| : +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 @ + ; |
| |
|
| 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 |
| >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 @ |
| : (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] |