1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 04:30:54 +11:00

Compare commits

..

5 Commits

Author SHA1 Message Date
Virgil Dupras
6bff03a48b Move adev to core
It's small enough to be worth it.
2020-05-22 14:50:34 -04:00
Virgil Dupras
bb190f9665 Add word TUCK 2020-05-22 14:19:02 -04:00
Virgil Dupras
41d439376d Add word NIP 2020-05-22 14:19:02 -04:00
Virgil Dupras
f75b1c8864 Add word ?DUP 2020-05-22 14:19:02 -04:00
Virgil Dupras
986249cf5e rc2014: fix misinformation in README 2020-05-22 14:19:02 -04:00
35 changed files with 76 additions and 92 deletions

View File

@ -2,8 +2,7 @@ MASTER INDEX
3 Usage 30 Dictionary 3 Usage 30 Dictionary
70 Implementation notes 100 Block editor 70 Implementation notes 100 Block editor
120 Linker 140 Addressed devices 120 Linker 150 Extra words
150 Extra words
200 Z80 assembler 260 Cross compilation 200 Z80 assembler 260 Cross compilation
280 Z80 boot code 350 Core words 280 Z80 boot code 350 Core words
410 PS/2 keyboard subsystem 420 Bootstrap guide 410 PS/2 keyboard subsystem 420 Bootstrap guide

View File

@ -14,3 +14,4 @@ Contents
8 Interpreter I/O 11 Signed-ness 8 Interpreter I/O 11 Signed-ness
14 Addressed devices 17 DOES> 14 Addressed devices 17 DOES>
18 Disk blocks 21 How blocks are organized 18 Disk blocks 21 How blocks are organized
22 Addressed devices

6
blk/022 Normal file
View File

@ -0,0 +1,6 @@
Addressed devices
A@ and A! are the indirect versions of C@ and C!. Their target
word is controlled through A@* and A!* and by default point to
C@ and C*. There is also a AMOVE word that is the same as MOVE
but using A@ and A!.

View File

@ -2,15 +2,15 @@ Parameter Stack
DROP a -- DROP a --
DUP a -- a a DUP a -- a a
?DUP DUP if a is nonzero
NIP a b -- b
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
TUCK a b -- b a b
2DROP a 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
'S Returns current stack pointer, not counting the 'S Returns current stack pointer, not counting the
push it's making right now. push it's making right now. (cont.)
S0 Returns address of PSP TOS. When PSP is empty,
'S == S0
(cont.)

View File

@ -1,4 +1,5 @@
(cont.) S0 Returns address of PSP TOS. When PSP is empty,
'S == S0
PICK Pick nth item from stack. "0 PICK" = DUP, PICK Pick nth item from stack. "0 PICK" = DUP,
"1 PICK" = OVER. "1 PICK" = OVER.
ROLL Rotate PSP over n items. "1 ROLL" = SWAP, ROLL Rotate PSP over n items. "1 ROLL" = SWAP,

18
blk/081
View File

