; UPD ID= 3279 on 12/12/80 at 10:13 AM by NIXON TITLE CLEAND FOR COBOL V12B SUBTTL CLEANUP AFTER PHASE D W.NEELY/CAM ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ; ;COPYRIGHT (C) 1974, 1981 BY DIGITAL EQUIPMENT CORPORATION SEARCH P %%P==:%%P DBMS==:DBMS DEBUG==:DEBUG ;EDITS ;NAME DATE COMMENTS ;DAW 14-Nov-80 [1074] "?Catastrophe in PHASE D" if "DYNAMIC" ; in ACCESS MODE clause is misspelled. ;JEH 27-JUN-80 [1032] STORE EBCDIC MODE IN KEY DESCRIPTOR ;JEH 03-APR-80 [1006] PULL OUT CODE TESTING ON USE PROCEDURE CONFLICTS ;DMN 24-OCT-79 [747] COBOL-74 BAD TABLE LINK IF MISSING ISAM RECORD KEY ;CLRH 14-SEP-79 [735] GIVE ERROR IF RECORD KEY NOT DEFINED IN RIGHT FD ;V12A SHIPPED ;DAW 23-APR-79 [677] FIX PROBLEM WITH TABLES EXPANDING THAT ; CAN MESS UP DBMS USE PROCEDURES ;EHM 17-SEP-78 [552] GIVE ERROR IF DECLARITIVES AND NO END DECL. ;V10***************** ; 10-AUG-76 [435] FIX UP USE PROCEDURE TABLE FOR DBMS ; 18-FEB-76 [407] FIX WRITING BEFORE/AFTER FOR STD ASCII ;DPL 01/29/76 [401] SET DBONLY OFF(=0) IF ONLY USE PROC IS DBMS ;ACK 14-JAN-74 GENERATE POINTERS IN THE FILE TABLE FOR FILE ; STATUS STUFF AND SIMULTANEOUS ACCESS STUFF. ;DBT 1/22/74 CHANGE THE PERF. UUO GENERATION TO GENERATE ; A PUSHJ 17,PERF. ;******************** ;[236] /ACK COBOLC.MAC, CLEAND.MAC ; RESERVE SPACE FOR LABEL RECORD IF LARGER THAN FD ; BUT DONT CHANGE FILE TABLE MAX-REC-SIZE ; EDIT 171 MAKES ENTER COBOL EQUIVELENT TO CALL. ; EDIT 137 GIVE ERROR MESSAGE IF SUBSCRIPT IS IN LINKAGE ; SECTION OF IF SUBSCRIPTED IS SUBSCRIPTED. ; EDIT 165 FIXES COMPILER LOOP IF RIGHT PAREN ; MISSING FOR SUBSCRIPTED DATA-NAME. ; EDIT 155 FIXES "ADDRESS CHECK" WHEN SORT FILE SHARES SAME BUFFER AREA. ; EDIT 151 FIXES UNBALL PAREN PROBLEM IN COMPUTE STATEMENT. ; EDIT 111 FIXES COMPILER LOOP FOR SEARCH ALL... AT END STOP RUN. ; EDIT 110 OPEN STATEMENT DOES NOT GIVE PERIOD ASSUMED MESSAGE ; IF A PERIOD IS MISSING AND STATEMENT IS LAST ONE IN A PARA. TWOSEG RELOC 400000 SALL ENTRY CLEAND,CLENTA,PRFSUB SUBTTL CLEAND:; GENERATE OBJECT FILE TABLES CLEAND: TSWTZ INDECL ;[552] STILL IN DECLARITIVES? JRST CLND0 ;[552] NO, OK LDB LN,[POINT 13,DECLR.##,28] ;[552] GET LINE NUMBER LDB CP,[POINT 7,DECLR.,35] ;[552] AND CHAR. POS. MOVEI DW,E.608 ;[552] GET ERROR MESSAGE CODE PUSHJ PP,FATAL ;[552] WARN USER CLND0: MOVE TA,EAS1PC## MOVEM TA,FILTBL## SETZM EAS1PC MOVE TA,FILLOC## CAMN TA,FILNXT## JRST ECLND ;NO FILTAB ENTRIES HRRZI TA,SZ.DEV ADDM TA,FILTBL HRRZI TA,CD.FIL*1B20+1 CLND: HRLZM TA,CURFIL## PUSHJ PP,LNKSET## HRRM TA,CURFIL SETZM TBLOCK+20 LDB TB,FI.FDD## JUMPN TB,CC0. SETOM TBLOCK+20 PUSHJ PP,CLE12. ;NO FD HRRZ TA,CURFIL CC0.: LDB TB,FI.NDV## ;NUMBER OF DEVICES JUMPG TB,CC0.1 PUSHJ PP,CLE1. ;SHOULD BE AT LEAST ONE CC0.1: HRRZ TA,CURFIL LDB TB,FI.IRM## ;INTERNAL RECORDING MODE CAIE TB,%%RM JRST CC1. ;SPECIFIED HRRZI TB,%RM.6B DPB TB,FI.IRM ;ASSUME SIXBIT CC1.: LDB TC, FI.PSN## ;GET POSITIONING LDB TD, FI.ADV## ; AND ADVANCING FLAGS. JUMPE TD, CC1.D ;IF THEY ARE BOTH ON, JUMPE TC, CC1.H ; COMPLAIN. PUSHJ PP, CLE18. ;IF EITHER IS ON, TURN CC1.D: DPB TC, FI.ADV## ; ON ADVANCING. CC1.H: IORI TC, (TD) ;GET ADV FLAG FOR LATER. LDB TD, FI.ERM## ;GET EXTERNAL RECORDING MODE. CAIE TD,%RM.7B ; [407] IF IT IS ASCII CAIN TD,%RM.SA ; [407] STANDARD ASCII JRST CC2. ; [407] GO ON TRNN TC, 1 ;IS ADVANCING ON? JRST CC2. ;NO, USE WHAT'S SPECIFIED OR DEFAULT TO SIXBIT MOVEI TD,%RM.7B ;YES, MAKE IT ASCII. DPB TD,FI.ERM## ;SET THE EXTERNAL RECORDING MODE. LDB TB,FI.RM2## ;WAS IT SPECIFIED? JUMPE TB,CC2. ;NO, OK PUSHJ PP,CLE13. ;YES, GIVE ERROR ;IF LABELS ARE NON STANDARD ON EBCDIC TAPES GIVE AN ERROR. CC2.: LDB TB, FI.ERM## ;GET THE EXTERNAL RECORDING MODE. CAIE TB, %RM.EB ;IF IT'S NOT EBCDIC JRST CC3. ; ALL IS WELL. LDB TB, FI.LBL## ;GET THE FILE'S LABEL TYPE. CAIE TB, %LBL.N ;IF IT'S NOT NON-STANDARD JRST CC3. ; ALL IS WELL. PUSHJ PP, CLE28. ;OTHERWISE COMPLAIN. HRRZ TA, CURFIL ;RESTORE THE FILE TABLE'S ADDRESS. CC3.: LDB TB,FI.DRL## ;DATA RECORD LINK JUMPN TB,.+3 PUSHJ PP,CLE2. ;NO DATA RECORDS HRRZ TA,CURFIL LDB TB,FI.DSD## JUMPN TB,CFGEN ;SORT-FILE LDB TB,FI.LBL## ;TYPE OF LABELS LDB TC,FI.VID## ;VALUE-OF-ID LDB TD,FI.VDW## ;VALUE-OF-DATE-WRITTEN JRST .+1(TB) JRST CC5. ;[157] OMITTED JRST CC4. ;STANDARD JRST CC5. ;[157] NON-STANDARD HRRZI TB,%LBL.S ;NOT SPECIFIED DPB TB,FI.LBL ;ASSUME STANDARD JRST CC4. CC4.: JUMPN TC,CC5. ;VALUE-OF-ID REQUIRED PUSHJ PP,CLE4. HRRZ TA,CURFIL CC5.: LDB TB,FI.POS ;MULTIPLE FILE TAPE FLAG JUMPE TB,CC6. LDB TB,FI.NDV CAIG TB,1 ;ONLY ONE DEVICE ALLOWED JRST CC5.2 PUSHJ PP,CLE6. HRRZ TA,CURFIL HRRZI TB,1 DPB TB,FI.NDV CC5.2: IFN ANS68,< LDB TB,FI.MLT## ;MULTIPLE REEL/UNIT JUMPE TB,CC6. ;NOT ALLOWED PUSHJ PP,CLE7. HRRZ TA,CURFIL > ;CHECK BLOCKING FACTOR CC6.: IFN ANS74,< LDB TB,FI.RMS ;IS THIS AN RMS FILE? JUMPN TB,CC7. ;YES, IGNORE BLOCKING FACTOR > LDB TB,FI.BLF## ;BLOCKING FACTOR JUMPN TB,CC7. LDB TC,FI.FBS## ;GIVEN BUFFER SIZE INSTEAD? JUMPE TC,CC6B. ;NO LDB TB,FI.MRS## ;YES, GET RECORD SIZE IDIVI TC,(TB) ;SEE HOW MANY FIT DPB TC,FI.BLF ;THIS IS BLOCKING FACTOR JUMPN TC,CC7. ;BETTER NOT BE ZERO PUSHJ PP,CLE30. ;TOO BAD JRST CC7. CC6B.: LDB TC,FI.ACC IFN ANS68,< CAIN TC,%ACC.R PUSHJ PP,CLE11. ;MUST NOT BE RANDOM ACCESS > IFN ANS74,< CAIE TC,%ACC.R JRST CC6A. ;NOT RELATIVE LDB TB,FI.ERM## ;EXTERNAL RECORDING MODE MOVE TB,[EXP 6,1,5,4,4](TB) ;BYTES PER WORD LSH TB,7 ;ASSUME 200 WORD BUFFER MOVE TC,[200000,,1] ;SEED EXCESS,,BLOCKING FACTOR MOVSI CH,-4 ;NO. OF PHYSICAL BUFFERS IN LOGICAL BUFFER CC6L.: MOVE TE,TB ;CHARS. IN 1 BUFFERS IMULI TE,1(CH) ;NO. IN LOGICAL BUFFER LDB TD,FI.MRS## ;RECORD SIZE CAIN TB,5*200 ;ASCII? ADDI TD,2 ;ALLOW FOR CR-LF CAIN TB,4*200 ;EBCDIC? JRST [PUSH PP,TD+1 ;YES, GET FEE AC LDB TD+1,FI.VLR## ;IS IT VARIABLE LENGTH? JUMPE TD+1,CC6M. ;NO ADDI TD,4 ;YES, ACCOUNT FOR 4 BYTE HEADER JRST CC6M.] CAIE TB,6*200 ;SIXBIT? JRST CC6N. ;NO PUSH PP,TD+1 ;SAVE TD+1 ADDI TD,6+5 ;ROUNDING + CONTROL WORD IDIVI TD,6 ;NO. WHOLE WORDS IMULI TD,6 ;NO. OF CHARACTERS OCCUPIED BY RECORD CC6M.: POP PP,TD+1 CC6N.: IDIVI TE,(TD) ;TE=NUMBER OF RECORDS, TD=REMAINDER HRL TE,TD ;EXCESS,,BLOCKING FACTOR IMULI TD,5 ;TRY TO GET 80% FULL CAIG TD,(TB) ; JRST CC6K. ;WASTAGE LESS THAN 20% OF 1 BUFFER CAMGE TE,TC ;BETTER THAN PREVIOUS? MOVE TC,TE ;YES, SAVE IT AOBJN CH,CC6L. ;TRY AGAIN MOVE TE,TC ;GET BLOCKING FACTOR CC6K.: DPB TE,FI.BLF ;STORE BLOCKING FACTOR JRST CC7. CC6A.: CAIN TC,%ACC.I ;IS IT INDEX? JRST CC6I. ;YES, SET DEFAULT > HRRZ TA,CURFIL LDB TB,FI.IOO## JUMPE TB,CC7. IFN ANS68,< PUSHJ PP,CLE15. HRRZ TA,CURFIL > IFN ANS74,< CC6I.: MOVEI TB,1 ;USE DEFAULT OF 1 DPB TB,FI.BLF MOVEI DW,E.733 ;"BLOCK CONTAINS 1 RECORD assumed." LDB LN,FI.FLN ;POINT TO THE FD LDB CP,FI.FCP PUSHJ PP,WARN## HRRZ TA,CURFIL ;POINT TO FILE AGAIN > CC7.: LDB TB,FI.ACC ;ACCESS MODE CAIE TB,%%ACC JRST CC8. ;SPECIFIED HRRZI TB,%ACC.S ;ASSUME SEQUENTIAL DPB TB,FI.ACC CC8.: JRST .+1(TB) JRST CFGEN ;SEQUENTIAL JRST CC12. ;RANDOM JRST CFGEN ;INDEXED CC12.: IFN ANS68,< LDB TB,FI.NFL## ;NUMBER OF FILE-LIMITS JUMPG TB,CC14. ;MUST BE SOME PUSHJ PP,CLE10. HRRZ TA,CURFIL CC14.:> LDB TB,FI.LBL ;LABELS MUST BE CAIN TB,%LBL.S ;STANDARD JRST CFGEN PUSHJ PP,CLE5. HRRZ TA,CURFIL ; JRST CFGEN ;FALL THRU CFGEN: HRRZI TC,SZ.DEV BAK.0: MOVEI CH,1 HRLI CH,AS.OCT## ;PUT PUSHJ PP,PUTAS1## ; OUT SETZ CH, ; 'OCT 0' PUSHJ PP,PUTAS1 SOJG TC,BAK.0 MOVE TC,EAS1PC HRRZ TA,CURFIL DPB TC,FI.OFT## ADDI TC,SZ.DEV MOVEM TC,EAS1PC IFN ANS74,< LDB TA,FI.LCP## ;SEE IF LINAGE-COUNTER JUMPE TA,B0.1 ;NO PUSHJ PP,LNKSET HRRZ TC,FI.LCP ;GET COMPILE TIME OFFSET ADD TC,FILTBL ;PLUS BASE OF FILE TABLE SUBI TC,SZ.DEV-4 ;RUN TIME OFFSET, DON'T COUNT SZ.DEV TWICE ADD TC,EAS1PC ;DEPTH IN FILTBL DPB TC,DA.LOC ;STORE INCORE LOCATION HRRZ TA,CURFIL LDB TC,FI.LPP## TRNE TC,700000 JRST B0.0 LDB TC,FI.WFA## TRNE TC,700000 JRST B0.0 LDB TC,FI.LAT## TRNE TC,700000 JRST B0.0 LDB TC,FI.LAB## TRNN TC,700000 JRST B0.1 B0.0: PUSHJ PP,GETTAG ;GET NEXT TAG HRRZ TA,CURFIL DPB CH,FI.LCI## ;STORE IT B0.1: HRRZ TA,CURFIL > MOVE TC,[TBLOCK,,TBLOCK+1] SETZM TBLOCK## BLT TC,TBLOCK+4 LDB TB,FI.NAM## ;NAMTAB LINK ADD TB,NAMLOC## MOVNI TC,5 MOVEM TC,CTR## B1: ADDI TB,1 MOVE TD,(TB) ;SIX CHARACTERS OF NAME TLNN TD,600000 JRST B2 ;NEXT ENTRY MOVEM TD,TBLOCK+5(TC) AOJL TC,B1 B2: HRLZI CH,AS.SIX## HRRI CH,5 ;5-WORD SIXBIT LITERAL PUSHJ PP,PUTAS1 MOVE TA,[POINT 6,TBLOCK] HRRZI TD,5 B3: HRRZI TC,6 MOVE TB,[POINT 6,CH] SETZ CH, B3.1: ILDB TE,TA JUMPE TE,B3.2 CAIN TE,":"-40 HRRZI TE,"-"-40 CAIN TE,";"-40 HRRZI TE,"."-40 B3.2: IDPB TE,TB SOJG TC,B3.1 PUSHJ PP,PUTAS1 SOJG TD,B3 HRLZI CH,AS.XWD## ;XWD HRRI CH,5 ;WORDS 6-10 PUSHJ PP,PUTAS1 HRRZ TA,CURFIL LDB CH,FI.NDV LDB TB,FI.DSD SKIPE TB TRO CH,(1B7) ;THIS IS A SORT FILE LDB TB,FI.RM2 SKIPN TB ;IF RECORDING MODE WAS NOT SET TRO CH,(1B8) ;SET FLAG FOR LIBOL MOVSS CH ;NUMBER OF DEVICES IN LEFT HALF MOVSI TB,(POINT 6,0,11) ;GET COBOL VERSION # HRRI TB,.JBVER## LDB TC,TB DPB TC,[POINT 6,CH,5] HRRI CH,AS.CNB## PUSHJ PP,PUTAS1 ;LEFT HALF OF WORD 6 HRRZ TA,CURFIL LDB CH,FI.VAL## JUMPE CH,B4.1 ;NULL LINK HRRZ TA,CH PUSHJ PP,REFTAG## ;REFERENCE IF TAG PUSHJ PP,PUTAS1 JRST B4.2 B4.1: HRRZI CH,AS.CNB PUSHJ PP,PUTAS1 B4.2: HRRZI CH,AS.CNB HRRZ TA,CURFIL LDB TB,FI.POS## DPB TB,[POINT 6,CH,17] ;POSITION IFN ANS68,< LDB TB,FI.NFL DPB TB,[POINT 5,CH,4] ;NUMBER OF FILE-LIMITS > IFN ANS74,< LDB TB,FI.FAM SKIPE TB ;LEAVE DEFAULT AS SEQENTIAL SUBI TB,1 ;LIBOL USES 0,1,2 FOR MODES DPB TB,[POINT 2,CH,4] ;FILE ACCESS MODE > PUSHJ PP,PUTAS1 LDB CH,FI.NXT## ;POINTER TO NEXT JUMPE CH,B4.3 ;FILE TABLE ENTRY IFN CD.FIL-4,< ANDI CH,077777 IORI CH,AS.FIL > PUSHJ PP,PUTAS1 JRST B4.4 B4.3: HRRZI CH,AS.CNB PUSHJ PP,PUTAS1 B4.4: MOVE TA,CURFIL SETZ CH, ;WORD 8 LDB TB,FI.NBF## ;NUMBER OF BUFFERS DPB TB,[POINT 6,CH,5] LDB TB,FI.MRS## ;MAXIMUM RECORD SIZE DPB TB,[POINT 12,CH,17] HRRI CH,AS.CNB PUSHJ PP,PUTAS1 HRRZ TA,CURFIL LDB CH,FI.RCT## ;RE-RUN COUNT MOVSS CH HRRI CH,AS.CNB PUSHJ PP,PUTAS1 HRRZ TA,CURFIL ;WORD 9 SETZ CH, LDB TB,FI.ERM ;RECORDING MODE CAIE TB, %RM.SA ;STANDARD ASCII? JRST B4.4D ;NO, GO ON. LDB TC, FI.RD## ;GET DENSITY. CAIE TC, %RD.2 ;ONLY 800, 1600 AND DEFAULT CAIN TC, %RD.5 ; DENSITY ARE ALLOWED. PUSHJ PP, CLE19. ;COMPLAIN. B4.4D: LDB TC,FI.ACC ;ACCESS MODE CAIN TC,%%ACC ;DO WE HAVE AN ACCESS MODE? MOVEI TC,%ACC.S ;NO, MAKE IT SEQUENTIAL. DPB TC,FI.ACC## CAIE TC,%ACC.I ;INDEXED? JRST .+3 ;NO CAIN TB,%RM.BN ;YES, MAY NOT BE BINARY. PUSHJ PP,CLE24 ;BAD NEWS DPB TB,[POINT 3,CH,9] DPB TC,[POINT 2,CH,17] LDB TB,FI.VLR## ;VARIABLE LENGTH. DPB TB,[POINT 1,CH,0] LDB TB,FI.LBL ;LABELS CAIN TB,%%LBL ;WERE THEY OMITTED (ON A SORT FILE)? MOVEI TB,%LBL.S ;YES, MAKE THEM STANDARD. DPB TB,FI.LBL DPB TB,[POINT 2,CH,3] LDB TB,FI.RER## ;RE-RUN END OF REEL DPB TB,[POINT 1,CH,10] LDB TB,FI.RRC## ;RE-RUN ON COUNT DPB TB,[POINT 1,CH,11] LDB TB,FI.OPT## DPB TB,[POINT 1,CH,13] LDB TB,FI.IRM ;INTERNAL MODE DPB TB,[POINT 2,CH,15] HRRI CH,AS.CNB LDB TB,FI.IOO JUMPE TB,.+2 TLO CH,4000 PUSHJ PP,PUTAS1 SETZ CH, ;WORD 9, RIGHT HALF HRRZ TA,CURFIL LDB CH,FI.DRL ;DATA RECORD LINK JUMPN CH,B4.6 B4.5: HRRZI CH,AS.CNB ;NULL PUSHJ PP,PUTAS1 JRST B4.7 B4.6: LDB TB,[POINT 3,CH,20] ;TYPE CODE CAIE TB,CD.DAT JRST B4.5 IFN CD.DAT-1,< ANDI CH,LMASKB IORI CH,AS.DAT > PUSHJ PP,PUTAS1 B4.7: SETZ CH, ;WORD 10 HRRZ TA,CURFIL LDB CH,FI.LRS## ;MAXIMUM LABEL RECORD SIZE MOVSS CH HRRI CH,AS.CNB PUSHJ PP,PUTAS1 HRRZ TA,CURFIL LDB CH,FI.SDL## JUMPE CH,B4.8 ;NULL LDB TB,[POINT 3,CH,20] CAIE TB,CD.FIL JRST B4.8 ;NOT A FILE IFN CD.FIL-4,< IFN CD.FIL,< ANDI CH,LMASKS > IORI CH,AS.FIL## > PUSHJ PP,PUTAS1 JRST B4.13 B4.8: HRRZI CH,AS.CNB PUSHJ PP,PUTAS1 B4.13: MOVE CH,[XWD AS.XWD,1] PUSHJ PP,PUTAS1 ;WORD 11 HRRZI CH,AS.CNB ;LEFT HALF LDB TB,FI.BLF DPB TB,[POINT 12,CH,17] ;BLOCKING FACTOR PUSHJ PP,PUTAS1 HRRZ TA,CURFIL LDB CH,FI.ACK## ;ACTUAL KEY IFN ANS68,< JUMPN CH,B4.13B > IFN ANS74,< JUMPE CH,B4.13Z LDB TB,[POINT 3,CH,20] ;GET CODE CAIE TB,AC.MSC## ;SPECIAL? JRST B4.13B ;NO, OUTPUT KEY HRLZ CH,CH ;PUT INCREMENT IN LHS TLZ CH,AS.MSC## TLO CH,AS.PAR## ;RELATIVE TO %PARAM HRRI CH,AS.MSC## ;SIGNAL MISC. JRST B4.13B ;OUTPUT IT B4.13Z:> LDB TB,FI.ACC## CAIE TB,%ACC.R ;RANDOM FILE? JRST B4.13A ;NO, PUT OUT A ZERO IFN ANS74,< LDB TB,FI.FAM## ;GET ACCESS MODE CAIG TB,%FAM.S ;SEQUENTIAL DOESN'T NEED KEY JRST B4.13A ;SO PUT OUT A ZERO HRRZI DW,E.727 ;?RELATIVE KEY MUST BE SUPPLIED > IFN ANS68,< HRRZI DW,E.240 > ;?NO ACTUAL KEY HRRZ TA,CURFIL LDB LN,FI.LN## ;POINT TO THE "SELECT" LDB CP,FI.CP## PUSHJ PP,FATAL B4.13A: HRRZI CH,AS.CNB B4.13B: PUSHJ PP,PUTAS1 LDB CH,FI.VID ;VALUE OF ID HRRZ TA,CH SKIPE TA PUSHJ PP,REFTAG## ;REFERENCE IF A TAG HRRZ TA,CURFIL PUSHJ PP,PUTBYT ;WORD 12 HRRZ TA,CURFIL LDB CH,FI.VDW PUSHJ PP,PUTBYT ;WORD 13 HRLZI CH,AS.XWD HRRI CH,5 PUSHJ PP,PUTAS1 MOVE TA,FI.SBA## MOVEM TA,PNTR## HRRZ TA,CURFIL LDB CH,PNTR ;SAME BUFFER AREA LINK JUMPE CH,B4.14Z ;NULL LDB TB,[POINT 3,CH,20] CAIE TB,CD.FIL JRST B4.14Z IFN CD.FIL-4,< IFN CD.FIL,< ANDI CH,077777> IORI CH,AS.FIL > PUSHJ PP,PUTAS1 JRST B4.15 B4.14Z: HRRZI CH,AS.CNB PUSHJ PP,PUTAS1 B4.15: SETZB TD,CTR B4.15L: HRRZ TA,CURFIL ILDB CH,PNTR ;'USE' POINTER JUMPE CH,B4.15Z ;NULL LDB TB,[POINT 3,CH,20] CAIE TB,CD.PRO JRST B4.15Z ;NOT PROTAB REPEAT 0,< ;[1006] CODE TESTED ON CONFLICTING USE HRRZ TD,CTR ;[1006] PROCEDURES, NO LONGER NECESSARY IMULI TD,3 SETZ TE, SKIPE TC,USES##(TD) PUSHJ PP,CLE14. SKIPE TC,USES+1(TD) PUSHJ PP,CLE14. SKIPE TC,USES+2(TD) PUSHJ PP,CLE14. JUMPN TE,B4.15Z > MOVE TA,CH PUSHJ PP,PUTPRF HRRZ TA,CH PUSHJ PP,REFTAG## ;GETS THE FILE USE-PROCEDURE TAGS JRST B4.15A B4.15Z: HRRZI CH,AS.CNB B4.15A: PUSHJ PP,PUTAS1 AOS TC,CTR IFN ANS68,< CAIGE TC,11 JRST B4.15L > IFN ANS74,< B4.16: HRRZ TA,CURFIL ILDB CH,PNTR TRNN CH,(1B2) TRZN CH,(1B0) ;IS IT USER NAME JRST B4.16A ;NO ADD CH,NAMLOC ;GET POINTER TO NAME HRRZ CH,(CH) ;GET DATAB PTR. DPB CH,PNTR ;STORE BACK SETOM RELKEY## ;SIGNAL PHASE E TO JUMP ROUND DECLARATIVES B4.16A: TRNE CH,700000 ;TYPE SET? JRST B4.16B ;YES MOVS CH,CH ;PUT VALUE IN LHS AND HRRI CH,AS.CNB ;OUTPUT AS CONST. B4.16B: PUSHJ PP,PUTAS1 AOS TC,CTR CAIGE TC,11 JRST B4.16 ;LOOP FOR ALL LINAGE STUFF > MOVE CH,[AS.XWD,,1] ;WORD 19 PUSHJ PP,PUTAS1 HRRZ TA,CURFIL ;LEFT HALF HRRZI CH,AS.CNB LDB TB,FI.RD## ;RECORD DENSITY DPB TB,[POINT 3,CH,2] LDB TB,FI.RP## ;RECORD PARITY LSH TB,-1 ;CONVERT 1 TO 0, 2 TO 1 FOR REAL FILE TABLE DPB TB,[POINT 1,CH,3] LDB TB,FI.DFR## ;GET DEFERRED OUTPUT ISAM BIT DPB TB,[POINT 1,CH,5] ;SET ACCORDINGLY LDB TB,FI.ENT## ;GET ERROR-PROC-ON-OPEN BIT DPB TB,[POINT 1,CH,6] ;SET RUN-TIME ACCORDINGLY LDB TB,FI.RMS## ;GET RMS BIT DPB TB,[POINT 1,CH,7] LDB TB,FI.BM## ;GET BYTE MODE BIT LDB TC,FI.ERM ;GET RECORDING MODE CAIN TC,%RM.BN ;CANNOT BE BINARY JUMPN TB,CLE29. ;AND BYTE MODE DPB TB,[POINT 1,CH,8] B4.16D: LDB TB,FI.CKP## ;GET CHECKPOINT BIT DPB TB,[POINT 1,CH,9] LDB TB,FI.CRC## ;GET CHECKPOINT RECORD COUNT DPB TB,[POINT 8,CH,17] PUSHJ PP,PUTAS1 HRRZ TA,CURFIL ;RIGHT HALF LDB CH,FI.VPP## ;PPN LINK PUSHJ PP,PUTAS1 HRRZ TA,CURFIL ;WORDS 20-21 LDB TC,FI.ACC ;ISAM FILE? CAIE TC,%ACC.I JRST B4.P ;NO, OUTPUT OCTAL 0'S IN WORDS 20-22 IFN ANS74,< LDB TB,FI.RKY ;MAKE SYMBOLIC KEY = RECORD KEY DPB TB,FI.SKY## ;AS EASIEST WAY TO FAKE OUT ISAM > IFN ANS68,< LDB TB,FI.SKY## ;SYMBOLIC KEY JUMPE TB,CLE26. ;NO SYMBOLIC KEY B4.IX1: > LDB TC,FI.RKY## ;RECORD KEY JUMPE TC,CLE27. ;NO RECORD KEY B4.IX2: MOVE TD,[TBLOCK+1,,TBLOCK+2] ;CLR STORAGE MOVEM TB,TBLOCK ;SAVE KEYS SETZM TBLOCK+1 BLT TD,TBLOCK+4 MOVEM TC,TBLOCK+5 CAIN TC,100001 ;[1074] IF DUMMY ENTRY (ERRORS EARLIER ON), JRST B4.SK5 ;[1074] SKIP THIS HRRZI TA,(TB) ;MAKE PTR TO SYMBOLIC KEY PUSHJ PP,LNKSET LDB TB,DA.CLA## ;CLASS MOVEM TB,TBLOCK+1 LDB TB,DA.USG## ;USAGE MOVEM TB,TBLOCK+2 LDB TB,DA.INS## ;SIZE MOVEM TB,TBLOCK+3 LDB TB,DA.NDP## ;# OF DECIMAL PLACES MOVEM TB,TBLOCK+4 IFN ANS68,< ;IF -74 WE KNOW THEY ARE THE SAME HRRZ TA,TBLOCK+5 ;COMPARE RECORD KEY INFO PUSHJ PP,LNKSET LDB TB,DA.INS ;GET SIZE OF RECORD KEY JUMPE TB,B4.SK5 ;WE HAVE AN ERROR, BYPASS REST OF TESTS SKIPN TBLOCK+3 ;IF NO SIZE TO SYMBOLIC KEY JRST B4.SK5 ;THEN WE HAVE AN ERROR SO BYPASS REST OF TESTS LDB TB,DA.CLA CAME TB,TBLOCK+1 JRST CLE20 ;CLASS NOT SAME AS SYMBOLIC KEY B4.SK1: LDB TB,DA.USG CAME TB,TBLOCK+2 JRST CLE21 ;USAGE NOT SAME B4.SK2: LDB TB,DA.INS CAME TB,TBLOCK+3 JRST CLE22 ;SIZE NOT SAME B4.SK3: LDB TB,DA.NDP CAME TB,TBLOCK+4 JRST CLE23 ;# DEC. PLACES NOT SAME B4.SK4: >;END IFN ANS68 LDB TB,DA.DFS## ;RECORD KEY IN RECORD? JUMPE TB,CLE25 ;NO B4.SK6: LDB TB,DA.POP## ;[735] FIND FILENAME LDB TE,[POINT 3,TB,20] ;[735] GET TYPE CAIN TE,CD.FIL ;[735] FILENAME? JRST B4.SK7 ;[735] YES - SEE IF ITS THE ONE MOVE TA,TB ;[735] NOT AT TOP YET PUSHJ PP,LNKSET ;[735] UP TO NEXT LEVEL... JRST B4.SK6 ;[735] LOOP UNTIL WE GET TO FILE B4.SK7: HLRZ TA,CURFIL ;[735] GET CURRENT FILE CAMN TA,TB ;[735] SAME FILE? JRST B4.SK5 ;[735] YES -- GO ON JRST CLE25 ;[735] NO - RECORD KEY IN WRONG FILE B4.SK5: MOVE CH,TBLOCK ;OUTPUT SYMBOLIC KEY BYTE PTR (WD 20) PUSHJ PP,PUTBYT HRLZI CH,AS.BYT## ;OUTPUT RECORD KEY BYTE PTR (WD 21) HRRI CH,AS.CNB PUSHJ PP,PUTAS1 HRRZ TA,TBLOCK+5 PUSHJ PP,LNKSET LDB CH,DA.LOC## ;REL. LOC OF KEY IN RECORD PUSHJ PP,PUTBX HRLZI CH,AS.XWD ;WORD 22 HRRI CH,1 PUSHJ PP,PUTAS1 MOVE TA,TBLOCK+1 ;GET CLASS OF KEY CAIE TA,%CL.NU ;NUMERIC SETZM TBLOCK+1 ;NON-NUMERIC -- SET TYPE = 0 HRRZ TA,TBLOCK+5 ;GET PTR TO RECORD KEY PUSHJ PP,LNKSET HRRZM TA,TBLOCK+5 LDB TB,DA.EDT## ;EDITING BIT ON? SKIPE TB SETZM TBLOCK+1 ;IF NUMERIC EDITED SET TYPE = 0 SKIPN TBLOCK+1 ;IF TYPE = 0, SKIP NUMERIC STUFF JRST B4.C2 MOVE TA,TBLOCK+2 ;USAGE CAIE TA,%US.C1 ;FLOATING? CAIN TA,%US.C2 TRNA JRST .+3 ;NO HRRZI TA,5 ;YES, SET TYPE = 5 JRST B4.C1 CAIE TA,%US.C3 ;COMP-3? JRST .+3 ;NO HRRZI TA,7 ;YES, SET TYPE = 7 JRST B4.C1 ;NOTE: IF SIZE IF >10, TYPE IS SET TO 10 CAIGE TA,%US.1C ;FIXED PT? JRST .+3 ;NO HRRZI TA,3 ;YES, SET TYPE = 3 JRST B4.C1 HRRZI TA,1 ;MUST BE DISPLY B4.C1: MOVEM TA,TBLOCK+1 ;STORE TYPE MOVE TA,TBLOCK+3 ;GET SIZE CAILE TA,^D10 ;MORE THAN 10 DIGITS? AOS TBLOCK+1 ;YES, ADD 1 TO TYPE HRRZ TA,TBLOCK+5 ;PTR TO REC. KEY LDB TB,DA.SGN## ;GET SIGN FLAG SETCA TB, ;COMPLEMENT IT DPB TB,[POINT 1,TBLOCK+3,20] B4.C2: HRRZ TA,CURFIL ;GET MODE LDB TB,FI.ERM SETZ TC, ;ASSUME SIXBIT CAIN TB,%RM.7B MOVEI TC,2 ;[1032] ASCII CAIN TB,%RM.EB ;[1032] TEST FOR EBCDIC MOVEI TC,1 ;[1032] DPB TC,[POINT 2,TBLOCK+3,19] ;[1032] HRRZI CH,AS.CNB ;OUTPUT LEFT HALF OF WD 22 HRL CH,TBLOCK+1 ;TYPE CODE PUSHJ PP,PUTAS1 HRRZI CH,AS.CNB ;RT. HALF HRL CH,TBLOCK+3 ;OTHER CODES PUSHJ PP,PUTAS1 JRST B4.Q B4.P: MOVEI TA,3 ;OCTAL 0'S TO WDS 20-22 MOVEM TA,CTR B4.S: MOVE CH,[AS.OCT,,1] PUSHJ PP,PUTAS1 SETZ CH, PUSHJ PP,PUTAS1 SOSLE CTR JRST B4.S B4.Q: ;WORD 23 LOOKS LIKE: ; BITS 0-8 OWNER ACCESS. ; BITS 9-17 OTHER ACCESS. ; BITS 18-35 COUNT OF RECORDS RETAINED. HRRZ TA, CURFIL ;POINT AT THE CURRENT FILE TABLE. MOVE CH, [AS.XWD,,1] ;A SINGLE XWD SHOULD SUFFICE. PUSHJ PP, PUTAS1 LDB TB, FI.OWA## ;OWNER ACCESS. DPB TB, [POINT 9,CH,8] LDB TB, FI.OTA## ;OTHER ACCESS. DPB TB, [POINT 9,CH,17] HRRI CH, AS.CNB PUSHJ PP, PUTAS1 LDB CH, FI.RTC## ;COUNT OF RECORDS RETAINED. MOVSS CH, CH HRRI CH, AS.CNB PUSHJ PP, PUTAS1 ;WORDS 24 THROUGH 31 ARE THE FILE STATUS WORDS. MOVE TD, FI.SPT## ;POINTER TO THEM IN THE FILE TABLE. ;WORD 24 - FILE STATUS. ; BITS 0-5 BYTE RESIDUE. ; BITS 6-11 BYTE SIZE. ; BITS 12-17 FIELD SIZE. ; BITS 18-35 ADDRESS. HRREI TE, -10 PUSHJ PP, PPTR ;WORD 25 - ERROR NUMBER. ; BITS 0-5 BYTE RESIDUE. ; BITS 6-11 BYTE SIZE. ; BITS 12-17 FIELD SIZE. ; BITS 18-35 ADDRESS. AOJGE TE, FSDN PUSHJ PP, PPTR ;WORD 26 - ACTION CODE. ; BITS 0-17 0 ; BITS 18-35 ADDRESS. AOJGE TE, FSDN PUSHJ PP, PIDX ;WORD 27 - VALUE OF ID. ; BITS 0-5 BYTE RESIDUE. ; BITS 6-11 BYTE SIZE. ; BITS 12-17 FIELD SIZE. ; BITS 18-35 ADDRESS. AOJGE TE, FSDN PUSHJ PP, PPTR ;WORD 28 - BLOCK NUMBER. ; BITS 0-17 0 ; BITS 18-35 ADDRESS. AOJGE TE, FSDN PUSHJ PP, PIDX ;WORD 29 - RECORD NUMBER. ; BITS 0-17 0 ; BITS 18-35 ADDRESS. AOJGE TE, FSDN PUSHJ PP, PIDX ;WORD 30 - FILE NAME. ; BITS 0-5 BYTE RESIDUE. ; BITS 6-11 BYTE SIZE. ; BITS 12-17 FIELD SIZE. ; BITS 18-35 ADDRESS. AOJGE TE, FSDN PUSHJ PP, PPTR ;WORD 31 - FILE TABLE ADDRESS. ; BITS 0-17 0 ; BITS 18-35 ADDRESS. AOJGE TE, FSDN PUSHJ PP, PIDX JRST FSDN ;ROUTINE TO PUT OUT A FILE STATUS POINTER FOR DISPLAY ITEMS. PPTR: JSP TB, PINT ;SET UP. LDB TB, DA.RES## ;RESIDUE. DPB TB, [POINT 6,CH,5] LDB TB, DA.USG## ;USAGE. CAIN TB, %US.D6 ;SIXBIT. MOVEI TC, 6 CAIN TB, %US.D7 ;ASCII. MOVEI TC, 7 CAIN TB, %US.EB ;EBCDIC. MOVEI TC, 11 DPB TC, [POINT 6,CH,11] LDB TB, DA.EXS## ;SIZE. DPB TB, [POINT 6,CH,17] HRRI CH, AS.CNB PPTR1: PUSHJ PP, PUTAS1 HRRZ TA, CURFIL ;POINT AT THE CURRENT FILE TABLE AGAIN. LDB CH, TD ;LOCATION. JRST PUTAS1 ;WRITE IT AND RETURN. ;ROUTINE TO PUT OUT A FILE STATUS POINTER FOR INDEX ITEMS. PIDX: JSP TB, PINT ;SET UP. HRRZI CH, AS.CNB ;NOTHING IN THE LEFT HALF. JRST PPTR1 ;INITIALIZATION ROUTINE. PINT: HRRZ TA, CURFIL ILDB TA, TD ;NEXT LINK. JUMPN TA, PINT2 ;JUMP IF THER IS ONE. PINT1: MOVE CH, [AS.OCT,,1] ;NONE, WRITE OUT ZEROES. PUSHJ PP, PUTAS1 SETZ CH, PUSHJ PP, PUTAS1 AOJL TE, PINT1 POPJ PP, PINT2: LDB TC, LNKCOD## ;GET ITS CODE. CAIE TC, CD.DAT ;DATAB? JRST PINT1 ;NO, MUST HAVE BEEN AN ERROR IN ; CLEANC. ANDI TA, 077777 ;GET THE OFFSET. ADD TA, DATLOC## ;MAKE IT ABSOLUTE. MOVE CH, [AS.XWD,,1] ;ONE XWD. PUSHJ PP, PUTAS1 JRST (TB) ;RETURN. FSDN: MOVEI TB,SZ.OFT ADDM TB,EAS1PC ;ADD IN THE FIXED PART OF THE FILE TABLE IFN ANS68,< HRRZ TA,CURFIL LDB TB,FI.NFL ;NUMBER OF FILE-LIMITS JUMPE TB,B5 ADDI TA,SZ.FIL HRLI TA,442200 MOVEM TA,PNTR ;BYTE POINTER HRLZI CH,AS.XWD HRRZI TE,(TB) ;NO. FILE LIMIT CLAUSES IMULI TE,3 ;NO. WORDS NEEDED HRRI CH,(TE) ASH TB,1 ;NO. HALFWORDS FOR LIMITS MOVEM TB,CFLM## ADDM TE,EAS1PC PUSHJ PP,PUTAS1 B4.16: ILDB CH,PNTR ;NEXT FILE-LIMIT JUMPE CH,B4.18 LDB TB,[POINT 3,CH,20] ;TYPE CODE CAIE TB,CD.DAT JRST B4.17 IFN CD.DAT-1,< ANDI CH,077777 IORI CH,AS.DAT > PUSHJ PP,PUTAS1 JRST B4.19 B4.17: CAIE TB,CD.TAG JRST B4.18 PUSHJ PP,PUTAS1 JRST B4.19 B4.18: HRRZI CH,AS.CNB PUSHJ PP,PUTAS1 B4.19: MOVE TB,PNTR TLNE TB,770000 JRST B4.20 ;NEED ANOTHER LIMIT HRRZI TB,4 HRRZI CH,AS.CNB PUSHJ PP,PUTAS1 SOJG TB,.-2 ;4 HALFWORDS B4.20: SOSLE CFLM JRST B4.16 > B5: HRRZ TA,CURFIL LDB TD,FI.LRS ;[236] GET LABEL RECORD SIZE SKIPN TD ;[236] MOVEI TD,^D80 ;[236] 80. CHARS IF STANDARD LABELS LDB TE,FI.MRS CAMGE TE,TD ;[236] MOVE TE,TD ;[236] USE THE LARGER LDB TD,FI.IRM CAIN TD,%RM.6B JRST B5.1 CAIE TD,%RM.7B SKIPA TD,[EXP 4] MOVEI TD,5 TRNA B5.1: MOVEI TD,6 IDIVI TE,(TD) CAIE TD,0 HRRZI TE,1(TE) HRRZM TE,TBLOCK ;RECORD AREA IN WORDS B5.2: LDB TB,FI.SRA## JUMPE TB,B5.3 ;NO SAME RECORD AREA HLRZ TC,CURFIL CAIN TC,(TB) JRST B5.3 HRRZI TA,(TB) PUSHJ PP,LNKSET LDB TB,FI.ADR## JUMPN TB,B5.5 ;RECORD AREA DEFINED LDB TE,FI.MRS LDB TD,FI.LRS CAIGE TE,(TD) HRRZI TE,(TD) LDB TD,FI.IRM CAIN TD,%RM.6B JRST .+5 CAIE TD,%RM.7B SKIPA TD,[EXP 4] MOVEI TD,5 TRNA MOVEI TD,6 IDIVI TE,(TD) CAIE TD,0 HRRZI TE,1(TE) CAMLE TE,TBLOCK HRRZM TE,TBLOCK JRST B5.2 B5.3: MOVE TA,CURFIL B5.4: LDB TB,FI.SAL## JUMPE TB,B5.6 ;NO SAME AREA LINK HLRZ TC,CURFIL CAIN TB,(TC) JRST B5.6 ;NO MORE HRRZI TA,(TB) PUSHJ PP,LNKSET LDB TB,FI.ADR JUMPN TB,B5.5 ;RECORD AREA DEFINED LDB TE,FI.MRS LDB TD,FI.LRS CAIGE TE,(TD) HRRZI TE,(TD) LDB TD,FI.IRM CAIN TD,%RM.6B JRST .+5 CAIE TD,%RM.7B SKIPA TD,[EXP 4] MOVEI TD,5 TRNA MOVEI TD,6 IDIVI TE,(TD) CAIE TD,0 HRRZI TE,1(TE) CAMLE TE,TBLOCK HRRZM TE,TBLOCK JRST B5.4 B5.5: LDB TB,FI.LOC## ;LOCATION OF RECORD AREA B5.51: HRRZ TA,CURFIL DPB TB,FI.LOC SETO TC, DPB TC,FI.ADR JRST B6 ;PUT OUT 'RELOC .+ B5.6: MOVEI CH,AS.MSC## HRLI CH,1+AS.REL## PUSHJ PP,PUTAS1 HRRZ CH,TBLOCK ANDI CH,077777 HRRZ TA,CURFIL LDB TB,FI.LBL CAIE TB,%LBL.S JRST B5.61 CAIGE CH,^D21 HRRZI CH,^D21 HRRZM CH,TBLOCK B5.61: IORI CH,AS.DOT## PUSHJ PP,PUTAS1 HRRZ TB,EAS1PC HRRZ TC,TBLOCK ADDM TC,EAS1PC ADD TB,FILTBL HRRZI TB,-SZ.DEV(TB) JRST B5.51 B6: HRRZ TA,CURFIL LDB TA,FI.NXT ;NEXT FILTAB ENTRY JUMPN TA,CLND ;ALL DONE WITH FILE TABLES - FALL THROUGH ;SEE IF WE HAVE TO ADJUST THE SIZE OF DEBUG-CONTENTS IFN ANS74,< MOVE TA,MAXDBC## ;GET MAX. RECORD SIZE SUBI TA,^D30/6 ;MINUS WHAT WE HAVE JUMPLE TA,ECLND ;NOTHING TO DO MOVEM TA,MAXDBC ;SAVE DIFFERENCE PUSH PP,FLGSW## ;SAVE CURRENT SETTING SETZM FLGSW ;TURN IT OFF TO AVOID SPURIOUS DEBUG-ITEM ERRORS MOVE TB,[SIXBIT /DEBUG:/] MOVEM TB,NAMWRD## MOVE TB,[SIXBIT /ITEM/] MOVEM TB,NAMWRD+1 SETZM NAMWRD+2 MOVE TB,[NAMWRD+2,,NAMWRD+3] BLT TB,NAMWRD+5 PUSHJ PP,TRYNAM## ;NAME BETTER EXIST JRST ECLND1 ;NO, GIVE UP HRRZ TA,0(TA) ;GET DATAB LINK PUSHJ PP,LNKSET MOVE TB,MAXDBC ;GET SIZE IN WORDS IMULI TB,6 HRL TB,TB ADDM TB,5(TA) ;MAKE IT BIGGER MOVE TB,[SIXBIT /CONTEN/] MOVEM TB,NAMWRD+1 MOVSI TB,'TS ' MOVEM TB,NAMWRD+2 PUSHJ PP,TRYNAM ;NAME BETTER EXIST JRST ECLND1 ;NO, GIVE UP HRRZ TA,0(TA) ;GET DATAB LINK PUSHJ PP,LNKSET MOVE TB,MAXDBC ;GET SIZE IN WORDS IMULI TB,6 HRL TB,TB ADDM TB,5(TA) ;MAKE IT BIGGER MOVE TB,[SIXBIT /TS:DIS/] MOVEM TB,NAMWRD+2 MOVE TB,[SIXBIT /PLAY:6/] MOVEM TB,NAMWRD+3 PUSHJ PP,TRYNAM ;NAME BETTER EXIST JRST ECLND1 ;NO, GIVE UP HRRZ TA,0(TA) ;GET DATAB LINK PUSHJ PP,LNKSET MOVE TB,MAXDBC ;GET SIZE IN WORDS IMULI TB,6 HRL TB,TB ADDM TB,5(TA) ;MAKE IT BIGGER AOS NAMWRD+3 ;DEBUG-CONTENTS-DISPLAY-7 PUSHJ PP,TRYNAM ;NAME BETTER EXIST JRST ECLND1 ;NO, GIVE UP HRRZ TA,0(TA) ;GET DATAB LINK PUSHJ PP,LNKSET MOVE TB,MAXDBC ;GET SIZE IN WORDS IMULI TB,5 HRL TB,TB ADDM TB,5(TA) ;MAKE IT BIGGER MOVEI TB,2 ADDM TB,NAMWRD+3 PUSHJ PP,TRYNAM ;NAME BETTER EXIST JRST ECLND1 ;NO, GIVE UP HRRZ TA,0(TA) ;GET DATAB LINK PUSHJ PP,LNKSET MOVE TB,MAXDBC ;GET SIZE IN WORDS IMULI TB,4 HRL TB,TB ADDM TB,5(TA) ;MAKE IT BIGGER ECLND1: POP PP,FLGSW ;RESTORE FIPS FLAGGER > ;SET 'USEBAS' AND PREPARE TO PUT OUT 'USE' TABLE ECLND: SKIPE TA,EAS1PC SUBI TA,SZ.DEV ;FILTBL POINTS AROUND ; FIRST DEVICE TABLE MOVEM TA,USEBAS## SETZM EAS1PC IFN ANS74,< SKIPE RELKEY## ;NEED %PARAM+0 FOR CONVERSION? AOS IMPPAR ;YES, RESERVE IT > IFN DBMS,< SETZM DBONLY## ;[401] START IN OFF POSITION SETZM TBLOCK+7 ;CLR CTR OF ERROR-STATUS DECL. PROCS. > IFN ANS74!DBMS,< PUSHJ PP,CUSETB ;SET UP PERFORMS FOR EACH E-S PROCEDURE > MOVEI TC,0 ;TC IS # OF WORDS PUT OUT MOVE TA,[XWD -USES.L##,USES##] ;IF NO SKIPN (TA) ;ENTRIES AOBJN TA,.-1 ;IN USE TABLE, JUMPGE TA,EC1.B ;DON'T PUT OUT ANYTHING IFN DBMS, ;[401] TURN ON SINCE AT LEAST ONE USE IS NON-DBMS MOVE CH,[XWD AS.XWD,SZ.OUS] ;PREPARE TO WRITE THE USES TABLE PUSHJ PP,PUTAS1 ;WRITE HEADER WORD ;EACH HALFWORD WILL BE WRITTEN OUT IN THE SAME ORDER THAT IT APPEARS ; IN USES, FOR EACH OF THE 20 WORDS. SETZB TA,CTR EC1: HLRZ TA,USES(TA) ;GET LH PUSHJ PP,CHKUSE ;DO IT MOVE TA,CTR HRRZ TA,USES(TA) ;GET RH PUSHJ PP,CHKUSE ;WRITE IT AOS TA,CTR ;COUNT WORDS WRITTEN CAIGE TA,SZ.OUS ;EXIT WHEN WROTE THEM ALL JRST EC1 ;ELSE LOOP IFN ANS74,< ;COPY USE PROCEDURE ADDRESSES FOR PHASE E MOVEI TC,0 ;PTR TO USP.XXXX MOVE TA,USES ;INPUT PUSHJ PP,PUTPTE ;PUT TAG FOR PHASE E MOVE TA,USES+5 ;OUTPUT PUSHJ PP,PUTPTE MOVE TA,USES+^D10 ;I-O PUSHJ PP,PUTPTE MOVE TA,USES+^D15 ;EXTEND PUSHJ PP,PUTPTE > HRRZI TC,SZ.OUS ;# WORDS WRITTEN EC1.B: IFN DBMS, ;ADD IN COUNT OF ERROR-STATUS PROCEDURES EXCH TC,IMPPAR## MOVEM TC,EAS1PC MOVE CH,[AS.REL+1,,AS.MSC] PUSHJ PP,PUTAS1 HRRZI CH,AS.DAT## PUSHJ PP,PUTAS1 JUMPLE TC,CPOPJ## HRRZ CH,TC ;NUMBER OF EXIT WORDS USED HRLI CH,AS.XWD PUSHJ PP,PUTAS1 HRRZI CH,AS.CNB EC1.L: PUSHJ PP,PUTAS1 PUSHJ PP,PUTAS1 SOJG TC,EC1.L POPJ PP, ;CHECK TO SEE IF USE PROCEDURE IN TA HAS A TAG, IF NOT, ; CREATE A PERFORM AND OUTPUT A TAG REFERENCE. CHKUSE: HRRZI CH,AS.CNB JUMPE TA,PUTAS1 ;NO USE PROCEDURE, OUTPUT 0 LDB TC,LNKCOD## CAIN TC,CD.PRO PUSHJ PP,PUTPRF PUSH PP,TA ;NEED TO SAVE TA HRRZ TA,CH PUSHJ PP,REFTAG## ;REFERENCE IF IT'S A TAG POP PP,TA JRST PUTAS1 IFN ANS74!DBMS,< ;SCAN USETAB FOR DEBUG AND ERROR-STATUS ENTRIES -- ; FOR EACH ONE SET UP A PERFORM OF THAT PROCEDURE, AND ; REMEMBER TAG OF THE PERFORM CUSETB: SETZM TBLOCK+5 ;[677] INIT DYNAMIC USETAB PTR AT TOP HRRZ TB,USELOC## ;[677] GET PTR TO START OF TABLE HRRZ TA,USENXT## ;GET PTR TO END OF USETAB SUB TA,TB ;[677] GET RELATIVE ADDRESS MOVEM TA,TBLOCK+6 ;[677] SAVE PTR TO END OF TABLE CUSET1: AOS TA,TBLOCK+5 ;BUMP USETAB PTR TO NEXT ENTRY CAMLE TA,TBLOCK+6 ;PAST END? POPJ PP, ;YES, RETURN ADD TA,USELOC## ;[677] MAKE ABSOLUTE ADDR. LDB TB,US.TYP## ;GET TYPE CODE IFN ANS74,< CAIN TB,%UT.DB ;DEBUGGING? JRST CUSET6 ;YES > IFN DBMS,< CAIE TB,%UT.ES ;THIS AN ERROR-STATUS ENTRY? > JRST CUSET4 ;NO IFN DBMS,< LDB TB,US.XTR## ;ANY EXTRA WORDS ALLOCATED? JUMPE TB,CUSET1 ;NO, MUST HAVE BEEN A BAD ENTRY AOS TBLOCK+7 ;BUMP ERROR-STATUS PROC COUNTER > IFN ANS74, HRRZ TB,USELOC## ;[677] GET ABS. START OF TABLE HRRZ TC,TA ;[677] TC:= ABS. PLACE IN TABLE SUB TC,TB ;[677] GET RELATIVE PLACE PUSH PP,TC ;[677] AND SAVE IT LDB TA,US.PRO## ;GET PROTAB LINK OF E-S SECTION PUSHJ PP,PUTPR2 ;ENTER PUTPRF ROUTINE POP PP,TA ;RESTORE USETAB PTR ADD TA,USELOC ;[677] MAKE ABS. POINTER DPB CH,US.PRO ;SAVE TAG ADDR OF PERFORM OF THAT SECTION IFN ANS68,< JRST CUSET3 > IFN ANS74,< LDB TB,US.TYP CAIE TB,%UT.DB ;IF DEBUG WE MAY NOT BE FINISHED JRST CUSET3 SKIPN TB,DBPARM## ;HAVE WE ALLOCATED %PARAM+N YET? JRST [AOS TB,IMPPAR ;NO, ALLOCATE IT SOJA TB,.+1] ;BUT USE PREVIOUS MOVEM TB,DBPARM LDB TB,US.XTR## ;ANY EXTRA WORDS? JUMPE TB,CUSET1 ;NO, WE ARE DONE LDB TC,US.CNT## ;YES, GET THE COUNT MOVNI TC,-1(TC) ;BUT NOT THE FIRST EXTRA WORD HRLZ TC,TC HRRI TC,2(TA) ;AOBJN POINTER TO USETAB CUSET5: HLRZ TA,(TC) ;GET FLOTAB POINTER ADD TA,FLOLOC## LDB TA,FL.PRO## ;GET PROTAB LINK ANDI TA,077777 ADD TA,PROLOC## MOVE TB,TBLOCK+5 ;GET USETAB LINK DPB TB,PR.DEB## ;SAVE IT IN PROTAB HRRZ TA,(TC) ;GET FLOTAB POINTER JUMPE TA,CUSET7 ;ALL DONE ADD TA,FLOLOC## LDB TA,FL.PRO## ;GET PROTAB LINK ANDI TA,077777 ADD TA,PROLOC## MOVE TB,TBLOCK+5 ;GET USETAB LINK DPB TB,PR.DEB## ;SAVE IT IN PROTAB CUSET7: AOBJN TC,CUSET5 ;LOOP MOVE TA,TBLOCK+5 ADD TA,USELOC LDB TC,US.CNT ;GET EXTRA WORDS ADDM TC,TBLOCK+5 JRST CUSET1 > CUSET4: LDB TC,US.XTR## ;ANY EXTRA WORDS? JUMPE TC,CUSET1 ;NO CUSET3: LDB TC,US.CNT## ;GET COUNT OF EXTRA WORDS IN USETAB ENTRY ;[435] THE USE TABLE LOOKS LIKE ;[435] CNT OF ERROR-STATUS,,ERROR-STATUS-1 ;[435] ERROR-STATUS-2,,ERROR-STATUS-3 ETC LSH TC,-1 ;[435] DIVIDE # OF ERROR-STATUS VALUES BY 2 AOS TC ;[435] ROUND UP TO GET NUMBER OF WORDS NEEDED ADDM TC,TBLOCK+5 ;[435] ADD TO DYNAMIC USETAB PTR JRST CUSET1 ;TRY NEXT ENTRY > CLE1.: HRRZI DW,E.202 ;NO DEVICES JRST CLER2. CLE2.: HRRZI DW,E.201 ;NO DATA RECORDS JRST CLER. CLE4.: HRRZI DW,E.199 ;VAL-ID AND VAL-DW REQUIRED JRST CLER. CLE5.: HRRZI DW,E.198 ;LABELS MUST BE STANDARD JRST CLER. CLE6.: HRRZI DW,E.197 ;ONLY ONE DEVICE ALLOWED JRST CLER2. IFN ANS68,< CLE7.: HRRZI DW,E.196 ;MULTIPLE REEL/UNIT NOT ALLOWED JRST CLER. CLE10.: HRRZI DW,E.193 ;FILE-LIMITS REQUIRED JRST CLER2. CLE11.: HRRZI DW,E.192 ;'BLOCK CONTAINS N RECORDS' MUST BE SPECIFIED JRST CLER. > CLE12.: HRRZI DW,E.97 ;NO FD HRRZ TA,CURFIL LDB LN,FI.LN## ;POINT TO THE "SELECT" LDB CP,FI.CP## JRST FATAL## CLE13.: HRRZI DW,E.365 ;FILE MUST BE ASCII IF WRITE ADV BIT ON JRST CLER2. IFN ANS68,< CLE14.: LDB TB,[POINT 3,TC,20] CAIE TB,CD.PRO JRST CLE14A MOVEM CH,TBLOCK+11 MOVEM TC,TBLOCK+12 MOVEM TD,TBLOCK+13 MOVEM TE,TBLOCK+14 HRRZ TA,CH PUSHJ PP,LNKSET LDB TA,PR.FLO## ADD TA,FLOLOC## LDB LN,FL.LN## LDB CP,FL.CP## HRRZI DW,E.505 ;CONFLICTING USES PUSHJ PP,FATAL## MOVE DW,TBLOCK+12 PUSHJ PP,PUTERA## MOVE CH,TBLOCK+11 MOVE TC,TBLOCK+12 MOVE TD,TBLOCK+13 SKIPA TE,TBLOCK+14 CLE14A: SETZM USES(TD) POPJ PP, CLE15.: HRRZI DW,E.301 JRST CLER2. ;BLOCKING FACTOR MUST BE GT. 0 FOR I-O USE > CLE18.: HRRZI DW,E.579 ;ADVANCING AND POSITIONING FOR THE SAME FILE. PJRST CLER2. CLE19.: HRRZI DW,E.585 ;ONLY DENSITIES OF 800 AND 1600 BPI PJRST CLER2. ; ARE ALLOWED ON STANDARD ASCII FILES. IFN ANS68,< CLE20: HRRZI DW,E.374 ;SYMBOLIC KEY & REC KEY NOT SAME CLASS PUSHJ PP,CLER2. JRST B4.SK1 CLE21: HRRZI DW,E.375 ;SYMBOLIC KEY & REC KEY NOT SAME USAGE PUSHJ PP,CLER2. JRST B4.SK2 CLE22: HRRZI DW,E.376 ;SYMBOLIC KEY & REC KEY NOT SAME SIZE PUSHJ PP,CLER2. JRST B4.SK3 CLE23: HRRZI DW,E.377 ;SYMBOLIC KEY & REC KEY NOT SAME # DEC PLACES PUSHJ PP,CLER2. JRST B4.SK4 > CLE24: HRRZI DW,E.378 ;INDEXED FILE MUST BE 6BIT OR ASCII JRST CLER2. CLE25: HRRZI DW,E.379 ;RECORD KEY NOT IN RECORD HRRZ TA,CURFIL LDB LN,FI.LN## ;POINT TO THE "SELECT" LDB CP,FI.CP## PUSHJ PP,FATAL## JRST B4.SK5 IFN ANS68,< CLE26.: HRRZI DW,E.393 ;SYMBOLIC KEY REQUIRED PUSHJ PP,CLER2. MOVEI TB,100001 ;DUMMY DATAB ENTRY JRST B4.IX1 > CLE27.: HRRZI DW,E.394 ;RECORD KEY REQUIRED PUSHJ PP,CLER2. MOVEI TC,100001 ;DUMMY DATAB ENTRY IFN ANS74,< MOVEI TB,100001 ;[747] DUMMY DATAB ENTRY > JRST B4.IX2 CLE28.: HRRZI DW,E.566 ;EBCDIC FILES MAY NOT PJRST CLER2. ;HAVE NON-STANDARD LABELS. CLE29.: HRRZI DW,E.596 ;CAN NOT BE BYTE MODE AND BINARY PUSHJ PP,CLER2. JRST B4.16D ;SO IGNORE BYTE MODE CLE30.: HRRZI DW,E.623 ;BLOCKING FACTOR TOO SMALL PJRST CLER2. CLER.: SKIPE TBLOCK+20 POPJ PP, CLER2.: HRRZ TA,CURFIL LDB LN,FI.FLN## ;POINT TO THE FD LDB CP,FI.FCP## JRST FATAL## PUTBYT: JUMPE CH,PBYT0 LDB TB,[POINT 3,CH,20] CAIE TB,CD.DAT JRST VALBYT HRRZM CH,CURDAT## ANDI CH,077777 IORI CH,AS.DAT HRLI CH,AS.BYT PUSHJ PP,PUTAS1 SETZ CH, HRRZ TA,CURDAT PUSHJ PP,LNKSET PUTBX: LDB TB,DA.RES## DPB TB,[POINT 6,CH,5] ;** Note: 3-APR-80 /DAW: ; Keys that are not DISPLAY get a 9-bit byte pointer ; by the nature of the code below. Code in CBLIO will not check ; the left half of the byte pointer when the compare against ; the file parameter is done for COMP keys. HRRZI TC,6 LDB TB,DA.USG CAIN TB,%US.D6 ;IS IT DISPLAY-6? JRST .+4 ;YES, GO ON. CAIN TB,%US.D7 ;HOW ABOUT DISPLAY-7? AOJA TC,.+2 ;YES, MAKE IT SEVEN BITS. HRRZI TC,^D9 ;MUST BE EBCDIC THEN. DPB TC,[POINT 6,CH,11] JRST PUTAS1 VALBYT: CAIE TB,CD.TAG JRST PBYT0 HRLI CH,AS.BYT ;BYTE POINTER PUSHJ PP,PUTAS1 HRLZI CH,440600 JRST PUTAS1 PBYT0: MOVE CH,[XWD AS.OCT,1] PUSHJ PP,PUTAS1 SETZ CH, JRST PUTAS1 IFN ANS74,< ; FOR EACH DECLARATIVE PROCEDURE, STORE THE TAG FOR PHASE E ;CALLED WITH TC= INDEX INTO USP.I BLOCK ; TA= PARAGRAPH ;EXIT WITH TAG STORED IN USP.I BLOCK, TC INCREMENTED PUTPTE: JUMPE TA,PUTPT2 ;JUMP IF NONE THERE PUSHJ PP,PUTPRF ;GET THE TAG HRRZM CH,USP.I##(TC) ;STORE THE INFO AOJA TC,CPOPJ ;INCREMENT TC AND RETURN PUTPT2: SETZM USP.I(TC) ;CLEAR LOCATION AOJA TC,CPOPJ ;INCREMENT TC AND RETURN >;END IFN ANS74 ;FOR EACH DECLARATIVE PROCEDURE, GENERATE THE FOLLOWING CODE: ; %TAG: PERF. %PARAM-LOC ; JRST DECL-PROC ; POPJ PP, PUTPRF: MOVEM TC,TBLOCK+10 JUMPE TA,PFZOUT LDB TB,LNKCOD CAIE TB,CD.PRO JRST PFZOUT IFN ANS74!DBMS,< PUTPR2: ;ENTER HERE FOR DEBUGGING AND ERROR-STATUS PROCEDURES> HRLZM TA,CURPRO## PUSHJ PP,LNKSET HRRM TA,CURPRO LDB CH,PR.PRF## JUMPN CH,PRFOUT IFN ANS74,< LDB CH,PR.SFI ;DID WE PREVIOUSLY ALLOCATE A TAG#? SKIPN CH ;YES, JUST USE IT > PUSHJ PP,GETTAG## HRRZ TA,CURPRO DPB CH,PR.PRF IFN ANS74,< DPB CH,PR.SFI## ;SO ERROR USE CAN FIND LABEL > PUSHJ PP,PRFSUB PRFOUT: HRRZ TA,CURPRO LDB CH,PR.PRF MOVE TC,TBLOCK+10 POPJ PP, PFZOUT: HRRZI CH,AS.CNB MOVE TC,TBLOCK+10 POPJ PP, PRFSUB: HRRZ TA,CURPRO LDB TB,PR.XTW## JUMPN TB,PRFXTW HRRZ TB,IMPPAR ANDI TB,077777 IORI TB,AS.PAR## DPB TB,PR.XTW AOS IMPPAR PRFXTW: SETO TB, DPB TB,PR.EXR## ;TURN ON EXIT REQUIRED FLAG HRLI CH,AS.%X## PUSHJ PP,PUTAS2## HRRZ TB,EAS2PC## ANDI CH,077777 HRRZ TD,CH ADD TD,TAGLOC## HRRM TB,(TD) MOVE CH,[XWD 201700,AS.MSC] ;MOVEI 16,%PARAM-LOC PUSHJ PP,PUTAS2 LDB CH,PR.XTW PUSHJ PP,PUTAS2 MOVE CH,[XWD 113740,PERF%##] ;PUSHJ 17,PERF. PUSHJ PP,PUTAS2 HLRZ CH,CURPRO ANDI CH,077777 IORI CH,AS.PRO## HRLI CH,076000 ;JRST PUSHJ PP,PUTAS2 HRLZI CH,137740 ;POPJ 17, PUSHJ PP,PUTAS2 MOVEI TB,4 ADDM TB,EAS2PC POPJ PP, SUBTTL CLEAN UP TABLES AND WRITE NAMTAB CLENTA: PUSHJ PP,CLEANT## ;CLEAN UP TABLES IFN DEBUG,< MOVE TA,CORESW## ;CK SWITCHES TLNE TA,%KILL## POPJ PP, ;DON'T DUMP NAMTAB IF /K ON > MOVE TE,NAMNXT## ;COMPUTE SIZE OF NAMTAB SUB TE,NAMLOC MOVEI TE,1(TE) ADD TE,NM12SZ## ;ADD SIZE OF NAMTAB MOVNS TE HRL TE,NM2LOC## ;FORM THE NAMTAB I/O LIST MOVSM TE,NAMIOL## SOS NAMIOL SETZM NAMIOL+1 OUT NAM,NAMIOL JRST CLENTB ;NO ERRORS OUTSTR [ASCIZ "%Couldn't write NAMTAB, compilation continuing without maps or object listing "] SWOFF FMAP!FOBJEC CLENTB: CLOSE NAM, HRRZ TE,FREESP## ;REDUCE SIZE OF IMPURE AREA IORI TE,1777 CORE TE, JRST CLENTE ;IGNORE ERRORS IFN DEBUG, CLENTE: MOVE TE,.JBREL## ADDI TE,1 HRRZM TE,TOPLOC## SUB TE,FREESP HRLM TE,FREESP POPJ PP, IFN DEBUG,< CLENTD: IDIVI TE,^D10 HRLM TD,(PP) SKIPE TE PUSHJ PP,CLENTD HLRZ CH,(PP) ADDI CH,"0" JRST PUTLST > END