[gforth] / gforth / prims2x.fs  

gforth: gforth/prims2x.fs

Diff for /gforth/prims2x.fs between version 1.50 and 1.51

version 1.50, Sun Nov 12 14:09:45 2000 UTC version 1.51, Sun Nov 12 18:14:09 2000 UTC
Line 103 
Line 103 
   
 s" sp" save-mem s" (Cell)" make-stack data-stack  s" sp" save-mem s" (Cell)" make-stack data-stack
 s" fp" save-mem s" "       make-stack fp-stack  s" fp" save-mem s" "       make-stack fp-stack
   s" rp" save-mem s" (Cell)" make-stack return-stack
 \ !! initialize stack-in and stack-out  \ !! initialize stack-in and stack-out
   
 \ stack items  \ stack items
Line 245 
Line 246 
   
   
 (( letter (( letter || digit )) **  (( letter (( letter || digit )) **
 )) <- c-name ( -- )  )) <- c-ident ( -- )
   
   (( ` # ?? (( letter || digit || ` : )) **
   )) <- stack-ident ( -- )
   
 (( nowhitebq nowhite ** ))  (( nowhitebq nowhite ** ))
 <- name ( -- )  <- forth-ident ( -- )
   
 Variable forth-flag  Variable forth-flag
 Variable c-flag  Variable c-flag
Line 283 
Line 287 
   
 (( ` \ comment-body nl )) <- comment ( -- )  (( ` \ comment-body nl )) <- comment ( -- )
   
 (( {{ effect-in }} (( {{ start }} c-name {{ end 2 pick init-item item% %size + }} white ** )) ** {{ effect-in-end ! }}  (( {{ start }} stack-ident {{ end 2 pick init-item item% %size + }} white ** )) **
   <- stack-items
   
   (( {{ effect-in }}  stack-items {{ effect-in-end ! }}
    ` - ` - white **     ` - ` - white **
    {{ effect-out }} (( {{ start }} c-name {{ end 2 pick init-item item% %size + }} white ** )) ** {{ effect-out-end ! }}     {{ effect-out }} stack-items {{ effect-out-end ! }}
 )) <- stack-effect ( -- )  )) <- stack-effect ( -- )
   
 (( {{ s" " doc 2! s" " forth-code 2! }}  (( {{ s" " doc 2! s" " forth-code 2! }}
    (( {{ line @ name-line ! filename 2@ name-filename 2! }}     (( {{ line @ name-line ! filename 2@ name-filename 2! }}
       {{ start }} name {{ end 2dup forth-name 2! c-name 2! }}  white ++        {{ start }} forth-ident {{ end 2dup forth-name 2! c-name 2! }}  white ++
       ` ( white ** {{ start }} stack-effect {{ end stack-string 2! }} ` ) white **        ` ( white ** {{ start }} stack-effect {{ end stack-string 2! }} ` ) white **
         {{ start }} name {{ end wordset 2! }} white **          {{ start }} forth-ident {{ end wordset 2! }} white **
         (( {{ start }}  c-name {{ end c-name 2! }} )) ??  nl          (( {{ start }}  c-ident {{ end c-name 2! }} )) ??  nl
    ))     ))
    (( ` " ` "  {{ start }} (( noquote ++ ` " )) ++ {{ end 1- doc 2! }} ` " nl )) ??     (( ` " ` "  {{ start }} (( noquote ++ ` " )) ++ {{ end 1- doc 2! }} ` " nl )) ??
    {{ skipsynclines off line @ c-line ! filename 2@ c-filename 2! start }} (( nocolonnl nonl **  nl )) ** {{ end c-code 2! skipsynclines on }}     {{ skipsynclines off line @ c-line ! filename 2@ c-filename 2! start }} (( nocolonnl nonl **  nl )) ** {{ end c-code 2! skipsynclines on }}
Line 485 
Line 492 
 : declaration ( item -- )  : declaration ( item -- )
     dup item-name 2@ execute-prefix ;      dup item-name 2@ execute-prefix ;
   
   : stack-prefix ( stack "prefix" -- )
       name tuck nextname create ( stack length ) 2,
   does> ( item -- )
       2@ { item stack prefix-length }
       item item-name 2@ prefix-length /string item item-name 2!
       stack item item-stack !
       item declaration ;
   
 : declaration-list ( addr1 addr2 -- )  : declaration-list ( addr1 addr2 -- )
  swap ?do   swap ?do
   i declaration    i declaration
Line 515 
Line 530 
 s" WID"         single-type type-prefix wid  s" WID"         single-type type-prefix wid
 s" struct F83Name *"    single-type type-prefix f83name  s" struct F83Name *"    single-type type-prefix f83name
   
   return-stack stack-prefix R:
   
 set-current  set-current
   
 \ offset computation  \ offset computation
Line 538 
Line 555 
   
   
 : compute-offsets ( -- )  : compute-offsets ( -- )
     data-stack clear-stack  fp-stack clear-stack      data-stack clear-stack  fp-stack clear-stack return-stack clear-stack
     effect-in  effect-in-end  @ ['] stack-in  compute-list      effect-in  effect-in-end  @ ['] stack-in  compute-list
     effect-out effect-out-end @ ['] stack-out compute-list ;      effect-out effect-out-end @ ['] stack-out compute-list ;
   
Line 551 
Line 568 
   
 : flush-tos ( -- )  : flush-tos ( -- )
     data-stack flush-a-tos      data-stack flush-a-tos
     fp-stack   flush-a-tos ;      fp-stack     flush-a-tos
       return-stack flush-a-tos ;
   
 : fill-a-tos { stack -- }  : fill-a-tos { stack -- }
     stack stack-out @ 0= stack stack-in @ 0<> and      stack stack-out @ 0= stack stack-in @ 0<> and
Line 562 
Line 580 
   
 : fill-tos ( -- )  : fill-tos ( -- )
     fp-stack   fill-a-tos      fp-stack   fill-a-tos
     data-stack fill-a-tos ;      data-stack   fill-a-tos
       return-stack fill-a-tos ;
   
 : fetch ( addr -- )  : fetch ( addr -- )
  dup item-type @ type-fetch @ execute ;   dup item-type @ type-fetch @ execute ;
Line 581 
Line 600 
   
 : stack-pointer-updates ( -- )  : stack-pointer-updates ( -- )
     data-stack stack-pointer-update      data-stack stack-pointer-update
     fp-stack   stack-pointer-update ;      fp-stack     stack-pointer-update
       return-stack stack-pointer-update ;
   
 : store ( item -- )  : store ( item -- )
 \ f is true if the item should be stored  \ f is true if the item should be stored
Line 641 
Line 661 
     compute-offsets \ for everything else      compute-offsets \ for everything else
     data-stack stack-used? IF ." Cell *sp=SP;" cr THEN      data-stack stack-used? IF ." Cell *sp=SP;" cr THEN
     fp-stack   stack-used? IF ." Cell *fp=*FP;" cr THEN      fp-stack   stack-used? IF ." Cell *fp=*FP;" cr THEN
       return-stack stack-used? IF ." Cell *rp=*RP;" cr THEN
     flush-tos      flush-tos
     fetches      fetches
     stack-pointer-updates      stack-pointer-updates

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help