mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 10:20:55 +11:00
Compare commits
No commits in common. "22f132094a11e260718f97f4ff0564c7869deb8b" and "415bd7a169d7bcfb82901af291298b92cf748e05" have entirely different histories.
22f132094a
...
415bd7a169
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 18 Signed-ness
|
||||
14 Addressed devices
|
||||
|
9
blk/018
9
blk/018
@ -1,9 +0,0 @@
|
||||
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.
|
||||
S= a1 a2 -- f Returns whether string a1 == a2.
|
||||
SCMP a1 a2 -- n Compare strings a1 and a2. See CMP
|
||||
SCPY a -- Copy string at addr a into HERE.
|
||||
SLEN a -- n Push length of str at a.
|
||||
|
@ -22,8 +22,6 @@ all: $(TARGETS)
|
||||
|
||||
$(BLKPACK):
|
||||
$(MAKE) -C ../tools
|
||||
|
||||
.PHONY: $(STRIPFC) $(SLATEST) $(BIN2C)
|
||||
$(STRIPFC): $(BLKPACK)
|
||||
$(SLATEST): $(BLKPACK)
|
||||
$(BIN2C): $(BLKPACK)
|
||||
|
@ -118,9 +118,7 @@ int main(int argc, char *argv[])
|
||||
tcsetattr(0, TCSAFLUSH, &termInfo);
|
||||
emul_printdebug();
|
||||
}
|
||||
if (blkfp != NULL) {
|
||||
fclose(blkfp);
|
||||
}
|
||||
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 )
|
||||
RAMSTART 0x4e + JPnn, ( 28, RST 28 )
|
||||
0 JPnn, ( 28, flagsToBC )
|
||||
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,
|
||||
IFNZ, ( noprev )
|
||||
IFZ, ( noprev )
|
||||
( get absolute addr from offset )
|
||||
( carry cleared from "or e" )
|
||||
DE SBCHLss,
|
||||
@ -218,6 +218,16 @@ 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,8 +2,6 @@
|
||||
|
||||
: >= < 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 S= UNTIL ; IMMEDIATE
|
||||
: ( BEGIN LIT< ) WORD SCMP NOT 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,7 +12,9 @@
|
||||
|
||||
: . ( n -- )
|
||||
( handle negative )
|
||||
DUP <0 IF '-' EMIT -1 * THEN
|
||||
( that "0 1 -" thing is because we don't parse negative
|
||||
number correctly yet. )
|
||||
DUP 0 < IF '-' EMIT 0 1 - * THEN
|
||||
_
|
||||
BEGIN
|
||||
DUP '9' > IF DROP EXIT THEN ( stop indicator, we're done )
|
||||
|
@ -52,52 +52,37 @@
|
||||
: < 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 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 )
|
||||
0 ROT ( f 0 n )
|
||||
(parsed) ( n f )
|
||||
SWAP 0 SWAP ( f 0 n )
|
||||
- SWAP EXIT ( 0-n f )
|
||||
THEN
|
||||
( running result from first char )
|
||||
( running result, staring at zero )
|
||||
0 SWAP ( a r c )
|
||||
_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
|
||||
( 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
|
||||
;
|
||||
|
||||
( 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, JRNZ, FJR, ;
|
||||
: IFNZ, JRZ, FJR, ;
|
||||
: IFC, JRNC, FJR, ;
|
||||
: IFNC, JRC, FJR, ;
|
||||
: IFZ, JRZ, FJR, ;
|
||||
: IFNZ, JRNZ, FJR, ;
|
||||
: IFC, JRC, FJR, ;
|
||||
: IFNC, JRNC, FJR, ;
|
||||
: THEN,
|
||||
DUP PC ( l l pc )
|
||||
-^ 1 - ( l off )
|
||||
|
@ -149,10 +149,10 @@ CODE NOT
|
||||
A L LDrr,
|
||||
H ORr,
|
||||
HL 0 LDddnn,
|
||||
IFZ,
|
||||
IFNZ, ( skip )
|
||||
( false, make 1 )
|
||||
HL INCss,
|
||||
THEN,
|
||||
THEN, ( skip )
|
||||
HL PUSHqq,
|
||||
;CODE
|
||||
|
||||
@ -209,10 +209,10 @@ CODE /MOD
|
||||
RLA,
|
||||
HL ADCHLss,
|
||||
DE SBCHLss,
|
||||
IFC,
|
||||
IFNC, ( skip )
|
||||
DE ADDHLss,
|
||||
C DECr,
|
||||
THEN,
|
||||
THEN, ( skip )
|
||||
DJNZ, AGAIN, ( loop )
|
||||
B A LDrr,
|
||||
HL PUSHqq,
|
||||
@ -311,13 +311,10 @@ CODE (resRS)
|
||||
IX RS_ADDR LDddnn,
|
||||
;CODE
|
||||
|
||||
CODE S=
|
||||
CODE SCMP
|
||||
DE POPqq,
|
||||
HL POPqq,
|
||||
chkPS,
|
||||
( pre-push false )
|
||||
BC 0 LDddnn,
|
||||
BC PUSHqq,
|
||||
BEGIN, ( loop )
|
||||
LDA(DE),
|
||||
(HL) CPr,
|
||||
@ -327,11 +324,10 @@ CODE S=
|
||||
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
|
||||
@ -339,16 +335,8 @@ CODE CMP
|
||||
DE POPqq,
|
||||
chkPS,
|
||||
DE SUBHLss,
|
||||
BC 0 LDddnn,
|
||||
IFNZ,
|
||||
( not equal )
|
||||
BC INCss,
|
||||
IFNC,
|
||||
( < )
|
||||
BC DECss,
|
||||
BC DECss,
|
||||
THEN,
|
||||
THEN,
|
||||
( 40 == flagsToBC )
|
||||
40 CALLnn,
|
||||
BC PUSHqq,
|
||||
;CODE
|
||||
|
||||
@ -359,14 +347,13 @@ CODE _find
|
||||
chkPS,
|
||||
( 3 == find )
|
||||
3 CALLnn,
|
||||
IFNZ,
|
||||
IFZ, ( found )
|
||||
( not found )
|
||||
HL PUSHqq,
|
||||
DE 0 LDddnn,
|
||||
DE PUSHqq,
|
||||
JPNEXT,
|
||||
THEN,
|
||||
( found )
|
||||
THEN, ( found )
|
||||
DE PUSHqq,
|
||||
DE 1 LDddnn,
|
||||
DE PUSHqq,
|
||||
|
@ -3,4 +3,3 @@
|
||||
0x42 <>{ 0x40 &> 0x44 &< <>} #
|
||||
0x44 <>{ 0x40 &> 0x44 &< <>} NOT #
|
||||
0x22 0x8065 < #
|
||||
-1 0 > #
|
||||
|
Loading…
Reference in New Issue
Block a user