whoops, missed some stuff
This commit is contained in:
parent
2f59db6766
commit
3f295581f5
|
@ -115,6 +115,7 @@
|
||||||
(pld) ; restore direct page register
|
(pld) ; restore direct page register
|
||||||
(cli))) ; enable interrupts
|
(cli))) ; enable interrupts
|
||||||
|
|
||||||
|
(macrobarrier drawfn)
|
||||||
(form drawfn [(lambda [ssc name ...]
|
(form drawfn [(lambda [ssc name ...]
|
||||||
(assert (not (ssc:defining?)) "drawfn must be defined at top level")
|
(assert (not (ssc:defining?)) "drawfn must be defined at top level")
|
||||||
(set ssc.locals nil) ; locals cannot be used
|
(set ssc.locals nil) ; locals cannot be used
|
||||||
|
|
23
ssc/init.fnl
23
ssc/init.fnl
|
@ -31,7 +31,6 @@
|
||||||
; Expressions are of the form [:function arg1 arg2 arg3]
|
; Expressions are of the form [:function arg1 arg2 arg3]
|
||||||
; args are either strings (symbols) or numbers
|
; args are either strings (symbols) or numbers
|
||||||
|
|
||||||
(import-macros {:sss ! : compile} :ssc.macros)
|
|
||||||
(local Object (require :core.object))
|
(local Object (require :core.object))
|
||||||
(local lume (require :lib.lume))
|
(local lume (require :lib.lume))
|
||||||
(local Ssc (Object:extend))
|
(local Ssc (Object:extend))
|
||||||
|
@ -49,8 +48,10 @@
|
||||||
(set self.globals {})
|
(set self.globals {})
|
||||||
(set self.constants {:true 0xffff true 0xffff :false 0 false 0})
|
(set self.constants {:true 0xffff true 0xffff :false 0 false 0})
|
||||||
(set self.macros (lume.clone (or opts.macros self.__index.macros)))
|
(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.setters {})
|
||||||
(set self.dp-vars 0)
|
(set self.dp-vars 0)
|
||||||
|
(set self.gensym-count 0)
|
||||||
(set self.LONG_LO (self:alloc-dp-var))
|
(set self.LONG_LO (self:alloc-dp-var))
|
||||||
(set self.LONG_HI (self:alloc-dp-var))
|
(set self.LONG_HI (self:alloc-dp-var))
|
||||||
(set self.ADDR_LO (self:alloc-dp-var))
|
(set self.ADDR_LO (self:alloc-dp-var))
|
||||||
|
@ -61,6 +62,11 @@
|
||||||
(set self.dp-vars (+ self.dp-vars 2))
|
(set self.dp-vars (+ self.dp-vars 2))
|
||||||
addr))
|
addr))
|
||||||
|
|
||||||
|
(fn Ssc.gensym [self ?prefix]
|
||||||
|
(let [sym (.. "<gensym " self.gensym-count (if ?prefix (.. " " ?prefix ">") ">"))]
|
||||||
|
(set self.gensym-count (+ self.gensym-count 1))
|
||||||
|
sym))
|
||||||
|
|
||||||
(fn Ssc.push [self name expr ?etype]
|
(fn Ssc.push [self name expr ?etype]
|
||||||
(let [opgen (if (= ?etype :register) {:lo #[:flatten]}
|
(let [opgen (if (= ?etype :register) {:lo #[:flatten]}
|
||||||
(self:expr-opgen expr ?etype))
|
(self:expr-opgen expr ?etype))
|
||||||
|
@ -228,12 +234,13 @@
|
||||||
|
|
||||||
(set Ssc.forms
|
(set Ssc.forms
|
||||||
{:asm (fn [self ...] (if (self:defining?) (self:asm-localify [:block ...]) (self.org:append (table.unpack (self:asm-localify [...])))))
|
{: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)))
|
:org (lambda [self org] (set self.org (self.prg:org org)))
|
||||||
:start-symbol (lambda [self symbol] (set self.prg.start-symbol symbol))
|
:start-symbol (lambda [self symbol] (set self.prg.start-symbol symbol))
|
||||||
:form (lambda [self name func] (tset self.forms name func))
|
:form (lambda [self name func] (tset self.forms name func))
|
||||||
:define (lambda [self name val] (tset self.constants name val))
|
:define (lambda [self name val] (tset self.constants name val))
|
||||||
:macro (lambda [self name func] (tset self.macros name func))
|
:macro (lambda [self name func] (tset self.macros name func))
|
||||||
|
:macrobarrier (lambda [self formname] (tset self.macrobarriers formname true))
|
||||||
:setter (lambda [self name arg ...]
|
:setter (lambda [self name arg ...]
|
||||||
(assert (= (length arg) 1))
|
(assert (= (length arg) 1))
|
||||||
(tset self.setters name (self:compile-function (.. :-set- name) arg ...)))
|
(tset self.setters name (self:compile-function (.. :-set- name) arg ...)))
|
||||||
|
@ -250,6 +257,10 @@
|
||||||
:word [:dw ?const]
|
:word [:dw ?const]
|
||||||
:long [:dl ?const]
|
:long [:dl ?const]
|
||||||
_ (error (.. "Unrecognized type " (fv etype))))))
|
_ (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 ...]
|
:do (fn [self ...]
|
||||||
(var etype-body :void)
|
(var etype-body :void)
|
||||||
(local c-body (lume.concat [:block] (icollect [i (countiter (select :# ...))]
|
(local c-body (lume.concat [:block] (icollect [i (countiter (select :# ...))]
|
||||||
|
@ -363,6 +374,12 @@
|
||||||
:byte! (lambda [self ref value] [:set! [:byte-at ref] value])
|
:byte! (lambda [self ref value] [:set! [:byte-at ref] value])
|
||||||
:word! (lambda [self ref value] [:set! [:word-at ref] value])
|
:word! (lambda [self ref value] [:set! [:word-at ref] value])
|
||||||
:long! (lambda [self ref value] [:set! [:long-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]
|
(fn Ssc.local-offset [self name-or-index]
|
||||||
|
@ -462,7 +479,7 @@
|
||||||
expanded (match expr
|
expanded (match expr
|
||||||
(where c (. self.constants c)) (self:expr-expand (. self.constants c))
|
(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)))
|
(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)
|
_ expr)
|
||||||
_ (when (= (type expanded) :table) (setmetatable expanded mt))]
|
_ (when (= (type expanded) :table) (setmetatable expanded mt))]
|
||||||
expanded))
|
expanded))
|
||||||
|
|
Loading…
Reference in a new issue