version 1.1, 1994/02/11 16:30:46
|
version 1.9, 1995/04/20 09:42:50
|
Line 6 decimal
|
Line 6 decimal
|
|
|
\ .( 12may93jaw |
\ .( 12may93jaw |
|
|
: .( [char] ) parse type ; |
: .( ( -- ) |
|
[char] ) parse type ; immediate |
|
|
\ VALUE 2>R 2R> 2R@ 17may93jaw |
\ VALUE 2>R 2R> 2R@ 17may93jaw |
|
|
: value ( n -- ) (constant) , ; |
: value ( n -- ) |
|
(constant) , ; |
: 2>r postpone >r postpone >r ; immediate restrict |
\ !! 2value |
: 2r> postpone r> postpone r> ; 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 |
\ CASE OF ENDOF ENDCASE 17may93jaw |
|
|
Line 44 decimal
|
Line 51 decimal
|
|
|
\ UNUSED 17may93jaw |
\ UNUSED 17may93jaw |
|
|
: unused forthstart dup @ over 2 cells + @ - |
: unused s0 @ 512 - \ for stack |
512 - \ for stack |
here - ; |
+ here - ; |
|
|
|
\ [COMPILE] 17may93jaw |
\ [COMPILE] 17may93jaw |
|
|
Line 64 decimal
|
Line 70 decimal
|
|
|
\ ERASE 17may93jaw |
\ 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 ; |
|
|
|
\ SEARCH 02sep94py |
|
|
|
: search ( buf buflen text textlen -- restbuf restlen flag ) |
|
2over 2 pick - 1+ 3 pick c@ >r |
|
BEGIN r@ scan dup WHILE |
|
>r >r 2dup r@ -text |
|
0= IF >r drop 2drop r> r> r> rot + 1- rdrop true EXIT THEN |
|
r> r> 1 /string REPEAT |
|
2drop 2drop rdrop false ; |
|
|
\ ROLL 17may93jaw |
\ ROLL 17may93jaw |
|
|
: roll dup 1+ pick >r |
: 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 SAVE-INPUT RESTORE-INPUT 11jun93jaw |
|
|
: source-id ( -- 0 | -1 | fileid ) |
: 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 ) |
: save-input ( -- x1 .. xn n ) |
>in @ |
>in @ |
loadfile @ ?dup |
loadfile @ ?dup |
IF linestart 2@ loadline @ 6 |
IF dup file-position throw loadline @ >tib @ 6 |
ELSE loadline @ blk @ linestart @ 5 THEN |
#tib @ >tib +! |
>tib @ swap ; \ >tib for security |
ELSE loadline @ blk @ linestart @ >tib @ 5 THEN |
|
; |
|
|
: restore-input ( x1 .. xn n -- flag ) |
: restore-input ( x1 .. xn n -- flag ) |
1- swap >tib @ <> IF discard true EXIT THEN |
swap >tib ! |
5 = IF loadline ! 2dup linestart 2! rot dup loadfile ! |
6 = IF loadline ! rot dup loadfile ! |
reposition-file IF drop true EXIT THEN |
reposition-file IF drop true EXIT THEN |
refill 0= IF drop true EXIT THEN |
|
ELSE linestart ! blk ! |
ELSE linestart ! blk ! |
dup loadline @ <> IF 2drop true EXIT THEN |
dup loadline @ <> IF 2drop true EXIT THEN |
loadline ! |
loadline ! |
Line 103 decimal
|
Line 120 decimal
|
variable span |
variable span |
|
|
: expect ( c-addr +len -- ) |
: expect ( c-addr +len -- ) |
0 rot over |
0 rot over |
BEGIN key decode >r 2over = r> or UNTIL |
BEGIN ( maxlen span c-addr pos1 ) |
2drop nip span ! ; |
key decode ( maxlen span c-addr pos2 flag ) |
|
>r 2over = r> or |
|
UNTIL |
|
type-rest drop |
|
2drop nip span ! ; |
|
|