1
0
mirror of https://github.com/janet-lang/janet synced 2025-02-08 13:00:01 +00:00

More work on sysir compiler - basic function calls (without prototypes).

This commit is contained in:
Calvin Rose 2024-05-15 07:23:37 -05:00
parent 19212e6f5c
commit 08e6051af8
2 changed files with 51 additions and 16 deletions

View File

@ -52,6 +52,8 @@
(make-type name))
(add-prim-type 'float 'f32)
(add-prim-type 'double 'f64)
(add-prim-type 'int 's32)
(add-prim-type 'pointer 'pointer)
(add-prim-type 'boolean 'boolean))
(defn type-extract
@ -72,7 +74,7 @@
# Compile a constant
(number? code)
(let [slot (get-slot)
slottype 'double]
slottype 'int]
(array/push into ~(bind ,slot ,slottype))
(array/push into ~(constant ,slot ,code))
slot)
@ -81,6 +83,14 @@
(symbol? code)
(named-slot code)
# String literals
(string? code)
(let [slot (get-slot)
slottype 'pointer]
(array/push into ~(bind ,slot ,slottype))
(array/push into ~(constant ,slot ,code))
slot)
# Compile forms
(and (tuple? code) (= :parens (tuple/type code)))
(do
@ -118,7 +128,7 @@
(assert (= 2 (length args)))
(def [full-name value] args)
(assert (symbol? full-name))
(def [name tp] (type-extract full-name 'double))
(def [name tp] (type-extract full-name 'int))
(def result (visit1 value into))
(def slot (get-slot name))
(when tp
@ -153,11 +163,39 @@
(var ret nil)
(each form args (set ret (visit1 form into)))
ret)
(errorf "unknown form %V" code)))
(errorf "cannot compile %V" code)))
# Branch
'if
(do
(def lab (keyword (gensym)))
(def lab-end (keyword (gensym)))
(assert (< 2 (length args) 4))
(def [cnd tru fal] args)
(def condition-slot (visit1 cnd into))
(def ret (get-slot))
(array/push into ~(branch ,condition-slot ,lab))
# false path
(array/push into ~(move ,ret ,(visit1 tru into)))
(array/push into ~(jump ,lab-end))
(array/push into lab)
# true path
(array/push into ~(move ,ret ,(visit1 fal into)))
(array/push into lab-end)
ret)
# Assume function call
(do
(def slots @[])
(def ret (get-slot))
(each arg args
(array/push slots (visit1 arg into)))
(array/push into ~(call ,ret ,op ,;slots))
ret)))
(errorf "cannot compile %q" code)))
(varfn do-binop
"Emit a 'binary' op succh as (+ x y).
"Emit an operation such as (+ x y).
Extended to support any number of arguments such as (+ x y z ...)"
[opcode args into]
(var final nil)
@ -168,7 +206,7 @@
(let [result (get-slot)]
# TODO - finish type inference - we should be able to omit the bind
# call and sysir should be able to infer the type
(array/push into ~(bind ,result double))
(array/push into ~(bind ,result int))
(array/push into ~(,opcode ,result ,final ,right))
result)
right)))
@ -203,20 +241,21 @@
(def myprog
'(do
(def xyz:double (+ 1 2 3))
(def abc:double (* 4 5 6))
(def xyz:int (+ 1 2 3))
(def abc:int (* 4 5 6))
(def x:boolean (= 5 7))
(the int (printf "hello, world!\n%d\n" (the int (if x abc xyz))))
(return (/ abc xyz))))
(defn dotest
[]
(def ctx (sysir/context))
(def ir-asm
@['(link-name "entry")
@['(link-name "main")
'(parameter-count 0)])
(setup-default-types ir-asm)
(visit1 myprog ir-asm)
(printf "%.99M" ir-asm)
(eprintf "%.99M" ir-asm)
(sysir/asm ctx ir-asm)
(print (sysir/to-c ctx)))

View File

@ -962,7 +962,7 @@ static int tcheck_cast_type(JanetSysIR *sysir, uint32_t td, uint32_t ts) {
* no casting between arrays and pointers
*
* TODO - check array and pointer types have same alignment
switch (primd) {
default:
return -1;
@ -1177,9 +1177,6 @@ static void janet_sysir_type_check(JanetSysIR *sysir) {
/* Write back possibly modified instruction */
sysir->instructions[i] = instruction;
}
}
/* Assert no unknown types */
JanetSysIRLinkage *linkage = sysir->linkage;
@ -1428,7 +1425,7 @@ void janet_sys_ir_lower_to_c(JanetSysIRLinkage *linkage, JanetBuffer *buffer) {
#define EMITBINOP(OP) emit_binop(ir, buffer, tempbuf, instruction, OP)
/* Prelude */
janet_formatb(buffer, "#include <stddef.h>\n\n");
janet_formatb(buffer, "#include <stddef.h>\n#include <stdint.h>\n#include <stdbool.h>\n#include <stdio.h>\n\n");
/* Emit type defs */
for (uint32_t j = 0; j < (uint32_t) linkage->ir_ordered->count; j++) {
@ -1503,7 +1500,6 @@ void janet_sys_ir_lower_to_c(JanetSysIRLinkage *linkage, JanetBuffer *buffer) {
case JANET_SYSOP_TYPE_UNION:
case JANET_SYSOP_TYPE_POINTER:
case JANET_SYSOP_TYPE_ARRAY:
case JANET_SYSOP_ARG:
continue;
default:
break;