From acc561366f3fe6ec0377103f52ef0f7e923711c9 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Mon, 1 Aug 2022 19:35:19 -0700
Subject: Modify the project structure.

Now the lib directory contains what will eventually end up on the
user's /usr/lib/csc. When I write make install, it will copy all of
the .csc files from lib into the destination lib directory. This means I
can start working on the standard library in lib/scheme.
---
 lib/csc/linker.csc | 119 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 119 insertions(+)
 create mode 100644 lib/csc/linker.csc

(limited to 'lib/csc/linker.csc')

diff --git a/lib/csc/linker.csc b/lib/csc/linker.csc
new file mode 100644
index 0000000..5e4e678
--- /dev/null
+++ b/lib/csc/linker.csc
@@ -0,0 +1,119 @@
+(define-library (csc linker)
+  (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 (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:
+    ;   - (local x),
+    ;   - (global x lib),
+    ;   - (const x),
+    ;   - or (label x).
+    ; The full list of opcodes can be found in encoding.csc.
+
+
+    ; Rewrites each (label x) form into a integer constant.
+    (define (translate-labels program label-map)
+      (loop for opcode in program
+            for op = (car opcode)
+            for args = (cdr opcode)
+            unless (symbol=? op 'label)
+              collect (cons op (loop for arg in args
+                                     collect (match arg
+                                               (('label x)
+                                                 (list 'const (lookup label-map x)))
+                                               (_ arg))))))
+
+
+    (define (make-label-map offset program)
+      (loop for op in program
+            for i from offset
+            with m = (make-map compare-numbers)
+            do (match op
+                 (('label id)
+                   (set! m (insert m id i))
+                   (set! i (- i 1))))  ; Labels will be removed later.
+            finally (return m)))
+
+
+    (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)
+      (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 (lookup environment arg)))
+                                             (_ arg))))))
+
+
+    (define (num-globals environment)
+      (define n 0)
+      (map-for-each (lambda (k v)
+                      (when (<= n v)
+                        (set! n (+ 1 v))))
+        environment)
+      n)
+
+
+    (define link
+      (case-lambda
+        ((programs environment)
+          (append
+            (list
+              (list 'alloc (list 'local 0) (list 'const (num-globals environment))))
+            (translate-globals
+              (loop for prog in programs
+                    for off = 1 then (+ off (length converted-prog))
+                    for converted-prog = (translate-labels
+                                           prog
+                                           (make-label-map off prog))
+                    append converted-prog)
+              environment)))
+        ((programs)
+          (link programs (add-to-environment (make-map compare-globals) programs)))))))
-- 
cgit v1.3.1