// JOB APCP0001 // ASM APCP0002 *LIST APCP0003 *PRINT SYMBOL TABLE APCP0004 HDNG PREPROLOGUE TO COPY ASSEMBLY APCP0005 ABS APCP0006 * DISK ADDRESSES APCP0007 LCDBS EQU /280 APCP0008 STTRK EQU LCDBS APCP0009 TMTRK EQU LCDBS+/1A APCP0010 TMTRX EQU LCDBS+/6E APCP0011 DACPY EQU LCDBS+/3F APCP0012 * ORIGINS OF THIS AND OTHER ASSEMBLIES APCP0013 ASMCP EQU /730 APCP0014 ASMDK EQU /0 APCP0015 ASMCT EQU /21E APCP0016 * OVERLAY NUMBER OF THIS ASSEMBLY APCP0017 CPYOV EQU 16 APCP0018 * IMPORTANT ADDRESSES APCP0019 FOUND EQU /F9F APCP0020 CLASS EQU /FA0 APCP0021 PARAM EQU /FA2 APCP0022 LOCOR EQU /1000 APCP0023 NEXEN EQU /5 APCP0024 EGBTB EQU /14 APCP0025 MATRX EQU /1011 CORE AD OF ACTIVE MSP APCP0026 LENGL EQU /1011 APCP0027 GRBCL EQU /1018 APCP0028 MSTRT EQU /1013 APCP0029 MNEXT EQU /1014 APCP0030 PAREL EQU /1017 APCP0031 GLSTB EQU /101C APCP0032 NUMGL EQU /1012 APCP0033 STUAD EQU /1015 APCP0034 SOLPT EQU /1016 APCP0035 GLBTB EQU /1036 APCP0036 LNDRD EQU /1F7E APCP0037 FNDPL EQU /1FEC APCP0038 CHRCT EQU /1FF9 APCP0039 MODE EQU /1FF4 APCP0040 MGCOL EQU /1FFE APCP0041 FGCOL EQU /1FFF APCP0042 * ADDRESSES IN CTRAY ASSEMBLY APCP0043 ERRXT EQU ASMCT+/37 APCP0044 ABSAD EQU ASMCT+/A8 APCP0045 SVOVL EQU ASMCT+/0C8 APCP0046 FSYL EQU ASMCT+/CB APCP0047 PSYL EQU ASMCT+/D5 APCP0048 GSYL EQU ASMCT+/DE APCP0049 CLOMN EQU ASMCT+/153 APCP0050 GETSP EQU ASMCT+/160 APCP0051 TYPE EQU ASMCT+/1A9 APCP0052 PRCRT EQU ASMCT+/1D1 APCP0053 PRNID EQU ASMCT+/1E3 APCP0054 SGBTB EQU ASMCT+/207 APCP0055 TSTUT EQU ASMCT+/4EE APCP0056 * ADDRESSES IN DISK I/O ASSEMBLY APCP0057 DKORG EQU ASMDK+/2C APCP0058 * ADDRESSES USED IN OTHER ASSEMBLIES APCP0059 DC COPY-ASMCP APCP0060 DC PCOPY-ASMCP APCP0061 DC DGCOL-ASMCP APCP0062 DC ERASE-ASMCP APCP0063 * LENGTH OF THIS ASSEMBLY APCP0064 DC LNGTH APCP0065 ORG ASMCP-2 APCP0066 DC 5*/140 APCP0067 DC DACPY APCP0068 DC CPYOV APCP0069 HDNG ENTRY POINTS APCP0070 COPY DC 0 APCP0071 BSC L SCOPY APCP0072 PCOPY DC 0 APCP0073 BSC L SPCPY APCP0074 DGCOL DC 0 APCP0075 BSC L SDGCL APCP0076 ERASE DC 0 APCP0077 BSC L SERSE APCP0078 HDNG INTERNAL SYMBOLS AND LOCATIONS APCP0079 PARID EQU PARAM+10 APCP0080 TLNC EQU 26*/140 APCP0081 IMTRX EQU MATRX+1920 CORE AD OF INACTIVE MSP APCP0082 MLNC EQU IMTRX-MATRX APCP0083 STORG EQU /2080 APCP0084 LNDRC EQU /BFC APCP0085 CBUF EQU /C30 APCP0086 CODE2 EQU /D70 APCP0087 CODE3 EQU /EB0 APCP0088 GBSUB EQU /1006 APCP0089 * APCP0090 A EQU 1 APCP0091 B EQU 2 APCP0092 C EQU 3 APCP0093 D EQU 4 APCP0094 E EQU 5 APCP0095 F EQU 6 APCP0096 G EQU 7 APCP0097 H EQU 8 APCP0098 I EQU 9 APCP0099 J EQU 10 APCP0100 K EQU 11 APCP0101 L EQU 12 APCP0102 M EQU 13 APCP0103 N EQU 14 APCP0104 O EQU 15 APCP0105 P EQU 16 APCP0106 Q EQU 17 APCP0107 R EQU 18 APCP0108 S EQU 19 APCP0109 T EQU 20 APCP0110 U EQU 21 APCP0111 V EQU 22 APCP0112 W EQU 23 APCP0113 X EQU 24 APCP0114 Y EQU 25 APCP0115 Z EQU 26 APCP0116 SPC EQU 38 SPACE APCP0117 P1 EQU 1600 APCP0118 P2 EQU 40 APCP0119 HDNG ROUTINES FOR PRINTING MESSAGES APCP0120 * BEFORE RETURN FROM COPY COMMAND APCP0121 GRCLF LDX L1 GBSUB APCP0122 BSI L DGBMN APCP0123 BSI XTMSG APCP0124 LDX 1 8 APCP0125 MDX FLXT APCP0126 GTSPF BSI XTMSG APCP0127 LDX 1 9 APCP0128 FLXT BSC L ERRXT APCP0129 XTMSG DC 0 APCP0130 LDX L1 GLBTB+MLNC-4 APCP0131 STX L1 GBPTR APCP0132 STX 1 MGFLG APCP0133 LD L NUMGL+MLNC APCP0134 STO XTMGC APCP0135 XTMG1 LDX L2 GBPTR APCP0136 BSI UPGBP APCP0137 LD 1 0 APCP0138 SRA 12 APCP0139 BSC L NDNCM,+- APCP0140 LD 1 1 APCP0141 BSC L NDNCM,+Z APCP0142 XTMG2 MDX L XTMGC,-1 APCP0143 MDX XTMG1 APCP0144 BSI NDCRT APCP0145 BSC I XTMSG APCP0146 NDNCM LDX L2 NCPDM APCP0147 MDX 1 2 APCP0148 BSI NDMG APCP0149 MDX XTMG2 APCP0150 XTMGC DC 0 APCP0151 NDCRT DC 0 APCP0152 LD MGFLG APCP0153 BSC I NDCRT,Z APCP0154 BSI L PRCRT APCP0155 BSC I NDCRT APCP0156 UPGBP DC 0 APCP0157 LD 2 0 APCP0158 STO L 1 APCP0159 UPGB1 MDX 1 4 APCP0160 LD 1 0 APCP0161 BSC L UPGB1,+- APCP0162 LD L 1 APCP0163 STO 2 0 APCP0164 BSC I UPGBP APCP0165 HDNG PRINTS TEXT IF NEEDED AND THE ID APCP0166 * X1 POINTS ID APCP0167 * X2 POINTS TEXT APCP0168 * MGFLG NON-ZERO IF TEXT NEEDED APCP0169 NDMG DC 0 APCP0170 STX 1 MGID+1 APCP0171 LD MGFLG APCP0172 BSC L NDMG1,+- APCP0173 SRA 16 APCP0174 STO MGFLG APCP0175 LD 2 0 APCP0176 STO L 1 APCP0177 MDX 2 1 APCP0178 BSI L PRNID APCP0179 NDMG1 LD L CHRCT APCP0180 S DC110 APCP0181 BSC L NDMG2,+ APCP0182 BSI L PRCRT APCP0183 NDMG2 LDX L1 MGCBL APCP0184 BSI L TYPE APCP0185 MGID LDX L2 *-* APCP0186 LDX 1 2 APCP0187 BSI L PRNID APCP0188 BSC I NDMG APCP0189 MGCBL DC /78 APCP0190 DC110 DC 110 APCP0191 MGFLG DC 0 APCP0192 NFMGT DC 4 APCP0193 DC N*P1+O*P2+T APCP0194 DC SPC*P1+F*P2+O APCP0195 DC U*P1+N*P2+D APCP0196 DC SPC*P1+SPC*P2+SPC APCP0197 NCPDM DC 4 APCP0198 DC N*P1+O*P2+T APCP0199 DC SPC*P1+C*P2+O APCP0200 DC P*P1+I*P2+E APCP0201 DC D*P1+SPC*P2+SPC APCP0202 GRBTX DC F*P1+U*P2+N APCP0203 DC C*P1+T*P2+I APCP0204 DC O*P1+N*P2+S APCP0205 DNETX DC SPC*P1+C*P2+O APCP0206 DC M*P1+P*P2+A APCP0207 DC C*P1+T*P2+E APCP0208 DC D APCP0209 HDNG DISK GARBAGE COLLECT APCP0210 PSPAR BSS 3 APCP0211 SPSYL DC 0 APCP0212 STKPT DC 0 APCP0213 DEFSW DC 0 APCP0214 DGCLC DC 0 APCP0215 GBMPT DC 0 APCP0216 GBTBP DC 0 APCP0217 SDGCL STX 1 PSPAR APCP0218 STX 2 PSPAR+1 APCP0219 STX 3 PSPAR+2 APCP0220 LD L PSYL APCP0221 STO SPSYL APCP0222 LDX 1 3 APCP0223 LDX L2 GRBTX APCP0224 BSI L PRNID APCP0225 LD L SVOVL APCP0226 S L ASMCP APCP0227 BSC L DGCL0,Z APCP0228 LDX L1 GBSUB APCP0229 BSI L DGBMN APCP0230 DGCL0 LDX L1 STTRK APCP0231 BSI L DOTST APCP0232 LDX L1 STORG APCP0233 STX L1 BPTR APCP0234 LD L NUMGL APCP0235 BSC L DGIMX,+ APCP0236 STO DGCLC APCP0237 LDX L1 GLBTB-4 APCP0238 STX 1 GBTBP APCP0239 LD L MODE APCP0240 STO DEFSW APCP0241 DGCL1 LDX L2 GBTBP APCP0242 BSI UPGBP APCP0243 LD 1 0 APCP0244 BSC L DGSTP,- APCP0245 LD DEFSW APCP0246 BSC L DGCL2,- APCP0247 LD L FNDPL+4 APCP0248 S GBTBP MODE APCP0249 BSC L DGDFM,+- COPY FN IN DEF MODE APCP0250 DGCL2 LD 1 0 APCP0251 BSI L DRDLN APCP0252 BSI L LDCPF APCP0253 LDX I2 GBMPT ADDRESS OF FN MENTRY APCP0254 LD L BPTR APCP0255 STO 2 2 APCP0256 ADJST LD L PAREL RELATIVE PTR TO TOP OF STACK APCP0257 ADJS1 BSI L ABSAD APCP0258 LD 1 0 APCP0259 SLA 4 APCP0260 BSC L DGSTP,+- APCP0261 LD 1 0 APCP0262 SRA 12 APCP0263 BSC L ADJS3,Z GO ON TO NEXT LEVEL IF IMEX,APCP0264 * QUAD, OR QUAD PRIME APCP0265 LD 1 3 APCP0266 S GBTBP APCP0267 BSC L ADJS3,Z APCP0268 LD 1 4 APCP0269 STO OSTLN APCP0270 LD 1 2 APCP0271 SRA 8 BITS APCP0272 STO L 3 APCP0273 MDX L3 LNDRC APCP0274 LD 3 0 NEW START OF LINE ADDRESS APCP0275 BSI NSTKP APCP0276 ADJS3 LD 1 0 APCP0277 MDX ADJS1 APCP0278 DGDFM LDX I1 FNDPL+5 APCP0279 LD 1 2 APCP0280 STO L LNCNT APCP0281 LDX L1 LNDRD APCP0282 BSI L TRANF APCP0283 LDX L1 CPYPT APCP0284 BSI L FSYL APCP0285 DGSTP MDX L DGCLC,-1 APCP0286 MDX DGCL1 APCP0287 DGIMX LDX 1 1 APCP0288 STX L1 LNCNT APCP0289 LDX I1 PAREL APCP0290 DGCL4 LD 1 0 APCP0291 SLA 4 APCP0292 BSC L DGINP,+- APCP0293 DGCL5 LD 1 0 APCP0294 BSI L ABSAD APCP0295 STO L STKPT APCP0296 LD 1 0 APCP0297 SRA 12 APCP0298 BSC L DGCL4,+- APCP0299 LD 1 4 APCP0300 STO OSTLN APCP0301 MDX 1 4 APCP0302 BSI L TRANF APCP0303 LDX I1 STKPT APCP0304 LD 1 4 APCP0305 BSI NSTKP APCP0306 MDX DGCL4 APCP0307 DGINP LD L SOLPT APCP0308 STO OSTLN APCP0309 LD L BPTR APCP0310 STO L SOLPT APCP0311 LD OSTLN APCP0312 BSC L DGXT,+- APCP0313 SLA 1 MULTIPLYS BY 2 AND GETS RID APCP0314 STO L SLCNT APCP0315 LD OSTLN APCP0316 A L CTLNC APCP0317 OR L H8000 APCP0318 STO L CPPTR APCP0319 BSI L RVSGP APCP0320 DGXT LDX L1 CPYPT APCP0321 BSI L FSYL APCP0322 LD L BPTR APCP0323 STO L STUAD APCP0324 LDX 1 4 APCP0325 LDX L2 DNETX APCP0326 BSI L PRNID APCP0327 BSI L PRCRT APCP0328 LD L SPSYL APCP0329 STO L GSYL APCP0330 LDX I1 PSPAR APCP0331 LDX I2 PSPAR+1 APCP0332 LDX I3 PSPAR+2 APCP0333 SRA 16 APCP0334 STO L GRBCL APCP0335 STO I1 3 APCP0336 LD L SVOVL APCP0337 S L ASMCP APCP0338 BSC I DGCOL,Z APCP0339 BSC L CPYFN APCP0340 HDNG SET NEW PTRS IN STACK APCP0341 NSTKP DC 0 APCP0342 STO 1 4 APCP0343 S OSTLN APCP0344 A 1 1 APCP0345 STO 1 1 APCP0346 BSC I NSTKP APCP0347 OSTLN DC 0 APCP0348 HDNG LOAD OR STORE 6 SECTORS (MATRIX) APCP0349 * X1 IS THE DISK ADDRESS APCP0350 * X2 IS THE CORE ADDRESS APCP0351 SLMSP DC 0 APCP0352 STX 1 SLM01 APCP0353 STX 2 SLM02 APCP0354 BSI L DKORG APCP0355 SLM01 DC 0 APCP0356 SLM02 DC 0 APCP0357 DC 6 APCP0358 DC /140 APCP0359 BSC I SLMSP APCP0360 HDNG DO TRANSFER OF STUDENT TRACK TO TMTRK APCP0361 DOTST DC 0 APCP0362 STX 1 FROM+1 APCP0363 LDX 1 0 APCP0364 LDX 2 /20 APCP0365 SV20A LDD L1 /FF0 APCP0366 STD L1 LNDRC APCP0367 MDX 1 2 APCP0368 MDX 2 -2 APCP0369 MDX SV20A APCP0370 LDS 2 APCP0371 LDX L1 TMTRX APCP0372 LDX L2 MATRX APCP0373 BSI SLMSP APCP0374 FROM LDX L1 *-* APCP0375 LDX L2 TMTRK APCP0376 LDX L3 CODE2 APCP0377 BSI L TSTUT APCP0378 LDS 1 APCP0379 LDX L1 TMTRX APCP0380 LDX L2 MATRX APCP0381 BSI SLMSP APCP0382 LDX 1 0 APCP0383 LDX 2 /20 APCP0384 RS20A LDD L1 LNDRC APCP0385 STD L1 /FF0 APCP0386 MDX 1 2 APCP0387 MDX 2 -2 APCP0388 MDX RS20A APCP0389 BSC I DOTST APCP0390 HDNG GET WORD FROM DISK APCP0391 GTWD DC 0 APCP0392 LDX L1 CPYGT APCP0393 BSI L GSYL APCP0394 LD CPYCH APCP0395 SLA 8 APCP0396 STO GTWD1 APCP0397 LDX L1 CPYGT APCP0398 BSI L GSYL APCP0399 LD CPYCH APCP0400 OR GTWD1 APCP0401 BSC I GTWD APCP0402 GTWD1 DC 0 APCP0403 HDNG PUT WORD TO DISK APCP0404 PTWD DC 0 APCP0405 RTE 8 TOP HALF OF WD IS JUNK APCP0406 STO PTWD1 APCP0407 SLT 8 APCP0408 STO CPYCH APCP0409 LDX L1 CPYPT APCP0410 BSI L PSYL APCP0411 LD PTWD1 APCP0412 STO CPYCH APCP0413 LDX L1 CPYPT APCP0414 BSI L PSYL APCP0415 BSC I PTWD APCP0416 PTWD1 DC 0 APCP0417 HDNG SET DRDSA AND LNCNT APCP0418 DRDLN DC 0 APCP0419 BSI L ABSAD APCP0420 STO L GBMPT APCP0421 LD 1 2 APCP0422 A CTLNC APCP0423 STO DRDSA APCP0424 LD 1 3 APCP0425 AND H00FF APCP0426 STO LNCNT APCP0427 BSC I DRDLN APCP0428 H00FF DC /FF APCP0429 HDNG READ LINE DIRECTORY AND COUNTS APCP0430 RLNDR DC 0 APCP0431 LD LNCNT APCP0432 A L VAL2 APCP0433 STO LNDC APCP0434 LDX L1 LNDRC APCP0435 STX 1 LNADP APCP0436 LD DRDSA APCP0437 STO CPPTR APCP0438 RLND1 BSI GTWD APCP0439 STO I LNADP APCP0440 MDX L LNADP,1 APCP0441 MDX L LNDC,-1 APCP0442 MDX RLND1 APCP0443 LD LNADP APCP0444 STO LNADE APCP0445 BSC I RLNDR APCP0446 HDNG WRITE COUNTS AND LINE DIRECTORY APCP0447 WLNDR DC 0 APCP0448 LD LNCNT APCP0449 A L VAL2 APCP0450 STO LNDC APCP0451 WLND1 MDX L LNADE,-1 APCP0452 LD I LNADE APCP0453 BSI PTWD APCP0454 MDX L LNDC,-1 APCP0455 MDX WLND1 APCP0456 BSC I WLNDR APCP0457 CBUFP DC 0 APCP0458 RCBUF DC CBUF APCP0459 CPYGT DC CPYCH APCP0460 DC CPPTR APCP0461 DC CODE3 APCP0462 DC CSEG3 APCP0463 CPYCH DC 0 APCP0464 CPYPT DC CPYCH APCP0465 DC BPTR APCP0466 DC CODE2 APCP0467 DC CSEG2 APCP0468 HDNG CONTROL TRANSFER OF FUNCTION APCP0469 LDCPF DC 0 APCP0470 BSI RLNDR APCP0471 LDX L1 LNDRC APCP0472 BSI TRANF APCP0473 BSI TDIR APCP0474 BSI WLNDR APCP0475 BSC I LDCPF APCP0476 CTLNC DC TLNC APCP0477 LNDC DC 0 APCP0478 LNADP DC 0 APCP0479 LNADE DC 0 APCP0480 LNCNT DC 0 APCP0481 DRDSA DC 0 APCP0482 CPPTR DC 0 APCP0483 HDNG TRANSFER LINES OF FUNCTION APCP0484 * X1 POINTS STTRK DISK ADDRESS OF FIRST LINE APCP0485 * LNCNT CONTAINS NUMBER OF LINES TO BE TRANSFERED APCP0486 * USING THE STTRK DISK ADDRESS THE LINE IS READ APCP0487 * INTO BUFFER CBUF FROM THE TMTRK UNTIL A APCP0488 * REAL METACOLON IS HIT APCP0489 * THEN IT IS PUT TO THE STTRK USING BPTR APCP0490 TRANF DC 0 X1 IS LNDRC EXCEPT WHEN DGCOLAPCP0491 STX 1 LNADP WHEN IT IS LNDRD APCP0492 LD LNCNT CONTAINS NUMBER OF LINES APCP0493 STO LNDC APCP0494 LD RCBUF APCP0495 STO CBUFP APCP0496 TRAN1 LD I LNADP APCP0497 AND L H7FFF GET RID OF TRACE BIT APCP0498 A CTLNC APCP0499 STO CPPTR APCP0500 TRAN8 EQU * APCP0501 SRA 16 APCP0502 STO TFLG APCP0503 TRAN3 STO METCK APCP0504 TRAN2 LDX L1 CPYGT APCP0505 BSI L GSYL APCP0506 LD CPYCH APCP0507 STO I CBUFP APCP0508 MDX L CBUFP,1 APCP0509 STO L 1 APCP0510 S CMETA APCP0511 BSC L TRAN4,Z APCP0512 LD METCK APCP0513 BSC L TRAN7,+ APCP0514 TRAN4 LD TFLG APCP0515 BSC L TRAN5,+ APCP0516 MDX L METCK,-1 APCP0517 NOP APCP0518 MDX L TFLG,-1 APCP0519 MDX TRAN2 APCP0520 MDX TRAN8 APCP0521 TRAN5 BSC L TRAN6,- APCP0522 EOR XFFFF APCP0523 M L 1 APCP0524 SLT 16 APCP0525 STO TFLG APCP0526 MDX TRAN2 APCP0527 TRAN6 MDX 1 -/25 APCP0528 MDX TRAN2 APCP0529 MDX 1 4 APCP0530 MDX TRAN2 APCP0531 LD L1 VAL2 APCP0532 STO TFLG APCP0533 LD L1 MTCNT APCP0534 MDX TRAN3 APCP0535 TRAN7 EQU * APCP0536 LD CBUFP APCP0537 S RCBUF APCP0538 STO PCBCT APCP0539 TPCB1 MDX L CBUFP,-1 APCP0540 LD I CBUFP APCP0541 STO CPYCH APCP0542 LDX L1 CPYPT APCP0543 BSI L PSYL APCP0544 MDX L PCBCT,-1 MIGHT GO TO GC APCP0545 MDX TPCB1 APCP0546 LD I LNADP APCP0547 AND H8000 APCP0548 OR L BPTR APCP0549 STO I LNADP APCP0550 MDX L LNADP,1 APCP0551 MDX L LNDC,-1 APCP0552 MDX TRAN1 APCP0553 BSC I TRANF APCP0554 VAL1 DC 1 APCP0555 VAL6 DC 6 APCP0556 TFLG DC 0 APCP0557 PCBCT DC 0 APCP0558 BPTR DC 0 APCP0559 METCK DC 0 APCP0560 CMETA DC /62 APCP0561 * FOLLOWING EIGHT CARDS MUST BE IN THIS ORXER APCP0562 VAL2 DC 2 CARD 1 APCP0563 VAL4 DC 4 CARD 2 APCP0564 DC -5 CARD 3 APCP0565 DC -2 CARD 4 APCP0566 MTCNT DC 2 CARD 5 APCP0567 DC /7FFF CARD 6 APCP0568 DC /7FFF CARD 7 APCP0569 DC /7FFF CARD 8 APCP0570 XFFFF DC /FFFF APCP0571 HDNG TRANSFER OTHER DIRECTORIES APCP0572 TDIR DC 0 APCP0573 LDX I1 LNADE APCP0574 LD 1 -2 APCP0575 A 1 -2 APCP0576 A 1 -2 APCP0577 A 1 -1 APCP0578 A 1 -1 APCP0579 A VAL6 APCP0580 SLA 1 APCP0581 STO SLCNT NUMBER OF SYLS TO GET/PUT APCP0582 SRA 1 APCP0583 A VAL2 APCP0584 A LNCNT APCP0585 A DRDSA APCP0586 OR H8000 APCP0587 STO CPPTR ARG FOR GSYL APCP0588 BSI RVSGP APCP0589 BSC I TDIR APCP0590 RVSGP DC 0 APCP0591 RVGP1 MDX L CPPTR,-1 APCP0592 NOP APCP0593 LDX L1 CPYGT APCP0594 BSI L GSYL APCP0595 LDX L1 CPYPT APCP0596 BSI L PSYL APCP0597 MDX L SLCNT,-1 APCP0598 MDX RVGP1 APCP0599 BSC I RVSGP APCP0600 SLCNT DC 0 APCP0601 H8000 DC /8000 APCP0602 HDNG COPY FUNCTION CONTROL APCP0603 CPYFN LD L FCNT APCP0604 BSC L CPYFX,+ APCP0605 LDX I1 WSDSA APCP0606 BSI L DOTST APCP0607 SRA 16 APCP0608 STO CSEG2 NOTHING IN GET OR PUT APCP0609 STO CSEG3 BUFFERS APCP0610 LDX L3 GLBTB+MLNC-4 APCP0611 STX L3 GBPTR APCP0612 CPYF1 MDX L GBPTR,4 APCP0613 LDX I3 GBPTR APCP0614 LD 3 1 APCP0615 BSC L CPYF1,- APCP0616 BSI STFGB APCP0617 LDX I3 GBPTR APCP0618 LD 3 0 APCP0619 A CMLNC APCP0620 BSI L DRDLN APCP0621 LD L STUAD APCP0622 STO BPTR APCP0623 BSI L LDCPF APCP0624 LDX L1 CPYPT APCP0625 BSI L FSYL APCP0626 LD L BPTR APCP0627 STO L STUAD APCP0628 STO L SOLPT APCP0629 LDX I2 FGB05+1 APCP0630 STO 2 2 APCP0631 LDX I3 GBPTR APCP0632 LD 3 1 APCP0633 AND L H7FFF APCP0634 STO 3 1 APCP0635 MDX L FCNT,-1 APCP0636 MDX CPYF1 APCP0637 CPYFX BSI L XTMSG APCP0638 BSI L SQEEZ APCP0639 BSC I COPY APCP0640 CSEG2 DC 0 APCP0641 CSEG3 DC 0 APCP0642 HDNG TRANSFER M ENTRY AND SET UP GBTB ENTRYAPCP0643 CMLNC DC MLNC APCP0644 STFGB DC 0 APCP0645 LDX L1 GBSUB APCP0646 LDD 3 2 X3 POINYS OLD GBTB ENTRY APCP0647 STD 1 0 APCP0648 LD 3 0 APCP0649 A CMLNC PTS TO GBTB IN IMS APCP0650 STO 1 5 APCP0651 * APCP0652 STX 1 FGB02+1 SEARCH GLOBAL TABLE APCP0653 BSI L SGBTB FOR ID APCP0654 LD 1 4 WAS IT FOUND APCP0655 BSC L FGB01,Z BRANCH IF YES APCP0656 BSI L AGBTB IF NOT, ADD ID TO APCP0657 MDX FGB02 GLOBAL TABLE. APCP0658 FGB01 STO L 2 ID WAS FOUND. APCP0659 LD 2 0 FIND M ENTRY OF THIS APCP0660 BSI L ABSAD ID APCP0661 LD L HFFFF APCP0662 STO 1 0 GARBAGE APCP0663 SRA 16 ZERO OUT M PTR IN GLOBAL APCP0664 STO 2 0 ENTRY APCP0665 * APCP0666 FGB02 LDX L1 *-* FIND AND SAVE APCP0667 LD 1 5 ADDRESS APCP0668 BSI L ABSAD OF OLD APCP0669 STX 1 FGB03+1 M ENTRY APCP0670 LDX I3 1 APCP0671 BSI L CLOMN ENTRY APCP0672 STO DIMNS APCP0673 BSI L GETSP GET SPACE FOR NEW ENTRY APCP0674 STX 1 FGB05+1 SAVE ADDRESS APCP0675 * APCP0676 FGB03 LDX L2 *-* TRANSFER OLD M ENTRY APCP0677 FGB04 LDD 2 0 TO POSITION IN APCP0678 STD 1 0 M MATRIX APCP0679 MDX 2 2 APCP0680 MDX 1 2 APCP0681 MDX L DIMNS,-2 APCP0682 MDX FGB04 APCP0683 * APCP0684 FGB05 LDX L2 *-* ADDRESS OF NEW M ENTRY APCP0685 LDX I1 FGB02+1 ADDRESS OF PARAMETER APCP0686 * LIST APCP0687 LD 1 4 STORE APCP0688 SRT 12 SYPTR APCP0689 LD 2 0 IN FIRST WORD APCP0690 SRA 12 OF APCP0691 SLT 12 M ENTRY APCP0692 STO 2 0 APCP0693 * APCP0694 LD L 2 STORE CLASS APCP0695 SRT 12 AND APCP0696 LD 1 5 MPTR APCP0697 SRA 12 IN GLOBAL APCP0698 SLT 12 TABLE APCP0699 STO I1 4 ENTRY APCP0700 * APCP0701 STO 1 5 STORE NEW M PTR IN APCP0702 * PARAMETER LIST APCP0703 BSC I STFGB APCP0704 HDNG ADD IDENTIFIER TO GLOBAL TABLE APCP0705 * X1 CONTAINS POINTER TO PARAMETER LIST APCP0706 AGBTB DC 0 APCP0707 STX 1 AGB09+1 SAVE X1 APCP0708 LD L LENGL TABLE APCP0709 S L NUMGL IS FULL APCP0710 BSC L AGB03,+ IS FULL APCP0711 * APCP0712 LDX L1 GLBTB ADDRESS OF GLOBAL TABLE APCP0713 AGB01 LD 1 0 APCP0714 BSC L AGB08,+- APCP0715 MDX 1 4 APCP0716 MDX AGB01 APCP0717 * APCP0718 AGB03 LD NEGBT APCP0719 BSI L GETSP FOR MORE GLOBALS APCP0720 * APCP0721 LD L MNEXT ADDRESS OF PREVIOUS APCP0722 S NEGBT END OF APCP0723 STO L 2 M MATRIX APCP0724 S L MSTRT NUMBER OF WORDS TO BE APCP0725 STO L 3 MOVED DOWN TO MAKE APCP0726 * ROOM FOR ADDITIONAL APCP0727 * GLOBAL TABLE ENTRIES APCP0728 STO LNGTB LENGTH OF TABLE APCP0729 MDX L LENGL,NEXEN ADVANCE COUNT OF ENTRIES APCP0730 * IN TABLE APCP0731 AGB04 LDD 2 -2 MOVE NEXT DOUBLE WORD APCP0732 STD 2 EGBTB-2 DOWN APCP0733 * APCP0734 MDX 2 -2 ADJUST ADDRESS APCP0735 MDX 3 -2 COUNT WORDS APCP0736 MDX AGB04 CONTINUE IF MORE APCP0737 * APCP0738 STX 2 NGBTB NEXT GLOBAL ENTRY APCP0739 LDX 3 EGBTB NUMBER OF EXTRA WORDS APCP0740 SLT 32 IN GLOBAL TABLE APCP0741 AGB05 STD 2 0 ZERO OUT GLOBAL ENTRIES APCP0742 MDX 2 2 ADJUST ADDRESS APCP0743 MDX 3 -2 COUNT NUMBER OF WORDS APCP0744 MDX AGB05 CONTINUE IF MORE APCP0745 * APCP0746 STX L2 MSTRT NEW START OF M MATRIX APCP0747 * APCP0748 * APCP0749 AGB06 LD 2 0 BRANCH IF THIS ENTRY APCP0750 BSC L AGB07,+Z IS GARBAGE APCP0751 BSI L ABSAD IF NOT CONVERT TO 1130 APCP0752 * ADDRESS APCP0753 LD L 2 ADDRESS OF THIS ENTRY APCP0754 SRT 12 APCP0755 LD 1 0 PLACE NEW ADDRESS APCP0756 SRA 12 IN RELEVANT APCP0757 SLT 12 SYPTR APCP0758 STO 1 0 APCP0759 AGB07 STX L2 3 APCP0760 BSI L CLOMN APCP0761 STO DIMNS APCP0762 * ADVANCE TO NEXT APCP0763 MDX I2 DIMNS ENTRY APCP0764 LD LNGTB ADJUST COUNT OF WORDS APCP0765 S DIMNS IN MATRIX APCP0766 STO LNGTB APCP0767 BSC L AGB06,-Z CONTINUE IF MORE APCP0768 MDX AGB09 BRANCH OUT IF NOT APCP0769 AGB08 STX 1 NGBTB APCP0770 * APCP0771 AGB09 LDX L1 *-* RESTORE POINTER APCP0772 LD NGBTB SAVE ADDRESS FOR APCP0773 STO 1 4 ENTRY APCP0774 LDS 1 APCP0775 BSI IGBTB APCP0776 * APCP0777 LDX I2 NGBTB ADDRESS OF ENTRY APCP0778 LDD 1 0 SAVE IDENT IN APCP0779 STD 2 2 ENTRY APCP0780 * APCP0781 MDX L NUMGL,1 ADVANCE COUNT OF GLOBALS APCP0782 * BY ONE APCP0783 BSC I AGBTB EXIT APCP0784 * APCP0785 DIMNS DC 0 APCP0786 NEGBT DC EGBTB APCP0787 LNGTB DC 0 APCP0788 NGBTB DC 0 APCP0789 HDNG REMOVE OR INSERT ID IN CHAIN APCP0790 * X1 CONTAINS POINTER TO PARAMETER LIST APCP0791 IGBTB DC 0 APCP0792 LD 1 3 GET PREVIOUS POINTER APCP0793 BSC L IGB01,Z BRANCH IF NOT ZERO APCP0794 LD 1 2 IF ZERO, FORM ADDRESS APCP0795 A AGSTB OF ENTRY IN SYNONYM APCP0796 * TABLE LESS ONE APCP0797 IGB01 STO L 2 SAVE ADDRESS FOR STORING APCP0798 LD 1 4 SAVE ADDRESS OF NEXT APCP0799 BSC O APCP0800 MDX IGB02 APCP0801 STO L 3 DELETED APCP0802 LD 3 1 GET POINTER TO NEXT ID APCP0803 IGB02 STO 2 1 APCP0804 BSC I IGBTB APCP0805 * APCP0806 AGSTB DC GLSTB-1 APCP0807 HDNG SET GARBAGE COLLECT SW AND DELETE APCP0808 DGBTB DC 0 APCP0809 * APCP0810 LD I1 4 APCP0811 BSC L DGB01,- APCP0812 STO L GRBCL SET GARBAGE CLOLECT SW APCP0813 DGB01 BSI DGBMN APCP0814 BSC I DGBTB EXIT APCP0815 HDNG DELETE FUNCTION OR VARIABLE APCP0816 * X1 CONTAINS POINTER TO PARAMETER LIST APCP0817 DGBMN DC 0 APCP0818 LDS 0 APCP0819 BSI IGBTB APCP0820 LD 3 0 APCP0821 BSI L ABSAD ADDRESS APCP0822 LD HFFFF APCP0823 STO 1 0 GARBAGE APCP0824 * APCP0825 SLT 32 ZERO OUT GLOBAL APCP0826 STD 3 0 ENTRY APCP0827 STD 3 2 APCP0828 * APCP0829 MDX L NUMGL,-1 REDUCE COUNT OF APCP0830 MDX * GLOBALS APCP0831 BSC I DGBMN APCP0832 HDNG SQUEEZE UP MSTRT APCP0833 SQEEZ DC 0 APCP0834 LD L LENGL LENGTH OF TABLE APCP0835 S L NUMGL LESS ENTRIES IN TABLE APCP0836 S DNEXN IS NO OF EMPTY ENTRIES APCP0837 BSC I SQEEZ,+ EXIT IF LESS THAN 6 APCP0838 STO L 3 NO. OF ENTRIES WHICH MAY APCP0839 LDX I1 MSTRT BE DELETED. START IF M-SPACEAPCP0840 SQE01 LD 1 -4 IS PREVIOUE ENTRY EMPTY APCP0841 BSC L SQEXT,Z GO TOEXIT IF YNOT APCP0842 MDX 1 -4 BACK ONE APCP0843 LDD GRBGE MARK AS GARBAGE APCP0844 STD 1 0 APCP0845 MDX L LENGL,-1 REDUCE TABLE LENGTH APCP0846 MDX 3 -1 COUNT ENTIRES FOR DELETIOAPCP0847 MDX SQE01 APCP0848 SQEXT STX L1 MSTRT NEW START OF M-SPACE APCP0849 BSC I SQEEZ EXIT APCP0850 GRBGE BSS E 0 APCP0851 HFFFF DC /FFFF APCP0852 DC /0101 APCP0853 DNEXN DC NEXEN APCP0854 HDNG CHECK FUNCTION APCP0855 * X1 CONTAINS ADDRESS OF IDS APCP0856 CKDFN DC 0 APCP0857 STX 1 CKD05+1 APCP0858 BSI L SGBTB SERCH GLOBAL TABLE APCP0859 LD 1 4 WAS OBJECT FOUND APCP0860 BSC L CKD07,+- GO MARK NOT FOUND IF NOT APCP0861 LDX I2 LOCOR+14 CURRENT SVI APCP0862 LDX I3 PAREL CURRETN TOP LEVEL HEADER APCP0863 LD L MODE IS THIS FN DEFN MODE APCP0864 BSC L CKD01,- BRANCH IF NOT APCP0865 LDD L FNDPL IF YES, CHECK OBJECT APCP0866 SD 1 0 APCP0867 BSC L CKD01,Z BRANCH IF DIFFERENT APCP0868 SLT 16 NOT ERASBLE IF APCP0869 BSC L CKD06,+- APCP0870 CKD01 LD L 3 IS SVI REDUCED APCP0871 S L 2 TO HEADER APCP0872 BSC L CKD04,-Z APCP0873 LD 3 0 IF YES, IS THIS APCP0874 SLA 4 BOTTOM LEVEL APCP0875 BSC L CKD09,+- APCP0876 LD 3 0 IF NOT, IS THIS QUAD APCP0877 AND H3000 OR QUAD PRIME APCP0878 BSC L CKD03,Z BRANCH IF YES APCP0879 LD 3 3 APCP0880 BSI L ABSAD FROM HEADER APCP0881 LDD 1 2 IS FUNCTION ID APCP0882 SD I CKD05+1 SAME AS OBJECT ID APCP0883 BSC L CKD02,Z BRANCH IF NOT APCP0884 SLT 16 RY SECOND WORF APCP0885 BSC L CKD06,+- GO MARK NOT ERASABLE APCP0886 CKD02 LD 2 5 DETERMINE LENGTH OF APCP0887 A 2 6 LABEL AND LOCAL APCP0888 SLA 1 APCP0889 A 2 5 IN HEADER APCP0890 A 2 6 APCP0891 STO CKD08 APCP0892 MDX I2 CKD08 FORM NEW SVI APCP0893 MDX 2 11 APCP0894 CKD03 MDX 2 5 ALLOW FOR OLD HEADER APCP0895 LD 3 0 GET NEW TOP LEVEL APCP0896 BSI L ABSAD HEADER APCP0897 STO L 3 FROM OLD TOP LEVEL APCP0898 MDX CKD01 APCP0899 CKD04 LD 2 0 GET NEXT ENTRY APCP0900 MDX 2 1 ADVANCE SVI APCP0901 BSC L CKD01,- IGNORE IF NOT INDIRECT APCP0902 EOR HFFFF GET ADDRESS OF APCP0903 BSI L ABSAD SYPTR APCP0904 CKD05 LDD L *-* COMPARE ID WITH OBJECT IDAPCP0905 SD 1 2 APCP0906 BSC L CKD01,Z BRANCH IF NOT SAME APCP0907 SLT 16 TRY 2ND WORD APCP0908 BSC L CKD01,Z TRY NEXT ENTRY IF DIFF APCP0909 CKD06 LD HFFFF OBJECT IS NOT ERASBLE APCP0910 MDX CKD10 APCP0911 CKD09 LD D1 APCP0912 CKD10 LDX I1 CKD05+1 APCP0913 CKD07 STO 1 6 SAVE STATUS INDICATOR APCP0914 BSC I CKDFN APCP0915 CKD08 DC 0 APCP0916 D1 DC 1 APCP0917 H3000 DC /3000 APCP0918 HDNG EXECUTE COPY AND PCOPY COMMANDS APCP0919 VCNT DC 0 APCP0920 FCNT DC 0 APCP0921 WSDSA DC 0 APCP0922 GBPTR DC 0 APCP0923 H7FFF DC /7FFF APCP0924 TCOPY DC 0 APCP0925 GBLC DC 0 APCP0926 PTRID DC 0 APCP0927 SPCPY LD L PCOPY APCP0928 STO L COPY APCP0929 LDX 1 0 APCP0930 MDX COPY1 APCP0931 SCOPY LDX 1 1 APCP0932 COPY1 STX 1 TCOPY APCP0933 LDX L1 GTSPF APCP0934 STX L1 MGCOL SET RETURN FOR GETSP FAILAPCP0935 LDX L1 GRCLF APCP0936 STX L1 FGCOL APCP0937 STX L1 MGFLG APCP0938 SRA 16 APCP0939 STO VCNT APCP0940 STO FCNT APCP0941 LDX I1 FOUND C/FOUND PTS WS DIRECTORY APCP0942 LD 1 7 ACC/ DSA OF WS APCP0943 STO WSDSA APCP0944 STO L 1 DSA ARG FOR LSMSP APCP0945 MDX 1 26 ADVANCE TO MSPACE APCP0946 LDX L2 IMTRX CORE ARG FOR LSMSP APCP0947 LDS 1 APCP0948 BSI L SLMSP APCP0949 MDX L CLASS,-12 APCP0950 MDX MKPAR APCP0951 LD L NUMGL+MLNC APCP0952 BSC I COPY,+ APCP0953 STO GBLC APCP0954 LDX L1 GLBTB+MLNC-4 APCP0955 STX 1 GBPTR APCP0956 CPCM1 LDX L2 GBPTR APCP0957 BSI L UPGBP APCP0958 LDD 1 2 APCP0959 STD L GBSUB APCP0960 BSI MRKGB APCP0961 MDX L GBLC,-1 APCP0962 MDX CPCM1 APCP0963 MDX CPYVB APCP0964 MKPAR LD L CLASS APCP0965 STO GBLC APCP0966 STO L MGFLG APCP0967 LDX L1 PARID APCP0968 STX 1 PTRID APCP0969 MKPR1 LDX L1 GBSUB APCP0970 LDD I PTRID APCP0971 STD 1 0 APCP0972 BSI SIBTB APCP0973 LD 1 4 APCP0974 BSC L NDNFM,+- APCP0975 STO GBPTR APCP0976 BSI L MRKGB APCP0977 MKPR2 MDX L PTRID,2 APCP0978 MDX L GBLC,-2 APCP0979 MDX MKPR1 APCP0980 BSI L NDCRT APCP0981 MDX CPYVB APCP0982 NDNFM LDX L2 NFMGT APCP0983 LDX I1 PTRID APCP0984 BSI L NDMG APCP0985 MDX MKPR2 APCP0986 CPYVB LD VCNT APCP0987 BSC L CPYFN,+ APCP0988 LDX L1 GLBTB+MLNC-4 APCP0989 STX 1 GBPTR APCP0990 LDX L1 GBSUB X1 PTS GBSUB THROUGHOUT APCP0991 CPYV1 MDX L GBPTR,4 APCP0992 LDX I3 GBPTR APCP0993 LD 3 1 APCP0994 BSC L CPYV1,- APCP0995 LD 3 0 APCP0996 BSC L CPYV1,+ APCP0997 BSI L STFGB APCP0998 LDX I3 GBPTR APCP0999 LD 3 1 APCP1000 AND H7FFF APCP1001 STO 3 1 APCP1002 MDX L VCNT,-1 APCP1003 MDX CPYV1 APCP1004 BSC L CPYFN APCP1005 HDNG MARK GLOBALS TO BE COPIED APCP1006 * FROM THE INACTIVE MSPACE APCP1007 MRKGB DC 0 APCP1008 LDX L1 GBSUB X1 POINTS GBSUB THROUGHOUT APCP1009 BSI L CKDFN APCP1010 LDX I3 GBPTR APCP1011 LD 3 1 APCP1012 BSC L MRKG9,+Z APCP1013 LD 1 6 STATUS APCP1014 BSC L MRKG1,+- APCP1015 LD L TCOPY APCP1016 BSC L MRKG4,+- SET MPTR TO 0 IF PCOPY APCP1017 LD 1 6 APCP1018 BSC L MRKG4,+ APCP1019 BSI L DGBTB APCP1020 LDX I3 GBPTR APCP1021 MRKG1 LD 3 1 APCP1022 OR L H8000 APCP1023 STO 3 1 APCP1024 LD 3 0 APCP1025 BSC L MRKG2,+ APCP1026 MDX L VCNT,1 APCP1027 MDX MRKG9 APCP1028 MRKG2 MDX L FCNT,1 APCP1029 MDX MRKG9 APCP1030 MRKG4 LD H0FFF APCP1031 STO 3 0 APCP1032 MRKG9 BSC I MRKGB APCP1033 H0003 DC /3 APCP1034 H0FFF DC /0FFF APCP1035 HDNG SEARCH INACTIVE GLOBAL TABLE APCP1036 * X1 CONTAINS ADDRESS OF ID AND ARGS APCP1037 SIBTB DC 0 APCP1038 LD 1 0 CALCULATE APCP1039 S 1 1 SYNONYM APCP1040 SRT 16 FOR IDENTIFIER APCP1041 SRA 16 ZERO OUT PRECEDING ID APCP1042 STO 1 3 WITH THIS SYNONYM APCP1043 D D0026 FORM SYNONYM = REMAINDER APCP1044 SLT 16 OF (1ST WORD - 2ND WORD) APCP1045 STO 1 2 DIVIDED BY 26 APCP1046 STO L 2 SAVE SYNONYM APCP1047 LD L2 GLSTB+MLNC APCP1048 * SYNONYM TABLE IE. APCP1049 * POINTER TO 1ST ID WITH APCP1050 * THIS SYNONYM APCP1051 SGB01 BSC L SGB04,+- APCP1052 STO L 2 POINTER TO X2 APCP1053 * APCP1054 LDD L2 2+MLNC APCP1055 SD 1 0 IDENTIFIERS APCP1056 BSC L SGB02,Z APCP1057 SLT 16 NOT SAME APCP1058 BSC L SGB03,+- APCP1059 SGB02 LDD L2 1+MLNC APCP1060 AND L H7FFF APCP1061 MDX SGB01 NEXT ID AND CONTINUE APCP1062 SGB03 LD L 2 GET POINTER TO THIS ID APCP1063 A L CMLNC APCP1064 SGB04 STO 1 4 SAVE POINTER APCP1065 BSC I SIBTB APCP1066 * APCP1067 D0026 DC 26 APCP1068 HDNG ERASE GLOBAL FUNCTIONS AND VARIABLES APCP1069 SERSE MDX L CLASS,-12 APCP1070 MDX ERSE1 APCP1071 ERSEX BSI L SQEEZ APCP1072 BSC I ERASE APCP1073 ERSE1 LDX L1 PARID APCP1074 STX L1 PTRID APCP1075 STX L1 MGFLG APCP1076 ERSE2 LDX L1 GBSUB APCP1077 LDD I PTRID APCP1078 STD 1 0 APCP1079 BSI L CKDFN APCP1080 LD 1 6 APCP1081 BSC L ERSEN,+Z APCP1082 BSI L DGBTB,Z APCP1083 ERSE3 MDX L PTRID,2 APCP1084 MDX L CLASS,-2 APCP1085 MDX ERSE2 APCP1086 BSI L NDCRT APCP1087 MDX ERSEX APCP1088 ERSEN LDX I1 PTRID APCP1089 LDX L2 NERSE APCP1090 BSI L NDMG APCP1091 MDX ERSE3 APCP1092 NERSE DC 4 APCP1093 DC N*P1+O*P2+T APCP1094 DC SPC*P1+E*P2+R APCP1095 DC A*P1+S*P2+E APCP1096 DC D*P1+SPC*P2+SPC APCP1097 LNGTH EQU *-ASMCP APCP1098 START LDX L1 ASMCP-2 APCP1099 BSI DSKIO APCP1100 EXIT APCP1101 DSKIO DC 0 APCP1102 STX 1 DSKI1 APCP1103 STX 1 DSKI3 APCP1104 LIBF DISK1 APCP1105 DC /3000 APCP1106 DSKI1 DC 0 APCP1107 DC DSKI4 APCP1108 DSKI2 LIBF DISK1 APCP1109 DC /0000 APCP1110 DSKI3 DC 0 APCP1111 MDX DSKI2 APCP1112 BSC I DSKIO APCP1113 DSKI4 WAIT APCP1114 BSC I DSKIO APCP1115 END START APCP1116 // XEQ L 1 APCP1117 // JOB APCT0001 // ASM APCT0002 *LIST APCT0003 *PRINT SYMBOL TABLE APCT0004 HDNG PREPROLOGUE TO CTRAY APCT0005 ABS APCT0006 ORG EQU -/800 APCT0007 * ORIGINS OF THIS AND OTHER ASSEMBLIES APCT0008 ASMCT EQU /21E APCT0009 ASMDK EQU /000 APCT0010 ASMT2 EQU /0DE APCT0011 ASMTA EQU /0DE APCT0012 ASMTB EQU /0DE APCT0013 ASMSN EQU /71E APCT0014 ASMIN EQU /730 APCT0015 ASMSC EQU /730 APCT0016 ASMPH EQU /730 APCT0017 ASMCP EQU /730 APCT0018 ASMXQ EQU /730 APCT0019 ASMED EQU /18D1 APCT0020 ASMFN EQU /18D1 APCT0021 ASMIX EQU /18D1 APCT0022 ASMES EQU /1B51 APCT0023 * LIST OF OVERLAYS USED BY THE APL SYSTEM APCT0024 * APCT0025 * OVERLAY LIST APCT0026 * APCT0027 INPOV EQU 4 APCT0028 SCMOV EQU 8 APCT0029 PCHOV EQU 12 APCT0030 CPYOV EQU 16 APCT0031 SGNOV EQU 20 APCT0032 SYNOV EQU 24 APCT0033 EDTOV EQU 28 APCT0034 IDXOV EQU 32 APCT0035 EOSOV EQU 36 APCT0036 * APCT0037 * LIST OF DISK ADDRESSES RELATIVE TO LCDBS APCT0038 LCDBS EQU /280 DISK BASE APCT0039 DASTU EQU 0 APCT0040 DATST EQU DASTU+26 TEMPORARY STUDENT TRK APCT0041 DACMD EQU DATST+26 SYSTEM COMMAND APCT0042 DAPCH EQU DACMD+5 PUNCH/DISPLAY/ERROR APCT0043 DACPY EQU DAPCH+6 APCT0044 DADSK EQU DACPY+5 APCT0045 DATYP EQU DADSK+1 TYPE/INTERRUPTS APCT0046 DACTY EQU DATYP+1 PERMANENT STORAGE APCT0047 DAINP EQU DACTY+5 APCT0048 DAEDT EQU DAINP+7 EDIT APCT0049 DASYN EQU DAEDT+5 SYNTAX APCT0050 DAFUN EQU DASYN+7 APCT0051 DAIDX EQU DAFUN+4 APCT0052 DAEOS EQU DAIDX+2 APCT0053 DATPA EQU DAEOS+4 APCT0054 DATPB EQU DATPA+1 APCT0055 DATPC EQU DATPB+1 APCT0056 DACLN EQU DATPC+1 APCT0057 DADRU EQU DACLN+1 APCT0058 DADRW EQU DADRU+1 WORK SPACE DIRECTORY APCT0059 DATMS EQU DADRW+1 APCT0060 * IMPORTANT ADDRESSES APCT0061 LOCOR EQU /1000 LC REGISTERS APCT0062 M EQU /13 (MSTRT) 1ST M-ENTRY APCT0063 MX EQU /14 (MNEXT) NEXT AVAILABLE M-NTRY APCT0064 STUAD EQU /1015 CURRENT STUTRK POINTR APCT0065 SOLPT EQU /1016 START OF LINE POINTER APCT0066 PAREL EQU /1017 TOP LEVEL HEADER ADDR APCT0067 GRBCL EQU /1018 GARBAGE COLLECT SWTCH APCT0068 GLSTB EQU /101C APCT0069 STKOR EQU /178C APCT0070 FNDPL EQU /1FEC APCT0071 ISBRN EQU /1FF3 APCT0072 MODE EQU /1FF4 APCT0073 SINON EQU /1FF6 APCT0074 FULST EQU /1FF7 APCT0075 ATTN EQU /1FF8 APCT0076 CHRCT EQU /1FF9 APCT0077 GTSPL EQU /1FFA APCT0078 MGCOL EQU /1FFE M-SPACE GARBAGE COLL APCT0079 FGCOL EQU /1FFF F-SPACE GARBAGE COLL APCT0080 TL41 EQU 58 LENGTH OF CODE-DEPENDENT APCT0081 * 2741 TRANSLATION TABLES APCT0082 * ADDRESSES IN DISK I/O APCT0083 DKORG EQU ASMDK+/2C APCT0084 * ADDRESSES IN TYPE APCT0085 TYPE2 EQU ASMT2+/52 APCT0086 * RELATIVE ADDRESSES IN INPUT/EDIT APCT0087 GNSTM EQU 1 APCT0088 * RELATIVE ADDRESSES IN SYSTEM COMMAND APCT0089 BREAK EQU 1 APCT0090 * RELATIVE ADDRESSES IN PUNCH/DISPLAY/ERROR APCT0091 ERROR EQU /A APCT0092 * RELATIVE ADDRESSES IN COPY/DISK GARBAGE COLLECAPCT0093 DGCOL EQU /7 APCT0094 * RELATIVE ADDRESSES IN STATEMENT EXECUTION APCT0095 NEXT EQU /4D APCT0096 EFPE1 EQU /AD APCT0097 * RELATIVE ADDRESSES IN OVERLAY OPS APCT0098 BSTBL EQU /6D7 APCT0099 * RELATIVE ADDRESSES IN FUNCTION TRACE APCT0100 XQFNT EQU /13 APCT0101 XFNTR EQU /C APCT0102 * ADDRESSES REQUIRED BY OTHER SEGMENTS APCT0103 DC APIPL-ASMCT+ORG APCT0104 DC CDSW-ASMCT+ORG APCT0105 DC TYPSW-ASMCT+ORG APCT0106 DC TSTIN-ASMCT+ORG APCT0107 DC ERRXT-ASMCT+ORG APCT0108 DC ABSAD-ASMCT+ORG APCT0109 DC LCLOD-ASMCT+ORG APCT0110 DC GOVLY-ASMCT+ORG APCT0111 DC FSYL-ASMCT+ORG APCT0112 DC PSYL-ASMCT+ORG APCT0113 DC GSYL-ASMCT+ORG APCT0114 DC CLOMN-ASMCT+ORG APCT0115 DC GETSP-ASMCT+ORG APCT0116 DC GCOL-ASMCT+ORG APCT0117 DC TYPE-ASMCT+ORG APCT0118 DC TYNCH-ASMCT+ORG APCT0119 DC MVCRG-ASMCT+ORG APCT0120 DC PRCRT-ASMCT+ORG APCT0121 DC PRNID-ASMCT+ORG APCT0122 DC UNPK-ASMCT+ORG APCT0123 DC SGBTB-ASMCT+ORG APCT0124 DC FSB-ASMCT+ORG APCT0125 DC FMP-ASMCT+ORG APCT0126 DC FDV-ASMCT+ORG APCT0127 DC FAD-ASMCT+ORG APCT0128 DC LCUFL-ASMCT+ORG APCT0129 DC UNFLT-ASMCT+ORG APCT0130 DC FLT-ASMCT+ORG APCT0131 DC FSBN-ASMCT+ORG APCT0132 DC EXIT-ASMCT+ORG APCT0133 DC AARG-ASMCT+ORG APCT0134 DC NLZE-ASMCT+ORG APCT0135 DC XMDS-ASMCT+ORG APCT0136 DC ONE-ASMCT+ORG APCT0137 DC CLEAR-ASMCT+ORG APCT0138 DC XDDS-ASMCT+ORG APCT0139 DC XTRCT-ASMCT+ORG APCT0140 DC ENTR2-ASMCT+ORG APCT0141 DC SVOVL-ASMCT+ORG APCT0142 DC GNXTW-ASMCT+ORG APCT0143 DC XQSTC-ASMCT+ORG APCT0144 DC XQNXL-ASMCT+ORG APCT0145 DC OVLXQ-ASMCT+ORG APCT0146 DC SYPTR-ASMCT+ORG APCT0147 DC TSTUT-ASMCT+ORG APCT0148 * LENGTH OF ASSEMBLY APCT0149 DC LNGTH APCT0150 * APCT0151 HDNG ORIGIN OF ASSEMBLY APCT0152 * APCT0153 ORG ASMCT-ORG-2 APCT0154 DC 5*/140 APCT0155 DC LCDBS+DACTY APCT0156 HDNG APL CONTROL APCT0157 * APCT0158 * APCT0159 CDSW DC 0 INPUT MODE APCT0160 TYPSW DC 0 APCT0161 FILLR BSS 11 APCT0162 HD DC /D APCT0163 H9 DC 9 APCT0164 H8 DC 8 APCT0165 BSS E 0 APCT0166 M9 DC -9 APCT0167 DC 0 APCT0168 * APCT0169 * APCT0170 APL LDX 2 INPOV APCT0171 BSI GOVLY OVERLAYS ARE LOADED APCT0172 LD L SINON APCT0173 SLA 1 APCT0174 LDX 2 SGNOV LOAD SIGN ON SECTOR IF APCT0175 BSI L GOVLY+ORG,Z APCT0176 LDX 2 EDTOV INTO MEMORY APCT0177 BSI GOVLY APCT0178 BSI 3 GNSTM APCT0179 * APCT0180 MDX CONTN PROCESS ATTENTION APCT0181 MDX XEQCM SYSTEM COMMAND APCT0182 * APCT0183 * APCT0184 XEQST LDX 2 SYNOV ENSURE SYNTAX ANALYSIS APCT0185 BSI GOVLY OVERLAYS ARE LOADED APCT0186 LDX 2 EOSOV APCT0187 BSI GOVLY APCT0188 BSI L XQSTC+ORG APCT0189 * CONTROL APCT0190 * APCT0191 MDX CONTN PROCESS ATTENTION APCT0192 * APCT0193 XEQCM LDX 2 SCMOV ENSURE SYSTEM COMMAND APCT0194 BSI GOVLY OVERLAY IS LOADED APCT0195 BSI 3 BREAK APCT0196 * APCT0197 * APCT0198 BSI GOVLY GET REQUIRED OVERLAY APCT0199 MDX I1 3 APCT0200 BSI 1 0 EXECUTE COMMAND APCT0201 MDX APL02 GO MARK OVERLAY AREA 2 APCT0202 WSERR LDX 1 9 APCT0203 MDX ERRXQ APCT0204 VALER LDX 1 18 APCT0205 MDX ERRXQ APCT0206 SYNER LDX 1 4 APCT0207 MDX ERRXQ APCT0208 DOMER EQU * APCT0209 FPRNG LDX 1 7 APCT0210 ERRXQ MDX L1 /4000 APCT0211 H4000 EQU *-1 APCT0212 ERRXT EQU * APCT0213 LDX 2 PCHOV ENSURE ERROR OVERLAY APCT0214 BSI GOVLY APCT0215 BSI 3 ERROR APCT0216 * (WHICH SETS ATTENTION) APCT0217 APL02 SRA 16 APCT0218 STO I OVLED+ORG APCT0219 * APCT0220 CONTN LDX L2 LOCOR APCT0221 LDX I1 PAREL APCT0222 LD 1 0 IS THIS A APCT0223 SRA 12 APCT0224 BSC L CON01+ORG,Z BRANCH IF NOT APCT0225 LD 1 0 ENSURE TOP LEVEL APCT0226 OR H4000 HEADER INDICATES APCT0227 STO 1 0 IMMEDIATE EXECUTION APCT0228 LD 2 STUAD-LOCOR CURRENT POINTER IS NEW APCT0229 MDX CON03 START OF LINE APCT0230 CON01 LD 1 4 IS END OF LINE POINTER APCT0231 S 2 STUAD-LOCOR EQUAL TO CURRENT POINTER APCT0232 BSC L CON02+ORG,+- BRANCH IF YES APCT0233 * EQUAL TO CURRENT S.O.L. APCT0234 STO 2 GRBCL-LOCOR EMBEDDED LINE. SET APCT0235 MDX CON04 GARBAGE COLLECT. APCT0236 CON02 LD 1 1 CURRENT POINTER IS NEW APCT0237 CON03 STO 2 SOLPT-LOCOR APCT0238 * APCT0239 CON04 LD L ATTN APCT0240 BSC L APL+ORG,+- APCT0241 LD CDSW APCT0242 SRT 12 APCT0243 AND HD APCT0244 S H8 APCT0245 CON05 BSC Z APCT0246 LDD M9 APCT0247 A H9 APCT0248 SLT 12 APCT0249 CON06 STO CDSW INPUT APCT0250 * APCT0251 MDX APL NEXT STATEMENT APCT0252 HDNG PATCH FOR FLOATING POINT ARITHMETIC APCT0253 NORMC BSS E 0 APCT0254 DC 0 APCT0255 DC /0100 APCT0256 PATCH EQU * APCT0257 BSC L OFLW+ORG,O ONLY POS CAN NOT OVFLW APCT0258 SD NORMC APCT0259 AD NORMC OVERFLOW WILL BE SET IF APCT0260 BSC L FPEXC+ORG,O RESULT IS /800000XX APCT0261 STD 3 4 SAVE AS ANSWER APCT0262 BSC L FPRET+ORG CONTINUE APCT0263 HDNG GET OVERLAY APCT0264 * X2 IS THE OVERLAY NUMBER WHICH IS APCT0265 * A MULTIPLE OF 4 APCT0266 * APCT0267 ORG *-1 APCT0268 BSS E 1 APCT0269 GOVLY DC 0 DOUBLE LOAD/STORES APCT0270 LD L2 OVLST+ORG+1 APCT0271 STO L 3 APCT0272 LD 3 0 APCT0273 S L 2 IS THIS REQUIRED OVLAY APCT0274 BSC I GOVLY+ORG,+- EXIT IF YES APCT0275 * APCT0276 LDD L2 OVLST+ORG PUT DISK AND COR APCT0277 STD GOV01 ADDRESSES IN PARAM LIST APCT0278 LDD L2 OVLST+ORG+2 PUT SECTORS AND LAST SEC APCT0279 STD GOV01+2 TOR LENGTH IN PARAM LIST APCT0280 LDS 1 READ OVERLAY INTO APCT0281 BSI L DKORG MEMORY APCT0282 GOV01 BSS 2 APCT0283 OVLST BSS 2 ORIGIN OF OVERLAY LIST APCT0284 * THIS AREA IS ALSO USED BY PRNID FOR UNPACKING APCT0285 * CHARACTERS FROM A MESSAGE WORD APCT0286 BSC I GOVLY+ORG EXIT APCT0287 * NOTE THAT FIRST OVERLAY APCT0288 * NUMBER IS FOUR APCT0289 DC LCDBS+DAINP APCT0290 OVLIN DC ASMIN APCT0291 DC 7 APCT0292 DC /140 APCT0293 DC LCDBS+DACMD APCT0294 DC ASMSC APCT0295 DC 5 APCT0296 DC /140 APCT0297 DC LCDBS+DAPCH APCT0298 DC ASMPH APCT0299 DC 6 APCT0300 DC /11D APCT0301 DC LCDBS+DACPY APCT0302 OVLCP DC ASMCP APCT0303 DC 5 APCT0304 DC /140 APCT0305 DC LCDBS+DACTY+4 APCT0306 DC ASMSN APCT0307 DC 1 APCT0308 DC /140 APCT0309 DC LCDBS+DASYN APCT0310 OVLXQ DC ASMXQ APCT0311 DC 7 APCT0312 DC /140 APCT0313 DC LCDBS+DAEDT APCT0314 OVLED DC ASMED APCT0315 DC 5 APCT0316 DC /140 APCT0317 DC LCDBS+DAFUN APCT0318 DC ASMFN APCT0319 DC 4 DAOVY APCT0320 DC /140 APCT0321 DC LCDBS+DAIDX APCT0322 OVLIX DC ASMIX APCT0323 DC 6 DAEOS+DAIDX APCT0324 DC /D7 APCT0325 HDNG FORM 1130 ADDRESS IN X1 APCT0326 * APCT0327 ABSAD DC 0 APCT0328 AND L LOCOR-1 ISOLATE BOTTOM 13 BITS APCT0329 OR L LOCOR-2 ENSURE 1130 ADDRESS APCT0330 STO L 1 SAVE IT IN X1 APCT0331 BSC I ABSAD+ORG EXIT APCT0332 * APCT0333 * APCT0334 * APCT0335 LCLOD DC 0 APCT0336 AND 1 -1 ISOLATE BOTTOM 13 BITS APCT0337 OR 1 -2 ENSURE TRUE 1130 ADDRESS APCT0338 STO *+1 SAVE IT APCT0339 LD L *-* GET CONTENTS OF WORD APCT0340 CLODI EQU *-1 APCT0341 BSC I LCLOD+ORG EXIT APCT0342 HDNG ** APL/1130 GET/PUT SYLLABLE RTN. ** APCT0343 * THIS ROUTINE GETS A SYLLABLE FROM THE CODESTRINGAPCT0344 * OR PUTS A SYLLABLE TO THE CODESTRING DEPENDING APCT0345 * ON THE ENTRY POINT. THE CALLING SEQUENCE IS AS APCT0346 * FOLLOWS APCT0347 * DISK BUFFERS. THE CPTR IS COMPARED WITH THE APCT0348 * APPROPRIATE CURRENT SECTOR ADDRESS IF A GET OR APCT0349 * PUT IS TO BE DONE AS FOLLOWS. APCT0350 * ON A GET THE COMPARISON IS MADE, A NEW SECTOR APCT0351 * IS OBTAINED IF NECESSARY, THE CPTR IS UPDATED APCT0352 * (INCREMENTED), AND A SYLLABLE IS OBTAINED BASED APCT0353 * ON THE OLD CPTR. APCT0354 * ON A PUT THE CPTR IS UPDATED (DECREMENTED), THE APCT0355 * COMPARISONS MADE, THE OLD SECTOR IS PUT IF NECESAPCT0356 * SARY, AND THE SYLLABLE IS PUT BASED ON THE NEW CAPCT0357 * CPTR. APCT0358 * THE OLD CPTR IS ALWAYS SAVED SO THAT OPCTL CAN *APCT0359 * RESTORE IT IN THE CASE OF A UNARY OPERATION. APCT0360 GCLSW EQU GRBCL APCT0361 EODSK LD I1 3 APCT0362 BSI L FSYL+ORG,Z FLUSH IF NOT APCT0363 LD L GCLSW IS THERE ANY GARBAGE APCT0364 BSC I FGCOL,+- DISK FULL ERROR APCT0365 LD I OVLCP+ORG APCT0366 STO SVOVL OF OVERLAY APCT0367 EODK1 LDX 2 CPYOV APCT0368 BSI GOVLY APCT0369 BSI 3 DGCOL APCT0370 LDX L2 *-* APCT0371 SVOVL EQU *-1 APCT0372 BSI GOVLY APCT0373 MDX PSYL2 APCT0374 FSYL DC 0 FLUSH THE BUFFER OUT TO DISK APCT0375 LD 1 2 APCT0376 STO CDSTR APCT0377 LD I1 3 APCT0378 STO SGAD APCT0379 LDS 2 APCT0380 BSI GPIO1 APCT0381 BSC I FSYL+ORG APCT0382 PSYL DC 0 APCT0383 LD I1 1 APCT0384 BSC L EODSK+ORG,+- TRY A GARBAGE COLLECT APCT0385 LD PSYL APCT0386 STO GSYL APCT0387 PSYL2 LDS 2 APCT0388 MDX GPSYL APCT0389 GSYL DC 0 APCT0390 LDS 1 APCT0391 GPSYL LD I1 1 APCT0392 STO CPTR C/CPTR IS CPTR APCT0393 STO PSYL IN CASE OF GSYL UNARY OP APCT0394 LD 1 2 APCT0395 STO CDSTR C/CDSTR PTS BUFFER TO USE APCT0396 LD I1 3 APCT0397 STO SGAD C/SGAD IS 1570 SECTOR NOW INAPCT0398 BSC L GET+ORG,O CALL IS TO GET IF BRANCH APCT0399 PUT LD CPTR APCT0400 BSC + APCT0401 A D01 APCT0402 A H7FFF APCT0403 STO CPTR CPTR DECREASED 1 SYL APCT0404 STO I1 1 SAVE NEW CPTR APCT0405 LD SGAD APCT0406 BSC L RANGP+ORG,Z BRANCH IF BUFFER NOT MPTYAPCT0407 BSI GPIO CALC SEGMENT ADDRESS APCT0408 LDS 1 APCT0409 BSI GPIO1 LOAD REQUIRED SEGMENT APCT0410 RANGP BSI RANGE SKIPPING FLUSH FOR OUT OF APCT0411 * RETURN FOR OUT OF * RANGE APCT0412 * RANGE * APCT0413 LDS 2 APCT0414 BSI GPIO1 FLUSH BUFFER OUT TO DISK APCT0415 BSI GPIO CALC NEW SEG ADDR APCT0416 MDX RANGP GO CALC CODESTRING PTR APCT0417 * RETURN FOR ADDRESS IN RANGE APCT0418 SLT 16 APCT0419 LD CPTR APCT0420 SLA 1 SETS CARRY TO 0 OR 1 APCT0421 LD I1 0 GET SYLLABLE APCT0422 RTE 24 APCT0423 BSC C WANT IT IN HI ORDER IF SKIP APCT0424 RTE 8 APCT0425 STO FLUSH APCT0426 LD GSLMK APCT0427 BSC C PRESERVE LOW ORDER IF SKIP APCT0428 SLA 8 APCT0429 AND I GPIO1+ORG MAKE SPACE FOR THIS SYL APCT0430 OR FLUSH OR IT IN APCT0431 STO I GPIO1+ORG STORE IT IN BUFFER APCT0432 MDX GPXIT APCT0433 RANGE DC 0 USED AS TEMP AND EXIT ADDRESSAPCT0434 FLUSH EQU RANGE APCT0435 LD SGAD APCT0436 BSC L SLCAD+ORG,+- APCT0437 S GPIOB FORM LC ADDRESS APCT0438 M GPK10 APCT0439 SLT 21 APCT0440 SLCAD STO LCAD STORE LC ADDRESS APCT0441 LD CPTR APCT0442 AND H7FFF APCT0443 S LCAD IS SYLLABLE IN CURRENT BUAPCT0444 BSC I RANGE+ORG,+Z MUST BE GE O APCT0445 S GSCTR APCT0446 BSC I RANGE+ORG,- AND LT 320 APCT0447 A GSCTR CALC CODESTRING PTR APCT0448 A CDSTR APCT0449 STO GPIO1 APCT0450 MDX L RANGE+ORG,4 APCT0451 BSC I RANGE+ORG APCT0452 GPIO DC 0 CALCULATE SECTOR ADDRESS APCT0453 LCAD EQU GPIO APCT0454 LD CPTR FROM CPTR APCT0455 AND H7FFF APCT0456 SRT 21 APCT0457 D GPK10 APCT0458 A GPIOB FORMM 1130 ADDRESS APCT0459 STO SGAD APCT0460 STO I1 3 SAVE SECTOR ADDRESS APCT0461 BSC I GPIO+ORG TO CALLERS AREA APCT0462 GPIO1 DC 0 APCT0463 BSI L DKORG APCT0464 SGAD DC 0 APCT0465 CDSTR DC 0 CORE ADDRESS APCT0466 D01 DC 1 APCT0467 GSCTR DC 320 APCT0468 BSC I GPIO1+ORG APCT0469 GPIOB DC LCDBS /280 APCT0470 H7FFF DC /7FFF APCT0471 GPK10 DC 10 APCT0472 GSLMK DC /FF APCT0473 GET BSI RANGE APCT0474 * RETURN FOR ADDRESS OUT OF RANGE APCT0475 BSI GPIO CALC NEW SEGMENT ADDRESS APCT0476 LDS 1 APCT0477 BSI GPIO1 LOAD NEW SEGMENT APCT0478 MDX GET APCT0479 * RETURN FOR ADDRESS IN RANGE APCT0480 LD CPTR APCT0481 BSC - APCT0482 S D01 APCT0483 S H7FFF APCT0484 STO I1 1 SAVE NEW CPTR APCT0485 SLA 1 SETS CARRY APCT0486 LD I GPIO1+ORG GET 2 SYLS APCT0487 BSC C WANT LOW ORDER IF SKIP APCT0488 RTE 8 APCT0489 AND GSLMK APCT0490 STO I1 0 SVAE SYLLABLE APCT0491 GPXIT BSC I GSYL+ORG EXIT APCT0492 HDNG CALCULATE LENGTH OF M ENTRY APCT0493 * X3 CONTAINS M-ENTRY ADDRESS APCT0494 CLOMN DC 0 APCT0495 CPTR EQU CLOMN APCT0496 LD 3 1 APCT0497 SRT 8 ISOLATE APCT0498 AND HFF APCT0499 STO DIMNS COUNT APCT0500 SRA 16 ISOLATE APCT0501 SLT 8 COLUMN COUNT APCT0502 M DIMNS FORM LENGTH APCT0503 SLT 17 OF MATRIX APCT0504 A D2 ADD 2 FOR HEADER APCT0505 BSC I CLOMN+ORG APCT0506 * APCT0507 D2 DC 2 APCT0508 HFF EQU GSLMK APCT0509 HDNG GET SPACE IN M MATRIX APCT0510 GETSP DC 0 APCT0511 LDX L1 LOCOR SET BASE APCT0512 STO 1 5 SAVE NUMBER OF WORDS APCT0513 * TO BE GOT APCT0514 BSI GCOL GET SPACE APCT0515 * APCT0516 LDX I1 LOCOR+5 ADDRESS OF MPTR TO X1 APCT0517 * THIS CONSISTS OF APCT0518 BSC I GETSP+ORG GETSP APCT0519 * ADDRESS RELATIVE TO APCT0520 * LOC /1000 IN BITS 4-16 APCT0521 * IN REALITY THIS IS THE APCT0522 * ABSOLUTE 1130 ADDRESS APCT0523 * APCT0524 * THIS ROUTINE PERFORMS A GETSPACE OF THE NUMBER APCT0525 * OF WORDS SPECIFIED IN LC REG 5 AND COLLECTS APCT0526 * GARBAGE FROM -M- WHEN NECESSARY. XR1 IS ASSUMEDAPCT0527 * TO CONTAIN LOCOR. IF THE GETSPACE FAILS, A APCT0528 * WORKSPACE FULL ERROR IS POSTED. THE GARBAGE APCT0529 * COLLECTION ALGORITHM ATTEMPTS TO RECLAIM SPACE APCT0530 * IN -M- BY SIMPLY MOVING ALL UNMARKED VARIABLES APCT0531 * DOWN IN -M-. XR 2 & 3 ARE DESTROYED. THE MPTR APCT0532 * WITH OP CLASS IS RETURNED IN LC REG 5. LC REGS APCT0533 * 3 AND 4 ARE DESTROYED. APCT0534 GCOL DC *-* ENTRY POINT APCT0535 * APCT0536 GTSPC LD 1 MX GET AND SAVE MX APCT0537 STO 1 3 APCT0538 A 1 5 ADD N APCT0539 S 1 14 IF MX&N GT MLIM, THE SVI, APCT0540 BSC L DOCOL+ORG,- COLLECT GARBAGE APCT0541 A 1 14 STORE THE NEW MX APCT0542 STO 1 MX APCT0543 LD 1 3 OLD MX IS MPTR APCT0544 STO 1 5 RETURN MPTR IN LC REG 5 APCT0545 BSC I GCOL+ORG APCT0546 DOCOL LDX I3 LOCOR+M INITIALIS I AND J APCT0547 STX 3 I APCT0548 STX 3 J TO BASE OF M APCT0549 CHEKI LD I IF MX GT I APCT0550 S 1 MX APCT0551 BSC L CLECT+ORG,+Z CONTINUE COLLECTION OR APCT0552 LD J STORE NEW MX AND APCT0553 STO 1 MX APCT0554 S I CHECK FOR WORKSPACE FULL APCT0555 BSC L GTSPC+ORG,Z IT IS NOT FULL APCT0556 * ENTERED FROM BRHO APCT0557 WSFER LDX 1 9 APCT0558 BSC I MGCOL APCT0559 CLECT BSI CLOMN APCT0560 STO 1 3 APCT0561 STO 1 4 APCT0562 LD 3 0 IF M HEADER GARBAGE, APCT0563 BSC L UPI+ORG,+Z SKIP THIS ENTRY APCT0564 LD J IF I EQ J, APCT0565 S I APCT0566 BSC L GCCNT+ORG,- NO NEED TO MOVE ENTRY APCT0567 LD 3 0 ADJUST MPTR IN SYMBOL APCT0568 BSI L LCLOD+ORG TABLE BEFORE MOVE APCT0569 S I BY DIFFERENCE OF MOVE PTRS APCT0570 A J APCT0571 STO I CLODI+ORG FOUND IN LCLOD APCT0572 LDX 2 0 APCT0573 MOVE LDD L2 *-* MOVE THE ENTRY APCT0574 STD L2 *-* APCT0575 I EQU MOVE&1 APCT0576 J EQU MOVE&3 APCT0577 MDX 2 2 APCT0578 MDX L LOCOR+4,-2 APCT0579 MDX MOVE APCT0580 GCCNT LD J UPDATE J APCT0581 A 1 3 APCT0582 STO J APCT0583 UPI MDX I3 LOCOR+3 UPDATE I APCT0584 LD I APCT0585 A 1 3 APCT0586 STO I APCT0587 MDX CHEKI APCT0588 HDNG TYPE OUT SERVICE ROUTINES APCT0589 * APCT0590 TYPE DC 0 APCT0591 DIMNS EQU TYPE APCT0592 LDS 3 OUTPUT APCT0593 STX 2 TYP01+1 SAVE X2 APCT0594 BSI L TYPE2 CHARACTER APCT0595 TYP01 LDX L2 *-* RESTORE X2 APCT0596 MDX L CHRCT,1 ADVANCE COUNT APCT0597 BSC I TYPE+ORG EXIT APCT0598 * APCT0599 TYNCH DC 0 APCT0600 STX 1 TYN03 SAVE COUNT OF CHARACTERS APCT0601 STX 3 TYN01+1 ADDRESS OF FIRST APCT0602 TYN01 LDX L1 *-* APCT0603 LD 1 0 APCT0604 BSI L TYPE+ORG,Z TYPE IT IF NON ZERO APCT0605 TYN02 MDX L TYN01+ORG+1,1 APCT0606 MDX L TYN03+ORG,-1 COUNT CHARACTERS APCT0607 MDX TYN01 CONTINUE IF MORE APCT0608 BSC I TYNCH+ORG EXIT APCT0609 TYN03 EQU * APCT0610 * ACCUMULATOR CONTAINS POSITION +VE APCT0611 MVCRG DC 0 APCT0612 S L CHRCT CHARACTERS TO BE MOVED APCT0613 BSC + TYPE AT LEAST ONE BLANK APCT0614 SRA 16 CHARACTER APCT0615 STO BLKCT SAVE COUNT APCT0616 MVC01 LDX L1 BLKCH+ORG TYPE BLANK APCT0617 BSI TYPE CHARACTER APCT0618 MDX L BLKCT+ORG,-1 COUNT CHARACTERS APCT0619 MDX MVC01 ANOTHER BLANK REQ'D APCT0620 BSC I MVCRG+ORG EXIT APCT0621 BLKCT EQU * APCT0622 * APCT0623 PRCRT DC 0 APCT0624 LDX L1 CRTCH+ORG PRINT CARRAIGE APCT0625 BSI TYPE RETURN APCT0626 PRC01 LDX L1 IDLCH+ORG PRINT IDLE APCT0627 BSI TYPE APCT0628 MDX L CHRCT,-11 ONE IDLE FOR TEN CHARS APCT0629 MDX PRC01 ANOTHER ONE WANTED APCT0630 PRC02 EQU * APCT0631 LDX 1 1 RESET CHARACTER APCT0632 STX L1 CHRCT COUNT APCT0633 BSC I PRCRT+ORG EXIT APCT0634 BLKCH DC /78 APCT0635 CRTCH DC /79 APCT0636 IDLCH DC /7D APCT0637 * APCT0638 * PRINT PACKED MESSAGE APCT0639 * X1 CONTAINS NUMBER OF WORDS APCT0640 * X2 CONTAINS IDENTIFIER ADDRESS APCT0641 PRNID DC 0 APCT0642 STX 1 PRNWD SAVE LENGTH OF IDENT APCT0643 PRN01 LDX L3 PRNCH+ORG+3 UNPACK NEXT WORD APCT0644 BSI UNPK IDENTIFIER WORD APCT0645 LDX 1 3 PRINT 3 APCT0646 BSI TYNCH CHARACTERS APCT0647 MDX 2 1 ADVANCE TO NEXT WORD APCT0648 MDX L PRNWD+ORG,-1 COUNT WORDS APCT0649 MDX PRN01 PRINT NEXT WORD APCT0650 BSC I PRNID+ORG EXIT APCT0651 PRNCH EQU GOV01 APCT0652 * APCT0653 * UNPACK CHARACTERS FROM A MESSAGE WORD APCT0654 * X2 CONTAINS ADDRESS OF WORD APCT0655 * X3 CONTAINS WORD FOR STORING 1ST APCT0656 * UNPACKED CHARACTER APCT0657 * APCT0658 UNPK DC 0 APCT0659 LDX 1 3 3 CHARACTERS PER WORD APCT0660 LD 2 0 GET WORD APCT0661 SRT 16 PREPARE TO ISOLATE APCT0662 UNP01 SRA 16 GET NEX APCT0663 D D0040 CHARACTER FROM APCT0664 RTE 16 WORD APCT0665 S D0037 IS THIS ALPHANUMERIC APCT0666 BSC -Z SKIP IF NOT BLANK APCT0667 LD BLNK THIS IS A BLANK APCT0668 BSC +- SKIP IF NOT EQUAL APCT0669 LD EQLCH THIS IS AN EQUAL SIGN APCT0670 A D0037 RESTORE CHARACTER APCT0671 MDX 3 -1 STORE APCT0672 STO 3 0 IT APCT0673 MDX 1 -1 COUNT CHARACTERS APCT0674 MDX UNP01 CONTINUE IF MORE APCT0675 BSC I UNPK+ORG EXIT APCT0676 EQLCH DC /4C-37 APCT0677 BLNK DC /78-37 APCT0678 D0040 DC 40 APCT0679 D0037 DC 37 APCT0680 HDNG SEARCH GLOBAL TABLE APCT0681 * X1 CONTAINS ADDRESS OF ID AND ARGS APCT0682 SGBTB DC 0 APCT0683 PRNWD EQU SGBTB APCT0684 LD 1 0 CALCULATE APCT0685 S 1 1 SYNONYM APCT0686 SRT 16 FOR IDENTIFIER APCT0687 SRA 16 ZERO OUT PRECEDING ID APCT0688 STO 1 3 WITH THIS SYNONYM APCT0689 D D0026 FORM SYNONYM = REMAINDER APCT0690 SLT 16 OF (1ST WORD - 2ND WORD) APCT0691 STO 1 2 DIVIDED BY 26 APCT0692 STO L 2 SAVE SYNONYM APCT0693 LD L2 GLSTB GET POINTER IN GLOBAL APCT0694 * SYNONYM TABLE IE. APCT0695 * POINTER TO 1ST ID WITH APCT0696 * THIS SYNONYM APCT0697 SGB01 BSC L SGB04+ORG,+- IS THIS ZERO POINTER APCT0698 STO L 2 POINTER TO X2 APCT0699 * APCT0700 LDD 2 2 COMPARE APCT0701 SD 1 0 IDENTIFIERS APCT0702 BSC L SGB02+ORG,Z BRANCH IF 1ST WORD APCT0703 SLT 16 NOT SAME APCT0704 BSC L SGB03+ORG,+- BRANCH IF REQUIRED ID APCT0705 SGB02 LD L 2 SAVE X2 AS ADDRESS OF APCT0706 STO 1 3 PREVIOUS ID WITH SAME APCT0707 LD 2 1 SYNONYM. GET POINTER TO APCT0708 MDX SGB01 NEXT ID AND CONTINUE APCT0709 SGB03 LD L 2 GET POINTER TO THIS ID APCT0710 SGB04 STO 1 4 SAVE POINTER APCT0711 BSC I SGBTB+ORG EXIT APCT0712 * APCT0713 D0026 DC 26 APCT0714 HDNG FLOATING POINT ARITHMETIC PACKAGE APCT0715 * THE FLOATING POINT ARITHMETIC PACKAGE APCT0716 * THIS PROGRAM PERFORMS THE BASIC FLOATING APCT0717 * POINT ARITMETIC FUNCTIONS OF ADDITION, APCT0718 * SUBTRACTION, MULTIPLICATION AND DIVISION. APCT0719 * THE STANDARD FLOATING POINT FORMAT IS APCT0720 * EXACTLY AS DESCRIBED IN SRL C26-5929 APCT0721 * 'IBM 1130 SUBROUTINE LIBRARY', PG.35 APCT0722 * UNDER STANDARD PRECISION FORMAT. APCT0723 * ALL RESULTS ARE NORMALIZED AND ROUNDED APCT0724 * TO 24 BITS. EVEN ALIGNMENT OF DATA HAS APCT0725 * BEEN ASSUMED. APCT0726 * ADDITIONAL ENTRY POINTS INCLUDE APCT0727 * A NORMALIZING ROUTINE, DOUBLE LENGTH FIXED APCT0728 * POINT MULTIPLY AND DIVIDE ROUTINES, AND A APCT0729 * DOUBLE DISSASSEMBLE ROUTINE. APCT0730 * ON ENTRY TO FAD,FSB,FMP,FDV THE REGISTERS ARE APCT0731 * ASSUMED TO CONTAIN THE FOLLOWING INFORMATION. APCT0732 * R1= POINTER TO FIRST WORD OF A PLIST WHICH APCT0733 * CONTAINS THE FOLLOWING INFORMATION. APCT0734 * PLIST DC LARG APCT0735 * DC RARG APCT0736 * DC RESULT APCT0737 * ( ALL 1130 ADDRESSES) APCT0738 * THIS ESSENTIALLY PROVIDES THREE ADDRESS APCT0739 * FLOATING POINT INSTRUCTIONS. APCT0740 * ON EXIT THE REGISTERS CONTAIN THE FOLLOWING APCT0741 * R1=UNCHANGED APCT0742 * R2= DESTROYED APCT0743 * R3 MAY BE USED TO OBTAIN THE EXPONENT APCT0744 * OF THE RESULT (EXCESS 128) VIA APCT0745 * LD 3 8 APCT0746 * LDD 3 4 WILL PICK UP THE 32-BIT APCT0747 * (24-BIT-ROUNDED) NORMALIZED FRACTION APCT0748 * APCT0749 FSB BSS 1 APCT0750 LDS 0 CARRY OFF, OVERFLOW OFF APCT0751 LD FSB APCT0752 MDX FPCOM APCT0753 FMP BSS 1 APCT0754 LDS 1 CARRY OFF, OVERFLOW ON APCT0755 LD FMP APCT0756 MDX FPCOM APCT0757 FDV BSS 1 APCT0758 LDS 3 CARRY ON, OVERFLOW ON APCT0759 LD FDV APCT0760 MDX FPCOM APCT0761 FAD BSS 1 APCT0762 LDS 2 CARRY ON, OVERFLOW OFF APCT0763 LD FAD APCT0764 FPCOM STO EXIT+1 SAVE RETURN ADDRESS APCT0765 LDX L3 AARG+ORG APCT0766 BSI L XTRCT+ORG APCT0767 BSC L MPDIV+ORG,O BRANCH ON MULT/DIV APCT0768 BSC L *+3+ORG,C SKIP ON ADDITION APCT0769 ENTR2 SLT 32 CLEAR APCT0770 SD BARG COMPLEMENT APCT0771 STD BARG SAVE APCT0772 LD BEX PICK UP BEXPONENT APCT0773 S AEX FIND SHIFT DIRECTION APCT0774 BSC L FLIP+ORG,-Z IF IN OTHER DRIECTION APCT0775 EOR FP1S COMPLEMENT APCT0776 S FP1S INCREMENT BY 1 APCT0777 STO L 2 FORM SHIFT COUNT IN XR2 APCT0778 LDD BARG SMALL OPERAND IS BARG APCT0779 CERC SRT 2 0 SHIFT SMALLER ARGUMENT APCT0780 MDX 2 -32 SKIP IF WITHIN RANGE APCT0781 SLT 32 ZERO OUT IF NOT APCT0782 AD 3 4 PERFORM ACTUAL ADDITION APCT0783 STD 3 4 SAVE ANSWER IN UNUSED LOC APCT0784 BSC L OFLW+ORG,O IF OVERFLOW THEN OK APCT0785 NLZE SLT 32 CLEAR REGISTERS APCT0786 SD 3 4 COMPLEMENT APCT0787 BSC &Z SEE IF WE SHOULD HAVE APCT0788 LDD 3 4 UNDO THE COMPLEMENTING APCT0789 BSC L FPEXC+ORG,+Z FOR THE CASE /80000000 APCT0790 LDX 2 32 PICK UP SHIFT COUNT APCT0791 SLC 2 SHIFT TO FIRST ONE APCT0792 STX 2 SLTK&1 SAVE IN A TEMPORARY LOC APCT0793 LD EK31 31 IN EXPONENT PART OF WORD APCT0794 S SLTK&1 HOW FAR DID WE SHIFT APCT0795 STO SLTK&1 SAVE MOMENTARILY APCT0796 SLTK LDX L2 *-* PICK UP NORMALIZATION SHIFT APCT0797 LD 3 8 PICK UP EXPONENT APCT0798 S SLTK&1 DECREMENT BY AMOUNT OF SHIFTAPCT0799 STO 3 8 SAVE IT BACK APCT0800 LDD 3 4 PICK UP ARGUMENT APCT0801 SLT 2 SHIFT TILL NORMALIZED APCT0802 BSC &- IS ANSWER ZERO APCT0803 STO 3 8 SAVE AS EXPONENT, TOO APCT0804 LDS 0 APCT0805 AD FRN ROUND UP (DOWN FOR NEG NO) APCT0806 BSC L PATCH+ORG APCT0807 NOP APCT0808 FPRET LD 3 8 PICK UP EXPONENT APCT0809 FARC BSC L *+2+ORG,- IF EXPONENT UNDERFLOW APCT0810 CLEAR SLT 32 ZERO RESULT. APCT0811 MDX EXIT-2 APCT0812 SRT 8 BUILD LOW HALF OF RESULT APCT0813 BSC L FPRNG+ORG,Z APCT0814 * OR UNDERFLOW APCT0815 LD 3 5 HIGH 8 BITS ARE LOW 8 BITS APCT0816 SRA 8 OF FRACTION APCT0817 SRT 8 EXT NOW BUILT APCT0818 LD 3 4 PICK UP FIRST WORD OF ANSWERAPCT0819 STD I1 2 SAVE RESULT THROUGH PLIST APCT0820 EXIT BSC L *-* RETURN APCT0821 SINK DC /8000 APCT0822 EK31 DC /001F APCT0823 FPK1 DC /81 APCT0824 FPEXC SRT 1 APCT0825 MDX OFLW1 APCT0826 FLIP STO L 2 FORM SHIFT COUNT IN XR2 APCT0827 LDD AARG SMALL OPERAND IS AARG APCT0828 MDX 3 -2 SWITCH ANSWER LOCATION TO B APCT0829 MDX CERC APCT0830 OFLW SRT 1 BACK OFF ONE APCT0831 EOR SINK CORRECT SIGN APCT0832 OFLW1 STD 3 4 SAVE ANSWER APCT0833 LD 3 8 PICK UP EXPONENT APCT0834 A D1 CORRECT EXPONENT APCT0835 STO 3 8 SAVE IT JUST IN CASE APCT0836 MDX FARC SEE IF EXPONENT OUT OF RANGEAPCT0837 BSS E 0 APCT0838 FRN DC /0 2-WORD ROUNDING CONSTANT APCT0839 XCES DC /0080 APCT0840 BARG BSS E 2 SECOND ARGUMENT APCT0841 AARG BSS E 2 FIRST ARGUMENT APCT0842 BEX BSS 1 B EXPONENT APCT0843 FP1S DC -1 APCT0844 AEX BSS 1 A EXPONENT APCT0845 * NOTE THAT THE PRECEDING CONSTANTS MUST BE IN APCT0846 * THIS ORDER FOR THE PROGRAM TO WORK APCT0847 MPDIV BSC L DIVID+ORG,C BRANCH IF DIVIDE APCT0848 LD BEX PICK UP BEXPONENT APCT0849 A AEX ADD EXPONENTS ON MULTIPLY APCT0850 S XCES CORRECT FOR EXCESS APCT0851 STO AEX SAVE AS RESULT EXPONENT APCT0852 BSI XMDS PERFORM DOUBLE LENGTH MULT APCT0853 DC AARG+ORG APCT0854 DC BARG+ORG APCT0855 STD AARG RESULT IN ACC & EXT APCT0856 MDX NLZE NORMALIZE AND RETURN APCT0857 DIVID LD AARG PICK UP NUMERATOR APCT0858 BSC L FPTST+ORG,+- TEST FOR ZERO APCT0859 LD BARG PICK UP DENOMINATOR APCT0860 BSC L FPRNG+ORG,+- APCT0861 LD AEX PICK UP A EXPONENT APCT0862 S BEX SUBTRACT APCT0863 A FPK1 APCT0864 STO AEX SAVE AS ANSWER EXPONENT APCT0865 BSI XDDS LONG DIVIDE APCT0866 DC AARG+ORG APCT0867 DC BARG+ORG APCT0868 STD AARG APCT0869 MDX NLZE APCT0870 HDNG DOUBLE LENGTH MULTIPLY ROUTINE APCT0871 XMDS BSS 1 APCT0872 LDX I2 XMDS+ORG APCT0873 LDD I2 0 APCT0874 STD AARG APCT0875 LDD I2 1 APCT0876 D1 EQU *-1 APCT0877 STD BARG APCT0878 M AARG HIGH ORDER PART OF A APCT0879 STD PROD SAVE IN TEMP APCT0880 LD BARG&1 LOW-ORDER PART OF B APCT0881 SRA 1 CLEAR OUT SIGN APCT0882 M AARG HIGH-ORDER PART OF A APCT0883 SRT 15 SHIFT DOWN TO ALIGN APCT0884 AD PROD ADD TO PARTIAL PRODUCT APCT0885 STD PROD SAVE AS NEW PARTIAL PRODUCT APCT0886 XMD1 LD AARG&1 LOW ORDER PART OF A APCT0887 SRA 1 SHIFT TO CLEAR SIGN APCT0888 M BARG HIGH-ORDER PART OF B APCT0889 SRT 15 SHIFT DOWN TO ALIGN APCT0890 AD PROD ADD TO PARTIAL PRODUCT APCT0891 XMD3 SLT 1 SHIFT UP TO NORMALIZE APCT0892 BSC L2 2 RETURN APCT0893 FPTST LDD BARG PICK UP DENOMINATOR APCT0894 BSC L FPRET+ORG,Z ANSWER IS ZERO UNLSS DEN APCT0895 * IS ZERO ALSO APCT0896 ONE LDD FP1 FLOATING POINT 1.0 APCT0897 MDX EXIT-2 APCT0898 FP1 DEC 1.0 FLOATING POINT 1.0 APCT0899 HDNG DOUBLE LENGTH DIVIDE ROUTINE APCT0900 XDDS BSS 1 APCT0901 LDX I2 XDDS+ORG APCT0902 LDD I2 0 APCT0903 STD AARG APCT0904 LDD I2 1 APCT0905 STD BARG APCT0906 LD BARG&1 PICK UP LOWER HALF OF BARG APCT0907 SRA 2 SHIFT DOWN APCT0908 M AARG MULTIPLY BY HIGH ORDER APCT0909 D BARG DIVIDE BY LOW ORDER APCT0910 EOR FP1S COMPLEMENT APCT0911 A D1 FIX UP FOR TWOS COMPLEMENT APCT0912 SRT 14 SHIFT DOWN APCT0913 AD AARG USE TO CORRECT NUMERATOR APCT0914 DIV SRT 2 SHIFT DOWN FOR DIVIDE APCT0915 BSC O DID THE AD OVERFLOW APCT0916 EOR FPK2 CORRECT SIGN POSITIONS APCT0917 D BARG DIVIDE APCT0918 STO PROD SAVE TEMPORARILY APCT0919 SLT 16 BRING IN REMAINDER APCT0920 SRT 1 MOVE DOWN ONE APCT0921 D BARG DIVIDE REMAINDER APCT0922 SRT 15 SHIFT DOWN TO ALIGN APCT0923 A PROD ADD IN PARTIAL QUOTIENT APCT0924 FPBAK BSC L2 2 APCT0925 FPK2 DC /C000 APCT0926 PROD BSS E 2 APCT0927 HDNG DOUBLE DISASSEMBLE ROUTINE APCT0928 XTRCT BSS 1 APCT0929 STS RELDS SAVE STATUS AND CLEAR APCT0930 FPN1 LDD I1 0 PICK UP ARGUMENT 1 APCT0931 STD 3 0 AND SAVE IT LOCALLY APCT0932 RTE 16 GET LOW ORDER WORD IN ACC APCT0933 STS 3 1 STRIP OFF EXPONENT APCT0934 EOR 3 1 PICK UP EXPONENT APCT0935 STO 3 4 SAVE IN EXPONENT LOCATION APCT0936 MDX 3 -2 PREPARE TO DO IT AGAIN APCT0937 LD FPN1+1 APCT0938 EOR D1 COMPLEMENT LOW ORDER BIT APCT0939 STO FPN1+1 APCT0940 BSC L FPN1+ORG,E GO BACK FOR SECOND PASS APCT0941 RELDS LDS *-* RELOAD INDICATORS APCT0942 BSC I XTRCT+ORG BRANCH IF DEXP MINUS APCT0943 HDNG UNFLOAT UTILITY ROUTINE APCT0944 LCUFL DC *-* APCT0945 LDX L1 LCLST+ORG APCT0946 BSI UNFLT UNFLOAT RGS 2,3 APCT0947 BSC I LCUFL+ORG EXIT APCT0948 LCLST DC LOCOR+2 APCT0949 DC LOCOR+2 APCT0950 * UNFLT UTILITY ROUTINES APCT0951 * THIS DECK CONSISTS OF THREE LOGICALLY APCT0952 * DISTINCT ROUTINES. THE FIRST IS UNFLT APCT0953 * WHICH TAKES A FLOATING POINT NUMBER AND APCT0954 * RETURNS A ONE-WORD INTEGER WHICH IS THE APCT0955 * VALUE OF THE FLOATING POINT NUMBER THAT IT APCT0956 * SEES. A DOMAIN ERROR EXISTS IF THE APCT0957 * FLOATING POINT NUMBER IS NEGATIVE, GTR APCT0958 * 2**16-1 OR NOT WITHIN 2**-14 OF AN APCT0959 * INTEGER. APCT0960 * REGISTERS ON ENTRY APCT0961 * R1= POINTER TO PLIST APCT0962 * PLIST DC ARG APCT0963 * DC RESULT APCT0964 * (ALL 1130 ADDRESSES) APCT0965 * REGISTERS ON EXIT APCT0966 * R1= UNCHANGED APCT0967 * R2,3 DESTROYED APCT0968 * RETURN IS TO LOCATION STORED BY BSI. APCT0969 * APCT0970 UNFLT BSS 1 APCT0971 LDD I1 0 PICK UP ARGUMENT APCT0972 STD ARG AND SAVE IT APCT0973 SLT 16 APCT0974 LDS 0 CLEAR STATUS INDICATORS APCT0975 STS ARG&1 CLEAR OUT EXPONENT PART APCT0976 EOR ARG&1 PICK UP EXPONENT APCT0977 S C143 143=128+15 APCT0978 BSC L DOMER+ORG,-Z APCT0979 A C16 ADD BACK 16 APCT0980 BSC L SLT+ORG,-Z IS THER AN INTEGER PART APCT0981 A C14 NO. ADD 14 APCT0982 * FUZZ = 2**-14=6.1E-5 APCT0983 BSC L DOMER+ORG,-Z APCT0984 SRA 16 SET RESULT TO ZERO APCT0985 STO I1 1 SAVE AS RESULT APCT0986 MDX UNRET BACK WE GO APCT0987 SLT STO L 3 SAVE SHIFT COUNT IN XR3 APCT0988 LD ARG PICK UP FIRST WORD OF ARG APCT0989 BSC L DOMER+ORG,+ APCT0990 SRT 16 SHIFT DOWN APCT0991 SLT 3 PICK UP INTEGER PART APCT0992 STO I1 1 SAVE AS RESULT APCT0993 LDD ARG PCIK UP UNCHANGED ARG APCT0994 SLT 3 PART OF THE SHIFT INSTR APCT0995 SRA 1 APCT0996 A UNK1 SEE IF JUST BELOW AN INTEGERAPCT0997 BSC L CRECT+ORG,O BY CHECKING FOR OVFLW APCT0998 LDX 3 13 APCT0999 SLCA 3 CONSECUTIVE ZEROS. APCT1000 BSC L DOMER+ORG,C APCT1001 UNRET BSC I UNFLT+ORG RETURN APCT1002 CRECT LD I1 1 PICK UP ANSWER APCT1003 UNC1 EQU CRECT+1 APCT1004 A UNC1 ADD ONE OT CORRECT APCT1005 STO I1 1 SAVE BACK AS ANSWER APCT1006 MDX UNRET APCT1007 UNK1 DC 4 APCT1008 ARG DEC 0 APCT1009 C143 DC 143 143=128+15 APCT1010 C16 DC 16 WORD LENGTH OF MACHINE APCT1011 FAEX BSS 1 APCT1012 * THE ABOVE 4 CARD MUST BE IN THE ORDER SHOWN. APCT1013 C14 DC 14 APCT1014 HDNG FLOAT ROUTINE APCT1015 * FLT FLOATING ROUTINE APCT1016 * THIS ROUTINE ACCEPTS A ONE WORD INTEGER APCT1017 * AND PRODUCES THE FLOATING POINT EQUIVALENT APCT1018 * OF IT. THE NUMBER MAY BE EITHER POSITIVE APCT1019 * OR NEGATIVE. APCT1020 * REGISTERS ON ENTRY APCT1021 * SAME AS FOR UNFLT APCT1022 * REGISTERS ON EXIT APCT1023 * R1= 1 LESS THAN ON ENTRY APCT1024 * R2,3 DESTROYED APCT1025 * NORMAL RETURN IS THE LOCATION STORED BY APCT1026 * THE BSI INSTRUCTION. APCT1027 * APCT1028 FLT BSS 1 APCT1029 SLT 16 ZERO LOW ORDER OF ARG APCT1030 LD I1 0 PICK UP DATA ITEM APCT1031 MDX 1 -1 POINT XR1 TO 2 LESS THAN APCT1032 * RESULT ADCON APCT1033 STD ARG SAVE NUMBER IN ARGUMENT APCT1034 LD C143 PICK UP EXPONENT APCT1035 STO FAEX SAVE AS EXPONENT APCT1036 LD FLT PICK UP RETURN ADDRESS APCT1037 STO L EXIT+ORG+1 SAVE AS RETURN ADDRESS APCT1038 LDX L3 ARG+ORG-4 ARG CONTAINS NUMBER TO APAPCT1039 BSC L NLZE+ORG BE NORMALISED APCT1040 HDNG FUZZED SUBTRACT TEST FOR EQUALITY APCT1041 * FSBN FUZZED SUBTRACT APCT1042 * THIS ROUTINE DOES THE 'SUBTRACT' NEEDED BY APCT1043 * RELATIONALS AND A FEW OTHERS. IF LARG-RARG APCT1044 * IS LESS THAN 2*-20 TIMES LARG THEN THE APCT1045 * RESULT IS ZERO. OTHERWISE IT HAS THE SIGN APCT1046 * BUT NOT NECESSARILY THE VALUE OF THE APCT1047 * DIFFERENCE. APCT1048 * REGISTERS ON ENTRY APCT1049 * R1= POINTER TO PLIST APCT1050 * PLIST DC LARG APCT1051 * DC RARG APCT1052 * DC RESULT APCT1053 * RARG AND RESULT MUST NOT BE THE SAME APCT1054 * (ALL 1130 ADDRESSES) APCT1055 * REGISTERS ON EXIT APCT1056 * R1=UNCHANGED APCT1057 * R2,3 DESTROYED APCT1058 * NORMAL RETURN IS THE LOCATION STORED BY APCT1059 * THE BSI INSTRUCTION. APCT1060 * APCT1061 FSBN BSS 1 APCT1062 LDD I1 0 GET LARG APCT1063 BSC L SUB+ORG,+- OK TO SUBTRACT IF ZERO APCT1064 STD I1 2 OTHERWISE, IT WILL BE THE APCT1065 EOR I1 1 RESULT IF THE ARGS HAVE APCT1066 BSC I FSBN+ORG,+Z DIFFERENT SIGNS APCT1067 SUB BSI L FSB+ORG APCT1068 FSN1 LD I1 2 PICK UP RESULT OF SUBTRACT APCT1069 RET BSC I FSBN+ORG,+- RETURN IF ZERO APCT1070 LDD I1 0 GET LOW BYTE OF 2ND WORD APCT1071 SLT 24 OF FIRST ARGUEMNT APCT1072 SRA 8 PICK UP EXPONENT APCT1073 S 3 8 SUBTRACT EXPONENT OF RESULT APCT1074 S K20 SUBTRACT 20 APCT1075 BSC I FSBN+ORG,+Z IF NONEG, LEAVE RESULT APCT1076 SLT 32 ELSE, STORE A ZERO APCT1077 STD I1 2 APCT1078 MDX RET APCT1079 K20 DC 20 FUZZ= 2**-20 APCT1080 HDNG EXECUTE STATEMENT CONTROL APCT1081 * APCT1082 XQSTC DC 0 APCT1083 * APCT1084 LDX L2 STUAD EXECUTING FROM INPUT APCT1085 LDX L1 WSERR+ORG DISK FULL ERROR APCT1086 STX L1 MGCOL APCT1087 * LINE APCT1088 XQNXS LDX I1 PAREL GET TOP MOST HEADER APCT1089 LD 2 0 STORE DISK ADDRESS AS APCT1090 STO 1 1 CURRENT POINTER AND APCT1091 STO 1 4 END OF LINE POINTER APCT1092 * APCT1093 LDX L1 LOCOR BASE FOR SYNTAX APCT1094 LD 1 PAREL-LOCOR STORE TOP OF STACK APCT1095 STO 1 14 POINTER IN R14 APCT1096 LD 1 1 STORE NULL STATE IN R15 APCT1097 STO 1 15 APCT1098 SRA 16 ZERO OUT BRANCH SWITCH APCT1099 STO L ISBRN APCT1100 * APCT1101 LDX I2 OVLXQ+ORG EXECUTE APCT1102 BSI 2 NEXT STATEMENT APCT1103 HDNG END OF STATEMENT EXECUTION APCT1104 * APCT1105 * APCT1106 * APCT1107 SXQES LDS 0 APCT1108 BSI CHCKS APCT1109 LD L ISBRN SAVE BRANCH SWITCH APCT1110 STO 3 2 APCT1111 SLA 16 ZERO IT OUT FOR APCT1112 STO L ISBRN NEXT TIME APCT1113 LDX I2 PAREL APCT1114 STX L2 XQE13+ORG+1 APCT1115 LD 2 0 APCT1116 AND X3000 APCT1117 BSC L XQE04+ORG,+- APCT1118 LD 3 PAREL-LOCOR APCT1119 S 3 14 APCT1120 S 3 1 STACK APCT1121 BSC L SYNER+ORG,Z ERROR IF NONE, OR MORE APCT1122 LD 2 0 APCT1123 BSI L ABSAD+ORG APCT1124 STO 3 PAREL-LOCOR MOVE TOP LEVEL HEADER APCT1125 LD 2 -1 APCT1126 MDX 2 4 APCT1127 MDX XQE12 APCT1128 CHCKS DC 0 APCT1129 STS CHC02 APCT1130 LDX L3 LOCOR APCT1131 LDX I2 LOCOR+14 APCT1132 LD 3 PAREL-LOCOR NUMBER OF ENTRIES APCT1133 S 3 14 STACK APCT1134 BSC I CHCKS+ORG,+ APCT1135 STO 3 3 SAVE COUNT APCT1136 * APCT1137 XQE05 LD 2 0 NEXT ENTRY APCT1138 BSC L XQE06+ORG,+ APCT1139 CHC02 LDS APCT1140 BSC L CHC03+ORG,O APCT1141 AND XF000 IF DIRECT, IT MUST BE APCT1142 EOR X1000 A TEMPORARY APCT1143 BSC L SYNER+ORG,Z ERROR IF NOT APCT1144 MDX XQE06 APCT1145 * APCT1146 * APCT1147 CHC03 BSI L ABSAD+ORG APCT1148 LD XFFFF MARK ENTRY AS GARBAGE APCT1149 STO 1 0 APCT1150 * APCT1151 XQE06 MDX 2 1 APCT1152 MDX L LOCOR+3,-1 COUNT ENTRIES APCT1153 MDX XQE05 GO GET NEXT ENTRY IF ONE APCT1154 BSC I CHCKS+ORG APCT1155 X3000 DC /3000 APCT1156 XF000 DC /F000 APCT1157 X1000 DC /1000 APCT1158 XFFFF DC /FFFF APCT1159 XQE04 LD 2 3 APCT1160 BSC L XQS01+ORG,+Z APCT1161 LD L FULST APCT1162 BSC L XQS02+ORG,Z APCT1163 XQS01 LDX 2 IDXOV APCT1164 BSI L GOVLY+ORG APCT1165 BSI 3 XQFNT APCT1166 XQS02 LDS 3 APCT1167 BSI CHCKS APCT1168 * APCT1169 * APCT1170 XQE07 LD I PAREL EXIT IF BOTTOM LEVEL APCT1171 SLA 4 APCT1172 BSC I XQSTC+ORG,+- APCT1173 LD 2 2 SAVE CLASS APCT1174 SRT 8 NEW LINE APCT1175 LD 3 2 BRANCH IF THIS IS APCT1176 BSC L XQE08+ORG,Z A STATEMENT BRANCH APCT1177 LD 2 0 1ST WORD OF TOP OF APCT1178 SLA 1 STACK HEADER APCT1179 BSC I XQSTC+ORG,+Z EXIT IF IMMEDIATE EXECN APCT1180 * APCT1181 XQNXL EQU * APCT1182 LD 2 2 GET NEXT STATEMENT LINE APCT1183 A X0100 ADVANCE BY ONE APCT1184 XQE08 SRA 8 APCT1185 STO 3 2 STORE LINE COUNT APCT1186 SLT 8 IN TOP OF STACK APCT1187 STO 2 2 HEADER APCT1188 LD 2 0 APCT1189 AND X0FFF APCT1190 STO 2 0 APCT1191 * APCT1192 LD 2 3 GET SYPTR APCT1193 BSI L ABSAD+ORG ADDRESS APCT1194 LD 1 0 GET POINTER TO M-ENTRY APCT1195 BSI L ABSAD+ORG FROM SYPTR APCT1196 * APCT1197 LD 1 3 ISOLATE LINE COUNT APCT1198 AND X00FF APCT1199 S 3 2 BRANCH IF OUT APCT1200 BSC L XQE09+ORG,+ APCT1201 LD 3 2 BRANCH IF NOT ZERO APCT1202 BSC L XQBOS+ORG,Z APCT1203 XQE09 LD 2 0 STEP DOWN ONE LEVEL APCT1204 BSI L ABSAD+ORG I N THE APCT1205 STO 3 PAREL-LOCOR STACK APCT1206 LD 2 5 COUNT OF LABELS AND APCT1207 A 2 6 LOCALS PLUS TWO APCT1208 STO 3 3 TO R3 APCT1209 MDX L LOCOR+3,2 APCT1210 LD 2 7 SAVE RESULT OF APCT1211 STO 3 4 FUNCTION APCT1212 * APCT1213 XQE10 LD 2 10 GET NEXT SYPTR APCT1214 BSC L XQE11+ORG,+- IGNORE IF ZERO APCT1215 BSI L ABSAD+ORG GET ADDRESS OF MPTR APCT1216 LD XFFFF MARK 1ST WORD AS APCT1217 STO 1 0 GARBAGE APCT1218 XQE11 MDX 2 3 ADVANCE TO NEXT SYPTR APCT1219 MDX L LOCOR+3,-1 COUNT SYPTRS APCT1220 MDX XQE10 CONTINUE IF MORE APCT1221 * APCT1222 MDX 2 9 NEW SVI APCT1223 LD 3 4 GET FUNCTION RESULT APCT1224 * APCT1225 XQE12 STX L2 LOCOR+14 SAVE NEQ SVI IN R14 APCT1226 STO 2 0 SAVE RESULT OF FUNCTION APCT1227 BSC L XQE15+ORG,+- BRANCH IF RESULTLESS APCT1228 * BRANCH IF INDIRECT APCT1229 BSC L XQE13+ORG,+ WHICH IS POSSIBLE FOR APCT1230 BSI L ABSAD+ORG QUAD. GET ADDRESS OF APCT1231 LD L 2 M-ENTRY APCT1232 SRT 12 ADJUST FIRST WORD APCT1233 LD 1 0 TO POINT TO NEW POSITION APCT1234 SRA 12 OF RESULT SYPTR APCT1235 SLT 12 IN STACK APCT1236 STO 1 0 APCT1237 * APCT1238 XQE13 LDX L1 *-* OLD TOP LEVEL HEADER APCT1239 LD 1 2 GET STATE AND APCT1240 AND X00FF PUT IT IN APCT1241 STO 3 12 R12 APCT1242 SRA 16 APCT1243 STO L FULST APCT1244 LDX I2 OVLXQ+ORG RETURN TO CONTINUE APCT1245 BSC L2 EFPE1 EXECUTION OF STATEMENT APCT1246 XQE15 MDX L LOCOR+14,1 ADVANCE SVI APCT1247 LD 3 PAREL-LOCOR GET ADDRESS OF CPTR APCT1248 A 3 1 IN HEADER APCT1249 LDX L1 GTSPL APCT1250 STO 1 1 SAVE IT IN PARAM LIST APCT1251 BSI L GSYL+ORG GET SYLLABLE APCT1252 LDX 1 -1 INDICATE FULL STATEMENT APCT1253 STX L1 FULST APCT1254 * APCT1255 LD I GTSPL WAS SYLLABLE A APCT1256 S MTCLN METACOLON APCT1257 BSC L SXQES+ORG,+- END OF STATEMENT IF YES APCT1258 S CLNTS OR A COLON PERHAPS APCT1259 BSC L VALER+ORG,Z APCT1260 BSC L SXQES+ORG END OF STATEMENT APCT1261 X7FFF DC /7FFF APCT1262 X8000 DC /8000 APCT1263 X0100 DC /0100 APCT1264 X00FF DC /00FF APCT1265 X0FFF DC /0FFF APCT1266 GTSCP DC 0 APCT1267 MTCLN DC /62 APCT1268 CLNTS DC /58-/62 APCT1269 HDNG BEGIN NEXT STATEMENT APCT1270 XQBOS LDX I1 PAREL APCT1271 LD L ATTN APCT1272 BSC L XQE14+ORG,+- BRANCH IF NO ATTENTION APCT1273 LDX 2 IDXOV APCT1274 BSI L GOVLY+ORG APCT1275 BSI 3 XFNTR APCT1276 BSC I XQSTC+ORG APCT1277 XQE14 LDX I2 PAREL APCT1278 LD 2 3 GET POINTER TO FUNCTION APCT1279 BSI L ABSAD+ORG SYPTR APCT1280 LD 1 0 GET ADDRESS OF M-ENTRY APCT1281 BSI L ABSAD+ORG FOR FUNCTION APCT1282 LD 2 2 GET DISK ADDRESS OF APCT1283 SRA 8 LINE APCT1284 A 1 2 APCT1285 LDX L1 GTSCP+ORG STORE DISK ADDRESS APCT1286 STO 1 0 IN APCT1287 STX L1 GTSPL+1 GETSYL PARAMETER LIST APCT1288 BSI L GNXTW+ORG GET LINE ADDRESS APCT1289 SLA 1 SET CARRY IF TRACE REQUIRED APCT1290 SRA 1 APCT1291 STO XQB06 SAVE DISK ADDRESS APCT1292 LD 2 3 ENSURE TRACE BIT NOT APCT1293 AND X7FFF APCT1294 BSC C SKIP IF NO TRACE. ELSE BIT IN APCT1295 OR X8000 FUNCTION SYPTR APCT1296 XQB04 STO 2 3 SAVE FUNCTION SYPTR APCT1297 LDX L2 XQB06+ORG WORD CONTAINING LINE ADR APCT1298 BSC L XQNXS+ORG EXECUTE NEXT STATEMENT APCT1299 * APCT1300 XQB06 EQU * APCT1301 HDNG GET NEXT WORD FROM DISK APCT1302 * GET NEXT WORD FROM DISK APCT1303 * APCT1304 GNXTW DC 0 APCT1305 LDX L1 GTSPL APCT1306 BSI L GSYL+ORG APCT1307 * APCT1308 LD I GTSPL APCT1309 SLA 8 APCT1310 STO GNX01 APCT1311 * APCT1312 LDX L1 GTSPL APCT1313 BSI L GSYL+ORG APCT1314 * APCT1315 LD I GTSPL APCT1316 OR GNX01 APCT1317 BSC I GNXTW+ORG APCT1318 * APCT1319 HDNG GET ADDRESS OF SYSTEM POINTER APCT1320 * ACCUMULATOR CONTAINS SYLLABLE APCT1321 * APCT1322 SYPTR DC 0 APCT1323 S H22 IS THIS IDENTIFIER APCT1324 BSC L SYP01+ORG,+ SYLLABLE. BRANCH IF YES APCT1325 EOR XFF APCT1326 A BST TABLE. FORM ADDRESS APCT1327 A L OVLIX+ORG APCT1328 MDX SYPXT GO TO EXIT APCT1329 * APCT1330 SYP01 LDX L2 FNDPL APCT1331 BSC L SYP02+ORG,- APCT1332 A 1 1 APCT1333 LDX 1 -1 APCT1334 BSC L ERRXT+ORG,+- APCT1335 A H21 APCT1336 * SYLLABLE ID APCT1337 STO 2 0 APCT1338 SRA 16 APCT1339 MDX SYP03 APCT1340 * APCT1341 SYP02 LDX I3 PSYL+ORG APCT1342 BSI GNXTW APCT1343 STO 2 0 APCT1344 BSI GNXTW APCT1345 STX L3 PSYL+ORG APCT1346 SYP03 STO 2 1 APCT1347 * APCT1348 LD L PAREL APCT1349 SYP09 BSI L ABSAD+ORG ADDRESS OF NEXT LEVEL APCT1350 LD 1 3 IS THIS FUNCTION APCT1351 * (EVEN IF SUSPENDED) APCT1352 BSC L SYP07+ORG,+- BRANCH IF NOT APCT1353 * APCT1354 LDX 2 3 COUNT OF RESULT & ARGS APCT1355 LDX I3 1 GET ADDRESS OF APCT1356 MDX 3 7 RESULT AND ARGUMENTS APCT1357 LDS 0 APCT1358 BSI CHKLB CHECK IF ID ONE OF THESE APCT1359 * IF NOT APCT1360 LD 1 5 ANY LABELS APCT1361 BSC L SYP06+ORG,+- BRANCH IF NOT APCT1362 * APCT1363 SYP05 STO L 2 CHECK ID TO SEE IF IT APCT1364 LDS 3 APCT1365 BSI CHKLB IS A LABEL APCT1366 SYP06 LD 1 6 IF NOT, ARE THERE ANY APCT1367 BSC L SYP07+ORG,+- LOCLAS. BRANCH IF NOT APCT1368 STO L 2 CHECK ID TO SEE IF IT APCT1369 LDS 0 APCT1370 BSI CHKLB IS A LOCAL APCT1371 SYP07 LD 1 0 IS THIS BOTTOM LEVEL APCT1372 EOR X4000 IDENTIFIER IS NOT A LOCALAPCT1373 BSC L SYP09+ORG,Z IF YES APCT1374 * LOCALS IF NOT APCT1375 * NOTE THAT THE ABOVE CODING PERMITS THE APCT1376 * ACCESSING OF .LOCALS OF ALL FUNCTIONS APCT1377 * WITHIN THE FUNCTION STRING, EVEN WHEN THE APCT1378 * TOP LEVEL HEADER IS A SUSPENDED FUNCTION APCT1379 * THE FUNCTION STRING STOPS AT THE FIRST APCT1380 * IMMEDIATE EXECUTION HEADER BELOW THE TOP APCT1381 * LEVEL UNLESS THAT HEADER IS ALSO THE BOTTOM APCT1382 * LEVEL . APCT1383 SYP10 LDX L1 FNDPL SEARCH GLOBAL TABLE APCT1384 BSI L SGBTB+ORG APCT1385 LD 1 4 PICK UP ADDRESS OF SYPTR APCT1386 SYP08 LDX L1 LOCOR RESTORE X1 AND X2 APCT1387 SYPXT BSC I SYPTR+ORG APCT1388 H21 DC /21 APCT1389 X4000 DC /4000 APCT1390 * APCT1391 GNX01 EQU * APCT1392 CHKLB DC 0 APCT1393 STS CHKL3 APCT1394 CHKL1 LDD L FNDPL IS IDENTIFIER IN APCT1395 S 3 1 DIRECTORY EQUAL TO IDENT APCT1396 BSC L CHKL2+ORG,Z APCT1397 SLT 16 IF APCT1398 S 3 2 NOT APCT1399 BSC L CHKL2+ORG,Z APCT1400 LD L 3 IF YES, PUT ADDRESS OF APCT1401 MDX L LOCOR+6,0 APCT1402 MDX SYP08 RETURN TO SYPTR APCT1403 CHKL3 LDS APCT1404 BSC L SYNER+ORG,O APCT1405 MDX SYP08 APCT1406 * APCT1407 CHKL2 MDX 3 3 ADVANCE TO NEXT ID APCT1408 MDX 2 -1 COUNT IDS IN DIRECTORY APCT1409 MDX CHKL1 CONTINUE IF MORE APCT1410 BSC I CHKLB+ORG EXIT IF NOT APCT1411 * APCT1412 H22 DC /22 APCT1413 BST DC BSTBL-/BF APCT1414 XFF DC /FF APCT1415 HDNG TRANSFER FUNCTION SPACE APCT1416 * APCT1417 * TRANSFER F-SPACE APCT1418 * APCT1419 TSTUT DC 0 APCT1420 STX 3 TSC03 APCT1421 LDX 3 8 SET FOR 8 SECTOR MOVE APCT1422 STX 3 TSC02 APCT1423 LDX 3 3 3 TIMES 8 SECTORS APCT1424 TST01 BSI TST02 TRANSFER NEXT 8 SECTORS APCT1425 MDX 1 8 ADVANCE TO AND FROM APCT1426 MDX 2 8 ADDRESSES APCT1427 MDX 3 -1 COUNT 3 APCT1428 MDX TST01 NEXT 8 SECTORS APCT1429 LDX 3 2 SET FOR 2 SECTOR MOVE APCT1430 STX 3 TSC02 APCT1431 BSI TST02 TRANSFER LAST 2 SECTORSAPCT1432 MDX 1 2 UPDATE THEM TO POINT APCT1433 MDX 2 2 TO M-SPACE APCT1434 BSC I TSTUT+ORG APCT1435 TST02 DC 0 APCT1436 STX 1 TSC01 SAVE FROM AND TO APCT1437 LDS 1 READ 8 SECTORS APCT1438 BSI TST03 READ SECTORS APCT1439 STX 2 TSC01 TO ADDRESS APCT1440 LDS 3 WRITE 8 SECTORS APCT1441 BSI TST03 WRITE SECTORS APCT1442 BSC I TST02+ORG APCT1443 TST03 DC 0 APCT1444 BSI L DKORG APCT1445 TSC01 DC 0 APCT1446 TSC03 DC 0 APCT1447 TSC02 DC 0 APCT1448 DC /140 APCT1449 BSC I TST03+ORG APCT1450 * APCT1451 LNGTH EQU *-ASMCT+ORG APCT1452 HDNG IPL PROCEDURE APCT1453 ORG ASMIN-ORG APCT1454 DC 0 APCT1455 APIPL LDD PARMS INITIALISE WORDS IN APCT1456 STD L LOCOR-2 /0FFE - /0FFF APCT1457 LDD PARMS+2 APCT1458 STD L LOCOR APCT1459 STO I OVLIN+ORG APCT1460 STO I OVLED+ORG APCT1461 STO L MODE ZERO OUT MODE APCT1462 LDX L1 STKOR SET UP TOP OF APCT1463 STX L1 PAREL APCT1464 LD Z4000 APCT1465 STO 1 0 APCT1466 LD PARMS+3 APCT1467 STO L CHRCT CARRAIGE APCT1468 BSC L APL+ORG APCT1469 PARMS BSS E 0 APCT1470 DC /1000 APCT1471 DC /1FFF APCT1472 DC 0 APCT1473 DC 1 APCT1474 Z4000 DC /4000 APCT1475 * APCT1476 * APCT1477 * APCT1478 * APCT1479 TSTIN DC 0 APCT1480 LD L CDSW+ORG EXIT IF IN CARD MODE APCT1481 BSC L STRT+ORG,+Z APCT1482 LDX 1 -1 APCT1483 M * DELAY APPROX 1 SECOND APCT1484 MDX 1 -1 APCT1485 MDX *-3 APCT1486 XIO CNSES CHACK SWITCHES APCT1487 LD SETNG BRANCH IF 2741 REQD APCT1488 BSC L TRY41+ORG,+Z APCT1489 LD L TYPSW+ORG APCT1490 LDX L1 LCDBS+DATYP APCT1491 BSI L GTTYP+ORG,Z GET CONSOLE SECTOR IF APCT1492 SRA 16 WAS 2741 INPUT APCT1493 STO L TYPSW+ORG ZERO OUT INPUT SWITCH APCT1494 LD SETNG APCT1495 SLA 1 IF SWITCH 1 IS ON, APCT1496 BSC L STRT+ORG,- APCT1497 LD CDINI SET )CARD EDIT DISP MODE APCT1498 STO L CDSW+ORG INITIALLY APCT1499 STRT BSI L PRCRT+ORG RETURN APCT1500 BSC I TSTIN+ORG EXIT APCT1501 * APCT1502 GTTYP DC 0 APCT1503 STX 1 GTT01 SAVE ADDRESS OF INPUT SECTR APCT1504 LDS 0 APCT1505 BSI L DKORG GET IT APCT1506 GTT01 DC 0 APCT1507 DC ASMT2 APCT1508 DC 1 APCT1509 GTT02 DC /140 APCT1510 BSC I GTTYP+ORG EXIT APCT1511 * APCT1512 * APCT1513 TRY41 MDX L TSTIN+ORG,1 ADJUST FOR 2741 EXIT APCT1514 STO L TYPSW+ORG INDICATE 2741 INPUT APCT1515 LDX L1 LCDBS+DATPA APCT1516 BSI GTTYP GET SECTOR FOR TSS 2741 APCT1517 RDY41 LDX L1 SETNG+ORG APCT1518 LDS 0 FROM 2741 APCT1519 BSI L TYPE2 APCT1520 LD SETNG IS IT RIGHT PAREN APCT1521 S RPARA FOR TSS 2741 APCT1522 BSC L LDCHA+ORG,+- SAVE IT IF YES APCT1523 S RPARB MAYBE IT'S REAL 2741 APCT1524 BSC L RDY41+ORG,Z TRY NEXT CHAR IF NOT APCT1525 * APCT1526 LDX 1 TL41 WE NEED ONLY CHANGE THE APCT1527 STX 1 GTT02 TRANSLATION TABLES FOR APCT1528 LDX L1 LCDBS+DATPB APCT1529 BSI GTTYP REAL 2741 APCT1530 LDCHA LD RPARA RECALL ALC RIGHT PAREN APCT1531 BSC I TSTIN+ORG EXIT APCT1532 BSS E APCT1533 CNSES DC SETNG+ORG APCT1534 DC /3A00 APCT1535 SETNG DC 0 APCT1536 CDINI DC /E000 APCT1537 RPARA DC 86 ALC RIGHT PAREN APCT1538 RPARB DC 57-86 (2741 RPAR USING TS41 TABLE)APCT1539 * MINUS (ALC RPAR) APCT1540 HDNG WRITE ASSEMBLY TO DISK APCT1541 START LDX L1 ASMCT-ORG-2 APCT1542 BSI L DSKIO APCT1543 EXIT APCT1544 * OUTPUT PROGRAM TO DISK APCT1545 DSKIO DC 0 APCT1546 STX 1 DSKI1 APCT1547 STX 1 DSKI3 APCT1548 LIBF DISK1 APCT1549 DC /3000 APCT1550 DSKI1 DC 0 APCT1551 DC DSKI4 APCT1552 DSKI2 LIBF DISK1 APCT1553 DC /0000 APCT1554 DSKI3 DC 0 APCT1555 MDX DSKI2 APCT1556 BSC I DSKIO APCT1557 DSKI4 WAIT APCT1558 BSC I DSKIO APCT1559 END START APCT1560 // XEQ L 1 APCT1561 // JOB APDK0001 // ASM APDK0002 *PRINT SYMBOL TABLE APDK0003 *LIST APDK0004 HDNG ** PREPROLOGUE -- DISK I/O APDK0005 ABS APDK0006 ORG EQU -/800 APDK0007 * DISK ADDRESSES APDK0008 LCDBS EQU /280 1130 BASE ADDR FOR LC DISK APDK0009 DADSK EQU LCDBS+/44 APDK0010 DATYP EQU LCDBS+/45 APDK0011 * ORIGIN OF THIS AND OTHER ASSEMBLIES APDK0012 ASMDK EQU 0 APDK0013 ASMT2 EQU /DE APDK0014 ASMCT EQU /21E APDK0015 * ADDRESSES FROM TYPE 2 ASSEMBLY APDK0016 BEGIN EQU ASMT2+0 APDK0017 ILS4 EQU ASMT2+/11D APDK0018 * ADDRESSES FROM CTRAY ASSEMBLY APDK0019 LOADR EQU ASMCT+/513 APDK0020 * ADDRESSES REQUIRED BY OTHER ASSEMBLIES APDK0021 DC DKORG+ORG-ASMDK APDK0022 DC SETUP+ORG-ASMDK APDK0023 DC PIOCC+ORG-ASMDK APDK0024 DC RIOCC-ASMDK+ORG APDK0025 * LENGTH OF ASSEMBLY APDK0026 DC LNGTH APDK0027 HDNG ORIGIN OF ASSEMBLY APDK0028 ORG ASMDK-ORG+3 APDK0029 DC /E0 APDK0030 DC DADSK APDK0031 HDNG *APL/1130 DISK I/O ROUTINE* APDK0032 * CALLING SEQUENCE APDK0033 * ---------------- APDK0034 * LDS 1 OR 2 FOR READ OR WRITE APDK0035 * BSI L 44 APDK0036 * DC DADDR DISK SECTOR ADDRESS (VALUE) APDK0037 * DC CADDR CORE ADDRESS OF 1ST DATA WD APDK0038 * DC D SECTOR COUNT APDK0039 * DC DDD WORD COUNT OF LAST APDK0040 * SECTOR TO BE DONE APDK0041 * ANY NUMBER OF CONSECUTIVE SECTORS MAY BE READ APDK0042 * OR WRITTEN ON A SINGLE CALL WITH THIS ROUTINE.APDK0043 * NUMBER OF ERROR RETRIES IS CONTROLLED BY APDK0044 * -RETRY-. ALL INDEX REGISTERS ARE PRESERVED. APDK0045 * THE UTILITY WHICH LOADS THE SYSTEM SETS THE APDK0046 * DEFTR TABLE PROPERLY. APDK0047 DEFTR DC /658 APDK0048 DC /0658 LIZED TO NULL CONDITION APDK0049 DC /0658 APDK0050 * INTERRUPT POINTS FOR LEVELS 1 & 4 MUST CORRES- APDK0051 * POND WITH A PRINT INTERRUPT ROUTINE (IF ANY) ANDAPDK0052 * ILS04 RESPECTIVELY. APDK0053 DC ILS0+ORG APDK0054 DC ILS05+ORG APDK0055 DC DKINT+ORG LEVEL 2 APDK0056 DC ILS05+ORG LEVEL 3 -- NULL APDK0057 DC ILS4 LEVEL 4 APDK0058 DC ILS05&ORG LEVEL 5 APDK0059 DKINT DC *-* INTERRUPT POINT APDK0060 STO TEMP SAVE ACC APDK0061 XIO SNSRS-1 SENSE DSW WITH RESET APDK0062 STO DSWRD SAVE IT APDK0063 LD TEMP RESTORE ACC APDK0064 BOSC I DKINT&ORG CLEAR LEVEL AND EXIT APDK0065 TEMP DC 0 FOR ACC DURING INTERRUPT APDK0066 DTEST DC *-* WAIT FOR DISK APDK0067 XIO SENSE-1 OPERATION TO BE COMPLETE APDK0068 AND DMASK APDK0069 BSC I DTEST+ORG,+- APDK0070 DWAIT WAIT APDK0071 MDX DTEST+1 APDK0072 DSWRD DC 0 DSW FROM INTERRUPT APDK0073 SCTRN DC 0 CURRENT SECTOR NUMBER 0-7 APDK0074 WRTCK DC 1 WD CNT FOR RD BEFORE WRITE APDK0075 BSS E 0 APDK0076 BSS 1 APDK0077 SENSE DC /2700 SENSE DSW--NO RESET APDK0078 WCA DC /4CC0 SAVE WD USED FOR WD COUNT APDK0079 SNSRS DC /2701 SENSE DSW W RESET IOCC APDK0080 ADDR DC ILS05+ORG SAVE WD USED FOR I/O ADDRESSAPDK0081 ILS05 DC 0 LEVEL 5 INTERRUPT POINT APDK0082 BOSC I ILS05+ORG CLEAR LEVEL AND EXIT APDK0083 ERCTR DC 0 NUMBER OF ERRORS APDK0084 RETRY DC 10 ERROR LIMIT APDK0085 FSCTR DC 321 FULL SECTOR WORD CT APDK0086 SCTR DC 320 SECTOR MINUS ADDR COUNT APDK0087 DKORG DC *-* ENTRY POINT APDK0088 STX 1 RSTO1+1 SAVE XR1 APDK0089 LDX I1 DKORG+ORG GET ADDRESS OF PARAMS APDK0090 STS RWSW SAVE READ WRITE INDCTR APDK0091 STX 2 RSTO2&1 SAVE XR2 APDK0092 LDX 2 4 PICK UP PARAMETER LIST APDK0093 GTPRM LD 1 0 APDK0094 STO 2 PWDCT-1+ORG APDK0095 MDX 1 1 APDK0096 MDX 2 -1 APDK0097 MDX GTPRM APDK0098 STX 1 DEXIT+1 SAVE RETURN APDK0099 MDX L PWDCT&ORG,1 UP WD CT TO INCL ADDR APDK0100 SETUP BSI DEFCK APDK0101 LDX I2 CADDR+ORG GET CORE ADDRESS APDK0102 LD 2 -1 SAVE AND REPLACE WORDS APDK0103 STO ADDR USED FOR COUNT AND ADDR APDK0104 LD 2 -2 APDK0105 STO WCA APDK0106 LD PWDCT PASSED WORD COUNT WILL APDK0107 MDX L PSCNT&ORG,-1 BE USED ON LAST SECTOR APDK0108 LD FSCTR ALL OTHERS USE 320 WORDS APDK0109 STO 2 -2 APDK0110 LD DADDR PUT ADDRESS FOR WRITE APDK0111 STO 2 -1 APDK0112 MDX 2 -2 XR2 NOW PTS TO I/O AREA APDK0113 RESET EQU * APDK0114 LD RETRY INITIALIZE ERROR COUNTER APDK0115 STO ERCTR APDK0116 STX 2 RECOV+1 APDK0117 SEEK LD DADDR CHECK IF SEEK NECESSARY APDK0118 RECOV LDX L2 *-* RECOVER AFTR WIITE INIT ERR APDK0119 SRT 3 APDK0120 BSC L FAIL+ORG,+- APDK0121 S CLNDR APDK0122 BSC L DOOP&ORG,&- BRANCH IF NO APDK0123 BSC L ARMBK&ORG,& BRANCH IF BACK SEEK APDK0124 RTE 16 SET UP IOCC FOR APDK0125 LD CNTRL FORWARD SEEK APDK0126 RTE 16 APDK0127 ACCES STD IOCC APDK0128 BSI DTEST CHECK FOR DISK READY APDK0129 XIO IOCC PERFORM SEEK APDK0130 LD DADDR UPDATE CYLINDER POINTER APDK0131 SRT 3 APDK0132 STO CLNDR APDK0133 DOOP SRA 16 SAVE SECTOR NUMBER APDK0134 STX 2 IOCC AND I/O ADDRESS APDK0135 SLT 3 APDK0136 STO SCTRN APDK0137 RWSW LDS GET READ/WRITE INDICATOR APDK0138 BSC L DKWRT+ORG,C BRANCH IF WRITE APDK0139 DKRD LD READ PERFORM DISK READ APDK0140 BSI DODSK APDK0141 RSTOR LD WCA RESTORE WCA AND ADDR APDK0142 STO 2 0 WORDS BORROWED FOR I/O APDK0143 LD ADDR OPERATION APDK0144 STO 2 1 APDK0145 LD CADDR UPDATE CORE ADDRESS APDK0146 A SCTR IN CASE THIS IS MULTI APDK0147 STO CADDR SECTOR OPERATION APDK0148 MDX L DKADR+ORG,1 UPDATE DISK ADDRESS APDK0149 MDX L PSCNT&ORG,0 AND BRANCH IF MULTI SECTOAPDK0150 MDX SETUP APDK0151 RSTO1 LDX L1 *-* ELSE, RESTORE XR APDK0152 RSTO2 LDX L2 *-* RESTORE XR2 APDK0153 DEXIT BSC L LOADR AND RETURN TO CALLING PROG. APDK0154 * PWDCT, PSCNT, CADDR, AND DKADR ARE INITIALIZED APDK0155 * TO READ THE REST OF THE SYSTEM. APDK0156 PWDCT DC /140 APDK0157 * FOR LAST SECTOR TO READ APDK0158 * TYPE AND CTRAY ASSEMBLY APDK0159 PSCNT DC 6 APDK0160 CADDR DC BEGIN CORE ADDRESS APDK0161 DKADR DC DATYP DISK ADDRESS APDK0162 IOCC BSS E 2 UNIVERSAL IOCC AREA APDK0163 HOME DC /CB APDK0164 CTROL DC /2404 ARM BACK IOCC APDK0165 READ DC /2600 READ DISK IOCC APDK0166 WRITE DC /2500 WRITE DISK IOCC APDK0167 CLNDR DC 0 CURRENT CYLINDER APDK0168 RDBCK DC /2680 READ BACK CHECK IOCC APDK0169 DADDR DC 0 ADJUSTED DISK ADDRESS APDK0170 CNTRL DC /2400 ARM FORWARD IOCC APDK0171 HDNG DISK I/O SERVICE SUBROUTINES APDK0172 DODSK DC *-* DISK READ WRITE ROUTINE APDK0173 OR SCTRN GET SECTOR NUMBER AND APDK0174 STO IOCC+1 SET I/O COMMAND APDK0175 BSI DTEST CHECK FOR DISK READY APDK0176 XIO XIO IOCC PERFORM OPERATION APDK0177 BSI DTEST WAIT FOR COMPLETION APDK0178 LD DSWRD CHECK FOR DATA ERROR APDK0179 BSC L ERTRY&ORG,&Z BRANCH IF ONE OCCURRED APDK0180 LD 2 1 CHECK DISK ADDRESS--READ APDK0181 EOR DADDR APDK0182 BSC I DODSK&ORG,&- BRANCH IF AGREEMENT APDK0183 ADERR SRA 16 IF ERROR, HOME THE ACCESS APDK0184 STO CLNDR AND INDICATE CYLINDER 0. APDK0185 XIO HOME APDK0186 MDX L ERCTR+ORG,-1 DECRMENT ERROR COUNT APDK0187 MDX SEEK AND RETRY OR APDK0188 MDX ERTRY+3 GO TO ERROR LOOP APDK0189 DKWRT STX 2 DKORG CHECK FOR PROPOER ADDRESSAPDK0190 LDX L2 WRTCK+ORG BY PERFORMING ONE WORD APDK0191 STX 2 IOCC READ OF THE ADDRESS APDK0192 LD READ APDK0193 BSI DODSK APDK0194 LDX I2 DKORG+ORG RESTORE XR2 AND IOCC APDK0195 STX 2 IOCC APDK0196 LD WRITE PERFORM WRITE OPERATION APDK0197 BSI DODSK APDK0198 LD RDBCK PERFORM A READ BACK CHECK APDK0199 BSI DODSK APDK0200 MDX RSTOR APDK0201 MASK DC /FFF8 APDK0202 * THE DISK MAY FUNCTION WITH UP TO THREE DEFECTIVEAPDK0203 * CYLINDERS. IF THE SPECIFIED ADDRESS IS ON OR APDK0204 * ABOVE ONE OR MORE PHYSICALLY DEFECTIVE CYLINDERSAPDK0205 * ALL DATA ID ADJUSTED UP ONE CYLINDER FOR EACH APDK0206 * DEFECTIVE ONE. THE ADDRESS ON THE DISK, HOW- APDK0207 * EVER, WILL BE THE SPECIFIED ONE. APDK0208 DEFCK DC *-* ADJUST FOR DEF CYL RTN APDK0209 LDX 1 -3 APDK0210 LD DKADR APDK0211 STO DADDR APDK0212 DEFLP AND MASK APDK0213 S 1 DEFTR+3+ORG IF SPECIFIED ADDRESS IS APDK0214 BSC I DEFCK+ORG,+Z BELOW ENTRY, BRANCH APDK0215 MDX L DADDR+ORG,8 ELSE, UP ADDR BY ONE CYLINAPDK0216 NOP DER. APDK0217 MDX 1 1 APDK0218 MDX DEFLP APDK0219 BSC I DEFCK&ORG APDK0220 ERTRY MDX L ERCTR+ORG,-1 DECREMENT ERROR APDK0221 MDX XIO COUNTER AND RETRY OR APDK0222 FAIL WAIT APDK0223 MDX FAIL APDK0224 ARMBK STO DEFCK SAVE COUNT APDK0225 LD CTROL SET UP IOCC FOR APDK0226 SRT 16 BACKWARD SEEK APDK0227 S DEFCK APDK0228 MDX ACCES APDK0229 DMASK EQU DWAIT APDK0230 HDNG ** INTERRUPT LEVEL 00 SERVICE RTN. ** APDK0231 * APDK0232 * THIS IS THE LEVEL 0 SERVICE RTN APDK0233 * APDK0234 * APDK0235 ILS0 DC 0 ENTRY POINT APDK0236 STD ITMP0 APDK0237 STS STAT0 APDK0238 XIO SENS0-1 APDK0239 BSC L READ0+ORG,+Z BRANCH IF READ APDK0240 PNCH0 MDX L PIOCC+ORG,1 ADDRESS OF NEXT CHAR. APDK0241 XIO PIOCC APDK0242 MDX STAT0 EXIT APDK0243 READ0 MDX L RIOCC+ORG,1 ADDRESS OF NEXT CHAR. APDK0244 XIO RIOCC APDK0245 STAT0 LDS RESET STATUS APDK0246 LDD ITMP0 RESTORE ACC AND EXT APDK0247 BOSC I ILS0+ORG APDK0248 ORG *-1 APDK0249 BSS E 1 APDK0250 SENS0 DC /1701 APDK0251 ITMP0 BSS E 2 APDK0252 PIOCC DC 0 APDK0253 DC /1100 APDK0254 RIOCC DC 0 APDK0255 DC /1200 APDK0256 LNGTH EQU *-ASMDK+ORG APDK0257 HDNG WRITE ROUTINE TO DISK APDK0258 START LDX L1 DEFTR-2 APDK0259 BSI DSKIO APDK0260 EXIT APDK0261 DSKIO DC 0 APDK0262 STX 1 DSKI1 APDK0263 STX 1 DSKI3 APDK0264 LIBF DISK1 APDK0265 DC /3000 APDK0266 DSKI1 DC 0 APDK0267 DC DSKI4 APDK0268 DSKI2 LIBF DISK1 APDK0269 DC /0000 APDK0270 DSKI3 DC 0 APDK0271 MDX DSKI2 APDK0272 BSC I DSKIO APDK0273 DSKI4 WAIT APDK0274 BSC I DSKIO APDK0275 END START APDK0276 // XEQ L 1 APDK0277 // JOB APFN0001 // ASM APFN0002 *LIST APFN0003 *PRINT SYMBOL TABLE APFN0004 HDNG PREPROLOGUE TO LEFT QUAD,TRACE FUNCTIOAPFN0005 * DISK ADDRESSES APFN0006 ABS APFN0007 LCDBS EQU /280 APFN0008 DAFUN EQU LCDBS+/5E APFN0009 * ORIGINS OF THIS AND OTHER ASSEMBLIES APFN0010 ASMFN EQU /18D1 APFN0011 ASMCT EQU /21E APFN0012 * OVERLAY NUMBER OF THIS ASSEMBLY APFN0013 IDXOV EQU 32 APFN0014 * IMPORTANT ADDRESSES APFN0015 LOCOR EQU /1000 APFN0016 PAREL EQU /1017 APFN0017 FULST EQU /1FF7 APFN0018 ATTN EQU /1FF8 APFN0019 CHCRT EQU /1FF9 APFN0020 GTSPL EQU /1FFA APFN0021 PTSPL EQU /1FFA APFN0022 * ADDRESSES REQUIRED FROM CTRAY APFN0023 ERRXT EQU ASMCT+/37 APFN0024 ABSAD EQU ASMCT+/A8 APFN0025 LCLOD EQU ASMCT+/B1 APFN0026 FSYL EQU ASMCT+/CB APFN0027 PSYL EQU ASMCT+/D5 APFN0028 GSYL EQU ASMCT+/DE APFN0029 TYPE EQU ASMCT+/1A9 APFN0030 MVCRG EQU ASMCT+/1C3 APFN0031 PRCRT EQU ASMCT+/1D1 APFN0032 PRNID EQU ASMCT+/1E3 APFN0033 LCUFL EQU ASMCT+/306 APFN0034 OVLXQ EQU ASMCT+/99 APFN0035 GNXTW EQU ASMCT+/479 APFN0036 * RELATIVE ADDRESSES IN STATEMENT EXECUTION APFN0037 NEXT EQU /4D APFN0038 * ADDRESSES REQUIRED BY OTHER ASSEMBLIESAPFN0039 DC XLQAD-ASMFN APFN0040 DC LQUAD-ASMFN APFN0041 DC XQTFN-ASMFN APFN0042 DC XFNTR-ASMFN APFN0043 DC XQFNT-ASMFN APFN0044 * LENGTH OF THIS ASSEMBLY APFN0045 DC LNGTH APFN0046 HDNG ORIGIN OF ASSEMBLY AND ENTRY POINTS APFN0047 ORG ASMFN-2 APFN0048 DC 4*/140 APFN0049 DC DAFUN APFN0050 DC IDXOV APFN0051 XLQAD BSI L XLQUA APFN0052 BSC L XQEXT APFN0053 LQUAD DC 0 APFN0054 BSI L XLQUA APFN0055 BSC I LQUAD APFN0056 XQTFN BSC L TRCFN APFN0057 XFNTR DC 0 APFN0058 NOP APFN0059 LDS 3 ATTENTION ENTRY APFN0060 BSI L FNTRC PRINT FN NAME AND LINE NOAPFN0061 BSC I XFNTR APFN0062 XQFNT DC 0 APFN0063 LDX I1 PAREL APFN0064 LD 1 3 APFN0065 LDS 0 TRACE ENTRY APFN0066 BSI L FNTRC,+Z APFN0067 BSI L XLQUA APFN0068 BSC I XQFNT APFN0069 HDNG FREE FORMAT OUTPUT CONVERSION APFN0070 ORG EQU 0 APFN0071 * NUMCON OUTPUT CONVERSION APFN0072 * THIS ROUTINES TAKES A FLOATING POINT APFN0073 * NUMBER A AND CONVERTS IT TO AN ALC STRING APFN0074 * FOR OUTPUT. NUMBERS GEQ 1E6 OR LSS 1E-3 APFN0075 * ARE AUTOMATICALLY CONVERTED IN EXPONENTIAL APFN0076 * FORMAT. TRAILING ZEROS ARE ELIMINATED AND APFN0077 * A DECIMAL POINT IS INSERTED ONLY IF THERE APFN0078 * ARE DIGITS FOLLOWING IT. A MAXIMUM OF SIX APFN0079 * SIGNIFICANT DIGITS WILL BE PRODUCED. APFN0080 * AN APL DESCRIPTION OF THIS ROUTINE EXISTS APFN0081 * IN THE WORKSPACE 763785APL1130 ON THE MOD APFN0082 * 50 AS A FUNCTION CALLED CONV. APFN0083 * REGISTERS ON ENTRY APFN0084 * R1= POINTER TO LC LOW CORE (1130 ADDRESS) APFN0085 * LC R7= POINTER TO DATA ITEM (FIRST WORD, APFN0086 * LC ADDRESS) APFN0087 * LC R8= POINTER TO LC OUTPUT AREA OUTBUF APFN0088 * (1ST WORD, LC ADDRESS) APFN0089 * REGISTERS ON EXIT APFN0090 * LC R8 POINTS TO ONE WORD PAST THE LAST ALC APFN0091 * CHARACTER INSERTED INTO OUTBUF APFN0092 * (LC ADDRESS) APFN0093 * ROUTINES CALLED. APFN0094 * NONE APFN0095 * CALLED BY APFN0096 * DALQUB APFN0097 * DALQUD APFN0098 * DADISL APFN0099 * APFN0100 * THE CONSTANTS BM10,BM3,BP10,BM10, ARE APFN0101 * STORED IN THE FOLLOWING FORMAT APFN0102 * WORD 1 SXXX XXXX XXXX XXXX APFN0103 * WORD 2 0XXX XXXX XXXX XXXX APFN0104 * THE BINARY POINT IS BETWEEN BITS 2 AND 3 OF WORD APFN0105 * ONE APFN0106 ALCD0 EQU 27 APFN0107 ALCNG EQU 73 APFN0108 ALCE EQU 5 APFN0109 ALCDP EQU 44 APFN0110 BSS E 0 APFN0111 BP3 DC /5000 APFN0112 DC /0000 APFN0113 * APFN0114 * APFN0115 BM10 DC /4189 1024/1000 APFN0116 DC /1BA6 APFN0117 BM3 DC /3333 8/10 APFN0118 DC /199A APFN0119 CONV3 DC 0 APFN0120 STX L3 PTRQB+ORG APFN0121 LDD 2 0 APFN0122 STD FRACT APFN0123 SLT 16 APFN0124 LDS 0 CLEAR INDICATORS APFN0125 STS FRACT&1 CLEAR LOWER HALF OF WORD APFN0126 EOR FRACT&1 PICK OUT EXPONENT APFN0127 LDX 1 0 SET UP PLUS FLAG APFN0128 STO 1 2 XR2.#E APFN0129 LD FRACT APFN0130 BSC L ZERO+ORG,+- FRACT=0 APFN0131 BSC L OPLUS+ORG,- IF POS. THEN DONT COMP APFN0132 SLT 32 CLEAR REGISTERS APFN0133 SD FRACT COMPLEMENT APFN0134 STD FRACT APFN0135 LDX 1 1 SET UP MINUS FLAG APFN0136 OPLUS STX 1 FLAG STORE FLAG APFN0137 LDX 3 0 SET BASE 10 EXPONENT =0 APFN0138 LDX 1 3 FOR BASE AND SHIFT COUNT APFN0139 MDX L2 -152 SUBTRACT EXCESS AND SCALE APFN0140 NOP APFN0141 OBACK LD 1 -1 PICK UP E APFN0142 BSC L POS+ORG,-Z E APFN0143 L2 BSC L SHIFT+ORG,- E=0 APFN0144 A L C10A+ORG APFN0145 BSC L CLOSE+ORG,-Z E GTR 0 APFN0146 STO 1 -1 SAVE E WHILE MULTIPLYING APFN0147 LDD BP10 1000/1024 APFN0148 BSI OMULT DOUBLE LENGTH MULTIPLY APFN0149 MDX 3 -3 STEP DOWN BASE 10 EXPONENT APFN0150 NOP FOR CHANGE OF SIGN APFN0151 LD 1 -1 PICK UP E APFN0152 MDX L2 CANT BE POSITIVE APFN0153 BSS E 0 ALIGN APFN0154 FRACT BSS 2 MANTISSA IS STORED HERE APFN0155 CLOSE S C7 E#E-7 APFN0156 STO 1 -1 SAVE E WHILE MULTIPLYING APFN0157 LDD BP3 10/8 APFN0158 BSI OMULT DOUBLE LENGTH MULTIPLY APFN0159 MDX 3 -1 COUNT DOWN BASE 10 EXPONENT APFN0160 MDX OBACK APFN0161 MDX OBACK ALLOW FOR CHANGE OF SIGN APFN0162 POS S C10A E#E-10 APFN0163 BSC L NEAR+ORG,+Z E LSS 0 APFN0164 STO 1 -1 SAVE BASE 2 EXPONENT APFN0165 LDD BM10 1024/1000 APFN0166 BSI OMULT DOUBLE LENGTH MULTIPLU APFN0167 MDX 3 3 COUNT UP BASE 10 EXPONENT APFN0168 MDX OBACK NO CHANGE OF SIGN POSSIBLE APFN0169 NEAR A C7 E#E&7 APFN0170 BSC L SHIFA+ORG,+Z E=-1 OR -2 APFN0171 STO 1 -1 SAVE BASE 2 EXPONENT APFN0172 LDD BM3 8/10 APFN0173 BSI OMULT DOUBLE LENGTH MULTIPLY APFN0174 MDX 3 1 COUNT UP BASE 10 EXPONENT APFN0175 MDX OBACK APFN0176 MDX L8 SAVE SOME TIME THIS WAY APFN0177 SHIFA A C3 E#E&3 APFN0178 SHIFT STO 1 -1 PUT INTO XR2 APFN0179 LDD FRACT PICK UP FRACTION APFN0180 L8 SRT 2 TOTAL SHIFT RIGHT IS 2-E APFN0181 SLC 2 WHERE E=0,1,2 APFN0182 SD MAX MAX#9999995 APFN0183 LDX 2 8 GET 8 DIGITS FROM CONVERSION APFN0184 BSC L LOW+ORG,+Z FRCT LSS 9999995 APFN0185 AD RND1 RND1#10000045 APFN0186 L7 SRT 5 PLACE IN LOW PART OF WORD APFN0187 D C1E4 GET TWO HALVES APFN0188 STO FRACT SAVE HIGH ORDER PART APFN0189 SRA 16 CLEAR ACCUMULATOR APFN0190 L6 LDX 1 4 GET 4 DIGITS FROM LOW ORDER APFN0191 L3 D C10A GET A DIGIT APFN0192 RTE 16 PLACE REMAINDER IN ACC APFN0193 STO L2 OUT+ORG-1 SAVE AS NEXT DIGIT APFN0194 SRA 16 CLEAR IT OUT APFN0195 MDX 2 -1 STEP DOWN LOC IN OUT APFN0196 MDX L4O GO STEP XR3 APFN0197 MDX L5 FINISHED CONVERTING APFN0198 L4O MDX 1 -1 STEP XR1 DOWN APFN0199 MDX L3 GET NEXT DIGIT APFN0200 LD FRACT PICK UP HIGH ORDER PART APFN0201 SRT 16 PLACE IN EXT APFN0202 MDX L6 GO GET MORE DIGITS APFN0203 LOW AD C1E7 C1E7#10000000 APFN0204 LDX 2 7 ONLY 7 DIGITS NOW APFN0205 MDX 3 -1 CT#CT-1 APFN0206 MDX L7 IN CASE OF SIGN CHANGE APFN0207 MDX L7 BACK TO MAIN FLOW APFN0208 ZERO STO FLAG APFN0209 LDX 3 -7 APFN0210 SLT 32 APFN0211 MDX L8 APFN0212 C3 DC /0003 CONSTANT 3 APFN0213 C7 DC /0007 CONSTANT 7 APFN0214 CON2 DC /3FFF MASK FOR SHIFT APFN0215 CON DC /00FF LOGICAL CONSTANT APFN0216 C1E4 DC /2710 10000 APFN0217 BSS E 0 ALIGN APFN0218 RND1 DC /1312 10000045 TIMES 2**5 APFN0219 DC /D5A0 APFN0220 C1E7 DC /1312 10000000 TIMES 2**5 APFN0221 DC /D000 APFN0222 BP10 DC /3E80 1000/1024 APFN0223 DC /0000 APFN0224 RND DC /0000 ROUNDING CONSTANT APFN0225 DC /0010 APFN0226 MAX DC /1312 9999995 TIMES 2**5 APFN0227 DC /CF60 APFN0228 FLAG BSS 1 SIGN FLAG FOR FRACTION APFN0229 * THE FOLLOWING IS THE DOUBLE LENGTH MULTIPLY APFN0230 * MULTIPLY ROUTINE. LOCATED HERE SO AS TO BE APFN0231 * REACHABLE BY SHORT INSTRUCTIONS. APFN0232 OMULT BSS 1 ENTRY POINT APFN0233 STD CONST PICK UP CONSTANT APFN0234 M FRACT HIGH-ORDER PART APFN0235 STD EVEN SAVE IN A TEMP APFN0236 LD FRACT&1 PICK UP LOW ORDER FRACT APFN0237 SRA 1 SHIFT TO CLEAR SIGN BIT APFN0238 M CONST HIGH ORDER PART OF CONST APFN0239 SRT 15 SHIFT DOWN TO ALIGN APFN0240 AD EVEN ADD TO PARTIAL PRODUCT APFN0241 STD EVEN STORE BACK IN TEMP APFN0242 LD FRACT HIGH-ORDER PART APFN0243 M CONST&1 LOW-ORDER PART APFN0244 SRT 15 SHIFT DOWN TO ALIGN APFN0245 AD EVEN ACCUMULATE PARTIAL PRODUCT APFN0246 AD RND ROUND APFN0247 SLC 1 SHIFT 3 OR TILL FIRST ONE APFN0248 LDX 1 3 PICK UP SHIFT COUNT APFN0249 BSC L ONORM+ORG,C BRANCH IF TOPPED BY CNT APFN0250 SRT 8 CLEAR ZEROS FROM BOTTOM APFN0251 AND CON WANT LOGICAL SHIFT APFN0252 SHFT SLT 7 DRAG IN ZEROS APFN0253 STD FRACT SAVE APFN0254 BSC I OMULT+ORG RETURN APFN0255 EVEN BSS E 2 PARTIAL PRODUCT ACCUMULATOR APFN0256 CONST BSS 2 TEMPORARY STORAGE FOR CONST APFN0257 C10 DC /000A CONSTANT 10 SECOND COPY APFN0258 ONORM SRT 2 WE WENT 2 LEFT APFN0259 AND CON2 WANT LOGICAL SHIFT APFN0260 AD RND ROUND AGAIN APFN0261 SRT 6 CLEAR LOW ORDER BITS APFN0262 MDX 2 1 ADD 1 TO E APFN0263 MDX SHFT GO BACK FOR RETURN APFN0264 MDX SHFT ALLOW FOR SIGN CHANGE APFN0265 * MULT SUBROUTINE ENDS HERE APFN0266 L5 LD C1 APFN0267 MDX 3 10 APFN0268 SLA 16 APFN0269 MDX 3 -8 APFN0270 SLA 16 APFN0271 STO EXP APFN0272 * EXP.=NOT ((CT LSS -10) OR CT GTR -2) APFN0273 MDX 3 6 APFN0274 NOP APFN0275 STX 3 CT1 APFN0276 * CT.= CT+8 APFN0277 M CT1 APFN0278 SLT 16 APFN0279 BSC & APFN0280 LD EXP APFN0281 A C2 APFN0282 MDX L EXP+ORG,0 APFN0283 S C1 APFN0284 STO DP APFN0285 * DP.=1+(EXP TIMES 1 MAX CT)+ NOT EXP APFN0286 LD CT1 APFN0287 S C1 APFN0288 STO CT1 APFN0289 BSC - APFN0290 SLA 16 APFN0291 EOR ALL1 APFN0292 A C1 APFN0293 M EXP APFN0294 SLT 16 APFN0295 STO LEADZ APFN0296 * LEADZ.=EXP TIMES ABS 0 MIN CT .= CT-1 APFN0297 LDX 1 7 APFN0298 * I .=7 APFN0299 LDX I2 PTRQB+ORG APFN0300 LDX L3 OUT+ORG APFN0301 LD NEG APFN0302 STO 2 0 APFN0303 MDX L FLAG+ORG,0 APFN0304 * OUTBUF.=NEG TIMES IOTA FLAG APFN0305 INSRT MDX 2 1 APFN0306 MDX L DP+ORG,-1 APFN0307 MDX M1 APFN0308 * =.M1 TIMES IOTA 0=DP .=DP-1 APFN0309 LD ALL1 APFN0310 STO DP APFN0311 STO 2 0 APFN0312 * OUTBUF.=OUTBUF,'.' APFN0313 MDX INSRT APFN0314 * .= INSRT APFN0315 M1 LD LEADZ APFN0316 BSC L INSTZ+ORG,-Z APFN0317 * M1.. .=INSTZ TIMES IOTA 0 LEQ LEADZ APFN0318 LD 3 0 APFN0319 MDX 3 1 APFN0320 STO 2 0 APFN0321 * OUTBUF.=OUTBUF, OUT$(8-I$) APFN0322 MDX 1 -1 APFN0323 MDX INSRT APFN0324 * .=INSRT TIMES IOTA 0 = I .=I-1 APFN0325 FINSH LD 2 -1 APFN0326 BSC L TEST+ORG,-Z APFN0327 MDX 2 -1 APFN0328 BSC L FINSH+ORG,- APFN0329 * TRIM OFF TRAILING ZEROS AND A DP IF APFN0330 * NECESSARY. APFN0331 TEST MDX L EXP+ORG,0 APFN0332 MDX TOALC APFN0333 LD TLCE APFN0334 STO 2 0 APFN0335 MDX 2 1 APFN0336 * OUTBUF.=OUTBUF,'E' APFN0337 LD CT1 APFN0338 BSC L M2+ORG,- APFN0339 LD NEG APFN0340 STO 2 0 APFN0341 MDX 2 1 APFN0342 SLA 16 APFN0343 S CT1 APFN0344 M2 SRT 16 APFN0345 D C10A APFN0346 STO 2 0 APFN0347 BSC Z APFN0348 MDX 2 1 APFN0349 RTE 16 APFN0350 STO 2 0 APFN0351 MDX 2 1 APFN0352 * FINISH UP CONVERSION OF EXPONENT APFN0353 TOALC LDX I3 PTRQB+ORG APFN0354 LD PTRQB APFN0355 S L 2 APFN0356 S C1 APFN0357 STO L 1 APFN0358 M4 MDX 1 1 APFN0359 MDX M3 APFN0360 BSC I CONV3+ORG APFN0361 M3 LD 3 0 APFN0362 BSC +Z SKIP IF A NUMBER APFN0363 A TLCDP INCREMENT E OR DECIMAL APFN0364 A TLCDG APFN0365 * CONVERT OUTBUF TO ALC BY ADDING 35 APFN0366 STO 3 0 APFN0367 MDX 3 1 APFN0368 MDX M4 APFN0369 INSTZ S C1 APFN0370 STO LEADZ APFN0371 * LEADZ.=LEADZ-1 APFN0372 SLA 16 APFN0373 STO 2 0 APFN0374 * OUTBUF.=OUTBUF,0 APFN0375 * =. INSRT APFN0376 MDX INSRT APFN0377 OUT BSS 8 APFN0378 C1 EQU M4-1 APFN0379 C2 EQU M4-4 APFN0380 NEG DC ALCNG-ALCD0 APFN0381 TLCE DC ALCE-ALCDP-1 APFN0382 CT1 EQU EVEN APFN0383 DP EQU EVEN&1 APFN0384 EXP EQU CONST APFN0385 LEADZ EQU CONST&1 APFN0386 TLCDG DC ALCD0 APFN0387 ALL1 DC /FFFF APFN0388 C10A EQU C10 APFN0389 TLCDP DC ALCDP-ALCD0+1 DIF TWIXT TWO CODES APFN0390 PTRQB DC 0 APFN0391 HDNG PRINT FUNCTION AND LINE NUMBER APFN0392 * SUBROUTINE PRINT FUNCTION AND LINE NUMBER APFN0393 * APFN0394 * X1 CONTAINS TOP OF STACK POINTER APFN0395 FNTRC DC 0 APFN0396 * APFN0397 STS FNT02 SAVE ENTRY INDICATOR APFN0398 LD 1 2 SAVE LINE APFN0399 STO LNNUM+1 NUMBER APFN0400 LD 1 3 GET FUNCTION SYPTR APFN0401 BSI L ABSAD APFN0402 MDX 1 2 ADDRESS OF FUNCTION ID APFN0403 STX L1 2 IDENTIFIER IS APFN0404 LDX 1 2 TWO WORDS LONG APFN0405 BSI L PRNID PRINT IT APFN0406 LD 2 -4 APFN0407 BSI L ABSAD APFN0408 LD 1 3 APFN0409 BSC L FNT03,- PRINT LINE IF UNLOCKED APFN0410 LD FNT02 APFN0411 BSC L FNT02,E BUT NOT IF LOCKED ATTN APFN0412 FNT03 EQU * APFN0413 LDX L1 LBRKT PRINT LEFT PARENTHESIS APFN0414 BSI L TYPE APFN0415 LD LNNUM+1 GET LINE NUMBER APFN0416 SRT 24 FORM TENS AND APFN0417 D TEN APFN0418 STD LNNUM SAVE UNIT DIGIT APFN0419 BSC L FNT01,+- BRANCH IF LESS THAN TEN APFN0420 MDX L LNNUM,27 FROM TEN DIGIT APFN0421 LDX L1 LNNUM PRINT TEN DIGIT APFN0422 BSI L TYPE APFN0423 FNT01 MDX L LNNUM+1,27 FORM UNIT DIGIT APFN0424 LDX L1 LNNUM+1 PRINT UNIT DIGIT APFN0425 BSI L TYPE APFN0426 LDX L1 RBRKT PRINT RIGHT BRACKET APFN0427 BSI L TYPE APFN0428 LD D7 APFN0429 BSI L MVCRG APFN0430 FNT02 LDS APFN0431 BSI L PRCRT,O CRT IF ATTN ENTRY APFN0432 * APFN0433 BSC I FNTRC EXIT APFN0434 * APFN0435 D7 DC 7 APFN0436 LBRKT DC /29 APFN0437 RBRKT DC /2A APFN0438 BLKCH DC /78 APFN0439 LARGA BSS E 2 APFN0440 LARGL BSS E 2 APFN0441 LNNUM DC 0 APFN0442 DC 0 APFN0443 TEN DC 10 APFN0444 HDNG QUAD ON LEFT EXECUTION APFN0445 * APFN0446 * APFN0447 * APFN0448 R14 EQU LOCOR+14 APFN0449 ADABS DC 0 ACC / 1570 TYPE ADDRESS APFN0450 AND ADMSK APFN0451 A ADBSE APFN0452 STO L 2 APFN0453 BSC I ADABS APFN0454 ADMSK DC /0FFF APFN0455 ADBSE DC /1000 APFN0456 XLQUA DC 0 APFN0457 LDX L1 LOCOR APFN0458 LD 1 14 APFN0459 STO QUAE+1 APFN0460 S 1 PAREL-LOCOR APFN0461 BSC L QUAE,- APFN0462 QUALD LD 1 14 APFN0463 BSI L LCLOD ENTRY IN STACK APFN0464 BSC L QUAL1,- BRANCH IF INDIRECT APFN0465 QUALI EOR HFFFF APFN0466 BSI ADABS APFN0467 LD 2 0 APFN0468 QUAL1 BSC L QUAX,+- APFN0469 BSI ADABS APFN0470 LD 2 0 FIRST WD OF MENTRY APFN0471 SLA 1 APFN0472 SRT 15 APFN0473 STO CHTST APFN0474 SRA 16 APFN0475 SLT 2 APFN0476 STO DIMSN APFN0477 SLT 32 APFN0478 LD 2 1 RANK VECTOR APFN0479 RTE 8 APFN0480 STO CLDIM # ELEMENTS IN A COLUMN APFN0481 SRA 16 APFN0482 SLT 8 APFN0483 STO RWDIM # ELEMENTS IN A ROW APFN0484 M CLDIM APFN0485 SLT 16 APFN0486 STO ELCNT # ELEMENTS APFN0487 BSC L QUAX,+- IF NO ELEMENTS APFN0488 MDX 2 2 APFN0489 STX 2 DTAPT APFN0490 LD CHTST APFN0491 BSC L QUAS,Z PRINT CH DATA APFN0492 LD DIMSN APFN0493 S H0002 APFN0494 BSC L QUAM,+- PRINT NUMERICAL MATRIX APFN0495 QUALV LDX I2 DTAPT X2 POINTS TO FP APFN0496 BSI GETDC RETURNS X1 PTING FIRST CH APFN0497 STO RHOQ ACC / # CHS APFN0498 STX 1 CHPTR APFN0499 LD CGLEN LENGTH OF CARRIAGE APFN0500 S L CHCRT POSITIONS USED ALREADY APFN0501 S RHOQ APFN0502 BSC + APFN0503 BSI QUAI NO ROOM ON THIS LINE, CR 5BLSAPFN0504 BSI PRQBF APFN0505 MDX L DTAPT,2 APFN0506 MDX L ELCNT,-1 APFN0507 MDX QUAL3 APFN0508 MDX QUAX APFN0509 QUAL3 LD CGLEN APFN0510 S L CHCRT APFN0511 S H0002 APFN0512 BSC L QUALV,+Z APFN0513 LDX L1 CBL APFN0514 BSI L TYPE APFN0515 LDX L1 CBL APFN0516 BSI L TYPE APFN0517 MDX QUALV APFN0518 QUAX MDX L R14,1 APFN0519 LDX L1 LOCOR APFN0520 LD 1 14 APFN0521 S 1 PAREL-LOCOR APFN0522 BSC L QUAE,- APFN0523 LD 1 14 APFN0524 BSI L LCLOD IN STACK APFN0525 BSC L QUALI,+Z APFN0526 BSC L QUAX,+ APFN0527 SRA 12 APFN0528 S 1 1 APFN0529 BSC L QUALD,+- APFN0530 QUAE LDX L3 *-* RESTORE R14 APFN0531 STX L3 R14 APFN0532 BSI L PRCRT APFN0533 BSC I XLQUA APFN0534 H4079 DC /4079 APFN0535 CHTST DC 0 APFN0536 H0002 DC /0002 APFN0537 HFFFF DC /FFFF APFN0538 DIMSN DC 0 APFN0539 CLDIM DC 0 APFN0540 RWDIM DC 0 APFN0541 ELCNT DC 0 APFN0542 DTAPT DC 0 APFN0543 CGLEN DC 110 APFN0544 RWELC DC 0 APFN0545 RWD DC 0 APFN0546 PRQBF DC 0 APFN0547 PRQB1 LDX I1 CHPTR C/CHPTR PTS FIRST CH TO PRINTAPFN0548 BSI L TYPE APFN0549 MDX L CHPTR,1 APFN0550 MDX L RHOQ,-1 C/RHOQ IS NUMBER OF CHS APFN0551 MDX PRQB1 APFN0552 LD L ATTN APFN0553 BSC L QUAE,Z PREPARE FOR EXIT FROM XLQUA APFN0554 BSC I PRQBF APFN0555 CHPTR DC 0 APFN0556 RHOQ DC 0 APFN0557 PRBLS DC 0 ON ENTRY PRBLC CONTAINS COUNT APFN0558 PRBL1 LDX L1 CBL APFN0559 BSI L TYPE APFN0560 MDX L PRBLC,-1 APFN0561 MDX PRBL1 APFN0562 BSC I PRBLS APFN0563 PRBLC DC 0 APFN0564 CBL DC /78 APFN0565 QUAI DC 0 APFN0566 BSI L PRCRT APFN0567 LD CIDNT APFN0568 STO PRBLC APFN0569 BSI PRBLS APFN0570 BSC I QUAI APFN0571 CIDNT DC 6 APFN0572 * GETDC ON ENTRY X2 POINTS TO FP APFN0573 GETDC DC 0 APFN0574 LDX L3 QBUF APFN0575 BSI L CONV3 APFN0576 LD L 3 APFN0577 S REQB APFN0578 LDX L1 QBUF APFN0579 BSC I GETDC APFN0580 REQB DC QBUF APFN0581 QUAS LD DIMSN APFN0582 S H0002 APFN0583 BSC L QUAS2,Z APFN0584 QUAS1 BSI L PRCRT APFN0585 QUAS2 LD RWDIM APFN0586 STO RWELC APFN0587 QUAS3 LD CGLEN APFN0588 S L CHCRT APFN0589 BSI L QUAI,+ APFN0590 LDX I1 DTAPT APFN0591 LD 1 0 APFN0592 S H4079 APFN0593 BSC L QUAS6,+- SPECIAL TREATMENT OF CR APFN0594 BSI L TYPE APFN0595 QUAS5 MDX L DTAPT,2 APFN0596 LD L ATTN CHECK ATTN APFN0597 BSC L QUAE,Z APFN0598 MDX L RWELC,-1 APFN0599 MDX QUAS3 APFN0600 MDX L CLDIM,-1 APFN0601 MDX QUAS1 APFN0602 MDX QUAX APFN0603 QUAS6 BSI L PRCRT APFN0604 MDX QUAS5 APFN0605 QMNRW BSI L PRCRT PRINTS THE MATRIX AFTER RWD APFN0606 LD RWDIM IS CALCULATED APFN0607 STO RWELC APFN0608 QMNXT LDX I2 DTAPT APFN0609 BSI L GETDC APFN0610 STO RHOQ APFN0611 STX 1 CHPTR USED BY PRQBF APFN0612 LD CGLEN APFN0613 S L CHCRT APFN0614 S RWD APFN0615 BSI L QUAI,+Z APFN0616 LD RWD APFN0617 S RHOQ APFN0618 STO PRBLC USED BY PRBLS APFN0619 LDX I1 RWD APFN0620 MDX 1 -8 APFN0621 MDX QMEXP PRINT IN EXP FORMAT APFN0622 BSI PRBLS PRINT IN INTEGER FORMAT APFN0623 BSI PRQBF APFN0624 QMORE MDX L DTAPT,2 APFN0625 MDX L RWELC,-1 APFN0626 MDX QMNXT APFN0627 MDX L CLDIM,-1 APFN0628 MDX QMNRW APFN0629 BSC L QUAX APFN0630 QMEXP LD I CHPTR APFN0631 S NEGCH APFN0632 BSC L QMEX1,+- APFN0633 LDX L1 CBL APFN0634 BSI L TYPE APFN0635 MDX L PRBLC,-1 APFN0636 QMEX1 BSI L PRQBF APFN0637 BSI PRBLS APFN0638 MDX QMORE APFN0639 NEGCH DC /49 APFN0640 QUAM LDX I1 DTAPT APFN0641 LDX 2 5 ASSUME SHORT PRINT APFN0642 QUAM1 LDD 1 0 I.E. OUTPUT WIDTH 5,8 OR 13APFN0643 SRT 8 APFN0644 SLT 8 GET RID OF EXPONENT APFN0645 BSC L QUAM2,- APFN0646 STD MNTSA APFN0647 SLT 32 UNCOMP THE 2'S COMP FP APFN0648 SD MNTSA APFN0649 QUAM2 BSC L QUAM5,+- IF N=0 THEN RWD IS UNCHANGED APFN0650 SLT 1 NORMALIZE APFN0651 STD MNTSA APFN0652 LD 1 1 EXPONENT IN BOTTOM 8 BITS APFN0653 SLA 8 APFN0654 SRA 8 APFN0655 S DC128 APFN0656 BSC L FMEXP,+Z NEG EXP PRINTS IN EXP FORM APFN0657 STO L 3 EXP GTQ 0 APFN0658 S DC020 APFN0659 BSC L FMEXP,- EXP GT 20 PRINTS IN EXP APFN0660 LDD MNTSA APFN0661 SLT 3 0 APFN0662 BSC L FMEXP,Z APFN0663 SLT 16 APFN0664 BSC L FMEXP,Z DEC FRACTIONS PRINT IN EXP FMAPFN0665 MDX 3 -9 APFN0666 LDX 2 8 DEC GT 999 PRINT WITH RWD =8 APFN0667 QUAM5 MDX 1 2 APFN0668 MDX L ELCNT,-1 APFN0669 MDX QUAM1 APFN0670 MDX QUAM6 APFN0671 FMEXP LDX 2 13 APFN0672 QUAM6 STX L2 RWD APFN0673 MDX QMNRW APFN0674 MNTSA BSS E 2 APFN0675 DC128 DC 128 APFN0676 DC020 DC 20 APFN0677 HDNG EXECUTE FUNCTION TRACE APFN0678 * APFN0679 * APFN0680 TRCFN LDX L1 GTSPL APFN0681 BSI L GSYL APFN0682 LD I GTSPL APFN0683 S DELTA ERROR IF NOT DELTA APFN0684 BSC L SYNER,Z APFN0685 BSI L GSYL APFN0686 LD I GTSPL APFN0687 S TTT ERROR IF NOT FOLLOWED APFN0688 BSC L SYNER,Z BY A T APFN0689 * APFN0690 LD I LOCOR+14 GET RIGHT HAND SIDE APFN0691 BSC L XQT01,- INDIRECT. BRANCH IF NO. APFN0692 EOR YFFFF DECOMPLEMENT IF YES APFN0693 BSI L LCLOD GET M-POINTER APFN0694 * APFN0695 * APFN0696 * APFN0697 XQT01 BSI L ABSAD ADDRESS OF M-ENTRY APFN0698 LD 1 0 GET FIRST WORD OF APFN0699 SLA 2 ENTRY APFN0700 BSC L RNKER,+Z ERROR IF RANK IS 2 APFN0701 MDX 1 2 APFN0702 * APFN0703 STX 1 XQT05+1 SAVE ADDRESS OF ENTRY APFN0704 XQT02 LD L LOCOR+13 ADDRESS OF FN SYPTR APFN0705 BSI L ABSAD M-ENTRY APFN0706 LD 1 0 APFN0707 BSI L ABSAD TO X1 APFN0708 LD 1 3 SAVE COUNT OF APFN0709 BSC L XQEXT,+Z APFN0710 AND Y00FF LINES APFN0711 STO FNLCT APFN0712 STO LNCNT APFN0713 LD 1 2 DISK ADDRESS OF FUNCTION APFN0714 LDX L1 GTSCP TO GETSYL APFN0715 STO 1 0 PARAMETER LIST APFN0716 STX L1 GTSPL+1 DISK ADDRESS APFN0717 LDX L1 LNDIR ADDRESS OF LINE DRECTRY APFN0718 STX 1 XQT04+1 SAVE IT APFN0719 * APFN0720 XQT03 BSI L GNXTW GET NEXT LINE ADDRESS APFN0721 AND Y7FFF REMOVE TRACE BIT APFN0722 XQT04 STO L *-* SAVE LINE ADDRESS IN APFN0723 MDX L XQT04+1,1 DIRECTORY. NEXT LINE APFN0724 MDX L LNCNT,-1 COUNT LINES APFN0725 MDX XQT03 CONTINUE IF MORE APFN0726 * APFN0727 * APFN0728 * APFN0729 LDX I1 XQT05+1 ADDRESS OF RHS VECTOR APFN0730 LD 1 -1 IS IT APFN0731 AND Y00FF EMPTY APFN0732 BSC L XQT07,+- BRANCH IF YES APFN0733 STO LNCNT LENGTH OF VECTOR APFN0734 LDX L1 LOCOR APFN0735 XQT05 LDD L *-* GET NEXT ELEMNT APFN0736 BSC L XQT06,+ APFN0737 STD 1 2 SAVE NUMBER APFN0738 BSI L LCUFL UNFLOAT IT APFN0739 LDX L1 LOCOR RESTORE BASE APFN0740 LD FNLCT IGNORE IF APFN0741 S 1 2 GREATER THAN APFN0742 BSC L XQT06,+ LINE COUNT APFN0743 LDX I2 LOCOR+2 APFN0744 LD L2 LNDIR APFN0745 OR Y8000 APFN0746 STO L2 LNDIR APFN0747 * APFN0748 XQT06 MDX L XQT05+1,2 ADVANCE TO NEXT ELEMENT APFN0749 MDX L LNCNT,-1 APFN0750 MDX XQT05 APFN0751 * APFN0752 XQT07 LDX I1 XQT04+1 ADDRESS OF LAST WORD OF APFN0753 MDX 1 -1 LINE DIRECTORY APFN0754 LDX I2 FNLCT OUTPUT LINE APFN0755 BSI BMTNW DIRECTORY TO DISK APFN0756 * APFN0757 LDX L1 PTSPL FLUSH OUTPUT APFN0758 BSI L FSYL BUFFER APFN0759 HDNG RETURN TO NEXT APFN0760 * APFN0761 XQEXT LDX 1 -1 APFN0762 STX L1 FULST SEEN APFN0763 LD Y0080 SET PREVIOUS STATE APFN0764 STO L LOCOR+15 APFN0765 LDX I2 OVLXQ APFN0766 BSC L2 NEXT+1 APFN0767 * APFN0768 Y0080 DC /0080 APFN0769 DELTA DC /34 APFN0770 TTT DC /14 APFN0771 YFFFF DC /FFFF APFN0772 Y00FF DC /00FF APFN0773 LNCNT DC 0 APFN0774 Y7FFF DC /7FFF APFN0775 Y8000 DC /8000 APFN0776 FNLCT DC 0 APFN0777 GTSCP DC 0 APFN0778 SYNER LDX 1 4 APFN0779 MDX ERROR APFN0780 RNKER LDX 1 16 APFN0781 ERROR MDX L1 /4000 APFN0782 BSC L ERRXT APFN0783 HDNG OUTPUT N WORDS TO DISK APFN0784 * X1 CONTAINS ADDRESS OF LAST WORD APFN0785 * X2 CONTAINS COUNT APFN0786 BMTNW DC 0 APFN0787 STX 1 BMT01+1 SAVE APFN0788 STX 2 BMT02 REGISTERS APFN0789 * APFN0790 BMT01 LD L *-* GET NEXT WORD APFN0791 AND Y00FF APFN0792 LDX L1 CHAR ADDRESS OF CHARACTER APFN0793 STO 1 0 STORE CHARACTER APFN0794 BSI BMITC OUTPUT TO DISK APFN0795 LD I BMT01+1 GET WORD AGAIN APFN0796 SRA 8 ISOLATE TOP BYTE APFN0797 LDX L1 CHAR ADDRESS OF CHARACTER APFN0798 STO 1 0 STORE CHARACTER APFN0799 BSI BMITC OUTPUT TO DISK APFN0800 MDX L BMT01+1,-1 ADJUST ADDRESS OF WORD APFN0801 MDX L BMT02,-1 COUNT WORDS APFN0802 MDX BMT01 CONTINUE IF MORE APFN0803 * APFN0804 LDX I1 BMT01+1 RESTORE UPDATED ADDRESS APFN0805 BSC I BMTNW EXIT APFN0806 BMT02 DC 0 APFN0807 CHAR DC 0 APFN0808 * APFN0809 BMITC DC 0 APFN0810 STX L1 PTSPL APFN0811 LDX L1 PTSPL APFN0812 BSI L PSYL APFN0813 BSC I BMITC APFN0814 QBUF BSS 13 APFN0815 ORG QBUF APFN0816 LNDIR BSS 51 APFN0817 LNGTH EQU *-ASMFN APFN0818 HDNG WRITE ASSEMBLY TO DISK APFN0819 START LDX L1 ASMFN-2 APFN0820 BSI DSKIO APFN0821 EXIT APFN0822 DSKIO DC 0 APFN0823 STX 1 DSKI1 APFN0824 STX 1 DSKI3 APFN0825 LIBF DISK1 APFN0826 DC /3000 APFN0827 DSKI1 DC 0 APFN0828 DC DSKI4 APFN0829 DSKI2 LIBF DISK1 APFN0830 DC /0000 APFN0831 DSKI3 DC 0 APFN0832 MDX DSKI2 APFN0833 BSC I DSKIO APFN0834 DSKI4 WAIT APFN0835 BSC I DSKIO APFN0836 END START APFN0837 // XEQ L 1 APFN0838 // JOB APIN0001 // ASM APIN0002 *LIST APIN0003 *PRINT SYMBOL TABLE APIN0004 HDNG PREPROLOGUE TO INPUT/EDIT APIN0005 ABS APIN0006 * DISK ADDRESSES OF OVERLAYS APIN0007 LCDBS EQU /280 APIN0008 DAINP EQU LCDBS+/4B APIN0009 DAEDT EQU LCDBS+/52 APIN0010 DACLN EQU LCDBS+/6B APIN0011 * STARTING POINT OF DISK STORAGE APIN0012 DASTU EQU 26*/140 APIN0013 * ORIGINS OF THIS AND OTHER ASSEMBLIES APIN0014 ASMIN EQU /730 APIN0015 ASMED EQU /18D1 APIN0016 ASMDK EQU 0 APIN0017 ASMT2 EQU /0DE APIN0018 ASMCT EQU /21E APIN0019 * OVERLAY NUMBER OF THESE AND OTHER ASSEMBLIES APIN0020 INPOV EQU 4 APIN0021 PCHOV EQU 12 APIN0022 EDTOV EQU 28 APIN0023 * IMPORTANT LOCATIONS APIN0024 LOCOR EQU /1000 APIN0025 PAGE0 EQU /1791 APIN0026 CONST EQU /1F7A APIN0027 STBFS EQU CONST-1 APIN0028 STBFE EQU STBFS-159 APIN0029 DSPML EQU /1F7A APIN0030 LINDR EQU /1F7E APIN0031 LNPML EQU /1FE4 APIN0032 RSEND EQU /1FEA APIN0033 FNDPL EQU /1FEC APIN0034 ISBRN EQU /1FF3 APIN0035 MODE EQU /1FF4 APIN0036 USER EQU /1FF5 APIN0037 SINON EQU /1FF6 APIN0038 FULST EQU /1FF7 APIN0039 ATTN EQU /1FF8 APIN0040 CHRCT EQU /1FF9 APIN0041 PTSPL EQU /1FFA APIN0042 GTSPL EQU PTSPL APIN0043 MGCOL EQU /1FFE APIN0044 FGCOL EQU /1FFF APIN0045 * ADDRESSES IN CTRAY ASSEMBLY APIN0046 CDSW EQU ASMCT APIN0047 TYPSW EQU ASMCT+1 APIN0048 ERRAD EQU ASMCT+/37 APIN0049 ABSAD EQU ASMCT+/A8 APIN0050 GOVLY EQU ASMCT+/6B APIN0051 FSYL EQU ASMCT+/CB APIN0052 PSYL EQU ASMCT+/D5 APIN0053 GSYL EQU ASMCT+/DE APIN0054 CLOMN EQU ASMCT+/153 APIN0055 GETSP EQU ASMCT+/160 APIN0056 TYPE EQU ASMCT+/1A9 APIN0057 TYNCH EQU ASMCT+/1B4 APIN0058 MVCRG EQU ASMCT+/1C3 APIN0059 PRCRT EQU ASMCT+/1D1 APIN0060 SGBTB EQU ASMCT+/207 APIN0061 GNXTW EQU ASMCT+/479 APIN0062 XDDS EQU ASMCT+/2D4 APIN0063 XMDS EQU ASMCT+/2B3 APIN0064 TSTIN EQU ASMCT+/52F APIN0065 * ADDRESSES IN TYPE2 APIN0066 TYPE2 EQU ASMT2+/52 APIN0067 DSW42 EQU ASMT2+/13A APIN0068 * ADDRESSES IN DSKIO APIN0069 PIOCC EQU ASMDK+/DA APIN0070 RIOCC EQU ASMDK+/DC APIN0071 * RELATIVE ADDRESS FROM PUNCH ASSEMBLY APIN0072 FNDSP EQU 7 APIN0073 * MISCELLANEOUS APIN0074 CCRAN EQU 29 APIN0075 NUMCC EQU /63 APIN0076 * PERMANENT ADDRESSES USED BY OTHER ASSEMBLIES APIN0077 DC LWKSP APIN0078 DC NEXEN APIN0079 DC EGBTB APIN0080 DC LNGLD APIN0081 DC LENGL APIN0082 DC NUMGL APIN0083 DC MSTRT APIN0084 DC MNEXT APIN0085 DC STUAD APIN0086 DC SOLPT APIN0087 DC PAREL APIN0088 DC GRBCL APIN0089 DC RAND APIN0090 DC GLSTB APIN0091 DC GLBTB APIN0092 DC GTSPL APIN0093 DC FNDPL APIN0094 DC LINDR APIN0095 DC RSEND APIN0096 DC MODE APIN0097 DC USER APIN0098 DC SINON APIN0099 DC FULST APIN0100 DC ATTN APIN0101 DC CHRCT APIN0102 DC ISBRN APIN0103 DC MGCOL APIN0104 DC FGCOL APIN0105 DC STKOR APIN0106 * ADDRESSES IN ASMIN USED BY OTHER ASSEMBLIES APIN0107 DC PHCHR-ASMIN APIN0108 DC NXTPH-ASMIN APIN0109 DC PHCNT-ASMIN APIN0110 DC CHECK-ASMIN APIN0111 DC TABLE-ASMIN APIN0112 * ADDRESSES IN ASMED USED BY OTHER ASSEMBLIES APIN0113 DC GNSTM-ASMED APIN0114 DC R13-ASMED APIN0115 DC R14-ASMED APIN0116 * LENGTH OF OVERLAYS APIN0117 DC LGTH1 APIN0118 DC LGTH2 APIN0119 DC LGTH3 APIN0120 HDNG INPUT/EDIT OVERLAY 1 APIN0121 ORG ASMIN-2 APIN0122 DC 7*/140 REQUIRED FOR WRITING APIN0123 DC DAINP APIN0124 DC INPOV IDENTIFIES OVERLAY APIN0125 HDNG ** APL INPUT CONVERSION ROUTINE ** APIN0126 ORG EQU 0 APIN0127 * THIS ROUTINE CONVERTS NUMBERS INPUT FROM THE APIN0128 * TERMINAL TO DOUBLE WORD 1130 FLOATING POINT NUM-APIN0129 * BERS. THE FOLLOWING LC REGISTER ASSUMPTIONS AREAPIN0130 * MADE ON ENTRY AS WELL AS THE ASSUMPTION THAT XR1APIN0131 * CONTAINS LOCOR. APIN0132 * ITEM LC REG NO. APIN0133 * MANTISSA 7,8 APIN0134 * DECIMAL EXP. 4 MINUS 3 APIN0135 * SIGN 2 /0000 IF POS, /FFFF IF NEG APIN0136 * DURING CONVERSION LC REGISTERS 4 TO 8 ARE USED APIN0137 * THE CONVERTED NUMBER IS RETURNED IN REGISTERS APIN0138 * 6 AND 7. APIN0139 * THE CONSTANTS KNEG, DNEG, KPLUS, DPLUS ARE APIN0140 * 32 BIT NORMALIZED MANTISSAS OF THE APIN0141 * INDICATED VALUES. APIN0142 ICONV DC *-* INPUT CONVERSION ENTRY POINTAPIN0143 LD 1 8 GET THE MANTISSA APIN0144 RTE 16 APIN0145 LD 1 7 APIN0146 LDX 3 32 NORMALIZE IT APIN0147 SLC 3 APIN0148 RTE 1 APIN0149 STD 1 6 STORE IT APIN0150 LD 1 4 FORM DECIMAL EXPONENT APIN0151 S 1 3 APIN0152 STO 1 4 APIN0153 A 1 4 APIN0154 A 1 4 BEXP.=128+3*DEXP APIN0155 A H80 APIN0156 K3ADR A L 3 BEXP.=BEXP+NORMALIZE FCTR APIN0157 STO 1 5 APIN0158 ETEST LD 1 4 APIN0159 BSC L MSCAL+ORG,+Z FINISHED IF DEXP ZERO APIN0160 BSC L DONE+ORG,+ APIN0161 MDX L LOCOR+5,1 UPDATE BEXP APIN0162 NOP APIN0163 S K3ADR+1 APIN0164 BSC L PCLOS+ORG,+Z YES APIN0165 STO 1 4 NO--UPDATE DEXP APIN0166 LDD KPLUS AND SCALE BY 1000/1024 APIN0167 MDX IMULT APIN0168 PCLOS MDX L LOCOR+4,-1 UPDATE DEXP APIN0169 NOP APIN0170 LDD DPLUS SCALE BY 10/8 APIN0171 IMULT STD IBARG APIN0172 BSI L XMDS+ORG PERFORM DOUBLE MULTIPLY APIN0173 DC LOCOR+6 APIN0174 DC IBARG+ORG APIN0175 INORM STD 1 6 SAVE RESULT APIN0176 SLT 1 IS NORMALIZATION NEEDED APIN0177 BSC L ETEST+ORG,+Z NO APIN0178 MDX L LOCOR+5,-1 AND UPDATE BEXP APIN0179 NOP APIN0180 MDX INORM APIN0181 MSCAL A K3ADR+1 IS DEXP GTR -3 APIN0182 BSC L MCLOS+ORG,-Z APIN0183 STO 1 4 NO, UPDATE DEXP APIN0184 LDD KPLUS AND SCALE BY 1000/1024 APIN0185 MDX IDIV APIN0186 MCLOS MDX L LOCOR+4,1 DEXP IS .GT. -3 APIN0187 NOP UPDATE DEXP APIN0188 LDD DPLUS AND SCALE BY 10/8 APIN0189 IDIV STD IBARG APIN0190 BSI L XDDS+ORG APIN0191 DC LOCOR+6 APIN0192 DC IBARG+ORG APIN0193 MDX INORM APIN0194 DONE LD 1 5 CHECK RANGE OF EXPONENT APIN0195 SRT 8 APIN0196 BSC L INDOM,Z- OUT OF RANGE APIN0197 BSC L *+2+ORG,- APIN0198 SLT 32 TOO SMALL, MAKE IT ZERO APIN0199 MDX IEXIT-1 APIN0200 SRT 8 APIN0201 LDS 0 APIN0202 STS 1 7 APIN0203 MDX L LOCOR+2,0 APIN0204 SD 1 6 APIN0205 MDX L LOCOR+2,1 APIN0206 AD 1 6 APIN0207 STD 1 6 APIN0208 IEXIT BSC I ICONV+ORG APIN0209 H80 DC /80 APIN0210 IBARG BSS E 2 APIN0211 KPLUS DC /7D00 1000/1024 APIN0212 DC /0000 APIN0213 DPLUS DC /5000 10/8 APIN0214 DC /0000 APIN0215 HDNG SET VARIOUS PARAMETER LISTS APIN0216 * APIN0217 * APIN0218 SLDPL DC 0 APIN0219 LD L FNDPL+5 APIN0220 BSI L ABSAD APIN0221 MDX 1 2 APIN0222 STX L1 LNPML+1 APIN0223 MDX 1 1 APIN0224 STX L1 LNPML APIN0225 LDX L1 LINDR APIN0226 STX L1 LNPML+2 APIN0227 BSC I SLDPL APIN0228 * APIN0229 SDSPM DC 0 APIN0230 LDX L1 LNPML APIN0231 BSI L FLNDR APIN0232 LD 1 3 NO DISPLAY IF LINE NO APIN0233 BSC L EDF14,+Z GREATER THAN LAST LINE APIN0234 MDX L DSPSW,-2 APIN0235 MDX SDS01 APIN0236 LD 1 5 FORM ADDRESS OF LAST LINE APIN0237 S X1 APIN0238 MDX SDS02 APIN0239 SDS01 BSC L EDF14,Z SINGLE LINE DISPLAY. APIN0240 * NO DISPLAY IF LINE IS NON EXISTENT APIN0241 SDS02 A 1 4 ADDR OF LAST LINE FOR DISP APIN0242 STO L 2 APIN0243 LD 1 4 APIN0244 STO L 1 APIN0245 X1 EQU *-1 APIN0246 MDX 1 LNGLD APIN0247 MDX 2 LNGLD APIN0248 LD 2 0 APIN0249 STO I LNPML APIN0250 BSC I SDSPM APIN0251 HDNG CHECK FUNCTION APIN0252 * X1 CONTAINS ADDRESS OF IDS APIN0253 CKDFN DC 0 APIN0254 LDX 3 0 ASSUME UNDEFINED IDENT APIN0255 STX 1 CKD06+1 APIN0256 * APIN0257 BSI L SGBTB GLOBAL FOUND APIN0258 LD 1 4 BRANCH IF ENTRY FOR APIN0259 BSC L CKD07,+- FUNCTION OT FOUND APIN0260 * APIN0261 * APIN0262 LD I1 4 GET SYPTR OF ENTRY APIN0263 AND HF000 ISOLATE CLASS APIN0264 S HC000 BRANCH IF APIN0265 BSC L CKD01,+- FUNCTION WITH APIN0266 S L H2000 OR WITHOUT APIN0267 LDX 3 1 INDICATE NOT A FUNCTION APIN0268 BSC L CKD07,Z BRANCH IF VARIABLE APIN0269 * APIN0270 * APIN0271 * APIN0272 CKD01 LD I1 4 ADDRESS OF M ENTRY APIN0273 BSI L ABSAD TO X1 APIN0274 LDX 3 2 FUNCTION FOUND APIN0275 LD 1 3 IS THIS A APIN0276 BSC L CKD02,- LOCKED FUNCTION APIN0277 LDX 3 5 INDICATE IF YES APIN0278 * APIN0279 CKD02 SRA 16 ASSUME FUNCTION NOT IN APIN0280 * STO FNINS STACK APIN0281 LD L PAREL APIN0282 LDX I2 CKD06+1 ADDRESS OF PARAMETERS APIN0283 * ADDRESS OF TOP OF APIN0284 CKD03 BSI L ABSAD STACK TO X1 APIN0285 LD 1 0 SAVE ADDRESS OF APIN0286 STO NXTLV NEXT LEVEL APIN0287 AND H0FFF EXIT IF BOTTOM OF APIN0288 BSC L CKD06,+- STACK APIN0289 LD 1 3 ADDRESS OF FUNCTION APIN0290 S 2 4 BRANCH IF APIN0291 AND H0FFF APIN0292 BSC L CKD05,Z NOT SAME APIN0293 LD NXTLV BRANCH APIN0294 SLA 1 IF SAME,BUT APIN0295 BSC L CKD04,+Z FUNCTION SUSPENDED APIN0296 LDX 1 2 EXIT IF FUNCTION IN APIN0297 STX 1 FNINS IMMEDIATE EXECUTION APIN0298 MDX CKD06 EXIT APIN0299 * APIN0300 CKD04 LDX 1 1 INDICATE SUSPENDED APIN0301 STX 1 FNINS FUNCTION APIN0302 * APIN0303 CKD05 LD NXTLV GO TO NEXT LEVEL APIN0304 MDX CKD03 APIN0305 * APIN0306 CKD06 LDX L1 *-* RESTORE PARAMETER LIST APIN0307 MDX I3 FNINS SET STATUS APIN0308 CKD07 LD L 3 SAVE STATUS APIN0309 STO 1 6 APIN0310 BSC I CKDFN EXIT APIN0311 HF000 DC /F000 APIN0312 HC000 DC /C000 APIN0313 FNINS DC 0 APIN0314 NXTLV DC 0 APIN0315 H0FFF DC /0FFF APIN0316 * EXIT CONDITIONS IN X3 APIN0317 * APIN0318 * 0=UNASSIGNED IDENTIFIER APIN0319 * 1=DEFINED BUT NOT A FUNCTION IDENT APIN0320 * 2=UNLOCKED FUNCTION - NOT IN STACK APIN0321 * 3=UNLOCKED FUNCTION - IN STACK BUT APIN0322 * SUSPENDED APIN0323 * 4=UNLOCKED FUNCTION - IN STACK AND APIN0324 * IN IMMEDIATE EXECUTION APIN0325 * 5=LOCKED FUNCTION - NOT IN STACK APIN0326 * 6=LOCKED FUNCTION - IN STACK BUT APIN0327 * SUSPENDED APIN0328 * 7=LOCKED FUNCTION - IN STACK AND APIN0329 * IN IMMEDIATE EXECUTION APIN0330 NEWFN EQU /4000 APIN0331 EDTBL EQU /2000 APIN0332 EDTHL EQU /1000 APIN0333 * APIN0334 TYPES DC NEWFN+EDTBL+EDTHL APIN0335 DC 0 APIN0336 DC EDTBL+EDTHL APIN0337 DC EDTBL APIN0338 DC 0 PENDANT FUNCTION APIN0339 DC 0 APIN0340 DC 0 APIN0341 DC 0 PENDANT FUNCTION APIN0342 HDNG DISK INPUT ROUTINES APIN0343 * GET AND STORE NEXT N WORDS FROM DISK APIN0344 * X1 CONTAINS ADDRESS APIN0345 * X2 CONTAINS NUMBER OF WORDS APIN0346 GSNNW DC 0 APIN0347 STX 1 GSN02+1 SAVE ADDRESS AND APIN0348 STX 2 GSN03 COUNT APIN0349 * APIN0350 GSN01 BSI L GNXTW GET NEXT WORD APIN0351 STO I GSN02+1 STORE WORD APIN0352 MDX L GSN02+1,1 ADVANCE ADDRESS APIN0353 MDX L GSN03,-1 COUNT WORDS APIN0354 MDX GSN01 CONTINUE IF MORE APIN0355 * APIN0356 GSN02 LDX L1 *-* RESTORE UPDATED ADDRESS APIN0357 BSC I GSNNW EXIT APIN0358 * APIN0359 GSN03 EQU * APIN0360 HDNG BUILD/STORE LINE NUMBER APIN0361 * APIN0362 BSLNM DC 0 APIN0363 SRA 16 ZERO OUT CURRENT LINE APIN0364 STO CURLN NUMBER AND APIN0365 STO DSPSW DISPLAY SWITCH APIN0366 STO PDSW PERIOD SWITCH APIN0367 STO L POSN ZERO FOR SUPER EDIT APIN0368 LDX 1 12 SET COUNT FOR 4 DIGITS APIN0369 BSL00 STX 1 DIGPS SAVE DIGIT COUNT APIN0370 * APIN0371 * APIN0372 BSL01 BSI L NONBK GET NE T NON BLANK APIN0373 MDX BSL10 ERROR IF LINE END APIN0374 * APIN0375 LD L CHAR APIN0376 STO TMPSV SAVE CHARACTER APIN0377 S L HNMTS BRANCH IF APIN0378 BSC L BSL02,- SPECIAL CHARACTER APIN0379 S L LNMTS ERROR IF APIN0380 BSC L FNERR,+Z ALPHABETIC APIN0381 * APIN0382 STO TMPSV SAVE DIFIT APIN0383 LD DIGPS BRANCH IF FIFTH DIGIT APIN0384 BSC L BSL14,+Z THIS MAY BE SUPEREDIT APIN0385 LD TMPSV RESTORE DIGIT APIN0386 LDX I1 DIGPS MOVE DIGIT TO APIN0387 SLA 1 0 PROPER POSITION APIN0388 A CURLN ADD INTO APIN0389 STO CURLN CURRENT LINE NUMBER APIN0390 * APIN0391 * APIN0392 MDX L DIGPS,-4 SKIP IF 3RD,4TH DIGIT APIN0393 MDX BSL01 CONTINUE IF 1ST,2ND APIN0394 LD PDSW IF 3RD,4TH DIGIT, APIN0395 BSC L BSL01,Z CHECK IF PERIOD READ APIN0396 MDX BSL10 ERROR IF NOT APIN0397 * APIN0398 BSL02 LD DIGPS NON-NUMERIC CHARACTER APIN0399 S D0008 BRANCH IF SOME DIGITS APIN0400 BSC L BSL03,+ HAVE BEEN READ APIN0401 LD TMPSV IS THIS A PERIOD APIN0402 S L PERCH APIN0403 BSC L BSL12,+- BRANCH IF YES APIN0404 * APIN0405 LD DSPSW NO DIGITS READ. BRANCH APIN0406 BSC L BSL09,Z IF QUAD HAS BEEN READ APIN0407 LD TMPSV NO QUAD YET APIN0408 S QADCH ERROR IF THIS IS APIN0409 BSC L FNERR,Z NOT QUAD APIN0410 MDX L DSPSW,1 SET DISPLAY INDICATOR APIN0411 MDX BSL01 CONTINUE APIN0412 * APIN0413 BSL03 BSC L BSL04,Z BRANCH IF MORE THAN 1 APIN0414 LD CURLN DIGIT READ. APIN0415 SRA 4 ADJUST CURRENT LINE APIN0416 STO CURLN NUMBER IF ONLY ONE APIN0417 MDX BSL05 GO TO CHECK FOR PERIOD APIN0418 * APIN0419 BSL04 A D0008 BRANCH IF 3 OR 4 APIN0420 BSC L BSL06,+ DIGITS HAVE BEEN READ APIN0421 LD PDSW ERROR IF NON NUMERIC APIN0422 BSC L FNERR,Z FOLLOWS PERIOD APIN0423 * APIN0424 BSL05 LD TMPSV IS THIS A APIN0425 S L PERCH PERIOD APIN0426 BSC L BSL06,Z BRANCH IF NOT APIN0427 BSL12 EQU * APIN0428 MDX L PDSW,1 INDICATE PERIOD READ APIN0429 LDX 1 4 SET DIGIT COUNT FOR TWO APIN0430 MDX BSL00 MORE AND GO STORE COUNT APIN0431 * APIN0432 * APIN0433 BSL06 LD DSPSW 3 OR 4 DIGITS READ APIN0434 BSC L BSL08,Z BRANCH IF YES APIN0435 LD TMPSV IF NOT, IS THIS APIN0436 S QADCH QUAD APIN0437 BSC L BSL07,Z BRANCH IF NOT APIN0438 MDX L DSPSW,2 DISPLAY INDICATOR=2 APIN0439 LDX 1 -4 AND NO MORE DIGITS IF APIN0440 MDX BSL00 YES. GO STORE DIGIT CNT APIN0441 * APIN0442 * APIN0443 BSL07 S RBRTS IS THIS RIGHT BRACKET APIN0444 BSC L BSLXT,+- EXIT IF YES APIN0445 MDX BSL10 ERROR IF NOT APIN0446 * APIN0447 BSL08 MDX L DSPSW,1 ADVANCE DISPLAY INDICAT- APIN0448 * OR BY ONE APIN0449 BSL09 LD TMPSV IS THIS RIGHT APIN0450 S RBRCH BRACKET APIN0451 BSC L FNERR,Z ERROR IF NOT APIN0452 BSI L NONBK GET NE T NON BLANK APIN0453 MDX BSL11 BRANCH IF END LINE APIN0454 * CHECK FOR APIN0455 BSI L DELCK CLOSE FUNCTION IF NOT APIN0456 LD L LTERM EXIT IF DEL OR DELTILDE APIN0457 BSC I BSLNM,+- FOUND APIN0458 BSL10 BSC L FNERR ERROR IF NOT APIN0459 * APIN0460 BSL11 LDX 1 -1 INDICATE END OF LINE APIN0461 STX L1 LTERM TERMINATION APIN0462 * APIN0463 BSLXT BSC I BSLNM EXIT APIN0464 * APIN0465 * APIN0466 PDSW DC 0 APIN0467 CURLN DC 0 APIN0468 DSPSW DC 0 APIN0469 DIGPS DC 0 APIN0470 QADCH DC /38 APIN0471 RBRTS DC /2A-/38 APIN0472 RBRCH DC /2A APIN0473 TMPSV DC 0 APIN0474 D0008 DC 8 APIN0475 D2 DC 2 APIN0476 D10 DC 10 APIN0477 D120 DC 120 APIN0478 BSL14 LD DSPSW DOES THIE DIGIT APIN0479 S D2 FOLLOW A QUAD APIN0480 BSC L FNERR,+Z ERROR IF NOT APIN0481 LD L CDSW SUPEREDIT NOT ALLOWED APIN0482 BSC L FNERR,+Z IN CARD MODE INPUT APIN0483 MDX L DSPSW,1 ADVANCE DISPLAY SWITCH APIN0484 LD L POSN BUILD APIN0485 M D10 UP APIN0486 SLT 16 STARTING POSITION APIN0487 A TMPSV FOR APIN0488 STO L POSN SUPEREDIT APIN0489 S D120 APIN0490 BSC L FNERR,- FULL LINE APIN0491 BSC L BSL01 APIN0492 HDNG PRINT LINE NUMBER APIN0493 LNMES DC 0 APIN0494 LD I1 0 APIN0495 STO CLNUM APIN0496 LDX L1 CLBR APIN0497 BSI L TYPE APIN0498 LD CLNUM APIN0499 SRA 12 APIN0500 BSC Z APIN0501 BSI LMESN APIN0502 LD CLNUM APIN0503 SLA 4 APIN0504 SRA 12 APIN0505 BSI LMESN APIN0506 LD CLNUM APIN0507 SLA 8 APIN0508 BSC L LMES1,+- APIN0509 LDX L1 CPD APIN0510 BSI L TYPE APIN0511 LD CLNUM APIN0512 SLA 8 APIN0513 SRA 12 APIN0514 BSI LMESN APIN0515 LD CLNUM APIN0516 SLA 12 APIN0517 SRA 12 APIN0518 BSC Z APIN0519 BSI LMESN APIN0520 LMES1 LDX L1 CRBR APIN0521 BSI L TYPE APIN0522 BSC I LNMES APIN0523 LMESN DC 0 APIN0524 A CZERO APIN0525 STO LNCHR APIN0526 LDX L1 LNCHR APIN0527 BSI L TYPE APIN0528 BSC I LMESN APIN0529 LNCHR DC 0 APIN0530 CPD DC /2C APIN0531 CLBR DC /29 APIN0532 CRBR DC /2A APIN0533 CZERO DC /1B APIN0534 HA000 DC /A000 APIN0535 HBIT DC /8000 APIN0536 CLNUM EQU * APIN0537 HDNG INPUT STATEMENT BY TYPEWRITER OR CARD APIN0538 INPST DC 0 APIN0539 SRA 16 APIN0540 STO L ATTN APIN0541 * APIN0542 * APIN0543 LDD L CDSW GET SWITCHES APIN0544 BSC L INC16,+Z BRANCH IF CARD MODE APIN0545 SLT 16 ACC =0 IF NOT 2741 INPUT APIN0546 BSC L INC16,- BRANCH IF NOT 2741 APIN0547 LD L SINON CHECK FOR SIGN ON FOR 2741 APIN0548 SLA 1 APIN0549 BSC L INC17,Z 1ST CHAR READ IF YES APIN0550 INC16 AND HA000 SET ACC=0 IF APIN0551 EOR HBIT )CARD NODISP APIN0552 LDX L1 RDSHF REDSHIFT (IDLE FOR 2741) APIN0553 BSI L TYPE,Z IF DISPLAY REQD APIN0554 * APIN0555 * APIN0556 INCHA LDX L1 CHAR READ APIN0557 BSI L RDCHR CHARACTER APIN0558 INC17 EQU * APIN0559 LDX L3 CHAR ADDRESS OF CHARACTER APIN0560 LD 3 0 IS THIS APIN0561 S 3 CRT-CHAR CARRAIGE RETURN APIN0562 BSC L INC18,+- CARRAIGE RETURN READ APIN0563 S 3 ONE-CHAR IS IT LINE FEED APIN0564 STO 3 LFSW-CHAR SAVE LINE FEED SWITCH APIN0565 BSC L INC01,Z BRANCH IF NOT LINE FEED APIN0566 LD 3 R14-CHAR DELETE ALL TO RIGHT OF APIN0567 STO 3 R13-CHAR CURRENT CHARACTER POINT APIN0568 * APIN0569 * APIN0570 LD L TYPSW GET INPUT SWITCH APIN0571 LDX L1 LNFD APIN0572 BSI L TYPE,+Z EXTRA LINE FEED IF 2741 APIN0573 * APIN0574 * APIN0575 LDX 1 3 APIN0576 LDX L3 LFMES INVERTED CARAT APIN0577 BSI L TYNCH LINE FEED APIN0578 MDX INCHA GO TO READ CHARACTER APIN0579 * APIN0580 * APIN0581 INC18 LDD L CDSW GET SWITCHES APIN0582 BSC L INC19,+Z BRANCH IF 2741 APIN0583 SLT 16 APIN0584 LDX L1 CHAR DISCARD CIRCLE C APIN0585 BSI L RDCHR,+Z IF 2741 INPUT APIN0586 INC19 LD INPST SET EXIT FROM PRCRT APIN0587 STO L PRCRT APIN0588 MDX L CHRCT,50 APIN0589 BSC L PRCRT+4 APIN0590 * APIN0591 * APIN0592 INC01 S 3 ONE-CHAR IS IT A BACKSPACE APIN0593 BSC L INC02,Z BRANCH IF NOT APIN0594 LD 3 STBUF-CHAR IS THIS APIN0595 S 3 R14-CHAR START OF LINE APIN0596 BSC L INCHA,+- GO READ CHARACTER IF YES APIN0597 MDX L R14,1 BACKTRACK APIN0598 MDX INCHA APIN0599 INC02 S 3 ONE-CHAR IS IT A TAB APIN0600 BSC L INC03,Z BRANCH IF NOT APIN0601 MDX L CHAR,-4 TAB CONVERTS TO SPACE APIN0602 MDX INC04 APIN0603 H17 DC /17 APIN0604 H4 DC 4 APIN0605 INC03 A H4 APIN0606 BSC L INC04,+- APIN0607 A H17 APIN0608 BSC L INC04,+ APIN0609 SRA 16 STORE INVALID APIN0610 STO 3 CHAR-CHAR CHARACTER APIN0611 * APIN0612 INC04 LD 3 R14-CHAR IS THIS N APIN0613 S 3 R13-CHAR OVERSTRIKE POSSIBILITY APIN0614 BSC L INC09,+ BRANCH IF NOT APIN0615 LD 3 0 IS INCOMING CHARACTER APIN0616 S 3 BLK-CHAR A BLANK APIN0617 BSC L INC14,+- IGNORE IF YES APIN0618 LD I R14 GET EXISTING CHARACTER APIN0619 STO 3 1 SAVE IT APIN0620 S 3 0 IS IT SAME AS INCOMING APIN0621 BSC L INC14,+- BRANCH IF YES APIN0622 LD 3 1 IS EXISTING CHARACTER APIN0623 S 3 BLK-CHAR BLANK APIN0624 BSC L INC15,+- APIN0625 * APIN0626 LDD 3 1 INITIALISE FOR SEARCH APIN0627 SLT 8 ONE COMBINATION OF APIN0628 A 3 0 CHARACTERS IS APIN0629 STO 3 1 A,B APIN0630 SLT 8 THE OTHER IS B,A APIN0631 STO 3 2 (B=INCOMING CHARACTER) APIN0632 LDX L2 COMBN FIRST COMBINATION APIN0633 LDX 1 NCOMB NUMBER OF COMBINATIONS APIN0634 * APIN0635 INC06 LD 2 0 CHECK COMBINATION APIN0636 BSI CHKOS (A,B) AND (B,A) APIN0637 LDD 2 0 CHECK COMBINATION APIN0638 SLT 8 (B,O) AND (O,B) APIN0639 BSI CHKOS (O=OVERSTRIKE CHARACTER) APIN0640 LD 2 1 CHECK COMBINATION APIN0641 BSI CHKOS (O,A) AND (A,O) APIN0642 MDX 2 2 ADDRESS OF NEXT COMBN APIN0643 MDX 1 -1 COUNT COMBINATIONS APIN0644 MDX INC06 GO TO CHECK NEXT COMBN APIN0645 SRA 16 INVALID CHARACTER APIN0646 MDX INC08 GO STORE CHARACTER APIN0647 INC07 LD 2 1 ISOLATE APIN0648 SRA 8 OVERSTRIKE CHARACTER APIN0649 INC08 STO 3 0 STORE AS CURRENT CHAR. APIN0650 INC15 MDX L R13,1 APIN0651 INC09 BSI PUTCH STORE CHARACTER APIN0652 MDX INCHA LINE TOO LONG APIN0653 INC14 MDX L R14,-1 ADVANCE CURRENT POINTER APIN0654 MDX INCHA APIN0655 * APIN0656 * APIN0657 * APIN0658 CHKOS DC 0 APIN0659 STO TEMP SAVE COMBINATION APIN0660 S 3 1 COMPARE FIRST WAY ROUND APIN0661 BSC L INC07,+- BRANCH IF FOUND APIN0662 LD TEMP COMPARE APIN0663 S 3 2 OTHER WAY ROUND APIN0664 BSC L INC07,+- BRANCH IF FOUND APIN0665 BSC I CHKOS EXIT OTHERWISE APIN0666 * APIN0667 TEMP DC 0 APIN0668 COMBN BSS E 0 APIN0669 DC /3B39 APIN0670 DC /593B APIN0671 DC /3B52 APIN0672 DC /5A3B APIN0673 DC /3B51 APIN0674 DC /5B3B APIN0675 DC /3B3C APIN0676 DC /5C3B APIN0677 DC /2552 APIN0678 DC /5D25 APIN0679 DC /5152 APIN0680 DC /5E51 APIN0681 DC /3837 APIN0682 DC /5F38 APIN0683 DC /2C37 APIN0684 DC /602C APIN0685 DC /3340 APIN0686 DC /6133 APIN0687 NCOMB EQU 9 APIN0688 RDSHF DC /7C APIN0689 LFMES DC /50 APIN0690 BKSPA DC /7B APIN0691 LNFD DC /7A APIN0692 STOCH DC 0 APIN0693 STO 3 CHAR-CHAR SAVE CHARCTER APIN0694 BSI PUTCH APIN0695 MDX STOC1 EXIT IF LINE FULL APIN0696 LDX L1 CHAR TYPE APIN0697 BSI L TYPE CHARACTER APIN0698 MDX L R14,-1 APIN0699 BSC I STOCH APIN0700 STOC1 STX L TLSW APIN0701 BSC I SUPER UNDO TOO LONG SWITCH APIN0702 TEN DC 10 APIN0703 D27 DC 27 APIN0704 SUPER DC 0 APIN0705 LDS 0 APIN0706 LD 3 STBUF-CHAR INITIALISE R14,R13 APIN0707 STO 3 R14-CHAR APIN0708 STO 3 R13-CHAR BUFFER APIN0709 LDX 2 120 APIN0710 LDX L1 PAGE0+319 ADDRESS OF 1ST CHAR APIN0711 STX 1 SUP05+1 OF LINE FOR SUPEREDIT APIN0712 SUP01 LD L2 PAGE0-1 GET NEXT CHARACER APIN0713 MDX 2 -1 SKIP IF NO MORE APIN0714 MDX SUP02 GO CHECK IT APIN0715 LDX 2 0 NO MORE CHARCTERS APIN0716 LD 3 BLK-CHAR USE A BLANK APIN0717 SUP02 S 3 SLH-CHAR IS THIS A SLASH APIN0718 BSC L SUP05,+- BRANCH IF YES APIN0719 BSC L SUP04,- ALPHANUMERIC APIN0720 A TEN SAVE CHARACTER APIN0721 BSC L SUP04,+- IF ZERO APIN0722 BSC L SUP06,- APIN0723 A D27 APIN0724 M TEN APIN0725 SLT 15 APIN0726 SUP06 STO TEMP APIN0727 LD 3 STLIN-CHAR APIN0728 BSC L SUP03,Z APIN0729 LD 3 R14-CHAR APIN0730 STO 3 STLIN-CHAR APIN0731 SUP03 LD 3 BLK-CHAR STORE A APIN0732 BSI STOCH BLANK APIN0733 MDX L TEMP,-1 COUNT BLANKS APIN0734 MDX SUP03 APIN0735 SUP04 LDS 3 APIN0736 SUP05 LD L *-* GET CHARACTER APIN0737 S 3 MET-CHAR APIN0738 BSC I SUPER,+- APIN0739 A 3 MET-CHAR APIN0740 MDX L SUP05+1,-1 ADVANCE TO NEXT APIN0741 BSI L STOCH,O STORE CHARCTER IF NOT APIN0742 MDX SUP01 SLASH. CONTINUE APIN0743 HDNG CHARACTERS IN AND OUT OF BUFFER APIN0744 * APIN0745 PUTCH DC 0 APIN0746 LD 3 R14-CHAR APIN0747 S 3 HLIM-CHAR BUFFER FULL APIN0748 STO 3 TLSW-CHAR GO READ CHARACTER AND APIN0749 BSC I PUTCH,+- EXIT IF LINE TOO LONG APIN0750 MDX L PUTCH,1 NORMAL EXIT APIN0751 MDX L R13,-1 ADVANCE ENDLINE POINTER APIN0752 INC13 LD 3 CHAR-CHAR STORE CHARACTER APIN0753 STO I R14 IN BUFFER APIN0754 BSC I PUTCH APIN0755 * APIN0756 * APIN0757 GETCH DC 0 APIN0758 LD L R13 IS THIS APIN0759 S L R14 END OF BUFFER APIN0760 BSC I GETCH,- EXIT IF YES APIN0761 MDX L GETCH,1 ADJUST EXIT FOR RETURN+1 APIN0762 LD I R14 LOAD CHARACTER APIN0763 BSC L BADCH,+- BRANCH IF DAD APIN0764 MDX L R14,-1 ADJUST CURRENT POINTER APIN0765 STO L CHAR APIN0766 BSC I GETCH EXIT APIN0767 * APIN0768 NONBK DC 0 APIN0769 NON01 BSI GETCH GET NEXT CHARACTER APIN0770 MDX NONXT EXIT IF END OF LINE APIN0771 S BLKC IS THIS BLANK APIN0772 BSC L NON01,+- TRY AGAIN IF YES APIN0773 MDX L NONBK,1 ADJUST EXIT FOR RETURN+1 APIN0774 NONXT BSC I NONBK EXIT APIN0775 BLKC DC /78 APIN0776 * APIN0777 * APIN0778 * APIN0779 DELCK DC 0 APIN0780 LD L CHAR IS THIS APIN0781 S DELCH CHARACTER A DEL APIN0782 BSC L DEL02,+- BRANCH IF YES APIN0783 S DELTL BRANCH IF APIN0784 BSC L DEL01,+- CHARACTER IS DEL TILDE APIN0785 LD L CHAR INDICATE TERMINATOR APIN0786 MDX DEL04 OTHER THAN DEL OR E.O.L APIN0787 DEL01 LD L H8000 INDICATE LOCKED FUNCTION APIN0788 DEL02 STO L CLOCK APIN0789 BSI NONBK GET NEXT NON-BKANK APIN0790 MDX DEL03 BRANCH IF END OF LINE APIN0791 BSC L FNERR APIN0792 DEL03 SRA 16 INDICATE CLOSE FUNCTION APIN0793 DEL04 STO L LTERM APIN0794 BSC I DELCK APIN0795 * APIN0796 DELCH DC /33 APIN0797 DELTL DC /61-/33 APIN0798 HDNG SET UP NEW FUNCTION HEADER APIN0799 SUNFH DC 0 APIN0800 * BEFORE SETTING UP FUNCTION HEADER APIN0801 * THE LABEL DIRECTORY MUST BE CHECKED APIN0802 LDX I1 FNDPL+5 ADDRESS OF FN DEF M NTRY APIN0803 LD 1 4 BRANCH IF NO APIN0804 BSC L SUN10,+- LABELS AS YET APIN0805 STO CMPCT APIN0806 LD L 1 ADDRESS OF START OF APIN0807 A 1 5 LABEL DIRACTORY LESS 12 APIN0808 A 1 5 APIN0809 STO L 1 SVAE IT IN X1 AND APIN0810 STO DIMCT FOR LATER MOVE APIN0811 SUN07 LDX L2 EXPRS 1ST PARAMETER IN HEADER APIN0812 LDX 3 4 APIN0813 SUN08 LD 2 0 IS NEXT PARAMETER PRESENTAPIN0814 BSC L SUN09,+- IGNORE TEST IF NOT APIN0815 S 1 13 CHECK PARAMETER WITH APIN0816 BSC L SUN09,Z NEXT LABEL IN APIN0817 LD 2 1 DIRECTORY APIN0818 S 1 14 APIN0819 BSC L FNERR,+- ERROR IF THE SAME APIN0820 SUN09 MDX 2 2 TRY NEXT PARAMETER APIN0821 MDX 3 -1 COUNT HEADER PARAMS APIN0822 MDX SUN08 APIN0823 MDX 1 3 TRY NEXY LABEL APIN0824 MDX L CMPCT,-1 COUNT LABELS APIN0825 MDX SUN07 CONTINUE IF MORE APIN0826 MDX 1 -1 SAVE END OF LABEL APIN0827 STX 1 DLTCT DIRECTORY APIN0828 LDX I1 FNDPL+5 ADDRESS OF FN DEF M-MTRY APIN0829 SUN10 LD L LOCCT FROM DIFFERENCE IN NO. APIN0830 S 1 5 OF LOCALS (OFFSET) APIN0831 STO OFSET APIN0832 BSC L SUN02,+- BRANCH IF NO CHANGE APIN0833 BSC L SUN01,+ BRANCH IF FEWER LOCALS APIN0834 LDS 2 IF MORE, GET SPACE FOR APIN0835 * ADDITIONAL LOCALS APIN0836 BSI L GSFFD NECESSARY APIN0837 LDX 3 -1 INDICATE LABEL PUSH DOWN APIN0838 MDX SUN02 APIN0839 SUN01 LDX 3 1 INDICATE LABEL PUSH UP APIN0840 SUN02 STX 3 PDINC SAVE INCREMENT APIN0841 LDX L1 FNDPL PREPARE TO APIN0842 LDX L2 NFNDP CHECK IF CHANGE APIN0843 LDD L FUNCT IN FUNCTION ID APIN0844 STD 2 0 APIN0845 LD L CLASS GET CLASS OF FUNCTION APIN0846 BSI L CGBTB CHANGE TABLE APIN0847 LD OFSET BRANCH IF NO APIN0848 BSC L SUN06,+- APIN0849 SUN04 LDX I2 FNDPL+5 ADDRESS OF FN DEF M NTRY APIN0850 LD 2 4 APIN0851 BSC L SUN06,+- IGNORE MOVE IF THERE APIN0852 A 2 4 ARE NO LABELS APIN0853 A 2 4 SET LENGTH OF APIN0854 STO PDCNT LABEL DIRECTORY APIN0855 LDX I3 PDINC GET START OR END OF LABELAPIN0856 LD L3 OFSET DIRECTORY DEPENDING ON APIN0857 * PUSH UP OR PUSH DOWN APIN0858 STO L 3 OF ENTRIES APIN0859 A OFSET FORM STARTING ADDRESS APIN0860 A OFSET LESS 12 FOR NEW POSN APIN0861 STO L 1 OF ENTRIES APIN0862 * APIN0863 SUN05 LD 3 12 GET NEXT WORD AND APIN0864 STO 1 12 STORE IT APIN0865 MDX I1 PDINC ADJUST ADDRESSES FOR APIN0866 MDX I3 PDINC NEXT WORD APIN0867 MDX L PDCNT,-1 COUNT WORDS APIN0868 MDX SUN05 CONTINUE IF MORE APIN0869 * APIN0870 * APIN0871 SUN06 LDX I1 FNDPL+5 STORE LOCAL COUNT, FN APIN0872 BSI L STCAR PARAMETERS AND LOCALS APIN0873 * APIN0874 LD I FNDPL+4 ADJUST ARGUMENT COUNT APIN0875 BSI L ABSAD IN FOURTH WORD APIN0876 LD L PARAD OF FUNCTION APIN0877 SLA 13 M ENTRY APIN0878 STO 1 3 APIN0879 * APIN0880 BSC I SUNFH APIN0881 NFNDP BSS E 5 APIN0882 DLTCT DC 0 APIN0883 OFSET DC 0 APIN0884 DIMCT DC 0 APIN0885 CMPCT DC 0 APIN0886 HFFFF DC /FFFF APIN0887 PDINC DC 0 APIN0888 PDCNT EQU * APIN0889 HDNG UPDATE LABEL DIRECTORY FOR LINE APIN0890 * X1=ADDRESS OF PARAMETER LIST APIN0891 ULBDR DC 0 APIN0892 * APIN0893 STX 1 ULB06+1 APIN0894 LD 1 5 ADDRESS OF FUNCTION APIN0895 BSI L ABSAD DEFINITION ENTRY APIN0896 SRA 16 ASSUME NO LABELS TO BE APIN0897 STO DLTCT DELETED APIN0898 * APIN0899 LD L 1 ADDRESS OF START OF APIN0900 A 1 5 LABEL DIRECTORY APIN0901 A 1 5 (DIRECTORY FOLLOWS APIN0902 STO L 2 COUNTS, IDS OF RESULT APIN0903 MDX 2 12 ARGUMENTS, LOCALS) APIN0904 STX 2 ULB09+1 SAVE DIRECTORY ADDRESS APIN0905 * FOR LATER USE APIN0906 LD 1 4 BRANCH IF NO LABELS APIN0907 BSC L ULB03,+- IN DIRECTORY APIN0908 STO L 3 SAVE LABEL COUNT APIN0909 * APIN0910 * FIND NUMBER OF LABELS TO BE DELETED APIN0911 ULB01 LD 2 0 DOES NEXT LABEL BELONG APIN0912 S 1 3 TO THIS LINE APIN0913 BSC L ULB02,Z BRANCH IF NOT APIN0914 MDX L DLTCT,1 IF YES, ADVANCE DELETE APIN0915 ULB02 MDX 2 3 COUNT. NEXT LABEL APIN0916 MDX 3 -1 COUNT LABELS APIN0917 MDX ULB01 CONTINUE IF MORE APIN0918 * APIN0919 ULB03 LD L LABCT CALCULATE APIN0920 SRA 1 APIN0921 S DLTCT OFFSET APIN0922 STO OFSET APIN0923 A 1 4 CALCULATE NEW LABEL APIN0924 STO DLTCT COUNT APIN0925 LD L LABCT BRANCH IF NO LABELS APIN0926 BSC L ULB13,+- IN NEW LINE APIN0927 * APIN0928 * START LABEL VALIDITY CHECK APIN0929 * APIN0930 STO L 3 LINE APIN0931 * APIN0932 ULB05 LDX 2 4 START TO COMPARE APIN0933 STX 2 CMPCT FUNCTION PARAMETERS APIN0934 STX L1 2 APIN0935 ULB06 LDD L *-* LOAD FUNCTION ID APIN0936 MDX ULB08 START COMPARE LOOP APIN0937 * APIN0938 ULB07 LDD 2 4 CHECK THIS LABEL APIN0939 ULB08 SD L3 LABLS-2 WITH ID APIN0940 BSC L ULB12,Z ERROR IF APIN0941 SLT 16 THE SAME APIN0942 BSC L LBERR,+- APIN0943 ULB12 MDX 2 2 ADDRESS OF NEXT ID APIN0944 MDX L CMPCT,-1 COUNT IDS APIN0945 MDX ULB07 CONTINUE IF MORE APIN0946 * APIN0947 * LABEL NOW CHECKED APIN0948 * AGAINST FUNCTION ID APIN0949 * EXPLICIT RESULT APIN0950 * LEFT ARGUMENT APIN0951 * RIGHT ARGUMENT APIN0952 LD 1 4 ANY LABELS IN FUNCTION APIN0953 BSC L ULB04,+- BRANCH IF NOT APIN0954 STO CMPCT IF SO, START LABEL APIN0955 ULB09 LDX L2 *-* CHECK APIN0956 * APIN0957 ULB10 LD 2 2 GET NEXT LABEL ID APIN0958 SRT 16 FROM DIRECTORY APIN0959 LD 2 1 APIN0960 SD L3 LABLS-2 COMPARE WITH THIS LABEL APIN0961 BSC L ULB11,Z BRANCH APIN0962 SLT 16 IF APIN0963 BSC L ULB11,Z DIFFERENT APIN0964 LD 2 0 IF SAME, ERROR IF APIN0965 S 1 3 EXISTING LABEL BELONGS APIN0966 BSC L LBERR,Z TO DIFFERENT LINE APIN0967 ULB11 MDX 2 3 ADDRESS OF NEXT LABEL APIN0968 MDX L CMPCT,-1 COUNT LABELS APIN0969 MDX ULB10 CONTINUE IF MORE APIN0970 * APIN0971 * LABEL NOW CHECKED APIN0972 * AGAINST LABEL DIRECTORY APIN0973 * APIN0974 * APIN0975 MDX 3 -2 COUNT LABELS IN NEW LINE APIN0976 MDX ULB05 CONTINUE IF MORE APIN0977 * APIN0978 * LABELS CAN NOW BE ADDED TO DIRECTORY AS LONG APIN0979 * AS THERE IS SPACE APIN0980 * APIN0981 ULB04 LD OFSET GET SPACE FOR ADDITIONAL APIN0982 LDS 0 LABELS APIN0983 BSI L GSFFD APIN0984 * WE CAN NOW ADJUST LABEL DIRECTORY APIN0985 * APIN0986 ULB13 LDX I2 ULB09+1 ADDRESS OF START OF APIN0987 LD 1 4 LABEL DIRECTORY, BRANCH APIN0988 BSC L ULB16,+- IF EMPTY APIN0989 STO CMPCT SAVE COUNT OF LABELS APIN0990 STX L2 3 APIN0991 ULB14 LD 3 0 DOES NEXT LABEL BELONG APIN0992 S 1 3 TO THIS LINE APIN0993 BSC L ULB15,+- BRANCH IF YES. APIN0994 LD 3 0 MOVE UP LABEL IN APIN0995 STO 2 0 DIRECTORY IF YES APIN0996 LD 3 1 APIN0997 STO 2 1 APIN0998 LD 3 2 APIN0999 STO 2 2 ADDRESS OF APIN1000 ULB19 MDX 2 3 NEXT LABEL TO BE STORED APIN1001 ULB15 MDX 3 3 NEXT LABEL IN DIRECTORY APIN1002 MDX L CMPCT,-1 COUNT LABELS APIN1003 MDX ULB14 CONTINUE IF MORE APIN1004 * APIN1005 ULB16 LD L LABCT ANY LABELS IN NEW LINE APIN1006 BSC L ULB18,+- BRANCH IF NOT APIN1007 * APIN1008 LDX L3 LABLS ADDRESS OF LABEL LIST APIN1009 ULB17 LD 1 3 STORE LINE NUMBER IN APIN1010 STO 2 0 NEXT LABEL ENTRY APIN1011 LD 3 0 STORE LABEL ID IN APIN1012 STO 2 1 NEXT LABEL ENTRY APIN1013 LD 3 1 APIN1014 STO 2 2 APIN1015 MDX 2 3 ADJUST LABEL ENTRY ADDRS APIN1016 MDX 3 2 ADDRESS OF NEXT LABEL APIN1017 MDX L LABCT,-1 COUNT LABELS APIN1018 MDX ULB17 CONTINUE IF MORE APIN1019 * APIN1020 ULB18 LD L DLTCT SAVE NEW LABEL APIN1021 STO 1 4 COUNT APIN1022 * APIN1023 BSC I ULBDR EXIT APIN1024 * APIN1025 * APIN1026 * APIN1027 HDNG LOAD FUNCTION AND LINE DIRECTORIES APIN1028 * LOAD LABEL AND LOCAL DIRECTORIES APIN1029 * APIN1030 * X2 CONTAINS PARAMETER LIST APIN1031 LFNDR DC 0 APIN1032 * APIN1033 STX 1 LFN02+1 SAVE PARAMETER LIST APIN1034 LD ACNTS ADDRESS. SET ADDRESS APIN1035 STO 1 1 FOR STORING COUNTS APIN1036 BSI L LLNDR LOAD LINE DIRECTORY APIN1037 * AND COUNTS APIN1038 * APIN1039 LDX L1 LBCNT-4 GET SPACE FOR FUNCTION APIN1040 LDS 3 DEFINITION ENTRY APIN1041 BSI L GSFFD APIN1042 * APIN1043 * APIN1044 MDX 1 2 SAVE DIRECTORY APIN1045 LD L 1 ADDRESS APIN1046 LDX I2 LFN02+1 IN APIN1047 STO 2 1 PARAMETER LIST APIN1048 * APIN1049 LDD LNCNT STORE APIN1050 STD 1 0 COUNTS AND CURRENT APIN1051 LDD LBCNT LINE NUMBER IN APIN1052 STD 1 2 FUNCTION DEFN ENTRY APIN1053 MDX 1 4 ADVANCE DIRECTORY ADDRES APIN1054 * APIN1055 LDX 2 6 GET AND STORE NEXT APIN1056 BSI L GSNNW 6 WORDS (ID OF RESULT APIN1057 * AND ARGUMENTS) APIN1058 LD LBCNT BRANCH IF NO APIN1059 BSC L LFN01,+- LABELS APIN1060 * APIN1061 * APIN1062 STX 1 LNADD SAVE LOCAL DIRECTORY APIN1063 * ADDRESS APIN1064 A LBCNT COUNT OF WORDS APIN1065 A LBCNT IN LABEL APIN1066 STO L 2 DIRECTORY APIN1067 * APIN1068 MDX I1 LCCNT ADDRESS OF LABEL APIN1069 MDX I1 LCCNT DIRECTORY APIN1070 * APIN1071 BSI L GSNNW GET AND STORE LABEL APIN1072 * DIRECTORY APIN1073 LDX I1 LNADD LOCAL DIRECTORY ADDRESS APIN1074 * APIN1075 LFN01 LD LCCNT EXIT IF NO APIN1076 BSC L LFN02,+- LOCAL DIRECTORY APIN1077 * APIN1078 A LCCNT COUNT OF WORDS IN APIN1079 STO L 2 LOCAL DIRECTORY APIN1080 * APIN1081 BSI L GSNNW GET AND STORE LOCAL APIN1082 * DIRECTORY APIN1083 LFN02 LDX L1 *-* RESET X1 APIN1084 BSC I LFNDR AND EXIT APIN1085 * APIN1086 ACNTS DC LNCNT APIN1087 * APIN1088 * LOAD LINE DIRECTORY APIN1089 * X1 CONTAINS PARAMETER LIST APIN1090 * ADDRESS APIN1091 LLNDR DC 0 APIN1092 * APIN1093 STX 1 LLN02+1 SAVE X1 APIN1094 LD I1 3 APIN1095 STO LNCNT COUNT APIN1096 STO NOLNS APIN1097 LD 1 0 SAVE LINE APIN1098 STO LNADD ADDRESS APIN1099 SRA 16 SAVE APIN1100 STO LNCUR CURRENT LINE NUMBER APIN1101 LLN01 BSI L GNXTW GET NEXT WORD APIN1102 LDX I1 LNADD SAVE LINE APIN1103 STO 1 0 DISK ADDRESS APIN1104 LD LNCUR SAVE LINE APIN1105 STO 1 LNGLD NUMBER APIN1106 LDX L1 LNCUR UPDATE LINE APIN1107 BSI L UPCUR NUMBER APIN1108 MDX L LNADD,1 ADVANCE DIRECTORY ADDRES APIN1109 MDX L NOLNS,-1 COUNT LINES APIN1110 MDX LLN01 CONTINUE IF MORE APIN1111 BSI L GNXTW GET AND STORE APIN1112 STO LBCNT LABEL COUNT APIN1113 BSI L GNXTW GET AND STORE APIN1114 STO LCCNT LOCAL COUNT APIN1115 LLN02 LDX L1 *-* PARAMETER LIST ADDRESS APIN1116 BSC I LLNDR EXIT APIN1117 * APIN1118 DMCNT BSS E 1 APIN1119 DC /00FF APIN1120 LNCNT DC 0 APIN1121 LNCUR DC 0 APIN1122 LBCNT DC 0 APIN1123 LCCNT DC 0 APIN1124 LNADD DC 0 APIN1125 NOLNS EQU * APIN1126 HDNG SET UP FUNCTION DEFINITION M ENTRY APIN1127 * APIN1128 * GET OR ADD SPACE APIN1129 GSFFD DC 0 APIN1130 BSC C BRANCH IF EXISTING ENTRY APIN1131 SRA 16 APIN1132 A 1 4 CALCULATE DIMENSION OF APIN1133 A D0011 ENTRY, ALLOWING FOR APIN1134 SRA 1 OFSET IF THIS IS AN APIN1135 BSC L GSF01,O EXISTING ENTRY APIN1136 A L OFSET APIN1137 MDX GSF05 APIN1138 GSF01 LDS 3 APIN1139 GSF05 STS GSF02 APIN1140 A 1 4 APIN1141 A 1 5 APIN1142 S H0100 ERROR IF DIMENSION HAS APIN1143 BSC L DIRER,- BECOME TOO LARGE APIN1144 A X0200 SAVE NEW APIN1145 STO DMCNT DIMENSION APIN1146 S 1 1 EXIT IF THIS IS LESS APIN1147 BSC I GSFFD,+ THAN OLD DIMENSION APIN1148 SLA 1 GET SPACE APIN1149 STX 1 GSF03+1 IF NEW ENTRY, OR OLD APIN1150 BSI L GETSP DIMENSION SMALLER APIN1151 * APIN1152 GSF02 LDS 0 BRANCH IF APIN1153 BSC L GSF04,O NEW ENTRY APIN1154 GSF03 LDX L1 *-* RESTORE ADDRESS OF ENTRY APIN1155 GSF04 LD DMCNT STORE APIN1156 STO 1 1 DIMENSION APIN1157 BSC I GSFFD EXIT APIN1158 D0011 DC 11 APIN1159 H0100 DC /100 APIN1160 X0200 DC /200 APIN1161 * APIN1162 * STORE COUNTS AND ARGUMENTS APIN1163 * APIN1164 STCAR DC 0 APIN1165 LDX L2 EXPRS ADDRESS OF EXPLICIT APIN1166 LD L LOCCT RESULT. SAVE NEW COUNT APIN1167 STO 1 5 OF LOCALS IN FNDEF ENTRY APIN1168 LDD 2 0 SAVE IDS OF APIN1169 STD 1 6 EXPLICIT RESULT APIN1170 LDD 2 2 AND LEFT ARGUMENT APIN1171 STD 1 8 IN FN DEFN ENTRY APIN1172 LDX I3 LOCCT PREPARE TO COPY IDS OF APIN1173 MDX 3 1 RIGHT ARGUMENT + LOCALS APIN1174 STC01 LDD 2 6 TO FN DEF ENTRY APIN1175 STD 1 10 MOVE NEXT ID APIN1176 MDX 2 2 ADJUST ADDRESSES FOR APIN1177 MDX 1 2 NEXT ID APIN1178 MDX 3 -1 COUNT IDS APIN1179 MDX STC01 BRANCH IF MORE APIN1180 BSC I STCAR EXIT IF NOT APIN1181 HDNG LINE DIRECTORY ROUTINES APIN1182 * FIND LINE IN DIRECTORY APIN1183 * APIN1184 * X1= ADDRESS OF PARAMETER LIST APIN1185 FLNDR DC 0 APIN1186 * APIN1187 LD 1 2 ADDRESS OF LINE APIN1188 STO L 2 DIRECTORY APIN1189 LD I1 1 NUMBER OF LINES APIN1190 STO L 3 APIN1191 FLN01 LD 2 LNGLD IS THIS REQUIRED ENTRY APIN1192 S I1 0 APIN1193 BSC L FLN02,- BRANCH IF YES, OR IF ENTRY APIN1194 MDX 2 1 LINE NUMBER TOO LARGE APIN1195 MDX 3 -1 COUNT LINES APIN1196 MDX FLN01 CONTINUE IF MORE APIN1197 FLN02 STO 1 3 STORE ZERO IF FOUND APIN1198 LDD L 2 SAVE ENTRY OR NEAREST APIN1199 STD 1 4 ENTRY ADDRESS APIN1200 BSC I FLNDR APIN1201 * APIN1202 * DELETE LINE FROM LINE DIRECTORY APIN1203 * X1=ADDRESS OF PARAMETER LIST APIN1204 DLNDR DC 0 APIN1205 LD 1 3 ERROR IF LINE NOT APIN1206 BSC I DLNDR,Z EXIT IF NOT FOUND APIN1207 LD I1 0 ERROR IF ATTEMPT TO APIN1208 BSC I DLNDR,+- EXIT IF LINE ZERO APIN1209 STO L GRBCL SET GARBAGE COLLECT SWTCH APIN1210 LDD 1 4 RESTORE ENTRY AND APIN1211 STD L 2 COUNT APIN1212 MDX DLN02 SKIP INTO LOOP APIN1213 DLN01 LD 2 0 MOVE UP DISK APIN1214 STO 2 -1 ADDRESS ENTRY APIN1215 LD 2 LNGLD MOVE UP LINE APIN1216 STO 2 LNGLD-1 NUMBER ENTRY APIN1217 DLN02 MDX 2 1 ADDRESS OF NEXT ENTRY APIN1218 MDX 3 -1 COUNT REMAINING ENTRIES APIN1219 MDX DLN01 CONTINUE IF MORE APIN1220 LD I1 1 REDUCE LINE APIN1221 D1 EQU *-1 APIN1222 S D1 COUNT BY ONE APIN1223 STO I1 1 APIN1224 STX L LUNPD ENSURE FUNCTION IS CLOSEDAPIN1225 BSC I DLNDR EXIT APIN1226 * APIN1227 * UPDATE LINE DIRECTORY APIN1228 ULNDR DC 0 APIN1229 * X1=ADDRESS OF PARAMETER LIST APIN1230 LDD 1 4 RESTORE COUNT AND ENTRY APIN1231 STD L 2 APIN1232 LD 1 3 BRANCH IF LINE APIN1233 BSC L ULN03,+- WAS FOUND APIN1234 MDX I2 3 ADDRESS OF LAST ENTRY APIN1235 MDX 3 1 BRANCH INTO MOVE APIN1236 MDX ULN02 LOOP APIN1237 ULN01 LD 2 -1 MOVE DISK ADDRESS ENTRY APIN1238 STO 2 0 DOWN ONE APIN1239 LD 2 LNGLD-1 MOVE LINE NUMBER ENTRY APIN1240 STO 2 LNGLD DOWN ONE APIN1241 MDX 2 -1 ADJUST ENTRY ADDRESS APIN1242 ULN02 MDX 3 -1 COUNT ENTRIES APIN1243 MDX ULN01 CONTINUE IF MORE APIN1244 LD I1 1 ADVANCE LINE APIN1245 A D1 COUNT BY APIN1246 STO I1 1 ONE APIN1247 LD I1 0 SAVE CURRENT LINE APIN1248 STO 2 LNGLD NUMBER IN DIRECTORY APIN1249 LD L MODE BRANCH IF NOT APIN1250 A D1 IN FUNCTION APIN1251 BSC L ULN04,+- REDEFINITION MODE APIN1252 SRA 16 NO TRACE BIT APIN1253 MDX ULN05 APIN1254 ULN03 LD L HBIT RETAIN TRACE BIT FROM LINE APIN1255 ULN05 STX L GRBCL INDICATE GARBAGE IN F-SPACE APIN1256 AND 2 0 SAVE TRACE BIT IF PRESENT APIN1257 ULN04 OR L STUAD SET CURRENT LIN ADDRESS APIN1258 STO 2 0 IN LINE DIRECTORY ENTRY APIN1259 STX L LUNPD ENSURE FUNCTION IS CLOSEDAPIN1260 BSC I ULNDR EXIT APIN1261 HDNG ADD FUNCTION TO M-SPACE APIN1262 * APIN1263 FGBTB DC 0 APIN1264 STX 1 FGB02+1 SEARCH GLOBAL TABLE APIN1265 BSI AGBTB IF NOT, ADD ID TO APIN1266 LD 1 5 ADDRESS APIN1267 BSI L ABSAD OF OLD APIN1268 STO L 3 M ENTRY APIN1269 LD D4 APIN1270 BSI L GETSP GET SPACE FOR NEW ENTRY APIN1271 STX L1 2 SVAE ADDRESS APIN1272 * APIN1273 LDD 3 0 TRANDFER M ENTRY APIN1274 STD 2 0 FOR FUNCTION APIN1275 LDD 3 2 TO M-SPACE APIN1276 STD 2 2 APIN1277 * APIN1278 FGB02 LDX L1 *-* ADDRESS OF PARAMETER APIN1279 * LIST APIN1280 LD 1 4 STORE APIN1281 AND HFFF APIN1282 STO 2 0 APIN1283 * APIN1284 LD L 2 STORE CLASS APIN1285 SRT 12 AND APIN1286 LD 1 5 MPTR APIN1287 SRA 12 IN GLOBAL APIN1288 SLT 12 TABLE APIN1289 STO I1 4 ENTRY APIN1290 * APIN1291 LDS 3 ADD ENTRY APIN1292 BSI L RGBTB TO CHAIN APIN1293 * THIS CAN ONLY BE DONE AFTER ALL POSSIBLE APIN1294 * CAUSES OF ERROR HAVE BEEN ELIMINATED APIN1295 BSC I FGBTB EXIT APIN1296 D4 DC 4 APIN1297 HFFF DC /FFF APIN1298 HDNG ADJUST GLOBAL CHAIN APIN1299 * ADD IDENTIFIER TO GLOBAL TABLE APIN1300 * APIN1301 * X1 CONTAINS POINTER TO PARAMETER LIST APIN1302 AGBTB DC 0 APIN1303 STX 1 AGB09+1 SAVE X1 APIN1304 LDX L1 GLBTB ADDRESS OF GLOBAL TABLE APIN1305 LD 1 LENGL-GLBTB APIN1306 S 1 NUMGL-GLBTB APIN1307 BSC L AGB03,+ IS FULL APIN1308 * APIN1309 AGB01 LD 1 0 APIN1310 BSC L AGB08,+- APIN1311 MDX 1 4 APIN1312 MDX AGB01 APIN1313 * APIN1314 AGB03 LD NEGBT APIN1315 BSI L GETSP FOR MORE GLOBALS APIN1316 * APIN1317 LD L MNEXT ADDRESS OF PREVIOUS APIN1318 S NEGBT END OF APIN1319 STO L 2 M MATRIX APIN1320 S L MSTRT NUMBER OF WORDS TO BE APIN1321 STO L 3 MOVED DOWN TO MAKE APIN1322 * ROOM FOR ADDITIONAL APIN1323 * GLOBAL TABLE ENTRIES APIN1324 STO LNGTB LENGTH OF TABLE APIN1325 MDX L LENGL,NEXEN ADVANCE COUNT OF ENTRIES APIN1326 * IN TABLE APIN1327 AGB04 LDD 2 -2 MOVE NEXT DOUBLE WORD APIN1328 STD 2 EGBTB-2 DOWN APIN1329 * APIN1330 MDX 2 -2 ADJUST ADDRESS APIN1331 MDX 3 -2 COUNT WORDS APIN1332 MDX AGB04 CONTINUE IF MORE APIN1333 * APIN1334 STX 2 NGBTB NEXT GLOBAL ENTRY APIN1335 LDX 3 EGBTB NUMBER OF EXTRA WORDS APIN1336 SLT 32 IN GLOBAL TABLE APIN1337 AGB05 STD 2 0 ZERO OUT GLOBAL ENTRIES APIN1338 MDX 2 2 ADJUST ADDRESS APIN1339 MDX 3 -2 COUNT NUMBER OF WORDS APIN1340 MDX AGB05 CONTINUE IF MORE APIN1341 * APIN1342 STX L2 MSTRT NEW START OF M MATRIX APIN1343 * APIN1344 * APIN1345 AGB06 LD 2 0 BRANCH IF THIS ENTRY APIN1346 BSC L AGB07,+Z IS GARBAGE APIN1347 BSI L ABSAD IF NOT CONVERT TO 1130 APIN1348 * ADDRESS APIN1349 LD L 2 ADDRESS OF THIS ENTRY APIN1350 SRT 12 APIN1351 LD 1 0 PLACE NEW ADDRESS APIN1352 SRA 12 IN RELEVANT APIN1353 SLT 12 SYPTR APIN1354 STO 1 0 APIN1355 AGB07 STX L2 3 GET LENGHT OF APIN1356 BSI L CLOMN M-ENTRY APIN1357 STO DIMNS SAVE IT APIN1358 * ADVANCE TO NEXT APIN1359 MDX I2 DIMNS ENTRY APIN1360 LD LNGTB ADJUST COUNT OF WORDS APIN1361 S DIMNS IN MATRIX APIN1362 STO LNGTB APIN1363 BSC L AGB06,-Z CONTINUE IF MORE APIN1364 MDX AGB09 BRANCH OUT IF NOT APIN1365 AGB08 STX 1 NGBTB APIN1366 * APIN1367 AGB09 LDX L1 *-* RESTORE POINTER APIN1368 LD NGBTB SAVE ADDRESS FOR APIN1369 STO 1 4 ENTRY APIN1370 * APIN1371 LDX I2 NGBTB ADDRESS OF ENTRY APIN1372 LDD 1 0 SAVE IDENT IN APIN1373 STD 2 2 ENTRY APIN1374 * APIN1375 MDX L NUMGL,1 ADVANCE COUNT OF GLOBALS APIN1376 * BY ONE APIN1377 BSC I AGBTB EXIT APIN1378 * APIN1379 NEGBT DC EGBTB APIN1380 LNGTB DC 0 APIN1381 NGBTB DC 0 APIN1382 DIMNS EQU * APIN1383 * APIN1384 * CHANGE GLOBAL ID APIN1385 * X1 CONTAINS EXISTING FUNCTION APIN1386 * X2 CONTAINS NEW FUNCTION APIN1387 CGBTB DC 0 APIN1388 STO CGB03 SAVE FN CLASS APIN1389 STX 1 CGB02+1 AND PARAMETER APIN1390 STX 2 CGB01+1 LIST APIN1391 BSI L SGBTB SEARCH FOR EXISTING APIN1392 LDD I CGB01+1 APIN1393 SD 1 0 APIN1394 BSC L CGB01,Z BRANCH IF FUNCTION APIN1395 SLT 16 IDENTIFIERS ARE APIN1396 BSC L CGB04,+- UNCHANGED APIN1397 CGB01 LDX L1 *-* SEARCH GLOBAL APIN1398 BSI L SGBTB TABLE FOR NEW ID APIN1399 LD 1 4 FUNCTION NAME ERROR APIN1400 BSC L FNERR,Z IF FOUND APIN1401 * APIN1402 CGB02 LDX L1 *-* FIND EXISTING GLOBAL APIN1403 * APIN1404 LDS 0 REMOVE GLOBAL APIN1405 BSI RGBTB FROM HAIN APIN1406 LDX I2 CGB01+1 X3 CONTAINS ENTRY ADDRES APIN1407 LDD 2 0 ADJUST APIN1408 STD 1 0 DEFINED FUNCTION APIN1409 LDD 2 2 ID AND APIN1410 STD 1 2 SYNONYM APIN1411 * APIN1412 LDS 3 INSERT GLOBAL APIN1413 BSI RGBTB IN NEW APIN1414 LDD 1 0 CHAIN, AND NEW IDENTIF- APIN1415 STD 3 2 IER IN GLOBAL ENTRY APIN1416 CGB04 LD I1 4 APIN1417 SRT 12 SET APIN1418 LD CGB03 FUNCTION CLASS IN APIN1419 SRA 12 GLOBAL ENTRY APIN1420 SLT 12 APIN1421 STO I1 4 APIN1422 BSC I CGBTB EXIT APIN1423 CGB03 DC 0 APIN1424 * APIN1425 * REMOVE ID FROM CHAIN APIN1426 * X1 CONTAINS POINTER TO PARAMETER LIST APIN1427 RGBTB DC 0 APIN1428 * APIN1429 LD 1 3 PREVIOUS POINTER APIN1430 BSC L RGB01,Z BRANCH IF NOT ZERO APIN1431 LD 1 2 IF ZERO, FORM ADDRESS APIN1432 A AGSTB OF ENTRY IN SYNONYM APIN1433 * TABLE LESS ONE APIN1434 RGB01 STO L 2 SAVE ADDRESS FOR STORING APIN1435 LD 1 4 POINTER TO GLOBAL TO BE APIN1436 BSC L RGB02,O BRANCH IF NOT APIN1437 STO L 3 DELETED APIN1438 * APIN1439 LD 3 1 GET POINTER TO NEXT ID APIN1440 RGB02 EQU * APIN1441 STO 2 1 SAVE IN PREVIOUS ID APIN1442 * APIN1443 BSC I RGBTB APIN1444 * APIN1445 AGSTB DC GLSTB-1 APIN1446 * APIN1447 HDNG READ CHARACTER ROUTINE APIN1448 * ROUTINE TO GET CHARACTER FROM APIN1449 * CARD BUFFER AND PLACE IT IN APIN1450 * THE LOCATION GIVEN BY X1 APIN1451 RDCHR DC 0 APIN1452 STX 1 EA APIN1453 LD L CDSW APIN1454 LDS 0 APIN1455 BSC L RDC16,- APIN1456 RDC01 LD EOS STATEMENT SWITCH APIN1457 BSC L RDC04,+- BRANCH IF START OF STMNT APIN1458 BSC L RDC02,+ BRANCH IF MIDDLE OF STMNT APIN1459 * STATEMENT APIN1460 SRA 16 APIN1461 STO EOS SET EOS TO START OF STMNT APIN1462 LD L CRT SET CARRAIGE RETURN APIN1463 MDX RDC14 AND GO TO STORE IT APIN1464 RDC04 LDX 2 -1 INDICATE STATEMENT NOW APIN1465 STX 2 EOS STARTED APIN1466 LDS 2 INITIATE CARD READ APIN1467 BSI L CDSIO APIN1468 RDC02 MDX L RDCNT,0 SKIP IF EMPTY BUFFER APIN1469 MDX RDC17 BRANCH IF NOT APIN1470 LDS 2 ENSURE A CADD HAS BVEN APIN1471 BSI L CHECK READ APIN1472 LDX I2 I2501 ADDRESS OF FIRST CARD APIN1473 MDX 2 1 COLUMN IN BUFFER APIN1474 STX 2 NXTCH APIN1475 MDX 2 71 APIN1476 LDX 1 72 APIN1477 * BLANK IN CARD FROM COL 72 BACK APIN1478 RDC06 LD 2 0 BRANCH IF NEXT CARD COL APIN1479 BSC L RDC10,Z IS NON BLANK APIN1480 MDX 2 -1 ADJUST CARD COL ADDRESS APIN1481 MDX 1 -1 RDCHR APIN1482 MDX RDC06 CONTINUE IF MORE APIN1483 RDC10 MDX 1 -70 SKIP IF LAST NON BLANK APIN1484 * BEFORE COL 71 APIN1485 LDX 1 0 COUNT GOES TO COL 71 APIN1486 * ONLY IF NON BLANK APIN1487 MDX 1 71 RESTORE CHARACTER APIN1488 NOP COUNT AND APIN1489 STX 1 RDCNT SAVE IT APIN1490 RDC17 LDX I2 NXTCH GET NEXT CHARACTER APIN1491 BSI L TRNCH IN BUFFER - TRANSLATE IT APIN1492 * APIN1493 MDX L NXTCH,1 APIN1494 * REDUCE COUNT OF APIN1495 MDX L RDCNT,-1 CARD CHARACTERS APIN1496 MDX RDC07 BRANCH - NOT CARD END APIN1497 * APIN1498 * APIN1499 RDC03 LDX I2 I2501 CHECK CONTINUATION APIN1500 LD 2 72 APIN1501 BSC L RDC05,Z BRANCH IF NOT APIN1502 * NO CONTINUATION IF YES APIN1503 LDX 2 1 INDICATE STMNT END APIN1504 STX 2 EOS APIN1505 MDX RDC07 APIN1506 RDC05 LDS 2 START I/O TO READ A APIN1507 BSI L CDSIO CARD APIN1508 RDC07 LD MNCNT HAS MNEMONIC BEEN STARTEDAPIN1509 BSC L RDC08,Z APIN1510 * APIN1511 LD L1 TABLE APIN1512 SLA 13 APIN1513 BSC L RDC13,- APIN1514 * APIN1515 SLT 32 ZERO OUT MNEMONIC APIN1516 STD MNEM BLANKS APIN1517 LDX 2 5 ALLOW 5 ALPHABETIC CHARS APIN1518 STX 2 MNCNT APIN1519 MDX RDC02 GET NEXT CHARACTER APIN1520 EOS DC 0 APIN1521 NXTCH DC 0 APIN1522 RDCNT DC 0 APIN1523 MNEM BSS E 2 APIN1524 MNCNT DC 0 APIN1525 EA DC 0 APIN1526 * APIN1527 RDC08 BSC L RDC09,+ BRANCH IF MNEMONIC END APIN1528 LD L1 TABLE SAVE NEXT CHARACTER IN CASE APIN1529 SLA 12 APIN1530 BSC L RDC09,- APIN1531 * APIN1532 LDD MNEM APIN1533 LD L1 CHAIN APIN1534 SLA 11 BUILD APIN1535 A MNEM MNEMONIC APIN1536 RTE 27 APIN1537 STD MNEM SAVE MNEMONIC APIN1538 * APIN1539 MDX L MNCNT,-1 REDUCE MNEMONIC COUNT APIN1540 MDX RDC02 READ NEXT CHARACTER IF MOAPIN1541 LDX 2 -1 INDICATE END OF APIN1542 STX 2 MNCNT MNEMONIC APIN1543 MDX RDC02 GET NEXT CHARACTER APIN1544 RDC09 LD L1 TABLE IS THIS BLANK.PART OF APIN1545 BSC L RDC11,+- MNEMONIC APIN1546 MDX L NXTCH,-1 ELSE STEP BACK ONE APIN1547 MDX L RDCNT,1 ADVANCE CHAR COUNT APIN1548 * APIN1549 STO I NXTCH APIN1550 LDX 2 -1 APIN1551 STX 2 EOS APIN1552 RDC11 LDX 2 0 APIN1553 STX 2 MNCNT APIN1554 RDC12 LDX L2 MNEM APIN1555 LDX L3 MNEMS TABLE TO BE SEARCHED TO X3 APIN1556 BSI L SERCH APIN1557 LD L1 MNEMS APIN1558 SRA 9 APIN1559 STO L 1 APIN1560 * APIN1561 RDC13 LD L1 CHAIN APIN1562 AND L H00FF APIN1563 RDC14 LDX I1 EA STORE APIN1564 STO 1 0 CHARACTER APIN1565 * APIN1566 LD L CDSW HAS DISPLAY BEEN REQUESTED APIN1567 SLA 2 CHECK SWITCHES APIN1568 BSC - SKIP IF YES APIN1569 MDX RDC15 EXIT APIN1570 LDS 3 TYPE CHARACTER APIN1571 RDC16 BSI L TYPE2 APIN1572 * APIN1573 RDC15 BSC I RDCHR EXIT APIN1574 HDNG TRANSLATE CHARACTER FROM CARD READ APIN1575 * THIS ROUTINE EXECUTES A LIST SEARCH APIN1576 * FOR THE CHARACTER POINTED TO BY APIN1577 * REGISTER 2. THERE ARE THREE VECTORS. APIN1578 * THESE ARE APIN1579 * TABLE - WHICH CONTAINS A LIST OF APIN1580 * EBCDIC CARD CODES WITH APIN1581 * CORRESPONDING MASK BITS APIN1582 * FOR IDENTIFYING SPECIAL APIN1583 * CHARACTERS APIN1584 * CHAIN - WHICH CONTAINS THE INTERNAL APIN1585 * HEX CODE FOR EACH CARD CODE APIN1586 * PLUS THE DISPLACEMENT OF APIN1587 * THE NEXT CHARACTER WHICH APIN1588 * HAS THE SAME ZONE PUNCHES APIN1589 * (COLS 12,11,0,8,9) APIN1590 * INDEX - WHICH CONTAINS THE DISPLACE APIN1591 * MENT OF THE FIRST CHARACTER APIN1592 * IN TABLE FOR EACH OF THE APIN1593 * 32 ZONE PUNCH COMBINATIONS APIN1594 * APIN1595 TRNCH DC *-* APIN1596 LD 2 0 CHARACTER TO ACCUMULATOR APIN1597 SRA 4 APIN1598 SRT 16 FORM APIN1599 D CCSYN SYNONYM APIN1600 SLT 16 APIN1601 STO L 1 INDEX DISPLACEMENT TO X1 APIN1602 LD L1 INDEX APIN1603 * APIN1604 TRN02 STO L 1 DISPLACEMENT OF NEXT CHARA- APIN1605 * CTER TO X1 APIN1606 LD L1 TABLE APIN1607 EOR 2 0 APIN1608 SRA 4 APIN1609 BSC I TRNCH,+- EXIT IF FOUND APIN1610 LD L1 CHAIN GET NEXT DISPLACEMENT & APIN1611 TRN01 SRA 8 ISOLATE DISPLACEMENT APIN1612 LDX L1 INVCH-TABLE SET DISPLACEMENT TO APIN1613 BSC I TRNCH,+- APIN1614 MDX TRN02 CHARACTER TO BE CHECKED APIN1615 * APIN1616 CCSYN DC CCRAN APIN1617 * APIN1618 HDNG BINARY SEARCH ROUTINE APIN1619 * THIS ROUTINE DOES A BINARY SEARCH APIN1620 * OF THE VECTOR POINTED TO BY X3 APIN1621 * TO FIND THE WORD OR DOUBLE WORD APIN1622 * POINTED TO BY X2. THE DISPLACEMENT APIN1623 * OF THE CORRESPONDING VECTOR ELEMENT APIN1624 * IS RETURNED IN X1 APIN1625 SERCH DC *-* APIN1626 * CHARACTER FIELDS APIN1627 LDD 3 -4 SAVE STARTING DISPLACEMENT APIN1628 STD DISP AND INCREMENT APIN1629 * APIN1630 SER01 LDX I1 3 APIN1631 MDX I1 DISP APIN1632 * APIN1633 SER02 LDD 1 0 COMPARE BITS 8-31 OF APIN1634 AND H01FF APIN1635 SD 2 0 APIN1636 * APIN1637 BSC L SER04,Z BRANCH IF FIRST WORD DIFFAPIN1638 SLT 16 TRY 2ND WORD APIN1639 BSC L SER05,Z APIN1640 LDX I1 DISP CONTENTS OF DISPLACEMENT APIN1641 BSC I SERCH TO X1 AND EXIT APIN1642 * APIN1643 SER04 BSC L SER05,- BRANCH IF BACKWARD SEARCH APIN1644 * REQD APIN1645 LD DISP FORWARD SEARCH REQD APIN1646 A MOD ADVANCE DISPLACEMENT BY APIN1647 MDX SER06 INCREMENT APIN1648 * APIN1649 SER05 LD DISP BACKWARD SEARCH REQD - APIN1650 S MOD REDUCE DISPLACEMENT BY APIN1651 BSC +Z APIN1652 SRA 16 APIN1653 SER06 STO DISP SAVE NEW DISPLACEMENT APIN1654 LD MOD CHECK FOR END OF SEARCH - APIN1655 S 3 -1 INCREMENT WOULD BE ZERO APIN1656 BSC L SER07,Z APIN1657 LD 3 -2 INVALID CODE - SET INVALID APIN1658 STO L 1 DISPLACEMENT TO X1 APIN1659 BSC I SERCH AND EXIT APIN1660 * APIN1661 SER07 LD MOD HALVE INCREMENT FOR NEXT APIN1662 SRA 1 SEARCH APIN1663 STO MOD APIN1664 MDX SER01 APIN1665 * APIN1666 H01FF DC /01FF APIN1667 BSS E 0 APIN1668 DISP DC 0 APIN1669 MOD DC 0 APIN1670 * APIN1671 HDNG TABLE OF MNEMONICS FOR APL OPERATORS APIN1672 BSS E 0 APIN1673 DC 10 APIN1674 DC 32 APIN1675 DC 74 APIN1676 DC 1 APIN1677 MNEMS DC /A800 GO APIN1678 DC /00EF APIN1679 DC /A000 OR APIN1680 DC /01F2 APIN1681 DC /BE00 QQ APIN1682 DC /0231 QUAD PRIME APIN1683 DC /8E00 AND APIN1684 DC /05C4 APIN1685 DC /5E00 CAP APIN1686 DC /0C30 APIN1687 DC /8400 CUP APIN1688 DC /0EB0 APIN1689 DC /6200 EPS APIN1690 DC /1613 MEMBERSHIP APIN1691 DC /9A00 GEQ APIN1692 DC /1CB1 APIN1693 DC /9600 LEQ APIN1694 DC /30B1 APIN1695 DC /B800 LOG APIN1696 DC /31E7 APIN1697 DC /7E00 MAX APIN1698 DC /3438 APIN1699 DC /6000 MIN APIN1700 DC /352E APIN1701 DC /9E00 NEQ APIN1702 DC /38B1 APIN1703 DC /8000 NOT APIN1704 DC /39F4 APIN1705 DC /7400 REP APIN1706 DC /48B0 REPRESENTATION APIN1707 DC /7C00 RHO APIN1708 DC /490F APIN1709 DC /5C01 BASE APIN1710 DC /0665 APIN1711 DC /BA01 CCMP APIN1712 DC /8DB0 COLUMN COMPRESSION APIN1713 DC /7E01 CEIL APIN1714 DC /952C CEILING APIN1715 DC /BC01 CEXP APIN1716 DC /9710 COLUMN EXPANSION APIN1717 DC /B401 CREV APIN1718 DC /C8B6 COLUMN REVERSAL APIN1719 DC /B401 CROT APIN1720 DC /C9F4 COLUMN ROTATION APIN1721 DC /6602 DEFN APIN1722 DC /14CE FUNCTION DEFINITION APIN1723 DC /8202 DROP APIN1724 DC /49F0 APIN1725 DC /A803 GOTO APIN1726 DC /BE8F APIN1727 DC /6A04 IOTA APIN1728 DC /BE81 APIN1729 DC /C206 LOCK APIN1730 DC /3C6B DEL TILDE APIN1731 DC /6C07 NULL APIN1732 DC /558C APIN1733 DC /7008 QUAD APIN1734 DC /D424 APIN1735 DC /A209 REXP APIN1736 DC /1710 ROW EXPANSION APIN1737 DC /B209 RREV APIN1738 DC /48B6 ROW REVERSAL APIN1739 DC /B209 RROT APIN1740 DC /49F4 ROW ROTATION APIN1741 DC /8A0A TAKE APIN1742 DC /0565 TAKE APIN1743 DC /B60A TRAN APIN1744 DC /482E TRANSPOSE APIN1745 DC /760A TRIG APIN1746 DC /4927 TRIGONOMETRIC FUNCTIONS APIN1747 DC /6842 DELTA APIN1748 DC /B281 TRACE APIN1749 DC /6066 FLOOR APIN1750 DC /3DF2 APIN1751 DC 0 APIN1752 DC 0 APIN1753 HDNG TABLE OF APL CARD CODES APIN1754 INDEX BSS E CCRAN APIN1755 * APIN1756 CHAIN DC /0000 APIN1757 BSS NUMCC APIN1758 ORG ASMIN+/75D APIN1759 TABLE BSS 0 APIN1760 INVCH DC /FFF0 INVALID CHARACTER APIN1761 DC /9008 A APIN1762 DC /8808 B APIN1763 DC /8408 C APIN1764 DC /8208 APIN1765 DC /8108 APIN1766 DC /8088 F APIN1767 DC /8048 G APIN1768 DC /8028 H APIN1769 DC /8018 I APIN1770 DC /5008 J APIN1771 DC /4808 K APIN1772 DC /4408 L APIN1773 DC /4208 M APIN1774 DC /4108 N APIN1775 DC /4088 O APIN1776 DC /4048 P APIN1777 DC /4028 Q APIN1778 DC /4018 R APIN1779 DC /2808 S APIN1780 DC /2408 T APIN1781 DC /2208 U APIN1782 DC /2108 APIN1783 DC /2088 APIN1784 DC /2048 X APIN1785 DC /2028 Y APIN1786 DC /2018 Z APIN1787 DC /2000 0 APIN1788 DC /1000 1 APIN1789 DC /0800 2 APIN1790 DC /0400 3 APIN1791 DC /0200 4 APIN1792 DC /0100 5 APIN1793 DC /0080 6 APIN1794 DC /0040 7 APIN1795 DC /0020 8 APIN1796 DC /0010 9 APIN1797 DC /3000 SLASH APIN1798 DC /80A0 PLUS APIN1799 DC /8000 MULTIPLY APIN1800 DC /0420 LEFT ARROW APIN1801 DC /4420 LEFT BRACKET APIN1802 DC /8820 RIGHT BRACKET APIN1803 DC /2420 COMMA APIN1804 DC /8420 PERIOD APIN1805 DC /1010 ALPHA APIN1806 DC /A800 BASE VALUE APIN1807 DC /A400 CAP APIN1808 DC /A200 FLOOR APIN1809 DC /A100 EPSILON APIN1810 DC /2120 UNDERBAR APIN1811 DC /A040 DEL APIN1812 DC /A020 DELTA APIN1813 DC /A010 IOTA APIN1814 DC /D000 NULL APIN1815 DC /0120 QUOTE APIN1816 DC /C400 APIN1817 DC /8060 RESIDUE APIN1818 DC /C100 APIN1819 DC /C080 CIRCLE APIN1820 DC /4220 STAR APIN1821 DC /2060 QUERY APIN1822 DC /C010 RHO APIN1823 DC /6800 CEILING APIN1824 DC /6400 TILDE APIN1825 DC /6200 DOWN ARROW APIN1826 DC /6100 CUP APIN1827 DC /0810 OMEGA APIN1828 DC /0210 HORSESHOE APIN1829 DC /6020 UP ARROW APIN1830 DC /0410 BACK HORSESHOE APIN1831 DC /B000 AND APIN1832 DC /0060 UMLAUT APIN1833 DC /4000 HIGH MINUS APIN1834 DC /8220 LESS THAN APIN1835 DC /C800 LESS THAN OR EQUAL APIN1836 DC /00A0 EQUAL APIN1837 DC /A080 GRETAER THAN OR EQUAL APIN1838 DC /20A0 GREATER THAN APIN1839 DC /C200 NOT EQUAL APIN1840 DC /C040 OR APIN1841 DC /C020 BACK SLASH APIN1842 DC /4060 MINUS SIGN APIN1843 DC /2220 DIVISION SIGN APIN1844 DC /6080 RIGHT ARROW APIN1845 DC /8120 LEFT PARENTHESIS APIN1846 DC /4120 RIGHT PARENTHESIS APIN1847 DC /40A0 SEMU COLON APIN1848 DC /0820 COLON APIN1849 DC /0110 PHI APIN1850 DC /0090 THETA APIN1851 DC /0050 TRANSPOSE APIN1852 DC /0030 LOG APIN1853 DC /1030 UMSLA APIN1854 DC /0830 UMBSLA APIN1855 DC /6040 QUAD PRIME APIN1856 DC /4820 SHRIEK APIN1857 DC /6010 LOCK APIN1858 DC /0224 AT SIGN APIN1859 DC /0000 BLANK APIN1860 HDNG PUNCH CHARACTER ROUTINE APIN1861 * APIN1862 * APIN1863 * ROUTINE TO PUT CHARACTER INTO APIN1864 * CARD BUFFER FROM THE LOCATION GIVEN APIN1865 * B7 X1, PUNCHING CARDS APIN1866 PHCHR DC 0 APIN1867 STX 1 PHC01+1 APIN1868 LD PHCNT BUFFER - BRANCH IF NOT APIN1869 BSC L PHC01,Z APIN1870 LDS 1 EMPTY BUFFER - ENSURE APIN1871 BSI CHECK LAST PUNCH OPERATION APIN1872 * COMPLETE APIN1873 LDX 2 80 SET PUNCH COUNT TO 80 APIN1874 STX 2 PHCNT APIN1875 LD I2501 APIN1876 STO NXTPH APIN1877 * APIN1878 PHC01 LDX I1 *-* APIN1879 MDX 1 -98 APIN1880 MDX 1 -21 IF BLANK,CAR.REC ETC APIN1881 * OF HEX CODES. X1 CONTAINS APIN1882 LD L1 TABLE+/62 GET EBCDIC CODE APIN1883 AND HFFF0 APIN1884 * CODE APIN1885 MDX L NXTPH,1 ADVANCE BUFFER ADDRESS APIN1886 STO I NXTPH STORE CODE IN BUFFER APIN1887 MDX L PHCNT,-1 REDUCE PUNCH COUNT APIN1888 MDX PHC02 EXIT IF ROOM IN BUFFER APIN1889 * APIN1890 OR H0008 APIN1891 STO I NXTPH APIN1892 LDS 1 BUFFER FULL, PUNCH CARD APIN1893 BSI CDSIO APIN1894 * APIN1895 PHC02 BSC I PHCHR EXIT APIN1896 * APIN1897 PHCNT DC 0 APIN1898 NXTPH DC 0 APIN1899 HFFF0 DC /FFF0 APIN1900 H0008 DC /0008 APIN1901 * APIN1902 HDNG INITIATE CARD I/O OPERATION APIN1903 * ROUTINE TO INITIATE I/O OPERATION APIN1904 * STATUS BYTES ARE 2 FOR READ APIN1905 * 1 FOR WRITE APIN1906 * THIS ROUTINE DESTROYS ACCUMULATOR APIN1907 * APIN1908 CDSIO DC 0 APIN1909 STX 1 CDS07+1 SAVE X1 APIN1910 STS REQ42 SAVE REQUEST APIN1911 LDX L1 CDSW APIN1912 LDX 2 80 IN CASE IT IS REQD APIN1913 SRA 16 ZERO OUT LEVEL 4 APIN1914 STO 1 DSW42-CDSW INTERRUPT RESPONSE APIN1915 CDS01 EQU * APIN1916 LD REQ42 IF NOT READY. BRANCH APIN1917 BSC L CDS03,E IF OUTPUT REQUEST APIN1918 LD 1 CDSW-CDSW IF NOT READY. HAS 1442 APIN1919 AND H0400 BEEN ASSIGNED FOR CARDIN APIN1920 BSC L CDS03,Z APIN1921 XIO S2501-1 IS 2501 READER APIN1922 AND H3003 APIN1923 BSC L CDS02,Z BRANCH IF NOT APIN1924 STX I2 I2501 INITIALISE WORD COUNT APIN1925 XIO I2501 INITIATE 2501 READ APIN1926 LD H0200 GO TO ASSIGN 2501 READER APIN1927 MDX CDS09 APIN1928 CDS02 EQU * APIN1929 LD 1 CDSW-CDSW IF NOT READY. HAS 2501 APIN1930 AND H0200 BEEN ASSIGNED. IF YES APIN1931 BSC L CDS05,Z BRANCH IF NOT READY APIN1932 CDS03 XIO S1442-1 IS 1442 READER/PUNCH APIN1933 AND H3003 READY APIN1934 BSC L CDS05,Z BRANCH IF NOT APIN1935 LD I2501 BUFFER ADDRESS APIN1936 REQ42 LDS BRANCH IF OUTPUT APIN1937 BSC L CDS04,O REQUEST APIN1938 STO L RIOCC APIN1939 XIO RSIOC-1 INITIATE 1442 READ APIN1940 LD H0400 ASSIGN 1442 READER APIN1941 CDS09 OR 1 CDSW-CDSW SAVE ASSIGNED READER APIN1942 STO 1 CDSW-CDSW APIN1943 MDX CDSXT GO TO EXIT APIN1944 CDS04 STO L PIOCC APIN1945 * 0 INTERRUPT FOR PUNCH APIN1946 LD 1 0 APIN1947 AND X0100 IS PUNCH ASSIGNED YET APIN1948 BSC L CDS10,Z GO START PUNCH IF YES APIN1949 LD 1 0 APIN1950 OR X0100 ASSIGN IT APIN1951 STO 1 0 APIN1952 XIO FIOCC-1 FEED CYCLE APIN1953 MDX CDS03 GO WAIT FOR READY APIN1954 CDS10 SRA 16 ZERO OUT LEVEL 4 INTERRUPT APIN1955 STO 1 DSW42-CDSW RESPONSE AFTER FEED CYCLAPIN1956 XIO PSIOC-1 APIN1957 MDX CDSXT GO TO EXIT APIN1958 * APIN1959 * UNREADY SITUATION APIN1960 * APIN1961 CDS05 LD L ATTN ATTENTION TERMINATES APIN1962 BSC L CDS01,+- APIN1963 CDS06 LD H0800 READY LOOP TERMINATED APIN1964 STO 1 DSW42-CDSW BY ATTENTION. ENSURE APIN1965 * LEVEL 4 INTERRUPT APIN1966 * RESPONSE MARKED OK. APIN1967 LD REQ42 APIN1968 SLA 15 APIN1969 BSC L NXSMT,- APIN1970 CDSXT EQU * APIN1971 CDS07 LDX L1 *-* RESTORE X1 AND EXIT APIN1972 BSC I CDSIO APIN1973 H3003 DC /3003 APIN1974 I2501 BSS E 0 APIN1975 DC BUFFR-1 APIN1976 DC /4E00 APIN1977 H0800 DC /0800 APIN1978 S2501 DC /4F00 APIN1979 H0400 DC /0400 APIN1980 S1442 DC /1700 APIN1981 H0200 DC /0200 APIN1982 PSIOC DC /1401 APIN1983 X0100 DC /0100 APIN1984 RSIOC DC /1404 APIN1985 HDNG CHECK FOR COMPLETION OF CARD I/O OPN APIN1986 * THIS ROUTINE CHECKS TO SEE IF ANY APIN1987 * IBM 1442 OPERATION IS STILL TO BE APIN1988 * CHECKED FOR COMPLETION. IF IT IS, APIN1989 * IT WAITS (IF NECESSARY) FOR THE APIN1990 * OPERATION TO COMPLETE, AND THEN APIN1991 CHECK DC 0 APIN1992 STS CHK42 SAVE STATUS APIN1993 LD CHK42 COMPARE WITH REQUESTS APIN1994 AND REQ42 APIN1995 SLA 14 APIN1996 BSC I CHECK,+- EXIT IF NO REQUEST APIN1997 * APIN1998 * THERE IS AN I/O OPERATION APIN1999 * INITIATED BUT NOT CHECKED APIN2000 LDX L1 CDSW APIN2001 CHK01 LD 1 DSW42-CDSW HAS LEVEL 4 INTERRUPT APIN2002 * OCCURRED - DSW42 IS ZEROED APIN2003 * APIN2004 * BY CDSIO AND SET BY ILS4 APIN2005 BSC L CHK02,Z APIN2006 LD 1 CDSW-CDSW IS ANYTHING APIN2007 SLA 4 ACTIVE? APIN2008 BSC L CHK07,+Z BRANCH IF YES APIN2009 SLA 2 NOTHING ACTIVE. WHAT DEVICE APIN2010 BSC L CHK05,C BRANCH IF 1442 READER APIN2011 BSC L CHK07,- BRANCH IF 1442 PUNCH APIN2012 XIO S2501-1 2501 READER. IS IT READY APIN2013 BSC L CHK07,Z BRANCH IF NOT APIN2014 * IF 2501 READER INDICATES THAT IT IS READY, APIN2015 * YET NO INTERRUPT HAS OCCURRED AS A RESULT APIN2016 * OF THE START READ, THEN THE 2501 CANNOT BE APIN2017 * PRESENT IN THIS SYSTEM APIN2018 LD H0400 ASSIGN 1442 READER APIN2019 MDX CHK06 APIN2020 * APIN2021 CHK05 XIO S1442-1 1442 READER. IS IT READY APIN2022 BSC L CHK07,Z BRANCH IF NOT APIN2023 * IF 1442 UNIT INDICATES THAT IT IS READY, YET APIN2024 * NO INTERRUPT HAS OCCURRED AS A RESULT OF YHE APIN2025 * START READ, THEN TH UNIT CAN ONLY BE A PUNCH APIN2026 LD H0200 ASSIGN 2501 READER APIN2027 CHK06 SRT 12 ADJUST CARD SWITCH APIN2028 LD 1 DSW42-CDSW APIN2029 BSC L CHK02,Z APIN2030 LD 1 CDSW-CDSW TO INDICATE APIN2031 SRA 12 THE REASSIGNED APIN2032 SLT 12 DEVICE APIN2033 STO 1 CDSW-CDSW APIN2034 CHK03 EQU * APIN2035 CHK42 LDS APIN2036 BSI CDSIO APIN2037 MDX CHK01 CHECK FOR COMPLETION APIN2038 FIOCC DC /1402 APIN2039 * APIN2040 CHK07 WAIT WAIT FOR INTERRUPT APIN2041 MDX CHK01 APIN2042 CHK02 SLA 2 WHAT IS THE RESULT APIN2043 BSC L CHK03,+Z APIN2044 LD 1 CDSW-CDSW SET DEVICE ACTIVE APIN2045 OR H0800 APIN2046 STO 1 CDSW-CDSW APIN2047 LDS 0 APIN2048 STS REQ42 APIN2049 BSC I CHECK EXIT APIN2050 * APIN2051 LGTH3 EQU *-TABLE APIN2052 LGTH1 EQU *-ASMIN APIN2053 HDNG BUFFER AREA NOT IN OVERLAY AREA APIN2054 ORG LOCOR-/61 BUFFER FOR CARD I/O APIN2055 BSS 1 APIN2056 BUFFR BSS E 80 APIN2057 ORG BUFFR APIN2058 LABLS EQU * APIN2059 EXPRS BSS 2 APIN2060 LARG BSS 2 APIN2061 FUNCT BSS 2 APIN2062 RARG BSS 2 APIN2063 ORG LOCOR-8 APIN2064 LWKSP BSS E 5 APIN2065 CPTR DC 0 APIN2066 HDNG POINTERS,MATRIX AND STACK APIN2067 ORG LOCOR+15 APIN2068 DC /140 APIN2069 DC DACLN APIN2070 NEXEN EQU 5 APIN2071 EGBTB EQU NEXEN*4 APIN2072 LNGLD EQU 51 APIN2073 LENGL DC NEXEN APIN2074 NUMGL DC 0 APIN2075 MSTRT DC MATRX+EGBTB APIN2076 MNEXT DC MATRX+EGBTB APIN2077 STUAD DC DASTU APIN2078 SOLPT DC DASTU APIN2079 PAREL DC STKOR APIN2080 GRBCL DC 0 APIN2081 LUNPD DC 0 APIN2082 RAND DC 0 APIN2083 DC /41A7 APIN2084 GLSTB BSS E 0 APIN2085 DC 0 APIN2086 DC 0 APIN2087 DC 0 APIN2088 DC 0 APIN2089 DC 0 APIN2090 DC 0 APIN2091 DC 0 APIN2092 DC 0 APIN2093 DC 0 APIN2094 DC 0 APIN2095 DC 0 APIN2096 DC 0 APIN2097 DC 0 APIN2098 DC 0 APIN2099 DC 0 APIN2100 DC 0 APIN2101 DC 0 APIN2102 DC 0 APIN2103 DC 0 APIN2104 DC 0 APIN2105 DC 0 APIN2106 DC 0 APIN2107 DC 0 APIN2108 DC 0 APIN2109 DC 0 APIN2110 DC 0 APIN2111 GLBTB BSS E 0 APIN2112 DC 0 APIN2113 DC 0 APIN2114 DC 0 APIN2115 DC 0 APIN2116 DC 0 APIN2117 DC 0 APIN2118 DC 0 APIN2119 DC 0 APIN2120 DC 0 APIN2121 DC 0 APIN2122 DC 0 APIN2123 DC 0 APIN2124 DC 0 APIN2125 DC 0 APIN2126 DC 0 APIN2127 DC 0 APIN2128 DC 0 APIN2129 DC 0 APIN2130 DC 0 APIN2131 DC 0 APIN2132 ORG GLBTB APIN2133 MATRX BSS E 1920-*+LENGL APIN2134 ORG *-5 APIN2135 STKOR DC /4000 APIN2136 HDNG INPUT EDIT OVERLAY 2 APIN2137 ORG ASMED-2 APIN2138 DC 5*/140 APIN2139 DC DAEDT APIN2140 DC EDTOV APIN2141 HDNG INPUT AND EDIT NEXT STATEMENT APIN2142 * APIN2143 GNSTM DC 0 APIN2144 LDX L1 LOCOR APIN2145 LDX L2 MODE APIN2146 LD 1 SOLPT-LOCOR INITIALISE CURRENT DISK APIN2147 STO 1 STUAD-LOCOR ADDRESS POINTER APIN2148 LD 1 PAREL-LOCOR GET TOP LEVEL HEADER APIN2149 STO 1 14 STORE IN LC REG14 APIN2150 STO L 1 ADDRESS IN X1 APIN2151 LD 1 3 ENSURE TRACE BIT APIN2152 AND Y7FFF REMOVED FROM HEADER APIN2153 STO 1 3 AT TOP OF STACK APIN2154 LD 2 MODE-MODE APIN2155 BSC L GNS10,+Z APIN2156 LD 1 0 SET MODE ACCORDING APIN2157 SRA 12 SUSPENDED FUNCTION APIN2158 AND D3 TO QUAD FLAGS APIN2159 STO 2 MODE-MODE APIN2160 GNS10 LDX L1 CHAR APIN2161 LD H01 INITIALISE CARRAIGE APIN2162 STO 2 CHRCT-MODE POSITION APIN2163 * APIN2164 LD 1 STBUF-CHAR INITIALISE POINTERS APIN2165 STO 1 R14-CHAR FOR STATEMENT INPUT APIN2166 STO 1 R13-CHAR BUFFER APIN2167 LDD 1 EGCOL-CHAR SET GARBAGE COLLECT APIN2168 STD 2 MGCOL-MODE ERROR ADDRESSES APIN2169 LD 2 SINON-MODE APIN2170 SLA 1 APIN2171 BSC L GNS11,+- APIN2172 BSI L TSTIN APIN2173 MDX GNS03 APIN2174 STO L CHAR APIN2175 MDX GNS05 APIN2176 GNS11 EQU * APIN2177 LD 2 MODE-MODE BRANCH IF QUAD PRIME APIN2178 S H01 APIN2179 BSC L GNS05,-Z APIN2180 LD L CDSW IS THIS TYPEWRITER MODE APIN2181 BSC L GNS06,- BRANCH IF YES APIN2182 SLA 2 CARD MODE. BRANCH IF APIN2183 BSC L GNS06,+Z DISPLAY REQUIRED APIN2184 MDX L CHRCT,6 BRANCH IF APIN2185 MDX GNS07 NO DISPLAY REQUIRED APIN2186 GNS06 LD 2 MODE-MODE BRANCH TO TYPE QUAD APIN2187 BSC L GNS02,-Z MESSAGE IF QUAD INPUT APIN2188 BSC L GNS03,- BRANCH IF IMMEDIATE EXEC.APIN2189 * APIN2190 A D02 BRANCH IF THIS IS NOT APIN2191 BSC L GNS01,- SUPEREDIT MODE APIN2192 LD POSN POSITION OF CARRAIGE APIN2193 MDX GNS08 GO MOVE IT APIN2194 D02 DC 2 APIN2195 POSN DC 0 APIN2196 Y7FFF DC /7FFF APIN2197 D3 DC 3 APIN2198 GNS01 LDX L1 LNPML APIN2199 BSI L LNMES FUNCTION DEFINITION MODE APIN2200 MDX GNS03 APIN2201 * APIN2202 GNS02 LDX L3 QADMS TYPE QUAD APIN2203 LDX 1 6 APIN2204 BSI L TYNCH LINE FEED APIN2205 * APIN2206 GNS03 LD D7 ENSURE CHARACTER IS APIN2207 GNS08 EQU * APIN2208 BSI L MVCRG AT LEAST AT POSITION 6 APIN2209 * APIN2210 * APIN2211 GNS07 LDX I3 CHRCT FILL BUFFER APIN2212 LD BLK TO LEFT OF CURRANT APIN2213 MDX 3 -1 CHARACTER POSITION APIN2214 GNS04 STO I R14 WITH SPACES APIN2215 MDX L R14,-1 APIN2216 MDX 3 -1 APIN2217 MDX GNS04 APIN2218 LD R14 END OF LINE APIN2219 STO R13 POINTERS APIN2220 GNS05 STX LFSW SET LINE FEED SWITCH APIN2221 STX TLSW TOO LONG WITCH APIN2222 SRA 16 CLEAR COLON SWITCH APIN2223 STO L RSEND APIN2224 GNS09 EQU * APIN2225 BSI L INPST INPUT STATEMENT APIN2226 * APIN2227 * APIN2228 LDX 1 1 RESET CHARACTER COUNT APIN2229 STX L1 CHRCT FOR OUTPUT MESSAGES APIN2230 * APIN2231 EDSTM LD L RSEND ERROR IF APIN2232 BSC L RESMS,Z TRANSMISSION FAULT APIN2233 * APIN2234 LD TLSW ERROR IF APIN2235 BSC L TLNMS,+- STATMENT TOO LONG APIN2236 LD STBUF APIN2237 STO R14 START AT POSITION 1 APIN2238 LD L MODE IS THIS SUPEREDIT APIN2239 A D02 MODE? APIN2240 BSC L SPRED,+Z APIN2241 * APIN2242 BSI L STPSP SET PUTSYL PARAMETERS APIN2243 * APIN2244 LD L MODE IS THIS APIN2245 S H01 APIN2246 BSC L EDS01,+ APIN2247 BSI L BLQPM BUILD QUAD PRIME STRING APIN2248 MDX EDS05 APIN2249 D7 DC 7 APIN2250 H01 DC 1 APIN2251 PARTS DC /56-/78 APIN2252 EDS01 BSI L NONBK GET FIRST NON BLANK APIN2253 MDX EDS06 SKIP FOR EMPTY LINE APIN2254 S PARTS CHECK FOR COMMAND APIN2255 BSC L XEQCM,+- EXECUTE IT IF IT IS APIN2256 LD R14 APIN2257 A ONE APIN2258 STO FNBLA APIN2259 EDS02 LD L CDSW IS THIS A CARD APIN2260 SLA 3 PLUSH APIN2261 BSC L GNXST,+Z GO TO GET NEXT STATEMENT APIN2262 * IF YES APIN2263 LD L MODE IS THIS FUNCTION DEFN APIN2264 BSC L EDS03,+Z MODE. GO TO EDIT FUNCTN APIN2265 * STATEMENT IF YES APIN2266 * IF YES APIN2267 LD L SINON IF NOT, INVALID SIGN ON APIN2268 SLA 1 APIN2269 BSC L INSGN,Z APIN2270 * APIN2271 * APIN2272 LD CHAR CHECK FOR OPEN FN DEFN APIN2273 S DEL IS THIS A DEL APIN2274 BSC L EDS04,Z BRANCH IF NOT OPEN FN APIN2275 * APIN2276 BSI L OPFND OPEN FUNCTION DEFINITION APIN2277 MDX GNXST GO GET NEXT STATEMENT APIN2278 * IF END OF LINE APIN2279 STLIN DC STBFS-6 APIN2280 STBUF DC STBFS APIN2281 HLIM DC STBFE APIN2282 ONE DC 1 APIN2283 DEL DC /33 APIN2284 R13 DC 0 APIN2285 R14 DC 0 APIN2286 TLSW DC 1 APIN2287 RPAR DC /56 APIN2288 CRT DC /79 APIN2289 FNBLA DC 0 APIN2290 QADMS DC /38 APIN2291 DC /58 APIN2292 DC /7A APIN2293 BLK DC /78 APIN2294 DC /78 APIN2295 DC /78 APIN2296 EDS06 LD L MODE EMPTY LINE. CHECK MODE APIN2297 BSC L GNXST,- IGNORE IF NOT IN FN DEFN APIN2298 EDS03 MDX L R14,1 APIN2299 BSI L EDFND APIN2300 * ION DEFN MODE APIN2301 MDX GNXST GO TO GET NEXT STATEMENT APIN2302 * EXIT APIN2303 EDS04 MDX L R14,1 APIN2304 BSI L ESLIN APIN2305 LD L LTERM SYNTAX ERROR IF LINE APIN2306 BSC L SYNER,- TERMINATED BY DEL OR APIN2307 * DEL TILDE APIN2308 EDS05 BSI L SNSOL APIN2309 XEQST MDX L GNSTM,1 EXECUTE STATEMENT EXIT APIN2310 XEQCM MDX L GNSTM,1 EXECUTE COMMAND EXIT APIN2311 GNXST BSC I GNSTM FN DEFN MODE EXIT APIN2312 * APIN2313 * APIN2314 CHAR BSS E 3 APIN2315 LFSW DC 1 APIN2316 EGCOL DC WSFER APIN2317 DC DOVER APIN2318 * APIN2319 * APIN2320 * APIN2321 * APIN2322 SLH DC /25 APIN2323 MET DC /62 APIN2324 RESMS LDX 1 1 APIN2325 MDX ERRXT APIN2326 * APIN2327 TLNMS LDX 1 2 APIN2328 MDX ERRXT APIN2329 * APIN2330 INSGN LDX 1 3 APIN2331 MDX ERRXT APIN2332 * APIN2333 SYNER LDX 1 4 APIN2334 MDX ERRTS APIN2335 * APIN2336 * APIN2337 FNERR LDX 1 6 APIN2338 MDX ERRXT APIN2339 * APIN2340 INDOM EQU * APIN2341 DOMER LDX 1 7 APIN2342 MDX ERRTS APIN2343 * APIN2344 DOVER LDX 1 8 APIN2345 MDX ERRXT APIN2346 * APIN2347 WSFER LDX 1 9 APIN2348 MDX ERRXT APIN2349 * APIN2350 BADCH LDX 1 10 APIN2351 MDX L R14,-1 APIN2352 MDX ERRXT APIN2353 * APIN2354 LBERR LDX 1 11 APIN2355 MDX ERRXT APIN2356 * APIN2357 DIRER LDX 1 12 APIN2358 MDX ERRXT APIN2359 * APIN2360 IDERR LDX 1 13 APIN2361 MDX ERRXT APIN2362 ERRTS LD L MODE BRANCH IF IN APIN2363 BSC L CPBMS,+Z FUNCTION DEFINITION APIN2364 ERRXT BSC L ERRAD GO TO ERROR IN APL CNTRL.APIN2365 * SYNTAX AND DOMAIN ERRORS OCCURRING DURING APIN2366 * FUNCTION DEFINITION WILL HAVE BEEN FOUND APIN2367 * IN THE ROUTINE ESLIN. APIN2368 CPBMS LD L SOLPT RESET APIN2369 STO L STUAD START OF LINE ADDRESS APIN2370 STX 1 ERRCH SAVE ERROR TYPE APIN2371 BSI L STPSP SET PUTSYL PARM LIST APIN2372 LD FNBLA APIN2373 S R14 WHERE ERROR APIN2374 STO CNTCH IS APIN2375 LDX L3 BMITC APIN2376 LDX L1 MTCLN OUTPUT APIN2377 BSI 3 BMITC-BMITC APIN2378 LD FNBLA APIN2379 STO R14 R14 TO START OF STATEMNT APIN2380 CPB01 BSI L GETCH GET NEXT CHARACTER APIN2381 MDX CPB03 END OF STATEMENT APIN2382 BSI L DELCK CHECK FOR DEL APIN2383 LD L LTERM DID IT OCCUR APIN2384 BSC L CPB02,+- END OF LINE IF YES APIN2385 LDX L1 CHAR CHARACTER TO DISK APIN2386 BSI 3 BMITC-BMITC APIN2387 MDX CPB01 GO GET NEXT CHARACTER APIN2388 CPB03 EQU * APIN2389 LDX 1 -1 SET LINE END APIN2390 STX L1 LTERM APIN2391 CPB02 LDX L1 CNTCH ERROR POSITION APIN2392 BSI 3 BMITC-BMITC APIN2393 LDX L1 ERRCH TYPE OF ERROR APIN2394 BSI 3 BMITC-BMITC APIN2395 LDX L1 ERSYL ERROR INDICATOR APIN2396 BSI 3 BMITC-BMITC APIN2397 BSI 3 BMTNL-BMITC APIN2398 BSC I ESLIN APIN2399 ERRCH DC 0 APIN2400 CNTCH DC 0 APIN2401 ERSYL DC /21 APIN2402 NXSMT LD 1 CDSW-CDSW APIN2403 AND X2000 APIN2404 BSI L PRCRT,Z APIN2405 BSC I GNSTM APIN2406 X2000 DC /2000 APIN2407 SPRED MDX L MODE,2 APIN2408 LDX 2 120 APIN2409 LDX L3 CHAR INPUT STATEMENT APIN2410 SPR01 BSI L GETCH GET CHARACTER APIN2411 LD 3 BLK-CHAR BLANK IF LINE END APIN2412 STO L2 PAGE0-1 STORE CHARACER APIN2413 MDX 2 -1 APIN2414 MDX SPR01 APIN2415 SRA 16 APIN2416 STO 3 STLIN-CHAR APIN2417 BSI L SUPER SET UP BUFFER APIN2418 SPR02 LD 3 STLIN-CHAR APIN2419 S 3 R14-CHAR APIN2420 BSC L GNS09,+ APIN2421 LDX L1 BKSPA APIN2422 BSI L TYPE MOVE CHARCTER APIN2423 MDX L R14,1 BACK TO START OF LINE APIN2424 MDX SPR02 APIN2425 HDNG OPEN FUNCTION FOR DEFINITION APIN2426 * APIN2427 OPFND DC 0 APIN2428 LD L MODE OPENING FUNCTION DEFN APIN2429 BSC L SYNER,Z DURING QUAD MODE IS APIN2430 * NOT ALLOWED APIN2431 BSI L EDHLN EDIT HEADER LINE APIN2432 * APIN2433 LDX L1 FNDPL ADDRESS OF FN DEFN APIN2434 LDD L FUNCT PARAMETER LIST. STORE APIN2435 STD 1 0 FUNCTION ID. APIN2436 BSI L CKDFN CHECK FUNCTION ID APIN2437 * APIN2438 OPF01 LD L3 TYPES IS THIS AN APIN2439 SLA 1 OLD FUNCTION APIN2440 BSC L OPF02,- BRANCH IF NOT APIN2441 * APIN2442 LD L LTERM IF NEW FUNCTION, LINE APIN2443 BSC L FNERR,-Z MUST BE TERMINTED APIN2444 * TERMINATED APIN2445 BSI L ONFDF OPEN NEW FUNCTION APIN2446 STX L LUNPD FUNCTION MUST BE CLOSED APIN2447 BSI SNSOL SET NEW START OF LINE APIN2448 BSI L SLDPL SET LINE DIRECTORY PARMS APIN2449 LD H001 APIN2450 STO I LNPML+1 APIN2451 LD L STUAD STORE ADDRESS OF APIN2452 STO L LINDR HEADER LINE APIN2453 SRA 16 STORE LINE APIN2454 STO L LINDR+LNGLD NUMBER APIN2455 MDX OPF04 APIN2456 H001 DC 1 APIN2457 OPF02 SLA 1 OLD FUNCTION. IS IT APIN2458 BSC L FNERR,- EDITABLE. ERROR IF NOT APIN2459 LD L PARCT CHECK PARAMETER COUNT APIN2460 S H001 APIN2461 BSC L FNERR,Z ERROR IF NOT ONE APIN2462 * APIN2463 LD L LTERM HOW IS IT TERMINATED APIN2464 BSC L OPF03,+ BRANCH IF LINE END APIN2465 S LBR DID LEFT BRACKET TERMIN APIN2466 BSC L FNERR,Z ERROR IF NOT APIN2467 * FOLLOWING LINE APIN2468 OPF03 LD L SOLPT RESET CURRENT DISK APIN2469 STO L STUAD POINTER APIN2470 BSI L STGSP SET GETSYL PARAMETERS APIN2471 * APIN2472 BSI L OOFDF OPEN OLD FUNCTION APIN2473 SRA 16 NO LINES UPDATED YET APIN2474 STO L LUNPD APIN2475 * APIN2476 BSI L STPSP RESET PUTSYL PARAMETERS APIN2477 BSI L SLDPL SET LINE DIRECTORY PARMS APIN2478 * APIN2479 OPF04 LD L LTERM EXIT IF LINE APIN2480 BSC I OPFND,+Z TERMINATED APIN2481 LD OPFND SET EXIT FROM APIN2482 STO EDFND EDIT FUNCTION DEFN APIN2483 LD L LTERM APIN2484 BSC L EDF06,+ BRANCH IF CLOSE APIN2485 MDX EDF10 GO BUILD LINE NUMBER APIN2486 * APIN2487 * APIN2488 LBR DC /29 APIN2489 LBRN DC /29-/56 APIN2490 ALNGL DC LNGLD APIN2491 * APIN2492 * SET NEQ START OF LINE POINTER APIN2493 * APIN2494 SNSOL DC 0 APIN2495 LDX L1 PTSPL FLUSH BUFFER TO DISK APIN2496 BSI L FSYL APIN2497 LDX I1 PAREL APIN2498 LD L STUAD APIN2499 STO L SOLPT APIN2500 STO 1 1 APIN2501 STO 1 4 APIN2502 BSC I SNSOL APIN2503 HDNG EDIT FUNCTION DEFINITION LINE APIN2504 * APIN2505 EDFND DC 0 APIN2506 * APIN2507 EDF01 BSI L NONBK GET NEXT NON-BLANK APIN2508 MDX EDF07 END OF LINE APIN2509 * APIN2510 BSI L DELCK CHECK FOR LINE CLOSE APIN2511 LD L LTERM IS THIS CLOSE FUNCTION APIN2512 BSC L EDF06,+- BRANCH IF YES APIN2513 * APIN2514 LD L CHAR THIS IS NOT CLOSE FN YET APIN2515 S L RPAR APIN2516 BSC L XEQCM,+- EXECUTE COMMAND APIN2517 S LBRN BRANCH IF NEXT CHARACTER APIN2518 BSC L EDF02,Z NOT A RIGHT BRACKET APIN2519 * APIN2520 EDF10 BSI L BSLNM BUILD/STORE LINE NUMBER APIN2521 * IF RIGHT BRACKET APIN2522 LD L CURLN STORE CURRENT LINE APIN2523 STO I LNPML NUMBER APIN2524 * APIN2525 LD L DSPSW GET NEXT NON-BLANK IF APIN2526 BSC L EDF01,+- NO QUAD READ APIN2527 * APIN2528 * APIN2529 BSI L SDSPM APIN2530 LD L DSPSW APIN2531 STO BELOW APIN2532 STX 2 EDF12+1 APIN2533 LDX 2 PCHOV APIN2534 BSI L GOVLY APIN2535 EDF12 LDX L2 *-* APIN2536 LD BELOW APIN2537 BSI 3 FNDSP APIN2538 * NO NEED TO CALL IN INPUT APIN2539 * OVERLAY IN BECAUSE NOT APIN2540 * REQUIRED BY CLFDF,UPCUR APIN2541 * APIN2542 LD BELOW APIN2543 BSC L EDF09,+ APIN2544 EDF14 EQU * DISPLAY IGNORED APIN2545 LD LTERM EXIT WITH NO UPDAT IF APIN2546 BSC I EDFND,Z FUNCTION NOT TO BE CLOSED APIN2547 MDX EDF06 CLOSE FUNCTION APIN2548 * APIN2549 * APIN2550 * APIN2551 EDF02 LDX L1 LNPML FIND LINE IN DIRECTORY APIN2552 BSI L FLNDR APIN2553 * APIN2554 MDX L R14,1 SKIP BACK ONE CHARACTER APIN2555 LD L R14 RESET START OF LINE APIN2556 STO L FNBLA APIN2557 LD 1 3 WAS LINE FOUND APIN2558 BSC L EDF03,+- BRANCH IF YES APIN2559 LD I1 1 IF NOT IS THERE ENOUGH APIN2560 S ALNGL ROOM FOR MORE APIN2561 BSC L DIRER,- ERROR IF NOT APIN2562 * APIN2563 EDF03 LD I1 0 IS THIS A HEADER LINE APIN2564 BSC L EDF04,Z BRANCH IF NOT APIN2565 * APIN2566 LDX I3 FNDPL+6 FUNCTION HEADER APIN2567 LD L3 TYPES CANNOT BE EDITED APIN2568 SLA 3 IF FUNCTION IS APIN2569 BSC L FNERR,- SUSPENDED APIN2570 * APIN2571 BSI EDHLN EDIT HEADER LINE APIN2572 * APIN2573 LD LTERM ERROR IF HEADER NOT APIN2574 BSC L FNERR,-Z TERMINATED APIN2575 * APIN2576 LDX L1 FNDPL SET UP NEW FUNCTION APIN2577 BSI L SUNFH HEADER APIN2578 MDX EDF05 APIN2579 * APIN2580 EDF04 BSI L ESLIN EDIT LINE APIN2581 LDX L1 FNDPL UPDATE LABEL APIN2582 BSI L ULBDR DIRECTORY APIN2583 * APIN2584 EDF05 BSI SNSOL SET NEW START OF LINE APIN2585 * APIN2586 LDX L1 LNPML UPDATE LINE DIRECTORY APIN2587 BSI L ULNDR APIN2588 * APIN2589 EDF09 LD LTERM IS FUNCTION TO BE CLOSED APIN2590 BSC L EDF08,Z BRANCH IF NOT APIN2591 * APIN2592 EDF06 BSI STPSP APIN2593 BSI L CLFDF APIN2594 * APIN2595 MDX EDF13 APIN2596 * APIN2597 EDF07 LD L LFSW EXIT IF NO APIN2598 BSC I EDFND,Z ERASE APIN2599 LDX L1 LNPML FIND LINE IN DIRECTORY APIN2600 BSI L FLNDR APIN2601 BSI L DLNDR DELETE LINE APIN2602 SRA 16 ZERO LABEL APIN2603 STO L LABCT COUNT APIN2604 LDX L1 FNDPL REMOVE ANY LABELS APIN2605 BSI L ULBDR BELONGING TO DELETED LN APIN2606 * APIN2607 EDF08 LDX I1 LNPML UPDATE CURRENT LINE NO APIN2608 BSI L UPCUR APIN2609 EDF13 BSC I EDFND APIN2610 LTERM DC 0 APIN2611 CLOCK DC 0 APIN2612 BELOW DC 0 APIN2613 D5 DC 5 APIN2614 STPSP DC 0 APIN2615 LDD PTPMS APIN2616 STD L PTSPL APIN2617 LD STPSP APIN2618 STO STGSP APIN2619 MDX STGS1 APIN2620 PTPMS BSS E 0 APIN2621 DC 0 APIN2622 DC STUAD APIN2623 GTPMS DC PAGE0 APIN2624 DC CPTR APIN2625 DC CHAR APIN2626 DC FNPTR APIN2627 * APIN2628 STGSP DC 0 APIN2629 LDD GTPMS+2 APIN2630 STD L GTSPL APIN2631 LD I FNDPL+4 APIN2632 BSI L ABSAD APIN2633 LD 1 2 APIN2634 STO I GTSPL+1 APIN2635 STGS1 EQU * APIN2636 LDD GTPMS APIN2637 STD L GTSPL+2 APIN2638 SRA 16 INDICATE BUFFER APIN2639 STO I GTSPL+3 APIN2640 BSC I STGSP APIN2641 HDNG EDIT HEADER LINE APIN2642 * APIN2643 * APIN2644 * APIN2645 EDHLN DC 0 APIN2646 LDX 2 2 APIN2647 STX L2 PARAD EXPECT LEFT ARGUMENT APIN2648 SLT 32 INDICATE NO LOCALS YET APIN2649 LDX L1 EXPRS APIN2650 STD 1 0 EXPLICIT RESULT APIN2651 STD 1 2 LEFT ARGUMENT APIN2652 STD 1 4 FUNCTION APIN2653 STD 1 6 RIGHT ARGUMENT APIN2654 LDX L1 MTCLN OUTPUT METACOLON AND APIN2655 STD 1 LOCSW-MTCLN APIN2656 STO 1 LOCCT-MTCLN APIN2657 BSI L BMITC DEL CHARACTERS APIN2658 LDX L1 DELCH TO DISK APIN2659 EDH01 BSI L BMITC NEXT CHARACTER TO DISK APIN2660 LDX 3 1 INDICATE ID IS EXPECTED APIN2661 EDH02 STX 3 EXPCH SAVE EXPECTED INDICATOR APIN2662 BSI L NONBK GET NEXT NON BLANK APIN2663 MDX EDH13 BRANCH IF END LINE APIN2664 A ALTST IF NOT, CHECK FOR ALPHA APIN2665 STO SVCHA SAVE CHARACTER ANYWAY APIN2666 BSC L EDH05,+Z BRANCH IF ALPHA APIN2667 LDX L1 CHAR ADDRESS OF CHARACTER APIN2668 LD EXPCH SYNTAX ERROR IF NOT ALPH APIN2669 BSC L FNERR,-Z AND ID WAS EXPECTED APIN2670 LD SVCHA IS THIS A APIN2671 S SMCTS SEMI-COLON APIN2672 BSC L EDH03,Z BRANCH IF NOT APIN2673 LD LOCSW CHECK FOR FIRST LOCAL APIN2674 BSC L EDH01,Z GET NEXT LOCAL IF NOT APIN2675 LDX 2 8 INDICATE LOCALS FROM APIN2676 STX 2 LOCSW NOW ON APIN2677 STX 2 PARAD SET PARAMETER ADDRESS APIN2678 MDX EDH01 SEMICOLON APIN2679 EDH03 BSI L DELCK CHECK FOR FUNCTION CLOSE APIN2680 LD LTERM GO SET UP ARGUMENTS APIN2681 BSC L EDH14,+- IF YES APIN2682 LD PARCT APIN2683 S H1 PARAMETERS,READ. APIN2684 BSC L FNERR,Z CAN ONLY BE ONE APIN2685 LD SVCHA APIN2686 EDH04 S LARTS IS THIS LEFT ARROW APIN2687 BSC L EDH14,Z APIN2688 LDD L LARG IF YES, PRECEDING APIN2689 STD L EXPRS PARAMETER WAS THE APIN2690 SLT 32 EXPLICIT RESULT, AND NOT APIN2691 STD L LARG AN ARGUMENT APIN2692 MDX L PARAD,-2 REDUCE PARAMETER ADDRESS APIN2693 MDX EDH01 ARROW TO DISK APIN2694 EDH05 LD EXPCH SYNTAX ERROR IF APIN2695 BSC L FNERR,+Z TERMINATOR EXPECTED APIN2696 LD SVCHA GET CHARACTER APIN2697 BSI L BSIDN BUILD STORE IDENTIFIER APIN2698 EDH06 LDX L2 EXPRS-2 INITIALISE SEARCH TO SEE APIN2699 LDX I3 PARCT IF PREDEFINED ID APIN2700 MDX 3 1 GO CHECK THIS ID IS APIN2701 MDX EDH08 UNIQUE APIN2702 EDH07 MDX 2 2 GET NEXT ID APIN2703 LDD 2 0 FROM LIST APIN2704 BSC L EDH07,+- IGNORE IF ZERO APIN2705 SD L IDENT COMPARE WITH LATEST ID APIN2706 BSC L EDH08,Z BRANCH IF 1ST WORDS DIFF APIN2707 SLT 16 CHECK 2ND WORDS APIN2708 BSC L FNERR,+- ERROR IF SAME ID APIN2709 EDH08 MDX 3 -1 DIFFERENT IDS, COUNT APIN2710 MDX EDH07 CONTINUE IF NOT APIN2711 MDX EDH09 PARMS. BRANCH IF END APIN2712 FNCLS DC /C000 APIN2713 DC /E000 APIN2714 DC /E000 APIN2715 * APIN2716 * APIN2717 BSS E 0 APIN2718 DC 0 APIN2719 DC /00FF APIN2720 CLASS DC 0 APIN2721 SVCHA DC 0 APIN2722 DC 0 APIN2723 LOCCT DC 0 APIN2724 ALTST DC /78-/1B APIN2725 SMCTS DC /57-/1B SEMI-COLON TEST APIN2726 LARTS DC /28-/1B APIN2727 LARCH DC /28 LEFT-ARROW CHARACTER APIN2728 H1 DC 1 APIN2729 LOCSW BSS E 1 APIN2730 PARCT DC 0 APIN2731 PARAD DC 0 APIN2732 EXPCH DC 0 APIN2733 SMCLN DC /57 APIN2734 * APIN2735 * APIN2736 EDH09 LD LOCSW BRANCH IF ID IS A APIN2737 BSC L EDH10,Z LOCAL APIN2738 LD L RARG ERROR IF RIGHT ARGUMENT APIN2739 BSC L FNERR,Z FOUND APIN2740 LDX 3 0 INDICATE ANYTHING CAN BE APIN2741 MDX EDH11 EXPECTED APIN2742 EDH10 MDX L LOCCT,1 A LOCAL. ADVANCE COUNT APIN2743 LDX 3 -1 TERMINATOR REQUIRED APIN2744 EDH11 LDD L IDENT APIN2745 LDX I2 PARAD STORE ID APIN2746 STD L2 EXPRS IN LIST OF ARGS AND LOCALS APIN2747 MDX L PARAD,2 ADVANCE PARAMETER ADDR APIN2748 MDX L PARCT,1 COUNT PARAMETERS APIN2749 MDX EDH02 GET NEXT APIN2750 * APIN2751 EDH13 LD EXPCH END OF LINE. ERROR IF APIN2752 BSC L FNERR,-Z ID EXPECTED APIN2753 LDX 3 -1 INDICATE END OF LINE APIN2754 STX L3 LTERM TERMINATION APIN2755 EDH14 LDX L1 LARG APIN2756 LD 1 0 ERROR IF NO APIN2757 BSC L FNERR,+- ARGUMENT APIN2758 LDX 3 0 ASSUME NO ARGUMENTS APIN2759 LD 1 2 BRANCH IF NO APIN2760 BSC L EDH15,+- FUNCTION APIN2761 LDX 3 2 ASSUME TWO ARGUMENTS APIN2762 LD 1 4 EXIT IF RIGHT ARGUMENT APIN2763 BSC L EDH16,Z PRESENT APIN2764 LDX 3 1 ONE ARGUMENT ONLY APIN2765 LDD 1 2 TRANSFER ID AT FUNCTION APIN2766 STD 1 4 TO RIGHT ARGUMENT APIN2767 EDH15 LDD 1 0 TRANSFER ID AT LEFT APIN2768 STD 1 2 ARGUMENT TO FUNCTION APIN2769 SLT 32 ZERO OUT APIN2770 STD 1 0 LEFT ARGUMENT APIN2771 EDH16 STX 3 PARAD SAVE NUMBER OF ARGUMENTS APIN2772 LD L3 FNCLS SET CLASS ACCORDING TO APIN2773 STO CLASS NUMBER OF ARGUMENTS APIN2774 * APIN2775 BSI L BMTNL OUTPUT NULL CHARACTER TO APIN2776 BSC I EDHLN DISK IF NECESSARY APIN2777 * APIN2778 HDNG ROUTINE TO EDIT 8 STORE LINE APIN2779 * APIN2780 ESLIN DC 0 APIN2781 SRA 16 ZERO OUT LABEL COUNT APIN2782 STO LABCT AND LINE SWITCHES APIN2783 STO LINSW FOR THIS LINE APIN2784 LDX L1 MTCLN OUTPUT METACOLON TO APIN2785 BSI L BMITC DISK APIN2786 ESL01 SRA 16 APIN2787 STO NUMCT ZERO OUT NUMBER COUNT APIN2788 ESL02 SRA 16 ZERO OUT NUMBER STRING APIN2789 STO NSTRG APIN2790 BSI L NONBK GET NEXT NON BLANK APIN2791 MDX ESL20 EXIT IF END OF LINE APIN2792 A BL RESTORE CHARACTER APIN2793 ESL03 S HNMTS BRANCH APIN2794 BSC L ESL04,- BRANCH IF NOT ALPHNUMERICAPIN2795 S LNMTS A APIN2796 BSC L ESL08,+Z BRANCH IF ALPHABETIC APIN2797 BSI L BSNUM BUILD/STORE NUMBER APIN2798 LD H8000 APIN2799 STO LINSW APIN2800 MDX ESL02 APIN2801 * APIN2802 * APIN2803 * APIN2804 ESL04 S MINTS IS THIS A HI-MINUS APIN2805 BSC L ESL05,Z BRANCH IF NOT APIN2806 LD NSTRG IF YES, ERROR IF PREV. APIN2807 BSC L SYNER,Z CHARACTER HI-MINUS OR APIN2808 LD H8000 PERIOD. APIN2809 MDX ESL06 INDICATE HI-MINUS APIN2810 * APIN2811 ESL05 S PERTS NOT HI-MINUS. BRANCH IF APIN2812 BSC L ESL08,Z NOT A PERIOD APIN2813 LD NSTRG ERROR IF PREVIOUS APIN2814 SLA 1 CHARACTER WAS ALSO APIN2815 BSC L SYNER,+Z A PERIOD APIN2816 LD H4000 INDICATE PERIOD READ APIN2817 * APIN2818 ESL06 OR NSTRG SAVE INDICATOR APIN2819 STO NSTRG APIN2820 LD H8000 INDICATE LINE APIN2821 STO LINSW STARTED APIN2822 BSI L GETCH GET NEXT CHARACTER APIN2823 MDX ESL07 ERROR IF END OF LINE APIN2824 MDX ESL03 CONTINUE EDIT APIN2825 BL DC /78 APIN2826 LABCT DC 0 APIN2827 LINSW DC 0 APIN2828 NUMCT DC 0 APIN2829 * APIN2830 MTCLN DC /62 APIN2831 MINTS DC /49-/25 APIN2832 PERTS DC /2C-/49 APIN2833 PERCH DC /2C APIN2834 COLTS DC /58 APIN2835 ALPTS DC /1B-/58 APIN2836 QTETS DC /37-/1B APIN2837 H8000 DC /8000 APIN2838 * APIN2839 * APIN2840 * APIN2841 * APIN2842 * APIN2843 ESL07 BSC L SYNER APIN2844 * APIN2845 * APIN2846 ESL08 LDX L3 BMITC APIN2847 BSI 3 BMITN-BMITC APIN2848 * NUMBER COUNT AND APIN2849 * SYLLABLE OUTPUT TO DISK APIN2850 * IF ANY NUMBERS READ APIN2851 LD NSTRG ERROR IF PREVIOUS APIN2852 BSC L SYNER,+Z CHARACTER IS HI-MINUS APIN2853 * APIN2854 BSC L ESL09,+ BRANCH IF PREVIOUS CHAR APIN2855 * NOT A PERIOD APIN2856 LDX L1 PERCH OUTPUT PERIOD TO APIN2857 BSI 3 BMITC-BMITC APIN2858 * APIN2859 ESL09 LD L CHAR IS THIS CHARACTER APIN2860 S COLTS A COLON APIN2861 BSC L ESL12,Z BRANCH IF NOT APIN2862 LD LINSW IS THIS START OF LINE APIN2863 BSC L SYNER,+ APIN2864 * APIN2865 LD L MODE ERROR IF LABEL OCCURS APIN2866 BSC L SYNER,- WHEN NOT IN FN DEFN MODE APIN2867 MDX L LABCT,2 ADVANCE LABEL COUNT APIN2868 LDX I1 LABCT GET LABEL COUNT APIN2869 MDX ESL11 GO CHECK LABELS APIN2870 * APIN2871 ESL10 LDD 3 IDENT-BMITC APIN2872 SD L1 LABLS-2 NEXT LABEL APIN2873 BSC L ESL11,Z CONTINUE CHECK APIN2874 SLT 16 IF DIFFERENT APIN2875 BSC L SYNER,+- SYNTAX ERROR IF SAME APIN2876 ESL11 MDX 1 -2 EXIT IF LAST LABEL APIN2877 MDX ESL10 CONTINUE CHECK IF NOT APIN2878 * APIN2879 LDX I1 LABCT SAVE IDENTIFIER APIN2880 LDD 3 IDENT-BMITC APIN2881 STD L1 LABLS-2 LIST APIN2882 * APIN2883 ESL21 LDX L1 CHAR OUTPUT COLON TO APIN2884 BSI 3 BMITC-BMITC APIN2885 SRA 16 INDICATE LINE HAS NOT APIN2886 STO LINSW YET STARTED APIN2887 MDX ESL02 CONTINUE EDIT APIN2888 * APIN2889 * APIN2890 ESL12 S ALPTS IS THIS ALPHABETIC APIN2891 BSC L ESL13,- BRANCH IF NOT APIN2892 BSI 3 BSIDN-BMITC APIN2893 LD LINSW BRANCH IF LINE STARTED APIN2894 BSC L ESL16,Z OR IF PRECEDED BY AN ID APIN2895 LD H4000 INDICATE ID READ APIN2896 MDX ESL17 GO SAVE INDICATOR APIN2897 * APIN2898 ESL13 S QTETS IS THIS QUOTE APIN2899 BSC L ESL14,Z BRANCH IF NOT APIN2900 BSI 3 BLSCS-BMITC APIN2901 MDX ESL16 STRING AND GO INDICATE APIN2902 * LINE STARTED APIN2903 ESL20 MDX ESL18 APIN2904 H4000 DC /4000 APIN2905 NSTRG DC 0 APIN2906 LNMTS DC /1B-/25 APIN2907 HNMTS DC /25 APIN2908 ESL14 BSI L DELCK CHECK FOR CLOSE FUNCTION APIN2909 LD L LTERM DID IT OCCUR APIN2910 BSC L ESL19,+- BRANCH IF YES APIN2911 * APIN2912 ESL15 LDX L1 CHAR OUTPUT CHARACTER TO APIN2913 BSI 3 BMITC-BMITC APIN2914 * APIN2915 ESL16 LD H8000 INDICATE LINE STARTED APIN2916 ESL17 STO LINSW SAVE LINE STATUS APIN2917 BSC L ESL01 APIN2918 ESL18 LD H8000 INDICATE END OF APIN2919 STO L LTERM LINE TERMINATION APIN2920 BSI L BMITN ENSURE NUMBER COUNT APIN2921 * AND SYLLABLE OUTPUT TO APIN2922 * DISK IF ANY NUMBERS READ APIN2923 ESL19 BSI L BMTNL BEMIT NULL CHARACTER APIN2924 * IF NECESSARY APIN2925 * APIN2926 * APIN2927 BSC I ESLIN EXIT APIN2928 * APIN2929 * APIN2930 NXDIG BSS E 2 APIN2931 NXNUM BSS E 2 APIN2932 H2000 DC /2000 APIN2933 PRDTS DC /2C-/25 APIN2934 EEETS DC /05-/1B APIN2935 NEGTS DC /49 APIN2936 POSTS DC /26-/49 APIN2937 NINTS DC /25-/49 APIN2938 H1000 DC /1000 APIN2939 HDNG BUILD/STORE NUMBER APIN2940 * APIN2941 BSNUM DC 0 APIN2942 SRT 16 SAVE APIN2943 STD NXDIG DIGIT APIN2944 LDX L2 LOCOR BASE ADDRESS APIN2945 LDX L3 GETCH APIN2946 SLT 32 ZERO OUT SIGN WORD APIN2947 STD 2 2 DEC PLACES CNT APIN2948 STO 2 4 EXPONENT APIN2949 STD 2 6 MANTISSA APIN2950 * APIN2951 * APIN2952 * APIN2953 * APIN2954 * APIN2955 * APIN2956 LD NSTRG WAS HI-MINUS READ APIN2957 BSC L BSN01,- BRANCH IF NOT APIN2958 LD L HFFFF COMING UP APIN2959 STO 2 2 COMING UP APIN2960 * APIN2961 * APIN2962 BSN01 LD NSTRG HAS A PERIOD APIN2963 SLA 1 BEEN READ APIN2964 BSC L BSN02,- BRANCH IF YES APIN2965 MDX L LOCOR+3,1 ADVANCE COUNT OF APIN2966 NOP APIN2967 * DECIMAL PLACES APIN2968 BSN02 SLA 1 HAS SIGNIFICANCE BEEN APIN2969 BSC L BSN04,+Z EXCEEDED. BRANCH IF YES APIN2970 * APIN2971 LDS 0 APIN2972 LDD 2 6 IF NOT, MULTIPLY APIN2973 AD 2 6 APIN2974 AD 2 6 APIN2975 STD NXNUM APIN2976 AD NXNUM APIN2977 AD NXNUM APIN2978 AD 2 6 APIN2979 AD NXDIG ADD IN NEXT DIGIT APIN2980 BSC L BSN03,O APIN2981 STD 2 6 EXCEEDED. SAVE NUMBER & APIN2982 MDX BSN05 GO GET NEXT CHARACTER APIN2983 * APIN2984 BSN03 LD NSTRG INDICATE APIN2985 OR H2000 SIGNIFICANCE APIN2986 STO NSTRG HAS BEEN EXCEEDED APIN2987 * APIN2988 BSN04 MDX L LOCOR+3,-1 REDUCE DECIMAL PLACE APIN2989 NOP APIN2990 * COUNT APIN2991 * APIN2992 * APIN2993 BSN05 BSI 3 GETCH-GETCH APIN2994 MDX BSN14 BRANCH IF END OF LINE APIN2995 S HNMTS BRANCH IF APIN2996 BSC L BSN06,- SPECIAL CHARACTER APIN2997 S LNMTS BRANCH IF APIN2998 BSC L BSN07,+Z ALPHABETIC APIN2999 SRT 16 NUMBER - SAVE APIN3000 STD NXDIG DIGIT APIN3001 MDX BSN01 GO TO BUILD MANTISSA APIN3002 * APIN3003 BSN06 S PRDTS IS THIS A PERIOD APIN3004 BSC L BSN13,Z END OF NUMBER IF NOT APIN3005 LD NSTRG ERROR IF APIN3006 SLA 1 PERIOD HAS OCCURRED APIN3007 BSC L SYNER,+Z BEFORE APIN3008 LD NSTRG INDICATE APIN3009 OR H4000 DECIMAL POINT APIN3010 STO NSTRG HAS OCCURRED APIN3011 * APIN3012 MDX BSN05 GO GET NEXT CHARACTER APIN3013 BSN07 S EEETS ALPHABETIC - END OF APIN3014 BSC L BSN13,Z NUMBER IF NOT E APIN3015 * APIN3016 * APIN3017 * APIN3018 BSI 3 GETCH-GETCH APIN3019 MDX BSN16 SYNTAX ERROR IF LINE END APIN3020 * APIN3021 S NEGTS IS THIS MINUS SIGN APIN3022 BSC L BSN10,Z BRANCH IF NOT APIN3023 LD NSTRG INDICATE -VE APIN3024 OR H1000 EXPONENT APIN3025 STO NSTRG IF YES APIN3026 BSN09 BSI 3 GETCH-GETCH APIN3027 MDX BSN16 SYNTAX ERROR IF LINE END APIN3028 S NEGTS FOR CONSISITENCY APIN3029 * APIN3030 BSN10 S NINTS IS THIS A SPECIAL CHAR. APIN3031 BSC L SYNER,- SYNTAX ERROR IF YES APIN3032 S LNMTS IS THIS ALPHABETIC APIN3033 BSC L SYNER,+Z SYNTAX ERROR IF YES APIN3034 MDX BSN12 GO BUILD EXPONENT APIN3035 * APIN3036 * APIN3037 * APIN3038 BSN11 BSI 3 GETCH-GETCH APIN3039 MDX BSN14 END OF NUMBER IF END OF APIN3040 * LINE APIN3041 S HNMTS APIN3042 BSC L BSN13,- OF NUMBER APIN3043 S L LNMTS APIN3044 BSC L BSN13,+Z NOT A DIGIT APIN3045 * APIN3046 SRT 16 APIN3047 STD NXDIG APIN3048 LD 2 4 MULTIPLY EXISTING APIN3049 M D0010 APIN3050 AD NXDIG APIN3051 BSC L DOMER,Z APIN3052 SLT 16 APIN3053 BSN12 STO 2 4 SAVE EXPONENT APIN3054 MDX BSN11 GO GET NEXT CHARACTER APIN3055 BSN13 MDX L R14,1 SKIP BACK ONE CHARACTER APIN3056 * (NOT END OF LINE) APIN3057 BSN14 LDD 2 6 TRANSFER APIN3058 STO 2 7 MANTISSA TO LOCATIONS APIN3059 SLT 16 FOR INPUT APIN3060 STO 2 8 CONVERSION APIN3061 BSC L BSN18,Z APIN3062 LD 2 7 APIN3063 BSC L BSN17,+- APIN3064 BSN18 LD L NSTRG APIN3065 SLA 3 NEGATIVE SIGN APIN3066 BSC L BSN15,- BRANCH IF NOT APIN3067 SRA 16 SET EXPONENT APIN3068 S 2 4 NEGATIVE APIN3069 STO 2 4 IF YES APIN3070 * APIN3071 BSN15 LDX L1 LOCOR CONVERT NUMBER TO APIN3072 BSI L ICONV FLOATING POINT APIN3073 * APIN3074 BSN17 LDX L1 LOCOR+7 APIN3075 LDX 2 2 APIN3076 BSI L BMTNW APIN3077 * APIN3078 MDX L NUMCT,1 ADVANCE COUNT OF NUMBERS APIN3079 BSC I BSNUM EXIT APIN3080 * APIN3081 BSN16 BSC L SYNER SYNTAX ERROR APIN3082 D0010 DC 10 APIN3083 HDNG BUILD/STORE CHARACTER STRING APIN3084 * APIN3085 BLSCS DC 0 APIN3086 * APIN3087 * APIN3088 * APIN3089 SRA 16 SET CHAR COUNT TO ZERO APIN3090 STO L NUMCT APIN3091 BLS01 BSI L GETCH GET CHARACTER APIN3092 MDX BSN16 APIN3093 * APIN3094 S QTECH BRANCH TO STORE IF APIN3095 BSC L BLS02,Z NOT A QUOTE APIN3096 * APIN3097 BSI L GETCH GET NEXT CHARACTER APIN3098 MDX BLS04 EXIT IF LINE END APIN3099 S QTECH EXIT IF NOT APIN3100 BSC L BLS03,Z A QUOTE APIN3101 * APIN3102 BLS02 A QTECH RESTORE CHARACTER APIN3103 BSI BCNDK CHARCTER IN NO9 FORM TO DAPIN3104 MDX BLS01 CONTINUE BUILDING APIN3105 * APIN3106 BLS03 MDX L R14,1 SKIP BACK ONE CHARACTER APIN3107 * APIN3108 BLS04 BSI BMCCN CHARACTER COUNT TO DISK APIN3109 * APIN3110 BSC I BLSCS EXIT APIN3111 * APIN3112 * APIN3113 * APIN3114 QTECH DC /37 APIN3115 * APIN3116 BCNDK DC 0 APIN3117 LDX L1 CHAR APIN3118 BSI BMITC APIN3119 MDX L NUMCT,1 INCREMENT COUNT OF CHARS APIN3120 BSC I BCNDK APIN3121 HDNG BUILD QUAD PRIME CHARACTER STRING APIN3122 * APIN3123 BLQPM DC 0 APIN3124 * APIN3125 SRA 16 ZERO OUT APIN3126 LDX L1 MTCLN METACOLON TO APIN3127 STO 1 NUMCT-MTCLN APIN3128 BSI BMITC DISK APIN3129 * APIN3130 BLQ01 BSI L GETCH GET NEXT CHARACTER APIN3131 MDX BLQ02 EXIT AT LINE END APIN3132 BSI BCNDK CHARCTER IN NO9 FORM TO DAPIN3133 MDX BLQ01 CONTINUE APIN3134 * APIN3135 BLQ02 BSI BMCCN CHARACTER COUNT TO DISK APIN3136 BSI BMTNL APIN3137 * APIN3138 BSC I BLQPM EXIT APIN3139 * APIN3140 BMCCN DC 0 APIN3141 LDX L1 NUMCT APIN3142 BSI BMITC APIN3143 LDX L1 CSSYL OUTPUT SYLLABLE TO APIN3144 BSI BMITC APIN3145 BSC I BMCCN APIN3146 CSSYL DC /24 APIN3147 * APIN3148 * APIN3149 HDNG BUILD/STORE IDENTIFIER APIN3150 * APIN3151 BSIDN DC 0 APIN3152 BSI BLDID BUILD IDENTIFIER APIN3153 BSI01 LDX L1 IDENT IF NOT. OUTPUT IDENT APIN3154 LD 1 0 IS THIS SINGLE CHARACTER APIN3155 AND HFFE0 ID APIN3156 BSC L BSI02,+- BRANCH IF YES APIN3157 LDX 2 2 APIN3158 MDX 1 1 APIN3159 BSI BMTNW APIN3160 BSI02 BSI BMITC ID SYLLABLE TO ISK APIN3161 BSC I BSIDN EXIT APIN3162 * APIN3163 HFFE0 DC /FFE0 APIN3164 * APIN3165 * APIN3166 * BUILD 6 CHARACTER IDENTIFIER APIN3167 * X2,X3 DESTROYED, X1 UPDATED APIN3168 BLDID DC 0 APIN3169 LDX 1 -2 TWO WORDS FOR ID APIN3170 A ALCHR RESTORE CHARACTER APIN3171 STO IDENT SAVE IN FIRST WORD APIN3172 SRA 16 ZERO OUT APIN3173 STO IDENT+1 SECOND IDENTIFIER WORD APIN3174 LDX 2 3 ALLOW 3 CHARS PER WORD APIN3175 MDX BLD03 BRANCH TO GET CHARACTER APIN3176 BLD01 STO CHARX SAVE THIS CHARACTER APIN3177 LD L1 IDENT+2 GET CURRENT WORD APIN3178 M FORTY MULTIPLY CONTENTS APIN3179 SLT 16 BY FORTY APIN3180 A CHARX ADD IN CHARACTER APIN3181 BLD02 STO L1 IDENT+2 SAVE CURRENT WORD APIN3182 BLD03 BSI L GETCH GET NEXT CHARACTER APIN3183 MDX BLDXT EXIT IF END OF STATEMENT APIN3184 S NMTST IS THIS ALPHANUMERIC APIN3185 BSC L BLD04,- IF NOT, EXIT AT RETURN+1 APIN3186 A NMTST RESTORE CHARACTER APIN3187 MDX 2 -1 COUNT CHARACTERS PER WD APIN3188 MDX BLD01 BUILD IDENTIFIER WORD APIN3189 LDX 2 3 SET 3 CHARS FOR NEXT WD APIN3190 MDX 1 1 COUNT IDENTIFIER WORDS APIN3191 MDX BLD02 SAVE CHARACTER APIN3192 BSC L IDERR APIN3193 BLD04 MDX L R14,1 STEP BACK ONE CHARACTER APIN3194 BLDXT BSC I BLDID EXIT APIN3195 BSS E 0 APIN3196 NMTST DC /25 APIN3197 IDSYL DC /22 APIN3198 IDENT BSS E 2 APIN3199 FORTY DC 40 APIN3200 ALCHR DC /1B APIN3201 CHARX EQU * APIN3202 HDNG DISK OUTPUT ROUTINES APIN3203 * PUT SYLLABLE TO DISK APIN3204 * APIN3205 BMITC DC 0 APIN3206 STX L1 PTSPL APIN3207 LDX L1 PTSPL APIN3208 BSI L PSYL APIN3209 BSC I BMITC APIN3210 * OUTPUT N WORDS TO DISK APIN3211 * X1 CONTAINS ADDRESS OF LAST WORD APIN3212 * X2 CONTAINS COUNT APIN3213 BMTNW DC 0 APIN3214 STX 1 BMT01+1 SAVE APIN3215 STX 2 BMT02 REGISTERS APIN3216 * APIN3217 BMT01 LD L *-* GET NEXT WORD APIN3218 AND H00FF APIN3219 LDX L1 CHAR ADDRESS OF CHARACTER APIN3220 STO 1 0 STORE CHARACTER APIN3221 BSI BMITC OUTPUT TO DISK APIN3222 LD I BMT01+1 GET WORD AGAIN APIN3223 SRA 8 ISOLATE TOP BYTE APIN3224 LDX L1 CHAR ADDRESS OF CHARACTER APIN3225 STO 1 0 STORE CHARACTER APIN3226 BSI BMITC OUTPUT TO DISK APIN3227 MDX L BMT01+1,-1 ADJUST ADDRESS OF WORD APIN3228 MDX L BMT02,-1 COUNT WORDS APIN3229 MDX BMT01 CONTINUE IF MORE APIN3230 * APIN3231 LDX I1 BMT01+1 RESTORE UPDATED ADDRESS APIN3232 BSC I BMTNW EXIT APIN3233 BMT02 DC 0 APIN3234 H00FF DC /00FF APIN3235 * APIN3236 * OUTPUT NUMBER STRING COUNT TO DISK APIN3237 BMITN DC 0 APIN3238 LDX L1 NUMCT GET NUMBER APIN3239 LD 1 0 COUNT APIN3240 BSC I BMITN,+- EXIT IF NONE READ APIN3241 BSI BMITC OUTPUT NUMBER COUNT APIN3242 LDX L1 CNSYL AND CONSTANT SYLLABLE APIN3243 BSI BMITC TO DISK APIN3244 BSC I BMITN EXIT APIN3245 * APIN3246 CNSYL DC /23 APIN3247 * APIN3248 * OUTPUT NULL SYLLABLE TO DISK IF REQD APIN3249 BMTNL DC 0 APIN3250 LD L STUAD APIN3251 BSC I BMTNL,- APIN3252 LDX L1 NULCH APIN3253 BSI BMITC APIN3254 BSC I BMTNL APIN3255 * APIN3256 NULCH DC 0 APIN3257 HDNG UPDATE LINE NUMBER APIN3258 * X1=ADDRESS OF LINE NUMBER APIN3259 NINCK EQU BMITC APIN3260 UPCUR DC 0 APIN3261 SRA 16 APIN3262 STO NINCK APIN3263 LDD D01 APIN3264 STD ADVAL APIN3265 LD 1 0 GET LINE NUMBER IN FORM APIN3266 SRT 16 TU.DH APIN3267 UPC01 RTE 4 GET NEXT DIGIT APIN3268 SRA 12 IS IT ZERO APIN3269 BSC L UPC02,Z BRANCH IF NOT APIN3270 LD ADVAL IS THIS 'UNIT' APIN3271 S H100 DIGIT APIN3272 BSC L UPC05,- APIN3273 LD NINCK APIN3274 BSC L UPC05,Z APIN3275 MDX UPC04 CONTINUE IF NOT APIN3276 UPC02 S D0009 IS THIS DIGIT NINE APIN3277 BSC L UPC05,Z GO TO UPDATE IF NOT APIN3278 LD ADVAL IS THIS 'TEN' APIN3279 S X1000 DIGIT APIN3280 BSC L UPC03,Z CONTINUE IF NOT APIN3281 LD H100 GO TO RESET LINE TO APIN3282 MDX UPC06 01.00 IF NOT APIN3283 UPC03 LD 1 0 REMOVE NINE DIGIT APIN3284 S SBVAL FROM APIN3285 STO 1 0 LINE APIN3286 MDX L NINCK,1 APIN3287 UPC04 LD ADVAL ADJUST APIN3288 SLA 4 ADD APIN3289 STO ADVAL VALUE APIN3290 LD SBVAL ADJUST APIN3291 SLA 4 SUBTRACT APIN3292 STO SBVAL VALUE APIN3293 MDX UPC01 CONTINUE APIN3294 * APIN3295 * APIN3296 UPC05 LD 1 0 ADVANCE APIN3297 A ADVAL LINE COUNT APIN3298 UPC06 STO 1 0 SAVE LINE COUNT APIN3299 BSC I UPCUR EXIT APIN3300 * APIN3301 XFFFF DC /FFFF APIN3302 ADVAL BSS E 1 APIN3303 SBVAL DC 0 APIN3304 D01 DC 1 APIN3305 D0009 DC 9 APIN3306 H100 DC /100 APIN3307 X1000 DC /1000 APIN3308 HDNG OPEN NEW FUNCTION FOR DEFINITION APIN3309 * APIN3310 ONFDF DC 0 APIN3311 * APIN3312 LD L PARAD PLACE COUNT OF APIN3313 SLA 13 ARGUMENTS IN APIN3314 STO MNTRY+3 M ENTRY APIN3315 LDX L1 FNDPL ADDRESS OF PARAMETER APIN3316 LD AMNRY LIST. APIN3317 A L CLASS PUT M PTR AND CLASS IN APIN3318 STO 1 5 PARAMETER LIST APIN3319 BSI L FGBTB ACCUMULATOR APIN3320 LDS 3 GET SPACE FOR NEW APIN3321 LDX L1 LOCCT-5 FUNCTION DEFINITION APIN3322 BSI L GSFFD ENTRY APIN3323 STX L1 FNDPL+5 SAVE M PTR TO ENTRY APIN3324 LD AFNDP SAVE SYPTR IN FN DEF APIN3325 STO 1 0 ENTRY APIN3326 LD H100 SET LINE NUMBER TO ONE APIN3327 STO 1 3 LABEL COUNT TO ZERO APIN3328 SRA 16 SET LINE COUNT, CURRENT APIN3329 STO 1 2 LINE NUMBER AND APIN3330 STO 1 4 APIN3331 * APIN3332 BSI L STCAR APIN3333 * APIN3334 LDX 1 -1 APIN3335 STX L1 MODE APIN3336 * APIN3337 BSC I ONFDF APIN3338 * APIN3339 * APIN3340 * APIN3341 * APIN3342 MNTRY BSS E 0 APIN3343 DC 0 APIN3344 DC /0101 APIN3345 DC 0 APIN3346 DC 0 APIN3347 AFNDP DC FNDPL+5 APIN3348 AMNRY DC MNTRY-/1000 APIN3349 HDNG OPEN OLD FUNCTION FOR DEFINITION APIN3350 * APIN3351 FNLCT EQU BMTNL APIN3352 OOFDF DC 0 APIN3353 * APIN3354 LD I FNDPL+4 GET M POINTER OF GLOBAL APIN3355 * ENTRY APIN3356 BSI L ABSAD CONVERT ADDRESS APIN3357 * APIN3358 LD 1 3 FROM FUNCTION M ENTRY APIN3359 AND H00FF APIN3360 STO FNLCT APIN3361 * APIN3362 LDX L1 LDRPL LOAD FUNCTION APIN3363 BSI L LFNDR DIRECTORIES APIN3364 LD 1 1 SAVE M POINTER IN APIN3365 STO L 2 SYPTR TO FUNCTION APIN3366 MDX 2 -2 DEFINITION APIN3367 STX L2 FNDPL+5 APIN3368 LD AFNDP SAVE SYPTR IN APIN3369 STO 2 0 M ENTRY APIN3370 * APIN3371 LDX 1 -2 SWITCH TO FUNCTION RE- APIN3372 STX L1 MODE DEFINITION MODE APIN3373 * APIN3374 BSC I OOFDF APIN3375 * APIN3376 LDRPL BSS E 0 APIN3377 DC LINDR APIN3378 DC 0 APIN3379 DC 0 APIN3380 DC FNLCT APIN3381 * APIN3382 SDRPL BSS E 0 APIN3383 DC LINDR APIN3384 DC 0 APIN3385 DC 0 APIN3386 DC FNLCT APIN3387 HDNG CLOSE FUNCTION DEFINITION APIN3388 STLOK DC 0 APIN3389 LD I FNDPL+4 MPTR TO FUNCTION APIN3390 * M ENTRY FROM GLOBAL APIN3391 * ENTRY WHICH MAY BE APIN3392 * ASSUMED TO HAVE NOT BEEN APIN3393 * MOVED SINCE GLOBAL WAS APIN3394 * FOUND APIN3395 * APIN3396 BSI L ABSAD 1130 ADDRESS OF M PTR APIN3397 LD L CLOCK SET FOURTH WORD OF APIN3398 OR 1 3 FUNCTION M ENTRY TO APIN3399 STO 1 3 APIN3400 BSC I STLOK APIN3401 FNCLN EQU OOFDF APIN3402 FNLBC EQU STLOK APIN3403 CLFDF DC 0 APIN3404 LDX I2 FNDPL+5 FN DEFN M ENTRY APIN3405 LD L LUNPD BRANCH IF NO UPDATE APIN3406 BSC L CLF05,+- SINCE FUNCTION WAS OPEND APIN3407 LD 2 4 BRANCH IF NO LABELS APIN3408 BSC L CLF04,+- TO BE UPDATED APIN3409 STO FNLBC STORE LABEL COUNT APIN3410 LD 2 5 ADDRESS OF LABEL APIN3411 A 2 5 DIRECTORY LESS 12 APIN3412 A L 2 APIN3413 STO L 3 APIN3414 CLF00 LD 2 2 SET COUNT OF LINES APIN3415 STO L FNLCT APIN3416 LDX L1 LINDR+LNGLD >TORE ADDRESS OF 1ST APIN3417 STX 1 CLF01+1 LINE NUMBER ENTRY APIN3418 SRA 16 ZERO OUT CURRENT LINE APIN3419 STO FNCLN NUMBER APIN3420 CLF01 LD L *-* DOES THIS LABEL BELONG APIN3421 S 3 12 THIS LINE APIN3422 BSC L CLF02,Z BRANCH IF NOT APIN3423 LD FNCLN SET CURRENT LINE NUMBER APIN3424 STO 3 12 IN LABEL ENTRY IF YES APIN3425 MDX CLF03 APIN3426 CLF02 MDX L CLF01+1,1 NEXT LINE NUMBER APIN3427 LDX L1 FNCLN IF NOT, UPDATE APIN3428 BSI L UPCUR CURRENT LINE NUMBER APIN3429 MDX L FNLCT,-1 COUNT LINES APIN3430 MDX CLF01 CONTINUE IF MORE APIN3431 * APIN3432 CLF03 MDX 3 3 ADVANCE TO NEXT ENTRY APIN3433 MDX L FNLBC,-1 COUNT LABELS APIN3434 MDX CLF00 CONTINUE IF MORE APIN3435 CLF04 MDX 2 2 SET UP PARAMETER LIST APIN3436 STX 2 SDRPL+1 FOR STORING APIN3437 LD 2 0 FUNCTION APIN3438 LDX L1 SDRPL STORE APIN3439 STO I1 3 LINE COUNT APIN3440 BSI SFNDR STORE DIRECTORIES APIN3441 * APIN3442 BSI STLOK SET LOCK IF DEL TILDE APIN3443 LD 1 3 ADD LINE COUNT APIN3444 AND HE000 INDICATE IF IT IS APIN3445 A L FNLCT LOCKED, COUNT OF APIN3446 STO 1 3 ARGUMENTS & LINE COUNT APIN3447 * APIN3448 LD L STUAD STORE CURRENT STUDENT APIN3449 STO 1 2 TRACK ADDRESS APIN3450 BSI L SNSOL APIN3451 * APIN3452 MDX CLF06 APIN3453 CLF05 BSI STLOK APIN3454 CLF06 LDX 2 -1 XET FNDEF MENTRY TO APIN3455 STX I2 FNDPL+5 GARBAGE APIN3456 * APIN3457 SRA 16 SWITCH TO IMMEDIATE APIN3458 STO L MODE EXECUTION APIN3459 * APIN3460 BSC I CLFDF EXIT APIN3461 HE000 DC /E000 APIN3462 HDNG STORE FUNCTION AND LINE DIRECTORIES APIN3463 * STORE LABEL AND LOCAL DIRECTORIES APIN3464 * X1 POINTS TO PARAMETER LIST WHICH APIN3465 * CONTAINS ADDRESS OF LINE DIRECTORY APIN3466 * ADDRESS OF OTHER DIRECTORY APIN3467 * ADDRESS OF DISK POINTER APIN3468 * COUNT OF LINES APIN3469 SFNDR DC 0 APIN3470 STX 1 SFN04+1 SAVE PARAMETER LIST APIN3471 * ADDRESS APIN3472 * APIN3473 SFN00 EQU * APIN3474 LDX I1 SFN04+1 APIN3475 LD 1 1 GET DIRECTORY ADDRESS APIN3476 STO L 2 APIN3477 STX 2 SFN01+1 SAVE DIRECTORY ADDRESS APIN3478 LD 2 3 GET LOCAL COUNT APIN3479 BSC L SFN01,+- BRANCH IF NONE APIN3480 A 2 3 LENGTH OF LOCAL DIRECT. APIN3481 STO L 1 GET ADDRESS OF APIN3482 MDX I1 2 APIN3483 MDX 1 9 DIRECTORY TO X1 APIN3484 STO L 2 DIRECTORY LENGTH TO X2 APIN3485 BSI L BMTNW DIRECTORY TO DISK APIN3486 * APIN3487 SFN01 LDX L2 *-* GET COUNT OF LABELS APIN3488 LD 2 2 APIN3489 * APIN3490 BSC L SFN03,+- BRANCH IF NONE APIN3491 A 2 2 SAVE APIN3492 A 2 2 LENGTH OF LABEL APIN3493 STO SFN02+1 DIRECTORY APIN3494 A 2 3 FORM ADDRESS OF LAST APIN3495 A 2 3 WORD OF LABEL APIN3496 STO L 1 DIRECTORY APIN3497 MDX I1 2 APIN3498 MDX 1 9 APIN3499 SFN02 LDX L2 *-* DIRECTORY LENGTH TO X2 APIN3500 BSI L BMTNW DIRECTORY TO DISK APIN3501 * APIN3502 SFN03 LDX I1 SFN01+1 ADDRESS OF LAST WORD APIN3503 MDX 1 9 APIN3504 LDX 2 8 OUTPUT IDS OF ARGUMENTS, APIN3505 BSI L BMTNW RESULT, AND COUNTS TO APIN3506 * DISK APIN3507 SFN04 LDX L1 *-* STORE LINE APIN3508 LD I1 3 GET COUNT OF APIN3509 STO L 2 LINES APIN3510 A 1 0 GET ADDRESS OF LAST APIN3511 STO L 1 ENTRY IN DIRECTORY APIN3512 MDX 1 -1 OUTPUT LINE DIRECTORY APIN3513 LD L GRBCL SAVE GARBAGE COLLECT APIN3514 STO GRBSW SWITCH SETTING APIN3515 BSI L BMTNW DISK ADDRESSES TO DISK APIN3516 LD L GRBCL EXIT IF GARBAGE COLLECT APIN3517 BSC I SFNDR,Z SWITCH SET, OR IF APIN3518 LD GRBSW CLEAR BEFORE LINE DIREC- APIN3519 BSC I SFNDR,+- WERE OUTPUT APIN3520 LD L SOLPT DISK GARBAGE COLLECTION HAPIN3521 STO L STUAD OCCURRED. REOUPUT LINE APIN3522 MDX SFN00 APIN3523 GRBSW DC 0 APIN3524 FNPTR DC 0 APIN3525 LGTH2 EQU *-ASMED APIN3526 HDNG SET UP CARD CODE INDEX AND CHAIN APIN3527 START STX 3 STA05+1 APIN3528 LDX 1 CCRAN APIN3529 SRA 16 INDEX APIN3530 STA01 STO L1 INDEX-1 AND APIN3531 STO L1 PSYNM-1 PREVIOUS APIN3532 MDX 1 -1 SYNONYM TABLES APIN3533 MDX STA01 APIN3534 LDX 2 NUMCC SAVE COUNT OF APIN3535 STX 2 COUNT CARD CODES APIN3536 LDX 1 1 FIRST CARD CODE APIN3537 STA02 LD L1 TABLE GET NEXT CARD CODE APIN3538 SRA 4 FORM APIN3539 SRT 16 SYNONYM APIN3540 D L CCSYN APIN3541 SLT 16 APIN3542 STO L 2 SAVE IT APIN3543 LD L2 PSYNM GET POINTER TO PREVIOUS APIN3544 STO L 3 SYNONYM APIN3545 LD L 1 PUT PINTER TO THIS CODE APIN3546 STO L2 PSYNM IN PREVIOUS SYNONYM APIN3547 STO L1 CHAIN APIN3548 LD L2 INDEX IS THIS FIRST SYNONYM APIN3549 BSC L STA03,Z BRANCH IF NOT APIN3550 LD L 1 INDICATE THI IS FIRST APIN3551 STO L2 INDEX CODE IN CHAIN APIN3552 MDX STA04 GO TO COUNT CODES APIN3553 STA03 LD L 1 APIN3554 SLA 8 SET UP CHAIN WHICH APIN3555 A L3 CHAIN CONTAINS POINTER TO PREVIOUSAPIN3556 STO L3 CHAIN SYNONYM AND ALC CODE APIN3557 STA04 MDX 1 1 ADVANCE TO NEXT CODE APIN3558 MDX L COUNT,-1 COUNT CODES APIN3559 MDX STA02 APIN3560 BLALC EQU /78-NUMCC APIN3561 MDX L CHAIN+NUMCC,BLALC APIN3562 STA05 LDX L3 *-* APIN3563 HDNG WRITE OVERLAYS TO DISK APIN3564 LDX L1 ASMIN-2 APIN3565 BSI DSKIO APIN3566 LDX L1 LOCOR+15 APIN3567 BSI DSKIO APIN3568 LDX L1 ASMED-2 APIN3569 BSI DSKIO APIN3570 EXIT APIN3571 DSKIO DC 0 APIN3572 STX 1 DSKI1 APIN3573 STX 1 DSKI3 APIN3574 LIBF DISK1 APIN3575 DC /3000 APIN3576 DSKI1 DC 0 APIN3577 DC DSKI4 APIN3578 DSKI2 LIBF DISK1 APIN3579 DC /0000 APIN3580 DSKI3 DC 0 APIN3581 MDX DSKI2 APIN3582 BSC I DSKIO APIN3583 DSKI4 WAIT APIN3584 BSC I DSKIO APIN3585 COUNT DC 0 APIN3586 PSYNM BSS E CCRAN APIN3587 END START APIN3588 // XEQ L 1 APIN3589 // JOB APIX0000 // ASM APIX0001 *LIST APIX0002 *PRINT SYMBOL TABLE APIX0003 HDNG PREPROLOGUE TO INDEXING/ASSIGNMENT APIX0004 ABS APIX0005 * DISK ADDRESSES APIX0006 LCDBS EQU /280 APIX0007 DAIDX EQU LCDBS+/62 APIX0008 * ORIGIN OF THIS AND OTHER ASSEMBLIES APIX0009 ASMIX EQU /18D1 APIX0010 ASMXQ EQU /730 APIX0011 ASMCT EQU /21E APIX0012 * OVERLAY NUMBER FOR THIS ASSEMBLY APIX0013 EOSOV EQU 36 APIX0014 * IMPORTANT ADDRESSES APIX0015 NEXEN EQU 5 APIX0016 EGBTB EQU NEXEN*4 APIX0017 LOCOR EQU /1000 APIX0018 LENGL EQU /1011 APIX0019 NUMGL EQU /1012 APIX0020 MSTRT EQU /1013 APIX0021 MNEXT EQU /1014 APIX0022 PAREL EQU /1017 APIX0023 GLSTB EQU /101C APIX0024 GLBTB EQU /1036 APIX0025 FNDPL EQU /1FEC APIX0026 FULST EQU /1FF7 APIX0027 * ADDRESSES IN CTRAY ASSEMBLY APIX0028 ERRXT EQU ASMCT+/37 APIX0029 ABSAD EQU ASMCT+/A8 APIX0030 CLOMN EQU ASMCT+/153 APIX0031 GETSP EQU ASMCT+/160 APIX0032 LCUFL EQU ASMCT+/306 APIX0033 * ADDRESSES IN STATEMENT EXECUTION ASSEMBLY APIX0034 NEXT EQU ASMXQ+/4D APIX0035 EFPE1 EQU ASMXQ+/AD APIX0036 SYNER EQU ASMXQ+/152 APIX0037 LNGER EQU ASMXQ+/15A APIX0038 RNKER EQU ASMXQ+/1AF APIX0039 * ADDRESSES USED IN OTHER ASSEMBLIES APIX0040 DC XQASS-ASMIX APIX0041 DC XQIND-ASMIX APIX0042 * LENGTH OF ASSEMBLY APIX0043 DC LNGTH APIX0044 HDNG ASSEMBLY ORIGIN APIX0045 ORG ASMIX-2 APIX0046 DC 2*/140 APIX0047 DC DAIDX APIX0048 DC EOSOV APIX0049 HDNG INDEXING ROUTINE APIX0050 XQASS BSC L SXQAS APIX0051 XQIND BSI L SETUP SET UP POINTERS ETC APIX0052 * APIX0053 * APIX0054 LDX 2 -1 INITIALISE DIMENSION CNT APIX0055 XQI01 MDX 2 1 ADVANCE DIMENSION COUNT APIX0056 NOP APIX0057 MDX 1 1 MOVE POINTER TO NEXT APIX0058 LD 1 0 SUBSCRIPT. APIX0059 BSC L XQI01,+- APIX0060 AND ZF000 APIX0061 BSC L XQI01,Z APIX0062 LD L 2 ERROR IF NO APIX0063 BSC L SYNER,+- DIMENSIONS APIX0064 LD 1 0 GET THE STATE APIX0065 STO STATE SAVE IT APIX0066 AND RARST CHECK FOR RIGHT ARROW APIX0067 BSC L SYNER,Z ERROR IF IT IS APIX0068 * APIX0069 LD 1 0 SET LEFT ARROW SWITCH APIX0070 AND LARST IF THIS IS ASSIGNMENT APIX0071 STO L LASW RATHER THAN INDEXING APIX0072 * APIX0073 MDX 1 -1 SAVE RIGHT MOST SEV APIX0074 STX 1 RMSEV ADDRESS APIX0075 STX 2 DMNSC SAVE COUNT OF DIMENSIONS APIX0076 LDD ODD1 INITIALISE DIMENSIONS APIX0077 STD XLSEV OF RESULT APIX0078 STO RHRHO INITIALISE LENGTH OF RES APIX0079 SRA 16 INITIALISE RANK OF APIX0080 STO RANKR RESULT APIX0081 * APIX0082 * APIX0083 LD I INDXE APIX0084 BSI L GTMPT APIX0085 LD 1 1 STORE RANK VECTOR APIX0086 STO INRKV+1 APIX0087 STX L1 MNTRI ADDRESS OF M-ENTRY FOR APIX0088 * INDEXEE APIX0089 LD 1 0 GET RENK OF APIX0090 SLA 2 INDEXEE APIX0091 SRA 14 APIX0092 S DMNSC ERROR IF RANK DOES NOT APIX0093 BSC L RNKER,Z WITH NUMBER OF SUBSCRIPTSAPIX0094 LDX 2 0 GET DIMENSIONS OF APIX0095 LDX I1 RMSEV RIGHT MOST SUBSCRIPT APIX0096 BSI GTDIM APIX0097 LDX I2 DMNSC GET COUNT OF DIMENSIONS APIX0098 MDX 2 -1 ARE THERE ANY MORE APIX0099 MDX XQI02 CONTINUE IF YES APIX0100 MDX XQI00 BRANCH IF ONE APIX0101 * APIX0102 XQI02 LD INRKV+1 USE LEFT HAND DIMENSION APIX0103 SRA 8 IF LEFT HAND SUBSCRIPT APIX0104 STO INRKV+1 OMITTED APIX0105 LDX I1 RMSEV GET DIMENSIONS OF APIX0106 MDX 1 -1 LEFT HAND SUBSCRIPT APIX0107 BSI GTDIM APIX0108 * APIX0109 * APIX0110 XQI00 LD D2 INITIALISE STEEPING APIX0111 STO STPSW SWITCH APIX0112 S RANKR ERROR IF RANK RESULT APIX0113 BSC L RNKER,+Z APIX0114 * APIX0115 LD L LASW IS THIS ASSIGNMENT APIX0116 BSC L XQI03,+- BRANCH IF NOT APIX0117 * APIX0118 LD I INDXE GET INDEXEE APIX0119 BSC L SYNER,- ERROR IF NOT VARIABLE APIX0120 * APIX0121 LDX I1 RMSEV GET RIGHT HAND SIDE APIX0122 LD 1 2 M-ENTRY ADDRESS APIX0123 BSI L GTMPT APIX0124 STX L1 MNTRR SAVE IT APIX0125 LD 1 1 GET RIGHT HAND SIDE APIX0126 BSI L GTLVR HAND SIDE APIX0127 S D1 SINGLE ELEMENT APIX0128 BSC L XQI20,+- OK IF SCALAR APIX0129 A D1 APIX0130 S RHRHO SAME LENGTH AS RESULT APIX0131 BSC L LNGER,Z ERROR IF NOT APIX0132 LD 1 0 GET RANK OF APIX0133 SLA 2 RIGHT HAND APIX0134 SRA 14 SIDE APIX0135 S RANKR IS IT SAME RANK AS RESLT APIX0136 BSC L RNKER,Z ERROR IF NOT APIX0137 MDX XQI21 APIX0138 * APIX0139 * APIX0140 * ALL CHECKING FOR ASSIGNMENT HAS BEEN DONE APIX0141 * EXCEPT FOR INDEX BOUNDS WHICH IS DONE IN APIX0142 * MOVE LOOP APIX0143 * APIX0144 XQI20 STO STPSW NO STEPPING FOR SCALAR APIX0145 XQI21 LD RMSEV NEW TOP OF STACK IS WHEREAPIX0146 A D2 WHERE RIGHT HAND SIDE APIX0147 STO L LOCOR+14 IS NOW APIX0148 * APIX0149 BSC L XQI12 APIX0150 * APIX0151 * PUT A FEW CONSTANTS HERE FOR ADDRESSING APIX0152 * APIX0153 * APIX0154 * APIX0155 RANKS DC 0 APIX0156 INRKV BSS E 0 APIX0157 D1 DC 1 APIX0158 DC 0 APIX0159 D2 DC 2 APIX0160 ODD1 DC 1 APIX0161 ZF000 DC /F000 APIX0162 LARST DC 32 APIX0163 RARST DC 4 APIX0164 * APIX0165 * APIX0166 STATE DC 0 APIX0167 DMNSC DC 0 APIX0168 RHRHO DC 0 APIX0169 RANKR DC 0 APIX0170 STPSW DC 0 APIX0171 * APIX0172 INDXE DC 0 APIX0173 RMSEV DC 0 APIX0174 * APIX0175 XESEV BSS E 2 APIX0176 XLSEV BSS E 2 APIX0177 XBOUN BSS E 2 APIX0178 XBADR BSS E 2 APIX0179 H00FF DC /00FF APIX0180 HDNG ROUTINE TO FORM DIMENSIONS OF RESULT APIX0181 * SUBROUTINE TO FORM DIMENSIONS OF RESULT APIX0182 * FOR NON ASSIGNMENT, AND DIMENSIONS OF APIX0183 * SUBSCRIPTS TO BE USED APIX0184 * X1 CONTAINS ADDRESS OF SUBSCRIPT EXPRESSION APIX0185 * X2 CONTAINS DIMENSION APIX0186 GTDIM DC 0 APIX0187 LD 1 0 GET SUBSCRIPT EXPRESSION APIX0188 STO L2 XBADR SAVE IT APIX0189 BSC L GTD01,+- BRANCH IF OMITTED SUBSC APIX0190 BSI L GTMPT APIX0191 LDD 1 0 RANK AND RHO VECTOR APIX0192 SLA 2 TO ACCUMULATOR APIX0193 SRA 14 AND EXTENSION APIX0194 MDX GTD02 APIX0195 * APIX0196 GTD01 LDD INRKV APIX0197 * OF INDEXEE IF YES APIX0198 GTD02 STO RANKS STORE RANK OF SUBSCRIPT APIX0199 RTE 8 ISOLATE RIGHT HAND APIX0200 SRA 8 DIMENSION OF SUBSCRIPT APIX0201 MDX L RANKS,0 SKIP IF SCALAR APIX0202 MDX GTD03 CONTINUE IF VECTOR OR APIX0203 MDX GTD05 MATRIX APIX0204 * APIX0205 * APIX0206 GTD03 LDX I1 RANKR STORE DIMENSION FOR APIX0207 STO L1 XLSEV APIX0208 * APIX0209 MDX I1 RANKS ADVANCE RANK OF APIX0210 STX 1 RANKR RESULT APIX0211 * APIX0212 MDX L RANKS,-1 SKIP IF A VECTOR APIX0213 MDX GTD04 CONTINUE IF MATRIX APIX0214 MDX GTD05 APIX0215 * APIX0216 GTD04 RTE 8 ISOLATE LEFT HAND APIX0217 SRA 8 DIMENSION APIX0218 STO XLSEV+1 SAVE IT APIX0219 SLT 8 FORM LENGTH OF SUBSCRIPT APIX0220 BSI L GTLVR APIX0221 * APIX0222 GTD05 STO L2 XESEV APIX0223 M RHRHO FORM LENGTH OF RESULT APIX0224 SLT 16 APIX0225 STO RHRHO APIX0226 BSC I GTDIM EXIT APIX0227 * APIX0228 * APIX0229 HDNG SET UP M-ENTRY FOR INDEXING APIX0230 * THIS IS AN INDEXING ENTRY APIX0231 * APIX0232 * APIX0233 XQI03 LD DMNSC HOW MANY APIX0234 S D1 SUBSCRIPTS APIX0235 BSC L XQI04,Z BRANCH IF TWO APIX0236 LD I RMSEV IS SUBSCRIPT A TEMPORARY APIX0237 BSC L XQI06,-Z BRANCH IF YES, WE CAN APIX0238 * USE IT TO HOLD THE RESLT APIX0239 * APIX0240 XQI04 LD RHRHO GET LENGTH OF RESULT APIX0241 A D1 ADJUST TO FORM ROOM REQD APIX0242 SLA 1 FOR M ENTRY APIX0243 BSI L GETSP GET SPACE FOR IT - THIS APIX0244 * ADDRESS IS GIVEN BY X1 APIX0245 STX 1 MNTRR SAVE RESULT APIX0246 * APIX0247 LD I RMSEV SET ADDRESS OF RIGHTMOST APIX0248 STO XBADR SEV IN CASE MOVED BY APIX0249 * GETSPACE APIX0250 LD DMNSC HOW MANY APIX0251 S D1 SUBSCRIPTS APIX0252 BSC L XQI05,+- BRANCH IF ONE APIX0253 LDX I1 RMSEV STORE ADDRESS OF LEFT APIX0254 LD 1 -1 MOST SEV IN CASE IT HAS APIX0255 STO XBADR+1 BEEN MOVED BY GETSPACE APIX0256 * APIX0257 XQI05 LD I INDXE GET M-ENTRY OF INDEXEE APIX0258 BSI L GTMPT IN CASE IT HAS MOVED APIX0259 STX 1 MNTRI SAVE IT APIX0260 LD MNTRR GET M-ENTRY OF RESULT APIX0261 * APIX0262 * APIX0263 XQI06 BSI L ABSAD CONVERT TO 1130 APIX0264 STX 1 MNTRR AND SAVE APIX0265 LD XLSEV+1 STORE DIMENSIONS APIX0266 SLA 8 IN M ENTRY APIX0267 A XLSEV APIX0268 STO 1 1 APIX0269 * APIX0270 LD RMSEV NEW TOP OF STACK IS APIX0271 A D1 IMMEDIATELY BELOW APIX0272 STO L LOCOR+14 APIX0273 * APIX0274 LDX I1 MNTRI GET M-ENTRY OF INDEXEE APIX0275 SRT 12 SAVE ADDRESS OF SYPTR APIX0276 LD RANKR GET RANK OF APIX0277 SRT 2 RESULT APIX0278 LD 1 0 GET TYPE OF APIX0279 SRA 14 INDEXEE APIX0280 SLT 14 STORE M-ENTRY HEADER APIX0281 STO I MNTRR APIX0282 * APIX0283 LD I INDXE MARK INDEXEE APIX0284 BSC L XQI07,+ AS GARBAGE APIX0285 LD HFFFF IF IT WAS A APIX0286 STO 1 0 TEMPORARY APIX0287 * APIX0288 XQI07 LDX I1 RMSEV SET M-POINTER IN THE APIX0289 LD MNTRR STACK FOR RESULT WHICH APIX0290 STO 1 1 IS A TEMPORARY APIX0291 * APIX0292 * APIX0293 HDNG MOVE ELEMENTS APIX0294 * APIX0295 * APIX0296 XQI12 LDX I1 MNTRI M-ENTRY OF INDEXEE APIX0297 LD 1 1 GET DIMENSIONS APIX0298 AND H00FF SAVE RIGHT HAND APIX0299 STO XBOUN DIMENSION APIX0300 LD 1 1 APIX0301 SRA 8 SAVE LEFT HAND APIX0302 STO XBOUN+1 DIMENSION APIX0303 * APIX0304 LDX L2 XBADR GET ADDRESS AND NUMBER APIX0305 LDX I3 DMNSC OF SUBSCRIPTS FOR APIX0306 * CONVERSION APIX0307 XQI08 LD 2 0 GET SUBSCRIPT APIX0308 BSC L XQI11,+- BRANCH IF OMITTED APIX0309 BSC L XQI09,+ BRANCH IF INDIRECT APIX0310 BSI L ABSAD CONVERT TO 1130 ADDRESS APIX0311 S MNTRR POSITION AS THE RESULT APIX0312 BSC L XQI10,+- BRANCH IF YES APIX0313 LD HFFFF MARK AS GARBAGE IF NOT APIX0314 STO 1 0 APIX0315 MDX XQI10 APIX0316 XQI09 BSI L GTMPT GET M-ENTRY ADDRESS APIX0317 XQI10 MDX 1 2 ADVANCE TO FIRST ELEMENT APIX0318 STX I1 2 SAVE IT APIX0319 * APIX0320 XQI11 MDX 2 1 ADVANCE TO NEXT SUBSCRPT APIX0321 MDX 3 -1 COUNT SUBSCRIPTS APIX0322 MDX XQI08 CONTINUE IF MORE THAN 1 APIX0323 * APIX0324 * APIX0325 * APIX0326 * APIX0327 LDX L1 LOCOR APIX0328 MDX L DMNSC,-1 APIX0329 MDX XQI13 APIX0330 * APIX0331 SRA 16 VECTOR MOVE - ZERO BASE APIX0332 LDX 2 0 1ST DIMENSION APIX0333 BSI STVEC STORE VECTOR APIX0334 * APIX0335 MDX XQI15 APIX0336 * APIX0337 XQI13 LD L XESEV+1 APIX0338 BSC L XQI15,+- APIX0339 STO 1 7 APIX0340 SRA 16 APIX0341 STO 1 8 APIX0342 * APIX0343 XQI14 LDX 2 1 GET SUBSCRIPT VALUE APIX0344 LD 1 8 FOR LEFT HAND APIX0345 BSI L GTSVL DIMENSION APIX0346 M L XBOUN FORM BASE OF M-ENTRY APIX0347 SLT 16 APIX0348 BSI STVEC STORE VECTOR APIX0349 MDX L LOCOR+8,1 ADVANCE AND COUNT ELEMENTAPIX0350 MDX L LOCOR+7,-1 IN LEFT HAND SUBSCRIPT APIX0351 MDX XQI14 APIX0352 * APIX0353 XQI15 LD LASW BRANCH IF LEFT ARROW APIX0354 BSC L XQEXT,Z STATE APIX0355 * APIX0356 LD L STATE OTHERWISE PUT STATE IN APIX0357 STO 1 12 R12 AND RETURN TO EFPE APIX0358 BSC L EFPE1 APIX0359 * APIX0360 * APIX0361 MNTRI DC 0 APIX0362 MNTRR DC 0 APIX0363 * APIX0364 HFFFF DC /FFFF APIX0365 * APIX0366 LASW DC 0 APIX0367 HDNG STORE VECTOR APIX0368 * SUBROUTINE TO TRANSFER ROW VECTOR APIX0369 * FROM OR TO INDEXEE APIX0370 * APIX0371 STVEC DC 0 APIX0372 * APIX0373 A MNTRI STORE ADDRESS OF FIRST APIX0374 STO 1 4 ELEMENT IN ROW VECTOR APIX0375 LD L XESEV LESS 2. EXIT IF EMPTY APIX0376 BSC I STVEC,+- APIX0377 STO 1 5 APIX0378 SRA 16 INITIALISE ELEMENT NO. APIX0379 STO 1 6 APIX0380 STV01 LDX 2 0 USE RIGHT HAND DIMNSION APIX0381 LD 1 6 GET SUBSCRIPT VALUE FOR APIX0382 BSI L GTSVL NEXT ELEMENT APIX0383 A 1 4 ADDRESS OF ELEMENT IN APIX0384 STO L 2 INDEXEE LESS 2 AND SAVE APIX0385 * IT APIX0386 LD LASW BRANCH IF APIX0387 BSC L STV02,+- INDEXING APIX0388 LDX I3 MNTRR ASSIGNMENT. MOVE IS TO APIX0389 MDX STV03 INDEXEE APIX0390 STV02 STX L2 3 INDEX. MOVE IS FROM APIX0391 LDX I2 MNTRR INDEXEE APIX0392 * APIX0393 STV03 LDD 3 2 MOVE APIX0394 STD 2 2 ELEMENT APIX0395 * APIX0396 LD MNTRR ADVANCE APIX0397 A L STPSW TO NEXT ELEMENT OF APIX0398 STO MNTRR RESULT OR RIGHT HAND S APIX0399 * APIX0400 MDX L LOCOR+6,1 ADVANCE TO NEXT ELEMENT APIX0401 MDX L LOCOR+5,-1 APIX0402 MDX STV01 APIX0403 * APIX0404 BSC I STVEC APIX0405 * APIX0406 * APIX0407 * SUBROUTINE TO CHECK STACK AND SET UP POINTERS APIX0408 SETUP DC 0 APIX0409 LDX L3 LOCOR BASE TO REGISTERS APIX0410 LD 3 PAREL-LOCOR APIX0411 S 3 14 ENTRIES IN THE STACK APIX0412 S 3 1 ARE THERE MORE THAN TWO APIX0413 BSC L SYNER,+ ERROR IF YES APIX0414 * APIX0415 LD 3 14 TOP SVI POINTER. APIX0416 BSI L ABSAD APIX0417 STX L1 INDXE SAVE ADDRESS OF INDEXEE APIX0418 BSC I SETUP APIX0419 HDNG SIMPLE ASSIGNMENT APIX0420 * APIX0421 SXQAS BSI SETUP APIX0422 LD 1 0 IS LEFT HAND SIDE APIX0423 S 1 1 SAME AS RIGHT HAND SIDE APIX0424 BSC L XQA07,+- NO COPY IF YES APIX0425 LD 1 1 BRANCH IF RHS IS APIX0426 BSC L XQA01,+Z A TEMPORORARY APIX0427 BSI STLHS SET UP LEFT HANSIDE APIX0428 LDX I3 INDXE GET ADDRESS OF RHS APIX0429 LD 3 1 M-ENTRY APIX0430 STO L 2 APIX0431 MDX XQA06 APIX0432 XQA01 BSI GTMPT GET RHS M-ENTRY APIX0433 STX L1 3 CALCULATE LENGTH OF APIX0434 BSI L CLOMN RHS APIX0435 STO DIMNS SAVE LENGTH OF RHS APIX0436 LD I INDXE GET M-ENTRY FOR APIX0437 BSI GTMPT LHS APIX0438 EOR H1000 BRANCH IF UNASSIGNED APIX0439 BSC L XQA02,+- LOCAL OR GLOBAL APIX0440 STX L1 3 CALCULATE LENGTH OF APIX0441 BSI L CLOMN LHS APIX0442 XQA02 STO SETUP APIX0443 LD DIMNS FIND SPACE REQD APIX0444 S SETUP APIX0445 A NEGBT ALLOW FOR GLOBAL TABLE APIX0446 BSC L XQA03,+ BRANCH IF ENOUGH SPACE APIX0447 STO SETUP SAVE EXTRA SPACE APIX0448 BSI L GETSP CHECK TO SEE IF ENOUGH APIX0449 LD L MNEXT THERE WAS] RESTORE APIX0450 S SETUP END OF M-SPACE POINTER APIX0451 STO L MNEXT APIX0452 XQA03 BSI STLHS SET UP LEFT HAND SIDE APIX0453 LD DIMNS SPACE FOR LHS APIX0454 BSI L GETSP APIX0455 STX 1 XQA04+1 SAVE LHS M-ENTRY ADDRESS APIX0456 LDX I3 INDXE GET ADDRESS OF RHS APIX0457 LD 3 1 M-ENTRY APIX0458 BSI GTMPT APIX0459 XQA04 LDX L2 *-* ADDRESS OF LHS M-ENTRY APIX0460 XQA05 LDD 1 0 TRANSFER RHS TO LHS APIX0461 STD 2 0 A DOUBLE WORD APIX0462 MDX 1 2 AT A TIME APIX0463 MDX 2 2 APIX0464 MDX L DIMNS,-2 APIX0465 MDX XQA05 APIX0466 LDX I2 XQA04+1 ADDRESS OF RHS M-ENTRY APIX0467 XQA06 LD 3 0 ADDRESS OF RHS SYPTR APIX0468 EOR XFFFF DECOMPLEMENT IT APIX0469 BSI L ABSAD INTO X1 APIX0470 STX I2 1 PUT MPTR IN SYPTR APIX0471 LD L 1 ADJUST POINTER APIX0472 SRT 12 TO SYPTR APIX0473 LD 2 0 IN M-ENTRY APIX0474 SRA 12 APIX0475 SLT 12 APIX0476 STO 2 0 APIX0477 LD 3 0 PUT SYPTR OF LHS IN STACK APIX0478 STO 3 1 APIX0479 * APIX0480 XQA07 MDX L LOCOR+14,1 PUSH STACK DOWN ONE APIX0481 HDNG RETURN TO NEXT APIX0482 * APIX0483 * APIX0484 XQEXT LDX 1 -1 FULL STATEMENT APIX0485 STX L1 FULST SEEN APIX0486 LD H0080 SET OPERAND STATE IN APIX0487 LDX L1 LOCOR IN R15 APIX0488 STO 1 15 APIX0489 BSC L NEXT+1 CONTINUE ANALYSIS APIX0490 * APIX0491 H0FFF DC /0FFF APIX0492 H0080 DC /0080 APIX0493 H1000 DC /1000 APIX0494 INDER LDX L1 17+/4000 APIX0495 BSC L ERRXT APIX0496 * APIX0497 HDNG SERVICE ROUTINES FOR XQIND & XQASS APIX0498 STLHS DC 0 SET LHS SUBROUTINE APIX0499 LD I INDXE GET LHS STACK ENTRY APIX0500 EOR XFFFF DECOMPLEMENT IT APIX0501 BSC L STL01,Z BRANCH IF TRUE POINTER APIX0502 LDX L1 FNDPL ADD GLOBAL TO LGOBAL TABLE APIX0503 BSI AGBTB APIX0504 LD NGBTB ADDRESS OF SYPTR APIX0505 LDX I1 INDXE STACK ENTRY ADDRESS APIX0506 AND H0FFF APIX0507 MDX STL02 GO COMPLEMENT IT APIX0508 STL01 EOR XFFFF COMPLEMENT IT AGAIN APIX0509 BSI GTMPT GET M-ENTRY APIX0510 EOR H1000 IS IT AN UNASSIGNED LOCAL APIX0511 BSC I STLHS,+- EXIT IF YES APIX0512 STL02 EOR XFFFF MARK EXISTING LHS ENTRY APIX0513 STO 1 0 AS GARBAGE. OR STORE SYPTR APIX0514 BSC I STLHS APIX0515 * APIX0516 * SUBROUTINE TO FORM LENGTH OF M-ENTRY APIX0517 * APIX0518 DIMNS DC 0 APIX0519 NEGBT DC EGBTB APIX0520 * SUBROUTINE TO GET ADDRESS OF M-ENTRY APIX0521 * GIVEN POINTER IN ACCUMULATOR APIX0522 * USES X1 APIX0523 GTMPT DC 0 APIX0524 BSC L GTM01,- BRANCH IF DIRECT APIX0525 EOR XFFFF APIX0526 BSI L ABSAD IN X1 APIX0527 LD 1 0 GET M PTR ADDRESS APIX0528 GTM01 BSI L ABSAD PUT IT IN X1 APIX0529 BSC I GTMPT APIX0530 XFFFF DC /FFFF APIX0531 * SUBROUTINE TO GET NTH SUBSCRIPT VALUE APIX0532 * GIVEN (N-1) IN ACCUMULATOR APIX0533 * X2 CONTAINS POINTER TO SUBSCRIPT ADDRESS APIX0534 * AND BOUNDS APIX0535 * N WILL BE USED AS THE VALUE IF NO SUBSCRIPT APIX0536 * EXISTS - RESULT IN ACCUMULATOR APIX0537 * APIX0538 GTSVL DC 0 APIX0539 * APIX0540 STO 1 2 SAVE N APIX0541 LD L2 XBADR GET SUBSCRIPT ADDRESS APIX0542 BSC L GTS02,+- BRANCH IF OMITTED APIX0543 STX 2 GTS01+1 SAVE X2 APIX0544 A 1 2 GET ELEMENT OF APIX0545 A 1 2 SUBSCRIPT APIX0546 STO L 3 PUT IT IN X3 APIX0547 LDD 3 0 GET ELEMENT APIX0548 STD 1 2 UNFLOAT IT TO APIX0549 BSI L LCUFL R2 APIX0550 LDX L1 LOCOR APIX0551 GTS01 LDX L2 *-* RESTORE X2 APIX0552 LD 1 2 CHECK VALUE OF ELEMENT APIX0553 BSC L INDER,+ ERROR IF ZERO OR -VE APIX0554 S L2 XBOUN WITH INDEXEE BOUNDS APIX0555 BSC L INDER,-Z ERROR IF OUT OF BOUNDS APIX0556 * APIX0557 MDX L LOCOR+2,-1 REDUCE N TO N-1 APIX0558 MDX * APIX0559 * APIX0560 GTS02 LD 1 2 FORM 2*(N-1) APIX0561 SLA 1 APIX0562 BSC I GTSVL EXIT APIX0563 GTLVR DC 0 APIX0564 RTE 24 APIX0565 SRA 8 APIX0566 STO GTL01 APIX0567 RTE 8 APIX0568 SRA 8 APIX0569 M GTL01 APIX0570 SLT 16 APIX0571 BSC I GTLVR APIX0572 GTL01 EQU GTMPT APIX0573 HDNG ADD IDENTIFIER TO GLOBAL TABLE APIX0574 LNGTB EQU GTMPT APIX0575 NGBTB EQU GTLVR APIX0576 * X1 CONTAINS POINTER TO PARAMETER LIST APIX0577 AGBTB DC 0 APIX0578 STX 1 AGB09+1 SAVE X1 APIX0579 LD L LENGL BRANCH IF GLOBAL APIX0580 S L NUMGL TABLE APIX0581 BSC L AGB03,+ IS FULL APIX0582 * APIX0583 LDX L1 GLBTB ADDRESS OF GLOBAL TABLE APIX0584 AGB01 LD 1 0 APIX0585 BSC L AGB08,+- APIX0586 MDX 1 4 APIX0587 MDX AGB01 APIX0588 * APIX0589 AGB03 LD NEGBT GET SPACE IN M MATRIX APIX0590 BSI L GETSP FOR MORE GLOBALS APIX0591 * APIX0592 LD L MNEXT ADDRESS OF PREVIOUS APIX0593 S NEGBT APIX0594 STO L 2 M MATRIX APIX0595 S L MSTRT NUMBER OF WORDS TO BE APIX0596 STO L 3 MOVED DOWN TO MAKE APIX0597 * ROOM FOR ADDITIONAL APIX0598 * GLOBAL TABLE ENTRIES APIX0599 STO LNGTB LENGTH OF TABLE APIX0600 MDX L LENGL,NEXEN ADVANCE COUNT OF ENTRIES APIX0601 * IN TABLE APIX0602 AGB04 LDD 2 -2 MOVE NEXT DOUBLE WORD APIX0603 STD 2 EGBTB-2 DOWN APIX0604 * APIX0605 MDX 2 -2 ADJUST ADDRESS APIX0606 MDX 3 -2 COUNT WORDS APIX0607 MDX AGB04 CONTINUE IF MORE APIX0608 * APIX0609 STX 2 NGBTB NEXT GLOBAL ENTRY APIX0610 LDX 3 EGBTB NUMBER OF EXTRA WORDS APIX0611 SLT 32 APIX0612 AGB05 STD 2 0 ZERO OUT GLOBAL ENTRIES APIX0613 MDX 2 2 ADJUST ADDRESS APIX0614 MDX 3 -2 COUNT NUMBER OF WORDS APIX0615 MDX AGB05 CONTINUE IF MORE APIX0616 * APIX0617 STX L2 MSTRT NEW START OF M MATRIX APIX0618 * APIX0619 * APIX0620 AGB06 LD 2 0 BRANCH IF THIS ENTRY APIX0621 BSC L AGB07,+Z IS GARBAGE APIX0622 BSI L ABSAD IF NOT CONVERT TO 1130 APIX0623 * ADDRESS APIX0624 LD L 2 ADDRESS OF THIS ENTRY APIX0625 SRT 12 APIX0626 LD 1 0 PLACE NEW ADDRESS APIX0627 SRA 12 IN RELEVANT APIX0628 SLT 12 SYPTR APIX0629 STO 1 0 APIX0630 AGB07 STX L2 3 APIX0631 BSI L CLOMN APIX0632 STO DIMNS APIX0633 * ADVANCE TO NEXT APIX0634 MDX I2 DIMNS ENTRY APIX0635 LD LNGTB ADJUST COUNT OF WORDS APIX0636 S DIMNS IN MATRIX APIX0637 STO LNGTB APIX0638 BSC L AGB06,-Z CONTINUE IF MORE APIX0639 MDX AGB09 BRANCH OUT IF NOT APIX0640 AGB08 STX 1 NGBTB APIX0641 * APIX0642 AGB09 LDX L1 *-* RESTORE POINTER APIX0643 * APIX0644 LD 1 3 GET PREVIOUS POINTER APIX0645 BSC L IGB01,Z BRANCH IF NOT ZERO APIX0646 LD 1 2 IF ZERO, FORM ADDRESS APIX0647 A AGSTB OF ENTRY IN SYNONYM APIX0648 * TABLE LESS ONE APIX0649 IGB01 STO L 2 SAVE ADDRESS FOR STORING APIX0650 LD NGBTB SAVE ADDRESS FOR APIX0651 STO 2 1 ENTRY IN PREVIOUS ENTRY APIX0652 * APIX0653 LDX I2 NGBTB ADDRESS OF ENTRY APIX0654 LDD 1 0 SAVE IDENT IN APIX0655 STD 2 2 ENTRY APIX0656 * APIX0657 MDX L NUMGL,1 ADVANCE COUNT OF GLOBALS APIX0658 * BY ONE APIX0659 BSC I AGBTB EXIT APIX0660 * APIX0661 AGSTB DC GLSTB-1 APIX0662 LNGTH EQU *-ASMIX APIX0663 HDNG WRITE ASSEMBLY TO DISK APIX0664 START LDX L1 ASMIX-2 APIX0665 BSI DSKIO APIX0666 EXIT APIX0667 DSKIO DC 0 APIX0668 STX 1 DSKI1 APIX0669 STX 1 DSKI3 APIX0670 LIBF DISK1 APIX0671 DC /3000 APIX0672 DSKI1 DC 0 APIX0673 DC DSKI4 APIX0674 DSKI2 LIBF DISK1 APIX0675 DC /0000 APIX0676 DSKI3 DC 0 APIX0677 MDX DSKI2 APIX0678 BSC I DSKIO APIX0679 DSKI4 WAIT APIX0680 BSC I DSKIO APIX0681 END START APIX0682 // XEQ L 1 APIX0683 // JOB APOV0001 // ASM APOV0002 *LIST APOV0003 *PRINT SYMBOL TABLE APOV0004 HDNG PREPROLOGUE TO END OF STATEMENT APOV0005 ABS APOV0006 * 1130 DISK ADDRESSES APOV0007 LCDBS EQU /280 1130 DISK ADDR OF LC DISK APOV0008 DAEOS EQU LCDBS+/64 APOV0009 * ORIGINS OF THIS AND OTHER ASSEMBLIES APOV0010 ASMES EQU /1B51 APOV0011 ASMCT EQU /21E APOV0012 ASMXQ EQU /730 APOV0013 ASMIX EQU /18D1 APOV0014 * IMPORTANT ADDRESSES APOV0015 LOCOR EQU /1000 APOV0016 MNEXT EQU /1014 APOV0017 PAREL EQU /1017 APOV0018 OVLY2 EQU /18D1 APOV0019 RAND EQU /101A APOV0020 ISBRN EQU /1FF3 APOV0021 ATTN EQU /1FF8 APOV0022 GTSPL EQU /1FFA APOV0023 * ADDRESSES IN CTRAY ASSEMBLY APOV0024 ABSAD EQU ASMCT+/A8 APOV0025 GSYL EQU ASMCT+/DE APOV0026 FSB EQU ASMCT+/22A APOV0027 FMP EQU ASMCT+/22E APOV0028 FDV EQU ASMCT+/232 APOV0029 FAD EQU ASMCT+/236 APOV0030 ENTR2 EQU ASMCT+/242 APOV0031 NLZE EQU ASMCT+/255 APOV0032 CLEAR EQU ASMCT+/272 APOV0033 EXIT EQU ASMCT+/27D APOV0034 AARG EQU ASMCT+/294 APOV0035 XMDS EQU ASMCT+/2B3 APOV0036 ONE EQU ASMCT+/2CF APOV0037 XDDS EQU ASMCT+/2D4 APOV0038 XTRCT EQU ASMCT+/2F4 APOV0039 UNFLT EQU ASMCT+/30E APOV0040 FLT EQU ASMCT+/346 APOV0041 FSBN EQU ASMCT+/355 APOV0042 GNXTW EQU ASMCT+/479 APOV0043 XQSTC EQU ASMCT+/373 APOV0044 XQNXL EQU ASMCT+/3E6 APOV0045 CLOMN EQU ASMCT+/153 APOV0046 GETSP EQU ASMCT+/160 APOV0047 * ADDRESSES IN STATEMENT EXECUTION APOV0048 SYNER EQU ASMXQ+/152 APOV0049 RNGER EQU ASMXQ+/276 APOV0050 LGTER EQU ASMXQ+/15A APOV0051 INDOM EQU ASMXQ+/276 APOV0052 PIN EQU ASMXQ+/237 APOV0053 MLARG EQU ASMXQ+/23F APOV0054 MRARG EQU ASMXQ+/240 APOV0055 XLARG EQU ASMXQ+/23E APOV0056 XRARG EQU ASMXQ+/23B APOV0057 MRSLT EQU ASMXQ+/244 APOV0058 GRP3 EQU ASMXQ+/126 APOV0059 UPL EQU ASMXQ+/391 APOV0060 UTEMP EQU ASMXQ+/394 APOV0061 UK1 EQU ASMXQ+/3C3 APOV0062 ABS EQU ASMXQ+/415 APOV0063 PLUS EQU ASMXQ+/3BF APOV0064 MINUS EQU ASMXQ+/3C6 APOV0065 IDEN1 EQU ASMXQ+/6A8 APOV0066 * ADDRESSES REQUIRED BY OTHER ASSEMBLIES APOV0067 DC XQFUN-ASMIX APOV0068 DC DAMAX-ASMIX APOV0069 DC DARES-ASMIX APOV0070 DC BREP-ASMIX APOV0071 DC BEPS-ASMIX APOV0072 DC BIOTA-ASMIX APOV0073 DC FLN-ASMIX APOV0074 DC BEXP-ASMIX APOV0075 DC FEXP-ASMIX APOV0076 DC DBASE-ASMIX APOV0077 DC QUERY-ASMIX APOV0078 DC COMBN-ASMIX APOV0079 DC FACTO-ASMIX APOV0080 DC BSTBL-ASMIX APOV0081 * LENGTH OF ASSEMBLY APOV0082 DC LNGTH APOV0083 HDNG ORIGIN OF ASSEMBLY APOV0084 ORG ASMES-2 APOV0085 DC 4*/140 APOV0086 DC DAEOS APOV0087 HDNG EXECUTE FUNCTION, QUAD INPUT APOV0088 * R12 = PREVIOUS STATE APOV0089 * R14 = S.V.I. APOV0090 * R15 = -VE IF PROCESSING FUNCTION APOV0091 * WITH NO PARAMETERS APOV0092 * R13 = POINTER TO FUNCTION M ENTRY APOV0093 * APOV0094 XQFUN EQU * APOV0095 SXQFN LDX L3 LOCOR APOV0096 LD 3 15 IS THIS FUNCTION WITH APOV0097 BSC L XQF01,- PARMS. BRANCH IF APOV0098 LD 3 14 GET ADDRESS APOV0099 BSI L ABSAD OF SYPTR APOV0100 LD 1 1 GET SYPTR OF FUNCTION APOV0101 EOR WFFFF APOV0102 STO 3 13 SAVE IN R13 APOV0103 LD 3 1 SET PREVIOUS STATE APOV0104 STO 3 12 RIGHT PAREN IN R12 APOV0105 XQF01 LD 3 13 GET CONTENTS OF APOV0106 BSI L ABSAD CURRENT SYPTR TO X1 APOV0107 LD 1 0 IS THIS QUAD,QUAD PRIME APOV0108 A H1000 APOV0109 BSC L XQF02,C BRANCH IF YES APOV0110 * APOV0111 * APOV0112 BSI L ABSAD GET M-PTR APOV0113 * APOV0114 STX 1 XQF04+1 APOV0115 LD 1 3 ISOLATE LINE COUNT APOV0116 AND H00FF AND USE THIS TO GET APOV0117 * DISK ADDRESS OF COUNTS APOV0118 A 1 2 APOV0119 LDX L1 GTSCP SAVE DISK ADDRESS APOV0120 STO 1 0 FRO READING DIRECTORIES APOV0121 STX L1 GTSPL+1 IN GETSYL PARAM LIST APOV0122 * READING DIRECTORIES APOV0123 BSI L GNXTW GET LABEL COUNT APOV0124 STO LABCT AND STORE APOV0125 BSI L GNXTW GET LOCAL COUNT APOV0126 STO LOCCT AND STORE APOV0127 LD LABCT DETERMINE SPACE REQUIRED APOV0128 SLA 2 FOR LABEL APOV0129 STO 3 5 M ENTRIES APOV0130 S LABCT DETERMINE SPACE APOV0131 A LOCCT FOR HEADER OF NEW APOV0132 A LOCCT TOP OF STACK APOV0133 A LOCCT LEVEL APOV0134 A D0016 APOV0135 STO TSPTR APOV0136 XQF04 LDX L1 *-* APOV0137 LD 3 15 DETERMINE SPACE REQ'D APOV0138 BSI L DSPRQ,+Z IN M-SPACE FOR FUNCTIOM APOV0139 * WITH ARGUMENTS (UPDATE APOV0140 SRA 16 R5) APOV0141 STO QINFL GET SPACE FOR M-ENTRIES APOV0142 BSI L SUTOS AND SET UP TOP OF STACK APOV0143 LD 3 15 GET ADDRESS OF ARGUMENTS APOV0144 BSI L GTARG,+Z FROM SYPTRS APOV0145 * X2 CONTAINS TOP OF STACK APOV0146 * ADDRESS APOV0147 LD LABCT STORE COUNTS APOV0148 STO 2 5 IN TOP OF STACK APOV0149 LD LOCCT HEADER APOV0150 STO 2 6 APOV0151 MDX 2 7 ADVANCE T.O.S. POINTER APOV0152 LD D0003 STORE NEXT 3 IDS APOV0153 BSI L SIDST IN STACK WITH ZERO APOV0154 LD 3 15 IF FUNCTION WITH PARAMS, APOV0155 BSI L SRAST,+Z SET SYPTRS AND MPTRS APOV0156 * OF RESULT AND ARGUMENT APOV0157 * IN STACK AND M SPACE APOV0158 LD LABCT SET UP LABELS IN STACK APOV0159 BSI L SLBST,Z IF ANY APOV0160 LD LOCCT STORE LOCALS IN STACK APOV0161 BSI L SIDST,Z IF ANY APOV0162 * APOV0163 LDX I2 PAREL APOV0164 BSC L XQNXL APOV0165 * STATEMENT APOV0166 XQF02 STO QINFL SET SPACE FOR TOP OF APOV0167 LDX 1 5 STACK HEADER REQUIRED APOV0168 STX 1 TSPTR FOR QUAD INPUT APOV0169 SRA 16 SET SPACE REQ'D IN APOV0170 STO 3 5 M SPACE. APOV0171 STO 3 13 NO FUNCTION POINTER APOV0172 BSI L SUTOS SET UP TOP OF STACK APOV0173 * APOV0174 XQF03 BSC I XQSTC GO GET QUAD INPUT APOV0175 * APOV0176 GTSCP DC 0 APOV0177 H1000 DC /1000 APOV0178 H00FF DC /00FF APOV0179 LABCT DC 0 APOV0180 LOCCT DC 0 APOV0181 D0016 DC 16 APOV0182 TSPTR DC 0 APOV0183 D0003 DC 3 APOV0184 WFFFF DC /FFFF APOV0185 LARGA EQU LOCOR+8 APOV0186 LARGL EQU LOCOR+10 APOV0187 HDNG SERVICE ROUTINES FOR XQFUN APOV0188 * SUBROUTINE TO DETERMINE SPACE REQ'D IN APOV0189 * M SPACE FOR FUNCTION ARGUMENTS APOV0190 * R14 POINTS TO SVI APOV0191 * X1 CONTAINS ADDRESS OF FUNCTION M ENTRY APOV0192 QINFL EQU * APOV0193 DSPRQ DC 0 APOV0194 MDX L TSPTR,-3 TOP 3 LOCOATIONS OF APOV0195 * FUNCTION WITH PARAMS ARE PART OF HEADER APOV0196 LD 1 3 STORE COUNT OF APOV0197 SLA 1 EXPECTED NUMBER OF APOV0198 SRA 14 ARGUMENTS TO X2 APOV0199 STO L 2 APOV0200 * APOV0201 LD 3 14 POINTER TO STACK APOV0202 BSI L ABSAD ENTRY TO X1 APOV0203 * APOV0204 LD 1 0 GET LEFT ARGUMENT APOV0205 BSC Z THIS WILL CATCH NO LEFT APOV0206 MDX 2 -1 ARGUMENT WHEN ONE IS APOV0207 MDX 2 -1 EXPECTED AND VICE VERSA APOV0208 MDX DSP04 BRANCH TO ERROR EXIT APOV0209 * APOV0210 LDX 2 2 COUNT 2 ARGUMENTS APOV0211 STX 1 DSP01+1 SAVE ADDRESS APOV0212 * APOV0213 DSP01 LD L *-* BRANCH IF ARG ABSENT APOV0214 BSC L DSP02,- OR IF DIRECT APOV0215 * IF INDIRECT, ARGUMENT APOV0216 EOR WFFFF MUST BE MOVED, DECOMPLE- APOV0217 BSI L ABSAD IT AND SAVE SYPTR APOV0218 STO L2 LARGA-1 ADDRESS APOV0219 LD 1 0 GET POINTER TO M-ENTRY APOV0220 BSI L ABSAD ADDRESS OF M ENTRY APOV0221 STO L 3 APOV0222 BSI L CLOMN CALCLATE ARG LENGTH APOV0223 LDX L3 LOCOR APOV0224 STO L2 LARGL-1 SAVE IT APOV0225 A 3 5 UPDATE SPACE REQ'D IN APOV0226 STO 3 5 M-SPACE APOV0227 MDX DSP03 GO TO COUNT ARGUMENTS APOV0228 * APOV0229 DSP02 LD DSP01+1 SAVE SYPTR OF DIRECT APOV0230 STO L2 LARGA-1 ENTRY WHICH IS IN STACK APOV0231 SRA 16 NO MOVE REQUIRED IF APOV0232 STO L2 LARGL-1 NON-EXISTENT OR DIRECT APOV0233 * ENTRY APOV0234 DSP03 MDX L DSP01+1,2 NEXT ARGUMENT SYPTR APOV0235 MDX 2 -1 COUNT TWO ARGUMENTS APOV0236 MDX DSP01 GO TO GET NEXT ARGUMENT APOV0237 * APOV0238 BSC I DSPRQ EXIT APOV0239 * APOV0240 DSP04 BSC L SYNER SYNTAX ERROR EXIT APOV0241 * APOV0242 GTARG DC 0 APOV0243 LD I LARGA SAVE CONTENTS OF APOV0244 STO L LARGA RIGHT ARGUMENT SYPTR APOV0245 LD I LARGA+1 SAVE CONTENTS OF APOV0246 STO L LARGA+1 LEFT ARGUMENT SYPTR APOV0247 BSC I GTARG APOV0248 * SET UP NEW LEVEL FOR TOP OF STACK APOV0249 * APOV0250 SUTOS DC 0 APOV0251 LD 3 5 FROM TOTAL SPACE REQD APOV0252 A TSPTR FOR NEW TOP LEVEL APOV0253 BSI L GETSP GET SPACE FOR IT APOV0254 LDX L3 LOCOR ARGUMENTS IF REQ'D APOV0255 LD 3 MNEXT-LOCOR THE TOP LEVEL HEADER GOESAPOV0256 S TSPTR ON TO THE STACK, NOT THE APOV0257 STO 3 MNEXT-LOCOR M-SPAEC APOV0258 LD 3 14 IS THERE ENOUGH ROOM APOV0259 S TSPTR FOR TOP OF STACK HEADER APOV0260 * APOV0261 BSI L ABSAD POINTER TO X2 APOV0262 STX L1 2 APOV0263 LD 3 PAREL-LOCOR APOV0264 SRT 12 APOV0265 LD QINFL STORE POINTER TO APOV0266 SLT 12 APOV0267 STO 2 0 HEADER - APOV0268 * (WORD CONTAINS QUAD FLAGS APOV0269 * IF ANY IN BITS 0-3) APOV0270 LD 3 12 STORE LINE NUMBER AND APOV0271 STO 2 2 APOV0272 * APOV0273 LD 3 13 STORE FUNCTION SYPTR APOV0274 STO 2 3 IN WORD 3 APOV0275 * APOV0276 SRA 16 ZERO OUT WORDS 1 AND 4 APOV0277 STO 2 1 APOV0278 STO 2 4 APOV0279 STX L2 PAREL NEW TOP LEVEL HEADER APOV0280 * APOV0281 BSC I SUTOS EXIT APOV0282 * APOV0283 H0FFF DC /0FFF APOV0284 H80 DC /80 APOV0285 H0101 DC /0101 APOV0286 * SUBROUTINE TO STORE LABELS IF NECESSARY APOV0287 * AND SET UP M-ENTRIES FOR EACH LABEL APOV0288 * USES R6,R7 - UPDATES R5 APOV0289 SLBST DC 0 APOV0290 SLB01 LD 3 5 SYPTR IE. POINTER TO APOV0291 STO 2 0 M-SPACE) IN 1ST WORD APOV0292 BSI L GNXTW LABEL. GET AND STORE APOV0293 RTE 28 APOV0294 SRA 4 APOV0295 STO SID03 SAVE TEN DIGIT APOV0296 SLT 28 APOV0297 SRA 12 APOV0298 M TEN APOV0299 SLT 24 FLOAT IT APOV0300 A SID03 APOV0301 LDX 1 8 NUMBER APOV0302 SLC 1 NORMALISE MANTISSA APOV0303 RTE 1 AND APOV0304 STD 3 6 SAVE APOV0305 LD H80 FROM APOV0306 A L 1 EXPONENT APOV0307 SRT 16 ADD IN APOV0308 AD 3 6 MANTISSA APOV0309 LD 3 5 GET ADDRESS OF APOV0310 BSI L ABSAD M ENTRY IN X1 APOV0311 LD 3 6 GET FLOATED LINE NUMBER APOV0312 STD 1 2 SAVE LINE NUMBER APOV0313 LD H0101 SAVE DIMENSIONS IN 2ND APOV0314 STO 1 1 WORD. 1ST WORD CONTAINS APOV0315 LD L 2 LABEL ENTRY ADDRESS AS APOV0316 AND H0FFF THE SYPTR AND INDICATE APOV0317 STO 1 0 SCALAR NUMBER APOV0318 MDX L LOCOR+5,4 ADVANCE M ENTRY POINTER APOV0319 BSI L GNXTW GET AND STORE FIRST APOV0320 STO 2 1 OF ENTRY APOV0321 BSI L GNXTW GET 2ND WORD OF ID APOV0322 STO 2 2 SAVE IDENTIFICATION IN APOV0323 MDX 2 3 ADVANCE LABEL ADDRESS APOV0324 MDX L LABCT,-1 COUNT LABELS APOV0325 MDX SLB01 GO TO GET NEXT LABEL APOV0326 * APOV0327 BSC I SLBST EXIT APOV0328 TEN DC 10 APOV0329 * SUBROUTINE TO GET IDS FROM DIRECTORY APOV0330 * AND STORE IT IN TOP OF STACK HEADER WITH APOV0331 * ZERO SYPTRS APOV0332 SIDST DC 0 APOV0333 STO SID03 SAVE COUNT OF IDS APOV0334 SID01 SRA 16 ZERO OUT M-POINTER IN APOV0335 STO 2 0 1ST WORD APOV0336 BSI L GNXTW GET 1ST WORD OF ID APOV0337 STO 2 1 ENTRY APOV0338 BSI L GNXTW GET 2ND WORD OF ID APOV0339 STO 2 2 SAVE IDENTIFICATION IN APOV0340 MDX 2 3 ADVANCE TO NEXT ENTRY APOV0341 MDX L SID03,-1 COUNT IDS APOV0342 MDX SID01 GO GET NEXT ID APOV0343 BSC I SIDST EXIT APOV0344 * APOV0345 SID03 EQU * APOV0346 * SUBROUTINE TO TRANSFER ARGUMENTS IF APOV0347 * NECESSARY APOV0348 SRAST DC 0 APOV0349 MDX 2 -6 SYPTRS APOV0350 LDX 1 2 2 ARGUMENTS APOV0351 SRA01 STX 1 SRA07+1 ARGUMENT COUNT APOV0352 LD L1 LARGL-1 BRANCH IF NO APOV0353 BSC L SRA05,+- MOVE REQUIRED APOV0354 SRA02 STO 3 6 SAVE WORDS TO BE MOVED APOV0355 LD L1 LARGA-1 GET ADDRESS OF THIS APOV0356 BSI L ABSAD ARGUMENT APOV0357 * APOV0358 STX 2 SRA06+1 APOV0359 LDX I2 LOCOR+5 ADDRESS OF NEXT M-ENTRY APOV0360 * APOV0361 * APOV0362 * APOV0363 SRA04 LDD 1 0 GET AND STORE APOV0364 STD 2 0 NEXT DOUBLE WORD APOV0365 MDX 1 2 ADVANCE ADDRESSES APOV0366 MDX 2 2 APOV0367 MDX L LOCOR+6,-2 COUNT WORDS APOV0368 MDX SRA04 BRANCH IF MORE APOV0369 LD 3 5 OLD M-ENTRY ADDRESS APOV0370 STX L2 LOCOR+5 SAVE NEW M-ENTRY APOV0371 SRA06 LDX L2 *-* ADDRESS OF ARGUMENT NTRY APOV0372 MDX SRA08 APOV0373 SRA05 LD L1 LARGA-1 ADDRESS OF DIRECT APOV0374 BSC L SRA07,+- APOV0375 * ARGUMENT APOV0376 SRA08 BSI L ABSAD CONVERT ADDRESS FRO APOV0377 STO 2 0 SAVING IN ARGUMENT SYPTR APOV0378 * APOV0379 LD L 2 BUILD SYPTR FOR STORING APOV0380 SRT 12 IN FIRST WORD OF ARGU- APOV0381 LD 1 0 MENT ENTRY APOV0382 SRA 12 APOV0383 SLT 12 APOV0384 STO 1 0 SAVE IT APOV0385 * APOV0386 SRA07 LDX L1 *-* RESTORE ARGUMENT COUNT APOV0387 MDX 2 3 ADVANCE TO NEXT ARG APOV0388 MDX 1 -1 COUNT ARGS APOV0389 MDX SRA01 GO GET NEXT IF MORE APOV0390 * APOV0391 BSC I SRAST EXIT APOV0392 HDNG MAX AND MIN EXECUTION APOV0393 * APOV0394 * DAMAX MAX AND MIN EXECUTION APOV0395 * THIS ROUTINE PERFORMS R= A MAX B OR APOV0396 * R= A MIN B. APOV0397 * IT BEGINS BY PERFORMING A FLOATING APOV0398 * SUBTRACT OF A AND B, FLIPPING THE SIGN OF APOV0399 * THE RESULT IF THE OPERATION IS MIN AND APOV0400 * THEN RETURNING A IF THE SIGN IS POSITIVE APOV0401 * AND B OTHERWISE. APOV0402 * REGISTERS ON ENTRY APOV0403 * R1=POINTER TO PLIST SET UP AS FOLLOWS APOV0404 * PLIST DC LARG APOV0405 * DC RARG APOV0406 * DC RESULT APOV0407 * * (ALL 1130 ADDRESSES) APOV0408 * DC 4(5) MAX (MIN) APOV0409 * REGISTERS ON EXIT APOV0410 * R1= UNCHANGED APOV0411 * R2,3 DESTROYED APOV0412 * APOV0413 DAMAX BSS 1 APOV0414 BSI L FSB FORM A-B APOV0415 LD 1 3 APOV0416 LDX 3 0 APOV0417 STO 3 2 SAVE FOR TEST APOV0418 LD I1 2 PICK UP FSB RESULT APOV0419 MDX 2 -4 OP NO. FOR MAX,MIN ARE 4,5 APOV0420 EOR RELC8 CHANGE SIGN IF MINUS APOV0421 LDX I2 1 XR2 .= XR1 APOV0422 BSC & TEST APOV0423 MDX 2 1 PICK UP SECOND ARG APOV0424 LD 2 0 PICK UP LOC OF RESULT APOV0425 STO 3 2 SAVE IN XR2 APOV0426 LDD 2 0 PUT RESULT IN M APOV0427 STD I1 2 APOV0428 BSC I DAMAX RETURN APOV0429 RELC8 DC /8000 APOV0430 HDNG RESIDUE EXECUTION APOV0431 * DARES RESIDUE EXECUTION APOV0432 * THIS ROUTINE PERFORMS R = A RES B APOV0433 * IT RETURNS AN EXACT RESULT FOR THE NUMBERS APOV0434 * THAT IT SEES. IT DOES THIS BY OBTAINING APOV0435 * AN EXACT REMAINDER IN A DIVIDE OF APOV0436 * ARBITRARY PRECISION WHICH IS IMPLEMENTED APOV0437 * AS A SHIFT AND SUBTRACT LOOP. APOV0438 * REGISTERS ON ENTRY APOV0439 * R1= POINTER TO PLIST SET UP AS FOLLOWS APOV0440 * PLIST DC LARG APOV0441 * DC RARG APOV0442 * DC RESULT APOV0443 * (ALL 1130 ADDRESSES) APOV0444 * APOV0445 * REGISTERS ON EXIT APOV0446 * R1= UNCHANGED APOV0447 * R3 AS IN FP PACKAGE APOV0448 * APOV0449 DARES BSS 1 APOV0450 LDX L3 AARG POINT XR3 TO AARG APOV0451 BSI L XTRCT PULL APART ARGUMENTS APOV0452 LDD 3 4 PICK UP ARG 1 APOV0453 BSC L RESN1,Z IS IT ZERO APOV0454 LD 3 2 YES. PICK UP SECOND ARG APOV0455 BSC L INDOM,+Z ERROR IF NEG APOV0456 MDX 3 -2 POINT XR3 TO BARG APOV0457 RSRET LD DARES PICK UP RETURN ADDRESS APOV0458 STO L EXIT&1 APOV0459 BSC L NLZE APOV0460 RESN1 BSC L *+2,- APOV0461 SLT 32 COMPLEMENT APOV0462 SD 3 4 AARG APOV0463 STD 3 4 STORE BACK IN AARG APOV0464 LDD 3 2 PICK UP BARG APOV0465 LDX 2 2 SET A FLAG APOV0466 BSC L RESN2,- TEST IF NEG APOV0467 SLT 32 YES. COMPLEMENT APOV0468 SD 3 2 SUBTRACT BARG APOV0469 LDX 2 1 AND SET FLAG PROPERLY APOV0470 RESN2 STD 3 2 SAVE IN BARG APOV0471 STX 2 FLAG&1 SAVE AS INDICATOR APOV0472 LD 3 6 PICK UP BEXPONENT APOV0473 S 3 8 SUBTRACT AEX APOV0474 BSC L RDONE,+Z APOV0475 STO L 2 SAVE IN XR2 AS COUNT APOV0476 LD 3 8 LOAD AEX APOV0477 STO 3 6 STORE IN BEX APOV0478 LDD 3 2 PICK UP NUMERATOR APOV0479 * THE FOLLOWING LOOP IS ESSENTIALLY A DIVIDE APOV0480 * IMPLEMENTED AS A SHIFT AND SUBTRACT LOOP. APOV0481 * SINCE WE DO NOT NEED THE QUOTIENT, IT IS NEVER APOV0482 * DEVELOPED APOV0483 RESN3 SD 3 4 SUBTRACT DENOMINATOR APOV0484 BSC C CARRY ON INDICATES OVERDRAW APOV0485 AD 3 4 CORRECT FOR OVERDRAW APOV0486 MDX 2 -1 APOV0487 MDX N4 INDX STILL POS, SO GO SHIFT APOV0488 MDX 2 0 WE'RE NOT THROUGH IF ZERO APOV0489 MDX FLAG ONLY IF NEGATIVE APOV0490 N4 SLT 1 APOV0491 MDX RESN3 APOV0492 RDONE LDD 3 2 LOAD BARG APOV0493 FLAG LDX L2 *-* PICK UP FLAG APOV0494 BSC Z IF RESULT ZERO, THEN SKIP APOV0495 MDX 2 -1 TEST FLAG APOV0496 MDX POS DONE APOV0497 STD 3 2 SAVE IN BARG APOV0498 LD DARES APOV0499 LDS 0 APOV0500 STO L EXIT&1 APOV0501 BSC L ENTR2 APOV0502 POS STD 3 4 SAVE IN AARG APOV0503 LD 3 6 PICK UP BEXPONENT APOV0504 STO 3 8 STORE IN AEXPONENT APOV0505 MDX RSRET NORMALIZE AND RETURN APOV0506 HDNG BASE REPRESENTATION APOV0507 * BREP BASE REPRESENTATION APOV0508 * THIS ROUTINE PERFORMS R=P REPR A APOV0509 * THE ALGORITHM USED EXISTS AS AN APL APOV0510 * PROGRAM IN THE WORKSPACE 224 APL1130 ON APOV0511 * THE MOD 50 UNDER THE NAME RP. APOV0512 * REGISTERS ON ENTRY APOV0513 * R1= POINTER TO PIN (1130 ADDRESS) APOV0514 * R2=SVI (1130 ADDRESS) APOV0515 * NOTE THAT THE MPTR OF R IS AT THE TOP APOV0516 * OF THE STACK (LC ADDRESS) APOV0517 * REGISTERS ON EXIT APOV0518 * ALL DESTROYED APOV0519 * APOV0520 BREP BSS 0 APOV0521 LD 1 7 XRHO OF LARG APOV0522 A REPK1 APOV0523 STO REPI I.=1+RHO P APOV0524 SLA 1 GET LENGTH OF LARG APOV0525 STO REPK APOV0526 LD 1 8 MPTR OF LARG APOV0527 A REPK LAST LOC OF LARG APOV0528 STO RLST1+1 WORK FROM BACK DOWN APOV0529 LD 1 9 MPTR OF RARG APOV0530 A REPK2 POINT TO FIRST ELEMENT APOV0531 STO RLST2+1 APOV0532 LD 1 13 PICK UP MPTR OF RESXULT APOV0533 A REPK POINT TO END OF IT APOV0534 STO PLST6&2 SAVE APOV0535 LDD RPONE APOV0536 STD REPJ J.=1 APOV0537 SLT 32 APOV0538 STD JR JR.=0 APOV0539 REPN9 MDX L PLST6+2,-2 APOV0540 MDX L RLST1+1,-2 APOV0541 MDX L REPI,-1 APOV0542 MDX REPN1 =.N1*0=I.=I-1 APOV0543 MDX UDONE APOV0544 REPN1 LDX L1 RLST1 APOV0545 BSI L FMP K.=J*LARG$(I$) APOV0546 LDX L1 RLST2 APOV0547 BSI L DARES KR.=K RES RARG APOV0548 LDX L1 PLST3 APOV0549 BSI L FSB KR.=KR-JR APOV0550 LD REPJ PICK UP J FOR SIGN TEST APOV0551 BSC L REPN5,- APOV0552 LDX L1 PLST4 KR.=KR*(1,-1)$(1+J LSS 0 $) APOV0553 BSI L MINUS APOV0554 REPN5 LDX L1 PLST5 APOV0555 BSI L DARES KR.=K RES KR APOV0556 LD REPJ APOV0557 BSC L N12,- APOV0558 LDX L1 PLST4 KR.=KR*(1,-1)$(1+J LSS 0$) APOV0559 BSI L MINUS APOV0560 N12 LDX L1 PLST6 APOV0561 BSI L FDV R.=(KR DIV J),R APOV0562 REPN7 LDX L1 PLST7 APOV0563 BSI L FAD JR.=KR+JR APOV0564 REPN8 LDX L1 PLST8 APOV0565 BSI L PLUS J.=K APOV0566 BSC L REPN9,Z =.N9*(0=J) RHO 1 APOV0567 SLT 32 APOV0568 LDX I1 PLST6&2 APOV0569 RPN11 LDX L2 *-* I STORED HERE APOV0570 REPI EQU RPN11+1 APOV0571 N13 MDX 1 -2 APOV0572 MDX 2 -1 APOV0573 MDX RPN10 R.=((I-1) RHO 0),R APOV0574 MDX DONE APOV0575 RPN10 STO 1 1 APOV0576 STO 1 0 APOV0577 MDX N13 APOV0578 REPK1 DC 1 APOV0579 REPK BSS E 2 APOV0580 RPONE DEC 1.0 APOV0581 REPJ BSS E 2 APOV0582 JR BSS E 2 APOV0583 KR BSS E 2 APOV0584 REPK2 DC 2 APOV0585 PLST8 DC REPK APOV0586 RLST1 DC REPJ APOV0587 DC MPTR OF LARG$(I$) APOV0588 PLST5 DC REPK APOV0589 PLST4 DC KR APOV0590 PLST3 DC KR APOV0591 PLST7 DC JR APOV0592 DC KR APOV0593 DC JR APOV0594 RLST2 DC REPK APOV0595 DC MPTR OF RARG APOV0596 PLST6 DC KR APOV0597 DC REPJ APOV0598 DC MPTR OF R (RESULT) APOV0599 HDNG BINARY EPSILON EXECUTION APOV0600 * BEPS BINARY EPSILON EXECUTION APOV0601 * THIS ROUTINE PERFORMS R= A EPSILON B APOV0602 * IT USES FSBN TO PERFORM A FUZZED SUBTRACT APOV0603 * TO TEST FOR EQUALITY AND THEN USES THIS APOV0604 * INFORMATION TO PLACE EITHER A 1 OR 0 IN APOV0605 * THE RESULT VECTOR. APOV0606 * REGISTERS ON ENTRY APOV0607 * R1=POINTER TO PIN (1130 ADDRESS) APOV0608 * R2=SVI (1130 ADDRESS) APOV0609 * NOTE THAT THE MPTR OF THE RESULT IS ON APOV0610 * THE TOP OF THE STACK (LC ADDRESS) APOV0611 * REGISTERS ON EXIT APOV0612 * R1,2,3 DESTROYED APOV0613 * RETURN IS TO GRP3 APOV0614 * APOV0615 BEPS BSS 0 APOV0616 LD 1 9 MPTR OF RARG APOV0617 STO EMPTR SAVE INTERNALLY APOV0618 LD 1 8 MPTR OF LARG APOV0619 STO EPLST+1 SAVE IN THE PLIST APOV0620 LD 1 13 APOV0621 STO EPRES SAVE IN RESULT APOV0622 LD 1 4 XRHO OF RARG APOV0623 A EPK1 ADD 1 APOV0624 STO EPCT STORE IN CGT APOV0625 LD 1 7 XRHO OF LARG APOV0626 A EPK1 ADD 1 APOV0627 STO ELCT ELCT IS NO. OF ELEMENTS IN APOV0628 * RESULT APOV0629 EPN5 MDX L EPRES,2 OUTER LOOP. STEP RESULT, APOV0630 MDX L EPLST+1,2 POINTER TO LARG, AND APOV0631 MDX L ELCT,-1 DECREMENT AND TEST ELCT. APOV0632 MDX EPN6 IF MORE GO TO N6 APOV0633 UDONE MDX DONE APOV0634 EPN6 LD EPCT RESET COUNT FOR INNER LOOP APOV0635 STO EPCNT APOV0636 LD EMPTR AND RESET MPTR OF RARG APOV0637 STO EPLST APOV0638 EPN3 MDX L EPLST,2 INNER LOOP. STEP POINTER APOV0639 * TO RARG, AND DECREMENT AND APOV0640 MDX L EPCNT,-1 TEST COUNT, APOV0641 MDX EPN1 APOV0642 SLT 32 CLEAR APOV0643 EPN4 STD I EPRES STORE RESULT APOV0644 MDX EPN5 STEP OUTER LOOP APOV0645 EPN1 LDX L1 EPLST SET UP POINTER TO PLIST APOV0646 BSI L FSBN RARG(I)-LARG(J) APOV0647 LD EPTMP PICK UP FIRST WORD OF RESULTAPOV0648 BSC L EPN3,Z WERE THE ARGUMENTS EQUAL APOV0649 EPON LDD EPONE YES. ANSEER IS 1,0 APOV0650 MDX EPN4 STORE AND THEN STEP OUTER APOV0651 * LOOP. APOV0652 EPLST DC POINTER TO RARG(I) APOV0653 DC POINTER TO LARG(J) APOV0654 DC EPTMP POINTER TO FSB RESULT APOV0655 EPTMP BSS 2 FSB RESULT APOV0656 EPRES BSS 1 POINTER TO RESULT VECTOR APOV0657 EPK1 DC 1 APOV0658 EPCT BSS 1 USED TO RESET INNER LOOP COUAPOV0659 EMPTR BSS 1 POINTER TO RARG APOV0660 ELCT BSS 1 COUNTER FOR OUTER LOOP. APOV0661 EPCNT BSS 1 COUNTER FOR INNTE LOOP APOV0662 EPONE DEC 1.0 APOV0663 HDNG BINARY IOTA EXECUTION APOV0664 * APOV0665 * BIOTA APOV0666 * THIS ROUTINE RETURNS R=A IOTA B APOV0667 * A AND B ARE PICKED UP VIA THEIR APOV0668 * M-POINTERS IN PIN. (1130 ADDRESSES) APOV0669 * MPTR OF R IS AT TOP OF STACK (LC ADDRESS) APOV0670 * REGISTERS ON ENTRY APOV0671 * R1=POINTER TO PIN (1130 ADDRESS) APOV0672 * R2=SVI (1130 ADDRESS) APOV0673 * REGISTER ON EXIT APOV0674 * ALL DESTROYED APOV0675 * ROUTINES CALLED APOV0676 * FSBN APOV0677 * FLT APOV0678 * THIS ROUTINE IS CALLED BY DOOP. APOV0679 * RETURN IS TO GRP3 APOV0680 * APOV0681 BIOTA LD 1 8 MPTR OF LARG APOV0682 STO MPTRL APOV0683 LD 1 9 MPTR OF RARG APOV0684 STO IOPL APOV0685 LD 1 7 XRHO OF LARG APOV0686 A IOK1 APOV0687 STO XRHOL APOV0688 LD 1 4 XRHO OF RARG APOV0689 A IOK1 APOV0690 STO XRHOR APOV0691 LD 2 0 MPTR OF RESULT APOV0692 OR IRELC RELOCATE INTO LC CORE APOV0693 STO IOPL2+1 APOV0694 STEPI MDX L IOPL,2 STEP I (OUTER LOOP) APOV0695 MDX L IOPL2+1,2 APOV0696 MDX L XRHOR,-1 COUNT AND TEST APOV0697 MDX ION2 APOV0698 DONE BSC L GRP3 APOV0699 ION2 SLA 16 CLEAR APOV0700 STO IOJ SAVE FOR RESULT APOV0701 LD XRHOL RESTORE CTR APOV0702 STO CTR APOV0703 LD MPTRL AND RESTORE MPTR APOV0704 STO IOPL+1 APOV0705 STEPJ MDX L IOPL+1,2 STEP J (INNER LOOP) APOV0706 MDX L IOJ,1 STEP RESULT APOV0707 MDX L CTR,-1 COUNT AND TEST APOV0708 MDX SUBTR APOV0709 MDX IOSTO APOV0710 SUBTR LDX L1 IOPL APOV0711 BSI L FSBN SUBTRACT AND FUZZ APOV0712 LD ITEMP PICK UP RESULT APOV0713 BSC L STEPJ,Z STEP INNER LOOP IF NONZERO APOV0714 IOSTO LDX L1 IOPL2 APOV0715 BSI L FLT FLOAT J FOR RESULT APOV0716 MDX STEPI STEP OUTER LOOP APOV0717 MPTRL DC APOV0718 XRHOL DC APOV0719 IRELC DC LOCOR APOV0720 IOPL DC RARG(I) APOV0721 DC LARG$(J$) APOV0722 DC ITEMP APOV0723 IOPL2 DC IOJ APOV0724 DC RSLT $(I$) APOV0725 XRHOR DC APOV0726 CTR DC APOV0727 ITEMP BSS 2 APOV0728 IOJ BSS 1 APOV0729 IOK1 DC 1 APOV0730 HDNG NATURAL LOGARITHM ROUTINE APOV0731 * FLN NATURAL LOGARITHM ROUTINE APOV0732 * THIS ROUTINE COMPUTES THE NATURAL APOV0733 * LOGARITHM OF A FLOATING POINT NUMBER AND APOV0734 * RETURNS THE RESULT IN STANDARD FLOATING APOV0735 * POINT FORMAT. THE ALGORITHM USED IS APOV0736 * IDENTICAL TO THE ONE USED IN THE 1130 APOV0737 * SUBROUTINE LIBRARY AND IS DESCRIBED IN APOV0738 * SRL C26-5929, 'IBM 1130 SUBROUTINE APOV0739 * LIBRARY', PG.45 UNDER THE HEADING STANDARD APOV0740 * PRECISION NATURAL LOGARITHM. APOV0741 * REGISTERS ON ENTRY APOV0742 * R1=POINTER TO PLIST APOV0743 * PLIST DC ARG APOV0744 * DC RESULT APOV0745 * (ALL 1130 ADDRESSES) APOV0746 * REGISTERS ON EXIT APOV0747 * R1= UNCHANGED APOV0748 * R2,3 DESTROYED APOV0749 FLN BSS 1 ENTRY FOR NATURAL LOG APOV0750 STX L1 SAVE&1 APOV0751 LDD I1 0 APOV0752 BSC L RNGER,& RANGE ERROR IF NOT PO S APOV0753 STD LNARG APOV0754 SLT 16 APOV0755 LLN1 LDS 0 CLEAR STATUS INDICATORS APOV0756 STS LNARG+1 CLEAR OUT EXPONENT APOV0757 EOR LNARG+1 PICK UP EXPONENT APOV0758 S LNK1 SUBTRACT OUT EXCESS APOV0759 STO LNK APOV0760 LD C130 PICK UP EXPONENT OF 2 APOV0761 STO FP1EX FP1 WILL BE B2 APOV0762 LDD LNARG PICK UP ARG FRACTION APOV0763 STD FM1 SAVE HERE TEMPORARILY APOV0764 SD SQRH COMPARE WITH SQRT (0.5) APOV0765 BSC L LN1,- APOV0766 LDD FM1 PICK UP FRACTION APOV0767 SLT 1 MULTIPLY BY 2 B-1 APOV0768 STD FM1 SAVE APOV0769 LD LNK PICK UP K APOV0770 S LNONE+1 SUBTRACT ONE APOV0771 STO LNK SAVE BACK APOV0772 LDD LNARG PICK UP FRACTION APOV0773 SRT 1 MAKE B2 APOV0774 MDX HERE COME TOGETHER APOV0775 LNARG DEC 0.0 APOV0776 SQRH DC /5A82 APOV0777 DC /799A 1.41421356B1 APOV0778 LNK1 DC 128 APOV0779 LNK BSS 1 APOV0780 FM1 DEC 0 APOV0781 FP1 DEC 0 ALSO Z APOV0782 FM1EX BSS 1 APOV0783 C130 DC 130 APOV0784 FP1EX BSS 1 APOV0785 * THE ABOVE 5 CARDS MUST BE IN THE ORDER SHOWN APOV0786 LN1 LDD LNARG APOV0787 SRT 2 MAKE B2 APOV0788 HERE A B2ONE APOV0789 STD FP1 SAVE AS FP1 B2 APOV0790 LD FM1 PICK UP FM1 APOV0791 EOR C8000 SUBTRACT ONE B-1 APOV0792 STO FM1 RESULT IS F-1 B0 APOV0793 LD LNK1 PICK UP EXPONENT OF ZERO APOV0794 STO FM1EX SAVE AS EXPONENT APOV0795 LDX L1 LADRG-2 THESE INSTRUCTIONS ARE THE APOV0796 LD ADBCK CALLING SEQUENCE FOR APOV0797 STO L EXIT&1 NORMALIZATION. THIS CALL APOV0798 LDX L3 FM1-4 NORMALIZES FM1 AND PUTS APOV0799 BSC L NLZE RESULT BACK INTO FM1. APOV0800 BCK LDX L1 ADZ-2 THIS CALL NORMALIZES APOV0801 LD ADBK2 FP1 AND PUTS THE RESULT APOV0802 STO L EXIT&1 INTO ARG APOV0803 LDX L3 FP1-4 APOV0804 BSC L NLZE APOV0805 BK2 LDX L1 LPL PICK UP LOC OF PLIST APOV0806 BSI L FDV Z.= (F-1)/(F&1) APOV0807 LD CSRT PICK UP A MODIFIED SRT APOV0808 S 3 8 SUBTRACT Z EXPONENT APOV0809 STO LSRT SAVE IN INSTRUCTION APOV0810 S CSRTR SAVE SOME TIME IF Z*Z ZERO APOV0811 BSC L *&2,& IF NOT ZERO, THEN BRANCH APOV0812 LDD LA0 ANSWER IS 2.0 APOV0813 MDX EPOL GO FINISH UP APOV0814 LDD 3 4 PICK UP Z SANS EXPONENT APOV0815 BSC &Z TEST IF NEGATIVE APOV0816 SD LNONE SEE NOTE IN FP PACKAGE APOV0817 LSRT SRT *-* SHIFT DOWN APOV0818 BSC &Z SEE NOTE IN FP PACKAGE APOV0819 AD LNONE CERTAINLY IS CRYPTIC APOV0820 STD LNARG SAVE APOV0821 BSI L XMDS DOUBLE LENGTH MULTIPLY APOV0822 DC LNARG APOV0823 DC LNARG APOV0824 STD LNARG APOV0825 SRT 10 0.25*Z*Z B4 APOV0826 AD A4 B4 APOV0827 STD FM1 SAVE TEMPORARILY APOV0828 BSI L XMDS DOUBLE LENGTH MULTIPLY APOV0829 DC LNARG APOV0830 DC FM1 APOV0831 AD LNA2 APOV0832 STD FM1 APOV0833 BSI L XMDS DOUBLE LENGTH MULTIPLY APOV0834 DC FM1 APOV0835 DC LNARG APOV0836 SRT 6 MULTIPLY RESULT IS B- 4 APOV0837 A LA0 SINCE A0 IS EXACT APOV0838 EPOL RTE 16 BRING IN LOW ORDER WORD APOV0839 AND LMASK APOV0840 OR C130 APOV0841 RTE 16 BRING INTO STANDARD FP FORM APOV0842 STD LNARG APOV0843 BSI L FMP Z.=ARG*Z APOV0844 MDX 1 -3 APOV0845 BSI L FLT APOV0846 MDX 1 2 APOV0847 BK3 BSI L FMP ARG.=ARG*LN 2 APOV0848 MDX 1 2 APOV0849 BSI L FAD Z.=Z&ARG APOV0850 SAVE LDX L1 *-* PICK UP XR1 APOV0851 LDD Z APOV0852 STD I1 1 APOV0853 BSC I FLN RETURN APOV0854 B2ONE EQU LLN1 APOV0855 C8000 DC /8000 APOV0856 LNONE DEC 1 APOV0857 ADBCK DC BCK APOV0858 ADBK2 DC BK2 APOV0859 DC LNK APOV0860 LADRG DC LNARG APOV0861 DC LN2 APOV0862 LPL DC LNARG APOV0863 DC Z APOV0864 ADZ DC Z APOV0865 * THE ABOVE 5 CARDS MUST BE IN THE ORDER SHOWN APOV0866 CSRT DC 128-2&/1880 APOV0867 CSRTR DC 16&/1880 APOV0868 BSS E 0 APOV0869 A4 DC /0337 APOV0870 DC /23A7 .4019234697B4 APOV0871 LNA2 DEC 0.66664413786B0 APOV0872 LA0 DC /4000 APOV0873 DC /0000 APOV0874 LMASK DC /FF00 APOV0875 C143 DC 143 APOV0876 LN2 DC /58B9 APOV0877 DC /0C80 0.6931471806599452 APOV0878 Z EQU FP1 APOV0879 HDNG BINARY EXPONENTIATION EXECUTION APOV0880 * BEXP BINARY EXPONENTIATION EXECUTION APOV0881 * THIS ROUTINE PERFORMS R= A EXP B APOV0882 * AFTER TRAPPING THE CASES OF NEGATIVE AND APOV0883 * ZERO BASE, THE ROUTINE PERFORMS A SEQUENCE APOV0884 * OF CALLS WHICH EXECUTES THE PROGRAM APOV0885 * R= EXP B TIMES LN A. APOV0886 * REGISTERS ON ENTRY APOV0887 * R1= POINTER TO A PLIST APOV0888 * PLIST DC LARG APOV0889 * DC RARG APOV0890 * DC RESULT APOV0891 * (ALL 1130 ADDRESSES) APOV0892 * NOTE THAT NEITHER THE ADDRESS OF LARG NOR APOV0893 * THE ADDRESS OF RARG MAY BE THE SAME AS THE APOV0894 * ADDRESS OF RESULT OR ERRONEOUS RESULTS APOV0895 * WILL OCCUR WITHOUT ANY ERROR INDICATION. APOV0896 * REGISTERS ON EXIT APOV0897 * ALL DESTROYED APOV0898 * APOV0899 BEXP BSS 1 APOV0900 LDD I1 0 SEE IF BASE IS ZERO APOV0901 BSC L TEST,+- APOV0902 STD L TOP IF NOT, SAVE IT APPROPRIATELAPOV0903 LD 1 1 SAVE RARG AND RESULT APOV0904 STO L SHLIS POINTERS IN NEW PLISTS APOV0905 LD 1 2 APOV0906 LDX L1 SHLIS+1 APOV0907 STO 1 SHLIS+4-SHLIS-1 APOV0908 BSI L ABS DIFNC .=ABS BASE APOV0909 LD 1 TOP-SHLIS-1 NOW IF THE BASE IS APOV0910 SLA 1 NEGATIVE, THE EXPONENT MUST APOV0911 STO 1 TOP-SHLIS-1 BE AN INTEGER AND ITS APOV0912 MDX 1 -1 PARITY DETERMINES THE SIGN APOV0913 BSI L UNFLT,C OF THE RESULT. APOV0914 LD 1 TOP-SHLIS SET NEGATING TRANSFER IF APOV0915 AND LNONE+1 EXPONENT ODD. APOV0916 STO TSFR+1 APOV0917 MDX 1 6 APOV0918 BSI L FLN TOP .= LN DIFNC APOV0919 MDX 1 -6 APOV0920 BSI L FMP DIFNC .= TOP X LARG APOV0921 MDX 1 2 APOV0922 BSI FEXP APOV0923 MDX 1 2 FEXP DECREASED XR1 BY 1 APOV0924 TSFR LDX L2 *-* APOV0925 BSI I2 SUBR APOV0926 XPXIT BSC I BEXP APOV0927 SUBR DC PLUS APOV0928 DC MINUS APOV0929 TEST LD I1 1 APOV0930 BSC L RNGER,+Z 0*-X APOV0931 BSI L FDV APOV0932 MDX XPXIT APOV0933 HDNG FLOATING POINT EXPONENTIAL ROUTINE APOV0934 * FEXP FLOATING NATURAL EXPONENTIATION APOV0935 * THIS ROUTINE PERFORMS R= EXP B APOV0936 * THE ALGORITHM USED IS DESCRIBED IN AN APOV0937 * ARTICLE IN THE COMMUNICATIONS OF THE ACM APOV0938 * JANUARY, 1967 VOL.10 NUMBER 1 ENTITLED APOV0939 * 'A NOTE ON COMPUTING APPROXIMATIONS TO THE APOV0940 * EXPONENTIAL FUNCTION' WRITTEN BY W.J. CODY APOV0941 * AND ANTHONY RALSTON. THE METHOD USED IS APOV0942 * IDENTIFIED IN THE ARTICLE AS METHOD 3. APOV0943 * REGISTERS ON ENTRY APOV0944 * R1=POINTER TO PLIST APOV0945 * PLIST DC RARG APOV0946 * DC RESULT APOV0947 * (ALL 1130 ADDRESSES) APOV0948 * REGISTERS ON EXIT APOV0949 * R1 DECREASED BY 1 APOV0950 * R2,3 DESTROYED APOV0951 * APOV0952 FEXP BSS 1 APOV0953 LD FEXP PICK UP RETURN ADDRESS APOV0954 STO L EXIT&1 SAVE FOR RETURN APOV0955 LDX L3 EARG-4 SET UP POINTER TO RESULT APOV0956 MDX 1 -1 CAUSE C%XR1<&2 TO BE RESULT APOV0957 * POINTER APOV0958 LDD I1 1 APOV0959 STD EARG APOV0960 SLT 16 APOV0961 LDS 0 CLEAR STATUS APOV0962 STS EARG+1 CLEAR OUT EXPONENT APOV0963 EOR EARG+1 PICK OUT EXPONENT APOV0964 S K106 SUBTRACT 127-23 APOV0965 BSC L ONE,+Z ABS A LSS 2*-23 APOV0966 STO AAEX SAVE AS EXPONENT APOV0967 BSI L XMDS ARG=ARG*LOGE(BASE 2) APOV0968 DC EARG LOC OF FRACTION APOV0969 DC LOGE LOGE(BASE 2) B1 APOV0970 STD EARG APOV0971 LD AAEX PICK UP EXPONENT APOV0972 S K30 APOV0973 BSC L EXERR,- APOV0974 A K9 APOV0975 * BUT REMEMBER FRACTION IS B1 APOV0976 BSC L SLT,-Z DO WE HAVE AN INTEGER PART APOV0977 EOR ALL1S COMPLEMENT APOV0978 A SRT1A MAKE INTO AN INSTRUCTION APOV0979 STO ESRT SAVE AS INSTRUCTION APOV0980 LD K130 APOV0981 STO AAEX RESULT IS B2 APOV0982 LDD EARG PICK UP ARGUMENT APOV0983 ESRT SRT 2 INSTRUCTION IS MODIFIED APOV0984 MDX TWOEX COMPUTE 2**ARG APOV0985 SLT STO L 2 SAVE FOR SHIFTS APOV0986 LD EARG APOV0987 SRT 15 SHIFT DOWN APOV0988 SLT 2 PICK UP INTEGER PART APOV0989 A K130 APOV0990 STO AAEX SAVE AS EXPONENT APOV0991 LDD EARG PICK UPARG APOV0992 SLT 2 PICK UP FRACTION APOV0993 AND EMASK CLEAR SIGN POSITION APOV0994 TWOEX STD EARG APOV0995 BSI L XMDS MULTIPLY APOV0996 DC EARG APOV0997 DC EARG APOV0998 SRT 7 B7 APOV0999 AD B1 B1&ARG*ARG B7 APOV1000 STD EXTMP APOV1001 BSI L XDDS A1/(B1&ARG*ARG) B5 APOV1002 DC A1 B11 APOV1003 ADTMP DC EXTMP APOV1004 STD EXTMP APOV1005 SLT 32 CLEAR APOV1006 SD EARG APOV1007 SRT 5 B5 APOV1008 SD EXTMP APOV1009 AD EA0 APOV1010 SLT 3 B2 APOV1011 STD EXTMP APOV1012 BSI L XDDS ARG/(A0- AG-A1/(B1&ARG*ARG)) B-4 APOV1013 DC EARG APOV1014 DC EXTMP APOV1015 SRT 2 MULTIPLY BY 2 B2 APOV1016 BSC O APOV1017 LDD K12 APOV1018 AD K12 1&2*ARG/(A0-ARG-A1/(B1&ARG*ARG)) APOV1019 STD EARG APOV1020 BSC L NLZE NORMALIZE AND RETURN APOV1021 EXERR LD EARG APOV1022 BSC L CLEAR,&Z APOV1023 EERR BSC L RNGER APOV1024 B1 DEC 125.6356487B7 APOV1025 A1 DEC 1823.432016B11 APOV1026 EA0 DEC 17.39904188B5 APOV1027 K12 DEC 1.0B2 APOV1028 LOGE DEC 1.442695041B1 APOV1029 EARG DEC 0 APOV1030 EXTMP DEC 0 APOV1031 AAEX BSS 1 APOV1032 * THE ABOVE 3 CARDS MUST NOT BE OUT OF ORDER APOV1033 K106 DC 106 APOV1034 K30 DC 30 APOV1035 K9 DC 9 APOV1036 SRT1A SRT 1 APOV1037 K130 DC 130 APOV1038 EMASK DC /7FFF APOV1039 ALL1S DC /FFFF APOV1040 HDNG ** BASE VALUE APOV1041 * MONADIC BASE VALUE APOV1042 * CALLED FORM OPERATOR CONTROL WITH R1 APOV1043 * POINTING TO PIN APOV1044 DBASE BSS 0 APOV1045 LD 1 XLARG-PIN APOV1046 EOR VL1 IS LEFT ARG SCALAR -- APOV1047 BSC L LMCH,&- APOV1048 LD 1 XRARG-PIN NO. DOES IT MATCH RT ARG -- APOV1049 EOR 1 XLARG-PIN APOV1050 BSC L LGTER,Z APOV1051 LMCH LD 1 MRSLT-PIN APOV1052 A VL2 APOV1053 STO 1 2 SETTING UP PLIST AT PIN FOR APOV1054 STO 1 1 FAD AND FMP APOV1055 SLT 32 APOV1056 STD I1 1 SET RESULT TO 0 APOV1057 VL1 EQU *-1 APOV1058 LEAP LD 1 XRARG-PIN ANY ELEMENTS LEFT IN THE APOV1059 S VL1 RIGHT ARGUMENT -- APOV1060 STO 1 XRARG-PIN APOV1061 BSC L GRP3,+Z APOV1062 LDD 1 XLARG-PIN GET XLARG AND MLARG APOV1063 S VL1 APOV1064 STO 1 XLARG-PIN APOV1065 SLA 1 APOV1066 RTE 16 APOV1067 BSC L SCLEF,C IF XLARG IS NEG, HAD A APOV1068 A VL2 SCALAR LEFT ARGUMENT APOV1069 STO 1 MLARG-PIN OTH, CHANGE LEFT ARG PTR APOV1070 SCLEF STO 1 PIN-PIN APOV1071 BSI L FMP APOV1072 LD 1 MRARG-PIN APOV1073 A VL2 APOV1074 STO 1 MRARG-PIN APOV1075 STO 1 PIN-PIN APOV1076 BSI L FAD APOV1077 MDX LEAP APOV1078 HDNG ** MONADIC QUERY APOV1079 * MONADIC QUERY APOV1080 * QUERY N SELECTS AN ELEMENT AT RANDOM APOV1081 * FROM IOTA N. SUCCESSIVE 31 BIT RANDOM APOV1082 * NUMBERS ARE GENERATED BY THE RELATION APOV1083 * R IS P RES M TIMES R WHERE P IS THE PRIME APOV1084 * -1-2*31 AND M IS A PRIMITIVE ROOT. APOV1085 * CONSIDERING R TO BE IN (0,1), THE RETURNED VALUE APOV1086 * IS CEIL R TIMES N. N MUST BE IN (0,2*15) AND APOV1087 * INTEGRAL APOV1088 QUERY DC *-* APOV1089 LDX L2 RAND SET UP BASE REGISTER APOV1090 LD 2 1 APOV1091 M MULPR APOV1092 BSC +Z APOV1093 A MULPR APOV1094 STO LZER+1 APOV1095 STD 1 UTEMP-UPL THE POSITIVE PROD OF M APOV1096 LD 2 AND LOW ORDER R APOV1097 M MULPR APOV1098 AD LZER ACC,EXT,TEMP+1 IS THE FULL APOV1099 SLT 1 PRODUCT OF M AND R. SPLIT ITAPOV1100 A 1 UTEMP-UPL+1 INTO LOW ORDER 31 BITS ANDAPOV1101 BSC C REST, ADD THEM, AND APOV1102 AD DBL2 PROPAGATE CARRY INTO LOW ENDAPOV1103 RTE 16 STRAIGHTEN OUT THE RESULT APOV1104 SRA 1 APOV1105 STD 2 APOV1106 BSI L UNFLT APOV1107 LD 1 UTEMP-UPL APOV1108 BSC L INDOM,+ ERROR IF 0 APOV1109 M 2 1 APOV1110 BSC +Z APOV1111 A 1 UTEMP-UPL APOV1112 STO LZER+1 APOV1113 LD 1 UTEMP-UPL APOV1114 M 2 APOV1115 AD LZER APOV1116 SLT 1 APOV1117 A 1 UK1-UPL APOV1118 STO 1 UTEMP-UPL APOV1119 LDX L1 PULSE APOV1120 BSI L FLT APOV1121 BSC I QUERY APOV1122 PULSE DC UTEMP APOV1123 DC UTEMP APOV1124 BSS E APOV1125 LZER DC APOV1126 BSS E APOV1127 DBL2 DC APOV1128 VL2 DC 2 APOV1129 MULPR DC 16807 7*5 APOV1130 HDNG ** DYADIC SHRIEK APOV1131 * CALCULATES BINOMIAL COEFFICIENTS APOV1132 * ON ENTRY, R1 POINTS TO PLIST.. APOV1133 * PLIST DC LARG APOV1134 * DC RARG APOV1135 * DC RESULT APOV1136 * ON EXIT, ALL REGISTERS ARE DESTROYED APOV1137 * A DOMAIN ERROR OCCURS IF RARG-LARG ISN'T AN APOV1138 * INTEGER. APOV1139 COMBN DC *-* APOV1140 LD 1 1 GET RIGHT ARG PTR FOR PLIST APOV1141 STO SHLIS APOV1142 LD 1 2 GET RESULT PTR APOV1143 STO SHLIS+4 APOV1144 LDD I1 PICK UP LEFT ARG APOV1145 STD TOP APOV1146 LDD L IDEN1 SET RESULT AND DENOMINATOR APOV1147 STD BOTM APOV1148 STD I1 2 TO 1.0. APOV1149 LDX L1 SHLIS SET POINTER TO PLIST APOV1150 BSI L FSBN APOV1151 LDD DIFNC IF LARG GTR RARG, APOV1152 BSC + USE RARG-LARG INSTEAD OF APOV1153 STD TOP LARG APOV1154 OPRAT BSI L FSBN GET DIFFERENCE TO SEE IF DONAPOV1155 LDD DIFNC APOV1156 BSC L INDOM,+Z DIFFERENCE WASN'T INTEGER APOV1157 BSC I COMBN,+ EXIT IF DIFFERENCE 0 APOV1158 MDX 1 7 MOVE TO NEXT OPERATION APOV1159 BSI L FAD INCREMENT TOP BY 1 APOV1160 MDX 1 -3 APOV1161 BSI L FMP MULTIPLY RESULT BY IT APOV1162 MDX 1 -2 APOV1163 BSI L FDV DIVIDE RESLT BY BOTM APOV1164 MDX 1 9 APOV1165 BSI L FAD INCREMENT BOTM BY 1.0 APOV1166 MDX 1 SHLIS-BTINC RESET INDEX TO SHLIS APOV1167 MDX OPRAT APOV1168 * SHLIS USED ALSO BY MONADIC SHRIEK, BEXP APOV1169 SHLIS DC RIGHT ARG XR1 PTS HERE FOR SUBTRACT APOV1170 DC TOP APOV1171 DC DIFNC HERE FOR DIVIDE APOV1172 DC BOTM APOV1173 DC RESULT HERE FOR MULTIPLY APOV1174 DC TOP APOV1175 DC DIFNC APOV1176 DC TOP HERE TO INCREMENT TOP APOV1177 DC IDEN1 APOV1178 DC TOP HERE BY FACTO TO MULTIPLY APOV1179 DC BOTM USED ONLY BY FACTO APOV1180 BTINC DC BOTM HERE TO INCREMENT BOTM APOV1181 DC IDEN1 APOV1182 DC BOTM APOV1183 TOP BSS E 2 APOV1184 BOTM BSS E 2 APOV1185 DIFNC BSS E 2 APOV1186 HDNG ** FACTORIAL APOV1187 * ARGUMENT MUST BE WITHIN FUZZ OF A NON-NEGATIVE APOV1188 * INTEGER. DOMAIN ERROR IF THE MULTIPLY OVERFLOWS.APOV1189 FACTO DC *-* APOV1190 BSI L UNFLT APOV1191 LDD L IDEN1 APOV1192 STD TOP MULTIPLIER APOV1193 STD BOTM APOV1194 SHRIK MDX L UTEMP,-1 SKIP IF DONE APOV1195 MDX MLMR APOV1196 LDD BOTM IN WHICH CASE MOVE BOTM APOV1197 STD L UTEMP TO ANSWER SPACE APOV1198 BSC I FACTO AND EXIT. APOV1199 MLMR LDX L1 SHLIS+7 NOT DONE. APOV1200 BSI L FAD INCREMENT TOP APOV1201 MDX 1 2 AND MULTIPLY PARTIAL APOV1202 BSI L FMP RESULT BY IT APOV1203 MDX SHRIK APOV1204 LNGTH EQU *-ASMES APOV1205 HDNG STATES,CLASSES AND BASIC SYMBOL TABLE APOV1206 ORG ASMES+/457 APOV1207 * APOV1208 * STATES APOV1209 * APOV1210 OPNS EQU 128 APOV1211 SLHS EQU 64 APOV1212 LARS EQU 32 APOV1213 SMCS EQU 16 APOV1214 OPSS EQU 8 APOV1215 RARS EQU 4 APOV1216 RBRS EQU 2 APOV1217 RPAS EQU 1 APOV1218 NILS EQU 1 APOV1219 * APOV1220 * CLASSES APOV1221 * APOV1222 OPNCL EQU /1000 APOV1223 OPSCL EQU /2000 APOV1224 LPRCL EQU /3000 APOV1225 LBRCL EQU /4000 APOV1226 RPRCL EQU /5000 APOV1227 RBRCL EQU /6000 APOV1228 LARCL EQU /7000 APOV1229 SMCCL EQU /8000 APOV1230 SLHCL EQU /9000 APOV1231 CLNCL EQU /A000 APOV1232 PDCLS EQU /B000 APOV1233 DFOCL EQU /C000 APOV1234 CONCL EQU /D000 APOV1235 DFNCL EQU /E000 APOV1236 BOXCL EQU /F000 APOV1237 ERRCL EQU OPSCL+32*8 APOV1238 TMPCL EQU OPNCL APOV1239 * APOV1240 * APOV1241 * APOV1242 BSTBL EQU * APOV1243 DC CLNCL META-COLON APOV1244 DC ERRCL DEL-TILDE APOV1245 DC OPSCL+32*0+9 SHRIEK APOV1246 DC BOXCL+2 QUAD-PRIME APOV1247 DC SLHCL+3 COLUMN BACKSLASH APOV1248 DC SLHCL+2 COLUMN SLASH APOV1249 DC OPSCL+32*0+10 LOG APOV1250 DC OPSCL+32*4+0 TRANSPOSE APOV1251 DC OPSCL+32*5+2 COLUMN REVERSAL APOV1252 DC OPSCL+32*5+0 REVERSAL APOV1253 DC CLNCL COLON APOV1254 DC SMCCL SEMI-COLON APOV1255 DC RPRCL RIGHT PARENTHSIS APOV1256 DC LPRCL LEFT PARENTHESIS APOV1257 DC OPSCL+32*6+0 RIGHT ARROW APOV1258 DC OPSCL+32*0+8 DIVIDE APOV1259 DC OPSCL+32*0+3 MINUS APOV1260 DC SLHCL+1 BACK SLASH APOV1261 DC OPSCL+32*0+13 OR APOV1262 DC OPSCL+32*0+19 NOT EQUAL APOV1263 DC OPSCL+32*0+18 GREATER APOV1264 DC OPSCL+32*0+17 GREATER OR EQUAL APOV1265 DC OPSCL+32*0+16 EQUAL APOV1266 DC OPSCL+32*0+15 LESS OR EQUAL APOV1267 DC OPSCL+32*0+14 LESS APOV1268 DC ERRCL NEGATE (HIGH MINUS) APOV1269 DC ERRCL UMLAUT (DIERESIS) APOV1270 DC OPSCL+32*0+12 AND APOV1271 DC ERRCL BACK HORSESHOE APOV1272 DC OPSCL+32*10+0 UP ARROW APOV1273 DC ERRCL HORSESHOE APOV1274 DC ERRCL OMEGA APOV1275 DC ERRCL CUP APOV1276 DC OPSCL+32*10+1 DOWN ARROW APOV1277 DC OPSCL+32*0+0 TILDE APOV1278 DC OPSCL+32*0+4 CEILING APOV1279 DC OPSCL+32*2+0 RHO APOV1280 DC OPSCL+32*7+11 QUERY APOV1281 DC OPSCL+32*0+1 EXPONENTIATE APOV1282 DC ERRCL CIRCLE APOV1283 DC OPSCL+32*11+0 REPRESENTATION APOV1284 DC OPSCL+32*0+6 RESIDUE APOV1285 DC BOXCL+1 QUAD APOV1286 DC ERRCL QUOTE APOV1287 DC OPSCL+32*1+1 NULL APOV1288 DC OPSCL+32*1+0 IOTA APOV1289 DC ERRCL DELTA APOV1290 DC ERRCL DEL APOV1291 DC ERRCL UNDERBAR APOV1292 DC OPSCL+32*9+0 EPSILON APOV1293 DC OPSCL+32*0+5 FLOOR APOV1294 DC ERRCL CAP APOV1295 DC OPSCL+32*12+0 BASE APOV1296 DC ERRCL ALPHA APOV1297 DC PDCLS PERIOD APOV1298 DC OPSCL+32*3+0 COMMA APOV1299 DC RBRCL RIGHT BRACKET APOV1300 DC LBRCL LEFT BRACKET APOV1301 DC LARCL LEFT ARROW APOV1302 DC OPSCL+32*0+7 MULTIPLICATION APOV1303 DC OPSCL+32*0+2 PLUS APOV1304 DC SLHCL+0 SLASH APOV1305 DC CONCL+4 CHARACTER CONSTANT APOV1306 DC CONCL+0 NUMERIC CONSTANT APOV1307 HDNG WRITE ASSEMBLY TO DISK APOV1308 START LDX L1 ASMES-2 APOV1309 BSI DSKIO APOV1310 EXIT APOV1311 DSKIO DC 0 APOV1312 STX 1 DSKI1 APOV1313 STX 1 DSKI3 APOV1314 LIBF DISK1 APOV1315 DC /3000 APOV1316 DSKI1 DC 0 APOV1317 DC DSKI4 APOV1318 DSKI2 LIBF DISK1 APOV1319 DC /0000 APOV1320 DSKI3 DC 0 APOV1321 MDX DSKI2 APOV1322 BSC I DSKIO APOV1323 DSKI4 WAIT APOV1324 BSC I DSKIO APOV1325 END START APOV1326 // XEQ L 1 APOV1327 // JOB APPH0001 // ASM APPH0002 *PRINT SYMBOL TABLE APPH0003 *LIST APPH0004 HDNG PREPROLOGUE TO PUNCH ASSEMBLY APPH0005 ABS APPH0006 * DISK ADDRESSES APPH0007 LCDBS EQU /280 APPH0008 TMTRK EQU LCDBS+/1A APPH0009 TMTRX EQU LCDBS+/6E APPH0010 DAPCH EQU LCDBS+/39 APPH0011 * ORIGINS OF THIS AND OTHER ASSEMBLIES APPH0012 ASMPH EQU /730 APPH0013 ASMDK EQU /0 APPH0014 ASMCT EQU /21E APPH0015 ASMIN EQU /730 APPH0016 ASMED EQU /18D1 APPH0017 * OVERLAY NUMBER OF THIS ASSEMBLY APPH0018 PCHOV EQU 12 APPH0019 * IMPORTANT ADDRESSES APPH0020 FOUND EQU /F9F APPH0021 CLASS EQU /FA0 APPH0022 PARAM EQU /FA2 APPH0023 LOCOR EQU /1000 APPH0024 MATRX EQU /1011 APPH0025 NUMGL EQU /1012 APPH0026 PAREL EQU /1017 APPH0027 GLBTB EQU /1036 APPH0028 TAREA EQU /1F79 APPH0029 MODE EQU /1FF4 APPH0030 ATTN EQU /1FF8 APPH0031 CHRCT EQU /1FF9 APPH0032 * ADDRESSES IN CTRAY ASSEMBLY APPH0033 CDSW EQU ASMCT+/0 APPH0034 ADABS EQU ASMCT+/A8 APPH0035 GSYL EQU ASMCT+/DE APPH0036 TYPE EQU ASMCT+/1A9 APPH0037 TYNCH EQU ASMCT+/1B4 APPH0038 MVCRG EQU ASMCT+/1C3 APPH0039 PRCRT EQU ASMCT+/1D1 APPH0040 PRNID EQU ASMCT+/1E3 APPH0041 UNPK EQU ASMCT+/1F0 APPH0042 SGBTB EQU ASMCT+/207 APPH0043 TSTUT EQU ASMCT+/4EE APPH0044 * ADDRESSES IN EDIT ASSEMBLY APPH0045 R13 EQU ASMED+/A6 APPH0046 R14 EQU ASMED+/A7 APPH0047 * ADDRESSES IN DISK I/O ASSEMBLY APPH0048 DKORG EQU ASMDK+/2C APPH0049 * ADDRESSES IN INPUT ASSEMBLY APPH0050 TABLE EQU ASMIN+/75D APPH0051 PHCHR EQU ASMIN+/7C1 APPH0052 PHCNT EQU ASMIN+/7E1 APPH0053 NXTPH EQU ASMIN+/7E2 APPH0054 CHECK EQU ASMIN+/838 APPH0055 * ADDRESSES USED IN OTHER ASSEMBLIES APPH0056 DC PUNCH-ASMPH APPH0057 DC PNCHA-ASMPH APPH0058 DC FNDSP-ASMPH APPH0059 DC ERROR-ASMPH APPH0060 * LENGTH OF THIS ASSEMBLY APPH0061 DC LNGTH APPH0062 ORG ASMPH-2 APPH0063 DC 6*/140 APPH0064 DC DAPCH APPH0065 DC PCHOV APPH0066 HDNG ENTRY POINTS APPH0067 PUNCH DC 0 APPH0068 BSC L SPNCH APPH0069 PNCHA DC 0 APPH0070 BSC L SPCHA APPH0071 FNDSP DC 0 APPH0072 BSC L SFDSP START FUNCTION DISPLAY EXAPPH0073 ERROR DC 0 APPH0074 BSC L SERRR APPH0075 HDNG INTERNAL SYMBOLS AND LOCATIONS APPH0076 PARID EQU PARAM+10 APPH0077 CODE1 EQU /1791 APPH0078 LINC EQU -51 APPH0079 TLNC EQU 26*/140 APPH0080 DSPB EQU TABLE APPH0081 * APPH0082 CPLUS DC /26 APPH0083 CLAR DC /28 APPH0084 CLBR DC /29 APPH0085 CRBR DC /2A APPH0086 CPD DC /2C APPH0087 CIOTA DC /35 APPH0088 CRHO DC /3E APPH0089 CSMIC DC /57 APPH0090 CBL DC /78 APPH0091 CZERO DC /1B APPH0092 * APPH0093 A EQU 1 APPH0094 B EQU 2 APPH0095 C EQU 3 APPH0096 D EQU 4 APPH0097 E EQU 5 APPH0098 F EQU 6 APPH0099 G EQU 7 APPH0100 H EQU 8 APPH0101 I EQU 9 APPH0102 J EQU 10 APPH0103 K EQU 11 APPH0104 L EQU 12 APPH0105 M EQU 13 APPH0106 N EQU 14 APPH0107 O EQU 15 APPH0108 P EQU 16 APPH0109 Q EQU 17 APPH0110 R EQU 18 APPH0111 S EQU 19 APPH0112 T EQU 20 APPH0113 U EQU 21 APPH0114 V EQU 22 APPH0115 W EQU 23 APPH0116 X EQU 24 APPH0117 Y EQU 25 APPH0118 Z EQU 26 APPH0119 SPC EQU 38 SPACE APPH0120 P1 EQU 1600 APPH0121 P2 EQU 40 APPH0122 ERM EQU /8000 CAUSES PRINTING OF ERROR APPH0123 FTH EQU /4000 CAUSES DISPLAY OF LINE APPH0124 HDNG PUNCH VARIABLE APPH0125 * PUNCH VARIABLE WHOSE MPTR IS IN X1 ON ENTRY APPH0126 PVARB DC 0 APPH0127 BSI L ADABS ACC AND X2 PT MENTRY APPH0128 LD 1 0 APPH0129 SLA 1 ISOLATE TYPE APPH0130 SRT 15 CH DATA -1, NUMBERS 0 APPH0131 LDX L3 DTYPE BASE ADDRESS APPH0132 STO 3 DTYPE-DTYPE APPH0133 SRA 16 APPH0134 STO L CDNUM INITIALIZE CARD SEQUENCING APPH0135 SLT 2 ISOLATE RANK. 0 SCALAR, 1 VECAPPH0136 STO 3 RANK-DTYPE APPH0137 SLT 32 APPH0138 LD 1 1 LOAD RANK VECTOR APPH0139 RTE 8 ISOLATE COLUMN DIMENSION APPH0140 STO 3 CDIM-DTYPE APPH0141 SRA 8 APPH0142 SLT 8 ISOLATE ROW DIMENSION APPH0143 STO 3 RDIM-DTYPE APPH0144 MDX 1 2 ADVANCE TO FIRST FLOATING POIAPPH0145 STX 1 FPPTR STO POINTER TO FP APPH0146 * PASS DIMENSION SPECIFICATION CARD APPH0147 LD RANK APPH0148 BSC L SCAL1,+ NO DIMENSION CARD IF SCALAR APPH0149 LDX 2 6 PUNCH 6 CHAR ID APPH0150 BSI L PNOBJ PUNCH FULL OBJECT NAME APPH0151 LDX L1 CLAR APPH0152 BSI L PHCHR PUNCH LEFT ARRAW APPH0153 LD RANK APPH0154 S VAL1 APPH0155 BSC L VECT1,+- NO ROW IF VECTOR APPH0156 LD CDIM APPH0157 BSI L PNDCN PUNCH COLUMN DIMENSION APPH0158 LDX L1 CBL APPH0159 BSI L PHCHR PUNCH BLANK APPH0160 VECT1 LD RDIM APPH0161 BSI L PNDCN PUNCH ROW DIMENSION APPH0162 LDX L1 CRHO APPH0163 BSI L PHCHR PUNCH RHO APPH0164 BSI L PHCQT APPH0165 BSI L SINGL CHECK FOR SINGLE VALUE APPH0166 LD DTYPE CHACK DATA TYPE APPH0167 LDX L1 CZERO ASSUME NUMERIC APPH0168 BSC Z SKIP IF IT IS APPH0169 MDX 1 CBL-CZERO ITS A CHARACTER APPH0170 BSI L PHCHR PUNCH CHARACTER APPH0171 BSI L PHCQT PUNCH QUOTE IF CHAR APPH0172 LDX 2 8 ARG FOR LEAVING 8 COLUMNS APPH0173 BSI L PNBL PUNCH BLANKS TILL 8 LEFT APPH0174 BSI L PSEQ PUNCH SEQUENCE FIELD APPH0175 LD RDIM APPH0176 BSC I PVARB,+- DONE IF 0 COLUMNS APPH0177 LD CDIM APPH0178 BSC I PVARB,+- DONE IF 0 ROWS APPH0179 SCAL1 SRA 16 APPH0180 STO RP ROW CURRENTLY BEING PUNCHED APPH0181 MTRXR MDX L RP,1 APPH0182 LD RDIM APPH0183 STO RWELC COUNT OF ELS LEFT THIS ROAPPH0184 SRA 16 APPH0185 STO CS INDEX FIRST EL THIS ROW _APPH0186 VECTR SRA 16 APPH0187 STO CP NUMBER OF ELS THIS ROW APPH0188 * NEXT COMES PNCRD (I.E. PUNCH SPEC. FIELD) APPH0189 PNCRD LDX 2 6 APPH0190 BSI L PNOBJ PUNCH FULL OBJECT NAME APPH0191 LD RANK APPH0192 BSC L SCAL2,+- NO INDEXES IF SCALAR APPH0193 LDX L1 CLBR APPH0194 BSI L PHCHR PUNCH LEFT BRACKET APPH0195 LD RANK APPH0196 S VAL1 APPH0197 BSC L VECT2,+- NO ROW INDEX IF VECTOR APPH0198 LD RP APPH0199 BSI L PNDCN PUNCH ROW INDEX APPH0200 LDX L1 CSMIC APPH0201 BSI L PHCHR PUNCH SEMI COLON APPH0202 VECT2 LD CS APPH0203 BSC L NOCS,+- SKIP IF CS IS ZERO APPH0204 BSI L PNDCN PUNCH INDEX OF LAST ELEMENT OAPPH0205 LDX L1 CPLUS APPH0206 BSI L PHCHR APPH0207 NOCS LDX L1 CIOTA APPH0208 BSI L PHCHR PUNCH IOTA APPH0209 LDX L1 CBL APPH0210 BSI L PHCHR PUNCH BLANK APPH0211 LD L NXTPH LEAVE 2 BLANKS FOR CP APPH0212 STO CPLOC LOCATION FOR INSERTING CP APPH0213 LDX L1 CBL APPH0214 BSI L PHCHR PUNCH BLANK APPH0215 LDX L1 CRBR APPH0216 BSI L PHCHR PUNCH RIGHT BRACKET APPH0217 SCAL2 LDX L1 CLAR APPH0218 BSI L PHCHR PUNCH SPEC ARROW APPH0219 BSI L PHCQT PUNCH QUOTE IFF CHAR DATA APPH0220 MDX GTELS GO TO GET ELEMENTS APPH0221 RANK DC 0 APPH0222 DTYPE DC 0 APPH0223 FPPTR DC 0 APPH0224 CDIM DC 0 APPH0225 RDIM DC 0 APPH0226 RWELC DC 0 APPH0227 CPLOC DC 0 APPH0228 CP DC 0 APPH0229 CS DC 0 APPH0230 RP DC 0 APPH0231 VAL1 DC 1 APPH0232 GTELS LD L PHCNT NUMBER OF PUNCH COLS LEFT APPH0233 STO EMTY APPH0234 MDX L EMTY,-9 EMTY # COLS FOR ELS APPH0235 FPBEG LD DTYPE APPH0236 LDX I2 FPPTR XI APPH0237 BSC L VARB2,- APPH0238 LD VAL1 APPH0239 STO RHOQ APPH0240 LD 2 0 APPH0241 AND X00FF APPH0242 LDX L1 QBUF APPH0243 STO 1 0 APPH0244 STO 1 1 STORE TWICE ON SPECULATION APPH0245 S L CQT THAT THE CHAR IS A QUOTE APPH0246 BSC L *+2,Z NOT APPH0247 MDX L RHOQ,1 IS. SET STRING LENGTH TO 2.APPH0248 LD EMTY APPH0249 S VAL3 APPH0250 BSC L CHDA1,+Z APPH0251 LD EMTY BUMP EMPTY COUNT APPH0252 S RHOQ APPH0253 STO EMTY APPH0254 STX 1 QBPTR APPH0255 MDX VARB4 APPH0256 X00FF DC /FF APPH0257 EMTY DC 0 APPH0258 RHOQ DC 0 APPH0259 QBPTR DC 0 APPH0260 VAL3 DC 3 APPH0261 VARB2 BSI L GETDC APPH0262 STO RHOQ NUMBER OF CHARS IN NUMBER APPH0263 LD EMTY NUMBER OF COLS LEFT FOR ELS APPH0264 VARB3 S RHOQ APPH0265 BSC L CHDA1,+Z APPH0266 STO EMTY NEW COUNT OF FREE COLS APPH0267 STX 1 QBPTR X1 CONTAINS PTR TO 1ST CHAPPH0268 LDX L1 CBL APPH0269 VARB4 BSI L PHCHR PUNCH BLANK APPH0270 LDX I1 QBPTR POINTER FIRST CHAR APPH0271 MDX L QBPTR,1 STEP TO NEXT APPH0272 MDX L RHOQ,-1 APPH0273 MDX VARB4 APPH0274 VARB6 MDX L FPPTR,2 STEP TO NEXT FP APPH0275 MDX L CP,1 INCREASE EL COUNT THIS CARD APPH0276 MDX L RWELC,-1 DECREASE ROW EL COUNT APPH0277 MDX FPBEG RETURN IF MORE APPH0278 CHDA1 BSI L PHCQT APPH0279 PCRD LD RANK APPH0280 LDX L3 DCCON APPH0281 BSC L SCAL3,+ NO INDEXING ADJUSTMENTS NEEDEAPPH0282 LD CP APPH0283 BSI 3 0 APPH0284 LDX I2 CPLOC PUTTING IN CP APPH0285 LD 3 DCNUM+1-DCCON APPH0286 BSC Z SKIP IF NONE APPH0287 BSI TRNSL TRANSLATEW TO CARD CODE APPH0288 MDX 2 1 APPH0289 LD 3 DCNUM+2-DCCON APPH0290 BSI TRNSL TRANSLATE TO CARD CODE APPH0291 SCAL3 LDX 2 8 APPH0292 BSI PNBL ADVANCE TO FIELD APPH0293 BSI L PSEQ PUNCH SEQUENCE FIELD APPH0294 * RETURN FOR NEWOBJ, NEW ROW, OR MORE FOR ROW APPH0295 RETWH LD L ATTN APPH0296 BSC I PVARB,Z RETURN IF ATTN SET APPH0297 LD RWELC APPH0298 BSC L MTRX2,+ APPH0299 LD CS APPH0300 A CP APPH0301 STO CS CS .= CS+CP APPH0302 BSC L VECTR APPH0303 MTRX2 LD CDIM APPH0304 S RP APPH0305 BSC I PVARB,+ APPH0306 BSC L MTRXR APPH0307 SINGL DC 0 APPH0308 LDX L3 RANK APPH0309 LD 3 RDIM-RANK APPH0310 M 3 CDIM-RANK APPH0311 SLT 16 APPH0312 BSC I SINGL,+- APPH0313 STO L 2 APPH0314 LDX I1 FPPTR APPH0315 SING1 LDD I FPPTR APPH0316 SD 1 0 APPH0317 BSC I SINGL,Z APPH0318 SLT 16 APPH0319 BSC I SINGL,Z APPH0320 MDX 1 2 APPH0321 MDX 2 -1 APPH0322 MDX SING1 APPH0323 STO 3 RWELC-RANK APPH0324 STO 3 RANK-RANK APPH0325 STO 3 CDIM-RANK APPH0326 BSC L GTELS APPH0327 HDNG VARIOUS PUNCH SERVICE ROUTINES APPH0328 * APPH0329 * PUNCH BLANKS APPH0330 * TILL X2 COLUMNS REMAIN APPH0331 PNBL DC 0 APPH0332 STX 2 PNBLC SAVE REQD POSN APPH0333 PNBL1 LD L PHCNT IS THIS AT APPH0334 S PNBLC REQUIRED POSITION APPH0335 BSC I PNBL,+ EXIT IF THERE OR PAST APPH0336 LDX L1 CBL APPH0337 BSI L PHCHR PUNCH BLANK APPH0338 MDX PNBL1 MORE TO GO APPH0339 PNBLC EQU * APPH0340 * APPH0341 * GET DECINAL OUTPUT FORMAT APPH0342 * GETDC ON ENTRY X2 POINTS TO FP APPH0343 * ON EXIT X1 POINTS FIRST CH, ACC CONTAINS RHOQ+1 APPH0344 GETDC DC 0 APPH0345 LDX L3 QBUF X3 POINTS BUFFER FOR CONV3 APPH0346 BSI L CONV3 DO CONVERSION TO OUTPUT FORMAAPPH0347 LD L 3 POINTS ONE PAST LAST CHAR APPH0348 S REQB POINTS FIRST CHAR APPH0349 A L VAL1 FOR SPACE APPH0350 LDX L1 QBUF APPH0351 BSC I GETDC APPH0352 REQB DC QBUF APPH0353 * APPH0354 * TRANSLATE TO CARD CODE APPH0355 TRNSL DC 0 APPH0356 STO L 1 APPH0357 MDX 1 -98 APPH0358 MDX 1 -21 APPH0359 LD L1 TABLE+/62 APPH0360 AND HFFF0 APPH0361 STO 2 0 APPH0362 BSC I TRNSL APPH0363 HFFF0 DC /FFF0 APPH0364 * APPH0365 * PUNCH INDICES APPH0366 PNDCN DC 0 ACC CONTAINS BINARY DIGITAPPH0367 BSI DCCON APPH0368 LD DCNUM APPH0369 BSC Z BRANCH IF NO HUNDREDS DIGAPPH0370 BSI PNACC PUNCHES CONTENTS OF ACC APPH0371 LD DCNUM+1 APPH0372 BSC Z SKIP IF NO TENS DIFIT APPH0373 BSI PNACC APPH0374 LD DCNUM+2 APPH0375 BSI PNACC MUST BE A UNITS DIGIT APPH0376 BSC I PNDCN APPH0377 * APPH0378 * PUNCH CHARACTER IN ACCUMULATOR APPH0379 PNACC DC 0 ACC CONTAINS BINARY N APPH0380 AND H00FF APPH0381 STO PNACN APPH0382 LDX L1 PNACN APPH0383 BSI L PHCHR PUNCH CHAR THAT WAS IN ACC APPH0384 BSC I PNACC APPH0385 PNACN EQU * APPH0386 * APPH0387 * PUNCH OBJECT ID APPH0388 * PUNCH AT MOST X2 CHARS APPH0389 PNOBJ DC 0 APPH0390 STX 2 POBJC APPH0391 LDX L2 OBJID APPH0392 BSI L SIXID APPH0393 LDX 3 6 APPH0394 LDX L1 SIXCH-1 APPH0395 STX 1 POBJP APPH0396 POBJ1 MDX L POBJP,1 APPH0397 LDX I1 POBJP APPH0398 LD 1 0 APPH0399 BSC L POBJ2,+- APPH0400 BSI L PHCHR APPH0401 MDX L POBJC,-1 APPH0402 MDX POBJ2 APPH0403 MDX POBJ9 APPH0404 POBJ2 MDX 3 -1 APPH0405 MDX POBJ1 APPH0406 POBJ9 BSC I PNOBJ APPH0407 POBJC DC 0 APPH0408 POBJP DC 0 APPH0409 OBJID BSS E 2 APPH0410 * APPH0411 * PUNCH QUOTE IF CHARACTER TYPE APPH0412 PHCQT DC 0 APPH0413 LD L DTYPE APPH0414 BSC I PHCQT,- APPH0415 LDX L1 CQT APPH0416 BSI L PHCHR APPH0417 BSC I PHCQT APPH0418 * APPH0419 * CONVERT BINARY TO DECIMAL APPH0420 * ACC CONTAINS BINARY NUMBER LSS 256 APPH0421 * RETURNS DECIMAL CHAR REPRESENTATION APPH0422 DCCON DC 0 APPH0423 LDX 2 3 APPH0424 AND H00FF NUMBER LSS 256 APPH0425 SRT 16 APPH0426 STO DCNUM APPH0427 STO DCNUM+1 APPH0428 DCON1 D DC010 APPH0429 RTE 16 APPH0430 A DC027 FOR OUTPUT REPRESENTATION APPH0431 STO L2 DCNUM-1 APPH0432 SLT 16 APPH0433 BSC L DCON2,+- APPH0434 SRT 16 APPH0435 MDX 2 -1 APPH0436 MDX DCON1 APPH0437 DCON2 BSC I DCCON APPH0438 DCNUM BSS 3 APPH0439 H00FF DC /00FF APPH0440 DC027 DC 27 APPH0441 DC010 DC 10 APPH0442 PNFLB DC /78 APPH0443 HDNG PUNCH FUNCTION APPH0444 PFUNC DC 0 APPH0445 MDX L PFUNC,2 RETURN MUST SKIP PVARB STATEMAPPH0446 BSI L ADABS ACC CONTAINS MPTR APPH0447 LD 1 3 X1 POINTS M ENTY APPH0448 BSC I PFUNC,+Z DO NOT PUNCH LOCKED FNS APPH0449 AND H00FF APPH0450 STO PFNCC STO LINE COUNT APPH0451 LD 1 2 POINTER TO LINE DIR ON DISK APPH0452 A DSDSP DISP TO TMTRK OR 0 APPH0453 STO L 2 X2 / DISK ADDR APPH0454 LDX L1 LNDRC X1 / CORE ADDR APPH0455 STX 1 LNDSA START OF LINE DIR APPH0456 SRA 16 APPH0457 STO CDNUM USED FOR NUMBERING FUNCTION CAPPH0458 LD PFNCC APPH0459 BSI LLNDR LOAD LINE DIRECTORY APPH0460 PFNC1 LD I LNDSA APPH0461 A DSDSP DISP TO TMTRK OR 0 APPH0462 BSI LSTMT BUILD LINE STATEMENT IN BUFFEAPPH0463 BSI PNST PUNCH STATEMENT APPH0464 MDX L LNDSA,1 STEP TO NEXT LINE APPH0465 MDX L PFNCC,-1 APPH0466 MDX PFNC1 MORE LINE APPH0467 LD L CDEL NO MORE LINES APPH0468 BSI L PTACC PUNCHING LAST CARD WITH DEL APPH0469 BSI PNST APPH0470 BSC I PFUNC APPH0471 PFNCC DC 0 APPH0472 CDNUM DC 0 APPH0473 LNDSA DC 0 APPH0474 DSDSP DC 0 APPH0475 * PUNCH COLUMNS 73-80 APPH0476 PSEQ DC 0 APPH0477 LDX 2 6 APPH0478 BSI L PNOBJ PUNCH FULL OBJECT NAME APPH0479 LDX L3 PNACC APPH0480 LDX 2 2 ADVANCE TO CARD NUMBER FIELD APPH0481 BSI 3 PNBL-PNACC APPH0482 LD CDNUM APPH0483 BSI 3 DCCON-PNACC APPH0484 LD 3 DCNUM+1-PNACC APPH0485 BSC +- APPH0486 LD PNFLB APPH0487 BSI 3 PNACC-PNACC APPH0488 LD 3 DCNUM+2-PNACC APPH0489 BSI 3 PNACC-PNACC APPH0490 * CARD BUFFER SHOULD HAVE JUST BEEN PUNCHED APPH0491 LD CHARC APPH0492 BSC L PNSTA,Z APPH0493 MDX L CDNUM,1 INCREASE CARD NUMBER IF NEW CAPPH0494 PNSTA BSC I PSEQ APPH0495 HDNG PUNCH FUNCTION STATEMENT APPH0496 PNST DC 0 APPH0497 LD L RDSPB APPH0498 S L DSPBP APPH0499 STO CHARC NUMBER OF CHARS TO PUNCH APPH0500 PNST2 LDX 2 71 NUMBER OF COLUMNS FOR BODY APPH0501 STX 2 BODYC APPH0502 PNST3 LDX I1 DSPBP POINTER FIRST CHAR TO PUNCH APPH0503 BSI L PHCHR APPH0504 MDX L DSPBP,1 STEP TO NEXT CHAR APPH0505 MDX L CHARC,-1 APPH0506 MDX PNST5 MORE CHARS, TEST IF MORE ROOMAPPH0507 LD PNFLB DONE, NO CONTINUATION CHAR APPH0508 PNST4 STO CCHF APPH0509 LDX 2 9 ADVANCE TO ID FIELD APPH0510 BSI L PNBL PUNCH BLANKS TO CONTINUATION APPH0511 LDX L1 CCHF APPH0512 BSI L PHCHR PUNCH BLANK OR CCH APPH0513 BSI PSEQ PUNCH SEQUENCE FIELD APPH0514 LD L ATTN APPH0515 BSC I PFUNC,Z ABORT IF ATTN SET APPH0516 LD CHARC APPH0517 BSC L PNST2,Z BRANCH IF NOT DONE. MUST FINIAPPH0518 BSC I PNST EXIT APPH0519 PNST5 MDX L BODYC,-1 DECREASE BODY COUNT APPH0520 MDX PNST3 MORE ROOM APPH0521 LD CCCH NO MORE ROOM. SET CCCH ON APPH0522 MDX PNST4 APPH0523 CHARC DC 0 APPH0524 BODYC DC 0 APPH0525 CCHF DC 0 APPH0526 CCCH DC /03 APPH0527 HDNG LOAD LINE DIRECTORY APPH0528 * ON ENTRY ACC / # LINES APPH0529 * X1 / CORE ADDRESS APPH0530 * X2 / DISK ADDRESS APPH0531 LLNDR DC 0 APPH0532 STO LLNDC APPH0533 STX 1 LLNDP APPH0534 STX L2 CSPTR APPH0535 LLND1 BSI GTWD GET LINE ADDRESS FROM DISK APPH0536 STO I LLNDP PUT ADDRESS IN DIRECTORY APPH0537 MDX L LLNDP,1 STEP TO NEXT LINE APPH0538 MDX L LLNDC,-1 APPH0539 MDX LLND1 GET NEXT LINE ADDRESS APPH0540 BSC I LLNDR NO MORE LINES. EXIT APPH0541 LLNDC DC 0 APPH0542 LLNDP DC 0 APPH0543 GTWD DC 0 APPH0544 BSI L NEX1 GET SYL FROM DISK. USES CODE1APPH0545 LD SNKSR APPH0546 SLA 8 APPH0547 STO GTWD1 APPH0548 BSI L NEX1 GET SECOND SYL APPH0549 LD SNKSR APPH0550 OR GTWD1 COMBINE TWO SYLS INTO WORD ADAPPH0551 BSC I GTWD EXIT APPH0552 GTWD1 DC 0 APPH0553 * APPH0554 HDNG BUILD FUNCTION LINE IN CORE APPH0555 * LSTMT PUTS A FUNCTION STATEMENT INTO A BUFFER APPH0556 * IN PROPER FORMAT FOR DISPLAYING. APPH0557 * LEFTMOST CHAR POINTED TO BY CONTENTS OF DSPBP. APPH0558 * RIGHTMOST CHAR POINTED TO BY DSPB-1. APPH0559 * APPH0560 * ACC CONTAINS CPTR OF START OF LINE APPH0561 * APPH0562 * FOR ERROR DISPLAY, ERRCT WILL COTAIN POINTER TO APPH0563 * ERROR IN BUFFER AT EXIT. APPH0564 * IFF ERROR DISPLAY, ERDSP MUST BE SET NON ZERO. APPH0565 * APPH0566 LSTMT DC 0 APPH0567 AND TRMSK GET RID OF TRACE BIT APPH0568 STO CSPTR STO LINE DISK POINTER APPH0569 SRA 16 APPH0570 STO CSEG1 NOTHING IN BUFFER APPH0571 LD RDSPB APPH0572 STO DSPBP APPH0573 PTRET SRA 16 APPH0574 STO SPIND SPACE INDICATOR SET OFF APPH0575 GETNX BSI NEX1 GET SYL FROM DISK APPH0576 LD SNKSR APPH0577 BSC L GETNX,+- NULL SYL RECOGNIZED APPH0578 S CMETA APPH0579 BSC I LSTMT,+- METACOLON RECOGNIZED APPH0580 S CCCN APPH0581 BSC L TCCN,+- CHAR STRING RECOGNIZED APPH0582 A H1 APPH0583 BSC L TCON,+- CONSTANT STRING RECOGNIZEAPPH0584 A H1 APPH0585 BSC L TID,+- IDENTIFIER STRING RECOGNIZED APPH0586 A H1 APPH0587 BSC L TERFL,+- APPH0588 SPCH LD SNKSR APPH0589 STO L 1 SPECIAL CHARS JUST PUT APPH0590 H1 EQU *-1 APPH0591 MDX 1 -26 APPH0592 MDX SPCH1 APPH0593 BSI SSPND BLANK INSERTED DEPENDING ON APPH0594 LD SNKSR APPH0595 BSI PTACC APPH0596 MDX GETNX RETURN TO GET NEXT CHAR(S) APPH0597 TCCN BSI NEX1 GET COUNT OF CHARS IN STRING APPH0598 LD SNKSR APPH0599 STO COUNT APPH0600 LD CQT APPH0601 BSI PTACC PUT OUT QUOTE FOR CHAR STING APPH0602 LD COUNT APPH0603 BSC L ENDQT,+- GO TO PUT FINAL QUOTE IF NO CAPPH0604 TCCN1 BSI NEX1 GET CHAR APPH0605 LD SNKSR APPH0606 BSI PTACC PUT CHAR APPH0607 LD CQT APPH0608 S SNKSR APPH0609 BSC L TCCN2,Z SPECIAL CASE IF IT WAS A QUOTAPPH0610 LD CQT APPH0611 BSI PTACC PUT EXTRA QUOTE APPH0612 TCCN2 MDX L COUNT,-1 APPH0613 MDX TCCN1 RETURN FOR MORE CHARS APPH0614 ENDQT LD CQT APPH0615 SPCH1 BSI PTACC PUT FINAL QUOTE APPH0616 MDX PTRET APPH0617 TCON BSI NEX1 GET COUNT OF NUMBERS APPH0618 LD SNKSR APPH0619 STO COUNT APPH0620 TCON1 BSI SSPND PUT BLANK IF NEEDED APPH0621 BSI BLDDW BUILD THE FP NUMBER APPH0622 BSI L GETDC GET THE CONVERSTED DECIMAL CHAPPH0623 STO L 2 NUMBER DIGITS + 1 APPH0624 MDX 2 -1 SHOULD NEVER SKIP APPH0625 MDX I1 2 APPH0626 STX L1 3 APPH0627 TCON2 MDX 3 -1 POINTS THIS DIGIT APPH0628 LD 3 0 APPH0629 BSI PTACC PUT THIS DIGIT APPH0630 MDX 2 -1 APPH0631 MDX TCON2 MORE DIGITS THIS NUMBER APPH0632 MDX L COUNT,-1 APPH0633 MDX TCON1 MORE FPS THIS CONSTANT APPH0634 MDX GETNX APPH0635 TID BSI SSPND PUTS BLANK IF NEEDED APPH0636 BSI BLDDW GET 4 SYLS OF PACKED ID APPH0637 BSI SIXID UNPACK ID APPH0638 LDX 3 6 APPH0639 TID2 LD L3 SIXCH-1 APPH0640 BSC L TID3,+- APPH0641 BSI PTACC PUT OUT ID TO BUFFER APPH0642 TID3 MDX 3 -1 APPH0643 MDX TID2 APPH0644 MDX GETNX APPH0645 TERFL MDX L CSPTR,1 SKIP OVER ERROR FLAG AND POSIAPPH0646 TERF1 BSI NEX1 APPH0647 LD SNKSR APPH0648 S CMETA APPH0649 BSC I LSTMT,+- DONE IF CMETA APPH0650 A CMETA APPH0651 BSI PTACC PUT CHAR TO BUFFER APPH0652 MDX TERF1 APPH0653 TRMSK DC /7FFF APPH0654 CSPTR DC 0 APPH0655 SNKSR DC 0 APPH0656 RDSPB DC DSPB APPH0657 DSPBP DC 0 APPH0658 CCCN DC /24-/62 APPH0659 CMETA DC /62 END OF LINE INDICATOR APPH0660 CQT DC /37 QUOTE APPH0661 COUNT DC 0 APPH0662 SPIND DC 0 APPH0663 CSEG1 DC 0 APPH0664 SSPND DC 0 APPH0665 LD SPIND 0 OR BLANK APPH0666 BSC Z APPH0667 BSI PTACC PUT BLANCK IF NEEDED APPH0668 LD L CBL APPH0669 STO SPIND SET BLANCK NEEDED ON APPH0670 BSC I SSPND APPH0671 HDNG GET NEXT SYL FROM DISK APPH0672 * APPH0673 NEX1 DC 0 APPH0674 LDX L1 NEX1P GSYL PARAMETER LIST APPH0675 BSI L GSYL APPH0676 LD ERDSP APPH0677 BSC I NEX1,+- NEITHER TEST NOR FOUND APPH0678 BSC L NEXFN,+ FOUND APPH0679 LD L BADCP APPH0680 S CSPTR APPH0681 BSC I NEX1,Z BRANCH IF NOT FOUND APPH0682 LDX 1 -1 BACK OF ONE APPH0683 STX 1 ERDSP POINTS TO BUFFER LOCATION OF APPH0684 MDX NEXXT APPH0685 NEXFN SRA 16 APPH0686 STO ERDSP APPH0687 LD DSPBP APPH0688 STO L ERRCT APPH0689 NEXXT BSC I NEX1 APPH0690 BSS E 0 APPH0691 NEX1P DC SNKSR APPH0692 DC CSPTR APPH0693 DC CODE1 APPH0694 DC CSEG1 APPH0695 ERDSP DC 0 APPH0696 PTACC DC 0 APPH0697 MDX L DSPBP,-1 APPH0698 * BUFFER BETTER BE LARGE ENOUGH TO NEVER SKIP APPH0699 STO I DSPBP PUT CHAR IN ACC INTO BUFFER APPH0700 BSC I PTACC APPH0701 HDNG BUILD DOUBLE WORD FROM DISK APPH0702 * BLDDW BUILDS A DOUBLE WORD FROM SYLABLES. APPH0703 * WHICH FOR CONSTANTS MAKES IT A PROPER FP NUMBER, APPH0704 * AND FOR IDENTIFIERS MAKES IT A B C APPH0705 * D E F APPH0706 * ON RETURN X2 POINTS TO DOUBLE WORD APPH0707 BLDDW DC 0 APPH0708 LDX 2 2 GET 2 WORDS, (4 SYLS). APPH0709 BLDD1 BSI NEX1 GET SYL APPH0710 LD SNKSR APPH0711 SLA 8 APPH0712 STO BLDW APPH0713 BSI NEX1 GET NEXT SYL OF THIS WORD APPH0714 LD SNKSR APPH0715 OR BLDW COMBINE INTO WORD APPH0716 MDX 2 -1 APPH0717 MDX BLDD2 HAVE GOTTEN FIRST WORD APPH0718 STO DWORD+1 STORE SECOND WORD APPH0719 LDX L2 DWORD MAKE X2 POINT TO WORD APPH0720 BSC I BLDDW EXIT APPH0721 BLDD2 STO DWORD STORE FIRST WORD APPH0722 MDX BLDD1 GO TO GET SECOND WORD APPH0723 BLDW DC 0 APPH0724 DWORD BSS E 2 APPH0725 SIXID DC 0 APPH0726 LDX L3 SIXCH+3 ARG FOR UNPK APPH0727 BSI L UNPK UNPACK WORD INTO SI THREE CHAAPPH0728 MDX 2 1 STEP TO NEXT WORD APPH0729 LDX L3 SIXCH+6 APPH0730 BSI L UNPK UNPACK SECOND WORD APPH0731 BSC I SIXID EXIT APPH0732 HDNG FUNCTION DISPLAY APPH0733 * X1 PTS LINE NUMBER OF FIRST LINE TO BE DISPLAYED APPH0734 * X2 PTS LINE NUMBER OF LAST LINE TO BE DISPLAYED APPH0735 * PRINTS LINE NUMBERS AND CHECKS FOR ATTN AFTER APPH0736 * EACH LINE IS DISPLAYED. FOR ATTN OR FINISHING APPH0737 * THE LAST LINE THE RETURN IS IMMEDIATE. THE CALLER APPH0738 * MUST TAKE CARE OF TRAILING DEL AND RETURN TO THE APPH0739 * PROPER MODE. APPH0740 * CURLN CONTAINS LINE NUMBER OF LAST LINE DISPLAYED APPH0741 * APPH0742 SFDSP STX 1 PLPTR APPH0743 STX 2 LLPTR POINTS LINE NUMBER OF LAST LIAPPH0744 S D1 APPH0745 STO DSPSW REQD, +VE FOR SUPEREDIT APPH0746 FDSP1 LD PLPTR POINTS LINE NUMBER PRESENT LIAPPH0747 A CLINC ADVANCE TO LINE ADDRESS APPH0748 STO DSPTR STORE POINTER TO LINE ADDRES APPH0749 LD I DSPTR APPH0750 BSC L FDSP3,+- GET NEXT IF LINE ADDRES IS 0 APPH0751 BSI L LSTMT BUILD LINE STATEMENT IN BUFFEAPPH0752 LD I PLPTR ACC / XX.XX APPH0753 BSI LNMES PRINT LINE NUMBER APPH0754 BSI PRST PRINT LINE STATEMENT APPH0755 FDSP3 LD L ATTN APPH0756 BSC L FDSP2,Z APPH0757 LD PLPTR APPH0758 S LLPTR APPH0759 BSC L FDSP2,+- APPH0760 MDX L PLPTR,1 STEP TO NEXT LINE NUMBER APPH0761 MDX FDSP1 APPH0762 PLPTR DC 0 APPH0763 LLPTR DC 0 APPH0764 DSPTR DC 0 APPH0765 CLINC DC LINC APPH0766 DSPSW DC 0 APPH0767 D1 DC 1 APPH0768 FDSP2 BSI PRDEL APPH0769 LD DSPSW END OF FUNCTION APPH0770 A D1 APPH0771 BSI L PRCRT,+Z APPH0772 BSC I FNDSP APPH0773 PRDEL DC 0 APPH0774 LD DSPSW APPH0775 A D1 APPH0776 BSC I PRDEL,- APPH0777 LD VAL5 SPECIAL INDENTATION FOR DEL APPH0778 BSI L MVCRG MOVE CARRIAGE TO POSITION APPH0779 LDX L1 CDEL APPH0780 BSI L TYPE PRINT DEL APPH0781 BSC I PRDEL APPH0782 HDNG PRINT STATEMENT APPH0783 PRST DC 0 APPH0784 LD I DSPBP LOAD FIRST CHAR TO PRINT APPH0785 S CDEL HEADER LINE IF IT IS A DEL APPH0786 BSC L PRST0,Z BRANCH IF NOT A DEL APPH0787 BSI PRDEL APPH0788 MDX L DSPBP,1 STEP TO NEXT CHAR APPH0789 PRST0 LD VAL7 APPH0790 BSI L MVCRG MOVE CARRIAGE TO POSITION 7 APPH0791 LD L CHRCT APPH0792 STO SVRCT SAVE STARTING POSITION FOR ERAPPH0793 LDX L3 CODE1+313 APPH0794 PRST1 LD L CHRCT APPH0795 S DC110 TEST IF AT END OF LINE APPH0796 BSC L PRST2,+ APPH0797 BSI L PRCRT START NEW LINE APPH0798 LD VAL5 APPH0799 BSI L MVCRG INDENT FOR SECOND LINE OF LINAPPH0800 PRST2 LD L RDSPB APPH0801 S L DSPBP APPH0802 BSC L PRST9,+ BRANCH IF DONE APPH0803 LDX I1 DSPBP LOAD NEXT CHAR APPH0804 LD DSPSW APPH0805 BSC L PRST3,+ APPH0806 LD 1 0 APPH0807 STO 3 0 APPH0808 MDX 3 -1 APPH0809 PRST3 BSI L TYPE APPH0810 MDX L DSPBP,1 STEP TO NEXT CHAR APPH0811 MDX PRST1 APPH0812 PRST9 BSI L PRCRT APPH0813 LD DSPSW APPH0814 BSC I PRST,+ APPH0815 LD L CMETA APPH0816 STO 3 0 APPH0817 LDX 2 6 APPH0818 LD L CBL APPH0819 PRST4 STO L2 CODE1+313 APPH0820 MDX 2 -1 APPH0821 MDX PRST4 APPH0822 MDX L MODE,-2 APPH0823 BSC I PRST APPH0824 DC110 DC 110 APPH0825 VAL5 DC 5 APPH0826 VAL7 DC 7 APPH0827 SVRCT DC 0 APPH0828 HDNG PRINT LINE NUMBER APPH0829 LNMES DC 0 APPH0830 STO CURLN APPH0831 BSC I LNMES,+- DON,T PRINT LINE NUMBER 0 APPH0832 LDX L1 CLBR APPH0833 BSI L TYPE PRINT LEFT BRACKET APPH0834 LD CURLN APPH0835 SRA 12 APPH0836 BSC Z SKIP IF NO HUNDREDS DIGIT APPH0837 BSI LMESN PRINT DIGIT APPH0838 LD CURLN APPH0839 SRA 8 APPH0840 BSI LMESN ALWAYS PRINT UNITS DIGIT APPH0841 LD CURLN APPH0842 SLA 8 APPH0843 BSC L LMES1,+- BRANCH IF NO DECIAMAL FRACTIOAPPH0844 LDX L1 CPD APPH0845 BSI L TYPE PRINT PERIOD APPH0846 LD CURLN APPH0847 SRA 4 APPH0848 BSI LMESN PRINT DECIMAL APPH0849 LD CURLN APPH0850 SLA 12 APPH0851 SRA 12 APPH0852 BSC Z SKIP IF NONE APPH0853 BSI LMESN PRINT DECIAMAL APPH0854 LMES1 LDX L1 CRBR APPH0855 BSI L TYPE PRINT RIGHT BRACKET APPH0856 BSC I LNMES EXIT APPH0857 CURLN DC 0 APPH0858 CDEL DC /33 APPH0859 LMESN DC 0 APPH0860 AND LNMSK ISOLATE DIGIT TO BE PRINTED APPH0861 A L CZERO MAKE IT OUTPUT REPRESENTATIONAPPH0862 STO LNCHR APPH0863 LDX L1 LNCHR APPH0864 BSI L TYPE PRINT IT APPH0865 BSC I LMESN EXIT APPH0866 LNCHR DC 0 APPH0867 LNMSK DC /000F APPH0868 HDNG LOAD OR STORE 6 SECTORS (MATRIX) APPH0869 * X1 IS THE DISK ADDRESS APPH0870 SLMSP DC 0 APPH0871 STX 1 SLM01 APPH0872 BSI L DKORG APPH0873 SLM01 DC 0 APPH0874 DC MATRX APPH0875 DC 6 APPH0876 DC /140 APPH0877 BSC I SLMSP APPH0878 HDNG PUNCH CONTROL APPH0879 SPNCH LDS 2 PUNCH COMMAND APPH0880 LDX L1 TMTRX APPH0881 BSI SLMSP SAVE ACTIVE M SPACE OVER TSTUAPPH0882 LDX I1 FOUND POINTER TO DIRECTORY APPH0883 LD 1 7 POINTER TO WS ON DISK APPH0884 STO WSDSA WORK SPACE DISK ADDRESS APPH0885 STO L 1 APPH0886 LDX L2 TMTRK APPH0887 LDX L3 MATRX APPH0888 BSI L TSTUT TRANSFER TO TMTRK APPH0889 LDX I1 WSDSA APPH0890 MDX 1 26 ADVANCE TO INACTIVE M SPACE APPH0891 LDX L2 MATRX APPH0892 LDS 1 APPH0893 BSI SLMSP LOAD MSPACE TO MATRX APPH0894 LDX L1 TLNC DISP TO TMTRK FROM STTRK APPH0895 MDX PNCH1 APPH0896 SPCHA LD L PNCHA PUNCHA ENTRY POINT APPH0897 STO L PUNCH APPH0898 LDX 1 0 APPH0899 PNCH1 STX L1 DSDSP DISP TO TMTRK IF PUNCH, 0 IF APPH0900 LD L CLASS APPH0901 S DC012 APPH0902 STO WHSPC PLUS IF PARAMETER LIST APPH0903 BSC L PNCH2,-Z BRANCH IF PARAMETER LIST APPH0904 SPNGB LD L NUMGL NUMBER OF GLOBALS APPH0905 BSC L ATTNS,+ APPH0906 STO GLBCT APPH0907 * CDSW USED TO BE SET HERE APPH0908 LDX L1 GLBTB-4 APPH0909 STX 1 GLBPT POINTER TO POSITION IN GLOBALAPPH0910 NXTGB LD L ATTN APPH0911 BSC L ATTNS,Z EXIT IF ATTN SET NON-ZERO APPH0912 MDX L GLBPT,4 STEP TO NEXT GLOBAL ENTRY APPH0913 LDX I1 GLBPT APPH0914 LD WHSPC APPH0915 BSC L PNCHO,-Z BRANCH IF PARAMETER LIST APPH0916 GOTGB LDD 1 2 APPH0917 STD L OBJID STORE OBJECT ID TO BE PUCHED APPH0918 LD I GLBPT APPH0919 BSC L NXTGB,+- BRANCH IF A ZERO ENTRY APPH0920 BSI L PFUNC,+ IT IS A FUNCTION IF BRANC APPH0921 BSI L PVARB IT IS A VARIABLE APPH0922 DGBCT MDX L GLBCT,-1 APPH0923 MDX NXTGB APPH0924 ATTNS LDS 1 APPH0925 BSI L CHECK APPH0926 LD L CDSW APPH0927 AND HF6FF RESET CARD SWITCH APPH0928 STO L CDSW APPH0929 LDS 1 APPH0930 LDX L1 TMTRX APPH0931 LD L DSDSP APPH0932 BSC Z APPH0933 BSI SLMSP RESTORE ACTIVE MSPACE IF NEEDAPPH0934 BSC I PUNCH EXIT APPH0935 PNCHO LD 1 1 TEST IF THIS OBJECT WAS APPH0936 BSC L DGBCT,- MARKED TO BE PUNCHED APPH0937 AND H7FFF APPH0938 STO 1 1 UNSET MARK IF MARKED APPH0939 MDX GOTGB APPH0940 WSDSA DC 0 APPH0941 GLBPT DC 0 APPH0942 GLBCT DC 0 APPH0943 WHSPC DC 0 APPH0944 H7FFF DC /7FFF APPH0945 HF6FF DC /F6FF APPH0946 H8000 DC /8000 APPH0947 H0800 DC /0800 APPH0948 DC012 DC 12 APPH0949 HDNG FREE FORMAT OUTPUT CONVERSION APPH0950 * NUMCON OUTPUT CONVERSION APPH0951 * THIS ROUTINES TAKES A FLOATING POINT APPH0952 * NUMBER A AND CONVERTS IT TO AN ALC STRING APPH0953 * FOR OUTPUT. NUMBERS GEQ 1E6 OR LSS 1E-3 APPH0954 * ARE AUTOMATICALLY CONVERTED IN EXPONENTIAL APPH0955 * FORMAT. TRAILING ZEROS ARE ELIMINATED AND APPH0956 * A DECIMAL POINT IS INSERTED ONLY IF THERE APPH0957 * ARE DIGITS FOLLOWING IT. A MAXIMUM OF SIX APPH0958 * SIGNIFICANT DIGITS WILL BE PRODUCED. APPH0959 * AN APL DESCRIPTION OF THIS ROUTINE EXISTS APPH0960 * IN THE WORKSPACE 763785APL1130 ON THE MOD APPH0961 * 50 AS A FUNCTION CALLED CONV. APPH0962 * REGISTERS ON ENTRY APPH0963 * R1= POINTER TO LC LOW CORE (1130 ADDRESS) APPH0964 * LC R7= POINTER TO DATA ITEM (FIRST WORD, APPH0965 * LC ADDRESS) APPH0966 * LC R8= POINTER TO LC OUTPUT AREA OUTBUF APPH0967 * (1ST WORD, LC ADDRESS) APPH0968 * REGISTERS ON EXIT APPH0969 * LC R8 POINTS TO ONE WORD PAST THE LAST ALC APPH0970 * CHARACTER INSERTED INTO OUTBUF APPH0971 * (LC ADDRESS) APPH0972 * ROUTINES CALLED. APPH0973 * NONE APPH0974 * CALLED BY APPH0975 * DALQUB APPH0976 * DALQUD APPH0977 * DADISL APPH0978 * APPH0979 * THE CONSTANTS BM10,BM3,BP10,BM10, ARE APPH0980 * STORED IN THE FOLLOWING FORMAT APPH0981 * WORD 1 SXXX XXXX XXXX XXXX APPH0982 * WORD 2 0XXX XXXX XXXX XXXX APPH0983 * THE BINARY POINT IS BETWEEN BITS 2 AND 3 OF WORD APPH0984 * ONE APPH0985 ORG EQU 0 APPH0986 ALCD0 EQU 27 APPH0987 ALCNG EQU 73 APPH0988 ALCE EQU 5 APPH0989 ALCDP EQU 44 APPH0990 BSS E 0 APPH0991 DPLUS DC /5000 APPH0992 DC /0000 APPH0993 BP3 EQU DPLUS APPH0994 * APPH0995 * APPH0996 BM10 DC /4189 1024/1000 APPH0997 DC /1BA6 APPH0998 BM3 DC /3333 8/10 APPH0999 DC /199A APPH1000 CONV3 DC 0 APPH1001 STX L3 PTRQB+ORG APPH1002 LDD 2 0 APPH1003 STD FRACT APPH1004 SLT 16 APPH1005 LDS 0 CLEAR INDICATORS APPH1006 STS FRACT&1 CLEAR LOWER HALF OF WORD APPH1007 EOR FRACT&1 PICK OUT EXPONENT APPH1008 LDX 1 0 SET UP PLUS FLAG APPH1009 STO 1 2 XR2.#E APPH1010 LD FRACT APPH1011 BSC L ZERO+ORG,+- FRACT=0 APPH1012 BSC L OPLUS+ORG,- IF POS. THEN DONT COMP APPH1013 SLT 32 CLEAR REGISTERS APPH1014 SD FRACT COMPLEMENT APPH1015 STD FRACT APPH1016 LDX 1 1 SET UP MINUS FLAG APPH1017 OPLUS STX 1 FLAG STORE FLAG APPH1018 LDX 3 0 SET BASE 10 EXPONENT =0 APPH1019 LDX 1 3 FOR BASE AND SHIFT COUNT APPH1020 MDX L2 -152 SUBTRACT EXCESS AND SCALE APPH1021 NOP APPH1022 OBACK LD 1 -1 PICK UP E APPH1023 BSC L POS+ORG,-Z E APPH1024 L2 BSC L SHIFT+ORG,- E=0 APPH1025 A L C10A+ORG APPH1026 BSC L CLOSE+ORG,-Z E GTR 0 APPH1027 STO 1 -1 SAVE E WHILE MULTIPLYING APPH1028 LDD BP10 1000/1024 APPH1029 BSI OMULT DOUBLE LENGTH MULTIPLY APPH1030 MDX 3 -3 STEP DOWN BASE 10 EXPONENT APPH1031 NOP FOR CHANGE OF SIGN APPH1032 LD 1 -1 PICK UP E APPH1033 MDX L2 CANT BE POSITIVE APPH1034 BSS E 0 ALIGN APPH1035 FRACT BSS 2 MANTISSA IS STORED HERE APPH1036 CLOSE S C7 E#E-7 APPH1037 STO 1 -1 SAVE E WHILE MULTIPLYING APPH1038 LDD BP3 10/8 APPH1039 BSI OMULT DOUBLE LENGTH MULTIPLY APPH1040 MDX 3 -1 COUNT DOWN BASE 10 EXPONENT APPH1041 MDX OBACK APPH1042 MDX OBACK ALLOW FOR CHANGE OF SIGN APPH1043 POS S C10A E#E-10 APPH1044 BSC L NEAR+ORG,+Z E LSS 0 APPH1045 STO 1 -1 SAVE BASE 2 EXPONENT APPH1046 LDD BM10 1024/1000 APPH1047 BSI OMULT DOUBLE LENGTH MULTIPLU APPH1048 MDX 3 3 COUNT UP BASE 10 EXPONENT APPH1049 MDX OBACK NO CHANGE OF SIGN POSSIBLE APPH1050 NEAR A C7 E#E&7 APPH1051 BSC L SHIFA+ORG,+Z E=-1 OR -2 APPH1052 STO 1 -1 SAVE BASE 2 EXPONENT APPH1053 LDD BM3 8/10 APPH1054 BSI OMULT DOUBLE LENGTH MULTIPLY APPH1055 MDX 3 1 COUNT UP BASE 10 EXPONENT APPH1056 MDX OBACK APPH1057 MDX L8 SAVE SOME TIME THIS WAY APPH1058 SHIFA A C3 E#E&3 APPH1059 SHIFT STO 1 -1 PUT INTO XR2 APPH1060 LDD FRACT PICK UP FRACTION APPH1061 L8 SRT 2 TOTAL SHIFT RIGHT IS 2-E APPH1062 SLC 2 WHERE E=0,1,2 APPH1063 SD MAX MAX#9999995 APPH1064 LDX 2 8 GET 8 DIGITS FROM CONVERSION APPH1065 BSC L LOW+ORG,+Z FRCT LSS 9999995 APPH1066 AD RND1 RND1#10000045 APPH1067 L7 SRT 5 PLACE IN LOW PART OF WORD APPH1068 D C1E4 GET TWO HALVES APPH1069 STO FRACT SAVE HIGH ORDER PART APPH1070 SRA 16 CLEAR ACCUMULATOR APPH1071 L6 LDX 1 4 GET 4 DIGITS FROM LOW ORDER APPH1072 L3 D C10A GET A DIGIT APPH1073 RTE 16 PLACE REMAINDER IN ACC APPH1074 STO L2 OUT+ORG-1 SAVE AS NEXT DIGIT APPH1075 SRA 16 CLEAR IT OUT APPH1076 MDX 2 -1 STEP DOWN LOC IN OUT APPH1077 MDX L4O GO STEP XR3 APPH1078 MDX L5 FINISHED CONVERTING APPH1079 L4O MDX 1 -1 STEP XR1 DOWN APPH1080 MDX L3 GET NEXT DIGIT APPH1081 LD FRACT PICK UP HIGH ORDER PART APPH1082 SRT 16 PLACE IN EXT APPH1083 MDX L6 GO GET MORE DIGITS APPH1084 LOW AD C1E7 C1E7#10000000 APPH1085 LDX 2 7 ONLY 7 DIGITS NOW APPH1086 MDX 3 -1 CT#CT-1 APPH1087 MDX L7 IN CASE OF SIGN CHANGE APPH1088 MDX L7 BACK TO MAIN FLOW APPH1089 ZERO STO FLAG APPH1090 LDX 3 -7 APPH1091 SLT 32 APPH1092 MDX L8 APPH1093 C3 DC /0003 CONSTANT 3 APPH1094 C7 DC /0007 CONSTANT 7 APPH1095 CON2 DC /3FFF MASK FOR SHIFT APPH1096 CON DC /00FF LOGICAL CONSTANT APPH1097 C1E4 DC /2710 10000 APPH1098 BSS E 0 ALIGN APPH1099 RND1 DC /1312 10000045 TIMES 2**5 APPH1100 DC /D5A0 APPH1101 C1E7 DC /1312 10000000 TIMES 2**5 APPH1102 DC /D000 APPH1103 BP10 DC /3E80 1000/1024 APPH1104 DC /0000 APPH1105 RND DC /0000 ROUNDING CONSTANT APPH1106 DC /0010 APPH1107 MAX DC /1312 9999995 TIMES 2**5 APPH1108 DC /CF60 APPH1109 FLAG BSS 1 SIGN FLAG FOR FRACTION APPH1110 * THE FOLLOWING IS THE DOUBLE LENGTH MULTIPLY APPH1111 * MULTIPLY ROUTINE. LOCATED HERE SO AS TO BE APPH1112 * REACHABLE BY SHORT INSTRUCTIONS. APPH1113 OMULT BSS 1 ENTRY POINT APPH1114 STD CONST PICK UP CONSTANT APPH1115 M FRACT HIGH-ORDER PART APPH1116 STD EVEN SAVE IN A TEMP APPH1117 LD FRACT&1 PICK UP LOW ORDER FRACT APPH1118 SRA 1 SHIFT TO CLEAR SIGN BIT APPH1119 M CONST HIGH ORDER PART OF CONST APPH1120 SRT 15 SHIFT DOWN TO ALIGN APPH1121 AD EVEN ADD TO PARTIAL PRODUCT APPH1122 STD EVEN STORE BACK IN TEMP APPH1123 LD FRACT HIGH-ORDER PART APPH1124 M CONST&1 LOW-ORDER PART APPH1125 SRT 15 SHIFT DOWN TO ALIGN APPH1126 AD EVEN ACCUMULATE PARTIAL PRODUCT APPH1127 AD RND ROUND APPH1128 SLC 1 SHIFT 3 OR TILL FIRST ONE APPH1129 LDX 1 3 PICK UP SHIFT COUNT APPH1130 BSC L ONORM+ORG,C BRANCH IF TOPPED BY CNT APPH1131 SRT 8 CLEAR ZEROS FROM BOTTOM APPH1132 AND CON WANT LOGICAL SHIFT APPH1133 SHFT SLT 7 DRAG IN ZEROS APPH1134 STD FRACT SAVE APPH1135 BSC I OMULT+ORG RETURN APPH1136 EVEN BSS E 2 PARTIAL PRODUCT ACCUMULATOR APPH1137 CONST BSS 2 TEMPORARY STORAGE FOR CONST APPH1138 C10 DC /000A CONSTANT 10 SECOND COPY APPH1139 ONORM SRT 2 WE WENT 2 LEFT APPH1140 AND CON2 WANT LOGICAL SHIFT APPH1141 AD RND ROUND AGAIN APPH1142 SRT 6 CLEAR LOW ORDER BITS APPH1143 MDX 2 1 ADD 1 TO E APPH1144 MDX SHFT GO BACK FOR RETURN APPH1145 MDX SHFT ALLOW FOR SIGN CHANGE APPH1146 * MULT SUBROUTINE ENDS HERE APPH1147 L5 LD C1 APPH1148 MDX 3 10 APPH1149 SLA 16 APPH1150 MDX 3 -8 APPH1151 SLA 16 APPH1152 STO EXP APPH1153 * EXP.=NOT ((CT LSS -10) OR CT GTR -2) APPH1154 MDX 3 6 APPH1155 NOP APPH1156 STX 3 CT1 APPH1157 * CT.= CT+8 APPH1158 M CT1 APPH1159 SLT 16 APPH1160 BSC & APPH1161 LD EXP APPH1162 A C2 APPH1163 MDX L EXP+ORG,0 APPH1164 S C1 APPH1165 STO DP APPH1166 * DP.=1+(EXP TIMES 1 MAX CT)+ NOT EXP APPH1167 LD CT1 APPH1168 S C1 APPH1169 STO CT1 APPH1170 BSC - APPH1171 SLA 16 APPH1172 EOR ALL1 APPH1173 A C1 APPH1174 M EXP APPH1175 SLT 16 APPH1176 STO LEADZ APPH1177 * LEADZ.=EXP TIMES ABS 0 MIN CT .= CT-1 APPH1178 LDX 1 7 APPH1179 * I .=7 APPH1180 LDX I2 PTRQB+ORG APPH1181 LDX L3 OUT+ORG APPH1182 LD NEG APPH1183 STO 2 0 APPH1184 MDX L FLAG+ORG,0 APPH1185 * OUTBUF.=NEG TIMES IOTA FLAG APPH1186 INSRT MDX 2 1 APPH1187 MDX L DP+ORG,-1 APPH1188 MDX M1 APPH1189 * =.M1 TIMES IOTA 0=DP .=DP-1 APPH1190 LD ALL1 APPH1191 STO DP APPH1192 STO 2 0 APPH1193 * OUTBUF.=OUTBUF,'.' APPH1194 MDX INSRT APPH1195 * .= INSRT APPH1196 M1 LD LEADZ APPH1197 BSC L INSTZ+ORG,-Z APPH1198 * M1.. .=INSTZ TIMES IOTA 0 LEQ LEADZ APPH1199 LD 3 0 APPH1200 MDX 3 1 APPH1201 STO 2 0 APPH1202 * OUTBUF.=OUTBUF, OUT$(8-I$) APPH1203 MDX 1 -1 APPH1204 MDX INSRT APPH1205 * .=INSRT TIMES IOTA 0 = I .=I-1 APPH1206 FINSH LD 2 -1 APPH1207 BSC L TEST+ORG,-Z APPH1208 MDX 2 -1 APPH1209 BSC L FINSH+ORG,- APPH1210 * TRIM OFF TRAILING ZEROS AND A DP IF APPH1211 * NECESSARY. APPH1212 TEST MDX L EXP+ORG,0 APPH1213 MDX TOALC APPH1214 LD TLCE APPH1215 STO 2 0 APPH1216 MDX 2 1 APPH1217 * OUTBUF.=OUTBUF,'E' APPH1218 LD CT1 APPH1219 BSC L M2+ORG,- APPH1220 LD NEG APPH1221 STO 2 0 APPH1222 MDX 2 1 APPH1223 SLA 16 APPH1224 S CT1 APPH1225 M2 SRT 16 APPH1226 D C10A APPH1227 STO 2 0 APPH1228 BSC Z APPH1229 MDX 2 1 APPH1230 RTE 16 APPH1231 STO 2 0 APPH1232 MDX 2 1 APPH1233 * FINISH UP CONVERSION OF EXPONENT APPH1234 TOALC LDX I3 PTRQB+ORG APPH1235 LD PTRQB APPH1236 S L 2 APPH1237 S C1 APPH1238 STO L 1 APPH1239 M4 MDX 1 1 APPH1240 MDX M3 APPH1241 BSC I CONV3+ORG APPH1242 M3 LD 3 0 APPH1243 BSC +Z SKIP IF A NUMBER APPH1244 A TLCDP INCREMENT E OR DECIMAL APPH1245 A TLCDG APPH1246 * CONVERT OUTBUF TO ALC BY ADDING 35 APPH1247 STO 3 0 APPH1248 MDX 3 1 APPH1249 MDX M4 APPH1250 INSTZ S C1 APPH1251 STO LEADZ APPH1252 * LEADZ.=LEADZ-1 APPH1253 SLA 16 APPH1254 STO 2 0 APPH1255 * OUTBUF.=OUTBUF,0 APPH1256 * =. INSRT APPH1257 MDX INSRT APPH1258 OUT BSS 8 APPH1259 C1 EQU M4-1 APPH1260 C2 EQU M4-4 APPH1261 NEG DC ALCNG-ALCD0 APPH1262 TLCE DC ALCE-ALCDP-1 APPH1263 CT1 EQU EVEN APPH1264 DP EQU EVEN&1 APPH1265 EXP EQU CONST APPH1266 LEADZ EQU CONST&1 APPH1267 TLCDG DC ALCD0 APPH1268 ALL1 DC /FFFF APPH1269 C10A EQU C10 APPH1270 TLCDP DC ALCDP-ALCD0+1 DIF TWIXT TWO CODES APPH1271 PTRQB DC 0 APPH1272 HDNG DISPLAY LINE FROME INPUT AREA APPH1273 INPED BSI L GTMSG PRINT THE MESSAGE APPH1274 LD RTREA START OF INPUT BUFFER APPH1275 STO AREAP POINTER TO CHAR IN INPUT BUFFAPPH1276 INED1 MDX L AREAP,-1 STEP TO NEXT CHAR APPH1277 LD AREAP LOAD CHAR APPH1278 S L R13 POINTS TO LAST CHAR OF STRINGAPPH1279 BSC L INED5,+- BRANCH IF ALL OF STRING IS PRAPPH1280 LD L CHRCT APPH1281 S L DC110 LENGTH FOR OUTPUT LINE APPH1282 BSC L INED3,+ BRANCH IF MORE ROOM THIS LINEAPPH1283 BSI L PRCRT START NEW LINE APPH1284 LD L VAL5 APPH1285 BSI L MVCRG INDENT 5 APPH1286 INED3 LDX I1 AREAP APPH1287 BSI L TYPE PRINT CHAR APPH1288 MDX INED1 GO TO GET NEXT CHAR APPH1289 INED5 BSI L PRCRT PRINT FINAL CARRIAGE RETURN FAPPH1290 LDX I1 R14 X1 POINTS ERROR LOCATION APPH1291 MDX 1 1 APPH1292 LD 1 0 LOAD ERROR CHAR APPH1293 BSC L INED7,+- CHARACTER ERROR APPH1294 S L CCCN APPH1295 BSC L INED7,-Z SPCEIAL CHARACTER ERROR APPH1296 INEDC MDX 1 1 MUST STEP TO THE FIRST CHAR APPH1297 LD RTREA OF BAD ERROR IN STRING APPH1298 S L 1 APPH1299 BSC L INED6,+ APPH1300 LD 1 0 APPH1301 S L CCCN APPH1302 BSC L INEDC,+ APPH1303 INED6 MDX 1 -1 APPH1304 INED7 LD RTREA APPH1305 S L 1 APPH1306 BSI L CARET PRINT CARET IN POSITION OF ACAPPH1307 BSC I ERROR EXIT APPH1308 AREAP DC 0 APPH1309 RTREA DC TAREA+1 APPH1310 HDNG ERROR MESSAGES APPH1311 * CALLED BY APL CONTROL APPH1312 * X1 CONTAINS ERROR NUMBER AND FLAGS IN HIGH 2 BITS APPH1313 * FLAGS 00 INPUT/EDIT, 01 STMT EXEC, 10 SYSTEM CMMAPPH1314 * X1 IS -1 IF ERROR WAS PUT TO DISK, AND NOT APPH1315 * INDICATED TILL EXECUTION TIME APPH1316 * APPH1317 SERRR STX 1 SVERR SAVE ERROR NUMBER AND TYPE FLAPPH1318 STX L1 ATTN THIS ALONE PREVENTS CARD SIGAPPH1319 * CUT BACK STACK AND MARK GARBAGE APPH1320 LDX I2 LOCOR+14 X2 POINTS TOP OF TOP OF STACKAPPH1321 CLSTK LD L 2 APPH1322 S L PAREL APPH1323 BSC L STKCL,- HAVE REACHED HEADER, DONE. APPH1324 LD 2 0 APPH1325 BSC L NXTST,+ DON,T TOUCH IF INDIRECT ENTRYAPPH1326 SRA 12 APPH1327 S H0001 TESTING FOP OPNDCL CLASS APPH1328 BSC L NXTST,Z APPH1329 LD 2 0 GET POINTER APPH1330 BSI L ADABS MAKE REAL POINTER APPH1331 LD HFFFF APPH1332 STO 1 0 MARK ENTRY AS GARBAGE APPH1333 NXTST MDX 2 1 STEP TO NEXT ENTRY APPH1334 MDX CLSTK APPH1335 STKCL STX 2 HDPTR HDPTR CONTAINS POINTER TO TOPAPPH1336 LDX I1 SVERR LOAD ERROR NUMBER AND FLAGES APPH1337 MDX 1 1 SKIP IF DELAYED ERROR APPH1338 MDX ERRB1 APPH1339 LDX I1 HDPTR DELAYED ERROR APPH1340 LD 1 1 POINTS AT SYL AFTER ERROR INDAPPH1341 STO L CSPTR APPH1342 BSI L NEX1 GET SYL OF COUNT TO ERROR PSIAPPH1343 LD L SNKSR APPH1344 STO SVERR ERROR NUMBER APPH1345 BSI L NEX1 GET POSITION OF ERROR IN LINEAPPH1346 LD L SNKSR APPH1347 S H0001 APPH1348 STO DSCNT POSITIONIN LINE OF ERROR APPH1349 LDX I1 HDPTR APPH1350 MDX ERRB2 APPH1351 ERRB1 LD SVERR APPH1352 SRA 14 APPH1353 BSC L INPED,+- BRANCH IF ERROR IN INPUT EDITAPPH1354 LDX I1 HDPTR APPH1355 STX L1 ERDSP ANY NON ZERO WILL DO APPH1356 LD 1 1 POINTER TO POSITION IN LINE APPH1357 STO BADCP DISK POINTER OF ERROR APPH1358 ERRB2 LD 1 4 APPH1359 STO L CSPTR START OF LINE ON DISK WITH ERAPPH1360 BSI GTMSG APPH1361 BSI PRTRC PRINT LINE NUMBER IF FN ERRORAPPH1362 LD L CSPTR APPH1363 BSI L LSTMT BUILD LINE IN BUFFER APPH1364 LD DSCNT APPH1365 BSC L ERRB3,Z APPH1366 LD ERRCT BRANCH IF ERROR NOT APPH1367 BSC L ERRB4,Z AT END OF LINE APPH1368 ERRB3 A L DSPBP APPH1369 ERRB4 STO L 1 POSITION FOR CARET (UNCORRECTAPPH1370 H0001 EQU *-1 APPH1371 BSI CORCT CORECT COUNT FOR IDS AND NUMBAPPH1372 BSI L PRST PRINT STATEMENT APPH1373 LD ERRCT APPH1374 A L SVRCT APPH1375 BSI CARET PRINT CARET AT POSITION IN ACAPPH1376 LDX I1 HDPTR APPH1377 LD 1 0 LOAD FIRST WD OF HEADER APPH1378 SLA 1 APPH1379 BSC I ERROR,- EXIT IF NOT IMEX APPH1380 LD L CSPTR PTS 1 SYL PAST METACOLON APPH1381 STO 1 1 APPH1382 BSC I ERROR EXIT APPH1383 SVERR DC 0 APPH1384 DSCNT DC 0 APPH1385 HDPTR DC 0 APPH1386 BADCP DC 0 APPH1387 HFFFF DC /FFFF APPH1388 ERRCT DC 0 APPH1389 H3FFF DC /3FFF APPH1390 HDNG PRINT CARET APPH1391 * ACC CONTAINS NUMBER SPACES TO PRECEED CARET APPH1392 CARET BSS E 1 APPH1393 GLBSB EQU CARET APPH1394 LNDRC EQU CARET APPH1395 QBUF EQU LNDRC+51 APPH1396 SIXCH EQU QBUF+13 APPH1397 CART1 S L DC110 IN CASE OF MORE THAN ONE LINEAPPH1398 BSC L CART1,Z- APPH1399 A L DC110 APPH1400 BSI L MVCRG SPACE OVER TO POSITION APPH1401 LDX L1 CRABT APPH1402 BSI L TYPE PRINT CARET APPH1403 BSI L PRCRT APPH1404 BSC I CARET EXIT APPH1405 CRABT DC /47 APPH1406 HDNG CALCULATE # CHS TO ERROR CHARS APPH1407 * X1 POINTS LOCATION OF ERROR WHEN CAUGHAPPH1408 CORCT DC 0 APPH1409 LD 1 0 APPH1410 S L CCCN APPH1411 BSC L CTOK,-Z BRANCH IF IT SI A SPECIAL CHAAPPH1412 CDECT LD L 1 APPH1413 S L DSPBP APPH1414 BSC L CTOK,+ APPH1415 MDX 1 -1 APPH1416 LD 1 0 APPH1417 S L CCCN APPH1418 BSC L CDECT,+ APPH1419 MDX 1 1 APPH1420 CTOK LD L 1 APPH1421 S L DSPBP APPH1422 STO ERRCT COREECTED POSITION APPH1423 BSC I CORCT APPH1424 HDNG GET MESSAGE APPH1425 * SVERR CONTAINS ERROR NUMBER APPH1426 * RETURNS X2 PTS ADDRESS OF MESSAGE APPH1427 * STORES MESSAGE FLAGS AT MSGTP APPH1428 * CALLS PRMSG TO PRINT THE MESSAGE N.B. 2 RETURNS APPH1429 GTMSG DC 0 APPH1430 LD SVERR CONTAINS NUMBER AND FLAGS APPH1431 AND H3FFF GET RID OF FLAGS APPH1432 A L ERRX2 CONTAINS ERRX2 APPH1433 STO L 2 POINTS TO MESSAGE APPH1434 LD I2 0 CONTAINS FLAGS AND NUMBER OF APPH1435 STO MSGTP WORD IN MESSAGE APPH1436 BSI PRMSG PRINTS MESSAGE APPH1437 LDX L2 ERRMG PREPARE TO PRINT ERROR APPH1438 LD MSGTP APPH1439 SLA 1 APPH1440 BSC C SKIP IF NOT ERROR TYPE MSG APPH1441 BSI PRMSG PRINTS ERROR APPH1442 BSI L PRCRT PRINTS CARRIAGE RETURN AFTER APPH1443 LD MSGTP APPH1444 SLA 2 APPH1445 BSC I GTMSG,C RETURN IF DISPLAY REQUIRED APPH1446 BSC I ERROR EXIT TO APL CONTROL APPH1447 MSGTP DC 0 APPH1448 PRMSG DC 0 X2 PTS ADDR OF MSG TEXT APPH1449 LD I2 0 FIRST WD IS # WDS PLUS SOME APPH1450 AND H3FFF APPH1451 STO L 1 X1 IS NUMBER OF WORDS APPH1452 LD 2 0 APPH1453 STO L 2 APPH1454 MDX 2 1 APPH1455 BSI L PRNID PRINT MESSAGE APPH1456 BSC I PRMSG EXIT APPH1457 HDNG PRINT ID AND LINE NUMBER IF REQUIRED APPH1458 * HDPTR CONTAINS ADDR OF TOP OF STACK HEADER APPH1459 * APPH1460 PRTRC DC 0 APPH1461 LDX I1 HDPTR FIRST WORD OF TOP OF STACK APPH1462 LD 1 0 APPH1463 SRA 12 APPH1464 BSC I PRTRC,Z EXIT IF NOT IN FUNCTION EXECUAPPH1465 LD 1 2 BINARY LINE NUMBER APPH1466 SRA 8 APPH1467 STO BINNM APPH1468 LD 1 3 APPH1469 BSI L ADABS GET POINTER TO M ENTRY APPH1470 MDX 1 2 POINTS AT ID APPH1471 LDX I2 1 APPH1472 LDX 1 2 TWO WORDS LONG APPH1473 BSI L PRNID PRINT FUNCTION ID APPH1474 LD 2 -4 NO OUTPUT IF THIS APPH1475 BSI L ADABS IS A LOCKED FUNCTION APPH1476 LD 1 3 APPH1477 BSC I ERROR,+Z APPH1478 LDX L1 CLBR APPH1479 BSI L TYPE PRINT LEFT BRACKET APPH1480 LD BINNM BINARY LINE NUMBER APPH1481 BSI L DCCON CONVERT TO DECIMAL APPH1482 LD L DCNUM+1 APPH1483 BSC L PRDC2,+- APPH1484 LDX L1 DCNUM+1 APPH1485 BSI L TYPE PRINT TENS DIGIT IF ANY APPH1486 PRDC2 LDX L1 DCNUM+2 APPH1487 BSI L TYPE PRINT UNITS DIGIT APPH1488 LDX L1 CRBR APPH1489 BSI L TYPE PRINT RIGHT BRACKET APPH1490 BSC I PRTRC EXIT APPH1491 BINNM DC 0 APPH1492 * APPH1493 * APPH1494 * MARK IN GLOBAL TABLE THE OBJECTS IN THE PARAM LISTAPPH1495 * LOCATED HERE AS IT IS NOT NEEDED AFTER PUNCHING STAPPH1496 * AND MAY BE OVERWRITTEN AS A BUFFER AREA IF NEEDED APPH1497 PNCH2 STO PARCT COUNT OF PARAMETERSS$2 APPH1498 STO MGFLG SET TO NON ZERO APPH1499 LDX L1 PARID APPH1500 STX 1 PTRID POINTS TO PARAMETER APPH1501 PNCH3 LDD I PTRID APPH1502 LDX L1 GLBSB APPH1503 STD 1 0 APPH1504 BSI L SGBTB SEARCH GLOBAL TABLE FOR ID APPH1505 LD 1 4 NON ZERO IF FOUND APPH1506 BSC L NDMG,+- BRANCH IF NOT FOUND APPH1507 STO L 1 APPH1508 LD 1 1 APPH1509 OR L H8000 MARK IT TO BE PUNCHED APPH1510 STO 1 1 APPH1511 PNCH4 MDX L PTRID,2 STEP TO NEXT PARAMETER APPH1512 MDX L PARCT,-2 APPH1513 MDX PNCH3 MORE PARAMETERS APPH1514 LD MGFLG APPH1515 BSC L SPNGB,Z APPH1516 BSI L PRCRT EXIT APPH1517 BSC L SPNGB EXIT EXIT AFTER CARRIAGE RETUAPPH1518 PARCT DC 0 APPH1519 PTRID DC 0 APPH1520 NDMG LD MGFLG NON ZERO IF MESSAGE TEXT NEEDAPPH1521 BSC L NDMG1,+- APPH1522 SRA 16 APPH1523 STO MGFLG SET TO NON SET TO ZERO (0) APPH1524 LDX L2 MGTXT ADDRESS OF TEXT APPH1525 LDX 1 4 APPH1526 BSI L PRNID PRINT TEXT APPH1527 NDMG1 LD L CHRCT APPH1528 S L DC110 TEST IF NEW LINE NEEDED APPH1529 BSC L NDMG2,+ APPH1530 BSI L PRCRT NEW LINE NEDDED APPH1531 NDMG2 LDX L1 CBL APPH1532 BSI L TYPE PRINT BLANK BETWEEN PARS APPH1533 LDX I2 PTRID APPH1534 LDX 1 2 APPH1535 BSI L PRNID PRINT ID NOT FOUND APPH1536 MDX PNCH4 APPH1537 MGFLG DC 0 APPH1538 MGTXT DC N*P1+O*P2+T APPH1539 DC SPC*P1+F*P2+O APPH1540 DC U*P1+N*P2+D APPH1541 DC SPC*P1+SPC*P2+SPC APPH1542 * APPH1543 * APPH1544 ERRX2 DC ERRX2 APPH1545 DC ERM1 RESEND APPH1546 DC ERM2 LINE TOO LONG APPH1547 DC ERM3 INCORRECT SIGN ON APPH1548 DC ERM4 SYNTAX APPH1549 DC ERM5 NUMBER NOT IN SYSTEM APPH1550 DC ERM6 DEFN APPH1551 DC ERM7 DOMAIN APPH1552 DC ERM8 DISK OFL APPH1553 DC ERM9 WS FULL APPH1554 DC ERM10 K CHARACTER APPH1555 DC ERM11 LABEL APPH1556 DC ERM12 FUNCTION TOO LARGE APPH1557 DC ERM13 ID APPH1558 DC ERM14 SYSTEM APPH1559 DC ERM15 LENGTH APPH1560 DC ERM16 RANK APPH1561 DC ERM17 INDEX APPH1562 DC ERM18 VALUE APPH1563 DC ERM19 INCORRECT COMMMAND APPH1564 DC ERM20 WS NOT FOUND APPH1565 DC ERM21 SYSTEM FULL APPH1566 DC ERM22 NOT SAVED WS QUOTA USED UP APPH1567 DC ERM23 NOT WITH OPEN DEFN APPH1568 DC ERM24 WS RATION EXCEEDED APPH1569 ERRMG DC ERRMS ERROR APPH1570 ERM1 DC 2 RESEND APPH1571 DC R*P1+E*P2+S APPH1572 DC E*P1+N*P2+D APPH1573 ERM2 DC 5 APPH1574 DC L*P1+I*P2+N LINE TOO LONG APPH1575 DC E*P1+SPC*P2+T APPH1576 DC O*P1+O*P2+SPC APPH1577 DC L*P1+O*P2+N APPH1578 DC G APPH1579 ERM3 DC 6 APPH1580 DC I*P1+N*P2+C INCORRECT SIGN-ON APPH1581 DC O*P1+R*P2+R APPH1582 DC E*P1+C*P2+T APPH1583 DC SPC*P1+S*P2+I APPH1584 DC G*P1+N*P2+SPC APPH1585 DC O*P1+N*P2 APPH1586 ERM4 DC ERM+FTH+2 SYNTAX APPH1587 DC S*P1+Y*P2+N APPH1588 DC T*P1+A*P2+X APPH1589 ERM5 DC 7 APPH1590 DC N*P1+U*P2+M APPH1591 DC B*P1+E*P2+R APPH1592 DC SPC*P1+N*P2+O APPH1593 DC T*P1+SPC*P2+I APPH1594 DC N*P1+SPC*P2+S APPH1595 DC Y*P1+S*P2+T APPH1596 DC E*P1+M*P2 APPH1597 ERM6 DC ERM+FTH+2 APPH1598 DC D*P1+E*P2+F APPH1599 DC N APPH1600 ERM7 DC ERM+FTH+2 DOMAIN APPH1601 DC D*P1+O*P2+M APPH1602 DC A*P1+I*P2+N APPH1603 ERM8 DC 5 FN SPACE FULL APPH1604 DC F*P1+N*P2+SPC APPH1605 DC S*P1+P*P2+A APPH1606 DC C*P1+E*P2+SPC APPH1607 DC F*P1+U*P2+L APPH1608 DC SPC*P1+L*P2 APPH1609 ERM9 DC FTH+3 APPH1610 DC W*P1+S*P2+SPC APPH1611 DC F*P1+U*P2+L APPH1612 DC L APPH1613 ERM10 DC ERM+FTH+3 CHARACTER APPH1614 DC C*P1+H*P2+A APPH1615 DC R*P1+A*P2+C APPH1616 DC T*P1+E*P2+R APPH1617 ERM11 DC ERM+2 APPH1618 DC L*P1+A*P2+B APPH1619 DC E*P1+L*P2 APPH1620 ERM12 DC 6 FUNCTION TOO LARGE APPH1621 DC F*P1+U*P2+N APPH1622 DC C*P1+T*P2+I APPH1623 DC O*P1+N*P2+SPC APPH1624 DC T*P1+O*P2+O APPH1625 DC SPC*P1+L*P2+A APPH1626 DC R*P1+G*P2+E APPH1627 ERM13 DC ERM+FTH+1 APPH1628 DC I*P1+D*P2 APPH1629 ERM14 DC ERM+2 SYSTEM APPH1630 DC S*P1+Y*P2+S APPH1631 DC T*P1+E*P2+M APPH1632 ERM15 DC ERM+FTH+2 LENGTH APPH1633 DC L*P1+E*P2+N APPH1634 DC G*P1+T*P2+H APPH1635 ERM16 DC ERM+FTH+2 RANK APPH1636 DC R*P1+A*P2+N APPH1637 DC K APPH1638 ERM17 DC ERM+FTH+2 INDEX APPH1639 DC I*P1+N*P2+D APPH1640 DC E*P1+X*P2 APPH1641 ERM18 DC ERM+FTH+2 VALUE APPH1642 DC V*P1+A*P2+L APPH1643 DC U*P1+E*P2 APPH1644 ERM19 DC 6 INCORRECT COMMAND APPH1645 DC I*P1+N*P2+C APPH1646 DC O*P1+R*P2+R APPH1647 DC E*P1+C*P2+T APPH1648 DC SPC*P1+C*P2+O APPH1649 DC M*P1+M*P2+A APPH1650 DC N*P1+D*P2 APPH1651 ERM20 DC 4 WS NOT FOUND APPH1652 DC W*P1+S*P2+SPC APPH1653 DC N*P1+O*P2+T APPH1654 DC SPC*P1+F*P2+O APPH1655 DC U*P1+N*P2+D APPH1656 ERM21 DC 4 SYSTEM FULL APPH1657 DC S*P1+Y*P2+S APPH1658 DC T*P1+E*P2+M APPH1659 DC SPC*P1+F*P2+U APPH1660 DC L*P1+L*P2 APPH1661 ERM22 DC 9 NOT SAVED, WS QUOTA APPH1662 DC N*P1+O*P2+T APPH1663 DC SPC*P1+S*P2+A USED UP APPH1664 DC V*P1+E*P2+D APPH1665 DC SPC*P1+SPC*P2+W APPH1666 DC S*P1+SPC*P2+Q APPH1667 DC U*P1+O*P2+T APPH1668 DC A*P1+SPC*P2+U APPH1669 DC S*P1+E*P2+D APPH1670 DC SPC*P1+U*P2+P APPH1671 ERM23 DC 6 NOT WITH OPEN DEFN APPH1672 DC N*P1+O*P2+T APPH1673 DC SPC*P1+W*P2+I APPH1674 DC T*P1+H*P2+SPC APPH1675 DC O*P1+P*P2+E APPH1676 DC N*P1+SPC*P2+D APPH1677 DC E*P1+F*P2+N APPH1678 ERM24 DC 6 APPH1679 DC W*P1+S*P2+SPC APPH1680 DC R*P1+A*P2+T APPH1681 DC I*P1+O*P2+N APPH1682 DC SPC*P1+E*P2+X APPH1683 DC C*P1+E*P2+E APPH1684 DC D*P1+E*P2+D APPH1685 ERRMS DC 2 APPH1686 DC SPC*P1+E*P2+R APPH1687 DC R*P1+O*P2+R APPH1688 LNGTH EQU *-ASMPH APPH1689 START LDX L1 ASMPH-2 APPH1690 BSI DSKIO APPH1691 EXIT APPH1692 DSKIO DC 0 APPH1693 STX 1 DSKI1 APPH1694 STX 1 DSKI3 APPH1695 LIBF DISK1 APPH1696 DC /3000 APPH1697 DSKI1 DC 0 APPH1698 DC DSKI4 APPH1699 DSKI2 LIBF DISK1 APPH1700 DC /0000 APPH1701 DSKI3 DC 0 APPH1702 MDX DSKI2 APPH1703 BSC I DSKIO APPH1704 DSKI4 WAIT APPH1705 BSC I DSKIO APPH1706 END START APPH1707 // XEQ L 1 APPH1708 // JOB APSC0001 // ASM APSC0002 *LIST APSC0003 *PRINT SYMBOL TABLE APSC0004 HDNG PREPROLOGUE TO SYSTEM COMMAND APSC0005 ABS APSC0006 * DISK ADDRESSES APSC0007 LCDBS EQU /280 APSC0008 DASTU EQU LCDBS APSC0009 DACMD EQU LCDBS+/34 APSC0010 DEMWS EQU LCDBS+/6B APSC0011 DUDIR EQU LCDBS+/6C APSC0012 * OVERLAY NUMBER OF THIS ASSEMBLY APSC0013 SCMOV EQU 8 APSC0014 * ORIGIN OF THIS AND OTHER ASSEMBLIES APSC0015 ASMSC EQU /730 APSC0016 ASMED EQU /18D1 APSC0017 ASMCT EQU /21E APSC0018 ASMDK EQU /000 APSC0019 * IMPORTANT ADDRESSES APSC0020 FOUND EQU /F9F APSC0021 CLASS EQU /FA0 APSC0022 PARAM EQU /FA2 APSC0023 LWKSP EQU /FF8 APSC0024 LOCOR EQU /1000 APSC0025 MATRX EQU /1011 APSC0026 NUMGL EQU /1012 APSC0027 SOLPT EQU /1016 APSC0028 PAREL EQU /1017 APSC0029 GLBTB EQU /1036 APSC0030 CUDIR EQU MATRX+/140*8+1 APSC0031 CWDIR EQU CUDIR+/140 APSC0032 MODE EQU /1FF4 APSC0033 USER EQU /1FF5 APSC0034 SINON EQU /1FF6 APSC0035 CHRCT EQU /1FF9 APSC0036 * ADDRESS FROM DISK I/O ASSEMBLY APSC0037 DKORG EQU ASMDK+/2C APSC0038 * ADDRESSES FROM CTRAY ASSEMBLY APSC0039 CDSW EQU ASMCT APSC0040 TYPSW EQU ASMCT+1 APSC0041 ERRXT EQU ASMCT+/37 APSC0042 ABSAD EQU ASMCT+/A8 APSC0043 TYPE EQU ASMCT+/1A9 APSC0044 TYNCH EQU ASMCT+/1B4 APSC0045 MVCRG EQU ASMCT+/1C3 APSC0046 PRCRT EQU ASMCT+/1D1 APSC0047 PRNID EQU ASMCT+/1E3 APSC0048 TSTUT EQU ASMCT+/4EE APSC0049 * ADDRESSES IN INPUT/EDIT ASSEMBLY APSC0050 R13 EQU ASMED+/A6 APSC0051 R14 EQU ASMED+/A7 APSC0052 * RELATIVE ADDRESS IN PUNCH ASSEMBLY APSC0053 PUNCH EQU 1 APSC0054 PNCHA EQU 4 APSC0055 * RELATIVE ADDRESSES IN COPY ASSEMBLY APSC0056 COPY EQU 1 APSC0057 PCOPY EQU 4 APSC0058 ERASE EQU /A APSC0059 * PERMANENT ADDRESSES USED BY OTHER ASSEMBLIES APSC0060 DC PARAM APSC0061 DC CLASS APSC0062 DC FOUND APSC0063 * ADDRESS USED BY OTHER ASSEMBLY APSC0064 DC BREAK-ASMSC APSC0065 * LENGTH OF ASSEMBLY APSC0066 DC LNGTH APSC0067 HDNG SYSTEM COMMAND PROCESSOR APSC0068 ORG ASMSC-2 APSC0069 DC 5*/140 APSC0070 DC DACMD APSC0071 DC SCMOV APSC0072 HDNG BREAK OUT SYSTEM COMMAND APSC0073 * APSC0074 BREAK DC 0 APSC0075 LDX L1 PARAM PARAMETER LIST ADDRESS APSC0076 SLT 32 ZERO APSC0077 STO 1 CLASS-PARAM CLASS APSC0078 STD 1 2 USER KEY APSC0079 STD 1 4 WORKSPACE APSC0080 STD 1 6 NAME APSC0081 STD 1 8 WORKSPACE KEY APSC0082 LD * APSC0083 STO 1 0 NO USER NUMBER READ YET APSC0084 STO 1 -1 NO LOCK REMOVAL YET APSC0085 * APSC0086 * APSC0087 BSI L NXTPM NO LEADING BLANKS APSC0088 MDX BRK01 ERROR IF NO PARAMETER APSC0089 LD L SINON BRANCH IF NUMBER FOUND APSC0090 SLA 1 APSC0091 BSC L BRK02,OZ WITH SIGN ON SITUATION APSC0092 BSC L BRK03,+- BRANCH IF NO SIGN ON APSC0093 * APSC0094 * APSC0095 BRK01 BSC L INSGN APSC0096 BRK02 MDX L CLASS,2 USER SIGN ON - SET PARAM APSC0097 LDX L3 SIGN & COMMAND ADDRESS APSC0098 MDX BRK07 APSC0099 * APSC0100 BRK03 BSI L FNDCM NOT A SIGN ON SITUATION APSC0101 * FIND COMMAND - ERROR IF APSC0102 * AFTER AN ATTEMPT TO SIGN ON WHEN APSC0103 * SOMEONE IS SIGNED ON ALREADY APSC0104 LD L SINON BRANCH IF APSC0105 BSC L BRK04,+Z PRIVILEGED USER APSC0106 LD 3 2 UNPRIVILEGED USER. APSC0107 BSC L INCOM,+Z ERROR IF PRIVILEGED CMND APSC0108 BRK04 LD L CDSW CHECK INPUT MODE APSC0109 BSC L BRK06,- BRANCH IF TYPEWRITER MODE APSC0110 SLA 3 CARD MODE. IS IT A FLUSH APSC0111 BSC L BRK05,- BRANCH IF NOT APSC0112 LD 3 3 FLUSH - IS IT )CARD APSC0113 SLA 1 COMMAND APSC0114 BSC L BRKXT,- IGNORE COMMAND IF NOT APSC0115 BRK05 LD 3 3 COMMAND ALLOWED IN CARD APSC0116 BSC L INCOM,+Z MODE - ERROR IF NOT APSC0117 BRK06 LD 3 3 BRANCH IF COMMAND ALLOWED APSC0118 SLA 2 IN OTHER THAN IMMEDIATE APSC0119 BSC L BRK07,- APSC0120 LD L MODE ERROR IF NOT ALLOWED AND APSC0121 BSC L NOFDF,+Z APSC0122 BRK07 STX 3 CMND STORE COMMAND TYPE APSC0123 LD 3 3 ISOLATE NUMBER OF APSC0124 SRT 5 PARAMETERS EXPECTED APSC0125 AND H0007 AND APSC0126 STO NUMPR SAVE APSC0127 SLT 5 ISOLATE KIND OF APSC0128 AND H001F COMMAND AND APSC0129 STO KIND SAVE APSC0130 LDX I3 KIND FIRST PARAMETER EXPECTED APSC0131 MDX BRK12 APSC0132 * APSC0133 * START OF NEXT PARAMETER LOOP APSC0134 * APSC0135 BRK08 BSI L NXTPM GET NEXT PARAMETER APSC0136 MDX BRK16 BRANCH OUT IF NONE FOUND APSC0137 BRK09 LD NUMPR ANY MORE PARAMETERS APSC0138 BSC L INCOM,+- ERROR IF NONE EXPECTED APSC0139 LDX I3 KIND NEXT PARAMETER EXPECTED APSC0140 LD L3 KNDLS ITS REQUIREMENTS APSC0141 BSC L BRK10,O BRANCH IF NUMERIC PARA- APSC0142 * METER FOUND APSC0143 BSC L BRK11,- ALPHANUMERIC FOUND, APSC0144 * BRANCH IF NUMERIC WANTED APSC0145 SLA 1 CHACK LENGTH APSC0146 MDX 1 2 SKIP IF LONG PARAMETER APSC0147 MDX BRK12 GO TO CHECK TERMINATOR APSC0148 EOR H8000 APSC0149 BRK10 BSC L BRK12,- GO CHECK TERMINATOR APSC0150 * (FOR NUMERIC TEST, APSC0151 * BRANCH IF NUMERIC REQ'D) APSC0152 BRK11 BSI OMIT CHECK FOR OMISSION APSC0153 MDX BRK01 ERROR IF YES, BUT OPERND APSC0154 MDX BRK09 TRY NEXT PARAMETER APSC0155 * APSC0156 BRK12 LD L3 KNDLS IF BLANK TERMINATOR IS APSC0157 SLA 4 IMPERATIVE, SET CARRY APSC0158 LD TERM WHAT WAS THE TERMINATOR APSC0159 BSC L BRK13,+Z BRANCH IF BLANK APSC0160 BSC L INCOM,C ERROR IF NOT & BLANK REQ APSC0161 BSI L NONBK APSC0162 MDX BRK17 NO LOCK/KEY IF LINE END APSC0163 * ACCUM WILL BE ZERO IF NO CHARS FOLLOW COLON APSC0164 BRK17 STO L PARAM-1 REMOVE LOCK AND APSC0165 BSC L BRK18,+- BRANCH IF NO LOCK/KEY APSC0166 MDX L R14,1 APSC0167 MDX BRK14 NEXT PARAMETER SEARCH APSC0168 BRK13 BSC L BRK19,C APSC0169 BRK18 MDX L KIND,1 SKIP LOCK/KEY PARAMETER APSC0170 MDX L NUMPR,-1 REDUCE PARAMETER COUNT APSC0171 MDX * APSC0172 BRK19 EQU * APSC0173 BRK14 LD L CLASS WHAT IS THIS PARAMETER APSC0174 BSC L BRK15,+- BRANCH IF COMMAND APSC0175 LDX I2 CLASS GET STORAGE DISPLACEMENT APSC0176 LDD IDENT STIRE FIRST APSC0177 STD L2 PARAM-2 6 CHARACTERS APSC0178 LD L3 KNDLS IS THIS A APSC0179 SLA 1 LONG PARAMETER APSC0180 BSC L BRK15,- APSC0181 LDD IDENT+2 STORE LAST 6 APSC0182 STD L2 PARAM CHARACTERS IF YES APSC0183 BRK15 BSI UPKND SET SEARCH FOR NEXT PAR. APSC0184 MDX BRK08 GET NEXT PARAMETER APSC0185 * APSC0186 * ALL PARAMETERS FOUND APSC0187 * APSC0188 BRK16 LD NUMPR ANY MORE PARAMETERS REQD APSC0189 BSC Z GO TO START EXECUTION APSC0190 BSI OMIT IF YES, CHECK OMISSION APSC0191 MDX EXCTE GO TO START EXECUTION APSC0192 MDX BRK16 TRY NEXT IF NOT OPERAND APSC0193 * APSC0194 BRKXT LDX L3 NULL-2 NULL COMMAND - GO TO APSC0195 MDX EXC02 EXIT APSC0196 NULL DC NULCM-ASMSC APSC0197 * APSC0198 * APSC0199 H0007 DC /0007 APSC0200 H0003 DC /0003 APSC0201 CMND DC 0 APSC0202 KIND DC 0 APSC0203 NUMPR DC 0 APSC0204 H001F DC /001F APSC0205 EXCTE EQU * APSC0206 * APSC0207 LD L PARAM BRANCH IF NUMBER HAS APSC0208 BSC L EXC01,+- APSC0209 LD L USER ASSUME CURRENT USER APSC0210 STO L PARAM+1 IF NOT APSC0211 EXC01 LDX I3 CMND COMMAND ADDRESS APSC0212 LD 3 3 DOES THIS COMMAND WANT APSC0213 SLA 3 THE DIRECTORIES APSC0214 LDS 1 TO BE LOADED APSC0215 BSI L LDDIR,+Z GO LOAD IF YES APSC0216 LD 3 3 DOES THIS COMMAND WANT APSC0217 SLA 4 THE WORKSPACE DIRECTORY APSC0218 LDX L3 WSADR TO BE SEARCHED APSC0219 BSI L FNWKS,+Z GO SEARCH IF YES APSC0220 LDX I3 CMND DOES THIS COMMAND APSC0221 LD 3 3 WANT THE PASSWORD APSC0222 SLA 5 TO BE CHECKED APSC0223 BSI L CHPSW,+Z CHECK PASSWORD IF YES APSC0224 EXC02 LD 3 3 ISOLATE OVERLAY APSC0225 SRA 6 REQUIRED TO APSC0226 AND H000C EXECUTE COMMAND APSC0227 STO L 2 PUT IT IN X2 APSC0228 MDX 2 SCMOV APSC0229 LD 3 2 GET ADDRESS OF ROUTINE APSC0230 STO L 1 APSC0231 BSC I BREAK EXIT APSC0232 H000C DC /000C APSC0233 H8000 DC /8000 APSC0234 TERM DC 0 APSC0235 HDNG CHECK PARAMETER OMISSION APSC0236 * APSC0237 OMIT DC 0 APSC0238 LDX I3 KIND APSC0239 LD L3 KNDLS CAN THIS PARAMETER BE APSC0240 SLA 2 OMITTED APSC0241 BSC L INCOM,- ERROR IF NOT APSC0242 LD L CLASS APSC0243 S OPND OPERAND APSC0244 BSC I OMIT,- EXIT NORMALLY IF YES APSC0245 MDX L OMIT,1 ADJUST EXIT FOR RETURN+1 APSC0246 BSI UPKND IF NOT, SET SEARCH FOR APSC0247 * NEXT PARAMETER APSC0248 OMTXT BSC I OMIT EXIT APSC0249 * APSC0250 * APSC0251 UPKND DC 0 APSC0252 LD L CLASS APSC0253 S OPND IS IT AN OPERAND APSC0254 BSC L UPK01,+Z BRANCH IF NOT APSC0255 MDX L CLASS,2 ADVANCE ADDRESS APSC0256 LD L CLASS APSC0257 S H50 APSC0258 BSC L INCOM,-Z APSC0259 MDX UPKXT EXIT APSC0260 H50 DC /50 APSC0261 UPK01 LDX I3 KIND APSC0262 LD L3 KNDLS APSC0263 AND H001F ADDRESS FOR STORING NEXT APSC0264 STO L CLASS APSC0265 MDX L KIND,1 REQUIREMENTS FOR NEXT PAR APSC0266 MDX L NUMPR,-1 REDUCE COUNT OF APSC0267 MDX * PARAMETERS REQUIRED APSC0268 UPKXT BSC I UPKND EXIT APSC0269 OPND DC OPN APSC0270 * APSC0271 * APSC0272 IDENT BSS E 4 APSC0273 FNDCM DC 0 APSC0274 LDX L3 CMNDS ADDRESS OF 1ST COMMAND APSC0275 FND01 LDD 3 0 GET THIS IDENTIFIER APSC0276 BSC L INCOM,+- INCORRECT COMMAND IF ZERO APSC0277 SD IDENT COMPARE WITH PASSWORD APSC0278 BSC L FND02,Z APSC0279 SLT 16 APSC0280 BSC I FNDCM,+- EXIT IF SAME APSC0281 FND02 MDX 3 4 APSC0282 MDX FND01 TRY NEXT IDENTIFIER APSC0283 * APSC0284 HDNG GET NEXT FIELD IN COMMAND APSC0285 NXTPM DC 0 X1,X2,X3 USED APSC0286 BSI NONBK DO A NON BLANK SEARCH APSC0287 MDX NXTXT EXIT IF END OF STATEMENT APSC0288 NXT02 A NUMTS IS SPECIAL CHARACTER APSC0289 BSC L INCOM,- ERROR IF YES APSC0290 NXT03 A TEN IS THIS ALPHABETIC? APSC0291 LDX 1 BLDID-BLDID ASSUME THIS IS AND ID APSC0292 BSC - SKIP IF YES APSC0293 LDX 1 BLNUM-BLDID ACTUALLY ITS A NUMBER APSC0294 BSI L1 BLDID EXECUTE BUILD ROUITNE APSC0295 MDX NXT06 END OF STATEMENT FOUND APSC0296 NXT05 S NUMTS IS THIS BLANK TERMINATOR APSC0297 BSC L NXT08,Z BRANCH IF NOT APSC0298 BSI NONBK IF YES,GET NEXT NON BLANK APSC0299 MDX NXT06 THERE WASNT ONE APSC0300 NXT08 A COLTS CHECK FOR COLON APSC0301 BSC L NXT07,+- BRANCH IF IT WAS APSC0302 MDX L R14,1 REREAD CHAR LATER IF NOT APSC0303 NXT06 LD H8000 SET BLANK TERMINATOR APSC0304 NXT07 STO TERM SAVE TERMINATOR APSC0305 MDX L NXTPM,1 ADJUST EXIT FOR RETURN+1 APSC0306 NXTXT BSC I NXTPM EXIT APSC0307 NUMTS DC /78-/25 APSC0308 COLTS DC /78-/58 APSC0309 * EXIT CONDITIONS: APSC0310 * OVERFLOW SET IF NUMBER FOUND APSC0311 * TERM=0 IF COLON TERMINATES APSC0312 * X1 CONTAINS (IDENT LENGTH-5) FOR APSC0313 * IDENTIFIERS APSC0314 BLKCH DC /78 APSC0315 HDNG BUILD 6 OR 12 CHARACTER IDENTIFIER APSC0316 * X2,X3 DESTROYED, X1 UPDATED APSC0317 BLDID DC 0 APSC0318 LDX 1 -4 UP TO 12 CHARS ALLOWED APSC0319 A ALCHR RESTORE CHARACTER APSC0320 STO IDENT SAVE IN FIRST WORD APSC0321 SLT 32 ZERO OUT APSC0322 STO IDENT+1 SECOND IDENTIFIER WORD APSC0323 STD IDENT+2 3RD,4TH IDENTIFIER WORDS APSC0324 LDX 2 3 ALLOW 3 CHARS PER WORD APSC0325 MDX BLD03 BRANCH TO GET CHARACTER APSC0326 BLD01 STO CHAR SAVE THIS CHARACTER APSC0327 LD L1 IDENT+4 GET CURRENT WORD APSC0328 M FORTY MULTIPLY CONTENTS APSC0329 SLT 16 BY FORTY APSC0330 A CHAR ADD IN CHARACTER APSC0331 BLD02 STO L1 IDENT+4 SAVE CURRENT WORD APSC0332 BLD03 BSI GETCH GET NEXT CHARACTER APSC0333 MDX BLDXT EXIT IF END OF STATEMENT APSC0334 S NMTST IS THIS ALPHANUMERIC APSC0335 BSC L BLD04,- IF NOT, EXIT AT RETURN+1 APSC0336 A NMTST RESTORE CHARACTER APSC0337 MDX 2 -1 COUNT CHARACTERS PER WD APSC0338 MDX BLD01 BUILD IDENTIFIER WORD APSC0339 LDX 2 3 SET 3 CHARS FOR NEXT WD APSC0340 MDX 1 1 COUNT IDENTIFIER WORDS APSC0341 MDX BLD02 SAVE CHARACTER APSC0342 BSC L INCID INCORRECT IDENTIFIER APSC0343 BLD04 MDX L BLDID,1 ADJUST EXIT FOR RETURN+1 APSC0344 BLDXT LDS 0 INDICATE IDENTIFIER APSC0345 BSC I BLDID EXIT APSC0346 FORTY DC 40 APSC0347 NMTST DC /25 APSC0348 ALCHR DC /1B APSC0349 TEN DC 10 APSC0350 CHAR EQU * APSC0351 HDNG BUILD INTEGER APSC0352 * X2,X3 DESTROYED APSC0353 BLNUM DC 0 APSC0354 LDX 2 5 BUILD NUMBER OF UP TO APSC0355 SRT 16 SHIFT DOWN DIGIT AND APSC0356 MDX BLN02 GO TO STORE IT APSC0357 BLN01 SRT 16 SAVE LAST APSC0358 STD IDENT+2 DIGIT APSC0359 LDD IDENT MULTIPLY DEVELOPING APSC0360 SLT 2 NUMBER APSC0361 AD IDENT BY APSC0362 SLT 1 TEN APSC0363 AD IDENT+2 ADD IN DIGIT APSC0364 BLN02 STD IDENT SAVE NUMBER APSC0365 BSI GETCH GET NEXT CHARACTER APSC0366 MDX BLNXT EXIT IF END OF STATEMENT APSC0367 S NMTST IS SPECIAL CHARACTER? APSC0368 BSC L BLN04,- END OF NUMBER IF YES APSC0369 A TEN IS ALPHABETIC? APSC0370 BSC L INCNM,+Z ERROR IF YES APSC0371 MDX 2 -1 COUNT DIGITS APSC0372 MDX BLN01 BRANCH TO BUILD NUMBER APSC0373 BLN05 BSC L INCNM APSC0374 BLN04 MDX L BLNUM,1 ADJUST EXIT FOR RETURN+1 APSC0375 BLNXT MDX L IDENT,0 CHECK NUMBER LEQ 65535 APSC0376 MDX BLN05 ERROR IF NOT APSC0377 LDS 3 INDICATE NUMBER READ APSC0378 BSC I BLNUM EXIT APSC0379 HDNG GET CHARACTER FROM STATEMENT BUFFER APSC0380 GETCH DC 0 APSC0381 LD L R14 IS THIS END OF APSC0382 S L R13 STATEMENT APSC0383 BSC I GETCH,+ EXIT IF YES APSC0384 MDX L GETCH,1 ADJUST EXIT FOR RETURN+1 APSC0385 LD I R14 GET CHARACTER APSC0386 GET02 MDX L R14,-1 ADJUST CURRENT POINTER APSC0387 BSC I GETCH,Z EXIT FOR NON-ZERO CHAR APSC0388 BSC L INCOM APSC0389 * APSC0390 * APSC0391 NONBK DC 0 APSC0392 NON01 BSI GETCH GET NEXT CHARACTER APSC0393 MDX NONXT EXIT IF END OF LINE APSC0394 S BLKCH IS THIS BLANK? APSC0395 BSC L NON01,+- TRY AGAIN IF YES APSC0396 NON02 EQU * APSC0397 MDX L NONBK,1 ADJUST,EXIT FOR RETURN+1 APSC0398 NONXT BSC I NONBK EXIT APSC0399 * APSC0400 HDNG INCORRECT COMMANDS APSC0401 * APSC0402 INCNM EQU * INCORRECT USER NUMBER APSC0403 LDX 1 5 NUMBER NOT IN SYSTEM APSC0404 MDX INCXT APSC0405 INCOM EQU * INCORRECT COMMAND APSC0406 INCID EQU * INCORRECT IDENTIFIER APSC0407 LDX 1 19 APSC0408 MDX INCXT APSC0409 WSNFD LDX 1 20 WORKSPACE NOT FOUND APSC0410 MDX INCXT APSC0411 NROOM LDX 1 21 SYSTEM FULL APSC0412 MDX INCXT APSC0413 NOFDF LDX 1 23 NOT WITH OPN DEFINITION APSC0414 MDX INCXT APSC0415 SREMS LDX 1 22 SAVE RATION EXCEEDED APSC0416 MDX INCXT APSC0417 INSGN LDX 1 3 INVALID SIGN ON APSC0418 * APSC0419 * APSC0420 INCXT MDX L1 /8000 APSC0421 NOP APSC0422 BSC L ERRXT APSC0423 HDNG LIST OF PARAMETER REQUIREMENTS APSC0424 * APSC0425 ALN EQU /8000 ALPHANUMERIC PARAMETER APSC0426 LNG EQU /4000 LONG PARAMETER APSC0427 OMT EQU /2000 MAY BE OMITTED APSC0428 TRM EQU /1000 MUST BE ENDED BY BLANK APSC0429 * APSC0430 USR EQU 2 USER NUMBER APSC0431 KEY EQU 4 USER KEYWORD APSC0432 WKS EQU 6 WORKSPACE OR USER NAME APSC0433 PSW EQU 10 WORKSPACE PASSWORD APSC0434 OPN EQU 12 OPERAND APSC0435 KNDLS EQU * APSC0436 KND01 DC ALN+TRM+USR COMMAND APSC0437 KND02 DC KEY USER APSC0438 DC ALN+TRM+WKS KEYWORD APSC0439 KND03 DC ALN+LNG+TRM+USR COMMAND APSC0440 DC TRM USER APSC0441 KND04 DC ALN+TRM+USR COMMAND APSC0442 DC OMT+TRM USER APSC0443 KND05 DC ALN+KEY COMMAND APSC0444 DC ALN+OMT+TRM KEYWORD APSC0445 KND06 DC ALN+TRM+OPN COMMAND APSC0446 DC ALN+OMT+TRM+OPN OPERAND APSC0447 KND07 DC ALN+TRM+USR COMMAND APSC0448 DC OMT+TRM+WKS USER APSC0449 DC ALN+LNG+PSW WORK SPACE APSC0450 DC ALN+TRM+OPN PASSWORD APSC0451 DC ALN+OMT+TRM+OPN OPERAND APSC0452 * APSC0453 HDNG LIST OF COMMANDS APSC0454 PRIV EQU /8000 PRIVILEGED COMMAND APSC0455 TYP EQU /8000 TYPEWRITER COMMAND APSC0456 FLH EQU /4000 ALLOW COMMAND IN FLUSH APSC0457 FDF EQU /2000 NOT DURING FN DEF APSC0458 DIR EQU /1000 LOAD DIRECTORIES APSC0459 FWS EQU /0800 FIND WORKSPACE APSC0460 CPW EQU /0400 CHECK PASSWORD APSC0461 OVL EQU /0100 OVERLAY REQUIRED APSC0462 PAR EQU /0020 PARAMETERS REQUIRED APSC0463 * APSC0464 K1 EQU KND01-KNDLS APSC0465 K2 EQU KND02-KNDLS APSC0466 K3 EQU KND03-KNDLS APSC0467 K4 EQU KND04-KNDLS APSC0468 K5 EQU KND05-KNDLS APSC0469 K6 EQU KND06-KNDLS APSC0470 K7 EQU KND07-KNDLS APSC0471 * APSC0472 A EQU 1 APSC0473 B EQU 2 APSC0474 C EQU 3 APSC0475 D EQU 4 APSC0476 E EQU 5 APSC0477 F EQU 6 APSC0478 G EQU 7 APSC0479 H EQU 8 APSC0480 I EQU 9 APSC0481 J EQU 10 APSC0482 K EQU 11 APSC0483 L EQU 12 APSC0484 M EQU 13 APSC0485 N EQU 14 APSC0486 O EQU 15 APSC0487 P EQU 16 APSC0488 Q EQU 17 APSC0489 R EQU 18 APSC0490 S EQU 19 APSC0491 T EQU 20 APSC0492 U EQU 21 APSC0493 V EQU 22 APSC0494 W EQU 23 APSC0495 X EQU 24 APSC0496 Y EQU 25 APSC0497 Z EQU 26 APSC0498 SPC EQU 38 SPACES FOR OUTPUT APSC0499 EQL EQU 37 EQUAL FOR OUTPUT APSC0500 NIL EQU 27 APSC0501 ONE EQU 28 APSC0502 TWO EQU 29 APSC0503 THR EQU 30 APSC0504 * APSC0505 CMNDS BSS E 0 APSC0506 DC 1600*A+40*S+S APSC0507 DC I*1600+G*40+N APSC0508 DC PRIV+ASSGN-ASMSC APSC0509 DC DIR+FWS+4*PAR+K7 APSC0510 DC P*1600+E*40+O PEOPLE APSC0511 DC P*1600+L*40+E APSC0512 DC PRIV+PEOPL-ASMSC APSC0513 DC DIR+PAR+K1 APSC0514 DC S*1600+P*40+A SPACES APSC0515 DC C*1600+E*40+S APSC0516 DC PRIV+SPACE-ASMSC APSC0517 DC DIR+PAR+K1 APSC0518 DC S*40+I APSC0519 DC 0 APSC0520 DC SI-ASMSC APSC0521 DC PAR+K1 APSC0522 DC S*1600+I*40+V APSC0523 DC 0 APSC0524 DC SIV-ASMSC APSC0525 DC PAR+K1 APSC0526 DC W*1600+S*40+I APSC0527 DC D APSC0528 DC WSID-ASMSC APSC0529 DC PAR+K1 APSC0530 DC F*1600+N*40+S FNS APSC0531 DC 0 APSC0532 DC FNS-ASMSC APSC0533 DC PAR+K1 APSC0534 DC C*1600+L*40+E CLEAR APSC0535 DC A*40+R APSC0536 DC CLEAR-ASMSC APSC0537 DC PAR+K1 APSC0538 DC V*1600+A*40+R VARS APSC0539 DC S APSC0540 DC VARS-ASMSC APSC0541 DC PAR+K1 APSC0542 DC E*1600+X*40+P EXPUNGE APSC0543 DC U*1600+N*40+G APSC0544 DC PRIV+EXPNG-ASMSC APSC0545 DC DIR+2*PAR+K3 APSC0546 DC L*1600+I*40+B LIB APSC0547 DC 0 APSC0548 DC LIB-ASMSC APSC0549 DC DIR+2*PAR+K4 APSC0550 SIGN DC O*40+N SIGN ON APSC0551 DC 0 APSC0552 DC SGNON-ASMSC APSC0553 DC DIR+2*PAR+K2 APSC0554 DC O*1600+F*40+F OFF APSC0555 DC 0 APSC0556 DC OFF-ASMSC APSC0557 DC DIR+2*PAR+K5+FLH APSC0558 DC C*1600+A*40+R CARD APSC0559 DC D APSC0560 DC CARD-ASMSC APSC0561 DC FLH+2*PAR+K6 APSC0562 DC P*1600+C*40+H APSC0563 DC 0 APSC0564 DC PNCHA APSC0565 DC TYP+FDF+1*OVL+2*PAR+K6 APSC0566 DC P*1600+C*40+H APSC0567 DC S APSC0568 DC PUNCH APSC0569 DC TYP+FDF+DIR+FWS+CPW+1*OVL+5*PAR+K7 APSC0570 DC C*1600+O*40+P COPY APSC0571 DC Y APSC0572 DC COPY APSC0573 DC FDF+DIR+FWS+CPW+2*OVL+5*PAR+K7 APSC0574 DC P*1600+C*40+O PCOPY APSC0575 DC P*40+Y APSC0576 DC PCOPY APSC0577 DC FDF+DIR+FWS+CPW+2*OVL+5*PAR+K7 APSC0578 DC L*1600+O*40+A LOAD APSC0579 DC D APSC0580 DC LOAD-ASMSC APSC0581 DC DIR+FWS+CPW+4*PAR+K7 APSC0582 DC S*1600+A*40+V SAVE APSC0583 DC E APSC0584 DC SAVE-ASMSC APSC0585 DC FDF+DIR+FWS+4*PAR+K7 APSC0586 DC D*1600+R*40+O DROP APSC0587 DC P APSC0588 DC DROP-ASMSC APSC0589 DC DIR+FWS+3*PAR+K7 APSC0590 DC E*1600+R*40+A APSC0591 DC S*40+E APSC0592 DC ERASE ERASE APSC0593 DC 2*OVL+2*PAR+K6 APSC0594 DC 0 END OF LIST APSC0595 HDNG SEARCH DIRECTORIES APSC0596 * APSC0597 * SEARCH WORKSPACE DIRECTORY APSC0598 * APSC0599 FNWKS DC 0 APSC0600 SRA 16 INITIALISE APSC0601 STO WSPCE SPACE FOR AN ASSIGN APSC0602 STO HOLE SPACE FOR A SAVE APSC0603 STO L FOUND WORKSPACE FOUND ADDRESS APSC0604 LDX L2 CWDIR ADDRESS OF DIRECTORY APSC0605 LDX 1 40 NUMBER OF SPACES APSC0606 STX 3 FNW02+1 SAVE ROUTINE TO EXECUTE APSC0607 STX 1 FNWCT SAVE COUNT OF ENTRIES APSC0608 FNW01 LD 2 0 GET NEXT ENTRY APSC0609 BSC +- BRANCH IF NOT EMPTY APSC0610 STX 2 WSPCE INDICATE AVAILABLE WS APSC0611 S L PARAM+1 IS THIS REQUIRED USER APSC0612 STX 2 FNW03+1 SAVE X2 APSC0613 FNW02 BSI L *-*,+- EXECUTE ROUTINE IF USER APSC0614 FNW03 LDX L2 *-* RESTORE X5 APSC0615 MDX 2 8 NEXT ENTRY ADDRESS APSC0616 MDX L FNWCT,-1 COUNT ENTRIES APSC0617 MDX FNW01 GO TO NEXT ENTRY APSC0618 BSC I FNWKS EXIT APSC0619 WSPCE DC 0 APSC0620 HOLE DC 0 APSC0621 * APSC0622 * SEARCH USER DIRECTORY APSC0623 * APSC0624 FNUSR DC 0 APSC0625 SRA 16 INITIALISE APSC0626 STO USRSP SPACE FOR NEW USER APSC0627 STO USRFN USER ENTRY APSC0628 LDX L2 CUDIR ADDRESS AND COUNT OF APSC0629 LDX 1 40 ASSIGNED APSC0630 STX 3 FNU02+1 SAVE ROUTINE TO EXECUTE APSC0631 STX 1 FNUCT SAVE COUNT OF ENTRIES APSC0632 FNU01 LD 2 0 GET NEXT USER APSC0633 BSC +- BRANCH IF EMPTY ENTRY APSC0634 STX 2 USRSP INDICATE AVAILABLE ENTRY APSC0635 STX 2 FNU03+1 SAVE X2 APSC0636 FNU02 BSI L *-*,Z EXECUTE ROUTINE IF USED APSC0637 FNU03 LDX L2 *-* RESTORE X5 APSC0638 FNU04 MDX 2 8 NEXT ENTRY ADDRESS APSC0639 MDX L FNUCT,-1 COUNT ENTRIES APSC0640 MDX FNU01 GO TO NEXT ENTRY APSC0641 BSC I FNUSR EXIT APSC0642 USRSP DC 0 APSC0643 USRFN DC 0 APSC0644 FNWCT DC 0 APSC0645 FNUCT DC 0 APSC0646 * APSC0647 * FIND REQUIRED WORKSPACE APSC0648 WSADR DC 0 APSC0649 LDX 3 -4 LENGTH OF WS NAME APSC0650 LD 2 1 IF ASSIGNED BUT UNUSED, APSC0651 BSC L WSA01,Z DO NOT BRANCH APSC0652 STX 2 HOLE A HOLE HAS BEEN FOUND APSC0653 MDX WSA02 IN CASE OF A SAVE APSC0654 WSA01 LD L3 PARAM+8 COMPARE WORD OF REQ'D APSC0655 S 2 1 WS WITH ENTRY WS APSC0656 BSC L WSA02,Z EXIT IF DIFFERENT APSC0657 MDX 2 1 CONTINUE WITH NEXT WORD APSC0658 MDX 3 1 COUNT 4 WORDS APSC0659 MDX WSA01 GO TO COMPARE NEXT WORD APSC0660 MDX 2 -4 STORE ADDRESS OF APSC0661 STX L2 FOUND WS FOUND APSC0662 WSA02 BSC I WSADR EXIT APSC0663 HDNG CHECK PASSWORD APSC0664 CHPSW DC 0 APSC0665 LDX I2 FOUND APSC0666 LD L FOUND WORK SPACE FOUND APSC0667 BSC L WSNFD,+- ERROR IF NOT APSC0668 LD 2 5 PASSWORD APSC0669 S L PARAM+8 USER. - CHECK 1ST WORD APSC0670 CHPW1 BSC L WSNFD,Z APSC0671 LD 2 6 DIFFERENT UNPRIVILEGED APSC0672 S L PARAM+9 HAS 2ND WORD BEEN APSC0673 BSC I CHPSW,+- GIVEN, EXIT IF YES APSC0674 MDX CHPW1 APSC0675 * APSC0676 * CHECK NON PRIVILEGED USER APSC0677 * FOR SAVE & DROP APSC0678 CHNPU DC 0 APSC0679 LD L SINON APSC0680 BSC I CHNPU,+Z APSC0681 LD L USER GET USER NUMBER APSC0682 S L PARAM+1 NON PRIVILEGED USER CAN APSC0683 BSC I CHNPU,+- ONLY DROP HIS OWN SPACE APSC0684 CHNP1 BSC L INCOM INCORRECT COMMAND APSC0685 HDNG LOAD/STORE DIRECTORIES AND WORKSPACES APSC0686 * LOAD OR STORE M-SPACE APSC0687 * APSC0688 LSMSP DC 0 APSC0689 STX 1 LSM01 DISK ADDRESS APSC0690 BSI L DKORG READ OR WRITE 6 SECTORS APSC0691 LSM01 DC 0 APSC0692 DC MATRX APSC0693 DC 6 APSC0694 DC /140 APSC0695 BSC I LSMSP EXIT APSC0696 * APSC0697 * APSC0698 * APSC0699 * LOAD OR STORE DIRECTORIES APSC0700 * APSC0701 LDDIR DC 0 APSC0702 BSI L DKORG READ OR WRITE APSC0703 DC DUDIR USER AND APSC0704 DC CUDIR WORKSPACE APSC0705 DC 2 DIRECTORIES APSC0706 DC /140 APSC0707 BSC I LDDIR APSC0708 * APSC0709 HDNG PRINT ROUTINES APSC0710 * APSC0711 * PRINT USER NUMBER APSC0712 * X2 CONTAINS ADDRESS OF USER NUMBER APSC0713 PRNCH EQU LOCOR+2 APSC0714 PRUSE DC 0 APSC0715 LDX L3 PRNCH+5 UNPACK THE NUMBER APSC0716 LDX 1 5 5 CHARACTERS IN USER APSC0717 LD 2 0 USER NUMBER APSC0718 SRT 16 MAKE IT A DOUBLE WORD APSC0719 UNU01 SRA 16 ZERO ACCUMULATOR APSC0720 D D0010 ISOLATE NEXT CHARACTER APSC0721 RTE 16 0 - 9 APSC0722 A H001B MAKE IT ALC APSC0723 MDX 3 -1 ADJUST SAVE ADDRESS APSC0724 STO 3 0 SAVE THE DIGIT APSC0725 MDX 1 -1 COUNT CHARACTERS APSC0726 MDX UNU01 GET NEXT CHARACTER APSC0727 LDX 1 5 PRINT ALL 6 CHARACTERS APSC0728 BSI L TYNCH APSC0729 BSC I PRUSE EXIT APSC0730 * APSC0731 * UNPACK USER NUMBER APSC0732 * APSC0733 H001B DC /001B APSC0734 D0010 DC 10 APSC0735 HDNG PEOPLE COMMAND APSC0736 * APSC0737 PEOPL DC 0 APSC0738 LDX L3 TYUSR SCAN USER DIRECTORY APSC0739 BSI L FNUSR TO PRINT USER NAME ETC APSC0740 BSC I PEOPL APSC0741 * APSC0742 TYUSR DC 0 NON-PRIVILEGED USER APSC0743 BSI PRUSE TYPE USER NUMBER APSC0744 MDX 2 3 APSC0745 TYU01 LD D0007 APSC0746 BSI L MVCRG CARRAIGE APSC0747 LDX 1 4 TYPE APSC0748 BSI L PRNID USER NAME APSC0749 LD 2 0 ISOLATE AND STORE APSC0750 STO SNON SIGN ONS APSC0751 LD D0018 APSC0752 BSI L MVCRG APSC0753 LDX L2 SOEMS TYPE APSC0754 LDX 1 2 SO= (SIGN ONS) APSC0755 BSI L PRNID MESSAGE APSC0756 LDX L2 SNON PRINT NUMBER OF SIGN ONSAPSC0757 BSI PRUSE SIGN ONS APSC0758 BSI L PRCRT PRINT CARRAIGE RETURN APSC0759 BSC I TYUSR EXIT APSC0760 D0018 DC 18 APSC0761 D0007 DC 7 APSC0762 SOEMS DC SPC*1600+SPC*40+S APSC0763 DC O*40+EQL APSC0764 HDNG SPACES COMMAND APSC0765 * APSC0766 SPACE DC 0 APSC0767 LDX L3 TYSPS SCAN USER DIRECTORY APSC0768 BSI L FNUSR TO PRINT LIBRARY OF APSC0769 BSC I SPACE WORK SPACES APSC0770 * APSC0771 TYSPS DC 0 APSC0772 LD 2 0 SAVE CURRENT APSC0773 STO L PARAM+1 USER APSC0774 BSI PRUWS USER WITH PASSWORDS APSC0775 BSC I TYSPS EXIT APSC0776 SNON EQU SPACE APSC0777 WSCNT EQU SNON APSC0778 WKSPS EQU TYSPS APSC0779 HDNG LIB COMMAND APSC0780 LIB DC 0 APSC0781 LD L PARAM+1 NO WORK SPACES FOR APSC0782 BSC L INCOM,+- USER ZERO APSC0783 LDX L3 ASUSR FIND USER IN APSC0784 BSI L FNUSR DIRECTORY APSC0785 LD L USRFN APSC0786 BSC L INCNM,+- ERROR IF NOT APSC0787 LDX I2 USRFN APSC0788 BSI PRUWS APSC0789 BSC I LIB EXIT APSC0790 * APSC0791 PRUWS DC 0 APSC0792 BSI L PRUSE PRINT USER NUMBER APSC0793 LDX L3 TYWKS TYPE WORK SPACES APSC0794 BSI L FNWKS BELONGING TO USER APSC0795 BSC I PRUWS EXIT APSC0796 TYWKS DC 0 WS BELONGING TO USER APSC0797 LD D0007 APSC0798 BSI L MVCRG CARRAIGE APSC0799 LDX 1 4 WORK SPACE APSC0800 MDX 2 1 PRINT APSC0801 LD 2 0 IS THIS W/S USED APSC0802 BSC L TYW03,Z BRANCH IF NOT APSC0803 LDX L2 UWSMS MESSAGE APSC0804 TYW03 BSI TYPMC APSC0805 BSC I TYWKS EXIT APSC0806 UWSMS DC U*1600+N*40+U APSC0807 DC S*1600+E*40+D APSC0808 DC SPC*1600+W*40+S APSC0809 DC 0 APSC0810 HDNG DROP COMMAND APSC0811 * APSC0812 DROP DC 0 APSC0813 LD L FOUND APSC0814 BSC L WSNFD,+- APSC0815 BSI L CHNPU CHECK TO SEE IF LEGIT- APSC0816 * IMATE REQUEST APSC0817 LDX I2 FOUND ADDRESS OF WORK SPACE APSC0818 BSI DRWSP DROP WORK SPACE APSC0819 LD L SINON IS THIS PRIVILEGED USER APSC0820 BSC L DROP1,- BRANCH IF NOT APSC0821 LDX L3 ASUSR APSC0822 BSI L FNUSR FIND USER APSC0823 SRA 16 ZERO WS COUNT APSC0824 STO WSCNT APSC0825 LD L FOUND APSC0826 STO DROP2+1 APSC0827 LDX L3 CNTWS SEARCH WS DIRCTORY TO APSC0828 BSI L FNWKS COUNT USERS WORKSPACES APSC0829 LD WSCNT IS THERE MORE THAN ONE WS APSC0830 S D0001 APSC0831 BSC L DROP1,+ BRANCH IF ONLY ONE APSC0832 SRA 16 APSC0833 DROP2 STO L *-* APSC0834 DROP1 EQU * APSC0835 LDS 3 STORE APSC0836 BSI L LDDIR DIRECTORIES APSC0837 BSC I DROP EXIT APSC0838 CNTWS DC 0 APSC0839 MDX L WSCNT,1 ADVANCE WS COUNT APSC0840 BSC I CNTWS EXIT APSC0841 * APSC0842 DRWSP DC 0 DROP WORK SPACE APSC0843 MDX 2 1 ADDRESS OF WORKSPACE APSC0844 LDX 1 4 PRINT APSC0845 STX 2 DRW02+1 APSC0846 LD 2 0 APSC0847 BSC L DRW01,Z APSC0848 LDX L2 UWSMS APSC0849 DRW01 BSI L PRNID APSC0850 DRW02 LDX L2 *-* APSC0851 SLT 32 REMOVE APSC0852 STO 2 0 APSC0853 STD 2 1 APSC0854 STD 2 3 APSC0855 STO 2 5 APSC0856 LDX L2 DRPED TYPE APSC0857 BSI TYPMC APSC0858 BSC I DRWSP EXIT APSC0859 DRPED DC SPC*1600+D*40+R APSC0860 DC O*1600+P*40+P APSC0861 DC E*40+D APSC0862 DC 0 APSC0863 HDNG EXPUNGE COMMAND APSC0864 * APSC0865 EXPNG DC 0 APSC0866 LD L PARAM+1 APSC0867 S L USER APSC0868 BSC L INCOM,+- APSC0869 LDX L3 DRPUS SCAN USER DIRECTORY APSC0870 BSI L FNUSR TO DROP USER APSC0871 LD L USRFN WAS USER DROPPED APSC0872 BSC L INCNM,+- ERROR IF NOT APSC0873 LDS 3 STORE APSC0874 BSI L LDDIR DIRECTORIES APSC0875 BSC I EXPNG EXIT APSC0876 * APSC0877 DRPUS DC 0 DROP USER APSC0878 S L PARAM+1 IS IT THIS USER APSC0879 BSC I DRPUS,Z EXIT IF NOT APSC0880 STX L2 USRFN APSC0881 SLT 32 ZERO OUT APSC0882 STD 2 0 APSC0883 STD 2 2 ZERO OUT APSC0884 STD 2 4 USER APSC0885 STD 2 6 NAME APSC0886 LDX L3 REMOV SCAN WORKSPACE DIRECTORY APSC0887 BSI L FNWKS TO REMOVE WORKSPACE APSC0888 BSC I FNUSR EXIT FROM FNUSR APSC0889 * APSC0890 REMOV DC 0 USER WORKSPACE FOUND APSC0891 SRA 16 CLEAR USER FROM APSC0892 STO 2 0 WORKSPACE ENTRY APSC0893 BSI DRWSP DROP WORK SPACE APSC0894 BSC I REMOV EXIT APSC0895 TYPMC DC 0 APSC0896 LDX 1 4 APSC0897 BSI L PRNID APSC0898 BSI L PRCRT APSC0899 BSC I TYPMC APSC0900 D0001 DC 1 APSC0901 * APSC0902 HDNG ASSIGN COMMAND APSC0903 * APSC0904 ASSGN DC 0 APSC0905 LD L PARAM+1 IN WORKSPACE APSC0906 BSC L INCOM,+- NO ASSIGNS FOR USER ZERO APSC0907 LD L WSPCE BRANCH IF APSC0908 BSC L NROOM,+- NO ROOM FOR ANOTHER WS APSC0909 LDX L3 ASUSR SCAN USER DIRECTORY APSC0910 BSI L FNUSR TO FIND USER APSC0911 LDX L1 PARAM ADDRESS OF PARAMETERS APSC0912 LDX I2 USRFN SKIP IF USER NOT APSC0913 MDX 2 0 FOUND APSC0914 MDX ASS02 APSC0915 LDX I2 USRSP NEW USER - USE NEW ENTRY APSC0916 ASS02 LD 1 8 WAS USER KEY SUPPLIED APSC0917 BSC L ASS03,+- BRANCH IF NOT APSC0918 STO 2 1 STORE TWO WORD APSC0919 LD 1 9 APSC0920 STO 2 2 KEYWORD APSC0921 ASS03 LD 1 4 WAS USER NAME GIVEN APSC0922 STO 2 3 STORE FOUR WORD APSC0923 LD 1 5 USER APSC0924 STO 2 4 NAME APSC0925 LD 1 6 APSC0926 STO 2 5 APSC0927 LD 1 7 APSC0928 STO 2 6 APSC0929 ASS04 EQU * APSC0930 LD 1 1 STORE USER NUMBER APSC0931 STO 2 0 APSC0932 STO I WSPCE SAVE USER NUMBER APSC0933 LDS 3 STORE DIRECTORIES APSC0934 BSI L LDDIR APSC0935 BSC I ASSGN APSC0936 * APSC0937 ASUSR DC 0 NON PRIVILEGED USER APSC0938 S L PARAM+1 IS THIS REQUIRED USER APSC0939 BSC I ASUSR,Z EXIT IF NOT APSC0940 STX L2 USRFN APSC0941 BSC I FNUSR EXIT FROM FNUSR APSC0942 * APSC0943 D0005 DC 5 APSC0944 HDNG SIGN ON COMMAND APSC0945 * APSC0946 SGNON DC 0 APSC0947 LD L PARAM+1 APSC0948 BSC L SGN02,+- USER ZERO APSC0949 LDX L3 ASUSR SCAN USER DIRECTORY APSC0950 BSI L FNUSR FOR USER APSC0951 LD L USRFN WAS USER FOUND APSC0952 BSC L INCNM,+- APSC0953 LDX I2 USRFN ENTRY ADDRESS APSC0954 SGN03 LD 2 1 IS THERE A KEYWORD APSC0955 S L PARAM+2 APSC0956 BSC L INCNM,Z WRONG KEY APSC0957 LD 2 2 APSC0958 S L PARAM+3 APSC0959 BSC L INCNM,Z WRONG KEY APSC0960 SGN01 LD 2 7 ADVANCE APSC0961 A H1 COUNT OF APSC0962 STO 2 7 SIGN ONS APSC0963 LDS 3 STORE APSC0964 BSI L LDDIR DIRECTORIES APSC0965 MDX 2 3 TYPE APSC0966 LDX 1 4 USER APSC0967 BSI L PRNID NAME APSC0968 LD L PARAM+1 SET USER NUMBER APSC0969 SGN02 LDX L1 USER APSC0970 STO 1 0 APSC0971 LD X8000 RETAIN PRIVILEGED BIT APSC0972 AND 1 SINON-USER APSC0973 STO 1 SINON-USER APSC0974 BSI CLEAR LOAD CLEAR WORKSPACE APSC0975 LDX L2 SONMS TYPE APSC0976 LDX 1 4 APSC0977 BSI L PRNID APSC0978 LDX L3 TYPE APSC0979 LDX L1 LNFD APSC0980 BSI 3 TYPE-TYPE APSC0981 LDX L1 LNFD APSC0982 BSI 3 TYPE-TYPE APSC0983 LDX L2 APLMS TYPE APSC0984 LDX 1 2 APSC0985 BSI 3 PRNID-TYPE APSC0986 LDX L1 BKSLA APSC0987 BSI L TYPE APSC0988 BSI L TYPMC APSC0989 BSI L PRCRT CARRAIGE RETURNS APSC0990 BSC I SGNON EXIT APSC0991 LNFD DC /7A APSC0992 H1 DC 1 APSC0993 D0020 DC 20 APSC0994 SONMS DC SPC*1600+S*40+I APSC0995 DC G*1600+N*40+E APSC0996 DC D*1600+SPC*40+O APSC0997 DC N*40+SPC APSC0998 APLMS DC A*1600+SPC*40+P APSC0999 DC SPC*1600+L*40+SPC APSC1000 DC SPC*1600+ONE*40+SPC APSC1001 DC ONE*1600+SPC*40+THR APSC1002 DC SPC*40+NIL APSC1003 DC 0 APSC1004 BKSLA DC /51 APSC1005 SOFMS DC S*1600+I*40+G APSC1006 DC N*1600+E*40+D APSC1007 DC SPC*1600+O*40+F APSC1008 DC F APSC1009 X8000 DC /8000 APSC1010 HDNG CLEAR COMMAND APSC1011 * APSC1012 CLEAR DC 0 APSC1013 SLT 32 CLEAR WORK SPACE APSC1014 LDX L1 LWKSP USER NUMBER AND NAME APSC1015 STD 1 0 APSC1016 STD 1 2 APSC1017 STO 1 4 APSC1018 LDS 1 APSC1019 BSI L DKORG GET WORKSPACE APSC1020 DC DEMWS APSC1021 DC MATRX APSC1022 DC 1 APSC1023 DC /140 APSC1024 LDX I1 PAREL GET TOP LEVEL HEADER APSC1025 LD H4000 SET POINTER TO NEXT APSC1026 STO 1 0 LEVEL. (ODD ALIGNMENT) APSC1027 SLT 32 ZERO OUT REMAINDER APSC1028 STD 1 2 APSC1029 STO L MODE APSC1030 LD L SOLPT APSC1031 STO 1 1 APSC1032 STO 1 4 APSC1033 BSC I CLEAR APSC1034 HDNG CARD COMMAND APSC1035 * APSC1036 CARD DC 0 APSC1037 LDX L1 CDSW FOR CONVENIENCE APSC1038 LD HE000 INITIALISE APSC1039 STO OPTNS OPTIONS APSC1040 MDX L CLASS,-12 APSC1041 MDX CAR01 BRANCH IF YES APSC1042 MDX CAR07 BRANCH IF NOT APSC1043 CAR01 LDX L3 PARAM+10 ADDRESS OF FIRST PARAM APSC1044 LDD 3 0 IS THIS APSC1045 SD OPRND+16 CARD END APSC1046 BSC L CAR02,Z COMMAND APSC1047 SLT 16 BRANCH IF APSC1048 BSC L CAR09,+- YES APSC1049 CAR02 LDX 2 -16 NUMBER OF POSSIBLE PARMS APSC1050 CAR03 LDD L2 OPRND+16 IS THIS THE APSC1051 SD 3 0 PARAMETER APSC1052 BSC L CAR14,Z BRANCH IF NOT APSC1053 SLT 16 APSC1054 BSC L CAR04,+- BRANCH IF YES APSC1055 CAR14 MDX 2 4 APSC1056 MDX CAR03 TRY AGAIN APSC1057 MDX CAR08 INVALID PARAMETER APSC1058 CAR04 LD L2 OPRND+18 APSC1059 BSC L CAR05,- BRANCH IF OPTION REQ'D APSC1060 AND OPTNS REMOVE OPTION APSC1061 MDX CAR06 APSC1062 CAR05 OR OPTNS ENSURE OPTION IS PRESENT APSC1063 CAR06 STO OPTNS SAVE OPTIONS APSC1064 MDX 3 2 NEXT INPUT PARAMETER APSC1065 MDX L CLASS,-2 COUNT INPUT PARAMETERS APSC1066 MDX CAR02 BRANCH IF MORE APSC1067 CAR07 LD 1 0 NO MORE PARAMETERS APSC1068 SLA 3 IS THIS A FLUSH APSC1069 BSC I CARD,+Z EXIT IF YES APSC1070 LD OPTNS NOT A FLUSH, APSC1071 MDX CAR11 GO TO STORE OPTIONS APSC1072 CAR08 LD 1 0 INVALID PARAMETER APSC1073 SLA 3 IS THIS A FLUSH APSC1074 BSC I CARD,+Z EXIT IF YES APSC1075 CAR12 BSC L INCOM INCORRECT COMMAND APSC1076 CAR09 LD 1 0 END COMMAND APSC1077 MDX L CLASS,-2 HOW MANY PARMS? ERROR IF APSC1078 MDX CAR12 MORE THAN ONE OPERAND APSC1079 BSC L CAR10,- BRANCH IF TYPE MODE APSC1080 SRA 16 SWITCH TO CARD MODE APSC1081 MDX CAR13 GO TO STORE OPTIONS APSC1082 CAR10 LD H9000 INITIATE A CARD FLUSH APSC1083 STO OPTNS APSC1084 CAR11 LD 1 0 ISOLATE EXISTING APSC1085 AND H0FFF OPTIONS APSC1086 OR OPTNS ADD NEW OPTIONS APSC1087 CAR13 STO 1 0 SAVE CARD SWITCH APSC1088 BSC I CARD EXIT APSC1089 BSS E 0 APSC1090 OPRND DC N*1600+O*40+E APSC1091 DC D*1600+I*40+T APSC1092 HMASK DC /B000 APSC1093 OPTNS DC 0 APSC1094 DC D*1600+I*40+S APSC1095 DC P APSC1096 DC /2000 APSC1097 H9000 DC /9000 APSC1098 DC N*1600+O*40+D APSC1099 DC I*1600+S*40+P APSC1100 DC /D000 APSC1101 HE000 DC /E000 APSC1102 DC E*1600+D*40+I APSC1103 DC T APSC1104 H4000 DC /4000 APSC1105 H0FFF DC /0FFF APSC1106 DC E*1600+N*40+D APSC1107 DC 0 APSC1108 HDNG OFF COMMAND APSC1109 * APSC1110 OFF DC 0 APSC1111 LDX L1 PARAM APSC1112 LD 1 -1 BRANCH IF LOCK TO BE APSC1113 BSC L OFF03,+- REMOVED APSC1114 LD 1 2 IS THERE A LOCK APSC1115 BSC L OFF01,+- BRANCH IF NOT APSC1116 OFF03 LD 1 1 BRANCH IF USER APSC1117 BSC L OFF01,+- ZERO APSC1118 LDX L3 ASUSR SCAN USER DIRECTORY APSC1119 BSI L FNUSR TO FIND USER APSC1120 LDX I2 USRFN ADDRESS OF USER ENTRY APSC1121 OFF02 LDD L PARAM+2 GET NEW KEYWORD APSC1122 STO 2 1 STORE APSC1123 SLT 16 IN USER APSC1124 STO 2 2 DIRECTORY ENTRY APSC1125 LDS 3 STORE APSC1126 BSI L LDDIR DIRECTORIES APSC1127 OFF01 STX L SINON SIGN ON SITUATION APSC1128 BSI L CLEAR APSC1129 LDX L2 SOFMS APSC1130 BSI L TYPMC APSC1131 LD L TYPSW APSC1132 SLA 1 APSC1133 LD L CDSW IS THIS CARD MODE APSC1134 LDX L1 DC41 APSC1135 BSI L TYPE,C- APSC1136 SRA 16 APSC1137 STO L CDSW APSC1138 BSC I OFF EXIT APSC1139 DC41 DC 126 DISCONNECT CODE FOR 2741 APSC1140 HDNG LOAD COMMAND APSC1141 * APSC1142 LOAD DC 0 WS MAY BE LOADED APSC1143 LDX I2 FOUND GET WORK SPACE DIRECTORY APSC1144 MDX 2 1 ENTRY AND APSC1145 LDX 1 4 TYPE APSC1146 BSI L PRNID WORKSPACE NAME APSC1147 LD 2 2 POSITION OF APSC1148 STO L 1 WORKSPACE APSC1149 LDX L2 DASTU STUDENT TRACK ADDRESS APSC1150 LDX L3 MATRX APSC1151 BSI L TSTUT LOAD STUDENT TRACK APSC1152 LDS 1 LOAD M MATRIX APSC1153 BSI L LSMSP ETC APSC1154 SRA 16 IMMEDIATE EXECUTION APSC1155 STO L MODE MODE APSC1156 BSI SWSID APSC1157 LDX L2 LDMES TYPE APSC1158 BSI L TYPMC APSC1159 BSC I LOAD EXIT APSC1160 LDMES DC SPC*1600+L*40+O APSC1161 DC A*1600+D*40+E APSC1162 DC D APSC1163 DC 0 APSC1164 SWSID DC 0 APSC1165 LDX L1 LWKSP APSC1166 LDX I2 FOUND KEEP APSC1167 LDD 2 0 FIRST FIVE APSC1168 STD 1 0 APSC1169 LDD 2 2 WORKSPACE ENTRY APSC1170 STD 1 2 APSC1171 LD 2 4 CURRENT APSC1172 STO 1 4 APSC1173 BSC I SWSID APSC1174 HDNG SAVE COMMAND APSC1175 * APSC1176 SAVE DC 0 APSC1177 LDX L3 PARAM FOR CONVENIENCE APSC1178 LD 3 1 USER NUMBE ZERO HAS NO APSC1179 BSC L INCOM,+- WORKSPACES APSC1180 BSI L CHNPU CHECK NON PRIVILEGED USR APSC1181 LD 3 FOUND-PARAM WAS WORKSPACE FOUND APSC1182 BSC L SAV02,Z BRANCH IF YES APSC1183 LD L HOLE IF NOT, IS THERE A HOLE APSC1184 BSC L SREMS,+- ERROR IF NONE APSC1185 STO 3 FOUND-PARAM SAVE ADDRESS OF HOLE APSC1186 STO L 2 IN DIRECTORY APSC1187 LDX 1 -6 AND APSC1188 SAV01 LD L1 PARAM+10 TRANSFER APSC1189 STO 2 1 WORKSPACE NAME APSC1190 MDX 2 1 AND APSC1191 MDX 1 1 PASSWORD APSC1192 MDX SAV01 TO DIRECTORY APSC1193 MDX SAV04 GO TO SAVE DIRECTORY APSC1194 SAV02 LDX I2 FOUND WORKSPACE WAS FOUND APSC1195 LDX 1 -5 CHECK TO SEE APSC1196 SAV03 LD L1 LWKSP+5 IF ACTIVE WORKSPACE APSC1197 S 2 0 CAN BE SAVED APSC1198 BSC L SAV07,Z NOT PERMITTED IF ACTIVE APSC1199 MDX 2 1 WORKSPACE NAME DIFFERS APSC1200 MDX 1 1 FROM THE INACTIVE NAME APSC1201 MDX SAV03 APSC1202 LD 3 -1 BRANCH IF LOCK TO BE APSC1203 BSC L SAV06,+- REMOVED APSC1204 LD 3 8 SAVE IS PERMITTED APSC1205 SAV06 STO 2 0 SAVE NEW LOCK APSC1206 LD 3 9 IN DIRECTORY APSC1207 STO 2 1 ENTRY APSC1208 SAV04 LDS 3 WRITE DIRECTORY APSC1209 BSI L LDDIR TO DISK APSC1210 SAV05 BSI SWSID APSC1211 LD 3 1 APSC1212 STO 1 0 APSC1213 MDX 2 1 PRINT APSC1214 LDX 1 4 NAME OF APSC1215 BSI L PRNID WORKSPACE APSC1216 * APSC1217 LD 2 2 SAVE APSC1218 STO L 1 MATRIX APSC1219 LDS 3 AND APSC1220 MDX 1 26 APSC1221 BSI L LSMSP IN WORKSPACE AREA APSC1222 LD 2 2 SAVE APSC1223 STO L 2 STUDENT APSC1224 LDX L1 DASTU TRACK APSC1225 LDX L3 MATRX APSC1226 BSI L TSTUT IN WORKSPACE AREA APSC1227 LDX I1 2 RESTORE APSC1228 LDS 1 AND STACK APSC1229 BSI L LSMSP INTO CORE APSC1230 LDX 1 2 TYPE APSC1231 LDX L2 SAVMS SAVED APSC1232 SAV08 BSI L PRNID APSC1233 BSI L PRCRT TYPE CARRAIGE RETURN APSC1234 MDX SAVXT GO TO EXIT APSC1235 SAV07 LDX L2 NSVMS TYPE APSC1236 LDX 1 6 NOT SAVED, WS IS APSC1237 BSI L PRNID MESSAGE APSC1238 BSI TYAWK TYPE ACTIVE WORKSPACE APSC1239 SAVXT BSC I SAVE EXIT APSC1240 SAVMS DC SPC*1600+S*40+A APSC1241 DC V*1600+E*40+D APSC1242 NSVMS DC N*1600+O*40+T APSC1243 DC SPC*1600+S*40+A APSC1244 DC V*1600+E*40+D APSC1245 DC SPC*1600+SPC*40+W APSC1246 DC S*1600+SPC*40+I APSC1247 DC S*40+SPC APSC1248 HDNG WSID COMMAND APSC1249 WSID DC 0 APSC1250 LDX L2 LWKSP ACTIVE WS NUMBER APSC1251 LD 2 1 IS THIS A CLEAN WS APSC1252 BSC L WSID1,+- BRANCH IF YES APSC1253 LD 2 0 DOES IT BELONG TO SIGNED ON USER APSC1254 S L USER APSC1255 BSC L WSID1,+- APSC1256 BSI L PRUSE APSC1257 BSI MVONE APSC1258 WSID1 EQU * APSC1259 BSI TYAWK TYPE ACTIVE WS NAME APSC1260 BSC I WSID APSC1261 * APSC1262 * TYPE ACTIVE WORKSPACE NAME APSC1263 * APSC1264 TYAWK DC 0 APSC1265 LDX L2 LWKSP+1 ACTIVE WS NAME APSC1266 LD 2 0 IS IT CLEAN APSC1267 BSC L TYAW1,Z BRANCH IF NOT APSC1268 LDX L2 CLWSM CLEAN WS MESSAGE APSC1269 TYAW1 BSI L TYPMC APSC1270 BSC I TYAWK EXIT APSC1271 CLWSM DC C*1600+L*40+E APSC1272 DC A*1600+R*40+SPC APSC1273 DC W*40+S APSC1274 DC 0 APSC1275 HDNG VARS,FNS AND NULL APSC1276 * APSC1277 VARS DC 0 APSC1278 LDS 3 PRINT VARIABLES IN APSC1279 BSI PGBTB GLOBAL TABLE APSC1280 BSC I VARS EXIT APSC1281 * APSC1282 FNS DC 0 APSC1283 LDS 0 PRINT FUNCTIONS IN APSC1284 BSI PGBTB GLOBAL TABLE APSC1285 BSC I FNS EXIT APSC1286 * APSC1287 NULCM DC 0 APSC1288 BSC I NULCM NULL COMMAND APSC1289 * APSC1290 * PRINT GLOBAL TABLE APSC1291 * APSC1292 PGBTB DC 0 APSC1293 STS PGB02 SAVE TYPE INDICATOR APSC1294 LD L NUMGL GET NUMBER OF GLOBALS APSC1295 BSC I PGBTB,+- EXIT IF NONE APSC1296 STO PGB07 SAVE GLOBAL COUNT APSC1297 LDX L2 GLBTB-4 START OF TABLE LESS 4 APSC1298 * APSC1299 PGB01 MDX 2 4 ADVANCE TO NEXT ENTRY APSC1300 LD 2 0 IS IT EMPTY APSC1301 BSC L PGB01,+- TRY NEXT ENTRY IF YES APSC1302 AND HF000 ISOLATE CLASS OF APSC1303 S H1000 GLOBAL APSC1304 PGB02 LDS 3 RESTORE TYPE INDICATOR APSC1305 BSC L PGB03,O BRANCH IF VARS APSC1306 BSC L PGB06,+- IGNORE IF VARIABLE APSC1307 MDX PGB04 APSC1308 PGB03 BSC L PGB06,Z IGNORE IF FUNCTION APSC1309 PGB04 STX 2 PGB05+1 SAVE GLOBAL ADDRESS APSC1310 MDX 2 2 ADDRESS OF 2 WORD APSC1311 BSI PRNT APSC1312 PGB05 LDX L2 *-* RESTORE ADDRESS APSC1313 PGB06 MDX L PGB07,-1 COUNT ENTRIES APSC1314 MDX PGB01 CONTINUE IF MORE APSC1315 LD L CHRCT PRINT CARRAIGE RETURN APSC1316 S C1 IF NOT AT HOME APSC1317 BSI L PRCRT,Z APSC1318 BSC I PGBTB EXIT IF NOT APSC1319 PGB07 EQU NULCM APSC1320 HF000 DC /F000 APSC1321 H1000 DC /1000 APSC1322 C1 DC 1 APSC1323 * PRINT ID ON SAME LINE IF POSSIBLE APSC1324 PRNT DC 0 APSC1325 LD L CHRCT APSC1326 S D100 APSC1327 BSC L PRNT1,+ BRANCH IF ROOM IN LINE APSC1328 BSI L PRCRT APSC1329 LD C16 APSC1330 BSI L MVCRG APSC1331 PRNT1 EQU * APSC1332 LDX 1 2 APSC1333 BSI L PRNID APSC1334 BSI MVONE APSC1335 BSC I PRNT APSC1336 C16 DC 16 APSC1337 D100 DC 100 APSC1338 MVONE DC 0 APSC1339 SRA 16 APSC1340 BSI L MVCRG APSC1341 BSC I MVONE APSC1342 HDNG SI AND SIV - LIST STATE INDICATORS APSC1343 * APSC1344 * LIST STATE INDICATOR APSC1345 * APSC1346 SI DC 0 APSC1347 LDS 3 APSC1348 BSI STACK APSC1349 BSC I SI APSC1350 * APSC1351 * LIST STATE INDICATOR AND LOCAL VARIABLES APSC1352 * APSC1353 SIV DC 0 APSC1354 LDS 0 APSC1355 BSI STACK APSC1356 BSC I SIV APSC1357 * APSC1358 * PRINT CONTENTS OF STACK APSC1359 * APSC1360 STACK DC 0 APSC1361 STS DELT5 APSC1362 LD L PAREL GET TOP LEVEL HEADER APSC1363 * APSC1364 DELT1 BSI L ABSAD ADDRESS TO X1 APSC1365 STX 1 DELT3+1 SAVE IT APSC1366 LD 1 0 IS THIS BOTTOM APSC1367 EOR L H4000 LEVEL APSC1368 BSC I STACK,+- APSC1369 AND H3000 IS THIS QUAD INPUT APSC1370 BSC L DELT2,+- BRANCH IF NOT APSC1371 LDX L1 QADCH GO TO TYPE QUAD APSC1372 BSI L TYPE TYPE QUAD APSC1373 MDX DELT8 GO DOWN A LEVEL APSC1374 * APSC1375 * APSC1376 * APSC1377 DELT2 BSI FNTRC PRINT FUNCTION ID AND APSC1378 * LINE NUMBER APSC1379 LD D0012 MOVE CARRAIGE TO APSC1380 BSI L MVCRG POSITION 12 APSC1381 DELT3 LDX L1 *-* IS THIS LEVEL IN APSC1382 LD 1 0 IMMEDIATE EXECUTION APSC1383 SLA 1 IE SUSPENDED FUNCTION APSC1384 LDX L1 BLKCH APSC1385 BSC L DELT4,- APSC1386 LDX L1 ASTK APSC1387 DELT4 BSI L TYPE CHARACTER APSC1388 DELT5 LDS APSC1389 BSC L DELT8,O APSC1390 * APSC1391 * PRINT LOCAL VARIABLES IN STACK FOR SIV COMMANDAPSC1392 * APSC1393 BSI MVONE APSC1394 LDX I2 DELT3+1 APSC1395 LD 2 5 APSC1396 A 2 6 APSC1397 STO PGB07 APSC1398 MDX L PGB07,3 APSC1399 MDX 2 5 APSC1400 DELT6 MDX 2 3 APSC1401 LD 2 0 APSC1402 BSC L DELT7,+- APSC1403 BSI PRNT APSC1404 MDX 2 -2 APSC1405 DELT7 MDX L PGB07,-1 APSC1406 MDX DELT6 APSC1407 DELT8 BSI L PRCRT APSC1408 LD I DELT3+1 GET NEXT LEVEL APSC1409 MDX DELT1 CONTINUE APSC1410 QADCH DC /38 APSC1411 ASTK DC /3C APSC1412 H3000 DC /3000 APSC1413 D0012 DC 12 APSC1414 * APSC1415 * PRINT FUNCTION AND LINE NUMBER APSC1416 * APSC1417 * X1 CONTAINS TOP OF STACK POINTER APSC1418 FNTRC DC 0 APSC1419 * APSC1420 LD 1 2 SAVE LINE APSC1421 STO LNNUM+1 NUMBER APSC1422 LD 1 3 GET FUNCTION SYPTR APSC1423 BSI L ABSAD APSC1424 MDX 1 2 ADDRESS OF FUNCTION ID APSC1425 STX L1 2 IDENTIFIER IS APSC1426 LDX 1 2 TWO WORDS LONG APSC1427 BSI L PRNID PRINT IT APSC1428 LD 2 -4 GET POINTER TO FUNCTION APSC1429 BSI L ABSAD M-SPACE ENTRY APSC1430 LD 1 3 NO LINE NUMBER PRINT APSC1431 BSC I FNTRC,+Z IF FUNCTION LOCKED APSC1432 LDX L1 LBRKT PRINT LEFT PARENTHESIS APSC1433 BSI L TYPE APSC1434 LD LNNUM+1 GET LINE NUMBER APSC1435 SRT 24 FORM TENS AND APSC1436 D D10 UNITS APSC1437 STD LNNUM SAVE THEM APSC1438 BSC L FNT01,+- BRANCH IF NO TENS APSC1439 MDX L LNNUM,27 FORM TEN DIGIT APSC1440 LDX L1 LNNUM PRINT TEN DIGIT APSC1441 BSI L TYPE APSC1442 FNT01 MDX L LNNUM+1,27 FORM UNIT DIGIT APSC1443 LDX L1 LNNUM+1 PRINT UNIT DIGIT APSC1444 BSI L TYPE APSC1445 LDX L1 RBRKT PRINT RIGHT BRACKET APSC1446 BSI L TYPE APSC1447 * APSC1448 BSC I FNTRC EXIT APSC1449 * APSC1450 LBRKT DC /29 APSC1451 RBRKT DC /2A APSC1452 BSS E 0 APSC1453 LNNUM DC 0 APSC1454 DC 0 APSC1455 D0026 DC 26 APSC1456 D10 DC 10 APSC1457 LNGTH EQU *-ASMSC APSC1458 HDNG WRITE ASSEMBLY TO DISK APSC1459 START LDX L1 ASMSC-2 APSC1460 BSI DSKIO APSC1461 EXIT APSC1462 DSKIO DC 0 APSC1463 STX 1 DSKI1 APSC1464 STX 1 DSKI3 APSC1465 LIBF DISK1 APSC1466 DC /3000 APSC1467 DSKI1 DC 0 APSC1468 DC DSKI4 APSC1469 DSKI2 LIBF DISK1 APSC1470 DC /0000 APSC1471 DSKI3 DC 0 APSC1472 MDX DSKI2 APSC1473 BSC I DSKIO APSC1474 DSKI4 WAIT APSC1475 BSC I DSKIO APSC1476 END START APSC1477 // XEQ L 1 APSC1478 // JOB APTA0001 // ASM APTA0002 * LIST APTA0003 * PRINT SYMBOL TABLE APTA0004 HDNG PREPROLOGUE TO 2741 I/O APTA0005 ABS APTA0006 BEGIN EQU /DE LOAD ADDRESS FOR T2741 APTA0007 ORG EQU -/200 LOAD ADDRESS MINUS ASM ADDRESS APTA0008 LCDBS EQU /280 1130 DISK ADDRESS OF LC DISK APTA0009 DAT41 EQU LCDBS+/68 DISK DESTINATION FOR TS41 APTA0010 * TABLES FOR REAL 2741 ARE IN NEXT SECTRAPTA0011 ATTN EQU /1FF8 ATTENTION IF NONZERO APTA0012 TYPE2 EQU /0330 COMPATIBLE WITH 1050 APTA0013 RSEND EQU /1FEA NON ZERO IF RESEND APTA0014 * APTA0015 * CALLING SEQUENCE IS . . . APTA0016 * LDX L1 EFFECTIVE ADDRESS OF CHARACTER APTA0017 * LDS READ/WRITE 0/3 APTA0018 * BSI L T2741 APTA0019 * APTA0020 * APTA0021 ***** THE FOLLOWING EQUATES FOR T2741 ***** APTA0022 * APTA0023 XR1 EQU 1 INDEX REGISTER 1 APTA0024 L EQU /8000 BIT 0 TO INDICATE LOWER SHIFT APTA0025 TBSZE EQU 44 NUMBER OF CHARACTERS PER CASE APTA0026 CNSZE EQU 6+1 NUMBER OF CONTROL CHARACTERS APTA0027 ORG BEGIN-ORG-2 APTA0028 DC /140+CONTB-TABLE APTA0029 DC DAT41 APTA0030 HDNG TRANSLATE TABLES FOR TSS 2741 APTA0031 TABLE EQU * LOWER UPPER APTA0032 * CASE CASE APTA0033 DC /6200 A 1 ALPHA 45 APTA0034 DC /6400 B 2 BASE 46 APTA0035 DC /6700 C 3 CAP 47 APTA0036 DC /6800 D 4 MIN 48 APTA0037 DC /6B00 E 5 EPSILON 49 APTA0038 DC /6D00 F 6 UNDER BAR 50 APTA0039 DC /6E00 G 7 DEL 51 APTA0040 DC /7000 H 8 DELTA 52 APTA0041 DC /7300 I 9 IOTA 53 APTA0042 DC /4300 J 10 NULL 54 APTA0043 DC /4500 K 11 QUOTE 55 APTA0044 DC /4600 L 13 QUAD 56 APTA0045 DC /4900 M 13 VERTICAL BAR 57 APTA0046 DC /4A00 N 14 REP 58 APTA0047 DC /4C00 O 15 CIRCLE 59 APTA0048 DC /4F00 P 16 STAR 60 APTA0049 DC /5100 Q 17 QUERY 61 APTA0050 DC /5200 R 18 RHO 62 APTA0051 DC /2500 S 19 MAX 63 APTA0052 DC /2600 T 20 TILDE 64 APTA0053 DC /2900 U 21 DOWN ARROW 65 APTA0054 DC /2A00 V 22 CUP 66 APTA0055 DC /2C00 W 23 OMEGA 67 APTA0056 DC /2F00 X 24 RSUB 68 APTA0057 DC /3100 Y 25 UP ARROW 69 APTA0058 DC /3200 Z 26 SUB 70 APTA0059 DC /1500 0 27 AND 71 APTA0060 DC /0200 1 28 DIERESIS 72 APTA0061 DC /0400 2 29 OVER BAR 73 APTA0062 DC /0700 3 30 LESS THAN 74 APTA0063 DC /0800 4 31 LESS OR EQUAL75 APTA0064 DC /0B00 5 32 EQUAL 76 APTA0065 DC /0D00 6 33 GREATER EQUAL 77 APTA0066 DC /0E00 7 34 GREATER 78 APTA0067 DC /1000 8 35 NOT EQUAL 79 APTA0068 DC /1300 9 36 OR 80 APTA0069 DC /2300 / 37 BACK SLASH 81 APTA0070 DC /4000 + 38 MINUS 82 APTA0071 DC /6100 X 39 DIVIDE 83 APTA0072 DC /2000 LF ARW 40 RIGHT ARROW 84 APTA0073 DC /5700 LBR 41 LEFT PAREN 85 APTA0074 DC /1600 RBR 42 RIGHT PAREN 86 APTA0075 DC /3700 , 43 SEMI COLON 87 APTA0076 DC /7600 . 44 COLON 88 APTA0077 * APTA0078 * OVER STRIKES ( ODD IF DOWNSHIFT REQUIRED ) APTA0079 * APTA0080 DC /4980+98 VERTICAL BAR BS CIRCLE 89 APTA0081 DC /4080+98 MINUS BS CIRCLE 90 APTA0082 DC /2380+98 BSLA BS CIRCLE 91 APTA0083 DC /4F80+98 STAR BS CIRCLE 92 APTA0084 DC /2380+99+L (LC) / BS DASH 93 APTA0085 DC /2380+99 BSLA BS DASH 94 APTA0086 DC /4680+100 BOX BS PRIME 95 APTA0087 DC /7680+100+L (LC) . BS PRIME 96 APTA0088 DC /6E80+101 DEL BS TILDE 97 APTA0089 * APTA0090 DC /5D80+59 CIRCLE AFTER BACKSPACE 98 APTA0091 DC /5D80+82 MINUS AFTER BACKSPACE 99 APTA0092 DC /5D80+55 QUOTE AFTER BACKSPACE 100 APTA0093 DC /5D80+64 TILDE AFTER BACKSPACE 101 APTA0094 DC /4380+98 NULL BS CIRCLE (CANONICAL APTA0095 * ILLEGAL) 102 APTA0096 * APTA0097 ***** ( 18 SPACES IN TABLE FOR EXPANSION ) APTA0098 * APTA0099 CONTB EQU * UPPER / LOWER CASE APTA0100 DC /0100 SPACE 120 APTA0101 DC /5B00 CR 121 APTA0102 LFEED DC /3B00 LF 122 APTA0103 DC /5D00 BS 123 APTA0104 DC /5E00 TAB (IDLE) 124 APTA0105 DC /5E00 IDLE 125 APTA0106 DC /8000 DISCONNECT 126 APTA0107 * APTA0108 UCASE DC /1C00 SHIFT TO UPPER CASE APTA0109 LCASE DC /7C00-/1C00 APTA0110 CIRC DC /1F00 CIRCLE C C8421 APTA0111 ICASE DC *-* 0 = LOWER NON-ZERO = UPPER APTA0112 JCHAR DC INPUT CHAR FROM 2741 APTA0113 INTLK DC *-* APTA0114 BSS E 0 APTA0115 STMOD DC /007F MASK TO REMOVE BITS 0-8 APTA0116 DC /D420 GO TO RECEIVE MODE APTA0117 * APTA0118 UP STX ICASE SET NON - ZERO FOR UPPER APTA0119 MDX STOJ0 GO TO CLEAR JCHAR APTA0120 DOWN STO ICASE ACCUMULATOR = 0 APTA0121 STOJ0 STO JCHAR SET JCHAR = 0 APTA0122 MDX IN GET NEXT CHARACTER APTA0123 CIRD DC /1600 CIRCLE D APTA0124 * APTA0125 ORG TYPE2 APTA0126 T2741 DC *-* APTA0127 STX 1 IOADR SAVE USER I/O ADDRESS APTA0128 BSC L WRIT+ORG,O BRANCH IF OUTPUT APTA0129 HDNG READ REQUEST FROM 2741 TO 1130 APTA0130 * READ ONE CHARACTER FROM 2741 APTA0131 MDX L STATE+ORG,0 SKIP IF WRITE STATE APTA0132 MDX WASIN ALREADY IN READ STATE APTA0133 LD CIRC CIRCLE C =/1F00 APTA0134 BSI L ALPHA+ORG OUTPUT SUBROUTINE APTA0135 STX STATE SET STATE =READ APTA0136 XIO STMOD APTA0137 LDS 1 SET OFL INDICATING CIRCLE D APTA0138 WASIN EQU * APTA0139 IN STX INTLK 'DISABLE' INTERRUPTS APTA0140 LD JCHAR GET INPUT CHARACTER APTA0141 BSC L IN2+ORG,Z PROCEED WITH THE NEW CHAR APTA0142 LDD BLINK APTA0143 RTE 1 USEFUL AND QUITE PLEASANT APTA0144 STO BLINK APTA0145 WAIT ELSE STOP THE METER APTA0146 MDX IN APTA0147 IN2 EOR UCASE APTA0148 BSC L UP+ORG,-+ BRANCH IF SHIFT TO UPPER APTA0149 EOR LCASE APTA0150 BSC L DOWN+ORG,-+ BRANCH IF LOWER CASE APTA0151 * APTA0152 * CONVERT CHARACTER READ TO ALC APTA0153 LDX 1 TBSZE TABLE SIZE TO SEARCH APTA0154 RLOOK LD JCHAR GET CHARACTER READ APTA0155 EOR L1 TABLE-1+ORG COMPARE WITH TABLE APTA0156 BSC L RNOT+ORG,Z BRANCH IF NO MATCH APTA0157 * APTA0158 * PRINTABLE CHARACTER FOUND APTA0159 MDX L ICASE+ORG,0 SKIP IF LOWER CASE APTA0160 RUCAS MDX 1 TBSZE INCREMENT FOR UPPER CASE APTA0161 STX I1 IOADR+ORG STORE ALC FOR USER APTA0162 REXIT SLA 16 CLEAR ACCUMULATOR FOR SUCCESS APTA0163 STO INTLK RESET INT 'DISABLE' APTA0164 STO JCHAR RESET INPUT BUFFER APTA0165 BSC L IN+ORG,O 1ST CHAR IS CRD. IGNORE IT APTA0166 BSC I T2741+ORG RETURN TO USER APTA0167 * APTA0168 RNOT MDX 1 -1 SKIP IF NOT FOUND IN TABLE APTA0169 MDX RLOOK CONTINUE SEARCH APTA0170 * APTA0171 * FALL THROUGH IF NOT IN TABLE OF CHARACTERS APTA0172 LDX 1 CNSZE SET TO SEARCH CONTROL TABLE APTA0173 CRLOK LD JCHAR GET CHARACTER READ APTA0174 EOR L1 CONTB-1+ORG COMPARE WITH TABLE APTA0175 BSC L CRNOT+ORG,Z BRANCH IF NOT IN TABLE APTA0176 * APTA0177 * CONTROL CHARACTER FOUND APTA0178 MDX 1 119-TBSZE INCREMENT FOR UPPER APTA0179 MDX RUCAS APTA0180 CRNOT MDX 1 -1 SKIP IF NOT IN TABLE APTA0181 MDX CRLOK CONTINUE SEARCH APTA0182 * APTA0183 * FALL THROUGH IF NEITHER CHARACTER NOR CONTROL APTA0184 STX L RSEND SET RESEND FLAG APTA0185 MDX REXIT RETURN TO USER WITH ERROR APTA0186 BSS 1 APTA0187 BSS E APTA0188 ORG *-1 APTA0189 BLINK DC /C000 MUST BE ODD APTA0190 SENS0 DC *-* = STATE APTA0191 DC /D700 SENSE WITHOUT RESET APTA0192 STATE EQU SENS0 0 = WRITE NON 0 = READ APTA0193 SENS1 DC *-* = SVALC APTA0194 DC /D701 SENSE WITH RESET APTA0195 SVALC EQU SENS1 USER ALC SAVED HERE APTA0196 READ DC JCHAR+ORG APTA0197 DC /D200 READ APTA0198 HDNG INTERRUPT SERVICE ROUTINE FOR 2741 APTA0199 * INTERRUPT SERVICE ROUTINE APTA0200 * APTA0201 INT04 XIO SENS1 SENSE WITH RESET APTA0202 RTE 21 EARLY TEST FOR ATTENTION APTA0203 BSC L *+2+ORG,- APTA0204 STX L ATTN SIGNAL ATTENTION APTA0205 RTE 8 LOOK FOR CHARACTER READY APTA0206 BSC L EXIT+ORG,- APTA0207 RTE 31 CHECK OVERRUN APTA0208 BSC L OVRUN+ORG,+Z APTA0209 LD JCHAR TEST FOR OVERRUN APTA0210 BSC L *+2+ORG,+- APTA0211 OVRUN STX L RSEND SET RESEND FLAG APTA0212 XIO READ GET THE CHARACTER APTA0213 LD JCHAR APTA0214 EOR L CIRC+ORG CHECK IF CIRCLE C APTA0215 BSC L EXIT+ORG,Z APTA0216 * APTA0217 * END OF TRANSMISSION FROM 2741 TO 1130 APTA0218 STO STATE RESET STATE = WRITE APTA0219 STO ICASE RESET FOR LOWER CASE APTA0220 STO OCASE RESET FOR LOWER CASE APTA0221 LD CIRD =/0B00 CIRCLE D APTA0222 BSI ALPHA OUTPUT SUBROUTINE APTA0223 LD LFEED CONVERT CIRCLE C TO LINE FEED APTA0224 STO JCHAR APTA0225 EXIT LD INTLK RETURN TO IL4 HANDLER, APTA0226 BSC Z JAMMING ADDR OF 'IN' INTO APTA0227 * IL4 RETURN IF NECESSARY APTA0228 STO ILS4 TO AVOID RACE CONDITION APTA0229 MDX NEXT GETTING US INTO PERM WAIT APTA0230 HDNG WRITE REQUEST FROM 1130 TO 2741 APTA0231 * USER REQUEST FOR WRITE TO 2741 APTA0232 * APTA0233 WRIT MDX L STATE+ORG,0 APTA0234 MDX WRIT APTA0235 LD L *-* GET ALC FROM USER APTA0236 IOADR EQU *-1 USER I/O ADDRESS APTA0237 AND STMOD REMOVE SPURIOUS BITS APTA0238 STO SVALC SAVE USER ALC APTA0239 BSC L ILALC+ORG,+ ILLEGAL ALC IF -VE OR ZER APTA0240 S K97 MAXIMUM ALC FOR GRAPHIC APTA0241 BSC L OKALC+ORG,+ BRANCH IF ALC IS GRAP APTA0242 S K23 =120-97 APTA0243 BSC L OKALC+ORG,- BRANCH IF ALC GT 119 APTA0244 * APTA0245 ILALC LD ILGAD ILG CHAR IS BULLSEYE APTA0246 OVSTR STO SVALC RE-ENTRY FOR OVERSTRIKE APTA0247 OKALC LD SVALC APTA0248 STO L XR1 APTA0249 LD L1 TABLE-1+ORG GET 2741,TS41 ENCODING APTA0250 MDX 1 -TBSZE SKIP IF LOWER CASE CHAR APTA0251 MDX UPPER APTA0252 SPECL AND H7FFF REMOVE BIT 0 APTA0253 MDX L OCASE+ORG,0 SKIP IF ALREADY LOWER APTA0254 MDX SDOWN DOWN SHIFT REQUIRED APTA0255 MDX WASDN ALREADY IN LOWER CASE APTA0256 SDOWN SLA 16 CLEAR ACCUMULATOR APTA0257 STO OCASE SET FOR LOWER CASE APTA0258 LDD LSHFT APTA0259 MDX LDALC APTA0260 UPPER LD L1 CONTB-1+ORG-119+TBSZE ASSUME CNTR APTA0261 MDX 1 -119+TBSZE SKIP IF GRAPHIC APTA0262 MDX CNTRL WAS CONTROL REQUEST APTA0263 LD L1 TABLE-1+ORG+119-TBSZE FOR GRAPHIC APTA0264 BSC L SPECL+ORG,Z+ IF ALC = 93, 96 APTA0265 MDX L OCASE+ORG,0 SKIP IF ALREADY LOWER CASEAPTA0266 MDX WASUP APTA0267 STX OCASE SET FOR UPPER CASE APTA0268 LDD USHFT APTA0269 LDALC LD SVALC GET ALC FROM USER APTA0270 SLA 8 AA00 00SS APTA0271 RTE 8 SSAA 0000 APTA0272 OR H0080 BIT FOR COMPOSITE CHAR. APTA0273 WASDN EQU * APTA0274 WASUP EQU * APTA0275 CNTRL EQU * APTA0276 BSC L DSCON+ORG,+Z NEGATIVE IS DISCONNECT APTA0277 BSI ALPHA OUTPUT SUBROUTINE APTA0278 LD CHAR GET CHARACTER JUST TYPED APTA0279 SLA 9 APTA0280 SRA 9 APTA0281 BSC L OVSTR+ORG,C BRANCH IF OVERSTRIKE APTA0282 WEXIT BSC I T2741+ORG RETURN TO USER APTA0283 DSCON XIO DSC-1 DISCONNECT CCA APTA0284 MDX WEXIT APTA0285 BSS E APTA0286 WRITE DC CHAR+ORG OUTPUT BUFFER APTA0287 DC /D100 WRITE ONE CHARACTER APTA0288 H7FFF DC /7FFF MASK TO REMOVE BIT 0 APTA0289 USHFT DC /001C UP SHIFT MUST BE ODD APTA0290 CHAR DC *-* OUTPUT BUFFER APTA0291 LSHFT DC /007C DOWN SHIFT MUST BE ODD APTA0292 OCASE DC *-* 0 = LOWER CASE NON-ZERO = UPPER APTA0293 DSC DC /D400 APTA0294 H0080 DC /0080 BIT TO INDICATE COMPOSITE APTA0295 K97 DC 97 MAXIMUM ALC FOR GRAPHIC APTA0296 K23 DC 23 =120-97 ILLEGAL ALC RANGEAPTA0297 ILGAD DC 102 APTA0298 ALPHA DC *-* BITS 0-7 OF ACCUMULATOR = CODE APTA0299 RTE 16 SAVE CHAR OVER BUSY TEST APTA0300 WBUSY XIO SENS0 GET DSW WITHOUT RESET APTA0301 SLA 2 APTA0302 BSC C SKIP IF CCA NOT BUSY APTA0303 MDX WBUSY LOOP TILL CCA UNBUSY APTA0304 RTE 16 APTA0305 STO CHAR PUT CHARACTER INTO O/P BUFFER APTA0306 XIO WRITE APTA0307 ALEND BSC I ALPHA+ORG RETURN TO CALLING ROUTINE APTA0308 HDNG INTERRUPT LEVEL 4 SERVICE ROUTINE APTA0309 CNSLE EQU * APTA0310 NTRP XIO SENSE-1 IGNORE KBD ATTENTION APTA0311 MDX NEXT APTA0312 ORG BEGIN-ORG+/140-41 APTA0313 * APTA0314 * ROUTINE TO SERVICE IBM 2501 APTA0315 IB501 XIO SI501-1 APTA0316 MDX STDSW GO STORE DSW APTA0317 * ROUTINE TO SERVICE INTERRUPT FOR APTA0318 * IBM 1442 APTA0319 * APTA0320 IBM42 XIO SIB42-1 APTA0321 STDSW STO DSW42 STORE DSW APTA0322 MDX NEXT APTA0323 * APTA0324 * NO SIMULTANEOUS READ, PUNCHING APTA0325 * PERMITTED APTA0326 * APTA0327 DVMSK DC /7010 APTA0328 ILS4 DC 0 APTA0329 STD ITMP4 SAVE ACCUMULATOR & EXT APTA0330 STS STAT4 SAVE STATUS APTA0331 STX 1 RSTO4+1 APTA0332 LDX 1 NDEV MAXIMUM DEVICE NUMBER APTA0333 XIO SENS4-1 SENSE ILSW APTA0334 AND DVMSK APTA0335 NXT4 SLCA 1 0 DETERMINE DEVICE APTA0336 STO ILSW4 SAVE ILSW FOR OTHER DEVICE APTA0337 BSC I1 ADDR4+ORG-1,+Z APTA0338 NEXT LD ILSW4 APTA0339 AND SMASK REMOVE SIGN BIT APTA0340 BSC L NXT4+ORG,Z APTA0341 RSTO4 LDX L1 *-* RESTORE X1 APTA0342 STAT4 LDS RESTORE STATUS APTA0343 LDD ITMP4 RESTORE ACC AND EXT APTA0344 BOSC I ILS4+ORG APTA0345 * APTA0346 ITMP4 BSS E 2 APTA0347 ADDR4 DC INT04+ORG CCA APTA0348 SENS4 DC /300 APTA0349 ILSW4 DC 0 APTA0350 SENSE DC /0F01 SENSE DSW W/RESET APTA0351 SMASK DC /7FFF APTA0352 SI501 DC /4F01 APTA0353 DSW42 DC /FFFF APTA0354 SIB42 DC /1702 APTA0355 DC IB501+ORG APTA0356 DC IBM42+ORG APTA0357 DC CNSLE+ORG APTA0358 DC NEXT+ORG APTA0359 NDEV EQU *-ADDR4 APTA0360 HDNG TRANSLATE TABLES FOR REAL 2741 APTA0361 ORG TABLE+/140 APTA0362 DC /4F00 A 1 ALPHA 45 APTA0363 DC /3700 B 2 BASE 46 APTA0364 DC /2F00 C 3 CAP 47 APTA0365 DC /2A00 D 4 MIN 48 APTA0366 DC /2900 E 5 EPSILON 49 APTA0367 DC /6700 F 6 UNDER BAR 50 APTA0368 DC /6200 G 7 DEL 51 APTA0369 DC /3200 H 8 DELTA 52 APTA0370 DC /4C00 I 9 IOTA 53 APTA0371 DC /6100 J 10 NULL 54 APTA0372 DC /2C00 K 11 QUOTE 55 APTA0373 DC /3100 L 13 QUAD 56 APTA0374 DC /4300 M 13 VERTICAL BAR 57 APTA0375 DC /2500 N 14 REP 58 APTA0376 DC /5100 O 15 CIRCLE 59 APTA0377 DC /6800 P 16 STAR 60 APTA0378 DC /6D00 Q 17 QUERY 61 APTA0379 DC /4A00 R 18 RHO 62 APTA0380 DC /5200 S 19 MAX 63 APTA0381 DC /2000 T 20 TILDE 64 APTA0382 DC /2600 U 21 DOWN ARROW 65 APTA0383 DC /4600 V 22 CUP 66 APTA0384 DC /5700 W 23 OMEGA 67 APTA0385 DC /2300 X 24 RSUB 68 APTA0386 DC /7300 Y 25 UP ARROW 69 APTA0387 DC /1500 Z 26 SUB 70 APTA0388 DC /1300 0 27 AND 71 APTA0389 DC /0200 1 28 DIERESIS 72 APTA0390 DC /0400 2 29 OVER BAR 73 APTA0391 DC /0700 3 30 LESS THAN 74 APTA0392 DC /1000 4 31 LESS OR EQUAL75 APTA0393 DC /0800 5 32 EQUAL 76 APTA0394 DC /0D00 6 33 GREATER EQUAL 77 APTA0395 DC /0B00 7 34 GREATER 78 APTA0396 DC /0E00 8 35 NOT EQUAL 79 APTA0397 DC /1600 9 36 OR 80 APTA0398 DC /7000 / 37 BACK SLASH 81 APTA0399 DC /7600 + 38 MINUS 82 APTA0400 DC /6400 X 39 DIVIDE 83 APTA0401 DC /4000 LF ARW 40 RIGHT ARROW 84 APTA0402 DC /6B00 LBR 41 LEFT PAREN 85 APTA0403 DC /4900 RBR 42 RIGHT PAREN 86 APTA0404 DC /6E00 , 43 SEMI COLON 87 APTA0405 DC /4500 . 44 COLON 88 APTA0406 * APTA0407 * OVER STRIKES ( ODD IF DOWNSHIFT REQUIRED ) APTA0408 * APTA0409 DC /4380+98 VERTICAL BAR BS CIRCLE 89 APTA0410 DC /7680+98 MINUS BS CIRCLE 90 APTA0411 DC /7080+98 BSLA BS CIRCLE 91 APTA0412 DC /6880+98 STAR BS CIRCLE 92 APTA0413 DC /7080+99+L (LC) / BS DASH 93 APTA0414 DC /7080+99 BSLA BS DASH 94 APTA0415 DC /3180+100 BOX BS PRIME 95 APTA0416 DC /4580+100+L (LC) . BS PRIME 96 APTA0417 DC /6280+101 DEL BS TILDE 97 APTA0418 * APTA0419 DC /5D80+59 CIRCLE AFTER BACKSPACE 98 APTA0420 DC /5D80+82 DASH AFTER BACKSPACE 99 APTA0421 DC /5D80+55 PRIME AFTER BACKSPACE 100 APTA0422 DC /5D80+64 TILDE AFTER BACKSPACE 101 APTA0423 DC /6180+98 NULL BS CIRCLE (CANONICAL APTA0424 * ILLEGAL) APTA0425 HDNG APTA0426 START LDX L1 BEGIN-ORG-2 APTA0427 BSI DSKIO APTA0428 EXIT APTA0429 DSKIO DC 0 APTA0430 STX 1 DSKI1 APTA0431 STX 1 DSKI3 APTA0432 LIBF DISK1 APTA0433 DC /3000 APTA0434 DSKI1 DC 0 APTA0435 DC DSKI4 APTA0436 DSKI2 LIBF DISK1 APTA0437 DC /0000 APTA0438 DSKI3 DC 0 APTA0439 MDX DSKI2 APTA0440 BSC I DSKIO APTA0441 DSKI4 WAIT APTA0442 BSC I DSKIO APTA0443 END START APTA0444 // XEQ L 1 APTA0445 // JOB APT20001 // ASM APT20002 *LIST APT20003 *PRINT SYMBOL TABLE APT20004 HDNG **TYPE2 --- PREPROLOGUE APT20005 ABS APT20006 ORG EQU -/800 APT20007 * DISK ADDRESSES APT20008 LCDBS EQU /280 1130 DISK ADDRESS OF LC DISKAPT20009 DATYP EQU LCDBS+/45 APT20010 * ORIGIN OF THIS ASSEMBLY APT20011 ASMT2 EQU /DE APT20012 * IMPORTANT ADDRESS APT20013 ATTN EQU /1FF8 APT20014 * ADDRESSES REQUIRED BY OTHER ASSEMBLIES APT20015 DC TYPE2+ORG-ASMT2 APT20016 DC ILS4+ORG-ASMT2 APT20017 DC DSW42+ORG-ASMT2 APT20018 * ALC CHARACTER CODES APT20019 DC ALCD0 ALC CODE FOR ZERO APT20020 DC ALCBL FOR SPACE APT20021 DC ALCNG FOR NEGATIVE SIGN APT20022 DC ALCE FOR E APT20023 DC ALCDP FOR DECIMAL POINT APT20024 * LENGTH OF ASSEMBLY APT20025 DC LNGTH APT20026 HDNG ORIGIN OF THIS ASSEMBLY APT20027 ORG ASMT2-ORG-2 APT20028 DC /140 APT20029 DC DATYP APT20030 HDNG ** TYPE2 APT20031 * KEYBOARD READ AND CONSOLE PRINTER WRITE APT20032 * 2741 IMITATING KEYBOARD WITH ATTENTION, APT20033 * LINE FEED, AND SEXY CASE SHIFT APT20034 * TILT ROTATE, ALC CASE 2 TABLES APT20035 * INDEXED BY ALC CODE OR CODE-CONST APT20036 KEYS EQU 44 APT20037 OFFST EQU *-KEYS APT20038 TRANS DC /7E80+CRFN PICTURE FOR ILLEGAL ALC APT20039 DC /3C1C A 1 APT20040 DC /1859 B REV APT20041 DC /1C51 C BSLA APT20042 DC /301E D 3 APT20043 ALCE EQU *-TRANS APT20044 DC /344A E LSS APT20045 DC /101F F 4 APT20046 DC /1420 G 5 APT20047 DC /2421 H 6 APT20048 DC /204F I NEQ APT20049 DC /7C22 J 7 APT20050 APOST EQU *-OFFST APT20051 DC /5823 K 8 APT20052 DC /5C24 L 9 APT20053 DC /705B M TRANS APT20054 DC /745A N COLREV APT20055 OMCRN EQU *-OFFST APT20056 DC /5050 O OR APT20057 DC /5447 P AND APT20058 DC /6448 Q DIAR APT20059 DC /604B R LEQ APT20060 DC /981D S 2 APT20061 TILDE EQU *-OFFST APT20062 DC /9C4C T EQU APT20063 DC /B04E U GTR APT20064 DC /B45E V COL BSLA APT20065 DC /9049 W NEGATIVE APT20066 DC /945D X COL / APT20067 DC /A44D Y GEQ APT20068 DC /A025 Z / APT20069 ALCD0 EQU *-TRANS APT20070 DC /C400 0 APT20071 DC /FC00 1 APT20072 ALCNG EQU *-OFFST APT20073 DC /D800 2 APT20074 DC /DC00 3 APT20075 DC /F000 4 APT20076 DC /F400 5 APT20077 DC /D000 6 APT20078 DC /D400 7 APT20079 DC /E400 8 APT20080 DC /E000 9 APT20081 DC /BC61 / DEL TILDE APT20082 MINUS EQU *-OFFST APT20083 DC /4426 + + APT20084 DC /0427 X X (TIMES) APT20085 DC /845C LF ARW LOG APT20086 DC /401B LBR 0 APT20087 DC /C05F RBR QUAD PRIME APT20088 DC /8060 , SHRIEK APT20089 ALCDP EQU *-TRANS APT20090 DC /002C . . APT20091 OVSTR DC /7080+CRFN REV APT20092 DC /4480+CRFN COLREV APT20093 DC /BC80+CRFN TRANS APT20094 DC /5480+CRFN LOG APT20095 DC /BE80+DSHFN COL / APT20096 DC /BC80+DSHFN COL BSLA APT20097 DC /5C80+PRMFN QUAD RPIME APT20098 DC /0280+PRMFN SHRIEK APT20099 DC /1480+TLDFN DEL TILDE APT20100 CRFN EQU *-OFFST APT20101 DC /1380+OMCRN APT20102 DSHFN EQU *-OFFST APT20103 DC /1380+MINUS APT20104 PRMFN EQU *-OFFST APT20105 DC /1380+APOST APT20106 TLDFN EQU *-OFFST APT20107 DC /1380+TILDE APT20108 BSS E 0 APT20109 ZNTBL DC 27 APT20110 DC 19 APT20111 DC 10 APT20112 CASE1 DC KEYS APT20113 CASE DC /0600 APT20114 DC /0106 APT20115 PRINT DC CHAR+ORG APT20116 DC /0900 PRINT CHAR IOCC APT20117 CHAR DC 0 BUFFER--1 CHAR APT20118 KBRD DC /0C00 KB SELECT IOCC APT20119 IOADR DC 0 APT20120 DISPL DC /FF00 NOTE .. MUST BE ODD ALIGNED APT20121 SHBIT DC /0200 APT20122 CASE2 DC 0 APT20123 NOLOK DC 1 APT20124 NOSHF DC 1 APT20125 CGRET DC /8500 APT20126 MASK DC /FF NOTE.. MUST BE ODD ALIGNED. APT20127 ALCBL EQU 120 APT20128 ORG ALCBL+OFFST APT20129 DC /2300 BLANK APT20130 DC /8700 CAR RET AND SHIFT TO BLACK APT20131 LNFD EQU *-OFFST APT20132 DC /0100 LF APT20133 DC /1300 BS APT20134 DC /0B00 SHIFT TO RED APT20135 DC /0300 IDLE APT20136 TYPE2 DC *-* APT20137 STX 1 IOADR APT20138 BSC L TYPOT+ORG,O APT20139 TYPIN EQU * APT20140 BSI TEST APT20141 XIO KBRD-1 INVITE ONE CHAR APT20142 BSI TEST FIRST SEARCH FOR CHARACTER APT20143 LDX 1 ENDT-TABLE IN TABLE APT20144 LOOP LDD L1 TABLE-2+ORG ACC IS CARD CODE,EXT ALC APT20145 EOR CHAR APT20146 BSC L NOTIT+ORG,Z APT20147 SLT 8 FOUND MATCH APT20148 BSC L HIT+ORG,Z BRANCH IF ORDINARY CHAR APT20149 SLT 17 APT20150 SRA 9 APT20151 BSC L GOTCH+ORG,C BRANCH IF LF, CR, OR BKSP.APT20152 MDX L NOSHF+ORG,0 HAVE A CASE SHIFT. APT20153 MDX GTCAS FORMER CASE WAS NO SHIFT. APT20154 STO L 1 APT20155 LD L1 CASE+ORG-2 APT20156 MDX L CASE2+ORG,0 APT20157 SRT 8 APT20158 GTCAS SRT 3 ACC CONTAINS CASE SHFT CODE.APT20159 LDX 1 3 APT20160 SETCS SRA 16 USE IT TO SET THE THREE APT20161 SLT 1 FLAGS NOSHF, NOLOK, CASE2 APT20162 STO L1 CASE2-1+ORG APT20163 MDX 1 -1 APT20164 MDX SETCS APT20165 MDX TYPIN GO BACK TO READ APT20166 NOTIT MDX 1 -2 APT20167 MDX LOOP APT20168 LD CHAR CHARACTER MUST BE ALPHABETICAPT20169 LDX 1 11 SO COMPUTE ITS ALC. APT20170 LDS APT20171 SLCA 1 APT20172 RTE 16 APT20173 LD L1 ZNTBL-9+ORG APT20174 STO ZNCOD APT20175 SLT 17 APT20176 SLCA 1 APT20177 BSC L TYPIN+ORG,- APT20178 SLA 1 APT20179 BSC L TYPIN+ORG,Z APT20180 LD ZNCOD APT20181 S L 1 APT20182 HIT MDX L NOSHF+ORG,0 APT20183 MDX GOTCH APT20184 A CASE1 APT20185 STO L 1 APT20186 MDX 1 /70 MATTER OF CONVENIENCE APT20187 MDX L CASE2+ORG,0 APT20188 LD 1 OFFST+ORG-/70 APT20189 GOTCH AND MASK APT20190 STO I IOADR+ORG APT20191 TYPOT LD I IOADR+ORG TYPE CHARACTER APT20192 AND MASK APT20193 XPND STO L 1 APT20194 PCKUP LD L1 TRANS+ORG PICK UP CHARACTER APT20195 MDX 1 -KEYS MAYBE IT SHOULD BE UPPER CASAPT20196 MDX *+1 APT20197 MDX GOTCD NO. APT20198 LD L1 TRANS+ORG YES. GET IT APT20199 EOR SHBIT AND INSERT SHIFT BIT. APT20200 GOTCD STO CHAR TYPE. APT20201 BSI TEST APT20202 XIO PRINT APT20203 LD CHAR APT20204 EOR CGRET RELEASE LOCK IF CAR RET. APT20205 BSC +- APT20206 STX NOLOK APT20207 SLA 9 APT20208 SRA 9 APT20209 BSC L XPND+ORG,C HANDLE OVERSTRIKE. APT20210 LD NOLOK UNSHIFT IF NOT LOCKED. APT20211 STO NOSHF APT20212 EXIT BSC I TYPE2+ORG RETURN TO SIMULATOR APT20213 TEST DC *-* APT20214 XIO SANS-1 CHECK FOR DEVICE READY APT20215 SLA 4 APT20216 TXIT BSC I TEST+ORG,+- APT20217 LDD DISPL ODD ALIGNED APT20218 MDX L CASE2+ORG PRODUCE CASE DISPLAY APT20219 RTE 8 APT20220 MDX L NOLOK+ORG APT20221 SLA 16 APT20222 MDX L NOSHF+ORG APT20223 SLT 32 APT20224 TWAIT WAIT APT20225 MDX TEST+1 APT20226 ZNCOD EQU TEST APT20227 SAVE1 EQU TEST APT20228 ORG *-1 APT20229 BSS E 1 APT20230 * ODD ALIGNMENT NECESSARY FOR SANS APT20231 SANS DC /0F00 SENSE DSW WITHOUT RESET APT20232 TABLE BSS E 0 MEANING KEY APT20233 DC /0220 CASE SHIFT 1 @ # APT20234 DC 2 APT20235 DC /2220 CASE SHIFT 2 % , APT20236 DC 3 APT20237 DC /4220 + - + * $ APT20238 DC /2600 APT20239 DC /8220 X DIV X < . APT20240 DC /2700 APT20241 DC /4000 CAR RET - - APT20242 DC /F9 APT20243 DC /3000 BKSP / 0 APT20244 DC /FB APT20245 DC /0008 LF, RT ARW LOG EOF APT20246 DC /2800 APT20247 DC /0004 LBR ( 0 LF ARW APT20248 DC /2900 APT20249 DC /0002 RBR ) QD PR ERS FLD APT20250 DC /2A00 APT20251 DC /2420 , SHRK , 8 APT20252 DC /2B00 APT20253 DC /8420 . : . . 9 APT20254 DC /2C00 APT20255 DC 0 SPACE SPACE APT20256 DC /F8 APT20257 DC /FFFF LINE FEED INT REQ APT20258 DC /FA APT20259 ENDT EQU * APT20260 BSS E 0 APT20261 READ DC CHAR+ORG APT20262 DC /0A00 READ CHAR IOCC APT20263 HDNG SUBROUTINE TO SERVICE 1130 CONSOLE APT20264 CNSLE EQU * APT20265 NTRP XIO SENSE-1 THIS ROUTINE CHECKS APT20266 SLA 2 AND SERVICES THE INTERRUPT. APT20267 BSC L RAAD+ORG,C GO READ IF KB RESP. APT20268 BSC L EXIT4+ORG,- NEITHER A KEY NOR INT REQ.APT20269 SLA 4 APT20270 BSC L FOO+ORG,- INT REQ AND NOT KBSEL IS ATTAPT20271 XIO READ LINE FEED. CLEAR KB SEL APT20272 MDX L CHAR+ORG,-1 MOCK UP A LF AND SKIP APT20273 RAAD XIO READ ORDINARY KB READ APT20274 EXIT4 MDX NEXT APT20275 FOO STX L ATTN INDICATE ATTENTION APT20276 MDX EXIT4 APT20277 HDNG SUBROUTINE TO SERVICE CARD I/O APT20278 ORG ASMT2-ORG+/140-41 APT20279 * APT20280 * ROUTINE TO SERVICE IBM 2501 APT20281 IB501 XIO SI501-1 APT20282 MDX STDSW GO STORE DSW APT20283 * ROUTINE TO SERVICE INTERRUPT FOR APT20284 * IBM 1442 APT20285 * APT20286 IBM42 XIO SIB42-1 APT20287 STDSW STO DSW42 STORE DSW APT20288 MDX NEXT APT20289 * APT20290 * NO SIMULTANEOUS READ, PUNCHING APT20291 * PERMITTED APT20292 * APT20293 DVMSK DC /7000 APT20294 HDNG INTERRUPT LEVEL 4 SERVICE ROUTINE APT20295 ILS4 DC 0 APT20296 STD ITMP4 SAVE ACCUMULATOR & EXT APT20297 STS STAT4 SAVE STATUS APT20298 STX 1 RSTO4+1 APT20299 LDX 1 NDEV RECOGNISE 6 DEVICES APT20300 XIO SENS4-1 SENSE ILSW APT20301 AND DVMSK APT20302 NXT4 SLCA 1 0 DETERMINE DEVICE APT20303 STO ILSW4 SAVE ILSW FOR OTHER DEVICE APT20304 BSC I1 ADDR4+ORG-1,+Z APT20305 NEXT LD ILSW4 APT20306 AND SMASK REMOVE SIGN BIT APT20307 BSC L NXT4+ORG,Z APT20308 RSTO4 LDX L1 *-* RESTORE X1 APT20309 STAT4 LDS RESTORE STATUS APT20310 LDD ITMP4 RESTORE ACC AND EXT APT20311 BOSC I ILS4+ORG APT20312 * APT20313 ITMP4 BSS E 2 APT20314 ADDR4 DC NEXT+ORG APT20315 SENS4 DC /300 APT20316 ILSW4 DC 0 APT20317 SENSE DC /0F01 SENSE DSW W/RESET APT20318 SMASK DC /7FFF APT20319 SI501 DC /4F01 APT20320 DSW42 DC /FFFF APT20321 SIB42 DC /1702 APT20322 DC IB501+ORG APT20323 DC IBM42+ORG APT20324 DC CNSLE+ORG APT20325 DC NEXT+ORG APT20326 NDEV EQU *-ADDR4 APT20327 LNGTH EQU *-ASMT2+ORG APT20328 HDNG WRITE TYPE2 AND ILS SERVICE TO DISK APT20329 START LDX L1 ASMT2-ORG-2 APT20330 BSI DSKIO APT20331 EXIT APT20332 DSKIO DC 0 APT20333 STX 1 DSKI1 APT20334 STX 1 DSKI3 APT20335 LIBF DISK1 APT20336 DC /3000 APT20337 DSKI1 DC 0 APT20338 DC DSKI4 APT20339 DSKI2 LIBF DISK1 APT20340 DC /0000 APT20341 DSKI3 DC 0 APT20342 MDX DSKI2 APT20343 BSC I DSKIO APT20344 DSKI4 WAIT APT20345 BSC I DSKIO APT20346 END START APT20347 // XEQ L 1 APT20348 // JOB APXQ0001 // ASM APXQ0002 *LIST APXQ0003 *PRINT SYMBOL TABLE APXQ0004 HDNG PREPROLOGUE TO STATEMENT EXECUTION APXQ0005 ABS APXQ0006 * DISK ADDRESS OF THIS ASSEMBLY APXQ0007 LCDBS EQU /280 APXQ0008 DASYN EQU LCDBS+/57 APXQ0009 * ORIGINS OF THIS AND OTHER ASSEMBLIES APXQ0010 ASMXQ EQU /730 STATEMENT EXECUTION APXQ0011 ASMCT EQU /21E CTRAY APXQ0012 * OVERLAY STRUCTURE DEPENDENT ITEMS APXQ0013 IDXFL EQU /4000 APXQ0014 EOSFL EQU /8000 APXQ0015 * OVERLAY NUMBERS OF THIS AND OTHER ASSEMBLIES APXQ0016 SYNOV EQU 24 APXQ0017 IDXOV EQU 32 APXQ0018 EOSOV EQU 36 APXQ0019 * IMPORTANT LOCATIONS APXQ0020 LOCOR EQU /1000 APXQ0021 STUAD EQU /1015 APXQ0022 RAND EQU /101A APXQ0023 PAREL EQU /1017 APXQ0024 FNDPL EQU /1FEC APXQ0025 ISBRN EQU /1FF3 APXQ0026 FULST EQU /1FF7 APXQ0027 GTSPL EQU /1FFA APXQ0028 MGCOL EQU /1FFE APXQ0029 * SUBROUTINES IN CTRAY APXQ0030 ERRXT EQU ASMCT+/37 APXQ0031 ABSAD EQU ASMCT+/A8 APXQ0032 LCLOD EQU ASMCT+/B1 APXQ0033 GOVLY EQU ASMCT+/6B APXQ0034 PSYL EQU ASMCT+/D5 APXQ0035 GSYL EQU ASMCT+/DE APXQ0036 GCOL EQU ASMCT+/169 APXQ0037 SGBTB EQU ASMCT+/207 APXQ0038 FSB EQU ASMCT+/22A APXQ0039 FMP EQU ASMCT+/22E APXQ0040 FDV EQU ASMCT+/232 APXQ0041 FAD EQU ASMCT+/236 APXQ0042 UNFLT EQU ASMCT+/30E APXQ0043 FLT EQU ASMCT+/346 APXQ0044 FSBN EQU ASMCT+/355 APXQ0045 GNXTW EQU ASMCT+/479 APXQ0046 SYPTR EQU ASMCT+/48B APXQ0047 * RELATIVE ADDRESSES IN IDEXING/ASSIGNMENT APXQ0048 XQASS EQU 1 APXQ0049 XQIND EQU 3 APXQ0050 * RELATIVE ADDRESSES IN TRACE FUNCTION APXQ0051 XLQAD EQU 1 APXQ0052 XQTFN EQU /A APXQ0053 * RELATIVE ADDRESSES IN OVERLAY OPS APXQ0054 XQFUN EQU /280 APXQ0055 DAMAX EQU /3B9 APXQ0056 RESDU EQU /3CF APXQ0057 BREP EQU /411 APXQ0058 BEPS EQU /47E APXQ0059 BIOTA EQU /4B5 APXQ0060 FLN EQU /4F3 APXQ0061 BEXP EQU /58F APXQ0062 FEXP EQU /5C0 APXQ0063 DBASE EQU /62B APXQ0064 QUERY EQU /652 APXQ0065 COMBN EQU /682 APXQ0066 FACTO EQU /6BF APXQ0067 * MISCELLANEOUS APXQ0068 CLNCL EQU /A APXQ0069 ALCBL EQU /78 APXQ0070 * ADDRESSES REQUIRED BY OTHER ASSEMBLIES APXQ0071 DC NEXT-ASMXQ APXQ0072 DC EFPE1-ASMXQ APXQ0073 DC SYNER-ASMXQ APXQ0074 DC LGTER-ASMXQ APXQ0075 DC WSFER-ASMXQ APXQ0076 DC RANK-ASMXQ ALSO RNKER APXQ0077 DC FPRNG-ASMXQ APXQ0078 DC INDOM-ASMXQ ALSO RNGER APXQ0079 DC PIN-ASMXQ APXQ0080 DC MLARG-ASMXQ APXQ0081 DC MRARG-ASMXQ APXQ0082 DC XLARG-ASMXQ APXQ0083 DC XRARG-ASMXQ APXQ0084 DC MRSLT-ASMXQ APXQ0085 DC GRP3-ASMXQ APXQ0086 DC UPL-ASMXQ APXQ0087 DC UTEMP-ASMXQ APXQ0088 DC UK1-ASMXQ APXQ0089 DC ABS-ASMXQ APXQ0090 DC PLUS-ASMXQ APXQ0091 DC MINUS-ASMXQ APXQ0092 DC IDEN1-ASMXQ APXQ0093 * LENGTH OF THIS ASSEMBLY APXQ0094 DC LNGTH APXQ0095 HDNG START OF EXECUTE STATEMENT OVERLAY APXQ0096 ORG ASMXQ-2 APXQ0097 DC 7*/140 APXQ0098 DC DASYN APXQ0099 DC SYNOV APXQ0100 HDNG ENSURE OVERLAY LOADED APXQ0101 ENSOV DC 0 APLH1550APXQ0102 STS ENS03 APXQ0103 RTE 30 APXQ0104 SRA 2 APXQ0105 STO ENS01 APXQ0106 SLT 30 APXQ0107 BSC L ENS03,+- APXQ0108 SRA 12 APXQ0109 STO L 2 APLH1600APXQ0110 MDX 2 IDXOV-4 APXQ0111 STX 3 ENS02+1 APXQ0112 BSI L GOVLY APLH1620APXQ0113 MDX I3 ENS01 APXQ0114 STX L3 ENS01 APXQ0115 ENS02 LDX L3 *-* APXQ0116 BSI L LDX2 APXQ0117 ENS03 LDS 0 APXQ0118 LD ENS01 APXQ0119 BSC I ENSOV APLH1652APXQ0120 ENS01 EQU * APXQ0121 HDNG SET GETSYL PARAMETER LIST APXQ0122 STGSP DC 0 APXQ0123 LDX L1 LOCOR BASE APXQ0124 LD 1 PAREL-LOCOR ADDRESS OF CPTR IN APXQ0125 A 1 1 TOP LEVEL HEADER APXQ0126 SRT 16 APXQ0127 LD ASYLB ADDRESS FOR STORING SYL APXQ0128 STD L GTSPL STORE SYLBL & CPTR ADDRS APXQ0129 BSC I STGSP EXIT APXQ0130 ASYLB DC SYLBL APXQ0131 HDNG ** SYNTAX ANALYSIS-- APL 1130 ** APXQ0132 * THIS ROUTINE PERFORMS THE APL SYNTAX ANALYSIS BYAPXQ0133 * DECODING THE INPUT CODESTRING RIGHT TO LEFT, APXQ0134 * SYLLABLE BY SYLLABLE. OPERATORS AND THE APPRO- APXQ0135 * PRIATE SYMBOL TABLE, OR M-, POINTERS ARE PLACED APXQ0136 * ON THE STACK BY THE INDIVIDUAL INTERPRETATION APXQ0137 * RULE (IR) ROUTINES. THE PRIMARY ENTRY POINT IS APXQ0138 * 'NEXT', AND XR1 IS ASSUMED TO CONTAIN LOCOR. APXQ0139 * XRS 2 & 3 ARE DESTROYED. UPON EXIT FROM NEXT TOAPXQ0140 * AN INTERPRETATION RULE XR2 CONTAINS SVI, THE TOPAPXQ0141 * OF STACK POINTER. OTHER ENTRY POINTS INCLUDE EFAPXQ0142 * THE SUBROUTINES LCLOD, EFPE1, CGCOL, STX2, AND APXQ0143 * LDX2. EFPE1 IS USED AS AN ESCAPE BY LC APXQ0144 HFC DC /FC00 APXQ0145 * LCLOD GET THE CONTENTS OF A LOCATION SPECIFIED &APXQ0146 * BY AN LC ADDRESS APXQ0147 * LEFT PAREN STATE APXQ0148 IR3 LD 2 1 GET STACKED STATE APXQ0149 STO 1 12 APXQ0150 A HFC IS IT A STATE APXQ0151 BSC L SNTER,C NO APXQ0152 LD 2 1 APXQ0153 AND RAST RIGHT ARROW STATE MEANS THISAPXQ0154 BSC L SNTER,+- IS RT PAREN INSTEAD OF RT BRAPXQ0155 LD 2 0 YES, PUT STACKED EXPRESSION APXQ0156 STO 2 1 WHERE ) WAS AND APXQ0157 MDX 2 1 INCREMENT SVI APXQ0158 MDX L LOCOR+14,1 APXQ0159 BSC L EFPE,+Z BRANCH IF TOS INDIRECT,ELSE APXQ0160 OR 1 -2 CHANGE M-SPTR- TO POINT APXQ0161 STO *&1 TO NEW STACK LOCATION APXQ0162 MDX L *-*,1 APXQ0163 MDX EFPE APXQ0164 * DFN STATE APXQ0165 IR14A LD 1 13 EXECUTE REDUCTION OR APXQ0166 EOR L INT1S STACK COMPLEMENT OF SYPTR APXQ0167 MDX IR2P AND LINK TO NEXT APXQ0168 * OPERATOR STATE APXQ0169 IR2 EOR 1 12 IF PREVIOUS SYMBOL A / APXQ0170 BSC L REDUC,+- DO REDUCTION, ELSE APXQ0171 LD 1 13 STACK OPERATOR AND LINK APXQ0172 BSC L *&2,&Z APXQ0173 LD I LOCOR&4 APXQ0174 IR2P BSI PUSH TO NEXT WITH OP STATE APXQ0175 LD OPST APXQ0176 MDX REPET APXQ0177 NEXT DC 0 APXQ0178 BSI L STGSP SET GETSYL PARAM LIST APXQ0179 LD 1 15 GET LAST APXQ0180 * IR7, LEFT ARROW STATE APXQ0181 * IR11, PERIOD STATE APXQ0182 REPET STO 1 12 SAVE PREVIOUS STATE APXQ0183 IR7 EQU REPET LINK TO NEXT W LA STATE APXQ0184 IR11 EQU REPET LINK TO NEXT W OPRND STATE APXQ0185 NULL LD 1 12 APXQ0186 EOR K32 IFF PREVIOUS STATE WAS APXQ0187 STO 1 6 LEFT ARROW, LA FLAG IS 0 APXQ0188 BSI GNSYL APLG5310APXQ0189 BSC L NULL,+- APLG5320APXQ0190 BSI L SYPTR APLG5330APXQ0191 * APXQ0192 GTPTR STO 1 13 LC SYPTR IN R13 APXQ0193 OR 1 -2 APXQ0194 STO 1 4 1130 SYPTR IN R4 APXQ0195 LD 1 12 GENERATE CARRY IF OPERATOR APXQ0196 SLA 13 APXQ0197 LD I LOCOR+4 GET STATE OF BST ENTRY FOR APXQ0198 SRA 12 INDEX TO DISPATCH TABLE APXQ0199 STO L 3 APXQ0200 EOR QCLN RESET FULL-STMT INDICATOR APXQ0201 BSC L *+3,+- APXQ0202 SRA 4 UNLESS THIS IS AN EOS SYMBOLAPXQ0203 STO L FULST APXQ0204 BSI L LDX2 SET UP SVI APXQ0205 LD L3 DSPCH GET DISPATCH ENTRY APXQ0206 BSC L DOOP,+ZC BRANCH IF UNARY OPERATOR APXQ0207 SRT 8 MATCH FOR PERMISSIBLE STATE APXQ0208 AND 1 12 APXQ0209 BSC L SNTER,+- NONE FOUND APXQ0210 LD MDX ONE FOUND--SET UP TO DO APXQ0211 SLT 8 DO INTERPRETATION RULE APXQ0212 STO INTRP APXQ0213 LD L3 LDTAB APXQ0214 * INTRP IS EQUATED TO PUSH AND IS EXIT FROM NEXT APXQ0215 * IT IS FILLED IN AS MDX IRXX APXQ0216 PUSH DC *-* STACK PASSED PARAMETER APXQ0217 INTRP EQU PUSH APXQ0218 MDX 2 -1 ON SV ANTER BUMPING SVI APXQ0219 STO 2 0 APXQ0220 SRA 16 CALL GETSPACE(0) TO MAKE APXQ0221 BSI L CGCOL SURE M IS NOT FULL APXQ0222 BSC I PUSH AAPXQ0223 GNSYL DC 0 APLG5801APXQ0224 LDX L1 GTSPL APLG5802APXQ0225 BSI L GSYL APLG5803APXQ0226 LDX L1 LOCOR APLG5804APXQ0227 LD SYLBL APLG5805APXQ0228 BSC I GNSYL APLG5806APXQ0229 SYLBL DC 0 APLG5807APXQ0230 * APLG5808APXQ0231 DASAS DC XQASS+EOSFL APXQ0232 NXTRT DC *-* AAPXQ0233 BSI L STX2 SAVE UPDATED SVI APXQ0234 BSI GNSYL APLG5830APXQ0235 BSC I NXTRT SYLLABLES APXQ0236 QCLN DC CLNCL AAPXQ0237 * TABLE OF USEFUL VALUES FOR ACC WHEN LINKING TO IRSAPXQ0238 LDTAB DC /FFFF IR0-COMPLEMENT APXQ0239 INT1S DC /FFFF APXQ0240 SLASH DC /40 IR2-SLASH SAATE APXQ0241 OPST DC 8 IR3-NULL AAPXQ0242 H101 DC /101 IR4-RPARST+DEX AAPXQ0243 RAST DC 4 IR5-RASTAT APXQ0244 MDX DC /70 IR6-NULL APXQ0245 K32 DC /20 IR7-LASTAT APXQ0246 DC /10 IR8-SEMIST APXQ0247 DC /40 IR9-SLASH STATE APXQ0248 DC 0 APXQ0249 OPRND DC /80 IR11-OPERAND STATE APXQ0250 TOSL DC ISLD APXQ0251 SLMSK DC /FF IR13-CONSTANT FLAG APXQ0252 DC IR14A IR14-RETURN LINK APXQ0253 DC XLQAD+IDXFL APXQ0254 * UNDEFINED STATE APXQ0255 VALER DC /4000+18 APXQ0256 IR0 MDX L LOCOR&6,0 IF LA FLAG NOT ON APXQ0257 LD VALER APXQ0258 BSC L ERXIT,- VALUE ERROR APXQ0259 * OPERAND STATE APXQ0260 IR1 EOR 1 13 STACK COMPLEMENT OF SYPTR APXQ0261 BSI PUSH APXQ0262 MDX EFPE APXQ0263 * IR'S LINKING TO THIS ROUTINE WILL APXQ0264 * HAVE SUBSEQUENT ACTION DETERMINED APXQ0265 * BY THE GROUP OF THE PRECEDING STATE APXQ0266 * GROUP 1 -- LEFT ARROW OR LBR APXQ0267 * GROUP 2 -- SLASHES APXQ0268 * GROUP 3 -- ) OR SEMIC OR RBR OR NIL APXQ0269 * GROUP 4 -- OPERATOR APXQ0270 EFPE1 EQU * APXQ0271 BSI L STGSP SET GETSYL PARAM LIST APXQ0272 BSI L LDX2 APXQ0273 EFPE LD 1 12 APXQ0274 AND LDS APXQ0275 BSC L F,+ GROUP 3 OR 4 IF BRANCH APXQ0276 STO 1 12 APXQ0277 SLA 10 APXQ0278 LD DASEL APLG6300APXQ0279 BSC L ISLD,C APLG6310APXQ0280 LD DASAS APXQ0281 MDX L LOCOR+6,0 APLG6321APXQ0282 LD DINDX APLG6320APXQ0283 * SEGMENT LOAD GETS OPERATOR IF NECE- APXQ0284 * SSARY AND THEN EXECUTES IT APXQ0285 * IR10, COLON STATE AAPXQ0286 ISLD BSI L STX2 APXQ0287 BSI L ENSOV APLG6380APXQ0288 LDX L1 PIN AAPXQ0289 BSC I ENS01 APXQ0290 IR10 BSC I NEXT APXQ0291 * RIGHT PAREN STATE APXQ0292 IR5 OR 1 12 OR RIGHT ARROW W PREVIOUS APXQ0293 STO 1 13 STATE; SET RIGHT PAREN STATEAPXQ0294 LD 1 1 APXQ0295 * IR9, SLASH STATE APXQ0296 IR5A STO 1 12 LOAD PREVIOUS STATE AND APXQ0297 IR9 EQU IR5A STACK AND LINK TO NEXT APXQ0298 LD 1 13 PUSH PRESET PARAMENER APXQ0299 BSI PUSH APXQ0300 MDX NULL APXQ0301 * RIGHT BRACKET STATE APXQ0302 IR6 LD 1 12 LOAD PREVIOUS STATE AND APXQ0303 STO 1 13 LINK TO NEXT W RBR STATE APXQ0304 LD RBRST AFTER STACKING APXQ0305 MDX IR5A APXQ0306 * DFN0 STATE APXQ0307 IR15R LD TOSL RIGHT QUAD TREATED LIKE DFN0APXQ0308 IR12 STO R13BR+1 SAVE LINK APXQ0309 IR14 EQU IR12 LINK TO DFNTR OR IR15A &APXQ0310 * MAKE R15 NEG IF DFN0 APXQ0311 STO L LOCOR+15 APXQ0312 LD 1 6 APXQ0313 SLA 11 APXQ0314 LD DAFCN EXECUTE OR STACK FCN AAPXQ0315 R13BR BSC L *-*,C APXQ0316 LD DAFTR EXECUTE FUNCTION TRACE APXQ0317 * QUAD STATE APXQ0318 IR15 MDX L LOCOR+6,0 EXECUTE LEFT OR RIGHT QUAD APXQ0319 MDX IR15R APXQ0320 MDX ISLD LEFT ARROW FOLLOWED QUAD AAPXQ0321 IEBR MDX E AAPXQ0322 IR4 EQU IEBR LINK TO NEXT. STACK IF NEC.APXQ0323 IR8 EQU IEBR LINK TO NEXT. STACK IF NEC.APXQ0324 * CONSTANT STATE AAPXQ0325 IR13 STO CFLAG LOAD CONSTANT SCALAR OR VCTRAPXQ0326 LD I LOCOR+4 APXQ0327 SLA 12 RSTO3 WILL HAVE /4000 IF CHAAPXQ0328 STO RSTO3 APXQ0329 BSI NXTRT GET COUNT AAPXQ0330 SLA 1 APXQ0331 STO CNT APXQ0332 A RBRST APXQ0333 MDX 2 -1 APXQ0334 BSI CGCOL GET SPACE APXQ0335 STO 2 0 STACK M POINTER APXQ0336 STO L 3 AAPXQ0337 LD SYLBL FORM RANK AAPXQ0338 S 1 1 APXQ0339 STO SYLBL FOR RANK VECTOR APXQ0340 BSC Z SKIP IF SCALAR APXQ0341 LD H1000 APXQ0342 A 1 14 APXQ0343 S H1000 APXQ0344 OR RSTO3 APXQ0345 STO 3 0 STORE RANK AAPXQ0346 LD SYLBL FORM RANK VECTOR AAPXQ0347 A H101 AAPXQ0348 STO 3 1 STORE RANK VECTOR AAPXQ0349 LD SYLBL TAKE CARE OF EMPTY CHAR. APXQ0350 BSC L EFPE,+Z STRING APXQ0351 MDX I3 CNT APXQ0352 CONLP LD RSTO3 IS THIS CHARACTER STRING APXQ0353 BSC L CONL1,Z BRANCH IF YES APXQ0354 BSI L GNXTW GET BITTOM WORD OF APXQ0355 STO 3 0 APXQ0356 BSI L GNXTW GET TOP WORD OF APXQ0357 MDX CONL2 NUMBER. GO SAVE IT APXQ0358 CONL1 BSI L GNSYL APXQ0359 A RSTO3 TOP WORD OF CHAR. NUMBER APXQ0360 STO 3 0 APXQ0361 LD H80 APXQ0362 CONL2 STO 3 1 APXQ0363 MDX 3 -2 INDEX APXQ0364 MDX L CNT,-2 LOOP APXQ0365 MDX CONLP &APXQ0366 LDX L1 LOCOR RESTORE X1 APXQ0367 MDX EFPE APXQ0368 H80 DC /80 APXQ0369 RSTO3 DC 0 APXQ0370 * IR4, LEFT BRACKET STATE APXQ0371 * IR8, SEMICOLON STATE APXQ0372 E SRT 16 APXQ0373 STO 1 13 SET TO STACK A ZERO &APXQ0374 LD 1 12 APXQ0375 AND OPND WAS LAST SYMBOL AN OPERAND APXQ0376 SLA 9 APXQ0377 RTE 16 APXQ0378 BSC L REPET,C YES APXQ0379 MDX IR5A NO APXQ0380 F LD 1 12 SET BINARY FLAG IN CASE OF APXQ0381 AND OPSTA GROUP 4 BRANCH AAPXQ0382 BSC L DOOP,Z GROUP 4 APXQ0383 GRP3 LD OPND GROUP3 APXQ0384 LDX L1 LOCOR APXQ0385 H1000 EQU *-1 APXQ0386 GOREP BSC L REPET APXQ0387 STBRZ LD AFOUR BRANCH STATE AAPXQ0388 MDX GRP3+1 APXQ0389 LDS DC /160 APXQ0390 DASEL DC DSEL+CFL APXQ0391 * CGCOL SAVES XR2 AS SVI, LINKS TO GCOL, AND THEN APXQ0392 * RESTORES SVI TO XR2 BEFORE EXITING APXQ0393 CGCOL DC *-* APXQ0394 LDX L1 LOCOR APXQ0395 STO 1 5 APXQ0396 BSI STX2 APXQ0397 BSI L GCOL GO GET SPACE APXQ0398 BSI LDX2 APXQ0399 BSC I CGCOL APXQ0400 REDUC LD DREDU LINK TO EXECUTE REDUCTION APXQ0401 SLDC MDX ISLD APXQ0402 DAFTR DC XQTFN+IDXFL APXQ0403 DINDX DC XQIND+EOSFL APXQ0404 RBRST DC /2 APXQ0405 DAFCN DC XQFUN+EOSFL APXQ0406 CFLAG DC 0 APXQ0407 CNT EQU CFLAG APXQ0408 AFOUR DC 4 APXQ0409 DREDU DC REDU+CFL APXQ0410 LDX2 DC *-* RESTORE SVI FROM LC REG 14 APXQ0411 LDX I2 LOCOR&14 APXQ0412 BSC I LDX2 APXQ0413 OPSTA DC 8 APXQ0414 OPND DC /80 APXQ0415 STX2 DC *-* APXQ0416 STX L2 LOCOR&14 APXQ0417 BSC I STX2 APXQ0418 WSFER LD WSOER APXQ0419 MDX ERXT2 APXQ0420 WSOER DC /4000+9 APXQ0421 SNTXX DC *-* SOME USE THIS, SOME DON'T APXQ0422 SYNER EQU * APXQ0423 SNTER LD SNERR APXQ0424 ERXIT BSS 0 ASSUMES R14 POINTS TO STACK APXQ0425 ERXT2 STO L 1 APLG8050APXQ0426 BSC L ERRXT APLG8060APXQ0427 * APLG8070APXQ0428 HDNG ** 1130 APL OPERATOR CONTROL ** APXQ0429 SYSER DC /4000+14 APXQ0430 SNERR DC /4000+4 APXQ0431 LENER DC /4000+15 APXQ0432 LGTER LD LENER APXQ0433 MDX ERXIT APXQ0434 NOMSK DC /1F APXQ0435 DMATR DC MATR APXQ0436 * DOOP PERFORMS OPERATOR CONTROL. IT IS ENTERED APXQ0437 * ONLY FROM THE SYNTAX ANALYZER. THIS ROUTINE APXQ0438 * EDITS FOR VALIDITY OF ENTRY AND THEN DECODES ANDAPXQ0439 * EDITS THE OPERATOR AND THE OPERANDSFOR THEIR APXQ0440 * ATTRIBUTES. APXQ0441 DOOP BSC L BINRY,- IF UNARY OPERATOR APXQ0442 LD L PSYL RESET POINTER APXQ0443 STO I GTSPL+1 APXQ0444 SRA 16 APXQ0445 MDX 2 -1 CREATE PSEUDO LEFT ARG ON APXQ0446 STO 2 0 STACK APXQ0447 BINRY STO L PIN APXQ0448 LD 2 1 APXQ0449 BSC L NOFNC,- IF OP IS DFN APXQ0450 LD DAFCN EXECUTE FUNCTION CALL APXQ0451 STO 1 15 R15 IS FLAG FOR FN W/ARG APXQ0452 MDX SLDC APXQ0453 NOFNC LD 2 2 IF RIGHT ARG IS OPERATOR APXQ0454 EOR H2000 APXQ0455 SRA 12 APXQ0456 BSC L *+2,Z APXQ0457 LD DMATR EXECUTE MATRIX PRODUCT APXQ0458 MDX SLDC APXQ0459 LD 2 1 GET OPERATOR NUMBER AND APXQ0460 AND NOMSK SAVE IN PIN APXQ0461 STO L PIN&1 APXQ0462 LD 2 1 GET KIND AND IF UNARY OP APXQ0463 SRA 5 ADD HIGHEST DYADIC KIND APXQ0464 AND NOMSK NUMBER APXQ0465 STO L 3 APXQ0466 LD SYSER APXQ0467 MDX 3 KTAB-UKTAB SKIP WILL OCCUR IF LEGAL OPAPXQ0468 MDX ERXIT APXQ0469 MDX L PIN,0 APXQ0470 MDX 3 KTAB-UKTAB ADJUST INDEX DOWN IF DYADICAPXQ0471 LD L3 ADTAB-2*KTAB+2*UKTAB GET BRANCH ADDRESAPXQ0472 STO EXCP3 APXQ0473 LD L3 2*UKTAB-KTAB GET COMPATIBILITY INFO APXQ0474 BSC L SNTER,+ APXQ0475 STO KNTRY AND RESULT INFORMATION APXQ0476 * THIS ROUTINE GETS AND EDITS THE RANK AND RANK APXQ0477 * VECTOR OF BOTH ARGUMENTS APXQ0478 LDX 3 2 SET UP TO GET AND CHECK M- APXQ0479 STX 3 CNT HEADER OF BOTH ARGUMENTS APXQ0480 LDX L3 PIN+2 APXQ0481 LD 2 2 GET RIGHT ARGUMENT APXQ0482 GTBST BSC L GMHDR,- IF STACK ENTRY NEG APXQ0483 EOR MSK USE INDIRECT BST ENTRY APXQ0484 BSI L LCLOD APXQ0485 GMHDR OR 1 -2 APXQ0486 STO *+1 APXQ0487 MHGET LDD L *-* GET M-HEADER AND EXTRACT APXQ0488 SLA 2 AND SAVE RANK APXQ0489 SRA 14 APXQ0490 STO 3 0 APXQ0491 LD I MHGET+1 GET HEADER WORD AGAIN APXQ0492 SRA 14 TO EXTRACT TYPE. APXQ0493 SLA 2 APXQ0494 STO 3 RHTYP-PIN-2 APXQ0495 SLT 16 GET AND SAVE RANK VECTOR APXQ0496 STO 3 1 APXQ0497 EOR H0101 CHECK RANK FOR COMPATIBILITYAPXQ0498 BSC L CXRHO,+- WITH THE REQUIRED RESULT APXQ0499 LD KNTRY IF SINGLE COMPONENT REQUIREDAPXQ0500 BSC E AND NOT PRESENT APXQ0501 MDX LGTER THERE IS A LENGTH EROOR APXQ0502 VCTR SRA 1 IF VECTOR REQUIRED AND A APXQ0503 OR 3 0 MATRIX IS PRESENT APXQ0504 BSC L CXRHO,E APXQ0505 RANK LD RNKER THERE IS A RANK ERROR APXQ0506 MDX ERXIT APXQ0507 CXRHO LD 3 1 CALCULATE XRHO APXQ0508 SRA 8 APXQ0509 STO BTMP RHO SUB 1 APXQ0510 LD 3 1 APXQ0511 SLA 8 APXQ0512 SRA 8 APXQ0513 M BTMP APXQ0514 SLT 16 APXQ0515 STO 3 2 APXQ0516 LD KNTRY ADJUST COMB/RESULT FIELD APXQ0517 SRA 2 APXQ0518 STO KNTRY APXQ0519 MDX 3 3 APXQ0520 LD 2 0 GET LEFT ARGUMENT APXQ0521 MDX L CNT,-1 APXQ0522 MDX GTBST AND PROCESS IT APXQ0523 * THIS ROUTINE CHECKS ALL ATTRIBUTES EXCEPT BSOP. APXQ0524 LD KNTRY SET XR3 FOR ATTR OPERATIONS APXQ0525 SRA 4 APXQ0526 A ADCON APXQ0527 CK3AD STO L 3 APXQ0528 K3 EQU CK3AD&1 APXQ0529 STO BRADR&1 APXQ0530 LD KNTRY IF NOT LATTER OR RATTR APXQ0531 AND K3 APXQ0532 BSC L INTBR,+- GO TO BRANCH ROUTINE APXQ0533 SLA 15 ELSE DETERMINE WHICH IT IS APXQ0534 LD 2 0 RESULT IS LATTR APXQ0535 BSC C APXQ0536 CKRAT LD 2 2 RESULT IS RATTR APXQ0537 BSC L GTPAR,- IF STACK ENTRY POS, DON'T APXQ0538 MDX SATT NEED TO GET SPACE FOR RESULTAPXQ0539 * SINCE IT WILL FIT INTO RARG APXQ0540 EXCP3 DC 0 APXQ0541 H2000 DC /2000 APXQ0542 MSK DC -1 APXQ0543 RHTYP DC 0 TYPE OF RIGHT ARG APXQ0544 KNTRY DC 0 APXQ0545 H100 DC /100 APXQ0546 DC 0 USED ONLY AS SINK. MUST BE APXQ0547 * THREE PAST RHTYP. APXQ0548 RNKER DC /4000+16 APXQ0549 ADCON DC BRADR APXQ0550 INTBR SRA 16 INITIALIZE SPAR APXQ0551 STO SPAR APXQ0552 LD 1 1 APXQ0553 STO SPAR+2 APXQ0554 LD H0101 APXQ0555 STO SPAR+1 APXQ0556 LD RATT APXQ0557 LDX L3 SPAR APXQ0558 BRADR BSC L *-* APXQ0559 SPAR DC 0 APXQ0560 * APXQ0561 DC /101 RHO APXQ0562 DC 1 XRHO APXQ0563 H0101 DC /101 APXQ0564 K8ATT LD RATT+2 COMPUTE XRHO=XRARG+XLARG APXQ0565 A LATT&2 APXQ0566 SRT 8 CHECK LENGTH LEQ 255 APXQ0567 BSC L LGTER,Z APXQ0568 SLT 8 APXQ0569 K12AT STO 3 2 STORE XRHO APXQ0570 A H100 COMPUTE RHO AND STORE IT APXQ0571 STO 3 1 APXQ0572 LD 1 1 APXQ0573 STO 3 0 APXQ0574 SATT LD 3 2 GET SPACE IN M FOR RESULT APXQ0575 A 1 1 APXQ0576 SLA 1 APXQ0577 STX 3 *+3 APXQ0578 BSI L CGCOL APXQ0579 LDX L3 *-* APXQ0580 BTMP EQU *-1 USED AS TEMP BY BSOP APXQ0581 * THIS ROUTINE SETS UP THE RESULT HEADER AND RANK APXQ0582 * VECTOR APXQ0583 GTPAR STO CKRNK APXQ0584 OR 1 -2 APXQ0585 STO MRSLT SAVE MPTR OF RESULT APXQ0586 BSI L MTGBG SET UP MLARG APXQ0587 STO MLARG APXQ0588 MDX 2 2 BUMP SVI APXQ0589 BSI L MTGBG SET UP MRARG APXQ0590 STO MRARG APXQ0591 LD 3 1 SET UP RANK VECTOR APXQ0592 SRT 16 APXQ0593 LD RHTYP TYPE BIT OF RIGHT ARG APXQ0594 AND KNTRY RETAIN IF PROPER APXQ0595 OR 3 0 APXQ0596 SLA 12 APXQ0597 ATWO A L 2 APXQ0598 S 1 -2 APXQ0599 STD I MRSLT STACK MPTR APXQ0600 LD CKRNK APXQ0601 STO 2 0 APXQ0602 EXC LD EXCP3 OFF TO EXECUTION APXQ0603 BSC L ISLD APXQ0604 * THIS ROUTINE EDITS BSOP ATTRIBUTES APXQ0605 MPATT LDX L3 RATT APXQ0606 S LATT APXQ0607 STO CKRNK APXQ0608 LD XRARG APXQ0609 EOR 1 1 SINGLE-COMPONENT CHECK APXQ0610 BSC L MULTI,Z APXQ0611 LD XLARG APXQ0612 EOR 1 1 SINGLE-COMPONENT CHECK APXQ0613 BSC L CKLAT,Z APXQ0614 LD CKRNK APXQ0615 BSC L CKRAT,- APXQ0616 CKLAT MDX 3 3 APXQ0617 LD 2 0 APXQ0618 MDX CKRAT&1 APXQ0619 MULTI LD XLARG APXQ0620 EOR 1 1 SINGLE-COMPONENT CHECK APXQ0621 BSC L CKRAT,&- APXQ0622 LD CKRNK APXQ0623 BSC L RANK,Z APXQ0624 LD XLARG APXQ0625 S XRARG APXQ0626 BSC L LGTER,Z APXQ0627 MDX CKRAT APXQ0628 BSS E 0 APXQ0629 IK2 DC 2 APXQ0630 * OPERATOR INFORMATION TABLE--PIN MUST BE ODD APXQ0631 PIN DC 1 UNARY/BINARY FLAG APXQ0632 DC 1 OPERATOR NUMBER APXQ0633 RATT DC 1 RHO RHO RARG APXQ0634 DC 1 RHO RARG APXQ0635 XRARG DC 1 XRHO RARG APXQ0636 LATT DC 1 RHO RHO LARG APXQ0637 DC 1 RHO LARG APXQ0638 XLARG DC 1 XRHO LARG APXQ0639 MLARG DC 1 M-POINTER LARG APXQ0640 MRARG DC 1 M-POINTER RARG APXQ0641 TRSLT DC LATT APXQ0642 MXADR DC 0 APXQ0643 MDXL DC /7400 APXQ0644 * BIOTA DEPENDS ON 1 13 BEING RELOCATED MPTR CK*APXQ0645 * ALSO BEPS APXQ0646 * COMMA ALSO APXQ0647 MRSLT DC 1 M-POINTER RESULT APXQ0648 * CKRNK SETS PTR TO FIRST DATA WORD AND SETS INCREAPXQ0649 * MENT FOR THE ARGUMENT. IT WILL BE EITHER 0 OR 2APXQ0650 CKRNK DC *-* APXQ0651 MDX 1 2 APXQ0652 LD 1 -1 APXQ0653 S H0101 APXQ0654 BSC Z APXQ0655 LD IK2 APXQ0656 OR MDXL APXQ0657 BSC I CKRNK APXQ0658 * THIS ROUTINE CONTROLS BSOP EXECUTION APXQ0659 BSOP BSS 0 APXQ0660 LD 3 2 INITIALIZE COUNTER APXQ0661 BSC L GRP3,+- EXIT NOW IF XRHO IS 0 APXQ0662 STO BTMP APXQ0663 LDX I1 MRARG APXQ0664 BSI CKRNK APXQ0665 STX 1 MRARG APXQ0666 STO RINCR APXQ0667 LDX I1 MLARG APXQ0668 BSI CKRNK APXQ0669 STX 1 MLARG APXQ0670 STO LINCR APXQ0671 LD PIN&1 APXQ0672 STO MXADR APXQ0673 OPRGO LDX I3 PIN+1 APXQ0674 LD L3 OPTAB APXQ0675 BSI L ENSOV APXQ0676 LDX L1 MLARG APXQ0677 BSI I ENS01 APXQ0678 RINCR MDX L MRARG,0 APXQ0679 LINCR MDX L MLARG,0 APXQ0680 LDD LATT APXQ0681 MDX L MRSLT,2 APXQ0682 STD I MRSLT APXQ0683 MDX L BTMP,-1 APXQ0684 MDX OPRGO APXQ0685 BSC L GRP3 APXQ0686 INDOM LD DOMER APXQ0687 BSC L ERXT2 APXQ0688 FPRNG EQU INDOM APXQ0689 IOERR EQU INDOM APXQ0690 BOLER EQU INDOM APXQ0691 ERROR EQU INDOM APXQ0692 DOMER DC /4000+7 APXQ0693 * DISPATCH TABLE FOR SYNTAX ANALYSIS EDITING AND APXQ0694 * LINKING TO INTERPRETATION RULES. APXQ0695 DSPCH DC /7B00+IR0-INTRP-1 UNDEFINED APXQ0696 DC /7B00+IR1-INTRP-1 OPERAND APXQ0697 DC /C100+IR2-INTRP-1 OPERATOR APXQ0698 DC /8100+IR3-INTRP-1 LEFT PAREN APXQ0699 DC /9200+IR4-INTRP-1 LEFT BRACKET APXQ0700 DC /5B00+IR5-INTRP-1 RIGHT PAREN APXQ0701 DC /7B00+IR6-INTRP-1 RIGHT BRACKET APXQ0702 DC /8100+IR7-INTRP-1 LEFT ARROW APXQ0703 DC /9200+IR8-INTRP-1 SEMICOLON APXQ0704 DC /8000+IR9-INTRP-1 SLASH APXQ0705 DC /8500+IR10-INTRP-1 COLON APXQ0706 DC /0900+IR11-INTRP-1 PERIOD APXQ0707 DC /7B00+IR12-INTRP-1 DFN FCN-NO ARGS APXQ0708 DC /5B00+IR13-INTRP-1 CONSTANT APXQ0709 DC /A000+IR14-INTRP-1 DFN FCN W/ARGS APXQ0710 DC /7B00+IR15-INTRP-1 QUAD APXQ0711 * BSOP EXECUTION ADDRESS TABLE APXQ0712 OPTAB DC SNTXX APXQ0713 DC BEXP+EOSFL APXQ0714 DC FAD APXQ0715 DC FSB APXQ0716 DC DAMAX+EOSFL APXQ0717 DC DAMAX+EOSFL APXQ0718 DC RESDU+EOSFL APXQ0719 DC FMP APXQ0720 DC FDV APXQ0721 DC COMBN+EOSFL APXQ0722 DC SNTXX LOG APXQ0723 DC SNTXX QUERY APXQ0724 ANDDR DC DABOL APXQ0725 DC DABOL APXQ0726 RELDR DC DAREL APXQ0727 DC DAREL APXQ0728 DC DAREL APXQ0729 DC DAREL APXQ0730 DC DAREL APXQ0731 DC DAREL APXQ0732 * ATTRIBUTE TABLE FOR OPERATOR CONTROL APXQ0733 KTAB DC LARB&RARB&MPATR BINARY SIMPLE OPS APXQ0734 DC LVEC&RARB&RATTR BINARY IOTA APXQ0735 DC LVEC+RARB+NOATR+RTYPE BINARY RHO APXQ0736 DC LVEC+RVEC+K8ATR+RTYPE COMMA APXQ0737 DC 0 TRANSPOSE APXQ0738 DC LARB+RARB+RATTR+RTYPE ROTATION APXQ0739 DC 0 BINARY RIGHT ARROW APXQ0740 DC 0 BINARY QUERY APXQ0741 DC 0 ERROR APXQ0742 DC LARB&RARB&LATTR BINARY EPSILON APXQ0743 DC 0 UP AND DOWN ARROWS APXQ0744 DC LVEC&RONC&LATTR REPRESENTATION APXQ0745 DC LVEC&RVEC&SATTR BASE VALUE APXQ0746 UKTAB DC LARB+RARB+RATTR UNARY SIMPLE OPS APXQ0747 DC LARB&RONC&NOATR UNARY IOTA APXQ0748 DC LARB&RARB&K12AR UNARY RHO APXQ0749 DC LARB+RARB+RATTR+RTYPE UNARY COMMA APXQ0750 DC LARB+RARB+NOATR MONADIC TRANSPOSE APXQ0751 DC LARB+RARB+RATTR+RTYPE REVERSAL APXQ0752 DC LARB&RVEC&NOATR RIGHT ARROW APXQ0753 DC LARB+RARB+RATTR MONADIC QUERY APXQ0754 DC 0 APXQ0755 DC 0 APXQ0756 DC 0 APXQ0757 DC 0 APXQ0758 DC 0 APXQ0759 * NON-BSOP EXECUTION ADDRESS TABLE APXQ0760 * AT LEAST THE FIRST UKTAB-KTAB-(ADTAB-UKTAB) WORDSAPXQ0761 * OF ADTAB MUST BE NON-POSITIVE BECAUSE SOME APXQ0762 * OPERATORS ARE LEGAL DYADICS BUT NOT MONADICS APXQ0763 ADTAB DC BSOP&CFL BINARY SIMPLE OPERATORS APXQ0764 DC BIOTA+EOSFL APXQ0765 DC BRHO+CFL BINARY RHO APXQ0766 DC COMMA+CFL COMMA APXQ0767 DC 0 DYADIC TRANSPOSE APXQ0768 DC DROT APXQ0769 DC 0 DYADIC BRANCH APXQ0770 DC 0 DYADIC QUERY APXQ0771 DC 0 DYADIC ERROR CLASS APXQ0772 DC BEPS+EOSFL APXQ0773 DC 0 UP AND DOWN ARROWS APXQ0774 DC BREP+EOSFL APXQ0775 DC DBASE+EOSFL APXQ0776 DC USOP APXQ0777 DC UIOTA+CFL UNARY IOTA APXQ0778 DC URHO+CFL UNARY RHO APXQ0779 DC RAVEL+CFL MONADIC COMMA APXQ0780 DC UPOSE APXQ0781 DC UREV APXQ0782 DC BRAN+CFL BRANCH APXQ0783 DC USOP APXQ0784 CFL EQU 0 APLH1654APXQ0785 LVEC EQU 0 APXQ0786 LONC EQU 4 APXQ0787 LARB EQU 8 APXQ0788 RVEC EQU 0 APXQ0789 RONC EQU 1 APXQ0790 RARB EQU 2 APXQ0791 RTYPE EQU /40 RES CHARACTER IF RIGHT ARG SAPXQ0792 T256 EQU 256 APXQ0793 BBAD EQU BRADR*T256 APXQ0794 MPATR EQU MPATT*T256-BBAD APXQ0795 K8ATR EQU K8ATT*T256-BBAD APXQ0796 K12AR EQU K12AT*T256-BBAD APXQ0797 SATTR EQU SATT*T256-BBAD APXQ0798 RATTR EQU RATT*T256-BBAD+/30 APXQ0799 LATTR EQU LATT*T256-BBAD+/10 APXQ0800 NOATR EQU EXC*T256-BBAD APXQ0801 HDNG AND OR EXECUTION APXQ0802 * DABOL AND/OR EXECUTION APXQ0803 * THIS ROUTINE PERFORMS R=A AND B OR R =A OR APXQ0804 * B. IT CHECKS THAT BOTH A AND B ARE EITHER APXQ0805 * 0 OR 1 AND RETURNS A DOMAIN ERROR IF THEY APXQ0806 * ARE NOT. APXQ0807 * REGISTERS ON ENTRY APXQ0808 * R1 = POINTER TO PLIST APXQ0809 * PLIST DC LARG APXQ0810 * DC RARG APXQ0811 * DC RESLT APXQ0812 * DC 12 (13) AND (OR) APXQ0813 * (ALL 1130 ADDRESSES) APXQ0814 * REGISTERS ON EXIT APXQ0815 * R1,2,3 DESTROYED APXQ0816 * APXQ0817 DAUNF DC 0 APXQ0818 BSI L UNFLT UNFLOAT B APXQ0819 BOLN1 LD I1 1 GET IT APXQ0820 BOLC1 EQU BOLN1+1 APXQ0821 S BOLC1 SEE IF IN RANGE APXQ0822 BSC I DAUNF,+ APXQ0823 MDX BOLER APXQ0824 DABOL EQU * APXQ0825 BSS 1 APXQ0826 MDX 1 1 APXQ0827 BSI DAUNF APXQ0828 STO BOTMP SAVE B-1 APXQ0829 LD 1 0 APXQ0830 STO BTMP2 SAVE LOC OF B APXQ0831 LD 1 -1 APXQ0832 STO 1 0 APXQ0833 BSI DAUNF APXQ0834 A BOTMP SUM IS -2, -1, OR 0 APXQ0835 A 1 2 ADD OP NO.,12=AND,13=OR APXQ0836 K2BOL STO L 2 SAVE IN XR2 APXQ0837 UIOK2 EQU K2BOL+1 APXQ0838 LDD I2 NUBIL+OPTAB-ANDDR+2 LUCKY FIND IN IDELAPXQ0839 STD I1 1 THAT'S THE ANSWER APXQ0840 LD BTMP2 APXQ0841 STO 1 0 APXQ0842 BORET BSC I DABOL BACK WE GO APXQ0843 BOTMP DC 0 APXQ0844 BTMP2 DC 0 APXQ0845 HDNG RELATIONAL OPERATOR EXECUTION APXQ0846 DAREL BSS 1 APXQ0847 LD 1 3 PICK UP OP NO. APXQ0848 STO L 2 SAVE IN XR2 APXQ0849 LD L2 BTABL-RELDR+OPTAB TO GET BRANCH INST APXQ0850 STO DARBR SAVE APXQ0851 BSI L FSBN APXQ0852 LDX L2 IDELS POINT XR2 INDIRECTLY TO 1.0 APXQ0853 LD I1 2 PICK UP RESULT APXQ0854 DARBR BSC +-Z INSTRUCTION IS MODIFIED APXQ0855 MDX 2 1 XR2 POINTS INDIRECTLY TO 0.0APXQ0856 LDD I2 0 PICK UP RESULT APXQ0857 STD I1 2 SAVE IN RESULT APXQ0858 BSC I DAREL APXQ0859 BTABL BSC - LSS APXQ0860 BSC -Z LEQ APXQ0861 BSC Z EQU APXQ0862 BSC &Z GEQ APXQ0863 BSC & GTR APXQ0864 BSC &- NEQ APXQ0865 HDNG UNARY RHO EXECUTION APXQ0866 * URHO UNARY RHO EXECUTION APXQ0867 * THIS ROUTINE PERFORMS R= RHO A APXQ0868 * IT PICKS UP THE SECOND WORD IN THE MHEADER APXQ0869 * OF A, BREAKS IT IN HALF AND FLOATS THE APXQ0870 * APPROPRIATE PORTIONS TO OBTAIN THE RESULT. APXQ0871 * REGISTERS ON ENTRY APXQ0872 * R1= POINTER TO PIN (1130 ADDRESS) APXQ0873 * R2=SVI (1130 ADDRESS) APXQ0874 * NOTE THAT THE MPTR OF RESULT IS AT THE TOP APXQ0875 * OF THE STACK (LC ADDRESS) APXQ0876 * REGISTERS ON EXIT APXQ0877 * R1,2,3 DESTROYED APXQ0878 * APXQ0879 URHO BSS 0 APXQ0880 LD 1 2 RHO RHO RARG APXQ0881 A BOLC1 APXQ0882 STO BTMP2 APXQ0883 SLA 1 APXQ0884 A 2 0 APXQ0885 STO URLST+1 APXQ0886 LD 1 3 PICK UP RHO RARG APXQ0887 STO DAREL APXQ0888 AND URMSK APXQ0889 RHON2 STO BOTMP APXQ0890 MDX L URLST+1,-2 APXQ0891 MDX L BTMP2,-1 APXQ0892 MDX RHON1 APXQ0893 MDX COMNX COMMON EXIT TO GRP3 APXQ0894 RHON1 LDX L1 URLST APXQ0895 BSI L FLT APXQ0896 LD DAREL APXQ0897 SRA 8 APXQ0898 MDX RHON2 APXQ0899 URLST DC BOTMP APXQ0900 DC APXQ0901 URMSK DC /FF APXQ0902 HDNG UNARY IOTA APXQ0903 * UIOTA UNARY IOTA EXECUTION APXQ0904 * THIS ROUTINE PERFORMS R=IOTA A APXQ0905 * IT DOES ITS OWN GETSPACE AND STACKS THE APXQ0906 * MPTR OF THE RESULT. IT STEPS THROUGH THE APXQ0907 * INTEGERS , FLOATING ONE AT A TIME UNTIL IT APXQ0908 * IS DONE. APXQ0909 * REGISTERS ON ENTRY APXQ0910 * R1= POINTER TO PIN (1130 ADDRESS) APXQ0911 * R2= SVI (1130 ADDRESS) APXQ0912 * REGISTERS ON EXIT APXQ0913 * ALL DESTROYED APXQ0914 * APXQ0915 UIOTA BSS 0 APXQ0916 MDX 2 2 POP STACK APXQ0917 LD 1 PIN+1-PIN GET OPERATOR NUMBER APXQ0918 BSC L SNTER,Z BECAUSE IT COULD BE A NULL APXQ0919 LDX L1 LOCOR APXQ0920 BSI L MTGBG GET LOC AND MARK AS GARBAGE APXQ0921 A UIOK2 APXQ0922 STO IOPL SAVE IN PLIST APXQ0923 LDX L1 IOPL APXQ0924 BSI L UNFLT APXQ0925 UION4 LD BOTMP APXQ0926 SRT 8 DOMAIN ERROR IF OVER 255 APXQ0927 BSC L IOERR,Z APXQ0928 LD BOTMP APXQ0929 A IOK1 APXQ0930 STO BTMP2 APXQ0931 SLA 1 APXQ0932 BSI L CGCOL APXQ0933 STO 2 0 APXQ0934 * ASSUMES RELOC IS OPERAND CLASS APXQ0935 ION1 STO L 1 APXQ0936 IOK1 EQU ION1&1 APXQ0937 LD L LOCOR&14 APXQ0938 STO 1 0 APXQ0939 LD BOTMP PICK UP RHO APXQ0940 OR RHOMK FORM INTO RHO WORD FOR HEADERAPXQ0941 STO 1 1 APXQ0942 MDX 1 2 APXQ0943 STX 1 IOPL&2 APXQ0944 LD IOK1 ONE ORIGIN APXQ0945 STO BOTMP APXQ0946 ION5 MDX L BTMP2,-1 APXQ0947 MDX ION6 APXQ0948 MDX COMNX COMMON EXIT TO GRP3 APXQ0949 ION6 LDX L1 IOPL+1 APXQ0950 BSI L FLT FLOAT THE NUMBER APXQ0951 MDX L BOTMP,1 STEP APXQ0952 MDX L IOPL&2,2 APXQ0953 MDX ION5 APXQ0954 IOPL DC APXQ0955 DC BOTMP APXQ0956 DC APXQ0957 RHOMK DC /0100 APXQ0958 * APXQ0959 HDNG COMMA EXECUTION APXQ0960 * COMMA COMMA EXECUTION APXQ0961 * THIS ROUTINE PERFORMS R= A,B APXQ0962 * IT DOES THIS BY PICKING UP THE ELEMENTS OF APXQ0963 * A, COPYING THEM INTO R AND THEN COPYING APXQ0964 * B INTO THE REMAINING LOCATIONS IN R. APXQ0965 * REGISTERS ON ENTRY APXQ0966 * R1= POINTER TO PIN (1130 ADDRESS) APXQ0967 * R2= SVI (1130 ADDRESS) APXQ0968 * NOTE THAT THE MPTR OF R IS ON THE TOP APXQ0969 * OF THE STACK. (LC ADDRESS) APXQ0970 * REGISTERS ON EXIT APXQ0971 * ALL DESTROYED APXQ0972 * RETURN IS TO GRP3 APXQ0973 * APXQ0974 COMMA BSS 0 APXQ0975 LDX 2 2 BECAUSE THERE ARE TWO ARGUMEAPXQ0976 LD 1 XLARG-PIN APXQ0977 COMN2 STO L 3 XR3 IS ELEMENT COUNTER APXQ0978 BSC L COMN5,+ BRANCH IF ARGUMENT NULL APXQ0979 COMN6 MDX L MRSLT,2 INCREMENT RESULT POINTER APXQ0980 MDX L MLARG,2 INCR ARG PTR APXQ0981 LDD I MLARG APXQ0982 STD I MRSLT TRANSFERED APXQ0983 MDX 3 -1 APXQ0984 MDX COMN6 APXQ0985 COMN5 LD 1 MRARG-PIN NOW DO RIGHT ARG APXQ0986 STO 1 MLARG-PIN APXQ0987 LD 1 XRARG-PIN APXQ0988 MDX 2 -1 APXQ0989 MDX COMN2 GO CATENATE IT APXQ0990 COMNX BSC L GRP3 APXQ0991 HDNG UNARY SIMPLE OPERATOR EXECUTION APXQ0992 * USOP UNARY SIMPLE OPERATOR CONTROL APXQ0993 * AND EXECUTION ROUTINES APXQ0994 * THE MAIN ROUTINE PERFORMS ALL THE SETUP APXQ0995 * COMMON TO ALL UNARY SIMPLE OPERATORS AND APXQ0996 * THEN BRANCHES TO AN APPROPRIATE EXECUTION APXQ0997 * ROUTINE, MOST OF WHICH ARE IN THIS SAME APXQ0998 * DECK. APXQ0999 * REGISTERS ON ENTRY APXQ1000 * R1=POINTER TO PIN(1130 ADDRESS) APXQ1001 * R2= SVI (1130 ADDRESS) APXQ1002 * NOTE THAT THE MPTR OF RESULT IS ON THE APXQ1003 * TOP OF THE STACK. (LC ADDRESS) APXQ1004 * REGISTERS ON EXIT APXQ1005 * ALL DESTROYED APXQ1006 USOP LD 1 1 PICK UP OP NO. APXQ1007 STO L 3 SAVE IN XR3 APXQ1008 S ULOP APXQ1009 BSC L SNTER,- APXQ1010 LD L3 UTABL APXQ1011 BSI L ENSOV ENSURE OVERLAY IS LOAAPXQ1012 STO BADDR&1 SAVE FOR BRANCH IN LOOP APXQ1013 LD 1 9 MPTR OF RARG APXQ1014 STO UPL APXQ1015 LD 1 4 XRHO OF RARG APXQ1016 A UK1 UP BU 1 FOR LEADING BRANCH APXQ1017 STO COUNT NUMBER OF TIMES THRU LOOP APXQ1018 LD 2 0 MPTR OF RESULT APXQ1019 STO RESLT APXQ1020 UN5 MDX L UPL,2 STEP ARG POINTER APXQ1021 MDX L COUNT,-1 COUNT AND TEST APXQ1022 MDX UN6 CONTINUE APXQ1023 UDONE MDX COMNX APXQ1024 UN6 LDX L1 UPL POINT TO PLIST APXQ1025 BADDR BSI L *-* EXECUTE ROUTINE APXQ1026 UN7 MDX L RESLT,2 APXQ1027 LDD UTEMP APXQ1028 STD L *-* APXQ1029 RESLT EQU *-1 APXQ1030 MDX UN5 APXQ1031 UPL DC MPTR OF RARG APXQ1032 DC UTEMP APXQ1033 UTEMP BSS E 2 APXQ1034 COUNT DC APXQ1035 * OP NO. OPERATION APXQ1036 UTABL DC COMPL 0 NOT APXQ1037 DC FEXP+EOSFL APXQ1038 DC PLUS 2 TRANSFER APXQ1039 DC UMIN 3 NEGATE APXQ1040 DC CEILN 4 GREATEST INTEGER IN APXQ1041 DC FLOOR 5 LEAST INTEGER IN APXQ1042 DC ABS 6 ABSOLUTE VALUE APXQ1043 DC UMULT APXQ1044 DC DIVID 8 RECIPROCAL APXQ1045 DC FACTO+EOSFL APXQ1046 DC FLN+EOSFL APXQ1047 DC QUERY+EOSFL APXQ1048 ULOP DC *-UTABL-1 NUMBER OF USOPS APXQ1049 COMPL BSS 1 APXQ1050 BSI L UNFLT APXQ1051 LDX I1 UTEMP PUT ARGUMENT IN INDEX APXQ1052 MDX 1 -1 TEST FOR GTR 1 APXQ1053 MDX COE IT WAS. ERROR. APXQ1054 LDD I1 IDELS+1 IDEN FOR EXP (1) OR FOR APXQ1055 STD UTEMP PLUS (0) APXQ1056 MDX UN7 APXQ1057 COE BSC L INDOM APXQ1058 UMULT DC 0 APXQ1059 LDD I1 0 APXQ1060 BSC L UMUL2,+- APXQ1061 BSC L UMUL1,+ APXQ1062 LDD L IDEN1 APXQ1063 MDX UMUL2 APXQ1064 UMUL1 LDD MINS1 APXQ1065 UMUL2 STD I1 1 APXQ1066 MDX UN7 APXQ1067 PLUS BSS 1 PLUS AND UMIN APXQ1068 LDD I1 0 MUST BE EXACTLY EIGHT APXQ1069 STD I1 1 LOCATIONS APART, BECAUSE APXQ1070 UK1 EQU *-1 APXQ1071 BSC I PLUS BEXP EXPECTS THEM TO BE. APXQ1072 UMIN BSS 1 APXQ1073 MINUS EQU UMIN APXQ1074 LDD UMINC APXQ1075 SD I1 0 APXQ1076 RTE 16 APXQ1077 EOR UMINC+1 APXQ1078 RTE 16 APXQ1079 STD I1 1 APXQ1080 BSC I UMIN APXQ1081 * RECALL THAT (CEILING A)=- FLOOR - A APXQ1082 CEILN BSS 1 APXQ1083 STX 1 SAVE1&1 SAVE XR1 APXQ1084 STX SAVE2+1 STORE FLAG APXQ1085 BSI UMIN NEGATE APXQ1086 LD CEILN PICK UP RETURN ADDRESS APXQ1087 MDX 1 1 POINT TO NEGATED ARGUMENT APXQ1088 MDX COMM COME TOGETHER APXQ1089 * FLOOR EXECUTION IS DONE BY TWO FLOATING APXQ1090 * ADDITIONS. THE FIRST PERFORMS THE FUZZING APXQ1091 * AND THE SECOND, BY ADDING AN UNNORMALIZED APXQ1092 * ZERO CAUSES THE FLOATING ADD ROUTINE TO DO APXQ1093 * THE TRUNCATION SHIFT. APXQ1094 FLOOR BSS 1 APXQ1095 LDX 2 0 SET FLAG APXQ1096 STX 2 SAVE2&1 AND STORE APXQ1097 STX 1 SAVE1&1 APXQ1098 LD FLOOR PICK UP RETURN ADDRESS APXQ1099 COMM STO UEXIT+1 SAVE RETURN ADDRESS APXQ1100 LD 1 0 PICK UP LOC OF ARG APXQ1101 STO UPL1+1 SAVE FOR FAD APXQ1102 LD ADFZZ PICK UP LOC OF FUZZ APXQ1103 STO UPL1 SAVE THAT IN PLIST APXQ1104 LDX L1 UPL1 SET UP POINTER TO PLIST APXQ1105 BSI L FAD ADD FUZZ APXQ1106 LD ADZRO OVERFLOW ON FAD IMPOSSIBLE APXQ1107 STO UPL1 POINTS TO UNNORMALIZED ZERO APXQ1108 LD UPL1+2 LOC OF RESULT OF FAD APXQ1109 STO UPL1+1 SAVE AS POINTER TO ADDEND APXQ1110 BSI L FAD PERFORM ADD APXQ1111 SAVE2 LDX L2 *-* PICK UP FLAG APXQ1112 MDX 2 0 TEST FOR ZERO APXQ1113 MDX CE IF CEILN, THEN GO TO CE APXQ1114 SAVE1 LDX L1 *-* RESTORE XR1 APXQ1115 LDD UTEMP APXQ1116 STD I1 1 APXQ1117 UNUN EQU *-1 APXQ1118 UEXIT BSC L *-* RETURN APXQ1119 CE LDX L1 UPL2 APXQ1120 BSI UMIN RECOMPLEMENT APXQ1121 MDX SAVE1 DONE APXQ1122 PLST1 DC IDEN1 DEC 1.0 APXQ1123 UPL1 DC APXQ1124 DC APXQ1125 UPL2 DC UTEMP APXQ1126 DC UTEMP APXQ1127 ADFZZ DC FUZZ APXQ1128 ADZRO DC ZERO APXQ1129 MINS1 DEC -1.0 APXQ1130 FUZZ DC /4000 APXQ1131 DC /0072 APXQ1132 ZERO DC 0 APXQ1133 DC /009F 128&31 APXQ1134 UMINC DC /0000 APXQ1135 DC /00FF APXQ1136 DIVID BSS 1 APXQ1137 LD 1 0 APXQ1138 STO PLST1&1 APXQ1139 LD 1 1 APXQ1140 STO PLST1&2 APXQ1141 LDX L1 PLST1 APXQ1142 BSI L FDV APXQ1143 RET BSC I DIVID APXQ1144 ABS BSS 1 APXQ1145 LD I1 0 APXQ1146 BSC - APXQ1147 BSI PLUS APXQ1148 BSC & APXQ1149 BSI UMIN APXQ1150 BSC I ABS APXQ1151 HDNG ** BRANCH APXQ1152 BRAN BSS 0 APXQ1153 MDX L LOCOR+14,2 CUT BACK STACK APXQ1154 STX L FULST SET FULL STATEMENT APXQ1155 LDD 1 XRARG-PIN ODD ALIGNED APXQ1156 BSC L STBRA,+ NULL VECTOR EXIT APXQ1157 LD 2 2 GET ARG PTR FROM STACK APXQ1158 BSI L LEWD ROUTINE HAS DESIRABLE APXQ1159 LD L LX SIDE EFFECT APXQ1160 LDX L1 MRARG AND AN UNDESIREABLE ONE. APXQ1161 A 1 ATWO-MRARG+1 ACC PTS TO 1ST EL, RARG APXQ1162 STO 1 MRARG-MRARG PLIST AT MRARG APXQ1163 LD I1 LOOK AT IT APXQ1164 BSC L STBRA,+ AND DUCK OUT IF NONPOS APXQ1165 BSI L UNFLT APXQ1166 LD 1 LATT-MRARG LOOK AT THE ANSWER APXQ1167 RTE 24 POSITION I0 IN HIGH BYTE APXQ1168 OR 1 ATWO+1-MRARG MAKE LOW BYTE NONZERO APXQ1169 STBRA STO L ISBRN STORE ANSWER APXQ1170 SLT 24 APXQ1171 BSC L STBRZ,+- LOADS STATE & GOES TO GRP3 APXQ1172 LD *-1 VERILY AN INVALID BRANCH ADRAPXQ1173 MDX STBRA WE'LL SURELY EXIT THIS TIME APXQ1174 HDNG ** RAVEL APXQ1175 RAVEL BSS 0 OPERATION ,A APXQ1176 LD 1 XRARG-PIN RECOMPUTE M-HEADER FOR RESLTAPXQ1177 SRT 8 APXQ1178 BSC L LGTER,Z DISALLOW LENGTH OVER 255 APXQ1179 LD UNUN APXQ1180 SRT 8 APXQ1181 LD 1 RHTYP-PIN RESULT TYPE IS AGRUMENT TYPEAPXQ1182 SLA 12 APXQ1183 A L 2 BECAUSE LOCOR=1000, THIS APXQ1184 STD I MRSLT SETS RESULT RANK TO 1. APXQ1185 LD 1 MRARG-PIN IF OPERATION IS BEING DONE APXQ1186 EOR 1 MRSLT-PIN IN PLACE, WE'RE THROUGH APXQ1187 BSC L GRP3,+- APXQ1188 RVNXT MDX L MRARG,2 TRANSFER LOOP APXQ1189 MDX L MRSLT,2 APXQ1190 LD 1 XRARG-PIN APXQ1191 S UNUN APXQ1192 STO 1 XRARG-PIN APXQ1193 BSC L GRP3,+Z EXIT IF NO MORE ELEMENTS APXQ1194 LDD I1 MRARG-PIN APXQ1195 STD I1 MRSLT-PIN APXQ1196 MDX RVNXT APXQ1197 HDNG ** MONADIC TRANSPOSE APXQ1198 UPOSE BSS 0 APXQ1199 MDX 2 1 POINT SVI TO OPERATOR APXQ1200 SLA 16 SET SWITCH USED BY RRGST APXQ1201 STO L SLFLP PROPERLY APXQ1202 LD UNUN RRGST THINKS AN OPERATOR IS APXQ1203 STO 2 0 AN ELSIE POINTER APXQ1204 BSI L RRGST GET MAGIC NUMBERS AND SET R1APXQ1205 MDX 2 1 CUT BACK STACK APXQ1206 LD FEUER CALCULATE SPACE FOR RESULT APXQ1207 S 1 SDECR-SDECR APXQ1208 UPO01 EQU * APXQ1209 BSI L CGCOL GET SPACE FOR RESULT APXQ1210 RTE 16 SAVE RESULT M-PTR APXQ1211 BSI L MTGBG MARK ARGUMENT GARBAGE APXQ1212 LDX L3 RDECR LOAD BASE REGISTER APXQ1213 A 3 SX-RDECR POINT POINTER TO FIRST APXQ1214 STO 3 RDECR-RDECR ELEMENT OF NON-EXISTENT APXQ1215 * COLUMN TO RIGHT OF LAST APXQ1216 * ACTUAL COLUMN APXQ1217 RTE 16 APXQ1218 STO 2 PUT RESULT PTR ON STACK APXQ1219 STO 3 RDECR+1-RDECR AND IN PLIST APXQ1220 LDD 3 INRHO-RDECR APXQ1221 MDX L RATT,-1 APXQ1222 RTE 16 APXQ1223 SLA 8 APXQ1224 RTE 24 APXQ1225 LD 3 RANQ-RDECR RANK AND TYPE APXQ1226 SLA 12 APXQ1227 A 1 14 APXQ1228 S 1 -2 APXQ1229 STD I3 RDECR+1-RDECR APXQ1230 LDX L1 RDECR XR1 IS PLIST POINTER APXQ1231 LD 1 1 RESULT PTR TO LAST ELEMENT APXQ1232 A 1 EL2-RDECR APXQ1233 S 1 SDECR-RDECR APXQ1234 STO 1 1 APXQ1235 NXELM LDD 1 ESCTR-RDECR COORDINATES OF WHERE WE APXQ1236 SD 1 ZERWN-RDECR WERE IN ARGUMENT APXQ1237 BSC L GRP3,+Z EXIT IF WE WERE AT 0,0 APXQ1238 STD 1 ESCTR-RDECR APXQ1239 SLT 1 APXQ1240 BSC L NEXRW,E BRANCH IF WE JUST FINISHED APXQ1241 LD 1 0 A COLUMN. APXQ1242 S 1 SDECR+1-RDECR MOVE TO NEXT ELEMENT IN APXQ1243 TNSFR STO 1 0 SAME COLUMN APXQ1244 BSI L PLUS DO THE TRANSFER. APXQ1245 MDX L RDECR+1,-2 DECREMENT RESULT PTR APXQ1246 MDX NXELM APXQ1247 NEXRW LD 1 LOSET-RDECR MOVE TO NEXT COLUMN APXQ1248 STO 1 ESCTR+1-RDECR TO THE LEFT APXQ1249 LD 1 0 APXQ1250 S 1 SDECR-RDECR APXQ1251 STO 1 0 APXQ1252 MDX NXELM APXQ1253 FEUER DC 4 APXQ1254 HDNG BINARY RHO EXECUTION APXQ1255 * BRHO BINARY RHO EXECUTION APXQ1256 * THIS ROUTINE PERFORMS R= A RHO B APXQ1257 * IT BEGINS BY COMPUTING THE TIMES REDUCTION APXQ1258 * OF A, THEN USING THIS INFORMATION IT APXQ1259 * PERFORMS A GETSPACE FOR THE RESULT APXQ1260 * AND SETS UP AND STORES THE MHDR. IT APXQ1261 * CUTS BACK THE STACK AND PLACES THE MPTR OF APXQ1262 * THE RESULT AT THE TOP OF THE STACK. IT APXQ1263 * RUNS THROUGH A LOOP, EXTRACTING DATA ITEMS APXQ1264 * FROM B IN THE APPROPRIATE ORDER AND APXQ1265 * PLACING THEM IN THE RESULT. APXQ1266 * REGISTERS ON ENTRY APXQ1267 * R1=POINTER TO PIN (1130 ADDRESS) APXQ1268 * R2 = SVI (1130 ADDRESS) APXQ1269 * REGISTERS ON EXIT APXQ1270 * ALL DESTROYED APXQ1271 * RETURN IS TO GRP3 APXQ1272 * APXQ1273 BRHO BSS 0 APXQ1274 LD 1 7 SAVE XRHO LARG APXQ1275 STO XRHOL APXQ1276 LD 1 4 SAVE XRHO RARG APXQ1277 A BRK1 APXQ1278 STO XRHOR APXQ1279 LDX L1 LOCOR APXQ1280 BSI MTGBG APXQ1281 A BRK2 POINT TO FIRST DATA IN APXQ1282 * LARG APXQ1283 STO PLST APXQ1284 LD XRHOL APXQ1285 A BRK1 ADD ONE FOR LEADING BRANCH APXQ1286 STO CT COUNT FOR FIRST LOOP APXQ1287 S BRK3 COMPARE WITH 2 APXQ1288 BSC L LGTER,-Z LENGTH ERROR IF GTR 2 APXQ1289 LDD BRK1 INITIALIZE RANK OF RESULT APXQ1290 STD ARG1 SAVE IN ARG1 AND ARG1&1 APXQ1291 LD ADARG PICK UP ADDRESS OF ARG1 APXQ1292 STO PLST&1 APXQ1293 BRON2 MDX L CT,-1 COUNT AND TEST APXQ1294 MDX BRN1 APXQ1295 LD ARG1 PICK UP ONE ELEMENT OF RANKAPXQ1296 M ARG1&1 MULTIPLY BY OTHER APXQ1297 SLT 16 BRING INTO ACC APXQ1298 A BRK1 ADD 1 FOR HEADER APXQ1299 STO XREDL COUNTER FOR SECOND LOOP APXQ1300 SLA 1 DOUBLE APXQ1301 BSC L WSFER,+C ERROR IF OVERFLOW APXQ1302 MDX 2 2 POP STACK BACK TO RIGHT ARG APXQ1303 BRH01 EQU * APXQ1304 BSI L CGCOL APXQ1305 STO MPTRR APXQ1306 * COUNTS ON RECOL BEING OPERAND CLASS APXQ1307 BRK3A STO L 3 APXQ1308 LD L RHTYP TO GET TYPE BIT APXQ1309 A XRHOL XRHO LARG APXQ1310 SLA 12 APXQ1311 A 1 14 APXQ1312 S 1 -2 APXQ1313 STO 3 0 SAVE AS MHDR APXQ1314 LDD ARG1 APXQ1315 RTE 8 APXQ1316 AD ARG1 APXQ1317 MDX L XRHOL,-1 APXQ1318 RTE 16 APXQ1319 STO 3 1 SAVE AS RESULT RANK VECTOR APXQ1320 BSI MTGBG APXQ1321 STO PLST APXQ1322 STO MPTR APXQ1323 LD MPTRR APXQ1324 STO 2 0 APXQ1325 STX 3 PLST&1 APXQ1326 LD XRHOR XRHO RARG APXQ1327 STO CT APXQ1328 S BRK1 APXQ1329 BSC L RLOOP,Z APXQ1330 LD XREDL APXQ1331 S BRK1 APXQ1332 BSC L DMERR,Z CAN'T REPLICATE IOTA 0 APXQ1333 RLOOP MDX L PLST+1,2 APXQ1334 MDX L XREDL,-1 APXQ1335 MDX N5 APXQ1336 BDONE BSC L GRP3 APXQ1337 N5 MDX L PLST,2 APXQ1338 MDX L CT,-1 APXQ1339 MDX BRON6 APXQ1340 LD MPTR APXQ1341 STO PLST START FRESH AT BEGINNING APXQ1342 LD XRHOR OF RARG APXQ1343 STO CT APXQ1344 MDX N5 APXQ1345 BRON6 LDD I PLST APXQ1346 STD I PLST&1 APXQ1347 MDX RLOOP APXQ1348 BRN1 LDX L1 PLST APXQ1349 BSI L UNFLT APXQ1350 N3 LD I PLST&1 APXQ1351 SRA 8 APXQ1352 BSC L DMERR,Z APXQ1353 MDX L PLST,2 APXQ1354 MDX L PLST&1,1 APXQ1355 MDX BRON2 APXQ1356 BRK2 DC 2 APXQ1357 PLST BSS 2 APXQ1358 BSS E 0 APXQ1359 CT DC APXQ1360 BRK1 DC 1 MUST BE ALIGNED ODD APXQ1361 ARG1 BSS 2 APXQ1362 ADARG DC ARG1 APXQ1363 XREDL DC APXQ1364 XRHOR DC 0 APXQ1365 XRHOL DC 0 APXQ1366 BRK3 EQU BRK3A+1 APXQ1367 MPTR EQU ARG1 APXQ1368 MPTRR EQU PLST&1 APXQ1369 DMERR EQU INDOM APXQ1370 MTGBG BSS 1 APXQ1371 LD 2 0 APXQ1372 BSC L INDIR,&Z APXQ1373 BSC I MTGBG,+ EXIT IF LARG OF UNARY OP APXQ1374 OR 1 -2 APXQ1375 STO *&2 APXQ1376 LD MTMSK APXQ1377 STO L *-* APXQ1378 LD *-2 APXQ1379 MDX MTXIT APXQ1380 INDIR EOR MTMSK APXQ1381 BSI L LCLOD APXQ1382 OR 1 -2 APXQ1383 MTXIT BSC I MTGBG APXQ1384 MTMSK EQU * APXQ1385 HDNG ** REDUCTION, EXPANSION, AND COMPRESSIAPXQ1386 ONES DC /FFFF APXQ1387 * DO COMMON SETUP FOR SLASH OPS APXQ1388 RRGST DC *-* APXQ1389 LD 2 1 GET RH OPERAND APXQ1390 BSI LEWD HEADER AND RANK VECTOR APXQ1391 SRA 12 APXQ1392 LDX L1 SDECR APXQ1393 STO 1 RANQ-SDECR SAVE RANK&TYPE FOR MASTER APXQ1394 SLA 8 TO CLEAR ACC APXQ1395 RTE 8 APXQ1396 SRA 8 RHO2 IN ACC, RHO1 IN EXT APXQ1397 STD 1 INRHO-SDECR APXQ1398 LD 2 APXQ1399 BSI LEWD GET SLASH APXQ1400 STO 1 SLISH-SDECR APXQ1401 AND 1 RANQ-SDECR REMOVE DIARESIS FOR VECT APXQ1402 SRA 1 APXQ1403 EOR 1 SLFLP-SDECR FLIP SLASH FOR REDUCTION APXQ1404 STO L 3 CODE 0 OR 1 ON OP, RANK, DIAAPXQ1405 MDX L3 INRHO APXQ1406 BSI 1 SCNST-SDECR APXQ1407 BSC I RRGST APXQ1408 * APXQ1409 *SEL FINISHED LAST VECTOR. MOVE TO NEXT, GET NEW LAAPXQ1410 SETLO LD 2 2 SET LO COORD TO APXQ1411 STO 2 5 LOSET APXQ1412 LD 2 3 TAKE SX OR RX APXQ1413 S 2 DISTRACT APXQ1414 STO 2 3 APXQ1415 LD 1 DECREMENT LH ARG APXQ1416 S 1 LDECR-LX PTR & GET NEXT APXQ1417 STO 1 LEFT ARG APXQ1418 STX 3 SV3+1 APXQ1419 BSI L UNFLT APXQ1420 *SEL DECIDE WHETHER 0 OR 1.. TRANSFER IF 1 APXQ1421 SV3 LDX L3 *-* APXQ1422 LD 1 VAL-LX APXQ1423 BSC L ZER,+ APXQ1424 S 1 EL1-LX APXQ1425 BSC L INDOM,Z APXQ1426 LD 3 3 RX OR SX APXQ1427 S 3 NEW VECTOR IN APXQ1428 STO 3 3 MINOR ARRAY APXQ1429 NXTEL BSI 1 NXMJL-LX NEXT ELEM IN MAJOR ARRAY APXQ1430 LD 3 3 NEW ELEMENT IN MINOR ARRAY APXQ1431 S 3 1 APXQ1432 STO 3 3 APXQ1433 LDD I SX APXQ1434 STD I RX THE ACTUAL TRANSFER APXQ1435 MDX NXTEL APXQ1436 *SEL START. CHECK OUT LEFT ARG APXQ1437 DSEL BSS 0 APXQ1438 LD 2 GET LEFT OPERAND POINTER APXQ1439 BSI LEWD GET HEADER & RANK VECTOR APXQ1440 SLA 8 CLEAR OUT HEADER APXQ1441 SLT 8 LOOK AT RHO1 APXQ1442 EOR G1&1 APXQ1443 BSC L LGVEC,&- ALLOW VECTOR OR EQUIV APXQ1444 BSC L RANK APXQ1445 *LEWD DOUBLE LOAD ACCORDING TO PTR IN ACC APXQ1446 LEWD DC *-* LOAD ARGUMENT WHOSE PTR APXQ1447 BSC L G1&3,- IS IN ACC APXQ1448 EOR ONES APXQ1449 OR RELAC APXQ1450 G1 STO L 1 APXQ1451 LD 1 APXQ1452 OR RELAC APXQ1453 STO LX APXQ1454 LDD I LX APXQ1455 BSC I LEWD APXQ1456 * REDUCTION APXQ1457 REDU BSS 0 APXQ1458 LD L 13&LOCOR CHECK FOR BSOP APXQ1459 BSI LEWD APXQ1460 AND L1FFF MASK CLASS APXQ1461 STO QLIST+3 APXQ1462 SRA 5 APXQ1463 SYNRE BSC L SNTER,Z KIND SHOULD BE 0 APXQ1464 LD G1+1 SET SLASH FLIPPER APXQ1465 STO L SLFLP APXQ1466 BSI RRGST APXQ1467 LD SLISH APXQ1468 FURRY BSC E APXQ1469 MDX SYNRE DON'T ALLOW BACKSLASH APXQ1470 MDX 2 1 CUT EXEC STACK BACK APXQ1471 LD 1 ESCTR-SDECR APXQ1472 A G1&1 APXQ1473 SLA 1 APXQ1474 STO LEWD APXQ1475 LDX L1 LOCOR APXQ1476 RELAC EQU *-1 APXQ1477 BSI L CGCOL GET RESULT POINTER APXQ1478 RTE 16 SAVE IN EXT APXQ1479 BSI L MTGBG MARK RH ARG GARB APXQ1480 A SX APXQ1481 STO QLIST APXQ1482 RTE 16 RESULT PTR BACK TO ACC APXQ1483 STARE STO 2 APXQ1484 A LEWD APXQ1485 STO QLIST+2 APXQ1486 LD ESCTR PREPARE RANK VECTOR APXQ1487 OR L100 FOR RESULT M-HEADER. APXQ1488 SRT 16 APXQ1489 LD LOSET IF LOSET IS 1, RESULT APXQ1490 EOR G1+1 HAS TYPE OF ARGUMENT APXQ1491 BSC Z APXQ1492 LD FURRY HAND CHOSEN FOR ITS FOUR APXQ1493 EOR *-1 APXQ1494 AND RANQ APXQ1495 A FURRY APXQ1496 SLA 11 APXQ1497 AND STARE APXQ1498 A 1 14 APXQ1499 S RELAC APXQ1500 STD I2 APXQ1501 MDX TRANS ENOUGH OF THIS NONS%NSE APXQ1502 L100 DC /100 APXQ1503 L1FFF DC /1FFF APXQ1504 RANQ BSS 1 APXQ1505 *REDU NULL VECTOR< GET IDENTITY APXQ1506 IDEN LDD I3 IDELS-1 APXQ1507 STR STD I QLIST&2 STORE START FOR NEW VECT APXQ1508 TRANS LDD ESCTR APXQ1509 SD ZERWN APXQ1510 BSC L GRP3,Z+ EXIT IF NO MORE ELEMENTS APXQ1511 MDX MORE APXQ1512 SLISH BSS 1 APXQ1513 *REDU BEGIN A NEW VECTOR APXQ1514 SETID MDX L QLIST+2,-2 DECREMENT DEST ADDR APXQ1515 LD QLIST APXQ1516 S SDECR APXQ1517 STO QLIST APXQ1518 LD LOSET APXQ1519 STO ESCTR+1 APXQ1520 BSC L IDEN,& START WITH IDENTITY ONLY APXQ1521 S EL1 APXQ1522 STO ESCTR+1 APXQ1523 LD QLIST APXQ1524 S SDECR&1 APXQ1525 STO QLIST APXQ1526 LDD I QLIST FOR NULL VECTOR APXQ1527 MDX STR APXQ1528 *REDU DO OPERATION APXQ1529 MORE STD ESCTR APXQ1530 SLT 1 APXQ1531 LDX I3 QLIST+3 APXQ1532 BSC E APXQ1533 MDX SETID APXQ1534 LDD I QLIST+2 APXQ1535 STD RTRAG APXQ1536 LDX L1 RTRAG APXQ1537 STX 1 QLIST+1 APXQ1538 LDX L1 QLIST APXQ1539 LD 1 APXQ1540 S SDECR&1 APXQ1541 STO 1 APXQ1542 LD L3 OPTAB APXQ1543 BSI L ENSOV APXQ1544 BSI I ENS01 APXQ1545 MDX TRANS APXQ1546 LDECR BSS 1 APXQ1547 RDECR BSS E 6 APXQ1548 RX EQU RDECR&3 APXQ1549 QLIST EQU RDECR APXQ1550 RTRAG EQU RDECR+4 APXQ1551 LX BSS 1 APXQ1552 DC VAL APXQ1553 SDECR BSS E 6 APXQ1554 LOSET EQU SDECR&2 APXQ1555 SX EQU SDECR&3 APXQ1556 ESCTR EQU SDECR+4 APXQ1557 *SEL GET MOVE NUMBERS FOR RES. GET SET FOR LOOP APXQ1558 LNOK LDX L1 RDECR APXQ1559 BSI SCNST APXQ1560 LD INRHO APXQ1561 M RHOO APXQ1562 SLT 17 APXQ1563 A EL2 APXQ1564 MDX 2 -1 APXQ1565 LNO01 EQU * APXQ1566 BSI L CGCOL APXQ1567 RTE 16 RESULT PTR IN EXT APXQ1568 BSI L MTGBG APXQ1569 A LCTR APXQ1570 A LCTR APXQ1571 A LDECR APXQ1572 STO LX LX PTR APXQ1573 MDX 2 2 APXQ1574 BSI L MTGBG APXQ1575 A SX APXQ1576 STO SX APXQ1577 RTE 16 APXQ1578 STO 2 APXQ1579 STO L 3 XR3 PTS TO RESULT APXQ1580 A RX APXQ1581 STO RX APXQ1582 LD RANQ APXQ1583 AND EL2 APXQ1584 BSC & APXQ1585 LD EL1 APXQ1586 OR RANQ APXQ1587 SLA 12 APXQ1588 BSI L STX2 APXQ1589 A 1 14 APXQ1590 S 1 -2 APXQ1591 STO 3 APXQ1592 LD RHOO APXQ1593 SLA 8 APXQ1594 OR RHOO+1 APXQ1595 STO 3 1 APXQ1596 LDX L3 RDECR APXQ1597 LDX L2 SDECR RDECR ALREADY IN XR3 APXQ1598 LD SLISH XR2,3 AS ARE FOR / APXQ1599 BSC E REVERSED FOR BACKSLASH APXQ1600 MDX 2 RDECR-SDECR SO XR2 POINTS TO APXQ1601 BSC E LARGER MATRIX. APXQ1602 MDX 3 SDECR-RDECR APXQ1603 LDX L1 LX APXQ1604 BSC L NXTEL APXQ1605 BSS E 0 APXQ1606 EL2 DC 2 APXQ1607 ZEROD DC 0 APXQ1608 ZERWN DC 0 APXQ1609 EL1 DC 1 APXQ1610 INRHO BSS E 2 APXQ1611 DC 1 APXQ1612 RHOO BSS 2 APXQ1613 DC 1 APXQ1614 SAFE EQU INRHO APXQ1615 VAL EQU INRHO APXQ1616 SLFLP EQU RHOO APXQ1617 LCTR BSS 1 APXQ1618 *SEL FINISH &/LARG. DO SPECIAL STUFF IF SCALAR APXQ1619 INCW LD W APXQ1620 A VAL KNOWN NON-NEGATIVE APXQ1621 STO W APXQ1622 MDX L SLFLP,-1 APXQ1623 MDX CTLP APXQ1624 NULEF MDX 2 1 SLFLP NOW 0, INDICATING NOT APXQ1625 BSI L RRGST REDUCTION. POINT XR2 TO SLSHAPXQ1626 LD EL2 & GET MOVE NOS FOR RT ARG APXQ1627 STO LDECR APXQ1628 LD 1 SLISH-SDECR XR1 SET TO SDECR BY RRGSTAPXQ1629 BSC L EXPA,E SKIP SECTION IF EXPANSION APXQ1630 LD LCTR APXQ1631 EOR EL1 APXQ1632 BSC L NONSC,Z APXQ1633 LD W SCALAR LEFT ARG APXQ1634 M ESCTR MENTALLY EXTEND IT APXQ1635 STO LDECR SURELY 0 APXQ1636 SLT 16 APXQ1637 STO W APXQ1638 LD ESCTR APXQ1639 MDX NONSC&1 APXQ1640 *SEL NEXT EL IN MAJOR ARRAY. RET IFF NOT NONE APXQ1641 NXMJL DC *-* MOVE TO NEXT ELEM IN MAJOR APXQ1642 LDD 2 4 ARRAY. FIRST DECREMENT 2 WDAPXQ1643 SD ZERWN COUNTER APXQ1644 BSC L GRP3,+Z EXIT SEL ON NEG HI WORD APXQ1645 STD 2 4 SAVE DECREMENTED COUNTER BACAPXQ1646 SLT 1 IS LOW ORDER WD NEG APXQ1647 BSC L SETLO,E IF SO, DONE WITH THIS VECTORAPXQ1648 LD 2 3 OTHERWISE, DECREMENT POINTERAPXQ1649 S 2 1 APXQ1650 STO 2 3 APXQ1651 BSC I NXMJL AND EXI0 FROM NXMJL APXQ1652 W EQU NXMJL SUM/LARG APXQ1653 *SEL PREPARE DIMS FOR EXPANSION. DO COMPATIB COMP APXQ1654 EXPA LD W APXQ1655 RTE 16 APXQ1656 LD LCTR APXQ1657 DODIM STO 3 APXQ1658 RTE 16 APXQ1659 EOR ESCTR APXQ1660 BSC L LGTER,Z APXQ1661 MDX LNOK APXQ1662 **CALCULATE NUMBERS TO MOVE WITH APXQ1663 SCNST DC *-* APXQ1664 LDD INRHO APXQ1665 STO RHOO+1 APXQ1666 RTE 16 APXQ1667 STO RHOO APXQ1668 * BEGINNING WITH AN ODD LOCATION, HAVE APXQ1669 * 0 0 1 RHO2 RHO1 1 RHO1 RHO2 1 APXQ1670 *ZEROD ZERWN INRHO RHOO APXQ1671 * XR3 POINTS AT INRHO OR INRHO&1 APXQ1672 * XR1 PTS AT 6 WORD SPACE FOR ANSWERS. APXQ1673 LD 3 3 RHO1 OR RHO2 APXQ1674 STO 1 2 LOSET APXQ1675 LD 3 4 RHO2 OR 1 APXQ1676 SLA 1 BECAUSE M-ENTRIES ARE DBL WAPXQ1677 STO 1 1 DECR&1 APXQ1678 M 3 1 RHO1 OR 1 APXQ1679 SLT 16 X/RHO OR 1 -- DBLD APXQ1680 EOR L ONES APXQ1681 A G3&1 3 IS 1 & 1 X 2 APXQ1682 STO 1 DECR APXQ1683 LD 3 RHO2 OR RHO1 APXQ1684 STO 1 4 CTR APXQ1685 M 3 -1 1 OR RHO2 APXQ1686 SLT 17 RHO2 OR X/RHO -- DBLD APXQ1687 A EL2 APXQ1688 STO 1 3 SX OR RX APXQ1689 SLT 15 CREATE 0 APXQ1690 STO 1 5 CTR&1 APXQ1691 BSC I SCNST THERE IS NO ERROR RETURN APXQ1692 *SEL LEFT ARG SUMMATION APXQ1693 LGVEC STO W INITALIZE &/LARG APXQ1694 SLT 8 APXQ1695 STO SLFLP SAVE 2 COPIES LHRHO APXQ1696 STO LCTR APXQ1697 BSC L NULEF,&- NULL LEFT ARG..SKIP SUMMATIOAPXQ1698 LDX L1 LX APXQ1699 CTLP MDX L LX,2 FORM &/LARG APXQ1700 BSI L UNFLT APXQ1701 MDX INCW APXQ1702 *SEL FILL A ZERO VECTOR APXQ1703 ZER BSI NXMJL NEXT ELEM IN MAJOR ARRAY APXQ1704 LDD I SX IF THIS IS COMPRESSION, THE APXQ1705 STD SAFE RH ARG IS ABOUT TO BE WIPED APXQ1706 LD 1 RANQ-LX OUT, SO PRESERVE IT. APXQ1707 SLA 14 SHIFT TYPE BIT OUT. APXQ1708 LDD ZEROD ZERO WITHOUT CLEARING CARRY APXQ1709 BSC C SKIP IF NOT CHARACTER APXQ1710 LDD SPACE APXQ1711 G3 STD I2 3 STORE 0 OR SPACE APXQ1712 LDD SAFE RESTORE RH ARG APXQ1713 STD I SX APXQ1714 MDX ZER APXQ1715 *SEL PREPARE DIMS FOR NONSCALAR COMPRESSION APXQ1716 NONSC LD LCTR APXQ1717 SRT 16 APXQ1718 LD W APXQ1719 MDX DODIM APXQ1720 HDNG ** IDENTITIES APXQ1721 * TABLE OF IDENTITY ELEMENT POINTERSAPXQ1722 * AND/OR DEPENDS UPON THE 0 0 1 1 PATTERN AT NUBIL APXQ1723 * RELATIONALS NEED THE 1 0 AT IDELS APXQ1724 * IDELS IS ALSO USED BY REDUCTION AND MATRIX MUL APXQ1725 * IDENTITY OP. NO. OPERATION APXQ1726 IDELS DC IDEN1 1 EXPONENTIATION APXQ1727 DC ZEROD 2 PLUS APXQ1728 DC ZEROD 3 MINUS APXQ1729 DC INFIM 4 MAX APXQ1730 DC SUPRA 5 MIN APXQ1731 DC ZEROD 6 RESIDUE APXQ1732 DC IDEN1 7 TIMES APXQ1733 DC IDEN1 8 DIVIDE APXQ1734 DC IDEN1 9 SHRIEK APXQ1735 DC ZEROD 10 LOG APXQ1736 DC ZEROD 11 QUERY APXQ1737 DC IDEN1 12 AND APXQ1738 NUBIL DC ZEROD 13 OR APXQ1739 DC ZEROD 14 LSS APXQ1740 DC IDEN1 15 LEQ APXQ1741 DC IDEN1 16 EQU APXQ1742 DC IDEN1 17 GEQ APXQ1743 DC ZEROD 18 GTR APXQ1744 DC ZEROD 19 NEQ APXQ1745 IDEN1 DEC 1.0 APXQ1746 INFIM DC /8000 APXQ1747 DC /01FF APXQ1748 SUPRA DEC 1.701411632E38 APXQ1749 BSS E 0 APXQ1750 SPACE DC /0400+ALCBL APXQ1751 DC /0080 APXQ1752 HDNG ** ROTATION AND REVERSAL APXQ1753 * ROTATION AND REVERSAL APXQ1754 * CALLED FROM OPERATOR CONTROL APXQ1755 * RIGHT ARGUMENT IS ARBITRARY APXQ1756 RHOL EQU PIN&6 APXQ1757 TEP1 EQU RDECR APXQ1758 TEP2 EQU RDECR+2 APXQ1759 POSI EQU RDECR+4 APXQ1760 CLASS EQU RDECR&5 APXQ1761 GCD EQU RDECR&1 APXQ1762 LFF DC /FF APXQ1763 LRDEC DC RDECR APXQ1764 DROT BSS 0 APXQ1765 LDD I1 MRARG-PIN APXQ1766 SRA 12 APXQ1767 LDX L1 SDECR APXQ1768 STO 1 RANQ-SDECR SAVE RANK&TYPE FOR MASTER APXQ1769 SLA 8 TO CLEAR ACC APXQ1770 RTE 8 APXQ1771 SRA 8 RHO2 IN ACC, RHO1 IN EXT APXQ1772 STD 1 INRHO-SDECR APXQ1773 LD L PIN+1 OPERATOR NUMBER APXQ1774 STO 1 SLISH-SDECR APXQ1775 AND 1 RANQ-SDECR REMOVE DIARESIS FOR VECT APXQ1776 SRA 1 APXQ1777 EOR 1 EL1-SDECR APXQ1778 STO L 3 CODE 0 OR 1 ON OP, RANK, DIAAPXQ1779 MDX L3 INRHO APXQ1780 BSI 1 SCNST-SDECR APXQ1781 LDX L3 PIN APXQ1782 LD 1 SX-SDECR APXQ1783 A 3 MRARG-PIN APXQ1784 STO RHPTR&1 PTS TO FIRST ELEM OF APXQ1785 LD 1 SX-SDECR VIRTUAL VECTOR APXQ1786 A 3 MRSLT-PIN APXQ1787 STO RSPTR&1 SIMILIAR APXQ1788 LD 3 PIN-PIN SKIP DOWN ON REVERSAL APXQ1789 BSC L LNMCH,&- I SUPPOSE APXQ1790 LD 3 RHOL-PIN APXQ1791 S 1 L100-SDECR ISOLATE LENGTH LEFT ARG APXQ1792 STO 3 RHOL-PIN APXQ1793 S 1 ESCTR-SDECR COMPR VS RELEV RGT ARG DIMAPXQ1794 BSC L LNMCH,&- IF NO MATCH, PERHAPS LEFT APXQ1795 LD 3 RHOL-PIN ARG IS SCALAR APXQ1796 EOR 1 EL1-SDECR APXQ1797 BSC L LGTER,Z WELL IT WASN'T APXQ1798 LNMCH LDX L1 LX SET UP XR1 FOR UNFLT APXQ1799 LD LRDEC APXQ1800 STO 1 POINT LX TO SPECIAL TEMP APXQ1801 NXVX LD 1 ESCTR-LX GET NEXT VECTOR APXQ1802 S 1 EL1-LX APXQ1803 BSC L GRP3,+Z LIKE WE'RE OUT APXQ1804 STO 1 ESCTR-LX APXQ1805 LD RHPTR&1 APXQ1806 S 1 SDECR-LX APXQ1807 STO 3 MRARG-PIN PTS TO LAST ELEM OF CURRENT APXQ1808 LD RSPTR&1 VECTOR APXQ1809 S 1 SDECR-LX APXQ1810 STO 3 MRSLT-PIN SIMILIAR APXQ1811 LD 3 PIN-PIN PATHS DIVERGE FOR TWO APXQ1812 BSC L REV,& OPERATORS APXQ1813 LD 3 RHOL-PIN ROTATION. GET LEFT ARG APXQ1814 BSC Z APXQ1815 S 1 EL1-LX APXQ1816 STO 3 RHOL-PIN APXQ1817 A 1 EL1-LX APXQ1818 SLA 1 APXQ1819 A 3 MLARG-PIN APXQ1820 STO *&1 APXQ1821 GTLFT LDD L *-* GET LEFT ARG APXQ1822 STD 1 RDECR-LX APXQ1823 LD LFF FLOATING POINT FORMAT APXQ1824 SRT 16 HAS THE PECULIARITY THAT THEAPXQ1825 SD 1 RDECR-LX EXPONENT IS TRUE. THIS APXQ1826 RTE 16 COMPLICATES THE ANYWAY ANNOYAPXQ1827 EOR LFF ING PROBLEM OF GETTING ITS APXQ1828 RTE 16 NEGATIVE. APXQ1829 BSC - APXQ1830 STD 1 RDECR-LX CHOOSE WHICHEVER IS POSITIVEAPXQ1831 BSI L UNFLT WHICH FIX APXQ1832 MDX ISINT APXQ1833 CYCL DC *-* SAVE RHARG OF POS IN APXQ1834 LD 1 POSI-LX TEP1, STORE TEP2 IN APXQ1835 S 1 LOSET-LX RES OF POSI, MOVE TEP1 APXQ1836 M 1 SDECR+1-LX TO TEP2. APXQ1837 RTE 16 APXQ1838 A 3 MRARG-PIN APXQ1839 STO RHPTR&1 APXQ1840 S 3 MRARG-PIN APXQ1841 A 3 MRSLT-PIN APXQ1842 STO RSPTR&1 APXQ1843 RHPTR LDD L *-* APXQ1844 STD 1 TEP1-LX APXQ1845 LDD 1 TEP2-LX APXQ1846 RSPTR STD L *-* APXQ1847 LDD 1 TEP1-LX APXQ1848 STD 1 TEP2-LX APXQ1849 BSC I CYCL APXQ1850 ISINT LD I GTLFT&1 IF LEFT ARG WAS NEGATIVE, APXQ1851 BSC L PSLF,- VAL MUST BE NEGATED APXQ1852 SRA 16 APXQ1853 S 1 VAL-LX APXQ1854 STO 1 VAL-LX IT REMAINS TO REDUCE VAL MODAPXQ1855 PSLF LDX L3 PIN LOSET APXQ1856 LD 1 VAL-LX APXQ1857 SRT 16 APXQ1858 LDS APXQ1859 D 1 LOSET-LX APXQ1860 BSC L GRP3,O EXIT ON ACCOUNT OF NULL ROWSAPXQ1861 SLT 16 APXQ1862 BSC & APXQ1863 A 1 LOSET-LX APXQ1864 STO 1 VAL-LX VAL NOW STRICTLY POSITIVE APXQ1865 STO 1 GCD-LX AND LEQ LOSET APXQ1866 LD 1 LOSET-LX APXQ1867 SHIF SRT 16 COMPUTE GCD OF VAL AND LOSETAPXQ1868 D 1 GCD-LX THE MANUAL LIES. EXT IS APXQ1869 LD 1 GCD-LX UNAFFECTED ON DIVIDE BY 0. APXQ1870 STD 1 GCD-1-LX APXQ1871 BSC O TYPICAL 1130 BRANCH SEQUENCEAPXQ1872 MDX *&1 APXQ1873 MDX SHIF APXQ1874 SCALF LD 1 GCD-LX GCD IS NO OF CLASSES APXQ1875 NEWCL S 1 EL1-LX MERGE WITH REVERSAL. APXQ1876 STO 1 CLASS-LX NEXT CLASS APXQ1877 BSC L NXVX,&Z NO MORE. THRU WITH VECTOR APXQ1878 STO 1 POSI-LX POSI MEANS WHERE WE'RE AT. APXQ1879 BSI CYCL APXQ1880 LD 3 PIN-PIN APXQ1881 BSC L ROTO,Z APXQ1882 LD 1 VAL-LX IF REVERSAL, BEGIN EACH APXQ1883 A 1 EL2-LX CLASS BY SHIFTING RIGHT AND APXQ1884 STO 1 VAL-LX INCREMENTING VAL BY 2. APXQ1885 A 1 POSI-LX APXQ1886 STO 1 POSI-LX APXQ1887 BSI CYCL APXQ1888 ROTO LD 1 POSI-LX SHIFT LEFT BY VAL. APXQ1889 S 1 VAL-LX APXQ1890 BSC &Z KEEP POS NONNEG APXQ1891 A 1 LOSET-LX APXQ1892 STO 1 POSI-LX ARE WE BACK TO STRTING POINTAPXQ1893 S 1 CLASS-LX APXQ1894 BSC L *&2,&- APXQ1895 BSI CYCL NO. DO TRANSFER AND APXQ1896 MDX ROTO BRANCH BACK APXQ1897 BSI CYCL YES. DO ONE LAST TRANSFER APXQ1898 BOTH LD 1 CLASS-LX AND BRANCH BACK TO APXQ1899 MDX NEWCL GET NEW CLASS APXQ1900 REV LD 1 LOSET-LX REVERSAL. NO CLASSES IS APXQ1901 SRT 1 FLOOR .5 X LOSET APXQ1902 STO 1 CLASS-LX APXQ1903 STO 1 POSI-LX IN CASE LOSET IS ODD APXQ1904 SLT 16 COMPUTE VAL AS -1 OR 0 APXQ1905 EOR *-1 ACCORDING AS LOSET IS APXQ1906 SRT 15 EVEN OR ODD APXQ1907 STO 1 VAL-LX APXQ1908 BSI CYCL NECESSARY IF LOSET IS ODD APXQ1909 STD I RSPTR+1 APXQ1910 MDX BOTH APXQ1911 UREV EQU DROT APXQ1912 HDNG MATRIX PRODUCT EXECUTION APXQ1913 * MATR MATRIX PRODUCT EXECUTION APXQ1914 * THIS ROUTINE PERFORMS R=LARG LOP.ROP RARG APXQ1915 * IT PERFORMS ALL THE NECESSARY OPERATOR APXQ1916 * CONTROL TO DETERMINE WHETHER THE OPERATORS APXQ1917 * ARE VALID, WHETHER THE OPERANDS ARE APXQ1918 * COMPATIBLE, ETC. IT MARKS THE OPERAND APXQ1919 * LOCATIONS IN M AS GARBAGE IF NECESSARY APXQ1920 * AND PERFORMS THE GETSPACE FOR THE RESULT. APXQ1921 * IT PERFORMS THE NECESSARY INITIALIZATION APXQ1922 * FOR BOTH THE CASE OF OUTER PRODUCT AND APXQ1923 * INNER PRODUCT AND THEN ENTERS ONE MAIN APXQ1924 * LOOP WHICH HANDLES BOTH CASES. APXQ1925 * REGISTERS ON ENTRY APXQ1926 * R2 = SVI (1130 ADDRESS) APXQ1927 * THE STACK LOOKS AS FOLLOWS UPON ENTRY APXQ1928 * LARG APXQ1929 * LOP APXQ1930 * ROP APXQ1931 * R2 POINTS HERE RARG APXQ1932 * REGISTERS ON EXIT APXQ1933 * R1,2,3 DESTROYED APXQ1934 * NOTE THAT THE MPTR OF THE RESULT IS ON THE APXQ1935 * TOP OF THE STACK. APXQ1936 * APXQ1937 RELC DC LOCOR APXQ1938 TMPCS EQU RELC APXQ1939 MATR LDX L1 L4 JUST FOR CONVENIENCE APXQ1940 LDD 1 MK1-L4 APXQ1941 STD 1 ASTEP-L4 APXQ1942 STD 1 BPR-L4 APXQ1943 STD 1 LB-L4 APXQ1944 STO 1 APL-L4 APXQ1945 LD 2 1 OP1 APXQ1946 EOR NLLL SEE IF NULL APXQ1947 BSC Z SKIP ON ZERO APXQ1948 SLT 16 A DISGUISED LD K1 APXQ1949 EOR MK1 LEAVES 1 IF NULL ELSE 0 APXQ1950 STO 1 OPROD-L4 SAVE AS FLAG APXQ1951 LDX 1 2 COUNT FOR TWO PASSES APXQ1952 STX L2 3 R3 IS RUNNING INDEX IN STACKAPXQ1953 K03 EQU *-1 APXQ1954 M4 LD 3 0 PICK UP RIGHT (LEFT) ARG APXQ1955 BSC L M1,& TEST IF INDIRECT APXQ1956 EOR TMPCS APXQ1957 SRT 12 IF NOT, INSPECT CLASS APXQ1958 BSC L SNTER,Z SYNTAX ERROR IF NOT OPND APXQ1959 * E.G. THE CASE A+.*.+B APXQ1960 SLT 12 RELOAD ARG APXQ1961 M2 OR RELC APXQ1962 STO *+1 APXQ1963 LDD L *-* APXQ1964 SRA 12 APXQ1965 AND K03 GET THE TWO BITS APXQ1966 STO L1 RRB-1 APXQ1967 MDX 3 3 PICK UP RARG ON 2ND PASS APXQ1968 SRA 2 BLANK ACC APXQ1969 SLT 8 COLLECT LAST-1 COMPONENT APXQ1970 STO L1 B2-1 OF RANK VECTOR APXQ1971 SRA 8 APXQ1972 SLT 8 COLLECT LAST COMPONENT APXQ1973 STO L1 B3-1 APXQ1974 MDX 1 -1 COUNT AND TEST APXQ1975 MDX M4 APXQ1976 LDX L1 L4 JUST FOR CONVENIENCE APXQ1977 LD 1 OPROD-L4 APXQ1978 BSC L LGTH,Z APXQ1979 LD 1 RRA-L4 IS A SCALAR APXQ1980 BSC L ANSCL,Z APXQ1981 STO 1 ASTEP-L4 YES. SET ASTEP TO 0 APXQ1982 MDX BTEST APXQ1983 ANSCL LD 1 A3-L4 APXQ1984 STO 1 DIM-L4 APXQ1985 BTEST LD 1 RRB-L4 APXQ1986 BSC L BNSCL,Z APXQ1987 STO 1 BSTEP-L4 APXQ1988 MDX LGTH APXQ1989 BNSCL LD 1 B3-L4 APXQ1990 MDX L RRB,-1 TEST IF RRB IS 1 APXQ1991 LD 1 B2-L4 IF TWO THEN B2 IS FIRST DIM APXQ1992 MDX L RRB,1 RESTORE RRB APXQ1993 STO T APXQ1994 EOR 1 DIM-L4 APXQ1995 BSC L MN7,+- APXQ1996 LD 1 ASTEP-L4 APXQ1997 BSC L LGTER,Z A SCALAR MATCHES ANYTHING APXQ1998 MN7 LD T APXQ1999 STO 1 DIM-L4 APXQ2000 LGTH LD 1 RRA-L4 APXQ2001 A 1 RRB-L4 APXQ2002 A 1 OPROD-L4 APXQ2003 A 1 OPROD-L4 APXQ2004 S 1 ASTEP-L4 APXQ2005 S 1 BSTEP-L4 APXQ2006 STO 1 RRR-L4 APXQ2007 S K03 APXQ2008 BSC L RANK,- RANK ERROR IF RHO RHO RESLT APXQ2009 * GTR 2 APXQ2010 LD 1 MA2-L4 APXQ2011 MDX L OPROD,0 TEST OPROD APXQ2012 LD 1 A3-L4 APXQ2013 STO 1 APL-L4 APL WILL BE PRODUCT APXQ2014 * OF ALL BUT LAST DIM OF A APXQ2015 LD 1 RRA-L4 APXQ2016 A 1 OPROD-L4 APXQ2017 S K03 APXQ2018 BSC L NXXT,Z APXQ2019 LD 1 A3-L4 APXQ2020 MDX L OPROD,0 APXQ2021 LD 1 MA2-L4 APXQ2022 M 1 APL-L4 APXQ2023 SLT 16 APXQ2024 STO 1 APL-L4 APXQ2025 NXXT LD 1 DIM-L4 APLO4490 APXQ2026 M 1 APL-L4 APXQ2027 SLT 16 APXQ2028 MDX L ASTEP,0 APXQ2029 STO 1 LA-L4 APXQ2030 N1 LD 1 RRB-L4 APXQ2031 A 1 OPROD-L4 APXQ2032 SLA 14 APXQ2033 BSC L NLLL,- APXQ2034 SLA 2 APXQ2035 LDD 1 B3-L4 ASSUMES ODD ALIGNMENT FOR B3APXQ2036 BSC C APXQ2037 M 1 B2-L4 APXQ2038 SLT 16 APXQ2039 STO 1 BPR-L4 APXQ2040 NLLL LDS 33 OVERFLOW IS USED AS LOOP COUNT APXQ2041 * AND LDS 1 USED AS SYMBOL APXQ2042 * TABLE ENTRY FOR NULL (UC J) APXQ2043 M8 LD 3 -4 PICK UP RIGHT (LEFT) OPERATOAPXQ2044 EOR NULLO NULL BST ENTRY W/O OP NO. APXQ2045 SRT 5 OP NO. IN EXT, 1 IN ACC APXQ2046 BSC +- UNLESS OP IS NULL, SO ACC=0 APXQ2047 BSC O ALLOWED ONLY FOR LEFT OP APXQ2048 * YOU MIGHT THINK THAT IOTA (WHICH HAS SYMBOL TABLE APXQ2049 * ENTRY /2020 ) WILL SLIP THROUGH THIS TEST. NOT APXQ2050 * SO. IT WILL APPEAR TO HAVE OPERATOR NUMBER 0, ANDAPXQ2051 * WILL BE CAUGHT IN THE TILDE TRAP AT EXECUTION. APXQ2052 EOR MK1 ENSURE OP KIND = 0 APXQ2053 BSC L SNTER,Z APXQ2054 SLT 5 PICK UP CLEAN OP NUMBER APXQ2055 NOP FORCE APXQ2056 ORG *-1 EVEN APXQ2057 BSS E 0 ALIGNMENT APXQ2058 M21 STO L 1 SAVE IN XR1 APXQ2059 MK1 EQU M21+1 MUST BE ALIGNED ODD APXQ2060 MDX M7 APXQ2061 M1 EOR ALL1 APXQ2062 OR MRELC APXQ2063 STO T FROM INDIRECT SYMBOL TABLE APXQ2064 LD L *-* PTR GET M-POINTER APXQ2065 T EQU *-1 A TEMP TWICE OVER APXQ2066 MDX M2 APXQ2067 ALL1 DC /FFFF APXQ2068 OPROD DC APXQ2069 MK EQU OPROD APXQ2070 OP1AD DC APXQ2071 OP2AD DC APXQ2072 NULLO DC /2020 NULL OR IOTA BST ENTRY APXQ2073 M30 STX L1 MPL1+3 PUT RIGHT OP IN PLISTS APXQ2074 STX L1 MPL2+3 APXQ2075 BSI L ENSOV ENSURE CORRECT APXQ2076 STO OP2AD SAVE OP-EXECN BRANCH ADDR APXQ2077 MDX M8 APXQ2078 M7 LD L1 OPTAB PICK UP ADD OF OP ROUTINE APXQ2079 MDX 3 -1 BUMP TO OTHER OP (NVER SKIP)APXQ2080 BSC L M30,O BACK UP FOR LEFT OP OR QUIT APXQ2081 BSI L ENSOV ENSURE CORRECT APXQ2082 STO OP1AD APXQ2083 STX L1 MPL3+3 APXQ2084 LD BPR APXQ2085 M DIM APXQ2086 SLT 16 APXQ2087 MDX L BSTEP,0 APXQ2088 STO LB APXQ2089 LDD I1 IDELS-1 PICK UP IDENTITY ELEMENT APXQ2090 STD MTEMP APXQ2091 LD BPR APXQ2092 M APL APXQ2093 SLT 16 APXQ2094 STO L NO. OF ELEMENTS IN RESULT APXQ2095 A MK1 APXQ2096 SLA 1 COMPUTE NUMBER OF WORDS APXQ2097 LDX L1 LOCOR APXQ2098 MRELC EQU *-1 APXQ2099 OPDCL EQU *-1 APXQ2100 BSI L CGCOL GETSPACE FOR RESULT APXQ2101 RTE 16 SAVE LC-RELATIVE M-PTR RESLTAPXQ2102 BSI L MTGBG MARK LH ARG GARBAGE APXQ2103 STO MPTL APXQ2104 NBOF3 MDX 2 3 POINT TO RH ARG ON STACK APXQ2105 BSI L MTGBG MARK IT GARBAGE APXQ2106 STO MPTRX APXQ2107 BSI L STX2 SYNCHRONIZE LC'S SVI APXQ2108 LD 1 14 GET SVI TO BE ATTACHED APXQ2109 SLA 4 TO RESULT M-HEADER APXQ2110 RTE 16 TAKE M-PTR FOR RESULT, APXQ2111 OR OPDCL GIVE IT OPERAND CLASS, APXQ2112 STO 2 0 AND PUT IT ON THE STACK. APXQ2113 * EOR OPDCL REMOVE ASTERISKS IF EVER APXQ2114 * OPERAND CLASS ISN'T THE SAME AS LOCOR APXQ2115 * OR 1 -2 MAKE AN 1130 RELATIVE M-PTR APXQ2116 LDX 1 0 AND KEEP IT IN XR3 APXQ2117 STO 1 3 MORE OR LESS PERMANENTLY APXQ2118 LD RRR RANK APXQ2119 SLT 12 APPEND STACK POINTER APXQ2120 STO 3 0 AND SAVE AS M-HEADER. APXQ2121 M11 LD RRA APXQ2122 SLA 1 APXQ2123 OR OPROD GENERATE POSITION IN TABL APXQ2124 A ADTB GET LOCATION IN CORE APXQ2125 STO M12&1 SAVE A LITTLE FURTHER ON APXQ2126 LD RRB APXQ2127 SLA 2 THIS GIVES US A SHIFT COUNT APXQ2128 STO 1 2 SAVE IN XR2 APXQ2129 M12 LD L *-* PICK UP TABLE ENTRY APXQ2130 SRA 2 SHIFT TO OBTAIN DESIRED APXQ2131 * INFO IN LAST 4 BITS OF ACC APXQ2132 SRT 2 TABLE CODE APXQ2133 AND NBOF3 DON'T NEED FULLWORD MASK APXQ2134 STO 1 2 B2=00 APXQ2135 SRA 2 A2=01 APXQ2136 SLT 2 B3=10 APXQ2137 STO 1 1 A3=11 APXQ2138 LD L2 B2 APXQ2139 SLA 8 APXQ2140 OR L1 B2 APXQ2141 STO 3 1 SAVE AS RANK VECTOR APXQ2142 MDX L MPTRX,2 POINT TO FIRST DATA ITEM APXQ2143 MDX L MPTL,2 HERE TOO APXQ2144 MDX 3 2 AND RESULT POINTER APXQ2145 STX 3 RSLT SAVE SINCE XR3 DESTROYED APXQ2146 * IN THE MAIN LOOP. APXQ2147 L4 LD LA APXQ2148 S MK1 APXQ2149 STO I APXQ2150 * APXQ2151 * FINALLY, THE MATRIX PRODUCT LOOP APXQ2152 * APXQ2153 LOOP1 LD LB APXQ2154 S MK1 APXQ2155 STO MJ POINT J TO END OF B APXQ2156 LOOP2 LD L APXQ2157 S MK1 APXQ2158 STO L POINT L TO END OF RESULT APXQ2159 BSC L GRP3,+Z DONE WHEN L NEGATIVE APXQ2160 LD DIM APXQ2161 STO MK SET K AS COUNTER APXQ2162 LD MJ APXQ2163 BSC L MSTOR,+Z APXQ2164 SLA 1 NO. COMPUTE ADDRESS APXQ2165 A MPTRX OF NEXT ELEMENT IN B APXQ2166 STO MPL1+1 AND SAVE FOR NEXT OPERATION APXQ2167 LD I APXQ2168 SLA 1 USE I TO COMPUTE ADDRESS IN APXQ2169 A MPTL A APXQ2170 STO MPL1 SAVE FOR OPERATION APXQ2171 LDX L1 MPL1 POINT XR1 AT PLIST APXQ2172 BSI I OP2AD PERFORM OP2 APXQ2173 LOOP3 LD I APXQ2174 S ASTEP DECREMENT I BY ASTEP APXQ2175 STO I APXQ2176 SLA 1 AND COMPUTE ADDRESS APXQ2177 A MPTL APXQ2178 STO MPL2 SAVE IN PLIST APXQ2179 LD MJ PREFETCH J APXQ2180 MDX L BSTEP,0 TEST BSTEP APXQ2181 MDX MN5 COUNT IN J IF NON ZERO APXQ2182 MDX L MK,-1 ELSE, COIUNT IN K APXQ2183 MDX MN6 IF MORE GO DO THEM APXQ2184 MDX MSTOR ELSE STORE RESULT APXQ2185 BSS E 0 ALIGN THE FOLLOWING FOR STD APXQ2186 BPR DC APXQ2187 DIM DC APXQ2188 MTEMP BSS E 2 APXQ2189 LB DC APXQ2190 LA DC APXQ2191 APL DC APXQ2192 BSS E 0 APXQ2193 ASTEP DC APXQ2194 BSTEP DC APXQ2195 RRB DC APXQ2196 RRA DC APXQ2197 ADTB DC MTABL APXQ2198 MPTRX DC 0 APXQ2199 MPTL DC APXQ2200 RRR DC APXQ2201 MN5 S BPR STEP J ALONG A COLUMN APXQ2202 STO MJ APXQ2203 BSC L MSTOR,+Z STORE IN RESULT IF DONE APXQ2204 MN6 SLA 1 COMPUTE ADDRESS APXQ2205 A MPTRX IN B APXQ2206 STO MPL2+1 SAVE IN PLIST APXQ2207 LDX L1 MPL2 POINT XR1 TO PLIST APXQ2208 BSI I OP2AD EXECUTE OP2 APXQ2209 LDX L1 MPL3 POINT XR3 TO PLIST APXQ2210 BSI I OP1AD EXECUTE OP1 REDUCTION APXQ2211 MDX LOOPR APXQ2212 MSTOR LD L APXQ2213 SLA 1 COMPUTE ADDRESS APXQ2214 A RSLT IN RESULT APXQ2215 STO ARSLT+1 APXQ2216 LDD MTEMP APXQ2217 ARSLT STD L *-* APXQ2218 LD BSTEP APXQ2219 BSC L LOOP1,&- TO LOOP1 IF SCALAR APXQ2220 LD MJ APXQ2221 A BPR SEE HOW FAR DOWN WE ARE APXQ2222 BSC L LOOP1,& APXQ2223 LD MJ APXQ2224 A LB APXQ2225 S BSTEP OTHERWISE COMPUTE NEXT J APXQ2226 STO MJ APXQ2227 LD ASTEP APXQ2228 BSC L LOOP2,&- TO LOOP2 IF A SCALR APXQ2229 LD I APXQ2230 A DIM ELSE STEP I UP APXQ2231 STO I APXQ2232 MDX LOOP2 AND THEN GO BACK APXQ2233 LOOPR LDD TEMP2 APXQ2234 STD MTEMP APXQ2235 MDX LOOP3 APXQ2236 ORG *-1 FORCE ODD APXQ2237 BSS E 1 ALIGNMENT APXQ2238 B2 DC APXQ2239 MA2 DC THOUGHT OF AS A2 APXQ2240 B3 DC APXQ2241 A3 DC APXQ2242 DC UTEMP APXQ2243 DC APXQ2244 MPL3 DC UTEMP APXQ2245 DC MTEMP APXQ2246 DC TEMP2 APXQ2247 DC APXQ2248 MPL2 EQU B3 APXQ2249 TEMP2 EQU RRB APXQ2250 MJ EQU RRR APXQ2251 I EQU LA APXQ2252 MPL1 DC APXQ2253 DC APXQ2254 DC MTEMP APXQ2255 DC APXQ2256 L EQU APL APXQ2257 RSLT EQU M12&1 APXQ2258 * TABLE OF RANK LOCATIONS APXQ2259 * RRA=0 APXQ2260 * RRB APXQ2261 * OPROD 2 1 0 APXQ2262 MTABL DC /0655 0 A2 B3 A2 A2 A2 A2 APXQ2263 DC /0223 1 B2 B3 B2 B3 B2 A3 APXQ2264 * RRA=1 APXQ2265 DC /0655 0 A2 B3 A2 A2 A2 A2 APXQ2266 DC /06E7 1 (A2 B3) A3 B3 A2 A3 APXQ2267 * RRA=2 APXQ2268 DC /0611 0 A2 B3 B2 A2 B2 A2 APXQ2269 DC /0677 1 (A2 B3) (A2 A3) A2 A3 APXQ2270 LNGTH EQU *-ASMXQ APXQ2271 HDNG WRITE ASSEMBLY TO DISK APXQ2272 START LDX L1 ASMXQ-2 APXQ2273 BSI DSKIO APXQ2274 EXIT APXQ2275 DSKIO DC 0 APXQ2276 STX 1 DSKI1 APXQ2277 STX 1 DSKI3 APXQ2278 LIBF DISK1 APXQ2279 DC /3000 APXQ2280 DSKI1 DC 0 APXQ2281 DC DSKI4 APXQ2282 DSKI2 LIBF DISK1 APXQ2283 DC /0000 APXQ2284 DSKI3 DC 0 APXQ2285 MDX DSKI2 APXQ2286 BSC I DSKIO APXQ2287 DSKI4 WAIT APXQ2288 BSC I DSKIO APXQ2289 END START APXQ2290 // XEQ L 1 APXQ2291 // XEQ DMP00001 // ASM DMP00002 *LIST DMP00003 HDNG ** DISK DUMP UTILITY TO CARDS ** DMP00004 ABS DMP00005 ORG /800 DMP00006 * HALT AT TEST+5 INDICATES THAT READER IS NOT DMP00007 * READY OR THAT 1131 SHOULD BE STARTED. DMP00008 * HALT AT ERROR INDICATES THAT FIRST CARD OUT OF DMP00009 * THE HOPPER ON -NPRO- IS IN ERROR AND SHOULD BE DMP00010 * REMOVED. IT WILL BE REPUNCHED WHEN MACHINE IS DMP00011 * STARTED AT READER AND 1131. DMP00012 * WAIT AT DKRD+3 INDICATES PERMANENT DISK ERROR DMP00013 DEFRD DC DFECT IOCC TO GET DEFECTIVE DMP00014 DC /2600 CYLINDER INFORMATION DMP00015 HOME DC /CB DMP00016 DC /2404 ARM BACK IOCC DMP00017 ILS0 DC LEVL0 DMP00018 RESET DC /1703 RESET ALL CARD INDICATORS DMP00019 DC LEVL2 DMP00020 SENSE DC /1700 SENSE CRD DEVICE--NO RESET DMP00021 DC LEVL4 DMP00022 SENS4 DC /1702 RESET AND TEST LEVEL 4 DSW DMP00023 PUNCH DC 0 DMP00024 DC /1100 COLUMN PUNCH DMP00025 READ DC 0 DMP00026 DC /1200 COLUMN READ DMP00027 OPFLG DC 0 DMP00028 SENS0 DC /1701 RESET LEVEL 0 AND GET DSW DMP00029 TEMP4 DC 0 DMP00030 RCTRL DC /1404 START READ DMP00031 TEMP0 DC 0 DMP00032 SLEV4 DC /300 DMP00033 LEVL4 DC *-* OPERATION COMPLETE INTERRUPTDMP00034 STO TEMP4 SAVE ACC DMP00035 STS RSTL4 DMP00036 XIO SLEV4-1 DMP00037 SLA 2 DMP00038 BSC L I2501,- DMP00039 XIO SENS4-1 CHECK AND RESET LEVEL 4 DMP00040 MDX RSLV4 DMP00041 I2501 SLA 1 DMP00042 BOSC I LEVL4,- DMP00043 XIO T2501-1 DMP00044 RSLV4 STO OPFLG DMP00045 LD TEMP4 RESTORE ACC DMP00046 RSTL4 LDS DMP00047 BOSC I LEVL4 EXIT AND CLEAR LEVEL 4 DMP00048 LEVL0 DC *-* COLUMN INTERRUPT ROUTINE DMP00049 STO TEMP0 SAVE ACC DMP00050 STX 3 READ SET I/O ADDRESSES DMP00051 STX 3 PUNCH DMP00052 XIO SENS0-1 TEST RESPONSE FOR READ DMP00053 SLA 1 OR PUNCH AND RESET INDCTRS DMP00054 BSC &Z DMP00055 XIO PUNCH IT WAS PUNCH DMP00056 BSC C DMP00057 XIO READ IT WAS READ DMP00058 MDX 3 1 UP I/O ADDRESS DMP00059 LD TEMP0 RESTORE ACC DMP00060 BOSC I LEVL0 EXIT AND CLEAR LEVEL 0 DMP00061 BUSY DC 3 BUSY/NOT-READY MASK DMP00062 DKADR DC 0 DMP00063 LIMIT DC 0 DMP00064 NEWDK DC 0 DMP00065 SEQ DC 0 CARD SEQUENCE NUMBER DMP00066 START LDX 1 6 SET INTERRUPT LEVELS DMP00067 ILOOP LD L1 ILS0-2 DMP00068 STO 1 6 DMP00069 MDX 1 -2 DMP00070 MDX ILOOP DMP00071 BSI L DTEST DMP00072 XIO HOME SET DISK ACCESS ARM TO 0 DMP00073 BSI L DTEST DMP00074 XIO DEFRD DMP00075 SLT 32 INITIALIZE LAST 16 WORDS OF DMP00076 LDX 2 16 DISK AREA TO ZERO DMP00077 DINIT STD L2 DAREA+318 DMP00078 MDX 2 -2 DMP00079 MDX DINIT DMP00080 NOTST XIO T2501-1 DMP00081 AND BUSY AND RESET INDICATORS DMP00082 BSC L NOTST,Z DMP00083 XIO R2501 DMP00084 RETST XIO S2501-1 DMP00085 AND BUSY DMP00086 BSC L BRKOT,+- DMP00087 WAIT DMP00088 MDX RETST DMP00089 BSS E 1 DMP00090 T2501 DC /4F01 DMP00091 R2501 DC CARD-1 DMP00092 DC /4E00 DMP00093 DC 0 DMP00094 S2501 DC /4F00 DMP00095 BRKOT LDX L3 CARD+80 DMP00096 * INITIALIZATION CARD HAS 3 COLS ID, DMP00097 * 3 COLS STARTING SECTOR ADDR, BCD OF DMP00098 * HEX REPRESENTATION, 3 COLS NUMBER OF DMP00099 * SECTORS, 3 COLS DESIGNATING STARTING DMP00100 * SECTOR WHERE DATA WILL BE STORED. DMP00101 STO SEQ INITIALIZE SEQUENCE COUNT DMP00102 LDD 3 -80 PUT ID IN COLUMNS 73-75 DMP00103 STD 3 -8 DMP00104 LD 3 -78 DMP00105 STO 3 -6 DMP00106 LDX 2 3 INITIALIZE -FROM- DISK ADDR,DMP00107 GTFLD LDX 1 3 DMP00108 SLT 16 LIMIT, AND -TO- DISK ADDR DMP00109 STX 2 TEST SEARCH FOR BCD REP OF HEX DMP00110 GTBCD LDX 2 16 DMP00111 SLOOP LD 3 -69 DMP00112 EOR L2 BCDTB-1 DMP00113 BSC L HIT,&- DMP00114 MDX 2 -1 DMP00115 MDX SLOOP DMP00116 WAIT NONE FOUND--PUNCH ERROR DMP00117 MDX NOTST RESTART DMP00118 HIT MDX 2 -1 DMP00119 NOP DMP00120 LD L 2 ONE FOUND, INDEX IS DMP00121 SRT 4 HEX CHARACTER DMP00122 MDX 3 -1 DMP00123 MDX 1 -1 DMP00124 MDX GTBCD DMP00125 SLT 12 DMP00126 LDX I2 TEST DMP00127 STO L2 DKADR-1 DMP00128 MDX 2 -1 DMP00129 MDX GTFLD DMP00130 MDX 3 9 DMP00131 LD DKADR INITIALIZE DISK ADDRESSES DMP00132 STO L DDADR DMP00133 BSI TEST DMP00134 XIO L RCTL-1 STACKER SELECT CARD AND DMP00135 BSI TEST FEED BLANK DMP00136 MDX RDDSK DMP00137 TEST DC *-* TEST DEVICE BUSY DMP00138 XIO L SENSE-1 DMP00139 AND BUSY DMP00140 BSC I TEST,&- DMP00141 WAIT DMP00142 MDX TEST&1 DMP00143 TEMP DC 0 DMP00144 MDX L NEWDK,1 DMP00145 RDDSK MDX DSKIO DMP00146 STO INDEX RESET RECORD INDEX DMP00147 DKTCD LDX 2 16 PROCESS 48 DISK WORDS DMP00148 MDX 3 -80 IN 64 COLUMNS DMP00149 SRA 16 DMP00150 STO TEST INITIALIZE -NULL- FLAG 0 DMP00151 CDLUP LD 1 0 PACK 3 DISK WORDS IN 4 DMP00152 BSC Z CARD COLUMNS DMP00153 STO TEST DMP00154 RTE 4 DMP00155 SLA 4 DMP00156 STO 3 0 DMP00157 RTE 12 DMP00158 LD 1 1 DMP00159 BSC Z DMP00160 STO TEST DMP00161 RTE 8 DMP00162 SLA 4 DMP00163 STO 3 1 DMP00164 SLA 4 DMP00165 RTE 8 DMP00166 LD 1 2 DMP00167 BSC Z DMP00168 STO TEST DMP00169 RTE 12 DMP00170 SLA 4 DMP00171 STO 3 2 DMP00172 SLT 16 DMP00173 STO 3 3 DMP00174 MDX 3 4 DMP00175 MDX 1 3 DMP00176 MDX 2 -1 DMP00177 MDX CDLUP DMP00178 MDX 3 16 DMP00179 LD TEST NO NEED TO PUNCH CARD IF DMP00180 BSC L SKPCH,&- NULL DATA DMP00181 LD L NEWDK DMP00182 SLA 4 ADDRESS IN COLUMNS 65,66 DMP00183 STO 3 -16 DMP00184 LD INDEX DMP00185 SLA 12 DMP00186 STO 3 -15 DMP00187 LD L SEQ DMP00188 STO TEMP DMP00189 SRT 4 DMP00190 SLA 4 DMP00191 STO 3 -14 DMP00192 LD L SEQ DMP00193 SLA 12 DMP00194 STO 3 -13 DMP00195 LDX 2 5 PUT BCD SEQUENCE IN L DMP00196 STX 2 TEST COLUMNS 76-80 DMP00197 BINDC LD TEMP DMP00198 SRT 16 DMP00199 D K10 DMP00200 STO TEMP DMP00201 SLT 16 DMP00202 STO L 2 DMP00203 LD L2 BCDTB DMP00204 STO 3 -1 DMP00205 MDX 3 -1 DMP00206 MDX L TEST,-1 DMP00207 MDX BINDC DMP00208 MDX L CARD&79,8 DMP00209 * XR3 POINTS TO COLUMN 76 DMP00210 MDX 3 5 DMP00211 MDX 3 -80 XET XR3 FOR CARD OPERATION DMP00212 BSI TEST MAKE SURE READER IS READY DMP00213 XIOP XIO PCTL-1 PUNCH THIS CARD AND DMP00214 BSI TEST WAIT FOR COMPLETION DMP00215 LD L OPFLG DMP00216 SLA 3 DMP00217 BSC L ERROR,C ERROR--REDO DMP00218 BSC &Z DMP00219 XIO RCTL-1 LAST CARD--EJECT DMP00220 MDX L SEQ,1 UP SEQUENCE NUMBER DMP00221 SKPCH MDX L INDEX,1 DMP00222 LD INDEX CHECK THAT IT HAS NOT DMP00223 S K8 EXCEEDED 7 DMP00224 BSC L DKTCD,&Z NO, PROCESS NEXT RECORD DMP00225 MDX L LIMIT,-1 YES, DECREMENT LIMIT DMP00226 MDX RDDSK-2 IF EXCEEDED, DMP00227 WAIT WAIT HALT--EOJ. ON START DMP00228 MDX *-2 PERFORM WAIT LOOP DMP00229 ERROR WAIT WAIT FOR BLANK CARDS TO BE DMP00230 BSI TEST LOADED, CHECK DEVICE READY, DMP00231 XIO RCTL-1 AND FEED FIRST CARD. DMP00232 BSI TEST DMP00233 LDX L3 CARD&80 DMP00234 MDX XIOP THEN REDO THIS CARD DMP00235 INDEX DC 0 DMP00236 K10 DC 10 DMP00237 DSKIO LD RETRY SET ERROR LIMIT DMP00238 STO ERCTR DMP00239 LDX 2 -3 SEE IF ADJUSTMENT FOR DMP00240 LD L DKADR DEFECTIVE CYLINDER IS DMP00241 STO L DDADR DMP00242 DEFLP AND MASK DMP00243 S L2 DEFTR&3 DMP00244 BSC L CKSEK,+Z IT IS NOT DMP00245 LD L DDADR DMP00246 S MASK PORTION OF ADDRESS AND DMP00247 STO L DDADR DMP00248 MDX 2 1 TOTAL ADJUSTMENT OF 3 DMP00249 MDX DEFLP CYLINDERS DMP00250 CKSEK LD L DDADR DMP00251 STO DDDAD SAVE DDADR FOR ADDRESS CHECKDMP00252 SRT 3 IS SEEK NECESSARY DMP00253 S CLNDR DMP00254 BSC L DKRD,&- NO DMP00255 SEEK STO DCTRL SAVE SEEK COUNT DMP00256 XIO DCTRL PERFORM SEEK DMP00257 LD L DDADR DMP00258 SRT 3 DMP00259 STO CLNDR DMP00260 DKRD MDX L ERCTR,-1 DECREMENT ERROR COUNTER DMP00261 MDX *+2 DMP00262 WAIT PERMANENT ERROR--DISK. DMP00263 MDX *-2 DMP00264 BSI DTEST WAIT FOR DISK READY DMP00265 SLT 3 GET SECTOR NO. IN IOCC DMP00266 OR RDIOC DMP00267 STO DSKRD&1 DMP00268 SRT 3 SAVE SECTOR FOR RETRY DMP00269 XIO DSKRD THEN READ 1 SECTOR AND DMP00270 BSI DTEST WAIT FOR COMPLETION. DMP00271 LD DSWRD IF DATA ERROR, DMP00272 BSC L DKRD,&Z RETRY OPERATION DMP00273 LD L DDADR DMP00274 EOR DDDAD DMP00275 BSC L ONWRD,+- RIGHT ONE DMP00276 XIO L HOME HOME ACCESS ARM FOR RETRY DMP00277 BSI DTEST DMP00278 STO CLNDR RESET CYLINDER INDICATOR DMP00279 MDX L ERCTR,-1 DECREMENT ERROR COUNTER DMP00280 MDX DSKIO+2 AND RETRY DMP00281 MDX DKRD+3 OR HALT DMP00282 ONWRD MDX L DKADR,1 INCREMENT DISK ADDRESS DMP00283 LDX L1 DAREA INITIALIZE REGISTERS DMP00284 BSC L RDDSK&1 RETURN DMP00285 RDIOC DC /2600 DMP00286 RETRY DC 10 DMP00287 DDDAD DC 0 DUP OF DDADR FOR ADDR CK DMP00288 BSS E 0 DMP00289 DSWRD DC 0 DMP00290 DSENS DC /2700 SENSE DSW--NO RESET DMP00291 DSKRD DC WCA DMP00292 DC /2600 READ DISK IOCC DMP00293 K8 DC 8 DMP00294 PCTL DC /1401 START PUNCH IOCC DMP00295 MASK DC /FFF8 DMP00296 RCTL DC /1402 FEED IOCC DMP00297 DCTRL DC 0 DMP00298 DC /2400 DMP00299 CLNDR DC 0 DMP00300 DSNSR DC /2701 SENSE DSW WITH RESET DMP00301 ERCTR DC 10 DMP00302 DTEST DC *-* TEST DISK BUSY ROUTINE DMP00303 XIO DSENS-1 DMP00304 AND DMASK DMP00305 BSC I DTEST,&- DMP00306 DWAIT WAIT DMP00307 MDX DTEST&1 DMP00308 DMASK EQU DWAIT DMP00309 LEVL2 DC *-* DISK INTERRUPT ROUTINE DMP00310 STO DTEMP SAVE ACC DMP00311 XIO DSNSR-1 SENSE DSW, RESET INDICATORS,DMP00312 STO DSWRD AND SAVE DSW DMP00313 LD DTEMP RESTORE ACC DMP00314 BOSC I LEVL2 EXIT AND CLEAR LEVEL DMP00315 DTEMP DC 0 DMP00316 DFECT DC 4 WORD COUNT TO GET DEFECTS DMP00317 DC 0 DISK ADDRESS 0,0 DMP00318 BSS E 0 DMP00319 DEFTR BSS 4 DMP00320 BCDTB DC /2000 0 DMP00321 DC /1000 1 DMP00322 DC /800 2 DMP00323 DC /400 3 DMP00324 DC /200 4 DMP00325 DC /100 5 DMP00326 DC /80 6 DMP00327 DC /40 7 DMP00328 DC /20 8 DMP00329 DC /10 9 DMP00330 DC /9000 A DMP00331 DC /8800 B DMP00332 DC /8400 C DMP00333 DC /8200 D DMP00334 DC /8100 E DMP00335 DC /8080 F DMP00336 BSS 1 DMP00337 DC /50 DMP00338 CARD BSS E 70 CARD I/O AREA DMP00339 USEQ DC 0 DMP00340 DC 0 DMP00341 UID DC /9000 A DMP00342 DC /4040 P DMP00343 DC /4400 L DMP00344 DC /8200 D DMP00345 DC /4200 M DMP00346 DC /4040 P DMP00347 BSS 2 DMP00348 WCA DC 321 DISK WORD COUNT DMP00349 DDADR DC 0 DISK ADDRESS DMP00350 DAREA BSS 336 DISK INPUT AREA DMP00351 HDNG ** CARD OBJECT DECK UTILITY ** DMP00352 UILS0 DC ULVL0 DMP00353 URSET DC /1703 RESET ALL CARD INDICATORS DMP00354 UILS4 DC ULVL4 DMP00355 USENS DC /1700 SENSE CRD DEVICE--NO RESET DMP00356 UPNCH DC CARD COLUMN PUNCH IOCC DMP00357 DC /1100 DMP00358 UOPFL DC 0 DMP00359 USNS4 DC /1702 RESET AND TEST LEVEL 4 DMP00360 UTMP4 DC 0 DMP00361 USNS0 DC /1701 RESET AND TEST LEVEL 3 DSW DMP00362 UTMP0 DC 0 DMP00363 USTRT DC /1401 START PUNCH IOCC DMP00364 ULVL4 DC *-* OPERATION COMPLETE INTERRUPTDMP00365 STO UTMP4 SAVE ACC DMP00366 XIO USNS4-1 RESET LEVEL 4 DMP00367 STO UOPFL SAVE STATUS DMP00368 LD UTMP4 RESTORE ACC DMP00369 BOSC I ULVL4 EXIT AND CLEAR LEVEL 4 DMP00370 ULVL0 DC *-* COLUMN INTERRUPT ROUTINE DMP00371 STO UTMP0 SAVE ACC DMP00372 XIO USNS0-1 CLEAR INDICATORS DMP00373 XIO UPNCH PUNCH COLUMN DMP00374 MDX L UPNCH,1 UP COLUMN ADDRESS DMP00375 LD UTMP0 RESTORE ACC DMP00376 BOSC I ULVL0 EXIT AND CLEAR LEVEL 0 DMP00377 BRADR DC START*16 DMP00378 FEED DC /1402 DMP00379 UBUSY DC 3 DMP00380 ULIM DC 490 DMP00381 BEGIN LDX 1 8 SET INTERRUPT LEVELS DMP00382 LD UILS0 DMP00383 STO 1 0 DMP00384 LD UILS4 DMP00385 STO 1 4 DMP00386 LDX L1 DEFRD DMP00387 XIO URSET-1 CLEAR INDICATO*S DMP00388 XIO FEED-1 DMP00389 URDY XIO URSET-1 CHECK FOR DEVICE READY DMP00390 AND UBUSY DMP00391 BSC L URDY,Z DMP00392 NEWCD SLT 16 DMP00393 LDX L3 CARD PUT 35 WORDS IN DMP00394 STX 3 UPNCH COLUMNS 1-70 DMP00395 LDX 2 35 DMP00396 FORMT LD 1 0 DMP00397 SRT 8 DMP00398 SLA 8 DMP00399 STO 3 0 DMP00400 SLT 16 DMP00401 STO 3 1 DMP00402 MDX 3 2 DMP00403 MDX 1 1 DMP00404 MDX 2 -1 DMP00405 MDX FORMT DMP00406 LD L USEQ DMP00407 SRT 20 IN COLUMNS 79,80 DMP00408 D UK10 DMP00409 STO L 2 DMP00410 LD L2 BCDTB DMP00411 STO L CARD+78 DMP00412 SLT 16 DMP00413 STO L 2 DMP00414 LD L2 BCDTB DMP00415 STO L CARD+79 DMP00416 LD BRADR DMP00417 MDX L ULIM,-35 DMP00418 SRA 16 DMP00419 STO L CARD+71 DMP00420 MDX L CARD+79,8 DMP00421 DOPCH XIO USTRT-1 PUNCH CARD DMP00422 UTEST XIO USENS-1 WAIT FOR COMPLETION DMP00423 AND UBUSY DMP00424 BSC L UTEST,Z DMP00425 LD UOPFL DMP00426 SLA 3 DMP00427 BSC L DOPCH,C DMP00428 MDX L USEQ,16 DMP00429 MDX L ULIM,0 DMP00430 MDX NEWCD DMP00431 WAIT DMP00432 MDX *-2 DMP00433 UK10 DC 10 DMP00434 END BEGIN DMP00435 // XEQ DMP00436 // ASM 25010001 *LIST 25010002 HDNG ** DISK RESTORE/LOAD UTILITY ** 25010003 * CARD FORMAT 25010004 * ---- ------ 25010005 * COLUMNS 1-64 CONTAIN 48 DATA WORDS 25010006 * IN 1130 CARD DATA FORMAT 25010007 * COLUMN 65 CONTAINS THE SECTOR ADDRESS 25010008 * COLUMN 66 CONTAINS AN INDEX IN SECTOR 25010009 * COLUMNS 67,68 CONTAIN THE SEQUENCE NO.25010010 * COLUMNS 69-72 ARE UNUSED 25010011 * COLUMNS 73-80 CONTAIN BCD ID AND SEQ. 25010012 ABS 25010013 ORG /800 25010014 HOME DC /CB 25010015 DC /2404 ARM BACK IOCC 25010016 ILS0 DC LEVL0 25010017 RESET DC /4F01 25010018 DC LEVL2 25010019 SENSE DC /4F00 25010020 DC LEVL4 25010021 SENS4 DC /4F01 25010022 READ DC CARD-1 25010023 DC /4E00 25010024 OPFLG DC 0 25010025 SENS0 DC /1701 RESET LEVEL 0 AND GET DSW 25010026 TEMP4 DC 0 25010027 RCTRL DC /1404 START CARD READ IOCC 25010028 LEVL4 DC *-* OPERATION COMPLETE INTERRUPT25010029 STO TEMP4 SAVE ACC 25010030 XIO SENS4-1 CHECK AND RESET LEVEL 4 25010031 STO OPFLG SAVE STATUS 25010032 LD TEMP4 RESTORE ACC 25010033 BOSC I LEVL4 EXIT AND CLEAR LEVEL 4 25010034 TEMP0 DC 0 25010035 LEVL0 DC *-* COLUMN INTERRUPT ROUTINE 25010036 STO TEMP0 SAVE ACC 25010037 XIO SENS0-1 CLEAR INDICATORS 25010038 XIO READ READ COLUMN 25010039 MDX L READ,1 UP READ ADDRESS 25010040 LD TEMP0 RESTORE ACC 25010041 BOSC I LEVL0 EXIT AND CLEAR LEVEL 0 25010042 BUSY DC 3 25010043 LSTCD DC 0 EJECT LAST CARD IOCC 25010044 DC /1402 25010045 SEQ DC 0 CARD SEQUENCE NUMBER 25010046 START LDX 1 6 SET INTERRUPT LEVELS 25010047 ILOOP LD L1 ILS0-2 25010048 STO 1 6 25010049 MDX 1 -2 25010050 MDX ILOOP 25010051 BSI DTEST 25010052 XIO HOME SET DISK ACCESS ARM TO 0 25010053 BSI DTEST 25010054 XIO L DSKWR READ FIRST SECTOR 25010055 BSI DTEST 25010056 LDX L1 DAREA INITIALIZE I/O POINTER 25010057 LDD 1 0 SET UP DEFECTIVE TRK TABL 25010058 STD L DEFTR 25010059 LD 1 2 25010060 STO L DEFTR&2 25010061 NOTST XIO RESET-1 CHECK FOR DEVICE READY 25010062 AND BUSY AND RESET INDICATORS 25010063 BSC L NOTST,Z 25010064 MDX TEST 25010065 CDTDK MDX L LSTCD,0 IF LAST CARD 25010066 MDX DSKIO PROCESSED, GO WRITE IT 25010067 MDX L SEQ,1 25010068 TEST XIO SENSE-1 WAIT FOR COMPLETION/READY 25010069 AND BUSY 25010070 BSC L *&2,&- 25010071 WAIT WAIT 25010072 MDX TEST 25010073 STO OPFLG ZERO INTERRUPT INDICATOR 25010074 XIO READ 25010075 CKRD LD OPFLG CHECK FOR INTERRUPT AFTER 25010076 BSC L CKRD,+- READ 25010077 SLA 3 25010078 SRA 3 25010079 STO OPFLG 25010080 BSC L WAIT,C WAIT IF THERE WAS ONE 25010081 SLA 3 25010082 BSC +Z IF LAST CARD 25010083 STO LSTCD INDICATE AND EJECT 25010084 LDX L3 CARD 25010085 LD 3 67 CHECK SEQUENCE NUMBER 25010086 SRA 12 FROM COLUMNS 67,68 25010087 OR 3 66 25010088 EOR SEQ THEY MUST BE CONSECUTIVE 25010089 SEQOK BSC L NSCTR,&- AND START AT ZERO 25010090 MDX WAIT WAIT IF SEQUENCE ERROR 25010091 CKADR LD 3 64 IF THIS CARD GOES ON A 25010092 S DKADR NEW SECTOR, 25010093 BSC L DSKIO,Z- WRITE OLD ONE 25010094 BSC L WAIT,Z WAIT IF LAST CARD 25010095 NSCTR LD 3 65 IF NEW INDEX IS NOT 25010096 SRA 12 NEXT ONE ON SECTOR-- 25010097 S INDEX 25010098 MDX L INDEX,1 25010099 BSC L DECOD,& 25010100 SLT 32 --ZERO THAT SECTION 25010101 LDX 2 48 25010102 ZER48 STD 1 0 25010103 MDX 1 2 25010104 MDX 2 -2 25010105 MDX ZER48 25010106 MDX NSCTR 25010107 INDEX DC 0 25010108 DECOD LDX 2 16 GET 48 WORDS TO DISK AREA 25010109 LD 3 0 FROM COLUMNS 1-64 25010110 RTE 20 25010111 LD 3 1 25010112 RTE 12 25010113 STO 1 0 25010114 RTE 8 25010115 LD 3 2 25010116 RTE 8 25010117 STO 1 1 25010118 RTE 12 25010119 LD 3 3 25010120 RTE 4 25010121 STO 1 2 25010122 MDX 1 3 25010123 MDX 3 4 25010124 MDX 2 -1 25010125 MDX DECOD&1 25010126 MDX L SEQ,0 IF THIS IS FIRST CARD-- 25010127 MDX CDTDK 25010128 LD 3 0 --NEED TO INITIALIZE 25010129 GTADR STO DKADR INITIALIZE DISK ADDRESS 25010130 BSC L *+4,Z REPL DEFECTIVE INFO IF SCTR025010131 LDD DEFTR 25010132 STD L DAREA 25010133 LD DEFTR+2 25010134 STO L DAREA+2 25010135 MDX L SEQOK&1,-6 CHANGE LOGIC TO CHECK 25010136 MDX CDTDK DISK ADDRESS 25010137 DTEST DC *-* TEST DISK BUSY ROUTINE 25010138 XIO DSENS-1 25010139 AND DMASK 25010140 BSC I DTEST,&- 25010141 DWAIT WAIT 25010142 MDX DTEST&1 25010143 DKADR DC 0 25010144 DSKIO LD RETRY RESET RETRY LIMIT 25010145 STO ERCTR 25010146 DODSK LDX 2 -3 SEE IF ADJUSTMENT FOR 25010147 LD DKADR DEFECTIVE CYLINDER IS 25010148 SRA 4 NECESSARY 25010149 STO L DDADR 25010150 DEFLP AND MASK 25010151 S L2 DEFTR&3 25010152 BSC L CKSEK,+Z IT IS NOT 25010153 LD L DDADR 25010154 S MASK PORTION OF ADDRESS AND 25010155 STO L DDADR 25010156 MDX 2 1 TOTAL ADJUSTMENT OF 3 CYLS 25010157 MDX DEFLP 25010158 CKSEK LD L DDADR 25010159 SRT 3 IS A SEEK NECESSARY 25010160 S CLNDR 25010161 BSC L WRITE,+- NO 25010162 SEEK STO DCTRL SAVE SEEK COUNT 25010163 BSI DTEST ASSURE DISK READY 25010164 XIO DCTRL PERFORM SEEK 25010165 LD L DDADR 25010166 SRT 3 25010167 STO CLNDR 25010168 WRITE BSI DTEST 25010169 MDX L ERCTR,-1 DECREMENT THE ERROR COUNTER 25010170 MDX *+2 25010171 WAIT PERMANENT DISK ERROR 25010172 MDX *-2 25010173 SLT 3 PERFORM 1 WORD ADDRESS CHECK25010174 OR RDIOC 25010175 STO DSKRD+1 25010176 SRT 3 25010177 XIO DSKRD 25010178 BSI DTEST 25010179 LD DKRD+1 25010180 EOR L DDADR 25010181 BSC L ONWRD,+- CONTINUE IF ADDRESSES AGREE,25010182 XIO L HOME ELSE HOME ACCESS ARM FOR RET25010183 BSI DTEST TRY 25010184 STO CLNDR RESET CYLINDER INDICATOR 25010185 MDX DODSK 25010186 ONWRD SLT 3 25010187 OR WRIOC 25010188 STO DSKWR&1 25010189 SRT 3 SAVE SECTOR FOR RETRY 25010190 XIO DSKWR WRITE SECTOR 25010191 BSI DTEST WAIT FOR COMPLETION 25010192 STO INDEX ZERO INDEX 25010193 LD DSWRD 25010194 BSC L WRITE,&Z RETRY IF DATA ERROR 25010195 LDX L1 DAREA ZERO THIS SECTOR 25010196 LDX L2 168 25010197 SLT 32 25010198 ZSCTR STD 1 0 25010199 MDX 1 2 25010200 MDX 2 -1 25010201 MDX ZSCTR 25010202 MDX L DKADR,16 25010203 LDX L1 DAREA 25010204 LDX L3 CARD 25010205 BSC L CKADR RETURN 25010206 DMASK EQU DWAIT 25010207 LEVL2 DC *-* DISK INTERRUPT ROUTINE 25010208 STO DTEMP SAVE ACC 25010209 XIO DSNSR-1 SENSE DSW, RESET INDICATORS,25010210 STO DSWRD SAVE DSW 25010211 LD DTEMP RESTORE ACC 25010212 BOSC I LEVL2 EXIT AND CLEAR LEVEL 2 25010213 RDIOC DC /2600 25010214 BSS E 0 DISK IOCC AREA 25010215 DSKRD DC DKRD READ DISK 1 WORD 25010216 DC /2600 25010217 DKRD DC 1 25010218 DC 0 25010219 RETRY DC 10 25010220 ERCTR DC 10 25010221 DSKWR DC WCA 25010222 DC /2600 WRITE DSK AND RD 1ST SCTR 25010223 DCTRL DC 0 25010224 DC /2400 SEEK IOCC 25010225 MASK DC /FFF8 25010226 DSENS DC /2700 SENSE DSW--NO RESET 25010227 WRIOC DC /2500 25010228 DSNSR DC /2701 SENSE DSW WITH RESET 25010229 DSWRD DC 0 25010230 CLNDR DC 0 25010231 BSS E 0 25010232 DEFTR BSS 3 DEFECTIVE CYLINDER INFO 25010233 DTEMP DC 0 25010234 BSS 1 25010235 DC /50 25010236 CARD BSS E 70 25010237 USEQ DC 0 25010238 DC 0 25010239 UID DC /9000 A 25010240 DC /4040 P 25010241 DC /4400 L 25010242 DC /4400 L 25010243 DC /8200 D 25010244 DC /4010 R 25010245 BSS 2 25010246 WCA DC 321 DISK WORD COUNT 25010247 DDADR DC 0 DISK ADDRESS 25010248 DAREA BSS 336 DISK OUTPUT AREA 25010249 HDNG ** APL CARD OBJECT DECK UTILITY ** 25010250 UILS0 DC ULVL0 25010251 URSET DC /1703 RESET ALL CARD INDICATORS 25010252 UILS4 DC ULVL4 25010253 USENS DC /1700 SENSE CRD DEVICE--NO RESET 25010254 UPNCH DC CARD 25010255 DC /1100 COLUMN PUNCH IOCC 25010256 UOPFL DC 0 25010257 USNS4 DC /1702 RESET AND TEST LEVEL 4 DSW 25010258 UTMP4 DC 0 25010259 USNS0 DC /1701 RESET AND TEST LEVEL 3 DSW 25010260 UTMP0 DC 0 25010261 USTRT DC /1401 START PUNCH IOCC 25010262 ULVL4 DC *-* OPERATION COMPLETE INTERRUPT25010263 STO UTMP4 SAVE ACC 25010264 XIO USNS4-1 RESET LEVEL 4 25010265 STO UOPFL SAVE STATUS 25010266 LD UTMP4 RESTORE ACC 25010267 BOSC I ULVL4 EXIT AND CLEAR LEVEL 4 25010268 ULVL0 DC *-* COLUMN INTERRUPT ROUTINE 25010269 STO UTMP0 SAVE ACC 25010270 XIO USNS0-1 CLEAR INDICATORS 25010271 XIO UPNCH PUNCH COLUMN 25010272 MDX L UPNCH,1 UP COLUMN ADDRESS 25010273 LD UTMP0 RESTORE ACC 25010274 BOSC I ULVL0 EXIT AND CLEAR LEVEL 0 25010275 BRADR DC START*16 25010276 FEED DC /1402 25010277 UBUSY DC 3 25010278 ULIM DC 490 25010279 BEGIN LDX 1 8 SET INTERRUPT LEVELS 25010280 LD UILS0 25010281 STO 1 0 25010282 LD UILS4 25010283 STO 1 4 25010284 LDX L1 HOME 25010285 XIO URSET-1 CLEAR INDICATORS 25010286 XIO FEED-1 25010287 URDY XIO URSET-1 CHECK FOR DEVICE READY 25010288 AND UBUSY 25010289 BSC L URDY,Z 25010290 NEWCD SLT 16 25010291 LDX L3 CARD PUT 35 WORDS IN 25010292 STX 3 UPNCH COLUMNS U-70 25010293 LDX 2 35 25010294 FORMT LD 1 0 25010295 SRT 8 25010296 SLA 8 25010297 STO 3 0 25010298 SLT 16 25010299 STO 3 1 25010300 MDX 3 2 25010301 MDX 1 1 25010302 MDX 2 -1 25010303 MDX FORMT 25010304 LD L USEQ 25010305 SRT 20 IN COLUMNS 79,80 25010306 D K10 25010307 STO L 2 25010308 LD L2 BCDTB 25010309 STO L CARD+78 25010310 SLT 16 25010311 STO L 2 25010312 LD L2 BCDTB 25010313 STO L CARD+79 25010314 LD BRADR 25010315 MDX L ULIM,-35 25010316 SRA 16 25010317 STO L CARD+71 25010318 MDX L CARD&79,8 25010319 DOPCH XIO USTRT-1 PUNCH CARD 25010320 UTEST XIO USENS-1 WAIT FOR COMPLETION 25010321 AND UBUSY 25010322 BSC L UTEST,Z 25010323 LD UOPFL 25010324 SLA 3 25010325 BSC C 25010326 MDX *-1 ERROR LOOP 25010327 MDX L USEQ,16 25010328 MDX L ULIM,0 25010329 MDX NEWCD 25010330 WAIT 25010331 MDX *-2 25010332 K10 DC 10 25010333 BCDTB DC /2000 0 25010334 DC /1000 1 25010335 DC /800 2 25010336 DC /400 3 25010337 DC /200 4 25010338 DC /100 5 25010339 DC /80 6 25010340 DC /40 7 25010341 DC /20 8 25010342 DC /10 9 25010343 END BEGIN 25010344 // XEQ 25010344 // JOB APWD0001 // ASM APWD0002 *LIST APWD0003 *PRINT SYMBOL TABLE APWD0004 HDNG SET UP USER AND WORKSPACE DIRECTORIES APWD0005 ABS APWD0006 ORG /800 APWD0007 * APWD0008 * DISK ADDRESSES APWD0009 LCDBS EQU /280 APWD0010 DADRU EQU LCDBS+/6C APWD0011 HDNG ORIGIN OF ASSEMBLY APWD0012 BSS E 0 APWD0013 DC 2*/140 APWD0014 DC DADRU APWD0015 HDNG FORM USER AND WORKSPACE DIRECTORIES APWD0016 WSADR BSS /280 APWD0017 START LDX L2 WSADR APWD0018 LDX L1 /140 APWD0019 SLT 32 APWD0020 STA01 STD 2 0 APWD0021 MDX 2 2 APWD0022 MDX 1 -1 APWD0023 MDX STA01 APWD0024 LDX 1 20 APWD0025 STX 1 STA04 APWD0026 LDX L2 WSADR+/147 APWD0027 STX 2 STA02+1 APWD0028 MDX 2 8 APWD0029 STX 2 STA03+1 APWD0030 LDX L1 /5A0 APWD0031 LDX 2 0 APWD0032 STA02 STX L1 *-* APWD0033 STA03 STX L2 *-* APWD0034 MDX L STA02+1,16 APWD0035 MDX L STA03+1,16 APWD0036 MDX 1 -/20 APWD0037 MDX 2 /20 APWD0038 MDX L STA04,-1 APWD0039 MDX STA02 APWD0040 LDX L1 /5C0 APWD0041 STX L1 WSADR+/14F APWD0042 HDNG WRITE DIRECTORIES TO DISK APWD0043 LDX L1 WSADR-2 APWD0044 BSI L DSKIO APWD0045 EXIT APWD0046 STA04 DC 0 APWD0047 * APWD0048 DSKIO DC 0 APWD0049 STX 1 DSKI1 APWD0050 STX 1 DSKI3 APWD0051 LIBF DISK1 APWD0052 DC /3000 APWD0053 DSKI1 DC 0 APWD0054 DC DSKI4 APWD0055 DSKI2 LIBF DISK1 APWD0056 DC /0000 APWD0057 DSKI3 DC 0 APWD0058 MDX DSKI2 APWD0059 BSC I DSKIO APWD0060 DSKI4 WAIT APWD0061 BSC I DSKIO APWD0062 * APWD0063 END START APWD0064 // XEQ L 1 APWD0065