diff --git a/aarch64var.rkt b/aarch64var.rkt index a5349d4..663ebd0 100644 --- a/aarch64var.rkt +++ b/aarch64var.rkt @@ -1,6 +1,19 @@ #lang racket -(provide Label Var Reg Imm LMov Add Sub RetDefault Svc Bl) +(provide + (struct-out Label) + (struct-out Var) + (struct-out Reg) + (struct-out Imm) + (struct-out LMov) + (struct-out AMOffset) + (struct-out Ldr) + (struct-out Str) + (struct-out Add) + (struct-out Sub) + (struct-out RetDefault) + (struct-out Svc) + (struct-out Bl)) (require racket/struct) @@ -10,6 +23,9 @@ (struct Reg (reg-name) #:transparent) (struct Imm (immediate) #:transparent) (struct LMov (src dest) #:transparent) +(struct AMOffset (base-reg offset) #:transparent) +(struct Ldr (src dest) #:transparent) +(struct Str (src dest) #:transparent) (struct Add (op1 op2 dest) #:transparent) (struct Sub (op1 op2 dest) #:transparent) (struct RetDefault () #:transparent) @@ -23,3 +39,4 @@ x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29 x30 sp pc xzr)) + diff --git a/allocate-regs.rkt b/allocate-regs.rkt new file mode 100644 index 0000000..55b253c --- /dev/null +++ b/allocate-regs.rkt @@ -0,0 +1,105 @@ +#lang racket + +(require "aarch64var.rkt") + +; the allocation strategy is quite trivial: +; always use stack to store results of operations and retrieve operands +; use temporary registers starting from x0 to perform the operation +; note that this separation is necessary because ARM is a load/store ISA +; x0 is used to store the returned value as per Aarch64 calling convention, +; this is already handled by instruction selection + + +; allocate-regs-std-instr +; this procedure should only be applied to: Add, Sub, RetDefault, Svc, Bl etc +; Use allocate-regs-lmov-instr for LMov + +; stack-map is a map with keys being the variables +; and values the position relative to stack base (frame pointer?) + +; stack-top is the offset where an eventual next variable would be +; allocated into the stack +; note that this is a virtual offset; sp must by aligned to 16 bytes + +; returns the generated instructions +; the stack-map is modified if needed +; +; TODO: does it make sense to use create-stack-bindings on instr-args? +(define (allocate-regs-std-instr! instr stack-map stack-top) + (begin + (define instr-dest (AArch64-instr-dest instr)) + (define instr-args (AArch64-instr-args instr)) + (create-stack-bindings! (append instr-args instr-dest) stack-map stack-top) + (define reg-args (generate-regs 0 (length instr-args))) + (define reg-dest (generate-regs (length instr-args) (length instr-dest))) + (append (generate-ldr instr-args stack-map) + (list (AArch64-instr-from-dest-args instr reg-dest reg-args)) + (generate-str instr-dest stack-map)))) + +(define (generate-regs start len) + (map (lambda (i) + (Reg (string->symbol (string-append "x" (number->string i))))) + (range start (+ start len)))) + +(define (generate-ldr var-list stack-map) + (for/list ([var var-list] + [reg (generate-regs 0 (length var-list))]) + (Ldr (AMOffset 'sp (hash-ref stack-map (Var-var-name var))) reg))) + +(define (generate-str var-list stack-map) + (list)) + + +; generate stack read/writes and allocate registers for +; a LMov instruction +;(define (allocate-regs-lmov-instr! instr stack-map)) + +; create bindings for the operands that are Var +(define (create-stack-bindings! operand-list stack-map stack-top) + (begin + (for-each (lambda (op) + (match op + [(Var var-name) + (begin + (create-stack-binding! var-name stack-map stack-top))] + [_ '()])) + operand-list))) + +; modify the stack map if the variable is not there yet +; only works for 64 bit integers +(define (create-stack-binding! var-name stack-map stack-top) + (begin + (hash-update! stack-map + var-name + identity + stack-top) + (set! stack-top (- stack-top 8)))) + +(define (AArch64-instr-dest instr) + (match instr + [(? LMov?) (list (LMov-dest instr))] + [(? Add?) (list (Add-dest instr))] + [(? Sub?) (list (Sub-dest instr))] + [(? RetDefault?) (list)])) + +(define (AArch64-instr-args instr) + (match instr + [(? LMov?) (list (LMov-src instr))] + [(Add op1 op2 _) (list op1 op2)] + [(Sub op1 op2 _) (list op1 op2)] + [(? RetDefault?) (list)])) + +(define (AArch64-instr-from-dest-args instr dest args) + (let ([constructor-args + (match instr + [(? LMov?) (append args dest)] + [(? Add?) (append args dest)] + [(? Sub?) (append args dest)] + [(? RetDefault?) (list)])]) + (construct-new-instr instr constructor-args))) + +(define (construct-new-instr instr args) + (let*-values ([(struct-type _) (struct-info instr)] + [(constructor) (struct-type-make-constructor struct-type)]) + (apply constructor args))) + diff --git a/tests/all-tests.rkt b/tests/all-tests.rkt index a43900e..7adba62 100644 --- a/tests/all-tests.rkt +++ b/tests/all-tests.rkt @@ -11,6 +11,7 @@ ;(require "test-explicate-control.rkt") (require "test-cvar-to-bril.rkt") (require "test-select-instr.rkt") +(require "test-allocate-regs.rkt") (define all-tests (test-suite @@ -22,5 +23,6 @@ ;remove-complex-opera-tests ;explicate-control-tests cvar-to-bril-tests - select-instr-tests)) + select-instr-tests + allocate-regs-tests)) diff --git a/tests/test-allocate-regs.rkt b/tests/test-allocate-regs.rkt new file mode 100644 index 0000000..0e98939 --- /dev/null +++ b/tests/test-allocate-regs.rkt @@ -0,0 +1,34 @@ +#lang racket + +(provide allocate-regs-tests) + +(require rackunit) + +(require "../aarch64var.rkt") +(require/expose "../allocate-regs.rkt" + (allocate-regs-std-instr!)) + +(define listing-1 + (list (Label "main") + (LMov (Imm 0) (Var "c")) + (LMov (Imm 2) (Var "d")) + (Add (Var "c") (Var "d") (Var "b")) + (LMov (Reg 'x0) (Var "b")) + (RetDefault))) + +(define allocate-regs-tests + (test-suite + "Register Allocation" + + (test-suite + "Single instruction allocation" + (test-case + "Add" + (check-equal? + (allocate-regs-std-instr! (Add (Var "a") (Var "b") (Var "c")) + (make-hash (list (cons "a" -0) (cons "b" -8))) + -16) + (list (Ldr (AMOffset 'sp 0) (Reg 'x0)) + (Ldr (AMOffset 'sp -8) (Reg 'x1)) + (Add (Reg 'x0) (Reg 'x1) (Reg 'x2)))))))) +