etc/uxn
0
0
Fork 0
mirror of https://git.sr.ht/~rabbits/uxn synced 2024-11-27 00:03:00 +00:00
Code Issues Projects Releases Wiki Activity
uxn/projects/software/asma.usm
Andrew Alderwick 3109ca3bdd Added keep mode parsing to asma
2021-05-13 08:02:15 +01:00

758 lines
20 KiB
Text
Raw Blame History

( devices )
|10 @Console [ &pad $8 &char $1 &byte $1 &short $2 &string $2 ]
|a0 @File [ &vector $2 &success $2 &offset $2 &pad $2 &name $2 &length $2 &load $2 &save $2 ]
( vectors )
|0100
%asma-IF-ERROR { ;asma/error LDA2 ORA }
@reset
;asma-init-assembler JSR2
;&filename ,asma-assemble-file-pass JSR
asma-IF-ERROR ,asma-print-error JCN
;asma-init-assembler-pass JSR2
;&filename ,asma-assemble-file-pass JSR
asma-IF-ERROR ,asma-print-error JCN
BRK
&filename
( "test.usm 00 )
"projects/demos/piano.usm 00
@asma-print-error ( -- )
;asma/error LDA2 .Console/string DEO2
#3a .Console/char DEO
#20 .Console/char DEO
;asma/orig-token LDA2 .Console/string DEO2
;&line .Console/string DEO2
;asma/line LDA2 .Console/short DEO2
#2e .Console/char DEO
#0a .Console/char DEO
BRK
&line 20 "on 20 "line 20 00
@asma-assemble-file-pass ( filename-ptr* -- )
#0000
&loop
OVR2 .File/name DEO2
DUP2 .File/offset DEO2
#0100 .File/length DEO2
#fe00 DUP2 DUP2 .File/load DEO2
.File/success DEI2 DUP2 ORA ,&not-end JCN
POP2 POP2
&error
POP2 POP2 POP2
JMP2r
&not-end
,asma-assemble-chunk JSR asma-IF-ERROR ,&error JCN
SUB2 SUB2
,&loop JMP
@asma-init-assembler ( -- )
#ff ;asma/pass STA
#0000 ;asma/error STA2
;asma-heap ;asma/heap STA2
;asma-labels/_entry ;asma-trees/labels STA2
( FIXME should walk the label tree and remove any in the heap )
;asma-opcodes/_entry ;asma-trees/opcodes STA2
#0000 ;asma-trees/macros STA2
@asma-init-assembler-pass ( -- )
;asma/pass LDA #01 ADD ;asma/pass STA
#00 ;asma/state STA
#0000 ;asma/addr STA2
#0001 ;asma/line STA2
JMP2r
@asma-assemble-chunk ( ptr* len* -- assembled-up-to-ptr* )
OVR2 ADD2 #0001 SUB2 SWP2 DUP2 STH2
,&loop JMP
&next-char-pop
POP
&next-char
#0001 ADD2
&loop ( last-ptr* ptr* / start-of-token* )
OVR2 OVR2 LTH2 ,&end JCN
DUP2 LDA ( last-ptr* ptr* char / start-of-token* )
DUP #20 GTH ,&next-char-pop JCN
#00 OVR2 ( last-ptr* ptr* char 00 ptr* / start-of-token* )
STA
STH2r ,asma-assemble-token JSR asma-IF-ERROR ,&error JCN
#0a NEQ ,&not-newline JCN
;asma/line LDA2 #0001 ADD2 ;asma/line STA2
&not-newline
DUP2 #0001 ADD2 STH2 ,&next-char JMP
&end
POP2 POP2 STH2r
JMP2r
&error
POP POP2 POP2
JMP2r
@asma [ &pass $1 &state $1 &line $2 &token $2 &orig-token $2 &heap $2 &addr $2 &scope-addr $2 &error $2 ]
@asma-trees [ &labels $2 &macros $2 &opcodes $2 &scope $2 ]
@asma-assemble-token ( string-ptr* -- )
DUP2 .Console/string DEO2 #0a .Console/char DEO
DUP2 ;asma/token STA2
DUP2 ;asma/orig-token STA2
DUP2 LDA ,&not-empty JCN
POP2
JMP2r
&not-empty ( token* / )
( truncate to one char long )
#0001 ADD2 ( end* / )
DUP2 STH2 DUP2r LDAr ( end* / end* char )
DUP2 STH2 ( end* / end* char end* )
LITr 00 STH2 ( / end* char end* 00 end* )
STAr ( / end* char end* )
( find lowest set bit of assembler/state
in C, this would be i & -i )
#00 ;asma/state LDA DUP2 SUB AND ( tree-offset* / end* )
DUP2 ;&first-char-trees ADD2 ( tree-offset* incoming-ptr* / end* )
;asma-traverse-tree JSR2
( restore truncated char )
STAr
,&not-found JCN
( tree-offset* token-routine-ptr* / end* )
STH2r ;asma/token STA2
SWP2 POP2 LDA2
JMP2 ( tail call )
&not-found ( tree-offset* dummy* / end* )
POP2 POP2r
;&first-char-dispatch ADD2 LDA2
JMP2 ( tail call )
&first-char-trees
:asma-first-char-normal/_entry
:asma-first-char-comment/_entry
:asma-first-char-macro/_entry
&first-char-dispatch
: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 ( -- value* 06 if valid hex and length > 2
OR value* 03 if valid hex and length <= 2
OR 00 otherwise )
;asma/token LDA2 DUP2 ,asma-strlen JSR #02 GTH ROT ROT
LIT2r 0000
&loop
DUP2 LDA
DUP ,&not-end JCN
POP POP2
STH2r ROT #01 ADD #03 MUL
JMP2r
&not-end
,asma-parse-hex-digit JSR
DUP #f0 AND ,&fail JCN
LIT2r 0010 MUL2r
#00 STH STH ADD2r
#0001 ADD2
,&loop JMP
&fail
POP POP2 POP2r
DUP EOR
JMP2r
@asma-strlen ( string-ptr* -- length )
LITr 00
&loop
DUP2 LDA
,&not-end JCN
POP2 STHr
JMP2r
&not-end
LITr 01 ADDr
#0001 ADD2
,&loop JMP
%asma-SHORT-FLAG { #20 }
%asma-RETURN-FLAG { #40 }
%asma-KEEP-FLAG { #80 }
@asma-parse-opcode ( -- byte 00 if valid opcode
OR 01 otherwise )
;asma/token LDA2
DUP2 ,asma-strlen JSR #03 LTH ,&too-short JCN
( truncate to three chars long )
#0003 ADD2 ( end* / )
DUP2 STH2 DUP2r LDAr ( end* / end* char )
DUP2 STH2 ( end* / end* char end* )
LITr 00 STH2 ( / end* char end* 00 end* )
STAr ( / end* char end* )
;asma-trees/opcodes ;asma-traverse-tree JSR2
STAr
,&not-found JCN
;asma-opcodes/_disasm SUB2 #0003 SFT2 ( 00 byte / end* )
&loop
DUP2r LDAr STHr LIT2r 0001 ADD2r ( 00 byte char / end* )
DUP ,&not-end JCN
POP POP2r
SWP
JMP2r
&not-end
DUP LIT '2 NEQ ,&not-two JCN
POP asma-SHORT-FLAG ORA ,&loop JMP
&not-two
DUP LIT 'r NEQ ,&not-return JCN
POP asma-RETURN-FLAG ORA ,&loop JMP
&not-return
LIT 'k NEQ ,&not-keep JCN
asma-KEEP-FLAG ORA ,&loop JMP
&not-keep ( 00 byte / end* )
&not-found ( incoming-ptr* / end* )
POP2r
&too-short ( token* / )
POP2 #01
JMP2r
@asma-write-byte ( byte -- )
#3e .Console/char DEO
#20 .Console/char DEO
.Console/byte DEO ( FIXME actually write! )
#0a .Console/char DEO
;asma/addr LDA2 #0001 ADD2 ;asma/addr STA2
JMP2r
@asma-write-short ( short -- )
SWP
,asma-write-byte JSR
,asma-write-byte JMP ( tail call )
@asma-append-heap-byte ( dummy byte -- dummy )
;asma/heap LDA2
OVR2 OVR2 STA POP
#0001 ADD2 ;asma/heap STA2
POP
JMP2r
@asma-append-heap-short ( dummy short* -- dummy )
SWP
,asma-append-heap-byte JSR
,asma-append-heap-byte JMP ( tail call )
@asma-append-heap-string ( string* -- )
DUP2 LDA
DUP ,asma-append-heap-byte JSR
,&keep-going JCN
POP2 JMP2r
&keep-going
#0001 ADD2
,asma-append-heap-string JMP
@asma-traverse-tree ( incoming-ptr* -- binary-ptr* 00 if key found
OR node-incoming-ptr* 01 if key not found )
( ;&help-str .Console/string DEO2
DUP2 .Console/short DEO2
#20 .Console/char DEO
;asma/token LDA2 .Console/string DEO2
#20 .Console/char DEO
;asma/orig-token LDA2 .Console/string DEO2
#0a .Console/char DEO )
&loop ( incoming-ptr* )
DUP2 LDA2 ORA ,&valid-node JCN
#01 JMP2r
&valid-node
LDA2 DUP2 STH2
#0004 ADD2 ,asma-strcmp-tree JSR
DUP ,&nomatch JCN
POP2r JMP2r
&nomatch
#06 SFT #02 AND #00 SWP
STH2r ADD2
,&loop JMP
( &help-str "Looking 20 "up 20 00 )
@asma-strcmp-tree ( node-key* -- order if strings differ
OR after-node-key* 00 if strings match )
;asma/token LDA2 STH2
&loop ( node-key* / token* )
DUP2 #0001 ADD2 SWP2 LDA DUP2r LDAr STHr
DUP2 ORA ,&not-end JCN
( end of C strings, match found )
POP2r POP
JMP2r
&not-end
SUB
DUP ,&nomatch JCN
POP
LIT2r 0001 ADD2r
,&loop JMP
&nomatch
POP2r ROT ROT POP2
JMP2r
( actions based on first character )
%asma-STATE-SET { ;asma/state LDA ORA ;asma/state STA }
%asma-STATE-CLEAR { #ff EOR ;asma/state LDA AND ;asma/state STA }
@asma-comment-start
#02 asma-STATE-SET
@asma-ignore
JMP2r
@asma-comment-end
#02 asma-STATE-CLEAR
JMP2r
@asma-macro-define
;asma/pass LDA ,&ignore-macro JCN
;asma-trees/macros ;asma-traverse-tree JSR2 ,&not-exist JCN
POP2
;asma-msg-macro ;asma/error STA2
JMP2r
&not-exist
( define macro by creating new node )
;asma/heap LDA2 SWP2 STA2
#0000 ;asma-append-heap-short JSR2 ( less-than pointer )
#0000 ;asma-append-heap-short JSR2 ( greater-than pointer )
;asma/token LDA2 ;asma-append-heap-string JSR2 ( key )
#04 asma-STATE-SET
JMP2r
&ignore-macro
#0c asma-STATE-SET
JMP2r
@asma-macro-body
;asma/token LDA2 ;asma-append-heap-string JSR2
JMP2r
@asma-macro-end
#00 ;asma-append-heap-byte JSR2
#0c asma-STATE-CLEAR
JMP2r
@asma-label-define
#0000 ;asma/scope-addr STA2
;asma-trees/labels ,asma-label-helper JSR
,&already-existed JCN
#0000 ;asma-append-heap-short JSR2 ( data2: subtree incoming ptr )
&already-existed
;asma/addr LDA2 ;asma/scope-addr STA2
#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* 00 if label existed already
OR binary-ptr* 01 if label was created )
;asma-traverse-tree JSR2
,&new-label JCN
( label already exists )
( FIXME check label address )
#01 JMP2r
&new-label ( incoming-ptr* )
( define label by creating new node )
;asma/heap LDA2 SWP2 STA2
#0000 ;asma-append-heap-short JSR2 ( less-than pointer )
#0000 ;asma-append-heap-short JSR2 ( greater-than pointer )
;asma/token LDA2 ;asma-append-heap-string JSR2 ( key )
;asma/heap LDA2
;asma/addr LDA2 ;asma/scope-addr LDA2 SUB2
;asma-append-heap-short JSR2 ( data1: address )
#00 JMP2r
@asma-pad-absolute
#0000 ,asma-pad-helper JMP
@asma-pad-relative
;asma/addr LDA2
( fall through )
@asma-pad-helper ( offset* -- )
;asma-parse-hex-string JSR2
,&valid JCN
;asma-msg-hex ;asma/error STZ2
JMP2r
&valid
( FIXME complain if rewind after writing nonzeroes )
ADD2 ;asma/addr STA2
JMP2r
@asma-raw-char
;asma/token LDA2 LDA
;asma-write-byte JMP2 ( tail call )
@asma-raw-word
;asma/token LDA2
&loop
DUP2 LDA
DUP ,&not-end JCN
POP POP2
JMP2r
&not-end
;asma-write-byte JSR2
#0001 ADD2
,&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
,asma-addr-helper JSR
;asma-write-byte JSR2
,&not-zero-page JCN
JMP2r
&not-zero-page
;asma-msg-zero-page ;asma/error STA2
JMP2r
@asma-literal-rel-addr
LIT LIT ;asma-write-byte JSR2
,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 DUP2 LDA #26 NEQ ,&not-local JCN
#0001 ADD2 ;asma/token STA2
;asma/scope-addr LDA2 ;asma-trees/scope LDA2
,&final-lookup JMP
&not-local ( token* )
DUP2 LDA
DUP ,&not-end JCN
POP POP2
#0000 ;asma-trees/labels
,&final-lookup JMP
&not-end ( token* char )
#2f EQU ,&found-slash JCN
#0001 ADD2
,&not-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 ,&not-found JCN
( token* binary-ptr* )
#0001 ADD2 ;asma/token STA2
DUP2 LDA2 SWP2 #0002 ADD2
&final-lookup ( addr-offset* incoming-ptr* )
;asma-traverse-tree JSR2 ,&not-found JCN
LDA2 ADD2
JMP2r
&not-found ( dummy* dummy* )
;asma/pass LDA #00 EQU ,&ignore-error JCN
;asma-msg-label ;asma/error STA2
&ignore-error
POP2 POP2
;asma/addr LDA2
JMP2r
@asma-literal-hex
;asma-parse-hex-string JSR2 JMP
( hex invalid ) ,&invalid JMP
( hex byte ) ,asma-byte-helper JMP
( hex short ) ,asma-short-helper JMP
&invalid
POP2
;asma-msg-hex ;asma/error STA2
JMP2r
@asma-byte-helper ( dummy value -- )
LIT LIT ;asma-write-byte JSR2
&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 ,&not-opcode JCN
;asma-write-byte JMP2 ( tail call )
&not-opcode
;asma-parse-hex-string JSR2 JMP
( hex invalid ) ,&not-hex JMP
( hex byte ) ,asma-byte-helper/raw JMP
( hex short ) ,asma-short-helper/raw JMP
&not-hex
;asma-trees/macros ;asma-traverse-tree JSR2 ,&not-macro JCN
&macro-loop
DUP2 LDA ,&keep-going JCN
&error
POP2
JMP2r
&keep-going
DUP2 DUP2 ;asma-strlen JSR2 #00 SWP #0001 ADD2 ADD2
SWP2 ;asma-assemble-token JSR2 asma-IF-ERROR ,&error JCN
,&macro-loop JMP
&not-macro
POP2
;asma-msg-label ;asma/error STA2
JMP2r
( 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
( trees )
( --- 8< ------- 8< --- cut here --- 8< ------- 8< --- )
( automatically generated code below )
( see etc/asma.moon for instructions )
( label less than greater than key data )
@asma-first-char-comment
&_entry $2 $2 ') 00 :asma-comment-end
@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
&22 $2 $2 '" 00 :asma-raw-word
&23 :&22 $2 '# 00 :asma-literal-hex
&24 :&23 :&25 '$ 00 :asma-pad-relative
&25 $2 $2 '% 00 :asma-macro-define
&26 :&24 :&29 26 00 ( & ) :asma-sublabel-define
&27 $2 $2 '' 00 :asma-raw-char
&28 :&27 $2 '( 00 :asma-comment-start
&29 :&28 :&2c ') 00 :asma-comment-end
&2c $2 $2 ', 00 :asma-literal-rel-addr
&_entry :&26 :&5d '. 00 :asma-literal-zero-addr
&3a $2 $2 ': 00 :asma-abs-addr
&3b :&3a $2 '; 00 :asma-literal-abs-addr
&40 :&3b :&5b '@ 00 :asma-label-define
&5b $2 $2 '[ 00 :asma-ignore
&5d :&40 :&7c '] 00 :asma-ignore
&7b $2 $2 '{ 00 :asma-ignore
&7c :&7b :&7d '| 00 :asma-pad-absolute
&7d $2 $2 '} 00 :asma-ignore
@asma-labels
&Audio0 $2 $2 "Audio0 00 0030 :asma-ldev-Audio/_entry
&Audio1 :&Audio0 :&Audio2 "Audio1 00 0040 :asma-ldev-Audio/_entry
&Audio2 $2 $2 "Audio2 00 0050 :asma-ldev-Audio/_entry
&Audio3 :&Audio1 :&Controller "Audio3 00 0060 :asma-ldev-Audio/_entry
&Console $2 $2 "Console 00 0010 :asma-ldev-Console/_entry
&Controller :&Console $2 "Controller 00 0080 :asma-ldev-Controller/_entry
&_entry :&Audio3 :&Mouse "DateTime 00 00b0 :asma-ldev-DateTime/_entry
&File $2 $2 "File 00 00a0 :asma-ldev-File/_entry
&Midi :&File $2 "Midi 00 0070 :asma-ldev-Midi/_entry
&Mouse :&Midi :&System "Mouse 00 0090 :asma-ldev-Mouse/_entry
&Screen $2 $2 "Screen 00 0020 :asma-ldev-Screen/_entry
&System :&Screen $2 "System 00 0000 :asma-ldev-System/_entry
@asma-ldev-Audio
&addr $2 $2 "addr 00 000c
&adsr :&addr $2 "adsr 00 0008
&length :&adsr :&output "length 00 000a
&output $2 $2 "output 00 0004
&_entry :&length :&vector "pitch 00 000f
&position $2 $2 "position 00 0002
&vector :&position :&volume "vector 00 0000
&volume $2 $2 "volume 00 000e
@asma-ldev-Console
&byte $2 $2 "byte 00 0009
&char :&byte $2 "char 00 0008
&_entry :&char :&string "short 00 000a
&string $2 $2 "string 00 000c
@asma-ldev-Controller
&button $2 $2 "button 00 0002
&_entry :&button :&vector "key 00 0003
&vector $2 $2 "vector 00 0000
@asma-ldev-DateTime
&day $2 $2 "day 00 0003
&dotw :&day $2 "dotw 00 0007
&doty :&dotw :&hour "doty 00 0008
&hour $2 $2 "hour 00 0004
&_entry :&doty :&second "isdst 00 000a
&minute $2 $2 "minute 00 0005
&month :&minute $2 "month 00 0002
&second :&month :&year "second 00 0006
&year $2 $2 "year 00 0000
@asma-ldev-File
&length $2 $2 "length 00 000a
&load :&length :&name "load 00 000c
&name $2 $2 "name 00 0008
&_entry :&load :&success "offset 00 0004
&save $2 $2 "save 00 000e
&success :&save :&vector "success 00 0002
&vector $2 $2 "vector 00 0000
@asma-ldev-Midi
&channel $2 $2 "channel 00 0002
&note :&channel $2 "note 00 0003
&_entry :&note :&velocity "vector 00 0000
&velocity $2 $2 "velocity 00 0004
@asma-ldev-Mouse
&chord $2 $2 "chord 00 0007
&state :&chord $2 "state 00 0006
&_entry :&state :&y "vector 00 0000
&x $2 $2 "x 00 0002
&y :&x $2 "y 00 0004
@asma-ldev-Screen
&addr $2 $2 "addr 00 000c
&color :&addr :&height "color 00 000e
&height $2 $2 "height 00 0004
&_entry :&color :&x "vector 00 0000
&width $2 $2 "width 00 0002
&x :&width :&y "x 00 0008
&y $2 $2 "y 00 000a
@asma-ldev-System
&b $2 $2 "b 00 000c
&g :&b :&r "g 00 000a
&r $2 $2 "r 00 0008
&_entry :&g :&wst "rst 00 0003
&vector $2 $2 "vector 00 0000
&wst :&vector $2 "wst 00 0002
@asma-opcodes
&BRK :&AND :&DEI &_disasm "BRK 00
&_entry :&EQU :&ROT "LIT 00
&NOP :&MUL :&OVR "NOP 00
&POP $2 $2 "POP 00
&DUP :&DIV :&EOR "DUP 00
&SWP $2 $2 "SWP 00
&OVR :&ORA :&POP "OVR 00
&ROT :&NOP :&STR "ROT 00
&EQU :&DEO :&JSR "EQU 00
&NEQ $2 $2 "NEQ 00
&GTH $2 $2 "GTH 00
&LTH $2 $2 "LTH 00
&JMP $2 $2 "JMP 00
&JCN :&GTH :&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 $2 $2 "DEI 00
&DEO :&BRK :&DUP "DEO 00
&ADD $2 $2 "ADD 00
&SUB :&STZ :&SWP "SUB 00
&MUL :&LTH :&NEQ "MUL 00
&DIV $2 $2 "DIV 00
&AND :&ADD $2 "AND 00
&ORA $2 $2 "ORA 00
&EOR $2 $2 "EOR 00
&SFT $2 $2 "SFT 00
@asma-heap
Reference in a new issue View git blame Copy permalink