uxn-utils/cli/uxnvm/vm.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 )
	( get opcode ) .uxn/pc LDZ2 ;rom ADD2 LDA
	( exit on BRK ) DUP #00 EQU ?halt
	( move PC ) .uxn/pc LDZ2k INC2 ROT STZ2
	( 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-lit
	DUP #20 EQU ?&op-jci
	DUP #40 EQU ?&op-jmi
	DUP #60 EQU ?&op-jsi
	.uxn/pc LDZ2 DUP2 peek push #0001 .uxn/2 LDZ ADD ADD2 !warp/16
	&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

@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
	&gth pop pop SWP2 GTH2 !push/byte
	&lth 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-lit =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