diff --git a/exe/dune b/exe/dune index 2cfc9e6..9d5c776 100644 --- a/exe/dune +++ b/exe/dune @@ -1,4 +1,4 @@ (executable (public_name uxnemu) (name uxnemu) - (libraries uxn varvara unix fmt)) + (libraries uxn varvara unix)) diff --git a/exe/uxnemu.ml b/exe/uxnemu.ml index dec0ab1..7b2189a 100644 --- a/exe/uxnemu.ml +++ b/exe/uxnemu.ml @@ -9,28 +9,22 @@ module Console = Varvara.Console.Make () module File = Uxn.Device.Compose (Varvara.File.Make (struct - let start_addr = 0xa0 + let start = 0xa0 end)) (Varvara.File.Make (struct - let start_addr = 0xb0 + let start = 0xb0 end)) module Devices = Uxn.Device.Compose (Uxn.Device.Compose (System) (Console)) (File) -let print_stack ~name (Machine.Stack { data; sp }) = - Fmt.epr "%s: @[%a@]@." name - (Fmt.on_bytes (Fmt.octets ())) - (Bytes.sub data 0 sp) - let run m pc = let dev = Machine.dev m in try Machine.dispatch ~trace m pc with | effect Machine.Trace (pc, instr, args), k -> if trace then begin - Fmt.epr "PC = %04x | %6s %a@." pc (Instr.to_string instr) - (Fmt.list ~sep:(Fmt.any " ") (Fmt.fmt "%02x")) - args; + Printf.eprintf "PC = %04x %6s %s\n" pc (Instr.to_string instr) + (List.map (Format.sprintf "%02x") args |> String.concat " "); Out_channel.flush stderr end; continue k () @@ -49,7 +43,7 @@ let run m pc = let main () = if Array.length Sys.argv < 2 then ( - Fmt.epr "usage: uxnemu file.rom ...\n"; + Printf.eprintf "usage: uxnemu file.rom ...\n"; exit 1); let code = @@ -92,11 +86,6 @@ let main () = done with Exit -> console_input 0 4 end; - - if trace then begin - print_stack ~name:"wst" (Machine.wst mach); - print_stack ~name:"rst" (Machine.rst mach) - end; exit (Bytes.get_uint8 dev 0x0f land 0x7f) let _ = main () diff --git a/lib/Machine.ml b/lib/Machine.ml index 783b94b..4450ce4 100644 --- a/lib/Machine.ml +++ b/lib/Machine.ml @@ -5,7 +5,10 @@ open Effect type stack = Stack of { data : bytes; mutable sp : int } type mode = Mode of { short : bool; keep : bool; mutable temp : int } -let stack_create () = Stack { data = Bytes.create 256; sp = 0 } +let stack_create () = + let data = Bytes.create 256 in + Bytes.unsafe_fill data 0 256 '\x00'; + Stack { data; sp = 0 } let peek (Mode { short; keep; temp }) (Stack { data; sp }) : int = let amt = if short then 2 else 1 in @@ -36,13 +39,6 @@ let pushbyte (Mode m) s v = m.temp <- temp [@@inline] -let pushshort (Mode m) s v = - let m' = Mode { m with short = true } in - push m' s v; - let (Mode { temp; _ }) = m' in - m.temp <- temp -[@@inline] - let popbyte (Mode m) s = let m' = Mode { m with short = false } in let r = pop m' s in @@ -75,9 +71,6 @@ type _ Effect.t += | DEI : ([ `Byte | `Short ] * int) -> int Effect.t | DEO : (int * int) -> unit Effect.t | Trace : (int * Instr.t * int list) -> unit Effect.t - | Breakpoint : int -> unit Effect.t - -type machine_state = Break | Next of int let ram (Machine { data; _ }) = data let dev (Machine { dev; _ }) = dev diff --git a/lib/Machine.mli b/lib/Machine.mli index f34d44b..8bce13f 100644 --- a/lib/Machine.mli +++ b/lib/Machine.mli @@ -5,10 +5,6 @@ val stack_create : unit -> stack val peek : mode -> stack -> int val pop : mode -> stack -> int val push : mode -> stack -> int -> unit -val pushbyte : mode -> stack -> int -> unit -val pushshort : mode -> stack -> int -> unit -val popbyte : mode -> stack -> int -val popshort : mode -> stack -> int type machine @@ -17,14 +13,11 @@ val dev : machine -> bytes val wst : machine -> stack val rst : machine -> stack -type machine_state = Break | Next of int - type _ Effect.t += | BRK : int Effect.t | DEI : ([ `Byte | `Short ] * int) -> int Effect.t | DEO : (int * int) -> unit Effect.t | Trace : (int * Instr.t * int list) -> unit Effect.t - | Breakpoint : int -> unit Effect.t val create : string -> machine val dispatch : ?trace:bool -> machine -> int -> 'a diff --git a/lib/Varvara/File.ml b/lib/Varvara/File.ml index d14ffc7..89b131c 100644 --- a/lib/Varvara/File.ml +++ b/lib/Varvara/File.ml @@ -5,24 +5,21 @@ type file_state = | Dir_read of Unix.dir_handle * string (* dir_handle, filepath *) | Dir_write -type file_device = { +type state = { mutable filepath : string option; mutable state : file_state; mutable length : int; } module type ADDR = sig - val start_addr : int + val start : int end -module Make (Addr : ADDR) : Uxn.Device.DEVICE with type state = file_device = -struct - type state = file_device +module Make (Addr : ADDR) : Uxn.Device.DEVICE with type state = state = struct + type nonrec state = state let state = { filepath = None; state = Idle; length = 0 } - - let can_handle port = - port >= Addr.start_addr && port <= Addr.start_addr + 0x0f + let can_handle port = port >= Addr.start && port <= Addr.start + 0x0f let read_cstring ram addr = let buf = Buffer.create 256 in @@ -204,17 +201,15 @@ struct let open Uxn in let ram = Machine.ram mach in let dev = Machine.dev mach in - let with_success result = - file_success dev (Addr.start_addr + 0x02) result - in - match port - Addr.start_addr with + let with_success result = file_success dev (Addr.start + 0x02) result in + match port - Addr.start with | 0x0a -> state.length <- value | 0x04 -> file_stat (Machine.ram mach) value state.length |> with_success | 0x06 -> file_delete () |> with_success | 0x08 -> file_init (Machine.ram mach) value |> with_success | 0x0c -> file_read (Machine.ram mach) value state.length |> with_success | 0x0e -> - let append = Bytes.get_uint8 dev (Addr.start_addr + 0x07) in + let append = Bytes.get_uint8 dev (Addr.start + 0x07) in file_write ram value state.length append |> with_success | _ -> () end diff --git a/lib/Varvara/System.ml b/lib/Varvara/System.ml index 58ab18f..047c3f5 100644 --- a/lib/Varvara/System.ml +++ b/lib/Varvara/System.ml @@ -9,9 +9,13 @@ module Make () : Uxn.Device.DEVICE with type state = state = struct let can_handle port = port >= 0x00 && port <= 0x0f let print_stack ~name (Machine.Stack { data; sp }) = - Fmt.epr "%s: @[%a@]@." name - (Fmt.on_bytes (Fmt.octets ())) - (Bytes.sub data 0 sp) + Printf.eprintf "%s " name; + for i = sp - 8 to sp - 1 do + Printf.eprintf "%02x%s" + (Bytes.get_uint8 data (i land 0xff)) + (if i land 0xff == 0xff then "|" else " ") + done; + Printf.eprintf "<%02x\n" sp let get_bank mach bank = if bank = 0 then Machine.ram mach diff --git a/lib/Varvara/dune b/lib/Varvara/dune index f7de2ae..600c2de 100644 --- a/lib/Varvara/dune +++ b/lib/Varvara/dune @@ -1,3 +1,3 @@ (library (name varvara) - (libraries uxn fmt unix)) + (libraries uxn unix)) diff --git a/utils/drifblim.tal b/utils/drifblim.tal new file mode 100644 index 0000000..bc48d63 --- /dev/null +++ b/utils/drifblim.tal @@ -0,0 +1,811 @@ +( usage: drifblim.rom input.tal 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 +|a0 @File/vector $2 &success $1 &success-lb $1 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 + +|000 + + @src/buf $3f &cap $1 + @dst/buf $3f &cap $1 + @scope/buf $3f &cap $1 + @token/buf $3f &cap $1 + +|100 + +@on-reset ( -> ) + ;meta #06 DEO2 + ;dict/reset scope/ + ;src/on-console + ( >> ) + +@bind ( vector* -> ) + .Console/vector DEO2 + [ LIT2 03 -Console/type ] DEI AND ?{ + ;dict/usage err/ + [ LIT2 01 -System/state ] DEO } + BRK + +@src/on-console ( -> ) + [ LIT2 02 -Console/type ] DEI LTH ?{ + .Console/read DEI [ LIT2 -&cap &ptr -&buf ] INCk ,&ptr STR + NEQk ?{ ;dict/exceeded ;&buf ;dict/Path err/ } + NIP STZ + BRK } + ( | src -> dst ) + ;dst/on-console !bind + +@dst/on-console ( -> ) + [ LIT2 02 -Console/type ] DEI LTH ?{ .Console/read DEI / + BRK } + ( | assemble ) + ;src/buf assembly/ + assembly/ + BRK + +@dst/ ( c -- ) + [ LIT2 -&cap &ptr -&buf ] INCk ,&ptr STR + NEQk ?{ ;dict/exceeded ;&buf ;dict/Path err/ } + NIP STZ + JMP2r + +@dst/ ( str* -- ) + LDAk DUP ?{ POP POP2 JMP2r } + / + INC2 !/ + +@err/ ( c -- ) + #19 DEO + JMP2r + +@runes/concat INC2 + ( >> ) + +@assembly/ ( f* -- ) + .File/name DEO2 + #0001 .File/length DEO2 + token/ + #0000 + &>s + .System/state DEI ?&end + ;&c .File/read DEO2 + .File/success-lb DEI ?{ + ORAk ?{ ;dict/invalid ;src/buf ;dict/File err/ } + &end ( i* -- ) + POP2 JMP2r } + INC2 [ LIT &c $1 ] token/ !&>s + +@rom/ ( byte addr* -- ) + ,&dst STR2 + ,&v STR + ;&mmu-put .System/expansion DEO2 + JMP2r + + &mmu-put [ 00 0001 0001 &dst $2 &v $1 ] + &mmu-get [ 01 0001 0001 &src $2 0000 =&buf ] &buf $1 + +@rom/ ( -- ) + ;dict/assembled err/ + #20 err/ + ;dst/buf err/ + ;dict/in err/ + ;head/length LDA2 DUP2 #0100 SUB2 err/ + ;dict/bytes err/ + ( | emit rom ) + ;dst/buf .File/name DEO2 + #0001 .File/length DEO2 + #0100 + &>ler + DUP2 ,&src STR2 + ;&mmu-get .System/expansion DEO2 + ;&buf .File/write DEO2 + INC2 GTH2k ?&>ler + POP2 POP2 + ( | emit sym ) + ;dict/sym-ext dst/ + ;dst/buf .File/name DEO2 + ;syms/ptr LDA2 ;syms/mem + &>les + #0002 .File/length DEO2 + DUP2 .File/write DEO2 + #0003 ADD2 DUP2 str/cap SWP2k SUB2 .File/length DEO2 + SWP2 .File/write DEO2 + GTH2k ?&>les + POP2 POP2 JMP2r + +@dict/usage "usage: 20 "drifblim.rom 20 "in.tal 20 "out.rom 0a $1 + &Path "Path $1 + &File "File $1 + &sym-ext ".sym $1 + +@meta $1 + ( name ) "Drifblim 0a + ( desc ) "Uxntal 20 "Assembler 0a + ( auth ) "By 20 "Devine 20 "Lu 20 "Linvega 0a + ( date ) "25 20 "Nov 20 "2025 $2 + + + +( Core ) + +@assembly/ ( -- ) + ( cap ) #0a token/ + ,&mode LDR2 ;comment/assemble NEQ2 ?{ + ( ! ) ;dict/open ;dict/trail ;dict/Comment err/ } + ,&mode LDR2 ;macros/assemble NEQ2 ?{ + ( ! ) ;dict/open ;dict/trail ;dict/Macro err/ } + .System/state DEI ?{ + refs/ + .System/state DEI ?{ + [ LIT2 80 -System/state ] DEO !syms/ } } + JMP2r + +@assembly/apply ( t* -- ) + LDZk ?{ POP2 JMP2r } + [ LIT2 &mode =standard/assemble ] JMP2 + +( +@|Standard ) + +@standard/ ( -- ) + ;&assemble ;assembly/mode STA2 + JMP2r + +@standard/assemble ( t* -- ) + ( hex ) str/is-hex ?rom/ + ( opc ) opcodes/is-opcode ?rom/ + LDZk runes/find INC2k ORA ?{ + POP2 + ( mac ) DUP2 macros/find-name INC2k ORA ?macros/ + POP2 + ( imm ) !runes/litjsi } + INC2 LDA2 JMP2 + +( +@|Comment ) + +@comment/ ( t* -- ) + POP2 ;&assemble ;assembly/mode STA2 + [ LIT2 01 _&depth ] STR + JMP2r + +@comment/assemble ( t* -- ) + LDA2 DUP2 [ LITr &depth $1 ] + ( a ) LIT2 "( $1 EQU2 [ STH ADDr ] + ( b ) LIT2 ") $1 EQU2 [ STH SUBr ] + ( . ) STHkr LITr _&depth STRr + ?{ !standard/ } + JMP2r + +( +@|Macros ) + +@macros/ ( t* -- ) + name/ + / + #00 / + ;&walk ;assembly/mode STA2 + JMP2r + + &walk ( t* -- ) + LDA2 [ LIT2 "{ $1 ] NEQ2 ?{ + ;&assemble ;assembly/mode STA2 + [ LIT2 01 _&depth ] STR } + JMP2r + +@macros/assemble ( t* -- ) + LDA2k DUP2 [ LITr &depth $1 ] + ( a ) LIT "{ EQU SWP LIT "{ EQU ORA [ STH ADDr ] + ( b ) LIT2 "} $1 EQU2 [ STH SUBr ] + ( . ) STHkr LITr _&depth STRr + ?{ POP2 #00 / !standard/ } + / + #20 !/ + +@macros/ ( t* -- ) + ;/ !hof/ + +@macros/ ( byte -- ) + [ LIT2 &ptr =&mem ] INC2k + ( | check overflow ) + DUP2 ;&memend LTH2 ?{ + ( ! ) ;dict/exceeded ;dict/Macros err/ } + ,&ptr STR2 + STA + JMP2r + +@macros/find-name ( name* -- * ) + STH2 + ,&ptr LDR2 ;&mem + &>lf + DUP2 STH2kr str/cmp ?{ + str/cap str/cap GTH2k ?&>lf + POP2 #ffff } + NIP2 POP2r JMP2r + +@macros/ ( t* macro* -- ) + NIP2 token/ + str/cap ;token/ !hof/ + +( +@|Token ) + +@token/ ( -- ) + [ LIT2 -&buf _&ptr ] STR + [ LIT2 00 -&buf ] STZ + JMP2r + +@token/ ( c -- ) + DUP #20 GTH ?{ + ;&buf assembly/apply #0a NEQ ?{ + [ LIT2 &line 0001 ] INC2 ,&line STR2 } + !/ } + [ LIT2 00 &ptr -&buf ] INCk + ( | check overflow ) + DUP .&cap LTH ?{ + ( ! ) ;dict/exceeded ;dict/Name err/ } + ,&ptr STR + STZ2 + JMP2r + +( +@|Scope ) + +@scope/ ( c -- ) + [ LIT2 00 &ptr -&buf ] INCk + ( | check overflow ) + DUP .&cap LTH ?{ + ( ! ) ;dict/exceeded ;dict/Symbol err/ } + ,&ptr STR + STZ2 + JMP2r + +@scope/ ( name* -- ) + [ LIT2 -&buf _&ptr ] STR + &>w + LDAk [ LIT "/ ] EQU ?{ + LDAk / + INC2 LDAk ?&>w } + POP2 ,&ptr LDR ,&anchor STR + JMP2r + +@scope/make-name ( name* -- scope/label* ) + INC2 [ LIT2 &anchor $1 _&ptr ] STR + [ LIT "/ ] / + ;&buf SWP2 ;/ !hof/ + +( +@|Runes ) + +@runes/find ( char -- * ) + STH + ;&lut + &>w + LDAk STHkr EQU ?{ + #0003 ADD2 LDAk ?&>w + POP2 #ffff } + POPr JMP2r + +@runes/ignore ( t* -- ) + POP2 JMP2r + + &lambda ( t* -- ) + POP2 !lambda/pop + + &coment ( t* -- ) + !comment/ + + ¯os ( t* -- ) + /req-name !macros/ + + &padabs ( t* -- ) + /req-name syms/find-addr !head/ + + &padrel ( t* -- ) + /req-name syms/find-addr !head/ + + &toplab ( t* -- ) + /req-name DUP2 scope/ !syms/ + + &sublab ( t* -- ) + scope/make-name !syms/ + + &litrel ( t* -- ) + #80 rom/ &rawrel /req-name refs/get-rel !rom/ + + &litzep ( t* -- ) + #80 rom/ &rawzep /req-name refs/get-abs !rom/ + + &litabs ( t* -- ) + #a0 rom/ &rawabs /req-name refs/get-abs2 !rom/ + + &litjci ( t* -- ) + /req-name #20 !rom/ + + &litjmi ( t* -- ) + /req-name #40 !rom/ + + &litjsi ( t* -- ) + #60 !rom/ + + &lithex ( t* -- ) + /req-name !rom/ + + &rawstr ( t* -- ) + /req-name !rom/ + +@runes/req-name ( str* -- str1* ) + INC2 LDAk #20 GTH ?{ ;dict/invalid ;dict/Name !err/ } + JMP2r + +@runes/lut [ + "| =&padabs "$ =&padrel + "@ =&toplab "& =&sublab + ", =&litrel "_ =&rawrel + ". =&litzep "- =&rawzep + "; =&litabs "= =&rawabs + "! =&litjmi "? =&litjci + "# =&lithex "" =&rawstr + "} =&lambda "~ =&concat + "( =&coment ") =&ignore + "[ =&ignore "] =&ignore "% =¯os ] $1 + +( +@|Opcodes ) + +@opcodes/is-opcode ( str* -- str* bool ) + DUP2 /parse #00 NEQ STH + DUP2 ;&brk str/cmp STHr ORA JMP2r + +@opcodes/parse ( str* -- byte ) + [ LIT2r 1f00 ] ;&lut + &>w1 + SWP2k #0003 SWP2 mem/cmp ?{ + INCr #0003 ADD2 LDAk ?&>w1 + POP2 POP2 POP2r #00 JMP2r } + POP2 + ( mask ) ANDr + ( litk ) LDA2k [ LIT2 "LI ] EQU2 #70 SFT [ STH ORAr ] + ( move ) #0003 ADD2 + &>w2 + LDAk #21 LTH ?{ + ( | parse modes ) + LDAk [ LIT "2 ] NEQ ?{ LITr 20 !&r } + LDAk [ LIT "r ] NEQ ?{ LITr 40 !&r } + LDAk [ LIT "k ] NEQ ?{ LITr 80 !&r } + POP2 POPr #00 JMP2r + &r ORAr INC2 !&>w2 } + POP2 STHr JMP2r + +@opcodes/lut [ + "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 "BRK $1 + +( +@|Lambda ) + +@lambda/make-name ( token* -- name* ) + POP2 [ LIT2 &count $2 ] INC2k ,&count STR2 + DUP2 [ LIT2 &ptr =&mem ] INC2k INC2 ,&ptr STR2 + STA2 + ( >> ) + +@lambda/name ( id* -- str* ) + /name-part ROT /name-part ,&id1 STR2 + ,&id2 STR2 + ;&sym JMP2r + +@lambda/name-part ( id -- hexchar hexchar ) + DUP #04 SFT hexc SWP !hexc + +@lambda/pop ( -- ) + ,&ptr LDR2 #0002 SUB2 LDA2k /name syms/ + ,&ptr STR2 + JMP2r + &sym cebb + &id1 ".. + &id2 ".. 00 + +( +@|Name ) + +@name/ ( name* -- name* ) + ( not hex ) str/is-hex ?&fail + ( not lambda ) LDAk LIT "{ EQU ?&fail + ( not runic ) LDAk runes/find INC2 ORA ?&fail + ( dup macros ) DUP2 macros/find-name INC2 ORA ?&dup + ( dup symbol ) DUP2 syms/find-name INC2 ORA ?&dup + ( not opcode ) opcodes/is-opcode [ JMP JMP2r ] + &fail ( -- ) + ;dict/invalid ;dict/Name !err/ + + &dup ( -- ) + ;dict/duplicate ;dict/Name !err/ + +@name/unpack ( name* -- name* ) + LDAk [ LIT "{ ] EQU ?lambda/make-name + LDAk [ LIT "/ ] EQU ?scope/make-name + LDAk [ LIT "& ] EQU ?scope/make-name + JMP2r + +( +@|Syms ) + +@syms/ ( name* -- ) + DUP2 /find-name INC2k ORA ?{ + POP2 ;&ptr LDA2 refs/ + .SymType/declared head/get !/ } + ( | name* sym* -- ) + NIP2 DUP2 refs/ + /is-declared ?{ head/get OVR2 STA2 !/ } + POP2 + ( ! ) ;dict/duplicate ;dict/Symbol !err/ + +@syms/ ( name* type addr* -- ) + ( hb ) SWP / + ( lb ) / + ( type ) / + name/ + ;/ hof/ + #00 + ( >> ) + +@syms/ ( byte -- ) + [ LIT2 &ptr =&mem ] INC2k + ( | check overflow ) + DUP2 ;refs/ptr LDA2 LTH2 ?{ + ( ! ) ;dict/exceeded ;dict/Symbols err/ } + ,&ptr STR2 + STA + JMP2r + +@syms/find-name ( name* -- * ) + STH2 + ,&ptr LDR2 ;&mem + &>lfn + DUP2 #0003 ADD2 STH2kr str/cmp ?{ + #0003 ADD2 str/cap GTH2k ?&>lfn + POP2 #ffff } + NIP2 POP2r JMP2r + +@syms/find-alloc ( name* -- * ) + DUP2 /find-name INC2k ORA ?{ + ( null* .. next* ) POP2 ,&ptr LDR2 + ( alloc ) SWP2 .SymType/used #ffff !/ } + NIP2 JMP2r + +@syms/find-addr ( name* -- * ) + str/is-hex ?str/hex + name/unpack /find-name /is-defined ?{ + ( ! ) ;dict/invalid ;dict/Symbol err/ } + /use LDA2 JMP2r + +@syms/ ( -- ) + ;&ptr LDA2 ;&mem + &>ls + EQU2k ?{ + /is-used ?{ + LDA2k #0100 EQU2 ?{ + DUP2 #0003 ADD2 LDAk [ LIT "A ] SUB #1a LTH ?{ + ;dict/unused err/ + DUP2 err/ + #0a err/ } + POP2 } } + #0003 ADD2 str/cap !&>ls } + POP2 POP2 !rom/ + +@syms/byte-distance ( addr* -- addr* ) + DUP2 #0080 ADD2 POP ?{ JMP2r } + ( ! ) ;dict/too-far ;dict/Symbol !err/ + +@syms/is-defined ( sym* -- sym* t ) + INC2k ORA ?{ #00 JMP2r } + ( >> ) + +@syms/is-declared ( sym* -- sym* t ) + INC2k INC2 LDA .SymType/declared AND JMP2r + +@syms/is-used ( sym* -- sym* t ) + INC2k INC2 LDA .SymType/used AND JMP2r + +@syms/use ( sym* -- sym* ) + INC2k INC2 STH2k LDA .SymType/used ORA STH2r STA + JMP2r + +@syms/ ( sym* -- ) + INC2 INC2 STH2k LDA .SymType/declared ORA STH2r STA + JMP2r + +( +@|References ) + +@refs/get-type ( token* type* -- addr* ) + ,&type STR2 + name/unpack syms/find-alloc syms/is-declared ?{ + DUP2 head/get ,&ptr LDR2 #000a SUB2 ,&ptr STR2 + ( addr* ) / + ( symbol* ) / + ( type-fn* ) [ LIT2 &type $2 ] / + ( scope* ) [ LIT2 &scope $2 ] / + ( line* ) ;token/line LDA2 / + ,&ptr LDR2 #000a SUB2 ,&ptr STR2 } + ( | mark as used ) + syms/use LDA2 JMP2r + +@refs/ ( value* -- ) + SWP / + ( >> ) + +@refs/ ( byte -- ) + [ LIT2 &ptr =&memend ] INC2k + ( | check overflow ) + DUP2 ;syms/ptr LDA2 GTH2 ?{ + ( ! ) ;dict/exceeded ;dict/References err/ } + ,&ptr STR2 + STA + JMP2r + +@refs/get-abs ( label* -- addr ) + ;&handle-abs /get-type NIP JMP2r + +@refs/get-abs2 ( label* -- addr* ) + ;&handle-abs2 !/get-type + +@refs/get-rel ( label* -- distance ) + ;&handle-rel /get-type INC2k ORA ?{ + ( undefined ) POP2 #00 JMP2r } + head/get /get-distance syms/byte-distance NIP JMP2r + +@refs/get-rel2 ( label* -- distance* ) + ;&handle-rel2 /get-type head/get + ( >> ) + +@refs/get-distance ( a* b* -- distance* ) + INC2 INC2 SUB2 JMP2r + +@refs/ ( -- ) + ,&ptr LDR2 ;&memend + &>l + EQU2k ?{ + #000a SUB2 DUP2 ;err/ref STA2 + DUP2k #0004 ADD2 LDA2 JSR2 !&>l } + POP2 POP2 JMP2r + +@refs/resolve-sym ( ref* -- ref* sym/addr* ) + LDA2k head/ + ( ref* sym* ) INC2k INC2 LDA2 + ( ref* sym/addr* ) LDA2 + ( ref* sym/addr* ) INC2k ORA ?{ + ( ! ) ;dict/invalid !err/ } + ( ref* sym/addr* ) JMP2r + +@refs/handle-abs ( ref* -- ) + /resolve-sym NIP2 NIP !rom/ + +@refs/handle-abs2 ( ref* -- ) + /resolve-sym NIP2 !rom/ + +@refs/handle-rel ( ref* -- ) + /resolve-sym SWP2 LDA2 /get-distance /byte-distance NIP !rom/ + +@refs/handle-rel2 ( ref* -- ) + /resolve-sym SWP2 LDA2 /get-distance !rom/ + +@refs/byte-distance ( addr* -- addr* ) + DUP2 #0080 ADD2 POP ?{ JMP2r } + ( ! ) ;dict/too-far !err/ + +@refs/ ( sym* -- ) + DUP2 #0003 ADD2 LDA2 #cebb NEQ2 ?{ POP2 JMP2r } + ;refs/scope STA2 + JMP2r + +( +@|Rom ) + +@rom/ ( str* -- ) + ;/ !hof/ + +@rom/ ( str* -- ) + opcodes/parse !/ + +@rom/ ( str* -- ) + str/len #02 NEQ #50 SFT #80 ORA / + ( >> ) + +@rom/ ( str* -- ) + str/is-hex #00 EQU ?{ + str/len DUP #02 NEQ ?{ POP str/hex NIP !/ } + #04 NEQ ?{ str/hex !/ } } + POP2 ;dict/invalid ;dict/Number !err/ + +@rom/ ( str* opc -- ) + / + refs/get-rel2 + ( >> ) + +@rom/ ( short* -- ) + SWP / + ( >> ) + +@rom/ ( byte -- ) + head/get-inc + ( | test zero-page ) + OVR ?{ + POP2 POP + ( ! ) ;dict/zero-page ;dict/Writing !err/ } + !rom/ + +@head/get-inc ( -- addr* ) + [ LIT2 &addr 0100 ] INC2k ,&addr STR2 + INC2k [ LIT2 &length 0100 ] LTH2 ?{ INC2k ,&length STR2 } + JMP2r + +@head/get ( -- addr* ) + ,&addr LDR2 JMP2r + +@head/ ( addr* -- ) + /get ADD2 + ( >> ) + +@head/ ( addr* -- ) + ,&addr STR2 + JMP2r + +( +@|Stdlib ) + +@hof/ ( data* byte-fn* -- ) + STH2 + &>w + LDAk DUP ?{ POP POP2 POP2r JMP2r } + STH2kr JSR2 INC2 !&>w + +@hexc ( hex -- char ) + #0f AND #0a LTHk ?{ + SUB [ LIT "a ] ADD JMP2r } + POP [ LIT "0 ] ADD JMP2r + +@chex ( addr* -- addr* ) + LDAk + ( dec ) [ LIT "0 ] SUB DUP #09 GTH [ JMP JMP2r ] + ( hex ) #27 SUB DUP #0a SUB #05 GTH [ JMP JMP2r ] + ( nil ) POP #ff JMP2r + +@str/hex ( str* -- value* ) + [ LIT2r 0000 ] + &>wh + [ LITr 40 ] SFT2r chex [ LITr 00 ] STH + ADD2r INC2 LDAk ?&>wh + POP2 STH2r JMP2r + +@str/len ( str* -- str* length ) + DUP2k /cap SWP2 INC2 SUB2 NIP JMP2r + +@str/is-hex ( str* -- str* f ) + DUP2 + &>wih + chex INC ?{ LDA #00 EQU JMP2r } + INC2 !&>wih + +@str/cap ( str* -- end* ) + LDAk ?{ INC2 JMP2r } + INC2 !/cap + +@str/cmp ( a* b* -- bool ) + DUP2k /cap SWP2 SUB2 SWP2 + ( >> ) + +@mem/cmp ( a* length* b* -- t ) + STH2 + OVR2 ADD2 SWP2 + &>l + EQU2k ?{ + LDAk LDAkr STHr NEQ ?{ INC2 INC2r !&>l } } + POP2r EQU2 JMP2r + +( +@|Error ) + +@err/ ( adj* topic* -- ) + .System/state DEI ?{ + [ LIT2 01 -System/state ] DEO + / + #20 / + / + ;dict/spacer / + ;token/buf / + ;token/line LDA2 ;scope/buf !/ } + POP2 POP2 JMP2r + +@err/ ( adj* -- ) + .System/state DEI ?{ + [ LIT2 01 -System/state ] DEO + ;dict/Reference / + #20 / + / + ;dict/spacer / + [ LIT2 &ref $2 ] INC2k INC2 LDA2 #0003 ADD2 / + DUP2 #0008 ADD2 LDA2 SWP2 #0006 ADD2 LDA2 #0003 ADD2 !/ } + POP2 JMP2r + +@err/ ( line* scope* -- ) + ;dict/in / + / + LIT ": / + / + #0a / + JMP2r + +@err/ ( adj* keyword* topic* -- ) + .System/state DEI ?{ + [ LIT2 01 -System/state ] DEO + / + #20 / + SWP2 / + ;dict/spacer / + / + #0a / + JMP2r } + POP2 POP2 POP2 JMP2r + +@err/ ( str* -- ) + ;/ !hof/ + +@err/ ( short* -- ) + [ LIT2r ff00 ] + &>read + #000a DIV2k STH2k MUL2 SUB2 STH2r INCr ORAk ?&>read + POP2 + &>write + NIP #30 ADD / + OVRr ADDr STHkr ?&>write + POP2r JMP2r + +@dict/assembled "Assembled $1 &in 20 "in 20 $1 &bytes 20 "bytes. 0a $1 + &unused "-- 20 "Unused + &spacer ": 20 $1 + &References "References $1 + &Reference "Reference $1 + &Symbols "Symbols $1 + &Symbol "Symbol $1 + &Macros "Macros $1 + &Macro "Macro $1 + &Name "Name $1 + &Number "Number $1 + &Comment "Comment $1 + &Writing "Writing $1 + &exceeded "exceeded $1 + &invalid "invalid $1 + &duplicate "duplicate $1 + &too-far "too 20 "far $1 + &zero-page "zero-page $1 + &open "open $1 + &trail ".. $1 + &reset "RESET $1 + +( +@|Buffers ) + +@lambda/mem $200 + +@macros/mem ( name\0, value\0 ) + $1000 &memend + +@syms/mem ( addr*, SymType, name\0 ) + $7000 &memend +|syms/mem @refs/mem ( addr*, symbol*, type-fn*, scope*, line* ) + $7000 &memend + +@rom/mem ( zeropage ) + $100 + &output +( +@|Enums ) + + +|00 @SymType/empty $1 &used $1 &declared +