--- gforth/extend.fs 1994/02/11 16:30:46 1.1 +++ gforth/extend.fs 1994/07/21 10:52:39 1.4 @@ -10,12 +10,22 @@ decimal \ VALUE 2>R 2R> 2R@ 17may93jaw -: value ( n -- ) (constant) , ; +: value ( n -- ) + (constant) , ; +\ !! 2value -: 2>r postpone >r postpone >r ; immediate restrict -: 2r> postpone r> postpone r> ; immediate restrict +: 2>r postpone swap postpone >r postpone >r ; immediate restrict +: 2r> postpone r> postpone r> postpone swap ; immediate restrict : 2r@ postpone 2r> postpone 2dup postpone 2>r ; immediate restrict +: 2Literal swap postpone Literal postpone Literal ; + immediate restrict + +: m*/ ( d1 n2 u3 -- dqout ) >r s>d >r abs -rot + s>d r> xor r> swap >r >r dabs rot tuck um* 2swap um* + swap >r 0 d+ r> -rot r@ um/mod -rot r> um/mod nip swap + r> IF dnegate THEN ; + \ CASE OF ENDOF ENDCASE 17may93jaw \ just as described in dpANS5 @@ -44,9 +54,8 @@ decimal \ UNUSED 17may93jaw -: unused forthstart dup @ over 2 cells + @ - - 512 - \ for stack - + here - ; +: unused s0 @ 512 - \ for stack + here - ; \ [COMPILE] 17may93jaw @@ -64,7 +73,8 @@ decimal \ ERASE 17may93jaw -: erase 0 1 chars um/mod nip 0 fill ; +: erase ( 0 1 chars um/mod nip ) 0 fill ; +: blank ( 0 1 chars um/mod nip ) bl fill ; \ ROLL 17may93jaw @@ -74,20 +84,20 @@ decimal \ SOURCE-ID SAVE-INPUT RESTORE-INPUT 11jun93jaw : source-id ( -- 0 | -1 | fileid ) - loadfile @ dup 0= IF drop linestart @ THEN ; + loadfile @ dup 0= IF drop loadline @ 0 min THEN ; : save-input ( -- x1 .. xn n ) >in @ loadfile @ ?dup - IF linestart 2@ loadline @ 6 - ELSE loadline @ blk @ linestart @ 5 THEN - >tib @ swap ; \ >tib for security + IF dup file-position throw loadline @ >tib @ 6 + #tib @ >tib +! + ELSE loadline @ blk @ linestart @ >tib @ 5 THEN +; : restore-input ( x1 .. xn n -- flag ) - 1- swap >tib @ <> IF discard true EXIT THEN - 5 = IF loadline ! 2dup linestart 2! rot dup loadfile ! + swap >tib ! + 6 = IF loadline ! rot dup loadfile ! reposition-file IF drop true EXIT THEN - refill 0= IF drop true EXIT THEN ELSE linestart ! blk ! dup loadline @ <> IF 2drop true EXIT THEN loadline !