diff options
Diffstat (limited to 'csc')
| -rw-r--r-- | csc/linker-test.csc | 17 | ||||
| -rw-r--r-- | csc/linker.csc | 73 |
2 files changed, 53 insertions, 37 deletions
diff --git a/csc/linker-test.csc b/csc/linker-test.csc index 70e5e31..7b5d5db 100644 --- a/csc/linker-test.csc +++ b/csc/linker-test.csc @@ -16,17 +16,6 @@ (begin - (define compare-globals - (make-comparer - (lambda (x) - (hash-bytevector (string->utf8 (sprintf "{}" x)))) - (lambda (x y) - (cond - ((equal? x y) 0) - ((string<? (sprintf "{}" x) (sprintf "{}" y)) -1) - (else 1))))) - - (test link-labels (assert-equal '((jmp (const 3)) @@ -39,8 +28,7 @@ (label 1) (jmp (label 0)) (label init) - (jmp (label 0)))) - (make-map compare-globals)))) + (jmp (label 0))))))) (test link-labels-are-unique-per-program @@ -59,8 +47,7 @@ ((label 0) (jmp (label 0)) (label init) - (jmp (label 0)))) - (make-map compare-globals)))) + (jmp (label 0))))))) (test link-globals diff --git a/csc/linker.csc b/csc/linker.csc index dc738b7..9095647 100644 --- a/csc/linker.csc +++ b/csc/linker.csc @@ -1,16 +1,25 @@ (define-library (csc linker) - (export link) + (export + add-to-environment + compare-globals + link) (import (scheme base) + (only (csc format) + sprintf) (only (csc hash-map) compare-numbers + hash-bytevector insert lookup + make-comparer make-map map-for-each) (only (csc loop) loop return) - (only (csc match) match)) + (only (csc match) match) + (only (scheme case-lambda) + case-lambda)) (begin ; A CSC bytecode program is a list of opcodes and labels. An opcode is a ; list of an opcode and arguments. Arguments can be any of: @@ -50,37 +59,57 @@ finally (return m))) - (define (translate-globals program environment) + (define (add-to-environment environment programs) (define next-global-id 0) (map-for-each (lambda (k v) (when (>= v next-global-id) (set! next-global-id (+ 1 v)))) environment) - (define (translate-global x) - (or (lookup environment x #f) - (let ((id next-global-id)) - (set! next-global-id (+ 1 next-global-id)) - (set! environment (insert environment x id)) - id))) + (loop for opcode in (apply append programs) + do (loop for arg in (cdr opcode) + do (match arg + (('global name lib) + (define id next-global-id) + (set! next-global-id (+ 1 next-global-id)) + (set! environment (insert environment arg id)))))) + environment) + + + (define compare-globals + (make-comparer + (lambda (x) + (hash-bytevector (string->utf8 (sprintf "{}" x)))) + (lambda (x y) + (cond + ((equal? x y) 0) + ((string<? (sprintf "{}" x) (sprintf "{}" y)) -1) + (else 1))))) + + + (define (translate-globals program environment) (loop for opcode in program for op = (car opcode) for args = (cdr opcode) collect (cons op (loop for arg in args collect (match arg (('global x lib) - (list 'const (translate-global arg))) + (list 'const (lookup environment arg))) (_ arg)))))) - (define (link programs environment) - (translate-globals - (loop for prog in programs - for off = 0 then (+ off (length converted-prog)) - for converted-prog = (let ((prog-prelude (cons - (list 'jmp '(label init)) - prog))) - (translate-labels - prog-prelude - (make-label-map off prog-prelude))) - append converted-prog) - environment)))) + (define link + (case-lambda + ((programs environment) + (translate-globals + (loop for prog in programs + for off = 0 then (+ off (length converted-prog)) + for converted-prog = (let ((prog-prelude (cons + (list 'jmp '(label init)) + prog))) + (translate-labels + prog-prelude + (make-label-map off prog-prelude))) + append converted-prog) + environment)) + ((programs) + (link programs (add-to-environment (make-map compare-globals) programs))))))) |