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

Compare commits

...

13 Commits

Author SHA1 Message Date
Virgil Dupras
4eca827d36 First function application: Block explorer! 2020-04-15 22:39:14 -04:00
Virgil Dupras
5d4155aa32 Add words 1+ 2+ 1- 2- and consts 0 1 -1
Saves quite a few bytes in the final binary.
2020-04-15 21:29:39 -04:00
Virgil Dupras
e1e634c815 boot: compaction
It's more hassle than it seems to move the stable ABI...
2020-04-15 20:57:46 -04:00
Virgil Dupras
f6727f8e34 boot: use CODE where possible
Now that we use xcomp unit, boot entry creation can be a bit
cleaner.
2020-04-15 20:17:28 -04:00
Virgil Dupras
a56ace4d3e boot: optimize (br) 2020-04-15 20:03:56 -04:00
Virgil Dupras
0750e8d0c0 Use IY for IP instead of RAM+06 2020-04-15 17:01:15 -04:00
Virgil Dupras
2a84a426b4 Strip usages of IY register 2020-04-15 16:53:04 -04:00
Virgil Dupras
2b0186fd58 boot: make routine field 1b
I forgot to do it earlier. NOP having an opcode of 0, it didn't have
any effect.
2020-04-15 16:24:03 -04:00
Virgil Dupras
6884c5cbe3 boot: use 3 labels instead of 4 2020-04-15 16:13:10 -04:00
Virgil Dupras
d2ec5e271c Optimize boot binary's word execution code
Should be significantly faster now. Less push/popping and usage of
DE instead of IY.
2020-04-15 16:09:10 -04:00
Virgil Dupras
d8de8a058a Make word routine refs 1b instead of 2
Saves quite a bit of binary space. More than 300 bytes in forth1.bin
2020-04-15 15:16:11 -04:00
Virgil Dupras
e40c059c26 Make word routines all in the <0x100 range 2020-04-15 14:00:59 -04:00
Virgil Dupras
728e4ce123 Bring EXECUTE word outside of stable ABI 2020-04-15 13:36:28 -04:00
21 changed files with 239 additions and 184 deletions

View File

@ -3,7 +3,8 @@ Collapse OS file system
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
each. You refer to blocks by numbers. You show them with LIST.
You interpret them with LOAD.
You interpret them with LOAD. For a convenient way to browse
blocks, see Block Explorer at B100.
Conventions: When you see "(cont.)" at the bottom right of a
block, it means that the next block continues the same kind of

View File

@ -10,3 +10,5 @@ MOD a b -- c a % b -> c
AND a b -- c a & b -> c
OR 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
- 2b prev offset
- 1b size + IMMEDIATE flag
- 2b code pointer
- 1b code pointer (always jumps in the <0x100 range)
- Parameter field (PF)
The prev offset is the number of bytes between the prev field

View File

@ -1,7 +1,9 @@
(cont.) The code pointer point to "word routines". These
routines expect to be called with IY pointing to the PF. They
themselves are expected to end by jumping to the address at
(IP). They will usually do so with "jp next".
(IP). They will usually do so with "jp next". They are 1b
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
chain). There are also "special words", for example NUMBER,

View File

@ -2,7 +2,7 @@
RAMSTART INITIAL_SP +53 readln's variables
+02 CURRENT +55 adev's variables
+04 HERE +57 blk's variables
+06 IP +59 z80a's variables
+06 FUTURE USES +59 z80a's variables
+08 FLAGS +5b FUTURE USES
+0a PARSEPTR +70 DRIVERS
+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.
Typing a decimal number followed by space or return lists the
contents of that block.
contents of that block. B for previous block, N for next.

16
blk/102
View File

