[gforth] / gforth / Attic / primitives  

gforth: gforth/Attic/primitives

Diff for /gforth/Attic/primitives between version 1.8 and 1.9

version 1.8, Wed Jun 1 10:05:20 1994 UTC version 1.9, Fri Jun 17 12:35:14 1994 UTC
Line 79 
Line 79 
 IF_TOS(TOS = sp[0]);  IF_TOS(TOS = sp[0]);
 NEXT1;  NEXT1;
   
   branch-lp+!#    --      new     branch_lp_plus_store_number
   /* this will probably not be used */
   branch_adjust_lp:
   lp += (int)(ip[1]);
   goto branch;
   
 branch  --              fig  branch  --              fig
 branch:  branch:
 ip = (Xt *)(((int)ip)+(int)*ip);  ip = (Xt *)(((int)ip)+(int)*ip);
   
 ?branch         f --            f83     question_branch  \ condbranch(forthname,restline,code)
 ""also known as 0branch""  \ this is non-syntactical: code must open a brace that is close by the macro
 if (f==0) {  define(condbranch,
     IF_TOS(TOS = sp[0]);  $1      $2
     goto branch;  $3    goto branch;
     }      }
 else  else
     ip++;      ip++;
   
 (next)  --              cmFORTH paren_next  $1-lp+!#        $2_lp_plus_store_number
 if ((*rp)--) {  $3    goto branch_adjust_lp;
     goto branch;  
 } else {  
     ip++;  
 }  }
   else
       ip+=2;
   
   )
   
 (loop)  --              fig     paren_loop  condbranch(?branch,f --         f83     question_branch,
   if (f==0) {
       IF_TOS(TOS = sp[0]);
   )
   
   condbranch((next),--            cmFORTH paren_next,
   if ((*rp)--) {
   )
   
   condbranch((loop),--            fig     paren_loop,
 int index = *rp+1;  int index = *rp+1;
 int limit = rp[1];  int limit = rp[1];
 if (index != limit) {  if (index != limit) {
     *rp = index;      *rp = index;
     goto branch;  )
 } else {  
     ip++;  
 }  
   
 (+loop)         n --            fig     paren_plus_loop  condbranch((+loop),n --         fig     paren_plus_loop,
 /* !! check this thoroughly */  /* !! check this thoroughly */
 int index = *rp;  int index = *rp;
 int olddiff = index-rp[1];  int olddiff = index-rp[1];
 /* sign bit manipulation and test: (x^y)<0 is equivalent to (x<0) != (y<0) */  /* sign bit manipulation and test: (x^y)<0 is equivalent to (x<0) != (y<0) */
 /* dependent upon two's complement arithmetic */  /* dependent upon two's complement arithmetic */
 if ((olddiff^(olddiff+n))<0   /* the limit is crossed */  if ((olddiff^(olddiff+n))>=0   /* the limit is not crossed */
     && (olddiff^n)<0          /* it is not a wrap-around effect */) {      || (olddiff^n)>=0          /* it is a wrap-around effect */) {
     /* break */  
     ip++;  
 } else {  
     /* continue */  
     *rp = index+n;      *rp = index+n;
     IF_TOS(TOS = sp[0]);      IF_TOS(TOS = sp[0]);
     goto branch;  )
 }  
   
 (s+loop)        n --            new     paren_symmetric_plus_loop  condbranch((s+loop),n --                new     paren_symmetric_plus_loop,
 ""The run-time procedure compiled by S+LOOP. It loops until the index  ""The run-time procedure compiled by S+LOOP. It loops until the index
 crosses the boundary between limit and limit-sign(n). I.e. a symmetric  crosses the boundary between limit and limit-sign(n). I.e. a symmetric
 version of (+LOOP).""  version of (+LOOP).""
Line 141 
Line 149 
 if (diff>=0 || newdiff<0) {  if (diff>=0 || newdiff<0) {
     *rp = oldindex+n;      *rp = oldindex+n;
     IF_TOS(TOS = sp[0]);      IF_TOS(TOS = sp[0]);
     goto branch;  )
 } else {  
     ip++;  
 }  
   
 unloop          --      core  unloop          --      core
 rp += 2;  rp += 2;
Line 460 
Line 465 
 fp = f_addr;  fp = f_addr;
   
 ;s      --              core    exit  ;s      --              core    exit
 /* use ;s as alias */  
 ip = (Xt *)(*rp++);  
   
 ?exit   w --            core            question_exit  
 /* use ;s as alias */  
 if(w)  
         ip = (Xt *)(*rp++);          ip = (Xt *)(*rp++);
   
 >r      w --            core,fig        to_r  >r      w --            core,fig        to_r
Line 824 
Line 823 
 represent               r c_addr u -- n f1 f2   float  represent               r c_addr u -- n f1 f2   float
 char *sig;  char *sig;
 int flag;  int flag;
 sig=ecvt(r, u, (int *)&n, &flag);  int decpt;
   sig=ecvt(r, u, &decpt, &flag);
   n=decpt;
 f1=FLAG(flag!=0);  f1=FLAG(flag!=0);
 f2=FLAG(isdigit(sig[0])!=0);  f2=FLAG(isdigit(sig[0])!=0);
 memmove(c_addr,sig,u);  memmove(c_addr,sig,u);
Line 960 
Line 961 
 @local#         -- w    new     fetch_local_number  @local#         -- w    new     fetch_local_number
 w = *(Cell *)(lp+(int)(*ip++));  w = *(Cell *)(lp+(int)(*ip++));
   
   @local0 -- w    new     fetch_local_zero
   w = *(Cell *)(lp+0);
   
   @local4 -- w    new     fetch_local_four
   w = *(Cell *)(lp+4);
   
   @local8 -- w    new     fetch_local_eight
   w = *(Cell *)(lp+8);
   
   @local12        -- w    new     fetch_local_twelve
   w = *(Cell *)(lp+12);
   
 f@local#        -- r    new     f_fetch_local_number  f@local#        -- r    new     f_fetch_local_number
 r = *(Float *)(lp+(int)(*ip++));  r = *(Float *)(lp+(int)(*ip++));
   
   f@local0        -- r    new     f_fetch_local_zero
   r = *(Float *)(lp+0);
   
   f@local8        -- r    new     f_fetch_local_eight
   r = *(Float *)(lp+8);
   
 laddr#          -- c_addr       new     laddr_number  laddr#          -- c_addr       new     laddr_number
 /* this can also be used to implement lp@ */  /* this can also be used to implement lp@ */
 c_addr = (Char *)(lp+(int)(*ip++));  c_addr = (Char *)(lp+(int)(*ip++));
Line 973 
Line 992 
 stack""  stack""
 lp += (int)(*ip++);  lp += (int)(*ip++);
   
   -4lp+!  --      new     minus_four_lp_plus_store
   lp += -4;
   
   8lp+!   --      new     eight_lp_plus_store
   lp += 8;
   
   16lp+!  --      new     sixteen_lp_plus_store
   lp += 16;
   
 lp!     c_addr --       new     lp_store  lp!     c_addr --       new     lp_store
 lp = (Address)c_addr;  lp = (Address)c_addr;
   

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help