1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 08:20:57 +11:00

Compare commits

..

No commits in common. "db9885b8cf51b302e3b4935a93f05690de0c9fa8" and "43eabf566b8d18510897aaa6beee8a50fe8277ff" have entirely different histories.

26 changed files with 82 additions and 66 deletions

View File

@ -10,7 +10,7 @@ Entry management
, n -- Write n in HERE and advance it. , n -- Write n in HERE and advance it.
ALLOT n -- Move HERE by n bytes ALLOT n -- Move HERE by n bytes
C, b -- Write byte b in HERE and advance it. C, b -- Write byte b in HERE and advance it.
FIND w -- a f Like '?, but for w.
EMPTY -- Rewind HERE and CURRENT where they were at EMPTY -- Rewind HERE and CURRENT where they were at
system initialization. system initialization.
(cont.) (cont.)

View File

@ -6,9 +6,7 @@ Logic
>< n l h -- f Push true if l < n < h >< n l h -- f Push true if l < n < h
=><= n l h -- f Push true if l <= n <= h =><= n l h -- f Push true if l <= n <= h
CMP n1 n2 -- n Compare n1 and n2 and set n to -1, 0, or 1. CMP n1 n2 -- n Compare n1 and n2 and set n to -1, 0, or 1.
n=0: a1=a2. n=1: a1>a2. n=-1: a1<a2. n=0: a1=a2. n=1: a1>a2. n=-1: a1<a2.
MIN a b -- n Returns the lowest of a and b
MAX a b -- n Returns the highest of a and b
NOT f -- f Push the logical opposite of f NOT f -- f Push the logical opposite of f

View File

