Google
 

Trailing-Edge - PDP-10 Archives - -
Click to see without markup as text/plain
There are no other files named in the archive.
(SETQ IBASE (SETQ BASE (ADD1 7))) 

(DEFPROP LAP 
 (LAMBDA(SL)
  (PROG (LOC CONLIST GEN REMOB L)
	(SETQ GEN (GENSYM))
	(SETQ CONLIST (LIST NIL))
	(SETQ LOC BPORG)
   A    (COND ((NULL (SETQ L (READ))) (GO END))
	      ((ATOM L) (DEFSYM L LOC) (GO A)))
	(DEPOSIT LOC (GWD L))
	(SETQ LOC (ADD1 LOC))
	(GO A)
   END  (DEFSYM GEN LOC)
   EN1  (COND
	 ((NULL (SETQ CONLIST (CDR CONLIST)))
	  (EVAL (CONS (QUOTE REMOB) REMOB))
	  (PUTPROP (CAR SL) (NUMVAL BPORG) (CADR SL))
	  (RETURN (LIST (CAR SL) (SETQ BPORG LOC)))))
	(SETQ KLIST (CONS (CONS (CAR CONLIST) LOC) KLIST))
	(DEPOSIT LOC (GWD (CAR CONLIST)))
	(SETQ LOC (ADD1 LOC))
	(GO EN1))) 
FEXPR)


(DEFPROP TYPE 
 (LAMBDA (X) (COND ((NUMBERP X) (CADR X)))) 
EXPR)


(DEFPROP GWD 
 (LAMBDA(X)
  (PROG (WRD FLD)
	(SETQ FLD
	      (QUOTE
	       ((22 . -1) (27 . 17) (0 . 777777) (22 . 777777))))
	(SETQ WRD 0)
	(MAPCAR (FUNCTION
		 (LAMBDA(ZZ)
		  (PROG2 (SETQ WRD
			       (PLUS WRD
				     (LSH (BOOLE 1
						 (CDAR FLD)
						 (LAPEVAL ZZ))
					  (CAAR FLD))))
			 (SETQ FLD (CDR FLD)))))
 		X)
	(RETURN WRD))) 
EXPR)


