mirror of https://git.sr.ht/~rabbits/uxn
Devine Lu Linvega
7 months ago
5 changed files with 0 additions and 2019 deletions
@ -1,70 +0,0 @@
|
||||
( Pig: |
||||
Each turn you roll a die and add the total to your points. |
||||
You can stop at any time and keep that total, or keep rolling. |
||||
If you ever roll a 1 you lose all the points you accrued. ) |
||||
|
||||
|10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1 |
||||
|
||||
|0000 @t $1 ( Total saved ) |
||||
|
||||
|0100 @game ( -> ) |
||||
|
||||
#00 .t STZ |
||||
;input-main .Console/vector DEO2 |
||||
,input-main/main JMP |
||||
|
||||
@roll ( -- dice ) |
||||
|
||||
[ LIT2 &r f793 ] |
||||
( 5*R+35 ) #0005 MUL2 #0023 ADD2 |
||||
( R-R/6547*6547 ) DUP2 #1993 DIV2 #1993 MUL2 SUB2 |
||||
DUP2 #c5 DEI2 ADD2 ,&r STR2 ADD ( mod ) #06 DIVk MUL SUB |
||||
|
||||
JMP2r |
||||
|
||||
@input-main ( -> ) |
||||
|
||||
.Console/read DEI |
||||
LIT "0 EQUk NIP ,&no JCN |
||||
LIT "1 EQUk NIP ,&yes JCN |
||||
( ignore other inputs ) |
||||
POP |
||||
|
||||
BRK |
||||
&no ( char -- ) |
||||
POP ;score-txt ,pstr JSR .t LDZ ,pdec JSR ;byte-txt ,&halt JMP |
||||
&yes ( char -- ) |
||||
POP ,roll JSR ;rolled-txt ,pstr JSR INCk ,pdec/d JSR DUP ,¬-bust JCN |
||||
&bust ( char -- ) |
||||
POP ;bust-txt |
||||
&halt ( msg* -- ) |
||||
,pstr JSR #0a .Console/write DEO #010f DEO BRK |
||||
¬-bust ( dice -- ) |
||||
INC .t LDZ ADD .t STZ |
||||
&main ( -- ) |
||||
;total-txt ,pstr JSR .t LDZ ,pdec JSR ;roll-txt ,pstr JSR BRK |
||||
|
||||
@pdec ( value -- ) |
||||
|
||||
DUP #0a DIV ,&emit JSR |
||||
&d #0a DIVk MUL SUB ,&emit JSR |
||||
#0a .Console/write DEO |
||||
|
||||
JMP2r |
||||
&emit #30 ADD .Console/write DEO JMP2r |
||||
|
||||
@pstr ( str* -- ) |
||||
|
||||
&while |
||||
LDAk DUP LIT "_ EQU #3f MUL SUB .Console/write DEO |
||||
INC2 LDAk ,&while JCN |
||||
POP2 |
||||
|
||||
JMP2r |
||||
|
||||
@total-txt "Your_current_total_is:_ $1 |
||||
@roll-txt "Would_you_like_to_roll?_(0_no,_1_yes)_ $1 |
||||
@score-txt "Your_score_is:_ $1 |
||||
@rolled-txt "You_rolled:_ $1 |
||||
@bust-txt "Busted! $1 |
||||
@byte-txt "Goodbye. $1 |
||||
@ -1,962 +0,0 @@
|
||||
( |
||||
Asma - an in-Uxn assembler |
||||
|
||||
This assembler aims to be binary compatible with the output from |
||||
src/uxnasm.c, but unlike that assembler this one can be run inside Uxn |
||||
itself! |
||||
|
||||
Asma is designed to be able to be copy-pasted inside another project, so |
||||
all its routines are prefixed with "asma-" to prevent clashes with labels |
||||
used in the incorporating project. The reset vector contains a couple of |
||||
examples of asma's usage and can be discarded. |
||||
) |
||||
|
||||
( |
||||
Asma's public interface. |
||||
These routines are what are expected to be called from programs that bundle |
||||
Asma into bigger projects. |
||||
) |
||||
|
||||
@asma-assemble-file ( src-filename* dest-filename* -- ) |
||||
#01 .File/append DEO |
||||
DUP2 .File/name DEO2 |
||||
#01 .File/delete DEO |
||||
;asma/dest-filename STA2 ;asma/src-filename STA2 |
||||
|
||||
;asma-init-first-pass JSR2 |
||||
;asma-flush-ignore ;asma/flush-fn STA2 |
||||
;asma/src-filename LDA2 ;asma-assemble-file-pass JSR2 |
||||
;asma/error LDA2 ORA ,&error JCN |
||||
|
||||
;asma-init-next-pass JSR2 |
||||
;asma-flush-to-file ;asma/flush-fn STA2 |
||||
;asma/dest-filename LDA2 ORA ,&filename-present JCN |
||||
;asma-flush-to-console ;asma/flush-fn STA2 |
||||
&filename-present |
||||
;asma/src-filename LDA2 ;asma-assemble-file-pass JSR2 |
||||
;asma/error LDA2 ORA ,&error JCN |
||||
|
||||
( flush output buffer ) |
||||
;asma-output/ptr LDA2 ;asma-write-buffer SUB2 ;asma/flush-fn LDA2 JSR2 |
||||
|
||||
;asma-trees/labels ;asma-print-labels JSR2 ( DEBUG ) |
||||
;asma-print-line-count JSR2 ( DEBUG ) |
||||
;asma-print-heap-usage JSR2 ( DEBUG ) |
||||
JMP2r |
||||
|
||||
&error |
||||
;asma-print-error JSR2 ( DEBUG ) |
||||
JMP2r |
||||
|
||||
( |
||||
Debugging routines. These all output extra information to the Console. |
||||
These can be stripped out to save space, once the references to them are |
||||
removed. Look for the word DEBUG above to find these references: the lines |
||||
that contain that word can be deleted to strip out the functionality |
||||
cleanly. |
||||
) |
||||
|
||||
@asma-print-error ( -- ) |
||||
.File/name DEI2 ;asma-print-string JSR2 |
||||
;&line ;asma-print-string JSR2 |
||||
;asma/line LDA2 ;asma-print-short JSR2 |
||||
#3a .Console/error DEO |
||||
#20 .Console/error DEO |
||||
;asma/error LDA2 ;asma-print-string JSR2 |
||||
#3a .Console/error DEO |
||||
#20 .Console/error DEO |
||||
;asma/orig-token LDA2 ;asma-print-string JSR2 |
||||
#2e .Console/error DEO |
||||
#0a .Console/error DEO |
||||
JMP2r |
||||
|
||||
&line 20 "line 20 00 |
||||
|
||||
@asma-print-line-count ( -- ) |
||||
;asma/log-level LDA #01 AND #00 EQU ,&skip JCN |
||||
;asma/lines LDA2 ;asma-print-short JSR2 |
||||
;&lines ;asma-print-string JSR2 |
||||
&skip |
||||
JMP2r |
||||
|
||||
&lines [ 20 "lines 20 "of 20 "source 20 "code. 0a 00 ] |
||||
|
||||
@asma-print-heap-usage ( -- ) |
||||
;asma/log-level LDA #08 AND #00 EQU ,&skip JCN |
||||
;heap LDA2 ;asma-heap SUB2 ;asma-print-short JSR2 |
||||
;&str1 ;asma-print-string JSR2 |
||||
;asma-heap/end ;heap LDA2 SUB2 ;asma-print-short JSR2 |
||||
;&str2 ;asma-print-string JSR2 |
||||
&skip |
||||
JMP2r |
||||
|
||||
&str1 [ 20 "bytes 20 "of 20 "heap 20 "used, 20 00 ] |
||||
&str2 [ 20 "bytes 20 "free. 0a 00 ] |
||||
|
||||
@asma-print-sublabels ( incoming-ptr* -- ) |
||||
LDA2 |
||||
ORAk ,&valid-incoming-ptr JCN |
||||
POP2 JMP2r |
||||
|
||||
&valid-incoming-ptr |
||||
( left node ) |
||||
DUP2 ,asma-print-sublabels JSR |
||||
( here ) |
||||
#09 .Console/error DEO |
||||
DUP2 #0004 ADD2 |
||||
&loop |
||||
DUP2 INC2 SWP2 LDA |
||||
DUP #00 EQU ,&end JCN |
||||
.Console/error DEO |
||||
,&loop JMP |
||||
&end |
||||
POP |
||||
#09 .Console/error DEO |
||||
LDA2 ;asma-print-short JSR2 |
||||
#0a .Console/error DEO |
||||
|
||||
( right node ) |
||||
#0002 ADD2 ,asma-print-sublabels JSR |
||||
JMP2r |
||||
|
||||
@asma-print-labels ( incoming-ptr* -- ) |
||||
;asma/log-level LDA #04 AND #00 EQU ,&skip JCN |
||||
LDA2 |
||||
ORAk ,&valid-incoming-ptr JCN |
||||
&skip |
||||
POP2 JMP2r |
||||
|
||||
&valid-incoming-ptr |
||||
( left node ) |
||||
DUP2 ,asma-print-labels JSR |
||||
( here ) |
||||
DUP2 #0004 ADD2 |
||||
LDAk LIT "A LTH ,&loop JCN |
||||
LDAk LIT "Z GTH ,&loop JCN |
||||
POP2 |
||||
,&skip-device-label JMP |
||||
&loop |
||||
DUP2 INC2 SWP2 LDA |
||||
DUP #00 EQU ,&end JCN |
||||
.Console/error DEO |
||||
,&loop JMP |
||||
&end |
||||
POP |
||||
#09 .Console/error DEO |
||||
LDA2k ;asma-print-short JSR2 |
||||
#0a .Console/error DEO |
||||
( subtree ) |
||||
#0002 ADD2 ;asma-print-sublabels JSR2 |
||||
|
||||
&skip-device-label |
||||
( right node ) |
||||
#0002 ADD2 ,asma-print-labels JSR |
||||
JMP2r |
||||
|
||||
@asma-print-string ( ptr* -- ) |
||||
LDAk DUP ,&keep-going JCN |
||||
POP POP2 JMP2r |
||||
|
||||
&keep-going |
||||
.Console/error DEO |
||||
INC2 |
||||
,asma-print-string JMP |
||||
|
||||
@asma-print-short ( short* -- ) |
||||
LIT "0 .Console/error DEO |
||||
LIT "x .Console/error DEO |
||||
OVR #04 SFT ,&hex JSR |
||||
SWP #0f AND ,&hex JSR |
||||
DUP #04 SFT ,&hex JSR |
||||
#0f AND ,&hex JMP |
||||
|
||||
&hex |
||||
#30 ADD DUP #3a LTH ,¬-alpha JCN |
||||
#27 ADD |
||||
¬-alpha |
||||
.Console/error DEO |
||||
JMP2r |
||||
|
||||
( |
||||
Initialise the assembler state before loading a file or chunk. |
||||
) |
||||
|
||||
@asma-init-first-pass ( -- ) |
||||
LIT2 POP2 POP EOR ;asma-parse-opcode/short-flag STA |
||||
LIT2 POPr POP EOR ;asma-parse-opcode/return-flag STA |
||||
LIT2 POPk POP EOR ;asma-parse-opcode/keep-flag STA |
||||
#ff ;asma/pass STA |
||||
#0000 DUP2k |
||||
;asma/error STA2 |
||||
;asma-trees/labels STA2 |
||||
;asma-trees/macros STA2 |
||||
;asma-opcodes/_entry ;asma-trees/opcodes STA2 |
||||
( fall through ) |
||||
|
||||
@asma-init-next-pass ( -- ) |
||||
;asma/pass LDA INC ;asma/pass STA |
||||
;asma-write-buffer ;asma-output/ptr STA2 |
||||
#0100 DUP2 DUP ( 0100 0100 00 ) |
||||
;asma/state STA |
||||
;asma/addr STA2 |
||||
;asma/written-addr STA2 |
||||
;&preamble-end ;&preamble SUB2k ;asma-assemble-chunk JSR2 POP2 POP2 |
||||
JMP2r |
||||
|
||||
&preamble |
||||
"%BRK 20 "{ 20 "00 20 "} 20 |
||||
"%[ 20 "{ 20 "} 20 |
||||
"%] 20 "{ 20 "} 20 |
||||
"@on-reset 20 |
||||
&preamble-end |
||||
|
||||
( |
||||
Divide a file up into chunks, and pass each chunk to asma-assemble-chunk. |
||||
) |
||||
|
||||
@asma-assemble-file-pass ( filename-ptr* -- ) |
||||
;asma-assemble-chunk #0000 ROT2 ( func* line^ filename* ) |
||||
;asma-read-buffer DUP2 ;asma-read-buffer/end ROT2 SUB2 ( func* line^ filename* buf* size^ ) |
||||
ROT2 ( func* line^ buf* size^ filename* ) |
||||
,file-read-chunks JSR |
||||
|
||||
;asma/error LDA2 ORA ,&error JCN |
||||
|
||||
&error |
||||
POP2 POP2 POP2 POP2 POP2 |
||||
JMP2r |
||||
|
||||
@file-read-chunks ( func* udata* buf* size* filename* -- func* udata'* buf* size* filename* ) |
||||
|
||||
#0000 DUP2 ( F* U* B* SZ* FN* OL* OH* / ) |
||||
&resume |
||||
ROT2 STH2 ( F* U* B* SZ* OL* OH* / FN* ) |
||||
ROT2 ( F* U* B* OL* OH* SZ* / FN* ) |
||||
|
||||
&loop |
||||
STH2kr .File/name DEO2 ( F* U* B* OL* OH* SZ* / FN* ) |
||||
STH2k ,ffwd/length STR2 ( F* U* B* OL* OH* / FN* SZ* ) |
||||
STH2 ( F* U* B* OL* / FN* SZ* OH* ) |
||||
STH2k ,ffwd/offset STR2 ( F* U* B* / FN* SZ* OH* OL* ) |
||||
DUP2 ,ffwd/addr STR2 |
||||
,ffwd JSR |
||||
SWP2 ( F* B* U* / FN* SZ* OH* OL* ) |
||||
ROT2k NIP2 ( F* B* U* B* F* / FN* SZ* OH* OL* ) |
||||
OVR2 .File/read DEO2 ( F* B* U* B* F* / FN* SZ* OH* OL* ) |
||||
.File/success DEI2 SWP2 ( F* B* U* B* length* F* / FN* SZ* OH* OL* ) |
||||
JSR2 ( F* B* U'* done-up-to* / FN* SZ* OH* OL* ) |
||||
ROT2 SWP2 ( F* U'* B* done-up-to* / FN* SZ* OH* OL* ) |
||||
SUB2k NIP2 ( F* U'* B* -done-length* / FN* SZ* OH* OL* ) |
||||
ORAk ,¬-end JCN ( F* U'* B* -done-length* / FN* SZ* OH* OL* ) |
||||
|
||||
POP2 POP2r POP2r ( F* U'* B* / FN* SZ* ) |
||||
STH2r STH2r ( F* U'* B* SZ* FN* / ) |
||||
JMP2r |
||||
|
||||
¬-end |
||||
STH2r SWP2 ( F* U'* B* OL* -done-length* / FN* SZ* OH* ) |
||||
LTH2k JMP INC2r ( F* U'* B* OL* -done-length* / FN* SZ* OH'* ) |
||||
SUB2 ( F* U'* B* OL'* / FN* SZ* OH'* ) |
||||
STH2r STH2r ( F* U'* B* OL'* OH'* SZ* / FN* ) |
||||
,&loop JMP |
||||
|
||||
@ffwd |
||||
LIT2 &length $2 |
||||
LIT2 &offset $2 |
||||
|
||||
&coarse ( length* offset* ) |
||||
GTH2k ,&fine JCN |
||||
OVR2 .File/length DEO2 |
||||
,&addr LDR2 .File/read DEO2 |
||||
OVR2 SUB2 |
||||
,&coarse JMP |
||||
|
||||
&fine ( length* offset* ) |
||||
.File/length DEO2 ( length* ) |
||||
,&addr LDR2 .File/read DEO2 |
||||
.File/length DEO2 ( ) |
||||
JMP2r |
||||
|
||||
&addr $2 |
||||
|
||||
|
||||
( |
||||
Assemble a chunk of source code, which begins with whitespace or the start |
||||
of a token and is divided up into tokens separated by whitespace. If the |
||||
chunk ends with whitespace, assembled-up-to-ptr* will equal ptr* + len* and |
||||
every token in the chunk will have been assembled. If the chunk ends with a |
||||
non-whitespace character, assembled-up-to-ptr* will point to the beginning |
||||
of the last token in the chunk. |
||||
) |
||||
|
||||
@asma-assemble-chunk ( line^ chunk* len^ -- line^ assembled-up-to-chunk* ) |
||||
ROT2 STH2 ( chunk* len^ / line^ ) |
||||
OVR2 ADD2 ( chunk* end-chunk* / line^ ) |
||||
OVR2 ;asma-read-buffer EQU2 STH |
||||
DUP2 ;asma-read-buffer/end NEQ2 |
||||
STHr AND ;asma/eof STA |
||||
SWP2 STH2k ( end-chunk* chunk* / line^ start-of-token* ) |
||||
|
||||
&loop ( end-chunk* char* / line^ start-of-token* ) |
||||
LDAk #21 LTH ,&whitespace JCN |
||||
INC2 ,&loop JMP |
||||
|
||||
&whitespace ( end-chunk* ws-char* / line^ start-of-token* ) |
||||
GTH2k ,&within-chunk JCN |
||||
;asma/eof LDA ,&eof JCN |
||||
|
||||
( reached the end of the chunk, start-of-token* is where we assembled up to ) |
||||
POP2 POP2 STH2r STH2r SWP2 JMP2r |
||||
|
||||
&within-chunk ( end-chunk* ws-char* / line^ start-of-token* ) |
||||
LDAk #0a NEQ ( end-chunk* ws-char* not-newline / line^ start-of-token* ) |
||||
#00 OVR2 STA |
||||
STH2r ,asma-assemble-token JSR ( end-chunk* ws-char* not-newline / line^ ) |
||||
;asma/error LDA2 ORA ,&error JCN |
||||
,¬-newline JCN |
||||
,asma/lines LDR2 INC2 ,asma/lines STR2 |
||||
¬-newline ( end-chunk* ws-char* / line^ ) |
||||
;asma/break LDA ,&break JCN |
||||
INC2 STH2k ( end-chunk* start-of-token* / line^ start-of-token* ) |
||||
,&loop JMP |
||||
|
||||
&break ( end-chunk* ws-char* / line^ ) |
||||
( the read buffer has been invalidated, ws-char* plus one is where we assembled up to ) |
||||
;asma/break LDA #01 SUB ;asma/break STA |
||||
INC2 NIP2 ( assembled-up-to-ptr* / line^ ) |
||||
STH2r SWP2 JMP2r |
||||
|
||||
&error ( end-chunk* ws-char* not-newline / line^ ) |
||||
( return no progress with assembly to make file-read-chunks exit ) |
||||
POP POP2 POP2 |
||||
STH2kr ;asma/line STA2 |
||||
STH2r ;asma-read-buffer |
||||
JMP2r |
||||
|
||||
&eof ( end-chunk* ws-char* / line^ start-of-token* ) |
||||
( reached the end of file, end-chunk* is safe to write since the buffer is bigger ) |
||||
( return no progress with assembly to make file-read-chunks exit ) |
||||
POP2 ( end-chunk* / line^ start-of-token* ) |
||||
#00 ROT ROT STA ( / line^ start-of-token* ) |
||||
STH2r ,asma-assemble-token JSR ( / line^ ) |
||||
STH2r ;asma-read-buffer JMP2r |
||||
|
||||
@asma [ |
||||
&pass $1 &state $1 &line $2 &lines $2 &break $1 &eof $1 |
||||
&comment-level $1 |
||||
&token $2 &orig-token $2 |
||||
&addr $2 &written-addr $2 &flush-fn $2 |
||||
&src-filename $2 &dest-filename $2 |
||||
&error $2 &log-level $1 |
||||
] |
||||
@asma-trees [ &labels $2 ¯os $2 &opcodes $2 &scope $2 ] |
||||
|
||||
( |
||||
The main routine to assemble a single token. |
||||
asma/state contains several meaningful bits: |
||||
0x02 we are in a comment, |
||||
0x04 we are in a macro body, |
||||
0x08 we are in a macro body that we are ignoring |
||||
(because the macro was already defined in a previous pass). |
||||
Since 0x08 never appears without 0x04, the lowest bit set in asma/state is |
||||
always 0x00, 0x02, or 0x04, which is very handy for use with jump tables. |
||||
The lowest bit set can be found easily by #00 (n) SUBk AND. |
||||
) |
||||
|
||||
@asma-assemble-token ( string-ptr* -- ) |
||||
DUP2 ;asma/token STA2 |
||||
DUP2 ;asma/orig-token STA2 |
||||
LDAk ,¬-empty JCN |
||||
POP2 |
||||
JMP2r |
||||
|
||||
¬-empty ( token* / ) |
||||
( truncate to one char long ) |
||||
INC2 ( end* / ) |
||||
STH2k LDAkr ( end* / end* char ) |
||||
STH2k ( end* / end* char end* ) |
||||
LITr 00 STH2 ( / end* char end* 00 end* ) |
||||
STAr ( / end* char end* ) |
||||
|
||||
#00 ;asma/state LDA SUBk AND ( tree-offset* / end* ) |
||||
DUP2 ;&first-char-trees ADD2 ( tree-offset* incoming-ptr* / end* ) |
||||
;asma-traverse-tree JSR2 |
||||
|
||||
( restore truncated char ) |
||||
STAr |
||||
|
||||
,¬-found JCN |
||||
|
||||
( tree-offset* token-routine-ptr* / end* ) |
||||
STH2r ;asma/token STA2 |
||||
NIP2 LDA2 |
||||
JMP2 ( tail call ) |
||||
|
||||
¬-found ( tree-offset* dummy* / end* ) |
||||
POP2 POP2r |
||||
;&body-routines ADD2 LDA2 |
||||
JMP2 ( tail call ) |
||||
|
||||
&first-char-trees |
||||
:asma-first-char-normal/_entry |
||||
:asma-first-char-comment/_entry |
||||
:asma-first-char-macro/_entry |
||||
|
||||
&body-routines |
||||
:asma-normal-body |
||||
:asma-ignore |
||||
:asma-macro-body |
||||
|
||||
@asma-parse-hex-digit ( charcode -- 00-0f if valid hex |
||||
OR 10-ff otherwise ) |
||||
DUP #3a LTH ,&digit JCN |
||||
DUP #60 GTH ,&letter JCN |
||||
JMP2r |
||||
|
||||
&digit |
||||
#30 SUB |
||||
JMP2r |
||||
|
||||
&letter |
||||
#57 SUB |
||||
JMP2r |
||||
|
||||
@asma-parse-hex-string ( strict -- value* 06 if valid hex and (length == 4 or (length == 3 and not strict)) |
||||
OR value* 03 if valid hex and (length == 2 or (length == 1 and not strict)) |
||||
OR 00 otherwise ) |
||||
STH |
||||
;asma/token LDA2 DUP2 ,strlen JSR ( token* length^ ) |
||||
DUP STHr AND ,&fail2 JCN |
||||
DUP2 #0004 GTH2 ,&fail2 JCN |
||||
ORAk #00 EQU ,&fail2 JCN |
||||
#0002 GTH2 ROT ROT |
||||
LIT2r 0000 |
||||
|
||||
&loop |
||||
LDAk |
||||
DUP ,¬-end JCN |
||||
POP POP2 |
||||
STH2r ROT INC DUPk ADD ADD |
||||
JMP2r |
||||
|
||||
¬-end |
||||
,asma-parse-hex-digit JSR |
||||
DUP #f0 AND ,&fail JCN |
||||
LITr 40 SFT2r |
||||
LITr 00 STH ADD2r |
||||
INC2 |
||||
,&loop JMP |
||||
|
||||
&fail |
||||
POP2r |
||||
&fail2 |
||||
POP2 POP2 |
||||
#00 |
||||
JMP2r |
||||
|
||||
~projects/library/string.tal |
||||
|
||||
@asma-traverse-tree ( incoming-ptr* -- binary-ptr* 00 if key found |
||||
OR node-incoming-ptr* 01 if key not found ) |
||||
;asma/token LDA2 |
||||
( fall through to traverse-tree ) |
||||
|
||||
~projects/library/binary-tree.tal |
||||
|
||||
@asma-parse-opcode ( -- byte 00 if valid opcode |
||||
OR 01 otherwise ) |
||||
;asma/token LDA2 |
||||
DUP2 ,strlen JSR #0003 LTH2 ,&too-short JCN |
||||
|
||||
( truncate to three chars long ) |
||||
#0003 ADD2 ( end* / ) |
||||
STH2k LDAkr ( end* / end* char ) |
||||
STH2k ( end* / end* char end* ) |
||||
LITr 00 STH2 ( / end* char end* 00 end* ) |
||||
STAr ( / end* char end* ) |
||||
|
||||
;asma-trees/opcodes ;asma-traverse-tree JSR2 |
||||
STAr |
||||
,¬-found JCN |
||||
|
||||
;asma-opcodes/_disasm SUB2 #03 SFT2 ( 00 byte / end* ) |
||||
DUP #00 EQU ,&set-keep JCN ( force keep flag for LIT ) |
||||
&loop |
||||
LDAkr STHr LIT2r 0001 ADD2r ( 00 byte char / end* ) |
||||
DUP ,¬-end JCN |
||||
POP POP2r |
||||
SWP |
||||
JMP2r |
||||
|
||||
¬-end |
||||
DUP LIT "2 NEQ ,¬-two JCN |
||||
POP LIT &short-flag $1 ORA ,&loop JMP |
||||
|
||||
¬-two |
||||
DUP LIT "r NEQ ,¬-return JCN |
||||
POP LIT &return-flag $1 ORA ,&loop JMP |
||||
|
||||
¬-return |
||||
LIT "k NEQ ,¬-keep JCN |
||||
&set-keep LIT &keep-flag $1 ORA ,&loop JMP |
||||
|
||||
¬-keep ( 00 byte / end* ) |
||||
¬-found ( incoming-ptr* / end* ) |
||||
POP2r |
||||
&too-short ( token* / ) |
||||
POP2 #01 |
||||
JMP2r |
||||
|
||||
@asma-write-lit ( byte -- ) |
||||
LIT LIT ,asma-write-byte JSR |
||||
,asma-write-byte JSR |
||||
JMP2r |
||||
|
||||
@asma-advance-addr ( delta* -- ) |
||||
;asma/addr LDA2k ( delta* ptr* value* ) |
||||
ROT2 ADD2 ( ptr* new-value* ) |
||||
SWP2 STA2 |
||||
JMP2r |
||||
|
||||
@asma-write-short ( short -- ) |
||||
SWP |
||||
,asma-write-byte JSR |
||||
( fall through ) |
||||
|
||||
@asma-write-byte ( byte -- ) |
||||
;asma/addr LDA2 ;asma/written-addr LDA2 |
||||
LTH2k ,&rewound JCN |
||||
&loop |
||||
EQU2k ,&ready JCN |
||||
#00 ,&write JSR |
||||
INC2 |
||||
,&loop JMP |
||||
|
||||
&rewound |
||||
;asma-msg-rewound ;asma/error STA2 |
||||
POP2 POP2 POP JMP2r |
||||
|
||||
&ready |
||||
POP2 INC2 |
||||
DUP2 ;asma/addr STA2 |
||||
;asma/written-addr STA2 |
||||
|
||||
&write |
||||
,asma-output/ptr LDR2 |
||||
DUP2 ;asma-write-buffer/end EQU2 ,&flush JCN |
||||
&after-flush |
||||
STH2k STA |
||||
STH2r INC2 ,asma-output/ptr STR2 |
||||
JMP2r |
||||
|
||||
&flush ( ptr* -- start-of-buffer* ) |
||||
;asma-write-buffer SUB2k ( ptr* start* len* ) |
||||
;asma/flush-fn LDA2 JSR2 |
||||
NIP2 ( start* ) |
||||
,&after-flush JMP |
||||
|
||||
@asma-output [ &ptr $2 ] |
||||
|
||||
@asma-flush-ignore ( len* -- ) |
||||
POP2 |
||||
JMP2r |
||||
|
||||
@asma-flush-to-file ( len* -- ) |
||||
.File/length DEO2 |
||||
;asma/dest-filename LDA2 .File/name DEO2 |
||||
;asma-write-buffer .File/write DEO2 |
||||
JMP2r |
||||
|
||||
@asma-flush-to-console ( len* -- ) |
||||
ORAk ,¬-empty JCN |
||||
POP2 JMP2r |
||||
|
||||
¬-empty |
||||
;asma-write-buffer DUP2 ROT2 ADD2 SWP2 ( end* ptr* ) |
||||
&loop ( end* ptr* ) |
||||
LDAk .Console/write DEO |
||||
INC2 |
||||
GTH2k ,&loop JCN |
||||
|
||||
POP2 POP2 |
||||
JMP2r |
||||
|
||||
~projects/library/heap.tal |
||||
|
||||
( |
||||
First character routines. |
||||
The following routines (that don't have a FORTH-like signature) are called |
||||
to deal with tokens that begin with particular first letters, or (for |
||||
-body routines) tokens that fail to match any first letter in their tree. |
||||
) |
||||
|
||||
@asma-comment-more |
||||
;asma/token LDA2 ;strlen JSR2 ORA ,asma-ignore JCN |
||||
@asma-comment-start |
||||
;asma/comment-level LDAk INC ROT ROT STA |
||||
;asma/state LDA #02 ORA ;asma/state STA |
||||
@asma-ignore |
||||
JMP2r |
||||
|
||||
@asma-comment-less |
||||
;asma/token LDA2 ;strlen JSR2 ORA ,asma-ignore JCN |
||||
;asma/comment-level LDAk #01 SUB DUP SWP2 STA ,asma-ignore JCN |
||||
@asma-comment-end |
||||
;asma/state LDA #0c AND ;asma/state STA |
||||
JMP2r |
||||
|
||||
@asma-macro-define |
||||
;asma/pass LDA ,&ignore-macro JCN |
||||
|
||||
;asma-trees/macros ;asma-traverse-tree JSR2 ,¬-exist JCN |
||||
POP2 |
||||
;asma-msg-macro ;asma/error STA2 |
||||
JMP2r |
||||
|
||||
¬-exist ( incoming-ptr* ) |
||||
( define macro by creating new node ) |
||||
;heap LDA2 SWP2 STA2 |
||||
#0000 ;append-heap-short JSR2 ( less-than pointer ) |
||||
#0000 ;append-heap-short JSR2 ( greater-than pointer ) |
||||
;asma/token LDA2 ;append-heap-string JSR2 ( key ) |
||||
;asma/state LDA #04 ORA ;asma/state STA |
||||
JMP2r |
||||
|
||||
&ignore-macro |
||||
;asma/state LDA #0c ORA ;asma/state STA |
||||
JMP2r |
||||
|
||||
@asma-macro-body |
||||
;asma/state LDA #08 AND ,&skip JCN |
||||
;asma/token LDA2 ;append-heap-string JSR2 |
||||
&skip |
||||
JMP2r |
||||
|
||||
@asma-macro-end |
||||
#00 ;append-heap-byte JSR2 |
||||
;asma/state LDA #02 AND ;asma/state STA |
||||
JMP2r |
||||
|
||||
@asma-label-define |
||||
;asma-trees/labels ,asma-label-helper JSR |
||||
,&already-existed JCN |
||||
|
||||
#0000 ;append-heap-short JSR2 ( data2: subtree incoming ptr ) |
||||
|
||||
&already-existed |
||||
#0002 ADD2 ;asma-trees/scope STA2 |
||||
JMP2r |
||||
|
||||
@asma-sublabel-define |
||||
;asma-trees/scope LDA2 ,asma-label-helper JSR |
||||
POP POP2 |
||||
JMP2r |
||||
|
||||
@asma-label-helper ( incoming-ptr* -- binary-ptr* 01 if label existed already |
||||
OR binary-ptr* 00 if label was created ) |
||||
;asma-traverse-tree JSR2 |
||||
,&new-label JCN |
||||
|
||||
( label already exists ) |
||||
LDA2k ;asma/addr LDA2 EQU2 ,&address-match JCN |
||||
;asma-msg-redefined ;asma/error STA2 |
||||
|
||||
&address-match |
||||
#01 JMP2r |
||||
|
||||
&new-label ( incoming-ptr* ) |
||||
( define label by creating new node ) |
||||
;heap LDA2 SWP2 STA2 |
||||
#0000 ;append-heap-short JSR2 ( less-than pointer ) |
||||
#0000 ;append-heap-short JSR2 ( greater-than pointer ) |
||||
;asma/token LDA2 ;append-heap-string JSR2 ( key ) |
||||
|
||||
;heap LDA2 |
||||
|
||||
;asma/addr LDA2 ;append-heap-short JSR2 ( data1: address ) |
||||
#00 JMP2r |
||||
|
||||
@asma-pad-absolute |
||||
#0000 ;asma/addr STA2 |
||||
( fall through ) |
||||
|
||||
@asma-pad-relative |
||||
#00 ;asma-parse-hex-string JSR2 |
||||
,&valid JCN |
||||
|
||||
;asma-msg-hex ;asma/error STA2 |
||||
JMP2r |
||||
|
||||
&valid |
||||
;asma-advance-addr JMP2 ( tail call ) |
||||
|
||||
@asma-raw-word |
||||
;asma/token LDA2 |
||||
|
||||
&loop |
||||
LDAk |
||||
DUP ,¬-end JCN |
||||
|
||||
POP POP2 |
||||
JMP2r |
||||
|
||||
¬-end |
||||
;asma-write-byte JSR2 |
||||
INC2 |
||||
,&loop JMP |
||||
|
||||
@asma-literal-abs-addr |
||||
LIT LIT2 ;asma-write-byte JSR2 |
||||
( fall through ) |
||||
|
||||
@asma-abs-addr |
||||
,asma-addr-helper JSR |
||||
;asma-write-short JMP2 ( tail call ) |
||||
|
||||
@asma-literal-zero-addr |
||||
LIT LIT ;asma-write-byte JSR2 |
||||
( fall through ) |
||||
|
||||
@asma-zero-addr |
||||
,asma-addr-helper JSR |
||||
;asma-write-byte JSR2 |
||||
|
||||
,¬-zero-page JCN |
||||
JMP2r |
||||
|
||||
¬-zero-page |
||||
;asma/pass LDA #00 EQU |
||||
;asma/error LDA2 ORA |
||||
ORA ,&ignore-error JCN |
||||
;asma-msg-zero-page ;asma/error STA2 |
||||
&ignore-error |
||||
JMP2r |
||||
|
||||
@asma-jci |
||||
#20 ,asma-jxi JMP ( tail call ) |
||||
|
||||
@asma-jmi |
||||
#40 |
||||
( fall through ) |
||||
|
||||
@asma-jxi |
||||
;asma-write-byte JSR2 |
||||
,asma-addr-helper JSR |
||||
;asma/addr LDA2 SUB2 |
||||
#0002 SUB2 |
||||
;asma-write-short JMP2 ( tail call ) |
||||
|
||||
@asma-literal-rel-addr |
||||
LIT LIT ;asma-write-byte JSR2 |
||||
( fall through ) |
||||
|
||||
@asma-rel-addr |
||||
,asma-addr-helper JSR |
||||
;asma/addr LDA2 SUB2 |
||||
#0002 SUB2 |
||||
|
||||
DUP2 #0080 LTH2 STH |
||||
DUP2 #ff7f GTH2 STHr ORA ,&in-bounds JCN |
||||
|
||||
POP2 |
||||
;asma-msg-relative ;asma/error STA2 |
||||
JMP2r |
||||
|
||||
&in-bounds |
||||
;asma-write-byte JSR2 |
||||
POP |
||||
JMP2r |
||||
|
||||
@asma-addr-helper ( -- addr* ) |
||||
;asma/token LDA2 LDAk #26 NEQ ,¬-local JCN |
||||
INC2 ;asma/token STA2 |
||||
;asma-trees/scope LDA2 |
||||
,&final-lookup JMP |
||||
|
||||
¬-local ( token* ) |
||||
LDAk |
||||
DUP ,¬-end JCN |
||||
POP POP2 |
||||
;asma-trees/labels |
||||
,&final-lookup JMP |
||||
|
||||
¬-end ( token* char ) |
||||
#2f EQU ,&found-slash JCN |
||||
INC2 |
||||
,¬-local JMP |
||||
|
||||
&found-slash ( token* ) |
||||
DUP2 #00 ROT ROT STA |
||||
;asma-trees/labels ;asma-traverse-tree JSR2 STH |
||||
SWP2 DUP2 #2f ROT ROT STA |
||||
STHr ,¬-found2 JCN |
||||
( token* binary-ptr* ) |
||||
INC2 ;asma/token STA2 |
||||
#0002 ADD2 |
||||
|
||||
&final-lookup ( addr-offset* incoming-ptr* ) |
||||
;asma-traverse-tree JSR2 |
||||
,¬-found JCN |
||||
LDA2 |
||||
JMP2r |
||||
|
||||
¬-found2 ( dummy* dummy* ) |
||||
POP2 |
||||
¬-found ( dummy* ) |
||||
POP2 |
||||
|
||||
;asma/pass LDA #00 EQU ,&ignore-error JCN |
||||
;asma-msg-label ;asma/error STA2 |
||||
&ignore-error |
||||
|
||||
;asma/addr LDA2 |
||||
JMP2r |
||||
|
||||
@asma-literal-hex |
||||
#01 ;asma-parse-hex-string JSR2 JMP |
||||
( hex invalid ) ,&invalid JMP |
||||
( hex byte ) ,asma-byte-helper JMP |
||||
( hex short ) ,asma-short-helper JMP |
||||
|
||||
&invalid |
||||
;asma-msg-hex ;asma/error STA2 |
||||
JMP2r |
||||
|
||||
@asma-byte-helper ( dummy value -- ) |
||||
;asma-write-lit JSR2 |
||||
POP |
||||
JMP2r |
||||
&raw |
||||
;asma-write-byte JSR2 |
||||
POP |
||||
JMP2r |
||||
|
||||
@asma-short-helper ( value* -- ) |
||||
LIT LIT2 ;asma-write-byte JSR2 |
||||
&raw |
||||
;asma-write-short JMP2 ( tail call ) |
||||
|
||||
@asma-normal-body |
||||
;asma-parse-opcode JSR2 ,¬-opcode JCN |
||||
;asma-write-byte JMP2 ( tail call ) |
||||
|
||||
¬-opcode |
||||
#01 ;asma-parse-hex-string JSR2 JMP |
||||
( hex invalid ) ,¬-hex JMP |
||||
( hex byte ) ,asma-byte-helper/raw JMP |
||||
( hex short ) ,asma-short-helper/raw JMP |
||||
|
||||
¬-hex |
||||
;asma-trees/macros ;asma-traverse-tree JSR2 ,¬-macro JCN |
||||
|
||||
¯o-loop |
||||
LDAk ,&keep-going JCN |
||||
POP2 |
||||
JMP2r |
||||
|
||||
&keep-going |
||||
DUP2k ;strlen JSR2 INC2 ADD2 |
||||
SWP2 ;asma-assemble-token JSR2 ;asma/error LDA2 ORA ,¯o-error JCN |
||||
,¯o-loop JMP |
||||
|
||||
¯o-error |
||||
POP2 |
||||
JMP2r |
||||
|
||||
¬-macro |
||||
POP2 |
||||
#60 ;asma-jxi JMP2 ( tail call ) |
||||
|
||||
@asma-include |
||||
;heap LDA2 |
||||
;asma/token LDA2 ;append-heap-string JSR2 |
||||
;asma-assemble-file-pass JSR2 |
||||
;asma/break LDAk INC ROT ROT STA |
||||
JMP2r |
||||
|
||||
( Error messages ) |
||||
|
||||
@asma-msg-hex "Invalid 20 "hexadecimal 00 |
||||
@asma-msg-zero-page "Address 20 "not 20 "in 20 "zero 20 "page 00 |
||||
@asma-msg-relative "Address 20 "outside 20 "range 00 |
||||
@asma-msg-label "Label 20 "not 20 "found 00 |
||||
@asma-msg-macro "Macro 20 "already 20 "exists 00 |
||||
@asma-msg-rewound "Memory 20 "overwrite 00 |
||||
@asma-msg-redefined "Label 20 "redefined 00 |
||||
|
||||
( trees ) |
||||
|
||||
( --- 8< ------- 8< --- cut here --- 8< ------- 8< --- ) |
||||
( automatically generated code below ) |
||||
( see etc/asma.moon for instructions ) |
||||
|
||||
( label less greater key binary |
||||
than than string data ) |
||||
|
||||
@asma-first-char-comment |
||||
&28 $2 $2 "( 00 :asma-comment-more |
||||
&_entry :&28 $2 ") 00 :asma-comment-less |
||||
|
||||
@asma-first-char-macro |
||||
&28 $2 $2 "( 00 :asma-comment-start |
||||
&29 :&28 $2 ") 00 :asma-comment-end |
||||
&_entry :&29 :&7d "{ 00 :asma-ignore |
||||
&7d $2 $2 "} 00 :asma-macro-end |
||||
|
||||
@asma-first-char-normal |
||||
&21 $2 $2 "! 00 :asma-jmi |
||||
&22 :&21 $2 "" 00 :asma-raw-word |
||||
&23 :&22 :&25 "# 00 :asma-literal-hex |
||||
&24 $2 $2 "$ 00 :asma-pad-relative |
||||
&25 :&24 $2 "% 00 :asma-macro-define |
||||
&26 :&23 :&2c 26 00 ( & ) :asma-sublabel-define |
||||
&28 $2 $2 "( 00 :asma-comment-start |
||||
&29 :&28 $2 ") 00 :asma-comment-end |
||||
&2c :&29 :&2d ", 00 :asma-literal-rel-addr |
||||
&2d $2 $2 "- 00 :asma-zero-addr |
||||
&_entry :&26 :&5f ". 00 :asma-literal-zero-addr |
||||
&3a $2 $2 ": 00 :asma-abs-addr |
||||
&3b :&3a $2 "; 00 :asma-literal-abs-addr |
||||
&3d :&3b :&40 "= 00 :asma-abs-addr |
||||
&3f $2 $2 "? 00 :asma-jci |
||||
&40 :&3f $2 "@ 00 :asma-label-define |
||||
&5f :&3d :&7d "_ 00 :asma-rel-addr |
||||
&7b $2 $2 "{ 00 :asma-ignore |
||||
&7c :&7b $2 "| 00 :asma-pad-absolute |
||||
&7d :&7c :&7e "} 00 :asma-ignore |
||||
&7e $2 $2 "~ 00 :asma-include |
||||
|
||||
@asma-opcodes |
||||
&_entry :>H :&ROT &_disasm "LIT 00 |
||||
&INC $2 $2 "INC 00 |
||||
&POP $2 $2 "POP 00 |
||||
&NIP :&MUL :&OVR "NIP 00 |
||||
&SWP $2 $2 "SWP 00 |
||||
&ROT :&NIP :&STR "ROT 00 |
||||
&DUP $2 $2 "DUP 00 |
||||
&OVR :&ORA :&POP "OVR 00 |
||||
&EQU $2 $2 "EQU 00 |
||||
&NEQ $2 $2 "NEQ 00 |
||||
>H :&DIV :&JSR "GTH 00 |
||||
<H $2 $2 "LTH 00 |
||||
&JMP $2 $2 "JMP 00 |
||||
&JCN :&INC :&JMP "JCN 00 |
||||
&JSR :&JCN :&LDR "JSR 00 |
||||
&STH $2 $2 "STH 00 |
||||
&LDZ $2 $2 "LDZ 00 |
||||
&STZ $2 $2 "STZ 00 |
||||
&LDR :&LDA :&LDZ "LDR 00 |
||||
&STR :&STA :&SUB "STR 00 |
||||
&LDA $2 $2 "LDA 00 |
||||
&STA :&SFT :&STH "STA 00 |
||||
&DEI :&AND :&DEO "DEI 00 |
||||
&DEO $2 $2 "DEO 00 |
||||
&ADD $2 $2 "ADD 00 |
||||
&SUB :&STZ :&SWP "SUB 00 |
||||
&MUL :<H :&NEQ "MUL 00 |
||||
&DIV :&DEI :&EOR "DIV 00 |
||||
&AND :&ADD $2 "AND 00 |
||||
&ORA $2 $2 "ORA 00 |
||||
&EOR :&DUP :&EQU "EOR 00 |
||||
&SFT $2 $2 "SFT 00 |
||||
|
||||
@ -1,52 +0,0 @@
|
||||
( |
||||
heap functions |
||||
|
||||
The heap is an area of memory that is written from the bottom up. These |
||||
are a few convenience functions to do that writing. |
||||
|
||||
There is a global short called "heap" that must be written to before using |
||||
these functions, otherwise the zero page and program memory could be |
||||
overwritten. |
||||
|
||||
A simple program could use all unallocated memory for the heap like so: |
||||
|
||||
|0100 @reset |
||||
;my-heap ;heap STA2 |
||||
|
||||
(the rest of your code) |
||||
|
||||
@my-heap |
||||
|
||||
Note that if there is a risk that the heap may overflow its bounds, it is |
||||
strongly recommended to check where it is writing to. ";heap LDA2" will |
||||
tell you where the next byte is written. |
||||
) |
||||
|
||||
@heap $2 |
||||
|
||||
@append-heap-byte ( byte -- ) |
||||
,heap LDR2 ( byte heap* ) |
||||
INC2k ,heap STR2 |
||||
STA |
||||
JMP2r |
||||
|
||||
@append-heap-short ( short^ -- ) |
||||
,heap LDR2 ( short^ heap* ) |
||||
INC2k INC2 ,heap STR2 |
||||
STA2 |
||||
JMP2r |
||||
|
||||
@append-heap-string ( string* -- ) |
||||
( copies a null-terminated string onto the heap, including the null ) |
||||
STH2 ,heap LDR2 ( heap* / string* ) |
||||
#01 JMP ( skip past INC2r ) |
||||
|
||||
&loop |
||||
INC2r ( heap* / string* ) |
||||
LDAkr DUPr STH2k STAr ( heap* / string* byte ) |
||||
INC2 |
||||
LITr f7 JCNr ( f7 is the value ",&loop" would produce ) |
||||
POP2r ( heap* ) |
||||
,heap STR2 |
||||
JMP2r |
||||
|
||||
@ -1,243 +0,0 @@
|
||||
%BYE { #01 .System/halt DEO BRK } |
||||
%DEBUG { #ab .System/debug DEO } |
||||
%IN-RANGE { ROT INCk SWP SUB2 GTH } |
||||
%MOD { DIVk MUL SUB } |
||||
%MOD2 { DIV2k MUL2 SUB2 } |
||||
%NL { #0a .Console/write DEO } |
||||
%SP { #20 .Console/write DEO } |
||||
|
||||
@print-string ( string* -- ) |
||||
LDAk ,¬-end JCN |
||||
POP2 JMP2r |
||||
¬-end |
||||
LDAk .Console/write DEO |
||||
INC2 |
||||
,print-string JMP |
||||
|
||||
@print-short-decimal ( short* -- ) |
||||
#03e8 DIV2k |
||||
DUP ,print-byte-decimal/second JSR |
||||
MUL2 SUB2 |
||||
#0064 DIV2k |
||||
DUP ,print-byte-decimal/third JSR |
||||
MUL2 SUB2 |
||||
NIP ,print-byte-decimal/second JMP |
||||
|
||||
@print-byte-decimal ( byte -- ) |
||||
#64 DIVk DUP #30 ADD .Console/write DEO MUL SUB |
||||
&second |
||||
#0a DIVk DUP #30 ADD .Console/write DEO MUL SUB |
||||
&third |
||||
#30 ADD .Console/write DEO |
||||
JMP2r |
||||
|
||||
@print-32z-hex ( 32-zp -- ) |
||||
#00 SWP |
||||
,print-32-hex JMP |
||||
|
||||
@print-64z-hex ( 64-zp -- ) |
||||
#00 SWP |
||||
( fall through ) |
||||
|
||||
@print-64-hex ( 64-ptr* -- ) |
||||
DUP2 #0004 ADD2 SWP2 ( lo32-ptr* hi32-ptr* ) |
||||
,print-32-hex JSR |
||||
( fall through ) |
||||
|
||||
@print-32-hex ( 32-ptr* -- ) |
||||
INC2k INC2 SWP2 ( lo-ptr* hi-ptr* ) |
||||
LDA2 ,print-short-hex JSR |
||||
LDA2 ( fall through ) |
||||
|
||||
@print-short-hex ( short* -- ) |
||||
SWP ,print-byte-hex JSR |
||||
( fall through ) |
||||
|
||||
@print-byte-hex ( byte -- ) |
||||
DUP #04 SFT ,print-nibble-hex JSR |
||||
#0f AND ( fall through ) |
||||
|
||||
@print-nibble-hex ( nibble -- ) |
||||
#30 ADD DUP #39 GTH #07 MUL ADD .Console/write DEO |
||||
JMP2r |
||||
|
||||
@next-input-byte ( -- number 00 |
||||
OR 01 at end of file ) |
||||
,next-input-short JSR ,&eof JCN |
||||
NIP #00 |
||||
JMP2r |
||||
|
||||
&eof |
||||
#01 |
||||
JMP2r |
||||
|
||||
@next-input-short ( -- number* 00 |
||||
OR 01 at end of file ) |
||||
LIT2 &ptr :heap |
||||
LIT2r 0000 |
||||
&ffwd |
||||
LDAk #3039 IN-RANGE ,&number JCN |
||||
INC2k SWP2 LDA ,&ffwd JCN |
||||
( eof ) |
||||
POP2 POP2r |
||||
;heap ,&ptr STR2 |
||||
#01 JMP2r |
||||
|
||||
&number |
||||
LIT2r 000a MUL2r |
||||
LDAk #30 SUB LITr 00 STH ADD2r |
||||
INC2 |
||||
LDAk #3039 IN-RANGE ,&number JCN |
||||
|
||||
,&ptr STR2 |
||||
STH2r #00 |
||||
JMP2r |
||||
|
||||
@add64 ( dest-ptr* src-ptr* -- carry ) |
||||
OVR2 #0004 ADD2 OVR2 #0004 ADD2 |
||||
,add32 JSR |
||||
( fall through ) |
||||
|
||||
@adc32 ( dest-ptr* src-ptr* carry -- carry ) |
||||
STH |
||||
OVR2 #0002 ADD2 OVR2 #0002 ADD2 |
||||
STHr ,adc16 JSR |
||||
,adc16 JMP ( tail call ) |
||||
|
||||
@add64z ( dest-zp src-zp -- carry ) |
||||
OVR #04 ADD OVR #04 ADD |
||||
,add32z JSR |
||||
( fall through ) |
||||
|
||||
@adc32z ( dest-zp src-zp carry -- carry ) |
||||
STH |
||||
OVR #02 ADD OVR #02 ADD |
||||
STHr ,adc16z JSR |
||||
,adc16z JMP ( tail call ) |
||||
|
||||
@add32z-short ( dest-zp src* -- carry ) |
||||
#00 SWP SWP2 ROT |
||||
( fall through ) |
||||
|
||||
@add32-short ( dest-ptr* src* -- carry ) |
||||
,&short STR2 |
||||
;&src ,add32 JMP ( tail call ) |
||||
|
||||
&src 0000 &short 0000 |
||||
|
||||
@add32 ( dest-ptr* src-ptr* -- carry ) |
||||
OVR2 #0002 ADD2 OVR2 #0002 ADD2 |
||||
,add16 JSR |
||||
( fall through ) |
||||
|
||||
@adc16 ( dest-ptr* src-ptr* carry -- carry ) |
||||
#00 EQU ,add16 JCN |
||||
OVR2 ;&one ,add16 JSR STH |
||||
,add16 JSR |
||||
STHr ORA |
||||
JMP2r |
||||
|
||||
&one 0001 |
||||
|
||||
@add16 ( dest-ptr* src-ptr* -- carry ) |
||||
OVR2 LDA2 DUP2 ROT2 LDA2 ( dest-ptr* dest* dest* src* ) |
||||
ADD2 GTH2k STH NIP2 ( dest-ptr* sum* / carry ) |
||||
SWP2 STA2 STHr ( carry ) |
||||
JMP2r |
||||
|
||||
@add32z ( dest-zp src-zp -- carry ) |
||||
OVR #02 ADD OVR #02 ADD |
||||
,add16z JSR |
||||
( fall through ) |
||||
|
||||
@adc16z ( dest-zp src-zp carry -- carry ) |
||||
#00 EQU ,add16z JCN |
||||
OVR #00 SWP ;adc16/one ,add16 JSR STH |
||||
,add16z JSR |
||||
STHr ORA |
||||
JMP2r |
||||
|
||||
@add16z ( dest-zp src-zp -- carry ) |
||||
OVR LDZ2 ROT LDZ2 OVR2 ( dest-zp dest* src* dest* ) |
||||
ADD2 GTH2k STH NIP2 ( dest-zp sum* / carry ) |
||||
ROT STZ2 STHr ( carry ) |
||||
JMP2r |
||||
|
||||
@gth64 ( left-ptr* right-ptr* -- 01 if left > right |
||||
OR 00 otherwise ) |
||||
OVR2 OVR2 ,gth32 JSR ,&greater JCN |
||||
OVR2 OVR2 SWP2 ,gth32 JSR ,&less JCN |
||||
#0004 ADD2 SWP2 #0004 ADD2 SWP2 ,gth32 JMP ( tail call ) |
||||
|
||||
&greater POP2 POP2 #01 JMP2r |
||||
&less POP2 POP2 #00 JMP2r |
||||
|
||||
@gth32z ( left-zp* right-zp* -- 01 if left > right |
||||
OR 00 otherwise ) |
||||
#00 ROT ROT #00 SWP |
||||
( fall through ) |
||||
|
||||
@gth32 ( left-ptr* right-ptr* -- 01 if left > right |
||||
OR 00 otherwise ) |
||||
OVR2 LDA2 OVR2 LDA2 ( left-ptr* right-ptr* left* right* ) |
||||
EQU2k ,&lo JCN |
||||
GTH2 NIP2 NIP NIP |
||||
JMP2r |
||||
|
||||
&lo |
||||
POP2 POP2 |
||||
INC2 INC2 LDA2 SWP2 INC2 INC2 LDA2 ( right-lo* left-lo* ) |
||||
LTH2 |
||||
JMP2r |
||||
|
||||
@add32z-short-short-mul ( dest-zp a* b* -- carry ) |
||||
STH2 STH2 #00 SWP STH2r STH2r |
||||
( fall through ) |
||||
|
||||
@add32-short-short-mul ( dest-ptr* a* b* -- carry ) |
||||
LITr 00 STH LITr 00 STH ( dest-ptr* a* / blo* bhi* ) |
||||
#00 ROT ROT #00 SWP ( dest-ptr* ahi* alo* / blo* bhi* ) |
||||
STH2kr OVR2 MUL2 ,&alo-bhi STR2 |
||||
OVR2 STH2r MUL2 ,&ahi-bhi STR2 ( dest-ptr ahi* alo* / blo* ) |
||||
STH2kr MUL2 ,&alo-blo STR2 ( dest-ptr* ahi* / blo* ) |
||||
STH2r MUL2 ,&ahi-blo STR2 ( dest-ptr* ) |
||||
DUP2 ;&sum1 ;add32 JSR2 STH |
||||
DUP2 ;&sum2 ;add32 JSR2 STH |
||||
;&sum3 ;add32 JSR2 |
||||
STH2r ORA ORA |
||||
JMP2r |
||||
|
||||
&sum1 &ahi-bhi 0000 &alo-blo 0000 |
||||
&sum2 00 &ahi-blo 0000 00 |
||||
&sum3 00 &alo-bhi 0000 00 |
||||
|
||||
@zero64 ( ptr* -- ) |
||||
#08 ,zero JMP ( tail call ) |
||||
|
||||
@zero32z ( zp -- ) |
||||
#00 SWP |
||||
( fall through ) |
||||
|
||||
@zero32 ( ptr* -- ) |
||||
#04 |
||||
( fall through ) |
||||
|
||||
@zero ( ptr* len -- ) |
||||
#00 SWP ADD2k NIP2 SWP2 |
||||
&loop |
||||
DUP2 #00 ROT ROT STA |
||||
INC2 |
||||
GTH2k ,&loop JCN |
||||
POP2 POP2 |
||||
JMP2r |
||||
|
||||
@is-nonzero64 ( ptr* -- flag ) |
||||
DUP2 ,is-nonzero32 JSR STH |
||||
#0004 ADD2 ,is-nonzero32 JSR STHr ORA |
||||
JMP2r |
||||
|
||||
@is-nonzero32 ( ptr* -- flag ) |
||||
LDA2k ORA STH |
||||
INC2 INC2 LDA2 ORA STHr ORA |
||||
JMP2r |
||||
|
||||
@ -1,692 +0,0 @@
|
||||
( simple graphical calculator ) |
||||
|
||||
|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1 |
||||
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 |
||||
|30 @Audio0 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 |
||||
|80 @Controller &vector $2 &button $1 &key $1 |
||||
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &wheel $1 |
||||
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 |
||||
|
||||
|0000 |
||||
|
||||
@input &value $2 &mode $1 |
||||
@stack &length $1 &items $10 |
||||
@center &x $2 &y $2 |
||||
@pointer &x $2 &y $2 &last $1 |
||||
@keypad-frame &x $2 &y $2 &x2 $2 &y2 $2 |
||||
@modpad-frame &x $2 &y $2 &x2 $2 &y2 $2 |
||||
@bitpad-frame &x $2 &y $2 &x2 $2 &y2 $2 |
||||
@input-frame &x $2 &y $2 &x2 $2 &y2 $2 |
||||
|
||||
|0100 ( -> ) |
||||
|
||||
( theme ) |
||||
#0e7d .System/r DEO2 |
||||
#0ec6 .System/g DEO2 |
||||
#0e95 .System/b DEO2 |
||||
( size ) |
||||
#0090 .Screen/width DEO2 |
||||
#0100 .Screen/height DEO2 |
||||
( vectors ) |
||||
;on-mouse .Mouse/vector DEO2 |
||||
;on-button .Controller/vector DEO2 |
||||
( setup synth ) |
||||
#0112 .Audio0/adsr DEO2 |
||||
;sin-pcm .Audio0/addr DEO2 |
||||
#0100 .Audio0/length DEO2 |
||||
#88 .Audio0/volume DEO |
||||
( center ) |
||||
.Screen/width DEI2 #01 SFT2 .center/x STZ2 |
||||
.Screen/height DEI2 #01 SFT2 .center/y STZ2 |
||||
.center/x LDZ2 #0020 SUB2 |
||||
DUP2 .keypad-frame/x STZ2 #003f ADD2 .keypad-frame/x2 STZ2 |
||||
.center/y LDZ2 #0018 SUB2 |
||||
DUP2 .keypad-frame/y STZ2 #003f ADD2 .keypad-frame/y2 STZ2 |
||||
.keypad-frame/x LDZ2 |
||||
DUP2 .modpad-frame/x STZ2 #003f ADD2 .modpad-frame/x2 STZ2 |
||||
.keypad-frame/y LDZ2 #0040 ADD2 |
||||
DUP2 .modpad-frame/y STZ2 #001f ADD2 .modpad-frame/y2 STZ2 |
||||
.keypad-frame/x LDZ2 |
||||
DUP2 .bitpad-frame/x STZ2 #003f ADD2 .bitpad-frame/x2 STZ2 |
||||
.modpad-frame/y2 LDZ2 #0008 ADD2 |
||||
DUP2 .bitpad-frame/y STZ2 #000f ADD2 .bitpad-frame/y2 STZ2 |
||||
.center/x LDZ2 #0020 SUB2 |
||||
DUP2 .input-frame/x STZ2 #003f ADD2 .input-frame/x2 STZ2 |
||||
.center/y LDZ2 #002a SUB2 |
||||
DUP2 .input-frame/y STZ2 #000f ADD2 .input-frame/y2 STZ2 |
||||
( theme support ) |
||||
;load-theme JSR2 |
||||
|
||||
BRK |
||||
|
||||
@on-button ( -> ) |
||||
|
||||
.Controller/key DEI |
||||
( generics ) |
||||
[ #00 ] NEQk NIP ,&no-empty JCN ;redraw JSR2 POP BRK &no-empty |
||||
[ #09 ] NEQk NIP ,&no-tab JCN ;toggle-mode JSR2 POP BRK &no-tab |
||||
[ #0d ] NEQk NIP ,&no-enter JCN ;do-push JSR2 POP BRK &no-enter |
||||
[ #1b ] NEQk NIP ,&no-esc JCN ;do-pop JSR2 POP BRK &no-esc |
||||
[ #08 ] NEQk NIP ,&no-backspace JCN ;do-erase JSR2 POP BRK &no-backspace |
||||
( arithmetic ) |
||||
[ LIT "+ ] NEQk NIP ,&no-add JCN ;do-add JSR2 POP BRK &no-add |
||||
[ LIT "- ] NEQk NIP ,&no-sub JCN ;do-sub JSR2 POP BRK &no-sub |
||||
[ LIT "* ] NEQk NIP ,&no-mul JCN ;do-mul JSR2 POP BRK &no-mul |
||||
[ LIT "/ ] NEQk NIP ,&no-div JCN ;do-div JSR2 POP BRK &no-div |
||||
( bitwise ) |
||||
[ LIT "& ] NEQk NIP ,&no-and JCN ;do-and JSR2 POP BRK &no-and |
||||
[ LIT "| ] NEQk NIP ,&no-ora JCN ;do-ora JSR2 POP BRK &no-ora |
||||
[ LIT "^ ] NEQk NIP ,&no-eor JCN ;do-eor JSR2 POP BRK &no-eor |
||||
[ LIT "~ ] NEQk NIP ,&no-not JCN ;do-not JSR2 POP BRK &no-not |
||||
( value ) |
||||
;key-value JSR2 ;push-input JSR2 |
||||
|
||||
BRK |
||||
|
||||
@on-mouse ( -> ) |
||||
|
||||
;pointer-icn .Screen/addr DEO2 |
||||
|
||||
( clear last cursor ) |
||||
.pointer/x LDZ2 .Screen/x DEO2 |
||||
.pointer/y LDZ2 .Screen/y DEO2 |
||||
#40 .Screen/sprite DEO |
||||
|
||||
( draw new cursor ) |
||||
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2 |
||||
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2 |
||||
#41 .Mouse/state DEI #01 EQU ADD .Screen/sprite DEO |
||||
|
||||
.Mouse/state DEI .pointer/last LDZ |
||||
( down ) |
||||
DUP2 #0100 NEQ2 ,&no-down JCN |
||||
.Mouse/x DEI2 .Mouse/y DEI2 |
||||
OVR2 OVR2 .keypad-frame ;within-rect JSR2 ;click-keypad JCN2 |
||||
OVR2 OVR2 .input-frame ;within-rect JSR2 ;click-input JCN2 |
||||
OVR2 OVR2 .modpad-frame ;within-rect JSR2 ;click-modpad JCN2 |
||||
OVR2 OVR2 .bitpad-frame ;within-rect JSR2 ;click-bitpad JCN2 |
||||
;toggle-mode JSR2 |
||||
POP2 POP2 |
||||
&no-down |
||||
( up ) |
||||
DUP2 #0001 NEQ2 ,&no-up JCN |
||||
;redraw JSR2 |
||||
&no-up |
||||
POP2 |
||||
( record ) |
||||
.Mouse/state DEI .pointer/last STZ |
||||
|
||||
BRK |
||||
|
||||
@click-keypad ( state* x* y* -> ) |
||||
|
||||
( y ) .keypad-frame/y LDZ2 SUB2 #24 SFT2 |
||||
( x ) SWP2 .keypad-frame/x LDZ2 SUB2 #04 SFT2 #0003 AND2 |
||||
( value ) ADD2 ;keypad/layout ADD2 LDA ;push-input JSR2 |
||||
#00 .Mouse/state DEO POP2 |
||||
|
||||
BRK |
||||
|
||||
@click-modpad ( state* x* y* -> ) |
||||
|
||||
( y ) .modpad-frame/y LDZ2 SUB2 #24 SFT2 NIP STH |
||||
( x ) .modpad-frame/x LDZ2 SUB2 #04 SFT2 |
||||
( lookup ) STHr ADD DUP2 ADD2 ;keypad/ops ADD2 LDA2 JSR2 |
||||
;draw-bitpad JSR2 |
||||
#00 .Mouse/state DEO POP2 |
||||
|
||||
BRK |
||||
|
||||
@click-input ( state* x* y* -> ) |
||||
|
||||
POP2 |
||||
.input-frame/x LDZ2 SUB2 #03 SFT2 NIP |
||||
DUP ,&no-push JCN |
||||
;do-push JSR2 &no-push |
||||
DUP #01 NEQ ,&no-pop JCN |
||||
;do-pop JSR2 &no-pop |
||||
POP |
||||
#00 .Mouse/state DEO POP2 |
||||
|
||||
BRK |
||||
|
||||
@click-bitpad ( state* x* y* -> ) |
||||
|
||||
( y ) .bitpad-frame/y LDZ2 SUB2 #33 SFT2 NIP STH |
||||
( x ) .bitpad-frame/x LDZ2 SUB2 #03 SFT2 NIP |
||||
( value ) STHr ADD STHk |
||||
|
||||
#30 ADD .Audio0/pitch DEO |
||||
|
||||
( toggle bit ) |
||||
.input/value LDZ2 #0001 |
||||
[ STHr #0f SWP SUB ] #40 SFT SFT2 EOR2 |
||||
.input/value STZ2 |
||||
|
||||
;draw-bitpad JSR2 |
||||
#ff ;draw-input JSR2 |
||||
#00 .Mouse/state DEO POP2 |
||||
|
||||
BRK |
||||
|
||||
@push-input ( key -- ) |
||||
|
||||
DUP #50 ADD .Audio0/pitch DEO |
||||
#00 OVR ;keypad/series ADD2 LDA ;draw-keypad JSR2 |
||||
( hex/dec ) |
||||
#00 SWP .input/value LDZ2 #00 [ #0a #10 .input/mode LDZ JMP SWP POP ] MUL2 |
||||
ADD2 .input/value STZ2 |
||||
#ff ;draw-input JSR2 |
||||
;draw-bitpad JSR2 |
||||
|
||||
JMP2r |
||||
|
||||
@push ( value* -- ) |
||||
|
||||
( store ) .stack/length LDZ DUP ADD .stack/items ADD STZ2 |
||||
( INCZ ) .stack/length LDZk INC SWP STZ |
||||
( reset ) #0000 .input/value STZ2 |
||||
#00 ;draw-input JSR2 |
||||
;draw-stack JSR2 |
||||
|
||||
JMP2r |
||||
|
||||
@pop ( -- value* ) |
||||
|
||||
.stack/length LDZ #01 SUB DUP ADD .stack/items ADD LDZ2 |
||||
( clear ) #0000 [ .stack/length LDZ #01 SUB DUP ADD .stack/items ADD ] STZ2 |
||||
( DECZ ) .stack/length LDZk #01 SUB SWP STZ |
||||
#01 ;draw-input JSR2 |
||||
;draw-stack JSR2 |
||||
|
||||
JMP2r |
||||
|
||||
@toggle-mode ( -- ) |
||||
|
||||
.input/mode LDZk #00 EQU SWP STZ |
||||
#30 .Audio0/pitch DEO |
||||
;redraw JSR2 |
||||
|
||||
JMP2r |
||||
|
||||
@do-push ( -- ) |
||||
|
||||
.input/value LDZ2 #0000 GTH2 JMP JMP2r |
||||
.stack/length LDZ #07 LTH JMP JMP2r |
||||
#40 .Audio0/pitch DEO |
||||
.input/value LDZ2 ;push JSR2 |
||||
;draw-bitpad JSR2 |
||||
|
||||
JMP2r |
||||
|
||||
@do-pop ( -- ) |
||||
|
||||
#0000 .input/value STZ2 |
||||
.stack/length LDZ #00 EQU ,&continue JCN |
||||
#41 .Audio0/pitch DEO |
||||
;pop JSR2 POP2 |
||||
;draw-stack JSR2 |
||||
&continue |
||||
#01 ;draw-input JSR2 |
||||
;draw-bitpad JSR2 |
||||
|
||||
JMP2r |
||||
|
||||
@do-add ( -- ) |
||||
|
||||
.input/value LDZ2 #0000 EQU2 ,&no-push JCN |
||||
;do-push JSR2 |
||||
&no-push |
||||
|
||||
( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r |
||||
|
||||
#42 .Audio0/pitch DEO |
||||
#00 ;draw-modpad JSR2 |
||||
;pop JSR2 ;pop JSR2 SWP2 ADD2 ;push JSR2 |
||||
|
||||
JMP2r |
||||
|
||||
@do-sub ( -- ) |
||||
|
||||
.input/value LDZ2 #0000 EQU2 ,&no-push JCN |
||||
;do-push JSR2 |
||||
&no-push |
||||
|
||||
( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r |
||||
|
||||
#43 .Audio0/pitch DEO |
||||
#01 ;draw-modpad JSR2 |
||||
;pop JSR2 ;pop JSR2 SWP2 SUB2 ;push JSR2 |
||||
|
||||
JMP2r |
||||
|
||||
@do-mul ( -- ) |
||||
|
||||
.input/value LDZ2 #0000 EQU2 ,&no-push JCN |
||||
;do-push JSR2 |
||||
&no-push |
||||
|
||||
( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r |
||||
|
||||
#44 .Audio0/pitch DEO |
||||
#02 ;draw-modpad JSR2 |
||||
;pop JSR2 ;pop JSR2 SWP2 MUL2 ;push JSR2 |
||||
|
||||
JMP2r |
||||
|
||||
@do-div ( -- ) |
||||
|
||||
.input/value LDZ2 #0000 EQU2 ,&no-push JCN |
||||
;do-push JSR2 |
||||
&no-push |
||||
|
||||
( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r |
||||
|
||||
#45 .Audio0/pitch DEO |
||||
#03 ;draw-modpad JSR2 |
||||
;pop JSR2 ;pop JSR2 SWP2 DIV2 ;push JSR2 |
||||
|
||||
JMP2r |
||||
|
||||
@do-and ( -- ) |
||||
|
||||
.input/value LDZ2 #0000 EQU2 ,&no-push JCN |
||||
;do-push JSR2 |
||||
&no-push |
||||
|
||||
( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r |
||||
|
||||
#46 .Audio0/pitch DEO |
||||
#04 ;draw-modpad JSR2 |
||||
;pop JSR2 ;pop JSR2 SWP2 AND2 ;push JSR2 |
||||
|
||||
JMP2r |
||||
|
||||
@do-ora ( -- ) |
||||
|
||||
.input/value LDZ2 #0000 EQU2 ,&no-push JCN |
||||
;do-push JSR2 |
||||
&no-push |
||||
|
||||
( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r |
||||
|
||||
#47 .Audio0/pitch DEO |
||||
#05 ;draw-modpad JSR2 |
||||
;pop JSR2 ;pop JSR2 SWP2 ORA2 ;push JSR2 |
||||
|
||||
JMP2r |
||||
|
||||
@do-eor ( -- ) |
||||
|
||||
.input/value LDZ2 #0000 EQU2 ,&no-push JCN |
||||
;do-push JSR2 |
||||
&no-push |
||||
|
||||
( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r |
||||
|
||||
#48 .Audio0/pitch DEO |
||||
#06 ;draw-modpad JSR2 |
||||
;pop JSR2 ;pop JSR2 SWP2 EOR2 ;push JSR2 |
||||
|
||||
JMP2r |
||||
|
||||
@do-not ( -- ) |
||||
|
||||
.input/value LDZ2 #0000 EQU2 ,&no-push JCN |
||||
;do-push JSR2 |
||||
&no-push |
||||
|
||||
( stack empty ) .stack/length LDZ #00 GTH JMP JMP2r |
||||
|
||||
#49 .Audio0/pitch DEO |
||||
#07 ;draw-modpad JSR2 |
||||
;pop JSR2 #ffff EOR2 ;push JSR2 |
||||
|
||||
JMP2r |
||||
|
||||
@do-erase ( -- ) |
||||
|
||||
.input/value LDZ2 #04 SFT2 .input/value STZ2 |
||||
#ff ;draw-input JSR2 |
||||
;draw-bitpad JSR2 |
||||
|
||||
JMP2r |
||||
|
||||
@key-value ( key -- value ) |
||||
|
||||
DUP #2f GTH OVR #3a LTH #0101 NEQ2 ,&no-num JCN |
||||
#30 SUB JMP2r &no-num |
||||
DUP #60 GTH OVR #67 LTH #0101 NEQ2 ,&no-lc JCN |
||||
#57 SUB JMP2r ( #61 - #0a ADD ) &no-lc |
||||
DUP #40 GTH OVR #47 LTH #0101 NEQ2 ,&no-uc JCN |
||||
#37 SUB JMP2r ( #41 - #0a ADD ) &no-uc |
||||
POP #00 |
||||
|
||||
JMP2r |
||||
|
||||
@redraw ( -- ) |
||||
|
||||
#ff ;draw-keypad JSR2 |
||||
#ff ;draw-modpad JSR2 |
||||
#ff ;draw-input JSR2 |
||||
;draw-bitpad JSR2 |
||||
;draw-mode JSR2 |
||||
;draw-stack JSR2 |
||||
|
||||
#0010 .Screen/x DEO2 |
||||
#0010 .Screen/y DEO2 |
||||
|
||||
JMP2r |
||||
|
||||
@draw-mode ( -- ) |
||||
|
||||
#26 .Screen/auto DEO |
||||
.input-frame/x LDZ2 .Screen/x DEO2 |
||||
.input-frame/y LDZ2 #0014 SUB2 .Screen/y DEO2 |
||||
;modes #00 .input/mode LDZ #0018 MUL2 ADD2 .Screen/addr DEO2 |
||||
#02 .input/mode LDZ ADD .Screen/sprite DEO |
||||
#00 .Screen/auto DEO |
||||
|
||||
JMP2r |
||||
|
||||
@draw-stack ( -- ) |
||||
|
||||
#08 #00 |
||||
&loop |
||||
.input-frame/x LDZ2 #0018 ADD2 .Screen/x DEO2 |
||||
#00 OVR #30 SFT2 .input-frame/y LDZ2 ADD2 #004c SUB2 .Screen/y DEO2 |
||||
( color ) DUP #08 .stack/length LDZ SUB #01 SUB GTH STH |
||||
( value ) DUP DUP ADD .stack/items ADD [ #10 .stack/length LDZ DUP ADD SUB SUB ] LDZ2 |
||||
STHr ;draw-number JSR2 |
||||
INC GTHk ,&loop JCN |
||||
POP2 |
||||
|
||||
JMP2r |
||||
|
||||
@draw-input ( key -- ) |
||||
|
||||
STH |
||||
( draw value ) |
||||
.input-frame/x LDZ2 #0018 ADD2 .Screen/x DEO2 |
||||
.input-frame/y LDZ2 #0003 ADD2 .Screen/y DEO2 |
||||
.input/value LDZ2 #02 ;draw-number JSR2 |
||||
( controls ) |
||||
.input-frame/x LDZ2 |
||||
.input-frame/y LDZ2 |
||||
;stack-icns/push [ STHkr #00 EQU ] #02 |
||||
;draw-key-thin JSR2 |
||||
.input-frame/x LDZ2 #0008 ADD2 |
||||
.input-frame/y LDZ2 |
||||
;stack-icns/pop [ STHkr #01 EQU ] #03 |
||||
;draw-key-thin JSR2 |
||||
( line ) |
||||
.input-frame/x LDZ2 |
||||
.input-frame/x2 LDZ2 |
||||
.input-frame/y LDZ2 #0004 SUB2 #02 |
||||
;line-hor-dotted JSR2 |
||||
POPr |
||||
|
||||
JMP2r |
||||
|
||||
@draw-keypad ( key -- ) |
||||
|
||||
STH |
||||
#10 #00 |
||||
&loop |
||||
( color ) #00 OVR ;keypad/color ADD2 LDA STH |
||||
( state ) DUP OVRr STHr EQU STH |
||||
( layout ) #00 OVR ;keypad/layout ADD2 LDA |
||||
( layout addr ) #00 SWP #30 SFT2 ;font-hex ADD2 STH2 |
||||
( x ) #00 OVR #03 AND #40 SFT2 STH2 |
||||
( y ) #00 OVR #42 SFT2 |
||||
( origin-x ) STH2r .keypad-frame/x LDZ2 ADD2 SWP2 |
||||
( origin-y ) .keypad-frame/y LDZ2 ADD2 |
||||
STH2r STHr STHr ;draw-key JSR2 |
||||
INC GTHk ,&loop JCN |
||||
POP2 |
||||
POPr |
||||
|
||||
JMP2r |
||||
|
||||
@draw-modpad ( key -- ) |
||||
|
||||
STH |
||||
#08 #00 |
||||
&loop |
||||
( state ) DUP STHkr EQU STH |
||||
( glyph ) #00 OVR #30 SFT2 ;mod-icns ADD2 STH2 |
||||
( y ) #00 OVR #42 SFT2 .modpad-frame/y LDZ2 ADD2 STH2 |
||||
( x ) #00 OVR #03 AND #40 SFT2 .modpad-frame/x LDZ2 ADD2 |
||||
STH2r STH2r STHr #03 ;draw-key JSR2 |
||||
INC GTHk ,&loop JCN |
||||
POP2 |
||||
POPr |
||||
|
||||
JMP2r |
||||
|
||||
@draw-bitpad ( -- ) |
||||
|
||||
#1000 |
||||
&loop |
||||
( y ) #00 OVR #33 SFT2 .bitpad-frame/y LDZ2 ADD2 .Screen/y DEO2 |
||||
( x ) #00 OVR #07 AND #30 SFT2 .bitpad-frame/x LDZ2 ADD2 .Screen/x DEO2 |
||||
( state ) DUP #0f SWP SUB .input/value LDZ2 ROT SFT2 #0001 AND2 |
||||
( addr ) #30 SFT2 ;bit-icns ADD2 .Screen/addr DEO2 |
||||
#01 .Screen/sprite DEO |
||||
INC GTHk ,&loop JCN |
||||
POP2 |
||||
|
||||
JMP2r |
||||
|
||||
@draw-key ( x* y* glyph* state color -- ) |
||||
|
||||
STH2 |
||||
#16 .Screen/auto DEO |
||||
SWP2 .Screen/y DEO2 |
||||
SWP2 .Screen/x DEO2 |
||||
( bg ) |
||||
;button-icns [ #00 OVRr STHr #50 SFT2 ADD2 ] .Screen/addr DEO2 |
||||
STHkr .Screen/sprite DEOk DEO |
||||
( fg ) |
||||
.Screen/addr DEO2 |
||||
#00 .Screen/auto DEO |
||||
.Screen/y DEI2k #000d SUB2 ROT DEO2 |
||||
.Screen/x DEI2k #0004 ADD2 ROT DEO2 |
||||
STHr [ STHr #09 MUL ADD ] .Screen/sprite DEO |
||||
|
||||
JMP2r |
||||
|
||||
@draw-key-thin ( x* y* glyph* state color -- ) |
||||
|
||||
#06 .Screen/auto DEO |
||||
,&color STR ,&state STR ,&glyph STR2 |
||||
( frame ) |
||||
;button-thin-icns #00 [ LIT &state $1 ] #40 SFT2 ADD2 .Screen/addr DEO2 |
||||
.Screen/y DEO2 .Screen/x DEO2 |
||||
[ LIT &color $1 ] .Screen/sprite DEOk DEO |
||||
( glyph ) |
||||
[ LIT2 &glyph $2 ] .Screen/addr DEO2 |
||||
.Screen/y DEI2 #000c SUB2 .Screen/y DEO2 |
||||
#05 .Screen/sprite DEO |
||||
#00 .Screen/auto DEO |
||||
|
||||
JMP2r |
||||
|
||||
@draw-number ( number* color -- ) |
||||
|
||||
,&color STR |
||||
( reset zero pad ) |
||||
#00 ;&zero STA |
||||
( hexadecimal ) |
||||
.input/mode LDZ ,&decimal JCN |
||||
#01 .Screen/auto DEO |
||||
#00 ,&digit JSR |
||||
SWP ,&byte JSR |
||||
&byte |
||||
STHk #04 SFT ,&digit JSR |
||||
STHr #0f AND |
||||
&digit ( num -- ) |
||||
,&addr JSR .Screen/addr DEO2 |
||||
[ LIT &color $1 ] .Screen/sprite DEO |
||||
JMP2r |
||||
&decimal ( num* -- ) |
||||
#01 .Screen/auto DEO |
||||
#2710 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2 |
||||
#03e8 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2 |
||||
#0064 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2 NIP |
||||
#0a DIVk DUP ,&digit JSR MUL SUB |
||||
,&digit JSR |
||||
#00 .Screen/auto DEO |
||||
JMP2r |
||||
&addr ( num -- addr* ) |
||||
,&zero LDR ,&padded JCN |
||||
DUP ,&no-blank JCN |
||||
POP ;blank-icn JMP2r |
||||
&no-blank |
||||
DUP ,&zero STR |
||||
&padded #30 SFT #00 SWP ;font-hex ADD2 |
||||
|
||||
JMP2r |
||||
&zero $1 |
||||
|
||||
( theme ) |
||||
|
||||
@theme-txt ".theme $1 |
||||
|
||||
@load-theme ( -- ) |
||||
|
||||
;theme-txt .File/name DEO2 |
||||
#0006 .File/length DEO2 |
||||
#fffa .File/read DEO2 |
||||
|
||||
.File/success DEI2 #0006 NEQ2 ,&ignore JCN |
||||
#fffa LDA2 .System/r DEO2 |
||||
#fffc LDA2 .System/g DEO2 |
||||
#fffe LDA2 .System/b DEO2 |
||||
&ignore |
||||
;redraw JSR2 |
||||
|
||||
JMP2r |
||||
|
||||
@within-rect ( x* y* rect -- flag ) |
||||
|
||||
STH |
||||
( y < rect.y1 ) DUP2 STHkr INC INC LDZ2 LTH2 ,&skip JCN |
||||
( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ,&skip JCN |
||||
SWP2 |
||||
( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ,&skip JCN |
||||
( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ,&skip JCN |
||||
POP2 POP2 POPr |
||||
#01 |
||||
JMP2r |
||||
&skip POP2 POP2 POPr #00 JMP2r |
||||
|
||||
@line-hor-dotted ( x0* x1* y* color -- ) |
||||
|
||||
STH .Screen/y DEO2 |
||||
SWP2 |
||||
&loop |
||||
( save ) DUP2 .Screen/x DEO2 |
||||
( draw ) STHkr .Screen/pixel DEO |
||||
INC2 INC2 GTH2k ,&loop JCN |
||||
POP2 POP2 POPr |
||||
|
||||
JMP2r |
||||
|
||||
( assets ) |
||||
|
||||
@keypad |
||||
&layout |
||||
0708 090f 0405 060e 0102 030d 000a 0b0c |
||||
&series |
||||
0c08 090a 0405 0600 0102 0d0e 0f0b 0703 |
||||
&color |
||||
0101 0102 0101 0102 0101 0102 0102 0202 |
||||
&ops |
||||
:do-add :do-sub :do-mul :do-div |
||||
:do-and :do-ora :do-eor :do-not |
||||
|
||||
@sin-pcm |
||||
8083 8689 8c8f 9295 989b 9ea1 a4a7 aaad |
||||
b0b3 b6b9 bbbe c1c3 c6c9 cbce d0d2 d5d7 |
||||
d9db dee0 e2e4 e6e7 e9eb ecee f0f1 f2f4 |
||||
f5f6 f7f8 f9fa fbfb fcfd fdfe fefe fefe |
||||
fffe fefe fefe fdfd fcfb fbfa f9f8 f7f6 |
||||
f5f4 f2f1 f0ee eceb e9e7 e6e4 e2e0 dedb |
||||
d9d7 d5d2 d0ce cbc9 c6c3 c1be bbb9 b6b3 |
||||
b0ad aaa7 a4a1 9e9b 9895 928f 8c89 8683 |
||||
807d 7a77 7471 6e6b 6865 625f 5c59 5653 |
||||
504d 4a47 4542 3f3d 3a37 3532 302e 2b29 |
||||
2725 2220 1e1c 1a19 1715 1412 100f 0e0c |
||||
0b0a 0908 0706 0505 0403 0302 0202 0202 |
||||
0102 0202 0202 0303 0405 0506 0708 090a |
||||
0b0c 0e0f 1012 1415 1719 1a1c 1e20 2225 |
||||
2729 2b2e 3032 3537 3a3d 3f42 4547 4a4d |
||||
5053 5659 5c5f 6265 686b 6e71 7477 7a7d |
||||
|
||||
@font-hex |
||||
007c 8282 8282 827c 0030 1010 1010 1010 |
||||
007c 8202 7c80 80fe 007c 8202 1c02 827c |
||||
000c 1424 4484 fe04 00fe 8080 7c02 827c |
||||
007c 8280 fc82 827c 00fe 0202 0408 1010 |
||||
007c 8282 7c82 827c 007c 8282 7e02 827c |
||||
007c 8202 7e82 827e 00fc 8282 fc82 82fc |
||||
007c 8280 8080 827c 00fc 8282 8282 82fc |
||||
00fe 8080 fe80 80fe 00fe 8080 f080 8080 |
||||
|
||||
@modes |
||||
( hex ) |
||||
0082 8282 fe82 8282 |
||||
00fe 8080 fe80 80fe |
||||
0082 4428 1028 4482 |
||||
( dec ) |
||||
00fc 8282 8282 82fc |
||||
00fe 8080 fe80 80fe |
||||
007c 8280 8080 827c |
||||
|
||||
@mod-icns |
||||
0010 1010 fe10 1010 |
||||
0000 0000 fe00 0000 |
||||
0082 4428 1028 4482 |
||||
0002 0408 1020 4080 |
||||
0070 8888 728a 847a |
||||
0010 1010 1010 1010 |
||||
0000 1028 4482 0000 |
||||
0000 0060 920c 0000 |
||||
|
||||
@button-icns |
||||
( outline ) |
||||
3f40 8080 8080 8080 |
||||
f804 0202 0202 0202 |
||||
8080 8080 8040 3f00 |
||||
0202 0202 0204 f800 |
||||
( full ) |
||||
3f7f ffff ffff ffff |
||||
f8fc fefe fefe fefe |
||||
ffff ffff ff7f 3f00 |
||||
fefe fefe fefc f800 |
||||
|
||||
@button-thin-icns |
||||
( outline ) |
||||
3844 8282 8282 8282 |
||||
8282 8282 8244 3800 |
||||
( full ) |
||||
387c fefe fefe fefe |
||||
fefe fefe fe7c 3800 |
||||
|
||||
@bit-icns |
||||
( outline ) |
||||
3844 8282 8244 3800 |
||||
( full ) |
||||
387c fefe fe7c 3800 |
||||
|
||||
@stack-icns |
||||
&push |
||||
0000 1028 1000 0000 |
||||
&pop |
||||
0000 2810 2800 0000 |
||||
|
||||
@pointer-icn |
||||
80c0 e0f0 f8e0 1000 |
||||
|
||||
@blank-icn |
||||
Loading…
Reference in new issue