mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-23 16:28:05 +11:00
Move most of the high layer of comp core into the low one
With KEY and EMIT being switch words, most of the high layer can be defined before drivers. In addition to this change, I've compacted core blocks which were becoming quite sparse.
This commit is contained in:
Virgil Dupras
parent
8f3891f7d3
commit
705d68deec
1
blk/001
1
blk/001
@ -6,6 +6,7 @@ MASTER INDEX
|
||||
160 AVR SPI programmer
|
||||
170-259 unused 260 Cross compilation
|
||||
280 Z80 boot code 350 Core words
|
||||
400-410 unused
|
||||
410 PS/2 keyboard subsystem 418 Z80 SPI Relay driver
|
||||
420 SD Card subsystem 440 8086 boot code
|
||||
470-519 unused 520 Fonts
|
||||
|
||||
2
blk/352
2
blk/352
@ -6,4 +6,4 @@ impossible.
|
||||
|
||||
The gap between these 2 parts is the ideal place to put device
|
||||
driver code. Load the low part with "353 LOAD", the high part
|
||||
with "380 LOAD"
|
||||
with "390 LOAD"
|
||||
|
||||
2
blk/353
2
blk/353
@ -11,4 +11,4 @@
|
||||
(resRS) 0 0x08 RAM+ ! ( C<* override ) (infl)
|
||||
LIT" (main)" FIND DROP EXECUTE
|
||||
;
|
||||
1 25 LOADR+ ( xcomp core low )
|
||||
1 33 LOADR+
|
||||
|
||||
14
blk/357
Normal file
14
blk/357
Normal file
@ -0,0 +1,14 @@
|
||||
( r c -- r f )
|
||||
( Parse digit c and accumulate into result r.
|
||||
Flag f is 0 when c was a valid digit, 1 when c was WS,
|
||||
-1 when c was an invalid digit. )
|
||||
: _pdacc
|
||||
DUP 0x21 < IF DROP 1 EXIT THEN
|
||||
( parse char )
|
||||
( if bad, return "r -1" )
|
||||
'0' -
|
||||
DUP 10 < NOT IF DROP -1 EXIT THEN
|
||||
( good, add to running result )
|
||||
SWAP 10 * + ( r*10+n )
|
||||
0 ( good )
|
||||
;
|
||||
28
blk/358
28
blk/358
@ -1,14 +1,14 @@
|
||||
( r c -- r f )
|
||||
( Parse digit c and accumulate into result r.
|
||||
Flag f is 0 when c was a valid digit, 1 when c was WS,
|
||||
-1 when c was an invalid digit. )
|
||||
: _pdacc
|
||||
DUP 0x21 < IF DROP 1 EXIT THEN
|
||||
( parse char )
|
||||
( if bad, return "r -1" )
|
||||
'0' -
|
||||
DUP 10 < NOT IF DROP -1 EXIT THEN
|
||||
( good, add to running result )
|
||||
SWAP 10 * + ( r*10+n )
|
||||
0 ( good )
|
||||
;
|
||||
: _pd ( a -- n f, parse decimal )
|
||||
( We read the first char outside of the loop because it *has*
|
||||
to be nonzero, which means _pdacc *has* to return 0. )
|
||||
C@+ OVER C@ 0 ( a len firstchar startat )
|
||||
( if we have '-', we only advance. more processing later. )
|
||||
SWAP '-' = IF 1+ THEN ( a len startat )
|
||||
( We loop until _pdacc is nonzero, which means either WS or
|
||||
non-digit. 1 means WS, which means parsing was a success.
|
||||
-1 means non-digit, which means we have a non-decimal. )
|
||||
0 ROT ROT ( len ) ( startat ) DO ( a r )
|
||||
OVER I + C@ ( a r c ) _pdacc ( a r f )
|
||||
IF DROP 1- 0 UNLOOP EXIT THEN LOOP ( a r )
|
||||
( if we had '-', we need to invert result. )
|
||||
SWAP C@ '-' = IF 0 -^ THEN 1 ( r 1 ) ;
|
||||
|
||||
24
blk/359
24
blk/359
@ -1,14 +1,10 @@
|
||||
: _pd ( a -- n f, parse decimal )
|
||||
( We read the first char outside of the loop because it *has*
|
||||
to be nonzero, which means _pdacc *has* to return 0. )
|
||||
C@+ OVER C@ 0 ( a len firstchar startat )
|
||||
( if we have '-', we only advance. more processing later. )
|
||||
SWAP '-' = IF 1+ THEN ( a len startat )
|
||||
( We loop until _pdacc is nonzero, which means either WS or
|
||||
non-digit. 1 means WS, which means parsing was a success.
|
||||
-1 means non-digit, which means we have a non-decimal. )
|
||||
0 ROT ROT ( len ) ( startat ) DO ( a r )
|
||||
OVER I + C@ ( a r c ) _pdacc ( a r f )
|
||||
IF DROP 1- 0 UNLOOP EXIT THEN LOOP ( a r )
|
||||
( if we had '-', we need to invert result. )
|
||||
SWAP C@ '-' = IF 0 -^ THEN 1 ( r 1 ) ;
|
||||
( strings being sent to parse routines are always null
|
||||
terminated )
|
||||
|
||||
: _pc ( a -- n f, parse character )
|
||||
( apostrophe is ASCII 39 )
|
||||
DUP 1+ C@ 39 = OVER 3 + C@ 39 = AND ( a f )
|
||||
NOT IF 0 EXIT THEN ( a 0 )
|
||||
( surrounded by apos, good, return )
|
||||
2+ C@ 1 ( n 1 )
|
||||
;
|
||||
|
||||
24
blk/360
24
blk/360
@ -1,10 +1,16 @@
|
||||
( strings being sent to parse routines are always null
|
||||
terminated )
|
||||
|
||||
: _pc ( a -- n f, parse character )
|
||||
( apostrophe is ASCII 39 )
|
||||
DUP 1+ C@ 39 = OVER 3 + C@ 39 = AND ( a f )
|
||||
NOT IF 0 EXIT THEN ( a 0 )
|
||||
( surrounded by apos, good, return )
|
||||
2+ C@ 1 ( n 1 )
|
||||
( returns negative value on error )
|
||||
: _ ( c -- n )
|
||||
DUP '0' '9' =><= IF '0' - EXIT THEN
|
||||
DUP 'a' 'f' =><= IF 0x57 ( 'a' - 10 ) - EXIT THEN
|
||||
DROP -1 ( bad )
|
||||
;
|
||||
: _ph ( a -- n f, parse hex )
|
||||
( '0': ASCII 0x30 'x': 0x78 0x7830 )
|
||||
DUP 1+ @ 0x7830 = NOT IF 0 EXIT THEN ( a 0 )
|
||||
( We have "0x" prefix )
|
||||
DUP C@ ( a len )
|
||||
0 SWAP 1+ ( len+1 ) 3 DO ( a r )
|
||||
OVER I + C@ ( a r c ) _ ( a r n )
|
||||
DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
|
||||
SWAP 4 LSHIFT + ( a r*16+n ) LOOP
|
||||
NIP 1 ;
|
||||
|
||||
13
blk/361
13
blk/361
@ -1,16 +1,15 @@
|
||||
( returns negative value on error )
|
||||
: _ ( c -- n )
|
||||
DUP '0' '9' =><= IF '0' - EXIT THEN
|
||||
DUP 'a' 'f' =><= IF 0x57 ( 'a' - 10 ) - EXIT THEN
|
||||
DUP '0' '1' =><= IF '0' - EXIT THEN
|
||||
DROP -1 ( bad )
|
||||
;
|
||||
: _ph ( a -- n f, parse hex )
|
||||
( '0': ASCII 0x30 'x': 0x78 0x7830 )
|
||||
DUP 1+ @ 0x7830 = NOT IF 0 EXIT THEN ( a 0 )
|
||||
( We have "0x" prefix )
|
||||
: _pb ( a -- n f, parse binary )
|
||||
( '0': ASCII 0x30 'b': 0x62 0x6230 )
|
||||
DUP 1+ @ 0x6230 = NOT IF 0 EXIT THEN ( a 0 )
|
||||
( We have "0b" prefix )
|
||||
DUP C@ ( a len )
|
||||
0 SWAP 1+ ( len+1 ) 3 DO ( a r )
|
||||
OVER I + C@ ( a r c ) _ ( a r n )
|
||||
DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
|
||||
SWAP 4 LSHIFT + ( a r*16+n ) LOOP
|
||||
SWAP 1 LSHIFT + ( a r*2+n ) LOOP
|
||||
NIP 1 ;
|
||||
|
||||
21
blk/362
21
blk/362
@ -1,15 +1,8 @@
|
||||
( returns negative value on error )
|
||||
: _ ( c -- n )
|
||||
DUP '0' '1' =><= IF '0' - EXIT THEN
|
||||
DROP -1 ( bad )
|
||||
: (parse) ( a -- n )
|
||||
_pc IF EXIT THEN
|
||||
_ph IF EXIT THEN
|
||||
_pb IF EXIT THEN
|
||||
_pd IF EXIT THEN
|
||||
( nothing works )
|
||||
(wnf)
|
||||
;
|
||||
: _pb ( a -- n f, parse binary )
|
||||
( '0': ASCII 0x30 'b': 0x62 0x6230 )
|
||||
DUP 1+ @ 0x6230 = NOT IF 0 EXIT THEN ( a 0 )
|
||||
( We have "0b" prefix )
|
||||
DUP C@ ( a len )
|
||||
0 SWAP 1+ ( len+1 ) 3 DO ( a r )
|
||||
OVER I + C@ ( a r c ) _ ( a r n )
|
||||
DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
|
||||
SWAP 1 LSHIFT + ( a r*2+n ) LOOP
|
||||
NIP 1 ;
|
||||
|
||||
19
blk/363
19
blk/363
@ -1,8 +1,11 @@
|
||||
: (parse) ( a -- n )
|
||||
_pc IF EXIT THEN
|
||||
_ph IF EXIT THEN
|
||||
_pb IF EXIT THEN
|
||||
_pd IF EXIT THEN
|
||||
( nothing works )
|
||||
(wnf)
|
||||
;
|
||||
: C<? 0x06 RAM+ @ ;
|
||||
SYSVARS 0x0c + :** C<*
|
||||
: C<
|
||||
0x08 RAM+ ( C<* override ) @
|
||||
?DUP NOT IF C<* ELSE EXECUTE THEN ;
|
||||
: , H@ ! H@ 2+ HERE ! ;
|
||||
: C, H@ C! H@ 1+ HERE ! ;
|
||||
: ,"
|
||||
BEGIN
|
||||
C< DUP 34 ( ASCII " ) = IF DROP EXIT THEN C,
|
||||
AGAIN ;
|
||||
|
||||
19
blk/364
19
blk/364
@ -1,11 +1,8 @@
|
||||
: C<? 0x06 RAM+ @ ;
|
||||
SYSVARS 0x0c + :** C<*
|
||||
: C<
|
||||
0x08 RAM+ ( C<* override ) @
|
||||
?DUP NOT IF C<* ELSE EXECUTE THEN ;
|
||||
: , H@ ! H@ 2+ HERE ! ;
|
||||
: C, H@ C! H@ 1+ HERE ! ;
|
||||
: ,"
|
||||
BEGIN
|
||||
C< DUP 34 ( ASCII " ) = IF DROP EXIT THEN C,
|
||||
AGAIN ;
|
||||
: WS? 33 < ;
|
||||
: EOT? 4 = ; ( 4 == ASCII EOT, CTRL+D )
|
||||
: EOT, 4 C, ;
|
||||
|
||||
: TOWORD
|
||||
0 ( dummy ) BEGIN
|
||||
DROP C< DUP WS? NOT OVER EOT? OR
|
||||
UNTIL ;
|
||||
|
||||
21
blk/365
21
blk/365
@ -1,8 +1,13 @@
|
||||
: WS? 33 < ;
|
||||
: EOT? 4 = ; ( 4 == ASCII EOT, CTRL+D )
|
||||
: EOT, 4 C, ;
|
||||
|
||||
: TOWORD
|
||||
0 ( dummy ) BEGIN
|
||||
DROP C< DUP WS? NOT OVER EOT? OR
|
||||
UNTIL ;
|
||||
( Read word from C<, copy to WORDBUF, null-terminate, and
|
||||
return WORDBUF. )
|
||||
: _wb 0x0e RAM+ ;
|
||||
: _eot 0x0401 _wb ! _wb ;
|
||||
: WORD
|
||||
_wb 1+ TOWORD ( a c )
|
||||
DUP EOT? IF 2DROP _eot EXIT THEN
|
||||
BEGIN
|
||||
OVER C! 1+ C< ( a c )
|
||||
OVER 0x2e RAM+ = OVER WS? OR
|
||||
UNTIL ( a c )
|
||||
SWAP _wb - 1- ( ws len ) _wb C!
|
||||
EOT? IF _eot ELSE _wb THEN ;
|
||||
|
||||
26
blk/366
26
blk/366
@ -1,13 +1,13 @@
|
||||
( Read word from C<, copy to WORDBUF, null-terminate, and
|
||||
return WORDBUF. )
|
||||
: _wb 0x0e RAM+ ;
|
||||
: _eot 0x0401 _wb ! _wb ;
|
||||
: WORD
|
||||
_wb 1+ TOWORD ( a c )
|
||||
DUP EOT? IF 2DROP _eot EXIT THEN
|
||||
BEGIN
|
||||
OVER C! 1+ C< ( a c )
|
||||
OVER 0x2e RAM+ = OVER WS? OR
|
||||
UNTIL ( a c )
|
||||
SWAP _wb - 1- ( ws len ) _wb C!
|
||||
EOT? IF _eot ELSE _wb THEN ;
|
||||
: IMMEDIATE
|
||||
CURRENT @ 1-
|
||||
DUP C@ 128 OR SWAP C! ;
|
||||
: IMMED? 1- C@ 0x80 AND ;
|
||||
: '? WORD FIND ;
|
||||
: ' '? NOT IF (wnf) THEN ;
|
||||
: ROLL
|
||||
?DUP NOT IF EXIT THEN
|
||||
1+ DUP PICK ( n val )
|
||||
SWAP 2 * (roll) ( val )
|
||||
NIP ;
|
||||
: 2OVER 3 PICK 3 PICK ;
|
||||
: 2SWAP 3 ROLL 3 ROLL ;
|
||||
|
||||
14
blk/367
Normal file
14
blk/367
Normal file
@ -0,0 +1,14 @@
|
||||
: MOVE ( a1 a2 u -- )
|
||||
?DUP IF ( u ) 0 DO ( a1 a2 )
|
||||
SWAP C@+ ( a2 a1+1 x )
|
||||
ROT C!+ ( a1+1 a2+1 )
|
||||
LOOP THEN 2DROP ;
|
||||
: MOVE- ( a1 a2 u -- )
|
||||
?DUP IF TUCK + 1- ( a1 u a2+u-1 )
|
||||
ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
|
||||
ROT ( u ) 0 DO ( a2 a1 )
|
||||
C@- ( a2 a1-1 x )
|
||||
ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 )
|
||||
LOOP THEN 2DROP ;
|
||||
: MOVE, ( a u -- ) H@ OVER ALLOT SWAP MOVE ;
|
||||
: PREV 3 - DUP @ - ;
|
||||
10
blk/368
Normal file
10
blk/368
Normal file
@ -0,0 +1,10 @@
|
||||
: [entry] ( w -- )
|
||||
C@+ ( w+1 len ) TUCK MOVE, ( len )
|
||||
( write prev value )
|
||||
H@ CURRENT @ - ,
|
||||
C, ( write size )
|
||||
H@ CURRENT !
|
||||
;
|
||||
: (entry) WORD [entry] ;
|
||||
: CREATE (entry) 2 ( cellWord ) C, ;
|
||||
: VARIABLE CREATE 2 ALLOT ;
|
||||
27
blk/369
27
blk/369
@ -1,13 +1,14 @@
|
||||
: IMMEDIATE
|
||||
CURRENT @ 1-
|
||||
DUP C@ 128 OR SWAP C! ;
|
||||
: IMMED? 1- C@ 0x80 AND ;
|
||||
: '? WORD FIND ;
|
||||
: ' '? NOT IF (wnf) THEN ;
|
||||
: ROLL
|
||||
?DUP NOT IF EXIT THEN
|
||||
1+ DUP PICK ( n val )
|
||||
SWAP 2 * (roll) ( val )
|
||||
NIP ;
|
||||
: 2OVER 3 PICK 3 PICK ;
|
||||
: 2SWAP 3 ROLL 3 ROLL ;
|
||||
: WORD(
|
||||
DUP 1- C@ ( name len field )
|
||||
127 AND ( 0x7f. remove IMMEDIATE flag )
|
||||
3 + ( fixed header len )
|
||||
-
|
||||
;
|
||||
: FORGET
|
||||
' DUP ( w w )
|
||||
( HERE must be at the end of prev's word, that is, at the
|
||||
beginning of w. )
|
||||
WORD( HERE ! ( w )
|
||||
PREV CURRENT !
|
||||
;
|
||||
: EMPTY LIT" _sys" FIND IF DUP HERE ! CURRENT ! THEN ;
|
||||
|
||||
27
blk/370
27
blk/370
@ -1,14 +1,13 @@
|
||||
: MOVE ( a1 a2 u -- )
|
||||
?DUP IF ( u ) 0 DO ( a1 a2 )
|
||||
SWAP C@+ ( a2 a1+1 x )
|
||||
ROT C!+ ( a1+1 a2+1 )
|
||||
LOOP THEN 2DROP ;
|
||||
: MOVE- ( a1 a2 u -- )
|
||||
?DUP IF TUCK + 1- ( a1 u a2+u-1 )
|
||||
ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
|
||||
ROT ( u ) 0 DO ( a2 a1 )
|
||||
C@- ( a2 a1-1 x )
|
||||
ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 )
|
||||
LOOP THEN 2DROP ;
|
||||
: MOVE, ( a u -- ) H@ OVER ALLOT SWAP MOVE ;
|
||||
: PREV 3 - DUP @ - ;
|
||||
: DOES>
|
||||
( Overwrite cellWord in CURRENT )
|
||||
3 ( does ) CURRENT @ C!
|
||||
( When we have a DOES>, we forcefully place HERE to 4
|
||||
bytes after CURRENT. This allows a DOES word to use ","
|
||||
and "C," without messing everything up. )
|
||||
CURRENT @ 3 + HERE !
|
||||
( HERE points to where we should write R> )
|
||||
R> ,
|
||||
( We're done. Because we've popped RS, we'll exit parent
|
||||
definition )
|
||||
;
|
||||
: CONSTANT CREATE , DOES> @ ;
|
||||
|
||||
14
blk/371
14
blk/371
@ -1,10 +1,4 @@
|
||||
: [entry] ( w -- )
|
||||
C@+ ( w+1 len ) TUCK MOVE, ( len )
|
||||
( write prev value )
|
||||
H@ CURRENT @ - ,
|
||||
C, ( write size )
|
||||
H@ CURRENT !
|
||||
;
|
||||
: (entry) WORD [entry] ;
|
||||
: CREATE (entry) 2 ( cellWord ) C, ;
|
||||
: VARIABLE CREATE 2 ALLOT ;
|
||||
: [IF]
|
||||
IF EXIT THEN
|
||||
LIT" [THEN]" BEGIN DUP WORD S= UNTIL DROP ;
|
||||
: [THEN] ;
|
||||
|
||||
24
blk/372
24
blk/372
@ -1,14 +1,10 @@
|
||||
: WORD(
|
||||
DUP 1- C@ ( name len field )
|
||||
127 AND ( 0x7f. remove IMMEDIATE flag )
|
||||
3 + ( fixed header len )
|
||||
-
|
||||
;
|
||||
: FORGET
|
||||
' DUP ( w w )
|
||||
( HERE must be at the end of prev's word, that is, at the
|
||||
beginning of w. )
|
||||
WORD( HERE ! ( w )
|
||||
PREV CURRENT !
|
||||
;
|
||||
: EMPTY LIT" _sys" FIND IF DUP HERE ! CURRENT ! THEN ;
|
||||
( n -- Fetches block n and write it to BLK( )
|
||||
: BLK@* 0x34 RAM+ ;
|
||||
( n -- Write back BLK( to storage at block n )
|
||||
: BLK!* 0x36 RAM+ ;
|
||||
( Current blk pointer in ( )
|
||||
: BLK> 0x38 RAM+ ;
|
||||
( Whether buffer is dirty )
|
||||
: BLKDTY 0x3a RAM+ ;
|
||||
: BLK( 0x3c RAM+ @ ;
|
||||
: BLK) BLK( 1024 + ;
|
||||
|
||||
20
blk/373
20
blk/373
@ -1,13 +1,9 @@
|
||||
: DOES>
|
||||
( Overwrite cellWord in CURRENT )
|
||||
3 ( does ) CURRENT @ C!
|
||||
( When we have a DOES>, we forcefully place HERE to 4
|
||||
bytes after CURRENT. This allows a DOES word to use ","
|
||||
and "C," without messing everything up. )
|
||||
CURRENT @ 3 + HERE !
|
||||
( HERE points to where we should write R> )
|
||||
R> ,
|
||||
( We're done. Because we've popped RS, we'll exit parent
|
||||
definition )
|
||||
: BLK$
|
||||
H@ 0x3c ( BLK(* ) RAM+ !
|
||||
1024 ALLOT
|
||||
( LOAD detects end of block with ASCII EOT. This is why
|
||||
we write it there. )
|
||||
EOT,
|
||||
0 BLKDTY !
|
||||
-1 BLK> !
|
||||
;
|
||||
: CONSTANT CREATE , DOES> @ ;
|
||||
|
||||
18
blk/374
18
blk/374
@ -1,4 +1,14 @@
|
||||
: [IF]
|
||||
IF EXIT THEN
|
||||
LIT" [THEN]" BEGIN DUP WORD S= UNTIL DROP ;
|
||||
: [THEN] ;
|
||||
: BLK! ( -- )
|
||||
BLK> @ BLK!* @ EXECUTE
|
||||
0 BLKDTY ! ;
|
||||
: FLUSH BLKDTY @ IF BLK! THEN ;
|
||||
: BLK@ ( n -- )
|
||||
DUP BLK> @ = IF DROP EXIT THEN
|
||||
FLUSH DUP BLK> ! BLK@* @ EXECUTE ;
|
||||
: BLK!! 1 BLKDTY ! ;
|
||||
: WIPE BLK( 1024 0 FILL BLK!! ;
|
||||
: WIPED? ( -- f )
|
||||
1 ( f ) BLK) BLK( DO
|
||||
I C@ IF DROP 0 ( f ) LEAVE THEN LOOP ;
|
||||
: COPY ( src dst -- )
|
||||
FLUSH SWAP BLK@ BLK> ! BLK! ;
|
||||
|
||||
16
blk/375
Normal file
16
blk/375
Normal file
@ -0,0 +1,16 @@
|
||||
: _
|
||||
999 SWAP ( stop indicator )
|
||||
BEGIN
|
||||
?DUP NOT IF EXIT THEN
|
||||
10 /MOD ( r q )
|
||||
SWAP '0' + SWAP ( d q )
|
||||
AGAIN ;
|
||||
: . ( n -- )
|
||||
?DUP NOT IF '0' EMIT EXIT THEN ( 0 is a special case )
|
||||
( handle negative )
|
||||
DUP 0< IF '-' EMIT -1 * THEN
|
||||
_
|
||||
BEGIN
|
||||
DUP '9' > IF DROP EXIT THEN ( stop indicator )
|
||||
EMIT
|
||||
AGAIN ;
|
||||
26
blk/376
26
blk/376
@ -1,10 +1,16 @@
|
||||
( n -- Fetches block n and write it to BLK( )
|
||||
: BLK@* 0x34 RAM+ ;
|
||||
( n -- Write back BLK( to storage at block n )
|
||||
: BLK!* 0x36 RAM+ ;
|
||||
( Current blk pointer in ( )
|
||||
: BLK> 0x38 RAM+ ;
|
||||
( Whether buffer is dirty )
|
||||
: BLKDTY 0x3a RAM+ ;
|
||||
: BLK( 0x3c RAM+ @ ;
|
||||
: BLK) BLK( 1024 + ;
|
||||
: ? @ . ;
|
||||
: _
|
||||
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
|
||||
;
|
||||
|
||||
20
blk/377
20
blk/377
@ -1,9 +1,13 @@
|
||||
: BLK$
|
||||
H@ 0x3c ( BLK(* ) RAM+ !
|
||||
1024 ALLOT
|
||||
( LOAD detects end of block with ASCII EOT. This is why
|
||||
we write it there. )
|
||||
EOT,
|
||||
0 BLKDTY !
|
||||
-1 BLK> !
|
||||
: _ ( 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
|
||||
;
|
||||
|
||||
27
blk/378
27
blk/378
@ -1,14 +1,13 @@
|
||||
: BLK! ( -- )
|
||||
BLK> @ BLK!* @ EXECUTE
|
||||
0 BLKDTY ! ;
|
||||
: FLUSH BLKDTY @ IF BLK! THEN ;
|
||||
: BLK@ ( n -- )
|
||||
DUP BLK> @ = IF DROP EXIT THEN
|
||||
FLUSH DUP BLK> ! BLK@* @ EXECUTE ;
|
||||
: BLK!! 1 BLKDTY ! ;
|
||||
: WIPE BLK( 1024 0 FILL BLK!! ;
|
||||
: WIPED? ( -- f )
|
||||
1 ( f ) BLK) BLK( DO
|
||||
I C@ IF DROP 0 ( f ) LEAVE THEN LOOP ;
|
||||
: COPY ( src dst -- )
|
||||
FLUSH SWAP BLK@ BLK> ! BLK! ;
|
||||
( handle backspace: go back one char in IN>, if possible, then
|
||||
emit BS + SPC + BS )
|
||||
: _bs
|
||||
( already at IN( ? )
|
||||
IN> @ IN( = IF EXIT THEN
|
||||
IN> @ 1- IN> !
|
||||
BS SPC BS
|
||||
;
|
||||
( del is same as backspace )
|
||||
: BS? DUP 0x7f = SWAP 0x8 = OR ;
|
||||
SYSVARS 0x55 + :** KEY
|
||||
( cont.: read one char into input buffer and returns whether we
|
||||
should continue, that is, whether CR was not met. )
|
||||
|
||||
17
blk/380
17
blk/380
@ -1 +1,16 @@
|
||||
1 20 LOADR+ ( xcomp core high )
|
||||
( Read one line in input buffer and make IN> point to it )
|
||||
: (rdln)
|
||||
( EOT or less triggers line flush )
|
||||
(infl) BEGIN (rdlnc) 5 < UNTIL
|
||||
LF IN( IN> ! ;
|
||||
( And finally, implement C<* )
|
||||
: RDLN<
|
||||
IN> @ C@
|
||||
DUP IF ( not EOL? good, inc and return )
|
||||
1 IN> +!
|
||||
ELSE ( EOL ? readline. we still return null though )
|
||||
(rdln)
|
||||
THEN
|
||||
( update C<? flag )
|
||||
IN> @ C@ 0 > 0x06 RAM+ ! ( 06 == C<? )
|
||||
;
|
||||
|
||||
10
blk/381
Normal file
10
blk/381
Normal file
@ -0,0 +1,10 @@
|
||||
( Initializes the readln subsystem )
|
||||
: RDLN$
|
||||
H@ 0x32 ( IN(* ) RAM+ !
|
||||
( plus 2 for extra bytes after buffer: 1 for
|
||||
the last typed 0x0a and one for the following NULL. )
|
||||
IN) IN( - ALLOT
|
||||
(infl)
|
||||
['] RDLN< ['] C<* **!
|
||||
1 0x06 RAM+ ! ( 06 == C<? )
|
||||
;
|
||||
11
blk/382
Normal file
11
blk/382
Normal file
@ -0,0 +1,11 @@
|
||||
: .2 DUP 10 < IF SPC THEN . ;
|
||||
: LIST
|
||||
BLK@
|
||||
16 0 DO
|
||||
I 1+ .2 SPC
|
||||
64 I * BLK( + DUP 64 + SWAP DO
|
||||
I C@ 0x20 MAX EMIT
|
||||
LOOP
|
||||
NL
|
||||
LOOP
|
||||
;
|
||||
27
blk/383
27
blk/383
@ -1,16 +1,15 @@
|
||||
: _
|
||||
999 SWAP ( stop indicator )
|
||||
: INTERPRET
|
||||
BEGIN
|
||||
?DUP NOT IF EXIT THEN
|
||||
10 /MOD ( r q )
|
||||
SWAP '0' + SWAP ( d q )
|
||||
AGAIN ;
|
||||
: . ( n -- )
|
||||
?DUP NOT IF '0' EMIT EXIT THEN ( 0 is a special case )
|
||||
( handle negative )
|
||||
DUP 0< IF '-' EMIT -1 * THEN
|
||||
_
|
||||
BEGIN
|
||||
DUP '9' > IF DROP EXIT THEN ( stop indicator )
|
||||
EMIT
|
||||
WORD DUP @ 0x0401 = ( EOT ) IF DROP EXIT THEN
|
||||
FIND NOT IF (parse) ELSE EXECUTE THEN
|
||||
C<? NOT IF SPC LIT" ok" (print) NL THEN
|
||||
AGAIN ;
|
||||
( Read from BOOT C< PTR and inc it. )
|
||||
: (boot<)
|
||||
( 2e == BOOT C< PTR )
|
||||
0x2e ( BOOT C< PTR ) RAM+ @ DUP C@ ( a c )
|
||||
SWAP 1 + 0x2e RAM+ ! ( c ) ;
|
||||
( pre-comment for tight LOAD: The 0x08==I check after INTERPRET
|
||||
is to check whether we're restoring to "_", the word above.
|
||||
if yes, then we're in a nested load. Also, the 1 in 0x06 is
|
||||
to avoid tons of "ok" displays. )
|
||||
|
||||
32
blk/384
32
blk/384
@ -1,16 +1,16 @@
|
||||
: ? @ . ;
|
||||
: _
|
||||
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
|
||||
;
|
||||
: LOAD
|
||||
BLK> @ >R ( save restorable variables to RSP )
|
||||
0x08 RAM+ @ >R ( 08 == C<* override )
|
||||
0x06 RAM+ @ >R ( C<? )
|
||||
0x2e RAM+ @ >R ( boot ptr )
|
||||
BLK@
|
||||
BLK( 0x2e RAM+ ! ( Point to beginning of BLK )
|
||||
['] (boot<) 0x08 RAM+ !
|
||||
1 0x06 RAM+ ! ( 06 == C<? )
|
||||
INTERPRET
|
||||
R> 0x2e RAM+ ! R> 0x06 RAM+ !
|
||||
I 0x08 RAM+ @ = IF ( nested load )
|
||||
R> DROP ( C<* ) R> BLK@
|
||||
ELSE ( not nested )
|
||||
R> 0x08 RAM+ ! R> DROP ( BLK> )
|
||||
THEN ;
|
||||
|
||||
28
blk/385
28
blk/385
@ -1,13 +1,15 @@
|
||||
: _ ( 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
|
||||
;
|
||||
: LOAD+ BLK> @ + LOAD ;
|
||||
( b1 b2 -- )
|
||||
: LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ;
|
||||
: LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ;
|
||||
( Now, adev stuff )
|
||||
SYSVARS 0x3e + :** A@
|
||||
SYSVARS 0x40 + :** A!
|
||||
|
||||
( src dst u -- )
|
||||
: AMOVE
|
||||
( u ) 0 DO
|
||||
SWAP DUP I + A@ ( dst src x )
|
||||
ROT TUCK I + ( src dst x dst )
|
||||
A! ( src dst )
|
||||
LOOP 2DROP ;
|
||||
|
||||
13
blk/387
13
blk/387
@ -1,13 +0,0 @@
|
||||
( handle backspace: go back one char in IN>, if possible, then
|
||||
emit BS + SPC + BS )
|
||||
: _bs
|
||||
( already at IN( ? )
|
||||
IN> @ IN( = IF EXIT THEN
|
||||
IN> @ 1- IN> !
|
||||
BS SPC BS
|
||||
;
|
||||
( del is same as backspace )
|
||||
: BS? DUP 0x7f = SWAP 0x8 = OR ;
|
||||
SYSVARS 0x55 + :** KEY
|
||||
( cont.: read one char into input buffer and returns whether we
|
||||
should continue, that is, whether CR was not met. )
|
||||
16
blk/389
16
blk/389
@ -1,16 +0,0 @@
|
||||
( Read one line in input buffer and make IN> point to it )
|
||||
: (rdln)
|
||||
( EOT or less triggers line flush )
|
||||
(infl) BEGIN (rdlnc) 5 < UNTIL
|
||||
LF IN( IN> ! ;
|
||||
( And finally, implement C<* )
|
||||
: RDLN<
|
||||
IN> @ C@
|
||||
DUP IF ( not EOL? good, inc and return )
|
||||
1 IN> +!
|
||||
ELSE ( EOL ? readline. we still return null though )
|
||||
(rdln)
|
||||
THEN
|
||||
( update C<? flag )
|
||||
IN> @ C@ 0 > 0x06 RAM+ ! ( 06 == C<? )
|
||||
;
|
||||
26
blk/390
26
blk/390
@ -1,10 +1,16 @@
|
||||
( Initializes the readln subsystem )
|
||||
: RDLN$
|
||||
H@ 0x32 ( IN(* ) RAM+ !
|
||||
( plus 2 for extra bytes after buffer: 1 for
|
||||
the last typed 0x0a and one for the following NULL. )
|
||||
IN) IN( - ALLOT
|
||||
(infl)
|
||||
['] RDLN< ['] C<* **!
|
||||
1 0x06 RAM+ ! ( 06 == C<? )
|
||||
;
|
||||
( xcomp core high )
|
||||
: (main) INTERPRET BYE ;
|
||||
: BOOT
|
||||
0x02 RAM+ CURRENT* !
|
||||
CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR )
|
||||
0 0x08 RAM+ ! ( 08 == C<* override )
|
||||
['] (emit) ['] EMIT **! ['] (key) ['] KEY **!
|
||||
['] CRLF ['] NL **!
|
||||
['] (boot<) ['] C<* **!
|
||||
['] C@ ['] A@ **! ['] C! ['] A! **!
|
||||
( boot< always has a char waiting. 06 == C<?* )
|
||||
1 0x06 RAM+ ! INTERPRET
|
||||
RDLN$ LIT" _sys" [entry]
|
||||
LIT" Collapse OS" (print) NL (main) ;
|
||||
XCURRENT @ _xapply ORG @ 0x04 ( stable ABI BOOT ) + !
|
||||
1 4 LOADR+
|
||||
|
||||
15
blk/391
15
blk/391
@ -1,11 +1,4 @@
|
||||
: .2 DUP 10 < IF SPC THEN . ;
|
||||
: LIST
|
||||
BLK@
|
||||
16 0 DO
|
||||
I 1+ .2 SPC
|
||||
64 I * BLK( + DUP 64 + SWAP DO
|
||||
I C@ 0x20 MAX EMIT
|
||||
LOOP
|
||||
NL
|
||||
LOOP
|
||||
;
|
||||
( Now we have "as late as possible" stuff. See bootstrap doc. )
|
||||
: :* ( addr -- ) (entry) 4 ( alias ) C, , ;
|
||||
: :** ( addr -- ) (entry) 5 ( switch ) C, , ;
|
||||
|
||||
|
||||
25
blk/392
25
blk/392
@ -1,15 +1,14 @@
|
||||
: INTERPRET
|
||||
: _bchk DUP 0x7f + 0xff > IF LIT" br ovfl" (print) ABORT THEN ;
|
||||
: DO COMPILE 2>R H@ ; IMMEDIATE
|
||||
: LOOP COMPILE (loop) H@ - _bchk C, ; IMMEDIATE
|
||||
( LEAVE is implemented in low xcomp )
|
||||
: LITN COMPILE (n) , ;
|
||||
( gets its name at the very end. can't comment afterwards )
|
||||
: _ BEGIN LIT" )" WORD S= UNTIL ; IMMEDIATE
|
||||
: _ ( : will get its name almost at the very end )
|
||||
(entry) 1 ( compiled ) C,
|
||||
BEGIN
|
||||
WORD DUP @ 0x0401 = ( EOT ) IF DROP EXIT THEN
|
||||
FIND NOT IF (parse) ELSE EXECUTE THEN
|
||||
C<? NOT IF SPC LIT" ok" (print) NL THEN
|
||||
WORD DUP LIT" ;" S= IF DROP COMPILE EXIT EXIT THEN
|
||||
FIND IF ( is word ) DUP IMMED? IF EXECUTE ELSE , THEN
|
||||
ELSE ( maybe number ) (parse) LITN THEN
|
||||
AGAIN ;
|
||||
( Read from BOOT C< PTR and inc it. )
|
||||
: (boot<)
|
||||
( 2e == BOOT C< PTR )
|
||||
0x2e ( BOOT C< PTR ) RAM+ @ DUP C@ ( a c )
|
||||
SWAP 1 + 0x2e RAM+ ! ( c ) ;
|
||||
( pre-comment for tight LOAD: The 0x08==I check after INTERPRET
|
||||
is to check whether we're restoring to "_", the word above.
|
||||
if yes, then we're in a nested load. Also, the 1 in 0x06 is
|
||||
to avoid tons of "ok" displays. )
|
||||
|
||||
32
blk/393
32
blk/393
@ -1,16 +1,16 @@
|
||||
: LOAD
|
||||
BLK> @ >R ( save restorable variables to RSP )
|
||||
0x08 RAM+ @ >R ( 08 == C<* override )
|
||||
0x06 RAM+ @ >R ( C<? )
|
||||
0x2e RAM+ @ >R ( boot ptr )
|
||||
BLK@
|
||||
BLK( 0x2e RAM+ ! ( Point to beginning of BLK )
|
||||
['] (boot<) 0x08 RAM+ !
|
||||
1 0x06 RAM+ ! ( 06 == C<? )
|
||||
INTERPRET
|
||||
R> 0x2e RAM+ ! R> 0x06 RAM+ !
|
||||
I 0x08 RAM+ @ = IF ( nested load )
|
||||
R> DROP ( C<* ) R> BLK@
|
||||
ELSE ( not nested )
|
||||
R> 0x08 RAM+ ! R> DROP ( BLK> )
|
||||
THEN ;
|
||||
: IF ( -- a | a: br cell addr )
|
||||
COMPILE (?br) H@ 1 ALLOT ( br cell allot )
|
||||
; IMMEDIATE
|
||||
: THEN ( a -- | a: br cell addr )
|
||||
DUP H@ -^ _bchk SWAP ( a-H a ) C!
|
||||
; IMMEDIATE
|
||||
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
|
||||
COMPILE (br)
|
||||
1 ALLOT
|
||||
[COMPILE] THEN
|
||||
H@ 1- ( push a. 1- for allot offset )
|
||||
; IMMEDIATE
|
||||
: LIT"
|
||||
COMPILE (s) H@ 0 C, ,"
|
||||
DUP H@ -^ 1- ( a len ) SWAP C!
|
||||
; IMMEDIATE
|
||||
|
||||
28
blk/394
28
blk/394
@ -1,15 +1,13 @@
|
||||
: LOAD+ BLK> @ + LOAD ;
|
||||
( b1 b2 -- )
|
||||
: LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ;
|
||||
: LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ;
|
||||
( Now, adev stuff )
|
||||
SYSVARS 0x3e + :** A@
|
||||
SYSVARS 0x40 + :** A!
|
||||
|
||||
( src dst u -- )
|
||||
: AMOVE
|
||||
( u ) 0 DO
|
||||
SWAP DUP I + A@ ( dst src x )
|
||||
ROT TUCK I + ( src dst x dst )
|
||||
A! ( src dst )
|
||||
LOOP 2DROP ;
|
||||
( We don't use ." and ABORT in core, they're not xcomp-ed )
|
||||
: ." [COMPILE] LIT" COMPILE (print) ; IMMEDIATE
|
||||
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
|
||||
: BEGIN H@ ; IMMEDIATE
|
||||
: AGAIN COMPILE (br) H@ - _bchk C, ; IMMEDIATE
|
||||
: UNTIL COMPILE (?br) H@ - _bchk C, ; IMMEDIATE
|
||||
: [ INTERPRET ; IMMEDIATE
|
||||
: ] R> DROP ;
|
||||
: COMPILE ' LITN ['] , , ; IMMEDIATE
|
||||
: [COMPILE] ' , ; IMMEDIATE
|
||||
: ['] ' LITN ; IMMEDIATE
|
||||
':' X' _ 4 - C! ( give : its name )
|
||||
'(' X' _ 4 - C!
|
||||
|
||||
16
blk/396
16
blk/396
@ -1,16 +0,0 @@
|
||||
: (main) INTERPRET BYE ;
|
||||
: BOOT
|
||||
0x02 RAM+ CURRENT* !
|
||||
CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR )
|
||||
0 0x08 RAM+ ! ( 08 == C<* override )
|
||||
['] (emit) ['] EMIT **!
|
||||
['] (key) ['] KEY **!
|
||||
['] CRLF ['] NL **!
|
||||
( 0c == C<* )
|
||||
['] (boot<) ['] C<* **!
|
||||
['] C@ ['] A@ ! ['] C! ['] A! **!
|
||||
( boot< always has a char waiting. 06 == C<?* )
|
||||
1 0x06 RAM+ ! INTERPRET
|
||||
RDLN$ LIT" _sys" [entry]
|
||||
LIT" Collapse OS" (print) NL (main) ;
|
||||
XCURRENT @ _xapply ORG @ 0x04 ( stable ABI BOOT ) + !
|
||||
4
blk/397
4
blk/397
@ -1,4 +0,0 @@
|
||||
( Now we have "as late as possible" stuff. See bootstrap doc. )
|
||||
: :* ( addr -- ) (entry) 4 ( alias ) C, , ;
|
||||
: :** ( addr -- ) (entry) 5 ( switch ) C, , ;
|
||||
|
||||
14
blk/398
14
blk/398
@ -1,14 +0,0 @@
|
||||
: _bchk DUP 0x7f + 0xff > IF LIT" br ovfl" (print) ABORT THEN ;
|
||||
: DO COMPILE 2>R H@ ; IMMEDIATE
|
||||
: LOOP COMPILE (loop) H@ - _bchk C, ; IMMEDIATE
|
||||
( LEAVE is implemented in low xcomp )
|
||||
: LITN COMPILE (n) , ;
|
||||
( gets its name at the very end. can't comment afterwards )
|
||||
: _ BEGIN LIT" )" WORD S= UNTIL ; IMMEDIATE
|
||||
: _ ( : will get its name almost at the very end )
|
||||
(entry) 1 ( compiled ) C,
|
||||
BEGIN
|
||||
WORD DUP LIT" ;" S= IF DROP COMPILE EXIT EXIT THEN
|
||||
FIND IF ( is word ) DUP IMMED? IF EXECUTE ELSE , THEN
|
||||
ELSE ( maybe number ) (parse) LITN THEN
|
||||
AGAIN ;
|
||||
16
blk/399
16
blk/399
@ -1,16 +0,0 @@
|
||||
: IF ( -- a | a: br cell addr )
|
||||
COMPILE (?br) H@ 1 ALLOT ( br cell allot )
|
||||
; IMMEDIATE
|
||||
: THEN ( a -- | a: br cell addr )
|
||||
DUP H@ -^ _bchk SWAP ( a-H a ) C!
|
||||
; IMMEDIATE
|
||||
: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
|
||||
COMPILE (br)
|
||||
1 ALLOT
|
||||
[COMPILE] THEN
|
||||
H@ 1- ( push a. 1- for allot offset )
|
||||
; IMMEDIATE
|
||||
: LIT"
|
||||
COMPILE (s) H@ 0 C, ,"
|
||||
DUP H@ -^ 1- ( a len ) SWAP C!
|
||||
; IMMEDIATE
|
||||
13
blk/400
13
blk/400
@ -1,13 +0,0 @@
|
||||
( We don't use ." and ABORT in core, they're not xcomp-ed )
|
||||
: ." [COMPILE] LIT" COMPILE (print) ; IMMEDIATE
|
||||
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
|
||||
: BEGIN H@ ; IMMEDIATE
|
||||
: AGAIN COMPILE (br) H@ - _bchk C, ; IMMEDIATE
|
||||
: UNTIL COMPILE (?br) H@ - _bchk C, ; IMMEDIATE
|
||||
: [ INTERPRET ; IMMEDIATE
|
||||
: ] R> DROP ;
|
||||
: COMPILE ' LITN ['] , , ; IMMEDIATE
|
||||
: [COMPILE] ' , ; IMMEDIATE
|
||||
: ['] ' LITN ; IMMEDIATE
|
||||
':' X' _ 4 - C! ( give : its name )
|
||||
'(' X' _ 4 - C!
|
||||
BIN
cvm/forth.bin
BIN
cvm/forth.bin
Binary file not shown.
@ -69,7 +69,7 @@ H@ 4 + XCURRENT ! ( make next CODE have 0 prev field )
|
||||
0x35 CODE RSHIFT
|
||||
0x36 CODE LSHIFT
|
||||
0x37 CODE TICKS
|
||||
353 LOAD ( xcomp core low )
|
||||
353 LOAD ( xcomp core )
|
||||
: (emit) 0 PC! ;
|
||||
: (key) 0 PC@ ;
|
||||
: EFS@
|
||||
@ -85,7 +85,7 @@ H@ 4 + XCURRENT ! ( make next CODE have 0 prev field )
|
||||
: COLS 80 ; : LINES 32 ;
|
||||
: AT-XY 6 PC! ( y ) 5 PC! ( x ) ;
|
||||
|
||||
380 LOAD ( xcomp core high )
|
||||
390 LOAD ( xcomp core high )
|
||||
(entry) _
|
||||
( Update LATEST )
|
||||
PC ORG @ 8 + !
|
||||
|
||||
@ -16,7 +16,7 @@ CODE _ BX POPx, AX POPx, 5 INT, ;CODE
|
||||
( 8086 port doesn't define PC@ and PC!, but test harness uses
|
||||
it. Our forth binary uses INT 6 for retcode. )
|
||||
CODE PC! AX POPx, ( discard ) AX POPx, 6 INT, ;CODE
|
||||
380 LOAD ( xcomp core high )
|
||||
390 LOAD ( xcomp core high )
|
||||
(entry) _ ( Update LATEST ) PC ORG @ 8 + !
|
||||
," BLK$ "
|
||||
," ' EFS@ BLK@* ! "
|
||||
|
||||
@ -23,7 +23,7 @@ RS_ADDR 0x80 - CONSTANT SYSVARS
|
||||
: COLS 80 ; : LINES 32 ;
|
||||
: AT-XY 6 PC! ( y ) 5 PC! ( x ) ;
|
||||
|
||||
380 LOAD ( xcomp core high )
|
||||
390 LOAD ( xcomp core high )
|
||||
(entry) _
|
||||
( Update LATEST )
|
||||
PC ORG @ 8 + !
|
||||
|
||||
@ -8,6 +8,6 @@ RS_ADDR 0x80 - CONSTANT SYSVARS
|
||||
604 LOAD ( KEY/EMIT drivers )
|
||||
606 608 LOADR ( BLK drivers )
|
||||
610 LOAD ( AT-XY drivers )
|
||||
380 LOAD ( xcomp core high )
|
||||
390 LOAD ( xcomp core high )
|
||||
(entry) _ ( Update LATEST ) PC ORG @ 8 + !
|
||||
," BLK$ FD$ ' FD@ BLK@* ! ' FD! BLK!* ! " EOT,
|
||||
|
||||
@ -6,7 +6,7 @@ RS_ADDR 0x80 - CONSTANT SYSVARS
|
||||
262 LOAD ( xcomp ) 282 LOAD ( boot.z80.decl )
|
||||
270 LOAD ( xcomp overrides ) 283 335 LOADR ( boot.z80 )
|
||||
353 LOAD ( xcomp core low ) 603 605 LOADR ( acia )
|
||||
380 LOAD ( xcomp core high )
|
||||
390 LOAD ( xcomp core high )
|
||||
(entry) _
|
||||
( Update LATEST )
|
||||
PC ORG @ 8 + !
|
||||
|
||||
@ -29,7 +29,7 @@ CURRENT @ XCURRENT !
|
||||
CREATE ~FNT CPFNT7x7
|
||||
603 608 LOADR ( VDP )
|
||||
612 617 LOADR ( PAD )
|
||||
380 LOAD ( xcomp core high )
|
||||
390 LOAD ( xcomp core high )
|
||||
(entry) _
|
||||
( Update LATEST )
|
||||
PC ORG @ 8 + !
|
||||
|
||||
@ -66,7 +66,7 @@ CURRENT @ XCURRENT !
|
||||
CREATE ~FNT CPFNT3x5
|
||||
605 610 LOADR ( LCD low )
|
||||
616 620 LOADR ( KBD low )
|
||||
380 LOAD ( xcomp core high )
|
||||
390 LOAD ( xcomp core high )
|
||||
(entry) _
|
||||
( Update LATEST )
|
||||
PC ORG @ 8 + !
|
||||
|
||||
@ -10,7 +10,7 @@ RS_ADDR 0x80 - CONSTANT SYSVARS
|
||||
283 335 LOADR ( boot.z80 )
|
||||
353 LOAD ( xcomp core low )
|
||||
602 LOAD ( trs80 )
|
||||
380 LOAD ( xcomp core high )
|
||||
390 LOAD ( xcomp core high )
|
||||
(entry) _
|
||||
( Update LATEST )
|
||||
PC ORG @ 8 + !
|
||||
|
||||
@ -34,7 +34,7 @@ CODE (key)
|
||||
: FD$ ( select disk 0 )
|
||||
0x09 ( seldisk ) 1 PC! 0 0 PC! ( sel disk 0 )
|
||||
;
|
||||
380 LOAD ( xcomp core high )
|
||||
390 LOAD ( xcomp core high )
|
||||
(entry) _
|
||||
( Update LATEST )
|
||||
PC ORG @ 8 + !
|
||||
|
||||
Loading…
Reference in New Issue
Block a user