./LOAD 00000001 ./A AAA,INCR=1 00000002 ..LOAD 00000003 ..A AAA,INCR=1 00000004 ..LOAD 00000005 ..A AAA,INCR=1 00000006 ..LOAD 00000007 ..A AAA,INCR=1 00000008 ..LOAD 00000009 ..A AAA,INCR=1 00000010 ..LOAD 00000011 ..A AAA,INCR=1 00000012 ..LOAD 00000013 ..A AAA,INCR=1 00000014 ..LOAD 00000015 DELETE FIRST CARD AND CHANGE .. INTO ./ ON SECOND AND THIRD CARD. 00000016 ./A ANNEKE,INCR=1 00000001 ./MACRO MAINMCRO 00000002 ./MACRO EXECMCRO 00000003 TITLE 'ANNEKE' 00000004 GBLC &OVLAY 00000005 ./MACRO EXECCOM 00000006 ./MACRO MAINCOM 00000007 *** 00000008 *** 00000009 PRINT NOGEN 00000010 ANNEKE0 CSECT 00000011 EQUIVAL 00000012 ENTRY ANNEKE 00000013 EXTRN FOUT 00000014 USING EXECCOM,10 00000015 USING BLANK,11 00000016 *** EXTRACTS QUANTS OUT IPR,IPR1,ISCAL AND IEP AND PACKS THEM */ 00000017 *** AGAIN, 5 CODE PER WORD IN IT AS AN EXPR TO BE USED LATER */ 00000018 /ANNEKE PRO 00000019 SET000 T$1POINT,MBE 00000020 / SETVAL T$1COEFF,MBE,(+,IGET,0,) 00000021 SET000 L$AKEY,MBU 00000022 SET000 L$DUMNR,MBU 00000023 SET000 L$PROP,MBU 00000024 / SETVAL L$BEGIN,MBU,(+,MBE,0,) 00000025 / SET111 K,0 00000026 *** IPR1(J) CONTAINS 60 BIT EXPONENT OF J TH ALGEBRA VARIABLE. */ 00000027 / DOLOOP J,1,NALGE,1,L0001,L0002 00000028 / CMP000 IPR1,J,EQ,AN9 00000029 / SETVAL T$1CODEA,-MBE-K-,(+,ALGEBR0,0,+,J,0,) 00000030 / SETVAL K,0,(+,K,0,+,1,0,) 00000031 / SETVAL -T$1CODEA-TYPE-,-MBE-K-,(+,NUMBER,0,) EXPONENT */ 00000032 / SETVAL -T$1CODEA-NR-,-MBE-K-,(+,IPR1,J,) 00000033 / SETVAL K,0,(+,K,0,+,1,0,) 00000034 / SET000 IPR1,J 00000035 /AN9 ENDDO L0001,+1 00000036 *** ISCAL CONTAINS VECTNR,EXP OR DOTPR,EXP OR INDEX,EXP */ 00000037 *** IN /0..00403//0..00002/ FORMAT . 60 BIT EXPONENT */ 00000038 /L0002 DOLOOP J,1,NDOTI,2,L0003,L0004 00000039 / CMP000 ISCAL,J,EQ,AN15 00000040 SETVAL II5,0,(+,J,0,+,1,0,) 00000041 CMP000 ISCAL,II5,EQ,AN15 EXPONENT=0 00000042 / SETVAL T$1CODEA,-MBE-K-,(+,ISCAL,J,) VECTNR,DOTPR OR IND* 00000043 / SETVAL K,0,(+,K,0,+,1,0,) 00000044 / SETVAL -T$1CODEA-TYPE-,-MBE-K-,(+,NUMBER,0,) 00000045 : SETVAL -T$1CODEA-NR-,-MBE-K-,(+,ISCAL,II5,) EXPONENT 00000046 / SETVAL K,0,(+,K,0,+,1,0,) 00000047 /AN15 ENDDO L0003,2 00000048 /L0004 SET000 NDOTI,0 00000049 *** IPR(J)=N MEANS D(N,J) FOR N=NR OR INDEX. N(J) FOR N=VECTOR. */ 00000050 *** N IS IN /0..03402/ FORMAT */ 00000051 / DOLOOP J,1,NQX,1,L0005,L0006 NR OF INDICES */ 00000052 / SETVAL CODE5,0,(+,IPR,J,) 00000053 / CMP000 CODE5,0,LE,AN21 00000054 ** /* IPR(J)=NEGATIVE WHEN J OCCURS ODD NR OF TIMES IN IEP. * 00000055 ** /* IRRELEVANT BY NOW */ 00000056 / CMPVAL -CODE5-TYPE-,0,(+,INDEX,0,),NE,L0020 00000057 SETVAL II5,0,(+,-CODE5-NR-,0,) 00000058 SET000 IPR,II5 00000059 /AN36 SETVAL T$1CODEA,-MBE-K-,(+,D,0,) 00000060 / SETVAL K,0,(+,K,0,+,1,0,) 00000061 / SETVAL T$1CODEA,-MBE-K-,(+,CODE5,0,) 00000062 / SETVAL K,0,(+,K,0,+,1,0,) 00000063 / SETVAL T$1CODEA,-MBE-K-,(+,INDEX0,0,+,J,0,) 00000064 / SETVAL K,0,(+,K,0,+,1,0,) 00000065 / SETVAL T$1CODEA,-MBE-K-,(+,FUNCT0,0,) 00000066 / SETVAL K,0,(+,K,0,+,1,0,) 00000067 / B AN21 00000068 /L0020 CMPVAL -CODE5-TYPE-,0,(+,NUMBER,0,),EQ,AN36 NUMBER */ 00000069 / SETVAL T$1CODEA,-MBE-K-,(+,CODE5,0,) VECTOR */ 00000070 / SETVAL K,0,(+,K,0,+,1,0,) 00000071 / SETVAL T$1CODEA,-MBE-K-,(+,INDEX0,0,+,J,0,) 00000072 / SETVAL K,0,(+,K,0,+,1,0,) 00000073 /AN21 SET000 IPR,J 00000074 / ENDDO L0005,+1 00000075 L0006 SETMAX MNEPS,NEPS 00000076 SETVAL II5,0,(+,NEPS,0,+,1,0,) 00000077 SETVAL P$WORD,II5,(-,1,0,) TERMINATOR 00000078 SETVAL P$EXPR,II5,(-,1,0,) TERMINATOR 00000079 / SET000 NQA,0 00000080 / SET000 NQB,0 00000081 / SET000 MARKER,0 00000082 / SETVAL MBU5,0,(+,MBU,0,+,1,0,) 00000083 / SET000 J,0 00000084 / SET000 NEW5,0 =1 IF START OF NEW TERM HAS TO BE CREATED */ 00000085 /AGAIN1 SET000 SKIP5,0 00000086 / SET000 JUMP5,0 00000087 /AN27 SETVAL J,0,(+,J,0,+,1,0,) 00000088 CMP000 P$VAR,J,NE,L0018 00000089 CMP000 P$POINT,J,NE,JUMP2 00000090 B AN27 00000091 /L0018 CMP000 P$EXPR,J,NE,NONZ12 00000092 *** QUANTS ARE STORED IN IEP. */ 00000093 / CMP000 NEW5,0,EQ,AN29 00000094 / SET000 NEW5,0 00000095 / SET000 L$AKEY,MBU5 START NEW TERM */ 00000096 / SETVAL L$BEGIN,MBU5,(+,MBE,0,) 00000097 / SET000 L$PROP,MBU5 00000098 / SET000 L$DUMNR,MBU5 00000099 / SETVAL MBU5,0,(+,MBU5,0,+,1,0,) 00000100 / SET000 T$1POINT,MBE 00000101 SET1$0 T$1COEFF,MBE 00000102 / SET111 K,0 00000103 /AN29 CMP000 P$VAR1,J,EQ,AN37 00000104 *** EXPR WITH MULTP=0 WILL THEREFORE BE SKIPPED 00000105 / SETVAL T$1CODEA,-MBE-K-,(+,P$VAR1,J,) 00000106 / SETVAL K,0,(+,K,0,+,1,0,) 00000107 / CMP000 P$VAR2,J,EQ,AN37 00000108 / SETVAL T$1CODEA,-MBE-K-,(+,P$VAR2,J,) 00000109 / SETVAL K,0,(+,K,0,+,1,0,) 00000110 / B AN37 00000111 *** POINTER TO QUANTS IS STORED IN IEP */ 00000112 /NONZ12 CMPVAL P$WORD,J,(-,1,0,),EQ,IEPEND1 00000113 CMP000 NEW5,0,NE,L0009 00000114 FILL T$1CODEA,MBE,K,MBE 00000115 /L0009 SET111 NEW5,0 00000116 / CMPVAL P$EXPR,J,(+,256,0,),LE,L0011 00000117 / SETVAL LOC5,0,(+,P$EXPR,J,) 00000118 SET000 L1,0 00000119 SET000 L2,0 00000120 SET000 LENG5,0 00000121 / B L0012 00000122 L0011 SETVAL II5,0,(+,P$EXPR,J,) 00000123 SETVAL LOC5,0,(+,L$BEGIN,II5,) 00000124 SETVAL L1,0,(+,L$PROP,II5,) 00000125 SETVAL L2,0,(+,L$ANAME,II5,) 00000126 SETVAL LENG5,0,(+,L$LENGT,II5,) 00000127 /L0012 SETVAL MULT5,0,(+,P$MULTP,J,) 00000128 / CMP000 MULT5,0,NE,L0013 00000129 LOOK$ 'UNITY' 00000130 PRINT$ 'IEP',IEP,80 00000131 PRINT$ 'P$EXPR',P$EXPR,80 00000132 PRINT$ 'P$POINT',P$POINT,40 00000133 PRINT$ 'J',J,1 00000134 / SETVAL L$BEGIN,MBU5,(+,L$BEGIN,1,) UNIT EXPRESS */ 00000135 SET000 L$AKEY,MBU5 00000136 SET000 L$PROP,MBU5 00000137 SET000 L$DUMNR,MBU5 00000138 / SETVAL MBU5,0,(+,MBU5,0,+,1,0,) 00000139 / B AN37 00000140 /L0013 DOLOOP L,1,MULT5,1,L0021,AN37 00000141 / SETVAL L$BEGIN,MBU5,(+,LOC5,0,) 00000142 SETVAL L$PROP,MBU5,(+,L1,0,) 00000143 SETVAL L$ANAME,MBU5,(+,L2,0,) 00000144 SETVAL L$LENGT,MBU5,(+,LENG5,0,) 00000145 / SETVAL MBU5,0,(+,MBU5,0,+,1,0,) 00000146 / ENDDO L0021,+1 00000147 AN37 SET000 P$VAR,J 00000148 SET000 P$EXPR,J 00000149 / CMP000 P$POINT,J,NE,JUMP2 00000150 / B AN27 00000151 *** DEAL WITH REORDERING */ 00000152 /JUMP2 CMPVAL P$POINT,J,(+,X'FFE',0,),GE,SPINX1 00000153 / CMP000 JUMP5,0,NE,L0015 00000154 / SETVAL JUMP5,0,(+,J,0,) 00000155 /L0015 SETVAL L,0,(+,P$POINT,J,) 00000156 / SET000 P$POINT,J 00000157 / SETVAL J,0,(+,L,0,) 00000158 /AN51 CMPVAL J,0,(+,NEPS,0,),LE,L0019 00000159 / SETVAL J,0,(+,NEPS,0,) 00000160 L0019 SETVAL J,0,(+,J,0,-,1,0,) 00000161 / B AN27 00000162 /SPINX1 CMPVAL P$POINT,J,(+,X'FFE',0,),EQ,SPINX2 00000163 / SET000 P$POINT,J 00000164 / CMP000 JUMP5,0,EQ,AN27 00000165 / SETVAL J,0,(+,JUMP5,0,) 00000166 / SET000 JUMP5,0 00000167 / B AN51 00000168 /SPINX2 SET000 P$POINT,J 00000169 /AN49 CMP000 P$POINT,J,NE,L0017 00000170 / SETVAL J,0,(+,J,0,+,1,0,) SKIP */ 00000171 / B AN49 00000172 /L0017 SET111 SKIP5,0 00000173 / B AN51 00000174 IEPEND1 SETVAL L,0,(+,J,0,) 00000175 SET000 J,0 00000176 / CMP000 SKIP5,0,NE,AGAIN1 00000177 SETVAL J,0,(+,JUMP5,0,) 00000178 / CMP000 JUMP5,0,NE,AGAIN1 00000179 / CMP000 NEW5,0,NE,AN53 00000180 FILL T$1CODEA,MBE,K,MBE 00000181 AN53 SETMAX MMBU,MBU5 00000182 / CMPVAL MBU5,0,(+,NANU,0,),GT,FOA1 TOO MANY EXPRESSIONS */ 00000183 / SETVAL NAANT,LEVEL1,(+,MBU5,0,-,MBU,0,) 00000184 / SETVAL MBU,0,(+,MBU5,0,) 00000185 SET1$0 IGET,0 00000186 / CMPVAL P$WORD,L,(-,1,0,),NE,FOA1 00000187 SET000 P$VAR,L 00000188 SET000 P$EXPR,L 00000189 / SET000 NEPS,0 00000190 B XANNEKE 00000191 ** 00000192 FOA1 ERROR 1,' TOO MANY EXPRESSIONS' 00000193 FOA2 ERROR 1,' UNKNOWN ERROR' 00000194 /ANNEKE EPI 00000195 FFOUT 1,'ANNEKE' 00000196 END 00000197 ./A BOEKH,INCR=1 00000001 ./MACRO MAINMCRO 00000002 ./MACRO EXECMCRO 00000003 TITLE 'BOEKH' 00000004 GBLC &OVLAY 00000005 ./MACRO EXECCOM 00000006 ./MACRO MAINCOM 00000007 *** 00000008 *** 00000009 PRINT NOGEN 00000010 BOEKH0 CSECT 00000011 EQUIVAL 00000012 ENTRY BOEK1,BOEK2,EPSRED1 00000013 EXTRN FOUT,SSCHUIF,SNOEP 00000014 USING EXECCOM,10 00000015 USING BLANK,11 00000016 SCHUIF EQU SSCHUIF 00000017 *** CONSTRUCT D(MU,X) FROM IPR CONTENT . RENUMBER CREATED INDICES .*/ 00000018 *** ORDER ARGS OF EPF . WORK OUT I**N . COLLECT IEP CONTENT AND QUS */ 00000019 *** CORRESPONDING TO MBR LIST INTO NS=VECTOR PART . COLLECT */ 00000020 *** IPR1,ISCAL CONTENT INTO NSA=ALGEBRA PART . */ 00000021 /BOEK1 PRO 00000022 / CMP000 I1001,0,EQ,L0001 00000023 / CMP000 IPR,I1001,NE,FOUT1 00000024 ** /* PROGRAM ERROR 1001 */ 00000025 /L0001 CMP000 NQA,0,EQ,MOVE1 00000026 / SETVAL K,0,(+,NEPS,0,) 00000027 / SET000 J,0 00000028 /CR1 SETVAL J,0,(+,J,0,+,NEXTI,0,) COPY EPF TO END OF IEP */ 00000029 / CMPVAL J,0,(+,NEPS,0,),GT,CR22 00000030 / CMPVAL P$VAR,J,(+,EPF,0,),NE,CR1 00000031 CR2 SETVAL K,0,(+,K,0,+,NEXTI,0,) 00000032 / SETVAL P$WORD,K,(+,P$WORD,J,) 00000033 / SET000 P$WORD,J 00000034 / CMPVAL P$VAR,K,(+,FUNCT0,0,),EQ,CR1 00000035 / SETVAL J,0,(+,J,0,+,NEXTI,0,) 00000036 / B CR2 00000037 CR22 SETVAL NEPS,0,(+,K,0,) 00000038 MOVE1 SETMAX NCRIN,NQX CONSTRUCT D FUS FROM IPR CONTENT 00000039 / DOLOOP J,1,NQX,1,L0002,L0003 00000040 / CMP000 IPR,J,LE,MO1 ODD OCCUR OF INDEX */ 00000041 / CMPVAL -IPR-TYPE-,J,(+,VECTOR,0,),NE,L0052 00000042 SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000043 / SETVAL P$VAR,NEPS,(+,IPR,J,) P(MU)* 00000044 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000045 / SETVAL P$VAR,NEPS,(+,J,0,+,INDEX0,0,) 00000046 / B MO1 00000047 L0052 SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000048 / SETVAL P$VAR,NEPS,(+,D,0,) 00000049 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000050 / SETVAL P$VAR,NEPS,(+,J,0,+,INDEX0,0,) D(MU,NR) OR D(MU,DUM 00000051 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000052 / SETVAL P$VAR,NEPS,(+,IPR,J,) 00000053 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000054 / SETVAL P$VAR,NEPS,(+,FUNCT0,0,) 00000055 / CMPVAL -IPR-TYPE-,J,(+,INDEX,0,),NE,MO1 00000056 SETVAL II5,0,(+,-IPR-NR-,J,) 00000057 SET000 IPR,II5 D(MU,NU) 00000058 /MO1 SET000 IPR,J 00000059 / ENDDO L0002,+1 00000060 ** /* RENUMBER CREATED INDICES */ 00000061 /L0003 SET000 FLAG,0 00000062 /CR3 DOLOOP J,1,NEPS,NEXTI,L0004,L0005 00000063 SETVAL IEP5,0,(+,P$VAR,J,) 00000064 GETOPR IEP5,0,OPR5 00000065 / CMPVAL -IEP5-TYPE-,0,(+,INDEX,0,),NE,CR4 00000066 SETVAL II5,0,(+,-IEP5-NR-,0,) 00000067 CMPBIT I$PROP,II5,CREAT,OFF,CR4 00000068 *** IEP(J).DIMEN=NVIGEH(IEP5.NR).DIMEN; 00000069 LOAD 1,I$PROP,II5 00000070 SLL 1,24 CREAT BIT MAKES IT NEGATIVE. CFLAG IS OFF 00000071 STORE 1,P$DIMEN,J 00000072 / SET111 FLAG,0 00000073 /CR4 ENDDO L0004,NEXTI 00000074 L0005 SET000 M,0 00000075 / CMP000 FLAG,0,EQ,CR12 NO CREATED INDX PRESENT */ 00000076 / DOLOOP J,1,NEPS,1,L0006,CR12 00000077 CMP000 P$EXPR,J,GE,CR7 DIMEN EQU EXPR 00000078 / SET000 L,0 00000079 /CR8 SETVAL L,0,(+,L,0,+,1,0,) 00000080 / CMPBIT I$PROP,L,CREAT,OFF,CR8 00000081 LOAD 1,P$DIMEN,J TEST ON EQUAL DIMEN AND CFLAG OFF 00000082 LOAD 2,I$PROP,L 00000083 SLL 2,24 VALID TILL END OF LOOP 00000084 CR 1,2 00000085 BNE CR8 00000086 / SETBIT I$PROP,L,CFLAG,ON FIND UNUSED CREATED INDEX */ 00000087 SET000 P$DIMEN,J 00000088 / SETVAL OLD5,0,(+,P$VAR,J,) 00000089 GETOPR OLD5,0,OPR5 00000090 SETMAX M,L 00000091 / SETVAL NN,0,(+,J,0,) 00000092 STM 7,9,LOOPVAR1 00000093 /CR11 SETVAL JJ,0,(+,NN,0,) 00000094 / CMP000 P$VAR2,JJ,NE,L0054 00000095 / SETVAL P$VAR1,JJ,(+,INDEX0,0,+,L,0,) 00000096 / B L0055 00000097 /L0054 SETVAL P$VAR2,JJ,(+,INDEX0,0,+,L,0,) 00000098 L0055 SET000 P$DIMEN,JJ 00000099 / DOLOOP NN,JJ,NEPS,1,L0056,CR6 00000100 *** IF IEP(NN).DIMEN NE NVIGEH(L).DIMEN THEN GOTO CR10; 00000101 LOAD 1,P$DIMEN,NN 00000102 CR 1,2 00000103 BNE CR10 00000104 / SETVAL IEP5,0,(+,P$WORD,NN,) 00000105 GETOPR IEP5,0,OPR5 00000106 / CMPVAL IEP5,0,(+,OLD5,0,),EQ,CR11 00000107 /CR10 ENDDO L0056,+1 00000108 CR6 LM 7,9,LOOPVAR1 00000109 /CR7 ENDDO L0006,+1 00000110 CR12 SETVAL II5,0,(+,M,0,+,2,0,) 00000111 DOLOOP J,1,II5,1,L0010,L0011 00000112 / SETBIT I$PROP,J,CFLAG,OFF 00000113 / ENDDO L0010,+1 00000114 L0011 SETMAX CRIND,M 00000115 / CMP000 NQA,0,EQ,L0012 00000116 / SETVAL EPSM1,0,(-,NEPS,0,) 00000117 / CCALL EPSRED1 00000118 /L0012 CMP000 IGET,0,NE,L0013 00000119 / CCALL BOEK2 00000120 B XBOEK1 00000121 /L0013 SETVAL NTEM,0,(+,NTEM,0,+,1,0,) 00000122 *** IF MOD(NTEM,2**13) = 0 THEN CALL SNOEP; /* PRINT STATISTIC* 00000123 L 1,NTEM 00000124 SLL 1,19 00000125 LTR 1,1 00000126 BNZ L0014 00000127 / CCALL SNOEP PRINT STATISTIC*/ 00000128 L0014 LOAD 1,IPR1,1 00000129 *** WORK OUT POWERS OF I . 00000130 *** K=BITS(IPR1(1),59,60); /* POWERS OF I */ 00000131 *** ELSE DO; IGET=IGET*BITS(K,31,31); /* FOR IBM */ 00000132 *** IPR1(1)=BITS(K,32,32); 00000133 SLL 1,30 00000134 LTR 1,1 00000135 BNZ L0015 00000136 SET000 IPR1,1 00000137 B A3IM7 00000138 L0015 LR 2,1 00000139 SRL 1,31 00000140 SLL 1,31 00000141 X 1,IGET 00000142 ST 1,IGET 00000143 SLL 2,1 00000144 SRL 2,31 00000145 STORE 2,IPR1,1 00000146 ** /* FILL VECTOR STORE (=NS) WITH CONTENT OF IEP AND QUS */ 00000147 ** /* OUTSIDE BRACKETS */ 00000148 /A3IM7 SETVAL K,0,(+,3,0,) 00000149 ** /* LEAVE ROOM FOR LENGTH,FILE NR */ 00000150 / DOLOOP J,1,NEPS,1,L0017,FL1ES 00000151 / CMP000 P$VAR1,J,EQ,FL7EQ 00000152 / SETVAL NS,K,(+,P$VAR1,J,) 00000153 / SETVAL K,0,(+,K,0,+,1,0,) 00000154 / CMP000 P$VAR2,J,EQ,FL7EQ 00000155 / SETVAL NS,K,(+,P$VAR2,J,) 00000156 / SETVAL K,0,(+,K,0,+,1,0,) 00000157 FL7EQ SET000 P$VAR,J 00000158 / ENDDO L0017,+1 00000159 /FL1ES DOLOOP J,1,NBR,1,L0021,FL2ES 00000160 / CMPVAL -MBR$C-TYPE-,J,(+,ALGEBR,0,),NE,L0060 00000161 SETVAL II5,0,(+,-MBR$C-NR-,J,) 00000162 CMP000 IPR1,II5,EQ,FL2BU 00000163 SETVAL NS,K,(+,MBR$C,J,) 00000164 SETVAL K,0,(+,K,0,+,1,0,) 00000165 SETVAL -NS-NR-,K,(+,IPR1,II5,) 00000166 SETVAL -NS-TYPE-,K,(+,NUMBER,0,) 00000167 SET000 IPR1,II5 00000168 SETVAL K,0,(+,K,0,+,1,0,) 00000169 / B FL2BU 00000170 L0060 STM 7,9,LOOPVAR1 00000171 / DOLOOP L,1,NDOTI,2,L0061,FL3BU 00000172 SETVAL II5,0,(+,L,0,+,1,0,) 00000173 CMP000 ISCAL,II5,EQ,BR2DP EXPONENT=0 00000174 / CMPVAL ISCAL,L,(+,MBR$C,J,),NE,BR2DP 00000175 / SETVAL NS,K,(+,ISCAL,L,) 00000176 SETVAL K,0,(+,K,0,+,1,0,) 00000177 SETVAL -NS-NR-,K,(+,ISCAL,II5,) EXPONENT 00000178 SETVAL -NS-TYPE-,K,(+,NUMBER,0,) 00000179 SET000 ISCAL,II5 00000180 SETVAL K,0,(+,K,0,+,1,0,) 00000181 / B FL3BU 00000182 /BR2DP ENDDO L0061,2 00000183 FL3BU LM 7,9,LOOPVAR1 00000184 /FL2BU ENDDO L0021,+1 00000185 /FL2ES FILL NS,0,K,NP 00000186 PUTLEN NS,1,NP,0 00000187 / SETVAL NS,2,(+,VECTNR0,0,+,NASFF,0,) 00000188 / CMP000 NDOTI,0,EQ,DOT8P 00000189 ** /* ORDER QUS INSIDE ISCAL. SMALLEST FIRST . DELETE QUS**0 */ 00000190 ** /* MAKE EXPONENTS IN NUMBER0 FORMAT */ 00000191 / SET000 COUNT5,0 00000192 / DOLOOP J,1,NDOTI,2,L0023,L0024 00000193 SETVAL IJ5,0,(+,J,0,+,1,0,) 00000194 CMP000 ISCAL,IJ5,NE,L0063 00000195 / SETVAL COUNT5,0,(+,COUNT5,0,+,2,0,) 00000196 / B HX1A 00000197 L0063 SETVAL II5,0,(+,J,0,+,2,0,) 00000198 STM 7,9,LOOPVAR1 00000199 DOLOOP K,II5,NDOTI,2,L0064,L0065 00000200 : CMPVAL ISCAL,K,(+,ISCAL,J,),GE,HX3A 00000201 SETVAL IK5,0,(+,K,0,+,1,0,) 00000202 CMP000 ISCAL,IK5,EQ,HX3A 00000203 LOAD 1,ISCAL,K EXCHANGE 00000204 LOAD 2,ISCAL,J 00000205 STORE 1,ISCAL,J 00000206 STORE 2,ISCAL,K 00000207 LOAD 1,ISCAL,IK5 00000208 LOAD 2,ISCAL,IJ5 00000209 STORE 1,ISCAL,IJ5 00000210 STORE 2,ISCAL,IK5 00000211 /HX3A ENDDO L0064,2 00000212 L0065 SETVAL II5,0,(+,J,0,+,1,0,-,COUNT5,0,) 00000213 SETVAL -ISCAL-NR-,II5,(+,ISCAL,IJ5,) 00000214 SETVAL -ISCAL-TYPE-,II5,(+,NUMBER,0,) 00000215 SETVAL II5,0,(+,J,0,-,COUNT5,0,) 00000216 SETVAL ISCAL,II5,(+,ISCAL,J,) 00000217 LM 7,9,LOOPVAR1 00000218 /HX1A ENDDO L0023,2 00000219 /L0024 SETVAL NDOTI,0,(+,NDOTI,0,-,COUNT5,0,) 00000220 DOT8P SETVAL K,0,(+,2,0,) 00000221 ** /* BRING IPR1 CONTENT TO NSA */ 00000222 / DOLOOP J,1,NALGE,1,L0025,L0026 00000223 / CMP000 IPR1,J,EQ,L0066 00000224 / SETVAL NSA,K,(+,J,0,+,ALGEBR0,0,) 00000225 SETVAL K,0,(+,K,0,+,1,0,) 00000226 SETVAL -NSA-NR-,K,(+,IPR1,J,) 00000227 SETVAL -NSA-TYPE-,K,(+,NUMBER,0,) 00000228 SETVAL K,0,(+,K,0,+,1,0,) 00000229 / SET000 IPR1,J 00000230 /L0066 ENDDO L0025,+1 00000231 /L0026 CMP000 NDOTI,0,EQ,X1ADP 00000232 ** /* BRING ISCAL CONTENT TO NSA */ 00000233 / DOLOOP J,1,NDOTI,1,L0027,X1ADP 00000234 / SETVAL NSA,K,(+,ISCAL,J,) 00000235 / SETVAL K,0,(+,K,0,+,1,0,) 00000236 / ENDDO L0027,+1 00000237 /X1ADP FILL NSA,0,K,NA 00000238 PUTLEN NSA,1,NA,0 00000239 / CMPVAL NA,0,(+,LTERM,0,),GE,FOUT2 00000240 / CMPVAL NP,0,(+,LTERM,0,),GE,FOUT2 00000241 / SET000 NDOTI,0 00000242 / SET000 NEPS,0 00000243 / SET000 NQA,0 00000244 / SET000 NQB,0 00000245 / SET000 MARKER,0 00000246 *** BRING IGET IN STANDARD FORM. POSSIBLY NORMALIZE OR TEST 00000247 *** ON UNDER OR OVERFLOW 00000248 CMP000 IGET,0,NE,L0067 00000249 SET0$0 IGET,0 FULL FLOAT.P ZERO 00000250 /L0067 CCALL SCHUIF 00000251 SET1$0 IGET,0 00000252 B XBOEK1 00000253 FOUT1 ERROR 1,' PROGRAM ERROR 1001' 00000254 FOUT2 ERROR 1,' TERM TOO LONG' 00000255 /BOEK1 EPI 00000256 DS 0H 00000257 USING *,15 00000258 BOEK2 DOLOOP J,1,NEPS,1,L0028,L0029 00000259 SET000 P$POINT,J 00000260 SET000 P$EXPR,J 00000261 ENDDO L0028,+1 00000262 /L0029 SET000 NEPS,0 INITIALIZE */ 00000263 / SET000 NDOTI,0 00000264 / SET000 NQA,0 00000265 / SET000 NQB,0 00000266 / SET000 MARKER,0 00000267 / DOLOOP J,1,NQX,1,L0008,L0009 00000268 / SET000 IPR,J 00000269 / ENDDO L0008,+1 00000270 /L0009 DOLOOP J,1,NALGE,1,L0018,L0019 00000271 / SET000 IPR1,J 00000272 / ENDDO L0018,+1 00000273 L0019 SET1$0 IGET,0 00000274 / BR 14 00000275 FFOUT 1,'BOEKH' 00000276 LTORG 00000277 ** 00000278 DS 0H 00000279 USING *,15 00000280 *** ROUTINE FOR EPSILON REDUCTION */ 00000281 /EPSRED1 SET000 JJ,0 00000282 / DOLOOP J,NEPS,1,-1,L0035,L0036 00000283 / CMPVAL P$VAR,J,(+,EPF,0,),NE,EP1 FIND FIRST EPF */ 00000284 / SETVAL JJ,0,(+,J,0,) 00000285 /EP2 SETVAL JJ,0,(+,JJ,0,+,1,0,) 00000286 GETMIN P$VAR,JJ,EP3,EPFO1 00000287 / NEGATE IGET,0 00000288 /EP3 CMPVAL P$VAR1,JJ,(+,FUNCT0,0,),NE,EP2 00000289 ** /* FIND END OF FUNCTION */ 00000290 / SETVAL P$ARGNR,J,(+,JJ,0,-,J,0,-,1,0,) NR OF ARGS */ 00000291 SETVAL K1,0,(+,J,0,) 00000292 L0074 SETVAL K1,0,(+,K1,0,+,1,0,) 00000293 CMPVAL K1,0,(+,JJ,0,),GE,EP1 00000294 SETVAL K2,0,(+,K1,0,) 00000295 EP5 SETVAL K2,0,(+,K2,0,+,1,0,) 00000296 CMPVAL K2,0,(+,JJ,0,),GE,L0074 00000297 CMPVAL P$VAR,K1,(+,P$VAR,K2,),LT,EP5 00000298 LOAD 1,P$VAR,K1 EXCHANGE 00000299 LOAD 2,P$VAR,K2 00000300 STORE 1,P$VAR,K2 00000301 STORE 2,P$VAR,K1 00000302 NEGATE IGET,0 00000303 CMPVAL P$VAR,K1,(+,P$VAR,K2,),NE,EP5 00000304 SET000 IGET,0 00000305 B EPEX1 00000306 /EP1 ENDDO L0035,-1 00000307 L0036 CMP000 JJ,0,EQ,RETURN 00000308 CMP000 EPSM1,0,LT,L0037 00000309 / SET000 K1,0 00000310 / B EP9 00000311 /L0037 DOLOOP J,1,NEPS,1,L0040,EPEX1 REMOVE ARG COUNT */ 00000312 / CMPVAL P$VAR1,J,(+,EPF,0,),NE,L0071 00000313 / SET000 P$ARGNR,J 00000314 /L0071 ENDDO L0040,+1 00000315 /EPEX1 SET000 EPSM1,0 00000316 / BR 14 00000317 ** /* TRICK IS REQUESTED */ 00000318 /EP9 SETVAL K1,0,(+,K1,0,+,1,0,) REDUCE PAIRS OF EPF S */ 00000319 / CMPVAL P$VAR1,K1,(+,EPF,0,),NE,EP8 00000320 / SETVAL EPDAT1,0,(+,K1,0,) 00000321 / SETVAL JJ,0,(+,K1,0,+,P$ARGNR,K1,) 00000322 SETVAL II5,0,(+,JJ,0,+,2,0,) 00000323 DOLOOP K2,II5,NEPS,1,L0043,LL001 00000324 CMPVAL P$VAR,K2,(+,P$VAR,K1,),EQ,EP99 00000325 ** /* COMPARE FU AND NR OF ARGS */ 00000326 / ENDDO L0043,+1 00000327 LL001 SET000 P$ARGNR,K1 00000328 /EP8 CMPVAL K1,0,(+,NEPS,0,),LT,EP9 00000329 ** /* NEPS IS INCREMENTED WHEN NEW DELTAS ARE ADDED */ 00000330 / B EPEX1 00000331 /EP99 SETVAL K3,0,(+,K1,0,) 00000332 SET000 P$ARGNR,K1 00000333 / SETVAL NEPS5,0,(+,NEPS,0,+,1,0,) 00000334 / SET000 PAIRS,0 SECOND EPF FOUND */ 00000335 /EP10 SETVAL K3,0,(+,K3,0,+,1,0,) POINTER ALONG ARGS OF FIRST EPF 00000336 / CMPVAL -P$VAR1-TYPE-,K3,(+,INDEX,0,),NE,EP12 00000337 / SETVAL K4,0,(+,K2,0,+,PAIRS,0,) POINTER ALONG ARGS OF SECON 00000338 EP11 SETVAL K4,0,(+,K4,0,+,1,0,) 00000339 CMPVAL P$VAR,K3,(+,P$VAR,K4,),LT,EP10 00000340 : CMPVAL P$VAR,K3,(+,P$VAR,K4,),NE,EP11 00000341 / SET000 P$WORD,K3 00000342 / SET000 P$WORD,K4 00000343 / SETVAL PAIRS,0,(+,PAIRS,0,+,1,0,) EQUAL ARG PAIR FOUND */ 00000344 / SETVAL SIGN5,0,(+,K3,0,-,K1,0,+,K4,0,-,K2,0,) RELAT DISPLAC 00000345 *** COMPARE EPF(A,B,L,M)*EPF(N,R,A,B) WITH EPF(A,B,L,M)*EPF(A,B,N,R) */ 00000346 *** IGET=IGET*PAIRS*(-1)**SIGN5; 00000347 LOAD 4,IGET,0 00000348 FLOAT 0,PAIRS,0 00000349 MULTP 00000350 STORE 0,IGET,0 00000351 ** /* BUILTS UP FACTORIAL IN FRONT OF DELTAS */ 00000352 IFEVEN SIGN5,0,EP10 00000353 NEGATE IGET,0 00000354 / B EP10 00000355 /EP12 SETVAL P$VAR,NEPS5,(+,DKEY,0,) MAKE KEY WITH ARGS THAT ARE 00000356 ** NOT PAIRED. 00000357 / SETVAL K3,0,(+,K1,0,) DELETE EPF AND ARGS */ 00000358 SET000 P$WORD,K1 00000359 /EP13 SETVAL K3,0,(+,K3,0,+,1,0,) 00000360 / CMP000 P$WORD,K3,EQ,EP13 ARGS OF FIRST EPF */ 00000361 / CMPVAL P$VAR,K3,(+,FUNCT0,0,),EQ,EP14A 00000362 / SETVAL NEPS5,0,(+,NEPS5,0,+,1,0,) 00000363 / SETVAL P$WORD,NEPS5,(+,P$WORD,K3,) 00000364 / SET000 P$WORD,K3 00000365 / B EP13 00000366 /EP14A SETVAL K4,0,(+,K2,0,) 00000367 SET000 P$WORD,K2 00000368 / SET000 P$WORD,K3 00000369 /EP14B SETVAL K4,0,(+,K4,0,+,1,0,) ARGS OF SECOND EPF */ 00000370 / CMP000 P$WORD,K4,EQ,EP14B 00000371 / CMPVAL P$VAR,K4,(+,FUNCT0,0,),EQ,EP14C 00000372 / SETVAL NEPS5,0,(+,NEPS5,0,+,1,0,) 00000373 / SETVAL P$WORD,NEPS5,(+,P$WORD,K4,) 00000374 / SET000 P$WORD,K4 00000375 / B EP14B 00000376 /EP14C SET000 P$WORD,K4 00000377 / SETVAL COUNT5,0,(+,NEPS5,0,-,NEPS,0,-,1,0,) NR OF ARGS=2*(N 00000378 IFEVEN COUNT5,0,EP14D ODD NUMBER OF ARGS 00000379 B EPFO1 00000380 /EP14D SETVAL K1,0,(+,K4,0,) POSITION BEHIND SECOND EPF */ 00000381 / CMP000 COUNT5,0,EQ,EP8 00000382 / SET111 MARKER,0 00000383 ** /* ALL INDICES CONTRACTED */ 00000384 / CMPVAL COUNT5,0,(+,2,0,),NE,EP15 00000385 SETVAL II5,0,(+,NEPS,0,+,1,0,) 00000386 SETVAL P$VAR,II5,(+,D,0,) 00000387 / SETVAL NEPS,0,(+,NEPS5,0,) DKEY BECOMES DELTA FUNCTION */ 00000388 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000389 / SETVAL P$WORD,NEPS,(+,FUNCT0,0,) 00000390 / B EP8 00000391 /EP15 SETVAL NEPS,0,(+,NEPS5,0,) 00000392 / CMPVAL COUNT5,0,(+,4,0,),NE,L0045 00000393 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000394 ** /* FORMULA WITH 2 DELTAS */ 00000395 / SETVAL P$EXPR,NEPS,(+,8,0,) 00000396 / SET111 P$MULTP,NEPS 00000397 / SET000 P$POINT,NEPS 00000398 / B EP8 00000399 L0045 L 1,COUNT5 COUNT5=COUNT5/2 00000400 SRA 1,1 00000401 ST 1,COUNT5 00000402 / SETVAL B3,0,(+,COUNT5,0,) NR OF DUMMIES IN SUPERKEY */ 00000403 /EP16 CMPVAL B3,0,(+,3,0,),NE,EP18 00000404 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000405 / SETVAL P$EXPR,NEPS,(+,7,0,) FORMULA WITH SKEY FOR 3 DELTAS 00000406 / SET111 P$MULTP,NEPS 00000407 / SET000 P$POINT,NEPS 00000408 / DOLOOP K4,1,COUNT5,1,L0046,L0047 NR OF DELTA FUNCTIONS */ 00000409 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000410 / SETVAL P$WORD,NEPS,(+,D,0,) 00000411 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000412 / SETVAL P$WORD,NEPS,(+,K4,0,+,DUMMY0,0,) 00000413 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000414 / SETVAL P$WORD,NEPS,(+,COUNT5,0,+,K4,0,+,DUMMY0,0,) 00000415 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000416 / SETVAL P$WORD,NEPS,(+,FUNCT0,0,) 00000417 / ENDDO L0046,+1 00000418 /L0047 SETVAL K1,0,(+,EPDAT1,0,+,1,0,) 00000419 / B EP8 00000420 ** 00000421 *** FOR B3=6 THE FOLLOWING SKEYS ARE GENERATED. */ 00000422 *** SKEY 1 2 3 4 5 6 + SKEY 1 2 3 4 6 5 + SKEY 1 2 3 6 5 4 */ 00000423 *** + SKEY 1 2 6 4 5 3 + SKEY 1 6 3 4 5 2 + SKEY 6 2 3 4 5 1 */ 00000424 *** SKEY 1 2 3 4 5 + SKEY 1 2 3 5 4 + SKEY 1 2 5 4 3 + SKEY 1 5 3 4 2 * 00000425 *** + SKEY 5 2 3 4 1 */ 00000426 *** SKEY 1 2 3 4 + SKEY 1 2 4 3 + SKEY 1 4 3 2 + SKEY 4 2 3 1 */ 00000427 *** THE SEQUENCE DKEY N1 N2 .. N12,SKEY S ,$7,A(1,7)*A(2,8)..A(6,12) * 00000428 *** GIVES THE EVALUATION OF THE DETERMINANT WITH ELEMENTS */ 00000429 *** A(N1,N7) A(N1,N8) ... A(N1,N12) */ 00000430 *** .. ..... */ 00000431 *** A(N6,N7) A(N6,N8) ... A(N6,N12) */ 00000432 EP18 SETVAL B3,0,(+,COUNT5,0,+,1,0,) 00000433 L0050 SETVAL B3,0,(+,B3,0,-,1,0,) 00000434 SETVAL MBE5,0,(+,MBE,0,) 00000435 CMPVAL B3,0,(+,3,0,),LE,EP16 00000436 SET1$0 T$1COEFF,MBE 00000437 SETVAL B2,0,(+,B3,0,) 00000438 B L0076 00000439 L0072 SETVAL B2,0,(+,B2,0,-,1,0,) 00000440 CMP000 B2,0,LE,L0073 00000441 SDR 2,2 00000442 LD 0,=D'-1.0' 00000443 STORE 0,T$1COEFF,MBE 00000444 SETVAL T$1POINT,EP5MBE,(+,MBE,0,) 00000445 /L0076 SETVAL T$1CODEA,-MBE-1-,(+,SKEY,0,) 00000446 / SETVAL SHIFT,0,(+,2,0,) 00000447 / SETVAL EP5MBE,0,(+,MBE,0,) 00000448 SET000 B1,0 00000449 L0100 SETVAL B1,0,(+,B1,0,+,1,0,) 00000450 CMPVAL B1,0,(+,B3,0,),GE,L0101 00000451 CMPVAL B1,0,(+,B2,0,),NE,LL002 00000452 SETVAL T$1CODEA,-MBE-SHIFT-,(+,B3,0,+,DUMMY0,0,) 00000453 B LL003 00000454 LL002 SETVAL T$1CODEA,-MBE-SHIFT-,(+,B1,0,+,DUMMY0,0,) 00000455 LL003 SETVAL SHIFT,0,(+,SHIFT,0,+,1,0,) 00000456 B L0100 00000457 L0101 SETVAL T$1CODEA,-MBE-SHIFT-,(+,B2,0,+,DUMMY0,0,) 00000458 SETVAL SHIFT,0,(+,SHIFT,0,+,1,0,) 00000459 / FILL T$1CODEA,MBE,SHIFT,MBE 00000460 / B L0072 00000461 /L0073 SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000462 / SET111 P$MULTP,NEPS 00000463 / SETVAL P$EXPR,NEPS,(+,MBE5,0,) 00000464 / SET000 P$POINT,NEPS 00000465 SET000 T$1POINT,EP5MBE 00000466 / B L0050 00000467 EPFO1 ERROR 2,' ILLEGAL EPF ARGUMENT' 00000468 *** MACRO INDCR 00000469 XFO1 ERROR 2,' TOO MANY CREATED INDICES' 00000470 FFOUT 2,'EPSRED' 00000471 END 00000472 ./A EXECFTN,INCR=1 00000001 SUBROUTINE EXEC 00000002 C LAY2(1)=0 CALL GLADYS. 00000003 C LAY2(1)=1,-1 CALL REPEAT AFTER * YEP , R INPUT . 00000004 CALL EXEC1 00000005 RETURN 00000006 END 00000007 SUBROUTINE BRIAN(X,Y,N) 00000008 REAL*16 X,Y 00000009 X=X*Y**N 00000010 RETURN 00000011 END 00000012 SUBROUTINE EXTRA(I,A,R) 00000013 DIMENSION I(10),A(5) 00000014 REAL*16 A,R,A1 00000015 IF ( I(1) ) 1,2,3 00000016 3 R=1. 00000017 I2=I(2) 00000018 DO 4 I1=1,I2 00000019 A1=I1 00000020 4 R=R*A1 00000021 2 RETURN 00000022 1 R=A(1)**I(2) 00000023 RETURN 00000024 END 00000025 ./A GLADYS,INCR=1 00000001 ./MACRO MAINMCRO 00000002 ./MACRO EXECMCRO 00000003 TITLE 'GLADYS' 00000004 GBLC &OVLAY 00000005 ./MACRO EXECCOM 00000006 ./MACRO MAINCOM 00000007 *** 00000008 *** 00000009 PRINT NOGEN 00000010 GLADYS0 CSECT 00000011 EQUIVAL 00000012 EXTRN INSER1,INSER2,MARTYN1,BOEK1,BOEK2,SSCHUI2,TAKMAN,UNCF 00000013 EXTRN ANNEKE,FOUT 00000014 ENTRY EXEC1 00000015 SCHUI2 EQU SSCHUI2 00000016 EXEC1 PROLOGH 00000017 L 10,=V(EXECCOM) INITIALIZE OVERLAY 00000018 USING EXECCOM,10 00000019 STORE 10,COMADR,1 00000020 ST 5,LAYNR ADDRESS OF SAVEAREA 00000021 / SETCAR LAYNAM$D,0,C'EXEC',4 00000022 / SETVAL LAYNAM$V,0,(+,2,0,) OVERLAY 2 IS EXEC 00000023 / SET000 MNEPS,0 00000024 / SET000 BBUFX,1 DELETE CONTENT OF BUFFERS */ 00000025 / SET000 IIDGEHX,1 00000026 / DOLOOP J,1,36,1,L0001,L0002 00000027 / SET000 VOLUM,J 00000028 / BXLE 7,8,L0001 00000029 /L0002 SETADR NDIMU,0,(+,BBUFX,1,-,3*LFLOAT,0,) 00000030 LADR 9,EXECCO1,1 END OF /EXECCOM/ 00000031 LR 7,10 BEGIN OF /EXECCOM/ 00000032 LA 8,NEXTW 00000033 LL001 ST 0,0(7) SET /EXECCOM/ TO ZERO 00000034 BXLE 7,8,LL001 00000035 SETADR ADRIEP,0,(+,IEP,1,-,NEXTW,0,) 00000036 / CCALL BOEK2 00000037 / CMP000 LAY2,0,NE,L0005 00000038 BAL 14,GLADYS OTHER * CARDS. 00000039 / B L0006 00000040 L0005 BAL 14,REPEAT * YEP , R-INPUT. 00000041 /L0006 CMP000 NTEMA,0,EQ,XEXEC1 00000042 / SETVAL NTEMA,0,(+,NTEMA,0,-,1,0,) 00000043 / CCALL SCHUI2 EMPTIES OUTPUT OVERFLOW BUFFERS */ 00000044 XEXEC1 EPILOGH 00000045 SAVEFTN DS 18F 00000046 ** 00000047 GLADYS ST 14,GLADYSX 00000048 / SET000 MARKER,0 00000049 / SET111 A37JO,0 00000050 / CMP000 KKUIT,0,EQ,XGLADYS NOTHING TO EVALUATE */ 00000051 / SETVAL MBUWW,0,(+,MBU,0,) 00000052 / SETVAL MBEWW,0,(+,MBE,0,) 00000053 /A32Q1 SET111 NAANT,1 LOOP OVER ALL Z-EXPRESSIONS */ 00000054 / SETVAL NASFF,0,(+,T$ZZFIL,-NFFO-A37JO-,) 00000055 / SETVAL H$MBU,1,(+,T$ZZLOC,-NFFO-A37JO-,) 00000056 / SET000 H$MBE,1 00000057 / SET000 H$MULT,1 00000058 / SET000 LEVEL,0 00000059 SET111 LEVEL1,0 00000060 / SETVAL LEVBUF1,0,(+,50,0,) 00000061 / SETVAL LEVBUF2,0,(+,50,0,) BOTH BUFFERS FREE */ 00000062 / SET000 G$MBE,1 00000063 / SETVAL G$INDEX,1,(+,NQX,0,) 00000064 LA 4,FLOP 00000065 STORE 4,G$RETUR,1 00000066 / B HUP4 00000067 /FLOP SETVAL MBE,0,(+,MBEWW,0,) START NEW Z-EXPRESSION */ 00000068 / SETVAL MBU,0,(+,MBUWW,0,) 00000069 / SETVAL A37JO,0,(+,A37JO,0,+,1,0,) 00000070 / CMPVAL A37JO,0,(+,KKUIT,0,),LE,A32Q1 00000071 XGLADYS L 14,GLADYSX EPILOGH 00000072 BR 14 00000073 GLADYSX DS 1F 00000074 ** 00000075 REPEAT ST 14,GLADYSX 00000076 / SET000 YTERM,0 00000077 / SETVAL MBUWW,0,(+,MBU,0,) 00000078 / SETADR MBE,0,(+,T$0NEXTW,MBE,) NOT UNDERSTOOD */ 00000079 / SETVAL MBEWW,0,(+,MBE,0,) 00000080 / SETADR START,0,(+,IDGEHX,1,) 00000081 /SO270 PTAKMAN NTAP6,START,DUMMM,READ0 NEXT RECORD */ 00000082 / SETADR MBE1F,0,(+,B$0VECTS,START,+,NEXTW,0,) 00000083 /SO270A SET000 LEVBUF1,0 BUFFER USED */ 00000084 ** /* CAN THE LEVBUF STATEMENTS BE TAKEN OUTSIDE THE LOOP???*/ 00000085 / SETVAL MBE4,0,(+,MBE1F,0,+,T$1POINT,MBE1F,) NEW VECTOR */ 00000086 / SETVAL NASFF,0,(+,T$1CODEA,-MBE1F-2-,-,VECTNR0,0,) FILE NUM 00000087 /SO270B SETVAL MBU,0,(+,MBUWW,0,) INSERT TERM */ 00000088 / SETVAL MBE,0,(+,MBEWW,0,) 00000089 / SETVAL LEVBUF2,0,(+,50,0,) SECOND BUFFER FREE. ANY NUMBER?? 00000090 / PINSER1 MBE1F 00000091 / CMP000 IGET,0,EQ,L0024 00000092 / PINSER1 MBE4 00000093 /L0024 DOLOOP J,1,NEPS,1,L0025,CALSUB2 00000094 / CMPVAL -P$VAR1-TYPE-,J,(+,EXPRES,0,),EQ,FOS12 00000095 / CMPVAL -P$VAR2-TYPE-,J,(+,EXPRES,0,),EQ,FOS12 00000096 ** /* EXPRES AS FUNCT ARGUMENT IN OUTPUT */ 00000097 ENDDO L0025,+ 00000098 /CALSUB2 SET000 LEVEL,0 00000099 SET111 LEVEL1,0 00000100 / SET000 MARKER,0 00000101 / SETVAL NQX,0,(+,NVIND,0,) 00000102 / SETVAL YTERM,0,(+,YTERM,0,+,1,0,) 00000103 / CMP000 IGET,0,NE,SO272 NO COUNT WHEN TERM=0 */ 00000104 / CMP000 LAY2,1,LT,SO272 JP IF R-INPUT */ 00000105 / SETVAL YTERM,0,(+,YTERM,0,-,1,0,) 00000106 SO272 LA 4,SO270C 00000107 STORE 4,BACK,0 00000108 B HELENE 00000109 /SO270C SETVAL MBE4,0,(+,MBE4,0,+,T$1POINT,MBE4,) 00000110 / CMP000 T$0WORD,MBE4,NE,SO270B NEXT ALGEBRA */ 00000111 / SETADR MBE1F,0,(+,T$0NEXTW,MBE4,) NEXT VECTOR */ 00000112 / CMP000 T$0WORD,MBE1F,EQ,SO270 GET NEXT RECORD*/ 00000113 / CMP111 T$0WORD,MBE1F,EQ,SO270 GET NEXT RECORD*/ 00000114 / CMPVAL T$0WORD,MBE1F,(-,1,0,),EQ,XREPEAT END OF FILE 00000115 / B SO270A NEXT VECTOR */ 00000116 FOS12 ERROR 1,' EXPRESSION AS FUNCTION ARGUMENT IN OUTPUT' 00000117 XREPEAT L 14,GLADYSX EPILOGH 00000118 BR 14 00000119 ** 00000120 /HELENE SETVAL MBE11,0,(+,MBE,0,) 00000121 / SETVAL LEVEL,0,(+,LEVEL,0,+,1,0,) 00000122 SETVAL LEVEL1,0,(+,LEVEL1,0,+,1,0,) 00000123 *** FOR EASY ADDRESSING IN ARRAYS, LEVEL1=LEVEL+1 WILL BE USED, */ 00000124 / SET000 G$MBE,LEVEL1 00000125 / SETVAL G$INDEX,LEVEL1,(+,NQX,0,) 00000126 / SETVAL G$RETUR,LEVEL1,(+,BACK,0,) 00000127 / CMP000 NQB,0,EQ,GLA2 JP IF NO SPECIAL FUNCTIONS */ 00000128 / PINSER2 NQB WORK OUT SPECIAL FUNCTIONS */ 00000129 / CMP000 IGET,0,EQ,HUP8B 00000130 /GLA2 CMPVAL LEVEL,0,(+,MAXID,0,),LT,HUP1 00000131 / CMP000 MARKER,0,NE,L0007 00000132 / CCALL BOEK1 00000133 / B EIND1 00000134 ** /* NORMAL EXIT. MULTPL OF 1 TERM OF */ 00000135 ** /* EACH EXPRESSION IS FINISHED */ 00000136 /L0007 CMPVAL LEVEL,0,(+,40,0,),LT,HUP3 00000137 / B GFO1 MORE THAN 40 SUBSTITUTIONS */ 00000138 /HUP1 CMP000 MARKER,0,NE,HUP3 NO SUBSTIT PERFORMED */ 00000139 CMP000 NID$FST,LEVEL1,NE,HUP3 00000140 HUP2 LA 4,EIND1 00000141 STORE 4,BACK,0 00000142 / B HELENE 00000143 HUP3 CMP000 NID$FST,LEVEL1,EQ,HUP8B 00000144 / CCALL MARTYN1 00000145 /HUP8B SETVAL H$MBE,LEVEL1,(+,MBE11,0,) 00000146 / SET000 H$MULT,LEVEL1 00000147 / SETVAL H$MBU,LEVEL1,(+,MBU,0,) 00000148 / CMP000 IGET,0,NE,L0011 00000149 / CCALL BOEK2 00000150 / B EIND1 00000151 /L0011 SET000 NAANT,LEVEL1 00000152 / CMP000 MARKER,0,EQ,HUP2 00000153 / CCALL ANNEKE 00000154 / SETVAL MBU,0,(+,H$MBU,LEVEL1,) 00000155 /HUP4 CMP000 NAANT,LEVEL1,EQ,HUP3 00000156 *** MULTIPLICATION OF EXPRESSIONS. EACH EXPRESSION HAS A LOC . THE * 00000157 *** FIRST ONE IS AT MBUW(LEVEL1).MBU . THE NEXT ONE IS IN THE NEXT * 00000158 *** LOC . THERE ARE NAANT(LEVEL1) EXPRESSIONS IN TOTAL. FOR EACH * 00000159 *** EXPR. TWO MULTIPLICATION POINTERS ARE SET UP( INITIAL VALUE AND 00000160 *** CURRENT VALUE ) . THEY POINT AT TERMS IN THE EXPRESSION OR , IN * 00000161 *** THE CASE OF FILES, TO FURTHER FILE INFORMATION WORDS . */ 00000162 / SETVAL H$MULT,LEVEL1,(+,MBE,0,) 00000163 SETVAL II5,0,(+,NAANT,LEVEL1,+,1,0,) 00000164 SETADR MBE,0,(+,T$0ADREF,-MBE-II5-,) 00000165 ** /* SPACE NEEDED FOR MULTIPLICATION POINTERS */ 00000166 SETVAL II5,0,(+,NAANT,LEVEL1,) 00000167 DOLOOP J,II5,1,-1,L0012,L0013 00000168 / SETVAL M,0,(+,H$MBU,LEVEL1,+,J,0,-,1,0,) LOC INDEX */ 00000169 / CMPBIT L$PROP,M,FILE,ON,FIL1 00000170 / SETVAL N,0,(+,L$BEGIN,M,) 00000171 / CMP000 N,0,EQ,GFO2 EMPTY EXPR ENCOUNTERED */ 00000172 / B A2AP 00000173 /FIL1 CMPBIT L$PROP,M,TAPE,OFF,FIL2 00000174 ** /* CASE OF FILE ON TAPE */ 00000175 / CMP000 L$RCNAM,M,EQ,GFO2 00000176 / SETVAL N,0,(+,MBE,0,) 00000177 / SETADR MBE,0,(+,T$1NEXTF,MBE,) FOR FILE INFORM WORDS */ 00000178 / SETVAL START,0,(+,MBE,0,) ASSIGN BUFFER SPACE */ 00000179 / CMPVAL LEVEL,0,(+,LEVBUF1,0,),GE,FIL1A 00000180 / SETVAL LEVBUF1,0,(+,LEVEL,0,) 00000181 / SETADR START,0,(+,IDGEHX,1,) 00000182 / B FIL1B 00000183 /FIL1A CMPVAL LEVEL,0,(+,LEVBUF2,0,),GE,FIL1B 00000184 / SETVAL LEVBUF2,0,(+,LEVEL,0,) 00000185 / SETADR START,0,(+,IDGEHX,1,+,BUFLENG,0,) 00000186 FIL1B SETVAL II5,0,(+,L$RCNAM,M,+,7,0,) 00000187 PTAKMAN NTAP7,START,DUMMM,II5 00000188 ** /* RECORD AFTER NAMELIST */ 00000189 / CMPVAL START,0,(+,MBE,0,),NE,FIL1C BUFFER IN IDGEHX */ 00000190 *** IF BUF(START).WORD(BUF(START).LENGT) NE -1 00000191 LOAD 4,B$0LENGT,START 00000192 SR 4,6 00000193 SLA 4,2 00000194 LA 5,4(4) 00000195 ST 5,LENG5 LENG OF BUFFER IN BYTES 00000196 A 4,START 00000197 L 1,0(4) 00000198 AR 1,6 00000199 BZ L0027 00000200 / SETVAL MBE,0,(+,MBE,0,+,BUFLENG,0,) NOT COMPLETELY IN MEMOR 00000201 / B FIL1C 00000202 /L0027 SETVAL MBE,0,(+,MBE,0,+,LENG5,0,) RESERVE BUFSPACE*/ 00000203 /FIL1C SETADR K,0,(+,B$0VECTS,START,) 00000204 / SETVAL T$1VECTF,N,(+,K,0,) 00000205 / SETVAL T$1VECTC,N,(+,K,0,) 00000206 / SETADR K,0,(+,T$0NEXTW,K,) 00000207 / SETVAL T$1ALGEC,N,(+,K,0,+,T$1POINT,K,) 00000208 SETBIT T$1PROP,N,FILER,ON USES BITS OF VECTF 00000209 *** IF BUF(START).WORD(BUF(START).LENGT) NE -1 00000210 LOAD 4,B$0LENGT,START 00000211 SR 4,6 00000212 SLA 4,2 00000213 A 4,START 00000214 L 1,0(4) 00000215 AR 1,6 00000216 BZ L0031 00000217 / SETBIT T$1PROP,N,MEMOR,OFF 00000218 / SETVAL T$1RCFST,N,(+,B$0RECOR,START,) 00000219 / SETVAL T$1RCCUR,N,(+,B$0RECOR,START,) 00000220 / B A2AP 00000221 /L0031 SETBIT T$1PROP,N,MEMOR,ON 00000222 / SETVAL T$1ALGEF,N,(+,T$1ALGEC,N,) 00000223 / B A2AP 00000224 /FIL2 CMP111 L$NUMB,M,EQ,GFO3 BEFORE FIL3 00000225 ** /* CASE OF A FILE IN MEMORY */ 00000226 / SETVAL K,0,(+,L$BEGIN,M,) 00000227 / CMP000 K,0,EQ,GFO2 EMPTY EXPR ENCOUNTERED */ 00000228 / SETVAL T$1VECTF,MBE,(+,K,0,) 00000229 / SETVAL T$1VECTC,MBE,(+,K,0,) 00000230 / SETADR K,0,(+,T$0NEXTW,K,) 00000231 / SETVAL T$1ALGEC,MBE,(+,K,0,+,T$1POINT,K,) 00000232 SETBIT T$1PROP,MBE,FILER,ON USES BITS OF VECTF 00000233 SETBIT T$1PROP,MBE,MEMOR,ON USES BITS OF VECTF 00000234 / SETVAL T$1ALGEF,MBE,(+,T$1ALGEC,MBE,) 00000235 / SETVAL N,0,(+,MBE,0,) 00000236 / SETADR MBE,0,(+,T$1NEXTF,MBE,) 00000237 /* B A2AP 00000238 ** /* CASE OF A NUMERICAL FILE */ 00000239 *** PRESUMABLY NEVER USED BECAUSE OF INSER2(SPF15) AND ROTSOI(EVFIL1) 00000240 *** TO TEST THIS, GFO3 IS USED. 00000241 /*FIL3 CMP000 L$VALUE,M,EQ,GFO2 EMPTY EXPR ENC */ 00000242 /* SETBIT T$1PROP,MBE,FILER,ON 00000243 * FLOAT 0,L$VALUE,M 00000244 * STORE 0,T$1COEFF,MBE 00000245 *** SET000 T$1ALGEC,MBE AUTOMATIC BECAUSE OF EXTENDED PREC 00000246 /* SET000 T$1EMPTY,MBE 00000247 /* SETVAL N,0,(+,MBE,0,) 00000248 /* SETADR MBE,0,(+,T$1NEXT1,MBE,) 00000249 A2AP SETVAL II5,0,(+,H$MULT,LEVEL1,) 00000250 SETVAL T$0ADREF,-II5-J-,(+,N,0,) 00000251 SETVAL T$0ADREC,-II5-J-,(+,N,0,) 00000252 ENDDO L0012,- 00000253 /L0013 SETVAL G$MBE,LEVEL1,(+,MBE,0,) 00000254 *** RESTART AFTER A POINTER WAS MOVED. */ 00000255 /APA7 SETVAL MBE,0,(+,G$MBE,LEVEL1,) 00000256 SET000 KEY$NR,0 00000257 SET000 KEY$NEW,0 00000258 / SETVAL KEY$NOW,0,(+,MBE,0,) 00000259 / SET000 DEPTH,0 NEPSG(DEPTH) USED IN CONJG */ 00000260 SETVAL II5,0,(+,NAANT,LEVEL1,) 00000261 : DOLOOP B1B,1,II5,1,L0014,HELENE MULTP OF FACTORS 00000262 STM 7,9,LOOPVAR2 00000263 / SETVAL K,0,(+,H$MULT,LEVEL1,) NOT SAVED IN INSERT */ 00000264 / SETVAL FILD1,0,(+,T$0ADREC,-K-B1B-,) 00000265 ** /* TAKE 1 TERM OF EACH EXPRESSION */ 00000266 ** /* AN EXPRESSION HAS SIMPLE FACTORS. THE FACTORS OF */ 00000267 ** /* OF A FILE ARE SPLIT IN VECTOR AND ALGEBRA PARTS. */ 00000268 ** /* THEREFORE TWO CALLS TO INSER1 ARE REQUIRED */ 00000269 / CMPBIT T$1PROP,FILD1,FILER,ON,L0033 00000270 / PINSER1 FILD1 00000271 / B L0034 00000272 :L0033 SETVAL M,0,(+,T$1VECTC,FILD1,+,NEXTW,0,) 00000273 PINSER1 M 00000274 / CMP000 IGET,0,EQ,L0034 00000275 SETVAL II5,0,(+,T$1ALGEC,FILD1,) 00000276 PINSER1 II5 00000277 /L0034 CMP000 IGET,0,NE,L0035 00000278 / CCALL BOEK2 00000279 / B PA064 00000280 L0035 LM 7,9,LOOPVAR2 00000281 ENDDO L0014,+1 00000282 LA 4,PA064 00000283 STORE 4,BACK,0 00000284 / B HELENE 00000285 /PA064 SET000 FILD2,0 NO TAPE WORK */ 00000286 / SET111 FILD3,0 ALL FILES AT THEIR END OF FILE */ 00000287 / SETVAL K,0,(+,H$MULT,LEVEL1,) VALID TILL EIND1 */ 00000288 SETVAL II5,0,(+,NAANT,LEVEL1,) 00000289 DOLOOP J,II5,1,-1,L0016,GLA35 00000290 ** /* MOVE 1 MULTIPLICATION POINTER TO NEXT TERM OR */ 00000291 ** /* RESET TO FIRST TERM WHEN END OF EXPR IS SEEN. */ 00000292 ** /* TRY THEN TO TAKE NEXT TERM IN PREVIOUS EXPRESSION.ETC.* 00000293 / SETVAL L,0,(+,T$0ADREC,-K-J-,) 00000294 / CMPBIT T$1PROP,L,FILER,ON,FIL4 00000295 / CMPVAL T$1POINT,L,(+,X'40',0,),LT,GLA33 00000296 ** /* 100B IS GUARANTEED TO BE SMALLER THAN ANY ABSOLUTE ADR* 00000297 / SETVAL T$0ADREC,-K-J-,(+,T$1POINT,L,) PICK UP NEXT TERM */ 00000298 / B APA7 START MULTIPLIC WITH NEW TERM */ 00000299 ** /* CASE OF END OF EXPRESSION : POINT=0 */ 00000300 ** /* CASE OF D-EXPR. POINT=1 OR 2 . HAS ONLY 1 TERM */ 00000301 /GLA33 SETVAL T$0ADREC,-K-J-,(+,T$0ADREF,-K-J-,) 00000302 / B GLA30 00000303 ** /* MOVE POINTER IN FILE INFORMATION WORD */ 00000304 /FIL4 CMP000 T$1ALGEC,L,EQ,GFO3 BEFORE GLA30 NUMERICAL FILE*/ 00000305 : SETVAL M,0,(+,T$1ALGEC,L,) 00000306 : SETVAL M,0,(+,T$1POINT,M,+,T$1ALGEC,L,) 00000307 / CMP000 T$0WORD,M,EQ,FIL5 VECTOR SEPARATOR */ 00000308 / SETVAL T$1ALGEC,L,(+,M,0,) 00000309 / B APA7 RESTART WITH NEXT ALG, SAME VECTOR */ 00000310 /FIL5 CMP000 T$0NEXTW,M,EQ,FILR1 END OF RECORD */ 00000311 / CMP111 T$0NEXTW,M,EQ,FILR1 END OF RECORD */ 00000312 / CMPVAL T$0NEXTW,M,(-,1,0,),EQ,FIL6 END OF FILE */ 00000313 / SETVAL T$1VECTC,L,(+,M,0,) 00000314 / SETADR M,0,(+,T$0NEXTW,M,) 00000315 / SETVAL T$1ALGEC,L,(+,M,0,+,T$1POINT,M,) 00000316 / CMP000 T$1POINT,M,EQ,GFO2 EMPTY EXPR ENCOU */ 00000317 / B APA7 RESTART WITH NEXT VECTOR ,ITS FIRST ALG */ 00000318 /FIL6 CMPBIT T$1PROP,L,MEMOR,OFF,FILF1 00000319 / SETVAL T$1ALGEC,L,(+,T$1ALGEF,L,) 00000320 / SETVAL T$1VECTC,L,(+,T$1VECTF,L,) 00000321 ** /* THIS RESET OF POINTERS CAN BE DONE BY IT(L)=IT(L+1) 00000322 / B GLA30 00000323 /FILR1 SET000 FILD3,0 THIS FILE IS NOT POSITIONED AT EOF */ 00000324 / SET111 FILD2,0 SIGNALS TAPE WORK */ 00000325 BAL 14,BSE1 00000326 / B GLA30 00000327 /FILF1 SET111 FILD2,0 00000328 / SETVAL T$1RCCUR,L,(+,T$1RCFST,L,-,1,0,) THIS ACTS AS EOF 00000329 BAL 14,BSE1 FOR EACH PARTICULAR FILE. 00000330 *** WE ARE AT END OF CURRENT EXPRESSION. TRY MOVING POINTER IN */ 00000331 *** PREVIOUS EXPRESSION */ 00000332 GLA30 ENDDO L0016,- 00000333 /GLA35 CMP000 FILD2,0,EQ,GLA36 00000334 / CMP000 FILD3,0,NE,GLA36 00000335 ** /* ALL POINTERS SIGNAL AN END OF EXPRESSION. FOR FILES THIS 00000336 ** /* COULD HAVE BEEN PROVOQUED BY EOR CONDITITIONS RATHER */ 00000337 ** /* THAN EOF. IN THAT CASE, READ NEXT RECORD */ 00000338 SETVAL II5,0,(+,NAANT,LEVEL1,) 00000339 DOLOOP J,II5,1,-1,L0020,GFO1 00000340 / SETVAL L,0,(+,T$0ADREC,-K-J-,) 00000341 / CMPBIT T$1PROP,L,FILER,OFF,FIL7A SKIP NON-TAPE */ 00000342 / CMPBIT T$1PROP,L,MEMOR,ON,FIL7A FILES */ 00000343 / CMP000 T$1ALGEC,L,EQ,GFO3 BEFORE FIL7A 00000344 / CMPVAL T$1RCCUR,L,(+,T$1RCFST,L,),GE,L0036 00000345 / SET000 FILD4,0 00000346 ** /* THIS FILE IS AT EOF. IT HAS TO READ AGAIN ITS FIRST */ 00000347 ** /* BUFFER. A PREVIOUS FILE HAS TO READ A NEXT BUFFER */ 00000348 / B L0037 00000349 /L0036 SETVAL FILD4,0,(-,1,0,) 00000350 ** /* READING NEXT BUFFER OF THIS FILE IS SUFFICIENT. */ 00000351 ** /* NO OTHER READING REQUIRED */ 00000352 L0037 LOAD 1,T$1VECTF,L 00000353 LA 1,0(1) BLANK OUT T$1PROP 00000354 ST 1,START 00000355 SETVAL START,0,(+,START,0,-,VECTS,0,) 00000356 SETVAL II5,0,(+,T$1RCCUR,L,+,7,0,) 00000357 : PTAKMAN NTAP7,START,DUMMM,II5 00000358 / SETVAL T$1RCCUR,L,(+,B$0RECOR,START,) 00000359 BAL 14,BSE1 00000360 CMP000 FILD4,0,NE,APA7 00000361 FIL7A ENDDO L0020,- 00000362 / B GFO1 MORE THAN 40 SUBSTITUTIONS */ 00000363 /GLA36 CMP000 LEVEL,0,EQ,EIND1 00000364 / SETVAL MBU,0,(+,H$MBU,LEVEL1,) 00000365 / SETVAL MBE,0,(+,H$MBE,LEVEL1,) 00000366 /EIND1 SETVAL NQX,0,(+,G$INDEX,LEVEL1,) 00000367 / CMPVAL LEVBUF1,0,(+,LEVEL,0,),LT,L0022 00000368 / SETVAL LEVBUF1,0,(+,50,0,) FREE BUFFERS */ 00000369 /L0022 CMPVAL LEVBUF2,0,(+,LEVEL,0,),LT,L0023 00000370 / SETVAL LEVBUF2,0,(+,50,0,) AGAIN */ 00000371 /L0023 SETVAL BACK,0,(+,G$RETUR,LEVEL1,) 00000372 / SETVAL LEVEL,0,(+,LEVEL,0,-,1,0,) 00000373 SETVAL LEVEL1,0,(+,LEVEL1,0,-,1,0,) 00000374 L 14,BACK 00000375 BR 14 00000376 LOOPVAR2 DS 3F 00000377 GFO1 ERROR 1,' MORE THAN 40 SUBSTITUTIONS' 00000378 GFO2 ERROR 1,' EMPTY EXPRESSION ENCOUNTERED' 00000379 GFO3 ERROR 1,' NUMERICAL FILES NOT BUILT IN' 00000380 FFOUT 1,'GLADYS' 00000381 ** 00000382 DS 0H 00000383 ***** PRO L RESET POINTERS TO BEGIN OF RECORD */ 00000384 /BSE1 SETVAL T$1VECTC,L,(+,T$1VECTF,L,) 00000385 SETVAL M,0,(+,T$1VECTF,L,+,NEXTW,0,) 00000386 / SETVAL T$1ALGEC,L,(+,M,0,+,T$1POINT,M,) 00000387 / BR 14 00000388 END 00000389 ./A INFTN,INCR=1 00000001 SUBROUTINE IN 00000002 C MFOUT=0 NORMAL START OF SCHOON. ELSE SKIP TO * BEGIN OR * END. 00000003 C LAY1(1) NEG, THEN SKIPPING STARTS WITH RJ STAR. ELSE WITH RJ INP . 00000004 C LAY1(2) NZ PRINTS TIME...SECONDS. 00000005 CALL IN1 00000006 C LAY1(1) =0 IF EXECUTION REQUIRED. = NZ IF SKIPPED TILL * END CARD. 00000007 RETURN 00000008 END 00000009 SUBROUTINE IN2 00000010 ./MACRO BLANK 00000011 ./MACRO STORAG 00000012 INTEGER STBEG,STEND,STNEX,STYEP,PAS,YEPFL 00000013 DIMENSION IPUNCH(37),MSG3(7),II(2) 00000014 EQUIVALENCE ( IBUF ( 38 ) , IPUNCH(1) ) 00000015 EXTERNAL CVTFL,SECOND 00000016 C DATA STBEG,STEND,STNEX,STYEP,STFIX /1,2,3,4,5/ 00000017 DATA STBEG,STEND,STNEX,STYEP /1,2,3,4/ 00000018 DATA MSG3/4H1BEG,4HIN ,4H SEC,4HONDS,4H0 ,4H0TIM,4HE / 00000019 IF ( LAY1(2) ) 6,19,6 00000020 19 IF ( MFOUT ) 6,1,6 00000021 1 IF ( NSPEC-STYEP ) 41,72,41 00000022 41 IF ( NSPEC-STBEG ) 42,13,42 00000023 42 IF ( NSPEC-STNEX ) 79,14,79 00000024 C FIX 00000025 79 MTAB(14)=NVIND 00000026 MTAB(15)=NVECT 00000027 MTAB(16)=NFUN 00000028 MTAB(17)=NALGE 00000029 MTAB(18)=NXEX 00000030 MTAB(2)=MBE 00000031 MTAB(9)=MBU 00000032 MTAB(10)=MBU 00000033 MTAB(19)=NXEX 00000034 C INITIALIZATION AFTER * BEGIN, * FIX 00000035 13 CALL UNFC(SECOND,NTIME) 00000036 IBUF(1)=NTAP2 00000037 IBUF(3)=0 00000038 IBUF(4)=6 00000039 IBUF(6)=MSG3(1) 00000040 IBUF(7)=MSG3(2) 00000041 CALL UNFC (CVTFL,NTIME,II) 00000042 IBUF(8)=II(1) 00000043 IBUF(9)=II(2) 00000044 IBUF(10)=MSG3(3) 00000045 IBUF(11)=MSG3(4) 00000046 CALL LIJN 00000047 IBUF(4)=1 00000048 IBUF(6)=MSG3(5) 00000049 CALL LIJN 00000050 C START NEW PROBLEM 00000051 12 NVIND=MTAB(14) 00000052 MTAB(20)=MTAB(14) 00000053 NVECT= MTAB(15) 00000054 NFUN=MTAB(16) 00000055 NALGE=MTAB(17) 00000056 MTAB(3)=MTAB(2) 00000057 MTAB(4)=0 00000058 MTAB(5)=MTAB(2) 00000059 MTAB(11)=MTAB(10) 00000060 C INITIALIZATION AFTER * NEXT 00000061 14 NTEMA=0 00000062 NBR=0 00000063 N5PS=0 00000064 MBE=MTAB(3) 00000065 MBU=MTAB(10) 00000066 GO TO 2 00000067 C INITIALIZATION AFTER * YEP 00000068 72 MBE=MTAB(5) 00000069 MBU=MTAB(11) 00000070 2 NSUBS=0 00000071 DO 15 L1=1,7 00000072 15 NCONT(L1)=0 00000073 NCONT(10)=0 00000074 NCONT(3)=1 00000075 NCONT(2)=1 00000076 NVRA=0 00000077 IF( ISPLAY ) 7,10,7 00000078 C DEFAULT. PRINT (N)OUTPUT FOR * YEP WHEN (PRINTER) DISPLAY. 00000079 7 NCONT(9)=0 00000080 NCONT(11)=0 00000081 NVRA=1 00000082 C ANALYZE INPUT 00000083 10 CALL SCHOON 00000084 RETURN 00000085 C 00000086 C INITIALIZATION AFTER ERROR RECOVERY OR AT FIRST ENTRY OF PROGRAM 00000087 6 LAY1(2)=0 00000088 DOVLAG(1)=0 00000089 DOVLAG(2)=0 00000090 BLOKPT(1)=0 00000091 BLOKPT(2)=0 00000092 YEPFL=0 00000093 NREP=0 00000094 MTAB(10)=MTAB(9) 00000095 MTAB(19)=MTAB(18) 00000096 DO 5 I=3,7 00000097 5 CALL TAKMAN ( I,Z,Z,REW0 ) 00000098 NTAP1=1 00000099 NTAP2=2 00000100 NTAP3=3 00000101 NTAP4=4 00000102 NTAP5=5 00000103 NTAP6=6 00000104 NTAP7=7 00000105 NTAP8=8 00000106 K=LAY1(1) 00000107 LAY1(1)=0 00000108 IF ( MFOUT ) 18,4,18 00000109 18 IF ( ISPLAY ) 4,9,4 00000110 C SKIP OVER CODE AFTER ERROR 00000111 9 IF ( K ) 23,24,24 00000112 25 CALL SCHOON 00000113 23 CALL STAR1 00000114 IF ( PAS ) 25,24,25 00000115 24 IF ( NSPEC-STBEG ) 16,4,16 00000116 16 IF ( NSPEC-STEND ) 25,17,25 00000117 17 MFOUT=0 00000118 LAY1(1)=-1 00000119 RETURN 00000120 C 00000121 C PRINT TIME MESSAGE 00000122 4 CALL UNFC(SECOND,NTIME) 00000123 IBUF(1)=NTAP2 00000124 IBUF(3)=0 00000125 IBUF(4)=6 00000126 IBUF(6)=MSG3(6) 00000127 IBUF(7)=MSG3(7) 00000128 CALL UNFC (CVTFL,NTIME,II) 00000129 IBUF(8)=II(1) 00000130 IBUF(9)=II(2) 00000131 IBUF(10)=MSG3(3) 00000132 IBUF(11)=MSG3(4) 00000133 CALL LIJN 00000134 IBUF(4)=1 00000135 IBUF(6)=MSG3(5) 00000136 CALL LIJN 00000137 MFOUT=0 00000138 GO TO 12 00000139 END 00000140 SUBROUTINE INPHV 00000141 ./MACRO BLANK 00000142 C IBUF(1)=NTAPX , IBUF(3)=BEGIN , IBUF(4)=END 00000143 C IBUF(5)=BLANK , IBUF(6) TO IBUF(37)=BUFFER 00000144 NTAPX=IBUF(1)+10 00000145 READ( NTAPX,10 ) ( IBUF(I),I=7,26) 00000146 IBUF(4)=21 00000147 C IBUF(4)=LENGTH ( NTAPX )+1=LAST READ WORD-5 AS IN LIJN 00000148 IBUF(6)=IBUF(5) 00000149 RETURN 00000150 10 FORMAT ( 20A4 ) 00000151 ENTRY ENFIL 00000152 NTAPX=NTAP3+10 00000153 END FILE NTAPX 00000154 RETURN 00000155 ENTRY RWND 00000156 NTAPX=NTAP3+10 00000157 REWIND NTAPX 00000158 REWIND NTAPX 00000159 RETURN 00000160 ENTRY RWND4 00000161 NTAPX=NTAP4+10 00000162 REWIND NTAPX 00000163 REWIND NTAPX 00000164 RETURN 00000165 END 00000166 SUBROUTINE GETAL(RN,AD1,IA,NB) 00000167 ./MACRO BLANK 00000168 ./MACRO STORAG 00000169 REAL*16 RN,AD1,C,CP,CP1,RNMAX 00000170 INTEGER TEX1(8) 00000171 DIMENSION KB(30),N(8),C(8),IPUNCH(37) 00000172 EQUIVALENCE ( KB(1),B(1) ), (IBUF(38),IPUNCH(1) ) 00000173 C TEMPOARAY SOLUTION............ 00000174 DATA CP,CP1,RNMAX,NSHIFT,NN1 / 10.Q0,1.Q0,1.Q75,Z01000000,Z100 / 00000175 DATA KPUN,KE,KP,KM,KN,K0,K9/Z4B,ZC5,ZD7,ZD4,ZD5,ZF0,ZF9/ 00000176 DATA KPL,KMI,KBL,KAST,KCO/Z4E,Z60,Z40,Z5C,Z6B / 00000177 DATA TEX1/4H ILL,4HEGAL,4H CHA,4HRACT,4HER I,4HN NU,4HMBER,4H /00000178 C KB(1) TILL KB(NB) ARE DISPLAY CODE CHARS ( LEFT ADJUSTED) E.G. 00000179 C 123.45E-67 . DIVIDING THEM BY 16**6 MAKES THEM RIGHT ADJUSTED. 00000180 C NSI = SIGN OF THE NUMBER ( CHANGED BY THE LETTER N ) 00000181 C NEXP = SIGN OF THE EXPONENT. 00000182 C N(1)=C(1)=123 (UNTIL . ) N(5)=3=NR OF DIGITS 00000183 C N(2)=C(2)=45 (UNTIL E ) N(6)=2 00000184 C N(3)=C(3)=67 N(7)=2 00000185 C N IS IN INTEGER FORMAT. C IS EXTENDED PRECISION. 00000186 DO 1 I1=1,8 00000187 C(I1)=0.0 00000188 1 N(I1)=0 00000189 I=1 00000190 NSI=1 00000191 NEXP=1 00000192 DO 2 NA=1,NB 00000193 MB=KB(NA) 00000194 MB=MB/NSHIFT 00000195 C ARITHMETIC RIGHT SHIFT. A LEFT ADJUSTED CHARACTER MIGHT BE A NEGATIVE00000196 C NUMBER. FORCE THEN POSITIVE. 00000197 IF ( MB ) 11,12,12 00000198 11 MB=NN1+MB 00000199 12 IF(MB-KN) 42,43,42 00000200 43 NSI=-NSI 00000201 GO TO 2 00000202 42 IF(MB-KBL) 34,2,34 00000203 34 IF (MB-KAST) 35,2,35 00000204 35 IF (MB-KCO) 33,2,33 00000205 C IGNORE BLANK, ASTERISK AND COMMA 00000206 33 IF (MB-KPUN) 3,4,3 00000207 4 I=I+1 00000208 GO TO 2 00000209 3 IF (MB-KE) 5,6,5 00000210 6 I=3 00000211 GO TO 2 00000212 5 IF (MB-KPL) 25,2,25 00000213 25 IF (MB-KMI) 15,9,15 00000214 15 IF (MB-KP) 7,2,7 00000215 7 IF (MB-KM) 8,9,8 00000216 9 NEXP=-1 00000217 GO TO 2 00000218 8 IF(MB-K0) 50,51,51 00000219 C ONLY DIGITS ARE VALID CHARACTERS. 00000220 51 IF(MB-K9) 52,52,50 00000221 52 C(4)=MB-K0 00000222 C(I)=C(I)*CP+C(4) 00000223 N(I)=N(I)*10+MB-K0 00000224 N(I+4)=N(I+4)+1 00000225 2 CONTINUE 00000226 IF ( N(7)+N(8) ) 13,10,13 00000227 C DETECT PUNCHING ERRORS LIKE 12E*A OR 12E-*A 00000228 10 IF ( I-2 ) 13,13,50 00000229 50 DO 14 J=1,8 00000230 14 IPUNCH(J+2)=TEX1(J) 00000231 CALL FOUTB 00000232 13 AD1=C(1) 00000233 IA=N(1) 00000234 IF (N(6)+N(7)) 17,17,18 00000235 C GO TO 18 TO DO PROPER SCALING OF C(1),C(2),C(3). NOT REQUIRED WHEN 00000236 C ONLY C(1) IS PRESENT. 00000237 C IF 123.45E-67.89 , THE FRACTIONAL PART OF THE EXPONENT IS IGNORED. 00000238 17 RN=RNMAX 00000239 IF(AD1) 40,41,40 00000240 40 RN=CP1/AD1 00000241 41 IF(NSI) 44,44,45 00000242 44 RN=-RN 00000243 AD1=-AD1 00000244 IA=-IA 00000245 45 RETURN 00000246 18 NEXP=NEXP*N(3) 00000247 IA=-N(6) 00000248 AD1=(C(1)+C(2)*CP**IA)*CP**NEXP 00000249 IA=AD1 00000250 GO TO 17 00000251 END 00000252 ./A INP,INCR=1 00000001 ./MACRO MAINMCRO 00000002 ./MACRO INMACRO 00000003 TITLE 'INP' 00000004 GBLC &OVLAY 00000005 LCLA &PTR,&AAA 00000006 PRINT NOGEN 00000007 ./MACRO INCOM 00000008 ./MACRO MAINCOM 00000009 INP0 CSECT 00000010 EQUIVAL 00000011 ENTRY SEAR3,SEAR4,PRIN3,BREAK,WREND1,INP 00000012 EXTRN LIJN,RWND,RWND4,ENFIL,INPHU,PAKB1 00000013 EXTRN FOUT,FOUTP,CVTIN 00000014 EXTRN ENCOM1,WRCOM1 00000015 USING INCOM,10 00000016 USING BLANK,11 00000017 INP PRO 00000018 /INP1 CMP000 DUMCAR,0 00000019 / BE L0001 00000020 SETVAL DUMCAR,0,(+,DUMCAR,0,+,1,0,) 00000021 / CMP000 DUMCAR,0 00000022 / BE INP1C 00000023 SETCAR A,1,X'77',1 GENERATE SECOND DUMMY CARD 00000024 B XINP 00000025 /L0001 SET111 TABIN1,0 REQUEST SEARCH THROUGH TABLE */ 00000026 / PINPHU NTAP1 00000027 *** EXCEPTIONS FOR DUMMY CARD GENERATION */ 00000028 *** THE STATEMENT IF IBUF(7) = 'DO' MEANS COMPARISON OF CHAR(1) AND * 00000029 *** CHAR(2) ONLY */ 00000030 / CMPCAR IBUF,7,C'T',1 00000031 / BE INP1A 00000032 / CMPCAR IBUF,7,C' ',1 00000033 / BE INP1AA 00000034 / CMPCAR IBUF,7,C'PRINT INPU',10 00000035 / BE INP1A 00000036 / CMPCAR IBUF,7,C'PRINT NINP',10 00000037 / BE INP1A 00000038 / CMPCAR IBUF,7,C'ENDBLOCK',8 00000039 / BE INP1A 00000040 / CMPCAR IBUF,7,C'DO',2 00000041 / BE INP1AA 00000042 / CMPCAR IBUF,7,C'C',1 00000043 / BNE INP2C 00000044 / CMPCAR IBUF,7,C'COMMON',6 00000045 / BNE INP1A 00000046 /INP2C SETVAL DUMCAR,0,(-,2,0,) GENERATE FIRST DUMMY CARD */ 00000047 / SETCAR A,1,C' ',1 00000048 SETCAR A,2,X'77',1 00000049 B XINP 00000050 /INP1C CMPCAR IBUF,7,C'AL',2 00000051 / BNE L0002 00000052 CMPVAL LEVHY,0,(+,LEVCH,0,) 00000053 BNL LL001 LEVHY=MAX(LEVHY,LEVCH) 00000054 SETVAL LEVHY,0,(+,LEVCH,0,) 00000055 /LL001 SETVAL BRAZI1,0,(+,LEVLO,0,) 00000056 /L0002 CMPCAR IBUF,7,C'ID',2 00000057 / BNE L0003 00000058 CMPVAL LEVHY,0,(+,LEVCH,0,) 00000059 BNL LL002 LEVHY=MAX(LEVHY,LEVCH) 00000060 SETVAL LEVHY,0,(+,LEVCH,0,) 00000061 /LL002 SETVAL BRAZI1,0,(+,LEVHY,0,) 00000062 /L0003 B INP1A 00000063 *** BRAZI1 = LEVEL TO BE PRINTED IN FRONT OF ID, AL CARD */ 00000064 /INP1AA SET000 TABIN1,0 00000065 /INP1A CMP000 ISPLAY,0 00000066 / BE INP1AB 00000067 / CMPVAL NTAP1,0,(+,3,0,) 00000068 / BE INP1AB 00000069 / CMP000 DOVLAG$B,0 00000070 / BE INP2 00000071 /INP1AB CMPCAR IBUF,7,C'PRINT INPU',10 00000072 / BE L0004 00000073 CMP000 NCONT,3 00000074 BE INP2 00000075 /L0004 CMPCAR IBUF,7,C'DISPLAY',7 00000076 / BE INP2 00000077 / CMP000 BRAZI1,0 00000078 / BE INP1CC 00000079 / SETVAL IBUF,6,(+,IBUF,5,) COMPLETE BLANK WORD */ 00000080 SETCAR IBUF,6,C'L',1 00000081 LA 1,BRAZI1 CONSTRUCT L 5 IN FRONT OF ID CARDS 00000082 LA 2,BRAZI2 BRAZI2 CONTAINS THE DISPLAY CODE 00000083 L 15,=A(CVTIN) 00000084 BALR 14,15 00000085 MVC IBUF+21(2),BRAZI2+6 00000086 /INP1CC SETVAL IBUF,1,(+,NTAP2,0,) 00000087 SETVAL IBUF,3,(-,1,0,) ECHO INPUT CARD ON OUTPUT 00000088 CALLFTN LIJN 00000089 *** ANALYZE THE INPUT CARD */ 00000090 /INP2 CMPCAR IBUF,7,C'DO',2 00000091 BNE LL012 00000092 L 15,=A(DO1) 00000093 BALR 14,15 00000094 B INP1 00000095 /LL012 CMPCAR IBUF,7,C'C',1 00000096 / BNE INP2B 00000097 / CMPCAR IBUF,7,C'COMMON',6 00000098 / BE INP4 00000099 / CMPCAR IBUF,7,C'COPY',4 00000100 BNE INP1 CASE OF COMMENT CARD 00000101 L 15,=A(COPYB1) 00000102 BALR 14,15 00000103 B INP1 00000104 /INP2B SET000 BRAZI1,0 00000105 / CMP000 TABIN1,0 00000106 / BE INP4 NO SCAN THRU TABLE */ 00000107 / CMP000 MFOUT,0 00000108 / BNE INP4 00000109 /INP5 CMPCAR IBUF,7,C'PRINT STAT',10 00000110 / BNE L0007 00000111 / SET111 NCONT,9 00000112 / B INP1 00000113 /L0007 CMPCAR IBUF,7,C'PRINT NSTA',10 00000114 / BNE L0010 00000115 / SET000 NCONT,9 00000116 / B INP1 00000117 /L0010 CMPCAR IBUF,7,C'PRINT LIST',10 00000118 / BNE L0011 00000119 / SET111 NCONT,11 00000120 / B INP1 00000121 /L0011 CMPCAR IBUF,7,C'PRINT NLIS',10 00000122 / BNE L0012 00000123 / SET000 NCONT,11 00000124 / B INP1 00000125 /L0012 CMPCAR IBUF,7,C'PRINT INPU',10 00000126 / BNE L0013 00000127 / SET111 NCONT,3 00000128 / B INP1 00000129 /L0013 CMPCAR IBUF,7,C'PRINT NINP',10 00000130 / BNE L0014 00000131 / SET000 NCONT,3 00000132 / B INP1 00000133 /L0014 CMPCAR IBUF,7,C'PRINT OUTP',10 00000134 / BNE L0015 00000135 / SET111 NCONT,2 00000136 / SET111 NVRA,0 FOR * YEP */ 00000137 / B INP1 00000138 /L0015 CMPCAR IBUF,7,C'PRINT NOUT',10 00000139 / BNE L0016 00000140 / SET000 NCONT,2 00000141 / SET000 NVRA,0 FOR * YEP */ 00000142 / B INP1 00000143 /L0016 CMPCAR IBUF,7,C'PRINT CINP',10 00000144 / BNE L0017 00000145 / SET111 NCONT,6 00000146 / B INP1 00000147 /L0017 CMPCAR IBUF,7,C'PRINT CEXE',10 00000148 / BNE L0020 00000149 / SET111 NCONT,7 00000150 / B INP1 00000151 /L0020 CMPCAR IBUF,7,C'PRINT COUT',10 00000152 / BNE L0021 00000153 / SET111 NCONT,10 00000154 / B INP1 00000155 /L0021 CMPCAR IBUF,7,C'PRINT ERRO',10 00000156 / BNE L0022 00000157 / SET111 NCONT,8 00000158 / B INP1 00000159 /L0022 CMPCAR IBUF,7,C'PRINT BRAC',10 00000160 / BNE L0023 00000161 / SET111 NCONT,5 00000162 / B INP1 00000163 /L0023 CMPCAR IBUF,7,C'DISPLAY',7 00000164 / BNE L0024 00000165 / SET111 ISPLAY,0 00000166 / SET111 NCONT,2 00000167 / SET111 NVRA,0 00000168 / SET000 NCONT,9 00000169 / SET000 NCONT,11 00000170 / B INP1 00000171 /L0024 CMPCAR IBUF,7,C'PRINTER',7 00000172 / BNE L0025 00000173 / SET000 ISPLAY,0 00000174 / SET000 NVRA,0 00000175 / SET111 NCONT,2 00000176 / SET111 NCONT,3 00000177 / SET111 NCONT,9 00000178 / SET111 NCONT,11 00000179 / B INP1 00000180 /L0025 CMPCAR IBUF,7,C'ENTER COMM',10 00000181 / BNE L0026 00000182 L 15,=A(ENCOM1) 00000183 BALR 14,15 00000184 / B INP1 00000185 /L0026 CMPCAR IBUF,7,C'WRITE COMM',10 00000186 / BNE L0027 00000187 L 15,=A(WRCOM1) 00000188 BALR 14,15 00000189 / B INP1 00000190 /L0027 CMPCAR IBUF,7,C'ENTER BLOC',10 00000191 / BNE L0030 00000192 SETVAL BLOV34,0,(-,1,0,) 00000193 / B INP1 00000194 /L0030 CMPCAR IBUF,7,C'WRITE BLOC',10 00000195 / BE WRBLOK1 00000196 / CMPCAR IBUF,7,C'TAPE REWIN',10 00000197 / BNE L0031 00000198 CALLFTN RWND 00000199 / B INP1 00000200 /L0031 CMPCAR IBUF,7,C'TAPE ENDFI',10 00000201 / BNE L0032 00000202 CALLFTN ENFIL 00000203 / B INP1 00000204 /L0032 CMPCAR IBUF,7,C'TAPE READ',9 00000205 / BNE L0033 00000206 CMP000 ITAR1,1 00000207 BNE IFO1 WRONG TAPE CARD. 00000208 / SETVAL ITAR1,1,(+,NTAP1,0,) 00000209 / SETVAL NTAP1,0,(+,NTAP3,0,) 00000210 / B INP1 00000211 /L0033 CMPCAR IBUF,7,C'TAPE START',10 00000212 / BNE L0034 00000213 CMP000 ITAR1,2 00000214 BE INP1 00000215 / SETVAL NTAP1,0,(+,ITAR1,2,) 00000216 / SET000 ITAR1,2 00000217 / B INP1 00000218 L0034 CMPCAR IBUF,7,C'TAPE END ',10 00000219 BE LL025 00000220 CMPCAR IBUF,7,C'ENDBLOCK',8 00000221 BNE LL003 00000222 LL025 CMP000 ITAR1,1 00000223 BE IFO1 WRONG TAPE CARD 00000224 / SETVAL NTAP1,0,(+,ITAR1,1,) 00000225 / SET000 ITAR1,1 00000226 / CMP000 IAL,0 00000227 / BNE L0035 00000228 / SET000 BLOKPT$B,0 00000229 / SET000 BLOKPT$L,0 00000230 B INP1 00000231 L0035 SETVAL ENDB1$B,0,(-,1,0,) 00000232 / B INP1 00000233 /LL003 CMPCAR IBUF,7,C'TAPE NAMES',10 00000234 / BNE L0037 00000235 CMP000 ITAR1,2 00000236 BNE IFO1 00000237 / CMP000 ITAR1,1 00000238 / BNE IFO1 WRONG TAPE CARD 00000239 / SETVAL ITAR1,2,(+,NTAP1,0,) 00000240 / SETVAL NTAP1,0,(+,NTAP3,0,) 00000241 / B INP1 00000242 /L0037 CMPCAR IBUF,7,C'TAPE NONAM',10 00000243 / BNE L0040 00000244 / SETCAR ITAR3,1,C'TAPE START',10 00000245 / B HCAP19 00000246 /L0040 CMPCAR IBUF,7,C'TAPE FORWA',10 00000247 / BNE L0041 00000248 / SETCAR ITAR3,1,C'TAPE END ',10 00000249 / B HCAP19 00000250 /L0041 CMPCAR IBUF,7,C'TAPE PRINT',10 00000251 / BNE L0042 00000252 / SET000 ITAR3,1 00000253 / B HCAP21 00000254 /L0042 CMPCAR IBUF,7,C'TAPE PUNCH',10 00000255 / BNE L0043 00000256 / SET111 ITAR3,1 00000257 / B HCAP21 00000258 /L0043 CMPCAR IBUF,7,C'TAPE COPY',9 00000259 / BE HCAP23 00000260 / B INP4 00000261 ** 00000262 /HCAP19 PINPHU NTAP3 TAPE NONAMES,FORWARD */ 00000263 LADR 3,ITAR3,1 00000264 CLC IBUF+4*6(10),0(3) 00000265 BNE HCAP19 00000266 / B INP1 00000267 /HCAP21 PINPHU NTAP3 INPHU USES IBUF(1) */ 00000268 / CMP000 ITAR3,1 00000269 / BNE L0044 00000270 / SETVAL IBUF,2,(+,NTAP2,0,) TAPE PRINT * 00000271 / SET000 IBUF,3 00000272 / B L0045 00000273 /L0044 SETVAL IBUF,1,(+,NTAP8,0,) TAPE PUNCH * 00000274 / SET111 IBUF,3 /* NO BLANK WORD IN FRONT * 00000275 L0045 CALLFTN LIJN 00000276 / CMPCAR IBUF,7,C'TAPE',4 00000277 / BE INP1 00000278 / CMPCAR IBUF,7,C'T',1 00000279 / BE INP1 00000280 / B HCAP21 00000281 /HCAP23 PINPHU NTAP1 TAPE COPY */ 00000282 L 15,=A(PRIN3) 00000283 BALR 14,15 00000284 / CMPCAR IBUF,7,C'T ',3 NR OF BLANKS IS MAX NRCHARS-2 00000285 / BE INP1 AS TRAILING 00 IS PRESENT AS RESULT OF BLANK SUPPRES 00000286 / SETVAL IBUF,1,(+,NTAP3,0,) 00000287 / SET111 IBUF,3 00000288 CALLFTN LIJN 00000289 / B HCAP23 00000290 ** 00000291 ** 00000292 /WRBLOK1 CMP000 AZ,0 00000293 / BE L0051 00000294 *** FORCE ABEND. 00000295 ABEND 1001 00000296 B *-4 00000297 /L0051 CMP000 ITNAM1,0 00000298 / BNE WRBLOK2 00000299 /WRBLOK3 L 15,=A(WREND1) WRITE TAPE END ON TAPE3 WHEN ALL DONE*/ 00000300 BALR 14,15 00000301 CALLFTN RWND4 00000302 / SET000 ITNAM1,0 00000303 / B INP1 00000304 /WRBLOK2 PINPHU NTAP4 00000305 / CMPCAR IBUF,7,C'TAPE END ',9 00000306 / BNE L0052 00000307 CMPVAL MMBE,0,(+,MBE,0,) MMBE=MAX(MMBE,MBE) 00000308 BNL LL004 00000309 SETVAL MMBE,0,(+,MBE,0,) 00000310 LL004 LA 4,T$5NEXT5-T$5SPACE 00000311 LNR 4,4 00000312 A 4,ITNAM1 MBE=ITNAM1-(IT.NEXT5-IT.SPACE) 00000313 ST 4,MBE 00000314 / B WRBLOK3 00000315 /L0052 SETVAL K,0,(+,ITNAM1,0,) 00000316 WRBLOK4 L 3,K IF IBUF(7) = IT(K).BNAME THEN GOTO WRBLO4A 00000317 USING T$6,3 00000318 CLC IBUF+4*6(L'T$6BNAME),T$6BNAME 00000319 DROP 3 00000320 BE WRBLO4A 00000321 LADR 4,T$6NEXT6,K 00000322 ST 4,K 00000323 / CMPVAL K,0,(+,MBE,0,) 00000324 BNL IFO9 BLOCK MISSING DURING COPY 00000325 / B WRBLOK4 00000326 WRBLO4A L 3,K 00000327 USING T$6,3 00000328 MVC IBUF+4*6+L'T$6BNAME(L'T$6BTYPE),T$6BTYPE 00000329 DROP 3 PRINT UPDATING MESSAGE 00000330 / SET000 IBUF,3 00000331 LA 4,1+(T$6NEXT6-T$6BNAME)/&NRCHARS LENGTH OF TEXT IN WORD 00000332 STORE 4,IBUF,4 00000333 / SETVAL IBUF,1,(+,NTAP2,0,) 00000334 CALLFTN LIJN 00000335 CMPCAR T$6BTYPE,K,C'AVAILABLE',9 00000336 / BE WRBLOK6 00000337 /WRBLO4B PINPHU NTAP4 SKIP BLOCK */ 00000338 / CMPCAR IBUF,7,C'ENDBLOCK',8 00000339 / BNE WRBLO4B 00000340 / B WRBLOK2 00000341 /WRBLOK6 SETVAL IBUF,1,(+,NTAP3,0,) 00000342 / SET111 IBUF,3 00000343 CALLFTN LIJN WRITE NAME OF BLOCK ON TAPE3 00000344 /WRBLOK5 PINPHU NTAP4 00000345 / SETVAL IBUF,1,(+,NTAP3,0,) 00000346 / SET111 IBUF,3 COPY TAPE4 TO TAPE3 */ 00000347 CALLFTN LIJN 00000348 / CMPCAR IBUF,7,C'ENDBLOCK',8 00000349 / BNE WRBLOK5 00000350 / B WRBLOK2 00000351 ** 00000352 INP4 CMP000 NORDER,0 00000353 BE LL027 00000354 LL026 L 15,=A(BREAK) 00000355 BALR 14,15 00000356 B XINP 00000357 LL027 CMPCAR IBUF,7,C' ',1 00000358 BNE LL026 00000359 *** CASE OF CONTINUATION OF COMMENT CARDS. NO CHECK WANTED ON ILLEGAL 00000360 SETCAR A,1,C' ',1 CHARACTERS 00000361 SETCAR A,2,C' ',1 00000362 SETCAR A,3,C' ',1 00000363 B XINP 00000364 IFO1 ERROR 1,' WRONG TAPE CARD' 00000365 IFO9 ERROR 1,' BLOCK MISSING DURING COPY' 00000366 INP EPI 00000367 FFOUT 1,'INP' 00000368 LTORG 00000369 ** 00000370 COPYB1 PRO 00000371 SETVAL MBE5,0,(+,MBE,0,) 00000372 LADR 1,T$1CODEA,-MBE-SHMEM1- 00000373 LA 1,L'T$5SPACE(1) SAFETY. DO NOT OVERWRITE CONTENT 00000374 SRA 1,2 OF IT, SET BY INDON. 00000375 SLA 1,2 SET ON WORD BOUNDARY 00000376 ST 1,MBE 00000377 L 15,=A(BREAK) 00000378 BALR 14,15 00000379 CMP000 MFOUT,0 00000380 BNE XCOPYB1 00000381 / SET000 NI,0 00000382 / SET000 END5,0 00000383 L 15,=A(SEAR3) 00000384 BALR 14,15 00000385 / CMPCAR A,NI,C'(',1 00000386 / BNE IFO7 /* ERROR IN BLOCK,DO ARGUMENTS * 00000387 L 15,=A(SEAR4) 00000388 BALR 14,15 00000389 / PPAKB1 C' PROBLEMS ' 00000390 SETVAL ENDB1$L,0,(+,BLOKPT$L,0,) 00000391 SETVAL ENDB1$B,0,(+,BLOKPT$B,0,) 00000392 / SETVAL BLOKPT$B,0,(+,NSUBS,0,) 00000393 / SETVAL NI,0,(+,NI,0,+,1,0,) 00000394 LADR 4,T$7ARGM,NSUBS 00000395 ST 4,NSUBS 00000396 / SETVAL N,0,(+,NSUBS,0,) 00000397 / SET000 NHAK2,0 00000398 LA 2,C2A BACK=ADDR(C2A) 00000399 LA 9,SEAR2 BASE REGISTER 00000400 SET111 K5,0 00000401 B C8 END5 STILL = 0 00000402 /C2A CMP000 NI,0 00000403 / BE IFO7 ERROR IN BLOCK,DO ARGS */ 00000404 / CMPCAR A,NI,C' ',1 00000405 / BE C8 00000406 / CMPCAR A,NI,C',',1 00000407 / BE C2 00000408 / CMPCAR A,NI,C')',1 00000409 / BE C2 00000410 / CMPCAR A,NI,C'(',1 00000411 / BNE C9 00000412 / SETVAL NHAK2,0,(+,NHAK2,0,+,1,0,) 00000413 / B C9 00000414 C2 SETVAL NHAK5,0,(+,NHAK2,0,) 00000415 / CMPCAR A,NI,C')',1 00000416 / BNE L0056 00000417 / SETVAL NHAK2,0,(+,NHAK2,0,-,1,0,) 00000418 L0056 CMP000 NHAK5,0 00000419 / BNE C9 00000420 L 1,N 00000421 L 4,K5 TERMINATE CURRENT WORD WITH ZEROS 00000422 SR 1,6 00000423 LR 3,4 PAD CHAR(K5) TILL CHAR(K1) 00000424 SR 3,6 00000425 SRA 3,2 00000426 AR 3,6 00000427 SLA 3,2 R3=((K5-1)/NRCHARS+1)*NRCHARS 00000428 AR 4,1 K1=R3 00000429 AR 3,1 00000430 L0057 MVI IT(4),X'00' 00000431 AR 4,6 00000432 CR 3,4 00000433 BNL L0057 00000434 ST 4,N N=ADDR(IT(N).CHAR(K1+1)) 00000435 CMPVAL NHAK2,0,(-,1,0,) 00000436 BE LL010 00000437 LADR 4,T$7ARGM,N 00000438 ST 4,N 00000439 SET111 K5,0 00000440 B C8 00000441 LL010 SETVAL T$0WORD,N,(-,1,0,) LIST TERMINATOR 00000442 LADR 4,T$0NEXTW,N 00000443 ST 4,N 00000444 / CMPVAL NDIMU,0,(+,N,0,) 00000445 / BL IFO4 NO SPACE FOR BLOCK,DO ARGS */ 00000446 / SETVAL NSUBS,0,(+,N,0,) 00000447 CALLFTN RWND 00000448 /COPYB2 PINPHU NTAP3 SEARCH BLOCK ON TAPE3 */ 00000449 / CMPCAR IBUF,7,C'TAPE END ',9 00000450 / BE IFO2 /* PROBLEMS WITH BLOCKS */ 00000451 L 3,MBE 00000452 USING T$6,3 IF IBUF(7) NE IT(MBE).BNAME THEN GOTO COPYB 00000453 CLC IBUF+4*6(T$6BTYPE-T$6BNAME),T$6BNAME 00000454 DROP 3 00000455 BNE COPYB2 00000456 / CMP000 ITAR1,1 00000457 / BNE IFO2 PROBLEMS WITH BLOCKS */ 00000458 / SETVAL ITAR1,1,(+,NTAP1,0,) 00000459 / SETVAL NTAP1,0,(+,NTAP3,0,) 00000460 / PINPHU NTAP1 00000461 L 15,=A(BREAK) 00000462 BALR 14,15 00000463 / CMP000 NCONT,3 00000464 / BE L0062 00000465 / SETVAL IBUF,0,(+,NTAP2,0,) PRINT INPUT */ 00000466 SETVAL IBUF,3,(-,1,0,) 00000467 CALLFTN LIJN 00000468 /L0062 SETVAL N,0,(+,NSUBS,0,) 00000469 / SET000 NI,0 00000470 / SET000 END5,0 00000471 LA 2,S1A BACK=ADDR(S1A) 00000472 LA 9,SEAR2 BASE ADDRESS 00000473 / B C8 00000474 /S1A CMP000 NI,0 00000475 / BE C8 00000476 / CMPCAR A,NI,C'(',1 00000477 / BNE C8 00000478 / SETVAL NHAK2,0,(+,BLOKPT$B,0,) 00000479 /S1 SETVAL N,0,(+,NSUBS,0,) 00000480 LA 2,S1B BACK=ADDR(S1B) 00000481 LA 9,SEAR2 BASE ADDRESS 00000482 SET111 K5,0 00000483 B C8 00000484 /S1B CMP000 NI,0 00000485 / BE IFO7 ERROR IN BLOCK,DO ARGS */ 00000486 / CMPCAR A,NI,C')',1 00000487 / BE S1C 00000488 / CMPCAR A,NI,C',',1 00000489 / BE S1C 00000490 / CMPCAR A,NI,C' ',1 00000491 BE C8 00000492 CMPCAR A,NI,C'A',1 LETTERS OR NUMBERS 00000493 BL IFO7 00000494 / B C9 00000495 *** FORMAT OF ARG LIST FOR BLOCKS.NHAK2 IS POINTER ALONG THIS LIST. * 00000496 *** SYMBOL,ARGUMENT,SYMBOL,ARGUMENT,...7776 * 00000497 *** BLOKPT$B NHAK2 NSUBS * 00000498 *** ARG IS ACTUAL PARAMETER OF COPY CARD.HAS ANY LENGTH AND ENDS ON 8 * 00000499 *** BINARY ZEROS * 00000500 *** SYMBOL IS DUMMY OF BLOCK DEFINITION AND IS 2 WORDS LONG. * 00000501 S1C L 3,NHAK2 IT(NHAK2).DUMMY=IT(NSUBS).DUMMY 00000502 L 4,NSUBS 00000503 USING T$7,3 00000504 MVC T$7DUMMY(T$7ARGM-T$7DUMMY),IT(4) 00000505 DROP 3 00000506 L 7,K5 00000507 AR 7,3 ZERO FILL 00000508 SR 7,6 00000509 LR 8,6 00000510 LADR 9,T$7ARGM,NHAK2 00000511 ST 9,NHAK2 DESTROYS BASE ADDRESS OF SEAR2 00000512 SR 9,6 00000513 LL014 MVI IT(7),X'00' 00000514 BXLE 7,8,LL014 00000515 S1D CMP000 T$0CHARR,NHAK2 SEARCH LOCATION FOR NEXT DUMMY 00000516 LADR 4,T$0NEXTW,NHAK2 00000517 ST 4,NHAK2 00000518 BNE S1D 00000519 / CMPCAR A,NI,C',',1 00000520 / BE S1 RESTART NEW ARGM */ 00000521 SETVAL MBE,0,(+,MBE5,0,) END OF SAFETY 00000522 LADR 4,T$0NEXTW,NHAK2 00000523 S 4,NSUBS 00000524 / BNE IFO7 NR OF ARGUMENTS INCONSISTENT 00000525 SETVAL BLOKPT$L,0,(+,NSUBS,0,-,BLOKPT$B,0,) 00000526 LA 4,2*(T$0NEXTW-T$0WORD)+(T$7ARGM-T$7DUMMY) 00000527 S 4,BLOKPT$L 00000528 BH IFO7 00000529 BNE S1E 00000530 CMPCAR T$7DUMMY,BLOKPT$B,X'0000000000000000',8 00000531 BNE S1E 00000532 SETVAL NSUBS,0,(+,BLOKPT$B,0,) THERE ARE NO ARGM S 00000533 / SET000 BLOKPT$B,0 00000534 / SET000 BLOKPT$L,0 00000535 /S1E CMP000 IAL,0 00000536 / BNE L0063 00000537 SET000 ENDB1$B,0 00000538 SET000 ENDB1$L,0 00000539 B XCOPYB1 00000540 /L0063 L 1,BLOKPT$B INTERCHANGE BLOKPT AND ENDB1 00000541 L 2,ENDB1$B 00000542 ST 2,BLOKPT$B 00000543 ST 1,ENDB1$B 00000544 L 1,BLOKPT$L 00000545 L 2,ENDB1$L 00000546 ST 2,BLOKPT$L 00000547 ST 1,ENDB1$L 00000548 B XCOPYB1 00000549 IFO2 ERROR 2,' PROBLEMS WITH BLOCKS' 00000550 IFO4 ERROR 2,' NO SPACE FOR BLOCK ARGUMENTS' 00000551 IFO7 ERRORP 2,' ERROR IN BLOCK ARGUMENTS' 00000552 COPYB1 EPI 00000553 FFOUT 2,'COPY' 00000554 LTORG 00000555 ** 00000556 ** /* END5 IS INCOMING PARAMETER FOR SEAR2. K5 IS OUTGOING */ 00000557 ** /* VALUE FOR FURTHER PADDING IN SEAR4. */ 00000558 *** SEAR3: PROCEDURE(END5,K5); /* POSITION AT LAST SPECIAL CHAR 00000559 SEAR3 PRO 00000560 / SETVAL N,0,(+,MBE,0,) 00000561 / SETVAL NI,0,(+,NI,0,+,1,0,) 00000562 SET000 SPEC5,0 00000563 CMPCAR A,NI,C'+',1 00000564 BE LL013 00000565 CMPCAR A,NI,C'-',1 00000566 BE LL013 00000567 CMPCAR A,NI,C'A',1 00000568 BNL LL013 JP IF NOT SPECIAL 00000569 SET111 SPEC5,0 00000570 LL013 LA 2,SEAR3A BACK=ADDR(SEAR3A) 00000571 LA 9,SEAR2 BASE REGISTER 00000572 / B C8 00000573 /SEAR3A CMPVAL NI,0,(+,73,0,) 00000574 BE XSEAR3 00000575 / CMP000 NI,0 00000576 BE XSEAR3 00000577 CMPCAR A,NI,C'+',1 00000578 BE SEAR3C 00000579 CMPCAR A,NI,C'-',1 00000580 BE SEAR3C 00000581 CMPCAR A,NI,C'A',1 00000582 BNL SEAR3C 00000583 SET111 SPEC5,0 00000584 B C8 SKIP SPECIAL CHARACTERS 00000585 /SEAR3C CMP000 SPEC5,0 00000586 / BE C8 SKIP NONSPEC. FIRST GROUP */ 00000587 LADR 4,A,NI POSITIONED. ASSEMBLE BLOCK NAME OR ARGM 00000588 L 1,MBE 00000589 MVC IT(1,1),0(4) 00000590 / SETVAL K5,0,(+,2,0,) 00000591 LA 2,SEAR3B BACK=ADDR(SEAR3B) 00000592 / B C8 00000593 SEAR3B CMPVAL NI,0,(+,73,0,) 00000594 BE XSEAR3 00000595 / CMP000 NI,0 00000596 BE XSEAR3 00000597 / CMPCAR A,NI,C' ',1 00000598 / BE C8 00000599 / CMPCAR A,NI,C',',1 00000600 BE XSEAR3 00000601 / CMPCAR A,NI,C')',1 00000602 BE XSEAR3 00000603 / CMPCAR A,NI,C'(',1 00000604 BE XSEAR3 00000605 / CMPCAR A,NI,C'=',1 00000606 BE XSEAR3 00000607 CMPCAR A,NI,C'+',1 00000608 BE C9 00000609 CMPCAR A,NI,C'-',1 00000610 BE C9 00000611 CMPCAR A,NI,C'A',1 00000612 BNL C9 STORE LETTER OF NAME 00000613 IFO6 ERRORP 3,' ILLEGAL CHAR IN BLOCK,DO ARGM' 00000614 SEAR3 EPI 00000615 *** SEAR4: PROCEDURE(K5); /* PAD BLOCKNAME WITH BLANKS */ 00000616 SEAR4 PRO 00000617 / SETVAL NI,0,(+,NI,0,-,1,0,) 00000618 L 1,K5 NR OF CHARS + 1 00000619 LA 4,L'T$6BNAME 00000620 L 2,MBE 00000621 AR 2,1 00000622 SR 2,6 00000623 SR 4,1 00000624 BL XSEAR4 00000625 MVI IT(2),C' ' 00000626 BE XSEAR4 00000627 SR 4,6 00000628 EX 4,PADDERS 00000629 SEAR4 EPI 00000630 PADDERS MVC 1(1,2),IT(2) 00000631 *** 00000632 *** THIS ROUTINE SCANS CHARACTERS OF INPUT CARD. WITH CONTINUATION * 00000633 *** CARDS FOR NBLOCK AND BLOCK ARGS. TILL END OF CARD FOR DO,ENDDO. * 00000634 *** C9=INSPECT AND STORE. C8=INSPECT AND SKIP. * 00000635 DS 0H 00000636 USING *,9 00000637 SEAR2 B 0(2) GO TO CONTENT(BACK). DO NOT USE R2,R9 00000638 C9 L 1,N ENTRY POINT 00000639 L 5,K5 IT(N).CHAR(K)=A(NI).CHARL 00000640 AR 1,5 K5=K5+1 00000641 AR 5,6 00000642 SR 1,6 00000643 ST 5,K5 00000644 LADR 3,A,NI 00000645 MVC IT(1,1),0(3) 00000646 /C8 SETVAL NI,0,(+,NI,0,+,1,0,) INSPECT WITHOUT STORING */ 00000647 / CMPVAL NI,0,(+,73,0,) 00000648 / BL SEAR2 00000649 / CMP000 END5,0 00000650 / BNE SEAR2 00000651 /C4 PINPHU NTAP1 SHOULD NOT USE K5 00000652 L 15,=A(BREAK) 00000653 BALR 14,15 00000654 / CMPCAR A,1,C' ',1 00000655 / BNE L0055 00000656 / SET000 NBLAN5,0 CONTINUATION CARD* 00000657 / B C6 MUST BE PRINTED. */ 00000658 /L0055 SET111 NBLAN5,0 00000659 / CMPCAR A,1,C'C',1 00000660 / BNE C5 00000661 / CMPCAR IBUF,7,C'COMMON',6 00000662 / BE C5 00000663 / CMPCAR IBUF,7,C'COPY',4 00000664 / BE C5 00000665 L 15,=A(PRIN3) PRINT COMMENT CARD 00000666 BALR 14,15 00000667 / B C4 00000668 C6 L 15,=A(PRIN3) 00000669 BALR 14,15 00000670 /C5 SET000 END5,0 00000671 / SET000 NI,0 00000672 / CMP000 NBLAN5,0 00000673 / BNE SEAR2 00000674 / B C8 00000675 DROP 9 00000676 ** 00000677 **** BEGIN OF A DO CYCLE 00000678 *** DOPT1=ABS ADDRESS OF BEGINNING OF DOLOOP * 00000679 *** DOLIST=BEGIN OF LIST OF DO VARIABLES * 00000680 DO1 PRO 00000681 CMP000 MFOUT,0 00000682 BE LL020 00000683 L 15,=A(BREAK) 00000684 BALR 14,15 00000685 B XDO1 00000686 LL020 LA 4,T$5CARD-T$5SPACE SAFETY 00000687 A 4,MBE 00000688 ST 4,MBE 00000689 / SET000 DODEPTH,0 00000690 / SETVAL DOPT1,0,(+,NSUBS,0,) WILL GENERATE IT.DOJMP=4 00000691 / SETVAL DOLIST,0,(+,NSUBS,0,+,4,0,) 4 IS TERMINATOR OF LIST 00000692 DO2 L 15,=A(BREAK) 00000693 BALR 14,15 00000694 / SETVAL DOCARD,0,(+,NSUBS,0,) CHAINING LIST OF DO VARIABS */ 00000695 / SETVAL DODEPTH,0,(+,DODEPTH,0,-,1,0,) 00000696 / SETCAR T$3DODIR,NSUBS,X'77',1 00000697 / SETVAL T$3DOJMP,NSUBS,(+,DOLIST,0,-,DOPT1,0,) 00000698 / SETVAL DOLIST,0,(+,NSUBS,0,) 00000699 / SET111 NI,0 00000700 DO8 L 15,=A(DO3) 00000701 BALR 14,15 00000702 SETNAM T$3JNAM,DOLIST,T$4NAM,N 00000703 SETVAL T$3JVAL,DOLIST,(+,T$4VAL,N,) 00000704 CMPVAL NI,0,(+,73,0,) 00000705 BE IFO3 ERROR IN BLOCK,DO ARGUMENTS 00000706 L 15,=A(DO3) 00000707 BALR 14,15 00000708 SETNAM T$3J1NAM,DOLIST,T$4NAM,N 00000709 SETVAL T$3J1VAL,DOLIST,(+,T$4VAL,N,) 00000710 CMPVAL NI,0,(+,73,0,) 00000711 BE IFO3 ERROR IN BLOCK,DO ARGUMENTS 00000712 L 15,=A(DO3) 00000713 BALR 14,15 00000714 SETNAM T$3J2NAM,DOLIST,T$4NAM,N 00000715 SETVAL T$3J2VAL,DOLIST,(+,T$4VAL,N,) 00000716 CMPVAL NI,0,(+,73,0,) 00000717 BNE LL007 00000718 SETCAR T$3J3NAM,DOLIST,X'0000000000',5 LNAME$=5 00000719 SET111 T$3J3VAL,DOLIST 00000720 B DO41 00000721 LL007 L 15,=A(DO3) 00000722 BALR 14,15 00000723 SETNAM T$3J3NAM,DOLIST,T$4NAM,N 00000724 SETVAL T$3J3VAL,DOLIST,(+,T$4VAL,N,) 00000725 CMPVAL NI,0,(+,73,0,) 00000726 BNE IFO3 ERROR IN BLOCK,DO ARGUMENTS 00000727 DO41 LADR 4,T$3LOOP,DOLIST 00000728 ST 4,NSUBS 00000729 ** 00000730 /DO4 PINPHU NTAP1 END OF ANALYSIS OF DOCARD */ 00000731 L 15,=A(PRIN3) READ CARDS INSIDE THE DOLOOP 00000732 BALR 14,15 00000733 / CMPCAR IBUF,7,C'DO',2 00000734 / BE DO2 00000735 / CMPCAR IBUF,7,C'ENDDO',5 00000736 / BE ENDDO1 00000737 LOAD 9,IBUF,4 DO J = 1 TO IBUF(4)-1 00000738 SR 9,6 00000739 DOLOOP J,1,,1,LL005,LL006 00000740 SETVAL K2,0,(+,6,0,+,J,0,) IT(NSUBS+J-1).WORD=IBUF(6+J).WOR 00000741 SETVAL T$0WORD,NSUBS,(+,IBUF,K2,) 00000742 LADR 1,T$0NEXTW,NSUBS 00000743 ST 1,NSUBS 00000744 BXLE 7,8,LL005 00000745 LL006 B DO4 00000746 *** 00000747 ENDDO1 L 15,=A(BREAK) ENDDO J,K,L 00000748 BALR 14,15 00000749 / SET111 NI,0 00000750 /ENDDO3 SETVAL NI,0,(+,NI,0,-,1,0,) 00000751 / SET111 END5,0 00000752 L 15,=A(SEAR3) 00000753 BALR 14,15 00000754 CMPCAR T$0WORD,MBE,X'00',1,EQ,IFO3 NO DOLOOP VARIABLES 00000755 / SETVAL DODEPTH,0,(+,DODEPTH,0,+,1,0,) 00000756 / SETCAR T$3DODIR,NSUBS,X'70',1 00000757 / SETVAL T$3DOJMP,NSUBS,(+,DOLIST,0,-,DOPT1,0,) CHAINING LIST 00000758 SETVAL DOLIST,0,(+,DOPT1,0,+,T$3DOJMP,DOLIST,) 00000759 LADR 4,T$3NEXT3,NSUBS 00000760 ST 4,NSUBS 00000761 / CMPVAL NI,0,(+,73,0,) 00000762 / BNE ENDDO3 00000763 CMP000 DODEPTH,0 00000764 BH DO4 00000765 / BNE IFO3 ERROR IN BLOCK,DO ARGS * 00000766 CMPVAL DOPT1,0,(+,DOLIST,0,-,4,0,) 00000767 BNE IFO3 00000768 SETVAL T$0WORD,NSUBS,(-,1,0,) TERMINATOR 00000769 / SET000 DOCARD,0 00000770 LADR 4,T$0NEXTW,NSUBS 00000771 ST 4,NSUBS 00000772 LA 4,T$5CARD-T$5SPACE END OF SAFETY 00000773 LNR 4,4 00000774 A 4,MBE 00000775 ST 4,MBE 00000776 / CMPVAL NDIMU,0,(+,NSUBS,0,) 00000777 / BL IFO8 /* NO SPACE FOR BLOCK,DO ARGS */ 00000778 / CMPVAL NSUBS,0,(+,DOPT1,0,) 00000779 / BL IFO3 ERROR IN BLOCK,DO ARGS */ 00000780 SETVAL DOVLAG$L,0,(+,NSUBS,0,-,DOPT1,0,) 00000781 SETVAL DOVLAG$B,0,(+,DOPT1,0,) 00000782 B XDO1 00000783 IFO3 ERRORP 3,' ERROR IN DO LOOP ARGUMENTS' 00000784 IFO8 ERROR 3,' NO SPACE FOR DO LOOP ARGUMENTS' 00000785 DO1 EPI 00000786 ** 00000787 DO3 PRO 00000788 SETVAL NI,0,(+,NI,0,-,1,0,) ANALYZE DO J=1,3,N 00000789 / SET000 MINUS5,0 00000790 / SET111 END5,0 00000791 L 15,=A(SEAR3) INTERMEDIATE STORAGE AT N=MBE 00000792 BALR 14,15 00000793 CMPVAL K5,0,(+,8,0,) MAX NR OF CHARS FOR A NUMBER 00000794 BNH LL011 00000795 SETVAL K5,0,(+,8,0,) INCLUDING SIGN 00000796 LL011 SET111 K2,0 00000797 DO6 CMPVAL K2,0,(+,K5,0,) 00000798 BH IFO10 00000799 L 1,MBE 00000800 A 1,K2 00000801 SR 1,6 00000802 CLI IT(1),C'+' 00000803 BNE LL015 00000804 SET000 MINUS5,0 00000805 SETVAL K2,0,(+,K2,0,+,1,0,) 00000806 / B DO6 00000807 LL015 CLI IT(1),C'-' 00000808 BNE LL016 00000809 / SET111 MINUS5,0 00000810 SETVAL K2,0,(+,K2,0,+,1,0,) 00000811 / B DO6 00000812 LL016 CLI IT(1),C'0' 00000813 BL LL017 00000814 L 2,MBE CONVERT DISPLAY CODE TO BINARY. 00000815 A 2,K5 00000816 SR 2,6 00000817 SR 9,9 00000818 LL018 M 8,=F'10' 9 IS MULTIPLICAND 00000819 SR 8,8 00000820 IC 8,IT(1) 00000821 S 8,=X'000000F0' =C'0' 00000822 AR 9,8 RESULT=RESULT*10+CHAR 00000823 AR 1,6 00000824 CR 1,2 00000825 BL LL018 00000826 STORE 9,T$4VAL,MBE 00000827 SETCAR T$4NAM,MBE,X'0000000000',5 LNAME$=5 00000828 CMP000 MINUS5,0 00000829 BE XDO3 00000830 LNR 9,9 00000831 STORE 9,T$4VAL,MBE 00000832 B XDO3 00000833 LL017 CLI IT(1),C'A' 00000834 BL IFO10 00000835 L 1,MBE 00000836 A 1,K5 ZERO FILL THE NAME 00000837 MVC IT(5,1),=X'0000000000' LNAME$=5 00000838 SET000 T$4VAL,N 00000839 B XDO3 00000840 IFO10 ERRORP 3,' FORMAT ERROR ON DO CARD' 00000841 DO3 EPI 00000842 *** 00000843 PRIN3 PROLOGH 00000844 *** FULL PROLOGH REQUIRED BY SEAR2,SEAR3 00000845 / CMP000 NCONT,3 PRINT INPUT 00000846 BE XPRIN3 00000847 / CMP000 ISPLAY,0 00000848 / BE L0067 00000849 / CMPVAL NTAP1,0,(+,3,0,) 00000850 BNE XPRIN3 00000851 /L0067 SETVAL IBUF,1,(+,NTAP2,0,) 00000852 / SET000 IBUF,3 00000853 CALLFTN LIJN 00000854 XPRIN3 EPILOGH 00000855 ** 00000856 WREND1 PRO WRITE TAPE END ON TAPE3 00000857 / SETVAL IBUF,1,(+,NTAP3,0,) 00000858 / SET000 IBUF,3 00000859 SETVAL IBUF,4,(+,2,0,) LENGTH OF TEXT 00000860 / SETCAR IBUF,6,C'TAPE END',8 00000861 CALLFTN LIJN 00000862 CALLFTN RWND 00000863 WREND1 EPI 00000864 *** 00000865 *** BRINGS CARD IMAGES INTO A(20) .CARDS FROM INPUT (LEESPT=0) ARE IN * 00000866 *** IBUF AND 20 WORDS LONG, UNLESS BLANK SUPPRESSION TOOK PLACE, WITH * 00000867 *** 00B AS DELIMITER. CARDS FROM BLOCKARGS ARE AT IT(LEESPT) AND CAN */ 00000868 *** HAVE ANY LENGTH. 00B IS DELIMITER. EXPANDED PER 18 WORDS. */ 00000869 *** CARDS ARE CONVERTED FROM BCD TO EBCDIC AND CHECKED FOR ILLEGAL 00000870 *** CHARS. THOSE ARE REPLACED BY QUESTION MARKS . */ 00000871 BREAK PROLOGH 00000872 *** FULL PROLOGH REQUIRED BY SEAR2,SEAR3 00000873 &PTR SETA 4 00000874 &AAA SETA 3 00000875 LADR &AAA,A,1 00000876 L &PTR,LEESPT 00000877 SR 1,1 00000878 SR 2,2 00000879 CR &PTR,0 00000880 BNE LL008 00000881 MVC 0(80,&AAA),IBUF+4*6 00000882 TR 0(72,&AAA),BCD ILLEGAL CHARS BECOME QUESTION MARKS 00000883 B LL009 00000884 LL008 MVC 0(72,&AAA),IT(&PTR) 00000885 LL009 TRT 0(72,&AAA),LIMIT 00000886 BC 8,BREAK1 JP IF NO DELIMITER SEEN 00000887 CR 2,6 X'01' IS ILLEGAL. X'02' IS DELIMITER 00000888 BE BREAK2 ERROR 00000889 MVI 0(1),C' ' LENGT=&AAA+80-R1-1 (INSERTED HERE ) 00000890 LA 5,78(0,&AAA) MOVES =LENGT-1 00000891 SR 5,1 NR OF MOVES IN ORDER TO PAD 00000892 EX 5,PADDERB 00000893 CR &PTR,0 00000894 BE XBREAK 00000895 ST 0,LEESPT 00000896 MVC 0(1,1),BIND1 00000897 B XBREAK 00000898 BREAK1 CR &PTR,0 00000899 BE XBREAK 00000900 LA &PTR,72(0,&PTR) 00000901 ST &PTR,LEESPT 00000902 B XBREAK 00000903 BREAK2 SR 1,&AAA LOCATION OF ILLEGAL CHAR 00000904 AR 1,6 00000905 ST 1,NI 00000906 IFO5 ERRORP 3,' ILLEGAL CHARACT ON INPUT CARD' 00000907 XBREAK EPILOGH 00000908 SAVEFTN DS 18F 00000909 PADDERB MVC 1(1,1),0(1) 00000910 LIMIT DC X'02',63X'01',X'00',10X'01',4X'00',X'01',X'00' 00000911 DC 11X'01',2X'00',2X'01',2X'00',9X'01',2X'00',14X'01' 00000912 DC X'00',2X'01',X'00',66X'01',9X'00',7X'01',9X'00' 00000913 DC 8X'01',8X'00',6X'01',10X'00',6X'01' 00000914 BCD DC X'00',63X'6F',X'40',10X'6F',X'4B5D4D4E',X'6F',X'4E' 00000915 DC 11X'6F',X'5C5D',2X'6F',X'6061',9X'6F',X'6B4D',14X'6F' 00000916 DC X'7E',2X'6F',X'7E',66X'6F',X'C1C2C3C4C5C6C7C8C9' 00000917 DC 7X'6F',X'D1D2D3D4D5D6D7D8D9',8X'6F',X'E2E3E4E5E6E7E8E9' 00000918 DC 6X'6F',X'F0F1F2F3F4F5F6F7F8F9',6X'6F' 00000919 *** 00000920 FFOUT 3,'DO,BREAK' 00000921 END 00000922 ./A INSERT,INCR=1 00000001 ./MACRO MAINMCRO 00000002 ./MACRO EXECMCRO 00000003 TITLE 'INSERT' 00000004 GBLC &OVLAY 00000005 ./MACRO EXECCOM 00000006 ./MACRO MAINCOM 00000007 *** 00000008 *** 00000009 PRINT NOGEN 00000010 INSERT0 CSECT 00000011 EQUIVAL 00000012 ENTRY INSER1,INSER2 00000013 EXTRN FOUT,BRIAN,EVNUM,EVFUN,SEARCH,TAKMAN,UNCF,INDCR,CROSR 00000014 USING EXECCOM,10 00000015 USING BLANK,11 00000016 /INSER1 PRO KBE 00000017 STORE 1,KBE,0 END OF CALLING SEQUENCE 00000018 *** IGET=IGET*IT(KBE).COEFF; 00000019 LOAD 0,IGET,0 00000020 LOAD 4,T$1COEFF,KBE 00000021 MULTP 00000022 STORE 0,IGET,0 00000023 CMP000 IGET,0,EQ,XINSER1 00000024 / SETVAL MBE1,0,(+,MBE,0,) 00000025 SET000 T$0WORD,MBE ONLY FOR DEBUG PURPOSES 00000026 / SETVAL MBE,0,(+,MBE,0,+,NEXTQ,0,) SAFETY */ 00000027 SET000 T$0WORD,MBE ONLY FOR DEBUG PURPOSES 00000028 / SET000 K,0 00000029 / SET000 OLDCODE,0 00000030 / SET000 NEWCODE,0 00000031 *** UNPACK CODE OF EXPRS ( 2 PER WORD ) TO CODE ( 1 PER WORD ). */ 00000032 *** AT THE SAME TIME, REPLACE DUMMIES BY THEIR VALUE AS GIVEN IN */ 00000033 *** DUMMY KEY ( STARTING AT KEY$NOW ) . THIS VALUE CAN BE A */ 00000034 *** SIMPLE QUANTITY OR A QUANTITY PRECEDED BY AN OPERATOR . IF THE */ 00000035 *** DUMMY ITSELF WAS ALREADY PRECEDED BY AN OPERATOR, 2 OPERATORS */ 00000036 *** BEHIND EACH OTHER MAY RESULT. IF BOTH ARE IN THE RANGE 1407B, */ 00000037 *** 1413B THEN THEY CAN BE REDUCED TO 1 OR 0 OPERATOR. FINALLY */ 00000038 *** 1407B NUMBER CAN ALWAYS BE REPLACED BY -NUMBER . EG 1407 3776 */ 00000039 *** BECOMES 3401B */ 00000040 *** EXAMPLES OF POSSIBLE CASES. */ 00000041 *** 2002 0001 BECOMES 2002 3403 (NORMAL CASE) */ 00000042 *** 2002 0001 BECOMES 2002 7777 (UNDEFINED DUMMY) */ 00000043 *** 2002 0001 BECOMES 2002 1407 2003 */ 00000044 *** 1407 0001 BECOMES 1407 1407 2003 BECOMES 2003 */ 00000045 *** 1407 0001 BECOMES 1407 1412 2405 BECOMES 1413 2405 */ 00000046 *** 1407 0001 BECOMES 1407 3403 BECOMES 3774 */ 00000047 /INA1 SETVAL OLDCODE,0,(+,NEWCODE,0,) 00000048 / SETVAL K,0,(+,K,0,+,1,0,) 00000049 / SETVAL NEWCODE,0,(+,T$1CODEA,-KBE-K-,) 00000050 /INA2 SETVAL MBE,0,(+,MBE,0,+,NEXTQ,0,) NEXTQ=LENGTH OF 1 EXPANDED 00000051 /INA6 SETVAL T$0SYMB,MBE,(+,NEWCODE,0,) 00000052 / CMPVAL -NEWCODE-TYPE-,0,(+,DUMMY,0,),NE,INA1 NORMAL CASE */ 00000053 / CMP000 NEWCODE,0,EQ,INA8 TERMINATOR */ 00000054 / CMPVAL KEY$NR,0,(+,-NEWCODE-NR-,0,),GE,L0001 00000055 / SETVAL NEWCODE,0,(+,X'1FF',0,) /* DUMMY WITHOUT VALUE */ 00000056 / B INA6 /*OVERWRITE DU WITH VALUE*/ 00000057 L0001 LOAD 4,-NEWCODE-NR-,0 00000058 *** NEWCODE=IT(KEY$NOW+NEWCODE.NR*NEXTK).VAR; 00000059 SLA 4,2 MULTIPLY BY NEXTK 00000060 A 4,KEY$NOW 00000061 ST 4,II5 00000062 SETVAL NEWCODE,0,(+,T$0VAR,II5,) 00000063 GETOPR NEWCODE,0,QUANT,INA3 00000064 / CMPVAL OLDCODE,0,(+,X'307',0,),LT,INA4 RANGE OF OPERATOR */ 00000065 / CMPVAL OLDCODE,0,(+,X'30B',0,),GT,INA4 MULTPLIC TABLE */ 00000066 / CMPVAL QUANT,0,(+,X'307',0,),LT,INA4 00000067 / CMPVAL QUANT,0,(+,X'30B',0,),GT,INA4 00000068 *** QUANT=TAB(QUANT-1407B,OLDCODE-1407B); 00000069 L 1,QUANT 00000070 L 2,OLDCODE 00000071 LA 3,X'307' 00000072 SR 1,3 00000073 SR 2,3 00000074 LR 3,2 00000075 SLA 2,2 00000076 AR 2,3 R2=5*(OLDCODE-307) 00000077 AR 1,2 00000078 SLA 1,1 00000079 LH 3,TAB1(1) 00000080 ST 3,QUANT 00000081 / SETVAL MBE,0,(+,MBE,0,-,NEXTQ,0,) OVERWRITE OLD OPERATOR */ 00000082 / CMP000 QUANT,0,EQ,INA6 00000083 ** /* BOTH OPERATORS CANCELLED EACH OTHER */ 00000084 /INA4 SETVAL T$0SYMB,MBE,(+,QUANT,0,) 00000085 / SETVAL OLDCODE,0,(+,QUANT,0,) 00000086 / B INA2 00000087 /INA3 CMPVAL -NEWCODE-TYPE-,0,(+,NUMBER,0,),NE,INA6 GO OVERWR DU 00000088 / CMPVAL OLDCODE,0,(+,MINUS,0,),NE,INA6 00000089 / SETVAL -NEWCODE-NR-,0,(-,-NEWCODE-NR-,0,) 00000090 / SETVAL MBE,0,(+,MBE,0,-,NEXTQ,0,) GO OVERWRITE MINUS BY -NR 00000091 / B INA6 00000092 *** MULTP MINUS,CONJG,CONJGM,INTEG,INTEGM 00000093 TAB1 DC Y(0,CONJGM,CONJG,INTEGM,INTEG) MINUS 00000094 DC Y(CONJGM,0,MINUS,INTEG,INTEGM) CONJG 00000095 DC Y(CONJG,MINUS,0,INTEGM,INTEG) CONJGM 00000096 DC Y(INTEGM,INTEG,INTEGM,INTEG,INTEGM) INTEG 00000097 DC Y(INTEG,INTEGM,INTEG,INTEGM,INTEG) INTEGM 00000098 /INA8 SETVAL MBE,0,(+,MBE,0,+,NEXTQ,0,) 00000099 SETMAX MMBE,MBE 00000100 CMPVAL MBE,0,(+,NDIMT,0,),GT,IFO10 TOO MUCH INPUT (IT) */ 00000101 / SETVAL J,0,(+,MBE1,0,+,2*NEXTQ,0,) 00000102 SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000103 JUMP VERDR1 00000104 IFO10 ERROR 4,' TOO MUCH INPUT' 00000105 DROP 12 00000106 DS 0H 00000107 USING *,12 00000108 INSER1 EPI 00000109 FFOUT 4,'INA' 00000110 LTORG 00000111 ** 00000112 *** J POINTS TO EXPANDED QUANTITIES. VALID TILL END OF ROUTINE INSER1 * 00000113 *** CODE AND NEWCODE ARE GLOBAL VARS FOR INSER1. NOT TO BE CHANGED */ 00000114 *** IN SUBROUTINES */ 00000115 *** IT(J).SYMB IS 1 EXPANDED QUANTITY, HEAD + TAIL TOGETHER */ 00000116 DS 0H 00000117 USING *,12 00000118 VERDR1 B VERDER 00000119 /VERDR2 SETVAL J,0,(+,J,0,+,NEXTQ,0,) INSPECT EXPANDED QUANTITIES 00000120 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000121 /VERDER SETVAL CODE,0,(+,NEWCODE,0,) 00000122 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000123 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000124 LOAD 4,-CODE-TYPE-,0 00000125 LA 1,VECTNR END OF TABLE 00000126 CR 4,1 00000127 BNL DOT1 00000128 SLA 4,2 00000129 L 2,TAB2(4) 00000130 BR 2 00000131 TAB2 DC A(DUM1,IND1,VEC1,OPE1,ALG1,EXR1,FUN1,NUM1) 00000132 ** 00000133 /DUM1 CMP000 CODE,0,NE,IFO2 UNRECOGNIZED QUANTITY */ 00000134 ** /* DUMMIES SHOULD HAVE BEEN REPLACED BY NOW */ 00000135 /EXI1 SETVAL MBE,0,(+,MBE1,0,) 00000136 SETMAX MNEPS,NEPS 00000137 CMP000 NF,0,EQ,EXI3 00000138 / CMPVAL NMULT,0,(+,NF,0,),GT,IFO4 INSERT COUNT LIMIT */ 00000139 /EXI3 SETVAL NMULT,0,(+,NMULT,0,+,1,0,) 00000140 EXI4 JUMP XINSER1 COME FROM ZERO TERMS 00000141 ** 00000142 *** CASE OF VECTOR */ 00000143 /VEC1 CMPVAL CODE,0,(+,ARGFU0,0,),LE,L0002 00000144 / SETVAL CODE,0,(+,CODE,0,-,ARGFU0,0,+,FUNCT0,0,) 00000145 / B FUN1 FUNCT AS FU ARG */ 00000146 /L0002 CMPVAL NEWCODE,0,(+,MINUS,0,),NE,VEC3 00000147 / NEGATE IGET,0 P(-MU)=-P(MU) */ 00000148 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000149 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000150 / B VEC3 00000151 ** 00000152 *** CASE OF ALGEBRA. ADD EXPONENT IN ORDER TO MULTIPLY */ 00000153 ALG1 SETVAL II5,0,(+,-CODE-NR-,0,) 00000154 SGNEXT RESULFX,0,-NEWCODE-NR-,0 00000155 SETVAL IPR1,II5,(+,IPR1,II5,+,RESULFX,0,) 00000156 / CMPVAL -NEWCODE-TYPE-,0,(+,NUMBER,0,),NE,IFO5 ILLEGAL EXPON 00000157 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000158 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000159 / B VERDER 00000160 ** 00000161 *** CASE OF AN EXPRESSION */ 00000162 EXR1 SETVAL EXPR,0,(+,CODE,0,) 00000163 CCALL NUMWO1 NSUC,EXPR,RESULT 00000164 / CMP000 NSUC,0,GE,NUM2 00000165 / SET111 FLAG,0 DISTINGUISH FROM CONJG CASE */ 00000166 EXR1A CCALL EXR1B 00000167 / CMP000 FLAG,0,GE,VERDER COME FROM EXR1 */ 00000168 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000169 / SETVAL P$VAR,NEPS,(+,CONJG2,0,) COME FROM COE1 */ 00000170 / B VERDER 00000171 ** 00000172 *** CASE OF DOTPRODUCT OR VECTOR COMPONENT OR INDEX */ 00000173 DOT1 LOAD 1,-CODE-VECT1-,0 00000174 CR 1,6 IF CODE.VECT1 LE 1 THEN GOTO VERDER 00000175 BNH VERDER 00000176 ** /* COMPONENT OF VECTOR 0 OR 1 ARE FILNR OR FILELEN */ 00000177 /IND1 CMPVAL -NEWCODE-TYPE-,0,(+,OPERAT,0,),NE,DOT2 00000178 / CMPVAL NEWCODE,0,(+,MINUS,0,),NE,IFO5 ILLEGAL EXPONENT */ 00000179 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000180 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000181 / SETVAL -NEWCODE-NR-,0,(-,-NEWCODE-NR-,0,) 00000182 DOT2 SGNEXT RESULFX,0,-NEWCODE-NR-,0 00000183 / DOLOOP K,1,NDOTI,2,L0006,DOT3 00000184 / CMPVAL ISCAL,K,(+,CODE,0,),EQ,DOT4 00000185 / ENDDO L0006,2 00000186 DOT3 SETVAL NDOTI,0,(+,NDOTI,0,+,1,0,) 00000187 / SETVAL ISCAL,NDOTI,(+,CODE,0,) 00000188 / SETVAL NDOTI,0,(+,NDOTI,0,+,1,0,) 00000189 SETVAL ISCAL,NDOTI,(+,RESULFX,0,) 00000190 / B VERDR2 00000191 DOT4 SETVAL II5,0,(+,K,0,+,1,0,) 00000192 SETVAL ISCAL,II5,(+,ISCAL,II5,+,RESULFX,0,) 00000193 / B VERDR2 00000194 ** 00000195 *** CASE OF A NUMBER */ 00000196 NUM1 SGNEXT RESULFX,0,-CODE-NR-,0 00000197 FLOAT 0,RESULFX,0 00000198 STORE 0,RESULT,0 00000199 /NUM2 CMPVAL -NEWCODE-TYPE-,0,(+,NUMBER,0,),NE,IFO5 ILLEGAL EXPON 00000200 / CMP000 RESULT,0,NE,L0010 00000201 SGNEXT RESULFX,0,-NEWCODE-NR-,0 00000202 / CMP000 RESULFX,0,LT,IFO5 00000203 ** /* CASE OF 0**-NR */ 00000204 / SET000 IGET,0 00000205 / B EXI4 00000206 L0010 SGNEXT NEWCODE,0,-NEWCODE-NR-,0 00000207 PBRIAN IGET,0,RESULT,0,NEWCODE 00000208 ** /* IGET=IGET*RESULT**NEWCODE.NR */ 00000209 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000210 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000211 / B VERDER 00000212 ** 00000213 *** CASE OF OPERATOR */ 00000214 /OPE1 CMPVAL CODE,0,(+,X'314',0,),GT,IFO2 UNRECOGNIZED QUANTITY * 00000215 LOAD 4,-CODE-NR-,0 00000216 SLA 4,2 00000217 L 3,=A(TAB3) 00000218 L 2,0(3,4) 00000219 BR 2 00000220 *** 00000221 KEY1 CCALL KEY2 00000222 / B EXI1 00000223 ** 00000224 /SUK1 CCALL SUKEY1 00000225 B EXI1 00000226 ** 00000227 DTP1 CCALL DOTP1 DOT OPERATOR 00000228 CMP000 FLAG,0,NE,DOT1 00000229 / B DEL1 00000230 ** 00000231 *** CASE OF OPERATOR MINUS = 1407B = X'307' */ 00000232 :SIG1 CMPVAL -NEWCODE-TYPE-,0,(+,VECTOR,0,),EQ,LL008 00000233 CMPVAL -NEWCODE-TYPE-,0,(+,FUNCT,0,),NE,LL005 00000234 LL008 NEGATE IGET,0 00000235 / B VERDER 00000236 ** /* VECTOR OR FUNCTION HAVE NO EXPONENT */ 00000237 LL005 SETVAL II5,0,(+,J,0,+,NEXTQ,0,) 00000238 SETVAL CODE,0,(+,T$0SYMB,II5,) 00000239 / CMPVAL -CODE-TYPE-,0,(+,OPERAT,0,),NE,L0024 00000240 SETVAL II5,0,(+,J,0,+,2*NEXTQ,0,) 00000241 : SETVAL CODE,0,(+,T$0SYMB,II5,) 00000242 L0024 IFEVEN -CODE-NR-,0,VERDER 00000243 / NEGATE IGET,0 ODD POWER ACCEPTS MINUS*/ 00000244 / B VERDER 00000245 ** 00000246 MCE1 SETVAL II5,0,(+,J,0,+,NEXTQ,0,) MINUS CONJG EXPRESSION 00000247 IFEVEN T$0SYMB,II5,COE1 00000248 / NEGATE IGET,0 ODD POWER ACCEPTS MINUS*/ 00000249 /COE1 SETVAL CODE,0,(+,NEWCODE,0,) CONJG EXPRESSION */ 00000250 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000251 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000252 SETVAL EXPR,0,(+,CODE,0,) 00000253 CCALL NUMWO1 NSUC,EXPR,RESULT 00000254 / CMP000 NSUC,0,GE,NUM2 00000255 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000256 SETVAL P$VAR,NEPS,(+,CONJG1,0,) 00000257 / SETVAL FLAG,0,(-,1,0,) 00000258 / B EXR1A 00000259 INT1 SETVAL EXPR,0,(+,NEWCODE,0,) MINUS INTEG OPERATOR 00000260 PUTMIN EXPR,0 00000261 / B INT3 00000262 INT2 SETVAL EXPR,0,(+,NEWCODE,0,) INTEG OPERATOR 00000263 INT3 CCALL INTEG1 EXPR,RESULFX 00000264 FLOAT 0,RESULFX,0 00000265 STORE 0,RESULT,0 00000266 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000267 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000268 / B NUM2 00000269 /CCB1 SETVAL DEPTH,0,(+,DEPTH,0,+,1,0,) CONJG1=BEGIN OPERAT */ 00000270 / SETVAL NEPSG,DEPTH,(+,NEPS,0,) 00000271 /CCB2 CCALL CAL2 CONJG OF ALGEBRAS */ 00000272 / B VERDER 00000273 /CCE1 SETVAL K,0,(+,NEPSG,DEPTH,) CONJG2=END OPERAT */ 00000274 / SETVAL DEPTH,0,(+,DEPTH,0,-,1,0,) 00000275 / CMPVAL NEPS,0,(+,K,0,),LT,CCB2 JP IF NO FUS */ 00000276 SETVAL LOW,0,(+,K,0,) 00000277 SETVAL HIGH,0,(+,NEPS,0,) 00000278 CCALL CFU1 LOW,HIGH CONJG OF FUNCTIONS 00000279 / CMP000 NQA,0,EQ,CCB2 00000280 / SET111 NQA,0 POSITION OF EPF FUS */ 00000281 / B CCB2 00000282 ** 00000283 *** CASE OF FUNCTION. INSERT FUNCTION AND ARGS IN IEP. FOR ARGS THAT * 00000284 *** ARE INDEX, LOOK IN IPR FOR POSSIBLE DELTA FUNCTIONS CONNECTED */ 00000285 *** WITH THEM. */ 00000286 /FUN1 CMPVAL CODE,0,(+,D,0,),EQ,DEL1 00000287 JUMP FUNCT1 00000288 *** CASE OF DELTA FUNCTION */ 00000289 ** /* CODE,NEWCODE ARE FIRST,SECOND ARG AFTER ELIMINATING */ 00000290 ** /* MINUS SIGN */ 00000291 /DEL1 SETVAL CODE,0,(+,NEWCODE,0,) 00000292 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000293 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000294 / CMPVAL CODE,0,(+,X'200',0,),GE,DEL3 00000295 /DEL2 SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000296 / CMPVAL NEWCODE,0,(+,X'200',0,),LT,DEL4 00000297 / CMPVAL NEWCODE,0,(+,MINUS,0,),NE,VEC5 00000298 / NEGATE IGET,0 00000299 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000300 / B DEL2 00000301 /DEL3 CMPVAL CODE,0,(+,MINUS,0,),NE,DEL3A 00000302 / NEGATE IGET,0 00000303 / B DEL1 00000304 /DEL3A SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000305 / CMPVAL NEWCODE,0,(+,MINUS,0,),NE,VEC3 00000306 / NEGATE IGET,0 00000307 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000308 / B DEL3A 00000309 /DEL4 CMPVAL T$0SYMB,J,(+,FUNCT0,0,),NE,IFO3 00000310 / B DEL5 00000311 ** /* TRANSFORM P(3) INTO P(N254)*D(N255,3)*D(N254,N255) */ 00000312 ** /* TO CREATE D(INDEX,INDEX) */ 00000313 /VEC3 CMPVAL CODE,0,(+,VECTNR0,0,),GT,IFO3 00000314 / CMPVAL CODE,0,(+,VECTOR0+32,0,),LT,VEC4 00000315 / CMPVAL CODE,0,(+,X'700',0,),LT,IFO3 00000316 /VEC4 SETVAL IPR,254,(+,CODE,0,) 00000317 / SETVAL CODE,0,(+,INDEX0,0,+,254,0,) VERY HIGH INDEX */ 00000318 / CMPVAL NEWCODE,0,(+,X'200',0,),LT,DEL5 00000319 /VEC5 CMPVAL NEWCODE,0,(+,VECTNR0,0,),GT,IFO3 00000320 / CMPVAL NEWCODE,0,(+,VECTOR0+32,0,),LT,VEC6 00000321 / CMPVAL NEWCODE,0,(+,X'700',0,),LT,IFO3 00000322 /VEC6 SETVAL IPR,255,(+,NEWCODE,0,) 00000323 / SETVAL NEWCODE,0,(+,INDEX0,0,+,255,0,) VERY HIGH INDEX */ 00000324 /DEL5 SETVAL ARG1,0,(+,CODE,0,-,INDEX0,0,) 00000325 / SETVAL ARG2,0,(+,NEWCODE,0,-,INDEX0,0,) 00000326 : CMPVAL IPR,ARG2,(+,IPR,ARG1,),LT,DEL6 00000327 / CMPVAL ARG2,0,(+,ARG1,0,),EQ,DEL12 D(M,M)=DIMEN */ 00000328 / SETVAL ARG2,0,(+,CODE,0,-,INDEX0,0,) 00000329 / SETVAL ARG1,0,(+,NEWCODE,0,-,INDEX0,0,) 00000330 /DEL6 SETVAL C1,0,(+,IPR,ARG1,) 00000331 / SETVAL C2,0,(+,IPR,ARG2,) 00000332 LOAD 1,-C1-TYPE-,0 00000333 LOAD 2,-C2-TYPE-,0 00000334 AR 1,6 00000335 AR 2,6 00000336 SLL 1,29 00000337 SLL 2,29 00000338 SRL 1,29 00000339 SRL 2,29 00000340 AR 1,2 00000341 SLL 2,2 00000342 AR 1,2 R1=MOD(C1+1,8)+5*MOD(C2+1,8) 00000343 SLA 1,2 00000344 L 2,=A(TAB4) 00000345 L 3,0(2,1) 00000346 BR 3 00000347 ** /* IN FACT ONLY LAST 3 BITS OF TYPE ARE REQUIRED AS ONLY */ 00000348 ** /* ZERO,INDEX,VECTOR,-ODDINDX,NR ARE POSSIBLE AS IPR CONTENT. 00000349 ** /* ABBREVIATED AS N,D,V,F,I . WITH TYPES 7,0,1,2,11 . 00000350 ** /* TYPE+1 MOD 8 IS A COLLATING SEQUENCE FOR THE GOTO . */ 00000351 ** /* -ODDINDX IMPLIES PRESENCE OF THAT INDEX AS A FU ARG IN IEP 00000352 ** /* ODD NUMBER OF TIMES */ 00000353 /DVV1 SET000 IPR,ARG1 00000354 / SET000 IPR,ARG2 00000355 / SET111 NEWCODE,0 00000356 *** CODE=DOTPR+32*MOD(C2,32)+MOD(C1,32); /* DOTPRODUCT */ 00000357 LOAD 1,-C1-VECT2-,0 00000358 LOAD 2,-C2-VECT2-,0 00000359 SLA 2,5 00000360 LA 4,DOTPR0(1,2) 00000361 ST 4,CODE 00000362 / B DOT2 00000363 /DII1 SET000 IPR,ARG1 00000364 / SET000 IPR,ARG2 00000365 / CMPVAL C1,0,(+,C2,0,),EQ,VERDR2 00000366 / SET000 IGET,0 00000367 B EXI4 00000368 /DIV1 SET000 IPR,ARG1 00000369 / SET000 IPR,ARG2 00000370 / SET111 NEWCODE,0 00000371 *** CODE=VECTNR+32*MOD(C2,32)+MOD(C1,32); /* VECTOR COMPONENT * 00000372 LOAD 1,-C1-VECT2-,0 00000373 LOAD 2,-C2-VECT2-,0 00000374 SLA 2,5 00000375 LA 4,VECTNR0(1,2) 00000376 ST 4,CODE 00000377 / B DOT2 00000378 /DVD1 SET000 IPR,ARG1 00000379 / SET000 IPR,ARG2 00000380 *** IPR(C2-INDEX0)=C1; /* IPR(INDEX)=VECTOR FOR VECTOR(INDEX) * 00000381 SETVAL II5,0,(+,-C2-NR-,0,) 00000382 SETVAL IPR,II5,(+,C1,0,) 00000383 / B VERDR2 00000384 /DVN1 SET000 IPR,ARG1 00000385 / SETVAL IPR,ARG2,(+,C1,0,) IPR(INDEX)=VECTOR */ 00000386 / B VERDR2 00000387 /DVF1 SET000 IPR,ARG1 00000388 / SET000 IPR,ARG2 00000389 / SETVAL NEW5,0,(+,C1,0,) VECTOR */ 00000390 / SETVAL OLD5,0,(+,ARG2,0,+,INDEX0,0,) F(A,B)*P(N)*D(N,A)=F(P 00000391 /DEL7 SET000 K,0 00000392 /DEL8 SETVAL K,0,(+,K,0,+,1,0,) 00000393 / CMPVAL K,0,(+,NEPS,0,),GT,IFO2 00000394 / CMPVAL P$VAR1,K,(+,DKEY,0,),EQ,DEL10 SKIP KEY */ 00000395 / CMPVAL P$VAR1,K,(+,OLD5,0,),NE,L0112 00000396 / SETVAL P$VAR1,K,(+,NEW5,0,) 00000397 / B VERDR2 00000398 /L0112 CMPVAL P$VAR2,K,(+,OLD5,0,),NE,DEL8 00000399 / SETVAL P$VAR2,K,(+,NEW5,0,) 00000400 / B VERDR2 00000401 /DEL10 SETVAL K,0,(+,K,0,+,1,0,) SKIP OVER DUMMY KEY */ 00000402 / CMP000 P$EXPR,K,EQ,DEL10 00000403 / CMPVAL K,0,(+,NEPS,0,),LT,DEL8 00000404 / B IFO2 00000405 /DDD1 SET000 IPR,ARG1 D(A,N)*D(B,M)*D(N,M)=D(A,B) */ 00000406 / SET000 IPR,ARG2 00000407 / CMPVAL C1,0,(+,C2,0,),EQ,DEL12 00000408 SETVAL II5,0,(+,-C1-NR-,0,) 00000409 SETVAL IPR,II5,(+,C2,0,) 00000410 SETVAL II5,0,(+,-C2-NR-,0,) 00000411 SETVAL IPR,II5,(+,C1,0,) 00000412 / B VERDR2 00000413 /DDN1 SET000 IPR,ARG1 00000414 SETVAL II5,0,(+,-C1-NR-,0,) 00000415 SETVAL IPR,II5,(+,ARG2,0,+,INDEX0,0,) 00000416 / SETVAL IPR,ARG2,(+,C1,0,) 00000417 / B VERDR2 00000418 /DNN1 SETVAL IPR,ARG1,(+,ARG2,0,+,INDEX0,0,) 00000419 / SETVAL IPR,ARG2,(+,ARG1,0,+,INDEX0,0,) 00000420 / B VERDR2 00000421 DDF1 SETVAL II5,0,(+,-C1-NR-,0,) F(A,B)*D(N,M)*D(N,A)=F(M,B) 00000422 SETVAL IPR,II5,(-,ODDINDX,0,) 00000423 / SETVAL OLD5,0,(+,ARG2,0,+,INDEX0,0,) 00000424 / SETVAL NEW5,0,(+,C1,0,) 00000425 / SET000 IPR,ARG1 00000426 / SET000 IPR,ARG2 00000427 / B DEL7 00000428 /DNF1 SETVAL OLD5,0,(+,ARG2,0,+,INDEX0,0,) F(A,B)*D(M,A)=F(M,B) 00000429 / SETVAL NEW5,0,(+,ARG1,0,+,INDEX0,0,) 00000430 / SETVAL IPR,ARG1,(-,ODDINDX,0,) 00000431 / SET000 IPR,ARG2 00000432 / B DEL7 00000433 /DFF1 SETVAL OLD5,0,(+,ARG1,0,+,INDEX0,0,) F(A,B)*F(K,L)*D(A,K)=F 00000434 / SETVAL NEW5,0,(+,ARG2,0,+,INDEX0,0,) 00000435 / SET000 IPR,ARG1 00000436 / SET000 IPR,ARG2 00000437 / B DEL7 00000438 /DEL12 CMPVAL ARG1,0,(+,NVIND,0,),GT,DEL16 D(M,M)=DIMENSION */ 00000439 LOAD 2,I$PROP,ARG1 00000440 SLL 2,28 00000441 SRL 2,28 00000442 *** IF NVIGEH(ARG1).DIMEN < 'N' THEN GOTO DEL16; 00000443 : CMPBIT I$PROP,ARG1,VARDIM,OFF,DEL16 00000444 A 2,=X'000000E0' 00000445 C 2,=X'000000E9' 00000446 BNH LL007 00000447 S 2,=X'00000015' CONVERTS X'EA' TILL X'EE' INTO N TILL R 00000448 LL007 ST 2,VARDIM5 00000449 ST 0,VARDIM5+4 00000450 / DOLOOP K,1,NALGE,1,L0114,IFO20 00000451 *** IF NAGEH(K).NAME = NVIGEH(ARG1).DIMEN THEN GOTO DEL15; 00000452 : CMPNAM S$NAME,K,VARDIM5+3,0,EQ,DEL15 00000453 / ENDDO L0114,+1 00000454 / B IFO20 VARIABLE DIMENSION NAME NOT IN S LIST */ 00000455 /DEL15 SETVAL IPR1,K,(+,IPR1,K,+,1,0,) MULTIPLY BY SYMBOL */ 00000456 / B VERDR2 00000457 DEL16 CR 0,2 00000458 BNZ L0116 NO DIM GIVES DIM=4 00000459 LOAD 0,IGET,0 00000460 LD 4,=D'4.0' 00000461 SDR 6,6 00000462 MULTP 00000463 STORE 0,IGET,0 00000464 / B VERDR2 00000465 L0116 ST 2,VARDIM5 00000466 LOAD 0,IGET,0 00000467 FLOAT 4,VARDIM5,0 00000468 MULTP 00000469 STORE 0,IGET,0 00000470 / B VERDR2 00000471 ** 00000472 IFO2 ERROR 1,' UNRECOGNIZED QUANTITY' 00000473 IFO3 ERROR 1,' WRONG VECTOR OR DELTA ARGUMENT' 00000474 IFO4 ERROR 1,' INSERT COUNT LIMIT' 00000475 IFO5 ERROR 1,' ILLEGAL EXPONENT' 00000476 IFO20 ERROR 1,' VAR DIMEN NAME NOT IN S-LIST' 00000477 DROP 12 00000478 FFOUT 1,'INSER1' 00000479 LTORG 00000480 TAB3 DC A(IFO2,KEY1,SUK1,DTP1,IFO2,IFO2,IFO2,SIG1,COE1,MCE1,INT2) 00000481 DC A(INT1,IFO2,IFO2,IFO2,IFO2,CCB1,CCE1,IFO2,IFO2,VERDER) 00000482 TAB4 DC A(DII1,DVN1,DVD1,DIV1,DVF1) GOTO (...),(C1,C2) 00000483 DC A(DVN1,DNN1,DDN1,DVN1,DNF1) 00000484 DC A(DVD1,DDN1,DDD1,DVD1,DDF1) 00000485 DC A(DIV1,DVN1,DVD1,DVV1,DVF1) 00000486 DC A(DVF1,DNF1,DDF1,DVF1,DFF1) 00000487 *** 00000488 *** 00000489 *** 00000490 DS 0H 00000491 USING *,15 00000492 /KEY2 CMP000 KEY$NEW,0,NE,L0013 00000493 / SETVAL K,0,(+,KEY$NOW,0,) DUMMY KEY */ 00000494 / B L0014 00000495 /L0013 SETVAL K,0,(+,MBE1,0,) 00000496 / SETVAL KEY$NOW,0,(+,MBE1,0,) 00000497 / SET000 KEY$NEW,0 00000498 L0014 SETVAL T$0VAR,K,(+,DKEY,0,) 00000499 / SETVAL SKEY1,0,(+,K,0,+,NEXTK,0,) ADR OF FIRST DUMMY FOR 00000500 / SET000 L,0 SUPERKEY 00000501 /KEY3 CMP000 NEWCODE,0,EQ,KEY4 00000502 / SETVAL L,0,(+,L,0,+,1,0,) 00000503 / SETVAL K,0,(+,K,0,+,NEXTK,0,) 00000504 SETVAL T$0VAR,K,(+,NEWCODE,0,) 00000505 / CMPVAL NEWCODE,0,(+,X'307',0,),LT,KEY5 00000506 / CMPVAL NEWCODE,0,(+,X'314',0,),GT,KEY5 00000507 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) PACK OPERAT WITH ITS VAR */ 00000508 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000509 SETVAL T$0VAR2,K,(+,NEWCODE,0,) 00000510 /KEY5 SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000511 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000512 / CMPVAL L,0,(+,255,0,),GT,IFO9 DUMMY OVERFLOW */ 00000513 / B KEY3 00000514 KEY4 SETVAL KEY$NR,0,(+,L,0,) 00000515 CMP000 KEY$NR,0,EQ,RETURN 00000516 / SETVAL MBE1,0,(+,K,0,+,NEXTK,0,) 00000517 BR 14 00000518 IFO9 ERROR 3,' DUMMY OVERFLOW' 00000519 DROP 15 00000520 *** 00000521 DS 0H 00000522 USING *,15 00000523 /SUKEY1 SETVAL K,0,(+,SKEY1,0,) SUPERKEY */ 00000524 SUK2 CMP000 NEWCODE,0,EQ,SUK3 00000525 SETVAL T$0VAR,K,(+,NEWCODE,0,) OVERWRITES THE EXIST 00000526 / CMPVAL NEWCODE,0,(+,X'307',0,),LT,SUK4 ING DKEY 00000527 / CMPVAL NEWCODE,0,(+,X'314',0,),GT,SUK4 00000528 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) PACK OPERAT WITH ITS VAR */ 00000529 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000530 SETVAL T$0VAR2,K,(+,NEWCODE,0,) 00000531 /SUK4 SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000532 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000533 / SETVAL K,0,(+,K,0,+,NEXTK,0,) 00000534 / B SUK2 00000535 /SUK3 CMPVAL MBE1,0,(+,K,0,-,NEXTK,0,),LT,IFO99 SUPERKEY OVERFLOW 00000536 BR 14 00000537 IFO99 ERROR 3,' SUPERKEY OVERFLOW' 00000538 DROP 15 00000539 *** 00000540 DS 0H 00000541 USING *,15 00000542 EXR1B SETVAL II5,0,(+,-CODE-NR-,0,) 00000543 SETVAL K,0,(+,L$AKEY,II5,) 00000544 SETVAL L,0,(+,L$DUMNR,II5,) 00000545 / CMP000 K,0,NE,L0004 00000546 / SETVAL K,0,(+,KEY$NOW,0,) 00000547 / SETVAL L,0,(+,KEY$NR,0,) 00000548 L0004 SGNEXT RESULFX,0,-NEWCODE-NR-,0 00000549 CMP000 RESULFX,0,LT,IFO17 EXPRES WITH NEG EXPON 00000550 BE L0009 00000551 / SET111 MARKER,0 00000552 / CMP000 L,0,EQ,L0005 00000553 SETVAL II5,0,(+,L,0,+,1,0,) 00000554 : DOLOOP M,1,II5,1,L0070,L0005 00000555 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000556 : SETVAL P$WORD,NEPS,(+,T$0WORD,K,) COPY KEY 00000557 SETVAL K,0,(+,K,0,+,NEXTK,0,) 00000558 ** /* KEY CONSISTS OF 1401B AND L DUMMIES */ 00000559 / ENDDO L0070,2 00000560 /L0005 SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000561 / SETVAL P$EXPR,NEPS,(+,-CODE-NR-,0,) 00000562 / SETVAL P$MULTP,NEPS,(+,-NEWCODE-NR-,0,) 00000563 / SET000 P$POINT,NEPS 00000564 /L0009 SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000565 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000566 BR 14 00000567 IFO17 ERROR 3,' EXPRESS. WITH NEGATIVE EXPONENT' 00000568 DROP 15 00000569 *** 00000570 DS 0H 00000571 USING *,15 00000572 DOTP1 SETVAL CODE,0,(+,NEWCODE,0,) DOT OPERATOR */ 00000573 / SET111 FLAG,0 00000574 SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000575 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000576 / CMPVAL CODE,0,(+,MINUS,0,),NE,L0015 00000577 / SETVAL CODE,0,(+,NEWCODE,0,) 00000578 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000579 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000580 / SETVAL FLAG,0,(-,FLAG,0,) 00000581 /L0015 CMPVAL NEWCODE,0,(+,MINUS,0,),NE,L0016 00000582 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000583 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000584 / SETVAL FLAG,0,(-,FLAG,0,) 00000585 /L0016 SETVAL J,0,(+,J,0,+,NEXTQ,0,) POINTS TO EXPONENT */ 00000586 : SETVAL NEW5,0,(+,T$0SYMB,J,) 00000587 / CMP000 FLAG,0,GT,DTP6 00000588 / SETVAL K,0,(+,-NEW5-NR-,0,) -P(M)**-3 */ 00000589 IFEVEN -NEW5-NR-,0,DTP6 00000590 / NEGATE IGET,0 ODD EXPONENT */ 00000591 /DTP6 CMPVAL CODE,0,(+,NEWCODE,0,),LE,L0020 00000592 / SETVAL K,0,(+,NEWCODE,0,) 00000593 / SETVAL NEWCODE,0,(+,CODE,0,) 00000594 / SETVAL CODE,0,(+,K,0,) 00000595 :L0020 CMPVAL CODE,0,(+,X'200',0,),LT,DTP10 00000596 CMPVAL CODE,0,(+,X'300',0,),GE,DTP10 00000597 SET111 FLAG,0 JP TO DOT1 AFTER RETURN 00000598 LOAD 1,-CODE-VECT2-,0 00000599 LOAD 2,-NEWCODE-VECT2-,0 00000600 / CMPVAL NEWCODE,0,(+,X'300',0,),LE,L0021 00000601 SLA 1,5 00000602 LA 4,VECTNR0(1,2) 00000603 STORE 4,CODE,0 00000604 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000605 / BR 14 VECTOR COMP */ 00000606 L0021 CR 1,2 00000607 BNL L0022 00000608 SLA 1,5 00000609 LA 4,DOTPR0(1,2) 00000610 / B L0023 00000611 L0022 SLA 2,5 00000612 LA 4,DOTPR0(1,2) 00000613 L0023 STORE 4,CODE,0 00000614 SETVAL NEWCODE,0,(+,NEW5,0,) 00000615 / BR 14 DOTPRODUCT */ 00000616 /DTP10 CMPVAL NEW5,0,(+,ONE,0,),NE,IFO11 ILLEGAL EXPONENT*/ 00000617 SETVAL T$0SYMB,J,(+,FUNCT0,0,) CONSTRUCT DELTA FUNCTION 00000618 SETVAL J,0,(+,J,0,-,NEXTQ,0,) 00000619 SETVAL T$0SYMB,J,(+,CODE,0,) 00000620 SETVAL J,0,(+,J,0,-,NEXTQ,0,) 00000621 SETVAL T$0SYMB,J,(+,NEWCODE,0,) 00000622 SET000 FLAG,0 JP TO DEL1 AFTER RETURN 00000623 BR 14 00000624 IFO11 ERROR 3,' VECT(INDX) MUST HAVE EXPONENT=1' 00000625 DROP 15 00000626 *** 00000627 DS 0H 00000628 USING *,12 00000629 FUNCT1 SETVAL DGEPF,0,(+,CODE,0,-,GI,0,) 00000630 : CMPVAL CODE,0,(+,DD,0,),LT,LL003 00000631 : CMPVAL CODE,0,(+,DP,0,),GT,LL003 00000632 SETVAL NQB,0,(+,NQB,0,+,1,0,) COUNTS SPECIAL FUNCTIONS 00000633 / B FUN6 00000634 /LL003 CMPVAL CODE,0,(+,NQA,0,+,EPF,0,),NE,FUN2 00000635 / SETVAL NQA,0,(+,NEPS,0,+,1,0,) 00000636 ** /* MEANS FIRST OCCUR OF EPF. CODE=EPF AND NQA=0. */ 00000637 ** /* NQA IS SET TO PRESENT LOCATION OF EPF IN IEP */ 00000638 /FUN2 SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000639 :FUN3 CMPVAL -CODE-TYPE-,0,(+,OPERAT,0,),NE,LL004 00000640 CMPVAL CODE,0,(+,X'314',0,),GT,IFO1 00000641 LOAD 4,-CODE-NR-,0 00000642 SLA 4,2 00000643 L 2,TAB5(4) 00000644 BR 2 00000645 TAB5 DC A(IFO1,IFO1,IFO1,DOF1,IFO1,IFO1,IFO1,SIF1,CCF1,CCF1,ITG2) 00000646 DC A(ITG1,IFO1,IFO1,IFO1,RQF1,IFO1,IFO1,REF1,REF1,PAF1) 00000647 *** GO TO (DOF1 FOR DOT , SIF1 FOR MINUS , CCF1 FOR CONJG,CONJGM* 00000648 *** ITG2 FOR INTEG , ITG1 FOR INTEGM , RQF1 FOR KREQ , * 00000649 *** PAF1 FOR PASS , REF1 FOR TRICK,TRACK ) * 00000650 LL004 SETVAL P$VAR,NEPS,(+,CODE,0,) 00000651 / CMPVAL CODE,0,(+,FUNCT0,0,),EQ,ENDFUN1 00000652 /FUN4 SETVAL CODE,0,(+,NEWCODE,0,) INSPECT NEXT FUNCTION ARGUMENT 00000653 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000654 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000655 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000656 / CMPVAL -CODE-TYPE-,0,(+,INDEX,0,),NE,FUN3 00000657 SETVAL P$VAR,NEPS,(+,CODE,0,) 00000658 SETVAL II5,0,(+,-CODE-NR-,0,) 00000659 SETVAL K,0,(+,IPR,II5,) 00000660 SETVAL IPR,II5,(-,ODDINDX,0,-,K,0,) 00000661 / CMP000 K,0,LE,FUN4 NOTHING OR FUNCTION IN IPR */ 00000662 SET000 IPR,II5 00000663 SETVAL P$VAR,NEPS,(+,K,0,) 00000664 / CMPVAL K,0,(+,VECTOR0,0,),GT,FUN4 VECTOR OR NUMBER */ 00000665 SETVAL II5,0,(+,-K-NR-,0,) 00000666 SETVAL IPR,II5,(-,ODDINDX,0,) 00000667 / B FUN4 00000668 /FUN6 CMPVAL CODE,0,(+,DD,0,),NE,FUN2 00000669 / CMPVAL NEWCODE,0,(+,STANDX,0,),NE,FUN2 00000670 SETVAL II5,0,(+,J,0,+,NEXTQ,0,) 00000671 : SETVAL CODE,0,(+,T$0SYMB,II5,) 00000672 / CMPVAL -CODE-TYPE-,0,(+,OPERAT,0,),NE,FUN8 00000673 / CMPVAL CODE,0,(+,MINUS,0,),NE,IFO18 00000674 ** /* WRONG DUMMY AS FUNCTION NAME */ 00000675 / NEGATE IGET,0 DD(1000B,-A... BECOMES -DD(1000B, 00000676 / SETVAL T$0SYMB,J,(+,DD,0,) RESET INPUT */ 00000677 / SETVAL NEWCODE,0,(+,DD,0,) 00000678 : SETVAL T$0SYMB,II5,(+,STANDX,0,) 00000679 / SETVAL NQB,0,(+,NQB,0,-,1,0,) 00000680 B ENDFUN1 00000681 /FUN7A CMPVAL -CODE-TYPE-,0,(+,FUNCT,0,),NE,IFO18 WRONG DUMMY ... 00000682 / SETVAL CODE,0,(+,CODE,0,-,FUNCT0,0,+,ARGFU0,0,) 00000683 /FUN8 CMPVAL -CODE-TYPE-,0,(+,ARGFU,0,),NE,FUN9 00000684 / CMPVAL CODE,0,(+,ARGFU0,0,),LT,IFO18 WRONG DUMMY AS FU NAM* 00000685 / SETVAL CODE,0,(+,CODE,0,-,ARGFU0,0,+,FUNCT0,0,) 00000686 / CMPVAL CODE,0,(+,D,0,),EQ,IFO19 D,DS,DX ILLEGAL AS DUMMY */ 00000687 / CMPVAL CODE,0,(+,DS,0,),EQ,IFO19 00000688 / CMPVAL CODE,0,(+,DX,0,),EQ,IFO19 00000689 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) DD(DUMMY FUNCT) BECOMES ACTUA 00000690 / SETVAL T$0SYMB,J,(+,CODE,0,) RESET INPUT */ 00000691 / SETVAL NEWCODE,0,(+,CODE,0,) 00000692 / SETVAL NQB,0,(+,NQB,0,-,1,0,) 00000693 ENDFUN1 JUMP VERDR1 00000694 /FUN9 CMPVAL -CODE-TYPE-,0,(+,EXPRES,0,),NE,FUN7A 00000695 / CMPVAL -CODE-NR-,0,(+,NXEX,0,),GT,IFO18 WRONG DUMMY AS FU * 00000696 SETVAL II5,0,(+,-CODE-NR-,0,) 00000697 CMPBIT X$PROP,II5,FILE,OFF,L0101 00000698 / SETVAL T$0SYMB,J,(+,ZEXPR,0,) 00000699 / SETVAL NEWCODE,0,(+,ZEXPR,0,) 00000700 / SETVAL CODE,0,(+,DD,0,) 00000701 / B FUN2 00000702 L0101 CMPBIT X$PROP,II5,XORD,OFF,L0102 00000703 / SETVAL T$0SYMB,J,(+,XEXPR,0,) 00000704 / SETVAL NEWCODE,0,(+,XEXPR,0,) 00000705 L0102 SETVAL IJ5,0,(+,J,0,+,NEXTQ,0,) 00000706 SETVAL T$0SYMB,IJ5,(+,X$LOCNR,II5,+,EXPRES0,0,) 00000707 / SETVAL CODE,0,(+,DD,0,) 00000708 / B FUN2 00000709 ** 00000710 ** /* MINUS IN FRONT OF FU ARG */ 00000711 /SIF1 CMP000 DGEPF,0,GE,L0103 00000712 / NEGATE IGET,0 D,G,EPF ARE ODD FU*/ 00000713 / SETVAL NEPS,0,(+,NEPS,0,-,1,0,) 00000714 / B FUN4 00000715 /L0103 SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000716 / CMPVAL -NEWCODE-TYPE-,0,(+,NUMBER,0,),NE,SIF4 00000717 / SETVAL -NEWCODE-NR-,0,(-,-NEWCODE-NR-,0,) 00000718 / SETVAL CODE,0,(+,NEWCODE,0,) 00000719 / SET000 NEWCODE,0 00000720 SIF3 SETVAL P$VAR2,NEPS,(+,NEWCODE,0,) 00000721 SETVAL P$VAR1,NEPS,(+,CODE,0,) 00000722 SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000723 / B FUN4 00000724 /REF1 SETVAL J,0,(+,J,0,+,NEXTQ,0,) DO NOTHING. FOR TRICK,TRACK * 00000725 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000726 ** /* CHECK IF INDEX CONNECTED WITH D FU */ 00000727 /SIF4 CMPVAL -NEWCODE-TYPE-,0,(+,INDEX,0,),NE,SIF3 00000728 SETVAL II5,0,(+,-NEWCODE-NR-,0,) 00000729 SETVAL K,0,(+,IPR,II5,) 00000730 SETVAL IPR,II5,(-,ODDINDX,0,-,K,0,) 00000731 / CMP000 K,0,LE,SIF3 NOTHING OR FU IN IPR */ 00000732 SET000 IPR,II5 00000733 / SETVAL NEWCODE,0,(+,K,0,) 00000734 / CMPVAL K,0,(+,VECTOR0,0,),GE,SIF3 VECTOR OR NR */ 00000735 SETVAL II5,0,(+,-K-NR-,0,) 00000736 SETVAL IPR,II5,(-,ODDINDX,0,) 00000737 / B SIF3 00000738 /ITG1 PUTMIN NEWCODE,0 -INTEG BEFORE FU ARG */ 00000739 ITG2 SETVAL EXPR,0,(+,NEWCODE,0,) 00000740 CCALL INTEG1 EXPR,RESULFX 00000741 L 1,RESULFX 00000742 LPR 1,1 00000743 S 1,=X'10000000' 00000744 BH IFO16 00000745 SET000 P$VAR,NEPS 00000746 SETVAL -P$VAR1-TYPE-,NEPS,(+,NUMBER,0,) 00000747 SETVAL -P$VAR1-NR-,NEPS,(+,RESULFX,0,) 00000748 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000749 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000750 / B FUN4 00000751 /DOF1 SETVAL CODE,0,(+,NEWCODE,0,) DOT OPERAT BEFORE FU ARG */ 00000752 / SET111 FLAG,0 00000753 SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000754 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000755 / CMPVAL CODE,0,(+,MINUS,0,),NE,L0104 00000756 / SETVAL CODE,0,(+,NEWCODE,0,) 00000757 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000758 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000759 / SETVAL FLAG,0,(-,FLAG,0,) 00000760 /L0104 CMPVAL NEWCODE,0,(+,MINUS,0,),NE,L0105 00000761 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000762 / SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000763 / SETVAL FLAG,0,(-,FLAG,0,) 00000764 L0105 LOAD 1,-CODE-VECT2-,0 00000765 LOAD 2,-NEWCODE-VECT2-,0 00000766 / CMPVAL NEWCODE,0,(+,X'300',0,),LE,L0106 00000767 SLA 1,5 00000768 LA 4,VECTNR0(1,2) 00000769 / B DOF5 00000770 L0106 CR 1,2 00000771 BNL L0107 00000772 SLA 1,5 00000773 LA 4,DOTPR0(1,2) 00000774 / B DOF5 00000775 L0107 SLA 2,5 00000776 LA 4,DOTPR0(1,2) 00000777 DOF5 STORE 4,P$VAR,NEPS 00000778 SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000779 SETVAL NEWCODE,0,(+,T$0SYMB,J,) 00000780 / CMP000 FLAG,0,GT,FUN4 00000781 PUTMIN P$VAR,NEPS 00000782 / B FUN4 00000783 /CCF1 CMPVAL DGEPF,0,(+,DS,0,-,GI,0,),EQ,CCF2 CONJG OR -CONJG */ 00000784 / CMPVAL DGEPF,0,(+,DX,0,-,GI,0,),NE,CCF3 TEST ON ORIGINAL FU 00000785 /CCF2 SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000786 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) NO KREQ NECESSARY FOR DS,DX * 00000787 / B SIF4 00000788 /CCF3 SETVAL FLAG,0,(-,1,0,) 00000789 / SETVAL K,0,(+,J,0,-,NEXTQ,0,) 00000790 / B RQF2 00000791 /RQF1 SETVAL K,0,(+,J,0,-,NEXTQ,0,) 00000792 / SET111 FLAG,0 KEY REQUEST */ 00000793 /RQF2 SETVAL NEW5,0,(+,T$0SYMB,K,) 00000794 / CMPVAL -NEW5-TYPE-,0,(+,EXPRES,0,),NE,RQF2 00000795 / SET111 KEY$NEW,0 00000796 SET000 L$PROP,MBU 00000797 / SETVAL L$DUMNR,MBU,(+,KEY$NR,0,) 00000798 / SETVAL L$AKEY,MBU,(+,KEY$NOW,0,) 00000799 SETVAL II5,0,(+,-NEW5-NR-,0,) 00000800 : SETVAL L$BEGIN,MBU,(+,L$BEGIN,II5,) 00000801 / SETVAL T$0SYMB,K,(+,MBU,0,+,EXPRES0,0,) 00000802 / SETVAL MBU,0,(+,MBU,0,+,1,0,) 00000803 / SETVAL NEPS,0,(+,NEPS,0,-,1,0,) 00000804 / CMP000 FLAG,0,GT,FUN4 00000805 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000806 / SETVAL J,0,(+,J,0,+,NEXTQ,0,) 00000807 / B SIF4 00000808 /PAF1 SETVAL NEPS,0,(+,NEPS,0,-,1,0,) SKIP PASS OPERAT */ 00000809 / B FUN4 00000810 IFO1 ERROR 3,' UNRECOGNIZED OPERATOR' 00000811 IFO16 ERROR 3,' NR GT 128 AS FUNCTION ARGUMENT' 00000812 IFO18 ERROR 3,' WRONG DUMMY AS FUNCTION NAME' 00000813 IFO19 ERROR 3,' D,DS,DX ILLEGAL AS DUMMY' 00000814 DROP 12 00000815 FFOUT 3,'FU-ARGS' 00000816 LTORG 00000817 ** 00000818 /NUMWO1 PRO FLAG EXPR RESULT X2,X7,X7 */ 00000819 / SETVAL K,0,(+,EXPR,0,) 00000820 GETOPR K,0,OPR5 00000821 SETVAL K,0,(+,-K-NR-,0,) 00000822 SETVAL II5,0,(+,NEPS,0,+,1,0,) 00000823 SETVAL P$VAR,II5,(+,EXPR,0,) 00000824 / CMP000 L$AKEY,K,EQ,L0011 00000825 SETVAL DUMPT,0,(+,L$AKEY,K,+,NEXTK,0,) 00000826 B L0012 DUMPT POINTS TO FIRST DUMMY. 1 WORD AFTER DKEY 00000827 L0011 SETVAL DUMPT,0,(+,KEY$NOW,0,+,NEXTK,0,) 00000828 L0012 SETVAL SAVE,1,(+,J,0,) 00000829 SETVAL SAVE,2,(+,CODE,0,) 00000830 SETVAL SAVE,3,(+,NEWCODE,0,) 00000831 CCALL EVNUM NSUC,EXPR,RESULT,DUMPT 00000832 SETVAL J,0,(+,SAVE,1,) 00000833 SETVAL CODE,0,(+,SAVE,2,) 00000834 SETVAL NEWCODE,0,(+,SAVE,3,) 00000835 /NUMWO1 EPI 00000836 SAVE DS 3F'0' 00000837 *** 00000838 /INTEG1 PRO EXPR RESULFX 00000839 SETVAL K,0,(+,EXPR,0,) 00000840 GETOPR K,0,OPR5 00000841 CMPVAL -K-TYPE-,0,(+,EXPRES,0,),NE,IFO12 00000842 CCALL NUMWO1 FLAG EXPR,RESULT 00000843 / CMP000 NSUC,0,LT,IFO12 INCORRECT INTEG ARGUMENT */ 00000844 LOAD 0,RESULT,0 00000845 LE 4,=X'2F400000' ROUND WITH PRECISION=2**-70 00000846 MER 4,0 00000847 PLUS 00000848 FIX 0,RESULFX,0 00000849 B XINTEG1 00000850 IFO12 ERROR 5,' INCORRECT INTEG ARGUMENT' 00000851 /INTEG1 EPI 00000852 *** 00000853 DS 0H 00000854 USING *,15 00000855 /CAL2 SET000 K,0 CONJG OF ALGEBRAS 00000856 /CAL5 SETVAL K,0,(+,K,0,+,1,0,) 00000857 / CMPBIT S$PROP,K,REAL,OFF,CAL4 00000858 : CMPBIT S$PROP,K,IMAG,OFF,L0030 00000859 IFEVEN IPR1,K,CAL4 00000860 / NEGATE IGET,0 00000861 / B CAL4 00000862 :L0030 CMPBIT S$PROP,K,COMP,OFF,CAL4 00000863 / SETVAL OLD5,0,(+,IPR1,K,) A */ 00000864 SETVAL II5,0,(+,K,0,+,1,0,) 00000865 : SETVAL IPR1,K,(+,IPR1,II5,) 00000866 : SETVAL IPR1,II5,(+,OLD5,0,) AG 00000867 / SETVAL K,0,(+,K,0,+,1,0,) 00000868 /CAL4 CMPVAL K,0,(+,NALGE,0,),LT,CAL5 00000869 / BR 14 00000870 *** 00000871 /CFU1 PRO LOW HIGH CONJG OF FU S AND THEIR ARGS*/ 00000872 / SETVAL K,0,(+,LOW,0,) REVERSE ORDER OF C,I,REAL FU S. LEAVE 00000873 ***... F1*F2*U1*U2*F3 BECOMES ...00..00 F3 CONJG1 U1 U2 CONJG2 F2 F1 * 00000874 ***IEP NEPSG=LOW NEPS=HIGH NEPS N * 00000875 /CFU2 SETVAL K,0,(+,K,0,+,1,0,) 00000876 / CMPVAL -P$VAR1-TYPE-,K,(+,FUNCT,0,),NE,CFU3 00000877 / CMPVAL P$VAR,K,(+,FUNCT0,0,),EQ,CFU3 00000878 SETVAL II5,0,(+,-P$VAR1-NR-,K,) 00000879 CMPBIT F$PROP,II5,UNDEF,ON,CFU3 00000880 / SET000 L,0 00000881 /CFU4 SETVAL K,0,(+,K,0,+,1,0,) 00000882 / SETVAL L,0,(+,L,0,-,1,0,) COUNTS ARGS */ 00000883 / CMPVAL K,0,(+,HIGH,0,),GT,IFO6 ERROR IN COMPL CONJG */ 00000884 / CMPVAL P$VAR,K,(+,FUNCT0,0,),NE,CFU4 00000885 ** /* MARK DEFINED FUNCTIONS WITH NEG VALUE. 3000B BECOMES */ 00000886 ** /* -1-NR OF ARGUMENTS */ 00000887 / SETVAL P$WORD,K,(+,L,0,) THIS SETS P$FLAG ON 00000888 /CFU3 CMPVAL K,0,(+,HIGH,0,),LT,CFU2 00000889 / SETVAL K,0,(+,HIGH,0,+,1,0,) 00000890 / SET000 L,0 00000891 / SETVAL N,0,(+,NEPS,0,) 00000892 /CFU6 SETVAL K,0,(+,K,0,-,1,0,) 00000893 / CMPVAL K,0,(+,LOW,0,),LE,CFU9 00000894 / SETVAL L,0,(+,L,0,+,1,0,) SKIP OVER UNDEFINED FUNCTIONS * 00000895 / CMP000 P$WORD,K,GE,CFU6 00000896 / SETVAL L,0,(+,L,0,-,1,0,) 00000897 / CMP000 L,0,GT,CFU10 JP IF U FU S PRESENT */ 00000898 :CFU7 SETVAL N,0,(+,N,0,+,1,0,-,P$WORD,K,) COPY LAST DEFINED FU 00000899 / SETVAL P$VAR,N,(+,FUNCT0,0,) 00000900 SETVAL II5,0,(-,P$WORD,K,) 00000901 : DOLOOP M,1,II5,1,L0032,L0033 00000902 SETVAL IJ5,0,(+,N,0,-,M,0,) 00000903 SETVAL IK5,0,(+,K,0,-,M,0,) 00000904 SETVAL P$WORD,IJ5,(+,P$WORD,IK5,) 00000905 / ENDDO L0032,2 00000906 /L0033 SET000 L,0 00000907 SETVAL K,0,(+,K,0,+,P$WORD,K,) 00000908 : CMPVAL LOW,0,(+,K,0,),LT,CFU6 00000909 / B CFU12 00000910 /CFU9 CMP000 L,0,EQ,CFU12 00000911 :CFU10 SETVAL II5,0,(+,N,0,+,1,0,) 00000912 SETVAL P$VAR,II5,(+,CONJG1,0,) COPY UNDEFINED FU S 00000913 SETVAL II5,0,(+,N,0,+,2,0,) SET THEM BETWEEN 00000914 SETVAL IJ5,0,(+,N,0,+,1,0,+,L,0,) CONJG1,CONJG2 00000915 DOLOOP M,II5,IJ5,1,L0034,L0035 00000916 SETVAL IK5,0,(+,K,0,+,M,0,-,N,0,-,1,0,) 00000917 SETVAL P$WORD,M,(+,P$WORD,IK5,) 00000918 SETVAL P$EXPR,M,(+,P$EXPR,IK5,) 00000919 / ENDDO L0034,2 00000920 /L0035 SETVAL N,0,(+,N,0,+,2,0,+,L,0,) 00000921 / SETVAL P$VAR,N,(+,CONJG2,0,) 00000922 / CMPVAL K,0,(+,LOW,0,),GT,CFU7 00000923 CFU12 SETVAL II5,0,(+,LOW,0,+,1,0,) 00000924 DOLOOP K,II5,HIGH,1,L0036,L0037 00000925 / SET000 P$WORD,K 00000926 SET000 P$EXPR,K 00000927 / ENDDO L0036,2 00000928 ** /* TAKE CONJG OF FU AND THEIR ARGS. EXCEPT FOR U FUS */ 00000929 /L0037 SETVAL K,0,(+,NEPS,0,) 00000930 SETVAL NEPS,0,(+,N,0,) 00000931 /CFU15 CMPVAL K,0,(+,N,0,),GT,XCFU1 00000932 / SETVAL K,0,(+,K,0,+,1,0,) 00000933 / CMPVAL P$VAR,K,(+,FUNCT0,0,),EQ,CFU15 00000934 / CMPVAL -P$VAR1-TYPE-,K,(+,FUNCT,0,),EQ,CFU17 00000935 / CMPVAL P$VAR,K,(+,DKEY,0,),NE,CFU15 SKIP ARGS OF U FUS */ 00000936 /CFU16 SETVAL K,0,(+,K,0,+,1,0,) SKIP OVER DUMMY KEY */ 00000937 / CMP000 P$EXPR,K,NE,CFU15 SIGNALS END OF DKEY 00000938 / CMPVAL K,0,(+,N,0,),LE,CFU16 00000939 / B IFO6 ERROR IN COMPLEX CONJG */ 00000940 CFU17 SETVAL II5,0,(+,-P$VAR1-NR-,K,) 00000941 CMPBIT F$PROP,II5,UNDEF,ON,CFU15 00000942 CMPBIT F$PROP,II5,IMAG,OFF,L0040 00000943 / NEGATE IGET,0 00000944 / B CFU20 00000945 L0040 CMPBIT F$PROP,II5,COMP,OFF,L0043 00000946 SETVAL P$VAR,K,(+,P$VAR,K,+,1,0,) 00000947 / B CFU20 00000948 L0043 SETVAL II5,0,(+,-P$VAR1-NR-,K,-,1,0,) 00000949 CMPBIT F$PROP,II5,COMP,OFF,CFU20 00000950 / SETVAL P$VAR,K,(+,P$VAR,K,-,1,0,) FG BECOMES F 00000951 /CFU20 SET000 FLAG,0 0,1 FOR +,- EXPR */ 00000952 / SETVAL K,0,(+,K,0,+,1,0,) CONJG OF EACH ARG */ 00000953 LOAD 4,-P$VAR1-TYPE-,K 00000954 LL010 LA 5,VECTNR END OF TABLE 00000955 CR 4,5 00000956 BNL FIN1 00000957 SLA 4,2 00000958 L 2,TAB6(4) 00000959 BR 2 00000960 TAB6 DC A(FIN1,FIN1,FVE1,FOP1,FAL1,FEX1,FFU1) 00000961 /FIN1 CMPVAL K,0,(+,N,0,),LT,CFU20 CASE OF A REAL ARG */ 00000962 / B IFO6 ERROR IN COMPLEX CONJG */ 00000963 FAL1 SETVAL II5,0,(+,-P$VAR1-NR-,K,) ALGEBRA ARGUMENT 00000964 SETVAL REAL1,0,(+,S$PROP,II5,) 00000965 SETVAL II5,0,(+,II5,0,-,1,0,) 00000966 SETVAL REAL2,0,(+,S$PROP,II5,) 00000967 / B CFU22 00000968 /FVE1 CMPVAL P$VAR,K,(+,VECTOR0,0,+,32,0,),LE,FIN1 VECTOR */ 00000969 SETVAL II5,0,(+,P$VAR,K,-,ARGFU0,0,) 00000970 SETVAL REAL1,0,(+,F$PROP,II5,) 00000971 SETVAL II5,0,(+,II5,0,-,1,0,) 00000972 SETVAL REAL2,0,(+,F$PROP,II5,) 00000973 CFU22 CMPBIT REAL1,0,IMAG,OFF,CFU24 00000974 / CMP000 FLAG,0,NE,FIN1 00000975 PUTMIN P$VAR,K 00000976 / B FIN1 CHANGE SIGN OF IMAGINARY QUANT */ 00000977 CFU24 CMPBIT REAL1,0,COMP,OFF,L0075 00000978 / SETVAL P$VAR,K,(+,P$VAR,K,+,1,0,) 00000979 / B CFU23 00000980 L0075 CMPBIT REAL1,0,COMP,OFF,FIN1 00000981 / SETVAL P$VAR,K,(+,P$VAR,K,-,1,0,) 00000982 /CFU23 CMP000 FLAG,0,EQ,FIN1 00000983 PUTMIN P$VAR,K 00000984 / B FIN1 00000985 /FFU1 CMPVAL P$VAR,K,(+,FUNCT0,0,),EQ,CFU15 START WITH NEXT FU */ 00000986 SETVAL II5,0,(+,-P$VAR1-NR-,K,) 00000987 SETVAL REAL1,0,(+,F$PROP,II5,) 00000988 SETVAL II5,0,(+,II5,0,-,1,0,) 00000989 SETVAL REAL2,0,(+,F$PROP,II5,) 00000990 / B CFU22 00000991 FEX1 SETVAL II5,0,(+,FLAG,0,+,CONJG,+,) CONJG OR CONJGM 00000992 PUTOPR P$VAR,K,II5 00000993 / B FIN1 00000994 /FOP1 SETVAL QUANT,0,(+,P$WORD,K,) 00000995 GETOPR QUANT,0,OPR5,FIN1 00000996 / CMPVAL OPR5,0,(+,CONJGM,0,),NE,L0077 00000997 / SETVAL P$VAR1,K,(+,MINUS,0,) 00000998 / B FIN1 00000999 /L0077 SETVAL P$VAR,K,(+,QUANT,0,) 00001000 / CMPVAL OPR5,0,(+,CONJG,0,),EQ,FIN1 CONJG(CONJG A)=A */ 00001001 / CMPVAL OPR5,0,(+,MINUS,0,),NE,FIN1 00001002 / SETVAL FLAG,0,(+,1,0,-,FLAG,0,) CASE OF MINUS. RESTART */ 00001003 LOAD 4,-QUANT-TYPE-,0 00001004 B LL010 00001005 IFO6 ERROR 5,' ERROR IN COMPLEX CONJG' 00001006 CFU1 EPI 00001007 FFOUT 5,'CONJG' 00001008 LTORG 00001009 ** 00001010 ** 00001011 *** TRY NUMERICAL EVAL OF DD-DP FU. WORK OUT DD AND DS FU, EVEN WHEN * 00001012 *** NOT NUMERICAL. */ 00001013 /INSER2 PRO NQB 00001014 / SET111 J,0 00001015 /SPF2 SETVAL NQB,0,(+,NQB,0,-,1,0,) 00001016 / DOLOOP K,J,NEPS,1,L0042,IFO7 LOCATE SPECIAL FUNCTION */ 00001017 CMPVAL P$VAR1,K,(+,DD,0,),LT,LL006 00001018 CMPVAL P$VAR1,K,(+,DP,0,),LE,SPF3 00001019 /LL006 ENDDO L0042,+1 00001020 / B IFO7 WRONG DD,DB,DT,DP,DK */ 00001021 /SPF3 SETVAL J,0,(+,K,0,) J=BEGIN OF FUNCTION */ 00001022 /SPF4 SETVAL K,0,(+,K,0,+,1,0,) 00001023 / CMPVAL P$VAR,K,(+,FUNCT0,0,),NE,SPF4 K=END OF FUNCTION */ 00001024 SETVAL II5,0,(+,J,0,+,1,0,) 00001025 CMPVAL P$VAR,II5,(+,ZEXPR,0,),EQ,SPF13 00001026 *** TRY NUMERICAL EVALUATION OF THE FUNCTION */ 00001027 / PEVFUN RESULT,NSUC,J,K,0 00001028 / CMP000 NSUC,0,LT,SPF10 JP IF NO SUCCESS */ 00001029 / CMP000 RESULT,0,NE,L0044 00001030 / SET000 IGET,0 00001031 B XINSER2 00001032 L0044 LOAD 0,IGET,0 00001033 LOAD 4,RESULT,0 00001034 MULTP 00001035 STORE 0,IGET,0 00001036 / DOLOOP L,J,K,1,L0045,SPF7 00001037 / SET000 P$WORD,L ERASE FU */ 00001038 / ENDDO L0045,+1 00001039 /SPF7 SETVAL J,0,(+,K,0,+,1,0,) 00001040 / CMP000 NQB,0,NE,SPF2 00001041 B XINSER2 00001042 /SPF10 CMPVAL P$WORD,J,(+,DD,0,),EQ,FDD1 00001043 / CMPVAL P$WORD,J,(+,DS,0,),NE,SPF7 00001044 *** CASE OF DS FUNCTION. DS,DUMMYS,INDEX,LOW,HIGH,EX1,EX2,3000B. */ 00001045 *** J K-5 K-3 K */ 00001046 *** BECOMES (COEF1 DKEY INDEX1 + COEF2 DKEY INDEX2 + ...)*DKEY */ 00001047 *** DUMMIES * 1 * EX1 ,0,0,0,0 */ 00001048 SETVAL II5,0,(+,K,0,-,5,0,) 00001049 SETVAL P$VAR,II5,(+,X'7FF',0,) VALUE FOR INDEX 00001050 / PEVFUN RESULT,NSUC,J,K,1 TRY NUM EV OF EX2 */ 00001051 ** /* RESULTING SERIES OF NUMBERS, CALLED COEF1,COEF2,... */ 00001052 ** /* IS STORED BEHIND IEP(NEPS) . */ 00001053 / CMP000 NSUC,0,LT,IFO8 WRONG DS,DX OR STAND EXP */ 00001054 / SETVAL P$EXPR,J,(+,MBE,0,) OLD DS */ 00001055 / SET000 P$POINT,J 00001056 / SET111 P$MULTP,J 00001057 SETVAL II5,0,(+,J,0,+,1,0,) 00001058 SETVAL P$VAR,II5,(+,DKEY,0,) OLD NR OF DUMMIES 00001059 / SET000 P$WORD,K 00001060 SETVAL II5,0,(+,K,0,-,1,0,) 00001061 SET000 P$WORD,II5 00001062 SETVAL II5,0,(+,K,0,-,2,0,) 00001063 : SETVAL CODE,0,(+,P$VAR,II5,) EX1 00001064 SET000 P$WORD,II5 00001065 GETMIN CODE,0,SPF11 00001066 / NEGATE IGET,0 00001067 /SPF11 CMPVAL -CODE-TYPE-,0,(+,EXPRES,0,),NE,IFO8 WRONG DS,DX,STX 00001068 SETVAL II5,0,(+,K,0,-,3,0,) 00001069 : SETVAL HIGH,0,(+,P$VAR,II5,) 00001070 SET000 P$WORD,II5 00001071 SETVAL II5,0,(+,K,0,-,4,0,) 00001072 : SETVAL LOW,0,(+,P$VAR,II5,) 00001073 SETVAL P$EXPR,II5,(+,CODE,0,-,EXPRES0,0,) 00001074 SET111 P$MULTP,II5 00001075 SET000 P$POINT,II5 00001076 SETVAL II5,0,(+,K,0,-,5,0,) 00001077 SET111 P$WORD,II5 OLD INDEX 00001078 SET1$0 RESULT,0 00001079 / SET111 L,0 00001080 /SPF12 SETVAL OLD5,0,(+,MBE,0,) 00001081 / SETVAL T$1COEFF,OLD5,(+,RESULT,0,) COEFS */ 00001082 / SETVAL T$1CODEA,-OLD5-1-,(+,DKEY,0,) VALUE OF INDEX = KEY F 00001083 / SETVAL T$1CODEA,-OLD5-2-,(+,LOW,0,) EACH EXPRESSION */ 00001084 FILL T$1CODEA,OLD5,3,MBE 00001085 / SETVAL T$1POINT,OLD5,(+,MBE,0,) 00001086 *** RESULT=IEP(NEPS+L).FLOAT 00001087 SETVAL II5,0,(+,NEPS,0,+,L,0,) 00001088 LADR 1,P$WORD,II5 00001089 MVC RESULT(LFLOAT),0(1) 00001090 : SETVAL L,0,(+,L,0,+,LFLOAT/NEXTW,0,) 00001091 / CMPVAL LOW,0,(+,HIGH,0,),GE,L0047 00001092 / SETVAL -LOW-NR-,0,(+,-LOW-NR-,0,+,1,0,) 00001093 / B SPF12 00001094 /L0047 SET000 T$1POINT,OLD5 END OF EXPR */ 00001095 / SET111 MARKER,0 00001096 / B SPF7 00001097 ** 00001098 *** CASE OF A FILE . FORMAT DD ZEXPR DLOC (DINDX) ARG1... */ 00001099 /SPF13 CMPVAL P$VAR,J,(+,DD,0,),NE,IFO7 WRONG DD,DB,DT,DP,DK */ 00001100 / SET000 P$WORD,J OLD DD */ 00001101 SETVAL II5,0,(+,J,0,+,1,0,) 00001102 SET000 P$WORD,II5 OLD /401=ZEXPR 00001103 SETVAL II5,0,(+,J,0,+,2,0,) 00001104 : SETVAL L,0,(+,P$VAR,II5,-,EXPRES0,0,) 00001105 / CMPBIT X$PROP,L,NINDX,ON,SPF15 00001106 SETVAL II5,0,(+,J,0,+,3,0,) 00001107 CMPVAL -P$VAR1-TYPE-,II5,(+,NUMBER,0,),NE,IFO13 00001108 ** /* INDEX EXPR INDEX OUT OF RANGE */ 00001109 / SETVAL M,0,(+,L,0,) 00001110 / DOLOOP L,1,NXEX,1,L0050,IFO13 00001111 / CMPNAM X$NAME,L,X$NAME,M,NE,SPF14 00001112 : CMPVAL X$INDEX,L,(+,-P$VAR1-NR-,II5,),NE,SPF14 00001113 / SETVAL J,0,(+,J,0,+,1,0,) 00001114 SETVAL II5,0,(+,J,0,+,1,0,) SKIP INDEX 00001115 SET000 P$WORD,II5 00001116 / B SPF15 00001117 /SPF14 ENDDO L0050,+1 00001118 / B IFO13 EXPRES INDEX OUT OF RANGE */ 00001119 /SPF15 SETVAL LOCX5,0,(+,X$LOCNR,L,) 00001120 / CMP000 LOCX5,0,EQ,IFO14 EMPTY EXPR */ 00001121 / CMP111 L$NUMB,LOCX5,NE,SPF18 00001122 *** CASE OF NUMERICAL FILE */ 00001123 FLOAT 0,L$VALUE,LOCX5 00001124 LOAD 4,IGET,0 00001125 MULTP 00001126 STORE 0,IGET,0 00001127 / CMP000 IGET,0,EQ,XINSER2 00001128 SETVAL II5,0,(+,J,0,+,2,0,) 00001129 DOLOOP L,II5,K,1,L0052,SPF7 00001130 / SET000 P$WORD,L 00001131 / ENDDO L0052,+1 00001132 / B SPF7 00001133 /SPF18 CMP000 L$BEGIN,LOCX5,EQ,IFO14 00001134 SET111 MARKER,0 00001135 / CMPBIT L$PROP,LOCX5,TAPE,ON,SPF19 00001136 *** CASE OF A KEEP FILE */ 00001137 SPF17 SETVAL II5,0,(+,J,0,+,2,0,) 00001138 CMPVAL K,0,(+,J,0,+,3,0,),EQ,L0054 00001139 : SETVAL P$VAR,II5,(+,DKEY,0,) FILE HAS ARGS 00001140 / B L0055 00001141 :L0054 SET000 P$WORD,II5 FILE HAS NO ARGS 00001142 /L0055 SETVAL P$EXPR,K,(+,LOCX5,0,) 00001143 / SET111 P$MULTP,K 00001144 / SET000 P$POINT,K 00001145 / B SPF7 00001146 /SPF19 CMPBIT L$PROP,LOCX5,COMON,OFF,SPF17 00001147 L 15,=A(SPFILE) 00001148 BALR 14,15 00001149 / B SPF7 00001150 ** 00001151 *** CASE OF DD FUNCTION */ 00001152 FDD1 SETVAL II5,0,(+,J,0,+,1,0,) 00001153 CMPVAL P$VAR,II5,(+,XEXPR,0,),EQ,FDD2 00001154 CMPVAL P$VAR,II5,(+,DEXPR,0,),EQ,FDD3 00001155 / CMPVAL K,0,(+,J,0,+,2,0,),LT,IFO7 WRONG DD,DB,DT,DP,DK */ 00001156 / CMPVAL K,0,(+,J,0,+,3,0,),GT,IFO7 DD MUST HAVE 1 OR 2 ARGS 00001157 / SET000 P$WORD,J ERASE DD FUNCTION */ 00001158 : SETVAL C1,0,(+,P$VAR,II5,) 00001159 SET000 P$WORD,II5 00001160 SETVAL II5,0,(+,J,0,+,2,0,) 00001161 : SETVAL C2,0,(+,P$VAR,II5,) 00001162 SET000 P$WORD,II5 00001163 SETVAL II5,0,(+,J,0,+,3,0,) 00001164 SET000 P$WORD,II5 00001165 / DOLOOP L,1,NEPS,1,L0060,L0061 REPLACE A BY B AND -A BY -B * 00001166 / CMPVAL P$VAR1,L,(+,C1,0,),NE,L0121 00001167 / SETVAL P$VAR1,L,(+,C2,0,) 00001168 /L0121 CMPVAL P$VAR1,L,(+,MINUS,0,),NE,FDD5 00001169 / CMPVAL P$VAR2,L,(+,C1,0,),NE,FDD5 00001170 / SETVAL P$VAR2,L,(+,C2,0,) 00001171 /FDD5 ENDDO L0060,+1 00001172 /L0061 CMPVAL -C1-TYPE-,0,(+,ALGEBR,0,),EQ,FDD13 00001173 / CMPVAL -C1-TYPE-,0,(+,VECTOR,0,),NE,FDD10 00001174 / DOLOOP L,1,NVIND,1,L0062,FDD14 VECTOR */ 00001175 / CMPVAL IPR,L,(+,C1,0,),NE,L0123 00001176 / SETVAL IPR,L,(+,C2,0,) 00001177 /L0123 ENDDO L0062,+1 00001178 / B FDD14 00001179 /FDD10 CMP000 NDOTI,0,EQ,FDD14 VECTNR,DOTPR,INDEX */ 00001180 ** /* CASE OF DD(P(3),Q(3)) ACTING ON P(3)**2*Q(3)**4 */ 00001181 / DOLOOP L,1,NDOTI,2,L0064,FDD11 00001182 / CMPVAL ISCAL,L,(+,C1,0,),NE,L0124 00001183 / SETVAL ISCAL,L,(+,C2,0,) 00001184 / B FDD11 00001185 /L0124 ENDDO L0064,2 00001186 /FDD11 DOLOOP M,1,NDOTI,2,L0066,FDD14 00001187 / CMPVAL ISCAL,M,(+,C2,0,),NE,FDD12 00001188 / CMPVAL M,0,(+,L,0,),EQ,FDD12 00001189 SETVAL II5,0,(+,L,0,+,1,0,) 00001190 SETVAL IJ5,0,(+,M,0,+,1,0,) 00001191 SETVAL ISCAL,II5,(+,ISCAL,II5,+,ISCAL,IJ5,) 00001192 / SET000 ISCAL,M 00001193 SET000 ISCAL,IJ5 00001194 /FDD12 ENDDO L0066,2 00001195 / B FDD14 00001196 /FDD13 CMPVAL -C2-TYPE-,0,(+,ALGEBR,0,),NE,IFO7 00001197 SETVAL II5,0,(+,-C1-NR-,0,) 00001198 SETVAL IJ5,0,(+,-C2-NR-,0,) 00001199 SETVAL IPR1,IJ5,(+,IPR1,IJ5,+,IPR1,II5,) 00001200 SET000 IPR1,II5 00001201 /FDD14 CMPVAL C2,0,(+,FUNCT0,0,),EQ,IFO7 ONLY 1 ARG WAS GIVEN */ 00001202 / B SPF7 00001203 *** CASE OF X-EXPRESSION . FORMAT DD XEXPR DLOC ARG1 ... */ 00001204 FDD2 SETVAL II5,0,(+,J,0,+,2,0,) 00001205 SETVAL CODE,0,(+,P$VAR,II5,) 00001206 GETMIN CODE,0,FDD4,IFO8 00001207 / NEGATE IGET,0 00001208 :FDD4 SETVAL P$VAR,II5,(+,DKEY,0,) 00001209 / SETVAL P$EXPR,K,(+,CODE,0,-,EXPRES0,0,) 00001210 / SET111 P$MULTP,K 00001211 / SET000 P$POINT,K 00001212 / SET000 P$WORD,J 00001213 SETVAL II5,0,(+,J,0,+,1,0,) 00001214 SET000 P$WORD,II5 00001215 / SET111 MARKER,0 00001216 / CMPVAL -CODE-TYPE-,0,(+,EXPRES,0,),NE,IFO8 WRONG DS,DX,STAND 00001217 / B SPF7 00001218 *** CASE OF D-EXPRESSION . FORMAT DD DEXPR DLOC DINDX ARG1 ... */ 00001219 FDD3 SETVAL II5,0,(+,J,0,+,2,0,) 00001220 SETADR J1,0,(+,P$WORD,J,) 00001221 GETMIN P$VAR,II5,FDD6,IFO8 00001222 / NEGATE IGET,0 00001223 /FDD6 PSEARCH J1,M 00001224 SETVAL II5,0,(+,J,0,+,2,0,) 00001225 : SETVAL P$VAR,II5,(+,DKEY,0,) 00001226 / SET111 MARKER,0 00001227 / SET000 P$POINT,K 00001228 / SETVAL P$EXPR,K,(+,M,0,) 00001229 / SET111 P$MULTP,K 00001230 / SET000 P$WORD,J 00001231 SETVAL II5,0,(+,J,0,+,1,0,) 00001232 SET000 P$WORD,II5 00001233 / B SPF7 00001234 IFO7 ERROR 2,' WRONG DD,DB,DT,DP,DK' 00001235 IFO8 ERROR 2,' WRONG DS,DX OR STAND. EXPRES.' 00001236 IFO13 ERROR 2,' EXPR INDEX OUT OF RANGE' 00001237 IFO14 ERROR 2,' EMPTY EXPRESSION' 00001238 INSER2 EPI 00001239 FFOUT 2,'INSER2' 00001240 LTORG 00001241 *** 00001242 SPFILE PRO 00001243 / CMP000 L$AKEY,LOCX5,EQ,SPF19A 00001244 *** CASE OF A COMMON FILE. DKEY + NAMELISTS ALREADY IN. ARGS AND */ 00001245 *** CREATED INDICES HAVE TO BE CONSIDERED AS A SUPERKEY 00001246 SETVAL II5,0,(+,J,0,+,1,0,) 00001247 SET000 P$POINT,II5 00001248 SETVAL P$EXPR,II5,(+,L$AKEY,LOCX5,) 00001249 SET111 P$MULTP,II5 00001250 SETVAL II5,0,(+,J,0,+,2,0,) 00001251 SETVAL P$VAR,II5,(+,SKEY,0,) ARGS ARE BEGIN OF SUPERKEY 00001252 / SETVAL P$EXPR,K,(+,LOCX5,0,) 00001253 / SET111 P$MULTP,K 00001254 / SET000 P$POINT,K 00001255 / SETVAL M,0,(+,L$AKEY,LOCX5,) 00001256 / SET000 N,0 00001257 / SETVAL NEPS5,0,(+,NEPS,0,) 00001258 /SPF20 SETVAL N,0,(+,N,0,+,1,0,) EXTEND SKEY IN IEP BY CREATED IND 00001259 SETVAL II5,0,(+,T$1CODEA,-M-N-,) 00001260 CMP000 II5,0,EQ,SPF21 TERMINATOR 00001261 / CMPVAL N,0,(+,K,0,-,J,0,-,2,0,),LT,SPF20 00001262 ** /* SKIP ARGS IN BEGIN OF NAMELIST AT DKEY */ 00001263 CMPVAL -II5-TYPE-,0,(+,INDEX,0,),NE,SPF20 00001264 SETVAL INDEX5,0,(+,-II5-NR-,0,) 00001265 / CMPBIT I$PROP,INDEX5,CREAT,OFF,SPF21 00001266 *** CALL INDCR(NVIGEH(INDEX5).DIMEN,NEW5) 00001267 PINDCR I$PROP,INDEX5,NEW5 00001268 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00001269 / SETVAL P$VAR,NEPS,(+,NEW5,0,+,INDEX0,0,) 00001270 / SET000 IPR,NEW5 00001271 / B SPF20 00001272 /SPF21 CMPVAL NEPS5,0,(+,NEPS,0,),EQ,XSPFILE NO CR IND WERE INSERT 00001273 SETVAL II5,0,(+,K,0,-,1,0,) 00001274 SETVAL P$POINT,II5,(+,NEPS5,0,) JP FORWARD 00001275 / SETVAL P$POINT,NEPS,(+,K,0,) JP BACK */ 00001276 / B XSPFILE 00001277 *** CASE OF COMMON FILE. NAMES NOT YET IN. ARGS BECOME DKEY, WHICH */ 00001278 *** IS EXTENDED WITH THE NAMELISTS, READ IN AFTER IEP(NEPS) */ 00001279 SPF19A SETVAL II5,0,(+,NEPS,0,+,1,0,) 00001280 *** CALL CROSR(L,ADDR(IEP(NEPS+1))); /* READ NAMES INTO IEP */ 00001281 PCROSR L,P$WORD,II5 00001282 / SET111 NAMES,0 00001283 SETVAL II5,0,(+,K,0,-,J,0,-,3,0,) 00001284 SETVAL J1,0,(+,3,0,+,NEXTT/4,0,+,II5,0,+,II5,0,) 00001285 *** BUF WORDS FILENAME 2 WORDS PER ARGM 00001286 : DOLOOP M,1,J1,1,L0056,L0057 NR OF ARGS+3 . ARE UNWANTED 00001287 SETVAL IJ5,0,(+,NEPS,0,+,M,0,) FOR KEY 00001288 SET000 P$WORD,IJ5 DELETE 3 BUFFER CONTROL WORDS+ARGS 00001289 / ENDDO L0056,+1 00001290 L0057 SETVAL M,0,(+,NEPS,0,+,J1,0,+,1,0,) 00001291 L0058 SETADR A0,0,(+,IEP,M,) 00001292 CMPCAR T$TNAME,A0,X'0000000000',5,EQ,L0059 00001293 SETCAR T$TNAME,A0,X'0000000000',5 00001294 SET000 T$TPROP,A0 00001295 SETVAL A0,0,(+,A0,0,+,NEXTN,0,) ABS ADRES 00001296 SETVAL M,0,(+,M,0,+,NEXTN/4,0,) RELAT ADRES 00001297 B L0058 00001298 L0059 CMPVAL M,0,(+,LIEP,0,),GE,IFO26 00001299 / SETVAL P$EXPR,K,(+,LOCX5,0,) 00001300 / SET111 P$MULTP,K 00001301 / SET000 P$POINT,K 00001302 SETVAL II5,0,(+,J,0,+,2,0,) 00001303 SETVAL P$VAR,II5,(+,DKEY,0,) 00001304 SETVAL II5,0,(+,K,0,-,1,0,) 00001305 SETVAL P$POINT,II5,(+,NEPS,0,+,J1,0,) JP FORWARD 00001306 SETVAL NEPS,0,(+,M,0,-,1,0,) 00001307 / SETVAL P$POINT,NEPS,(+,K,0,) JP BACK */ 00001308 B XSPFILE 00001309 IFO26 ERROR 6,' PLEASE USE NAMES CARD' 00001310 SPFILE EPI 00001311 FFOUT 6,'SPFILE' 00001312 END 00001313 ./A IN1,INCR=1 00000001 ./MACRO MAINMCRO 00000002 ./MACRO INMACRO 00000003 TITLE 'IN1' 00000004 GBLC &OVLAY 00000005 LCLA &SYMBOL$,&TOP$,&NR$,&ARRAY$,&QUANT$,&EXPON$ 00000006 LCLA &LENGTH$,&VALUE$,&FOUND$ 00000007 LCLC &CBUF1 00000008 ./MACRO INCOM 00000009 ./MACRO MAINCOM 00000010 *** 00000011 *** 00000012 PRINT NOGEN 00000013 IN0 CSECT 00000014 EQUIVAL 00000015 EXTRN FOUT,IN2,INPHV,LIJN,LEZE1,FOUTP,TAKMAN,UNCF 00000016 ENTRY ZOEK,SARAY1,INDON,IN1,INPHU,SAMEN,READI1,SEAR1 00000017 ENTRY COVNR1,COSYM1,SNAME1,FORWAR,DLIST1,CCROSR,UUPDAT 00000018 ENTRY WRCOM1,ENCOM1,FREEZE 00000019 IN1 PROLOGH 00000020 *** INFORMATION ABOUT THE OVERLAY 00000021 L 10,=V(INCOM) 00000022 USING INCOM,10 00000023 STORE 10,COMADR,1 00000024 ST 5,LAYNR ADDRESS OF SAVEAREA 00000025 SETCAR LAYNAM$D,0,C'INPU',4 00000026 SET111 LAYNAM$V,0 OVERLAY 1 IS INPUT 00000027 L 15,=A(IN2) 00000028 BALR 14,15 00000029 EPILOGH 00000030 SAVEFTN DS 18F 00000031 DROP 12 00000032 ** 00000033 ** SAMEN: PROCEDURE(RESULT,NR,ADDR(ARRAY)); 00000034 *** PACK THE CHARS ARRAY(1)...ARRAY(NR) INTO RESULT 00000035 DS 0H 00000036 USING *,15 00000037 &NR$ SETA 9 00000038 SAMEN LPR &NR$,&NR$ R1=A(RESULT),R3=A(ARRAY) 00000039 LA 4,10 00000040 CR &NR$,4 00000041 BNH LL005 00000042 LR &NR$,4 00000043 LL005 LR 7,6 00000044 LR 8,6 00000045 L0005 MVC 0(1,1),0(3) 00000046 AR 1,6 00000047 LA 3,4(0,3) 00000048 / BXLE 7,8,L0005 00000049 BR 14 00000050 DROP 15 00000051 ** 00000052 DS 0H 00000053 USING *,15 00000054 *** SEARCH SYMBOL IN ARRAY. IF FOUND RETURNS ITS PLACE. ELSE INSERT IT 00000055 *** AT THE END OF THE ARRAY. THE PLACE IS RETURNED IN NR . 00000056 &SYMBOL$ SETA 1 00000057 &TOP$ SETA 2 00000058 &NR$ SETA 3 00000059 &ARRAY$ SETA 4 ADDR ( REF$IN ) 00000060 ZOEK L 5,0(&ARRAY$) ADDR(ARRAY$NAME) 00000061 LR 7,6 00000062 L 9,0(&TOP$) 00000063 CR 9,7 00000064 LR 8,6 00000065 BL ZOEK2 00000066 ZOEK1 CLC 0(LNAME$,5),0(&SYMBOL$) 00000067 BNE ZOEK3 00000068 ST 7,0(&NR$) 00000069 BR 14 00000070 ZOEK3 LA 5,LNAME$(5) 00000071 BXLE 7,8,ZOEK1 00000072 ZOEK2 AR 9,6 00000073 ST 9,0(&TOP$) 00000074 ST 9,0(&NR$) 00000075 MVC 0(LNAME$,5),0(&SYMBOL$) 00000076 L 5,8(&ARRAY$) ADDR ( ARRAY$PROP ) 00000077 CR 0,5 ARRAY$PROP DOES NOT ALWAYS EXIST. 00000078 BER 14 E.G. FOR DUMMIES. 00000079 SR 9,6 00000080 STC 0,0(5,9) 00000081 BR 14 00000082 DROP 15 00000083 *** 00000084 DS 0H 00000085 USING *,15 00000086 *** SEARCH SYMBOL IN ARRAY. IF FOUND, RETURN NR=ITS PLACE. ELSE NR=0. 00000087 &SYMBOL$ SETA 1 00000088 &ARRAY$ SETA 2 00000089 &TOP$ SETA 9 00000090 &NR$ SETA 4 00000091 SARAY1 LR 7,6 00000092 LR 8,6 00000093 CR &TOP$,7 00000094 BL SARAY2 00000095 SARAY4 CLC 0(LNAME$,&ARRAY$),0(&SYMBOL$) 00000096 BNE SARAY3 00000097 ST 7,0(&NR$) 00000098 BR 14 00000099 SARAY3 LA &ARRAY$,LNAME$(0,&ARRAY$) 00000100 BXLE 7,8,SARAY4 00000101 SARAY2 ST 0,0(&NR$) 00000102 BR 14 00000103 DROP 15 00000104 *** 00000105 *** 00000106 DS 0H 00000107 USING *,15 00000108 INDON ST 1,QUANT$ CALL INDON(QUANT$,EXPON$) 00000109 ST 2,EXPON$ PACK PER 16 BITS 00000110 CMP000 EXPON$,0,NE,SO117 00000111 INDO2 SETVAL T$1CODEA,-MBE-SHMEM1-,(+,QUANT$,0,) 00000112 SETVAL SHMEM1,0,(+,SHMEM1,0,+,1,0,) 00000113 SO112 SETADR EXPON$,0,(+,T$1CODEA,-MBE-SHMEM1-,) 00000114 CMPVAL EXPON$,0,(+,NDIMT,0,),GE,INFO3 00000115 CMP000 QUANT$,0,NE,RETURN 00000116 L 1,SHMEM1 SHMEM1=SHMEM1/2*2 00000117 SRA 1,1 00000118 SLA 1,1 00000119 ST 1,SHMEM1 00000120 SET000 T$1CODEA,-MBE-SHMEM1- BLANK OUT REST OF WORD 00000121 SETVAL SHMEM1,0,(+,SHMEM1,0,+,1,0,) 00000122 SETADR MBE,0,(+,T$1CODEA,-MBE-SHMEM1-,) 00000123 SET111 SHMEM1,0 00000124 BR 14 00000125 SO117 SETVAL SHMEM1,0,(+,SHMEM1,0,-,1,0,) 00000126 CMPVAL T$1CODEA,-MBE-SHMEM1-,(+,ONE,0,),EQ,INDO2 00000127 CMPVAL -QUANT$-TYPE-,0,(+,DUMMY,0,),NE,SO116 00000128 SETVAL T$1CODEA,-MBE-SHMEM1-,(+,MINUS,0,) 00000129 SETVAL SHMEM1,0,(+,SHMEM1,0,+,1,0,) 00000130 B INDO2 00000131 SO116 SETVAL -QUANT$-NR-,0,(-,-QUANT$-NR-,0,) 00000132 B INDO2 00000133 INFO3 ERROR 1,' INPUT SPACE IS FULL' 00000134 DROP 15 00000135 *** 00000136 *** READI1: PROCEDURE(NDUMFL); /* READ A VARIABLE INTO SYMB1 */ 00000137 *** IF DUMMY,SET NDUMFL=1 AND GIVE VARIABLE,WITHOUT + BEHIND, IN IB */ 00000138 READI1 PRO 00000139 PLEZE1 00000140 / SETVAL IB,0,(+,IAL,0,-,1,0,) 00000141 / SET111 NDUMFL,0 NO DUMMY */ 00000142 DOLOOP J,1,IAL,1,LL006,LL007 00000143 CMPCAR B,J,C'A',1 CHECK ON ILLEGAL CHARACTER 00000144 BL READI2 00000145 READI4 BXLE 7,8,LL006 00000146 LL007 B XREADI1 00000147 READI2 CMP000 NRFLAG1,0 00000148 BE READI3 00000149 CMPCAR B,J,C'.',1 00000150 BNE INFO5 00000151 B READI4 00000152 READI3 CMPVAL J,0,(+,IAL,0,) 00000153 BNE INFO5 00000154 CMPCAR B,IAL,C'+',1 DUMMY 00000155 BNE INFO5 00000156 SETCAR SYMB1,0,X'0000000000',5 00000157 PSAMEN SYMB1,IB,B CUT TRAILING + OFF 00000158 PZOEK D,SYMB1,IB 00000159 / SET000 NDUMFL,0 DUMMY */ 00000160 B XREADI1 00000161 INFO5 ERRORP 1,' ILLEGAL CHAR IN VARIABLE NAME' 00000162 READI1 EPI 00000163 ** 00000164 ** 00000165 ** 00000166 *** SKIP ALL NON-SPECIAL CHARACTERS OF CARD (IF ANY). SKIP ALL BUT * 00000167 *** ONE SPECIAL CHARS. THIS FIXES A(NI+1)=77B OR NON-SPECIAL. * 00000168 *** BLANK IS CONSIDERED SPECIAL HERE. * 00000169 SEAR1 PRO 00000170 LR 1,6 R1=IA 00000171 SEA1 L 7,NI 00000172 AR 7,6 00000173 DOLOOP J,,72,1,LL011,LL012 00000174 CMPCAR A,J,X'77',1 00000175 BE SEA5 00000176 CR 1,0 00000177 BL SEA4 JP IF SPECIAL 00000178 LOAD 1,A,J 00000179 S 1,=F'192' =X'C0' HIGHEST SPECIAL CHARACTER 00000180 SEA3 BXLE 7,8,LL011 00000181 LL012 ST 1,IA 00000182 / SETVAL NI,0,(+,144,0,) FORCE READING OF NEW CARD 00000183 / SETVAL IB,0,(+,NORDER,0,) 00000184 SETVAL NORDER,0,(-,1,0,) 00000185 L 15,=A(LEZE1) 00000186 BALR 14,15 00000187 / SETVAL NORDER,0,(+,IB,0,) 00000188 / SET111 NI,0 00000189 L 1,IA 00000190 B SEA1 00000191 SEA4 CMPCAR A,J,X'C0',1 00000192 BL SEA3 JP IF SPECIAL CHARACTER 00000193 /SEA5 SETVAL NI,0,(+,J,0,-,1,0,) 00000194 SEAR1 EPI 00000195 ** 00000196 *** CARDLENGTH EQU NR OF WORDS NEEDED FOR 80 CHARACTERS */ 00000197 *** 8 ON CDC . 20 ON IBM . */ 00000198 INPHU PROLOGH 1 00000199 STORE 1,IBUF,1 R1=NTAPX 00000200 CMP111 IBUF,1 00000201 / BNE INPH1 JP IF READ REQUESTED FROM TAPE3 00000202 / CMP000 DOVLAG$B,0 00000203 / BNE INPH22 JP IF INSIDE DOLOOP */ 00000204 /INPH11 CMP000 ISPLAY,0 00000205 / BE INPH1 00000206 / SETVAL IBUF,1,(+,NTAP2,0,) 00000207 / SET000 IBUF,3 00000208 / SET111 IBUF,4 00000209 / SETCAR IBUF,6,C' ) ',4 INTERACTIVE RUN USES ) AS PROMPT 00000210 CALLFTN LIJN 00000211 SET111 IBUF,1 00000212 INPH1 CALLFTN INPHV READ 00000213 SETVAL L,0,(+,IBUF,4,) LENGTH. NR OF WORDS 00000214 LA 9,6 DO K=IBUF(4)+5 TO 7 BY -1 00000215 LNR 8,6 STRIP OFF TRAILING BLANKS 00000216 L 7,IBUF+12 00000217 LA 7,5(7) 00000218 LL003 ST 7,K 00000219 CMPVAL IBUF,K,(+,IBUF,5,) 00000220 BNE LL002 00000221 SETVAL L,0,(+,L,0,-,1,0,) 00000222 BXH 7,8,LL003 00000223 *** IBUF(5) CONTAINS A BLANK WORD */ 00000224 /LL002 SETVAL IBUF,4,(+,L,0,) 00000225 CMPCAR IBUF+3,K,C' ',1 00000226 BNE LL004 00000227 SETCAR IBUF+3,K,X'00',1 TERMINATOR OF INPUT CARD 00000228 B XINPHU 00000229 LL004 CMPVAL L,0,(+,&CARDLEN,0,+,1,0,) 00000230 BE XINPHU 00000231 SETVAL K,0,(+,K,0,+,1,0,) 00000232 / SETVAL IBUF,4,(+,L,0,+,1,0,) 00000233 / SETVAL IBUF,K,(+,IBUF,5,) 00000234 SETCAR IBUF+3,K,X'00',1 TERMINATE WITH BLANKS,00 00000235 B XINPHU 00000236 INPH22 CMPVAL T$3DOJMP,DOVLAG$B,(+,4,0,) 00000237 BNE INFO1 00000238 ** /* RANGE OF DO INDEX UNDEFINED. IMPOSSIBLE ERROR */ 00000239 INPH2 SETVAL K,0,(+,DOVLAG$B,0,+,DOCARD,0,) 00000240 CMPVAL T$0WORD,K,(-,1,0,) TERMINATOR. END OF LOOP 00000241 BNE LL010 00000242 SET000 DOVLAG$B,0 00000243 SET000 DOVLAG$L,0 00000244 / B INPH11 00000245 LL010 CMPCAR T$3DODIR,K,X'77',1 00000246 / BE INPH3 DO */ 00000247 CMPCAR T$3DODIR,K,X'70',1 00000248 / BE INPH4 ENDDO */ 00000249 / SETVAL IBUF,6,(+,IBUF,5,) BLANK WORD */ 00000250 / DOLOOP J,1,&CARDLEN,1,L0016,L0017 CARDLENGTH 00000251 LR 4,7 J 00000252 SR 4,6 00000253 SLA 4,2 00000254 A 4,K 00000255 ST 4,K5 K5=K+4*(J-1) 00000256 SETVAL K2,0,(+,6,0,+,J,0,) 00000257 SETVAL IBUF,K2,(+,T$0WORD,K5,) 00000258 / SETVAL IBUF,4,(+,J,0,+,1,0,) RETRIEVE 1 CARD FROM STORE */ 00000259 CMPCAR T$0CHARR,K5,X'00',1 00000260 BE INPH5 00000261 / BXLE 7,8,L0016 00000262 /L0017 SETVAL J,0,(+,&CARDLEN,0,) CARDLENGTH 00000263 INPH5 L 4,J DOCARD=DOCARD+4*J 00000264 SLA 4,2 00000265 A 4,DOCARD 00000266 ST 4,DOCARD 00000267 B XINPHU 00000268 ** /* CASE OF ENDDO . INCREMENT AND TEST */ 00000269 INPH4 SETVAL L,0,(+,T$3DOJMP,K,+,DOVLAG$B,0,) 00000270 ** /* DO J=J1 TO J2 BY J3 */ 00000271 / SETVAL TEST5,0,(+,T$3J2VAL,L,-,T$3JVAL,L,-,T$3J3VAL,L,) 00000272 / CMP000 T$3J3VAL,L 00000273 / BNH L0020 00000274 / SETVAL TEST5,0,(-,TEST5,0,) 00000275 /L0020 SETVAL DOLIS5,0,(+,DOLIST,0,) 00000276 / CMP000 TEST5,0 00000277 / BNH L0021 00000278 LADR 4,T$3NEXT3,K DOCARD=REL ADDR(WORD AFTER ENDDO 00000279 S 4,DOVLAG$B WITH RESPECT TO DOVLAG$B 00000280 ST 4,DOCARD POSITION AFTER ENDDO. LOOP FINISHED. 00000281 / SETVAL DOLIST,0,(+,T$3DOJMP,L,) 00000282 ** /* DELETE DO VARIABLE FROM DOLIST * 00000283 / B L0022 00000284 L0021 LADR 4,T$3LOOP,L DOCARD=REL ADDR(BEGIN OF LOOP) 00000285 S 4,DOVLAG$B WITH RESPECT TO DOVLAG$B 00000286 ST 4,DOCARD POSITION AGAIN AT BEGIN OF DO 00000287 L0022 CMP000 IAL,0 00000288 BE INPH44 00000289 / CMP000 DOLST1,0 00000290 BNE INPH44 00000291 / SETVAL DOLST1,0,(+,NSUBS,0,) 00000292 / SET000 J,0 00000293 / SETVAL N,0,(+,DOLIS5,0,) STRAIGHTEN DOLIST */ 00000294 *** DOLIST CONTAINS OLD VALUE OF DO VARIABLE 00000295 INPH4A SETVAL K5,0,(+,DOVLAG$B,0,+,N,0,) 00000296 SETVAL K2,0,(+,NSUBS,0,+,J,0,) 00000297 SETNAM T$4NAM,K2,T$3JNAM,K5 /* COPY */ 00000298 SETVAL T$4VAL,K2,(+,T$3JVAL,K5,) /* COPY */ 00000299 SETVAL N,0,(+,T$3DOJMP,K5,) 00000300 L 4,J POSITION J FOR NEXT NAME 00000301 LA 4,T$4NEXT4-T$4NAM(0,4) 00000302 ST 4,J 00000303 CMPVAL N,0,(+,4,0,) 00000304 / BNE INPH4A TERMINATOR */ 00000305 SETVAL K5,0,(+,NSUBS,0,+,J,0,) 00000306 SETVAL T$0WORD,K5,(-,1,0,) /* TERMINATOR */ 00000307 / SETVAL NSUBS,0,(+,NSUBS,0,+,J,0,+,4,0,) 1 WORD FURTHER 00000308 / CMPVAL NSUBS,0,(+,NDIMU,0,) 00000309 / BH INFO2 DOLOOP USES TOO MUCH SPACE 00000310 INPH44 SETVAL T$3JVAL,L,(+,T$3JVAL,L,+,T$3J3VAL,L,) 00000311 / B INPH2 00000312 ** /* INITIALIZE . DO J=J1,J2,J3 */ 00000313 &VALUE$ SETA 2 00000314 &FOUND$ SETA 3 00000315 /INPH3 CMPCAR T$3J1NAM,K,X'0000000000',5 00000316 LA 15,DLIST1 00000317 / BE L0023 00000318 SETNAM NAME5,0,T$3J1NAM,K 00000319 BALR 14,15 00000320 CR &FOUND$,6 00000321 / BNE INFO1 00000322 STORE &VALUE$,T$3J1VAL,K 00000323 /L0023 CMPCAR T$3J2NAM,K,X'0000000000',5 00000324 / BE L0024 00000325 SETNAM NAME5,0,T$3J2NAM,K 00000326 BALR 14,15 00000327 CR &FOUND$,6 00000328 / BNE INFO1 00000329 STORE &VALUE$,T$3J2VAL,K 00000330 /L0024 CMPCAR T$3J3NAM,K,X'0000000000',5 00000331 / BE L0025 00000332 SETNAM NAME5,0,T$3J3NAM,K 00000333 BALR 14,15 00000334 CR &FOUND$,6 00000335 / BNE INFO1 00000336 STORE &VALUE$,T$3J3VAL,K 00000337 /L0025 SETVAL DOLIST,0,(+,DOCARD,0,) 00000338 SETVAL T$3JVAL,K,(+,T$3J1VAL,K,) 00000339 LADR 4,T$3LOOP,K 00000340 S 4,DOVLAG$B 00000341 ST 4,DOCARD POSITION AT BEGIN OF LOOP 00000342 / B INPH2 00000343 INFO1 ERROR 1,' RANGE OF DO INDEX UNDEFINED' 00000344 INFO2 ERROR 1,' DO LOOP USES TOO MUCH SPACE' 00000345 XINPHU EPILOGH 1 00000346 SAVEFTN1 DS 18F 00000347 *** 00000348 *** DLIST1: PROCEDURE(NNAME,VVALUE,FOUND); 00000349 *** SEARCH VALUE OF DO VARIABLE .X3,X4,B2 * 00000350 DS 0H 00000351 USING *,15 00000352 DLIST1 SETVAL L,0,(+,DOLIST,0,) 00000353 DLIST2 SETVAL K5,0,(+,L,0,+,DOVLAG$B,0,) 00000354 CMPNAM T$3JNAM,K5,NAME5,0 00000355 BNE L0030 00000356 LOAD &VALUE$,T$3JVAL,K5 00000357 LR &FOUND$,6 00000358 / BR 14 00000359 ** /* CHECK FOR TERMINATOR */ 00000360 L0030 CMPVAL T$3DOJMP,K5,(+,4,0,) TERMINATOR 00000361 BNE L0031 00000362 LR &FOUND$,0 00000363 / BR 14 00000364 L0031 SETVAL L,0,(+,T$3DOJMP,K5,) 00000365 / B DLIST2 00000366 DROP 15 00000367 *** 00000368 FFOUT 1,'IN1' 00000369 LTORG 00000370 *** 00000371 *** CREATE INTEG IN FRONT OF NUMERICAL ARGS OF A FUNCTION */ 00000372 FORWAR PRO 00000373 / CMPCAR NBIND,0,C',',1 00000374 BE XFORWAR INTEG NOT NECESSARY 00000375 / CMPCAR NBIND,0,C')',1 00000376 BE XFORWAR INTEG NOT NECESSARY 00000377 / CMP000 IAL,0 00000378 BE XFORWAR INTEG NOT NECESSARY 00000379 / CMPCAR NBIND,0,C'(',1 00000380 / BNE FOR1 00000381 *** CASE OF X EXPR. COULD BECOME NUMERICAL. */ 00000382 *** CASE OF FUNCTION. CAN ONLY BECOME NUMERICAL IF IT IS A */ 00000383 *** NUMERICAL FUNCTION . */ 00000384 *** ALL OTHER CASES ARE CONSIDERED AS VECTOR. THEN INTEG IS NOT */ 00000385 *** NECESSARY */ 00000386 PSARAY1 X$NAME,SYMB1,NR 00000387 / CMP111 NR,0 00000388 BE XFORWAR CASE OF CONJG. NO INTEG REQUIRED 00000389 / CMP000 NR,0 00000390 / BNE FOR1 00000391 PSARAY1 F$NAME,SYMB1,NR 00000392 / CMP000 NR,0 00000393 BE XFORWAR CONSIDERED AS VECTOR 00000394 / CMPVAL NR,0,(+,X'A',0,) 00000395 BL XFORWAR NO NUMERICAL FUNCTION. WILL LEAD TO ERROR 00000396 / CMPVAL NR,0,(+,X'11',0,) 00000397 BNL XFORWAR NO NUMERICAL FUNCTION. WILL LEAD TO ERROR 00000398 /FOR1 CMPCAR NBIND,0,C'(',1 00000399 / BNE L0150 00000400 / SETVAL NHAK,0,(+,NHAK,0,-,1,0,) 00000401 /L0150 SETVAL NI,0,(+,NI,0,-,IAL,0,-,1,0,) BACKSPACE ON INPUT CARD 00000402 *** THIS CAN LEAD TO NI<0, THEREFORE A(-5) TILL A(0) CAN GET USED. * 00000403 *** E.G. IN THE CASE Z Z=F(AAAAA AND ON NEXT CARD +1) . */ 00000404 / DOLOOP J,1,IAL,1,L0151,L0152 CONSTRUCT *(-SYMB ON THE CARD 00000405 SETVAL K,0,(+,NI,0,+,J,0,) 00000406 LOAD 1,B,J 00000407 SRL 1,24 00000408 STORE 1,A,K 00000409 ** /* SYMB IN B DOES NOT CONTAIN BLANKS, WHILE THE ORIGINAL * 00000410 ** /* VARIABLE COULD */ 00000411 / BXLE 7,8,L0151 00000412 /L0152 CMP000 IMINUS,0 00000413 / BNH L0153 00000414 / SET000 IMINUS,0 00000415 / SETCAR A,NI,C'-',1 00000416 / SETVAL NI,0,(+,NI,0,-,1,0,) 00000417 SETCAR A,NI,C'(',1 00000418 / SETVAL NI,0,(+,NI,0,-,1,0,) 00000419 / B L0154 00000420 /L0153 SETCAR A,NI,C'(',1 00000421 / SETVAL NI,0,(+,NI,0,-,1,0,) 00000422 /L0154 SETNAM SYMB1,0,X$NAME,2 INTEG */ 00000423 / SET000 NRFLAG1,0 00000424 / SET000 EXPOFL1,0 00000425 / SET000 NBLAN1,0 00000426 / SET111 CREATBR,0 00000427 / SET000 SLASH2,0 00000428 / SETCAR NBIND,0,C'*',1 00000429 SET000 B,1 00000430 SETCAR B,1,C'I',1 00000431 FORWAR EPI 00000432 *** 00000433 *** CONSTRUCT VECTOR NUMBER. USE -P(-N)=P(N). */ 00000434 *** P(3) IS 10B,5BITS VECTOR,5BITS NR. P(MU) IS 1403 100* 040* */ 00000435 *** P(-3) = 1403 100* 3774 AND P(-MU) = 1403 100* 1407 040* */ 00000436 *** COVNR1: PROCEDURE(NR,CODE) ; 00000437 COVNR1 PRO 00000438 PSARAY1 D$NAME,SYMB1,NR 00000439 / SETVAL AA,0,(+,SLASH1,0,) 00000440 SETVAL IA,0,(+,NR,0,) +X'000' 00000441 / CMP000 NR,0 00000442 / BNE SO147 JP IF DUMMY VECTOR */ 00000443 PZOEK V,SYMB1,IA 00000444 / PLEZE1 READ INDEX. THIS DESTROYS SLASH1,IGET.*/ 00000445 ** /* STORED IN AA,SO1 */ 00000446 L 1,IA 00000447 SLL 1,27 00000448 SRL 1,27 R1=MOD(IA,32) 00000449 L 2,NRFIX 00000450 SLL 2,27 00000451 SRL 2,27 R2=MOD(NRFIX,32) 00000452 LR 3,1 00000453 SLL 3,5 00000454 AR 3,2 NP31=32*R1+R2 00000455 ST 3,NP31 00000456 A 1,=X'00000200' 00000457 ST 1,IA IA=X'200'+R1 00000458 / CMP000 NRFLAG1,0 00000459 / BE SO149 00000460 / CMPCAR NBIND,0,C')',1 00000461 BNE FOS31 ILLEGAL VECTOR ARGUMENT 00000462 L 1,IMINUS IF IMINUS*SO1 < 0 THEN GOTO SO149 00000463 X 1,SO1 00000464 LTR 1,1 00000465 / BL SO149 00000466 PLEZE1 00000467 / SETVAL CODE,0,(+,X'800',0,) 00000468 /SO150 SETVAL NR,0,(+,NP31,0,) 00000469 / SETVAL SLASH1,0,(+,AA,0,) 00000470 B XCOVNR1 00000471 /SO147 PLEZE1 00000472 /SO149 PSNAME1 NR,CODE ARG IS INDEX,DUMMY OR NEG NR */ 00000473 / SETVAL NP31,0,(+,CODE,0,+,NR,0,) 00000474 / PINDON X'303',0 00000475 / PINDON IA,0 00000476 L 1,IMINUS IF IMINUS*SO1 < 0 THEN CALL INDON... 00000477 X 1,SO1 00000478 LTR 1,1 00000479 / BNL L0172 00000480 / PINDON X'307',0 00000481 /L0172 SET000 IMINUS,0 00000482 / SET000 SO1,0 00000483 / CMPCAR NBIND,0,C')',1 00000484 BNE FOS31 ILLEGAL VECTOR ARGUMENT 00000485 / PLEZE1 00000486 / SET000 CODE,0 00000487 / B SO150 00000488 FOS31 ERRORP 5,' ILLEGAL VECTOR ARGUMENT' 00000489 COVNR1 EPI 00000490 ** 00000491 *** CONSTRUCT DOTPRODUCT. PDQ IS 11B,5BITS VECTOR,5BITS VECTOR. */ 00000492 *** IF ONE VECTOR IS DUMMY THEN PDQ IS 1403 VECTOR VECTOR . * 00000493 *** CODPR1: PROCEDURE(NR,CODE); 00000494 CODPR1 PRO 00000495 PSARAY1 D$NAME,SYMB2,NR 00000496 / CMP000 NR,0 00000497 / BNE SO155 00000498 PSARAY1 D$NAME,SYMB3,NR 00000499 / CMP000 NR,0 00000500 / BNE SO163 00000501 PZOEK V,SYMB2,IA 00000502 PZOEK V,SYMB3,IB 00000503 L 1,IA ORDER COMPONENTS 00000504 L 2,IB SMALLEST FIRST 00000505 CR 1,2 00000506 SLL 1,5 NR=32*V1+V2 00000507 BNH L0174 00000508 SRL 1,5 00000509 SLL 2,5 00000510 L0174 AR 1,2 00000511 ST 1,NR 00000512 SETVAL CODE,0,(+,X'C00',0,) 00000513 / SETVAL JDVF1,0,(+,JDVF1,0,+,4096,0,) 00000514 B XCODPR1 00000515 /SO155 SETVAL IA,0,(+,NR,0,) 00000516 PSARAY1 D$NAME,SYMB3,NR 00000517 / CMP000 NR,0 00000518 / BNE L0175 00000519 PZOEK V,SYMB3,IB 00000520 / SETVAL NR,0,(+,IB,0,+,X'200',0,) 00000521 L0175 SETVAL IB,0,(+,NR,0,) 00000522 /SO159 PINDON X'303',0 00000523 / PINDON IA,0 00000524 / CMP000 SO1,0 00000525 / BNH L0176 00000526 / SET000 IMINUS,0 00000527 / PINDON X'307',0 00000528 /L0176 SET000 SO1,0 00000529 / SETVAL NR,0,(+,IB,0,) 00000530 / SET000 CODE,0 00000531 B XCODPR1 00000532 /SO163 SETVAL IB,0,(+,NR,0,) 00000533 PZOEK V,SYMB2,IA 00000534 / SETVAL IA,0,(+,IA,0,+,X'200',0,) 00000535 / B SO159 00000536 CODPR1 EPI 00000537 ** 00000538 *** COSYM1: PROCEDURE(NR,CODE); 00000539 COSYM1 PRO 00000540 CMPCAR SYMB2,0,X'0000000000',5 00000541 / BE L0210 00000542 L 15,=A(CODPR1) CONSTRUCT DOTPRODUCT 00000543 BALR 14,15 CODPR1(NR,CODE) 00000544 B XCOSYM1 00000545 L0210 CMPCAR B,1,C'$',1 00000546 / BE SO176 00000547 SO175 CMPCAR B,1,C'I',1 00000548 BL L0211 00000549 CMPCAR B,1,C'N',1 00000550 BH L0211 00000551 ** /* CASE OF INDEX IF FIRST LETTER LIES IN RANGE I TO N. */ 00000552 PZOEK I,SYMB1,LVAG 00000553 / SETVAL NR,0,(+,LVAG,0,) 00000554 / SETVAL JANI1,0,(+,JANI1,0,+,1,0,) 00000555 / SETVAL CODE,0,(+,X'100',0,) 00000556 B XCOSYM1 00000557 L0211 PZOEK S,SYMB1,LVAG 00000558 / SETVAL NR,0,(+,LVAG,0,) 00000559 / SETVAL CODE,0,(+,X'400',0,) 00000560 /SO179 SETVAL JANI1,0,(+,JANI1,0,+,4096,0,) 00000561 B XCOSYM1 00000562 ** /* DOLLAR EXPRESSSION SEEN IN RHS OF A SUBSTITUTION. */ 00000563 ** /* RHS CAN BE ENCOUNTERED AFTER LHS IS ANALYZED. E.G. IN */ 00000564 ** /* Z=F(A,B,(C)+A) . SEE ENTRY DOLLA1 . */ 00000565 SO176 L 8,SYMB1 LVAG=BIN(SYMB1.NUMB) 00000566 SLL 8,12 CONVERT '$0.*' INTO X'.*' 00000567 SRDL 8,15 00000568 SRL 8,5 00000569 SRDL 8,3 00000570 SRL 8,5 00000571 SLDL 8,6 00000572 ST 8,K 00000573 / CMP000 K,0 00000574 / BH FOS17 00000575 / CMPVAL K,0,(+,&LISCAL,0,) 00000576 / BH FOS17 UNRECOGNIZABLE TEXT */ 00000577 CMP000 ISCAL$M,K 00000578 / BNE FOS17 00000579 / SET000 NR,0 00000580 CMP000 ISCAL$P,K 00000581 / BE L0212 00000582 SETVAL CODE,0,(+,ISCAL$P,K,) 00000583 / B SO179 00000584 L0212 SET111 ISCAL$M,K DISTINGUISHES CONTENT 24** VERSUS 00000585 SETVAL ISCAL$S,K,(+,SHMEM1,0,) SHIFT AND MBE 00000586 SETVAL ISCAL$P,K,(+,MBE,0,) REMEMBER POSITION OF INDO 00000587 / SETVAL CODE,0,(+,X'500',0,) 00000588 / B SO179 00000589 FOS17 ERRORP 5,' UNRECOGNIZABLE TEXT' 00000590 COSYM1 EPI 00000591 ** 00000592 *** SNAME1: PROCEDURE(NR,CODE); 00000593 *** RETURN NR=0 AND CODE=0 IF QUANTITY IS NOT FOUND. 00000594 SNAME1 PRO 00000595 / CMP000 NRFLAG1,0 00000596 / BNE SO167 00000597 PSARAY1 D$NAME,SYMB1,NR 00000598 / CMP000 NR,0 00000599 / BE L0177 00000600 / SETVAL CODE,0,(+,X'0',0,) 00000601 B XSNAME1 00000602 L0177 PSARAY1 S$NAME,SYMB1,NR 00000603 / CMP000 NR,0 00000604 / BE L0200 00000605 / SETVAL JANI1,0,(+,JANI1,0,+,4096,0,) 00000606 / SETVAL CODE,0,(+,X'400',0,) 00000607 B XSNAME1 00000608 L0200 PSARAY1 I$NAME,SYMB1,NR 00000609 / CMP000 NR,0 00000610 / BE L0201 00000611 / SETVAL JANI1,0,(+,JANI1,0,+,1,0,) 00000612 SETVAL CODE,0,(+,X'100',0,) 00000613 B XSNAME1 00000614 L0201 PSARAY1 V$NAME,SYMB1,NR 00000615 / CMP000 NR,0 00000616 / BE L0202 00000617 / SETVAL JDVF1,0,(+,JDVF1,0,+,64,0,) 00000618 / SETVAL CODE,0,(+,X'200',0,) 00000619 B XSNAME1 00000620 L0202 PSARAY1 F$NAME,SYMB1,NR 00000621 SET000 CODE,0 FOR CASE IF QUANT IS NOT FOUND. 00000622 / CMP000 NR,0 00000623 BE XSNAME1 00000624 / SETVAL JDVF1,0,(+,JDVF1,0,+,1,0,) 00000625 / SETVAL CODE,0,(+,X'600',0,) 00000626 B XSNAME1 00000627 *** CASE OF A NUMBER APPEARING AS FU ARG,VECT INDEX OR IN COMMAND */ 00000628 /SO167 CMP000 IMINUS,0 00000629 / BNH L0204 00000630 / SETVAL NRFIX,0,(-,NRFIX,0,) 00000631 /L0204 SETVAL JANI1,0,(+,JANI1,0,+,64,0,) 00000632 / SET111 IMINUS,0 00000633 / SETVAL CODE,0,(+,X'700',0,) 00000634 SR 1,1 NR=MOD(NRFIX,128) 00000635 IC 1,NRFIX+3 00000636 ST 1,NR 00000637 SNAME1 EPI 00000638 FFOUT 5,'IN2' 00000639 LTORG 00000640 *** 00000641 FREEZE PRO 00000642 PSEAR1 00000643 PLEZE1 00000644 DOLOOP J,1,NXEX,1,L0306,FOS18 00000645 CMPNAM X$NAME,J,SYMB1,0,EQ,FRE2 00000646 ENDDO L0306,+1 00000647 B FOS18 00000648 FRE2 CMPBIT X$PROP,J,COMON,OFF,FOS18 00000649 CMPBIT X$PROP,J,NINDX,OFF,FOS18 00000650 CMPBIT X$PROP,J,FREZE,ON,XFREEZE 00000651 SETVAL LOC5,0,(+,X$LOCNR,J,) 00000652 CMP000 LOC5,0,EQ,FOS18 00000653 CMPBIT L$PROP,LOC5,TAPE,OFF,XFREEZE 00000654 *** TEMPORARY FIX 00000655 *** FREEZE NOT YET BUILT IN. MUST BE A NO-OPERATION, AS AN ERROR 00000656 *** MESSAGE LEADS TO RESET OF ALL TAPE NUMBERS. 00000657 SETBIT X$PROP,J,FREZE,ON 00000658 B XFREEZE 00000659 FOS18 ERROR 6,' ILLEGAL FREEZE REQUEST' 00000660 FREEZE EPI 00000661 FFOUT 6,'FREEZE' 00000662 LTORG 00000663 *** 00000664 WRCOM1 PRO 00000665 CMP000 AZ,0,EQ,L0300 00000666 SET000 NCONT,8 00000667 ABEND 1001 00000668 B *-4 00000669 /L0300 SETVAL NTAP4,0,(+,5,0,) 00000670 / SET000 K4,0 00000671 SETADR START,0,(+,BUFV1,1,) 00000672 SETADR KV,0,(+,B$0VECTS,START,) 00000673 / PTAKMAN NTAP4,DUMMM,DUMMM,WEOFR0 00000674 / DOLOOP J,1,NXEX,1,L0301,L0302 00000675 / CMPBIT X$PROP,J,COMON,OFF,WRI2 DO NOT KEEP 00000676 SETVAL LOC5,0,(+,X$LOCNR,J,) 00000677 CMP000 LOC5,0,EQ,WRI1A 00000678 CMP000 L$RCNAM,LOC5,NE,WRI1B 00000679 /WRI1A CMPBIT X$PROP,J,NINDX,ON,WRI1B EMPTY FILE 00000680 / CMP000 X$INDEX,J,NE,WRI2 00000681 *** NON INDEXED EMPTY FILES AND EMPTY FILES WITH INDEX=0 ARE KEPT 00000682 *** FOR THE CASE THEY ARE LATER DEFINED. 00000683 WRI1B SETNAM T$TNAME,KV,X$NAME,J INSCRIBE FILE IN NAMELIST 00000684 SETVAL T$TPROP,KV,(+,X$PROP,J,) 00000685 SETVAL T$TINDEX,KV,(+,X$INDEX,J,) 00000686 SETVAL T$TRCNAM,KV,(+,L$RCNAM,LOC5,) 00000687 SETVAL T$TRCTOT,KV,(+,L$RCTOT,LOC5,) 00000688 SETVAL T$TLPROP,KV,(+,L$PROP,LOC5,) 00000689 SETVAL KV,0,(+,KV,0,+,NEXTC,0,) 00000690 WRI2 ENDDO L0301,+1 00000691 /L0302 PWBUFV1 1 00000692 SETADR KV,0,(+,B$0VECTS,START,) 00000693 SETVAL B$0WORD,KV,(-,1,0,) THIS RECORD SERVES AS AN EOF 00000694 SETVAL KV,0,(+,KV,0,+,NEXTW,0,) WRITING IT ON TAP7 RETURNS 00000695 / SETVAL NTAP4,0,(+,NTAP7,0,) RECORD NR IN BUFV1(1) */ 00000696 / PWBUFV1 1 00000697 / SETVAL NTAP5,0,(+,NTAP7,0,) 00000698 / SETVAL NTAP7,0,(+,5,0,) 00000699 SETADR START,0,(+,BUFV1,1,) 00000700 SETVAL NREC,0,(+,B$0RECOR,START,) 00000701 PCOPY1 NREC,NTAP5 COPY TAP7 TO TAP5 00000702 / SETVAL NTAP7,0,(+,NTAP5,0,) 00000703 / SETVAL NTAP5,0,(+,5,0,) 00000704 / SETVAL NTAP4,0,(+,4,0,) 00000705 WRCOM1 EPI 00000706 ** 00000707 *** ENTER COMMON . COMMON FILES ARE COPIED FROM NTAP5 TO NTAP7. 00000708 *** AN NXGEH AND LOC ARE CREATED FOR THEM. 00000709 ENCOM1 PRO 00000710 / SETVAL NTAP7,0,(+,5,0,) 00000711 / PTAKMAN NTAP7,DUMMM,DUMMM,REW0 00000712 SETADR START,0,(+,BUFI1,1,) 00000713 PTAKMAN NTAP7,START,END5,READ0 00000714 CMPVAL END5,0,(+,VECTS+3*NEXTW,0,),LE,XENCOM1 EMPTY FILE 00000715 *** THE EOF MARK IS -1,0,0 00000716 SETADR II5,0,(+,B$0VECTS,START,) 00000717 SETVAL K,0,(+,II5,0,+,END5,0,-,NEXTC+2*NEXTW,0,) 00000718 *** DO NOT COUNT TERMINATING 0,0 00000719 DOLOOP KV,II5,K,NEXTC,L0304,L0305 00000720 / SETVAL NXEX,0,(+,NXEX,0,+,1,0,) 00000721 SETNAM X$NAME,NXEX,T$TNAME,KV 00000722 SETVAL X$INDEX,NXEX,(+,T$TINDEX,KV,) 00000723 SETVAL X$PROP,NXEX,(+,T$TPROP,KV,) 00000724 CMP000 T$TRCNAM,KV,EQ,L0303 00000725 SETVAL L$RCNAM,MBU,(+,T$TRCNAM,KV,) 00000726 SETVAL L$RCTOT,MBU,(+,T$TRCTOT,KV,) 00000727 SETVAL L$PROP,MBU,(+,T$TLPROP,KV,) 00000728 / SETVAL X$LOCNR,NXEX,(+,MBU,0,) 00000729 / SETVAL MBU,0,(+,MBU,0,+,1,0,) 00000730 L0303 ENDDO L0304,+1 00000731 /L0305 SETVAL MTAB,9,(+,MBU,0,) 00000732 / SETVAL MTAB,10,(+,MBU,0,) 00000733 / SETVAL MTAB,11,(+,MBU,0,) 00000734 / SETVAL MTAB,18,(+,NXEX,0,) 00000735 / SETVAL NTAP4,0,(+,4,0,) 00000736 / SETVAL NTAP5,0,(+,5,0,) 00000737 / SETVAL NTAP6,0,(+,6,0,) 00000738 / SETVAL NTAP7,0,(+,7,0,) 00000739 / PCOPY1 -1,NTAP5 COPY WITHOUT PRIOR REWINDING TAP5*/ 00000740 ENCOM1 EPI WITHOUT KNOWING NR OF RECORDS */ 00000741 ** 00000742 RBUFI1 PRO READ RECORD K7 00000743 / PTAKMAN NTAP7,START,KI,K7 00000744 / SETVAL K7,0,(+,K7,0,+,1,0,) 00000745 / SETVAL KI,0,(+,START,0,+,VECTS,0,) 00000746 RBUFI1 EPI 00000747 WBUFV1 PRO END5 END5=+1 OR -1 00000748 SET000 B$0WORD,KV 00000749 SETVAL KV,0,(+,KV,0,+,NEXTW,0,) 00000750 / CMP111 END5,0,NE,L0046 00000751 SET000 B$0WORD,KV 00000752 / B L0047 00000753 L0046 SETVAL B$0WORD,KV,(-,1,0,) 00000754 L0047 SETADR START,0,(+,BUFV1,1,) 00000755 SETVAL KV,0,(+,KV,0,-,START,0,-,VECTS-NEXTW,0,) 00000756 / PTAKMAN NTAP4,START,KV,WRITE0 00000757 SETVAL KV,0,(+,START,0,+,VECTS,0,) 00000758 / SETVAL K4,0,(+,K4,0,+,1,0,) 00000759 WBUFV1 EPI 00000760 WBUFA1 PRO END5 END5=0 OR +1 OR -1 00000761 SET000 B$0WORD,KA 00000762 SETVAL KA,0,(+,KA,0,+,NEXTW,0,) 00000763 SETVAL B$0WORD,KA,(+,END5,0,) 00000764 SETADR START,0,(+,BUFI1,1,) 00000765 SETADR START,0,(+,BUFA1,1,) 00000766 SETVAL KA,0,(+,KA,0,-,START,0,-,VECTS-NEXTW,0,) 00000767 / PTAKMAN NTAP5,START,KA,WRITE0 00000768 / SETVAL K5,0,(+,K5,0,+,1,0,) 00000769 SETVAL KA,0,(+,START,0,+,VECTS,0,) 00000770 WBUFA1 EPI 00000771 *** COPY NTAP ONTO NTAP7 */ 00000772 *** IF NREC >= 0 THEN REWIND NTAP AND COPY NREC RECORDS. */ 00000773 *** ELSE COPY TILL (-1,0) IS SEEN */ 00000774 COPY1 PRO NREC,ITAP4 00000775 CMP000 NREC,0,LT,XCOPY1 00000776 / PTAKMAN ITAP4,DUMMM,DUMMM,WEOFR0 00000777 SETADR START,0,(+,BUFI1,1,) 00000778 /COP1 CMP000 NREC,0,EQ,XCOPY1 00000779 / SETVAL NREC,0,(+,NREC,0,-,1,0,) 00000780 / PTAKMAN ITAP4,START,KI,READ0 00000781 / CMP000 NREC,0,GE,COP3 00000782 CMPVAL B$0VECTS,START,(-,1,0,),NE,COP3 00000783 B XCOPY1 00000784 COP3 PTAKMAN NTAP7,START,KI,WRITE0 00000785 B COP1 00000786 COPY1 EPI 00000787 *** 00000788 &CBUF1 SETC 'IIEP' 00000789 ./MACRO UPDATM 00000790 ./MACRO CROSRM 00000791 ./MACRO INDCRM 00000792 UUPDAT EQU UPDAT 00000793 CCROSR EQU CROSR 00000794 *** 00000795 FFOUT 7,'UPDAT' 00000796 END 00000797 ./A KIJFPU,INCR=1 00000001 ./MACRO MAINMCRO 00000002 TITLE 'KIJFPU' 00000003 GBLC &OVLAY 00000004 &OVLAY SETC 'RONGCOM' 00000005 PRINT NOGEN 00000006 ./MACRO MAINCOM 00000007 RONGCOM DSECT 00000008 ARRAYS DC 7ZL4'0' 00000009 LISTNR1 DC 7ZL4'0' 00000010 LISTNR2 DC 7ZL4'0' 00000011 PROPS DC 7ZL4'0' 00000012 KIJFPU0 CSECT 00000013 EQUIVAL 00000014 EXTRN LIJN,NUM1 00000015 ENTRY KIJFPU 00000016 ENTRY NCONF,CONFU$N 00000017 USING BLANK,11 00000018 KIJFPU PRO 00000019 L 10,=V(RONGCOM) 00000020 USING RONGCOM,10 00000021 SET000 ILK,0 00000022 CMP000 NCONT,1 00000023 BNE L0001 00000024 CMP000 NCONT,4 00000025 BE L0002 00000026 L0001 SET111 ILK,0 00000027 L0002 SET000 NCONF,0 00000028 L 15,=A(INNAM) 00000029 BALR 14,15 00000030 SET000 TYPE,0 00000031 LL005 SETVAL TYPE,0,(+,TYPE,0,+,1,0,) 00000032 CMPVAL TYPE,0,(+,5,0,) 00000033 BH GENOEG 00000034 LOAD 7,ARRAYS,TYPE 00000035 SET000 NR,0 00000036 LL002 SETVAL NR,0,(+,NR,0,+,1,0,) 00000037 LOAD 1,LISTNR2,TYPE 00000038 L 2,0(1) 00000039 C 2,NR 00000040 BL LL005 00000041 LA 7,5(7) 00000042 SETVAL J,0,(+,TYPE,0,) 00000043 LL003 SETVAL J,0,(+,J,0,+,1,0,) 00000044 CMPVAL J,0,(+,5,0,) 00000045 BH LL002 00000046 LOAD 8,ARRAYS,J 00000047 SET000 K,0 00000048 LL004 SETVAL K,0,(+,K,0,+,1,0,) 00000049 LOAD 1,LISTNR2,J 00000050 L 2,0(1) 00000051 C 2,K 00000052 BL LL003 00000053 LA 8,5(8) 00000054 CLC 0(5,7),0(8) 00000055 BNE LL004 00000056 SETVAL NCONF,0,(+,NCONF,0,+,1,0,) 00000057 LADR 3,CONFU$N,NCONF 00000058 MVC 0(5,3),0(7) 00000059 CMPVAL NCONF,0,(+,20,0,) 00000060 BL LL004 00000061 GENOEG SET000 TYPE,0 00000062 LOOP1 SETVAL TYPE,0,(+,TYPE,0,+,1,0,) 00000063 CMPVAL TYPE,0,(+,7,0,) 00000064 BH DONE1 00000065 LOAD 1,LISTNR2,TYPE 00000066 L 2,0(1) 00000067 ST 2,TOP 00000068 SETVAL NR,0,(+,LISTNR1,TYPE,) 00000069 CMPVAL TOP,0,(+,NR,0,) 00000070 BL LOOP1 00000071 SET000 CONTIN,0 00000072 LOOP2 SETVAL IBUF,4,(+,5,0,) 00000073 SET000 IBUF,10 00000074 SETCAR IBUF,9,C' ',4 00000075 L 15,=A(NAMLIST) 00000076 BALR 14,15 00000077 CMP000 CONTIN,0 00000078 BNE TWEE 00000079 SET111 CONTIN,0 00000080 SETVAL IBUF,1,(+,NTAP2,0,) 00000081 L 3,TYPE 00000082 M 2,=F'12' 00000083 LA 3,TEX-12(3) 00000084 CMP000 ISPLAY,0 00000085 BNE L0003 00000086 MVC IBUF+5*4(12),0(3) 00000087 SET000 IBUF,3 00000088 B L0004 00000089 L0003 MVI IBUF+32,C' ' 00000090 MVC IBUF+33(1),1(3) 00000091 SETVAL IBUF,3,(+,3,0,) STARTING POINT 00000092 L0004 CALLFTN LIJN 00000093 CMP000 ILK,0 00000094 BE HULP3 00000095 CMPVAL TYPE,0,(+,5,0,) 00000096 BNL HULP3 00000097 SETVAL IBUF,3,(+,3,0,) STARTING POINT 00000098 L 3,TYPE 00000099 M 2,=F'12' 00000100 LA 3,TEX-12(3) 00000101 MVC IBUF+32(1),1(3) 00000102 MVI IBUF+33,C' ' 00000103 CMP000 NCONT,1 00000104 BE L0005 00000105 SETVAL IBUF,1,(+,NTAP8,1,) 00000106 CALLFTN LIJN 00000107 L0005 CMP000 NCONT,4 00000108 BE HULP3 00000109 SETVAL IBUF,1,(+,NTAP3,0,) 00000110 CALLFTN LIJN 00000111 B HULP3 00000112 TWEE CMP000 ISPLAY,0 00000113 BNE L0006 00000114 SET000 IBUF,3 00000115 SETCAR IBUF,6,C' ',12 00000116 B L0007 00000117 L0006 SETVAL IBUF,3,(+,3,0,) 00000118 L0007 SETVAL IBUF,1,(+,NTAP2,0,) 00000119 CALLFTN LIJN 00000120 CMP000 ILK,0 00000121 BE HULP3 00000122 CMPVAL TYPE,0,(+,5,0,) 00000123 BNL HULP3 CONFUSED,BRACKETS,EXPR NOT WRITTEN ONTO TAPE 00000124 SETVAL IBUF,3,(+,3,0,) 00000125 CMP000 NCONT,1 00000126 BE L0008 00000127 SETVAL IBUF,1,(+,NTAP8,0,) 00000128 CALLFTN LIJN 00000129 L0008 CMP000 NCONT,4 00000130 BE HULP3 00000131 SETVAL IBUF,1,(+,NTAP3,0,) 00000132 CALLFTN LIJN 00000133 HULP3 CMPVAL TOP,0,(+,NR,0,) 00000134 BNL LOOP2 00000135 B LOOP1 00000136 DONE1 CMP000 NCONT,4 00000137 BE EXI1 00000138 SETVAL IBUF,1,(+,NTAP3,0,) 00000139 SET000 IBUF,3 00000140 SETVAL IBUF,4,(+,3,0,) 00000141 SETCAR IBUF,6,C'TAPE START ',12 00000142 CALLFTN LIJN 00000143 EXI1 DOLOOP J,1,NVIND,1,L0009,XKIJFPU 00000144 CMPBIT I$PROP,J,CREAT,ON 00000145 BZ L0010 00000146 SETCAR I$NAME,J,X'0000000000',5 00000147 L0010 BXLE 7,8,L0009 00000148 KIJFPU EPI 00000149 *** 00000150 NAMLIST PRO 00000151 NEXT1 ST 0,NAME2 00000152 ST 0,NAME2+4 00000153 ST 0,NAME3 00000154 ST 0,NAME3+4 00000155 ST 0,NAME1+4 00000156 ST 0,TERMIN 00000157 ST 0,TERMIN+4 00000158 CMPVAL TYPE,0,(+,6,0,) 00000159 BNE L0011 00000160 LADR 1,MBR$N,NR 00000161 MVC NAME1(8),0(1) 00000162 B NEXT2 00000163 L0011 LOAD 1,ARRAYS,TYPE 00000164 L 3,NR 00000165 M 2,=F'5' 00000166 AR 1,3 00000167 MVC NAME1(5),0(1) 00000168 CMPVAL TYPE,0,(+,5,0,) 00000169 BNE N2 00000170 CMPBIT X$PROP,NR,FILE,OFF 00000171 BZ L0012 00000172 CMPBIT X$PROP,NR,FREZE,ON 00000173 BO NEXT3 00000174 CMPBIT X$PROP,NR,NINDX,ON 00000175 BO NEXT2 00000176 CMP000 X$LOCNR,NR 00000177 BE NEXT2 UNUSED COMMON EXPRESSION 00000178 NEXT3 SETCAR NAME3$C,1,C')',1 00000179 SETCAR NAME2$C,1,C'(',1 00000180 SETVAL NUMB,0,(+,X$INDEX,NR,) 00000181 B CONV1 00000182 L0012 SETCAR NAME2$C,1,C'=',1 00000183 SETVAL NUMB,0,(+,X$DEPTH,NR,) 00000184 CONV1 L 1,NUMB 00000185 SR 2,2 00000186 L 15,=A(NUM1) 00000187 BALR 14,15 00000188 MVC NAME2$C+1(7),0(3) 00000189 B NEXT2 00000190 N2 CMPVAL TYPE,0,(+,2,0,) 00000191 BNE N3 00000192 LADR 1,I$PROP,NR 00000193 TM 0(1),X'1F' 00000194 BZ NEXT2 00000195 SETCAR NAME2$C,1,C'=',1 00000196 SR 2,2 00000197 IC 2,0(1) 00000198 SLL 2,28 00000199 SRL 2,28 00000200 TM 0(1),X'10' 00000201 BZ L0015 00000202 A 2,=X'000000E0' 00000203 C 2,=X'000000E9' 00000204 BNH L0016 00000205 S 2,=X'00000015' CONVERTS X'EA' TILL X'EE' INTO N TILL R 00000206 L0016 STC 2,NAME2+1 00000207 B NEXT2 00000208 L0015 ST 2,NUMB NUMBER 00000209 B CONV1 00000210 N3 LOAD 1,PROPS,TYPE 00000211 A 1,NR 00000212 TM 0(1),REAL 00000213 BZ NEXT2 00000214 SETCAR NAME2$C,1,C'=',1 00000215 TM 0(1),UNDEF 00000216 BO L0017 00000217 TM 0(1),COMP 00000218 BO L0018 00000219 LA 2,C'I' 00000220 B L0019 00000221 L0017 LA 2,C'U' 00000222 B L0019 00000223 L0018 LA 2,C'C' 00000224 L0019 STC 2,NAME2+1 00000225 NEXT2 SETCAR TERMIN,0,C'.',1 00000226 CMPVAL NR,0,(+,TOP,0,) 00000227 BNL L0020 00000228 SETCAR TERMIN,0,C', ',2 00000229 L0020 LA 15,JOIN 00000230 LA 1,NAME1 00000231 BALR 14,15 00000232 LA 1,NAME2 00000233 BALR 14,15 00000234 LA 1,NAME3 00000235 BALR 14,15 00000236 LA 1,TERMIN 00000237 BALR 14,15 00000238 SETVAL NR,0,(+,NR,0,+,1,0,) 00000239 CMPVAL NR,0,(+,TOP,0,) 00000240 BH XNAMLIST 00000241 CMPVAL IBUF,4,(+,20,0,) 00000242 BL NEXT1 00000243 B XNAMLIST 00000244 JOIN SETVAL K,0,(+,IBUF,4,+,6,0,) 00000245 LADR 2,IBUF,K 00000246 L0021 SR 2,6 00000247 TM 0(2),X'FF' 00000248 BZ L0021 00000249 MVC 1(8,2),0(1) 00000250 MVC 9(4,2),=X'00000000' 00000251 LA 3,IBUF+7 00000252 SR 2,3 00000253 SRA 2,2 00000254 STORE 2,IBUF,4 00000255 BR 14 00000256 NAMLIST EPI 00000257 *** 00000258 ./MACRO INNAMM 00000259 *** 00000260 CONTIN DC 1FL4'0' 00000261 COUNT DC 1FL4'0' 00000262 ILK DC 1FL4'0' 00000263 J DC 1FL4'0' 00000264 K DC 1FL4'0' 00000265 NAME5 DC 0FL8'0' 00000266 NAME5$C DC 0FL1'0' 00000267 NAME1 DC 0FL8'0' 00000268 NAME1$C DC 8FL1'0' 00000269 NAME2 DC 0FL8'0' 00000270 NAME2$C DC 8FL1'0' 00000271 NAME3 DC 0FL8'0' 00000272 NAME3$C DC 8FL1'0' 00000273 NCONF DC 1FL4'0' 00000274 NR DC 1FL4'0' 00000275 NUMB DC 1FL4'0' 00000276 TERMIN DC 2FL4'0' 00000277 TOP DC 1FL4'0' 00000278 TYPE DC 1FL4'0' 00000279 TEX DC C'0SYMBOLS 0INDICES 0VECTORS 0FUNCTIONS ' 00000280 DC C'0EXPR. 0BRACKETS 0CONFUSED ' 00000281 CONFU$N DC 20FL5'0' 00000282 END 00000283 ./A LEES,INCR=1 00000001 ./MACRO MAINMCRO 00000002 ./MACRO INMACRO 00000003 TITLE 'LEES' 00000004 GBLC &OVLAY 00000005 PRINT NOGEN 00000006 ./MACRO INCOM 00000007 ./MACRO MAINCOM 00000008 LEES CSECT 00000009 EQUIVAL 00000010 ENTRY LEZE1,FOUTP 00000011 EXTRN BREAK,INP,DLIST1,CVTIN,UNCF,GETAL,SAMEN,FOUT,LIJN 00000012 USING INCOM,10 00000013 USING BLANK,11 00000014 LEZE1 PRO 00000015 / SETVAL SLASH1,0,(+,SLASH2,0,) 00000016 / SET000 SLASH2,0 00000017 / SET000 EXPOFL1,0 00000018 / SET000 IMINUS,0 FLAGS MINUS SIGN */ 00000019 /LE1 SET000 NRFLAG1,0 COME FROM ARG3 */ 00000020 / SETVAL MMBU,0,(+,MBU,0,) 00000021 / SET000 NBLAN1,0 00000022 / SET000 LDA3,0 FLAGS BRACKETS IN **(-K) */ 00000023 SETCAR SYMB1,0,X'0000000000',5 00000024 SETCAR SYMB2,0,X'0000000000',5 00000025 SETCAR SYMB3,0,X'0000000000',5 00000026 / SET000 IAL,0 00000027 SET000 IAL3,0 00000028 /NEXT1 CMP000 CREATBR,0 00000029 / BNH L0001 00000030 / SETVAL NHAK,0,(+,NHAK,0,-,1,0,) 00000031 / SET000 CREATBR,0 00000032 / B L0002 00000033 /L0001 SETVAL NI,0,(+,NI,0,+,1,0,) 00000034 /L0002 CMPVAL NI,0,(+,72,0,) 00000035 / BNH LE31 JP IF NO NEW CARD NEEDED */ 00000036 *** LE3 COMES FROM LE17 */ 00000037 /LE3 CMP000 RCUR1,0 00000038 / BNE L0003 00000039 / CMP000 NTAP1,0 00000040 / BNL LE5 00000041 L 15,=A(INP) READ FROM INPUT 00000042 BALR 14,15 00000043 / B LE15 00000044 /L0003 CMP000 LEESPT,0 00000045 / BE L0004 00000046 L 15,=A(BREAK) TAKE NEXT PART OF 00000047 BALR 14,15 00000048 / SET000 NI,0 SAME BLOCK ARG */ 00000049 / B NEXT1 00000050 L0004 SETVAL NI,0,(+,T$9NI,RCUR1,) 00000051 / SETVAL RCUR2,0,(+,RCUR1,0,) END OF BLOCK ARGUMENT */ 00000052 / SET000 RCUR1,0 GO BACK TO ORIGINAL CARD */ 00000053 CMPVAL MNSUBS,0,(+,NSUBS,0,) MNSUBS=MAX(MNSUBS,NSUBS 00000054 BNL LL001 00000055 SETVAL MNSUBS,0,(+,NSUBS,0,) 00000056 LL001 LADR 7,A,1 00000057 LADR 8,T$9CHAR,RCUR2 00000058 MVC 0(80,7),0(8) 00000059 B NEXT1 00000060 LE5 L 15,=A(INPP) READ FROM IEP INTO A 00000061 BALR 14,15 00000062 / CMPCAR A,1,C'$',1 00000063 / BNE L0007 00000064 SETVAL BLOKPT$B,0,(+,A1$BLOK,0,) 00000065 SETVAL DOLST1,0,(+,A1$DO,0,) 00000066 SET000 A1$BLOK,0 00000067 SET000 A1$DO,0 00000068 /L0007 CMP000 NCONT,5 00000069 / BE LE15 PRINT BRACKETS */ 00000070 CMPCAR A,1,C'$',1 00000071 BE LE7 00000072 CMPCAR A,1,C' ',1 00000073 BNE LE15 00000074 CMPCAR A,2,X'77',1 00000075 / BE LE15 DUMMY CARD */ 00000076 /LE7 PUIT2 80 PRINT DO0S 00000077 /LE15 CMP000 NORDER,0 00000078 / BH EXIT2 00000079 / SET111 NI,0 00000080 / CMPCAR A,1,C' ',1 00000081 / BE NEXT1 00000082 / CMP000 NHAK,0 00000083 / BNE LFO2 BRACKET UNCHECK */ 00000084 CMPCAR A,1,C'$',1 00000085 / BE LE21 00000086 *** CASE OF END OF STATEMENT OR END OF IEP INPUT */ 00000087 / CMP000 IDO3,0 00000088 / BE LE21 00000089 / CMP000 IDO2,0 00000090 / BE LE19 00000091 PINOUT A,A1$DO,A1$BLOK COPY LAST INPUT CARD TO IEP 00000092 L 15,=A(REW) 00000093 BALR 14,15 00000094 / CMP000 ITA1,1 00000095 / BNE L0010 00000096 / SETVAL ITA1,1,(+,NTAP1,0,) 00000097 / SETVAL BLOKP1$B,0,(+,BLOKPT$B,0,) 00000098 / SETVAL BLOKP1$L,0,(+,BLOKPT$L,0,) 00000099 / SETVAL NSUB1,0,(+,NSUBS,0,) 00000100 /L0010 SETVAL KTA1,1,(+,ITA1,4,) 00000101 / SETVAL KTA1,2,(+,ITA1,3,) 00000102 / SETVAL NTAP1,0,(+,ITA1,3,) 00000103 / SET000 IDO2,0 00000104 / SETVAL LEVCH,0,(+,LEVCH,0,+,1,0,) 00000105 / SETVAL LEVCL,0,(+,LEVCH,0,) 00000106 / B LE3 00000107 /LE19 SET000 IDO1,0 ALL SUBEXPR ANALYZED */ 00000108 / SET000 IDO2,0 INITIALIZE */ 00000109 / SET000 IDO3,0 00000110 LADR 1,IIEP,1 INITIALIZE ABSOLUTE ADDRESSES 00000111 ST 1,IEPHIGH 00000112 ST 1,IEPLOW 00000113 ST 1,TAPMA1 00000114 / SETVAL NTAP1,0,(+,ITA1,1,) 00000115 / SET000 KTA1,1 00000116 / SETVAL KTA1,2,(-,2,0,) 00000117 / SET000 ITA1,1 00000118 / SET000 DOLST1,0 00000119 / SET000 RCUR1,0 00000120 / SETVAL BLOKPT$B,0,(+,BLOKP1$B,0,) 00000121 / SETVAL BLOKPT$L,0,(+,BLOKP1$L,0,) 00000122 CMPVAL MNSUBS,0,(+,NSUBS,0,) MNSUBS=MAX(MNSUBS,NSUBS 00000123 BNL LL002 00000124 SETVAL MNSUBS,0,(+,NSUBS,0,) 00000125 /LL002 SETVAL NSUBS,0,(+,NSUB1,0,) 00000126 /LE21 SET000 WW1,0 INITIALIZE FOR ANALYZING DO0 CARD */ 00000127 / SET111 NBLAN1,0 00000128 / B EXIT1 00000129 /LE23 CMPCAR A,NI,C'(',1 00000130 / BE LE25 00000131 / CMPCAR A,NI,X'77',1 00000132 / BE LFO2 BRACKET UNCHECK */ 00000133 / SETVAL NHAK5,0,(-,1,0,) X2 */ 00000134 / CMPCAR A,NI,C')',1 00000135 / BE LE27 00000136 / SET000 NHAK5,0 00000137 / CMPCAR A,NI,C',',1 00000138 / BNE LE25 00000139 / CMP000 CREATBR,0 00000140 / BE LE25 00000141 / CMPVAL NHAK,0,(+,NHAK1,0,) 00000142 / BNE LE25 00000143 ** /* CASE OF INTEG() AROUND FU ARG. ADD ). * 00000144 / SET000 CREATBR,0 00000145 / SETVAL NI,0,(+,NI,0,-,2,0,) 00000146 SETVAL K,0,(+,NI,0,+,1,0,) 00000147 SETCAR A,K,C')',1 00000148 / B NEXT1 00000149 /LE25 SETVAL LDA2,0,(+,LDA2,0,+,1,0,) 00000150 *** LDA2 COUNTS CHARS IN IPR1. CARD IMAGE OF EXPR. IN BRACKETS */ 00000151 SETVAL IPR1$C,LDA2,(+,A,NI,) 00000152 / SETVAL NHAK,0,(+,NHAK,0,+,NHAK5,0,) 00000153 / CMPVAL LDA2,0,(+,72,0,) 00000154 / BL NEXT1 00000155 / PINOUT IPR1$C,IPR1$D,IPR1$B COPY IPR1 TO IEP 00000156 SETCAR IPR1$C,1,C' ',1 CONTINUATION CARD 00000157 / SET111 LDA2,0 00000158 / B NEXT1 00000159 /LE27 CMPVAL NHAK,0,(+,NHAK1,0,) 00000160 / BNE LE25 00000161 / CMP000 CREATBR,0 00000162 / BE L0011 00000163 / SETVAL NI,0,(+,NI,0,-,1,0,) 00000164 / SET000 CREATBR,0 00000165 L0011 SETVAL LDA2,0,(+,LDA2,0,+,1,0,) TERMINATE DOLLAR EXPRESSION 00000166 SETCAR IPR1$C,LDA2,C'=',1 00000167 SETVAL LDA2,0,(+,LDA2,0,+,1,0,) 00000168 DOLOOP J,LDA2,72,1,LL003,LL004 00000169 / SETCAR IPR1$C,J,C' ',1 00000170 BXLE 7,8,LL003 00000171 LL004 PINOUT IPR1$C,IPR1$D,IPR1$B COPY IPR1 TO IEP 00000172 SETCAR WW1,0,C'AAA',3 SHOULD NOT MATCH IN LE37 00000173 / SET000 IDO1,0 00000174 / B NEXT1 00000175 /LE31 CMPCAR A,NI,C' ',1 00000176 / BE NEXT1 00000177 / SET111 NHAK5,0 00000178 / CMP000 IDO1,0 00000179 / BNE LE23 00000180 / CMP000 EXPOFL1,0 00000181 / BE LE35 00000182 ** /* SKIPS BRACKETS IN A**(-3) */ 00000183 / CMPCAR A,NI,C'(',1 00000184 / BNE L0012 00000185 / SETVAL LDA3,0,(-,1,0,) 00000186 / B NEXT1 00000187 /L0012 CMPCAR A,NI,C')',1 00000188 / BNE LE35 00000189 / CMP000 LDA3,0 00000190 / BE LE35 00000191 / SET000 LDA3,0 00000192 / B NEXT1 00000193 /LE35 SETVAL BBA,0,(+,BBB,0,) 00000194 / SETVAL BBB,0,(+,A,NI,) 00000195 / CMP000 NORDER,0 00000196 / BNE L0013 00000197 / SETVAL NI,0,(+,101,0,) 00000198 / B NEXT1 00000199 ** /* WW1 HOLDS LAST 3 CHARS. LEFT ADJUSTED. ZERO FILL. */ 00000200 L0013 L 8,WW1 00000201 LOAD 9,A,NI 00000202 SRL 8,8 00000203 SLL 9,24 00000204 SLDL 8,16 00000205 ST 8,WW1 00000206 / SET111 NTEKEN,0 00000207 SETVAL NBIND,0,(+,A,NI,) 00000208 LE37 SETVAL WORD,0,(+,WW1,0,) COMPARE 3 CHARS 00000209 / CMPCAR WORD,0,C'**-',3 00000210 / BNE L0014 00000211 / SETVAL IMINUS,0,(-,1,0,) 00000212 / B NEXT1 00000213 /L0014 CMPCAR WORD,0,C'**+',3 00000214 / BE NEXT1 00000215 L 1,WORD 00000216 SLL 1,8 00000217 ST 1,WORD COMPARE 2 CHARS 00000218 / CMPCAR WORD,0,C'**',2 00000219 / BNE L0015 00000220 / SETVAL EXPOFL1,0,(-,1,0,) 00000221 / B NEXT1 00000222 /L0015 CMPCAR WORD,0,C'(+',2 00000223 / BE NEXT1 00000224 / CMPCAR WORD,0,C'(-',2 00000225 / BNE L0016 00000226 / SETVAL IMINUS,0,(-,1,0,) 00000227 / B NEXT1 00000228 /L0016 CMPCAR WORD,0,C'=+',2 00000229 / BE NEXT1 00000230 / CMPCAR WORD,0,C'=-',2 00000231 / BNE L0017 00000232 / SETVAL IMINUS,0,(-,1,0,) 00000233 / B NEXT1 00000234 *** CHECK IF THIS IS REALLY REQUIRED FOR GETAL. */ 00000235 /L0017 CMPCAR WORD,0,C'E+',2 00000236 / BNE L0020 00000237 / CMP000 NRFLAG1,0 00000238 BE L0020 00000239 / SETCAR BBB,0,C'P',1 00000240 / B LE59 00000241 /L0020 CMPCAR WORD,0,C'E-',2 00000242 / BNE L0021 00000243 / CMP000 NRFLAG1,0 00000244 BE L0021 00000245 / SETCAR BBB,0,C'M',1 00000246 / B LE59 00000247 /L0021 CMPCAR WORD,0,C',+',2 00000248 / BE NEXT1 00000249 / CMPCAR WORD,0,C',-',2 00000250 / BNE L0022 00000251 / SETVAL IMINUS,0,(-,1,0,) 00000252 / B NEXT1 00000253 /L0022 CMP000 NORDER,0 00000254 / BE LE59 00000255 L 1,WORD 00000256 SLL 1,8 00000257 ST 1,WORD COMPARE 1 CHARACTER. 00000258 / CMPCAR WORD,0,C')',1 00000259 / BNE L0023 00000260 / SETVAL NHAK,0,(+,NHAK,0,-,1,0,) 00000261 / B EXIT1 00000262 /L0023 CMP111 NORDER,0 00000263 / BE LE59 00000264 CMPCAR WORD,0,X'77',1 00000265 / BE EXIT1A 00000266 / CMPVAL NORDER,0,(+,2,0,) 00000267 / BE LE59 00000268 / CMPCAR WORD,0,C',',1 00000269 / BE EXIT1 00000270 / CMPVAL NORDER,0,(+,3,0,) 00000271 / BE LE59 00000272 / CMPCAR WORD,0,C'(',1 00000273 / BE LE57 00000274 / CMPVAL NORDER,0,(+,4,0,) 00000275 / BE LE59 00000276 / CMPCAR WORD,0,C'=',1 00000277 / BE EXIT1 00000278 / CMPVAL NORDER,0,(+,5,0,) 00000279 / BE LE59 00000280 / CMPCAR WORD,0,C'D',1 00000281 / BE LE55 00000282 / CMPVAL NORDER,0,(+,6,0,) 00000283 / BE LE59 00000284 / CMPCAR WORD,0,C'*',1 00000285 / BE EXIT1 00000286 / CMPVAL NORDER,0,(+,7,0,) 00000287 / BE LE59 00000288 / CMPCAR WORD,0,C'/',1 00000289 / BNE L0024 00000290 / SETVAL SLASH2,0,(-,1,0,) 00000291 / SETCAR NBIND,0,C'*',1 00000292 / B EXIT1 00000293 /L0024 CMPVAL NORDER,0,(+,8,0,) 00000294 / BE LE59 00000295 / CMPCAR WORD,0,C'+',1 00000296 / BE EXIT1 00000297 / CMPVAL NORDER,0,(+,9,0,) 00000298 / BE LE59 00000299 / CMPCAR WORD,0,C'-',1 00000300 / BNE L0025 00000301 / SETVAL NTEKEN,0,(-,1,0,) 00000302 / B EXIT1 00000303 /L0025 CMPVAL NORDER,0,(+,10,0,) 00000304 / BE LE59 00000305 / CMPCAR WORD,0,C'.',1 00000306 / BE EXIT1 00000307 / B LE59 00000308 *** CASE OF A NAME WITH A 'D' IN IT. TRY BREAK INTO 2 VECTOR NAMES */ 00000309 /LE55 CMP000 IAL,0 00000310 / BE LE59 NO NAME BEFORE D */ 00000311 / CMPVAL IAL,0,(+,3,0,) 00000312 / BNL LE59 FIRST NAME TOO LONG */ 00000313 CMPCAR SYMB2,0,X'0000000000',5 00000314 / BNE LE59 SECOND D IN THE NAME */ 00000315 SETNAM SYMB2,0,SYMB1,0 00000316 SETCAR SYMB3,0,X'0000000000',5 00000317 SET000 IAL3,0 00000318 / B LE61 00000319 ** 00000320 /LE57 SETVAL NHAK,0,(+,NHAK,0,+,1,0,) CASE OF ( */ 00000321 / CMP000 NREP,0 00000322 / BNE EXIT1 00000323 ** /* DO NOT CREATE DO0 IN CASE OF R INPUT */ 00000324 / CMP000 IAL,0 00000325 / BNE EXIT1 CASE OF P(MU) */ 00000326 / SETVAL NHAK,0,(+,NHAK,0,-,1,0,) CASE OF DO0 EXPR */ 00000327 / SETVAL NHAK1,0,(+,NHAK,0,) 00000328 ** /* RECORD ITS DOLIST AND BLOKPT */ 00000329 / CMP000 DOLST1,0 00000330 / BE L0026 00000331 / SETVAL IPR1$D,1,(+,DOLST1,0,) 00000332 / B LE58 00000333 /L0026 CMP000 DOVLAG$B,0 00000334 / BNE L0027 00000335 / SET000 IPR1$D,1 00000336 / B LE58 00000337 /L0027 SETVAL IPR1$D,1,(+,NSUBS,0,) 00000338 / SETVAL K,0,(+,DOLIST,0,) 00000339 LE57A SETVAL L,0,(+,DOVLAG$B,0,+,K,0,) STRAIGHTEN DOLIST 00000340 SETNAM T$4NAM,NSUBS,T$3JNAM,L 00000341 SETVAL T$4VAL,NSUBS,(+,T$3JVAL,L,) 00000342 LADR 1,T$4NEXT4,NSUBS 00000343 ST 1,NSUBS 00000344 SETVAL K,0,(+,T$3DOJMP,L,) 00000345 LADR 1,T$4NEXT4,NSUBS 00000346 ST 1,NSUBS COPY LIST AT NSUBS 00000347 SETVAL K,0,(+,T$3DOJMP,L,) 00000348 CMPVAL K,0,(+,4,0,) TERMINATOR 00000349 / BNE LE57A 1 = TERMINATOR OF OLD LIST */ 00000350 / SETVAL T$0WORD,NSUBS,(-,1,0,) -1=NEW TERMINATOR */ 00000351 LADR 1,T$0NEXTW,NSUBS 00000352 ST 1,NSUBS 00000353 / CMPVAL NDIMU,0,(+,NSUBS,0,) 00000354 / BL LFO3 DO,BLOK ARGS TOO LONG*/ 00000355 *** LE58 TILL LE59 COULD AS WELL BE USED AS A SUBROUTINE. 00000356 ** /* FIRST DO0 CREATION FOR THAT STATEMENT */ 00000357 /LE58 CMP000 RCUR1,0,EQ,L0030 00000358 / SET000 IPR1$B,1 00000359 / B L0031 00000360 /L0030 SETVAL IPR1$B,1,(+,BLOKPT$B,0,) 00000361 L0031 SETVAL IDO4,0,(+,IDO4,0,-,1,0,) 00000362 SET000 ISCAL$M,IDO4 00000363 SET000 ISCAL$P,IDO4 00000364 SET000 ISCAL$S,IDO4 00000365 *** IDO4 COUNTS NR OF DOLLAR EXPRS DOWN IN BINARY. 127,126,... */ 00000366 *** CONVERSION OF IDO4 FROM OCTAL TO DISPLAY CODE */ 00000367 L 9,IDO4 CONVERT IDO4 TO OCTAL DISPLAY CODE 00000368 SLL 9,24 TO CONSTRUCT C'$0*.' 00000369 SR 8,8 00000370 SLDL 8,2 00000371 SLL 8,5 00000372 SLDL 8,3 00000373 SLL 8,5 00000374 SLDL 8,3 00000375 O 8,=X'5BF0F0F0' X'5B'=C'$' 00000376 ST 8,SYMB1 00000377 ST 0,SYMB1+4 00000378 STORE 8,IPR1$C,5 'F.' 00000379 STORE 8,BBB,0 'F.' 00000380 SRDL 8,8 00000381 STORE 8,IPR1$C,4 'F*' 00000382 STORE 8,BBA,0 'F*' 00000383 STORE 9,B,4 'F.' 00000384 SR 9,9 00000385 SRDL 8,8 00000386 STORE 8,IPR1$C,3 'F0' 00000387 STORE 9,B,3 'F*' 00000388 SR 9,9 00000389 SRDL 8,8 00000390 STORE 8,IPR1$C,2 C'$' 00000391 STORE 8,IPR1$C,1 C'$' 00000392 STORE 9,B,2 'F0' 00000393 SR 9,9 00000394 SRDL 8,8 00000395 STORE 9,B,1 C'$' 00000396 SETCAR IPR1$C,6,C'=',1 00000397 SETNAM SYMB3,0,SYMB1,0 00000398 / SETVAL IAL,0,(+,4,0,) 00000399 / SETVAL IAL3,0,(+,4,0,) 00000400 / SETVAL NCIND,0,(+,NCIND,0,-,1,0,) COUNTS SUBEXPRESSIONS */ 00000401 / SET111 IDO1,0 00000402 / SET111 IDO3,0 00000403 / SETVAL LDA2,0,(+,6,0,) NR OF CHARS IN IPR1 */ 00000404 / SETVAL ITA1,3,(+,KTA1,1,) 00000405 / SETVAL ITA1,4,(+,KTA1,2,) 00000406 / CMP000 IDO2,0 00000407 / BNE NEXT1 00000408 / SET111 IDO2,0 00000409 L 15,=A(REW) 00000410 BALR 14,15 00000411 / B NEXT1 00000412 ** 00000413 *** NORMAL CASE. THE CHAR IS NOT A SEPARATOR. IS ADDED TO SYMB1 */ 00000414 LE59 SETVAL IAL3,0,(+,IAL3,0,+,1,0,) 00000415 SETVAL SYMB3$C,IAL3,(+,BBB,0,) 00000416 LE61 SETVAL IAL,0,(+,IAL,0,+,1,0,) 00000417 SETVAL SYMB1$C,IAL,(+,BBB,0,) 00000418 / CMPVAL IAL,0,(+,29,0,) 00000419 / BH LFO1 TOO LONG */ 00000420 LOAD 1,BBB,0 00000421 SLL 1,24 00000422 STORE 1,B,IAL 00000423 / CMP111 IAL,0 00000424 / BNE NEXT1 JP IF NOT FIRST CHAR */ 00000425 ** /* DETERMINE IF QUANT IS NUMBER OR NAME */ 00000426 / CMPCAR BBB,0,C'.',1 00000427 / BNE L0032 00000428 / SET111 NRFLAG1,0 00000429 / B NEXT1 00000430 /L0032 CMPCAR BBB,0,C'0',1 00000431 / BL NEXT1 00000432 / CMPCAR BBB,0,C'9',1 00000433 / BH NEXT1 00000434 / SET111 NRFLAG1,0 00000435 / B NEXT1 00000436 ** 00000437 /EXIT1A SETVAL NI,0,(+,101,0,) END OF SYMBOL */ 00000438 / CMP000 NHAK,0 00000439 / BNE LFO2 BRACKET UNCHECK */ 00000440 EXIT1 L 15,=A(INSPECT) 00000441 BALR 14,15 00000442 CMP000 RESTART5,0 00000443 BNE LE1 00000444 /EXIT2 SETVAL EREXP1,2,(+,EREXP1,1,) CHECK IF QUANT**QUANT IS LEG 00000445 / SET000 EREXP1,1 00000446 / CMPVAL LEVCH,0,(+,40,0,) 00000447 / BH LFO8 TOO MANY SUBSTITUTIONS */ 00000448 B XLEZE1 00000449 LFO1 PSAMEN *+46,10,B 00000450 ERRORP 1,' TOO LONG ' 00000451 LFO2 ERRORP 1,' BRACKET UNCHECK' 00000452 LFO3 ERROR 1,' DO, BLOCK ARG. TOO LONG' 00000453 LFO8 ERROR 1,' TOO MANY SUBSTITUTIONS' 00000454 LEZE1 EPI 00000455 FFOUT 1,'LEES' 00000456 LTORG 00000457 *** 00000458 INSPECT PRO 00000459 SET000 RESTART5,0 00000460 / CMP000 LDA3,0 00000461 / BNE LFO4 /* EXPONENT MUST BE NR OR DUMMY */ 00000462 CMPCAR SYMB1,0,X'0000000000',5 00000463 BE XINSPECT 00000464 / CMP000 NRFLAG1,0 00000465 / BE LE73 00000466 LE71 SETCAR SYMB2,0,X'0000000000',5 CASE OF A NUMBER 00000467 LA 1,NRINVERS 00000468 LA 2,NRFLOAT 00000469 LA 3,NRFIX 00000470 LA 4,IAL 00000471 A 4,=X'80000000' TERMINATE ARGUMENT LIST 00000472 L 0,=A(GETAL) 00000473 L 15,=A(UNCF) 00000474 BALR 14,15 00000475 L 15,=A(END2) DEAL WITH POSSIBLE ENDBLOCK,ENDDO 00000476 BALR 14,15 00000477 B XINSPECT 00000478 /LE73 CMPVAL IAL,0,(+,10,0,) 00000479 / BNL LFO5 TOO LONG... */ 00000480 CMPCAR SYMB3$C,1,C'$',1 00000481 / BNE L0033 00000482 CMPVAL IAL,0,(+,4,0,) 00000483 BH LFO7 /* ILLEGAL CHARACTER. CASE OF (A+B)E*7 00000484 / B LE74 /* WOULD GENERATE SYMB3=$776E IAL=5 00000485 *** CHECK IF SYMBOL HAS TO BE REPLACED BY BLOCK ARG OR DO VARIABLE */ 00000486 /L0033 CMP000 RCUR1,0 00000487 / BNE ARG3 00000488 / CMP000 BLOKPT$B,0 00000489 / BE ARG3 00000490 / SETVAL K,0,(+,BLOKPT$B,0,) TRY BLOCK ARGMS */ 00000491 /ARG4A CMPVAL T$0WORD,K,(-,1,0,) 00000492 / BE ARG3 END OF LIST */ 00000493 / CMPNAM T$7DUMMY,K,SYMB1,0 00000494 BE ARG4 ARGM FOUND 00000495 LADR 1,T$7ARGM,K 00000496 ST 1,K 00000497 ** /* POSITION AT NEXT DUMMY ARGUMENT */ 00000498 ARG4B LADR 1,T$0NEXTW,K 00000499 / CMPCAR T$0CHARR,K,X'00',1 00000500 ST 1,K 00000501 BE ARG4A 00000502 B ARG4B 00000503 /ARG4 CMPCAR NBIND,0,C'(',1 00000504 / BNE L0034 00000505 / SETVAL NHAK,0,(+,NHAK,0,-,1,0,) 00000506 /L0034 CMPCAR NBIND,0,C')',1 00000507 / BNE L0035 00000508 / SETVAL NHAK,0,(+,NHAK,0,+,1,0,) 00000509 /L0035 SETVAL BIND1,0,(+,NBIND,0,) 00000510 LADR 1,T$7ARGM,K 00000511 ST 1,LEESPT BEGIN ARGM REPLACEMENT 00000512 / CMP000 RCUR2,0 00000513 / BNE L0036 00000514 / SETVAL K,0,(+,NSUBS,0,) 00000515 / SETVAL RCUR1,0,(+,NSUBS,0,) 00000516 SETVAL T$9END,NSUBS,(-,1,0,) TERMINATOR 00000517 LADR 1,T$9NEXT9,NSUBS 00000518 ST 1,NSUBS 00000519 / CMPVAL NSUBS,0,(+,NDIMU,0,) 00000520 / BH LFO9 /* DO,BLOCK ARG TOO LONG * 00000521 ** /* CREATE SAVEAREA FOR NI,A(80) * 00000522 / B L0037 00000523 /L0036 SETVAL RCUR1,0,(+,RCUR2,0,) 00000524 / SETVAL K,0,(+,RCUR2,0,) 00000525 L0037 LADR 7,A,1 00000526 LADR 8,T$9CHAR,K 00000527 MVC 0(80,8),0(7) 00000528 SETVAL T$9NI,K,(+,NI,0,) 00000529 / SETVAL NI,0,(+,81,0,) FORCE END OF CARD */ 00000530 SET111 RESTART5,0 PROVOKE RESTART TO LE1 RATHER THAN EXI 00000531 B XINSPECT 00000532 /ARG3 CMP000 DOLST1,0 00000533 / BNE LE72 TRY DO VARS */ 00000534 / CMP000 DOVLAG$B,0 00000535 / BE LE74 00000536 SETNAM NAME5,0,SYMB1,0 00000537 L 15,=A(DLIST1) 00000538 BALR 14,15 00000539 ST 2,VALUE5 00000540 ST 3,FOUND5 00000541 *** SCAN THRU LINKED LIST OF DO VARIABLES * 00000542 /LE76 CMP000 FOUND5,0 00000543 / BE LE74 00000544 / CMP000 VALUE5,0 00000545 / BNH L0042 00000546 / SETVAL VALUE5,0,(-,VALUE5,0,) 00000547 CMP000 IMINUS,0 00000548 / BNH L0077 00000549 SET000 IMINUS,0 00000550 B L0042 00000551 /L0077 SETVAL IMINUS,0,(-,1,0,) 00000552 /L0042 SET111 NRFLAG1,0 00000553 LA 1,VALUE5 CONVERT TO DISPLAY CODE 00000554 LA 2,DISPL5 00000555 L 15,=A(CVTIN) 00000556 BALR 14,15 DISPL5 IS RIGHT ADJ. BLANK FILL. 00000557 SET000 J,0 00000558 SET000 K,0 00000559 LE76A SETVAL J,0,(+,J,0,+,1,0,) 00000560 CMPCAR DISPL5,J,C' ',1 00000561 BE LE76A 00000562 SETVAL K,0,(+,K,0,+,1,0,) 00000563 LOAD 1,DISPL5,J 00000564 SLL 1,24 00000565 STORE 1,B,K 00000566 CMPVAL J,0,(+,8,0,) 00000567 BL LE76A 00000568 SETVAL IAL,0,(+,K,0,) 00000569 / B LE71 00000570 ** 00000571 *** SCAN THRU STRAIGHTENED LIST OF DO VARS. THIS OCCURS WHEN */ 00000572 *** DO0 EXPRS CONTAINING BLOCK ARGS WERE CREATED */ 00000573 /LE72 SETVAL K,0,(+,DOLST1,0,) 00000574 /LE72A CMPVAL T$0WORD,K,(-,1,0,) 00000575 / BNE L0044 00000576 / SET000 FOUND5,0 TERMINATOR */ 00000577 / B LE76 00000578 /L0044 CMPNAM T$4NAM,K,SYMB1,0 00000579 / BNE L0045 00000580 / SET111 FOUND5,0 00000581 / SETVAL VALUE5,0,(+,T$4VAL,K,) 00000582 / B LE76 00000583 L0045 LADR 1,T$3NEXT3,K 00000584 ST 1,K 00000585 / B LE72A 00000586 ** 00000587 *** ANALYZE NAME WITH A D IN IT. TRY TO SPLIT INTO 2 VECTORS. * 00000588 LE74 L 15,=A(END2) DEAL WITH POSSIBLE ENDBLOCK,ENDDO 00000589 BALR 14,15 00000590 CMPCAR SYMB3,0,X'0000000000',5 00000591 / BE LE75 /* NOTHING FOLLOWING D IS NO DOTPRODUCT * 00000592 CMPCAR SYMB2,0,X'0000000000',5 00000593 BE XINSPECT 00000594 CMPCAR B,2,C'D',1 00000595 / BNE LE97 00000596 CMPCAR B,3,C'D',1 00000597 / BNE LE95 00000598 / SET000 FLAG4,0 00000599 / PVECT1 SYMB2,FLAG4 SECOND AND 3RD LETTER ARE D */ 00000600 / SETVAL FLAG1,0,(+,FLAG4,0,) 00000601 / SET000 FLAG4,0 00000602 / PVECT1 SYMB3,FLAG4 00000603 / SETVAL FLAG2,0,(+,FLAG4,0,) 00000604 / CMP000 FLAG1,0 00000605 BNL LL005 00000606 CMP000 FLAG2,0 2 VECTORS 00000607 BL XINSPECT 00000608 /LL005 SET000 FLAG4,0 00000609 SETNAM SYMBOL,0,SYMB2,0 CASE OF ADDB 00000610 SETCAR SYMBOL$C,2,C'D',1 00000611 PVECT1 SYMBOL,FLAG4 TRY AD 00000612 / SETVAL FLAG3,0,(+,FLAG4,0,) 00000613 / SET000 SYMBOL,0 00000614 SETVAL SYMBOL$C,1,(+,SYMB3$C,2,) 00000615 SETVAL SYMBOL$C,2,(+,SYMB3$C,3,) 00000616 / SET000 FLAG4,0 00000617 PVECT1 SYMBOL,FLAG4 TRY DB 00000618 / CMP000 FLAG3,0 00000619 / BNL LE83 00000620 / CMP000 FLAG4,0 00000621 / BNL LE83 00000622 LE81 SETCAR SYMB2$C,2,C'D',1 BOTH MODIFIED SYMBOLS ARE VECTOR 00000623 SETVAL SYMB3$C,1,(+,SYMB3$C,2,) 00000624 SETVAL SYMB3$C,2,(+,SYMB3$C,3,) 00000625 B XINSPECT 00000626 /LE83 SETVAL FLAG1,0,(+,FLAG1,0,+,FLAG2,0,) FOR UNMODIFIED SYMBOL 00000627 / SETVAL FLAG3,0,(+,FLAG3,0,+,FLAG4,0,) FOR MODIFIED SYMBOLS 00000628 ** /* HIGH VALUE IMPLIES SUCCESSFUL SPLIT. * 00000629 / CMPVAL IAL,0,(+,5,0,) 00000630 BNL LE85 00000631 / CMP000 FLAG1,0 00000632 / BH LE85 00000633 / CMPVAL FLAG1,0,(+,FLAG3,0,) 00000634 / BL LE81 00000635 B XINSPECT 00000636 /LE85 CMP000 FLAG3,0 00000637 / BNH LE81 00000638 / B LE75 NOT ACCEPTED AS A DOTPRODUCT.*/ 00000639 /LE95 CMPVAL IAL,0,(+,5,0,) 00000640 / BNL LE75 2ND LETTER IS D. 3RD NOT */ 00000641 /LE97 SET000 FLAG4,0 2ND LETTER IS NOT D. */ 00000642 / PVECT1 SYMB2,FLAG4 00000643 / CMP000 FLAG4,0 00000644 / BH LE75 00000645 / SET000 FLAG4,0 00000646 / PVECT1 SYMB3,FLAG4 00000647 / CMP000 FLAG4,0 00000648 / BH LE75 00000649 B XINSPECT 00000650 LE75 SETCAR SYMB2,0,X'0000000000',5 NOT ACCEPTED AS DOTPRODUCT 00000651 B XINSPECT 00000652 LFO4 ERRORP 2,' EXPONENT MUST BE NR OR DUMMY' 00000653 LFO5 PSAMEN *+46,10,B 00000654 ERRORP 2,' TOO LONG. ' 00000655 LFO7 ERRORP 2,' ILLEGAL CHARACTER' 00000656 LFO9 ERROR 2,' DO, BLOCK ARGMS TOO LONG' 00000657 INSPECT EPI 00000658 FFOUT 2,'INSPECT' 00000659 LTORG 00000660 ** 00000661 *** TRY IF SYMBOL CAN BE ASSUMED AS VECTOR. FLAG4=1 IF SYMBOL=VECTOR. * 00000662 *** FLAG4=0 IF SYMBOL IS NOT YET USED. FLAG4=-3 IF USED FOR NONVECTOR * 00000663 *** LE89: PROCEDURE(SYMBOL,FLAG4) 00000664 VECT1 PRO 00000665 CLI 0(1),C'Z' 00000666 / BNH L0053 00000667 / SETVAL FLAG4,0,(-,3,0,) NOT ALPHABETIC * 00000668 B XVECT1 00000669 /L0053 PVECT2 V$NAME,NVECT,FLAG4,1,SYMBOL 00000670 C 0,FLAG4 00000671 BNE XVECT1 00000672 / PVECT2 S$NAME,NALGE,FLAG4,-3,SYMBOL 00000673 C 0,FLAG4 00000674 BNE XVECT1 00000675 / PVECT2 F$NAME,NFUN,FLAG4,-3,SYMBOL 00000676 C 0,FLAG4 00000677 BNE XVECT1 00000678 / PVECT2 I$NAME,NVIND,FLAG4,-3,SYMBOL 00000679 B XVECT1 00000680 *** LE91: PROCEDURE(ARRAY,NUMBER,FLAG4,FLAG5,SYMBOL); 00000681 DS 0H 00000682 VECT2 LR 8,9 00000683 SLA 9,2 00000684 AR 9,8 MULTIPLY BY 5 00000685 S 9,=F'5' 00000686 DOLOOP J,0,,5,L0051,L0052 00000687 LR 3,7 00000688 AR 3,2 00000689 CLC 0(5,3),0(1) 00000690 / BNE L0101 00000691 ST 4,FLAG4 00000692 / BR 14 00000693 /L0101 BXLE 7,8,L0051 00000694 /L0052 BR 14 00000695 VECT1 EPI 00000696 ** 00000697 *** IEPHIGH IS POINTER IN IEP WHEN ITA1(3) NE 0. HIGHER PART. */ 00000698 *** IEPLOW IS POINTER IN IEP WHEN ITA1(3) = 0. LOWER PART. */ 00000699 *** THERE IS A TEST ON LOWER PART NOT OVERWRITING HIGHER PART. * 00000700 *** PACK A SUBEXPRESSION (PER 72 CHARS) FROM ARRAY INTO IEP * 00000701 *** ARRAY CAN BE A OR IPR1 . 00000702 *** INOUT: PROCEDURE(ARRAY,ARRAY$DO,ARRAY$BLOK) ARGMS IN R7,R8,R9 00000703 DS 0H 00000704 USING *,15 00000705 /INOUT CMP000 ITA1,3 00000706 / BE L0054 00000707 / SETVAL IEPPT5,0,(+,IEPHIGH,0,) 00000708 L 1,IEPHIGH 00000709 LA 1,IEP$N-IEP(1) 00000710 ST 1,IEPHIGH 00000711 / B LE109 00000712 /L0054 SETVAL IEPPT5,0,(+,IEPLOW,0,) 00000713 L 1,IEPLOW 00000714 LA 1,IEP$N-IEP(1) 00000715 ST 1,IEPLOW 00000716 LADR 2,IIEP,1 00000717 S 2,IEPHIGH 00000718 / BE LE109 00000719 L 1,IEPLOW 00000720 LA 1,IEP$N-IEP(1) 00000721 ST 1,K 00000722 / CMPVAL IEPHIGH,0,(+,K,0,) 00000723 / BNH LFO6 /* NO OVERWRITING */ 00000724 LE109 LADR 2,IIEP,LIEP TOP OF IEP 00000725 S 2,IEPPT5 00000726 / BL LFO6 TOO MUCH INBETWEEN (())*/ 00000727 L 1,IEPPT5 00000728 USING IEP0,1 00000729 MVC IEP(72),0(7) 00000730 ST 8,IEP$D ARRAY.DO 00000731 ST 9,IEP$B ARRAY.BLOK 00000732 DROP 1 00000733 LA 1,IEP$N-IEP(1) 00000734 ST 1,IEPPT5 00000735 CMPVAL MNEPS,0,(+,IEPPT5,0,) 00000736 BNLR 14 00000737 SETVAL MNEPS,0,(+,IEPPT5,0,) 00000738 / BR 14 00000739 LFO6 ERROR 3,' TOO MUCH INBETWEEN (())' 00000740 DROP 15 00000741 FFOUT 3,'INOUT' 00000742 ** 00000743 *** UNPACK A SUBEXPRESSION (PER 72 CHARS) FROM IEP INTO A. * 00000744 *** INPP: PROCEDURE; 00000745 DS 0H 00000746 USING *,15 00000747 /INPP CMP000 NTAP1,0 00000748 / BNE L0057 00000749 / SETVAL IEPPT5,0,(+,IEPLOW,0,) 00000750 L 1,IEPLOW 00000751 LA 1,IEP$N-IEP(1) 00000752 ST 1,IEPLOW 00000753 / B L0060 00000754 /L0057 SETVAL IEPPT5,0,(+,IEPHIGH,0,) 00000755 L 1,IEPHIGH 00000756 LA 1,IEP$N-IEP(1) 00000757 ST 1,IEPHIGH 00000758 L0060 L 1,IEPPT5 00000759 USING IEP0,1 00000760 L 2,IEP$D 00000761 ST 2,A1$DO 00000762 L 2,IEP$B 00000763 ST 2,A1$BLOK 00000764 LADR 2,A,1 00000765 MVC 0(72,2),IEP 00000766 BR 14 00000767 DROP 1,15 00000768 ** 00000769 *** THIS SYSTEM OF STORING ASSUMES THAT SUBSEQUENT BRACKET EXPRS TAKE * 00000770 *** LESS AND LESS SPACE. * 00000771 *** AS A SAFETY, PLACE FOR 2 ADDITIONAL CARDS IS FORESEEN. 00000772 *** END OF STORING SUBEXPRESSIONS.PREPARE FOR READING THEM OUT AGAIN * 00000773 *** REW: PROCEDURE; 00000774 DS 0H 00000775 USING *,15 00000776 /REW CMP000 ITA1,3 00000777 / BNE L0063 00000778 / SETVAL TAPMA1,0,(+,IEPLOW,0,) 00000779 LADR 2,IIEP,1 00000780 ST 2,IEPLOW 00000781 / BR 14 00000782 L0063 L 1,TAPMA1 00000783 LA 1,IEP$N-IEP(1) 1 ADDITIONAL CARD 00000784 LA 1,IEP$N-IEP(1) 1 ADDITIONAL CARD 00000785 LA 1,20(1) MORE SAFETY 00000786 ST 1,IEPHIGH 00000787 / BR 14 00000788 DROP 15 00000789 ** 00000790 *** UIT2: PROCEDURE(LENG5); /* PRINT 1 LINE OF A */ 00000791 UIT2 PRO 00000792 MVC IPUNCH(148),IBUF SAVE BUFFER 00000793 SETVAL IBUF,6,(+,IBUF,5,) 1 BLANK WORD * 00000794 MVC IBUF+24(80),IBUF+23 SET BLANK 00000795 LPR 1,1 SAFETY . 0 LT R1 LT 80 00000796 LA 2,80 00000797 CR 1,2 00000798 BNH L0072 00000799 LR 1,2 00000800 L0072 SR 1,6 00000801 LADR 2,A,1 00000802 EX 1,COPY 00000803 SETVAL IBUF,1,(+,NTAP2,0,) 00000804 / CMP000 ISPLAY,0 00000805 / BNE L0070 00000806 / SETVAL IBUF,3,(-,1,0,) 00000807 / B L0071 00000808 /L0070 SET000 IBUF,3 00000809 L0071 SRA 1,2 NR OF WORDS USED=1+(LENG5-1)/NRCHARS 00000810 LA 1,2(1) TOP OF BUFFER 00000811 STORE 1,IBUF,4 00000812 CALLFTN LIJN 00000813 MVC IBUF(148),IPUNCH RESTORE BUFFER 00000814 UIT2 EPI 00000815 COPY MVC IBUF+24(1),0(2) 00000816 ** 00000817 DS 0H 00000818 USING *,15 00000819 /END2 CMP000 NTAP1,0 00000820 / BNLR 14 00000821 / CMP000 ENDB1$B,0 00000822 / BNE L0046 00000823 / SET000 DOLST1,0 00000824 / BR 14 00000825 /L0046 CMP000 ENDB1$B,0 00000826 / BNH L0047 00000827 / SET000 ENDB1$B,0 00000828 / SET000 DOLST1,0 00000829 / SET000 BLOKPT$B,0 00000830 / SET000 BLOKPT$L,0 00000831 / BR 14 00000832 /L0047 SETVAL BLOKPT$B,0,(+,ENDB1$B,0,) 00000833 / SETVAL BLOKPT$L,0,(+,ENDB1$L,0,) 00000834 / SET000 ENDB1$B,0 00000835 / SET000 ENDB1$L,0 00000836 / SET000 DOLST1,0 00000837 / BR 14 00000838 DROP 15 00000839 ** 00000840 FOUTP PROLOGH 00000841 CMPCAR A,1,X'77',1 00000842 BE XFOUTP 00000843 CMPCAR A,2,X'77',1 00000844 BE XFOUTP 00000845 / CMPVAL NI,0,(+,72,0,) 00000846 BNH LL006 00000847 / SETVAL NI,0,(+,72,0,) 00000848 LL006 PUIT2 NI 00000849 XFOUTP EPILOGH 00000850 SAVEFTN DS 18F 00000851 END 00000852 ./A LOVBUG,INCR=1 00000001 ./MACRO MAINMCRO 00000002 TITLE 'LOVBUG' 00000003 LCLA &TIME$,&INTEG$,&DISPL$ 00000004 ./MACRO MAINCOM 00000005 PRINT NOGEN 00000006 LOVBUG CSECT 00000007 ENTRY LOOK,FOUT,FOUTB,UNFC,UNCF,CVTIN,CVTFL,SNOEP,SECOND 00000008 ENTRY LOOKPR,NUM1 00000009 EXTRN LIJN 00000010 EQUIVAL 00000011 PRINT GEN 00000012 DS 0H 00000013 USING *,15 VALUE IS GIVEN BY CALLING PROGR 00000014 FOUT STM 0,13,REGSTOR ERROR OCCURED IN ASSEMBLER PROG 00000015 STD 0,SAVEFP SAVE FP. PRINT REGS 00000016 STD 2,SAVEFP+8 00000017 STD 4,SAVEFP+16 00000018 STD 6,SAVEFP+24 00000019 SLL 14,2 REMOVE ILC FROM PSW 00000020 SRL 14,2 00000021 ST 14,SAVEPSW 00000022 MVC REGSTOR+56(8),16(14) R14,R15 .MUST BE COPIED BEFORE OVL 00000023 MVC NAMSTOR(8),8(14) SWAP. NAME GIVEN IN FFOUT MACRO 00000024 L 11,=V(BLANK) 00000025 USING BLANK,11 00000026 L 1,0(14) 00000027 MVC IPUNCH+8(32),0(1) COPY ERRORMESSAGE 00000028 DROP 11,15 00000029 FOUTB BALR 12,0 ERROR OCCURED IN FTN PROGRAM 00000030 USING *,12 00000031 L 11,=V(BLANK) 00000032 USING BLANK,11 00000033 LA 6,1 00000034 ST 6,MFOUT 00000035 L 13,LAYNR 00000036 DROP 11,12 00000037 LM 2,12,28(13) EXECUTE APPROPRIATE EPILOGH OF OVERLAY 00000038 L 14,12(13) 00000039 MVI 12(13),X'FF' 00000040 BR 14 00000041 *** 00000042 EXTRN ORIGIN 00000043 LOAD EQU ORIGIN STARTING POINT OF LOAD MAP 00000044 ** THE STAR IN THE COMMENTS REFERS TO THE RETURN ADDRESS OF THE LOOK 00000045 ** MACRO, AS CONTAINED IN PSW. 00000046 DS 0H 00000047 USING *,15 VALUE IS GIVEN BY CALLING PROGR 00000048 LOOK STM 0,13,REGSTOR 00000049 STD 0,SAVEFP SAVE FP. PRINT REGS 00000050 STD 2,SAVEFP+8 00000051 STD 4,SAVEFP+16 00000052 STD 6,SAVEFP+24 00000053 SLL 14,2 REMOVE ILC FROM PSW 00000054 SRL 14,2 00000055 ST 14,SAVEPSW 00000056 MVC REGSTOR+56(8),16(14) R14,R15 .MUST BE COPIED BEFORE OVL 00000057 MVC NAMSTOR(8),8(14) SWAP. NAME GIVEN IN LOOK MACRO 00000058 L 11,=V(BLANK) 00000059 USING BLANK,11 00000060 BALR 12,0 00000061 DROP 15 00000062 USING *,12 00000063 MVC SAVE1(140),IBUF SAVE IBUF DURING PRINTING 00000064 L 15,=A(LOOKPR) 00000065 BALR 14,15 00000066 ** DEAL WITH POSSIBLE PRINT MACROS 00000067 L 10,SAVEPSW POSITION AT BEGIN OF PRINT MACRO 00000068 LA 3,0(0,10) CONSTRUCT BRANCH ADDRESS 00000069 S 3,=F'12' 00000070 L 4,0(3) STM 14,15,*+28 INSTRUCTION 00000071 SLL 4,16 00000072 SRL 4,16 BASE,DISPLACEMENT 00000073 LR 3,4 00000074 SRL 3,12 BASE REGISTER 00000075 LA 2,8(0,4) NEW BRANCH ADDRESS 00000076 LR 5,2 00000077 SRL 5,12 00000078 CLR 3,5 COMPARE BASE REGISTERS 00000079 BE *+10 JP IF NEW ADDRESS IS ADDRESSABLE 00000080 S 4,=F'12' 00000081 LR 2,4 B * WILL PROVOKE ERROR 00000082 STH 2,6(10) 00000083 LA 10,8(0,10) 00000084 ST 10,CPRINT1 INITIALIZE ON *+2F 00000085 PRINT1 L 10,CPRINT1 00000086 LA 10,16(0,10) 00000087 ST 10,CPRINT1 00000088 CLI 0(10),X'00' TEST IF MORE PRINTS FOLLOW 00000089 BNE RESTOR1 00000090 ** MODIFY BRANCH IN LOOK MACRO AS TO JUMP OVER PRINT MACRO. 00000091 ** IF DISPLACEMENT GETS TOO LARGE, NO MODIF IS MADE, WHAT WILL LEAD TO 00000092 ** AN ERROR, BY JUMPING INTO 00 CODE OF PRINT MACRO. 00000093 L 3,SAVEPSW 00000094 L 1,4(3) OLD BRANCH INSTRUCTION 00000095 LR 2,1 00000096 A 2,=F'16' NEW BRANCH INSTRUCTION 00000097 LR 4,2 00000098 SRL 1,12 00000099 SRL 4,12 00000100 CLR 1,4 00000101 BNE *+8 DISPLACEMENT TOO LARGE. JP UNMOD 00000102 ST 2,4(3) OVERWRITE BRANCH ADDRESS 00000103 L 2,0(10) LENGTH OF AREA 00000104 L 1,4(10) ADRES OF AREA 00000105 CLI 4(10),X'0B' 00000106 BNE PR2 00000107 LA 1,0(1,11) MAIN COMMON VARIABLE 00000108 B PR1 00000109 PR2 CLI 4(10),X'0A' 00000110 BNE PR1 JP IF LOCAL VARIABLE 00000111 L 5,=A(COMADR-BLANK) 00000112 L 5,0(5,11) HOPE THAT THE ADDRESS WAS IN... 00000113 LA 1,0(1,5) OVERLAY COMMON VARIABLE 00000114 PR1 LA 1,0(1,0) STRIP OFF LEADING 8 BITS 00000115 ST 2,LAREA 00000116 ST 1,SAVEPSW+4 ABS ADDRESS 00000117 S 1,=A(LOAD) 00000118 ST 1,SAVEPSW+8 REL ADDRESS 00000119 LA 10,SAVEPSW-20 00000120 L 15,=A(OCT1) 00000121 BALR 14,15 00000122 LA 1,12 PRINT TEXT2 00000123 ST 1,IBUF+12 00000124 L 10,CPRINT1 00000125 MVC IBUF+20(48),TEXT2 00000126 MVC IBUF+32(8),8(10) COPY NAME 00000127 MVC IBUF+60(6),IBUF+126 COPY REL AREA ADDRESS 00000128 CALLFTN LIJN 00000129 LA 1,28 LENGTH OF PRINTLINE 00000130 ST 1,IBUF+12 00000131 LA 1,1 00000132 ST 1,SAVEPSW+8 00000133 PRINT2 LA 10,SAVEPSW-20 00000134 L 15,=A(OCT1) CONVERT ADRES OF AREA 00000135 BALR 14,15 00000136 MVC IBUF+20(2),IBUF+16 BLANK FILL 00000137 MVC IBUF+22(6),IBUF+114 ABS ADRES 00000138 MVC IBUF+28(2),IBUF+16 BLANK FILL 00000139 MVC IBUF+30(6),IBUF+126 ARRAY NR 00000140 L 10,SAVEPSW+4 00000141 L 15,=A(OCT1) CONVERT CONTENT OF AREA 00000142 BALR 14,15 00000143 CALLFTN LIJN 00000144 L 10,SAVEPSW+4 COUNT ABS ADDRESS 00000145 LA 10,32(0,10) 00000146 ST 10,SAVEPSW+4 00000147 L 10,SAVEPSW+8 COUNT ARRAY ELEMENT 00000148 LA 10,8(0,10) 00000149 ST 10,SAVEPSW+8 00000150 L 1,LAREA 00000151 S 1,=F'8' 00000152 ST 1,LAREA 00000153 BP PRINT2 START NEXT 8 WORDS 00000154 B PRINT1 START NEXT PRINT MACRO 00000155 *** 00000156 RESTOR1 LD 0,SAVEFP RESTORE FP 00000157 LD 2,SAVEFP+8 00000158 LD 4,SAVEFP+16 00000159 LD 6,SAVEFP+24 00000160 MVC IBUF(140),SAVE1 RESTORE IBUF AFTER PRINTING 00000161 L 14,SAVEPSW RETURN ADDRESS 00000162 SPM 14 00000163 LM 0,13,REGSTOR 00000164 BR 14 00000165 DROP 12 00000166 *** 00000167 LOOKPR PROLOGH 1 00000168 L 10,SAVEPSW PRINT REGISTER CONTENT 00000169 MVC IBUF(40),TEXT4 PRINT ********************** 00000170 LA 13,SAFEFTN 00000171 CALLFTN LIJN 00000172 LA 1,28 LENGTH OF PRINTLINE IN WORDS 00000173 ST 1,IBUF+12 00000174 LA 10,REGSTOR 00000175 L 15,=A(OCT1) CONVERT GP0-7 00000176 BALR 14,15 GP10 IS ARG OF OCT1 00000177 MVC IBUF+20(16),TEXT3 PRINT GP0-7 00000178 CALLFTN LIJN 00000179 LA 10,REGSTOR+32 PLACE OF GP8 STORE 00000180 L 15,=A(OCT1) CONVERT GP8-F 00000181 BALR 14,15 GP10 IS ARG OF OCT1 00000182 MVC IBUF+20(16),TEXT3+16 PRINT GP8-F 00000183 CALLFTN LIJN 00000184 LA 10,SAVEFP GP10 IS ARG OF OCT1 00000185 L 15,=A(OCT1) CONVERT FP 00000186 BALR 14,15 00000187 MVC IBUF+20(16),TEXT3+32 PRINT FP 00000188 CALLFTN LIJN 00000189 L 1,SAVEPSW ABS CALLING ADDRESS 00000190 S 1,=A(LOAD) 00000191 ST 1,SAVEPSW+4 CONSTRUCT RELATIVE ADDRESS 00000192 LA 10,SAVEPSW-24 CONVERT PSW TO IBUF(29,30) 00000193 ** CONVERT REL CALLING ADR TO IBUF(32,33) 00000194 ** 6 OTHER WORDS IN FRONT ARE CONVERTED AS 00000195 L 15,=A(OCT1) WELL, BUT ARE IRRELEVANT. 00000196 BALR 14,15 GP10 IS ARG OF OCT1 00000197 LA 1,18 LENGTH 00000198 ST 1,IBUF+12 PRINT TEXT1 00000199 MVC IBUF+20(72),TEXT1 00000200 L 10,SAVEPSW FIND PLACE OF NAME. *+2F 00000201 MVC IBUF+32(8),NAMSTOR COPY NAME 00000202 MVC IBUF+60(6),IBUF+114 COPY ABSOLUTE CALLING ADDRESS 00000203 MVC IBUF+76(6),IBUF+126 COPY RELATIVE CALLING ADDRESS 00000204 MVC IBUF+89(1),IBUF+112 COPY CC 00000205 CALLFTN LIJN 00000206 EPILOGH 1 00000207 SAVEFTN1 DS 18F 00000208 DROP 12 00000209 *** 00000210 DS 0H 00000211 USING *,15 00000212 OCT1 LA 7,IBUF+36 COUNTER FOR IBUF 00000213 LA 6,8 TRANSLATE 8 CONSECUTIVE WORDS AT R10 IN 00000214 ** DISPLAY CODE. RESULT IN IBUF(11,12), IBUF(14,15)..IBUF(32,33) 00000215 LOOK5 SR 1,1 OCT1 DOES NOT USE R13 00000216 L 3,0(10) CONTENT IN R3 00000217 LOOK4 LR 5,1 ASSEMBLE DISPLAY CODE 00000218 LA 4,4 COUNTS CHARS PER WORD 00000219 LOOK3 SLL 1,8(0) 00000220 SR 2,2 CONTAINS 1 X CHAR 00000221 SLDL 2,4(0) 00000222 C 2,=F'9' 00000223 BH LOOK2 00000224 O 2,=X'000000F0' DIGIT 00000225 B LOOK1 00000226 LOOK2 S 2,=F'9' 00000227 O 2,=X'000000C0' LETTER 00000228 LOOK1 OR 1,2 00000229 BCT 4,LOOK3 START NEXT DIGIT 00000230 LTR 5,5 00000231 BZ LOOK4 START 2ND HALF WORD 00000232 MVC 0(4,7),IBUF+16 STORE BLANK WORD 00000233 ST 5,4(7) STORE CONVERTED WORD 00000234 ST 1,8(7) 00000235 LA 7,12(0,7) 00000236 LA 10,4(0,10) 00000237 BCT 6,LOOK5 START NEXT WORD 00000238 BR 14 00000239 DROP 15 00000240 ** 00000241 SAVEFP DS 4D SAVE FP DURING LOOK. 00000242 SAVEPSW DS 3F SAVE PSW DURING LOOK. 00000243 ** 1F FOR REL ADR OF PSW=CALLING AD 00000244 ** 1F FOR NR IN AREA DURING BUGPRIN 00000245 SAVE1 DS 35F STORE IBUF DURING BUGPRINT 00000246 REGSTOR DS 16F STORE REGS 0-13,14-15 00000247 NAMSTOR DS 2F NAME GIVEN IN FFOUT,LOOK MACRO. SAVED OVER OVLAY SWAP 00000248 SAFEFTN DS 18F SAFEAREA WHILE CALLING LIJN 00000249 LOOKPR14 DS 1F SAVE R14 DURING LOOKPR 00000250 LAREA DS 1F LENGTH OF AREA 00000251 CPRINT1 DS 1F COUNT ADRES OF NEXT PRINT MACRO 00000252 TEXT1 DC C'0REGPRINT NNAAMMEE ,CALLED AT ABS ADR NUMBER ,REL ' 00000253 DC C'ADR NUMBER . CC=5 .' 00000254 TEXT2 DC C'0BUGPRINT NNAAMMEE ,RELATIVE ADDRESS NUMBER .' 00000255 TEXT3 DC C'0GENERAL REG 0-70GENERAL REG 8-F0FLOATING PT REG' 00000256 TEXT4 DC F'2',F'0',F'0',F'5',C' ',C'0*******************' 00000257 *** 00000258 UNFC PROLOGH 00000259 L 7,0(1) FORTRAN CALLS AN ASSEMBLER PROGRAM 00000260 L 15,0(7) ADDRESS OF ASSEMBLER ROUTINE 00000261 LM 1,5,4(1) R.N IS ADDR OF N TH ARGUMENT 00000262 LA 1,0(1) DELETE THE BYTE X'80' WHICH INDICATES 00000263 LA 2,0(2) THE LAST ARGUMENT 00000264 LA 3,0(3) 00000265 LA 4,0(4) 00000266 LA 5,0(5) 00000267 SR 0,0 00000268 LA 6,1 00000269 BALR 14,15 CALL TO LOW LEVEL ASSEMBLER ROUTINE 00000270 *** SHOULD NOT USE R12 00000271 EPILOGH 00000272 DROP 12 00000273 *** 00000274 USING *,15 00000275 UNCF STM 12,14,RETURNCF ASSEMBLER CALLS A FORTRAN PROGRA 00000276 BALR 12,0 ADDRESS OF ROUTINE IN R0 00000277 DROP 15 00000278 USING *,12 00000279 LR 15,0 00000280 LR 0,14 RETURN ADDR IN ASS PROG FOR DEBUG PURPOSES 00000281 STM 1,5,ARGLIST1 00000282 MVI ARGLIST1+16,X'80' 00000283 LA 1,ARGLIST1 00000284 BALR 14,15 CALL TO FTN ROUTINE WITH ARGS 00000285 LM 12,14,RETURNCF 00000286 SR 0,0 00000287 BR 14 00000288 RETURNCF DS 3F 00000289 ARGLIST1 DS 5F 00000290 DROP 12 00000291 *** 00000292 DS 0H 00000293 USING *,2 00000294 &TIME$ SETA 3 00000295 SECOND LR 2,15 BASE REG 00000296 LR 7,14 RETURN REG 00000297 LR &TIME$,1 REMAINING TIME IN UNITS OF 26.04 MMSECS 00000298 TTIMER 00000299 L 4,TIME0 USES REGS 0,14,15 00000300 SR 4,0 ELAPSED TIME IN .01 SECONDS 00000301 SRDA 4,32 00000302 D 4,=F'384' 00000303 ST 5,0(&TIME$) 00000304 SR 0,0 00000305 BR 7 00000306 DROP 2 00000307 *** 00000308 DS 0H 00000309 USING *,15 00000310 *** LEADING ZEROS ARE REPLACED BY BLANKS. NO SIGN IS PRESENT. RESULT 00000311 *** IS 8 BYTES LONG. 00000312 &INTEG$ SETA 1 VALUE OF INTEGER 00000313 &DISPL$ SETA 2 ADDRESS OF ARRAY. DIM=2 00000314 CVTIN L &INTEG$,0(1) 00000315 CVD &INTEG$,DEC1 DECIMAL 00000316 UNPK 0(8,&DISPL$),DEC1+4(4) DISPLAY 00000317 OI 0(&DISPL$),X'F0' FORCE EBCDIC ZONES,RATHER THAN ASCII 00000318 MVZ 1(7,&DISPL$),0(&DISPL$) FORCES ALL ZONES=F.OVERWRITE SIG 00000319 LA 3,7(0,&DISPL$) 00000320 LR 4,&DISPL$ 00000321 CVTIN1 CLI 0(4),C'0' LEADING ZEROS 00000322 BNER 14 00000323 MVI 0(4),C' ' BECOMES BLANK 00000324 AR 4,6 00000325 CR 4,3 00000326 BL CVTIN1 00000327 BR 14 00000328 DROP 15 00000329 *** 00000330 DS 0H 00000331 USING *,15 00000332 *** ZEROS ARE REPLACED BY BLANKS. NO SIGN IS PRESENT. A DECIMAL POINT 00000333 *** IS INSERTED IN FRONT OF THE LAST 2 DIGITS. GOES CORRECTLY, EVEN 00000334 *** WHEN NO TIMER OPTION IS INSTALLED. 00000335 &INTEG$ SETA 1 VALUE OF INTEGER 00000336 &DISPL$ SETA 2 ADDRESS OF ARRAY. DIM=2 00000337 CVTFL L &INTEG$,0(1) 00000338 CVD &INTEG$,DEC1 DECIMAL 00000339 UNPK 0(8,&DISPL$),DEC1+4(4) DISPLAY 00000340 OI 0(&DISPL$),X'F0' FORCE EBCDIC ZONES,RATHER THAN ASCII 00000341 MVZ 1(7,&DISPL$),0(&DISPL$) FORCES ALL ZONES=F.OVERWRITE SIG 00000342 LA 3,6(0,&DISPL$) 00000343 LR 4,&DISPL$ 00000344 CVTFL1 CLI 0(4),C'0' LEADING ZEROS 00000345 BNE CVTFL2 00000346 MVI 0(4),C' ' BECOMES BLANK 00000347 AR 4,6 00000348 CR 4,3 00000349 BL CVTFL1 00000350 CVTFL2 MVC 0(5,&DISPL$),1(&DISPL$) SHIFT 1 DIGIT FORWARD 00000351 MVI 5(&DISPL$),C'.' INSERT DECIMAL POINT 00000352 BR 14 00000353 DROP 15 00000354 *** 00000355 *** CONVERT R1 TO DECIMAL DISPLAY CODE. ADDRESS OF FIRST CHAR OR SIGN 00000356 *** IN R3. TERMINATED BY ZEROES. R2='+' REQUESTS + SIGN IN FRONT OF 00000357 *** POSITIVE NR. ELSE R2 MUST BE =0 . - IS ALWAYS PRESENT. 00000358 DS 0H 00000359 USING *,15 00000360 NUM1 CR 0,1 00000361 BNH L0001 00000362 LA 2,C'-' 00000363 LPR 1,1 00000364 L0001 CVD 1,DEC1 00000365 UNPK DISPL5(16),DEC1(8) 00000366 OI DISPL5,X'F0' FORCE EBCDIC ZONES 00000367 MVZ DISPL5+1(15),DISPL5 00000368 LA 4,DISPL5+15 00000369 LA 3,DISPL5 00000370 L0002 CLI 0(3),C'0' 00000371 BNE L0003 00000372 AR 3,6 00000373 CR 3,4 00000374 BL L0002 00000375 L0003 CR 0,2 00000376 BER 14 00000377 SR 3,6 00000378 STC 2,0(3) 00000379 BR 14 00000380 DROP 15 00000381 DISPL5 DS 2D 00000382 DC 2D'0' TO MAKE DISPL5 LEFT ADJ. ZERO FILL 00000383 DEC1 DS 1D 00000384 *** 00000385 SNOEP PROLOGH 00000386 CMP000 NCONT,9 PRINT STATISTICS 00000387 BE SNOE1 00000388 L 15,=A(SECOND) 00000389 LA 1,KTIME 00000390 BALR 14,15 00000391 SETVAL KTIME,0,(+,KTIME,0,-,NTIME,0,) 00000392 SET000 NNSUBS,0 00000393 CMP000 NSUBS,0,LE,SNOE2 00000394 SETVAL NNSUBS,0,(+,NSUBS,0,-,NDIMT,0,) 00000395 SNOE2 SETVAL NNDIMU,0,(+,NDIMU,0,-,NDIMT,0,) 00000396 SETVAL NOUT,0,(+,NTEM,0,-,NZELF,0,-,NWEG,0,) 00000397 SETMAX MMBE,MBE 00000398 SETVAL IBUF,1,(+,NTAP2,0,) 00000399 SET000 IBUF,2 00000400 SET000 IBUF,3 00000401 SETVAL IBUF,4,(+,16,0,) 00000402 MVC IBUF+20(64),TEX1 00000403 LA 1,KTIME 00000404 LA 2,IBUF+40 00000405 L 15,=A(CVTFL) 00000406 BALR 14,15 00000407 CALLFTN LIJN 00000408 SETVAL IBUF,4,(+,7,0,) 00000409 MVC IBUF+20(28),TEX2 00000410 LA 1,NOUT 00000411 LA 2,IBUF+40 00000412 L 15,=A(CVTIN) 00000413 BALR 14,15 00000414 CALLFTN LIJN 00000415 SETVAL IBUF,4,(+,16,0,) 00000416 MVC IBUF+20(64),TEX3 00000417 LA 1,NTEM 00000418 LA 2,IBUF+40 00000419 L 15,=A(CVTIN) 00000420 BALR 14,15 00000421 SETVAL NN,0,(+,MMBE,0,-,MTAB,1,+,1,0,) 00000422 LA 1,NN 00000423 LA 2,IBUF+68 00000424 L 15,=A(CVTIN) 00000425 BALR 14,15 00000426 SETVAL NN,0,(+,NDIMT,0,-,MTAB,1,+,3*LFLOAT,0,) 00000427 LA 1,NN 00000428 LA 2,IBUF+76 00000429 L 15,=A(CVTIN) 00000430 BALR 14,15 00000431 CALLFTN LIJN 00000432 MVC IBUF+20(64),TEX4 00000433 LA 1,NZELF 00000434 LA 2,IBUF+40 00000435 L 15,=A(CVTIN) 00000436 BALR 14,15 00000437 LA 1,NNSUBS 00000438 LA 2,IBUF+68 00000439 L 15,=A(CVTIN) 00000440 BALR 14,15 00000441 LA 1,NNDIMU 00000442 LA 2,IBUF+76 00000443 L 15,=A(CVTIN) 00000444 BALR 14,15 00000445 CALLFTN LIJN 00000446 MVC IBUF+20(64),TEX5 00000447 LA 1,NWEG 00000448 LA 2,IBUF+40 00000449 L 15,=A(CVTIN) 00000450 BALR 14,15 00000451 LA 1,MMBU 00000452 LA 2,IBUF+68 00000453 L 15,=A(CVTIN) 00000454 BALR 14,15 00000455 LA 1,NANU 00000456 LA 2,IBUF+76 00000457 L 15,=A(CVTIN) 00000458 BALR 14,15 00000459 CALLFTN LIJN 00000460 MVC IBUF+20(64),TEX6 00000461 LA 1,NQ1 00000462 LA 2,IBUF+40 00000463 L 15,=A(CVTIN) 00000464 BALR 14,15 00000465 SETVAL NN,0,(+,IDAAN,0,-,IDADR,0,) 00000466 LA 1,NN 00000467 LA 2,IBUF+68 00000468 L 15,=A(CVTIN) 00000469 BALR 14,15 00000470 LA 1,MAXI1 00000471 LA 2,IBUF+76 00000472 L 15,=A(CVTIN) 00000473 BALR 14,15 00000474 CALLFTN LIJN 00000475 MVC IBUF+20(64),TEX7 00000476 LA 1,NMULT 00000477 LA 2,IBUF+40 00000478 L 15,=A(CVTIN) 00000479 BALR 14,15 00000480 L 2,MNEPS 00000481 C 2,MAXI2 00000482 BNH L0004 00000483 LADR 1,IIEP,1 00000484 SR 2,1 00000485 L0004 ST 2,NN 00000486 LA 1,NN 00000487 LA 2,IBUF+68 00000488 L 15,=A(CVTIN) 00000489 BALR 14,15 00000490 LA 1,MAXI2 00000491 LA 2,IBUF+76 00000492 BALR 14,15 00000493 CALLFTN LIJN 00000494 SETVAL IBUF,3,(-,1,0) 00000495 SET000 IBUF,4 00000496 CALLFTN LIJN 00000497 SNOE1 EPILOGH 00000498 SAVEFTN DS 18F 00000499 MAXI1 DC A(NDIMI) 00000500 MAXI2 DC A(LIEP) 00000501 KTIME DS 1F 00000502 NN DS 1F 00000503 NOUT DS 1F 00000504 NNSUBS DS 1F 00000505 NNDIMU DS 1F 00000506 TEX1 DC C'0RUNNING TIME (SEC) ' 00000507 DC C' USED MAXIMUM' 00000508 TEX2 DC C' TERMS IN OUTPUT ' 00000509 TEX3 DC C' GENERATED TERMS INPUT SPACE ' 00000510 DC C' ' 00000511 TEX4 DC C' EQUAL TERMS OUTPUT SPACE' 00000512 DC C' ' 00000513 TEX5 DC C' CANCELLATIONS NR. OF EXPR.' 00000514 DC C' ' 00000515 TEX6 DC C' RECORDS WRITTEN ID. REGISTER' 00000516 DC C' ' 00000517 TEX7 DC C' MULTIPLICATIONS FUNCT. REG. ' 00000518 DC C' ' 00000519 END 00000520 ./A MAINFTN,INCR=1 00000001 C PROGRAM SCHIP 00000002 EXTERNAL DUMP1 00000003 CALL ERRSET(207,2,2,2,DUMP1,229) 00000004 CALL ERRSET(231,2,2,2,DUMP1,239) 00000005 CALL ERRSET(241,2,2,2,DUMP1,301) 00000006 C 4TH ARG REQUESTS TRACEBACK. ELSE SET TO 1 00000007 CALL CERN 00000008 STOP 00000009 END 00000010 SUBROUTINE CERN 00000011 ./MACRO BLANK 00000012 ./MACRO STORAG 00000013 INTEGER STEND,STYEP,STFIX,PAS,YTERM,YEPFL 00000014 DIMENSION II(2),MSG2(8),MSG3(13),IPUNCH(37) 00000015 EQUIVALENCE ( IBUF(38),IPUNCH(1) ) 00000016 EXTERNAL CVTFL,CVTIN,SECOND 00000017 DATA MSG2/4H YEP,4H COU,4HNT U,4HNCHE,4HCK ,4H ,4H ,4H /00000018 DATA MSG3/4H0TER,4HMS O,4HUT ,4H ,TE,4HRMS ,4HIN , 00000019 1 4H0END,4H OF ,4HRUN.,4H TIM,4HE ,4H SEC,4HONDS/ 00000020 C DATA STBEG,STEND,STNEX,STYEP,STFIX /1,2,3,4,5/ 00000021 DATA STEND,STYEP,STFIX /2,4,5/ 00000022 CALL SETZ 00000023 LAY1(2)=1 00000024 C START READING INPUT 00000025 10 CALL IN 00000026 C * END SEEN WHILE SKIPPING INPUT CARDS AFTER ERROR. 00000027 IF ( LAY1(1) ) 9,112,9 00000028 112 IF ( MFOUT ) 101,102,101 00000029 101 LAY1(1)=-1 00000030 C ERROR RECOVERY 00000031 107 CALL WRONG 00000032 C ERROR OCCURED IN THE LAST PROBLEM. 00000033 IF ( NSPEC-STEND ) 10,9,10 00000034 102 LAY1(1)=0 00000035 PAS=1 00000036 LAY4(1)=NCONT(6) 00000037 LAY4(2)=NCONT(11) 00000038 C PRINT NAMELISTS AND CINPUT 00000039 22 KK=LAY4(1)+LAY4(2) 00000040 IF ( KK ) 27,71,27 00000041 27 CALL WRONG 00000042 71 IF(NREP) 17,26,17 00000043 17 NREP=0 00000044 C NREP NZ WHEN R INPUT WAS READ AND WRITTEN ON TAPE6. PROCESSED AS IN 00000045 C * YEP CASE, I.E. NSL NZ. 00000046 NNOTI=NTEM 00000047 IF ( NSPEC-STYEP ) 10,31,10 00000048 31 YEPFL=1 00000049 LAY2(1)=-1 00000050 CALL SNOEP 00000051 GO TO 10 00000052 26 IF ( NSPEC-STFIX ) 18,10,18 00000053 18 IF ( YEPFL ) 40,20,40 00000054 20 LAY2(1)=0 00000055 C CALL TO GLADYS 00000056 CALL EXEC 00000057 IF ( MFOUT ) 107,78,107 00000058 40 CALL TAKMAN ( NTAP6,Z,Z,REW0 ) 00000059 C CALL TO REPEAT. READS FROM TAPE6. CASE OF * YEP OR R INPUT. 00000060 CALL EXEC 00000061 IF (MFOUT) 107,108,107 00000062 108 IF ( NCONT(9) ) 1,2,1 00000063 1 IBUF(1)=NTAP2 00000064 IBUF(2)=0 00000065 IBUF(3)=0 00000066 IBUF(4)=10 00000067 IBUF(6)=MSG3(1) 00000068 IBUF(7)=MSG3(2) 00000069 IBUF(8)=MSG3(3) 00000070 CALL UNFC (CVTIN,NNOTI,II) 00000071 IBUF(9)=II(1) 00000072 IBUF(10)=II(2) 00000073 IBUF(11)=MSG3(4) 00000074 IBUF(12)=MSG3(5) 00000075 IBUF(13)=MSG3(6) 00000076 CALL UNFC(CVTIN,YTERM,II) 00000077 IBUF(14)=II(1) 00000078 IBUF(15)=II(2) 00000079 CALL LIJN 00000080 2 IF ( NNOTI-YTERM ) 69,78,69 00000081 69 DO 130 I=1,8 00000082 130 IPUNCH(I+2)=MSG2(I) 00000083 75 MFOUT=1 00000084 GO TO 107 00000085 78 IF ( NSPEC-STYEP ) 25,24,25 00000086 24 CALL TAKMAN ( NTAP6,Z,Z,REW0 ) 00000087 YEPFL=1 00000088 LAY2(1)=1 00000089 NCONT(2)=NVRA 00000090 GO TO 70 00000091 25 YEPFL=0 00000092 70 CALL SNOEP 00000093 PAS=-1 00000094 LAY4(1)=NCONT(7) 00000095 LAY4(2)=NCONT(11) 00000096 IF ( NAMES ) 111,122,111 00000097 122 LAY4(2)=0 00000098 111 KK=LAY4(1)+LAY4(2) 00000099 NAMES=0 00000100 IF ( KK ) 125,124,125 00000101 125 CALL WRONG 00000102 124 CALL OUT 00000103 NNOTI=NTEM-NZELF-NWEG 00000104 IF ( MFOUT ) 107,109,107 00000105 109 IF ( NCONT(10) ) 113,114,113 00000106 113 PAS=-1 00000107 LAY4(1)=1 00000108 CALL WRONG 00000109 114 IF ( NSPEC-STEND ) 10,9,10 00000110 9 CALL UNFC(SECOND,NTIME) 00000111 IBUF(1)=NTAP2 00000112 IBUF(2)=0 00000113 IBUF(3)=0 00000114 IBUF(4)=9 00000115 DO 131 I=1,5 00000116 131 IBUF(I+5)=MSG3(I+6) 00000117 CALL UNFC (CVTFL,NTIME,II) 00000118 IBUF(11)=II(1) 00000119 IBUF(12)=II(2) 00000120 IBUF(13)=MSG3(12) 00000121 IBUF(14)=MSG3(13) 00000122 CALL LIJN 00000123 STOP 00000124 END 00000125 SUBROUTINE LIJN 00000126 ./MACRO BLANK 00000127 C IBUF(1)=NTAPX , IBUF(3)=BEGIN , IBUF(4)=END 00000128 C IBUF(5)=BLANK , IBUF(6) TO IBUF(37)=BUFFER 00000129 C IBUF(38) TO IBUF(74) IS A SECOND BUFFER (CALLED IPUNCH) FOR 00000130 C WRITING ERROR MESSAGES AND PUNCH CARD OUTPUT AND PRINT BRACKETS 00000131 NTAPX=IBUF(1)+10 00000132 I1=IBUF(3)+6 00000133 I2=IBUF(4)+5 00000134 IPAD=IBUF(I2) 00000135 C CALL PAD40 00000136 IF ( NTAPX-18 ) 8,9,8 00000137 9 PUNCH 10,(IBUF(I),I=I1,I2) 00000138 IBUF(I2)=IPAD 00000139 RETURN 00000140 8 WRITE ( NTAPX,13 ) (IBUF(I),I=I1,I2) 00000141 IBUF(I2)=IPAD 00000142 RETURN 00000143 10 FORMAT ( 20A4 ) 00000144 13 FORMAT ( 32A4 ) 00000145 END 00000146 SUBROUTINE TAKMAN(NTB,LBUF,NWOR,I8) 00000147 ./MACRO BLANK 00000148 DIMENSION LBUF(3),MEM(10),NRE(10),ITEX(8),KTEX(8),IPUNCH(37) 00000149 INTEGER*2 IHALF(2) 00000150 EQUIVALENCE (IBUF(38),IPUNCH(1)),(IHALF(1),IFUL) 00000151 EXTERNAL GETAHS 00000152 DATA NSHIFT / Z1000000 / 00000153 DATA NRE / 10*0 / 00000154 DATA MEM / 10*0 / 00000155 DATA KTEX/4H FRO,4HZEN ,4HSUBF,4HILE ,4HMISS,4HING ,4H ,4H /00000156 DATA ITEX/4H TAP,4HE TR,4HOUBL,4HE OR,4H END,4H OF ,4HFILE,4H /00000157 C LBUF(1)=TAPE AND RECORD NUMBER. IS SET TO ZERO IF RECORD IS NOT READ 00000158 C IN ENTIRELY. THIS FORCES A NEW READ OF THE RECORD LATER. 00000159 C LBUF(2)=LENGTH IN WORDS OF RECORD. 00000160 C NWOR = LENGTH IN BYTES OF RECORD 00000161 C LBUF(3)=CHECKWORD 00000162 C MEANING OF THE I8 PARAMETER IS.. 00000163 C -3=EOF, -2=REWIND,-1=READ, 0=WRITE, 1=EOF+REW, 6+K=READ RECORD K 00000164 C NRE(NTA)=NR OF RECORD LAST READ OR WRITTEN 00000165 C -4 = GIVE NR OF NEXT RECORD TO BE WRITTEN OR READ INTO NWOR. 00000166 C -5 = REWIND, END OF FILE, REWIND 00000167 C 2= SEARCH RECORD WITH FIRST WORD AS IN NWOR. NWOR IS SUPPOSEDLY 00000168 C CONTAINING 30 BIT NAME FOLLOWED BY A 12 BIT NUMBER. 00000169 C THE RECORD NUMBER IS RETURNED IN LBUF(1) 00000170 NTA=NTB 00000171 NTA10=NTA+10 00000172 I9=I8+4 00000173 IF(10-I9) 12,11,11 00000174 11 IF(I9-2) 40,2,5 00000175 5 IF(I9-4) 3,4,1 00000176 40 IF(I9) 2,41,1 00000177 41 NWOR=MEM(NTA) 00000178 IF(NWOR) 42,42,43 00000179 42 NWOR=NRE(NTA) 00000180 43 NWOR=NWOR+1 00000181 RETURN 00000182 C I9=1=EOF, 2=REW, 3=READ, 4=WRITE, 5=EOF+REW 00000183 1 IF(I9-6) 54,45,54 00000184 54 L2=MEM(NTA) 00000185 MEM(NTA)=0 00000186 CALL POSIT(NTA,L2,NRE(NTA)) 00000187 END FILE NTA10 00000188 NRE(NTA)=NRE(NTA)+1000000 00000189 IF(I9-5) 6,2,6 00000190 2 MEM(NTA)=0 00000191 NRE(NTA)=0 00000192 REWIND NTA10 00000193 REWIND NTA10 00000194 IF(I9+1) 6,44,6 00000195 44 I9=5 00000196 GO TO 1 00000197 45 NWIS=NWOR 00000198 C SEARCH RECORD WITH GIVEN FILENAME. 00000199 IF(MEM(NTA)) 46,47,46 00000200 47 MEM(NTA)=NRE(NTA) 00000201 46 LIM=MEM(NTA) 00000202 NACT=NRE(NTA) 00000203 MES=10 00000204 51 IF(NACT-LIM) 48,49,49 00000205 49 REWIND NTA10 00000206 NACT=0 00000207 IF(MES) 50,53,50 00000208 50 MES=MES-1 00000209 48 MRE=0 00000210 READ (NTA10) MRE,NWOR1,MCH,NSEA 00000211 IF ( MRE ) 53,53,70 00000212 70 MRE1=MRE-NSHIFT*NTA 00000213 NACT=MRE 00000214 IF ( MRE1 ) 10,9,9 00000215 9 NACT=MRE1 00000216 10 CALL UNFC(GETAHS,NSEA,NWIS,L7) 00000217 IF(L7) 51,52,49 00000218 52 LBUF(1)=NACT 00000219 NRE(NTA)=NACT 00000220 RETURN 00000221 53 DO 80 I=1,8 00000222 80 IPUNCH(I+2)=KTEX(I) 00000223 CALL FOUTB 00000224 6 RETURN 00000225 3 L2=MEM(NTA) 00000226 C READ NEXT RECORD. I8=-1. I9=3 00000227 MEM(NTA)=0 00000228 MRE1=NRE(NTA)+1+NSHIFT*NTA 00000229 IF ( MRE1 - LBUF(1) ) 16,61,16 00000230 61 NCH=0 00000231 NWOR1=LBUF(2) 00000232 DO 62 L2=4,NWOR1 00000233 IFUL=LBUF(L2) 00000234 62 NCH=NCH+IHALF(1)+IHALF(2) 00000235 IF ( NCH- LBUF(3) ) 16,6,16 00000236 16 CALL POSIT(NTA,L2,NRE(NTA)) 00000237 15 MES=10 00000238 NRE(NTA)=NRE(NTA)+1 00000239 19 MES=MES-1 00000240 MRE=0 00000241 READ (NTA10) MRE,NWOR1,MCH,(LBUF(L2),L2=4,NWOR1) 00000242 LBUF(1)=MRE 00000243 LBUF(2)=NWOR1 00000244 LBUF(3)=MCH 00000245 NWOR=(NWOR1-3)*4 00000246 C THE CHECK ON MRE=0 AFTER EACH READ SIMULATES AN EOF TEST. 00000247 IF ( MRE ) 24,24,71 00000248 71 MRE1=MRE-NSHIFT*NTA 00000249 IF ( MRE1 ) 7,8,8 00000250 8 MRE=MRE1 00000251 7 IF(MRE-NRE(NTA)) 20,21,22 00000252 22 BACKSPACE NTA10 00000253 23 BACKSPACE NTA10 00000254 20 IF(MES) 24,19,19 00000255 24 DO 81 I=1,8 00000256 81 IPUNCH(I+2)=ITEX(I) 00000257 CALL FOUTB 00000258 RETURN 00000259 21 NCH=0 00000260 DO 25 L2=4,NWOR1 00000261 IFUL=LBUF(L2) 00000262 25 NCH=NCH+IHALF(1)+IHALF(2) 00000263 IF(NCH-MCH) 23,6,23 00000264 C WRITE. I8=0. I9=4 00000265 4 MCH=0 00000266 NWOR1=NWOR/4+3 00000267 DO 26 L2=4,NWOR1 00000268 IFUL=LBUF(L2) 00000269 26 MCH=MCH+IHALF(1)+IHALF(2) 00000270 L2=MEM(NTA) 00000271 MEM(NTA)=0 00000272 CALL POSIT(NTA,L2,NRE(NTA)) 00000273 MRE=NRE(NTA)+1 00000274 NRE(NTA)=MRE 00000275 LBUF(1)=MRE+NSHIFT*NTA 00000276 LBUF(2)=NWOR1 00000277 LBUF(3)=MCH 00000278 WRITE (NTA10) (LBUF(L2),L2=1,NWOR1) 00000279 NQ1=NQ1+1 00000280 RETURN 00000281 C READ RECORD NUMBER I8-6 . 00000282 12 L2=I8-7 00000283 IF ( L2+1 + NSHIFT*NTA - LBUF(1) ) 33,63,33 00000284 63 NCH=0 00000285 NWOR1=LBUF(2) 00000286 DO 64 L2=4,NWOR1 00000287 IFUL=LBUF(L2) 00000288 64 NCH=NCH+IHALF(1)+IHALF(2) 00000289 IF ( NCH- LBUF(3) ) 33,6,33 00000290 33 IF(MEM(NTA)) 29,27,29 00000291 27 MEM(NTA)=NRE(NTA) 00000292 IF(MEM(NTA)) 29,31,29 00000293 31 MEM(NTA)=-1 00000294 29 IF(L2) 30,30,16 00000295 30 REWIND NTA10 00000296 NRE(NTA)=0 00000297 GO TO 15 00000298 END 00000299 SUBROUTINE POSIT(NTB,L1,NREA) 00000300 ./MACRO BLANK 00000301 DIMENSION IPUNCH(37),KTEX(8) 00000302 EQUIVALENCE ( IBUF(38),IPUNCH(1) ) 00000303 DATA NSHIFT / Z1000000 / 00000304 DATA KTEX/4H TAP,4HE PO,4HSITI,4HONIN,4HG ER,4HROR ,4H ,4H /00000305 NTA=NTB 00000306 NTA10=NTA+10 00000307 L2=L1 00000308 IF(L2) 4,1,2 00000309 4 NREA=0 00000310 REWIND NTA10 00000311 1 RETURN 00000312 2 IF(L2-NREA) 3,1,5 00000313 3 NREA=L2 00000314 REWIND NTA10 00000315 GO TO 9 00000316 5 NREA=L2 00000317 9 MES=10 00000318 6 MRE=0 00000319 READ (NTA10) MRE 00000320 IF ( MRE ) 8,8,12 00000321 12 MRE1=MRE-NSHIFT*NTA 00000322 IF ( MRE1 ) 11,10,10 00000323 10 MRE=MRE1 00000324 11 IF(MRE-L2) 6,1,7 00000325 7 REWIND NTA10 00000326 MES=MES-1 00000327 IF(MES) 8,6,6 00000328 8 DO 80 I=1,8 00000329 80 IPUNCH(I+2)=KTEX(I) 00000330 CALL FOUTB 00000331 RETURN 00000332 END 00000333 SUBROUTINE PAD40 00000334 RETURN 00000335 END 00000336 SUBROUTINE GETAHS 00000337 RETURN 00000338 END 00000339 ./A MARTYN1,INCR=1 00000001 ./MACRO MAINMCRO 00000002 ./MACRO EXECMCRO 00000003 TITLE 'MARTYN1' 00000004 GBLC &OVLAY 00000005 LCLA &VALUE$ 00000006 ./MACRO EXECCOM 00000007 ./MACRO MAINCOM 00000008 *** 00000009 *** 00000010 PRINT NOGEN 00000011 MARTYN0 CSECT 00000012 EQUIVAL 00000013 ENTRY MARTYN1,XMARTYN1,Z1IDT 00000014 EXTRN EPSRED1,FOUT,BRIAN,TAKMAN,UNCF 00000015 EXTRN SOORT39,SOORT41,SOORT45,SOORT54 00000016 USING EXECCOM,10 00000017 USING BLANK,11 00000018 *** EXECUTE SUBSTITUTIONS AND COMMANDS OF THE CURRENT LEVEL */ 00000019 *** ( AS INDICATED IN IDGEH ) . */ 00000020 /MARTYN1 PRO 00000021 / SETVAL EPSM1,0,(+,NQA,0,) SIGNALS EPF. REQUEST ARG REARRANG 00000022 : SETVAL IDNEXT,0,(+,NID$FST,LEVEL1,) 00000023 : SETVAL IDLAST,0,(+,NID$LST,LEVEL1,) 00000024 JUMP Z1IDT 00000025 DROP 12 00000026 DS 0H 00000027 USING *,12 00000028 /Z1IDT CMPVAL IDLAST,0,(+,IDNEXT,0,),LT,Z2UIT 00000029 ** /* FIND NEXT IDENTIFIER APPLICABLE AT CURRENT LEVEL */ 00000030 /Z2IDT SETVAL IDCUR,0,(+,IDNEXT,0,) 00000031 / SETVAL IDNEXT,0,(+,ID$POINT,IDCUR,+,IDADR,0,) 00000032 : CMPVAL ID$LEVLF,IDCUR,(+,LEVEL,0,),GT,LL001 00000033 : CMPVAL ID$LEVLL,IDCUR,(+,LEVEL,0,),GE,Z2RAAK 00000034 /LL001 CMPVAL IDNEXT,0,(+,IDLAST,0,),LE,Z2IDT 00000035 /Z2UIT CMP000 EPSM1,0,EQ,EXIT1 00000036 / SETVAL EPSM1,0,(-,EPSM1,0,) 00000037 / CCALL EPSRED1 00000038 EXIT1 JUMP XMARTYN1 00000039 /Z2RAAK SETVAL ANTHAU,0,(+,ID$LOCNR,IDCUR,) 00000040 / SETADR IDCODE,0,(+,ID$VAR,IDCUR,) 00000041 *** GO TO C(WAARZO(IDGEH(IDCUR).SOORT)); 00000042 *** WAARZO IS SOORT0,SOORT1,...,SOORT63. TYPES THAT ARE NOT */ 00000043 *** BUILT IN JUMP TO FOUTB1=ERROR IN SUBSTITUTION,COMMAND */ 00000044 CMPVAL ID$SOORT,IDCUR,(+,32,0,),GE,COMMAND1 00000045 LOAD 1,ID$SOORT,IDCUR 00000046 SLA 1,2 00000047 L 2,=A(TAB1) 00000048 L 3,0(1,2) 00000049 BR 3 00000050 COMMAND1 JUMP COMMAND0 00000051 ** 00000052 *** SUBSTITUTIONS...SUBSTITUTIONS...SUBSTITUTIONS...SUBSTITUTIONS... 00000053 ** 00000054 *** CAREFUL WITH SIGN EXTENSIONS OF CODE.NR INTO FULL WORD INTEGER. 00000055 *** IPR1=FULL INTEG. ISCAL=FULL INTEG. ID$WORD =CODE. NEEDS SGNEXT 00000056 ** 00000057 *** ID,F(A+,B+,...,N+)=... */ 00000058 *** IN IEP ...F A B C ...).. BECOMES ... DKEY A B C .../LOCNR,1/... */ 00000059 /SOORT0 CMPVAL -ID$WORD-TYPE-,IDCODE,(+,DUMMY,0,),EQ,SOORT10 00000060 ** /* FUNCTION WITH ONLY DUMMIES AS ARGS. JP IF FU ITSELF IS */ 00000061 ** /* A DUMMY AS WELL. */ 00000062 / CMP000 NEPS,0,EQ,Z1IDT 00000063 / SET000 J,0 00000064 /Z2DOORG SETVAL J,0,(+,J,0,+,1,0,) 00000065 / CMPVAL J,0,(+,NEPS,0,),GT,Z1IDT 00000066 / CMPVAL P$VAR,J,(+,ID$WORD,IDCODE,),NE,Z2DOORG 00000067 ** /* SEARCH SAME FUNCTION */ 00000068 / SETVAL P$WORD,J,(+,DKEY,0,) 00000069 / SET111 MARKER,0 00000070 SETVAL II5,0,(+,J,0,+,1,0,) 00000071 DOLOOP K,II5,NEPS,1,L0001,FOUTB1 00000072 / CMPVAL P$WORD,K,(+,FUNCT0,0,),NE,L0240 00000073 / SETVAL P$EXPR,K,(+,ANTHAU,0,) 00000074 / SET111 P$MULTP,K 00000075 / SET000 P$POINT,K 00000076 / SETVAL J,0,(+,K,0,) 00000077 / B Z2DOORG 00000078 /L0240 ENDDO L0001,5 00000079 / B FOUTB1 ERROR IN SUBSTITUTION,COMMAND */ 00000080 ** 00000081 *** ID,MULTI,A**3=... OR ID,A=... */ 00000082 /SOORT1 SETVAL L,0,(+,ID$WORD,IDCODE,-,ALGEBR0,0,) 00000083 / CMPVAL IDNEXT,0,(+,IDCODE,0,+,NEXTW,0,),NE,SO1A 00000084 ** /* JP IF EXPON PRESENT. ELSE ASSUME EXPON=1 */ 00000085 / CMP111 IPR1,L,LT,Z1IDT 00000086 / SETVAL QUOT5,0,(+,IPR1,L,) CASE OF A**1 */ 00000087 / SET000 IPR1,L 00000088 / B SO1D 00000089 /SO1A SETVAL N1,0,(+,IPR1,L,) CASE OF ID,MULTI,A**N2 ON A**N1 * 00000090 / CMP000 N1,0,EQ,Z1IDT 00000091 SETVAL IJ5,0,(+,IDCODE,0,+,NEXTW,0,) 00000092 SGNEXT RESULFX,0,-ID$WORD-NR-,IJ5 00000093 L 1,RESULFX DIVIDER 00000094 L 2,N1 00000095 SRDA 2,32 DIVIDEND. 64 BIT WORD WITH SIGN EXTEN 00000096 DR 2,1 00000097 CR 3,6 00000098 BL Z1IDT JP IF QUOT5 LT 1 00000099 ST 3,QUOT5 00000100 STORE 2,IPR1,L REMAINDER 00000101 /SO1D SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000102 / SETVAL P$EXPR,NEPS,(+,ANTHAU,0,) 00000103 / SETVAL P$MULTP,NEPS,(+,QUOT5,0,) 00000104 / SET000 P$POINT,NEPS 00000105 / SET111 MARKER,0 00000106 / B Z1IDT 00000107 ** 00000108 *** ID,MULTI,J OR PDQ OR P(3)**5=... OR ID,J OR PDQ OR P(3)=... */ 00000109 /SOORT2 DOLOOP J,1,NDOTI,2,L0003,Z1IDT 00000110 / CMPVAL ISCAL,J,(+,ID$WORD,IDCODE,),EQ,SO2A 00000111 / ENDDO L0003,2 00000112 / B Z1IDT 00000113 SO2A SETVAL II5,0,(+,J,0,+,1,0,) 00000114 CMPVAL IDNEXT,0,(+,IDCODE,0,+,NEXTW,0,),NE,SO2E 00000115 CMP111 ISCAL,II5,LT,Z1IDT NO EXPON PRESENT 00000116 : SETVAL QUOT5,0,(+,ISCAL,II5,) 00000117 SET000 ISCAL,II5 00000118 / B SO1D 00000119 :SO2E SETVAL N1,0,(+,ISCAL,II5,) 00000120 SETVAL IJ5,0,(+,IDCODE,0,+,NEXTW,0,) 00000121 SGNEXT RESULFX,0,-ID$WORD-NR-,IJ5 00000122 L 1,RESULFX DIVIDER 00000123 L 2,N1 00000124 SRDA 2,32 DIVIDEND. 64 BIT WORD WITH SIGN EXTEN 00000125 DR 2,1 00000126 CR 3,6 00000127 BL Z1IDT JP IF QUOT5 LT 1 00000128 ST 3,QUOT5 00000129 STORE 2,ISCAL,II5 REMAINDER 00000130 / B SO1D 00000131 ** 00000132 *** ID,A**3=... */ 00000133 /SOORT3 SETVAL L,0,(+,ID$WORD,IDCODE,-,ALGEBR0,0,) 00000134 SETVAL IJ5,0,(+,IDCODE,0,+,NEXTW,0,) 00000135 : CMPVAL -IPR1-NR-,L,(+,-ID$WORD-NR-,IJ5,),NE,Z1IDT 00000136 / SET000 IPR1,L 00000137 / SET111 QUOT5,0 00000138 / B SO1D 00000139 ** 00000140 *** ID,J OR PDQ OR P(3)**5=... */ 00000141 /SOORT4 DOLOOP J,1,NDOTI,2,L0005,Z1IDT 00000142 / CMPVAL ISCAL,J,(+,ID$WORD,IDCODE,),NE,L0241 00000143 SETVAL II5,0,(+,J,0,+,1,0,) 00000144 SETVAL IJ5,0,(+,IDCODE,0,+,NEXTW,0,) 00000145 CMPVAL -ISCAL-NR-,II5,(+,-ID$WORD-NR-,IJ5,),NE,Z1IDT 00000146 SET000 ISCAL,II5 00000147 / SET111 QUOT5,0 00000148 / B SO1D 00000149 /L0241 ENDDO L0005,2 00000150 / B Z1IDT 00000151 ** 00000152 *** ID,P(J)=... */ 00000153 /SOORT5 SET000 ISWI1,0 00000154 CCALL Z9IDT FLAG 00000155 / B Z1IDT 00000156 ** 00000157 *** ID,P(J+)=... */ 00000158 /SOORT6 SET000 ISWI1,0 00000159 CCALL Z9IDT FLAG 00000160 / CMP000 FLAG,0,NE,SOORT6 00000161 / B Z1IDT 00000162 ** 00000163 *** ID,FUNCT,A=... ON F(A,-A) OR ID,ONCE,A**3=... */ 00000164 /SOORT7 CMPVAL IDNEXT,0,(+,IDCODE,0,+,NEXTW,0,),EQ,Z1IDX 00000165 / SETVAL L,0,(+,ID$WORD,IDCODE,-,ALGEBR0,0,) EXPONENT FOLLOWI 00000166 SETVAL IJ5,0,(+,IDCODE,0,+,NEXTW,0,) 00000167 LOAD 1,IPR1,L CAN BE NEGATIVE 00000168 SGNEXT RESULFX,0,-ID$WORD-NR-,IJ5 00000169 L 2,RESULFX 00000170 *** IF N1/N2 < 1 THEN GOTO Z1IDT; 00000171 LPR 4,1 00000172 LPR 5,2 00000173 XR 1,2 TEST IF SAME SIGN 00000174 SR 4,5 TEST IF SMALLER 00000175 OR 1,4 00000176 LTR 1,1 00000177 BL Z1IDT 00000178 / SETVAL IPR1,L,(+,IPR1,L,-,RESULFX,0,) 00000179 / SET111 QUOT5,0 00000180 / B SO1D 00000181 ** 00000182 *** ID,FUNCT,J OR PDQ OR P(3)=... OR ID,ONCE,J OR PDQ OR P(3)**5=.* 00000183 /SOORT8 CMPVAL IDNEXT,0,(+,IDCODE,0,+,NEXTW,0,),EQ,Z1IDX 00000184 / DOLOOP J,1,NDOTI,2,L0007,Z1IDT 00000185 / CMPVAL ISCAL,J,(+,ID$WORD,IDCODE,),NE,L0242 00000186 SETVAL II5,0,(+,J,0,+,1,0,) 00000187 SETVAL IJ5,0,(+,IDCODE,0,+,NEXTW,0,) 00000188 LOAD 1,ISCAL,II5 CAN BE NEGATIVE 00000189 SGNEXT RESULFX,0,-ID$WORD-NR-,IJ5 00000190 L 2,RESULFX 00000191 *** IF N1/N2 < 1 THEN GOTO Z1IDT; 00000192 LPR 4,1 00000193 LPR 5,2 00000194 XR 1,2 TEST IF SAME SIGN 00000195 SR 4,5 TEST IF SMALLER 00000196 OR 1,4 00000197 LTR 1,1 00000198 BL Z1IDT 00000199 SETVAL ISCAL,II5,(+,ISCAL,II5,-,RESULFX,0,) 00000200 / SET111 QUOT5,0 00000201 / B SO1D 00000202 /L0242 ENDDO L0007,2 00000203 / B Z1IDT 00000204 *** ID,FUNCT,QU=NEW ON F(QU,-QU) GIVES F(NEW,-NEW) */ 00000205 /Z1IDX CMP000 NEPS,0,EQ,Z1IDT 00000206 / SET000 FLAG,0 00000207 / DOLOOP J,1,NEPS,1,L0011,Z1IDT 00000208 / CMP000 FLAG,0,NE,L0243 00000209 CMPVAL -P$VAR-TYPE-,J,(+,FUNCT,0,),NE,Z1IDY 00000210 / SET111 FLAG,0 00000211 / B Z1IDY FIND BEGIN OF FUNCTION */ 00000212 /L0243 SETVAL FLAG,0,(+,P$VAR,J,-,FUNCT0,0,) FIND END OF FUNCTION 00000213 / SETVAL QUANT,0,(+,ANTHAU,0,+,EXPRES0,0,) 00000214 GETMIN P$VAR,J,Z2IDY 00000215 PUTMIN QUANT,0 00000216 /Z2IDY CMPVAL P$VAR,J,(+,ID$WORD,IDCODE,),NE,Z1IDY 00000217 / SETVAL P$WORD,J,(+,QUANT,0,) 00000218 /Z1IDY ENDDO L0011,+1 00000219 / B Z1IDT 00000220 ** 00000221 *** ID,ZERO OR 1 FU * ANYTHING ELSE =... */ 00000222 /SOORT9 SET000 ISWI1,0 00000223 CCALL Z9IDT FLAG 00000224 / B Z1IDT 00000225 ** 00000226 *** ID,F(NOT ALL DUMMIES) OR F+(ANYTHING) OR F(REPETITIVE DUMMIES)= * 00000227 /SOORT10 SET000 ISWI1,0 00000228 CCALL Z9IDT FLAG 00000229 / CMP000 FLAG,0,NE,SOORT10 00000230 / B Z1IDT 00000231 ** 00000232 *** ID,ADISO,... */ 00000233 /SOORT11 SET000 ISWI1,0 00000234 CCALL Z9IDT FLAG 00000235 / B Z1IDT 00000236 ** 00000237 *** ID,AINBE,... */ 00000238 SOORT12 SET111 ISWI1,0 00000239 CCALL Z9IDT FLAG 00000240 / B Z1IDT 00000241 ** 00000242 *** ID,F(...)*FF(...)*...=... */ 00000243 SOORT13 SETVAL ISWI1,0,(-,1,0,) 00000244 CCALL Z9IDT FLAG 00000245 / B Z1IDT 00000246 ** 00000247 ** 00000248 *** ID,DOTPR,P(M+)=. ON PDQ BECOMES DKEY Q RHS**ISCAL(J+1) */ 00000249 *** ON P(3) BECOMES DKEY 3 RHS**ISCAL(J+1) */ 00000250 /SOORT15 SETVAL L1,0,(+,ID$WORD,IDCODE,-,VECTOR0,0,) 00000251 / DOLOOP J,1,NDOTI,2,L0050,Z1IDT 00000252 / CMPVAL -ISCAL-TYPE-,J,(+,INDEX,0,),EQ,SO15A 00000253 SETVAL II5,0,(+,J,0,+,1,0,) 00000254 CMP000 ISCAL,II5,LE,SO15A 00000255 / CMPVAL -ISCAL-TYPE-,J,(+,DOTPR,0,),LT,L0254 00000256 / CMPVAL -ISCAL-VECT1-,J,(+,L1,0,),NE,L0277 00000257 SETVAL NEW5,0,(+,-ISCAL-VECT2-,J,+,VECTOR0,0,) 00000258 B SO15D 00000259 /L0277 CMPVAL -ISCAL-VECT2-,J,(+,L1,0,),NE,SO15A 00000260 SETVAL NEW5,0,(+,-ISCAL-VECT1-,J,+,VECTOR0,0,) 00000261 B SO15D 00000262 /L0254 CMPVAL -ISCAL-VECT1-,J,(+,L1,0,),NE,SO15A VECTNR*/ 00000263 SETVAL NEW5,0,(+,-ISCAL-VECT2-,J,+,NUMBER0,0,) 00000264 /SO15D SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000265 SETVAL P$WORD,NEPS,(+,DKEY,0,) 00000266 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000267 SETVAL P$WORD,NEPS,(+,NEW5,0,) 00000268 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000269 SETVAL P$EXPR,NEPS,(+,ANTHAU,0,) 00000270 SETVAL P$MULTP,NEPS,(+,ISCAL,II5,) 00000271 SET000 P$POINT,NEPS 00000272 / SET000 ISCAL,J 00000273 SET000 ISCAL,II5 00000274 / SET111 MARKER,0 00000275 /SO15A ENDDO L0050,2 00000276 / B Z1IDT 00000277 ** 00000278 *** ID,FUNCT,P(M+)=DOLLAR1 ON F(P) OR F(-P) BECOMES */ 00000279 *** F(N1) OR F(-N1) * DKEY N1 DOLLAR1 */ 00000280 /SOORT16 CMP000 NEPS,0,EQ,SOORT6 00000281 / SET000 FLAG,0 =1 FOR FU ARGS */ 00000282 / SETVAL L1,0,(+,ID$WORD,IDCODE,) 00000283 / DOLOOP J,1,NEPS,1,L0052,SOORT6 00000284 / CMP000 FLAG,0,NE,L0255 00000285 / CMPVAL -P$VAR-TYPE-,J,(+,FUNCT,0,),NE,S16C2 00000286 SET111 FLAG,0 00000287 / B S16C2 00000288 /L0255 SETVAL FLAG,0,(+,P$VAR,J,-,FUNCT0,0,) 00000289 / SETVAL L2,0,(+,P$VAR,J,) 00000290 / SETVAL QUANT,0,(+,NQX,0,) 00000291 / GETMIN L2,0,S16A1,S16C2 00000292 PUTMIN QUANT,0 00000293 /S16A1 CMPVAL L2,0,(+,L1,0,),NE,S16C2 00000294 / SETVAL NQX,0,(+,NQX,0,+,1,0,) CREATE NEW INDEX */ 00000295 / SET000 IPR,NQX 00000296 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000297 SETVAL P$WORD,NEPS,(+,DKEY,0,) 00000298 SETVAL P$WORD,J,(+,NQX,0,+,INDEX0,0,) 00000299 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000300 SETVAL P$WORD,NEPS,(+,NQX,0,+,INDEX0,0,) 00000301 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000302 SETVAL P$EXPR,NEPS,(+,ANTHAU,0,) 00000303 SET000 P$POINT,NEPS 00000304 SET111 P$MULTP,NEPS 00000305 / SET111 MARKER,0 00000306 /S16C2 ENDDO L0052,+1 00000307 / B SOORT6 00000308 ** 00000309 FOUTB1 ERROR 1,' ERROR IN SUBSTITUTION' 00000310 DROP 12 00000311 FFOUT 1,'MARTYN1' 00000312 *** 00000313 DS 0H 00000314 USING *,12 00000315 MARTYN1 EPI 00000316 *** 00000317 LTORG 00000318 TAB1 DC A(SOORT0,SOORT1,SOORT2,SOORT3,SOORT4,SOORT5,SOORT6,SOORT7) 00000319 DC A(SOORT8,SOORT9,SOORT10,SOORT11,SOORT12,SOORT13,FOUTB1) 00000320 DC A(SOORT15,SOORT16,FOUTB1,FOUTB1,FOUTB1,FOUTB1,FOUTB1) 00000321 DC A(FOUTB1,FOUTB1,FOUTB1,FOUTB1,FOUTB1,FOUTB1,FOUTB1,FOUTB1) 00000322 DC A(FOUTB1,FOUTB1) 00000323 ** 00000324 *** COMMANDS ... COMMANDS ... COMMANDS ... COMMANDS ... COMMANDS */ 00000325 DS 0H 00000326 USING *,12 00000327 COMMAND0 LOAD 1,ID$SOORT,IDCUR 00000328 SLA 1,2 00000329 L 2,=A(TAB2-32*NEXTW) 00000330 L 3,0(1,2) 00000331 BR 3 00000332 *** ID,ORTHG,Q1,P1,P2,P3 MAKES Q1DP1=Q1DP2=Q1DP3=0 */ 00000333 /SOORT32 CMP000 NDOTI,0,EQ,Z3IDT 00000334 / SETVAL L1,0,(+,-ID$WORD-NR-,IDCODE,) 00000335 /C32NO SETVAL IDCODE,0,(+,IDCODE,0,+,NEXTW,0,) 00000336 / CMPVAL IDNEXT,0,(+,IDCODE,0,),LE,Z3IDT 0 OR 1 VECTOR GIVEN* 00000337 / SETVAL L2,0,(+,-ID$WORD-NR-,IDCODE,) 00000338 L 1,L1 00000339 L 2,L2 00000340 CR 1,2 00000341 BNL L0054 00000342 SLA 1,5 00000343 B L0055 00000344 L0054 SLA 2,5 00000345 L0055 LA 3,DOTPR0(1,2) 00000346 ST 3,CODE5 00000347 DOLOOP J,1,NDOTI,2,L0056,C32NO 00000348 / CMPVAL ISCAL,J,(+,CODE5,0,),NE,L0256 00000349 SETVAL II5,0,(+,J,0,+,1,0,) 00000350 CMP000 ISCAL,II5,LT,C32NO 00000351 / SET000 IGET,0 00000352 B EXIT3 00000353 /L0256 ENDDO L0056,2 00000354 / B C32NO 00000355 ** 00000356 *** ID,ORTHN,P1,P2,P3 MAKES P1DP2=P1DP3=P2DP3=0 AND P1DP1= */ 00000357 *** P2DP2=P3DP3=1 */ 00000358 *** FLAG=1 IF L1=L2. THEN DOTPR=1 . FLAG=0 IF L1 NE L2. THEN DOTPR=0 */ 00000359 /SOORT33 CMP000 NDOTI,0,EQ,Z3IDT 00000360 /RT33S SETVAL L1,0,(+,-ID$WORD-NR-,IDCODE,) 00000361 / CMPVAL IDCODE,0,(+,IDNEXT,0,),GE,Z3IDT 00000362 / SET111 FLAG,0 00000363 / SETVAL K2,0,(+,IDCODE,0,) 00000364 / SETVAL IDCODE,0,(+,IDCODE,0,+,NEXTW,0,) 00000365 /C33NO SETVAL L2,0,(+,-ID$WORD-NR-,K2,) 00000366 / CMPVAL K2,0,(+,IDNEXT,0,),GE,RT33S 00000367 / SETVAL K2,0,(+,K2,0,+,NEXTW,0,) 00000368 L 1,L1 00000369 L 2,L2 00000370 CR 1,2 00000371 BNL L0060 00000372 SLA 1,5 00000373 B L0061 00000374 L0060 SLA 2,5 00000375 L0061 LA 3,DOTPR0(1,2) 00000376 ST 3,CODE5 00000377 DOLOOP J,1,NDOTI,2,L0062,TT33R 00000378 / CMPVAL ISCAL,J,(+,CODE5,0,),NE,L0257 00000379 SETVAL II5,0,(+,J,0,+,1,0,) 00000380 / CMP000 FLAG,0,EQ,L0302 00000381 SET000 ISCAL,J 00000382 SET000 ISCAL,II5 00000383 B TT33R 00000384 L0302 CMP000 ISCAL,II5,LT,TT33R 00000385 / SET000 IGET,0 00000386 B EXIT3 00000387 /L0257 ENDDO L0062,2 00000388 /TT33R SET000 FLAG,0 00000389 / B C33NO 00000390 ** 00000391 *** ID,ORDER,F,2,I1,I2 OR ORDER,I1,I2 */ 00000392 /SOORT34 CMP000 NEPS,0,LE,Z3IDT 00000393 / DOLOOP J,NEPS,1,-1,L0064,L0065 00000394 SETVAL II5,0,(+,J,0,+,1,0,) 00000395 SETVAL P$VAR,II5,(+,P$VAR,J,) MAKE 1 FREE WORD FOR STARTING 00000396 / ENDDO L0064,-1 POINTER 00000397 /L0065 SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000398 / SET000 P$WORD,1 00000399 / CMPVAL IDNEXT,0,(+,IDCODE,0,),EQ,Z3IDT 00000400 / SETVAL L1,0,(+,ID$WORD,IDCODE,) 00000401 / SET111 OLD5,0 (R) OF PREVIOUS FU IN CHAIN */ 00000402 / SET000 SELF5,0 (R) OF PREVIOUS OCCUR OF INDEX */ 00000403 / SET000 J,0 (R) OF CURRENT INDEX */ 00000404 / CMPVAL -L1-TYPE-,0,(+,FUNCT,0,),NE,S34D 00000405 SETVAL IJ5,0,(+,IDCODE,0,+,NEXTW,0,) 00000406 : SETVAL L2,0,(+,ID$WORD,IJ5,) ARGNR 00000407 /S34B SETVAL J,0,(+,J,0,+,1,0,) 00000408 / CMPVAL J,0,(+,NEPS,0,),GT,Z3IDT 00000409 / CMPVAL P$VAR,J,(+,L1,0,),NE,S34B 00000410 ** /* FIND INDEX CORRESPONDING TO FU,NR */ 00000411 / CMPVAL -L2-TYPE-,0,(+,NUMBER,0,),NE,S34J ERROR MESSAGE */ 00000412 ** /* MUST BE FU,NR,I1,I2... */ 00000413 SETVAL II5,0,(+,J,0,+,1,0,) 00000414 SETVAL IJ5,0,(+,J,0,+,-L2-NR-,0,) 00000415 DOLOOP JJ,II5,IJ5,1,L0066,L0067 00000416 / CMPVAL P$VAR,JJ,(+,FUNCT0,0,),NE,L0260 00000417 / SETVAL J,0,(+,JJ,0,) NOT ENOUGH ARGS */ 00000418 / B S34B RESTART */ 00000419 /L0260 ENDDO L0066,1 00000420 /L0067 SETVAL J,0,(+,J,0,+,-L2-NR-,0,) 00000421 / SETVAL SELF5,0,(+,J,0,) 00000422 / B S34F 00000423 /S34DD SETVAL L1,0,(+,P$VAR,SELF5,) RESTART WITH ADJACENT INDEX * 00000424 / SET000 J,0 00000425 /S34D SETVAL J,0,(+,J,0,+,1,0,) OCCURENCE OF THE INDEX AT J */ 00000426 / CMPVAL J,0,(+,NEPS,0,),GT,S34I 00000427 / CMPVAL P$VAR,J,(+,L1,0,),NE,S34D 00000428 / CMP111 OLD5,0,EQ,S34F JP IF FIRST TIME */ 00000429 / CMPVAL J,0,(+,SELF5,0,),EQ,S34D EXCLUDE LINK BACK TO START* 00000430 /S34F SETVAL END5,0,(+,J,0,) 00000431 /S34G SETVAL END5,0,(+,END5,0,+,1,0,) 00000432 / CMPVAL P$VAR,END5,(+,FUNCT0,0,),NE,S34G 00000433 ** /* FIND END OF FU. CHECK IF ALREADY IN CHAIN */ 00000434 / CMP000 P$POINT,END5,NE,S34I 00000435 / SETVAL BEGIN5,0,(+,J,0,) 00000436 /S34H SETVAL BEGIN5,0,(+,BEGIN5,0,-,1,0,) 00000437 / CMPVAL -P$WORD-TYPE-,BEGIN5,(+,FUNCT,0,),NE,S34H 00000438 ** /* FIND BEGIN OF FU AND POINT TO IT. */ 00000439 / SETVAL P$POINT,OLD5,(+,BEGIN5,0,) 00000440 / SETVAL OLD5,0,(+,END5,0,) 00000441 / SETVAL SELF5,0,(+,J,0,+,1,0,) 00000442 / CMPVAL -P$WORD-TYPE-,SELF5,(+,INDEX,0,),EQ,S34DD 00000443 / SETVAL SELF5,0,(+,J,0,-,1,0,) 00000444 / CMPVAL -P$WORD-TYPE-,SELF5,(+,INDEX,0,),EQ,S34DD 00000445 /S34I SETVAL IDCODE,0,(+,IDCODE,0,+,NEXTW,0,) TAKE NEXT INDEX IN 00000446 / SET000 J,0 00000447 / SETVAL L1,0,(+,ID$WORD,IDCODE,) 00000448 / CMPVAL IDNEXT,0,(+,IDCODE,0,),GT,S34D 00000449 / CMP111 OLD5,0,EQ,Z3IDT NO REORDERING */ 00000450 / SET111 P$POINT,OLD5 00000451 / SET111 MARKER,0 00000452 B Z3IDT 00000453 SOORT35 EQU SOORT34 00000454 ** 00000455 *** ID,SYMXX,F1,1,2,F2,3,5 ORDER ARGS */ 00000456 /SOORT36 SET000 FLAG,0 00000457 / B SOORD37 00000458 ** 00000459 *** ID,ASYMX,F1,1,2,F2,3,5 ORDER ARGS */ 00000460 /SOORT37 SET111 FLAG,0 00000461 /SOORD37 SET111 SIGN5,0 00000462 /SOORE37 CMPVAL IDCODE,0,(+,IDNEXT,0,),GE,END37 00000463 / SETVAL L1,0,(+,ID$WORD,IDCODE,) 00000464 / SETVAL IDCODE,0,(+,IDCODE,0,+,NEXTW,0,) FIND NEXT FU OF COM 00000465 / CMPVAL -L1-TYPE-,0,(+,FUNCT,0,),NE,SOORE37 00000466 / DOLOOP J,1,NEPS,1,L0070,SOORE37 00000467 / CMPVAL P$VAR,J,(+,L1,0,),EQ,SOORF37 00000468 /SOORA37 ENDDO L0070,+1 00000469 / B SOORE37 00000470 SOORF37 SETVAL K1,0,(+,IDCODE,0,) 00000471 /SOORB37 CMPVAL -ID$WORD-TYPE-,K1,(+,NUMBER,0,),NE,SOORA37 00000472 ** /* FUNCTION IS FOUND */ 00000473 : SETVAL J1,0,(+,J,0,+,-ID$WORD-NR-,K1,) LOOK AT ARGS 00000474 / SETVAL K2,0,(+,K1,0,+,NEXTW,0,) 00000475 /SOORC37 CMPVAL -ID$WORD-TYPE-,K2,(+,NUMBER,0,),EQ,L0072 00000476 / SETVAL K1,0,(+,K1,0,+,NEXTW,0,) 00000477 / B SOORB37 00000478 :L0072 SETVAL J2,0,(+,J,0,+,-ID$WORD-NR-,K2,) 00000479 / SETVAL K2,0,(+,K2,0,+,NEXTW,0,) 00000480 LOAD 1,P$VAR,J1 00000481 LOAD 2,P$VAR,J2 00000482 CR 1,2 00000483 BH SOORC37 00000484 STORE 1,P$VAR,J2 EXCHANGE 00000485 STORE 2,P$VAR,J1 00000486 / SETVAL SIGN5,0,(-,SIGN5,0,) 00000487 CR 1,2 00000488 BNE SOORC37 00000489 / CMP000 FLAG,0,EQ,SOORC37 00000490 / SET000 IGET,0 CASE OF ASYMX */ 00000491 B EXIT3 00000492 /END37 CMP000 FLAG,0,EQ,Z3IDT 00000493 L 2,SIGN5 00000494 SRA 2,31 00000495 SLA 2,31 00000496 X 2,IGET 00000497 ST 2,IGET IGET=IGET*SIGN5 00000498 B Z3IDT 00000499 ** 00000500 *** ID,COUNT,VAR,QU,NR,QU,NR,... */ 00000501 SOORT40 CCALL COU38 WEIGHT5 00000502 / SETVAL L1,0,(+,ID$WORD,IDCODE,) 00000503 / CMPVAL -L1-TYPE-,0,(+,NUMBER,0,),NE,L0073 00000504 SGNEXT L1,0,-L1-NR-,0 00000505 / CMPVAL WEIGHT5,0,(+,L1,0,),GE,Z3IDT 00000506 / SET000 IGET,0 00000507 B EXIT3 00000508 /L0073 CMPVAL -L1-TYPE-,0,(+,FUNCT,0,),NE,L0074 00000509 S40E L 1,WEIGHT5 IF ABS(WEIGHT) GT 128 GOTO ERROR 00000510 LPR 1,1 00000511 SRA 1,7 00000512 LTR 1,1 00000513 BH S40F 00000514 ** /* WRONG FORMAT OR TOO LARGE NUMBER */ 00000515 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000516 SETVAL P$WORD,NEPS,(+,L1,0,) 00000517 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000518 SETVAL -P$VAR-TYPE-,NEPS,(+,NUMBER,0,) 00000519 SETVAL -P$VAR-NR-,NEPS,(+,WEIGHT5,0,) 00000520 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000521 SETVAL P$WORD,NEPS,(+,FUNCT0,0,) 00000522 B Z3IDT 00000523 /L0074 CMPVAL -L1-TYPE-,0,(+,ALGEBR,0,),NE,L0075 00000524 SETVAL II5,0,(+,-L1-NR-,0,) 00000525 SETVAL IPR1,II5,(+,IPR1,II5,+,WEIGHT5,0,) 00000526 B Z3IDT 00000527 /L0075 CMPVAL -L1-TYPE-,0,(+,EXPRES,0,),NE,L0076 00000528 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000529 SETVAL P$WORD,NEPS,(+,DD,0,) 00000530 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000531 SETVAL P$WORD,NEPS,(+,STANDX,0,) 00000532 / SET111 MARKER,0 00000533 / B S40E 00000534 /L0076 CMPVAL -L1-TYPE-,0,(+,INDEX,0,),EQ,S40G 00000535 / CMPVAL -L1-TYPE-,0,(+,DOTPR,0,),GE,S40G 00000536 / CMPVAL -L1-TYPE-,0,(+,VECTNR,0,),LT,S40F ERROR. WRONG FORMA 00000537 /S40G DOLOOP J,1,NDOTI,2,L0077,L0100 00000538 / CMPVAL ISCAL,J,(+,L1,0,),NE,L0261 00000539 SETVAL II5,0,(+,J,0,+,1,0,) 00000540 SETVAL ISCAL,II5,(+,ISCAL,II5,+,WEIGHT5,0,) 00000541 B Z3IDT 00000542 /L0261 ENDDO L0077,2 00000543 /L0100 SETVAL NDOTI,0,(+,NDOTI,0,+,1,0,) 00000544 SETVAL ISCAL,NDOTI,(+,L1,0,) 00000545 / SETVAL NDOTI,0,(+,NDOTI,0,+,1,0,) 00000546 SETVAL ISCAL,NDOTI,(+,WEIGHT5,0,) 00000547 B Z3IDT 00000548 ** 00000549 *** ID,EVENX,F1,1,2,3,F2,4 REMOVE MINUS FROM ARGS */ 00000550 /SOORT42 SET000 FLAG,0 00000551 CCALL SO42A FLAG,SIGN5,DUMMM,DUMMM 00000552 B Z3IDT 00000553 ** 00000554 *** ID,ODDXX,F1,1,2,3,F2,4 REMOVE MINUS FROM ARGS */ 00000555 /SOORT43 SET000 FLAG,0 00000556 SET111 SIGN5,0 00000557 CCALL SO42A FLAG,SIGN5,DUMMM,DUMMM 00000558 / CMP000 SIGN5,0,GE,Z3IDT 00000559 / NEGATE IGET,0 00000560 B Z3IDT 00000561 ** 00000562 *** ID,REPLA,A1,A1,F1,1,2,F2,2,4 */ 00000563 /SOORT44 SET111 FLAG,0 00000564 SETVAL SYMBOL1,0,(+,ID$WORD,IDCODE,) 00000565 SETVAL IDCODE,0,(+,IDCODE,0,+,NEXTW,0,) 00000566 SETVAL SYMBOL2,0,(+,ID$WORD,IDCODE,) 00000567 SETVAL IDCODE,0,(+,IDCODE,0,+,NEXTW,0,) 00000568 CCALL SO42A FLAG,SIGN5,SYMBOL1,SYMBOL2 00000569 B Z3IDT 00000570 ** 00000571 *** ID,NUMER,QU,VAL,QU,VAL,... */ 00000572 /SOORT48 CMPVAL IDCODE,0,(+,IDNEXT,0,),GE,Z3IDT 00000573 / SETVAL K1,0,(+,IDCODE,0,) 00000574 : SETVAL IDCODE,0,(+,IDCODE,0,+,NEXTW,0,+,LFLOAT,0,) 00000575 / CMP000 ID$WORD,K1,EQ,FOUTB3 00000576 / CMPVAL -ID$WORD-TYPE-,K1,(+,ALGEBR,0,),NE,DOT48 00000577 / SETVAL L1,0,(+,-ID$WORD-NR-,K1,) 00000578 / CMP000 IPR1,L1,EQ,SOORT48 00000579 SETVAL K1,0,(+,K1,0,+,NEXTW,0,) 00000580 *** IF IDGEH(K1).FLOAT EQ 0 THEN GOTO L0213 00000581 L 1,K1 00000582 LE 0,0(1) 00000583 LTER 0,0 00000584 BE L0213 00000585 / SETVAL L2,0,(+,IPR1,L1,) 00000586 / SET000 IPR1,L1 00000587 / B AL48 00000588 /L0213 CMP000 IPR1,L1,LT,SOORT48 00000589 / SET000 IGET,0 00000590 B EXIT3 00000591 AL48 L 1,K1 00000592 MVC NRFLOAT(LFLOAT),0(1) 00000593 PBRIAN IGET,0,NRFLOAT,0,L2 00000594 / B SOORT48 00000595 /DOT48 DOLOOP J,1,NDOTI,2,L0214,SOORT48 00000596 / CMPVAL ISCAL,J,(+,ID$WORD,K1,),NE,DTO48 00000597 SETVAL II5,0,(+,J,0,+,1,0,) 00000598 CMP000 ISCAL,II5,EQ,DTO48 00000599 SETVAL K1,0,(+,K1,0,+,NEXTW,0,) 00000600 *** IF IDGEH(K1).FLOAT EQ 0 THEN GOTO L0272 00000601 L 1,K1 00000602 LE 0,0(1) 00000603 LTER 0,0 00000604 BE L0272 00000605 : SETVAL L2,0,(+,ISCAL,II5,) 00000606 / SET000 ISCAL,J 00000607 SET000 ISCAL,II5 00000608 / B AL48 00000609 /L0272 CMP000 ISCAL,J,LT,SOORT48 00000610 / SET000 IGET,0 00000611 B EXIT3 00000612 /DTO48 ENDDO L0214,2 00000613 / B SOORT48 00000614 ** 00000615 *** ID,IFGRE,VALUE,ALGEBRA */ 00000616 SOORT50 CCALL SO50A FLAG 00000617 / CMP000 FLAG,0,LE,Z3IDT 00000618 SO50D SETVAL IJ5,0,(+,IDCODE,0,+,LFLOAT,0,) 00000619 SETVAL L1,0,(+,ID$WORD,IJ5,) 00000620 / CMPVAL -L1-TYPE-,0,(+,ALGEBR,0,),NE,FOUTB3 00000621 SETVAL L1,0,(+,-L1-NR-,0,) 00000622 / SETVAL IPR1,L1,(+,IPR1,L1,+,1,0,) 00000623 B Z3IDT 00000624 ** 00000625 *** ID,IFEQU,VALUE,ALGEBRA */ 00000626 SOORT51 CCALL SO50A FLAG 00000627 / CMP000 FLAG,0,EQ,SO50D 00000628 B Z3IDT 00000629 ** 00000630 *** ID,IFSMA,VALUE,ALGEBRA */ 00000631 SOORT52 CCALL SO50A FLAG 00000632 / CMP000 FLAG,0,LT,SO50D 00000633 B Z3IDT 00000634 ** 00000635 *** ID,EXPAND,FIA */ 00000636 SOORT53 LADR 1,P$VAR,J 00000637 B Z3IDT COMMAND NOT TESTED. 00000638 L 2,IDCODE 00000639 MVC NAME5(LNAME$),0(2) 00000640 DOLOOP J,1,NEPS,1,L0217,Z3IDT 00000641 CLC NEXTW(1,1),0(2) COMPARE NAME 00000642 BNE S53A 00000643 CLC 2*NEXTW(1,1),1(2) 00000644 BNE S53A 00000645 CLC 3*NEXTW(1,1),2(2) 00000646 BNE S53A 00000647 CLC 4*NEXTW(1,1),3(2) 00000648 BNE S53A 00000649 CLC 5*NEXTW(1,1),4(2) 00000650 BE S53B 00000651 /S53A ENDDO L0217,+1 00000652 B Z3IDT 00000653 /S53B SET000 P$WORD,J 00000654 SETVAL J,0,(+,J,0,+,1,0,) 00000655 / SET000 P$WORD,J 00000656 SETVAL J,0,(+,J,0,+,1,0,) 00000657 / SET000 P$WORD,J 00000658 SETVAL J,0,(+,J,0,+,1,0,) 00000659 / SET000 P$WORD,J 00000660 SETVAL J,0,(+,J,0,+,1,0,) 00000661 / SET000 P$WORD,J 00000662 SETVAL J,0,(+,J,0,+,1,0,) 00000663 LOAD 1,-P$VAR-NR-,J 00000664 SETVAL II5,0,(+,J,0,+,1,0,) 00000665 LOAD 2,-P$VAR-NR-,II5 00000666 SLA 1,8 00000667 AR 1,2 00000668 ST 1,INDEX5 INDEX WITH WHICH FIA OCCURS IN IEP. 00000669 SETVAL P$VAR,II5,(+,SKEY,0,) IN FRONT OF ACTUAL PARAMETERS 00000670 / SET111 MARKER,0 00000671 / DOLOOP K,1,NXEX,1,L0221,FOUTB4 00000672 : CMPNAM X$NAME,K,NAME5,0,EQ,S53C 00000673 / ENDDO L0221,+1 00000674 B FOUTB4 00000675 /S53C SETVAL L2,0,(+,X$LOCNR,K,) 00000676 / CMP000 L2,0,EQ,FOUTB4 00000677 / CMP000 L$AKEY,L2,EQ,FOUTB4 00000678 SETVAL P$EXPR,J,(+,L$AKEY,L2,) POINTS TO NAMELIST 00000679 SET111 P$MULTP,J 00000680 SET000 P$POINT,J 00000681 ** /* CREATED IN MEMORY BY NAMES FIA CARD */ 00000682 SETVAL J,0,(+,J,0,+,1,0,) 00000683 / DOLOOP K,J,NEPS,1,L0223,FOUTB4 00000684 CMPVAL P$VAR,K,(+,FUNCT0,0,),EQ,S53D 00000685 / ENDDO L0223,+1 00000686 B FOUTB4 00000687 ** /* MINIMIZE TAPE READING BY REMEMBERING RECORDNR OF */ 00000688 ** /* FIA(INDEX5) IN HULP1C */ 00000689 /S53D CMPNAM HULPNAME,0,NAME5,0,NE,S53E 00000690 / CMPVAL HULPINDX,0,(+,INDEX5,0,),EQ,S53F 00000691 S53E SETNAM HULPNAME,0,NAME5,0 00000692 / SETVAL HULPINDX,0,(+,INDEX5,0,) 00000693 / PTAKMAN NTAP7,HULPNAME,HULP1C,SEAR0 00000694 *** TAPE FORMAT NOT YET KNOWN 00000695 /S53F SET000 L$PROP,MBU 00000696 / SETBIT L$PROP,MBU,COMON,ON 00000697 / SETBIT L$PROP,MBU,FILE,ON 00000698 / SETBIT L$PROP,MBU,TAPE,ON 00000699 SET000 L$AKEY,MBU 00000700 SET000 L$RCTOT,MBU 00000701 / SETVAL L$RCNAM,MBU,(+,HULP1C,0,) 00000702 / SET111 P$MULTP,K 00000703 / SETVAL P$EXPR,K,(+,MBU,0,) 00000704 / SET000 P$POINT,K 00000705 / SETVAL MBU,0,(+,MBU,0,+,1,0,) 00000706 *** 00000707 Z3IDT JUMP Z1IDT 00000708 EXIT3 JUMP XMARTYN1 00000709 FOUTB3 ERROR 2,' ERROR IN COMMAND' 00000710 FOUTB4 ERROR 2,' IMPOSSIBLE TO EXPAND' 00000711 S34J ERROR 2,' MUST BE NR,I1,I2...' 00000712 S40F ERROR 2,' WRONG FORMAT OR TOO LARGE NR' 00000713 DROP 12 00000714 FFOUT 2,'COMMANDS' 00000715 LTORG 00000716 TAB2 DC A(SOORT32,SOORT33,SOORT34,SOORT35,SOORT36) 00000717 DC A(SOORT37,FOUTB3,SOORT39,SOORT40,SOORT41,SOORT42,SOORT43) 00000718 DC A(SOORT44,SOORT45,FOUTB3,FOUTB3,SOORT48,FOUTB3,SOORT50) 00000719 DC A(SOORT51,SOORT52,SOORT53,SOORT54,FOUTB3,FOUTB3,FOUTB3) 00000720 DC A(FOUTB3,FOUTB3,FOUTB3,FOUTB3,FOUTB3,FOUTB3) 00000721 *** 00000722 *** 00000723 *** 00000724 *** TRY TO MATCH GENERAL LHS IN IDGEH WITH CONTENT OF IEP,IPR,ISCAL,..* 00000725 *** LHS HAS (NON)COMMUTING FUS IN IT. THE TESTROUND CHECKS IF ALL */ 00000726 *** QUANTS ARE AVAILABLE AND TRIES TO SET UP A CONSISTENT DUMMY TABLE.* 00000727 *** IN THE REPLACEMENT ROUND, THE QUS ARE ZEROED AND THE RHS IS */ 00000728 *** CONSTRUCTED */ 00000729 /Z9IDT PRO FLAG 00000730 / SET000 NDUMY,0 00000731 / SET000 ROUND5,0 =0 FOR TESTROUND. =1 FOR REPLACEMENT */ 00000732 /NXROUND SET000 COMM1,0 00000733 / SET000 DEPTH,0 00000734 / SETVAL K,0,(+,IDCODE,0,-,NEXTW,0,) 00000735 /NXFACT SETVAL K,0,(+,K,0,+,NEXTW,0,) 00000736 / CMPVAL IDNEXT,0,(+,K,0,),LE,EIND9A 00000737 ** /* INSPECT LHS IN IDGEH. START NEXT FACTOR. */ 00000738 / SETVAL L1,0,(+,-ID$WORD-TYPE-,K,) 00000739 / CMPVAL L1,0,(+,DUMMY,0,),EQ,SEFU9 DUMMY FUNCTION */ 00000740 / CMPVAL L1,0,(+,VECTOR,0,),EQ,SEV9 00000741 / CMPVAL L1,0,(+,OPERAT,0,),EQ,FOUTB2 00000742 / CMPVAL L1,0,(+,ALGEBR,0,),EQ,SEA9 00000743 / CMPVAL L1,0,(+,EXPRES,0,),EQ,FOUTB2 00000744 / CMPVAL L1,0,(+,FUNCT,0,),EQ,SEFU9 00000745 / CMPVAL L1,0,(+,NUMBER,0,),EQ,FOUTB2 00000746 / B SEDA9 CASE OF INDEX,DOTPR,VECTNR */ 00000747 /NOMATCH CMP000 ROUND5,0,NE,FOUTB2 NOMATCH. MUST OCCUR */ 00000748 / SET000 FLAG,0 IN TESTROUND */ 00000749 / CMP000 SE9VL,0,EQ,XZ9IDT 00000750 / SET000 SE9VL,0 00000751 / DOLOOP J,1,NQX,1,L0013,XZ9IDT 00000752 LADR 1,IPR,J 00000753 TM 0(1),X'80' SIGN FLAG FROM ODDINDX=FIRST BIT 00000754 BO L0245 00000755 NI 0(1),X'BF' USED FLAG IS SECOND BIT 00000756 /L0245 ENDDO L0013,+1 00000757 B XZ9IDT 00000758 /EIND9A CMP000 ROUND5,0,NE,OK9 END TESTROUND*/ 00000759 / SET111 ROUND5,0 00000760 / CMP000 SE9VL,0,EQ,NXROUND GO BACK FOR REPLACMT*/ 00000761 / SET000 SE9VL,0 00000762 / DOLOOP J,1,NQX,1,L0015,NXROUND 00000763 LADR 1,IPR,J 00000764 TM 0(1),X'80' SIGN FLAG FROM ODDINDX=FIRST BIT 00000765 BO L0246 00000766 NI 0(1),X'BF' USED FLAG IS SECOND BIT 00000767 /L0246 ENDDO L0015,+1 00000768 / B NXROUND 00000769 /OK9 DOLOOP K1,1,DEPTH,1,L0017,L0020 END OF REPLACEMENT ROUND */ 00000770 SETVAL II5,0,(+,ISWIH1,K1,) 00000771 STM 7,9,LOOPVAR1 00000772 DOLOOP J,II5,NEPS,1,L0247,OK9C DELETE MATCHED FUNCTIONS 00000773 / CMPVAL P$VAR,J,(+,FUNCT0,0,),NE,L0275 00000774 SET000 P$WORD,J 00000775 B OK9C RESTART FOR NEXT FUNCTION 00000776 /L0275 SET000 P$WORD,J 00000777 / ENDDO L0247,+1 00000778 OK9C LM 7,9,LOOPVAR1 00000779 / ENDDO L0017,+1 00000780 /L0020 SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000781 / CMP000 DEPTH,0,EQ,L0021 00000782 SETVAL II5,0,(+,ISWIH1,DEPTH,) 00000783 SETVAL P$POINT,II5,(+,NEPS,0,) 00000784 ** /* LINK FIRST SUBSTITUTED FU TO RHS. THERE IS NOT NECESSAR */ 00000785 ** /* ENOUGH ROOM AT FIRST FU FOR ALL DUMMIES. BEHIND NEPS IS */ 00000786 ** /* BUILT DKEY V1 V2 V3 ... EXPR JPBACK */ 00000787 /L0021 SETVAL P$WORD,NEPS,(+,DKEY,0,) 00000788 / DOLOOP J,1,NDUMY,1,L0022,L0023 00000789 SETVAL II5,0,(+,NEPS,0,+,J,0,) 00000790 SETVAL P$WORD,II5,(+,IDUM1,J,) 00000791 / ENDDO L0022,+1 00000792 /L0023 SETVAL NEPS,0,(+,NEPS,0,+,NDUMY,0,+,1,0,) 00000793 / SETVAL P$EXPR,NEPS,(+,ANTHAU,0,) 00000794 / SET111 P$MULTP,NEPS 00000795 / SET000 P$POINT,NEPS 00000796 / CMP000 DEPTH,0,EQ,L0024 00000797 SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000798 SET000 P$VAR,NEPS 00000799 / SETVAL P$POINT,NEPS,(+,ISWIH1,DEPTH,+,1,0,) 00000800 /L0024 SET111 MARKER,0 00000801 / SET111 FLAG,0 00000802 B XZ9IDT 00000803 ** 00000804 /SEV9 SETVAL L1,0,(+,ID$WORD,K,) VECTOR */ 00000805 / SETVAL K,0,(+,K,0,+,NEXTW,0,) 00000806 / SETVAL L2,0,(+,ID$WORD,K,) DUMMY OR VECTOR */ 00000807 / CMPVAL -L2-TYPE-,0,(+,DUMMY,0,),EQ,SEV9D 00000808 / CMPVAL -L2-TYPE-,0,(+,INDEX,0,),NE,NOMATCH VECTOR(INDEX) */ 00000809 SETVAL II5,0,(+,-L2-NR-,0,) 00000810 CMPVAL IPR,II5,(+,L1,0,),NE,NOMATCH 00000811 / CMP000 ROUND5,0,EQ,NXFACT 00000812 SET000 IPR,II5 00000813 / B NXFACT 00000814 /SEV9D DOLOOP J,1,NQX,1,L0026,NOMATCH VECTOR(DUMMY) */ 00000815 / CMPVAL IPR,J,(+,L1,0,),NE,L0251 00000816 / SETVAL DUMNR,0,(+,L2,0,-,DUMMY0,0,) 00000817 / SETVAL DUMVAL,0,(+,INDEX0,0,+,J,0,) 00000818 BAL 14,DUIN9 FLAG 00000819 / CMP000 FLAG,0,NE,FOUTB2 00000820 / CMP000 ROUND5,0,EQ,L0276 00000821 SET000 IPR,J 00000822 B NXFACT 00000823 L0276 LADR 1,IPR,J 00000824 OI 0(1),X'40' SET USED FLAG ON 00000825 / SET111 SE9VL,0 00000826 / B NXFACT 00000827 /L0251 ENDDO L0026,+1 00000828 / B NOMATCH 00000829 ** 00000830 /SEA9 SETVAL L1,0,(+,ID$WORD,K,-,ALGEBR0,0,) ALGEBRA */ 00000831 / CMP000 IPR1,L1,EQ,NOMATCH 00000832 / SETVAL K,0,(+,K,0,+,NEXTW,0,) 00000833 / SETVAL L2,0,(+,ID$WORD,K,) EXPONENT */ 00000834 / CMPVAL -L2-TYPE-,0,(+,NUMBER,0,),NE,SEA8 00000835 SGNEXT RESULFX,0,-L2-NR-,0 00000836 / CMPVAL IPR1,L1,(+,RESULFX,0,),EQ,D9OGC MATCH */ 00000837 / B NOMATCH 00000838 /SEA8 CMPVAL -L2-TYPE-,0,(+,DUMMY,0,),NE,NOMATCH 00000839 / SETVAL DUMNR,0,(+,L2,0,-,DUMMY0,0,) 00000840 / SETVAL -DUMVAL-NR-,0,(+,IPR1,L1,) 00000841 / SETVAL -DUMVAL-TYPE-,0,(+,NUMBER,0,) 00000842 BAL 14,DUIN9 FLAG 00000843 / CMP000 FLAG,0,NE,RET9R CASE OF CONFLICT */ 00000844 /D9OGC CMP000 ROUND5,0,EQ,NXFACT 00000845 / SET000 IPR1,L1 REPLACE IF NOT TESTROUND*/ 00000846 / B NXFACT 00000847 ** 00000848 /SEDA9 SETVAL L1,0,(+,ID$WORD,K,) INDEX,VECTNR,DOTPR */ 00000849 / SETVAL K,0,(+,K,0,+,NEXTW,0,) 00000850 / SETVAL L2,0,(+,ID$WORD,K,) ITS EXPONENT */ 00000851 / DOLOOP J,1,NDOTI,2,L0031,NOMATCH 00000852 / CMPVAL ISCAL,J,(+,L1,0,),NE,L0252 00000853 SETVAL II5,0,(+,J,0,+,1,0,) 00000854 CMP000 -ISCAL-NR-,II5,EQ,NOMATCH 00000855 CMPVAL L2,0,(+,-ISCAL-NR-,II5,+,NUMBER0,0,),EQ,D9OGB 00000856 / CMPVAL -L2-TYPE-,0,(+,DUMMY,0,),NE,NOMATCH 00000857 / SETVAL DUMNR,0,(+,L2,0,-,DUMMY0,0,) 00000858 SETVAL -DUMVAL-NR-,0,(+,ISCAL,II5,) 00000859 SETVAL -DUMVAL-TYPE-,0,(+,NUMBER,0,) 00000860 BAL 14,DUIN9 FLAG 00000861 / CMP000 FLAG,0,NE,RET9R 00000862 / B D9OGB 00000863 /L0252 ENDDO L0031,2 00000864 / B NOMATCH 00000865 /D9OGB CMP000 ROUND5,0,EQ,NXFACT 00000866 / SET000 ISCAL,J 00000867 SET000 ISCAL,II5 00000868 / B NXFACT 00000869 ** 00000870 /SEFU9 SETVAL L1,0,(+,ID$WORD,K,) FUNCTION */ 00000871 / SETVAL NDUM5,0,(+,NDUMY,0,) 00000872 / SETVAL J,0,(+,COMM1,0,) 00000873 / CMP000 DEPTH,0,NE,L0034 00000874 / SET000 NCOMUT5,0 00000875 / B SEF9A 00000876 /L0034 SETVAL NCOMUT5,0,(+,ISWI1,0,) 00000877 ** /* FIRST FU IS ALWAYS CONSIDERED AS COMMUTING */ 00000878 /SEF9A CMPVAL -L1-TYPE-,0,(+,DUMMY,0,),EQ,SEF9I 00000879 /SEF9B SETVAL J,0,(+,J,0,+,1,0,) SEARCH NEXT FU IN IEP */ 00000880 / CMPVAL J,0,(+,NEPS,0,),GT,RET9R 00000881 / CMP000 P$VAR,J,EQ,SEF9B 00000882 / CMPVAL P$VAR,J,(+,L1,0,),EQ,HEF9U 00000883 / CMP000 NCOMUT5,0,LT,RET9R MUST BE ADJACENT FU */ 00000884 / B SEF9B 00000885 /HEF9U DOLOOP JJ,DEPTH,1,-1,L0036,L0037 FU IN IEP FOUND */ 00000886 ** /* DO NOT MATCH TWICE WITH SAME FU. ALL ELEMENTS OF ISWIH1 */ 00000887 ** /* MUST BE DIFFERENT. */ 00000888 / CMPVAL ISWIH1,JJ,(+,J,0,),NE,L0253 00000889 / CMP000 NCOMUT5,0,GE,SEF9A 00000890 / B RET9R 00000891 /L0253 ENDDO L0036,-1 00000892 /L0037 SETVAL KK,0,(+,K,0,) BEGIN IN IDGEH OF MATCHING FUNCTIONS * 00000893 / SETVAL J2,0,(+,J,0,) BEGIN IN IEP OF MATCHING FUNCTIONS */ 00000894 /HE9FU SETVAL KK,0,(+,KK,0,+,NEXTW,0,) 00000895 / SETVAL J2,0,(+,J2,0,+,1,0,) COMPARE FU ARGS IN IEP WITH FU 00000896 / CMPVAL -ID$WORD-TYPE-,KK,(+,DUMMY,0,),NE,L0040 00000897 / SETVAL DUMVAL,0,(+,P$VAR,J2,) 00000898 / SETVAL DUMNR,0,(+,ID$WORD,KK,-,DUMMY0,0,) 00000899 BAL 14,DUIN9 FLAG 00000900 / CMP000 FLAG,0,NE,SEF9F 00000901 / B HE9FU 00000902 /L0040 CMPVAL ID$WORD,KK,(+,P$VAR,J2,),NE,SEF9F 00000903 / CMPVAL P$VAR,J2,(+,FUNCT0,0,),NE,HE9FU 00000904 ** /* A MATCH OF FUNCTION IN IEP WITH FU IN IDGEH OCCURRED */ 00000905 / CMP000 ISWI1,0,NE,L0041 00000906 / SET000 COMM1,0 ADISO */ 00000907 / B L0042 00000908 /L0041 SETVAL COMM1,0,(+,J2,0,) 00000909 /L0042 SETVAL DEPTH,0,(+,DEPTH,0,+,1,0,) 00000910 / SETVAL ISWIH2,DEPTH,(+,K,0,) PLACE IN IDGEH OF START OF FU 00000911 / SETVAL ISWIH4,DEPTH,(+,NDUM5,0,) 00000912 / SETVAL ISWIH1,DEPTH,(+,J,0,) PLACE IN IEP OF START OF FU */ 00000913 / CMPVAL DEPTH,0,(+,5,0,),GT,FOUTB2 00000914 / SETVAL K,0,(+,KK,0,) 00000915 / B NXFACT 00000916 /SEF9F SETVAL NDUMY,0,(+,NDUM5,0,) FAILURE. TRY AGAIN AT SAME DEPT 00000917 / SETVAL J,0,(+,J2,0,) 00000918 / SETVAL NCOMUT5,0,(+,ISWI1,0,) 00000919 / CMP000 NCOMUT5,0,GE,SEF9A 00000920 / SET000 NCOMUT5,0 00000921 / CMP000 DEPTH,0,EQ,SEF9A 00000922 / B RET9R 00000923 /SEF9I SETVAL NDUMY,0,(+,NDUM5,0,) CASE OF DUMMY FUNCTION */ 00000924 /SEF9J SETVAL J,0,(+,J,0,+,1,0,) 00000925 / CMPVAL J,0,(+,NEPS,0,),GT,RET9R 00000926 / CMP000 P$VAR,J,EQ,SEF9J 00000927 / CMPVAL -P$VAR-TYPE-,J,(+,FUNCT,0,),EQ,HEF9I 00000928 / CMP000 NCOMUT5,0,LT,RET9R 00000929 / B SEF9J 00000930 /HEF9I CMPVAL P$VAR,J,(+,FUNCT0,0,),NE,L0043 00000931 / CMP000 NCOMUT5,0,LT,RET9R 00000932 / B SEF9J 00000933 /L0043 SETVAL DUMNR,0,(+,-L1-NR-,0,) 00000934 / SETVAL DUMVAL,0,(+,P$VAR,J,-,FUNCT0-ARGFU0,0,) 00000935 BAL 14,DUIN9 FLAG 00000936 / CMP000 FLAG,0,EQ,HEF9U 00000937 / CMP000 NCOMUT5,0,GE,SEF9I 00000938 ** 00000939 *** STACK WHEN A MATCHING FU IS FOUND. UNSTACK IN CASE OF FAILURE */ 00000940 *** OF NEXT MATCH. TRY ANOTHER MATCH ON LOWER DEPTH. */ 00000941 *** EXAMPLE. Z=A OR PDQ OR MU OR P(5)**3*F(1)*F(2)*F(3) WITH */ 00000942 *** ID,F(N+)*A**N+=FF GIVES CONFLICT AT FIRST ATTEMPT. TRY AGAIN */ 00000943 /RET9R CMP000 DEPTH,0,EQ,NOMATCH END OF RECURSION */ 00000944 /RET8R SETVAL COMM1,0,(+,ISWIH1,DEPTH,+,1,0,) 00000945 SETVAL K,0,(+,ISWIH2,DEPTH,-,NEXTW,0,) 00000946 / CMP000 ROUND5,0,NE,L0044 00000947 / SETVAL NDUMY,0,(+,ISWIH4,DEPTH,) 00000948 /L0044 SETVAL DEPTH,0,(+,DEPTH,0,-,1,0,) 00000949 / CMP000 DEPTH,0,EQ,NXFACT 00000950 / CMP000 ISWI1,0,GE,NXFACT JP IF AINBE,ADISO */ 00000951 / SET111 DEPTH,0 IN CASE OF NONCOMMUT,RESTART AT DEPTH=0 */ 00000952 / B RET8R IS THE ONLY POSSIBILITY */ 00000953 ** 00000954 *** BUILD UP DUMMY TABLE. FLAG NZ IF INCONSISTENCY FOUND */ 00000955 *** DUIN9 PRO FLAG 00000956 /DUIN9 CMPVAL DUMVAL,0,(+,FUNCT0,0,),NE,L0045 00000957 / SET111 FLAG,0 CONFLICT */ 00000958 / BR 14 00000959 /L0045 SET000 FLAG,0 00000960 / CMPVAL DUMNR,0,(+,NDUMY,0,),LE,L0046 00000961 / SETVAL NDUMY,0,(+,DUMNR,0,) 00000962 / SETVAL IDUM1,DUMNR,(+,DUMVAL,0,) 00000963 / BR 14 00000964 /L0046 CMP000 IDUM1,DUMNR,NE,L0047 00000965 / SETVAL IDUM1,DUMNR,(+,DUMVAL,0,) 00000966 / BR 14 00000967 /L0047 SETVAL FLAG,0,(+,IDUM1,DUMNR,-,DUMVAL,0,) DETERMINES CONFLI 00000968 / BR 14 00000969 FOUTB2 ERROR 3,' ERROR DURING FUNCTION MATCHING' 00000970 /Z9IDT EPI 00000971 *** 00000972 *** 00000973 *** 00000974 /COU38 PRO WEIGHT5 00000975 / SET000 WEIGHT5,0 00000976 / DOLOOP J,1,NALGE,1,L0101,L0102 00000977 / CMP000 IPR1,J,EQ,L0262 00000978 SETVAL SYMBOL1,0,(+,J,0,+,ALGEBR0,0,) 00000979 PCA38 SYMBOL1,VALUE5 00000980 *** WEIGHT5=WEIGHT5+VALUE5*IPR1(J); 00000981 LOAD 1,IPR1,J 00000982 LR 3,1 00000983 M 2,VALUE5 00000984 A 3,WEIGHT5 00000985 ST 3,WEIGHT5 00000986 /L0262 ENDDO L0101,+1 00000987 /L0102 DOLOOP J,1,NQX,1,L0103,L0104 00000988 / CMPVAL IPR,J,(+,VECTOR0,0,+,32,0,),GT,C38D 00000989 / CMPVAL IPR,J,(+,VECTOR0,0,),LT,C38D 00000990 SETVAL SYMBOL1,0,(+,IPR,J,) 00000991 PCA38 SYMBOL1,VALUE5 00000992 / SETVAL WEIGHT5,0,(+,WEIGHT5,0,+,VALUE5,0,) 00000993 /C38D ENDDO L0103,+1 00000994 /L0104 DOLOOP J,1,NDOTI,2,L0105,L0106 00000995 / SET000 VALUE2,0 00000996 / CMPVAL -ISCAL-TYPE-,J,(+,INDEX,0,),NE,L0263 00000997 SETVAL SYMBOL1,0,(+,ISCAL,J,) 00000998 PCA38 SYMBOL1,VALUE5 00000999 / B C38I 00001000 /L0263 CMPVAL -ISCAL-TYPE-,J,(+,DOTPR,0,),LT,L0264 00001001 SETVAL SYMBOL1,0,(+,-ISCAL-VECT1-,J,+,VECTOR0,0,) 00001002 PCA38 SYMBOL1,VALUE5 00001003 SETVAL SYMBOL1,0,(+,-ISCAL-VECT2-,J,+,VECTOR0,0,) 00001004 PCA38 SYMBOL1,VALUE2 00001005 / B C38I 00001006 L0264 SETVAL SYMBOL1,0,(+,-ISCAL-VECT1-,J,+,VECTOR0,0,) VECTNR 00001007 PCA38 SYMBOL1,VALUE5 00001008 C38I SETVAL II5,0,(+,J,0,+,1,0,) 00001009 *** WEIGHT5=WEIGHT5+(VALUE2+VALUE5)*ISCAL(J+1); 00001010 LOAD 1,ISCAL,II5 00001011 L 3,VALUE2 00001012 A 3,VALUE5 00001013 MR 2,1 00001014 A 3,WEIGHT5 00001015 ST 3,WEIGHT5 00001016 / ENDDO L0105,2 00001017 /L0106 DOLOOP J,1,NEPS,1,L0107,XCOU38 00001018 / CMPVAL -P$WORD-TYPE-,J,(+,FUNCT,0,),NE,L0265 00001019 SETVAL SYMBOL1,0,(+,P$VAR,J,) 00001020 PCA38 SYMBOL1,VALUE5 00001021 / SETVAL WEIGHT5,0,(+,WEIGHT5,0,+,VALUE5,0,) 00001022 /L0265 ENDDO L0107,+1 00001023 B XCOU38 00001024 *** CA38 PRO SYMBOL1 VALUE$ 00001025 ** /* FIND WEIGHT OF FACTOR IN IDGEH LIST */ 00001026 &VALUE$ SETA 2 00001027 CA38 LR &VALUE$,0 00001028 STM 7,9,LOOPVAR1 00001029 SETVAL K5,0,(+,IDNEXT,0,-,NEXTW,0,) 00001030 SETVAL IJ5,0,(+,IDCODE,0,+,NEXTW,0,) 00001031 DOLOOP K1,IJ5,K5,NEXTW,L0111,L0112 00001032 / CMPVAL ID$WORD,K1,(+,SYMBOL1,0,),NE,CA38A 00001033 LR &VALUE$,6 00001034 / CMPVAL K1,0,(+,IDNEXT,0,-,NEXTW,0,),EQ,L0112 00001035 SETVAL II5,0,(+,K1,0,+,NEXTW,0,) 00001036 CMPVAL -ID$WORD-TYPE-,II5,(+,NUMBER,0,),NE,L0112 00001037 SGNEXT SYMBOL1,0,-ID$WORD-NR-,II5 00001038 LOAD &VALUE$,SYMBOL1,0 00001039 B L0112 00001040 /CA38A ENDDO L0111,+1 00001041 L0112 LM 7,9,LOOPVAR1 00001042 BR 14 00001043 /COU38 EPI 00001044 *** 00001045 /SO42A PRO SIGN5 SYMBOL1 SYMBOL2 00001046 / CMP000 NEPS,0,EQ,XSO42A 00001047 / SETVAL IDCODE,0,(+,IDCODE,0,-,NEXTW,0,) 00001048 /SO42B SETVAL IDCODE,0,(+,IDCODE,0,+,NEXTW,0,) POINTS AT FUS OF COM 00001049 / CMPVAL IDCODE,0,(+,IDNEXT,0,),GE,XSO42A 00001050 / CMPVAL -ID$WORD-TYPE-,IDCODE,(+,FUNCT,0,),NE,SO42B 00001051 / DOLOOP J,NEPS,1,-1,L0202,SO42B FIND ALL F1 IN IEP */ 00001052 / CMPVAL P$WORD,J,(+,ID$WORD,IDCODE,),NE,SO42C 00001053 / SETVAL K2,0,(+,IDCODE,0,) 00001054 / B SO42D 00001055 /SO42C ENDDO L0202,-1 00001056 / B SO42B 00001057 /SO42D SETVAL K2,0,(+,K2,0,+,NEXTW,0,) DEAL WITH ALL ARGS OF F1 */ 00001058 / CMPVAL -ID$WORD-TYPE-,K2,(+,NUMBER,0,),NE,SO42C 00001059 : SETVAL K1,0,(+,J,0,+,-ID$WORD-NR-,K2,) POSITION AT N TH 00001060 / CMP000 FLAG,0,EQ,SO42E ARGUMENT 00001061 / CMPVAL P$VAR,K1,(+,SYMBOL1,0,),NE,SO42D CASE OF REPLA */ 00001062 / SETVAL P$VAR,K1,(+,SYMBOL2,0,) 00001063 / B SO42D 00001064 SO42E GETMIN P$VAR,K1,SO42D CASE OF ODD,EVEN 00001065 / SETVAL SIGN5,0,(-,SIGN5,0,) 00001066 / B SO42D 00001067 /SO42A EPI 00001068 *** 00001069 DS 0H 00001070 USING *,15 00001071 *** SO50A PRO FLAG 00001072 *** FLAG=IGET-IDGEH(IDCODE).FLOAT; 00001073 SO50A L 1,IDCODE 00001074 MVC NRFLOAT(LFLOAT),0(1) 00001075 LOAD 0,NRFLOAT,0 00001076 LOAD 4,IGET,0 00001077 LCDR 0,0 00001078 LCDR 2,2 00001079 PLUS 00001080 TEST 19 HEX DIGITS 00001081 STE 0,FLAG 00001082 BR 14 00001083 DROP 15 00001084 *** 00001085 FFOUT 3,'COMMUTE' 00001086 END 00001087 ./A MARTYN2,INCR=1 00000001 ./MACRO MAINMCRO 00000002 ./MACRO EXECMCRO 00000003 TITLE 'MARTYN2' 00000004 GBLC &OVLAY 00000005 ./MACRO EXECCOM 00000006 ./MACRO MAINCOM 00000007 *** 00000008 *** 00000009 PRINT NOGEN 00000010 MARTYN2 CSECT 00000011 EQUIVAL 00000012 ENTRY SOORT39,SOORT41,SOORT45,SOORT54 00000013 EXTRN FOUT,Z1IDT,XMARTYN1,EPSRED1 00000014 USING EXECCOM,10 00000015 USING BLANK,11 00000016 DS 0H 00000017 USING *,12 00000018 *** ID,RATIO,XA,XB,BA */ 00000019 SOORT45 LR 12,3 00000020 CMPVAL IDNEXT,0,(+,IDCODE,0,+,3*NEXTW,0,),NE,FOUTB1 00000021 / SETVAL XA,0,(+,ID$WORD,IDCODE,) 00000022 SETVAL IJ5,0,(+,IDCODE,0,+,NEXTW,0,) 00000023 : SETVAL XB,0,(+,ID$WORD,IJ5,) 00000024 SETVAL IJ5,0,(+,IDCODE,0,+,2*NEXTW,0,) 00000025 : SETVAL BA,0,(+,ID$WORD,IJ5,) 00000026 SETVAL II5,0,(+,-XA-NR-,0,) XA**NN*XB**MM 00000027 SETVAL IJ5,0,(+,-XB-NR-,0,) 00000028 SETVAL NN,0,(+,IPR1,II5,) 00000029 SETVAL MM,0,(+,IPR1,IJ5,) 00000030 / CMP000 NN,0,EQ,Z4IDT 00000031 / CMP000 MM,0,EQ,Z4IDT 00000032 / CMP000 NN,0,GE,L0204 00000033 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000034 SETVAL P$VAR,NEPS,(+,DKEY,0,) 00000035 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000036 SETVAL P$VAR1,NEPS,(+,XA,0,) 00000037 SETVAL P$VAR2,NEPS,(+,XB,0,) 00000038 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000039 SETVAL P$VAR1,NEPS,(+,BA,0,) 00000040 SETVAL P$VAR2,NEPS,(+,MINUS,0,) 00000041 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000042 SETVAL P$VAR,NEPS,(+,BA,0,) 00000043 ** /* KEY=XA,XB,BA,-BA */ 00000044 / B L0205 00000045 /L0204 CMP000 MM,0,GE,Z4IDT 00000046 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000047 SETVAL P$VAR,NEPS,(+,DKEY,0,) 00000048 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000049 SETVAL P$VAR1,NEPS,(+,XB,0,) 00000050 SETVAL P$VAR2,NEPS,(+,XA,0,) 00000051 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000052 SETVAL P$VAR1,NEPS,(+,MINUS,0,) 00000053 SETVAL P$VAR2,NEPS,(+,BA,0,) 00000054 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000055 SETVAL P$VAR,NEPS,(+,BA,0,) 00000056 ** /* KEY=XB,XA,-BA,BA */ 00000057 / SETVAL KK,0,(+,MM,0,) 00000058 / SETVAL MM,0,(+,NN,0,) 00000059 / SETVAL NN,0,(+,KK,0,) 00000060 ** /* NN IS NOW NEGATIVE. */ 00000061 L0205 SET000 IPR1,II5 00000062 SET000 IPR1,IJ5 00000063 / SETVAL NEPS,0,(+,NEPS,0,+,1,0,) 00000064 SETVAL P$EXPR,NEPS,(+,MBE,0,) 00000065 SET000 P$POINT,NEPS 00000066 SET111 P$MULTP,NEPS 00000067 / SET111 MARKER,0 00000068 / SETVAL MM,0,(-,MM,0,) 00000069 / SETVAL NN,0,(-,NN,0,) 00000070 / SET000 FLAG,0 00000071 / SET111 B1,0 00000072 / SETVAL B2,0,(+,4,0,) 00000073 SO45G LD 0,=D'1.0' 00000074 SDR 2,2 00000075 STORE 0,NRFLOAT,0 00000076 *** NRFLOAT=-1**MM; 00000077 L 2,MM 00000078 SR 3,3 00000079 SRDA 2,1 00000080 X 3,NRFLOAT 00000081 ST 3,NRFLOAT 00000082 SETVAL IJ5,0,(+,NN,0,-,1,0,) 00000083 / DOLOOP J,0,IJ5,1,L0206,L0207 NN IS POSITIVE */ 00000084 / SETVAL T$1COEFF,MBE,(+,NRFLOAT,0,) 00000085 / SETVAL T$1CODEA,-MBE-1-,(+,DUMMY0,0,+,B1,0,) 00000086 SETVAL -T$1CODEA-TYPE-,-MBE-2-,(+,NUMBER,0,) 00000087 SETVAL -T$1CODEA-NR-,-MBE-2-,(+,J,0,-,NN,0,) 00000088 / SETVAL T$1CODEA,-MBE-3-,(+,DUMMY0,0,+,B2,0,) 00000089 SETVAL -T$1CODEA-TYPE-,-MBE-4-,(+,NUMBER,0,) 00000090 SETVAL -T$1CODEA-NR-,-MBE-4-,(-,J,0,-,MM,0,) 00000091 / FILL T$1CODEA,MBE,5,MBE5 00000092 / SETVAL T$1POINT,MBE,(+,MBE5,0,) 00000093 / SETVAL OLD5,0,(+,MBE,0,) 00000094 / SETVAL MBE,0,(+,MBE5,0,) 00000095 *** NRFLOAT=NRFLOAT*(J+MM)/(J+1); 00000096 *** IS NRFLOAT NECESSARY REPRESENTATION OF INTEGER. 00000097 *** IS DOUBLE PREC THE APPROPRIATE LENGTH... 00000098 SETVAL II5,0,(+,J,0,+,MM,0,) 00000099 FLOAT 0,II5,0 00000100 MD 0,NRFLOAT 00000101 SETVAL II5,0,(+,J,0,+,1,0,) 00000102 FLOAT 4,II5,0 00000103 DDR 0,4 00000104 SDR 2,2 00000105 STORE 0,NRFLOAT,0 00000106 / CMP000 NRFLOAT,0,EQ,SO45DD 00000107 / ENDDO L0206,+1 00000108 /L0207 SETVAL KK,0,(+,MM,0,) 00000109 / SETVAL MM,0,(+,NN,0,) 00000110 / SETVAL NN,0,(+,KK,0,) 00000111 / CMP111 FLAG,0,EQ,SO45DD 00000112 / CMP000 NN,0,LT,L0210 00000113 / SET111 FLAG,0 00000114 / SETVAL B1,0,(+,2,0,) 00000115 / SETVAL B2,0,(+,3,0,) 00000116 / B SO45G 00000117 /L0210 SETVAL NN,0,(-,NN,0,) 00000118 / CMPVAL NN,0,(+,MM,0,),LT,SO45DD 00000119 SET1$0 NRFLOAT,0 00000120 SETVAL IJ5,0,(+,NN,0,-,MM,0,) 00000121 : DOLOOP J,0,IJ5,1,L0211,SO45DD 00000122 / SETVAL T$1COEFF,MBE,(+,NRFLOAT,0,) 00000123 / SETVAL T$1CODEA,-MBE-1-,(+,DUMMY0,0,+,2,0,) 00000124 SETVAL -T$1CODEA-TYPE-,-MBE-2-,(+,NUMBER,0,) 00000125 SETVAL -T$1CODEA-NR-,-MBE-2-,(+,NN,0,-,MM,0,-,J,0,) 00000126 / SETVAL T$1CODEA,-MBE-3-,(+,DUMMY0,0,+,3,0,) 00000127 SETVAL -T$1CODEA-TYPE-,-MBE-4-,(+,NUMBER,0,) 00000128 SETVAL -T$1CODEA-NR-,-MBE-4-,(+,J,0,) 00000129 / FILL T$1CODEA,MBE,5,MBE5 00000130 / SETVAL T$1POINT,MBE,(+,MBE5,0,) 00000131 / SETVAL OLD5,0,(+,MBE,0,) 00000132 / SETVAL MBE,0,(+,MBE5,0,) 00000133 *** NRFLOAT=NRFLOAT*(J+MM)/(J+1); 00000134 SETVAL II5,0,(+,J,0,+,MM,0,) 00000135 FLOAT 0,II5,0 00000136 MD 0,NRFLOAT 00000137 SETVAL II5,0,(+,J,0,+,1,0,) 00000138 FLOAT 4,II5,0 00000139 DDR 0,4 00000140 SDR 2,2 00000141 STORE 0,NRFLOAT,0 00000142 / ENDDO L0211,+1 00000143 /SO45DD SET000 T$1POINT,OLD5 00000144 / CMPVAL NDIMT,0,(+,MBE,0,),LT,FOUT3 00000145 Z4IDT JUMP Z1IDT 00000146 FOUTB1 ERROR 1,' ERROR IN RATIO COMMAND' 00000147 DROP 12 00000148 ** 00000149 DS 0H 00000150 USING *,12 00000151 SOORT41 LR 12,3 00000152 SET111 EPSM1,0 00000153 CCALL EPSRED1 00000154 B Z5IDT 00000155 Z5IDT JUMP Z1IDT 00000156 DROP 12 00000157 DS 0H 00000158 USING *,12 00000159 AAA LR 12,3 00000160 SET000 NCONT,8 00000161 ERROR 1,' COMMAND NOT (YET) BUILT IN' 00000162 FOUT3 ERROR 1,' OVERFLOW ON INPUT ARRAY' 00000163 FOUT7 ERROR 1,' INCOMPATIBLE OPERATIONS' 00000164 SO54N ERROR 1,' ILLEGAL FU ARG CONFIGURATION' 00000165 Z6IDT JUMP Z1IDT 00000166 EXIT6 JUMP XMARTYN1 00000167 DROP 12 00000168 SOORT39 EQU AAA 00000169 SOORT54 EQU AAA 00000170 FFOUT 1,'SPINORS' 00000171 END 00000172 ./ADD ORIGIN,INCR=1 00000001 ENTRY NOUSE 00000002 ORIGIN CSECT 00000003 NOUSE SR 15,15 00000004 ABEND 1002 00000005 END 00000006 ./A ROTSOI,INCR=1 00000001 ./MACRO MAINMCRO 00000002 ./MACRO EXECMCRO 00000003 TITLE 'ROTSOI' 00000004 GBLC &OVLAY 00000005 LCLA &RESUL$ 00000006 ./MACRO EXECCOM 00000007 ./MACRO MAINCOM 00000008 *** 00000009 *** 00000010 PRINT NOGEN 00000011 ROTSOI CSECT 00000012 EQUIVAL 00000013 NEXTA EQU T$ANEXTA-T$A 00000014 DSEND EQU T$DDSEND-T$DDSIND 00000015 ENTRY SEARCH,EVNUM,EVFUN 00000016 EXTRN FOUT,BRIAN,UNCF,EXTRA 00000017 USING EXECCOM,10 00000018 USING BLANK,11 00000019 *** ROTSOI DOES THE NUMERICAL EVALUATION OF EXPRESSIONS AND FUNCTIONS * 00000020 *** RECURSIVE FUNCTION CALLS */ 00000021 *** RECUR CALL FU MEANS REG=ADDR(LABEL); */ 00000022 *** GO TO FU; */ 00000023 *** LABEL: ... */ 00000024 *** AT ENTRY FU: LEVEL=LEVEL+1; */ 00000025 *** REMEM1(LEVEL)=REG; */ 00000026 *** REMEM2(LEVEL)=BASE REG; */ 00000027 *** AT EXIT RETURN: REG=REMEM1(LEVEL); */ 00000028 *** BASE REG=REMEM2(LEVEL) */ 00000029 *** LEVEL=LEVEL-1; */ 00000030 *** GO TO REG; */ 00000031 ** 00000032 ** 00000033 *** TRY NUM. EV. OF DD,DB,DT,DK,DP,DX,DS AND STANDARD EXPRESSIONS */ 00000034 /EVFUN PRO RESULT NSUC J K NFUL X6-X7,X2,B1,B3,X7*/ 00000035 LA 1,EVFU1 00000036 ST 1,BACK 00000037 / SET000 DREQ1,0 00000038 / SETVAL MBU1,0,(+,MBU,0,) 00000039 / SETVAL NEPS5,0,(+,NEPS,0,+,1,0,) 00000040 / SETVAL A0,0,(+,MBE,0,+,NEXTW,0,) 00000041 / SETVAL R$A0,1,(+,A0,0,) 00000042 / SETVAL R$J,1,(+,J,0,) 00000043 / SETVAL R$K,1,(+,K,0,) 00000044 / SETADR J,0,(+,P$WORD,J,) BEGIN OF FU.IEP-ADR BECOMES IT-ADR 00000045 / SETADR K,0,(+,P$WORD,K,) END OF FUNCTION */ 00000046 SET111 NLEV,0 00000047 / CMPVAL T$8FU,J,(+,DX,0,),NE,LL010 00000048 JUMP EXTRA1 00000049 /LL010 CMPVAL T$8FU,J,(+,DS,0,),NE,LL011 00000050 JUMP EVSIG1 00000051 /LL011 CMPVAL T$8FU,J,(+,DD,0,),NE,EVFUN01 00000052 / CMPVAL -T$8ARG1-TYPE-,J,(+,NUMBER,0,),EQ,EVFUN01 00000053 / CMPVAL T$8ARG1,J,(+,DEXPR,0,),EQ,EVSTE11 00000054 / CMPVAL T$8ARG1,J,(+,XEXPR,0,),EQ,EVSTE11 00000055 ** /* CASE OF ZEXPR IS EXPLICITLY EXCLUDED IN INSER2 */ 00000056 JUMP NOSUC1 CASE OF REPLACEMENT FUNCTION 00000057 EVFUN01 JUMP EVFUN0 00000058 EVSTE11 JUMP EVSTE1 00000059 DROP 12 00000060 DS 0H 00000061 USING *,12 00000062 *** A SUCCESSFUL RETURN IS VIA EVBAS8. AN UNSUCCESSFUL VIA NOSUC1 */ 00000063 /EVBAS8 CMP111 NLEV,0,NE,LL002 00000064 / SET000 NSUC,0 00000065 JUMP EVFU1 00000066 LL002 L 1,=A(EVXP11) SUCCESS WHEN CALLED FROM EVEX6 00000067 L 12,REG12 00000068 DROP 12 00000069 BR 1 00000070 DS 0H 00000071 USING *,12 00000072 /EVFU1 SETVAL J,0,(+,R$J,1,) 00000073 / SETVAL K,0,(+,R$K,1,) 00000074 /EVFUN EPI 00000075 ** 00000076 *** TRY NUMERICAL EVALUATION OF AN EXPR. CALLED BY NUMWO1 IN INSER1 */ 00000077 /EVNUM PRO NSUC EXPR RESULT DUMPT X2,B2,X7,B1 */ 00000078 LA 1,XEVNUM 00000079 ST 1,BACK 00000080 / SET000 DREQ1,0 00000081 / SETVAL A0,0,(+,MBE,0,+,NEXTW,0,) 00000082 SET111 NLEV,0 00000083 / SETVAL MBU1,0,(+,MBU,0,) 00000084 / SETVAL R$DUMPT,1,(+,DUMPT,0,) 00000085 / SETVAL R$A0,1,(+,A0,0,) 00000086 REVEX6 EXPR,DUMPT,RESULT 00000087 / SET000 NSUC,0 CASE OF SUCCESSFUL RETURN */ 00000088 JUMP XEVNUM UNSUCCESSFUL RETURN IS VIA NOSUC1 00000089 DROP 12 00000090 DS 0H 00000091 USING *,12 00000092 /EVNUM EPI 00000093 ** 00000094 DS 0H 00000095 USING *,12 00000096 /NOSUC1 SETVAL NSUC,0,(-,1,0,) 00000097 L 12,BACK 00000098 DROP 12 00000099 BR 12 00000100 ** 00000101 DS 0H 00000102 USING *,12 00000103 *** IF EVSIG1 IS CALLED DIRECTLY FROM INSERT ( NLEV=0) THEN THE */ 00000104 *** PARTIAL OR FULL EV CAN BE REQUESTED. IF CALLED FROM EVEX6 (NLEV>0)* 00000105 *** THEN FULL EV IS ALWAYS REQUIRED. PARTIAL EV MEANS EVAL OF EX2 */ 00000106 *** ONLY. THIS MUST BE SUCCESSFUL. FULL EV MEANS EVAL OF EX1 AS WELL. * 00000107 :EVSIG1 SETVAL L,0,(+,K,0,-,DSEND,0,) 00000108 / CMPVAL T$DDSIND,L,(+,X'7FF',0,),NE,FOUT1 DD...TROUBLE */ 00000109 / SETVAL T$DDSIND,L,(+,T$DDSLOW,L,) 00000110 / CMPVAL -T$DDSLOW-TYPE-,L,(+,NUMBER,0,),NE,NOSUC2 00000111 / CMPVAL -T$DDSHI-TYPE-,L,(+,NUMBER,0,),NE,NOSUC2 00000112 SGNEXT II5,0,T$DDSLOW,L 00000113 SGNEXT IJ5,0,T$DDSHI,L 00000114 CMPVAL IJ5,0,(+,II5,0,),GE,L0001 00000115 / SET000 RESULT,0 00000116 B SUC2 00000117 L0001 SET0$0 T$ASUMDS,A0 00000118 SET1$0 T$APRODS,A0 00000119 / SETVAL T$AJ,A0,(+,J,0,) 00000120 / SETVAL T$AK,A0,(+,K,0,) 00000121 / CMP111 NLEV,0,NE,SIG1AA FULL EVAL */ 00000122 / CMP111 NFUL,0,EQ,SIG1BB CONSTRUCT COEFS WITH EX2 */ 00000123 /SIG1AA SETVAL EXPR,0,(+,T$DDSEX1,L,) 00000124 : SETADR DUMPT,0,(+,T$8DUM1,J,) 00000125 / CMP111 NLEV,0,NE,L0002 00000126 / SETVAL A0,0,(+,A0,0,+,NEXTA,0,) 00000127 / B L0003 00000128 /L0002 SETVAL A0,0,(+,K,0,+,NEXTW,0,) 00000129 L0003 REVEX6 EXPR,DUMPT,RESULT 00000130 SETVAL A0,0,(+,R$A0,NLEV,) 00000131 / SETVAL J,0,(+,T$AJ,A0,) 00000132 / SETVAL K,0,(+,T$AK,A0,) 00000133 SETVAL L,0,(+,K,0,-,DSEND,0,) 00000134 / CMP000 RESULT,0,EQ,SIG1C 00000135 LOAD 0,RESULT,0 00000136 LOAD 4,T$APRODS,A0 00000137 MULTP 00000138 STORE 0,RESULT,0 00000139 SIG1C LOAD 0,RESULT,0 00000140 LOAD 4,T$ASUMDS,A0 00000141 PLUS 00000142 TEST 19 00000143 STORE 0,RESULT,0 00000144 SETVAL T$ASUMDS,A0,(+,RESULT,0,) 00000145 /SIG1BB CMPVAL T$DDSIND,L,(+,T$DDSHI,L,),EQ,SUC2 00000146 / SETVAL -T$DDSIND-NR-,L,(+,-T$DDSIND-NR-,L,+,1,0,) 00000147 : SETADR DUMPT,0,(+,T$8DUM1,J,) 00000148 / CMP111 NLEV,0,NE,L0005 00000149 / SETVAL A0,0,(+,A0,0,+,NEXTA,0,) 00000150 / B L0006 00000151 /L0005 SETVAL A0,0,(+,K,0,+,NEXTW,0,) 00000152 /L0006 SETVAL EXPR,0,(+,T$DDSEX2,L,) 00000153 REVEX6 EXPR,DUMPT,RESULT 00000154 SETVAL A0,0,(+,R$A0,NLEV,) 00000155 / SETVAL J,0,(+,T$AJ,A0,) 00000156 / SETVAL K,0,(+,T$AK,A0,) 00000157 SETVAL L,0,(+,K,0,-,DSEND,0,) 00000158 / CMP000 RESULT,0,NE,L0007 00000159 / SETVAL RESULT,0,(+,T$ASUMDS,A0,) 00000160 SETVAL -T$DDSHI-NR-,L,(+,-T$DDSIND-NR-,L,-,1,0,) 00000161 B SUC2 /* END OF USEFUL EXPANSION OF DS */ 00000162 L0007 LOAD 0,RESULT,0 00000163 LOAD 4,T$APRODS,A0 00000164 MULTP 00000165 STORE 0,T$APRODS,A0 00000166 / CMP111 NLEV,0,NE,SIG1AA 00000167 / CMP000 NFUL,0,EQ,SIG1AA 00000168 *** IEP(NEPS5).FLOAT=IT(A0).PRODS; 00000169 LADR 2,P$WORD,NEPS5 00000170 L 1,A0 00000171 MVC 0(LFLOAT,2),T$APRODS-T$A(1) 00000172 : SETVAL NEPS5,0,(+,NEPS5,0,+,LFLOAT/NEXTW,0,) 00000173 / B SIG1BB 00000174 SUC2 JUMP EVBAS8 00000175 NOSUC2 JUMP NOSUC1 00000176 FOUT1 ERROR 1,' TROUBLE WITH DS FUNCTION' 00000177 DROP 12 00000178 ** 00000179 DS 0H 00000180 USING *,12 00000181 /EXTRA1 CMP111 NLEV,0,NE,L0010 00000182 / SETVAL T$AAFIX,A0,(+,A0,0,+,NEXTA,0,) 00000183 / B L0011 00000184 /L0010 SETVAL T$AAFIX,A0,(+,K,0,+,NEXTW,0,) 00000185 :L0011 SETVAL T$AAFLOA,A0,(+,T$AAFIX,A0,+,10*NEXTW,0,) LFIX=NEXTW 00000186 / SETVAL T$ACFIX,A0,(+,T$AAFIX,A0,) 00000187 / SETVAL T$ACFLOA,A0,(+,T$AAFLOA,A0,) 00000188 *** IT(A0).DXARG=ADDR(IT(J).DUM1)+IT(J).DUMNR.NR*NEXTW; 00000189 LOAD 1,-T$8DUMNR-NR-,J 00000190 SLA 1,2 00000191 ST 1,II5 00000192 : SETADR T$ADXARG,A0,(+,T$8DUM1,J,+,II5,0,) 00000193 EXTRA3 SETVAL II5,0,(+,T$ADXARG,A0,) 00000194 CMPVAL T$0VAR,II5,(+,FUNCT0,0,),EQ,EXTRA4 00000195 / SETVAL T$ADXARG,A0,(+,T$ADXARG,A0,+,NEXTR,0,) 00000196 CMPVAL -T$0VAR-TYPE-,II5,(+,NUMBER,0,),NE,EXTRA5 00000197 SETVAL IJ5,0,(+,T$ACFIX,A0,) CASE OF FIXED POINT 00000198 SGNEXT T$0WORD,IJ5,-T$0VAR-NR-,II5 00000199 : SETVAL T$ACFIX,A0,(+,T$ACFIX,A0,+,NEXTW,0,) CFIX=NEXTW 00000200 / B EXTRA3 00000201 :EXTRA5 SETADR DUMPT,0,(+,T$8DUM1,J,) 00000202 : SETVAL EXPR,0,(+,T$0VAR,II5,) FLOATING POINT CASE 00000203 / SETVAL A0,0,(+,T$ACFLOA,A0,+,NEXTW,0,) 00000204 REVEX6 EXPR,DUMPT,RESULT 00000205 SETVAL A0,0,(+,R$A0,NLEV,) 00000206 SETVAL J,0,(+,R$J,NLEV,) 00000207 *** IT(IT(A0).CFLOA).FLOAT=RESULT; 00000208 LOAD 1,T$ACFLOA,A0 00000209 MVC 0(LFLOAT,1),RESULT 00000210 : SETVAL T$ACFLOA,A0,(+,T$ACFLOA,A0,+,LFLOAT,0,) 00000211 / B EXTRA3 00000212 :EXTRA4 PEXTRA T$AAFIX,A0,T$AAFLOA,A0,T$ARSLDX,A0 00000213 / SETVAL RESULT,0,(+,T$ARSLDX,A0,) 00000214 JUMP EVBAS8 00000215 DROP 12 00000216 ** 00000217 DS 0H 00000218 USING *,12 00000219 /EVSTE1 SETVAL T$AJ,A0,(+,J,0,) X OR D EXPR IN IEP OR IT */ 00000220 / SETVAL T$AK,A0,(+,K,0,) 00000221 / SETADR DUMPT,0,(+,T$8DINDX,J,) 00000222 / SETVAL EXPR,0,(+,T$8DLOC,J,) 00000223 / CMP111 NLEV,0,NE,L0012 00000224 / SETVAL A0,0,(+,A0,0,+,NEXTA,0,) 00000225 / B L0013 00000226 /L0012 SETVAL A0,0,(+,K,0,+,NEXTW,0,) 00000227 /L0013 CMPVAL T$8ARG1,J,(+,XEXPR,0,),NE,L0014 00000228 REVEX6 EXPR,DUMPT,RESULT 00000229 B SUC3 00000230 /L0014 CMPVAL T$8ARG1,J,(+,ZEXPR,0,),EQ,EVFIL1 00000231 / SETVAL EXPR,0,(+,X'7FF',0,) 00000232 GETMIN T$8DLOC,J,STA1C 00000233 PUTMIN EXPR,0 00000234 /STA1C PSEARCH J,M FIND (A) OF D-COMPONENT*/ 00000235 / SETVAL T$AEXPR1,A0,(+,M,0,) 00000236 REVEX6 EXPR,DUMPT,RESULT 00000237 B SUC3 00000238 ** 00000239 /EVFIL1 SETVAL CODE,0,(+,EXPR,0,) Z EXPR IN IT */ 00000240 GETOPR CODE,0,OPR5 00000241 SETVAL II5,0,(+,-CODE-NR-,0,) 00000242 CMP111 L$NUMB,II5,NE,EVF1D 00000243 FLOAT 0,L$VALUE,II5 00000244 STORE 0,RESULT,0 00000245 /EVF1B GETMIN EXPR,0,SUC3,NOSUC3 00000246 NEGATE RESULT,0 00000247 B SUC3 00000248 EVF1D CMPBIT L$PROP,II5,COMON,ON,NOSUC3 00000249 CMPBIT L$PROP,II5,TAPE,ON,NOSUC3 00000250 CMPVAL L$LENGT,II5,(+,2*CODEA+3*NEXTW,0,),NE,NOSUC3 00000251 *** LENGTH OF NUM FILE=VECTOR SEPARATOR+2*CODEA+(0,-1) TERMINATOR 00000252 SETVAL L,0,(+,L$BEGIN,II5,+,NEXTW,0,) VECTOR SEPARATOR 00000253 *** IF IT(L).COEFF NE 1.0 THEN GOTO NOSUC1; 00000254 LOAD 0,T$1COEFF,L 00000255 LD 4,=D'-1.0' 00000256 SDR 6,6 00000257 PLUS 00000258 LTDR 0,0 00000259 BNE NOSUC3 00000260 : CMPVAL T$1POINT,L,(+,CODEA,0),NE,NOSUC3 00000261 / SETVAL L,0,(+,L,0,+,T$1POINT,L,) 00000262 / SETVAL RESULT,0,(+,T$1COEFF,L,) 00000263 / B EVF1B 00000264 SUC3 JUMP EVBAS8 00000265 NOSUC3 JUMP NOSUC1 00000266 DROP 12 00000267 ** 00000268 DS 0H 00000269 USING *,12 00000270 *** NUMERICAL EVALUATION OF DD,DB,DT,DK,DP FUNCTIONS. */ 00000271 *** ALL ARGUMENTS MUST BE NUMERICAL. */ 00000272 EVFUN0 SETVAL II5,0,(+,J,0,+,NEXTR,0,) 00000273 SETVAL IJ5,0,(+,K,0,-,NEXTR,0,) 00000274 DOLOOP N,II5,IJ5,NEXTR,L0015,L0016 00000275 / CMPVAL -T$0WORD-TYPE-,N,(+,NUMBER,0,),NE,NOSUC4 00000276 / ENDDO L0015,5 00000277 /L0016 CMPVAL T$8FU,J,(+,DP,0,),EQ,EPF1F 00000278 / CMPVAL T$8FU,J,(+,DK,0,),EQ,DEL1F 00000279 / CMPVAL T$8FU,J,(+,DT,0,),EQ,THE1F 00000280 / CMPVAL T$8FU,J,(+,DB,0,),EQ,BINO1F 00000281 / CMPVAL T$8FU,J,(+,DD,0,),NE,FOUT2 DD,BINOM,...TROUBLE */ 00000282 / CMPVAL K,0,(+,J,0,+,NEXTR,0,),LE,FOUT2 DD FU WITHOUT ARGS 00000283 SGNEXT ARG1,0,-T$8ARG1-NR-,J 00000284 / CMPVAL K,0,(+,J,0,+,2*NEXTR,0,),NE,L0017 00000285 LD 0,=D'1.0' 00000286 SDR 2,2 00000287 FLOAT 4,ARG1,0 00000288 / B L0020 00000289 L0017 FLOAT 0,ARG1,0 00000290 SGNEXT ARG2,0,-T$8ARG2-NR-,J 00000291 FLOAT 4,ARG2,0 00000292 L0020 STORE 0,RESULT,0 00000293 STORE 4,BASE1,0 00000294 CMPVAL K,0,(+,J,0,+,3*NEXTR,0,),GT,FOUT2 00000295 / CMP000 BASE1,0,EQ,FOUT2 00000296 *** RESULT=RESULT/BASE1 00000297 SETVAL EXPO1,0,(-,1,0,) 00000298 PBRIAN RESULT,0,BASE1,0,EXPO1 00000299 B SUC4 00000300 ** 00000301 THE1F SETVAL II5,0,(+,J,0,+,NEXTR,0,) THETA FUNCTION 00000302 SETVAL IJ5,0,(+,K,0,-,NEXTR,0,) 00000303 DOLOOP L,II5,IJ5,NEXTR,L0021,L0022 00000304 SGNEXT RESULFX,0,-T$0WORD-NR-,L 00000305 / CMP000 RESULFX,0,GE,L0056 00000306 / SET000 RESULT,0 00000307 B SUC4 00000308 /L0056 ENDDO L0021,5 00000309 L0022 SET1$0 RESULT,0 00000310 B SUC4 00000311 ** 00000312 /BINO1F CMPVAL K,0,(+,J,0,+,3*NEXTR,0,),NE,FOUT2 00000313 SGNEXT ARG1,0,-T$8ARG1-NR-,J 00000314 / CMP000 ARG1,0,GE,L0023 00000315 / SET0$0 RESULT,0 00000316 B SUC4 00000317 L0023 SGNEXT ARG2,0,-T$8ARG2-NR-,J 00000318 / CMPVAL ARG2,0,(+,ARG1,0,-,ARG2,0,),LE,L0024 00000319 / SETVAL ARG2,0,(+,ARG1,0,-,ARG2,0,) 00000320 /L0024 SET000 L,0 00000321 SET111 RESULFX,0 00000322 /BINO2F CMPVAL L,0,(+,ARG2,0,),GE,BINO3F 00000323 *** RESULT=RESULT*(ARG1-L)/(L+1); IN INTEGER 00000324 SETVAL II5,0,(+,ARG1,0,-,L,0,) 00000325 / SETVAL L,0,(+,L,0,+,1,0,) 00000326 SR 2,2 00000327 L 3,RESULFX 00000328 M 2,II5 00000329 D 2,L 00000330 ST 3,RESULFX 00000331 ** /* THIS CALCULATION IS DONE IN SINGLE OR DOUBLE PRECISION * 00000332 ** /* DEPENDING ON THE MAGNITUDE OF THE INTEGERS INVOLVED. */ 00000333 / B BINO2F 00000334 BINO3F FLOAT 0,RESULFX,0 00000335 STORE 0,RESULT,0 00000336 B SUC4 00000337 ** 00000338 /DEL1F CMPVAL K,0,(+,J,0,+,3*NEXTR,0,),NE,FOUT2 KRONECKER DELTA */ 00000339 / CMPVAL -T$8ARG1-NR-,J,(+,-T$8ARG2-NR-,J,),EQ,L0025 00000340 SDR 0,0 00000341 B L0028 00000342 L0025 LD 0,=D'1.0' 00000343 L0028 SDR 2,2 00000344 STORE 0,RESULT,0 00000345 B SUC4 00000346 ** 00000347 &RESUL$ SETA 0 00000348 EPF1F LD &RESUL$,=D'1.0' RESULT=1 . PERMUTATION FU 00000349 SETVAL K1,0,(+,J,0,+,NEXTR,0,) 00000350 SETVAL K2,0,(+,K,0,-,NEXTR,0,) 00000351 DOLOOP L,K1,K2,NEXTR,L0027,L0058 00000352 / SETVAL ARG1,0,(+,T$0VAR,L,) 00000353 STM 7,9,LOOPVAR1 00000354 SETVAL K3,0,(+,L,0,+,NEXTR,0,) 00000355 DOLOOP LL,K3,K2,NEXTR,L0057,L0060 00000356 / SETVAL ARG2,0,(+,T$0WORD,LL,) 00000357 SGNEXT II5,0,-ARG1-NR-,0 00000358 SGNEXT IJ5,0,-ARG2-NR-,0 00000359 CMPVAL II5,0,(+,IJ5,0,),LT,EPF2F 00000360 BNE L0061 00000361 SDR &RESUL$,&RESUL$ RESULT=0 00000362 B L0058 00000363 /L0061 SETVAL T$0VAR,LL,(+,ARG1,0,) 00000364 / SETVAL T$0VAR,L,(+,ARG2,0,) 00000365 / SETVAL ARG1,0,(+,ARG2,0,) 00000366 LCDR &RESUL$,&RESUL$ RESULT=-RESULT 00000367 /EPF2F ENDDO L0057,+1 00000368 L0060 LM 7,9,LOOPVAR1 00000369 ENDDO L0027,5 00000370 L0058 SDR 2,2 00000371 STORE &RESUL$,RESULT,0 00000372 SUC4 JUMP EVBAS8 00000373 NOSUC4 JUMP NOSUC1 00000374 FOUT2 ERROR 1,' DD,BINOM,THETA,SIGMA TROUBLE' 00000375 DROP 12 00000376 FFOUT 1,'EVFUN' 00000377 LTORG 00000378 ** 00000379 *** EVEX6 RECUR PROCEDURE(EXPR,DUMPT,RESULT); 00000380 EVEX6 PRO 00000381 / CMPVAL EXPR,0,(+,EXPRES0,0,+,1,0,),NE,L0031 00000382 SET1$0 RESULT,0 THE BUILT IN EXPR 1.0 00000383 B XEVEX6 RETURN LIKE A NORMAL ROUTINE 00000384 /L0031 SETVAL NLEV,0,(+,NLEV,0,+,1,0,) ENTRY WITH RECURSION */ 00000385 SETVAL R$DUMPT,NLEV,(+,DUMPT,0,) 00000386 SETVAL R$A0,NLEV,(+,A0,0,) 00000387 SETVAL R$RETUR,NLEV,(+,EVEX6X,3,) R14 AT ENTRY 00000388 SETVAL R$BASE,NLEV,(+,EVEX6X,1,) R12 AT ENTRY 00000389 SET0$0 T$ASUM,A0 00000390 SET0$0 T$APROD,A0 00000391 / SETVAL CODE,0,(+,EXPR,0,) 00000392 / SET111 T$ASIGN1,A0 OVERALL SIGN OF EXPRES */ 00000393 / GETMIN CODE,0,EVEX7 00000394 / SETVAL T$ASIGN1,A0,(-,1,0,) 00000395 /EVEX7 SETVAL T$AMBU1,A0,(+,MBU1,0,) 00000396 / CMPVAL NLEV,0,(+,41,0,),GE,NOSUC6 00000397 / CMPVAL CODE,0,(+,X'7FF',0,),NE,L0032 00000398 / SETVAL OLD5,0,(+,T$AEXPR1,A0,) 00000399 / B NEXT8 00000400 /L0032 CMPVAL -CODE-TYPE-,0,(+,EXPRES,0,),NE,FOUT3 00000401 SETVAL II5,0,(+,-CODE-NR-,0,) 00000402 CMPBIT L$PROP,II5,TAPE,ON,NOSUC6 00000403 SETVAL OLD5,0,(+,L$BEGIN,II5,) 00000404 *** START NEXT TERM */ 00000405 /NEXT8 CMPVAL T$1POINT,OLD5,(+,X'40',0,),GE,L0033 00000406 / SET000 T$ANTERM,A0 00000407 ** /* D EXPR OR END OF EXPR */ 00000408 / B L0034 00000409 /L0033 SETVAL T$ANTERM,A0,(+,T$1POINT,OLD5,) 00000410 /L0034 SETVAL T$ATERM,A0,(+,OLD5,0,) 00000411 / SET111 T$ASHIFT,A0 00000412 LOAD 0,T$ASUM,A0 00000413 LOAD 4,T$APROD,A0 00000414 PLUS 00000415 TEST 19 00000416 STORE 0,T$ASUM,A0 00000417 SETVAL T$APROD,A0,(+,T$1COEFF,OLD5,) 00000418 ** /* COEF OF NEW TERM IS INITIAL VALUE FOR PRODUCT. */ 00000419 /NEXF1 PVOFA1 CODE,0 VOLGENDE=NEXT FACTOR */ 00000420 / CMP000 CODE,0,EQ,NEXF4 00000421 / CMPVAL -CODE-TYPE-,0,(+,NUMBER,0,),NE,EVBAS1 00000422 *** BASE1=FLOAT(CODE.NR); 00000423 SGNEXT II5,0,-CODE-NR-,0 00000424 FLOAT 0,II5,0 00000425 STORE 0,BASE1,0 00000426 *** COME FROM EVBAS1,EVBA2A. CASE OF CODE=EXPRES OR OPERAT. CAN HAVE */ 00000427 *** AN EXPONENT. IF CODE=FUNCT, THEN NO EXPONENT PRESENT. RETURN */ 00000428 *** VIA EVXP11 */ 00000429 :EVXP2A PVOFA1 CODE,1 GET EXPONENT 00000430 / CMPVAL CODE,0,(+,MINUS,0,),NE,L0036 00000431 / PVOFA1 CODE,1 00000432 / SETVAL -CODE-NR-,0,(-,-CODE-NR-,0,) 00000433 /L0036 CMPVAL -CODE-TYPE-,0,(+,NUMBER,0,),NE,NOSUC6 00000434 SGNEXT EXPO1,0,-CODE-NR-,0 00000435 / CMP000 BASE1,0,NE,L0037 00000436 / CMP000 EXPO1,0,LE,RFO5 00000437 /L0037 CMP000 EXPO1,0,EQ,EVXP13 00000438 / CMP111 EXPO1,0,NE,L0040 00000439 LOAD 0,T$APROD,A0 00000440 LOAD 4,BASE1,0 00000441 MULTP 00000442 STORE 0,T$APROD,A0 00000443 / B EVXP13 00000444 L0040 PBRIAN T$APROD,A0,BASE1,0,EXPO1 00000445 ** /* PROD=PROD*BASE1**EXPO1 */ 00000446 /EVXP13 CMPVAL NLEV,0,(+,41,0,),GE,NOSUC6 00000447 / CMP000 T$APROD,A0,NE,NEXF1 READ NEXT FACTOR*/ 00000448 /NEXF4 SETVAL OLD5,0,(+,T$ANTERM,A0,) START NEXT TERM */ 00000449 / CMP000 OLD5,0,NE,NEXT8 00000450 LOAD 0,T$ASUM,A0 END OF EXPRESSION 00000451 LOAD 4,T$APROD,A0 00000452 PLUS 00000453 TEST 19 00000454 STORE 0,RESULT,0 00000455 SETVAL DUMPT,0,(+,R$DUMPT,NLEV,) 00000456 SETVAL A0,0,(+,R$A0,NLEV,) RETURN WITH RECURSION 00000457 / SETVAL MBU1,0,(+,T$AMBU1,A0,) 00000458 / CMPVAL A0,0,(+,NDIMT,0,-,NEXTA,0,),GT,FOUT3 00000459 ** /* STORE OVERFLOW DURING NUMERICS */ 00000460 / CMPVAL MMBE,0,(+,A0,0,+,NEXTA,0,),GE,L0042 00000461 / SETVAL MMBE,0,(+,A0,0,+,NEXTA,0,) 00000462 *** RESULT=RESULT*IT(A0).SIGN1; 00000463 L0042 LOAD 1,T$ASIGN1,A0 00000464 SRL 1,31 00000465 SLL 1,31 00000466 X 1,RESULT 00000467 ST 1,RESULT 00000468 : SETVAL EVEX6X,3,(+,R$RETUR,NLEV,) 00000469 : SETVAL EVEX6X,1,(+,R$BASE,NLEV,) 00000470 / SETVAL NLEV,0,(+,NLEV,0,-,1,0,) 00000471 B XEVEX6 RETURN WITH RECURSION 00000472 *** 00000473 EVXP11 SETVAL DUMPT,0,(+,R$DUMPT,NLEV,) 00000474 *** EXIT FROM EVSIG,EXTRA,EVSTE,EVFUN. 00000475 SETVAL A0,0,(+,R$A0,NLEV,) 00000476 *** RESULT=IT(A0).PROD*RESULT*IT(A0).SIGN2; 00000477 LOAD 0,RESULT,0 00000478 LOAD 4,T$APROD,A0 00000479 MULTP 00000480 STORE 0,T$APROD,A0 00000481 L 3,A0 00000482 USING T$A,3 00000483 L 1,T$ASIGN2 00000484 SRL 1,31 00000485 SLL 1,31 00000486 X 1,T$APROD 00000487 ST 1,T$APROD 00000488 DROP 3 00000489 / B EVXP13 00000490 ** 00000491 *** FACTOR IN EXPRESSION IS NOT A NUMBER. TRY ITS NUMERICAL EVAL. */ 00000492 /EVBAS1 SETVAL T$AEXPR1,A0,(+,CODE,0,) 00000493 / SETVAL EXPR,0,(+,CODE,0,) CAN CONTAIN MINUS */ 00000494 / SETVAL CODE5,0,(+,CODE,0,) 00000495 / SET111 T$ASIGN2,A0 00000496 / GETMIN CODE5,0,EVBAS2 00000497 / SETVAL T$ASIGN2,A0,(-,1,0,) 00000498 /EVBAS2 CMPVAL -CODE5-TYPE-,0,(+,EXPRES,0,),NE,EVBAS4 00000499 *** THE FACTOR IS AN EXPRESSION. */ 00000500 ** /* THE A0 AND DUMPT OF THIS MOMENT ARE STILL REQUIRED */ 00000501 ** /* AFTER CALL EVEX6. THEY WERE STORED IN LOWER REMEM1 */ 00000502 / SETVAL A0,0,(+,A0,0,+,NEXTA,0,) GO TO HIGHER LEVEL */ 00000503 SETVAL II5,0,(+,-CODE5-NR-,0,) 00000504 CMP000 L$AKEY,II5,EQ,L0043 00000505 SETVAL DUMPT,0,(+,L$AKEY,II5,+,NEXTK,0,) 00000506 ** /* OTHERWISE THE OLD DUMPT STAYS VALID. */ 00000507 L0043 REVEX6 EXPR,DUMPT,RESULT 00000508 SETVAL DUMPT,0,(+,R$DUMPT,NLEV,) 00000509 SETVAL A0,0,(+,R$A0,NLEV,) 00000510 / SETVAL BASE1,0,(+,RESULT,0,) 00000511 / B EVXP2A 00000512 ** 00000513 :EVBAS4 CMPVAL CODE5,0,(+,DP,0,),GT,EVBA2A 00000514 CMPVAL CODE5,0,(+,DD,0,),LT,EVBA2A 00000515 *** THE FACTOR IS A NUMERICAL FUNCTION */ 00000516 / SET000 DREQ1,0 00000517 / SETVAL K,0,(+,A0,0,+,NEXTA,0,) 00000518 / SETVAL L,0,(+,K,0,) 00000519 / SETVAL T$AEXPR2,A0,(+,CODE5,0,) DOES NOT CONTAIN MINUS */ 00000520 / CMPVAL CODE5,0,(+,DS,0,),NE,EVBAS5 00000521 / PVOFA1 CODE,1 GET KEY IN */ 00000522 / SETVAL T$0WORD,L,(+,CODE,0,) NUMBER OF DUMMIES */ 00000523 / CMPVAL -CODE-TYPE-,0,(+,NUMBER,0,),NE,NOSUC6 00000524 / SETVAL L,0,(+,L,0,+,NEXTR,0,) SAME AS IN IEP */ 00000525 LOAD 1,-CODE-NR-,0 00000526 SR 1,6 00000527 SLA 1,2 *NEXTR 00000528 A 1,L 00000529 ST 1,KK 00000530 DOLOOP K,L,KK,NEXTR,L0044,L0045 00000531 / PVOFA1 CODE,1 COPY DUMMIES */ 00000532 / SETVAL T$0WORD,K,(+,CODE,0,) 00000533 / ENDDO L0044,5 00000534 /L0045 SETVAL K,0,(+,KK,0,+,NEXTR,0,) 00000535 *** EXPAND FUNCTION AND ITS ARG. SAME FORMAT AS IEP. BUT LOCATED IN IT* 00000536 *** DUMMIES ARE REPLACED BY ACTUAL VALUES IN VOFA1 */ 00000537 /EVBAS5 PVOFA1 CODE,1 GET NEXT ARGUMENT */ 00000538 / CMPVAL -CODE-TYPE-,0,(+,OPERAT,0,),EQ,WORK1 00000539 / CMPVAL -CODE-TYPE-,0,(+,EXPRES,0,),EQ,WORK8 00000540 /EVBAS7 SETVAL T$0WORD,K,(+,CODE,0,) STORE CURRENT ARGUMENT */ 00000541 / SETVAL K,0,(+,K,0,+,NEXTR,0,) SAME AS IN IEP */ 00000542 / CMPVAL CODE,0,(+,FUNCT0,0,),NE,EVBAS5 00000543 / SETVAL K,0,(+,K,0,-,NEXTR,0,) ALL ARGS EVAL. INSPECT FU 00000544 / SETADR J,0,(+,T$AEXPR2,A0,) 00000545 ST 12,REG12 BASEREG FOR RETURN VIA EVBAS8 TO EVXF11 00000546 /EVBA7A CMPVAL T$8FU,J,(+,DX,0,),NE,LL012 00000547 JUMP EXTRA1 00000548 LL012 CMPVAL T$8FU,J,(+,DS,0,),NE,LL013 00000549 JUMP EVSIG1 00000550 EVFUN02 JUMP EVFUN0 00000551 /LL013 CMPVAL T$8FU,J,(+,DD,0,),NE,EVFUN02 00000552 / CMPVAL -T$8ARG1-TYPE-,J,(+,NUMBER,0,),EQ,EVFUN02 NUMERIC DD 00000553 / CMPVAL T$8ARG1,J,(+,STANDX,0,),NE,NOSUC6 00000554 / SETVAL CODE,0,(+,T$8DLOC,J,) 00000555 / SET000 OLDCODE,0 00000556 GETOPR CODE,0,OLDCODE 00000557 /EVB7B CMPVAL -CODE-TYPE-,0,(+,FUNCT,0,),NE,EVB7C 00000558 ** /* CASE OF DUMMY FU . SKIP DD 1000B */ 00000559 / CMPVAL OLDCODE,0,(+,MINUS,0,),NE,L0046 00000560 / SETVAL T$ASIGN2,A0,(-,T$ASIGN2,A0,) 00000561 / SETVAL T$8DLOC,J,(+,CODE,0,) 00000562 /L0046 SETVAL J,0,(+,J,0,+,2*NEXTR,0,) 00000563 / B EVBA7A 00000564 /EVB7C CMPVAL -CODE-TYPE-,0,(+,EXPRES,0,),NE,EVB7E 00000565 / SETVAL NN,0,(+,-CODE-NR-,0,) 00000566 / CMPBIT X$PROP,NN,FILE,ON,EVB7G 00000567 / SETVAL T$8ARG1,J,(+,XEXPR,0,) 00000568 / CMPBIT X$PROP,NN,XORD,ON,EVB7D 00000569 / SETVAL T$8ARG1,J,(+,DEXPR,0,) 00000570 /EVB7D SETVAL T$8DLOC,J,(+,EXPRES0,0,+,X$LOCNR,NN,) 00000571 / CMPVAL OLDCODE,0,(+,MINUS,0,),NE,LL014 00000572 PUTMIN T$8DLOC,J 00000573 LL014 JUMP EVSTE1 00000574 /EVB7G SETVAL T$8ARG1,J,(+,ZEXPR,0,) 00000575 / CMPBIT X$PROP,NN,NINDX,ON,EVB7D 00000576 / CMPVAL -T$8DINDX-TYPE-,J,(+,NUMBER,0,),NE,NOSUC6 00000577 / DOLOOP NN,3,NXEX,1,L0050,NOSUC6 00000578 SETVAL II5,0,(+,-CODE-NR-,0,) 00000579 : CMPNAM X$NAME,NN,X$NAME,II5,NE,EVB7H 00000580 / CMPVAL X$INDEX,NN,(+,-T$8DINDX-NR-,J,),EQ,EVB7D 00000581 /EVB7H ENDDO L0050,+1 00000582 / B NOSUC6 00000583 /EVB7E CMPVAL -CODE-TYPE-,0,(+,ARGFU,0,),NE,NOSUC6 00000584 / CMPVAL CODE,0,(+,ARGFU0,0,),LT,NOSUC6 00000585 / SETVAL CODE,0,(+,CODE,0,-,ARGFU0,0,+,FUNCT0,0,) 00000586 / B EVB7B 00000587 ** 00000588 /WORK8 CMP000 DREQ1,0,EQ,EVBAS7 EXPRES AS FU ARG */ 00000589 SETVAL II5,0,(+,-CODE-NR-,0,) 00000590 SETVAL L$PROP,MBU1,(+,L$PROP,II5,) 00000591 SETVAL L$BEGIN,MBU1,(+,L$BEGIN,II5,) 00000592 SETVAL L$DUMNR,MBU1,(+,L$DUMNR,II5,) 00000593 / SETVAL L$AKEY,MBU1,(+,DUMPT,0,-,NEXTK,0,) 00000594 / SETVAL CODE,0,(+,EXPRES0,0,+,MBU1,0,) 00000595 / SETVAL MBU1,0,(+,MBU1,0,+,1,0,) 00000596 / SET000 DREQ1,0 00000597 / B EVBAS7 00000598 ** 00000599 WORK1 SETVAL CODE5,0,(+,CODE,0,) OPERAT INSIDE FU ARG 00000600 GETMIN CODE5,0,EMPTY1,RFO6 ONLY MINUS CAN BE COMPOUND QU 00000601 *** IF I GUESSED RIGHT 00000602 B EVBAS7 //EXPR MINUS// 00000603 EMPTY1 CMPVAL CODE,0,(+,INTEG,0,),EQ,LL003 00000604 CMPVAL CODE,0,(+,INTEGM,0,),EQ,LL003 00000605 CMPVAL CODE,0,(+,KREQ,0,),EQ,WORK7 00000606 CMPVAL CODE,0,(+,MINUS,0,),GT,NOSUC6 NON NUMERIC OPERAT 00000607 BL RFO6 00000608 PVOFA1 CODE,1 MINUS WAS PRESENT 00000609 SETVAL CODE5,0,(+,CODE,0,) 00000610 GETMIN CODE5,0,EMPTY2,WORK6 00000611 SETVAL CODE,0,(+,CODE5,0,) 00000612 B EVBAS7 //MINUS//EXPR MINUS// 00000613 EMPTY2 CMPVAL CODE,0,(+,MINUS,0,),NE,WORK6 //MINUS//EXPR// 00000614 B EVBAS5 //MINUS//MINUS// 00000615 WORK7 SET111 DREQ1,0 KREQ FOR NEXT EXPR 00000616 B EVBAS5 00000617 /LL003 SETVAL OLDCODE,0,(+,CODE,0,) 00000618 / PVOFA1 CODE,1 00000619 / CMPVAL -CODE-TYPE-,0,(+,EXPRES,0,),NE,RFO6 ILLEGAL INTEG AR 00000620 / CMPVAL OLDCODE,0,(+,INTEGM,0,),NE,L0053 00000621 / PUTMIN CODE,0 00000622 /L0053 SETVAL T$0WORD,K,(+,CODE,0,) 00000623 / SETVAL T$AK,A0,(+,K,0,) 00000624 / SETVAL EXPR,0,(+,T$0WORD,K,) 00000625 / SETVAL A0,0,(+,K,0,+,NEXTW,0,) 00000626 REVEX6 EXPR,DUMPT,RESULT 00000627 : SETVAL DUMPT,0,(+,R$DUMPT,NLEV,) 00000628 : SETVAL A0,0,(+,R$A0,NLEV,) 00000629 / SETVAL K,0,(+,T$AK,A0,) 00000630 *** RESULT=RESULT*(1+2**-70); 00000631 LOAD 0,RESULT,0 ROUND UPWARDS BEFORE TRUNCATING TO 00000632 LER 4,0 INTEGER 00000633 ME 4,=X'2F400000' 2**-70 00000634 PLUS 00000635 FIX 0,RESULFX,0 00000636 L 1,RESULFX 00000637 LPR 1,1 IF ABS(RESULFX) GT 128 THEN GOTO RFO7 00000638 SRA 1,7 00000639 BNE RFO7 NR GT 128 IN STAND EXPR 00000640 / SETVAL -CODE-NR-,0,(+,RESULFX,0,) 00000641 / SETVAL -CODE-TYPE-,0,(+,NUMBER,0,) 00000642 / B EVBAS7 00000643 *** FACTOR = MINUS , NEWFACTOR . IF NEWFACTOR = NUMBER THEN MAKE */ 00000644 *** . -NUMBER . ELSE MAKE . NEWFACTOR MINUS . */ 00000645 /WORK6 CMPVAL -CODE-TYPE-,0,(+,EXPRES,0,),NE,WORK6A 00000646 / CMP000 DREQ1,0,EQ,WORK6B 00000647 / SET000 DREQ1,0 HONOR KEY REQUEST */ 00000648 SETVAL II5,0,(+,-CODE-NR-,0,) 00000649 SETVAL L$PROP,MBU1,(+,L$PROP,II5,) 00000650 SETVAL L$BEGIN,MBU1,(+,L$BEGIN,II5,) 00000651 SETVAL L$DUMNR,MBU1,(+,L$DUMNR,II5,) 00000652 / SETVAL L$AKEY,MBU1,(+,DUMPT,0,-,NEXTK,0,) 00000653 / SETVAL CODE,0,(+,EXPRES0,0,+,MBU1,0,) 00000654 / SETVAL MBU1,0,(+,MBU1,0,+,1,0,) 00000655 / B WORK6B 00000656 /WORK6A CMPVAL -CODE-TYPE-,0,(+,NUMBER,0,),NE,WORK6B 00000657 / SETVAL -CODE-NR-,0,(-,-CODE-NR-,0,) 00000658 / B EVBAS7 00000659 /WORK6B PUTMIN CODE,0 00000660 / B EVBAS7 00000661 ** 00000662 *** THE FACTOR IS NOT A NUM. FU OR AN EXPRES. */ 00000663 /EVBA2A SETVAL CODE,0,(+,CODE,0,+,FUNCT0,0,-,ARGFU0,0,) 00000664 : CMPVAL CODE,0,(+,DD,0,),LT,LL001 00000665 : CMPVAL CODE,0,(+,DP,0,),LE,EVBAS4 00000666 /LL001 SETVAL CODE,0,(+,CODE,0,+,ARGFU0,0,-,FUNCT0,0,) 00000667 / SETVAL OLDCODE,0,(+,CODE,0,) 00000668 : CMPVAL CODE,0,(+,INTEG,0,),EQ,LL004 00000669 : CMPVAL CODE,0,(+,INTEGM,0,),NE,NOSUC6 00000670 /LL004 PVOFA1 CODE,1 00000671 / CMPVAL -CODE-TYPE-,0,(+,EXPRES,0,),NE,RFO6 ILLEGAL INTEG AR 00000672 / CMPVAL OLDCODE,0,(+,INTEGM,0,),NE,L0055 00000673 / PUTMIN CODE,0 00000674 /L0055 SETVAL T$AEXPR1,A0,(+,CODE,0,) 00000675 SETVAL EXPR,0,(+,CODE,0,) 00000676 / SETVAL A0,0,(+,A0,0,+,NEXTA,0,) 00000677 REVEX6 EXPR,DUMPT,RESULT 00000678 SETVAL DUMPT,0,(+,R$DUMPT,NLEV,) 00000679 SETVAL A0,0,(+,R$A0,NLEV,) 00000680 *** RESULT=RESULT*(1+2**-70); 00000681 LOAD 0,RESULT,0 ROUND UPWARDS BEFORE TRUNCATING TO 00000682 LER 4,0 INTEGER 00000683 ME 4,=X'2F400000' 00000684 PLUS 00000685 FIX 0,RESULFX,0 00000686 FLOAT 0,RESULFX,0 00000687 STORE 0,BASE1,0 00000688 / B EVXP2A 00000689 NOSUC6 JUMP NOSUC1 00000690 FOUT3 ERROR 2,' STORE OVFLOW DURING NUMERICS' 00000691 RFO5 ERROR 2,' DIVISION BY ZERO' 00000692 RFO6 ERROR 2,' ILLEGAL INTEG ARGUMENT' 00000693 RFO7 ERROR 2,' NR GE 128 AS ARG IN STAND.EX.' 00000694 XEVEX6 LM 12,14,EVEX6X EXPLICIT EXPANSION OF EPI TO BE ABLE 00000695 BR 14 TO USE EVEX6X EXPLICITLY. 00000696 EVEX6X DS 3F 00000697 DROP 12 00000698 FFOUT 2,'ROTSOI' 00000699 LTORG 00000700 ** 00000701 *** GIVE NEXT FACTOR. IF FLAG=1 THEN END OF TERM MEANS NOSUCCESS */ 00000702 *** ELSE END OF TERM IS ACCEPTED SO THAT A NEW TERM CAN BE STARTED. */ 00000703 *** FLAG=1 FOR EXPONENT,OPERATOR,FU-ARG,KEY INSIDE DS-FU. THEN AN END * 00000704 *** OF TERM CAN NOT OCCUR. */ 00000705 *** AT THE SAME TIME, DUMMIES ARE REPLACED BY THEIR ACTUAL VALUES */ 00000706 DS 0H 00000707 USING *,15 00000708 *** VOFA1 PRO CODE FLAG 00000709 /VOFA1 SETVAL N,0,(+,T$ASHIFT,A0,) 00000710 SETVAL II5,0,(+,T$ATERM,A0,) 00000711 : SETVAL CODE,0,(+,T$1CODEA,-II5-N-,) 00000712 / SETVAL T$ASHIFT,A0,(+,N,0,+,1,0,) 00000713 / CMP000 CODE,0,EQ,VOFA2 00000714 / CMPVAL -CODE-TYPE-,0,(+,DUMMY,0,),NE,RETURN 00000715 *** CODE=IT(DUMPT+(CODE.NR-1)*NEXTK).VAR; 00000716 ** /* DUMPT IS (A) OF FIRST DUMMY */ 00000717 LOAD 1,-CODE-NR-,0 00000718 SR 1,6 00000719 SLA 1,2 00000720 A 1,DUMPT 00000721 ST 1,II5 00000722 SETVAL CODE,0,(+,T$0VAR,II5,) 00000723 / CMPVAL -CODE-TYPE-,0,(+,DUMMY,0,),NE,RETURN 00000724 NOSUC5 JUMP NOSUC1 00000725 /VOFA2 CMP111 FLAG,0,EQ,NOSUC5 END OF TERM */ 00000726 / BR 14 00000727 DROP 15 00000728 *** 00000729 DS 0H 00000730 USING *,15 00000731 *** FIND ABS ADDR OF BEGIN OF COMPONENT OF D-EXPR */ 00000732 *** FORMAT OF CALLING D-EXPRES IS DD DEXPR DLOC DINDX ARG1 ... */ 00000733 *** SEARCH PRO J1 M ABS ADRESSES 00000734 /SEARCH CMPVAL -T$8DLOC-TYPE-,J1,(+,EXPRES,0,),NE,FOUT4 00000735 SETVAL II5,0,(+,-T$8DLOC-NR-,J1,) 00000736 SETVAL M,0,(+,L$BEGIN,II5,-,NEXTW,0,) 00000737 / SETVAL N,0,(+,-T$8DINDX-NR-,J1,) 00000738 /SER1 SETVAL M,0,(+,M,0,+,NEXTW,0,) 00000739 / CMP111 T$1POINT,M,EQ,ENDS1 END OF EXPR */ 00000740 / CMPVAL T$1POINT,M,(+,2,0,),NE,SER1 END OF TERM */ 00000741 / SETVAL N,0,(+,N,0,-,1,0,) 00000742 / CMP000 N,0,NE,SER1 00000743 / BR 14 00000744 /ENDS1 SETVAL N,0,(+,N,0,-,1,0,) 00000745 / CMP000 N,0,EQ,RETURN 00000746 FOUT4 ERROR 3,' DATA EXPR. OUT OF RANGE' 00000747 DROP 15 00000748 FFOUT 3,'SEARCH' 00000749 END 00000750 ./A SCHOON1,INCR=1 00000001 ./MACRO MAINMCRO 00000002 ./MACRO INMACRO 00000003 TITLE 'SCHOON1' 00000004 GBLC &OVLAY 00000005 LCLA &PT$B,&PT$L,&WORD 00000006 ./MACRO INCOM 00000007 ./MACRO MAINCOM 00000008 PRINT NOGEN 00000009 SCHOON1 CSECT 00000010 EQUIVAL 00000011 ENTRY SCHOON,FNAM2,GOON1,NBLANK1 00000012 EXTRN CCROSR 00000013 EXTRN ZOEK,FOUTP,SNAME1,LEZE1,FOUT,RWND,RWND4,LIJN,INPHU 00000014 EXTRN SEAR3,SEAR4,WREND1,PRIN3,INDON,SARAY1,READI1,COVNR1 00000015 EXTRN SEAR1,FREEZE,MAIN,STEXPR,IDTFIER,STAR1,PAKB1,COSYM1 00000016 CROSR EQU CCROSR 00000017 SCHOON PROLOGH 00000018 L 10,=V(INCOM) 00000019 USING INCOM,10 00000020 CCALL INITIAL 00000021 / PMOV12 DOVLAG MOVE DOLOOP,BLOCK ARGS */ 00000022 / PMOV12 BLOKPT FORWARD (*YEP) OR PICK*/ 00000023 / PLEZE1 UP THEIR ADDRESSES */ 00000024 SETVAL K,0,(+,NDIMT,0,-,8,0,) 2 WORDS FOR SAFETY 00000025 L 7,MBE 00000026 L 9,K 00000027 LA 8,2*NEXTW 00000028 L0007 ST 0,0(7) SET ITIN TO ZERO 00000029 ST 0,4(7) 2 WORDS AT THE TIME 00000030 / BXLE 7,8,L0007 00000031 L0010 JUMP NBLANK1 00000032 DROP 12 00000033 LTORG 00000034 ** 00000035 *** INSPEC1: PROCEDURE ; /* INSPECT TERMINATOR 00000036 DS 0H 00000037 USING *,15 00000038 /INSPEC1 CMPVAL NBIND,0,(+,X'77',0,) 00000039 BE INSPEC2 00000040 / CMP000 NBLAN1,0 00000041 BNE INSPEC3 00000042 / CMPCAR NBIND,0,C'.',1 00000043 BE INSPEC2 00000044 / CMPCAR NBIND,0,C',',1 00000045 / BER 14 00000046 / CMPCAR NBIND,0,C'=',1 00000047 / BER 14 00000048 INSPEC2 JUMP GOON1 00000049 INSPEC3 JUMP NBLANK1 00000050 DROP 15 00000051 ** 00000052 DS 0H 00000053 USING *,12 00000054 /GOON1 SET000 IDIND1,0 START NEW STATEMENT */ 00000055 / SET000 NORDER,0 00000056 / PLEZE1 00000057 LA 12,NBLANK1 00000058 DROP 12 00000059 DS 0H 00000060 USING *,12 00000061 NBLANK1 LADR 1,A,1 00000062 MVC BEGIN(3),0(1) 00000063 *** THIS IS IN FACT A TABLE WITH NORDER (12 BITS), 3 CHARS (18 BITS ) * 00000064 *** JUMP ADDRESS ( 18 BITS ). * 00000065 / SETVAL NORDER,0,(+,11,0,) 00000066 / CMPCAR BEGIN,0,C'BLO',3 00000067 / BE BLOK1 00000068 / CMPCAR BEGIN,0,C'COM',3 00000069 / BE COMMO1 00000070 / CMPCAR BEGIN,0,C'DEL',3 00000071 / BE DELET1 00000072 / CMPCAR BEGIN,0,C'FRE',3 00000073 / BE FREEZ1 00000074 / CMPCAR BEGIN,0,C'KEE',3 00000075 / BE KEEP1 00000076 / CMPCAR BEGIN,0,C'NAM',3 00000077 / BE FNAM1 00000078 / CMPCAR BEGIN,0,C'NBL',3 00000079 / BE NBLO1 00000080 CMPCAR BEGIN,0,C'NPR',3 00000081 BE NPRIN1 00000082 CMPCAR BEGIN,0,C'OLD',3 00000083 / BE OLDNE1 00000084 / CMPCAR BEGIN,0,C'PUN',3 00000085 / BE PUNCH1 00000086 / CMPCAR BEGIN,0,C'PRI',3 00000087 / BE PRIN1 00000088 / CMPCAR BEGIN,0,C'SUM',3 00000089 / BE SUMI1 00000090 / CMPCAR BEGIN,0,C'STO',3 00000091 / BE STORE1 00000092 / CMPCAR BEGIN,0,C'SPA',3 00000093 / BE SPAC1 00000094 *** THIS IS IN FACT A TABLE WITH THE CHARACTERS IN ASCENDING ORDER, TO* 00000095 *** MAKE SURE THAT EACH CARD GETS ASSOCIATED WITH A CERTAIN LABEL, * 00000096 *** EVEN IF ITS KEYWORD IS ILLEGAL. */ 00000097 CMPCAR BEGIN,0,C'+',1 00000098 BL GOON2 00000099 CMPCAR BEGIN,0,C'$',1 00000100 BL SPACE2 00000101 CMPCAR BEGIN,0,C'*',1 00000102 BL DOLLA1 00000103 CMPCAR BEGIN,0,C'-',1 00000104 BL EXIT1 00000105 CMPCAR BEGIN,0,X'77',1 00000106 BL SPACE3 00000107 CMPCAR BEGIN,0,C'=',1 00000108 BL GOON2 00000109 CMPCAR BEGIN,0,C'A',1 00000110 BL IDENI1 00000111 CMPCAR BEGIN,0,C'AL',2 00000112 BL GOON2 00000113 / BE IDENA1 00000114 CMPCAR BEGIN,0,C'B',1 00000115 BL GOON2 00000116 CMPCAR BEGIN,0,C'C',1 00000117 BL BRACK1 00000118 CMPCAR BEGIN,0,C'D',1 00000119 BNL L0012 00000120 / SET000 NORDER,0 00000121 B GOON2 00000122 L0012 CMPCAR BEGIN,0,C'F',1 00000123 BNL L0013 00000124 / SET111 DATAFL1,0 00000125 / B XIDEN1 00000126 L0013 CMPCAR BEGIN,0,C'I',1 00000127 BNL L0014 00000128 PNAMEL1 F 00000129 L0014 CMPCAR BEGIN,0,C'ID',2 00000130 / BE IDENI1 00000131 CMPCAR BEGIN,0,C'L',1 00000132 BNL L0015 00000133 PNAMEL1 I 00000134 L0015 CMPCAR BEGIN,0,C'N',1 00000135 BL IDENL1 00000136 CMPCAR BEGIN,0,C'R',1 00000137 BL NUMER1 00000138 CMPCAR BEGIN,0,C'S',1 00000139 BNL L0016 00000140 / SET111 RIND1,0 00000141 / SETVAL NORDER,0,(+,10,0,) 00000142 / B MAINX1 00000143 L0016 CMPCAR BEGIN,0,C'V',1 00000144 BNL L0017 00000145 PNAMEL1 S 00000146 L0017 CMPCAR BEGIN,0,C'X',1 00000147 BNL L0020 00000148 PNAMEL1 V 00000149 L0020 CMPCAR BEGIN,0,C'Z',1 00000150 BL XIDEN1 00000151 CMPCAR BEGIN,0,C'0',1 00000152 BL MAINX1 00000153 B SPACE1 00000154 GOON2 JUMP GOON1 00000155 NUMER1 JUMP NUMER 00000156 MAINX1 JUMP MAIN 00000157 FREEZ1 CCALL FREEZE 00000158 B GOON2 00000159 ** 00000160 /COMMO1 PSEAR1 COMMON FIA,FIB(0)... */ 00000161 /COM1 PLEZE1 00000162 / CMP000 IAL,0 00000163 / BE COM3 00000164 PZOEK X,SYMB1,IA 00000165 / SETBIT X$PROP,IA,COMON,ON 00000166 / CMPBIT X$PROP,IA,FILE,ON 00000167 / BZ L0024 00000168 / CMPBIT X$PROP,IA,NINDX,ON THE FILE EXISTED ALREADY 00000169 BO LL012 00000170 CMPCAR NBIND,0,C'(',1 00000171 BNE FOS20 INDEXING CONFLICT 00000172 B L0025 00000173 LL012 CMPCAR NBIND,0,C'(',1 00000174 BE FOS20 00000175 / B L0025 00000176 /L0024 SETBIT X$PROP,IA,FILE,ON A NEW ENTRY IN NXGEH 00000177 / CMPCAR NBIND,0,C'(',1 00000178 / BNE L0277 00000179 / SETBIT X$PROP,IA,NINDX,OFF 00000180 B L0025 00000181 /L0277 SETBIT X$PROP,IA,NINDX,ON 00000182 /L0025 CMPCAR NBIND,0,C'(',1 00000183 / BNE COM3 00000184 / PLEZE1 READ OVER INDEX */ 00000185 / PLEZE1 READ OVER ) */ 00000186 /COM3 CMPVAL NBIND,0,(+,X'77',0,) 00000187 / BNE COM1 00000188 / SETVAL MTAB,18,(+,NXEX,0,) 00000189 / SETVAL MTAB,19,(+,NXEX,0,) 00000190 B GOON2 00000191 ** 00000192 /KEEP1 SET111 IB,0 00000193 / B DEL0 00000194 /PRIN1 SETVAL IB,0,(+,2,0,) 00000195 / B DEL0 00000196 /NPRIN1 SETVAL IB,0,(+,3,0,) 00000197 / B DEL0 00000198 /PUNCH1 SET111 NCONT,1 00000199 / SETVAL IB,0,(+,4,0,) 00000200 / B DEL0 00000201 /STORE1 SET111 NCONT,4 STORE RESULTS ON TAPE3 */ 00000202 / SETVAL IB,0,(+,5,0,) 00000203 / B DEL0 00000204 /DELET1 SET000 IB,0 IB INDICATES WHICH BIT TO BE SET ON OR OFF*/ 00000205 *** IB=0,DELETE. =1,KEEP. =2,PRINT. =3,NPRINT. =4,PUNCH. =5,STORE * 00000206 DEL0 JUMP DEL 00000207 ** 00000208 /FNAM1 PSEAR1 NAMES FIA,FIB(3),... */ 00000209 /FNA1 PRFIL1 NNAME,IINDEX,FFLAG 00000210 / DOLOOP NR,1,NXEX,1,L0032,L0033 00000211 / CMPNAM X$NAME,NR,NNAME,0 00000212 / BNE FNA3 00000213 / CMP000 FFLAG,0 00000214 / BNE FNA4 00000215 / CMPVAL X$INDEX,NR,(+,IINDEX,0,) 00000216 / BNE FNA3 00000217 /FNA4 CMP000 X$LOCNR,NR 00000218 / BE FNA3 00000219 / CMPBIT X$PROP,NR,FILE,OFF 00000220 / BZ FNA3 00000221 / CMPBIT X$PROP,NR,COMON,OFF 00000222 / BZ FNA3 00000223 SETVAL K,0,(+,X$LOCNR,NR,) 00000224 CMPBIT L$PROP,K,TAPE,OFF 00000225 BZ FNA3 00000226 / PFNAM2 NR 00000227 / B FNA8 00000228 /FNA3 BXLE 7,8,L0032 00000229 /L0033 B FNA7 00000230 /FNA8 SETVAL MTAB,5,(+,MBE,0,) 00000231 /FNA7 CMPVAL NBIND,0,(+,X'77',0,) 00000232 / BNE FNA1 00000233 B GOON2 00000234 ** 00000235 BLOK1 CCALL COPY34 GET BLOCKS IN 00000236 / SET000 NI,0 ANALYSIS OF BLOCK CARD */ 00000237 / SET000 END5,0 00000238 CCALL SEAR3 00000239 / CMPCAR A,NI,C'(',1 00000240 / BNE FOS22 /* WRONG USE OF BLOCKS * 00000241 CCALL SEAR4 00000242 PPAKB1 C'REPLACED ' 00000243 LADR 1,T$6NEXT6,MBE 00000244 MVC 0(L'T$5CARD,1),IBUF+24 00000245 LADR 1,T$6BNAME,MBE 00000246 MVC IBUF+20(L'T$6BNAME),0(1) 00000247 / SETVAL IBUF,1,(+,NTAP3,0,) 00000248 / SET000 IBUF,3 00000249 MVC IBUF+20+L'T$6BNAME(L'T$6BTYPE),=C'AVAILABLE ' 00000250 LA 1,(T$6NEXT6-T$6BNAME)/4 00000251 STORE 1,IBUF,4 00000252 CALLFTN LIJN 00000253 LADR 1,T$6NEXT6,MBE 00000254 MVC IBUF+20(L'T$5CARD),0(1) CARD WITH BEGIN OF ARG 00000255 / SETVAL IBUF,4,(+,&CARDLEN,0,) 00000256 ST 1,MBE5 THIS CARD HAS BLANK SUPPRESSION 00000257 LA 9,L'T$5CARD-NEXTW(1) FIND TERMINATING 00 00000258 DOLOOP J,MBE5,,NEXTW,LL004,LL005 REDUCE IBUF(4) 00000259 CMPCAR T$0CHARR,J,X'00',1,EQ,BLOK11 ACCORDINGLY 00000260 BXLE 7,8,LL004 00000261 LL005 CALLFTN LIJN 00000262 /BLOK6 PINPHU NTAP1 COPY BLOCK FROM INPUT TO */ 00000263 CCALL PRIN3 00000264 / SETVAL IBUF,1,(+,NTAP3,0,) 00000265 / SET111 IBUF,3 00000266 CALLFTN LIJN 00000267 / CMPCAR IBUF,7,C'ENDBLOCK ',9 00000268 / BNE L0053 00000269 / SET000 DUMCAR,0 /* NO DUMMY CARD GENERAT. */ 00000270 B GOON2 00000271 /L0053 CMPCAR IBUF,7,C'COP',3 00000272 / BE FOS22 00000273 / CMPCAR IBUF,7,C'BLO',3 00000274 / BE FOS22 WRONG USE OF BLOCKS*/ 00000275 / CMPCAR IBUF,7,C'DO',2 00000276 / BE FOS22 00000277 / B BLOK6 00000278 BLOK11 L 1,J 00000279 S 1,MBE5 00000280 LA 1,NEXTW(1) 00000281 SRA 1,2 00000282 STORE 1,IBUF,4 IBUF(4)=(J-MBE5+NEXTW)/4 00000283 B LL005 00000284 ** 00000285 NBLO1 CCALL COPY34 DELETE BLOCKS 00000286 / CMP000 ITNAM1,0 00000287 BE GOON2 00000288 / SET000 NI,0 00000289 / SET000 END5,0 00000290 NBLO2 CCALL SEAR3 00000291 CCALL SEAR4 00000292 / PPAKB1 C'DELETED ' 00000293 / CMP000 NI,0 00000294 / BNH NBLO2 JP UNTILL NOMORE */ 00000295 / SETVAL NI,0,(+,80,0,) CONTINUATION CARDS */ 00000296 / SETVAL DUMCAR,0,(-,2,0,) DUMMY CARD GENERATION */ 00000297 B GOON2 00000298 ** 00000299 *** REDEFINE DIMENSION OF INPUT ARRAY. * 00000300 /SPAC1 PSEAR1 00000301 / PLEZE1 00000302 / CMP000 NRFLAG1,0 00000303 / BE FOS9 ERROR IN LAST LINE*/ 00000304 / SETVAL NDIMT,0,(+,NRFIX,0,+,MTAB,1,) 00000305 / SETVAL MTAB,7,(+,NDIMT,0,) 00000306 / CMPVAL NDIMU,0,(+,1000,0,+,NDIMT,0,) 00000307 / BL FOS9 00000308 B GOON2 00000309 ** 00000310 *** MAIN EXPRESSIONS AND Z-EXPRESSIONS AND R - EXPRESSIONS */ 00000311 /XIDEN1 SET000 NDUMY,0 CASE OF X - EXPRESSION */ 00000312 / SETVAL NORDER,0,(+,7,0,) 00000313 / PLEZE1 00000314 PSARAY1 X$NAME,SYMB1,NR 00000315 / CMP000 NR,0 00000316 / BE L0062 00000317 / CMPBIT X$PROP,NR,FILE,ON 00000318 BO FOS21 NAME ALREADY USED FOR EXPR. 00000319 /L0062 SETVAL IDIND1,0,(-,1,0,) 00000320 PZOEK X,SYMB1,IB 00000321 / SETVAL XDRE1,0,(+,IB,0,) 00000322 / CMPVAL IB,0,(+,128,0,) 00000323 / BH FOS8 TOO MANY X-EXPRESSIONS */ 00000324 / SETVAL X$LOCNR,IB,(+,MBU,0,) 00000325 SET000 X$DEPTH,IB FOR RECURSIVE USE 00000326 / CMP000 DATAFL1,0 00000327 / BNE L0063 00000328 / SETBIT X$PROP,IB,XORD,ON 00000329 /L0063 CMPCAR NBIND,0,C'(',1 00000330 / BE SO185B 00000331 / CMPCAR NBIND,0,C'=',1 00000332 / BE STEX1 00000333 / B FOS9 ERROR IN LAST LINE */ 00000334 /SO185B PREADI1 NDUMFL ANALYSIS OF ARGUMENTS */ 00000335 *** ALL ARGUMENTS OF X/D EXPR ARE ASSUMED TO BE DUMMY * 00000336 / CMP000 NDUMFL,0 00000337 / BE L0064 00000338 PZOEK D,SYMB1,IB 00000339 /L0064 CMPCAR NBIND,0,C',',1 00000340 / BE SO185B 00000341 / CMPCAR NBIND,0,C')',1 00000342 / BNE FOS9 ERROR IN LAST LINE */ 00000343 / PLEZE1 00000344 / CMPCAR NBIND,0,C'=',1 00000345 / BE STEX1 00000346 / B FOS9 00000347 ** 00000348 *** DOLLAR 7 7 6 = . . . */ 00000349 /DOLLA1 PLEZE1 00000350 / SETVAL NCIND,0,(+,NCIND,0,+,1,0,) 00000351 / SET000 IDIND1,0 00000352 L 8,SYMB1 CONVERT C'$0.*' INTO X'.*' 00000353 SLL 8,12 00000354 SRDL 8,15 00000355 SRL 8,5 00000356 SRDL 8,3 00000357 SRL 8,5 00000358 SLDL 8,6 00000359 ST 8,K 00000360 / CMP000 K,0 00000361 BH FOS27 WRONGLY NESTED SUBEXPRESSIONS 00000362 / CMPVAL K,0,(+,&LISCAL,0,) 00000363 BH FOS27 WRONGLY NESTED SUBEXPRESSIONS 00000364 CMP000 ISCAL$M,K 00000365 / BE L0072 00000366 SETVAL NR,0,(+,MBU,0,+,X'500',0,) 00000367 SETVAL IA,0,(+,ISCAL$P,K,) 00000368 SETVAL IB,0,(+,ISCAL$S,K,) 00000369 SETVAL T$1CODEA,-IA-IB-,(+,NR,0,) 00000370 SET000 ISCAL$M,K 00000371 SET000 ISCAL$S,K 00000372 L0072 SETVAL ISCAL$P,K,(+,X'500',0,+,MBU,0,) 00000373 ** /* THIS OCCURS E.G. IN Z=F(A,B,(C)+A) WHERE THE ACTION */ 00000374 ** /* OF ROUTINE FORWAR CREATES $$777=C; $$776=$777+A */ 00000375 ** 00000376 STEX1 JUMP STEXPR 00000377 ** 00000378 /SUMI1 PSEAR1 SET CREATED BIT FOR INDICES */ 00000379 /SUM1 PLEZE1 00000380 PZOEK I,SYMB1,IA 00000381 / SETBIT I$PROP,IA,CREAT,ON 00000382 / CMPVAL NBIND,0,(+,X'77',0,) 00000383 / BNE SUM1 00000384 B GOON2 00000385 ** 00000386 *** CONSTRUCT A NEW BRACKET LIST */ 00000387 *** BRACKETS P(3),PDQ,A */ 00000388 /BRACK1 PSEAR1 00000389 / SET000 NBR,0 00000390 /SO142 PLEZE1 00000391 ST 0,GAMM5+4 00000392 SETNAM GAMM5,0,SYMB1,0 00000393 / PSNAME1 NR,CODE 00000394 / CMPCAR NBIND,0,C'(',1 00000395 / BNE SO143 00000396 PZOEK V,SYMB1,IA 00000397 PLEZE1 00000398 CMP000 NRFLAG1,0,EQ,FOS9 00000399 CMPCAR NBIND,0,C')',1,NE,FOS9 00000400 CMP000 IMINUS,0,LT,FOS9 00000401 L 3,IA 00000402 SLL 3,27 00000403 SRL 3,22 00000404 L 2,NRFIX 00000405 SLL 2,27 00000406 SRL 2,27 NR=32*MOD(IA,32)+MOD(NRFIX,32) 00000407 AR 3,2 00000408 ST 3,NR 00000409 SETVAL CODE,0,(+,X'800',0,) 00000410 DOLOOP J,1,8,1,L0166,L0167 00000411 CMPCAR GAMM5,J,X'00',1,EQ,SO147A 00000412 BXLE 7,8,L0166 00000413 L0167 B SO147B 00000414 SO147A SETCAR GAMM5,J,C'(',1 00000415 CMPVAL J,0,(+,8,0,),EQ,SO147B 00000416 SETVAL K,0,(+,IAL,0,+,1,0,) 00000417 SET000 B,K 00000418 SETCAR B,K,C')',1 00000419 SETVAL N,0,(+,8,0,-,J,0,) 00000420 DOLOOP K,1,N,1,L0171,SO147B 00000421 CMPVAL K,0,(+,IAL,0,+,1,0,),GT,L0170 00000422 SETVAL L,0,(+,J,0,+,K,0,) 00000423 LOAD 1,B,K 00000424 SRL 1,24 00000425 STORE 1,GAMM5,L 00000426 L0170 BXLE 7,8,L0171 00000427 SO147B PLEZE1 00000428 / B SO145 00000429 SO143 CMPVAL NR,0,(+,CODE,0,) 00000430 BNE SO145 00000431 / PCOSYM1 NR,CODE APPLY DEFAULT */ 00000432 /SO145 CMP000 GAMM5,0 00000433 BE FOS9 ERROR IN LAST LINE 00000434 / SETVAL NBR,0,(+,NBR,0,+,1,0,) 00000435 LADR 1,GAMM5,0 00000436 LADR 2,MBR$N,NBR MBR$N CAN BE 8 CHARS LONG 00000437 MVC 0(8,2),0(1) 00000438 SETVAL MBR$C,NBR,(+,NR,0,+,CODE,0,) 00000439 L 15,=A(INSPEC1) 00000440 BALR 14,15 00000441 / CMPCAR NBIND,0,C'=',1 00000442 / BE FOS9 ERROR IN THE LAST LINE */ 00000443 / CMPVAL NBR,0,(+,25,0,) 00000444 / BL SO142 00000445 / SETVAL NBR,0,(+,NBR,0,-,1,0,) OVERFLOW OF BRACKET LIST */ 00000446 / B SO142 00000447 ** 00000448 *** OLDNEW A=B, AG=BG */ 00000449 /OLDNE1 PSEAR1 00000450 /SO146A PLEZE1 00000451 / CMP000 NRFLAG1,0 00000452 / BNE FOS9 ERROR IN THE LAST LINE */ 00000453 / CMPCAR NBIND,0,C'=',1 00000454 / BNE FOS9 00000455 / PSNAME1 NR,CODE 00000456 CMPVAL NR,0,(+,CODE,0,) 00000457 / BE FOS9 00000458 / PLEZE1 00000459 / CMP000 NRFLAG1,0 00000460 / BNE FOS9 00000461 / CMPVAL CODE,0,(+,X'100',0,) 00000462 / BNE L0162 00000463 / SETNAM I$NAME,NR,SYMB1,0 00000464 /L0162 CMPVAL CODE,0,(+,X'200',0,) 00000465 / BNE L0163 00000466 / SETNAM V$NAME,NR,SYMB1,0 00000467 /L0163 CMPVAL CODE,0,(+,X'400',0,) 00000468 / BNE L0164 00000469 / SETNAM S$NAME,NR,SYMB1,0 00000470 /L0164 CMPVAL CODE,0,(+,X'600',0,) 00000471 / BNE L0165 00000472 / SETNAM F$NAME,NR,SYMB1,0 00000473 L0165 L 15,=A(INSPEC1) 00000474 BALR 14,15 00000475 / B SO146A 00000476 ** 00000477 *** SPECIFICATION OF SUBSTITUTION LEVELS . ID, AL, L3, 0, +3, -3 */ 00000478 *** ID, 5, A=B */ 00000479 /IDENI1 SETVAL LEVL5,0,(+,LEVHY,0,) 00000480 /IDE1 SETVAL SUBS1$L,0,(+,LEVL5,0,) 00000481 SET111 NI,0 00000482 / PSEAR1 POSITION NI AFTER KEYWORD */ 00000483 / PNUM1 NR READ NR FOR MULTIPLICITY */ 00000484 / SETVAL NR,0,(+,NR,0,-,1,0,) 00000485 / CMP000 NR,0 00000486 / BNH L0215 00000487 / SET000 NR,0 /* CASE WHEN NO NUMBER WAS SPECIFIED * 00000488 /L0215 SETVAL SUBS1$M,0,(+,NR,0,) 00000489 / B IDEN1 00000490 *** AL,5,A=B */ 00000491 /IDENA1 SETVAL LEVL5,0,(+,LEVLO,0,) 00000492 B IDE1 00000493 *** L3,5,A=B */ 00000494 IDENL1 SET111 NI,0 00000495 / PNUM1 LEVL5 00000496 / B IDE1 00000497 *** 0,5,A=B */ 00000498 /SPACE1 SET000 NI,0 00000499 / PNUM1 NR 00000500 / B SPA1 00000501 *** + 3,5,A=B */ 00000502 SPACE2 SET111 NI,0 00000503 / PNUM1 NR 00000504 /SPA1 SETVAL LEVCH,0,(+,LEVCH,0,+,NR,0,) 00000505 CMPVAL LEVCH,0,(+,LEVHY,0,) 00000506 BL LL002 LEVL5=MAX(LEVCH,LEVHY) 00000507 SETVAL LEVL5,0,(+,LEVCH,0,) 00000508 B IDE1 00000509 LL002 SETVAL LEVL5,0,(+,LEVHY,0,) 00000510 / B IDE1 00000511 *** -3,5,A=B */ 00000512 SPACE3 SET111 NI,0 00000513 / PNUM1 NR 00000514 / SETVAL NR,0,(-,NR,0,) 00000515 / B SPA1 00000516 IDEN1 JUMP IDTFIER 00000517 ** 00000518 *** END OF INPUT SCAN. STAR CARD WAS SEEN. ARRAYS WITH DOLOOP, * 00000519 *** BLOCK ARGUMENTS AND IDGEH ARE BROUGHT TO THE INPUT STORE. * 00000520 *** LIMITS ARE TESTED. CREATED INDEX BITS AND OUTPUT PRESENCE BITS * 00000521 *** ARE INITIALIZED. */ 00000522 EXIT1 CCALL IDMOV1 00000523 / PMOV12 DOVLAG 00000524 / PMOV12 BLOKPT 00000525 CMPVAL IDAAN,0,(+,NDIMI,0,+,IDADR,0,) 00000526 / BH FOS10 OVFLOW OF IDGEH */ 00000527 / CMPVAL NANU,0,(+,MBU,0,) OVERFLOW OF LOC 00000528 BL FOS10 INPUT STORAGE OVERFLOW 00000529 CMPVAL MNSUBS,0,(+,NSUBS,0,) MNSUBS=MAX(MNSUBS,NSUBS) 00000530 BNL LL014 OUTPUT SPACE WAS USED FOR 00000531 SETVAL MNSUBS,0,(+,NSUBS,0,) 00000532 /LL014 SET000 NSUBS,0 DOLOOPS AND BLOCKARGUMENTS*/ 00000533 CCALL STAR1 ANALYZE KEYWORD ON A * CARD 00000534 / CMPVAL NVECT,0,(+,31,0,) 00000535 BNL FOS4 TOO MANY VECTOR NAMES 00000536 B XSCHOON 00000537 FOS4 ERROR 1,' TOO MANY VECTOR NAMES' 00000538 FOS8 ERROR 1,' TOO MANY X-EXPRESSIONS' 00000539 FOS9 ERRORP 1,' ERROR IN LAST LINE' 00000540 FOS10 ERROR 1,' INPUT STORAGE OVERFLOW' 00000541 FOS20 ERRORP 1,' INDEXING CONFLICT' 00000542 FOS21 ERRORP 1,' NAME ALREADY USED FOR EXPR' 00000543 FOS22 CCALL WREND1 00000544 ERRORP 1,' WRONG USE OF BLOCKS' 00000545 FOS27 ERROR 1,' WRONGLY NESTED SUBEXPRESSIONS' 00000546 XSCHOON EPILOGH 00000547 SAVEFTN DS 18F 00000548 DO9999 DC C'/DO/ ' 00000549 BLOK99 DC C'BLOK/' 00000550 FFOUT 1,'SCHOON' 00000551 LTORG 00000552 *** 00000553 *** 00000554 *** 00000555 INITIAL PRO 00000556 LADR 9,INCO1,1 END OF /INCOM/ 00000557 LR 7,10 BEGIN OF /INCOM/ 00000558 LA 8,4 SET /INCOM/ TO ZERO 00000559 LL001 ST 0,0(7) 00000560 BXLE 7,8,LL001 00000561 /L0002 DOLOOP J,1,42,1,L0003,L0004 00000562 SET000 NID$FST,J 00000563 SET000 NID$LST,J 00000564 BXLE 7,8,L0003 00000565 /L0004 SET111 NTEKEN,0 00000566 / SET111 LEVCH,0 00000567 / SET111 LEVCL,0 00000568 / SET111 LEVLO,0 SUBSTITUTION LEVELS */ 00000569 SET000 DUMCAR,0 00000570 SET000 KKUIT,0 00000571 / SET000 I1001,0 00000572 / SET000 LEVEL,0 00000573 SET000 MMBE,0 00000574 SET000 MMBU,0 00000575 SET000 MNSUBS,0 00000576 / SET000 NCRIN,0 00000577 SET000 CRIND,0 00000578 / SET000 NF,0 00000579 / SET000 NMULT,0 00000580 / SET000 NREP,0 INITIALIZE */ 00000581 / SET000 NSPEC,0 00000582 SET000 NTEM,0 00000583 / SET000 NWEG,0 00000584 / SET000 NZELF,0 00000585 / SET000 YTERM,0 00000586 SET000 IIEP,1 DELETE CONTENT OF BUFFERS 00000587 SET000 BBUFX,1 00000588 SET000 BUFA1,1 00000589 LADR 1,IIEP,1 00000590 ST 1,IEPHIGH 00000591 ST 1,IEPLOW 00000592 ST 1,TAPMA1 00000593 STORE 1,MNEPS,0 00000594 S 1,=A(3*LFLOAT) 00000595 ST 1,NDIMU NDIMU=ADDR(IIEP)-SAFETY 00000596 CMPVAL NDIMU,0,(+,NDIMT,0,+,4000,0,),LT,INFO4 00000597 *** INPUT SPACE IS TOO SMALL 00000598 / SETVAL IDO4,0,(+,&LISCAL,0,) LABEL OF DO0 EXPRS */ 00000599 / SETVAL KTA1,2,(-,3,0,) 00000600 / SETVAL NI,0,(+,101,0,) 00000601 / SETVAL NQU,0,(+,5,0,) 00000602 / SETVAL NSUBS,0,(+,NDIMT,0,+,3*LFLOAT,0,) 00000603 LADR 1,IDGEH,1 00000604 ST 1,IDADR 00000605 ST 1,IDAAN 00000606 B XINITIAL 00000607 INFO4 ERROR 2,' INPUT SPACE IS TOO SMALL' 00000608 INITIAL EPI 00000609 *** 00000610 *** 00000611 *** ADD VARIABLES TO EXISTING LISTS */ 00000612 *** FUNCTIONS F1, F2 = COMP,DS=U */ 00000613 *** NAMEL1: PROCEDURE(ARRAY,NUMBER); 00000614 DS 0H 00000615 USING *,12 00000616 NAMEL1 ST 1,K7 ADDR IN MREF, DESCRIBING ARRAY. 00000617 / PSEAR1 00000618 /SO123 PLEZE1 00000619 L 1,K7 00000620 PSARAY1 ,SYMB1,NR 00000621 / CMP000 NR,0 00000622 BNE SO125 00000623 L 1,K7 00000624 PZOEK ,SYMB1,K2 00000625 SO125 CCALL INSPEC1 00000626 / CMPCAR NBIND,0,C'=',1 00000627 / BNE SO123 00000628 SETNAM IA,0,SYMB1,0 00000629 / PLEZE1 00000630 / CMP000 NR,0 00000631 / BNE SO125 OLD PROPERTIES HOLD */ 00000632 / CMP000 IAL,0 NEW VARIABLE 00000633 / BE SO125 00000634 L 1,K7 00000635 L 1,8(1) ADDR ( PROP ARRAY ) 00000636 A 1,K2 00000637 SR 1,6 ARRAY$PROP(K1) 00000638 LADR 2,REF$IN,5 SPECIFIES INDEX ARRAY 00000639 C 2,K7 00000640 BE SO124 JP IF CASE OF INDEX LIST 00000641 / CMP000 NRFLAG1,0 00000642 / BNE FOS49 ERROR IN THE LAST LINE */ 00000643 CMPCAR B,1,C'U',1 00000644 BNE LL015 00000645 OI 0(1),UNDEF 00000646 B SO125 00000647 LL015 CMPCAR B,1,C'I',1 00000648 BNE LL016 00000649 OI 0(1),IMAG 00000650 B SO125 00000651 LL016 CMPCAR B,1,C'C',1 00000652 BNE FOS49 00000653 OI 0(1),COMP 00000654 SETVAL J,0,(+,5,0,) CONSTRUCT NAME BY APPENDING G. 00000655 LL020 CMPCAR IA$C,J,X'00',1 00000656 BNE LL017 00000657 SETVAL J,0,(+,J,0,-,1,0,) 00000658 B LL020 00000659 LL017 CMP111 J,0 00000660 BH FOS49 00000661 SETVAL J,0,(+,J,0,+,1,0,) 00000662 SETCAR IA$C,J,C'G',1 00000663 L 1,K7 00000664 PZOEK ,IA,K2 00000665 B SO125 00000666 SO124 CMP000 NRFLAG1,0 CASE OF AN INDEX 00000667 BE L0160 00000668 L 2,NRFIX DIMENSION MUST BE POSITIVE 00000669 LPR 2,2 00000670 SLL 2,28 00000671 SRL 2,28 CUT TO 4 BITS 00000672 B L0320 00000673 L0160 LOAD 2,SYMB1$C,1 CASE OF VARIABLE DIMENSION 00000674 CMPCAR B,1,C'S',1 DIMENSION = LETTER 00000675 BNL L0155 00000676 A 2,=X'00000015' MAPS N,O,P,Q,R INTO X'EA',EB,EC,ED,EE 00000677 L0155 SLL 2,28 00000678 SRL 2,28 CUT TO 4 BITS 00000679 A 2,=X'00000010' BIT TO INDICATE DIMEN=LETTER. 00000680 L0320 NI 0(1),X'E0' R1=ADDR ( PROP ARRAY ) 00000681 IC 3,0(1) INSERT DIMENSION. BITS 4-8. 00000682 OR 3,2 00000683 STC 3,0(1) 00000684 B SO125 00000685 FOS49 ERRORP 2,' ERROR IN THE LAST LINE' 00000686 DROP 12 00000687 ** 00000688 *** IB=0,DELETE. =1,KEEP. =2,PRINT. =3,NPRINT. =4,PUNCH. =5,STORE * 00000689 DS 0H 00000690 USING *,12 00000691 /DEL PSEAR1 00000692 /DEL1 PRFIL1 NNAME,IINDEX,FFLAG 00000693 / DOLOOP J,1,NXEX,1,L0026,L0027 00000694 / CMPNAM X$NAME,J,NNAME,0 00000695 / BNE DEL6 00000696 / CMP000 FFLAG,0 00000697 / BNE DEL5 00000698 / CMPVAL X$INDEX,J,(+,IINDEX,0,) 00000699 / BNE DEL6 00000700 /DEL5 CMP000 IB,0 00000701 / BNE L0301 00000702 / SETBIT X$PROP,J,COMON,OFF 00000703 / SETBIT X$PROP,J,KEEP,OFF 00000704 / B DEL6 00000705 /L0301 CMP111 IB,0 00000706 / BNE L0302 00000707 / SETBIT X$PROP,J,KEEP,ON 00000708 / B DEL6 00000709 /L0302 CMPVAL IB,0,(+,2,0,) 00000710 / BNE L0303 00000711 / SETBIT X$PROP,J,PRINT,ON 00000712 / B DEL6 00000713 /L0303 CMPVAL IB,0,(+,3,0,) 00000714 / BNE L0304 00000715 / SETBIT X$PROP,J,PRINT,OFF 00000716 / B DEL6 00000717 /L0304 CMPVAL IB,0,(+,4,0,) 00000718 / BNE L0305 00000719 / SETBIT X$PROP,J,PUNCH,ON 00000720 / B DEL6 00000721 /L0305 CMPVAL IB,0,(+,5,0,) 00000722 BNE DEL6 00000723 / SETBIT X$PROP,J,STORE,ON 00000724 /DEL6 BXLE 7,8,L0026 00000725 /L0027 CMP000 IB,0 00000726 / BE DEL10 00000727 / CMP000 N5PS,0 00000728 / BE DEL10 00000729 / DOLOOP J,1,N5PS,1,L0030,DEL10 00000730 / CMPNAM Z$NAME,J,NNAME,0 00000731 / BNE DEL9 00000732 / CMP000 FFLAG,0 00000733 / BNE DEL8 00000734 / CMPVAL Z$INDEX,J,(+,IINDEX,0,) 00000735 / BNE DEL9 00000736 /DEL8 CMP111 IB,0 00000737 / BNE L0307 00000738 / SETBIT Z$PROP,J,KEEP,ON 00000739 / B DEL9 00000740 /L0307 CMPVAL IB,0,(+,2,0,) 00000741 / BNE L0310 00000742 / SETBIT Z$PROP,J,PRINT,ON 00000743 / B DEL9 00000744 /L0310 CMPVAL IB,0,(+,3,0,) 00000745 / BNE L0311 00000746 / SETBIT Z$PROP,J,PRINT,OFF 00000747 / B DEL9 00000748 /L0311 CMPVAL IB,0,(+,4,0,) 00000749 / BNE L0312 00000750 / SETBIT Z$PROP,J,PUNCH,ON 00000751 / B DEL9 00000752 /L0312 CMPVAL IB,0,(+,5,0,) 00000753 BNE DEL9 00000754 / SETBIT Z$PROP,J,STORE,ON 00000755 /DEL9 BXLE 7,8,L0030 00000756 /DEL10 CMPVAL NBIND,0,(+,X'77',0,) 00000757 / BNE DEL1 00000758 JUMP GOON1 00000759 DROP 12 00000760 ** 00000761 *** N 15,R REQUESTS PRINTING OF NUMBERS WITH 15 DIGITS OR */ 00000762 *** POSSIBLY AS A RATIO */ 00000763 *** N 309 REQUESTS ERROR (INSERT COUNT LIMIT) AFTER 9 INSERT PASSINGS * 00000764 *** N MU REQUESTS ERROR (PROGRAM ERROR 1001) WHEN MU APPEARS IN */ 00000765 *** OUTPUT */ 00000766 DS 0H 00000767 USING *,12 00000768 /NUMER PLEZE1 00000769 / CMP000 NRFLAG1,0 00000770 / BE SO14 00000771 / CMPVAL NRFIX,0,(+,300,0,) 00000772 BL L0054 00000773 SETVAL NF,0,(+,NRFIX,0,-,300,0,) INSERT PASSINGS 00000774 B SO13 00000775 L0054 CMPVAL NQU,0,(+,200,0,) 00000776 BL L0061 00000777 SETVAL NQU,0,(+,NRFIX,0,+,200,0,) 00000778 B SO13 R WAS ALREADY REQUESTED 00000779 L0061 SETVAL NQU,0,(+,NRFIX,0,) 00000780 B SO13 NR OF DIGITS IN PRINT 00000781 SO14 CMPCAR SYMB1,0,C'R',1 00000782 BNE SO14B REQUEST RATIO OF INTEGERS 00000783 CMPVAL NQU,0,(+,200,0,) 00000784 BNL SO13 00000785 SETVAL NQU,0,(+,NQU,0,+,200,0,) 00000786 B SO13 00000787 SO14B PZOEK I,SYMB1,I1001 ERROR INDEX 00000788 SO13 CCALL INSPEC1 00000789 B NUMER 00000790 DROP 12 00000791 ** 00000792 *** CONVERT DECIMAL NR IN DISPLAY CODE INTO BIN. START AT A(PLACE) */ 00000793 *** STOP AT ENCOUNTER OF NON-NUMERIC . DO NOT CROSS END OF CARD */ 00000794 *** NUM1: PROCEDURE(VALUE); 00000795 DS 0H 00000796 USING *,15 00000797 NUM1 LR 2,0 VALUE=0 00000798 NUM2 SETVAL K,0,(+,NI,0,+,1,0,) 00000799 LOAD 4,A,K 00000800 S 4,=X'000000F0' =C'0' 00000801 BL NUM3 00000802 LR 8,2 00000803 SLA 2,1 00000804 SLA 8,3 00000805 AR 2,8 00000806 AR 2,4 VALUE=10*VALUE+A(NI)-'0' 00000807 SETVAL NI,0,(+,NI,0,+,1,0,) 00000808 / B NUM2 00000809 /NUM3 CMPVAL NI,0,(+,72,0,) 00000810 BNL FOS12 EXPECTED NUMBER NOT FOUND 00000811 BR 14 00000812 FOS12 ERRORP 2,' EXPECTED NUMBER NOT FOUND' 00000813 DROP 15 00000814 *** 00000815 *** RFIL1: PROCEDURE (NNAME,IINDEX,FFLAG); /* READ 1 FILENAME, AND 00000816 RFIL1 PRO 00000817 RFI1 PLEZE1 POSSIBLY ITS INDEX. FLAG=1*/ 00000818 / CMP000 IAL,0 00000819 / BE RFI3 WHEN NOT INDEXED. */ 00000820 SETNAM NNAME,0,SYMB1,0 00000821 / SET111 FFLAG,0 00000822 / CMPCAR NBIND,0,C'(',1 00000823 BNE XRFIL1 00000824 / PLEZE1 READ INDEX */ 00000825 / SET000 FFLAG,0 00000826 / CMP000 IMINUS,0,LT,L0022 00000827 / SETVAL IINDEX,0,(+,NRFIX,0,) 00000828 B XRFIL1 00000829 /L0022 SETVAL IINDEX,0,(-,NRFIX,0,) 00000830 B XRFIL1 00000831 /RFI3 CMPVAL NBIND,0,(+,X'77',0,) 00000832 BNE RFI1 00000833 JUMP GOON1 00000834 RFIL1 EPI 00000835 ** 00000836 *** FNAM2: PROCEDURE(NR); /* CONSTRUCT KEY IN MEMORY WITH NAMELIS 00000837 FNAM2 PRO 00000838 / SETVAL NCRIN,0,(+,NVIND,0,) ON TAPE */ 00000839 / SETVAL NQX,0,(+,NVIND,0,) FIX NR OF INDICES */ 00000840 / PCROSR NR,CROSBUF,1 00000841 SETVAL K,0,(+,X$LOCNR,NR,) 00000842 SETVAL L$AKEY,K,(+,MBE,0,) 00000843 / SETVAL SHMEM1,0,(+,1,0,) 00000844 / SET000 T$1POINT,MBE 00000845 SET1$0 T$1COEFF,MBE 00000846 PINDON DKEY,0 00000847 SETADR K,0,(+,CROSBUF,1,+,VECTS+NEXTT,0,) 00000848 FNA5 SETVAL AA,0,(+,T$TDUMMY,K,) 00000849 PINDON AA,0 00000850 / CMP000 B$0WORD,K 00000851 BE XFNAM2 00000852 / SETVAL K,0,(+,K,0,+,NEXTN,0,) 00000853 / B FNA5 00000854 FNAM2 EPI 00000855 ** 00000856 *** COPY BLOCKS FROM TAPE3 TO TAPE4, WHILE CONSTRUCTING A NAMELIST. * 00000857 *** EACH ENTRY IS THE NAME(50 CHARS), FOLLOWED BY 'AVAILABLE' OR * 00000858 *** 'DELETED' OR 'REPLACED'. THE LIST STARTS AT ITNAM1 AND IS PRECEDED* 00000859 *** BY A COPY OF THE LAST INPUT CARD. MBE IS POSITIONED BEHIND LAST * 00000860 *** NAME. * 00000861 *** COPY34: PROCEDURE; 00000862 COPY34 PRO 00000863 / CMP000 BLOV34,0 00000864 / BE XCOPY34 JP IF BLOCKS ARE ALREADY IN*/ 00000865 / SET000 BLOV34,0 00000866 CALLFTN RWND4 00000867 LADR 1,T$5CARD,MBE 00000868 MVC 0(L'T$5CARD,1),IBUF+24 00000869 LADR 2,T$5NEXT5,MBE 00000870 ST 2,MBE 00000871 / SETVAL ITNAM1,0,(+,MBE,0,) 00000872 *** EACH CARD BEHIND AN ENDBLOCK CARD IS A BLOCKNAME, UNLESS THAT CARD* 00000873 *** IS TAPE END */ 00000874 /BLOK5 PINPHU NTAP3 00000875 / SETVAL IBUF,1,(+,NTAP4,0,) 00000876 / SET111 IBUF,3 00000877 CALLFTN LIJN 00000878 / CMPCAR IBUF,7,C'TAPE END ',9 00000879 / BE BLOK3 00000880 *** ONLY 8 CHARS ARE COMPARED BECAUSE THE 12TH IS X'00' WHEN REST OF 00000881 *** CARD IS BLANK, BUT X'40' IF COLUMNS 73-80 ARE NOT EMPTY. 00000882 / CMPCAR IBUF,7,C'ENDBLOCK ',9 00000883 / BNE L0052 00000884 / SET000 NENDBL1,0 00000885 / B BLOK5 00000886 /L0052 CMP000 NENDBL1,0 00000887 / BNE BLOK5 00000888 / SET111 NENDBL1,0 00000889 L 1,MBE 00000890 MVC 0(L'T$6BNAME+L'T$6BTYPE,1),IBUF+24 00000891 LADR 2,T$6NEXT6,MBE 00000892 ST 2,MBE 00000893 / CMPVAL NDIMT,0,(+,MBE,0,+,80,0,) 00000894 BL FOS7 INPUT STORAGE OVERFLOW. 00000895 / B BLOK5 00000896 BLOK3 LA 1,T$5NEXT5-T$5SPACE 00000897 LNR 1,1 00000898 A 1,ITNAM1 00000899 ST 1,J 00000900 LADR 2,T$5CARD,J 00000901 MVC IBUF+24(L'T$5CARD),0(2) 00000902 CALLFTN RWND 00000903 CALLFTN RWND4 00000904 B XCOPY34 00000905 FOS7 ERROR 2,' INPUT STORAGE OVERFLOW.' 00000906 COPY34 EPI 00000907 *** 00000908 *** IDMOV1: PROCEDURE; /* MOVE IDGEH INTO IT 00000909 DS 0H 00000910 USING *,15 00000911 IDMOV1 LADR 1,IDGEH,1 00000912 C 1,IDADR 00000913 BNER 14 00000914 SETVAL IDAAN,0,(+,IDAAN,0,-,IDADR,0,+,MBE,0,) 00000915 L 1,IDADR 00000916 L 3,IDAAN 00000917 L 2,MBE 00000918 ST 2,IDADR 00000919 CR 2,3 00000920 BNL LL003 00000921 LL013 MVC 0(NEXTW,2),0(1) 00000922 LA 1,NEXTW(1) TAKE NEXT WORD 00000923 LA 2,NEXTW(2) 00000924 CR 2,3 00000925 BL LL013 00000926 LL003 MVC 0(4,2),=X'FF000000' TERMINATOR 00000927 LA 2,4(2) 00000928 ST 2,MBE 00000929 SET111 MAXID,0 00000930 SETADR II5,0,(+,IDGEH,1,-,IDADR,0,) 00000931 DOLOOP J,1,41,1,LL029,LL030 00000932 CMP000 NID$FST,J MAKE ADDRESSES ABSOLUTE 00000933 BE LL027 00000934 SETVAL MAXID,0,(+,J,0,) FIND HIGHEST SUBSTIT LEVEL 00000935 SETVAL NID$FST,J,(+,NID$FST,J,-,II5,0,) 00000936 LL027 CMP000 NID$LST,J 00000937 BE LL028 00000938 SETVAL NID$LST,J,(+,NID$LST,J,-,II5,0,) 00000939 LL028 BXLE 7,8,LL029 00000940 /LL030 DOLOOP J,1,NVIND,1,L0250,L0251 00000941 / CMPBIT I$PROP,J,CREAT,ON 00000942 BZ L0322 00000943 / SETCAR I$NAME,J,X'0000000000',5 00000944 /L0322 BXLE 7,8,L0250 00000945 L0251 L 7,NVIND 00000946 AR 7,6 00000947 DOLOOP J,,32,1,LL025,LL026 TEMPORARY SIZE OF INDEX ARRAY 00000948 / SETBIT I$PROP,J,CREAT,ON 00000949 BXLE 7,8,LL025 00000950 /LL026 SETVAL NQX,0,(+,NVIND,0,) 00000951 / SETVAL NCRIN,0,(+,NVIND,0,) 00000952 / DOLOOP J,1,NVIND,1,L0252,L0253 THOSE 4 DOLOOPS ARE COMBINED 00000953 / SETBIT I$PROP,J,OUTPR,OFF BY THE USE OF MREF 00000954 / BXLE 7,8,L0252 00000955 /L0253 DOLOOP J,1,NALGE,1,L0254,L0255 00000956 / SETBIT S$PROP,J,OUTPR,OFF 00000957 / BXLE 7,8,L0254 00000958 /L0255 DOLOOP J,1,NVECT,1,L0256,L0257 00000959 / SETBIT V$PROP,J,OUTPR,OFF 00000960 / BXLE 7,8,L0256 00000961 /L0257 DOLOOP J,1,NFUN,1,L0260,L0261 00000962 / SETBIT F$PROP,J,OUTPR,OFF 00000963 / BXLE 7,8,L0260 00000964 L0261 CMP000 KKUIT,0,EQ,RETURN 00000965 SETVAL NFFO,0,(+,MBE,0,) POINTER TO LIST OF LOC,FILN1 OF 00000966 DOLOOP J,1,KKUIT,1,L0270,L0271 Z EXPRS 00000967 SETVAL T$ZZLOC,MBE,(+,IPR$LOC,J,) 00000968 SETVAL T$ZZFIL,MBE,(+,IPR$FIL,J,) 00000969 LADR 1,T$ZNEXTZ,MBE 00000970 ST 1,MBE 00000971 BXLE 7,8,L0270 00000972 L0271 BR 14 00000973 DROP 15 00000974 ** 00000975 *** MOVE DOLOOP OR BLOCK ARGUMENTS. */ 00000976 *** MOV12: PROCEDURE(POINTER,WORD); /* LOCATE DOLOOP 00000977 DS 0H 00000978 USING *,15 00000979 *** ADDR(PT$B) IS R1 00000980 &PT$B SETA 2 00000981 &WORD SETA 3 00000982 &PT$L SETA 5 00000983 MOV12 L &PT$B,0(1) 00000984 CR 0,&PT$B 00000985 BER 14 00000986 CR 0,&PT$L 00000987 BE MOV13 00000988 C &PT$B,MBE 00000989 BNL L0262 00000990 LR 3,&PT$B 00000991 AR 3,&PT$L 00000992 C 3,MBE 00000993 BH FOS23 BLOCK OR DOLOOP OVERWRITTEN 00000994 BR 14 00000995 *** MOVE DOLOOP AT BEGINNING OF EXECUTION FROM OUTPUT SPACE TO INPUT * 00000996 *** SPACE. MOVE DOLOOP TO LOWER MBE AFTER * YEP. */ 00000997 L0262 C &PT$B,MBE 00000998 / BE MOV16 NO COPY REQUIRED*/ 00000999 L 3,MBE 00001000 LNR 4,6 TERMINATOR 00001001 MOV14 MVC 0(4,3),0(&PT$B) 00001002 LA 3,4(3) 00001003 LA &PT$B,4(&PT$B) 00001004 C 4,0(&PT$B) 00001005 BNE MOV14 00001006 ST 4,0(3) COPY TERMINATOR 00001007 LA 3,4(3) 00001008 S 3,MBE 00001009 CR 3,&PT$L 00001010 BNE FOS23 BLOCK OR DOLOOP OVERWRITTEN 00001011 L 3,MBE 00001012 ST 3,0(1) 00001013 MOV16 A &PT$L,MBE 00001014 ST &PT$L,MBE 00001015 / CMPVAL MBE,0,(+,NDIMT,0,) 00001016 BH FOS23 BLOCK OR DOLOOP OVERWRITTEN 00001017 / BR 14 00001018 *** A DO LOOP IS SAVED OVER * NEXT,* BEGIN BY FORMATTING IT AS A KEEP * 00001019 *** FILE. ITS POSITION IS PICKED UP AFTERWARDS BY SEARCHING 'WORD'. * 00001020 MOV13 LR 2,&WORD 00001021 / DOLOOP J,1,NXEX,1,L0263,L0264 00001022 LADR 4,X$NAME,J 00001023 CLC 0(LNAME$,4),0(2) 00001024 / BE MOV15 00001025 / BXLE 7,8,L0263 00001026 L0264 B FOS23 BLOCK OR DOLOOP OVERWRITTEN 00001027 /MOV15 SETVAL K,0,(+,X$LOCNR,J,) 00001028 LOAD 4,L$ANAME,K 00001029 ST 4,0(1) 00001030 / CMPVAL MBE,0,(+,L$BEGIN,K,+,L$LENGT,K,) 00001031 / BNLR 14 00001032 / SETVAL MBE,0,(+,L$BEGIN,K,+,L$LENGT,K,) 00001033 / BR 14 00001034 FOS23 ERROR 2,' BLOCK OR DOLOOP OVERWRITTEN' 00001035 DROP 15 00001036 FFOUT 2,'SCHOON1' 00001037 LTORG 00001038 END 00001039 ./A SCHOON2,INCR=1 00000001 ./MACRO MAINMCRO 00000002 ./MACRO INMACRO 00000003 TITLE 'SCHOON2' 00000004 GBLC &OVLAY 00000005 LCLA &PT$B,&PT$L,&WORD 00000006 ./MACRO INCOM 00000007 ./MACRO MAINCOM 00000008 PRINT NOGEN 00000009 SCHOON2 CSECT 00000010 EQUIVAL 00000011 ENTRY STAR1,PAKB1,MAIN,IDTFIER 00000012 EXTRN GOON1,NBLANK1,LEZE1,STEXPR,FNAM2 00000013 EXTRN ZOEK,FOUT,FOUTP,SARAY1,READI1,COVNR1,COSYM1,SNAME1 00000014 USING INCOM,10 00000015 USING BLANK,11 00000016 ** 00000017 *** COMPARE READ-IN NAME (AT MBE.50 CHARS) WITH NAMELIST (AT ITNAM1). * 00000018 *** IF MATCHES, WRITE'DELETED' OR 'REPLACED' IN THE FOLLOWING 10 CHARS* 00000019 *** USED FOR ENTER BLOCKS, NBLOCK,... * 00000020 *** PAKB1: PROCEDURE(WORD); 00000021 DS 0H 00000022 USING *,15 00000023 /PAKB1 CMP000 ITNAM1,0 00000024 / BER 14 00000025 / SETVAL J,0,(+,ITNAM1,0,) 00000026 /PAKB2 CMPVAL J,0,(+,MBE,0,) 00000027 / BNLR 14 00000028 L 7,J 00000029 L 8,MBE 00000030 CLC 0(L'T$6BNAME,7),0(8) 00000031 / BNE L0051 00000032 MVC L'T$6BNAME(L'T$6BTYPE,7),0(1) 00000033 / BR 14 00000034 L0051 LADR 7,T$6NEXT6,J 00000035 ST 7,J 00000036 / B PAKB2 00000037 DROP 15 00000038 ** 00000039 *** STAR: PROCEDURE(PAS) PAS=1 IF NO * CARD. =0 IF * . 00000040 STAR1 PROLOGH 00000041 L 10,=V(INCOM) BASE REG. CALLED FROM FTN. 00000042 CMPCAR A,1,C'*',1 VALUE OF NSPEC DEPENDS ON 00000043 / BE L0265 FOLLOWING KEY WORD 00000044 / SET111 PAS,0 00000045 B XSTAR1 00000046 /L0265 SET000 PAS,0 00000047 / SET111 K,0 00000048 / DOLOOP J,2,72,1,L0266,STA2 ONLY 3 CHARS RELEVANT */ 00000049 / CMPCAR A,J,C' ',1 00000050 / BE STA1 00000051 SETVAL BEGIN$C,K,(+,A,J,) 00000052 / SETVAL K,0,(+,K,0,+,1,0,) 00000053 / CMPVAL K,0,(+,4,0,) 00000054 / BNL STA2 00000055 /STA1 BXLE 7,8,L0266 00000056 /STA2 SET111 NSPEC,0 *ANYTHING=*BEGIN */ 00000057 / CMPCAR BEGIN,0,C'BEG',3 00000058 / BNE L0270 00000059 SETVAL NSPEC,0,(+,STARBEG,0,) 00000060 B XSTAR1 00000061 /L0270 CMPCAR BEGIN,0,C'END',3 00000062 / BNE L0271 00000063 / SETVAL NSPEC,0,(+,STAREND,0,) 00000064 B XSTAR1 00000065 /L0271 CMPCAR BEGIN,0,C'NEX',3 00000066 / BNE L0272 00000067 / SETVAL NSPEC,0,(+,STARNEX,0,) 00000068 B XSTAR1 00000069 /L0272 CMPCAR BEGIN,0,C'YEP',3 00000070 / BNE L0273 00000071 / SETVAL NSPEC,0,(+,STARYEP,0,) 00000072 B XSTAR1 00000073 /L0273 CMPCAR BEGIN,0,C'FIX',3 00000074 BNE XSTAR1 00000075 / SETVAL NSPEC,0,(+,5,0,) 00000076 XSTAR1 EPILOGH 00000077 SAVEFTN DS 18F 00000078 *** 00000079 *** INIDG1 PROCEDURE(NR,CODE); 00000080 DS 0H 00000081 USING *,15 00000082 INIDG1 AR 1,2 INSERT NR+CODE IN IDGEH 00000083 L 3,IDAAN IDAAN IS ABSOLUTE ADDRESS 00000084 ST 1,0(3) 00000085 LA 3,NEXTW(3) 00000086 ST 3,IDAAN 00000087 BR 14 00000088 DROP 15 00000089 ** 00000090 *** CASE OF Z - EXPRESSION */ 00000091 DS 0H 00000092 USING *,12 00000093 MAIN SETMAX LEVHY,LEVCH 00000094 / SET111 LEVLO,0 00000095 / SET111 LEVCL,0 00000096 / SET111 LEVCH,0 00000097 / PLEZE1 00000098 *** READ FILENAME AND INSERT IN FILN1 . ITS LOCATION IS STORED IN IPR * 00000099 PSARAY1 X$NAME,SYMB1,NR 00000100 / SETVAL N5PS,0,(+,N5PS,0,+,1,0,) COUNTS ADRES IN FILN1 */ 00000101 SET000 Z$INDEX,N5PS 00000102 SET000 Z$ARGNR,N5PS 00000103 SET000 Z$PROP,N5PS 00000104 / SETNAM Z$NAME,N5PS,SYMB1,0 00000105 / SETBIT Z$PROP,N5PS,FILE,ON 00000106 / SETBIT Z$PROP,N5PS,PRINT,ON 00000107 / SETBIT Z$PROP,N5PS,NINDX,ON 00000108 / CMP000 NR,0 00000109 / BE MAI2 00000110 / CMPBIT X$PROP,NR,FILE,OFF 00000111 / BZ MAI2 00000112 / CMPBIT X$PROP,NR,COMON,ON 00000113 / BZ L0065 00000114 / SETBIT Z$PROP,N5PS,COMON,ON 00000115 /L0065 CMPBIT X$PROP,NR,NINDX,OFF 00000116 BO MAI2 00000117 / SETBIT Z$PROP,N5PS,NINDX,OFF 00000118 /MAI2 SETVAL IA,0,(+,N5PS,0,) REMEMBERS BEGIN OF Z EXPR. FOR COUN 00000119 / CMPVAL IA,0,(+,&FILIMIT,0,) 00000120 / BNL FOS19 /* TOO MANY Z EXPRESSIONS * 00000121 SETVAL KKUIT,0,(+,KKUIT,0,+,1,0,) 00000122 SETVAL IPR$LOC,KKUIT,(+,MBU,0,) 00000123 SETVAL IPR$FIL,KKUIT,(+,N5PS,0,) 00000124 / SET000 IB,0 ADDITIVE PART OF VALUE OF EXPR. INDEX */ 00000125 / SET000 NP31,0 MULTIPLICATIVE PART OF VALUE OF EXPR. INDEX * 00000126 / CMPCAR NBIND,0,C'(',1 00000127 / BNE MAI12 JP IF NO ARG OR INDEX FOLLOWS */ 00000128 / PLEZE1 00000129 / CMP000 NRFLAG1,0 00000130 / BE MAI10 JP IF SYMBOL READ IS NOT A NUMBER */ 00000131 / SETBIT Z$PROP,N5PS,NINDX,OFF 00000132 / SETVAL IB,0,(+,NRFIX,0,) 00000133 / CMP000 IMINUS,0 00000134 BNH MAI3 00000135 / SETVAL IB,0,(-,IB,0,) 00000136 *** NUMERICAL EVALUATION OF INDEX. E.G. Z EXP(-3 * 4 + 20 +3) =... */ 00000137 /MAI3 CMPCAR NBIND,0,C')',1 00000138 / BE MAI11 00000139 / CMPCAR NBIND,0,C',',1 00000140 / BE MAI9 00000141 / CMPCAR NBIND,0,C'+',1 00000142 / BE MAI8 00000143 / CMPCAR NBIND,0,C'-',1 00000144 / BE MAI7 00000145 / CMPCAR NBIND,0,C'*',1 00000146 BNE FOS32 NOT EXPECTED ... 00000147 CMP000 SLASH2,0 00000148 BE MAI5 00000149 PLEZE1 00000150 SR 2,2 IB=IB/NRFIX 00000151 L 3,IB 00000152 D 2,NRFIX 00000153 ST 3,IB 00000154 / B MAI3 00000155 /MAI5 PLEZE1 00000156 L 3,IB IB=IB*NRFIX 00000157 M 2,NRFIX 00000158 ST 3,IB 00000159 / B MAI3 00000160 /MAI7 SETVAL NP31,0,(+,NP31,0,+,IB,0,) - IS -1 * */ 00000161 / SETVAL IB,0,(-,1,0,) 00000162 / B MAI5 00000163 /MAI8 SETVAL NP31,0,(+,NP31,0,+,IB,0,) + IS + 1 * */ 00000164 / SET111 IB,0 00000165 / B MAI5 00000166 /MAI9 PLEZE1 AFTER ',' READ NEXT ARGUMENT */ 00000167 /MAI10 PSNAME1 NR,CODE SEARCH NAMELISTS */ 00000168 CMPVAL NR,0,(+,CODE,0,) 00000169 / BNE L0070 00000170 / PCOSYM1 NR,CODE /* VARIABLE WAS NOT FOUND */ 00000171 /L0070 CMPVAL CODE,0,(+,X'600',0,) 00000172 / BNE L0071 00000173 / SETVAL CODE,0,(+,X'220',0,) MAKE DUMMY FUNCTION * 00000174 /L0071 SETVAL N5PS,0,(+,N5PS,0,+,1,0,) 00000175 / SETNAM Z$NAME,N5PS,SYMB1,0 00000176 / SETVAL Z$CODE,N5PS,(+,CODE,0,+,NR,0,) 00000177 SET000 Z$PROP,N5PS 00000178 SET000 Z$ARGNR,N5PS 00000179 / CMPVAL N5PS,0,(+,&FILIMIT,0,) 00000180 / BL MAI3 00000181 / B FOS19 TOO MANY EXPRESSION NAMES, ARGUMENTS */ 00000182 /MAI11 SETVAL Z$INDEX,IA,(+,IB,0,+,NP31,0,) AFTER ')' */ 00000183 / SETVAL Z$ARGNR,IA,(+,N5PS,0,-,IA,0,) 00000184 / PLEZE1 START ANALYSIS OF RHS */ 00000185 /MAI12 CMPCAR NBIND,0,C'=',1 00000186 BNE FOS32 NOT EXPECTED ... 00000187 SETVAL K,0,(+,N5PS,0,+,1,0,) 00000188 SETCAR Z$NAME,K,X'7777777777',5 TERMINATOR OF FILES 00000189 / SET000 IDIND1,0 IDENTIFIER INDICATOR */ 00000190 JUMP STEXPR 00000191 FOS19 ERRORP 6,' TOO MANY EXPR NAMES, ARGUMENTS' 00000192 FOS32 MVC F32+32(1),NBIND 00000193 CLI NBIND,X'77' 00000194 BNE F32 00000195 MVI F32+32,C'?' 00000196 F32 ERRORP 6,' NOT EXPECTED ' 00000197 DROP 12 00000198 ** 00000199 *** FLAG1 = 0, SEARCH FIRST TABLE. =1 SEARCH BOTH TABLES */ 00000200 *** FLAG2 = 0, MATCH ONLY JANI1 AND JDVF1. =1,MATCH AS WELL AZPMEM1. */ 00000201 *** FLAG3 = 0 IF NOT FOUND. ELSE CONTAINS NR OF THE SUBSTITUTION. */ 00000202 *** LOOKUP(FLAG1,FLAG2,FLAG3) FIND TYPE OF SUBSTITUTIONS. 00000203 DS 0H 00000204 USING *,15 00000205 LOOKUP L 2,JANI1 PREPARE FOR COMPARE WITH TABLE 00000206 L 3,JDVF1 00000207 SLL 3,12 00000208 IC 3,AZPMEM1 00000209 SLL 3,2 00000210 SLDL 2,14 00000211 ST 2,COMP1 00000212 ST 3,COMP1+4 00000213 SETVAL FFLAG,0,(+,FLAG1,0,) 00000214 LA 1,TABLE1 00000215 LL020 CLC 0(6,1),=X'000000000000' 00000216 BE LOK3 00000217 CMP000 FLAG2,0 00000218 BE LL018 00000219 CLC 0(6,1),COMP1 00000220 BNE LOK1 00000221 B LOK2 00000222 LL018 CLC 0(5,1),COMP1 00000223 BE LOK2 00000224 LOK1 LA 1,7(0,1) 00000225 B LL020 00000226 LOK3 CMP000 FFLAG,0 00000227 BE LL021 00000228 SET000 FFLAG,0 00000229 B LOK1 00000230 LL021 SET000 FLAG3,0 00000231 BR 14 00000232 LOK2 SR 2,2 FOUND 00000233 IC 2,6(1) 00000234 ST 2,FLAG3 00000235 BR 14 00000236 *** TABLE CONTAINS JANI1(18 BITS),JDVF1(18 BITS),ZERO(4 BITS), 00000237 *** AZPMEM1(8 BITS),TYPE(8 BITS) = 7 BYTES. 00000238 TABLE1 DC X'0000000400',C' ',FL1'6' P(MU+) 00000239 DC X'0000000400',C'D',FL1'15' P(MU+) D 00000240 DC X'0000000400',C'F',FL1'16' P(MU+) F 00000241 DC X'00000000000000' 00000242 DC X'0400000000',C' ',FL1'1' A 00000243 DC X'0410000000',C' ',FL1'3' A**3 00000244 DC X'0400000000',C'F',FL1'7' A F 00000245 DC X'0410000000',C'O',FL1'7' A**3 O 00000246 DC X'0400000000',C'M',FL1'1' A M 00000247 DC X'0410000000',C'M',FL1'1' A**3 M 00000248 DC X'0000400000',C' ',FL1'2' I 00000249 DC X'0010400000',C' ',FL1'4' I**3 00000250 DC X'0000400000',C'F',FL1'8' I F 00000251 DC X'0010400000',C'O',FL1'8' I**3 O 00000252 DC X'0000400000',C'M',FL1'2' I M 00000253 DC X'0010400000',C'M',FL1'2' I**3 M 00000254 DC X'0000010000',C' ',FL1'2' PDQ3 00000255 DC X'0010010000',C' ',FL1'4' PDQ**3 00000256 DC X'0000010000',C'F',FL1'8' PDQ F 00000257 DC X'0010010000',C'O',FL1'8' PDQ**3 O 00000258 DC X'0010010000',C'M',FL1'2' PDQ M 00000259 DC X'0010010000',C'M',FL1'2' PDQ**3 M 00000260 DC X'0010000400',C' ',FL1'2' P(4) 00000261 DC X'0020000400',C' ',FL1'4' P(4)**3 00000262 DC X'0010000400',C'F',FL1'8' P(4) F 00000263 DC X'0020000400',C'O',FL1'8' P(4)**3 O 00000264 DC X'0010000400',C'M',FL1'2' P(4) M 00000265 DC X'0020000400',C'M',FL1'2' P(4)**3 M 00000266 DC X'00000000000000' 00000267 DROP 15 00000268 FFOUT 6,'SCHOON2' 00000269 LTORG 00000270 *** 00000271 *** ANALYZE LHS OF SUBSTITUTION OR COMMAND */ 00000272 DS 0H 00000273 USING *,12 00000274 IDTFIER SETCAR AZPMEM1,0,C' ',1 LETTER ASSOCIAT WITH KEYWORD */ 00000275 / SETVAL IDAHE,0,(+,IDAAN,0,) POINTER TO BEGIN OF CURRENT LHS 00000276 / SET000 VLAG,0 NON ZERO IF COMMAND */ 00000277 / SET000 JANI1,0 00000278 / SET000 JDVF1,0 00000279 / SET000 NDUMY,0 00000280 / SETVAL NORDER,0,(+,7,0,) 00000281 *** ANALYZE POSSIBLY LEADING KEYWORDS. AZPMEM1=SUBSTITUTION KEYWORD * 00000282 *** NSPEC =COMMAND KEYWORD * 00000283 / PREADI1 NDUMFL NDUMFL=0 IF QUANT READ IS DUMMY */ 00000284 / CMP000 IAL,0 00000285 / BNE L0217 00000286 / PREADI1 NDUMFL 00000287 ** /* IGNORE POSSIBLY LEADING COMMA * 00000288 /L0217 SETVAL AA,0,(+,NDUMFL,0,) 00000289 PSARAY1 KEYWORD,SYMB1,NR 00000290 ** /* ARRAY WITH KEYWORDS MULTI,ONCE... * 00000291 / CMP000 NR,0 00000292 / BE SO190 00000293 SETVAL AZPMEM1,0,(+,MSPEC2,NR,) 00000294 / CMPCAR NBIND,0,C',',1 00000295 / BNE FOS2 UNEXPECTED... */ 00000296 / PREADI1 NDUMFL 00000297 / SETVAL AA,0,(+,NDUMFL,0,) 00000298 SO190 PSARAY1 COMMAND,SYMB1,NR 00000299 ** /* LIST OF KEYWORDS OF COMMANDS * 00000300 / SETVAL NSPEC,0,(+,NR,0,) 00000301 / CMP000 NSPEC,0 00000302 / BE SO193 00000303 / SET111 VLAG,0 SIGNALS COMMAND */ 00000304 / SETVAL NNUM1,0,(-,2,0,) 00000305 / CMPVAL NSPEC,0,(+,12,0,) 00000306 / BNE SO193 JP IF NOT TRICK */ 00000307 / CMP000 SUBS1$M,0 00000308 BNE SO193 00000309 / SETVAL SUBS1$M,0,(+,4,0,) 5 LEVELS FOR TRICK* 00000310 *** DETERMINE SUBSTITUTION LEVELS. CONSTRUCT PILOT WORD IN IDGEH. * 00000311 /SO193 SETVAL LEVLO,0,(+,SUBS1$L,0,) 00000312 / SETVAL LEVCL,0,(+,LEVLO,0,+,SUBS1$M,0,+,1,0,) 00000313 / SETVAL LEVCH,0,(+,LEVCL,0,) 00000314 CMPVAL LEVCL,0,(+,40,0,) 00000315 BH FOS15 00000316 SETVAL II5,0,(+,LEVCL,0,-,1,0,) 00000317 / DOLOOP J,LEVLO,II5,1,L0221,L0222 00000318 SETVAL K,0,(+,J,0,+,1,0,) 00000319 SETVAL NID$LST,K,(+,IDAAN,0,) 00000320 CMP000 NID$FST,K 00000321 / BNE L0321 00000322 SETVAL NID$FST,K,(+,IDAAN,0,) 00000323 /L0321 BXLE 7,8,L0221 00000324 L0222 SETVAL ID$LEVLF,IDAAN,(+,LEVLO,0,) 00000325 SETVAL ID$LEVLL,IDAAN,(+,LEVCL,0,-,1,0,) 00000326 SETVAL ID$LOCNR,IDAAN,(+,MBU,0,) 00000327 SETADR IDAAN,0,(+,ID$VAR,IDAAN,) 00000328 / SETVAL NDUMFL,0,(+,AA,0,) 00000329 / CMP000 NSPEC,0 00000330 / BE SO203 LAST READ WAS A VARIABLE */ 00000331 / SETVAL LEVLO,0,(+,LEVCL,0,) LAST READ WAS A KEYWORD */ 00000332 ** /* A NEXT IDENTIFIER IS FORCED TO BE CONSIDERED AS WITH * 00000333 ** /* ID IN FRONT */ 00000334 / B BIN243 00000335 ** 00000336 /RE201 PREADI1 NDUMFL RESTART */ 00000337 /SO203 SETVAL NNUM1,0,(+,NNUM1,0,+,1,0,) COUNTS ARGS IN NUMER */ 00000338 / CMPCAR NBIND,0,C'(',1 00000339 / BE SO207 00000340 / CMP000 NDUMFL,0 00000341 / BNE SO205 00000342 SETVAL NR,0,(+,IB,0,) 00000343 SET000 CODE,0 00000344 / CMP000 EXPOFL1,0 00000345 / BNE SC239 00000346 ** /* A DUMMY WHICH IS NOT AN EXPONENT CAN ONLY BE A DUMMY * 00000347 ** /* FUNCTION. ID, F+=... */ 00000348 / PINIDG1 IB,X'0' 00000349 / PINIDG1 0,X'600' 00000350 / SETVAL JDVF1,0,(+,JDVF1,0,+,1,0,) 00000351 / B BIN243 00000352 *** ANALYZE QUANT WITHOUT '(' WHICH IS NOT A DUMMY */ 00000353 /SO205 CMPVAL NSPEC,0,(+,24,0,) JP IF NOT EXPAND 00000354 / BNE SO205B 00000355 PSARAY1 X$NAME,SYMB1,NR CASE OF EXPAND 00000356 / CMP000 NR,0 00000357 / BE FOS16 WRONG FROZEN SUBEXPRESSION */ 00000358 / CMPBIT X$PROP,NR,FREZE,OFF 00000359 / BZ FOS16 00000360 LADR 8,X$NAME,NR 00000361 MVC CODE(4),0(8) INSERT FILENAME IN IDGEH 00000362 PINIDG1 0,CODE 00000363 ST 0,CODE 00000364 MVC CODE(1),4(8) 00000365 PINIDG1 0,CODE 00000366 / CMP000 X$LOCNR,NR 00000367 / BE FOS16 00000368 SETVAL K,0,(+,X$LOCNR,NR,) 00000369 CMP000 L$AKEY,K 00000370 / BNE L0223 00000371 / PFNAM2 NR NR 00000372 /L0223 B END245 ONLY 1 FILENAME IS ALLOWED */ 00000373 *** ANALYZE QUANT WITHOUT '(' WHICH IS NOT A DUMMY * 00000374 SO205B CMP000 NRFLAG1,0 00000375 BE SO205A 00000376 CMPVAL NSPEC,0,(+,19,0) NUMER 00000377 BE SO171 00000378 SET000 NNUM1,0 00000379 CMPVAL NSPEC,0,(+,21,0,) IFGRE 00000380 BE SO171 00000381 CMPVAL NSPEC,0,(+,22,0,) IFEQU 00000382 BE SO171 00000383 CMPVAL NSPEC,0,(+,23,0,) IFSMA 00000384 BE SO171 00000385 CMP111 VLAG,0 00000386 BE SO205A COMMAND 00000387 CMP000 EXPOFL1,0 00000388 BE FOS47 00000389 *** NUMERICAL QUANTITY WILL BE TREATED AS FIXED POINT NR X'7**' 00000390 /SO205A PSNAME1 NR,CODE 00000391 CMPVAL NR,0,(+,CODE,0,) 00000392 / BE SO237 APPLY DEFAULT */ 00000393 / CMPVAL CODE,0,(+,X'600',0,) 00000394 / BNE SC239 00000395 / PINIDG1 NR,CODE 00000396 / CMP000 VLAG,0 00000397 / BNE BIN243 00000398 / PINIDG1 0,X'600' FUNCTION IN COMMAND DOES */ 00000399 / B BIN243 NOT REQUIRE 3000B TERMINATOR */ 00000400 *** QUANTITY IS A FLOATING POINT NUMBER 00000401 SO171 SETVAL JANI1,0,(+,JANI1,0,+,64,0,) 00000402 L 1,IDAAN 00000403 LOAD 0,NRFLOAT,0 00000404 CMP000 IMINUS,0 00000405 BNH LL010 00000406 LCDR 0,0 CHANGE SIGN 00000407 LCDR 2,2 00000408 LL010 STORE 0,ALIGN,0 INSERT NRFLOAT IN IDGEH 00000409 MVC 0(16,1),ALIGN FAKE 4 TIMES USE OF INIDG1 00000410 LA 1,16(0,1) 00000411 ST 1,IDAAN 00000412 *** TEST ON CORRECT ALTERNATING VAR,VALUE IN NUMER COMMAND 00000413 CMP000 NNUM1,0 00000414 BNE FOS25 VARIABLE IS NOT GIVEN A VALUE 00000415 SETVAL NNUM1,0,(-,2,0,) 00000416 B BIN243 00000417 *** ANALYZE QUANT WITH '(' BEHIND IT. * 00000418 /SO207 SETNAM IA,0,SYMB1,0 00000419 SETVAL ILK,0,(+,SYMB1$C,1,) FIRST LETTER D-H IS FUNCTIO 00000420 / PREADI1 NDUMFL READ FIRST ARGUMENT */ 00000421 / CMPCAR NBIND,0,C')',1 00000422 / BNE FU217 /* JP IF CERTAINLY NO VECTOR * 00000423 PSARAY1 V$NAME,IA,NR 00000424 / CMP000 NR,0 00000425 / BNE VE209 00000426 PSARAY1 F$NAME,IA,NR 00000427 / CMP000 NR,0 00000428 / BNE FU217 00000429 / CMPCAR ILK,0,C'D',1 00000430 BL LL011 00000431 / CMPCAR ILK,0,C'H',1 00000432 BNH FU217 00000433 LL011 PZOEK V,IA,IB 00000434 / SETVAL NR,0,(+,IB,0,) 00000435 ** /* THE CRITERION OF NAME LONGER THAN 3 LETTERS IS NOT * 00000436 ** /* APPLIED */ 00000437 /VE209 SETVAL IB,0,(+,NR,0,) 00000438 / CMP000 NRFLAG1,0 00000439 / BNE SO215 00000440 PSARAY1 D$NAME,IA,NR ANALYZE VECTOR 00000441 / SETVAL CODE,0,(+,X'0',0,) 00000442 / CMP000 NR,0 00000443 / BNE SO211 00000444 / SETVAL JDVF1,0,(+,JDVF1,0,+,64,0,) 00000445 / SETVAL NR,0,(+,IB,0,) 00000446 / SETVAL CODE,0,(+,X'200',0,) 00000447 SO211 PINIDG1 NR,CODE 00000448 / PSNAME1 NR,CODE ANALYZE VECTOR ARGUM */ 00000449 CMPVAL NR,0,(+,CODE,0,) 00000450 / BNE SO213 00000451 PZOEK I,SYMB1,IA 00000452 / SETVAL JANI1,0,(+,JANI1,0,+,1,0,) 00000453 / SETVAL NR,0,(+,IA,0,) 00000454 / SETVAL CODE,0,(+,X'100',0,) 00000455 *** IA IS A VECTOR. SYMB1 IS THE QUANTITY FOLLOWING. CONSTRUCT VECTOR * 00000456 *** COMPONENT IF NR. ELSE CONSTRUCT 2 QUANTS. BY DEFAULT, THE SECOND * 00000457 *** QUANTITY IS AN INDEX. * 00000458 /SO213 PINIDG1 NR,CODE 00000459 / PREADI1 NDUMFL 00000460 / B BIN243 00000461 /SO215 PZOEK V,IA,IB VECTOR COMPONENT */ 00000462 / CMP000 NRFLAG1,0 00000463 / BE FOS3 STRANGE NOTATION */ 00000464 L 1,IB IA=32*MOD(IB,32)+MOD(NRFIX,32) 00000465 L 2,NRFIX 00000466 SLL 1,27 00000467 SLL 2,27 00000468 SRL 1,22 00000469 SRL 2,27 00000470 AR 1,2 00000471 ST 1,IA 00000472 SETVAL IA,0,(+,IA,0,+,X'800',0,) 00000473 / PREADI1 NDUMFL 00000474 / SETVAL JANI1,0,(+,JANI1,0,+,64,0,) 00000475 / SETVAL JDVF1,0,(+,JDVF1,0,+,64,0,) 00000476 / SETVAL NR,0,(+,IA,0,) 00000477 / SET000 CODE,0 00000478 / B SC239 00000479 ** 00000480 *** CASE OF A FUNCTION */ 00000481 /FU217 PSARAY1 D$NAME,IA,NR 00000482 / SETVAL JDVF1,0,(+,JDVF1,0,+,1,0,) 00000483 / CMP000 NR,0 00000484 / BE L0224 00000485 / SETVAL NR,0,(+,NR,0,+,X'0',0,) 00000486 / B SO221 00000487 /L0224 PZOEK F,IA,IB 00000488 / SETVAL NR,0,(+,IB,0,+,X'600',0,) 00000489 / CMPVAL IB,0,(+,X'11',0,) 00000490 / BE SO222 JP IF FUNCTION DF */ 00000491 /SO221 SET000 CODE,0 00000492 / PINIDG1 NR,CODE 00000493 / B ARG227 00000494 /SO222 SET000 CODE,0 CASE OF SPECIAL FUNCTION DF */ 00000495 / PINIDG1 NR,CODE 00000496 SETVAL CODE,0,(+,X'700',0,) 00000497 / DOLOOP J,1,5,1,L0225,L0226 CONSTRUCT FILENAME */ 00000498 SETVAL NR,0,(+,SYMB1$C,J,) 00000499 PINIDG1 NR,CODE 00000500 / BXLE 7,8,L0225 00000501 /L0226 PREADI1 NDUMFL 00000502 / CMP000 NRFLAG1,0 00000503 / BNE L0227 00000504 / SET000 NR,0 00000505 / B L0230 00000506 L0227 SR 1,1 00000507 IC 1,NRFIX+2 00000508 ST 1,NR NR=BITS(NRFIX,17,24) 00000509 /L0230 PINIDG1 NR,X'700' CONSTRUCT INDEX */ 00000510 / CMP000 NRFLAG1,0 00000511 BE SO229A 00000512 SR 1,1 00000513 IC 1,NRFIX+3 00000514 ST 1,NRFIX NRFIX=BITS(NRFIX,25,32) 00000515 B SO229A START ANALYSIS OF NORMAL ARGUMS */ 00000516 *** ANALYSIS OF FUNCTION ARGUMENTS. ENTER AT ARG227 */ 00000517 /SO223 CMP000 IMINUS,0 00000518 / BNH SO225 00000519 PUTMIN NR,0 2 CODES WILL BE INSERTED IN IDGEH 00000520 /SO225 SET000 CODE,0 00000521 / PINIDG1 NR,CODE 00000522 / CMPCAR NBIND,0,C')',1 00000523 / BNE L0232 00000524 PINIDG1 0,X'600' 00000525 / PREADI1 NDUMFL TERMINATE 00000526 / B BIN243 00000527 /L0232 PREADI1 NDUMFL 00000528 / CMP000 NDUMFL,0 00000529 BNE ARG227 00000530 / SETVAL NR,0,(+,IB,0,) DUMMY CAN BE INSERTED * 00000531 / B SO225 IMMEDIATELY */ 00000532 /ARG227 CMPCAR NBIND,0,C'(',1 00000533 / BNE SO229 00000534 / SETVAL SO1,0,(+,IMINUS,0,) ARG IS A VECTOR COMPONENT */ 00000535 / SET000 IMINUS,0 P(MU+) CANNOT BE AN ARG. */ 00000536 / PCOVNR1 NR,CODE 00000537 / SETVAL JDVF1,0,(+,JDVF1,0,+,4096,0,) 00000538 / SETVAL NR,0,(+,NR,0,+,CODE,0,) 00000539 / CMP000 CODE,0 00000540 BE FOS14 ILLEGAL FUNCTION ARGUMENT 00000541 / B SO225 00000542 /SO229 CMP000 NRFLAG1,0 00000543 / BNE SO229A /* ZERO CAN MATCH A DELETED FILE. */ 00000544 PSARAY1 X$NAME,SYMB1,NR 00000545 / CMP000 NR,0 00000546 / BE SO229A 00000547 / CMPBIT X$PROP,NR,FILE,OFF 00000548 / BO L0234 00000549 / SETVAL NR,0,(+,X'500',0,+,X$LOCNR,NR,) 00000550 B SO223 00000551 /L0234 SETVAL NR,0,(+,X'500',0,+,NR,0,) 00000552 B SO223 00000553 /SO229A PSNAME1 NR,CODE 00000554 CMPVAL NR,0,(+,CODE,0,) 00000555 / BNE L0236 00000556 / PCOSYM1 NR,CODE 00000557 / SETVAL NR,0,(+,NR,0,+,CODE,0,) 00000558 / B SO223 00000559 /L0236 SETVAL NR,0,(+,NR,0,+,CODE,0,) 00000560 / CMP000 CODE,0 00000561 / BNE L0237 00000562 CMPCAR SYMB2,0,X'0000000000',5 00000563 / BE SO225 00000564 B FOS14 ILLEGAL FUNCTION ARGUMENT 00000565 /L0237 CMPVAL CODE,0,(+,X'600',0,) 00000566 / BNE SO223 00000567 / SETVAL NR,0,(+,NR,0,-,X'600',0,+,X'220',0,) FU ARG IS A FUN 00000568 / B SO223 00000569 ** 00000570 SO237 PSARAY1 X$NAME,SYMB1,NR APPLY DEFAULT 00000571 / CMP000 NR,0 00000572 / BNE L0240 00000573 / PCOSYM1 NR,CODE FOR SCALAR */ 00000574 B SC239 00000575 /L0240 SETVAL CODE,0,(+,X'500',0,) QUANTITIES. */ 00000576 /SC239 CMP000 EXPOFL1,0 00000577 / BE L0242 00000578 SETVAL IDAAN,0,(+,IDAAN,0,-,NEXTW,0,) OVERWRITE EXPONENT 00000579 /L0242 PINIDG1 NR,CODE 00000580 / CMP000 EXPOFL1,0 00000581 / BNE BIN243 00000582 / CMP000 VLAG,0 00000583 / BNE BIN243 00000584 / CMPCAR NBIND,0,C'=',1 00000585 / BNE SO242 00000586 / CMPCAR AZPMEM1,0,C'O',1 00000587 / BNE SO241A ONCE */ 00000588 / SETVAL JANI1,0,(+,JANI1,0,+,64,0,) 00000589 / B SO242 00000590 SO241A SETADR TEST5,0,(+,ID$VAR,IDAHE,+,NEXTW,0,) 00000591 CMPVAL IDAAN,0,(+,TEST5,0,),EQ,BIN243 00000592 /SO242 PINIDG1 1,X'700' NO EXPONENT IF ONLY ONE FACTOR */ 00000593 /BIN243 CMPCAR NBIND,0,C'=',1 00000594 / BE END245 INSPECT BINDING CHAR */ 00000595 / CMPVAL NBIND,0,(+,X'77',0,) 00000596 / BE END245 00000597 / CMP000 NBLAN1,0 00000598 / BNE END245 00000599 / CMPCAR NBIND,0,C')',1 00000600 / BNE RE201 00000601 / B FOS2 UNEXPECTED ... */ 00000602 /END245 SET111 IDIND1,0 00000603 SETVAL ID$POINT,IDAHE,(+,IDAAN,0,-,IDADR,0,) 00000604 / CMP000 NSPEC,0 00000605 / BNE SO265 00000606 / CMP000 NBLAN1,0 00000607 / BNE FOS1 EXPECT = OR ) */ 00000608 ** 00000609 *** ANALYZE THE TYPE OF SUBSTITUTION */ 00000610 / SET111 FLAG1,0 00000611 / CMP111 NDUMY,0 00000612 / BNE L0243 00000613 / SET000 FLAG1,0 00000614 /L0243 CMPVAL NDUMY,0,(+,2,0,) 00000615 / BNL SO251 NOT INCLUDED IN TABLE */ 00000616 / SET000 FLAG2,0 00000617 CCALL LOOKUP 00000618 / CMP000 FLAG3,0 00000619 / BE SO251 JP IF NOT FOUND */ 00000620 / SET111 FLAG2,0 00000621 / SETVAL FLAG4,0,(+,FLAG3,0,) 00000622 CCALL LOOKUP 00000623 / CMP000 FLAG3,0 00000624 / BNE SO263 00000625 / SETVAL FLAG3,0,(+,FLAG4,0,) 00000626 / B SO263 00000627 ** 00000628 *** CASE OF SUBSTITUTIONS, NOT FOUND IN THE TABLE */ 00000629 SO251 L 1,JDVF1 IF MOD(JDVF1,64) NE 1 THEN GOTO SO257 00000630 SLL 1,26 00000631 SRL 1,26 00000632 CR 1,6 00000633 BNE SO257 00000634 *** TEST FIRST QUANTITY OF THAT IDENTIFIER 00000635 CMPVAL -ID$VAR-TYPE-,IDAHE,(+,FUNCT,0,),NE,SO253 00000636 LA 3,NEXTW 00000637 LNR 3,3 IF IDGEH(K).CODE(5) NE 3000B THEN GOTO SO25 00000638 A 3,IDAAN LAST QUANTITY OF THE IDENTIFIER 00000639 ST 3,II5 00000640 CMPVAL ID$VAR1,II5,(+,FUNCT0,0,),NE,SO255 00000641 SETVAL FLAG3,0,(+,10,0,) 00000642 L 3,IDAHE IF IDAAN NE ADDR(IDGEH(IDAHE).VAR) 00000643 USING ID$,3 +2*NEXTW+NDUMY*NEXTW THEN... 00000644 LA 1,ID$VAR+2*NEXTW SPACE FOR FU AND ) 00000645 S 1,IDAAN 00000646 L 2,NDUMY 00000647 SLA 2,2 4 BYTES PER DUMMY 00000648 AR 1,2 00000649 BNE SO263 00000650 ** /* ONE FUNCTION.ALL ARGS DUMMIES.NO REPETITIVE DUMMIES */ 00000651 LA 2,ID$VAR+NEXTW ERASE ALL DUMMIES IN IDGEH 00000652 ST 2,IDAAN 00000653 DROP 3 00000654 SETVAL ID$POINT,IDAHE,(+,IDAAN,0,-,IDADR,0,) 00000655 SET000 ID$SOORT,IDAHE 00000656 / B STEX3 00000657 /SO253 SETVAL FLAG3,0,(+,10,0,) MIGHT STILL BE A DUMMY FUN */ 00000658 CMPVAL -ID$VAR-TYPE-,IDAHE,(+,DUMMY,0,),EQ,SO263 00000659 /SO255 SETVAL FLAG3,0,(+,9,0,) ANYTHING * ONE FUNCTION */ 00000660 / B SO263 00000661 /SO257 SETVAL FLAG3,0,(+,13,0,) 00000662 / CMPCAR AZPMEM1,0,C'N',1 00000663 / BNE L0245 00000664 / SETVAL FLAG3,0,(+,11,0,) 00000665 /L0245 CMPCAR AZPMEM1,0,C'O',1 00000666 BNE SO263 00000667 / SETVAL FLAG3,0,(+,12,0,) 00000668 SO263 SETVAL ID$SOORT,IDAHE,(+,FLAG3,0,) FOUND IN TABLE 00000669 / B STEX3 00000670 ** 00000671 *** CASE OF COMMANDS */ 00000672 SO265 SETVAL ID$SOORT,IDAHE,(+,NSPEC,0,+,29,0,) 00000673 / CMPVAL NSPEC,0,(+,19,0,) 00000674 / BNE SO266 COMMAND NUMER */ 00000675 / CMPVAL NNUM1,0,(-,2,0,) 00000676 BNE FOS25 VARIABLE IS NOT GIVEN A VALUE 00000677 /SO266 SET000 NSPEC,0 00000678 / SET000 NNUM1,0 00000679 / CMP000 NBLAN1,0 00000680 BNE NBLANK3 00000681 JUMP GOON1 00000682 NBLANK3 JUMP NBLANK1 00000683 STEX3 JUMP STEXPR 00000684 FOS1 ERRORP 3,' EXPECT = OR ) ' 00000685 FOS2 MVC F2+32(1),NBIND 00000686 CLI NBIND,X'77' 00000687 BNE F2 00000688 MVI F2+32,C'?' 00000689 F2 ERRORP 3,' UNEXPECTED ' 00000690 FOS3 MVC F3+38(1),BBA 00000691 MVC F3+39(1),BBB 00000692 CLI BBB,X'77' CONDITION CODE CHANGED 00000693 BNE F3 00000694 MVI F3+39,C'?' 00000695 F3 ERRORP 3,' STRANGE NOTATION ' 00000696 FOS14 ERRORP 3,' ILLEGAL FUNCTION ARGUMENT' 00000697 FOS15 ERRORP 3,' TOO MANY SUBSTITUTION LEVELS' 00000698 FOS16 SET000 NCONT,8 00000699 ERRORP 3,' WRONG FROZEN SUBEXPRESSION' 00000700 FOS25 ERRORP 3,' VARIABLE IS NOT GIVEN A VALUE' 00000701 FOS47 ERRORP 3,' LHS OF SUBSTITUTION IS ILLEGAL' 00000702 ** 00000703 MSPEC DC C'REDUC',C'TRACE',C'ORTHG' KEYWORDS FOR COMMANDS 00000704 DC C'ORTHN',C'ORDER',C'ORDEI' 00000705 DC C'SYMXX',C'ASYMX',C'ASYMP' 00000706 DC C'SPIN1',C'COUNT',C'TRICK' 00000707 DC C'EVENX',C'ODDXX',C'REPLA' 00000708 DC C'RATIO',C'RENAM',C'ORDEF' 00000709 DC C'NUMER',C'SELFE',C'IFGRE' 00000710 DC C'IFEQU',C'IFSMA',C'EXPAN' 00000711 DC C'COMPO' 00000712 MSPEC1 DC C'MULTI',C'FUNCT',C'DOTPR' KEYWORDS FOR SUBSTITUT 00000713 DC C'ONCEX',C'AINBE',C'ADISO',C'ONCE',X'00' 00000714 MSPEC2 DS 0CL1 00000715 DC C'MFDOONO' 1 LETTER FOR EACH KEYWORD OF MSPEC1 00000716 DROP 12 00000717 FFOUT 3,'INP-LHS' 00000718 LTORG 00000719 END 00000720 ./A SCHOON3,INCR=1 00000001 ./MACRO MAINMCRO 00000002 ./MACRO INMACRO 00000003 TITLE 'SCHOON3' 00000004 GBLC &OVLAY 00000005 LCLA &PT$B,&PT$L,&WORD 00000006 ./MACRO INCOM 00000007 ./MACRO MAINCOM 00000008 PRINT NOGEN 00000009 SCHOON3 CSECT 00000010 EQUIVAL 00000011 ENTRY STEXPR 00000012 EXTRN GOON1,NBLANK1,MAIN,ZOEK,FOUT,FOUTP,LEZE1,INDON,TAKMAN 00000013 EXTRN UNCF,FORWAR,SARAY1,SNAME1,COVNR1,COSYM1 00000014 USING INCOM,10 00000015 USING BLANK,11 00000016 *** ANALYZE RIGHT HAND SIDE OF AN EXPRESSION 00000017 *** START NEW EXPRESSION */ 00000018 DS 0H 00000019 USING *,12 00000020 /STEXPR CMP000 RIND1,0 00000021 / BE STEX2 R-INPUT INDICATOR */ 00000022 CCALL STARTR 00000023 B RINPU6 00000024 /STEX2 SET000 FITE1,0 00000025 / SET111 NTEKEN,0 00000026 SETVAL L$BEGIN,MBU,(+,MBE,0,) 00000027 SET000 L$AKEY,MBU 00000028 SET000 L$DUMNR,MBU 00000029 SET000 L$PROP,MBU 00000030 SETVAL MBU,0,(+,MBU,0,+,1,0,) 00000031 *** START NEXT TERM */ 00000032 /STTE1 SETVAL NORDER,0,(+,10,0,) 00000033 / CMP000 RIND1,0 00000034 / BNE RINPU1 00000035 CCALL STTERM 00000036 *** START NEXT FACTOR */ 00000037 /STFA1 PLEZE1 00000038 / CMP000 RIND1,0 00000039 / BE SO27 00000040 / CMP000 IAL,0 00000041 / BNE SO27 SEARCH FOR *( */ 00000042 / CMPCAR NBIND,0,C'(',1 00000043 / BNE SO27 00000044 CCALL REND 00000045 / SET000 VECIN1,0 00000046 / SETVAL SHMEM1,0,(+,2,0,) 00000047 / B RINPU5 START SCALAR */ 00000048 ** 00000049 *** CASE OF R INPUT - NREP NE 0 PREVENTS CREATION OF DOLLARS, WHEN * 00000050 *** BRACHETS ARE SEEN. IDIND1 NE 0 WHEN RHS OF SUBSTITUTION IS */ 00000051 *** ANALYSED . = 0 WHEN RHS OF Z EXPR * 00000052 *** FITE2 = 0 WHEN FIRST TERM OF FIRST R EXP IS READ - REQUESTS * 00000053 *** ASSIGNMENT OF BUFFER SPACE TO WRITE EXPRESSION ON TAPE6 */ 00000054 *** R INPUT HAS FORMAT VECTOR+VECTOR+VECTOR*(SCALAR+SCALAR+...)+... * 00000055 *** IS TRANSLATED IN VECTOR*(E.SC)+VECTOR*(E.SC)+VECTOR*(SC+SC+..)+.. * 00000056 *** WITH E.SC = EMPTY SCALAR TAIL = */ 00000057 *** 00000018/41100000/00000000/00000000/00000000/0801 0000/ 00000058 *** POINTER=LENGTH IN BYTES. INCLUDING POINTER,COEFF 00000059 *** FILE.LENGT=0801= LENGTH IN WORDS OF CODE. EXCLUD POINT,COEFF 00000060 RINPU1 CCALL REND END OF A VECTOR OR SCALAR 00000061 / CMP000 VECIN1,0 00000062 / BE RINPU4 JP IF SCALAR */ 00000063 CCALL REND3 00000064 RINPU6 SET000 T$0WORD,MBE START NEW VECTOR. SEPARATE WITH ONE. 00000065 LADR 1,T$0NEXTW,MBE 00000066 ST 1,MBE 00000067 / SETVAL SHMEM1,0,(+,3,0,) SHIFT FOR VECTOR */ 00000068 CMPVAL MBE,0,(+,ITTA1,0,+,BUFLENG-2*LTERM-2*CODEA-20,0,) 00000069 *** JUMP IF BUFFER FULL. 00000070 / BH TAK1 BUFFER FULL */ 00000071 / SETVAL LVEC1,0,(+,MBE,0,) REMEMBER LAST VECTOR HEAD */ 00000072 / B RINPU5 00000073 RINPU4 CMPVAL MBE,0,(+,ITTA1,0,+,BUFLENG-LTERM-CODEA-20,0,),GT,TAK2 00000074 / SETVAL SHMEM1,0,(+,2,0,) START NEW SCALAR 00000075 /RINPU5 SETVAL KTERM,0,(+,MBE,0,) BEGIN NEW QUANTITY . VECTOR OR SC 00000076 LD 0,=D'1.0' IT(MBE).FLOAT=FLOAT(NTEKEN) 00000077 SDR 2,2 = +1 OR -1 00000078 C 0,NTEKEN 00000079 BNH LL005 00000080 LNDR 0,0 00000081 LL005 STORE 0,T$1COEFF,MBE 00000082 / PLEZE1 00000083 / B SO27 00000084 TAK1 SET000 T$0WORD,MBE BUFFER FULL 00000085 SETVAL START,0,(+,ITTA1,0,-,VECTS,0,) 00000086 SETVAL K2,0,(+,MBE,0,-,ITTA1,0,+,4,0,) 00000087 PTAKMAN NTAP6,START,K2,WRITE0 00000088 / SETVAL MBE,0,(+,ITTA1,0,) 00000089 / B RINPU6 START WITH NEW VECTOR */ 00000090 TAK2 CCALL FULVECT 00000091 / B RINPU5 START SCALAR WITH THE SAME VECTOR */ 00000092 ** 00000093 *** BEGIN OF ANALYSIS OF A FACTOR */ 00000094 /SO27 CMP000 EXPOFL1,0 00000095 / BNE SO31 00000096 / CMP000 IMINUS,0 00000097 / BNH SO31 00000098 LOAD 0,T$1COEFF,KTERM 00000099 LCDR 0,0 IT(KTERM).FLOAT=-IT(KTERM).FLOAT 00000100 LCDR 2,2 00000101 STORE 0,T$1COEFF,KTERM 00000102 /SO31 CMP000 NRFLAG1,0 00000103 / BE SO49 JP IF NO NUMBER READ */ 00000104 / CMP000 EXPOFL1,0 00000105 / BNE SO37 00000106 ** 00000107 *** A NUMBER IS READ IN. TREAT AS 34** FACTOR IF SMALL INTEGER. ELSE */ 00000108 *** MULTIPLY IT(KTERM) ACCORDINGLY */ 00000109 FLOAT 0,NRFIX,0 IF FLOAT(NRFIX) NE NRFLOAT THEN GOTO SO33 00000110 CD 0,NRFLOAT 00000111 BNE SO33 00000112 CD 2,NRFLOAT+8 00000113 BNE SO33 JP IF NOT AN EXACT INTEGER 00000114 L 2,NRFIX IF ABS(NRFIX) >= 128 THEN GOTO SO33 00000115 LPR 1,2 00000116 C 1,=F'128' 00000117 BNL SO33 NR HAS TO BE REPRESENTED AS FL POINT 00000118 STORE 2,-QUANT-NR-,0 00000119 SETVAL -QUANT-TYPE-,0,(+,NUMBER,0,) 00000120 / B SO51 00000121 SO33 LOAD 0,T$1COEFF,KTERM 00000122 LOAD 4,NRINVERS,0 00000123 CMP000 SLASH1,0 00000124 BNE L0075 00000125 LOAD 4,NRFLOAT,0 00000126 L0075 MULTP 00000127 STORE 0,T$1COEFF,KTERM 00000128 SETVAL EREXP1,1,(+,2,0,) NUMBER ** NUMBER IS ILLEGAL */ 00000129 ** 00000130 *** TERMINATORS OF A FACTOR */ 00000131 /BIND35 CMPCAR NBIND,0,C')',1 00000132 / BE SO43 END OF EXPRESSION */ 00000133 / CMPCAR NBIND,0,C'=',1 00000134 / BE SO45 END OF IDENTITY */ 00000135 / CMPCAR NBIND,0,C'*',1 00000136 / BE STFA1 NEXT FACTOR */ 00000137 / CMPCAR NBIND,0,C'+',1 00000138 / BE SO41 NEXT TERM */ 00000139 / CMPCAR NBIND,0,C'-',1 00000140 / BE SO41 NEXT TERM */ 00000141 / CMPVAL NBIND,0,(+,X'77',0,) 00000142 / BE SO40A SPECIAL TERMINATOR */ 00000143 / CMPCAR NBIND,0,C',',1 00000144 / BE SO40 DATA EXPRESSION */ 00000145 / CMP000 NBLAN1,0 00000146 BE FOS26 ILLEGAL ... 00000147 *** NOT UNDERSTOOD ****************** */ 00000148 / CMP000 IDIND1,0 00000149 / BNE SO45 IDENTITY */ 00000150 B FOS24 ) OR = EXPECTED 00000151 /SO37 CMP000 IMINUS,0 00000152 / BNH L0077 00000153 / SETVAL NRFIX,0,(-,NRFIX,0,) INSERT EXPONENT */ 00000154 L0077 LA 1,X'700' 00000155 IC 1,NRFIX+3 00000156 ST 1,QUANT QUANT.NR=NRFIX . QUANT.TYPE=7 00000157 / PINDON QUANT,1 00000158 / CMP000 EREXP1,2 00000159 / BE BIND35 00000160 B FOS6 ... ** EXP NOT ALLOWED 00000161 *** CASE OF ',' */ 00000162 /SO40 CMP000 DATAFL1,0 00000163 BE FOS29 FORMAT ERROR IN LAST LINE 00000164 ** /* FOR DATA EXPR NO TERMINATING 0000B NEEDED */ 00000165 PINDON 0,0 00000166 SETVAL MBE,0,(+,MBE,0,-,NEXTW,0,) 00000167 CMP000 T$0WORD,MBE,EQ,STTE1 00000168 SETVAL MBE,0,(+,MBE,0,+,NEXTW,0,) 00000169 / B STTE1 00000170 *** CASE OF '+' OR '-' */ 00000171 /SO41 CMP000 DATAFL1,0 00000172 BNE FOS29 FORMAT ERROR IN LAST LINE 00000173 ** /* DATA EXPRESSION HAS PURELY MULTIPLICATIVE COMPONENTS */ 00000174 / CMP000 RIND1,0 00000175 / BNE RINPU1 00000176 / PINDON 0,0 TERMINATE TERM */ 00000177 / B STTE1 00000178 *** CASE OF ')' */ 00000179 /SO43 CMP000 RIND1,0 00000180 BE FOS29 FORMAT ERROR IN LAST LINE 00000181 L 15,=A(REND) 00000182 BALR 14,15 00000183 / PLEZE1 00000184 / CMPVAL NBIND,0,(+,X'77',0,) 00000185 / BE SO40B 00000186 / SET111 VECIN1,0 00000187 / B RINPU6 00000188 *** CASE OF 77B . SPECIAL TERMINATIOR */ 00000189 /SO40A CMP000 RIND1,0 00000190 / BE SO45 00000191 CCALL REND 00000192 CCALL REND3 00000193 SO40B JUMP ENDR 00000194 *** 00000195 *** END OF EXPRESSION */ 00000196 /SO45 PINDON 0,0 00000197 / CMP000 NCIND,0 00000198 / BNE SO46 00000199 / SET000 NDUMY,0 00000200 / CMP000 XDRE1,0 00000201 / BE SO46 00000202 / SETVAL MTAB,5,(+,MBE,0,) TERMINATE X EXPRESSION */ 00000203 / SETVAL MTAB,11,(+,MBU,0,) 00000204 SETMAX K,LEVCH,LEVHY 00000205 SETVAL X$DEPTH,XDRE1,(+,K,0,) 00000206 / SET000 XDRE1,0 00000207 / SET111 LEVLO,0 00000208 / SET111 LEVCL,0 00000209 / SET111 LEVCH,0 RESET LEVEL COUNTERS */ 00000210 / SET000 LEVHY,0 00000211 /SO46 SET000 IDIND1,0 00000212 / CMP000 DATAFL1,0 00000213 / BE L0100 00000214 / SET000 DATAFL1,0 00000215 / SET111 T$1POINT,KTERM /* TERMINATE DATA EXPRESSION */ 00000216 /L0100 CMP000 NBLAN1,0 00000217 BNE NBLANK2 00000218 JUMP GOON1 BLANK FIRST COLUMN 00000219 NBLANK2 JUMP NBLANK1 00000220 ** 00000221 *** AN ALPHABETIC SYMBOL WAS READ IN. COME FROM SO31 */ 00000222 /SO49 SET000 VLAG,0 00000223 / CMP000 IAL,0 00000224 / BE SO47 MUST BE P(N)*... */ 00000225 / CMPCAR NBIND,0,C'(',1 00000226 / BE SO65 00000227 / CMP000 EXPOFL1,0 00000228 / BNE SO61 JP IF EXPONENT */ 00000229 / B SO55 00000230 /SO47 CMPCAR BBA,0,C')',1 00000231 / BE BIND35 00000232 B FOS13 STRANGE NOTATION. 00000233 *** ANALYZE ALPHABETIC SYMBOL. NOT EXPONENT. NOT FOLLOWED BY ARGS */ 00000234 SO55 PSARAY1 X$NAME,SYMB1,NR 00000235 SETNAM IB,0,SYMB1,0 REQUIRED BY IFILE 00000236 / CMP000 NR,0 00000237 / BE SO57 00000238 *** CASE OF CONJG OR INTEG */ 00000239 /SO55A CMPVAL NR,0,(+,3,0,) 00000240 / BL L0101 00000241 / PIFILE 1,NR COME FROM SO65 * 00000242 / B SO58A 00000243 L0101 SETVAL K,0,(+,X$CODE,NR,) 00000244 PINDON K,0 00000245 ** /* CONJG(...) AND CONJG*(...) ARE LEGAL. SAME FOR INTEG * 00000246 / CMPCAR NBIND,0,C'*',1 00000247 / BNE L0102 00000248 / SET000 CREATBR,0 00000249 / B SO56 00000250 /L0102 CMPCAR NBIND,0,C'(',1 00000251 / BNE FOS5 WHATS IN A NAME */ 00000252 / SETVAL CREATBR,0,(-,1,0,) 00000253 /SO56 PLEZE1 00000254 CMPCAR B,1,C'$',1 00000255 / BNE FOS5 WHATS IN A NAME */ 00000256 / PCOSYM1 NR,CODE 00000257 / SETVAL QUANT,0,(+,NR,0,+,CODE,0,) 00000258 / B SO51 INSERT DOLLAR EXPRESSION */ 00000259 *** ANALYSE ALPHABETIC SYMBOL WITHOUT ARGS. NOT IN NXGEH */ 00000260 /SO57 PSARAY1 S$NAME,SYMB1,NR 00000261 / SETVAL TUS1A,0,(+,X'400',0,+,NR,0,) 00000262 / CMP000 NR,0 00000263 / BNE SO50 00000264 PSARAY1 I$NAME,SYMB1,NR 00000265 / SETVAL TUS1A,0,(+,X'100',0,+,NR,0,) 00000266 / CMP000 NR,0 00000267 / BNE SO50 00000268 PSARAY1 F$NAME,SYMB1,NR 00000269 / CMP000 NR,0 00000270 / BE SO59 NOWHERE FOUND. APPLY DEFAULT*/ 00000271 / SETVAL TUS1A,0,(+,X'600',0,+,NR,0,) 00000272 PSARAY1 D$NAME,SYMB1,NR 00000273 / CMP000 NR,0 00000274 / BNE L0103 00000275 / PINDON TUS1A,0 NORMAL FUNCTION * 00000276 B SO58A 00000277 /L0103 PIFILE 0,NR 00000278 /SO58A PINDON X'600',0 TERMINATE FUNCTION */ 00000279 / CMP000 SLASH1,0 00000280 / BE L0105 00000281 SET111 EREXP1,2 00000282 B FOS6 00000283 /L0105 SET111 EREXP1,1 FUNCTION **EXP NOT ALLOWED */ 00000284 / B BIND35 00000285 ** 00000286 *** INSERT A QUANTITY IN IT. GIVE IT AN EXPONENT +1 OR -1 */ 00000287 SO50 PSARAY1 D$NAME,SYMB1,NR 00000288 / CMP000 NR,0 00000289 / BNE L0111 00000290 / SETVAL QUANT,0,(+,TUS1A,0,) 00000291 B SO51 00000292 /L0111 SETVAL QUANT,0,(+,NR,0,) +X'000' 00000293 ** /*USE ORIGINAL VALUE IF NOT DUMMY AT THE SAME TIME* 00000294 *** INSERT NUMBER 34** . COME FROM SO31 */ 00000295 /SO51 PINDON QUANT,0 00000296 / CMP000 SLASH1,0 00000297 / BNE L0113 00000298 / SETVAL QUANT,0,(+,X'701',0,) 00000299 / B L0114 00000300 /L0113 SETVAL QUANT,0,(+,X'7FF',0,) IF PRECEDED BY SLASH * 00000301 /L0114 PINDON QUANT,0 00000302 / B BIND35 00000303 ** 00000304 *** A QUANTITY, NOT APPEARING IN ANY NAMELIST, IS ASSUMED ALGEBRA * 00000305 SO59 PSARAY1 D$NAME,SYMB1,NR 00000306 / CMP000 NR,0 00000307 / BE L0115 00000308 / SETVAL QUANT,0,(+,NR,0,) +X'000' 00000309 B SO51 00000310 /L0115 PCOSYM1 NR,CODE 00000311 / SETVAL QUANT,0,(+,NR,0,+,CODE,0,) 00000312 B SO51 00000313 *** ANALYZE ALPHABETIC QUANTITY, BEING AN EXPONENT */ 00000314 SO61 PSARAY1 D$NAME,SYMB1,NR MUST BE A DUMMY 00000315 / CMP000 EREXP1,2 00000316 / BE L0117 00000317 B FOS6 ... ** EXP NOT ALLOWED 00000318 *** EREXP(2) CHARACTERIZES QUANTITY , ILLEGAL TO BE RAISED TO POWER */ 00000319 *** 1 = FUNC ; 2 = NUMB ; 3 = VECTOR ; */ 00000320 /L0117 CMP000 NR,0 00000321 / BE FOS5 WHATS IN A NAME */ 00000322 / CMP000 IMINUS,0 00000323 / BNH L0120 00000324 / SETVAL IA,0,(+,NR,0,) 00000325 / PINDON X'7FF',1 -1 00000326 / SETVAL NR,0,(+,IA,0,) 00000327 L0120 PINDON NR,1 00000328 / B BIND35 00000329 *** ANALYZE ALPHABETIC SYMBOL FOLLOWED BY BRACKETS */ 00000330 SO65 CMPCAR B,1,C'$',1 00000331 BE FOS13 STRANGE NOTATION. 00000332 PSARAY1 X$NAME,SYMB1,NR 00000333 CMP111 NR,0 00000334 BE SO55A CONJG 00000335 CMPVAL NR,0,(+,2,0,) 00000336 BE SO55A INTEG 00000337 SETNAM IB,0,SYMB1,0 00000338 / SETVAL AA,0,(+,SLASH1,0,) IS SYMB1 A FUNCTION OR A VECTOR . 00000339 / SETVAL DS1,0,(-,1000,0,) COUNTS CO0 FOR DS */ 00000340 / SET000 VLAG,0 00000341 SETVAL ILK,0,(+,SYMB1$C,1,) 00000342 / PLEZE1 00000343 CCALL FORWAR SEE IF INTEG() MUST BE GENERATED 00000344 / CMPCAR NBIND,0,C')',1 00000345 / BNE FU83 SEVERAL ARGS. MUST BE FUNCTION */ 00000346 / CMP000 IAL,0 00000347 / BE FU83 QUANTITY WITHOUT ARG */ 00000348 CMPCAR IB$C,3,X'00',1 00000349 / BNE FU83 /* NAME OF MORE THAN 2 LETTERS * 00000350 PSARAY1 V$NAME,IB,NR 00000351 / CMP000 NR,0 00000352 / BE SO81 UNDECIDED */ 00000353 / SETVAL IA,0,(+,NR,0,) SURELY A VECTOR */ 00000354 PSARAY1 D$NAME,IB,NR 00000355 / CMP000 NR,0 00000356 BE VE67 00000357 / SETVAL IA,0,(+,NR,0,) 00000358 / B VE69 00000359 ** 00000360 *** ANALYZE ARGUMENT OF A VECTOR. LEGAL ARE DUMMY, VECTOR, NR, INDEX * 00000361 /VE67 SETVAL IA,0,(+,IA,0,+,X'200',0,) 00000362 /VE69 PSNAME1 NR,CODE 00000363 CMPVAL NR,0,(+,CODE,0,) 00000364 / BE SO71 ASSUME INDEX */ 00000365 / CMPVAL CODE,0,(+,X'100',0,) 00000366 / BE SO73 00000367 / CMPVAL CODE,0,(+,X'0',0,) 00000368 BE SO77 00000369 CMPVAL CODE,0,(+,X'200',0,) 00000370 BE SO77 00000371 / CMPVAL CODE,0,(+,X'700',0,) 00000372 / BE SO77 00000373 / B FOS5 WHATS IN A NAME */ 00000374 *** VECTOR ARGUMENT IS AN INDEX . REPRESENTED 1005 0403 OR 1005 1407 * 00000375 *** 0403 */ 00000376 SO71 PZOEK I,SYMB1,NR 00000377 CMPCAR B,1,C'$',1 00000378 / BE FOS5 WHATS IS A NAME */ 00000379 /SO73 SETVAL IB,0,(+,NR,0,+,X'100',0,) 00000380 / PINDON IA,0 INSERT THE VECTOR */ 00000381 / CMP000 IMINUS,0 00000382 / BNH L0122 00000383 / PINDON X'307',0 00000384 /L0122 PINDON IB,0 INSERT THE INDEX */ 00000385 / PLEZE1 00000386 / SETVAL EREXP1,0,(+,3,0,) CANNOT HAVE AN EXPONENT */ 00000387 / B BIND35 00000388 *** VECTOR ARGUMENT IS DUMMY, NR OR VECTOR. REPRESENTED 1403 1002 */ 00000389 *** 1407 1003 3401 */ 00000390 /SO77 SETVAL IB,0,(+,NR,0,+,CODE,0,) 00000391 / PINDON X'303',0 00000392 / PINDON IA,0 INSERT VECTOR */ 00000393 / CMP000 IMINUS,0 00000394 / BNH L0123 00000395 / PINDON X'307',0 00000396 /L0123 PLEZE1 00000397 / SETVAL SLASH1,0,(+,AA,0,) 00000398 / SETVAL QUANT,0,(+,IB,0,) GO TO INSERT ARGUMENT */ 00000399 / B SO51 00000400 *** ANALYZE SYMBOL WITH BRACKETS . UNDECIDED CONTINUATION OF SO65. */ 00000401 *** APPLY DEFAULTS */ 00000402 SO81 PSARAY1 F$NAME,IB,IA 00000403 / CMP000 IA,0 00000404 / BNE SO82C 00000405 PSARAY1 X$NAME,IB,NR 00000406 / CMP000 NR,0 00000407 / BE L0124 00000408 / PIFILE 1,NR 00000409 B SO89 00000410 /L0124 CMPCAR ILK,0,C'D',1 00000411 BL LL009 00000412 ** /* VARIABLE STARTING WITH D, E, F, G, H IS A FUNCTION * 00000413 CMPCAR ILK,0,C'H',1 00000414 BNH FU83 00000415 LL009 PSARAY1 D$NAME,IB,NR 00000416 / CMP000 NR,0 00000417 / BNE VE69 00000418 PZOEK V,IB,IA 00000419 / B VE67 00000420 *** CASE OF DF FUNCTION . ITS FIRST 2 ARGS ARE WRITTEN IN 34** FORMAT * 00000421 /SO82C CMPVAL IA,0,(+,X'11',0,) 00000422 / BNE FU83 00000423 / PINDON X'611',0 00000424 SETVAL QUANT,0,(+,X'700',0,) 00000425 SET000 J,0 00000426 L0125 SETVAL J,0,(+,J,0,+,1,0,) 00000427 LOAD 1,SYMB1$C,J 00000428 STC 1,QUANT+3 INSERT FILE NAME 00000429 / PINDON QUANT,0 00000430 CMPVAL J,0,(+,5,0,) INDON USES ALL REGS. BUT NOT J. 00000431 BL L0125 00000432 PLEZE1 00000433 / SETVAL QUANT,0,(+,X'700',0,) 00000434 / CMP000 NRFLAG1,0 00000435 BE L0130 00000436 MVC QUANT+3(1),NRFIX+2 QUANT=BITS(NRFIX,17,24)+3400B 00000437 /L0130 PINDON QUANT,0 INSERT NR OF SUBFILE */ 00000438 / CMP000 NRFLAG1,0 00000439 / BNE SO82F 00000440 PSARAY1 D$NAME,SYMB1,NR 00000441 / CMP000 NR,0 00000442 BE FOS33 WRONG DF ARGUMENT 00000443 / SETVAL QUANT,0,(+,NR,0,) +X'000' 00000444 / B SO105 00000445 SO82F MVC QUANT+3(1),NRFIX+3 QUANT=X'700'+BITS(NRFIX,25,32) 00000446 / B SO105 00000447 ** 00000448 *** ANALYZE ALPHABETIC QUANTITY WITH BRACKETS . SURELY NO VECTOR */ 00000449 FU83 PSARAY1 X$NAME,IB,NR 00000450 / CMP000 AA,0 00000451 / BE L0131 00000452 SET111 EREXP1,2 00000453 B FOS6 FUNCTION ** EXP NOT ALLOWED 00000454 /L0131 CMP000 NR,0 00000455 / BE L0132 00000456 / PIFILE 1,NR 00000457 B SO89 00000458 L0132 PSARAY1 D$NAME,IB,NR 00000459 / CMP000 NR,0 00000460 / BE L0133 00000461 / PIFILE 0,NR 00000462 B SO89 00000463 L0133 PZOEK F,IB,IA 00000464 / CMPVAL IA,0,(+,X'11',0,) 00000465 / BE SO82C 00000466 / SETVAL QUANT,0,(+,IA,0,+,X'600',0,) 00000467 / PINDON QUANT,0 00000468 *** DISTINGUISH D FOR D(X,-Y)=-D(X,Y) . DX FOR SPECIAL DUMMY */ 00000469 *** SEQUENCE . DS FOR COUNTING ARGS, SPECIAL FIRST ARG AND SPECIAL */ 00000470 *** DUMMY SEQUENCE . */ 00000471 /SO85 CMP000 IAL,0 00000472 / BNE SO85A 00000473 / CMPCAR NBIND,0,C')',1 00000474 BE SO107 CASE OF NO ARGUMENTS 00000475 /SO85A CMP111 IA,0 00000476 / BNE L0135 00000477 / SETVAL VLAG,0,(-,1,0,) FUNCTION D * 00000478 / B SO89 00000479 /L0135 CMPVAL IA,0,(+,X'E',0,) 00000480 / BE SO86 FUNCTION DX */ 00000481 / CMPVAL IA,0,(+,X'D',0,) 00000482 / BNE SO89 NOT FUNCTION DS */ 00000483 / SET111 DS1,0 00000484 *** CASE OF FUNCTION DS OR DX . INSERT NDUMY, D1, D2, ... */ 00000485 /SO86 SETVAL DSXI1,0,(-,1,0,) 00000486 / SETVAL QUANT,0,(+,X'700',0,+,NDUMY,0,) 00000487 / PINDON QUANT,0 00000488 SET000 J,0 00000489 L0136 CMPVAL J,0,(+,NDUMY,0,) 00000490 BNL LL030 00000491 SETVAL J,0,(+,J,0,+,1,0,) 00000492 PINDON J,0 QUANT=J+X'0' 00000493 B L0136 00000494 LL030 CMP000 DS1,0 00000495 / BH SO89 JP IF FUNCTION DX */ 00000496 *** CHECK FORMAT OF FIRST ARG OF DS FUNCTION. CREATE NEW DUMMY. * 00000497 *** NO MINUS SIGN ALLOWED */ 00000498 PSARAY1 D$NAME,SYMB1,NR 00000499 / CMP000 NR,0 00000500 BNE FOS29 FORMAT ERROR IN LAST LINE 00000501 PZOEK D,SYMB1,IA 00000502 / CMP000 IMINUS,0 00000503 BH FOS29 FORMAT ERROR IN LAST LINE 00000504 / PINDON X'7FF',0 00000505 *** NOT UNDERSTOOD ***********PERHAPS TERMINATOR OF DUMMIES 00000506 / CMPCAR NBIND,0,C')',1 00000507 BE FOS29 FORMAT ERROR IN LAST LINE 00000508 ** 00000509 *** START ANALYSIS OF NEXT FUNCTION ARGUMENT */ 00000510 /SO87 PLEZE1 00000511 CCALL FORWAR 00000512 SO89 CCALL ARG90 00000513 /SO105 PINDON QUANT,0 00000514 / CMPCAR NBIND,0,C',',1 00000515 / BNE L0147 00000516 / SETVAL DS1,0,(+,DS1,0,+,1,0,) 00000517 / B SO87 /* COUNT COMMAS FOR DS ARGUMENTS */ 00000518 /L0147 CMPCAR NBIND,0,C')',1 00000519 BNE FOS29 FORMAT ERROR IN LAST LINE 00000520 ** /* IMPOSSIBLE ERROR BECAUSE ACTION OF FORWAR * 00000521 / SET000 DSXI1,0 00000522 / CMP000 DS1,0 00000523 / BH SO107 JP IF NOT DS */ 00000524 / CMPVAL DS1,0,(+,4,0,) 00000525 / BE SO107 00000526 / CMPVAL DS1,0,(+,3,0,) 00000527 BNE FOS29 FORMAT ERROR IN LAST LINE 00000528 / PINDON X'501',0 00000529 ** /* PROVIDE EXPR. NR 1 = 1 AS FIFTH ARGUMENT OF DS FUNCTION * 00000530 /SO107 PINDON X'600',0 TERMINATE ARGUMENTS OF A FUNCTION */ 00000531 / PLEZE1 00000532 CMPCAR SYMB1$C,1,C'$',1 00000533 BE FOS13 STRANGE NOTATION. CASE OF F(X,Y)(A+B) 00000534 / SET111 EREXP1,1 FU**EXP NOT ALLOWED */ 00000535 / B BIND35 00000536 ** 00000537 TEX6 DC C'FUNCTION',C' NUMBER',C' VECTOR' 00000538 FOS6 LOAD 1,EREXP1,2 00000539 SLA 1,3 00000540 LA 2,TEX6-8 00000541 AR 1,2 00000542 MVC *+23(8),0(1) 00000543 ERRORP 4,' **EXP NOT ALLOWED' 00000544 FOS5 MVC *+44(5),SYMB1 00000545 ERRORP 4,' WHATS IN A NAME ' 00000546 FOS13 MVC F13+38(1),BBA 00000547 MVC F13+39(1),BBB 00000548 CLI BBB,X'77' CONDITION CODE MODIFIED 00000549 BNE F13 00000550 MVI F13+39,C'?' 00000551 F13 ERRORP 4,' STRANGE NOTATION. ' 00000552 FOS24 ERRORP 4,' ) OR = EXPECTED' 00000553 FOS26 MVC F26+32(1),NBIND 00000554 CLI NBIND,X'77' 00000555 BNE F26 00000556 MVI F26+32,C'?' 00000557 F26 ERRORP 4,' ILLEGAL ' 00000558 FOS29 ERRORP 4,' FORMAT ERROR IN LAST LINE' 00000559 FOS33 ERRORP 4,' WRONG DF ARGUMENT' 00000560 DROP 12 00000561 FFOUT 4,'INP-RHS' 00000562 LTORG 00000563 *** 00000564 ARG90 PRO 00000565 CMP000 IAL,0 00000566 / BNE SO89AB 00000567 / CMPCAR NBIND,0,C'*',1 00000568 BNE SO89AA 00000569 / PLEZE1 F(*) */ 00000570 / SETVAL QUANT,0,(+,X'200',0,) 00000571 B XARG90 00000572 /SO89AA CMPCAR NBIND,0,C'=',1 00000573 BNE SO89AB 00000574 / PLEZE1 F(=C) 00000575 / CMP111 IAL,0 00000576 BNE FOS35 ERROR IN FUNCTION ARGUMENT 00000577 LOAD 1,B,1 00000578 S 1,=X'000000F0' C'0' 00000579 ST 1,QUANT 00000580 ** /* SPECIAL BIAS * 00000581 *** NOT UNDERSTOOD *********** 00000582 / SETVAL QUANT,0,(+,QUANT,0,+,X'700',0,) 00000583 B XARG90 00000584 SO89AB CMPCAR B,1,C'$',1 00000585 / BNE SO89B 00000586 / CMP000 NDUMY,0 00000587 / BE SO89A F($776) */ 00000588 / CMP000 DSXI1,0 00000589 / BNE SO89A 00000590 / PINDON X'30F',0 KEY REQUEST. NOT FOR DS, DX */ 00000591 /SO89A CMP000 IMINUS,0 00000592 / BNH SO91 00000593 / SET000 IMINUS,0 00000594 / PINDON X'307',0 00000595 /SO89B CMP000 IMINUS,0 00000596 / BNH L0142 00000597 / SETVAL SO1,0,(-,1,0,) 00000598 B SO91 00000599 /L0142 SET000 SO1,0 00000600 SO91 PSARAY1 X$NAME,SYMB1,NR /* NECESSARY FOR F(A,CONJG(B)) */ 00000601 / CMP000 NR,0 00000602 / BNE SO93 OFTEN SYMB1.NAME = INTEG* BECAUSE OF FORWAR */ 00000603 / CMPCAR NBIND,0,C'(',1 00000604 / BNE SO93 /* F(P(..)..) IMPLIES P=VECTOR * 00000605 PCOVNR1 NR,CODE 00000606 ** /* NON NUMERICAL FUNCTIONS, ON WHICH FORWAR DID NOT ACT, * 00000607 ** /* COME HERE AND CRASH ON THEIR ARG NOT BEING AN INDEX * 00000608 / SETVAL QUANT,0,(+,CODE,0,+,NR,0,) 00000609 B SO99 00000610 /SO93 PSNAME1 NR,CODE 00000611 / SETVAL QUANT,0,(+,NR,0,+,CODE,0,) 00000612 CMPVAL NR,0,(+,CODE,0,) 00000613 / BNE SO99 00000614 PSARAY1 X$NAME,SYMB1,NR 00000615 / CMP000 NR,0 00000616 / BE SO97 00000617 / CMPVAL NR,0,(+,2,0,) 00000618 BNH SO93A 00000619 / SETVAL QUANT,0,(+,NR,0,+,X'500',0,) 00000620 / B SO101 00000621 /SO93A SETVAL QUANT,0,(+,X$CODE,NR,) F(CONJG...) OR F(INTEG...) */ 00000622 / CMP000 IMINUS,0 00000623 / BNH L0145 00000624 / SETVAL QUANT,0,(+,QUANT,0,+,1,0,) 00000625 ** /* INTEG IS 1412B. -INTEG=1413B. * 00000626 /L0145 SET000 IMINUS,0 00000627 / PINDON QUANT,0 00000628 / CMPCAR NBIND,0,C'*',1 00000629 / BE L0146 00000630 / CMPCAR NBIND,0,C'(',1 00000631 BNE FOS35 ERROR IN FUNCTION ARGUMENT 00000632 / SETVAL CREATBR,0,(-,1,0,) REQUESTS LEES TO CREATE (EXPR) * 00000633 /L0146 PLEZE1 00000634 / B SO89B 00000635 /SO97 PCOSYM1 NR,CODE 00000636 / SETVAL QUANT,0,(+,CODE,0,+,NR,0,) 00000637 /SO99 SET000 SO1,0 00000638 CMPVAL CODE,0,(,X'600',0,) 00000639 / BNE SO101 00000640 / SETVAL QUANT,0,(+,X'220',0,+,NR,0,) FU AS FUNCTION ARGUMENT 00000641 SO101 CMP000 IMINUS,0 00000642 BNH XARG90 00000643 / CMP000 VLAG,0 00000644 / BNH SO103 JP IF NOT FUNCTION D */ 00000645 LOAD 0,T$1COEFF,KTERM D(X,-Y)=-D(X,Y) 00000646 LCDR 0,0 IT(KTERM).COEFF=-IT(KTERM).COEFF 00000647 LCDR 2,2 00000648 STORE 0,T$1COEFF,KTERM 00000649 B XARG90 00000650 /SO103 PINDON MINUS,0 00000651 B XARG90 00000652 FOS35 ERRORP 5,' ERROR IN FUNCTION ARGUMENT' 00000653 ARG90 EPI 00000654 *** 00000655 STARTR PRO 00000656 / SETVAL NREP,0,(-,1,0,) 00000657 / CMP000 FITE2,0 00000658 BNE XSTARTR 00000659 / SET000 NTEM,0 CASE OF FIRST R CARD */ 00000660 / SET111 FITE2,0 ASSIGN BUFFER SPACE */ 00000661 CMPVAL NDIMT,0,(+,MBE,0,+,&BUFLEN,0,) 00000662 BL FOS11 NO SPACE FOR R BUFFER 00000663 / SETVAL MBE,0,(+,MBE,0,+,VECTS,0,) 00000664 / SETVAL ITTA1,0,(+,MBE,0,) ASSIGN BUFFER SPACE */ 00000665 / SET111 RIND1,0 3 CONTROL WORDS FOR TAKMAN */ 00000666 / SET111 VECIN1,0 00000667 / PTAKMAN NTAP6,DUMMM,DUMMM,REW0 00000668 B XSTARTR 00000669 FOS11 ERROR 5,' NO SPACE FOR R BUFFER' 00000670 STARTR EPI 00000671 *** 00000672 DS 0H 00000673 USING *,12 00000674 ENDR PLEZE1 READ OVER GENERATED DUMMY CARDS */ 00000675 / CMPCAR A,1,C' ',1 00000676 BE ENDR 00000677 CMPCAR A,1,X'77',1 00000678 BE ENDR 00000679 / SET111 VECIN1,0 00000680 / CMPCAR A,1,C'R',1 00000681 / BE MAINX1 00000682 / CMPCAR A,1,C'*',1 00000683 BNE FOS28 * YEP SHOULD FOLLOW R EXPRESSION 00000684 SET000 T$0WORD,MBE /* WRITE LAST BUFFER ON TAPE * 00000685 LADR 1,T$0NEXTW,MBE 00000686 ST 1,MBE END OF INFORMATION. 0,-1 . 00000687 SETVAL T$0WORD,MBE,(-,1,0,) 00000688 SETVAL START,0,(+,ITTA1,0,-,VECTS,0,) 00000689 SETVAL K2,0,(+,MBE,0,-,ITTA1,0,+,4,0,) 00000690 PTAKMAN NTAP6,START,K2,WRITE0 00000691 / PTAKMAN NTAP6,DUMMM,DUMMM,REW0 00000692 / SETVAL MBE,0,(+,START,0,) 00000693 / SET000 RIND1,0 00000694 / SET111 NREP,0 00000695 JUMP NBLANK1 00000696 MAINX1 JUMP MAIN 00000697 FOS28 ERROR 5,' * YEP SHOULD FOLLOW R EXPR' 00000698 DROP 12 00000699 *** 00000700 DS 0H 00000701 USING *,15 00000702 /STTERM SETVAL MBE5,0,(+,MBE,0,) ADDRESS CURRENT TERM */ 00000703 / SETVAL KTER5,0,(+,KTERM,0,) ADDRESS PREVIOUS TERM */ 00000704 / SETVAL KTERM,0,(+,MBE,0,) 00000705 LD 0,=D'1.0' IT(MBE).FLOAT=FLOAT(NTEKEN) 00000706 SDR 2,2 = +1 OR -1 00000707 C 0,NTEKEN 00000708 BNH LL004 00000709 LNDR 0,0 00000710 LL004 STORE 0,T$1COEFF,MBE 00000711 SET000 T$1POINT,MBE 00000712 SET000 T$1CODEA,-MBE-1- TERMINATOR FOR CASE OF 00000713 SET000 T$1CODEA,-MBE-2- NO FACTORS PRESENT 00000714 SET111 SHMEM1,0 00000715 / SETVAL FITE5,0,(+,FITE1,0,) 00000716 / SETVAL FITE1,0,(+,MBE,0,) 00000717 / CMP000 FITE5,0 00000718 BER 14 JP IF FIRST TERM 00000719 / CMP000 DATAFL1,0 00000720 / BE L0073 00000721 / SETVAL MBE5,0,(+,2,0,) CASE OF D EXPRESSION * 00000722 /L0073 SETVAL T$1POINT,KTER5,(+,MBE5,0,) LINK PREVIOUS TERM TO 00000723 BR 14 PRESENT TERM 00000724 DROP 15 00000725 *** 00000726 FULVECT PRO 00000727 SET000 T$0WORD,MBE 00000728 SETADR MBE,0,(+,T$0NEXTW,MBE,) 00000729 SET111 T$0WORD,MBE RECORD ENDS ON 0,1 00000730 SETVAL START,0,(+,ITTA1,0,-,VECTS,0,) 00000731 SETVAL K2,0,(+,MBE,0,-,ITTA1,0,+,4,0,) 00000732 PTAKMAN NTAP6,START,K2,WRITE0 00000733 *** DO J = 0 TO IT(LVEC1).POINT ; 00000734 *** IT(ITTA1+J) = IT(LVEC1 - 1+J) ; 00000735 *** /* COPY LAST VECTOR AND ITS PRECEDING ZERO */ 00000736 *** END ; /* TO BEGIN OF BUFFER */ 00000737 L 1,ITTA1 00000738 L 2,LVEC1 00000739 USING T$1,2 00000740 L 3,T$1POINT 00000741 DROP 2 00000742 ST 0,0(1) 00000743 LL021 MVC 4(256,1),0(2) 00000744 LA 1,256(1) 00000745 LA 2,256(2) 00000746 S 3,=F'256' 00000747 BH LL021 00000748 / SETVAL MBE,0,(+,ITTA1,0,+,T$1POINT,LVEC1,+,4,0,) 00000749 / SETVAL SHMEM1,0,(+,2,0,) 00000750 FULVECT EPI 00000751 *** 00000752 *** INSERT X, D EXPR, FILE OR DUMMY FUNCTION (K = 0). IN FORMAT 3012 */ 00000753 *** 1000 24** OR 3012 1000 00** */ 00000754 *** COUNT SUBSTITUTION LEVELS */ 00000755 *** IFILE: PROCEDURE(K, NR) ; 00000756 IFILE PRO 00000757 CR 1,0 00000758 / BE IFIL1 00000759 / CMPBIT X$PROP,NR,FILE,ON 00000760 BZ L0106 00000761 / SETVAL LEVL5,0,(+,LEVCL,0,+,1,0,) 00000762 / B L0107 00000763 /L0106 SETVAL LEVL5,0,(+,LEVCL,0,+,X$DEPTH,NR,) 00000764 L0107 SETMAX LEVCH,LEVL5 00000765 / SETVAL TUS1A,0,(+,NR,0,+,X'500',0,) 00000766 /IFIL1 PINDON X'60A',0 00000767 / PINDON X'200',0 00000768 PSARAY1 D$NAME,IB,NR 00000769 / CMP000 NR,0 00000770 / BE L0110 00000771 / SETVAL TUS1A,0,(+,NR,0,) 00000772 /L0110 SET000 IA,0 REQUIRED FOR ARG85. NO SPECIAL FUNCTION */ 00000773 / PINDON TUS1A,0 00000774 IFILE EPI 00000775 *** 00000776 *** REND PROCEDURE; END VECTOR OR SCALAR TERM IN R INPUT 00000777 REND PRO 00000778 PINDON 0,0 TERMINATE CURRENT WORD 00000779 /LL001 CMPVAL MBE,0,(+,KTERM,0,+,LTERM+CODEA,0,) 00000780 BNL FOS15 /* ILLEGAL R INPUT . TERM TOO LONG */ 00000781 / SETVAL T$1POINT,KTERM,(+,MBE,0,-,KTERM,0,) 00000782 *** IT(KTERM) . CODE (1) = MBE-KTERM-2+4000B ; 00000783 SETVAL K,0,(+,MBE,0,-,KTERM,0,-,CODEA,0,) LENG OF TERM 00000784 PUTLEN T$1CODEA,-KTERM-1-,K,0 00000785 CMP000 VECIN1,0,NE,L0074 00000786 / SETVAL NTEM,0,(+,NTEM,0,+,1,0,) 00000787 ** /* COUNT NUMBER OF TERMS */ 00000788 B XREND 00000789 *** IT(KTERM).CODE(2)=4000B+KKUIT; /* FILE NR */ 00000790 L0074 SETVAL K,0,(+,X'800',0,+,KKUIT,0,) 00000791 SETVAL T$1CODEA,-KTERM-2-,(+,K,0,) 00000792 B XREND 00000793 FOS15 ERRORP 5,' ILLEGAL R INPUT' 00000794 REND EPI 00000795 *** 00000796 *** REND3: PROCEDURE ; /* CONSTRUCT EMPTY SCALAR TAIL */ 00000797 DS 0H 00000798 USING *,15 00000799 REND3 L 1,MBE 00000800 MVC 0(LEMPTY,1),EMPTERM 00000801 SETVAL MBE,0,(+,MBE,0,+,LEMPTY,0,) 00000802 / SETVAL NTEM,0,(+,NTEM,0,+,1,0,) 00000803 / BR 14 00000804 DROP 15 00000805 *** 00000806 FFOUT 5,'FU-ARG90' 00000807 EMPTERM DC X'00000018',DL8'1.0',8X'00',X'08010000' 00000808 LEMPTY EQU *-EMPTERM 00000809 LTORG 00000810 END 00000811 ./A SCHRYF1,INCR=1 00000001 ./MACRO MAINMCRO 00000002 ./MACRO UITMACRO 00000003 TITLE 'SCHRYF1' 00000004 GBLC &OVLAY 00000005 LCLA &LENGTH$,&BEGIN$ 00000006 ./MACRO UITCOM 00000007 ./MACRO MAINCOM 00000008 *** 00000009 *** 00000010 PRINT NOGEN 00000011 SCHRYF1 CSECT 00000012 EQUIVAL 00000013 ENTRY SCHRYF,DORIS 00000014 EXTRN SCHUIF,TERMI,FEEDIN,MSTAT1,REFER,TAPEW,WRITE1,COSEA1 00000015 EXTRN CVTIN,LIJN,NUM1,TAKMAN,UNCF,INNAM,UPDAT 00000016 EXTRN NUMCV,NUMERH,DOMOV1,FOUT 00000017 USING UITCOM,10 00000018 USING BLANK,11 00000019 BSIZE1 EQU BUFLENG 00000020 /SCHRYF PRO PROLOGUE CDC IS SAVING AO REGISTER */ 00000021 / SET000 NORPR1,0 00000022 / CMP000 ISPLAY,0,NE,L0007 00000023 / SETVAL LLIM1,0,(+,110,0,) FIX LINE LENGTH */ 00000024 / B L0010 00000025 /L0007 SETVAL LLIM1,0,(+,65,0,) 00000026 /L0010 CCALL INNAM INVENT NAMES CREATED INDICES */ 00000027 /SYF8 SET000 TUS,0 00000028 / CMP000 NSUBS,0,NE,L0011 00000029 / SET000 JEERST,0 OUTP STORE IS EMPTY*/ 00000030 /L0011 CMPVAL NSPEC,0,(+,STARYEP,0,),EQ,JEP1 00000031 / CMPVAL NSPEC,0,(+,STAREND,0,),EQ,END1 00000032 / SETVAL NXEX,0,(+,MTAB,19,) 00000033 / CMPVAL NSPEC,0,(+,STARBEG,0,),NE,L0012 00000034 SETVAL II5,0,(+,MTAB,18,+,1,0,) 00000035 DOLOOP K,II5,NXEX,1,L0235,L0236 00000036 / SETBIT X$PROP,K,KEEP,OFF 00000037 ENDDO L0235,+1 00000038 L0236 DOLOOP K,1,N5PS,1,L0013,L0012 00000039 / SETBIT Z$PROP,K,KEEP,OFF 00000040 ** /* THIS BIT IS NOT USED FOR FILE ARGS */ 00000041 : ENDDO L0013,+1 00000042 L0012 PDOMOV1 DOVLAG$L,DOVLAG$B,C'/DO/ ' 00000043 PDOMOV1 BLOKPT$L,BLOKPT$B,C'BLOK/' 00000044 ** 00000045 *** DELETE ALL FILES WHICH ARE NOT COMMON, NOT KEEP, OR BEING * 00000046 *** REDEFINED IN THIS SECTION. NOTE IN TUS IF FILES HAVE TO BE * 00000047 *** DELETED ON TAPE ( FOR ROUTINE UPDAT). A KEEP FILE IS DELETED BY * 00000048 *** REMOVING IT FROM NXGEH. A COMMON FILE HAS ITS LOCNR IN NXGEH * 00000049 *** SET TO ZERO. * 00000050 / DOLOOP K,1,NXEX,1,L0015,L0016 00000051 STM 7,9,LOOPVAR1 00000052 / CMPBIT X$PROP,K,FILE,OFF,SYF12A KEEP X-EXPRS*/ 00000053 : CMPBIT X$PROP,K,KEEP,ON,L0008 00000054 : CMPBIT X$PROP,K,COMON,OFF,SYF12 THEN DELETE 00000055 ** /* CHECK IF FILE IS REDEFINED IN THIS SECTION. NEW Z-EXPRS */ 00000056 /L0008 DOLOOP J,1,N5PS,1,L0237,L0240 ARE IN FILN1 */ 00000057 / CMPNAM Z$NAME,J,X$NAME,K,NE,SYF11B 00000058 / CMPBIT X$PROP,K,NINDX,ON,SYF12 00000059 / CMPVAL Z$INDEX,J,(+,X$INDEX,K,),EQ,SYF12 00000060 /SYF11B ENDDO L0237,+1 00000061 /L0240 SETBIT X$PROP,K,STORE,OFF NON REDEFINED FILE */ 00000062 / SETBIT X$PROP,K,KEEP,OFF 00000063 / SETBIT X$PROP,K,PUNCH,OFF 00000064 / SETBIT X$PROP,K,PRINT,OFF 00000065 / B SYF12A 00000066 /SYF12 CMP000 X$LOCNR,K,EQ,L0243 DELETE FILE 00000067 SETVAL II5,0,(+,X$LOCNR,K,) 00000068 CMPBIT L$PROP,II5,TAPE,OFF,L0242 00000069 SET111 TUS,0 NOTE IF ON TAPE 00000070 /L0242 SET000 X$LOCNR,K 00000071 SET000 L$PROP,II5 00000072 SET000 L$ANAME,II5 00000073 SET000 L$LENGT,II5 00000074 SET000 L$BEGIN,II5 00000075 /L0243 CMPBIT X$PROP,K,COMON,ON,SYF12A 00000076 SETCAR X$NAME,K,X'0000000000',5 00000077 SET000 X$INDEX,K 00000078 SET000 X$LOCNR,K 00000079 SET000 X$PROP,K 00000080 SYF12A LM 7,9,LOOPVAR1 00000081 ENDDO L0015,+1 00000082 ** 00000083 *** DELETED FILES CREATE ZERO WORDS IN LOC AND NXGEH. GARBAGE */ 00000084 *** COLLECTION IN LOC AND NXGEH IS NOW DONE WHILE MODIFYING NXGEH */ 00000085 *** ACCORDINGLY. MBU AND NXEX ARE UPDATED. */ 00000086 /L0016 SETVAL KK,0,(+,MTAB,18,) 00000087 SETVAL II5,0,(+,MTAB,18,+,1,0,) 00000088 SETVAL IJ5,0,(+,MTAB,19,) 00000089 DOLOOP K,II5,IJ5,1,L0017,L0020 00000090 CMPCAR X$NAME,K,X'0000000000',5,EQ,SYF15 DELETED KEEP FILE 00000091 / CMP000 X$LOCNR,K,NE,L0245 00000092 / SET000 J,0 00000093 / B SYF14A 00000094 ** /* DELETED COMMON FILE * 00000095 L0245 SETVAL LOC5,0,(+,X$LOCNR,K,) 00000096 SETVAL L1,0,(+,L$AKEY,LOC5,) 00000097 SETVAL L2,0,(+,L$LENGT,LOC5,) 00000098 SETVAL L3,0,(+,L$BEGIN,LOC5,) 00000099 SETVAL L4,0,(+,L$PROP,LOC5,) 00000100 SET000 L$AKEY,LOC5 00000101 SET000 L$BEGIN,LOC5 00000102 SET000 L$LENGT,LOC5 00000103 SET000 L$PROP,LOC5 00000104 ** /* CREATE ZERO WORD, SYF14 WILL ALWAYS BE SUCCESFUL */ 00000105 / SET111 J,0 00000106 SYF14 CMP000 L$BEGIN,J,NE,L0248 00000107 CMP000 L$LENGT,J,NE,L0248 00000108 CMP000 L$AKEY,J,NE,L0248 00000109 CMP000 L$PROP,J,EQ,L0246 00000110 /L0248 SETVAL J,0,(+,J,0,+,1,0,) 00000111 / B SYF14 00000112 ** /* SEARCH ZERO WORD */ 00000113 L0246 SETVAL L$AKEY,J,(+,L1,0,) 00000114 SETVAL L$LENGT,J,(+,L2,0,) 00000115 SETVAL L$BEGIN,J,(+,L3,0,) 00000116 SETVAL L$PROP,J,(+,L4,0,) 00000117 /SYF14A SETVAL KK,0,(+,KK,0,+,1,0,) NXGEH IS REFILLED CONSECUTIVELY 00000118 SETNAM X$NAME,KK,X$NAME,K 00000119 SETVAL X$INDEX,KK,(+,X$INDEX,K,) 00000120 SETVAL X$PROP,KK,(+,X$PROP,K,) 00000121 / SETVAL X$LOCNR,KK,(+,J,0,) 00000122 /SYF15 ENDDO L0017,+1 00000123 ** 00000124 *** GARBAGE COLLECTION IN IT . KEEP FILES ARE MOVED DOWNWARDS AS */ 00000125 *** MUCH AS POSSIBLE. LOC IS CHANGED ACCORDINGLY. AT THE SAME TIME, */ 00000126 *** KEY ADDRESSES ARE REMOVED IN LOC. FILES ON TAPE ARE DELETED. */ 00000127 /L0020 SETVAL NXEX,0,(+,KK,0,) 00000128 / SETVAL K,0,(+,MTAB,10,-,1,0,) 00000129 SYF17 CMP000 L$BEGIN,K,NE,L0021 00000130 CMP000 L$LENGT,K,NE,L0021 00000131 CMP000 L$AKEY,K,NE,L0021 00000132 CMP000 L$PROP,K,NE,L0021 00000133 / SETVAL K,0,(+,K,0,-,1,0,) 00000134 / B SYF17 00000135 /L0021 SETVAL MBU,0,(+,K,0,+,1,0,) 00000136 / SETVAL LIM1,0,(+,MTAB,2,) UNDERLIMIT IN IT */ 00000137 / SETVAL LIM2,0,(+,NDIMU,0,) UPPERLIMIT IN IT OR INFINITE */ 00000138 SYF18 SETVAL II5,0,(+,MBU,0,-,1,0,) 00000139 DOLOOP K,1,II5,1,L0022,L0023 00000140 : CMPBIT L$PROP,K,FILE,OFF,L0247 00000141 CMPBIT L$PROP,K,TAPE,OFF,L0250 00000142 L0247 SET000 L$AKEY,K 00000143 / B SYF19 00000144 :L0250 CMP111 L$NUMB,K,EQ,SYF19 NUMERICAL FILE 00000145 / CMPVAL LIM1,0,(+,L$ANAME,K,),GT,SYF19 00000146 / CMPVAL L$ANAME,K,(+,LIM2,0,),GE,SYF19 00000147 / SETVAL LIM2,0,(+,L$ANAME,K,) 00000148 / SETVAL MIN5,0,(+,K,0,) 00000149 ** /* LOOK FOR FILE WITH LOWEST STARTING POINT IN IT * 00000150 /SYF19 ENDDO L0022,+1 00000151 /L0023 CMPVAL LIM2,0,(+,NDIMU,0,),EQ,SYF22 ALL FILES HAVE BEEN */ 00000152 ** /* DEALT WITH */ 00000153 / CMPVAL LIM1,0,(+,LIM2,0,),LT,SYF20 MOVE THIS FILE */ 00000154 / SETVAL LIM1,0,(+,L$BEGIN,MIN5,+,L$LENGT,MIN5,) 00000155 / SETVAL LIM2,0,(+,NDIMU,0,) THE PRESENT FILE IS AS LOW AS PO 00000156 / B SYF18 INITIALIZE FOR NEXT FILE */ 00000157 /SYF20 SETVAL LIM3,0,(+,LIM2,0,-,LIM1,0,) THE LOWEST FILE IS FOUND 00000158 / SETVAL BEGIN5,0,(+,L$BEGIN,MIN5,-,LIM3,0,) 00000159 / SETVAL ANAME5,0,(+,L$ANAME,MIN5,-,LIM3,0,) 00000160 / SETVAL L$BEGIN,MIN5,(+,BEGIN5,0,) 00000161 / SETVAL L$ANAME,MIN5,(+,ANAME5,0,) 00000162 SETVAL II5,0,(+,BEGIN5,0,+,L$LENGT,MIN5,) 00000163 : DOLOOP K,ANAME5,II5,NEXTW,L0024,L0025 00000164 SETVAL IJ5,0,(+,K,0,+,LIM3,0,) 00000165 : SETVAL T$0WORD,K,(+,T$0WORD,IJ5,) COPY FILE TO LOWER IT 00000166 / ENDDO L0024,+1 00000167 /L0025 SETVAL LIM1,0,(+,BEGIN5,0,+,L$LENGT,MIN5,) 00000168 / SETVAL LIM2,0,(+,NDIMU,0,) 00000169 / B SYF18 00000170 /SYF22 SETVAL MBE,0,(+,LIM1,0,) ALL DONE */ 00000171 / SETVAL MTAB,3,(+,LIM1,0,) 00000172 / CMP000 TUS,0,EQ,L0026 00000173 / CCALL UPDAT DELETE FILES ON TAPE */ 00000174 ** /* IF NECESSARY */ 00000175 ** 00000176 *** TRANSFER OF KEEP FILE. REFER CONSTRUCT ITS NAMELIST. TAPEW COPIES * 00000177 *** THE FILE FROM OUTPUT ARRAY TO INPUT ARRAY. LOC, NXGEH ARE */ 00000178 *** ADAPTED ACCORDINGLY */ 00000179 /L0026 SET000 NINX,0 NOTE IF ANY FILE TO KEEP */ 00000180 / DOLOOP K,1,N5PS,1,L0027,L0030 00000181 CMPBIT Z$PROP,K,KEEP,OFF,L0028 00000182 SET111 NINX,0 00000183 /L0028 ENDDO L0027,+1 00000184 /L0030 CCALL TERMI MOVE CONTENT OUTPUT STORE UPWARDS TO */ 00000185 ** /* MAKE PLACE IN INPUT STORE FOR KEEPFILES */ 00000186 / SETVAL NURI$ADR,0,(+,JEERST,0,) 00000187 / CCALL DORIS PRINT ALL FILES IN THE OUTPUT STORE * 00000188 *** CONSIDER EACH FILE SEPARATELY FOR ITS STORING IN CORE OR ON TAPE */ 00000189 SET000 FNR,0 00000190 SYF33 SETVAL FNR,0,(+,FNR,0,+,1,0,) 00000191 CMPVAL N5PS,0,(+,FNR,0,),LT,SYF40 00000192 / CMPBIT Z$PROP,FNR,FILE,OFF,SYF33 00000193 ** /* CASE OF FILE ARGUMENT * 00000194 / SETVAL NURI$FIL,0,(+,VECTNR0,0,+,FNR,0,) 00000195 : CMPBIT Z$PROP,FNR,COMON,ON,SYF34 00000196 : CMPBIT Z$PROP,FNR,KEEP,ON,SYF34 00000197 B SYF33 00000198 SYF34 CCALL MSTAT1 FLAG INVESTIG FILESIZE AND CALLS FEEDIN, 00000199 ** /* DORIS WHEN END OF OUTPUT STORE */ 00000200 / CMP111 FLAG,0,EQ,SYF33 JP IF NUMERICAL FILE */ 00000201 / CMP000 FLAG,0,LT,SYF35 JP IF FILE DOES NOT FIT IN MEMORY 00000202 / CMPBIT Z$PROP,FNR,COMON,ON,SYF35 GO TO WRITE ON TAPE */ 00000203 / PREFER MBE,NWOR2 CONSTRUCT NAMELIST IN IT */ 00000204 / SETVAL L$ANAME,MBU,(+,MBE,0,) CASE OF SMALL KEEP FILES */ 00000205 / SETVAL MBE,0,(+,MBE,0,+,NWOR2,0,) 00000206 / SETVAL L$BEGIN,MBU,(+,MBE,0,) 00000207 / SETBIT L$PROP,MBU,FILE,ON 00000208 / SETVAL NXEX,0,(+,NXEX,0,+,1,0,) 00000209 SETNAM X$NAME,NXEX,Z$NAME,FNR 00000210 / SETVAL X$INDEX,NXEX,(+,Z$INDEX,FNR,) 00000211 / SETVAL X$PROP,NXEX,(+,Z$PROP,FNR,) 00000212 / SETBIT X$PROP,NXEX,STORE,OFF 00000213 / SETBIT X$PROP,NXEX,KEEP,OFF 00000214 / SETBIT X$PROP,NXEX,PUNCH,OFF 00000215 / SETBIT X$PROP,NXEX,PRINT,OFF 00000216 / SETVAL X$LOCNR,NXEX,(+,MBU,0,) 00000217 SETVAL START,0,(+,MBE,0,) 00000218 SETVAL BUFLIMIT,0,(+,NDIMT,0,-,MBE,0,) 00000219 : PTAPEW NTAP7,START,BUFLIMIT,NWOR2,NRECO2,END5 00000220 ** /* BUFFERLENGTH=ALL AVAILABLE SPACE. FILE MUST FIT. */ 00000221 ** /* NO RECORDS MUST BE WRITTEN. */ 00000222 / CMP000 NRECO2,0,NE,MFO2 00000223 / SETVAL L$LENGT,MBU,(+,NWOR2,0,) 00000224 / SETVAL MBU,0,(+,MBU,0,+,1,0,) 00000225 / SETVAL MBE,0,(+,MBE,0,+,NWOR2,0,) 00000226 / B SYF33 00000227 ** 00000228 *** COMMON FILES AND BIG KEEP FILES ARE WRITTEN ON TAPE */ 00000229 SYF35 PTAKMAN NTAP7,DUMMM,TUS3,REQST0 00000230 ** /* REQUEST RECORD NUMBER IN TUS3 FOR LOC */ 00000231 SETADR START,0,(+,CBUF1,1,+,VECTS,0,) 3 W FOR TAKMAN 00000232 / PREFER START,NWOR2 CONSTRUCT NAMELIST */ 00000233 / PTAKMAN NTAP7,CBUF1,NWOR2,WRITE0 00000234 / SET111 TUS2,0 00000235 SYF36 SETADR START,0,(+,CBUF1,1,+,VECTS,0,) 3 W FOR TAKMAN 00000236 / PTAPEW NTAP7,START,BSIZE1,NWOR2,NRECO2,END5 00000237 CMP000 NRECO2,0,NE,SYF37 00000238 PTAKMAN NTAP7,CBUF1,NWOR2,WRITE0 00000239 / SET111 NRECO2,0 00000240 /SYF37 SETVAL TUS2,0,(+,TUS2,0,+,NRECO2,0,) COUNTS RECORDS ON TAPE 00000241 / CMP000 END5,0,NE,SYF38 END OF THAT FILE*/ 00000242 / CCALL FEEDIN 00000243 / CCALL DORIS 00000244 / SETVAL NXEX,0,(-,NXEX,0,) SIGN OF NXEX IS FLAG FOR MSTAT1 * 00000245 CCALL MSTAT1 FLAG INVESTIG FILESIZE AND CALLS FEEDIN, 00000246 ** /* DORIS WHEN END OF OUTPUT STORE */ 00000247 / SETVAL NXEX,0,(-,NXEX,0,) 00000248 / B SYF36 00000249 ** 00000250 *** KEEP FILES THAT ARE REDEFINED IN THIS SECTION AND NEW OR */ 00000251 *** REDEFINED COMMON FILES BECOME ASSOCIATED TO THEIR ALREADY */ 00000252 *** EXISTING ENTRY IN NXGEH . A LOC ENTRY IS CREATED FOR THEM */ 00000253 *** AS WELL */ 00000254 /SYF38 PCOSEA1 K,J 00000255 ** /* K IS POINTER IN FILN1, GIVEN BY NURI */ 00000256 ** /* J IS POINTER IN NXGEH SUCH THAT 2 00000257 ** /* CORRESPONDING FILES HAVE THE SAME NAME. * 00000258 / SETVAL LOC5,0,(+,X$LOCNR,J,) 00000259 / CMP000 LOC5,0,NE,L0033 00000260 / SETVAL LOC5,0,(+,MBU,0,) 00000261 SET000 L$AKEY,LOC5 00000262 SET000 L$PROP,LOC5 00000263 / SETVAL MBU,0,(+,MBU,0,+,1,0,) 00000264 /L0033 SETBIT L$PROP,LOC5,FILE,ON 00000265 / SETBIT L$PROP,LOC5,TAPE,ON 00000266 CMPBIT Z$PROP,K,COMON,ON,LL004 00000267 SETBIT L$PROP,LOC5,COMON,OFF 00000268 B LL005 00000269 LL004 SETBIT L$PROP,LOC5,COMON,ON 00000270 /LL005 SETVAL L$RCTOT,LOC5,(+,TUS2,0,) 00000271 / SETVAL L$RCNAM,LOC5,(+,TUS3,0,) 00000272 SETNAM X$NAME,J,Z$NAME,K 00000273 SETVAL X$INDEX,J,(+,Z$INDEX,K,) 00000274 SETVAL X$PROP,J,(+,Z$PROP,K,) 00000275 / SETVAL X$LOCNR,J,(+,LOC5,0,) OTHER PROPS EXIST ALREADY*/ 00000276 / SETBIT X$PROP,J,STORE,OFF 00000277 / SETBIT X$PROP,J,KEEP,OFF 00000278 / SETBIT X$PROP,J,PUNCH,OFF 00000279 / SETBIT X$PROP,J,PRINT,OFF 00000280 / B SYF33 00000281 ** 00000282 /SYF40 SETVAL MTAB,3,(+,MBE,0,) 00000283 / SETVAL MTAB,5,(+,MBE,0,) 00000284 / SETVAL MTAB,10,(+,MBU,0,) 00000285 / SETVAL MTAB,11,(+,MBU,0,) 00000286 / SETVAL MTAB,19,(+,NXEX,0,) 00000287 /SYF41 CMP000 NSUM,0,EQ,SYF42 00000288 / CCALL FEEDIN 00000289 / CCALL DORIS 00000290 / B SYF41 00000291 SYF42 SETVAL NDIMT5,0,(+,MTAB,7,+,MBE,0,-,MTAB,2,) 00000292 CMPVAL NDIMT,0,(+,NDIMT5,0,),LT,XSCHRYF 00000293 / SETVAL NDIMT,0,(+,NDIMT5,0,) 00000294 B XSCHRYF 00000295 ** 00000296 *** CASE OF * YEP */ 00000297 /JEP1 CCALL TERMI 00000298 / SETVAL DCONT1,3,(+,NCONT,1,+,NCONT,2,+,NCONT,4,) 00000299 ** /* CHECK IF PUNCH, PRINT OR STORE REQUIRED. * 00000300 /JEP2 CMP000 DCONT1,3,EQ,L0035 00000301 / CCALL DORIS 00000302 L0035 SETADR START,0,(+,IT23,1,+,VECTS,0,) 3 W FOR TAKMAN 00000303 / PTAPEW NTAP6,START,BSIZE1,NWOR2,NRECO2,END5 00000304 / CMP000 END5,0,NE,XSCHRYF 00000305 / CCALL FEEDIN 00000306 / B JEP2 00000307 ** 00000308 *** CASE OF * END */ 00000309 /END1 CCALL TERMI INITIALIZE */ 00000310 /END2 CCALL DORIS 00000311 / CMP000 NSUM,0,EQ,XSCHRYF 00000312 / CCALL FEEDIN 00000313 / B END2 00000314 MFO2 ERROR 1,' KEEPFILE DOES NOT FIT IN STORE' 00000315 SCHRYF EPI 00000316 FFOUT 1,'SCHRYF' 00000317 LTORG 00000318 ** 00000319 *** 00000320 *** 00000321 *** PRINT CONTENT OF THE OUTPUT STORE */ 00000322 *** CONSTRUCT PRINTLINES IN ARRAY BC1 */ 00000323 /DORIS PRO 00000324 / CMP000 N5PS,0,EQ,XDORIS NO Z EXPRS */ 00000325 / SET000 IERIC,0 00000326 / CCALL S1NEWL PRINT BLANK LINE.RETURN WITH IERIC=5*/ 00000327 / SET000 NFIRST,0 00000328 / SET000 BRAKOP,0 00000329 / SET000 BRAKCL,0 00000330 / SETVAL NREM,0,(+,JEERST,0,) 00000331 *** NEW VECTOR IS STARTED */ 00000332 /S1NEWV CMP000 BRAKCL,0,EQ,S3IKW 00000333 / SET000 BRAKCL,0 00000334 / PINZET1 C' )' 00000335 ** /* TERMINATE ALGEBRA */ 00000336 :S3IKW CMP000 NSUM,0,NE,L0038 00000337 CMP000 NREM,0,EQ,ARL1 00000338 /L0038 CMP000 NREM,0,EQ,ARL5 00000339 / CMPVAL NORPR1,0,(+,-T$2CODEV-NR-,-NREM-2-,),EQ,ARL4 00000340 ** /* FILE NUMBER */ 00000341 ARL1 SETVAL II5,0,(+,NORPR1,0,+,1,0,) 00000342 DOLOOP J,II5,N5PS,1,L0037,ARL5 FIND BEGIN OF NEXT Z-EXPR 00000343 / CMPBIT Z$PROP,J,FILE,ON,ARL1A SKIP ARGS*/ 00000344 / ENDDO L0037,+1 00000345 /ARL5 PINZET1 C' ' 00000346 / B AR1 GO TO END */ 00000347 /ARL1A SETVAL NORPR1,0,(+,J,0,) START NEXT Z EXPR */ 00000348 / CCALL S1NEWL 00000349 / CCALL S1NEWL 00000350 CCALL ARGL1 NORPR1,FLAG PRINT ARGUMENT LIST AND 00000351 ** /* SET PRINT CONTROL WORDS */ 00000352 / CMP000 FLAG,0,NE,ARL2B SKIP A FILE WHICH DOES */ 00000353 ** /* NOT REQUIRE PRINTING */ 00000354 /ARL2C CMP000 NREM,0,EQ,XDORIS 00000355 / CMPVAL NORPR1,0,(+,-T$2CODEV-NR-,-NREM-2-,),NE,S1NEWV 00000356 ** /* JP WHEN END OF THE FILE */ 00000357 / SETVAL NREM,0,(+,T$2VECTN,NREM,) 00000358 / B ARL2C 00000359 /ARL2B CMP000 NREM,0,EQ,ARL2A 00000360 / CMPVAL NORPR1,0,(+,-T$2CODEV-NR-,-NREM-2-,),EQ,ARL6 00000361 ARL3 PINZET1 C'0.' EMPTY FILE 00000362 B S3IKW 00000363 /ARL4 CCALL S1NEWL 00000364 / B ARL8 00000365 /ARL2A CMP000 NSUM,0,EQ,ARL3 00000366 / CCALL S1NEWL 00000367 /AR1 CMP000 NRECOR,0,NE,L0041 00000368 / PINZET1 C' +0.' 00000369 /L0041 CCALL S1NEWL 00000370 / CMP000 NRECOR,0,NE,L0042 00000371 / SETVAL IREG,0,(+,4,0,) FORCE PUNCHING OF LAST CARD */ 00000372 /L0042 CCALL S1NEWL 00000373 B XDORIS 00000374 :ARL6 CMPVAL VOLUM,NORPR1,(+,3*CODEA+3*CODEV+3*LFLOAT,0,),GE,ARL8 00000375 *** LENGTH OF A SHORT FILE. FAIRLY ARBITRARY NUMBER. 00000376 CMPVAL IERIC,0,(+,50,0,),LT,ARL7 00000377 /ARL8 CCALL S1NEWL PUT FILE + ARGS (LENGTH=IERIC) */ 00000378 ** /* AND RESULT (LENGTH = VOLUM) ON ONE LINE IF POSSIBLE */ 00000379 /ARL7 CMP000 NREM,0,EQ,AR1 JP IF ALL DONE */ 00000380 *** PRINT PART OUTSIDE BRACKETS */ 00000381 GETLEN NPA,0,T$2CODEV,-NREM-1- LENGTH OF VECTOR PART 00000382 L 1,NPA 00000383 SRA 1,1 00000384 ST 1,NPA NR OF CODES 00000385 / SETVAL NFOL,0,(+,T$2ALGEN,NREM,) 00000386 CMPVAL NPA,0,(+,2,0,),GT,L0043 00000387 / SETVAL NREM,0,(+,T$2VECTN,NREM,) 00000388 / SET000 BRAKOP,0 00000389 / B S1A 00000390 ** /* NO VECTOR PART PRESENT * 00000391 /L0043 SET111 BRAKOP,0 00000392 / CMPVAL IREG,0,(+,3,0,),EQ,L0044 00000393 / SETVAL IREG,0,(+,4,0,) 00000394 /L0044 CMP000 T$1POINT,NFOL,NE,S35YW2 SEVERAL ALGEBRS*/ 00000395 : CMP000 T$1CODEA,-NFOL-2-,NE,S35YW2 00000396 / SETVAL BDOUB,0,(+,T$1COEFF,NFOL,) A NUMBER ON ITS OWN AS AL 00000397 / SETVAL IND,0,(+,2,0,) ADD + OR - IN FRONT */ 00000398 / CCALL S1NUMB 00000399 SET111 NFIRST,0 00000400 *** IF ABS(IT(NFOL).COEFF) EQ 1 WITHIN 2**-46 THEN DO NOT PRINT 00000401 *** CAN THIS NOT BE TESTED WITH FLAG,VALUE OF S1NUMB ... 00000402 ** LOAD 0,T$1COEFF,NFOL 00000403 ** LD 4,=D'1.0' 00000404 ** SDR 6,6 00000405 ** LNDR 0,0 00000406 ** LNDR 2,2 00000407 ** PLUS 00000408 ** LPER 0,0 00000409 ** SE 0,=X'35400000' 2**-46 00000410 ** BNL L0047 00000411 CMPVAL FLAG,0,(-,1,0,),NE,L0047 NOT AN INTEGER 00000412 CMP111 VALUE,0,NE,L0047 NOT 1.0 00000413 / SET000 NFIRST,0 DO NOT PRINT*/ 00000414 / SETVAL IERIC,0,(+,IERIC,0,-,2,0,) +1 -1 */ 00000415 /L0047 SET000 NFOL,0 00000416 / SET000 BRAKOP,0 00000417 / B S3BC 00000418 /S35YW2 PINZET1 C'+ ' 00000419 / SET000 NFIRST,0 00000420 /S3BC SETVAL A0,0,(+,NREM,0,) STARTING POINT FOR TRANSL1 */ 00000421 / SETVAL NREM,0,(+,T$2VECTN,NREM,) 00000422 / CMP000 NPA,0,EQ,S1A 00000423 / SETVAL LLIM5,0,(+,LLIM1,0,) 00000424 SET000 FLAG,0 00000425 / SETVAL K,0,(+,3,0,) 00000426 /S1BE CMPVAL IERIC,0,(+,LLIM5,0,),LE,L0050 00000427 / CCALL S3NEWL PRINT QUANTITY */ 00000428 L0050 CCALL TRANSL1 K,SYMBOL,CODE,FLAG 00000429 CMP111 FLAG,0,EQ,S1A 00000430 / CMP000 NFIRST,0,NE,L0051 00000431 / SET111 NFIRST,0 00000432 / B S2BEA 00000433 /L0051 CMPVAL CODE,0,(+,CONJG2,0,),EQ,S2BEA 00000434 / PINZET1 C'*' 00000435 /S2BEA PINZET1 SYMBOL 00000436 / CMPVAL -CODE-TYPE-,0,(+,VECTOR,0,),NE,L0053 00000437 / PINZET1 C'(' 00000438 CCALL TRANSL1 K,SYMBOL,CODE,FLAG 00000439 CMP111 FLAG,0,EQ,S1A 00000440 / PINZET1 SYMBOL 00000441 / PINZET1 C')' 00000442 / B S1BE 00000443 /L0053 CMPVAL -CODE-TYPE-,0,(+,OPERAT,0,),NE,L0054 00000444 / CMPVAL CODE,0,(+,CONJG1,0,),NE,S1BE 00000445 / SET000 NFIRST,0 00000446 / B S1BE 00000447 /L0054 CMPVAL -CODE-TYPE-,0,(+,FUNCT,0,),EQ,S2FU7 00000448 CCALL TRANSL1 K,SYMBOL,CODE,FLAG PRINT EXPONENT 00000449 CMP111 FLAG,0,EQ,S1A 00000450 / CMP000 RESULFX,0,GE,L0055 00000451 / PINZET1 C'**(' 00000452 / PINZET1 SYMBOL 00000453 / PINZET1 C')' 00000454 / B S1BE 00000455 /L0055 CMP111 RESULFX,0,EQ,S1BE DO NOT WRITE **1 */ 00000456 / PINZET1 C'**' 00000457 / PINZET1 SYMBOL 00000458 / B S1BE 00000459 /S2FU7 PINZET1 C'(' PRINT FU ARGS */ 00000460 / SETVAL LLIM5,0,(+,LLIM1,0,) 00000461 / CMPVAL CODE,0,(+,DF,0,),NE,BU5KE 00000462 / DOLOOP J,1,5,1,L0056,L0057 RECONSTRUCT FROZEN FILE NAME */ 00000463 SETVAL SYMBOL$C,J,(+,-T$2CODEV-NR-,-A0-K-,) 00000464 / SETVAL K,0,(+,K,0,+,1,0,) 00000465 / ENDDO L0056,+1 00000466 L0057 SETCAR SYMBOL$C,6,X'00',1 TERMINATOR 00000467 PINZET1 SYMBOL 00000468 / DOLOOP J,1,2,1,L0060,L0061 RECONSTRUCT INDEX < 4096 */ 00000469 SETVAL VALUE$C,J,(+,-T$2CODEV-NR-,-A0-K-,) 00000470 / SETVAL K,0,(+,K,0,+,1,0,) 00000471 / ENDDO L0060,+1 00000472 L0061 L 1,VALUE 00000473 SRL 1,16 RIGHT ADJUST 00000474 ST 1,VALUE 00000475 PNUTRA0 SYMBOL,VALUE CONVERT WITHOUT SIGN 00000476 CMPVAL K,0,(+,NPA,0,),GT,S1A 00000477 / PINZET1 C',' 00000478 / B DFF2A 00000479 BU5KE CCALL TRANSL1 K,SYMBOL,CODE,FLAG FUNCT ARGUMENTS 00000480 CMP111 FLAG,0,EQ,S1A 00000481 /DFF2A CMPVAL CODE,0,(+,FUNCT0,0,),NE,S3FU7 00000482 SETVAL II5,0,(+,IERIC,0,-,1,0,) 00000483 CMPCAR BC1,II5,C'(',1,NE,L0062 00000484 / SETVAL IERIC,0,(+,IERIC,0,-,1,0,) 00000485 / B L0063 00000486 L0062 SETVAL II5,0,(+,IERIC,0,-,1,0,) WITH ARGS 00000487 SETCAR BC1,II5,C')',1 00000488 ** /* TERMINATE FU WITHOUT ARGS */ 00000489 /L0063 SETVAL LLIM5,0,(+,LLIM1,0,-,20,0,) OVERWRITE SEPARATING COM 00000490 / B S1BE 00000491 S3FU7 PINZET1 SYMBOL 00000492 / CMPVAL LLIM5,0,(+,IERIC,0,),GE,L0065 00000493 / CCALL S1NEWL 00000494 /L0065 CMPVAL -CODE-TYPE-,0,(+,OPERAT,0,),EQ,BU5KE 00000495 / PINZET1 C',' 00000496 / B BU5KE 00000497 *** NEW ALGEBRA IS STARTED */ 00000498 /S1A CMP000 NFOL,0,EQ,S1NEWV 00000499 / SETVAL BDOUB,0,(+,T$1COEFF,NFOL,) 00000500 SETVAL IND,0,(+,2,0,) 00000501 / CMP000 BRAKOP,0,EQ,L0066 00000502 / SET000 BRAKOP,0 00000503 / CCALL S1NEWL 00000504 / PINZET1 C'* (' 00000505 / SET111 BRAKCL,0 00000506 *** IND=1-SIGN(BDOUB) =0 OR 2 00000507 L 1,BDOUB 00000508 SRL 1,31 00000509 SLL 1,1 00000510 ST 1,IND 00000511 ** /*+ SUPPRES IN CASE OF FU*(ALG) */ 00000512 /L0066 CMPVAL LLIM1,0,(+,IERIC,0,),GE,L0067 00000513 / CCALL S1NEWL 00000514 /L0067 CMP000 T$1CODEA,-NFOL-2-,NE,L0070 00000515 / SET000 NPA,0 00000516 / B L0071 00000517 /L0070 GETLEN NPA,0,T$1CODEA,-NFOL-1- LENGTH OF ALGEBRA PART 00000518 L 1,NPA 00000519 SRA 1,1 00000520 ST 1,NPA NR OF CODES 00000521 /L0071 SET111 NFIRST,0 00000522 / SETVAL A0,0,(+,NFOL,0,) 00000523 / SETVAL NFOL,0,(+,T$1POINT,NFOL,) 00000524 / PINZET1 C' ' 00000525 / CCALL S1NUMB 00000526 *** IF ABS(IT(A0).COEFF) EQ 1 WITHIN 2**-46 THEN DO NOT PRINT 00000527 *** CAN THIS NOT BE TESTED WITH FLAG,VALUE OF S1NUMB ... 00000528 ** LOAD 0,T$1COEFF,A0 00000529 ** LD 4,=D'1.0' 00000530 ** SDR 6,6 00000531 ** LNDR 0,0 00000532 ** LNDR 2,2 00000533 ** PLUS 00000534 ** LPER 0,0 00000535 ** SE 0,=X'35400000' 2**-46 00000536 ** BH S2VE2S 00000537 CMPVAL FLAG,0,(-,1,0,),NE,S2VE2S NOT AN INTEGER 00000538 CMP111 VALUE,0,NE,S2VE2S NOT 1.0 00000539 / CMP000 NPA,0,EQ,S2VE2S 00000540 / SET000 NFIRST,0 CASE OF VECT*(3*A+B) */ 00000541 / SETVAL IERIC,0,(+,IERIC,0,-,2,0,) ERASE +1,-1 */ 00000542 /S2VE2S CMP000 NPA,0,EQ,S1A 00000543 / SETVAL LLIM5,0,(+,LLIM1,0,) 00000544 / SETVAL K,0,(+,2,0,) 00000545 SET000 FLAG,0 00000546 SETVAL A0,0,(+,A0,0,+,CODEA,0,-,CODEV,0,) 00000547 *** FAKE A VECTOR FOR TRANSL1. SO T$2CODEV CAN ALWAYS BE USED 00000548 / B S1BE 00000549 /DORIS EPI 00000550 ** 00000551 /TRANSL1 PRO K SYMBOL CODE,FLAG 00000552 *** WORKS AS WELL FOR VECTOR AS ALGEBRA. CODEV IS ALWAYS USED. 00000553 *** A0=A0+CODEA-CODEV WAS SET FOR ALGEBRAS BEFORE ENTERING. 00000554 CMPVAL K,0,(+,NPA,0,),GT,EXIT1 00000555 SETVAL CODE,0,(+,T$2CODEV,-A0-K-,) 00000556 / SETVAL K,0,(+,K,0,+,1,0,) 00000557 / CMP000 CODE,0,EQ,EXIT1 00000558 SETCAR SYMBOL$C,6,X'00',1 TERMINATOR FOR NAME 00000559 SETVAL II5,0,(+,-CODE-NR-,0,) 00000560 / CMPVAL -CODE-TYPE-,0,(+,DUMMY,0,),EQ,FOSY1 00000561 ** /* UNKNOWN ERROR IN SCHRYF */ 00000562 / CMPVAL -CODE-TYPE-,0,(+,INDEX,0,),NE,L0112 00000563 SETNAM SYMBOL,0,I$NAME,II5 00000564 B XTRANSL1 00000565 /L0112 CMPVAL -CODE-TYPE-,0,(+,VECTOR,0,),NE,L0113 00000566 / CMPVAL CODE,0,(+,ARGFU0,0,),GE,L0252 00000567 SETNAM SYMBOL,0,V$NAME,II5 00000568 B XTRANSL1 00000569 L0252 SETNAM SYMBOL,0,F$NAME,II5 00000570 / SETVAL -CODE-TYPE-,0,(+,FUNCT,0,) 00000571 B XTRANSL1 00000572 /L0113 CMPVAL -CODE-TYPE-,0,(+,OPERAT,0,),NE,L0114 00000573 LADR 1,KOHER,II5 00000574 MVC SYMBOL(8),0(1) 00000575 B XTRANSL1 00000576 /L0114 CMPVAL -CODE-TYPE-,0,(+,ALGEBR,0,),NE,L0115 00000577 SETNAM SYMBOL,0,S$NAME,II5 00000578 B XTRANSL1 00000579 /L0115 CMPVAL -CODE-TYPE-,0,(+,EXPRES,0,),EQ,T1EXPR 00000580 / CMPVAL -CODE-TYPE-,0,(+,FUNCT,0,),NE,L0116 00000581 SETNAM SYMBOL,0,F$NAME,II5 00000582 B XTRANSL1 00000583 /L0116 CMPVAL -CODE-TYPE-,0,(+,NUMBER,0,),EQ,T1NUMB 00000584 / CMPVAL -CODE-TYPE-,0,(+,DOTPR,0,),GE,T1DOPR 00000585 / CMPVAL -CODE-TYPE-,0,(+,VECTNR,0,),GE,T1VENR 00000586 T1NUMB SGNEXT RESULFX,0,II5,0 00000587 : PNUTRA0 SYMBOL,RESULFX 00000588 B XTRANSL1 00000589 :T1EXPR PNUTRA0 NAME5,II5 00000590 SET111 IAL,0 00000591 / PINZET2 C'$' 00000592 / PINZET2 NAME5 00000593 B XTRANSL1 00000594 T1VENR LOAD 1,-CODE-VECT1-,0 00000595 CR 1,6 IF CODE5.VECT1 LE 1 THEN GOTO TRA2N 00000596 BNH FOSY1 00000597 *** MODIFICATION OF CDC TO FIND USE OF 4000,4040 ... 00000598 ** /* 4000 AND 4040 ARE ALLOWED,BUT NOT PRINTED. */ 00000599 ** /* NOT UNDERSTOOD... */ 00000600 STORE 1,II5,0 00000601 SETNAM NAME5,0,V$NAME,II5 00000602 / SET111 IAL,0 00000603 / PINZET2 NAME5 00000604 / PINZET2 C'(' 00000605 SETVAL II5,0,(+,-CODE-VECT2-,0,) 00000606 : PNUTRA0 NAME5,II5 00000607 / PINZET2 NAME5 00000608 / PINZET2 C')' 00000609 B XTRANSL1 00000610 T1DOPR SETVAL II5,0,(+,-CODE-VECT1-,0,) 00000611 SETNAM NAME5,0,V$NAME,II5 00000612 / SET111 IAL,0 00000613 / PINZET2 NAME5 00000614 / PINZET2 C'D' 00000615 SETVAL II5,0,(+,-CODE-VECT2-,0,) 00000616 SETNAM NAME5,0,V$NAME,II5 00000617 / PINZET2 NAME5 00000618 B XTRANSL1 00000619 EXIT1 SET111 FLAG,0 00000620 B XTRANSL1 00000621 *** INZET2 PRO NAME5 00000622 /INZET2 DOLOOP J,1,5,1,L0123,L0124 00000623 / CMPCAR NAME5$C,J,X'00',1,EQ,L0124 00000624 / SETVAL SYMBOL$C,IAL,(+,NAME5$C,J,) 00000625 / SETVAL IAL,0,(+,IAL,0,+,1,0,) 00000626 / ENDDO L0123,+1 00000627 L0124 SETCAR SYMBOL$C,IAL,X'00',1 00000628 BR 14 00000629 FOSY1 ERROR 2,' UNKNOWN ERROR IN SCHRYF' 00000630 /TRANSL1 EPI 00000631 FFOUT 2,'DORIS' 00000632 KOHER DS 0CL8 00000633 DC C'KEY',5X'00',C'SKEY',4X'00',C'X(Y)',4X'00',24X'00' 00000634 DC C'-',7X'00',C'CONJG*',2X'00',C'-CONJG*',X'00' 00000635 DC C'INTEG*',2X'00' 00000636 DC C'-INTEG*',X'00',24X'00',C'REQUEST',X'00',C'CONJG(',2X'00' 00000637 DC C')',7X'00',C'TRICK',3X'00',C'TRACK',3X'00',C'PASS',4X'00' 00000638 LTORG 00000639 *** 00000640 /ARGL1 PRO NORPR1 FLAG 00000641 *** FLAG=0 IF NO OUTPUTTING REQUIRED. ELSE FLAG=1 AND FILENAME ( ARG1 * 00000642 *** ... ARGN ) = IS PRINTED. */ 00000643 / SETVAL IREG,0,(+,2,0,) 00000644 / CCALL S1NEWL 00000645 SET000 DCONT1,1 00000646 SET000 DCONT1,2 00000647 SET000 DCONT1,4 00000648 CMPBIT Z$PROP,NORPR1,PUNCH,OFF,LL001 00000649 CMP000 NCONT,1,EQ,LL001 00000650 SET111 DCONT1,1 00000651 LL001 CMPBIT Z$PROP,NORPR1,PRINT,OFF,LL002 00000652 CMP000 NCONT,2,EQ,LL002 00000653 SET111 DCONT1,2 00000654 LL002 CMPBIT Z$PROP,NORPR1,STORE,OFF,LL003 00000655 CMP000 NCONT,4,EQ,LL003 00000656 SET111 DCONT1,4 00000657 /LL003 SETVAL DCONT1,3,(+,DCONT1,1,+,DCONT1,2,+,DCONT1,4,) OVERALL 00000658 / CMP000 DCONT1,3,NE,L0075 00000659 / SET000 FLAG,0 00000660 B XARGL1 00000661 /L0075 SET111 FLAG,0 00000662 / SETVAL IREG,0,(+,3,0,) 00000663 SETNAM SYMBOL,0,Z$NAME,NORPR1 00000664 : PINZET1 SYMBOL 00000665 / PINZET1 C'(' 00000666 / SETVAL INDEX5,0,(+,Z$INDEX,NORPR1,) FROZEN INDX ALWAYS GT 0 00000667 / CMPBIT Z$PROP,NORPR1,FREZE,ON,L0076 00000668 L 1,INDEX5 00000669 SLL 1,24 00000670 SRA 1,24 TAKE MODULO 128 WITH SIGN EXTENSION 00000671 ST 1,INDEX5 00000672 /L0076 CMPBIT Z$PROP,NORPR1,NINDX,ON,ARG11 00000673 PNUTRA0 SYMBOL,INDEX5 00000674 PINZET1 SYMBOL 00000675 / PINZET1 C',' 00000676 ARG11 SETVAL II5,0,(+,Z$ARGNR,NORPR1,) 00000677 DOLOOP J,1,II5,1,L0077,ARG33 00000678 STM 7,9,LOOPVAR1 00000679 SETVAL IJ5,0,(+,NORPR1,0,+,J,0,) 00000680 SETNAM SYMBOL,0,Z$NAME,IJ5 00000681 : PINZET1 SYMBOL 00000682 / PINZET1 C',' 00000683 / CMPVAL IERIC,0,(+,LLIM1,0,),LT,ARG22 00000684 / SET000 BC1,IERIC 00000685 ARG22 LM 7,9,LOOPVAR1 00000686 / ENDDO L0077,+1 00000687 ARG33 SETVAL IERIC,0,(+,IERIC,0,-,1,0,) 00000688 CMPCAR BC1,IERIC,C'(',1,NE,L0101 00000689 PINZET1 C' ' 00000690 / B L0102 00000691 /L0101 PINZET1 C') ' 00000692 /L0102 PINZET1 C'= ' 00000693 /ARGL1 EPI 00000694 ** 00000695 DS 0H 00000696 USING *,15 00000697 *** INZET1 PRO SYMBOL 00000698 *** IF ARG IS A LITTERAL, PUT ALL ITS CHARS -INCLUDING BLANKS- IN BC1 * 00000699 /INZET1 DOLOOP J,1,6,1,L0103,L0104 MAX LENGTH FOR PP(28) */ 00000700 CMPCAR SYMBOL$C,J,X'00',1,EQ,RETURN 00000701 CMPCAR SYMBOL$C,J,C' ',1,EQ,RETURN 00000702 / SETVAL BC1,IERIC,(+,SYMBOL$C,J,) 00000703 / SETVAL IERIC,0,(+,IERIC,0,+,1,0,) 00000704 / ENDDO L0103,+1 00000705 /L0104 BR 14 00000706 DROP 15 00000707 /S3NEWL PRO K A0 00000708 / CMP000 NFOL,0,NE,S2NEWL DO NOT WRITE ) */ 00000709 / CMP000 BRAKCL,0,EQ,S2NEWL 00000710 CMP000 T$2CODEV,-A0-K-,NE,S2NEWL 00000711 / SET000 BRAKCL,0 00000712 / PINZET1 C')' 00000713 /S2NEWL CCALL S1NEWL 00000714 /S3NEWL EPI 00000715 /S1NEWL PRO 00000716 CCALL OUTP 00000717 / SET111 IERIC,0 00000718 / PINZET1 C' ' 00000719 /S1NEWL EPI 00000720 /S1NUMB PRO 00000721 CCALL NUMERH FLAG,VALUE,IEXP,BDOUB,BB 00000722 PNUMCV 00000723 *** WITH ARGS BB,BDOUB,IND,NQU,IDATA=(FLAG,VALUE,IEXP) 00000724 / CMPVAL LLIM1,0,(+,IND,0,+,IERIC,0,),GT,L0107 00000725 / CCALL S1NEWL 00000726 /L0107 DOLOOP J,1,IND,1,L0110,L0111 00000727 SETVAL II5,0,(+,IERIC,0,+,J,0,-,1,0,) 00000728 SETVAL BC1,II5,(+,BB,J,) 00000729 / ENDDO L0110,+1 00000730 /L0111 SETVAL IERIC,0,(+,IERIC,0,+,IND,0,) 00000731 /S1NUMB EPI 00000732 ** 00000733 ** 00000734 /OUTP PRO 00000735 / SETVAL IERIC,0,(+,IERIC,0,-,1,0,) 00000736 / CMP000 IERIC,0,GE,L0125 00000737 : SETCAR IBUF,6,C'0 ',4 00000738 / SET111 COUNT5,0 00000739 / B OUT5 00000740 /L0125 SETVAL COUNT5,0,(+,LENGT1,0,) MAX NR OF WORDS IN PRINTLINE 00000741 L 1,IERIC IERIC=MIN(IERIC,NR OF CHARS IN PRINTLINE) 00000742 LA 2,LENGT1*NEXTW 00000743 CR 1,2 00000744 BL LL007 00000745 ST 2,IERIC 00000746 LL007 LA 1,C'$' 00000747 LADR 2,IBUF,6 00000748 / DOLOOP J,1,IERIC,1,L0126,L0127 00000749 LOAD 4,BC1,J 00000750 CR 4,1 00000751 BNE L0254 00000752 / SET111 LDOC,0 00000753 L0254 STC 4,0(2) 00000754 LA 2,1(2) 00000755 / ENDDO L0126,+1 00000756 L0127 MVC 0(4,2),=C' ' 00000757 L 1,IERIC 00000758 SR 1,6 00000759 SRA 1,2 NR OF FULL WORDS 00000760 AR 1,6 00000761 ST 1,COUNT5 00000762 /OUT5 SETVAL IBUF,4,(+,COUNT5,0,) 00000763 / SET000 IBUF,3 00000764 / SETVAL IBUF,1,(+,NTAP2,0,) 00000765 / SETCAR IBUF,6,C'0',1 CARRIAGE CONTROL */ 00000766 / CMP000 LDOC,0,EQ,PRINT3 00000767 / SET000 LDOC,0 00000768 CALLFTN LIJN 00000769 MVC IBUF+20(28),TEXT1 00000770 SETVAL IBUF,4,(+,7,0,) 00000771 CALLFTN LIJN 00000772 / CMP000 ISPLAY,0,NE,PRINT4 00000773 MVC IBUF+20(120),TEXT2 00000774 SETVAL IBUF,4,(+,30,0,) 00000775 CALLFTN LIJN 00000776 MVC IBUF+20(68),TEXT3 00000777 SETVAL IBUF,4,(+,17,0,) 00000778 CALLFTN LIJN 00000779 MVC IBUF+20(44),TEXT4 00000780 SETVAL IBUF,4,(+,11,0,) 00000781 CALLFTN LIJN 00000782 / SET111 AZ,0 00000783 / B PRINT4 00000784 /PRINT2 CMP000 ISPLAY,0,NE,XOUTP CASE OF EMPTY CARD */ 00000785 / CMP000 DCONT1,2,EQ,XOUTP 00000786 CALLFTN LIJN 00000787 B XOUTP 00000788 /PRINT3 CMP000 IERIC,0,LT,PRINT2 00000789 / CMP000 DCONT1,2,EQ,PRINT4 PRINT CARD WITHOUT $*/ 00000790 CALLFTN LIJN 00000791 :PRINT4 CMP000 DCONT1,1,NE,LL008 00000792 CMP000 DCONT1,4,EQ,XOUTP 00000793 *** PAD AND PUNCH, DEPENDING ON IREG. IREG=0 OR 1 CONTINUE ON SAME */ 00000794 *** CARD. =2 FINISH PREVIOUS CARD AND SET OFF FTN CONTINUATION FLAG */ 00000795 *** =3 WRITE R AND START NEW CARD. =4 FINISH PREVIOUS CARD AND START */ 00000796 *** NEW CARD. */ 00000797 /LL008 CMP000 INIT2,0,NE,L0132 00000798 / SET000 KAM1,0 COUNTS OUTGOING CARDS 00000799 / SET111 INIT2,0 00000800 SETVAL KOM1,0,(+,8,0,) 00000801 SETCAR IPUNCH,0,C' ',7 00000802 /L0132 CMP111 IREG,0,GT,L0133 00000803 / CCALL PACK1 00000804 B XOUTP 00000805 /L0133 CMPVAL IREG,0,(+,3,0,),EQ,PRINT9 00000806 CMPVAL KOM1,0,(+,8,0,),EQ,L0134 EMPTY CARD 00000807 / CCALL PAD1 00000808 / CCALL PUNCH2 00000809 /L0134 CMPVAL IREG,0,(+,4,0,),EQ,PRINT8 00000810 / SET111 KEM1,0 00000811 /PRINT5 SET111 IREG,0 00000812 B XOUTP 00000813 /PRINT9 SETCAR IBUF,6,C'R ',4 00000814 / SET000 IBUF,3 00000815 / SET111 IBUF,4 00000816 / CMP000 DCONT1,1,EQ,L0135 00000817 / SETVAL IBUF,1,(+,NTAP8,0,) 00000818 CALLFTN LIJN 00000819 /L0135 CMP000 DCONT1,4,EQ,PRINT8 00000820 / SETVAL IBUF,1,(+,NTAP3,0,) 00000821 CALLFTN LIJN 00000822 PRINT8 SETVAL KOM1,0,(+,8,0,) 00000823 SETCAR IPUNCH,0,C' ',7 00000824 / CCALL PACK1 00000825 / B PRINT5 00000826 OUTP EPI 00000827 /PACK1 PRO 00000828 / DOLOOP J,5,IERIC,1,L0137,XPACK1 00000829 / CMPCAR BC1,J,C' ',1,EQ,OUT15 00000830 SETVAL IPUNCH$C,KOM1,(+,BC1,J,) 00000831 / SETVAL KOM1,0,(+,KOM1,0,+,1,0,) 00000832 CMPVAL KOM1,0,(+,72,0,),LT,OUT15 00000833 / SETCAR IPUNCH$C,72,C' ',1 00000834 / CCALL PUNCH2 00000835 SETVAL KOM1,0,(+,8,0,) 00000836 /OUT15 ENDDO L0137,+1 00000837 PACK1 EPI 00000838 /PUNCH2 PRO IS USED INSIDE DOLOOP. DANGER. 00000839 / SETCAR IPUNCH$C,73,C'OUT ',4 00000840 / SETVAL KAM1,0,(+,KAM1,0,+,1,0,) COUNTS OUTGOING CARDS */ 00000841 LA 1,KAM1 00000842 LA 2,SYMBOL LEADING BLANK FILLED 00000843 L 15,=A(CVTIN) 00000844 BALR 14,15 00000845 MVC IPUNCH+76(4),SYMBOL+4 LAST 4 CHARS 00000846 / SETVAL IBUF,3,(+,32,0,) FOR PUNCHING IPUNCH(1) TO IPUNCH(8) 00000847 / SETVAL IBUF,4,(+,52,0,) 00000848 / CMP000 DCONT1,4,EQ,L0141 00000849 / SETVAL IBUF,1,(+,NTAP3,0,) 00000850 CALLFTN LIJN 00000851 /L0141 CMP000 DCONT1,1,EQ,XPUNCH2 00000852 / CMP111 KEM1,0,EQ,L0142 00000853 / SETCAR IPUNCH$C,6,C'1',1 FTN CONTIN FLAG */ 00000854 /L0142 SET000 KEM1,0 00000855 / SETVAL IBUF,1,(+,NTAP8,0,) 00000856 CALLFTN LIJN 00000857 SETCAR IPUNCH$C,6,C' ',1 00000858 /PUNCH2 EPI 00000859 DS 0H 00000860 USING *,15 00000861 PAD1 DOLOOP J,KOM1,72,1,L0143,L0144 00000862 / SETCAR IPUNCH$C,J,C' ',1 00000863 ** /* IN FACT FIRST PADDING WITH CHARS AND THEN WITH FULL WS* 00000864 / ENDDO L0143,+1 00000865 /L0144 BR 14 00000866 DROP 15 00000867 TEXT1 DC C'0***ERROR. DOLLAR IN OUTPUT.' 00000868 TEXT2 DC C'0MAY BE DUE TO EXPRESSION AS FUNCTION ARGUMENT, WHIC' 00000869 DC C'H IS O.K. DURING CALCULATION, BUT ILLEGAL IF APPEARI' 00000870 DC C'NG IN OUTPUT. ' 00000871 TEXT3 DC C' SUCH FUNCTIONS MUST BE SUBJECT TO A SUBSTITUTION BE' 00000872 DC C'FORE THE * CARD.' 00000873 TEXT4 DC C' ALSO IMPROPER DUMMY USE MAY BE THE REASON. ' 00000874 END 00000875 ./A SCHRYF2,INCR=1 00000001 ./MACRO MAINMCRO 00000002 ./MACRO UITMACRO 00000003 TITLE 'SCHRYF2' 00000004 GBLC &OVLAY 00000005 LCLA &LENGTH$,&BEGIN$ 00000006 ./MACRO UITCOM 00000007 ./MACRO MAINCOM 00000008 *** 00000009 *** 00000010 PRINT NOGEN 00000011 SCHRYF2 CSECT 00000012 EQUIVAL 00000013 ENTRY DOMOV1,TERMI,FEEDIN,MSTAT1,REFER,TAPEW,WRITE1,COSEA1 00000014 EXTRN FOUT,GARBAG,DORIS,SCHUIF,SCHUI2,SNOEP,TAKMAN,UNCF 00000015 USING UITCOM,10 00000016 USING BLANK,11 00000017 *** 00000018 DS 0H 00000019 USING *,15 00000020 *** DOMOV1 PRO LENG5 BEGIN5 NAME5 00000021 &LENGTH$ SETA 1 00000022 &BEGIN$ SETA 2 00000023 DOMOV1 CR 0,&BEGIN$ 00000024 BER 14 00000025 CR 0,&LENGTH$ 00000026 BNE DO2 00000027 / DOLOOP J,1,NXEX,1,L0005,FFO2 00000028 / CMPNAM X$NAME,J,NAME5,0,NE,L0234 00000029 / SETBIT X$PROP,J,KEEP,ON 00000030 / BR 14 00000031 /L0234 ENDDO L0005,+1 00000032 / B FFO2 DOLOOP,BLOCK TROUBLE */ 00000033 DO2 SETVAL II5,0,(+,MTAB,10,) 00000034 *** SIMULATES EXISTENCE OF A NAMELIST 00000035 S &LENGTH$,=F'12' 00000036 STORE &LENGTH$,L$LENGT,II5 00000037 STORE &BEGIN$,L$ANAME,II5 00000038 A &BEGIN$,=F'12' 00000039 STORE &BEGIN$,L$BEGIN,II5 00000040 SET000 L$PROP,II5 00000041 SETBIT L$PROP,II5,FILE,ON 00000042 / SETVAL MTAB,19,(+,MTAB,19,+,1,0,) 00000043 SETVAL II5,0,(+,MTAB,19,) 00000044 SET000 X$INDEX,II5 00000045 SETNAM X$NAME,II5,NAME5,0 00000046 SET000 X$PROP,II5 00000047 SETBIT X$PROP,II5,FILE,ON 00000048 SETBIT X$PROP,II5,KEEP,ON 00000049 SETBIT X$PROP,II5,NINDX,ON 00000050 SETVAL X$LOCNR,II5,(+,MTAB,10,) 00000051 / SETVAL MTAB,10,(+,MTAB,10,+,1,0,) 00000052 / BR 14 00000053 FFO2 ERROR 1,' DOLOOP,BLOCK TROUBLE' 00000054 DROP 15 00000055 ** 00000056 /FEEDIN PRO 00000057 *** READ IN ALL OUTPUT OVERFLOW FROM TAPE. SORT TERMS BY COPYING THEM * 00000058 *** TO NS,NSA AND CALLING SCHUIF. THE OUTPUT STORE IS FILLED AGAIN, */ 00000059 *** AND NEW OVERFLOW MIGHT HAVE BEEN WRITTEN BY SCHUIF. */ 00000060 / CMP000 NRECOR,0,EQ,XFEEDIN 00000061 / SETVAL NRECOR,0,(+,NRECOR,0,-,1,0,) 00000062 / SET000 NSUBS,0 00000063 /FEE1A PTAKMAN NTAP5,IT12,NWORDS,READ0 00000064 / SETVAL NKLOPS,0,(+,NKLOPS,0,-,NWORDS,0,) 00000065 / SETVAL NWORDS,0,(+,NWORDS,0,-,NEXTW,0,) 00000066 SETADR START,0,(+,IT12,1,) 00000067 SETADR START,0,(+,B$0VECTS,START,) 00000068 /FEE2 CMP000 NWORDS,0,EQ,FEE5 00000069 SETVAL IGET,0,(+,B$0COEFF,START,) 00000070 : SETVAL START,0,(+,START,0,+,LFLOAT,0,) 00000071 SETVAL II5,0,(+,START,0,+,LCODE,0,) 00000072 / SETVAL NASFF,0,(+,-B$0CODE-NR-,II5,) 00000073 GETLEN NP,0,B$0CODE,START 00000074 L 1,NP 00000075 SRA 1,1 00000076 ST 1,II5 00000077 / DOLOOP J,1,II5,1,L0154,L0155 00000078 : SETVAL NNS,J,(+,B$0CODE,START,) 00000079 SETVAL START,0,(+,START,0,+,LCODE,0,) 00000080 / ENDDO L0154,+1 00000081 L0155 GETLEN NA,0,B$0CODE,START 00000082 L 1,NA 00000083 SRA 1,1 00000084 ST 1,II5 00000085 / DOLOOP J,1,II5,1,L0156,L0157 00000086 : SETVAL NNSA,J,(+,B$0CODE,START,) 00000087 SETVAL START,0,(+,START,0,+,LCODE,0,) 00000088 / ENDDO L0156,+1 00000089 :L0157 SETVAL NWORDS,0,(+,NWORDS,0,-,NP,0,-,NA,0,-,LFLOAT,0,) 00000090 / CCALL SCHUIF 00000091 / CMP000 NWORDS,0,LT,FFO1 TAPE COUNT UNCHECK */ 00000092 / CMP000 NWORDS,0,NE,FEE2 00000093 /FEE5 CMP000 NRECOR,0,EQ,L0160 00000094 / SETVAL NRECOR,0,(+,NRECOR,0,-,1,0,) 00000095 / B FEE1A 00000096 /L0160 SETVAL NRECOR,0,(-,1,0,) 00000097 / CMP000 NKLOPS,0,NE,FFO1 TAPE COUNT UNCHECK */ 00000098 / PTAKMAN NTAP5,DUMMM,DUMMM,REOFR0 00000099 / CCALL SNOEP 00000100 / CCALL TERMI 00000101 / CMP000 NSUM,0,EQ,XFEEDIN 00000102 CCALL GARBAG FLAG 00000103 / CMP000 FLAG,0,LT,XFEEDIN 00000104 *** IF NSUBS > (NDIMU+NDIMT)/2 THEN RETURN; 00000105 L 1,NDIMU 00000106 A 1,NDIMT 00000107 SRA 1,1 00000108 C 1,NSUBS 00000109 BH XFEEDIN 00000110 / SETVAL NRECOR,0,(+,NRECOR,0,-,1,0,) 00000111 / SET000 NSUM,0 00000112 / B FEE1A 00000113 FFO1 ERROR 1,' TAPE COUNT UNCHECK' 00000114 /FEEDIN EPI 00000115 ** 00000116 /MSTAT1 PRO FLAG 00000117 *** CHECK IF THE FILE, INDICATED IN NURI, CAN BE STORED IN CORE OR */ 00000118 *** MUST GO TO TAPE. A NUMERICAL FILE CAN ALWAYS STAY IN CORE */ 00000119 *** FLAG=1 IF NUM FILE ( TREATED BY MSTAT ). =0 IF FILE FITS IN */ 00000120 *** MEMORY ( TO BE TREATED ). =-1 IF FILE IS TO BE WRITTEN ON TAPE */ 00000121 /MST1 SETVAL FILNR5,0,(+,-NURI$FIL-NR-,0,) 00000122 / CMP000 NSUM,0,EQ,MST2 00000123 / CMPVAL NSUM,0,(+,FILNR5,0,),GE,MST9 CASE OF OUTPUT OVFLOW*/ 00000124 /MST1A CCALL FEEDIN FILE PARTIALLY IN CORE,PART ON TAPE*/ 00000125 / CCALL DORIS 00000126 / B MST1 00000127 /MST2 CMP000 VOLUM,FILNR5,NE,L0161 00000128 / SET000 NURI$ADR,0 00000129 / SET000 VALUE5,0 00000130 / B MST6 00000131 ** /* EMPTY FILE=NUM FILE WITH 0 * 00000132 L0161 BAL 14,MST10 NURI$FIL,A0 00000133 CMPVAL VOLUM,FILNR5,(+,CODEA+CODEV+LFLOAT+4*NEXTW,0,),EQ,MST8 00000134 *** LENGTH OF FILE IS CODEA+CODEV+LFLOAT+2*NP+2*NA. 00000135 *** FOR NUMERICAL FILE, NP=NEXTW . NA=NEXTW. 00000136 :MST2A CMPVAL NDIMT,0,(+,MBE,0,+,6000,0,+,VOLUM,FILNR5,),GE,L0158 00000137 SETVAL FLAG,0,(-,1,0,) 00000138 B XMSTAT1 00000139 /L0158 SET000 FLAG,0 FITS IN MEMORY */ 00000140 B XMSTAT1 00000141 MST8 CMPVAL T$2CODEV,-A0-1-,(+,VECTNR0+1,0,),NE,MST2A 00000142 ** /* TEST IF NUM FILE. NO VARS MUST BE PRESENT APART FROM COEF* 00000143 / SETVAL A0,0,(+,T$2ALGEN,A0,) 00000144 : CMP000 T$1CODEA,-A0-2-,NE,MST2A 00000145 *** CONVERT IT(A0).COEFF TO FIX AND BACK TO FLOAT. CMP VALUE 00000146 LOAD 0,T$1COEFF,A0 00000147 LDR 4,0 00000148 FIX 4,VALUE5,0 00000149 FLOAT 4,VALUE5,0 00000150 LCDR 4,4 00000151 LCDR 6,6 00000152 PLUS 00000153 TEST 18 HEX DIGITS 00000154 LTDR 0,0 00000155 BNE MST2A NOT AN INTEGER 00000156 /MST6 CMP000 NXEX,0,LT,RETURN 00000157 / PCOSEA1 K,J CASE OF NUMERICAL FILE */ 00000158 ** /* THE CURRENT FILE, INDICATED IN NURI, IS DEFINED IN */ 00000159 ** /* FILN1(K) AND HAS TO BE KEPT IN NXGEH(J) */ 00000160 / SETVAL LOC5,0,(+,X$LOCNR,J,) 00000161 / CMP000 LOC5,0,NE,L0162 00000162 / SETVAL LOC5,0,(+,MBU,0,) 00000163 / SETVAL MBU,0,(+,MBU,0,+,1,0,) 00000164 SETVAL X$LOCNR,J,(+,LOC5,0,) 00000165 /L0162 SETNAM X$NAME,J,Z$NAME,K TRANSFER PROPERTIES 00000166 / SETVAL X$INDEX,J,(+,Z$INDEX,K,) 00000167 SETVAL X$PROP,J,(+,Z$PROP,K,) 00000168 SETBIT X$PROP,J,PRINT,OFF 00000169 / SET000 L$AKEY,LOC5 00000170 / SET000 L$PROP,LOC5 00000171 CMPBIT Z$PROP,J,COMON,OFF,L0159 00000172 SETBIT L$PROP,LOC5,COMON,ON 00000173 /L0159 SETBIT L$PROP,LOC5,FILE,ON 00000174 / SET111 L$NUMB,LOC5 00000175 / SETVAL L$VALUE,LOC5,(+,VALUE5,0,) 00000176 / SET111 FLAG,0 00000177 B XMSTAT1 00000178 /MST9 CMPVAL NSUM,0,(+,FILNR5,0,),GT,MST2 00000179 / CMP000 VOLUM,FILNR5,EQ,MST1A 00000180 BAL 14,MST10 NURI$FIL,A0 00000181 / SETVAL FLAG,0,(-,1,0,) 00000182 B XMSTAT1 00000183 *** MST10 PRO NURI$FIL A0 FIND BEGIN OF FILE NURI$FIL 00000184 /MST10 SETVAL A0,0,(+,JEERST,0,) 00000185 /MST11 CMP000 A0,0,EQ,MFO1 STORAGE INCONSISTENCIES*/ 00000186 / CMPVAL T$2CODEV,-A0-2-,(+,NURI$FIL,0,),NE,L0163 00000187 / SETVAL NURI$ADR,0,(+,A0,0,) 00000188 / BR 14 00000189 /L0163 SETVAL A0,0,(+,T$2VECTN,A0,) 00000190 / B MST11 00000191 MFO1 ERROR 1,' STORAGE INCONSISTENCIES' 00000192 MSTAT1 EPI 00000193 ** 00000194 DS 0H 00000195 USING *,15 00000196 *** REFER PRO A0 NWOR2 FLAG 00000197 *** A0=STARTING ADDRESS IN IT FOR WRITING NAMELIST RECORD. */ 00000198 *** OUTPUT PRESENCE BIT . COUNT5 IS DUMMYNUMBER. */ 00000199 *** NWOR2=LENGTH OF RECORD IN BYTES. FLAG < 0 WHEN EXPR IS COMMON */ 00000200 ** /* THIS FLAG SEEMS TO BE UNUSED */ 00000201 /REFER DOLOOP J,1,NALGE,1,L0164,L0165 DOLOOPS CAN BE COMBINED WITH 00000202 / SET000 S$DUMMY,J 00000203 / ENDDO L0164,+1 00000204 /L0165 DOLOOP J,1,NVECT,1,L0166,L0167 00000205 / SET000 V$DUMMY,J 00000206 / ENDDO L0166,+1 00000207 /L0167 DOLOOP J,1,NVIND,1,L0170,L0171 00000208 / SET000 I$DUMMY,J 00000209 / ENDDO L0170,+1 00000210 /L0171 DOLOOP J,1,NFUN,1,L0172,L0173 00000211 / SET000 F$DUMMY,J 00000212 / ENDDO L0172,+1 00000213 /L0173 SETVAL FILNR5,0,(+,-NURI$FIL-NR-,0,) 00000214 SETNAM T$TNAME,A0,Z$NAME,FILNR5 00000215 SETVAL T$TPROP,A0,(+,Z$PROP,FILNR5,) 00000216 SETVAL T$TINDEX,A0,(+,Z$INDEX,FILNR5,) 00000217 SETVAL T$TARGNR,A0,(+,Z$ARGNR,FILNR5,) 00000218 / SETBIT T$TPROP,A0,STORE,OFF 00000219 / SETBIT T$TPROP,A0,KEEP,OFF 00000220 / SETBIT T$TPROP,A0,PUNCH,OFF 00000221 / SETBIT T$TPROP,A0,PRINT,OFF 00000222 / SETVAL K,0,(+,A0,0,+,NEXTT,0,) 00000223 / SET111 COUNT5,0 00000224 SETVAL II5,0,(+,Z$ARGNR,FILNR5,) 00000225 : DOLOOP J,1,II5,1,L0174,L0175 00000226 SETVAL IJ5,0,(+,FILNR5,0,+,J,0,) 00000227 SETVAL L1,0,(+,-Z$CODE-TYPE-,IJ5,) 00000228 SETVAL L2,0,(+,-Z$CODE-NR-,IJ5,) 00000229 CMPVAL L1,0,(+,INDEX,0,),EQ,REF11 00000230 CMPVAL L1,0,(+,VECTOR,0,),EQ,REF12 00000231 CMPVAL L1,0,(+,ALGEBR,0,),EQ,REF13 00000232 CMPVAL L1,0,(+,FUNCT,0,),EQ,REF14 00000233 B RFO1 ILLEGAL,TOO MANY FILE ARGS 00000234 REF11 SETVAL I$DUMMY,L2,(+,COUNT5,0,) 00000235 SETNAM T$TNAME,K,I$NAME,L2 00000236 SETVAL T$TPROP,K,(+,I$PROP,L2,) 00000237 SETBIT T$TPROP,K,CFLAG,OFF 00000238 B REF15 00000239 REF12 SETVAL V$DUMMY,L2,(+,COUNT5,0,) 00000240 SETNAM T$TNAME,K,V$NAME,L2 00000241 SETVAL T$TPROP,K,(+,V$PROP,L2,) 00000242 B REF15 00000243 REF13 SETVAL S$DUMMY,L2,(+,COUNT5,0,) 00000244 SETNAM T$TNAME,K,S$NAME,L2 00000245 SETVAL T$TPROP,K,(+,S$PROP,L2,) 00000246 B REF15 00000247 REF14 SETVAL F$DUMMY,L2,(+,COUNT5,0,) 00000248 SETNAM T$TNAME,K,F$NAME,L2 00000249 SETVAL T$TPROP,K,(+,F$PROP,L2,) 00000250 REF15 SETBIT T$TPROP,K,OUTPR,OFF 00000251 SETVAL T$TDUMMY,K,(+,Z$CODE,IJ5,) 00000252 SETVAL COUNT5,0,(+,COUNT5,0,+,1,0,) 00000253 SETVAL K,0,(+,K,0,+,NEXTN,0,) 00000254 / ENDDO L0174,+1 00000255 L0175 CMPBIT Z$PROP,FILNR5,COMON,OFF,REF8 00000256 SET000 FLAG,0 TAKE FIRST CREAT IND. THEN OTHER INDICES 00000257 REF5 DOLOOP J,2,NVIND,1,L0300,L0301 00000258 CMP000 I$DUMMY,J,NE,REF51 00000259 CMPBIT I$PROP,J,OUTPR,OFF,REF51 00000260 CMP000 FLAG,0,NE,REF56 00000261 CMPBIT I$PROP,J,CREAT,OFF,REF51 00000262 REF56 SETVAL I$DUMMY,J,(+,COUNT5,0,) 00000263 SETNAM T$TNAME,K,I$NAME,J 00000264 SETVAL T$TDUMMY,K,(+,J,0,+,INDEX0,0,) 00000265 SETVAL T$TPROP,K,(+,I$PROP,J,) 00000266 SETVAL K,0,(+,K,0,+,NEXTN,0,) 00000267 SETVAL COUNT5,0,(+,COUNT5,0,+,1,0,) 00000268 REF51 ENDDO L0300,+1 00000269 L0301 CMP000 FLAG,0,NE,REF8 00000270 DOLOOP J,2,NALGE,1,L0302,L0303 00000271 CMP000 S$DUMMY,J,NE,REF54 00000272 CMPBIT S$PROP,J,OUTPR,OFF,REF54 00000273 SETVAL S$DUMMY,J,(+,COUNT5,0,) 00000274 SETNAM T$TNAME,K,S$NAME,J 00000275 SETVAL T$TDUMMY,K,(+,J,0,+,ALGEBR0,0,) 00000276 SETVAL T$TPROP,K,(+,S$PROP,J,) 00000277 SETVAL K,0,(+,K,0,+,NEXTN,0,) 00000278 SETVAL COUNT5,0,(+,COUNT5,0,+,1,0,) 00000279 REF54 ENDDO L0302,+1 00000280 L0303 DOLOOP J,18,NFUN,1,L0304,L0305 00000281 CMP000 F$DUMMY,J,NE,REF53 00000282 CMPBIT F$PROP,J,OUTPR,OFF,REF53 00000283 SETVAL F$DUMMY,J,(+,COUNT5,0,) 00000284 SETNAM T$TNAME,K,F$NAME,J 00000285 SETVAL T$TDUMMY,K,(+,J,0,+,FUNCT0,0,) 00000286 SETVAL T$TPROP,K,(+,F$PROP,J,) 00000287 SETVAL K,0,(+,K,0,+,NEXTN,0,) 00000288 SETVAL COUNT5,0,(+,COUNT5,0,+,1,0,) 00000289 REF53 ENDDO L0304,+1 00000290 L0305 DOLOOP J,2,NVECT,1,L0306,L0307 00000291 CMP000 V$DUMMY,J,NE,REF52 00000292 CMPBIT V$PROP,J,OUTPR,OFF,REF52 00000293 SETVAL V$DUMMY,J,(+,COUNT5,0,) 00000294 SETNAM T$TNAME,K,V$NAME,J 00000295 SETVAL T$TDUMMY,K,(+,J,0,+,VECTOR0,0,) 00000296 SETVAL T$TPROP,K,(+,V$PROP,J,) 00000297 SETVAL K,0,(+,K,0,+,NEXTN,0,) 00000298 SETVAL COUNT5,0,(+,COUNT5,0,+,1,0,) 00000299 REF52 ENDDO L0306,+1 00000300 L0307 SET111 FLAG,0 00000301 B REF5 00000302 /REF8 SET000 T$0WORD,K 00000303 / SETVAL K,0,(+,K,0,+,NEXTW,0,) TERMINATORS */ 00000304 / SET000 T$0WORD,K 00000305 / CMPVAL COUNT5,0,(+,254,0,),GT,RFO1 00000306 / SETVAL NWOR2,0,(+,K,0,+,NEXTW,0,-,A0,0,) NR OF BYTES */ 00000307 / BR 14 00000308 RFO1 ERROR 1,' ILLEGAL OR TOO MANY FILE ARGS' 00000309 DROP 15 00000310 FFOUT 1,'SCHRYF2' 00000311 LTORG 00000312 ** 00000313 /TERMI PRO 00000314 *** TERMINATE OUTPUT OVERFLOW WRITING. INTERCHANGE TAPE NUMBERS */ 00000315 *** COPY CONTENT OF OUTPUT STORE TO HIGHER IT-PLACES */ 00000316 / SETVAL NRECOR,0,(+,NTEMA,0,) 00000317 / CMP000 NTEMA,0,EQ,TER1 00000318 / CMP000 ZN2IND,0,EQ,TER1 00000319 / CCALL SCHUI2 EMPTY LAST BUFFER */ 00000320 /TER1 SETVAL NKLOPS,0,(+,NWOC,0,) 00000321 / SET000 NTEMA,0 00000322 / SETVAL ITAP4,0,(+,NTAP5,0,) 00000323 / SETVAL NTAP5,0,(+,NTAP4,0,) 00000324 / SETVAL NTAP4,0,(+,ITAP4,0,) 00000325 / CMP000 YEPFLAG,0,NE,XTERMI 00000326 / CMP000 NINX,0,EQ,XTERMI 00000327 / SET000 NINX,0 00000328 CCALL GARBAG FLAG 00000329 *** NDIMT5=(MTAB(7)+MTAB(8))/2; 00000330 LOAD 4,MTAB,7 00000331 ADD 4,MTAB,8 00000332 SRA 4,1 00000333 STORE 4,NDIMT5,0 00000334 / CMP000 NSUBS,0,NE,L0145 00000335 : SETVAL NDIMT,0,(+,NDIMT5,0,) 00000336 B XTERMI 00000337 *** IF NSUBS-NDIMT < (MTAB(8)-MTAB(7))/2 00000338 ** /* IF SIZE EXPR < HALF OUTPUT SPACE */ 00000339 L0145 CMPVAL NSUBS,0,(+,NDIMT,0,+,NDIMT5,0,-,MTAB,7,),GE,L0146 00000340 / B L0147 00000341 :L0146 SETVAL NDIMT5,0,(+,MTAB,8,-,NSUBS,0,+,NDIMT,0,) 00000342 /L0147 SETVAL SHIFT5,0,(+,NDIMT5,0,-,NDIMT,0,) 00000343 / CMPVAL SHIFT5,0,(+,8400,0,),LT,XTERMI MINIMAL SIZE OUTPUT S 00000344 / DOLOOP J,NSUBS,NDIMT,-4,L0150,L0151 COPY TO HIGHER IT-PL 00000345 SETVAL II5,0,(+,J,0,+,SHIFT5,0,) 00000346 SETVAL T$0WORD,II5,(+,T$0WORD,J,) 00000347 / ENDDO L0150,-NEXTW 00000348 /L0151 SETVAL NDIMT,0,(+,NDIMT5,0,) 00000349 / SETVAL NSUBS,0,(+,NSUBS,0,+,SHIFT5,0,) 00000350 / SET111 JEERST1,0 00000351 / SETVAL JEERST,0,(+,JEERST,0,+,SHIFT5,0,) 00000352 / SETVAL J,0,(+,JEERST,0,) ADJUST POINTERS AFTER SHIFT */ 00000353 /TER4 SETVAL T$2ALGEN,J,(+,T$2ALGEN,J,+,SHIFT5,0,) 00000354 / SETVAL K,0,(+,T$2ALGEN,J,) 00000355 / CMP000 T$2VECTN,J,EQ,L0152 00000356 / SETVAL T$2VECTN,J,(+,T$2VECTN,J,+,SHIFT5,0,) 00000357 /L0152 SETVAL J,0,(+,T$2VECTN,J,) 00000358 /TER6 CMP000 T$1POINT,K,EQ,L0153 00000359 / SETVAL T$1POINT,K,(+,T$1POINT,K,+,SHIFT5,0,) 00000360 /L0153 SETVAL K,0,(+,T$1POINT,K,) 00000361 / CMP000 K,0,NE,TER6 00000362 / CMP000 J,0,NE,TER4 00000363 /TERMI EPI 00000364 ** 00000365 /TAPEW PRO ITAP4 START BUFLIMIT NWOR2 NRECO2 END5 00000366 / SETVAL COUNT5,0,(+,START,0,) 00000367 / CMP000 YEPFLAG,0,NE,L0201 00000368 / SETVAL VECNX,0,(+,NURI$ADR,0,) 00000369 / B L0202 00000370 /L0201 SETVAL VECNX,0,(+,JEERST,0,) 00000371 /L0202 SET000 NRECO2,0 00000372 / SET000 ALGNX,0 00000373 *** START NEXT VECTOR OR RESTART WITH OLD VECTOR */ 00000374 /TAP1V CMP000 VECNX,0,EQ,TAP9 00000375 / SETVAL II5,0,(+,NURI$FIL,0,-,T$2CODEV,-VECNX-2-,) 00000376 / CMP000 II5,0,EQ,TAP1 00000377 / CMP000 YEPFLAG,0,NE,TAP1 00000378 / CMP000 II5,0,LT,TAP10 00000379 / SETVAL VECNX,0,(+,T$2VECTN,VECNX,) 00000380 / B TAP1V 00000381 /TAP9 CMP000 NSUM,0,EQ,TAP10 00000382 / CMP000 YEPFLAG,0,NE,TAP11 00000383 / CMPVAL NSUM,0,(+,-NURI$FIL-NR-,0,),EQ,TAP11 00000384 /TAP10 PWRITE1 0 00000385 / SETVAL END5,0,(-,1,0,) 00000386 B XTAPEW 00000387 /TAP11 PWRITE1 -1 00000388 / SET000 END5,0 00000389 B XTAPEW 00000390 TAP1 GETLEN NPA,0,T$2CODEV,-VECNX-1- 00000391 SETVAL II5,0,(+,T$2ALGEN,VECNX,) 00000392 GETLEN NA,0,T$1CODEA,-II5-1- 00000393 ** /* ESTIMATE SPACE NEEDED FOR VECTOR + ONE ALGEBRA */ 00000394 SETVAL II5,0,(+,NPA,0,+,NA,0,+,NEXTW,0,+,LFLOAT,0,) 00000395 *** 1 WORD FOR VECTOR SEPARATOR 00000396 CMPVAL BUFLIMIT,0,(+,COUNT5,0,-,START,0,+,II5,0,+,II5,0,),GE,*00000397 L0204 00000398 / PWRITE1 1 00000399 / B TAP1V 00000400 L0204 L 1,COUNT5 00000401 MVC 0(LVECBEG,1),EMPTERM 00000402 SETVAL A0,0,(+,COUNT5,0,+,NEXTW,0,) 00000403 SETVAL COUNT5,0,(+,COUNT5,0,+,LVECBEG,0,) 00000404 ** /* ALGNX < 0 FOR NOT TAKING NEXT ALG.PREVIOUS NOT YET IN BUF* 00000405 / CMP000 ALGNX,0,GE,L0205 00000406 / SETVAL ALGNX,0,(-,ALGNX,0,) 00000407 / B L0206 00000408 /L0205 SETVAL ALGNX,0,(+,T$2ALGEN,VECNX,) 00000409 /L0206 SETVAL SHIFT5,0,(+,3,0,) EXCLUDE FILE LENGTH,FILE NR FOR TR 00000410 SETVAL K1,0,(+,VECNX,0,) 00000411 / CMP000 YEPFLAG,0,EQ,TRANSL 00000412 TAP4 L 1,NPA 00000413 SRA 1,1 00000414 ST 1,II5 00000415 / DOLOOP J,1,II5,1,L0207,TAP6 00000416 SETVAL B$0CODE,COUNT5,(+,T$2CODEV,-K1-J-,) 00000417 SETVAL COUNT5,0,(+,COUNT5,0,+,LCODE,0,) 00000418 / ENDDO L0207,+1 00000419 /TAP6 SETVAL B$0POINT,A0,(+,COUNT5,0,-,A0,0,) 00000420 / CMP000 ALGNX,0,NE,L0211 00000421 / SETVAL VECNX,0,(+,T$2VECTN,VECNX,) 00000422 / B TAP1V 00000423 L0211 GETLEN NPA,0,T$1CODEA,-ALGNX-1- 00000424 SETVAL II5,0,(+,NPA,0,+,NEXTW,0,) 00000425 CMPVAL BUFLIMIT,0,(+,COUNT5,0,-,START,0,+,II5,0,+,II5,0,),GT,*00000426 L0212 00000427 / PWRITE1 1 00000428 / SETVAL ALGNX,0,(-,ALGNX,0,) 00000429 / B TAP1V 00000430 ** /*COPY OLD VECTOR */ 00000431 /L0212 SETVAL A0,0,(+,COUNT5,0,) 00000432 SETVAL COUNT5,0,(+,COUNT5,0,+,NEXTW,0,) SPACE FOR POINTER 00000433 SETVAL B$0COEFF,COUNT5,(+,T$1COEFF,ALGNX,) 00000434 SETVAL COUNT5,0,(+,COUNT5,0,+,LFLOAT,0,) 00000435 SETVAL K1,0,(+,ALGNX,0,+,CODEA,0,-,CODEV,0,) FAKE VECTOR 00000436 / SETVAL ALGNX,0,(+,T$1POINT,ALGNX,) 00000437 / CMP000 YEPFLAG,0,NE,TAP4 00000438 / SETVAL SHIFT5,0,(+,2,0,) EXCLUDE FILE LENGTH FOR TRANSLATIO 00000439 TRANSL L 1,NPA 00000440 SRA 1,1 00000441 ST 1,II5 00000442 CMPVAL SHIFT5,0,(+,II5,0,),GT,TRA5 00000443 SETVAL CODE5,0,(+,T$2CODEV,-K1-SHIFT5-,) 00000444 SETVAL L3,0,(+,-CODE5-TYPE-,0,) 00000445 SETVAL L2,0,(+,-CODE5-NR-,0,) 00000446 / CMPVAL L3,0,(+,DUMMY,0,),NE,L0213 00000447 / CMP000 L2,0,EQ,TRA4 00000448 / B TRA2N 00000449 /L0213 CMPVAL L3,0,(+,INDEX,0,),NE,L0214 00000450 : SETVAL CODE1,0,(+,I$DUMMY,L2,) 00000451 / B TRA2S 00000452 /L0214 CMPVAL L3,0,(+,VECTOR,0,),EQ,TRA2V 00000453 / CMPVAL L3,0,(+,OPERAT,0,),EQ,TRA2N 00000454 / CMPVAL L3,0,(+,ALGEBR,0,),NE,L0215 00000455 / SETVAL CODE1,0,(+,S$DUMMY,L2,) 00000456 / B TRA2S 00000457 /L0215 CMPVAL L3,0,(+,EXPRES,0,),EQ,TRA2N 00000458 / CMPVAL L3,0,(+,FUNCT,0,),EQ,TRA2F 00000459 / CMPVAL L3,0,(+,NUMBER,0,),EQ,TRA2N 00000460 CMPVAL L3,0,(+,DOTPR,0,),GE,TRA2D 00000461 / CMPVAL L3,0,(+,VECTNR,0,),GE,TRA2VN 00000462 /TRA2N SETVAL B$0CODE,COUNT5,(+,CODE5,0,) 00000463 ** /* ASSEMBLE (TRANSLATED OR UNMODIFIED) QUANT TO OUTPUT WORD * 00000464 SETVAL COUNT5,0,(+,COUNT5,0,+,LCODE,0,) 00000465 /TRA4 SETVAL SHIFT5,0,(+,SHIFT5,0,+,1,0,) 00000466 B TRANSL 00000467 /TRA5 FILL BUFFER,0,0,COUNT5 00000468 / B TAP6 00000469 /TRA2V CMPVAL CODE5,0,(+,ARGFU0,0,),GE,L0216 00000470 / SETVAL CODE1,0,(+,V$DUMMY,L2,) 00000471 TRA2S CMP000 CODE1,0,EQ,TRA2N 00000472 SETVAL CODE5,0,(+,CODE1,0,) 00000473 / B TRA2N 00000474 /L0216 SETVAL CODE1,0,(+,F$DUMMY,L2,) 00000475 / B TRA2S 00000476 /TRA2F CMPVAL CODE5,0,(+,FUNCT0,0,),EQ,TRA2N 00000477 / CMP000 F$DUMMY,L2,EQ,TRA2N 00000478 / SETVAL CODE5,0,(+,F$DUMMY,L2,) 00000479 / SETVAL CODE1,0,(+,DD,0,) DD STANDX DUMMYFUNCTION */ 00000480 / SETVAL CODE2,0,(+,STANDX,0,) 00000481 / B TRA9 00000482 TRA2D LOAD 1,-CODE5-VECT1-,0 CASE OF )VECT 00000483 CR 1,6 IF CODE5.VECT1 LE 1 THEN GOTO TRA2N 00000484 BNH TRA2N 00000485 STORE 1,II5,0 00000486 LOAD 2,-CODE5-VECT2-,0 00000487 CR 2,6 IF CODE5.VECT2 LE 1 THEN GOTO TRA2N 00000488 BNH TRA2N 00000489 STORE 2,IJ5,0 00000490 CMP000 V$DUMMY,IJ5,NE,TRA7 00000491 CMP000 V$DUMMY,II5,EQ,TRA2N 00000492 SETVAL CODE2,0,(+,V$DUMMY,II5,) 00000493 SETVAL CODE5,0,(+,IJ5,0,+,VECTOR0,0,) 00000494 ** /* DOT DUMMYVECTOR VECTOR */ 00000495 / B TRA8 00000496 TRA7 SETVAL CODE5,0,(+,V$DUMMY,IJ5,) 00000497 CMP000 V$DUMMY,II5,EQ,L0221 00000498 SETVAL CODE2,0,(+,V$DUMMY,II5,) 00000499 ** /* DOT DUMMYVECTOR DUMMYVECTOR */ 00000500 / B TRA8 00000501 L0221 SETVAL CODE2,0,(+,II5,0,+,VECTOR0,0,) 00000502 ** /* DOT VECTOR DUMMYVECTOR */ 00000503 /TRA8 SETVAL CODE1,0,(+,DOT,0,) 00000504 /TRA9 SETVAL B$0CODE,COUNT5,(+,CODE1,0,) 00000505 SETVAL COUNT5,0,(+,COUNT5,0,+,LCODE,0,) 00000506 SETVAL B$0CODE,COUNT5,(+,CODE2,0,) 00000507 SETVAL COUNT5,0,(+,COUNT5,0,+,LCODE,0,) 00000508 / B TRA2N 00000509 TRA2VN SETVAL II5,0,(+,-CODE5-VECT1-,0,) 00000510 CMP111 II5,0,LE,TRA2N 00000511 CMP000 V$DUMMY,II5,EQ,TRA2N 00000512 : SETVAL CODE2,0,(+,V$DUMMY,II5,) 00000513 SETVAL CODE5,0,(+,-CODE5-VECT2-,0,+,NUMBER0,0,) 00000514 ** /* DOT DUMMYVECTOR NUMBER */ 00000515 / B TRA8 00000516 /TAPEW EPI 00000517 ** 00000518 /WRITE1 PRO FLAG 00000519 *** WRITE A BUFFER OUT ON TAPE,AFTER APPENDING EOR OR EOF WORDS ( AS * 00000520 *** REQUESTED BY FLAG) . IF ONLY 1 BUFFER, DO NOT YET WRITE UNLESS */ 00000521 *** CASE OF * YEP . */ 00000522 ** /* AVOID EMPTY BUFFER BY PUTTING 0**1 IN IT */ 00000523 CMPVAL COUNT5,0,(+,START,0,),NE,L0223 00000524 L 1,COUNT5 00000525 MVC 0(LEMPTY,1),EMPTERM 00000526 SETVAL COUNT5,0,(+,COUNT5,0,+,LEMPTY,0,) 00000527 /L0223 SET000 B$0WORD,COUNT5 00000528 / SETVAL COUNT5,0,(+,COUNT5,0,+,NEXTW,0,) 00000529 ** /* RECORD ENDING WORD */ 00000530 / CMP000 FLAG,0,EQ,L0224 00000531 / CMP000 ALGNX,0,NE,L0257 00000532 / SET000 B$0WORD,COUNT5 00000533 / B L0260 00000534 /L0257 SET111 B$0WORD,COUNT5 00000535 /L0260 B L0225 00000536 /L0224 SETVAL B$0WORD,COUNT5,(-,1,0,) 00000537 /L0225 SETVAL COUNT5,0,(+,COUNT5,0,+,NEXTW,0,) 00000538 / SETVAL NWOR2,0,(+,COUNT5,0,-,START,0,) 00000539 / CMP000 FLAG,0,NE,WRI2 00000540 / CMP000 NRECO2,0,NE,WRI2 00000541 / CMP000 YEPFLAG,0,NE,WRI2 00000542 B XWRITE1 00000543 WRI2 SETVAL START,0,(+,START,0,-,VECTS,0,) 00000544 PTAKMAN ITAP4,START,NWOR2,WRITE0 00000545 SETVAL START,0,(+,START,0,+,VECTS,0,) 00000546 SETVAL COUNT5,0,(+,START,0,) 00000547 / SETVAL NRECO2,0,(+,NRECO2,0,+,1,0,) 00000548 / SETVAL NWOR2,0,(-,1,0,) 00000549 /WRITE1 EPI 00000550 *** VECTS POINTER COEFF 00000551 EMPTERM DC 4X'00',X'0000001C',DL8'1.0',8X'00' 00000552 LVECBEG EQU *-EMPTERM 00000553 *** LEN FILNR FILL 00000554 DC X'08020801',4X'00' 00000555 *** POINTER COEFF LEN 0 ** 1 00000556 DC X'0000001C',DL8'1.0',8X'00',X'08020700',X'07010000' 00000557 LEMPTY EQU *-EMPTERM EMPTY FILE = 0**1 00000558 ** 00000559 DS 0H 00000560 USING *,15 00000561 *** COSEA1 PRO K J 00000562 *** SEARCH IF FILE, INDICATED BY NURI, EXISTS IN NXGEH. IF NOT, CREATE* 00000563 *** AN EMPTY PLACE FOR IT IN NXGEH. K= (R) OF FILE IN FILN1 . */ 00000564 *** J = (R) OF FILE IN NXGEH */ 00000565 /COSEA1 SETVAL K,0,(+,-NURI$FIL-NR-,0,) 00000566 / DOLOOP J,1,NXEX,1,L0226,L0227 00000567 : CMPNAM X$NAME,J,Z$NAME,K,NE,COS2 00000568 CMPBIT Z$PROP,K,NINDX,ON,RETURN 00000569 / CMPVAL X$INDEX,J,(+,Z$INDEX,K,),EQ,RETURN 00000570 /COS2 ENDDO L0226,+1 00000571 /L0227 SETVAL NXEX,0,(+,NXEX,0,+,1,0,) 00000572 SETCAR X$NAME,NXEX,X'0000000000',5 00000573 / SET000 X$INDEX,NXEX 00000574 / SET000 X$LOCNR,NXEX 00000575 / SET000 X$PROP,NXEX 00000576 / SETVAL J,0,(+,NXEX,0,) 00000577 / BR 14 00000578 DROP 15 00000579 END 00000580 ./A SCHUIF,INCR=1 00000001 ./MACRO MAINMCRO 00000002 ./MACRO EXECMCRO 00000003 TITLE 'SCHUIF' 00000004 GBLC &OVLAY 00000005 LCLC &NS,&NSA,&BUFX,&BUFF1 00000006 ./MACRO EXECCOM 00000007 ./MACRO MAINCOM 00000008 *** 00000009 *** 00000010 PRINT NOGEN 00000011 SCHUIF0 CSECT 00000012 EQUIVAL 00000013 ENTRY SSCHUIF,SSCHUI2,INDCR,CROSR 00000014 EXTRN FOUT,UNCF,TAKMAN 00000015 USING EXECCOM,10 00000016 USING BLANK,11 00000017 &NS SETC '-NS-' 00000018 &NSA SETC '-NSA-' 00000019 &BUFX SETC 'BBUFX' 00000020 &BUFF1 SETC 'IEPX' 00000021 ./MACRO SCHUIFM 00000022 SSCHUIF EQU SCHUIF 00000023 SSCHUI2 EQU SCHUI2 00000024 LTORG 00000025 *** 00000026 ./MACRO CROSRM 00000027 ./MACRO INDCRM 00000028 *** 00000029 FFOUT 7,'CROSR' 00000030 END 00000031 ./A SETEXEC,INCR=1 00000001 ICTL 2,71,20 00000002 EXECCOM CSECT 00000003 DC 171FL4'0' 00000004 DS 0D 00000005 DC 2250FL4'0' 00000006 EXECCO1 DC 1FL4'0' 00000007 END 00000008 ./A SETIN,INCR=1 00000001 ICTL 2,71,20 00000002 INCOM CSECT 00000003 EXTRN D$NAME,I$NAME,I$DUMMY,I$PROP,NVIND,V$NAME,V$DUMMY 00000004 EXTRN V$PROP,NVECT,S$NAME,S$DUMMY,S$PROP,NALGE,X$NAME,X$PROP 00000005 EXTRN NXEX,F$NAME,F$DUMMY,F$PROP,NFUN 00000006 DC 82FL4'0' 00000007 NDUMY DC 1FL4'0' 00000008 DC 98FL4'0' 00000009 DC 6FL1'0' 00000010 DS 0D 00000011 DC 11FL4'0' 00000012 INCO1 DC 1FL4'0' 00000013 REF$IN DC A(D$NAME),2F'0',A(NDUMY) 00000014 DC A(I$NAME,I$DUMMY,I$PROP,NVIND) 00000015 DC A(V$NAME,V$DUMMY,V$PROP,NVECT) 00000016 DC 4F'0' 00000017 DC A(S$NAME,S$DUMMY,S$PROP,NALGE) 00000018 DC A(X$NAME),1F'0',A(X$PROP,NXEX) 00000019 DC A(F$NAME,F$DUMMY,F$PROP,NFUN) 00000020 DC 4F'0' 00000021 END 00000022 ./A SETMAIN,INCR=1 00000001 ./MACRO MAINMCRO 00000002 ENTRY D$NAME,I$NAME,I$DUMMY,I$PROP,NVIND,V$NAME,V$DUMMY 00000003 ENTRY V$PROP,NVECT,S$NAME,S$DUMMY,S$PROP,NALGE,X$NAME,X$PROP 00000004 ENTRY NXEX,F$NAME,F$DUMMY,F$PROP,NFUN,MBR$N,NBR 00000005 BLANK CSECT 00000006 T$1 EQU 0 SHOULD NOT BE USED HERE 00000007 T$1CODEA EQU 0 SHOULD NOT BE USED HERE 00000008 T$2 EQU 0 SHOULD NOT BE USED HERE 00000009 T$2CODEV EQU 0 SHOULD NOT BE USED HERE 00000010 B$0 EQU 0 SHOULD NOT BE USED HERE 00000011 B$0VECTS EQU 0 SHOULD NOT BE USED HERE 00000012 T$T EQU 0 SHOULD NOT BE USED HERE 00000013 T$TARGNR EQU 0 SHOULD NOT BE USED HERE 00000014 T$TNEXTT EQU 0 SHOULD NOT BE USED HERE 00000015 EQUIVAL 00000016 DC 54FL4'0' 00000017 NBR DC 1FL4'0' 00000018 DC 41FL4'0' 00000019 NALGE DC 1FL4'0' 00000020 NFUN DC 1FL4'0' 00000021 NVECT DC 1FL4'0' 00000022 NVIND DC 1FL4'0' 00000023 NXEX DC 1FL4'0' 00000024 DC 77FL4'0' 00000025 MBR$N DC 52FL4'0' 00000026 DC 60FL4'0' 00000027 L$ANAME DC 260FL4'0' 00000028 L$BEGIN DC A(EXPR1,EXPR2,EXPR3,EXPR4,EXPR5,EXPR6,EXPR7,EXPR8,EXPR9) 00000029 DC A(EXPRA,EXPRB,EXPRC,EXPRD,EXPRE,EXPRF) 00000030 L$2 DS 0FL4 00000031 L$3 EQU (L$2-L$BEGIN)/4 00000032 DC (260-L$3)FL4'0' 00000033 DC 260FL2'0' 00000034 DC 260FL1'0' 00000035 DC 81FL4'0' 00000036 S$NAME DC C'I',FL4'0' 00000037 DC 259FL5'0' 00000038 S$DUMMY DC 260FL2'0' 00000039 S$PROP DC X'04' 00000040 S$2 DC 259X'00' 00000041 F$NAME DC C'D',FL4'0' 00000042 DC C'EPF',FL2'0' 00000043 DC C'G',FL4'0' 00000044 DC C'GI',FL3'0' 00000045 DC C'G5',FL3'0' 00000046 DC C'G6',FL3'0' 00000047 DC C'G7',FL3'0' 00000048 DC C'UB',FL3'0' 00000049 DC C'UBG',FL2'0' 00000050 DC C'DD',FL3'0' 00000051 DC C'DB',FL3'0' 00000052 DC C'DT',FL3'0' 00000053 DC C'DS',FL3'0' 00000054 DC C'DX',FL3'0' 00000055 DC C'DK',FL3'0' 00000056 DC C'DP',FL3'0' 00000057 DC C'DF',FL3'0' 00000058 DC 243FL5'0' 00000059 F$DUMMY DC 260FL2'0' 00000060 F$PROP DC X'0004040004' 00000061 DC X'0200020008' 00000062 DC X'0000080000' 00000063 DC X'0008' 00000064 F$2 DC 243X'00' 00000065 I$NAME DC C'TRACE' 00000066 DC 259FL5'0' 00000067 I$DUMMY DC 260FL2'0' 00000068 I$PROP DC X'00' 00000069 I$2 DC 259X'00' 00000070 V$NAME DC C')VECT' 00000071 DC 31FL5'0' 00000072 V$DUMMY DC 32FL2'0' 00000073 V$PROP DC X'00' 00000074 V$2 DC 31X'00' 00000075 X$NAME DC C'CONJG',C'INTEG' 00000076 DC 258FL5'0' 00000077 X$CODE DC X'0308',X'030A' 00000078 DC 258FL2'0' 00000079 DC 260FL1'0' 00000080 X$PROP DC X'0000' 00000081 X$2 DC 258X'00' 00000082 MTAB DC A(ITIN) 00000083 DC A(ITEND1) 00000084 DC A(ITEND1) 00000085 DC F'0' 00000086 DC A(ITEND1) 00000087 DC F'0' 00000088 DC A(ITOUT-3*LFLOAT) 00000089 DC A(BBUFX-44) 00000090 DC A(L$3+1) 00000091 DC A(L$3+1) 00000092 DC A(L$3+1) 00000093 DC 2F'0' 00000094 DC A(I$2-I$PROP) 00000095 DC A(V$2-V$PROP) 00000096 DC A(F$2-F$PROP) 00000097 DC A(S$2-S$PROP) 00000098 DC A(X$2-X$PROP) 00000099 DC A(X$2-X$PROP) 00000100 DC A(I$2-I$PROP) 00000101 ITIN DS 0FL4 00000102 D1 EQU X'0001' 00000103 D2 EQU X'0002' 00000104 D3 EQU X'0003' 00000105 D4 EQU X'0004' 00000106 D5 EQU X'0005' 00000107 EXPR1 DC A(0),E'1.0',F'0',X'33000000',F'0' 00000108 DC Y(0,0) 00000109 EXPR2 DC A(0),E'1.0',F'0',X'33000000',F'0' 00000110 DC Y(GI,D1,FUNCT0,0) 00000111 EXPR3 DC A(0),E'1.0',F'0',X'33000000',F'0' 00000112 DC Y(G5,D1,FUNCT0,0) 00000113 EXPR4 DC A(P41),E'1.0',F'0',X'33000000',F'0' 00000114 DC Y(GI,D1,FUNCT0,0) 00000115 P41 DC A(0),E'1.0',F'0',X'33000000',F'0' 00000116 DC Y(G5,D1,FUNCT0,0) 00000117 EXPR5 DC A(P51),E'1.0',F'0',X'33000000',F'0' 00000118 DC Y(GI,D1,FUNCT0,0) 00000119 P51 DC A(0),E'-1.0',F'0',X'33000000',F'0' 00000120 DC Y(G5,D1,FUNCT0,0) 00000121 EXPR6 DC A(P61),E'1.0',F'0',X'33000000',F'0' 00000122 DC Y(D,D2,D3,FUNCT0,D,D4,D5,FUNCT0,0,0) 00000123 P61 DC A(P62),E'1.0',F'0',X'33000000',F'0' 00000124 DC Y(D,D3,D4,FUNCT0,D,D2,D5,FUNCT0,0,0) 00000125 P62 DC A(P63),E'-1.0',F'0',X'33000000',F'0' 00000126 DC Y(D,D2,D4,FUNCT0,D,D3,D5,FUNCT0,0,0) 00000127 P63 DC A(0),E'1.0',F'0',X'33000000',F'0' 00000128 DC Y(EPF,D2,D3,D4,FUNCT0,G5,D1,FUNCT0,0,0) 00000129 EXPR7 DC A(P71),E'1.0',F'0',X'33000000',F'0' 00000130 DC Y(SKEY,D1,D2,D3,0,0) 00000131 P71 DC A(P72),E'-1.0',F'0',X'33000000',F'0' 00000132 DC Y(SKEY,D2,D1,D3,0,0) 00000133 P72 DC A(P73),E'1.0',F'0',X'33000000',F'0' 00000134 DC Y(SKEY,D2,D3,D1,0,0) 00000135 P73 DC A(P74),E'-1.0',F'0',X'33000000',F'0' 00000136 DC Y(SKEY,D3,D2,D1,0,0) 00000137 P74 DC A(P75),E'1.0',F'0',X'33000000',F'0' 00000138 DC Y(SKEY,D3,D1,D2,0,0) 00000139 P75 DC A(0),E'-1.0',F'0',X'33000000',F'0' 00000140 DC Y(SKEY,D1,D3,D2,0,0) 00000141 EXPR8 DC A(P81),E'1.0',F'0',X'33000000',F'0' 00000142 DC Y(D,D1,D3,FUNCT0,D,D2,D4,FUNCT0,0,0) 00000143 P81 DC A(0),E'-1.0',F'0',X'33000000',F'0' 00000144 DC Y(D,D1,D4,FUNCT0,D,D3,D2,FUNCT0,0,0) 00000145 EXPR9 DC A(P91),E'-1.0',F'0',X'33000000',F'0' 00000146 DC Y(I,ONE,G,D1,D3,FUNCT0,0,0) 00000147 P91 DC A(0),E'-1.0',F'0',X'33000000',F'0' 00000148 DC Y(D2,ONE,GI,D1,FUNCT0,0) 00000149 EXPRA DC 1F'0' 00000150 EXPRB DC 1F'0' 00000151 EXPRC DC 1F'0' 00000152 EXPRD DC 1F'0' 00000153 EXPRE DC 1F'0' 00000154 EXPRF DC 1F'0' 00000155 ITEND1 DS 0FL1'0' 00000156 DC (4000-(ITEND1-ITIN)/4)FL4'0' 00000157 ITOUT DC 8000FL4'0' 00000158 DC 1500FL4'0' 00000159 BBUFX DC 1000FL4'0' 00000160 DC 2746FL4'0' 00000161 D$NAME PRESET 30 00000162 PRESET 84 00000163 COMADR DC 1FL4'0' 00000164 END 00000165 ./A SETRONG,INCR=1 00000001 ICTL 2,71,20 00000002 RONGCOM CSECT 00000003 EXTRN S$NAME,I$NAME,V$NAME,F$NAME,X$NAME,MBR$N,NALGE,NFUN 00000004 EXTRN NBR,S$PROP,V$PROP,F$PROP 00000005 EXTRN NCONF,CONFU$N,NVIND,NVECT,NXEX 00000006 ARRAYS DC A(S$NAME-5,I$NAME-5,V$NAME-5,F$NAME-5,X$NAME-5,MBR$N-5) 00000007 DC A(CONFU$N-5) 00000008 *** SOME LISTS DO NOT NEED TO HAVE ALL QUANTS PRINTED. 00000009 LISTNR1 DC F'1',F'2',F'2',F'1',F'3',F'1',F'1' BOTTOM OF LISTS 00000010 LISTNR2 DC A(NALGE,NVIND,NVECT,NFUN,NXEX,NBR,NCONF) TOP OF LISTS 00000011 PROPS DC A(S$PROP-1),F'0',A(V$PROP-1,F$PROP-1),3F'0' 00000012 END 00000013 ./A SETUIT,INCR=1 00000001 ICTL 2,71,20 00000002 EXTRN I$NAME,V$NAME,S$NAME,F$NAME,NVIND,NALGE,NFUN,NVECT 00000003 EXTRN X$NAME,NXEX 00000004 UITCOM CSECT 00000005 DC 104FL4'0' 00000006 DC 1FL4'0' 00000007 DC 1FL1'0' 00000008 DS 0D 00000009 DC 3843FL4'0' 00000010 UITCO1 DC 1FL4'0' 00000011 REF$UIT DC A(S$NAME-5,I$NAME-5,V$NAME-5,F$NAME-5,X$NAME-5) 00000012 DC A(NALGE,NVIND,NVECT,NFUN,NXEX) 00000013 END 00000014 ./A SETZERO,INCR=1 00000001 ./MACRO MAINMCRO 00000002 TITLE 'SETZERO' 00000003 EXTRN LIJN 00000004 ENTRY SETZ,DUMP1 00000005 PRINT NOGEN 00000006 ./MACRO MAINCOM 00000007 SET0 CSECT 00000008 SETZ PROLOGH 00000009 STAE DUMPP 00000010 LA 1,2 00000011 ST 1,IBUF 00000012 ST 1,NTAP2 00000013 EXTRN LOVBUG,ORIGIN,IN1,INCOM,SNOEP,INDON,WRONG1 00000014 EXTRN SCHIP,TAKMAN,INPHV,GETAL,WRONG,FOUTA,STORE,ERROB 00000015 EXTRN SCHOON1,IDTFIER,SCHOON2,MAIN,NBLANK1,FNAM2,INPHU 00000016 EXTRN COVNR1,LEZE1,INP,SEAR3,PRIN3,SCHOON3 00000017 EXTRN EXEC,BRIAN,EXTRA,EXEC1,INSER1,INSER2,MARTYN1,MARTYN2 00000018 EXTRN ANNEKE,BOEK1,BOEK2,EPSRED1,EVFUN,EVNUM,SSCHUIF,SSCHUI2 00000019 EXTRN OUT,RATON,NUMCV,UIT1,SCHUIF,SCHRYF1,SCHRYF2,DORIS 00000020 EXTRN EXECCOM,UITCOM 00000021 EXTRN KIJFPU 00000022 LOOK$ 'LOADMAP' 00000023 PRINT$ 'ORIGIN',ORIGIN,1,LOCAL 00000024 PRINT$ 'SCHIP',SCHIP,4,LOCAL 00000025 PRINT$ 'LIJN',LIJN,4,LOCAL 00000026 PRINT$ 'TAKMAN',TAKMAN,4,LOCAL 00000027 PRINT$ 'SETZERO',SETZ,1,LOCAL 00000028 PRINT$ 'LOVBUG',LOVBUG,1,LOCAL 00000029 PRINT$ 'SNOEP',SNOEP,1,LOCAL 00000030 PRINT$ 'BLANK',ALIGN,1 00000031 PRINT$ 'INPHV',INPHV,4,LOCAL 00000032 PRINT$ 'GETAL',GETAL,4,LOCAL 00000033 PRINT$ 'IN1',IN1,1,LOCAL 00000034 PRINT$ 'INDON',INDON,1,LOCAL 00000035 PRINT$ 'INPHU',INPHU,4,LOCAL 00000036 PRINT$ 'COVNR1',COVNR1,4,LOCAL 00000037 PRINT$ 'LEZE1',LEZE1,4,LOCAL 00000038 PRINT$ 'INP',INP,4,LOCAL 00000039 PRINT$ 'SEAR3',SEAR3,4,LOCAL 00000040 PRINT$ 'PRIN3',PRIN3,4,LOCAL 00000041 PRINT$ 'SCHOON1',SCHOON1,4,LOCAL 00000042 PRINT$ 'NBLANK1',NBLANK1,4,LOCAL 00000043 PRINT$ 'FNAM2',FNAM2,4,LOCAL 00000044 PRINT$ 'SCHOON2',SCHOON2,4,LOCAL 00000045 PRINT$ 'MAIN',MAIN,4,LOCAL 00000046 PRINT$ 'IDTFIER',IDTFIER,4,LOCAL 00000047 PRINT$ 'SCHOON3',SCHOON3,4,LOCAL 00000048 PRINT$ 'INCOM',INCOM,4,LOCAL 00000049 PRINT$ 'WRONG',WRONG,4,LOCAL 00000050 PRINT$ 'FOUTA',FOUTA,4,LOCAL 00000051 PRINT$ 'STORE',STORE,4,LOCAL 00000052 PRINT$ 'ERROB',ERROB,4,LOCAL 00000053 PRINT$ 'WRONG1',WRONG1,1,LOCAL 00000054 PRINT$ 'KIJFPU',KIJFPU,1,LOCAL 00000055 PRINT$ 'EXECCOM',EXECCOM,4,LOCAL 00000056 PRINT$ 'EXEC',EXEC,4,LOCAL 00000057 PRINT$ 'BRIAN',BRIAN,4,LOCAL 00000058 PRINT$ 'EXTRA',EXTRA,4,LOCAL 00000059 PRINT$ 'EXEC1',EXEC1,4,LOCAL 00000060 PRINT$ 'INSER1',INSER1,4,LOCAL 00000061 PRINT$ 'INSER2',INSER2,4,LOCAL 00000062 PRINT$ 'MARTYN1',MARTYN1,4,LOCAL 00000063 PRINT$ 'MARTYN2',MARTYN2,4,LOCAL 00000064 PRINT$ 'ANNEKE',ANNEKE,4,LOCAL 00000065 PRINT$ 'BOEK1',BOEK1,4,LOCAL 00000066 PRINT$ 'SSCHUIF',SSCHUIF,4,LOCAL 00000067 PRINT$ 'SSCHUI2',SSCHUI2,4,LOCAL 00000068 PRINT$ 'BOEK2',BOEK2,4,LOCAL 00000069 PRINT$ 'EPSRED1',EPSRED1,4,LOCAL 00000070 PRINT$ 'EVFUN',EVFUN,4,LOCAL 00000071 PRINT$ 'EVNUM',EVNUM,4,LOCAL 00000072 PRINT$ 'UITCOM',UITCOM,4,LOCAL 00000073 PRINT$ 'RATON',RATON,4,LOCAL 00000074 PRINT$ 'NUMCV',NUMCV,4,LOCAL 00000075 PRINT$ 'SCHUIF',SCHUIF,4,LOCAL 00000076 PRINT$ 'SCHRYF1',SCHRYF1,4,LOCAL 00000077 PRINT$ 'SCHRYF2',SCHRYF2,4,LOCAL 00000078 PRINT$ 'DORIS',DORIS,4,LOCAL 00000079 LOOK$ 'VARIABS' 00000080 PRINT$ 'L$ANAME',L$ANAME,1 00000081 PRINT$ 'Z$NAME',Z$NAME,1 00000082 PRINT$ 'S$NAME',S$NAME,1 00000083 PRINT$ 'F$NAME',F$NAME,1 00000084 PRINT$ 'I$NAME',I$NAME,1 00000085 PRINT$ 'V$NAME',V$NAME,1 00000086 PRINT$ 'X$NAME',X$NAME,1 00000087 PRINT$ 'IT',ITIN,1 00000088 PRINT$ 'IEP',IIEP,1 00000089 PRINT$ 'IDGEH',IIDGEH,1 00000090 PRINT$ 'IPR1',IPR1,1 00000091 PRINT$ 'A',A,1 00000092 PRINT$ 'IPR',IPR,1 00000093 PRINT$ 'ISCAL',IISCAL,1 00000094 MVC BLANK(INITEND-INITIAL),INITIAL 00000095 STIMER TASK,TUINTVL=TIME0 00000096 SR 0,0 MIGHT BE DESTROYED BY STIMER 00000097 LA 6,1 00000098 LA 3,L$3-L$PROP MAX SIZE OF LOC 00000099 ST 3,NANU 00000100 SET111 NCONT,9 00000101 SET111 NCONT,11 00000102 SET000 ISPLAY,0 00000103 SETVAL NDIMT,0,(+,MTAB,7) 00000104 SETVAL MBE,0,(+,MTAB,2,) 00000105 SETVAL NXEX,0,(+,MTAB,18,) 00000106 MVC IBUF(TEXT2-TEXT),TEXT 00000107 CALLFTN LIJN 00000108 EPILOGH 00000109 SAVEFTN DS 18F 00000110 TEXT DC F'2',F'0',F'0',A((TEXT2-TEXT1)/4-1) 00000111 TEXT1 DC C' 1SCHOONSCHIP , VERSION OF JANUARY 1, 1978 ' 00000112 TEXT2 DS 0F 00000113 INITIAL DS 0F 00000114 ALIGN1 DC 4FL4'0' 00000115 FLCONS1 DC X'4E00000080000000' 00000116 FLWORK1 DC X'4E00000000000000' 00000117 FXCONS1 DC X'4F08000000000000' 00000118 FXWORK1 DC X'0000000000000000' 00000119 READ1 DC F'-1' 00000120 REQST1 DC F'-4' 00000121 REW1 DC F'-2' 00000122 REOFR1 DC F'-5' 00000123 SEAR1 DC F'2' 00000124 WEOF1 DC F'-3' 00000125 WEOFR1 DC F'1' 00000126 WRITE1 DC F'0' 00000127 TIME1 DC X'0FFFFFFF' VERY BIG NR 00000128 INITEND DS 0F 00000129 DS 0H 00000130 USING *,15 00000131 DUMPP L 0,=A(DUMP1) 00000132 DROP 15 00000133 LA 15,4 00000134 BR 14 00000135 DS 0H 00000136 DUMP1 BALR 12,0 00000137 USING *,12 00000138 LA 13,SAVEFTN2 00000139 L 11,=V(BLANK) 00000140 USING BLANK,11 00000141 SR 0,0 00000142 LA 6,1 00000143 NEXTW EQU 4 00000144 FLS EQU X'32000' FIELDLENGTH 00000145 B BEGIN1 00000146 *** 00000147 INRANGE LA 2,0(2) CHECK IF CONT OF R2 IS AN ACCESSIBLE MEMORY LOC 00000148 LR 3,2 00000149 S 3,=A(16*NEXTW) 00000150 S 2,=A(ORIGIN+16*NEXTW) 00000151 BH GOOD1 00000152 SR 3,3 00000153 GOOD1 S 2,=A(FLS) 00000154 BL GOOD2 00000155 SR 3,3 00000156 GOOD2 BR 14 00000157 *** 00000158 BEGIN1 L 2,12(1) DUMP AROUND OLD PSW 00000159 BAL 14,INRANGE 00000160 LTR 3,3 00000161 BZ OUT1 00000162 ST 3,DUMP5+4 00000163 B NEXT1 00000164 OUT1 MVC DUMP5+8(8),=C'OUT PSW' 00000165 NEXT1 LA 7,24(1) 00000166 LR 4,7 00000167 LA 8,NEXTW 00000168 LA 9,15*NEXTW(7) 00000169 BACK L 2,0(7) DUMP AROUND CONTENT OF ALL REGS 00000170 BAL 14,INRANGE 00000171 LR 5,7 00000172 SR 5,4 00000173 SLA 5,2 00000174 LTR 3,3 00000175 BZ OUT2 00000176 ST 3,DUM0+4(5) 00000177 B NEXT2 00000178 OUT2 L 3,=C'OUT ' 00000179 ST 3,DUM0+8(5) 00000180 NEXT2 BXLE 7,8,BACK 00000181 ST 1,DUMP2+4 00000182 LA 1,24(1) 00000183 ST 1,DUMP3+4 00000184 LA 1,64(1) 00000185 ST 1,DUMP4+4 00000186 LOOK$ 'RECOV' 00000187 *** THE ADDRESS DUMP1 IN THE PRINT$ MACRO WILL BE OVERWRITTEN WITH 00000188 *** THE ADDRESSES IN STAE BLOCK. 00000189 DUMP2 PRINT$ 'PSW',DUMP1,8 00000190 DUMP3 PRINT$ 'REGS',DUMP1,16 00000191 DUMP4 PRINT$ 'LINK',DUMP1,8 00000192 DUMP5 PRINT$ 'C OLDPSW',DUMP1,40 00000193 DUM0 PRINT$ 'C OF R 0',DUMP1,40 00000194 DUM1 PRINT$ 'C OF R 1',DUMP1,40 00000195 DUM2 PRINT$ 'C OF R 2',DUMP1,40 00000196 DUM3 PRINT$ 'C OF R 3',DUMP1,40 00000197 DUM4 PRINT$ 'C OF R 4',DUMP1,40 00000198 DUM5 PRINT$ 'C OF R 5',DUMP1,40 00000199 DUM6 PRINT$ 'C OF R 6',DUMP1,40 00000200 DUM7 PRINT$ 'C OF R 7',DUMP1,40 00000201 DUM8 PRINT$ 'C OF R 8',DUMP1,40 00000202 DUM9 PRINT$ 'C OF R 9',DUMP1,40 00000203 DUM10 PRINT$ 'C OF R10',DUMP1,40 00000204 DUM11 PRINT$ 'C OF R11',DUMP1,40 00000205 DUM12 PRINT$ 'C OF R12',DUMP1,40 00000206 DUM13 PRINT$ 'C OF R13',DUMP1,40 00000207 DUM14 PRINT$ 'C OF R14',DUMP1,40 00000208 DUM15 PRINT$ 'C OF R15',DUMP1,40 00000209 LA 6,1 00000210 ST 6,RECOV 00000211 L 15,=V(WRONG) 00000212 BALR 14,15 THIS ROU WILL NOT RETURN, BUT IT STOPS 00000213 SAVEFTN2 DC 18F'0' 00000214 END 00000215 ./A UITFTN,INCR=1 00000001 SUBROUTINE OUT 00000002 CALL UIT1 00000003 RETURN 00000004 END 00000005 SUBROUTINE RATON(XX,IND,IUP,IDO) 00000006 C TRY TO CONVERT XX INTO IUP/IDOWN. XX=FLOAT.P. IUP,IDOWN ARE INTEGERS 00000007 C LT 2**30. INDICATOR=+1 IF SUCCESSFUL. =-1 IF CONVERSION IMPOSSIBLE. 00000008 C LSIGN=+1 IF XX GT 1 . =2 IF XX LY -1 . =-1 IF 0 LT XX LT 1 . =-2 IF 00000009 C 0 GT XX GT -1 . 00000010 C X IS THE NUMBER GT 1 WHICH WILL BE CONVERTED. XX CAN BE RECONSTRUCTED 00000011 C BY LOOKING AT LSIGN. X-INTEG(X)/1 IS FRACTION TO BE APPROXIMATED BY 2 00000012 C INTEGERS. R1,R2 ARE LENGTHS OF INTERVALS ( EVERYTIME MADE FINER). 00000013 C N1,N2 INDICATE HOW OFTEN THE ORIGINAL INTERVALS CONTAIN THE FINEST 00000014 C SUBINTERVAL. 00000015 REAL*16 XX,X,R1,R2,R3 00000016 EXTERNAL TWOLOG,TWOILO 00000017 DATA RD/1E-26/ 00000018 LTRY=3 00000019 X=XX 00000020 LSIGN=1 00000021 IF(X) 1,2,2 00000022 1 LSIGN=2 00000023 X=-X 00000024 2 CALL UNFC(TWOLOG,X,I2) 00000025 IF(IABS(I2)-29) 3,4,4 00000026 4 IND=-1 00000027 RETURN 00000028 3 IF(I2) 5,6,6 00000029 5 X=1./X 00000030 LSIGN=-LSIGN 00000031 I2=-I2 00000032 6 K1=X 00000033 R2=K1 00000034 R2=X-R2 00000035 R1=R2-1. 00000036 N1=1 00000037 N2=1 00000038 ICR=60-I2 00000039 21 CALL UNFC(TWOLOG,R1,L1) 00000040 CALL UNFC(TWOILO,N1,L2) 00000041 L1=L1-L2 00000042 K4=1 00000043 IF(L1+ICR) 7,7,8 00000044 C EXIT. RECONSTRUCT ORIGINAL NR. TEST ACCURACY. 00000045 7 R3=N1 00000046 IUP=R3*X 00000047 IUP=IUP+K4 00000048 IDO=N1 00000049 CALL UNFC(TWOLOG,R3,L1) 00000050 IF(L1+I2-30) 9,9,4 00000051 9 IF(LSIGN) 11,12,12 00000052 11 N3=IDO 00000053 IDO=IUP 00000054 IUP=N3 00000055 12 IF(IABS(LSIGN)-2) 13,14,13 00000056 14 IUP=-IUP 00000057 13 R1=IUP 00000058 R2=IDO 00000059 R3=R1/R2 00000060 R1=XX 00000061 CALL UNFC(TWOLOG,R1,L1) 00000062 CALL UNFC(TWOLOG,R1-R3,L2) 00000063 IF(L1-L2-60) 27,15,15 00000064 C LTRY ALLOWS 2 TRIES FOR NUMERATOR, IUP AND IUP+1 . K4 IS THE VALUE 00000065 C OF THIS CORRECTION (0 OR 1) . 00000066 27 LTRY=LTRY-2 00000067 K4=1-K4 00000068 IF(LTRY) 4,7,7 00000069 15 IND=1 00000070 RETURN 00000071 8 CALL UNFC(TWOLOG,R2,L1) 00000072 CALL UNFC(TWOILO,N2,L2) 00000073 L1=L1-L2 00000074 IF(L1+ICR) 16,16,17 00000075 16 N1=N2 00000076 K4=0 00000077 GO TO 7 00000078 17 IF(QABS(R1)-QABS(R2)) 18,25,19 00000079 25 K1=1 00000080 X=X-RD*X 00000081 GO TO 24 00000082 18 R3=QABS(R2/R1) 00000083 CALL UNFC(TWOLOG,R3,L1) 00000084 IF(L1-30) 23,23,4 00000085 23 K1=R3 00000086 R3=R2+K1*R1 00000087 R1=R3+R1 00000088 R2=R3 00000089 CALL UNFC(TWOILO,N1,L1) 00000090 CALL UNFC(TWOILO,K1,L3) 00000091 N3=N2+K1*N1 00000092 N1=N3+N1 00000093 N2=N3 00000094 IF(L1+L3-30) 21,21,4 00000095 19 R3=QABS(R1/R2) 00000096 CALL UNFC(TWOLOG,R3,L1) 00000097 IF(L1-30) 22,22,4 00000098 22 K1=R3 00000099 24 R3=R1+K1*R2 00000100 R2=R3+R2 00000101 R1=R3 00000102 CALL UNFC(TWOILO,N2,L1) 00000103 CALL UNFC(TWOILO,K1,L3) 00000104 N3=N1+K1*N2 00000105 N2=N3+N2 00000106 N1=N3 00000107 IF(L1+L3-30) 21,21,4 00000108 END 00000109 SUBROUTINE NUMCV(IB,AN,IND,MIND,IDATA) 00000110 DIMENSION I10(10),IB(1),IDATA(3) 00000111 REAL*16 AN,Z1,X10,X1,X01 00000112 EXTERNAL TWOILO 00000113 DATA I10 /1,10,100,1000,10000,100000,1000000, 00000114 1 10000000,100000000,1000000000 / 00000115 DATA X10,X1,X01/10.D0,1.D0,0.1D0/ 00000116 DATA KE,KMI,KPUN,KSL,K0 / ZC5,Z60,Z4B,Z61,ZF0 / 00000117 C ROUTINE TO CONVERT FLOATING POINT NUMBERS TO PRINTABLE FORM. 00000118 C MIND=NR OF DIGITS TO BE PRINTED OR RATON(=CONVERT TO RATIO OF 2 INTEG00000119 C ERS ) REQUEST. 00000120 C IND=LOCATION IN ARRAY B WHERE NEXT DISPLAY CHARACTER SHOULD BE STORED00000121 C BDOUB=AN=DOUBLE PREC COEF (96 BITS) TO BE CONVERTED TO DISPLAY CODE 00000122 C IY1=0(-1) CONVERTS TO PRINTABLE FLOAT POINT NR (INTEGER) 00000123 C I.E. 2.5E1 OR 25 00000124 C IY2=INTEGER CORRESPONDING WITH BDOUB(RESULT AFTER UNPACKING). 00000125 C IEXP=ESTIMATED(VIA TWO LOGARITHM) POWER OF 10 FOR BDOUB. BY NUMERH 00000126 IY1=IDATA(1) 00000127 IY2=IDATA(2) 00000128 IEXP=IDATA(3) 00000129 IRATIO=0 00000130 IF(MIND-195) 42,43,43 00000131 43 CALL RATON(AN,IW1X,IUP,IDO) 00000132 IF(MIND-201) 50,50,51 00000133 50 MIND=202 00000134 51 MIND=MIND-200 00000135 IF(IW1X) 42,44,44 00000136 44 IRATIO=1 00000137 IY2=IUP 00000138 IY1=-1 00000139 CALL UNFC(TWOILO,IY2,IYX2,XYYX) 00000140 YX2=IYX2 00000141 IEXP=0.30102*YX2 00000142 42 IMND=-MIND 00000143 IIEXP=-IEXP 00000144 C MIND=1 TRUNCATE TO INTEGER. DONE BY GOTO 36 . 00000145 C MIND=0 ROUND TO INTEGER. DONE BY ADDING .5 00000146 IF(MIND-1) 1,36,3 00000147 1 IY2=AN+0.5 00000148 IF(IEXP+1) 2,36,36 00000149 2 IEXP=0 00000150 IY2=0 00000151 GO TO 36 00000152 3 IF(MIND-25) 39,40,40 00000153 40 MIND=25 00000154 39 IF(IY1) 36,4,4 00000155 C PROCEDURE TO ADJUST IEXP (IF THE ESTIMATION WAS SLIGHTLY WRONG). 00000156 C IF IEXP GT 293, 10**-IEXP=AN=0 WILL RESULT AND THIS PROCEDURE LOOPS. 00000157 C R1 IS REQUESTED ACCURACY. E.G. .5*10**-15 00000158 4 R1=0.5*10.**IMND 00000159 IF(IEXP) 41,5,41 00000160 41 AN=AN*X10**IIEXP 00000161 5 Z1=AN-X1 00000162 IF(Z1) 6,7,7 00000163 6 AN=AN*X10 00000164 IEXP=IEXP-1 00000165 GO TO 5 00000166 7 Z1=AN-X10 00000167 IF(Z1) 9,8,8 00000168 8 AN=AN*X01 00000169 IEXP=IEXP+1 00000170 GO TO 7 00000171 C AN IS REDUCED TO 1 LT AN LT 10 . MAKE 1 DIGIT APPEAR IN FRONT OF 00000172 C DECIMAL POINT. TRY TWICE IN DOLOOP 15. 00000173 9 IZ=AN 00000174 IK=IZ-1 00000175 DO 15 I2=1,2 00000176 IK=IK+1 00000177 Z1=IK 00000178 R2=AN-Z1 00000179 IF(R2) 10,11,11 00000180 10 R2=-R2 00000181 11 R2=R2-R1 00000182 IF(R2) 12,12,15 00000183 12 IF(IK-10) 14,13,5 00000184 13 IK=1 00000185 IEXP=IEXP+1 00000186 14 IZ=0 00000187 AN=0. 00000188 IND=IND+1 00000189 IB(IND)=IK+K0 00000190 GO TO 18 00000191 15 CONTINUE 00000192 IF(IEXP+1) 17,16,17 00000193 16 IEXP=0 00000194 IZ=0 00000195 IND=IND+1 00000196 IB(IND)=K0 00000197 GO TO 18 00000198 17 IZ=AN 00000199 IND=IND+1 00000200 IB(IND)=IZ+K0 00000201 Z1=IZ 00000202 AN=(AN-Z1)*X10 00000203 18 IND=IND+1 00000204 IB(IND)=KPUN 00000205 LIND=IND+1 00000206 KIND=IND+MIND 00000207 C MAKE PART BEHIND DECIMAL POINT. I1 COUNTS DIGITS. IND DISCARDS 00000208 C TRAILING ZEROS. 00000209 DO 24 I1=LIND,KIND 00000210 IZ=AN 00000211 R1=10.*R1 00000212 IK=IZ-1 00000213 DO 22 I2=1,2 00000214 IK=IK+1 00000215 Z1=IK 00000216 R2=AN-Z1 00000217 IF(R2) 19,20,20 00000218 19 R2=-R2 00000219 20 R2=R2-R1 00000220 IF(R2) 21,21,22 00000221 21 IF (IK) 52,53,52 00000222 52 IND=I1 00000223 53 IK=IK+K0 00000224 IB(I1)=IK 00000225 GO TO 25 00000226 22 CONTINUE 00000227 23 Z1=IZ 00000228 AN=(AN-Z1)*X10 00000229 IF (IZ) 54,55,54 00000230 54 IND=I1 00000231 55 IZ=IZ+K0 00000232 24 IB(I1)=IZ 00000233 C MAKE EXPONENT. MAX VALUE 3 DIGITS. 00000234 25 IF(IEXP) 38,34,26 00000235 38 IND=IND+2 00000236 IB(IND)=KMI 00000237 IB(IND-1)=KE 00000238 IEXP=-IEXP 00000239 GO TO 27 00000240 26 IND=IND+1 00000241 IB(IND)=KE 00000242 27 IKA=3 00000243 IC=100 00000244 IP=0 00000245 28 IL=0 00000246 C CONVERT TO PRINTABLE INTEGER. EXPON OR RATIO RESULT. 00000247 DO 32 I7=1,IKA 00000248 KI=IEXP/IC 00000249 IF(KI) 29,29,30 00000250 29 KI=0 00000251 IF(IL) 31,32,31 00000252 30 IL=3 00000253 IEXP=IEXP-KI*IC 00000254 31 KLAP=IND+1 00000255 IB(KLAP)=KI+K0 00000256 IND=KLAP 00000257 32 IC=IC/10 00000258 IF(IP) 33,34,33 00000259 33 IND=IND+1 00000260 IB(IND)=KPUN 00000261 IF(IRATIO) 34,34,46 00000262 46 IRATIO=0 00000263 IF(IDO-1) 49,34,49 00000264 49 IND=IND+1 00000265 IB(IND)=KSL 00000266 IY2=IDO 00000267 CALL UNFC(TWOILO,IY2,IYX2,XYYX) 00000268 YX2=IYX2 00000269 IEXP=0.30102*YX2 00000270 GO TO 36 00000271 34 RETURN 00000272 36 IKA=IEXP+2 00000273 C PREPARE TO CONVERT RATIO RESULT. MAX 10 DIGITS. I10 CONTAINS ALL 00000274 C POWERS OF 10 REPRESENTABLE AS INTEGER. 00000275 IF(IKA-11) 47,48,48 00000276 48 IKA=10 00000277 47 IC=I10(IKA) 00000278 IEXP=IY2 00000279 IP=1 00000280 IF(IY2) 28,37,28 00000281 37 IND=IND+1 00000282 IB(IND)=K0 00000283 GO TO 33 00000284 END 00000285 ./A UIT1,INCR=1 00000001 ./MACRO MAINMCRO 00000002 ./MACRO UITMACRO 00000003 TITLE 'UIT' 00000004 GBLC &OVLAY 00000005 LCLC &NS,&NSA,&BUFF1,&BUFX,&CBUF1 00000006 LCLA &FIX$,&FLOAT$,&RESUL$ 00000007 ./MACRO UITCOM 00000008 ./MACRO MAINCOM 00000009 *** 00000010 *** 00000011 PRINT NOGEN 00000012 UIT0 CSECT 00000013 EQUIVAL 00000014 EXTRN SCHRYF,FOUT,TAKMAN,UNCF,NUM1,LIJN 00000015 ENTRY UIT1,SCHUIF,SCHUI2,GARBAG,INNAM,NUMERH,UPDAT 00000016 ENTRY TWOLOG,TWOILO 00000017 UIT1 PROLOGH 00000018 L 10,=V(UITCOM) INITIALIZE OVERLAY 00000019 USING UITCOM,10 00000020 STORE 10,COMADR,1 00000021 ST 5,LAYNR ADDRESS OF SAVEAREA 00000022 SETCAR LAYNAM$D,0,C'UIT ',4 00000023 SETVAL LAYNAM$V,0,(+,3,0,) 00000024 LADR 9,UITCO1,1 END OF /UITCOM/ 00000025 LR 7,10 BEGIN OF /UITCOM/ 00000026 LA 8,NEXTW 00000027 LL005 ST 0,0(7) SET /UITCOM/ TO ZERO 00000028 BXLE 7,8,LL005 00000029 SETADR NDIMU,0,(+,COMADR,1,-,3*LFLOAT,0,) 00000030 CCALL SCHRYF 00000031 SET000 IBUF,3 00000032 SETVAL IBUF,4,(+,2,0,) 00000033 CMP000 NCONT,1,EQ,LL006 00000034 SETVAL IBUF,1,(+,NTAP8,0,) 00000035 MVC IBUF+20(8),=C'* END' 00000036 CALLFTN LIJN 00000037 LL006 CMP000 NCONT,4,EQ,XUIT1 00000038 SETVAL IBUF,1,(+,NTAP3,0,) 00000039 MVC IBUF+20(8),=C'TAPE END' 00000040 CALLFTN LIJN 00000041 XUIT1 EPILOGH 00000042 SAVEFTN DS 18F 00000043 *** 00000044 &FIX$ SETA 1 00000045 &FLOAT$ SETA 1 00000046 &RESUL$ SETA 2 00000047 NUMERH PRO 00000048 LA 4,C'+' 00000049 STORE 4,BB,1 00000050 LA 4,C' ' 00000051 STORE 4,BB,2 00000052 LD 0,BDOUB 00000053 LTDR 0,0 00000054 BH L0108 00000055 BE L0109 00000056 LA 4,C'-' 00000057 STORE 4,BB,1 00000058 LPDR 0,0 00000059 STD 0,BDOUB 00000060 L0108 LA &FLOAT$,BDOUB 00000061 LA &RESUL$,IEXP 00000062 CCALL TWOLOG 00000063 L 2,IEXP IEXP IS TWOLOG 00000064 FLOAT 0,IEXP,0 00000065 ME 0,=E'0.30103' =LOG10(2) 00000066 FIX 0,IEXP,0 IEXP IS LOG10 00000067 AR 2,6 TWOLOG OF INTEG MUST BE BETWEEN -1,30. 00000068 *** THIS INCLUDES THE CASE INTEG=.9999999 00000069 BL FLOAT1 NOT IN RANGE FOR INTEGER 00000070 SH 2,=Y(32) 00000071 BL INTEG1 00000072 FLOAT1 SET000 FLAG,0 00000073 B XNUMERH 00000074 L0109 SET000 IEXP,0 COEFF IS A ZERO 00000075 SET000 VALUE,0 00000076 SETVAL FLAG,0,(-,1,0,) 00000077 B XNUMERH 00000078 INTEG1 LOAD 4,BDOUB,0 00000079 LDR 0,4 00000080 FIX 0,VALUE,0 00000081 FLOAT 0,VALUE,0 00000082 LCDR 0,0 00000083 SDR 2,2 00000084 PLUS 00000085 TEST 12 00000086 SETVAL FLAG,0,(-,1,0,) 00000087 LTDR 0,0 00000088 BE XNUMERH CASE OF BDOUB=500 OR 500.0000001 00000089 SETVAL VALUE,0,(+,VALUE,0,+,1,0,) 00000090 FLOAT 0,VALUE,0 CASE OF BDOUB=500.999999999 00000091 LCDR 0,0 00000092 SDR 2,2 00000093 PLUS 00000094 TEST 12 HEX DIGITS 00000095 LTDR 0,0 00000096 BNE FLOAT1 00000097 NUMERH EPI 00000098 *** 00000099 DS 0H 00000100 USING *,15 00000101 TWOLOG L 4,0(&FLOAT$) 00000102 SLL 4,1 00000103 SRL 4,1 00000104 SR 5,5 00000105 SRDL 4,24 R4=EXPONENT. R5=MANTISSA 00000106 SH 4,=Y(64) REMOVE BIAS . IS NOW LOG16 00000107 SLA 4,2 NOW LOG2 00000108 SR 4,6 00000109 LTR 5,5 00000110 BE ZERO1 00000111 SHIFT1 BL EXIT1 00000112 SR 4,6 00000113 SLL 5,1 NORMALIZE EVEN MORE 00000114 LTR 5,5 00000115 B SHIFT1 00000116 ZERO1 L 4,=F'-1000' 00000117 EXIT1 ST 4,0(&RESUL$) 00000118 BR 14 00000119 DROP 15 00000120 *** 00000121 DS 0H 00000122 USING *,15 00000123 TWOILO L 3,0(&FIX$) 00000124 LPR 3,3 00000125 LNR 4,6 00000126 SHIFT2 AR 4,6 00000127 SRA 3,1 00000128 BNE SHIFT2 00000129 ST 4,0(&RESUL$) 00000130 BR 14 00000131 DROP 15 00000132 *** 00000133 &CBUF1 SETC 'CBUF1' 00000134 ./MACRO INNAMM 00000135 ./MACRO UPDATM 00000136 FFOUT 7,'UPDAT' 00000137 LTORG 00000138 *** 00000139 *** 00000140 &NS SETC '-NNS-' 00000141 &NSA SETC '-NNSA-' 00000142 &BUFF1 SETC 'IEP' 00000143 &BUFX SETC 'BUFXX' 00000144 ./MACRO SCHUIFM 00000145 END 00000146 ./A WRONGFTN,INCR=1 00000001 SUBROUTINE WRONG 00000002 C MFOUT(RECOV) NZ PRINTS ERROR MESSAGE AFTER SCHOONSCHIP(SCOPE) ERROR. 00000003 C LAY4(1) NZ CALLS ERROB (=PRINT CINPUT) LAY4(2) NZ PRINTS NAMELISTS 00000004 CALL WRONG1 00000005 RETURN 00000006 END 00000007 SUBROUTINE FOUTA 00000008 ./MACRO BLANK 00000009 COMMON /LAY41/ IEROR(60),ISAVE(37),LAYNM1 00000010 INTEGER AZ,PAS,RECOV 00000011 EXTERNAL CVTIN 00000012 DIMENSION II(2),IPUNCH(37) 00000013 EQUIVALENCE ( IBUF(38),IPUNCH(1) ) 00000014 CALL STORE ( IBUF,0,ISAVE,0,37) 00000015 IBUF(1)=2 00000016 IBUF(2)=0 00000017 IBUF(3)=0 00000018 IF ( ISPLAY ) 4,3,4 00000019 3 CALL STORE (IEROR,0,IBUF,5,20) 00000020 IBUF(4)=20 00000021 AZ=1 00000022 CALL LIJN 00000023 CALL STORE ( IEROR,20,IBUF,5,15) 00000024 IBUF(4)=15 00000025 CALL LIJN 00000026 IBUF(6)=IBUF(5) 00000027 IBUF(7)=IBUF(5) 00000028 CALL STORE ( IPUNCH,2,IBUF,7,8) 00000029 J=15 00000030 GO TO 16 00000031 4 IBUF(6)=IEROR(50) 00000032 IBUF(7)=IEROR(51) 00000033 IBUF(4)=2 00000034 CALL LIJN 00000035 CALL STORE (IPUNCH,2,IBUF,5,8) 00000036 J=13 00000037 16 IF ( IBUF(J) ) 10 , 11 , 10 00000038 C STRIP OFF ZERO WORDS. 00000039 11 J=J-1 00000040 GO TO 16 00000041 10 IBUF(4)=J-5 00000042 CALL LIJN 00000043 IF ( LEVEL ) 2,2,1 00000044 1 IBUF(4)=11 00000045 CALL STORE ( IEROR,51,IBUF,5,7 ) 00000046 CALL UNFC (CVTIN,LEVEL,II) 00000047 IBUF(13)=II(1) 00000048 IBUF(14)=II(2) 00000049 IBUF(15)=IEROR(59) 00000050 IBUF(16)=IEROR(60) 00000051 CALL LIJN 00000052 2 IF ( ISPLAY ) 5,6,5 00000053 6 CALL STORE ( IEROR,35,IBUF,5,14) 00000054 IBUF(4)=14 00000055 CALL LIJN 00000056 NCONT(9)=1 00000057 NCONT(11)=1 00000058 GO TO 7 00000059 5 IBUF(6)=IEROR(50) 00000060 IBUF(7)=IEROR(51) 00000061 IBUF(4)=2 00000062 CALL LIJN 00000063 7 CALL SNOEP 00000064 PAS=0 00000065 IF ( NCONT(8) ) 8,9,8 00000066 8 CALL ERROB 00000067 9 CALL STORE ( ISAVE , 0 , IBUF , 0 , 37 ) 00000068 LEVEL=0 00000069 IF ( RECOV .NE. 0 ) STOP 00000070 RETURN 00000071 END 00000072 SUBROUTINE STORE(IA,NA,IB,NB,M) 00000073 DIMENSION IA(1),IB(1) 00000074 DO 1 I=1,M 00000075 N1=NA+I 00000076 N2=NB+I 00000077 1 IB(N2)=IA(N1) 00000078 RETURN 00000079 END 00000080 SUBROUTINE ERROB 00000081 CALL LOOKPR 00000082 CALL DDUMP 00000083 CALL SNOEP 00000084 RETURN 00000085 END 00000086 ./A WRONG1,INCR=1 00000001 ./MACRO MAINMCRO 00000002 GBLC &OVLAY 00000003 TITLE 'WRONG1' 00000004 ./MACRO INCOM 00000005 ./MACRO MAINCOM 00000006 PRINT NOGEN 00000007 WRONG0 CSECT 00000008 ENTRY WRONG1,DDUMP 00000009 EXTRN FOUTA,ERROB,KIJFPU,WRONGEX,WRONGUI 00000010 WRONG1 PROLOGH 00000011 CMP000 RECOV,0 00000012 BE WRONG3 00000013 MVC IPUNCH+8(32),MSG1 00000014 WRONG2 CCALL FOUTA 00000015 SET000 NCONT,8 00000016 B XWRONG1 00000017 WRONG3 CMP000 MFOUT,0 00000018 BNE WRONG2 00000019 CMP000 LAY4,2 00000020 BE LL001 00000021 CCALL KIJFPU 00000022 LL001 CMP000 LAY4,1 00000023 BE XWRONG1 00000024 CCALL ERROB 00000025 XWRONG1 EPILOGH 00000026 DDUMP PROLOGH 1 00000027 LOAD 1,COMADR,1 ESTABLISH ADDRESSABILITY 00000028 LR 10,1 10 IS A DANGEROUS REG VALUE FOR THE LOAD MACRO 00000029 LOOK$ 'MAIN' 00000030 PRINT$ 'ALIGN',ALIGN,24 00000031 PRINT$ 'AZ',AZ,8 00000032 PRINT$ 'IDAAN',IDAAN,8 00000033 PRINT$ 'LAY1',LAY1,8 00000034 PRINT$ 'MAXID',MAXID,8 00000035 PRINT$ 'MBE',MBE,8 00000036 PRINT$ 'NDIMT',NDIMT,8 00000037 PRINT$ 'NQ1',NQ1,8 00000038 PRINT$ 'NTAP4',NTAP4,8 00000039 PRINT$ 'NVRA',NVRA,8 00000040 PRINT$ 'MMBU',MMBU,8 00000041 PRINT$ 'NMULT',NMULT,8 00000042 PRINT$ 'ITAR1',ITAR1,8 00000043 PRINT$ 'MBR$N',MBR$N,56 00000044 PRINT$ 'MBR$C',MBR$C,16 00000045 PRINT$ 'NCONT',NCONT,16 00000046 PRINT$ 'VOLUM',VOLUM,24 00000047 PRINT$ 'L$AKEY',L$AKEY,24 00000048 PRINT$ 'L$BEGIN',L$BEGIN,24 00000049 PRINT$ 'L$DUMNR',L$DUMNR,16 00000050 PRINT$ 'L$PROP',L$PROP,8 00000051 PRINT$ 'Z$NAME',Z$NAME,40 00000052 PRINT$ 'Z$INDEX',Z$INDEX,16 00000053 PRINT$ 'Z$ARGNR',Z$ARGNR,8 00000054 PRINT$ 'Z$PROP',Z$PROP,8 00000055 PRINT$ 'X$NAME',X$NAME,64 00000056 PRINT$ 'X$INDEX',X$INDEX,16 00000057 PRINT$ 'X$LOCNR',X$LOCNR,8 00000058 PRINT$ 'X$PROP',X$PROP,10 00000059 PRINT$ 'I$NAME',I$NAME,40 00000060 PRINT$ 'I$DUMMY',I$DUMMY,16 00000061 PRINT$ 'I$PROP',I$PROP,8 00000062 PRINT$ 'V$NAME',V$NAME,40 00000063 PRINT$ 'V$DUMMY',V$DUMMY,16 00000064 PRINT$ 'V$PROP',V$PROP,8 00000065 PRINT$ 'S$NAME',S$NAME,40 00000066 PRINT$ 'S$DUMMY',S$DUMMY,16 00000067 PRINT$ 'S$PROP',S$PROP,8 00000068 PRINT$ 'F$NAME',F$NAME,40 00000069 PRINT$ 'F$DUMMY',F$DUMMY,16 00000070 PRINT$ 'F$PROP',F$PROP,8 00000071 PRINT$ 'D$NAME',D$NAME,40 00000072 PRINT$ 'MTAB',MTAB,24 00000073 PRINT$ 'IT',ITIN+360,500,MAIN 00000074 PRINT$ 'ITOUT',ITOUT-32,300 00000075 PRINT$ 'IIEP',IIEP,200 00000076 PRINT$ 'ISCAL',IISCAL,160 00000077 PRINT$ 'IDGEH',IIDGEH,50 00000078 PRINT$ 'BBUFX',BBUFX,24 00000079 PRINT$ 'BUFA1',BUFA1,24 00000080 PRINT$ 'IPR1',IPR1,40 00000081 PRINT$ 'IPR',IPR,80 00000082 PRINT$ 'NS',NS,24 00000083 PRINT$ 'NSA',NSA,24 00000084 PRINT$ 'NID$FST',NID$FST,40 00000085 PRINT$ 'NID$LST',NID$LST,40 00000086 CMP111 LAYNAM$V,0,NE,LL002 00000087 LOOK$ 'IN' 00000088 PRINT$ 'A',A,20 00000089 PRINT$ 'B',B,50 00000090 PRINT$ 'NRFLOAT',NRFLOAT,32 00000091 PRINT$ 'CODE',CODE,20 00000092 PRINT$ 'NR',NR,20 00000093 PRINT$ 'IAL',IAL,20 00000094 PRINT$ 'KTERM',KTERM,20 00000095 PRINT$ 'NORDER',NORDER,20 00000096 PRINT$ 'SYMB1',SYMB1,36 00000097 PRINT$ 'ACHAR5',ACHAR5$C,40 00000098 PRINT$ 'AZPMEM',AZPMEM1,20 00000099 B XDDUMP 00000100 LL002 CMPVAL LAYNAM$V,0,(+,2,0,),NE,LL003 00000101 CCALL WRONGEX 00000102 B XDDUMP 00000103 LL003 CCALL WRONGUI 00000104 XDDUMP EPILOGH 1 00000105 SAVEFTN1 DS 18F 00000106 SAVEFTN DS 18F 00000107 MSG1 DC CL32' RECOVERY FROM SCOPE ERROR' 00000108 LAY41 CSECT 00000109 E1 DC C'0*** SOME INPUT ERROR OR TAPE READ OR WRITE ERROR PR' 00000110 DC C'EVENTS FURTHER EXECUTION. ' 00000111 E21 DC C' THE FOLLOWING MESSAGE MAY BE OF HELP IN FINDING THE' 00000112 DC C' ERROR ' 00000113 E36 DC C'0THE PROGRAM CONTINUES WITH THE NEXT PROBLEM, IF ANY' 00000114 DC C'. ' 00000115 E50 DC C' **ERROR' 00000116 E52 DC C' ***** AT SUBSTITUTION LEVEL' 00000117 E59 DC C' ***** ' 00000118 ISAVE DS 37F 00000119 LAYNM1 DC 1F'0' 00000120 END 00000121 ./A WRONG2,INCR=1 00000001 ./MACRO MAINMCRO 00000002 GBLC &OVLAY 00000003 TITLE 'WRONG2' 00000004 ./MACRO MAINCOM 00000005 ./MACRO EXECCOM 00000006 PRINT NOGEN 00000007 WRONG2 CSECT 00000008 ENTRY WRONGEX 00000009 WRONGEX PRO 00000010 LOOK$ 'EXEC' 00000011 PRINT$ 'BASE1',BASE1,16 00000012 PRINT$ 'ADRIEP',ADRIEP,8 00000013 PRINT$ 'A0',A0,8 00000014 PRINT$ 'BACK',BACK,8 00000015 PRINT$ 'DEPTH',DEPTH,8 00000016 PRINT$ 'EXPO1',EXPO1,8 00000017 PRINT$ 'FLAG',FLAG,8 00000018 PRINT$ 'II5',II5,8 00000019 PRINT$ 'JVA5',JVA5,8 00000020 PRINT$ 'JVA',JVA,8 00000021 PRINT$ 'K3',K3,8 00000022 PRINT$ 'KEY$NEW',KEY$NEW,8 00000023 PRINT$ 'M',M,8 00000024 PRINT$ 'MBE5',MBE5,8 00000025 PRINT$ 'NDUMY',NDUMY,8 00000026 PRINT$ 'NEW5',NEW5,8 00000027 PRINT$ 'OPR5',OPR5,8 00000028 PRINT$ 'ROUND5',ROUND5,8 00000029 PRINT$ 'SYMBOL1',SYMBOL1,8 00000030 PRINT$ 'S1XR4',S1XR4,8 00000031 PRINT$ 'NAME5',NAME5,8 00000032 PRINT$ 'ARRAY5',ARRAY5,8 00000033 PRINT$ 'LOOPVAR1',LOOPVAR1,8 00000034 PRINT$ 'ISWIH1',ISWIH1,16 00000035 PRINT$ 'H$MULT',H$MULT,40 00000036 PRINT$ 'H$MBE',H$MBE,40 00000037 PRINT$ 'H$MBU',H$MBU,40 00000038 PRINT$ 'IDUM1',IDUM1,16 00000039 PRINT$ 'R$RETUR',R$RETUR,40 00000040 PRINT$ 'R$A0',R$A0,40 00000041 PRINT$ 'R$DUMPT',R$DUMPT,40 00000042 PRINT$ 'R$BASE',R$BASE,40 00000043 PRINT$ 'G$MBE',G$MBE,40 00000044 PRINT$ 'G$RETUR',G$RETUR,40 00000045 PRINT$ 'G$INDEX',G$INDEX,40 00000046 PRINT$ 'P$POINT',P$POINT,80 00000047 PRINT$ 'P$EXPR',P$EXPR,80 00000048 PRINT$ 'IEP',IEP,80 00000049 WRONGEX EPI 00000050 END 00000051 ./A WRONG3,INCR=1 00000001 ./MACRO MAINMCRO 00000002 GBLC &OVLAY 00000003 TITLE 'WRONG3' 00000004 ./MACRO MAINCOM 00000005 ./MACRO UITCOM 00000006 PRINT NOGEN 00000007 WRONG3 CSECT 00000008 ENTRY WRONGUI 00000009 WRONGUI PRO 00000010 LOOK$ 'UIT' 00000011 PRINT$ 'BDOUB',BDOUB,8 00000012 PRINT$ 'FLAG',FLAG,8 00000013 PRINT$ 'A0',A0,8 00000014 PRINT$ 'CODE2',CODE2,8 00000015 PRINT$ 'FNR',FNR,8 00000016 PRINT$ 'INDEX5',INDEX5,0 00000017 PRINT$ 'JVA5',JVA5,8 00000018 PRINT$ 'LENGTH5',LENGTH5,8 00000019 PRINT$ 'LOC5',LOC5,8 00000020 PRINT$ 'NFIRST',NFIRST,8 00000021 PRINT$ 'NREC5',NREC5,8 00000022 PRINT$ 'SYMBOL',SYMBOL,8 00000023 PRINT$ 'TUS2',TUS2,8 00000024 PRINT$ 'NURI$FIL',NURI$FIL,8 00000025 PRINT$ 'DCONT1',DCONT1,8 00000026 PRINT$ 'BB',BB,8 00000027 PRINT$ 'BC1',BC1,32 00000028 PRINT$ 'LOOPVAR1',LOOPVAR1,8 00000029 PRINT$ 'NNS',NNS,24 00000030 PRINT$ 'NNSA',NNSA,24 00000031 PRINT$ 'BUFXX',BUFXX,24 00000032 PRINT$ 'IEP',IEP,24 00000033 PRINT$ 'CBUF1',CBUF1,24 00000034 WRONGUI EPI 00000035 END 00000036