@ -1,13 +1,13 @@
RAMSTART FUTURE USES +3c BLK(* RAMSTART FUTURE USES +3c BLK(*
+02 CURRENT +3e FUTURE USES +02 CURRENT +3e A@*
+04 HERE +04 HERE +40 A!*
+06 C<? +51 CURRENTPTR +06 C<? +42 FUTURE USES
+08 C<* override +53 (emit) override +08 C<* override +51 CURRENTPTR
+0a NLPTR +55 (key) override +0a NLPTR +53 (emit) override
+0c C<* +57 FUTURE USES +0c C<* +55 (key) override
+0e WORDBUF +0e WORDBUF +57 FUTURE USES
+2e BOOT C< PTR +5d adev's variables +2e BOOT C< PTR
+30 IN> +5f FUTURE USES +30 IN>
+32 IN(* +70 DRIVERS +32 IN(* +70 DRIVERS
+34 BLK@* +80 RAMEND +34 BLK@* +80 RAMEND
+36 BLK!* +36 BLK!*

View File

@ -3,7 +3,7 @@
BEGIN BEGIN
C@+ ROT ( a2+1 c2 a1 ) C@+ ROT ( a2+1 a1+1 c1 c2 ) C@+ ROT ( a2+1 c2 a1 ) C@+ ROT ( a2+1 a1+1 c1 c2 )
= NOT IF DROP FBUF THEN = NOT IF DROP FBUF THEN
SWAP OVER C@ 0xd = ( a1 a2 f1 ) TUCK C@ 0xd = ( a1 a2 f1 )
OVER BLK) = OR ( a1 a2 f1|f2 ) OVER BLK) = OR ( a1 a2 f1|f2 )
UNTIL UNTIL
DUP BLK) < IF BLK( - FBUF + -^ EDPOS ! THEN DUP BLK) < IF BLK( - FBUF + -^ EDPOS ! THEN

View File

@ -4,10 +4,10 @@
EDPOS @ 64 MOD 63 -^ ; EDPOS @ 64 MOD 63 -^ ;
: _I : _I
IBUF _type _rbufsz IBUF _blen 2DUP > IF IBUF _type _rbufsz IBUF _blen 2DUP > IF
SWAP OVER - ( ilen chars-to-move ) TUCK - ( ilen chars-to-move )
SWAP EDPOS @ _cpos 2DUP + ( ctm ilen a a+ilen ) SWAP EDPOS @ _cpos 2DUP + ( ctm ilen a a+ilen )
3 PICK MOVE- ( ctm ilen ) 3 PICK MOVE- ( ctm ilen )
SWAP DROP ( ilen ) NIP ( ilen )
ELSE DROP ( ilen becomes rbuffsize ) ELSE DROP ( ilen becomes rbuffsize )
THEN THEN
DUP IBUF EDPOS @ _cpos ROT MOVE ( ilen ) DUP IBUF EDPOS @ _cpos ROT MOVE ( ilen )

View File

@ -7,9 +7,9 @@
THEN THEN
ROT ( o a n ol ) ROT ( o a n ol )
< IF ( under limit, do nothing ) < IF ( under limit, do nothing )
SWAP DROP ( a ) NIP ( a )
ELSE ( o a ) ELSE ( o a )
SWAP OVER @ ( a o n ) TUCK @ ( a o n )
-^ ( a n-o ) -^ ( a n-o )
OVER ! ( a ) OVER ! ( a )
THEN THEN

10
blk/140
View File

@ -1,10 +0,0 @@
Addressed devices
Abstractions to read and write to devices that allow addressed
access. At all times, we have one active "fetch" device and
one active "store" device, A@ and A!.
Those words have the same signature as C@ and C!, and in fact,
initially default to proxy of those words.
Load with "142 LOAD"

View File

@ -1 +0,0 @@
1 2 LOADR+

15
blk/143
View File

@ -1,15 +0,0 @@
: ADEVMEM+ 0x5d RAM+ @ + ;
: A@* 0 ADEVMEM+ ;
: A!* 2 ADEVMEM+ ;
: ADEV$
H@ 0x5d RAM+ !
4 ALLOT
['] C@ A@* !
['] C! A!* !
;
: A@ A@* @ EXECUTE ;
: A! A!* @ EXECUTE ;

11
blk/144
View File

@ -1,11 +0,0 @@
( Same as MOVE, but with A@ and A! )
( src dst u -- )
: AMOVE
( u ) 0 DO
SWAP DUP I + A@ ( dst src x )
ROT SWAP OVER I + ( src dst x dst )
A! ( src dst )
LOOP
2DROP
;

View File

@ -3,7 +3,7 @@
hit 0. ) hit 0. )
: ENDCASE : ENDCASE
BEGIN BEGIN
DUP NOT IF DROP EXIT THEN ?DUP NOT IF EXIT THEN
[COMPILE] THEN [COMPILE] THEN
AGAIN AGAIN
; IMMEDIATE ; IMMEDIATE

12
blk/307
View File

@ -1,9 +1,13 @@
( a -- a a ) ( a -- a a )
CODE DUP CODE DUP
HL POPqq, ( A ) HL POPqq, chkPS,
chkPS, HL PUSHqq, HL PUSHqq,
HL PUSHqq, ( A ) ;CODE
HL PUSHqq, ( A )
CODE ?DUP
HL POPqq, chkPS,
HL PUSHqq,
HLZ, IFNZ, HL PUSHqq, THEN,
;CODE ;CODE
( a -- ) ( a -- )

View File

@ -6,7 +6,8 @@
: =><= 2 PICK >= ( n l f ) ROT ROT >= AND ; : =><= 2 PICK >= ( n l f ) ROT ROT >= AND ;
: MIN ( n n - n ) 2DUP > IF SWAP THEN DROP ; : MIN ( n n - n ) 2DUP > IF SWAP THEN DROP ;
: MAX ( n n - n ) 2DUP < IF SWAP THEN DROP ; : MAX ( n n - n ) 2DUP < IF SWAP THEN DROP ;
: NIP SWAP DROP ; : TUCK SWAP OVER ;
: C@+ ( a -- a+1 c ) DUP C@ SWAP 1+ SWAP ; : C@+ ( a -- a+1 c ) DUP C@ SWAP 1+ SWAP ;
: C!+ ( c a -- a+1 ) SWAP OVER C! 1+ ; : C!+ ( c a -- a+1 ) TUCK C! 1+ ;
: C@- ( a -- a-1 c ) DUP C@ SWAP 1- SWAP ; : C@- ( a -- a-1 c ) DUP C@ SWAP 1- SWAP ;
: C!- ( c a -- a-1 ) SWAP OVER C! 1- ; : C!- ( c a -- a-1 ) TUCK C! 1- ;

View File

@ -5,12 +5,12 @@
- SWAP EXIT ( 0-n f ) - SWAP EXIT ( 0-n f )
THEN THEN
0 SWAP _pdacc ( a r f ) 0 SWAP _pdacc ( a r f )
DUP IF 2DROP 0 EXIT THEN ?DUP IF 2DROP 0 EXIT THEN
BEGIN ( a r 0 ) BEGIN ( a r )
DROP SWAP 1+ ( r a+1 ) SWAP 1+ ( r a+1 )
DUP C@ ( r a c ) DUP C@ ( r a c )
ROT SWAP ( a r c ) ROT SWAP ( a r c )
_pdacc ( a r f ) _pdacc ( a r f )
DUP UNTIL ?DUP UNTIL
1 = ( a r f ) 1 = ( a r f )
ROT DROP ( r f ) ; ROT DROP ( r f ) ;

View File

@ -6,7 +6,7 @@
0 ( a r ) 0 ( a r )
BEGIN BEGIN
SWAP C@+ ( r a+1 c ) SWAP C@+ ( r a+1 c )
DUP NOT IF 2DROP 1 EXIT THEN ( r, 1 ) ?DUP NOT IF DROP 1 EXIT THEN ( r, 1 )
_ ( r a n ) _ ( r a n )
DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 ) DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
ROT 16 * + ( a r*16+n ) ROT 16 * + ( a r*16+n )

View File

@ -6,7 +6,7 @@
0 ( a r ) 0 ( a r )
BEGIN BEGIN
SWAP C@+ ( r a+1 c ) SWAP C@+ ( r a+1 c )
DUP NOT IF 2DROP 1 EXIT THEN ( r 1 ) ?DUP NOT IF DROP 1 EXIT THEN ( r 1 )
_ ( r a n ) _ ( r a n )
DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 ) DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
ROT 2 * + ( a r*2+n ) ROT 2 * + ( a r*2+n )

