version 1.23, 1995/02/08 13:38:50
|
version 1.27, 1995/08/27 19:56:27
|
Line 120 H
|
Line 120 H
|
-4 Constant :dovar |
-4 Constant :dovar |
-5 Constant :douser |
-5 Constant :douser |
-6 Constant :dodefer |
-6 Constant :dodefer |
-7 Constant :dodoes |
-7 Constant :dostruc |
-8 Constant :doesjump |
-8 Constant :dodoes |
|
-9 Constant :doesjump |
|
|
>CROSS |
>CROSS |
|
|
Line 287 VARIABLE Already
|
Line 288 VARIABLE Already
|
UNTIL |
UNTIL |
2 cells + count cr ." CROSS: Exists: " type 4 spaces drop |
2 cells + count cr ." CROSS: Exists: " type 4 spaces drop |
swap cell+ ! |
swap cell+ ! |
ELSE true ABORT" CROSS: Ghostnames inconsistent" |
ELSE true abort" CROSS: Ghostnames inconsistent " |
THEN ; |
THEN ; |
|
|
: resolve ( ghost tcfa -- ) |
: resolve ( ghost tcfa -- ) |
Line 360 VARIABLE ^imm
|
Line 361 VARIABLE ^imm
|
: name, ( "name" -- ) bl word count string, T cfalign H ; |
: name, ( "name" -- ) bl word count string, T cfalign H ; |
: view, ( -- ) ( dummy ) ; |
: view, ( -- ) ( dummy ) ; |
|
|
|
\ Target Document Creation (goes to crossdoc.fd) 05jul95py |
|
|
|
s" crossdoc.fd" r/w create-file throw value doc-file-id |
|
\ contains the file-id of the documentation file |
|
|
|
: \G ( -- ) |
|
source >in @ /string doc-file-id write-line throw |
|
source >in ! drop ; immediate |
|
|
|
Variable to-doc |
|
|
|
: cross-doc-entry ( -- ) |
|
to-doc @ tlast @ 0<> and \ not an anonymous (i.e. noname) header |
|
IF |
|
s" " doc-file-id write-line throw |
|
s" make-doc " doc-file-id write-file throw |
|
tlast @ >image count $1F and doc-file-id write-file throw |
|
>in @ |
|
[char] ( parse 2drop |
|
[char] ) parse doc-file-id write-file throw |
|
s" )" doc-file-id write-file throw |
|
[char] \ parse 2drop |
|
POSTPONE \g |
|
>in ! |
|
THEN to-doc on ; |
|
|
VARIABLE CreateFlag CreateFlag off |
VARIABLE CreateFlag CreateFlag off |
|
|
: (Theader ( "name" -- ghost ) T align H view, |
: (Theader ( "name" -- ghost ) T align H view, |
Line 374 VARIABLE CreateFlag CreateFlag off
|
Line 401 VARIABLE CreateFlag CreateFlag off
|
dup >magic ^imm ! \ a pointer for immediate |
dup >magic ^imm ! \ a pointer for immediate |
Already @ IF dup >end tdoes ! |
Already @ IF dup >end tdoes ! |
ELSE 0 tdoes ! THEN |
ELSE 0 tdoes ! THEN |
80 flag! ; |
80 flag! |
|
cross-doc-entry ; |
|
|
VARIABLE ;Resolve 1 cells allot |
VARIABLE ;Resolve 1 cells allot |
|
|
Line 383 VARIABLE ;Resolve 1 cells allot
|
Line 411 VARIABLE ;Resolve 1 cells allot
|
|
|
>TARGET |
>TARGET |
: Alias ( cfa -- ) \ name |
: Alias ( cfa -- ) \ name |
|
dup 0< IF to-doc off THEN |
(THeader over resolve T A, H 80 flag! ; |
(THeader over resolve T A, H 80 flag! ; |
>CROSS |
>CROSS |
|
|
Line 604 Build: ( n -- ) T A, H ;
|
Line 633 Build: ( n -- ) T A, H ;
|
by Constant |
by Constant |
Builder AConstant |
Builder AConstant |
|
|
|
Build: ( d -- ) T , , H ; |
|
DO: ( ghost -- d ) T dup cell+ @ swap @ H ;DO |
|
Builder 2Constant |
|
|
Build: T 0 , H ; |
Build: T 0 , H ; |
by Constant |
by Constant |
Builder Value |
Builder Value |
Line 613 DO: ( ghost -- ) ABORT" CROSS: Don't exe
|
Line 646 DO: ( ghost -- ) ABORT" CROSS: Don't exe
|
Builder Defer |
Builder Defer |
by Defer :dodefer resolve |
by Defer :dodefer resolve |
|
|
|
\ Sturctures 23feb95py |
|
|
|
>CROSS |
|
: nalign ( addr1 n -- addr2 ) |
|
\ addr2 is the aligned version of addr1 wrt the alignment size n |
|
1- tuck + swap invert and ; |
|
>TARGET |
|
|
|
Build: >r rot r@ nalign dup T , H ( align1 size offset ) |
|
+ swap r> nalign ; |
|
DO: T @ H + ;DO |
|
Builder Field |
|
by Field :dostruc resolve |
|
|
|
: struct T 0 1 chars H ; |
|
: end-struct T 2Constant H ; |
|
|
|
: cells: ( n -- size align ) |
|
T cells 1 cells H ; |
|
|
|
\ ' 2Constant Alias2 end-struct |
|
\ 0 1 T Chars H 2Constant struct |
|
|
\ structural conditionals 17dec92py |
\ structural conditionals 17dec92py |
|
|
>CROSS |
>CROSS |
Line 764 Cond: [ELSE] [ELSE] ;Cond
|
Line 820 Cond: [ELSE] [ELSE] ;Cond
|
|
|
bigendian Constant bigendian |
bigendian Constant bigendian |
|
|
|
Create magic s" gforth00" here over allot swap move |
|
|
|
[char] 1 bigendian + cell + magic 7 + c! |
|
|
: save-cross ( "name" -- ) |
: save-cross ( "name" -- ) |
bl parse ." Saving to " 2dup type |
bl parse ." Saving to " 2dup type |
w/o bin create-file throw >r |
w/o bin create-file throw >r |
s" gforth00" r@ write-file throw \ write magic |
magic 8 r@ write-file throw \ write magic |
image @ there r@ write-file throw \ write image |
image @ there r@ write-file throw \ write image |
bit$ @ there 1- cell>bit rshift 1+ |
bit$ @ there 1- cell>bit rshift 1+ |
r@ write-file throw \ write tags |
r@ write-file throw \ write tags |
Line 788 cell constant cell
|
Line 848 cell constant cell
|
\ include bug5.fs |
\ include bug5.fs |
\ only forth also minimal definitions |
\ only forth also minimal definitions |
|
|
: \ postpone \ ; |
: \ postpone \ ; |
: ( postpone ( ; |
: \G postpone \G ; |
|
: ( postpone ( ; |
: include bl word count included ; |
: include bl word count included ; |
: .( [char] ) parse type ; |
: .( [char] ) parse type ; |
: cr cr ; |
: cr cr ; |