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

version 1.18, 1994/12/15 12:35:12 version 1.19, 1995/01/19 17:47:59
Line 86  Variable tdp Line 86  Variable tdp
   
 included  included
   
   \ Create additional parameters                         19jan95py
   
   T
   cell               Constant tcell
   cell<<             Constant tcell<<
   cell>bit           Constant tcell>bit
   bits/byte          Constant tbits/byte
   float              Constant tfloat
   1 bits/byte lshift Constant maxbyte
   H
   
 >TARGET  >TARGET
   
 \ Byte ordering and cell size                          06oct92py  \ Byte ordering and cell size                          06oct92py
   
 : cell+         cell + ;  : cell+         tcell + ;
 : cells         cell<< lshift ;  : cells         tcell<< lshift ;
 : chars         ;  : chars         ;
 : floats        float * ;  : floats        tfloat * ;
           
 >CROSS  >CROSS
 : cell/         cell<< rshift ;  : cell/         tcell<< rshift ;
 >TARGET  >TARGET
 20 CONSTANT bl  20 CONSTANT bl
 -1 Constant NIL  -1 Constant NIL
Line 111  included Line 122  included
 >CROSS  >CROSS
   
 bigendian  0 pad ! -1 pad c! pad @ 0<  bigendian  0 pad ! -1 pad c! pad @ 0<
 = [IF]   : bswap ; immediate   = [IF]
 [ELSE]   : bswap ( big / little -- little / big )  0  \   : bswap ; immediate 
            cell 1- FOR  bits/byte lshift over  : T!  ( n addr -- )  >r s>d r> tcell bounds swap 1-
                         [ 1 bits/byte lshift 1- ] Literal and or    DO  maxbyte ud/mod rot I c!  -1 +LOOP  2drop ;
                         swap bits/byte rshift swap  NEXT  nip ;  : 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 ;
 [THEN]  [THEN]
   
 \ Memory initialisation                                05dec92py  \ Memory initialisation                                05dec92py
Line 164  CREATE Bittable 80 c, 40 c, 20 c, 10 c, Line 187  CREATE Bittable 80 c, 40 c, 20 c, 10 c,
 >CROSS  >CROSS
 : >image ( taddr -- absaddr )  image @ + ;  : >image ( taddr -- absaddr )  image @ + ;
 >TARGET  >TARGET
 : @  ( taddr -- w )     >image @ bswap ;  : @  ( taddr -- w )     >image t@ ;
 : !  ( w taddr -- )     >r bswap r> >image ! ;  : !  ( w taddr -- )     >image t! ;
 : c@ ( taddr -- char )  >image c@ ;  : c@ ( taddr -- char )  >image c@ ;
 : c! ( char taddr -- )  >image c! ;  : c! ( char taddr -- )  >image c! ;
 : 2@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ;  : 2@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ;
Line 547  Variable tup  0 tup ! Line 570  Variable tup  0 tup !
 Variable tudp 0 tudp !  Variable tudp 0 tudp !
 : u,  ( n -- udp )  : u,  ( n -- udp )
   tup @ tudp @ + T  ! H    tup @ tudp @ + T  ! H
   tudp @ dup cell+ tudp ! ;    tudp @ dup T cell+ H tudp ! ;
 : au, ( n -- udp )  : au, ( n -- udp )
   tup @ tudp @ + T A! H    tup @ tudp @ + T A! H
   tudp @ dup cell+ tudp ! ;    tudp @ dup T cell+ H tudp ! ;
 >TARGET  >TARGET
   
 Build: T 0 u, , H ;  Build: T 0 u, , H ;
Line 751  bigendian Constant bigendian Line 774  bigendian Constant bigendian
 : * * ;         : / / ;  : * * ;         : / / ;
 : dup dup ;     : over over ;  : dup dup ;     : over over ;
 : swap swap ;   : rot rot ;  : swap swap ;   : rot rot ;
 : drop drop ;  : drop drop ;   : =   = ;
 : lshift lshift ; : 2/ 2/ ;  : lshift lshift ; : 2/ 2/ ;
   : . . ;
 cell constant cell  cell constant cell
   
 \ include bug5.fs  \ include bug5.fs

Removed from v.1.18  
changed lines
  Added in v.1.19


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