@ -1,6 +1,6 @@
RAMSTART FUTURE USES +3c BLK(* RAMSTART FUTURE USES +3c BLK(*
+02 CURRENT +3e XYPOS +02 CURRENT +3e FUTURE USES
+04 HERE +40 FUTURE USES +04 HERE
+06 C<? +51 CURRENTPTR +06 C<? +51 CURRENTPTR
+08 C<* override +53 (emit) override +08 C<* override +53 (emit) override
+0a NLPTR +55 (key) override +0a NLPTR +55 (key) override

View File

@ -7,8 +7,8 @@ WORDBUF is the buffer used by WORD
BOOT C< PTR is used when Forth boots from in-memory BOOT C< PTR is used when Forth boots from in-memory
source. See "Initialization sequence" below. source. See "Initialization sequence" below.
XYPOS Current position of the cursor on screen. The meaning of
the pos in terms of row and cols is driver-dependent.

23
blk/090
View File

@ -1,10 +1,15 @@
4. Call INTERPRET which interprets boot source code until 4. Call INTERPRET
ASCII EOT (4) is met. This usually init drivers.
5. Initialize rdln buffer, _sys entry (for EMPTY), prints
"CollapseOS" and then calls (main).
6. (main) interprets from rdln input (usually from KEY) until
EOT is met, then calls BYE.
In RAM-only environment, we will typically have a In other words, BOOT interprets bytes directly following
"CURRENT @ HERE !" line during init to have HERE begin at the CURRENT as Forth source code. This code will typically
end of the binary instead of RAMEND. initialize all subsystems and then call RDLN$. As soon as
this is called, INTERPRET will begin reading from RDLN< which
reads from KEY.
In the "/emul" binaries, "HERE" is readjusted to "CURRENT @" so
that we don't have to relocate compiled dicts. Note that in
this context, the initialization code is fighting for space
with HERE: New entries to the dict will overwrite that code!
Also, because we're barebone, we can't have comments. This can
lead to peculiar code in this area where we try to "waste"
space in initialization code.

9
blk/131 Normal file
View File

@ -0,0 +1,9 @@
( Relink a regular Forth full interpreter. )
: RLCORE
LIT< [ (find) DROP ( target )
DUP 3 - @ ( t prevoff )
( subtract [ name length )
1- ( t o )
RLDICT
;

View File

@ -1,4 +1,4 @@
: EMPTY : EMPTY
LIT< _sys FIND NOT IF ABORT THEN LIT< _sys (find) NOT IF ABORT THEN
DUP HERE ! CURRENT ! ; DUP HERE ! CURRENT ! ;

View File

@ -11,5 +11,5 @@ VARIABLE XCURRENT
: X['] XCON ' _xapply LITA XCOFF ; : X['] XCON ' _xapply LITA XCOFF ;
: XCOMPILE : XCOMPILE
XCON ' _xapply LITA XCON ' _xapply LITA
LIT< , FIND DROP _xapply , XCOFF ; LIT< , (find) DROP _xapply , XCOFF ;
: X[COMPILE] XCON ' _xapply , XCOFF ; : X[COMPILE] XCON ' _xapply , XCOFF ;

View File

@ -3,14 +3,13 @@
: HERE 0x04 RAM+ ; : HERE 0x04 RAM+ ;
: CURRENT* 0x51 RAM+ ; : CURRENT* 0x51 RAM+ ;
: CURRENT CURRENT* @ ; : CURRENT CURRENT* @ ;
: XYPOS 0x40 RAM+ ;
( w -- a f ) ( w -- a f )
: FIND CURRENT @ SWAP _find ; : (find) CURRENT @ SWAP _find ;
: QUIT : QUIT
(resRS) (resRS)
0 0x08 RAM+ ! ( 08 == C<* override ) 0 0x08 RAM+ ! ( 08 == C<* override )
LIT< (main) FIND DROP EXECUTE LIT< INTERPRET (find) DROP EXECUTE
; ;
1 25 LOADR+ ( xcomp core low ) 1 25 LOADR+ ( xcomp core low )

19
blk/394
View File

@ -1,12 +1,15 @@
: ABORT (resSP) QUIT ; : ABORT (resSP) QUIT ;
: ERR LIT< (print) FIND IF EXECUTE THEN ABORT ; : ERR LIT< (print) (find) IF EXECUTE THEN ABORT ;
: = CMP NOT ; : < CMP -1 = ; : > CMP 1 = ; : = CMP NOT ; : < CMP -1 = ; : > CMP 1 = ;
: 0< 32767 > ; : >= < NOT ; : <= > NOT ; : 0>= 0< NOT ; : 0< 32767 > ; : >= < NOT ; : <= > NOT ; : 0>= 0< NOT ;
: >< ( n l h -- f ) 2 PICK > ( n l f ) ROT ROT > AND ; ( n l h -- f )
: >< 2 PICK > ( n l f ) ROT ROT > AND ;
: =><= 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 ; ( a -- a+1 c )
: MAX ( n n - n ) 2DUP < IF SWAP THEN DROP ; : C@+ DUP C@ SWAP 1+ SWAP ;
: C@+ ( a -- a+1 c ) DUP C@ SWAP 1+ SWAP ; ( c a -- a+1 )
: C!+ ( c a -- a+1 ) SWAP OVER C! 1+ ; : C!+ SWAP OVER C! 1+ ;
: C@- ( a -- a-1 c ) DUP C@ SWAP 1- SWAP ; ( a -- a-1 c )
: C!- ( c a -- a-1 ) SWAP OVER C! 1- ; : C@- DUP C@ SWAP 1- SWAP ;
( c a -- a-1 )
: C!- SWAP OVER C! 1- ;

View File

@ -4,5 +4,5 @@
(parseb) IF EXIT THEN (parseb) IF EXIT THEN
(parsed) IF EXIT THEN (parsed) IF EXIT THEN
( nothing works ) ( nothing works )
LIT< (wnf) FIND IF EXECUTE ELSE ABORT THEN LIT< (wnf) (find) IF EXECUTE ELSE ABORT THEN
; ;

View File

@ -1,6 +1,5 @@
: WS? 33 < ; : WS? 33 < ;
: EOT? 4 = ; ( 4 == ASCII EOT, CTRL+D ) : EOT? 4 = ; ( 4 == ASCII EOT, CTRL+D )
: EOT, 4 C, ;
: TOWORD : TOWORD
0 ( dummy ) BEGIN 0 ( dummy ) BEGIN

View File

@ -1,7 +1,7 @@
: '? WORD FIND ; : '? WORD (find) ;
: ' : '
'? (?br) [ 4 , ] EXIT '? (?br) [ 4 , ] EXIT
LIT< (wnf) FIND DROP EXECUTE LIT< (wnf) (find) DROP EXECUTE
; ;
: ROLL : ROLL
DUP NOT IF EXIT THEN DUP NOT IF EXIT THEN

View File

@ -2,8 +2,8 @@
H@ 0x3c ( BLK(* ) RAM+ ! H@ 0x3c ( BLK(* ) RAM+ !
1024 ALLOT 1024 ALLOT
( LOAD detects end of block with ASCII EOT. This is why ( LOAD detects end of block with ASCII EOT. This is why
we write it there. ) we write it there. EOT == 0x04 )
EOT, 4 C,
0 BLKDTY ! 0 BLKDTY !
-1 BLK> ! -1 BLK> !
; ;

View File

@ -11,5 +11,6 @@
: 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 DROP CRLF THEN ;
: (ok) SPC LIT" ok" (print) NL ;
: (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

@ -1,8 +1,8 @@
: INTERPRET : INTERPRET
BEGIN BEGIN
WORD DUP C@ EOT? IF DROP EXIT THEN WORD DUP C@ EOT? IF DROP EXIT THEN
FIND NOT IF (parse) ELSE EXECUTE THEN (find) NOT IF (parse) ELSE EXECUTE THEN
C<? NOT IF SPC LIT< ok (print) NL THEN C<? NOT IF (ok) THEN
AGAIN ; AGAIN ;
( Read from BOOT C< PTR and inc it. ) ( Read from BOOT C< PTR and inc it. )
: (boot<) : (boot<)

View File

@ -1,4 +1,3 @@
: (main) INTERPRET BYE ;
: BOOT : BOOT
0x02 RAM+ CURRENT* ! 0x02 RAM+ CURRENT* !
CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR ) CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR )
@ -9,6 +8,6 @@
( 0c == C<* ) ( 0c == C<* )
['] (boot<) 0x0c RAM+ ! ['] (boot<) 0x0c RAM+ !
( boot< always has a char waiting. 06 == C<?* ) ( boot< always has a char waiting. 06 == C<?* )
1 0x06 RAM+ ! INTERPRET 1 0x06 RAM+ !
RDLN$ LIT< _sys [entry] INTERPRET BYE ;
LIT< CollapseOS (print) NL (main) ;

View File

@ -9,7 +9,7 @@
(entry) (entry)
[ 14 ( == compiledWord ) LITN ] C, [ 14 ( == compiledWord ) LITN ] C,
BEGIN BEGIN
WORD FIND WORD (find)
IF ( is word ) DUP IMMED? IF EXECUTE ELSE , THEN IF ( is word ) DUP IMMED? IF EXECUTE ELSE , THEN
ELSE ( maybe number ) (parse) LITN THEN ELSE ( maybe number ) (parse) LITN THEN
AGAIN ; AGAIN ;

View File

@ -12,4 +12,4 @@ RAMSTART 0x70 + CONSTANT ACIA_MEM
(entry) _ (entry) _
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
," ACIA$ " EOT, ," : _ ACIA$ RDLN$ (ok) ; _ "

18
blk/627
View File

@ -1,6 +1,14 @@
: (emit) : _set ( row col tilenum -- )
XYPOS @ 2 * 0x7800 OR _ctl ROT 5 LSHIFT ROT OR 0x7800 OR _ctl
0x20 - 0x5e MIN ( tilenum ) _data 1 _zero _data 1 _zero
XYPOS @ 1+ DUP [ VDP_COLS VDP_ROWS * LITN ]
= IF DROP 0 THEN XYPOS !
; ;
: VDP$
9 0 DO _idat I 2 * + @ _ctl LOOP _blank
( palettes )
0xc000 _ctl
( BG ) 1 _zero 0x3f _data 14 _zero
( sprite, inverted colors ) 0x3f _data 15 _zero
0x4000 _ctl 0x5e 0 DO ~FNT I 7 * + _sfont LOOP
0 0 1 _set
;

View File

@ -1,9 +0,0 @@
: VDP$
9 0 DO _idat I 2 * + @ _ctl LOOP _blank
( palettes )
0xc000 _ctl
( BG ) 1 _zero 0x3f _data 14 _zero
( sprite, inverted colors ) 0x3f _data 15 _zero
0x4000 _ctl 0x5e 0 DO ~FNT I 7 * + _sfont LOOP
0 XYPOS !
;

Binary file not shown.

View File

@ -28,9 +28,13 @@
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
," CURRENT @ HERE ! " ," CURRENT @ HERE ! "
," : INIT "
," BLK$ " ," BLK$ "
," ' EFS@ BLK@* ! " ," ['] EFS@ BLK@* ! "
," ' EFS! BLK!* ! " ," ['] EFS! BLK!* ! "
EOT, ," RDLN$ "
," LIT< _sys [entry] "
," LIT< CollapseOS (print) NL "
," ; INIT "
ORG @ 256 /MOD 2 PC! 2 PC! ORG @ 256 /MOD 2 PC! 2 PC!
H@ 256 /MOD 2 PC! 2 PC! H@ 256 /MOD 2 PC! 2 PC!

View File

@ -21,12 +21,12 @@ CURRENT @ XCURRENT !
282 LOAD ( boot.z80 ) 282 LOAD ( boot.z80 )
393 LOAD ( xcomp core low ) 393 LOAD ( xcomp core low )
CREATE ~FNT CPFNT7x7 CREATE ~FNT CPFNT7x7
623 628 LOADR ( VDP ) 623 627 LOADR ( VDP )
: (key) 4 ; : (key) 0 ; : (emit) DROP ;
420 LOAD ( xcomp core high ) 420 LOAD ( xcomp core high )
(entry) _ (entry) _
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
," VDP$ " EOT, ," VDP$ BYE "
ORG @ 0x100 - 256 /MOD 2 PC! 2 PC! ORG @ 0x100 - 256 /MOD 2 PC! 2 PC!
H@ 256 /MOD 2 PC! 2 PC! H@ 256 /MOD 2 PC! 2 PC!

View File

@ -68,6 +68,6 @@ CREATE ~FNT CPFNT3x5
(entry) _ (entry) _
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
," LCD$ KBD$ " EOT, ," : _ LCD$ KBD$ (ok) RDLN$ ; _ "
ORG @ 0x100 - 256 /MOD 2 PC! 2 PC! ORG @ 0x100 - 256 /MOD 2 PC! 2 PC!
H@ 256 /MOD 2 PC! 2 PC! H@ 256 /MOD 2 PC! 2 PC!

View File

@ -15,6 +15,6 @@ RS_ADDR 0x80 - CONSTANT RAMSTART
PC ORG @ 8 + ! PC ORG @ 8 + !
," CURRENT @ HERE ! " ," CURRENT @ HERE ! "
( 0x0a == NLPTR. TRS-80 wants CR-only newlines ) ( 0x0a == NLPTR. TRS-80 wants CR-only newlines )
," ' CR 0x0a RAM+ ! BLK$ FD$ " EOT, ," : _ ['] CR 0x0a RAM+ ! BLK$ FD$ (ok) RDLN$ ; _ "
ORG @ 256 /MOD 2 PC! 2 PC! ORG @ 256 /MOD 2 PC! 2 PC!
H@ 256 /MOD 2 PC! 2 PC! H@ 256 /MOD 2 PC! 2 PC!