mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-23 19:58:06 +11:00
Move core's fmt to xcomp core (high)
This commit is contained in:
parent
e2e9faef2c
commit
56af516d07
28
blk/423
28
blk/423
@ -1,14 +1,16 @@
|
||||
( LITN has to be defined after the last immediate usage of
|
||||
it to avoid bootstrapping issues )
|
||||
: LITN 32 , , ( 32 == NUMBER ) ;
|
||||
|
||||
: IMMED? 1- C@ 0x80 AND ;
|
||||
|
||||
( ';' can't have its name right away because, when created, it
|
||||
is not an IMMEDIATE yet and will not be treated properly by
|
||||
xcomp. )
|
||||
: _
|
||||
['] EXIT ,
|
||||
R> DROP ( exit : )
|
||||
; IMMEDIATE
|
||||
|
||||
999 SWAP ( stop indicator )
|
||||
DUP 0 = IF '0' EXIT THEN ( 0 is a special case )
|
||||
BEGIN
|
||||
DUP 0 = IF DROP EXIT THEN
|
||||
10 /MOD ( r q )
|
||||
SWAP '0' + SWAP ( d q )
|
||||
AGAIN ;
|
||||
: . ( n -- )
|
||||
( handle negative )
|
||||
DUP 0< IF '-' EMIT -1 * THEN
|
||||
_
|
||||
BEGIN
|
||||
DUP '9' > IF DROP EXIT THEN ( stop indicator )
|
||||
EMIT
|
||||
AGAIN ;
|
||||
|
32
blk/424
32
blk/424
@ -1,16 +1,16 @@
|
||||
XCURRENT @ ( to PSP )
|
||||
: :
|
||||
(entry)
|
||||
( We cannot use LITN as IMMEDIATE because of bootstrapping
|
||||
issues. Same thing for ",".
|
||||
32 == NUMBER 14 == compiledWord )
|
||||
[ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C,
|
||||
BEGIN
|
||||
WORD
|
||||
(find)
|
||||
( is word )
|
||||
IF DUP IMMED? IF EXECUTE ELSE , THEN
|
||||
( maybe number )
|
||||
ELSE (parse) LITN THEN
|
||||
AGAIN ;
|
||||
( from PSP ) ';' SWAP 4 - C!
|
||||
: ? @ . ;
|
||||
: _
|
||||
DUP 9 > IF 10 - 'a' +
|
||||
ELSE '0' + THEN
|
||||
;
|
||||
( For hex display, there are no negatives )
|
||||
: .x
|
||||
256 MOD ( ensure < 0x100 )
|
||||
16 /MOD ( l h )
|
||||
_ EMIT ( l )
|
||||
_ EMIT
|
||||
;
|
||||
: .X
|
||||
256 /MOD ( l h )
|
||||
.x .x
|
||||
;
|
||||
|
13
blk/425
Normal file
13
blk/425
Normal file
@ -0,0 +1,13 @@
|
||||
: _ ( a -- a+8 )
|
||||
DUP ( a a )
|
||||
':' EMIT DUP .x SPC
|
||||
4 0 DO DUP @ 256 /MOD SWAP .x .x SPC 2+ LOOP
|
||||
DROP ( a )
|
||||
8 0 DO
|
||||
C@+ DUP 0x20 0x7e =><= NOT IF DROP '.' THEN EMIT
|
||||
LOOP NL ;
|
||||
: DUMP ( n a -- )
|
||||
LF
|
||||
SWAP 8 /MOD SWAP IF 1+ THEN
|
||||
0 DO _ LOOP
|
||||
;
|
14
blk/426
Normal file
14
blk/426
Normal file
@ -0,0 +1,14 @@
|
||||
( LITN has to be defined after the last immediate usage of
|
||||
it to avoid bootstrapping issues )
|
||||
: LITN 32 , , ( 32 == NUMBER ) ;
|
||||
|
||||
: IMMED? 1- C@ 0x80 AND ;
|
||||
|
||||
( ';' can't have its name right away because, when created, it
|
||||
is not an IMMEDIATE yet and will not be treated properly by
|
||||
xcomp. )
|
||||
: _
|
||||
['] EXIT ,
|
||||
R> DROP ( exit : )
|
||||
; IMMEDIATE
|
||||
|
16
blk/427
Normal file
16
blk/427
Normal file
@ -0,0 +1,16 @@
|
||||
XCURRENT @ ( to PSP )
|
||||
: :
|
||||
(entry)
|
||||
( We cannot use LITN as IMMEDIATE because of bootstrapping
|
||||
issues. Same thing for ",".
|
||||
32 == NUMBER 14 == compiledWord )
|
||||
[ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C,
|
||||
BEGIN
|
||||
WORD
|
||||
(find)
|
||||
( is word )
|
||||
IF DUP IMMED? IF EXECUTE ELSE , THEN
|
||||
( maybe number )
|
||||
ELSE (parse) LITN THEN
|
||||
AGAIN ;
|
||||
( from PSP ) ';' SWAP 4 - C!
|
16
blk/442
16
blk/442
@ -1,16 +0,0 @@
|
||||
: _
|
||||
999 SWAP ( stop indicator )
|
||||
DUP 0 = IF '0' EXIT THEN ( 0 is a special case )
|
||||
BEGIN
|
||||
DUP 0 = IF DROP EXIT THEN
|
||||
10 /MOD ( r q )
|
||||
SWAP '0' + SWAP ( d q )
|
||||
AGAIN ;
|
||||
: . ( n -- )
|
||||
( handle negative )
|
||||
DUP 0< IF '-' EMIT -1 * THEN
|
||||
_
|
||||
BEGIN
|
||||
DUP '9' > IF DROP EXIT THEN ( stop indicator )
|
||||
EMIT
|
||||
AGAIN ;
|
16
blk/443
16
blk/443
@ -1,16 +0,0 @@
|
||||
: ? @ . ;
|
||||
: _
|
||||
DUP 9 > IF 10 - 'a' +
|
||||
ELSE '0' + THEN
|
||||
;
|
||||
( For hex display, there are no negatives )
|
||||
: .x
|
||||
256 MOD ( ensure < 0x100 )
|
||||
16 /MOD ( l h )
|
||||
_ EMIT ( l )
|
||||
_ EMIT
|
||||
;
|
||||
: .X
|
||||
256 /MOD ( l h )
|
||||
.x .x
|
||||
;
|
16
blk/444
16
blk/444
@ -1,16 +0,0 @@
|
||||
: _ ( a -- a+8 )
|
||||
DUP ( save for 2nd loop )
|
||||
':' EMIT DUP .x SPC
|
||||
4 0 DO
|
||||
DUP @ 256 /MOD SWAP
|
||||
.x .x SPC 2+
|
||||
LOOP
|
||||
DROP
|
||||
8 0 DO
|
||||
C@+
|
||||
DUP 0x20 0x7e =><= NOT
|
||||
IF DROP '.' THEN
|
||||
EMIT
|
||||
LOOP
|
||||
NL
|
||||
;
|
BIN
emul/forth.bin
BIN
emul/forth.bin
Binary file not shown.
Loading…
Reference in New Issue
Block a user