( 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 ,¬-end JCN POP2 POP2 &error POP2 POP2 POP2 JMP2r ¬-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 ,¬-newline JCN ;asma/line LDA2 #0001 ADD2 ;asma/line STA2 ¬-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 ¯os $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 ,¬-empty JCN POP2 JMP2r ¬-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 ,¬-found JCN ( tree-offset* token-routine-ptr* / end* ) STH2r ;asma/token STA2 SWP2 POP2 LDA2 JMP2 ( tail call ) ¬-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 ,¬-end JCN POP POP2 STH2r ROT #01 ADD #03 MUL JMP2r ¬-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 ,¬-end JCN POP2 STHr JMP2r ¬-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 ,¬-found JCN ;asma-opcodes/_disasm SUB2 #0003 SFT2 ( 00 byte / end* ) &loop DUP2r LDAr STHr LIT2r 0001 ADD2r ( 00 byte char / end* ) DUP ,¬-end JCN POP POP2r SWP JMP2r ¬-end DUP LIT '2 NEQ ,¬-two JCN POP asma-SHORT-FLAG ORA ,&loop JMP ¬-two DUP LIT 'r NEQ ,¬-return JCN POP asma-RETURN-FLAG ORA ,&loop JMP ¬-return LIT 'k NEQ ,¬-keep JCN asma-KEEP-FLAG ORA ,&loop JMP ¬-keep ( 00 byte / end* ) ¬-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 ,¬-end JCN ( end of C strings, match found ) POP2r POP JMP2r ¬-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 ,¬-exist JCN POP2 ;asma-msg-macro ;asma/error STA2 JMP2r ¬-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 ,¬-end JCN POP POP2 JMP2r ¬-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 ,¬-zero-page JCN JMP2r ¬-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 ,¬-local JCN #0001 ADD2 ;asma/token STA2 ;asma/scope-addr LDA2 ;asma-trees/scope LDA2 ,&final-lookup JMP ¬-local ( token* ) DUP2 LDA DUP ,¬-end JCN POP POP2 #0000 ;asma-trees/labels ,&final-lookup JMP ¬-end ( token* char ) #2f EQU ,&found-slash JCN #0001 ADD2 ,¬-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 ,¬-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 ,¬-found JCN LDA2 ADD2 JMP2r ¬-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 ,¬-opcode JCN ;asma-write-byte JMP2 ( tail call ) ¬-opcode ;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 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 ,¯o-loop JMP ¬-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 ¬e :&channel $2 "note 00 0003 &_entry :¬e :&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 >H $2 $2 "GTH 00 <H $2 $2 "LTH 00 &JMP $2 $2 "JMP 00 &JCN :>H :&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 :<H :&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