and run in an internal PROCESS, though some fundamental ops need to be
compiled for a particular type of GC implementation (because hooks for
allocation and read/write barriers need to be as fast as possible).
+
+# Loading MIM Libraries
+
+Usually a whole library (like the stdlib) is statically linked into
+one file, but per-file dynamic linking is also possible.
+
+Run some code from the file, typically a standard loader in the
+header--the loading process is up to the MIM code.
+
+Standard loader needs to, at minimum:
+- lookup some ATOMs from const STRINGs
+- SETG those ATOMs (to LAZY.UBLOCK stub objects or upfront-loaded RVECTORs)
+
+On a MSUBR's first call (or earlier), it's necessary to:
+- create its RVECTOR, including its CODE object
+
+File will look like:
+[ module loader CODE ] (not needed after load)
+[ STRINGs for ATOMs defined on load ] (not needed after load)
+[ RVECTOR loaders... ] (const, each needed once)
+[ MSUBR CODE... ] (rw, persistent)
+
+--if we use the CODE in-place (as mmap'd), the GC can ignore it completely
+RVECTOR loaders:
+- all at once?
+ - much more efficient if we're going to be running them all anyway
+ - section becomes droppable
+ - simpler
+- lazily?
+ - work scales with functions called, not functions available
+ - have to mmap in low-space to make the CODE directly accessible
+- it's up to the loader; initial impl will be upfront
+
+MSUBR calls in a MSUBR can be:
+- unlinked: ATOM in RVECTOR, NTHRGL to look up current value each call
+- linked: MSUBR in RVECTOR, set up by loader
--- /dev/null
+;;; Copyright (C) 2018 Keziah Wesley
+;;;
+;;; You can redistribute and/or modify this file under the terms of the
+;;; GNU Affero General Public License as published by the Free Software
+;;; Foundation, either version 3 of the License, or (at your option) any
+;;; later version.
+;;;
+;;; This file is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public
+;;; License along with this file. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+global _start
+default rel
+
+%macro doj 3
+ dw %1, %2
+ dd %3
+%endmacro
+
+%macro dop 4
+ db ((ops.%1 - ops)>>3), %2, %3, %4
+%endmacro
+%macro dop 3
+ db ((ops.%1 - ops)>>3), %2
+ dw %3
+%endmacro
+
+%macro defop 1
+ .%1: dq op_%1
+%endmacro
+
+;;; tracing: abort if not primtype match (XXX: actual tests usu. more complex...)
+%macro tr_guard_pt 1
+%endmacro
+
+;;; tracing: abort if not fulltype match
+%macro tr_guard_tt 1
+%endmacro
+
+%macro tr_guard_bounds 0
+%endmacro
+
+;;; profiling: count jumps if offset negative.
+%macro pr_j 2
+%endmacro
+
+;;; log if tracing. record if profiling and offset negative.
+%macro tr_br_taken 2
+%endmacro
+
+;;; tracing: log road not taken.
+%macro tr_br_fallthrough 2
+%endmacro
+
+%define PT_FIX 1h
+%define PT_BYTES 2h
+%define PT_STRING 3h
+%define PT_UBLOCK 4h
+%define PT_DOPE 5h
+%define PT_RECORD 6h
+%define PT_BYTES 7h
+
+%define TT_MSUBR (PT_RECORD | 0100h) ; aka RVECTOR
+%define TT_CODE (PT_UBLOCK | 0100h)
+%define TT_DOPE_UB (PT_DOPE | (PT_UBLOCK << 8))
+
+;%macro leafcall 1
+; lea r14, [.leaf_ret]
+; jmp %1
+; .leaf_ret:
+;%endmacro
+
+section .rodata
+align 8
+ops:
+ defop error
+ defop applyb
+ defop return
+ defop nthrb
+ defop princ
+ defop constb
+ defop halt
+ defop adj
+ defop subb
+ defop grtrb
+ defop mull
+ defop jump
+ defop andb
+ defop lshb
+ defop addb
+ defop newyl
+ defop putyl
+ defop restyl
+
+errStr db 'An error has occurred.',0xA
+errLen equ $-errStr
+
+byeStr db 0xA,'Goodbye!',0xA
+byeLen equ $-byeStr
+
+section .data
+
+ ;<destrucr? 1 # =>
+ ;<destrucxn 1 start..end>
+
+;reqs: ;<destrucr? 1 opts local1>
+ ;<destrucr? 1 opts local2>
+ ;<error NEED-MORE-ARGS>
+;opt1: ;<destrucr? 1 opt2 local3>
+ ;<... =local2>
+;opt2: ;<destrucr? 1 chk local4>
+ ;<... =local3>
+;chk: ;<empr? 1 body>
+ ;<error TOO-MANY-ARGS>
+;body:
+
+;reqs: ;<destrucxn local1..local2>
+;opt1: ;<destrucr? 1 opt2 local3>
+ ;<... =local2>
+;opt2: ;<destrucr? 1 chk local4>
+ ;<... =local3>
+;chk: ;<empr? 1 body>
+ ;<error TOO-MANY-ARGS>
+;body:
+
+;; <MAPF ,STRING <FUNCTION (x) ...>>
+
+unparse_code:
+ ;; implicit locals (0-1):
+ ;; 0: RVECTOR
+ ;; 1: ARGS TUPLE
+ ;; reserved locals (2-2):
+ ;; 2: N (arg)
+ ;; 3: buf
+ ;; 4: x
+ ;; 5: i
+ ;; stack (4-):
+ dop adj, 3, 0
+ dop nthrb, 0, 1, 2
+ dop constb, 12, 5, 0
+ dop newyl, 5, ' ', 3
+
+ dop andb, 7, 2, 4
+ dop lshb, -3, 2, 2
+ dop addb, '0', 4, 4
+ dop putyl, 5, 4, 3
+ dop subb, 1, 5, 5
+ dop grtrb, 0, -6, 2
+
+ dop restyl, 5, 3, 3
+ dop return, 3, 0
+ .len equ ($-unparse_code) >> 2
+ align 8
+ doj TT_DOPE_UB, 0, .len
+unparse_rv:
+ doj TT_CODE, unparse_code.len, unparse_code
+ doj TT_MSUBR, unparse_rv.len, unparse_rv
+ .len equ ($-unparse_rv) >> 3
+
+fact_code:
+ ;; implicit locals (0-1):
+ ;; 0: RVECTOR
+ ;; 1: ARGS TUPLE
+ ;; reserved locals (2-3):
+ ;; 2: N (arg)
+ ;; 3: FACT
+ ;; 4: tmp0
+ ;; stack (5-):
+ dop adj, 3, 0
+
+ dop nthrb, 0, 1, 2
+ dop nthrb, 1, 0, 3
+
+ dop grtrb, 1, 2, 2
+ dop constb, 1, 2, 0
+ dop return, 2, 0
+
+ dop subb, 1, 2, 5
+ dop applyb, 1, 3, 4
+ dop mull, 2, 4, 4
+ dop return, 4, 0
+ .len equ ($-fact_code) >> 2
+ align 8
+ doj TT_DOPE_UB, 0, .len
+fact_rv:
+ doj TT_CODE, fact_code.len, fact_code
+ doj TT_MSUBR, fact_rv.len, fact_rv
+ .len equ ($-fact_rv) >> 3
+
+toplevel_code:
+ ;; implicit locals (0-1):
+ ;; 0: RVECTOR
+ ;; 1: ARGS TUPLE
+ ;; reserved locals (2-2):
+ ;; 2: tmp0
+ ;; 3: MSUBR unparse
+ ;; stack (4-):
+ dop adj, 2, 0
+
+ dop constb, 5, 4, 0
+ dop nthrb, 1, 0, 2
+ dop applyb, 1, 2, 4
+
+ dop adj, 1, 0
+ dop nthrb, 2, 0, 3
+ dop applyb, 1, 3, 3
+ dop princ, 3, 0
+
+ dop constb, 0, 0, 2
+ dop halt, 2, 0
+ .len equ ($-toplevel_code) >> 2
+ align 8
+ doj TT_DOPE_UB, 0, .len
+toplevel_rv:
+ doj TT_CODE, toplevel_code.len, toplevel_code
+ doj TT_MSUBR, fact_rv.len, fact_rv
+ doj TT_MSUBR, unparse_rv.len, unparse_rv
+ .len equ ($-toplevel_rv) >> 3
+oj_toplevel doj TT_MSUBR, toplevel_rv.len, toplevel_rv
+
+section .bss
+
+;; state:
+;; esi: ip
+;; ebp: bp [nonnegative idxes are locals, neg are cur FRAME's fields]
+;; esp: sp [top of stack. starts at end of locals. grows UP.]
+;; edi: next free heap pos [grows up.]
+;; on entry into an op:
+;; rbx: B
+;; rax: CD
+
+section .text
+;; inline this for "release mode", but it's a useful breakpoint
+dispatch:
+ lodsd
+ movzx edx, al
+ movzx ebx, ah
+ shr eax, 16
+ jmp [ops + 8*rdx]
+
+%macro dispatch 0
+ jmp dispatch
+%endmacro
+
+_start:
+;; Setup memory layout:
+ mov edx, 1|2 ; int prot = PROT_READ | PROT_WRITE
+ mov r10d, 2|32|64 ; int flags = MAP_PRIVATE | MAP_ANONYMOUS | MAP_32BIT
+ mov r8d, -1 ; int fd = -1
+ xor edi, edi ; void *addr = NULL
+ xor r9d, r9d ; off_t offset = 0
+;; initial stack (1MB)
+ mov esi, 100000h ; size_t length
+ mov eax, 9 ; mmap
+ syscall
+ mov esp, eax
+;; major heap...
+;; (large-alloc space)...
+;; FFI stack pool...
+;; minor heap (default: 8MB)
+ mov esi, 800000h ; size_t length
+ mov eax, 9 ; mmap
+ syscall
+ mov edi, eax
+
+;; Load some builtins into the heap
+
+;; Setup a PROCESS for the GC...
+
+;; boot:
+ ;; point locals to a static MSUBR object for the toplevel MSUBR
+ mov ebp, oj_toplevel
+ ;; set eax,ebx as if we'd just read <APPLY 0 0 0>
+ xor eax, eax
+ xor ebx, ebx
+ xor esi, esi ; toplevel must not return
+ jmp op_applyb
+
+op_princ: ; PRINC [B]:STRING
+ mov rax, [rbp + 8*rbx]
+ cmp al, PT_STRING
+ je .string
+ cmp al, PT_BYTES
+ jne error
+.bytes:
+.string:
+ mov r8, rsi
+ mov r9, rdi
+
+ mov edx, eax ; size_t
+ shr edx, 16 ; count
+ shr rax, 32 ; const void *
+ mov esi, eax ; buf
+ mov eax, 1 ; write(2)
+ mov edi, eax ; int fd = stdout
+ syscall
+
+ mov rsi, r8
+ mov rdi, r9
+
+ cmp eax, edx
+ jne error
+
+ dispatch
+
+op_halt: ; HALT [B]:FIX
+ mov edx, byeLen ; size_t count
+ mov esi, byeStr ; const void *buf
+ mov eax, 1 ; write(2)
+ lea edi, [rax+rax] ; int fd = stderr
+ syscall
+
+ mov rax, [rbp + 8*rbx]
+ cmp al, PT_FIX
+ ;jne error
+ shr rax, 32
+ mov edi, eax ; int status
+ mov eax, 60 ; exit(2)
+ syscall
+
+op_applyb: ; <APPLY nargs:byte local:msubr =>
+ ; ignore [=] for now. we'll re-decode this insn in op_return
+ movzx eax, al
+ mov rax, [rbp + 8*rax]
+ cmp ax, TT_MSUBR
+ jne error
+ mov rdx, rax
+
+%ifdef DEBUG
+ test eax, 0ffff0000h
+ jz error
+%endif
+
+ shr rax, 32
+ mov rax, [rax]
+
+%ifdef DEBUG
+ cmp ax, TT_CODE
+ jne error
+ test eax, 0ffff0000h
+ jz error
+%endif
+
+ mov ecx, ebx
+ ;; save a FRAME of state to return to:
+ neg rbx
+ lea ebx, [rsp+8*rbx]
+ add esp, 16
+ mov r8d, ebp
+ mov ebp, esp
+ ;; FRAME:
+ ;mov [rbp-16], e-- ; padding
+ mov [rbp-12], ebx ; start of args on stack
+ mov [rbp-8], esi ; return-to ip
+ mov [rbp-4], r8d ; prev FRAME/locals boundary
+ ;; implicit locals:
+ shl rbx, 32
+ shl ecx, 16
+ lea rbx, [rbx+rcx+PT_RECORD]
+ mov [rbp], rdx ; 0: MSUBR (RVECTOR)
+ mov [rbp+8], rbx ; 1: ARGS TUPLE
+
+ add esp, 24
+
+ shr rax, 32
+ mov esi, eax
+
+ dispatch
+
+op_return: ; <RETURN any:local>
+ mov rbx, [rbp+8*rbx]
+
+ mov esp, [rbp-12]
+ mov esi, [rbp-8]
+ mov ebp, [rbp-4]
+
+ mov eax, [rsi-4]
+ shr eax, 24
+ mov [rbp+8*rax], rbx
+
+ dispatch
+
+op_nthrb: ; <NTH index:byte record:local =>
+ movzx ecx, al
+ movzx edx, ah
+ mov rax, [rbp + 8*rcx]
+ cmp al, PT_RECORD
+ ;; TODO: fallback to pmorphic
+ jne error
+
+ mov ecx, eax
+ shr ecx, 16
+ cmp ebx, ecx
+ jge error
+
+ shr rax, 32
+ mov rax, [rax+8*rbx]
+ mov [rbp+8*rdx], rax
+
+ dispatch
+
+ ;; BodyLnTP
+
+op_restyl: ; <RESTYL index:local bytes:local =>
+ movzx ecx, al
+ movzx edx, ah
+ mov rax, [rbp + 8*rcx]
+ cmp al, PT_BYTES
+ ;; TODO: fallback to pmorphic
+ jne error
+
+ mov rbx, [rbp + 8*rbx]
+ sub rbx, PT_FIX ; (dec rbx) if PT_FIX==1
+ test bx, bx
+ jnz error
+
+ add rax, rbx
+ rol rax, 32
+ rol rbx, 16
+ sub rax, rbx
+ jo error
+ ror rax, 32
+ mov [rbp+8*rdx], rax
+
+ dispatch
+
+op_putyl: ; <PUTYL local:index value:local local:bytes>
+ movzx edx, al
+
+ mov rcx, [rbp + 8*rbx]
+ cmp cl, PT_FIX
+ jne error
+ shr rcx, 32
+ jz error
+ ;; rcx = offset
+
+ movzx eax, ah
+ mov rax, [rbp + 8*rax]
+ cmp al, PT_BYTES
+ ;; TODO: fallback to pmorphic
+ jne error
+ ;; rax = bytes
+
+ mov rdx, [rbp + 8*rdx]
+ cmp dx, PT_FIX
+ jne error
+ shr rdx, 32
+ ;; rdx = val
+
+ shr rax, 16
+ cmp cx, ax
+ jg error
+ shr rax, 16
+ mov [rax + rcx - 1], dl
+
+ dispatch
+
+op_constb: ; <CONSTB byte = hitype:byte>
+ movzx edx, al
+ sub eax, edx
+ or eax, PT_FIX
+ shl rbx, 32
+ or rbx, rax
+ mov [rbp+8*rdx], rbx
+
+ dispatch
+
+op_adj: ; <ADJ byte>
+ lea esp, [rsp+8*rbx]
+
+ dispatch
+
+op_subb: ; <SUBB rhs:byte in:fix =>
+ movzx edx, ah
+ movzx eax, al
+ mov rax, [rbp+8*rax]
+ cmp ax, PT_FIX
+ setne cl
+ shl rbx, 32
+ sub rax, rbx
+ seto bl
+ or cl, bl
+ jnz error
+ mov [rbp+8*rdx], rax
+
+ dispatch
+
+op_addb: ; <ADDB ubyte local:fix =>
+ movzx edx, ah
+ movzx eax, al
+ mov rax, [rbp+8*rax]
+ cmp ax, PT_FIX
+ setne cl
+ shl rbx, 32
+ add rax, rbx
+ seto bl
+ or cl, bl
+ jnz error
+ mov [rbp+8*rdx], rax
+
+ dispatch
+
+op_andb: ; <ANDB byte local:fix =>
+ movzx edx, ah
+ movzx eax, al
+ mov rax, [rbp+8*rax]
+ cmp ax, PT_FIX
+ jne error
+ shl rbx, 32
+ and rax, rbx
+ or rax, PT_FIX
+ mov [rbp+8*rdx], rax
+
+ dispatch
+
+op_lshb: ; <LSHB byte local:fix =>
+ movzx edx, ah
+ movzx eax, al
+ mov rax, [rbp+8*rax]
+ cmp ax, PT_FIX
+ jne error
+ lea ecx, [rbx-32]
+ neg ecx
+ shr rax, cl
+ shl rax, 32
+ or rax, PT_FIX
+ mov [rbp+8*rdx], rax
+
+ dispatch
+
+op_newyl: ; <NEWYB len:local initial:byte =>
+ movzx edx, ah
+
+ mov rbx, [rbp+8*rbx]
+ cmp bx, PT_FIX
+ jne error
+ shr rbx, 32
+
+ movzx eax, al ; " a"
+ mov ecx, eax
+ shl ecx, 8
+ or eax, ecx ; " aa"
+ mov ecx, eax
+ shl ecx, 16
+ or eax, ecx ; " aaaa"
+ mov ecx, eax
+ shl rcx, 32
+ or rax, rcx ; "aaaaaaaa"
+
+ mov ecx, ebx
+
+ ;; write object
+ shl rbx, 48
+ or rbx, rdi
+ rol rbx, 32
+ or rbx, PT_BYTES
+ mov [rbp+8*rdx], rbx
+
+ ;jmp blitheap_op
+blitheap_op: ; rax=init ecx=len (dword [rdx]: rewritten if base != edi)
+ add ecx, 7
+ shr ecx, 3
+ lea ecx, [rdi + rcx]
+.init:
+ stosq
+ cmp edi, ecx
+ jl .init
+
+ dispatch
+
+op_mull: ; <MULL b:fix c:fix =>
+ movzx edx, ah
+ movzx eax, al
+ mov rbx, [rbp+8*rbx]
+ mov rax, [rbp+8*rax]
+ cmp bx, PT_FIX
+ setne cl
+ cmp ax, bx
+ setne ch
+ or cl, ch
+ shr rbx, 32
+ shr rax, 32
+ imul eax, ebx
+ seto ch
+ or cl, ch
+ jnz error
+ shl rax, 32
+ or rax, PT_FIX
+ mov [rbp+8*rdx], rax
+
+ dispatch
+
+op_grtrb: ; <GRTRB? rhs:byte tgt in:fix>
+ movsx rdx, al
+ movzx eax, ah
+ mov rax, [rbp+8*rax]
+ cmp ax, PT_FIX
+ jne error
+ shr rax, 32
+ cmp eax, ebx
+ jle .done
+ lea esi, [rsi+4*rdx]
+.done:
+ dispatch
+
+op_jump: ; <JUMP . ##>
+ movsx eax, ax
+ lea esi, [esi+4*eax]
+ dispatch
+
+op_error: ; ERROR local:atom local:any local:any
+error:
+ mov r8d, esi
+ mov r9d, edi
+
+ mov edx, errLen ; size_t count
+ mov esi, errStr ; const void *buf
+ mov eax, 1 ; write(2)
+ lea edi, [rax+rax] ; int fd = stderr
+ syscall
+
+ mov esi, r8d
+ mov edi, r9d
+
+ mov edi, -1 ; int status
+ mov eax, 60 ; exit(2)
+ syscall
projects / muddle.git / commitdiff