View File

@ -1,7 +1,7 @@
: C<? 0x06 RAM+ @ ; : C<? 0x06 RAM+ @ ;
: C< : C<
0x08 RAM+ @ ( 08 == C<* override ) 0x08 RAM+ @ ( 08 == C<* override )
DUP NOT IF DROP 0x0c RAM+ @ THEN ( 0c == C<* ) ?DUP NOT IF 0x0c RAM+ @ THEN ( 0c == C<* )
EXECUTE EXECUTE
; ;
: , H@ ! H@ 2+ HERE ! ; : , H@ ! H@ 2+ HERE ! ;

View File

@ -9,5 +9,5 @@
OVER ! 1+ C< ( a c ) OVER ! 1+ C< ( a c )
OVER 0x2d ( 2e-1 for NULL ) RAM+ = OVER WS? OR OVER 0x2d ( 2e-1 for NULL ) RAM+ = OVER WS? OR
UNTIL ( a c ) UNTIL ( a c )
SWAP DROP 0x0e RAM+ ( ws a ) NIP 0x0e RAM+ ( ws a )
SWAP EOT? IF 4 OVER ! THEN ; SWAP EOT? IF 4 OVER ! THEN ;

View File

@ -1,6 +1,6 @@
: SCPY : SCPY
BEGIN ( a ) BEGIN ( a )
C@+ ( a+1 c ) C@+ ( a+1 c )
DUP NOT IF 2DROP EXIT THEN ?DUP NOT IF DROP EXIT THEN
C, ( a c ) C, ( a c )
AGAIN ; AGAIN ;

