[BACK]Return to cross.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/cross.fs between versions 1.19 and 1.23

version 1.19, 1995/01/19 17:47:59 version 1.23, 1995/02/08 13:38:50
Line 23 Line 23
   
 \ include other.fs       \ ansforth extentions for cross  \ 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 )  : comment? ( c-addr u -- c-addr u )
         2dup s" (" compare 0=          2dup s" (" compare 0=
         IF    postpone (          IF    postpone (
Line 39  decimal Line 43  decimal
 VARIABLE GhostNames  VARIABLE GhostNames
 0 GhostNames !  0 GhostNames !
 : GhostName ( -- addr )  : GhostName ( -- addr )
         here GhostNames @ , GhostNames ! here 0 ,      here GhostNames @ , GhostNames ! here 0 ,
         bl word count      bl word count
 \        2dup type space      \ 2dup type space
         dup c, here over chars allot swap move align ;      string, cfalign ;
   
 hex  hex
   
Line 121  H Line 125  H
   
 >CROSS  >CROSS
   
 bigendian  0 pad ! -1 pad c! pad @ 0<  bigendian
 = [IF]  [IF]
 \   : bswap ; immediate      : T!  ( n addr -- )  >r s>d r> tcell bounds swap 1-
 : T!  ( n addr -- )  >r s>d r> tcell bounds swap 1-       DO  maxbyte ud/mod rot I c!  -1 +LOOP  2drop ;
   DO  maxbyte ud/mod rot I c!  -1 +LOOP  2drop ;     : T@  ( addr -- n )  >r 0 0 r> tcell bounds
 : T@  ( addr -- n )  >r 0 0 r> tcell bounds       DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  LOOP d>s ;
   DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  LOOP d>s ;  
   
 [ELSE]  [ELSE]
 : T!  ( n addr -- )  >r s>d r> tcell bounds     : T!  ( n addr -- )  >r s>d r> tcell bounds
   DO  maxbyte ud/mod rot I c!  LOOP  2drop ;       DO  maxbyte ud/mod rot I c!  LOOP  2drop ;
 : T@  ( addr -- n )  >r 0 0 r> tcell bounds swap 1-     : 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 ;       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 ;  
 [THEN]  [THEN]
   
 \ Memory initialisation                                05dec92py  \ Memory initialisation                                05dec92py
Line 179  CREATE Bittable 80 c, 40 c, 20 c, 10 c, Line 176  CREATE Bittable 80 c, 40 c, 20 c, 10 c,
   
 : align+  ( taddr -- rest )  : align+  ( taddr -- rest )
     cell tuck 1- and - [ cell 1- ] Literal and ;      cell tuck 1- and - [ cell 1- ] Literal and ;
   : cfalign+  ( taddr -- rest )
       \ see kernal.fs:cfaligned
       float tuck 1- and - [ float 1- ] Literal and ;
   
 >TARGET  >TARGET
 : aligned ( taddr -- ta-addr )  dup align+ + ;  : aligned ( taddr -- ta-addr )  dup align+ + ;
 \ assumes cell alignment granularity (as GNU C)  \ assumes cell alignment granularity (as GNU C)
   
   : cfaligned ( taddr1 -- taddr2 )
       \ see kernal.fs
       dup cfalign+ + ;
   
 >CROSS  >CROSS
 : >image ( taddr -- absaddr )  image @ + ;  : >image ( taddr -- absaddr )  image @ + ;
 >TARGET  >TARGET
Line 202  CREATE Bittable 80 c, 40 c, 20 c, 10 c, Line 206  CREATE Bittable 80 c, 40 c, 20 c, 10 c,
 : ,     ( w -- )        T here H cell T allot  ! H ;  : ,     ( w -- )        T here H cell T allot  ! H ;
 : c,    ( char -- )     T here    1 allot c! H ;  : c,    ( char -- )     T here    1 allot c! H ;
 : align ( -- )          T here H align+ 0 ?DO  bl T c, H LOOP ;  : 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!                    dup relon T ! H ;
 : A,    ( w -- )        T here H relon T , H ;  : A,    ( w -- )        T here H relon T , H ;
Line 351  VARIABLE ^imm Line 357  VARIABLE ^imm
   
 : string,  ( addr count -- )  : string,  ( addr count -- )
   dup T c, H bounds  DO  I c@ T c, H  LOOP ;     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 ) ;  : view,   ( -- ) ( dummy ) ;
   
 VARIABLE CreateFlag CreateFlag off  VARIABLE CreateFlag CreateFlag off
Removed from v.1.19  
changed lines
  Added in v.1.23

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>