version 1.64, 2001/01/17 09:35:12
|
version 1.66, 2001/01/18 16:44:15
|
Line 68 variable rawinput \ pointer to next char
|
Line 68 variable rawinput \ pointer to next char
|
variable endrawinput \ pointer to the end of the input (the char after the last) |
variable endrawinput \ pointer to the end of the input (the char after the last) |
variable cookedinput \ pointer to the next char to be parsed |
variable cookedinput \ pointer to the next char to be parsed |
variable line \ line number of char pointed to by input |
variable line \ line number of char pointed to by input |
1 line ! |
variable line-start \ pointer to start of current line (for error messages) |
|
0 line ! |
2variable filename \ filename of original input file |
2variable filename \ filename of original input file |
0 0 filename 2! |
0 0 filename 2! |
2variable f-comment |
2variable f-comment |
Line 103 struct%
|
Line 104 struct%
|
cell% field item-stack \ descriptor for the stack used, 0 is default |
cell% field item-stack \ descriptor for the stack used, 0 is default |
cell% field item-type \ descriptor for the item type |
cell% field item-type \ descriptor for the item type |
cell% field item-offset \ offset in stack items, 0 for the deepest element |
cell% field item-offset \ offset in stack items, 0 for the deepest element |
|
cell% field item-first \ true if this is the first occurence of the item |
end-struct item% |
end-struct item% |
|
|
struct% |
struct% |
Line 225 print-token !
|
Line 227 print-token !
|
endif |
endif |
drop ; |
drop ; |
|
|
|
: print-error-line ( -- ) |
|
\ print the current line and position |
|
line-start @ endrawinput @ over - 2dup nl-char scan drop nip ( start end ) |
|
over - type cr |
|
line-start @ rawinput @ over - typewhite ." ^" cr ; |
|
|
: ?nextchar ( f -- ) |
: ?nextchar ( f -- ) |
?not? if |
?not? if |
filename 2@ type ." :" line @ 0 .r ." : syntax error, wrong char:" |
outfile-id >r try |
getinput . cr |
stderr to outfile-id |
rawinput @ endrawinput @ over - 100 min type cr |
filename 2@ type ." :" line @ 0 .r ." : syntax error, wrong char:" |
|
getinput . cr |
|
print-error-line |
|
0 |
|
recover endtry |
|
r> to outfile-id throw |
abort |
abort |
endif |
endif |
rawinput @ endrawinput @ <> if |
rawinput @ endrawinput @ <> if |
Line 238 print-token !
|
Line 251 print-token !
|
1 chars cookedinput +! |
1 chars cookedinput +! |
nl-char = if |
nl-char = if |
checksyncline |
checksyncline |
|
rawinput @ line-start ! |
endif |
endif |
rawinput @ c@ cookedinput @ c! |
rawinput @ c@ cookedinput @ c! |
endif ; |
endif ; |
Line 349 warnings @ [IF]
|
Line 363 warnings @ [IF]
|
: primfilter ( file-id xt -- ) |
: primfilter ( file-id xt -- ) |
\ fileid is for the input file, xt ( -- ) is for the output word |
\ fileid is for the input file, xt ( -- ) is for the output word |
output ! |
output ! |
here dup rawinput ! cookedinput ! |
here dup rawinput ! dup line-start ! cookedinput ! |
here unused rot read-file throw |
here unused rot read-file throw |
dup here + endrawinput ! |
dup here + endrawinput ! |
allot |
allot |
Line 489 does> ( item -- )
|
Line 503 does> ( item -- )
|
typ item item-type ! |
typ item item-type ! |
typ type-stack @ item item-stack !default |
typ type-stack @ item item-stack !default |
item item-name 2@ items @ search-wordlist 0= if \ new name |
item item-name 2@ items @ search-wordlist 0= if \ new name |
item item-name 2@ 2dup nextname item declare |
item item-name 2@ nextname item declare |
typ type-c-name 2@ type space type ." ;" cr |
item item-first on |
|
\ typ type-c-name 2@ type space type ." ;" cr |
else |
else |
drop |
drop |
|
item item-first off |
endif ; |
endif ; |
|
|
: execute-prefix ( item addr1 u1 -- ) |
: execute-prefix ( item addr1 u1 -- ) |
Line 519 does> ( item -- )
|
Line 535 does> ( item -- )
|
effect-in effect-in-end @ declaration-list |
effect-in effect-in-end @ declaration-list |
effect-out effect-out-end @ declaration-list ; |
effect-out effect-out-end @ declaration-list ; |
|
|
|
: print-declaration { item -- } |
|
item item-first @ if |
|
item item-type @ type-c-name 2@ type space |
|
item item-name 2@ type ." ;" cr |
|
endif ; |
|
|
|
: print-declarations ( -- ) |
|
effect-in effect-in-end @ ['] print-declaration map-items |
|
effect-out effect-out-end @ ['] print-declaration map-items ; |
|
|
: stack-prefix ( stack "prefix" -- ) |
: stack-prefix ( stack "prefix" -- ) |
name tuck nextname create ( stack length ) 2, |
name tuck nextname create ( stack length ) 2, |
does> ( item -- ) |
does> ( item -- ) |
Line 653 does> ( item -- )
|
Line 679 does> ( item -- )
|
." DEF_CA" cr |
." DEF_CA" cr |
declarations |
declarations |
compute-offsets \ for everything else |
compute-offsets \ for everything else |
|
print-declarations |
." NEXT_P0;" cr |
." NEXT_P0;" cr |
flush-tos |
flush-tos |
fetches |
fetches |
Line 740 does> ( item -- )
|
Line 767 does> ( item -- )
|
." {" cr |
." {" cr |
declarations |
declarations |
compute-offsets \ for everything else |
compute-offsets \ for everything else |
|
print-declarations |
inst-stream stack-used? IF ." Cell *ip=IP;" cr THEN |
inst-stream stack-used? IF ." Cell *ip=IP;" cr THEN |
data-stack stack-used? IF ." Cell *sp=SP;" cr THEN |
data-stack stack-used? IF ." Cell *sp=SP;" cr THEN |
fp-stack stack-used? IF ." Cell *fp=*FP;" cr THEN |
fp-stack stack-used? IF ." Cell *fp=*FP;" cr THEN |