View File

@ -5,9 +5,9 @@
CURRENT @ 1- CURRENT @ 1-
DUP C@ 128 OR SWAP C! ; DUP C@ 128 OR SWAP C! ;
: IMMED? 1- C@ 0x80 AND ; : IMMED? 1- C@ 0x80 AND ;
: +! SWAP OVER @ + SWAP ! ; : +! TUCK @ + SWAP ! ;
: -^ SWAP - ; : -^ SWAP - ;
: / /MOD SWAP DROP ; : / /MOD NIP ;
: MOD /MOD DROP ; : MOD /MOD DROP ;
: ALLOT HERE +! ; : ALLOT HERE +! ;
: CREATE (entry) 11 ( 11 == cellWord ) C, ; : CREATE (entry) 11 ( 11 == cellWord ) C, ;

View File

@ -4,10 +4,9 @@
LIT< (wnf) FIND DROP EXECUTE LIT< (wnf) FIND DROP EXECUTE
; ;
: ROLL : ROLL
DUP NOT IF EXIT THEN ?DUP NOT IF EXIT THEN
1+ DUP PICK ( n val ) 1+ DUP PICK ( n val )
SWAP 2 * (roll) ( val ) SWAP 2 * (roll) ( val )
SWAP DROP NIP ;
;
: 2OVER 3 PICK 3 PICK ; : 2OVER 3 PICK 3 PICK ;
: 2SWAP 3 ROLL 3 ROLL ; : 2SWAP 3 ROLL 3 ROLL ;

View File

@ -4,7 +4,7 @@
ROT C!+ ( a1+1 a2+1 ) ROT C!+ ( a1+1 a2+1 )
LOOP 2DROP ; LOOP 2DROP ;
: MOVE- ( a1 a2 u -- ) : MOVE- ( a1 a2 u -- )
SWAP OVER + 1- ( a1 u a2+u-1 ) TUCK + 1- ( a1 u a2+u-1 )
ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 ) ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
ROT ( u ) 0 DO ( a2 a1 ) ROT ( u ) 0 DO ( a2 a1 )
C@- ( a2 a1-1 x ) C@- ( a2 a1-1 x )

View File

@ -1,6 +1,6 @@
: EMIT : EMIT
( 0x53==(emit) override ) ( 0x53==(emit) override )
0x53 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ; 0x53 RAM+ @ ?DUP IF EXECUTE ELSE (emit) THEN ;
: (print) : (print)
BEGIN BEGIN
C@+ ( a+1 c ) C@+ ( a+1 c )
@ -10,6 +10,6 @@
AGAIN ; AGAIN ;
: BS 8 EMIT ; : LF 10 EMIT ; : CR 13 EMIT ; : BS 8 EMIT ; : LF 10 EMIT ; : CR 13 EMIT ;
: CRLF CR LF ; : SPC 32 EMIT ; : CRLF CR LF ; : SPC 32 EMIT ;
: NL 0x0a RAM+ @ ( NLPTR ) DUP IF EXECUTE ELSE DROP CRLF THEN ; : NL 0x0a RAM+ @ ( NLPTR ) ?DUP IF EXECUTE ELSE CRLF THEN ;
: (uflw) LIT" stack underflow" ERR ; : (uflw) LIT" stack underflow" ERR ;
: (wnf) (print) SPC LIT" word not found" ERR ; : (wnf) (print) SPC LIT" word not found" ERR ;

View File

