mirror of
https://git.sr.ht/~rabbits/uxn
synced 2024-11-12 17:25:05 +00:00
910 lines
26 KiB
Text
910 lines
26 KiB
Text
( asma: in-Uxn assembler (not working yet, in progress) )
|
|
|
|
%HCF { #0000 DIV }
|
|
%SHORT_FLAG { #20 }
|
|
%RETURN_FLAG { #40 }
|
|
|
|
( devices )
|
|
|
|
|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
|
|
|10 @Console [ &vector $2 &pad $6 &char $1 &byte $1 &short $2 &string $2 ]
|
|
|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &color $1 ]
|
|
|30 @Audio [ &wave $2 &envelope $2 &pad $4 &volume $1 &pitch $1 &play $1 &value $2 &delay $2 &finish $1 ]
|
|
|40 @Controller [ &vector $2 &button $1 &key $1 ]
|
|
|60 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &chord $1 ]
|
|
|70 @File [ &vector $2 &success $2 &offset $2 &pad $2 &name $2 &length $2 &load $2 &save $2 ]
|
|
|a0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
|
|
|
|
( variables )
|
|
|
|
|0000
|
|
|
|
@tree [ &search-key $2 &max-key-len $1 ]
|
|
@assembler [ &pass $1 &state $1 &token $2 &scope-len $1 &scope $80 &heap $2 &addr $2 &subtree $2 &field_size $2 &var_size $2 &field $2 ]
|
|
|
|
( vectors )
|
|
|
|
|0100 ,RESET JMP
|
|
|
|
@RESET
|
|
;assembler-heap-start .assembler/heap POK2
|
|
|
|
;&read-filename ,assemble-file JSR
|
|
HCF
|
|
|
|
HCF
|
|
|
|
&read-filename [ "projects/software/noodle.usm 00 ]
|
|
|
|
@assemble-file ( filename-ptr* -- )
|
|
#0000
|
|
|
|
&loop
|
|
OVR2 .File/name DEO2
|
|
DUP2 .File/offset DEO2
|
|
#0600 .File/length DEO2
|
|
#f000 DUP2 DUP2 .File/load DEO2
|
|
.File/success DEI2 DUP2 #0000 EQU2 ,&end JNZ
|
|
,assemble-chunk JSR
|
|
SUB2 SUB2
|
|
,&loop JMP
|
|
|
|
&end
|
|
POP2 POP2 POP2 POP2 POP2
|
|
JMP2r
|
|
|
|
@assemble-chunk ( ptr* len* -- assembled-up-to-ptr* )
|
|
( FIXME we still return on seeing 00 in source code,
|
|
while assemble-file is now binary safe )
|
|
OVR2 ADD2 STH2
|
|
#0001 SUB2
|
|
|
|
&per-token
|
|
DUP2 STH2
|
|
|
|
&loop
|
|
#0001 ADD2
|
|
DUP2 GET
|
|
#20 GTH ,&loop JNZ
|
|
|
|
DUP2 OVR2r STH2r LTS2 ,&valid JNZ
|
|
SWP2r POP2r POP2
|
|
STH2r #0001 ADD2
|
|
JMP2r
|
|
|
|
&valid
|
|
DUP2 GET #00 OVR2 PUT
|
|
STH2r #0001 ADD2 ,assemble-token JSR
|
|
,&per-token JNZ
|
|
|
|
POP2r JMP2r
|
|
|
|
@assemble-macro ( macro-ptr* -- )
|
|
DUP2 ;strlen JSR2 DUP2 #0000 EQU2 ,&end JNZ
|
|
OVR2 ,assemble-token JSR
|
|
ADD2 #0001 ADD2
|
|
,assemble-macro JMP
|
|
|
|
&end
|
|
POP2 POP2
|
|
JMP2r
|
|
|
|
@assemble-token ( string-ptr* -- )
|
|
( get location of tree )
|
|
DUP2
|
|
;state-machine-pointers #00 .assembler/state PEK ;highest-bit JSR2 #0004 MUL2 ADD2
|
|
DUP2 STH2
|
|
( see if first char is recognised )
|
|
SWP2 #01 ;traverse-tree JSR2
|
|
,¬-found JNZ
|
|
( skip first character of token )
|
|
SWP2 #0001 ADD2 .assembler/token POK2
|
|
( tail call handling function defined in tree )
|
|
POP2r JMP2
|
|
|
|
¬-found
|
|
( not interested in incoming-ptr )
|
|
POP2
|
|
.assembler/token POK2
|
|
( tail call default handling function defined in state-machine-pointers )
|
|
LIT2r [ 0002 ] ADD2r GET2r
|
|
JMP2r
|
|
|
|
@parse-hex-length ( string-ptr* -- value 01 if one or two hex digits
|
|
OR 00 otherwise )
|
|
DUP2 #0001 ADD2 GET ,parse-hex-string/try-two JNZ
|
|
GET ,parse-hex-digit JSR DUP #04 SFT ,parse-hex-string/fail1 JNZ
|
|
#01 JMP2r
|
|
|
|
@parse-hex-string ( string-ptr* -- value* 02 if four hex digits
|
|
OR value 01 if two hex digits
|
|
OR 00 otherwise )
|
|
DUP2 #0004 ADD2 GET #00 EQU ,&try-four JNZ
|
|
&try-two
|
|
DUP2 #0002 ADD2 GET ,&fail2 JNZ
|
|
&known-two
|
|
DUP2 GET ,parse-hex-digit JSR DUP #04 SFT ,&fail3 JNZ ROT ROT
|
|
#0001 ADD2 GET ,parse-hex-digit JSR DUP #04 SFT ,&fail2 JNZ
|
|
SWP #40 SFT ORA #01 JMP2r
|
|
|
|
&fail3 POP
|
|
&fail2 POP
|
|
&fail1 POP #00 JMP2r
|
|
|
|
&try-four
|
|
DUP2 #0002 ADD2 ,&known-two JSR ,&maybe-four JNZ
|
|
,&try-two JMP
|
|
|
|
&maybe-four
|
|
ROT ROT ,&known-two JSR ,&four JNZ
|
|
,&fail1 JMP
|
|
|
|
&four
|
|
SWP #02 JMP2r
|
|
|
|
@parse-hex-digit ( charcode -- 00-0f if valid hex
|
|
-- 10-ff otherwise )
|
|
DUP #3a LTH ,&digit JNZ
|
|
DUP #60 GTH ,&lowercase JNZ
|
|
DUP #40 GTH ,&uppercase JNZ
|
|
JMP2r
|
|
|
|
&digit ( #30 is #00 )
|
|
#30 SUB JMP2r
|
|
|
|
&lowercase ( #61 is #0a )
|
|
#57 SUB JMP2r
|
|
|
|
&uppercase ( #41 is #0a )
|
|
#37 SUB JMP2r
|
|
|
|
@find-opcode ( name* -- byte 00 if valid opcode name
|
|
OR 01 if not found )
|
|
;opcodes/tree SWP2 #03 ,traverse-tree JSR
|
|
,&nomatch JNZ
|
|
;opcodes/asm SUB2 #0007 DIV2
|
|
SWP JMP2r
|
|
|
|
&nomatch
|
|
DUP2 EQU2 JMP2r
|
|
|
|
@traverse-tree ( tree-ptr* search-key* max-key-len --
|
|
binary-ptr* 00 if key matched
|
|
OR incoming-ptr* 01 if key not found )
|
|
.tree/max-key-len POK .tree/search-key POK2
|
|
|
|
&loop
|
|
DUP2 GET2 #0000 NEQ2 ,&valid-node JNZ
|
|
#01 JMP2r
|
|
|
|
&valid-node
|
|
GET2 DUP2 STH2 #0004 ADD2 ,strcmp-tree JSR
|
|
DUP ,&nomatch JNZ
|
|
POP2r JMP2r
|
|
|
|
&nomatch
|
|
#07 SFT #02 MUL #00 SWP
|
|
STH2r ADD2
|
|
,&loop JMP
|
|
|
|
@strcmp-tree ( node-key* -- order if strings differ
|
|
OR after-node-key* 00 if strings match )
|
|
.tree/search-key PEK2 STH2
|
|
.tree/max-key-len PEK
|
|
|
|
&loop ( node-key* key-len in wst, search-key* in rst )
|
|
DUP ,&keep-going JNZ
|
|
|
|
( exhausted key-len, match found )
|
|
POP2r
|
|
JMP2r
|
|
|
|
&keep-going
|
|
#01 OVR2 GET DUP2r GETr STHr
|
|
DUP2 ORA ,¬-end JNZ
|
|
|
|
( end of C strings, match found )
|
|
POP2r POP ROT POP SWP ADD2 #00
|
|
JMP2r
|
|
|
|
¬-end
|
|
SUB DUP ,&nomatch JNZ
|
|
POP SUB
|
|
LIT2r [ 0001 ] ADD2r STH
|
|
LIT2 [ 0001 ] ADD2 STHr
|
|
,&loop JMP
|
|
|
|
&nomatch
|
|
STH POP2 POP2 STHr POP2r
|
|
JMP2r
|
|
|
|
@highest-bit ( n -- 00 if n is 00
|
|
OR 01 if n is 01
|
|
OR 02 if n is 02..03
|
|
OR 03 if n is 04..07
|
|
OR 04 if n is 08..0f
|
|
..
|
|
OR 08 if n is 80..ff )
|
|
DUP #00 NEQ JMP JMP2r
|
|
DUP #01 SFT ORA
|
|
DUP #02 SFT ORA
|
|
DUP #04 SFT ORA
|
|
#1d MUL #05 SFT #00 SWP ;&lookup ADD2 GET
|
|
JMP2r
|
|
|
|
&lookup
|
|
[ 01 06 02 07 05 04 03 08 ]
|
|
|
|
@memcpy ( src-ptr* dest-ptr* length* -- after-dest-ptr* )
|
|
SWP2 STH2
|
|
|
|
&loop
|
|
DUP2 ORA ,&keep-going JNZ
|
|
POP2 POP2 STH2r
|
|
JMP2r
|
|
|
|
&keep-going
|
|
#0001 SUB2
|
|
SWP2 DUP2 GET DUP2r STH2r PUT
|
|
#0001 ADD2 SWP2
|
|
LIT2r [ 0001 ] ADD2r
|
|
,&loop JMP
|
|
|
|
@strcpy ( src-ptr* dest-ptr* -- after-dest-ptr* )
|
|
OVR2 ,strlen JSR #0001 ADD2 ,memcpy JMP
|
|
|
|
@strlen ( string-ptr* -- length* )
|
|
DUP2 #0001 SUB2
|
|
&loop
|
|
#0001 ADD2
|
|
DUP2 GET ,&loop JNZ
|
|
SWP2 SUB2
|
|
JMP2r
|
|
|
|
@append-heap ( string-ptr* -- after-string-ptr* )
|
|
.assembler/heap PEK2 ;strcpy JSR2
|
|
DUP2 .assembler/heap POK2
|
|
JMP2r
|
|
|
|
@append-tree ( string-ptr* incoming-ptr* -- binary-data* )
|
|
.assembler/heap PEK2 SWP2 PUT2
|
|
;&zero-pointers .assembler/heap PEK2 #0004 ,memcpy JSR .assembler/heap POK2
|
|
,append-heap JSR
|
|
JMP2r
|
|
|
|
&zero-pointers [ 0000 0000 ]
|
|
|
|
@add-label ( label-flags string-ptr* tree-ptr* -- )
|
|
OVR2 #ff ;traverse-tree JSR2
|
|
,&new-label JNZ
|
|
|
|
( label already exists, check the flags and addr value )
|
|
SWP2 POP2
|
|
DUP2 #0001 ADD2 GET2 .assembler/addr PEK2 EQU2 ,&addr-okay JNZ
|
|
( FIXME address is different to previous run, or label defined twice )
|
|
&addr-okay
|
|
GET EQU ,&type-okay JNZ
|
|
( FIXME node type is different to before )
|
|
&type-okay
|
|
JMP2r
|
|
|
|
&new-label
|
|
,append-tree JSR
|
|
(
|
|
~assembler.heap SWP2 STR2
|
|
,$zero-pointers ~assembler.heap #0004 ^memcpy JSR =assembler.heap
|
|
~assembler.heap ,strcpy JSR2
|
|
)
|
|
|
|
DUP2 STH2 PUT STH2r
|
|
DUP2 #0001 ADD2 .assembler/addr PEK2 SWP2 PUT2
|
|
#0003 ADD2 .assembler/heap POK2
|
|
JMP2r
|
|
|
|
@lookup-label ( string-ptr* -- address* node-type if found
|
|
OR false-address* 00 if not found )
|
|
DUP2
|
|
&loop
|
|
DUP2 #0001 ADD2 SWP2 GET
|
|
DUP #2e EQU ,&dotted JNZ
|
|
,&loop JNZ
|
|
DUP2 EOR2 ( faster than POP2 #0000 )
|
|
.assembler/field POK2
|
|
|
|
&main
|
|
DUP2 ;label-tree SWP2 #ff ;traverse-tree JSR2
|
|
,¬-found JNZ
|
|
|
|
SWP2 POP2
|
|
.assembler/field PEK2 #0000 EQU2 ,&end JNZ
|
|
DUP2 GET #80 LTH ,¬-found JNZ
|
|
#0003 ADD2 .assembler/field PEK2 #ff ;traverse-tree JSR2
|
|
,¬-found JNZ
|
|
|
|
&end
|
|
DUP2 #0001 ADD2 GET2 SWP2 GET
|
|
JMP2r
|
|
|
|
¬-found
|
|
POP2
|
|
( FIXME complain about missing label )
|
|
POP2
|
|
( false-address is out of reach for JMP )
|
|
.assembler/addr PEK2 #8765 ADD2
|
|
#00
|
|
JMP2r
|
|
|
|
&dotted
|
|
DUP OVR2 .assembler/field POK2
|
|
EOR ROT ROT #0001 SUB2 PUT
|
|
,&main JMP
|
|
|
|
@write-byte ( byte -- )
|
|
( FIXME ) .Console/byte DEO
|
|
.assembler/addr PEK2 #0001 ADD2 .assembler/addr POK2
|
|
JMP2r
|
|
|
|
@write-short ( short -- )
|
|
( FIXME ) .Console/short DEO2
|
|
.assembler/addr PEK2 #0002 ADD2 .assembler/addr POK2
|
|
JMP2r
|
|
|
|
@label-tree :l-root
|
|
@macro-tree [ 0000 ]
|
|
|
|
@opcodes
|
|
(
|
|
The code for this section is automatically generated, and needs to be
|
|
regenerated when the opcode list in src/assembler.c is updated.
|
|
|
|
After editing src/assembler.c, run "lua etc/assembler-trees.lua"
|
|
and this file will be edited automatically.
|
|
|
|
This is the first example of a binary tree in this code, so let's
|
|
explore them in general. The format of a tree node in memory is:
|
|
|
|
left-node* right-node* node-key-cstring binary-data
|
|
|
|
and the general algorithm is to compare the key you're looking for
|
|
against node-key-cstring, and move to the node pointed to by left-node*
|
|
or right-node* if the keys don't match. If your key sorts earlier than
|
|
use left-node*, otherwise go to right-node*. When you find a node that
|
|
matches your key, traverse-bintree gives you a pointer to the
|
|
binary-data straight after the node-key-cstring. This data can contain
|
|
anything you want: fixed length fields, executable code... in this case
|
|
of this opcode tree, we store nothing. traverse-bintree is passed the
|
|
maximum length of node-key-cstring, not including the zero, so the zero
|
|
can be omitted if the string is at that maximum length.
|
|
|
|
If the key isn't present in the tree, you'll eventually get to a node
|
|
where the left-node* or right-node* pointer you'll need to follow is
|
|
null (0000). traverse-bintree will give you the location of that
|
|
pointer, so if you want to insert another node, you can write it to the
|
|
heap and overwrite the pointer with the new node's location. This
|
|
approach works even if the tree is completely empty and the pointer
|
|
you've provided to the root node is null, since that pointer gets
|
|
updated to point to the first node without needing any special logic.
|
|
|
|
The ordering of nodes in memory is totally arbitrary, so for pre-
|
|
prepared trees like this one we can have our own meaning for the order
|
|
of the nodes. By ordering the opcodes by their byte value, we can find
|
|
the byte by subtracting $asm from the binary-data pointer and dividing
|
|
by seven (the size of each node). By multiplying the byte value by seven
|
|
and adding to $disasm, we get the opcode name when disassembling too.
|
|
)
|
|
|
|
&tree :&op-lth ( opcode tree )
|
|
&start
|
|
&op-brk :&op-add :&op-dup &disasm [ "BRK ] &asm
|
|
&op-nop :&op-mul :&op-ovr [ "NOP ]
|
|
&op-lit [ 0000 ] [ 0000 ] [ "LIT ]
|
|
&op-pop [ 0000 ] [ 0000 ] [ "POP ]
|
|
&op-dup :&op-div :&op-eor [ "DUP ]
|
|
&op-swp [ 0000 ] [ 0000 ] [ "SWP ]
|
|
&op-ovr :&op-ora :&op-pek [ "OVR ]
|
|
&op-rot :&op-pop :&op-sft [ "ROT ]
|
|
&op-equ :&op-brk :&op-jnz [ "EQU ]
|
|
&op-neq [ 0000 ] [ 0000 ] [ "NEQ ]
|
|
&op-gth [ 0000 ] [ 0000 ] [ "GTH ]
|
|
&op-lth :&op-equ :&op-pok [ "LTH ]
|
|
&op-gts :&op-gth :&op-jmp [ "GTS ]
|
|
&op-lts [ 0000 ] [ 0000 ] [ "LTS ]
|
|
[ 0000 ] [ 0000 ] [ "??? ]
|
|
[ 0000 ] [ 0000 ] [ "??? ]
|
|
&op-pek [ 0000 ] [ 0000 ] [ "PEK ]
|
|
&op-pok :&op-nop :&op-sth [ "POK ]
|
|
&op-ldr :&op-jsr :&op-lit [ "LDR ]
|
|
&op-str [ 0000 ] [ 0000 ] [ "STR ]
|
|
&op-jmp [ 0000 ] [ 0000 ] [ "JMP ]
|
|
&op-jnz :&op-gts :&op-ldr [ "JNZ ]
|
|
&op-jsr [ 0000 ] [ 0000 ] [ "JSR ]
|
|
&op-sth :&op-rot :&op-sub [ "STH ]
|
|
&op-add [ 0000 ] :&op-and [ ADD ]
|
|
&op-sub :&op-str :&op-swp [ "SUB ]
|
|
&op-mul :&op-lts :&op-neq [ "MUL ]
|
|
&op-div [ 0000 ] [ 0000 ] [ "DIV ]
|
|
&op-and [ 0000 ] [ 0000 ] [ "AND ]
|
|
&op-ora [ 0000 ] [ 0000 ] [ "ORA ]
|
|
&op-eor [ 0000 ] [ 0000 ] [ "EOR ]
|
|
&op-sft [ 0000 ] [ 0000 ] [ "SFT ]
|
|
|
|
@state-machine-pointers
|
|
( normal mode 00 )
|
|
:normal-root :normal-main
|
|
( macro definition 01 )
|
|
:macro-root :macro-main
|
|
( macro definition, contents ignored 02 )
|
|
:macro-root :ignore
|
|
( variable definition, expect field size 04 )
|
|
:variable-nul :variable-size
|
|
( variable definition, expect field name 08 )
|
|
:variable-root :variable-name
|
|
( reserved for future use 10 )
|
|
[ 0000 ] :ignore
|
|
( literal data 20 )
|
|
:normal-5d :data-main
|
|
( reserved for future use 40 )
|
|
[ 0000 ] :ignore
|
|
( comment 80 )
|
|
:normal-29 :ignore
|
|
|
|
(
|
|
Next up, we have the tree of code corresponding to each token's
|
|
first character. Here we do have a binary payload, which is
|
|
the code to run when the assembler considers the token.
|
|
|
|
Some special assembler modes have their own trees. Since comments
|
|
have a very simple tree that only understands the end of comments,
|
|
we reuse the terminal branch of the main tree as the root of
|
|
the comment tree.
|
|
)
|
|
|
|
|
|
(
|
|
Left and right parentheses start and end comment sections. They use the
|
|
highest bit in assembler state, so they receive highest priority: it
|
|
doesn't matter what other bits are set, a comment's a comment.
|
|
)
|
|
|
|
|
|
@normal-28 [ 0000 ] :normal-29 [ 28 ]
|
|
.assembler/state PEK #80 ORA .assembler/state POK
|
|
JMP2r
|
|
|
|
@normal-29 [ 0000 ] [ 0000 ] [ 29 ]
|
|
.assembler/state PEK #7f AND .assembler/state POK
|
|
JMP2r
|
|
|
|
(
|
|
Ampersands introduce global labels, and define the scope for any
|
|
local labels that follow.
|
|
)
|
|
|
|
|
|
@normal-@ [ 0000 ] [ 0000 ] [ 40 ]
|
|
#00 .assembler/token PEK2 ;label-tree ;add-label JSR2
|
|
|
|
&scope
|
|
.assembler/token PEK2 ;assembler/scope ;strcpy JSR2
|
|
DUP2 ;assembler/scope SUB2 .assembler/scope-len POK POP
|
|
#0001 SUB2 #2d SWP POK POP
|
|
JMP2r
|
|
|
|
(
|
|
Dollar signs introduce local labels, which use the scope defined above.
|
|
)
|
|
|
|
|
|
@normal-24 :normal-" :normal-, [ 24 ]
|
|
.assembler/token PEK2
|
|
;assembler/scope .assembler/scope-len PEK ADD
|
|
;strcpy JSR2 POP2
|
|
|
|
#00 ;assembler/scope ;label-tree ;add-label JMP2 ( tail call )
|
|
|
|
(
|
|
Hash signs followed by two or four hex digits write a literal.
|
|
)
|
|
|
|
|
|
@normal-# [ 0000 ] [ 0000 ] [ 23 ]
|
|
.assembler/token PEK2 ;parse-hex-string JSR2
|
|
DUP ,&valid JNZ
|
|
( FIXME complain about invalid hex literal )
|
|
POP
|
|
JMP2r
|
|
|
|
&valid
|
|
DUP #01 SUB SHORT_FLAG MUL ( short flag for opcode )
|
|
;opcodes/op-lit ;opcodes/start SUB2 #07 DIV
|
|
ADD ADD ;write-byte JSR2
|
|
|
|
&value
|
|
#02 EQU ,&short JNZ
|
|
;write-byte JMP2 ( tail call )
|
|
|
|
&short
|
|
;write-short JMP2 ( tail call )
|
|
|
|
(
|
|
Left and right square brackets start and end literal data sections.
|
|
)
|
|
|
|
|
|
@normal-5b :normal-@ :normal-5d [ 5b ]
|
|
.assembler/state PEK #20 ORA .assembler/state POK
|
|
JMP2r
|
|
|
|
@normal-5d [ 0000 ] [ 0000 ] [ 5d ]
|
|
.assembler/state PEK #df AND .assembler/state POK
|
|
JMP2r
|
|
|
|
@data-] :normal-28 [ 0000 ] [ 5d ]
|
|
.assembler/state PEK #df AND .assembler/state POK
|
|
JMP2r
|
|
|
|
@data-root
|
|
@data-nul [ 0000 ] :data-] [ 00 ]
|
|
JMP2r
|
|
|
|
@data-main
|
|
.assembler/token PEK2 ;parse-hex-string JSR2
|
|
DUP ,normal-#/value JNZ
|
|
POP
|
|
|
|
.assembler/token PEK2
|
|
&loop
|
|
DUP2 GET
|
|
DUP ,&keep-going JNZ
|
|
POP POP2 JMP2r
|
|
|
|
&keep-going
|
|
;write-byte JSR2
|
|
#0001 ADD2
|
|
,&loop JMP
|
|
|
|
(
|
|
A pipe moves the current address to the hex value given.
|
|
)
|
|
|
|
|
|
@normal-| :normal-{ :normal-} [ 7c ]
|
|
.assembler/token PEK2 ;parse-hex-string JSR2
|
|
DUP #02 EQU ,&valid JNZ
|
|
#00 EQU JMP POP
|
|
( FIXME complain about invalid hex literal )
|
|
JMP2r
|
|
|
|
&valid
|
|
POP
|
|
DUP2 .assembler/addr PEK2 LTH2 ,&backwards JNZ
|
|
( FIXME add zeroes when writing )
|
|
.assembler/addr POK2
|
|
JMP2r
|
|
|
|
&backwards
|
|
( FIXME complain about going backwards )
|
|
POP2
|
|
JMP2r
|
|
|
|
(
|
|
Commas and dots write the label address - the comma precedes this
|
|
with a LIT2 opcode.
|
|
)
|
|
|
|
|
|
@normal-, :normal-% :normal-dot [ 2c ]
|
|
;opcodes/op-lit ;opcodes/start SUB2 #07 DIV SHORT_FLAG ADD ;write-byte JSR2 POP
|
|
,normal-dot/main JMP
|
|
|
|
@normal-dot [ 0000 ] :normal-; [ 2e ]
|
|
&main
|
|
.assembler/token PEK2 ;lookup-label JSR2
|
|
POP ( don't care about node type )
|
|
;write-short JMP2 ( tail call )
|
|
|
|
(
|
|
Caret writes LIT, followed by the label address as an offset.
|
|
)
|
|
|
|
|
|
@normal-^ :normal-5b :normal-| [ 5e ]
|
|
;opcodes/op-lit ;opcodes/start SUB2 #07 DIV ;write-byte JSR2 POP
|
|
.assembler/token PEK2 ;lookup-label JSR2
|
|
POP ( don't care about node type )
|
|
.assembler/addr PEK2 SUB2
|
|
DUP2 #ff79 GTH2 ,&okay JNZ
|
|
DUP2 #0080 LTH2 ,&okay JNZ
|
|
|
|
( FIXME complain about jump being too far )
|
|
|
|
&okay
|
|
;write-byte JSR2 POP
|
|
JMP2r
|
|
|
|
(
|
|
Tilde and equals are the load and store helpers respectively.
|
|
If the target is in the zero page, use LDR/PEK or STR/POK opcodes,
|
|
otherwise use LDR2/PEK2 or STR2/POK2 opcodes.
|
|
)
|
|
|
|
@normal-~ [ 0000 ] [ 0000 ] [ 7e ]
|
|
LIT2r :opcodes/op-ldr LIT2r :opcodes/op-pek
|
|
,normal-=/main JMP
|
|
|
|
@normal-root
|
|
@normal-= :normal-24 :normal-^ [ 3d ]
|
|
LIT2r :opcodes/op-str LIT2r :opcodes/op-pok
|
|
&main
|
|
.assembler/token PEK2 ;lookup-label JSR2
|
|
DUP #03 AND ,&valid JNZ
|
|
|
|
( FIXME complain about helper not being usable )
|
|
POP2 JMP2r
|
|
|
|
&valid
|
|
#02 AND ,&two-byte JNZ
|
|
SWP2r
|
|
&two-byte
|
|
POP2r
|
|
LIT2r :opcodes/start SUB2r LITr [ 07 ] DIVr
|
|
OVR #00 EQU ,&byte-mode JNZ
|
|
|
|
;write-short SHORT_FLAG ,&end JMP
|
|
|
|
&byte-mode
|
|
SWP POP
|
|
;write-byte #00
|
|
|
|
&end
|
|
;opcodes/op-lit ;opcodes/start SUB2 #07 DIV ADD ADD ;write-byte JSR2
|
|
JSR2
|
|
STHr ;write-byte JSR2
|
|
POPr
|
|
JMP2r
|
|
|
|
(
|
|
Semicolons introduce variables. The variable name is added to the label
|
|
tree as usual, but all of the subfields are collected into their own tree
|
|
pointed to in the variable name's binary data.
|
|
)
|
|
|
|
@normal-; [ 0000 ] [ 0000 ] [ 3b ]
|
|
#80 .assembler/token PEK2 ;label-tree ;add-label JSR2
|
|
.assembler/heap PEK2 #0000 OVR2 PUT2
|
|
DUP2 #0003 SUB2 .assembler/var_size POK2
|
|
DUP2 .assembler/subtree POK2
|
|
#0002 ADD2 .assembler/heap POK2
|
|
|
|
.assembler/state PEK #0c ORA .assembler/state POK
|
|
JMP2r
|
|
|
|
@variable-root
|
|
@variable-{ :variable-nul :variable-} [ 7b ]
|
|
JMP2r
|
|
|
|
@variable-nul [ 0000 ] :normal-28 [ 00 ]
|
|
JMP2r
|
|
|
|
@variable-} [ 0000 ] [ 0000 ] [ 7d ]
|
|
.assembler/state PEK #f3 AND .assembler/state POK
|
|
JMP2r
|
|
|
|
@variable-name
|
|
#00 .assembler/token PEK2 .assembler/subtree PEK2 ;add-label JSR2
|
|
.assembler/heap PEK2 #0003 SUB2 .assembler/field_size POK2
|
|
.assembler/state PEK #f7 AND .assembler/state POK
|
|
JMP2r
|
|
|
|
@variable-size
|
|
.assembler/token PEK2 ;parse-hex-length JSR2
|
|
,&valid JNZ
|
|
( FIXME complain about invalid size )
|
|
JMP2r
|
|
|
|
&valid
|
|
&no-var-size
|
|
DUP #02 GTH ,&end JNZ
|
|
DUP .assembler/field_size PEK2 PUT
|
|
.assembler/var_size PEK2 #0000 EQU2 ,&end JNZ
|
|
DUP #80 EOR .assembler/var_size PEK2 PUT
|
|
,&end JMP
|
|
|
|
&loop
|
|
#00 ;write-byte JSR2
|
|
#01 SUB
|
|
&end
|
|
DUP ,&loop JNZ
|
|
POP
|
|
.assembler/state PEK #0c ORA .assembler/state POK
|
|
#0000 .assembler/var_size POK2
|
|
JMP2r
|
|
|
|
(
|
|
Percent signs introduce macros. The macro name is added to the macro tree,
|
|
and all the arguments are collected into a list that follows the label's
|
|
binary data.
|
|
)
|
|
|
|
@normal-% [ 0000 ] :normal-28 [ 25 ]
|
|
;macro-tree .assembler/token PEK2 #ff ;traverse-tree JSR2
|
|
,&new-macro JNZ
|
|
|
|
( macro already exists, we assume defined in a previous pass
|
|
we totally ignore the contents )
|
|
POP2
|
|
.assembler/state PEK #02 ORA .assembler/state POK
|
|
JMP2r
|
|
|
|
&new-macro
|
|
.assembler/token PEK2 SWP2 ;append-tree JSR2
|
|
POP2
|
|
.assembler/state PEK #01 ORA .assembler/state POK
|
|
JMP2r
|
|
|
|
@macro-root
|
|
@macro-{ :macro-nul :macro-} [ 7b ]
|
|
JMP2r
|
|
|
|
@macro-} [ 0000 ] [ 0000 ] [ 7d ]
|
|
.assembler/heap PEK2 DUP2 #00 ROT ROT PUT
|
|
#0001 ADD2 .assembler/heap POK2
|
|
.assembler/state PEK #fc AND .assembler/state POK
|
|
JMP2r
|
|
|
|
@macro-nul [ 0000 ] :normal-28 [ 00 ]
|
|
JMP2r
|
|
|
|
@macro-main
|
|
.assembler/token PEK2 ;append-heap JSR2
|
|
POP2
|
|
JMP2r
|
|
|
|
|
|
@normal-" :normal-nul :normal-# [ 22 ]
|
|
( FIXME NYI )
|
|
JMP2r
|
|
|
|
@normal-{ [ 0000 ] [ 0000 ] [ 7b ]
|
|
( these are spurious, but ignore them anyway )
|
|
JMP2r
|
|
|
|
@normal-} [ 0000 ] :normal-~ [ 7d ]
|
|
( these are spurious, but ignore them anyway )
|
|
JMP2r
|
|
|
|
@normal-nul [ 0000 ] [ 0000 ] [ 00 ]
|
|
@ignore
|
|
JMP2r
|
|
|
|
@normal-main
|
|
.assembler/token PEK2
|
|
;opcodes/tree OVR2 #03 ;traverse-tree JSR2
|
|
,¬-opcode JNZ
|
|
|
|
;opcodes/asm SUB2 #0007 DIV2
|
|
SWP2 #0003 ADD2
|
|
&flags
|
|
DUP2 GET
|
|
DUP #00 EQU ,&end-flags JNZ
|
|
DUP #32 NEQ ,¬-two JNZ
|
|
POP SWP2 SHORT_FLAG ORA SWP2 #0001 ADD2 ,&flags JMP
|
|
¬-two
|
|
DUP #72 NEQ ,¬-r JNZ
|
|
POP SWP2 RETURN_FLAG ORA SWP2 #0001 ADD2 ,&flags JMP
|
|
¬-r
|
|
POP POP2 .assembler/token PEK2 SWP2
|
|
,¬-opcode JMP
|
|
|
|
&end-flags
|
|
POP POP2
|
|
;write-byte JSR2
|
|
POP
|
|
JMP2r
|
|
|
|
¬-opcode
|
|
POP2
|
|
;macro-tree SWP2 #ff ;traverse-tree JSR2
|
|
,¬-macro JNZ
|
|
;assemble-macro JMP2 ( tail call )
|
|
|
|
¬-macro
|
|
( FIXME complain about bad opcode / nonexistent macro )
|
|
POP2
|
|
JMP2r
|
|
|
|
(
|
|
Here's the big set of trees relating to labels. Starting from l-root, all
|
|
the devices are stored here, perhaps some helper functions in the future,
|
|
too.
|
|
|
|
left-node* right-node* node-key-cstring binary-data
|
|
|
|
The node-keys are terminated with NUL since, unlike the opcodes and first
|
|
characters, the keys are variable length.
|
|
|
|
The binary-data is either three or five bytes long:
|
|
flags value* [ subtree-pointer* ]
|
|
|
|
The flags byte is divided up into bits:
|
|
|
|
bit 0-1: 00 means store / load helpers cannot be used,
|
|
01 means the helpers use POK / PEK,
|
|
02 means the helpers use STR / LDR,
|
|
03 is invalid;
|
|
bits 2-6 are reserved; and
|
|
bit 7: 80 means there is a subtree.
|
|
|
|
If there is a subtree, it is searched when the reference contains a dot.
|
|
)
|
|
|
|
|
|
@l-Audio [ 0000 ] [ 0000 ] [ "Audio 00 ] [ 80 ] :Audio :l-Audio-root
|
|
@l-Audio-delay [ 0000 ] [ 0000 ] [ "delay 00 ] [ 02 ] :Audio/delay
|
|
@l-Audio-envelope :l-Audio-delay :l-Audio-finish [ "envelope 00 ] [ 02 ] :Audio/envelope
|
|
@l-Audio-finish [ 0000 ] [ 0000 ] [ "finish 00 ] [ 01 ] :Audio/finish
|
|
@l-Audio-root
|
|
@l-Audio-pitch :l-Audio-envelope :l-Audio-value [ "pitch 00 ] [ 01 ] :Audio/pitch
|
|
@l-Audio-play [ 0000 ] [ 0000 ] [ "play 00 ] [ 01 ] :Audio/play
|
|
@l-Audio-value :l-Audio-play :l-Audio-volume [ "value 00 ] [ 02 ] :Audio/value
|
|
@l-Audio-volume [ 0000 ] :l-Audio-wave [ "volume 00 ] [ 01 ] :Audio/volume
|
|
@l-Audio-wave [ 0000 ] [ 0000 ] [ "wave 00 ] [ 02 ] :Audio/wave
|
|
@l-Console :l-Audio :l-Controller [ "Console 00 ] [ 80 ] :Console :l-Console-root
|
|
@l-Console-byte [ 0000 ] :l-Console-char [ "byte 00 ] [ 01 ] :Console/byte
|
|
@l-Console-char [ 0000 ] [ 0000 ] [ "char 00 ] [ 01 ] :Console/char
|
|
@l-Console-root
|
|
@l-Console-short :l-Console-byte :l-Console-string [ "short 00 ] [ 02 ] :Console/short
|
|
@l-Console-string [ 0000 ] :l-Console-vector [ "string 00 ] [ 02 ] :Console/string
|
|
@l-Console-vector [ 0000 ] [ 0000 ] [ "vector 00 ] [ 02 ] :Console/vector
|
|
@l-Controller [ 0000 ] [ 0000 ] [ "Controller 00 ] [ 80 ] :Controller :l-Controller-root
|
|
@l-Controller-button [ 0000 ] [ 0000 ] [ "button 00 ] [ 01 ] :Controller/button
|
|
@l-Controller-root
|
|
@l-Controller-key :l-Controller-button :l-Controller-vector [ "key 00 ] [ 01 ] :Controller/key
|
|
@l-Controller-vector [ 0000 ] [ 0000 ] [ "vector 00 ] [ 02 ] :Controller/vector
|
|
@l-root
|
|
@l-DateTime :l-Console :l-Mouse [ "DateTime 00 ] [ 80 ] :DateTime :l-DateTime-root
|
|
@l-DateTime-day [ 0000 ] [ 0000 ] [ "day 00 ] [ 01 ] :DateTime/day
|
|
@l-DateTime-dotw :l-DateTime-day :l-DateTime-doty [ "dotw 00 ] [ 01 ] :DateTime/dotw
|
|
@l-DateTime-doty [ 0000 ] :l-DateTime-hour [ "doty 00 ] [ 02 ] :DateTime/doty
|
|
@l-DateTime-hour [ 0000 ] [ 0000 ] [ "hour 00 ] [ 01 ] :DateTime/hour
|
|
@l-DateTime-root
|
|
@l-DateTime-isdst :l-DateTime-dotw :l-DateTime-refresh [ "isdst 00 ] [ 01 ] :DateTime/isdst
|
|
@l-DateTime-minute [ 0000 ] :l-DateTime-month [ "minute 00 ] [ 01 ] :DateTime/minute
|
|
@l-DateTime-month [ 0000 ] [ 0000 ] [ "month 00 ] [ 01 ] :DateTime/month
|
|
@l-DateTime-refresh :l-DateTime-minute :l-DateTime-second [ "refresh 00 ] [ 01 ] :DateTime/refresh
|
|
@l-DateTime-second [ 0000 ] :l-DateTime-year [ "second 00 ] [ 01 ] :DateTime/second
|
|
@l-DateTime-year [ 0000 ] [ 0000 ] [ "year 00 ] [ 02 ] :DateTime/year
|
|
@l-File [ 0000 ] [ 0000 ] [ "File 00 ] [ 80 ] :File :l-File-root
|
|
@l-File-length [ 0000 ] [ 0000 ] [ "length 00 ] [ 02 ] :File/length
|
|
@l-File-load :l-File-length :l-File-name [ "load 00 ] [ 02 ] :File/load
|
|
@l-File-name [ 0000 ] [ 0000 ] [ "name 00 ] [ 02 ] :File/name
|
|
@l-File-root
|
|
@l-File-offset :l-File-load :l-File-success [ "offset 00 ] [ 02 ] :File/offset
|
|
@l-File-save [ 0000 ] [ 0000 ] [ "save 00 ] [ 02 ] :File/save
|
|
@l-File-success :l-File-save :l-File-vector [ "success 00 ] [ 02 ] :File/success
|
|
@l-File-vector [ 0000 ] [ 0000 ] [ "vector 00 ] [ 02 ] :File/vector
|
|
@l-Mouse :l-File :l-Screen [ "Mouse 00 ] [ 80 ] :Mouse :l-Mouse-root
|
|
@l-Mouse-chord [ 0000 ] :l-Mouse-state [ "chord 00 ] [ 01 ] :Mouse/chord
|
|
@l-Mouse-state [ 0000 ] [ 0000 ] [ "state 00 ] [ 01 ] :Mouse/state
|
|
@l-Mouse-root
|
|
@l-Mouse-vector :l-Mouse-chord :l-Mouse-x [ "vector 00 ] [ 02 ] :Mouse/vector
|
|
@l-Mouse-x [ 0000 ] :l-Mouse-y [ "x 00 ] [ 02 ] :Mouse/x
|
|
@l-Mouse-y [ 0000 ] [ 0000 ] [ "y 00 ] [ 02 ] :Mouse/y
|
|
@l-Screen [ 0000 ] :l-System [ "Screen 00 ] [ 80 ] :Screen :l-Screen-root
|
|
@l-Screen-addr [ 0000 ] [ 0000 ] [ "addr 00 ] [ 02 ] :Screen/addr
|
|
@l-Screen-color :l-Screen-addr :l-Screen-height [ "color 00 ] [ 01 ] :Screen/color
|
|
@l-Screen-height [ 0000 ] [ 0000 ] [ "height 00 ] [ 02 ] :Screen/height
|
|
@l-Screen-root
|
|
@l-Screen-vector :l-Screen-color :l-Screen-x [ "vector 00 ] [ 02 ] :Screen/vector
|
|
@l-Screen-width [ 0000 ] [ 0000 ] [ "width 00 ] [ 02 ] :Screen/width
|
|
@l-Screen-x :l-Screen-width :l-Screen-y [ "x 00 ] [ 02 ] :Screen/x
|
|
@l-Screen-y [ 0000 ] [ 0000 ] [ "y 00 ] [ 02 ] :Screen/y
|
|
@l-System [ 0000 ] [ 0000 ] [ "System 00 ] [ 80 ] :System :l-System-root
|
|
@l-System-b [ 0000 ] [ 0000 ] [ b 00 ] [ 02 ] :System/b
|
|
@l-System-root
|
|
@l-System-g :l-System-b :l-System-r [ "g 00 ] [ 02 ] :System/g
|
|
@l-System-r [ 0000 ] :l-System-vector [ "r 00 ] [ 02 ] :System/r
|
|
@l-System-vector [ 0000 ] [ 0000 ] [ "vector 00 ] [ 02 ] :System/vector
|
|
|
|
@assembler-heap-start
|
|
|