initial import
This commit is contained in:
commit
ad589d2894
26 changed files with 2241 additions and 0 deletions
4
.gitignore
vendored
Normal file
4
.gitignore
vendored
Normal file
|
|
@ -0,0 +1,4 @@
|
||||||
|
*.rom
|
||||||
|
*.rom.sym
|
||||||
|
/_build
|
||||||
|
/uxn-utils/uxnmin
|
||||||
2
.ocamlformat
Normal file
2
.ocamlformat
Normal file
|
|
@ -0,0 +1,2 @@
|
||||||
|
version = 0.28.1
|
||||||
|
ocaml-version = 5.4.1
|
||||||
13
LICENSE
Normal file
13
LICENSE
Normal file
|
|
@ -0,0 +1,13 @@
|
||||||
|
Copyright (c) 2025 Javier B. Torres <lobo@quiltro.org>
|
||||||
|
|
||||||
|
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.
|
||||||
6
Makefile
Normal file
6
Makefile
Normal file
|
|
@ -0,0 +1,6 @@
|
||||||
|
.PHONY: utils clean
|
||||||
|
|
||||||
|
utils:
|
||||||
|
$(MAKE) -C utils
|
||||||
|
clean:
|
||||||
|
$(MAKE) -C utils clean
|
||||||
5
README.md
Normal file
5
README.md
Normal file
|
|
@ -0,0 +1,5 @@
|
||||||
|
# Uxn\_of\_ocaml
|
||||||
|
|
||||||
|
An Uxn emulator library for OCaml 5 (as it uses effect handlers)
|
||||||
|
|
||||||
|
|
||||||
19
dune-project
Normal file
19
dune-project
Normal file
|
|
@ -0,0 +1,19 @@
|
||||||
|
(lang dune 3.20)
|
||||||
|
|
||||||
|
(name uxn)
|
||||||
|
|
||||||
|
(generate_opam_files true)
|
||||||
|
|
||||||
|
(source
|
||||||
|
(codeberg lobo/uxn))
|
||||||
|
|
||||||
|
(authors "Javier B. Torres <lobo@quiltro.org>")
|
||||||
|
(maintainers "Javier B. Torres <lobo@quiltro.org>")
|
||||||
|
|
||||||
|
(license LICENSE)
|
||||||
|
|
||||||
|
(package
|
||||||
|
(name uxn)
|
||||||
|
(synopsis "Uxn emulator library for OCaml")
|
||||||
|
(description "Uxn emulator library for OCaml")
|
||||||
|
(depends ocaml))
|
||||||
4
exe/dune
Normal file
4
exe/dune
Normal file
|
|
@ -0,0 +1,4 @@
|
||||||
|
(executable
|
||||||
|
(public_name uxnemu)
|
||||||
|
(name uxnemu)
|
||||||
|
(libraries uxn unix fmt))
|
||||||
82
exe/uxnemu.ml
Normal file
82
exe/uxnemu.ml
Normal file
|
|
@ -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 ()
|
||||||
73
lib/Instr.ml
Normal file
73
lib/Instr.ml
Normal file
|
|
@ -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 "")
|
||||||
6
lib/Instr.mli
Normal file
6
lib/Instr.mli
Normal file
|
|
@ -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
|
||||||
288
lib/Machine.ml
Normal file
288
lib/Machine.ml
Normal file
|
|
@ -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
|
||||||
36
lib/Machine.mli
Normal file
36
lib/Machine.mli
Normal file
|
|
@ -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
|
||||||
17
lib/Util.ml
Normal file
17
lib/Util.ml
Normal file
|
|
@ -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)
|
||||||
5
lib/Util.mli
Normal file
5
lib/Util.mli
Normal file
|
|
@ -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
|
||||||
0
lib/Varvara.ml
Normal file
0
lib/Varvara.ml
Normal file
2
lib/dune
Normal file
2
lib/dune
Normal file
|
|
@ -0,0 +1,2 @@
|
||||||
|
(library
|
||||||
|
(name uxn))
|
||||||
13
utils/LICENSE
Normal file
13
utils/LICENSE
Normal file
|
|
@ -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.
|
||||||
19
utils/Makefile
Normal file
19
utils/Makefile
Normal file
|
|
@ -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
|
||||||
4
utils/assemble.sh
Normal file
4
utils/assemble.sh
Normal file
|
|
@ -0,0 +1,4 @@
|
||||||
|
#!/bin/sh
|
||||||
|
make -q uxnmin
|
||||||
|
make -q drifloon.rom
|
||||||
|
./uxnmin drifloon.rom < $1 > $2
|
||||||
82
utils/console.tal
Normal file
82
utils/console.tal
Normal file
|
|
@ -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 <print-str>
|
||||||
|
.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 <print-result>
|
||||||
|
[ 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 <print-result>
|
||||||
|
;dict/quit scmp ?{
|
||||||
|
[ LIT2 -std _&ptr ] STR
|
||||||
|
BRK }
|
||||||
|
( quit ) #800f DEO
|
||||||
|
BRK
|
||||||
|
|
||||||
|
@<print-result> ( buf* name* -- )
|
||||||
|
<print-str>
|
||||||
|
[ LIT2 "" 18 ] DEO
|
||||||
|
<print-str>/
|
||||||
|
[ LIT2 "" 18 ] DEO
|
||||||
|
[ LIT2 00 -Console/type ] DEI DUP ADD ;Types ADD2 LDA2 <print-str>/
|
||||||
|
#0a18 DEO
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
@<print-str> ( str* -- )
|
||||||
|
LDAk #18 DEO
|
||||||
|
INC2 & LDAk ?<print-str>
|
||||||
|
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 "<none> $1
|
||||||
|
&arg-stdin "<stdin> $1
|
||||||
|
&arg-data "<data> $1
|
||||||
|
&arg-spacer "<spacer> $1
|
||||||
|
&arg-end "<end> $1
|
||||||
155
utils/drifloon.rom.txt
Normal file
155
utils/drifloon.rom.txt
Normal file
|
|
@ -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
|
||||||
732
utils/drifloon.tal
Normal file
732
utils/drifloon.tal
Normal file
|
|
@ -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/<set>
|
||||||
|
;assembly/on-console .Console/vector DEO2
|
||||||
|
BRK
|
||||||
|
|
||||||
|
@assembly/on-console ( -> )
|
||||||
|
[ LIT2 04 -Console/type ] DEI EQU ?{ .Console/read DEI token/<push-byte>
|
||||||
|
BRK }
|
||||||
|
/<resolve>
|
||||||
|
BRK
|
||||||
|
|
||||||
|
@rom/<put> ( byte addr* -- )
|
||||||
|
;&mem ADD2 STA
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
@rom/<emit> ( -- )
|
||||||
|
;dict/assembled err/<print>
|
||||||
|
;dict/in err/<print>
|
||||||
|
;head/length LDA2 DUP2 #0100 SUB2 err/<pdec>
|
||||||
|
;dict/bytes err/<print>
|
||||||
|
( | write )
|
||||||
|
;rom/mem ADD2 ;rom/output
|
||||||
|
&>l
|
||||||
|
LDAk #18 DEO
|
||||||
|
INC2 GTH2k ?&>l
|
||||||
|
POP2 POP2 JMP2r
|
||||||
|
|
||||||
|
@runes/concat ( t* -- )
|
||||||
|
POP2 JMP2r
|
||||||
|
|
||||||
|
@err/<emit> ( 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/<resolve> ( -- )
|
||||||
|
( cap ) #0a token/<push-byte>
|
||||||
|
,&mode LDR2 ;comment/assemble NEQ2 ?{
|
||||||
|
( ! ) ;dict/open ;dict/trail ;dict/Comment err/<generic> }
|
||||||
|
,&mode LDR2 ;macros/assemble NEQ2 ?{
|
||||||
|
( ! ) ;dict/open ;dict/trail ;dict/Macro err/<generic> }
|
||||||
|
.System/state DEI ?{
|
||||||
|
refs/<resolve-all>
|
||||||
|
.System/state DEI ?{
|
||||||
|
[ LIT2 80 -System/state ] DEO !syms/<emit> } }
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
@assembly/apply ( t* -- )
|
||||||
|
LDZk ?{ POP2 JMP2r }
|
||||||
|
[ LIT2 &mode =standard/assemble ] JMP2
|
||||||
|
|
||||||
|
(
|
||||||
|
@|Standard )
|
||||||
|
|
||||||
|
@standard/<latch> ( -- )
|
||||||
|
;&assemble ;assembly/mode STA2
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
@standard/assemble ( t* -- )
|
||||||
|
( hex ) str/is-hex ?rom/<write-rawhex>
|
||||||
|
( opc ) opcodes/is-opcode ?rom/<write-opcode>
|
||||||
|
LDZk runes/find INC2k ORA ?{
|
||||||
|
POP2
|
||||||
|
( mac ) DUP2 macros/find-name INC2k ORA ?macros/<write>
|
||||||
|
POP2
|
||||||
|
( imm ) !runes/litjsi }
|
||||||
|
INC2 LDA2 JMP2
|
||||||
|
|
||||||
|
(
|
||||||
|
@|Comment )
|
||||||
|
|
||||||
|
@comment/<latch> ( 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/<latch> }
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
(
|
||||||
|
@|Macros )
|
||||||
|
|
||||||
|
@macros/<latch> ( t* -- )
|
||||||
|
name/<validate>
|
||||||
|
/<push-word>
|
||||||
|
#00 /<push-byte>
|
||||||
|
;&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 /<push-byte> !standard/<latch> }
|
||||||
|
/<push-word>
|
||||||
|
#20 !/<push-byte>
|
||||||
|
|
||||||
|
@macros/<push-word> ( t* -- )
|
||||||
|
;/<push-byte> !hof/<each>
|
||||||
|
|
||||||
|
@macros/<push-byte> ( byte -- )
|
||||||
|
[ LIT2 &ptr =&mem ] INC2k
|
||||||
|
( | check overflow )
|
||||||
|
DUP2 ;&memend LTH2 ?{
|
||||||
|
( ! ) ;dict/exceeded ;dict/Macros err/<token> }
|
||||||
|
,&ptr STR2
|
||||||
|
STA
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
@macros/find-name ( name* -- <addr>* )
|
||||||
|
STH2
|
||||||
|
,&ptr LDR2 ;&mem
|
||||||
|
&>lf
|
||||||
|
DUP2 STH2kr str/cmp ?{
|
||||||
|
str/cap str/cap GTH2k ?&>lf
|
||||||
|
POP2 #ffff }
|
||||||
|
NIP2 POP2r JMP2r
|
||||||
|
|
||||||
|
@macros/<write> ( t* macro* -- )
|
||||||
|
NIP2 token/<new>
|
||||||
|
str/cap ;token/<push-byte> !hof/<each>
|
||||||
|
|
||||||
|
(
|
||||||
|
@|Token )
|
||||||
|
|
||||||
|
@token/<new> ( -- )
|
||||||
|
[ LIT2 -&buf _&ptr ] STR
|
||||||
|
[ LIT2 00 -&buf ] STZ
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
@token/<push-byte> ( c -- )
|
||||||
|
DUP #20 GTH ?{
|
||||||
|
;&buf assembly/apply #0a NEQ ?{
|
||||||
|
[ LIT2 &line 0001 ] INC2 ,&line STR2 }
|
||||||
|
!/<new> }
|
||||||
|
[ LIT2 00 &ptr -&buf ] INCk
|
||||||
|
( | check overflow )
|
||||||
|
DUP .&cap LTH ?{
|
||||||
|
( ! ) ;dict/exceeded ;dict/Name err/<token> }
|
||||||
|
,&ptr STR
|
||||||
|
STZ2
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
(
|
||||||
|
@|Scope )
|
||||||
|
|
||||||
|
@scope/<push-byte> ( c -- )
|
||||||
|
[ LIT2 00 &ptr -&buf ] INCk
|
||||||
|
( | check overflow )
|
||||||
|
DUP .&cap LTH ?{
|
||||||
|
( ! ) ;dict/exceeded ;dict/Symbol err/<token> }
|
||||||
|
,&ptr STR
|
||||||
|
STZ2
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
@scope/<set> ( name* -- )
|
||||||
|
[ LIT2 -&buf _&ptr ] STR
|
||||||
|
&>w
|
||||||
|
LDAk [ LIT "/ ] EQU ?{
|
||||||
|
LDAk /<push-byte>
|
||||||
|
INC2 LDAk ?&>w }
|
||||||
|
POP2 ,&ptr LDR ,&anchor STR
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
@scope/make-name ( name* -- scope/label* )
|
||||||
|
INC2 [ LIT2 &anchor $1 _&ptr ] STR
|
||||||
|
[ LIT "/ ] /<push-byte>
|
||||||
|
;&buf SWP2 ;/<push-byte> !hof/<each>
|
||||||
|
|
||||||
|
(
|
||||||
|
@|Runes )
|
||||||
|
|
||||||
|
@runes/find ( char -- <addr>* )
|
||||||
|
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/<latch>
|
||||||
|
|
||||||
|
¯os ( t* -- )
|
||||||
|
/req-name !macros/<latch>
|
||||||
|
|
||||||
|
&padabs ( t* -- )
|
||||||
|
/req-name syms/find-addr !head/<set>
|
||||||
|
|
||||||
|
&padrel ( t* -- )
|
||||||
|
/req-name syms/find-addr !head/<set-rel>
|
||||||
|
|
||||||
|
&toplab ( t* -- )
|
||||||
|
/req-name DUP2 scope/<set> !syms/<new>
|
||||||
|
|
||||||
|
&sublab ( t* -- )
|
||||||
|
scope/make-name !syms/<new>
|
||||||
|
|
||||||
|
&litrel ( t* -- )
|
||||||
|
#80 rom/<write-byte> &rawrel /req-name refs/get-rel !rom/<write-byte>
|
||||||
|
|
||||||
|
&litzep ( t* -- )
|
||||||
|
#80 rom/<write-byte> &rawzep /req-name refs/get-abs !rom/<write-byte>
|
||||||
|
|
||||||
|
&litabs ( t* -- )
|
||||||
|
#a0 rom/<write-byte> &rawabs /req-name refs/get-abs2 !rom/<write-short>
|
||||||
|
|
||||||
|
&litjci ( t* -- )
|
||||||
|
/req-name #20 !rom/<write-call>
|
||||||
|
|
||||||
|
&litjmi ( t* -- )
|
||||||
|
/req-name #40 !rom/<write-call>
|
||||||
|
|
||||||
|
&litjsi ( t* -- )
|
||||||
|
#60 !rom/<write-call>
|
||||||
|
|
||||||
|
&lithex ( t* -- )
|
||||||
|
/req-name !rom/<write-lithex>
|
||||||
|
|
||||||
|
&rawstr ( t* -- )
|
||||||
|
/req-name !rom/<write-str>
|
||||||
|
|
||||||
|
@runes/req-name ( str* -- str1* )
|
||||||
|
INC2 LDAk #20 GTH ?{ ;dict/invalid ;dict/Name !err/<token> }
|
||||||
|
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/<new>
|
||||||
|
,&ptr STR2
|
||||||
|
JMP2r
|
||||||
|
&sym cebb
|
||||||
|
&id ".. $1
|
||||||
|
|
||||||
|
(
|
||||||
|
@|Name )
|
||||||
|
|
||||||
|
@name/<validate> ( 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/<token>
|
||||||
|
|
||||||
|
&dup ( -- )
|
||||||
|
;dict/duplicate ;dict/Name !err/<token>
|
||||||
|
|
||||||
|
@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/<new> ( name* -- )
|
||||||
|
DUP2 /find-name INC2k ORA ?{
|
||||||
|
POP2 ;&ptr LDA2 refs/<record-scope>
|
||||||
|
.SymType/declared head/get !/<push-sym> }
|
||||||
|
( | name* sym* -- )
|
||||||
|
NIP2 DUP2 refs/<record-scope>
|
||||||
|
/is-declared ?{ head/get OVR2 STA2 !/<declare> }
|
||||||
|
POP2
|
||||||
|
( ! ) ;dict/duplicate ;dict/Symbol !err/<token>
|
||||||
|
|
||||||
|
@syms/<push-sym> ( name* type addr* -- )
|
||||||
|
( hb ) SWP /<push-byte>
|
||||||
|
( lb ) /<push-byte>
|
||||||
|
( type ) /<push-byte>
|
||||||
|
name/<validate>
|
||||||
|
;/<push-byte> hof/<each>
|
||||||
|
#00
|
||||||
|
( >> )
|
||||||
|
|
||||||
|
@syms/<push-byte> ( byte -- )
|
||||||
|
[ LIT2 &ptr =&mem ] INC2k
|
||||||
|
( | check overflow )
|
||||||
|
DUP2 ;&memend LTH2 ?{
|
||||||
|
( ! ) ;dict/exceeded ;dict/Symbols err/<token> }
|
||||||
|
,&ptr STR2
|
||||||
|
STA
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
@syms/find-name ( name* -- <sym>* )
|
||||||
|
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* -- <addr>* )
|
||||||
|
DUP2 /find-name INC2k ORA ?{
|
||||||
|
( null* .. next* ) POP2 ,&ptr LDR2
|
||||||
|
( alloc ) SWP2 .SymType/used #ffff !/<push-sym> }
|
||||||
|
NIP2 JMP2r
|
||||||
|
|
||||||
|
@syms/find-addr ( name* -- <addr>* )
|
||||||
|
str/is-hex ?str/hex
|
||||||
|
name/unpack /find-name /is-defined ?{
|
||||||
|
( ! ) ;dict/invalid ;dict/Symbol err/<token> }
|
||||||
|
/use LDA2 JMP2r
|
||||||
|
|
||||||
|
@syms/<emit> ( -- )
|
||||||
|
;&ptr LDA2 ;&mem
|
||||||
|
&>ls
|
||||||
|
EQU2k ?{
|
||||||
|
/is-used ?{
|
||||||
|
LDA2k #0100 EQU2 ?{
|
||||||
|
DUP2 #0003 ADD2 LDAk [ LIT "A ] SUB #1a LTH ?{
|
||||||
|
;dict/unused err/<print>
|
||||||
|
DUP2 err/<print>
|
||||||
|
#0a err/<emit> }
|
||||||
|
POP2 } }
|
||||||
|
#0003 ADD2 str/cap !&>ls }
|
||||||
|
POP2 POP2 !rom/<emit>
|
||||||
|
|
||||||
|
@syms/byte-distance ( addr* -- addr* )
|
||||||
|
DUP2 #0080 ADD2 POP ?{ JMP2r }
|
||||||
|
( ! ) ;dict/too-far ;dict/Symbol !err/<token>
|
||||||
|
|
||||||
|
@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/<declare> ( 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* ) /<push-short>
|
||||||
|
( symbol* ) /<push-short>
|
||||||
|
( type-fn* ) [ LIT2 &type $2 ] /<push-short>
|
||||||
|
( scope* ) [ LIT2 &scope $2 ] /<push-short>
|
||||||
|
( line* ) ;token/line LDA2 /<push-short> }
|
||||||
|
( | mark as used )
|
||||||
|
syms/use LDA2 JMP2r
|
||||||
|
|
||||||
|
@refs/<push-short> ( value* -- )
|
||||||
|
SWP /<push-byte>
|
||||||
|
( >> )
|
||||||
|
|
||||||
|
@refs/<push-byte> ( byte -- )
|
||||||
|
[ LIT2 &ptr =&mem ] INC2k
|
||||||
|
( | check overflow )
|
||||||
|
DUP2 ;&memend LTH2 ?{
|
||||||
|
( ! ) ;dict/exceeded ;dict/References err/<token> }
|
||||||
|
,&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/<resolve-all> ( -- )
|
||||||
|
,&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/<set>
|
||||||
|
( ref* sym* ) INC2k INC2 LDA2
|
||||||
|
( ref* sym/addr* ) LDA2
|
||||||
|
( ref* sym/addr* ) INC2k ORA ?{
|
||||||
|
( ! ) ;dict/invalid !err/<resolution> }
|
||||||
|
( ref* sym/addr* ) JMP2r
|
||||||
|
|
||||||
|
@refs/handle-abs ( ref* -- )
|
||||||
|
/resolve-sym NIP2 NIP !rom/<write-byte>
|
||||||
|
|
||||||
|
@refs/handle-abs2 ( ref* -- )
|
||||||
|
/resolve-sym NIP2 !rom/<write-short>
|
||||||
|
|
||||||
|
@refs/handle-rel ( ref* -- )
|
||||||
|
/resolve-sym SWP2 LDA2 /get-distance /byte-distance NIP !rom/<write-byte>
|
||||||
|
|
||||||
|
@refs/handle-rel2 ( ref* -- )
|
||||||
|
/resolve-sym SWP2 LDA2 /get-distance !rom/<write-short>
|
||||||
|
|
||||||
|
@refs/byte-distance ( addr* -- addr* )
|
||||||
|
DUP2 #0080 ADD2 POP ?{ JMP2r }
|
||||||
|
( ! ) ;dict/too-far !err/<resolution>
|
||||||
|
|
||||||
|
@refs/<record-scope> ( sym* -- )
|
||||||
|
DUP2 #0003 ADD2 LDA2 #cebb NEQ2 ?{ POP2 JMP2r }
|
||||||
|
;refs/scope STA2
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
(
|
||||||
|
@|Rom )
|
||||||
|
|
||||||
|
@rom/<write-str> ( str* -- )
|
||||||
|
;/<write-byte> !hof/<each>
|
||||||
|
|
||||||
|
@rom/<write-opcode> ( str* -- )
|
||||||
|
opcodes/parse !/<write-byte>
|
||||||
|
|
||||||
|
@rom/<write-lithex> ( str* -- )
|
||||||
|
str/len #02 NEQ #50 SFT #80 ORA /<write-byte>
|
||||||
|
( >> )
|
||||||
|
|
||||||
|
@rom/<write-rawhex> ( str* -- )
|
||||||
|
str/is-hex #00 EQU ?{
|
||||||
|
str/len DUP #02 NEQ ?{ POP str/hex NIP !/<write-byte> }
|
||||||
|
#04 NEQ ?{ str/hex !/<write-short> } }
|
||||||
|
POP2 ;dict/invalid ;dict/Number !err/<token>
|
||||||
|
|
||||||
|
@rom/<write-call> ( str* opc -- )
|
||||||
|
/<write-byte>
|
||||||
|
refs/get-rel2
|
||||||
|
( >> )
|
||||||
|
|
||||||
|
@rom/<write-short> ( short* -- )
|
||||||
|
SWP /<write-byte>
|
||||||
|
( >> )
|
||||||
|
|
||||||
|
@rom/<write-byte> ( byte -- )
|
||||||
|
head/get-inc
|
||||||
|
( | test zero-page )
|
||||||
|
OVR ?{
|
||||||
|
POP2 POP
|
||||||
|
( ! ) ;dict/zero-page ;dict/Writing !err/<token> }
|
||||||
|
!rom/<put>
|
||||||
|
|
||||||
|
@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/<set-rel> ( addr* -- )
|
||||||
|
/get ADD2
|
||||||
|
( >> )
|
||||||
|
|
||||||
|
@head/<set> ( addr* -- )
|
||||||
|
,&addr STR2
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
(
|
||||||
|
@|Stdlib )
|
||||||
|
|
||||||
|
@hof/<each> ( 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* <val> )
|
||||||
|
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/<token> ( adj* topic* -- )
|
||||||
|
.System/state DEI ?{
|
||||||
|
[ LIT2 01 -System/state ] DEO
|
||||||
|
/<print>
|
||||||
|
#20 /<emit>
|
||||||
|
/<print>
|
||||||
|
;dict/spacer /<print>
|
||||||
|
;token/buf /<print>
|
||||||
|
;token/line LDA2 ;scope/buf !/<print-location> }
|
||||||
|
POP2 POP2 JMP2r
|
||||||
|
|
||||||
|
@err/<resolution> ( adj* -- )
|
||||||
|
.System/state DEI ?{
|
||||||
|
[ LIT2 01 -System/state ] DEO
|
||||||
|
;dict/Reference /<print>
|
||||||
|
#20 /<emit>
|
||||||
|
/<print>
|
||||||
|
;dict/spacer /<print>
|
||||||
|
[ LIT2 &ref $2 ] INC2k INC2 LDA2 #0003 ADD2 /<print>
|
||||||
|
DUP2 #0008 ADD2 LDA2 SWP2 #0006 ADD2 LDA2 #0003 ADD2 !/<print-location> }
|
||||||
|
POP2 JMP2r
|
||||||
|
|
||||||
|
@err/<print-location> ( line* scope* -- )
|
||||||
|
;dict/in /<print>
|
||||||
|
/<print>
|
||||||
|
LIT ": /<emit>
|
||||||
|
/<pdec>
|
||||||
|
#0a /<emit>
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
@err/<generic> ( adj* keyword* topic* -- )
|
||||||
|
.System/state DEI ?{
|
||||||
|
[ LIT2 01 -System/state ] DEO
|
||||||
|
/<print>
|
||||||
|
#20 /<emit>
|
||||||
|
SWP2 /<print>
|
||||||
|
;dict/spacer /<print>
|
||||||
|
/<print>
|
||||||
|
#0a /<emit>
|
||||||
|
JMP2r }
|
||||||
|
POP2 POP2 POP2 JMP2r
|
||||||
|
|
||||||
|
@err/<print> ( str* -- )
|
||||||
|
;/<emit> !hof/<each>
|
||||||
|
|
||||||
|
@err/<pdec> ( short* -- )
|
||||||
|
[ LIT2r ff00 ]
|
||||||
|
&>read
|
||||||
|
#000a DIV2k STH2k MUL2 SUB2 STH2r INCr ORAk ?&>read
|
||||||
|
POP2
|
||||||
|
&>write
|
||||||
|
NIP #30 ADD /<emit>
|
||||||
|
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
|
||||||
509
utils/opctest.tal
Normal file
509
utils/opctest.tal
Normal file
|
|
@ -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
|
||||||
|
|
||||||
BIN
utils/uxnmin
Executable file
BIN
utils/uxnmin
Executable file
Binary file not shown.
135
utils/uxnmin.c
Normal file
135
utils/uxnmin.c
Normal file
|
|
@ -0,0 +1,135 @@
|
||||||
|
#include <stdio.h>
|
||||||
|
|
||||||
|
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;
|
||||||
|
}
|
||||||
30
uxn.opam
Normal file
30
uxn.opam
Normal file
|
|
@ -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 <lobo@quiltro.org>"]
|
||||||
|
authors: ["Javier B. Torres <lobo@quiltro.org>"]
|
||||||
|
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)"]
|
||||||
Loading…
Add table
Add a link
Reference in a new issue