version 1.27, 1995/01/30 18:47:52
|
version 1.28, 1995/02/06 18:14:34
|
Line 66 DOES> ( n -- ) + c@ ;
|
Line 66 DOES> ( n -- ) + c@ ;
|
bl c, |
bl c, |
LOOP ; |
LOOP ; |
|
|
|
\ !! this is machine-dependent, but works on all but the strangest machines |
|
' faligned Alias maxaligned |
|
' falign Alias maxalign |
|
|
|
\ the code field is aligned if its body is maxaligned |
|
\ !! machine-dependent and won't work if "0 >body" <> "0 >body maxaligned" |
|
' maxaligned Alias cfaligned |
|
' maxalign Alias cfalign |
|
|
: chars ; immediate |
: chars ; immediate |
|
|
: A! ( addr1 addr2 -- ) dup relon ! ; |
: A! ( addr1 addr2 -- ) dup relon ! ; |
Line 78 DOES> ( n -- ) + c@ ;
|
Line 87 DOES> ( n -- ) + c@ ;
|
|
|
\ name> found 17dec92py |
\ name> found 17dec92py |
|
|
: (name>) ( nfa -- cfa ) count $1F and + aligned ; |
: (name>) ( nfa -- cfa ) |
: name> ( nfa -- cfa ) cell+ |
count $1F and + cfaligned ; |
dup (name>) swap c@ $80 and 0= IF @ THEN ; |
: name> ( nfa -- cfa ) |
|
cell+ |
|
dup (name>) swap c@ $80 and 0= IF @ THEN ; |
|
|
: found ( nfa -- cfa n ) cell+ |
: found ( nfa -- cfa n ) cell+ |
dup c@ >r (name>) r@ $80 and 0= IF @ THEN |
dup c@ >r (name>) r@ $80 and 0= IF @ THEN |
Line 358 Defer notfound ( c-addr count -- )
|
Line 369 Defer notfound ( c-addr count -- )
|
IF |
IF |
1 and |
1 and |
IF \ not restricted to compile state? |
IF \ not restricted to compile state? |
nip nip execute EXIT |
nip nip execute EXIT |
THEN |
THEN |
-&14 throw |
-&14 throw |
THEN |
THEN |
Line 802 Avariable leave-sp leave-stack 3 cells
|
Line 813 Avariable leave-sp leave-stack 3 cells
|
defer (header) |
defer (header) |
defer header ' (header) IS header |
defer header ' (header) IS header |
|
|
|
: string, ( c-addr u -- ) |
|
\ puts down string as cstring |
|
dup c, here swap chars dup allot move ; |
|
|
: name, ( "name" -- ) |
: name, ( "name" -- ) |
name |
name |
dup $1F u> -&19 and throw ( is name too long? ) |
dup $1F u> -&19 and throw ( is name too long? ) |
dup c, here swap chars dup allot move align ; |
string, cfalign ; |
: input-stream-header ( "name" -- ) |
: input-stream-header ( "name" -- ) |
\ !! this is f83-implementation-dependent |
\ !! this is f83-implementation-dependent |
align here last ! -1 A, |
align here last ! -1 A, |
Line 824 create nextname-buffer 32 chars allot
|
Line 839 create nextname-buffer 32 chars allot
|
\ !! f83-implementation-dependent |
\ !! f83-implementation-dependent |
nextname-buffer count |
nextname-buffer count |
align here last ! -1 A, |
align here last ! -1 A, |
dup c, here swap chars dup allot move align |
string, cfalign |
$80 flag! |
$80 flag! |
input-stream ; |
input-stream ; |
|
|
Line 836 create nextname-buffer 32 chars allot
|
Line 851 create nextname-buffer 32 chars allot
|
['] nextname-header IS (header) ; |
['] nextname-header IS (header) ; |
|
|
: noname-header ( -- ) |
: noname-header ( -- ) |
0 last ! |
0 last ! cfalign |
input-stream ; |
input-stream ; |
|
|
: noname ( -- ) \ general |
: noname ( -- ) \ general |
Line 856 create nextname-buffer 32 chars allot
|
Line 871 create nextname-buffer 32 chars allot
|
Create ??? 0 , 3 c, char ? c, char ? c, char ? c, |
Create ??? 0 , 3 c, char ? c, char ? c, char ? c, |
: >name ( cfa -- nfa ) |
: >name ( cfa -- nfa ) |
$21 cell do |
$21 cell do |
dup i - count $9F and + aligned over $80 + = if |
dup i - count $9F and + cfaligned over $80 + = if |
i - cell - unloop exit |
i - cell - unloop exit |
then |
then |
cell +loop |
cell +loop |
Line 992 G forth-wordlist current T !
|
Line 1007 G forth-wordlist current T !
|
dup cell+ @ @ execute ; |
dup cell+ @ @ execute ; |
|
|
: search-wordlist ( addr count wid -- 0 / xt +-1 ) |
: search-wordlist ( addr count wid -- 0 / xt +-1 ) |
(search-wordlist) dup IF found THEN ; |
(search-wordlist) dup IF found THEN ; |
|
|
Variable warnings G -1 warnings T ! |
Variable warnings G -1 warnings T ! |
|
|