ADDED reduce2/Hearn-StandardLisp-AIM-90.pdf Index: reduce2/Hearn-StandardLisp-AIM-90.pdf ================================================================== --- reduce2/Hearn-StandardLisp-AIM-90.pdf +++ reduce2/Hearn-StandardLisp-AIM-90.pdf cannot compute difference between binary files ADDED reduce2/README Index: reduce2/README ================================================================== --- reduce2/README +++ reduce2/README @@ -0,0 +1,5 @@ +The files here were retrieved from the Software Preservation Group, +http://www.softwarepreservation.org/projects/LISP/stanford/REDUCE_2 +and other URLs at softwarepreservation.org. It is really good to find these +early sources and documents there. Thanks you! + ADDED reduce2/Stanford-AIM-50_Redacted.pdf Index: reduce2/Stanford-AIM-50_Redacted.pdf ================================================================== --- reduce2/Stanford-AIM-50_Redacted.pdf +++ reduce2/Stanford-AIM-50_Redacted.pdf cannot compute difference between binary files ADDED reduce2/Stanford-AIM-57.pdf Index: reduce2/Stanford-AIM-57.pdf ================================================================== --- reduce2/Stanford-AIM-57.pdf +++ reduce2/Stanford-AIM-57.pdf cannot compute difference between binary files ADDED reduce2/reduce2._reduce2.c.5 Index: reduce2/reduce2._reduce2.c.5 ================================================================== --- reduce2/reduce2._reduce2.c.5 +++ reduce2/reduce2._reduce2.c.5 @@ -0,0 +1,5 @@ +$RUN NEW:LISP SCARDS=*SOURCE*+*MSOURCE* +VERBOS (NIL) PRBUFFER (NIL) +OPEN (WATF:RDC2CHKPT SYSFILE INPUT) +RESTORE (WATF:RDC2CHKPT) +BEGIN NIL ADDED reduce2/reduce2.chkpoint.o.4 Index: reduce2/reduce2.chkpoint.o.4 ================================================================== --- reduce2/reduce2.chkpoint.o.4 +++ reduce2/reduce2.chkpoint.o.4 cannot compute difference between binary files ADDED reduce2/reduce2.example.p.7 Index: reduce2/reduce2.example.p.7 ================================================================== --- reduce2/reduce2.example.p.7 +++ reduce2/reduce2.example.p.7 @@ -0,0 +1,687 @@ + REDUCE2(15-SEP-72 (UM 1-JUNE-73)) ... + + + + COMMENT SOME EXAMPLES OF THE F O R STATEMENT; + + + + COMMENT SUMMING THE SQUARES OF THE EVEN POSITIVE INTEGERS THROUGH 50; + + + + FOR I:=2 STEP 2 UNTIL 50 SUM I**2; + + 22100 + + + COMMENT TO SET XXX TO THE FACTORIAL OF 10; + + + + XXX:=FOR I:=1:10 PRODUCT I; + + XXX:=3628800 + + + COMMENT ALTERNATIVELY, WE COULD SET THE ELEMENTS A(I) OF THE ARRAY A TO THE FACTORIAL OF I BY THE STATEMENTS; + + + + ARRAY A(10); + + + A(0):=1$ + + + FOR I:=1:10 DO A(I):=I*A(I - 1); + + + COMMENT THE ABOVE VERSION OF THE F O R STATEMENT DOES NOT RETURN AN ALGEBRAIC VALUE, BUT WE CAN NOW USE THESE + ARRAY ELEMENTS AS FACTORIALS IN EXPRESSIONS, E. G.; + + + + 1 + A(5); + + 121 + + + COMMENT WE COULD HAVE PRINTED THE VALUES OF EACH A(I) AS THEY WERE COMPUTED BY REPLACING THE F O R STATEMENT BY; + + + + FOR I:=1:10 DO WRITE A(I):=I*A(I - 1); + + A(1):=1 + + A(2):=2 + + A(3):=6 + + A(4):=24 + + A(5):=120 + + A(6):=720 + + A(7):=5040 + + A(8):=40320 + + A(9):=362880 + + A(10):=3628800 + + + COMMENT ANOTHER WAY TO USE FACTORIALS WOULD BE TO INTRODUCE AN OPERATOR FAC BY AN INTEGER PROCEDURE AS FOLLOWS; + + + + INTEGER PROCEDURE FAC(N); + BEGIN INTEGER M,N; + M:=1; + L1:IF N=0 THEN RETURN M; + M:=M*N; + N:=N - 1; + GO TO L1 END; + + + + COMMENT WE CAN NOW USE FAC AS AN OPERATOR IN EXPRESSIONS, E. G. ; + + + + Z**2 + FAC(4) - 2*FAC 2*Y; + + 2 + - (4*Y - Z - 24) + + + COMMENT NOTE IN THE ABOVE EXAMPLE THAT THE PARENTHESES AROUND THE ARGUMENTS OF FAC MAY BE OMITTED SINCE FAC IS A + UNARY OPERATOR; + + + + COMMENT THE FOLLOWING EXAMPLES ILLUSTRATE THE SOLUTION OF SOME COMPLETE PROBLEMS; + + + + COMMENT THE F AND G SERIES (REF SCONZO, P., LESCHACK, A. R. AND TOBEY, R. G., ASTRONOMICAL JOURNAL, VOL 70 (MAY + 1965); + + + + SCALAR F1,F2,G1,G2; + + + DEPS:= - SIG*(MU + 2*EPS)$ + + + DMU:= - 3*MU*SIG$ + + + DSIG:=EPS - 2*SIG**2$ + + + F1:=1$ + + + G1:=0$ + + + FOR I:=1:8 DO BEGIN F2:= - MU*G1 + DEPS*DF(F1,EPS) + DMU*DF(F1,MU) + DSIG*DF(F1,SIG)$ + WRITE"F(",I,") := ",F2; + G2:=F1 + DEPS*DF(G1,EPS) + DMU*DF(G1,MU) + DSIG*DF(G1,SIG)$ + WRITE"G(",I,") := ",G2; + F1:=F2$ + G1:=G2 END; + + + F(1) := 0 + + G(1) := 1 + + F(2) := - MU + + G(2) := 0 + + F(3) := 3*MU*SIG + + G(3) := - MU + + 2 + F(4) := MU*(MU - 15*SIG + 3*EPS) + + G(4) := 6*MU*SIG + + 2 + F(5) := - 15*MU*SIG*(MU - 7*SIG + 3*EPS) + + 2 + G(5) := MU*(MU - 45*SIG + 9*EPS) + + 2 2 4 2 2 + F(6) := - MU*(MU - 210*MU*SIG + 24*MU*EPS + 945*SIG - 630*SIG *EPS + 45*EPS ) + + 2 + G(6) := - 30*MU*SIG*(MU - 14*SIG + 6*EPS) + + 2 2 4 2 2 + F(7) := 63*MU*SIG*(MU - 50*MU*SIG + 14*MU*EPS + 165*SIG - 150*SIG *EPS + 25*EPS ) + + 2 2 4 2 2 + G(7) := - MU*(MU - 630*MU*SIG + 54*MU*EPS + 4725*SIG - 3150*SIG *EPS + 225*EPS ) + + 3 2 2 2 4 2 2 6 + F(8) := MU*(MU - 2205*MU *SIG + 117*MU *EPS + 51975*MU*SIG - 24570*MU*SIG *EPS + 1107*MU*EPS - 135135*SIG + + + 4 2 2 3 + 155925*SIG *EPS - 42525*SIG *EPS + 1575*EPS ) + + 2 2 4 2 2 + G(8) := 126*MU*SIG*(MU - 100*MU*SIG + 24*MU*EPS + 495*SIG - 450*SIG *EPS + 75*EPS ) + + + COMMENT A PROBLEM IN FOURIER ANALYSIS; + + + + FOR ALL X,Y LET COS(X)*COS(Y)=(COS(X + Y) + COS(X - Y))/2,COS(X)*SIN(Y)=(SIN(X + Y) - SIN(X - Y))/2,SIN(X)*SIN(Y) + =(COS(X - Y) - COS(X + Y))/2; + + + FACTOR COS,SIN; + + + ON LIST; + + + (A1*COS(WT) + A3*COS(3*WT) + B1*SIN(WT) + B3*SIN(3*WT))**3; + + 3 3 + (4*SIN(WT) *B1 + + 2 + + 3*SIN(WT)*(2*B3 *B1 + + 2 + - B3*B1 + + 2 + + B3*A1 + + 2 + + 2*B1*A3 + + - 2*B1*A3*A1 + + 2 + + B1*A1 ) + + 2 + + 3*SIN(9*WT)*B3*A3 + + 2 + - 3*SIN(7*WT)*(B3 *B1 + + - 2*B3*A3*A1 + + 2 + - B1*A3 ) + + 2 + + 3*SIN(5*WT)*(B3 *B1 + + 2 + - B3*B1 + + + 2*B3*A3*A1 + + 2 + + B3*A1 + + 2 + - B1*A3 + + + 2*B1*A3*A1) + + 3 3 + + 4*SIN(3*WT) *B3 + + 2 + + 3*SIN(3*WT)*(2*B3*B1 + + 2 + + B3*A3 + + 2 + + 2*B3*A1 + + 2 + + B1*A1 ) + + 3 3 + + 4*COS(WT) *A1 + + 2 + + 3*COS(WT)*(2*B3 *A1 + + + 2*B3*B1*A1 + + 2 + - B1 *A3 + + 2 + + B1 *A1 + + 2 + + 2*A3 *A1 + + 2 + + A3*A1 ) + + 2 + - 3*COS(9*WT)*B3 *A3 + + 2 + - 3*COS(7*WT)*(B3 *A1 + + + 2*B3*B1*A3 + + 2 + - A3 *A1) + + 2 + - 3*COS(5*WT)*(B3 *A1 + + - 2*B3*B1*A3 + + + 2*B3*B1*A1 + + 2 + + B1 *A3 + + 2 + - A3 *A1 + + 2 + - A3*A1 ) + + 3 3 + + 4*COS(3*WT) *A3 + + 2 + + 3*COS(3*WT)*(B3 *A3 + + 2 + + 2*B1 *A3 + + 2 + - B1 *A1 + + 2 + + 2*A3*A1 )) + + /4 + + + COMMENT END OF FOURIER ANALYSIS EXAMPLE ; + + + + OFF LIST; + + + FOR ALL X,Y CLEAR COS X*COS Y,COS X*SIN Y,SIN X*SIN Y; + + + COMMENT LEAVING SUCH REPLACEMENTS ACTIVE WOULD SLOW DOWN SUBSEQUENT COMPUTATION; + + + + COMMENT AN EXAMPLE USING THE MATRIX FACILITY; + + + + MATRIX XX,YY; + + + LET XX=MAT((A11,A12),(A21,A22)),YY=MAT((Y1),(Y2)); + + + 2*DET XX - 3*XXX; + + 2*(A22*A11 - A21*A12 - 5443200) + + + ZZ:=SOLVE(XX,YY); + + ZZ(1,1)=(Y1*A22 - Y2*A12)/(A22*A11 - A21*A12) + + + ZZ(2,1)=( - (Y1*A21 - Y2*A11))/(A22*A11 - A21*A12) + + + + + 1/XX**2; + + 2 2 2 2 2 + MAT(1,1)=(A22 + A21*A12)/(A22 *A11 - 2*A22*A21*A12*A11 + A21 *A12 ) + + + 2 2 2 2 + MAT(1,2)=( - A12*(A22 + A11))/(A22 *A11 - 2*A22*A21*A12*A11 + A21 *A12 ) + + + 2 2 2 2 + MAT(2,1)=( - A21*(A22 + A11))/(A22 *A11 - 2*A22*A21*A12*A11 + A21 *A12 ) + + + 2 2 2 2 2 + MAT(2,2)=(A21*A12 + A11 )/(A22 *A11 - 2*A22*A21*A12*A11 + A21 *A12 ) + + + + + COMMENT END OF MATRIX EXAMPLES; + + + + COMMENT THE FOLLOWING EXAMPLES WILL FAIL UNLESS THE FUNCTIONS NEEDED FOR PROBLEMS IN HIGH ENERGY PHYSICS HAVE + BEEN LOADED; + + + + COMMENT A PHYSICS EXAMPLE; + + + + ON DIV; + + + COMMENT THIS GIVES US OUTPUT IN SAME FORM AS BJORKEN AND DRELL; + + + + MASS KI=0,KF=0,PI=M,PF=M; + + + VECTOR EI,EF; + + + MSHELL KI,KF,PI,PF; + + + LET PI.EI=0,PI.EF=0,PI.PF=M**2 + KI.KF,PI.KI=M*K,PI.KF=M*KP,PF.EI= - KF.EI,PF.EF=KI.EF,PF.KI=M*KP,PF.KF=M*K,KI.EI + =0,KI.KF=M*(K - KP),KF.EF=0,EI.EI= - 1,EF.EF= - 1; + + + FOR ALL P LET GP(P)=G(L,P) + M; + + + COMMENT THIS IS JUST TO SAVE US A LOT OF WRITING; + + + + GP(PF)*(G(L,EF,EI,KI)/(2*KI.PI) + G(L,EI,EF,KF)/(2*KF.PI))*GP(PI)*(G(L,KI,EI,EF)/(2*KI.PI) + G(L,KF,EF,EI)/(2*KF. + PI))$ + + + WRITE"THE COMPTON CROSS-SECTION IS ",*ANS; + + (-1) (-1) 2 2 2 + THE COMPTON CROSS-SECTION IS 1/2*K *KP *(K + 4*K*KP*EF.EI - 2*K*KP + KP ) + + + COMMENT END OF FIRST PHYSICS EXAMPLE; + + + + OFF DIV; + + + COMMENT ANOTHER PHYSICS EXAMPLE; + + + + FACTOR MM,P1.P3; + + + INDEX X1,Y1,Z; + + + MASS P1=MM,P2=MM,P3=MM,P4=MM,K1=0; + + + MSHELL P1,P2,P3,P4,K1; + + + VECTOR Q1,Q2; + + + FOR ALL P LET GA(P)=G(LA,P) + MM,GB(P)=G(LB,P) + MM; + + + GA( - P2)*G(LA,X1)*GA( - P4)*G(LA,Y1)*(GB(P3)*G(LB,X1)*GB(Q1)*G(LB,Z)*GB(P1)*G(LB,Y1)*GB(Q2)*G(LB,Z) + GB(P3)*G( + LB,Z)*GB(Q2)*G(LB,X1)*GB(P1)*G(LB,Z)*GB(Q1)*G(LB,Y1))$ + + + LET Q1=P1 - K1,Q2=P3 + K1; + + + COMMENT IT IS USUALLY FASTER TO MAKE SUCH SUBSTITUTIONS AFTER ALL TRACE ALGEBRA IS DONE; + + + + WRITE"CXN = ",*ANS; + + 4 4 2 2 2 2 + CXN = 32*MM *P3.P1 - 8*MM *(P3.K1 - P1.K1) - 16*MM *P3.P1 - 16*MM *P3.P1*(P4.P2 - P3.K1 + P1.K1) + 8*MM *(P4.P2* + + P3.K1 - P4.P2*P1.K1 - 2*P4.K1*P2.K1) + 8*P3.P1*(2*P4.P3*P2.P1 - P4.P3*P2.K1 + 2*P4.P1*P2.P3 + P4.P1*P2.K1 + + - P4.K1*P2.P3 + P4.K1*P2.P1) + 8*(2*P4.P3*P2.P3*P1.K1 - P4.P3*P2.P1*P3.K1 + P4.P3*P2.P1*P1.K1 - P4.P1*P2. + + P3*P3.K1 + P4.P1*P2.P3*P1.K1 - 2*P4.P1*P2.P1*P3.K1) + + + COMMENT END OF SECOND PHYSICS EXAMPLE; + + + + COMMENT THE FOLLOWING RATHER LONG PROGRAM IS A COMPLETE ROUTINE FOR CALCULATING THE RICCI SCALAR. IT WAS + DEVELOPED IN COLLABORATION WITH DAVID BARTON AND JOHN FITCH; + + + + COMMENT FIRST WE INHIBIT DIAGNOSTIC MESSAGE PRINTING AND THE PRINTING OF ZERO ELEMENTS OF ARRAYS; + + + + OFF MSG$ + + + ON NERO$ + + + COMMENT HERE WE INTRODUCE THE COVARIANT AND CONTRAVARIANT METRICS; + + + + ARRAY GG(3,3),H(3,3),X(3)$ + + + FOR I:=0:3 DO FOR J:=0:3 DO GG(I,J):=H(I,J):=0$ + + + GG(0,0):=E**(Q1(X(1)))$ + + + GG(1,1):= - E**(P1(X(1)))$ + + + GG(2,2):= - X(1)**2$ + + + GG(3,3):= - X(1)**2*SIN(X(2))**2$ + + + FOR I:=0:3 DO H(I,I):=1/GG(I,I)$ + + + IF I~=J LET DF(P1(X(I)),X(J))=0,DF(Q1(X(I)),X(J))=0; + + + COMMENT GENERATE CHRISTOFFEL SYMBOLS AND STORE IN ARRAYS CS1 AND CS2; + + + + ARRAY CS1(3,3,3)$ + + + FOR I:=0:3 DO FOR J:=I:3 DO FOR K:=0:3 DO CS1(J,I,K):=CS1(I,J,K):=(DF(GG(I,K),X(J)) + DF(GG(J,K),X(I)) - DF(GG(I, + J),X(K)))/2$ + + + ARRAY CS2(3,3,3)$ + + + FOR I:=0:3 DO FOR J:=I:3 DO FOR K:=0:3 DO CS2(J,I,K):=CS2(I,J,K):=FOR P:=0:3 SUM H(K,P)*CS1(I,J,P)$ + + + COMMENT NOW CALCULATE THE DERIVATIVES OF THE CHRISTOFFEL SYMBOLS AND STORE IN DC2(I,J,K,L); + + + + ARRAY DC2(3,3,3,3)$ + + + FOR I:=0:3 DO FOR J:=I:3 DO FOR K:=0:3 DO FOR L:=0:3 DO DC2(J,I,K,L):=DC2(I,J,K,L):=DF(CS2(I,J,K),X(L))$ + + + COMMENT NOW STORE THE SUMS OF PRODUCTS OF THE CS2 IN SPCS2; + + + + ARRAY SPCS2(3,3,3,3)$ + + + FOR I:=0:3 DO FOR J:=I:3 DO FOR K:=0:3 DO FOR L:=0:3 DO SPCS2(J,I,K,L):=SPCS2(I,J,K,L):=FOR P:=0:3 SUM CS2(P,L,K) + *CS2(I,J,P)$ + + + COMMENT NOW COMPUTE THE RIEMANN TENSOR AND STORE IN R(I,J,K,L); + + + + ARRAY R(3,3,3,3)$ + + + FOR I:=0:3 DO FOR J:=I + 1:3 DO FOR K:=I:3 DO FOR L:=K + 1:IF K=I THEN J ELSE 3 DO BEGIN R(J,I,L,K):=R(I,J,K,L):= + FOR Q:=0:3 SUM GG(I,Q)*(DC2(K,J,Q,L) - DC2(J,L,Q,K) + SPCS2(K,J,Q,L) - SPCS2(L,J,Q,K))$ + R(I,J,L,K):=R(J,I,K,L):= - R(I,J,K,L)$ + IF I=K&J=L THEN GO TO A$ + R(K,L,I,J):=R(L,K,J,I):=R(I,J,K,L)$ + R(L,K,I,J):=R(K,L,J,I):= - R(I,J,K,L)$ + A:END$ + + + + COMMENT NOW COMPUTE AND PRINT THE RICCI TENSOR; + + + + ARRAY RICCI(3,3)$ + + + FOR I:=0:3 DO FOR J:=0:3 DO WRITE RICCI(J,I):=RICCI(I,J):=FOR P:=0:3 SUM FOR Q:=0:3 SUM H(P,Q)*R(Q,I,P,J); + + ( - Q1(X(1))) ( - (P1(X(1)) - Q1(X(1)))) + RICCI(0,0):=RICCI(0,0):=(4*R(0,0,0,0)*X(1)*E + X(1)*E *DF(P1(X(1)),X(1))*DF + + ( - (P1(X(1)) - Q1(X(1)))) 2 ( - (P1(X(1)) - Q1(X(1)))) + (Q1(X(1)),X(1)) - X(1)*E *DF(Q1(X(1)),X(1)) - 2*X(1)*E *DF(Q1( + + ( - (P1(X(1)) - Q1(X(1)))) + X(1)),X(1),X(1)) - 4*E *DF(Q1(X(1)),X(1)))/(4*X(1)) + + ( - P1(X(1))) ( - Q1(X(1))) + RICCI(1,0):=RICCI(0,1):= - (R(1,0,1,1)*E - R(0,0,0,1)*E ) + + 2 ( - Q1(X(1))) 2 + RICCI(2,0):=RICCI(0,2):=( - (R(2,0,2,2) - R(0,0,0,2)*X(1) *E ))/X(1) + + 2 2 ( - Q1(X(1))) 2 2 + RICCI(3,0):=RICCI(0,3):=(SIN(X(2)) *R(0,0,0,3)*X(1) *E - R(3,0,3,3))/(SIN(X(2)) *X(1) ) + + ( - P1(X(1))) ( - Q1(X(1))) + RICCI(0,1):=RICCI(1,0):= - (R(1,1,1,0)*E - R(0,1,0,0)*E ) + + ( - P1(X(1))) + RICCI(1,1):=RICCI(1,1):=( - (4*R(1,1,1,1)*X(1)*E + X(1)*DF(P1(X(1)),X(1))*DF(Q1(X(1)),X(1)) - X(1)* + + 2 + DF(Q1(X(1)),X(1)) - 2*X(1)*DF(Q1(X(1)),X(1),X(1)) + 4*DF(P1(X(1)),X(1))))/(4*X(1)) + + 2 ( - P1(X(1))) 2 + RICCI(2,1):=RICCI(1,2):=( - (R(2,1,2,2) + R(1,1,1,2)*X(1) *E ))/X(1) + + 2 2 ( - P1(X(1))) 2 2 + RICCI(3,1):=RICCI(1,3):=( - SIN(X(2)) *R(1,1,1,3)*X(1) *E - R(3,1,3,3))/(SIN(X(2)) *X(1) ) + + 2 ( - Q1(X(1))) 2 + RICCI(0,2):=RICCI(2,0):=( - (R(2,2,2,0) - R(0,2,0,0)*X(1) *E ))/X(1) + + 2 ( - P1(X(1))) 2 + RICCI(1,2):=RICCI(2,1):=( - (R(2,2,2,1) + R(1,2,1,1)*X(1) *E ))/X(1) + + 3 ( - P1(X(1))) 3 ( - P1(X(1))) + RICCI(2,2):=RICCI(2,2):=( - (2*R(2,2,2,2) + X(1) *E *DF(P1(X(1)),X(1)) - X(1) *E *DF(Q1(X + + 2 ( - P1(X(1))) 2 2 + (1)),X(1)) - 2*X(1) *E + 2*X(1) ))/(2*X(1) ) + + 2 2 2 + RICCI(3,2):=RICCI(2,3):=( - SIN(X(2)) *R(2,2,2,3) - R(3,2,3,3))/(SIN(X(2)) *X(1) ) + + 2 2 ( - Q1(X(1))) 2 2 + RICCI(0,3):=RICCI(3,0):=(SIN(X(2)) *R(0,3,0,0)*X(1) *E - R(3,3,3,0))/(SIN(X(2)) *X(1) ) + + 2 2 ( - P1(X(1))) 2 2 + RICCI(1,3):=RICCI(3,1):=( - SIN(X(2)) *R(1,3,1,1)*X(1) *E - R(3,3,3,1))/(SIN(X(2)) *X(1) ) + + 2 2 2 + RICCI(2,3):=RICCI(3,2):=( - SIN(X(2)) *R(2,3,2,2) - R(3,3,3,2))/(SIN(X(2)) *X(1) ) + + 4 2 ( - P1(X(1))) ( - P1(X(1))) + RICCI(3,3):=RICCI(3,3):=( - SIN(X(2)) *X(1) *(X(1)*E *DF(P1(X(1)),X(1)) - X(1)*E *DF(Q1(X + + ( - P1(X(1))) 2 2 + (1)),X(1)) - 2*E + 2) - 2*R(3,3,3,3))/(2*SIN(X(2)) *X(1) ) + + + COMMENT FINALLY COMPUTE AND PRINT THE RICCI SCALAR; + + + + R:=FOR I:=0:3 SUM FOR J:=0:3 SUM H(I,J)*RICCI(I,J); + + 4 4 ( - 2*P1(X(1))) 4 ( - 2*Q1(X(1))) 4 + R:=(SIN(X(2)) *(2*R(2,2,2,2) + 2*R(1,1,1,1)*X(1) *E + 2*R(0,0,0,0)*X(1) *E + X(1) * + + ( - P1(X(1))) 4 ( - P1(X(1))) 2 4 ( - + E *DF(P1(X(1)),X(1))*DF(Q1(X(1)),X(1)) - X(1) *E *DF(Q1(X(1)),X(1)) - 2*X(1) *E + + P1(X(1))) 3 ( - P1(X(1))) 3 ( - P1(X(1))) + *DF(Q1(X(1)),X(1),X(1)) + 4*X(1) *E *DF(P1(X(1)),X(1)) - 4*X(1) *E *DF(Q1(X( + + 2 ( - P1(X(1))) 2 4 4 + 1)),X(1)) - 4*X(1) *E + 4*X(1) ) + 2*R(3,3,3,3))/(2*SIN(X(2)) *X(1) ) + + + END OF RICCI TENSOR AND SCALAR CALCULATION; + + LEAVING REDUCE ... + *** ADDED reduce2/reduce2.example.s.6 Index: reduce2/reduce2.example.s.6 ================================================================== --- reduce2/reduce2.example.s.6 +++ reduce2/reduce2.example.s.6 @@ -0,0 +1,226 @@ + +COMMENT SOME EXAMPLES OF THE F O R STATEMENT; + +COMMENT SUMMING THE SQUARES OF THE EVEN POSITIVE INTEGERS + THROUGH 50; + +FOR I:=2 STEP 2 UNTIL 50 SUM I**2; + +COMMENT TO SET XXX TO THE FACTORIAL OF 10; + +XXX := FOR I:=1:10 PRODUCT I; + +COMMENT ALTERNATIVELY, WE COULD SET THE ELEMENTS A(I) OF THE + ARRAY A TO THE FACTORIAL OF I BY THE STATEMENTS; + +ARRAY A(10); +A(0):=1$ +FOR I:=1:10 DO A(I):=I*A(I-1); + +COMMENT THE ABOVE VERSION OF THE F O R STATEMENT DOES NOT RETURN AN + ALGEBRAIC VALUE, BUT WE CAN NOW USE THESE ARRAY ELEMENTS + AS FACTORIALS IN EXPRESSIONS, E. G.; + +1+A(5); + +COMMENT WE COULD HAVE PRINTED THE VALUES OF EACH A(I) + AS THEY WERE COMPUTED BY REPLACING THE F O R STATEMENT BY; + +FOR I:=1:10 DO WRITE A(I):= I*A(I-1); + +COMMENT ANOTHER WAY TO USE FACTORIALS WOULD BE TO INTRODUCE AN +OPERATOR FAC BY AN INTEGER PROCEDURE AS FOLLOWS; + +INTEGER PROCEDURE FAC (N); + BEGIN INTEGER M,N; + M:=1; + L1: IF N=0 THEN RETURN M; + M:=M*N; + N:=N-1; + GO TO L1 + END; + +COMMENT WE CAN NOW USE FAC AS AN OPERATOR IN EXPRESSIONS, +E. G. ; + +Z**2+FAC(4)-2*FAC 2*Y; + +COMMENT NOTE IN THE ABOVE EXAMPLE THAT THE PARENTHESES AROUND +THE ARGUMENTS OF FAC MAY BE OMITTED SINCE FAC IS A UNARY OPERATOR; + +COMMENT THE FOLLOWING EXAMPLES ILLUSTRATE THE SOLUTION OF SOME + COMPLETE PROBLEMS; + +COMMENT THE F AND G SERIES (REF SCONZO, P., LESCHACK, A. R. AND + TOBEY, R. G., ASTRONOMICAL JOURNAL, VOL 70 (MAY 1965); + +SCALAR F1,F2,G1,G2; + +DEPS:= -SIG*(MU+2*EPS)$ +DMU:= -3*MU*SIG$ +DSIG:= EPS-2*SIG**2$ +F1:= 1$ +G1:= 0$ + +FOR I:= 1:8 DO + BEGIN + F2:= -MU*G1 + DEPS*DF(F1,EPS) + DMU*DF(F1,MU) + DSIG*DF(F1,SIG)$ + WRITE "F(",I,") := ",F2; + G2:= F1 + DEPS*DF(G1,EPS) + DMU*DF(G1,MU) + DSIG*DF(G1,SIG)$ + WRITE "G(",I,") := ",G2; + F1:=F2$ + G1:=G2 + END; + +COMMENT A PROBLEM IN FOURIER ANALYSIS; + +FOR ALL X,Y LET COS(X)*COS(Y)= (COS(X+Y)+COS(X-Y))/2, + COS(X)*SIN(Y)= (SIN(X+Y)-SIN(X-Y))/2, + SIN(X)*SIN(Y)= (COS(X-Y)-COS(X+Y))/2; +FACTOR COS,SIN; +ON LIST; +(A1*COS(WT)+ A3*COS(3*WT)+ B1*SIN(WT)+ B3*SIN(3*WT))**3; + +COMMENT END OF FOURIER ANALYSIS EXAMPLE ; + +OFF LIST; +FOR ALL X,Y CLEAR COS X*COS Y,COS X*SIN Y,SIN X*SIN Y; +COMMENT LEAVING SUCH REPLACEMENTS ACTIVE WOULD SLOW DOWN + SUBSEQUENT COMPUTATION; + +COMMENT AN EXAMPLE USING THE MATRIX FACILITY; + +MATRIX XX,YY; + +LET XX= MAT((A11,A12),(A21,A22)), + YY= MAT((Y1),(Y2)); + +2*DET XX - 3*XXX; + +ZZ:= SOLVE (XX,YY); + +1/XX**2; + +COMMENT END OF MATRIX EXAMPLES; + +COMMENT THE FOLLOWING EXAMPLES WILL FAIL UNLESS THE FUNCTIONS + NEEDED FOR PROBLEMS IN HIGH ENERGY PHYSICS HAVE BEEN LOADED; + +COMMENT A PHYSICS EXAMPLE; +ON DIV; COMMENT THIS GIVES US OUTPUT IN SAME FORM AS BJORKEN AND DRELL; +MASS KI= 0, KF= 0, PI= M, PF= M; VECTOR EI,EF; +MSHELL KI,KF,PI,PF; +LET PI.EI= 0, PI.EF= 0, PI.PF= M**2+KI.KF, PI.KI= M*K,PI.KF= + M*KP, PF.EI= -KF.EI, PF.EF= KI.EF, PF.KI= M*KP, PF.KF= + M*K, KI.EI= 0, KI.KF= M*(K-KP), KF.EF= 0, EI.EI= -1, EF.EF= + -1; +FOR ALL P LET GP(P)= G(L,P)+M; +COMMENT THIS IS JUST TO SAVE US A LOT OF WRITING; +GP(PF)*(G(L,EF,EI,KI)/(2*KI.PI) + G(L,EI,EF,KF)/(2*KF.PI)) + * GP(PI)*(G(L,KI,EI,EF)/(2*KI.PI) + G(L,KF,EF,EI)/(2*KF.PI)) $ +WRITE "THE COMPTON CROSS-SECTION IS ",!*ANS; +COMMENT END OF FIRST PHYSICS EXAMPLE; + +OFF DIV; + +COMMENT ANOTHER PHYSICS EXAMPLE; +FACTOR MM,P1.P3; +INDEX X1,Y1,Z; +MASS P1=MM,P2=MM,P3= MM,P4= MM,K1=0; +MSHELL P1,P2,P3,P4,K1; +VECTOR Q1,Q2; +FOR ALL P LET GA(P)=G(LA,P)+MM, GB(P)= G(LB,P)+MM; +GA(-P2)*G(LA,X1)*GA(-P4)*G(LA,Y1)* (GB(P3)*G(LB,X1)*GB(Q1) + *G(LB,Z)*GB(P1)*G(LB,Y1)*GB(Q2)*G(LB,Z) + GB(P3) + *G(LB,Z)*GB(Q2)*G(LB,X1)*GB(P1)*G(LB,Z)*GB(Q1)*G(LB,Y1))$ +LET Q1=P1-K1, Q2=P3+K1; +COMMENT IT IS USUALLY FASTER TO MAKE SUCH SUBSTITUTIONS AFTER ALL + TRACE ALGEBRA IS DONE; +WRITE "CXN = ",!*ANS; + +COMMENT END OF SECOND PHYSICS EXAMPLE; + + +COMMENT THE FOLLOWING RATHER LONG PROGRAM IS A COMPLETE ROUTINE FOR +CALCULATING THE RICCI SCALAR. IT WAS DEVELOPED IN COLLABORATION WITH +DAVID BARTON AND JOHN FITCH; + +COMMENT FIRST WE INHIBIT DIAGNOSTIC MESSAGE PRINTING AND THE PRINTING OF + ZERO ELEMENTS OF ARRAYS; + +OFF MSG$ ON NERO$ + +COMMENT HERE WE INTRODUCE THE COVARIANT AND CONTRAVARIANT METRICS; + +ARRAY GG(3,3),H(3,3),X(3)$ +FOR I:=0:3 DO FOR J:=0:3 DO GG(I,J):=H(I,J):=0$ +GG(0,0):=E**(Q1(X(1)))$ +GG(1,1):=-E**(P1(X(1)))$ +GG(2,2):=-X(1)**2$ +GG(3,3):=-X(1)**2*SIN(X(2))**2$ +FOR I:=0:3 DO H(I,I):=1/GG(I,I)$ + +IF I UNEQ J LET DF(P1(X(I)),X(J))=0, DF(Q1(X(I)),X(J))=0; + +COMMENT GENERATE CHRISTOFFEL SYMBOLS AND STORE IN ARRAYS + CS1 AND CS2; + +ARRAY CS1(3,3,3)$ +FOR I:=0:3 DO FOR J:=I:3 + DO FOR K:=0:3 DO + CS1(J,I,K) := CS1(I,J,K):=(DF(GG(I,K),X(J))+DF(GG(J,K),X(I)) + -DF(GG(I,J),X(K)))/2$ + + +ARRAY CS2(3,3,3)$ +FOR I:= 0:3 DO FOR J:=I:3 + DO FOR K:=0:3 DO + CS2(J,I,K):= CS2(I,J,K) := FOR P := 0:3 + SUM H(K,P)*CS1(I,J,P)$ + +COMMENT NOW CALCULATE THE DERIVATIVES OF THE CHRISTOFFEL SYMBOLS + AND STORE IN DC2(I,J,K,L); + +ARRAY DC2(3,3,3,3)$ +FOR I:=0:3 DO FOR J:=I:3 DO FOR K:=0:3 DO FOR L:=0:3 DO + DC2(J,I,K,L) := DC2(I,J,K,L):=DF(CS2(I,J,K),X(L))$ + +COMMENT NOW STORE THE SUMS OF PRODUCTS OF THE CS2 IN SPCS2; + +ARRAY SPCS2(3,3,3,3)$ +FOR I:=0:3 DO FOR J:=I:3 DO FOR K:=0:3 DO FOR L:=0:3 DO + SPCS2(J,I,K,L) := SPCS2(I,J,K,L) := FOR P := 0:3 + SUM CS2(P,L,K)*CS2(I,J,P)$ + +COMMENT NOW COMPUTE THE RIEMANN TENSOR AND STORE IN R(I,J,K,L); + +ARRAY R(3,3,3,3)$ +FOR I:=0:3 DO FOR J:=I+1:3 DO +FOR K:=I:3 DO +FOR L:=K+1:IF K=I THEN J ELSE 3 DO + BEGIN + R(J,I,L,K) := R(I,J,K,L) := FOR Q := 0:3 + SUM GG(I,Q)*(DC2(K,J,Q,L)-DC2(J,L,Q,K) + +SPCS2(K,J,Q,L)-SPCS2(L,J,Q,K))$ + R(I,J,L,K) := R(J,I,K,L) := -R(I,J,K,L)$ + IF I=K AND J =L THEN GO TO A$ + R(K,L,I,J) := R(L,K,J,I) := R(I,J,K,L)$ + R(L,K,I,J) := R(K,L,J,I) := -R(I,J,K,L)$ + A: END$ + +COMMENT NOW COMPUTE AND PRINT THE RICCI TENSOR; + +ARRAY RICCI(3,3)$ +FOR I:=0:3 DO FOR J:=0:3 DO + WRITE RICCI(J,I) := RICCI(I,J) := FOR P := 0:3 SUM FOR Q := 0:3 SUM + H(P,Q)*R(Q,I,P,J); + +COMMENT FINALLY COMPUTE AND PRINT THE RICCI SCALAR; + +R := FOR I:= 0:3 SUM FOR J:= 0:3 SUM H(I,J)*RICCI(I,J); + +END OF RICCI TENSOR AND SCALAR CALCULATION; + +COMMENT END OF ALL EXAMPLES; END; + + ADDED reduce2/reduce2.mts_master.s.1 Index: reduce2/reduce2.mts_master.s.1 ================================================================== --- reduce2/reduce2.mts_master.s.1 +++ reduce2/reduce2.mts_master.s.1 @@ -0,0 +1,5773 @@ + 00000010 +OPEN (COMPILE SYSFILE INPUT) RESTORE (COMPILE) + 00000030 + 00000040 +DEFLIST (((COMMENT (LAMBDA (U A) NIL))) FEXPR) 00000050 + 00000051 +COMMENT (***** DATE OF LAST SYSTEM UPDATE *****) 00000052 + 00000053 +DEFLIST (((DATE* ( 00000054 + 00000055 +$$$15-SEP-72 (UM 1-JUNE-73)$ + 00000057 +))) SPECIAL) 00000058 + 00000059 +COMMENT (THE FOLLOWING COMMANDS ARE USED BY THE COMPILER) 00000060 + 00000061 +OPTIMIZE (T) BPSUSED (T) 00000062 + 00000063 +COMMENT((R E D U C E P R E P R O C E S S O R F O R L I S P /360))00000090 + 00000100 +OVOFF NIL 00000110 + 00000120 +COMMENT ((REDUCE CONVERTOR)) 00000130 + 00000140 +REMPROP (DEFINE SUBR) 00000150 + 00000160 +SPECIAL ((NOCMP*)) 00000170 + 00000180 +(LAMBDA (U) (COMPILE (DEFLIST U (QUOTE EXPR)))) (( 00000190 + 00000200 +(DEFINE (LAMBDA (U) 00000210 + (DEF1 U (QUOTE EXPR)))) 00000220 + +(DEFEXPR (LAMBDA (U) + (DEF1 U (QUOTE FEXPR)))) + 00000230 +(DEF1 (LAMBDA (U V) 00000240 + (PROG (X Y) 00000250 + A (COND ((NULL U) (RETURN Y)) 00000260 + ((FLAGP (SETQ X (CAAR U)) (QUOTE LOSE)) (GO B)) 00000270 + ((GETD (SETQ X (TRANS X NIL))) 00000280 + (PRINT (LIST (QUOTE *****) X (QUOTE REDEFINED))))) 00000290 + (SETQ Y (NCONC Y (LIST X))) 00000300 + (COND (NOCMP* (DEFLIST (LIST (TRANS (CAR U) T)) V)) 00000310 + ((EQ V (QUOTE EXPR)) 00000320 + (COM1 X (TRANS (CADAR U) NIL) NIL)) 00000330 + (T (COM1 X NIL (TRANS (CADAR U) NIL)))) 00000340 + B (SETQ U (CDR U)) (GO A)))) 00000350 + 00000360 +(TRANS (LAMBDA (U V) 00000370 + (COND ((NULL U) NIL) 00000380 + ((ATOM U) (COND ((NUMBERP U) U) 00000390 + (T 00000400 + ((LAMBDA(X) 00000410 + (COND (X 00000420 + (LIST 00000430 + (QUOTE QUOTE) 00000440 + X)) 00000450 + (T ((LAMBDA (Y) 00000460 + (COND (Y Y) 00000470 + ((AND V (GET U (QUOTE SPECIAL))) + (LIST (QUOTE GTS) (LIST (QUOTE QUOTE) U))) 00000490 + (T U))) 00000500 + (GET U (QUOTE NEWNAM)))))) 00000510 + (GET U (QUOTE CONSTANT)))))) 00000520 + ((ATOM (CAR U)) 00000530 + (COND ((EQ (CAR U) (QUOTE QUOTE)) U) 00000540 + ((NUMBERP (CAR U)) 00000550 + (CONS (CAR U) (MAPTR (CDR U)))) 00000560 + ((AND V (EQ (CAR U) (QUOTE SETQ)) + (GET (CADR U) (QUOTE SPECIAL))) 00000580 + (LIST (QUOTE PTS) (LIST (QUOTE QUOTE) (CADR U)) (TRANS 00000590 + (CADDR U) V))) 00000600 + (T 00000610 + ((LAMBDA(X) 00000620 + (COND (X 00000630 + (SUBLIS 00000640 + (PAIR (CADR X) (MAPTR (CDR U) V)) 00000650 + (CADDR X))) 00000660 + (T (CONS (TRANS (CAR U) V) + (MAPTR (CDR U) V))))) 00000750 + (GET (CAR U) (QUOTE NEWFORM)))))) 00000760 + (T (MAPTR U V))))) 00000770 + 00000780 +(MAPTR (LAMBDA (U V) 00000790 + (COND ((ATOM U) (TRANS U V)) 00000800 + (T (CONS (TRANS (CAR U) V) (MAPTR (CDR U) V)))))) 00000810 + 00000820 +(GETD(LAMBDA(U) 00000830 + (OR (GET U (QUOTE EXPR)) 00000840 + (GET U (QUOTE FEXPR)) 00000850 + (GET U (QUOTE SUBR)) 00000860 + (GET U (QUOTE FSUBR)) 00000870 + (GET U (QUOTE MACRO))))) 00000880 + 00000890 +)) 00000900 + 00000910 +(LAMBDA NIL (PROG NIL (DEFLIST (LIST (LIST (QUOTE CONVRT) 00000912 + (GET (QUOTE TRANS) (QUOTE SUBR)))) (QUOTE SUBR)))) NIL 00000914 + 00000916 +(LAMBDA (U) (DEFLIST U (QUOTE EXPR))) (( 00000920 + 00000930 +(CONSTANT (LAMBDA (U) 00000940 + (DEFLIST U (QUOTE CONSTANT)))) 00000950 + 00000960 +(LOSE (LAMBDA (U) 00000970 + (FLAG U (QUOTE LOSE)))) 00000980 + 00000990 +(NEWFORM (LAMBDA (U) 00001000 + (DEFLIST U (QUOTE NEWFORM)))) 00001010 + 00001020 +(NEWNAM (LAMBDA (U) 00001030 + (DEFLIST U (QUOTE NEWNAM)))) 00001040 + 00001050 +)) 00001060 + 00001070 + 00001080 +(LAMBDA (U) (COMPILE (DEFLIST U (QUOTE EXPR)))) (( 00001090 + 00001100 +(SUBLIS (LAMBDA (U V) (COND 00001110 + ((NULL U) V) 00001120 + (T ((LAMBDA (X) (COND 00001130 + (X (CDR X)) 00001140 + ((ATOM V) V) 00001150 + (T (CONS (SUBLIS U (CAR V)) (SUBLIS U (CDR V)))))) 00001160 + (SASSOC V U (FUNCTION (LAMBDA NIL NIL)))))))) 00001170 +)) 00001180 + 00001190 +CONSTANT (( 00001200 + (**BLANK $$$ $) 00001210 + (**COMMA $$$,$) 00001220 + (**DOLLAR $$/$/) 00001230 + (**ESC $$$?$) + (**LPAR $$$($) 00001250 + (**MILLION 1000000) 00001260 + (**DASH $$$-$) 00001270 + (**DOT $$$.$) 00001280 + (**RPAR $$$)$) 00001290 + (**SEMICOL $$$;$) 00001300 + (**STAR $$$*$) 00001310 +(**EMARK $$/$/) 00001320 + (**FMARK $$$&$) 00001330 + (**QMARK $$$'$) 00001340 + (**SMARK $$$"$) 00001350 + (**XMARK $$$!$) 00001360 + (**EOF EOF) 00001370 + (**PLUSS $$$+$) 00001380 + (**ENDMSG $$$LEAVING REDUCE ...$) 00001390 +)) 00001400 + 00001410 +NEWNAM (( 00001420 + (DIGIT DIGP) 00001430 + (EVENP *EVENP) 00001440 + (EXPLODE *EXPLODE) 00001450 + (LITER LETP) 00001460 + (OPEN *OPEN) 00001470 +(PAIR PAIRX) 00001471 + (PRINC PRIN1) 00001480 + (RDS *RDS) 00001500 + (SPACES XTAB) 00001510 + (WRS *WRS) 00001520 +)) 00001530 + 00001540 + 00001550 +NEWFORM (( 00001560 + (*APPLY (LAMBDA (U V) (APPLY U V ALIST))) 00001570 + (CAAAAR (LAMBDA (U) (CAAR (CAAR U)))) 00001580 + (CAAADR (LAMBDA (U) (CAAR (CADR U)))) 00001590 + (CAADAR (LAMBDA (U) (CAAR (CDAR U)))) 00001600 + (CAADDR (LAMBDA (U) (CAAR (CDDR U)))) 00001610 + (CADAAR (LAMBDA (U) (CADR (CAAR U)))) 00001620 + (CADADR (LAMBDA (U) (CADR (CADR U)))) 00001630 + (CADDAR (LAMBDA (U) (CADR (CDAR U)))) 00001640 + (CADDDR (LAMBDA (U) (CADR (CDDR U)))) 00001650 + (CDAAAR (LAMBDA (U) (CDAR (CAAR U)))) 00001660 + (CDAADR (LAMBDA (U) (CDAR (CADR U)))) 00001670 + (CDADAR (LAMBDA (U) (CDAR (CDAR U)))) 00001680 + (CDDAAR (LAMBDA (U) (CDDR (CAAR U)))) 00001690 + (CDDADR (LAMBDA (U) (CDDR (CADR U)))) 00001700 + (CDDDAR (LAMBDA (U) (CDDR (CDAR U)))) 00001710 + (CDDDDR (LAMBDA (U) (CDDR (CDDR U)))) 00001720 + (DIVIDE (LAMBDA (U V) (CONS (QUOTIENT U V) (REMAINDER U V)))) 00001730 + (GENSYM (LAMBDA NIL (GENSYM1 (QUOTE $$$ G$)))) 00001750 + (ONEP (LAMBDA (N) (EQUAL N 1))) 00001760 + (READCH (LAMBDA NIL (READCH NIL))) 00001770 +)) 00001780 + 00001790 + 00001800 + 00001810 +COMMENT ((DECLARATION OF SPECIAL AND GLOBAL VARIABLES)) 00001820 + 00001830 +COMMENT ((THE FOLLOWING ARE EXTENDED SPECIAL VARIABLES)) 00001840 + 00001850 +SPECIAL ((*S* *S1*)) 00001860 + 00001870 +COMMENT ((THE FOLLOWING VARIABLES ARE GLOBAL TO ALL FUNCTIONS)) 00001880 + 00001890 +SPECIAL(( 00001900 + IFL* OFL* IPL* OPL* PRI* CRCHAR* SV* MCOND* 00001910 + *FORT *ECHO *INT PRECLIS* ORIG* POSN* *NAT YCOORD* 00001920 + YMIN* YMAX* *LIST COUNT* *CARDNO ECHO* FORTVAR* 00001930 + LLENGTH* PLINE* CURSYM* *MODE MATP* DEFN* 00001940 + SEMIC* SYMFG* VARS* TMODE* *SQVAR* PROGRAM* PROGRAML* 00001950 + *GCD *EXP *MCD *FLOAT MATCH* *DIV *RAT *SUPER *MSG 00001960 + *ALLFAC *NCMP SUBFG* FRLIS1* FRLIS* GAMIDEN* SUB2* 00001970 + RPLIS* SUBL* DSUBL* FACTORS* FRASC* VREP* INDICES* 00001980 + WTP* SNO* *RAT *OUTP DIAG* 00001990 + MCHFG* SYMFG* *ANS *RESUBS *NERO EXLIST* ORDN* 00002000 +NAT** 00002001 +)) 00002010 + 00002020 +COMMENT ((THE FOLLOWING VARIABLE IS USED AS A FUNCTIONAL ARGUMENT)) 00002030 + 00002040 +COMMON ((*PI*)) 00002050 + 00002060 +REMPROP (F APVAL) 00002070 + 00002080 + 00002090 +COMMENT ((REDUCE FUNCTIONS WITH SYSTEM DEPENDENT PROPERTIES)) 00002100 + 00002110 +DEFLIST (( 00002120 + 00002130 +(INIT (LAMBDA NIL (PROG NIL 00002140 + (PTS (QUOTE NOCMP*) T) 00002150 + (RECLAIM) 00002160 + (REMPROP (QUOTE INIT) (QUOTE EXPR)) 00002200 + (RETURN (QUOTE ***))))) 00002210 + 00002220 +) EXPR) 00002230 + 00002240 +(LAMBDA (U) (COMPILE (DEFLIST U (QUOTE EXPR)))) (( 00002250 + 00002260 +(PRINTTY (LAMBDA (U) 00002282 + (AND *NAT (PRINT U)))) 00002283 + 00002290 +(READCH* (LAMBDA NIL 00002300 + (SETQ CRCHAR* (READCH NIL)))) 00002310 + 00002320 +)) 00002330 + +DEFINE (( +(MKSTRING (LAMBDA (U) + (LIST (QUOTE QUOTE) (COMPRESS (DELETE **SMARK (CDR U)))))) +)) + +COMMENT ((FUNCTIONS FOR MTS IMPLEMENTATION ONLY)) + +DEFLIST (((PAUSE NORLIS) (CONT NORLIS)) STAT) + +DEFINE (( + +(PAUSE (LAMBDA NIL + (PROG (Y Z) + (COND ((BATCH) (RETURN NIL))) + (PRINM (QUOTE ($$$CONT?$))) + (COND ((YORN) (RETURN NIL))) + (COND ((AND IFL* (NOT (EQ IFL* (CAR IPL*)))) + (SETQ IPL* (CONS IFL* IPL*)))) + (SETQ IFL* NIL) + (SETQ Y *INT) + (SETQ *INT T) + (SETQ Z *ECHO) + (SETQ *ECHO NIL) + (RDS (OPEN (QUOTE GUSER) (QUOTE INPUT))) + (BEGIN1 T) + (SETQ *INT Y) + (SETQ *ECHO Z) + ))) + +(REDMSG1 (LAMBDA (U V) + (PROG NIL + (PRINM (LIST (QUOTE SHOULD) U (QUOTE BE) + (QUOTE DECLARED) V (QUOTE $$$?$))) + (RETURN (YORN)) ))) + +(PRINM (LAMBDA (U) + (PROG (V) + (WRS (OPEN (QUOTE SERCOM) (QUOTE OUTPUT))) + (SETQ V U) +A (PRINC (CAR V)) + (PRINC **BLANK) + (COND ((SETQ V (CDR V)) (GO A))) + (TERPRI) + (WRS OFL*) ))) + +(READM (LAMBDA NIL + (PROG (U) + (CLOSE (QUOTE GUSER)) + (RDS (OPEN (QUOTE GUSER) (QUOTE INPUT))) + (SETQ U (READ)) + (RDS IFL*) + (RETURN U) ))) + +(YORN (LAMBDA NIL + (PROG (U) +A (SETQ U (READM)) + (COND ((EQ U (QUOTE Y)) (RETURN T)) + ((EQ U (QUOTE N)) (RETURN NIL))) + (PRINM (QUOTE (ILLEGAL $$$RESPONSE.$ ENTER Y OR N))) + (GO A) ))) +)) + 00002340 +(LAMBDA (U) (COMPILE (DEFLIST U (QUOTE EXPR)))) (( 00002390 + 00002400 +(BEGIN (LAMBDA NIL (PROG NIL 00002410 + (OVOFF) 00002420 + (SETQ NOCMP* T) 00002430 + (SETQ *INT (NULL (BATCH))) + (SETQ *ECHO (BATCH)) + (*WRS NIL) + (SETQ ORIG* 0) 00002460 + (SETP) 00002470 + (SETQ *MODE (QUOTE ALGEBRAIC)) 00002480 + (COND ((NULL DATE*) (GO A0))) 00002490 + (VERBOS NIL) 00002500 + (EXCISE T) 00002510 + (EXITERR (BATCH)) + (EJECT) 00002521 + (PRIN1 (QUOTE $$$REDUCE2($)) 00002522 + (PRIN1 DATE*) 00002523 + (PRIN1 (QUOTE $$$) ...$)) 00002524 + (TERPRI) (SETQ DATE* NIL) 00002525 + A0 (SETQ IFL* NIL) 00002540 + (SETQ OFL* NIL) 00002550 + (RETURN (BEGIN1 NIL))))) + 00002580 +)) 00002590 + 00002600 + 00002610 +COMMENT ((REDUCE FUNCTIONS DEFINED IN TERMS OF SYSTEM FUNCTIONS 00002620 + OF THE SAME NAME)) 00002630 + 00002640 +COMMENT ((THE FOLLOWING LIST IS USED BY EXPLODN1 DEFINED BELOW)) 00002650 + 00002660 +DEFLIST (((NASL* (((0 . $$$0$) (1 . $$$1$) (2 . $$$2$) (3 . $$$3$) 00002670 + (4 . $$$4$) (5 . $$$5$) (6 . $$$6$) (7 . $$$7$) 00002680 + (8 . $$$8$) (9 . $$$9$))))) SPECIAL) 00002690 + 00002700 +(LAMBDA (U) (COMPILE (DEFLIST U (QUOTE EXPR)))) (( 00002710 + 00002720 +(*EXPLODE (LAMBDA (U) (COND 00002730 + ((NUMBERP U) (EXPLODN U)) 00002740 + (T (EXPLODE U))))) 00002750 + 00002760 +(EXPLODN (LAMBDA (U) (COND 00002770 + ((ZEROP U) (LIST (QUOTE $$$0$))) 00002780 + ((MINUSP U) (CONS (QUOTE $$$-$) (EXPLODN (MINUS U)))) 00002790 + ((NOT (FIXP U)) (LIST 1 2 3 4 5 6 7 8 9 0 1 2)) 00002800 + (T (EXPLODN1 U))))) 00002810 + 00002820 +(EXPLODN1 (LAMBDA (U) (PROG (Z) 00002830 + A (COND ((ZEROP U) (RETURN Z))) 00002840 + (SETQ Z (CONS (CDR (ASSOC* (REMAINDER U 10) NASL*)) Z)) 00002850 + (SETQ U (QUOTIENT U 10)) 00002860 + (GO A)))) 00002870 + 00002880 +(ASSOC* (LAMBDA (U V) 00002890 + (COND ((NULL V) NIL) 00002900 + ((EQUAL U (CAAR V)) (CAR V)) 00002910 + (T (ASSOC* U (CDR V)))))) 00002920 + 00002930 +(*OPEN (LAMBDA (U V) (PROG2 (OPEN U NIL V) U))) + 00002960 +(*RDS (LAMBDA (U) (COND 00002970 + ((NULL U) (RDS (QUOTE LISPIN))) 00002980 + (T (RDS U))))) 00002990 + 00003000 +(*WRS (LAMBDA (U) + (PROG NIL + (WRS (QUOTE LISPOUT)) + (COND (U (PROG2 (ASA NIL) (WRS U)))) + (OTLL (OTLLNG)) + (PTS (QUOTE LLENGTH*) (DIFFERENCE (OTLLNG) 7))))) +)) 00003040 + 00003050 +LOSE ((ASSOC* REMK*)) + 00003070 +COMMENT ((STANDARD LISP FUNCTIONS NOT DEFINED IN LISP/360)) 00003080 + 00003090 + 00003100 +DEFINE (( 00003110 + 00003120 +(COMPRESS (LAMBDA (U) 00003130 + (PROG2 (COND ((DIGIT (CAR U)) 00003140 + (MAP U (FUNCTION (LAMBDA (J) (RNUMB (CAR J)))))) 00003150 + (T (MAP U (FUNCTION (LAMBDA (J) (RLIT (CAR J))))))) 00003160 + (MKATOM)))) 00003170 + 00003180 +(GTS (LAMBDA (U) ((LAMBDA (X) (COND 00003190 + ((NULL X) (ERROR (LIST (QUOTE GTS) U))) 00003200 + (T (CAR X)))) (GET U (QUOTE SPECIAL))))) 00003210 + 00003220 +(PTS (LAMBDA (U V) (CAR ((LAMBDA (X) (COND 00003230 + ((NULL X) (PUT U (QUOTE SPECIAL) (LIST V))) 00003240 + (T (RPLACA X V)))) (GET U (QUOTE SPECIAL)))))) 00003250 + 00003260 +(PUT (LAMBDA (U V W) 00003270 + (PROG2 (DEFLIST (LIST (LIST U W)) V) W))) 00003280 + 00003290 +(*EVAL (LAMBDA (U) ((LAMBDA (X) (COND 00003300 + (X (CAR X)) 00003310 + (T (EVAL U ALIST)))) 00003320 + (GET* U (QUOTE SPECIAL))))) 00003330 + 00003340 +(PAIRX (LAMBDA (U V) 00003341 + (COND ((AND (NULL U) (NULL V)) NIL) 00003342 + ((OR (NULL U) (NULL V)) (ERROR (QUOTE (PAIR MISMATCH)))) 00003343 + (T (CONS (CONS (CAR U) (CAR V)) (PAIRX (CDR U) (CDR V))))))) 00003344 + 00003345 +)) 00003350 + 00003360 +COMMENT ((REDEFINING SOME FUNCTIONS EXCISED FROM THE COMPILER)) 00003370 + 00003380 +DEFINE (( 00003390 + 00003400 +(MAP (LAMBDA (U *PI*) 00003410 + (PROG NIL 00003420 + A (COND ((NULL U) (RETURN NIL))) 00003430 + (*PI* U) 00003440 + (SETQ U (CDR U)) 00003450 + (GO A)))) 00003460 + 00003470 +(MAPCON (LAMBDA (U *PI*) 00003480 + (COND ((NULL U) NIL) 00003490 + (T (NCONC (*PI* U) (MAPCON (CDR U) *PI*)))))) 00003500 + 00003510 +(REVERSE (LAMBDA (U) 00003520 + (PROG (V) 00003530 + A (COND ((NULL U) (RETURN V))) 00003540 + (SETQ V (CONS (CAR U) V)) 00003550 + (SETQ U (CDR U)) 00003560 + (GO A)))) 00003570 + 00003580 +(SUBST (LAMBDA (U V W) 00003590 + (COND ((NULL W) NIL) 00003600 + ((EQUAL V W) U) 00003610 + ((ATOM W) W) 00003620 + (T (CONS (SUBST U V (CAR W)) (SUBST U V (CDR W))))))) 00003630 + 00003640 +)) 00003650 + 00003660 +COMMENT (ARRAY HANDLING ROUTINES) 00003670 + 00003680 +DEFINE (( 00003690 + 00003700 +(*ARRAY (LAMBDA (U) 00003710 + (MAP U (FUNCTION (LAMBDA (J) 00003720 + (PUT (CAAR J) (QUOTE ARRAY) (MKARRAY (CDAR J)))))))) 00003730 + 00003740 +(MKARRAY (LAMBDA (U) 00003750 + (COND ((NULL U) NIL) 00003760 + (T (ARLIST (CDR U) (CAR U)))))) 00003770 + 00003772 +(ARLIST (LAMBDA (U N) 00003774 + (COND ((ZEROP N) NIL) (T (CONS (MKARRAY U) (ARLIST U (SUB1 N))))))) 00003776 + 00003780 +(GETEL (LAMBDA (U) 00003790 + (GETEL1 (GET (CAR U) (QUOTE ARRAY)) (CDR U)))) 00003800 + 00003810 +(GETEL1 (LAMBDA (U V) 00003820 + (COND ((NULL V) U) 00003830 + (T (GETEL1 (NTH U (ADD1 (CAR V))) (CDR V)))))) 00003840 + 00003850 +(SETEL (LAMBDA (U V) 00003860 + (PROG (X N) 00003870 + (SETQ X (REVERSE (CDR U))) 00003880 + (SETQ N (CAR X)) 00003890 + (SETQ X (GETEL1 (GET (CAR U) (QUOTE ARRAY)) 00003900 + (REVERSE (CDR X)))) 00003910 + A (COND ((EQUAL N 0) (RETURN (RPLACA X V)))) 00003920 + (SETQ N (SUB1 N)) 00003930 + (SETQ X (CDR X)) 00003940 + (GO A)))) 00003950 + 00003960 +)) 00003970 + 00003980 +COMMENT ((I O HANDLING ROUTINES)) 00003990 + 00004000 +DEFINE (( 00004010 + 00004020 +(IN (LAMBDA (U) 00004030 + (INOUT U (QUOTE INPUT)))) 00004040 + 00004050 +(OUT (LAMBDA (U) 00004060 + (INOUT U (QUOTE OUTPUT)))) 00004070 + 00004080 +(INOUT (LAMBDA (U V) 00004090 + (PROG (ECHO INT) 00004100 + (COND ((NOT (ATOMLIS U)) (REDERR (QUOTE (ILLEGAL FILE NAME))))) + (SETQ ECHO *ECHO) 00004110 + (SETQ INT *INT) 00004120 + A (COND ((NULL U) (GO E)) 00004130 + ((EQ V (QUOTE OUTPUT)) (GO C)) 00004140 + ((EQ (CAR U) (QUOTE T)) (GO L))) 00004150 + (SETQ IFL* (CAR U)) 00004160 + (COND ((MEMBER IFL* IPL*) (GO B))) 00004170 + (OPEN IFL* V) 00004180 + (SETQ IPL* (CONS IFL* IPL*)) 00004190 + B (RDS IFL*) 00004200 + (SETQ *ECHO T) 00004210 + (SETQ *INT NIL) 00004220 + F (BEGIN1 T) + (SETQ U (CDR U)) 00004240 + (GO A) 00004250 + C (COND ((EQ (CAR U) (QUOTE T)) (GO M))) 00004260 + (SETQ OFL* (CAR U)) 00004270 + (COND ((MEMBER OFL* OPL*) (GO D))) 00004280 + (OPEN OFL* V) 00004290 + (SETQ OPL* (CONS OFL* OPL*)) 00004300 + D (WRS OFL*) 00004310 + E (SETQ *ECHO ECHO) 00004320 + (SETQ *INT INT) 00004330 + (RETURN NIL) 00004340 + L (SETQ IFL* NIL) 00004350 + (RDS NIL) 00004360 + (SETQ *INT (NOT (BATCH))) + (SETQ *ECHO (BATCH)) + (GO F) + M (SETQ OFL* NIL) 00004380 + (WRS NIL) 00004390 + (GO E) 00004400 +))) 00004410 + 00004420 +(SHUT (LAMBDA (U) 00004430 + (PROG (X) 00004440 + A (COND ((NULL U) (RETURN NIL))) 00004450 + (SETQ X (CAR U)) 00004460 + (COND ((MEMBER X OPL*) (GO B)) 00004470 + ((NOT (MEMBER X IPL*)) 00004480 + (REDERR (CONS X (QUOTE (NOT OPEN)))))) 00004490 + (CLOSE X) 00004500 + (SETQ IPL* (DELETE X IPL*)) 00004510 + (COND ((NOT (EQUAL X IFL*)) (GO C))) 00004520 + (RDS (SETQ IFL* (COND (IPL* (CAR IPL*)) (T NIL)))) 00004530 + (GO C) 00004540 + B (SETQ OPL* (DELETE X OPL*)) 00004550 + (CLOSE X) 00004560 + (COND ((NOT (EQ X OFL*)) (GO C))) 00004570 + (SETQ OFL* NIL) 00004580 + (WRS NIL) 00004590 + C (SETQ U (CDR U)) 00004600 + (GO A)))) 00004610 + 00004620 +)) 00004630 + 00004640 +DEFLIST (((SHUT RLIS) (IN RLIS) (OUT RLIS)) STAT) 00004650 + 00004660 + 00004670 +COMMENT ((INITIALIZATION OF INPUT AND OUTPUT CHARACTER STRINGS)) 00004680 + 00004690 +CSET (SWITCH* ( 00004700 + ($$*$* NIL *SEMICOL* NIL) 00004710 + ($$$;$ NIL *SEMICOL* NIL) 00004720 + ($$$+$ NIL PLUS NIL $$$ + $) 00004730 + ($$$-$ NIL MINUS NIL $$$ - $) 00004740 + ($$$*$ $$$*$ TIMES EXPT) 00004750 +($$$/$ NIL QUOTIENT NIL) 00004760 + ($$$=$ NIL EQUAL NIL) 00004770 + ($$$,$ NIL *COMMA* NIL) 00004780 + ($$$($ NIL *LPAR* NIL) 00004790 + ($$$)$ NIL *RPAR* NIL) 00004800 + ($$$.$ NIL CONS NIL) 00004810 + ($$$:$ $$$=$ *COLON* SETQ) 00004820 + ($$$<$ $$$=$ LESSP LESSEQ) 00004830 + ($$$>$ $$$=$ GREATERP GREATEQ) 00004840 + ($$$&$ NIL AND NIL) + ($$$|$ NIL OR NIL) + ($$$~$ $$$=$ NOT UNEQ) +)) 00004850 + 00004860 + 00004870 +COMMENT ((E N D O F R E D U C E P R E P R O C E S S O R)) 00004880 + 00004890 + 00004900 + 00004910 + 00010000 + 00010010 + 00010020 +COMMENT ((R E D U C E M A I N P R O G R A M)) 00010030 + 00010040 +(LAMBDA (U) (MAP U (FUNCTION (LAMBDA (J) (PTS (CAR J) NIL))))) ((*FORT 00010050 + *ECHO *INT PRECLIS* ORIG* POSN* *NAT YCOORD* YMIN* YMAX* *LIST COUNT* 00010060 + *CARDNO ECHO* FORTVAR* LLENGTH* PLINE* CURSYM* *MODE MATP* DEFN* 00010070 + SEMIC* SYMFG* *MSG TMODE* *SQVAR* PROGRAM* PROGRAML* DIAG* VARS* 00010080 + CRCHAR* IFL* OFL* IPL* OPL* PRI* ERFG*)) 00010090 + 00010100 +(LAMBDA (U) (MAP U (FUNCTION (LAMBDA (J) (PTS (CAAR J) (CADAR J)))))) 00010110 +(((*NAT T) (COUNT* 1) (*CARDNO 20) (ORIG* 0) (LLENGTH* 67) (*SQVAR* (T 00010120 +)))) 00010130 + 00010140 +DEFINE (( 00010150 + 00010160 +(FLAGP** (LAMBDA (U V) 00010170 + (AND (ATOM U) (NOT (NUMBERP U)) (FLAGP U V)))) 00010180 + 00010190 +(GET* (LAMBDA (U V) 00010200 + (COND ((NUMBERP U) NIL) (T (GET U V))))) 00010210 + 00010220 +(EQCAR (LAMBDA (U V) 00010230 + (AND (NOT (ATOM U)) (EQ (CAR U) V)))) 00010240 + 00010250 +(MKPREC (LAMBDA NIL 00010260 + (PROG (X Y) 00010270 + (SETQ X (CONS (QUOTE SETQ) PRECLIS*)) 00010280 + (SETQ Y 2) 00010290 + A (COND ((NULL X) (RETURN NIL))) 00010300 + (PUT (CAR X) (QUOTE INFIX) Y) 00010310 + (SETQ X (CDR X)) 00010320 + (SETQ Y (ADD1 Y)) 00010330 + (GO A)))) 00010340 + 00010350 +)) 00010360 + 00010370 +PTS (PRECLIS* (AND OR MEMBER EQUAL UNEQ EQ GREATEQ GREATERP LESSEQ 00010380 + LESSP PLUS MINUS TIMES QUOTIENT EXPT CONS)) 00010390 + 00010400 +(LAMBDA NIL (PROG (W X Y Z) (MKPREC) (SETQ X SWITCH*) (MAP X (FUNCTION 00010410 + (LAMBDA (J) (PUT (CAAR J) (QUOTE SWITCH*) (CDAR J))))) A (COND ((NULL 00010420 + X) (RETURN NIL))) (SETQ W (CDAR X)) (PUT (CADR W) (QUOTE PRTCH) (LIST 00010430 + (CAAR X) (CAAR X))) (COND ((CAR (SETQ Y (CDDR W))) (PROG2 (SETQ Z 00010440 +(COMPRESS (LIST (CAAR X)(CAR W))))(PUT (CAR Y)(QUOTE PRTCH) (LIST Z Z) 00010450 +)))) (COND ((NULL (CDR Y)) (GO B)) ((CADR Y) (RPLACA (GET (CADR W) 00010460 +(QUOTE PRTCH))(CADR Y))))(COND ((CDDR Y)(RPLACA (GET (CAR Y) (QUOTE 00010470 + PRTCH)) (CADDR Y)))) B (SETQ X (CDR X)) (GO A))) NIL 00010480 + 00010490 +DEFLIST (((MINUS (PLUS . MINUS))) ALT) 00010500 + 00010510 +DEFINE (( 00010520 + 00010530 +(RVLIS (LAMBDA NIL 00010540 + (PROG (X) 00010550 + A (SETQ X (CONS (SCAN) X)) 00010560 + (COND 00010570 + ((OR (FLAGP** (SCAN) (QUOTE DELIM)) 00010580 + (MEMBER CURSYM* (QUOTE (CLEAR LET MATCH SAVEAS)))) 00010590 + (RETURN X)) 00010600 + ((NOT (EQ CURSYM* (QUOTE *COMMA*))) (CURERR NIL T))) 00010610 + (GO A)))) 00010620 + 00010630 +(INFIXFN (LAMBDA NIL 00010640 + (PROG (X) 00010650 + (SETQ X (RVLIS)) 00010660 + (COND 00010670 + ((EQ *MODE (QUOTE ALGEBRAIC)) 00010680 + (*APPLY (QUOTE OPERATOR) (LIST X)))) 00010690 + (SETQ PRECLIS* (APPEND X PRECLIS*)) 00010700 + (MKPREC)))) 00010710 + 00010720 +(PRECEDFN (LAMBDA NIL 00010730 + (PROG (W X Y Z) 00010740 + (SETQ X (RVLIS)) 00010750 + (SETQ Y (CAR X)) 00010760 + (SETQ X (CADR X)) 00010770 + (SETQ PRECLIS* (DELETE X PRECLIS*)) 00010780 + (SETQ W PRECLIS*) 00010790 + A (COND ((NULL W) (REDERR (CONS Y (QUOTE (NOT FOUND))))) 00010800 + ((EQ Y (CAR W)) (GO B))) 00010810 + (SETQ Z (CONS (CAR W) Z)) 00010820 + (SETQ W (CDR W)) 00010830 + (GO A) 00010840 + B (SETQ PRECLIS* 00010850 + (NCONC (REVERSE Z) (CONS (CAR W) (CONS X (CDR W))))) 00010860 + (MKPREC)))) 00010870 + 00010880 +)) 00010890 + 00010900 +DEFINE (( 00010910 + 00010920 +(MATHPRINT (LAMBDA (L) 00010930 + (PROG NIL (MAPRIN L) (TERPRI*)))) 00010940 + 00010950 +(MAPRIN (LAMBDA (U) 00010960 + (MAPRINT U 0))) 00010970 + 00010980 +(MAPRINT (LAMBDA (L P) 00010990 + (PROG (X Y) 00011000 + (COND ((NULL L) (RETURN NIL)) 00011010 + ((ATOM L) (GO B)) 00011020 + ((NOT (ATOM (CAR L))) (MAPRINT (CAR L) P)) 00011030 + ((SETQ X (GET* (CAR L) (QUOTE INFIX))) (GO A)) 00011040 + ((SETQ X (GET* (CAR L) (QUOTE SPECPRN))) 00011050 + (RETURN (*APPLY X (LIST (CDR L))))) 00011060 + (T (PRINC* (CAR L)))) 00011070 + (PRINC* **LPAR) 00011080 + (INPRINT (QUOTE *COMMA*) 0 (CDR L)) 00011090 + E (RETURN (PRINC* **RPAR)) 00011100 + B (COND ((NUMBERP L) (GO D)) 00011110 + ((SETQ X (GET L (QUOTE OLDNAME))) 00011120 + (RETURN (PRINC* X)))) 00011130 + C (RETURN (PRINC* L)) 00011140 + D (COND ((NOT (MINUSP L)) (GO C))) 00011150 + (PRINC* **LPAR) 00011160 + (PRINC* L) 00011170 + (GO E) 00011180 + A (SETQ P (NOT (GREATERP X P))) 00011190 + (COND ((NOT P) (GO G))) 00011200 + (SETQ Y ORIG*) 00011210 + (PRINC* **LPAR) 00011220 + (COND ((LESSP POSN* 15) (SETQ ORIG* POSN*))) 00011230 + G (INPRINT (CAR L) X (CDR L)) 00011240 + (COND ((NOT P) (RETURN NIL))) 00011250 + (PRINC* **RPAR) 00011260 + (SETQ ORIG* Y)))) 00011270 + 00011280 +(INPRINT (LAMBDA (OP P L) 00011290 + (PROG NIL 00011300 + (COND ((FLAGP OP (QUOTE UNIP)) (GO A))) 00011310 + (MAPRINT (CAR L) P) 00011320 + (GO C) 00011330 + A (COND ((NULL L) (RETURN NIL)) 00011340 + ((AND (NOT (ATOM (CAR L))) 00011350 + (GET* (CAAR L) (QUOTE ALT)) 00011360 + (EQ OP (CAR (GET* (CAAR L) (QUOTE ALT))))) 00011370 + (GO B))) 00011380 + (OPRIN OP) 00011390 + B (MAPRINT (CAR L) P) 00011400 + (COND ((OR (NOT *NAT) (NOT (EQ OP (QUOTE EXPT)))) (GO C))) 00011410 + (SETQ YCOORD* (SUB1 YCOORD*)) 00011420 + (SETQ YMIN* (*EVAL (LIST (QUOTE MIN) YMIN* YCOORD*))) 00011430 + C (SETQ L (CDR L)) 00011440 + (GO A)))) 00011450 + 00011460 +)) 00011470 + 00011480 +DEFINE (( 00011490 + 00011500 +(OPRIN (LAMBDA (OP) 00011510 + ((LAMBDA(X) 00011520 + (COND ((NULL X) (PRINC* OP)) 00011530 + (*FORT (PRINC* (CADR X))) 00011540 + (*NAT 00011550 + (COND ((EQ OP (QUOTE EXPT)) 00011560 + (PROG NIL 00011570 + (SETQ YCOORD* (ADD1 YCOORD*)) 00011580 + (SETQ YMAX* 00011590 + (*EVAL 00011600 + (LIST (QUOTE MAX) YMAX* YCOORD*))))) 00011610 + ((AND *LIST 00011620 + (MEMBER OP (QUOTE (PLUS MINUS QUOTIENT)))) 00011630 + (PROG NIL (CLOSELINE) (TERPRI) (PPRINT (CAR X)))) 00011640 + (T (PPRINT (CAR X))))) 00011650 + (T (PRINC (CAR X))))) 00011660 + (GET OP (QUOTE PRTCH))))) 00011670 + 00011680 +(PRINC* (LAMBDA (U) 00011690 + (COND (*NAT (PPRINT U)) 00011700 + ((NULL *FORT) (PRINC U)) 00011710 + (T 00011720 + (PROG NIL 00011730 + (COND 00011740 + ((AND (EQUAL COUNT* *CARDNO) 00011750 + (OR (EQ U **PLUSS) (EQ U **DASH))) 00011760 + (GO B)) 00011770 + ((NOT 00011780 + (GREATERP (SETQ POSN* 00011790 + (PLUS POSN* (LENGTH (EXPLODE U)))) 00011800 + 69)) 00011810 + (GO A))) 00011820 + (TERPRI) 00011830 + (SPACES 5) 00011840 + (PRINC (QUOTE X)) 00011850 + (SETQ POSN* (PLUS 6 (LENGTH (EXPLODE U)))) 00011860 + (SETQ COUNT* (ADD1 COUNT*)) 00011870 + A (RETURN (COND (ECHO* (PRINC U)) (T NIL))) 00011880 + B (TERPRI) 00011890 + (SETQ POSN* 0) + (COND ((NULL FORTVAR*) (GO A))) + (SPACES 6) 00011900 + (SETQ POSN* 6) + (PRINC* FORTVAR*) + (OPRIN (QUOTE EQUAL)) 00011920 + (PRINC* FORTVAR*) + (SETQ COUNT* 1) 00011940 + (GO A)))))) 00011950 + 00011960 +(TERPRI* (LAMBDA NIL 00011970 + (COND (*NAT (PROG NIL (CLOSELINE) (COND (ECHO* (TERPRI))))) 00011980 + (*FORT (COND ((ZEROP POSN*) NIL) 00011990 + (T (PROG NIL (TERPRI) (SETQ COUNT* 1) 00011992 + (SETQ POSN* 0))))) 00011994 + (T (TERPRI))))) 00012000 + 00012010 +(PPRINT (LAMBDA (U) 00012020 + (PROG (M N) 00012030 + (SETQ N (LENGTH (EXPLODE U))) 00012040 + (COND ((GREATERP N LLENGTH*) (GO A1))) 00012050 + C (SETQ M (PLUS POSN* N)) 00012060 + (COND ((AND (GREATERP M LLENGTH*) (NOT (TERPRI*))) (GO C))) 00012070 + (SETQ PLINE* 00012080 + (CONS (CONS (CONS (CONS POSN* M) YCOORD*) U) PLINE*)) 00012090 + A (RETURN (SETQ POSN* M)) 00012100 + A1 (TERPRI*) 00012110 + (PRINC U) 00012120 + (RETURN (SETQ POSN* (REMAINDER N LLENGTH*)))))) 00012130 + 00012140 +(CLOSELINE (LAMBDA NIL 00012150 + (PROG (N) 00012160 + (COND ((OR (NULL PLINE*) (NULL ECHO*)) (GO C))) 00012170 + (SETQ N YMAX*) 00012180 + (SETQ PLINE* (REVERSE PLINE*)) 00012190 + A (SCPRINT PLINE* N) 00012200 + (COND ((EQUAL N YMIN*) (GO B))) 00012210 + (TERPRI) 00012220 + (SETQ N (SUB1 N)) 00012230 + (GO A) 00012240 + B (COND ((EQ ECHO* (QUOTE RESULT)) (TERPRI))) 00012250 + C (SETP)))) 00012260 + 00012270 +(SCPRINT (LAMBDA (U N) 00012280 + (PROG (M) 00012290 + (SETQ POSN* 0) 00012300 + A (COND ((NULL U) (RETURN NIL)) 00012310 + ((NOT (EQUAL (CDAAR U) N)) (GO B)) 00012320 + ((NOT (MINUSP (SETQ M (DIFFERENCE (CAAAAR U) POSN*)))) 00012330 + (SPACES M))) 00012340 + (PRINC (CDAR U)) 00012350 + (SETQ POSN* (CDAAAR U)) 00012360 + B (SETQ U (CDR U)) 00012370 + (GO A)))) 00012380 + 00012390 +(SPACES* (LAMBDA (N) 00012400 + (COND (*NAT (SETQ POSN* (PLUS N POSN*))) (T (SPACES N))))) 00012410 + 00012420 +)) 00012430 + 00012440 +DEFINE (( 00012450 + 00012460 +(SETP (LAMBDA NIL 00012470 + (PROG NIL 00012480 + (SETQ PLINE* NIL) 00012490 + (SETQ POSN* ORIG*) 00012500 + (SETQ YMAX* 0) 00012510 + (SETQ YMIN* 0) 00012520 + (SETQ YCOORD* 0)))) 00012530 + 00012540 +)) 00012550 + 00012560 +FLAG ((MINUS NOT) UNIP) 00012570 + 00012580 +DEFINE (( 00012590 + 00012600 +(MREAD* (LAMBDA (J) 00012610 + (PROG2 (SCAN) (MREAD J)))) 00012620 + 00012630 +(MREAD (LAMBDA (J) 00012640 + (PROG (U V W W1 X Y Z) 00012650 + (SETQ Z -1) 00012660 + A (SETQ V CURSYM*) 00012670 + (COND ((OR (NOT (ATOM V)) (NUMBERP V)) (GO B)) 00012680 + ((FLAGP V (QUOTE DELIM)) (GO ERR1)) 00012682 + ((EQ V (QUOTE *LPAR*)) (GO E)) 00012690 + ((AND (EQ V (QUOTE *RPAR*)) (NULL U)) (RETURN NIL))) 00012700 + (SETQ X (GET V (QUOTE INFIX))) 00012710 + B0 (COND ((SETQ W (GET* V (QUOTE ISTAT))) (GO L))) 00012720 + B (SETQ W (SCAN)) 00012750 + BX (SETQ Y NIL) 00012760 + (COND ((OR (NOT (ATOM W)) (NUMBERP W)) (GO B2)) 00012762 + ((FLAGP W (QUOTE DELIM)) (GO ENDD)) 00012764 + ((EQ W (QUOTE *LPAR*)) (GO E2)) 00012770 + ((EQ W (QUOTE *RPAR*)) (GO END0)) 00012780 + (U (GO B1))) 00012790 + BY (COND 00012800 + ((AND J 00012870 + (EQ W (QUOTE *COMMA*)) 00012880 + (NOT (MEMBER J (QUOTE (MAT PAREN FUNC))))) 00012890 + (RETURN V))) 00012900 + B1 (SETQ Y (GET W (QUOTE INFIX))) 00012910 + B2 (COND ((NULL X) (GO SYM)) 00012920 + ((NOT (FLAGP V (QUOTE UNARY))) (GO ERR3))) 00012930 + C (SETQ Z X) 00012940 + (SETQ U (CONS (LIST V) U)) 00012950 + (SETQ V W) 00012960 + (SETQ X Y) 00012970 + (COND ((OR (NOT (ATOM V)) (NUMBERP V)) (GO B)) (T (GO B0))) 00012980 + SYM (COND ((NULL Y) (GO M)) 00012990 + ((AND (NULL W1) 00013000 + (SETQ W1 (GET W (QUOTE ALT))) 00013010 + (SETQ W (CAR W1))) 00013020 + (GO B1))) 00013030 + SYM1 (COND ((OR (NULL Z) (LESSP Y Z)) (GO H)) 00013040 + ((OR (GREATERP Y Z) (FLAGP W (QUOTE BINARY))) (GO G))) 00013050 + (SETQ U (CONS (ACONC (CAR U) V) (CDR U))) 00013060 + (GO G1) 00013070 + E (SETQ V 00013080 + (MREAD* 00013090 + (COND ((EQ J (QUOTE MAT)) (QUOTE FUNC)) 00013100 + (T (QUOTE PAREN))))) 00013110 + (GO B) 00013130 + E2 (COND ((EQ V (QUOTE MAT)) 00013140 + (SETQ V (CONS V (REMCOMMA (MREAD* (SETQ MATP* V)))))) 00013150 + ((AND (ATOM V) (GET V (QUOTE UNARY)) 00013152 + (SETQ W (CAR (MREAD* (QUOTE FUNC))))) (GO C)) 00013154 + ((OR (ATOM V) (EQ *MODE (QUOTE SYMBOLIC))) 00013160 + (SETQ V (CONS V (MREAD* (QUOTE FUNC))))) 00013170 + (T (GO ERR4))) 00013180 + (SETQ X NIL) 00013185 + (GO B) 00013190 + G (SETQ U (CONS (LIST W V) U)) 00013200 + (SETQ Z Y) 00013210 + G1 (COND (W1 (GO G2))) 00013220 + (SCAN) 00013230 + G3 (SETQ X NIL) 00013232 + (GO A) 00013240 + G2 (SETQ CURSYM* (CDR W1)) 00013250 + (SETQ W1 NIL) 00013260 + (GO G3) 00013270 + H (SETQ V (ACONC (CAR U) V)) 00013280 + (SETQ U (CDR U)) 00013290 + (COND ((AND (NULL U) (SETQ Z 0)) (GO BY))) 00013300 + (SETQ Z (GET (CAAR U) (QUOTE INFIX))) 00013310 + (GO SYM1) 00013320 + L (SETQ V (*APPLY W NIL)) 00013330 + (SETQ W CURSYM*) 00013340 + (GO BX) 00013350 + M (COND ((NUMBERP V) (GO ERR4)) 00013360 + ((PROGVR V) 00013370 + (LPRIM* 00013380 + (APPEND (QUOTE (PROGRAM VARIABLE)) 00013390 + (CONS V 00013400 + (QUOTE (USED AS OPERATOR))))))) 00013410 + (GO C) 00013420 + END0 (COND ((NULL J) (GO ERR21)) (T (GO END2))) 00013430 + ENDD (COND ((MEMBER J (QUOTE (MAT PAREN FUNC))) (GO ERR22))) 00013440 + END2 (COND (X (GO ERR1))) 00013450 + END1 (COND 00013460 + ((NULL U) 00013470 + (RETURN (COND ((EQ J (QUOTE FUNC)) (REMCOMMA V)) (T V))))) 00013480 + (SETQ V (ACONC (CAR U) V)) 00013490 + (SETQ U (CDR U)) 00013500 + (GO END1) 00013510 + ERR1 (CURERR (QUOTE (SYNTAX ERROR)) NIL) 00013520 + ERR21 00013530 + (CURERR (QUOTE (TOO MANY RIGHT PARENTHESES)) NIL) 00013540 + ERR22 00013550 + (CURERR (QUOTE (TOO FEW RIGHT PARENTHESES)) NIL) 00013560 + ERR3 (CURERR (QUOTE (REDUNDANT OPERATOR)) 1) 00013570 + ERR4 (CURERR (QUOTE (MISSING OPERATOR)) NIL)))) 00013580 + 00013590 +(ACONC (LAMBDA (U V) 00013600 + (NCONC U (LIST V)))) 00013610 + 00013620 +(REMCOMMA (LAMBDA (U) 00013630 + (COND ((EQCAR U (QUOTE *COMMA*)) (CDR U)) (T (LIST U))))) 00013640 + 00013650 +(SCAN (LAMBDA NIL 00013660 + (PROG (X Y) 00013670 + (COND ((EQ CURSYM* (QUOTE *SEMICOL*)) (TERPRI*))) 00013680 + A (COND ((EQ CRCHAR* **BLANK) (GO L)) 00013690 + ((EQ CRCHAR* **EOF) (GO EOF)) + ((DIGIT CRCHAR*) (GO G)) 00013700 + ((LITER CRCHAR*) (GO E)) 00013710 + ((EQ CRCHAR* **XMARK) (GO E0)) 00013720 + ((EQ CRCHAR* **QMARK) (GO P)) 00013730 + ((EQ CRCHAR* **SMARK) (RETURN (COMM1 NIL))) 00013740 + ((NULL (SETQ X (GET* CRCHAR* (QUOTE SWITCH*)))) 00013750 + (GO B)) 00013760 + ((EQ (SETQ Y (CADR X)) (QUOTE *SEMICOL*)) (GO J)) 00013770 + ((EQ (READCH*) (CAR X)) (GO K))) 00013780 + C (SETQ CURSYM* (CADR X)) 00013790 + D (COND ((OR ECHO* *NAT) (SYMPRI CURSYM*))) + (COND 00013810 + ((SETQ X (GET* CURSYM* (QUOTE NEWNAME))) (SETQ CURSYM* X))) 00013820 + D1 (RETURN CURSYM*) 00013830 + E0 (READCH*) 00013840 + E (SETQ Y (CONS CRCHAR* Y)) 00013850 + (COND 00013860 + ((OR (DIGIT (READCH*)) (LITER CRCHAR*)) (GO E)) 00013870 + ((EQ CRCHAR* **XMARK) (GO E0))) 00013880 + (GO H) 00013890 + G (SETQ Y (CONS CRCHAR* Y)) 00013900 + (SETQ X CRCHAR*) 00013910 + (COND 00013920 + ((OR (DIGIT (READCH*)) 00013930 + (EQ CRCHAR* **DOT) 00013940 + (EQ CRCHAR* (QUOTE E)) 00013950 + (EQ X (QUOTE E))) 00013960 + (GO G))) 00013970 + H (SETQ CURSYM* (COMPRESS (REVERSE Y))) 00013980 + (GO D) 00013990 + J (SETQ SEMIC* CRCHAR*) 00014000 + (SETQ CRCHAR* **BLANK) 00014010 + (GO C) 00014020 + K (READCH*) 00014030 + (SETQ CURSYM* (CADDR X)) 00014040 + (GO D) 00014050 + B (COND ((EQ CRCHAR* **ESC) (ERROR **ESC)) 00014060 + (Y 00014070 + (CURERR (CONS CRCHAR* (QUOTE (INVALID CHARACTER))) 00014080 + NIL))) 00014090 + (SETQ CURSYM* CRCHAR*) 00014100 + (READCH*) 00014110 + (GO D) 00014120 + L (READCH*) 00014130 + (GO A) 00014140 + P (SETQ CURSYM* (LIST (QUOTE QUOTE) (READ))) 00014150 + (READCH*) 00014160 + (COND ((OR ECHO* *NAT) (MAPRIN CURSYM*))) + (GO D1) + EOF (SETQ CURSYM* (QUOTE END)) + (SETQ CRCHAR* **SEMICOL) + (GO D) ))) + 00014190 +)) 00014200 + 00014210 +DEFINE (( 00014220 + 00014230 +(LPRI (LAMBDA (U) 00014240 + (PROG NIL 00014250 + A (COND ((NULL U) (RETURN NIL))) 00014260 + (PRINC* (CAR U)) 00014270 + (SPACES* 1) 00014280 + (SETQ U (CDR U)) 00014290 + (GO A)))) 00014300 + 00014310 +(LPRIE (LAMBDA (U X) 00014320 + (PROG NIL (SETQ ERFG* T) (LPRIW U X (QUOTE *****))))) 00014330 + 00014340 +(REDERR (LAMBDA (U) 00014350 + (PROG2 (LPRIE U T) (ERROR*)))) 00014360 + 00014370 +(LPRIW (LAMBDA (U X Y) 00014380 + (PROG (V W) 00014390 + (COND ((AND OFL* (OR *FORT (NOT *NAT))) (GO D))) 00014392 + (TERPRI*) 00014400 + A (SETQ V U) 00014410 + (PRINC Y) 00014420 + (PRINC **BLANK) 00014430 + B (COND ((NULL V) (GO C))) 00014440 + (PRINC (CAR V)) 00014450 + (PRINC **BLANK) 00014460 + (SETQ V (CDR V)) 00014470 + (GO B) 00014480 + C (COND (X (TERPRI))) 00014490 + (COND ((NULL OFL*) (RETURN NIL)) (W (RETURN (WRS OFL*)))) 00014500 + D (WRS NIL) 00014510 + (SETQ W T) 00014520 + (GO A)))) 00014530 + 00014540 +)) 00014550 + 00014560 +DEFLIST (((*COMMA* 1)) INFIX) 00014570 + 00014580 +FLAG ((CONS EXPT QUOTIENT) BINARY) 00014590 + 00014600 +FLAG ((PLUS MINUS TIMES NOT *COMMA*) UNARY) 00014610 + 00014620 +FLAG ((*COLON* *SEMICOL*) DELIM) 00014630 + 00014640 +DEFINE (( 00014670 + 00014680 +(COMMAND (LAMBDA NIL 00014690 + (PROG2 (SCAN) (COMMAND1 (QUOTE TOP))))) 00014700 + 00014710 +(COMMAND1 (LAMBDA (U) 00014720 + (PROG (V X Y) 00014730 + A0 (COND ((NOT (ATOM U)) (SETQ V (CAR U))) 00014740 + ((AND (EQ CURSYM* (QUOTE *SEMICOL*)) 00014750 + (LIST (SCAN))) (GO A0)) 00014760 + ((NOT (SETQ Y (GET* (SETQ V CURSYM*) (QUOTE STAT)))) 00014770 + (SETQ V (MREAD 00014780 + (AND (NOT (EQ U (QUOTE TOP))) 00014790 + (OR (EQ U (QUOTE IF)) 00014800 + (EQ *MODE (QUOTE SYMBOLIC)))))))) 00014810 + (SETQ U (AND (NOT (EQ *MODE (QUOTE SYMBOLIC))) + (OR PRI* (EQ U (QUOTE TOP)) (EQ U (QUOTE PRI))))) + (COND (Y (GO B)) 00014850 + ((EQ CURSYM* (QUOTE *COLON*)) (RETURN V)) 00014860 + ((EQCAR V (QUOTE SETQ)) (GO C)) 00014870 + ((OR (EQUAL *MODE (QUOTE SYMBOLIC)) 00014880 + (EQCAR V (QUOTE QUOTE)) 00014890 + (AND (NUMBERP V) (FIXP V))) 00014900 + (SETQ Y V)) 00014910 + ((EQCAR V (QUOTE EQUAL)) (GO C)) 00014920 + (T (SETQ Y (LIST (QUOTE AEVAL) (MKARG V))))) 00014930 + A (COND ((AND U (OR PRI* (EQ SEMIC* **SEMICOL))) + (SETQ Y (LIST (QUOTE VARPRI) X Y PRI*))) 00014950 + ((AND PRI* (EQ *MODE (QUOTE SYMBOLIC))) 00014960 + (SETQ Y (LIST (QUOTE PRINC) Y)))) 00014970 + (RETURN Y) 00014980 + B (SETQ Y (*APPLY Y NIL)) 00014990 + (SETQ U (AND U (MEMBER V (QUOTE (BEGIN FOR IF))))) 00015000 + (GO A) 00015010 + C (SETQ V (CDR V)) 00015020 + (COND ((NULL (CDDR V)) (GO D))) 00015030 + (SETQ X PRI*) 00015040 + (SETQ PRI* NIL) 00015050 + (SETQ Y (COMMAND1 (LIST (CONS (QUOTE SETQ) (CDR V))))) 00015060 + (SETQ PRI* X) 00015070 + (SETQ X NIL) 00015080 + D (COND ((EQ *MODE (QUOTE SYMBOLIC)) (GO E)) 00015090 + (U 00015100 + (SETQ X 00015110 + (CONS (QUOTE LIST) 00015120 + (MAPCAR 00015130 + (REVERSE (CDR (REVERSE V))) 00015140 + (FUNCTION MKARG*)))))) 00015150 + (COND ((NULL (CDDR V)) 00015160 + (SETQ Y (LIST (QUOTE AEVAL) (MKARG (CADR V)))))) 00015170 + (SETQ Y 00015180 + (COND 00015190 + ((AND (ATOM (CAR V)) (PROGVR (CAR V))) 00015200 + (LIST (QUOTE SETQ) (CAR V) Y)) 00015210 + (T (LIST (QUOTE SETK) (MKARG (CAR V)) Y)))) 00015220 + (GO A) 00015230 + E (COND ((NULL (CDDR V)) (SETQ Y (CADR V)))) 00015240 + (SETQ Y 00015250 + (COND 00015260 + ((ATOM (CAR V)) (LIST (QUOTE SETQ) (CAR V) Y)) 00015270 + ((GET* (CAAR V) (QUOTE **ARRAY)) 00015280 + (LIST (QUOTE SETEL) (CAR V) Y)) 00015282 + (T (PROCDEF1 (CAR V) Y)))) 00015284 + (GO A)))) 00015286 + 00015290 +(MKARG (LAMBDA (U) 00015300 + (COND ((NULL U) NIL) 00015310 + ((ATOM U) (COND ((PROGVR U) U) (T (LIST (QUOTE QUOTE) U)))) 00015320 + ((MEMBER (CAR U) (QUOTE (COND PROG QUOTE))) U) 00015330 + (T (CONS (QUOTE LIST) (MAPCAR U (FUNCTION MKARG))))))) 00015340 + 00015350 +(MKARG* (LAMBDA (U) 00015360 + (COND ((NULL U) NIL) 00015370 + ((ATOM U) (LIST (QUOTE QUOTE) U)) 00015420 + (T (CONS (QUOTE LIST) (MAPCAR U (FUNCTION MKARG))))))) 00015430 + 00015440 +(MKPROG (LAMBDA (U V) 00015480 + (CONS (QUOTE PROG) (CONS U V)))) 00015490 + 00015510 +(PROGVR (LAMBDA (VAR) 00015520 + (COND ((NOT (ATOM VAR)) NIL) 00015530 + ((NUMBERP VAR) T) 00015540 + (T 00015550 + ((LAMBDA (X) (COND (X (CAR X)) (T NIL))) 00015560 + (GET VAR (QUOTE DATATYPE))))))) 00015570 + 00015580 +)) 00015590 + 00015600 +DEFINE (( 00015610 + 00015620 +(LPRIM* (LAMBDA (U) 00015630 + (PROG (X Y) 00015640 + (COND ((AND OFL* (OR *FORT (NOT *NAT))) (GO C))) 00015650 + A (SETQ X *NAT) 00015660 + (SETQ *NAT NIL) 00015670 + (LPRI (CONS (QUOTE ***) U)) 00015680 + (TERPRI) 00015690 + (SETQ *NAT X) 00015700 + (COND ((NULL Y) (GO B))) 00015701 + (WRS Y) 00015702 + (RETURN NIL) 00015703 + B (COND ((NULL OFL*) (RETURN NIL))) 00015704 + C (SETQ Y OFL*) 00015705 + (WRS NIL) 00015706 + (GO A)))) 00015707 + 00015710 +(SYMPRI (LAMBDA (U) 00015720 + (PROG (X) 00015730 + (COND 00015740 + ((EQ U (QUOTE *SEMICOL*)) (PRINC* SEMIC*)) 00015750 + ((SETQ X (GET* U (QUOTE PRTCH))) (PRINC* (CAR X))) 00015760 + (T (GO B))) 00015770 + (RETURN (SETQ SYMFG* NIL)) 00015780 + B (COND (SYMFG* (SPACES* 1))) 00015790 + (PRINC* U) 00015800 + (SETQ SYMFG* T)))) 00015810 + 00015820 +(CURERR (LAMBDA (U V) 00015830 + (PROG (X) 00015840 + (SETQ ECHO* T) 00015850 + (TERPRI) 00015860 + (SETQ X CURSYM*) 00015870 + (COND ((NULL PLINE*) (GO B)) 00015880 + ((EQUAL V 1) 00015890 + (SETQ PLINE* 00015900 + (CONS (CAR PLINE*) 00015910 + (CONS 00015920 + (CONS (CONS (CAAADR PLINE*) -1) **EMARK) 00015930 + (CDR PLINE*))))) 00015940 + (T 00015950 + (SETQ PLINE* 00015960 + (CONS (CONS (CONS (CAAAR PLINE*) -1) **EMARK) 00015970 + PLINE*)))) 00015980 + (SETQ YMIN* -1) 00015990 + B (COMM1*) 00016000 + (COND ((NUMBERP V) (SETQ V NIL))) 00016010 + (COND ((AND (NULL U) (NULL V)) (GO A)) 00016020 + ((NULL V) (LPRIE U T)) 00016030 + (T (LPRIE 00016040 + (CONS X 00016050 + (CONS (QUOTE INVALID) 00016060 + (COND 00016070 + (U 00016080 + (LIST (QUOTE IN) 00016090 + U 00016100 + (QUOTE STATEMENT))) 00016110 + (T NIL)))) 00016120 + T))) 00016130 + A (ERROR*)))) 00016140 + 00016150 +(ERROR* (LAMBDA NIL 00016160 + (PROG2 (TERPRI*) (ERROR NIL)))) 00016170 + 00016180 +)) 00016190 + 00016200 +DEFINE (( 00016210 + 00016220 +(GREATEQ (LAMBDA (U V) 00016230 + (OR (EQUAL U V) (GREATERP U V)))) 00016240 + 00016250 +(LESSEQ (LAMBDA (U V) 00016260 + (OR (EQUAL U V) (LESSP U V)))) 00016270 + 00016280 +(UNEQ (LAMBDA (U V) 00016290 + (NOT (EQUAL U V)))) 00016300 + 00016310 +(REDMSG (LAMBDA (U V W) 00016320 + (COND ((NULL *MSG) T) 00016330 + ((AND *INT W) (REDMSG1 U V)) 00016340 + (T (NULL (LPRIM* (LIST U (QUOTE DECLARED) V))))))) 00016350 + 00016360 +(DELETE (LAMBDA (U V) 00016370 + (COND ((NULL V) NIL) 00016380 + ((EQUAL U (CAR V)) (CDR V)) 00016390 + (T (CONS (CAR V) (DELETE U (CDR V))))))) 00016400 + 00016410 +(SETDIFF (LAMBDA (U V) 00016420 + (COND ((NULL V) U) (T (SETDIFF (DELETE (CAR V) U) (CDR V)))))) 00016430 + 00016440 +(XN (LAMBDA (U V) 00016450 + (COND ((NULL U) NIL) 00016460 + ((MEMBER (CAR U) V) 00016470 + (CONS (CAR U) (XN (CDR U) (DELETE (CAR U) V)))) 00016480 + (T (XN (CDR U) V))))) 00016490 + 00016500 +)) 00016510 + 00016520 +DEFINE (( 00016530 + 00016540 +(PROCDEF (LAMBDA NIL 00016550 + (PROG (X Y) 00016560 + (COND ((ATOM (SETQ X (MREAD* NIL))) (SETQ X (LIST X)))) 00016570 + (SCAN) 00016580 + (SETQ Y (FLAGTYPE (CDR X) (QUOTE SCALAR))) 00016581 + (SETQ X (PROCDEF1 X (COMMAND1 NIL))) 00016582 + (REMTYPE Y) 00016583 + (RETURN X)))) 00016584 + 00016600 +(PROCDEF1 (LAMBDA (U BODY) 00016602 + (PROG (NAME VARLIS) 00016604 + (SETQ NAME (CAR U)) 00016610 + (COND 00016620 + ((OR (NULL NAME) (NOT (ATOM NAME)) (NUMBERP NAME)) 00016630 + (CURERR NAME NIL)) 00016640 + ((NOT (GETD NAME)) (FLAG (LIST NAME) (QUOTE FNC)))) 00016650 + (COND ((EQCAR BODY (QUOTE PROG)) (SETQ VARLIS (CADR BODY)))) 00016660 + (COND (VARLIS (RPLACA (CDR BODY) (SETDIFF VARLIS (CDR U))))) 00016680 + (SETQ VARLIS (CDR U)) 00016690 + (AND (NOT (FLAGP NAME (QUOTE FNC))) 00016710 + (LPRIM* (LIST NAME (QUOTE REDEFINED)))) 00016720 + (DEF* NAME VARLIS BODY DEFN*) 00016730 + (REMFLAG (LIST NAME) (QUOTE FNC)) + (RETURN (LIST (QUOTE QUOTE) NAME))))) 00016760 + 00016780 +(FLAGTYPE (LAMBDA (U V) 00016790 + (PROG (X Y Z) 00016800 + A (COND ((NULL U) (RETURN (REVERSE Z)))) 00016810 + (SETQ X (CAR U)) 00016820 + (COND ((GET X (QUOTE SIMPFN)) 00016830 + (REDERR (APPEND (QUOTE (TYPE CONFLICT FOR)) (LIST X))))) 00016830 + (SETQ Y (GET X (QUOTE DATATYPE))) 00016840 + (PUT X (QUOTE DATATYPE) (CONS V Y)) 00016910 + (SETQ Z (CONS X Z)) 00016920 + C (SETQ U (CDR U)) 00016930 + (GO A)))) 00016940 + 00016970 +(REMTYPE (LAMBDA (VARLIS) 00016980 + (PROG (X Y) 00016990 + A (COND ((NULL VARLIS) (RETURN NIL))) 00017000 + (SETQ X (CAR VARLIS)) 00017010 + (SETQ Y (CDR (GET X (QUOTE DATATYPE)))) 00017020 + (COND (Y (PUT X (QUOTE DATATYPE) Y)) 00017060 + (T (REMPROP X (QUOTE DATATYPE)))) 00017070 + (SETQ VARLIS (CDR VARLIS)) 00017080 + (GO A)))) 00017090 + 00017100 +(NEWVAR (LAMBDA (U) 00017110 + (COMPRESS (CONS **FMARK (EXPLODE U))))) 00017120 + 00017130 +(DEF* (LAMBDA (NAME VARLIS BODY FN) 00017140 + (*APPLY FN 00017150 + (LIST 00017160 + (LIST (LIST NAME (LIST (QUOTE LAMBDA) VARLIS BODY))))))) 00017170 + 00017180 +)) 00017190 + 00017200 +DEFINE (( 00017210 + 00017220 +(PROCBLOCK (LAMBDA NIL 00017230 + (PROG (X HOLD VARLIS) 00017240 + (SCAN) 00017250 + (COND ((MEMBER CURSYM* (QUOTE (NIL *RPAR*))) (ERROR **ESC))) 00017260 + (SETQ VARLIS (DECL T)) 00017270 + A (COND ((EQ CURSYM* (QUOTE END)) (GO B))) 00017280 + (SETQ X (COMMAND1 NIL)) 00017290 + (COND ((EQCAR X (QUOTE END)) (GO C))) 00017300 + (AND (NOT (EQ CURSYM* (QUOTE END))) (SCAN)) 00017310 + (COND (X (SETQ HOLD (ACONC HOLD X)))) 00017320 + (GO A) 00017330 + B (COMM1 (QUOTE END)) 00017340 + C (REMTYPE VARLIS) 00017350 + (COND ((NOT (EQ *MODE (QUOTE SYMBOLIC))) 00017351 + (SETQ HOLD (ACONC HOLD (QUOTE (RETURN 0)))))) 00017352 + (RETURN (MKPROG VARLIS HOLD))))) 00017360 + 00017380 +(DECL* (LAMBDA NIL 00017390 + (MAP (DECL NIL) (FUNCTION (LAMBDA (J) 00017400 + (PUT (CAR J) (QUOTE SPECIAL) (LIST NIL))))))) 00017400 + 00017410 +(DECL (LAMBDA (U) 00017420 + (PROG (V W VARLIS) 00017430 + A (COND 00017440 + ((NOT (MEMBER CURSYM* (QUOTE (REAL INTEGER SCALAR)))) 00017450 + (RETURN VARLIS))) 00017460 + (SETQ W CURSYM*) 00017470 + (COND ((EQ (SCAN) (QUOTE PROCEDURE)) (RETURN (ALGFN)))) 00017480 + (SETQ V (FLAGTYPE (REMCOMMA (MREAD NIL)) W)) 00017490 + (SETQ VARLIS (APPEND V VARLIS)) 00017500 + (AND (NOT (EQ CURSYM* (QUOTE *SEMICOL*))) (CURERR NIL T)) 00017510 + (AND U (SCAN)) 00017520 + (GO A)))) 00017530 + 00017540 +(GOFN (LAMBDA NIL 00017550 + (PROG (VAR) 00017560 + (SETQ VAR 00017570 + (COND ((EQ (SCAN) (QUOTE TO)) (SCAN)) (T CURSYM*))) 00017580 + (SCAN) 00017590 + (RETURN (LIST (QUOTE GO) VAR))))) 00017600 + 00017610 +(RETFN (LAMBDA NIL 00017620 + (LIST (QUOTE RETURN) 00017630 + (COND ((FLAGP** (SCAN) (QUOTE DELIM)) NIL) 00017635 + (T (COMMAND1 NIL)))))) 00017640 + 00017650 +(ENDFN (LAMBDA NIL 00017660 + (PROG2 (COMM1 (QUOTE END)) (QUOTE (END))))) 00017670 + 00017680 +)) 00017690 + 00017700 +DEFINE (( 00017710 + 00017720 +(FORSTAT (LAMBDA NIL 00017730 + (COND ((EQ (SCAN) (QUOTE ALL)) (FORALLFN*)) (T (FORLOOP))))) 00017740 + 00017750 +(FORLOOP (LAMBDA NIL 00017760 + (PROG (CURS EXP INCR INDX CONDLIST BODY FLG FNC LAB1 LAB2) 00017770 + (SETQ FNC (GENSYM)) 00017780 + (SETQ EXP (MREAD T)) 00017790 + (COND 00017800 + ((AND (EQ (CAR EXP) (QUOTE *COMMA*)) 00017810 + (EQCAR (CADR EXP) (QUOTE SETQ))) 00017820 + (SETQ EXP 00017830 + (LIST NIL 00017840 + (CADADR EXP) 00017850 + (CONS (QUOTE *COMMA*) 00017860 + (NCONC (CDDADR EXP) (CDDR EXP)))))) 00017870 + ((NOT (MEMBER (CAR EXP) (QUOTE (SETQ EQUAL)))) (GO ERR))) 00017880 + (SETQ EXP (CDR EXP)) 00017890 + (COND 00017900 + ((OR (NOT (ATOM (SETQ INDX (CAR EXP)))) (NUMBERP INDX)) 00017910 + (GO ERR))) 00017920 + (SETQ INDX (CAR (FLAGTYPE (LIST INDX) (QUOTE INTEGER)))) 00017920 + A (SETQ EXP (REMCOMMA (CADR EXP))) 00017930 + A1 (COND ((NULL EXP) (GO B2)) 00017940 + ((CDR EXP) (SETQ FLG T)) 00017950 + ((EQ CURSYM* (QUOTE STEP)) (GO B1)) 00017960 + ((EQ CURSYM* (QUOTE *COLON*)) (GO BB))) 00017970 + (SETQ CONDLIST 00017980 + (NCONC CONDLIST 00017990 + (LIST (LIST (QUOTE SETQ) INDX (MKEX (CAR EXP))) 00018000 + (LIST FNC)))) 00018010 + B0 (SETQ EXP (CDR EXP)) 00018020 + (GO A1) 00018030 + B1 (SETQ INCR (MKEX (MREAD* NIL))) 00018040 + (COND 00018050 + ((NOT (MEMBER (SETQ CURS CURSYM*) (QUOTE (UNTIL WHILE)))) 00018060 + (GO ERR))) 00018070 + AA (SETQ LAB1 (GENSYM)) 00018080 + (SETQ LAB2 (GENSYM)) 00018090 + (SETQ CONDLIST 00018100 + (ACONC CONDLIST(LIST (QUOTE SETQ) INDX (MKEX (CAR EXP))))) 00018110 + (SETQ EXP (REMCOMMA (MREAD* NIL))) 00018120 + (SETQ BODY (MKEX (CAR EXP))) 00018130 + (SETQ CONDLIST 00018140 + (NCONC CONDLIST 00018150 + (LIST LAB1 00018160 + (LIST (QUOTE COND) 00018170 + (LIST 00018180 + (COND 00018190 + ((EQ CURS (QUOTE UNTIL)) 00018200 + (COND 00018210 + ((NUMBERP INCR) 00018220 + (LIST 00018230 + (COND 00018240 + ((MINUSP INCR) 00018250 + (QUOTE LESSP)) 00018260 + (T (QUOTE GREATERP))) 00018270 + INDX 00018280 + BODY)) 00018290 + (T 00018300 + (LIST 00018310 + (QUOTE MINUSP) 00018320 + (LIST 00018330 + (QUOTE TIMES) 00018340 + (LIST 00018350 + (QUOTE DIFFERENCE) 00018360 + BODY 00018370 + INDX) 00018380 + INCR))))) 00018390 + (T (LIST (QUOTE NOT) BODY))) 00018400 + (LIST (QUOTE GO) LAB2))) 00018410 + (LIST FNC) 00018420 + (LIST (QUOTE SETQ) 00018430 + INDX 00018440 + (LIST (QUOTE PLUS) INDX INCR)) 00018450 + (LIST (QUOTE GO) LAB1) 00018460 + LAB2))) 00018470 + (AND (CDR EXP) (SETQ FLG T)) 00018480 + (GO B0) 00018490 + BB (SETQ INCR 1) 00018500 + (SETQ CURS (QUOTE UNTIL)) 00018510 + (GO AA) 00018520 + B2 (COND ((NULL CONDLIST) (GO ERR)) 00018530 + ((MEMBER CURSYM* (QUOTE (SUM PRODUCT))) (GO C)) 00018540 + ((NOT (EQ CURSYM* (QUOTE DO))) (GO ERR))) 00018550 + (SCAN) 00018560 + (SETQ BODY (COMMAND1 NIL)) 00018570 + B (COND (FLG (DEF* FNC NIL BODY (QUOTE DEFINE))) 00018590 + (T (SETQ CONDLIST (ADFORM BODY (LIST FNC) CONDLIST)))) 00018600 + (REMTYPE (LIST INDX)) 00018602 + (RETURN (MKPROG (CONS INDX EXP) (ACONC CONDLIST 00018610 + (QUOTE (RETURN NIL))))) 00018612 + C (SETQ CURS CURSYM*) 00018620 + (SETQ EXP (GENSYM)) 00018630 + (SETQ BODY 00018640 + (LIST (QUOTE SETQ) 00018650 + EXP 00018660 + (LIST 00018670 + (COND 00018680 + ((EQ CURS (QUOTE SUM)) (QUOTE ADDSQ)) 00018690 + (T (QUOTE MULTSQ))) 00018700 + (LIST (QUOTE AEVAL1) (MKARG (MREAD* T))) 00018710 + EXP))) 00018720 + (SETQ CONDLIST 00018730 + (CONS (LIST (QUOTE SETQ) 00018740 + EXP 00018750 + (LIST (QUOTE CONS) 00018760 + (COND 00018770 + ((EQ CURS (QUOTE SUM)) NIL) 00018780 + (T 1)) 00018790 + 1)) 00018800 + (ACONC CONDLIST 00018810 + (LIST (QUOTE RETURN) 00018820 + (LIST (QUOTE MK*SQ) 00018830 + (LIST (QUOTE SUBS2) EXP)))))) 00018840 + (SETQ EXP (LIST EXP)) 00018840 + (GO B) 00018850 + ERR (CURERR (QUOTE FOR) T)))) 00018900 + 00018910 +(ADFORM (LAMBDA (U V W) 00018920 + (COND ((NULL W) NIL) 00018930 + ((EQUAL V (CAR W)) 00018940 + ((LAMBDA(X) 00018950 + (COND (X (APPEND X (CDR W))) (T (CONS U (CDR W))))) 00018960 + (PROGCHK U))) 00018970 + (T (CONS (CAR W) (ADFORM U V (CDR W))))))) 00018980 + 00018990 +(PROGCHK (LAMBDA (U) 00019000 + (PROG (X) 00019010 + (COND 00019020 + ((OR (NOT (EQCAR U (QUOTE PROG))) (CADR U)) (RETURN NIL))) 00019030 + (SETQ U (CDR U)) 00019040 + A (SETQ U (CDR U)) 00019050 + (COND ((NULL U) (RETURN (REVERSE X))) 00019060 + ((ATOM (CAR U)) (GO B)) 00019070 + ((EQCAR (CAR U) (QUOTE RETURN)) (GO RET)) 00019080 + ((EQCAR (CAR U) (QUOTE PROG)) (GO B)) 00019090 + ((MEMBER (QUOTE RETURN) (FLATTEN (CAR U))) 00019100 + (RETURN NIL))) 00019110 + B (SETQ X (CONS (CAR U) X)) 00019120 + (GO A) 00019130 + RET (COND ((CDR U) (RETURN NIL)) 00019135 + ((NOT (ATOM (CADAR U))) (SETQ X (CONS (CADAR U) X)))) 00019140 + (GO A)))) 00019145 + 00019150 +(FLATTEN (LAMBDA (U) 00019160 + (COND ((NULL U) NIL) 00019170 + ((ATOM U) (LIST U)) 00019180 + ((ATOM (CAR U)) (CONS (CAR U) (FLATTEN (CDR U)))) 00019190 + (T (NCONC (FLATTEN (CAR U)) (FLATTEN (CDR U))))))) 00019200 + 00019210 +)) 00019220 + 00019230 +DEFINE (( 00019240 + 00019250 +(IFSTAT (LAMBDA NIL 00019260 + (PROG (CONDX CONDIT) 00019270 + (FLAG (QUOTE (CLEAR LET MATCH)) (QUOTE DELIM)) 00019280 + A (SETQ CONDX (MREAD* T)) 00019290 + (REMFLAG (QUOTE (CLEAR LET MATCH)) (QUOTE DELIM)) 00019300 + (COND ((NOT (EQ CURSYM* (QUOTE THEN))) (GO C))) 00019330 + (SCAN) 00019340 + (SETQ CONDIT(ACONC CONDIT (LIST (MKEX CONDX) (COMMAND1 NIL)))) 00019350 + (COND ((NOT (EQ CURSYM* (QUOTE ELSE))) (GO B)) 00019360 + ((EQ (SCAN) (QUOTE IF)) (GO A)) 00019370 + (T 00019380 + (SETQ CONDIT 00019390 + (ACONC CONDIT 00019400 + (LIST T (COMMAND1 (QUOTE IF))))))) 00019410 + B (RETURN (CONS (QUOTE COND) CONDIT)) 00019420 + C (COND 00019430 + ((NOT (MEMBER CURSYM* (QUOTE (CLEAR LET MATCH)))) 00019440 + (CURERR (QUOTE IF) T))) 00019450 + (SETQ MCOND* (MKEX CONDX)) 00019460 + (RETURN (FORALLFN (GVARB CONDX)))))) 00019470 + 00019480 +(MKEX (LAMBDA (U) 00019490 + (COND ((EQ *MODE (QUOTE SYMBOLIC)) U) (T (APROC U))))) 00019500 + 00019510 +(APROC (LAMBDA (U) 00019520 + (COND ((NULL U) NIL) 00019530 + ((ATOM U) 00019540 + (COND ((AND (NUMBERP U) (FIXP U)) U) 00019550 + (T (LIST (QUOTE REVAL) (MKARG U))))) 00019560 + ((MEMBER (CAR U) (QUOTE (COND PROG))) U) 00019570 + ((MEMBER (CAR U) (QUOTE (EQUAL UNEQ))) 00019580 + (LIST (CAR U) 00019590 + (LIST (QUOTE REVAL) 00019600 + (MKARG 00019610 + (LIST (QUOTE PLUS) 00019620 + (CADR U) 00019630 + (LIST (QUOTE MINUS) (CARX (CDDR U)))))) 00019640 + 0)) 00019650 + (T (CONS (CAR U) (MAPCAR (CDR U) (FUNCTION APROC))))))) 00019660 + 00019670 +(ARB (LAMBDA (U) 00019680 + T)) 00019690 + 00019700 +(GVARB (LAMBDA (U) 00019710 + (COND ((ATOM U) (COND ((NUMBERP U) NIL) (T (LIST U)))) 00019720 + ((EQ (CAR U) (QUOTE QUOTE)) NIL) 00019730 + (T 00019740 + (MAPCON (CDR U) (FUNCTION (LAMBDA (J) (GVARB (CAR J))))))))) 00019750 + 00019760 +)) 00019770 + 00019780 +FLAG ((THEN ELSE END STEP DO SUM PRODUCT UNTIL WHILE) DELIM) 00019790 + 00019800 +DEFINE (( 00019810 + 00019820 +(ALGFN (LAMBDA NIL 00019830 + (ALGFN* (QUOTE ALGEBRAIC)))) 00019840 + 00019850 +(LSPFN (LAMBDA NIL 00019860 + (ALGFN* (QUOTE SYMBOLIC)))) 00019870 + 00019880 +(ALGFN* (LAMBDA (U) 00019890 + (PROG (X) 00019900 + (COND ((EQ CURSYM* (QUOTE PROCEDURE)) (GO A)) 00019910 + ((EQ CURSYM* (QUOTE MACRO)) (SETQ DEFN* CURSYM*)) 00019920 + ((EQ CURSYM* (QUOTE FEXPR)) 00019930 + (SETQ DEFN* (QUOTE DEFEXPR)))) 00019940 + (COND 00019950 + ((FLAGP** (SCAN) (QUOTE DELIM)) (GO B))) 00019960 + A (SETQ TMODE* *MODE) 00019970 + (SETQ *MODE U) 00019980 + (COND 00019990 + ((NOT (EQ CURSYM* (QUOTE PROCEDURE))) 00020000 + (RETURN (COMMAND1 (QUOTE PRI))))) + (SETQ X (PROCDEF)) 00020020 + (COND 00020030 + ((NOT (EQ U (QUOTE SYMBOLIC)))(FLAG (CDR X)(QUOTE OPFN)))) 00020035 + (RETURN (CONS (QUOTE QUOTE) (CDR X))) 00020040 + B (SETQ *MODE U)))) 00020050 + 00020060 +(RLIS (LAMBDA NIL 00020070 + (RLIS* T))) 00020080 + 00020090 +(NORLIS (LAMBDA NIL 00020100 + (RLIS* NIL))) 00020110 + 00020120 +(RLIS* (LAMBDA (U) 00020130 + (PROG (X Y) 00020140 + (SETQ X CURSYM*) 00020150 + (COND ((FLAGP** (SCAN) (QUOTE DELIM)) (GO A))) 00020160 + (SETQ Y (REMCOMMA (MREAD NIL))) 00020170 + (COND (U (SETQ Y (LIST Y)))) 00020180 + A (RETURN (CONS X (MAPCAR Y (FUNCTION MKARG))))))) 00020190 + 00020200 +)) 00020210 + 00020220 +DEFINE (( 00020230 + 00020240 +(COMM1* (LAMBDA NIL 00020250 + (COMM1 T))) 00020260 + 00020270 +(COMM1 (LAMBDA (U) 00020280 + (PROG (X Y Z) + (SETQ X ECHO*) + (COND 00020310 + ((AND (EQ U (QUOTE END)) 00020320 + (MEMBER (SCAN) (QUOTE (ELSE END UNTIL *RPAR*)))) 00020330 + (GO RET1))) 00020340 + (COND (U (GO LOOP)) (X (PRINC* CRCHAR*))) 00020350 + (SETQ Y (LIST CRCHAR*)) 00020360 + (GO A) 00020370 + LOOP (COND ((EQ CRCHAR* **EOF) (GO RET)) + ((NULL U) (GO L1)) + ((EQ CURSYM* (QUOTE *SEMICOL*)) (GO RET1)) 00020390 + ((OR (EQ CRCHAR* **SEMICOL) 00020400 + (EQ CRCHAR* **DOLLAR) 00020410 + (EQ CRCHAR* **ESC)) 00020420 + (GO RET))) 00020430 + L1 (COND ((NULL X) (GO L3))) + (COND ((NULL U) (PRINC* CRCHAR*)) + ((BREAKP CRCHAR*) (GO L2)) + (T (PROG2 (RLIT CRCHAR*) (SETQ Z T)))) + L3 + (COND 00020450 + ((OR (NULL U) (EQ U (QUOTE END))) 00020460 + (SETQ Y (CONS CRCHAR* Y)))) 00020470 + (COND 00020480 + ((AND (EQ U (QUOTE END)) 00020490 + (EQ CRCHAR* (QUOTE D)) 00020500 + (EQCAR (CDR Y) (QUOTE N)) 00020510 + (EQCAR (CDDR Y) (QUOTE E)) 00020520 + (SETQ CRCHAR* **BLANK) 00020530 + (SETQ CURSYM* (QUOTE END))) 00020540 + (GO RET1)) 00020550 + ((AND (NULL U) (EQ CRCHAR* **SMARK)) (GO RETS))) 00020560 + A (SETQ CRCHAR* (READCH*)) 00020570 + (GO LOOP) 00020580 + L2 (COND (Z (PRINC* (MKATOM)))) + (SETQ Z NIL) + (PRINC* CRCHAR*) + (COND ((NOT (EQ CRCHAR* **BLANK)) (GO L3)) + ((EQ U (QUOTE END)) (SETQ Y NIL))) + L4 (COND ((EQ (READCH*) **BLANK) (GO L4))) + (GO LOOP) + RET (COND ((AND X Z) (PROG2 (PRINC* (MKATOM)) (SETQ Z NIL)))) + (SCAN) + RET1 (COND ((AND X Z) (PRINC* (MKATOM)))) + (RETURN (COND (X (TERPRI*)) (T NIL))) + RETS (SETQ CURSYM* (MKSTRING (REVERSE Y))) 00020610 + (READCH*) 00020620 + (RETURN CURSYM*)))) 00020630 + 00020640 +(QOTPRI (LAMBDA (U) 00020650 + (PROG2 (PRINC* **QMARK) (PRIN0* (CAR U))))) 00020660 + 00020670 +(PRIN0* (LAMBDA (U) 00020680 + (PROG NIL 00020690 + (COND ((ATOM U) (RETURN (PRINC* U)))) 00020700 + (PRINC* **LPAR) 00020710 + A (COND ((NULL U) (GO B)) ((ATOM U) (GO C))) 00020720 + (PRIN0* (CAR U)) 00020730 + (COND ((CDR U) (PRINC* **BLANK))) 00020740 + (SETQ U (CDR U)) 00020750 + (GO A) 00020760 + B (RETURN (PRINC* **RPAR)) 00020770 + C (PRINC* **DOT) 00020780 + (PRINC* **BLANK) 00020790 + (PRINC* U) 00020800 + (GO B)))) 00020810 + 00020820 +)) 00020830 + 00020840 +DEFLIST (((QUOTE QOTPRI)) SPECPRN) 00020850 + 00020860 +DEFINE (( 00020870 + 00020880 +(LMDEF (LAMBDA NIL 00020890 + (PROG (X) 00020900 + (COND 00020910 + ((NOT (EQ *MODE (QUOTE SYMBOLIC))) 00020920 + (CURERR (QUOTE ALGEBRAIC) T))) 00020930 + (SETQ CURSYM* (QUOTE *COMMA*)) 00020940 + (SETQ X (MREAD NIL)) 00020950 + (RETURN (LIST (QUOTE LAMBDA) (CDR X) (COMMAND1 NIL)))))) 00020960 + 00020970 +(WRITEFN (LAMBDA NIL 00020980 + (PROG (X Y Z) 00020990 + (SETQ X (MREAD* NIL)) 00021000 + (SETQ PRI* T) 00021010 + (SETQ X 00021020 + (COND 00021030 + ((EQCAR X (QUOTE *COMMA*)) (CDR X)) 00021040 + (T (LIST X)))) 00021050 + A (COND ((NULL X) (GO B))) 00021060 + (SETQ Z (COMMAND1 (LIST (CAR X)))) 00021065 + (COND ((NULL (CDR X)) (SETQ Z (LIST (QUOTE RETURN) Z)))) 00021070 + (SETQ Y (ACONC Y Z)) 00021075 + (SETQ X (CDR X)) 00021080 + (GO A) 00021090 + B (SETQ PRI* NIL) 00021100 + (RETURN (MKPROG NIL (CONS (QUOTE (TERPRI*)) Y)))))) 00021110 + 00021120 +)) 00021130 + 00021140 +DEFINE (( 00021150 + 00021160 +(ON1 (LAMBDA (U V) 00021170 + (PROG (X) 00021180 + A (COND ((NULL U) (RETURN NIL))) 00021190 + (PTS (COMPRESS (APPEND (EXPLODE **STAR) (EXPLODE (CAR U)))) 00021200 + V) 00021210 + (COND 00021220 + ((SETQ X (ASSOC V (GET* (CAR U) (QUOTE SIMPFG)))) 00021230 + (*APPLY (CONVRT (CDR X) T) NIL))) + (SETQ U (CDR U)) 00021250 + (GO A)))) 00021260 + 00021270 +(ON (LAMBDA (U) 00021280 + (ON1 U T))) 00021290 + 00021300 +(OFF (LAMBDA (U) 00021310 + (ON1 U NIL))) 00021320 + 00021330 +)) 00021340 + 00021350 +DEFINE (( 00021360 + 00021370 +(AARRAY (LAMBDA (U) 00021380 + (PROG (X Y) 00021390 + A (COND ((NULL U) (RETURN NIL))) 00021400 + (SETQ X (CAR U)) 00021410 + (COND 00021420 + ((OR (NUMBERP (CAR X)) 00021430 + (NOT (ATOM (CAR X))) 00021440 + (GET (CAR X) (QUOTE SIMPFN)) 00021460 + (GET (CAR X) (QUOTE APROP))) 00021465 + (REDERR (APPEND (QUOTE (TYPE CONFLICT FOR)) 00021470 + (LIST (CAR X))))) 00021475 + ((NOT (NUMLIS (SETQ Y (MAPCAR (CDR X) 00021480 + (FUNCTION REVAL))))) (PROG2 (ERRPRI2 X) (ERROR*)))) + (PUT (CAR X) (QUOTE **ARRAY) Y) 00021490 + (*ARRAY 00021495 + (LIST (CONS (CAR X) (MAPCAR Y (FUNCTION ADD1))))) 00021500 + B (SETQ U (CDR U)) 00021520 + (GO A)))) 00021530 + 00021560 +(NUMLIS (LAMBDA (U) 00021570 + (OR (NULL U) (AND (NUMBERP (CAR U)) (NUMLIS (CDR U)))))) 00021580 + 00021590 +)) 00021600 + 00021610 +DEFLIST (((AARRAY RLIS)) STAT) 00021620 + 00021630 +(LAMBDA NIL (PUT (QUOTE ARRAY) (QUOTE NEWNAME) (QUOTE AARRAY))) NIL 00021640 + 00021650 +DEFINE (( 00021660 + 00021670 +(BEGIN1 (LAMBDA (U) + (PROG (RESULT) 00021690 + (SETQ CURSYM* NIL) 00021700 + A (TERPRI) 00021710 + (COND ((AND TMODE* (SETQ *MODE TMODE*)) (SETQ TMODE* NIL))) 00021720 + (SETQ ECHO* (AND *ECHO (NOT (AND OFL* (OR *FORT (NULL *NAT)))))) + (SETQ ERFG* NIL) 00021740 + (COND ((EQ CURSYM* (QUOTE END)) (GO ND0))) 00021750 + (SETQ CRCHAR* **BLANK) 00021760 + (SETQ DEFN* (QUOTE DEFINE)) 00021770 + (OVOFF) 00021771 + (SETQ PROGRAM* (ERRORSET (QUOTE (COMMAND)) T)) 00021780 + (COND ((OR (ATOM PROGRAM*) (CDR PROGRAM*)) (GO ERR1))) 00021790 + (SETQ PROGRAM* (CAR PROGRAM*)) 00021800 + (COND 00021810 + ((EQ (CAR PROGRAM*) (QUOTE RETRY)) 00021820 + (SETQ PROGRAM* PROGRAML*)) 00021830 + ((EQCAR PROGRAM* (QUOTE *COMMA*)) (GO ER)) 00021835 + ((EQ (CAR PROGRAM*) (QUOTE END)) (GO ND1)) 00021840 + ((EQ (CAR PROGRAM*) (QUOTE CONT)) (GO C)) + (DIAG* (GO D))) 00021850 + B (TERPRI*) + (SETQ ECHO* (QUOTE RESULT)) 00021860 + (SETP) 00021870 + (OVON) 00021871 + (SETQ RESULT 00021880 + (ERRORSET (CONVRT (GTS (QUOTE PROGRAM*)) T) T)) + (COND ((OR (ATOM RESULT) (CDR RESULT)) (GO ERR2)) 00021900 + ((EQ *MODE (QUOTE SYMBOLIC)) (AND (EQ SEMIC* **SEMICOL) 00021910 + (PROG2 (PRINT (CAR RESULT)) (TERPRI)))) 00021920 + ((CAR RESULT) (SETQ *ANS (CAR RESULT)))) 00021930 + (SETQ ORIG* 0) 00021940 + (CLOSELINE) 00021950 + (COND ((NULL (OR *INT OFL* *FORT)) (PRINTTY **STAR))) + (GO A) 00021970 + C (COND ((NOT U) (GO A))) + (COND (IFL* (GO ND1))) + (SETQ IFL* (COND (IPL* (CAR IPL*)) (T NIL))) + (RDS IFL*) + (TERPRI*) + (RETURN NIL) + D (COND ((OR (ATOM PROGRAM*)(EQ (CAR PROGRAM*) (QUOTE QUOTE))) 00021972 + (GO A)) 00021974 + ((FLAGP (CAR PROGRAM*) (QUOTE IGNORE)) (GO B))) 00021975 + (PRINT (CONVRT PROGRAM* NIL)) 00021978 + (GO A) 00021979 + ND0 (COMM1 (QUOTE END)) 00021980 + ND1 00022000 + (RETURN (FINF U)) + ERR1 (COND ((OR (EQ PROGRAM* **ESC) (EQ PROGRAM* **EOF)) (GO A))) 00022020 + (GO ERR3) 00022030 + ER (LPRIE (COND ((NOT (ATOM (CADR PROGRAM*))) 00022032 + (LIST (CAADR PROGRAM*) (QUOTE UNDEFINED))) 00022034 + (T (QUOTE (SYNTAX ERROR)))) T) 00022036 + (GO ERR3) 00022038 + ERR2 (SETQ PROGRAML* PROGRAM*) 00022040 + (SETP) + ERR3 (COND 00022050 + ((NULL ERFG*) 00022060 + (LPRIE (QUOTE (COMMAND TERMINATED *****)) T))) + (SETQ ORIG* 0) 00022080 + (TERPRI*) 00022090 + (COND (IFL* (PAUSE))) + (GO A)))) 00022110 + 00022120 +(FINF (LAMBDA (U) + (PROG NIL 00022140 + (COND (U (GO A))) + (MAPCAR (APPEND IPL* OPL*) (FUNCTION CLOSE)) 00022160 + (SETQ IFL* NIL) + (SETQ IPL* NIL) 00022170 + (SETQ OPL* NIL) 00022180 + (SETQ OFL* NIL) 00022190 + (LPRIW NIL T **ENDMSG) 00022200 + (RETURN (QUOTE ***)) 00022210 + A (COND ((NOT IFL*) (RETURN NIL))) + (SHUT (LIST IFL*)) + (LPRIM* NIL)))) 00022260 + 00022270 +)) 00022280 + 00022290 +DEFLIST (((FOR FORSTAT) (FORALL FORALLFN*) (IF IFSTAT) (BEGIN PROCBLOCK 00022300 +) (IN RLIS) (OUT RLIS) (SHUT RLIS) (GO GOFN) (GOTO GOFN) (RETURN RETFN 00022310 + ) (INTEGER DECL*) (SCALAR DECL*) (WRITE WRITEFN) ( 00022320 +REAL DECL*) (LISP LSPFN) (ALGEBRAIC ALGFN) (RETRY NORLIS) (PROCEDURE 00022330 + ALGFN)(MACRO LSPFN)(FEXPR LSPFN) (SYMBOLIC LSPFN) (ON RLIS) (OFF RLIS 00022340 +) (END ENDFN) (COMMENT COMM1*) (INFIX INFIXFN) (PRECEDENCE PRECEDFN)) 00022350 +STAT) 00022360 + 00022370 +DEFLIST (((BEGIN PROCBLOCK) (FOR FORSTAT) (IF IFSTAT) (LAMBDA LMDEF)) 00022380 +ISTAT) 00022390 + 00022400 +(LAMBDA (U) (MAP U (FUNCTION (LAMBDA (J) (PTS (CAR J) NIL))))) ((*GCD 00022410 +*EXP *MCD *FLOAT MATCH* *DIV *RAT *SUPER MCOND* *ALLFAC *NCMP SUBFG* 00022420 +FRLIS1* FRLIS* GAMIDEN* SUB2* RPLIS* SUBL* DSUBL* FACTORS* FRASC* VREP* 00022430 + INDICES* WTP* SNO* PNO* *RAT *OUTP MCHFG* *ANS *RESUBS *NERO EXLIST* 00022440 +ORDN* *XDN SV* DNL* UPL* EXPTL*)) 00022450 + 00022460 +(LAMBDA (U) (MAP U (FUNCTION (LAMBDA (J) (PTS (CAAR J) (CADAR J)))))) 00022470 +(((*EXP T) (*MSG T) (*ALLFAC T) (*MCD T) (SUBFG* T) (EXLIST* ((*))) 00022480 + (*RESUBS T) (ORDN* 0) (*ANS 0) (SNO* 500) (*XDN T))) 00022490 + 00022500 +DEFLIST (((EXP ((NIL . RMSUBS1) (T . RMSUBS))) (MCD ((NIL . RMSUBS1) ( 00022510 +T . RMSUBS))) (FORT ((NIL LAMBDA NIL (SETQ *NAT NAT**)) (T LAMBDA NIL 00022520 +(PROG2 (SETQ NAT** *NAT) (SETQ *NAT NIL))))) (GCD ((T . RMSUBS))) 00022530 + (FLOAT ((T . RMSUBS)))) SIMPFG) 00022540 + 00022550 +DEFLIST (((ANTISYMMETRIC RLIS)(CLEAR RLIS)(DENOM NORLIS) (FACTOR RLIS) 00022560 + (LET RLIS) (MATCH RLIS) (MKCOEFF NORLIS) (ND NORLIS) (NUMER NORLIS) 00022570 + (MTS NORLIS) + (OPERATOR RLIS) (ORDER RLIS) (REMFAC RLIS) (SAVEAS NORLIS) (SYMMETRIC 00022580 + RLIS) (TERMS NORLIS) (WEIGHT RLIS)) STAT) 00022590 + 00022600 +DEFLIST (((PLUS SIMPPLUS) (MINUS SIMPMINUS) (EXPT SIMPEXPT) (SUB 00022610 +SIMPSUBS)(DF SIMPDF)(RECIP SIMPRECIP)(QUOTIENT SIMPQUOT) (*SQ SIMP*SQ) 00022620 + (TIMES SIMPTIMES)) SIMPFN) 00022630 + 00022640 +DEFLIST (((*ANS (SCALAR)) (*MODE (SCALAR))) DATATYPE) 00022650 + 00022660 +DEFLIST (((I (I NIL (REP (MINUS 1) 2 NIL)))) APROP) 00022670 + 00022680 +DEFINE (( 00022690 + 00022700 +(ABS (LAMBDA (N) 00022710 + (COND ((MINUSP N) (MINUS N)) (T N)))) 00022720 + 00022730 +(ASSOC (LAMBDA (U V) 00022740 + (SASSOC U V (FUNCTION (LAMBDA NIL NIL))))) 00022750 + 00022760 +(ASSOC* (LAMBDA (U V) 00022770 + (COND ((NULL V) NIL) 00022780 + ((EQUAL U (CAAR V)) (CAR V)) 00022790 + (T (ASSOC* U (CDR V)))))) 00022800 + 00022810 +(ATOMLIS (LAMBDA (U) 00022820 + (OR (NULL U) (AND (ATOM (CAR U)) (ATOMLIS (CDR U)))))) 00022830 + 00022840 +(CARX (LAMBDA (U) 00022850 + (COND ((NULL (CDR U)) (CAR U)) (T (ERRACH (LIST (QUOTE CARX) U))))) 00022860 +) 00022870 + 00022880 +(DELASC (LAMBDA (U V) 00022890 + (COND ((NULL V) NIL) 00022900 + ((OR (ATOM (CAR V)) (NOT (EQUAL U (CAAR V)))) 00022910 + (CONS (CAR V) (DELASC U (CDR V)))) 00022920 + (T (CDR V))))) 00022930 + 00022940 +(MAPCONS (LAMBDA (U *S*) 00022980 + (MAPCAR U (FUNCTION (LAMBDA (J) (CONS *S* J)))))) 00022990 + 00023000 +(MAPC2 (LAMBDA (U *PI*) 00023010 + (MAPCAR U 00023020 + (FUNCTION 00023030 + (LAMBDA(J) 00023040 + (MAPCAR J (FUNCTION (LAMBDA (K) (*PI* K))))))))) 00023050 + 00023060 +(MEXPR (LAMBDA (U V) 00023070 + (COND ((NULL V) NIL) 00023080 + ((ATOM V) (EQ U V)) 00023090 + (T (OR (MEXPR U (CAR V)) (MEXPR U (CDR V))))))) 00023100 + 00023110 +(NCONS (LAMBDA (U V) 00023120 + (COND ((NULL U) V) (T (CONS U V))))) 00023130 + 00023140 +(NLIST (LAMBDA (U N) 00023150 + (COND ((ZEROP N) NIL) (T (CONS U (NLIST U (SUB1 N))))))) 00023160 + 00023170 +(NTH (LAMBDA (U N) 00023180 + (COND ((ONEP N) (CAR U)) (T (NTH (CDR U) (SUB1 N)))))) 00023190 + 00023200 +(POSN (LAMBDA (U V) 00023210 + (COND ((EQ U (CAR V)) 1) (T (ADD1 (POSN U (CDR V))))))) 00023220 + 00023230 +(REMOVE (LAMBDA (X N) 00023240 + (COND ((MINUSP N) (ERRACH (LIST (QUOTE REMOVE) X N))) 00023250 + ((NULL X) NIL) 00023260 + ((ZEROP N) (CDR X)) 00023270 + (T (CONS (CAR X) (REMOVE (CDR X) (SUB1 N))))))) 00023280 + 00023290 +(REVPR (LAMBDA (U) 00023300 + (CONS (CDR U) (CAR U)))) 00023310 + 00023320 +(RPLACW (LAMBDA (U V) 00023330 + (COND 00023340 + ((OR (ATOM U) (ATOM V)) (ERRACH (LIST (QUOTE RPLACW) U V))) 00023350 + (T (RPLACD (RPLACA U (CAR V)) (CDR V)))))) 00023360 + 00023370 +(REPEATS (LAMBDA (X) 00023380 + (COND ((NULL X) NIL) 00023390 + ((MEMBER (CAR X) (CDR X)) (CONS (CAR X) (REPEATS (CDR X)))) 00023400 + (T (REPEATS (CDR X)))))) 00023410 + 00023420 +(UNION (LAMBDA (X Y) 00023430 + (COND ((NULL X) Y) 00023440 + (T 00023450 + (UNION (CDR X) 00023460 + (COND ((MEMBER (CAR X) Y) Y) 00023470 + (T (CONS (CAR X) Y)))))))) 00023480 + 00023490 +)) 00023500 + 00023510 +DEFINE (( 00023520 + 00023530 +(REPPRI (LAMBDA (U V) 00023540 + (MESPRI NIL U (QUOTE (REPRESENTED BY)) V NIL))) 00023550 + 00023560 +(REDEFPRI (LAMBDA (U) 00023570 + (COND ((NULL U) NIL) 00023580 + (T 00023590 + (MESPRI (QUOTE (ASSIGNMENT FOR)) 00023600 + U 00023610 + (QUOTE (REDEFINED)) 00023620 + NIL 00023630 + NIL))))) 00023640 + 00023650 +(MESPRI (LAMBDA (U V W X Y) 00023660 + (PROG (Z) 00023670 + (COND 00023680 + ((AND (NULL Y) (NULL *MSG)) (RETURN NIL)) 00023690 + ((AND OFL* (OR *FORT (NOT *NAT))) (GO B))) 00023700 + A (LPRIM U) 00023710 + (MAPRIN V) 00023720 + (PRINC* **BLANK) 00023730 + (LPRI W) 00023740 + (MATHPRINT X) 00023750 + (COND ((NULL OFL*) (RETURN NIL)) (Z (RETURN (WRS OFL*)))) 00023760 + B (WRS NIL) 00023770 + (SETQ Z T) 00023780 + (GO A)))) 00023790 + 00023800 +(LPRIM (LAMBDA (U) 00023810 + (PROG2 (TERPRI*) (LPRI (CONS (QUOTE ***) U))))) 00023820 + 00023830 +(ERRACH (LAMBDA (U) 00023840 + (PROG NIL 00023850 + (LPRIE (QUOTE (CATASTROPHIC ERROR *****)) T) 00023860 + (PRINTTY U) 00023870 + (PRINTTY **BLANK) 00023880 + (LPRIE (QUOTE 00023890 + (PLEASE SEND 00023900 + OUTPUT 00023910 + AND 00023920 + INPUT 00023930 + LISTING 00023940 + TO 00023950 + THE COMPUTING CENTER + *****)) 00023990 + T) 00024000 + (ERROR*)))) 00024010 + 00024020 +(ERRPRI1 (LAMBDA (U) 00024030 + (MESPRI (QUOTE (ASSIGNMENT)) U (QUOTE (NOT ALLOWED)) NIL T))) 00024040 + 00024050 +(ERRPRI2 (LAMBDA (U) 00024060 + (MESPRI (QUOTE (FORMAT)) U (QUOTE (INCORRECT)) NIL T))) 00024070 + 00024080 +)) 00024090 + 00024100 +DEFINE (( 00024110 + 00024120 +(ORDAD (LAMBDA (A U) 00024130 + (COND ((NULL U) (LIST A)) 00024140 + ((ORDP A (CAR U)) (CONS A U)) 00024150 + (T (CONS (CAR U) (ORDAD A (CDR U))))))) 00024160 + 00024170 +(ORDN (LAMBDA (U) 00024180 + (COND ((NULL U) NIL) 00024190 + ((NULL (CDR U)) U) 00024200 + ((NULL (CDDR U)) (ORD2 (CAR U) (CADR U))) 00024210 + (T (ORDAD (CAR U) (ORDN (CDR U))))))) 00024220 + 00024230 +(ORD2 (LAMBDA (U V) 00024240 + (COND ((ORDP U V) (LIST U V)) (T (LIST V U))))) 00024250 + 00024260 +(ORDP (LAMBDA (U V) 00024270 + (COND ((NULL U) (NULL V)) 00024280 + ((NULL V) T) 00024290 + ((ATOM U) 00024300 + (COND 00024310 + ((ATOM V) 00024320 + (COND ((NUMBERP U) (AND (NUMBERP V) (NOT (LESSP U V)))) 00024330 + ((NUMBERP V) T) 00024340 + (T (ORDERP U V)))) 00024350 + (T T))) 00024360 + ((ATOM V) NIL) 00024370 + ((EQUAL (CAR U) (CAR V)) (ORDP (CDR U) (CDR V))) 00024380 + (T (ORDP (CAR U) (CAR V)))))) 00024390 + 00024400 +)) 00024410 + 00024420 +DEFINE (( 00024430 + 00024440 +(ADDSQ (LAMBDA (U V) 00024450 + (COND ((EQUAL (CDR U) (CDR V)) 00024460 + (CONS (ADDF (CAR U) (CAR V)) (CDR U))) 00024470 + ((NULL (CAR U)) V) 00024480 + ((NULL (CAR V)) U) 00024490 + ((NULL *MCD) (CONS (ADDF (MKSQP U) (MKSQP V)) 1)) 00024500 + (T 00024510 + ((LAMBDA(Z) 00024520 + ((LAMBDA(X Y) 00024530 + (COND ((OR (NULL X) (NULL Y)) (ERRACH (QUOTE ADDSQ))) (T 00024531 + (CONS (ADDF (MULTF Y (CAR U)) (MULTF X (CAR V))) 00024540 + (MULTF Y (CDR U)))) 00024550 + )) 00024551 + (QUOTF (CDR U) Z) 00024560 + (QUOTF (CDR V) Z))) 00024570 + (GCD1 (CDR U) (CDR V))))))) 00024580 + 00024590 +(ADDF (LAMBDA (U V) 00024600 + (COND ((NULL U) V) 00024610 + ((NULL V) U) 00024620 + ((ATOM U) (ADDN U V)) 00024630 + ((ATOM V) (ADDN V U)) 00024640 + ((EQUAL (CAAR U) (CAAR V)) 00024650 + ((LAMBDA(X) 00024660 + (COND ((NULL X) (ADDF (CDR U) (CDR V))) 00024670 + (T 00024680 + (CONS (CONS (CAAR U) X) (ADDF (CDR U) (CDR V)))))) 00024690 + (ADDF (CDAR U) (CDAR V)))) 00024700 + ((ORDP (CAAR U) (CAAR V)) (CONS (CAR U) (ADDF (CDR U) V))) 00024710 + (T (CONS (CAR V) (ADDF U (CDR V))))))) 00024720 + 00024730 +(ADDN (LAMBDA (N V) 00024740 + (COND ((NULL V) N) 00024750 + ((ATOM V) 00024760 + ((LAMBDA (M) (COND ((ZEROP M) NIL) (T M))) (PLUS N V))) 00024770 + (T (CONS (CAR V) (ADDN N (CDR V))))))) 00024780 + 00024790 +(MULTSQ (LAMBDA (U V) 00024800 + (COND 00024810 + ((OR (NULL (CAR U)) (NULL (CAR V))) (CONS NIL 1)) 00024820 + (T 00024830 + ((LAMBDA(X Y) 00024840 + (COND ((AND X Y) (CONS (MULTF X Y) 1)) 00024850 + (X (CONS (MULTF X (CAR V)) (CDR U))) 00024860 + (Y (CONS (MULTF (CAR U) Y) (CDR V))) 00024870 + (T 00024880 + (CONS (MULTF (CAR U) (CAR V)) 00024890 + (MULTF (CDR U) (CDR V)))))) 00024900 + (QUOTF (CAR U) (CDR V)) 00024910 + (QUOTF (CAR V) (CDR U))))))) 00024920 + 00024930 +(MULTF (LAMBDA (U V) 00024940 + (PROG (X Y Z) 00024950 + (COND ((OR (NULL U) (NULL V)) (RETURN NIL)) 00024960 + ((ATOM U) (RETURN (MULTN U V))) 00024970 + ((ATOM V) (RETURN (MULTN V U))) 00024980 + ((OR *EXP *NCMP) (GO A))) 00024990 + (SETQ U (MKSFP U 1)) 00025000 + (SETQ V (MKSFP V 1)) 00025010 + (COND ((ATOM U) (RETURN (MULTN U V))) 00025020 + ((ATOM V) (RETURN (MULTN V U)))) 00025030 + A (SETQ X (CAAAR U)) 00025040 + (SETQ Y (CAAAR V)) 00025050 + (COND 00025060 + ((OR (ATOM X) 00025070 + (ATOM Y) 00025080 + (NOT (ATOM (CAR X))) 00025090 + (NOT (ATOM (CAR Y)))) 00025100 + (GO B)) 00025110 + ((AND (EQ (CAR X) (CAR Y)) 00025120 + (SETQ Z (GET (CAR X) (QUOTE MRULE))) 00025130 + (NOT 00025140 + (EQ (SETQ Z (*APPLY Z (LIST (CAAR U) (CAAR V)))) 00025150 + (QUOTE FAILED)))) 00025160 + (RETURN 00025170 + (ADDF (MULTF Z (MULTF (CDAR U) (CDAR V))) 00025180 + (ADDF (MULTF (LIST (CAR U)) (CDR V)) 00025190 + (MULTF (CDR U) V))))) 00025200 + ((AND (FLAGP (CAR X) (QUOTE NONCOM)) 00025210 + (FLAGP (CAR Y) (QUOTE NONCOM))) 00025220 + (GO B1))) 00025230 + B (COND ((EQ X Y) (GO C)) 00025240 + ((ORDP (CAAR U) (CAAR V)) (GO B1))) 00025250 + (SETQ X (MULTF U (CDAR V))) 00025260 + (SETQ Y (MULTF U (CDR V))) 00025270 + (RETURN (COND ((NULL X) Y) (T (CONS (CONS (CAAR V) X) Y)))) 00025280 + B1 (SETQ X (MULTF (CDAR U) V)) 00025290 + (SETQ Y (MULTF (CDR U) V)) 00025300 + (RETURN (COND ((NULL X) Y) (T (CONS (CONS (CAAR U) X) Y)))) 00025310 + C (SETQ X (MKSP X (PLUS (CDAAR U) (CDAAR V)))) 00025320 + (SETQ Y 00025330 + (ADDF (MULTF (LIST (CAR U)) (CDR V)) 00025340 + (MULTF (CDR U) V))) 00025350 + (RETURN 00025360 + (COND 00025370 + ((NULL (CDR X)) 00025380 + (COND ((NULL (CAAR X)) Y) 00025390 + (T 00025400 + (ADDF (MULTF (CAAR X) 00025410 + (MULTF (CDAR U) 00025420 + (COND 00025430 + ((EQUAL (CDAR X) 1) (CDAR V)) 00025440 + (T 00025450 + (MULTF 00025460 + (MKSQP (CONS 1 (CDAR X))) 00025470 + (CDAR V)))))) 00025480 + Y)))) 00025490 + ((NULL (SETQ U (MULTF (CDAR U) (CDAR V)))) Y) 00025495 + (T (CONS (CONS X U) Y))))))) 00025500 + 00025510 +(MULTF2 (LAMBDA (U V) 00025520 + (MULTF (LIST (CONS U 1)) V))) 00025530 + 00025540 +(MULTN (LAMBDA (N V) 00025550 + (COND ((NULL V) NIL) 00025560 + ((ZEROP N) NIL) 00025570 + ((ONEP N) V) 00025580 + ((NUMBERP V) (TIMES N V)) 00025590 + ((EQ (CAR V) (QUOTE QUOTIENT)) 00025591 + (MKFR (TIMES N (CADR V)) (CADDR V))) 00025592 + (T 00025600 + (CONS (CONS (CAAR V) (MULTN N (CDAR V))) 00025610 + (MULTN N (CDR V))))))) 00025620 + 00025630 +)) 00025640 + 00025650 +DEFINE (( 00025660 + 00025670 +(REVAL (LAMBDA (U) 00025680 + (COND ((AND (NUMBERP U) (FIXP U)) U) 00025690 + ((VECTORP U) U) 00025700 + (T ((LAMBDA (X) 00025710 + (COND ((AND (EQCAR X (QUOTE MINUS)) (NUMBERP (CADR X))) 00025712 + (MINUS (CADR X))) 00025714 + (T X))) 00025716 + (PREPSQ (AEVAL1 U))))))) 00025718 + 00025720 +(AEVAL (LAMBDA (U) 00025730 + (COND 00025740 + ((EQCAR U (QUOTE *COMMA*)) (REDERR (QUOTE (SYNTAX ERROR)))) 00025750 + (T (MK*SQ (AEVAL1 U)))))) 00025760 + 00025770 +(AEVAL1 (LAMBDA (U) 00025780 + (PROG2 (RSET2) 00025790 + (COND ((MATEXPR U) (MATSM U)) (T (SUBS2 (SIMP* U))))))) 00025800 + 00025810 +(MATEXPR (LAMBDA (U) 00025820 + NIL)) 00025830 + 00025840 +(MK*SQ (LAMBDA (U) 00025880 + (COND ((NULL (CAR U)) 0) 00025890 + ((AND (ATOM (CAR U)) (EQUAL (CDR U) 1)) (CAR U)) 00025900 + ((EQCAR U (QUOTE MAT)) U) 00025910 + (T (CONS (QUOTE *SQ) (CONS U *SQVAR*)))))) 00025920 + 00025930 +(RSET2 (LAMBDA NIL 00025940 + (PROG2 (MAP RPLIS* 00025950 + (FUNCTION (LAMBDA (J) (RPLACW (CDAR J) (CAAR J))))) 00025960 + (SETQ RPLIS* NIL)))) 00025970 + 00025980 +)) 00025990 + 00026000 +DEFINE (( 00026010 + 00026020 +(MKSP (LAMBDA (U P) 00026030 + (PROG (V X Y) 00026040 + (SETQ U (FKERN U)) 00026050 + A0 (SETQ V (CDDR U)) 00026060 + A (COND ((OR (NULL V) (NULL SUBFG*)) (GO B)) 00026070 + ((SETQ X (ASSOC (QUOTE ASYMP) V)) (GO L1)) 00026080 + ((SETQ X (ASSOC (QUOTE REP) V)) (GO L2)) 00026090 + ((AND (NOT (ATOM (CAR U))) 00026110 + (ATOM (CAAR U)) 00026120 + (FLAGP (CAAR U) (QUOTE VOP)) 00026130 + (VCREP U)) 00026140 + (GO A0))) 00026150 + B (RETURN (GETPOWER U P)) 00026170 + L1 (COND 00026180 + ((NOT (LESSP P (CDR X))) (RETURN (LIST (CONS NIL 1))))) 00026190 + (SETQ V (DELASC (CAR X) V)) 00026200 + (GO A) 00026210 + L2 (SETQ V (CDDDR X)) 00026220 + (COND ((LESSP P (CADDR X)) (GO B)) 00026230 + ((AND (CAR V) 00026231 + (NOT (FLAGP** (CAR U) (QUOTE WEIGHT)))) (GO L3))) 00026232 + (SETQ SUBL* (CONS V SUBL*)) 00026240 + (SETQ Y (SIMPCAR (CDR X))) 00026250 + (COND 00026260 + ((NOT (ASSOC (QUOTE HOLD) (CDDR U))) (GO L21)) 00026270 + ((EQUAL (CDR Y) 1) (SETQ Y (CONS (MKSFP (CAR Y) 1) 1))) 00026280 + (T (SETQ Y (MKSQP Y)))) 00026290 + L21 (RPLACA V (MK*SQ Y)) 00026295 + (GO L31) 00026300 + L3 (SETQ Y (SIMPCAR V)) 00026305 + (COND((AND(EQCAR (CAR V)(QUOTE *SQ))(NULL(CADDAR V)))(GO L21)))00026310 + L31 (SETQ V Y) 00026315 + (SETQ X (CADDR X)) 00026320 + (COND ((ONEP X) (RETURN (LIST (NMULTSQ V P))))) 00026330 + (SETQ Y (DIVIDE P X)) 00026340 + C (SETQ V (NMULTSQ V (CAR Y))) 00026370 + (COND 00026380 + ((NOT (ZEROP (CDR Y))) 00026390 + (SETQ V 00026400 + (CONS (MULTF2 (GETPOWER U (CDR Y)) (CAR V)) 00026410 + (CDR V))))) 00026420 + (RETURN (LIST V))))) 00026470 + 00026500 +(FKERN (LAMBDA (U) 00026510 + (PROG (V) 00026520 + (COND ((NOT (ATOM U)) (GO A0)) 00026530 + ((SETQ V (GET U (QUOTE APROP))) (RETURN V))) 00026540 + (SETQ V (LIST U NIL)) 00026550 + (PUT U (QUOTE APROP) V) 00026560 + (RETURN V) 00026570 + A0 (COND ((NOT (ATOM (CAR U))) (SETQ V EXLIST*)) 00026580 + ((NOT (SETQ V (GET (CAR U) (QUOTE KLIST)))) (GO B))) 00026590 + A (COND ((EQUAL U (CAAR V)) (RETURN (CAR V))) 00026600 + ((ORDP U (CAAR V)) 00026610 + (RETURN 00026620 + (CAR 00026630 + (RPLACW V 00026640 + (CONS (LIST U NIL) 00026650 + (CONS (CAR V) (CDR V))))))) 00026660 + ((NULL (CDR V)) 00026670 + (RETURN (CADR (RPLACD V (LIST (LIST U NIL))))))) 00026680 + (SETQ V (CDR V)) 00026690 + (GO A) 00026700 + B (SETQ V (LIST (LIST U NIL))) 00026710 + (PUT (CAR U) (QUOTE KLIST) V) 00026720 + (GO A)))) 00026730 + 00026740 +(GETPOWER (LAMBDA (U N) 00026750 + (PROG (V) 00026760 + (COND ((AND SUBFG* (NOT (ASSOC (QUOTE USED*) (CDR U)))) 00026761 + (ACONC U (LIST (QUOTE USED*))))) 00026762 + (SETQ V (CADR U)) 00026770 + (COND 00026780 + ((NULL V) 00026790 + (RETURN (CAAR (RPLACA (CDR U) (LIST (CONS (CAR U) N))))))) 00026800 + A (COND ((EQUAL N (CDAR V)) (RETURN (CAR V))) 00026810 + ((LESSP N (CDAR V)) 00026820 + (RETURN 00026830 + (CAR 00026840 + (RPLACW V 00026850 + (CONS (CONS (CAAR V) N) 00026860 + (CONS (CAR V) (CDR V))))))) 00026870 + ((NULL (CDR V)) 00026880 + (RETURN (CADR (RPLACD V (LIST (CONS (CAAR V) N))))))) 00026890 + (SETQ V (CDR V)) 00026900 + (GO A)))) 00026910 + 00026920 +(NMULTSQ (LAMBDA (U N) 00026930 + (PROG (X) 00026940 + (COND 00026950 + ((NULL (CAR U)) (RETURN U)) 00026955 + ((NULL *EXP) 00026960 + (RETURN (CONS (MKSFP (CAR U) N) (MKSFP (CDR U) N))))) 00026970 + (SETQ X U) 00026980 + A (COND ((ONEP N) (RETURN X))) 00026990 + (SETQ X (MULTSQ U X)) 00027000 + (SETQ N (SUB1 N)) 00027010 + (GO A)))) 00027020 + 00027030 +)) 00027040 + 00027050 +DEFINE (( 00027060 + 00027070 +(MKSF (LAMBDA (U N) 00027080 + ((LAMBDA(X) 00027090 + (COND 00027100 + ((NULL (CDR X)) 00027110 + (COND ((EQUAL (CDAR X) 1) (CAAR X)) 00027120 + (T (MULTF (MKSQP (CONS 1 (CDAR X))) (CAAR X))))) 00027130 + (T (LIST (CONS X 1))))) 00027140 + (MKSP U N)))) 00027150 + 00027160 +(MKSFP (LAMBDA (U N) 00027170 + (COND ((KERNLP U) (NMULTF U N)) 00027180 + (T 00027190 + (PROG2 (SETQ SUB2* T) 00027200 + (COND ((MINUSF U) (MULTN -1 (MKSF (MULTN -1 U) N))) 00027210 + (T (MKSF U N)))))))) 00027220 + 00027230 +(MKSQP (LAMBDA (U) 00027240 + (COND ((NULL (CAR U)) NIL) 00027250 + ((OR (EQUAL (CDR U) 1) (EQUAL (CDR (SETQ U (CANCEL U))) 1)) 00027260 + (COND (*EXP (CAR U)) (T (MKSFP (CAR U) 1)))) 00027270 + (T 00027280 + (PROG NIL 00027290 + (SETQ SUB2* T) 00027300 + (RETURN 00027310 + (COND (*EXP 00027320 + (MULTF (CAR U) 00027330 + (MKSF (MK*SQ 00027340 + (CONS 1 (MKSFP (CDR U) 1))) 00027350 + 1))) 00027360 + ((MINUSF (CAR U)) 00027370 + (MULTN -1 00027380 + (MKSF 00027390 + (MK*SQ 00027400 + (CONS (MULTN -1 (CAR U)) 00027410 + (MKSFP (CDR U) 1))) 00027420 + 1))) 00027430 + (T 00027440 + (MKSF (MK*SQ 00027450 + (CONS (CAR U) (MKSFP (CDR U) 1))) 00027460 + 1))))))))) 00027470 + 00027480 +(MKSQ (LAMBDA (U N) 00027570 + ((LAMBDA(X) 00027580 + (COND ((NULL (CDR X)) (CAR X)) (T (CONS (LIST (CONS X 1)) 1)))) 00027590 + (MKSP U N)))) 00027600 + 00027610 +)) 00027620 + 00027630 +DEFINE (( 00027640 + 00027650 +(SIMP* (LAMBDA (U) 00027660 + (COND ((LESSP (SCNT U) SNO*) (ISIMPQ (SIMP U))) 00027670 + ((EQ (CAR U) (QUOTE PLUS)) (SIMPADD (CDR U))) 00027680 + ((EQ (CAR U) (QUOTE MINUS)) (NEGSQ (SIMP* (CARX (CDR U))))) 00027690 + ((EQ (CAR U) (QUOTE TIMES)) (ISIMPQ* (TSCAN (CDR U)))) 00027700 + (T (ISIMPQ (SIMP U)))))) 00027710 + 00027720 +(SIMPADD (LAMBDA (U) 00027730 + (PROG (Z) 00027740 + (SETQ Z (CONS NIL 1)) 00027750 + A (COND ((NULL U) (RETURN Z))) 00027760 + (SETQ Z (ADDSQ (SIMP* (CAR U)) Z)) 00027770 + (SETQ U (CDR U)) 00027780 + (GO A)))) 00027790 + 00027800 +(ISIMPQ* (LAMBDA (U) 00027810 + (PROG (X) 00027820 + (SETQ U (REVERSE (MAPCAR U (FUNCTION SIMP)))) 00027830 + (SETQ SV* (CONS NIL 1)) 00027840 + (ISIMPQ*1 (CDR U) (CAR U)) 00027850 + (SETQ X SV*) 00027860 + (SETQ SV* NIL) 00027870 + (RETURN X)))) 00027880 + 00027890 +(ISIMPQ*1 (LAMBDA (U V) 00027900 + (PROG (X Y) 00027910 + (COND ((NULL U) (RETURN (SETQ SV* (ADDSQ (ISIMPQ V) SV*))))) 00027920 + (SETQ X (CAAR U)) 00027930 + (SETQ Y (MULTF (CDAR U) (CDR V))) 00027940 + (SETQ V (CAR V)) 00027950 + A (COND ((NULL X) (RETURN NIL)) 00027960 + ((ATOM X) 00027970 + (RETURN (ISIMPQ*1 (CDR U) (CONS (MULTN X V) Y))))) 00027980 + (ISIMPQ*1 (CDR U) (CONS (MULTF (LIST (CAR X)) V) Y)) 00027990 + (SETQ X (CDR X)) 00028000 + (GO A)))) 00028010 + 00028020 +(ISIMPQ (LAMBDA (U) 00028020 + U)) 00028020 + 00028020 +(TSCAN (LAMBDA (U) 00028030 + (COND ((NULL U) NIL) 00028040 + ((ATOM U) (ERRACH (LIST (QUOTE TSCAN) U))) 00028050 + ((EQ (CAR U) (QUOTE TIMES)) (TSCAN (CDR U))) 00028060 + ((AND (NOT (ATOM (CAR U))) (EQ (CAAR U) (QUOTE TIMES))) 00028070 + (APPEND (TSCAN (CDAR U)) (TSCAN (CDR U)))) 00028080 + (T (CONS (CAR U) (TSCAN (CDR U))))))) 00028090 + 00028100 +(SCNT (LAMBDA (U) 00028110 + (COND ((OR (NULL U) (EQUAL U 0)) 0) 00028120 + ((ATOM U) 1) 00028130 + ((EQ (CAR U) (QUOTE PLUS)) 00028140 + (*EVAL 00028150 + (CONS (QUOTE PLUS) (MAPCAR (CDR U) (FUNCTION SCNT))))) 00028160 + ((MEMBER (CAR U) (QUOTE (TIMES G CONS EPS))) 00028170 + (*EVAL 00028180 + (CONS (QUOTE TIMES) (MAPCAR (CDR U) (FUNCTION SCNT))))) 00028190 + ((FLAGP (CAR U) (QUOTE UNIP)) (SCNT (CADR U))) 00028200 + ((EQ (CAR U) (QUOTE EXPT)) 00028210 + (COND 00028220 + ((OR (ATOM (CADR U)) (NOT (NUMBERP (CADDR U)))) 1) 00028230 + (T 00028240 + ((LAMBDA(X) 00028250 + (COND ((LESSP X 2) 1) 00028260 + (T (TIMES 2 X (ABS (*EVAL (CADDR U))))))) 00028270 + (SCNT (CADR U)))))) 00028280 + ((AND (EQ (CAR U) (QUOTE *SQ)) GAMIDEN*) (TERMS1 (CAADR U))) 00028290 + (T 1)))) 00028300 + 00028310 +)) 00028320 + 00028330 +DEFINE (( 00028340 + 00028350 +(SIMP (LAMBDA (U) 00028360 + (PROG (X) 00028370 + A (COND ((ATOM U) (RETURN (SIMPATOM U))) 00028380 + ((OR (NOT (ATOM (CAR U))) (NUMBERP (CAR U))) (GO E)) 00028390 + ((AND (SETQ X (OPMTCH U)) (SETQ U X)) (GO A)) 00028400 + ((SETQ X (GET (CAR U) (QUOTE SIMPFN))) 00028410 + (RETURN 00028420 + (COND 00028430 + ((EQ X (QUOTE IDEN)) (SIMPIDEN U)) 00028440 + (T (*APPLY X (LIST (CDR U))))))) 00028450 + ((GET (CAR U) (QUOTE **ARRAY)) (GO D)) 00028460 + ((FLAGP (CAR U) (QUOTE OPFN)) 00028470 + (SETQ U (*APPLY (CAR U) (CDR U)))) 00028480 + ((GET (CAR U) (QUOTE INFIX)) (GO E)) 00028490 + ((MEMBER (CAR U) (QUOTE (COND PROG))) 00028500 + (RETURN (SIMP (*EVAL U)))) 00028510 + ((NOT (REDMSG (CAR U) (QUOTE OPERATOR) T)) (ERROR*)) 00028520 + (T (MKOP (CAR U)))) 00028530 + (GO A) 00028540 + D (SETQ U (CONS (CAR U) (MAPCAR (CDR U) (FUNCTION REVAL)))) 00028550 + (COND 00028560 + ((NOT (NUMLIS (CDR U))) 00028570 + (REDERR 00028580 + (APPEND (QUOTE (INCORRECT ARRAY ARGUMENTS FOR)) 00028590 + (LIST (CAR U))))) 00028600 + ((AND (SETQ X (GETEL U)) (SETQ U X)) (GO A)) 00028610 + (T (RETURN (MKSQ U 1)))) 00028620 + E (CURERR (QUOTE (SYNTAX ERROR)) NIL)))) 00028630 + 00028640 +(SIMPATOM (LAMBDA (U) 00028650 + (COND((NULL U)(REDERR(QUOTE(NIL USED IN ALGEBRAIC EXPRESSION)))) 00028660 + ((NUMBERP U) 00028670 + (COND ((ZEROP U) (CONS NIL 1)) 00028680 + ((FIXP U) (CONS U 1)) 00028690 + (*FLOAT (CONS (PLUS 0.0 U) 1)) 00028700 + (T 00028710 + ((LAMBDA(Z) 00028720 + (PROG2 (REPPRI U 00028730 + (LIST 00028740 + (QUOTE QUOTIENT) 00028750 + (CAR Z) 00028760 + (CDR Z))) 00028770 + Z)) 00028780 + (MAKFRC U))))) 00028790 + ((VECTORP U) 00028800 + (REDERR 00028810 + (CONS (QUOTE VECTOR) (CONS U (QUOTE (USED AS SCALAR)))))) 00028820 + (T (MKSQ U 1))))) 00028830 + 00028840 +(MAKFRC (LAMBDA (U) 00028850 + (PROG (X Y) 00028860 + (SETQ X (FIX (TIMES **MILLION U))) 00028870 + (SETQ Y (GCDN **MILLION X)) 00028880 + (RETURN (CONS (QUOTIENT X Y) (QUOTIENT **MILLION Y)))))) 00028890 + 00028900 +(MKOP (LAMBDA (U) 00028910 + (COND ((MEMBER U FRLIS*) (REDERR (CONS (QUOTE OPERATOR) 00028920 + (CONS U (QUOTE (CANNOT BE ARBITRARY)))))) 00028922 + (T (PUT U (QUOTE SIMPFN) (QUOTE IDEN)))))) 00028924 + 00028930 +(SIMPCAR (LAMBDA (U) 00028940 + (SIMP (CAR U)))) 00028950 + 00028960 +(VECTORP (LAMBDA (U) 00028970 + NIL)) 00028980 + 00028990 +(SIMPEXPT (LAMBDA (U) 00029000 + (PROG (N X) 00029010 + (COND 00029020 + ((AND (NUMBERP (SETQ N (CARX (CDR U)))) (FIXP N)) (GO A))) 00029030 + (SETQ X *FLOAT) 00029040 + (SETQ *FLOAT NIL) 00029050 + (SETQ N (CANCEL (SIMP N))) 00029060 + (SETQ *FLOAT X) 00029070 + (COND ((AND (ATOM (CAR N)) (EQUAL (CDR N) 1)) (GO A0))) 00029080 + (SETQ X (PREPSQ (SIMPCAR U))) 00029090 + (SETQ N (PREPSQ N)) 00029100 + (COND ((EQCAR X (QUOTE TIMES)) (GO B)) 00029101 + ((AND (EQCAR X (QUOTE MINUS)) 00029102 + (NOT (NUMBERP (CADR X)))) 00029103 + (RETURN 00029104 + (MULTSQ (SIMPEXPT (LIST -1 N)) 00029105 + (SIMPEXPT (LIST (CADR X) N))))) 00029106 + ((EQCAR X (QUOTE QUOTIENT)) 00029107 + (RETURN 00029108 + (MULTSQ (SIMPEXPT (LIST (CADR X) N)) 00029109 + (SIMPEXPT 00029110 + (LIST (CADDR X) (LIST (QUOTE MINUS) N)))))) 00029111 + ((EQCAR X (QUOTE EXPT)) 00029112 + (AND (SETQ N 00029113 + (REVAL (LIST (QUOTE TIMES) (CADDR X) N))) 00029114 + (SETQ X (CADR X))))) 00029115 + (RETURN 00029116 + (COND ((EQUAL X 0) (CONS NIL 1)) 00029117 + ((EQUAL X 1) (CONS 1 1)) 00029118 + ((AND (ATOM X) (MEMBER N FRLIS*)) 00029119 + (CONS (LIST (CONS (CONS X N) 1)) 1)) 00029120 + (T 00029121 + (PROG2 (AND (NOT (MEMBER X EXPTL*)) 00029122 + (NOT (NUMBERP X)) 00029123 + (SETQ EXPTL* (CONS X EXPTL*))) 00029124 + (MKSQ (LIST (QUOTE EXPT) X N) 1))))) 00029125 + A0 (SETQ N (CAR N)) 00029170 + (COND ((NULL N) (SETQ N 0))) 00029172 + A (RETURN 00029180 + (COND ((EQUAL N 0) (CONS 1 1)) 00029190 + ((ATOM (CAR U)) 00029200 + (COND ((NULL N) (CONS 1 1)) 00029210 + ((NUMBERP (CAR U)) 00029220 + (COND 00029230 + ((ZEROP (CAR U)) (CONS NIL 1)) 00029240 + ((MINUSP N) 00029250 + (CONS 1 (EXPT (CAR U) (MINUS N)))) 00029260 + (T (CONS (EXPT (CAR U) N) 1)))) 00029270 + ((MINUSP N) 00029280 + (LIST 1 (CONS (MKSP (CAR U) (MINUS N)) 1))) 00029290 + (T (MKSQ (CAR U) N)))) 00029300 + ((MINUSP N) (REVPR (NMULTSQ (SIMPCAR U) (MINUS N)))) 00029310 + (T (NMULTSQ (SIMPCAR U) N)))) 00029311 + B (SETQ U (CDDR X)) 00029312 + (SETQ X (SIMPEXPT (LIST (CADR X) N))) 00029313 + C (COND ((NULL U) (RETURN X))) 00029314 + (SETQ X (MULTSQ (SIMPEXPT (LIST (CAR U) N)) X)) 00029315 + (SETQ U (CDR U)) 00029316 + (GO C)))) 00029317 + 00029318 +(MEXPT (LAMBDA (U V) 00029340 + (COND 00029350 + ((NOT (EQUAL (CADAR U) (CADAR V))) (QUOTE FAILED)) 00029360 + (T 00029370 + ((LAMBDA(X) 00029380 + (COND ((EQUAL X 0) 1) 00029390 + ((AND (NUMBERP X) (EQUAL (CADAR U) (QUOTE (MINUS 1)))) 00029400 + (COND ((ZEROP (REMAINDER X 2)) 1) (T -1))) 00029410 + (T (MKSQP (MKSQ (LIST (QUOTE EXPT) (CADAR U) X) 1))))) 00029450 + (REVAL 00029460 + (LIST (QUOTE PLUS) 00029470 + (LIST (QUOTE TIMES) (CDR U) (CADDAR U)) 00029480 + (LIST (QUOTE TIMES) (CDR V) (CADDAR V))))))))) 00029490 + 00029500 +)) 00029510 + 00029520 +DEFLIST (((EXPT MEXPT)) MRULE) 00029530 + 00029540 +DEFINE (( 00029550 + 00029560 +(SIMPIDEN (LAMBDA (*S*) 00029570 + (PROG (Y Z) 00029580 + (COND ((FLAGP (CAR *S*) (QUOTE VOP)) (GO E))) 00029590 + (SETQ *S* 00029600 + (CONS (CAR *S*) (MAPCAR (CDR *S*) (FUNCTION REVAL)))) 00029610 + B (COND ((SETQ Z (OPMTCH *S*)) (RETURN (SIMP Z))) 00029620 + ((FLAGP (CAR *S*) (QUOTE SYMMETRIC)) 00029630 + (SETQ *S* (CONS (CAR *S*) (ORDN (CDR *S*))))) 00029640 + ((FLAGP (CAR *S*) (QUOTE ANTISYMMETRIC)) (GO D))) 00029650 + C (SETQ *S* (MKSQ *S* 1)) 00029660 + (RETURN (COND (Y (NEGSQ *S*)) (T *S*))) 00029670 + D (COND ((REPEATS (CDR *S*)) (RETURN (CONS NIL 1))) 00029680 + ((NOT (PERMP (SETQ Z (ORDN (CDR *S*))) (CDR *S*))) 00029690 + (SETQ Y T))) 00029700 + (SETQ *S* (CONS (CAR *S*) Z)) 00029710 + (GO C) 00029720 + E (COND ((ATOMLIS (CDR *S*)) (GO B))) 00029730 + (RETURN 00029740 + (MKVARG (CDR *S*) 00029750 + (FUNCTION 00029760 + (LAMBDA (J) (SIMPIDEN (CONS (CAR *S*) J))))))))) 00029770 + 00029780 +(NEGSQ (LAMBDA (U) 00029790 + (CONS (MULTN -1 (CAR U)) (CDR U)))) 00029800 + 00029810 +(SIMPMINUS (LAMBDA (U) 00029820 + (NEGSQ (SIMP (CARX U))))) 00029830 + 00029840 +(SIMPPLUS (LAMBDA (U) 00029850 + (PROG (Z) 00029860 + (SETQ Z (CONS NIL 1)) 00029870 + A (COND ((NULL U) (RETURN Z))) 00029880 + (SETQ Z (ADDSQ (SIMPCAR U) Z)) 00029890 + (SETQ U (CDR U)) 00029900 + (GO A)))) 00029910 + 00029920 +(SIMPQUOT (LAMBDA (U) 00029930 + ((LAMBDA(X) 00029940 + (COND 00029950 + ((NULL (CDR X)) (REDERR (QUOTE (ZERO DENOMINATOR)))) 00029960 + (T (MULTSQ (SIMPCAR U) X)))) 00029970 + (SIMPRECIP (CDR U))))) 00029980 + 00029990 +(SIMPRECIP (LAMBDA (U) 00030000 + ((LAMBDA(X) 00030010 + (COND 00030020 + ((NULL (CAR X)) (REDERR (QUOTE (ZERO DENOMINATOR)))) 00030030 + ((AND *FLOAT (ATOM (CAR X))) 00030040 + (CONS (MULTN (RECIP (PLUS 0.0 (CAR X))) (CDR X)) 1)) 00030050 + (T (REVPR X)))) 00030060 + (SIMP (CARX U))))) 00030070 + 00030080 +(SIMPTIMES (LAMBDA (U) 00030090 + (PROG (X) 00030100 + (SETQ X (SIMPCAR U)) 00030110 + A (SETQ U (CDR U)) 00030120 + (COND ((NULL (CAR X)) (RETURN (CONS NIL 1))) 00030130 + ((NULL U) (RETURN X))) 00030140 + (SETQ X (MULTSQ X (SIMPCAR U))) 00030150 + (GO A)))) 00030160 + 00030170 +(SIMPSUBS (LAMBDA (U) 00030180 + (PROG (X Y Z) 00030190 + (SETQ U (REVERSE U)) 00030200 + (SETQ Y (SUBS2 (SIMPCAR U))) 00030210 + (SETQ U (CDR U)) 00030220 + A (COND ((NULL U) (GO B)) 00030230 + ((NOT (MEMBER (CAAR U) (QUOTE (EQUAL SETQ)))) 00030240 + (GO ERR)) 00030250 + ((VECTORP (SETQ X (CADAR U))) (GO C)) 00030260 + ((OR (NOT (KERNP (SETQ X (SIMP X)))) 00030270 + (NOT (EQUAL (CDR X) 1)) 00030280 + (NOT (EQUAL (CDAAR X) 1)) 00030290 + (NOT (EQUAL (CDAAAR X) 1))) 00030300 + (GO ERR))) 00030310 + (SETQ X (CAAAAR X)) 00030320 + C (SETQ Z (CONS (CONS X (CADDAR U)) Z)) 00030330 + (SETQ U (CDR U)) 00030340 + (GO A) 00030350 + B (RETURN (SIMP (SUBLIS Z (PREPSQ Y)))) 00030360 + ERR (ERRPRI1 (CAR U)) 00030370 + (ERROR*)))) 00030380 + 00030390 +(SIMP*SQ (LAMBDA (U) 00030400 + (COND ((NULL (CADR U)) (SIMP (PREPSQ (CAR U)))) (T (CAR U))))) 00030410 + 00030420 +)) 00030430 + 00030440 +DEFINE (( 00030450 + 00030460 +(SUBS2 (LAMBDA (U) 00030470 + (PROG (X) 00030480 + (RSET2) 00030490 + (SETQ U (EXPSQ U)) 00030500 + (COND ((AND (NULL EXPTL*) 00030505 + (OR (NULL MATCH*) (NULL SUBFG*))) (GO A))) 00030510 + (COND (EXPTL* (SETQ U (EXPTCHK U)))) 00030515 + (SETQ X MCHFG*) 00030520 + (SETQ U (MULTSQ (SUBS31 (CAR U)) (REVPR (SUBS31 (CDR U))))) 00030530 + (SETQ MCHFG* X) 00030540 + A (RETURN (CANCEL U))))) 00030550 + 00030560 +(CANCEL (LAMBDA (U) 00030570 + (PROG (X) 00030580 + (COND ((NULL (CAR U)) (RETURN (CONS NIL 1))) 00030590 + ((OR *FLOAT (EQUAL (CDR U) 1)) (GO C))) 00030600 + (SETQ X (GCD1 (CDR U) (CAR U))) 00030610 + (SETQ U (CONS (QUOTF (CAR U) X) (QUOTF (CDR U) X))) 00030620 + C (RETURN (MKCANON U))))) 00030630 + 00030640 +(MKCANON (LAMBDA (U) 00030650 + (COND ((MINUSF (CDR U)) 00030660 + (CONS (MULTN -1 (CAR U)) (MULTN -1 (CDR U)))) 00030670 + (T U)))) 00030680 + 00030690 +(MINUSF (LAMBDA (U) 00030700 + (COND ((NULL U) NIL) 00030701 + ((ATOM U) (MINUSP U)) 00030702 + ((EQ (CAR U) (QUOTE QUOTIENT)) (MINUSP (CADR U))) 00030703 + (T (MINUSF (CDAR U)))))) 00030704 + 00030720 +)) 00030730 + 00030740 +DEFINE (( 00030750 + 00030760 +(EXPSQ (LAMBDA (U) 00030770 + (COND ((OR (NULL SUB2*) (NULL *EXP)) U) 00030780 + (T 00030790 + ((LAMBDA(X Y) 00030800 + (CONS (MULTF (CAR X) (CDR Y)) (MULTF (CDR X) (CAR Y)))) 00030810 + (EXPAND (CAR U)) 00030820 + (COND (*XDN (EXPAND (CDR U))) (T (CONS (CDR U) 1)))))))) 00030830 + 00030840 +(EXPAND (LAMBDA (U) 00030850 + (PROG (W X Y Z) 00030860 + (COND ((ATOM U) (RETURN (CONS U 1)))) 00030870 + (SETQ X U) 00030880 + (SETQ Z (CONS NIL 1)) 00030890 + A (COND 00030900 + ((NULL X) 00030910 + (RETURN 00030920 + (COND ((EQUAL (CAR Z) U) (CONS U (CDR Z))) (T Z)))) 00030930 + ((ATOM X) (GO E))) 00030940 + (SETQ Y (EXPAND (CDAR X))) 00030950 + (COND 00030960 + ((AND (NOT (ATOM (SETQ W (CAAAR X)))) 00030970 + (OR (EQ (CAR W) (QUOTE *SQ)) (NOT (ATOM (CAR W))))) 00030980 + (GO C))) 00030990 + (SETQ Z (ADDSQ (CONS (MULTF2 (CAAR X) (CAR Y)) (CDR Y)) Z)) 00031000 + B (SETQ X (CDR X)) 00031010 + (GO A) 00031020 + C (SETQ Z 00031030 + (ADDSQ 00031040 + (MULTSQ 00031050 + (COND 00031060 + ((EQ (CAR W) (QUOTE *SQ)) 00031070 + (NMULTSQ (EXPSQ (CADR W)) (CDAAR X))) 00031080 + ((NULL (CDAAR X)) (EXPSQ W)) 00031090 + (T (NMULTSQ (EXPAND W) (CDAAR X)))) 00031100 + Y) 00031110 + Z)) 00031120 + (GO B) 00031130 + E (SETQ Z (ADDSQ (CONS X 1) Z)) 00031140 + (SETQ X NIL) 00031150 + (GO A)))) 00031160 + 00031170 +)) 00031180 + 00031181 +DEFINE (( 00031182 + 00031183 +(EXSCAN (LAMBDA (U) 00031184 + (COND ((ATOM U) U) 00031185 + (T 00031186 + (ADDF 00031187 + (MULTF2 00031188 + (COND 00031189 + ((MEMBER (CAAAR U) EXPTL*) 00031190 + (MKSP (LIST (QUOTE EXPT) (CAAAR U) 1) (CDAAR U))) 00031191 + (T (CAAR U))) 00031192 + (EXSCAN (CDAR U))) 00031193 + (EXSCAN (CDR U))))))) 00031194 + 00031195 +(EXPTCHK (LAMBDA (U) 00031196 + (PROG (V W X Y Y1 Z) 00031197 + (SETQ V (EXSCAN (CAR U))) 00031198 + (SETQ W (CDR U)) 00031199 + (SETQ X (CONS FACTORS* ORDN*)) 00031200 + (SETQ FACTORS* NIL) 00031201 + (SETQ ORDN* 0) 00031202 + (SETQ Y (CKRN W)) 00031203 + A (COND ((ATOM Y) (GO C))) 00031204 + (SETQ Y1 (CAAAR Y)) 00031205 + (COND 00031206 + ((AND (NOT (MEMBER Y1 EXPTL*)) (NOT (EQCAR Y1 (QUOTE EXPT)))) 00031207 + (GO B))) 00031208 + (SETQ V 00031209 + (MULTF2 00031210 + (MKSP 00031211 + (COND 00031212 + ((MEMBER Y1 EXPTL*) (LIST (QUOTE EXPT) Y1 -1)) 00031213 + (T 00031214 + (LIST (QUOTE EXPT) 00031215 + (CADR Y1) 00031216 + (PREPSQ (SIMPMINUS (CDDR Y1)))))) 00031217 + (CDAAR Y)) 00031218 + V)) 00031219 + (SETQ Z (CONS (CAAR Y) Z)) 00031220 + B (SETQ Y (CDAR Y)) 00031221 + (GO A) 00031222 + C (SETQ FACTORS* (CAR X)) 00031223 + (SETQ ORDN* (CDR X)) 00031224 + (SETQ X 1) 00031225 + D (COND ((NULL Z) (GO E))) 00031226 + (SETQ X (LIST (CONS (CAR Z) X))) 00031227 + (SETQ Z (CDR Z)) 00031228 + (GO D) 00031229 + E (RETURN (CONS V (QUOTF W X)))))) 00031231 + 00031232 +)) 00031233 + 00031234 +DEFINE (( 00031235 + 00031236 +(SUBS31 (LAMBDA (U) 00031237 + (COND ((ATOM U) (CONS U 1)) 00031238 + (T 00031239 + (ADDSQ 00031250 + ((LAMBDA(X) 00031260 + (COND ((NULL MCHFG*) (CONS (LIST (CAR U)) 1)) 00031270 + ((AND MCHFG* (NOT (SETQ MCHFG* NIL)) *RESUBS) 00031280 + (SUBS2 X)) 00031290 + (T X))) 00031300 + (SUBS3T (CAR U) MATCH*)) 00031310 + (SUBS31 (CDR U))))))) 00031320 + 00031330 +(SUBS3T (LAMBDA (U V) 00031340 + (SUBS3T0 (SUBS3T1 U V)))) 00031350 + 00031360 +(SUBS3T0 (LAMBDA (X) 00031370 + (PROG (Y) 00031380 + (COND ((OR (CAR X) (ATOM (CDR X))) (RETURN X))) 00031390 + (SETQ Y (MULTSQ (SIMP (CAADR X)) (CADDR X))) 00031400 + (COND 00031410 + ((CDADR X) 00031420 + (SETQ Y 00031430 + (MULTSQ 00031440 + (REVPR (SIMPTIMES (EXCHK (CDADR X) NIL))) 00031450 + Y)))) 00031460 + (RETURN (CANCEL Y))))) 00031470 + 00031480 +(SUBS3T1 (LAMBDA (U V) 00031490 + (PROG (X Y Z) 00031500 + (SETQ X (MTCHK (CAR U) V)) 00031510 + (COND 00031520 + ((NULL X) 00031530 + (RETURN (COND ((NULL MCHFG*) U) (T (CONS (LIST U) 1))))) 00031540 + ((AND (NULL (CAAR X)) 00031550 + (SETQ MCHFG* T) 00031560 + (SETQ Y 00031570 + (LIST NIL 00031580 + (CONS (CADDAR X) (CADR (CDDAR X))) 00031590 + (SUBS32 (CDR U) MATCH*)))) 00031600 + (GO B)) 00031610 + ((AND (NOT (ATOM (CDR U))) (NULL (CDDR U))) (GO A))) 00031620 + (SETQ Y (SUBS32 (CDR U) X)) 00031630 + (COND ((NULL MCHFG*) (RETURN (CONS (CAR U) Y)))) 00031640 + A0 (SETQ X (LIST (CONS (CAR U) 1))) 00031650 + (SETQ Z (GCD1 X (CDR Y))) 00031660 + (RETURN 00031670 + (COND ((NULL Z) (MULTS2 (CAR U) Y)) 00031680 + ((EQUAL X Z) (CONS (CAR Y) (QUOTF (CDR Y) X))) 00031690 + (T 00031700 + (CONS (MULTF (QUOTF X Z) (CAR Y)) 00031710 + (QUOTF (CDR Y) Z))))) 00031720 + A (SETQ Y (SUBS3T1 (CADR U) X)) 00031730 + (COND ((AND (NULL (CAR Y)) (NOT (ATOM (CDR Y)))) (GO B)) 00031740 + ((NULL MCHFG*) (RETURN (LIST (CAR U) Y))) 00031750 + (T (GO A0))) 00031760 + B (COND 00031770 + ((AND (CDADR Y) (EQUAL (CADADR Y) (CAR U))) 00031780 + (RETURN (LIST NIL (CONS (CAADR Y) (CDDADR Y)) (CADDR Y)))) 00031790 + ((AND (NOT (ATOM (CAAR U))) 00031800 + (FLAGP** (CAAAR U) (QUOTE NONCOM)) 00031810 + (SETQ Y (SUBS3T0 Y))) 00031820 + (GO A0)) 00031830 + (T 00031840 + (RETURN (LIST NIL (CADR Y) (MULTS2 (CAR U) (CADDR Y)))))))) 00031850 +) 00031860 + 00031870 +(MULTS2 (LAMBDA (U V) 00031880 + (CONS (MULTF2 U (CAR V)) (CDR V)))) 00031890 + 00031900 +(SUBS32 (LAMBDA (U V) 00031910 + (PROG (B X Y) 00031920 + A (COND 00031930 + ((ATOM U) 00031940 + (RETURN 00031950 + (COND (MCHFG* 00031960 + (COND ((NULL X) (CONS U 1)) 00031970 + (T (ADDSQ (CONS U 1) X)))) 00031980 + (T (APPEND X U)))))) 00031990 + (SETQ Y (SUBS3T (CAR U) V)) 00032000 + (COND ((NULL MCHFG*) (SETQ X (APPEND X (LIST Y)))) 00032010 + (B (SETQ X (ADDSQ Y X))) 00032020 + ((SETQ B T) (SETQ X (ADDSQ (CONS X 1) Y)))) 00032030 + (SETQ U (CDR U)) 00032040 + (GO A)))) 00032050 + 00032060 +(MKKL (LAMBDA (U V) 00032070 + (COND ((NULL U) V) (T (MKKL (CDR U) (LIST (CONS (CAR U) V))))))) 00032080 + 00032090 +)) 00032100 + 00032110 +DEFINE (( 00032120 + 00032130 +(MTCHK (LAMBDA (U V1) 00032140 + (PROG (V W X Y Z Q) + A0 (COND ((NULL V1) (RETURN Z))) 00032160 + (SETQ V (CAR V1)) 00032170 + (SETQ W (CAR V)) 00032180 + A (SETQ Q (CAR W)) + (COND ((NULL W) (GO D)) + ((AND (EQUAL U (CAR W)) (SETQ Y (LIST NIL))) (GO B)) 00032200 + ((NOT (ATOM (CAR U))) (GO A3)) + ((NOT (ATOM (CAAR W))) (GO D)) 00032220 + ((OR FRLIS* (ORDP (CAR U) (CAAR W))) (GO A2)) 00032230 + (T (GO E))) 00032231 + A3 (COND ((NOT (ATOM (CAAR W))) (GO A1)) + ((AND (MEMBER (CDAR W) FRLIS*) + (EQ (CAAR U) (QUOTE EXPT)) + (SETQ W (CONS (CONS (LIST (QUOTE EXPT) (CAAR W) + (CDAR W)) 1) (CDR W)))) + (GO A1)) + ((MEMBER (CAAR W) FRLIS*) (GO A2)) + (T (GO D))) + A1 (COND ((EQ (CAAR U) (CAAAR W)) (GO A2)) 00032232 + ((FLAGP** (CAAR U) (QUOTE NONCOM)) (GO C1)) 00032234 + ((NULL (ORDP (CAAR U) (CAAAR W))) (GO E)) 00032240 + (T (GO D))) 00032250 + A2 (COND 00032260 + ((OR (AND (NOT (MEMBER (CDAR W) FRLIS*)) 00032270 + (OR (AND (CAADR V) 00032280 + (NOT (EQUAL (CDR U) (CDAR W)))) 00032290 + (LESSP (CDR U) (CDAR W)))) 00032300 + (NOT (SETQ Y (MCHK (CAR U) (CAAR W))))) 00032310 + (GO C)) 00032320 + ((MEMBER (CDAR W) FRLIS*) 00032321 + (SETQ Y 00032322 + (MAPCONS U (CONS (CDAR W) (CDR U)))))) 00032324 + B (COND ((NULL Y) (GO C)) 00032330 + ((AND (NULL 00032340 + (CAR 00032350 + (SETQ X 00032360 + (CONS (SUBLIS (CAR Y) 00032370 + (DELETE Q (CAR V))) + (LIST (CADR V) 00032390 + (SUBLIS (CAR Y) (CADDR V)) 00032400 + (CONS 00032410 + (SUBLIS (CAR Y) (CAR W)) 00032420 + (CADDDR V))))))) 00032430 + (*EVAL (SUBLIS (CAR Y) (CDADR V)))) 00032440 + (RETURN (LIST X)))) 00032450 + (SETQ Z (CONS X Z)) 00032460 + (SETQ Y (CDR Y)) 00032470 + (GO B) 00032480 + C (COND 00032490 + ((AND (NOT (ATOM (CAR U))) 00032500 + (FLAGP** (CAAR U) (QUOTE NONCOM))) 00032510 + (GO C1))) 00032520 + (SETQ W (CDR W)) 00032530 + (GO A) 00032540 + C1 (COND ((AND (CADDDR V) (NOT (NOCP (CADDDR V)))) (GO E))) 00032550 + D (SETQ Z (APPEND Z (LIST V))) 00032580 + E (SETQ V1 (CDR V1)) 00032590 + (GO A0)))) 00032600 + 00032710 +(NOCP (LAMBDA (U) 00032720 + (OR (NULL U) 00032730 + (AND (OR (ATOM (CAAR U)) 00032740 + (NOT (FLAGP** (CAAAR U) (QUOTE NONCOM)))) 00032750 + (NOCP (CDR U)))))) 00032760 + 00032770 +(MCHK (LAMBDA (U V) 00032780 + (COND ((EQUAL U V) (LIST NIL)) 00032790 + ((OR (NULL U) (NULL V)) NIL) 00032800 + ((MEMBER V FRLIS*) (LIST (LIST (CONS V (EMTCH U))))) 00032810 + ((OR (ATOM U) (ATOM V)) NIL) 00032820 + ((EQ (CAR U) (CAR V)) (MCHARG (CDR U) (CDR V) (CAR U))) 00032830 + (T NIL)))) 00032840 + 00032850 +(MCHARG (LAMBDA (*S* V W) 00032860 + ((LAMBDA(X) 00032870 + (COND 00032880 + ((MTP V) 00032890 + (COND 00032900 + (X 00032910 + (COND 00032920 + ((FLAGP W (QUOTE SYMMETRIC)) 00032930 + (MAPLIST (PERMUTATIONS V) 00032940 + (FUNCTION 00032950 + (LAMBDA(J) 00032960 + (PAIR (CAR J) 00032970 + (MAPCAR *S* (FUNCTION EMTCH))))))) 00032980 + ((FLAGP W (QUOTE ANTISYMMETRIC)) 00032990 + (ERRACH (QUOTE (NOT YET)))) 00033000 + (T (LIST (PAIR V (MAPCAR *S* (FUNCTION EMTCH))))))) 00033010 + ((AND (EQUAL (LENGTH V) 2) (FLAGP W (QUOTE NARY))) 00033020 + (MCHARG (CDR (MKBIN (CONS W *S*))) V W)) 00033030 + (T NIL))) 00033040 + (X (MCHARG1 *S* V (FLAGP W (QUOTE SYMMETRIC)) (LIST NIL))) 00033050 + (T NIL))) 00033060 + (EQUAL (LENGTH *S*) (LENGTH V))))) 00033070 + 00033080 +(MCHARG1 (LAMBDA (U V FLG W) 00033090 + (PROG (X Z) 00033100 + (COND ((NULL U) (RETURN W)) 00033110 + ((NULL FLG) 00033120 + (RETURN 00033130 + (MCHARG3 U (CDR V) (MCHK (CAR U) (CAR V)) FLG W)))) 00033140 + (SETQ X (MCHARG2 (CAR U) V)) 00033150 + A (COND ((NULL X) (RETURN Z))) 00033160 + (SETQ Z (APPEND (MCHARG3 U (CDAR X) (CAAR X) FLG W) Z)) 00033170 + (SETQ X (CDR X)) 00033180 + (GO A)))) 00033190 + 00033200 +(MCHARG2 (LAMBDA (U V) 00033210 + (PROG (X Y Z) 00033220 + A (COND ((NULL V) (RETURN (REVERSE Z))) 00033230 + ((SETQ Y (MCHK U (CAR V))) 00033240 + (SETQ Z 00033250 + (CONS (CONS Y (APPEND (REVERSE X) (CDR V))) 00033260 + Z)))) 00033270 + (SETQ X (CONS (CAR V) X)) 00033280 + (SETQ V (CDR V)) 00033290 + (GO A)))) 00033300 + 00033310 +(MCHARG3 (LAMBDA (U V *S* FLG W) 00033320 + (PROG (Z) 00033330 + A (COND ((NULL *S*) (RETURN Z))) 00033340 + (SETQ Z 00033350 + (APPEND (MCHARG1 (CDR U) 00033360 + (SUBLIS (CAR *S*) V) 00033370 + FLG 00033380 + (MAPLIST W 00033390 + (FUNCTION 00033400 + (LAMBDA(J) 00033410 + (APPEND 00033420 + (CAR *S*) 00033430 + (CAR J)))))) 00033440 + Z)) 00033450 + (SETQ *S* (CDR *S*)) 00033460 + (GO A)))) 00033470 + 00033480 +(MKBIN (LAMBDA (U) 00033490 + (COND ((OR (NULL (CDDR U)) (NULL (CDDDR U))) U) 00033500 + (T (MKBIN1 (CAR U) (CDR U)))))) 00033510 + 00033520 +(MKBIN1 (LAMBDA (U V) 00033530 + (COND ((NULL (CDDR V)) (CONS U V)) 00033540 + (T (LIST U (CAR V) (MKBIN1 U (CDR V))))))) 00033550 + 00033560 +(MTP (LAMBDA (V) 00033570 + (OR (NULL V) 00033580 + (AND (MEMBER (CAR V) FRLIS*) 00033590 + (NOT (MEMBER (CAR V) (CDR V))) 00033600 + (MTP (CDR V)))))) 00033610 + 00033620 +(PERMUTATIONS (LAMBDA (*S*) 00033630 + (COND ((NULL *S*) (LIST NIL)) 00033640 + ((NULL (CDR *S*)) (LIST *S*)) 00033650 + (T 00033660 + (MAPCON *S* 00033670 + (FUNCTION 00033680 + (LAMBDA(J) 00033690 + (MAPCONS 00033700 + (PERMUTATIONS (DELETE (CAR J) *S*)) 00033710 + (CAR J))))))))) 00033720 + 00033730 +)) 00033740 + 00033750 +DEFINE (( 00033760 + 00033770 +(EMTCH (LAMBDA (U) 00033780 + (COND ((ATOM U) U) 00033790 + (T ((LAMBDA (X) (COND (X X) (T U))) (OPMTCH U)))))) 00033800 + 00033810 +(OPMTCH (LAMBDA (U) 00033820 + (PROG (X Y) 00033830 + (COND ((NULL SUBFG*) (RETURN NIL))) 00033840 + (SETQ X (GET (CAR U) (QUOTE OPMTCH*))) 00033850 + A (COND ((NULL X) (RETURN NIL)) 00033860 + ((AND (NULL (CAADAR X)) 00033870 + (SETQ Y (MCHARG (CDR U) (CAAR X) (CAR U))) 00033880 + (*EVAL (SUBLIS (CAR Y) (CDADAR X)))) 00033890 + (GO B))) 00033900 + (SETQ X (CDR X)) 00033910 + (GO A) 00033920 + B (RETURN (SUBLIS (CAR Y) (CADDAR X)))))) 00033930 + 00033940 +)) 00033950 + 00033960 +DEFINE (( 00033970 + 00033980 +(ORDER (LAMBDA (U) 00033990 + (PROG NIL 00034000 + (RMSUBS) + A (COND ((NULL U) (RETURN NIL)) 00034010 + ((OR (NOT (ATOM (CAR U))) (NUMBERP (CAR U))) (GO B))) 00034020 + (PUT (CAR U) (QUOTE ORDER) ORDN*) 00034030 + (SETQ ORDN* (ADD1 ORDN*)) 00034040 + B (SETQ U (CDR U)) 00034050 + (GO A)))) 00034060 + 00034070 +(FORMOP (LAMBDA (U) 00034080 + (COND ((ATOM U) U) 00034090 + (T 00034100 + (ADDOF (MULTOP (CAAR U) (FORMOP (CDAR U))) 00034110 + (FORMOP (CDR U))))))) 00034120 + 00034130 +(ADDOF (LAMBDA (U V) 00034140 + (COND ((NULL U) V) 00034150 + ((NULL V) U) 00034160 + ((ATOM U) (CONS (CAR V) (ADDOF U (CDR V)))) 00034170 + ((ATOM V) (ADDOF V U)) 00034180 + ((EQUAL (CAAR U) (CAAR V)) 00034190 + (CONS (CONS (CAAR U) (ADDOF (CDAR U) (CDAR V))) 00034200 + (ADDOF (CDR U) (CDR V)))) 00034210 + ((ORDOP (CAAR U) (CAAR V)) (CONS (CAR U) (ADDOF (CDR U) V))) 00034220 + (T (CONS (CAR V) (ADDOF U (CDR V))))))) 00034230 + 00034240 +(MULTOP (LAMBDA (U V) 00034250 + (COND ((EQ (CAR U) (QUOTE K*)) V) (T (MULTOP1 U V))))) 00034260 + 00034270 +(MULTOP1 (LAMBDA (U V) 00034280 + (COND ((NULL V) NIL) 00034290 + ((OR (ATOM V) (ORDOP U (CAAR V))) (LIST (CONS U V))) 00034300 + (T 00034310 + (CONS (CONS (CAAR V) (MULTOP1 U (CDAR V))) 00034320 + (MULTOP1 U (CDR V))))))) 00034330 + 00034340 +(ORDOP (LAMBDA (U V) 00034350 + (COND ((NULL U) (NULL V)) 00034360 + ((NULL V) NIL) 00034370 + ((AND (MEMBER U FACTORS*) (NOT (MEMBER V FACTORS*))) T) 00034380 + ((AND (MEMBER V FACTORS*) (NOT (MEMBER U FACTORS*))) NIL) 00034390 + ((ATOM U) 00034400 + (COND 00034410 + ((ATOM V) 00034420 + (COND ((NUMBERP U) (AND (NUMBERP V) (NOT (LESSP U V)))) 00034430 + ((NUMBERP V) T) 00034440 + ((ZEROP ORDN*) (ORDERP U V)) 00034445 + (T 00034450 + ((LAMBDA(X Y) 00034460 + (COND ((AND X Y) (LESSP X Y)) 00034470 + (X T) 00034480 + (Y NIL) 00034490 + (T (ORDERP U V)))) 00034500 + (GET U (QUOTE ORDER)) 00034510 + (GET V (QUOTE ORDER)))))) 00034520 + ((MEMBER U FACTORS*) T) 00034530 + (T (NOT (MEMBER (CAR V) FACTORS*))))) 00034540 + ((ATOM V) (MEMBER (CAR U) FACTORS*)) 00034550 + ((EQUAL (CAR U) (CAR V)) (ORDOP (CDR U) (CDR V))) 00034560 + (T (ORDOP (CAR U) (CAR V)))))) 00034570 + 00034580 +(QUOTOF (LAMBDA (P Q) 00034590 + (COND ((NULL P) NIL) 00034600 + ((EQUAL P Q) 1) 00034610 + ((EQUAL Q 1) P) 00034620 + ((NUMB Q) 00034630 + (COND 00034640 + ((NUMB P) 00034650 + (COND ((AND (ATOM P) (ATOM Q)) (MKFR P Q)) 00034660 + ((ATOM P) (MKFR (TIMES P (CADDR Q)) (CADR Q))) + ((ATOM Q) (MKFR (CADR P) (TIMES Q (CADDR P)))) + (T (MKFR (TIMES (CADR P) (CADDR Q)) + (TIMES (CADR Q) (CADDR P)))) )) + (T 00034680 + (CONS (CONS (CAAR P) (QUOTOF (CDAR P) Q)) 00034690 + (QUOTOF (CDR P) Q))))) 00034700 + ((NUMB P) 00034710 + (LIST 00034720 + (CONS (CONS (CAAAR Q) (MINUS (CDAAR Q))) 00034730 + (QUOTOF P (CDARX Q))))) 00034740 + (T 00034750 + ((LAMBDA(X Y) 00034760 + (COND 00034770 + ((EQ (CAR X) (CAR Y)) 00034780 + ((LAMBDA(N W Z) 00034790 + (COND ((ZEROP N) (ADDOF W Z)) 00034800 + (T (CONS (CONS (CONS (CAR Y) N) W) Z)))) 00034810 + (DIFFERENCE (CDR X) (CDR Y)) 00034820 + (QUOTOF (CDAR P) (CDARX Q)) 00034830 + (QUOTOF (CDR P) Q))) 00034840 + ((ORDOP X Y) 00034850 + (CONS (CONS X (QUOTOF (CDAR P) Q)) (QUOTOF (CDR P) Q))) 00034860 + (T 00034870 + (LIST 00034880 + (CONS (CONS (CAR Y) (MINUS (CDR Y))) 00034890 + (QUOTOF P (CDARX Q))))))) 00034900 + (CAAR P) 00034910 + (CAAR Q)))))) 00034920 + 00034930 +)) 00034940 + 00034950 +DEFINE (( 00034960 + 00034970 +(CKRN (LAMBDA (U) 00034980 + (PROG (X) 00034990 + (COND ((KERNLOP U) (RETURN U))) 00035000 + A (SETQ X (CONS (CKRN (CDAR U)) X)) 00035010 + (COND 00035020 + ((NULL (CDR U)) (RETURN (LIST (CONS (CAAR U) (GCK X))))) 00035030 + ((OR (ATOM (CDR U)) (NOT (EQ (CAAAR U) (CAAADR U)))) 00035040 + (RETURN (GCK (CONS (CKRN (CDR U)) X))))) 00035050 + (SETQ U (CDR U)) 00035060 + (GO A)))) 00035070 + 00035080 +(GCK (LAMBDA (U) 00035090 + (COND ((NULL U) 1) 00035100 + ((NULL (CDR U)) (CAR U)) 00035110 + (T (GCK (CONS (GCK1 (CAR U) (CADR U)) (CDDR U))))))) 00035120 + 00035130 +(GCK1 (LAMBDA (U V) 00035140 + (COND ((OR (NULL U) (NULL V)) (ERRACH (QUOTE GCK1))) 00035150 + ((EQUAL U V) U) 00035160 + ((NUMB U) 00035170 + (COND 00035180 + ((NUMB V) 00035190 + (COND ((AND (ATOM U) (ATOM V)) (GCDN U V)) (T 1))) 00035200 + (T (GCK1 U (CDARX V))))) 00035210 + ((NUMB V) (GCK1 (CDARX U) V)) 00035220 + (T 00035230 + ((LAMBDA(X Y) 00035240 + (COND 00035250 + ((EQ (CAR X) (CAR Y)) 00035260 + (LIST 00035270 + (CONS 00035280 + (COND ((GREATERP (CDR X) (CDR Y)) Y) (T X)) 00035290 + (GCK1 (CDARX U) (CDARX V))))) 00035300 + ((ORDOP X Y) (GCK1 (CDARX U) V)) 00035310 + (T (GCK1 U (CDARX V))))) 00035320 + (CAAR U) 00035330 + (CAAR V)))))) 00035340 + 00035350 +)) 00035360 + 00035370 +DEFINE (( 00035380 + 00035390 +(PREPSQ (LAMBDA (U) 00035400 + (COND ((NULL (CAR U)) 0) 00035410 + (T 00035420 + ((LAMBDA(X) 00035430 + (COND 00035440 + ((OR *RAT (AND (NOT *FLOAT) *DIV) UPL* DNL*) 00035450 + (REPLUS (PREPSQ1 (CAR X) NIL (CDR X)))) 00035460 + (T 00035470 + (SQFORM X 00035480 + (FUNCTION 00035490 + (LAMBDA (J) (REPLUS (PREPSQ1 J NIL 1)))))))) 00035500 + (CONS (FORMOP (CAR U)) (FORMOP (CDR U)))))))) 00035510 + 00035520 +(SQFORM (LAMBDA (U *PI*) 00035530 + ((LAMBDA(X Y) 00035540 + (COND ((EQUAL Y 1) X) (T (LIST (QUOTE QUOTIENT) X Y)))) 00035550 + (*PI* (CAR U)) 00035560 + (*PI* (CDR U))))) 00035570 + 00035580 +(PREPSQ1 (LAMBDA (U V W) 00035590 + (PROG (X Y Z) 00035600 + (COND ((NULL U) (RETURN NIL)) 00035610 + ((AND (NOT (ATOM U)) 00035620 + (OR (MEMBER (CAAAR U) FACTORS*) 00035630 + (AND (NOT (ATOM (CAAAR U))) 00035640 + (MEMBER (CAAAAR U) FACTORS*)))) 00035650 + (RETURN 00035660 + (NCONC (PREPSQ1 (CDAR U) (CONS (CAAR U) V) W) 00035670 + (PREPSQ1 (CDR U) V W)))) 00035680 + ((NULL (KERNLP U)) (GO A))) 00035690 + (SETQ U (MKKL V U)) 00035700 + (SETQ V NIL) 00035710 + A (SETQ X (CKRN U)) 00035720 + (COND ((NULL DNL*) (GO A1))) 00035730 + (SETQ Z (CKRN* X DNL*)) 00035740 + (SETQ X (QUOTOF X Z)) 00035750 + (SETQ U (QUOTF U Z)) 00035760 + (SETQ W (QUOTOF W Z)) 00035770 + A1 (SETQ Y (CKRN W)) 00035780 + (COND ((NULL UPL*) (GO A2))) 00035790 + (SETQ Z (CKRN* Y UPL*)) 00035800 + (SETQ Y (QUOTOF Y Z)) 00035810 + (SETQ U (QUOTOF U Z)) 00035820 + (SETQ W (QUOTOF W Z)) 00035830 + A2 (COND ((AND (NULL *DIV) (NULL *FLOAT)) (SETQ Y (GCK1 X Y)))) 00035840 + (SETQ U (MKCANON (CONS (QUOTOF U Y) (QUOTOF W Y)))) 00035850 + (COND ((AND *GCD (ZEROP ORDN*)) (SETQ U (CANCEL U)))) 00035852 + (SETQ X (QUOTOF X Y)) 00035860 + (COND 00035870 + ((AND *ALLFAC (NOT (EQUAL X (CAR U)))) (GO B)) + ((NULL V) (GO D))) 00035890 + (SETQ V (EXCHK V NIL)) 00035900 + (GO C) 00035910 + D (SETQ U (PREPSQ2 U)) 00035920 + (RETURN 00035930 + (COND ((EQCAR U (QUOTE PLUS)) (CDR U)) (T (LIST U)))) 00035940 + B (COND ((AND (EQUAL X 1) (NULL V)) (GO D))) 00035950 + (SETQ U (CONS (QUOTOF (CAR U) X) (CDR U))) 00035960 + (SETQ V (PREPF (MKKL V X))) 00035970 + (COND ((EQUAL U (CONS 1 1)) (RETURN V)) 00035980 + ((EQCAR V (QUOTE TIMES)) (SETQ V (CDR V))) 00035990 + (T (SETQ V (LIST V)))) 00036000 + C (RETURN (LIST (RETIMES (ACONC V (PREPSQ2 U)))))))) 00036010 + 00036020 +(CKRN* (LAMBDA (U V) 00036030 + (COND ((NULL U) (ERRACH (QUOTE CKRN*))) 00036040 + ((ATOM U) 1) 00036050 + ((MEMBER (CAAAR U) V) 00036060 + (LIST (CONS (CAAR U) (CKRN* (CDARX U) V)))) 00036070 + (T (CKRN* (CDARX U) V))))) 00036080 + 00036090 +(UP (LAMBDA (U) 00036100 + (FACTOR1 U T (QUOTE UPL*)))) 00036110 + 00036120 +(DOWN (LAMBDA (U) 00036130 + (FACTOR1 U T (QUOTE DNL*)))) 00036140 + 00036150 +)) 00036160 + 00036170 +DEFLIST (((UP RLIS) (DOWN RLIS)) STAT) 00036180 + 00036190 +DEFINE (( 00036200 + 00036210 +(REPLUS (LAMBDA (U) 00036220 + (COND ((ATOM U) U) 00036230 + ((NULL (CDR U)) (CAR U)) 00036240 + (T (CONS (QUOTE PLUS) U))))) 00036250 + 00036260 +(RETIMES (LAMBDA (U) 00036270 + (PROG (X Y) 00036275 + A (COND ((NULL U) (GO D)) 00036280 + ((NOT (EQCAR (CAR U) (QUOTE MINUS))) (GO B))) 00036285 + (SETQ X (NOT X)) 00036290 + (COND ((EQUAL (CADAR U) 1) (GO C)) 00036295 + (T (SETQ U (CONS (CADAR U) (CDR U))))) 00036300 + B (SETQ Y (CONS (CAR U) Y)) 00036305 + C (SETQ U (CDR U)) 00036310 + (GO A) 00036315 + D (SETQ Y (COND ((NULL Y) 1) 00036320 + ((CDR Y) (CONS (QUOTE TIMES) (REVERSE Y))) 00036325 + (T (CAR Y)))) 00036330 + (RETURN (COND (X (LIST (QUOTE MINUS) Y)) (T Y)))))) 00036335 + 00036350 +(PREPSQ2 (LAMBDA (U) 00036360 + (SQFORM U (FUNCTION PREPF)))) 00036370 + 00036380 +(PREPF (LAMBDA (U) 00036390 + (PROG (X) 00036395 + (COND ((AND (MINUSF U) (SETQ X T)) (SETQ U (MULTN -1 U)))) 00036400 + (SETQ U (REPLUS (PREPF1 U NIL))) 00036405 + (RETURN (COND (X (LIST (QUOTE MINUS) U)) (T U)))))) 00036410 + 00036415 +(PREPF1 (LAMBDA (U V) 00036420 + (COND ((NULL U) NIL) 00036430 + ((NUMB U) 00036440 + (LIST (RETIMES (NUMCONS (MINUSCHK U) (EXCHK V NIL))))) 00036450 + (T 00036460 + (NCONC (PREPF1 (CDAR U) (CONS (CAAR U) V)) 00036470 + (PREPF1 (CDR U) V)))))) 00036480 + 00036490 +(NUMB (LAMBDA (U) 00036500 + (OR (NUMBERP U) (EQCAR U (QUOTE QUOTIENT))))) 00036510 + 00036520 +(NUMCONS (LAMBDA (N V) 00036530 + (COND ((NULL V) (LIST N)) ((EQUAL N 1) V) (T (CONS N V))))) 00036540 + 00036550 +(KERNLOP (LAMBDA (U) 00036560 + (OR (NUMB U) (AND (NULL (CDR U)) (KERNLOP (CDAR U)))))) 00036570 + 00036580 +(EXCHK (LAMBDA (U V) 00036590 + (COND ((NULL U) V) 00036600 + ((ONEP (CDAR U)) (EXCHK (CDR U) (CONS (SQCHK (CAAR U)) V))) 00036610 + (T 00036620 + (EXCHK (CDR U) 00036630 + (CONS (LIST (QUOTE EXPT) (SQCHK (CAAR U)) (CDAR U)) 00036640 + V)))))) 00036650 + 00036660 +(SQCHK (LAMBDA (U) 00036670 + (COND ((ATOM U) ((LAMBDA (X) 00036675 + (COND (X X) (T U))) (GET U (QUOTE NEWNAME)))) 00036680 + ((EQ (CAR U) (QUOTE *SQ)) (PREPSQ (CADR U))) 00036685 + ((AND (EQ (CAR U) (QUOTE EXPT)) (EQUAL (CADDR U) 1)) 00036690 + (CADR U)) 00036695 + ((ATOM (CAR U)) U) 00036700 + (T (PREPF U))))) 00036710 + 00036720 +(MINUSCHK (LAMBDA (U) 00036730 + (COND 00036740 + ((ATOM U) 00036750 + (COND ((MINUSP U) (LIST (QUOTE MINUS) (MINUS U))) (T U))) 00036760 + ((MINUSP (CADR U)) 00036770 + (LIST (QUOTE MINUS) 00036780 + (LIST (QUOTE QUOTIENT) (MINUS (CADR U)) (CADDR U)))) 00036790 + (T U)))) 00036800 + 00036810 +(MKFR (LAMBDA (U V) 00036820 + (COND (*FLOAT (QUOTIENT (PLUS 0.0 U) V)) 00036830 + (T 00036840 + ((LAMBDA(M) 00036850 + ((LAMBDA(N1 N2) 00036860 + (COND ((ONEP N2) N1) 00036870 + (T (LIST (QUOTE QUOTIENT) N1 N2)))) 00036880 + (QUOTIENT U M) 00036890 + (QUOTIENT V M))) 00036900 + (GCDN U V)))))) 00036910 + 00036920 +)) 00036930 + 00036940 +DEFLIST (((*SQ SQPRINT)) SPECPRN) 00036950 + 00036960 +DEFINE (( 00036970 + 00036980 +(SQPRINT (LAMBDA (U) 00036990 + (PROG (Z) 00037000 + (SETQ Z ORIG*) 00037010 + (COND ((LESSP POSN* 20) (SETQ ORIG* POSN*))) 00037020 + (MAPRIN 00037030 + (SETQ *OUTP 00037040 + (COND ((NULL (CAAR U)) 0) (T (PREPSQ (CAR U)))))) 00037050 + (SETQ ORIG* Z)))) 00037060 + 00037070 +(VARPRI (LAMBDA (U V W) 00037080 + (PROG NIL 00037090 + (COND ((NULL V) (RETURN NIL)) 00037100 + (*FORT (GO D)) 00037110 + ((AND (EQUAL V 0) U *NERO) (GO C))) 00037120 + (COND ((NULL W) (TERPRI*))) 00037130 + (COND ((EQCAR V (QUOTE MAT)) (GO M)) ((NULL U) (GO A))) 00037140 + (INPRINT (QUOTE SETQ) (GET (QUOTE SETQ) (QUOTE INFIX)) U) 00037150 + (OPRIN (QUOTE SETQ)) 00037160 + A (MAPRIN V) 00037170 + (COND (W (GO C)) 00037180 + ((AND (NULL *NAT) (NULL *FORT)) (PRINC* **DOLLAR))) 00037190 + C (RETURN V) 00037210 + D (COND ((NULL (OR W (EQ POSN* 0))) (PROG2 (SETQ POSN* 0) + (TERPRI)))) + (COND ((EQ POSN* 0) (SETQ COUNT* 1))) + (SETQ FORTVAR* NIL) + (COND ((OR W (ATOM V) (NOT (EQ POSN* 0))) (GO A))) + (SETQ FORTVAR* (QUOTE ANS)) 00037230 + (COND ((OR (NULL U) (NOT (ATOM (CAR U)))) (GO E))) 00037240 + (SETQ FORTVAR* (CAR U)) 00037250 +E (COND ((GREATERP POSN* 5) (GO A))) 00037260 + (SPACES 6) 00037265 + (SETQ POSN* 6) + (PRINC* FORTVAR*) + (OPRIN (QUOTE EQUAL)) 00037280 + (GO A) 00037290 + M (MATPRI (CDR V) (COND (U (CAR U)) (T NIL))) 00037300 + (GO C)))) 00037310 + 00037320 +)) 00037330 + 00037340 +DEFINE (( 00037350 + 00037360 +(SIMPDF (LAMBDA (U) 00037370 + (PROG (V X Y N) 00037380 + (COND ((NULL SUBFG*) (RETURN (MKSQ (CONS (QUOTE DF) U) 1)))) 00037390 + (SETQ V (CDR U)) 00037400 + (SETQ U (SIMPCAR U)) 00037410 + A (COND ((OR (NULL V) (NULL (CAR U))) (RETURN U))) 00037420 + (SETQ X (COND ((NULL Y) (SIMP (CAR V))) (T Y))) 00037430 + (SETQ Y NIL) 00037440 + (COND 00037450 + ((OR (NULL (KERNP X)) (NOT (ONEP (CDAAAR X)))) (GO E)) 00037460 + ((OR (NULL (CDR V)) 00037470 + (NOT 00037480 + (NUMBERP 00037490 + (SETQ N (PREPSQ (SETQ Y (SIMP (CADR V)))))))) 00037500 + (GO C1))) 00037510 + (SETQ Y NIL) 00037520 + (SETQ V (CDR V)) 00037530 + (SETQ X (CAAAAR X)) 00037540 + C (COND ((ZEROP N) (GO D))) 00037550 + (SETQ U (DIFF1 U X)) 00037560 + (SETQ N (SUB1 N)) 00037570 + (GO C) 00037580 + C1 (SETQ U (DIFF1 U (CAAAAR X))) 00037590 + D (SETQ V (CDR V)) 00037600 + (GO A) 00037610 + E (MESPRI (QUOTE (DIFFERENTIATION WITH RESPECT TO)) 00037620 + (CAR V) 00037630 + (QUOTE (NOT ALLOWED)) 00037640 + NIL 00037650 + T) 00037660 + (SETQ ERFG* T) + (ERROR*)))) 00037670 + 00037680 +(DIFF1 (LAMBDA (U V) 00037690 + (PROG (W X Y Z Z1) 00037700 + (COND 00037710 + ((KERNP (CONS (CDR U) 1)) (SETQ W (CONS (CAAADR U) 1)))) 00037720 + (SETQ X (DIFF2 (CAR U) V)) 00037730 + (SETQ Y 00037740 + (COND ((NULL W) (DIFF2 (CDR U) V)) 00037750 + (T (DIFFK (LIST (CONS W 1)) V)))) 00037760 + (SETQ Z 00037770 + (COND ((NULL (CAR X)) (CONS NIL 1)) 00037780 + (T (CONS (CAR X) (MULTF (CDR X) (CDR U)))))) 00037790 + (COND ((NULL (CAR Y)) (RETURN Z))) 00037800 + (SETQ Z1 00037810 + (NEGSQ 00037820 + (MULTSQ Y 00037830 + (COND ((NULL W) 00037840 + (CONS (CAR U) (NMULTF (CDR U) 2))) 00037850 + (T 00037860 + (CONS (MULTN (CDAADR U) (CAR U)) 00037870 + (MULTF2 W (CDR U)))))))) 00037880 + (RETURN 00037890 + (COND 00037900 + ((AND *EXP *MCD) 00037910 + (CANCEL 00037920 + (CONS (ADDF (MULTF (CAR X) 00037930 + (COND 00037940 + ((NULL W) (MULTF (CDR U) (CDR Y))) 00037950 + (T (MULTF2 W (CDR Y))))) 00037960 + (MULTF (CDR X) (CAR Z1))) 00037970 + (MULTF (CDR X) (CDR Z1))))) 00037980 + (T (ADDSQ Z Z1))))))) 00037990 + 00038000 +(DIFF2 (LAMBDA (U V) 00038010 + (COND ((ATOM U) (CONS NIL 1)) 00038020 + (T 00038030 + (ADDSQ (DIFF2 (CDR U) V) 00038040 + (ADDSQ (MULTS2 (CAAR U) (DIFF2 (CDAR U) V)) 00038050 + (DIFFK U V))))))) 00038060 + 00038070 +(DIFFK (LAMBDA (U *S*) 00038080 + (PROG (V W X Y Z) 00038090 + (SETQ X (CAAR U)) 00038100 + (COND 00038110 + ((AND (EQ (CAR X) *S*) (SETQ X (CONS 1 1))) (GO D)) 00038120 + ((OR (ATOM (CAR X)) 00038130 + (AND (ATOM (CAAR X)) (GET (CAAR X) (QUOTE **ARRAY)))) 00038140 + (RETURN (COND ((AND (SETQ Z (FKERN (CAR X))) 00038150 + (ASSOC (QUOTE REP) (CDDR Z))) 00038151 + (MKSQ (LIST (QUOTE DF) (CAR X) *S*) 1)) 00038152 + (T (CONS NIL 1)))))) 00038153 + (SETQ Y (FKERN (CAR X))) 00038160 + (COND 00038170 + ((AND (SETQ V (ASSOC (QUOTE DFN) (CDDR Y))) 00038180 + (SETQ V (ASSOC *S* (CADR V))) 00038190 + (SETQ X (CDR V))) 00038200 + (GO D)) 00038210 + ((OR (AND (NOT (ATOM (CAAR X))) 00038220 + (SETQ X (NMULTSQ (DIFF2 (CAR X) *S*) (CDR X)))) 00038230 + (AND (EQ (CAAR X) (QUOTE *SQ)) 00038240 + (SETQ X (DIFF1 (CADAR X) *S*)))) 00038250 + (GO B)) 00038260 + ((OR (NOT (SETQ V (GET* (CAAR X) (QUOTE DFN)))) 00038270 + (NOT 00038280 + (DFP (SETQ W 00038290 + (MAPCAR (CDAR X) 00038300 + (FUNCTION 00038310 + (LAMBDA(J) 00038320 + (DIFF1 (SIMP J) *S*))))) 00038330 + V))) 00038340 + (GO H))) 00038350 + (SETQ Z (CDAR X)) 00038360 + (SETQ X (CONS NIL 1)) 00038370 + (COND 00038380 + ((NULL 00038390 + (*EVAL 00038400 + (CONS (QUOTE OR) 00038410 + (MAPCAR W 00038420 + (FUNCTION 00038430 + (LAMBDA(J) 00038440 + (LIST (QUOTE QUOTE) (CAR J)))))))) 00038450 + (GO B))) 00038460 + A (COND ((NULL W) (GO B)) 00038470 + ((CAAR W) 00038480 + (SETQ X 00038490 + (ADDSQ (MULTSQ (CAR W) 00038500 + (SIMP 00038510 + (SUBLIS 00038520 + (PAIR (CAAR V) Z) 00038530 + (CDAR V)))) 00038540 + X)))) 00038550 + (SETQ W (CDR W)) 00038560 + (SETQ V (CDR V)) 00038570 + (GO A) 00038580 + B (COND 00038590 + ((SETQ V (ASSOC (QUOTE DFN) (CDDR Y))) (GO C)) 00038600 + (T (ACONC Y (SETQ V (LIST (QUOTE DFN) NIL))))) 00038610 + (SETQ DSUBL* (CONS (CDR V) DSUBL*)) 00038620 + C (RPLACA (CDR V) (XADD (CONS *S* X) (CADR V) NIL T)) 00038630 + (COND ((NULL (CAR X)) (RETURN X))) 00038640 + D (SETQ U (CAR U)) 00038650 + (SETQ W 00038660 + (COND ((ONEP (CDAR U)) (CDR U)) 00038670 + (T 00038680 + (MULTF2 (GETPOWER (COND (Y Y) 00038690 + (T (FKERN (CAAR U)))) 00038700 + (SUB1 (CDAR U))) 00038710 + (MULTN (CDAR U) (CDR U)))))) 00038720 + (RETURN (CONS (MULTF (CAR X) W) (CDR X))) 00038730 + H (SETQ V 00038740 + (COND 00038750 + ((EQ (CAAR X) (QUOTE DF)) 00038760 + (CONS (CAAR X) (CONS (CADAR X) 00038765 + (ORDAD *S* (CDDAR X))))) 00038770 + (T (LIST (QUOTE DF) (CAR X) *S*)))) 00038780 + (SETQ X 00038790 + (COND ((SETQ W (OPMTCH V)) (SIMP W)) (T (MKSQ V 1)))) 00038800 + (GO B)))) 00038810 + 00038820 +(DFP (LAMBDA (U V) 00038830 + (COND ((NULL U) (NULL V)) 00038840 + ((NULL V) NIL) 00038850 + ((CAAR U) (AND (CAR V) (DFP (CDR U) (CDR V)))) 00038860 + (T (DFP (CDR U) (CDR V)))))) 00038870 + 00038880 +)) 00038890 + 00038900 +DEFINE (( 00038910 + 00038920 +(GCDN (LAMBDA (P Q) 00038930 + (GCDN0 (ABS P) (ABS Q)))) 00038940 + 00038950 +(GCDN0 (LAMBDA (P Q) 00038960 + (COND ((EQUAL P Q) P) 00038970 + (*FLOAT (COND ((GREATERP P Q) Q) (T P))) 00038980 + ((GREATERP Q P) (GCDN1 Q P)) 00038990 + (T (GCDN1 P Q))))) 00039000 + 00039010 +(GCDN1 (LAMBDA (P Q) 00039020 + ((LAMBDA (X) (COND ((ZEROP X) Q) (T (GCDN1 Q X)))) 00039030 + (REMAINDER P Q)))) 00039040 + 00039050 +)) 00039060 + 00039070 +DEFINE (( 00039080 + 00039090 +(QUOTF (LAMBDA (P Q) 00039100 + (COND ((NULL P) NIL) 00039110 + ((EQUAL P Q) 1) 00039120 + ((EQUAL Q 1) P) 00039130 + ((ATOM Q) 00039140 + (COND 00039150 + ((ATOM P) 00039160 + (COND (*FLOAT (TIMES P (RECIP (PLUS 0.0 Q)))) 00039165 + (T ((LAMBDA (Z) 00039170 + (COND ((ZEROP (CDR Z)) (CAR Z)) 00039180 + (T NIL))) 00039200 + (DIVIDE P Q))))) 00039210 + (T (QUOTK (CAAR P) P Q)))) 00039220 + ((ATOM P) NIL) 00039230 + (T 00039240 + ((LAMBDA(X Y) 00039250 + (COND 00039260 + ((EQ (CAR X) (CAR Y)) 00039270 + ((LAMBDA(N) 00039280 + (COND 00039290 + ((NOT (MINUSP N)) 00039300 + ((LAMBDA(W) 00039310 + (COND 00039320 + (W 00039330 + ((LAMBDA(V Y) 00039340 + (COND ((NULL Y) V) 00039350 + (T 00039360 + ((LAMBDA(Z) 00039370 + (COND (Z (APPEND V Z)) (T NIL))) 00039380 + (QUOTF Y Q))))) 00039390 + (COND ((ZEROP N) W) 00039400 + (T (LIST (CONS (MKSP (CAR X) N) W)))) 00039410 + (ADDF P 00039420 + (MULTF 00039430 + (COND ((ZEROP N) Q) 00039440 + (T (MULTF2 (MKSP (CAR X) N) Q))) 00039450 + (MULTN -1 W))))) 00039460 + (T NIL))) 00039470 + (QUOTF (CDAR P) (CDAR Q)))) 00039480 + (T NIL))) 00039490 + (DIFFERENCE (CDR X) (CDR Y)))) 00039500 + ((ORDP X Y) (QUOTK X P Q)) 00039510 + (T NIL))) 00039520 + (CAAR P) 00039530 + (CAAR Q)))))) 00039540 + 00039550 +(QUOTK (LAMBDA (X P Q) 00039560 + ((LAMBDA(W) 00039570 + (COND (W 00039580 + (COND ((NULL (CDR P)) (LIST (CONS X W))) 00039590 + (T 00039600 + ((LAMBDA(Y) 00039610 + (COND (Y (CONS (CONS X W) Y)) (T NIL))) 00039620 + (QUOTF (CDR P) Q))))) 00039630 + (T NIL))) 00039640 + (QUOTF (CDAR P) Q)))) 00039650 + 00039660 +)) 00039670 + 00039680 +DEFINE (( 00039690 + 00039700 +(ABSONE (LAMBDA (U) 00039710 + (AND (NUMBERP U) (ONEP (ABS U))))) 00039720 + 00039730 +(CDARX (LAMBDA (U) 00039740 + (COND ((NULL (CDR U)) (CDAR U)) 00039750 + (T (ERRACH (LIST (QUOTE CDARX) U)))))) 00039760 + 00039770 +)) 00039780 + 00039790 +DEFINE (( 00039800 + 00039810 +(PRMCON (LAMBDA (P) 00039820 + (PROG (X Y Q) 00039830 + (SETQ Q P) 00039840 + (COND ((ATOM P) (ERRACH (LIST (QUOTE PRMCON) P))) 00039850 + ((AND (NULL (CDR P)) (SETQ X (CAR P))) (GO B))) 00039860 + (SETQ Y (CAAAR P)) 00039870 + A (COND 00039880 + ((OR (AND (OR (ATOM Q) (NOT (EQ (CAAAR Q) Y))) 00039890 + (SETQ X (CONS 1 (GCD (REVERSE (CONS Q X)))))) 00039900 + (AND (NULL (CDR Q)) 00039910 + (SETQ X 00039920 + (CONS (CAAR Q) (GCD (CONS (CDAR Q) X)))))) 00039930 + (GO B))) 00039940 + (SETQ X (CONS (CDAR Q) X)) 00039950 + (SETQ Q (CDR Q)) 00039960 + (GO A) 00039970 + B (RETURN 00039980 + (CONS (QUOTF P 00039990 + (COND ((ATOM (CAR X)) (CDR X)) (T (LIST X)))) 00040000 + X))))) 00040010 + 00040020 +(GCD (LAMBDA (L) 00040030 + (COND ((NULL (CDR L)) (CAR L)) 00040040 + ((MEMBER 1 L) 1) 00040050 + (T (GCD (CONS (GCD1 (CAR L) (CADR L)) (CDDR L))))))) 00040060 + 00040070 +(GCD1 (LAMBDA (U V) 00040080 + (COND 00040090 + ((OR (NULL U) (NULL V)) (ERRACH (LIST (QUOTE GCD1) U V))) 00040100 + ((EQUAL U V) U) 00040110 + ((ATOM U) 00040120 + (COND ((ATOM V) (GCDN U V)) 00040130 + (T (GCD (NCONS (CDR V) (LIST U (CDAR V))))))) 00040140 + ((ATOM V) (GCD (NCONS (CDR U) (LIST V (CDAR U))))) 00040150 + (T 00040160 + ((LAMBDA(X Y) 00040170 + (COND ((EQ X Y) 00040180 + (PROG (N W X1 Y1 Z Z1 Z2 Z3) 00040190 + (SETQ X1 (PRMCON U)) 00040200 + (SETQ Y1 (PRMCON V)) 00040210 + (SETQ W 1) 00040220 + (SETQ Z1 (CAR X1)) 00040230 + (SETQ Z2 (CAR Y1)) 00040240 + (COND 00040250 + ((OR (NULL *GCD) (ABSONE Z1) (ABSONE Z2)) 00040260 + (GO A)) 00040270 + ((OR (ATOM Z1) (ATOM Z2)) 00040280 + (ERRACH (LIST (QUOTE GCDK) U V X1 Y1))) 00040290 + ((EQ (CAAAR Z1) (CAAAR Z2)) (GO C))) 00040300 + A (SETQ W (MULTF W (GCD1 (CDDR X1) (CDDR Y1)))) 00040310 + (RETURN 00040320 + (COND 00040330 + ((OR (ATOM (CADR X1)) (ATOM (CADR Y1))) W) 00040340 + ((ORDP (CADR X1) (CADR Y1)) 00040350 + (MULTF2 (CADR Y1) W)) 00040360 + (T (MULTF2 (CADR X1) W)))) 00040370 + C (COND ((ORDP Z1 Z2) (GO D))) 00040380 + (SETQ Z Z1) 00040390 + D1 (SETQ Z1 Z2) 00040400 + (SETQ Z2 Z) 00040410 + D (SETQ Z (REMK Z1 Z2)) 00040420 + (COND (Z (GO G))) 00040430 + (SETQ W (CAR (PRMCON Z2))) 00040440 + (GO A) 00040450 + G (COND ((NULL N) (GO H))) 00040460 + (SETQ Z (QUOTF Z (NMULTF Z3 N))) 00040470 + (COND 00040480 + ((NULL Z) 00040490 + (REDERR 00040500 + (LIST (QUOTE (INTEGER OVERFLOW)) Z3 N)))) 00040510 + H (SETQ N 00040520 + (ADD1 (DIFFERENCE (CDAAR Z1) (CDAAR Z2)))) 00040530 + (SETQ Z3 (CDAR Z2)) 00040540 + (COND 00040550 + ((OR (ATOM Z) 00040560 + (NULL (CDR Z)) 00040570 + (NOT (EQ (CAAAR Z) (CAAAR Z1)))) 00040580 + (GO A))) 00040590 + (GO D1))) 00040600 + ((ORDP X Y) (GCD (CONS V (COEFF U X)))) 00040610 + (T (GCD (CONS U (COEFF V Y)))))) 00040620 + (CAAAR U) 00040630 + (CAAAR V)))))) 00040640 + 00040650 +(COEFF (LAMBDA (U A) 00040660 + (COND ((NULL U) NIL) 00040670 + ((OR (ATOM U) (NOT (EQ (CAAAR U) A))) (LIST U)) 00040680 + (T (CONS (CDAR U) (COEFF (CDR U) A)))))) 00040690 + 00040700 +(REMK (LAMBDA (U V) 00040710 + (REMK1 U V (CAAR V) NIL))) 00040720 + 00040730 +(REMK1 (LAMBDA (U V W Z) 00040740 + (COND 00040750 + ((AND (NOT (ATOM U)) (ORDP (CAAR U) W)) 00040760 + (REMK1 (ADDF (MULTF (CDAR V) U) 00040770 + ((LAMBDA(M X) 00040780 + (COND ((ZEROP M) (MULTN -1 X)) 00040790 + (T 00040800 + (MULTF 00040810 + (LIST (CONS (MKSP (CAAAR U) M) -1)) 00040820 + X)))) 00040830 + (DIFFERENCE (CDAAR U) (CDR W)) 00040840 + (MULTF (CDAR U) V))) 00040850 + V 00040860 + W 00040870 + (MULTF Z (CDAR V)))) 00040880 + ((NULL Z) U) 00040890 + (T (CANCEL (CONS U Z)))))) 00040900 + 00040910 +(REMK* (LAMBDA (U V) 00040920 + (REMK1 U V (CAAR V) 1))) 00040930 + 00040940 +(NMULTF (LAMBDA (U N) 00040950 + (COND ((OR *EXP (KERNLP U)) (NMULTF1 U N)) (T (MKSFP U N))))) 00040960 + 00040970 +(NMULTF1 (LAMBDA (U N) 00040980 + (COND ((ONEP N) U) (T (MULTF U (NMULTF1 U (SUB1 N))))))) 00040990 + 00041000 +)) 00041010 + 00041020 +DEFINE (( 00041030 + 00041040 +(OPERATOR (LAMBDA (U) 00041050 + (PROG NIL 00041060 + (COND 00041070 + ((EQ *MODE (QUOTE SYMBOLIC)) 00041080 + (RETURN (FLAG U (QUOTE OPFN))))) 00041090 + A (COND ((NULL U) (RETURN NIL)) 00041100 + ((OR (NUMBERP (CAR U)) (NOT (ATOM (CAR U)))) 00041110 + (LPRIM* 00041120 + (CONS (CAR U) (QUOTE (CANNOT BE AN OPERATOR))))) 00041130 + ((GET (CAR U) (QUOTE SIMPFN)) 00041140 + (LPRIM* (CONS (CAR U) (QUOTE (ALREADY DEFINED))))) 00041150 + (T (MKOP (CAR U)))) 00041160 + (SETQ U (CDR U)) 00041170 + (GO A)))) 00041180 + 00041190 +(FACTOR (LAMBDA (U) 00041200 + (FACTOR1 U T (QUOTE FACTORS*)))) 00041210 + 00041220 +(FACTOR1 (LAMBDA (U V W) 00041230 + (PROG (X Y) 00041240 + (SETQ Y (GTS W)) 00041250 + A (COND ((NULL U) (GO B)) 00041260 + ((OR (KERNP (SETQ X (SIMPCAR U))) 00041270 + (AND *SUPER (KERNP (SETQ X (MKSFP X 1))))) 00041280 + (GO C)) 00041290 + (T (ERRPRI2 (CAR U)))) 00041300 + (GO D) 00041310 + C (SETQ X (CAAAAR X)) 00041320 + (COND (V (SETQ Y (CONS X Y))) 00041330 + ((NOT (MEMBER X Y)) 00041340 + (MESPRI NIL (CAR U) (QUOTE (NOT FOUND)) NIL NIL)) 00041350 + (T (SETQ Y (DELETE X Y)))) 00041360 + D (SETQ U (CDR U)) 00041370 + (GO A) 00041375 + B (PTS W Y)))) 00041380 + 00041390 +(REMFAC (LAMBDA (U) 00041400 + (FACTOR1 U NIL (QUOTE FACTORS*)))) 00041410 + 00041420 +)) 00041430 + 00041440 +DEFINE (( 00041450 + 00041460 +(FORALLFN* (LAMBDA NIL 00041470 + (FORALLFN (RVLIS)))) 00041480 + 00041490 +(FORALLFN (LAMBDA (U) 00041500 + (PROG (X Y) 00041510 + (SETQ X (MAPCAR U (FUNCTION NEWVAR))) 00041520 + (SETQ Y (PAIR U X)) 00041530 + (SETQ MCOND* (SUBLIS Y MCOND*)) 00041540 + (SETQ FRLIS* (UNION X FRLIS*)) 00041550 + (SETQ X (LIST (COMMAND1 NIL))) 00041560 + (COND (MCOND* (SETQ X (CONS (LIST (QUOTE SETQ) 00041570 + (QUOTE MCOND*) (LIST (QUOTE QUOTE) MCOND*)) X)))) 00041580 + (COND (Y (SETQ X (CONS (LIST (QUOTE SETQ) (QUOTE FRASC*) 00041590 + (LIST (QUOTE QUOTE) Y)) X)))) 00041592 + (RETURN (MKPROG NIL X))))) 00041594 + 00041600 +)) 00041610 + 00041620 +DEFINE (( 00041630 + 00041640 +(LET (LAMBDA (U) 00041650 + (LET0 U NIL))) 00041660 + 00041670 +(LET0 (LAMBDA (U V) 00041680 + (PROG NIL 00041690 + A (COND ((NULL U) (RETURN (SETQ MCOND* (SETQ FRASC* NIL)))) 00041700 + ((OR (NOT (EQCAR (CAR U) (QUOTE EQUAL))) (CDDDAR U)) 00041710 + (ERRPRI2 (CAR U)))) 00041720 + (LET2 (CADAR U) (CAR (CDDAR U)) V T) 00041730 + (SETQ U (CDR U)) 00041740 + (GO A)))) 00041750 + 00041760 +(LET1 (LAMBDA (U V) 00041770 + (LET2 U V NIL T))) 00041780 + 00041790 +(LET2 (LAMBDA (U V W B) 00041800 + (PROG (X Y Z) 00041810 + (SETQ U (SUBLIS FRASC* U)) 00041812 + (SETQ V (SUBLIS FRASC* V)) 00041814 + (COND ((AND FRASC* (EQCAR V (QUOTE *SQ))) 00041816 + (SETQ V (PREPSQ (CADR V))))) 00041818 + A (SETQ X U) 00041820 + (COND ((NUMBERP X) (GO LER1)) 00041840 + ((NOT (ATOM X)) (GO D)) 00041850 + ((AND (SETQ Y (GET X (QUOTE OLDNAME))) 00041860 + (NOT (MEMBER Y (FLATTEN V)))) (LET2 Y V W B))) 00041870 + (COND (B (GO A2))) 00041880 + (REMPROP X (QUOTE NEWNAME)) 00041890 + (REMPROP X (QUOTE OLDNAME)) 00041900 + A2 (COND 00041950 + ((AND (VECTORP X) (VLET X V B)) (RETURN NIL)) 00041960 + ((AND (NULL B) (GET X (QUOTE **ARRAY))) (GO J2)) 00041970 + (W (GO H)) 00041980 + ((MATEXPR V) (GO J))) 00041990 + B1 (SETQ X (SIMP0 X)) 00042000 + C (SETQ X (CAAAR X)) 00042010 + (SETQ Z (FKERN (CAR X))) 00042020 + (COND ((NULL B) (RETURN (RPLACD (CDR Z) NIL))) 00042025 + ((ASSOC (QUOTE USED*) (CDR Z)) (RMSUBS2))) 00042030 + (XADD 00042040 + (COND 00042050 + ((AND (EQUAL V 0) (NOT (EQUAL (CDR X) 1))) 00042060 + (CONS (QUOTE ASYMP) (CDR X))) 00042070 + (T (LIST (QUOTE REP) V (CDR X) NIL))) 00042080 + (CDR Z) 00042090 + (SQCHK (CAR Z)) 00042100 + T) 00042110 + (RPLACW Z (DELASC (QUOTE DFN) Z)) 00042120 + (RETURN NIL) 00042130 + D (COND ((NOT (ATOM (CAR X))) (GO LER2)) 00042140 + ((GET* (CAR X) (QUOTE **ARRAY)) (GO L)) 00042150 + ((EQ (CAR X) (QUOTE DF)) (GO K)) 00042160 + ((NOT (GET* (CAR X) (QUOTE SIMPFN))) (GO LER3)) 00042180 + ((OR W 00042190 + (EQ (CAR X) (QUOTE TIMES)) 00042200 + (XN (FLATTEN (CDR X)) FRLIS*)) 00042210 + (GO H))) 00042220 + (SETQ X (SIMP0 X)) 00042230 + (COND ((NOT (EQUAL (CDR X) 1)) (GO LER1))) 00042240 + E (COND ((NOT (KERNP X)) (GO G)) 00042250 + ((NOT (ONEP (CDAAR X))) 00042260 + (SETQ V (LIST (QUOTE QUOTIENT) V (CDAAR X))))) 00042270 + (GO C) 00042280 + G (COND ((NOT (KERNLP (CAR X))) (GO M))) 00042290 + (SETQ X U) 00042300 + H (RMSUBS) 00042305 + (COND 00042310 + ((OR (NULL 00042320 + (SETQ Y 00042330 + (KERNLP 00042340 + (CAR (SETQ X (SIMP0 X)))))) 00042350 + (NOT (ATOM (CDR X)))) 00042360 + (GO LER2)) 00042370 + ((AND (ONEP Y) (ONEP (CDR X))) (GO H1))) 00042380 + (SETQ V (LIST (QUOTE TIMES) (CDR X) V)) 00042390 + (COND 00042400 + ((NOT (ONEP Y)) 00042410 + (SETQ V (ACONC V (LIST (QUOTE QUOTIENT) 1 Y))))) 00042420 + H1 (SETQ X (KLISTT (CAR X))) 00042430 + (SETQ Y 00042440 + (LIST (CONS W (COND (MCOND* MCOND*) (T T))) 00042450 + V 00042460 + NIL)) 00042470 + (COND 00042480 + ((AND (NULL W) (NULL (CDR X)) (ONEP (CDAR X))) (GO H2))) 00042490 + (RETURN (SETQ MATCH* (XADD (CONS X Y) MATCH* U B))) 00042500 + H2 (SETQ X (CAAR X)) 00042510 + (COND ((NOT (MATEXPR V)) (GO H3)) 00042511 + ((NOT (REDMSG (CAR X) (QUOTE MATRIX) T)) (ERROR*))) 00042512 + (FLAG (LIST (CAR X)) (QUOTE MATFN)) 00042513 + H3 (RETURN (PUT (CAR X) 00042514 + (QUOTE OPMTCH*) 00042530 + (XADD (CONS (CDR X) Y) 00042540 + (GET (CAR X) (QUOTE OPMTCH*)) 00042550 + U B))) 00042560 + J (SETQ MATP* T) 00042590 + (COND ((GET X (QUOTE MATRIX)) (GO J1)) 00042600 + ((NOT (REDMSG X (QUOTE MATRIX) T)) (ERROR*))) 00042610 + (PUT X (QUOTE MATRIX) (QUOTE MATRIX)) 00042620 + J1 (COND ((EQCAR V (QUOTE MAT)) (RETURN (SETM X V))) 00042630 + (T (GO B1))) 00042640 + J2 (REMPROP X (QUOTE MATRIX)) 00042650 + (REMPROP X (QUOTE **ARRAY)) 00042660 + (REMPROP X (QUOTE ARRAY)) + (RETURN NIL) 00042670 + K (COND 00042680 + ((AND (NOT (ATOMLIS (CADR X))) (CDDDR X)) (GO LER1)) 00042690 + ((AND (NOT (GET* (CAADR X) (QUOTE SIMPFN))) 00042700 + (SETQ X (CADR X))) 00042710 + (GO LER3)) 00042720 + ((OR (NOT (FRLP (CDADR X))) 00042730 + (NOT (FRLP (CDDR X))) 00042740 + (NOT (MEMBER (CADDR X) (CDADR X)))) 00042750 + (GO H))) 00042760 + (SETQ Z (POSN (CADDR X) (CDADR X))) 00042770 + (COND 00042780 + ((NOT (GET (CAADR X) (QUOTE DFN))) 00042790 + (PUT (CAADR X) 00042800 + (QUOTE DFN) 00042810 + (NLIST NIL (LENGTH (CDADR X)))))) 00042820 + (COND 00042830 + ((NULL (REPN (GET (CAADR X) (QUOTE DFN)) Z V X)) 00042840 + (GO LER1))) 00042850 + (RETURN NIL) 00042860 + L (COND ((AND (SETQ Z (ASSOC* X (GET (CAR X) (QUOTE KLIST)))) 00042865 + (ASSOC (QUOTE USED*) (CDR Z))) (RMSUBS2))) 00042870 + (SETEL (CONS (CAR X) (MAPCAR (CDR X) (FUNCTION 00042875 + REVAL))) V) 00042880 + (RETURN NIL) 00042890 + M (COND ((NULL *SUPER) (GO LER1))) 00042900 + (SETQ X (CONS (MKSFP (CAR X) 1) 1)) 00042910 + (GO E) 00042920 + LER1 (ERRPRI2 U) 00042930 + (ERROR*) 00042940 + LER2 (ERRPRI1 U) 00042950 + (ERROR*) 00042960 + LER3 (COND ((NOT (REDMSG (CAR X) (QUOTE OPERATOR) T)) (ERROR*))) 00042970 + (MKOP (CAR X)) 00042980 + (GO A)))) 00042990 + 00043000 +(FRLP (LAMBDA (U) 00043010 + (OR (NULL U) (AND (MEMBER (CAR U) FRLIS*) (FRLP (CDR U)))))) 00043020 + 00043030 +(SIMP0 (LAMBDA (U) 00043040 + (PROG (X) 00043050 + (SETQ SUBFG* NIL) 00043060 + (SETQ X (SIMP U)) 00043070 + (SETQ SUBFG* T) 00043080 + (RETURN X)))) 00043090 + 00043100 +(MATCH (LAMBDA (U) 00043220 + (LET0 U T))) 00043230 + 00043240 +(CLEAR (LAMBDA (U) 00043250 + (PROG NIL 00043260 + (RMSUBS) 00043270 + A (COND ((NULL U) (RETURN (SETQ MCOND* (SETQ FRASC* NIL))))) 00043280 + B (LET2 (CAR U) NIL NIL NIL) 00043330 + (SETQ U (CDR U)) 00043340 + (GO A)))) 00043350 + 00043360 +(KLISTT (LAMBDA (U) 00043370 + (COND ((ATOM U) NIL) (T (CONS (CAAR U) (KLISTT (CDARX U))))))) 00043380 + 00043390 +)) 00043400 + 00043410 +DEFINE (( 00043420 + 00043430 +(KERNP (LAMBDA (U) 00043440 + (AND (ATOM (CDR U)) 00043450 + (NOT (ATOM (CAR U))) 00043460 + (NULL (CDAR U)) 00043470 + (ATOM (CDAAR U))))) 00043480 + 00043490 +(KERNLP (LAMBDA (U) 00043500 + (COND ((ATOM U) U) ((NULL (CDR U)) (KERNLP (CDAR U))) (T NIL)))) 00043510 + 00043520 +(RMSUBS (LAMBDA NIL 00043530 + (PROG2 (RMSUBS1) (RMSUBS2)))) 00043531 + 00043532 +(RMSUBS2 (LAMBDA NIL 00043533 + (PROG2 (RPLACA *SQVAR* NIL) (SETQ *SQVAR* (LIST T))))) 00043534 + 00043550 +(RMSUBS1 (LAMBDA NIL 00043560 + (PROG NIL 00043570 + (MAP (APPEND DSUBL* SUBL*) 00043580 + (FUNCTION (LAMBDA (J) (RPLACA (CAR J) NIL)))) 00043590 + (SETQ SUBL* NIL)))) 00043600 + 00043610 +(XADD (LAMBDA (U V W B) 00043620 + (PROG (X) 00043630 + (SETQ X (ASSOC* (CAR U) V)) 00043640 + (COND ((NULL X) (GO C)) ((NULL B) (GO B1))) 00043650 + (RMSUBS1) 00043660 + (RPLACD X (CDR U)) 00043670 + A (RETURN V) 00043680 + B1 (SETQ V (DELETE X V)) 00043690 + (GO A) 00043700 + C (COND ((NULL B) (MESPRI NIL W (QUOTE (NOT FOUND)) NIL NIL)) 00043710 + (T (SETQ V (NCONC V (LIST U))))) 00043720 + (GO A)))) 00043730 + 00043740 +(REPN (LAMBDA (U N V W) 00043750 + (PROG NIL 00043760 + A (COND ((OR (NULL U) (ZEROP N)) (RETURN NIL)) 00043770 + ((NOT (ONEP N)) (GO B)) 00043780 + ((CAR U) (REDEFPRI W))) 00043790 + (RETURN (RPLACA U (CONS (CDADR W) V))) 00043800 + B (SETQ U (CDR U)) 00043810 + (SETQ N (SUB1 N)) 00043820 + (GO A)))) 00043830 + 00043840 +(DENOM (LAMBDA (U) 00043850 + (PROG2 (LET1 U (MK*SQ (CONS (CDR (SIMP *ANS)) 1))) + (SETQ MCOND* (SETQ FRASC* NIL))))) + 00043870 +(NUMER* (LAMBDA (U) + (LET1 U (MK*SQ (CONS (CAR (SIMP *ANS)) 1))))) 00043890 + 00043900 +(ND (LAMBDA (U V) 00043910 + (PROG2 (NUMER* U) (DENOM V)))) + +(NUMER (LAMBDA (U) + (PROG2 (NUMER* U) (SETQ MCOND* (SETQ FRASC* NIL))))) + 00043930 +(SAVEAS (LAMBDA (U) 00043940 + (SETK U *ANS))) 00043950 + 00043960 +(SETK (LAMBDA (U V) 00043970 + (PROG2 (LET1 U 00043980 + (COND 00043990 + ((AND(NOT (ATOM U))(NOT (ATOM V))(XN (CDR U) FRLIS*)) 00044000 + (PREPSQ (CADR V))) 00044010 + (T V))) 00044020 + V))) 00044030 + 00044040 +(TERMS (LAMBDA NIL 00044050 + (PRINTTY 00044060 + (COND 00044070 + ((EQCAR *ANS (QUOTE *SQ)) (TERMS1 (CAADR *ANS))) 00044080 + (T (SCNT *ANS)))))) 00044090 + 00044100 +(TERMS1 (LAMBDA (U) 00044110 + (PROG (N) 00044120 + (SETQ N 0) 00044130 + A (COND ((NULL U) (RETURN N)) ((ATOM U) (RETURN (ADD1 N)))) 00044140 + (SETQ N (PLUS N (TERMS1 (CDAR U)))) 00044150 + (SETQ U (CDR U)) 00044160 + (GO A)))) 00044170 + 00044180 +)) 00044190 + 00044200 +DEFINE (( 00044210 + 00044220 +(ANTISYMMETRIC (LAMBDA (U) 00044230 + (FLAG U (QUOTE ANTISYMMETRIC)))) 00044240 + 00044250 +(SYMMETRIC (LAMBDA (U) 00044260 + (FLAG U (QUOTE SYMMETRIC)))) 00044270 + 00044280 +)) 00044290 + 00044300 +FLAG ((PLUS TIMES CONS) SYMMETRIC) 00044310 + 00044320 +FLAG ((PLUS TIMES) NARY) 00044321 + 00044322 +DEFINE (( 00044330 + 00044340 +(MKCOEFF (LAMBDA (U V) 00044350 + (PROG (W X Y Z) 00044360 + (COND ((NOT (ATOM U)) (SETQ U (REVAL U)))) 00044370 + (SETQ X FACTORS*) 00044380 + (SETQ FACTORS* (LIST U)) 00044390 + (SETQ W 00044400 + (COND 00044410 + ((EQCAR *ANS (QUOTE *SQ)) (CADR *ANS)) 00044420 + (T (SIMP *ANS)))) 00044430 + (SETQ Y (CONS (FORMOP (CAR W)) (FORMOP (CDR W)))) 00044440 + (COND 00044450 + ((NULL (EQUAL (CDR Y) 1)) 00044460 + (LPRIM* (QUOTE (MKCOEFF GIVEN RATIONAL FUNCTION))))) 00044470 + (SETQ W (CDR Y)) 00044480 + (SETQ Y (CAR Y)) 00044490 + A (COND ((OR (ATOM Y) (NOT (EQUAL (CAAAR Y) U))) (GO B))) 00044500 + (SETQ Z 00044510 + (CONS (CONS (CDAAR Y) 00044520 + (PREPSQ (CANCEL (CONS (CDAR Y) W)))) 00044530 + Z)) 00044540 + (SETQ Y (CDR Y)) 00044550 + (GO A) 00044560 + B (COND ((NULL Y) (GO B1))) 00044570 + (SETQ Z (CONS (CONS 0 (PREPSQ (CANCEL (CONS Y W)))) Z)) 00044580 + B1 (COND 00044590 + ((OR (AND (NOT (ATOM V)) (ATOM (CAR V)) 00044595 + (SETQ Y (GET* (CAR V) (QUOTE **ARRAY)))) 00044600 + (AND (ATOM V) 00044605 + (SETQ Y (GET* V (QUOTE **ARRAY))) 00044610 + (NULL (CDR Y)))) 00044615 + (GO G))) 00044630 + (SETQ Y (EXPLODE V)) 00044640 + (SETQ V NIL) 00044650 + C (COND ((NULL Z) (GO D))) 00044660 + (SETQ V 00044670 + (CONS (LIST (QUOTE EQUAL) 00044680 + (COMPRESS (APPEND Y (EXPLODE (CAAR Z)))) 00044690 + (CDAR Z)) 00044700 + V)) 00044710 + (SETQ Z (CDR Z)) 00044720 + (GO C) 00044730 + D (*APPLY (QUOTE LET) (LIST V)) 00044740 + (COND 00044760 + (*MSG 00044770 + (LPRI 00044780 + (NCONC (MAPLIST V (FUNCTION CADAR)) 00044790 + (QUOTE (ARE NON ZERO)))))) 00044800 + E (SETQ FACTORS* X) 00044805 + (RETURN NIL) 00044810 + G (SETQ Z (REVERSE Z)) 00044815 + (COND ((ATOM V) (SETQ V (LIST V (QUOTE *))))) 00044820 + (COND 00044840 + (*MSG 00044850 + (LPRI 00044860 + (APPEND (QUOTE (HIGHEST POWER IS)) (LIST (CAAR Z)))))) 00044870 + (SETQ Y (PAIR (CDR V) Y)) 00044871 + G0 (COND ((AND (MEMBER (QUOTE *) (FLATTEN (CAAR Y))) 00044872 + (SETQ Y (PLUS (CDAR Y) (MINUS (REVAL 00044873 + (SUBST 0 (QUOTE *) (CAAR Y))))))) (GO G1))) 00044874 + (SETQ Y (CDR Y)) 00044875 + (GO G0) 00044876 + G1 (COND 00044877 + ((GREATERP (CAAR Z) Y) (REDERR (QUOTE (ARRAY TOO SMALL))))) 00044890 + H (COND 00044900 + ((OR (NULL Z) (NOT (EQUAL Y (CAAR Z)))) 00044910 + (SETEL (SUBST Y (QUOTE *) V) 0)) 00044915 + (T (PROG2 (SETEL (SUBST Y (QUOTE *) V) (CDAR Z)) 00044920 + (SETQ Z (CDR Z))))) 00044925 + (COND ((ZEROP Y) (GO E))) 00044930 + (SETQ Y (SUB1 Y)) 00044950 + (GO H)))) 00044960 + 00044970 +)) 00044980 + 00044990 + 00045000 +DEFINE (( 00045010 + 00045020 +(WEIGHT (LAMBDA (U) 00045030 + (PROG (X Y) 00045040 + (RMSUBS) 00045050 + A (COND ((NULL U) (RETURN NIL)) 00045060 + ((OR (NOT (EQ (CAAR U) (QUOTE EQUAL))) 00045070 + (NOT (AND (ATOM (CADAR U)) 00045075 + (NOT (NUMBERP (CADAR U))))) 00045080 + (NOT 00045090 + (AND (NUMBERP (CADDAR U)) 00045100 + (FIXP (CADDAR U)) 00045110 + (NOT (MINUSP (CADDAR U)))))) 00045115 + (ERRPRI1 (CAR U)))) 00045120 + (SETQ Y (CADAR U)) 00045125 + (COND ((SETQ X (GET Y (QUOTE OLDNAME))) (GO C))) 00045130 + (SETQ X (NEWVAR Y)) 00045135 + (PUT Y (QUOTE NEWNAME) X) 00045140 + (PUT X (QUOTE OLDNAME) Y) 00045145 + (FLAG (LIST X) (QUOTE WEIGHT)) 00045150 + B (LET2 X 00045155 + (LIST (QUOTE TIMES) 00045160 + Y 00045165 + (LIST (QUOTE EXPT) (QUOTE K*) (CADDAR U))) 00045170 + NIL 00045175 + T) 00045180 + (SETQ U (CDR U)) 00045185 + (GO A) 00045190 + C (COND ((NOT (FLAGP Y (QUOTE WEIGHT))) (ERRPRI1 (CAR U)))) 00045195 + (SETQ Y X) 00045200 + (SETQ X (CADAR U)) 00045205 + (GO B)))) 00045210 + 00045215 +(WTLEVEL (LAMBDA (N) 00045220 + (PROG (X) 00045225 + (SETQ N (REVAL N)) 00045230 + (COND 00045235 + ((NOT (AND (NUMBERP N) (FIXP N) (NOT (MINUSP N)))) 00045240 + (ERRPRI1 N))) 00045245 + (SETQ X (ASSOC (QUOTE ASYMP) (CDDR (FKERN (QUOTE K*))))) 00045250 + (COND ((EQUAL N (CDR X)) (RETURN NIL)) 00045255 + ((NOT (GREATERP N (CDR X))) (RMSUBS2))) 00045260 + (RMSUBS1) 00045265 + (RPLACD X N)))) 00045270 + 00045300 +)) 00045310 + 00045320 +DEFLIST (((WEIGHT RLIS) (WTLEVEL NORLIS)) STAT) 00045330 + 00045340 +LET1 ((EXPT K* 2) 0) 00045350 + 00045360 +COMMENT ((ELEMENTARY FUNCTION PROPERTIES)) 00045370 + 00045380 +DEFLIST (((LOG IDEN) (COS IDEN) (SIN IDEN)) SIMPFN) 00045390 + 00045400 +DEFLIST (( 00045410 + (LOG (((LOG E) (((LOG E) . 1)) (REP 1 1 NIL)) 00045420 + ((LOG 1) (((LOG 1) . 1)) (REP 0 1 NIL)))) 00045430 + (COS (((COS 0) (((COS 0) . 1)) (REP 1 1 NIL)))) 00045440 + (SIN (((SIN 0) (((SIN 0) . 1)) (REP 0 1 NIL)))) 00045450 +) KLIST) 00045460 + 00045470 +DEFLIST (( 00045480 + (EXPT (((X Y) TIMES Y (EXPT X (PLUS Y (MINUS 1)))) 00045490 + ((X Y) TIMES (LOG X) (EXPT X Y)))) 00045500 +(LOG (((X) QUOTIENT 1 X))) 00045510 +(COS (((X) MINUS (SIN X)))) 00045520 +(SIN (((X) COS X))) 00045530 +) DFN) 00045540 + 00045550 +DEFLIST (( 00045560 + (COS ((((MINUS ***X)) (NIL . T) (COS ***X) NIL))) 00045570 + (SIN ((((MINUS ***X)) (NIL . T) (MINUS (SIN ***X)) NIL))) 00045580 +) OPMTCH*) 00045590 + 00045600 +PTS (FRLIS* (***X)) 00045610 + 00045620 +DEFINE (( 00045630 + 00045640 +(MSIMP (LAMBDA (U V) 00045650 + (PROG (X Y Z) 00045660 + (COND ((AND (NULL V) SUBFG*) (SETQ U (SUBLIS VREP* U)))) 00045670 + (SETQ U (MSIMP1 U V)) 00045680 + A1 (COND ((NULL U) (RETURN Z))) 00045690 + A0 (SETQ X (CAR U)) 00045700 + A (COND ((AND V (NULL X)) (GO D)) 00045710 + ((NULL X) (GO NULLU)) 00045720 + ((OR (AND (NULL V) (VECTORP (CAR X))) 00045730 + (AND V (MATP (CAR X)))) 00045740 + (GO B))) 00045750 + BACK (SETQ X (CDR X)) 00045760 + (GO A) 00045770 + B (SETQ Y (LIST (CAR X))) 00045780 + (SETQ X (CDR X)) 00045790 + C (COND ((NULL X) (GO D)) 00045800 + ((AND (NULL V) (VECTORP (CAR X))) 00045810 + (REDERR 00045820 + (APPEND (QUOTE (REDUNDANT VECTOR)) (LIST (CAR U))))) 00045830 + ((AND V (MATP (CAR X))) (SETQ Y (ACONC Y (CAR X))))) 00045840 + (SETQ X (CDR X)) 00045850 + (GO C) 00045860 + D (SETQ X (SETDIFF (CAR U) Y)) 00045870 + (SETQ Z 00045880 + (ADDM1 (CONS (COND ((NULL X) (CONS 1 1)) 00045890 + (T (SIMPTIMES X))) 00045900 + (REVERSE Y)) 00045910 + Z)) 00045920 + (SETQ U (CDR U)) 00045930 + (GO A1) 00045940 + E (VECTOR (LIST (CAAR U))) 00045950 + (GO A0) 00045960 + NULLU 00045970 + (COND 00045980 + ((AND (ATOM (CAAR U)) 00045990 + (NOT (NUMBERP (CAAR U))) 00046000 + (REDMSG (CAAR U) (QUOTE VECTOR) T)) 00046010 + (GO E)) 00046020 + (T 00046030 + (REDERR 00046040 + (APPEND (QUOTE (MISSING VECTOR)) (LIST (CAR U)))))) 00046050 + (GO BACK)))) 00046060 + 00046070 +(MSIMP1 (LAMBDA (U1 *S*) ((LAMBDA (U) 00046080 + (COND ((NUMBERP U) (LIST (LIST U))) 00046090 + ((ATOM U) 00046100 + ((LAMBDA(X) 00046110 + (COND ((AND X SUBFG* (EQUAL (CADDR X) 1)) 00046115 + (MSIMP1 (CADR X) *S*)) 00046120 + (T 00046130 + (PROG2 00046140 + (COND ((NULL *S*) (FLAG (LIST U) (QUOTE USED*))) 00046150 + (T NIL)) 00046160 + (LIST (LIST U)))))) 00046170 + (ASSOC (QUOTE REP) (CDDR (FKERN U))))) 00046180 + ((EQ (CAR U) (QUOTE PLUS)) 00046190 + (MAPCON (CDR U) 00046200 + (FUNCTION (LAMBDA (J) (MSIMP1 (CAR J) *S*))))) 00046210 + ((EQ (CAR U) (QUOTE MINUS)) 00046220 + (MSIMPTIMES (LIST -1 (CARX (CDR U))) *S*)) 00046230 + ((EQ (CAR U) (QUOTE TIMES)) (MSIMPTIMES (CDR U) *S*)) 00046240 + ((EQ (CAR U) (QUOTE QUOTIENT)) 00046241 + (MSIMPTIMES (LIST (CADR U) 00046242 + (LIST (QUOTE RECIP) (CARX (CDDR U)))) 00046243 + *S*)) 00046244 + ((OR (NULL *S*) (EQCAR U (QUOTE MAT)) (NOT (MATEXPR U))) 00046250 + (LIST (LIST U))) 00046260 + ((EQ (CAR U) (QUOTE RECIP)) (MSIMPRS (CARX (CDR U)) NIL)) 00046270 + ((EQ (CAR U) (QUOTE SOLVE)) 00046280 + (MSIMPRS (CADR U) (MATSIMP (MSIMP (CADDR U) T)))) 00046290 + (T 00046340 + ((LAMBDA(Z) 00046350 + (COND 00046360 + ((OR (NOT (EQ (CAR U) (QUOTE EXPT))) 00046370 + (NOT (NUMBERP Z)) 00046380 + (NOT (FIXP Z))) 00046390 + (REDERR (QUOTE (MATRIX SYNTAX)))) 00046400 + ((MINUSP Z) 00046410 + (MSIMPRS 00046420 + (CONS (QUOTE TIMES) (NLIST (CADR U) (MINUS Z))) NIL)) 00046430 + (T (MSIMPTIMES (NLIST (CADR U) Z) T)))) 00046440 + ((LAMBDA(Y) 00046450 + (COND 00046460 + ((AND (EQCAR Y (QUOTE MINUS)) (NUMBERP (CADR Y))) 00046470 + (MINUS (CADR Y))) 00046480 + (T Y))) 00046490 + (REVAL (CADDR U))))))) (EMTCH U1)))) 00046500 + 00046510 +(MSIMPTIMES (LAMBDA (U V) 00046520 + (COND ((NULL U) (ERRACH (QUOTE MSIMPTIMES))) 00046530 + ((NULL (CDR U)) (MSIMP1 (CAR U) V)) 00046540 + (T 00046550 + ((LAMBDA(*S*) 00046560 + (MAPCON (MSIMPTIMES (CDR U) V) 00046570 + (FUNCTION 00046580 + (LAMBDA(*S1*) 00046590 + (MAPCAR *S* 00046600 + (FUNCTION 00046610 + (LAMBDA(K) 00046620 + (APPEND (CAR *S1*) K)))))))) 00046630 + (MSIMP1 (CAR U) V)))))) 00046640 + 00046650 +(ADDM1 (LAMBDA (U V) 00046660 + (COND ((NULL V) (LIST U)) 00046670 + ((EQUAL (CDR U) (CDAR V)) 00046680 + ((LAMBDA(X) 00046690 + (COND ((NULL (CAR X)) (CDR V)) 00046700 + (T (CONS (CONS X (CDR U)) (CDR V))))) 00046710 + (ADDSQ (CAR U) (CAAR V)))) 00046720 + ((ORDP (CDR U) (CDAR V)) (CONS U V)) 00046730 + (T (CONS (CAR V) (ADDM1 U (CDR V))))))) 00046740 + 00046750 +)) 00046760 + 00046770 +DEFINE (( 00046780 + 00046790 +(MATP (LAMBDA (U) 00046800 + (COND ((ATOM U) (FLAGP** U (QUOTE MATRIX))) 00046810 + (T (EQCAR U (QUOTE MAT)))))) 00046820 + 00046830 +(MATEXPR (LAMBDA (U) 00046840 + (AND MATP* (MATEXPR1 U)))) 00046850 + 00046860 +(MATEXPR1 (LAMBDA (U) 00046870 + (COND ((NULL U) NIL) 00046880 + ((ATOM U) (MATP U)) 00046890 + ((MEMBER (CAR U) (QUOTE (*SQ DET TRACE))) NIL) 00046900 + ((OR (FLAGP** (CAR U) (QUOTE MATFN)) (MATEXPR1 (CADR U))) T) 00046910 + (T 00046920 + (*EVAL 00046930 + (CONS (QUOTE OR) (MAPCAR (CDR U) (FUNCTION MATEXPR1)))))))) 00046940 + 00046950 +)) 00046960 + 00046970 +FLAG ((MAT) MATFN) 00046971 + 00046972 +DEFINE (( 00046980 + 00046990 +(MATSM (LAMBDA (U) 00047000 + ((LAMBDA(X) 00047010 + (COND 00047020 + ((AND (NULL (CDR X)) (NULL (CDAR X))) (SIMP (CAAR X))) 00047030 + (T (CONS (QUOTE MAT) X)))) 00047040 + (MAPC2 (MATSIMP (MSIMP U T)) 00047050 + (FUNCTION (LAMBDA (J) (MK*SQ (SUBS2 J)))))))) 00047060 + 00047070 +)) 00047080 + 00047090 +DEFINE (( 00047100 + 00047110 +(MATSIMP (LAMBDA (U) 00047120 + (PROG (X) 00047130 + (SETQ X (SMMULT (CAAR U) (MMULT (CDAR U)))) 00047140 + A (SETQ U (CDR U)) 00047150 + (COND ((NULL U) (RETURN X))) 00047160 + (SETQ X (MADD X (SMMULT (CAAR U) (MMULT (CDAR U))))) 00047170 + (GO A)))) 00047180 + 00047190 +(MMULT (LAMBDA (U) 00047200 + (PROG (Y Z) 00047210 + (SETQ Y (GETM* (CAR U))) 00047220 + A (SETQ U (CDR U)) 00047230 + (COND ((NULL U) (RETURN Y))) 00047240 + (SETQ Z (GETM* (CAR U))) 00047250 + (COND 00047260 + ((NOT (EQUAL (LENGTH (CAR Y)) (LENGTH Z))) 00047270 + (REDERR (QUOTE (MATRIX MISMATCH))))) 00047280 + (SETQ Y (MULTM Y Z)) 00047290 + (GO A)))) 00047300 + 00047310 +(SMMULT (LAMBDA (*S* V) 00047320 + (COND ((EQUAL *S* (CONS 1 1)) V) 00047330 + (T (MAPC2 V (FUNCTION (LAMBDA (J) (MULTSQ *S* J)))))))) 00047340 + 00047350 +(GETM* (LAMBDA (U) 00047360 + (COND ((EQCAR U (QUOTE MAT)) (SIMPDET* (CDR U))) 00047370 + (T 00047380 + ((LAMBDA(X) 00047390 + (COND 00047400 + ((OR (NULL X) (EQ X (QUOTE MATRIX))) 00047410 + (REDERR 00047420 + (CONS (QUOTE MATRIX) (CONS U (QUOTE (NOT SET)))))) 00047430 + (T (MLIST U (CAR X) (CADR X))))) 00047440 + (COND ((ATOM U) (GET U (QUOTE MATRIX))) (T NIL))))))) 00047450 + 00047460 +(MLIST (LAMBDA (U M N) 00047470 + (PROG (M1 N1 X Y Z) 00047480 + (SETQ M1 M) 00047490 + A (SETQ Y NIL) 00047500 + (SETQ N1 N) 00047510 + B (COND 00047520 + ((NULL (SETQ X (GETEL (LIST U M1 N1)))) 00047530 + (REDERR (CONS U (CONS (LIST M1 N1) (QUOTE (NOT SET))))))) 00047540 + (SETQ Y (CONS (SIMP X) Y)) 00047550 + (SETQ N1 (SUB1 N1)) 00047560 + (COND ((NOT (ZEROP N1)) (GO B))) 00047570 + (SETQ Z (CONS Y Z)) 00047580 + (SETQ M1 (SUB1 M1)) 00047590 + (COND ((ZEROP M1) (RETURN Z))) 00047600 + (GO A)))) 00047610 + 00047620 +)) 00047630 + 00047640 +DEFINE (( 00047650 + 00047660 +(MADD (LAMBDA (U V) 00047670 + (MAPCAR (PAIR U V) 00047680 + (FUNCTION (LAMBDA (J) (MADD1 (CAR J) (CDR J))))))) 00047690 + 00047700 +(MADD1 (LAMBDA (U V) 00047710 + (COND ((NULL U) NIL) 00047720 + (T (CONS (ADDSQ (CAR U) (CAR V)) (MADD1 (CDR U) (CDR V))))))) 00047730 + 00047740 +)) 00047750 + 00047760 +DEFLIST (((MATRIX RLIS)) STAT) 00047770 + 00047780 +DEFINE (( 00047790 + 00047800 +(MATRIX (LAMBDA (U) 00047810 + (PROG NIL 00047820 + (SETQ MATP* T) 00047830 + A (COND ((NULL U) (RETURN NIL)) 00047840 + ((ATOM (CAR U)) 00047850 + (PUT (CAR U) 00047860 + (QUOTE MATRIX) 00047870 + ((LAMBDA (X) (COND (X X) (T (QUOTE MATRIX)))) 00047880 + (GET* (CAR U) (QUOTE **ARRAY))))) 00047890 + (T 00047900 + (PROG2 (*APPLY (QUOTE AARRAY) (LIST (LIST (CAR U)))) 00047910 + (PUT (CAAR U) (QUOTE MATRIX) 00047915 + (MAPCAR (CDAR U) (FUNCTION REVAL)))))) 00047920 + (SETQ U (CDR U)) 00047930 + (GO A)))) 00047940 + 00047950 +)) 00047960 + 00047970 +DEFINE (( 00047980 + 00047990 +(MULTM (LAMBDA (U *S*) 00048000 + (MAPCAR U 00048010 + (FUNCTION 00048020 + (LAMBDA (J) (MULTM1 J *S* (LENGTH (CAR *S*)) NIL)))))) 00048030 + 00048040 +(MULTM1 (LAMBDA (U V N W) 00048050 + (COND ((ZEROP N) W) 00048060 + (T (MULTM1 U V (SUB1 N) (CONS (MELEM U V N) W)))))) 00048070 + 00048080 +(MELEM (LAMBDA (U V N) 00048090 + (COND ((NULL U) (CONS NIL 1)) 00048100 + (T 00048110 + ((LAMBDA (X) (COND ((NULL (CAR X)) (CONS NIL 1)) (T X))) 00048120 + (ADDSQ (MULTSQ (CAR U) (NTH (CAR V) N)) 00048130 + (MELEM (CDR U) (CDR V) N))))))) 00048140 + 00048150 +)) 00048160 + 00048170 +DEFINE (( 00048180 + 00048190 +(MATPRI (LAMBDA (U X) 00048200 + (PROG (V M N) 00048210 + (SETQ M 1) 00048220 + (COND ((NULL X) (SETQ X (QUOTE MAT)))) 00048230 + A (COND ((NULL U) (RETURN NIL))) 00048240 + (SETQ N 1) 00048250 + (SETQ V (CAR U)) 00048260 + B (COND ((NULL V) (GO C)) 00048270 + ((AND (EQUAL (CAR V) 0) *NERO) (GO B1))) 00048280 + (MAPRIN (LIST X M N)) 00048290 + (OPRIN (QUOTE EQUAL)) 00048350 + (SETQ ORIG* POSN*) 00048360 + (MATHPRINT (CAR V)) 00048370 + (SETQ ORIG* 0) 00048380 + (TERPRI*) 00048390 + B1 (SETQ V (CDR V)) 00048400 + (SETQ N (ADD1 N)) 00048410 + (GO B) 00048420 + C (SETQ U (CDR U)) 00048430 + (SETQ M (ADD1 M)) 00048440 + (GO A)))) 00048450 + 00048460 +)) 00048470 + 00048480 +DEFINE (( 00048490 + 00048500 +(SETM (LAMBDA (U V) 00048510 + (PROG (N M X Y) 00048520 + (SETQ V (CDR V)) 00048530 + (SETQ Y (LIST (LENGTH V) (LENGTH (CAR V)))) 00048540 + (COND 00048550 + ((NOT (EQ (SETQ X (GET U (QUOTE MATRIX))) (QUOTE MATRIX))) 00048560 + (GO A))) 00048570 + (*APPLY (QUOTE AARRAY) (LIST (LIST (CONS U Y)))) 00048580 + (PUT U (QUOTE MATRIX) Y) 00048590 + (GO A1) 00048600 + A (COND 00048610 + ((NOT (EQUAL X Y)) (REDERR (QUOTE (MATRIX MISMATCH))))) 00048620 + A1 (SETQ M 1) 00048630 + B (SETQ Y (CAR V)) 00048640 + (SETQ N 1) 00048650 + C (COND ((NULL Y) (GO D))) 00048660 + (SETEL (LIST U M N) (CAR Y)) 00048670 + (SETQ N (ADD1 N)) 00048680 + (SETQ Y (CDR Y)) 00048690 + (GO C) 00048700 + D (SETQ V (CDR V)) 00048710 + (COND ((NULL V) (RETURN NIL))) 00048720 + (SETQ M (ADD1 M)) 00048730 + (GO B)))) 00048740 + 00048750 +)) 00048760 + 00048770 +DEFINE (( 00048780 + 00048790 +(MSIMPRS (LAMBDA (U V) 00048800 + ((LAMBDA(X) 00048810 + (LIST 00048820 + (LIST 00048830 + (CONS (QUOTE MAT) 00048840 + (MAPC2 00048850 + (COND 00048860 + ((AND (NULL (CDR X)) (NULL V)) 00048870 + (SMMULT (REVPR (CAAR X)) 00048880 + (*MATINV (MMULT (CDAR X)) NIL))) 00048890 + (T (*MATINV (MATSIMP X) V))) 00048900 + (FUNCTION MK*SQ)))))) 00048910 + (MSIMP U T)))) 00048920 + 00048930 +)) 00048940 + 00048950 +DEFINE (( 00048960 + 00048970 +(AUGMENT (LAMBDA (U V) 00048980 + (COND ((NULL U) NIL) 00048990 + (T 00049000 + (CONS (APPEND (CAR U) (CAR V)) (AUGMENT (CDR U) (CDR V)))))) 00049010 +) 00049020 + 00049030 +)) 00049040 + 00049050 +DEFINE (( 00049060 + 00049070 +(SETMATELEM (LAMBDA (U I J ELEM) 00049080 + (PROG (A) 00049090 + (SETQ A (NTH U I)) 00049100 + LOOP (COND ((EQUAL J 1) (RETURN (RPLACA A ELEM)))) 00049110 + (SETQ J (SUB1 J)) 00049120 + (SETQ A (CDR A)) 00049130 + (GO LOOP)))) 00049140 + 00049150 +)) 00049160 + 00049170 +DEFINE (( 00049180 + 00049190 +(LIPSON (LAMBDA (U M N V) 00049200 + (PROG (AA AA1 K K1 K2 I J TEMP BB C0 CI1 CI2 AAK) 00049210 + (SETQ AA (CONS 1 1)) 00049220 + (SETQ K 2) 00049230 + BEG (SETQ K1 (SUB1 K)) 00049240 + (SETQ K2 (SUB1 K1)) 00049250 + (COND ((GREATERP K M) (GO FB)) ((EQUAL K 2) (GO PIVOT))) 00049260 + (SETQ AA (REVPR (NTH (NTH U K2) K2))) 00049270 + PIVOT 00049280 + (SETQ AA1 (NTH (NTH U K1) K1)) 00049290 + (COND ((NULL (EQUAL AA1 (CONS NIL 1))) (GO L2))) 00049300 + (SETQ I K) 00049310 + L (COND ((GREATERP I M) (GO SING)) 00049320 + ((EQUAL (NTH (NTH U I) K1) (CONS NIL 1)) (GO L1))) 00049330 + (SETQ J K1) 00049340 + L0 (COND ((GREATERP J N) (GO PL2))) 00049350 + (SETQ TEMP (NTH (NTH U I) J)) 00049360 + (SETMATELEM U I J (NEGSQ (NTH (NTH U K1) J))) 00049370 + (SETMATELEM U K1 J TEMP) 00049380 + (SETQ J (ADD1 J)) 00049390 + (GO L0) 00049400 + L1 (SETQ I (ADD1 I)) 00049410 + (GO L) 00049420 + PL2 (SETQ AA1 (NTH (NTH U K1) K1)) 00049430 + L2 (SETQ I K) 00049440 + L2A (COND ((GREATERP I M) (GO SING))) 00049450 + (SETQ BB 00049460 + (ADDSQ (MULTSQ AA1 (NTH (NTH U I) K)) 00049470 + (NEGSQ 00049480 + (MULTSQ (NTH (NTH U K1) K) 00049490 + (NTH (NTH U I) K1))))) 00049500 + (COND ((EQUAL BB (CONS NIL 1)) (GO L2B))) 00049510 + (GO L3) 00049520 + L2B (SETQ I (ADD1 I)) 00049530 + (GO L2A) 00049540 + L3 (SETQ C0 (MULTSQ BB AA)) 00049550 + (COND ((EQUAL K M) (GO EV)) ((EQUAL I K) (GO COMP))) 00049560 + (SETQ J K1) 00049570 + L3A (COND ((GREATERP J N) (GO COMP))) 00049580 + (SETQ TEMP (NTH (NTH U I) J)) 00049590 + (SETMATELEM U I J (NEGSQ (NTH (NTH U K) J))) 00049600 + (SETMATELEM U K J TEMP) 00049610 + (SETQ J (ADD1 J)) 00049620 + (GO L3A) 00049630 + COMP (SETQ I (ADD1 K)) 00049640 + (SETQ AAK (NTH (NTH U K) K)) 00049650 + COMP1 00049660 + (COND ((GREATERP I M) (GO EV))) 00049670 + (SETQ CI1 00049680 + (MULTSQ (ADDSQ (MULTSQ (NTH (NTH U K1) K) 00049690 + (NTH (NTH U I) K1)) 00049700 + (NEGSQ (MULTSQ AA1 (NTH (NTH U I) K)))) 00049710 + AA)) 00049720 + (SETQ CI2 00049730 + (MULTSQ (ADDSQ (MULTSQ (NTH (NTH U K) K1) 00049740 + (NTH (NTH U I) K)) 00049750 + (NEGSQ 00049760 + (MULTSQ AAK (NTH (NTH U I) K1)))) 00049770 + AA)) 00049780 + (SETQ J (ADD1 K)) 00049790 + COMP2 00049800 + (COND ((GREATERP J N) (GO COMP3))) 00049810 + (SETMATELEM U 00049820 + I 00049830 + J 00049840 + (MULTSQ 00049850 + (ADDSQ (MULTSQ (NTH (NTH U I) J) C0) 00049860 + (ADDSQ 00049870 + (MULTSQ (NTH (NTH U K) J) CI1) 00049880 + (MULTSQ (NTH (NTH U K1) J) CI2))) 00049890 + AA)) 00049900 + (SETQ J (ADD1 J)) 00049910 + (GO COMP2) 00049920 + COMP3 00049930 + (SETQ I (ADD1 I)) 00049940 + (GO COMP1) 00049950 + EV (SETMATELEM U K K C0) 00049960 + (SETQ J (ADD1 K)) 00049970 + EV1 (COND ((GREATERP J N) (GO BOT))) 00049980 + (SETMATELEM U 00049990 + K 00050000 + J 00050010 + (MULTSQ (ADDSQ (MULTSQ AA1 (NTH (NTH U K) J)) 00050020 + (NEGSQ 00050030 + (MULTSQ 00050040 + (NTH (NTH U K) K1) 00050050 + (NTH (NTH U K1) J)))) 00050060 + AA)) 00050070 + (SETQ J (ADD1 J)) 00050080 + (GO EV1) 00050090 + BOT (SETQ K (ADD1 (ADD1 K))) 00050100 + (GO BEG) 00050110 + FB (COND ((EQUAL (NTH (NTH U M) M) (CONS NIL 1)) (GO SING))) 00050120 + (RETURN U) 00050130 + SING (COND 00050140 + ((NULL V) 00050150 + (RETURN (PROG2 (SETMATELEM U N N (CONS NIL 1)) U)))) 00050160 + (REDERR (QUOTE (SINGULAR MATRIX)))))) 00050170 + 00050180 +)) 00050190 + 00050200 +DEFINE (( 00050210 + 00050220 +(BACKSUB (LAMBDA (U M N) 00050230 + (PROG (DET IJ I J JJ SUM) 00050240 + (SETQ DET (NTH (NTH U M) M)) 00050250 + (SETQ J (ADD1 M)) 00050260 + ROWM (COND ((GREATERP J N) (GO ROWS))) 00050270 + (SETMATELEM U 00050280 + M 00050290 + J 00050300 + (CANCEL (MULTSQ (NTH (NTH U M) J) (REVPR DET)))) 00050310 + (SETQ J (ADD1 J)) 00050320 + (GO ROWM) 00050330 + ROWS (SETQ IJ 1) 00050340 + ROWS1 00050350 + (COND ((GREATERP IJ (SUB1 M)) (GO DONE))) 00050360 + (SETQ I (DIFFERENCE M IJ)) 00050370 + (SETQ JJ (ADD1 M)) 00050380 + ROWS2 00050390 + (COND ((GREATERP JJ N) (GO ROWS5))) 00050400 + (SETQ J (ADD1 I)) 00050410 + (SETQ DET (NTH (NTH U I) I)) 00050420 + (SETQ SUM (CONS NIL 1)) 00050430 + ROWS3 00050440 + (COND ((GREATERP J M) (GO ROWS4))) 00050450 + (SETQ SUM 00050460 + (ADDSQ SUM 00050470 + (CANCEL (MULTSQ (NTH (NTH U I) J) (NTH (NTH U J) JJ))))) 00050480 + (SETQ J (ADD1 J)) 00050490 + (GO ROWS3) 00050500 + ROWS4 00050510 + (SETMATELEM U 00050520 + I 00050530 + JJ 00050540 + (CANCEL 00050550 + (MULTSQ (ADDSQ (NTH (NTH U I) JJ) (NEGSQ SUM)) 00050560 + (REVPR DET)))) 00050570 + (SETQ JJ (ADD1 JJ)) 00050580 + (GO ROWS2) 00050590 + ROWS5 00050600 + (SETQ IJ (ADD1 IJ)) 00050610 + (GO ROWS1) 00050620 + DONE (RETURN U)))) 00050630 + 00050640 +)) 00050650 + 00050660 +DEFINE (( 00050670 + 00050680 +(RHSIDE (LAMBDA (U M) 00050690 + (COND ((NULL U) NIL) 00050700 + (T (CONS (RHSIDE1 (CAR U) M) (RHSIDE (CDR U) M)))))) 00050710 + 00050720 +)) 00050730 + 00050740 +DEFINE (( 00050750 + 00050760 +(RHSIDE1 (LAMBDA (U M) 00050770 + (PROG NIL 00050780 + A (COND ((EQUAL M 0) (RETURN U))) 00050790 + (SETQ U (CDR U)) 00050800 + (SETQ M (SUB1 M)) 00050810 + (GO A)))) 00050820 + 00050830 +)) 00050840 + 00050850 +DEFINE (( 00050860 + 00050870 +(GENERATEIDENT (LAMBDA (N) 00050880 + (PROG (I K U V) 00050890 + (SETQ I 1) 00050900 + (SETQ V NIL) 00050910 + E (COND ((GREATERP I N) (GO A))) 00050920 + (SETQ U NIL) 00050930 + (SETQ K 1) 00050940 + C (COND ((GREATERP K N) (GO D)) ((EQUAL K I) (GO B))) 00050950 + (SETQ U (CONS (CONS NIL 1) U)) 00050960 + (SETQ K (ADD1 K)) 00050970 + (GO C) 00050980 + B (SETQ U (CONS (CONS 1 1) U)) 00050990 + (SETQ K (ADD1 K)) 00051000 + (GO C) 00051010 + D (SETQ I (ADD1 I)) 00051020 + (SETQ V (CONS U V)) 00051030 + (GO E) 00051040 + A (RETURN V)))) 00051050 + 00051060 +(*MATINV (LAMBDA (U V) 00051070 + (PROG (A B M N X) 00051080 + (SETQ A U) 00051090 + (SETQ X SUBFG*) 00051092 + (SETQ SUBFG* NIL) 00051094 + (SETQ M (LENGTH A)) 00051100 + (SETQ N (LENGTH (CAR A))) 00051110 + (COND 00051120 + ((NOT (EQUAL M N)) (REDERR (QUOTE (NON SQUARE MATRIX))))) 00051130 + (SETQ B (COND (V V) (T (GENERATEIDENT M)))) 00051140 + (COND 00051150 + ((AND V (NOT (EQUAL M (LENGTH B)))) 00051160 + (REDERR (QUOTE (EQUATION MISMATCH))))) 00051170 + (SETQ A (AUGMENT A B)) 00051180 + (SETQ N (LENGTH (CAR A))) 00051190 + (SETQ A (LIPSON A M N T)) 00051200 + (SETQ A (BACKSUB A M N)) 00051210 + (SETQ SUBFG* X) 00051212 + (RETURN (MAPC2 (RHSIDE A M) (FUNCTION 00051220 + (LAMBDA (J) (SIMP (PREPSQ J))))))))) 00051221 + 00051230 +)) 00051240 + 00051250 +DEFINE (( 00051260 + 00051270 +(SIMPDET (LAMBDA (U) 00051280 + (SIMPDET1 U T))) 00051290 + 00051300 +(SIMPTRACE (LAMBDA (U) 00051310 + (SIMPDET1 U NIL))) 00051320 + 00051330 +(SIMPDET1 (LAMBDA (U V) 00051340 + (PROG (N) 00051350 + (COND 00051360 + ((AND (NOT (EQCAR (CAR U) (QUOTE *COMMA*))) 00051370 + (NOT (MATEXPR (CAR U)))) 00051380 + (REDERR (QUOTE (MATRIX EXPRESSION REQUIRED))))) 00051390 + (SETQ U 00051400 + (COND 00051410 + ((EQCAR (CAR U) (QUOTE *COMMA*)) 00051420 + (MAPCAR U 00051430 + (FUNCTION 00051440 + (LAMBDA(J) 00051450 + (MAPCAR 00051460 + (COND 00051470 + ((EQCAR J (QUOTE *COMMA*)) (CDR J)) 00051480 + (T J)) 00051490 + (FUNCTION SIMP)))))) 00051500 + (T (MATSIMP (MSIMP (CARX U) T))))) 00051510 + (COND 00051520 + ((NOT (EQUAL (LENGTH U) (LENGTH (CAR U)))) 00051530 + (REDERR (QUOTE (NON SQUARE MATRIX))))) 00051540 + (COND (V (RETURN (DETQ U)))) 00051550 + (SETQ N 1) 00051560 + (SETQ V (CONS NIL 1)) 00051570 + A (COND ((NULL U) (RETURN V))) 00051580 + (SETQ V (ADDSQ (NTH (CAR U) N) V)) 00051590 + (SETQ U (CDR U)) 00051600 + (SETQ N (ADD1 N)) 00051610 + (GO A)))) 00051620 + 00051630 +(SIMPDET* (LAMBDA (U) 00051640 + (MAPC2 U (FUNCTION SIMP)))) 00051650 + 00051660 +(SIMPMAT (LAMBDA (U) 00051670 + (REDERR (QUOTE (MATRIX MISMATCH))))) 00051680 + 00051690 +)) 00051700 + 00051710 +DEFLIST (((DET SIMPDET) (TRACE SIMPTRACE) (MAT SIMPMAT)) SIMPFN) 00051720 + 00051730 +DEFINE (( 00051740 + 00051750 +(DETQ (LAMBDA (U) 00051760 + (PROG (V X) 00051770 + (SETQ X SUBFG*) 00051772 + (SETQ SUBFG* NIL) 00051774 + (SETQ V (LENGTH U)) 00051776 + (SETQ V (NTH (NTH (LIPSON U V V NIL) V) V)) 00051777 + (SETQ SUBFG* X) 00051778 + (RETURN (SIMP (PREPSQ V)))))) 00051779 + 00051780 +)) 00051790 + 00051800 +DEFLIST (((CONS SIMPDOT)) SIMPFN) 00051810 + 00051820 +FLAG ((CONS) VOP) 00051830 + 00051840 +DEFINE (( 00051870 + 00051880 +(VOP (LAMBDA (U) 00051890 + (FLAG U (QUOTE VOP)))) 00051900 + 00051910 +(VECTORP (LAMBDA (U) 00051920 + (AND (ATOM U) 00051930 + (NOT (NUMBERP U)) 00051940 + (OR (FLAGP U (QUOTE MASS)) 00051950 + (FLAGP U (QUOTE VECTOR)) 00051960 + (MEMBER U INDICES*))))) 00051970 + 00051980 +(ISIMPQ (LAMBDA (U) 00051990 + (CONS (ISIMP (CAR U)) (CDR U)))) 00052000 + 00052010 +(ISIMP (LAMBDA (U) 00052020 + (COND 00052030 + ((OR (NULL SUBFG*) 00052035 + (AND (NULL INDICES*) 00052040 + (NULL GAMIDEN*) 00052050 + (NULL (GET (QUOTE EPS) (QUOTE KLIST))))) 00052060 + U) 00052070 + (T (ISIMP1 U INDICES* NIL NIL NIL))))) 00052080 + 00052090 +(ISIMP1 (LAMBDA (U I V W X) 00052100 + (COND 00052110 + ((ATOM U) 00052120 + (COND 00052130 + ((OR V X) (REDERR (APPEND (QUOTE (UNMATCHED INDEX ERROR)) I))) 00052140 + (W (MULTF (EMULT W) (ISIMP1 U I V NIL X))) 00052150 + (T U))) 00052160 + (T 00052170 + (ADDF (ISIMP2 (CAR U) I V W X) 00052180 + (COND ((NULL (CDR U)) NIL) 00052190 + (T (ISIMP1 (CDR U) I V W X)))))))) 00052200 + 00052210 +(ISIMP2 (LAMBDA (U I V W X) 00052220 + (PROG (Z) 00052230 + (COND ((ATOM (SETQ Z (CAAR U))) (GO A)) 00052240 + ((AND (EQ (CAR Z) (QUOTE CONS)) (XN (CDR Z) I)) 00052250 + (RETURN (DOTSUM U I V W X))) 00052260 + ((EQ (CAR Z) (QUOTE G)) (RETURN (SPUR0 U I V W X))) 00052270 + ((EQ (CAR Z) (QUOTE EPS)) (RETURN (ESUM U I V W X)))) 00052280 + A (RETURN (MULTF2 (CAR U) (ISIMP1 (CDR U) I V W X)))))) 00052290 + 00052300 +(DOTSUM (LAMBDA (U I V W X) 00052310 + (PROG (I1 N U1 U2 V1 Y Z) 00052320 + (SETQ N (CDAR U)) 00052330 + (COND 00052340 + ((NOT (MEMBER (CAR (SETQ U1 (CDAAR U))) I)) 00052350 + (SETQ U1 (REVERSE U1)))) 00052360 + (SETQ U2 (CADR U1)) 00052370 + (SETQ U1 (CAR U1)) 00052380 + (SETQ V1 (CDR U)) 00052390 + (COND ((EQUAL N 2) (GO H)) ((NOT (ONEP N)) (REDERR U))) 00052400 + A (COND 00052410 + ((NOT (MEMBER U1 I)) 00052420 + (RETURN (MULTF (MKDOT U1 U2) (ISIMP1 V1 I1 V W X))))) 00052430 + A1 (SETQ I1 (DELETE U1 I)) 00052440 + (COND ((EQ U1 U2) (RETURN (MULTN 4 (ISIMP1 V1 I1 V W X)))) 00052450 + ((NOT (SETQ Z (ASSOC U1 V))) (GO C)) 00052460 + ((MEMBER U2 I) (GO D))) 00052470 + (SETQ U1 (CDR Z)) 00052480 + (GO E) 00052490 + C (COND 00052500 + ((SETQ Z (MEMLIS U1 X)) 00052510 + (RETURN 00052520 + (SPUR0 (CONS (CONS (CONS (QUOTE G) (SUBST U2 U1 Z)) 1) 00052530 + V1) 00052540 + I1 00052550 + V 00052560 + W 00052570 + (DELETE Z X)))) 00052580 + ((SETQ Z (MEMLIS U1 W)) 00052590 + (RETURN 00052600 + (ESUM (CONS (CONS (CONS (QUOTE EPS) (SUBST U2 U1 Z)) 1) 00052610 + V1) 00052620 + I1 00052630 + V 00052640 + (DELETE Z W) 00052650 + X))) 00052660 + ((AND (MEMBER U2 I) (NULL Y)) (GO G))) 00052670 + (RETURN (ISIMP1 V1 I (CONS (CONS U1 U2) V) W X)) 00052680 + D (SETQ U1 U2) 00052690 + (SETQ U2 (CDR Z)) 00052700 + E (SETQ I I1) 00052710 + (SETQ V (DELETE Z V)) 00052720 + (GO A) 00052730 + G (SETQ Y T) 00052740 + (SETQ Z U1) 00052750 + (SETQ U1 U2) 00052760 + (SETQ U2 Z) 00052770 + (GO A1) 00052780 + H (COND ((EQ U1 U2) (REDERR U))) 00052790 + (SETQ I (DELETE U1 I)) 00052800 + (SETQ U1 U2) 00052810 + (GO A)))) 00052820 + 00052830 +)) 00052840 + 00052850 +DEFINE (( 00052860 + 00052870 +(VMULT (LAMBDA (U) 00052880 + (PROG (Z) 00052890 + (SETQ U 00052900 + (REVERSE 00052910 + (MAPCAR U (FUNCTION (LAMBDA (J) (MSIMP J NIL)))))) 00052920 + A (COND ((NULL U) (RETURN Z)) 00052930 + ((NULL Z) (SETQ Z (CAR U))) 00052940 + (T (SETQ Z (VMULT1 (CAR U) Z)))) 00052950 + (SETQ U (CDR U)) 00052960 + (GO A)))) 00052970 + 00052980 +(VMULT1 (LAMBDA (U *S1*) 00052990 + (COND ((NULL *S1*) NIL) 00053000 + (T 00053010 + (MAPCON U 00053020 + (FUNCTION 00053030 + (LAMBDA(*S*) 00053040 + (MAPCAR *S1* 00053050 + (FUNCTION 00053060 + (LAMBDA(J) 00053070 + (CONS (MULTSQ (CAAR *S*) (CAR J)) 00053080 + (APPEND (CDAR *S*) 00053090 + (CDR J))))))))))))) 00053100 + 00053110 +)) 00053120 + 00053130 +DEFINE (( 00053140 + 00053150 +(SIMPDOT (LAMBDA (U) 00053160 + (COND ((CDDR U) (ERRACH (LIST (QUOTE SIMPDOT) U))) 00053170 + (T 00053180 + (MKVARG U 00053190 + (FUNCTION 00053200 + (LAMBDA(J) 00053210 + (MKSQ (CONS (QUOTE CONS) (ORD2 (CAR J) (CADR J))) 00053220 + 1)))))))) 00053230 + 00053240 +(MKVARG (LAMBDA (U *PI*) 00053250 + (PROG (Z) 00053260 + (SETQ U (VMULT U)) 00053270 + (SETQ Z (CONS NIL 1)) 00053280 + A (COND ((NULL U) (RETURN Z))) 00053290 + (SETQ Z (ADDSQ (MULTSQ (*PI* (CDAR U)) (CAAR U)) Z)) 00053300 + (SETQ U (CDR U)) 00053310 + (GO A)))) 00053320 + 00053330 +(MKDOT (LAMBDA (U V) 00053340 + (MKSF (CONS (QUOTE CONS) (ORD2 U V)) 1))) 00053350 + 00053360 +(VLET (LAMBDA (U V B) 00053370 + (PROG2 00053375 + (AND B (FLAGP U (QUOTE USED*)) (RMSUBS2)) 00053380 + (SETQ VREP* (XADD (CONS U V) VREP* U B))))) 00053385 + 00053390 +)) 00053400 + 00053410 +DEFINE (( 00053420 + 00053430 +(INDEX (LAMBDA (U) 00053440 + (SETQ INDICES* (UNION INDICES* U)))) 00053450 + 00053460 +(REMIND (LAMBDA (U) 00053470 + (PROG2 (VECTOR U) (SETQ INDICES* (SETDIFF INDICES* U))))) 00053480 + 00053490 +(MASS (LAMBDA (U) 00053500 + (COND ((NULL U) NIL) 00053510 + (T 00053520 + (PROG2 (PUT (CADAR U) (QUOTE MASS) (CADDAR U)) 00053530 + (MASS (CDR U))))))) 00053540 + 00053550 +(MSHELL (LAMBDA (U) 00053560 + (PROG (X Z) 00053570 + A (COND ((NULL U) (RETURN (LET Z)))) 00053580 + (SETQ X (GETMAS (CAR U))) 00053590 + (SETQ Z 00053600 + (CONS (LIST (QUOTE EQUAL) 00053610 + (LIST (QUOTE CONS) (CAR U) (CAR U)) 00053620 + (LIST (QUOTE TIMES) X X)) 00053630 + Z)) 00053640 + (SETQ U (CDR U)) 00053650 + (GO A)))) 00053660 + 00053670 +(GETMAS (LAMBDA (U) 00053680 + ((LAMBDA(X) 00053690 + (COND (X X) (T (REDERR (CONS U (QUOTE (HAS NO MASS))))))) 00053700 + (GET* U (QUOTE MASS))))) 00053710 + 00053720 +(VECTOR (LAMBDA (U) 00053730 + (FLAG U (QUOTE VECTOR)))) 00053740 + 00053750 +)) 00053760 + 00053770 +DEFINE (( 00053780 + 00053790 +(VCREP (LAMBDA (U) 00053800 + ((LAMBDA(X) 00053810 + (COND 00053820 + ((AND SUBFG* (NOT (EQUAL X (CAR U)))) 00053830 + (NCONC U (LIST (LIST (QUOTE REP) X 1 NIL NIL)))) 00053840 + (T NIL))) 00053850 + (SUBLIS VREP* (CAR U))))) 00053860 + 00053870 +)) 00053880 + 00053890 +DEFLIST (((MSHELL RLIS) (MASS RLIS) (INDEX RLIS) (REMIND RLIS) (VECTOR 00053900 + RLIS) (VOP RLIS)) STAT) 00053910 + 00053920 +FLAG ((EPS) VOP) 00053950 + 00053960 +DEFLIST (((G SIMPGAMMA) (EPS SIMPEPS)) SIMPFN) 00053970 + 00053980 +FLAG ((G) NONCOM) 00053990 + 00054000 +DEFLIST (((G GMULT)) MRULE) 00054010 + 00054020 +DEFINE (( 00054030 + 00054040 +(GMULT (LAMBDA (U V) 00054050 + (COND 00054060 + ((OR (NOT (EQUAL (CDR U) 1)) (NOT (EQUAL (CDR V) 1))) 00054070 + (ERRACH (LIST (QUOTE GMULT) U V))) 00054080 + ((NOT (EQ (CADAR U) (CADAR V))) (QUOTE FAILED)) 00054090 + (T (GCHECK (REVERSE (CDDAR U)) (CDDAR V) (CADAR U)))))) 00054100 + 00054110 +(NONCOM (LAMBDA (U) 00054120 + (FLAG U (QUOTE NONCOM)))) 00054130 + 00054140 +)) 00054150 + 00054160 +DEFINE (( 00054170 + 00054180 +(SPUR (LAMBDA (U) 00054190 + (PROG2 (RMSUBS) 00054200 + (MAP U 00054210 + (FUNCTION 00054220 + (LAMBDA(J) 00054230 + (PROG2 (REMFLAG (LIST (CAR J)) (QUOTE NOSPUR)) 00054240 + (REMFLAG (LIST (CAR J)) (QUOTE REDUCE))))))))) 00054250 + 00054260 +(NOSPUR (LAMBDA (U) 00054270 + (FLAG U (QUOTE NOSPUR)))) 00054280 + 00054290 +(REDUCE (LAMBDA (U) 00054300 + (PROG2 (NOSPUR U) (FLAG U (QUOTE REDUCE))))) 00054310 + 00054320 +(SIMPGAMMA (LAMBDA (*S*) 00054330 + (COND 00054340 + ((OR (NULL *S*) (NULL (CDR *S*))) 00054350 + (REDERR (QUOTE (MISSING ARGUMENTS FOR G OPERATOR)))) 00054360 + (T 00054370 + (PROG NIL 00054380 + (SETQ GAMIDEN* (UNION (LIST (CAR *S*)) GAMIDEN*)) 00054390 + (SETQ *NCMP T) 00054400 + (RETURN 00054410 + (MKVARG (CDR *S*) 00054420 + (FUNCTION 00054430 + (LAMBDA(J) 00054440 + (CONS (GCHECK (REVERSE J) NIL (CAR *S*)) 00054450 + 1)))))))))) 00054460 + 00054470 +(GCHECK (LAMBDA (U V L) 00054480 + (COND ((EQ (CAR V) (QUOTE A)) (GCHKA U (CDR V) T L)) 00054490 + (T (GCHKV U V T L))))) 00054500 + 00054510 +(GCHKA (LAMBDA (U V X W) 00054520 + (COND ((NULL U) (MULTN (NB X) (MKG (CONS (QUOTE A) V) W))) 00054530 + ((EQ (CAR U) (QUOTE A)) (GCHKV (CDR U) V X W)) 00054540 + (T (GCHKA (CDR U) (CONS (CAR U) V) (NOT X) W))))) 00054550 + 00054560 +(GCHKV (LAMBDA (U V X L) 00054570 + (COND ((NULL U) 00054580 + (COND ((NULL V) (NB X)) (T (MULTN (NB X) (MKG V L))))) 00054590 + ((EQ (CAR U) (QUOTE A)) (GCHKA (CDR U) V X L)) 00054600 + (T (GCHKV (CDR U) (CONS (CAR U) V) X L))))) 00054610 + 00054620 +(MKG (LAMBDA (U L) 00054630 + (LIST (CONS (CONS (CONS (QUOTE G) (CONS L U)) 1) 1)))) 00054640 + 00054650 +(MKA (LAMBDA (L) 00054660 + (MKG (LIST (QUOTE A)) L))) 00054670 + 00054680 +(MKG1 (LAMBDA (U L) 00054690 + (COND 00054700 + ((OR (NOT (FLAGP L (QUOTE NOSPUR))) 00054710 + (NULL (CDR U)) 00054720 + (CDDR U) 00054730 + (ORDOP (CAR U) (CADR U)) 00054740 + (EQ (CAR U) (QUOTE A))) 00054750 + (MKG U L)) 00054760 + (T 00054770 + (ADDF (MULTN 2 (MKDOT (CAR U) (CADR U))) 00054780 + (MULTN -1 (MKG (REVERSE U) L))))))) 00054790 + 00054800 +(NB (LAMBDA (U) 00054810 + (COND (U 1) (T -1)))) 00054820 + 00054830 +)) 00054840 + 00054850 +DEFINE (( 00054860 + 00054870 +(SPUR0 (LAMBDA (U I V1 V2 V3) 00054880 + (PROG (L V W I1 Z KAHP) 00054890 + (SETQ L (CADAAR U)) 00054900 + (SETQ V (CDDAAR U)) 00054910 + (COND ((NOT (ONEP (CDAR U))) (SETQ V (APPN V (CDAR U))))) 00054920 + (SETQ U (CDR U)) 00054930 + (COND 00054940 + ((AND (NOT (FLAGP L (QUOTE NOSPUR))) + (OR (AND (EQ (CAR V) (QUOTE A)) 00054960 + (OR (LESSP (LENGTH V) 5) 00054970 + (NOT (EVENP (CDR V))))) 00054980 + (AND (NOT (EQ (CAR V) (QUOTE A))) 00054990 + (NOT (EVENP V))))) 00055000 + (RETURN NIL)) 00055010 + ((NULL I) (GO END))) 00055020 + A (COND ((NULL V) (GO END1)) ((MEMBER (CAR V) I) (GO B))) 00055030 + A1 (SETQ W (CONS (CAR V) W)) 00055040 + (SETQ V (CDR V)) 00055050 + (GO A) 00055060 + B (COND ((MEMBER (CAR V) (CDR V)) (GO KAH1)) 00055070 + ((MEMBER (CAR V) I1) (GO A1)) 00055080 + ((SETQ Z (BASSOC (CAR V) V1)) (GO E)) 00055090 + ((SETQ Z (MEMLIS (CAR V) V2)) 00055100 + (RETURN 00055110 + ((LAMBDA(X) 00055120 + (COND 00055130 + ((AND (FLAGP L (QUOTE REDUCE)) 00055140 + (NULL V1) 00055150 + (NULL V3) 00055160 + (NULL (CDR V2))) 00055170 + (MULTF (MKG* X L) (MULTF (MKEPS1 Z) (ISIMP U)))) 00055180 + (T 00055190 + (ISIMP1 00055200 + (SPUR0 (CONS (CAAR (MKG X L)) U) 00055210 + NIL 00055220 + V1 00055230 + (DELETE Z V2) 00055240 + V3) 00055250 + I 00055260 + NIL 00055270 + (LIST Z) 00055280 + NIL)))) 00055290 + (APPEND (REVERSE W) V)))) 00055300 + ((SETQ Z (MEMLIS (CAR V) V3)) (GO C)) 00055310 + (T 00055320 + (RETURN 00055330 + (ISIMP1 U 00055340 + I 00055350 + V1 00055360 + V2 00055370 + (CONS (CONS L (APPEND (REVERSE W) V)) 00055380 + V3))))) 00055390 + C (SETQ V3 (DELETE Z V3)) 00055400 + (SETQ KAHP NIL) 00055410 + (COND 00055420 + ((AND (FLAGP L (QUOTE NOSPUR)) 00055430 + (FLAGP (CAR Z) (QUOTE NOSPUR))) 00055440 + (ERROR (QUOTE HELP))) 00055450 + ((FLAGP (CAR Z) (QUOTE NOSPUR)) (SETQ KAHP (CAR Z)))) 00055460 + (SETQ Z (CDR Z)) 00055470 + (SETQ I1 NIL) 00055480 + C1 (COND ((EQ (CAR V) (CAR Z)) (GO D))) 00055490 + (SETQ I1 (CONS (CAR Z) I1)) 00055500 + (SETQ Z (CDR Z)) 00055510 + (GO C1) 00055520 + D (SETQ Z (CDR Z)) 00055530 + (SETQ I (DELETE (CAR V) I)) 00055540 + (SETQ V (CDR V)) 00055550 + (COND ((NOT (FLAGP L (QUOTE NOSPUR))) (GO D0))) 00055560 + (SETQ W (CONS W (CONS V (CONS I1 Z)))) 00055570 + (SETQ I1 (CAR W)) 00055580 + (SETQ Z (CADR W)) 00055590 + (SETQ V (CADDR W)) 00055600 + (SETQ W (CDDDR W)) 00055610 + D0 (SETQ W (REVERSE W)) 00055620 + (COND 00055630 + ((AND (OR (NULL V) (NOT (EQ (CAR W) (QUOTE A)))) 00055640 + (SETQ V (APPEND V W))) 00055650 + (GO D1)) 00055660 + ((NOT (EVENP V)) (SETQ U (MULTN -1 U)))) 00055670 + (SETQ V (CONS (QUOTE A) (APPEND V (CDR W)))) 00055680 + D1 (COND (KAHP (SETQ L KAHP))) 00055690 + (SETQ VARS* NIL) 00055700 + (SETQ Z (MULTF (MKG (REVERSE I1) L) 00055710 + (MULTF (BRACE V L I) (MULTF (MKG1 Z L) U)))) 00055720 + (SETQ Z (ISIMP1 Z (APPEND VARS* I) V1 V2 V3)) 00055730 + (COND ((NULL Z) (RETURN Z)) 00055780 + ((NULL (SETQ Z (QUOTF Z 2))) 00055790 + (ERRACH (LIST (QUOTE SPUR0) U I V1 V2 V3)))) 00055800 + (RETURN Z) 00055810 + E (SETQ V1 (DELETE Z V1)) 00055820 + (SETQ I (DELETE (CAR W) I)) 00055830 + (SETQ V (CONS (OTHER (CAR V) Z) (CDR V))) 00055840 + (GO A) 00055850 + KAH1 (COND ((EQ (CAR V) (CADR V)) (GO K2))) 00055860 + (SETQ KAHP T) 00055870 + (SETQ I1 (CONS (CAR V) I1)) 00055880 + (GO A1) 00055890 + K2 (SETQ I (DELETE (CAR V) I)) 00055900 + (SETQ V (CDDR V)) 00055910 + (SETQ U (MULTN 4 U)) 00055920 + (GO A) 00055930 + END (SETQ W (REVERSE V)) 00055940 + END1 (COND (KAHP (GO END2)) 00055950 + ((NULL (SETQ Z (SPURR W L NIL 1))) (RETURN NIL)) 00055960 + (T (RETURN (COND ((AND (GET (QUOTE EPS) (QUOTE KLIST)) 00055970 + (NOT (FLAGP L (QUOTE NOSPUR)))) 00055971 + (ISIMP1 (MULTF Z U) I V1 V2 V3)) 00055972 + (T (MULTF Z (ISIMP1 U I V1 V2 V3))))))) 00055973 + END2 (SETQ VARS* NIL) 00055980 + (SETQ Z (MULTF (KAHANE (REVERSE W) I1 L) U)) 00055990 + (RETURN (ISIMP1 Z (APPEND VARS* (SETDIFF I I1)) V1 V2 V3))))) 00056000 + 00056040 +(APPN (LAMBDA (U N) 00056050 + (COND ((ONEP N) U) (T (APPEND U (APPN U (SUB1 N))))))) 00056060 + 00056070 +(OTHER (LAMBDA (U V) 00056080 + (COND ((EQ U (CAR V)) (CDR V)) (T (CAR V))))) 00056090 + 00056100 +)) 00056110 + 00056120 +DEFINE (( 00056130 + 00056140 +(KAHANE (LAMBDA (U I L) 00056150 + (PROG (K2 LD LU M P V W X Y) 00056160 + (SETQ K2 0) 00056170 + (SETQ M 0) 00056180 + (SETQ W (LIST T T NIL)) 00056190 + (COND ((EQ (CAR U) (QUOTE A)) (GO B))) 00056200 + A (COND 00056210 + ((AND (NULL U) (SETQ W (CONS NIL (CONS NIL (CONS NIL W))))) 00056220 + (GO KETJAK)) 00056230 + ((MEMBER (CAR U) I) (GO D))) 00056240 + (SETQ P (NOT P)) 00056250 + B (SETQ W (CONS (CAR U) W)) 00056260 + C (SETQ U (CDR U)) 00056270 + (GO A) 00056280 + D (SETQ W (CONS (CAR U) (CONS P (CONS NIL W)))) 00056290 + (SETQ X NIL) 00056300 + KETJAK 00056310 + (SETQ W (REVERSE W)) 00056320 + TJARUM 00056330 + (COND ((CADR W) (SETQ LU (CONS W LU))) 00056340 + (T (SETQ LD (CONS W LD)))) 00056350 + (COND ((NULL U) (GO DJANGER)) (X (GO MAS))) 00056360 + (SETQ W (REVERSE W)) 00056370 + (SETQ X T) 00056380 + (GO TJARUM) 00056390 + MAS (SETQ W (LIST T (SETQ P (NOT P)) (CAR U))) 00056400 + (SETQ K2 (ADD1 K2)) 00056410 + (GO C) 00056420 + DJANGER 00056430 + (SETQ LU (REVERSE LU)) 00056440 + BARUNA 00056450 + (COND ((NULL LU) (GO JAVA))) 00056460 + (SETQ V (CAR LU)) 00056470 + (SETQ LU (CDR LU)) 00056480 + WAJANG 00056490 + (SETQ X (CONS (CAR V) (CADR V))) 00056495 + (SETQ P (NULL (CADDR V))) 00056500 + (SETQ M (ADD1 M)) 00056510 + (SETQ W NIL) 00056520 + RINDIK 00056530 + (SETQ Y (REVERSE V)) 00056540 + R1 (COND ((CADR Y) (SETQ LU (DELETE Y LU))) 00056545 + (T (SETQ LD (DELETE Y LD)))) 00056550 + (COND ((EQ Y V) (GO RINDIK)) 00056555 + (P (AND (SETQ V Y) 00056560 + (SETQ X (CONS (CAR V) (CADR V))) 00056565 + (SETQ P NIL)))) 00056570 + (SETQ V (CDDDR V)) 00056575 + BANDJAR 00056580 + (COND ((CDDDR V) (GO SUBAK)) 00056585 + ((NULL (CADDR V)) (GO WADAH)) 00056590 + ((AND (EQ (CADDR V) (CAR X)) 00056595 + (EQ (CADR V) (CDR X))) (GO BARIS))) 00056596 + (SETQ V 00056600 + (SASSOC (CADDR V) 00056605 + (COND ((CADR V) LU) (T LD)) 00056610 + (FUNCTION 00056650 + (LAMBDA NIL (ERRACH (QUOTE KAHANE)))))) 00056660 + (SETQ Y V) 00056670 + (GO R1) 00056680 + SUBAK 00056700 + (SETQ W (CONS (CAR V) W)) 00056710 + (SETQ V (CDR V)) 00056720 + (GO BANDJAR) 00056730 + WADAH 00056740 + (SETQ U (MKG (REVERSE W) L)) 00056750 + (GO BARUNA) 00056760 + BARIS 00056770 + (COND ((AND W (CDR X)) (SETQ W (NCONC (CDR W) (LIST (CAR W)))))) 00056775 + (SETQ U (MULTF (BRACE W L NIL) U)) 00056780 + (GO BARUNA) 00056790 + JAVA (COND ((NULL LD) (GO HOME))) 00056800 + (SETQ V (CAR LD)) 00056810 + (SETQ LD (CDR LD)) 00056820 + (GO WAJANG) 00056830 + HOME (SETQ K2 (QUOTIENT K2 2)) 00056840 + (SETQ X (EXPT 2 K2)) 00056850 + (COND 00056860 + ((ZEROP (REMAINDER (DIFFERENCE K2 M) 2)) 00056870 + (SETQ X (MINUS X)))) 00056880 + (RETURN (MULTN X U))))) 00056890 + 00056900 +(BRACE (LAMBDA (U L I) 00056910 + (COND ((NULL U) 2) 00056920 + ((OR (XN I U) (FLAGP L (QUOTE NOSPUR))) 00056930 + (ADDF (MKG1 U L) (MKG1 (REVERSE U) L))) 00056935 + ((EQ (CAR U) (QUOTE A)) 00056940 + (COND ((EVENP U) (ADDF (MKG U L) 00056950 + (MULTN -1 (MKG (CONS (QUOTE A) 00056952 + (REVERSE (CDR U))) L)))) 00056954 + (T (MULTF (MKA L) (SPR2 (CDR U) L 2 NIL))))) 00056960 + ((EVENP U) (SPR2 U L 2 NIL)) 00056970 + (T (SPR1 U L 2 NIL))))) 00056980 + 00056990 +(SPR1 (LAMBDA (U L N B) 00057000 + (COND ((NULL U) NIL) 00057010 + ((NULL (CDR U)) (MULTN N (MKG1 U L))) 00057020 + (T 00057030 + (PROG (M X Z) 00057040 + (SETQ X U) 00057050 + (SETQ M 0) 00057060 + A (COND ((NULL X) (RETURN Z))) 00057070 + (SETQ Z 00057080 + (ADDF (MULTF (MKG1 (LIST (CAR X)) L) 00057090 + (COND 00057100 + ((NULL B) 00057110 + (SPURR (REMOVE U M) L NIL N)) 00057120 + (T (SPR1 (REMOVE U M) L N NIL)))) 00057130 + Z)) 00057140 + (SETQ X (CDR X)) 00057150 + (SETQ N (MINUS N)) 00057160 + (SETQ M (ADD1 M)) 00057170 + (GO A)))))) 00057180 + 00057190 +(SPR2 (LAMBDA (U L N B) 00057200 + (COND ((AND (NULL (CDDR U)) (NULL B)) 00057210 + (MULTN N (MKDOT (CAR U) (CADR U)))) 00057220 + (T 00057230 + ((LAMBDA (X) (COND (B (ADDF (SPR1 U L N B) X)) (T X))) 00057240 + (ADDF (SPURR U L NIL N) 00057250 + (MULTF (MKA L) 00057255 + (SPURR (APPEND U (LIST (QUOTE A))) L NIL N)))))))) 00057260 + 00057270 +(EVENP (LAMBDA (U) 00057410 + (OR (NULL U) (NOT (EVENP (CDR U)))))) 00057420 + 00057430 +(BASSOC (LAMBDA (U V) 00057440 + (COND ((NULL V) NIL) 00057450 + ((OR (EQ U (CAAR V)) (EQ U (CDAR V))) (CAR V)) 00057460 + (T (BASSOC U (CDR V)))))) 00057470 + 00057480 +(MEMLIS (LAMBDA (U V) 00057490 + (COND ((NULL V) NIL) 00057500 + ((MEMBER U (CAR V)) (CAR V)) 00057510 + (T (MEMLIS U (CDR V)))))) 00057520 + 00057530 +)) 00057540 + 00057550 +DEFINE (( 00057560 + 00057570 +(SPURR (LAMBDA (U L V N) 00057580 + (PROG (M W X Y Z) 00057590 + A (COND ((NULL U) (GO B)) ((MEMBER (CAR U) (CDR U)) (GO G))) 00057600 + (SETQ V (CONS (CAR U) V)) 00057610 + (SETQ U (CDR U)) 00057620 + (GO A) 00057630 + B (COND ((NULL V) (RETURN N)) 00057640 + ((FLAGP L (QUOTE NOSPUR)) 00057650 + (RETURN (MULTN N (MKG* V L)))) 00057660 + (T (RETURN (SPRGEN V N)))) 00057670 + G (SETQ X (CAR U)) 00057680 + (SETQ Y (CDR U)) 00057690 + (SETQ W Y) 00057700 + (SETQ M 0) 00057710 + H (COND 00057720 + ((EQ X (CAR W)) 00057730 + (RETURN 00057740 + (ADDF (MULTF (MKDOT X X) (SPURR (DELETE X Y) L V N)) 00057750 + Z)))) 00057760 + (SETQ Z 00057770 + (ADDF (MULTF (MKDOT X (CAR W)) 00057780 + (SPURR (REMOVE Y M) L V (TIMES 2 N))) 00057790 + Z)) 00057800 + (SETQ W (CDR W)) 00057810 + (SETQ N (MINUS N)) 00057820 + (SETQ M (ADD1 M)) 00057830 + (GO H)))) 00057840 + 00057850 +(SPRGEN (LAMBDA (V N) 00057860 + (PROG (X Z) 00057870 + (COND 00057880 + ((NOT (EQ (CAR V) (QUOTE A))) (RETURN (SPRGEN1 V N))) 00057890 + ((NULL (SETQ X (COMB1 (SETQ V (CDR V)) 4 NIL))) 00057900 + (RETURN NIL)) 00057910 + ((NULL (CDR X)) (GO E))) 00057920 + C (COND ((NULL X) (RETURN (MULTF2 (MKSP (QUOTE I) 1) Z)))) 00057930 + (SETQ Z 00057940 + (ADDF (MULTN (ASIGN (CAR X) V N) 00057950 + (MULTF (MKEPS1 (CAR X)) 00057960 + (SPRGEN1 (SETDIFF V (CAR X)) 1))) 00057970 + Z)) 00057980 + D (SETQ X (CDR X)) 00057990 + (GO C) 00058000 + E (SETQ Z (MULTN N (MKEPS1 (CAR X)))) 00058010 + (GO D)))) 00058020 + 00058030 +(ASIGN (LAMBDA (U V N) 00058031 + (COND ((NULL U) N) 00058032 + (T (ASIGN (CDR U) V (TIMES (ASIGN1 (CAR U) V -1) N)))))) 00058033 + 00058034 +(ASIGN1 (LAMBDA (U V N) 00058035 + (COND ((NULL V) (ERROR (QUOTE ARG))) 00058036 + ((EQ U (CAR V)) N) 00058037 + (T (ASIGN1 U (CDR V) (MINUS N)))))) 00058038 + 00058039 +(SPRGEN1 (LAMBDA (U N) 00058040 + (COND ((NULL U) NIL) 00058050 + ((NULL (CDDR U)) (MULTN N (MKDOT (CAR U) (CADR U)))) 00058060 + (T 00058070 + (PROG (W X Y Z) 00058080 + (SETQ X (CAR U)) 00058090 + (SETQ U (CDR U)) 00058100 + (SETQ Y U) 00058110 + A (COND ((NULL U) (RETURN Z)) 00058120 + ((NULL (SETQ W (MKDOT X (CAR U)))) (GO B))) 00058130 + (SETQ Z 00058140 + (ADDF (MULTF W (SPRGEN1 (DELETE (CAR U) Y) N)) 00058150 + Z)) 00058160 + B (SETQ N (MINUS N)) 00058170 + (SETQ U (CDR U)) 00058180 + (GO A)))))) 00058190 + 00058200 +(COMB1 (LAMBDA (U N V) 00058210 + ((LAMBDA(M) 00058220 + (COND ((ONEP N) 00058230 + (APPEND V (MAPCAR U (FUNCTION (LAMBDA (J) (LIST J)))))) 00058240 + ((MINUSP M) NIL) 00058250 + ((ZEROP M) (CONS U V)) 00058260 + (T 00058270 + (COMB1 (CDR U) 00058280 + N 00058290 + (APPEND V 00058300 + (MAPCONS (COMB1 (CDR U) (SUB1 N) NIL) 00058310 + (CAR U))))))) 00058320 + (DIFFERENCE (LENGTH U) N)))) 00058330 + 00058340 +)) 00058350 + 00058360 +DEFINE (( 00058370 + 00058380 +(SIMPEPS (LAMBDA (U) 00058390 + (MKVARG U 00058400 + (FUNCTION 00058410 + (LAMBDA(J) 00058420 + (CONS (COND ((REPEATS J) NIL) (T (MKEPS1 J))) 1)))))) 00058430 + 00058440 +(MKEPS1 (LAMBDA (U) 00058450 + ((LAMBDA(X) 00058460 + (MULTN (NB (PERMP X U)) (MKSF (CONS (QUOTE EPS) X) 1))) 00058470 + (ORDN U)))) 00058480 + 00058490 +(PERMP (LAMBDA (U V) 00058500 + (COND ((NULL U) T) 00058510 + ((EQ (CAR U) (CAR V)) (PERMP (CDR U) (CDR V))) 00058520 + (T (NOT (PERMP (CDR U) (SUBST (CAR V) (CAR U) (CDR V)))))))) 00058530 + 00058540 +)) 00058550 + 00058560 +DEFINE (( 00058570 + 00058580 +(ESUM (LAMBDA (U I V W XX) 00058590 + (PROG (X Y Z) 00058600 + (SETQ X (CAR U)) 00058610 + (SETQ U (CDR U)) 00058620 + (COND 00058630 + ((NOT (ONEP (CDR X))) 00058640 + (SETQ U 00058650 + (MULTF (NMULTF (MKEPS1 (CDAR X)) (SUB1 (CDR X))) 00058660 + U)))) 00058670 + (SETQ X (CDAR X)) 00058680 + A (COND ((REPEATS X) (RETURN NIL))) 00058690 + B (COND ((NULL X) 00058700 + (RETURN (ISIMP1 U I V (CONS (REVERSE Y) W) XX))) 00058710 + ((NOT (MEMBER (CAR X) I)) (GO D)) 00058720 + ((NOT (SETQ Z (BASSOC (CAR X) V))) (GO C))) 00058730 + (SETQ V (DELETE Z V)) 00058740 + (SETQ I (DELETE (CAR X) I)) 00058750 + (SETQ X 00058760 + (APPEND (REVERSE Y) (CONS (OTHER (CAR X) Z) (CDR X)))) 00058770 + (SETQ Y NIL) 00058780 + (GO A) 00058790 + C (COND ((SETQ Z (MEMLIS (CAR X) W)) (GO C1)) 00058800 + ((SETQ Z (MEMLIS (CAR X) XX)) 00058810 + (RETURN 00058820 + (SPUR0 (CONS (CONS (CONS (QUOTE G) Z) 1) U) 00058830 + I 00058840 + V 00058850 + (CONS (APPEND (REVERSE Y) X) W) 00058860 + (DELETE Z XX))))) 00058870 + (RETURN (ISIMP1 U I V (CONS (APPEND (REVERSE Y) X) W) XX)) 00058880 + C1 (SETQ X (APPEND (REVERSE Y) X)) 00058890 + (SETQ Y (XN I (XN X Z))) 00058900 + (RETURN 00058910 + (ISIMP1 (MULTF (EMULT1 Z X Y) U) 00058920 + (SETDIFF I Y) 00058930 + V 00058940 + (DELETE Z W) 00058950 + XX)) 00058960 + D (SETQ Y (CONS (CAR X) Y)) 00058970 + (SETQ X (CDR X)) 00058980 + (GO B)))) 00058990 + 00059000 +(EMULT (LAMBDA (U) 00059010 + (COND ((NULL (CDR U)) (MKEPS1 (CAR U) 1)) 00059020 + ((NULL (CDDR U)) (EMULT1 (CAR U) (CADR U) NIL)) 00059030 + (T (MULTF (EMULT1 (CAR U) (CADR U) NIL) (EMULT (CDDR U))))))) 00059040 + 00059050 +(EMULT1 (LAMBDA (U V I) 00059060 + ((LAMBDA(X *S*) 00059070 + ((LAMBDA(M N) 00059080 + (COND ((EQUAL M 4) (TIMES 6 (TIMES 4 N))) 00059090 + ((EQUAL M 3) 00059100 + (MULTN (TIMES 6 N) (MKDOT (CAR X) (CAR *S*)))) 00059110 + (T 00059120 + (MULTN (TIMES N (COND ((ZEROP M) 1) (T M))) 00059130 + (CAR 00059140 + (DETQ 00059150 + (MAPLIST X 00059160 + (FUNCTION 00059170 + (LAMBDA(*S1*) 00059180 + (MAPLIST *S* 00059190 + (FUNCTION 00059200 + (LAMBDA 00059210 + (J) 00059220 + (CONS 00059230 + (MKDOT 00059240 + (CAR *S1*) 00059250 + (CAR J)) 00059260 + 1))))))))))))) 00059270 + (LENGTH I) 00059280 + ((LAMBDA (J) (NB(COND((PERMP U (APPEND I X)) (NOT J)) (T J)))) 00059290 + (PERMP V (APPEND I *S*))))) 00059300 + (SETDIFF U I) 00059310 + (SETDIFF V I)))) 00059320 + 00059330 +)) 00059340 + 00059350 +DEFLIST (((NONCOM RLIS) (SPUR RLIS) (NOSPUR RLIS) (REDUCE RLIS)) STAT) 00059360 + 00059370 + 00059380 +DEFINE (( 00059390 + 00059400 +(MKG* (LAMBDA (U L) 00059410 + (COND ((NULL U) 1) 00059420 + ((NOT (FLAGP L (QUOTE REDUCE))) (MKG1 U L)) 00059430 + ((LESSP (LENGTH U) 3) (MKG1 U L)) 00059440 + ((AND (EQCAR U (QUOTE A)) (EQUAL (LENGTH U) 3)) 00059450 + ((LAMBDA(Y) 00059460 + (PROG2 (SETQ INDICES* (APPEND Y INDICES*)) 00059470 + (ADDF (MULTF (MKA L) (MKDOT (CADR U) (CADDR U))) 00059480 + (MULTF2 (MKSP (QUOTE I) 1) 00059490 + (MULTF (MKG1 Y L) 00059500 + (MKEPS1 00059510 + (APPEND (CDR U) Y))))))) 00059520 + (LIST (GENSYM) (GENSYM)))) 00059530 + (T (RED* U L))))) 00059540 + 00059550 +(RED* (LAMBDA (U L) 00059560 + (PROG (I X) 00059570 + (SETQ X (ACONC (EXPLODE L) (QUOTE I))) 00059580 + (SETQ I 00059590 + (LIST (COMPRESS (APPEND X (QUOTE (1)))) 00059600 + (COMPRESS (APPEND X (QUOTE (2)))))) 00059610 + (SETQ X (LIST (QUOTE A) (CAR I))) 00059620 + (RETURN 00059630 + (ADDF (SPURR NIL (QUOTE ***) U 3) 00059640 + (ADDF (MULTF (MKG (QUOTE (A)) L) 00059650 + (ISIMP1 00059660 + (GCHECK (QUOTE (A)) U (QUOTE ***)) 00059670 + NIL 00059680 + NIL 00059690 + NIL 00059700 + NIL)) 00059710 + (ADDF 00059720 + (ISIMP1* 00059730 + (ISIMP1 (GCHECK (LIST (CAR I)) U (QUOTE ***)) 00059740 + NIL 00059750 + NIL 00059760 + NIL 00059770 + NIL) 00059780 + (LIST (CAR I)) 00059790 + (LIST (LIST L (CAR I)))) 00059800 + (ADDF (MULTN -1 00059810 + (ISIMP1* 00059820 + (ISIMP1 00059830 + (GCHECK 00059840 + (REVERSE X) 00059850 + U 00059860 + (QUOTE ***)) 00059870 + NIL 00059880 + NIL 00059890 + NIL 00059900 + NIL) 00059910 + (CDR X) 00059920 + (LIST (CONS L X)))) 00059930 + (MULTF (MKSQP (CONS -1 2)) 00059940 + (ISIMP1* 00059950 + (ISIMP1 00059960 + (GCHECK 00059970 + (REVERSE I) 00059980 + U 00059990 + (QUOTE ***)) 00060000 + NIL 00060010 + NIL 00060020 + NIL 00060030 + NIL) 00060040 + I 00060050 + (LIST (CONS L I)))))))))))) 00060060 + 00060070 +(ISIMP1* (LAMBDA (U I V) 00060080 + (COND ((NULL U) NIL) (T (ISIMP1 U I NIL NIL V))))) 00060090 + 00060100 +)) 00060110 + 00060120 +INIT NIL 00060130 + 00060140 + 00060150 +COMMENT ((E N D O F R E D U C E P R O G R A M)) 00060160 + 00060170 + 00060180 ADDED reduce2/reduce2.os_source.s.2 Index: reduce2/reduce2.os_source.s.2 ================================================================== --- reduce2/reduce2.os_source.s.2 +++ reduce2/reduce2.os_source.s.2 @@ -0,0 +1,5675 @@ + 00000010 +OPEN (COMPILE SYSFILE INPUT) RESTORE (COMPILE) CLOSE (COMPILE) 00000020 + 00000030 + 00000040 +DEFLIST (((COMMENT (LAMBDA (U A) NIL))) FEXPR) 00000050 + 00000051 +COMMENT (***** DATE OF LAST SYSTEM UPDATE *****) 00000052 + 00000053 +DEFLIST (((DATE* ( 00000054 + 00000055 +$$$15-SEP-72$ 00000056 + 00000057 +))) SPECIAL) 00000058 + 00000059 +COMMENT (THE FOLLOWING COMMANDS ARE USED BY THE COMPILER) 00000060 + 00000061 +OPTIMIZE (T) BPSUSED (T) 00000062 + 00000063 +COMMENT((R E D U C E P R E P R O C E S S O R F O R L I S P /360))00000090 + 00000100 +OVOFF NIL 00000110 + 00000120 +COMMENT ((REDUCE CONVERTOR)) 00000130 + 00000140 +REMPROP (DEFINE SUBR) 00000150 + 00000160 +SPECIAL ((NOCMP*)) 00000170 + 00000180 +(LAMBDA (U) (COMPILE (DEFLIST U (QUOTE EXPR)))) (( 00000190 + 00000200 +(DEFINE (LAMBDA (U) 00000210 + (DEF1 U (QUOTE EXPR)))) 00000220 + 00000230 +(DEF1 (LAMBDA (U V) 00000240 + (PROG (X Y) 00000250 + A (COND ((NULL U) (RETURN Y)) 00000260 + ((FLAGP (SETQ X (CAAR U)) (QUOTE LOSE)) (GO B)) 00000270 + ((GETD (SETQ X (TRANS X NIL))) 00000280 + (PRINT (LIST (QUOTE *****) X (QUOTE REDEFINED))))) 00000290 + (SETQ Y (NCONC Y (LIST X))) 00000300 + (COND (NOCMP* (DEFLIST (LIST (TRANS (CAR U) T)) V)) 00000310 + ((EQ V (QUOTE EXPR)) 00000320 + (COM1 X (TRANS (CADAR U) NIL) NIL)) 00000330 + (T (COM1 X NIL (TRANS (CADAR U) NIL)))) 00000340 + B (SETQ U (CDR U)) (GO A)))) 00000350 + 00000360 +(TRANS (LAMBDA (U V) 00000370 + (COND ((NULL U) NIL) 00000380 + ((ATOM U) (COND ((NUMBERP U) U) 00000390 + (T 00000400 + ((LAMBDA(X) 00000410 + (COND (X 00000420 + (LIST 00000430 + (QUOTE QUOTE) 00000440 + X)) 00000450 + (T ((LAMBDA (Y) 00000460 + (COND (Y Y) 00000470 + ((AND NOCMP* (GET U (QUOTE SPECIAL))) 00000480 + (LIST (QUOTE GTS) (LIST (QUOTE QUOTE) U))) 00000490 + (T U))) 00000500 + (GET U (QUOTE NEWNAM)))))) 00000510 + (GET U (QUOTE CONSTANT)))))) 00000520 + ((ATOM (CAR U)) 00000530 + (COND ((EQ (CAR U) (QUOTE QUOTE)) U) 00000540 + ((NUMBERP (CAR U)) 00000550 + (CONS (CAR U) (MAPTR (CDR U)))) 00000560 + ((AND NOCMP* (EQ (CAR U) (QUOTE SETQ)) 00000570 + (GET (CADR U) (QUOTE SPECIAL))) 00000580 + (LIST (QUOTE PTS) (LIST (QUOTE QUOTE) (CADR U)) (TRANS 00000590 + (CADDR U) V))) 00000600 + (T 00000610 + ((LAMBDA(X) 00000620 + (COND (X 00000630 + (SUBLIS 00000640 + (PAIR (CADR X) (MAPTR (CDR U) V)) 00000650 + (CADDR X))) 00000660 + (T (CONS ((LAMBDA (Y) 00000670 + (COND (Y Y) 00000680 + (T ((LAMBDA (Z) 00000690 + (COND (Z(LIST (QUOTE QUOTE)00000700 + Z)) 00000710 + (T (TRANS (CAR U) V)))) 00000720 + (GET(CAR U) (QUOTE CONSTANT))))))00000730 + (GET (CAR U) (QUOTE NEWNAM))) 00000740 + (MAPTR (CDR U) V))))) 00000750 + (GET (CAR U) (QUOTE NEWFORM)))))) 00000760 + (T (MAPTR U V))))) 00000770 + 00000780 +(MAPTR (LAMBDA (U V) 00000790 + (COND ((ATOM U) (TRANS U V)) 00000800 + (T (CONS (TRANS (CAR U) V) (MAPTR (CDR U) V)))))) 00000810 + 00000820 +(GETD(LAMBDA(U) 00000830 + (OR (GET U (QUOTE EXPR)) 00000840 + (GET U (QUOTE FEXPR)) 00000850 + (GET U (QUOTE SUBR)) 00000860 + (GET U (QUOTE FSUBR)) 00000870 + (GET U (QUOTE MACRO))))) 00000880 + 00000890 +)) 00000900 + 00000910 +(LAMBDA NIL (PROG NIL (DEFLIST (LIST (LIST (QUOTE CONVRT) 00000912 + (GET (QUOTE TRANS) (QUOTE SUBR)))) (QUOTE SUBR)))) NIL 00000914 + 00000916 +(LAMBDA (U) (DEFLIST U (QUOTE EXPR))) (( 00000920 + 00000930 +(CONSTANT (LAMBDA (U) 00000940 + (DEFLIST U (QUOTE CONSTANT)))) 00000950 + 00000960 +(LOSE (LAMBDA (U) 00000970 + (FLAG U (QUOTE LOSE)))) 00000980 + 00000990 +(NEWFORM (LAMBDA (U) 00001000 + (DEFLIST U (QUOTE NEWFORM)))) 00001010 + 00001020 +(NEWNAM (LAMBDA (U) 00001030 + (DEFLIST U (QUOTE NEWNAM)))) 00001040 + 00001050 +)) 00001060 + 00001070 + 00001080 +(LAMBDA (U) (COMPILE (DEFLIST U (QUOTE EXPR)))) (( 00001090 + 00001100 +(SUBLIS (LAMBDA (U V) (COND 00001110 + ((NULL U) V) 00001120 + (T ((LAMBDA (X) (COND 00001130 + (X (CDR X)) 00001140 + ((ATOM V) V) 00001150 + (T (CONS (SUBLIS U (CAR V)) (SUBLIS U (CDR V)))))) 00001160 + (SASSOC V U (FUNCTION (LAMBDA NIL NIL)))))))) 00001170 +)) 00001180 + 00001190 +CONSTANT (( 00001200 + (**BLANK $$$ $) 00001210 + (**COMMA $$$,$) 00001220 + (**DOLLAR $$/$/) 00001230 + (**ESC ESC) 00001240 + (**LPAR $$$($) 00001250 + (**MILLION 1000000) 00001260 + (**DASH $$$-$) 00001270 + (**DOT $$$.$) 00001280 + (**RPAR $$$)$) 00001290 + (**SEMICOL $$$;$) 00001300 + (**STAR $$$*$) 00001310 +(**EMARK $$/$/) 00001320 + (**FMARK $$$&$) 00001330 + (**QMARK $$$'$) 00001340 + (**SMARK $$$"$) 00001350 + (**XMARK $$$!$) 00001360 + (**EOF EOF) 00001370 + (**PLUSS $$$+$) 00001380 + (**ENDMSG $$$LEAVING REDUCE ...$) 00001390 +)) 00001400 + 00001410 +NEWNAM (( 00001420 + (DIGIT DIGP) 00001430 + (EVENP *EVENP) 00001440 + (EXPLODE *EXPLODE) 00001450 + (LITER LETP) 00001460 + (OPEN *OPEN) 00001470 +(PAIR PAIRX) 00001471 +(PAUSE TERPRI) 00001472 + (PRINC PRIN1) 00001480 + (RDS *RDS) 00001500 + (SPACES XTAB) 00001510 + (WRS *WRS) 00001520 +)) 00001530 + 00001540 + 00001550 +NEWFORM (( 00001560 + (*APPLY (LAMBDA (U V) (APPLY U V ALIST))) 00001570 + (CAAAAR (LAMBDA (U) (CAAR (CAAR U)))) 00001580 + (CAAADR (LAMBDA (U) (CAAR (CADR U)))) 00001590 + (CAADAR (LAMBDA (U) (CAAR (CDAR U)))) 00001600 + (CAADDR (LAMBDA (U) (CAAR (CDDR U)))) 00001610 + (CADAAR (LAMBDA (U) (CADR (CAAR U)))) 00001620 + (CADADR (LAMBDA (U) (CADR (CADR U)))) 00001630 + (CADDAR (LAMBDA (U) (CADR (CDAR U)))) 00001640 + (CADDDR (LAMBDA (U) (CADR (CDDR U)))) 00001650 + (CDAAAR (LAMBDA (U) (CDAR (CAAR U)))) 00001660 + (CDAADR (LAMBDA (U) (CDAR (CADR U)))) 00001670 + (CDADAR (LAMBDA (U) (CDAR (CDAR U)))) 00001680 + (CDDAAR (LAMBDA (U) (CDDR (CAAR U)))) 00001690 + (CDDADR (LAMBDA (U) (CDDR (CADR U)))) 00001700 + (CDDDAR (LAMBDA (U) (CDDR (CDAR U)))) 00001710 + (CDDDDR (LAMBDA (U) (CDDR (CDDR U)))) 00001720 + (DIVIDE (LAMBDA (U V) (CONS (QUOTIENT U V) (REMAINDER U V)))) 00001730 + (ERRORSET (LAMBDA (U V) (LIST (*EVAL U)))) 00001740 + (GENSYM (LAMBDA NIL (GENSYM1 (QUOTE $$$ G$)))) 00001750 + (ONEP (LAMBDA (N) (EQUAL N 1))) 00001760 + (READCH (LAMBDA NIL (READCH NIL))) 00001770 +)) 00001780 + 00001790 + 00001800 + 00001810 +COMMENT ((DECLARATION OF SPECIAL AND GLOBAL VARIABLES)) 00001820 + 00001830 +COMMENT ((THE FOLLOWING ARE EXTENDED SPECIAL VARIABLES)) 00001840 + 00001850 +SPECIAL ((*S* *S1*)) 00001860 + 00001870 +COMMENT ((THE FOLLOWING VARIABLES ARE GLOBAL TO ALL FUNCTIONS)) 00001880 + 00001890 +SPECIAL(( 00001900 + IFL* OFL* IPL* OPL* PRI* CRCHAR* SV* MCOND* 00001910 + *FORT *ECHO *INT PRECLIS* ORIG* POSN* *NAT YCOORD* 00001920 + YMIN* YMAX* *LIST COUNT* *CARDNO ECHO* FORTVAR* 00001930 + LLENGTH* PLINE* CURSYM* *MODE MATP* DEFN* 00001940 + SEMIC* SYMFG* VARS* TMODE* *SQVAR* PROGRAM* PROGRAML* 00001950 + *GCD *EXP *MCD *FLOAT MATCH* *DIV *RAT *SUPER *MSG 00001960 + *ALLFAC *NCMP SUBFG* FRLIS1* FRLIS* GAMIDEN* SUB2* 00001970 + RPLIS* SUBL* DSUBL* FACTORS* FRASC* VREP* INDICES* 00001980 + WTP* SNO* *RAT *OUTP DIAG* 00001990 + MCHFG* SYMFG* *ANS *RESUBS *NERO EXLIST* ORDN* 00002000 +NAT** 00002001 +)) 00002010 + 00002020 +COMMENT ((THE FOLLOWING VARIABLE IS USED AS A FUNCTIONAL ARGUMENT)) 00002030 + 00002040 +COMMON ((*PI*)) 00002050 + 00002060 +REMPROP (F APVAL) 00002070 + 00002080 + 00002090 +COMMENT ((REDUCE FUNCTIONS WITH SYSTEM DEPENDENT PROPERTIES)) 00002100 + 00002110 +DEFLIST (( 00002120 + 00002130 +(INIT (LAMBDA NIL (PROG NIL 00002140 + (PTS (QUOTE NOCMP*) T) 00002150 + (RECLAIM) 00002160 + (OPEN (QUOTE REDUCE) (QUOTE SYSFILE) (QUOTE OUTPUT)) 00002170 + (REMPROP (QUOTE INIT) (QUOTE EXPR)) 00002200 + (RETURN (QUOTE ***))))) 00002210 + 00002220 +) EXPR) 00002230 + 00002240 +(LAMBDA (U) (COMPILE (DEFLIST U (QUOTE EXPR)))) (( 00002250 + 00002260 +(MKSTRING (LAMBDA (U) 00002270 +(LIST (QUOTE QUOTE)(COMPRESS (DELETE (QUOTE $$$"$) (CDR U)))))) 00002280 + 00002281 +(PRINTTY (LAMBDA (U) 00002282 + (AND *NAT (PRINT U)))) 00002283 + 00002290 +(READCH* (LAMBDA NIL 00002300 + (SETQ CRCHAR* (READCH NIL)))) 00002310 + 00002320 +)) 00002330 + 00002340 +(LAMBDA (U) (COMPILE (DEFLIST U (QUOTE EXPR)))) (( 00002390 + 00002400 +(BEGIN (LAMBDA NIL (PROG NIL 00002410 + (OVOFF) 00002420 + (SETQ NOCMP* T) 00002430 + (SETQ *INT NIL) 00002440 + (SETQ *ECHO T) 00002450 + (SETQ ORIG* 0) 00002460 + (SETP) 00002470 + (SETQ *MODE (QUOTE ALGEBRAIC)) 00002480 + (COND ((NULL DATE*) (GO A0))) 00002490 + (VERBOS NIL) 00002500 + (EXCISE T) 00002510 + (EXITERR T) 00002520 + (EJECT) 00002521 + (PRIN1 (QUOTE $$$REDUCE2($)) 00002522 + (PRIN1 DATE*) 00002523 + (PRIN1 (QUOTE $$$) ...$)) 00002524 + (TERPRI) (SETQ DATE* NIL) 00002525 + A0 (SETQ IFL* NIL) 00002540 + (SETQ OFL* NIL) 00002550 + (RETURN (BEGIN1))))) 00002570 + 00002580 +)) 00002590 + 00002600 + 00002610 +COMMENT ((REDUCE FUNCTIONS DEFINED IN TERMS OF SYSTEM FUNCTIONS 00002620 + OF THE SAME NAME)) 00002630 + 00002640 +COMMENT ((THE FOLLOWING LIST IS USED BY EXPLODN1 DEFINED BELOW)) 00002650 + 00002660 +DEFLIST (((NASL* (((0 . $$$0$) (1 . $$$1$) (2 . $$$2$) (3 . $$$3$) 00002670 + (4 . $$$4$) (5 . $$$5$) (6 . $$$6$) (7 . $$$7$) 00002680 + (8 . $$$8$) (9 . $$$9$))))) SPECIAL) 00002690 + 00002700 +DEFLIST (((BLKSIZE* (80))) SPECIAL) 00002701 + 00002702 +(LAMBDA (U) (COMPILE (DEFLIST U (QUOTE EXPR)))) (( 00002710 + 00002720 +(*EXPLODE (LAMBDA (U) (COND 00002730 + ((NUMBERP U) (EXPLODN U)) 00002740 + (T (EXPLODE U))))) 00002750 + 00002760 +(EXPLODN (LAMBDA (U) (COND 00002770 + ((ZEROP U) (LIST (QUOTE $$$0$))) 00002780 + ((MINUSP U) (CONS (QUOTE $$$-$) (EXPLODN (MINUS U)))) 00002790 + ((NOT (FIXP U)) (LIST 1 2 3 4 5 6 7 8 9 0 1 2)) 00002800 + (T (EXPLODN1 U))))) 00002810 + 00002820 +(EXPLODN1 (LAMBDA (U) (PROG (Z) 00002830 + A (COND ((ZEROP U) (RETURN Z))) 00002840 + (SETQ Z (CONS (CDR (ASSOC* (REMAINDER U 10) NASL*)) Z)) 00002850 + (SETQ U (QUOTIENT U 10)) 00002860 + (GO A)))) 00002870 + 00002880 +(ASSOC* (LAMBDA (U V) 00002890 + (COND ((NULL V) NIL) 00002900 + ((EQUAL U (CAAR V)) (CAR V)) 00002910 + (T (ASSOC* U (CDR V)))))) 00002920 + 00002930 +(*OPEN (LAMBDA (U V) (PROG2 00002935 + (OPEN U (LIST (QUOTE (LRECL . 80)) (CONS (QUOTE BLKSIZE) 00002940 + BLKSIZE*)) V) 00002945 + U))) 00002950 + 00002960 +(*RDS (LAMBDA (U) (COND 00002970 + ((NULL U) (RDS (QUOTE LISPIN))) 00002980 + (T (RDS U))))) 00002990 + 00003000 +(*WRS (LAMBDA (U) (COND 00003010 + ((NULL U) (WRS (QUOTE LISPOUT))) 00003020 + (T (PROG NIL (OTLL 72) (ASA NIL) (WRS U)))))) 00003030 +)) 00003040 + 00003050 +LOSE ((ASSOC* REMK* TERMS CKRN* UP DOWN SYMMETRIC ANTISYMMETRIC)) 00003060 + 00003070 +COMMENT ((STANDARD LISP FUNCTIONS NOT DEFINED IN LISP/360)) 00003080 + 00003090 + 00003100 +DEFINE (( 00003110 + 00003120 +(COMPRESS (LAMBDA (U) 00003130 + (PROG2 (COND ((DIGIT (CAR U)) 00003140 + (MAP U (FUNCTION (LAMBDA (J) (RNUMB (CAR J)))))) 00003150 + (T (MAP U (FUNCTION (LAMBDA (J) (RLIT (CAR J))))))) 00003160 + (MKATOM)))) 00003170 + 00003180 +(GTS (LAMBDA (U) ((LAMBDA (X) (COND 00003190 + ((NULL X) (ERROR (LIST (QUOTE GTS) U))) 00003200 + (T (CAR X)))) (GET U (QUOTE SPECIAL))))) 00003210 + 00003220 +(PTS (LAMBDA (U V) (CAR ((LAMBDA (X) (COND 00003230 + ((NULL X) (PUT U (QUOTE SPECIAL) (LIST V))) 00003240 + (T (RPLACA X V)))) (GET U (QUOTE SPECIAL)))))) 00003250 + 00003260 +(PUT (LAMBDA (U V W) 00003270 + (PROG2 (DEFLIST (LIST (LIST U W)) V) W))) 00003280 + 00003290 +(*EVAL (LAMBDA (U) ((LAMBDA (X) (COND 00003300 + (X (CAR X)) 00003310 + (T (EVAL U ALIST)))) 00003320 + (GET* U (QUOTE SPECIAL))))) 00003330 + 00003340 +(PAIRX (LAMBDA (U V) 00003341 + (COND ((AND (NULL U) (NULL V)) NIL) 00003342 + ((OR (NULL U) (NULL V)) (ERROR (QUOTE (PAIR MISMATCH)))) 00003343 + (T (CONS (CONS (CAR U) (CAR V)) (PAIRX (CDR U) (CDR V))))))) 00003344 + 00003345 +)) 00003350 + 00003360 +COMMENT ((REDEFINING SOME FUNCTIONS EXCISED FROM THE COMPILER)) 00003370 + 00003380 +DEFINE (( 00003390 + 00003400 +(MAP (LAMBDA (U *PI*) 00003410 + (PROG NIL 00003420 + A (COND ((NULL U) (RETURN NIL))) 00003430 + (*PI* U) 00003440 + (SETQ U (CDR U)) 00003450 + (GO A)))) 00003460 + 00003470 +(MAPCON (LAMBDA (U *PI*) 00003480 + (COND ((NULL U) NIL) 00003490 + (T (NCONC (*PI* U) (MAPCON (CDR U) *PI*)))))) 00003500 + 00003510 +(REVERSE (LAMBDA (U) 00003520 + (PROG (V) 00003530 + A (COND ((NULL U) (RETURN V))) 00003540 + (SETQ V (CONS (CAR U) V)) 00003550 + (SETQ U (CDR U)) 00003560 + (GO A)))) 00003570 + 00003580 +(SUBST (LAMBDA (U V W) 00003590 + (COND ((NULL W) NIL) 00003600 + ((EQUAL V W) U) 00003610 + ((ATOM W) W) 00003620 + (T (CONS (SUBST U V (CAR W)) (SUBST U V (CDR W))))))) 00003630 + 00003640 +)) 00003650 + 00003660 +COMMENT (ARRAY HANDLING ROUTINES) 00003670 + 00003680 +DEFINE (( 00003690 + 00003700 +(*ARRAY (LAMBDA (U) 00003710 + (MAP U (FUNCTION (LAMBDA (J) 00003720 + (PUT (CAAR J) (QUOTE ARRAY) (MKARRAY (CDAR J)))))))) 00003730 + 00003740 +(MKARRAY (LAMBDA (U) 00003750 + (COND ((NULL U) NIL) 00003760 + (T (ARLIST (CDR U) (CAR U)))))) 00003770 + 00003772 +(ARLIST (LAMBDA (U N) 00003774 + (COND ((ZEROP N) NIL) (T (CONS (MKARRAY U) (ARLIST U (SUB1 N))))))) 00003776 + 00003780 +(GETEL (LAMBDA (U) 00003790 + (GETEL1 (GET (CAR U) (QUOTE ARRAY)) (CDR U)))) 00003800 + 00003810 +(GETEL1 (LAMBDA (U V) 00003820 + (COND ((NULL V) U) 00003830 + (T (GETEL1 (NTH U (ADD1 (CAR V))) (CDR V)))))) 00003840 + 00003850 +(SETEL (LAMBDA (U V) 00003860 + (PROG (X N) 00003870 + (SETQ X (REVERSE (CDR U))) 00003880 + (SETQ N (CAR X)) 00003890 + (SETQ X (GETEL1 (GET (CAR U) (QUOTE ARRAY)) 00003900 + (REVERSE (CDR X)))) 00003910 + A (COND ((EQUAL N 0) (RETURN (RPLACA X V)))) 00003920 + (SETQ N (SUB1 N)) 00003930 + (SETQ X (CDR X)) 00003940 + (GO A)))) 00003950 + 00003960 +)) 00003970 + 00003980 +COMMENT ((I O HANDLING ROUTINES)) 00003990 + 00004000 +DEFINE (( 00004010 + 00004020 +(IN (LAMBDA (U) 00004030 + (INOUT U (QUOTE INPUT)))) 00004040 + 00004050 +(OUT (LAMBDA (U) 00004060 + (INOUT U (QUOTE OUTPUT)))) 00004070 + 00004080 +(INOUT (LAMBDA (U V) 00004090 + (PROG (ECHO INT) 00004100 + (SETQ ECHO *ECHO) 00004110 + (SETQ INT *INT) 00004120 + A (COND ((NULL U) (GO E)) 00004130 + ((EQ V (QUOTE OUTPUT)) (GO C)) 00004140 + ((EQ (CAR U) (QUOTE T)) (GO L))) 00004150 + (SETQ IFL* (CAR U)) 00004160 + (COND ((MEMBER IFL* IPL*) (GO B))) 00004170 + (OPEN IFL* V) 00004180 + (SETQ IPL* (CONS IFL* IPL*)) 00004190 + B (RDS IFL*) 00004200 + (SETQ *ECHO T) 00004210 + (SETQ *INT NIL) 00004220 + (BEGIN1) 00004230 + (SETQ U (CDR U)) 00004240 + (GO A) 00004250 + C (COND ((EQ (CAR U) (QUOTE T)) (GO M))) 00004260 + (SETQ OFL* (CAR U)) 00004270 + (COND ((MEMBER OFL* OPL*) (GO D))) 00004280 + (OPEN OFL* V) 00004290 + (SETQ OPL* (CONS OFL* OPL*)) 00004300 + D (WRS OFL*) 00004310 + E (SETQ *ECHO ECHO) 00004320 + (SETQ *INT INT) 00004330 + (RETURN NIL) 00004340 + L (SETQ IFL* NIL) 00004350 + (RDS NIL) 00004360 + (GO E) 00004370 + M (SETQ OFL* NIL) 00004380 + (WRS NIL) 00004390 + (GO E) 00004400 +))) 00004410 + 00004420 +(SHUT (LAMBDA (U) 00004430 + (PROG (X) 00004440 + A (COND ((NULL U) (RETURN NIL))) 00004450 + (SETQ X (CAR U)) 00004460 + (COND ((MEMBER X OPL*) (GO B)) 00004470 + ((NOT (MEMBER X IPL*)) 00004480 + (REDERR (CONS X (QUOTE (NOT OPEN)))))) 00004490 + (CLOSE X) 00004500 + (SETQ IPL* (DELETE X IPL*)) 00004510 + (COND ((NOT (EQUAL X IFL*)) (GO C))) 00004520 + (RDS (SETQ IFL* (COND (IPL* (CAR IPL*)) (T NIL)))) 00004530 + (GO C) 00004540 + B (SETQ OPL* (DELETE X OPL*)) 00004550 + (CLOSE X) 00004560 + (COND ((NOT (EQ X OFL*)) (GO C))) 00004570 + (SETQ OFL* NIL) 00004580 + (WRS NIL) 00004590 + C (SETQ U (CDR U)) 00004600 + (GO A)))) 00004610 + 00004620 +)) 00004630 + 00004640 +DEFLIST (((SHUT RLIS) (IN RLIS) (OUT RLIS)) STAT) 00004650 + 00004660 + 00004670 +COMMENT ((INITIALIZATION OF INPUT AND OUTPUT CHARACTER STRINGS)) 00004680 + 00004690 +CSET (SWITCH* ( 00004700 + ($$*$* NIL *SEMICOL* NIL) 00004710 + ($$$;$ NIL *SEMICOL* NIL) 00004720 + ($$$+$ NIL PLUS NIL $$$ + $) 00004730 + ($$$-$ NIL MINUS NIL $$$ - $) 00004740 + ($$$*$ $$$*$ TIMES EXPT) 00004750 +($$$/$ NIL QUOTIENT NIL) 00004760 + ($$$=$ NIL EQUAL NIL) 00004770 + ($$$,$ NIL *COMMA* NIL) 00004780 + ($$$($ NIL *LPAR* NIL) 00004790 + ($$$)$ NIL *RPAR* NIL) 00004800 + ($$$.$ NIL CONS NIL) 00004810 + ($$$:$ $$$=$ *COLON* SETQ) 00004820 + ($$$<$ $$$=$ LESSP LESSEQ) 00004830 + ($$$>$ $$$=$ GREATERP GREATEQ) 00004840 +)) 00004850 + 00004860 + 00004870 +COMMENT ((E N D O F R E D U C E P R E P R O C E S S O R)) 00004880 + 00004890 + 00004900 + 00004910 + 00010000 + 00010010 + 00010020 +COMMENT ((R E D U C E M A I N P R O G R A M)) 00010030 + 00010040 +(LAMBDA (U) (MAP U (FUNCTION (LAMBDA (J) (PTS (CAR J) NIL))))) ((*FORT 00010050 + *ECHO *INT PRECLIS* ORIG* POSN* *NAT YCOORD* YMIN* YMAX* *LIST COUNT* 00010060 + *CARDNO ECHO* FORTVAR* LLENGTH* PLINE* CURSYM* *MODE MATP* DEFN* 00010070 + SEMIC* SYMFG* *MSG TMODE* *SQVAR* PROGRAM* PROGRAML* DIAG* VARS* 00010080 + CRCHAR* IFL* OFL* IPL* OPL* PRI* ERFG*)) 00010090 + 00010100 +(LAMBDA (U) (MAP U (FUNCTION (LAMBDA (J) (PTS (CAAR J) (CADAR J)))))) 00010110 +(((*NAT T) (COUNT* 1) (*CARDNO 20) (ORIG* 0) (LLENGTH* 67) (*SQVAR* (T 00010120 +)))) 00010130 + 00010140 +DEFINE (( 00010150 + 00010160 +(FLAGP** (LAMBDA (U V) 00010170 + (AND (ATOM U) (NOT (NUMBERP U)) (FLAGP U V)))) 00010180 + 00010190 +(GET* (LAMBDA (U V) 00010200 + (COND ((NUMBERP U) NIL) (T (GET U V))))) 00010210 + 00010220 +(EQCAR (LAMBDA (U V) 00010230 + (AND (NOT (ATOM U)) (EQ (CAR U) V)))) 00010240 + 00010250 +(MKPREC (LAMBDA NIL 00010260 + (PROG (X Y) 00010270 + (SETQ X (CONS (QUOTE SETQ) PRECLIS*)) 00010280 + (SETQ Y 2) 00010290 + A (COND ((NULL X) (RETURN NIL))) 00010300 + (PUT (CAR X) (QUOTE INFIX) Y) 00010310 + (SETQ X (CDR X)) 00010320 + (SETQ Y (ADD1 Y)) 00010330 + (GO A)))) 00010340 + 00010350 +)) 00010360 + 00010370 +PTS (PRECLIS* (AND OR MEMBER EQUAL UNEQ EQ GREATEQ GREATERP LESSEQ 00010380 + LESSP PLUS MINUS TIMES QUOTIENT EXPT CONS)) 00010390 + 00010400 +(LAMBDA NIL (PROG (W X Y Z) (MKPREC) (SETQ X SWITCH*) (MAP X (FUNCTION 00010410 + (LAMBDA (J) (PUT (CAAR J) (QUOTE SWITCH*) (CDAR J))))) A (COND ((NULL 00010420 + X) (RETURN NIL))) (SETQ W (CDAR X)) (PUT (CADR W) (QUOTE PRTCH) (LIST 00010430 + (CAAR X) (CAAR X))) (COND ((CAR (SETQ Y (CDDR W))) (PROG2 (SETQ Z 00010440 +(COMPRESS (LIST (CAAR X)(CAR W))))(PUT (CAR Y)(QUOTE PRTCH) (LIST Z Z) 00010450 +)))) (COND ((NULL (CDR Y)) (GO B)) ((CADR Y) (RPLACA (GET (CADR W) 00010460 +(QUOTE PRTCH))(CADR Y))))(COND ((CDDR Y)(RPLACA (GET (CAR Y) (QUOTE 00010470 + PRTCH)) (CADDR Y)))) B (SETQ X (CDR X)) (GO A))) NIL 00010480 + 00010490 +DEFLIST (((MINUS (PLUS . MINUS))) ALT) 00010500 + 00010510 +DEFINE (( 00010520 + 00010530 +(RVLIS (LAMBDA NIL 00010540 + (PROG (X) 00010550 + A (SETQ X (CONS (SCAN) X)) 00010560 + (COND 00010570 + ((OR (FLAGP** (SCAN) (QUOTE DELIM)) 00010580 + (MEMBER CURSYM* (QUOTE (CLEAR LET MATCH SAVEAS)))) 00010590 + (RETURN X)) 00010600 + ((NOT (EQ CURSYM* (QUOTE *COMMA*))) (CURERR NIL T))) 00010610 + (GO A)))) 00010620 + 00010630 +(INFIXFN (LAMBDA NIL 00010640 + (PROG (X) 00010650 + (SETQ X (RVLIS)) 00010660 + (COND 00010670 + ((EQ *MODE (QUOTE ALGEBRAIC)) 00010680 + (*APPLY (QUOTE OPERATOR) (LIST X)))) 00010690 + (SETQ PRECLIS* (APPEND X PRECLIS*)) 00010700 + (MKPREC)))) 00010710 + 00010720 +(PRECEDFN (LAMBDA NIL 00010730 + (PROG (W X Y Z) 00010740 + (SETQ X (RVLIS)) 00010750 + (SETQ Y (CAR X)) 00010760 + (SETQ X (CADR X)) 00010770 + (SETQ PRECLIS* (DELETE X PRECLIS*)) 00010780 + (SETQ W PRECLIS*) 00010790 + A (COND ((NULL W) (REDERR (CONS Y (QUOTE (NOT FOUND))))) 00010800 + ((EQ Y (CAR W)) (GO B))) 00010810 + (SETQ Z (CONS (CAR W) Z)) 00010820 + (SETQ W (CDR W)) 00010830 + (GO A) 00010840 + B (SETQ PRECLIS* 00010850 + (NCONC (REVERSE Z) (CONS (CAR W) (CONS X (CDR W))))) 00010860 + (MKPREC)))) 00010870 + 00010880 +)) 00010890 + 00010900 +DEFINE (( 00010910 + 00010920 +(MATHPRINT (LAMBDA (L) 00010930 + (PROG NIL (MAPRIN L) (TERPRI*)))) 00010940 + 00010950 +(MAPRIN (LAMBDA (U) 00010960 + (MAPRINT U 0))) 00010970 + 00010980 +(MAPRINT (LAMBDA (L P) 00010990 + (PROG (X Y) 00011000 + (COND ((NULL L) (RETURN NIL)) 00011010 + ((ATOM L) (GO B)) 00011020 + ((NOT (ATOM (CAR L))) (MAPRINT (CAR L) P)) 00011030 + ((SETQ X (GET* (CAR L) (QUOTE INFIX))) (GO A)) 00011040 + ((SETQ X (GET* (CAR L) (QUOTE SPECPRN))) 00011050 + (RETURN (*APPLY X (LIST (CDR L))))) 00011060 + (T (PRINC* (CAR L)))) 00011070 + (PRINC* **LPAR) 00011080 + (INPRINT (QUOTE *COMMA*) 0 (CDR L)) 00011090 + E (RETURN (PRINC* **RPAR)) 00011100 + B (COND ((NUMBERP L) (GO D)) 00011110 + ((SETQ X (GET L (QUOTE OLDNAME))) 00011120 + (RETURN (PRINC* X)))) 00011130 + C (RETURN (PRINC* L)) 00011140 + D (COND ((NOT (MINUSP L)) (GO C))) 00011150 + (PRINC* **LPAR) 00011160 + (PRINC* L) 00011170 + (GO E) 00011180 + A (SETQ P (NOT (GREATERP X P))) 00011190 + (COND ((NOT P) (GO G))) 00011200 + (SETQ Y ORIG*) 00011210 + (PRINC* **LPAR) 00011220 + (COND ((LESSP POSN* 15) (SETQ ORIG* POSN*))) 00011230 + G (INPRINT (CAR L) X (CDR L)) 00011240 + (COND ((NOT P) (RETURN NIL))) 00011250 + (PRINC* **RPAR) 00011260 + (SETQ ORIG* Y)))) 00011270 + 00011280 +(INPRINT (LAMBDA (OP P L) 00011290 + (PROG NIL 00011300 + (COND ((FLAGP OP (QUOTE UNIP)) (GO A))) 00011310 + (MAPRINT (CAR L) P) 00011320 + (GO C) 00011330 + A (COND ((NULL L) (RETURN NIL)) 00011340 + ((AND (NOT (ATOM (CAR L))) 00011350 + (GET* (CAAR L) (QUOTE ALT)) 00011360 + (EQ OP (CAR (GET* (CAAR L) (QUOTE ALT))))) 00011370 + (GO B))) 00011380 + (OPRIN OP) 00011390 + B (MAPRINT (CAR L) P) 00011400 + (COND ((OR (NOT *NAT) (NOT (EQ OP (QUOTE EXPT)))) (GO C))) 00011410 + (SETQ YCOORD* (SUB1 YCOORD*)) 00011420 + (SETQ YMIN* (*EVAL (LIST (QUOTE MIN) YMIN* YCOORD*))) 00011430 + C (SETQ L (CDR L)) 00011440 + (GO A)))) 00011450 + 00011460 +)) 00011470 + 00011480 +DEFINE (( 00011490 + 00011500 +(OPRIN (LAMBDA (OP) 00011510 + ((LAMBDA(X) 00011520 + (COND ((NULL X) (PRINC* OP)) 00011530 + (*FORT (PRINC* (CADR X))) 00011540 + (*NAT 00011550 + (COND ((EQ OP (QUOTE EXPT)) 00011560 + (PROG NIL 00011570 + (SETQ YCOORD* (ADD1 YCOORD*)) 00011580 + (SETQ YMAX* 00011590 + (*EVAL 00011600 + (LIST (QUOTE MAX) YMAX* YCOORD*))))) 00011610 + ((AND *LIST 00011620 + (MEMBER OP (QUOTE (PLUS MINUS QUOTIENT)))) 00011630 + (PROG NIL (CLOSELINE) (TERPRI) (PPRINT (CAR X)))) 00011640 + (T (PPRINT (CAR X))))) 00011650 + (T (PRINC (CAR X))))) 00011660 + (GET OP (QUOTE PRTCH))))) 00011670 + 00011680 +(PRINC* (LAMBDA (U) 00011690 + (COND (*NAT (PPRINT U)) 00011700 + ((NULL *FORT) (PRINC U)) 00011710 + (T 00011720 + (PROG NIL 00011730 + (COND 00011740 + ((AND (EQUAL COUNT* *CARDNO) 00011750 + (OR (EQ U **PLUSS) (EQ U **DASH))) 00011760 + (GO B)) 00011770 + ((NOT 00011780 + (GREATERP (SETQ POSN* 00011790 + (PLUS POSN* (LENGTH (EXPLODE U)))) 00011800 + 69)) 00011810 + (GO A))) 00011820 + (TERPRI) 00011830 + (SPACES 5) 00011840 + (PRINC (QUOTE X)) 00011850 + (SETQ POSN* (PLUS 6 (LENGTH (EXPLODE U)))) 00011860 + (SETQ COUNT* (ADD1 COUNT*)) 00011870 + A (RETURN (COND (ECHO* (PRINC U)) (T NIL))) 00011880 + B (TERPRI) 00011890 + (SPACES 6) 00011900 + (PRINC FORTVAR*) 00011910 + (OPRIN (QUOTE EQUAL)) 00011920 + (PRINC FORTVAR*) 00011930 + (SETQ COUNT* 1) 00011940 + (SETQ POSN* 20) 00011941 + (GO A)))))) 00011950 + 00011960 +(TERPRI* (LAMBDA NIL 00011970 + (COND (*NAT (PROG NIL (CLOSELINE) (COND (ECHO* (TERPRI))))) 00011980 + (*FORT (COND ((ZEROP POSN*) NIL) 00011990 + (T (PROG NIL (TERPRI) (SETQ COUNT* 1) 00011992 + (SETQ POSN* 0))))) 00011994 + (T (TERPRI))))) 00012000 + 00012010 +(PPRINT (LAMBDA (U) 00012020 + (PROG (M N) 00012030 + (SETQ N (LENGTH (EXPLODE U))) 00012040 + (COND ((GREATERP N LLENGTH*) (GO A1))) 00012050 + C (SETQ M (PLUS POSN* N)) 00012060 + (COND ((AND (GREATERP M LLENGTH*) (NOT (TERPRI*))) (GO C))) 00012070 + (SETQ PLINE* 00012080 + (CONS (CONS (CONS (CONS POSN* M) YCOORD*) U) PLINE*)) 00012090 + A (RETURN (SETQ POSN* M)) 00012100 + A1 (TERPRI*) 00012110 + (PRINC U) 00012120 + (RETURN (SETQ POSN* (REMAINDER N LLENGTH*)))))) 00012130 + 00012140 +(CLOSELINE (LAMBDA NIL 00012150 + (PROG (N) 00012160 + (COND ((OR (NULL PLINE*) (NULL ECHO*)) (GO C))) 00012170 + (SETQ N YMAX*) 00012180 + (SETQ PLINE* (REVERSE PLINE*)) 00012190 + A (SCPRINT PLINE* N) 00012200 + (COND ((EQUAL N YMIN*) (GO B))) 00012210 + (TERPRI) 00012220 + (SETQ N (SUB1 N)) 00012230 + (GO A) 00012240 + B (COND ((EQ ECHO* (QUOTE RESULT)) (TERPRI))) 00012250 + C (SETP)))) 00012260 + 00012270 +(SCPRINT (LAMBDA (U N) 00012280 + (PROG (M) 00012290 + (SETQ POSN* 0) 00012300 + A (COND ((NULL U) (RETURN NIL)) 00012310 + ((NOT (EQUAL (CDAAR U) N)) (GO B)) 00012320 + ((NOT (MINUSP (SETQ M (DIFFERENCE (CAAAAR U) POSN*)))) 00012330 + (SPACES M))) 00012340 + (PRINC (CDAR U)) 00012350 + (SETQ POSN* (CDAAAR U)) 00012360 + B (SETQ U (CDR U)) 00012370 + (GO A)))) 00012380 + 00012390 +(SPACES* (LAMBDA (N) 00012400 + (COND (*NAT (SETQ POSN* (PLUS N POSN*))) (T (SPACES N))))) 00012410 + 00012420 +)) 00012430 + 00012440 +DEFINE (( 00012450 + 00012460 +(SETP (LAMBDA NIL 00012470 + (PROG NIL 00012480 + (SETQ PLINE* NIL) 00012490 + (SETQ POSN* ORIG*) 00012500 + (SETQ YMAX* 0) 00012510 + (SETQ YMIN* 0) 00012520 + (SETQ YCOORD* 0)))) 00012530 + 00012540 +)) 00012550 + 00012560 +FLAG ((MINUS NOT) UNIP) 00012570 + 00012580 +DEFINE (( 00012590 + 00012600 +(MREAD* (LAMBDA (J) 00012610 + (PROG2 (SCAN) (MREAD J)))) 00012620 + 00012630 +(MREAD (LAMBDA (J) 00012640 + (PROG (U V W W1 X Y Z) 00012650 + (SETQ Z -1) 00012660 + A (SETQ V CURSYM*) 00012670 + (COND ((OR (NOT (ATOM V)) (NUMBERP V)) (GO B)) 00012680 + ((FLAGP V (QUOTE DELIM)) (GO ERR1)) 00012682 + ((EQ V (QUOTE *LPAR*)) (GO E)) 00012690 + ((AND (EQ V (QUOTE *RPAR*)) (NULL U)) (RETURN NIL))) 00012700 + (SETQ X (GET V (QUOTE INFIX))) 00012710 + B0 (COND ((SETQ W (GET* V (QUOTE ISTAT))) (GO L))) 00012720 + B (SETQ W (SCAN)) 00012750 + BX (SETQ Y NIL) 00012760 + (COND ((OR (NOT (ATOM W)) (NUMBERP W)) (GO B2)) 00012762 + ((FLAGP W (QUOTE DELIM)) (GO ENDD)) 00012764 + ((EQ W (QUOTE *LPAR*)) (GO E2)) 00012770 + ((EQ W (QUOTE *RPAR*)) (GO END0)) 00012780 + (U (GO B1))) 00012790 + BY (COND 00012800 + ((AND J 00012870 + (EQ W (QUOTE *COMMA*)) 00012880 + (NOT (MEMBER J (QUOTE (MAT PAREN FUNC))))) 00012890 + (RETURN V))) 00012900 + B1 (SETQ Y (GET W (QUOTE INFIX))) 00012910 + B2 (COND ((NULL X) (GO SYM)) 00012920 + ((NOT (FLAGP V (QUOTE UNARY))) (GO ERR3))) 00012930 + C (SETQ Z X) 00012940 + (SETQ U (CONS (LIST V) U)) 00012950 + (SETQ V W) 00012960 + (SETQ X Y) 00012970 + (COND ((OR (NOT (ATOM V)) (NUMBERP V)) (GO B)) (T (GO B0))) 00012980 + SYM (COND ((NULL Y) (GO M)) 00012990 + ((AND (NULL W1) 00013000 + (SETQ W1 (GET W (QUOTE ALT))) 00013010 + (SETQ W (CAR W1))) 00013020 + (GO B1))) 00013030 + SYM1 (COND ((OR (NULL Z) (LESSP Y Z)) (GO H)) 00013040 + ((OR (GREATERP Y Z) (FLAGP W (QUOTE BINARY))) (GO G))) 00013050 + (SETQ U (CONS (ACONC (CAR U) V) (CDR U))) 00013060 + (GO G1) 00013070 + E (SETQ V 00013080 + (MREAD* 00013090 + (COND ((EQ J (QUOTE MAT)) (QUOTE FUNC)) 00013100 + (T (QUOTE PAREN))))) 00013110 + (GO B) 00013130 + E2 (COND ((EQ V (QUOTE MAT)) 00013140 + (SETQ V (CONS V (REMCOMMA (MREAD* (SETQ MATP* V)))))) 00013150 + ((AND (ATOM V) (GET V (QUOTE UNARY)) 00013152 + (SETQ W (CAR (MREAD* (QUOTE FUNC))))) (GO C)) 00013154 + ((OR (ATOM V) (EQ *MODE (QUOTE SYMBOLIC))) 00013160 + (SETQ V (CONS V (MREAD* (QUOTE FUNC))))) 00013170 + (T (GO ERR4))) 00013180 + (SETQ X NIL) 00013185 + (GO B) 00013190 + G (SETQ U (CONS (LIST W V) U)) 00013200 + (SETQ Z Y) 00013210 + G1 (COND (W1 (GO G2))) 00013220 + (SCAN) 00013230 + G3 (SETQ X NIL) 00013232 + (GO A) 00013240 + G2 (SETQ CURSYM* (CDR W1)) 00013250 + (SETQ W1 NIL) 00013260 + (GO G3) 00013270 + H (SETQ V (ACONC (CAR U) V)) 00013280 + (SETQ U (CDR U)) 00013290 + (COND ((AND (NULL U) (SETQ Z 0)) (GO BY))) 00013300 + (SETQ Z (GET (CAAR U) (QUOTE INFIX))) 00013310 + (GO SYM1) 00013320 + L (SETQ V (*APPLY W NIL)) 00013330 + (SETQ W CURSYM*) 00013340 + (GO BX) 00013350 + M (COND ((NUMBERP V) (GO ERR4)) 00013360 + ((PROGVR V) 00013370 + (LPRIM* 00013380 + (APPEND (QUOTE (PROGRAM VARIABLE)) 00013390 + (CONS V 00013400 + (QUOTE (USED AS OPERATOR))))))) 00013410 + (GO C) 00013420 + END0 (COND ((NULL J) (GO ERR21)) (T (GO END2))) 00013430 + ENDD (COND ((MEMBER J (QUOTE (MAT PAREN FUNC))) (GO ERR22))) 00013440 + END2 (COND (X (GO ERR1))) 00013450 + END1 (COND 00013460 + ((NULL U) 00013470 + (RETURN (COND ((EQ J (QUOTE FUNC)) (REMCOMMA V)) (T V))))) 00013480 + (SETQ V (ACONC (CAR U) V)) 00013490 + (SETQ U (CDR U)) 00013500 + (GO END1) 00013510 + ERR1 (CURERR (QUOTE (SYNTAX ERROR)) NIL) 00013520 + ERR21 00013530 + (CURERR (QUOTE (TOO MANY RIGHT PARENTHESES)) NIL) 00013540 + ERR22 00013550 + (CURERR (QUOTE (TOO FEW RIGHT PARENTHESES)) NIL) 00013560 + ERR3 (CURERR (QUOTE (REDUNDANT OPERATOR)) 1) 00013570 + ERR4 (CURERR (QUOTE (MISSING OPERATOR)) NIL)))) 00013580 + 00013590 +(ACONC (LAMBDA (U V) 00013600 + (NCONC U (LIST V)))) 00013610 + 00013620 +(REMCOMMA (LAMBDA (U) 00013630 + (COND ((EQCAR U (QUOTE *COMMA*)) (CDR U)) (T (LIST U))))) 00013640 + 00013650 +(SCAN (LAMBDA NIL 00013660 + (PROG (X Y) 00013670 + (COND ((EQ CURSYM* (QUOTE *SEMICOL*)) (TERPRI*))) 00013680 + A (COND ((EQ CRCHAR* **BLANK) (GO L)) 00013690 + ((DIGIT CRCHAR*) (GO G)) 00013700 + ((LITER CRCHAR*) (GO E)) 00013710 + ((EQ CRCHAR* **XMARK) (GO E0)) 00013720 + ((EQ CRCHAR* **QMARK) (GO P)) 00013730 + ((EQ CRCHAR* **SMARK) (RETURN (COMM1 NIL))) 00013740 + ((NULL (SETQ X (GET* CRCHAR* (QUOTE SWITCH*)))) 00013750 + (GO B)) 00013760 + ((EQ (SETQ Y (CADR X)) (QUOTE *SEMICOL*)) (GO J)) 00013770 + ((EQ (READCH*) (CAR X)) (GO K))) 00013780 + C (SETQ CURSYM* (CADR X)) 00013790 + D (COND ((AND *ECHO *NAT) (SYMPRI CURSYM*))) 00013800 + (COND 00013810 + ((SETQ X (GET* CURSYM* (QUOTE NEWNAME))) (SETQ CURSYM* X))) 00013820 + D1 (RETURN CURSYM*) 00013830 + E0 (READCH*) 00013840 + E (SETQ Y (CONS CRCHAR* Y)) 00013850 + (COND 00013860 + ((OR (DIGIT (READCH*)) (LITER CRCHAR*)) (GO E)) 00013870 + ((EQ CRCHAR* **XMARK) (GO E0))) 00013880 + (GO H) 00013890 + G (SETQ Y (CONS CRCHAR* Y)) 00013900 + (SETQ X CRCHAR*) 00013910 + (COND 00013920 + ((OR (DIGIT (READCH*)) 00013930 + (EQ CRCHAR* **DOT) 00013940 + (EQ CRCHAR* (QUOTE E)) 00013950 + (EQ X (QUOTE E))) 00013960 + (GO G))) 00013970 + H (SETQ CURSYM* (COMPRESS (REVERSE Y))) 00013980 + (GO D) 00013990 + J (SETQ SEMIC* CRCHAR*) 00014000 + (SETQ CRCHAR* **BLANK) 00014010 + (GO C) 00014020 + K (READCH*) 00014030 + (SETQ CURSYM* (CADDR X)) 00014040 + (GO D) 00014050 + B (COND ((EQ CRCHAR* **ESC) (ERROR **ESC)) 00014060 + (Y 00014070 + (CURERR (CONS CRCHAR* (QUOTE (INVALID CHARACTER))) 00014080 + NIL))) 00014090 + (SETQ CURSYM* CRCHAR*) 00014100 + (READCH*) 00014110 + (GO D) 00014120 + L (READCH*) 00014130 + (GO A) 00014140 + P (SETQ CURSYM* (LIST (QUOTE QUOTE) (READ))) 00014150 + (READCH*) 00014160 + (COND ((OR *ECHO *NAT) (MAPRIN CURSYM*))) 00014170 + (GO D1)))) 00014180 + 00014190 +)) 00014200 + 00014210 +DEFINE (( 00014220 + 00014230 +(LPRI (LAMBDA (U) 00014240 + (PROG NIL 00014250 + A (COND ((NULL U) (RETURN NIL))) 00014260 + (PRINC* (CAR U)) 00014270 + (SPACES* 1) 00014280 + (SETQ U (CDR U)) 00014290 + (GO A)))) 00014300 + 00014310 +(LPRIE (LAMBDA (U X) 00014320 + (PROG NIL (SETQ ERFG* T) (LPRIW U X (QUOTE *****))))) 00014330 + 00014340 +(REDERR (LAMBDA (U) 00014350 + (PROG2 (LPRIE U T) (ERROR*)))) 00014360 + 00014370 +(LPRIW (LAMBDA (U X Y) 00014380 + (PROG (V W) 00014390 + (COND ((AND OFL* (OR *FORT (NOT *NAT))) (GO D))) 00014392 + (TERPRI*) 00014400 + A (SETQ V U) 00014410 + (PRINC Y) 00014420 + (PRINC **BLANK) 00014430 + B (COND ((NULL V) (GO C))) 00014440 + (PRINC (CAR V)) 00014450 + (PRINC **BLANK) 00014460 + (SETQ V (CDR V)) 00014470 + (GO B) 00014480 + C (COND (X (TERPRI))) 00014490 + (COND ((NULL OFL*) (RETURN NIL)) (W (RETURN (WRS OFL*)))) 00014500 + D (WRS NIL) 00014510 + (SETQ W T) 00014520 + (GO A)))) 00014530 + 00014540 +)) 00014550 + 00014560 +DEFLIST (((*COMMA* 1)) INFIX) 00014570 + 00014580 +FLAG ((CONS EXPT QUOTIENT) BINARY) 00014590 + 00014600 +FLAG ((PLUS MINUS TIMES NOT *COMMA*) UNARY) 00014610 + 00014620 +FLAG ((*COLON* *SEMICOL*) DELIM) 00014630 + 00014640 +DEFINE (( 00014670 + 00014680 +(COMMAND (LAMBDA NIL 00014690 + (PROG2 (SCAN) (COMMAND1 (QUOTE TOP))))) 00014700 + 00014710 +(COMMAND1 (LAMBDA (U) 00014720 + (PROG (V X Y) 00014730 + A0 (COND ((NOT (ATOM U)) (SETQ V (CAR U))) 00014740 + ((AND (EQ CURSYM* (QUOTE *SEMICOL*)) 00014750 + (LIST (SCAN))) (GO A0)) 00014760 + ((NOT (SETQ Y (GET* (SETQ V CURSYM*) (QUOTE STAT)))) 00014770 + (SETQ V (MREAD 00014780 + (AND (NOT (EQ U (QUOTE TOP))) 00014790 + (OR (EQ U (QUOTE IF)) 00014800 + (EQ *MODE (QUOTE SYMBOLIC)))))))) 00014810 + (SETQ U 00014820 + (AND (NOT (EQ *MODE (QUOTE SYMBOLIC))) 00014830 + (OR PRI* (EQ U (QUOTE TOP))))) 00014840 + (COND (Y (GO B)) 00014850 + ((EQ CURSYM* (QUOTE *COLON*)) (RETURN V)) 00014860 + ((EQCAR V (QUOTE SETQ)) (GO C)) 00014870 + ((OR (EQUAL *MODE (QUOTE SYMBOLIC)) 00014880 + (EQCAR V (QUOTE QUOTE)) 00014890 + (AND (NUMBERP V) (FIXP V))) 00014900 + (SETQ Y V)) 00014910 + ((EQCAR V (QUOTE EQUAL)) (GO C)) 00014920 + (T (SETQ Y (LIST (QUOTE AEVAL) (MKARG V))))) 00014930 + A (COND ((AND U (EQ SEMIC* **SEMICOL)) 00014940 + (SETQ Y (LIST (QUOTE VARPRI) X Y PRI*))) 00014950 + ((AND PRI* (EQ *MODE (QUOTE SYMBOLIC))) 00014960 + (SETQ Y (LIST (QUOTE PRINC) Y)))) 00014970 + (RETURN Y) 00014980 + B (SETQ Y (*APPLY Y NIL)) 00014990 + (SETQ U (AND U (MEMBER V (QUOTE (BEGIN FOR IF))))) 00015000 + (GO A) 00015010 + C (SETQ V (CDR V)) 00015020 + (COND ((NULL (CDDR V)) (GO D))) 00015030 + (SETQ X PRI*) 00015040 + (SETQ PRI* NIL) 00015050 + (SETQ Y (COMMAND1 (LIST (CONS (QUOTE SETQ) (CDR V))))) 00015060 + (SETQ PRI* X) 00015070 + (SETQ X NIL) 00015080 + D (COND ((EQ *MODE (QUOTE SYMBOLIC)) (GO E)) 00015090 + (U 00015100 + (SETQ X 00015110 + (CONS (QUOTE LIST) 00015120 + (MAPCAR 00015130 + (REVERSE (CDR (REVERSE V))) 00015140 + (FUNCTION MKARG*)))))) 00015150 + (COND ((NULL (CDDR V)) 00015160 + (SETQ Y (LIST (QUOTE AEVAL) (MKARG (CADR V)))))) 00015170 + (SETQ Y 00015180 + (COND 00015190 + ((AND (ATOM (CAR V)) (PROGVR (CAR V))) 00015200 + (LIST (QUOTE SETQ) (CAR V) Y)) 00015210 + (T (LIST (QUOTE SETK) (MKARG (CAR V)) Y)))) 00015220 + (GO A) 00015230 + E (COND ((NULL (CDDR V)) (SETQ Y (CADR V)))) 00015240 + (SETQ Y 00015250 + (COND 00015260 + ((ATOM (CAR V)) (LIST (QUOTE SETQ) (CAR V) Y)) 00015270 + ((GET* (CAAR V) (QUOTE **ARRAY)) 00015280 + (LIST (QUOTE SETEL) (CAR V) Y)) 00015282 + (T (PROCDEF1 (CAR V) Y)))) 00015284 + (GO A)))) 00015286 + 00015290 +(MKARG (LAMBDA (U) 00015300 + (COND ((NULL U) NIL) 00015310 + ((ATOM U) (COND ((PROGVR U) U) (T (LIST (QUOTE QUOTE) U)))) 00015320 + ((MEMBER (CAR U) (QUOTE (COND PROG QUOTE))) U) 00015330 + (T (CONS (QUOTE LIST) (MAPCAR U (FUNCTION MKARG))))))) 00015340 + 00015350 +(MKARG* (LAMBDA (U) 00015360 + (COND ((NULL U) NIL) 00015370 + ((ATOM U) (LIST (QUOTE QUOTE) U)) 00015420 + (T (CONS (QUOTE LIST) (MAPCAR U (FUNCTION MKARG))))))) 00015430 + 00015440 +(MKPROG (LAMBDA (U V) 00015480 + (CONS (QUOTE PROG) (CONS U V)))) 00015490 + 00015510 +(PROGVR (LAMBDA (VAR) 00015520 + (COND ((NOT (ATOM VAR)) NIL) 00015530 + ((NUMBERP VAR) T) 00015540 + (T 00015550 + ((LAMBDA (X) (COND (X (CAR X)) (T NIL))) 00015560 + (GET VAR (QUOTE DATATYPE))))))) 00015570 + 00015580 +)) 00015590 + 00015600 +DEFINE (( 00015610 + 00015620 +(LPRIM* (LAMBDA (U) 00015630 + (PROG (X Y) 00015640 + (COND ((AND OFL* (OR *FORT (NOT *NAT))) (GO C))) 00015650 + A (SETQ X *NAT) 00015660 + (SETQ *NAT NIL) 00015670 + (LPRI (CONS (QUOTE ***) U)) 00015680 + (TERPRI) 00015690 + (SETQ *NAT X) 00015700 + (COND ((NULL Y) (GO B))) 00015701 + (WRS Y) 00015702 + (RETURN NIL) 00015703 + B (COND ((NULL OFL*) (RETURN NIL))) 00015704 + C (SETQ Y OFL*) 00015705 + (WRS NIL) 00015706 + (GO A)))) 00015707 + 00015710 +(SYMPRI (LAMBDA (U) 00015720 + (PROG (X) 00015730 + (COND 00015740 + ((EQ U (QUOTE *SEMICOL*)) (PRINC* SEMIC*)) 00015750 + ((SETQ X (GET* U (QUOTE PRTCH))) (PRINC* (CAR X))) 00015760 + (T (GO B))) 00015770 + (RETURN (SETQ SYMFG* NIL)) 00015780 + B (COND (SYMFG* (SPACES* 1))) 00015790 + (PRINC* U) 00015800 + (SETQ SYMFG* T)))) 00015810 + 00015820 +(CURERR (LAMBDA (U V) 00015830 + (PROG (X) 00015840 + (SETQ ECHO* T) 00015850 + (TERPRI) 00015860 + (SETQ X CURSYM*) 00015870 + (COND ((NULL PLINE*) (GO B)) 00015880 + ((EQUAL V 1) 00015890 + (SETQ PLINE* 00015900 + (CONS (CAR PLINE*) 00015910 + (CONS 00015920 + (CONS (CONS (CAAADR PLINE*) -1) **EMARK) 00015930 + (CDR PLINE*))))) 00015940 + (T 00015950 + (SETQ PLINE* 00015960 + (CONS (CONS (CONS (CAAAR PLINE*) -1) **EMARK) 00015970 + PLINE*)))) 00015980 + (SETQ YMIN* -1) 00015990 + B (COMM1*) 00016000 + (COND ((NUMBERP V) (SETQ V NIL))) 00016010 + (COND ((AND (NULL U) (NULL V)) (GO A)) 00016020 + ((NULL V) (LPRIE U T)) 00016030 + (T (LPRIE 00016040 + (CONS X 00016050 + (CONS (QUOTE INVALID) 00016060 + (COND 00016070 + (U 00016080 + (LIST (QUOTE IN) 00016090 + U 00016100 + (QUOTE STATEMENT))) 00016110 + (T NIL)))) 00016120 + T))) 00016130 + A (ERROR*)))) 00016140 + 00016150 +(ERROR* (LAMBDA NIL 00016160 + (PROG2 (TERPRI*) (ERROR NIL)))) 00016170 + 00016180 +)) 00016190 + 00016200 +DEFINE (( 00016210 + 00016220 +(GREATEQ (LAMBDA (U V) 00016230 + (OR (EQUAL U V) (GREATERP U V)))) 00016240 + 00016250 +(LESSEQ (LAMBDA (U V) 00016260 + (OR (EQUAL U V) (LESSP U V)))) 00016270 + 00016280 +(UNEQ (LAMBDA (U V) 00016290 + (NOT (EQUAL U V)))) 00016300 + 00016310 +(REDMSG (LAMBDA (U V W) 00016320 + (COND ((NULL *MSG) T) 00016330 + ((AND *INT W) (REDMSG1 U V)) 00016340 + (T (NULL (LPRIM* (LIST U (QUOTE DECLARED) V))))))) 00016350 + 00016360 +(DELETE (LAMBDA (U V) 00016370 + (COND ((NULL V) NIL) 00016380 + ((EQUAL U (CAR V)) (CDR V)) 00016390 + (T (CONS (CAR V) (DELETE U (CDR V))))))) 00016400 + 00016410 +(SETDIFF (LAMBDA (U V) 00016420 + (COND ((NULL V) U) (T (SETDIFF (DELETE (CAR V) U) (CDR V)))))) 00016430 + 00016440 +(XN (LAMBDA (U V) 00016450 + (COND ((NULL U) NIL) 00016460 + ((MEMBER (CAR U) V) 00016470 + (CONS (CAR U) (XN (CDR U) (DELETE (CAR U) V)))) 00016480 + (T (XN (CDR U) V))))) 00016490 + 00016500 +)) 00016510 + 00016520 +DEFINE (( 00016530 + 00016540 +(PROCDEF (LAMBDA NIL 00016550 + (PROG (X Y) 00016560 + (COND ((ATOM (SETQ X (MREAD* NIL))) (SETQ X (LIST X)))) 00016570 + (SCAN) 00016580 + (SETQ Y (FLAGTYPE (CDR X) (QUOTE SCALAR))) 00016581 + (SETQ X (PROCDEF1 X (COMMAND1 NIL))) 00016582 + (REMTYPE Y) 00016583 + (RETURN X)))) 00016584 + 00016600 +(PROCDEF1 (LAMBDA (U BODY) 00016602 + (PROG (NAME VARLIS) 00016604 + (SETQ NAME (CAR U)) 00016610 + (COND 00016620 + ((OR (NULL NAME) (NOT (ATOM NAME)) (NUMBERP NAME)) 00016630 + (CURERR NAME NIL)) 00016640 + ((NOT (GETD NAME)) (FLAG (LIST NAME) (QUOTE FNC)))) 00016650 + (COND ((EQCAR BODY (QUOTE PROG)) (SETQ VARLIS (CADR BODY)))) 00016660 + (COND (VARLIS (RPLACA (CDR BODY) (SETDIFF VARLIS (CDR U))))) 00016680 + (SETQ VARLIS (CDR U)) 00016690 + (AND (NOT (FLAGP NAME (QUOTE FNC))) 00016710 + (LPRIM* (LIST NAME (QUOTE REDEFINED)))) 00016720 + (DEF* NAME VARLIS BODY DEFN*) 00016730 + (REMPROP NAME (QUOTE FNC)) 00016740 + (RETURN (LIST (QUOTE QUOTE) NAME))))) 00016760 + 00016780 +(FLAGTYPE (LAMBDA (U V) 00016790 + (PROG (X Y Z) 00016800 + A (COND ((NULL U) (RETURN (REVERSE Z)))) 00016810 + (SETQ X (CAR U)) 00016820 + (COND ((GET X (QUOTE SIMPFN)) 00016830 + (REDERR (APPEND (QUOTE (TYPE CONFLICT FOR)) (LIST X))))) 00016830 + (SETQ Y (GET X (QUOTE DATATYPE))) 00016840 + (PUT X (QUOTE DATATYPE) (CONS V Y)) 00016910 + (SETQ Z (CONS X Z)) 00016920 + C (SETQ U (CDR U)) 00016930 + (GO A)))) 00016940 + 00016970 +(REMTYPE (LAMBDA (VARLIS) 00016980 + (PROG (X Y) 00016990 + A (COND ((NULL VARLIS) (RETURN NIL))) 00017000 + (SETQ X (CAR VARLIS)) 00017010 + (SETQ Y (CDR (GET X (QUOTE DATATYPE)))) 00017020 + (COND (Y (PUT X (QUOTE DATATYPE) Y)) 00017060 + (T (REMPROP X (QUOTE DATATYPE)))) 00017070 + (SETQ VARLIS (CDR VARLIS)) 00017080 + (GO A)))) 00017090 + 00017100 +(NEWVAR (LAMBDA (U) 00017110 + (COMPRESS (CONS **FMARK (EXPLODE U))))) 00017120 + 00017130 +(DEF* (LAMBDA (NAME VARLIS BODY FN) 00017140 + (*APPLY FN 00017150 + (LIST 00017160 + (LIST (LIST NAME (LIST (QUOTE LAMBDA) VARLIS BODY))))))) 00017170 + 00017180 +)) 00017190 + 00017200 +DEFINE (( 00017210 + 00017220 +(PROCBLOCK (LAMBDA NIL 00017230 + (PROG (X HOLD VARLIS) 00017240 + (SCAN) 00017250 + (COND ((MEMBER CURSYM* (QUOTE (NIL *RPAR*))) (ERROR **ESC))) 00017260 + (SETQ VARLIS (DECL T)) 00017270 + A (COND ((EQ CURSYM* (QUOTE END)) (GO B))) 00017280 + (SETQ X (COMMAND1 NIL)) 00017290 + (COND ((EQCAR X (QUOTE END)) (GO C))) 00017300 + (AND (NOT (EQ CURSYM* (QUOTE END))) (SCAN)) 00017310 + (COND (X (SETQ HOLD (ACONC HOLD X)))) 00017320 + (GO A) 00017330 + B (COMM1 (QUOTE END)) 00017340 + C (REMTYPE VARLIS) 00017350 + (COND ((NOT (EQ *MODE (QUOTE SYMBOLIC))) 00017351 + (SETQ HOLD (ACONC HOLD (QUOTE (RETURN 0)))))) 00017352 + (RETURN (MKPROG VARLIS HOLD))))) 00017360 + 00017380 +(DECL* (LAMBDA NIL 00017390 + (MAP (DECL NIL) (FUNCTION (LAMBDA (J) 00017400 + (PUT (CAR J) (QUOTE SPECIAL) (LIST NIL))))))) 00017400 + 00017410 +(DECL (LAMBDA (U) 00017420 + (PROG (V W VARLIS) 00017430 + A (COND 00017440 + ((NOT (MEMBER CURSYM* (QUOTE (REAL INTEGER SCALAR)))) 00017450 + (RETURN VARLIS))) 00017460 + (SETQ W CURSYM*) 00017470 + (COND ((EQ (SCAN) (QUOTE PROCEDURE)) (RETURN (ALGFN)))) 00017480 + (SETQ V (FLAGTYPE (REMCOMMA (MREAD NIL)) W)) 00017490 + (SETQ VARLIS (APPEND V VARLIS)) 00017500 + (AND (NOT (EQ CURSYM* (QUOTE *SEMICOL*))) (CURERR NIL T)) 00017510 + (AND U (SCAN)) 00017520 + (GO A)))) 00017530 + 00017540 +(GOFN (LAMBDA NIL 00017550 + (PROG (VAR) 00017560 + (SETQ VAR 00017570 + (COND ((EQ (SCAN) (QUOTE TO)) (SCAN)) (T CURSYM*))) 00017580 + (SCAN) 00017590 + (RETURN (LIST (QUOTE GO) VAR))))) 00017600 + 00017610 +(RETFN (LAMBDA NIL 00017620 + (LIST (QUOTE RETURN) 00017630 + (COND ((FLAGP** (SCAN) (QUOTE DELIM)) NIL) 00017635 + (T (COMMAND1 NIL)))))) 00017640 + 00017650 +(ENDFN (LAMBDA NIL 00017660 + (PROG2 (COMM1 (QUOTE END)) (QUOTE (END))))) 00017670 + 00017680 +)) 00017690 + 00017700 +DEFINE (( 00017710 + 00017720 +(FORSTAT (LAMBDA NIL 00017730 + (COND ((EQ (SCAN) (QUOTE ALL)) (FORALLFN*)) (T (FORLOOP))))) 00017740 + 00017750 +(FORLOOP (LAMBDA NIL 00017760 + (PROG (CURS EXP INCR INDX CONDLIST BODY FLG FNC LAB1 LAB2) 00017770 + (SETQ FNC (GENSYM)) 00017780 + (SETQ EXP (MREAD T)) 00017790 + (COND 00017800 + ((AND (EQ (CAR EXP) (QUOTE *COMMA*)) 00017810 + (EQCAR (CADR EXP) (QUOTE SETQ))) 00017820 + (SETQ EXP 00017830 + (LIST NIL 00017840 + (CADADR EXP) 00017850 + (CONS (QUOTE *COMMA*) 00017860 + (NCONC (CDDADR EXP) (CDDR EXP)))))) 00017870 + ((NOT (MEMBER (CAR EXP) (QUOTE (SETQ EQUAL)))) (GO ERR))) 00017880 + (SETQ EXP (CDR EXP)) 00017890 + (COND 00017900 + ((OR (NOT (ATOM (SETQ INDX (CAR EXP)))) (NUMBERP INDX)) 00017910 + (GO ERR))) 00017920 + (SETQ INDX (CAR (FLAGTYPE (LIST INDX) (QUOTE INTEGER)))) 00017920 + A (SETQ EXP (REMCOMMA (CADR EXP))) 00017930 + A1 (COND ((NULL EXP) (GO B2)) 00017940 + ((CDR EXP) (SETQ FLG T)) 00017950 + ((EQ CURSYM* (QUOTE STEP)) (GO B1)) 00017960 + ((EQ CURSYM* (QUOTE *COLON*)) (GO BB))) 00017970 + (SETQ CONDLIST 00017980 + (NCONC CONDLIST 00017990 + (LIST (LIST (QUOTE SETQ) INDX (MKEX (CAR EXP))) 00018000 + (LIST FNC)))) 00018010 + B0 (SETQ EXP (CDR EXP)) 00018020 + (GO A1) 00018030 + B1 (SETQ INCR (MKEX (MREAD* NIL))) 00018040 + (COND 00018050 + ((NOT (MEMBER (SETQ CURS CURSYM*) (QUOTE (UNTIL WHILE)))) 00018060 + (GO ERR))) 00018070 + AA (SETQ LAB1 (GENSYM)) 00018080 + (SETQ LAB2 (GENSYM)) 00018090 + (SETQ CONDLIST 00018100 + (ACONC CONDLIST(LIST (QUOTE SETQ) INDX (MKEX (CAR EXP))))) 00018110 + (SETQ EXP (REMCOMMA (MREAD* NIL))) 00018120 + (SETQ BODY (MKEX (CAR EXP))) 00018130 + (SETQ CONDLIST 00018140 + (NCONC CONDLIST 00018150 + (LIST LAB1 00018160 + (LIST (QUOTE COND) 00018170 + (LIST 00018180 + (COND 00018190 + ((EQ CURS (QUOTE UNTIL)) 00018200 + (COND 00018210 + ((NUMBERP INCR) 00018220 + (LIST 00018230 + (COND 00018240 + ((MINUSP INCR) 00018250 + (QUOTE LESSP)) 00018260 + (T (QUOTE GREATERP))) 00018270 + INDX 00018280 + BODY)) 00018290 + (T 00018300 + (LIST 00018310 + (QUOTE MINUSP) 00018320 + (LIST 00018330 + (QUOTE TIMES) 00018340 + (LIST 00018350 + (QUOTE DIFFERENCE) 00018360 + BODY 00018370 + INDX) 00018380 + INCR))))) 00018390 + (T (LIST (QUOTE NOT) BODY))) 00018400 + (LIST (QUOTE GO) LAB2))) 00018410 + (LIST FNC) 00018420 + (LIST (QUOTE SETQ) 00018430 + INDX 00018440 + (LIST (QUOTE PLUS) INDX INCR)) 00018450 + (LIST (QUOTE GO) LAB1) 00018460 + LAB2))) 00018470 + (AND (CDR EXP) (SETQ FLG T)) 00018480 + (GO B0) 00018490 + BB (SETQ INCR 1) 00018500 + (SETQ CURS (QUOTE UNTIL)) 00018510 + (GO AA) 00018520 + B2 (COND ((NULL CONDLIST) (GO ERR)) 00018530 + ((MEMBER CURSYM* (QUOTE (SUM PRODUCT))) (GO C)) 00018540 + ((NOT (EQ CURSYM* (QUOTE DO))) (GO ERR))) 00018550 + (SCAN) 00018560 + (SETQ BODY (COMMAND1 NIL)) 00018570 + B (COND (FLG (DEF* FNC NIL BODY (QUOTE DEFINE))) 00018590 + (T (SETQ CONDLIST (ADFORM BODY (LIST FNC) CONDLIST)))) 00018600 + (REMTYPE (LIST INDX)) 00018602 + (RETURN (MKPROG (CONS INDX EXP) (ACONC CONDLIST 00018610 + (QUOTE (RETURN NIL))))) 00018612 + C (SETQ CURS CURSYM*) 00018620 + (SETQ EXP (GENSYM)) 00018630 + (SETQ BODY 00018640 + (LIST (QUOTE SETQ) 00018650 + EXP 00018660 + (LIST 00018670 + (COND 00018680 + ((EQ CURS (QUOTE SUM)) (QUOTE ADDSQ)) 00018690 + (T (QUOTE MULTSQ))) 00018700 + (LIST (QUOTE AEVAL1) (MKARG (MREAD* T))) 00018710 + EXP))) 00018720 + (SETQ CONDLIST 00018730 + (CONS (LIST (QUOTE SETQ) 00018740 + EXP 00018750 + (LIST (QUOTE CONS) 00018760 + (COND 00018770 + ((EQ CURS (QUOTE SUM)) NIL) 00018780 + (T 1)) 00018790 + 1)) 00018800 + (ACONC CONDLIST 00018810 + (LIST (QUOTE RETURN) 00018820 + (LIST (QUOTE MK*SQ) 00018830 + (LIST (QUOTE SUBS2) EXP)))))) 00018840 + (SETQ EXP (LIST EXP)) 00018840 + (GO B) 00018850 + ERR (CURERR (QUOTE FOR) T)))) 00018900 + 00018910 +(ADFORM (LAMBDA (U V W) 00018920 + (COND ((NULL W) NIL) 00018930 + ((EQUAL V (CAR W)) 00018940 + ((LAMBDA(X) 00018950 + (COND (X (APPEND X (CDR W))) (T (CONS U (CDR W))))) 00018960 + (PROGCHK U))) 00018970 + (T (CONS (CAR W) (ADFORM U V (CDR W))))))) 00018980 + 00018990 +(PROGCHK (LAMBDA (U) 00019000 + (PROG (X) 00019010 + (COND 00019020 + ((OR (NOT (EQCAR U (QUOTE PROG))) (CADR U)) (RETURN NIL))) 00019030 + (SETQ U (CDR U)) 00019040 + A (SETQ U (CDR U)) 00019050 + (COND ((NULL U) (RETURN (REVERSE X))) 00019060 + ((ATOM (CAR U)) (GO B)) 00019070 + ((EQCAR (CAR U) (QUOTE RETURN)) (GO RET)) 00019080 + ((EQCAR (CAR U) (QUOTE PROG)) (GO B)) 00019090 + ((MEMBER (QUOTE RETURN) (FLATTEN (CAR U))) 00019100 + (RETURN NIL))) 00019110 + B (SETQ X (CONS (CAR U) X)) 00019120 + (GO A) 00019130 + RET (COND ((CDR U) (RETURN NIL)) 00019135 + ((NOT (ATOM (CADAR U))) (SETQ X (CONS (CADAR U) X)))) 00019140 + (GO A)))) 00019145 + 00019150 +(FLATTEN (LAMBDA (U) 00019160 + (COND ((NULL U) NIL) 00019170 + ((ATOM U) (LIST U)) 00019180 + ((ATOM (CAR U)) (CONS (CAR U) (FLATTEN (CDR U)))) 00019190 + (T (NCONC (FLATTEN (CAR U)) (FLATTEN (CDR U))))))) 00019200 + 00019210 +)) 00019220 + 00019230 +DEFINE (( 00019240 + 00019250 +(IFSTAT (LAMBDA NIL 00019260 + (PROG (CONDX CONDIT) 00019270 + (FLAG (QUOTE (CLEAR LET MATCH)) (QUOTE DELIM)) 00019280 + A (SETQ CONDX (MREAD* T)) 00019290 + (REMFLAG (QUOTE (CLEAR LET MATCH)) (QUOTE DELIM)) 00019300 + (COND ((NOT (EQ CURSYM* (QUOTE THEN))) (GO C))) 00019330 + (SCAN) 00019340 + (SETQ CONDIT(ACONC CONDIT (LIST (MKEX CONDX) (COMMAND1 NIL)))) 00019350 + (COND ((NOT (EQ CURSYM* (QUOTE ELSE))) (GO B)) 00019360 + ((EQ (SCAN) (QUOTE IF)) (GO A)) 00019370 + (T 00019380 + (SETQ CONDIT 00019390 + (ACONC CONDIT 00019400 + (LIST T (COMMAND1 (QUOTE IF))))))) 00019410 + B (RETURN (CONS (QUOTE COND) CONDIT)) 00019420 + C (COND 00019430 + ((NOT (MEMBER CURSYM* (QUOTE (CLEAR LET MATCH)))) 00019440 + (CURERR (QUOTE IF) T))) 00019450 + (SETQ MCOND* (MKEX CONDX)) 00019460 + (RETURN (FORALLFN (GVARB CONDX)))))) 00019470 + 00019480 +(MKEX (LAMBDA (U) 00019490 + (COND ((EQ *MODE (QUOTE SYMBOLIC)) U) (T (APROC U))))) 00019500 + 00019510 +(APROC (LAMBDA (U) 00019520 + (COND ((NULL U) NIL) 00019530 + ((ATOM U) 00019540 + (COND ((AND (NUMBERP U) (FIXP U)) U) 00019550 + (T (LIST (QUOTE REVAL) (MKARG U))))) 00019560 + ((MEMBER (CAR U) (QUOTE (COND PROG))) U) 00019570 + ((MEMBER (CAR U) (QUOTE (EQUAL UNEQ))) 00019580 + (LIST (CAR U) 00019590 + (LIST (QUOTE REVAL) 00019600 + (MKARG 00019610 + (LIST (QUOTE PLUS) 00019620 + (CADR U) 00019630 + (LIST (QUOTE MINUS) (CARX (CDDR U)))))) 00019640 + 0)) 00019650 + (T (CONS (CAR U) (MAPCAR (CDR U) (FUNCTION APROC))))))) 00019660 + 00019670 +(ARB (LAMBDA (U) 00019680 + T)) 00019690 + 00019700 +(GVARB (LAMBDA (U) 00019710 + (COND ((ATOM U) (COND ((NUMBERP U) NIL) (T (LIST U)))) 00019720 + ((EQ (CAR U) (QUOTE QUOTE)) NIL) 00019730 + (T 00019740 + (MAPCON (CDR U) (FUNCTION (LAMBDA (J) (GVARB (CAR J))))))))) 00019750 + 00019760 +)) 00019770 + 00019780 +FLAG ((THEN ELSE END STEP DO SUM PRODUCT UNTIL WHILE) DELIM) 00019790 + 00019800 +DEFINE (( 00019810 + 00019820 +(ALGFN (LAMBDA NIL 00019830 + (ALGFN* (QUOTE ALGEBRAIC)))) 00019840 + 00019850 +(LSPFN (LAMBDA NIL 00019860 + (ALGFN* (QUOTE SYMBOLIC)))) 00019870 + 00019880 +(ALGFN* (LAMBDA (U) 00019890 + (PROG (X) 00019900 + (COND ((EQ CURSYM* (QUOTE PROCEDURE)) (GO A)) 00019910 + ((EQ CURSYM* (QUOTE MACRO)) (SETQ DEFN* CURSYM*)) 00019920 + ((EQ CURSYM* (QUOTE FEXPR)) 00019930 + (SETQ DEFN* (QUOTE DEFEXPR)))) 00019940 + (COND 00019950 + ((FLAGP** (SCAN) (QUOTE DELIM)) (GO B))) 00019960 + A (SETQ TMODE* *MODE) 00019970 + (SETQ *MODE U) 00019980 + (COND 00019990 + ((NOT (EQ CURSYM* (QUOTE PROCEDURE))) 00020000 + (RETURN (COMMAND1 NIL)))) 00020010 + (SETQ X (PROCDEF)) 00020020 + (COND 00020030 + ((NOT (EQ U (QUOTE SYMBOLIC)))(FLAG (CDR X)(QUOTE OPFN)))) 00020035 + (RETURN (CONS (QUOTE QUOTE) (CDR X))) 00020040 + B (SETQ *MODE U)))) 00020050 + 00020060 +(RLIS (LAMBDA NIL 00020070 + (RLIS* T))) 00020080 + 00020090 +(NORLIS (LAMBDA NIL 00020100 + (RLIS* NIL))) 00020110 + 00020120 +(RLIS* (LAMBDA (U) 00020130 + (PROG (X Y) 00020140 + (SETQ X CURSYM*) 00020150 + (COND ((FLAGP** (SCAN) (QUOTE DELIM)) (GO A))) 00020160 + (SETQ Y (REMCOMMA (MREAD NIL))) 00020170 + (COND (U (SETQ Y (LIST Y)))) 00020180 + A (RETURN (CONS X (MAPCAR Y (FUNCTION MKARG))))))) 00020190 + 00020200 +)) 00020210 + 00020220 +DEFINE (( 00020230 + 00020240 +(COMM1* (LAMBDA NIL 00020250 + (COMM1 T))) 00020260 + 00020270 +(COMM1 (LAMBDA (U) 00020280 + (PROG (X Y) 00020290 + (SETQ X (AND (OR *ECHO ECHO*) *NAT)) 00020300 + (COND 00020310 + ((AND (EQ U (QUOTE END)) 00020320 + (MEMBER (SCAN) (QUOTE (ELSE END UNTIL *RPAR*)))) 00020330 + (GO RET1))) 00020340 + (COND (U (GO LOOP)) (X (PRINC* CRCHAR*))) 00020350 + (SETQ Y (LIST CRCHAR*)) 00020360 + (GO A) 00020370 + LOOP (COND ((NULL U) (GO L1)) 00020380 + ((EQ CURSYM* (QUOTE *SEMICOL*)) (GO RET1)) 00020390 + ((OR (EQ CRCHAR* **SEMICOL) 00020400 + (EQ CRCHAR* **DOLLAR) 00020410 + (EQ CRCHAR* **ESC)) 00020420 + (GO RET))) 00020430 + L1 (COND (X (PRINC* CRCHAR*))) 00020440 + (COND 00020450 + ((OR (NULL U) (EQ U (QUOTE END))) 00020460 + (SETQ Y (CONS CRCHAR* Y)))) 00020470 + (COND 00020480 + ((AND (EQ U (QUOTE END)) 00020490 + (EQ CRCHAR* (QUOTE D)) 00020500 + (EQCAR (CDR Y) (QUOTE N)) 00020510 + (EQCAR (CDDR Y) (QUOTE E)) 00020520 + (SETQ CRCHAR* **BLANK) 00020530 + (SETQ CURSYM* (QUOTE END))) 00020540 + (GO RET1)) 00020550 + ((AND (NULL U) (EQ CRCHAR* **SMARK)) (GO RETS))) 00020560 + A (SETQ CRCHAR* (READCH*)) 00020570 + (GO LOOP) 00020580 + RET (SCAN) 00020590 + RET1 (RETURN (COND (X (TERPRI*)) (T NIL))) 00020600 + RETS (SETQ CURSYM* (MKSTRING (REVERSE Y))) 00020610 + (READCH*) 00020620 + (RETURN CURSYM*)))) 00020630 + 00020640 +(QOTPRI (LAMBDA (U) 00020650 + (PROG2 (PRINC* **QMARK) (PRIN0* (CAR U))))) 00020660 + 00020670 +(PRIN0* (LAMBDA (U) 00020680 + (PROG NIL 00020690 + (COND ((ATOM U) (RETURN (PRINC* U)))) 00020700 + (PRINC* **LPAR) 00020710 + A (COND ((NULL U) (GO B)) ((ATOM U) (GO C))) 00020720 + (PRIN0* (CAR U)) 00020730 + (COND ((CDR U) (PRINC* **BLANK))) 00020740 + (SETQ U (CDR U)) 00020750 + (GO A) 00020760 + B (RETURN (PRINC* **RPAR)) 00020770 + C (PRINC* **DOT) 00020780 + (PRINC* **BLANK) 00020790 + (PRINC* U) 00020800 + (GO B)))) 00020810 + 00020820 +)) 00020830 + 00020840 +DEFLIST (((QUOTE QOTPRI)) SPECPRN) 00020850 + 00020860 +DEFINE (( 00020870 + 00020880 +(LMDEF (LAMBDA NIL 00020890 + (PROG (X) 00020900 + (COND 00020910 + ((NOT (EQ *MODE (QUOTE SYMBOLIC))) 00020920 + (CURERR (QUOTE ALGEBRAIC) T))) 00020930 + (SETQ CURSYM* (QUOTE *COMMA*)) 00020940 + (SETQ X (MREAD NIL)) 00020950 + (RETURN (LIST (QUOTE LAMBDA) (CDR X) (COMMAND1 NIL)))))) 00020960 + 00020970 +(WRITEFN (LAMBDA NIL 00020980 + (PROG (X Y Z) 00020990 + (SETQ X (MREAD* NIL)) 00021000 + (SETQ PRI* T) 00021010 + (SETQ X 00021020 + (COND 00021030 + ((EQCAR X (QUOTE *COMMA*)) (CDR X)) 00021040 + (T (LIST X)))) 00021050 + A (COND ((NULL X) (GO B))) 00021060 + (SETQ Z (COMMAND1 (LIST (CAR X)))) 00021065 + (COND ((NULL (CDR X)) (SETQ Z (LIST (QUOTE RETURN) Z)))) 00021070 + (SETQ Y (ACONC Y Z)) 00021075 + (SETQ X (CDR X)) 00021080 + (GO A) 00021090 + B (SETQ PRI* NIL) 00021100 + (RETURN (MKPROG NIL (CONS (QUOTE (TERPRI*)) Y)))))) 00021110 + 00021120 +)) 00021130 + 00021140 +DEFINE (( 00021150 + 00021160 +(ON1 (LAMBDA (U V) 00021170 + (PROG (X) 00021180 + A (COND ((NULL U) (RETURN NIL))) 00021190 + (PTS (COMPRESS (APPEND (EXPLODE **STAR) (EXPLODE (CAR U)))) 00021200 + V) 00021210 + (COND 00021220 + ((SETQ X (ASSOC V (GET* (CAR U) (QUOTE SIMPFG)))) 00021230 + (*APPLY (CONVRT (CDR X) NIL) NIL))) 00021240 + (SETQ U (CDR U)) 00021250 + (GO A)))) 00021260 + 00021270 +(ON (LAMBDA (U) 00021280 + (ON1 U T))) 00021290 + 00021300 +(OFF (LAMBDA (U) 00021310 + (ON1 U NIL))) 00021320 + 00021330 +)) 00021340 + 00021350 +DEFINE (( 00021360 + 00021370 +(AARRAY (LAMBDA (U) 00021380 + (PROG (X Y) 00021390 + A (COND ((NULL U) (RETURN NIL))) 00021400 + (SETQ X (CAR U)) 00021410 + (COND 00021420 + ((OR (NUMBERP (CAR X)) 00021430 + (NOT (ATOM (CAR X))) 00021440 + (GET (CAR X) (QUOTE SIMPFN)) 00021460 + (GET (CAR X) (QUOTE APROP))) 00021465 + (REDERR (APPEND (QUOTE (TYPE CONFLICT FOR)) 00021470 + (LIST (CAR X))))) 00021475 + ((NOT (NUMLIS (SETQ Y (MAPCAR (CDR X) 00021480 + (FUNCTION REVAL))))) (ERRPRI2 X))) 00021485 + (PUT (CAR X) (QUOTE **ARRAY) Y) 00021490 + (*ARRAY 00021495 + (LIST (CONS (CAR X) (MAPCAR Y (FUNCTION ADD1))))) 00021500 + B (SETQ U (CDR U)) 00021520 + (GO A)))) 00021530 + 00021560 +(NUMLIS (LAMBDA (U) 00021570 + (OR (NULL U) (AND (NUMBERP (CAR U)) (NUMLIS (CDR U)))))) 00021580 + 00021590 +)) 00021600 + 00021610 +DEFLIST (((AARRAY RLIS)) STAT) 00021620 + 00021630 +(LAMBDA NIL (PUT (QUOTE ARRAY) (QUOTE NEWNAME) (QUOTE AARRAY))) NIL 00021640 + 00021650 +DEFINE (( 00021660 + 00021670 +(BEGIN1 (LAMBDA NIL 00021680 + (PROG (RESULT) 00021690 + (SETQ CURSYM* NIL) 00021700 + A (TERPRI) 00021710 + (COND ((AND TMODE* (SETQ *MODE TMODE*)) (SETQ TMODE* NIL))) 00021720 + (SETQ ECHO* *ECHO) 00021730 + (SETQ ERFG* NIL) 00021740 + (COND ((EQ CURSYM* (QUOTE END)) (GO ND0))) 00021750 + (SETQ CRCHAR* **BLANK) 00021760 + (SETQ DEFN* (QUOTE DEFINE)) 00021770 + (OVOFF) 00021771 + (SETQ PROGRAM* (ERRORSET (QUOTE (COMMAND)) T)) 00021780 + (COND ((OR (ATOM PROGRAM*) (CDR PROGRAM*)) (GO ERR1))) 00021790 + (SETQ PROGRAM* (CAR PROGRAM*)) 00021800 + (COND 00021810 + ((EQ (CAR PROGRAM*) (QUOTE RETRY)) 00021820 + (SETQ PROGRAM* PROGRAML*)) 00021830 + ((EQCAR PROGRAM* (QUOTE *COMMA*)) (GO ER)) 00021835 + ((EQ (CAR PROGRAM*) (QUOTE END)) (GO ND1)) 00021840 + (DIAG* (GO D))) 00021850 + B (COND (PLINE* (TERPRI*))) 00021852 + (SETQ ECHO* (QUOTE RESULT)) 00021860 + (SETP) 00021870 + (OVON) 00021871 + (SETQ RESULT 00021880 + (ERRORSET (CONVRT (GTS (QUOTE PROGRAM*)) NOCMP*) T)) 00021890 + (COND ((OR (ATOM RESULT) (CDR RESULT)) (GO ERR2)) 00021900 + ((EQ *MODE (QUOTE SYMBOLIC)) (AND (EQ SEMIC* **SEMICOL) 00021910 + (PROG2 (PRINT (CAR RESULT)) (TERPRI)))) 00021920 + ((CAR RESULT) (SETQ *ANS (CAR RESULT)))) 00021930 + (SETQ ORIG* 0) 00021940 + (CLOSELINE) 00021950 + (COND ((NULL *INT) (PRINTTY **STAR))) 00021960 + (GO A) 00021970 + D (COND ((OR (ATOM PROGRAM*)(EQ (CAR PROGRAM*) (QUOTE QUOTE))) 00021972 + (GO A)) 00021974 + ((FLAGP (CAR PROGRAM*) (QUOTE IGNORE)) (GO B))) 00021975 + (PRINT (CONVRT PROGRAM* NIL)) 00021978 + (GO A) 00021979 + ND0 (COMM1 (QUOTE END)) 00021980 + ND1 00022000 + (RETURN (FINF)) 00022010 + ERR1 (COND ((OR (EQ PROGRAM* **ESC) (EQ PROGRAM* **EOF)) (GO A))) 00022020 + (GO ERR3) 00022030 + ER (LPRIE (COND ((NOT (ATOM (CADR PROGRAM*))) 00022032 + (LIST (CAADR PROGRAM*) (QUOTE UNDEFINED))) 00022034 + (T (QUOTE (SYNTAX ERROR)))) T) 00022036 + (GO ERR3) 00022038 + ERR2 (SETQ PROGRAML* PROGRAM*) 00022040 + ERR3 (COND 00022050 + ((NULL ERFG*) 00022060 + (LPRIE (QUOTE (ERROR TERMINATION *****)) NIL))) 00022070 + (SETQ ORIG* 0) 00022080 + (TERPRI*) 00022090 + (COND (IFL* (PAUSE)) (OFL* (PRINTTY **STAR))) 00022100 + (GO A)))) 00022110 + 00022120 +(FINF (LAMBDA NIL 00022130 + (PROG NIL 00022140 + (COND (IFL* (GO A))) 00022150 + (MAPCAR (APPEND IPL* OPL*) (FUNCTION CLOSE)) 00022160 + (SETQ IPL* NIL) 00022170 + (SETQ OPL* NIL) 00022180 + (SETQ OFL* NIL) 00022190 + (LPRIW NIL T **ENDMSG) 00022200 + (RETURN (QUOTE ***)) 00022210 + A (CLOSE IFL*) 00022220 + (SETQ IPL* (DELETE IFL* IPL*)) 00022221 + (RDS (SETQ IFL* (COND (IPL* (CAR IPL*)) (T NIL)))) 00022222 + (LPRIM* NIL)))) 00022260 + 00022270 +)) 00022280 + 00022290 +DEFLIST (((FOR FORSTAT) (FORALL FORALLFN*) (IF IFSTAT) (BEGIN PROCBLOCK 00022300 +) (IN RLIS) (OUT RLIS) (SHUT RLIS) (GO GOFN) (GOTO GOFN) (RETURN RETFN 00022310 + ) (INTEGER DECL*) (SCALAR DECL*) (WRITE WRITEFN) ( 00022320 +REAL DECL*) (LISP LSPFN) (ALGEBRAIC ALGFN) (RETRY NORLIS) (PROCEDURE 00022330 + ALGFN)(MACRO LSPFN)(FEXPR LSPFN) (SYMBOLIC LSPFN) (ON RLIS) (OFF RLIS 00022340 +) (END ENDFN) (COMMENT COMM1*) (INFIX INFIXFN) (PRECEDENCE PRECEDFN)) 00022350 +STAT) 00022360 + 00022370 +DEFLIST (((BEGIN PROCBLOCK) (FOR FORSTAT) (IF IFSTAT) (LAMBDA LMDEF)) 00022380 +ISTAT) 00022390 + 00022400 +(LAMBDA (U) (MAP U (FUNCTION (LAMBDA (J) (PTS (CAR J) NIL))))) ((*GCD 00022410 +*EXP *MCD *FLOAT MATCH* *DIV *RAT *SUPER MCOND* *ALLFAC *NCMP SUBFG* 00022420 +FRLIS1* FRLIS* GAMIDEN* SUB2* RPLIS* SUBL* DSUBL* FACTORS* FRASC* VREP* 00022430 + INDICES* WTP* SNO* PNO* *RAT *OUTP MCHFG* *ANS *RESUBS *NERO EXLIST* 00022440 +ORDN* *XDN SV* DNL* UPL* EXPTL*)) 00022450 + 00022460 +(LAMBDA (U) (MAP U (FUNCTION (LAMBDA (J) (PTS (CAAR J) (CADAR J)))))) 00022470 +(((*EXP T) (*MSG T) (*ALLFAC T) (*MCD T) (SUBFG* T) (EXLIST* ((*))) 00022480 + (*RESUBS T) (ORDN* 0) (*ANS 0) (SNO* 500) (*XDN T))) 00022490 + 00022500 +DEFLIST (((EXP ((NIL . RMSUBS1) (T . RMSUBS))) (MCD ((NIL . RMSUBS1) ( 00022510 +T . RMSUBS))) (FORT ((NIL LAMBDA NIL (SETQ *NAT NAT**)) (T LAMBDA NIL 00022520 +(PROG2 (SETQ NAT** *NAT) (SETQ *NAT NIL))))) (GCD ((T . RMSUBS))) 00022530 + (FLOAT ((T . RMSUBS)))) SIMPFG) 00022540 + 00022550 +DEFLIST (((ANTISYMMETRIC RLIS)(CLEAR RLIS)(DENOM NORLIS) (FACTOR RLIS) 00022560 + (LET RLIS) (MATCH RLIS) (MKCOEFF NORLIS) (ND NORLIS) (NUMER NORLIS) 00022570 + (OPERATOR RLIS) (ORDER RLIS) (REMFAC RLIS) (SAVEAS NORLIS) (SYMMETRIC 00022580 + RLIS) (TERMS NORLIS) (WEIGHT RLIS)) STAT) 00022590 + 00022600 +DEFLIST (((PLUS SIMPPLUS) (MINUS SIMPMINUS) (EXPT SIMPEXPT) (SUB 00022610 +SIMPSUBS)(DF SIMPDF)(RECIP SIMPRECIP)(QUOTIENT SIMPQUOT) (*SQ SIMP*SQ) 00022620 + (TIMES SIMPTIMES)) SIMPFN) 00022630 + 00022640 +DEFLIST (((*ANS (SCALAR)) (*MODE (SCALAR))) DATATYPE) 00022650 + 00022660 +DEFLIST (((I (I NIL (REP (MINUS 1) 2 NIL)))) APROP) 00022670 + 00022680 +DEFINE (( 00022690 + 00022700 +(ABS (LAMBDA (N) 00022710 + (COND ((MINUSP N) (MINUS N)) (T N)))) 00022720 + 00022730 +(ASSOC (LAMBDA (U V) 00022740 + (SASSOC U V (FUNCTION (LAMBDA NIL NIL))))) 00022750 + 00022760 +(ASSOC* (LAMBDA (U V) 00022770 + (COND ((NULL V) NIL) 00022780 + ((EQUAL U (CAAR V)) (CAR V)) 00022790 + (T (ASSOC* U (CDR V)))))) 00022800 + 00022810 +(ATOMLIS (LAMBDA (U) 00022820 + (OR (NULL U) (AND (ATOM (CAR U)) (ATOMLIS (CDR U)))))) 00022830 + 00022840 +(CARX (LAMBDA (U) 00022850 + (COND ((NULL (CDR U)) (CAR U)) (T (ERRACH (LIST (QUOTE CARX) U))))) 00022860 +) 00022870 + 00022880 +(DELASC (LAMBDA (U V) 00022890 + (COND ((NULL V) NIL) 00022900 + ((OR (ATOM (CAR V)) (NOT (EQUAL U (CAAR V)))) 00022910 + (CONS (CAR V) (DELASC U (CDR V)))) 00022920 + (T (CDR V))))) 00022930 + 00022940 +(MAPCONS (LAMBDA (U *S*) 00022980 + (MAPCAR U (FUNCTION (LAMBDA (J) (CONS *S* J)))))) 00022990 + 00023000 +(MAPC2 (LAMBDA (U *PI*) 00023010 + (MAPCAR U 00023020 + (FUNCTION 00023030 + (LAMBDA(J) 00023040 + (MAPCAR J (FUNCTION (LAMBDA (K) (*PI* K))))))))) 00023050 + 00023060 +(MEXPR (LAMBDA (U V) 00023070 + (COND ((NULL V) NIL) 00023080 + ((ATOM V) (EQ U V)) 00023090 + (T (OR (MEXPR U (CAR V)) (MEXPR U (CDR V))))))) 00023100 + 00023110 +(NCONS (LAMBDA (U V) 00023120 + (COND ((NULL U) V) (T (CONS U V))))) 00023130 + 00023140 +(NLIST (LAMBDA (U N) 00023150 + (COND ((ZEROP N) NIL) (T (CONS U (NLIST U (SUB1 N))))))) 00023160 + 00023170 +(NTH (LAMBDA (U N) 00023180 + (COND ((ONEP N) (CAR U)) (T (NTH (CDR U) (SUB1 N)))))) 00023190 + 00023200 +(POSN (LAMBDA (U V) 00023210 + (COND ((EQ U (CAR V)) 1) (T (ADD1 (POSN U (CDR V))))))) 00023220 + 00023230 +(REMOVE (LAMBDA (X N) 00023240 + (COND ((MINUSP N) (ERRACH (LIST (QUOTE REMOVE) X N))) 00023250 + ((NULL X) NIL) 00023260 + ((ZEROP N) (CDR X)) 00023270 + (T (CONS (CAR X) (REMOVE (CDR X) (SUB1 N))))))) 00023280 + 00023290 +(REVPR (LAMBDA (U) 00023300 + (CONS (CDR U) (CAR U)))) 00023310 + 00023320 +(RPLACW (LAMBDA (U V) 00023330 + (COND 00023340 + ((OR (ATOM U) (ATOM V)) (ERRACH (LIST (QUOTE RPLACW) U V))) 00023350 + (T (RPLACD (RPLACA U (CAR V)) (CDR V)))))) 00023360 + 00023370 +(REPEATS (LAMBDA (X) 00023380 + (COND ((NULL X) NIL) 00023390 + ((MEMBER (CAR X) (CDR X)) (CONS (CAR X) (REPEATS (CDR X)))) 00023400 + (T (REPEATS (CDR X)))))) 00023410 + 00023420 +(UNION (LAMBDA (X Y) 00023430 + (COND ((NULL X) Y) 00023440 + (T 00023450 + (UNION (CDR X) 00023460 + (COND ((MEMBER (CAR X) Y) Y) 00023470 + (T (CONS (CAR X) Y)))))))) 00023480 + 00023490 +)) 00023500 + 00023510 +DEFINE (( 00023520 + 00023530 +(REPPRI (LAMBDA (U V) 00023540 + (MESPRI NIL U (QUOTE (REPRESENTED BY)) V NIL))) 00023550 + 00023560 +(REDEFPRI (LAMBDA (U) 00023570 + (COND ((NULL U) NIL) 00023580 + (T 00023590 + (MESPRI (QUOTE (ASSIGNMENT FOR)) 00023600 + U 00023610 + (QUOTE (REDEFINED)) 00023620 + NIL 00023630 + NIL))))) 00023640 + 00023650 +(MESPRI (LAMBDA (U V W X Y) 00023660 + (PROG (Z) 00023670 + (COND 00023680 + ((AND (NULL Y) (NULL *MSG)) (RETURN NIL)) 00023690 + ((AND OFL* (OR *FORT (NOT *NAT))) (GO B))) 00023700 + A (LPRIM U) 00023710 + (MAPRIN V) 00023720 + (PRINC* **BLANK) 00023730 + (LPRI W) 00023740 + (MATHPRINT X) 00023750 + (COND ((NULL OFL*) (RETURN NIL)) (Z (RETURN (WRS OFL*)))) 00023760 + B (WRS NIL) 00023770 + (SETQ Z T) 00023780 + (GO A)))) 00023790 + 00023800 +(LPRIM (LAMBDA (U) 00023810 + (PROG2 (TERPRI*) (LPRI (CONS (QUOTE ***) U))))) 00023820 + 00023830 +(ERRACH (LAMBDA (U) 00023840 + (PROG NIL 00023850 + (LPRIE (QUOTE (CATASTROPHIC ERROR *****)) T) 00023860 + (PRINTTY U) 00023870 + (PRINTTY **BLANK) 00023880 + (LPRIE (QUOTE 00023890 + (PLEASE SEND 00023900 + OUTPUT 00023910 + AND 00023920 + INPUT 00023930 + LISTING 00023940 + TO 00023950 + A 00023960 + C 00023970 + HEARN 00023980 + *****)) 00023990 + T) 00024000 + (ERROR*)))) 00024010 + 00024020 +(ERRPRI1 (LAMBDA (U) 00024030 + (MESPRI (QUOTE (ASSIGNMENT)) U (QUOTE (NOT ALLOWED)) NIL T))) 00024040 + 00024050 +(ERRPRI2 (LAMBDA (U) 00024060 + (MESPRI (QUOTE (FORMAT)) U (QUOTE (INCORRECT)) NIL T))) 00024070 + 00024080 +)) 00024090 + 00024100 +DEFINE (( 00024110 + 00024120 +(ORDAD (LAMBDA (A U) 00024130 + (COND ((NULL U) (LIST A)) 00024140 + ((ORDP A (CAR U)) (CONS A U)) 00024150 + (T (CONS (CAR U) (ORDAD A (CDR U))))))) 00024160 + 00024170 +(ORDN (LAMBDA (U) 00024180 + (COND ((NULL U) NIL) 00024190 + ((NULL (CDR U)) U) 00024200 + ((NULL (CDDR U)) (ORD2 (CAR U) (CADR U))) 00024210 + (T (ORDAD (CAR U) (ORDN (CDR U))))))) 00024220 + 00024230 +(ORD2 (LAMBDA (U V) 00024240 + (COND ((ORDP U V) (LIST U V)) (T (LIST V U))))) 00024250 + 00024260 +(ORDP (LAMBDA (U V) 00024270 + (COND ((NULL U) (NULL V)) 00024280 + ((NULL V) T) 00024290 + ((ATOM U) 00024300 + (COND 00024310 + ((ATOM V) 00024320 + (COND ((NUMBERP U) (AND (NUMBERP V) (NOT (LESSP U V)))) 00024330 + ((NUMBERP V) T) 00024340 + (T (ORDERP U V)))) 00024350 + (T T))) 00024360 + ((ATOM V) NIL) 00024370 + ((EQUAL (CAR U) (CAR V)) (ORDP (CDR U) (CDR V))) 00024380 + (T (ORDP (CAR U) (CAR V)))))) 00024390 + 00024400 +)) 00024410 + 00024420 +DEFINE (( 00024430 + 00024440 +(ADDSQ (LAMBDA (U V) 00024450 + (COND ((EQUAL (CDR U) (CDR V)) 00024460 + (CONS (ADDF (CAR U) (CAR V)) (CDR U))) 00024470 + ((NULL (CAR U)) V) 00024480 + ((NULL (CAR V)) U) 00024490 + ((NULL *MCD) (CONS (ADDF (MKSQP U) (MKSQP V)) 1)) 00024500 + (T 00024510 + ((LAMBDA(Z) 00024520 + ((LAMBDA(X Y) 00024530 + (COND ((OR (NULL X) (NULL Y)) (ERRACH (QUOTE ADDSQ))) (T 00024531 + (CONS (ADDF (MULTF Y (CAR U)) (MULTF X (CAR V))) 00024540 + (MULTF Y (CDR U)))) 00024550 + )) 00024551 + (QUOTF (CDR U) Z) 00024560 + (QUOTF (CDR V) Z))) 00024570 + (GCD1 (CDR U) (CDR V))))))) 00024580 + 00024590 +(ADDF (LAMBDA (U V) 00024600 + (COND ((NULL U) V) 00024610 + ((NULL V) U) 00024620 + ((ATOM U) (ADDN U V)) 00024630 + ((ATOM V) (ADDN V U)) 00024640 + ((EQUAL (CAAR U) (CAAR V)) 00024650 + ((LAMBDA(X) 00024660 + (COND ((NULL X) (ADDF (CDR U) (CDR V))) 00024670 + (T 00024680 + (CONS (CONS (CAAR U) X) (ADDF (CDR U) (CDR V)))))) 00024690 + (ADDF (CDAR U) (CDAR V)))) 00024700 + ((ORDP (CAAR U) (CAAR V)) (CONS (CAR U) (ADDF (CDR U) V))) 00024710 + (T (CONS (CAR V) (ADDF U (CDR V))))))) 00024720 + 00024730 +(ADDN (LAMBDA (N V) 00024740 + (COND ((NULL V) N) 00024750 + ((ATOM V) 00024760 + ((LAMBDA (M) (COND ((ZEROP M) NIL) (T M))) (PLUS N V))) 00024770 + (T (CONS (CAR V) (ADDN N (CDR V))))))) 00024780 + 00024790 +(MULTSQ (LAMBDA (U V) 00024800 + (COND 00024810 + ((OR (NULL (CAR U)) (NULL (CAR V))) (CONS NIL 1)) 00024820 + (T 00024830 + ((LAMBDA(X Y) 00024840 + (COND ((AND X Y) (CONS (MULTF X Y) 1)) 00024850 + (X (CONS (MULTF X (CAR V)) (CDR U))) 00024860 + (Y (CONS (MULTF (CAR U) Y) (CDR V))) 00024870 + (T 00024880 + (CONS (MULTF (CAR U) (CAR V)) 00024890 + (MULTF (CDR U) (CDR V)))))) 00024900 + (QUOTF (CAR U) (CDR V)) 00024910 + (QUOTF (CAR V) (CDR U))))))) 00024920 + 00024930 +(MULTF (LAMBDA (U V) 00024940 + (PROG (X Y Z) 00024950 + (COND ((OR (NULL U) (NULL V)) (RETURN NIL)) 00024960 + ((ATOM U) (RETURN (MULTN U V))) 00024970 + ((ATOM V) (RETURN (MULTN V U))) 00024980 + ((OR *EXP *NCMP) (GO A))) 00024990 + (SETQ U (MKSFP U 1)) 00025000 + (SETQ V (MKSFP V 1)) 00025010 + (COND ((ATOM U) (RETURN (MULTN U V))) 00025020 + ((ATOM V) (RETURN (MULTN V U)))) 00025030 + A (SETQ X (CAAAR U)) 00025040 + (SETQ Y (CAAAR V)) 00025050 + (COND 00025060 + ((OR (ATOM X) 00025070 + (ATOM Y) 00025080 + (NOT (ATOM (CAR X))) 00025090 + (NOT (ATOM (CAR Y)))) 00025100 + (GO B)) 00025110 + ((AND (EQ (CAR X) (CAR Y)) 00025120 + (SETQ Z (GET (CAR X) (QUOTE MRULE))) 00025130 + (NOT 00025140 + (EQ (SETQ Z (*APPLY Z (LIST (CAAR U) (CAAR V)))) 00025150 + (QUOTE FAILED)))) 00025160 + (RETURN 00025170 + (ADDF (MULTF Z (MULTF (CDAR U) (CDAR V))) 00025180 + (ADDF (MULTF (LIST (CAR U)) (CDR V)) 00025190 + (MULTF (CDR U) V))))) 00025200 + ((AND (FLAGP (CAR X) (QUOTE NONCOM)) 00025210 + (FLAGP (CAR Y) (QUOTE NONCOM))) 00025220 + (GO B1))) 00025230 + B (COND ((EQ X Y) (GO C)) 00025240 + ((ORDP (CAAR U) (CAAR V)) (GO B1))) 00025250 + (SETQ X (MULTF U (CDAR V))) 00025260 + (SETQ Y (MULTF U (CDR V))) 00025270 + (RETURN (COND ((NULL X) Y) (T (CONS (CONS (CAAR V) X) Y)))) 00025280 + B1 (SETQ X (MULTF (CDAR U) V)) 00025290 + (SETQ Y (MULTF (CDR U) V)) 00025300 + (RETURN (COND ((NULL X) Y) (T (CONS (CONS (CAAR U) X) Y)))) 00025310 + C (SETQ X (MKSP X (PLUS (CDAAR U) (CDAAR V)))) 00025320 + (SETQ Y 00025330 + (ADDF (MULTF (LIST (CAR U)) (CDR V)) 00025340 + (MULTF (CDR U) V))) 00025350 + (RETURN 00025360 + (COND 00025370 + ((NULL (CDR X)) 00025380 + (COND ((NULL (CAAR X)) Y) 00025390 + (T 00025400 + (ADDF (MULTF (CAAR X) 00025410 + (MULTF (CDAR U) 00025420 + (COND 00025430 + ((EQUAL (CDAR X) 1) (CDAR V)) 00025440 + (T 00025450 + (MULTF 00025460 + (MKSQP (CONS 1 (CDAR X))) 00025470 + (CDAR V)))))) 00025480 + Y)))) 00025490 + ((NULL (SETQ U (MULTF (CDAR U) (CDAR V)))) Y) 00025495 + (T (CONS (CONS X U) Y))))))) 00025500 + 00025510 +(MULTF2 (LAMBDA (U V) 00025520 + (MULTF (LIST (CONS U 1)) V))) 00025530 + 00025540 +(MULTN (LAMBDA (N V) 00025550 + (COND ((NULL V) NIL) 00025560 + ((ZEROP N) NIL) 00025570 + ((ONEP N) V) 00025580 + ((NUMBERP V) (TIMES N V)) 00025590 + ((EQ (CAR V) (QUOTE QUOTIENT)) 00025591 + (MKFR (TIMES N (CADR V)) (CADDR V))) 00025592 + (T 00025600 + (CONS (CONS (CAAR V) (MULTN N (CDAR V))) 00025610 + (MULTN N (CDR V))))))) 00025620 + 00025630 +)) 00025640 + 00025650 +DEFINE (( 00025660 + 00025670 +(REVAL (LAMBDA (U) 00025680 + (COND ((AND (NUMBERP U) (FIXP U)) U) 00025690 + ((VECTORP U) U) 00025700 + (T ((LAMBDA (X) 00025710 + (COND ((AND (EQCAR X (QUOTE MINUS)) (NUMBERP (CADR X))) 00025712 + (MINUS (CADR X))) 00025714 + (T X))) 00025716 + (PREPSQ (AEVAL1 U))))))) 00025718 + 00025720 +(AEVAL (LAMBDA (U) 00025730 + (COND 00025740 + ((EQCAR U (QUOTE *COMMA*)) (REDERR (QUOTE (SYNTAX ERROR)))) 00025750 + (T (MK*SQ (AEVAL1 U)))))) 00025760 + 00025770 +(AEVAL1 (LAMBDA (U) 00025780 + (PROG2 (RSET2) 00025790 + (COND ((MATEXPR U) (MATSM U)) (T (SUBS2 (SIMP* U))))))) 00025800 + 00025810 +(MATEXPR (LAMBDA (U) 00025820 + NIL)) 00025830 + 00025840 +(MK*SQ (LAMBDA (U) 00025880 + (COND ((NULL (CAR U)) 0) 00025890 + ((AND (ATOM (CAR U)) (EQUAL (CDR U) 1)) (CAR U)) 00025900 + ((EQCAR U (QUOTE MAT)) U) 00025910 + (T (CONS (QUOTE *SQ) (CONS U *SQVAR*)))))) 00025920 + 00025930 +(RSET2 (LAMBDA NIL 00025940 + (PROG2 (MAP RPLIS* 00025950 + (FUNCTION (LAMBDA (J) (RPLACW (CDAR J) (CAAR J))))) 00025960 + (SETQ RPLIS* NIL)))) 00025970 + 00025980 +)) 00025990 + 00026000 +DEFINE (( 00026010 + 00026020 +(MKSP (LAMBDA (U P) 00026030 + (PROG (V X Y) 00026040 + (SETQ U (FKERN U)) 00026050 + A0 (SETQ V (CDDR U)) 00026060 + A (COND ((OR (NULL V) (NULL SUBFG*)) (GO B)) 00026070 + ((SETQ X (ASSOC (QUOTE ASYMP) V)) (GO L1)) 00026080 + ((SETQ X (ASSOC (QUOTE REP) V)) (GO L2)) 00026090 + ((AND (NOT (ATOM (CAR U))) 00026110 + (ATOM (CAAR U)) 00026120 + (FLAGP (CAAR U) (QUOTE VOP)) 00026130 + (VCREP U)) 00026140 + (GO A0))) 00026150 + B (RETURN (GETPOWER U P)) 00026170 + L1 (COND 00026180 + ((NOT (LESSP P (CDR X))) (RETURN (LIST (CONS NIL 1))))) 00026190 + (SETQ V (DELASC (CAR X) V)) 00026200 + (GO A) 00026210 + L2 (SETQ V (CDDDR X)) 00026220 + (COND ((LESSP P (CADDR X)) (GO B)) 00026230 + ((AND (CAR V) 00026231 + (NOT (FLAGP** (CAR U) (QUOTE WEIGHT)))) (GO L3))) 00026232 + (SETQ SUBL* (CONS V SUBL*)) 00026240 + (SETQ Y (SIMPCAR (CDR X))) 00026250 + (COND 00026260 + ((NOT (ASSOC (QUOTE HOLD) (CDDR U))) (GO L21)) 00026270 + ((EQUAL (CDR Y) 1) (SETQ Y (CONS (MKSFP (CAR Y) 1) 1))) 00026280 + (T (SETQ Y (MKSQP Y)))) 00026290 + L21 (RPLACA V (MK*SQ Y)) 00026295 + (GO L31) 00026300 + L3 (SETQ Y (SIMPCAR V)) 00026305 + (COND((AND(EQCAR (CAR V)(QUOTE *SQ))(NULL(CADDAR V)))(GO L21)))00026310 + L31 (SETQ V Y) 00026315 + (SETQ X (CADDR X)) 00026320 + (COND ((ONEP X) (RETURN (LIST (NMULTSQ V P))))) 00026330 + (SETQ Y (DIVIDE P X)) 00026340 + C (SETQ V (NMULTSQ V (CAR Y))) 00026370 + (COND 00026380 + ((NOT (ZEROP (CDR Y))) 00026390 + (SETQ V 00026400 + (CONS (MULTF2 (GETPOWER U (CDR Y)) (CAR V)) 00026410 + (CDR V))))) 00026420 + (RETURN (LIST V))))) 00026470 + 00026500 +(FKERN (LAMBDA (U) 00026510 + (PROG (V) 00026520 + (COND ((NOT (ATOM U)) (GO A0)) 00026530 + ((SETQ V (GET U (QUOTE APROP))) (RETURN V))) 00026540 + (SETQ V (LIST U NIL)) 00026550 + (PUT U (QUOTE APROP) V) 00026560 + (RETURN V) 00026570 + A0 (COND ((NOT (ATOM (CAR U))) (SETQ V EXLIST*)) 00026580 + ((NOT (SETQ V (GET (CAR U) (QUOTE KLIST)))) (GO B))) 00026590 + A (COND ((EQUAL U (CAAR V)) (RETURN (CAR V))) 00026600 + ((ORDP U (CAAR V)) 00026610 + (RETURN 00026620 + (CAR 00026630 + (RPLACW V 00026640 + (CONS (LIST U NIL) 00026650 + (CONS (CAR V) (CDR V))))))) 00026660 + ((NULL (CDR V)) 00026670 + (RETURN (CADR (RPLACD V (LIST (LIST U NIL))))))) 00026680 + (SETQ V (CDR V)) 00026690 + (GO A) 00026700 + B (SETQ V (LIST (LIST U NIL))) 00026710 + (PUT (CAR U) (QUOTE KLIST) V) 00026720 + (GO A)))) 00026730 + 00026740 +(GETPOWER (LAMBDA (U N) 00026750 + (PROG (V) 00026760 + (COND ((AND SUBFG* (NOT (ASSOC (QUOTE USED*) (CDR U)))) 00026761 + (ACONC U (LIST (QUOTE USED*))))) 00026762 + (SETQ V (CADR U)) 00026770 + (COND 00026780 + ((NULL V) 00026790 + (RETURN (CAAR (RPLACA (CDR U) (LIST (CONS (CAR U) N))))))) 00026800 + A (COND ((EQUAL N (CDAR V)) (RETURN (CAR V))) 00026810 + ((LESSP N (CDAR V)) 00026820 + (RETURN 00026830 + (CAR 00026840 + (RPLACW V 00026850 + (CONS (CONS (CAAR V) N) 00026860 + (CONS (CAR V) (CDR V))))))) 00026870 + ((NULL (CDR V)) 00026880 + (RETURN (CADR (RPLACD V (LIST (CONS (CAAR V) N))))))) 00026890 + (SETQ V (CDR V)) 00026900 + (GO A)))) 00026910 + 00026920 +(NMULTSQ (LAMBDA (U N) 00026930 + (PROG (X) 00026940 + (COND 00026950 + ((NULL (CAR U)) (RETURN U)) 00026955 + ((NULL *EXP) 00026960 + (RETURN (CONS (MKSFP (CAR U) N) (MKSFP (CDR U) N))))) 00026970 + (SETQ X U) 00026980 + A (COND ((ONEP N) (RETURN X))) 00026990 + (SETQ X (MULTSQ U X)) 00027000 + (SETQ N (SUB1 N)) 00027010 + (GO A)))) 00027020 + 00027030 +)) 00027040 + 00027050 +DEFINE (( 00027060 + 00027070 +(MKSF (LAMBDA (U N) 00027080 + ((LAMBDA(X) 00027090 + (COND 00027100 + ((NULL (CDR X)) 00027110 + (COND ((EQUAL (CDAR X) 1) (CAAR X)) 00027120 + (T (MULTF (MKSQP (CONS 1 (CDAR X))) (CAAR X))))) 00027130 + (T (LIST (CONS X 1))))) 00027140 + (MKSP U N)))) 00027150 + 00027160 +(MKSFP (LAMBDA (U N) 00027170 + (COND ((KERNLP U) (NMULTF U N)) 00027180 + (T 00027190 + (PROG2 (SETQ SUB2* T) 00027200 + (COND ((MINUSF U) (MULTN -1 (MKSF (MULTN -1 U) N))) 00027210 + (T (MKSF U N)))))))) 00027220 + 00027230 +(MKSQP (LAMBDA (U) 00027240 + (COND ((NULL (CAR U)) NIL) 00027250 + ((OR (EQUAL (CDR U) 1) (EQUAL (CDR (SETQ U (CANCEL U))) 1)) 00027260 + (COND (*EXP (CAR U)) (T (MKSFP (CAR U) 1)))) 00027270 + (T 00027280 + (PROG NIL 00027290 + (SETQ SUB2* T) 00027300 + (RETURN 00027310 + (COND (*EXP 00027320 + (MULTF (CAR U) 00027330 + (MKSF (MK*SQ 00027340 + (CONS 1 (MKSFP (CDR U) 1))) 00027350 + 1))) 00027360 + ((MINUSF (CAR U)) 00027370 + (MULTN -1 00027380 + (MKSF 00027390 + (MK*SQ 00027400 + (CONS (MULTN -1 (CAR U)) 00027410 + (MKSFP (CDR U) 1))) 00027420 + 1))) 00027430 + (T 00027440 + (MKSF (MK*SQ 00027450 + (CONS (CAR U) (MKSFP (CDR U) 1))) 00027460 + 1))))))))) 00027470 + 00027480 +(MKSQ (LAMBDA (U N) 00027570 + ((LAMBDA(X) 00027580 + (COND ((NULL (CDR X)) (CAR X)) (T (CONS (LIST (CONS X 1)) 1)))) 00027590 + (MKSP U N)))) 00027600 + 00027610 +)) 00027620 + 00027630 +DEFINE (( 00027640 + 00027650 +(SIMP* (LAMBDA (U) 00027660 + (COND ((LESSP (SCNT U) SNO*) (ISIMPQ (SIMP U))) 00027670 + ((EQ (CAR U) (QUOTE PLUS)) (SIMPADD (CDR U))) 00027680 + ((EQ (CAR U) (QUOTE MINUS)) (NEGSQ (SIMP* (CARX (CDR U))))) 00027690 + ((EQ (CAR U) (QUOTE TIMES)) (ISIMPQ* (TSCAN (CDR U)))) 00027700 + (T (ISIMPQ (SIMP U)))))) 00027710 + 00027720 +(SIMPADD (LAMBDA (U) 00027730 + (PROG (Z) 00027740 + (SETQ Z (CONS NIL 1)) 00027750 + A (COND ((NULL U) (RETURN Z))) 00027760 + (SETQ Z (ADDSQ (SIMP* (CAR U)) Z)) 00027770 + (SETQ U (CDR U)) 00027780 + (GO A)))) 00027790 + 00027800 +(ISIMPQ* (LAMBDA (U) 00027810 + (PROG (X) 00027820 + (SETQ U (REVERSE (MAPCAR U (FUNCTION SIMP)))) 00027830 + (SETQ SV* (CONS NIL 1)) 00027840 + (ISIMPQ*1 (CDR U) (CAR U)) 00027850 + (SETQ X SV*) 00027860 + (SETQ SV* NIL) 00027870 + (RETURN X)))) 00027880 + 00027890 +(ISIMPQ*1 (LAMBDA (U V) 00027900 + (PROG (X Y) 00027910 + (COND ((NULL U) (RETURN (SETQ SV* (ADDSQ (ISIMPQ V) SV*))))) 00027920 + (SETQ X (CAAR U)) 00027930 + (SETQ Y (MULTF (CDAR U) (CDR V))) 00027940 + (SETQ V (CAR V)) 00027950 + A (COND ((NULL X) (RETURN NIL)) 00027960 + ((ATOM X) 00027970 + (RETURN (ISIMPQ*1 (CDR U) (CONS (MULTN X V) Y))))) 00027980 + (ISIMPQ*1 (CDR U) (CONS (MULTF (LIST (CAR X)) V) Y)) 00027990 + (SETQ X (CDR X)) 00028000 + (GO A)))) 00028010 + 00028020 +(ISIMPQ (LAMBDA (U) 00028020 + U)) 00028020 + 00028020 +(TSCAN (LAMBDA (U) 00028030 + (COND ((NULL U) NIL) 00028040 + ((ATOM U) (ERRACH (LIST (QUOTE TSCAN) U))) 00028050 + ((EQ (CAR U) (QUOTE TIMES)) (TSCAN (CDR U))) 00028060 + ((AND (NOT (ATOM (CAR U))) (EQ (CAAR U) (QUOTE TIMES))) 00028070 + (APPEND (TSCAN (CDAR U)) (TSCAN (CDR U)))) 00028080 + (T (CONS (CAR U) (TSCAN (CDR U))))))) 00028090 + 00028100 +(SCNT (LAMBDA (U) 00028110 + (COND ((OR (NULL U) (EQUAL U 0)) 0) 00028120 + ((ATOM U) 1) 00028130 + ((EQ (CAR U) (QUOTE PLUS)) 00028140 + (*EVAL 00028150 + (CONS (QUOTE PLUS) (MAPCAR (CDR U) (FUNCTION SCNT))))) 00028160 + ((MEMBER (CAR U) (QUOTE (TIMES G CONS EPS))) 00028170 + (*EVAL 00028180 + (CONS (QUOTE TIMES) (MAPCAR (CDR U) (FUNCTION SCNT))))) 00028190 + ((FLAGP (CAR U) (QUOTE UNIP)) (SCNT (CADR U))) 00028200 + ((EQ (CAR U) (QUOTE EXPT)) 00028210 + (COND 00028220 + ((OR (ATOM (CADR U)) (NOT (NUMBERP (CADDR U)))) 1) 00028230 + (T 00028240 + ((LAMBDA(X) 00028250 + (COND ((LESSP X 2) 1) 00028260 + (T (TIMES 2 X (ABS (*EVAL (CADDR U))))))) 00028270 + (SCNT (CADR U)))))) 00028280 + ((AND (EQ (CAR U) (QUOTE *SQ)) GAMIDEN*) (TERMS1 (CAADR U))) 00028290 + (T 1)))) 00028300 + 00028310 +)) 00028320 + 00028330 +DEFINE (( 00028340 + 00028350 +(SIMP (LAMBDA (U) 00028360 + (PROG (X) 00028370 + A (COND ((ATOM U) (RETURN (SIMPATOM U))) 00028380 + ((OR (NOT (ATOM (CAR U))) (NUMBERP (CAR U))) (GO E)) 00028390 + ((AND (SETQ X (OPMTCH U)) (SETQ U X)) (GO A)) 00028400 + ((SETQ X (GET (CAR U) (QUOTE SIMPFN))) 00028410 + (RETURN 00028420 + (COND 00028430 + ((EQ X (QUOTE IDEN)) (SIMPIDEN U)) 00028440 + (T (*APPLY X (LIST (CDR U))))))) 00028450 + ((GET (CAR U) (QUOTE **ARRAY)) (GO D)) 00028460 + ((FLAGP (CAR U) (QUOTE OPFN)) 00028470 + (SETQ U (*APPLY (CAR U) (CDR U)))) 00028480 + ((GET (CAR U) (QUOTE INFIX)) (GO E)) 00028490 + ((MEMBER (CAR U) (QUOTE (COND PROG))) 00028500 + (RETURN (SIMP (*EVAL U)))) 00028510 + ((NOT (REDMSG (CAR U) (QUOTE OPERATOR) T)) (ERROR*)) 00028520 + (T (MKOP (CAR U)))) 00028530 + (GO A) 00028540 + D (SETQ U (CONS (CAR U) (MAPCAR (CDR U) (FUNCTION REVAL)))) 00028550 + (COND 00028560 + ((NOT (NUMLIS (CDR U))) 00028570 + (REDERR 00028580 + (APPEND (QUOTE (INCORRECT ARRAY ARGUMENTS FOR)) 00028590 + (LIST (CAR U))))) 00028600 + ((AND (SETQ X (GETEL U)) (SETQ U X)) (GO A)) 00028610 + (T (RETURN (MKSQ U 1)))) 00028620 + E (CURERR (QUOTE (SYNTAX ERROR)) NIL)))) 00028630 + 00028640 +(SIMPATOM (LAMBDA (U) 00028650 + (COND((NULL U)(REDERR(QUOTE(NIL USED IN ALGEBRAIC EXPRESSION)))) 00028660 + ((NUMBERP U) 00028670 + (COND ((ZEROP U) (CONS NIL 1)) 00028680 + ((FIXP U) (CONS U 1)) 00028690 + (*FLOAT (CONS (PLUS 0.0 U) 1)) 00028700 + (T 00028710 + ((LAMBDA(Z) 00028720 + (PROG2 (REPPRI U 00028730 + (LIST 00028740 + (QUOTE QUOTIENT) 00028750 + (CAR Z) 00028760 + (CDR Z))) 00028770 + Z)) 00028780 + (MAKFRC U))))) 00028790 + ((VECTORP U) 00028800 + (REDERR 00028810 + (CONS (QUOTE VECTOR) (CONS U (QUOTE (USED AS SCALAR)))))) 00028820 + (T (MKSQ U 1))))) 00028830 + 00028840 +(MAKFRC (LAMBDA (U) 00028850 + (PROG (X Y) 00028860 + (SETQ X (FIX (TIMES **MILLION U))) 00028870 + (SETQ Y (GCDN **MILLION X)) 00028880 + (RETURN (CONS (QUOTIENT X Y) (QUOTIENT **MILLION Y)))))) 00028890 + 00028900 +(MKOP (LAMBDA (U) 00028910 + (COND ((MEMBER U FRLIS*) (REDERR (CONS (QUOTE OPERATOR) 00028920 + (CONS U (QUOTE (CANNOT BE ARBITRARY)))))) 00028922 + (T (PUT U (QUOTE SIMPFN) (QUOTE IDEN)))))) 00028924 + 00028930 +(SIMPCAR (LAMBDA (U) 00028940 + (SIMP (CAR U)))) 00028950 + 00028960 +(VECTORP (LAMBDA (U) 00028970 + NIL)) 00028980 + 00028990 +(SIMPEXPT (LAMBDA (U) 00029000 + (PROG (N X) 00029010 + (COND 00029020 + ((AND (NUMBERP (SETQ N (CARX (CDR U)))) (FIXP N)) (GO A))) 00029030 + (SETQ X *FLOAT) 00029040 + (SETQ *FLOAT NIL) 00029050 + (SETQ N (CANCEL (SIMP N))) 00029060 + (SETQ *FLOAT X) 00029070 + (COND ((AND (ATOM (CAR N)) (EQUAL (CDR N) 1)) (GO A0))) 00029080 + (SETQ X (PREPSQ (SIMPCAR U))) 00029090 + (SETQ N (PREPSQ N)) 00029100 + (COND ((EQCAR X (QUOTE TIMES)) (GO B)) 00029101 + ((AND (EQCAR X (QUOTE MINUS)) 00029102 + (NOT (NUMBERP (CADR X)))) 00029103 + (RETURN 00029104 + (MULTSQ (SIMPEXPT (LIST -1 N)) 00029105 + (SIMPEXPT (LIST (CADR X) N))))) 00029106 + ((EQCAR X (QUOTE QUOTIENT)) 00029107 + (RETURN 00029108 + (MULTSQ (SIMPEXPT (LIST (CADR X) N)) 00029109 + (SIMPEXPT 00029110 + (LIST (CADDR X) (LIST (QUOTE MINUS) N)))))) 00029111 + ((EQCAR X (QUOTE EXPT)) 00029112 + (AND (SETQ N 00029113 + (REVAL (LIST (QUOTE TIMES) (CADDR X) N))) 00029114 + (SETQ X (CADR X))))) 00029115 + (RETURN 00029116 + (COND ((EQUAL X 0) (CONS NIL 1)) 00029117 + ((EQUAL X 1) (CONS 1 1)) 00029118 + ((AND (ATOM X) (MEMBER N FRLIS*)) 00029119 + (CONS (LIST (CONS (CONS X N) 1)) 1)) 00029120 + (T 00029121 + (PROG2 (AND (NOT (MEMBER X EXPTL*)) 00029122 + (NOT (NUMBERP X)) 00029123 + (SETQ EXPTL* (CONS X EXPTL*))) 00029124 + (MKSQ (LIST (QUOTE EXPT) X N) 1))))) 00029125 + A0 (SETQ N (CAR N)) 00029170 + (COND ((NULL N) (SETQ N 0))) 00029172 + A (RETURN 00029180 + (COND ((EQUAL N 0) (CONS 1 1)) 00029190 + ((ATOM (CAR U)) 00029200 + (COND ((NULL N) (CONS 1 1)) 00029210 + ((NUMBERP (CAR U)) 00029220 + (COND 00029230 + ((ZEROP (CAR U)) (CONS NIL 1)) 00029240 + ((MINUSP N) 00029250 + (CONS 1 (EXPT (CAR U) (MINUS N)))) 00029260 + (T (CONS (EXPT (CAR U) N) 1)))) 00029270 + ((MINUSP N) 00029280 + (LIST 1 (CONS (MKSP (CAR U) (MINUS N)) 1))) 00029290 + (T (MKSQ (CAR U) N)))) 00029300 + ((MINUSP N) (REVPR (NMULTSQ (SIMPCAR U) (MINUS N)))) 00029310 + (T (NMULTSQ (SIMPCAR U) N)))) 00029311 + B (SETQ U (CDDR X)) 00029312 + (SETQ X (SIMPEXPT (LIST (CADR X) N))) 00029313 + C (COND ((NULL U) (RETURN X))) 00029314 + (SETQ X (MULTSQ (SIMPEXPT (LIST (CAR U) N)) X)) 00029315 + (SETQ U (CDR U)) 00029316 + (GO C)))) 00029317 + 00029318 +(MEXPT (LAMBDA (U V) 00029340 + (COND 00029350 + ((NOT (EQUAL (CADAR U) (CADAR V))) (QUOTE FAILED)) 00029360 + (T 00029370 + ((LAMBDA(X) 00029380 + (COND ((EQUAL X 0) 1) 00029390 + ((AND (NUMBERP X) (EQUAL (CADAR U) (QUOTE (MINUS 1)))) 00029400 + (COND ((ZEROP (REMAINDER X 2)) 1) (T -1))) 00029410 + (T (MKSQP (MKSQ (LIST (QUOTE EXPT) (CADAR U) X) 1))))) 00029450 + (REVAL 00029460 + (LIST (QUOTE PLUS) 00029470 + (LIST (QUOTE TIMES) (CDR U) (CADDAR U)) 00029480 + (LIST (QUOTE TIMES) (CDR V) (CADDAR V))))))))) 00029490 + 00029500 +)) 00029510 + 00029520 +DEFLIST (((EXPT MEXPT)) MRULE) 00029530 + 00029540 +DEFINE (( 00029550 + 00029560 +(SIMPIDEN (LAMBDA (*S*) 00029570 + (PROG (Y Z) 00029580 + (COND ((FLAGP (CAR *S*) (QUOTE VOP)) (GO E))) 00029590 + (SETQ *S* 00029600 + (CONS (CAR *S*) (MAPCAR (CDR *S*) (FUNCTION REVAL)))) 00029610 + B (COND ((SETQ Z (OPMTCH *S*)) (RETURN (SIMP Z))) 00029620 + ((FLAGP (CAR *S*) (QUOTE SYMMETRIC)) 00029630 + (SETQ *S* (CONS (CAR *S*) (ORDN (CDR *S*))))) 00029640 + ((FLAGP (CAR *S*) (QUOTE ANTISYMMETRIC)) (GO D))) 00029650 + C (SETQ *S* (MKSQ *S* 1)) 00029660 + (RETURN (COND (Y (NEGSQ *S*)) (T *S*))) 00029670 + D (COND ((REPEATS (CDR *S*)) (RETURN (CONS NIL 1))) 00029680 + ((NOT (PERMP (SETQ Z (ORDN (CDR *S*))) (CDR *S*))) 00029690 + (SETQ Y T))) 00029700 + (SETQ *S* (CONS (CAR *S*) Z)) 00029710 + (GO C) 00029720 + E (COND ((ATOMLIS (CDR *S*)) (GO B))) 00029730 + (RETURN 00029740 + (MKVARG (CDR *S*) 00029750 + (FUNCTION 00029760 + (LAMBDA (J) (SIMPIDEN (CONS (CAR *S*) J))))))))) 00029770 + 00029780 +(NEGSQ (LAMBDA (U) 00029790 + (CONS (MULTN -1 (CAR U)) (CDR U)))) 00029800 + 00029810 +(SIMPMINUS (LAMBDA (U) 00029820 + (NEGSQ (SIMP (CARX U))))) 00029830 + 00029840 +(SIMPPLUS (LAMBDA (U) 00029850 + (PROG (Z) 00029860 + (SETQ Z (CONS NIL 1)) 00029870 + A (COND ((NULL U) (RETURN Z))) 00029880 + (SETQ Z (ADDSQ (SIMPCAR U) Z)) 00029890 + (SETQ U (CDR U)) 00029900 + (GO A)))) 00029910 + 00029920 +(SIMPQUOT (LAMBDA (U) 00029930 + ((LAMBDA(X) 00029940 + (COND 00029950 + ((NULL (CDR X)) (REDERR (QUOTE (ZERO DENOMINATOR)))) 00029960 + (T (MULTSQ (SIMPCAR U) X)))) 00029970 + (SIMPRECIP (CDR U))))) 00029980 + 00029990 +(SIMPRECIP (LAMBDA (U) 00030000 + ((LAMBDA(X) 00030010 + (COND 00030020 + ((NULL (CAR X)) (REDERR (QUOTE (ZERO DENOMINATOR)))) 00030030 + ((AND *FLOAT (ATOM (CAR X))) 00030040 + (CONS (MULTN (RECIP (PLUS 0.0 (CAR X))) (CDR X)) 1)) 00030050 + (T (REVPR X)))) 00030060 + (SIMP (CARX U))))) 00030070 + 00030080 +(SIMPTIMES (LAMBDA (U) 00030090 + (PROG (X) 00030100 + (SETQ X (SIMPCAR U)) 00030110 + A (SETQ U (CDR U)) 00030120 + (COND ((NULL (CAR X)) (RETURN (CONS NIL 1))) 00030130 + ((NULL U) (RETURN X))) 00030140 + (SETQ X (MULTSQ X (SIMPCAR U))) 00030150 + (GO A)))) 00030160 + 00030170 +(SIMPSUBS (LAMBDA (U) 00030180 + (PROG (X Y Z) 00030190 + (SETQ U (REVERSE U)) 00030200 + (SETQ Y (SUBS2 (SIMPCAR U))) 00030210 + (SETQ U (CDR U)) 00030220 + A (COND ((NULL U) (GO B)) 00030230 + ((NOT (MEMBER (CAAR U) (QUOTE (EQUAL SETQ)))) 00030240 + (GO ERR)) 00030250 + ((VECTORP (SETQ X (CADAR U))) (GO C)) 00030260 + ((OR (NOT (KERNP (SETQ X (SIMP X)))) 00030270 + (NOT (EQUAL (CDR X) 1)) 00030280 + (NOT (EQUAL (CDAAR X) 1)) 00030290 + (NOT (EQUAL (CDAAAR X) 1))) 00030300 + (GO ERR))) 00030310 + (SETQ X (CAAAAR X)) 00030320 + C (SETQ Z (CONS (CONS X (CADDAR U)) Z)) 00030330 + (SETQ U (CDR U)) 00030340 + (GO A) 00030350 + B (RETURN (SIMP (SUBLIS Z (PREPSQ Y)))) 00030360 + ERR (ERRPRI1 (CAR U)) 00030370 + (ERROR*)))) 00030380 + 00030390 +(SIMP*SQ (LAMBDA (U) 00030400 + (COND ((NULL (CADR U)) (SIMP (PREPSQ (CAR U)))) (T (CAR U))))) 00030410 + 00030420 +)) 00030430 + 00030440 +DEFINE (( 00030450 + 00030460 +(SUBS2 (LAMBDA (U) 00030470 + (PROG (X) 00030480 + (RSET2) 00030490 + (SETQ U (EXPSQ U)) 00030500 + (COND ((AND (NULL EXPTL*) 00030505 + (OR (NULL MATCH*) (NULL SUBFG*))) (GO A))) 00030510 + (COND (EXPTL* (SETQ U (EXPTCHK U)))) 00030515 + (SETQ X MCHFG*) 00030520 + (SETQ U (MULTSQ (SUBS31 (CAR U)) (REVPR (SUBS31 (CDR U))))) 00030530 + (SETQ MCHFG* X) 00030540 + A (RETURN (CANCEL U))))) 00030550 + 00030560 +(CANCEL (LAMBDA (U) 00030570 + (PROG (X) 00030580 + (COND ((NULL (CAR U)) (RETURN (CONS NIL 1))) 00030590 + ((OR *FLOAT (EQUAL (CDR U) 1)) (GO C))) 00030600 + (SETQ X (GCD1 (CDR U) (CAR U))) 00030610 + (SETQ U (CONS (QUOTF (CAR U) X) (QUOTF (CDR U) X))) 00030620 + C (RETURN (MKCANON U))))) 00030630 + 00030640 +(MKCANON (LAMBDA (U) 00030650 + (COND ((MINUSF (CDR U)) 00030660 + (CONS (MULTN -1 (CAR U)) (MULTN -1 (CDR U)))) 00030670 + (T U)))) 00030680 + 00030690 +(MINUSF (LAMBDA (U) 00030700 + (COND ((NULL U) NIL) 00030701 + ((ATOM U) (MINUSP U)) 00030702 + ((EQ (CAR U) (QUOTE QUOTIENT)) (MINUSP (CADR U))) 00030703 + (T (MINUSF (CDAR U)))))) 00030704 + 00030720 +)) 00030730 + 00030740 +DEFINE (( 00030750 + 00030760 +(EXPSQ (LAMBDA (U) 00030770 + (COND ((OR (NULL SUB2*) (NULL *EXP)) U) 00030780 + (T 00030790 + ((LAMBDA(X Y) 00030800 + (CONS (MULTF (CAR X) (CDR Y)) (MULTF (CDR X) (CAR Y)))) 00030810 + (EXPAND (CAR U)) 00030820 + (COND (*XDN (EXPAND (CDR U))) (T (CONS (CDR U) 1)))))))) 00030830 + 00030840 +(EXPAND (LAMBDA (U) 00030850 + (PROG (W X Y Z) 00030860 + (COND ((ATOM U) (RETURN (CONS U 1)))) 00030870 + (SETQ X U) 00030880 + (SETQ Z (CONS NIL 1)) 00030890 + A (COND 00030900 + ((NULL X) 00030910 + (RETURN 00030920 + (COND ((EQUAL (CAR Z) U) (CONS U (CDR Z))) (T Z)))) 00030930 + ((ATOM X) (GO E))) 00030940 + (SETQ Y (EXPAND (CDAR X))) 00030950 + (COND 00030960 + ((AND (NOT (ATOM (SETQ W (CAAAR X)))) 00030970 + (OR (EQ (CAR W) (QUOTE *SQ)) (NOT (ATOM (CAR W))))) 00030980 + (GO C))) 00030990 + (SETQ Z (ADDSQ (CONS (MULTF2 (CAAR X) (CAR Y)) (CDR Y)) Z)) 00031000 + B (SETQ X (CDR X)) 00031010 + (GO A) 00031020 + C (SETQ Z 00031030 + (ADDSQ 00031040 + (MULTSQ 00031050 + (COND 00031060 + ((EQ (CAR W) (QUOTE *SQ)) 00031070 + (NMULTSQ (EXPSQ (CADR W)) (CDAAR X))) 00031080 + ((NULL (CDAAR X)) (EXPSQ W)) 00031090 + (T (NMULTSQ (EXPAND W) (CDAAR X)))) 00031100 + Y) 00031110 + Z)) 00031120 + (GO B) 00031130 + E (SETQ Z (ADDSQ (CONS X 1) Z)) 00031140 + (SETQ X NIL) 00031150 + (GO A)))) 00031160 + 00031170 +)) 00031180 + 00031181 +DEFINE (( 00031182 + 00031183 +(EXSCAN (LAMBDA (U) 00031184 + (COND ((ATOM U) U) 00031185 + (T 00031186 + (ADDF 00031187 + (MULTF2 00031188 + (COND 00031189 + ((MEMBER (CAAAR U) EXPTL*) 00031190 + (MKSP (LIST (QUOTE EXPT) (CAAAR U) 1) (CDAAR U))) 00031191 + (T (CAAR U))) 00031192 + (EXSCAN (CDAR U))) 00031193 + (EXSCAN (CDR U))))))) 00031194 + 00031195 +(EXPTCHK (LAMBDA (U) 00031196 + (PROG (V W X Y Y1 Z) 00031197 + (SETQ V (EXSCAN (CAR U))) 00031198 + (SETQ W (CDR U)) 00031199 + (SETQ X (CONS FACTORS* ORDN*)) 00031200 + (SETQ FACTORS* NIL) 00031201 + (SETQ ORDN* 0) 00031202 + (SETQ Y (CKRN W)) 00031203 + A (COND ((ATOM Y) (GO C))) 00031204 + (SETQ Y1 (CAAAR Y)) 00031205 + (COND 00031206 + ((AND (NOT (MEMBER Y1 EXPTL*)) (NOT (EQCAR Y1 (QUOTE EXPT)))) 00031207 + (GO B))) 00031208 + (SETQ V 00031209 + (MULTF2 00031210 + (MKSP 00031211 + (COND 00031212 + ((MEMBER Y1 EXPTL*) (LIST (QUOTE EXPT) Y1 -1)) 00031213 + (T 00031214 + (LIST (QUOTE EXPT) 00031215 + (CADR Y1) 00031216 + (PREPSQ (SIMPMINUS (CDDR Y1)))))) 00031217 + (CDAAR Y)) 00031218 + V)) 00031219 + (SETQ Z (CONS (CAAR Y) Z)) 00031220 + B (SETQ Y (CDAR Y)) 00031221 + (GO A) 00031222 + C (SETQ FACTORS* (CAR X)) 00031223 + (SETQ ORDN* (CDR X)) 00031224 + (SETQ X 1) 00031225 + D (COND ((NULL Z) (GO E))) 00031226 + (SETQ X (LIST (CONS (CAR Z) X))) 00031227 + (SETQ Z (CDR Z)) 00031228 + (GO D) 00031229 + (COND ((EQUAL V (CAR U)) (SETQ V (CAR U)))) 00031230 + E (RETURN (CONS V (QUOTF W X)))))) 00031231 + 00031232 +)) 00031233 + 00031234 +DEFINE (( 00031235 + 00031236 +(SUBS31 (LAMBDA (U) 00031237 + (COND ((ATOM U) (CONS U 1)) 00031238 + (T 00031239 + (ADDSQ 00031250 + ((LAMBDA(X) 00031260 + (COND ((NULL MCHFG*) (CONS (LIST (CAR U)) 1)) 00031270 + ((AND MCHFG* (NOT (SETQ MCHFG* NIL)) *RESUBS) 00031280 + (SUBS2 X)) 00031290 + (T X))) 00031300 + (SUBS3T (CAR U) MATCH*)) 00031310 + (SUBS31 (CDR U))))))) 00031320 + 00031330 +(SUBS3T (LAMBDA (U V) 00031340 + (SUBS3T0 (SUBS3T1 U V)))) 00031350 + 00031360 +(SUBS3T0 (LAMBDA (X) 00031370 + (PROG (Y) 00031380 + (COND ((OR (CAR X) (ATOM (CDR X))) (RETURN X))) 00031390 + (SETQ Y (MULTSQ (SIMP (CAADR X)) (CADDR X))) 00031400 + (COND 00031410 + ((CDADR X) 00031420 + (SETQ Y 00031430 + (MULTSQ 00031440 + (REVPR (SIMPTIMES (EXCHK (CDADR X) NIL))) 00031450 + Y)))) 00031460 + (RETURN (CANCEL Y))))) 00031470 + 00031480 +(SUBS3T1 (LAMBDA (U V) 00031490 + (PROG (X Y Z) 00031500 + (SETQ X (MTCHK (CAR U) V)) 00031510 + (COND 00031520 + ((NULL X) 00031530 + (RETURN (COND ((NULL MCHFG*) U) (T (CONS (LIST U) 1))))) 00031540 + ((AND (NULL (CAAR X)) 00031550 + (SETQ MCHFG* T) 00031560 + (SETQ Y 00031570 + (LIST NIL 00031580 + (CONS (CADDAR X) (CADR (CDDAR X))) 00031590 + (SUBS32 (CDR U) MATCH*)))) 00031600 + (GO B)) 00031610 + ((AND (NOT (ATOM (CDR U))) (NULL (CDDR U))) (GO A))) 00031620 + (SETQ Y (SUBS32 (CDR U) X)) 00031630 + (COND ((NULL MCHFG*) (RETURN (CONS (CAR U) Y)))) 00031640 + A0 (SETQ X (LIST (CONS (CAR U) 1))) 00031650 + (SETQ Z (GCD1 X (CDR Y))) 00031660 + (RETURN 00031670 + (COND ((NULL Z) (MULTS2 (CAR U) Y)) 00031680 + ((EQUAL X Z) (CONS (CAR Y) (QUOTF (CDR Y) X))) 00031690 + (T 00031700 + (CONS (MULTF (QUOTF X Z) (CAR Y)) 00031710 + (QUOTF (CDR Y) Z))))) 00031720 + A (SETQ Y (SUBS3T1 (CADR U) X)) 00031730 + (COND ((AND (NULL (CAR Y)) (NOT (ATOM (CDR Y)))) (GO B)) 00031740 + ((NULL MCHFG*) (RETURN (LIST (CAR U) Y))) 00031750 + (T (GO A0))) 00031760 + B (COND 00031770 + ((AND (CDADR Y) (EQUAL (CADADR Y) (CAR U))) 00031780 + (RETURN (LIST NIL (CONS (CAADR Y) (CDDADR Y)) (CADDR Y)))) 00031790 + ((AND (NOT (ATOM (CAAR U))) 00031800 + (FLAGP** (CAAAR U) (QUOTE NONCOM)) 00031810 + (SETQ Y (SUBS3T0 Y))) 00031820 + (GO A0)) 00031830 + (T 00031840 + (RETURN (LIST NIL (CADR Y) (MULTS2 (CAR U) (CADDR Y)))))))) 00031850 +) 00031860 + 00031870 +(MULTS2 (LAMBDA (U V) 00031880 + (CONS (MULTF2 U (CAR V)) (CDR V)))) 00031890 + 00031900 +(SUBS32 (LAMBDA (U V) 00031910 + (PROG (B X Y) 00031920 + A (COND 00031930 + ((ATOM U) 00031940 + (RETURN 00031950 + (COND (MCHFG* 00031960 + (COND ((NULL X) (CONS U 1)) 00031970 + (T (ADDSQ (CONS U 1) X)))) 00031980 + (T (APPEND X U)))))) 00031990 + (SETQ Y (SUBS3T (CAR U) V)) 00032000 + (COND ((NULL MCHFG*) (SETQ X (APPEND X (LIST Y)))) 00032010 + (B (SETQ X (ADDSQ Y X))) 00032020 + ((SETQ B T) (SETQ X (ADDSQ (CONS X 1) Y)))) 00032030 + (SETQ U (CDR U)) 00032040 + (GO A)))) 00032050 + 00032060 +(MKKL (LAMBDA (U V) 00032070 + (COND ((NULL U) V) (T (MKKL (CDR U) (LIST (CONS (CAR U) V))))))) 00032080 + 00032090 +)) 00032100 + 00032110 +DEFINE (( 00032120 + 00032130 +(MTCHK (LAMBDA (U V1) 00032140 + (PROG (V W X Y Z) 00032150 + A0 (COND ((NULL V1) (RETURN Z))) 00032160 + (SETQ V (CAR V1)) 00032170 + (SETQ W (CAR V)) 00032180 + A (COND ((NULL W) (GO D)) 00032190 + ((AND (EQUAL U (CAR W)) (SETQ Y (LIST NIL))) (GO B)) 00032200 + ((NOT (ATOM (CAR U))) (GO A1)) 00032210 + ((NOT (ATOM (CAAR W))) (GO D)) 00032220 + ((OR FRLIS* (ORDP (CAR U) (CAAR W))) (GO A2)) 00032230 + (T (GO E))) 00032231 + A1 (COND ((EQ (CAAR U) (CAAAR W)) (GO A2)) 00032232 + ((FLAGP** (CAAR U) (QUOTE NONCOM)) (GO C1)) 00032234 + ((NULL (ORDP (CAAR U) (CAAAR W))) (GO E)) 00032240 + (T (GO D))) 00032250 + A2 (COND 00032260 + ((OR (AND (NOT (MEMBER (CDAR W) FRLIS*)) 00032270 + (OR (AND (CAADR V) 00032280 + (NOT (EQUAL (CDR U) (CDAR W)))) 00032290 + (LESSP (CDR U) (CDAR W)))) 00032300 + (NOT (SETQ Y (MCHK (CAR U) (CAAR W))))) 00032310 + (GO C)) 00032320 + ((MEMBER (CDAR W) FRLIS*) 00032321 + (SETQ Y 00032322 + (MAPCONS U (CONS (CDAR W) (CDR U)))))) 00032324 + B (COND ((NULL Y) (GO C)) 00032330 + ((AND (NULL 00032340 + (CAR 00032350 + (SETQ X 00032360 + (CONS (SUBLIS (CAR Y) 00032370 + (DELETE (CAR W) (CAR V))) 00032380 + (LIST (CADR V) 00032390 + (SUBLIS (CAR Y) (CADDR V)) 00032400 + (CONS 00032410 + (SUBLIS (CAR Y) (CAR W)) 00032420 + (CADDDR V))))))) 00032430 + (*EVAL (SUBLIS (CAR Y) (CDADR V)))) 00032440 + (RETURN (LIST X)))) 00032450 + (SETQ Z (CONS X Z)) 00032460 + (SETQ Y (CDR Y)) 00032470 + (GO B) 00032480 + C (COND 00032490 + ((AND (NOT (ATOM (CAR U))) 00032500 + (FLAGP** (CAAR U) (QUOTE NONCOM))) 00032510 + (GO C1))) 00032520 + (SETQ W (CDR W)) 00032530 + (GO A) 00032540 + C1 (COND ((AND (CADDDR V) (NOT (NOCP (CADDDR V)))) (GO E))) 00032550 + D (SETQ Z (APPEND Z (LIST V))) 00032580 + E (SETQ V1 (CDR V1)) 00032590 + (GO A0)))) 00032600 + 00032710 +(NOCP (LAMBDA (U) 00032720 + (OR (NULL U) 00032730 + (AND (OR (ATOM (CAAR U)) 00032740 + (NOT (FLAGP** (CAAAR U) (QUOTE NONCOM)))) 00032750 + (NOCP (CDR U)))))) 00032760 + 00032770 +(MCHK (LAMBDA (U V) 00032780 + (COND ((EQUAL U V) (LIST NIL)) 00032790 + ((OR (NULL U) (NULL V)) NIL) 00032800 + ((MEMBER V FRLIS*) (LIST (LIST (CONS V (EMTCH U))))) 00032810 + ((OR (ATOM U) (ATOM V)) NIL) 00032820 + ((EQ (CAR U) (CAR V)) (MCHARG (CDR U) (CDR V) (CAR U))) 00032830 + (T NIL)))) 00032840 + 00032850 +(MCHARG (LAMBDA (*S* V W) 00032860 + ((LAMBDA(X) 00032870 + (COND 00032880 + ((MTP V) 00032890 + (COND 00032900 + (X 00032910 + (COND 00032920 + ((FLAGP W (QUOTE SYMMETRIC)) 00032930 + (MAPLIST (PERMUTATIONS V) 00032940 + (FUNCTION 00032950 + (LAMBDA(J) 00032960 + (PAIR (CAR J) 00032970 + (MAPCAR *S* (FUNCTION EMTCH))))))) 00032980 + ((FLAGP W (QUOTE ANTISYMMETRIC)) 00032990 + (ERRACH (QUOTE (NOT YET)))) 00033000 + (T (LIST (PAIR V (MAPCAR *S* (FUNCTION EMTCH))))))) 00033010 + ((AND (EQUAL (LENGTH V) 2) (FLAGP W (QUOTE NARY))) 00033020 + (MCHARG (CDR (MKBIN (CONS W *S*))) V W)) 00033030 + (T NIL))) 00033040 + (X (MCHARG1 *S* V (FLAGP W (QUOTE SYMMETRIC)) (LIST NIL))) 00033050 + (T NIL))) 00033060 + (EQUAL (LENGTH *S*) (LENGTH V))))) 00033070 + 00033080 +(MCHARG1 (LAMBDA (U V FLG W) 00033090 + (PROG (X Z) 00033100 + (COND ((NULL U) (RETURN W)) 00033110 + ((NULL FLG) 00033120 + (RETURN 00033130 + (MCHARG3 U (CDR V) (MCHK (CAR U) (CAR V)) FLG W)))) 00033140 + (SETQ X (MCHARG2 (CAR U) V)) 00033150 + A (COND ((NULL X) (RETURN Z))) 00033160 + (SETQ Z (APPEND (MCHARG3 U (CDAR X) (CAAR X) FLG W) Z)) 00033170 + (SETQ X (CDR X)) 00033180 + (GO A)))) 00033190 + 00033200 +(MCHARG2 (LAMBDA (U V) 00033210 + (PROG (X Y Z) 00033220 + A (COND ((NULL V) (RETURN (REVERSE Z))) 00033230 + ((SETQ Y (MCHK U (CAR V))) 00033240 + (SETQ Z 00033250 + (CONS (CONS Y (APPEND (REVERSE X) (CDR V))) 00033260 + Z)))) 00033270 + (SETQ X (CONS (CAR V) X)) 00033280 + (SETQ V (CDR V)) 00033290 + (GO A)))) 00033300 + 00033310 +(MCHARG3 (LAMBDA (U V *S* FLG W) 00033320 + (PROG (Z) 00033330 + A (COND ((NULL *S*) (RETURN Z))) 00033340 + (SETQ Z 00033350 + (APPEND (MCHARG1 (CDR U) 00033360 + (SUBLIS (CAR *S*) V) 00033370 + FLG 00033380 + (MAPLIST W 00033390 + (FUNCTION 00033400 + (LAMBDA(J) 00033410 + (APPEND 00033420 + (CAR *S*) 00033430 + (CAR J)))))) 00033440 + Z)) 00033450 + (SETQ *S* (CDR *S*)) 00033460 + (GO A)))) 00033470 + 00033480 +(MKBIN (LAMBDA (U) 00033490 + (COND ((OR (NULL (CDDR U)) (NULL (CDDDR U))) U) 00033500 + (T (MKBIN1 (CAR U) (CDR U)))))) 00033510 + 00033520 +(MKBIN1 (LAMBDA (U V) 00033530 + (COND ((NULL (CDDR V)) (CONS U V)) 00033540 + (T (LIST U (CAR V) (MKBIN1 U (CDR V))))))) 00033550 + 00033560 +(MTP (LAMBDA (V) 00033570 + (OR (NULL V) 00033580 + (AND (MEMBER (CAR V) FRLIS*) 00033590 + (NOT (MEMBER (CAR V) (CDR V))) 00033600 + (MTP (CDR V)))))) 00033610 + 00033620 +(PERMUTATIONS (LAMBDA (*S*) 00033630 + (COND ((NULL *S*) (LIST NIL)) 00033640 + ((NULL (CDR *S*)) (LIST *S*)) 00033650 + (T 00033660 + (MAPCON *S* 00033670 + (FUNCTION 00033680 + (LAMBDA(J) 00033690 + (MAPCONS 00033700 + (PERMUTATIONS (DELETE (CAR J) *S*)) 00033710 + (CAR J))))))))) 00033720 + 00033730 +)) 00033740 + 00033750 +DEFINE (( 00033760 + 00033770 +(EMTCH (LAMBDA (U) 00033780 + (COND ((ATOM U) U) 00033790 + (T ((LAMBDA (X) (COND (X X) (T U))) (OPMTCH U)))))) 00033800 + 00033810 +(OPMTCH (LAMBDA (U) 00033820 + (PROG (X Y) 00033830 + (COND ((NULL SUBFG*) (RETURN NIL))) 00033840 + (SETQ X (GET (CAR U) (QUOTE OPMTCH*))) 00033850 + A (COND ((NULL X) (RETURN NIL)) 00033860 + ((AND (NULL (CAADAR X)) 00033870 + (SETQ Y (MCHARG (CDR U) (CAAR X) (CAR U))) 00033880 + (*EVAL (SUBLIS (CAR Y) (CDADAR X)))) 00033890 + (GO B))) 00033900 + (SETQ X (CDR X)) 00033910 + (GO A) 00033920 + B (RETURN (SUBLIS (CAR Y) (CADDAR X)))))) 00033930 + 00033940 +)) 00033950 + 00033960 +DEFINE (( 00033970 + 00033980 +(ORDER (LAMBDA (U) 00033990 + (PROG NIL 00034000 + A (COND ((NULL U) (RETURN NIL)) 00034010 + ((OR (NOT (ATOM (CAR U))) (NUMBERP (CAR U))) (GO B))) 00034020 + (PUT (CAR U) (QUOTE ORDER) ORDN*) 00034030 + (SETQ ORDN* (ADD1 ORDN*)) 00034040 + B (SETQ U (CDR U)) 00034050 + (GO A)))) 00034060 + 00034070 +(FORMOP (LAMBDA (U) 00034080 + (COND ((ATOM U) U) 00034090 + (T 00034100 + (ADDOF (MULTOP (CAAR U) (FORMOP (CDAR U))) 00034110 + (FORMOP (CDR U))))))) 00034120 + 00034130 +(ADDOF (LAMBDA (U V) 00034140 + (COND ((NULL U) V) 00034150 + ((NULL V) U) 00034160 + ((ATOM U) (CONS (CAR V) (ADDOF U (CDR V)))) 00034170 + ((ATOM V) (ADDOF V U)) 00034180 + ((EQUAL (CAAR U) (CAAR V)) 00034190 + (CONS (CONS (CAAR U) (ADDOF (CDAR U) (CDAR V))) 00034200 + (ADDOF (CDR U) (CDR V)))) 00034210 + ((ORDOP (CAAR U) (CAAR V)) (CONS (CAR U) (ADDOF (CDR U) V))) 00034220 + (T (CONS (CAR V) (ADDOF U (CDR V))))))) 00034230 + 00034240 +(MULTOP (LAMBDA (U V) 00034250 + (COND ((EQ (CAR U) (QUOTE K*)) V) (T (MULTOP1 U V))))) 00034260 + 00034270 +(MULTOP1 (LAMBDA (U V) 00034280 + (COND ((NULL V) NIL) 00034290 + ((OR (ATOM V) (ORDOP U (CAAR V))) (LIST (CONS U V))) 00034300 + (T 00034310 + (CONS (CONS (CAAR V) (MULTOP1 U (CDAR V))) 00034320 + (MULTOP1 U (CDR V))))))) 00034330 + 00034340 +(ORDOP (LAMBDA (U V) 00034350 + (COND ((NULL U) (NULL V)) 00034360 + ((NULL V) NIL) 00034370 + ((AND (MEMBER U FACTORS*) (NOT (MEMBER V FACTORS*))) T) 00034380 + ((AND (MEMBER V FACTORS*) (NOT (MEMBER U FACTORS*))) NIL) 00034390 + ((ATOM U) 00034400 + (COND 00034410 + ((ATOM V) 00034420 + (COND ((NUMBERP U) (AND (NUMBERP V) (NOT (LESSP U V)))) 00034430 + ((NUMBERP V) T) 00034440 + ((ZEROP ORDN*) (ORDERP U V)) 00034445 + (T 00034450 + ((LAMBDA(X Y) 00034460 + (COND ((AND X Y) (LESSP X Y)) 00034470 + (X T) 00034480 + (Y NIL) 00034490 + (T (ORDERP U V)))) 00034500 + (GET U (QUOTE ORDER)) 00034510 + (GET V (QUOTE ORDER)))))) 00034520 + ((MEMBER U FACTORS*) T) 00034530 + (T (NOT (MEMBER (CAR V) FACTORS*))))) 00034540 + ((ATOM V) (MEMBER (CAR U) FACTORS*)) 00034550 + ((EQUAL (CAR U) (CAR V)) (ORDOP (CDR U) (CDR V))) 00034560 + (T (ORDOP (CAR U) (CAR V)))))) 00034570 + 00034580 +(QUOTOF (LAMBDA (P Q) 00034590 + (COND ((NULL P) NIL) 00034600 + ((EQUAL P Q) 1) 00034610 + ((EQUAL Q 1) P) 00034620 + ((NUMB Q) 00034630 + (COND 00034640 + ((NUMB P) 00034650 + (COND ((AND (ATOM P) (ATOM Q)) (MKFR P Q)) 00034660 + (T (ERRACH (LIST (QUOTE QUOTOF) P Q))))) 00034670 + (T 00034680 + (CONS (CONS (CAAR P) (QUOTOF (CDAR P) Q)) 00034690 + (QUOTOF (CDR P) Q))))) 00034700 + ((NUMB P) 00034710 + (LIST 00034720 + (CONS (CONS (CAAAR Q) (MINUS (CDAAR Q))) 00034730 + (QUOTOF P (CDARX Q))))) 00034740 + (T 00034750 + ((LAMBDA(X Y) 00034760 + (COND 00034770 + ((EQ (CAR X) (CAR Y)) 00034780 + ((LAMBDA(N W Z) 00034790 + (COND ((ZEROP N) (ADDOF W Z)) 00034800 + (T (CONS (CONS (CONS (CAR Y) N) W) Z)))) 00034810 + (DIFFERENCE (CDR X) (CDR Y)) 00034820 + (QUOTOF (CDAR P) (CDARX Q)) 00034830 + (QUOTOF (CDR P) Q))) 00034840 + ((ORDOP X Y) 00034850 + (CONS (CONS X (QUOTOF (CDAR P) Q)) (QUOTOF (CDR P) Q))) 00034860 + (T 00034870 + (LIST 00034880 + (CONS (CONS (CAR Y) (MINUS (CDR Y))) 00034890 + (QUOTOF P (CDARX Q))))))) 00034900 + (CAAR P) 00034910 + (CAAR Q)))))) 00034920 + 00034930 +)) 00034940 + 00034950 +DEFINE (( 00034960 + 00034970 +(CKRN (LAMBDA (U) 00034980 + (PROG (X) 00034990 + (COND ((KERNLOP U) (RETURN U))) 00035000 + A (SETQ X (CONS (CKRN (CDAR U)) X)) 00035010 + (COND 00035020 + ((NULL (CDR U)) (RETURN (LIST (CONS (CAAR U) (GCK X))))) 00035030 + ((OR (ATOM (CDR U)) (NOT (EQ (CAAAR U) (CAAADR U)))) 00035040 + (RETURN (GCK (CONS (CKRN (CDR U)) X))))) 00035050 + (SETQ U (CDR U)) 00035060 + (GO A)))) 00035070 + 00035080 +(GCK (LAMBDA (U) 00035090 + (COND ((NULL U) 1) 00035100 + ((NULL (CDR U)) (CAR U)) 00035110 + (T (GCK (CONS (GCK1 (CAR U) (CADR U)) (CDDR U))))))) 00035120 + 00035130 +(GCK1 (LAMBDA (U V) 00035140 + (COND ((OR (NULL U) (NULL V)) (ERRACH (QUOTE GCK1))) 00035150 + ((EQUAL U V) U) 00035160 + ((NUMB U) 00035170 + (COND 00035180 + ((NUMB V) 00035190 + (COND ((AND (ATOM U) (ATOM V)) (GCDN U V)) (T 1))) 00035200 + (T (GCK1 U (CDARX V))))) 00035210 + ((NUMB V) (GCK1 (CDARX U) V)) 00035220 + (T 00035230 + ((LAMBDA(X Y) 00035240 + (COND 00035250 + ((EQ (CAR X) (CAR Y)) 00035260 + (LIST 00035270 + (CONS 00035280 + (COND ((GREATERP (CDR X) (CDR Y)) Y) (T X)) 00035290 + (GCK1 (CDARX U) (CDARX V))))) 00035300 + ((ORDOP X Y) (GCK1 (CDARX U) V)) 00035310 + (T (GCK1 U (CDARX V))))) 00035320 + (CAAR U) 00035330 + (CAAR V)))))) 00035340 + 00035350 +)) 00035360 + 00035370 +DEFINE (( 00035380 + 00035390 +(PREPSQ (LAMBDA (U) 00035400 + (COND ((NULL (CAR U)) 0) 00035410 + (T 00035420 + ((LAMBDA(X) 00035430 + (COND 00035440 + ((OR *RAT (AND (NOT *FLOAT) *DIV) UPL* DNL*) 00035450 + (REPLUS (PREPSQ1 (CAR X) NIL (CDR X)))) 00035460 + (T 00035470 + (SQFORM X 00035480 + (FUNCTION 00035490 + (LAMBDA (J) (REPLUS (PREPSQ1 J NIL 1)))))))) 00035500 + (CONS (FORMOP (CAR U)) (FORMOP (CDR U)))))))) 00035510 + 00035520 +(SQFORM (LAMBDA (U *PI*) 00035530 + ((LAMBDA(X Y) 00035540 + (COND ((EQUAL Y 1) X) (T (LIST (QUOTE QUOTIENT) X Y)))) 00035550 + (*PI* (CAR U)) 00035560 + (*PI* (CDR U))))) 00035570 + 00035580 +(PREPSQ1 (LAMBDA (U V W) 00035590 + (PROG (X Y Z) 00035600 + (COND ((NULL U) (RETURN NIL)) 00035610 + ((AND (NOT (ATOM U)) 00035620 + (OR (MEMBER (CAAAR U) FACTORS*) 00035630 + (AND (NOT (ATOM (CAAAR U))) 00035640 + (MEMBER (CAAAAR U) FACTORS*)))) 00035650 + (RETURN 00035660 + (NCONC (PREPSQ1 (CDAR U) (CONS (CAAR U) V) W) 00035670 + (PREPSQ1 (CDR U) V W)))) 00035680 + ((NULL (KERNLP U)) (GO A))) 00035690 + (SETQ U (MKKL V U)) 00035700 + (SETQ V NIL) 00035710 + A (SETQ X (CKRN U)) 00035720 + (COND ((NULL DNL*) (GO A1))) 00035730 + (SETQ Z (CKRN* X DNL*)) 00035740 + (SETQ X (QUOTOF X Z)) 00035750 + (SETQ U (QUOTF U Z)) 00035760 + (SETQ W (QUOTOF W Z)) 00035770 + A1 (SETQ Y (CKRN W)) 00035780 + (COND ((NULL UPL*) (GO A2))) 00035790 + (SETQ Z (CKRN* Y UPL*)) 00035800 + (SETQ Y (QUOTOF Y Z)) 00035810 + (SETQ U (QUOTOF U Z)) 00035820 + (SETQ W (QUOTOF W Z)) 00035830 + A2 (COND ((AND (NULL *DIV) (NULL *FLOAT)) (SETQ Y (GCK1 X Y)))) 00035840 + (SETQ U (MKCANON (CONS (QUOTOF U Y) (QUOTOF W Y)))) 00035850 + (COND ((AND *GCD (ZEROP ORDN*)) (SETQ U (CANCEL U)))) 00035852 + (SETQ X (QUOTOF X Y)) 00035860 + (COND 00035870 + ((AND *ALLFAC (NULL *DIV) (NOT (EQUAL X (CAR U)))) (GO B)) 00035880 + ((NULL V) (GO D))) 00035890 + (SETQ V (EXCHK V NIL)) 00035900 + (GO C) 00035910 + D (SETQ U (PREPSQ2 U)) 00035920 + (RETURN 00035930 + (COND ((EQCAR U (QUOTE PLUS)) (CDR U)) (T (LIST U)))) 00035940 + B (COND ((AND (EQUAL X 1) (NULL V)) (GO D))) 00035950 + (SETQ U (CONS (QUOTOF (CAR U) X) (CDR U))) 00035960 + (SETQ V (PREPF (MKKL V X))) 00035970 + (COND ((EQUAL U (CONS 1 1)) (RETURN V)) 00035980 + ((EQCAR V (QUOTE TIMES)) (SETQ V (CDR V))) 00035990 + (T (SETQ V (LIST V)))) 00036000 + C (RETURN (LIST (RETIMES (ACONC V (PREPSQ2 U)))))))) 00036010 + 00036020 +(CKRN* (LAMBDA (U V) 00036030 + (COND ((NULL U) (ERRACH (QUOTE CKRN*))) 00036040 + ((ATOM U) 1) 00036050 + ((MEMBER (CAAAR U) V) 00036060 + (LIST (CONS (CAAR U) (CKRN* (CDARX U) V)))) 00036070 + (T (CKRN* (CDARX U) V))))) 00036080 + 00036090 +(UP (LAMBDA (U) 00036100 + (FACTOR1 U T (QUOTE UPL*)))) 00036110 + 00036120 +(DOWN (LAMBDA (U) 00036130 + (FACTOR1 U T (QUOTE DNL*)))) 00036140 + 00036150 +)) 00036160 + 00036170 +DEFLIST (((UP RLIS) (DOWN RLIS)) STAT) 00036180 + 00036190 +DEFINE (( 00036200 + 00036210 +(REPLUS (LAMBDA (U) 00036220 + (COND ((ATOM U) U) 00036230 + ((NULL (CDR U)) (CAR U)) 00036240 + (T (CONS (QUOTE PLUS) U))))) 00036250 + 00036260 +(RETIMES (LAMBDA (U) 00036270 + (PROG (X Y) 00036275 + A (COND ((NULL U) (GO D)) 00036280 + ((NOT (EQCAR (CAR U) (QUOTE MINUS))) (GO B))) 00036285 + (SETQ X (NOT X)) 00036290 + (COND ((EQUAL (CADAR U) 1) (GO C)) 00036295 + (T (SETQ U (CONS (CADAR U) (CDR U))))) 00036300 + B (SETQ Y (CONS (CAR U) Y)) 00036305 + C (SETQ U (CDR U)) 00036310 + (GO A) 00036315 + D (SETQ Y (COND ((NULL Y) 1) 00036320 + ((CDR Y) (CONS (QUOTE TIMES) (REVERSE Y))) 00036325 + (T (CAR Y)))) 00036330 + (RETURN (COND (X (LIST (QUOTE MINUS) Y)) (T Y)))))) 00036335 + 00036350 +(PREPSQ2 (LAMBDA (U) 00036360 + (SQFORM U (FUNCTION PREPF)))) 00036370 + 00036380 +(PREPF (LAMBDA (U) 00036390 + (PROG (X) 00036395 + (COND ((AND (MINUSF U) (SETQ X T)) (SETQ U (MULTN -1 U)))) 00036400 + (SETQ U (REPLUS (PREPF1 U NIL))) 00036405 + (RETURN (COND (X (LIST (QUOTE MINUS) U)) (T U)))))) 00036410 + 00036415 +(PREPF1 (LAMBDA (U V) 00036420 + (COND ((NULL U) NIL) 00036430 + ((NUMB U) 00036440 + (LIST (RETIMES (NUMCONS (MINUSCHK U) (EXCHK V NIL))))) 00036450 + (T 00036460 + (NCONC (PREPF1 (CDAR U) (CONS (CAAR U) V)) 00036470 + (PREPF1 (CDR U) V)))))) 00036480 + 00036490 +(NUMB (LAMBDA (U) 00036500 + (OR (NUMBERP U) (EQCAR U (QUOTE QUOTIENT))))) 00036510 + 00036520 +(NUMCONS (LAMBDA (N V) 00036530 + (COND ((NULL V) (LIST N)) ((EQUAL N 1) V) (T (CONS N V))))) 00036540 + 00036550 +(KERNLOP (LAMBDA (U) 00036560 + (OR (NUMB U) (AND (NULL (CDR U)) (KERNLOP (CDAR U)))))) 00036570 + 00036580 +(EXCHK (LAMBDA (U V) 00036590 + (COND ((NULL U) V) 00036600 + ((ONEP (CDAR U)) (EXCHK (CDR U) (CONS (SQCHK (CAAR U)) V))) 00036610 + (T 00036620 + (EXCHK (CDR U) 00036630 + (CONS (LIST (QUOTE EXPT) (SQCHK (CAAR U)) (CDAR U)) 00036640 + V)))))) 00036650 + 00036660 +(SQCHK (LAMBDA (U) 00036670 + (COND ((ATOM U) ((LAMBDA (X) 00036675 + (COND (X X) (T U))) (GET U (QUOTE NEWNAME)))) 00036680 + ((EQ (CAR U) (QUOTE *SQ)) (PREPSQ (CADR U))) 00036685 + ((AND (EQ (CAR U) (QUOTE EXPT)) (EQUAL (CADDR U) 1)) 00036690 + (CADR U)) 00036695 + ((ATOM (CAR U)) U) 00036700 + (T (PREPF U))))) 00036710 + 00036720 +(MINUSCHK (LAMBDA (U) 00036730 + (COND 00036740 + ((ATOM U) 00036750 + (COND ((MINUSP U) (LIST (QUOTE MINUS) (MINUS U))) (T U))) 00036760 + ((MINUSP (CADR U)) 00036770 + (LIST (QUOTE MINUS) 00036780 + (LIST (QUOTE QUOTIENT) (MINUS (CADR U)) (CADDR U)))) 00036790 + (T U)))) 00036800 + 00036810 +(MKFR (LAMBDA (U V) 00036820 + (COND (*FLOAT (QUOTIENT (PLUS 0.0 U) V)) 00036830 + (T 00036840 + ((LAMBDA(M) 00036850 + ((LAMBDA(N1 N2) 00036860 + (COND ((ONEP N2) N1) 00036870 + (T (LIST (QUOTE QUOTIENT) N1 N2)))) 00036880 + (QUOTIENT U M) 00036890 + (QUOTIENT V M))) 00036900 + (GCDN U V)))))) 00036910 + 00036920 +)) 00036930 + 00036940 +DEFLIST (((*SQ SQPRINT)) SPECPRN) 00036950 + 00036960 +DEFINE (( 00036970 + 00036980 +(SQPRINT (LAMBDA (U) 00036990 + (PROG (Z) 00037000 + (SETQ Z ORIG*) 00037010 + (COND ((LESSP POSN* 20) (SETQ ORIG* POSN*))) 00037020 + (MAPRIN 00037030 + (SETQ *OUTP 00037040 + (COND ((NULL (CAAR U)) 0) (T (PREPSQ (CAR U)))))) 00037050 + (SETQ ORIG* Z)))) 00037060 + 00037070 +(VARPRI (LAMBDA (U V W) 00037080 + (PROG NIL 00037090 + (COND ((NULL V) (RETURN NIL)) 00037100 + (*FORT (GO D)) 00037110 + ((AND (EQUAL V 0) U *NERO) (GO C))) 00037120 + (COND ((NULL W) (TERPRI*))) 00037130 + (COND ((EQCAR V (QUOTE MAT)) (GO M)) ((NULL U) (GO A))) 00037140 + (INPRINT (QUOTE SETQ) (GET (QUOTE SETQ) (QUOTE INFIX)) U) 00037150 + (OPRIN (QUOTE SETQ)) 00037160 + A (MAPRIN V) 00037170 + (COND (W (GO C)) 00037180 + ((AND (NULL *NAT) (NULL *FORT)) (PRINC* **DOLLAR))) 00037190 + C (RETURN V) 00037210 + D (SETQ COUNT* 1) 00037220 + (COND ((AND (ATOM V) (NOT (NUMBERP V))) (GO A))) 00037221 + (SETQ FORTVAR* (QUOTE ANS)) 00037230 + (COND ((OR (NULL U) (NOT (ATOM (CAR U)))) (GO E))) 00037240 + (SETQ FORTVAR* (CAR U)) 00037250 +E (COND ((GREATERP POSN* 5) (GO A))) 00037260 + (SPACES 6) 00037265 + (PRINC FORTVAR*) 00037270 + (OPRIN (QUOTE EQUAL)) 00037280 + (SETQ POSN* (PLUS 7 (LENGTH (EXPLODE FORTVAR*)))) 00037281 + (GO A) 00037290 + M (MATPRI (CDR V) (COND (U (CAR U)) (T NIL))) 00037300 + (GO C)))) 00037310 + 00037320 +)) 00037330 + 00037340 +DEFINE (( 00037350 + 00037360 +(SIMPDF (LAMBDA (U) 00037370 + (PROG (V X Y N) 00037380 + (COND ((NULL SUBFG*) (RETURN (MKSQ (CONS (QUOTE DF) U) 1)))) 00037390 + (SETQ V (CDR U)) 00037400 + (SETQ U (SIMPCAR U)) 00037410 + A (COND ((OR (NULL V) (NULL (CAR U))) (RETURN U))) 00037420 + (SETQ X (COND ((NULL Y) (SIMP (CAR V))) (T Y))) 00037430 + (SETQ Y NIL) 00037440 + (COND 00037450 + ((OR (NULL (KERNP X)) (NOT (ONEP (CDAAAR X)))) (GO E)) 00037460 + ((OR (NULL (CDR V)) 00037470 + (NOT 00037480 + (NUMBERP 00037490 + (SETQ N (PREPSQ (SETQ Y (SIMP (CADR V)))))))) 00037500 + (GO C1))) 00037510 + (SETQ Y NIL) 00037520 + (SETQ V (CDR V)) 00037530 + (SETQ X (CAAAAR X)) 00037540 + C (COND ((ZEROP N) (GO D))) 00037550 + (SETQ U (DIFF1 U X)) 00037560 + (SETQ N (SUB1 N)) 00037570 + (GO C) 00037580 + C1 (SETQ U (DIFF1 U (CAAAAR X))) 00037590 + D (SETQ V (CDR V)) 00037600 + (GO A) 00037610 + E (MESPRI (QUOTE (DIFFERENTIATION WITH RESPECT TO)) 00037620 + (CAR V) 00037630 + (QUOTE (NOT ALLOWED)) 00037640 + NIL 00037650 + T) 00037660 + (ERROR*)))) 00037670 + 00037680 +(DIFF1 (LAMBDA (U V) 00037690 + (PROG (W X Y Z Z1) 00037700 + (COND 00037710 + ((KERNP (CONS (CDR U) 1)) (SETQ W (CONS (CAAADR U) 1)))) 00037720 + (SETQ X (DIFF2 (CAR U) V)) 00037730 + (SETQ Y 00037740 + (COND ((NULL W) (DIFF2 (CDR U) V)) 00037750 + (T (DIFFK (LIST (CONS W 1)) V)))) 00037760 + (SETQ Z 00037770 + (COND ((NULL (CAR X)) (CONS NIL 1)) 00037780 + (T (CONS (CAR X) (MULTF (CDR X) (CDR U)))))) 00037790 + (COND ((NULL (CAR Y)) (RETURN Z))) 00037800 + (SETQ Z1 00037810 + (NEGSQ 00037820 + (MULTSQ Y 00037830 + (COND ((NULL W) 00037840 + (CONS (CAR U) (NMULTF (CDR U) 2))) 00037850 + (T 00037860 + (CONS (MULTN (CDAADR U) (CAR U)) 00037870 + (MULTF2 W (CDR U)))))))) 00037880 + (RETURN 00037890 + (COND 00037900 + ((AND *EXP *MCD) 00037910 + (CANCEL 00037920 + (CONS (ADDF (MULTF (CAR X) 00037930 + (COND 00037940 + ((NULL W) (MULTF (CDR U) (CDR Y))) 00037950 + (T (MULTF2 W (CDR Y))))) 00037960 + (MULTF (CDR X) (CAR Z1))) 00037970 + (MULTF (CDR X) (CDR Z1))))) 00037980 + (T (ADDSQ Z Z1))))))) 00037990 + 00038000 +(DIFF2 (LAMBDA (U V) 00038010 + (COND ((ATOM U) (CONS NIL 1)) 00038020 + (T 00038030 + (ADDSQ (DIFF2 (CDR U) V) 00038040 + (ADDSQ (MULTS2 (CAAR U) (DIFF2 (CDAR U) V)) 00038050 + (DIFFK U V))))))) 00038060 + 00038070 +(DIFFK (LAMBDA (U *S*) 00038080 + (PROG (V W X Y Z) 00038090 + (SETQ X (CAAR U)) 00038100 + (COND 00038110 + ((AND (EQ (CAR X) *S*) (SETQ X (CONS 1 1))) (GO D)) 00038120 + ((OR (ATOM (CAR X)) 00038130 + (AND (ATOM (CAAR X)) (GET (CAAR X) (QUOTE **ARRAY)))) 00038140 + (RETURN (COND ((AND (SETQ Z (FKERN (CAR X))) 00038150 + (ASSOC (QUOTE REP) (CDDR Z))) 00038151 + (MKSQ (LIST (QUOTE DF) (CAR X) *S*) 1)) 00038152 + (T (CONS NIL 1)))))) 00038153 + (SETQ Y (FKERN (CAR X))) 00038160 + (COND 00038170 + ((AND (SETQ V (ASSOC (QUOTE DFN) (CDDR Y))) 00038180 + (SETQ V (ASSOC *S* (CADR V))) 00038190 + (SETQ X (CDR V))) 00038200 + (GO D)) 00038210 + ((OR (AND (NOT (ATOM (CAAR X))) 00038220 + (SETQ X (NMULTSQ (DIFF2 (CAR X) *S*) (CDR X)))) 00038230 + (AND (EQ (CAAR X) (QUOTE *SQ)) 00038240 + (SETQ X (DIFF1 (CADAR X) *S*)))) 00038250 + (GO B)) 00038260 + ((OR (NOT (SETQ V (GET* (CAAR X) (QUOTE DFN)))) 00038270 + (NOT 00038280 + (DFP (SETQ W 00038290 + (MAPCAR (CDAR X) 00038300 + (FUNCTION 00038310 + (LAMBDA(J) 00038320 + (DIFF1 (SIMP J) *S*))))) 00038330 + V))) 00038340 + (GO H))) 00038350 + (SETQ Z (CDAR X)) 00038360 + (SETQ X (CONS NIL 1)) 00038370 + (COND 00038380 + ((NULL 00038390 + (*EVAL 00038400 + (CONS (QUOTE OR) 00038410 + (MAPCAR W 00038420 + (FUNCTION 00038430 + (LAMBDA(J) 00038440 + (LIST (QUOTE QUOTE) (CAR J)))))))) 00038450 + (GO B))) 00038460 + A (COND ((NULL W) (GO B)) 00038470 + ((CAAR W) 00038480 + (SETQ X 00038490 + (ADDSQ (MULTSQ (CAR W) 00038500 + (SIMP 00038510 + (SUBLIS 00038520 + (PAIR (CAAR V) Z) 00038530 + (CDAR V)))) 00038540 + X)))) 00038550 + (SETQ W (CDR W)) 00038560 + (SETQ V (CDR V)) 00038570 + (GO A) 00038580 + B (COND 00038590 + ((SETQ V (ASSOC (QUOTE DFN) (CDDR Y))) (GO C)) 00038600 + (T (ACONC Y (SETQ V (LIST (QUOTE DFN) NIL))))) 00038610 + (SETQ DSUBL* (CONS (CDR V) DSUBL*)) 00038620 + C (RPLACA (CDR V) (XADD (CONS *S* X) (CADR V) NIL T)) 00038630 + (COND ((NULL (CAR X)) (RETURN X))) 00038640 + D (SETQ U (CAR U)) 00038650 + (SETQ W 00038660 + (COND ((ONEP (CDAR U)) (CDR U)) 00038670 + (T 00038680 + (MULTF2 (GETPOWER (COND (Y Y) 00038690 + (T (FKERN (CAAR U)))) 00038700 + (SUB1 (CDAR U))) 00038710 + (MULTN (CDAR U) (CDR U)))))) 00038720 + (RETURN (CONS (MULTF (CAR X) W) (CDR X))) 00038730 + H (SETQ V 00038740 + (COND 00038750 + ((EQ (CAAR X) (QUOTE DF)) 00038760 + (CONS (CAAR X) (CONS (CADAR X) 00038765 + (ORDAD *S* (CDDAR X))))) 00038770 + (T (LIST (QUOTE DF) (CAR X) *S*)))) 00038780 + (SETQ X 00038790 + (COND ((SETQ W (OPMTCH V)) (SIMP W)) (T (MKSQ V 1)))) 00038800 + (GO B)))) 00038810 + 00038820 +(DFP (LAMBDA (U V) 00038830 + (COND ((NULL U) (NULL V)) 00038840 + ((NULL V) NIL) 00038850 + ((CAAR U) (AND (CAR V) (DFP (CDR U) (CDR V)))) 00038860 + (T (DFP (CDR U) (CDR V)))))) 00038870 + 00038880 +)) 00038890 + 00038900 +DEFINE (( 00038910 + 00038920 +(GCDN (LAMBDA (P Q) 00038930 + (GCDN0 (ABS P) (ABS Q)))) 00038940 + 00038950 +(GCDN0 (LAMBDA (P Q) 00038960 + (COND ((EQUAL P Q) P) 00038970 + (*FLOAT (COND ((GREATERP P Q) Q) (T P))) 00038980 + ((GREATERP Q P) (GCDN1 Q P)) 00038990 + (T (GCDN1 P Q))))) 00039000 + 00039010 +(GCDN1 (LAMBDA (P Q) 00039020 + ((LAMBDA (X) (COND ((ZEROP X) Q) (T (GCDN1 Q X)))) 00039030 + (REMAINDER P Q)))) 00039040 + 00039050 +)) 00039060 + 00039070 +DEFINE (( 00039080 + 00039090 +(QUOTF (LAMBDA (P Q) 00039100 + (COND ((NULL P) NIL) 00039110 + ((EQUAL P Q) 1) 00039120 + ((EQUAL Q 1) P) 00039130 + ((ATOM Q) 00039140 + (COND 00039150 + ((ATOM P) 00039160 + (COND (*FLOAT (TIMES P (RECIP (PLUS 0.0 Q)))) 00039165 + (T ((LAMBDA (Z) 00039170 + (COND ((ZEROP (CDR Z)) (CAR Z)) 00039180 + (T NIL))) 00039200 + (DIVIDE P Q))))) 00039210 + (T (QUOTK (CAAR P) P Q)))) 00039220 + ((ATOM P) NIL) 00039230 + (T 00039240 + ((LAMBDA(X Y) 00039250 + (COND 00039260 + ((EQ (CAR X) (CAR Y)) 00039270 + ((LAMBDA(N) 00039280 + (COND 00039290 + ((NOT (MINUSP N)) 00039300 + ((LAMBDA(W) 00039310 + (COND 00039320 + (W 00039330 + ((LAMBDA(V Y) 00039340 + (COND ((NULL Y) V) 00039350 + (T 00039360 + ((LAMBDA(Z) 00039370 + (COND (Z (APPEND V Z)) (T NIL))) 00039380 + (QUOTF Y Q))))) 00039390 + (COND ((ZEROP N) W) 00039400 + (T (LIST (CONS (MKSP (CAR X) N) W)))) 00039410 + (ADDF P 00039420 + (MULTF 00039430 + (COND ((ZEROP N) Q) 00039440 + (T (MULTF2 (MKSP (CAR X) N) Q))) 00039450 + (MULTN -1 W))))) 00039460 + (T NIL))) 00039470 + (QUOTF (CDAR P) (CDAR Q)))) 00039480 + (T NIL))) 00039490 + (DIFFERENCE (CDR X) (CDR Y)))) 00039500 + ((ORDP X Y) (QUOTK X P Q)) 00039510 + (T NIL))) 00039520 + (CAAR P) 00039530 + (CAAR Q)))))) 00039540 + 00039550 +(QUOTK (LAMBDA (X P Q) 00039560 + ((LAMBDA(W) 00039570 + (COND (W 00039580 + (COND ((NULL (CDR P)) (LIST (CONS X W))) 00039590 + (T 00039600 + ((LAMBDA(Y) 00039610 + (COND (Y (CONS (CONS X W) Y)) (T NIL))) 00039620 + (QUOTF (CDR P) Q))))) 00039630 + (T NIL))) 00039640 + (QUOTF (CDAR P) Q)))) 00039650 + 00039660 +)) 00039670 + 00039680 +DEFINE (( 00039690 + 00039700 +(ABSONE (LAMBDA (U) 00039710 + (AND (NUMBERP U) (ONEP (ABS U))))) 00039720 + 00039730 +(CDARX (LAMBDA (U) 00039740 + (COND ((NULL (CDR U)) (CDAR U)) 00039750 + (T (ERRACH (LIST (QUOTE CDARX) U)))))) 00039760 + 00039770 +)) 00039780 + 00039790 +DEFINE (( 00039800 + 00039810 +(PRMCON (LAMBDA (P) 00039820 + (PROG (X Y Q) 00039830 + (SETQ Q P) 00039840 + (COND ((ATOM P) (ERRACH (LIST (QUOTE PRMCON) P))) 00039850 + ((AND (NULL (CDR P)) (SETQ X (CAR P))) (GO B))) 00039860 + (SETQ Y (CAAAR P)) 00039870 + A (COND 00039880 + ((OR (AND (OR (ATOM Q) (NOT (EQ (CAAAR Q) Y))) 00039890 + (SETQ X (CONS 1 (GCD (REVERSE (CONS Q X)))))) 00039900 + (AND (NULL (CDR Q)) 00039910 + (SETQ X 00039920 + (CONS (CAAR Q) (GCD (CONS (CDAR Q) X)))))) 00039930 + (GO B))) 00039940 + (SETQ X (CONS (CDAR Q) X)) 00039950 + (SETQ Q (CDR Q)) 00039960 + (GO A) 00039970 + B (RETURN 00039980 + (CONS (QUOTF P 00039990 + (COND ((ATOM (CAR X)) (CDR X)) (T (LIST X)))) 00040000 + X))))) 00040010 + 00040020 +(GCD (LAMBDA (L) 00040030 + (COND ((NULL (CDR L)) (CAR L)) 00040040 + ((MEMBER 1 L) 1) 00040050 + (T (GCD (CONS (GCD1 (CAR L) (CADR L)) (CDDR L))))))) 00040060 + 00040070 +(GCD1 (LAMBDA (U V) 00040080 + (COND 00040090 + ((OR (NULL U) (NULL V)) (ERRACH (LIST (QUOTE GCD1) U V))) 00040100 + ((EQUAL U V) U) 00040110 + ((ATOM U) 00040120 + (COND ((ATOM V) (GCDN U V)) 00040130 + (T (GCD (NCONS (CDR V) (LIST U (CDAR V))))))) 00040140 + ((ATOM V) (GCD (NCONS (CDR U) (LIST V (CDAR U))))) 00040150 + (T 00040160 + ((LAMBDA(X Y) 00040170 + (COND ((EQ X Y) 00040180 + (PROG (N W X1 Y1 Z Z1 Z2 Z3) 00040190 + (SETQ X1 (PRMCON U)) 00040200 + (SETQ Y1 (PRMCON V)) 00040210 + (SETQ W 1) 00040220 + (SETQ Z1 (CAR X1)) 00040230 + (SETQ Z2 (CAR Y1)) 00040240 + (COND 00040250 + ((OR (NULL *GCD) (ABSONE Z1) (ABSONE Z2)) 00040260 + (GO A)) 00040270 + ((OR (ATOM Z1) (ATOM Z2)) 00040280 + (ERRACH (LIST (QUOTE GCDK) U V X1 Y1))) 00040290 + ((EQ (CAAAR Z1) (CAAAR Z2)) (GO C))) 00040300 + A (SETQ W (MULTF W (GCD1 (CDDR X1) (CDDR Y1)))) 00040310 + (RETURN 00040320 + (COND 00040330 + ((OR (ATOM (CADR X1)) (ATOM (CADR Y1))) W) 00040340 + ((ORDP (CADR X1) (CADR Y1)) 00040350 + (MULTF2 (CADR Y1) W)) 00040360 + (T (MULTF2 (CADR X1) W)))) 00040370 + C (COND ((ORDP Z1 Z2) (GO D))) 00040380 + (SETQ Z Z1) 00040390 + D1 (SETQ Z1 Z2) 00040400 + (SETQ Z2 Z) 00040410 + D (SETQ Z (REMK Z1 Z2)) 00040420 + (COND (Z (GO G))) 00040430 + (SETQ W (CAR (PRMCON Z2))) 00040440 + (GO A) 00040450 + G (COND ((NULL N) (GO H))) 00040460 + (SETQ Z (QUOTF Z (NMULTF Z3 N))) 00040470 + (COND 00040480 + ((NULL Z) 00040490 + (REDERR 00040500 + (LIST (QUOTE (INTEGER OVERFLOW)) Z3 N)))) 00040510 + H (SETQ N 00040520 + (ADD1 (DIFFERENCE (CDAAR Z1) (CDAAR Z2)))) 00040530 + (SETQ Z3 (CDAR Z2)) 00040540 + (COND 00040550 + ((OR (ATOM Z) 00040560 + (NULL (CDR Z)) 00040570 + (NOT (EQ (CAAAR Z) (CAAAR Z1)))) 00040580 + (GO A))) 00040590 + (GO D1))) 00040600 + ((ORDP X Y) (GCD (CONS V (COEFF U X)))) 00040610 + (T (GCD (CONS U (COEFF V Y)))))) 00040620 + (CAAAR U) 00040630 + (CAAAR V)))))) 00040640 + 00040650 +(COEFF (LAMBDA (U A) 00040660 + (COND ((NULL U) NIL) 00040670 + ((OR (ATOM U) (NOT (EQ (CAAAR U) A))) (LIST U)) 00040680 + (T (CONS (CDAR U) (COEFF (CDR U) A)))))) 00040690 + 00040700 +(REMK (LAMBDA (U V) 00040710 + (REMK1 U V (CAAR V) NIL))) 00040720 + 00040730 +(REMK1 (LAMBDA (U V W Z) 00040740 + (COND 00040750 + ((AND (NOT (ATOM U)) (ORDP (CAAR U) W)) 00040760 + (REMK1 (ADDF (MULTF (CDAR V) U) 00040770 + ((LAMBDA(M X) 00040780 + (COND ((ZEROP M) (MULTN -1 X)) 00040790 + (T 00040800 + (MULTF 00040810 + (LIST (CONS (MKSP (CAAAR U) M) -1)) 00040820 + X)))) 00040830 + (DIFFERENCE (CDAAR U) (CDR W)) 00040840 + (MULTF (CDAR U) V))) 00040850 + V 00040860 + W 00040870 + (MULTF Z (CDAR V)))) 00040880 + ((NULL Z) U) 00040890 + (T (CANCEL (CONS U Z)))))) 00040900 + 00040910 +(REMK* (LAMBDA (U V) 00040920 + (REMK1 U V (CAAR V) 1))) 00040930 + 00040940 +(NMULTF (LAMBDA (U N) 00040950 + (COND ((OR *EXP (KERNLP U)) (NMULTF1 U N)) (T (MKSFP U N))))) 00040960 + 00040970 +(NMULTF1 (LAMBDA (U N) 00040980 + (COND ((ONEP N) U) (T (MULTF U (NMULTF1 U (SUB1 N))))))) 00040990 + 00041000 +)) 00041010 + 00041020 +DEFINE (( 00041030 + 00041040 +(OPERATOR (LAMBDA (U) 00041050 + (PROG NIL 00041060 + (COND 00041070 + ((EQ *MODE (QUOTE SYMBOLIC)) 00041080 + (RETURN (FLAG U (QUOTE OPFN))))) 00041090 + A (COND ((NULL U) (RETURN NIL)) 00041100 + ((OR (NUMBERP (CAR U)) (NOT (ATOM (CAR U)))) 00041110 + (LPRIM* 00041120 + (CONS (CAR U) (QUOTE (CANNOT BE AN OPERATOR))))) 00041130 + ((GET (CAR U) (QUOTE SIMPFN)) 00041140 + (LPRIM* (CONS (CAR U) (QUOTE (ALREADY DEFINED))))) 00041150 + (T (MKOP (CAR U)))) 00041160 + (SETQ U (CDR U)) 00041170 + (GO A)))) 00041180 + 00041190 +(FACTOR (LAMBDA (U) 00041200 + (FACTOR1 U T (QUOTE FACTORS*)))) 00041210 + 00041220 +(FACTOR1 (LAMBDA (U V W) 00041230 + (PROG (X Y) 00041240 + (SETQ Y (GTS W)) 00041250 + A (COND ((NULL U) (GO B)) 00041260 + ((OR (KERNP (SETQ X (SIMPCAR U))) 00041270 + (AND *SUPER (KERNP (SETQ X (MKSFP X 1))))) 00041280 + (GO C)) 00041290 + (T (ERRPRI2 (CAR U)))) 00041300 + (GO D) 00041310 + C (SETQ X (CAAAAR X)) 00041320 + (COND (V (SETQ Y (CONS X Y))) 00041330 + ((NOT (MEMBER X Y)) 00041340 + (MESPRI NIL (CAR U) (QUOTE (NOT FOUND)) NIL NIL)) 00041350 + (T (SETQ Y (DELETE X Y)))) 00041360 + D (SETQ U (CDR U)) 00041370 + (GO A) 00041375 + B (PTS W Y)))) 00041380 + 00041390 +(REMFAC (LAMBDA (U) 00041400 + (FACTOR1 U NIL (QUOTE FACTORS*)))) 00041410 + 00041420 +)) 00041430 + 00041440 +DEFINE (( 00041450 + 00041460 +(FORALLFN* (LAMBDA NIL 00041470 + (FORALLFN (RVLIS)))) 00041480 + 00041490 +(FORALLFN (LAMBDA (U) 00041500 + (PROG (X Y) 00041510 + (SETQ X (MAPCAR U (FUNCTION NEWVAR))) 00041520 + (SETQ Y (PAIR U X)) 00041530 + (SETQ MCOND* (SUBLIS Y MCOND*)) 00041540 + (SETQ FRLIS* (UNION X FRLIS*)) 00041550 + (SETQ X (LIST (COMMAND1 NIL))) 00041560 + (COND (MCOND* (SETQ X (CONS (LIST (QUOTE SETQ) 00041570 + (QUOTE MCOND*) (LIST (QUOTE QUOTE) MCOND*)) X)))) 00041580 + (COND (Y (SETQ X (CONS (LIST (QUOTE SETQ) (QUOTE FRASC*) 00041590 + (LIST (QUOTE QUOTE) Y)) X)))) 00041592 + (RETURN (MKPROG NIL X))))) 00041594 + 00041600 +)) 00041610 + 00041620 +DEFINE (( 00041630 + 00041640 +(LET (LAMBDA (U) 00041650 + (LET0 U NIL))) 00041660 + 00041670 +(LET0 (LAMBDA (U V) 00041680 + (PROG NIL 00041690 + A (COND ((NULL U) (RETURN (SETQ MCOND* (SETQ FRASC* NIL)))) 00041700 + ((OR (NOT (EQCAR (CAR U) (QUOTE EQUAL))) (CDDDAR U)) 00041710 + (ERRPRI2 (CAR U)))) 00041720 + (LET2 (CADAR U) (CAR (CDDAR U)) V T) 00041730 + (SETQ U (CDR U)) 00041740 + (GO A)))) 00041750 + 00041760 +(LET1 (LAMBDA (U V) 00041770 + (LET2 U V NIL T))) 00041780 + 00041790 +(LET2 (LAMBDA (U V W B) 00041800 + (PROG (X Y Z) 00041810 + (SETQ U (SUBLIS FRASC* U)) 00041812 + (SETQ V (SUBLIS FRASC* V)) 00041814 + (COND ((AND FRASC* (EQCAR V (QUOTE *SQ))) 00041816 + (SETQ V (PREPSQ (CADR V))))) 00041818 + A (SETQ X U) 00041820 + (COND ((NUMBERP X) (GO LER1)) 00041840 + ((NOT (ATOM X)) (GO D)) 00041850 + ((AND (SETQ Y (GET X (QUOTE OLDNAME))) 00041860 + (NOT (MEMBER Y (FLATTEN V)))) (LET2 Y V W B))) 00041870 + (COND (B (GO A2))) 00041880 + (REMPROP X (QUOTE NEWNAME)) 00041890 + (REMPROP X (QUOTE OLDNAME)) 00041900 + A2 (COND 00041950 + ((AND (VECTORP X) (VLET X V B)) (RETURN NIL)) 00041960 + ((AND (NULL B) (GET X (QUOTE **ARRAY))) (GO J2)) 00041970 + (W (GO H)) 00041980 + ((MATEXPR V) (GO J))) 00041990 + B1 (SETQ X (SIMP0 X)) 00042000 + C (SETQ X (CAAAR X)) 00042010 + (SETQ Z (FKERN (CAR X))) 00042020 + (COND ((NULL B) (RETURN (RPLACD (CDR Z) NIL))) 00042025 + ((ASSOC (QUOTE USED*) (CDR Z)) (RMSUBS2))) 00042030 + (XADD 00042040 + (COND 00042050 + ((AND (EQUAL V 0) (NOT (EQUAL (CDR X) 1))) 00042060 + (CONS (QUOTE ASYMP) (CDR X))) 00042070 + (T (LIST (QUOTE REP) V (CDR X) NIL))) 00042080 + (CDR Z) 00042090 + (SQCHK (CAR Z)) 00042100 + T) 00042110 + (RPLACW Z (DELASC (QUOTE DFN) Z)) 00042120 + (RETURN NIL) 00042130 + D (COND ((NOT (ATOM (CAR X))) (GO LER2)) 00042140 + ((GET* (CAR X) (QUOTE **ARRAY)) (GO L)) 00042150 + ((EQ (CAR X) (QUOTE DF)) (GO K)) 00042160 + ((NOT (GET* (CAR X) (QUOTE SIMPFN))) (GO LER3)) 00042180 + ((OR W 00042190 + (EQ (CAR X) (QUOTE TIMES)) 00042200 + (XN (FLATTEN (CDR X)) FRLIS*)) 00042210 + (GO H))) 00042220 + (SETQ X (SIMP0 X)) 00042230 + (COND ((NOT (EQUAL (CDR X) 1)) (GO LER1))) 00042240 + E (COND ((NOT (KERNP X)) (GO G)) 00042250 + ((NOT (ONEP (CDAAR X))) 00042260 + (SETQ V (LIST (QUOTE QUOTIENT) V (CDAAR X))))) 00042270 + (GO C) 00042280 + G (COND ((NOT (KERNLP (CAR X))) (GO M))) 00042290 + (SETQ X U) 00042300 + H (RMSUBS) 00042305 + (COND 00042310 + ((OR (NULL 00042320 + (SETQ Y 00042330 + (KERNLP 00042340 + (CAR (SETQ X (SIMP0 X)))))) 00042350 + (NOT (ATOM (CDR X)))) 00042360 + (GO LER2)) 00042370 + ((AND (ONEP Y) (ONEP (CDR X))) (GO H1))) 00042380 + (SETQ V (LIST (QUOTE TIMES) (CDR X) V)) 00042390 + (COND 00042400 + ((NOT (ONEP Y)) 00042410 + (SETQ V (ACONC V (LIST (QUOTE QUOTIENT) 1 Y))))) 00042420 + H1 (SETQ X (KLISTT (CAR X))) 00042430 + (SETQ Y 00042440 + (LIST (CONS W (COND (MCOND* MCOND*) (T T))) 00042450 + V 00042460 + NIL)) 00042470 + (COND 00042480 + ((AND (NULL W) (NULL (CDR X)) (ONEP (CDAR X))) (GO H2))) 00042490 + (RETURN (SETQ MATCH* (XADD (CONS X Y) MATCH* U B))) 00042500 + H2 (SETQ X (CAAR X)) 00042510 + (COND ((NOT (MATEXPR V)) (GO H3)) 00042511 + ((NOT (REDMSG (CAR X) (QUOTE MATRIX) T)) (ERROR*))) 00042512 + (FLAG (LIST (CAR X)) (QUOTE MATFN)) 00042513 + H3 (RETURN (PUT (CAR X) 00042514 + (QUOTE OPMTCH*) 00042530 + (XADD (CONS (CDR X) Y) 00042540 + (GET (CAR X) (QUOTE OPMTCH*)) 00042550 + U B))) 00042560 + J (SETQ MATP* T) 00042590 + (COND ((GET X (QUOTE MATRIX)) (GO J1)) 00042600 + ((NOT (REDMSG X (QUOTE MATRIX) T)) (ERROR*))) 00042610 + (PUT X (QUOTE MATRIX) (QUOTE MATRIX)) 00042620 + J1 (COND ((EQCAR V (QUOTE MAT)) (RETURN (SETM X V))) 00042630 + (T (GO B1))) 00042640 + J2 (REMPROP X (QUOTE MATRIX)) 00042650 + (REMPROP X (QUOTE **ARRAY)) 00042660 + (RETURN NIL) 00042670 + K (COND 00042680 + ((AND (NOT (ATOMLIS (CADR X))) (CDDDR X)) (GO LER1)) 00042690 + ((AND (NOT (GET* (CAADR X) (QUOTE SIMPFN))) 00042700 + (SETQ X (CADR X))) 00042710 + (GO LER3)) 00042720 + ((OR (NOT (FRLP (CDADR X))) 00042730 + (NOT (FRLP (CDDR X))) 00042740 + (NOT (MEMBER (CADDR X) (CDADR X)))) 00042750 + (GO H))) 00042760 + (SETQ Z (POSN (CADDR X) (CDADR X))) 00042770 + (COND 00042780 + ((NOT (GET (CAADR X) (QUOTE DFN))) 00042790 + (PUT (CAADR X) 00042800 + (QUOTE DFN) 00042810 + (NLIST NIL (LENGTH (CDADR X)))))) 00042820 + (COND 00042830 + ((NULL (REPN (GET (CAADR X) (QUOTE DFN)) Z V X)) 00042840 + (GO LER1))) 00042850 + (RETURN NIL) 00042860 + L (COND ((AND (SETQ Z (ASSOC* X (GET (CAR X) (QUOTE KLIST)))) 00042865 + (ASSOC (QUOTE USED*) (CDR Z))) (RMSUBS2))) 00042870 + (SETEL (CONS (CAR X) (MAPCAR (CDR X) (FUNCTION 00042875 + REVAL))) V) 00042880 + (RETURN NIL) 00042890 + M (COND ((NULL *SUPER) (GO LER1))) 00042900 + (SETQ X (CONS (MKSFP (CAR X) 1) 1)) 00042910 + (GO E) 00042920 + LER1 (ERRPRI2 U) 00042930 + (ERROR*) 00042940 + LER2 (ERRPRI1 U) 00042950 + (ERROR*) 00042960 + LER3 (COND ((NOT (REDMSG (CAR X) (QUOTE OPERATOR) T)) (ERROR*))) 00042970 + (MKOP (CAR X)) 00042980 + (GO A)))) 00042990 + 00043000 +(FRLP (LAMBDA (U) 00043010 + (OR (NULL U) (AND (MEMBER (CAR U) FRLIS*) (FRLP (CDR U)))))) 00043020 + 00043030 +(SIMP0 (LAMBDA (U) 00043040 + (PROG (X) 00043050 + (SETQ SUBFG* NIL) 00043060 + (SETQ X (SIMP U)) 00043070 + (SETQ SUBFG* T) 00043080 + (RETURN X)))) 00043090 + 00043100 +(MATCH (LAMBDA (U) 00043220 + (LET0 U T))) 00043230 + 00043240 +(CLEAR (LAMBDA (U) 00043250 + (PROG NIL 00043260 + (RMSUBS) 00043270 + A (COND ((NULL U) (RETURN (SETQ MCOND* (SETQ FRASC* NIL))))) 00043280 + B (LET2 (CAR U) NIL NIL NIL) 00043330 + (SETQ U (CDR U)) 00043340 + (GO A)))) 00043350 + 00043360 +(KLISTT (LAMBDA (U) 00043370 + (COND ((ATOM U) NIL) (T (CONS (CAAR U) (KLISTT (CDARX U))))))) 00043380 + 00043390 +)) 00043400 + 00043410 +PTS (NOCMP* T) 00043411 + 00043412 +DEFINE (( 00043420 + 00043430 +(KERNP (LAMBDA (U) 00043440 + (AND (ATOM (CDR U)) 00043450 + (NOT (ATOM (CAR U))) 00043460 + (NULL (CDAR U)) 00043470 + (ATOM (CDAAR U))))) 00043480 + 00043490 +(KERNLP (LAMBDA (U) 00043500 + (COND ((ATOM U) U) ((NULL (CDR U)) (KERNLP (CDAR U))) (T NIL)))) 00043510 + 00043520 +(RMSUBS (LAMBDA NIL 00043530 + (PROG2 (RMSUBS1) (RMSUBS2)))) 00043531 + 00043532 +(RMSUBS2 (LAMBDA NIL 00043533 + (PROG2 (RPLACA *SQVAR* NIL) (SETQ *SQVAR* (LIST T))))) 00043534 + 00043550 +(RMSUBS1 (LAMBDA NIL 00043560 + (PROG NIL 00043570 + (MAP (APPEND DSUBL* SUBL*) 00043580 + (FUNCTION (LAMBDA (J) (RPLACA (CAR J) NIL)))) 00043590 + (SETQ SUBL* NIL)))) 00043600 + 00043610 +(XADD (LAMBDA (U V W B) 00043620 + (PROG (X) 00043630 + (SETQ X (ASSOC* (CAR U) V)) 00043640 + (COND ((NULL X) (GO C)) ((NULL B) (GO B1))) 00043650 + (RMSUBS1) 00043660 + (RPLACD X (CDR U)) 00043670 + A (RETURN V) 00043680 + B1 (SETQ V (DELETE X V)) 00043690 + (GO A) 00043700 + C (COND ((NULL B) (MESPRI NIL W (QUOTE (NOT FOUND)) NIL NIL)) 00043710 + (T (SETQ V (NCONC V (LIST U))))) 00043720 + (GO A)))) 00043730 + 00043740 +(REPN (LAMBDA (U N V W) 00043750 + (PROG NIL 00043760 + A (COND ((OR (NULL U) (ZEROP N)) (RETURN NIL)) 00043770 + ((NOT (ONEP N)) (GO B)) 00043780 + ((CAR U) (REDEFPRI W))) 00043790 + (RETURN (RPLACA U (CONS (CDADR W) V))) 00043800 + B (SETQ U (CDR U)) 00043810 + (SETQ N (SUB1 N)) 00043820 + (GO A)))) 00043830 + 00043840 +(DENOM (LAMBDA (U) 00043850 + (LET1 U (MK*SQ (CONS (CDR (SIMP *ANS)) 1))))) 00043860 + 00043870 +(NUMER (LAMBDA (U) 00043880 + (LET1 U (MK*SQ (CONS (CAR (SIMP *ANS)) 1))))) 00043890 + 00043900 +(ND (LAMBDA (U V) 00043910 + (PROG2 (NUMER U) (DENOM V)))) 00043920 + 00043930 +(SAVEAS (LAMBDA (U) 00043940 + (SETK U *ANS))) 00043950 + 00043960 +(SETK (LAMBDA (U V) 00043970 + (PROG2 (LET1 U 00043980 + (COND 00043990 + ((AND(NOT (ATOM U))(NOT (ATOM V))(XN (CDR U) FRLIS*)) 00044000 + (PREPSQ (CADR V))) 00044010 + (T V))) 00044020 + V))) 00044030 + 00044040 +(TERMS (LAMBDA NIL 00044050 + (PRINTTY 00044060 + (COND 00044070 + ((EQCAR *ANS (QUOTE *SQ)) (TERMS1 (CAADR *ANS))) 00044080 + (T (SCNT *ANS)))))) 00044090 + 00044100 +(TERMS1 (LAMBDA (U) 00044110 + (PROG (N) 00044120 + (SETQ N 0) 00044130 + A (COND ((NULL U) (RETURN N)) ((ATOM U) (RETURN (ADD1 N)))) 00044140 + (SETQ N (PLUS N (TERMS1 (CDAR U)))) 00044150 + (SETQ U (CDR U)) 00044160 + (GO A)))) 00044170 + 00044180 +)) 00044190 + 00044200 +DEFINE (( 00044210 + 00044220 +(ANTISYMMETRIC (LAMBDA (U) 00044230 + (FLAG U (QUOTE ANTISYMMETRIC)))) 00044240 + 00044250 +(SYMMETRIC (LAMBDA (U) 00044260 + (FLAG U (QUOTE SYMMETRIC)))) 00044270 + 00044280 +)) 00044290 + 00044300 +FLAG ((PLUS TIMES CONS) SYMMETRIC) 00044310 + 00044320 +FLAG ((PLUS TIMES) NARY) 00044321 + 00044322 +DEFINE (( 00044330 + 00044340 +(MKCOEFF (LAMBDA (U V) 00044350 + (PROG (W X Y Z) 00044360 + (COND ((NOT (ATOM U)) (SETQ U (REVAL U)))) 00044370 + (SETQ X FACTORS*) 00044380 + (SETQ FACTORS* (LIST U)) 00044390 + (SETQ W 00044400 + (COND 00044410 + ((EQCAR *ANS (QUOTE *SQ)) (CADR *ANS)) 00044420 + (T (SIMP *ANS)))) 00044430 + (SETQ Y (CONS (FORMOP (CAR W)) (FORMOP (CDR W)))) 00044440 + (COND 00044450 + ((NULL (EQUAL (CDR Y) 1)) 00044460 + (LPRIM* (QUOTE (MKCOEFF GIVEN RATIONAL FUNCTION))))) 00044470 + (SETQ W (CDR Y)) 00044480 + (SETQ Y (CAR Y)) 00044490 + A (COND ((OR (ATOM Y) (NOT (EQUAL (CAAAR Y) U))) (GO B))) 00044500 + (SETQ Z 00044510 + (CONS (CONS (CDAAR Y) 00044520 + (PREPSQ (CANCEL (CONS (CDAR Y) W)))) 00044530 + Z)) 00044540 + (SETQ Y (CDR Y)) 00044550 + (GO A) 00044560 + B (COND ((NULL Y) (GO B1))) 00044570 + (SETQ Z (CONS (CONS 0 (PREPSQ (CANCEL (CONS Y W)))) Z)) 00044580 + B1 (COND 00044590 + ((OR (AND (NOT (ATOM V)) (ATOM (CAR V)) 00044595 + (SETQ Y (GET* (CAR V) (QUOTE **ARRAY)))) 00044600 + (AND (ATOM V) 00044605 + (SETQ Y (GET* V (QUOTE **ARRAY))) 00044610 + (NULL (CDR Y)))) 00044615 + (GO G))) 00044630 + (SETQ Y (EXPLODE V)) 00044640 + (SETQ V NIL) 00044650 + C (COND ((NULL Z) (GO D))) 00044660 + (SETQ V 00044670 + (CONS (LIST (QUOTE EQUAL) 00044680 + (COMPRESS (APPEND Y (EXPLODE (CAAR Z)))) 00044690 + (CDAR Z)) 00044700 + V)) 00044710 + (SETQ Z (CDR Z)) 00044720 + (GO C) 00044730 + D (*APPLY (QUOTE LET) (LIST V)) 00044740 + (COND 00044760 + (*MSG 00044770 + (LPRI 00044780 + (NCONC (MAPLIST V (FUNCTION CADAR)) 00044790 + (QUOTE (ARE NON ZERO)))))) 00044800 + E (SETQ FACTORS* X) 00044805 + (RETURN NIL) 00044810 + G (SETQ Z (REVERSE Z)) 00044815 + (COND ((ATOM V) (SETQ V (LIST V (QUOTE *))))) 00044820 + (COND 00044840 + (*MSG 00044850 + (LPRI 00044860 + (APPEND (QUOTE (HIGHEST POWER IS)) (LIST (CAAR Z)))))) 00044870 + (SETQ Y (PAIR (CDR V) Y)) 00044871 + G0 (COND ((AND (MEMBER (QUOTE *) (FLATTEN (CAAR Y))) 00044872 + (SETQ Y (PLUS (CDAR Y) (MINUS (REVAL 00044873 + (SUBST 0 (QUOTE *) (CAAR Y))))))) (GO G1))) 00044874 + (SETQ Y (CDR Y)) 00044875 + (GO G0) 00044876 + G1 (COND 00044877 + ((GREATERP (CAAR Z) Y) (REDERR (QUOTE (ARRAY TOO SMALL))))) 00044890 + H (COND 00044900 + ((OR (NULL Z) (NOT (EQUAL Y (CAAR Z)))) 00044910 + (SETEL (SUBST Y (QUOTE *) V) 0)) 00044915 + (T (PROG2 (SETEL (SUBST Y (QUOTE *) V) (CDAR Z)) 00044920 + (SETQ Z (CDR Z))))) 00044925 + (COND ((ZEROP Y) (GO E))) 00044930 + (SETQ Y (SUB1 Y)) 00044950 + (GO H)))) 00044960 + 00044970 +)) 00044980 + 00044990 + 00045000 +DEFINE (( 00045010 + 00045020 +(WEIGHT (LAMBDA (U) 00045030 + (PROG (X Y) 00045040 + (RMSUBS) 00045050 + A (COND ((NULL U) (RETURN NIL)) 00045060 + ((OR (NOT (EQ (CAAR U) (QUOTE EQUAL))) 00045070 + (NOT (AND (ATOM (CADAR U)) 00045075 + (NOT (NUMBERP (CADAR U))))) 00045080 + (NOT 00045090 + (AND (NUMBERP (CADDAR U)) 00045100 + (FIXP (CADDAR U)) 00045110 + (NOT (MINUSP (CADDAR U)))))) 00045115 + (ERRPRI1 (CAR U)))) 00045120 + (SETQ Y (CADAR U)) 00045125 + (COND ((SETQ X (GET Y (QUOTE OLDNAME))) (GO C))) 00045130 + (SETQ X (NEWVAR Y)) 00045135 + (PUT Y (QUOTE NEWNAME) X) 00045140 + (PUT X (QUOTE OLDNAME) Y) 00045145 + (FLAG (LIST X) (QUOTE WEIGHT)) 00045150 + B (LET2 X 00045155 + (LIST (QUOTE TIMES) 00045160 + Y 00045165 + (LIST (QUOTE EXPT) (QUOTE K*) (CADDAR U))) 00045170 + NIL 00045175 + T) 00045180 + (SETQ U (CDR U)) 00045185 + (GO A) 00045190 + C (COND ((NOT (FLAGP Y (QUOTE WEIGHT))) (ERRPRI1 (CAR U)))) 00045195 + (SETQ Y X) 00045200 + (SETQ X (CADAR U)) 00045205 + (GO B)))) 00045210 + 00045215 +(WTLEVEL (LAMBDA (N) 00045220 + (PROG (X) 00045225 + (SETQ N (REVAL N)) 00045230 + (COND 00045235 + ((NOT (AND (NUMBERP N) (FIXP N) (NOT (MINUSP N)))) 00045240 + (ERRPRI1 N))) 00045245 + (SETQ X (ASSOC (QUOTE ASYMP) (CDDR (FKERN (QUOTE K*))))) 00045250 + (COND ((EQUAL N (CDR X)) (RETURN NIL)) 00045255 + ((NOT (GREATERP N (CDR X))) (RMSUBS2))) 00045260 + (RMSUBS1) 00045265 + (RPLACD X N)))) 00045270 + 00045300 +)) 00045310 + 00045320 +PTS (NOCMP* NIL) 00045321 + 00045322 +DEFLIST (((WEIGHT RLIS) (WTLEVEL NORLIS)) STAT) 00045330 + 00045340 +LET1 ((EXPT K* 2) 0) 00045350 + 00045360 +COMMENT ((ELEMENTARY FUNCTION PROPERTIES)) 00045370 + 00045380 +DEFLIST (((LOG IDEN) (COS IDEN) (SIN IDEN)) SIMPFN) 00045390 + 00045400 +DEFLIST (( 00045410 + (LOG (((LOG E) (((LOG E) . 1)) (REP 1 1 NIL)) 00045420 + ((LOG 1) (((LOG 1) . 1)) (REP 0 1 NIL)))) 00045430 + (COS (((COS 0) (((COS 0) . 1)) (REP 1 1 NIL)))) 00045440 + (SIN (((SIN 0) (((SIN 0) . 1)) (REP 0 1 NIL)))) 00045450 +) KLIST) 00045460 + 00045470 +DEFLIST (( 00045480 + (EXPT (((X Y) TIMES Y (EXPT X (PLUS Y (MINUS 1)))) 00045490 + ((X Y) TIMES (LOG X) (EXPT X Y)))) 00045500 +(LOG (((X) QUOTIENT 1 X))) 00045510 +(COS (((X) MINUS (SIN X)))) 00045520 +(SIN (((X) COS X))) 00045530 +) DFN) 00045540 + 00045550 +DEFLIST (( 00045560 + (COS ((((MINUS ***X)) (NIL . T) (COS ***X) NIL))) 00045570 + (SIN ((((MINUS ***X)) (NIL . T) (MINUS (SIN ***X)) NIL))) 00045580 +) OPMTCH*) 00045590 + 00045600 +PTS (FRLIS* (***X)) 00045610 + 00045620 +DEFINE (( 00045630 + 00045640 +(MSIMP (LAMBDA (U V) 00045650 + (PROG (X Y Z) 00045660 + (COND ((AND (NULL V) SUBFG*) (SETQ U (SUBLIS VREP* U)))) 00045670 + (SETQ U (MSIMP1 U V)) 00045680 + A1 (COND ((NULL U) (RETURN Z))) 00045690 + A0 (SETQ X (CAR U)) 00045700 + A (COND ((AND V (NULL X)) (GO D)) 00045710 + ((NULL X) (GO NULLU)) 00045720 + ((OR (AND (NULL V) (VECTORP (CAR X))) 00045730 + (AND V (MATP (CAR X)))) 00045740 + (GO B))) 00045750 + BACK (SETQ X (CDR X)) 00045760 + (GO A) 00045770 + B (SETQ Y (LIST (CAR X))) 00045780 + (SETQ X (CDR X)) 00045790 + C (COND ((NULL X) (GO D)) 00045800 + ((AND (NULL V) (VECTORP (CAR X))) 00045810 + (REDERR 00045820 + (APPEND (QUOTE (REDUNDANT VECTOR)) (LIST (CAR U))))) 00045830 + ((AND V (MATP (CAR X))) (SETQ Y (ACONC Y (CAR X))))) 00045840 + (SETQ X (CDR X)) 00045850 + (GO C) 00045860 + D (SETQ X (SETDIFF (CAR U) Y)) 00045870 + (SETQ Z 00045880 + (ADDM1 (CONS (COND ((NULL X) (CONS 1 1)) 00045890 + (T (SIMPTIMES X))) 00045900 + (REVERSE Y)) 00045910 + Z)) 00045920 + (SETQ U (CDR U)) 00045930 + (GO A1) 00045940 + E (VECTOR (LIST (CAAR U))) 00045950 + (GO A0) 00045960 + NULLU 00045970 + (COND 00045980 + ((AND (ATOM (CAAR U)) 00045990 + (NOT (NUMBERP (CAAR U))) 00046000 + (REDMSG (CAAR U) (QUOTE VECTOR) T)) 00046010 + (GO E)) 00046020 + (T 00046030 + (REDERR 00046040 + (APPEND (QUOTE (MISSING VECTOR)) (LIST (CAR U)))))) 00046050 + (GO BACK)))) 00046060 + 00046070 +(MSIMP1 (LAMBDA (U1 *S*) ((LAMBDA (U) 00046080 + (COND ((NUMBERP U) (LIST (LIST U))) 00046090 + ((ATOM U) 00046100 + ((LAMBDA(X) 00046110 + (COND ((AND X SUBFG* (EQUAL (CADDR X) 1)) 00046115 + (MSIMP1 (CADR X) *S*)) 00046120 + (T 00046130 + (PROG2 00046140 + (COND ((NULL *S*) (FLAG (LIST U) (QUOTE USED*))) 00046150 + (T NIL)) 00046160 + (LIST (LIST U)))))) 00046170 + (ASSOC (QUOTE REP) (CDDR (FKERN U))))) 00046180 + ((EQ (CAR U) (QUOTE PLUS)) 00046190 + (MAPCON (CDR U) 00046200 + (FUNCTION (LAMBDA (J) (MSIMP1 (CAR J) *S*))))) 00046210 + ((EQ (CAR U) (QUOTE MINUS)) 00046220 + (MSIMPTIMES (LIST -1 (CARX (CDR U))) *S*)) 00046230 + ((EQ (CAR U) (QUOTE TIMES)) (MSIMPTIMES (CDR U) *S*)) 00046240 + ((EQ (CAR U) (QUOTE QUOTIENT)) 00046241 + (MSIMPTIMES (LIST (CADR U) 00046242 + (LIST (QUOTE RECIP) (CARX (CDDR U)))) 00046243 + *S*)) 00046244 + ((OR (NULL *S*) (EQCAR U (QUOTE MAT)) (NOT (MATEXPR U))) 00046250 + (LIST (LIST U))) 00046260 + ((EQ (CAR U) (QUOTE RECIP)) (MSIMPRS (CARX (CDR U)) NIL)) 00046270 + ((EQ (CAR U) (QUOTE SOLVE)) 00046280 + (MSIMPRS (CADR U) (MATSIMP (MSIMP (CADDR U) T)))) 00046290 + (T 00046340 + ((LAMBDA(Z) 00046350 + (COND 00046360 + ((OR (NOT (EQ (CAR U) (QUOTE EXPT))) 00046370 + (NOT (NUMBERP Z)) 00046380 + (NOT (FIXP Z))) 00046390 + (REDERR (QUOTE (MATRIX SYNTAX)))) 00046400 + ((MINUSP Z) 00046410 + (MSIMPRS 00046420 + (CONS (QUOTE TIMES) (NLIST (CADR U) (MINUS Z))) NIL)) 00046430 + (T (MSIMPTIMES (NLIST (CADR U) Z) T)))) 00046440 + ((LAMBDA(Y) 00046450 + (COND 00046460 + ((AND (EQCAR Y (QUOTE MINUS)) (NUMBERP (CADR Y))) 00046470 + (MINUS (CADR Y))) 00046480 + (T Y))) 00046490 + (REVAL (CADDR U))))))) (EMTCH U1)))) 00046500 + 00046510 +(MSIMPTIMES (LAMBDA (U V) 00046520 + (COND ((NULL U) (ERRACH (QUOTE MSIMPTIMES))) 00046530 + ((NULL (CDR U)) (MSIMP1 (CAR U) V)) 00046540 + (T 00046550 + ((LAMBDA(*S*) 00046560 + (MAPCON (MSIMPTIMES (CDR U) V) 00046570 + (FUNCTION 00046580 + (LAMBDA(*S1*) 00046590 + (MAPCAR *S* 00046600 + (FUNCTION 00046610 + (LAMBDA(K) 00046620 + (APPEND (CAR *S1*) K)))))))) 00046630 + (MSIMP1 (CAR U) V)))))) 00046640 + 00046650 +(ADDM1 (LAMBDA (U V) 00046660 + (COND ((NULL V) (LIST U)) 00046670 + ((EQUAL (CDR U) (CDAR V)) 00046680 + ((LAMBDA(X) 00046690 + (COND ((NULL (CAR X)) (CDR V)) 00046700 + (T (CONS (CONS X (CDR U)) (CDR V))))) 00046710 + (ADDSQ (CAR U) (CAAR V)))) 00046720 + ((ORDP (CDR U) (CDAR V)) (CONS U V)) 00046730 + (T (CONS (CAR V) (ADDM1 U (CDR V))))))) 00046740 + 00046750 +)) 00046760 + 00046770 +DEFINE (( 00046780 + 00046790 +(MATP (LAMBDA (U) 00046800 + (COND ((ATOM U) (FLAGP** U (QUOTE MATRIX))) 00046810 + (T (EQCAR U (QUOTE MAT)))))) 00046820 + 00046830 +(MATEXPR (LAMBDA (U) 00046840 + (AND MATP* (MATEXPR1 U)))) 00046850 + 00046860 +(MATEXPR1 (LAMBDA (U) 00046870 + (COND ((NULL U) NIL) 00046880 + ((ATOM U) (MATP U)) 00046890 + ((MEMBER (CAR U) (QUOTE (*SQ DET TRACE))) NIL) 00046900 + ((OR (FLAGP** (CAR U) (QUOTE MATFN)) (MATEXPR1 (CADR U))) T) 00046910 + (T 00046920 + (*EVAL 00046930 + (CONS (QUOTE OR) (MAPCAR (CDR U) (FUNCTION MATEXPR1)))))))) 00046940 + 00046950 +)) 00046960 + 00046970 +FLAG ((MAT) MATFN) 00046971 + 00046972 +DEFINE (( 00046980 + 00046990 +(MATSM (LAMBDA (U) 00047000 + ((LAMBDA(X) 00047010 + (COND 00047020 + ((AND (NULL (CDR X)) (NULL (CDAR X))) (SIMP (CAAR X))) 00047030 + (T (CONS (QUOTE MAT) X)))) 00047040 + (MAPC2 (MATSIMP (MSIMP U T)) 00047050 + (FUNCTION (LAMBDA (J) (MK*SQ (SUBS2 J)))))))) 00047060 + 00047070 +)) 00047080 + 00047090 +DEFINE (( 00047100 + 00047110 +(MATSIMP (LAMBDA (U) 00047120 + (PROG (X) 00047130 + (SETQ X (SMMULT (CAAR U) (MMULT (CDAR U)))) 00047140 + A (SETQ U (CDR U)) 00047150 + (COND ((NULL U) (RETURN X))) 00047160 + (SETQ X (MADD X (SMMULT (CAAR U) (MMULT (CDAR U))))) 00047170 + (GO A)))) 00047180 + 00047190 +(MMULT (LAMBDA (U) 00047200 + (PROG (Y Z) 00047210 + (SETQ Y (GETM* (CAR U))) 00047220 + A (SETQ U (CDR U)) 00047230 + (COND ((NULL U) (RETURN Y))) 00047240 + (SETQ Z (GETM* (CAR U))) 00047250 + (COND 00047260 + ((NOT (EQUAL (LENGTH (CAR Y)) (LENGTH Z))) 00047270 + (REDERR (QUOTE (MATRIX MISMATCH))))) 00047280 + (SETQ Y (MULTM Y Z)) 00047290 + (GO A)))) 00047300 + 00047310 +(SMMULT (LAMBDA (*S* V) 00047320 + (COND ((EQUAL *S* (CONS 1 1)) V) 00047330 + (T (MAPC2 V (FUNCTION (LAMBDA (J) (MULTSQ *S* J)))))))) 00047340 + 00047350 +(GETM* (LAMBDA (U) 00047360 + (COND ((EQCAR U (QUOTE MAT)) (SIMPDET* (CDR U))) 00047370 + (T 00047380 + ((LAMBDA(X) 00047390 + (COND 00047400 + ((OR (NULL X) (EQ X (QUOTE MATRIX))) 00047410 + (REDERR 00047420 + (CONS (QUOTE MATRIX) (CONS U (QUOTE (NOT SET)))))) 00047430 + (T (MLIST U (CAR X) (CADR X))))) 00047440 + (COND ((ATOM U) (GET U (QUOTE MATRIX))) (T NIL))))))) 00047450 + 00047460 +(MLIST (LAMBDA (U M N) 00047470 + (PROG (M1 N1 X Y Z) 00047480 + (SETQ M1 M) 00047490 + A (SETQ Y NIL) 00047500 + (SETQ N1 N) 00047510 + B (COND 00047520 + ((NULL (SETQ X (GETEL (LIST U M1 N1)))) 00047530 + (REDERR (CONS U (CONS (LIST M1 N1) (QUOTE (NOT SET))))))) 00047540 + (SETQ Y (CONS (SIMP X) Y)) 00047550 + (SETQ N1 (SUB1 N1)) 00047560 + (COND ((NOT (ZEROP N1)) (GO B))) 00047570 + (SETQ Z (CONS Y Z)) 00047580 + (SETQ M1 (SUB1 M1)) 00047590 + (COND ((ZEROP M1) (RETURN Z))) 00047600 + (GO A)))) 00047610 + 00047620 +)) 00047630 + 00047640 +DEFINE (( 00047650 + 00047660 +(MADD (LAMBDA (U V) 00047670 + (MAPCAR (PAIR U V) 00047680 + (FUNCTION (LAMBDA (J) (MADD1 (CAR J) (CDR J))))))) 00047690 + 00047700 +(MADD1 (LAMBDA (U V) 00047710 + (COND ((NULL U) NIL) 00047720 + (T (CONS (ADDSQ (CAR U) (CAR V)) (MADD1 (CDR U) (CDR V))))))) 00047730 + 00047740 +)) 00047750 + 00047760 +DEFLIST (((MATRIX RLIS)) STAT) 00047770 + 00047780 +DEFINE (( 00047790 + 00047800 +(MATRIX (LAMBDA (U) 00047810 + (PROG NIL 00047820 + (SETQ MATP* T) 00047830 + A (COND ((NULL U) (RETURN NIL)) 00047840 + ((ATOM (CAR U)) 00047850 + (PUT (CAR U) 00047860 + (QUOTE MATRIX) 00047870 + ((LAMBDA (X) (COND (X X) (T (QUOTE MATRIX)))) 00047880 + (GET* (CAR U) (QUOTE **ARRAY))))) 00047890 + (T 00047900 + (PROG2 (*APPLY (QUOTE AARRAY) (LIST (LIST (CAR U)))) 00047910 + (PUT (CAAR U) (QUOTE MATRIX) 00047915 + (MAPCAR (CDAR U) (FUNCTION REVAL)))))) 00047920 + (SETQ U (CDR U)) 00047930 + (GO A)))) 00047940 + 00047950 +)) 00047960 + 00047970 +DEFINE (( 00047980 + 00047990 +(MULTM (LAMBDA (U *S*) 00048000 + (MAPCAR U 00048010 + (FUNCTION 00048020 + (LAMBDA (J) (MULTM1 J *S* (LENGTH (CAR *S*)) NIL)))))) 00048030 + 00048040 +(MULTM1 (LAMBDA (U V N W) 00048050 + (COND ((ZEROP N) W) 00048060 + (T (MULTM1 U V (SUB1 N) (CONS (MELEM U V N) W)))))) 00048070 + 00048080 +(MELEM (LAMBDA (U V N) 00048090 + (COND ((NULL U) (CONS NIL 1)) 00048100 + (T 00048110 + ((LAMBDA (X) (COND ((NULL (CAR X)) (CONS NIL 1)) (T X))) 00048120 + (ADDSQ (MULTSQ (CAR U) (NTH (CAR V) N)) 00048130 + (MELEM (CDR U) (CDR V) N))))))) 00048140 + 00048150 +)) 00048160 + 00048170 +DEFINE (( 00048180 + 00048190 +(MATPRI (LAMBDA (U X) 00048200 + (PROG (V M N) 00048210 + (SETQ M 1) 00048220 + (COND ((NULL X) (SETQ X (QUOTE MAT)))) 00048230 + A (COND ((NULL U) (RETURN NIL))) 00048240 + (SETQ N 1) 00048250 + (SETQ V (CAR U)) 00048260 + B (COND ((NULL V) (GO C)) 00048270 + ((AND (EQUAL (CAR V) 0) *NERO) (GO B1))) 00048280 + (MAPRIN (LIST X M N)) 00048290 + (OPRIN (QUOTE EQUAL)) 00048350 + (SETQ ORIG* POSN*) 00048360 + (MATHPRINT (CAR V)) 00048370 + (SETQ ORIG* 0) 00048380 + (TERPRI*) 00048390 + B1 (SETQ V (CDR V)) 00048400 + (SETQ N (ADD1 N)) 00048410 + (GO B) 00048420 + C (SETQ U (CDR U)) 00048430 + (SETQ M (ADD1 M)) 00048440 + (GO A)))) 00048450 + 00048460 +)) 00048470 + 00048480 +DEFINE (( 00048490 + 00048500 +(SETM (LAMBDA (U V) 00048510 + (PROG (N M X Y) 00048520 + (SETQ V (CDR V)) 00048530 + (SETQ Y (LIST (LENGTH V) (LENGTH (CAR V)))) 00048540 + (COND 00048550 + ((NOT (EQ (SETQ X (GET U (QUOTE MATRIX))) (QUOTE MATRIX))) 00048560 + (GO A))) 00048570 + (*APPLY (QUOTE AARRAY) (LIST (LIST (CONS U Y)))) 00048580 + (PUT U (QUOTE MATRIX) Y) 00048590 + (GO A1) 00048600 + A (COND 00048610 + ((NOT (EQUAL X Y)) (REDERR (QUOTE (MATRIX MISMATCH))))) 00048620 + A1 (SETQ M 1) 00048630 + B (SETQ Y (CAR V)) 00048640 + (SETQ N 1) 00048650 + C (COND ((NULL Y) (GO D))) 00048660 + (SETEL (LIST U M N) (CAR Y)) 00048670 + (SETQ N (ADD1 N)) 00048680 + (SETQ Y (CDR Y)) 00048690 + (GO C) 00048700 + D (SETQ V (CDR V)) 00048710 + (COND ((NULL V) (RETURN NIL))) 00048720 + (SETQ M (ADD1 M)) 00048730 + (GO B)))) 00048740 + 00048750 +)) 00048760 + 00048770 +DEFINE (( 00048780 + 00048790 +(MSIMPRS (LAMBDA (U V) 00048800 + ((LAMBDA(X) 00048810 + (LIST 00048820 + (LIST 00048830 + (CONS (QUOTE MAT) 00048840 + (MAPC2 00048850 + (COND 00048860 + ((AND (NULL (CDR X)) (NULL V)) 00048870 + (SMMULT (REVPR (CAAR X)) 00048880 + (*MATINV (MMULT (CDAR X)) NIL))) 00048890 + (T (*MATINV (MATSIMP X) V))) 00048900 + (FUNCTION MK*SQ)))))) 00048910 + (MSIMP U T)))) 00048920 + 00048930 +)) 00048940 + 00048950 +DEFINE (( 00048960 + 00048970 +(AUGMENT (LAMBDA (U V) 00048980 + (COND ((NULL U) NIL) 00048990 + (T 00049000 + (CONS (APPEND (CAR U) (CAR V)) (AUGMENT (CDR U) (CDR V)))))) 00049010 +) 00049020 + 00049030 +)) 00049040 + 00049050 +DEFINE (( 00049060 + 00049070 +(SETMATELEM (LAMBDA (U I J ELEM) 00049080 + (PROG (A) 00049090 + (SETQ A (NTH U I)) 00049100 + LOOP (COND ((EQUAL J 1) (RETURN (RPLACA A ELEM)))) 00049110 + (SETQ J (SUB1 J)) 00049120 + (SETQ A (CDR A)) 00049130 + (GO LOOP)))) 00049140 + 00049150 +)) 00049160 + 00049170 +DEFINE (( 00049180 + 00049190 +(LIPSON (LAMBDA (U M N V) 00049200 + (PROG (AA AA1 K K1 K2 I J TEMP BB C0 CI1 CI2 AAK) 00049210 + (SETQ AA (CONS 1 1)) 00049220 + (SETQ K 2) 00049230 + BEG (SETQ K1 (SUB1 K)) 00049240 + (SETQ K2 (SUB1 K1)) 00049250 + (COND ((GREATERP K M) (GO FB)) ((EQUAL K 2) (GO PIVOT))) 00049260 + (SETQ AA (REVPR (NTH (NTH U K2) K2))) 00049270 + PIVOT 00049280 + (SETQ AA1 (NTH (NTH U K1) K1)) 00049290 + (COND ((NULL (EQUAL AA1 (CONS NIL 1))) (GO L2))) 00049300 + (SETQ I K) 00049310 + L (COND ((GREATERP I M) (GO SING)) 00049320 + ((EQUAL (NTH (NTH U I) K1) (CONS NIL 1)) (GO L1))) 00049330 + (SETQ J K1) 00049340 + L0 (COND ((GREATERP J N) (GO PL2))) 00049350 + (SETQ TEMP (NTH (NTH U I) J)) 00049360 + (SETMATELEM U I J (NEGSQ (NTH (NTH U K1) J))) 00049370 + (SETMATELEM U K1 J TEMP) 00049380 + (SETQ J (ADD1 J)) 00049390 + (GO L0) 00049400 + L1 (SETQ I (ADD1 I)) 00049410 + (GO L) 00049420 + PL2 (SETQ AA1 (NTH (NTH U K1) K1)) 00049430 + L2 (SETQ I K) 00049440 + L2A (COND ((GREATERP I M) (GO SING))) 00049450 + (SETQ BB 00049460 + (ADDSQ (MULTSQ AA1 (NTH (NTH U I) K)) 00049470 + (NEGSQ 00049480 + (MULTSQ (NTH (NTH U K1) K) 00049490 + (NTH (NTH U I) K1))))) 00049500 + (COND ((EQUAL BB (CONS NIL 1)) (GO L2B))) 00049510 + (GO L3) 00049520 + L2B (SETQ I (ADD1 I)) 00049530 + (GO L2A) 00049540 + L3 (SETQ C0 (MULTSQ BB AA)) 00049550 + (COND ((EQUAL K M) (GO EV)) ((EQUAL I K) (GO COMP))) 00049560 + (SETQ J K1) 00049570 + L3A (COND ((GREATERP J N) (GO COMP))) 00049580 + (SETQ TEMP (NTH (NTH U I) J)) 00049590 + (SETMATELEM U I J (NEGSQ (NTH (NTH U K) J))) 00049600 + (SETMATELEM U K J TEMP) 00049610 + (SETQ J (ADD1 J)) 00049620 + (GO L3A) 00049630 + COMP (SETQ I (ADD1 K)) 00049640 + (SETQ AAK (NTH (NTH U K) K)) 00049650 + COMP1 00049660 + (COND ((GREATERP I M) (GO EV))) 00049670 + (SETQ CI1 00049680 + (MULTSQ (ADDSQ (MULTSQ (NTH (NTH U K1) K) 00049690 + (NTH (NTH U I) K1)) 00049700 + (NEGSQ (MULTSQ AA1 (NTH (NTH U I) K)))) 00049710 + AA)) 00049720 + (SETQ CI2 00049730 + (MULTSQ (ADDSQ (MULTSQ (NTH (NTH U K) K1) 00049740 + (NTH (NTH U I) K)) 00049750 + (NEGSQ 00049760 + (MULTSQ AAK (NTH (NTH U I) K1)))) 00049770 + AA)) 00049780 + (SETQ J (ADD1 K)) 00049790 + COMP2 00049800 + (COND ((GREATERP J N) (GO COMP3))) 00049810 + (SETMATELEM U 00049820 + I 00049830 + J 00049840 + (MULTSQ 00049850 + (ADDSQ (MULTSQ (NTH (NTH U I) J) C0) 00049860 + (ADDSQ 00049870 + (MULTSQ (NTH (NTH U K) J) CI1) 00049880 + (MULTSQ (NTH (NTH U K1) J) CI2))) 00049890 + AA)) 00049900 + (SETQ J (ADD1 J)) 00049910 + (GO COMP2) 00049920 + COMP3 00049930 + (SETQ I (ADD1 I)) 00049940 + (GO COMP1) 00049950 + EV (SETMATELEM U K K C0) 00049960 + (SETQ J (ADD1 K)) 00049970 + EV1 (COND ((GREATERP J N) (GO BOT))) 00049980 + (SETMATELEM U 00049990 + K 00050000 + J 00050010 + (MULTSQ (ADDSQ (MULTSQ AA1 (NTH (NTH U K) J)) 00050020 + (NEGSQ 00050030 + (MULTSQ 00050040 + (NTH (NTH U K) K1) 00050050 + (NTH (NTH U K1) J)))) 00050060 + AA)) 00050070 + (SETQ J (ADD1 J)) 00050080 + (GO EV1) 00050090 + BOT (SETQ K (ADD1 (ADD1 K))) 00050100 + (GO BEG) 00050110 + FB (COND ((EQUAL (NTH (NTH U M) M) (CONS NIL 1)) (GO SING))) 00050120 + (RETURN U) 00050130 + SING (COND 00050140 + ((NULL V) 00050150 + (RETURN (PROG2 (SETMATELEM U N N (CONS NIL 1)) U)))) 00050160 + (REDERR (QUOTE (SINGULAR MATRIX)))))) 00050170 + 00050180 +)) 00050190 + 00050200 +DEFINE (( 00050210 + 00050220 +(BACKSUB (LAMBDA (U M N) 00050230 + (PROG (DET IJ I J JJ SUM) 00050240 + (SETQ DET (NTH (NTH U M) M)) 00050250 + (SETQ J (ADD1 M)) 00050260 + ROWM (COND ((GREATERP J N) (GO ROWS))) 00050270 + (SETMATELEM U 00050280 + M 00050290 + J 00050300 + (CANCEL (MULTSQ (NTH (NTH U M) J) (REVPR DET)))) 00050310 + (SETQ J (ADD1 J)) 00050320 + (GO ROWM) 00050330 + ROWS (SETQ IJ 1) 00050340 + ROWS1 00050350 + (COND ((GREATERP IJ (SUB1 M)) (GO DONE))) 00050360 + (SETQ I (DIFFERENCE M IJ)) 00050370 + (SETQ JJ (ADD1 M)) 00050380 + ROWS2 00050390 + (COND ((GREATERP JJ N) (GO ROWS5))) 00050400 + (SETQ J (ADD1 I)) 00050410 + (SETQ DET (NTH (NTH U I) I)) 00050420 + (SETQ SUM (CONS NIL 1)) 00050430 + ROWS3 00050440 + (COND ((GREATERP J M) (GO ROWS4))) 00050450 + (SETQ SUM 00050460 + (ADDSQ SUM 00050470 + (CANCEL (MULTSQ (NTH (NTH U I) J) (NTH (NTH U J) JJ))))) 00050480 + (SETQ J (ADD1 J)) 00050490 + (GO ROWS3) 00050500 + ROWS4 00050510 + (SETMATELEM U 00050520 + I 00050530 + JJ 00050540 + (CANCEL 00050550 + (MULTSQ (ADDSQ (NTH (NTH U I) JJ) (NEGSQ SUM)) 00050560 + (REVPR DET)))) 00050570 + (SETQ JJ (ADD1 JJ)) 00050580 + (GO ROWS2) 00050590 + ROWS5 00050600 + (SETQ IJ (ADD1 IJ)) 00050610 + (GO ROWS1) 00050620 + DONE (RETURN U)))) 00050630 + 00050640 +)) 00050650 + 00050660 +DEFINE (( 00050670 + 00050680 +(RHSIDE (LAMBDA (U M) 00050690 + (COND ((NULL U) NIL) 00050700 + (T (CONS (RHSIDE1 (CAR U) M) (RHSIDE (CDR U) M)))))) 00050710 + 00050720 +)) 00050730 + 00050740 +DEFINE (( 00050750 + 00050760 +(RHSIDE1 (LAMBDA (U M) 00050770 + (PROG NIL 00050780 + A (COND ((EQUAL M 0) (RETURN U))) 00050790 + (SETQ U (CDR U)) 00050800 + (SETQ M (SUB1 M)) 00050810 + (GO A)))) 00050820 + 00050830 +)) 00050840 + 00050850 +DEFINE (( 00050860 + 00050870 +(GENERATEIDENT (LAMBDA (N) 00050880 + (PROG (I K U V) 00050890 + (SETQ I 1) 00050900 + (SETQ V NIL) 00050910 + E (COND ((GREATERP I N) (GO A))) 00050920 + (SETQ U NIL) 00050930 + (SETQ K 1) 00050940 + C (COND ((GREATERP K N) (GO D)) ((EQUAL K I) (GO B))) 00050950 + (SETQ U (CONS (CONS NIL 1) U)) 00050960 + (SETQ K (ADD1 K)) 00050970 + (GO C) 00050980 + B (SETQ U (CONS (CONS 1 1) U)) 00050990 + (SETQ K (ADD1 K)) 00051000 + (GO C) 00051010 + D (SETQ I (ADD1 I)) 00051020 + (SETQ V (CONS U V)) 00051030 + (GO E) 00051040 + A (RETURN V)))) 00051050 + 00051060 +(*MATINV (LAMBDA (U V) 00051070 + (PROG (A B M N X) 00051080 + (SETQ A U) 00051090 + (SETQ X SUBFG*) 00051092 + (SETQ SUBFG* NIL) 00051094 + (SETQ M (LENGTH A)) 00051100 + (SETQ N (LENGTH (CAR A))) 00051110 + (COND 00051120 + ((NOT (EQUAL M N)) (REDERR (QUOTE (NON SQUARE MATRIX))))) 00051130 + (SETQ B (COND (V V) (T (GENERATEIDENT M)))) 00051140 + (COND 00051150 + ((AND V (NOT (EQUAL M (LENGTH B)))) 00051160 + (REDERR (QUOTE (EQUATION MISMATCH))))) 00051170 + (SETQ A (AUGMENT A B)) 00051180 + (SETQ N (LENGTH (CAR A))) 00051190 + (SETQ A (LIPSON A M N T)) 00051200 + (SETQ A (BACKSUB A M N)) 00051210 + (SETQ SUBFG* X) 00051212 + (RETURN (MAPC2 (RHSIDE A M) (FUNCTION 00051220 + (LAMBDA (J) (SIMP (PREPSQ J))))))))) 00051221 + 00051230 +)) 00051240 + 00051250 +DEFINE (( 00051260 + 00051270 +(SIMPDET (LAMBDA (U) 00051280 + (SIMPDET1 U T))) 00051290 + 00051300 +(SIMPTRACE (LAMBDA (U) 00051310 + (SIMPDET1 U NIL))) 00051320 + 00051330 +(SIMPDET1 (LAMBDA (U V) 00051340 + (PROG (N) 00051350 + (COND 00051360 + ((AND (NOT (EQCAR (CAR U) (QUOTE *COMMA*))) 00051370 + (NOT (MATEXPR (CAR U)))) 00051380 + (REDERR (QUOTE (MATRIX EXPRESSION REQUIRED))))) 00051390 + (SETQ U 00051400 + (COND 00051410 + ((EQCAR (CAR U) (QUOTE *COMMA*)) 00051420 + (MAPCAR U 00051430 + (FUNCTION 00051440 + (LAMBDA(J) 00051450 + (MAPCAR 00051460 + (COND 00051470 + ((EQCAR J (QUOTE *COMMA*)) (CDR J)) 00051480 + (T J)) 00051490 + (FUNCTION SIMP)))))) 00051500 + (T (MATSIMP (MSIMP (CARX U) T))))) 00051510 + (COND 00051520 + ((NOT (EQUAL (LENGTH U) (LENGTH (CAR U)))) 00051530 + (REDERR (QUOTE (NON SQUARE MATRIX))))) 00051540 + (COND (V (RETURN (DETQ U)))) 00051550 + (SETQ N 1) 00051560 + (SETQ V (CONS NIL 1)) 00051570 + A (COND ((NULL U) (RETURN V))) 00051580 + (SETQ V (ADDSQ (NTH (CAR U) N) V)) 00051590 + (SETQ U (CDR U)) 00051600 + (SETQ N (ADD1 N)) 00051610 + (GO A)))) 00051620 + 00051630 +(SIMPDET* (LAMBDA (U) 00051640 + (MAPC2 U (FUNCTION SIMP)))) 00051650 + 00051660 +(SIMPMAT (LAMBDA (U) 00051670 + (REDERR (QUOTE (MATRIX MISMATCH))))) 00051680 + 00051690 +)) 00051700 + 00051710 +DEFLIST (((DET SIMPDET) (TRACE SIMPTRACE) (MAT SIMPMAT)) SIMPFN) 00051720 + 00051730 +DEFINE (( 00051740 + 00051750 +(DETQ (LAMBDA (U) 00051760 + (PROG (V X) 00051770 + (SETQ X SUBFG*) 00051772 + (SETQ SUBFG* NIL) 00051774 + (SETQ V (LENGTH U)) 00051776 + (SETQ V (NTH (NTH (LIPSON U V V NIL) V) V)) 00051777 + (SETQ SUBFG* X) 00051778 + (RETURN (SIMP (PREPSQ V)))))) 00051779 + 00051780 +)) 00051790 + 00051800 +DEFLIST (((CONS SIMPDOT)) SIMPFN) 00051810 + 00051820 +FLAG ((CONS) VOP) 00051830 + 00051840 +DEFINE (( 00051870 + 00051880 +(VOP (LAMBDA (U) 00051890 + (FLAG U (QUOTE VOP)))) 00051900 + 00051910 +(VECTORP (LAMBDA (U) 00051920 + (AND (ATOM U) 00051930 + (NOT (NUMBERP U)) 00051940 + (OR (FLAGP U (QUOTE MASS)) 00051950 + (FLAGP U (QUOTE VECTOR)) 00051960 + (MEMBER U INDICES*))))) 00051970 + 00051980 +(ISIMPQ (LAMBDA (U) 00051990 + (CONS (ISIMP (CAR U)) (CDR U)))) 00052000 + 00052010 +(ISIMP (LAMBDA (U) 00052020 + (COND 00052030 + ((OR (NULL SUBFG*) 00052035 + (AND (NULL INDICES*) 00052040 + (NULL GAMIDEN*) 00052050 + (NULL (GET (QUOTE EPS) (QUOTE KLIST))))) 00052060 + U) 00052070 + (T (ISIMP1 U INDICES* NIL NIL NIL))))) 00052080 + 00052090 +(ISIMP1 (LAMBDA (U I V W X) 00052100 + (COND 00052110 + ((ATOM U) 00052120 + (COND 00052130 + ((OR V X) (REDERR (APPEND (QUOTE (UNMATCHED INDEX ERROR)) I))) 00052140 + (W (MULTF (EMULT W) (ISIMP1 U I V NIL X))) 00052150 + (T U))) 00052160 + (T 00052170 + (ADDF (ISIMP2 (CAR U) I V W X) 00052180 + (COND ((NULL (CDR U)) NIL) 00052190 + (T (ISIMP1 (CDR U) I V W X)))))))) 00052200 + 00052210 +(ISIMP2 (LAMBDA (U I V W X) 00052220 + (PROG (Z) 00052230 + (COND ((ATOM (SETQ Z (CAAR U))) (GO A)) 00052240 + ((AND (EQ (CAR Z) (QUOTE CONS)) (XN (CDR Z) I)) 00052250 + (RETURN (DOTSUM U I V W X))) 00052260 + ((EQ (CAR Z) (QUOTE G)) (RETURN (SPUR0 U I V W X))) 00052270 + ((EQ (CAR Z) (QUOTE EPS)) (RETURN (ESUM U I V W X)))) 00052280 + A (RETURN (MULTF2 (CAR U) (ISIMP1 (CDR U) I V W X)))))) 00052290 + 00052300 +(DOTSUM (LAMBDA (U I V W X) 00052310 + (PROG (I1 N U1 U2 V1 Y Z) 00052320 + (SETQ N (CDAR U)) 00052330 + (COND 00052340 + ((NOT (MEMBER (CAR (SETQ U1 (CDAAR U))) I)) 00052350 + (SETQ U1 (REVERSE U1)))) 00052360 + (SETQ U2 (CADR U1)) 00052370 + (SETQ U1 (CAR U1)) 00052380 + (SETQ V1 (CDR U)) 00052390 + (COND ((EQUAL N 2) (GO H)) ((NOT (ONEP N)) (REDERR U))) 00052400 + A (COND 00052410 + ((NOT (MEMBER U1 I)) 00052420 + (RETURN (MULTF (MKDOT U1 U2) (ISIMP1 V1 I1 V W X))))) 00052430 + A1 (SETQ I1 (DELETE U1 I)) 00052440 + (COND ((EQ U1 U2) (RETURN (MULTN 4 (ISIMP1 V1 I1 V W X)))) 00052450 + ((NOT (SETQ Z (ASSOC U1 V))) (GO C)) 00052460 + ((MEMBER U2 I) (GO D))) 00052470 + (SETQ U1 (CDR Z)) 00052480 + (GO E) 00052490 + C (COND 00052500 + ((SETQ Z (MEMLIS U1 X)) 00052510 + (RETURN 00052520 + (SPUR0 (CONS (CONS (CONS (QUOTE G) (SUBST U2 U1 Z)) 1) 00052530 + V1) 00052540 + I1 00052550 + V 00052560 + W 00052570 + (DELETE Z X)))) 00052580 + ((SETQ Z (MEMLIS U1 W)) 00052590 + (RETURN 00052600 + (ESUM (CONS (CONS (CONS (QUOTE EPS) (SUBST U2 U1 Z)) 1) 00052610 + V1) 00052620 + I1 00052630 + V 00052640 + (DELETE Z W) 00052650 + X))) 00052660 + ((AND (MEMBER U2 I) (NULL Y)) (GO G))) 00052670 + (RETURN (ISIMP1 V1 I (CONS (CONS U1 U2) V) W X)) 00052680 + D (SETQ U1 U2) 00052690 + (SETQ U2 (CDR Z)) 00052700 + E (SETQ I I1) 00052710 + (SETQ V (DELETE Z V)) 00052720 + (GO A) 00052730 + G (SETQ Y T) 00052740 + (SETQ Z U1) 00052750 + (SETQ U1 U2) 00052760 + (SETQ U2 Z) 00052770 + (GO A1) 00052780 + H (COND ((EQ U1 U2) (REDERR U))) 00052790 + (SETQ I (DELETE U1 I)) 00052800 + (SETQ U1 U2) 00052810 + (GO A)))) 00052820 + 00052830 +)) 00052840 + 00052850 +DEFINE (( 00052860 + 00052870 +(VMULT (LAMBDA (U) 00052880 + (PROG (Z) 00052890 + (SETQ U 00052900 + (REVERSE 00052910 + (MAPCAR U (FUNCTION (LAMBDA (J) (MSIMP J NIL)))))) 00052920 + A (COND ((NULL U) (RETURN Z)) 00052930 + ((NULL Z) (SETQ Z (CAR U))) 00052940 + (T (SETQ Z (VMULT1 (CAR U) Z)))) 00052950 + (SETQ U (CDR U)) 00052960 + (GO A)))) 00052970 + 00052980 +(VMULT1 (LAMBDA (U *S1*) 00052990 + (COND ((NULL *S1*) NIL) 00053000 + (T 00053010 + (MAPCON U 00053020 + (FUNCTION 00053030 + (LAMBDA(*S*) 00053040 + (MAPCAR *S1* 00053050 + (FUNCTION 00053060 + (LAMBDA(J) 00053070 + (CONS (MULTSQ (CAAR *S*) (CAR J)) 00053080 + (APPEND (CDAR *S*) 00053090 + (CDR J))))))))))))) 00053100 + 00053110 +)) 00053120 + 00053130 +DEFINE (( 00053140 + 00053150 +(SIMPDOT (LAMBDA (U) 00053160 + (COND ((CDDR U) (ERRACH (LIST (QUOTE SIMPDOT) U))) 00053170 + (T 00053180 + (MKVARG U 00053190 + (FUNCTION 00053200 + (LAMBDA(J) 00053210 + (MKSQ (CONS (QUOTE CONS) (ORD2 (CAR J) (CADR J))) 00053220 + 1)))))))) 00053230 + 00053240 +(MKVARG (LAMBDA (U *PI*) 00053250 + (PROG (Z) 00053260 + (SETQ U (VMULT U)) 00053270 + (SETQ Z (CONS NIL 1)) 00053280 + A (COND ((NULL U) (RETURN Z))) 00053290 + (SETQ Z (ADDSQ (MULTSQ (*PI* (CDAR U)) (CAAR U)) Z)) 00053300 + (SETQ U (CDR U)) 00053310 + (GO A)))) 00053320 + 00053330 +(MKDOT (LAMBDA (U V) 00053340 + (MKSF (CONS (QUOTE CONS) (ORD2 U V)) 1))) 00053350 + 00053360 +(VLET (LAMBDA (U V B) 00053370 + (PROG2 00053375 + (AND B (FLAGP U (QUOTE USED*)) (RMSUBS2)) 00053380 + (SETQ VREP* (XADD (CONS U V) VREP* U B))))) 00053385 + 00053390 +)) 00053400 + 00053410 +DEFINE (( 00053420 + 00053430 +(INDEX (LAMBDA (U) 00053440 + (SETQ INDICES* (UNION INDICES* U)))) 00053450 + 00053460 +(REMIND (LAMBDA (U) 00053470 + (PROG2 (VECTOR U) (SETQ INDICES* (SETDIFF INDICES* U))))) 00053480 + 00053490 +(MASS (LAMBDA (U) 00053500 + (COND ((NULL U) NIL) 00053510 + (T 00053520 + (PROG2 (PUT (CADAR U) (QUOTE MASS) (CADDAR U)) 00053530 + (MASS (CDR U))))))) 00053540 + 00053550 +(MSHELL (LAMBDA (U) 00053560 + (PROG (X Z) 00053570 + A (COND ((NULL U) (RETURN (LET Z)))) 00053580 + (SETQ X (GETMAS (CAR U))) 00053590 + (SETQ Z 00053600 + (CONS (LIST (QUOTE EQUAL) 00053610 + (LIST (QUOTE CONS) (CAR U) (CAR U)) 00053620 + (LIST (QUOTE TIMES) X X)) 00053630 + Z)) 00053640 + (SETQ U (CDR U)) 00053650 + (GO A)))) 00053660 + 00053670 +(GETMAS (LAMBDA (U) 00053680 + ((LAMBDA(X) 00053690 + (COND (X X) (T (REDERR (CONS U (QUOTE (HAS NO MASS))))))) 00053700 + (GET* U (QUOTE MASS))))) 00053710 + 00053720 +(VECTOR (LAMBDA (U) 00053730 + (FLAG U (QUOTE VECTOR)))) 00053740 + 00053750 +)) 00053760 + 00053770 +DEFINE (( 00053780 + 00053790 +(VCREP (LAMBDA (U) 00053800 + ((LAMBDA(X) 00053810 + (COND 00053820 + ((AND SUBFG* (NOT (EQUAL X (CAR U)))) 00053830 + (NCONC U (LIST (LIST (QUOTE REP) X 1 NIL NIL)))) 00053840 + (T NIL))) 00053850 + (SUBLIS VREP* (CAR U))))) 00053860 + 00053870 +)) 00053880 + 00053890 +DEFLIST (((MSHELL RLIS) (MASS RLIS) (INDEX RLIS) (REMIND RLIS) (VECTOR 00053900 + RLIS) (VOP RLIS)) STAT) 00053910 + 00053920 +FLAG ((EPS) VOP) 00053950 + 00053960 +DEFLIST (((G SIMPGAMMA) (EPS SIMPEPS)) SIMPFN) 00053970 + 00053980 +FLAG ((G) NONCOM) 00053990 + 00054000 +DEFLIST (((G GMULT)) MRULE) 00054010 + 00054020 +DEFINE (( 00054030 + 00054040 +(GMULT (LAMBDA (U V) 00054050 + (COND 00054060 + ((OR (NOT (EQUAL (CDR U) 1)) (NOT (EQUAL (CDR V) 1))) 00054070 + (ERRACH (LIST (QUOTE GMULT) U V))) 00054080 + ((NOT (EQ (CADAR U) (CADAR V))) (QUOTE FAILED)) 00054090 + (T (GCHECK (REVERSE (CDDAR U)) (CDDAR V) (CADAR U)))))) 00054100 + 00054110 +(NONCOM (LAMBDA (U) 00054120 + (FLAG U (QUOTE NONCOM)))) 00054130 + 00054140 +)) 00054150 + 00054160 +DEFINE (( 00054170 + 00054180 +(SPUR (LAMBDA (U) 00054190 + (PROG2 (RMSUBS) 00054200 + (MAP U 00054210 + (FUNCTION 00054220 + (LAMBDA(J) 00054230 + (PROG2 (REMFLAG (LIST (CAR J)) (QUOTE NOSPUR)) 00054240 + (REMFLAG (LIST (CAR J)) (QUOTE REDUCE))))))))) 00054250 + 00054260 +(NOSPUR (LAMBDA (U) 00054270 + (FLAG U (QUOTE NOSPUR)))) 00054280 + 00054290 +(REDUCE (LAMBDA (U) 00054300 + (PROG2 (NOSPUR U) (FLAG U (QUOTE REDUCE))))) 00054310 + 00054320 +(SIMPGAMMA (LAMBDA (*S*) 00054330 + (COND 00054340 + ((OR (NULL *S*) (NULL (CDR *S*))) 00054350 + (REDERR (QUOTE (MISSING ARGUMENTS FOR G OPERATOR)))) 00054360 + (T 00054370 + (PROG NIL 00054380 + (SETQ GAMIDEN* (UNION (LIST (CAR *S*)) GAMIDEN*)) 00054390 + (SETQ *NCMP T) 00054400 + (RETURN 00054410 + (MKVARG (CDR *S*) 00054420 + (FUNCTION 00054430 + (LAMBDA(J) 00054440 + (CONS (GCHECK (REVERSE J) NIL (CAR *S*)) 00054450 + 1)))))))))) 00054460 + 00054470 +(GCHECK (LAMBDA (U V L) 00054480 + (COND ((EQ (CAR V) (QUOTE A)) (GCHKA U (CDR V) T L)) 00054490 + (T (GCHKV U V T L))))) 00054500 + 00054510 +(GCHKA (LAMBDA (U V X W) 00054520 + (COND ((NULL U) (MULTN (NB X) (MKG (CONS (QUOTE A) V) W))) 00054530 + ((EQ (CAR U) (QUOTE A)) (GCHKV (CDR U) V X W)) 00054540 + (T (GCHKA (CDR U) (CONS (CAR U) V) (NOT X) W))))) 00054550 + 00054560 +(GCHKV (LAMBDA (U V X L) 00054570 + (COND ((NULL U) 00054580 + (COND ((NULL V) (NB X)) (T (MULTN (NB X) (MKG V L))))) 00054590 + ((EQ (CAR U) (QUOTE A)) (GCHKA (CDR U) V X L)) 00054600 + (T (GCHKV (CDR U) (CONS (CAR U) V) X L))))) 00054610 + 00054620 +(MKG (LAMBDA (U L) 00054630 + (LIST (CONS (CONS (CONS (QUOTE G) (CONS L U)) 1) 1)))) 00054640 + 00054650 +(MKA (LAMBDA (L) 00054660 + (MKG (LIST (QUOTE A)) L))) 00054670 + 00054680 +(MKG1 (LAMBDA (U L) 00054690 + (COND 00054700 + ((OR (NOT (FLAGP L (QUOTE NOSPUR))) 00054710 + (NULL (CDR U)) 00054720 + (CDDR U) 00054730 + (ORDOP (CAR U) (CADR U)) 00054740 + (EQ (CAR U) (QUOTE A))) 00054750 + (MKG U L)) 00054760 + (T 00054770 + (ADDF (MULTN 2 (MKDOT (CAR U) (CADR U))) 00054780 + (MULTN -1 (MKG (REVERSE U) L))))))) 00054790 + 00054800 +(NB (LAMBDA (U) 00054810 + (COND (U 1) (T -1)))) 00054820 + 00054830 +)) 00054840 + 00054850 +DEFINE (( 00054860 + 00054870 +(SPUR0 (LAMBDA (U I V1 V2 V3) 00054880 + (PROG (L V W I1 Z KAHP) 00054890 + (SETQ L (CADAAR U)) 00054900 + (SETQ V (CDDAAR U)) 00054910 + (COND ((NOT (ONEP (CDAR U))) (SETQ V (APPN V (CDAR U))))) 00054920 + (SETQ U (CDR U)) 00054930 + (COND 00054940 + ((AND (NOT (GET L (QUOTE NOSPUR))) 00054950 + (OR (AND (EQ (CAR V) (QUOTE A)) 00054960 + (OR (LESSP (LENGTH V) 5) 00054970 + (NOT (EVENP (CDR V))))) 00054980 + (AND (NOT (EQ (CAR V) (QUOTE A))) 00054990 + (NOT (EVENP V))))) 00055000 + (RETURN NIL)) 00055010 + ((NULL I) (GO END))) 00055020 + A (COND ((NULL V) (GO END1)) ((MEMBER (CAR V) I) (GO B))) 00055030 + A1 (SETQ W (CONS (CAR V) W)) 00055040 + (SETQ V (CDR V)) 00055050 + (GO A) 00055060 + B (COND ((MEMBER (CAR V) (CDR V)) (GO KAH1)) 00055070 + ((MEMBER (CAR V) I1) (GO A1)) 00055080 + ((SETQ Z (BASSOC (CAR V) V1)) (GO E)) 00055090 + ((SETQ Z (MEMLIS (CAR V) V2)) 00055100 + (RETURN 00055110 + ((LAMBDA(X) 00055120 + (COND 00055130 + ((AND (FLAGP L (QUOTE REDUCE)) 00055140 + (NULL V1) 00055150 + (NULL V3) 00055160 + (NULL (CDR V2))) 00055170 + (MULTF (MKG* X L) (MULTF (MKEPS1 Z) (ISIMP U)))) 00055180 + (T 00055190 + (ISIMP1 00055200 + (SPUR0 (CONS (CAAR (MKG X L)) U) 00055210 + NIL 00055220 + V1 00055230 + (DELETE Z V2) 00055240 + V3) 00055250 + I 00055260 + NIL 00055270 + (LIST Z) 00055280 + NIL)))) 00055290 + (APPEND (REVERSE W) V)))) 00055300 + ((SETQ Z (MEMLIS (CAR V) V3)) (GO C)) 00055310 + (T 00055320 + (RETURN 00055330 + (ISIMP1 U 00055340 + I 00055350 + V1 00055360 + V2 00055370 + (CONS (CONS L (APPEND (REVERSE W) V)) 00055380 + V3))))) 00055390 + C (SETQ V3 (DELETE Z V3)) 00055400 + (SETQ KAHP NIL) 00055410 + (COND 00055420 + ((AND (FLAGP L (QUOTE NOSPUR)) 00055430 + (FLAGP (CAR Z) (QUOTE NOSPUR))) 00055440 + (ERROR (QUOTE HELP))) 00055450 + ((FLAGP (CAR Z) (QUOTE NOSPUR)) (SETQ KAHP (CAR Z)))) 00055460 + (SETQ Z (CDR Z)) 00055470 + (SETQ I1 NIL) 00055480 + C1 (COND ((EQ (CAR V) (CAR Z)) (GO D))) 00055490 + (SETQ I1 (CONS (CAR Z) I1)) 00055500 + (SETQ Z (CDR Z)) 00055510 + (GO C1) 00055520 + D (SETQ Z (CDR Z)) 00055530 + (SETQ I (DELETE (CAR V) I)) 00055540 + (SETQ V (CDR V)) 00055550 + (COND ((NOT (FLAGP L (QUOTE NOSPUR))) (GO D0))) 00055560 + (SETQ W (CONS W (CONS V (CONS I1 Z)))) 00055570 + (SETQ I1 (CAR W)) 00055580 + (SETQ Z (CADR W)) 00055590 + (SETQ V (CADDR W)) 00055600 + (SETQ W (CDDDR W)) 00055610 + D0 (SETQ W (REVERSE W)) 00055620 + (COND 00055630 + ((AND (OR (NULL V) (NOT (EQ (CAR W) (QUOTE A)))) 00055640 + (SETQ V (APPEND V W))) 00055650 + (GO D1)) 00055660 + ((NOT (EVENP V)) (SETQ U (MULTN -1 U)))) 00055670 + (SETQ V (CONS (QUOTE A) (APPEND V (CDR W)))) 00055680 + D1 (COND (KAHP (SETQ L KAHP))) 00055690 + (SETQ VARS* NIL) 00055700 + (SETQ Z (MULTF (MKG (REVERSE I1) L) 00055710 + (MULTF (BRACE V L I) (MULTF (MKG1 Z L) U)))) 00055720 + (SETQ Z (ISIMP1 Z (APPEND VARS* I) V1 V2 V3)) 00055730 + (COND ((NULL Z) (RETURN Z)) 00055780 + ((NULL (SETQ Z (QUOTF Z 2))) 00055790 + (ERRACH (LIST (QUOTE SPUR0) U I V1 V2 V3)))) 00055800 + (RETURN Z) 00055810 + E (SETQ V1 (DELETE Z V1)) 00055820 + (SETQ I (DELETE (CAR W) I)) 00055830 + (SETQ V (CONS (OTHER (CAR V) Z) (CDR V))) 00055840 + (GO A) 00055850 + KAH1 (COND ((EQ (CAR V) (CADR V)) (GO K2))) 00055860 + (SETQ KAHP T) 00055870 + (SETQ I1 (CONS (CAR V) I1)) 00055880 + (GO A1) 00055890 + K2 (SETQ I (DELETE (CAR V) I)) 00055900 + (SETQ V (CDDR V)) 00055910 + (SETQ U (MULTN 4 U)) 00055920 + (GO A) 00055930 + END (SETQ W (REVERSE V)) 00055940 + END1 (COND (KAHP (GO END2)) 00055950 + ((NULL (SETQ Z (SPURR W L NIL 1))) (RETURN NIL)) 00055960 + (T (RETURN (COND ((AND (GET (QUOTE EPS) (QUOTE KLIST)) 00055970 + (NOT (FLAGP L (QUOTE NOSPUR)))) 00055971 + (ISIMP1 (MULTF Z U) I V1 V2 V3)) 00055972 + (T (MULTF Z (ISIMP1 U I V1 V2 V3))))))) 00055973 + END2 (SETQ VARS* NIL) 00055980 + (SETQ Z (MULTF (KAHANE (REVERSE W) I1 L) U)) 00055990 + (RETURN (ISIMP1 Z (APPEND VARS* (SETDIFF I I1)) V1 V2 V3))))) 00056000 + 00056040 +(APPN (LAMBDA (U N) 00056050 + (COND ((ONEP N) U) (T (APPEND U (APPN U (SUB1 N))))))) 00056060 + 00056070 +(OTHER (LAMBDA (U V) 00056080 + (COND ((EQ U (CAR V)) (CDR V)) (T (CAR V))))) 00056090 + 00056100 +)) 00056110 + 00056120 +DEFINE (( 00056130 + 00056140 +(KAHANE (LAMBDA (U I L) 00056150 + (PROG (K2 LD LU M P V W X Y) 00056160 + (SETQ K2 0) 00056170 + (SETQ M 0) 00056180 + (SETQ W (LIST T T NIL)) 00056190 + (COND ((EQ (CAR U) (QUOTE A)) (GO B))) 00056200 + A (COND 00056210 + ((AND (NULL U) (SETQ W (CONS NIL (CONS NIL (CONS NIL W))))) 00056220 + (GO KETJAK)) 00056230 + ((MEMBER (CAR U) I) (GO D))) 00056240 + (SETQ P (NOT P)) 00056250 + B (SETQ W (CONS (CAR U) W)) 00056260 + C (SETQ U (CDR U)) 00056270 + (GO A) 00056280 + D (SETQ W (CONS (CAR U) (CONS P (CONS NIL W)))) 00056290 + (SETQ X NIL) 00056300 + KETJAK 00056310 + (SETQ W (REVERSE W)) 00056320 + TJARUM 00056330 + (COND ((CADR W) (SETQ LU (CONS W LU))) 00056340 + (T (SETQ LD (CONS W LD)))) 00056350 + (COND ((NULL U) (GO DJANGER)) (X (GO MAS))) 00056360 + (SETQ W (REVERSE W)) 00056370 + (SETQ X T) 00056380 + (GO TJARUM) 00056390 + MAS (SETQ W (LIST T (SETQ P (NOT P)) (CAR U))) 00056400 + (SETQ K2 (ADD1 K2)) 00056410 + (GO C) 00056420 + DJANGER 00056430 + (SETQ LU (REVERSE LU)) 00056440 + BARUNA 00056450 + (COND ((NULL LU) (GO JAVA))) 00056460 + (SETQ V (CAR LU)) 00056470 + (SETQ LU (CDR LU)) 00056480 + WAJANG 00056490 + (SETQ X (CONS (CAR V) (CADR V))) 00056495 + (SETQ P (NULL (CADDR V))) 00056500 + (SETQ M (ADD1 M)) 00056510 + (SETQ W NIL) 00056520 + RINDIK 00056530 + (SETQ Y (REVERSE V)) 00056540 + R1 (COND ((CADR Y) (SETQ LU (DELETE Y LU))) 00056545 + (T (SETQ LD (DELETE Y LD)))) 00056550 + (COND ((EQ Y V) (GO RINDIK)) 00056555 + (P (AND (SETQ V Y) 00056560 + (SETQ X (CONS (CAR V) (CADR V))) 00056565 + (SETQ P NIL)))) 00056570 + (SETQ V (CDDDR V)) 00056575 + BANDJAR 00056580 + (COND ((CDDDR V) (GO SUBAK)) 00056585 + ((NULL (CADDR V)) (GO WADAH)) 00056590 + ((AND (EQ (CADDR V) (CAR X)) 00056595 + (EQ (CADR V) (CDR X))) (GO BARIS))) 00056596 + (SETQ V 00056600 + (SASSOC (CADDR V) 00056605 + (COND ((CADR V) LU) (T LD)) 00056610 + (FUNCTION 00056650 + (LAMBDA NIL (ERRACH (QUOTE KAHANE)))))) 00056660 + (SETQ Y V) 00056670 + (GO R1) 00056680 + SUBAK 00056700 + (SETQ W (CONS (CAR V) W)) 00056710 + (SETQ V (CDR V)) 00056720 + (GO BANDJAR) 00056730 + WADAH 00056740 + (SETQ U (MKG (REVERSE W) L)) 00056750 + (GO BARUNA) 00056760 + BARIS 00056770 + (COND ((AND W (CDR X)) (SETQ W (NCONC (CDR W) (LIST (CAR W)))))) 00056775 + (SETQ U (MULTF (BRACE W L NIL) U)) 00056780 + (GO BARUNA) 00056790 + JAVA (COND ((NULL LD) (GO HOME))) 00056800 + (SETQ V (CAR LD)) 00056810 + (SETQ LD (CDR LD)) 00056820 + (GO WAJANG) 00056830 + HOME (SETQ K2 (QUOTIENT K2 2)) 00056840 + (SETQ X (EXPT 2 K2)) 00056850 + (COND 00056860 + ((ZEROP (REMAINDER (DIFFERENCE K2 M) 2)) 00056870 + (SETQ X (MINUS X)))) 00056880 + (RETURN (MULTN X U))))) 00056890 + 00056900 +(BRACE (LAMBDA (U L I) 00056910 + (COND ((NULL U) 2) 00056920 + ((OR (XN I U) (FLAGP L (QUOTE NOSPUR))) 00056930 + (ADDF (MKG1 U L) (MKG1 (REVERSE U) L))) 00056935 + ((EQ (CAR U) (QUOTE A)) 00056940 + (COND ((EVENP U) (ADDF (MKG U L) 00056950 + (MULTN -1 (MKG (CONS (QUOTE A) 00056952 + (REVERSE (CDR U))) L)))) 00056954 + (T (MULTF (MKA L) (SPR2 (CDR U) L 2 NIL))))) 00056960 + ((EVENP U) (SPR2 U L 2 NIL)) 00056970 + (T (SPR1 U L 2 NIL))))) 00056980 + 00056990 +(SPR1 (LAMBDA (U L N B) 00057000 + (COND ((NULL U) NIL) 00057010 + ((NULL (CDR U)) (MULTN N (MKG1 U L))) 00057020 + (T 00057030 + (PROG (M X Z) 00057040 + (SETQ X U) 00057050 + (SETQ M 0) 00057060 + A (COND ((NULL X) (RETURN Z))) 00057070 + (SETQ Z 00057080 + (ADDF (MULTF (MKG1 (LIST (CAR X)) L) 00057090 + (COND 00057100 + ((NULL B) 00057110 + (SPURR (REMOVE U M) L NIL N)) 00057120 + (T (SPR1 (REMOVE U M) L N NIL)))) 00057130 + Z)) 00057140 + (SETQ X (CDR X)) 00057150 + (SETQ N (MINUS N)) 00057160 + (SETQ M (ADD1 M)) 00057170 + (GO A)))))) 00057180 + 00057190 +(SPR2 (LAMBDA (U L N B) 00057200 + (COND ((AND (NULL (CDDR U)) (NULL B)) 00057210 + (MULTN N (MKDOT (CAR U) (CADR U)))) 00057220 + (T 00057230 + ((LAMBDA (X) (COND (B (ADDF (SPR1 U L N B) X)) (T X))) 00057240 + (ADDF (SPURR U L NIL N) 00057250 + (MULTF (MKA L) 00057255 + (SPURR (APPEND U (LIST (QUOTE A))) L NIL N)))))))) 00057260 + 00057270 +(EVENP (LAMBDA (U) 00057410 + (OR (NULL U) (NOT (EVENP (CDR U)))))) 00057420 + 00057430 +(BASSOC (LAMBDA (U V) 00057440 + (COND ((NULL V) NIL) 00057450 + ((OR (EQ U (CAAR V)) (EQ U (CDAR V))) (CAR V)) 00057460 + (T (BASSOC U (CDR V)))))) 00057470 + 00057480 +(MEMLIS (LAMBDA (U V) 00057490 + (COND ((NULL V) NIL) 00057500 + ((MEMBER U (CAR V)) (CAR V)) 00057510 + (T (MEMLIS U (CDR V)))))) 00057520 + 00057530 +)) 00057540 + 00057550 +DEFINE (( 00057560 + 00057570 +(SPURR (LAMBDA (U L V N) 00057580 + (PROG (M W X Y Z) 00057590 + A (COND ((NULL U) (GO B)) ((MEMBER (CAR U) (CDR U)) (GO G))) 00057600 + (SETQ V (CONS (CAR U) V)) 00057610 + (SETQ U (CDR U)) 00057620 + (GO A) 00057630 + B (COND ((NULL V) (RETURN N)) 00057640 + ((FLAGP L (QUOTE NOSPUR)) 00057650 + (RETURN (MULTN N (MKG* V L)))) 00057660 + (T (RETURN (SPRGEN V N)))) 00057670 + G (SETQ X (CAR U)) 00057680 + (SETQ Y (CDR U)) 00057690 + (SETQ W Y) 00057700 + (SETQ M 0) 00057710 + H (COND 00057720 + ((EQ X (CAR W)) 00057730 + (RETURN 00057740 + (ADDF (MULTF (MKDOT X X) (SPURR (DELETE X Y) L V N)) 00057750 + Z)))) 00057760 + (SETQ Z 00057770 + (ADDF (MULTF (MKDOT X (CAR W)) 00057780 + (SPURR (REMOVE Y M) L V (TIMES 2 N))) 00057790 + Z)) 00057800 + (SETQ W (CDR W)) 00057810 + (SETQ N (MINUS N)) 00057820 + (SETQ M (ADD1 M)) 00057830 + (GO H)))) 00057840 + 00057850 +(SPRGEN (LAMBDA (V N) 00057860 + (PROG (X Z) 00057870 + (COND 00057880 + ((NOT (EQ (CAR V) (QUOTE A))) (RETURN (SPRGEN1 V N))) 00057890 + ((NULL (SETQ X (COMB1 (SETQ V (CDR V)) 4 NIL))) 00057900 + (RETURN NIL)) 00057910 + ((NULL (CDR X)) (GO E))) 00057920 + C (COND ((NULL X) (RETURN (MULTF2 (MKSP (QUOTE I) 1) Z)))) 00057930 + (SETQ Z 00057940 + (ADDF (MULTN (ASIGN (CAR X) V N) 00057950 + (MULTF (MKEPS1 (CAR X)) 00057960 + (SPRGEN1 (SETDIFF V (CAR X)) 1))) 00057970 + Z)) 00057980 + D (SETQ X (CDR X)) 00057990 + (GO C) 00058000 + E (SETQ Z (MULTN N (MKEPS1 (CAR X)))) 00058010 + (GO D)))) 00058020 + 00058030 +(ASIGN (LAMBDA (U V N) 00058031 + (COND ((NULL U) N) 00058032 + (T (ASIGN (CDR U) V (TIMES (ASIGN1 (CAR U) V -1) N)))))) 00058033 + 00058034 +(ASIGN1 (LAMBDA (U V N) 00058035 + (COND ((NULL V) (ERROR (QUOTE ARG))) 00058036 + ((EQ U (CAR V)) N) 00058037 + (T (ASIGN1 U (CDR V) (MINUS N)))))) 00058038 + 00058039 +(SPRGEN1 (LAMBDA (U N) 00058040 + (COND ((NULL U) NIL) 00058050 + ((NULL (CDDR U)) (MULTN N (MKDOT (CAR U) (CADR U)))) 00058060 + (T 00058070 + (PROG (W X Y Z) 00058080 + (SETQ X (CAR U)) 00058090 + (SETQ U (CDR U)) 00058100 + (SETQ Y U) 00058110 + A (COND ((NULL U) (RETURN Z)) 00058120 + ((NULL (SETQ W (MKDOT X (CAR U)))) (GO B))) 00058130 + (SETQ Z 00058140 + (ADDF (MULTF W (SPRGEN1 (DELETE (CAR U) Y) N)) 00058150 + Z)) 00058160 + B (SETQ N (MINUS N)) 00058170 + (SETQ U (CDR U)) 00058180 + (GO A)))))) 00058190 + 00058200 +(COMB1 (LAMBDA (U N V) 00058210 + ((LAMBDA(M) 00058220 + (COND ((ONEP N) 00058230 + (APPEND V (MAPCAR U (FUNCTION (LAMBDA (J) (LIST J)))))) 00058240 + ((MINUSP M) NIL) 00058250 + ((ZEROP M) (CONS U V)) 00058260 + (T 00058270 + (COMB1 (CDR U) 00058280 + N 00058290 + (APPEND V 00058300 + (MAPCONS (COMB1 (CDR U) (SUB1 N) NIL) 00058310 + (CAR U))))))) 00058320 + (DIFFERENCE (LENGTH U) N)))) 00058330 + 00058340 +)) 00058350 + 00058360 +DEFINE (( 00058370 + 00058380 +(SIMPEPS (LAMBDA (U) 00058390 + (MKVARG U 00058400 + (FUNCTION 00058410 + (LAMBDA(J) 00058420 + (CONS (COND ((REPEATS J) NIL) (T (MKEPS1 J))) 1)))))) 00058430 + 00058440 +(MKEPS1 (LAMBDA (U) 00058450 + ((LAMBDA(X) 00058460 + (MULTN (NB (PERMP X U)) (MKSF (CONS (QUOTE EPS) X) 1))) 00058470 + (ORDN U)))) 00058480 + 00058490 +(PERMP (LAMBDA (U V) 00058500 + (COND ((NULL U) T) 00058510 + ((EQ (CAR U) (CAR V)) (PERMP (CDR U) (CDR V))) 00058520 + (T (NOT (PERMP (CDR U) (SUBST (CAR V) (CAR U) (CDR V)))))))) 00058530 + 00058540 +)) 00058550 + 00058560 +DEFINE (( 00058570 + 00058580 +(ESUM (LAMBDA (U I V W XX) 00058590 + (PROG (X Y Z) 00058600 + (SETQ X (CAR U)) 00058610 + (SETQ U (CDR U)) 00058620 + (COND 00058630 + ((NOT (ONEP (CDR X))) 00058640 + (SETQ U 00058650 + (MULTF (NMULTF (MKEPS1 (CDAR X)) (SUB1 (CDR X))) 00058660 + U)))) 00058670 + (SETQ X (CDAR X)) 00058680 + A (COND ((REPEATS X) (RETURN NIL))) 00058690 + B (COND ((NULL X) 00058700 + (RETURN (ISIMP1 U I V (CONS (REVERSE Y) W) XX))) 00058710 + ((NOT (MEMBER (CAR X) I)) (GO D)) 00058720 + ((NOT (SETQ Z (BASSOC (CAR X) V))) (GO C))) 00058730 + (SETQ V (DELETE Z V)) 00058740 + (SETQ I (DELETE (CAR X) I)) 00058750 + (SETQ X 00058760 + (APPEND (REVERSE Y) (CONS (OTHER (CAR X) Z) (CDR X)))) 00058770 + (SETQ Y NIL) 00058780 + (GO A) 00058790 + C (COND ((SETQ Z (MEMLIS (CAR X) W)) (GO C1)) 00058800 + ((SETQ Z (MEMLIS (CAR X) XX)) 00058810 + (RETURN 00058820 + (SPUR0 (CONS (CONS (CONS (QUOTE G) Z) 1) U) 00058830 + I 00058840 + V 00058850 + (CONS (APPEND (REVERSE Y) X) W) 00058860 + (DELETE Z XX))))) 00058870 + (RETURN (ISIMP1 U I V (CONS (APPEND (REVERSE Y) X) W) XX)) 00058880 + C1 (SETQ X (APPEND (REVERSE Y) X)) 00058890 + (SETQ Y (XN I (XN X Z))) 00058900 + (RETURN 00058910 + (ISIMP1 (MULTF (EMULT1 Z X Y) U) 00058920 + (SETDIFF I Y) 00058930 + V 00058940 + (DELETE Z W) 00058950 + XX)) 00058960 + D (SETQ Y (CONS (CAR X) Y)) 00058970 + (SETQ X (CDR X)) 00058980 + (GO B)))) 00058990 + 00059000 +(EMULT (LAMBDA (U) 00059010 + (COND ((NULL (CDR U)) (MKEPS1 (CAR U) 1)) 00059020 + ((NULL (CDDR U)) (EMULT1 (CAR U) (CADR U) NIL)) 00059030 + (T (MULTF (EMULT1 (CAR U) (CADR U) NIL) (EMULT (CDDR U))))))) 00059040 + 00059050 +(EMULT1 (LAMBDA (U V I) 00059060 + ((LAMBDA(X *S*) 00059070 + ((LAMBDA(M N) 00059080 + (COND ((EQUAL M 4) (TIMES 6 (TIMES 4 N))) 00059090 + ((EQUAL M 3) 00059100 + (MULTN (TIMES 6 N) (MKDOT (CAR X) (CAR *S*)))) 00059110 + (T 00059120 + (MULTN (TIMES N (COND ((ZEROP M) 1) (T M))) 00059130 + (CAR 00059140 + (DETQ 00059150 + (MAPLIST X 00059160 + (FUNCTION 00059170 + (LAMBDA(*S1*) 00059180 + (MAPLIST *S* 00059190 + (FUNCTION 00059200 + (LAMBDA 00059210 + (J) 00059220 + (CONS 00059230 + (MKDOT 00059240 + (CAR *S1*) 00059250 + (CAR J)) 00059260 + 1))))))))))))) 00059270 + (LENGTH I) 00059280 + ((LAMBDA (J) (NB(COND((PERMP U (APPEND I X)) (NOT J)) (T J)))) 00059290 + (PERMP V (APPEND I *S*))))) 00059300 + (SETDIFF U I) 00059310 + (SETDIFF V I)))) 00059320 + 00059330 +)) 00059340 + 00059350 +DEFLIST (((NONCOM RLIS) (SPUR RLIS) (NOSPUR RLIS) (REDUCE RLIS)) STAT) 00059360 + 00059370 + 00059380 +PTS (NOCMP* T) 00059381 +DEFINE (( 00059390 + 00059400 +(MKG* (LAMBDA (U L) 00059410 + (COND ((NULL U) 1) 00059420 + ((NOT (FLAGP L (QUOTE REDUCE))) (MKG1 U L)) 00059430 + ((LESSP (LENGTH U) 3) (MKG1 U L)) 00059440 + ((AND (EQCAR U (QUOTE A)) (EQUAL (LENGTH U) 3)) 00059450 + ((LAMBDA(Y) 00059460 + (PROG2 (SETQ INDICES* (APPEND Y INDICES*)) 00059470 + (ADDF (MULTF (MKA L) (MKDOT (CADR U) (CADDR U))) 00059480 + (MULTF2 (MKSP (QUOTE I) 1) 00059490 + (MULTF (MKG1 Y L) 00059500 + (MKEPS1 00059510 + (APPEND (CDR U) Y))))))) 00059520 + (LIST (GENSYM) (GENSYM)))) 00059530 + (T (RED* U L))))) 00059540 + 00059550 +(RED* (LAMBDA (U L) 00059560 + (PROG (I X) 00059570 + (SETQ X (ACONC (EXPLODE L) (QUOTE I))) 00059580 + (SETQ I 00059590 + (LIST (COMPRESS (APPEND X (QUOTE (1)))) 00059600 + (COMPRESS (APPEND X (QUOTE (2)))))) 00059610 + (SETQ X (LIST (QUOTE A) (CAR I))) 00059620 + (RETURN 00059630 + (ADDF (SPURR NIL (QUOTE ***) U 3) 00059640 + (ADDF (MULTF (MKG (QUOTE (A)) L) 00059650 + (ISIMP1 00059660 + (GCHECK (QUOTE (A)) U (QUOTE ***)) 00059670 + NIL 00059680 + NIL 00059690 + NIL 00059700 + NIL)) 00059710 + (ADDF 00059720 + (ISIMP1* 00059730 + (ISIMP1 (GCHECK (LIST (CAR I)) U (QUOTE ***)) 00059740 + NIL 00059750 + NIL 00059760 + NIL 00059770 + NIL) 00059780 + (LIST (CAR I)) 00059790 + (LIST (LIST L (CAR I)))) 00059800 + (ADDF (MULTN -1 00059810 + (ISIMP1* 00059820 + (ISIMP1 00059830 + (GCHECK 00059840 + (REVERSE X) 00059850 + U 00059860 + (QUOTE ***)) 00059870 + NIL 00059880 + NIL 00059890 + NIL 00059900 + NIL) 00059910 + (CDR X) 00059920 + (LIST (CONS L X)))) 00059930 + (MULTF (MKSQP (CONS -1 2)) 00059940 + (ISIMP1* 00059950 + (ISIMP1 00059960 + (GCHECK 00059970 + (REVERSE I) 00059980 + U 00059990 + (QUOTE ***)) 00060000 + NIL 00060010 + NIL 00060020 + NIL 00060030 + NIL) 00060040 + I 00060050 + (LIST (CONS L I)))))))))))) 00060060 + 00060070 +(ISIMP1* (LAMBDA (U I V) 00060080 + (COND ((NULL U) NIL) (T (ISIMP1 U I NIL NIL V))))) 00060090 + 00060100 +)) 00060110 + 00060120 +INIT NIL 00060130 + 00060140 +CHKPOINT (REDUCE) 00060145 + 00060150 +COMMENT ((E N D O F R E D U C E P R O G R A M)) 00060160 + 00060170 + 00060180 ADDED reduce2/reduce2.update.uu.3 Index: reduce2/reduce2.update.uu.3 ================================================================== --- reduce2/reduce2.update.uu.3 +++ reduce2/reduce2.update.uu.3 @@ -0,0 +1,273 @@ +%DELETE '00000020' +OPEN (COMPILE SYSFILE INPUT) RESTORE (COMPILE) +%DELETE '00000056' +$$$15-SEP-72 (UM 1-JUNE-73)$ +%AFTER '00000220' + +(DEFEXPR (LAMBDA (U) + (DEF1 U (QUOTE FEXPR)))) +%DELETE '00000480' + ((AND V (GET U (QUOTE SPECIAL))) +%DELETE '00000570' + ((AND V (EQ (CAR U) (QUOTE SETQ)) +%DELETE '00000670' '00000740' + (T (CONS (TRANS (CAR U) V) +%DELETE '00001240' + (**ESC $$$?$) +%DELETE '00001472' +%DELETE '00001740' +%DELETE '00002170' '00002190' +%DELETE '00002270' '00002281' +%AFTER '00002330' + +DEFINE (( +(MKSTRING (LAMBDA (U) + (LIST (QUOTE QUOTE) (COMPRESS (DELETE **SMARK (CDR U)))))) +)) + +COMMENT ((FUNCTIONS FOR MTS IMPLEMENTATION ONLY)) + +DEFLIST (((PAUSE NORLIS) (CONT NORLIS)) STAT) + +DEFINE (( + +(PAUSE (LAMBDA NIL + (PROG (Y Z) + (COND ((BATCH) (RETURN NIL))) + (PRINM (QUOTE ($$$CONT?$))) + (COND ((YORN) (RETURN NIL))) + (COND ((AND IFL* (NOT (EQ IFL* (CAR IPL*)))) + (SETQ IPL* (CONS IFL* IPL*)))) + (SETQ IFL* NIL) + (SETQ Y *INT) + (SETQ *INT T) + (SETQ Z *ECHO) + (SETQ *ECHO NIL) + (RDS (OPEN (QUOTE GUSER) (QUOTE INPUT))) + (BEGIN1 T) + (SETQ *INT Y) + (SETQ *ECHO Z) + ))) + +(REDMSG1 (LAMBDA (U V) + (PROG NIL + (PRINM (LIST (QUOTE SHOULD) U (QUOTE BE) + (QUOTE DECLARED) V (QUOTE $$$?$))) + (RETURN (YORN)) ))) + +(PRINM (LAMBDA (U) + (PROG (V) + (WRS (OPEN (QUOTE SERCOM) (QUOTE OUTPUT))) + (SETQ V U) +A (PRINC (CAR V)) + (PRINC **BLANK) + (COND ((SETQ V (CDR V)) (GO A))) + (TERPRI) + (WRS OFL*) ))) + +(READM (LAMBDA NIL + (PROG (U) + (CLOSE (QUOTE GUSER)) + (RDS (OPEN (QUOTE GUSER) (QUOTE INPUT))) + (SETQ U (READ)) + (RDS IFL*) + (RETURN U) ))) + +(YORN (LAMBDA NIL + (PROG (U) +A (SETQ U (READM)) + (COND ((EQ U (QUOTE Y)) (RETURN T)) + ((EQ U (QUOTE N)) (RETURN NIL))) + (PRINM (QUOTE (ILLEGAL $$$RESPONSE.$ ENTER Y OR N))) + (GO A) ))) +)) +%DELETE '00002440' 2 + (SETQ *INT (NULL (BATCH))) + (SETQ *ECHO (BATCH)) + (*WRS NIL) +%DELETE '00002520' + (EXITERR (BATCH)) +%DELETE '00002570' + (RETURN (BEGIN1 NIL))))) +%DELETE '00002701' '00002702' +%DELETE '00002935' '00002950' +(*OPEN (LAMBDA (U V) (PROG2 (OPEN U NIL V) U))) +%DELETE '00003010' '00003030' +(*WRS (LAMBDA (U) + (PROG NIL + (WRS (QUOTE LISPOUT)) + (COND (U (PROG2 (ASA NIL) (WRS U)))) + (OTLL (OTLLNG)) + (PTS (QUOTE LLENGTH*) (DIFFERENCE (OTLLNG) 7))))) +%DELETE '00003060' +LOSE ((ASSOC* REMK*)) +%BEFORE '00004110' + (COND ((NOT (ATOMLIS U)) (REDERR (QUOTE (ILLEGAL FILE NAME))))) +%DELETE '00004230' + F (BEGIN1 T) +%DELETE '00004370' + (SETQ *INT (NOT (BATCH))) + (SETQ *ECHO (BATCH)) + (GO F) +%AFTER '00004840' + ($$$&$ NIL AND NIL) + ($$$|$ NIL OR NIL) + ($$$~$ $$$=$ NOT UNEQ) +%AFTER '00011890' + (SETQ POSN* 0) + (COND ((NULL FORTVAR*) (GO A))) +%AFTER '00011900' + (SETQ POSN* 6) +%DELETE '00011910' + (PRINC* FORTVAR*) +%DELETE '00011930' + (PRINC* FORTVAR*) +%DELETE '00011941' +%AFTER '00013690' + ((EQ CRCHAR* **EOF) (GO EOF)) +%DELETE '00013800' + D (COND ((OR ECHO* *NAT) (SYMPRI CURSYM*))) +%DELETE '00014170' + (COND ((OR ECHO* *NAT) (MAPRIN CURSYM*))) +%DELETE '00014180' + (GO D1) + EOF (SETQ CURSYM* (QUOTE END)) + (SETQ CRCHAR* **SEMICOL) + (GO D) ))) +%DELETE '00014820' '00014840' + (SETQ U (AND (NOT (EQ *MODE (QUOTE SYMBOLIC))) + (OR PRI* (EQ U (QUOTE TOP)) (EQ U (QUOTE PRI))))) +%DELETE '00014940' + A (COND ((AND U (OR PRI* (EQ SEMIC* **SEMICOL))) +%DELETE '00016740' + (REMFLAG (LIST NAME) (QUOTE FNC)) +%DELETE '00020010' + (RETURN (COMMAND1 (QUOTE PRI))))) +%DELETE '00020290' + (PROG (X Y Z) +%DELETE '00020300' + (SETQ X ECHO*) +%DELETE '00020380' + LOOP (COND ((EQ CRCHAR* **EOF) (GO RET)) + ((NULL U) (GO L1)) +%DELETE '00020440' + L1 (COND ((NULL X) (GO L3))) + (COND ((NULL U) (PRINC* CRCHAR*)) + ((BREAKP CRCHAR*) (GO L2)) + (T (PROG2 (RLIT CRCHAR*) (SETQ Z T)))) + L3 +%DELETE '00020590' '00020600' + L2 (COND (Z (PRINC* (MKATOM)))) + (SETQ Z NIL) + (PRINC* CRCHAR*) + (COND ((NOT (EQ CRCHAR* **BLANK)) (GO L3)) + ((EQ U (QUOTE END)) (SETQ Y NIL))) + L4 (COND ((EQ (READCH*) **BLANK) (GO L4))) + (GO LOOP) + RET (COND ((AND X Z) (PROG2 (PRINC* (MKATOM)) (SETQ Z NIL)))) + (SCAN) + RET1 (COND ((AND X Z) (PRINC* (MKATOM)))) + (RETURN (COND (X (TERPRI*)) (T NIL))) +%DELETE '00021240' + (*APPLY (CONVRT (CDR X) T) NIL))) +%DELETE '00021485' + (FUNCTION REVAL))))) (PROG2 (ERRPRI2 X) (ERROR*)))) +%DELETE '00021680' +(BEGIN1 (LAMBDA (U) +%DELETE '00021730' + (SETQ ECHO* (AND *ECHO (NOT (AND OFL* (OR *FORT (NULL *NAT)))))) +%AFTER '00021840' + ((EQ (CAR PROGRAM*) (QUOTE CONT)) (GO C)) +%DELETE '00021852' + B (TERPRI*) +%DELETE '00021890' + (ERRORSET (CONVRT (GTS (QUOTE PROGRAM*)) T) T)) +%DELETE '00021960' + (COND ((NULL (OR *INT OFL* *FORT)) (PRINTTY **STAR))) +%AFTER '00021970' + C (COND ((NOT U) (GO A))) + (COND (IFL* (GO ND1))) + (SETQ IFL* (COND (IPL* (CAR IPL*)) (T NIL))) + (RDS IFL*) + (TERPRI*) + (RETURN NIL) +%DELETE '00022010' + (RETURN (FINF U)) +%AFTER '00022040' + (SETP) +%DELETE '00022070' + (LPRIE (QUOTE (COMMAND TERMINATED *****)) T))) +%DELETE '00022100' + (COND (IFL* (PAUSE))) +%DELETE '00022130' +(FINF (LAMBDA (U) +%DELETE '00022150' + (COND (U (GO A))) +%AFTER '00022160' + (SETQ IFL* NIL) +%DELETE '00022220' '00022222' + A (COND ((NOT IFL*) (RETURN NIL))) + (SHUT (LIST IFL*)) +%AFTER '00022570' + (MTS NORLIS) +%DELETE '00023960' '00023980' + THE COMPUTING CENTER +%DELETE '00031230' +%DELETE '00032150' + (PROG (V W X Y Z Q) +%DELETE '00032190' + A (SETQ Q (CAR W)) + (COND ((NULL W) (GO D)) +%DELETE '00032210' + ((NOT (ATOM (CAR U))) (GO A3)) +%AFTER '00032231' + A3 (COND ((NOT (ATOM (CAAR W))) (GO A1)) + ((AND (MEMBER (CDAR W) FRLIS*) + (EQ (CAAR U) (QUOTE EXPT)) + (SETQ W (CONS (CONS (LIST (QUOTE EXPT) (CAAR W) + (CDAR W)) 1) (CDR W)))) + (GO A1)) + ((MEMBER (CAAR W) FRLIS*) (GO A2)) + (T (GO D))) +%DELETE '00032380' + (DELETE Q (CAR V))) +%AFTER '00034000' + (RMSUBS) +%DELETE '00034670' + ((ATOM P) (MKFR (TIMES P (CADDR Q)) (CADR Q))) + ((ATOM Q) (MKFR (CADR P) (TIMES Q (CADDR P)))) + (T (MKFR (TIMES (CADR P) (CADDR Q)) + (TIMES (CADR Q) (CADDR P)))) )) +%DELETE '00035880' + ((AND *ALLFAC (NOT (EQUAL X (CAR U)))) (GO B)) +%DELETE '00037220' '00037221' + D (COND ((NULL (OR W (EQ POSN* 0))) (PROG2 (SETQ POSN* 0) + (TERPRI)))) + (COND ((EQ POSN* 0) (SETQ COUNT* 1))) + (SETQ FORTVAR* NIL) + (COND ((OR W (ATOM V) (NOT (EQ POSN* 0))) (GO A))) +%DELETE '00037270' + (SETQ POSN* 6) + (PRINC* FORTVAR*) +%DELETE '00037281' +%BEFORE '00037670' + (SETQ ERFG* T) +%AFTER '00042660' + (REMPROP X (QUOTE ARRAY)) +%DELETE '00043411' '00043412' +%DELETE '00043860' + (PROG2 (LET1 U (MK*SQ (CONS (CDR (SIMP *ANS)) 1))) + (SETQ MCOND* (SETQ FRASC* NIL))))) +%DELETE '00043880' +(NUMER* (LAMBDA (U) +%DELETE '00043920' + (PROG2 (NUMER* U) (DENOM V)))) + +(NUMER (LAMBDA (U) + (PROG2 (NUMER* U) (SETQ MCOND* (SETQ FRASC* NIL))))) +%DELETE '00045321' '00045322' +%DELETE '00054950' + ((AND (NOT (FLAGP L (QUOTE NOSPUR))) +%DELETE '00059381' +%DELETE '00060145' +%BEFORE FILEMARK ADDED reduce2/reduce2.writeup.wf.8 Index: reduce2/reduce2.writeup.wf.8 ================================================================== --- reduce2/reduce2.writeup.wf.8 +++ reduce2/reduce2.writeup.wf.8 @@ -0,0 +1,121 @@ +SPECIAL KEYPUNCH +WIDTH OF COLUMN IS 65 +SENTENCES SEPARATED BY 2 BLANKS +REPEAT TITLE +TEXT STARTS ON LINE 5 IN POSITION 1 +INDENT (5,0),(10,0),(15,0),(20,0),(25,0) +TABS AT 6 11 16 21 26 31 36 41 +NO CAPITALIZE +TITLE 1 +9COMPUTING CENTER MEMO #M182ñññññññññMTA/7-14-71 +)E +GO +)LLLL )M REDUCE 2 )M +)LLLL )P This memo describes the programming language REDUCE 2 and how to use it in MTS. REDUCE 2 +is an improved version of REDUCE 1 (See CCMemo #M134) and will replace it. By the end of 1971 the +REDUCE 1 language will be removed from MTS and all those using it should switch to REDUCE 2. This +should present little trouble since the languages are similar and since REDUCE 2 is much easier to +use. Most of the annoying problems in REDUCE 1, especially error handling, have been corrected in +REDUCE 2. +)P REDUCE 2 is intended primarily as an interactive algebraic programming system. However, it +may also be used in batch mode, and it contains facilities for solving general symbolic computations +either in batch mode or interactively. +)P The bulk of this memo consists of the manual for REDUCE 2 from the Stanford Artificial Intelligence +Project. The remainder of these introductory pages describe changes made to REDUCE 2 in MTS and features +not mentioned in the manual. It should be noted that the Stanford manual was written for a version of +REDUCE 2 that uses a different character set than is available in MTS. This should be only a minor +problem since most characters used in the manual which exists in MTS have the same meaning. The +complete set of characters that are used for operators in REDUCE 2 in MTS is given below. (See page + 2-4 in the manual for Stanford's set) +)V +TABS AT 6 20 35 +GO +)LLT MTS )T OPERATOR )T CHARACTER +)LT )U Character )U )T )U Name )U )T )U used in manual )U +)LT := )T SETQ )T < +)LT & )T AND )T / +)LT | )T OR )T V +)LT ~ )T NOT )T ~ +)LT = )T EQUAL )T = +)LT ~= )T UNEQ )T = +)LT >= )T GREATEQ )T >= +)LT > )T GREATERP )T > +)LT <= )T LESSEQ )T <= +)LT < )T LESSP )T < +)LT + )T PLUS )T + +)LT - )T MINUS )T - +)LT * )T TIMES )T * +)LT / )T QUOTIENT )T / +)LT ** )T EXPT )T | +)LLLL )P There are two commands and one operator available in REDUCE 2 in MTS which are not mentioned in +the manual. +)V +TABS AT 6 20 +INDENT (5,0),(19,0) +GO +)LLT MTS; )TH2 Return control to MTS in such a way that $RESTART will return to REDUCE. Can be used to +inspect or modify files while running REDUCE. +)H2 +)LLT RETRY; )TH2 Attempt to reexecute the last REDUCE command that resulted in an error comment +during execution. Commands entered with incorrect syntax (for example missing parentheses) will not +be saved and can not be retried. +)H2 +)LLT SOLVE(L,R) )TH2 An operator with two matrix operands which will solve a set of linear equations. +L is the left hand side matrix and R in the right hand side matrix for one or more right hand sides. +)H2 +)P The remainder of this introduction consists of individual corrections to the REDUCE manual. Each +is given with a page reference. For information on running REDUCE in MTS see Appendix B. +)LLT Page 2-1: )TH2 Numbers in this version of REDUCE are limited to the range -2147483648 to 2147483647 +(-2**31 to 2**31-1) +)H2 +)LLT Page 2-2: )TH2 An identifier may be up to 80 characters long +)H2 +)LLT Page 2-4: )TH2 See the character set table above. +)H2 +)LLT Page 2-12: )TH2 The result of the evaluation of an expression is printed )U only )U if it is entered +directly in the input stream or from a file (and if it is ended with a ;). It will not be printed if +evaluated as part of a user defined operator. +)H2 +)LLT Page 2-18: )TH2 A file name for use in the IN and OUT commands can be )U either )U an identifier +)U or )U a string enclosed in quotes. For example IN FILE; or OUT "-T"; Note that if the file name +does not follow the rules for an identifier, it must be enclosed in quotes. A logical unit name (eg. +SPUNCH) can be used in an IN or OUT command. +)H2 +)LLT Page 2-18: )TH2 An output file is )U not )U erased before its first use (use the MTS command $EMPTY +for this) and additional output will be appended to the end of a file only if no intervening SHUT command +is given for it. +)H2 +)LLT Page 2-19: )TH2 IN T; will cause input to be taken from SCARDS and OUT T; will cause output to be +written on SPRINT. +)H2 +)S +)LLT Page 2-19: )TH2 The absence of a SHUT command will not cause output to be lost. +)H2 +)LLT Page 3-10: )TH2 If a long expression is output with FORT mode on, it will be broken into two or +more FORTRAN assignment statements without regard for parentheses. This will often result in an incorrect +FORTRAN statement. +)H2 +)LLT Page 6-5: )TH2 This version of LISP has no such thing as a MACRO and they can't be defined in REDUCE. +)H2 +)LLT Page A-1: )TH2 The following commands should be added to the list given: MTS, RETRY, PAUSE, CONT, +INDEX, and REMIND. +)H2 +)LLT Page C-4: )TH2 The reference to page B-2 should be to page C-2. +)H2 +)S +)LLLL )M Appendix B )M +)LLLLB.1 Running REDUCE in MTS +)P The commands necessary to run REDUCE in MTS are stored in the public file *REDUCE2. All that is +necessary to run REDUCE is +)LLTT $SOURCE *REDUCE2 +)LL This will cause the LISP interpreter to be loaded and REDUCE to be restored from a file. The process +of restoring REDUCE takes several seconds, be patient. When LISP and REDUCE have been loaded, REDUCE will +automatically be started and will print a heading identifying the version being used. The only way to get +back into LISP is to enter an END; command, errors will not cause this. +)P When the REDUCE heading is printed the system is ready for REDUCE commands. If commands are stored in a +file use the IN command to cause them to be executed. (See page 2-18). An end of file from the terminal +(or batch job) will unload REDUCE and LISP, and return to MTS. +)P An example of the use of REDUCE is in the file *REDUCE2EXAMP. To print it use the following MTS +command (in Batch) +)LLTT $COPY *REDUCE2EXAMP +)E