1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 06:40:56 +11:00

Compare commits

..

No commits in common. "6bff03a48b1734f4e7b5112797f0bc29f4ad0e36" and "ae87e88c526553e6cae40aaefd6c09fa4d478c0e" have entirely different histories.

35 changed files with 92 additions and 76 deletions

View File

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

View File

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

View File

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

View File

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

18
blk/081
View File

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

View File

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

View File

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

View File

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

10
blk/140 Normal file
View File

@ -0,0 +1,10 @@
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"

1
blk/142 Normal file
View File

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

15
blk/143 Normal file
View File

@ -0,0 +1,15 @@
: 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 Normal file
View File

@ -0,0 +1,11 @@
( 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. )
: ENDCASE
BEGIN
?DUP NOT IF EXIT THEN
DUP NOT IF DROP EXIT THEN
[COMPILE] THEN
AGAIN
; IMMEDIATE

12
blk/307
View File

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

View File

@ -6,8 +6,7 @@
: =><= 2 PICK >= ( n l f ) ROT ROT >= AND ;
: MIN ( 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!+ ( c a -- a+1 ) TUCK C! 1+ ;
: C!+ ( c a -- a+1 ) SWAP OVER C! 1+ ;
: C@- ( a -- a-1 c ) DUP C@ SWAP 1- SWAP ;
: C!- ( c a -- a-1 ) TUCK C! 1- ;
: C!- ( c a -- a-1 ) SWAP OVER C! 1- ;

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -4,7 +4,7 @@
ROT C!+ ( a1+1 a2+1 )
LOOP 2DROP ;
: MOVE- ( a1 a2 u -- )
TUCK + 1- ( a1 u a2+u-1 )
SWAP OVER + 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 )

View File

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

View File

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

10
blk/394
View File

@ -2,13 +2,3 @@
( b1 b2 -- )
: LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ;
: 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,7 +8,6 @@
0 0x0a RAM+ ! ( NLPTR )
( 0c == C<* )
['] (boot<) 0x0c RAM+ !
['] C@ A@* ! ['] C! A!* !
( boot< always has a char waiting. 06 == C<?* )
1 0x06 RAM+ ! INTERPRET
RDLN$ LIT< _sys [entry]

View File

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

View File

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

View File

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

View File

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

Binary file not shown.

View File

@ -45,15 +45,16 @@ device I use in this recipe.
* [GNU screen][screen]
* 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
Building the binary is as simple as running `make`. This will yield `os.bin`
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
The Collapse OS project includes a RC2014 emulator suitable for this image.