Google
 

Trailing-Edge - PDP-10 Archives - -
Click to see without markup as text/plain
There are no other files named in the archive.
00010	
00020	(SETQ IBASE (SETQ BASE (ADD1 7))) 
00030	
00040	(DEFPROP LAP 
00050	 (LAMBDA(SL)
00060	  (PROG (LOC CONLIST GEN REMOB L)
00070		(SETQ GEN (GENSYM))
00080		(SETQ CONLIST (LIST NIL))
00090		(SETQ LOC BPORG)
00100	   A    (COND ((NULL (SETQ L (READ))) (GO END))
00110		      ((ATOM L) (DEFSYM L LOC) (GO A)))
00120		(DEPOSIT LOC (GWD L))
00130		(SETQ LOC (ADD1 LOC))
00140		(GO A)
00150	   END  (DEFSYM GEN LOC)
00160	   EN1  (COND
00170		 ((NULL (SETQ CONLIST (CDR CONLIST)))
00180		  (EVAL (CONS (QUOTE REMOB) REMOB))
00190		  (PUTPROP (CAR SL) (NUMVAL BPORG) (CADR SL))
00200		  (RETURN (LIST (CAR SL) (SETQ BPORG LOC)))))
00210		(SETQ KLIST (CONS (CONS (CAR CONLIST) LOC) KLIST))
00220		(DEPOSIT LOC (GWD (CAR CONLIST)))
00230		(SETQ LOC (ADD1 LOC))
00240		(GO EN1))) 
00250	FEXPR)
00260	
00270	
00280	(DEFPROP TYPE 
00290	 (LAMBDA (X) (COND ((NUMBERP X) (CADR X)))) 
00300	EXPR)
00310	
00320	
00330	(DEFPROP GWD 
00340	 (LAMBDA(X)
00350	  (PROG (WRD FLD)
00360		(SETQ FLD
00370		      (QUOTE
00380		       ((22 . -1) (27 . 17) (0 . 777777) (22 . 777777))))
00390		(SETQ WRD 0)
00400		(MAPCAR (FUNCTION
00410			 (LAMBDA(ZZ)
00420			  (PROG2 (SETQ WRD
00430				       (PLUS WRD
00440					     (LSH (BOOLE 1
00450							 (CDAR FLD)
00460							 (LAPEVAL ZZ))
00470						  (CAAR FLD))))
00480				 (SETQ FLD (CDR FLD)))))
00490	 		X)
00500		(RETURN WRD))) 
00510	EXPR)
00520	
00530	(DEFPROP LAPEVAL 
00540	 (LAMBDA(X)
00550	  (COND ((NUMBERP X) X)
00560		((ATOM X) (GVAL X))
00570		((MEMBER (CAR X) (QUOTE (E QUOTE)))
00580		 (MAKNUM
00590		  (COND
00600		   ((OR (NOT (ATOM (SETQ X (CADR X))))
00610			(AND (NUMBERP X) (NOT (EQ (PLUS X 0) X)))
00620			(EQ (CAR (EXPLODE X)) (QUOTE /")))
00630		    (PROG (Y)
00640			  (SETQ Y QLIST)
00650	 	     A    (COND
00660			   ((NULL Y)
00670			    (RETURN (CAR (SETQ QLIST (CONS X QLIST)))))
00680			   ((AND (EQUAL X (CAR Y))
00690				 (EQ (TYPE X) (TYPE (CAR Y))))
00700			    (RETURN (CAR Y))))
00710			  (SETQ Y (CDR Y))
00720			  (GO A)))
00730		   (T X))
00740		  (QUOTE FIXNUM)))
00750		((EQ (CAR X) (QUOTE SPECIAL))
00760		 (COND
00770		  ((NULL (GET (CADR X) (QUOTE VALUE)))
00780		   (PUTPROP (CADR X) (LIST NIL) (QUOTE VALUE))))
00790		 (MAKNUM (GET (CADR X) (QUOTE VALUE)) (QUOTE FIXNUM)))
00800		((EQ (CAR X) (QUOTE C))
00810		 (PROG (N CPTR)
00820		       (SETQ CPTR KLIST)
00830	 	  L11  (COND ((NULL CPTR) (GO L12))
00840			     ((EQUAL (CDR X) (CAAR CPTR))
00850			      (RETURN (CDAR CPTR))))
00860		       (SETQ CPTR (CDR CPTR))
00870		       (GO L11)
00880	 	  L12  (GVAL GEN)
00890		       (SETQ N 0)
00900		       (SETQ CPTR CONLIST)
00910	 	  A    (COND
00920			((NULL (CDR CPTR)) (RPLACD CPTR (LIST (CDR X)))))
00930		       (COND ((EQUAL (CDR X) (CADR CPTR)) (RETURN N)))
00940		       (SETQ N (ADD1 N))
00950		       (SETQ CPTR (CDR CPTR))
00960		       (GO A)))
00970		(T (PLUS (LAPEVAL (CAR X)) (LAPEVAL (CDR X)))))) 
00980	EXPR)
00990	
01000	(DEFPROP DEFSYM 
01010	 (LAMBDA(SYM VAL)
01020	  (PROG (Z)
01030		(SETQ REMOB (CONS SYM REMOB))
01040		(COND ((SETQ Z (GET SYM (QUOTE UNDEF))) (GO PATCH)))
01050	   A    (RETURN (PUTPROP SYM VAL (QUOTE SYM)))
01060	   PATCH
01070		(COND ((NULL Z) (RPLACD SYM (CDDDR SYM)) (GO A)))
01080		(DEPOSIT (CAR Z) (PLUS (EXAMINE (CAR Z)) VAL))
01090		(SETQ Z (CDR Z))
01100		(GO PATCH))) 
01110	EXPR)
01120	
01130	
01140	(DEFPROP GVAL 
01150	 (LAMBDA(SYM)
01160	  (COND ((GET SYM (QUOTE SYM)))
01170		((GET SYM (QUOTE VALUE)) (MAKNUM SYM (QUOTE FIXNUM)))
01180		(T (PUTPROP SYM
01190			    (CONS LOC (GET SYM (QUOTE UNDEF)))
01200			    (QUOTE UNDEF))
01210	 	   0))) 
01220	EXPR)
01230	
01240	
01250	(DEFPROP OPS 
01260	 (LAMBDA(L)
01270	  (PROG NIL
01280	   A    (COND ((NULL L) (RETURN T)))
01290		(PUTPROP (CAR L) (CADR L) (QUOTE SYM))
01300		(SETQ L (CDDR L))
01310		(GO A))) 
01320	FEXPR)
01330	
01340	(OPS MOVE 200000 MOVEI 201000 MOVEM 202000 JRST 254000 CALL 34000 JCA
01350	LL 35000 PUSHJ 260000 POPJ 263000 PUSH 261000 POP 262000 P 14 JSP 265
01360	000 EXCH 250000 JUMPE 322000 JUMPN 326000 SOJE 362000 SOJN 366000 CAI
01370	E 302000 CAIN 306000 CAME 312000 CAMN 316000 CALLF 36000 JCALLF 37000
01380	 HRRZ@ 550020 HLRZ@ 554020 TDZA 634000 SUB 274000 HRRZ 550000 HLRZ 55
01390	4000 CLEARM 402000 CLEARB 403000 ADD 270000 MOVNI 211000 CALLF@ 36020
01400	 JCALLF@ 37020 HRRM@ 542020 HRLM@ 506020 HRRZS@ 553020 HLLZS@ 513020 
01410	DPB 137000 HRRM 542000) 
01420	
01430	
01440	(DEFPROP REMLAP 
01450	 (LAMBDA NIL
01460	  (PROG (Z)
01470		(SETQ Z (QUOTE (LAP LAPEVAL GWD DEFSYM REMLAP ILAP GVAL TYPE)))
01480	   A    (COND ((NULL Z) (GO B)))
01490		(REMPROP (CAR Z) (QUOTE EXPR))
01500		(REMPROP (CAR Z) (QUOTE FEXPR))
01510		(SETQ Z (CDR Z))
01520		(GO A)
01530	   B    (REMPROP (QUOTE REMLAP) (QUOTE EXPR)))) 
01540	EXPR)
01550	
01560	(COND ((NULL (GET (QUOTE QLIST) (QUOTE VALUE))) (SETQ QLIST NIL))) 
01570	(COND ((NULL (GET (QUOTE KLIST) (QUOTE VALUE))) (SETQ KLIST NIL))) 
01580	
01590	(SETQ BPORG1 BPORG) 
01600	(SETQ BPORG (*DIF BPEND 500)) 
01610	(SETQ BPEND1 BPEND) 
01620	
01630	
01640	(LAP GWD SUBR) 
01650	(PUSH P (C 0)) 
01660	(PUSH P 1) 
01670	(PUSHJ P G0123) 
01680	(137000 1 (C 222200 0 -1 P)) 
01690	(PUSHJ P G0123) 
01700	(242000 1 27) 
01710	(436000 1 -1 P) 
01720	(PUSHJ P G0123) 
01730	(137000 1 (C 2200 0 -1 P)) 
01740	(PUSHJ P G0123) 
01750	(514000 1 1) 
01760	(436000 1 -1 P) 
01770	G0124 
01780	(POP P 1) 
01790	(POP P 1) 
01800	(JRST 0 FIX1A) 
01810	G0125 
01820	(POP P 1) 
01830	(JRST 0 G0124) 
01840	G0123 
01850	(MOVE 2 -1 P) 
01860	(JUMPE 2 G0125) 
01870	(HLRZ 1 0 2) 
01880	(HRRZ 2 0 2) 
01890	(MOVEM 2 -1 P) 
01900	(CALL 1 (E LAPEVAL)) 
01910	(JRST 0 NUMVAL) 
01920	NIL 
01930	
01940	(LAP LAP FSUBR) 
01950		(JSP 6 SPECBIND)(0 0 (SPECIAL LOC))(0 0 (SPECIAL CONLIST))(0 0 (SPECIAL GEN))(0 0 (SPECIAL REMOB))
01960		(PUSH P 1)(CALL 0 (E GENSYM))(MOVEM 1 (SPECIAL GEN))(MOVEI 1 (QUOTE NIL))(CALL 1 (E NCONS))
01970		(MOVEM 1 (SPECIAL CONLIST))(MOVE 2 (SPECIAL BPORG))(MOVEM 2 (SPECIAL LOC))(PUSH P (C 0 0 (QUOTE NIL)))
01980	G0001 (CALL 0 (E READ))(MOVEM 1 0 P)(JUMPE 1 G0002)(CALL 1 (E ATOM))(JUMPE 1 G0011)(MOVE 2 (SPECIAL LOC))
01990		(MOVE 1 0 P)(CALL 2 (E DEFSYM))(JRST 0 G0001)
02000	G0011 (MOVE 1 0 P)(PUSH P (SPECIAL LOC))(CALL 1 (E GWD))(MOVE 2 1)(POP P 1)(CALL 2 (E DEPOSIT))
02010		(MOVE 1 (SPECIAL LOC))(CALL 1 (E ADD1))(MOVEM 1 (SPECIAL LOC))
02020		(MOVE 2 (SPECIAL BPEND1))(CALL 2 (E *LESS))(JUMPN 1 G0001)
02030		(MOVEI 1 (QUOTE (BINARY PROGRAM SPACE EXCEEDED)))(CALL 1 (E PRINT))
02040		(CALL 0 (E ERR))(JRST 0 G0001)
02050	G0002 (MOVE 2 (SPECIAL LOC))(MOVE 1 (SPECIAL GEN))(CALL 2 (E DEFSYM))
02060	G0003 (HRRZ@ 1 (SPECIAL CONLIST))(MOVEM 1 (SPECIAL CONLIST))(JUMPN 1 G0022)(MOVE 1 (SPECIAL REMOB))
02070		(CALL 17 (E REMOB))(HLRZ@ 1 -1 P)(PUSH P 1)(MOVE 1 (SPECIAL BPORG))(CALL 1 (E NUMVAL))
02080		(HRRZ@ 3 -2 P)(HLRZ@ 3 3)(MOVE 2 1)(POP P 1)(CALL 3 (E PUTPROP))(MOVE 1 (SPECIAL LOC))
02090		(MOVEM 1 (SPECIAL BPORG))(CALL 1 (E NCONS))(HLRZ@ 2 -1 P)(CALL 2 (E XCONS))(JRST 0 G0004)
02100	G0022 (MOVE 2 (SPECIAL LOC))(HLRZ@ 1 (SPECIAL CONLIST))(CALL 2 (E CONS))(MOVE 2 (SPECIAL KLIST))
02110		(CALL 2 (E CONS))(MOVEM 1 (SPECIAL KLIST))(HLRZ@ 1 (SPECIAL CONLIST))(PUSH P (SPECIAL LOC))
02120		(CALL 1 (E GWD))(MOVE 2 1)(POP P 1)(CALL 2 (E DEPOSIT))(MOVE 1 (SPECIAL LOC))(CALL 1 (E ADD1))
02130		(MOVEM 1 (SPECIAL LOC))(JRST 0 G0003)
02140	G0004 (SUB P (C 0 0 2 2))(JRST 0 SPECSTR)
02150	NIL 
02160	
02170	
02180	(LAP LAPEVAL SUBR) 
02190		(PUSH P 1)(CALL 1 (E NUMBERP))(JUMPE 1 G0006)(MOVE 1 0 P)(JRST 0 G0005)
02200	G0006 (MOVE 1 0 P)(CALL 1 (E ATOM))(JUMPE 1 G0008)(MOVE 1 0 P)(CALL 1 (E GVAL))(JRST 0 G0005)
02210	G0008 (MOVEI 2 (QUOTE (E QUOTE)))(HLRZ@ 1 0 P)(CALL 2 (E MEMBER))(JUMPE 1 G0011)(HRRZ@ 1 0 P)
02220		(HLRZ@ 1 1)(MOVEM 1 0 P)(CALL 1 (E ATOM))(JUMPE 1 G0016)(MOVE 1 0 P)(CALL 1 (E NUMBERP))
02230		(JUMPE 1 G0019)(MOVEI 2 (QUOTE 0))(MOVE 1 0 P)(CALL 2 (E *PLUS))(CAME 1 0 P)(JRST 0 G0016)
02240	G0019 (MOVE 1 0 P)(CALL 1 (E EXPLODE))(HLRZ@ 2 1)(CAIE 2 (QUOTE /"))(JRST 0 G0015)
02250	G0016 (PUSH P (SPECIAL QLIST))
02260	G0001 (MOVE 1 0 P)(JUMPN 1 G0028)(MOVE 2 (SPECIAL QLIST))(MOVE 1 -1 P)(CALL 2 (E CONS))(MOVEM 1 (SPECIAL QLIST))
02270		(HLRZ@ 1 1)(JRST 0 G0024)
02280	G0028 (HLRZ@ 2 1)(MOVE 1 -1 P)(CALL 2 (E EQUAL))(JUMPE 1 G0032)(MOVE 1 -1 P)(CALL 1 (E TYPE))
02290		(PUSH P 1)(HLRZ@ 1 -1 P)(CALL 1 (E TYPE))(POP P 2)(CAME 1 2)(JRST 0 G0032)(HLRZ@ 1 0 P)
02300		(JRST 0 G0024)
02310	G0032 (HRRZ@ 1 0 P)(MOVEM 1 0 P)(JRST 0 G0001)
02320	G0024 (SUB P (C 0 0 1 1))(JRST 0 G0014)
02330	G0015 (MOVE 1 0 P)
02340	G0045 
02350	G0014 (MOVEI 2 (QUOTE FIXNUM))(CALL 2 (E MAKNUM))(JRST 0 G0005)
02360	G0011 (HLRZ@ 1 0 P)(CAIE 1 (QUOTE SPECIAL))(JRST 0 G0049)(MOVEI 2 (QUOTE VALUE))(HRRZ@ 1 0 P)
02370		(HLRZ@ 1 1)(CALL 2 (E GET))(JUMPN 1 G0052)(CALL 1 (E NCONS))(MOVEI 3 (QUOTE VALUE))
02380		(MOVE 2 1)(HRRZ@ 1 0 P)(HLRZ@ 1 1)(CALL 3 (E PUTPROP))
02390	G0052 (MOVEI 2 (QUOTE VALUE))(HRRZ@ 1 0 P)(HLRZ@ 1 1)(CALL 2 (E GET))(MOVEI 2 (QUOTE FIXNUM))
02400		(CALL 2 (E MAKNUM))(JRST 0 G0005)
02410	G0049 (CAIE 1 (QUOTE C))(JRST 0 G0062)(PUSH P (SPECIAL KLIST))(PUSH P (C 0 0 (QUOTE NIL)))
02420	G0002 (MOVE 1 -1 P)(JUMPE 1 G0003)(HLRZ@ 2 1)(HLRZ@ 2 2)(HRRZ@ 1 -2 P)(CALL 2 (E EQUAL))(JUMPE 1 G0068)
02430		(HLRZ@ 1 -1 P)(HRRZ@ 1 1)(JRST 0 G0064)
02440	G0068 (HRRZ@ 1 -1 P)(MOVEM 1 -1 P)(JRST 0 G0002)
02450	G0003 (MOVE 1 (SPECIAL GEN))(CALL 1 (E GVAL))(MOVEI 2 (QUOTE 0))(MOVE 3 (SPECIAL CONLIST))
02460		(MOVEM 3 -1 P)(MOVEM 2 0 P)
02470	G0004 (HRRZ@ 1 -1 P)(JUMPN 1 G0079)(HRRZ@ 1 -2 P)(CALL 1 (E NCONS))(HRRM@ 1 -1 P)
02480	G0079 (HRRZ@ 2 -1 P)(HLRZ@ 2 2)(HRRZ@ 1 -2 P)(CALL 2 (E EQUAL))(JUMPE 1 G0085)(MOVE 1 0 P)
02490		(JRST 0 G0064)
02500	G0085 (MOVE 1 0 P)(CALL 1 (E ADD1))(MOVEM 1 0 P)(HRRZ@ 1 -1 P)(MOVEM 1 -1 P)(JRST 0 G0004)
02510	G0064 (SUB P (C 0 0 2 2))(JRST 0 G0005)
02520	G0062 (HLRZ@ 1 0 P)(CALL 1 (E LAPEVAL))(PUSH P 1)(HRRZ@ 1 -1 P)(CALL 1 (E LAPEVAL))(POP P 2)
02530		(CALL 2 (E *PLUS))
02540	G0095 
02550	G0005 (SUB P (C 0 0 1 1))(POPJ P)
02560	NIL 
02570	
02580	
02590	(LAP DEFSYM SUBR) 
02600		(PUSH P 2)(MOVE 2 (SPECIAL REMOB))(PUSH P 1)(CALL 2 (E CONS))(MOVEM 1 (SPECIAL REMOB))
02610		(PUSH P (C 0 0 (QUOTE NIL)))(MOVEI 2 (QUOTE UNDEF))(MOVE 1 -1 P)(CALL 2 (E GET))(MOVEM 1 0 P)
02620		(JUMPN 1 G0002)
02630	G0001 (MOVEI 3 (QUOTE SYM))(MOVE 2 -2 P)(MOVE 1 -1 P)(CALL 3 (E PUTPROP))(JRST 0 G0003)
02640	G0002 (MOVE 1 0 P)(JUMPN 1 G0013)(HRRZ@ 2 -1 P)(HRRZ@ 2 2)(HRRZ@ 2 2)(HRRM@ 2 -1 P)(JRST 0 G0001)
02650	G0013 (HLRZ@ 1 0 P)(PUSH P 1)(CALL 1 (E EXAMINE))(MOVE 2 -3 P)(CALL 2 (E *PLUS))(MOVE 2 1)
02660		(POP P 1)(CALL 2 (E DEPOSIT))(HRRZ@ 1 0 P)(MOVEM 1 0 P)(JRST 0 G0002)
02670	G0003 (SUB P (C 0 0 3 3))(POPJ P)
02680	NIL 
02690	
02700	
02710	(LAP GVAL SUBR) 
02720		(PUSH P 1)(MOVEI 2 (QUOTE SYM))(CALL 2 (E GET))(JUMPN 1 G0001)(MOVEI 2 (QUOTE VALUE))
02730		(MOVE 1 0 P)(CALL 2 (E GET))(JUMPE 1 G0003)(MOVEI 2 (QUOTE FIXNUM))(MOVE 1 0 P)(CALL 2 (E MAKNUM))
02740		(JRST 0 G0001)
02750	G0003 (MOVEI 2 (QUOTE UNDEF))(MOVE 1 0 P)(CALL 2 (E GET))(MOVE 2 (SPECIAL LOC))(CALL 2 (E XCONS))
02760		(MOVEI 3 (QUOTE UNDEF))(MOVE 2 1)(MOVE 1 0 P)(CALL 3 (E PUTPROP))(MOVEI 1 (QUOTE 0))
02770	G0006 
02780	G0001 (SUB P (C 0 0 1 1))(POPJ P)
02790	NIL 
02800	
02810	
02820	(LAP TYPE SUBR) 
02830		(PUSH P 1)(CALL 1 (E NUMBERP))(JUMPE 1 G0002)(HRRZ@ 1 0 P)(HLRZ@ 1 1)
02840	G0002 (SUB P (C 0 0 1 1))(POPJ P)
02850	NIL 
02860	
02870	
02880	
02890	(SETQ KLIST NIL)
02900	(SETQ BPORG BPORG1)
02910	(SETQ BPEND1 (*DIF BPEND 500))
02920	(REMLAP)