commit ff81d21b08821c7bef3a594cf9e9010afbe6885c
parent 0e36e4da69b85301189226fc64d5a5f794c1066b
Author: neauoire <aliceffekt@gmail.com>
Date: Mon, 12 Apr 2021 21:16:31 -0700
Progress on orca
Diffstat:
2 files changed, 96 insertions(+), 114 deletions(-)
diff --git 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 }
-
-%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 )
+%DATA-CELLS { #2000 }
+%DATA-LOCKS { #3000 }
+%DATA-TYPES { #4000 }
+
+%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
-@is-selected ( x y -- flag )
-
- ~selection.x1 ~selection.y1 EQU2
+( operations )
+@get-bang ( x y -- bang )
RTN
-@set-lock ( x y flag -- )
-
- ROT ROT GET-OFFSET GRID-LOCKS ADD2 POK2
+( old )
-RTN
-
-@get-lock ( x y -- flag )
-
- GET-OFFSET GRID-LOCKS ADD2 PEK2
-
-RTN
-
-@get-cell-value ( char -- value )
+@is-selected ( x y -- flag )
- #00 SWP ,values ADD2 PEK2
-
-RTN
+ ~selection.x1 ~selection.y1 EQU2
-@get-value-char ( value -- char )
-
- #24 MOD #00 SWP ,b36clc ADD2 PEK2
-
RTN
-@get-value ( x y -- value )
+@get-port ( x y lock -- 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
@@ -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;
