[BACK]Return to prim CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/prim between versions 1.93 and 1.98

version 1.93, 2002/06/02 10:31:28 version 1.98, 2002/09/24 16:16:43
Line 104 Line 104
 \E inst-stream  stack-prefix #  \E inst-stream  stack-prefix #
 \E   \E 
 \E set-current  \E set-current
   \E store-optimization on
   
 \   \ 
 \   \ 
Line 182  SET_IP((Xt *)(((Cell)(IP-1))+ndisp)); Line 183  SET_IP((Xt *)(((Cell)(IP-1))+ndisp));
 define(condbranch,  define(condbranch,
 $1 ( `#'ndisp $2 ) $3  $1 ( `#'ndisp $2 ) $3
 $4      SET_IP((Xt *)(((Cell)(IP-1))+ndisp));  $4      SET_IP((Xt *)(((Cell)(IP-1))+ndisp));
 TAIL;  INST_TAIL;
 }  }
 SUPER_CONTINUE;  SUPER_CONTINUE;
 $5  $5
Line 192  $5 Line 193  $5
 $1-lp+!`#' ( `#'ndisp `#'nlocals $2 ) $3_lp_plus_store_number  $1-lp+!`#' ( `#'ndisp `#'nlocals $2 ) $3_lp_plus_store_number
 $4    lp += nlocals;  $4    lp += nlocals;
 SET_IP((Xt *)(((Cell)(IP-2))+ndisp));  SET_IP((Xt *)(((Cell)(IP-2))+ndisp));
 TAIL;  INST_TAIL;
 }  }
 SUPER_CONTINUE;  SUPER_CONTINUE;
   
Line 219  if (f==0) { Line 220  if (f==0) {
   sp++;    sp++;
   IF_spTOS(spTOS = sp[0]);    IF_spTOS(spTOS = sp[0]);
   SET_IP((Xt *)(((Cell)(IP-1))+ndisp));    SET_IP((Xt *)(((Cell)(IP-1))+ndisp));
   TAIL;    INST_TAIL;
 }  }
 SUPER_CONTINUE;  SUPER_CONTINUE;
   
