(define wordsize 8)
-(define (type-size type env)
+(define (type-size data-layouts type)
(define (adt-size adt)
(let ([sizes
(map (lambda (sum)
- (fold-left (lambda (acc x) (+ acc (type-size x)))
+ (fold-left (lambda (acc x) (+ acc (type-size data-layouts x)))
wordsize ; one word needed to store tag
(cdr sum)))
(cdr adt))])
['Int wordsize]
['Bool wordsize]
[else
- (let ([adt (assoc type (env-adts env))])
+ (let ([adt (assoc type data-layouts)])
(if adt
(adt-size adt)
(error #f "unknown size" type)))]))
+(define (on-stack? expr)
+ (case (ast-type expr)
+ ['stack (cadr expr)]
+ [else #f]))
+
; an environment consists of adt layouts in scope,
; and any bound variables.
; bound variables are an assoc list with their stack offset
(define make-env list)
-(define env-adts car)
+(define env-data-layouts car)
(define env-bindings cadr)
(define (codegen-add xs si env)
acc))
(env-bindings env)
comps)]
- [scc-env (make-env (env-adts env) scc-binding-offsets)])
+ [scc-env (make-env (env-data-layouts env) scc-binding-offsets)])
(for-each
(lambda (name)
(let ([expr (cadr (assoc name bindings))])
(codegen-expr expr
inner-si
(make-env
- (env-adts scc-env)
+ (env-data-layouts scc-env)
(cons (cons name 'self-captive)
(env-bindings scc-env))))
(codegen-expr expr inner-si scc-env))
(define (data-tor env e)
(and (list? e)
- (assoc (car e) (flat-map data-tors (env-adts env)))))
+ (assoc (car e) (flat-map data-tors (env-data-layouts env)))))
(define (codegen-data-tor e si env)
(define (codegen-destructor tor)
- (codegen-expr (cadr e) si env)
+ (when (not (eqv? 'stack (ast-type (cadr e))))
+ (error #f "expected stack value"))
+ (let* ([stack-expr (cadr e)]
+ [stack-body (caddr stack-expr)]
+ [stack-type (cadr stack-expr)])
+
+ (codegen-expr stack-body si env)
(let ([index (cadr tor)]
[products 2]
[to-traverse (list-head products index)]
wordsize ; skip tag in first word
to-traverse)])
3
- ))
+ )))
- (let ([tor (data-tor env e)]
+ (let* ([tor (data-tor env e)]
[constructor (eqv? 'constructor (cadr tor))])
(if constructor
(codegen-constructor tor)
(codegen-call (car e) (cdr e) si env)))))
; this is a builtin being passed around as a variable
- ('builtin (emit "movq $~a, %rax" (builtin-id e)))
+ ; this should have been converted to a closure!
+ ('builtin (error #f "passing about a builtin!" e))
('let (codegen-let (let-bindings e)
(let-body e)
('static-string (emit "movq ~a@GOTPCREL(%rip), %rax"
(cadr e)))
- (else (error #f "don't know how to codegen this"))))
+ ('stack (error #f "stack value that needs explicit handling" e))
+ (else (error #f "don't know how to codegen this"))))
+ ; takes in a expr annotated with types and returns a type-less AST
+ ; with stack values wrapped
+(define (annotate-stack-values data-layout ann-e)
+ (define (stack-type? type)
+ (assoc type data-layout))
+ (define (strip e)
+ (ast-traverse strip (ann-expr e)))
+ (let* ([e (ann-expr ann-e)]
+ [type (ann-type ann-e)])
+ (if (stack-type? type)
+ `(stack ,type ,(ast-traverse strip e))
+ (ast-traverse (lambda (x)
+ (annotate-stack-values data-layout x))
+ e))))
(define (free-vars prog)
(define bound '())
(define (codegen program)
(set! cur-label 0)
(set! cur-lambda 0)
- (let* ([body (program-body program)]
+ (let* ([data-layouts (program-data-layouts program)]
- [data-layouts (map data-layout (program-datas program))]
+ [type-annotated (annotate-types program)]
+ [stack-annotated (annotate-stack-values data-layouts
+ type-annotated)]
- (extract-res-0 (extract-strings body))
- (strings (car extract-res-0))
- (extract-res-1 (extract-lambdas (cdr extract-res-0)))
- (lambdas (car extract-res-1))
- (xform-prog (cdr extract-res-1)))
+ (strings-res (extract-strings stack-annotated))
+ (strings (car strings-res))
+ (lambdas-res (extract-lambdas (cdr strings-res)))
+ (lambdas (car lambdas-res))
+ (xform-prog (cdr lambdas-res)))
(emit "\t.global _start")
(emit "\t.text")
; %r8 = 5th arg
; %r9 = 6th arg
-; on darwin, the syscall is offset by 0x2000000
+; on darwin, unix/posix syscalls are offset by 0x2000000 (syscall classes)
; https://opensource.apple.com/source/xnu/xnu-2782.20.48/bsd/kern/syscalls.master
; documentation for most syscalls: /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/usr/include/sys