version 1.6, 1998/12/08 22:03:11
|
version 1.7, 1998/12/11 22:54:31
|
Line 23
|
Line 23
|
has? os [IF] |
has? os [IF] |
0 Value outfile-id ( -- file-id ) \ gforth |
0 Value outfile-id ( -- file-id ) \ gforth |
0 Value infile-id ( -- file-id ) \ gforth |
0 Value infile-id ( -- file-id ) \ gforth |
|
|
: (type) ( c-addr u -- ) \ gforth |
: (type) ( c-addr u -- ) \ gforth |
outfile-id write-file drop \ !! use ?DUP-IF THROW ENDIF instead of DROP ? |
outfile-id write-file drop \ !! use ?DUP-IF THROW ENDIF instead of DROP ? |
; |
; |
Line 39 has? os [IF]
|
Line 39 has? os [IF]
|
infile-id key?-file ; |
infile-id key?-file ; |
[THEN] |
[THEN] |
|
|
[IFUNDEF] (type) |
undef-words |
|
|
|
Defer type ( c-addr u -- ) \ core |
: (type) BEGIN dup WHILE |
: (type) BEGIN dup WHILE |
>r dup c@ (emit) 1+ r> 1- REPEAT 2drop ; |
>r dup c@ (emit) 1+ r> 1- REPEAT 2drop ; |
[THEN] |
|
|
|
Defer type ( c-addr u -- ) \ core |
[IFDEF] (type) ' (type) IS Type [THEN] |
' (type) IS Type |
|
|
|
Defer emit ( c -- ) \ core |
Defer emit ( c -- ) \ core |
' (Emit) IS Emit |
: (emit) ( c -- ) \ gforth |
|
0 emit-file drop \ !! use ?DUP-IF THROW ENDIF instead of DROP ? |
|
; |
|
|
|
[IFDEF] (emit) ' (emit) IS emit [THEN] |
|
|
Defer key ( -- c ) \ core |
Defer key ( -- c ) \ core |
' (key) IS key |
: (key) ( -- c ) \ gforth |
|
0 key-file ; |
|
|
|
[IFDEF] (key) ' (key) IS key [THEN] |
|
|
Defer key? ( -- flag ) \ core |
Defer key? ( -- flag ) \ core |
' (key?) IS key? |
: (key?) ( -- flag ) \ gforth |
|
0 key?-file ; |
|
|
|
[IFDEF] (key?) ' (key?) IS key? [THEN] |
|
|
|
all-words |
|
|
: (.") "lit count type ; |
: (.") "lit count type ; |
: (S") "lit count ; |
: (S") "lit count ; |
Line 78 Defer key? ( -- flag ) \ core
|
Line 90 Defer key? ( -- flag ) \ core
|
[ [THEN] ] |
[ [THEN] ] |
; |
; |
|
|
1 [IF] |
: space bl emit ; |
|
has? ec [IF] |
|
: spaces 0 max 0 ?DO space LOOP ; |
|
: backspaces 0 max 0 ?DO #bs emit LOOP ; |
|
[ELSE] |
\ space spaces 21mar93py |
\ space spaces 21mar93py |
decimal |
decimal |
Create spaces ( u -- ) \ core |
Create spaces ( u -- ) \ core |
Line 92 DOES> ( u -- )
|
Line 108 DOES> ( u -- )
|
swap |
swap |
0 max 0 ?DO I' I - &80 min 2dup type +LOOP drop ; |
0 max 0 ?DO I' I - &80 min 2dup type +LOOP drop ; |
hex |
hex |
: space ( -- ) \ core |
|
1 spaces ; |
|
[ELSE] |
|
: space bl emit ; |
|
: spaces 0 max 0 ?DO space LOOP ; |
|
|
|
[THEN] |
[THEN] |
|
|