[gforth] / gforth / prim  

gforth: gforth/prim

Diff for /gforth/prim between version 1.63 and 1.64

version 1.63, Sat Sep 23 15:46:58 2000 UTC version 1.64, Fri Nov 10 10:04:20 2000 UTC
Line 117 
Line 117 
 execute ( xt -- )               core  execute ( xt -- )               core
 ""Perform the semantics represented by the execution token, @i{xt}.""  ""Perform the semantics represented by the execution token, @i{xt}.""
 ip=IP;  ip=IP;
 IF_TOS(TOS = sp[0]);  IF_spTOS(spTOS = sp[0]);
 EXEC(xt);  EXEC(xt);
   
 perform ( a_addr -- )   gforth  perform ( a_addr -- )   gforth
 ""@code{@@ execute}.""  ""@code{@@ execute}.""
 /* and pfe */  /* and pfe */
 ip=IP;  ip=IP;
 IF_TOS(TOS = sp[0]);  IF_spTOS(spTOS = sp[0]);
 EXEC(*(Xt *)a_addr);  EXEC(*(Xt *)a_addr);
 :  :
  @ execute ;   @ execute ;
Line 170 
Line 170 
   
 condbranch(?branch,( f -- )             f83     question_branch,  condbranch(?branch,( f -- )             f83     question_branch,
 if (f==0) {  if (f==0) {
     IF_TOS(TOS = sp[0]);      IF_spTOS(spTOS = sp[0]);
 ,:  ,:
  0= dup     \ !f !f   0= dup     \ !f !f
  r> dup @   \ !f !f IP branchoffset   r> dup @   \ !f !f IP branchoffset
Line 187 
Line 187 
 ""The run-time procedure compiled by @code{?DUP-IF}.""  ""The run-time procedure compiled by @code{?DUP-IF}.""
 if (f==0) {  if (f==0) {
   sp++;    sp++;
   IF_TOS(TOS = sp[0]);    IF_spTOS(spTOS = sp[0]);
   SET_IP((Xt *)(((Cell)IP)+(Cell)NEXT_INST));    SET_IP((Xt *)(((Cell)IP)+(Cell)NEXT_INST));
   NEXT;    NEXT;
 }  }
Line 241 
Line 241 
 #else  #else
     *rp = index + n;      *rp = index + n;
 #endif  #endif
     IF_TOS(TOS = sp[0]);      IF_spTOS(spTOS = sp[0]);
 ,:  ,:
  r> swap   r> swap
  r> r> 2dup - >r   r> r> 2dup - >r
Line 262 
Line 262 
 #else  #else
     *rp = index - u;      *rp = index - u;
 #endif  #endif
     IF_TOS(TOS = sp[0]);      IF_spTOS(spTOS = sp[0]);
 ,)  ,)
   
 condbranch((s+loop),( n -- )            gforth  paren_symmetric_plus_loop,  condbranch((s+loop),( n -- )            gforth  paren_symmetric_plus_loop,
Line 283 
Line 283 
 #else  #else
     *rp = index + n;      *rp = index + n;
 #endif  #endif
     IF_TOS(TOS = sp[0]);      IF_spTOS(spTOS = sp[0]);
 ,)  ,)
   
 \+  \+
Line 311 
Line 311 
 *--rp = nlimit;  *--rp = nlimit;
 *--rp = nstart;  *--rp = nstart;
 if (nstart == nlimit) {  if (nstart == nlimit) {
     IF_TOS(TOS = sp[0]);      IF_spTOS(spTOS = sp[0]);
     goto branch;      goto branch;
     }      }
 else {  else {
Line 331 
Line 331 
 *--rp = nlimit;  *--rp = nlimit;
 *--rp = nstart;  *--rp = nstart;
 if (nstart >= nlimit) {  if (nstart >= nlimit) {
     IF_TOS(TOS = sp[0]);      IF_spTOS(spTOS = sp[0]);
     goto branch;      goto branch;
     }      }
 else {  else {
Line 351 
Line 351 
 *--rp = ulimit;  *--rp = ulimit;
 *--rp = ustart;  *--rp = ustart;
 if (ustart >= ulimit) {  if (ustart >= ulimit) {
     IF_TOS(TOS = sp[0]);      IF_spTOS(spTOS = sp[0]);
     goto branch;      goto branch;
     }      }
 else {  else {
Line 371 
Line 371 
 *--rp = nlimit;  *--rp = nlimit;
 *--rp = nstart;  *--rp = nstart;
 if (nstart <= nlimit) {  if (nstart <= nlimit) {
     IF_TOS(TOS = sp[0]);      IF_spTOS(spTOS = sp[0]);
     goto branch;      goto branch;
     }      }
 else {  else {
Line 391 
Line 391 
 *--rp = ulimit;  *--rp = ulimit;
 *--rp = ustart;  *--rp = ustart;
 if (ustart <= ulimit) {  if (ustart <= ulimit) {
     IF_TOS(TOS = sp[0]);      IF_spTOS(spTOS = sp[0]);
     goto branch;      goto branch;
     }      }
 else {  else {
Line 955 
Line 955 
   
 sp!     ( a_addr -- )           gforth          sp_store  sp!     ( a_addr -- )           gforth          sp_store
 sp = a_addr;  sp = a_addr;
 /* works with and without TOS caching */  /* works with and without spTOS caching */
   
 rp@     ( -- a_addr )           gforth          rp_fetch  rp@     ( -- a_addr )           gforth          rp_fetch
 a_addr = rp;  a_addr = rp;
Line 1066 
Line 1066 
 ""Actually the stack effect is: @code{( w -- 0 | w w )}.  It performs a  ""Actually the stack effect is: @code{( w -- 0 | w w )}.  It performs a
 @code{dup} if w is nonzero.""  @code{dup} if w is nonzero.""
 if (w!=0) {  if (w!=0) {
   IF_TOS(*sp-- = w;)    IF_spTOS(*sp-- = w;)
 #ifndef USE_TOS  #ifndef USE_TOS
   *--sp = w;    *--sp = w;
 #endif  #endif
Line 1584 
Line 1584 
 variables @code{SP} and @code{FP}.""  variables @code{SP} and @code{FP}.""
 /* This is a first attempt at support for calls to C. This may change in  /* This is a first attempt at support for calls to C. This may change in
    the future */     the future */
 IF_FTOS(fp[0]=FTOS);  IF_fpTOS(fp[0]=fpTOS);
 FP=fp;  FP=fp;
 SP=sp;  SP=sp;
 ((void (*)())w)();  ((void (*)())w)();
 sp=SP;  sp=SP;
 fp=FP;  fp=FP;
 IF_TOS(TOS=sp[0]);  IF_spTOS(spTOS=sp[0]);
 IF_FTOS(FTOS=fp[0]);  IF_fpTOS(fpTOS=fp[0]);
   
 \+  \+
 \+file  \+file
Line 1892 
Line 1892 
 r=strtod(number,&endconv);  r=strtod(number,&endconv);
 if((flag=FLAG(!(Cell)*endconv)))  if((flag=FLAG(!(Cell)*endconv)))
 {  {
    IF_FTOS(fp[0] = FTOS);     IF_fpTOS(fp[0] = fpTOS);
    fp += -1;     fp += -1;
    FTOS = sign ? -r : r;     fpTOS = sign ? -r : r;
 }  }
 else if(*endconv=='d' || *endconv=='D')  else if(*endconv=='d' || *endconv=='D')
 {  {
Line 1902 
Line 1902 
    r=strtod(number,&endconv);     r=strtod(number,&endconv);
    if((flag=FLAG(!(Cell)*endconv)))     if((flag=FLAG(!(Cell)*endconv)))
      {       {
         IF_FTOS(fp[0] = FTOS);          IF_fpTOS(fp[0] = fpTOS);
         fp += -1;          fp += -1;
         FTOS = sign ? -r : r;          fpTOS = sign ? -r : r;
      }       }
 }  }
   
Line 2196 
Line 2196 
 Variable UP  Variable UP
   
 wcall   ( u -- )        gforth  wcall   ( u -- )        gforth
 IF_FTOS(fp[0]=FTOS);  IF_fpTOS(fp[0]=fpTOS);
 FP=fp;  FP=fp;
 sp=(SYSCALL(Cell(*)(Cell *, void *))u)(sp, &FP);  sp=(SYSCALL(Cell(*)(Cell *, void *))u)(sp, &FP);
 fp=FP;  fp=FP;
 IF_TOS(TOS=sp[0];)  IF_spTOS(spTOS=sp[0];)
 IF_FTOS(FTOS=fp[0]);  IF_fpTOS(fpTOS=fp[0]);
   
 \+file  \+file
   

Generate output suitable for use with a patch program
Legend:
Removed from v.1.63  
changed lines
  Added in v.1.64
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help