--- gforth/cross.fs 1995/01/19 17:47:59 1.19 +++ gforth/cross.fs 1995/02/08 13:38:50 1.23 @@ -1,5 +1,5 @@ \ CROSS.FS The Cross-Compiler 06oct92py -\ $Id: cross.fs,v 1.19 1995/01/19 17:47:59 pazsan Exp $ +\ $Id: cross.fs,v 1.23 1995/02/08 13:38:50 pazsan Exp $ \ Idea and implementation: Bernd Paysan (py) \ Copyright 1992-94 by the GNU Forth Development Group @@ -23,6 +23,10 @@ \ include other.fs \ ansforth extentions for cross +: string, ( c-addr u -- ) + \ puts down string as cstring + dup c, here swap chars dup allot move ; +' falign Alias cfalign : comment? ( c-addr u -- c-addr u ) 2dup s" (" compare 0= IF postpone ( @@ -39,10 +43,10 @@ decimal VARIABLE GhostNames 0 GhostNames ! : GhostName ( -- addr ) - here GhostNames @ , GhostNames ! here 0 , - bl word count -\ 2dup type space - dup c, here over chars allot swap move align ; + here GhostNames @ , GhostNames ! here 0 , + bl word count + \ 2dup type space + string, cfalign ; hex @@ -121,24 +125,17 @@ H >CROSS -bigendian 0 pad ! -1 pad c! pad @ 0< -= [IF] -\ : bswap ; immediate -: T! ( n addr -- ) >r s>d r> tcell bounds swap 1- - DO maxbyte ud/mod rot I c! -1 +LOOP 2drop ; -: T@ ( addr -- n ) >r 0 0 r> tcell bounds - DO maxbyte * swap maxbyte um* rot + swap I c@ + swap LOOP d>s ; - +bigendian +[IF] + : T! ( n addr -- ) >r s>d r> tcell bounds swap 1- + DO maxbyte ud/mod rot I c! -1 +LOOP 2drop ; + : T@ ( addr -- n ) >r 0 0 r> tcell bounds + DO maxbyte * swap maxbyte um* rot + swap I c@ + swap LOOP d>s ; [ELSE] -: T! ( n addr -- ) >r s>d r> tcell bounds - DO maxbyte ud/mod rot I c! LOOP 2drop ; -: T@ ( addr -- n ) >r 0 0 r> tcell bounds swap 1- - DO maxbyte * swap maxbyte um* rot + swap I c@ + swap -1 +LOOP d>s ; - -\ : bswap ( big / little -- little / big ) 0 -\ cell 1- FOR bits/byte lshift over -\ [ 1 bits/byte lshift 1- ] Literal and or -\ swap bits/byte rshift swap NEXT nip ; + : T! ( n addr -- ) >r s>d r> tcell bounds + DO maxbyte ud/mod rot I c! LOOP 2drop ; + : T@ ( addr -- n ) >r 0 0 r> tcell bounds swap 1- + DO maxbyte * swap maxbyte um* rot + swap I c@ + swap -1 +LOOP d>s ; [THEN] \ Memory initialisation 05dec92py @@ -179,11 +176,18 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c, : align+ ( taddr -- rest ) cell tuck 1- and - [ cell 1- ] Literal and ; +: cfalign+ ( taddr -- rest ) + \ see kernal.fs:cfaligned + float tuck 1- and - [ float 1- ] Literal and ; >TARGET : aligned ( taddr -- ta-addr ) dup align+ + ; \ assumes cell alignment granularity (as GNU C) +: cfaligned ( taddr1 -- taddr2 ) + \ see kernal.fs + dup cfalign+ + ; + >CROSS : >image ( taddr -- absaddr ) image @ + ; >TARGET @@ -202,6 +206,8 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c, : , ( w -- ) T here H cell T allot ! H ; : c, ( char -- ) T here 1 allot c! H ; : align ( -- ) T here H align+ 0 ?DO bl T c, H LOOP ; +: cfalign ( -- ) + T here H cfalign+ 0 ?DO bl T c, H LOOP ; : A! dup relon T ! H ; : A, ( w -- ) T here H relon T , H ; @@ -351,7 +357,7 @@ VARIABLE ^imm : string, ( addr count -- ) dup T c, H bounds DO I c@ T c, H LOOP ; -: name, ( "name" -- ) bl word count string, T align H ; +: name, ( "name" -- ) bl word count string, T cfalign H ; : view, ( -- ) ( dummy ) ; VARIABLE CreateFlag CreateFlag off