--- gforth/prims2x.fs 1994/09/28 17:02:50 1.9 +++ gforth/prims2x.fs 1994/11/17 15:53:19 1.11 @@ -21,7 +21,8 @@ warnings off -[IFUNDEF] vocabulary include search-order.fs [THEN] +[IFUNDEF] vocabulary include search-order.fs [THEN] +[IFUNDEF] environment? include environ.fs [THEN] include gray.fs 100 constant max-effect \ number of things on one side of a stack effect @@ -347,13 +348,13 @@ constant type-description endif rdrop ; -: single-type ( -- xt n1 n2 ) +: single-type ( -- xt1 xt2 n1 n2 ) ['] fetch-single ['] store-single 1 0 ; -: double-type ( -- xt n1 n2 ) +: double-type ( -- xt1 xt2 n1 n2 ) ['] fetch-double ['] store-double 2 0 ; -: float-type ( -- xt n1 n2 ) +: float-type ( -- xt1 xt2 n1 n2 ) ['] fetch-float ['] store-float 0 1 ; : s, ( addr u -- ) @@ -548,8 +549,19 @@ set-current effect-out effect-out-end @ .stack-list ." )" cr forth-code 2@ type cr -1 primitive-number +! - THEN -; + THEN ; + +[IFDEF] documentation +: register-doc ( -- ) + get-current documentation set-current + forth-name 2@ nextname create + forth-name 2@ 2, + stack-string 2@ 2, + wordset 2@ 2, + c-name 2@ 2, + doc 2@ 2, + set-current ; +[THEN] : process-file ( addr u xt -- ) >r r/o open-file abort" cannot open file"