[gforth] / gforth / prim  

gforth: gforth/prim

Diff for /gforth/prim between version 1.137 and 1.138

version 1.137, Sun Aug 17 22:52:33 2003 UTC version 1.138, Mon Aug 18 19:29:14 2003 UTC
Line 1315 
Line 1315 
   
 \g compiler  \g compiler
   
   \+f83headerstring
   
   (f83find)       ( c_addr u f83name1 -- f83name2 )       new     paren_f83find
   for (; f83name1 != NULL; f83name1 = (struct F83Name *)(f83name1->next))
     if ((UCell)F83NAME_COUNT(f83name1)==u &&
         memcasecmp(c_addr, f83name1->name, u)== 0 /* or inline? */)
       break;
   f83name2=f83name1;
   :
       BEGIN  dup WHILE  (find-samelen)  dup  WHILE
           >r 2dup r@ cell+ char+ capscomp  0=
           IF  2drop r>  EXIT  THEN
           r> @
       REPEAT  THEN  nip nip ;
   : (find-samelen) ( u f83name1 -- u f83name2/0 )
       BEGIN  2dup cell+ c@ $1F and <> WHILE  @  dup 0= UNTIL  THEN ;
   : capscomp ( c_addr1 u c_addr2 -- n )
    swap bounds
    ?DO  dup c@ I c@ <>
        IF  dup c@ toupper I c@ toupper =
        ELSE  true  THEN  WHILE  1+  LOOP  drop 0
    ELSE  c@ toupper I c@ toupper - unloop  THEN  sgn ;
   : sgn ( n -- -1/0/1 )
    dup 0= IF EXIT THEN  0< 2* 1+ ;
   
   \-
   
 (listlfind)     ( c_addr u longname1 -- longname2 )     new     paren_listlfind  (listlfind)     ( c_addr u longname1 -- longname2 )     new     paren_listlfind
 longname2=listlfind(c_addr, u, longname1);  longname2=listlfind(c_addr, u, longname1);
 :  :
Line 1348 
Line 1375 
             IF  2drop r> rdrop  EXIT  THEN  THEN              IF  2drop r> rdrop  EXIT  THEN  THEN
         rdrop r>          rdrop r>
  REPEAT nip nip ;   REPEAT nip nip ;
   : -text ( c_addr1 u c_addr2 -- n )
    swap bounds
    ?DO  dup c@ I c@ = WHILE  1+  LOOP  drop 0
    ELSE  c@ I c@ - unloop  THEN  sgn ;
   : sgn ( n -- -1/0/1 )
    dup 0= IF EXIT THEN  0< 2* 1+ ;
   
 (hashkey1)      ( c_addr u ubits -- ukey )              gforth  paren_hashkey1  (hashkey1)      ( c_addr u ubits -- ukey )              gforth  paren_hashkey1
 ""ukey is the hash key for the string c_addr u fitting in ubits bits""  ""ukey is the hash key for the string c_addr u fitting in ubits bits""
Line 1367 
Line 1400 
   
 \+  \+
   
   \+
   
 (parse-white)   ( c_addr1 u1 -- c_addr2 u2 )    gforth  paren_parse_white  (parse-white)   ( c_addr1 u1 -- c_addr2 u2 )    gforth  paren_parse_white
 struct Cellpair r=parse_white(c_addr1, u1);  struct Cellpair r=parse_white(c_addr1, u1);
 c_addr2 = (Char *)(r.n1);  c_addr2 = (Char *)(r.n1);

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help