[BACK]Return to prims2x.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/prims2x.fs between versions 1.92 and 1.94

version 1.92, 2001/03/18 11:35:35 version 1.94, 2001/03/18 18:52:55
Line 431  wordlist constant prefixes Line 431  wordlist constant prefixes
     rdrop ;      rdrop ;
   
 : type-prefix ( xt1 xt2 n stack "prefix" -- )  : type-prefix ( xt1 xt2 n stack "prefix" -- )
     create-type      get-current >r prefixes set-current
       create-type r> set-current
 does> ( item -- )  does> ( item -- )
     \ initialize item      \ initialize item
     { item typ }      { item typ }
Line 481  does> ( item -- ) Line 482  does> ( item -- )
     prim prim-effect-out prim prim-effect-out-end @ ['] print-declaration map-items ;      prim prim-effect-out prim prim-effect-out-end @ ['] print-declaration map-items ;
           
 : stack-prefix ( stack "prefix" -- )  : stack-prefix ( stack "prefix" -- )
       get-current >r prefixes set-current
     name tuck nextname create ( stack length ) 2,      name tuck nextname create ( stack length ) 2,
       r> set-current
 does> ( item -- )  does> ( item -- )
     2@ { item stack prefix-length }      2@ { item stack prefix-length }
     item item-name 2@ prefix-length /string item item-name 2!      item item-name 2@ prefix-length /string item item-name 2!
Line 493  does> ( item -- ) Line 496  does> ( item -- )
 : stack-type-name ( addr u "name" -- )  : stack-type-name ( addr u "name" -- )
     single 0 create-type ;      single 0 create-type ;
   
 s" Cell"  stack-type-name w  wordlist constant type-names \ this is here just to meet the requirement
 s" Float" stack-type-name r                      \ that a type be a word; it is never used for lookup
   
 s" IP" save-mem w make-stack inst-stream  : stack ( "name" "stack-pointer" "type" -- )
       \ define stack
       name { d: stack-name }
       name { d: stack-pointer }
       name { d: stack-type }
       get-current type-names set-current
       stack-type 2dup nextname stack-type-name
       set-current
       stack-pointer lastxt >body stack-name nextname make-stack ;
   
   stack inst-stream IP Cell
 ' inst-in-index inst-stream stack-in-index-xt !  ' inst-in-index inst-stream stack-in-index-xt !
 ' inst-stream <is> inst-stream-f  ' inst-stream <is> inst-stream-f
   
 s" sp" save-mem w make-stack data-stack   
 s" fp" save-mem r make-stack fp-stack  
 s" rp" save-mem w make-stack return-stack  
 \ !! initialize stack-in and stack-out  \ !! initialize stack-in and stack-out
   
 \ offset computation  \ offset computation
Removed from v.1.92  
changed lines
  Added in v.1.94

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