Skip to content
Snippets Groups Projects
load.lisp 33.7 KiB
Newer Older
ram's avatar
ram committed
  (let ((value (pop-stack))
	(code (pop-stack)))
    (setf (code-header-ref code (clone-arg)) value)
    (undefined-value)))
ram's avatar
ram committed

(define-fop (fop-function-entry 142)
  (let ((type (pop-stack))
	(arglist (pop-stack))
	(name (pop-stack))
	(code-object (pop-stack))
	(offset (read-arg 4)))
    (declare (type index offset))
    (unless (zerop (logand offset vm:lowtag-mask))
      (error "Unaligned function object, offset = #x~X." offset))
    (let ((fun (%primitive compute-function code-object offset)))
      (%primitive set-function-self fun fun)
      (%primitive set-function-next fun
		  (%primitive code-entry-points code-object))
      (%primitive set-code-entry-points code-object fun)
      (%primitive set-function-name fun name)
      (%primitive set-function-arglist fun arglist)
      (%primitive set-function-type fun type)
	(load-fresh-line)
	(format t "~S defined~%" fun))
ram's avatar
ram committed


;;;; Linkage fixups.
ram's avatar
ram committed

;;; These two variables are initially filled in by Genesis.
ram's avatar
ram committed

(defvar *initial-assembler-routines*)
(defvar *initial-foreign-symbols*)
ram's avatar
ram committed

(defvar *assembler-routines* (make-hash-table :test #'eq))
(defvar *foreign-symbols* (make-hash-table :test #'equal))
ram's avatar
ram committed

(defun loader-init ()
  (dolist (routine *initial-assembler-routines*)
    (setf (gethash (car routine) *assembler-routines*) (cdr routine)))
  (dolist (symbol *initial-foreign-symbols*)
    (setf (gethash (car symbol) *foreign-symbols*) (cdr symbol)))
  (makunbound '*initial-assembler-routines*)
  (makunbound '*initial-foreign-symbols*))
ram's avatar
ram committed

(defun foreign-symbol-address (symbol)
  (multiple-value-bind
      (value found)
      (gethash symbol *foreign-symbols* 0)
    (unless found
      (error "Unknown foreign symbol: ~S" symbol))
    (int-sap value)))
(define-fop (fop-foreign-fixup 147)
  (let* ((kind (pop-stack))
	 (code-object (pop-stack))
	 (len (read-arg 1))
	 (sym (make-string len)))
    (read-n-bytes *fasl-file* sym 0 len)
    (multiple-value-bind
	(value found)
	(gethash sym *foreign-symbols* 0)
      (unless found
	(error "Unknown foreign symbol: ~S" sym))
      (vm:fixup-code-object code-object (read-arg 4) value kind))
(define-fop (fop-assembler-code 144)
  (error "Cannot load assembler code."))

(define-fop (fop-assembler-routine 145)
  (error "Cannot load assembler code."))

(define-fop (fop-assembler-fixup 148)
  (let ((routine (pop-stack))
	(kind (pop-stack))
	(code-object (pop-stack)))
    (multiple-value-bind
	(value found)
	(gethash routine *assembler-routines*)
      (unless found
	(error "Undefined assembler routine: ~S" routine))
      (vm:fixup-code-object code-object (read-arg 4) value kind))
wlott's avatar
wlott committed
(proclaim '(maybe-inline read-byte))