mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-26 13:38:05 +11:00
Compare commits
6 Commits
415bd7a169
...
22f132094a
Author | SHA1 | Date | |
---|---|---|---|
|
22f132094a | ||
|
b73e1a5f7a | ||
|
2439f1ed86 | ||
|
16d5cd91de | ||
|
c40f336959 | ||
|
79acf92b28 |
2
blk/003
2
blk/003
@ -9,4 +9,4 @@ Contents
|
||||
|
||||
4 DOES> 6 Compilation vs meta-comp.
|
||||
8 I/O 11 Chained comparisons
|
||||
14 Addressed devices
|
||||
14 Addressed devices 18 Signed-ness
|
||||
|
9
blk/018
Normal file
9
blk/018
Normal file
@ -0,0 +1,9 @@
|
||||
Signed-ness
|
||||
|
||||
For simplicity purposes, numbers are generally considered
|
||||
unsigned. For convenience, decimal parsing and formatting
|
||||
support the "-" prefix, but under the hood, it's all unsigned.
|
||||
|
||||
This leads to some oddities. For example, "-1 0 <" is false.
|
||||
To compare whether something is negative, use the "<0" word
|
||||
which is the equivalent to "0x7fff >".
|
2
blk/058
2
blk/058
@ -5,6 +5,6 @@ LIT -- Write a LIT entry. You're expected to write
|
||||
LIT< x -- Read following word and write to HERE as a
|
||||
string literal.
|
||||
LITS a -- Write word at addr a as a atring literal.
|
||||
SCMP a1 a2 -- n Compare strings a1 and a2. See CMP
|
||||
S= a1 a2 -- f Returns whether string a1 == a2.
|
||||
SCPY a -- Copy string at addr a into HERE.
|
||||
SLEN a -- n Push length of str at a.
|
||||
|
@ -22,6 +22,8 @@ all: $(TARGETS)
|
||||
|
||||
$(BLKPACK):
|
||||
$(MAKE) -C ../tools
|
||||
|
||||
.PHONY: $(STRIPFC) $(SLATEST) $(BIN2C)
|
||||
$(STRIPFC): $(BLKPACK)
|
||||
$(SLATEST): $(BLKPACK)
|
||||
$(BIN2C): $(BLKPACK)
|
||||
|
@ -118,7 +118,9 @@ int main(int argc, char *argv[])
|
||||
tcsetattr(0, TCSAFLUSH, &termInfo);
|
||||
emul_printdebug();
|
||||
}
|
||||
if (blkfp != NULL) {
|
||||
fclose(blkfp);
|
||||
}
|
||||
fclose(fp);
|
||||
return retcode;
|
||||
}
|
||||
|
Binary file not shown.
@ -27,7 +27,7 @@ NOP, NOP, ( 20, numberWord )
|
||||
NOP, NOP, ( 22, litWord )
|
||||
NOP, NOP, ( 24, addrWord )
|
||||
NOP, NOP, ( 26, unused )
|
||||
0 JPnn, ( 28, flagsToBC )
|
||||
RAMSTART 0x4e + JPnn, ( 28, RST 28 )
|
||||
0 JPnn, ( 2b, doesWord )
|
||||
NOP, NOP, ( 2e, unused )
|
||||
RAMSTART 0x4e + JPnn, ( RST 30 )
|
||||
@ -201,7 +201,7 @@ L4 FSET L3 FSET ( loopend )
|
||||
( HL is prev field's addr. Is offset zero? )
|
||||
A D LDrr,
|
||||
E ORr,
|
||||
IFZ, ( noprev )
|
||||
IFNZ, ( noprev )
|
||||
( get absolute addr from offset )
|
||||
( carry cleared from "or e" )
|
||||
DE SBCHLss,
|
||||
@ -218,16 +218,6 @@ L4 FSET ( end )
|
||||
BC POPqq,
|
||||
RET,
|
||||
|
||||
PC ORG @ 0x29 + ! ( flagsToBC )
|
||||
BC 0 LDddnn,
|
||||
CZ RETcc, ( equal )
|
||||
BC INCss,
|
||||
CC RETcc, ( > )
|
||||
( < )
|
||||
BC DECss,
|
||||
BC DECss,
|
||||
RET,
|
||||
|
||||
PC ORG @ 0x12 + ! ( pushRS )
|
||||
IX INCss,
|
||||
IX INCss,
|
||||
|
@ -2,6 +2,8 @@
|
||||
|
||||
: >= < NOT ;
|
||||
: <= > NOT ;
|
||||
: <0 32767 > ;
|
||||
: >=0 <0 NOT ;
|
||||
|
||||
( n1 -- n1 true )
|
||||
: <>{ 1 ;
|
||||
|
@ -18,7 +18,7 @@
|
||||
: BEGIN H@ ; IMMEDIATE
|
||||
: AGAIN COMPILE (br) H@ - , ; IMMEDIATE
|
||||
: UNTIL COMPILE (?br) H@ - , ; IMMEDIATE
|
||||
: ( BEGIN LIT< ) WORD SCMP NOT UNTIL ; IMMEDIATE
|
||||
: ( BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE
|
||||
( Hello, hello, krkrkrkr... do you hear me?
|
||||
Ah, voice at last! Some lines above need comments
|
||||
BTW: Forth lines limited to 64 cols because of default
|
||||
|
@ -12,9 +12,7 @@
|
||||
|
||||
: . ( n -- )
|
||||
( handle negative )
|
||||
( that "0 1 -" thing is because we don't parse negative
|
||||
number correctly yet. )
|
||||
DUP 0 < IF '-' EMIT 0 1 - * THEN
|
||||
DUP <0 IF '-' EMIT -1 * THEN
|
||||
_
|
||||
BEGIN
|
||||
DUP '9' > IF DROP EXIT THEN ( stop indicator, we're done )
|
||||
|
@ -52,37 +52,52 @@
|
||||
: < CMP -1 = ;
|
||||
: > CMP 1 = ;
|
||||
|
||||
( r c -- r f )
|
||||
( Parse digit c and accumulate into result r.
|
||||
Flag f is 0 when c was a valid digit, 1 when c was WS,
|
||||
-1 when c was an invalid digit. )
|
||||
: _pdacc
|
||||
DUP 0x21 < IF DROP 1 EXIT THEN
|
||||
( parse char )
|
||||
'0' -
|
||||
( if bad, return "r -1" )
|
||||
DUP 0 < IF DROP -1 EXIT THEN ( bad )
|
||||
DUP 9 > IF DROP -1 EXIT THEN ( bad )
|
||||
( good, add to running result )
|
||||
SWAP 10 * + ( r*10+n )
|
||||
0 ( good )
|
||||
;
|
||||
|
||||
: (parsed) ( a -- n f )
|
||||
( read first char outside of the loop. it *has* to be
|
||||
nonzero. )
|
||||
DUP C@ ( a c )
|
||||
DUP NOT IF EXIT THEN ( a 0 )
|
||||
( special case: do we have a negative? )
|
||||
DUP '-' = IF
|
||||
( Oh, a negative, let's recurse and reverse )
|
||||
DROP 1 + ( a+1 )
|
||||
(parsed) ( n f )
|
||||
SWAP 0 SWAP ( f 0 n )
|
||||
0 ROT ( f 0 n )
|
||||
- SWAP EXIT ( 0-n f )
|
||||
THEN
|
||||
( running result, staring at zero )
|
||||
( running result from first char )
|
||||
0 SWAP ( a r c )
|
||||
( Loop over chars )
|
||||
BEGIN
|
||||
( parse char )
|
||||
'0' -
|
||||
( if bad, return "a 0" )
|
||||
DUP 0 < IF 2DROP 0 EXIT THEN ( bad )
|
||||
DUP 9 > IF 2DROP 0 EXIT THEN ( bad )
|
||||
( good, add to running result )
|
||||
SWAP 10 * + ( a r*10+n )
|
||||
SWAP 1 + SWAP ( a+1 r )
|
||||
( read next char )
|
||||
OVER C@
|
||||
DUP NOT UNTIL
|
||||
( we're done and it's a success. We have "a r c", we want
|
||||
"r 1". )
|
||||
DROP SWAP DROP 1
|
||||
_pdacc ( a r f )
|
||||
DUP IF
|
||||
( first char was not a valid digit )
|
||||
2DROP 0 EXIT ( a 0 )
|
||||
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
|
||||
( a r f -- f is 1 on success, -1 on error, normalize
|
||||
to bool. )
|
||||
1 = ( a r f )
|
||||
( we want "r f" )
|
||||
ROT DROP
|
||||
;
|
||||
|
||||
( This is only the "early parser" in earlier stages. No need
|
||||
|
@ -372,10 +372,10 @@
|
||||
: BWR @ AGAIN, ;
|
||||
( same as BSET, but we need to write a placeholder )
|
||||
: FJR, PC 0 A, ;
|
||||
: IFZ, JRZ, FJR, ;
|
||||
: IFNZ, JRNZ, FJR, ;
|
||||
: IFC, JRC, FJR, ;
|
||||
: IFNC, JRNC, FJR, ;
|
||||
: IFZ, JRNZ, FJR, ;
|
||||
: IFNZ, JRZ, FJR, ;
|
||||
: IFC, JRNC, FJR, ;
|
||||
: IFNC, JRC, FJR, ;
|
||||
: THEN,
|
||||
DUP PC ( l l pc )
|
||||
-^ 1 - ( l off )
|
||||
|
@ -149,10 +149,10 @@ CODE NOT
|
||||
A L LDrr,
|
||||
H ORr,
|
||||
HL 0 LDddnn,
|
||||
IFNZ, ( skip )
|
||||
IFZ,
|
||||
( false, make 1 )
|
||||
HL INCss,
|
||||
THEN, ( skip )
|
||||
THEN,
|
||||
HL PUSHqq,
|
||||
;CODE
|
||||
|
||||
@ -209,10 +209,10 @@ CODE /MOD
|
||||
RLA,
|
||||
HL ADCHLss,
|
||||
DE SBCHLss,
|
||||
IFNC, ( skip )
|
||||
IFC,
|
||||
DE ADDHLss,
|
||||
C DECr,
|
||||
THEN, ( skip )
|
||||
THEN,
|
||||
DJNZ, AGAIN, ( loop )
|
||||
B A LDrr,
|
||||
HL PUSHqq,
|
||||
@ -311,10 +311,13 @@ CODE (resRS)
|
||||
IX RS_ADDR LDddnn,
|
||||
;CODE
|
||||
|
||||
CODE SCMP
|
||||
CODE S=
|
||||
DE POPqq,
|
||||
HL POPqq,
|
||||
chkPS,
|
||||
( pre-push false )
|
||||
BC 0 LDddnn,
|
||||
BC PUSHqq,
|
||||
BEGIN, ( loop )
|
||||
LDA(DE),
|
||||
(HL) CPr,
|
||||
@ -324,10 +327,11 @@ CODE SCMP
|
||||
HL INCss,
|
||||
DE INCss,
|
||||
JRNZ, AGAIN, ( loop )
|
||||
( success, change false to true )
|
||||
HL POPqq,
|
||||
HL INCss,
|
||||
HL PUSHqq,
|
||||
L1 FSET ( end )
|
||||
( 40 == flagsToBC )
|
||||
40 CALLnn,
|
||||
BC PUSHqq,
|
||||
;CODE
|
||||
|
||||
CODE CMP
|
||||
@ -335,8 +339,16 @@ CODE CMP
|
||||
DE POPqq,
|
||||
chkPS,
|
||||
DE SUBHLss,
|
||||
( 40 == flagsToBC )
|
||||
40 CALLnn,
|
||||
BC 0 LDddnn,
|
||||
IFNZ,
|
||||
( not equal )
|
||||
BC INCss,
|
||||
IFNC,
|
||||
( < )
|
||||
BC DECss,
|
||||
BC DECss,
|
||||
THEN,
|
||||
THEN,
|
||||
BC PUSHqq,
|
||||
;CODE
|
||||
|
||||
@ -347,13 +359,14 @@ CODE _find
|
||||
chkPS,
|
||||
( 3 == find )
|
||||
3 CALLnn,
|
||||
IFZ, ( found )
|
||||
IFNZ,
|
||||
( not found )
|
||||
HL PUSHqq,
|
||||
DE 0 LDddnn,
|
||||
DE PUSHqq,
|
||||
JPNEXT,
|
||||
THEN, ( found )
|
||||
THEN,
|
||||
( found )
|
||||
DE PUSHqq,
|
||||
DE 1 LDddnn,
|
||||
DE PUSHqq,
|
||||
|
@ -3,3 +3,4 @@
|
||||
0x42 <>{ 0x40 &> 0x44 &< <>} #
|
||||
0x44 <>{ 0x40 &> 0x44 &< <>} NOT #
|
||||
0x22 0x8065 < #
|
||||
-1 0 > #
|
||||
|
Loading…
Reference in New Issue
Block a user