1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-26 19:28:06 +11:00

Compare commits

..

No commits in common. "4eca827d365bb183caee2cb04e67944ed66ca1e2" and "22f132094a11e260718f97f4ff0564c7869deb8b" have entirely different histories.

21 changed files with 189 additions and 244 deletions

View File

@ -3,8 +3,7 @@ Collapse OS file system
This is a Forth-style filesystems which is very simple. It is a This is a Forth-style filesystems which is very simple. It is a
list of 1024 bytes block, organised in 16 lines of 64 columns list of 1024 bytes block, organised in 16 lines of 64 columns
each. You refer to blocks by numbers. You show them with LIST. each. You refer to blocks by numbers. You show them with LIST.
You interpret them with LOAD. For a convenient way to browse You interpret them with LOAD.
blocks, see Block Explorer at B100.
Conventions: When you see "(cont.)" at the bottom right of a Conventions: When you see "(cont.)" at the bottom right of a
block, it means that the next block continues the same kind of block, it means that the next block continues the same kind of

View File

@ -10,5 +10,3 @@ MOD a b -- c a % b -> c
AND a b -- c a & b -> c AND a b -- c a & b -> c
OR a b -- c a | b -> c OR a b -- c a | b -> c
XOR a b -- c a ^ b -> c XOR a b -- c a ^ b -> c
Shortcuts: 1+ 2+ 1- 2-

View File

@ -6,7 +6,7 @@ A dictionary entry has this structure:
bigger than input buffer, of course). not null-terminated bigger than input buffer, of course). not null-terminated
- 2b prev offset - 2b prev offset
- 1b size + IMMEDIATE flag - 1b size + IMMEDIATE flag
- 1b code pointer (always jumps in the <0x100 range) - 2b code pointer
- Parameter field (PF) - Parameter field (PF)
The prev offset is the number of bytes between the prev field The prev offset is the number of bytes between the prev field

View File

@ -1,9 +1,7 @@
(cont.) The code pointer point to "word routines". These (cont.) The code pointer point to "word routines". These
routines expect to be called with IY pointing to the PF. They routines expect to be called with IY pointing to the PF. They
themselves are expected to end by jumping to the address at themselves are expected to end by jumping to the address at
(IP). They will usually do so with "jp next". They are 1b (IP). They will usually do so with "jp next".
because all those routines live in the first 0x100 bytes of
the boot binary. The 0 MSB is assumed.
That's for "regular" words (words that are part of the dict That's for "regular" words (words that are part of the dict
chain). There are also "special words", for example NUMBER, chain). There are also "special words", for example NUMBER,

View File

@ -2,7 +2,7 @@
RAMSTART INITIAL_SP +53 readln's variables RAMSTART INITIAL_SP +53 readln's variables
+02 CURRENT +55 adev's variables +02 CURRENT +55 adev's variables
+04 HERE +57 blk's variables +04 HERE +57 blk's variables
+06 FUTURE USES +59 z80a's variables +06 IP +59 z80a's variables
+08 FLAGS +5b FUTURE USES +08 FLAGS +5b FUTURE USES
+0a PARSEPTR +70 DRIVERS +0a PARSEPTR +70 DRIVERS
+0c CINPTR +80 RAMEND +0c CINPTR +80 RAMEND

View File

@ -7,4 +7,4 @@ USAGE: When loaded, the Forth interpreter is replaced by the
explorer interpreter. Typing "Q" quits the program. explorer interpreter. Typing "Q" quits the program.
Typing a decimal number followed by space or return lists the Typing a decimal number followed by space or return lists the
contents of that block. B for previous block, N for next. contents of that block.

16
blk/102
View File

@ -1,14 +1,2 @@
103 LOAD : foo ." Hello world! " 42 . ;
VARIABLE _K foo
: PGM
100 _LIST
BEGIN
KEY
DUP 'Q' = IF DROP EXIT THEN
DUP 58 ( '9'+1 ) < IF _NUM
ELSE
_K ! _K (find) IF EXECUTE THEN
THEN
AGAIN
; PGM

10
blk/103
View File

@ -1,9 +1 @@
VARIABLE ACC 42 . 102 LOAD 43 .
: _LIST ." Block " DUP . CRLF LIST ;
: _NUM
ACC @ SWAP _pdacc
IF _LIST 0 THEN
ACC !
;
: B BLK> @ 1- DUP BLK> ! _LIST ;
: N BLK> @ 1+ DUP BLK> ! _LIST ;

Binary file not shown.

View File

