mirror of
https://github.com/PDP-10/its.git
synced 2026-01-21 02:08:50 +00:00
85994ed770
Resolves #284. Commented out uses of time-origin in maxtul; mcldmp (init) until we can figure out why it gives arithmetic overflows under the emulators. Updated the expect script statements in build_macsyma_portion to not attempt to match expected strings, but simply sleep for some time since in some cases the matching appears not to work.
67 lines
1.9 KiB
Common Lisp
67 lines
1.9 KiB
Common Lisp
;;;-*-Lisp-*-
|
|
|
|
(declare (load '((alan) lspenv init)))
|
|
|
|
;;;Bitwise macros (BIT-xxx X Y)
|
|
|
|
;X and Y
|
|
(defun (bit-and macro) (form) `(boole 1 . ,(cdr form)))
|
|
|
|
;X or Y
|
|
(defun (bit-or macro) (form) `(boole 7 . ,(cdr form)))
|
|
|
|
;X and (not Y)
|
|
(defun (bit-clear macro) (form) `(boole 4 . ,(cdr form)))
|
|
|
|
;Right 18. bits of 36. bit word
|
|
(defun (rh-bits macro) (form) `(boole 1 #o777777 ,(cadr form)))
|
|
|
|
;Left 18. bits of 36. bit word
|
|
(defun (lh-bits macro) (form) `(boole 1 #o777777 (lsh ,(cadr form) -18.)))
|
|
|
|
;T if bits are there
|
|
(defun (bitp macro) (form) `(not (= 0 (boole 1 . ,(cdr form)))))
|
|
(defun (bit-test macro) (form) `(not (= 0 (boole 1 .,(cdr form)))))
|
|
|
|
;T if bit not there
|
|
(defun (nbitp macro) (form) `(= 0 (boole 1 .,(cdr form))))
|
|
|
|
;(bit-range x |4.8-3.1|)
|
|
;Really should be a load byte. Returns bit range, using ITS bit naming
|
|
(defun (bit-range macro) (form)
|
|
(prog (spec d1 d2 d3 d4)
|
|
(setq spec (caddr form)
|
|
d1 (- (getcharn spec 1) #/0)
|
|
d2 (- (getcharn spec 3) #/0)
|
|
d3 (- (getcharn spec 5) #/0)
|
|
d4 (- (getcharn spec 7) #/0))
|
|
(cond ((not (and (= (flatc spec) 7)
|
|
(eq (getchar spec 2) '/.)
|
|
(eq (getchar spec 4) '/-)
|
|
(eq (getchar spec 6) '/.)
|
|
(>= d1 1) (<= d1 4)
|
|
(>= d2 1) (<= d2 9.)
|
|
(>= d3 1) (<= d3 4)
|
|
(>= d4 1) (<= d4 9.)))
|
|
(error "-- bad bit range." spec 'wrng-type-arg))
|
|
(t (setq d1 (+ (* 9. (1- d1)) d2 -1) ; bit # start
|
|
d2 (+ (* 9. (1- d3)) d4 -1)) ; bit # end
|
|
(unless (> d1 d2)
|
|
(setq d1 (prog1 d2 (setq d2 d1))))
|
|
(setq d3 (- d1 d2 -1)) ; length of mask
|
|
(let ((shifted (if (zerop d2)
|
|
(cadr form)
|
|
`(rot ,(cadr form) ,(- d2)))))
|
|
(if (= d3 36.)
|
|
(return shifted)
|
|
(return `(boole 1 ,(1- (rot 1 d3))
|
|
,shifted))))))))
|
|
|
|
;(rplac-lh word new-lh)
|
|
(defmacro rplac-lh (word new)
|
|
`(bit-or (bit-and ,word #o777777) (lsh ,new 18.)))
|
|
|
|
;(rplac-rh word new-rh)
|
|
(defmacro rplac-rh (word new)
|
|
`(bit-or (bit-clear ,word #o777777) ,new))
|