--- gforth/extend.fs 1994/02/11 16:30:46 1.1 +++ gforth/extend.fs 1994/08/31 19:42:45 1.6 @@ -10,11 +10,17 @@ decimal \ VALUE 2>R 2R> 2R@ 17may93jaw -: value ( n -- ) (constant) , ; - -: 2>r postpone >r postpone >r ; immediate restrict -: 2r> postpone r> postpone r> ; immediate restrict -: 2r@ postpone 2r> postpone 2dup postpone 2>r ; immediate restrict +: value ( n -- ) + (constant) , ; +\ !! 2value + +: 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 @@ -44,9 +50,8 @@ decimal \ UNUSED 17may93jaw -: unused forthstart dup @ over 2 cells + @ - - 512 - \ for stack - + here - ; +: unused s0 @ 512 - \ for stack + here - ; \ [COMPILE] 17may93jaw @@ -64,30 +69,31 @@ 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 : roll dup 1+ pick >r - cells sp@ 2 cells + dup cell+ rot move drop r> ; + cells sp@ cell+ dup cell+ rot move drop r> ; \ 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 !