| \ Variables 06oct92py |
\ Variables 06oct92py |
| |
|
| Variable image |
Variable image |
| Variable tlast TNIL tlast ! \ Last name field |
Variable (tlast) |
| |
(tlast) Value tlast TNIL tlast ! \ Last name field |
| Variable tlastcfa \ Last code field |
Variable tlastcfa \ Last code field |
| Variable bit$ |
Variable bit$ |
| |
|
| Variable mirrored-link \ linked list for mirrored regions |
Variable mirrored-link \ linked list for mirrored regions |
| 0 dup mirrored-link ! region-link ! |
0 dup mirrored-link ! region-link ! |
| |
|
| |
: >rname 8 cells + ; |
| : >rname 7 cells + ; |
: >rbm 4 cells + ; \ bitfield per cell witch indicates relocation |
| : >rbm 4 cells + ; |
|
| : >rmem 5 cells + ; |
: >rmem 5 cells + ; |
| : >rtype 6 cells + ; |
: >rtype 6 cells + ; \ field per cell witch points to a type struct |
| |
: >rrom 7 cells + ; \ a -1 indicates that this region is rom |
| : >rlink 3 cells + ; |
: >rlink 3 cells + ; |
| : >rdp 2 cells + ; |
: >rdp 2 cells + ; |
| : >rlen cell+ ; |
: >rlen cell+ ; |
| save-input create restore-input throw |
save-input create restore-input throw |
| here last-defined-region ! |
here last-defined-region ! |
| over ( startaddr ) , ( length ) , ( dp ) , |
over ( startaddr ) , ( length ) , ( dp ) , |
| region-link linked 0 , 0 , 0 , bl word count string, |
region-link linked 0 , 0 , 0 , 0 , bl word count string, |
| ELSE \ store new parameters in region |
ELSE \ store new parameters in region |
| bl word drop |
bl word drop |
| >body (region) |
>body (region) |
| \G returns the total area |
\G returns the total area |
| dup >rstart @ swap >rlen @ ; |
dup >rstart @ swap >rlen @ ; |
| |
|
| : mirrored |
: mirrored ( -- ) |
| \G mark a region as mirrored |
\G mark last defined region as mirrored |
| mirrored-link |
mirrored-link |
| align linked last-defined-region @ , ; |
align linked last-defined-region @ , ; |
| |
|
| |
: writeprotected |
| |
\G mark a region as write protected |
| |
-1 last-defined-region @ >rrom ! ; |
| |
|
| : .addr ( u -- ) |
: .addr ( u -- ) |
| \G prints a 16 or 32 Bit nice hex value |
\G prints a 16 or 32 Bit nice hex value |
| base @ >r hex |
base @ >r hex |
| \ add regions real address in our memory |
\ add regions real address in our memory |
| r> >rmem @ + ; |
r> >rmem @ + ; |
| |
|
| |
: (>regionramimage) ( taddr -- 'taddr ) |
| |
\G same as (>regionimage) but aborts if the region is rom |
| |
dup |
| |
\ find region we want to address |
| |
taddr>region-abort |
| |
>r |
| |
r@ >rrom @ ABORT" CROSS: region is write-protected!" |
| |
\ calculate offset in region |
| |
r@ >rstart @ - |
| |
\ add regions real address in our memory |
| |
r> >rmem @ + ; |
| |
|
| : (>regionbm) ( taddr -- 'taddr bitmaskbaseaddr ) |
: (>regionbm) ( taddr -- 'taddr bitmaskbaseaddr ) |
| dup |
dup |
| \ find region we want to address |
\ find region we want to address |
| : (>image) ( taddr -- absaddr ) image @ + ; |
: (>image) ( taddr -- absaddr ) image @ + ; |
| |
|
| DEFER >image |
DEFER >image |
| |
DEFER >ramimage |
| DEFER relon |
DEFER relon |
| DEFER reloff |
DEFER reloff |
| DEFER correcter |
DEFER correcter |
| ' (relon) IS relon |
' (relon) IS relon |
| ' (reloff) IS reloff |
' (reloff) IS reloff |
| ' (>regionimage) IS >image |
' (>regionimage) IS >image |
| |
' (>regionimage) IS >ramimage |
| [ELSE] |
[ELSE] |
| ' drop IS relon |
' drop IS relon |
| ' drop IS reloff |
' drop IS reloff |
| ' (>regionimage) IS >image |
' (>regionimage) IS >image |
| |
' (>regionimage) IS >ramimage |
| [THEN] |
[THEN] |
| |
|
| |
: enforce-writeprotection ( -- ) |
| |
['] (>regionramimage) IS >ramimage ; |
| |
|
| |
: relax-writeprotection ( -- ) |
| |
['] (>regionimage) IS >ramimage ; |
| |
|
| |
: writeprotection-relaxed? ( -- ) |
| |
['] >ramimage >body @ ['] (>regionimage) = ; |
| |
|
| \ Target memory access 06oct92py |
\ Target memory access 06oct92py |
| |
|
| : align+ ( taddr -- rest ) |
: align+ ( taddr -- rest ) |
| dup cfalign+ + ; |
dup cfalign+ + ; |
| |
|
| : @ ( taddr -- w ) >image S@ ; |
: @ ( taddr -- w ) >image S@ ; |
| : ! ( w taddr -- ) >image S! ; |
: ! ( w taddr -- ) >ramimage S! ; |
| : c@ ( taddr -- char ) >image Sc@ ; |
: c@ ( taddr -- char ) >image Sc@ ; |
| : c! ( char taddr -- ) >image Sc! ; |
: c! ( char taddr -- ) >ramimage Sc! ; |
| : 2@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ; |
: 2@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ; |
| : 2! ( x1 x2 taddr -- ) T tuck ! cell+ ! H ; |
: 2! ( x1 x2 taddr -- ) T tuck ! cell+ ! H ; |
| |
|