2020-11-15 06:50:14 +11:00
|
|
|
( This is xcomp code that is common to both stage and forth
|
|
|
|
binaries. )
|
2020-06-27 08:58:02 +10:00
|
|
|
0xff00 CONSTANT RS_ADDR
|
|
|
|
0xfffa CONSTANT PS_ADDR
|
2020-06-29 09:45:28 +10:00
|
|
|
RS_ADDR 0x80 - CONSTANT SYSVARS
|
|
|
|
0 CONSTANT HERESTART
|
2020-06-27 08:58:02 +10:00
|
|
|
: CODE ( natidx -- ) (entry) 0 C, C, ;
|
|
|
|
VARIABLE ORG
|
|
|
|
CREATE BIN( 0 ,
|
|
|
|
: PC H@ ORG @ - ;
|
|
|
|
262 LOAD ( xcomp )
|
|
|
|
270 LOAD ( xcomp overrides )
|
|
|
|
|
|
|
|
H@ ORG !
|
2020-09-20 10:35:35 +10:00
|
|
|
0x15 ALLOT0
|
2020-06-27 08:58:02 +10:00
|
|
|
( END OF STABLE ABI )
|
2020-07-06 04:57:18 +10:00
|
|
|
H@ 4 + XCURRENT ! ( make next CODE have 0 prev field )
|
2020-07-06 03:41:12 +10:00
|
|
|
0x00 CODE EXIT
|
2020-07-06 04:57:18 +10:00
|
|
|
0x01 CODE (br)
|
|
|
|
0x02 CODE (?br)
|
|
|
|
0x03 CODE (loop)
|
2020-09-26 07:31:06 +10:00
|
|
|
0x04 CODE (n)
|
|
|
|
0x05 CODE (s)
|
|
|
|
0x06 CODE >R
|
|
|
|
0x07 CODE R>
|
|
|
|
0x08 CODE 2>R
|
2020-06-27 08:58:02 +10:00
|
|
|
0x09 CODE 2R>
|
|
|
|
0x0a CODE EXECUTE
|
|
|
|
0x0b CODE ROT
|
|
|
|
0x0c CODE DUP
|
|
|
|
0x0d CODE ?DUP
|
|
|
|
0x0e CODE DROP
|
|
|
|
0x0f CODE SWAP
|
|
|
|
0x10 CODE OVER
|
|
|
|
0x11 CODE PICK
|
|
|
|
0x12 CODE (roll)
|
|
|
|
0x13 CODE 2DROP
|
|
|
|
0x14 CODE 2DUP
|
|
|
|
0x15 CODE S0
|
|
|
|
0x16 CODE 'S
|
|
|
|
0x17 CODE AND
|
|
|
|
0x18 CODE OR
|
|
|
|
0x19 CODE XOR
|
|
|
|
0x1a CODE NOT
|
|
|
|
0x1b CODE +
|
|
|
|
0x1c CODE -
|
|
|
|
0x1d CODE *
|
|
|
|
0x1e CODE /MOD
|
|
|
|
0x1f CODE !
|
|
|
|
0x20 CODE @
|
|
|
|
0x21 CODE C!
|
|
|
|
0x22 CODE C@
|
|
|
|
0x23 CODE PC!
|
|
|
|
0x24 CODE PC@
|
|
|
|
0x25 CODE I
|
|
|
|
0x26 CODE I'
|
|
|
|
0x27 CODE J
|
|
|
|
0x28 CODE BYE
|
|
|
|
0x29 CODE (resSP)
|
|
|
|
0x2a CODE (resRS)
|
|
|
|
0x2b CODE S=
|
|
|
|
0x2c CODE CMP
|
|
|
|
0x2d CODE _find
|
|
|
|
0x2e CODE 0
|
|
|
|
0x2f CODE 1
|
|
|
|
0x30 CODE -1
|
|
|
|
0x31 CODE 1+
|
|
|
|
0x32 CODE 1-
|
|
|
|
0x33 CODE 2+
|
|
|
|
0x34 CODE 2-
|
|
|
|
0x35 CODE RSHIFT
|
|
|
|
0x36 CODE LSHIFT
|
2020-09-26 07:31:06 +10:00
|
|
|
0x37 CODE TICKS
|
2020-10-30 03:34:02 +11:00
|
|
|
0x38 CODE ROT>
|
2020-12-08 12:08:45 +11:00
|
|
|
0x39 CODE |L
|
|
|
|
0x3a CODE |M
|
2020-10-29 09:06:58 +11:00
|
|
|
353 LOAD ( xcomp core )
|
Make KEY non-blocking
... and rename it to KEY?. Then, add KEY from KEY? for its blocking
version.
I need this for an upcoming Remote Shell feature. If a Collapse OS
system remotely controls another shell, it needs to be able to poll
both the remote system and the local keyboard at the same time. A
blocking KEY is incompatible with this.
In some places, the polling mechanism doesn't make sense, so this
new KEY? always returns a character. In some places, I just haven't
implemented the mechanism yet, so I kept the old blocking code and
added a "always 1" flag as a temporary shim.
I have probably broken something, but in emulators, Collapse OS runs
fine. It's an important reminder of what will be lost with the new
"dogfooding" approach (see recent mailing list message): without
emulators, it's much harder to to sweeping changes like this without
breaking stuff.
It's fine, I don't expect many more of these core changes to the
system. It's nearly feature-complete.
2021-01-02 00:05:29 +11:00
|
|
|
: (key?) 0 PC@ 1 ;
|
2020-06-27 08:58:02 +10:00
|
|
|
: EFS@
|
|
|
|
1 3 PC! ( read )
|
2020-12-08 12:08:45 +11:00
|
|
|
|M 3 PC! 3 PC! ( blkid )
|
|
|
|
BLK( |M 3 PC! 3 PC! ( dest )
|
2020-06-27 08:58:02 +10:00
|
|
|
;
|
|
|
|
: EFS!
|
|
|
|
2 3 PC! ( write )
|
2020-12-08 12:08:45 +11:00
|
|
|
|M 3 PC! 3 PC! ( blkid )
|
|
|
|
BLK( |M 3 PC! 3 PC! ( dest )
|
2020-06-27 08:58:02 +10:00
|
|
|
;
|
2020-11-15 06:50:14 +11:00
|
|
|
( fork between stage and forth begins here )
|