mirror of
https://github.com/PDP-10/its.git
synced 2026-01-25 19:56:53 +00:00
61 lines
1.7 KiB
Common Lisp
Executable File
61 lines
1.7 KiB
Common Lisp
Executable File
;;;-*-lisp-*-
|
|
|
|
(declare (load '((alan) lspenv init)))
|
|
|
|
(*expr *make-array *rem *del ass mem listp copyalist copytree apropos
|
|
defstruct-examine defstruct-deposit y-or-n-p
|
|
macroexpand macroexpand-1)
|
|
|
|
(*lexpr format ?format ferror cerror describe inspect
|
|
gprint gprint1 gprinc pl gexplode gexplodec)
|
|
|
|
(unspecial args symbols car cdr)
|
|
|
|
(setq use-strt7 t)
|
|
|
|
(defmacro xcar (x) `(car ,x))
|
|
(defmacro xrplaca (x v) `(rplaca ,x ,v))
|
|
(defmacro xcdr (x) `(cdr ,x))
|
|
(defmacro xrplacd (x v) `(rplacd ,x ,v))
|
|
(defmacro xcxr (n x) `(cxr ,n ,x))
|
|
(defmacro xrplacx (n x v) `(rplacx ,n ,x ,v))
|
|
(defmacro vcell (sym) `(cdar ,sym))
|
|
(defmacro pname (sym) `(cxr 2 (car ,sym)))
|
|
|
|
(defmacro ldb (ppss x)
|
|
(setq ppss (macroexpand ppss))
|
|
(setq x (macroexpand x))
|
|
(if (not (fixp ppss))
|
|
`(*ldb (lsh ,ppss #o30) ,x) ;ugh!
|
|
(let ((mask (1- (lsh 1 (boole 1 #o77 ppss))))
|
|
(shift (- (lsh ppss -6))))
|
|
(cond ((fixp x)
|
|
(boole 1 mask (lsh x shift)))
|
|
((zerop shift)
|
|
`(boole 1 ,mask ,x))
|
|
(t
|
|
`(boole 1 ,mask (lsh ,x ,shift)))))))
|
|
|
|
(defmacro dpb (v ppss x)
|
|
(setq v (macroexpand v))
|
|
(setq ppss (macroexpand ppss))
|
|
(setq x (macroexpand x))
|
|
(if (not (fixp ppss))
|
|
`(*dpb ,v (lsh ,ppss #o30) ,x) ;ugh!
|
|
(let* ((shift (lsh ppss -6))
|
|
(mask (lsh (1- (lsh 1 (boole 1 #o77 ppss))) shift)))
|
|
(let ((vp (cond ((fixp v)
|
|
(boole 1 mask (lsh v shift)))
|
|
((zerop shift)
|
|
`(boole 1 ,mask ,v))
|
|
(t
|
|
`(boole 1 ,mask (lsh ,v ,shift)))))
|
|
(xp (if (fixp x)
|
|
(boole 4 x mask)
|
|
`(boole 4 ,x ,mask))))
|
|
(if (and (fixp vp) (fixp xp))
|
|
(boole 7 vp xp)
|
|
`(boole 7 ,vp ,xp))))))
|
|
|
|
(sstatus feature alan/;lspcom)
|