100 lines
4.7 KiB
Fennel
100 lines
4.7 KiB
Fennel
(local Sqlog (require :sqlog))
|
|
(import-macros {: $ : specify : query} :sqlog.macros)
|
|
|
|
(fn nextval [varname] ($ (+ (coalesce (max ,[:var varname]) 0) 1)))
|
|
|
|
(local Cpu {})
|
|
(fn Cpu.new [self ?filename]
|
|
(set self.sqlog (Sqlog ?filename))
|
|
(set self.instructions [])
|
|
(self:init-new-db))
|
|
|
|
(fn Cpu.init-new-db [self]
|
|
"Initialize a fresh database with the necessary tables and rules."
|
|
(specify self.sqlog
|
|
; cpu layout:
|
|
(table cpu.running process-id)
|
|
[cpu.running 0] ; 0 means nothing
|
|
(table cpu.fp process-id frame-id)
|
|
(table cpu.frame frame-id var-id value)
|
|
(table cpu.program program-id instruction-id instruction)
|
|
; special frame variables:
|
|
; $result - the anonymous result of the most recent computation (useful?)
|
|
; $fp-return - the frame-id to return to when finished
|
|
; $program - the id of the program that the frame is referencing
|
|
; $ip - the id of the instruction within the program that the process is executing
|
|
|
|
; function calls create a new frame by incrementing cpu.next-fp and populating cpu.frame.
|
|
; returning from a function call sets the $result of $fp-return to the $result of the current frame,
|
|
; sets cpu.fp for the current process to $fp-return, and removes all data from cpu.frame with the current frame ID.
|
|
(table compiler.sourcemap program-id instruction-id filename position)
|
|
|
|
(* [cpu.next-process ,(nextval :process-id)] [cpu.fp process-id _])
|
|
(* [cpu.next-fp ,(nextval :frame-id)] [cpu.frame frame-id _ _])
|
|
(* [cpu.next-program-id ,(nextval :program-id)] [cpu.program program-id _ _ _])
|
|
(* [cpu.next-instruction-id program-id ,(nextval :instruction-id)] [cpu.program program-id instruction-id _ _])
|
|
(* [cpu.next-instruction-id next-program-id 1] [cpu.next-program-id next-program-id])
|
|
(* [cpu.frame-var var-id value] [cpu.running process-id] [cpu.fp process-id frame-id] [cpu.frame frame-id var-id value])
|
|
(* [cpu.my-fp fp] [cpu.running pid] [cpu.fp pid fp])
|
|
(* [cpu.ip program-id ip] [cpu.frame-var :$ip ip] [cpu.frame-var :$program program-id])
|
|
(* [cpu.instruction instruction] [cpu.ip program-id ip] [cpu.program program-id ip instruction])
|
|
(* [cpu.return-fp fp] [cpu.frame-var :$fp-return fp])
|
|
|
|
; frame 1 destroys all processes that enter it (program 1 will implement this logic)
|
|
[cpu.frame 1 :$ip 1]
|
|
[cpu.frame 1 :$program 1])
|
|
|
|
; define program 1 for frame 1
|
|
(self:insert-program ($
|
|
(!- [cpu.fp _ 1])
|
|
(!= [cpu.frame _ _ 0] [cpu.frame 1 :$ip _]))) ; this shouldn't be needed
|
|
|
|
(set self.ret
|
|
(self:def-instruction
|
|
($ (!= [cpu.fp _ fp-return] [cpu.fp pid _] [cpu.running pid] [cpu.return-fp fp-return])))))
|
|
|
|
(fn Cpu.def-instruction [self ...]
|
|
"Creates a new reusable instruction and returns its ID"
|
|
(let [analysis (self.sqlog:compile-action [:do ...])]
|
|
(table.insert self.instructions analysis)
|
|
(length self.instructions)))
|
|
|
|
(fn Cpu.insert-program [self ...]
|
|
"Creates a new program with the specified instructions"
|
|
(let [[{: program-id}] (query self.sqlog [cpu.next-program-id program-id])]
|
|
(each [ip action (ipairs [...])]
|
|
(let [instruction (if (not= (type action) :table) action (self:def-instruction action))]
|
|
(specify self.sqlog [cpu.program #program-id #ip #instruction])))
|
|
program-id))
|
|
|
|
(fn Cpu.initialize-process [self program-id]
|
|
"Creates a new process, starting at the beginning of the specified program"
|
|
(let [[{: process-id : fp}] (query self.sqlog [cpu.next-process process-id] [cpu.next-fp fp])]
|
|
(specify self.sqlog
|
|
(!+ [cpu.fp #process-id #fp])
|
|
(!+ [cpu.frame #fp :$program #program-id])
|
|
(!+ [cpu.frame #fp :$ip 1])
|
|
(!+ [cpu.frame #fp :$fp-return 1]))))
|
|
|
|
(fn Cpu.process-round [self]
|
|
"Executes each currently-active process until it hits a suspend instruction or is removed."
|
|
(let [process-ids (query self.sqlog [cpu.fp process-id _])]
|
|
(each [_ {: process-id} (ipairs process-ids)]
|
|
(specify self.sqlog (!= [cpu.running #process-id] [cpu.running _]))
|
|
(var done false)
|
|
(while (not done)
|
|
(let [[instruction-result] (query self.sqlog [cpu.instruction instruction])
|
|
{: instruction} (or instruction-result {})
|
|
action (and instruction (. self.instructions instruction))]
|
|
(if (= action nil) (set done true)
|
|
(= (type action) :function) (action self)
|
|
(self.sqlog:execute action))
|
|
(specify self.sqlog (!= [cpu.frame _ _ (+ ip 1)] [cpu.frame fp :$ip ip] [cpu.fp #process-id fp])))))
|
|
(specify self.sqlog (!= [cpu.running 0] [cpu.running _]))
|
|
process-ids))
|
|
|
|
(fn Cpu.run [self] (while (> (length (self:process-round)) 0)))
|
|
|
|
(setmetatable Cpu {:__call (fn [cls ...] (doto (setmetatable {} {:__index cls}) (: :new ...)))})
|
|
|