akkartik
/
mu
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

253

This commit is contained in:
Kartik K. Agaram 2014-11-07 11:59:22 -08:00
parent a1a9d145df
commit ee3a90b1bb
1 changed files with 17 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
mu.arc
View File

@ -699,14 +699,14 @@
(set done)))))) (set done))))))
(- close pc 1))) (- close pc 1)))
;; convert symbolic names to integer offsets ;; convert symbolic names to raw memory locations
(def convert-names (instrs) (def convert-names (instrs)
(with (offset (table) (with (location (table)
isa-field (table)) isa-field (table))
(let idx 1 (let idx 1
(each instr instrs (each instr instrs
(trace "cn0" instr " " canon.offset " " canon.isa-field) (trace "cn0" instr " " canon.location " " canon.isa-field)
(let (oargs op args) (parse-instr instr) (let (oargs op args) (parse-instr instr)
(if (in op 'get 'get-address) (if (in op 'get 'get-address)
(with (basetype (typeinfo args.0) (with (basetype (typeinfo args.0)
@ -718,45 +718,45 @@
(assert basetype!address "@args.0 requests deref, but it's not an address of a record") (assert basetype!address "@args.0 requests deref, but it's not an address of a record")
(= basetype (types* basetype!elem))) (= basetype (types* basetype!elem)))
(when (isa field 'sym) (when (isa field 'sym)
(assert (or (~offset field) isa-field.field) "field @args.1 is also a variable") (assert (or (~location field) isa-field.field) "field @args.1 is also a variable")
(when (~offset field) (when (~location field)
(trace "cn0" "new field; computing offset") (trace "cn0" "new field; computing location")
(assert basetype!fields "no field names available for @instr") (assert basetype!fields "no field names available for @instr")
(iflet idx (pos field basetype!fields) (iflet idx (pos field basetype!fields)
(do (set isa-field.field) (do (set isa-field.field)
(= offset.field idx)) (= location.field idx))
(assert nil "couldn't find field in @instr"))))) (assert nil "couldn't find field in @instr")))))
(each arg args (each arg args
(assert (~isa-field v.arg) "arg @arg is also a field name") (assert (~isa-field v.arg) "arg @arg is also a field name")
(when (maybe-add arg offset idx) (when (maybe-add arg location idx)
(err "use before set: @arg")))) (err "use before set: @arg"))))
(each arg oargs (each arg oargs
(trace "cn0" "checking " arg) (trace "cn0" "checking " arg)
(unless (is arg '_) (unless (is arg '_)
(assert (~isa-field v.arg) "oarg @arg is also a field name") (assert (~isa-field v.arg) "oarg @arg is also a field name")
(when (maybe-add arg offset idx) (when (maybe-add arg location idx)
(trace "cn0" "location for arg " arg ": " idx) (trace "cn0" "location for arg " arg ": " idx)
(++ idx (sizeof ty.arg)))))))) (++ idx (sizeof ty.arg))))))))
(trace "cn1" "update names " canon.offset " " canon.isa-field) (trace "cn1" "update names " canon.location " " canon.isa-field)
(each instr instrs (each instr instrs
(let (oargs op args) (parse-instr instr) (let (oargs op args) (parse-instr instr)
(each arg args (each arg args
(when (and nondummy.arg (offset v.arg)) (when (and nondummy.arg (location v.arg))
(zap offset v.arg))) (zap location v.arg)))
(each arg oargs (each arg oargs
(when (and nondummy.arg (offset v.arg)) (when (and nondummy.arg (location v.arg))
(zap offset v.arg))))) (zap location v.arg)))))
instrs)) instrs))
(def maybe-add (arg offset idx) (def maybe-add (arg location idx)
(trace "maybe-add" arg) (trace "maybe-add" arg)
(when (and nondummy.arg (when (and nondummy.arg
(~in ty.arg 'literal 'offset 'fn) (~in ty.arg 'literal 'offset 'fn)
(~offset v.arg) (~location v.arg)
(isa v.arg 'sym) (isa v.arg 'sym)
(~in v.arg 'nil 'default-scope) (~in v.arg 'nil 'default-scope)
(~pos 'global metadata.arg)) (~pos 'global metadata.arg))
(= (offset v.arg) idx))) (= (location v.arg) idx)))
;; literate tangling system for reordering code ;; literate tangling system for reordering code