1
0
mirror of https://github.com/PDP-10/its.git synced 2026-01-19 01:27:05 +00:00
PDP-10.its/src/libdoc/getsyn.gsb6
2018-07-13 15:12:49 -07:00

78 lines
1.4 KiB
Common Lisp

; Wednesday Aug 20,1980 00:20 FQ+1D.17H.10M.56S. -*- Lisp -*-
(defun declare-globally macro (x)
(mapc 'eval (cdr x))
`(cond ((status feature complr) ,@(cdr x))))
(declare-globally
(*lexpr getsyntax getmacro getchtran)
(fixnum (getsyntax fixnum notype) (getchtran fixnum notype))
(notype (getmacro fixnum notype))
(mapc '(lambda (x) (putprop x '(1 . 2) 'args))
'(getsyntax getmacro getchtran)))
(lap-a-list
'((lap getsyntax lsubr)
(args getsyntax (1 . 2))
(skipa f (% 0 0 fix1))
(movei f cpopj)
(jsp tt lwnack)
(12._18. 0 'getsyntax)
(jsp r set-up-args)
(hlrz tt @ 1 b)
(jrst 0 0 f)
set-up-args
(aojl t (* 2))
(tdza b b)
(pop p b)
rt-recheck
(skipn 0 b)
(move b (special readtable))
(movei t 0 b)
(lsh t -9.)
(hrrz t st t)
(caie t 'array)
(jrst 0 rtlose)
(move t 0 b)
(tlnn t #o20000)
(jrst 0 rtlose)
(pop p a)
(jsp t fxnv1)
(andi tt 127.)
(jrst 0 0 r)
rtlose
(movei a 0 b)
(erint 2 (% sixbit |bad value for readtable!|))
(movei b 0 a)
(jrst 0 rt-recheck)
(entry getmacro lsubr)
(args getmacro (1 . 2))
(jsp tt lwnack)
(#o14_22 0 'getmacro)
(jsp r set-up-args)
(hlrz t @ 1 b)
(trnn t #o4000)
(tdza a a)
(hrrz a @ 1 b)
(popj p)
(entry getchtran lsubr)
(args getchtran (1 . 2))
(skipa f (% 0 0 fix1))
(movei f cpopj)
(jsp tt lwnack)
(#o14_22 0 'getchtran)
(jsp r set-up-args)
(hlrz t @ 1 b)
(trnn t #o4000)
(hrrz tt @ 1 b)
(jrst 0 0 f)
nil))