home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / sources.lha / sources / link / defs.t < prev    next >
Encoding:
Text File  |  1988-02-05  |  3.0 KB  |  122 lines
  1. (herald defs)
  2.  
  3.  
  4. (define NONVALUE (list '**nonvalue**))
  5.  
  6. (define-structure-type lstate   ;linker state
  7.     pure            
  8.     impure          
  9.     foreign-reloc   
  10.     foreign                     
  11.     symbols                        
  12.     symbol-count
  13.     text-reloc   ;List of relocation items
  14.     data-reloc
  15.     pure-size
  16.     )
  17.  
  18. (define (create-lstate)
  19.   (let ((l (make-lstate)))
  20.     (set (lstate-foreign l) '())
  21.     (set (lstate-pure l) (make-area))
  22.     (set (lstate-impure l) (make-area))
  23.     (set (lstate-symbols l) '())
  24.     (set (lstate-symbol-count l) 0)
  25.     (set (lstate-foreign-reloc l) '())
  26.     (set (lstate-text-reloc l) '())
  27.     (set (lstate-data-reloc l) '())
  28.     l))
  29.  
  30.  
  31.  
  32. (define-structure-type area         ;A.k.a. "heap"
  33.   frontier      ;Address of next available cell
  34.   objects       ;List of objects allocated
  35.   )
  36.  
  37. (let ((master (stype-master area-stype)))
  38.   (set (area-frontier    master) 0)
  39.   (set (area-objects     master) '()))
  40.  
  41.     
  42. (define-structure-type foreign-object
  43.   name     ;the string that is the name of this procedure
  44.   )
  45.  
  46. (define-structure-type templat
  47.   code-vec  ;the code vector
  48.   offset)   ;and offset within the vector where this template points to.
  49.  
  50.  
  51. ;;; closure-internal-templates
  52.  
  53. (define-structure-type cit
  54.   pointer      ;number of pointer slots  
  55.   scratch      ;number of scratch slots  
  56.   nargs        ;number of args this template's fun takes
  57.   header/nary? ; byte with high bit on if nary, low bits template header
  58.   code-vec     ;the code vector
  59.   aux-offset   ;and offset within the vector where the auxiliary template begins
  60.   unit-offset  ;offset of template in unit (bytes)
  61.   )
  62.  
  63. (define-integrable (no-op? x)
  64.   (eq? x no-op))
  65.  
  66. (define-structure-type vcell-struct
  67.   var           ; var node
  68.   )
  69.  
  70. (define-structure-type unit-loc
  71.   unit
  72.   offset
  73.   )
  74.                                  
  75.  
  76. (define (create-unit-loc unit offset)
  77.   (let ((u (make-unit-loc)))
  78.     (set (unit-loc-unit u) unit)
  79.     (set (unit-loc-offset u) offset)
  80.     u))
  81.  
  82. (define-structure-type address
  83.   heap 
  84.   addr)
  85.  
  86. (define (create-address heap addr)
  87.   (let ((a (make-address)))
  88.     (set (address-heap a) heap)
  89.     (set (address-addr a) addr)
  90.     a))
  91.  
  92.  
  93. (define-structure-type var-node
  94.   name          ;the symbol that is this var's name
  95.   refs          ;a list of (unit . slot) pairs giving the unit slots where this
  96.                 ;var's value is kept.
  97.   defined
  98.   vcell
  99.   value         ; slot where linker definition (closure) occurs in unit
  100.   vcell-refs
  101.   )
  102.  
  103. (let ((node (stype-master var-node-stype)))
  104.   (set (var-node-refs node) '())                                  
  105.   (set (var-node-vcell-refs node) '())                                  
  106.   (set (var-node-defined node) nil)
  107.   (set (var-node-vcell node) nil)
  108.   (set (var-node-value node) NONVALUE))
  109.  
  110. (lset *linker-debug?* nil)
  111.  
  112. (define (linker-message message . args)
  113.   (apply format t message args))
  114.  
  115. ;++(define (linker-message message . args)
  116. ;++  (apply format *linker-noise-file* message args))
  117.  
  118. (define (linker-debug message . args)
  119.   (cond (*linker-debug?*
  120.          (apply format t message args)
  121.          (newline (terminal-output)))))
  122.