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 |