Update readme and work on SCM to C translator

This commit is contained in:
2021-06-11 18:05:03 -04:00
parent 38b8a9fb56
commit bcabdd3212
5 changed files with 84 additions and 28 deletions

24
shared/scm2c/main.c Normal file
View 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
View 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;
}

View File

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