version 1.80, 1999/07/24 13:07:18
|
version 1.84, 2000/05/04 09:31:16
|
Line 787 VARIABLE env-current \ save information
|
Line 787 VARIABLE env-current \ save information
|
|
|
>ENVIRON get-order get-current swap 1+ set-order |
>ENVIRON get-order get-current swap 1+ set-order |
true SetValue compiler |
true SetValue compiler |
true SetValue cross |
true SetValue cross |
true SetValue standard-threading |
true SetValue standard-threading |
>TARGET previous |
>TARGET previous |
|
|
Line 864 float Constant tfloat
|
Line 864 float Constant tfloat
|
bits/byte Constant tbits/byte |
bits/byte Constant tbits/byte |
[THEN] |
[THEN] |
H |
H |
tbits/byte bits/byte / Constant tbyte |
tbits/char bits/byte / Constant tbyte |
|
|
|
|
\ Variables 06oct92py |
\ Variables 06oct92py |
Line 1180 CREATE Bittable 80 c, 40 c, 20 c, 10 c,
|
Line 1180 CREATE Bittable 80 c, 40 c, 20 c, 10 c,
|
: +bit ( addr n -- ) >bit over c@ or swap c! ; |
: +bit ( addr n -- ) >bit over c@ or swap c! ; |
: -bit ( addr n -- ) >bit invert over c@ and swap c! ; |
: -bit ( addr n -- ) >bit invert over c@ and swap c! ; |
|
|
: (relon) ( taddr -- ) bit$ @ swap cell/ +bit ; |
: (relon) ( taddr -- ) |
: (reloff) ( taddr -- ) bit$ @ swap cell/ -bit ; |
[ [IFDEF] fd-relocation-table ] |
|
s" +" fd-relocation-table write-file throw |
|
dup s>d <# #s #> fd-relocation-table write-line throw |
|
[ [THEN] ] |
|
bit$ @ swap cell/ +bit ; |
|
|
|
: (reloff) ( taddr -- ) |
|
[ [IFDEF] fd-relocation-table ] |
|
s" -" fd-relocation-table write-file throw |
|
dup s>d <# #s #> fd-relocation-table write-line throw |
|
[ [THEN] ] |
|
bit$ @ swap cell/ -bit ; |
|
|
: (>image) ( taddr -- absaddr ) image @ + ; |
: (>image) ( taddr -- absaddr ) image @ + ; |
|
|
Line 1222 T has? relocate H
|
Line 1233 T has? relocate H
|
: c@ ( taddr -- char ) >image Sc@ ; |
: c@ ( taddr -- char ) >image Sc@ ; |
: c! ( char taddr -- ) >image Sc! ; |
: c! ( char taddr -- ) >image Sc! ; |
: 2@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ; |
: 2@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ; |
: 2! ( x1 x2 taddr -- ) T swap over ! cell+ ! H ; |
: 2! ( x1 x2 taddr -- ) T tuck ! cell+ ! H ; |
|
|
\ Target compilation primitives 06oct92py |
\ Target compilation primitives 06oct92py |
\ included A! 16may93jaw |
\ included A! 16may93jaw |
Line 1651 NoHeaderFlag off
|
Line 1662 NoHeaderFlag off
|
base @ >r hex |
base @ >r hex |
0 swap <# 0 ?DO # LOOP #> type |
0 swap <# 0 ?DO # LOOP #> type |
r> base ! ; |
r> base ! ; |
: .sym |
|
|
: .sym ( adr len -- ) |
|
\G escapes / and \ to produce sed output |
bounds |
bounds |
DO I c@ dup |
DO I c@ dup |
CASE [char] / OF drop ." \/" ENDOF |
CASE [char] / OF drop ." \/" ENDOF |
Line 1674 NoHeaderFlag off
|
Line 1687 NoHeaderFlag off
|
>in @ T name, H >in ! |
>in @ T name, H >in ! |
THEN |
THEN |
T cfalign here H tlastcfa ! |
T cfalign here H tlastcfa ! |
\ Symbol table |
\ Old Symbol table sed-script |
\ >in @ cr ." sym:s/CFA=" there 4 0.r ." /" bl word count .sym ." /g" cr >in ! |
\ >in @ cr ." sym:s/CFA=" there 4 0.r ." /" bl word count .sym ." /g" cr >in ! |
ghost |
ghost |
|
\ output symbol table to extra file |
|
[ [IFDEF] fd-symbol-table ] |
|
base @ hex there s>d <# 8 0 DO # LOOP #> fd-symbol-table write-file throw base ! |
|
s" :" fd-symbol-table write-file throw |
|
dup >ghostname fd-symbol-table write-line throw |
|
[ [THEN] ] |
dup Last-Header-Ghost ! |
dup Last-Header-Ghost ! |
dup >magic ^imm ! \ a pointer for immediate |
dup >magic ^imm ! \ a pointer for immediate |
Already @ |
Already @ |
Line 1797 Cond: ['] T ' H alit, ;Cond
|
Line 1816 Cond: ['] T ' H alit, ;Cond
|
: (lit,) ( n -- ) compile lit T , H ; ' (lit,) IS lit, |
: (lit,) ( n -- ) compile lit T , H ; ' (lit,) IS lit, |
|
|
\ if we dont produce relocatable code alit, defaults to lit, jaw |
\ if we dont produce relocatable code alit, defaults to lit, jaw |
has? relocate |
\ this is just for convenience, so we don't have to define alit, |
|
\ seperately for embedded systems.... |
|
T has? relocate H |
[IF] |
[IF] |
: (alit,) ( n -- ) compile lit T a, H ; ' (alit,) IS alit, |
: (alit,) ( n -- ) compile lit T a, H ; ' (alit,) IS alit, |
[ELSE] |
[ELSE] |