--- gforth/cross.fs	2002/03/21 16:35:18	1.123
+++ gforth/cross.fs	2002/03/21 17:20:38	1.125
@@ -27,7 +27,6 @@ ToDo:
   cross.fs is used seperately. jaw
 - Do we need this char translation with >address and in branchoffset? 
   (>body also affected) jaw
-- MAXU etc. can be done with dlit,
 
 [THEN]
 
@@ -1235,7 +1234,8 @@ tbits/char bits/byte /	Constant tbyte
 \ Variables                                            06oct92py
 
 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 bit$
 
@@ -1259,11 +1259,11 @@ Variable region-link            \ linked
 Variable mirrored-link          \ linked list for mirrored regions
 0 dup mirrored-link ! region-link !
 
-
-: >rname 7 cells + ;
-: >rbm   4 cells + ;
+: >rname 8 cells + ;
+: >rbm   4 cells + ; \ bitfield per cell witch indicates relocation
 : >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 + ;
 : >rdp 2 cells + ;
 : >rlen cell+ ;
@@ -1283,7 +1283,7 @@ Variable mirrored-link          \ linked
 	save-input create restore-input throw
 	here last-defined-region !
 	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
         bl word drop
 	>body (region)
@@ -1301,11 +1301,15 @@ Variable mirrored-link          \ linked
 \G returns the total area
   dup >rstart @ swap >rlen @ ;
 
-: mirrored                              
-\G mark a region as mirrored
+: mirrored ( -- )                              
+\G mark last defined region as mirrored
   mirrored-link
   align linked last-defined-region @ , ;
 
+: writeprotected
+\G mark a region as write protected
+  -1 last-defined-region @ >rrom ! ;
+
 : .addr ( u -- )
 \G prints a 16 or 32 Bit nice hex value
   base @ >r hex
@@ -1561,6 +1565,18 @@ bigendian
   \ add regions real address in our memory
   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 )
   dup
   \ find region we want to address
@@ -1609,6 +1625,7 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c,
 : (>image) ( taddr -- absaddr ) image @ + ;
 
 DEFER >image
+DEFER >ramimage
 DEFER relon
 DEFER reloff
 DEFER correcter
@@ -1618,12 +1635,23 @@ T has? relocate H
 ' (relon) IS relon
 ' (reloff) IS reloff
 ' (>regionimage) IS >image
+' (>regionimage) IS >ramimage
 [ELSE]
 ' drop IS relon
 ' drop IS reloff
 ' (>regionimage) IS >image
+' (>regionimage) IS >ramimage
 [THEN]
 
+: enforce-writeprotection ( -- )
+  ['] (>regionramimage) IS >ramimage ;
+
+: relax-writeprotection ( -- )
+  ['] (>regionimage) IS >ramimage ;
+
+: writeprotection-relaxed? ( -- )
+  ['] >ramimage >body @ ['] (>regionimage) = ;
+
 \ Target memory access                                 06oct92py
 
 : align+  ( taddr -- rest )
@@ -1641,9 +1669,9 @@ T has? relocate H
     dup cfalign+ + ;
 
 : @  ( taddr -- w )     >image S@ ;
-: !  ( w taddr -- )     >image S! ;
+: !  ( w taddr -- )     >ramimage S! ;
 : 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! ( x1 x2 taddr -- ) T tuck ! cell+ ! H ;
 
@@ -2410,35 +2438,24 @@ Cond: chars ;Cond
 
 \ some special literals					27jan97jaw
 
-\ !! Known Bug: Special Literals and plug-ins work only correct
-\ on 16 and 32 Bit Targets and 32 Bit Hosts!
-
-\ This section could be done with dlit, now. But first I need
-\ some test code JAW
-
 Cond: MAXU
-  tcell 1 cells u> 
-  IF	compile lit tcell 0 ?DO FF T c, H LOOP 
-  ELSE	ffffffff lit, THEN
+  -1 s>d dlit,
   ;Cond
 
+tcell 2 = tcell 4 = or tcell 8 = or 0=
+[IF]
+.( Warning: MINI and MAXI may not work with this host) cr
+[THEN]
+
 Cond: MINI
-  tcell 1 cells u>
-  IF	compile lit bigendian 
-  	IF	80 T c, H tcell 1 ?DO 0 T c, H LOOP 
-  	ELSE  	tcell 1 ?DO 0 T c, H LOOP 80 T c, H
-  	THEN
-  ELSE	tcell 2 = IF 8000 ELSE 80000000 THEN lit, THEN
+  tcell 2 = IF $8000 ELSE $80000000 THEN 0
+  tcell 8 = IF swap THEN dlit,
   ;Cond
  
 Cond: MAXI
- tcell 1 cells u>
- IF	compile lit bigendian 
-	IF 	7F T c, H tcell 1 ?DO FF T c, H LOOP
-	ELSE 	tcell 1 ?DO FF T c, H LOOP 7F T c, H
- 	THEN
- ELSE	tcell 2 = IF 7fff ELSE 7fffffff THEN lit, THEN
- ;Cond
+  tcell 2 = IF $7fff ELSE $7fffffff THEN 0
+  tcell 8 = IF drop -1 swap THEN dlit,
+  ;Cond
 
 >CROSS