mirror of https://git.sr.ht/~rabbits/uxn-utils
169 lines
3.6 KiB
Tal
169 lines
3.6 KiB
Tal
( emulator )
|
|
|
|
@<reset> ( -- )
|
|
[ LIT2 00 -uxn/err ] STZ
|
|
#0100 .uxn/pc STZ2
|
|
#0000 DUP2 ;wst/ptr STA2
|
|
DUP2 ;rst/ptr STA2
|
|
;<step>/count STA2
|
|
JMP2r
|
|
|
|
@<step> ( -- ok )
|
|
( incr pointer ) .uxn/pc LDZ2 INC2k .uxn/pc STZ2
|
|
( get opcode ) ;rom ADD2 LDA
|
|
( short mode ) DUP #20 AND #00 NEQ .uxn/2 STZ
|
|
( return mode ) DUP #40 AND #00 NEQ STH ;rst ;wst STHr [ JMP SWP2 ] .uxn/dst STZ2
|
|
.uxn/src STZ2
|
|
( keep mode ) DUP #80 AND #00 NEQ ;pop/keep STA
|
|
( copy pop pointer ) .uxn/src LDZ2 #00fe ADD2 LDAk DUP SWP2 STA2
|
|
( get routine ) #00 OVR #1f AND DUP2 ADD2 ;optbl ADD2 LDA2 JSR2
|
|
( incr time ) [ LIT2 &count $2 ] INC2 ,&count STR2
|
|
( check err ) .uxn/err LDZ ?halt
|
|
JMP2r
|
|
|
|
(
|
|
@|primitives )
|
|
|
|
@push ( v* -- )
|
|
.uxn/2 LDZ ?&16
|
|
&8 ( v* -- )
|
|
NIP
|
|
&byte ( stack ptr* )
|
|
.uxn/src LDZ2 #00fe ADD2 STH2k
|
|
( err 02 overflow ) LDA #ff EQU .uxn/err LDZk ROT DUP ADD ORA SWP STZ
|
|
( incr ) .uxn/src LDZ2 #00 LDAkr STHr INCk STH2r STA
|
|
( save ) ADD2 STA
|
|
JMP2r
|
|
&16 ( v* -- )
|
|
SWP push/byte !push/byte
|
|
|
|
@pop ( -- v* )
|
|
.uxn/2 LDZ ?&16
|
|
&8 ( -- v* )
|
|
#00
|
|
&byte ( -- )
|
|
.uxn/src LDZ2 #00fe ADD2 #00 [ LIT &keep $1 ] ADD2 STH2k
|
|
( err 01 underflow ) LDA #00 EQU .uxn/err LDZk ROT ORA SWP STZ
|
|
( decr ) .uxn/src LDZ2 LDAkr STHr #01 SUB STH2kr STA
|
|
( load ) #00 LDAr STHr ADD2 LDA JMP2r
|
|
&16 ( -- v* )
|
|
pop/byte pop/byte SWP JMP2r
|
|
|
|
@poke ( v* a* -- )
|
|
.uxn/2 LDZ ?&16
|
|
&8 ;rom ADD2 STA
|
|
POP JMP2r
|
|
&16 ;rom ADD2 STA2
|
|
JMP2r
|
|
|
|
@peek ( a* -- v* )
|
|
.uxn/2 LDZ ?&16
|
|
&8 ;rom ADD2 LDA #00 SWP JMP2r
|
|
&16 ;rom ADD2 LDA2 JMP2r
|
|
|
|
@warp ( a* -- )
|
|
.uxn/2 LDZ ?&16
|
|
&8 NIP rel &16 .uxn/pc STZ2
|
|
JMP2r
|
|
|
|
@rel ( a* -- )
|
|
DUP #7f GTH #ff MUL SWP .uxn/pc LDZ2 ADD2 JMP2r
|
|
|
|
@devw ( v* p* -- )
|
|
.uxn/2 LDZ ?&16
|
|
&8 NIP ROT POP !emu-deo
|
|
&16 NIP STHk emu-deo STHr INC !emu-deo
|
|
|
|
@devr ( p* -- )
|
|
.uxn/2 LDZ ?devr/16
|
|
&8 NIP DEI #00 SWP !push
|
|
&16 NIP DEI2 !push
|
|
|
|
(
|
|
@|library )
|
|
|
|
@op-imm
|
|
DUP #00 EQU ?&op-brk
|
|
DUP #20 EQU ?&op-jci
|
|
DUP #40 EQU ?&op-jmi
|
|
DUP #60 EQU ?&op-jsi
|
|
&op-lit ( -- )
|
|
.uxn/pc LDZ2 peek push #0001 .uxn/2 LDZ ADD !warp/8
|
|
&op-jci ( -- )
|
|
;wst .uxn/src STZ2
|
|
pop/8 NIP ?&op-jmi
|
|
( else ) .uxn/pc LDZ2k INC2 INC2 ROT STZ2
|
|
JMP2r
|
|
&op-jsi ( -- )
|
|
;rst .uxn/src STZ2
|
|
.uxn/pc LDZ2 INC2 INC2 push/16
|
|
( fall )
|
|
&op-jmi ( -- )
|
|
.uxn/pc LDZ2 DUP2 peek/16 ADD2 INC2 INC2 !warp/16
|
|
&op-brk ( -- )
|
|
JMP2r
|
|
|
|
@lib ( non immediate opcodes )
|
|
&inc pop INC2 !push
|
|
&pop pop POP2 JMP2r
|
|
&nip pop pop POP2 !push
|
|
&swp pop pop SWP2 push !push
|
|
&rot pop pop pop ROT2 ROT2 push push !push
|
|
&dup pop DUP2 push !push
|
|
&ovr pop pop SWP2 OVR2 push push !push
|
|
&equ pop pop EQU2 !push/byte
|
|
&neq pop pop NEQ2 !push/byte
|
|
>h pop pop SWP2 GTH2 !push/byte
|
|
<h pop pop SWP2 LTH2 !push/byte
|
|
&jmp pop !warp
|
|
&jcn pop pop/8 NIP ?warp
|
|
POP2 JMP2r
|
|
&jsr pop .uxn/pc LDZ2 .uxn/dst LDZ2 .uxn/src STZ2
|
|
push/16 !warp
|
|
&sth pop .uxn/dst LDZ2 .uxn/src STZ2
|
|
!push
|
|
&ldz pop/8 peek !push
|
|
&stz pop/8 pop SWP2 !poke
|
|
&ldr pop/8 NIP rel peek !push
|
|
&str pop/8 pop SWP2 NIP rel !poke
|
|
&lda pop/16 peek !push
|
|
&sta pop/16 pop SWP2 !poke
|
|
&dei pop/8 !devr
|
|
&deo pop/8 pop SWP2 !devw
|
|
&add pop pop ADD2 !push
|
|
&sub pop pop SWP2 SUB2 !push
|
|
&mul pop pop MUL2 !push
|
|
&div pop pop SWP2 DIV2 !push
|
|
&and pop pop AND2 !push
|
|
&ora pop pop ORA2 !push
|
|
&eor pop pop EOR2 !push
|
|
&sft pop/8 pop SWP2 NIP SFT2 !push
|
|
|
|
@optbl
|
|
[
|
|
=op-imm =lib/inc =lib/pop =lib/nip
|
|
=lib/swp =lib/rot =lib/dup =lib/ovr
|
|
=lib/equ =lib/neq =lib/gth =lib/lth
|
|
=lib/jmp =lib/jcn =lib/jsr =lib/sth
|
|
=lib/ldz =lib/stz =lib/ldr =lib/str
|
|
=lib/lda =lib/sta =lib/dei =lib/deo
|
|
=lib/add =lib/sub =lib/mul =lib/div
|
|
=lib/and =lib/ora =lib/eor =lib/sft ]
|
|
|
|
(
|
|
@|uxn )
|
|
|
|
@sym $2000
|
|
|
|
@wst $fe
|
|
&ptr $2
|
|
|
|
@rst $fe
|
|
&ptr $2
|
|
|
|
@dev $100
|
|
|
|
@rom $100
|
|
&reset
|
|
|