@ -1,2 +1,14 @@
: foo ." Hello world! " 42 . ;
foo
103 LOAD
VARIABLE _K
: 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 +1,9 @@
42 . 102 LOAD 43 .
VARIABLE ACC
: _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
BLK@
16 0 DO
I 1 + .2 SPC
I 1+ .2 SPC
64 I * BLK( + (print)
CRLF
LOOP

View File

@ -1,6 +1,13 @@
( Configuration words: RAMSTART, RS_ADDR )
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
Those jumps below are supposed to stay at these offsets,
always. If they change bootstrap binaries have to be
@ -20,7 +27,7 @@ NOP, ( 0a, unused )
0 JPnn, ( 0e, compiledWord )
0 JPnn, ( 11, pushRS )
0 JPnn, ( 14, popRS )
JP(IY), NOP, ( 17, nativeWord )
EXDEHL, JP(HL), NOP, ( 17, nativeWord )
0 JPnn, ( 1a, next )
0 JPnn, ( 1d, chkPS )
NOP, NOP, ( 20, numberWord )
@ -31,77 +38,82 @@ RAMSTART 0x4e + JPnn, ( 28, RST 28 )
0 JPnn, ( 2b, doesWord )
NOP, NOP, ( 2e, unused )
RAMSTART 0x4e + JPnn, ( RST 30 )
NOP, NOP, NOP, ( unused )
0 JPnn, ( 33, execute )
NOP, NOP, ( unused )
RAMSTART 0x4e + JPnn, ( RST 38 )
NOP, ( unused )
( BOOT DICT
There are only 5 words in the boot dict, but these words'
There are only 3 words in the boot dict, but these words'
offset need to be stable, so they're part of the "stable
ABI"
)
'E' A, 'X' A, 'I' A, 'T' A,
0 A,, ( prev )
4 A,
L1 BSET ( EXIT )
0x17 A,, ( nativeWord )
0x14 CALLnn, ( popRS )
RAMSTART 0x06 + LD(nn)HL, ( RAMSTART+0x06 == IP )
H@ XCURRENT ! ( set current tip of dict, 0x42 )
0x17 A, ( nativeWord )
0x14 CALLnn, ( popRS )
HL PUSHqq, IY POPqq, ( --> IP )
JPNEXT,
NOP, NOP, NOP, ( unused )
'(' A, 'b' A, 'r' A, ')' A,
PC L1 @ - A,, ( prev )
4 A,
L1 BSET ( BR )
0x17 A,, ( nativeWord )
CODE (br) ( 0x53 )
L2 BSET ( used in CBR )
RAMSTART 0x06 + LDHL(nn), ( RAMSTART+0x06 == IP )
E (HL) LDrr,
HL INCss,
D (HL) LDrr,
HL DECss,
DE ADDHLss,
RAMSTART 0x06 + LD(nn)HL, ( RAMSTART+0x06 == IP )
E 0 IY+ LDrIXY,
D 1 IY+ LDrIXY,
DE ADDIYss,
JPNEXT,
'(' A, '?' A, 'b' A, 'r' A, ')' A,
PC L1 @ - A,, ( prev )
5 A,
L1 BSET ( CBR )
0x17 A,, ( nativeWord )
CODE (?br) ( 0x67 )
HL POPqq,
chkPS,
A H LDrr,
L ORr,
JRZ, L2 BWR ( BR + 2. False, branch )
( True, skip next 2 bytes and don't branch )
RAMSTART 0x06 + LDHL(nn), ( RAMSTART+0x06 == IP )
HL INCss,
HL INCss,
RAMSTART 0x06 + LD(nn)HL, ( RAMSTART+0x06 == IP )
IY INCss,
IY INCss,
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 )
( 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 )
L1 BSET
'B' A, 'O' A, 'O' A, 'T' A, 0 A,
@ -129,8 +141,7 @@ PC ORG @ 1 + ! ( main )
EXDEHL,
HL L1 @ LDddnn,
0x03 CALLnn, ( 03 == find )
DE PUSHqq,
L2 @ 2 + JPnn,
0x33 JPnn, ( 33 == execute )
PC ORG @ 4 + ! ( find )
( Find the entry corresponding to word name where (HL) points
@ -167,7 +178,7 @@ BEGIN, ( inner )
LDA(DE),
0x7f ANDn, ( remove IMMEDIATE flag )
C CPr,
JRNZ, L4 FWR ( loopend )
JRNZ, L2 FWR ( loopend )
( match, let's compare the string then )
DE DECss, ( Skip prev field. One less because we )
DE DECss, ( pre-decrement )
@ -180,12 +191,12 @@ BEGIN, ( loop )
(HL) CPr,
JRNZ, L3 FWR ( loopend )
DJNZ, AGAIN, ( loop )
L4 FSET L3 FSET ( loopend )
L2 FSET L3 FSET ( loopend )
( At this point, Z is set if we have a match. In all cases,
we want to pop HL and DE )
DE POPqq, ( <-- lvl 2 )
HL POPqq, ( <-- lvl 1 )
JRZ, L4 FWR ( end, match? we're done! )
JRZ, L2 FWR ( end, match? we're done! )
( no match, go to prev and continue )
HL PUSHqq, ( --> lvl 1 )
DE DECss,
@ -213,7 +224,7 @@ L4 FSET L3 FSET ( loopend )
L1 FSET ( fail )
A XORr,
A INCr,
L4 FSET ( end )
L2 FSET ( end )
HL POPqq,
BC POPqq,
RET,
@ -237,8 +248,7 @@ L1 BSET ( abortUnderflow )
HL PC 7 - LDddnn,
DE RAMSTART 0x02 + LDdd(nn), ( RAM+02 == CURRENT )
0x03 CALLnn, ( find )
DE PUSHqq,
L2 @ 2 + JPnn, ( EXECUTE, skip nativeWord )
0x33 JPnn, ( 33 == execute )
PC ORG @ 0x1e + ! ( chkPS )
@ -255,7 +265,7 @@ PC ORG @ 0x1e + ! ( chkPS )
CNC RETcc, ( INITIAL_SP >= SP? good )
JR, L1 BWR ( abortUnderflow )
L3 BSET ( chkRS )
L2 BSET ( chkRS )
IX PUSHqq, HL POPqq,
DE RS_ADDR LDddnn,
DE SUBHLss,
@ -269,44 +279,45 @@ PC ORG @ 0x1b + ! ( next )
it by 2 before jumping. )
( Before we continue: are stacks within bounds? )
0x1d CALLnn, ( chkPS )
L3 @ CALLnn, ( chkRS )
DE RAMSTART 0x06 + LDdd(nn), ( RAMSTART+0x06 == IP )
H D LDrr,
L E LDrr,
DE INCss,
DE INCss,
RAMSTART 0x06 + DE LD(nn)dd, ( RAMSTART+0x06 == IP )
( HL is an atom list pointer. We need to go into it to
have a wordref )
E (HL) LDrr,
HL INCss,
D (HL) LDrr,
DE PUSHqq,
L2 @ 2 + JPnn, ( EXECUTE, skip nativeWord )
L2 @ CALLnn, ( chkRS )
E 0 IY+ LDrIXY,
D 1 IY+ LDrIXY,
IY INCss,
IY INCss,
( continue to execute )
( WORD ROUTINES )
PC ORG @ 0x34 + ! ( execute )
( DE points to wordref )
EXDEHL,
E (HL) LDrr,
D 0 LDrn,
EXDEHL,
( HL points to code pointer )
DE INCss,
( DE points to PFA )
JP(HL),
PC ORG @ 0x0f + ! ( compiledWord )
( Execute a list of atoms, which always end with EXIT.
IY points to that list. What do we do:
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. )
RAMSTART 0x06 + LDHL(nn), ( RAMSTART+0x06 == IP )
IY PUSHqq, HL POPqq, ( <-- IP )
0x11 CALLnn, ( 11 == pushRS )
IY PUSHqq, HL POPqq,
EXDEHL, ( HL points to PFA )
( While we increase, dereference into DE for execute call
later. )
E (HL) LDrr,
HL INCss,
D (HL) LDrr,
HL INCss,
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 )
HL PUSHqq, IY POPqq, ( --> IP )
0x33 JPnn, ( 33 == execute )
PC ORG @ 0x0c + ! ( cellWord )
( Pushes the PFA directly )
IY PUSHqq,
( Pushes PFA directly )
DE PUSHqq,
JPNEXT,
PC ORG @ 0x2c + ! ( doesWord )
@ -317,46 +328,11 @@ PC ORG @ 0x2c + ! ( doesWord )
linkfrom the PFA, and then continue as a regular
compiledWord.
)
IY PUSHqq, ( like a regular cell )
L 2 IY+ LDrIXY,
H 3 IY+ LDrIXY,
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 )
DE PUSHqq, ( like a regular cell )
EXDEHL,
HL INCss,
HL INCss,
E (HL) LDrr,
HL INCss,
D (HL) LDrr,
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,
0x0e JPnn, ( 0e == compiledWord )

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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