(DEFPROP LAPEVAL 
 (LAMBDA(X)
  (COND ((NUMBERP X) X)
	((ATOM X) (GVAL X))
	((MEMBER (CAR X) (QUOTE (E QUOTE)))
	 (MAKNUM
	  (COND
	   ((OR (NOT (ATOM (SETQ X (CADR X))))
		(AND (NUMBERP X) (NOT (EQ (PLUS X 0) X)))
		(EQ (CAR (EXPLODE X)) (QUOTE /")))
	    (PROG (Y)
		  (SETQ Y QLIST)
 	     A    (COND
		   ((NULL Y)
		    (RETURN (CAR (SETQ QLIST (CONS X QLIST)))))
		   ((AND (EQUAL X (CAR Y))
			 (EQ (TYPE X) (TYPE (CAR Y))))
		    (RETURN (CAR Y))))
		  (SETQ Y (CDR Y))
		  (GO A)))
	   (T X))
	  (QUOTE FIXNUM)))
	((EQ (CAR X) (QUOTE SPECIAL))
	 (COND
	  ((NULL (GET (CADR X) (QUOTE VALUE)))
	   (PUTPROP (CADR X) (LIST NIL) (QUOTE VALUE))))
	 (MAKNUM (GET (CADR X) (QUOTE VALUE)) (QUOTE FIXNUM)))
	((EQ (CAR X) (QUOTE C))
	 (PROG (N CPTR)
	       (SETQ CPTR KLIST)
 	  L11  (COND ((NULL CPTR) (GO L12))
		     ((EQUAL (CDR X) (CAAR CPTR))
		      (RETURN (CDAR CPTR))))
	       (SETQ CPTR (CDR CPTR))
	       (GO L11)
 	  L12  (GVAL GEN)
	       (SETQ N 0)
	       (SETQ CPTR CONLIST)
 	  A    (COND
		((NULL (CDR CPTR)) (RPLACD CPTR (LIST (CDR X)))))
	       (COND ((EQUAL (CDR X) (CADR CPTR)) (RETURN N)))
	       (SETQ N (ADD1 N))
	       (SETQ CPTR (CDR CPTR))
	       (GO A)))
	(T (PLUS (LAPEVAL (CAR X)) (LAPEVAL (CDR X)))))) 
EXPR)


(DEFPROP DEFSYM 
 (LAMBDA(SYM VAL)
  (PROG (Z)
	(SETQ REMOB (CONS SYM REMOB))
	(COND ((SETQ Z (GET SYM (QUOTE UNDEF))) (GO PATCH)))
   A    (RETURN (PUTPROP SYM VAL (QUOTE SYM)))
   PATCH
	(COND ((NULL Z) (RPLACD SYM (CDDDR SYM)) (GO A)))
	(DEPOSIT (CAR Z) (PLUS (EXAMINE (CAR Z)) VAL))
	(SETQ Z (CDR Z))
	(GO PATCH))) 
EXPR)


(DEFPROP GVAL 
 (LAMBDA(SYM)
  (COND ((GET SYM (QUOTE SYM)))
	((GET SYM (QUOTE VALUE)) (MAKNUM SYM (QUOTE FIXNUM)))
	(T (PUTPROP SYM
		    (CONS LOC (GET SYM (QUOTE UNDEF)))
		    (QUOTE UNDEF))
 	   0))) 
EXPR)


(DEFPROP OPS 
 (LAMBDA(L)
  (PROG NIL
   A    (COND ((NULL L) (RETURN T)))
	(PUTPROP (CAR L) (CADR L) (QUOTE SYM))
	(SETQ L (CDDR L))
	(GO A))) 
FEXPR)

(OPS MOVE 200000 MOVEI 201000 MOVEM 202000 JRST 254000 CALL 34000 JCA
LL 35000 PUSHJ 260000 POPJ 263000 PUSH 261000 POP 262000 P 14 JSP 265
000 EXCH 250000 JUMPE 322000 JUMPN 326000 SOJE 362000 SOJN 366000 CAI
E 302000 CAIN 306000 CAME 312000 CAMN 316000 CALLF 36000 JCALLF 37000
 HRRZ@ 550020 HLRZ@ 554020 TDZA 634000 SUB 274000 HRRZ 550000 HLRZ 55
4000 CLEARM 402000 CLEARB 403000 ADD 270000 MOVNI 211000 CALLF@ 36020
 JCALLF@ 37020 HRRM@ 542020 HRLM@ 506020 HRRZS@ 553020 HLLZS@ 513020 
DPB 137000 HRRM 542000) 
(COND ((NULL (GET (QUOTE QLIST) (QUOTE VALUE))) (SETQ QLIST NIL))) 
(COND ((NULL (GET (QUOTE KLIST) (QUOTE VALUE))) (SETQ KLIST NIL))) 

(DEFPROP REMLAP 
 (LAMBDA NIL
  (PROG (Z)
	(SETQ Z (QUOTE (LAP LAPEVAL GWD DEFSYM REMLAP ILAP GVAL TYPE)))
   A    (COND ((NULL Z) (GO B)))
	(REMPROP (CAR Z) (QUOTE EXPR))
	(REMPROP (CAR Z) (QUOTE FEXPR))
	(SETQ Z (CDR Z))
	(GO A)
   B    (REMPROP (QUOTE REMLAP) (QUOTE EXPR)))) 
EXPR)

(SETQ BPORG1 BPORG) 
(SETQ BPORG (*DIF BPEND 500)) 
(SETQ BPEND1 BPEND) 
(LAP GWD SUBR) 
(PUSH P (C 0)) 
(PUSH P 1) 
(PUSHJ P G0123) 
(137000 1 (C 222200 0 -1 P)) 
(PUSHJ P G0123) 
(242000 1 27) 
(436000 1 -1 P) 
(PUSHJ P G0123) 
(137000 1 (C 2200 0 -1 P)) 
(PUSHJ P G0123) 
(514000 1 1) 
(436000 1 -1 P) 
G0124 
(POP P 1) 
(POP P 1) 
(JRST 0 FIX1A) 
G0125 
(POP P 1) 
(JRST 0 G0124) 
G0123 
(MOVE 2 -1 P) 
(JUMPE 2 G0125) 
(HLRZ 1 0 2) 
(HRRZ 2 0 2) 
(MOVEM 2 -1 P) 
(CALL 1 (E LAPEVAL)) 
(JRST 0 NUMVAL) 
NIL 

(LAP LAP FSUBR) 
	(JSP 6 SPECBIND)(0 0 (SPECIAL LOC))(0 0 (SPECIAL CONLIST))(0 0 (SPECIAL GEN))(0 0 (SPECIAL REMOB))
	(PUSH P 1)(CALL 0 (E GENSYM))(MOVEM 1 (SPECIAL GEN))(MOVEI 1 (QUOTE NIL))(CALL 1 (E NCONS))
	(MOVEM 1 (SPECIAL CONLIST))(MOVE 2 (SPECIAL BPORG))(MOVEM 2 (SPECIAL LOC))(PUSH P (C 0 0 (QUOTE NIL)))
G0001 (CALL 0 (E READ))(MOVEM 1 0 P)(JUMPE 1 G0002)(CALL 1 (E ATOM))(JUMPE 1 G0011)(MOVE 2 (SPECIAL LOC))
	(MOVE 1 0 P)(CALL 2 (E DEFSYM))(JRST 0 G0001)
G0011 (MOVE 1 0 P)(PUSH P (SPECIAL LOC))(CALL 1 (E GWD))(MOVE 2 1)(POP P 1)(CALL 2 (E DEPOSIT))
	(MOVE 1 (SPECIAL LOC))(CALL 1 (E ADD1))(MOVEM 1 (SPECIAL LOC))
	(MOVE 2 (SPECIAL BPEND1))(CALL 2 (E *LESS))(JUMPN 1 G0001)
	(MOVEI 1 (QUOTE (BINARY PROGRAM SPACE EXCEEDED)))(CALL 1 (E PRINT))
	(CALL 0 (E ERR))(JRST 0 G0001)
G0002 (MOVE 2 (SPECIAL LOC))(MOVE 1 (SPECIAL GEN))(CALL 2 (E DEFSYM))
G0003 (HRRZ@ 1 (SPECIAL CONLIST))(MOVEM 1 (SPECIAL CONLIST))(JUMPN 1 G0022)(MOVE 1 (SPECIAL REMOB))
	(CALL 17 (E REMOB))(HLRZ@ 1 -1 P)(PUSH P 1)(MOVE 1 (SPECIAL BPORG))(CALL 1 (E NUMVAL))
	(HRRZ@ 3 -2 P)(HLRZ@ 3 3)(MOVE 2 1)(POP P 1)(CALL 3 (E PUTPROP))(MOVE 1 (SPECIAL LOC))
	(MOVEM 1 (SPECIAL BPORG))(CALL 1 (E NCONS))(HLRZ@ 2 -1 P)(CALL 2 (E XCONS))(JRST 0 G0004)
G0022 (MOVE 2 (SPECIAL LOC))(HLRZ@ 1 (SPECIAL CONLIST))(CALL 2 (E CONS))(MOVE 2 (SPECIAL KLIST))
	(CALL 2 (E CONS))(MOVEM 1 (SPECIAL KLIST))(HLRZ@ 1 (SPECIAL CONLIST))(PUSH P (SPECIAL LOC))
	(CALL 1 (E GWD))(MOVE 2 1)(POP P 1)(CALL 2 (E DEPOSIT))(MOVE 1 (SPECIAL LOC))(CALL 1 (E ADD1))
	(MOVEM 1 (SPECIAL LOC))(JRST 0 G0003)
G0004 (SUB P (C 0 0 2 2))(JRST 0 SPECSTR)
NIL 


(LAP LAPEVAL SUBR) 
	(PUSH P 1)(CALL 1 (E NUMBERP))(JUMPE 1 G0006)(MOVE 1 0 P)(JRST 0 G0005)
G0006 (MOVE 1 0 P)(CALL 1 (E ATOM))(JUMPE 1 G0008)(MOVE 1 0 P)(CALL 1 (E GVAL))(JRST 0 G0005)
G0008 (MOVEI 2 (QUOTE (E QUOTE)))(HLRZ@ 1 0 P)(CALL 2 (E MEMBER))(JUMPE 1 G0011)(HRRZ@ 1 0 P)
	(HLRZ@ 1 1)(MOVEM 1 0 P)(CALL 1 (E ATOM))(JUMPE 1 G0016)(MOVE 1 0 P)(CALL 1 (E NUMBERP))
	(JUMPE 1 G0019)(MOVEI 2 (QUOTE 0))(MOVE 1 0 P)(CALL 2 (E *PLUS))(CAME 1 0 P)(JRST 0 G0016)
G0019 (MOVE 1 0 P)(CALL 1 (E EXPLODE))(HLRZ@ 2 1)(CAIE 2 (QUOTE /"))(JRST 0 G0015)
G0016 (PUSH P (SPECIAL QLIST))
G0001 (MOVE 1 0 P)(JUMPN 1 G0028)(MOVE 2 (SPECIAL QLIST))(MOVE 1 -1 P)(CALL 2 (E CONS))(MOVEM 1 (SPECIAL QLIST))
	(HLRZ@ 1 1)(JRST 0 G0024)
G0028 (HLRZ@ 2 1)(MOVE 1 -1 P)(CALL 2 (E EQUAL))(JUMPE 1 G0032)(MOVE 1 -1 P)(CALL 1 (E TYPE))
	(PUSH P 1)(HLRZ@ 1 -1 P)(CALL 1 (E TYPE))(POP P 2)(CAME 1 2)(JRST 0 G0032)(HLRZ@ 1 0 P)
	(JRST 0 G0024)
G0032 (HRRZ@ 1 0 P)(MOVEM 1 0 P)(JRST 0 G0001)
G0024 (SUB P (C 0 0 1 1))(JRST 0 G0014)
G0015 (MOVE 1 0 P)
G0045 
G0014 (MOVEI 2 (QUOTE FIXNUM))(CALL 2 (E MAKNUM))(JRST 0 G0005)
G0011 (HLRZ@ 1 0 P)(CAIE 1 (QUOTE SPECIAL))(JRST 0 G0049)(MOVEI 2 (QUOTE VALUE))(HRRZ@ 1 0 P)
	(HLRZ@ 1 1)(CALL 2 (E GET))(JUMPN 1 G0052)(CALL 1 (E NCONS))(MOVEI 3 (QUOTE VALUE))
	(MOVE 2 1)(HRRZ@ 1 0 P)(HLRZ@ 1 1)(CALL 3 (E PUTPROP))
G0052 (MOVEI 2 (QUOTE VALUE))(HRRZ@ 1 0 P)(HLRZ@ 1 1)(CALL 2 (E GET))(MOVEI 2 (QUOTE FIXNUM))
	(CALL 2 (E MAKNUM))(JRST 0 G0005)
G0049 (CAIE 1 (QUOTE C))(JRST 0 G0062)(PUSH P (SPECIAL KLIST))(PUSH P (C 0 0 (QUOTE NIL)))
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)
	(HLRZ@ 1 -1 P)(HRRZ@ 1 1)(JRST 0 G0064)
G0068 (HRRZ@ 1 -1 P)(MOVEM 1 -1 P)(JRST 0 G0002)
G0003 (MOVE 1 (SPECIAL GEN))(CALL 1 (E GVAL))(MOVEI 2 (QUOTE 0))(MOVE 3 (SPECIAL CONLIST))
	(MOVEM 3 -1 P)(MOVEM 2 0 P)
G0004 (HRRZ@ 1 -1 P)(JUMPN 1 G0079)(HRRZ@ 1 -2 P)(CALL 1 (E NCONS))(HRRM@ 1 -1 P)
G0079 (HRRZ@ 2 -1 P)(HLRZ@ 2 2)(HRRZ@ 1 -2 P)(CALL 2 (E EQUAL))(JUMPE 1 G0085)(MOVE 1 0 P)
	(JRST 0 G0064)
G0085 (MOVE 1 0 P)(CALL 1 (E ADD1))(MOVEM 1 0 P)(HRRZ@ 1 -1 P)(MOVEM 1 -1 P)(JRST 0 G0004)
G0064 (SUB P (C 0 0 2 2))(JRST 0 G0005)
G0062 (HLRZ@ 1 0 P)(CALL 1 (E LAPEVAL))(PUSH P 1)(HRRZ@ 1 -1 P)(CALL 1 (E LAPEVAL))(POP P 2)
	(CALL 2 (E *PLUS))
G0095 
G0005 (SUB P (C 0 0 1 1))(POPJ P)
NIL 


(LAP DEFSYM SUBR) 
	(PUSH P 2)(MOVE 2 (SPECIAL REMOB))(PUSH P 1)(CALL 2 (E CONS))(MOVEM 1 (SPECIAL REMOB))
	(PUSH P (C 0 0 (QUOTE NIL)))(MOVEI 2 (QUOTE UNDEF))(MOVE 1 -1 P)(CALL 2 (E GET))(MOVEM 1 0 P)
	(JUMPN 1 G0002)
G0001 (MOVEI 3 (QUOTE SYM))(MOVE 2 -2 P)(MOVE 1 -1 P)(CALL 3 (E PUTPROP))(JRST 0 G0003)
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)
G0013 (HLRZ@ 1 0 P)(PUSH P 1)(CALL 1 (E EXAMINE))(MOVE 2 -3 P)(CALL 2 (E *PLUS))(MOVE 2 1)
	(POP P 1)(CALL 2 (E DEPOSIT))(HRRZ@ 1 0 P)(MOVEM 1 0 P)(JRST 0 G0002)
G0003 (SUB P (C 0 0 3 3))(POPJ P)
NIL 


(LAP GVAL SUBR) 
	(PUSH P 1)(MOVEI 2 (QUOTE SYM))(CALL 2 (E GET))(JUMPN 1 G0001)(MOVEI 2 (QUOTE VALUE))
	(MOVE 1 0 P)(CALL 2 (E GET))(JUMPE 1 G0003)(MOVEI 2 (QUOTE FIXNUM))(MOVE 1 0 P)(CALL 2 (E MAKNUM))
	(JRST 0 G0001)
G0003 (MOVEI 2 (QUOTE UNDEF))(MOVE 1 0 P)(CALL 2 (E GET))(MOVE 2 (SPECIAL LOC))(CALL 2 (E XCONS))
	(MOVEI 3 (QUOTE UNDEF))(MOVE 2 1)(MOVE 1 0 P)(CALL 3 (E PUTPROP))(MOVEI 1 (QUOTE 0))
G0006 
G0001 (SUB P (C 0 0 1 1))(POPJ P)
NIL 


(LAP TYPE SUBR) 
	(PUSH P 1)(CALL 1 (E NUMBERP))(JUMPE 1 G0002)(HRRZ@ 1 0 P)(HLRZ@ 1 1)
G0002 (SUB P (C 0 0 1 1))(POPJ P)
NIL 

(SETQ KLIST NIL)
(SETQ BPORG BPORG1)
(SETQ BPEND1 (*DIF BPEND 500))
(REMLAP)