mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 10:20:55 +11:00
Compare commits
18 Commits
400ef99b54
...
61195a987d
Author | SHA1 | Date | |
---|---|---|---|
|
61195a987d | ||
|
a9cf861cfd | ||
|
f9d45f7f53 | ||
|
e984efe6c3 | ||
|
162ff2c5cb | ||
|
8ef9e7d0da | ||
|
f9c3a0444c | ||
|
49994f09ce | ||
|
8186511727 | ||
|
395eb04fac | ||
|
f6cba4b1cf | ||
|
da9f9f9899 | ||
|
d09ec0d757 | ||
|
cc4700e389 | ||
|
09cd25df29 | ||
|
9cfddea940 | ||
|
a2c258afba | ||
|
7c9d799d93 |
Binary file not shown.
@ -86,9 +86,14 @@
|
|||||||
|
|
||||||
: (sysv)
|
: (sysv)
|
||||||
(entry)
|
(entry)
|
||||||
|
( JTBL+0 == sysvarWord )
|
||||||
[ JTBL LITN ] ,
|
[ JTBL LITN ] ,
|
||||||
SYSVNXT @ ,
|
( JTBL+42 == SYSVNXT )
|
||||||
2 SYSVNXT +!
|
[ JTBL 42 + @ LITN ] DUP ( a a )
|
||||||
|
( Get new sysv addr )
|
||||||
|
@ , ( a )
|
||||||
|
( increase current sysv counter )
|
||||||
|
2 SWAP +!
|
||||||
;
|
;
|
||||||
|
|
||||||
: ."
|
: ."
|
||||||
|
@ -100,6 +100,7 @@ DUP a -- a a
|
|||||||
OVER a b -- a b a
|
OVER a b -- a b a
|
||||||
ROT a b c -- b c a
|
ROT a b c -- b c a
|
||||||
SWAP a b -- b a
|
SWAP a b -- b a
|
||||||
|
2DROP a a --
|
||||||
2DUP a b -- a b a b
|
2DUP a b -- a b a b
|
||||||
2OVER a b c d -- a b c d a b
|
2OVER a b c d -- a b c d a b
|
||||||
2SWAP a b c d -- c d a b
|
2SWAP a b c d -- c d a b
|
||||||
|
261
forth/forth.asm
261
forth/forth.asm
@ -122,6 +122,17 @@ LIT:
|
|||||||
.dw litWord
|
.dw litWord
|
||||||
.dw INITIAL_SP
|
.dw INITIAL_SP
|
||||||
.dw WORDBUF
|
.dw WORDBUF
|
||||||
|
jp flagsToBC
|
||||||
|
; 35
|
||||||
|
jp strcmp
|
||||||
|
.dw RS_ADDR
|
||||||
|
.dw CINPTR
|
||||||
|
.dw SYSVNXT
|
||||||
|
.dw FLAGS
|
||||||
|
; 46
|
||||||
|
.dw PARSEPTR
|
||||||
|
.dw HERE
|
||||||
|
.dw CURRENT
|
||||||
|
|
||||||
; *** Code ***
|
; *** Code ***
|
||||||
forthMain:
|
forthMain:
|
||||||
@ -141,20 +152,6 @@ forthMain:
|
|||||||
ld (CURRENT), hl
|
ld (CURRENT), hl
|
||||||
ld hl, HERE_INITIAL
|
ld hl, HERE_INITIAL
|
||||||
ld (HERE), hl
|
ld (HERE), hl
|
||||||
; Set up PARSEPTR
|
|
||||||
ld hl, .parseName
|
|
||||||
call find
|
|
||||||
ld (PARSEPTR), de
|
|
||||||
; Set up CINPTR
|
|
||||||
; do we have a (c<) impl?
|
|
||||||
ld hl, .cinName
|
|
||||||
call find
|
|
||||||
jr z, .skip
|
|
||||||
; no? then use KEY
|
|
||||||
ld hl, .keyName
|
|
||||||
call find
|
|
||||||
.skip:
|
|
||||||
ld (CINPTR), de
|
|
||||||
; Set up SYSVNXT
|
; Set up SYSVNXT
|
||||||
ld hl, SYSVBUF
|
ld hl, SYSVBUF
|
||||||
ld (SYSVNXT), hl
|
ld (SYSVNXT), hl
|
||||||
@ -163,36 +160,14 @@ forthMain:
|
|||||||
push de
|
push de
|
||||||
jp EXECUTE+2
|
jp EXECUTE+2
|
||||||
|
|
||||||
.parseName:
|
|
||||||
.db "(parse)", 0
|
|
||||||
.cinName:
|
|
||||||
.db "(c<)", 0
|
|
||||||
.keyName:
|
|
||||||
.db "KEY", 0
|
|
||||||
.bootName:
|
.bootName:
|
||||||
.db "BOOT", 0
|
.db "BOOT", 0
|
||||||
|
|
||||||
INTERPRET:
|
.fill 101
|
||||||
.dw compiledWord
|
|
||||||
.dw LIT
|
|
||||||
.db "INTERPRET", 0
|
|
||||||
.dw FIND_
|
|
||||||
.dw DROP
|
|
||||||
.dw EXECUTE
|
|
||||||
|
|
||||||
.fill 56
|
|
||||||
|
|
||||||
; STABLE ABI
|
; STABLE ABI
|
||||||
; Offset: 00cd
|
; Offset: 00cd
|
||||||
.out $
|
.out $
|
||||||
; *** Collapse OS lib copy ***
|
|
||||||
; In the process of Forth-ifying Collapse OS, apps will be slowly rewritten to
|
|
||||||
; Forth and the concept of ASM libs will become obsolete. To facilitate this
|
|
||||||
; transition, I make, right now, a copy of the routines actually used by Forth's
|
|
||||||
; native core. This also has the effect of reducing binary size right now and
|
|
||||||
; give us an idea of Forth's compactness.
|
|
||||||
; These routines below are copy/paste from apps/lib and stdio.
|
|
||||||
|
|
||||||
; copy (HL) into DE, then exchange the two, utilising the optimised HL instructions.
|
; copy (HL) into DE, then exchange the two, utilising the optimised HL instructions.
|
||||||
; ld must be done little endian, so least significant byte first.
|
; ld must be done little endian, so least significant byte first.
|
||||||
intoHL:
|
intoHL:
|
||||||
@ -630,23 +605,7 @@ EXIT:
|
|||||||
call popRSIP
|
call popRSIP
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
; ( R:I -- )
|
.fill 30
|
||||||
.db "QUIT"
|
|
||||||
.dw $-EXIT
|
|
||||||
.db 4
|
|
||||||
QUIT:
|
|
||||||
.dw compiledWord
|
|
||||||
.dw NUMBER
|
|
||||||
.dw 0
|
|
||||||
.dw FLAGS_
|
|
||||||
.dw STORE
|
|
||||||
.dw .private
|
|
||||||
.dw INTERPRET
|
|
||||||
|
|
||||||
.private:
|
|
||||||
.dw nativeWord
|
|
||||||
ld ix, RS_ADDR
|
|
||||||
jp next
|
|
||||||
|
|
||||||
abortUnderflow:
|
abortUnderflow:
|
||||||
ld hl, .name
|
ld hl, .name
|
||||||
@ -657,7 +616,7 @@ abortUnderflow:
|
|||||||
.db "(uflw)", 0
|
.db "(uflw)", 0
|
||||||
|
|
||||||
.db "(br)"
|
.db "(br)"
|
||||||
.dw $-QUIT
|
.dw $-EXIT
|
||||||
.db 4
|
.db 4
|
||||||
BR:
|
BR:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
@ -784,24 +743,10 @@ FIND_:
|
|||||||
push de
|
push de
|
||||||
jp next
|
jp next
|
||||||
|
|
||||||
; This is an indirect word that can be redirected through "CINPTR"
|
.fill 41
|
||||||
; code: it is replaced in readln.fs.
|
|
||||||
.db "C<"
|
|
||||||
.dw $-FIND_
|
|
||||||
.db 2
|
|
||||||
CIN:
|
|
||||||
.dw compiledWord
|
|
||||||
.dw NUMBER
|
|
||||||
.dw CINPTR
|
|
||||||
.dw FETCH
|
|
||||||
.dw EXECUTE
|
|
||||||
.dw EXIT
|
|
||||||
|
|
||||||
|
|
||||||
.fill 24
|
|
||||||
|
|
||||||
.db "NOT"
|
.db "NOT"
|
||||||
.dw $-CIN
|
.dw $-FIND_
|
||||||
.db 3
|
.db 3
|
||||||
NOT:
|
NOT:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
@ -841,178 +786,10 @@ PARSED:
|
|||||||
jp next
|
jp next
|
||||||
|
|
||||||
|
|
||||||
.fill 96
|
.fill 224
|
||||||
|
|
||||||
.db "JTBL"
|
|
||||||
.dw $-PARSED
|
|
||||||
.db 4
|
|
||||||
JTBL:
|
|
||||||
.dw sysvarWord
|
|
||||||
.dw JUMPTBL
|
|
||||||
|
|
||||||
; STABLE ABI (every sysvars)
|
|
||||||
; Offset: 05ca
|
|
||||||
.out $
|
|
||||||
.db "HERE"
|
|
||||||
.dw $-JTBL
|
|
||||||
.db 4
|
|
||||||
HERE_: ; Caution: conflicts with actual variable name
|
|
||||||
.dw sysvarWord
|
|
||||||
.dw HERE
|
|
||||||
|
|
||||||
.db "CURRENT"
|
|
||||||
.dw $-HERE_
|
|
||||||
.db 7
|
|
||||||
CURRENT_:
|
|
||||||
.dw sysvarWord
|
|
||||||
.dw CURRENT
|
|
||||||
|
|
||||||
.db "(parse*)"
|
|
||||||
.dw $-CURRENT_
|
|
||||||
.db 8
|
|
||||||
PARSEPTR_:
|
|
||||||
.dw sysvarWord
|
|
||||||
.dw PARSEPTR
|
|
||||||
|
|
||||||
.db "FLAGS"
|
|
||||||
.dw $-PARSEPTR_
|
|
||||||
.db 5
|
|
||||||
FLAGS_:
|
|
||||||
.dw sysvarWord
|
|
||||||
.dw FLAGS
|
|
||||||
|
|
||||||
.db "SYSVNXT"
|
|
||||||
.dw $-FLAGS_
|
|
||||||
.db 7
|
|
||||||
SYSVNXT_:
|
|
||||||
.dw sysvarWord
|
|
||||||
.dw SYSVNXT
|
|
||||||
|
|
||||||
; ( n a -- )
|
|
||||||
.db "!"
|
|
||||||
.dw $-SYSVNXT_
|
|
||||||
.db 1
|
|
||||||
; STABLE ABI
|
|
||||||
; Offset: 0610
|
|
||||||
.out $
|
|
||||||
STORE:
|
|
||||||
.dw nativeWord
|
|
||||||
pop iy
|
|
||||||
pop hl
|
|
||||||
call chkPS
|
|
||||||
ld (iy), l
|
|
||||||
ld (iy+1), h
|
|
||||||
jp next
|
|
||||||
|
|
||||||
; ( a -- n )
|
|
||||||
.db "@"
|
|
||||||
.dw $-STORE
|
|
||||||
.db 1
|
|
||||||
FETCH:
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
call chkPS
|
|
||||||
call intoHL
|
|
||||||
push hl
|
|
||||||
jp next
|
|
||||||
|
|
||||||
; ( a -- )
|
|
||||||
.db "DROP"
|
|
||||||
.dw $-FETCH
|
|
||||||
.db 4
|
|
||||||
; STABLE ABI
|
|
||||||
DROP:
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
jp next
|
|
||||||
|
|
||||||
; ( a b -- b a )
|
|
||||||
.db "SWAP"
|
|
||||||
.dw $-DROP
|
|
||||||
.db 4
|
|
||||||
SWAP:
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
call chkPS
|
|
||||||
ex (sp), hl
|
|
||||||
push hl
|
|
||||||
jp next
|
|
||||||
|
|
||||||
; ( a -- a a )
|
|
||||||
.db "DUP"
|
|
||||||
.dw $-SWAP
|
|
||||||
.db 3
|
|
||||||
DUP:
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
call chkPS
|
|
||||||
push hl
|
|
||||||
push hl
|
|
||||||
jp next
|
|
||||||
|
|
||||||
; ( a b -- a b a )
|
|
||||||
.db "OVER"
|
|
||||||
.dw $-DUP
|
|
||||||
.db 4
|
|
||||||
OVER:
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl ; B
|
|
||||||
pop de ; A
|
|
||||||
call chkPS
|
|
||||||
push de
|
|
||||||
push hl
|
|
||||||
push de
|
|
||||||
jp next
|
|
||||||
|
|
||||||
|
|
||||||
.fill 31
|
|
||||||
|
|
||||||
; ( a b -- c ) A + B
|
|
||||||
.db "+"
|
|
||||||
.dw $-OVER
|
|
||||||
.db 1
|
|
||||||
PLUS:
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
pop de
|
|
||||||
call chkPS
|
|
||||||
add hl, de
|
|
||||||
push hl
|
|
||||||
jp next
|
|
||||||
|
|
||||||
.fill 18
|
|
||||||
|
|
||||||
; ( a1 a2 -- b )
|
|
||||||
.db "SCMP"
|
|
||||||
.dw $-PLUS
|
|
||||||
.db 4
|
|
||||||
SCMP:
|
|
||||||
.dw nativeWord
|
|
||||||
pop de
|
|
||||||
pop hl
|
|
||||||
call chkPS
|
|
||||||
call strcmp
|
|
||||||
call flagsToBC
|
|
||||||
push bc
|
|
||||||
jp next
|
|
||||||
|
|
||||||
; ( n1 n2 -- f )
|
|
||||||
.db "CMP"
|
|
||||||
.dw $-SCMP
|
|
||||||
.db 3
|
|
||||||
CMP:
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
pop de
|
|
||||||
call chkPS
|
|
||||||
or a ; clear carry
|
|
||||||
sbc hl, de
|
|
||||||
call flagsToBC
|
|
||||||
push bc
|
|
||||||
jp next
|
|
||||||
|
|
||||||
.db "_bend"
|
.db "_bend"
|
||||||
.dw $-CMP
|
.dw $-PARSED
|
||||||
.db 5
|
.db 5
|
||||||
; Offset: 06ee
|
; Offset: 0647
|
||||||
.out $
|
.out $
|
||||||
|
108
forth/icore.fs
108
forth/icore.fs
@ -17,6 +17,12 @@
|
|||||||
properly stabilized.
|
properly stabilized.
|
||||||
4. Make sure that the words you compile are not overridden
|
4. Make sure that the words you compile are not overridden
|
||||||
by the full interpreter.
|
by the full interpreter.
|
||||||
|
5. When using words as immediates, make sure that they're
|
||||||
|
not defined in icore or, if they are, make sure that
|
||||||
|
they contain no "_c" references.
|
||||||
|
|
||||||
|
All these rules make this unit a bit messy, but this is the
|
||||||
|
price to pay for the awesomeness of self-bootstrapping.
|
||||||
)
|
)
|
||||||
|
|
||||||
( When referencing words from native defs or this very unit,
|
( When referencing words from native defs or this very unit,
|
||||||
@ -49,7 +55,34 @@
|
|||||||
, ( write! )
|
, ( write! )
|
||||||
; IMMEDIATE
|
; IMMEDIATE
|
||||||
|
|
||||||
: ABORT _c (resSP) QUIT ;
|
: JTBL 0x08 ;
|
||||||
|
|
||||||
|
: FLAGS
|
||||||
|
( JTBL+44 == FLAGS )
|
||||||
|
[ JTBL 44 + @ LITN ]
|
||||||
|
;
|
||||||
|
|
||||||
|
: (parse*)
|
||||||
|
( JTBL+46 == PARSEPTR )
|
||||||
|
[ JTBL 46 + @ LITN ]
|
||||||
|
;
|
||||||
|
|
||||||
|
: HERE
|
||||||
|
( JTBL+48 == HERE )
|
||||||
|
[ JTBL 48 + @ LITN ]
|
||||||
|
;
|
||||||
|
|
||||||
|
: CURRENT
|
||||||
|
( JTBL+50 == CURRENT )
|
||||||
|
[ JTBL 50 + @ LITN ]
|
||||||
|
;
|
||||||
|
|
||||||
|
: QUIT
|
||||||
|
0 _c FLAGS _c ! _c (resRS)
|
||||||
|
LIT< INTERPRET (find) _c DROP EXECUTE
|
||||||
|
;
|
||||||
|
|
||||||
|
: ABORT _c (resSP) _c QUIT ;
|
||||||
|
|
||||||
( This is only the "early parser" in earlier stages. No need
|
( This is only the "early parser" in earlier stages. No need
|
||||||
for an abort message )
|
for an abort message )
|
||||||
@ -60,12 +93,12 @@
|
|||||||
( a -- )
|
( a -- )
|
||||||
: (print)
|
: (print)
|
||||||
BEGIN
|
BEGIN
|
||||||
DUP ( a a )
|
_c DUP ( a a )
|
||||||
_c C@ ( a c )
|
_c C@ ( a c )
|
||||||
( exit if null )
|
( exit if null )
|
||||||
DUP NOT IF DROP DROP EXIT THEN
|
_c DUP NOT IF _c 2DROP EXIT THEN
|
||||||
_c EMIT ( a )
|
_c EMIT ( a )
|
||||||
1 + ( a+1 )
|
1 _c + ( a+1 )
|
||||||
AGAIN
|
AGAIN
|
||||||
;
|
;
|
||||||
|
|
||||||
@ -73,19 +106,24 @@
|
|||||||
LIT< stack-underflow _c (print) _c ABORT
|
LIT< stack-underflow _c (print) _c ABORT
|
||||||
;
|
;
|
||||||
|
|
||||||
|
: C<
|
||||||
|
( JTBL+40 == CINPTR )
|
||||||
|
[ JTBL 40 + @ LITN ] _c @ EXECUTE
|
||||||
|
;
|
||||||
|
|
||||||
: C,
|
: C,
|
||||||
HERE @ _c C!
|
_c HERE _c @ _c C!
|
||||||
HERE @ 1 + HERE !
|
_c HERE _c @ 1 _c + _c HERE _c !
|
||||||
;
|
;
|
||||||
|
|
||||||
( The NOT is to normalize the negative/positive numbers to 1
|
( The NOT is to normalize the negative/positive numbers to 1
|
||||||
or 0. Hadn't we wanted to normalize, we'd have written:
|
or 0. Hadn't we wanted to normalize, we'd have written:
|
||||||
32 CMP 1 - )
|
32 CMP 1 - )
|
||||||
: WS? 33 CMP 1 + NOT ;
|
: WS? 33 _c CMP 1 _c + NOT ;
|
||||||
|
|
||||||
: TOWORD
|
: TOWORD
|
||||||
BEGIN
|
BEGIN
|
||||||
C< DUP _c WS? NOT IF EXIT THEN DROP
|
_c C< _c DUP _c WS? NOT IF EXIT THEN _c DROP
|
||||||
AGAIN
|
AGAIN
|
||||||
;
|
;
|
||||||
|
|
||||||
@ -98,36 +136,30 @@
|
|||||||
BEGIN
|
BEGIN
|
||||||
( We take advantage of the fact that char MSB is
|
( We take advantage of the fact that char MSB is
|
||||||
always zero to pre-write our null-termination )
|
always zero to pre-write our null-termination )
|
||||||
OVER ! ( a )
|
_c OVER _c ! ( a )
|
||||||
1 + ( a+1 )
|
1 _c + ( a+1 )
|
||||||
C< ( a c )
|
_c C< ( a c )
|
||||||
DUP _c WS?
|
_c DUP _c WS?
|
||||||
UNTIL
|
UNTIL
|
||||||
( a this point, PS is: a WS )
|
( a this point, PS is: a WS )
|
||||||
( null-termination is already written )
|
( null-termination is already written )
|
||||||
DROP DROP
|
_c 2DROP
|
||||||
[ JTBL 30 + @ LITN ]
|
[ JTBL 30 + @ LITN ]
|
||||||
;
|
;
|
||||||
|
|
||||||
: LITN
|
|
||||||
( JTBL+24 == NUMBER )
|
|
||||||
JTBL 24 + ,
|
|
||||||
,
|
|
||||||
;
|
|
||||||
|
|
||||||
: (entry)
|
: (entry)
|
||||||
HERE @ ( h )
|
_c HERE _c @ ( h )
|
||||||
_c WORD ( h s )
|
_c WORD ( h s )
|
||||||
SCPY ( h )
|
SCPY ( h )
|
||||||
( Adjust HERE -1 because SCPY copies the null )
|
( Adjust HERE -1 because SCPY copies the null )
|
||||||
HERE @ 1 _c - ( h h' )
|
_c HERE _c @ 1 _c - ( h h' )
|
||||||
DUP HERE ! ( h h' )
|
_c DUP _c HERE _c ! ( h h' )
|
||||||
SWAP _c - ( sz )
|
_c SWAP _c - ( sz )
|
||||||
( write prev value )
|
( write prev value )
|
||||||
HERE @ CURRENT @ _c - ,
|
_c HERE _c @ _c CURRENT _c @ _c - ,
|
||||||
( write size )
|
( write size )
|
||||||
_c C,
|
_c C,
|
||||||
HERE @ CURRENT !
|
_c HERE _c @ _c CURRENT _c !
|
||||||
;
|
;
|
||||||
|
|
||||||
: INTERPRET
|
: INTERPRET
|
||||||
@ -135,20 +167,32 @@
|
|||||||
_c WORD
|
_c WORD
|
||||||
(find)
|
(find)
|
||||||
IF
|
IF
|
||||||
1 FLAGS !
|
1 _c FLAGS _c !
|
||||||
EXECUTE
|
EXECUTE
|
||||||
0 FLAGS !
|
0 _c FLAGS _c !
|
||||||
ELSE
|
ELSE
|
||||||
(parse*) @ EXECUTE
|
_c (parse*) _c @ EXECUTE
|
||||||
THEN
|
THEN
|
||||||
AGAIN
|
AGAIN
|
||||||
;
|
;
|
||||||
|
|
||||||
: BOOT
|
: BOOT
|
||||||
LIT< (c<$) (find) IF EXECUTE ELSE DROP THEN
|
LIT< (parse) (find) _c DROP _c (parse*) _c !
|
||||||
|
LIT< (c<) (find) NOT IF LIT< KEY (find) _c DROP THEN
|
||||||
|
( JTBL+40 == CINPTR )
|
||||||
|
[ JTBL 40 + @ LITN ] _c !
|
||||||
|
LIT< (c<$) (find) IF EXECUTE ELSE _c DROP THEN
|
||||||
_c INTERPRET
|
_c INTERPRET
|
||||||
;
|
;
|
||||||
|
|
||||||
|
( LITN has to be defined after the last immediate usage of
|
||||||
|
it to avoid bootstrapping issues )
|
||||||
|
: LITN
|
||||||
|
( JTBL+24 == NUMBER )
|
||||||
|
_c JTBL 24 _c + ,
|
||||||
|
,
|
||||||
|
;
|
||||||
|
|
||||||
( : and ; have to be defined last because it can't be
|
( : and ; have to be defined last because it can't be
|
||||||
executed now also, they can't have their real name
|
executed now also, they can't have their real name
|
||||||
right away )
|
right away )
|
||||||
@ -162,15 +206,15 @@
|
|||||||
_c WORD
|
_c WORD
|
||||||
(find)
|
(find)
|
||||||
( is word )
|
( is word )
|
||||||
IF DUP _c IMMED? IF EXECUTE ELSE , THEN
|
IF _c DUP _c IMMED? IF EXECUTE ELSE , THEN
|
||||||
( maybe number )
|
( maybe number )
|
||||||
ELSE (parse*) @ EXECUTE _c LITN THEN
|
ELSE _c (parse*) _c @ EXECUTE _c LITN THEN
|
||||||
AGAIN
|
AGAIN
|
||||||
; IMMEDIATE
|
; IMMEDIATE
|
||||||
|
|
||||||
: Y
|
: Y
|
||||||
['] EXIT ,
|
['] EXIT ,
|
||||||
_c R> DROP ( exit : )
|
_c R> _c DROP ( exit : )
|
||||||
; IMMEDIATE
|
; IMMEDIATE
|
||||||
|
|
||||||
( Give ":" and ";" their real name )
|
( Give ":" and ";" their real name )
|
||||||
|
@ -37,6 +37,7 @@
|
|||||||
|
|
||||||
( -- )
|
( -- )
|
||||||
: OP1 CREATE C, DOES> C@ A, ;
|
: OP1 CREATE C, DOES> C@ A, ;
|
||||||
|
0xeb OP1 EXDEHL,
|
||||||
0x76 OP1 HALT,
|
0x76 OP1 HALT,
|
||||||
0xc9 OP1 RET,
|
0xc9 OP1 RET,
|
||||||
0x17 OP1 RLA,
|
0x17 OP1 RLA,
|
||||||
|
@ -31,6 +31,38 @@ CODE ROT
|
|||||||
BC PUSHqq, ( A )
|
BC PUSHqq, ( A )
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
|
( a -- a a )
|
||||||
|
CODE DUP
|
||||||
|
HL POPqq, ( A )
|
||||||
|
chkPS,
|
||||||
|
HL PUSHqq, ( A )
|
||||||
|
HL PUSHqq, ( A )
|
||||||
|
;CODE
|
||||||
|
|
||||||
|
( a -- )
|
||||||
|
CODE DROP
|
||||||
|
HL POPqq,
|
||||||
|
;CODE
|
||||||
|
|
||||||
|
( a b -- b a )
|
||||||
|
CODE SWAP
|
||||||
|
HL POPqq, ( B )
|
||||||
|
DE POPqq, ( A )
|
||||||
|
chkPS,
|
||||||
|
HL PUSHqq, ( B )
|
||||||
|
DE PUSHqq, ( A )
|
||||||
|
;CODE
|
||||||
|
|
||||||
|
( a b -- a b a )
|
||||||
|
CODE OVER
|
||||||
|
HL POPqq, ( B )
|
||||||
|
DE POPqq, ( A )
|
||||||
|
chkPS,
|
||||||
|
DE PUSHqq, ( A )
|
||||||
|
HL PUSHqq, ( B )
|
||||||
|
DE PUSHqq, ( A )
|
||||||
|
;CODE
|
||||||
|
|
||||||
( a b -- a b a b )
|
( a b -- a b a b )
|
||||||
CODE 2DUP
|
CODE 2DUP
|
||||||
HL POPqq, ( B )
|
HL POPqq, ( B )
|
||||||
@ -42,6 +74,12 @@ CODE 2DUP
|
|||||||
HL PUSHqq, ( B )
|
HL PUSHqq, ( B )
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
|
( a b -- )
|
||||||
|
CODE 2DROP
|
||||||
|
HL POPqq,
|
||||||
|
HL POPqq,
|
||||||
|
;CODE
|
||||||
|
|
||||||
( a b c d -- a b c d a b )
|
( a b c d -- a b c d a b )
|
||||||
|
|
||||||
CODE 2OVER
|
CODE 2OVER
|
||||||
@ -111,6 +149,14 @@ CODE XOR
|
|||||||
HL PUSHqq,
|
HL PUSHqq,
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
|
CODE +
|
||||||
|
HL POPqq,
|
||||||
|
DE POPqq,
|
||||||
|
chkPS,
|
||||||
|
DE ADDHLss,
|
||||||
|
HL PUSHqq,
|
||||||
|
;CODE
|
||||||
|
|
||||||
CODE -
|
CODE -
|
||||||
DE POPqq,
|
DE POPqq,
|
||||||
HL POPqq,
|
HL POPqq,
|
||||||
@ -167,6 +213,25 @@ CODE /MOD
|
|||||||
BC PUSHqq,
|
BC PUSHqq,
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
|
CODE !
|
||||||
|
HL POPqq,
|
||||||
|
DE POPqq,
|
||||||
|
chkPS,
|
||||||
|
(HL) E LDrr,
|
||||||
|
HL INCss,
|
||||||
|
(HL) D LDrr,
|
||||||
|
;CODE
|
||||||
|
|
||||||
|
CODE @
|
||||||
|
HL POPqq,
|
||||||
|
chkPS,
|
||||||
|
E (HL) LDrr,
|
||||||
|
HL INCss,
|
||||||
|
D (HL) LDrr,
|
||||||
|
EXDEHL,
|
||||||
|
HL PUSHqq,
|
||||||
|
;CODE
|
||||||
|
|
||||||
CODE C!
|
CODE C!
|
||||||
HL POPqq,
|
HL POPqq,
|
||||||
DE POPqq,
|
DE POPqq,
|
||||||
@ -254,3 +319,31 @@ CODE (resSP)
|
|||||||
( INITIAL_SP == JTBL+28 )
|
( INITIAL_SP == JTBL+28 )
|
||||||
SP JTBL 28 + @ LDdd(nn),
|
SP JTBL 28 + @ LDdd(nn),
|
||||||
;CODE
|
;CODE
|
||||||
|
|
||||||
|
CODE (resRS)
|
||||||
|
( RS_ADDR == JTBL+38 )
|
||||||
|
IX JTBL 38 + @ LDddnn,
|
||||||
|
;CODE
|
||||||
|
|
||||||
|
CODE SCMP
|
||||||
|
DE POPqq,
|
||||||
|
HL POPqq,
|
||||||
|
chkPS,
|
||||||
|
( JTBL+35 == strcmp )
|
||||||
|
JTBL 35 + CALLnn,
|
||||||
|
( JTBL+32 == flagsToBC )
|
||||||
|
JTBL 32 + CALLnn,
|
||||||
|
BC PUSHqq,
|
||||||
|
;CODE
|
||||||
|
|
||||||
|
CODE CMP
|
||||||
|
HL POPqq,
|
||||||
|
DE POPqq,
|
||||||
|
chkPS,
|
||||||
|
A ORr, ( clear carry )
|
||||||
|
DE SBCHLss,
|
||||||
|
( JTBL+32 == flagsToBC )
|
||||||
|
JTBL 32 + CALLnn,
|
||||||
|
BC PUSHqq,
|
||||||
|
;CODE
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user