Diff for /gforth/cross.fs between versions 1.88 and 1.89

version 1.88, 2000/10/29 20:27:02 version 1.89, 2001/01/28 16:54:55
Line 1516  variable ResolveFlag Line 1516  variable ResolveFlag
 >CROSS  >CROSS
 \ Header states                                        12dec92py  \ Header states                                        12dec92py
   
 : flag! ( 8b -- )   tlast @ dup >r T c@ xor r> c! H ;  : flag! ( w -- )   tlast @ dup >r T @ xor r> ! H ;
   
 VARIABLE ^imm  VARIABLE ^imm
   
   \ !! should be target wordsize specific
   $80000000 constant alias-mask
   $40000000 constant immediate-mask
   $20000000 constant restrict-mask
   
 >TARGET  >TARGET
 : immediate     40 flag!  : immediate     immediate-mask flag!
                 ^imm @ @ dup <imm> = IF  drop  EXIT  THEN                  ^imm @ @ dup <imm> = IF  drop  EXIT  THEN
                 <res> <> ABORT" CROSS: Cannot immediate a unresolved word"                  <res> <> ABORT" CROSS: Cannot immediate a unresolved word"
                 <imm> ^imm @ ! ;                  <imm> ^imm @ ! ;
 : restrict      20 flag! ;  : restrict      restrict-mask flag! ;
   
 : isdoer          : isdoer        
 \G define a forth word as doer, this makes obviously only sence on  \G define a forth word as doer, this makes obviously only sence on
Line 1537  VARIABLE ^imm Line 1542  VARIABLE ^imm
   
 >TARGET  >TARGET
 : string,  ( addr count -- )  : string,  ( addr count -- )
   dup T c, H bounds  ?DO  I c@ T c, H  LOOP ;       dup T c, H bounds  ?DO  I c@ T c, H  LOOP ;
 : name,  ( "name" -- )  bl word count T string, cfalign H ;  : lstring, ( addr count -- )
       dup T , H bounds  ?DO  I c@ T c, H  LOOP ;
   : name,  ( "name" -- )  bl word count T lstring, cfalign H ;
 : view,   ( -- ) ( dummy ) ;  : view,   ( -- ) ( dummy ) ;
 >CROSS  >CROSS
   
Line 1693  NoHeaderFlag off Line 1700  NoHeaderFlag off
     IF  dup >end tdoes !      IF  dup >end tdoes !
     ELSE 0 tdoes !      ELSE 0 tdoes !
     THEN      THEN
     80 flag!      alias-mask flag!
     cross-doc-entry cross-tag-entry ;      cross-doc-entry cross-tag-entry ;
   
 VARIABLE ;Resolve 1 cells allot  VARIABLE ;Resolve 1 cells allot
Line 1710  VARIABLE ;Resolve 1 cells allot Line 1717  VARIABLE ;Resolve 1 cells allot
     IF      IF
         .sourcepos ." needs prim: " >in @ bl word count type >in ! cr          .sourcepos ." needs prim: " >in @ bl word count type >in ! cr
     THEN      THEN
     (THeader over resolve T A, H 80 flag! ;      (THeader over resolve T A, H alias-mask flag! ;
 : Alias:   ( cfa -- ) \ name  : Alias:   ( cfa -- ) \ name
     >in @ skip? IF  2drop  EXIT  THEN  >in !      >in @ skip? IF  2drop  EXIT  THEN  >in !
     dup 0< s" prims" T $has? H 0= and      dup 0< s" prims" T $has? H 0= and
Line 2034  Cond: DOES> restrict? Line 2041  Cond: DOES> restrict?
   create-forward-warn    create-forward-warn
   IF ['] reswarn-forward IS resolve-warning THEN    IF ['] reswarn-forward IS resolve-warning THEN
   \ make Alias    \ make Alias
   (THeader there 0 T a, H 80 flag! ( S executed-ghost new-ghost )    (THeader there 0 T a, H alias-mask flag! ( S executed-ghost new-ghost )
   \ store  poiter to code-field    \ store  poiter to code-field
   switchram T cfalign H    switchram T cfalign H
   there swap T ! H    there swap T ! H

Removed from v.1.88  
changed lines
  Added in v.1.89


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