d6
/
uxn
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Progress on orca

This commit is contained in:
neauoire 2021-04-12 21:16:31 -07:00
parent 0e36e4da69
commit ff81d21b08
2 changed files with 97 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

202
projects/software/orca.usm
View File

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

10
src/assembler.c
View File

@ -270,7 +270,7 @@ walktoken(char *w)
case ',': return 3; /* lit2 addr-hb addr-lb */ case ',': return 3; /* lit2 addr-hb addr-lb */
case '.': return 2; /* addr-hb addr-lb */ case '.': return 2; /* addr-hb addr-lb */
case '^': return 2; /* Relative jump: lit addr-offset */ 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))) { if((m = findmacro(w))) {
int i, res = 0; int i, res = 0;
@ -332,10 +332,12 @@ parsetoken(char *w)
pushshort(findlabeladdr(w + 1), 1); pushshort(findlabeladdr(w + 1), 1);
l->refs++; l->refs++;
return 1; return 1;
} else if(w[0] == '#' && sihx(w + 1)) { } else if(w[0] == '#') {
if(slen(w + 1) == 2) if(slen(w + 1) == 1)
pushbyte((Uint8)w[1], 1);
if(sihx(w + 1) && slen(w + 1) == 2)
pushbyte(shex(w + 1), 1); 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); pushshort(shex(w + 1), 1);
else else
return 0; return 0;