mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-26 17:28:05 +11:00
Compare commits
4 Commits
43eabf566b
...
db9885b8cf
Author | SHA1 | Date | |
---|---|---|---|
|
db9885b8cf | ||
|
175b4bc497 | ||
|
ca60685067 | ||
|
0163af470a |
2
blk/037
2
blk/037
@ -10,7 +10,7 @@ Entry management
|
||||
, n -- Write n in HERE and advance it.
|
||||
ALLOT n -- Move HERE by n bytes
|
||||
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
|
||||
system initialization.
|
||||
|
||||
(cont.)
|
||||
|
4
blk/056
4
blk/056
@ -6,7 +6,9 @@ Logic
|
||||
>< 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.
|
||||
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
|
||||
|
||||
|
||||
|
4
blk/081
4
blk/081
@ -1,6 +1,6 @@
|
||||
RAMSTART FUTURE USES +3c BLK(*
|
||||
+02 CURRENT +3e FUTURE USES
|
||||
+04 HERE
|
||||
+02 CURRENT +3e XYPOS
|
||||
+04 HERE +40 FUTURE USES
|
||||
+06 C<? +51 CURRENTPTR
|
||||
+08 C<* override +53 (emit) override
|
||||
+0a NLPTR +55 (key) override
|
||||
|
4
blk/083
4
blk/083
@ -7,8 +7,8 @@ WORDBUF is the buffer used by WORD
|
||||
BOOT C< PTR is used when Forth boots from in-memory
|
||||
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
23
blk/090
@ -1,15 +1,10 @@
|
||||
4. Call INTERPRET
|
||||
4. Call INTERPRET which interprets boot source code until
|
||||
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 other words, BOOT interprets bytes directly following
|
||||
CURRENT as Forth source code. This code will typically
|
||||
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.
|
||||
In RAM-only environment, we will typically have a
|
||||
"CURRENT @ HERE !" line during init to have HERE begin at the
|
||||
end of the binary instead of RAMEND.
|
||||
|
9
blk/131
9
blk/131
@ -1,9 +0,0 @@
|
||||
( Relink a regular Forth full interpreter. )
|
||||
: RLCORE
|
||||
LIT< [ (find) DROP ( target )
|
||||
DUP 3 - @ ( t prevoff )
|
||||
( subtract [ name length )
|
||||
1- ( t o )
|
||||
RLDICT
|
||||
;
|
||||
|
2
blk/156
2
blk/156
@ -1,4 +1,4 @@
|
||||
: EMPTY
|
||||
LIT< _sys (find) NOT IF ABORT THEN
|
||||
LIT< _sys FIND NOT IF ABORT THEN
|
||||
DUP HERE ! CURRENT ! ;
|
||||
|
||||
|
2
blk/263
2
blk/263
@ -11,5 +11,5 @@ VARIABLE XCURRENT
|
||||
: X['] XCON ' _xapply LITA XCOFF ;
|
||||
: XCOMPILE
|
||||
XCON ' _xapply LITA
|
||||
LIT< , (find) DROP _xapply , XCOFF ;
|
||||
LIT< , FIND DROP _xapply , XCOFF ;
|
||||
: X[COMPILE] XCON ' _xapply , XCOFF ;
|
||||
|
5
blk/393
5
blk/393
@ -3,13 +3,14 @@
|
||||
: HERE 0x04 RAM+ ;
|
||||
: CURRENT* 0x51 RAM+ ;
|
||||
: CURRENT CURRENT* @ ;
|
||||
: XYPOS 0x40 RAM+ ;
|
||||
|
||||
( w -- a f )
|
||||
: (find) CURRENT @ SWAP _find ;
|
||||
: FIND CURRENT @ SWAP _find ;
|
||||
|
||||
: QUIT
|
||||
(resRS)
|
||||
0 0x08 RAM+ ! ( 08 == C<* override )
|
||||
LIT< INTERPRET (find) DROP EXECUTE
|
||||
LIT< (main) FIND DROP EXECUTE
|
||||
;
|
||||
1 25 LOADR+ ( xcomp core low )
|
||||
|
19
blk/394
19
blk/394
@ -1,15 +1,12 @@
|
||||
: 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 = ;
|
||||
: 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 ;
|
||||
( a -- a+1 c )
|
||||
: C@+ DUP C@ SWAP 1+ SWAP ;
|
||||
( c a -- a+1 )
|
||||
: C!+ SWAP OVER C! 1+ ;
|
||||
( a -- a-1 c )
|
||||
: C@- DUP C@ SWAP 1- SWAP ;
|
||||
( c a -- a-1 )
|
||||
: C!- SWAP OVER C! 1- ;
|
||||
: MIN ( n n - n ) 2DUP > IF SWAP THEN DROP ;
|
||||
: MAX ( n n - n ) 2DUP < IF SWAP THEN DROP ;
|
||||
: C@+ ( a -- a+1 c ) DUP C@ SWAP 1+ SWAP ;
|
||||
: C!+ ( c a -- a+1 ) SWAP OVER C! 1+ ;
|
||||
: C@- ( a -- a-1 c ) DUP C@ SWAP 1- SWAP ;
|
||||
: C!- ( c a -- a-1 ) SWAP OVER C! 1- ;
|
||||
|
2
blk/403
2
blk/403
@ -4,5 +4,5 @@
|
||||
(parseb) IF EXIT THEN
|
||||
(parsed) IF EXIT THEN
|
||||
( nothing works )
|
||||
LIT< (wnf) (find) IF EXECUTE ELSE ABORT THEN
|
||||
LIT< (wnf) FIND IF EXECUTE ELSE ABORT THEN
|
||||
;
|
||||
|
1
blk/405
1
blk/405
@ -1,5 +1,6 @@
|
||||
: WS? 33 < ;
|
||||
: EOT? 4 = ; ( 4 == ASCII EOT, CTRL+D )
|
||||
: EOT, 4 C, ;
|
||||
|
||||
: TOWORD
|
||||
0 ( dummy ) BEGIN
|
||||
|
4
blk/410
4
blk/410
@ -1,7 +1,7 @@
|
||||
: '? WORD (find) ;
|
||||
: '? WORD FIND ;
|
||||
: '
|
||||
'? (?br) [ 4 , ] EXIT
|
||||
LIT< (wnf) (find) DROP EXECUTE
|
||||
LIT< (wnf) FIND DROP EXECUTE
|
||||
;
|
||||
: ROLL
|
||||
DUP NOT IF EXIT THEN
|
||||
|
4
blk/417
4
blk/417
@ -2,8 +2,8 @@
|
||||
H@ 0x3c ( BLK(* ) RAM+ !
|
||||
1024 ALLOT
|
||||
( LOAD detects end of block with ASCII EOT. This is why
|
||||
we write it there. EOT == 0x04 )
|
||||
4 C,
|
||||
we write it there. )
|
||||
EOT,
|
||||
0 BLKDTY !
|
||||
-1 BLK> !
|
||||
;
|
||||
|
1
blk/421
1
blk/421
@ -11,6 +11,5 @@
|
||||
: BS 8 EMIT ; : LF 10 EMIT ; : CR 13 EMIT ;
|
||||
: CRLF CR LF ; : SPC 32 EMIT ;
|
||||
: NL 0x0a RAM+ @ ( NLPTR ) DUP IF EXECUTE ELSE DROP CRLF THEN ;
|
||||
: (ok) SPC LIT" ok" (print) NL ;
|
||||
: (uflw) LIT" stack underflow" ERR ;
|
||||
: (wnf) (print) SPC LIT" word not found" ERR ;
|
||||
|
4
blk/432
4
blk/432
@ -1,8 +1,8 @@
|
||||
: INTERPRET
|
||||
BEGIN
|
||||
WORD DUP C@ EOT? IF DROP EXIT THEN
|
||||
(find) NOT IF (parse) ELSE EXECUTE THEN
|
||||
C<? NOT IF (ok) 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<)
|
||||
|
7
blk/436
7
blk/436
@ -1,3 +1,4 @@
|
||||
: (main) INTERPRET BYE ;
|
||||
: BOOT
|
||||
0x02 RAM+ CURRENT* !
|
||||
CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR )
|
||||
@ -8,6 +9,6 @@
|
||||
( 0c == C<* )
|
||||
['] (boot<) 0x0c RAM+ !
|
||||
( boot< always has a char waiting. 06 == C<?* )
|
||||
1 0x06 RAM+ !
|
||||
INTERPRET BYE ;
|
||||
|
||||
1 0x06 RAM+ ! INTERPRET
|
||||
RDLN$ LIT< _sys [entry]
|
||||
LIT< CollapseOS (print) NL (main) ;
|
||||
|
2
blk/437
2
blk/437
@ -9,7 +9,7 @@
|
||||
(entry)
|
||||
[ 14 ( == compiledWord ) LITN ] C,
|
||||
BEGIN
|
||||
WORD (find)
|
||||
WORD FIND
|
||||
IF ( is word ) DUP IMMED? IF EXECUTE ELSE , THEN
|
||||
ELSE ( maybe number ) (parse) LITN THEN
|
||||
AGAIN ;
|
||||
|
2
blk/618
2
blk/618
@ -12,4 +12,4 @@ RAMSTART 0x70 + CONSTANT ACIA_MEM
|
||||
(entry) _
|
||||
( Update LATEST )
|
||||
PC ORG @ 8 + !
|
||||
," : _ ACIA$ RDLN$ (ok) ; _ "
|
||||
," ACIA$ " EOT,
|
||||
|
18
blk/627
18
blk/627
@ -1,14 +1,6 @@
|
||||
: _set ( row col tilenum -- )
|
||||
ROT 5 LSHIFT ROT OR 0x7800 OR _ctl
|
||||
_data 1 _zero
|
||||
: (emit)
|
||||
XYPOS @ 2 * 0x7800 OR _ctl
|
||||
0x20 - 0x5e MIN ( tilenum ) _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
|
||||
;
|
||||
|
||||
|
9
blk/628
Normal file
9
blk/628
Normal file
@ -0,0 +1,9 @@
|
||||
: 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 !
|
||||
;
|
BIN
emul/forth.bin
BIN
emul/forth.bin
Binary file not shown.
@ -28,13 +28,9 @@
|
||||
( Update LATEST )
|
||||
PC ORG @ 8 + !
|
||||
," CURRENT @ HERE ! "
|
||||
," : INIT "
|
||||
," BLK$ "
|
||||
," ['] EFS@ BLK@* ! "
|
||||
," ['] EFS! BLK!* ! "
|
||||
," RDLN$ "
|
||||
," LIT< _sys [entry] "
|
||||
," LIT< CollapseOS (print) NL "
|
||||
," ; INIT "
|
||||
," ' EFS@ BLK@* ! "
|
||||
," ' EFS! BLK!* ! "
|
||||
EOT,
|
||||
ORG @ 256 /MOD 2 PC! 2 PC!
|
||||
H@ 256 /MOD 2 PC! 2 PC!
|
||||
|
@ -21,12 +21,12 @@ CURRENT @ XCURRENT !
|
||||
282 LOAD ( boot.z80 )
|
||||
393 LOAD ( xcomp core low )
|
||||
CREATE ~FNT CPFNT7x7
|
||||
623 627 LOADR ( VDP )
|
||||
: (key) 0 ; : (emit) DROP ;
|
||||
623 628 LOADR ( VDP )
|
||||
: (key) 4 ;
|
||||
420 LOAD ( xcomp core high )
|
||||
(entry) _
|
||||
( Update LATEST )
|
||||
PC ORG @ 8 + !
|
||||
," VDP$ BYE "
|
||||
," VDP$ " EOT,
|
||||
ORG @ 0x100 - 256 /MOD 2 PC! 2 PC!
|
||||
H@ 256 /MOD 2 PC! 2 PC!
|
||||
|
@ -68,6 +68,6 @@ CREATE ~FNT CPFNT3x5
|
||||
(entry) _
|
||||
( Update LATEST )
|
||||
PC ORG @ 8 + !
|
||||
," : _ LCD$ KBD$ (ok) RDLN$ ; _ "
|
||||
," LCD$ KBD$ " EOT,
|
||||
ORG @ 0x100 - 256 /MOD 2 PC! 2 PC!
|
||||
H@ 256 /MOD 2 PC! 2 PC!
|
||||
|
@ -15,6 +15,6 @@ RS_ADDR 0x80 - CONSTANT RAMSTART
|
||||
PC ORG @ 8 + !
|
||||
," CURRENT @ HERE ! "
|
||||
( 0x0a == NLPTR. TRS-80 wants CR-only newlines )
|
||||
," : _ ['] CR 0x0a RAM+ ! BLK$ FD$ (ok) RDLN$ ; _ "
|
||||
," ' CR 0x0a RAM+ ! BLK$ FD$ " EOT,
|
||||
ORG @ 256 /MOD 2 PC! 2 PC!
|
||||
H@ 256 /MOD 2 PC! 2 PC!
|
||||
|
Loading…
Reference in New Issue
Block a user