;; ------------------------------------
;;
;; ARMSchembler 0241 linker and utility library
;;
;; ------------------------------------


(library 
 (linker)
 (export defined? libs erase-libs bytevector-copy!
	 link lib-link unpack-to-lib unpack-above-heap)
 (import)

 ;; list all libs
 (define (libs)
   (map (lambda (e) (list (vector-ref (vector-ref e 0) 0))) (vector-ref (_GLV) 12)))

 ;; clear all libs
 (define (erase-libs) (erase #x20000000))

 (define (defined? sym)
   (let ((is-defined #f)
	 (old_catch (eval '_catch (interaction-environment))))
     (call/cc
      (lambda (inner_catch)
	(eval `(begin
		 (set! _catch ,inner_catch)
		 ,sym)
	      (interaction-environment))
	(set! is-defined #t)))
     (eval `(set! _catch ,old_catch) (interaction-environment))
     is-defined))

 (define (bytevector-copy! src sst tgt tst k)
   (if (> sst tst)
       (let loop ((n 0))
	 (if (>= n k) #t
	     (begin
	       (bytevector-u8-set! tgt (+ tst n) (bytevector-u8-ref src (+ sst n)))
	       (loop (+ n 1)))))
       (let loop ((n (- k 1)))
	 (if (< n 0) #t
	     (begin
	       (bytevector-u8-set! tgt (+ tst n) (bytevector-u8-ref src (+ sst n)))
	       (loop (- n 1)))))))

 (define (link cvec)
   (let ((code (vector-ref cvec 0)))
     ;; link the symbols used by the compiled code
     (map
      (lambda (lvar)
	(let ((n (car lvar))
	      (s (string->symbol (cdr (assq (cdr lvar) (vector-ref cvec 2))))))
	  (bytevector-u16-native-set!
	   code n (bitwise-ior (bitwise-arithmetic-shift s 2) #x0f)) ; synt/var
	  (bytevector-u16-native-set! code (+ n 2) (bitwise-arithmetic-shift s -14))))
      (vector-ref cvec 1))
     ;; link the long jumps
     (map
      (lambda (ljmp)
	(bytevector-copy!
	 (address-of (eval (string->symbol (cdr ljmp)) (interaction-environment)) 4)
	 0 code (car ljmp) 4))
      (vector-ref cvec 3))
     code))

 (define (unpack-to-lib obj)
   (if (vector? obj)
       (unpack (link obj) -1)
       (unpack obj -1)))

 (define (unpack-above-heap obj)
   (if (vector? obj)
       (unpack (link obj) 1)
       (unpack obj 1)))

 (define (lib-link cvec)
   (unpack (link cvec) -1))

 ) ;; end of library