@ -29,7 +29,7 @@
: LIST : LIST
BLK@ BLK@
16 0 DO 16 0 DO
I 1+ .2 SPC I 1 + .2 SPC
64 I * BLK( + (print) 64 I * BLK( + (print)
CRLF CRLF
LOOP LOOP

View File

@ -1,13 +1,6 @@
( Configuration words: RAMSTART, RS_ADDR ) ( Configuration words: RAMSTART, RS_ADDR )
H@ 256 /MOD 2 PC! 2 PC! H@ 256 /MOD 2 PC! 2 PC!
( RESERVED REGISTERS
At all times, IX points to RSP TOS and IY is IP. SP points
to PSP TOS, but you can still use the stack in native code.
you just have to make sure you've restored it before "next".
)
( STABLE ABI ( STABLE ABI
Those jumps below are supposed to stay at these offsets, Those jumps below are supposed to stay at these offsets,
always. If they change bootstrap binaries have to be always. If they change bootstrap binaries have to be
@ -27,7 +20,7 @@ NOP, ( 0a, unused )
0 JPnn, ( 0e, compiledWord ) 0 JPnn, ( 0e, compiledWord )
0 JPnn, ( 11, pushRS ) 0 JPnn, ( 11, pushRS )
0 JPnn, ( 14, popRS ) 0 JPnn, ( 14, popRS )
EXDEHL, JP(HL), NOP, ( 17, nativeWord ) JP(IY), NOP, ( 17, nativeWord )
0 JPnn, ( 1a, next ) 0 JPnn, ( 1a, next )
0 JPnn, ( 1d, chkPS ) 0 JPnn, ( 1d, chkPS )
NOP, NOP, ( 20, numberWord ) NOP, NOP, ( 20, numberWord )
@ -38,82 +31,77 @@ RAMSTART 0x4e + JPnn, ( 28, RST 28 )
0 JPnn, ( 2b, doesWord ) 0 JPnn, ( 2b, doesWord )
NOP, NOP, ( 2e, unused ) NOP, NOP, ( 2e, unused )
RAMSTART 0x4e + JPnn, ( RST 30 ) RAMSTART 0x4e + JPnn, ( RST 30 )
0 JPnn, ( 33, execute ) NOP, NOP, NOP, ( unused )
NOP, NOP, ( unused ) NOP, NOP, ( unused )
RAMSTART 0x4e + JPnn, ( RST 38 ) RAMSTART 0x4e + JPnn, ( RST 38 )
NOP, ( unused )
( BOOT DICT ( BOOT DICT
There are only 3 words in the boot dict, but these words' There are only 5 words in the boot dict, but these words'
offset need to be stable, so they're part of the "stable offset need to be stable, so they're part of the "stable
ABI" ABI"
) )
'E' A, 'X' A, 'I' A, 'T' A, 'E' A, 'X' A, 'I' A, 'T' A,
0 A,, ( prev ) 0 A,, ( prev )
4 A, 4 A,
H@ XCURRENT ! ( set current tip of dict, 0x42 ) L1 BSET ( EXIT )
0x17 A, ( nativeWord ) 0x17 A,, ( nativeWord )
0x14 CALLnn, ( popRS ) 0x14 CALLnn, ( popRS )
HL PUSHqq, IY POPqq, ( --> IP ) RAMSTART 0x06 + LD(nn)HL, ( RAMSTART+0x06 == IP )
JPNEXT, JPNEXT,
CODE (br) ( 0x53 ) NOP, NOP, NOP, ( unused )
'(' A, 'b' A, 'r' A, ')' A,
PC L1 @ - A,, ( prev )
4 A,
L1 BSET ( BR )
0x17 A,, ( nativeWord )
L2 BSET ( used in CBR ) L2 BSET ( used in CBR )
E 0 IY+ LDrIXY, RAMSTART 0x06 + LDHL(nn), ( RAMSTART+0x06 == IP )
D 1 IY+ LDrIXY, E (HL) LDrr,
DE ADDIYss, HL INCss,
D (HL) LDrr,
HL DECss,
DE ADDHLss,
RAMSTART 0x06 + LD(nn)HL, ( RAMSTART+0x06 == IP )
JPNEXT, JPNEXT,
CODE (?br) ( 0x67 ) '(' A, '?' A, 'b' A, 'r' A, ')' A,
PC L1 @ - A,, ( prev )
5 A,
L1 BSET ( CBR )
0x17 A,, ( nativeWord )
HL POPqq, HL POPqq,
chkPS, chkPS,
A H LDrr, A H LDrr,
L ORr, L ORr,
JRZ, L2 BWR ( BR + 2. False, branch ) JRZ, L2 BWR ( BR + 2. False, branch )
( True, skip next 2 bytes and don't branch ) ( True, skip next 2 bytes and don't branch )
IY INCss, RAMSTART 0x06 + LDHL(nn), ( RAMSTART+0x06 == IP )
IY INCss, HL INCss,
HL INCss,
RAMSTART 0x06 + LD(nn)HL, ( RAMSTART+0x06 == IP )
JPNEXT, JPNEXT,
'E' A, 'X' A, 'E' A, 'C' A, 'U' A, 'T' A, 'E' A,
PC L1 @ - A,, ( prev )
7 A,
H@ XCURRENT ! ( set current tip of dict )
L2 BSET ( used frequently below )
0x17 A,, ( nativeWord )
IY POPqq, ( is a wordref )
chkPS,
L 0 IY+ LDrIXY,
H 1 IY+ LDrIXY,
( HL points to code pointer )
IY INCss,
IY INCss,
( IY points to PFA )
JP(HL),
( END OF STABLE ABI ) ( END OF STABLE ABI )
( We want numberWord and litWord routine to be below the 0x100
offset so that we can reduce the size of the routine field
in words to 1 byte. )
( addrWord is the exact same thing as a numberWord except that
it is treated differently by meta-tools. See notes.txt )
PC ORG @ 0x20 + ! ( numberWord )
PC ORG @ 0x24 + ! ( addrWord )
( This is not a word, but a number literal. This works a bit
differently than others: PF means nothing and the actual
number is placed next to the numberWord reference in the
compiled word list. What we need to do to fetch that number
is to play with the IP.
)
E 0 IY+ LDrIXY,
D 1 IY+ LDrIXY,
IY INCss,
IY INCss,
DE PUSHqq,
JPNEXT,
PC ORG @ 0x22 + ! ( litWord )
( Similarly to numberWord, this is not a real word, but a
string literal. Instead of being followed by a 2 bytes
number, it's followed by a null-terminated string. When
called, puts the string's address on PS )
IY PUSHqq, HL POPqq, ( <-- IP )
HL PUSHqq,
( skip to null char )
A XORr, ( look for null )
B A LDrr,
C A LDrr,
CPIR,
( CPIR advances HL regardless of comparison, so goes one
char after NULL. This is good, because that's what we
want... )
HL PUSHqq, IY POPqq, ( --> IP )
JPNEXT,
( Name of BOOT word ) ( Name of BOOT word )
L1 BSET L1 BSET
'B' A, 'O' A, 'O' A, 'T' A, 0 A, 'B' A, 'O' A, 'O' A, 'T' A, 0 A,
@ -141,7 +129,8 @@ PC ORG @ 1 + ! ( main )
EXDEHL, EXDEHL,
HL L1 @ LDddnn, HL L1 @ LDddnn,
0x03 CALLnn, ( 03 == find ) 0x03 CALLnn, ( 03 == find )
0x33 JPnn, ( 33 == execute ) DE PUSHqq,
L2 @ 2 + JPnn,
PC ORG @ 4 + ! ( find ) PC ORG @ 4 + ! ( find )
( Find the entry corresponding to word name where (HL) points ( Find the entry corresponding to word name where (HL) points
@ -178,7 +167,7 @@ BEGIN, ( inner )
LDA(DE), LDA(DE),
0x7f ANDn, ( remove IMMEDIATE flag ) 0x7f ANDn, ( remove IMMEDIATE flag )
C CPr, C CPr,
JRNZ, L2 FWR ( loopend ) JRNZ, L4 FWR ( loopend )
( match, let's compare the string then ) ( match, let's compare the string then )
DE DECss, ( Skip prev field. One less because we ) DE DECss, ( Skip prev field. One less because we )
DE DECss, ( pre-decrement ) DE DECss, ( pre-decrement )
@ -191,12 +180,12 @@ BEGIN, ( loop )
(HL) CPr, (HL) CPr,
JRNZ, L3 FWR ( loopend ) JRNZ, L3 FWR ( loopend )
DJNZ, AGAIN, ( loop ) DJNZ, AGAIN, ( loop )
L2 FSET L3 FSET ( loopend ) L4 FSET L3 FSET ( loopend )
( At this point, Z is set if we have a match. In all cases, ( At this point, Z is set if we have a match. In all cases,
we want to pop HL and DE ) we want to pop HL and DE )
DE POPqq, ( <-- lvl 2 ) DE POPqq, ( <-- lvl 2 )
HL POPqq, ( <-- lvl 1 ) HL POPqq, ( <-- lvl 1 )
JRZ, L2 FWR ( end, match? we're done! ) JRZ, L4 FWR ( end, match? we're done! )
( no match, go to prev and continue ) ( no match, go to prev and continue )
HL PUSHqq, ( --> lvl 1 ) HL PUSHqq, ( --> lvl 1 )
DE DECss, DE DECss,
@ -224,7 +213,7 @@ L2 FSET L3 FSET ( loopend )
L1 FSET ( fail ) L1 FSET ( fail )
A XORr, A XORr,
A INCr, A INCr,
L2 FSET ( end ) L4 FSET ( end )
HL POPqq, HL POPqq,
BC POPqq, BC POPqq,
RET, RET,
@ -248,7 +237,8 @@ L1 BSET ( abortUnderflow )
HL PC 7 - LDddnn, HL PC 7 - LDddnn,
DE RAMSTART 0x02 + LDdd(nn), ( RAM+02 == CURRENT ) DE RAMSTART 0x02 + LDdd(nn), ( RAM+02 == CURRENT )
0x03 CALLnn, ( find ) 0x03 CALLnn, ( find )
0x33 JPnn, ( 33 == execute ) DE PUSHqq,
L2 @ 2 + JPnn, ( EXECUTE, skip nativeWord )
PC ORG @ 0x1e + ! ( chkPS ) PC ORG @ 0x1e + ! ( chkPS )
@ -265,7 +255,7 @@ PC ORG @ 0x1e + ! ( chkPS )
CNC RETcc, ( INITIAL_SP >= SP? good ) CNC RETcc, ( INITIAL_SP >= SP? good )
JR, L1 BWR ( abortUnderflow ) JR, L1 BWR ( abortUnderflow )
L2 BSET ( chkRS ) L3 BSET ( chkRS )
IX PUSHqq, HL POPqq, IX PUSHqq, HL POPqq,
DE RS_ADDR LDddnn, DE RS_ADDR LDddnn,
DE SUBHLss, DE SUBHLss,
@ -279,45 +269,44 @@ PC ORG @ 0x1b + ! ( next )
it by 2 before jumping. ) it by 2 before jumping. )
( Before we continue: are stacks within bounds? ) ( Before we continue: are stacks within bounds? )
0x1d CALLnn, ( chkPS ) 0x1d CALLnn, ( chkPS )
L2 @ CALLnn, ( chkRS ) L3 @ CALLnn, ( chkRS )
E 0 IY+ LDrIXY, DE RAMSTART 0x06 + LDdd(nn), ( RAMSTART+0x06 == IP )
D 1 IY+ LDrIXY, H D LDrr,
IY INCss, L E LDrr,
IY INCss,
( continue to execute )
PC ORG @ 0x34 + ! ( execute )
( DE points to wordref )
EXDEHL,
E (HL) LDrr,
D 0 LDrn,
EXDEHL,
( HL points to code pointer )
DE INCss, DE INCss,
( DE points to PFA ) DE INCss,
JP(HL), RAMSTART 0x06 + DE LD(nn)dd, ( RAMSTART+0x06 == IP )
( HL is an atom list pointer. We need to go into it to
PC ORG @ 0x0f + ! ( compiledWord ) have a wordref )
( Execute a list of atoms, which always end with EXIT.
DE points to that list. What do we do:
1. Push current IP to RS
2. Set new IP to the second atom of the list
3. Execute the first atom of the list. )
IY PUSHqq, HL POPqq, ( <-- IP )
0x11 CALLnn, ( 11 == pushRS )
EXDEHL, ( HL points to PFA )
( While we increase, dereference into DE for execute call
later. )
E (HL) LDrr, E (HL) LDrr,
HL INCss, HL INCss,
D (HL) LDrr, D (HL) LDrr,
DE PUSHqq,
L2 @ 2 + JPnn, ( EXECUTE, skip nativeWord )
( WORD ROUTINES )
PC ORG @ 0x0f + ! ( compiledWord )
( Execute a list of atoms, which always end with EXIT.
IY points to that list. What do we do:
1. Push current IP to RS
2. Set new IP to the second atom of the list
3. Execute the first atom of the list. )
RAMSTART 0x06 + LDHL(nn), ( RAMSTART+0x06 == IP )
0x11 CALLnn, ( 11 == pushRS )
IY PUSHqq, HL POPqq,
HL INCss, HL INCss,
HL PUSHqq, IY POPqq, ( --> IP ) HL INCss,
0x33 JPnn, ( 33 == execute ) RAMSTART 0x06 + LD(nn)HL, ( RAMSTART+0x06 == IP )
( IY still is our atom reference )
L 0 IY+ LDrIXY,
H 1 IY+ LDrIXY,
HL PUSHqq, ( arg for EXECUTE )
L2 @ 2 + JPnn, ( EXECUTE, skip nativeWord )
PC ORG @ 0x0c + ! ( cellWord ) PC ORG @ 0x0c + ! ( cellWord )
( Pushes PFA directly ) ( Pushes the PFA directly )
DE PUSHqq, IY PUSHqq,
JPNEXT, JPNEXT,
PC ORG @ 0x2c + ! ( doesWord ) PC ORG @ 0x2c + ! ( doesWord )
@ -328,11 +317,46 @@ PC ORG @ 0x2c + ! ( doesWord )
linkfrom the PFA, and then continue as a regular linkfrom the PFA, and then continue as a regular
compiledWord. compiledWord.
) )
DE PUSHqq, ( like a regular cell ) IY PUSHqq, ( like a regular cell )
EXDEHL, L 2 IY+ LDrIXY,
HL INCss, H 3 IY+ LDrIXY,
HL INCss, HL PUSHqq, IY POPqq,
0x0e JPnn, ( 0e == compiledWord )
( addrWord is the exact same thing as a numberWord except that
it is treated differently by meta-tools. See notes.txt )
PC ORG @ 0x20 + ! ( numberWord )
PC ORG @ 0x24 + ! ( addrWord )
( This is not a word, but a number literal. This works a bit
differently than others: PF means nothing and the actual
number is placed next to the numberWord reference in the
compiled word list. What we need to do to fetch that number
is to play with the IP.
)
RAMSTART 0x06 + LDHL(nn), ( RAMSTART+0x06 == IP )
E (HL) LDrr, E (HL) LDrr,
HL INCss, HL INCss,
D (HL) LDrr, D (HL) LDrr,
0x0e JPnn, ( 0e == compiledWord ) HL INCss,
RAMSTART 0x06 + LD(nn)HL, ( RAMSTART+0x06 == IP )
DE PUSHqq,
JPNEXT,
PC ORG @ 0x22 + ! ( litWord )
( Similarly to numberWord, this is not a real word, but a
string literal. Instead of being followed by a 2 bytes
number, it's followed by a null-terminated string. When
called, puts the string's address on PS )
RAMSTART 0x06 + LDHL(nn), ( RAMSTART+0x06 == IP )
HL PUSHqq,
( skip to null char )
A XORr, ( look for null )
B A LDrr,
C A LDrr,
CPIR,
( CPIR advances HL regardless of comparison, so goes one
char after NULL. This is good, because that's what we
want... )
RAMSTART 0x06 + LD(nn)HL, ( RAMSTART+0x06 == IP )
JPNEXT,

View File

@ -1,6 +1,6 @@
: H@ HERE @ ; : H@ HERE @ ;
: IMMEDIATE : IMMEDIATE
CURRENT @ 1- CURRENT @ 1 -
DUP C@ 128 OR SWAP C! DUP C@ 128 OR SWAP C!
; ;
: [ INTERPRET 1 FLAGS ! ; IMMEDIATE : [ INTERPRET 1 FLAGS ! ; IMMEDIATE
@ -52,13 +52,13 @@
2 ALLOT 2 ALLOT
DUP H@ -^ SWAP ( a-H a ) DUP H@ -^ SWAP ( a-H a )
! !
H@ 2- ( push a. -2 for allot offset ) H@ 2 - ( push a. -2 for allot offset )
; IMMEDIATE ; IMMEDIATE
: CREATE : CREATE
(entry) ( empty header with name ) (entry) ( empty header with name )
11 ( 11 == cellWord ) 11 ( 11 == cellWord )
C, ( write it ) , ( write it )
; ;
( We run this when we're in an entry creation context. Many ( We run this when we're in an entry creation context. Many
@ -71,11 +71,11 @@
: DOES> : DOES>
( Overwrite cellWord in CURRENT ) ( Overwrite cellWord in CURRENT )
( 43 == doesWord ) ( 43 == doesWord )
43 CURRENT @ C! 43 CURRENT @ !
( When we have a DOES>, we forcefully place HERE to 4 ( When we have a DOES>, we forcefully place HERE to 4
bytes after CURRENT. This allows a DOES word to use "," bytes after CURRENT. This allows a DOES word to use ","
and "C," without messing everything up. ) and "C," without messing everything up. )
CURRENT @ 3 + HERE ! CURRENT @ 4 + HERE !
( HERE points to where we should write R> ) ( HERE points to where we should write R> )
R> , R> ,
( We're done. Because we've popped RS, we'll exit parent ( We're done. Because we've popped RS, we'll exit parent
@ -97,7 +97,7 @@
( Increase loop counter and returns whether we should loop. ) ( Increase loop counter and returns whether we should loop. )
: _ : _
R> ( IP, keep for later ) R> ( IP, keep for later )
R> 1+ ( ip i+1 ) R> 1 + ( ip i+1 )
DUP >R ( ip i ) DUP >R ( ip i )
I' = ( ip f ) I' = ( ip f )
SWAP >R ( f ) SWAP >R ( f )
@ -123,7 +123,7 @@
; ;
: DELW : DELW
1- 0 SWAP C! 1 - 0 SWAP C!
; ;
: PREV : PREV
@ -132,7 +132,7 @@
; ;
: WHLEN : WHLEN
1- C@ ( name len field ) 1 - C@ ( name len field )
127 AND ( 0x7f. remove IMMEDIATE flag ) 127 AND ( 0x7f. remove IMMEDIATE flag )
3 + ( fixed header len ) 3 + ( fixed header len )
; ;
@ -155,6 +155,6 @@
['] INTERPRET ( I ) ['] INTERPRET ( I )
BEGIN ( I ) BEGIN ( I )
DUP ( I I ) DUP ( I I )
R> DROP I 2- @ ( I I a ) R> DROP I 2 - @ ( I I a )
= UNTIL = UNTIL
; ;

View File

@ -50,7 +50,7 @@
256 /MOD SWAP 256 /MOD SWAP
.x .x .x .x
SPC SPC
2+ 2 +
LOOP LOOP
DROP DROP
8 0 DO 8 0 DO
@ -58,7 +58,7 @@
DUP <>{ 0x20 &< 0x7e |> <>} DUP <>{ 0x20 &< 0x7e |> <>}
IF DROP '.' THEN IF DROP '.' THEN
EMIT EMIT
1+ 1 +
LOOP LOOP
CRLF CRLF
; ;

View File

@ -75,7 +75,7 @@
( special case: do we have a negative? ) ( special case: do we have a negative? )
DUP '-' = IF DUP '-' = IF
( Oh, a negative, let's recurse and reverse ) ( Oh, a negative, let's recurse and reverse )
DROP 1+ ( a+1 ) DROP 1 + ( a+1 )
(parsed) ( n f ) (parsed) ( n f )
0 ROT ( f 0 n ) 0 ROT ( f 0 n )
- SWAP EXIT ( 0-n f ) - SWAP EXIT ( 0-n f )
@ -88,7 +88,7 @@
2DROP 0 EXIT ( a 0 ) 2DROP 0 EXIT ( a 0 )
THEN THEN
BEGIN ( a r 0 ) BEGIN ( a r 0 )
DROP SWAP 1+ ( r a+1 ) DROP 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 )
@ -113,18 +113,18 @@
: , : ,
HERE @ ! HERE @ !
HERE @ 2+ HERE ! HERE @ 2 + HERE !
; ;
: C, : C,
HERE @ C! HERE @ C!
HERE @ 1+ HERE ! HERE @ 1 + HERE !
; ;
( The NOT is to normalize the negative/positive numbers to 1 ( The NOT is to normalize the negative/positive numbers to 1
or 0. Hadn't we wanted to normalize, we'd have written: or 0. Hadn't we wanted to normalize, we'd have written:
32 CMP 1 - ) 32 CMP 1 - )
: WS? 33 CMP 1+ NOT ; : WS? 33 CMP 1 + NOT ;
: TOWORD : TOWORD
BEGIN BEGIN
@ -141,8 +141,8 @@
BEGIN BEGIN
( We take advantage of the fact that char MSB is ( We take advantage of the fact that char MSB is
always zero to pre-write our null-termination ) always zero to pre-write our null-termination )
OVER ! ( a ) OVER ! ( a )
1+ ( a+1 ) 1 + ( a+1 )
C< ( a c ) C< ( a c )
DUP WS? DUP WS?
UNTIL UNTIL
@ -157,7 +157,7 @@
DUP C@ ( a c ) DUP C@ ( a c )
DUP C, ( a c ) DUP C, ( a c )
NOT IF DROP EXIT THEN NOT IF DROP EXIT THEN
1+ ( a+1 ) 1 + ( a+1 )
AGAIN AGAIN
; ;
@ -165,8 +165,8 @@
HERE @ ( w h ) HERE @ ( w h )
SWAP SCPY ( h ) SWAP SCPY ( h )
( Adjust HERE -1 because SCPY copies the null ) ( Adjust HERE -1 because SCPY copies the null )
HERE @ 1- ( h h' ) HERE @ 1 - ( h h' )
DUP HERE ! ( h h' ) DUP HERE ! ( h h' )
SWAP - ( sz ) SWAP - ( sz )
( write prev value ) ( write prev value )
HERE @ CURRENT @ - , HERE @ CURRENT @ - ,
@ -220,7 +220,7 @@
32 , , 32 , ,
; ;
: IMMED? 1- C@ 0x80 AND ; : IMMED? 1 - C@ 0x80 AND ;
( ';' can't have its name right away because, when created, it ( ';' can't have its name right away because, when created, it
is not an IMMEDIATE yet and will not be treated properly by is not an IMMEDIATE yet and will not be treated properly by
@ -237,7 +237,7 @@ XCURRENT @ ( to PSP )
( We cannot use LITN as IMMEDIATE because of bootstrapping ( We cannot use LITN as IMMEDIATE because of bootstrapping
issues. Same thing for ",". issues. Same thing for ",".
32 == NUMBER 14 == compiledWord ) 32 == NUMBER 14 == compiledWord )
[ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C, [ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] ,
BEGIN BEGIN
WORD WORD
(find) (find)

View File

@ -30,13 +30,13 @@
DUP <>{ 0x70 &= 0x58 |= 0x20 |= 0x24 |= <>} DUP <>{ 0x70 &= 0x58 |= 0x20 |= 0x24 |= <>}
IF DROP 4 + EXIT THEN IF DROP 4 + EXIT THEN
( regular word ) ( regular word )
0x22 = NOT IF 2+ EXIT THEN 0x22 = NOT IF 2 + EXIT THEN
( it's a lit, skip to null char ) ( it's a lit, skip to null char )
( a ) ( a )
1+ ( we skip by 2, but the loop below is pre-inc... ) 1 + ( we skip by 2, but the loop below is pre-inc... )
BEGIN 1+ DUP C@ NOT UNTIL BEGIN 1 + DUP C@ NOT UNTIL
( skip null char ) ( skip null char )
1+ 1 +
; ;
( Get word addr, starting at name's address ) ( Get word addr, starting at name's address )
@ -57,7 +57,7 @@
our number will be treated like a regular wordref. our number will be treated like a regular wordref.
) )
DROP DROP
2+ ( o ol a+2 ) 2 + ( o ol a+2 )
ROT ROT 2DROP ( a ) ROT ROT 2DROP ( a )
EXIT EXIT
THEN THEN
@ -82,7 +82,7 @@
) )
( ol o a1 a2 -- ) ( ol o a1 a2 -- )
: RLWORD : RLWORD
SWAP DUP C@ ( ol o a2 a1 n ) SWAP DUP @ ( ol o a2 a1 n )
( 0e == compiledWord, 2b == doesWord ) ( 0e == compiledWord, 2b == doesWord )
DUP <>{ 0x0e &= 0x2b |= <>} NOT IF DUP <>{ 0x0e &= 0x2b |= <>} NOT IF
( unwind all args ) ( unwind all args )
@ -93,9 +93,9 @@
( doesWord is processed exactly like a compiledWord, but ( doesWord is processed exactly like a compiledWord, but
starts 2 bytes further. ) starts 2 bytes further. )
( ol o a2 a1 n ) ( ol o a2 a1 n )
0x2b = IF 2+ THEN 0x2b = IF 2 + THEN
( ol o a2 a1 ) ( ol o a2 a1 )
1+ ( ol o a2 a1+1 ) 2 + ( ol o a2 a1+2 )
BEGIN ( ol o a2 a1 ) BEGIN ( ol o a2 a1 )
2OVER ( ol o a2 a1 ol o ) 2OVER ( ol o a2 a1 ol o )
SWAP ( ol o a2 a1 o ol ) SWAP ( ol o a2 a1 o ol )
@ -136,11 +136,11 @@
prev word is a "hook word", that is, an empty word. ) prev word is a "hook word", that is, an empty word. )
( H@ == target ) ( H@ == target )
DUP H@ ! DUP H@ !
DUP 1- C@ 0x7f AND ( t namelen ) DUP 1 - C@ 0x7f AND ( t namelen )
SWAP 3 - @ ( namelen po ) SWAP 3 - @ ( namelen po )
-^ ( o ) -^ ( o )
( H@+2 == offset ) ( H@+2 == offset )
H@ 2+ ! ( ) H@ 2 + ! ( )
( We have our offset, now let's copy our memory chunk ) ( We have our offset, now let's copy our memory chunk )
H@ @ DUP WHLEN - ( src ) H@ @ DUP WHLEN - ( src )
DUP H@ -^ ( src u ) DUP H@ -^ ( src u )
@ -162,7 +162,7 @@
DUP ROT ( wr wr we ) DUP ROT ( wr wr we )
( call RLWORD. we need a sig: ol o wr we ) ( call RLWORD. we need a sig: ol o wr we )
H@ @ ( wr wr we ol ) H@ @ ( wr wr we ol )
H@ 2+ @ ( wr wr we ol o ) H@ 2 + @ ( wr wr we ol o )
2SWAP ( wr ol o wr we ) 2SWAP ( wr ol o wr we )
RLWORD ( wr ) RLWORD ( wr )
( wr becomes wr's prev and we is wr-header ) ( wr becomes wr's prev and we is wr-header )

View File

@ -5,9 +5,9 @@
: (parsec) ( a -- n f ) : (parsec) ( a -- n f )
( apostrophe is ASCII 39 ) ( apostrophe is ASCII 39 )
DUP C@ 39 = NOT IF 0 EXIT THEN ( a 0 ) DUP C@ 39 = NOT IF 0 EXIT THEN ( a 0 )
DUP 2+ C@ 39 = NOT IF 0 EXIT THEN ( a 0 ) DUP 2 + C@ 39 = NOT IF 0 EXIT THEN ( a 0 )
( surrounded by apos, good, return ) ( surrounded by apos, good, return )
1+ C@ 1 ( n 1 ) 1 + C@ 1 ( n 1 )
; ;
( returns negative value on error ) ( returns negative value on error )
@ -28,7 +28,7 @@
( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 ) ( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
DUP @ 30768 = NOT IF 0 EXIT THEN ( a 0 ) DUP @ 30768 = NOT IF 0 EXIT THEN ( a 0 )
( We have "0x" prefix ) ( We have "0x" prefix )
2+ 2 +
( validate slen ) ( validate slen )
DUP SLEN ( a l ) DUP SLEN ( a l )
DUP 0 = IF DROP 0 EXIT THEN ( a 0 ) DUP 0 = IF DROP 0 EXIT THEN ( a 0 )
@ -40,7 +40,7 @@
hexdig ( a r n ) hexdig ( a r n )
DUP 0 < IF DROP DROP 1 EXIT THEN ( a 0 ) DUP 0 < IF DROP DROP 1 EXIT THEN ( a 0 )
SWAP 16 * + ( a r*16+n ) SWAP 16 * + ( a r*16+n )
SWAP 1+ SWAP ( a+1 r ) SWAP 1 + SWAP ( a+1 r )
AGAIN AGAIN
; ;
@ -58,7 +58,7 @@
( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 ) ( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 )
DUP @ 25136 = NOT IF 0 EXIT THEN ( a 0 ) DUP @ 25136 = NOT IF 0 EXIT THEN ( a 0 )
( We have "0b" prefix ) ( We have "0b" prefix )
2+ 2 +
( validate slen ) ( validate slen )
DUP SLEN ( a l ) DUP SLEN ( a l )
DUP 0 = IF DROP 0 EXIT THEN ( a 0 ) DUP 0 = IF DROP 0 EXIT THEN ( a 0 )
@ -70,7 +70,7 @@
bindig ( a r n ) bindig ( a r n )
DUP 0 < IF DROP DROP 1 EXIT THEN ( a 0 ) DUP 0 < IF DROP DROP 1 EXIT THEN ( a 0 )
SWAP 2 * + ( a r*2+n ) SWAP 2 * + ( a r*2+n )
SWAP 1+ SWAP ( a+1 r ) SWAP 1 + SWAP ( a+1 r )
AGAIN AGAIN
; ;

View File

@ -14,7 +14,7 @@
( points to INBUF ) ( points to INBUF )
: IN( 2 RDLNMEM+ ; : IN( 2 RDLNMEM+ ;
( points to INBUF's end ) ( points to INBUF's end )
: IN) INBUFSZ 2+ RDLNMEM+ ; : IN) INBUFSZ 2 + RDLNMEM+ ;
( flush input buffer ) ( flush input buffer )
( set IN> to IN( and set IN> @ to null ) ( set IN> to IN( and set IN> @ to null )
@ -25,7 +25,7 @@
: (inbs) : (inbs)
( already at IN( ? ) ( already at IN( ? )
IN> @ IN( = IF EXIT THEN IN> @ IN( = IF EXIT THEN
IN> @ 1- IN> ! IN> @ 1 - IN> !
SPC BS SPC BS
; ;

View File

@ -2,6 +2,6 @@
DUP ( astart aend ) DUP ( astart aend )
BEGIN BEGIN
DUP C@ 0 = IF -^ EXIT THEN DUP C@ 0 = IF -^ EXIT THEN
1+ 1 +
AGAIN AGAIN
; ;

View File

@ -34,7 +34,7 @@ VARIABLE XOFF
: X: : X:
(xentry) (xentry)
( 0e == compiledWord ) ( 0e == compiledWord )
[ 0x0e LITN ] C, [ 0x0e LITN ] ,
BEGIN BEGIN
WORD WORD
( cross compile CURRENT ) ( cross compile CURRENT )

View File

@ -158,11 +158,6 @@
0x0b OP1qq DECss, 0x0b OP1qq DECss,
0x09 OP1qq ADDHLss, 0x09 OP1qq ADDHLss,
: ADDIXss, 0xdd A, ADDHLss, ;
: ADDIXIX, HL ADDIXss, ;
: ADDIYss, 0xfd A, ADDHLss, ;
: ADDIYIY, HL ADDIYss, ;
: _1rr : _1rr
C@ ( rd rr op ) C@ ( rd rr op )
ROT ( rr op rd ) ROT ( rr op rd )
@ -329,7 +324,7 @@
( same as CREATE, but with native word ) ( same as CREATE, but with native word )
(entry) (entry)
( 23 == nativeWord ) ( 23 == nativeWord )
23 C, 23 ,
; ;
: ;CODE JPNEXT, ; : ;CODE JPNEXT, ;
@ -371,7 +366,7 @@
( Place BEGIN, where you want to jump back and AGAIN after ( Place BEGIN, where you want to jump back and AGAIN after
a relative jump operator. Just like BSET and BWR. ) a relative jump operator. Just like BSET and BWR. )
: BEGIN, PC ; : BEGIN, PC ;
: AGAIN, PC - 1- A, ; : AGAIN, PC - 1 - A, ;
: BSET PC SWAP ! ; : BSET PC SWAP ! ;
: BWR @ AGAIN, ; : BWR @ AGAIN, ;
@ -383,10 +378,11 @@
: IFNC, JRC, FJR, ; : IFNC, JRC, FJR, ;
: THEN, : THEN,
DUP PC ( l l pc ) DUP PC ( l l pc )
-^ 1- ( l off ) -^ 1 - ( l off )
( warning: l is a PC offset, not a mem addr! ) ( warning: l is a PC offset, not a mem addr! )
SWAP ORG @ + ( off addr ) SWAP ORG @ + ( off addr )
C! C!
; ;
: FWR BSET 0 A, ; : FWR BSET 0 A, ;
: FSET @ THEN, ; : FSET @ THEN, ;

View File

@ -14,11 +14,6 @@
This unit expects the same conf as boot.fs. This unit expects the same conf as boot.fs.
) )
CODE EXECUTE
DE POPqq,
chkPS,
0x33 JPnn, ( 33 == execute )
( a b c -- b c a ) ( a b c -- b c a )
CODE ROT CODE ROT
HL POPqq, ( C ) HL POPqq, ( C )
@ -85,13 +80,13 @@ CODE 2OVER
HL POPqq, ( D ) HL POPqq, ( D )
DE POPqq, ( C ) DE POPqq, ( C )
BC POPqq, ( B ) BC POPqq, ( B )
EXX, HL POPqq, EXX, ( A ) IY POPqq, ( A )
chkPS, chkPS,
EXX, HL PUSHqq, EXX, ( A ) IY PUSHqq, ( A )
BC PUSHqq, ( B ) BC PUSHqq, ( B )
DE PUSHqq, ( C ) DE PUSHqq, ( C )
HL PUSHqq, ( D ) HL PUSHqq, ( D )
EXX, HL PUSHqq, EXX, ( A ) IY PUSHqq, ( A )
BC PUSHqq, ( B ) BC PUSHqq, ( B )
;CODE ;CODE
@ -101,11 +96,11 @@ CODE 2SWAP
HL POPqq, ( D ) HL POPqq, ( D )
DE POPqq, ( C ) DE POPqq, ( C )
BC POPqq, ( B ) BC POPqq, ( B )
EXX, HL POPqq, EXX, ( A ) IY POPqq, ( A )
chkPS, chkPS,
DE PUSHqq, ( C ) DE PUSHqq, ( C )
HL PUSHqq, ( D ) HL PUSHqq, ( D )
EXX, HL PUSHqq, EXX, ( A ) IY PUSHqq, ( A )
BC PUSHqq, ( B ) BC PUSHqq, ( B )
;CODE ;CODE
@ -381,48 +376,3 @@ CODE (im1)
IM1, IM1,
EI, EI,
;CODE ;CODE
CODE 0
HL 0 LDddnn,
HL PUSHqq,
;CODE
CODE 1
HL 1 LDddnn,
HL PUSHqq,
;CODE
CODE -1
HL -1 LDddnn,
HL PUSHqq,
;CODE
CODE 1+
HL POPqq,
chkPS,
HL INCss,
HL PUSHqq,
;CODE
CODE 1-
HL POPqq,
chkPS,
HL DECss,
HL PUSHqq,
;CODE
CODE 2+
HL POPqq,
chkPS,
HL INCss,
HL INCss,
HL PUSHqq,
;CODE
CODE 2-
HL POPqq,
chkPS,
HL DECss,
HL DECss,
HL PUSHqq,
;CODE