@ -9,7 +9,7 @@
: KEY : KEY
85 RAM+ @ ( (key) override ) 85 RAM+ @ ( (key) override )
DUP IF EXECUTE ELSE DROP (key) THEN ; ?DUP IF EXECUTE ELSE (key) THEN ;
( cont.: read one char into input buffer and returns whether we ( cont.: read one char into input buffer and returns whether we

10
blk/394
View File

@ -2,3 +2,13 @@
( b1 b2 -- ) ( b1 b2 -- )
: LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ; : LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ;
: LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ; : LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ;
( Now, adev stuff )
: A@* 0x3e RAM+ ; : A@ A@* @ EXECUTE ;
: A!* 0x40 RAM+ ; : A! A!* @ EXECUTE ;
( 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 ;

View File

@ -8,6 +8,7 @@
0 0x0a RAM+ ! ( NLPTR ) 0 0x0a RAM+ ! ( NLPTR )
( 0c == C<* ) ( 0c == C<* )
['] (boot<) 0x0c RAM+ ! ['] (boot<) 0x0c RAM+ !
['] C@ A@* ! ['] C! A!* !
( boot< always has a char waiting. 06 == C<?* ) ( boot< always has a char waiting. 06 == C<?* )
1 0x06 RAM+ ! INTERPRET 1 0x06 RAM+ ! INTERPRET
RDLN$ LIT< _sys [entry] RDLN$ LIT< _sys [entry]

View File

@ -11,5 +11,5 @@
DUP _shift? IF DROP 1 PS2_SHIFT C! (key) EXIT THEN DUP _shift? IF DROP 1 PS2_SHIFT C! (key) EXIT THEN
( ah, finally, we have a gentle run-of-the-mill KC ) ( ah, finally, we have a gentle run-of-the-mill KC )
PS2_CODES PS2_SHIFT C@ IF 0x80 + THEN + C@ PS2_CODES PS2_SHIFT C@ IF 0x80 + THEN + C@
DUP NOT IF DROP (key) THEN ; ?DUP NOT IF (key) THEN ;

View File

@ -8,5 +8,5 @@
( gid dmask ) ( gid dmask )
0xff XOR ( dpos ) 0 ( dindex ) 0xff XOR ( dpos ) 0 ( dindex )
BEGIN 1+ 2DUP RSHIFT NOT UNTIL 1- BEGIN 1+ 2DUP RSHIFT NOT UNTIL 1-
( gid dpos dindex ) SWAP DROP ( gid dpos dindex ) NIP
( gid dindex ) SWAP 8 * + ; ( gid dindex ) SWAP 8 * + ;

View File

@ -8,7 +8,7 @@
0 ( cnt ) 0 ( cnt )
BEGIN BEGIN
_idle _idle
DUP 0xff = IF DROP ELSE SWAP DROP EXIT THEN DUP 0xff = IF DROP ELSE NIP EXIT THEN
1+ 1+
DUP 20 = UNTIL DUP 20 = UNTIL
DROP 0xff DROP 0xff

View File

@ -4,5 +4,5 @@
CREATE _ '0' C, ':' C, 'A' C, '[' C, 'a' C, 0xff C, CREATE _ '0' C, ':' C, 'A' C, '[' C, 'a' C, 0xff C,
: _nxtcls : _nxtcls
_sel @ _ BEGIN ( c a ) C@+ 2 PICK > UNTIL ( c a ) _sel @ _ BEGIN ( c a ) C@+ 2 PICK > UNTIL ( c a )
1- C@ SWAP DROP _sel ! 1- C@ NIP _sel !
; ;

Binary file not shown.

View File

@ -45,16 +45,15 @@ device I use in this recipe.
* [GNU screen][screen] * [GNU screen][screen]
* A FTDI-to-TTL cable to connect to the Serial I/O module * A FTDI-to-TTL cable to connect to the Serial I/O module
### Configure your build
Modules used in this build are configured through the `conf.fs` file in this
folder. There isn't much to configure, but it's there.
### Build the binary ### Build the binary
Building the binary is as simple as running `make`. This will yield `os.bin` Building the binary is as simple as running `make`. This will yield `os.bin`
which can then be written to EEPROM. which can then be written to EEPROM.
This build is controlled by the `xcomp.fs` unit, which loads `blk/618`. That's
what you need to modify if you want to customize your build (if you do, you'll
need to rebuild `/emul/stage` because the blkfs is embedded in it).
### Emulate ### Emulate
The Collapse OS project includes a RC2014 emulator suitable for this image. The Collapse OS project includes a RC2014 emulator suitable for this image.