From ff81d21b08821c7bef3a594cf9e9010afbe6885c Mon Sep 17 00:00:00 2001
From: neauoire <aliceffekt@gmail.com>
Date: Mon, 12 Apr 2021 21:16:31 -0700
Subject: [PATCH] Progress on orca

---
 projects/software/orca.usm | 202 +++++++++++++++++--------------------
 src/assembler.c            |  10 +-
 2 files changed, 97 insertions(+), 115 deletions(-)

diff --git a/projects/software/orca.usm b/projects/software/orca.usm
index 92ae5da..91ae86f 100644
--- a/projects/software/orca.usm
+++ b/projects/software/orca.usm
@@ -12,26 +12,29 @@
 )
 
 %RTN { JMP2r }
+%++ { #01 ADD } %-- { #01 SUB }
 %8+ { #0008 ADD2 }
 %8* { #0008 MUL2 } %8/ { #0008 DIV2 }
 %MOD { DUP2 DIV MUL SUB }
 
-%GRID-CELLS { #2000 }
-%GRID-LOCKS { #3000 }
-%GRID-TYPES { #4000 }
+%DATA-CELLS { #2000 }
+%DATA-LOCKS { #3000 }
+%DATA-TYPES { #4000 }
 
-%GET-OFFSET {
-	#00 SWP #00 ~grid.width MUL2 ROT #00 SWP ADD2
-} ( x y -- offset* )
-%GET-INDEX { 
-	GET-OFFSET GRID-CELLS ADD2 
-} ( x y -- index* )
-%SET-CELL { 
-	ROT ROT GET-INDEX POK2 
-} ( x y char -- )
-%GET-CELL { 
-	GET-INDEX PEK2 
-} ( x y -- char )
+%GET-CHAR { #24 MOD #00 SWP ,b36clc ADD2 PEK2 } ( b36 -- char )
+%GET-VALUE { #20 SUB #00 SWP ,values ADD2 PEK2 } ( char -- b36 )
+
+%GET-INDEX { #00 SWP #00 ~grid.width MUL2 ROT #00 SWP ADD2 } ( x y -- index )
+%GET-CELL { GET-INDEX DATA-CELLS ADD2 PEK2 } ( x y -- char )
+%SET-CELL { ROT ROT GET-INDEX DATA-CELLS ADD2 POK2 } ( x y char -- )
+%GET-TYPE { GET-INDEX DATA-TYPES ADD2 PEK2 } ( x y -- type )
+%SET-TYPE { ROT ROT GET-INDEX DATA-TYPES ADD2 POK2 } ( x y type -- )
+%GET-LOCK { GET-INDEX DATA-TYPES ADD2 PEK2 } ( x y -- type )
+%SET-LOCK { ROT ROT GET-INDEX DATA-TYPES ADD2 POK2 } ( x y type -- )
+%GET-PORT { } ( x y lock -- char )
+%SET-PORT { } ( x y char -- )
+
+%GET-CELL-VALUE { GET-CELL GET-VALUE } ( x y -- b36 )
 
 ( variables )
 
@@ -68,11 +71,11 @@ BRK
 
 @on-frame
 
-	~timer #01 ADD DUP =timer
+	~timer ++ DUP =timer
 
 	( skip ) #08 EQU ^$tick JNZ BRK $tick
 
-	~timer.frame #01 ADD =timer.frame
+	~timer.frame ++ =timer.frame
 
 	,run JSR2
 
@@ -91,20 +94,20 @@ BRK
 	~Controller.button #f0 AND
 		DUP #04 SFT #01 AND #01 NEQ ^$no-up JNZ 
 			~selection.y1 #00 EQU ^$no-up JNZ
-			~selection.y1 #01 SUB =selection.y1 
-			~selection.y2 #01 SUB =selection.y2 $no-up
+			~selection.y1 -- =selection.y1 
+			~selection.y2 -- =selection.y2 $no-up
 		DUP #05 SFT #01 AND #01 NEQ ^$no-down JNZ 
-			~selection.y1 ~grid.height #01 SUB EQU ^$no-down JNZ
-			~selection.y1 #01 ADD =selection.y1 
-			~selection.y2 #01 ADD =selection.y2 $no-down
+			~selection.y1 ~grid.height -- EQU ^$no-down JNZ
+			~selection.y1 ++ =selection.y1 
+			~selection.y2 ++ =selection.y2 $no-down
 		DUP #06 SFT #01 AND #01 NEQ ^$no-left JNZ 
 			~selection.x1 #00 EQU ^$no-left JNZ
-			~selection.x1 #01 SUB =selection.x1 
-			~selection.x2 #01 SUB =selection.x2 $no-left
+			~selection.x1 -- =selection.x1 
+			~selection.x2 -- =selection.x2 $no-left
 		DUP #07 SFT #01 AND #01 NEQ ^$no-right JNZ 
-			~selection.x1 ~grid.width #01 SUB EQU ^$no-right JNZ
-			~selection.x1 #01 ADD =selection.x1 
-			~selection.x2 #01 ADD =selection.x2 $no-right
+			~selection.x1 ~grid.width -- EQU ^$no-right JNZ
+			~selection.x1 ++ =selection.x1 
+			~selection.x2 ++ =selection.x2 $no-right
 	POP
 
 	~Controller.key #08 NEQ ^$no-backspace JNZ
@@ -149,10 +152,10 @@ BRK
 		$hor
 			( get x,y ) SWP2 OVR STH SWP2 OVR STHr 
 			#2e SET-CELL
-			( incr )    SWP #01 ADD SWP
+			( incr )    SWP ++ SWP
 			DUP2 LTH ^$hor JNZ
 		POP2
-		( incr ) SWP #01 ADD SWP
+		( incr ) SWP ++ SWP
 		DUP2 LTH ^$ver JNZ
 	POP2
 
@@ -160,39 +163,28 @@ BRK
 
 RTN
 
+( operations )
+
+@get-bang ( x y -- bang )
+RTN
+
+( old )
+
 @is-selected ( x y -- flag )
 	
 	~selection.x1 ~selection.y1 EQU2
 
 RTN
 
-@set-lock ( x y flag -- )
+@get-port ( x y lock -- value )
 	
-	ROT ROT GET-OFFSET GRID-LOCKS ADD2 POK2
-
-RTN
-
-@get-lock ( x y -- flag )
-	
-	GET-OFFSET GRID-LOCKS ADD2 PEK2
-
-RTN
-
-@get-cell-value ( char -- value )
-	
-	#00 SWP ,values ADD2 PEK2
-
-RTN
-
-@get-value-char ( value -- char )
-	
-	#24 MOD #00 SWP ,b36clc ADD2 PEK2
-	
-RTN
-
-@get-value ( x y -- value )
-	
-	GET-CELL #20 SUB ,get-cell-value JSR2
+	(
+	DUP #01 NEQ ^$no-lock JNZ
+		DUP2 #01 SET-LOCK
+	$no-lock
+	STH DUP2 #02 #02 STHr MUL ADD ,set-type JSR2
+	GET-CELL
+	)
 
 RTN
 
@@ -217,11 +209,11 @@ RTN
 @op-a ( x y char -- )
 
 	POP
-	( get left ) DUP2 SWP #01 SUB SWP ,get-value JSR2 STH
-	( get right ) DUP2 SWP #01 ADD SWP ,get-value JSR2 STH
-	( incr y ) #01 ADD 
+	( get left ) DUP2 SWP -- SWP GET-CELL-VALUE STH
+	( get right ) DUP2 SWP ++ SWP GET-CELL-VALUE STH
+	( incr y ) ++ 
 	( get result ) ADDr STHr
-	,get-value-char JSR2 
+	GET-CHAR 
 	SET-CELL
 
 RTN
@@ -229,11 +221,12 @@ RTN
 @op-b ( x y char -- )
 	
 	POP
-	( get left ) DUP2 SWP #01 SUB SWP ,get-value JSR2 STH
-	( get right ) DUP2 SWP #01 ADD SWP ,get-value JSR2 STH
-	( incr y ) #01 ADD 
+	( get left ) DUP2 SWP -- SWP GET-CELL-VALUE STH
+	( get right ) DUP2 SWP ++ SWP GET-CELL-VALUE STH
+	( incr y ) ++ 
 	( get result ) SUBr STHr 
-	,get-value-char JSR2 
+	DUP =Console.byte
+	GET-CHAR 
 	SET-CELL
 
 RTN
@@ -241,7 +234,7 @@ RTN
 @op-c ( x y char -- )
 	
 	POP
-	#01 ADD
+	++
 	#30 ~timer.frame #08 MOD ADD SET-CELL
 
 RTN
@@ -314,12 +307,12 @@ RTN
 		#2a SET-CELL POP STHr RTN 
 	$not-edge
 	( collide )
-	DUP2 #01 SUB GET-CELL #2e EQU ^$not-collide JNZ
+	DUP2 -- GET-CELL #2e EQU ^$not-collide JNZ
 		#2a SET-CELL POP STHr RTN
 	$not-collide
 	( move )
 	DUP2 STHr
-	SWP #01 SUB SWP SET-CELL	
+	SWP -- SWP SET-CELL	
 	#2e SET-CELL
 	
 RTN
@@ -352,7 +345,7 @@ RTN
 	
 	STH 
 	( clear ) DUP2 #2e SET-CELL
-	( move ) #01 ADD DUP2 #01 ,set-lock JSR2
+	( move ) ++ DUP2 #01 SET-LOCK
 	STHr SET-CELL
 	
 RTN
@@ -383,12 +376,12 @@ RTN
 		#2a SET-CELL POP STHr RTN 
 	$not-edge
 	( collide )
-	DUP2 SWP #01 SUB SWP GET-CELL #2e EQU ^$not-collide JNZ
+	DUP2 SWP -- SWP GET-CELL #2e EQU ^$not-collide JNZ
 		#2a SET-CELL POP STHr RTN
 	$not-collide
 	( move )
 	DUP2 
-	SWP #01 SUB SWP STHr SET-CELL	
+	SWP -- SWP STHr SET-CELL	
 	#2e SET-CELL
 	
 RTN
@@ -426,37 +419,24 @@ RTN
 	$not-dot
 
 	( skip locked )
-	ROT ROT DUP2 ,get-lock JSR2 #00 EQU ^$not-locked JNZ
+	ROT ROT DUP2 GET-LOCK #00 EQU ^$not-locked JNZ
 		POP POP2 RTN 
 	$not-locked
 	ROT
 
-	( A ) DUP #41 EQU ,op-a JNZ2
-	( B ) DUP #42 EQU ,op-b JNZ2
-	( C ) DUP #43 EQU ,op-c JNZ2
-	( D ) DUP #44 EQU ,op-d JNZ2
-	( E ) DUP #45 EQU ,op-e JNZ2
-	( F ) DUP #46 EQU ,op-f JNZ2
-	( G ) DUP #47 EQU ,op-g JNZ2
-	( H ) DUP #48 EQU ,op-h JNZ2
-	( I ) DUP #49 EQU ,op-i JNZ2
-	( J ) DUP #4a EQU ,op-j JNZ2
-	( K ) DUP #4b EQU ,op-k JNZ2
-	( L ) DUP #4c EQU ,op-l JNZ2
-	( M ) DUP #4d EQU ,op-m JNZ2
-	( N ) DUP #4e EQU ,op-n JNZ2 ( done. )
-	( O ) DUP #4f EQU ,op-o JNZ2
-	( P ) DUP #50 EQU ,op-p JNZ2
-	( Q ) DUP #51 EQU ,op-q JNZ2
-	( R ) DUP #52 EQU ,op-r JNZ2
-	( S ) DUP #53 EQU ,op-s JNZ2
-	( T ) DUP #54 EQU ,op-t JNZ2
-	( U ) DUP #55 EQU ,op-u JNZ2
-	( V ) DUP #56 EQU ,op-v JNZ2
-	( W ) DUP #57 EQU ,op-w JNZ2 ( done. )
-	( X ) DUP #58 EQU ,op-x JNZ2
-	( Y ) DUP #59 EQU ,op-y JNZ2
-	( Z ) DUP #5a EQU ,op-z JNZ2
+	( A ) DUP #41 EQU ,op-a JNZ2 ( B ) DUP #42 EQU ,op-b JNZ2
+	( C ) DUP #43 EQU ,op-c JNZ2 ( D ) DUP #44 EQU ,op-d JNZ2
+	( E ) DUP #45 EQU ,op-e JNZ2 ( F ) DUP #46 EQU ,op-f JNZ2
+	( G ) DUP #47 EQU ,op-g JNZ2 ( H ) DUP #48 EQU ,op-h JNZ2
+	( I ) DUP #49 EQU ,op-i JNZ2 ( J ) DUP #4a EQU ,op-j JNZ2
+	( K ) DUP #4b EQU ,op-k JNZ2 ( L ) DUP #4c EQU ,op-l JNZ2
+	( M ) DUP #4d EQU ,op-m JNZ2 ( N ) DUP #4e EQU ,op-n JNZ2 
+	( O ) DUP #4f EQU ,op-o JNZ2 ( P ) DUP #50 EQU ,op-p JNZ2
+	( Q ) DUP #51 EQU ,op-q JNZ2 ( R ) DUP #52 EQU ,op-r JNZ2
+	( S ) DUP #53 EQU ,op-s JNZ2 ( T ) DUP #54 EQU ,op-t JNZ2
+	( U ) DUP #55 EQU ,op-u JNZ2 ( V ) DUP #56 EQU ,op-v JNZ2
+	( W ) DUP #57 EQU ,op-w JNZ2 ( X ) DUP #58 EQU ,op-x JNZ2
+	( Y ) DUP #59 EQU ,op-y JNZ2 ( Z ) DUP #5a EQU ,op-z JNZ2
 	( * ) DUP #2a EQU ,op-bang JNZ2
 	POP POP2
 
@@ -469,11 +449,11 @@ RTN
 		#00 ~grid.width
 		$hor
 			( get x,y ) SWP2 OVR STH SWP2 OVR STHr 
-			( unlock ) #00 ,set-lock JSR2
-			( incr ) SWP #01 ADD SWP
+			( unlock ) #00 SET-LOCK
+			( incr ) SWP ++ SWP
 			DUP2 LTH ^$hor JNZ
 		POP2
-		( incr ) SWP #01 ADD SWP
+		( incr ) SWP ++ SWP
 		DUP2 LTH ^$ver JNZ
 	POP2
 
@@ -489,10 +469,10 @@ RTN
 		$hor
 			( get x,y ) SWP2 OVR STH SWP2 OVR STHr 
 			DUP2 GET-CELL ,run-char JSR2
-			( incr )    SWP #01 ADD SWP
+			( incr )    SWP ++ SWP
 			DUP2 LTH ^$hor JNZ
 		POP2
-		( incr ) SWP #01 ADD SWP
+		( incr ) SWP ++ SWP
 		DUP2 LTH ^$ver JNZ
 	POP2
 	,redraw JSR2
@@ -506,19 +486,19 @@ RTN
 	( Positionx )
 	#0000 =Screen.x
 	~selection.x1 
-		DUP #04 SFT ,get-value-char JSR2 #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
+		DUP #04 SFT GET-CHAR #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
 	#22 =Screen.color
 	#0008 =Screen.x
-		#0f AND ,get-value-char JSR2 #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
+		#0f AND GET-CHAR #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
 	#22 =Screen.color
 
 	( Positiony )
 	#0010 =Screen.x
 	~selection.y1 
-		DUP #04 SFT ,get-value-char JSR2 #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
+		DUP #04 SFT GET-CHAR #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
 	#22 =Screen.color
 	#0018 =Screen.x
-		#0f AND ,get-value-char JSR2 #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
+		#0f AND GET-CHAR #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
 	#22 =Screen.color
 
 	#0020 =Screen.x
@@ -528,10 +508,10 @@ RTN
 	( Frame )
 	#0030 =Screen.x
 	~timer.frame 
-		DUP #04 SFT ,get-value-char JSR2 #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
+		DUP #04 SFT GET-CHAR #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
 	#22 =Screen.color
 	#0038 =Screen.x
-		#0f AND ,get-value-char JSR2 #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
+		#0f AND GET-CHAR #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
 	#22 =Screen.color
 
 	#0040 =Screen.x
@@ -541,10 +521,10 @@ RTN
 	( Speed )
 	#0050 =Screen.x
 	~timer.speed 
-		DUP #04 SFT ,get-value-char JSR2 #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
+		DUP #04 SFT GET-CHAR #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
 	#22 =Screen.color
 	#0058 =Screen.x
-		#0f AND ,get-value-char JSR2 #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
+		#0f AND GET-CHAR #20 SUB #00 SWP #0008 MUL2 ,font ADD2 =Screen.addr
 	#22 =Screen.color
 
 	( TODO: Signal VU )
@@ -569,10 +549,10 @@ RTN
 			( get x,y ) SWP2 OVR STH SWP2 OVR STHr 
 			( sprite )  DUP2 ,get-cell-sprite JSR2 =Screen.addr
 			( draw )    ,is-selected JSR2 #0d MUL #21 ADD =Screen.color
-			( incr )    SWP #01 ADD SWP
+			( incr )    SWP ++ SWP
 			DUP2 LTH ^$hor JNZ
 		POP2
-		( incr ) SWP #01 ADD SWP
+		( incr ) SWP ++ SWP
 		DUP2 LTH ^$ver JNZ
 	POP2
 
diff --git a/src/assembler.c b/src/assembler.c
index 8e144a6..5a3991e 100644
--- a/src/assembler.c
+++ b/src/assembler.c
@@ -270,7 +270,7 @@ walktoken(char *w)
 	case ',': return 3;                                                       /* lit2 addr-hb addr-lb */
 	case '.': return 2;                                                       /* addr-hb addr-lb */
 	case '^': return 2;                                                       /* Relative jump: lit addr-offset */
-	case '#': return (slen(w + 1) == 2 ? 2 : 3);
+	case '#': return (slen(w + 1) == 4 ? 3 : 2);
 	}
 	if((m = findmacro(w))) {
 		int i, res = 0;
@@ -332,10 +332,12 @@ parsetoken(char *w)
 		pushshort(findlabeladdr(w + 1), 1);
 		l->refs++;
 		return 1;
-	} else if(w[0] == '#' && sihx(w + 1)) {
-		if(slen(w + 1) == 2)
+	} else if(w[0] == '#') {
+		if(slen(w + 1) == 1)
+			pushbyte((Uint8)w[1], 1);
+		if(sihx(w + 1) && slen(w + 1) == 2)
 			pushbyte(shex(w + 1), 1);
-		else if(slen(w + 1) == 4)
+		else if(sihx(w + 1) && slen(w + 1) == 4)
 			pushshort(shex(w + 1), 1);
 		else
 			return 0;