Trailing-Edge
-
PDP-10 Archives
-
-
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)