Diff for /gforth/prims2x.fs between versions 1.81 and 1.82

version 1.81, 2001/02/23 10:43:40 version 1.82, 2001/02/24 09:58:31
Line 101  skipsynclines on Line 101  skipsynclines on
     loop      loop
     drop ;      drop ;
   
 : wordlist-insert { c-addr u wordlist xt -- }  : insert-wordlist { c-addr u wordlist xt -- }
     \ adds name "addr u" to wordlist using defining word xt      \ adds name "addr u" to wordlist using defining word xt
     \ xt may cause additional stack effects      \ xt may cause additional stack effects
     get-current >r wordlist set-current      get-current >r wordlist set-current
Line 209  struct% Line 209  struct%
     cell% 2* field prim-c-code      cell% 2* field prim-c-code
     cell% 2* field prim-forth-code      cell% 2* field prim-forth-code
     cell% 2* field prim-stack-string      cell% 2* field prim-stack-string
       cell%    field prim-num            \ ordinal number
     cell%    field prim-items-wordlist \ unique items      cell%    field prim-items-wordlist \ unique items
     item% max-effect * field prim-effect-in      item% max-effect * field prim-effect-in
     item% max-effect * field prim-effect-out      item% max-effect * field prim-effect-out
Line 242  create min-depth     max-stacks cells al Line 243  create min-depth     max-stacks cells al
 wordlist constant primitives  wordlist constant primitives
   
 : create-prim ( prim -- )  : create-prim ( prim -- )
     get-current >r      dup prim-name 2@ primitives ['] constant insert-wordlist ;
     primitives set-current  
     dup prim-name 2@ nextname constant  
     r> set-current ;  
   
 : stack-in ( stack -- addr )  : stack-in ( stack -- addr )
     \ address of number of stack items in effect in      \ address of number of stack items in effect in
Line 525  s" IP" save-mem cell-type  s" error don' Line 523  s" IP" save-mem cell-type  s" error don'
   
 : process-simple ( -- )  : process-simple ( -- )
     prim prim { W^ key } key cell      prim prim { W^ key } key cell
     combinations ['] constant wordlist-insert      combinations ['] constant insert-wordlist
     declarations compute-offsets      declarations compute-offsets
     output @ execute      output @ execute ;
     1 function-number +! ;  
   
 : flush-a-tos { stack -- }  : flush-a-tos { stack -- }
     stack stack-out @ 0<> stack stack-in @ 0= and      stack stack-out @ 0<> stack stack-in @ 0= and
Line 759  s" IP" save-mem cell-type  s" error don' Line 756  s" IP" save-mem cell-type  s" error don'
   
 [IFDEF] documentation  [IFDEF] documentation
 : register-doc ( -- )  : register-doc ( -- )
     get-current documentation set-current      prim prim-name 2@ documentation ['] create insert-wordlist
     prim prim-name 2@ nextname create  
     prim prim-name 2@ 2,      prim prim-name 2@ 2,
     prim prim-stack-string 2@ condition-stack-effect 2,      prim prim-stack-string 2@ condition-stack-effect 2,
     prim prim-wordset 2@ 2,      prim prim-wordset 2@ 2,
     prim prim-c-name 2@ condition-pronounciation 2,      prim prim-c-name 2@ condition-pronounciation 2,
     prim prim-doc 2@ 2,      prim prim-doc 2@ 2, ;
     set-current ;  
 [THEN]  [THEN]
   
   
Line 903  s" IP" save-mem cell-type  s" error don' Line 898  s" IP" save-mem cell-type  s" error don'
   
 : process-combined ( -- )  : process-combined ( -- )
     combined combined-prims num-combined @ cells      combined combined-prims num-combined @ cells
     combinations ['] constant wordlist-insert      combinations ['] constant insert-wordlist
     prim compute-effects      prim compute-effects
     prim init-effects      prim init-effects
     output-combined perform ;      output-combined perform ;
Line 982  s" IP" save-mem cell-type  s" error don' Line 977  s" IP" save-mem cell-type  s" error don'
 : output-pregen-combined ( -- )  : output-pregen-combined ( -- )
     combined-prims num-combined @ 1- cells combinations search-wordlist      combined-prims num-combined @ 1- cells combinations search-wordlist
     s" the prefix for this combination must be defined earlier" ?print-error      s" the prefix for this combination must be defined earlier" ?print-error
     execute prim-c-name 2@ type space      ." {"
     combined-prims num-combined @ 1- th @ prim-c-name 2@ type ."  -> "      execute prim-num @ 5 .r ." ,"
     combined prim-c-name 2@ type cr ;      combined-prims num-combined @ 1- th @ prim-num @ 5 .r ." ,"
       combined prim-num @ 5 .r ." }, /* "
       combined prim-c-name 2@ type ."  */"
       cr ;
   
   
 \ the parser  \ the parser
   
Line 1145  Variable c-flag Line 1144  Variable c-flag
   
 (( {{ make-prim to prim 0 to combined  (( {{ make-prim to prim 0 to combined
       line @ name-line ! filename 2@ name-filename 2!        line @ name-line ! filename 2@ name-filename 2!
         function-number @ prim prim-num !
       start }} forth-ident {{ end 2dup prim prim-name 2! prim prim-c-name 2! }}  white ++        start }} forth-ident {{ end 2dup prim prim-name 2! prim prim-c-name 2! }}  white ++
    (( simple-primitive || combined-primitive ))     (( simple-primitive || combined-primitive )) {{ 1 function-number +! }}
 )) <- primitive ( -- )  )) <- primitive ( -- )
   
 (( (( comment || primitive || nl white ** )) ** eof ))  (( (( comment || primitive || nl white ** )) ** eof ))

Removed from v.1.81  
changed lines
  Added in v.1.82


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