Update readme and work on SCM to C translator
This commit is contained in:
24
shared/scm2c/main.c
Normal file
24
shared/scm2c/main.c
Normal file
@@ -0,0 +1,24 @@
|
||||
#include <stdio.h>
|
||||
#include "scm_support.h"
|
||||
|
||||
int main() {
|
||||
int val;
|
||||
int *argl;
|
||||
void *cont, *entry, *proc, *env;
|
||||
|
||||
proc = lookup_variable_value("+", env);
|
||||
val = 1;
|
||||
argl = list(val);
|
||||
val = 1;
|
||||
argl = cons(val, argl);
|
||||
if (primitive_procedure(proc) == 1)
|
||||
goto primitivebranch3;
|
||||
compiledbranch2:
|
||||
cont = &&aftercall1;
|
||||
entry = compiled_procedure_entry(proc);
|
||||
goto *entry;
|
||||
primitivebranch3:
|
||||
val = proc(argl);
|
||||
aftercall1:
|
||||
printf("%u\n", val);
|
||||
}
|
||||
15
shared/scm2c/scm2c.h
Normal file
15
shared/scm2c/scm2c.h
Normal file
@@ -0,0 +1,15 @@
|
||||
void* lookup_variable_value(char* c, void* e) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
int* list(int n) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
int* cons(int n, int* argl) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
int primitive_procedure(void* p) {
|
||||
return 1;
|
||||
}
|
||||
@@ -87,8 +87,8 @@
|
||||
(end-with-linkage linkage
|
||||
(make-instruction-sequence '(env) (list target)
|
||||
`((" "
|
||||
,target " " = " " lookup-variable-value
|
||||
"(" "\"" ,exp "\"" ", " env ")")))))
|
||||
,target " " = " " lookup_variable_value
|
||||
"(" "\"" ,exp "\"" ", " env ");")))))
|
||||
|
||||
(define (compile-assignment exp target linkage)
|
||||
(let ((var (assignment-variable exp))
|
||||
@@ -245,45 +245,41 @@
|
||||
;;;applying procedures
|
||||
|
||||
(define (compile-procedure-call target linkage)
|
||||
(let ((primitive-branch (make-label 'primitive-branch))
|
||||
(compiled-branch (make-label 'compiled-branch))
|
||||
(after-call (make-label 'after-call)))
|
||||
(let ((primitive-branch (make-label 'primitivebranch))
|
||||
(compiled-branch (make-label 'compiledbranch))
|
||||
(after-call (make-label 'aftercall)))
|
||||
(let ((compiled-linkage
|
||||
(if (eq? linkage 'next) after-call linkage)))
|
||||
(append-instruction-sequences
|
||||
(make-instruction-sequence '(proc) '()
|
||||
`((test (op primitive-procedure?) (reg proc))
|
||||
(branch (label ,primitive-branch))))
|
||||
`((" if (" primitive_procedure "(proc) == 1)")
|
||||
(" goto " ,primitive-branch ";")))
|
||||
(parallel-instruction-sequences
|
||||
(append-instruction-sequences
|
||||
compiled-branch
|
||||
(make-instruction-sequence '() '() `((,compiled-branch ":")))
|
||||
(compile-proc-appl target compiled-linkage))
|
||||
(append-instruction-sequences
|
||||
primitive-branch
|
||||
(make-instruction-sequence '() '() `((,primitive-branch ":")))
|
||||
(end-with-linkage linkage
|
||||
(make-instruction-sequence '(proc argl)
|
||||
(list target)
|
||||
`((assign ,target
|
||||
(op apply-primitive-procedure)
|
||||
(reg proc)
|
||||
(reg argl)))))))
|
||||
after-call))))
|
||||
`((" val = proc(argl);"))))))
|
||||
(make-instruction-sequence '() '() `((,after-call ":")))))))
|
||||
|
||||
;;;applying compiled procedures
|
||||
|
||||
(define (compile-proc-appl target linkage)
|
||||
(cond ((and (eq? target 'val) (not (eq? linkage 'return)))
|
||||
(make-instruction-sequence '(proc) all-regs
|
||||
`((assign continue (label ,linkage))
|
||||
(assign val (op compiled-procedure-entry)
|
||||
(reg proc))
|
||||
(goto (reg val)))))
|
||||
`((" " cont " = &&" ,linkage ";")
|
||||
(" " entry " = " compiled_procedure_entry "(proc);")
|
||||
(" goto *entry;"))))
|
||||
((and (not (eq? target 'val))
|
||||
(not (eq? linkage 'return)))
|
||||
(let ((proc-return (make-label 'proc-return)))
|
||||
(make-instruction-sequence '(proc) all-regs
|
||||
`((assign continue (label ,proc-return))
|
||||
(assign val (op compiled-procedure-entry)
|
||||
(assign val (op compiled_procedure_entry)
|
||||
(reg proc))
|
||||
(goto (reg val))
|
||||
,proc-return
|
||||
Reference in New Issue
Block a user