diff --git a/gneiss/cpu.fnl b/gneiss/cpu.fnl new file mode 100644 index 0000000..eba7b3c --- /dev/null +++ b/gneiss/cpu.fnl @@ -0,0 +1,99 @@ +(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 ...)))}) + diff --git a/gneiss/example.fnl b/gneiss/example.fnl new file mode 100644 index 0000000..a9f09b2 --- /dev/null +++ b/gneiss/example.fnl @@ -0,0 +1,34 @@ +(local Cpu (require :gneiss.cpu)) +(local {: show} (require :inspector.debug)) +(local sql (require :diet-sqlite)) +(import-macros {: $ : query : specify} :sqlog.macros) + +(sql.shutdown) +; (sql.register-logger #(print "SQL:" $2 $1)) + +(local cpu (Cpu)) + +(macro divisible-by [val denominator] + `($ (= (% ,val ,denominator) 0))) + +(pp (divisible-by i 3)) + +(specify cpu.sqlog + (table fizzbuzz i fizzbuzz)) + +(let [pgid (cpu:insert-program ($ + (do ; 1 + (!+ [cpu.frame fp :i 1] [cpu.my-fp fp])) ; ideally: (!+ [cpu.frame-var :i 1]) + (do ;2 + (!+ [fizzbuzz i (case (when (and ,(divisible-by i 3) ,(divisible-by i 5)) :fizzbuzz) + (when ,(divisible-by i 3) :fizz) + (when ,(divisible-by i 5) :buzz) + (else i))] [cpu.frame-var :i i]) + (!= [cpu.frame _ _ (+ i 1)] [cpu.frame fp :i i] [cpu.my-fp fp]) ; ideally: (!= [cpu.frame-var :i 1])? + (!= [cpu.frame _ _ 1] [cpu.frame fp :$ip _] [cpu.my-fp fp] [cpu.frame-var :i i] (< i 100))) ; if i < 100 goto 2 + ,cpu.ret)) + pid (cpu:initialize-process pgid)] + (cpu:run) + (show (query cpu.sqlog [fizzbuzz i fizzbuzz]))) + +{}