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))))