[gforth] / gforth / Attic / primitives  

gforth: gforth/Attic/primitives

Diff for /gforth/Attic/primitives between version 1.31 and 1.41

version 1.31, Thu Jan 19 19:43:48 1995 UTC version 1.41, Sat Oct 7 17:38:18 1995 UTC
Line 86 
Line 86 
  ;   ;
   
 lit     -- w            fig  lit     -- w            fig
 w = (Cell)*ip++;  w = (Cell)NEXT_INST;
   INC_IP(1);
   
 execute         xt --           core,fig  execute         xt --           core,fig
   ip=IP;
 cfa = xt;  cfa = xt;
 IF_TOS(TOS = sp[0]);  IF_TOS(TOS = sp[0]);
 NEXT1;  NEXT1;
Line 96 
Line 98 
 branch-lp+!#    --      new     branch_lp_plus_store_number  branch-lp+!#    --      new     branch_lp_plus_store_number
 /* this will probably not be used */  /* this will probably not be used */
 branch_adjust_lp:  branch_adjust_lp:
 lp += (Cell)(ip[1]);  lp += (Cell)(IP[1]);
 goto branch;  goto branch;
   
 branch  --              fig  branch  --              fig
 branch:  branch:
 ip = (Xt *)(((Cell)ip)+(Cell)*ip);  ip = (Xt *)(((Cell)IP)+(Cell)NEXT_INST);
   NEXT_P0;
 :  :
  r> dup @ + >r ;   r> dup @ + >r ;
   
 \ condbranch(forthname,restline,code)  \ condbranch(forthname,restline,code)
 \ this is non-syntactical: code must open a brace that is close by the macro  \ this is non-syntactical: code must open a brace that is closed by the macro
 define(condbranch,  define(condbranch,
 $1      $2  $1      $2
 $3    goto branch;  $3      ip = (Xt *)(((Cell)IP)+(Cell)NEXT_INST);
           NEXT_P0;
           NEXT;
 }  }
 else  else
     ip++;      INC_IP(1);
   
 $1-lp+!#        $2_lp_plus_store_number  $1-lp+!#        $2_lp_plus_store_number
 $3    goto branch_adjust_lp;  $3    goto branch_adjust_lp;
 }  }
 else  else
     ip+=2;      INC_IP(2);
   
 )  )
   
