~rabbits/uxn-utils

f41eb2a86f6a3a4ab8cc169b4a2d7291ea097728 — Devine Lu Linvega 3 months ago 5b3007e
Starting validation
2 files changed, 73 insertions(+), 72 deletions(-)

M cli/stdlib/build.sh
M cli/stdlib/stdlib.tal
M cli/stdlib/build.sh => cli/stdlib/build.sh +6 -0
@@ 3,6 3,7 @@
ASM="uxncli $HOME/roms/drifblim.rom"
EMU="uxncli"
LIN="uxncli $HOME/roms/uxnlin.rom"
BAL="uxncli $HOME/roms/uxnbal.rom"

ID="stdlib"
SRC="${ID}.tal"


@@ 10,6 11,11 @@ DST="${ID}.rom"
CPY="$HOME/roms"
ARG=""

if [[ "$*" == *"--bal"* ]]
then
	$BAL $SRC
fi

if [[ "$*" == *"--lint"* ]]
then
	$LIN $SRC

M cli/stdlib/stdlib.tal => cli/stdlib/stdlib.tal +67 -72
@@ 1,9 1,7 @@
|0100

@on-reset ( -> )
|0100 @on-reset ( -> )
	;tests/end ;tests
	&l ( -- )
		LDA2k JSR2 test INC2 INC2 GTH2k ?&l
	LDA2k JSR2 test INC2 INC2 GTH2k ?&l
	POP2 POP2
	( lb ) #0a18 DEO
	( debugger ) #010e DEO


@@ 21,62 19,56 @@
	=test-dec1 =test-dec2 =test-dec3 =test-dec4
	=test-hex1 =test-hex2 =test-hex3 =test-hex4
	=test-scmp1 =test-scmp2 =test-scmp3 =test-scmp4
	=test-scpy1 ] &end
	=test-scpy1 =test-spal1 =test-spal2 ]
	&end

@test-dec1
	#0a18 DEO
@test-dec1 #0a18 DEO
	;dict/dec1 sdec #1234 EQU2 JMP2r

@test-dec2
	;dict/dec2 sdec #0123 EQU2 JMP2r
@test-dec2 ;dict/dec2 sdec #0123 EQU2 JMP2r

@test-dec3
	;dict/dec3 sdec #0000 EQU2 JMP2r
@test-dec3 ;dict/dec3 sdec #0000 EQU2 JMP2r

@test-dec4
	;dict/dec4 sdec #0000 EQU2 JMP2r
@test-dec4 ;dict/dec4 sdec #0000 EQU2 JMP2r

@test-hex1
	#0a18 DEO
@test-hex1 #0a18 DEO
	;dict/hex1 shex #12c0 EQU2 JMP2r

@test-hex2
	;dict/hex2 shex #034f EQU2 JMP2r
@test-hex2 ;dict/hex2 shex #034f EQU2 JMP2r

@test-hex3
	;dict/dec3 sdec #0000 EQU2 JMP2r
@test-hex3 ;dict/dec3 sdec #0000 EQU2 JMP2r

@test-hex4
	;dict/dec4 sdec #0000 EQU2 JMP2r
@test-hex4 ;dict/dec4 sdec #0000 EQU2 JMP2r

@test-scmp1
	#0a18 DEO
