SpindleyQ/honeylisp
1
1
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

whoops, missed some stuff

Browse source
This commit is contained in:
Jeremy Penner 2021-09-26 23:21:57 -04:00
parent 2f59db6766
commit 3f295581f5
2 changed files with 21 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
ssc/iigs/graphics.fnl
View file

@ -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

23
ssc/init.fnl
View file

@ -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 (.. "<gensym " self.gensym-count (if ?prefix (.. " " ?prefix ">") ">"))]
(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))