diff --git a/ssc/iigs/graphics.fnl b/ssc/iigs/graphics.fnl index d801bb5..fd400c0 100644 --- a/ssc/iigs/graphics.fnl +++ b/ssc/iigs/graphics.fnl @@ -115,6 +115,7 @@ (pld) ; restore direct page register (cli))) ; enable interrupts + (macrobarrier drawfn) (form drawfn [(lambda [ssc name ...] (assert (not (ssc:defining?)) "drawfn must be defined at top level") (set ssc.locals nil) ; locals cannot be used diff --git a/ssc/init.fnl b/ssc/init.fnl index 14a25bd..dea214e 100644 --- a/ssc/init.fnl +++ b/ssc/init.fnl @@ -31,7 +31,6 @@ ; Expressions are of the form [:function arg1 arg2 arg3] ; args are either strings (symbols) or numbers -(import-macros {:sss ! : compile} :ssc.macros) (local Object (require :core.object)) (local lume (require :lib.lume)) (local Ssc (Object:extend)) @@ -49,8 +48,10 @@ (set self.globals {}) (set self.constants {:true 0xffff true 0xffff :false 0 false 0}) (set self.macros (lume.clone (or opts.macros self.__index.macros))) + (set self.macrobarriers {:fn true :far-fn true :do true}) (set self.setters {}) (set self.dp-vars 0) + (set self.gensym-count 0) (set self.LONG_LO (self:alloc-dp-var)) (set self.LONG_HI (self:alloc-dp-var)) (set self.ADDR_LO (self:alloc-dp-var)) @@ -61,6 +62,11 @@ (set self.dp-vars (+ self.dp-vars 2)) addr)) +(fn Ssc.gensym [self ?prefix] + (let [sym (.. "") ">"))] + (set self.gensym-count (+ self.gensym-count 1)) + sym)) + (fn Ssc.push [self name expr ?etype] (let [opgen (if (= ?etype :register) {:lo #[:flatten]} (self:expr-opgen expr ?etype)) @@ -228,12 +234,13 @@ (set Ssc.forms {:asm (fn [self ...] (if (self:defining?) (self:asm-localify [:block ...]) (self.org:append (table.unpack (self:asm-localify [...]))))) - :asm-long (fn [self ...] (values [:block ...] :long)) + :asm-long (fn [self ...] (values (self:asm-localify [:block ...]) :long)) :org (lambda [self org] (set self.org (self.prg:org org))) :start-symbol (lambda [self symbol] (set self.prg.start-symbol symbol)) :form (lambda [self name func] (tset self.forms name func)) :define (lambda [self name val] (tset self.constants name val)) :macro (lambda [self name func] (tset self.macros name func)) + :macrobarrier (lambda [self formname] (tset self.macrobarriers formname true)) :setter (lambda [self name arg ...] (assert (= (length arg) 1)) (tset self.setters name (self:compile-function (.. :-set- name) arg ...))) @@ -250,6 +257,10 @@ :word [:dw ?const] :long [:dl ?const] _ (error (.. "Unrecognized type " (fv etype)))))) + :buffer (lambda [self name bytes-or-size] + (self.org:append name [:bytes (match (type bytes-or-size) + :string bytes-or-size + :number (string.rep "\x00" bytes-or-size))])) :do (fn [self ...] (var etype-body :void) (local c-body (lume.concat [:block] (icollect [i (countiter (select :# ...))] @@ -363,6 +374,12 @@ :byte! (lambda [self ref value] [:set! [:byte-at ref] value]) :word! (lambda [self ref value] [:set! [:word-at ref] value]) :long! (lambda [self ref value] [:set! [:long-at ref] value]) + :data (lambda [self bytes] + (print "data" bytes (self:defining?)) + (if (self:defining?) (let [name (self:gensym)] (self:expr-poly [:buffer name bytes]) name) + bytes)) + :pstr (lambda [self str] [:data (.. (string.char (length str)) str)]) ; pascal-style + :cstr (lambda [self str] [:data (.. str "\x00")]) ; c-style }) (fn Ssc.local-offset [self name-or-index] @@ -462,7 +479,7 @@ expanded (match expr (where c (. self.constants c)) (self:expr-expand (. self.constants c)) (where [m & args] (. self.macros m)) (self:expr-expand ((. self.macros m) self (table.unpack args))) - [f & args] (lume.concat [f] (icollect [_ arg (ipairs args)] (self:expr-expand arg))) + (where [f & args] (not (. self.macrobarriers f))) (lume.concat [f] (icollect [_ arg (ipairs args)] (self:expr-expand arg))) _ expr) _ (when (= (type expanded) :table) (setmetatable expanded mt))] expanded))