Line 314  nlimit=0; Line 315  nlimit=0;
 (?do)   ( #ndisp nlimit nstart -- R:nlimit R:nstart )   gforth  paren_question_do  (?do)   ( #ndisp nlimit nstart -- R:nlimit R:nstart )   gforth  paren_question_do
 if (nstart == nlimit) {  if (nstart == nlimit) {
     SET_IP((Xt *)(((Cell)(IP-1))+ndisp));      SET_IP((Xt *)(((Cell)(IP-1))+ndisp));
     TAIL;      INST_TAIL;
 }  }
 SUPER_CONTINUE;  SUPER_CONTINUE;
 :  :
Line 330  SUPER_CONTINUE; Line 331  SUPER_CONTINUE;
 (+do)   ( #ndisp nlimit nstart -- R:nlimit R:nstart )   gforth  paren_plus_do  (+do)   ( #ndisp nlimit nstart -- R:nlimit R:nstart )   gforth  paren_plus_do
 if (nstart >= nlimit) {  if (nstart >= nlimit) {
     SET_IP((Xt *)(((Cell)(IP-1))+ndisp));      SET_IP((Xt *)(((Cell)(IP-1))+ndisp));
     TAIL;      INST_TAIL;
 }  }
 SUPER_CONTINUE;  SUPER_CONTINUE;
 :  :
Line 346  SUPER_CONTINUE; Line 347  SUPER_CONTINUE;
 (u+do)  ( #ndisp ulimit ustart -- R:ulimit R:ustart )   gforth  paren_u_plus_do  (u+do)  ( #ndisp ulimit ustart -- R:ulimit R:ustart )   gforth  paren_u_plus_do
 if (ustart >= ulimit) {  if (ustart >= ulimit) {
     SET_IP((Xt *)(((Cell)(IP-1))+ndisp));      SET_IP((Xt *)(((Cell)(IP-1))+ndisp));
     TAIL;      INST_TAIL;
 }  }
 SUPER_CONTINUE;  SUPER_CONTINUE;
 :  :
Line 362  SUPER_CONTINUE; Line 363  SUPER_CONTINUE;
 (-do)   ( #ndisp nlimit nstart -- R:nlimit R:nstart )   gforth  paren_minus_do  (-do)   ( #ndisp nlimit nstart -- R:nlimit R:nstart )   gforth  paren_minus_do
 if (nstart <= nlimit) {  if (nstart <= nlimit) {
     SET_IP((Xt *)(((Cell)(IP-1))+ndisp));      SET_IP((Xt *)(((Cell)(IP-1))+ndisp));
     TAIL;      INST_TAIL;
 }  }
 SUPER_CONTINUE;  SUPER_CONTINUE;
 :  :
Line 378  SUPER_CONTINUE; Line 379  SUPER_CONTINUE;
 (u-do)  ( #ndisp ulimit ustart -- R:ulimit R:ustart )   gforth  paren_u_minus_do  (u-do)  ( #ndisp ulimit ustart -- R:ulimit R:ustart )   gforth  paren_u_minus_do
 if (ustart <= ulimit) {  if (ustart <= ulimit) {
     SET_IP((Xt *)(((Cell)(IP-1))+ndisp));      SET_IP((Xt *)(((Cell)(IP-1))+ndisp));
     TAIL;      INST_TAIL;
 }  }
 SUPER_CONTINUE;  SUPER_CONTINUE;
 :  :
Line 2166  Variable UP Line 2167  Variable UP
 wcall   ( u -- )        gforth  wcall   ( u -- )        gforth
 IF_fpTOS(fp[0]=fpTOS);  IF_fpTOS(fp[0]=fpTOS);
 FP=fp;  FP=fp;
 sp=(Cell*)(SYSCALL(Cell(*)(Cell *, void *))u)(sp, &FP);  sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &FP);
 fp=FP;  fp=FP;
 IF_spTOS(spTOS=sp[0];)  IF_spTOS(spTOS=sp[0];)
 IF_fpTOS(fpTOS=fp[0]);  IF_fpTOS(fpTOS=fp[0]);
Line 2174  IF_fpTOS(fpTOS=fp[0]); Line 2175  IF_fpTOS(fpTOS=fp[0]);
 \+file  \+file
   
 open-dir        ( c_addr u -- wdirid wior )     gforth  open_dir  open-dir        ( c_addr u -- wdirid wior )     gforth  open_dir
   ""Open the directory specified by @i{c-addr, u}
   and return @i{dir-id} for futher access to it.""
 wdirid = (Cell)opendir(tilde_cstr(c_addr, u, 1));  wdirid = (Cell)opendir(tilde_cstr(c_addr, u, 1));
 wior =  IOR(wdirid == 0);  wior =  IOR(wdirid == 0);
   
 read-dir        ( c_addr u1 wdirid -- u2 flag wior )    gforth  read_dir  read-dir        ( c_addr u1 wdirid -- u2 flag wior )    gforth  read_dir
   ""Attempt to read the next entry from the directory specified
   by @i{dir-id} to the buffer of length @i{u1} at address @i{c-addr}. 
   If the attempt fails because there is no more entries,
   @i{ior}=0, @i{flag}=0, @i{u2}=0, and the buffer is unmodified.
   If the attempt to read the next entry fails because of any other reason, 
   return @i{ior}<>0.
   If the attempt succeeds, store file name to the buffer at @i{c-addr}
   and return @i{ior}=0, @i{flag}=true and @i{u2} equal to the size of the file name.
   If the length of the file name is greater than @i{u1}, 
   store first @i{u1} characters from file name into the buffer and
   indicate "name too long" with @i{ior}, @i{flag}=true, and @i{u2}=@i{u1}.""
 struct dirent * dent;  struct dirent * dent;
 dent = readdir((DIR *)wdirid);  dent = readdir((DIR *)wdirid);
 wior = 0;  wior = 0;
Line 2195  if(dent == NULL) { Line 2209  if(dent == NULL) {
 }  }
   
 close-dir       ( wdirid -- wior )      gforth  close_dir  close-dir       ( wdirid -- wior )      gforth  close_dir
   ""Close the directory specified by @i{dir-id}.""
 wior = IOR(closedir((DIR *)wdirid));  wior = IOR(closedir((DIR *)wdirid));
   
 filename-match  ( c_addr1 u1 c_addr2 u2 -- flag )       gforth  match_file  filename-match  ( c_addr1 u1 c_addr2 u2 -- flag )       gforth  match_file
Line 2412  a_addr = (Cell *)(up+u); Line 2427  a_addr = (Cell *)(up+u);
 compile-prim ( xt1 -- xt2 )     new     compile_prim  compile-prim ( xt1 -- xt2 )     new     compile_prim
 xt2 = (Xt)compile_prim((Label)xt1);  xt2 = (Xt)compile_prim((Label)xt1);
   
 lit@ / lit_fetch = lit @  \ lit@ / lit_fetch = lit @
   
   lit@            ( #a_addr -- w ) new    lit_fetch
   w = *a_addr;
   
 lit-perform     ( #a_addr -- )  new     lit_perform  lit-perform     ( #a_addr -- )  new     lit_perform
 ip=IP;  ip=IP;
 SUPER_END;  SUPER_END;
 EXEC(*(Xt *)a_addr);  EXEC(*(Xt *)a_addr);
   
 lit+ / lit_plus = lit +  \ lit+ / lit_plus = lit +
   
   lit+    ( n1 #n2 -- n )         new     lit_plus
   n=n1+n2;
   
 does-exec ( #a_cfa -- R:nest a_pfa )    new     does_exec  does-exec ( #a_cfa -- R:nest a_pfa )    new     does_exec
 a_pfa = PFA(a_cfa);  a_pfa = PFA(a_cfa);
Removed from v.1.93  
changed lines
  Added in v.1.98

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>