make #010e DEO print stack in the recommended repr
This commit is contained in:
parent
b71cf4343e
commit
bc1bae5977
8 changed files with 837 additions and 52 deletions
2
exe/dune
2
exe/dune
|
|
@ -1,4 +1,4 @@
|
|||
(executable
|
||||
(public_name uxnemu)
|
||||
(name uxnemu)
|
||||
(libraries uxn varvara unix fmt))
|
||||
(libraries uxn varvara unix))
|
||||
|
|
|
|||
|
|
@ -9,28 +9,22 @@ module Console = Varvara.Console.Make ()
|
|||
module File =
|
||||
Uxn.Device.Compose
|
||||
(Varvara.File.Make (struct
|
||||
let start_addr = 0xa0
|
||||
let start = 0xa0
|
||||
end))
|
||||
(Varvara.File.Make (struct
|
||||
let start_addr = 0xb0
|
||||
let start = 0xb0
|
||||
end))
|
||||
|
||||
module Devices =
|
||||
Uxn.Device.Compose (Uxn.Device.Compose (System) (Console)) (File)
|
||||
|
||||
let print_stack ~name (Machine.Stack { data; sp }) =
|
||||
Fmt.epr "%s: @[%a@]@." name
|
||||
(Fmt.on_bytes (Fmt.octets ()))
|
||||
(Bytes.sub data 0 sp)
|
||||
|
||||
let run m pc =
|
||||
let dev = Machine.dev m in
|
||||
try Machine.dispatch ~trace m pc with
|
||||
| effect Machine.Trace (pc, instr, args), k ->
|
||||
if trace then begin
|
||||
Fmt.epr "PC = %04x | %6s %a@." pc (Instr.to_string instr)
|
||||
(Fmt.list ~sep:(Fmt.any " ") (Fmt.fmt "%02x"))
|
||||
args;
|
||||
Printf.eprintf "PC = %04x %6s %s\n" pc (Instr.to_string instr)
|
||||
(List.map (Format.sprintf "%02x") args |> String.concat " ");
|
||||
Out_channel.flush stderr
|
||||
end;
|
||||
continue k ()
|
||||
|
|
@ -49,7 +43,7 @@ let run m pc =
|
|||
|
||||
let main () =
|
||||
if Array.length Sys.argv < 2 then (
|
||||
Fmt.epr "usage: uxnemu file.rom ...\n";
|
||||
Printf.eprintf "usage: uxnemu file.rom ...\n";
|
||||
exit 1);
|
||||
|
||||
let code =
|
||||
|
|
@ -92,11 +86,6 @@ let main () =
|
|||
done
|
||||
with Exit -> console_input 0 4
|
||||
end;
|
||||
|
||||
if trace then begin
|
||||
print_stack ~name:"wst" (Machine.wst mach);
|
||||
print_stack ~name:"rst" (Machine.rst mach)
|
||||
end;
|
||||
exit (Bytes.get_uint8 dev 0x0f land 0x7f)
|
||||
|
||||
let _ = main ()
|
||||
|
|
|
|||
|
|
@ -5,7 +5,10 @@ open Effect
|
|||
type stack = Stack of { data : bytes; mutable sp : int }
|
||||
type mode = Mode of { short : bool; keep : bool; mutable temp : int }
|
||||
|
||||
let stack_create () = Stack { data = Bytes.create 256; sp = 0 }
|
||||
let stack_create () =
|
||||
let data = Bytes.create 256 in
|
||||
Bytes.unsafe_fill data 0 256 '\x00';
|
||||
Stack { data; sp = 0 }
|
||||
|
||||
let peek (Mode { short; keep; temp }) (Stack { data; sp }) : int =
|
||||
let amt = if short then 2 else 1 in
|
||||
|
|
@ -36,13 +39,6 @@ let pushbyte (Mode m) s v =
|
|||
m.temp <- temp
|
||||
[@@inline]
|
||||
|
||||
let pushshort (Mode m) s v =
|
||||
let m' = Mode { m with short = true } in
|
||||
push m' s v;
|
||||
let (Mode { temp; _ }) = m' in
|
||||
m.temp <- temp
|
||||
[@@inline]
|
||||
|
||||
let popbyte (Mode m) s =
|
||||
let m' = Mode { m with short = false } in
|
||||
let r = pop m' s in
|
||||
|
|
@ -75,9 +71,6 @@ type _ Effect.t +=
|
|||
| DEI : ([ `Byte | `Short ] * int) -> int Effect.t
|
||||
| DEO : (int * int) -> unit Effect.t
|
||||
| Trace : (int * Instr.t * int list) -> unit Effect.t
|
||||
| Breakpoint : int -> unit Effect.t
|
||||
|
||||
type machine_state = Break | Next of int
|
||||
|
||||
let ram (Machine { data; _ }) = data
|
||||
let dev (Machine { dev; _ }) = dev
|
||||
|
|
|
|||
|
|
@ -5,10 +5,6 @@ val stack_create : unit -> stack
|
|||
val peek : mode -> stack -> int
|
||||
val pop : mode -> stack -> int
|
||||
val push : mode -> stack -> int -> unit
|
||||
val pushbyte : mode -> stack -> int -> unit
|
||||
val pushshort : mode -> stack -> int -> unit
|
||||
val popbyte : mode -> stack -> int
|
||||
val popshort : mode -> stack -> int
|
||||
|
||||
type machine
|
||||
|
||||
|
|
@ -17,14 +13,11 @@ val dev : machine -> bytes
|
|||
val wst : machine -> stack
|
||||
val rst : machine -> stack
|
||||
|
||||
type machine_state = Break | Next of int
|
||||
|
||||
type _ Effect.t +=
|
||||
| BRK : int Effect.t
|
||||
| DEI : ([ `Byte | `Short ] * int) -> int Effect.t
|
||||
| DEO : (int * int) -> unit Effect.t
|
||||
| Trace : (int * Instr.t * int list) -> unit Effect.t
|
||||
| Breakpoint : int -> unit Effect.t
|
||||
|
||||
val create : string -> machine
|
||||
val dispatch : ?trace:bool -> machine -> int -> 'a
|
||||
|
|
|
|||
|
|
@ -5,24 +5,21 @@ type file_state =
|
|||
| Dir_read of Unix.dir_handle * string (* dir_handle, filepath *)
|
||||
| Dir_write
|
||||
|
||||
type file_device = {
|
||||
type state = {
|
||||
mutable filepath : string option;
|
||||
mutable state : file_state;
|
||||
mutable length : int;
|
||||
}
|
||||
|
||||
module type ADDR = sig
|
||||
val start_addr : int
|
||||
val start : int
|
||||
end
|
||||
|
||||
module Make (Addr : ADDR) : Uxn.Device.DEVICE with type state = file_device =
|
||||
struct
|
||||
type state = file_device
|
||||
module Make (Addr : ADDR) : Uxn.Device.DEVICE with type state = state = struct
|
||||
type nonrec state = state
|
||||
|
||||
let state = { filepath = None; state = Idle; length = 0 }
|
||||
|
||||
let can_handle port =
|
||||
port >= Addr.start_addr && port <= Addr.start_addr + 0x0f
|
||||
let can_handle port = port >= Addr.start && port <= Addr.start + 0x0f
|
||||
|
||||
let read_cstring ram addr =
|
||||
let buf = Buffer.create 256 in
|
||||
|
|
@ -204,17 +201,15 @@ struct
|
|||
let open Uxn in
|
||||
let ram = Machine.ram mach in
|
||||
let dev = Machine.dev mach in
|
||||
let with_success result =
|
||||
file_success dev (Addr.start_addr + 0x02) result
|
||||
in
|
||||
match port - Addr.start_addr with
|
||||
let with_success result = file_success dev (Addr.start + 0x02) result in
|
||||
match port - Addr.start with
|
||||
| 0x0a -> state.length <- value
|
||||
| 0x04 -> file_stat (Machine.ram mach) value state.length |> with_success
|
||||
| 0x06 -> file_delete () |> with_success
|
||||
| 0x08 -> file_init (Machine.ram mach) value |> with_success
|
||||
| 0x0c -> file_read (Machine.ram mach) value state.length |> with_success
|
||||
| 0x0e ->
|
||||
let append = Bytes.get_uint8 dev (Addr.start_addr + 0x07) in
|
||||
let append = Bytes.get_uint8 dev (Addr.start + 0x07) in
|
||||
file_write ram value state.length append |> with_success
|
||||
| _ -> ()
|
||||
end
|
||||
|
|
|
|||
|
|
@ -9,9 +9,13 @@ module Make () : Uxn.Device.DEVICE with type state = state = struct
|
|||
let can_handle port = port >= 0x00 && port <= 0x0f
|
||||
|
||||
let print_stack ~name (Machine.Stack { data; sp }) =
|
||||
Fmt.epr "%s: @[%a@]@." name
|
||||
(Fmt.on_bytes (Fmt.octets ()))
|
||||
(Bytes.sub data 0 sp)
|
||||
Printf.eprintf "%s " name;
|
||||
for i = sp - 8 to sp - 1 do
|
||||
Printf.eprintf "%02x%s"
|
||||
(Bytes.get_uint8 data (i land 0xff))
|
||||
(if i land 0xff == 0xff then "|" else " ")
|
||||
done;
|
||||
Printf.eprintf "<%02x\n" sp
|
||||
|
||||
let get_bank mach bank =
|
||||
if bank = 0 then Machine.ram mach
|
||||
|
|
|
|||
|
|
@ -1,3 +1,3 @@
|
|||
(library
|
||||
(name varvara)
|
||||
(libraries uxn fmt unix))
|
||||
(libraries uxn unix))
|
||||
|
|
|
|||
811
utils/drifblim.tal
Normal file
811
utils/drifblim.tal
Normal file
|
|
@ -0,0 +1,811 @@
|
|||
( usage: drifblim.rom input.tal output.rom )
|
||||
|
||||
|00 @System/vector $2 &expansion $2 &wst $1 &rst $1 &metadata $2 &r $2 &g $2 &b $2 &debug $1 &state $1
|
||||
|10 @Console/vector $2 &read $1 &pad $4 &type $1 &write $1 &error $1
|
||||
|a0 @File/vector $2 &success $1 &success-lb $1 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|
||||
|
||||
|000
|
||||
|
||||
@src/buf $3f &cap $1
|
||||
@dst/buf $3f &cap $1
|
||||
@scope/buf $3f &cap $1
|
||||
@token/buf $3f &cap $1
|
||||
|
||||
|100
|
||||
|
||||
@on-reset ( -> )
|
||||
;meta #06 DEO2
|
||||
;dict/reset scope/<set>
|
||||
;src/on-console
|
||||
( >> )
|
||||
|
||||
@bind ( vector* -> )
|
||||
.Console/vector DEO2
|
||||
[ LIT2 03 -Console/type ] DEI AND ?{
|
||||
;dict/usage err/<print>
|
||||
[ LIT2 01 -System/state ] DEO }
|
||||
BRK
|
||||
|
||||
@src/on-console ( -> )
|
||||
[ LIT2 02 -Console/type ] DEI LTH ?{
|
||||
.Console/read DEI [ LIT2 -&cap &ptr -&buf ] INCk ,&ptr STR
|
||||
NEQk ?{ ;dict/exceeded ;&buf ;dict/Path err/<generic> }
|
||||
NIP STZ
|
||||
BRK }
|
||||
( | src -> dst )
|
||||
;dst/on-console !bind
|
||||
|
||||
@dst/on-console ( -> )
|
||||
[ LIT2 02 -Console/type ] DEI LTH ?{ .Console/read DEI /<push>
|
||||
BRK }
|
||||
( | assemble )
|
||||
;src/buf assembly/<handle-file>
|
||||
assembly/<resolve>
|
||||
BRK
|
||||
|
||||
@dst/<push> ( c -- )
|
||||
[ LIT2 -&cap &ptr -&buf ] INCk ,&ptr STR
|
||||
NEQk ?{ ;dict/exceeded ;&buf ;dict/Path err/<generic> }
|
||||
NIP STZ
|
||||
JMP2r
|
||||
|
||||
@dst/<push-str> ( str* -- )
|
||||
LDAk DUP ?{ POP POP2 JMP2r }
|
||||
/<push>
|
||||
INC2 !/<push-str>
|
||||
|
||||
@err/<emit> ( c -- )
|
||||
#19 DEO
|
||||
JMP2r
|
||||
|
||||
@runes/concat INC2
|
||||
( >> )
|
||||
|
||||
@assembly/<handle-file> ( f* -- )
|
||||
.File/name DEO2
|
||||
#0001 .File/length DEO2
|
||||
token/<new>
|
||||
#0000
|
||||
&>s
|
||||
.System/state DEI ?&end
|
||||
;&c .File/read DEO2
|
||||
.File/success-lb DEI ?{
|
||||
ORAk ?{ ;dict/invalid ;src/buf ;dict/File err/<generic> }
|
||||
&end ( i* -- )
|
||||
POP2 JMP2r }
|
||||
INC2 [ LIT &c $1 ] token/<push-byte> !&>s
|
||||
|
||||
@rom/<put> ( byte addr* -- )
|
||||
,&dst STR2
|
||||
,&v STR
|
||||
;&mmu-put .System/expansion DEO2
|
||||
JMP2r
|
||||
|
||||
&mmu-put [ 00 0001 0001 &dst $2 &v $1 ]
|
||||
&mmu-get [ 01 0001 0001 &src $2 0000 =&buf ] &buf $1
|
||||
|
||||
@rom/<emit> ( -- )
|
||||
;dict/assembled err/<print>
|
||||
#20 err/<emit>
|
||||
;dst/buf err/<print>
|
||||
;dict/in err/<print>
|
||||
;head/length LDA2 DUP2 #0100 SUB2 err/<pdec>
|
||||
;dict/bytes err/<print>
|
||||
( | emit rom )
|
||||
;dst/buf .File/name DEO2
|
||||
#0001 .File/length DEO2
|
||||
#0100
|
||||
&>ler
|
||||
DUP2 ,&src STR2
|
||||
;&mmu-get .System/expansion DEO2
|
||||
;&buf .File/write DEO2
|
||||
INC2 GTH2k ?&>ler
|
||||
POP2 POP2
|
||||
( | emit sym )
|
||||
;dict/sym-ext dst/<push-str>
|
||||
;dst/buf .File/name DEO2
|
||||
;syms/ptr LDA2 ;syms/mem
|
||||
&>les
|
||||
#0002 .File/length DEO2
|
||||
DUP2 .File/write DEO2
|
||||
#0003 ADD2 DUP2 str/cap SWP2k SUB2 .File/length DEO2
|
||||
SWP2 .File/write DEO2
|
||||
GTH2k ?&>les
|
||||
POP2 POP2 JMP2r
|
||||
|
||||
@dict/usage "usage: 20 "drifblim.rom 20 "in.tal 20 "out.rom 0a $1
|
||||
&Path "Path $1
|
||||
&File "File $1
|
||||
&sym-ext ".sym $1
|
||||
|
||||
@meta $1
|
||||
( name ) "Drifblim 0a
|
||||
( desc ) "Uxntal 20 "Assembler 0a
|
||||
( auth ) "By 20 "Devine 20 "Lu 20 "Linvega 0a
|
||||
( date ) "25 20 "Nov 20 "2025 $2
|
||||
|
||||
|
||||
|
||||
( Core )
|
||||
|
||||
@assembly/<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 [ LIT2 &count $2 ] INC2k ,&count STR2
|
||||
DUP2 [ LIT2 &ptr =&mem ] INC2k INC2 ,&ptr STR2
|
||||
STA2
|
||||
( >> )
|
||||
|
||||
@lambda/name ( id* -- str* )
|
||||
/name-part ROT /name-part ,&id1 STR2
|
||||
,&id2 STR2
|
||||
;&sym JMP2r
|
||||
|
||||
@lambda/name-part ( id -- hexchar hexchar )
|
||||
DUP #04 SFT hexc SWP !hexc
|
||||
|
||||
@lambda/pop ( -- )
|
||||
,&ptr LDR2 #0002 SUB2 LDA2k /name syms/<new>
|
||||
,&ptr STR2
|
||||
JMP2r
|
||||
&sym cebb
|
||||
&id1 "..
|
||||
&id2 ".. 00
|
||||
|
||||
(
|
||||
@|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 ;refs/ptr LDA2 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 ,&ptr LDR2 #000a SUB2 ,&ptr STR2
|
||||
( 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>
|
||||
,&ptr LDR2 #000a SUB2 ,&ptr STR2 }
|
||||
( | mark as used )
|
||||
syms/use LDA2 JMP2r
|
||||
|
||||
@refs/<push-short> ( value* -- )
|
||||
SWP /<push-byte>
|
||||
( >> )
|
||||
|
||||
@refs/<push-byte> ( byte -- )
|
||||
[ LIT2 &ptr =&memend ] INC2k
|
||||
( | check overflow )
|
||||
DUP2 ;syms/ptr LDA2 GTH2 ?{
|
||||
( ! ) ;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 ;&memend
|
||||
&>l
|
||||
EQU2k ?{
|
||||
#000a SUB2 DUP2 ;err/ref STA2
|
||||
DUP2k #0004 ADD2 LDA2 JSR2 !&>l }
|
||||
POP2 POP2 JMP2r
|
||||
|
||||
@refs/resolve-sym ( ref* -- ref* sym/addr* )
|
||||
LDA2k head/<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 $200
|
||||
|
||||
@macros/mem ( name\0, value\0 )
|
||||
$1000 &memend
|
||||
|
||||
@syms/mem ( addr*, SymType, name\0 )
|
||||
$7000 &memend
|
||||
|syms/mem @refs/mem ( addr*, symbol*, type-fn*, scope*, line* )
|
||||
$7000 &memend
|
||||
|
||||
@rom/mem ( zeropage )
|
||||
$100
|
||||
&output
|
||||
(
|
||||
@|Enums )
|
||||
|
||||
|
||||
|00 @SymType/empty $1 &used $1 &declared
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue