| >CROSS |
>CROSS |
| \ Header states 12dec92py |
\ Header states 12dec92py |
| |
|
| : flag! ( 8b -- ) tlast @ dup >r T c@ xor r> c! H ; |
: flag! ( w -- ) tlast @ dup >r T @ xor r> ! H ; |
| |
|
| VARIABLE ^imm |
VARIABLE ^imm |
| |
|
| |
\ !! should be target wordsize specific |
| |
$80000000 constant alias-mask |
| |
$40000000 constant immediate-mask |
| |
$20000000 constant restrict-mask |
| |
|
| >TARGET |
>TARGET |
| : immediate 40 flag! |
: immediate immediate-mask flag! |
| ^imm @ @ dup <imm> = IF drop EXIT THEN |
^imm @ @ dup <imm> = IF drop EXIT THEN |
| <res> <> ABORT" CROSS: Cannot immediate a unresolved word" |
<res> <> ABORT" CROSS: Cannot immediate a unresolved word" |
| <imm> ^imm @ ! ; |
<imm> ^imm @ ! ; |
| : restrict 20 flag! ; |
: restrict restrict-mask flag! ; |
| |
|
| : isdoer |
: isdoer |
| \G define a forth word as doer, this makes obviously only sence on |
\G define a forth word as doer, this makes obviously only sence on |
| >TARGET |
>TARGET |
| : string, ( addr count -- ) |
: string, ( addr count -- ) |
| dup T c, H bounds ?DO I c@ T c, H LOOP ; |
dup T c, H bounds ?DO I c@ T c, H LOOP ; |
| : name, ( "name" -- ) bl word count T string, cfalign H ; |
: lstring, ( addr count -- ) |
| |
dup T , H bounds ?DO I c@ T c, H LOOP ; |
| |
: name, ( "name" -- ) bl word count T lstring, cfalign H ; |
| : view, ( -- ) ( dummy ) ; |
: view, ( -- ) ( dummy ) ; |
| >CROSS |
>CROSS |
| |
|
| IF dup >end tdoes ! |
IF dup >end tdoes ! |
| ELSE 0 tdoes ! |
ELSE 0 tdoes ! |
| THEN |
THEN |
| 80 flag! |
alias-mask flag! |
| cross-doc-entry cross-tag-entry ; |
cross-doc-entry cross-tag-entry ; |
| |
|
| VARIABLE ;Resolve 1 cells allot |
VARIABLE ;Resolve 1 cells allot |
| IF |
IF |
| .sourcepos ." needs prim: " >in @ bl word count type >in ! cr |
.sourcepos ." needs prim: " >in @ bl word count type >in ! cr |
| THEN |
THEN |
| (THeader over resolve T A, H 80 flag! ; |
(THeader over resolve T A, H alias-mask flag! ; |
| : Alias: ( cfa -- ) \ name |
: Alias: ( cfa -- ) \ name |
| >in @ skip? IF 2drop EXIT THEN >in ! |
>in @ skip? IF 2drop EXIT THEN >in ! |
| dup 0< s" prims" T $has? H 0= and |
dup 0< s" prims" T $has? H 0= and |
| create-forward-warn |
create-forward-warn |
| IF ['] reswarn-forward IS resolve-warning THEN |
IF ['] reswarn-forward IS resolve-warning THEN |
| \ make Alias |
\ make Alias |
| (THeader there 0 T a, H 80 flag! ( S executed-ghost new-ghost ) |
(THeader there 0 T a, H alias-mask flag! ( S executed-ghost new-ghost ) |
| \ store poiter to code-field |
\ store poiter to code-field |
| switchram T cfalign H |
switchram T cfalign H |
| there swap T ! H |
there swap T ! H |