( cat input.tal | uxncli drifloon.rom > output.rom ) |00 @System &vector $2 &expansion $2 &wst $1 &rst $1 &metadata $2 &r $2 &g $2 &b $2 &debug $1 &state $1 |10 @Console &vector $2 &read $1 &pad $4 &type $1 &write $1 &error $1 |00 @RefType &ab $1 &as $1 &rb $1 &rs $1 |00 @SymType $40 &used $40 &declared |000 @token/buf $2f &cap $1 @scope/buf $2f &cap $1 |100 @on-reset ( -> ) ;meta #06 DEO2 ;dict/reset scope/ ;on-console .Console/vector DEO2 BRK @on-console ( -> ) .Console/read DEI token/ [ LIT2 04 -Console/type ] DEI EQU ?{ BRK } refs/ .System/state DEI ?{ rom/ } BRK @rom/ ( -- ) ( +length ) [ LIT2 &length $2 ] ( +labels ) syms/ ;dict/assembled ;rom/length LDA2 #00ff SUB2 ;dict/bytes ( -labels ) ;dict/labels ( | output ) ( -length ) ;rom/mem SWP2 ADD2 ;rom/output &>l ( -- ) LDAk #18 DEO INC2 GTH2k ?&>l POP2 POP2 ( | success ) [ LIT2 80 -System/state ] DEO JMP2r @runes/db [ "| =lib/padabs "$ =lib/padrel "@ =lib/toplab "& =lib/sublab "% =lib/macros "( =lib/coment ", =lib/litrel "_ =lib/rawrel ". =lib/litzep "- =lib/rawzep "; =lib/litabs "= =lib/rawabs "? =lib/litjci "! =lib/litjmi "# =lib/lithex "" =lib/rawstr 5b =lib/ignore 5d =lib/ignore "} =lib/lambda ] &db-end @meta $1 ( name ) "Drifloon 0a ( desc ) "Uxntal 20 "Assembler 0a ( auth ) "By 20 "Devine 20 "Lu 20 "Linvega 0a ( date ) "18 20 "Jan 20 "2025 $2 ( Core ) @ ( adj* name* -- ) [ LIT2 &ref $2 ] #0003 ADD2 ! @ ( adj* name* -- ) ;token/buf ( >> ) @ ( adj* name* keyword* -- ) SWP2 #2019 DEO SWP2 [ LIT2 ": 19 ] DEO #2019 DEO ;dict/in / ;scope/buf / #0a19 DEO [ LIT2 01 -System/state ] DEO JMP2r ( @|Buffers ) @token/ ( -- ) [ LIT2 -&buf _&ptr ] STR [ LIT2 00 -&buf ] STZ JMP2r @token/ ( c -- ) DUP #20 GTH ?{ POP ;&buf LDZk ?{ POP2 JMP2r } [ LIT2 &mode =asm-default ] JSR2 !& } ( | append ) [ LIT2 00 &ptr -&buf ] ( overflow ) DUP .&cap EQU ?{ INCk ,&ptr STR } STZ2 JMP2r @scope/ ( c -- ) [ LIT2 00 &ptr -&buf ] INCk ,&ptr STR ( overflow ) DUP .&cap LTH ?{ ;dict/exceeded ;dict/Symbol ;&buf } STZ2 JMP2r @scope/ ( str* -- ) [ LIT2 -&buf _&ptr ] STR &>w ( -- ) LDAk [ LIT "/ ] EQU ?{ LDAk / INC2 LDAk ?&>w } POP2 ,&ptr LDR ,&anchor STR JMP2r @scope/make-name ( name* -- scope/label* ) [ LIT2 &anchor $1 _&ptr ] STR [ LIT "/ ] / &>wl ( -- ) LDAk / INC2 LDAk ?&>wl POP2 ;&buf JMP2r ( @|Assembly ) @ ( -- ) ;asm-default ;token/mode STA2 JMP2r @asm-default ( t* -- ) LDZk runes/find INC2k ORA ?{ POP2 ( hex ) is-hex ?rom/ ( opc ) opcodes/find INC ?rom/ ( mac ) DUP2 macros/find INC2k ORA ?rom/ ( imm ) POP2 !lib/litjsi } INC2 LDA2 JMP2 @ ( -- ) ;asm-comment ;token/mode STA2 [ LIT2 01 _asm-comment/depth ] STR JMP2r @asm-comment ( t* -- ) [ LITr &depth $1 ] LDA2 DUP2 ( | nested comments ) [ LIT2 ") 00 ] NEQ2 ?{ LITr 01 SUBr } [ LIT2 "( 00 ] NEQ2 ?{ INCr } STHkr [ LITr _&depth ] STRr ?{ ! } JMP2r @ ( -- ) ;asm-macro ;token/mode STA2 [ LIT2 00 _asm-macro/depth ] STR JMP2r @asm-macro ( t* -- ) [ LITr &depth $1 ] LDAk ( | nested lambdas ) [ LIT "} ] NEQ ?{ [ LITr 01 ] SUBr STHkr ?{ #00 macros/ POP2 POPr ! } } STHkr #00 EQU ?{ ;token/buf macros/ } LDA [ LIT "{ ] NEQ ?{ INCr } [ LITr _&depth ] STRr JMP2r @lib ( runics ) &padabs INC2 refs/get-any !rom/ &padrel INC2 refs/get-any !rom/ &toplab INC2 DUP2 scope/ !syms/ &sublab INC2 scope/make-name !syms/ &litrel #80 rom/ &rawrel INC2 refs/get-rb !rom/ &litzep #80 rom/ &rawzep INC2 refs/get-ab !rom/ &litabs #a0 rom/ &rawabs INC2 refs/get-as !rom/ &litjci INC2 #20 !rom/ &litjmi INC2 #40 !rom/ &litjsi #60 !rom/ &lithex INC2 !rom/ &rawstr INC2 !rom/ &lambda POP2 !lambda/pop &coment POP2 ! ¯os INC2 macros/ ! &ignore POP2 JMP2r ( @|Lambda ) @lambda/make-name ( -- name* ) [ LIT &count $1 ] INCk ,&count STR DUP [ LIT2 &ptr =&mem ] INC2k ,&ptr STR2 STA ( >> ) @lambda/name ( id -- str* ) hexs ,&id STR2 ;&sym JMP2r @lambda/pop ( -- ) ,&ptr LDR2 #0001 SUB2 LDAk /name syms/ ,&ptr STR2 JMP2r &sym cebb &id 0000 $1 ( @|Macros ) @macros/find ( name* -- * ) STH2 ,&ptr LDR2 ;&mem &>l ( -- ) DUP2 STH2kr wcmp ?{ scap/ GTH2k ?&>l POP2 #ffff } NIP2 POP2r JMP2r @macros/ ( t* -- ) LDAk / INC2 LDAk ?& POP2 #20 ( >> ) @macros/ ( byte -- ) [ LIT2 &ptr =&mem ] INC2k ,&ptr STR2 STA ( | check overflow ) ,&ptr LDR2 ;&mem-end LTH2 ?{ ( ! ) ;dict/exceeded ;dict/Macros ! } JMP2r ( @|Syms ) @syms/find ( name* -- * ) STH2 ;&ptr LDA2 ;&mem &>l ( -- ) DUP2 #0003 ADD2 STH2kr wcmp ?{ #0003 ADD2 scap/ GTH2k ?&>l POP2 #ffff } NIP2 POP2r JMP2r @syms/find-alloc ( name* -- * ) DUP2 /find INC2k ORA ?{ ( null* -> ptr* ) POP2 ,&ptr LDR2 ( alloc ) OVR2 .SymType/used #ffff / } NIP2 JMP2r @syms/ ( name* -- ) DUP2 macros/find INC2 ORA ?&duplicate DUP2 /find INC2k ORA ?{ ( alloc ) POP2 .SymType/declared rom/get-head !/ } ( | name* sym* -- ) INC2k INC2 LDA .SymType/declared AND ?{ ( addr* ) rom/get-head OVR2 STA2 ( type ) INC2 INC2 LDAk .SymType/declared ORA ROT ROT STA ( name* ) POP2 JMP2r } POP2 &duplicate ( name* -- ) POP2 ( ! ) ;dict/duplicate ;dict/Symbol ! @syms/ ( name* type addr* -- ) ( hb ) SWP / ( lb ) / ( type ) / is-hex ?&invalid ( is runic ) LDAk runes/find INC2 ORA ?&invalid ( is opcode ) opcodes/find INC ?&invalid ( >> ) @syms/ ( word* -- ) LDAk / INC2 LDAk ?& POP2 #00 ( >> ) @syms/ ( byte -- ) [ LIT2 &ptr =&mem ] INC2k ,&ptr STR2 STA ( | check overflow ) ,&ptr LDR2 ;&mem-end LTH2 ?{ ( ! ) ;dict/exceeded ;dict/Symbols ! } JMP2r @syms/invalid ( name* -- ) / ( ! ) ;dict/invalid ;dict/Symbol ! @syms/ ( -- ) [ LIT2r ffff ] ;&ptr LDA2 ;&mem &>ls ( -- ) ( used ) INC2k INC2 LDA .SymType/used AND ?{ ( upper ) DUP2 #0003 ADD2 LDAk [ LIT "A ] SUB #1a LTH ?{ ;dict/unused DUP2 / #0a19 DEO } POP2 } INC2r #0003 ADD2 scap/ GTH2k ?&>ls POP2 POP2 STH2r JMP2r ( @|References ) @refs/get-any ( str* -- value* ) is-hex ?shex !/get-ref @refs/get-type ( token* type -- addr* ) ,&type STR ( >> ) @refs/get-ref ( token* -- addr* ) LDA2k [ LIT2 "{ 00 ] NEQ2 ?{ POP2 lambda/make-name } LDAk [ LIT "/ ] NEQ ?{ INC2 scope/make-name } LDAk [ LIT "& ] NEQ ?{ INC2 scope/make-name } ( | find symbol or create it ) syms/find-alloc ( | check if declared ) INC2k INC2 STH2k LDA .SymType/declared AND ?{ STH2k [ LIT &type $1 ] STH2r rom/get-head ( addr* ) refs/ ( value* ) refs/ ( type ) refs/ } ( | mark as used ) LDAkr STHr .SymType/used ORA STH2r STA LDA2 JMP2r @refs/ ( -- ) SWP / ( >> ) @refs/ ( byte -- ) [ LIT2 &ptr =&mem ] INC2k ,&ptr STR2 DUP2 ;&mem-end LTH2 ?{ ( ! ) ;dict/exceeded ;dict/References ! } STA JMP2r @refs/ ( -- ) ,&ptr LDR2 ;&mem &>l ( -- ) INC2k INC2 LDA2 ;/ref STA2 .System/state DEI ?{ / #0005 ADD2 GTH2k ?&>l } POP2 POP2 JMP2r @refs/ ( addr* -- addr* ) DUP2 DUP2 #0004 ADD2 LDA ( | handlers ) DUP .RefType/ab EQU ?/ DUP .RefType/as EQU ?/ DUP .RefType/rb EQU ?/ DUP .RefType/rs EQU ?/ POP JMP2r @refs/ ( ref* type -- ) POP /resolve-abs STA POP JMP2r @refs/ ( ref* type -- ) POP /resolve-abs STA2 JMP2r @refs/ ( ref* type -- ) POP /resolve-rel STA2 JMP2r @refs/ ( ref* type -- ) POP /resolve-rel ( | validate distance ) OVR2 #0080 ADD2 POP #00 EQU ?{ ( ! ) ;dict/too-far ;dict/Reference } STA POP JMP2r @refs/resolve-sym ( ref* -- ref* addr* ) ( sym* ) INC2k INC2 LDA2 ( sym/addr* ) LDA2k INC2k ORA ?{ ( ! ) ;dict/invalid ;dict/Reference } ( | sym* addr* ) NIP2 JMP2r @refs/resolve-abs ( ref* -- value* addr* ) ( value* ) /resolve-sym !/resolve @refs/resolve-rel ( ref* -- value* addr* ) ( value* ) /resolve-sym OVR2 LDA2 /get-distance ( >> ) @refs/resolve ( ref* -- value* addr* ) ( addr* ) SWP2 LDA2 ;rom/mem ADD2 JMP2r @refs/get-ab ( label* -- addr ) .RefType/ab /get-type NIP JMP2r @refs/get-as ( label* -- addr* ) .RefType/as !/get-type @refs/get-rb ( label* -- distance ) .RefType/rb /get-type INC2k ORA ?{ ( undefined ) POP2 #00 JMP2r } rom/get-head /get-distance ( | check distance ) DUP2 #0080 ADD2 POP ?{ NIP JMP2r } NIP ( ! ) ;dict/too-far ;dict/Reference ! @refs/get-rs ( label* -- distance* ) .RefType/rs /get-type rom/get-head ( >> ) @refs/get-distance ( addr* -- distance* ) ( ) INC2 INC2 SUB2 JMP2r ( @|Rom ) @rom/get-head ( -- addr* ) [ LIT2 &head 0100 ] JMP2r @rom/ ( addr* -- ) rom/get-head ADD2 ( >> ) @rom/ ( addr* -- ) ,&head STR2 JMP2r @rom/ ( t* macro* -- ) token/ &>wcap ( name* -- body* ) INC2 LDAk #20 GTH ?&>wcap INC2 &>body ( body* -- cap* ) LDAk token/ INC2 LDAk ?&>body NIP2 LDA !token/ @rom/ ( str* -- ) LDAk / INC2 LDAk ?& POP2 JMP2r @rom/ ( str* -- ) opcodes/find #63 SWP SUB #03 DIV #1f AND STH LDA2k [ LIT2 "LI ] EQU2 #70 SFT STH ORAr #0003 ADD2 &>w ( -- ) LDAk #21 LTH ?{ LDAk [ LIT "k ] NEQ ?{ LITr 80 ORAr !&r } LDAk [ LIT "r ] NEQ ?{ LITr 40 ORAr !&r } LDAk [ LIT "2 ] NEQ ?{ LITr 20 ORAr !&r } ( ! ) ;dict/invalid ;dict/Opcode &r INC2 !&>w } POP2 STHr !& @rom/ ( str* -- ) zlen ( LIT ) DUP #04 EQU #50 SFT #80 ORA / !& @rom/ ( str* -- ) zlen ( >> ) @rom/ ( str* len -- ) DUP #02 NEQ ?{ POP shex NIP !& } #04 NEQ ?{ shex !& } POP2 ( ! ) ;dict/invalid ;dict/Number ! @rom/ ( str* opc -- ) / refs/get-rs ( >> ) @rom/ ( short* -- ) SWP / ( >> ) @rom/ ( byte -- ) DUP /get-head INC2k / ;&mem ADD2 STA ( not zero ) ?{ JMP2r } /get-head ( ) OVR ?{ ( ! ) ;dict/invalid ;dict/Writing } ( ) DUP2 #8000 LTH2 ?{ ( ! ) ;dict/exceeded ;dict/File } ;&length STA2 JMP2r ( @|Stdlib ) @is-hex ( str* -- str* f ) DUP2 &>w ( -- ) chex INC ?{ POP2 #00 JMP2r } INC2 LDAk ?&>w POP2 #01 JMP2r @shex ( str* -- value* ) [ LIT2r 0000 ] &>w ( `i* -- ) ( acc ) [ LITr 40 ] SFT2r ( res ) chex [ LITr 00 ] STH ADD2r INC2 LDAk ?&>w POP2 STH2r JMP2r @hexs ( hex -- char char ) DUP #04 SFT hexc SWP ( >> ) @hexc ( hex -- char ) #0f AND #0a LTHk ?{ SUB [ LIT "a ] ADD JMP2r } POP [ LIT "0 ] ADD JMP2r @chex ( str* c -- str* ) LDAk [ LIT "0 ] SUB DUP #0a LTH ?{ #27 SUB DUP #10 LTH ?{ POP #ff } } JMP2r @scap ( str* -- end* ) INC2 & LDAk ?scap INC2 JMP2r @zlen ( ztr -- ztr len ) DUP [ LITr 00 ] &>w ( -- ) INCr INC LDZk ?&>w POP STHr JMP2r @wcmp ( a* b* -- f ) STH2 &>l ( a* `b* -- f ) LDAk #21 LTH ?{ LDAk LDAkr STHr NEQ ?{ INC2 INC2r !&>l } } LDA #21 LTH LDAr STHr #21 LTH AND JMP2r @ ( str* -- ) LDAk #19 DEO INC2 & LDAk ? POP2 JMP2r @ ( short* -- ) [ LIT2r ff00 ] &>read ( -- ) #000a DIV2k STH2k MUL2 SUB2 STH2r INCr ORAk ?&>read POP2 &>write ( -- ) NIP #30 ADD #19 DEO OVRr ADDr STHkr ?&>write POP2r JMP2r ( @|Assets ) @opcodes/find ( str* -- str* ) LDA2k ,&xxo STR2 INC2k INC2 LDA ,&oox STR ;&db-end ;&db &>l ( -- ) LDA2k [ LIT2 &xxo $2 ] NEQ2 ?{ INC2k INC2 LDA [ LIT &oox $1 ] NEQ ?{ SUB2 NIP JMP2r } } #0003 ADD2 GTH2k ?&>l POP2 POP2 #ff JMP2r @opcodes/db [ "LIT "INC "POP "NIP "SWP "ROT "DUP "OVR "EQU "NEQ "GTH "LTH "JMP "JCN "JSR "STH "LDZ "STZ "LDR "STR "LDA "STA "DEI "DEO "ADD "SUB "MUL "DIV "AND "ORA "EOR "SFT "BRK ] &db-end @runes/find ( char -- * ) STH ;&db-end ;&db &>l ( -- ) LDAk STHkr EQU ?{ #0003 ADD2 GTH2k ?&>l POP2 #ffff } NIP2 POPr JMP2r @dict &assembled "Assembled 20 $1 &in 20 "in 20 $1 &bytes 20 "bytes( $1 &labels 20 "labels). 0a $1 &unused "-- 20 "Unused: 20 $1 &reset "RESET $1 &File "File $1 &Symbol "Symbol $1 &Reference "Reference $1 &Opcode "Opcode $1 &Number "Number $1 &Writing "Writing $1 &Macros "Macros $1 &Symbols "Symbols $1 &References "References $1 &exceeded "exceeded $1 &invalid "invalid $1 &duplicate "duplicate $1 &too-far "too 20 "far $1 ( @|Buffers ) @lambda/mem $100 @refs/mem ( addr*, symbol*, RefType ) $1800 &mem-end @syms/mem ( addr*, SymType, body..00 ) $4800 &mem-end @macros/mem ( name..20, value..00 ) $1000 &mem-end @rom/mem ( zeropage ) $100 &output