suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

trying to fix the basic block structure of the assembler

Browse Source
This commit is contained in:
Danny Yoo 2011-07-27 17:55:30 -04:00
parent 3add8633e3
commit c2024bcd7a
2 changed files with 52 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
js-assembler/assemble-structs.rkt
View File

@ -11,5 +11,25 @@
;; Assembly ;; Assembly
(define-struct: BasicBlock ([name : Symbol] (define-struct: BasicBlock ([name : Symbol]
[stmts : (Listof UnlabeledStatement)]) [stmts : (Listof StraightLineStatement)]
[jump : Jump])
#:transparent) #:transparent)
(define-struct: ComputedJump ([label : (U Reg
ModuleEntry
CompiledProcedureEntry)])
#:transparent)
(define-struct: DirectJump ([label : Symbol])
#:transparent)
(define-struct: ConditionalJump ([op : PrimitiveTest]
[true-label : Symbol]
[false-label : Symbol])
#:transparent)
(define-type Jump (U ComputedJump
DirectJump
ConditionalJump
False))

63
js-assembler/fracture.rkt
View File

@ -13,6 +13,11 @@
racket/string racket/string
racket/list) racket/list)
;; Takes a sequence of statements, and breaks them down into basic
;; blocks.
;;
;; A basic block consists of a name, a sequence of straight-line statements,
;; followed by a branch (or the absence of a branch).
(provide fracture) (provide fracture)
@ -43,36 +48,30 @@
(reverse (cons (make-BasicBlock name (reverse acc)) (reverse (cons (make-BasicBlock name (reverse acc))
basic-blocks))] basic-blocks))]
[else [else
(: do-on-label (Symbol -> (Listof BasicBlock)))
(define (do-on-label label-name)
(loop label-name
'()
(cons (make-BasicBlock
name
(if last-stmt-goto?
(reverse acc)
(reverse (append `(,(make-GotoStatement (make-Label label-name)))
acc))))
basic-blocks)
(cdr stmts)
last-stmt-goto?))
(let: ([first-stmt : Statement (car stmts)]) (let: ([first-stmt : Statement (car stmts)])
(: do-on-label (Symbol -> (Listof BasicBlock))) (cond
(define (do-on-label label-name) [(symbol? first-stmt)
(cond (do-on-label first-stmt)]
[(member label-name jump-targets) [(LinkedLabel? first-stmt)
(loop label-name (do-on-label (LinkedLabel-label first-stmt))]
'() [else
(cons (make-BasicBlock (loop name
name (cons first-stmt acc)
(if last-stmt-goto? basic-blocks
(reverse acc) (cdr stmts)
(reverse (append `(,(make-GotoStatement (make-Label label-name))) (GotoStatement? (car stmts)))]))]))))
acc))))
basic-blocks)
(cdr stmts)
last-stmt-goto?)]
[else
(loop name
acc
basic-blocks
(cdr stmts)
last-stmt-goto?)]))
(cond
[(symbol? first-stmt)
(do-on-label first-stmt)]
[(LinkedLabel? first-stmt)
(do-on-label (LinkedLabel-label first-stmt))]
[else
(loop name
(cons first-stmt acc)
basic-blocks
(cdr stmts)
(GotoStatement? (car stmts)))]))]))))