[gforth] / gforth / cross.fs  

gforth: gforth/cross.fs

Diff for /gforth/cross.fs between version 1.163 and 1.164

version 1.163, Sat Mar 31 21:43:18 2007 UTC version 1.164, Sun Apr 1 21:30:26 2007 UTC
Line 1244 
Line 1244 
 H  H
 tbits/char bits/byte /  Constant tbyte  tbits/char bits/byte /  Constant tbyte
   
   : >signed ( u -- n )
       1 tbits/char tcell * 1- lshift 2dup and
       IF  negate or  ELSE  drop  THEN ;
   
 \ Variables                                            06oct92py  \ Variables                                            06oct92py
   
Line 2316 
Line 2319 
   prim# @ (THeader ( S xt ghost )    prim# @ (THeader ( S xt ghost )
   ['] prim-resolved over >comp !    ['] prim-resolved over >comp !
   dup >ghost-flags <primitive> set-flag    dup >ghost-flags <primitive> set-flag
   over resolve-noforwards T A, H  
   s" EC" T $has? H 0=    s" EC" T $has? H 0=
   IF    IF
         over resolve-noforwards T A, H
       alias-mask flag!        alias-mask flag!
     ELSE
         T here H resolve-noforwards T A, H
   THEN    THEN
   -1 prim# +! ;    -1 prim# +! ;
 >CROSS  >CROSS
Line 2975 
Line 2980 
 : (callcm) T here 0 a, 0 a, H ;                 ' (callcm) plugin-of colonmark,  : (callcm) T here 0 a, 0 a, H ;                 ' (callcm) plugin-of colonmark,
 : (call-res) >tempdp resolved gexecute tempdp> drop ;  : (call-res) >tempdp resolved gexecute tempdp> drop ;
                                                 ' (call-res) plugin-of colon-resolve                                                  ' (call-res) plugin-of colon-resolve
   T has? ec H [IF]
   : (pprim) T @ H >signed dup 0< IF  $4000 -  ELSE
       cr ." wrong usage of (prim) "
       dup gdiscover IF  .ghost  ELSE  .  THEN  cr -1 throw  THEN
       T a, H ;                                    ' (pprim) plugin-of prim,
   [ELSE]
 : (pprim) dup 0< IF  $4000 -  ELSE  : (pprim) dup 0< IF  $4000 -  ELSE
     cr ." wrong usage of (prim) "      cr ." wrong usage of (prim) "
     dup gdiscover IF  .ghost  ELSE  .  THEN  cr -1 throw  THEN      dup gdiscover IF  .ghost  ELSE  .  THEN  cr -1 throw  THEN
     T a, H ;                                    ' (pprim) plugin-of prim,      T a, H ;                                    ' (pprim) plugin-of prim,
   [THEN]
   
 \ if we want this, we have to spilt aconstant  \ if we want this, we have to spilt aconstant
 \ and constant!!  \ and constant!!
Line 3002 
Line 3014 
 compile: g>body compile lit-perform T A, H ;compile  compile: g>body compile lit-perform T A, H ;compile
   
 Builder (Field)  Builder (Field)
 compile: g>body T @ H compile lit+ T , H ;compile  compile: g>body T @ H compile lit+ T here H reloff T , H ;compile
   
 Builder interpret/compile:  Builder interpret/compile:
 compile: does-resolved ;compile  compile: does-resolved ;compile

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help