@test-scmp1 #0a18 DEO
	{ "text 00 }
	STH2r { "text 00 }
	STH2r scmp #01 EQU JMP2r

@test-scmp2
	{ "text 00 }
@test-scmp2 { "text 00 }
	STH2r { "te 00 }
	STH2r scmp #00 EQU JMP2r

@test-scmp3
	{ "textext 00 }
@test-scmp3 { "textext 00 }
	STH2r { "text 00 }
	STH2r scmp #00 EQU JMP2r

@test-scmp4
	{ 00 "ext 00 }
@test-scmp4 { 00 "ext 00 }
	STH2r { "text 00 }
	STH2r scmp #00 EQU JMP2r

@test-scpy1
	#0a18 DEO
@test-scpy1 #0a18 DEO
	{ "hello 00 }
	STH2kr ;&buf <scpy>
	STH2r ;&buf scmp #01 EQU JMP2r
	&buf $10

@test-pal1 { "racecar 00 }
	STH2r spal #01 EQU JMP2r

@test-pal2 { "racecat 00 }
	STH2r spal #00 EQU JMP2r

(
@|stdlib )



@@ 84,14 76,18 @@
	INC2 & LDAk ?scap
	JMP2r

@palindrome? ( str* -- f )
	scap/
	( TODO ) JMP2r

@slen ( str* -: len* )
	DUP2 scap/ SWP2 SUB2 JMP2r

@<scpy> ( src* dst* -: )
	STH2
	&w ( src* `dst* -- )
		LDAk #00 STH2kr STA2
		INC2r INC2 LDAk ?&w
	LDAk #00 STH2kr STA2
	INC2r INC2 LDAk ?&w
	POP2 POP2r JMP2r

@<sput> ( chr str* -: )


@@ 99,79 95,78 @@
	#00 STH2r scap/ STA2
	JMP2r

@<sclr> ( str* -: )
@<sclr> ( str* -- )
	STH2
	#00 STH2r
	&w ( -- )
		STAk INC2 LDAk ?&w
	STAk INC2 LDAk ?&w
	STA
	JMP2r

@scmp ( a* b* -- f )
	STH2
	&l ( -- )
		LDAk ?{
			&d LDA LDAr STHr EQU JMP2r }
		LDAk LDAkr STHr NEQ ?&d
	LDAk ?{
		&d LDA LDAr STHr EQU JMP2r }
	LDAk LDAkr STHr NEQ ?&d
	INC2 INC2r !&l

@sdec ( str* -- val* )
	[ LIT2r 0000 ]
	&w ( -- )
		( validate ) LDAk [ LIT "0 ] SUB #09 GTH ?&end
		( accumulate ) [ LIT2r 000a ] MUL2r
		( combine ) LDAk [ LIT "0 ] SUB [ LITr 00 ] STH
		ADD2r
		( continue ) INC2 LDAk ?&w
	( validate ) LDAk [ LIT "0 ] SUB #09 GTH ?&end
	( accumulate ) [ LIT2r 000a ] MUL2r
	( combine ) LDAk [ LIT "0 ] SUB [ LITr 00 ] STH
	ADD2r
	( continue ) INC2 LDAk ?&w
	&end POP2 STH2r JMP2r

@shex ( str* -- val* )
@shex ( str* -: val* )
	[ LIT2r 0000 ]
	&w ( -- )
		( validate ) LDAk chex INC #00 EQU ?&end
		( accumulate ) [ LITr 40 ] SFT2r
		( combine ) LDAk chex [ LITr 00 ] STH
		ADD2r
		( continue ) INC2 LDAk ?&w
	&end POP2 STH2r JMP2r
	&w ( str* `acc* -: val* )
	LDAk chex INC #00 EQU ?{
		[ LITr 40 ] SFT2r LDAk chex [ LITr 00 ] STH
		ADD2r INC2 LDAk ?&w }
	POP2 STH2r JMP2r

@chex ( c -- val|ff )
@chex ( c -: val! )
	( dec ) [ LIT "0 ] SUB DUP #09 GTH ?{ JMP2r }
	( hex ) #27 SUB DUP #0f GTH ?{ JMP2r }
	( err ) POP #ff JMP2r
	( return 1 if string is palindrome, otherwise 0 )

(
@|print )

@<pstr> ( str* -- )
	&w ( -- )
		LDAk #18 DEO
		INC2 & LDAk ?&w
@<pstr> ( str* -: )
	LDAk #18 DEO
	INC2 & LDAk ?<pstr>
	POP2 JMP2r

@<phex> ( short* -- )
	SWP <phex>/b
	&b ( -- )
		DUP #04 SFT <phex>/c
	&c ( -- )
		#0f AND DUP #09 GTH #27 MUL ADD [ LIT "0 ] ADD #18 DEO
		JMP2r
@<phex> ( short* -: )
	SWP /b
	&b ( byte -: )
	DUP #04 SFT /c
	&c ( byte -: )
	#0f AND DUP #09 GTH #27 MUL ADD [ LIT "0 ] ADD #18 DEO
	JMP2r

@<pdec> ( short* -- )
@<pdec> ( short* -: )
	#2710 [ LIT2r 00fb ]
	&w ( -- )
		DIV2k #000a DIV2k MUL2 SUB2 SWPr EQUk OVR STHkr EQU AND ?{
			DUP [ LIT "0 ] ADD #19 DEO
			INCr }
		POP2 #000a DIV2 SWPr INCr STHkr ?&w
	&>w ( short* size* `acc* -: )
		DIV2k #000a DIV2k MUL2 SUB2 SWPr EQUk OVR STHkr EQU AND ?&e
		DUP [ LIT "0 ] ADD #19 DEO
		INCr
		&e ( short* size* `acc* -: )
		POP2 #000a DIV2 SWPr INCr STHkr ?&>w
	POP2r POP2 POP2 JMP2r

@<pmem> ( addr* -- )
	#0000
	&l ( -- )
		ADD2k LDA <phex>/b
		DUP #0f AND #0f NEQ #16 MUL #0a ADD #18 DEO
		INC NEQk ?&l
	ADD2k LDA <phex>/b
	DUP #0f AND #0f NEQ #16 MUL #0a ADD #18 DEO
	INC NEQk ?&l
	POP2 POP2 JMP2r

(