Google
 

Trailing-Edge - PDP-10 Archives - clisp - clisp/upsala/lap2.lap
There are no other files named lap2.lap in the archive.
;;; -*- Mode:CLISP; Package:COMPILER -*-
;;; Extensions to make lap nicer

(provide "LAP2")
(in-package "COMPILER")

;;; A macro to define hardwired entrypoints
(defmacro makent (lab ent)
  `(setf (get ,lab 'lisp::sym) ,ent))

;;; A macro to copy a function entrypoint to the SYM property
(defmacro cpyent (fun nargs)
  `(setf (get ,fun 'lisp::sym)
	 ;; UNBOX is needed since entrypoints are IADRs nowadays.
	 (lisp::unbox (aref (cadr (symbol-function ,fun)) ,nargs))))

; Define some
(import '(lisp::get1nt lisp::ret1nt lisp::retint))
;;;(makent 'get1nt #o1033110)	; Lisp object (o1) -> Integer (w2)
;;;(makent 'ret1nt #o1033126)	; Integer (w2) -> Lisp object (o1)
;;;(makent 'retint #o1033127)	; Integer (w2&w3) -> Lisp object (o1)
(cpyent 'cons	2)	; (setq o1 (cons o1 o2))
(cpyent 'car	1)	; (setq o1 (car o1))
(cpyent 'cdr    1)	; (setq o1 (cdr o1))
(makent 'o2     o2)		;Accumulators, why aren't they already defined?
(makent 'o3	o3)
(makent 'o4	o4)
(makent 'o5	o5)
(makent 'w3	w3)
(makent 'w4	w4)

;;; Erjmp to label
(dlm erjmp erjmp-cp2 (lbl reg)
     (setq reg (lapval reg))
     (dinst jump #o16 (+ (svref labels lbl) (ash reg 18))))

;;; Pushj p,label
(dlm lcall lcall-cp2 (lbl reg)
     (setq reg (lapval reg))
     (dinst pushj #o17 (+ (svref labels lbl) (ash reg 18))))

;;; JSP ac,label
(dlm jsp jsp-cp2 (reg lbl reg2)
     (setq reg (lapval reg))
     (setq reg2 (lapval reg2))
     (dinst jsp reg (+ (svref labels lbl) (ash reg2 18))))