Line 144 
Line 149 
 /* 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 */
 Cell olddiff = index-rp[1];  Cell olddiff = index-rp[1];
 #ifdef undefined  #ifndef undefined
 if ((olddiff^(olddiff+n))>=0   /* the limit is not crossed */  if ((olddiff^(olddiff+n))>=0   /* the limit is not crossed */
     || (olddiff^n)>=0          /* it is a wrap-around effect */) {      || (olddiff^n)>=0          /* it is a wrap-around effect */) {
 #else  #else
Line 161 
Line 166 
     IF_TOS(TOS = sp[0]);      IF_TOS(TOS = sp[0]);
 )  )
   
   condbranch((-loop),u --         new     paren_minus_loop,
   /* !! check this thoroughly */
   Cell index = *rp;
   /* sign bit manipulation and test: (x^y)<0 is equivalent to (x<0) != (y<0) */
   /* dependent upon two's complement arithmetic */
   UCell olddiff = index-rp[1];
   if (olddiff>u) {
       *rp = index - u;
       IF_TOS(TOS = sp[0]);
   )
   
 condbranch((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
Line 201 
Line 217 
 :  :
  r> -rot swap >r >r >r ;   r> -rot swap >r >r >r ;
   
 (?do)   nlimit nstart --        core-ext        paren_question_do  (?do)   nlimit nstart --        new     paren_question_do
 *--rp = nlimit;  *--rp = nlimit;
 *--rp = nstart;  *--rp = nstart;
 if (nstart == nlimit) {  if (nstart == nlimit) {
Line 209 
Line 225 
     goto branch;      goto branch;
     }      }
 else {  else {
     ip++;      INC_IP(1);
   }
   
   (+do)   nlimit nstart --        new     paren_plus_do
   *--rp = nlimit;
   *--rp = nstart;
   if (nstart >= nlimit) {
       IF_TOS(TOS = sp[0]);
       goto branch;
       }
   else {
       INC_IP(1);
   }
   
   (u+do)  ulimit ustart --        new     paren_u_plus_do
   *--rp = ulimit;
   *--rp = ustart;
   if (ustart >= ulimit) {
       IF_TOS(TOS = sp[0]);
       goto branch;
       }
   else {
       INC_IP(1);
   }
   
   (-do)   nlimit nstart --        new     paren_minus_do
   *--rp = nlimit;
   *--rp = nstart;
   if (nstart <= nlimit) {
       IF_TOS(TOS = sp[0]);
       goto branch;
       }
   else {
       INC_IP(1);
   }
   
   (u-do)  ulimit ustart --        new     paren_u_minus_do
   *--rp = ulimit;
   *--rp = ustart;
   if (ustart <= ulimit) {
       IF_TOS(TOS = sp[0]);
       goto branch;
       }
   else {
       INC_IP(1);
 }  }
   
 i       -- n            core,fig  i       -- n            core,fig
Line 608 
Line 668 
   
 ;s      --              fig     semis  ;s      --              fig     semis
 ip = (Xt *)(*rp++);  ip = (Xt *)(*rp++);
   NEXT_P0;
   
 >r      w --            core,fig        to_r  >r      w --            core,fig        to_r
 *--rp = w;  *--rp = w;
Line 769 
Line 830 
 return (Label *)n;  return (Label *)n;
   
 system  c_addr u -- n   own  system  c_addr u -- n   own
 n=system(cstr(c_addr,u,1));  n=system(cstr(c_addr,u,1)); /* ~ expansion on first part of string? */
   
 getenv  c_addr1 u1 -- c_addr2 u2        new  getenv  c_addr1 u1 -- c_addr2 u2        new
 c_addr2 = getenv(cstr(c_addr1,u1,1));  c_addr2 = getenv(cstr(c_addr1,u1,1));
 u2=strlen(c_addr2);  u2 = (c_addr2 == NULL ? 0 : strlen(c_addr2));
   
 popen   c_addr u n -- wfileid   own  popen   c_addr u n -- wfileid   own
 static char* mode[2]={"r","w"};  static char* mode[2]={"r","w"}; /* !! should we use FAM here? */
 wfileid=(Cell)popen(cstr(c_addr,u,1),mode[n]);  wfileid=(Cell)popen(cstr(c_addr,u,1),mode[n]); /* ~ expansion of 1st arg? */
   
 pclose  wfileid -- wior own  pclose  wfileid -- wior own
 wior=pclose((FILE *)wfileid);  wior=pclose((FILE *)wfileid); /* !! what to do with the result */
   
 time&date       -- nsec nmin nhour nday nmonth nyear    facility-ext    time_and_date  time&date       -- nsec nmin nhour nday nmonth nyear    facility-ext    time_and_date
 struct timeval time1;  struct timeval time1;
 struct timezone zone1;  struct timezone zone1;
 struct tm *ltime;  struct tm *ltime;
 gettimeofday(&time1,&zone1);  gettimeofday(&time1,&zone1);
 ltime=localtime(&time1.tv_sec);  ltime=localtime((time_t *)&time1.tv_sec);
 nyear =ltime->tm_year+1900;  nyear =ltime->tm_year+1900;
 nmonth=ltime->tm_mon+1;  nmonth=ltime->tm_mon+1;
 nday  =ltime->tm_mday;  nday  =ltime->tm_mday;
Line 803 
Line 864 
   
 allocate        u -- a_addr wior        memory  allocate        u -- a_addr wior        memory
 a_addr = (Cell *)malloc(u);  a_addr = (Cell *)malloc(u);
 wior = a_addr==NULL;    /* !! Define a return code */  wior = IOR(a_addr==NULL);
   
 free            a_addr -- wior          memory  free            a_addr -- wior          memory
 free(a_addr);  free(a_addr);
 wior = 0;  wior = 0;
   
 resize          a_addr1 u -- a_addr2 wior       memory  resize          a_addr1 u -- a_addr2 wior       memory
 a_addr2 = realloc(a_addr1, u);  ""Change the size of the allocated area at @i{a_addr1} to @i{u}
 wior = a_addr2==NULL;   /* !! Define a return code */  address units, possibly moving the contents to a different
   area. @i{a_addr2} is the address of the resulting area. If
   @code{a_addr2} is 0, gforth's (but not the standard) @code{resize}
   @code{allocate}s @i{u} address units.""
   /* the following check is not necessary on most OSs, but it is needed
      on SunOS 4.1.2. */
   if (a_addr1==NULL)
     a_addr2 = (Cell *)malloc(u);
   else
     a_addr2 = (Cell *)realloc(a_addr1, u);
   wior = IOR(a_addr2==NULL);      /* !! Define a return code */
   
 (f83find)       c_addr u f83name1 -- f83name2   new     paren_f83find  (f83find)       c_addr u f83name1 -- f83name2   new     paren_f83find
 for (; f83name1 != NULL; f83name1 = f83name1->next)  for (; f83name1 != NULL; f83name1 = f83name1->next)
Line 904 
Line 975 
  REPEAT  THEN  nip - ;   REPEAT  THEN  nip - ;
   
 close-file      wfileid -- wior file    close_file  close-file      wfileid -- wior file    close_file
 wior = FILEIO(fclose((FILE *)wfileid)==EOF);  wior = IOR(fclose((FILE *)wfileid)==EOF);
   
 open-file       c_addr u ntype -- w2 wior       file    open_file  open-file       c_addr u ntype -- w2 wior       file    open_file
 w2 = (Cell)fopen(cstr(c_addr, u, 1), fileattr[ntype]);  w2 = (Cell)fopen(tilde_cstr(c_addr, u, 1), fileattr[ntype]);
 wior =  FILEEXIST(w2 == NULL);  wior =  IOR(w2 == 0);
   
 create-file     c_addr u ntype -- w2 wior       file    create_file  create-file     c_addr u ntype -- w2 wior       file    create_file
 Cell    fd;  Cell    fd;
 fd = creat(cstr(c_addr, u, 1), 0644);  fd = open(tilde_cstr(c_addr, u, 1), O_CREAT|O_RDWR|O_TRUNC, 0666);
 if (fd > -1) {  if (fd != -1) {
 #ifdef __osf__  
   (void)close(fd);  
   w2 = (Cell)fopen(cstr(c_addr, u, 1), fileattr[ntype]);  
 #else  
   w2 = (Cell)fdopen(fd, fileattr[ntype]);    w2 = (Cell)fdopen(fd, fileattr[ntype]);
 #endif    wior = IOR(w2 == 0);
   assert(w2 != NULL);  
   wior = 0;  
 } else {  } else {
   assert(fd == -1);  
   wior = FILEIO(fd);  
   w2 = 0;    w2 = 0;
     wior = IOR(1);
 }  }
   
 delete-file     c_addr u -- wior                file    delete_file  delete-file     c_addr u -- wior                file    delete_file
 wior = FILEEXIST(unlink(cstr(c_addr, u, 1)));  wior = IOR(unlink(tilde_cstr(c_addr, u, 1))==-1);
   
 rename-file     c_addr1 u1 c_addr2 u2 -- wior   file-ext        rename_file  rename-file     c_addr1 u1 c_addr2 u2 -- wior   file-ext        rename_file
 char *s1=cstr(c_addr2, u2, 1);  char *s1=tilde_cstr(c_addr2, u2, 1);
 wior = FILEEXIST(rename(cstr(c_addr1, u1, 0), s1));  wior = IOR(rename(tilde_cstr(c_addr1, u1, 0), s1)==-1);
   
 file-position   wfileid -- ud wior      file    file_position  file-position   wfileid -- ud wior      file    file_position
 /* !! use tell and lseek? */  /* !! use tell and lseek? */
 ud = ftell((FILE *)wfileid);  ud = ftell((FILE *)wfileid);
 wior = 0; /* !! or wior = FLAG(ud<0) */  wior = IOR(ud==-1);
   
 reposition-file ud wfileid -- wior      file    reposition_file  reposition-file ud wfileid -- wior      file    reposition_file
 wior = FILEIO(fseek((FILE *)wfileid, (long)ud, SEEK_SET));  wior = IOR(fseek((FILE *)wfileid, (long)ud, SEEK_SET)==-1);
   
 file-size       wfileid -- ud wior      file    file_size  file-size       wfileid -- ud wior      file    file_size
 struct stat buf;  struct stat buf;
 wior = FILEEXIST(fstat(fileno((FILE *)wfileid), &buf));  wior = IOR(fstat(fileno((FILE *)wfileid), &buf)==-1);
 ud = buf.st_size;  ud = buf.st_size;
   
 resize-file     ud wfileid -- wior      file    resize_file  resize-file     ud wfileid -- wior      file    resize_file
 wior = FILEIO(ftruncate(fileno((FILE *)wfileid), (Cell)ud));  wior = IOR(ftruncate(fileno((FILE *)wfileid), (Cell)ud)==-1);
   
 read-file       c_addr u1 wfileid -- u2 wior    file    read_file  read-file       c_addr u1 wfileid -- u2 wior    file    read_file
 /* !! fread does not guarantee enough */  /* !! fread does not guarantee enough */
 u2 = fread(c_addr, sizeof(Char), u1, (FILE *)wfileid);  u2 = fread(c_addr, sizeof(Char), u1, (FILE *)wfileid);
 wior = FILEIO(u2<u1 && ferror((FILE *)wfileid));  wior = FILEIO(u2<u1 && ferror((FILE *)wfileid));
 /* !! who performs clearerr((FILE *)wfileid); ? */  /* !! is the value of ferror errno-compatible? */
   if (wior)
     clearerr((FILE *)wfileid);
   
 read-line       c_addr u1 wfileid -- u2 flag wior       file    read_line  read-line       c_addr u1 wfileid -- u2 flag wior       file    read_line
 /*  /*
Line 975 
Line 1041 
 */  */
 if ((flag=FLAG(!feof((FILE *)wfileid) &&  if ((flag=FLAG(!feof((FILE *)wfileid) &&
                fgets(c_addr,u1+1,(FILE *)wfileid) != NULL))) {                 fgets(c_addr,u1+1,(FILE *)wfileid) != NULL))) {
   wior=FILEIO(ferror((FILE *)wfileid));    wior=FILEIO(ferror((FILE *)wfileid)); /* !! ior? */
     if (wior)
       clearerr((FILE *)wfileid);
   u2 = strlen(c_addr);    u2 = strlen(c_addr);
   u2-=((u2>0) && (c_addr[u2-1]==NEWLINE));    u2-=((u2>0) && (c_addr[u2-1]==NEWLINE));
 }  }
Line 989 
Line 1057 
 {  {
   Cell u2 = fwrite(c_addr, sizeof(Char), u1, (FILE *)wfileid);    Cell u2 = fwrite(c_addr, sizeof(Char), u1, (FILE *)wfileid);
   wior = FILEIO(u2<u1 && ferror((FILE *)wfileid));    wior = FILEIO(u2<u1 && ferror((FILE *)wfileid));
     if (wior)
       clearerr((FILE *)wfileid);
 }  }
   
 flush-file      wfileid -- wior         file-ext        flush_file  flush-file      wfileid -- wior         file-ext        flush_file
 wior = FILEIO(fflush((FILE *) wfileid));  wior = IOR(fflush((FILE *) wfileid)==EOF);
   
   file-status     c_addr u -- ntype wior  file-ext        file_status
   char *filename=tilde_cstr(c_addr, u, 1);
   if (access (filename, F_OK) != 0) {
     ntype=0;
     wior=IOR(1);
   }
   else if (access (filename, R_OK | W_OK) == 0) {
     ntype=2; /* r/w */
     wior=0;
   }
   else if (access (filename, R_OK) == 0) {
     ntype=0; /* r/o */
     wior=0;
   }
   else if (access (filename, W_OK) == 0) {
     ntype=4; /* w/o */
     wior=0;
   }
   else {
     ntype=1; /* well, we cannot access the file, but better deliver a legal
               access mode (r/o bin), so we get a decent error later upon open. */
     wior=0;
   }
   
 comparisons(f, r1 r2, f_, r1, r2, new, new, float, new)  comparisons(f, r1 r2, f_, r1, r2, new, new, float, new)
 comparisons(f0, r, f_zero_, r, 0., float, new, float, new)  comparisons(f0, r, f_zero_, r, 0., float, new, float, new)
Line 1104 
Line 1198 
 char *sig;  char *sig;
 Cell flag;  Cell flag;
 Cell decpt;  Cell decpt;
 sig=ecvt(r, u, &decpt, &flag);  sig=ecvt(r, u, (int *)&decpt, (int *)&flag);
 n=decpt;  n=(r==0 ? 1 : 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 1115 
Line 1209 
 Float r;  Float r;
 char *number=cstr(c_addr, u, 1);  char *number=cstr(c_addr, u, 1);
 char *endconv;  char *endconv;
 while(isspace(number[u-1])) u--;  while(isspace(number[--u]) && u>0);
 switch(number[u-1])  switch(number[u])
 {  {
         case 'd':          case 'd':
         case 'D':          case 'D':
         case 'e':          case 'e':
         case 'E': u--; break;     case 'E':  break;
         default: break;     default :  u++; break;
 }  }
 number[u]='\0';  number[u]='\0';
 r=strtod(number,&endconv);  r=strtod(number,&endconv);
Line 1194 
Line 1288 
   
 falog           r1 -- r2        float-ext  falog           r1 -- r2        float-ext
 ""@i{r2}=10**@i{r1}""  ""@i{r2}=10**@i{r1}""
 #ifdef HAVE_POW10  
 extern double pow10(double);  extern double pow10(double);
 r2 = pow10(r1);  r2 = pow10(r1);
 #else  
 #ifndef M_LN10  
 #define M_LN10      2.30258509299404568402  
 #endif  
 r2 = exp(r1*M_LN10);  
 #endif  
   
 fsin            r1 -- r2        float-ext  fsin            r1 -- r2        float-ext
 r2 = sin(r1);  r2 = sin(r1);
Line 1217 
Line 1304 
   
 ftan            r1 -- r2        float-ext  ftan            r1 -- r2        float-ext
 r2 = tan(r1);  r2 = tan(r1);
   :
    fsincos f/ ;
   
 fsinh           r1 -- r2        float-ext  fsinh           r1 -- r2        float-ext
 r2 = sinh(r1);  r2 = sinh(r1);
   :
    fexpm1 fdup fdup 1. d>f f+ f/ f+ f2/ ;
   
 fcosh           r1 -- r2        float-ext  fcosh           r1 -- r2        float-ext
 r2 = cosh(r1);  r2 = cosh(r1);
   :
    fexp fdup 1/f f+ f2/ ;
   
 ftanh           r1 -- r2        float-ext  ftanh           r1 -- r2        float-ext
 r2 = tanh(r1);  r2 = tanh(r1);
   :
    f2* fexpm1 fdup 2. d>f f+ f/ ;
   
 fasinh          r1 -- r2        float-ext  fasinh          r1 -- r2        float-ext
 r2 = asinh(r1);  r2 = asinh(r1);
   :
    fdup fdup f* 1. d>f f+ fsqrt f/ fatanh ;
   
 facosh          r1 -- r2        float-ext  facosh          r1 -- r2        float-ext
 r2 = acosh(r1);  r2 = acosh(r1);
   :
    fdup fdup f* 1. d>f f- fsqrt f+ fln ;
   
 fatanh          r1 -- r2        float-ext  fatanh          r1 -- r2        float-ext
 r2 = atanh(r1);  r2 = atanh(r1);
   :
    fdup f0< >r fabs 1. d>f fover f- f/  f2* flnp1 f2/
    r> IF  fnegate  THEN ;
   
 \ The following words access machine/OS/installation-dependent ANSI  \ The following words access machine/OS/installation-dependent ANSI
 \   figForth internals  \   figForth internals
Line 1257 
Line 1359 
 defining-word-defined */  defining-word-defined */
 a_addr = (Cell *)DOES_CODE(xt);  a_addr = (Cell *)DOES_CODE(xt);
   
 code-address!           n xt -- new     code_address_store  code-address!           c_addr xt --            new     code_address_store
 ""Creates a code field with code address c_addr at xt""  ""Creates a code field with code address c_addr at xt""
 MAKE_CF(xt, symbols[CF(n)]);  MAKE_CF(xt, c_addr);
 CACHE_FLUSH(xt,PFA(0));  CACHE_FLUSH(xt,PFA(0));
   
 does-code!      a_addr xt --            new     does_code_store  does-code!      a_addr xt --            new     does_code_store
Line 1268 
Line 1370 
 MAKE_DOES_CF(xt, a_addr);  MAKE_DOES_CF(xt, a_addr);
 CACHE_FLUSH(xt,PFA(0));  CACHE_FLUSH(xt,PFA(0));
   
 does-handler!   a_addr --       new     does_jump_store  does-handler!   a_addr --       new     does_handler_store
 ""creates a DOES>-handler at address a_addr. a_addr usually points  ""creates a DOES>-handler at address a_addr. a_addr usually points
 just behind a DOES>.""  just behind a DOES>.""
 MAKE_DOES_HANDLER(a_addr);  MAKE_DOES_HANDLER(a_addr);
Line 1279 
Line 1381 
 /* !! a constant or environmental query might be better */  /* !! a constant or environmental query might be better */
 n = DOES_HANDLER_SIZE;  n = DOES_HANDLER_SIZE;
   
   flush-icache    c_addr u --     gforth  flush_icache
   ""Make sure that the instruction cache of the processor (if there is
   one) does not contain stale data at @var{c_addr} and @var{u} bytes
   afterwards. @code{END-CODE} performs a @code{flush-icache}
   automatically. Caveat: @code{flush-icache} might not work on your
   installation; this is usually the case if direct threading is not
   supported on your machine (take a look at your @file{machine.h}) and
   your machine has a separate instruction cache. In such cases,
   @code{flush-icache} does nothing instead of flushing the instruction
   cache.""
   FLUSH_ICACHE(c_addr,u);
   
 toupper c1 -- c2        new  toupper c1 -- c2        new
 c2 = toupper(c1);  c2 = toupper(c1);
   
 \ local variable implementation primitives  \ local variable implementation primitives
 @local#         -- w    new     fetch_local_number  @local#         -- w    new     fetch_local_number
 w = *(Cell *)(lp+(Cell)(*ip++));  w = *(Cell *)(lp+(Cell)NEXT_INST);
   INC_IP(1);
   
 @local0 -- w    new     fetch_local_zero  @local0 -- w    new     fetch_local_zero
 w = *(Cell *)(lp+0*sizeof(Cell));  w = *(Cell *)(lp+0*sizeof(Cell));
Line 1299 
Line 1414 
 w = *(Cell *)(lp+3*sizeof(Cell));  w = *(Cell *)(lp+3*sizeof(Cell));
   
 f@local#        -- r    new     f_fetch_local_number  f@local#        -- r    new     f_fetch_local_number
 r = *(Float *)(lp+(Cell)(*ip++));  r = *(Float *)(lp+(Cell)NEXT_INST);
   INC_IP(1);
   
 f@local0        -- r    new     f_fetch_local_zero  f@local0        -- r    new     f_fetch_local_zero
 r = *(Float *)(lp+0*sizeof(Float));  r = *(Float *)(lp+0*sizeof(Float));
Line 1309 
Line 1425 
   
 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+(Cell)(*ip++));  c_addr = (Char *)(lp+(Cell)NEXT_INST);
   INC_IP(1);
   
 lp+!#   --      new     lp_plus_store_number  lp+!#   --      new     lp_plus_store_number
 ""used with negative immediate values it allocates memory on the  ""used with negative immediate values it allocates memory on the
 local stack, a positive immediate argument drops memory from the local  local stack, a positive immediate argument drops memory from the local
 stack""  stack""
 lp += (Cell)(*ip++);  lp += (Cell)NEXT_INST;
   INC_IP(1);
   
 lp-     --      new     minus_four_lp_plus_store  lp-     --      new     minus_four_lp_plus_store
 lp += -sizeof(Cell);  lp += -sizeof(Cell);
Line 1339 
Line 1457 
   
 up!     a_addr --       new     up_store  up!     a_addr --       new     up_store
 up0=up=(char *)a_addr;  up0=up=(char *)a_addr;
   
   call-c  w --    new     call_c
   ""Call the C function pointed to by @i{w}. The C function has to
   access the stack itself. The stack pointers are exported in the gloabl
   variables @code{SP} and @code{FP}.""
   /* This is a first attempt at support for calls to C. This may change in
      the future */
   IF_FTOS(fp[0]=FTOS);
   FP=fp;
   SP=sp;
   ((void (*)())w)();
   sp=SP;
   fp=FP;
   IF_TOS(TOS=sp[0]);
   IF_FTOS(FTOS=fp[0]);
   
   strerror        n -- c_addr u   new
   c_addr = strerror(n);
   u = strlen(c_addr);

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help