commit ad589d28941ec6abfb7e7f2e92f08ab8cd786c27 Author: Javier B. Torres Date: Thu Nov 27 16:39:54 2025 -0300 initial import diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..1d00f41 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +*.rom +*.rom.sym +/_build +/uxn-utils/uxnmin diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 0000000..ad02287 --- /dev/null +++ b/.ocamlformat @@ -0,0 +1,2 @@ +version = 0.28.1 +ocaml-version = 5.4.1 diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..530bc67 --- /dev/null +++ b/LICENSE @@ -0,0 +1,13 @@ +Copyright (c) 2025 Javier B. Torres + +Permission to use, copy, modify, and distribute this software for any +purpose with or without fee is hereby granted, provided that the above +copyright notice and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..89294a2 --- /dev/null +++ b/Makefile @@ -0,0 +1,6 @@ +.PHONY: utils clean + +utils: + $(MAKE) -C utils +clean: + $(MAKE) -C utils clean diff --git a/README.md b/README.md new file mode 100644 index 0000000..dc59278 --- /dev/null +++ b/README.md @@ -0,0 +1,5 @@ +# Uxn\_of\_ocaml + +An Uxn emulator library for OCaml 5 (as it uses effect handlers) + + diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..b8c7172 --- /dev/null +++ b/dune-project @@ -0,0 +1,19 @@ +(lang dune 3.20) + +(name uxn) + +(generate_opam_files true) + +(source + (codeberg lobo/uxn)) + +(authors "Javier B. Torres ") +(maintainers "Javier B. Torres ") + +(license LICENSE) + +(package + (name uxn) + (synopsis "Uxn emulator library for OCaml") + (description "Uxn emulator library for OCaml") + (depends ocaml)) diff --git a/exe/dune b/exe/dune new file mode 100644 index 0000000..a95ce30 --- /dev/null +++ b/exe/dune @@ -0,0 +1,4 @@ +(executable + (public_name uxnemu) + (name uxnemu) + (libraries uxn unix fmt)) diff --git a/exe/uxnemu.ml b/exe/uxnemu.ml new file mode 100644 index 0000000..52bcbeb --- /dev/null +++ b/exe/uxnemu.ml @@ -0,0 +1,82 @@ +open Uxn +open Effect.Deep + +let print_stack ?(name = "wst") (Machine.Stack stack) = + if stack.sp != 0 then + let stack = Bytes.to_seq stack.data |> Seq.take stack.sp |> Bytes.of_seq in + Fmt.epr "@[%s: [@[%a@]]@]@." name (Fmt.on_bytes (Fmt.octets ())) stack + +let print_instruction i pc = Fmt.epr "%6s (PC = %04x)@." (Instr.to_string i) pc +let debug = Option.is_some (Sys.getenv_opt "DBG") +let console_vector = ref 0 + +let dispatch = + if debug then + Machine.dispatch + ~dbg: + (Some + (fun m i pc -> + print_instruction i pc; + print_stack (Machine.wst m); + print_stack ~name:"rst" (Machine.rst m))) + else Machine.dispatch ~dbg:None + +let eval m pc = + let console_input mach ch ty k = + Bytes.set_uint8 (Machine.dev mach) 0x12 ch; + Bytes.set_uint8 (Machine.dev mach) 0x17 ty; + if !console_vector != 0 && Bytes.get_uint8 (Machine.dev mach) 0x0f = 0 then + continue k !console_vector + in + try dispatch m pc with + | effect Machine.BRK, k -> + if !console_vector != 0 then ( + try + while Bytes.get_uint8 (Machine.dev m) 0x0f = 0 do + match In_channel.input_char stdin with + | None -> raise Exit + | Some c -> console_input m (Char.code c) 1 k + done + with Exit -> + Bytes.set_uint8 (Machine.dev m) 0x12 0; + Bytes.set_uint8 (Machine.dev m) 0x17 4; + continue k !console_vector) + | effect Machine.DEI port, k -> + continue k (Bytes.get_uint8 (Machine.dev m) port) + | effect Machine.DEI2 port, k -> + continue k (Util.get_uint16_wrap (Machine.dev m) port) + | effect Machine.DEO (port, value), k -> + (match port with + | 0x10 -> console_vector := value + | 0x18 -> + print_char (Char.chr value); + Out_channel.flush stdout + | 0x19 -> + prerr_char (Char.chr value); + Out_channel.flush stderr + | _ -> ()); + continue k () + +let main () = + if Array.length Sys.argv < 2 then ( + Fmt.epr "usage: uxnemu file.rom ...\n"; + exit 1); + + let code = + In_channel.with_open_bin Sys.argv.(1) (fun i -> In_channel.input_all i) + in + In_channel.set_binary_mode stdin true; + Out_channel.set_binary_mode stdout true; + + let mach = Machine.create code in + Bytes.set_uint8 (Machine.dev mach) 0x17 0; + eval mach 0x100; + + if debug then ( + Fmt.epr "Execution ended:@."; + Machine.wst mach |> print_stack; + Machine.rst mach |> print_stack ~name:"rst"); + + Out_channel.flush_all () + +let _ = main () diff --git a/lib/Instr.ml b/lib/Instr.ml new file mode 100644 index 0000000..cb1ae7e --- /dev/null +++ b/lib/Instr.ml @@ -0,0 +1,73 @@ +let short_mask = 0x20 +let return_mask = 0x40 +let keep_mask = 0x80 +let opcode_mask = 0x1f + +let opcode_names = + [| + "BRK"; + "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"; + |] + +type t = + | Instruction of { short : bool; return : bool; keep : bool; opcode : int } + +let of_int (op : int) : t = + let has_mask mask = op land mask = mask in + let short = has_mask short_mask in + let return = has_mask return_mask in + let keep = has_mask keep_mask in + match op with + | 0x20 | 0x40 | 0x60 -> + Instruction { short = false; return = false; keep = false; opcode = op } + | 0x80 | 0xa0 | 0xc0 | 0xe0 -> + Instruction { short; return; keep = false; opcode = 0x80 } + | _ -> Instruction { short; return; keep; opcode = Int.logand op opcode_mask } + +let to_int (Instruction { opcode; short; keep; return } : t) : int = + let flags = if short then short_mask else 0 in + let flags = if return then Int.logor flags return_mask else flags in + let flags = if keep then Int.logor flags keep_mask else flags in + opcode lor flags + +let to_string (Instruction { opcode; short; keep; return } : t) : string = + Format.sprintf "%s%s%s%s" + (match opcode with + | 0x20 -> "JCI" + | 0x40 -> "JMI" + | 0x60 -> "JSI" + | 0x80 -> "LIT" + | _ -> opcode_names.(opcode)) + (if short then "2" else "") + (if keep then "k" else "") + (if return then "r" else "") diff --git a/lib/Instr.mli b/lib/Instr.mli new file mode 100644 index 0000000..5dd09b3 --- /dev/null +++ b/lib/Instr.mli @@ -0,0 +1,6 @@ +type t = + | Instruction of { short : bool; return : bool; keep : bool; opcode : int } + +val of_int : int -> t +val to_int : t -> int +val to_string : t -> string diff --git a/lib/Machine.ml b/lib/Machine.ml new file mode 100644 index 0000000..e9b5bb3 --- /dev/null +++ b/lib/Machine.ml @@ -0,0 +1,288 @@ +(* Unoptimized Uxn virtual machine. *) + +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 peek (Mode { short; keep; temp }) (Stack { data; sp }) : int = + let amt = if short then 2 else 1 in + let sp = if keep then (temp - amt) land 0xff else (sp - amt) land 0xff in + if short then Util.get_uint16_wrap data sp else Bytes.get_uint8 data sp +[@@inline] + +let pop (Mode m as m' : mode) (Stack s' as s : stack) = + let res = peek m' s in + let amt = if m.short then 2 else 1 in + if m.keep then m.temp <- (m.temp - amt) land 0xff + else s'.sp <- (s'.sp - amt) land 0xff; + res +[@@inline] + +let push (Mode ({ short; keep; _ } as m) : mode) (Stack s : stack) (v : int) = + if short then Util.set_uint16_wrap s.data s.sp (v land 0xffff) + else Bytes.set_uint8 s.data s.sp (v land 0xff); + let amt = if m.short then 2 else 1 in + if keep then m.temp <- (m.temp + amt) land 0xff; + s.sp <- (s.sp + amt) land 0xff +[@@inline] + +let pushbyte (Mode m) s v = + let m' = Mode { m with short = false } in + push m' s v; + let (Mode { temp; _ }) = m' in + 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 + let (Mode { temp; _ }) = m' in + m.temp <- temp; + r +[@@inline] + +let popshort (Mode m) s = + let m' = Mode { m with short = true } in + let r = pop m' s in + let (Mode { temp; _ }) = m' in + m.temp <- temp; + r +[@@inline] + +let pop1 s = pop (Mode { short = false; keep = false; temp = 0 }) s [@@inline] + +let push1 s v = push (Mode { short = false; keep = false; temp = 0 }) s v +[@@inline] + +let push2 s v = push (Mode { short = true; keep = false; temp = 0 }) s v +[@@inline] + +type machine = + | Machine of { data : bytes; dev : bytes; stack : stack; callstack : stack } + +type _ Effect.t += + | BRK : int Effect.t + | DEI : int -> int Effect.t + | DEI2 : int -> int Effect.t + | DEO : (int * int) -> unit Effect.t + +type machine_state = Break | Next of int + +let ram (Machine { data; _ }) = data +let dev (Machine { dev; _ }) = dev +let wst (Machine { stack; _ }) = stack +let rst (Machine { callstack; _ }) = callstack + +let stack (Machine { stack; callstack; _ }) mode = + if mode then callstack else stack + +let create code = + let data = Bytes.create 65536 in + let dev = Bytes.create 256 in + Bytes.unsafe_fill data 0 65536 '\x00'; + Bytes.unsafe_fill dev 0 256 '\x00'; + Bytes.blit_string code 0 data 0x100 (String.length code); + Machine { data; dev; stack = stack_create (); callstack = stack_create () } + +let dispatch ?(dbg = None) ?(cycles = 65536) (Machine m) (pc : int) : unit = + let cycles = ref cycles in + let pc = ref pc in + while !cycles > 0 do + decr cycles; + + pc := !pc land 0xffff; + + let op = Bytes.get_uint8 m.data !pc in + let instr = Instr.of_int op in + (match dbg with Some dbg -> dbg (Machine m) instr !pc | None -> ()); + + pc := (!pc + 1) land 0xffff; + + match op with + | 0x00 -> pc := perform BRK + | 0x20 (* JCI *) -> + let cond = pop1 m.stack in + let addr = Util.get_int16_wrap ~wrap:0xffff m.data !pc in + if cond != 0 then pc := !pc + addr + 2 else pc := !pc + 2 + | 0x40 (* JMI *) -> + let addr = Util.get_int16_wrap ~wrap:0xffff m.data !pc in + pc := !pc + addr + 2 + | 0x60 (* JSI *) -> + let addr = Util.get_int16_wrap ~wrap:0xffff m.data !pc in + push2 m.callstack (!pc + 2); + pc := !pc + addr + 2 + | 0x80 (* LIT *) -> + push1 m.stack (Bytes.get_uint8 m.data !pc); + pc := !pc + 1 + | 0xa0 (* LIT2 *) -> + push2 m.stack (Util.get_uint16_wrap ~wrap:0xffff m.data !pc); + pc := !pc + 2 + | 0xc0 (* LITr *) -> + push1 m.callstack (Bytes.get_uint8 m.data !pc); + pc := !pc + 1 + | 0xe0 (* LIT2r *) -> + push2 m.callstack (Util.get_uint16_wrap ~wrap:0xffff m.data !pc); + pc := !pc + 2 + | _ -> begin + let (Instruction { short; keep; return; opcode }) = Instr.of_int op in + let stk = if return then m.callstack else m.stack in + let stk' = if return then m.stack else m.callstack in + let mode = + Mode { short; keep; temp = (match stk with Stack { sp; _ } -> sp) } + in + let deo port value = perform (DEO (port, value)) in + let dei port = + if short then perform (DEI2 port) else perform (DEI port) + in + match[@warning "-8"] opcode with + | 0x01 (* INC *) -> + let r = pop mode stk in + push mode stk (r + 1) + | 0x02 (* POP *) -> ignore (pop mode stk) + | 0x03 (* NIP *) -> + let b = pop mode stk in + let _ = pop mode stk in + push mode stk b + | 0x04 (* SWP *) -> + let b = pop mode stk in + let a = pop mode stk in + push mode stk b; + push mode stk a + | 0x05 (* ROT *) -> + let c = pop mode stk in + let b = pop mode stk in + let a = pop mode stk in + push mode stk b; + push mode stk c; + push mode stk a + | 0x06 (* DUP *) -> + let a = peek mode stk in + push mode stk a + | 0x07 (* OVR *) -> + let b = pop mode stk in + let a = pop mode stk in + push mode stk a; + push mode stk b; + push mode stk a + | 0x08 (* EQU *) -> + let b = pop mode stk in + let a = pop mode stk in + pushbyte mode stk (if a = b then 1 else 0) + | 0x09 (* NEQ *) -> + let b = pop mode stk in + let a = pop mode stk in + pushbyte mode stk (if a != b then 1 else 0) + | 0x0a (* GTH *) -> + let b = pop mode stk in + let a = pop mode stk in + pushbyte mode stk (if a > b then 1 else 0) + | 0x0b (* GTH *) -> + let b = pop mode stk in + let a = pop mode stk in + pushbyte mode stk (if a < b then 1 else 0) + | 0x0c (* JMP *) -> + let addr = pop mode stk in + if short then pc := addr else pc := !pc + Util.uint8_to_int8 addr + | 0x0d (* JCN *) -> + let addr = pop mode stk in + let cond = popbyte mode stk in + if cond != 0 then + if short then pc := addr else pc := !pc + Util.uint8_to_int8 addr + | 0x0e (* JSR *) -> + push2 m.callstack !pc; + let addr = pop mode stk in + if short then pc := addr else pc := !pc + Util.uint8_to_int8 addr + | 0x0f (* STH *) -> ( + let a = pop mode stk in + match mode with + | Mode mode -> + push + (Mode + { + mode with + temp = (match stk' with Stack { sp; _ } -> sp); + }) + stk' a) + | 0x10 (* LDZ *) -> + let addr = popbyte mode stk in + push mode stk + (if short then Util.get_uint16_wrap m.data addr + else Bytes.get_uint8 m.data addr) + | 0x11 (* STZ *) -> + let addr = popbyte mode stk in + let v = pop mode stk in + if short then Util.set_uint16_wrap m.data addr v + else Bytes.set_uint8 m.data addr v + | 0x12 (* LDR *) -> + let addr = !pc + Util.uint8_to_int8 (popbyte mode stk) in + push mode stk + (if short then Util.get_uint16_wrap ~wrap:0xffff m.data addr + else Bytes.get_uint8 m.data addr) + | 0x13 (* STR *) -> + let addr = !pc + Util.uint8_to_int8 (popbyte mode stk) in + let v = pop mode stk in + if short then Util.set_uint16_wrap ~wrap:0xffff m.data addr v + else Bytes.set_uint8 m.data addr v + | 0x14 (* LDA *) -> + let addr = popshort mode stk in + push mode stk + (if short then Util.get_uint16_wrap ~wrap:0xffff m.data addr + else Bytes.get_uint8 m.data addr) + | 0x15 (* STA *) -> + let addr = popshort mode stk in + let v = pop mode stk in + if short then Util.set_uint16_wrap ~wrap:0xffff m.data addr v + else Bytes.set_uint8 m.data addr v + | 0x16 (* DEI *) -> + let port = popbyte mode stk in + push mode stk (dei port) + | 0x17 (* DEO *) -> + let port = popbyte mode stk in + let value = pop mode stk in + if short then Util.set_uint16_wrap m.dev port value + else Bytes.set_uint8 m.dev port value; + deo port value + | 0x18 (* ADD *) -> + let b = pop mode stk in + let a = pop mode stk in + push mode stk (a + b) + | 0x19 (* SUB *) -> + let b = pop mode stk in + let a = pop mode stk in + push mode stk (a - b) + | 0x1a (* MUL *) -> + let b = pop mode stk in + let a = pop mode stk in + push mode stk (a * b) + | 0x1b (* DIV *) -> + let b = pop mode stk in + let a = pop mode stk in + push mode stk (if b = 0 then 0 else a / b) + | 0x1c (* AND *) -> + let b = pop mode stk in + let a = pop mode stk in + push mode stk (a land b) + | 0x1d (* ORA *) -> + let b = pop mode stk in + let a = pop mode stk in + push mode stk (a lor b) + | 0x1e (* EOR *) -> + let b = pop mode stk in + let a = pop mode stk in + push mode stk (a lxor b) + | 0x1f (* SFT *) -> + let sft = popbyte mode stk in + let a = pop mode stk in + push mode stk ((a lsr (sft land 0xf)) lsl sft lsr 4) + end + done diff --git a/lib/Machine.mli b/lib/Machine.mli new file mode 100644 index 0000000..9837253 --- /dev/null +++ b/lib/Machine.mli @@ -0,0 +1,36 @@ +type stack = Stack of { data : bytes; mutable sp : int } +type mode = Mode of { short : bool; keep : bool; mutable temp : int } + +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 + +val ram : machine -> bytes +val dev : machine -> bytes +val wst : machine -> stack +val rst : machine -> stack +val stack : machine -> bool -> stack + +type machine_state = Break | Next of int + +type _ Effect.t += + | BRK : int Effect.t (* Returns a new PC if handled *) + | DEI : int -> int Effect.t + | DEI2 : int -> int Effect.t + | DEO : (int * int) -> unit Effect.t + +val create : string -> machine + +val dispatch : + ?dbg:(machine -> Instr.t -> int -> unit) option -> + ?cycles:int -> + machine -> + int -> + unit diff --git a/lib/Util.ml b/lib/Util.ml new file mode 100644 index 0000000..81f3531 --- /dev/null +++ b/lib/Util.ml @@ -0,0 +1,17 @@ +let uint8_to_int8 i = (i lsl (Sys.int_size - 8)) asr (Sys.int_size - 8) +let uint16_to_int16 i = (i lsl (Sys.int_size - 16)) asr (Sys.int_size - 16) + +let get_uint16_wrap ?(wrap = 0xff) (bytes : bytes) (position : int) : int = + let i0 = position land wrap in + let hi = Bytes.get_uint8 bytes i0 in + let lo = Bytes.get_uint8 bytes ((i0 + 1) land wrap) in + (hi lsl 8) lor lo + +let get_int16_wrap ?(wrap = 0xff) (bytes : bytes) (position : int) : int = + get_uint16_wrap ~wrap bytes position |> uint16_to_int16 + +let set_uint16_wrap ?(wrap = 0xff) (bytes : bytes) (position : int) + (value : int) : unit = + let i0 = position land wrap in + Bytes.set_uint8 bytes i0 ((value lsr 8) land 0xff); + Bytes.set_uint8 bytes ((i0 + 1) land wrap) (value land 0xff) diff --git a/lib/Util.mli b/lib/Util.mli new file mode 100644 index 0000000..adb8f59 --- /dev/null +++ b/lib/Util.mli @@ -0,0 +1,5 @@ +val uint8_to_int8 : int -> int +val uint16_to_int16 : int -> int +val get_uint16_wrap : ?wrap:int -> bytes -> int -> int +val get_int16_wrap : ?wrap:int -> bytes -> int -> int +val set_uint16_wrap : ?wrap:int -> bytes -> int -> int -> unit diff --git a/lib/Varvara.ml b/lib/Varvara.ml new file mode 100644 index 0000000..e69de29 diff --git a/lib/dune b/lib/dune new file mode 100644 index 0000000..248d9cc --- /dev/null +++ b/lib/dune @@ -0,0 +1,2 @@ +(library + (name uxn)) diff --git a/utils/LICENSE b/utils/LICENSE new file mode 100644 index 0000000..d0716ec --- /dev/null +++ b/utils/LICENSE @@ -0,0 +1,13 @@ +Copyright (c) 2020-2025 Devine Lu Linvega + +Permission to use, copy, modify, and distribute this software for any +purpose with or without fee is hereby granted, provided that the above +copyright notice and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. diff --git a/utils/Makefile b/utils/Makefile new file mode 100644 index 0000000..fbe5a68 --- /dev/null +++ b/utils/Makefile @@ -0,0 +1,19 @@ +.PHONY: all clean +.SUFFIXES: .tal .rom + +all: uxnmin drifloon.rom opctest.rom +clean: + rm -f uxnmin drifloon.rom opctest.rom + +uxnmin: uxnmin.c +drifloon.rom: uxnmin + xxd -r -p drifloon.rom.txt drifloon-seed.rom + ./uxnmin drifloon-seed.rom < drifloon.tal > drifloon.rom + cmp drifloon.rom drifloon-seed.rom + rm drifloon-seed.rom + +.tal.rom: + sh assemble.sh $< $@ + +#opctest.rom: uxnmin drifloon.rom opctest.tal +# ./uxnmin drifloon.rom < opctest.tal > opctest.rom diff --git a/utils/assemble.sh b/utils/assemble.sh new file mode 100644 index 0000000..7bd01d7 --- /dev/null +++ b/utils/assemble.sh @@ -0,0 +1,4 @@ +#!/bin/sh +make -q uxnmin +make -q drifloon.rom +./uxnmin drifloon.rom < $1 > $2 diff --git a/utils/console.tal b/utils/console.tal new file mode 100644 index 0000000..a007f1f --- /dev/null +++ b/utils/console.tal @@ -0,0 +1,82 @@ +( usage: uxncli console.rom foo "bar baz" +| Prints Welcome to Uxn!, and listens for incoming stdin events on enter. ) + +|10 @Console &vector $2 &read $1 &pad $4 &type $1 &write $1 &error $1 + +|000 + + @arg $40 + @std $40 + +|100 + +@on-reset ( -> ) + ;dict/hello + .Console/type DEI ?{ + ( | no arguments ) + ;on-std .Console/vector DEO2 + BRK } + ;on-arg .Console/vector DEO2 + BRK + +@on-arg ( -> ) + [ LIT2 02 -Console/type ] DEI NEQ ?{ + .Console/read DEI [ LIT2 00 &ptr -arg ] INCk ,&ptr STR + STZ2 + BRK } + ;arg ;dict/yousent + [ LIT2 -arg _&ptr ] STR + [ LIT2 04 -Console/type ] DEI NEQ ?{ ;on-std .Console/vector DEO2 } + BRK + +@on-std ( -> ) + [ LIT2 0a -Console/read ] DEI EQU ?{ + .Console/read DEI [ LIT2 00 &ptr -std ] INCk ,&ptr STR + STZ2 + BRK } + ;std DUP2 ;dict/yousaid + ;dict/quit scmp ?{ + [ LIT2 -std _&ptr ] STR + BRK } + ( quit ) #800f DEO + BRK + +@ ( buf* name* -- ) + + [ LIT2 "" 18 ] DEO + / + [ LIT2 "" 18 ] DEO + [ LIT2 00 -Console/type ] DEI DUP ADD ;Types ADD2 LDA2 / + #0a18 DEO + JMP2r + +@ ( str* -- ) + LDAk #18 DEO + INC2 & LDAk ? + POP2 JMP2r + +@scmp ( a* b* -- f ) + STH2 + &l ( a* b* -- f ) + LDAk LDAkr STHr NEQk ?&d + DUP EOR EQUk ?&d + POP2 INC2 INC2r !&l + + &d ( a* c1 c2 b* -- f ) + NIP2 POP2r EQU JMP2r + +( +@|assets ) + +@Types =dict/arg-none =dict/arg-stdin =dict/arg-data =dict/arg-spacer =dict/arg-end + +@dict + &hello "Welcome 20 "to 20 "Uxn! 0a $1 + &yousaid "You 20 "said: 20 $1 + &yousent "You 20 "sent: 20 $1 + &quit "quit $1 + &arg-none " $1 + &arg-stdin " $1 + &arg-data " $1 + &arg-spacer " $1 + &arg-end " $1 diff --git a/utils/drifloon.rom.txt b/utils/drifloon.rom.txt new file mode 100644 index 0000000..d5a1fb3 --- /dev/null +++ b/utils/drifloon.rom.txt @@ -0,0 +1,155 @@ +a001 6380 0637 a00a a560 0233 a001 1380 +1037 00a0 0417 1608 2000 0780 1216 6001 +cf00 6000 7a00 a093 ab38 156c a009 ff60 +08a7 a00a 0960 08a1 a008 8034 26a0 0100 +3960 089b a00a 0e60 088f a093 ab38 a094 +ab94 8018 1721 aa20 fff7 2222 6c22 6c80 +1917 6c00 4472 6966 6c6f 6f6e 0a55 786e +7461 6c20 4173 7365 6d62 6c65 720a 4279 +2044 6576 696e 6520 4c75 204c 696e 7665 +6761 0a38 204e 6f76 2032 3032 3500 0080 +0a60 014c 8047 32a0 022c 2920 000c a00a +9da0 0aa2 a00a 6060 07f6 8031 32a0 026e +2920 000c a00a 9da0 0aa2 a00a 4e60 07e0 +800f 1620 0010 6005 b280 0f16 2000 07a0 +800f 1740 049d 6c90 2000 0222 6ca0 01f9 +2ca0 01f9 a001 ee35 6c60 06f6 2006 2860 +0253 2006 0d90 6001 66a1 1d20 000e 2226 +6000 a7a1 1d20 00c2 2240 01d6 2134 2c22 +a002 2ca0 01ee 35a0 0104 136c 3426 c000 +a028 0028 0f58 a029 0028 0f59 cfc0 ef53 +2000 0340 ffab 6c60 0322 6000 4d80 0060 +004e a002 5aa0 01ee 356c 34a0 7b00 2920 +000b a002 6ea0 01ee 35a0 0104 136c b426 +c000 807b 0804 807b 081d 0f58 a07d 0028 +0f59 cfc0 eb53 2000 0922 8000 6000 1140 +ff5f 6000 0580 2040 0006 a002 a040 05f7 +a00b aba1 26a0 1bab 2b20 0009 a00a 70a0 +0a47 6006 7680 e933 156c 2f80 e332 a00b +ab26 ef60 0647 2000 0e60 0637 6006 34aa +20ff ee22 a0ff ff23 626c 2360 0009 6006 +22a0 02f0 4005 b0a0 4024 13a0 0040 116c +0680 200a 2000 16a0 0040 60fe ea80 0a09 +2000 07a0 0001 2180 fa33 40ff daa0 0040 +8106 807f 0b20 0009 a00a 70a0 0a54 6006 +0a80 eb13 316c a000 0081 0680 3f0b 2000 +09a0 0a70 a00a 4060 05f1 80eb 1331 6ca0 +00e5 1394 802f 0820 0009 9460 ffd8 2194 +20ff f022 80d1 1280 0313 6c21 a000 c813 +802f 60ff c1a0 0000 24a0 0326 4005 280f +a004 1594 cf08 2000 0ca0 0003 3894 20ff +f222 a0ff ff42 6c22 6c22 4001 c840 fe8f +6000 7040 feb1 6000 6a60 02c7 4004 f460 +0061 6002 be40 04e7 6000 5826 60ff 9040 +020f 60ff a640 0209 8080 6004 a560 0043 +6003 a140 049c 8080 6004 9760 0035 6003 +8540 048e 80a0 6004 8960 0027 6003 7f40 +047c 6000 1e80 2040 046e 6000 1680 4040 +0466 8060 4004 6160 0009 4004 1b60 0003 +4004 0921 9480 200a 2000 09a0 0a79 a00a +5440 0517 6c7c 0396 2403 9f40 03a8 2603 +b22c 03b8 5f03 bd2e 03c6 2d03 cb3b 03d4 +3d03 d921 03ea 3f03 e223 03f7 2203 fd7d +0389 7e01 5d28 038d 2903 875b 0387 5d03 +8725 0390 0026 6000 0e80 0009 0f26 a005 +2f60 04a9 4f1d 6ce0 1f00 a004 cfa4 a000 +0324 6004 9f20 000f 41a0 0003 3894 20ff +ec22 2262 8000 6c22 5cb4 a04c 4928 8070 +1f0f 5da0 0003 3894 8021 0b20 002e 9480 +3209 2000 05c0 2040 001d 9480 7209 2000 +05c0 4040 0011 9480 6b09 2000 05c0 8040 +0005 2242 8000 6c5d 2140 ffcb 224f 6c4c +4954 494e 4350 4f50 4e49 5053 5750 524f +5444 5550 4f56 5245 5155 4e45 5147 5448 +4c54 484a 4d50 4a43 4e4a 5352 5354 484c +445a 5354 5a4c 4452 5354 524c 4441 5354 +4144 4549 4445 4f41 4444 5355 424d 554c +4449 5641 4e44 4f52 4145 4f52 5346 5442 +524b 0022 8000 8180 fb13 06a0 0aab a180 +fa33 1506 8004 1f60 035d 0460 0359 8018 +33a0 0567 6c80 e432 a000 0139 9460 ffe3 +6000 5e80 d633 6cce bb2e 2e00 6003 8320 +0027 9480 7b08 2000 2094 60fd f221 1d20 +0017 2660 fd34 211d 2000 1726 6000 9721 +1d20 000e 60fe be0c 6ca0 0a79 a00a 5440 +0389 a00a 81a0 0a54 4003 8094 807b 0820 +ff81 9480 2f08 20fd a294 8026 0820 fd9b +6c26 6000 61a1 1d20 0010 22a0 060d 3460 +0226 8002 6002 b440 001d 2326 6002 1960 +0103 2000 0860 02a3 2735 4001 1022 a00a +81a0 0a40 4003 3404 6000 1160 000e 6000 +0b60 ff68 a006 0c60 028d 8000 a04b aba1 +26a0 93ab 2b20 0009 a00a 70a0 0a38 6003 +0a80 e933 156c 2f80 e332 a04b ab26 a000 +0338 ef60 02d7 2000 0fa0 0003 3860 02c3 +aa20 ffe9 22a0 ffff 2362 6c26 60ff d7a1 +1d20 000d 2280 b532 2480 01a0 ffff 40ff +9623 6c60 028c 2002 6b60 ff3f 60ff b760 +006b 2000 09a0 0a79 a00a 4060 02ad 6000 +7234 6ca0 060d 34a0 4bab a820 0037 6000 +5b20 0027 b4a0 0100 2820 001f 26a0 0003 +3894 8041 1980 1a0b 2000 0fa0 0a17 6003 +2826 6003 2480 0a60 faa5 22a0 0003 3860 +0241 40ff c522 2240 fa62 26a0 0080 3802 +2000 016c a00a 8ba0 0a40 4002 4ea1 1d20 +0003 8000 6ca1 2114 8002 1c6c a121 1480 +011c 6ca1 21af 1480 011d 6f15 6c21 21af +1480 021d 6f15 6c80 1733 60fe 9e60 ff3b +60ff d220 001d 2660 0171 6000 1b60 0018 +a000 0060 0012 a000 0060 000c a003 0434 +6000 0560 ffbd 346c 0460 0000 a01b aba1 +26a0 4bab 2b20 0009 a00a 70a0 0a23 6001 +da80 e933 156c a007 bf60 ffab 036c a007 +c740 ffa3 a007 ce60 ff9d a11d 2000 0422 +8000 6c60 0115 6000 0e60 ff4e 036c a007 +dd60 ff83 6001 0421 2139 6c80 af32 a01b +aba8 2000 1326 a009 7835 a6a0 0004 3834 +2ea0 000a 3840 ffe9 2222 6cb4 6000 e4a1 +2134 34a1 1d20 0006 a00a 7940 019b 6c60 +ffe9 2303 4000 9b60 ffe1 2340 0090 60ff +da24 3460 ffb1 6000 0f03 4000 8560 ffcb +2434 60ff a240 0076 26a0 0080 3802 2000 +016c a00a 8b40 0161 26a0 0003 3834 a0ce +bb29 2000 0222 6ca0 0727 356c a008 6240 +0085 60fc 5240 004a 6000 ce80 0209 8050 +1f80 801d 6000 3b60 00c8 8000 0820 001e +6000 b606 8002 0920 0008 0260 0096 0340 +0020 8004 0920 0006 6000 8940 0010 22a0 +0a79 a00a 5940 00d3 6000 0760 ff20 0460 +0000 6000 1207 2000 0b22 02a0 0a93 a00a +6840 00b7 40f8 afa0 0100 a180 fa33 a1a0 +0100 2b20 0004 a180 f633 6c80 ea32 6c60 +fff9 3880 e233 6c2f 9406 2000 0402 2262 +6cef 2e21 40ff f180 0f1c 800a 8b20 0005 +1980 6118 6c02 8030 186c 9480 3019 0680 +090a 0c6c 8027 1906 800a 1980 050a 0c6c +0280 ff6c e000 00c0 407f 60ff ddc0 000f +7821 9420 fff1 226f 6ca6 6000 1624 2139 +036c 2660 ffc4 0120 0005 1480 0008 6c21 +40ff f094 2000 0221 6c21 40ff f6a6 60ff +f224 3924 2f27 3824 a820 000c 94d4 4f09 +2000 0521 6140 fff0 6228 6c80 0f16 2000 +25a0 010f 1760 00a1 8020 60f8 2260 0099 +a00a 2060 0093 a000 4060 008d a003 0434 +a000 0040 0043 2222 6c80 0f16 2000 38a0 +010f 17a0 0a2e 6000 7080 2060 f7f1 6000 +68a0 0a20 6000 62a0 0000 a121 34a0 0003 +3860 0055 26a0 0008 3834 24a0 0006 3834 +a000 0338 4000 0222 6ca0 0a09 6000 3a60 +0037 803a 60f7 b860 0035 800a 60f7 b06c +800f 1620 001f a001 0f17 6000 1c80 2060 +f79d 2460 0013 a00a 2060 000d 6000 0a80 +0a60 f78b 6c22 2222 6ca0 015f 40fe b8e0 +ff00 a000 0abb af3a 396f 419d 20ff f322 +0380 3018 60f7 6847 58cf 20ff f362 6c41 +7373 656d 626c 6564 0020 696e 2000 2062 +7974 6573 2e0a 002d 2d20 556e 7573 6564 +3a20 0052 6566 6572 656e 6365 7300 5265 +6665 7265 6e63 6500 5379 6d62 6f6c 7300 +5379 6d62 6f6c 004d 6163 726f 7300 4d61 +6372 6f00 4e61 6d65 004e 756d 6265 7200 +436f 6d6d 656e 7400 5772 6974 696e 6700 +6578 6365 6564 6564 0069 6e76 616c 6964 +0064 7570 6c69 6361 7465 0074 6f6f 2066 +6172 007a 6572 6f2d 7061 6765 006f 7065 +6e00 2e2e 0052 4553 4554 diff --git a/utils/drifloon.tal b/utils/drifloon.tal new file mode 100644 index 0000000..bfef597 --- /dev/null +++ b/utils/drifloon.tal @@ -0,0 +1,732 @@ +( 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 + +|000 + + @scope/buf $3f &cap $1 + @token/buf $3f &cap $1 + +|100 + +@on-reset ( -> ) + ;meta #06 DEO2 + ;dict/reset scope/ + ;assembly/on-console .Console/vector DEO2 + BRK + +@assembly/on-console ( -> ) + [ LIT2 04 -Console/type ] DEI EQU ?{ .Console/read DEI token/ + BRK } + / + BRK + +@rom/ ( byte addr* -- ) + ;&mem ADD2 STA + JMP2r + +@rom/ ( -- ) + ;dict/assembled err/ + ;dict/in err/ + ;head/length LDA2 DUP2 #0100 SUB2 err/ + ;dict/bytes err/ + ( | write ) + ;rom/mem ADD2 ;rom/output + &>l + LDAk #18 DEO + INC2 GTH2k ?&>l + POP2 POP2 JMP2r + +@runes/concat ( t* -- ) + POP2 JMP2r + +@err/ ( c -- ) + #19 DEO JMP2r + +@meta $1 + ( name ) "Drifloon 0a + ( desc ) "Uxntal 20 "Assembler 0a + ( auth ) "By 20 "Devine 20 "Lu 20 "Linvega 0a + ( date ) "8 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 [ LIT &count $1 ] INCk ,&count STR + DUP [ LIT2 &ptr =&mem ] INC2k ,&ptr STR2 + STA + ( >> ) + +@lambda/name ( id -- str* ) + DUP #04 SFT hexc SWP hexc ,&id STR2 + ;&sym JMP2r + +@lambda/pop ( -- ) + ,&ptr LDR2 #0001 SUB2 LDAk /name syms/ + ,&ptr STR2 + JMP2r + &sym cebb + &id ".. $1 + +( +@|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 ;&memend 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 + ( addr* ) / + ( symbol* ) / + ( type-fn* ) [ LIT2 &type $2 ] / + ( scope* ) [ LIT2 &scope $2 ] / + ( line* ) ;token/line LDA2 / } + ( | mark as used ) + syms/use LDA2 JMP2r + +@refs/ ( value* -- ) + SWP / + ( >> ) + +@refs/ ( byte -- ) + [ LIT2 &ptr =&mem ] INC2k + ( | check overflow ) + DUP2 ;&memend LTH2 ?{ + ( ! ) ;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 ;&mem + &>l + EQU2k ?{ + DUP2 ;err/ref STA2 + DUP2k #0004 ADD2 LDA2 JSR2 + ( ) #000a ADD2 !&>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 $100 + +@macros/mem ( name\0, value\0 ) + $1000 &memend + +@refs/mem ( addr*, symbol*, type-fn*, scope*, line* ) + $3000 &memend + +@syms/mem ( addr*, SymType, name\0 ) + $4800 &memend + +@rom/mem ( zeropage ) + $100 + &output +( +@|Enums ) + + +|00 @SymType/empty $1 &used $1 &declared diff --git a/utils/opctest.tal b/utils/opctest.tal new file mode 100644 index 0000000..fe90997 --- /dev/null +++ b/utils/opctest.tal @@ -0,0 +1,509 @@ +|0013 + + @Zeropage &byte $1 &short $2 + @id $1 + +|100 + +@on-reset ( -> ) + + ( part 1 + > LIT2: Puts a short on the stack + > LIT: Puts a byte on the stack + > #06 DEO: Write to metadata ports + > #18 DEO: Write a letter in terminal ) + + ;meta #06 DEO2 + [ LIT2 "kO ] #18 DEO #18 DEO + [ LIT2 "1 18 ] DEO #0a18 DEO + + ( part 2 + > LITr: Put a byte on return stack + > STH: Move a byte from working stack to return stack + > STH2r: Move a short from return stack to working stack ) + + [ LITr "k ] [ LIT "O ] STH STH2r #18 DEO #18 DEO + [ LIT2 "2 18 ] DEO #0a18 DEO + + ( part 3 + > LIT2r: Put a short on return stack + > DUP: Duplicate byte + > ADDr: Add bytes on return stack ) + + [ LIT2r "k 4d ] #01 DUP STH ADDr STH ADDr STH2r #18 DEO #18 DEO + [ LIT2 "3 18 ] DEO #0a18 DEO + + ( part 4 + > JSI: Subroutine to relative short address + > JMP2r: Jumps to absolute address on return stack ) + + subroutine + [ LIT2 "4 18 ] DEO #0a18 DEO + + ( part 5 + > POP2: Removes a short from the stack + > INC2: Increments short on stack + > DUP2: Duplicate short + > LDA: load byte from absolute address + > JCI: Conditional subroutine to relative short address ) + + ;Dict/ok pstr + [ LIT2 "5 18 ] DEO #0a18 DEO + + ( part 6 + > JSR2: Jump to subroutine from short pointer + > LDAk: Non-destructive load byte from absolute address ) + + { "Ok $1 } STH2r ;pstr-jcn JSR2 + [ LIT2 "6 18 ] DEO #0a18 DEO + + ( part 7 + > Relative distance bytes ) + + rel-distance/entry SWP #18 DEO #18 DEO + [ LIT2 "7 18 ] DEO #0a18 DEO + + ( part xx + > GTH2k: Non-destructive greater-than short + > LDA2k: Non-destructive load short from absolute address + > STA2: Store short at absolute address ) + + [ LIT2r 0000 ] + ;tests/end ;tests + &l + run-test [ LITr 00 ] STH ADD2r + INC2 INC2 GTH2k ?&l + POP2 POP2 + STH2r ;tests/end ;tests SUB2 #01 SFT2 + EQU2 ;Dict/opctests test-part + + ( Part xx + > Testing that stacks are circular and wrapping + > Storing 12 at -1 and 34 at 0 ) + + POP #12 #34 ADD #46 EQU STH + POP #1234 ADD #46 EQU STH + POP2 #1111 #2222 ADD2 #3333 EQU2 + STHr AND STHr AND + ;Dict/stack-wrap test-part + + ( restore stack ) #0000 #0000 + + ( Part xx + > Testing RAM wrapping + > Storing 12 in 0xffff, and 34 in 0x0000 ) + + #1234 #ffff STA2 + ( LDA ) #0000 LDA #ffff LDA ADD #46 EQU + ( LDA2 ) #ffff LDA2 ADD #46 EQU + AND ;Dict/ram-wrap test-part + + ( Part xx + > Testing PC wrapping: split instruction + > Storing 80[LIT] in 0xffff, and 55[val8] in 0x0000 + > Storing 6c[JMP2r] in 0x0001 ) + + #8055 #ffff STA2 #6c #01 STZ #ffff JSR2 #55 EQU + ;Dict/pc-wrap test-part + + ( Part xx + > Testing PC wrapping: split value after instruction + > Storing a0[LIT2] in 0xfffe, + > and 0x55[hi-byte] in 0xffff, and 0xaa[lo-byte] in 0x0000 + > Storing 6c[JMP2r] in 0x0001 ) + + #a055 #fffe STA2 #aa6c #0000 STA2 #fffe JSR2 #55aa EQU2 + ;Dict/pc2-wrap test-part + + ( Part xx + > Testing that zero-page is wrapping ) + + #5678 #ff STZ2 + ( LDZ ) #00 LDZ #ff LDZ ADD #ce EQU + ( LDZ2 ) #ff LDZ2 ADD #ce EQU + AND ;Dict/zp-wrap test-part + + ( Part xx + > Testing that device page is wrapping ) + + #1234 #ff DEO2 + ( DEI ) #00 DEI #ff DEI ADD #46 EQU + ( DEI2 ) #ff DEI2 ADD #46 EQU + AND ;Dict/dev-wrap test-part + #0000 DEO #00ff DEO + + ( end ) + + [ LIT &fail 80 ] + DUP #80 EQU ;Dict/result test-part + #0f DEO + + #0a18 DEO + #010e DEO + +BRK + +( +@|metadata ) + +@meta 00 + ( name ) "Opctest 0a + ( details ) "A 20 "Testing 20 "Program 0a + ( author ) "By 20 "Devine 20 "Lu 20 "Linvega 0a + ( date ) "24 20 "Jun 20 "2025 $2 + +@test-part ( f name* -- ) + pstr ?{ + #01 ;on-reset/fail STA + ;Dict/failed !pstr } + ;Dict/passed !pstr + +@run-test ( addr* -- addr* f ) + + LDA2k JSR2 DUP ?&pass + ;Dict/missed pstr + [ LIT2 &name $2 ] pstr + [ LIT2 "# 18 ] DEO + [ LIT2 "a -id ] LDZ ADD #18 DEO + #0a18 DEO + #01 ;on-reset/fail STA + &pass + .id LDZ INC .id STZ + +JMP2r + +@set ( name* -- f ) + + ;run-test/name STA2 #01 + [ LIT2 ff -id ] STZ + +JMP2r + +@pstr ( str* -- ) + DUP2 LDA + DUP ?{ POP POP2 JMP2r } + #18 DEO + INC2 !pstr + +@pstr-jcn ( str* -- ) + LDAk #18 DEO + INC2 LDAk ,pstr-jcn JCN + POP2 + JMP2r + +@tests +=op-equ [ + =op-equ/a =op-equ/b =op-equ/c =op-equ/d + =op-equ/e =op-equ/f =op-equ/g =op-equ/h ] +=op-neq [ + =op-neq/a =op-neq/b =op-neq/c =op-neq/d + =op-neq/e =op-neq/f =op-neq/g =op-neq/h ] +=op-gth [ + =op-gth/a =op-gth/b =op-gth/c =op-gth/d + =op-gth/e =op-gth/f =op-gth/g =op-gth/h ] +=op-lth [ + =op-lth/a =op-lth/b =op-lth/c =op-lth/d + =op-lth/e =op-lth/f =op-lth/g =op-lth/h ] +=op-add [ + =op-add/a =op-add/b =op-add/c =op-add/d + =op-add/e =op-add/f =op-add/g =op-add/h ] +=op-sub [ + =op-sub/a =op-sub/b =op-sub/c =op-sub/d + =op-sub/e =op-sub/f =op-sub/g =op-sub/h ] +=op-mul [ + =op-mul/a =op-mul/b =op-mul/c =op-mul/d + =op-mul/e =op-mul/f =op-mul/g =op-mul/h ] +=op-div [ + =op-div/a =op-div/b =op-div/c =op-div/d =op-div/e + =op-div/f =op-div/g =op-div/h =op-div/i =op-div/j ] +=op-inc [ + =op-inc/a =op-inc/b =op-inc/c =op-inc/d + =op-inc/e =op-inc/f =op-inc/g =op-inc/h ] +=op-pop [ + =op-pop/a =op-pop/b =op-pop/c =op-pop/d + =op-pop/e =op-pop/f =op-pop/g =op-pop/h ] +=op-dup [ + =op-dup/a =op-dup/b ] +=op-nip [ + =op-nip/a =op-nip/b =op-nip/c =op-nip/d ] +=op-swp [ + =op-swp/a =op-swp/b ] +=op-ovr [ + =op-ovr/a =op-ovr/b ] +=op-rot [ + =op-rot/a =op-rot/b ] +=op-and [ + =op-and/a =op-and/b =op-and/c =op-and/d + =op-and/e =op-and/f =op-and/g =op-and/h ] +=op-ora [ + =op-ora/a =op-ora/b =op-ora/c =op-ora/d + =op-ora/e =op-ora/f =op-ora/g =op-ora/h ] +=op-eor [ + =op-eor/a =op-eor/b =op-eor/c =op-eor/d + =op-eor/e =op-eor/f =op-eor/g =op-eor/h ] +=op-sft [ + =op-sft/a =op-sft/b =op-sft/c =op-sft/d + =op-sft/e =op-sft/f =op-sft/g =op-sft/h ] +=op-stz [ + =op-stz/a =op-stz/b =op-stz/c =op-stz/d ] +=op-str [ + =op-str/a =op-str/b =op-str/c =op-str/d ] +=op-sta [ + =op-sta/a =op-sta/b =op-sta/c =op-sta/d ] +=op-jmp [ + =op-jmp/a =op-jmp/b ] +=op-jcn [ + =op-jcn/a =op-jcn/b =op-jcn/c =op-jcn/d ] +=op-jsr [ + =op-jsr/a =op-jsr/b ] +=op-sth [ + =op-sth/a =op-sth/b ] +=op-jci [ + =op-jci/a =op-jci/b =op-jci/c ] +=op-jmi [ + =op-jmi/a ] +=op-jsi [ + =op-jsi/a =op-jsi/b =op-jsi/c =op-jsi/d ] + &end + +@op-equ ;Dict/equ !set + &a #f8 #f8 EQU [ #01 ] EQU JMP2r + &b #01 #01 EQU [ #01 ] EQU JMP2r + &c #f8 #01 EQU [ #00 ] EQU JMP2r + &d #00 #ff EQU [ #00 ] EQU JMP2r + &e #f801 #f801 EQU2 [ #01 ] EQU JMP2r + &f #01f8 #01f8 EQU2 [ #01 ] EQU JMP2r + &g #f801 #01f8 EQU2 [ #00 ] EQU JMP2r + &h #01f8 #f801 EQU2 [ #00 ] EQU JMP2r +@op-neq ;Dict/neq !set + &a #f8 #f8 NEQ [ #00 ] EQU JMP2r + &b #01 #01 NEQ [ #00 ] EQU JMP2r + &c #f8 #01 NEQ [ #01 ] EQU JMP2r + &d #01 #f8 NEQ [ #01 ] EQU JMP2r + &e #f801 #f801 NEQ2 [ #00 ] EQU JMP2r + &f #01f8 #01f8 NEQ2 [ #00 ] EQU JMP2r + &g #f801 #01f8 NEQ2 [ #01 ] EQU JMP2r + &h #01f8 #f801 NEQ2 [ #01 ] EQU JMP2r +@op-gth ;Dict/gth !set + &a #f8 #f8 GTH [ #00 ] EQU JMP2r + &b #01 #01 GTH [ #00 ] EQU JMP2r + &c #f8 #01 GTH [ #01 ] EQU JMP2r + &d #01 #f8 GTH [ #00 ] EQU JMP2r + &e #f801 #f801 GTH2 [ #00 ] EQU JMP2r + &f #01f8 #01f8 GTH2 [ #00 ] EQU JMP2r + &g #f801 #01f8 GTH2 [ #01 ] EQU JMP2r + &h #01f8 #f801 GTH2 [ #00 ] EQU JMP2r +@op-lth ;Dict/lth !set + &a #f8 #f8 LTH [ #00 ] EQU JMP2r + &b #01 #01 LTH [ #00 ] EQU JMP2r + &c #f8 #01 LTH [ #00 ] EQU JMP2r + &d #01 #ff LTH [ #01 ] EQU JMP2r + &e #f801 #f801 LTH2 [ #00 ] EQU JMP2r + &f #01f8 #01f8 LTH2 [ #00 ] EQU JMP2r + &g #f801 #01f8 LTH2 [ #00 ] EQU JMP2r + &h #01f8 #f801 LTH2 [ #01 ] EQU JMP2r +@op-add ;Dict/add !set + &a #ff #00 ADD [ #ff ] EQU JMP2r + &b #01 #ff ADD [ #00 ] EQU JMP2r + &c #ff #ff ADD [ #fe ] EQU JMP2r + &d #12 #34 ADDk ADD ADD [ #8c ] EQU JMP2r + &e #ffff #0000 ADD2 [ #ffff ] EQU2 JMP2r + &f #0001 #ffff ADD2 [ #0000 ] EQU2 JMP2r + &g #ffff #ffff ADD2 [ #fffe ] EQU2 JMP2r + &h #fffe #ffff ADD2 [ #fffd ] EQU2 JMP2r +@op-sub ;Dict/sub !set + &a #ff #00 SUB [ #ff ] EQU JMP2r + &b #01 #ff SUB [ #02 ] EQU JMP2r + &c #ff #ff SUB [ #00 ] EQU JMP2r + &d #fe #ff SUB [ #ff ] EQU JMP2r + &e #ffff #0000 SUB2 [ #ffff ] EQU2 JMP2r + &f #0001 #ffff SUB2 [ #0002 ] EQU2 JMP2r + &g #ffff #ffff SUB2 [ #0000 ] EQU2 JMP2r + &h #fffe #ffff SUB2 [ #ffff ] EQU2 JMP2r +@op-mul ;Dict/mul !set + &a #00 #01 MUL [ #00 ] EQU JMP2r + &b #3f #e7 MUL [ #d9 ] EQU JMP2r + &c #37 #3f MUL [ #89 ] EQU JMP2r + &d #10 #02 MUL [ #20 ] EQU JMP2r + &e #1000 #0003 MUL2 [ #3000 ] EQU2 JMP2r + &f #abcd #1234 MUL2 [ #4fa4 ] EQU2 JMP2r + &g #8000 #0200 MUL2 [ #0000 ] EQU2 JMP2r + &h #2222 #0003 MUL2 [ #6666 ] EQU2 JMP2r +@op-div ;Dict/div !set + &a #10 #06 DIV [ #02 ] EQU JMP2r + &b #20 #20 DIV [ #01 ] EQU JMP2r + &c #34 #01 DIV [ #34 ] EQU JMP2r + &d #02 #ef DIV [ #00 ] EQU JMP2r + &e #02 #00 DIV [ #00 ] EQU JMP2r + &f #03e8 #0006 DIV2 [ #00a6 ] EQU2 JMP2r + &g #abcd #1234 DIV2 [ #0009 ] EQU2 JMP2r + &h #8000 #0200 DIV2 [ #0040 ] EQU2 JMP2r + &i #2222 #0003 DIV2 [ #0b60 ] EQU2 JMP2r + &j #0202 #0000 DIV2 [ #0000 ] EQU2 JMP2r +@op-inc ;Dict/inc !set + &a #01 INC [ #02 ] EQU JMP2r + &b #ff INC [ #00 ] EQU JMP2r + &c #fe INC [ #ff ] EQU JMP2r + &d #00 INC [ #01 ] EQU JMP2r + &e #0001 INC2 [ #0002 ] EQU2 JMP2r + &f #ffff INC2 [ #0000 ] EQU2 JMP2r + &g #fffe INC2 [ #ffff ] EQU2 JMP2r + &h #0000 INC2 [ #0001 ] EQU2 JMP2r +@op-pop ;Dict/pop !set + &a #0a #0b POP [ #0a ] EQU JMP2r + &b #0a #0b #0c POP POP [ #0a ] EQU JMP2r + &c #0a #0b #0c ADD POP [ #0a ] EQU JMP2r + &d #0a #0b #0c POP ADD [ #15 ] EQU JMP2r + &e #0a0b #0c0d POP2 [ #0a0b ] EQU2 JMP2r + &f #0a0b #0c0d #0e0f POP2 POP2 [ #0a0b ] EQU2 JMP2r + &g #0a0b #0c0d #0e0f ADD2 POP2 [ #0a0b ] EQU2 JMP2r + &h #0a0b #0c0d #0e0f POP2 ADD2 [ #1618 ] EQU2 JMP2r +@op-dup ;Dict/dup !set + &a #0a #0b DUP ADD ADD [ #20 ] EQU JMP2r + &b #0a0b DUP2 ADD2 [ #1416 ] EQU2 JMP2r +@op-nip ;Dict/nip !set + &a #12 #34 #56 NIP ADD [ #68 ] EQU JMP2r + &b #12 #34 #56 NIPk ADD2 ADD [ #f2 ] EQU JMP2r + &c #1234 #5678 #9abc NIP2 ADD2 [ #acf0 ] EQU2 JMP2r + &d #1234 #5678 #9abc NIP2k ADD2 ADD2 ADD2 [ #9e24 ] EQU2 JMP2r +@op-swp ;Dict/swp !set + &a #02 #10 SWP DIV [ #08 ] EQU JMP2r + &b #0a0b #0c0d SWP2 NIP2 [ #0a0b ] EQU2 JMP2r +@op-ovr ;Dict/ovr !set + &a #02 #10 OVR DIV ADD [ #0a ] EQU JMP2r + &b #0a0b #0c0d OVR2 NIP2 ADD2 [ #1416 ] EQU2 JMP2r +@op-rot ;Dict/rot !set + &a #02 #04 #10 ROT DIV ADD [ #0c ] EQU JMP2r + &b #0a0b #0c0d #0c0f ROT2 ADD2 NIP2 [ #161a ] EQU2 JMP2r +@op-and ;Dict/and !set + &a #fc #3f AND [ #3c ] EQU JMP2r + &b #f0 #0f AND [ #00 ] EQU JMP2r + &c #ff #3c AND [ #3c ] EQU JMP2r + &d #02 #03 AND [ #02 ] EQU JMP2r + &e #f0f0 #00f0 AND2 [ #00f0 ] EQU2 JMP2r + &f #aaaa #5555 AND2 [ #0000 ] EQU2 JMP2r + &g #ffff #1234 AND2 [ #1234 ] EQU2 JMP2r + &h #abcd #0a0c AND2 [ #0a0c ] EQU2 JMP2r +@op-ora ;Dict/ora !set + &a #0f #f0 ORA [ #ff ] EQU JMP2r + &b #ab #cd ORA [ #ef ] EQU JMP2r + &c #12 #34 ORA [ #36 ] EQU JMP2r + &d #88 #10 ORA [ #98 ] EQU JMP2r + &e #0f0f #f0f0 ORA2 [ #ffff ] EQU2 JMP2r + &f #abab #cdcd ORA2 [ #efef ] EQU2 JMP2r + &g #1122 #1234 ORA2 [ #1336 ] EQU2 JMP2r + &h #8888 #1000 ORA2 [ #9888 ] EQU2 JMP2r +@op-eor ;Dict/eor !set + &a #00 #00 EOR [ #00 ] EQU JMP2r + &b #ff #00 EOR [ #ff ] EQU JMP2r + &c #aa #55 EOR [ #ff ] EQU JMP2r + &d #ff #ff EOR [ #00 ] EQU JMP2r + &e #ffff #ff00 EOR2 [ #00ff ] EQU2 JMP2r + &f #aaaa #5555 EOR2 [ #ffff ] EQU2 JMP2r + &g #1122 #1234 EOR2 [ #0316 ] EQU2 JMP2r + &h #8888 #1000 EOR2 [ #9888 ] EQU2 JMP2r +@op-sft ;Dict/sft !set + &a #ff #08 SFT [ #00 ] EQU JMP2r + &b #ff #e0 SFT [ #00 ] EQU JMP2r + &c #ff #11 SFT [ #fe ] EQU JMP2r + &d #ff #12 SFT [ #7e ] EQU JMP2r + &e #ffff #01 SFT2 [ #7fff ] EQU2 JMP2r + &f #ffff #70 SFT2 [ #ff80 ] EQU2 JMP2r + &g #ffff #7e SFT2 [ #0180 ] EQU2 JMP2r + &h #ffff #e3 SFT2 [ #c000 ] EQU2 JMP2r +@op-stz ;Dict/stz !set + &a #ab .Zeropage/byte STZ .Zeropage/byte LDZ [ #ab ] EQU JMP2r + &b #cd .Zeropage/byte STZ .Zeropage/byte LDZ [ #cd ] EQU JMP2r + &c #1234 .Zeropage/short STZ2 .Zeropage/short LDZ2 [ #1234 ] EQU2 JMP2r + &d #5678 .Zeropage/short STZ2 .Zeropage/short LDZ2 [ #5678 ] EQU2 JMP2r +@op-str ;Dict/str !set + [ LIT &before1 $1 ] [ LIT2 &before2 $2 ] + &a #22 ,&before1 STR ,&before1 LDR [ #22 ] EQU JMP2r + &b #ef ,&after1 STR ,&after1 LDR [ #ef ] EQU JMP2r + &c #1234 ,&before2 STR2 ,&before2 LDR2 [ #1234 ] EQU2 JMP2r + &d #5678 ,&after2 STR2 ,&after2 LDR2 [ #5678 ] EQU2 JMP2r + [ LIT &after1 $1 ] [ LIT2 &after2 $2 ] +@op-sta ;Dict/sta !set + &a #34 ;Absolute/byte STA ;Absolute/byte LDA [ #34 ] EQU JMP2r + &b #56 ;Absolute/byte STA ;Absolute/byte LDA [ #56 ] EQU JMP2r + &c #1234 ;Absolute/short STA2 ;Absolute/short LDA2 [ #1234 ] EQU2 JMP2r + &d #5678 ;Absolute/short STA2 ;Absolute/short LDA2 [ #5678 ] EQU2 JMP2r +@op-jmp ;Dict/jmp !set + &a #12 #34 ,&reljmp JMP SWP &reljmp POP [ #12 ] EQU JMP2r + &b #56 #78 ;&absjmp JMP2 SWP &absjmp POP [ #56 ] EQU JMP2r +@op-jcn ;Dict/jcn !set + &a #23 #01 ,&reljcn-y JCN INC &reljcn-y [ #23 ] EQU JMP2r + &b #23 #00 ,&reljcn-n JCN INC &reljcn-n [ #24 ] EQU JMP2r + &c #23 #01 ;&absjcn-y JCN2 INC &absjcn-y [ #23 ] EQU JMP2r + &d #23 #00 ;&absjcn-n JCN2 INC &absjcn-n [ #24 ] EQU JMP2r +@op-jsr ;Dict/jsr !set + &a #1234 #5678 ,&routine JSR [ #68ac ] EQU2 JMP2r + &b #12 #34 ;routine JSR2 [ #46 ] EQU JMP2r + &routine ADD2 JMP2r +@op-sth ;Dict/sth !set + &a #0a STH #0b STH ADDr STHr [ #15 ] EQU JMP2r + &b #000a STH2 #000b STH2 ADD2r STH2r [ #0015 ] EQU2 JMP2r +@op-jci ;Dict/jci !set + &before #01 JMP2r + &a #01 ?&skip-a #00 JMP2r &skip-a #01 JMP2r + &b #00 ?&skip-b #01 JMP2r &skip-b #00 JMP2r + &c #01 ?&before #00 JMP2r +@op-jmi ;Dict/jmi !set + &a !&skip-a #00 JMP2r &skip-a #01 JMP2r +@op-jsi ;Dict/jsi !set + &a #02 #04 routine #06 EQU JMP2r + &b ;&return special &return JMP2r + &c ,&skip-c JMP &routine-c ADD JMP2r &skip-c #02 #04 op-jsi/routine-c #06 EQU JMP2r + &d ,&skip-d JMP &routine-d ADD JMP2r &skip-d #02 #04 op-jsi-far-routine-d #06 EQU JMP2r + +@special ( routine* -- f ) + + ( test that the stack order is LIFO ) + DUP2 STH2kr EQU2 + ROT ROT DUP2r STHr STHr SWP EQU2 AND + +JMP2r + +@routine ( a b -- c ) ADD JMP2r +@subroutine ( -- ) [ LIT2 "kO ] #18 DEO #18 DEO JMP2r +@Absolute &byte $1 &short $2 + +@Dict [ + &ok "Ok $1 + &done "Tests 20 "Complete. 0a $1 + &opctests "Opcodes $1 + &stack-wrap "Stack-wrap $1 + &ram-wrap "RAM-wrap $1 + &pc-wrap "PC-wrap $1 + &pc2-wrap "PC2-wrap $1 + &zp-wrap "Zeropage-wrap $1 + &dev-wrap "Devices-wrap $1 + &result "Result: $1 + &passed 20 "passed! 0a $1 + &missed "Opcode 20 "Failed 20 "-- 20 $1 + &failed 20 "failed. 0a $1 + &equ "EQU $1 &neq "NEQ $1 >h "GTH $1 <h "LTH $1 + &add "ADD $1 &sub "SUB $1 &mul "MUL $1 &div "DIV $1 + &inc "INC $1 &pop "POP $1 &dup "DUP $1 &nip "NIP $1 + &swp "SWP $1 &ovr "OVR $1 &rot "ROT $1 + &and "AND $1 &ora "ORA $1 &eor "EOR $1 &sft "SFT $1 + &stz "STZ $1 &str "STR $1 &sta "STA $1 + &jmp "JMP $1 &jcn "JCN $1 &jsr "JSR $1 &sth "STH $1 + &jmi "JMI $1 &jci "JCI $1 &jsi "JSI $1 +] + +( +@|Relative Distance Bytes ) + +@rel-distance +&back "O $7c +&entry + ,&back LDR + ,&forw LDR + JMP2r +$7e +&forw "k + +@op-jsi-far-routine-d + op-jsi/routine-d JMP2r + diff --git a/utils/uxnmin b/utils/uxnmin new file mode 100755 index 0000000..93e70d3 Binary files /dev/null and b/utils/uxnmin differ diff --git a/utils/uxnmin.c b/utils/uxnmin.c new file mode 100644 index 0000000..d29a854 --- /dev/null +++ b/utils/uxnmin.c @@ -0,0 +1,135 @@ +#include + +static unsigned int console_vector; +static unsigned char ram[0x10000], dev[0x100], ptr[2], stk[2][0x100]; + +static unsigned char +emu_dei(const unsigned char port) +{ + return dev[port]; +} + +static void +emu_deo(const unsigned char port, const unsigned char value) +{ + dev[port] = value; + switch(port) { + case 0x11: console_vector = dev[0x10] << 8 | value; return; + case 0x18: fputc(value, stdout); return; + case 0x19: fputc(value, stderr); return; + } +} + +#define REM ptr[_r] -= 1 + _2; +#define DEC(m) stk[m][--ptr[m]] +#define INC(m) stk[m][ptr[m]++] +#define IMM(r) { r = ram[pc++] << 8, r |= ram[pc++]; } +#define MOV(x) { if(_2) pc = x; else pc += (signed char)x; } +#define PO1(o) o = DEC(_r); +#define PO2(o) { PO1(o) o |= DEC(_r) << 8; } +#define POx(o) if(_2) PO2(o) else PO1(o) +#define GOT(o) if(_2) PO1(o[1]) PO1(o[0]) +#define DEO(o,r) emu_deo(o, r[0]); if(_2) emu_deo(o + 1, r[1]); +#define POK(o,r,m) ram[o] = r[0]; if(_2) ram[(o + 1) & m] = r[1]; +#define RP1(i) INC(!_r) = i; +#define PU1(i) INC(_r) = i; +#define PUx(i) if(_2) { c = (i); PU1(c >> 8) PU1(c) } else PU1(i) +#define PUT(i) PU1(i[0]) if(_2) PU1(i[1]) +#define DEI(i,r) r[0] = emu_dei(i); if(_2) r[1] = emu_dei(i + 1); PUT(r) +#define PEK(i,r,m) r[0] = ram[i]; if(_2) r[1] = ram[(i + 1) & m]; PUT(r) + +#define NEXT if(--cycles) goto step; else return 0; +#define OPC(opc, A, B) {\ + case 0x00|opc: {const int _2=0,_r=0;A B} NEXT\ + case 0x20|opc: {const int _2=1,_r=0;A B} NEXT\ + case 0x40|opc: {const int _2=0,_r=1;A B} NEXT\ + case 0x60|opc: {const int _2=1,_r=1;A B} NEXT\ + case 0x80|opc: {const int _2=0,_r=0;int k=ptr[0];A ptr[0]=k;B} NEXT\ + case 0xa0|opc: {const int _2=1,_r=0;int k=ptr[0];A ptr[0]=k;B} NEXT\ + case 0xc0|opc: {const int _2=0,_r=1;int k=ptr[1];A ptr[1]=k;B} NEXT\ + case 0xe0|opc: {const int _2=1,_r=1;int k=ptr[1];A ptr[1]=k;B} NEXT } + +static unsigned int +uxn_eval(unsigned short pc) +{ + unsigned int a, b, c, x[2], y[2], z[2], cycles = 0x80000000; +step: + switch(ram[pc++]) { + /* BRK */ case 0x00: return 1; + /* JCI */ case 0x20: if(DEC(0)) { IMM(c) pc += c; } else pc += 2; NEXT + /* JMI */ case 0x40: IMM(c) pc += c; NEXT + /* JSI */ case 0x60: IMM(c) INC(1) = pc >> 8, INC(1) = pc, pc += c; NEXT + /* LI2 */ case 0xa0: INC(0) = ram[pc++]; /* fall-through */ + /* LIT */ case 0x80: INC(0) = ram[pc++]; NEXT + /* L2r */ case 0xe0: INC(1) = ram[pc++]; /* fall-through */ + /* LIr */ case 0xc0: INC(1) = ram[pc++]; NEXT + /* INC */ OPC(0x01,POx(a),PUx(a + 1)) + /* POP */ OPC(0x02,REM,{}) + /* NIP */ OPC(0x03,GOT(x) REM,PUT(x)) + /* SWP */ OPC(0x04,GOT(x) GOT(y),PUT(x) PUT(y)) + /* ROT */ OPC(0x05,GOT(x) GOT(y) GOT(z),PUT(y) PUT(x) PUT(z)) + /* DUP */ OPC(0x06,GOT(x),PUT(x) PUT(x)) + /* OVR */ OPC(0x07,GOT(x) GOT(y),PUT(y) PUT(x) PUT(y)) + /* EQU */ OPC(0x08,POx(a) POx(b),PU1(b == a)) + /* NEQ */ OPC(0x09,POx(a) POx(b),PU1(b != a)) + /* GTH */ OPC(0x0a,POx(a) POx(b),PU1(b > a)) + /* LTH */ OPC(0x0b,POx(a) POx(b),PU1(b < a)) + /* JMP */ OPC(0x0c,POx(a),MOV(a)) + /* JCN */ OPC(0x0d,POx(a) PO1(b),if(b) MOV(a)) + /* JSR */ OPC(0x0e,POx(a),RP1(pc >> 8) RP1(pc) MOV(a)) + /* STH */ OPC(0x0f,GOT(x),RP1(x[0]) if(_2) RP1(x[1])) + /* LDZ */ OPC(0x10,PO1(a),PEK(a, x, 0xff)) + /* STZ */ OPC(0x11,PO1(a) GOT(y),POK(a, y, 0xff)) + /* LDR */ OPC(0x12,PO1(a),PEK(pc + (signed char)a, x, 0xffff)) + /* STR */ OPC(0x13,PO1(a) GOT(y),POK(pc + (signed char)a, y, 0xffff)) + /* LDA */ OPC(0x14,PO2(a),PEK(a, x, 0xffff)) + /* STA */ OPC(0x15,PO2(a) GOT(y),POK(a, y, 0xffff)) + /* DEI */ OPC(0x16,PO1(a),DEI(a, x)) + /* DEO */ OPC(0x17,PO1(a) GOT(y),DEO(a, y)) + /* ADD */ OPC(0x18,POx(a) POx(b),PUx(b + a)) + /* SUB */ OPC(0x19,POx(a) POx(b),PUx(b - a)) + /* MUL */ OPC(0x1a,POx(a) POx(b),PUx(b * a)) + /* DIV */ OPC(0x1b,POx(a) POx(b),PUx(a ? b / a : 0)) + /* AND */ OPC(0x1c,POx(a) POx(b),PUx(b & a)) + /* ORA */ OPC(0x1d,POx(a) POx(b),PUx(b | a)) + /* EOR */ OPC(0x1e,POx(a) POx(b),PUx(b ^ a)) + /* SFT */ OPC(0x1f,PO1(a) POx(b),PUx(b >> (a & 0xf) << (a >> 4))) + } + return 0; +} + +static void +console_input(int c, unsigned int type) +{ + dev[0x12] = c, dev[0x17] = type; + if(console_vector && !dev[0x0f]) + uxn_eval(console_vector); +} + +int +main(int argc, char **argv) +{ + FILE *f; + if(argc < 2) + return fprintf(stdout, "usage: %s file.rom [args..]\n", argv[0]); + else if(!(f = fopen(argv[1], "rb"))) + return fprintf(stderr, "%s: %s not found.\n", argv[0], argv[1]); + fread(&ram[0x100], 0xff00, 1, f), fclose(f); + dev[0x17] = argc > 2; + if(uxn_eval(0x100) && console_vector) { + int i = 2; + for(; i < argc; i++) { + char c, *p = argv[i]; + while(!dev[0x0f] && (c = *p++)) + console_input(c, 2); + console_input(0, 3 + (i == argc - 1)); + } + while(!dev[0x0f]) { + char c = fgetc(stdin); + if(feof(stdin)) break; + console_input(c, 1); + } + console_input(0, 4); + } + return dev[0x0f] & 0x7f; +} diff --git a/uxn.opam b/uxn.opam new file mode 100644 index 0000000..35bd3c7 --- /dev/null +++ b/uxn.opam @@ -0,0 +1,30 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "Uxn emulator library for OCaml" +description: "Uxn emulator library for OCaml" +maintainer: ["Javier B. Torres "] +authors: ["Javier B. Torres "] +license: "LICENSE" +homepage: "https://codeberg.org/lobo/uxn" +bug-reports: "https://codeberg.org/lobo/uxn/issues" +depends: [ + "dune" {>= "3.20"} + "ocaml" + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://codeberg.org/lobo/uxn.git" +x-maintenance-intent: ["(latest)"]