; UPD ID= 3569 on 6/8/81 at 1:37 PM by NIXON TITLE COBOLC V12B SUBTTL DATA DIV. SYNTAX SCAN W.NEELY/CAM/SEB ;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 RPW==:RPW DBMS==:DBMS DEBUG==:DEBUG MCS==:MCS TCS==:TCS ;EDITS ;NAME DATE COMMENTS ;DAW 31-DEC-80 [1106] Don't give wrong error message when 88 level ; item has value clause and item is subordinate to an item ; whose usage is INDEX. ;DMN 14-NOV-80 [1071] GIVE ERROR MESSAGE WHEN VARIABLE PART IS NOT THE LAST THING IN RECORD. ;CLRH 9-APR-80 [1011] FIX EDIT 733 TO NOT REQUIRE DATA RECORD IF FD HAS ; A REPORT CLAUSE. ;DMN 28-MAR-80 [1003] FIX DUPLICATE CREF DEFINITION WHEN LEVEL # DECREASES. ;DMN 30-JAN-80 [763] CHECK FOR DUPLICATE LINKAGE AND REPORT SECTIONS. ;DMN 29-JAN-80 [760] MAKE "BLANK WHEN ZERO" WORK AGAIN FOR NUMERIC SENDING ITEM. ;DMN 24-OCT-79 [751] BAD DATAB DEFINITION IF FD NAME MATCHES PROGRAM ID. ;DMN 13-SEP-79 [733] GIVE ERROR IF NO DATA RECORD IN FD. ;V12A SHIPPED ;DMN 8-AUG-79 [723] FIX EDIT 706 TO POINT TO CORRECT RECORD ;DAW 22-MAY-79 [711] FIX ANOTHER ERROR IN 674 (INDEX ITEMS) ;DMN 16-MAY-79 [710] SET FLAG SHOWING WORKING-STORAGE SEEN ;CLRH 3-MAY-79 [706] CHECK RECORD CONTAINS CLAUSE AGAINST MAX. RECORD SIZE. ;DAW 27-APR-79 [700] FIX UNDESERVED ERROR FOR COMP-1 ITEMS WHEN ; EDIT 674 IS INSTALLED ;CLRH 3-APR-79 [674] GENERATE ERROR FOR BAD VALUE CLAUSE OF 88 LEVEL ITEM ;DAW 29-MAR-79 [672] FIX ILL MEM REF WHEN SOMEONE DEFINES A DATANAME "TALLY". ;DMN 6-MAR-79 [651] USE CORRECT BYTE POINTER TO TEST RPW CONTROL FLAGS ;DAW 21-FEB-79 [635] FIX WRONG SIZE COMPUTATION FOR ITEMS RENAMING ITEM-1 THRU ITEM-2 ;V12****************** ;DMN 5-JAN-79 [624] RECORD SIZE MUST MATCH RECORD CONTAINS IN F MODE FILE ;DMN 28-NOV-78 [603] FIX ILL UUO WHEN "CONTROL" IN "RD" REFERS TO EDITED ITEM. ;V11****************** ;NAME DATE COMMENTS ;EHM 16-DEC-78 [527] FIX CATASTROPHIE WHEN REPORT WRITER VALUE IS MESSED UP ;MDL 22-SEP-77 [513] IF INVALID DBMS PRIVACY KEY, GIVE FATAL ; AND BEGIN PROCESSING AFTER SCHEMA SECTION. ;V10***************** ;NAME DATE COMMENTS ;VR 13-SEP-77 [507] TO BUILD COBOL WITH DBMS==0, DBMS4==0 ; WHEN EDIT [476] IS INSTALLED ;VR 13-SEP-77 [503] TO BUILD COBOL WITH DBMS==0, DBMS4==0 ;DPL 24-MAY-77 [476] CHECK FOR PROPER SEQUENCE OF SECTION ; NAMES AND PROPER ALLOCATION OF DATA STORAGE ;MDL 26-APR-77 [471] GIVE APPROPRIATE ERROR MESSAGE WHEN OCCURS ; MAXIMUM EXCEEDED. ;VR 15-FEB-77 [465] LOCATE TOO LARGE DATA ITEM DEFINED BY ; OCCURS FOLLOWED BY OCCURS. GIVE FATAL ERROR. ;DPL 09-DEC-76 [453] MAKE /S WORK FOR DBMS PROGRAMS ;EHM 23-NOV-76 [451] LINKAGE SECTION MUST COME AFTER W-S IF ; THERE IS A SCHEMA SECTION OR A COMM SECTION ;SER 5-NOV-76 [450] FIX RENAMES THRU FOR DATA-NAME USED IN LINKAGE SECTION. ;EHM 14-SEP-76 [442] GIVE ERROR MESSAGES FOR COMMUNICATION SECTION ; OUT OF ORDER AND RESET THE LEVEL 77 FLAG ; 6-APR-76 [423] DON'T ATTEMPT TO MAKE CONTROL ID PREVIOUS IF ID IS ERROR ;DPL 23-MAR-76 [412] FIX COMM SECTION AND SCHEMA SECTION SHARING ; SAME DATA AREA. DA119A AND DA120. ; 29-JAN-76 FIX BLANK WHEN ZERO ;ACK 9-FEB-75 ADD COMP-3/EBCDIC CODE. ;SSC MAR-5-75 PLACED 6A EDIT %316 DIRECTLY INTO V10 ;ACK 5-MAR-75 REWRITE OF DA54. ;ACK 10-MAR-75 VALUE CLAUSE CODE FOR COMP-3/EBCDIC ;******************** ;DPL 24-MAY-77 [476] CHECK FOR PROPER SEQUENCE OF SECTION ; NAMES AND PROPER ALLOCATION OF DATA STORAGE ; EDIT 356 ALLOW LOWER CASE LETTERS FOR VALUE OF ID. ; EDIT 335 REPORT WRITER FATAL ERROR CONDITION. ; EDIT 331 CHECK FOR SCHEMA BEFORE FILE SECTION OR AFTER ANY OTHER SECTION ; EDIT 315 VARIOUS REPORT WRITER FIXES - SEE P.MAC ; EDIT 270 REMOVE EXTRA ERROR MSG WHEN VALUE OF ID UNDEFINED ; EDIT 264 FIXES ILL MEM REF WHEN ACTUAL KEY MISSING ; EDIT 260 FIX 01 DATAN .. ; EDIT 253 FIXES A RENAMES B. ; EDIT 247 FLAGS ERROR FOR ITEMS IN REPORT SECTION THAT ARE SUBCRIPTED. ; EDIT 243 FIXES PHASE E CRASHES BECAUSE OF ERROR IN OCCURS N ; TO P CLAUSE - ALSO ALLOWS N TO BE 0. ;[237] /JEF COBOLC.MAC, DIAGS.MAC QAR-2918 ; IDENTIFIERS GIVEN IN THE CONTROL CLAUSE MUST BE DEFINED ; ONLY IN THE FILE OR WORKING SECTIONS. ;[236] /ACK COBOLC.MAC, CLEAND.MAC ; RESERVE SPACE FOR LABEL RECORD IF LARGER THAN FD ; BUT DONT CHANGE FILE TABLE MAX-REC-SIZE ;[220] /ACK GENERATE AN ERROR IF A MINOR KEY IS THE SUBJECT OF AN OCCURS. ; EDIT 215 REPORT-WRITER CHECK THAT HEADER .LE. FIRST-DETAIL .LE. LAST-DETAIL .LE. FOOTING ; EDIT 175 PREVENT ASSEMBLY IF A RECORD ASSOCIATED WITH AN FD HAS NO FILE NAME ; EDIT 174 FIXES RD FILNAME COPY . ; EDIT 164A FIX TO 164 ; EDIT 164 FLAG AS FATAL ANY DEPENDING ITEM NOT 1-WORD COMP OR ; SUBSCRIPTED OR IN LINK SECTION. ; EDIT 162 GIVE WARNING THE FOLLOWING MAY NOT BE IN LINKAGE SECTION ; VALUE OF ID, DATE-WRITTEN, OR USER-NAME ; FILE-LIMITS, ACTUAL-KEY OR SYMBOLIC-KEY ; EDIT 152 FIXES ILLEGAL MEM REF FOR UNDEFINED VALUES OF ID ; DATE-WRITTEN, AND PPN. ; EDIT 110 NO MULTIPLE WORKING STORAGE ; RESERVE ALTERNATE AREAS GIVES TOO MANY BUFFERS ; ALTER STATEMENT GETS ERROR IF PRG COMPILED WITH /A. ; LAST STATEMENT IN PARA IS AN OPEN NOT TERMINATED BY A PERIOD GETS NO WARNING. TWOSEG SALL RELOC 400000 ENTRY COBOLC EXTERN CTREE,CPOPJ,CPOPJ1 EXTERN DA.DEF,DA.INS,DA.EXS,DA.OCC,DA.FAL,DA.RDS,DA.LN,DA.CP EXTERN DA.BWZ,DA.DPR,DA.EDT,DA.ERR,DA.JST,DA.NAM,DA.NDP,DA.NOC,DA.PIC EXTERN DA.PWA,DA.SGN,DA.SUB,DA.USG,DA.VAL EXTERN HL.COD,HL.LNK,HL.LNC,HL.NAM,HL.QAL EXTERN CFLM,CURCON,DATLVL,EAS2PC,FATALW,LEVEL EXTERN PUTCRF,PUTLNK EXTERN RDFLVL,RPWRDL,RUSAGE,THSCTL EXTERN CURRPW EXTERN LNKSET EXTERN RENLOC,RENNXT,RN.01,RN.66,XPNREN INTERN D54.NJ ; [315] COBOLC: SETFAZ C; SETZM FILSEC ;CLR FILE-SECTION-SEEN FLAG SETZM WRKSEC## ;CLR WORKING-STORAGE-SECTION-SEEN FLAG IFN RPW,< SETZM RPWERR## ; [335] CLEAR REPORT WRITER ERROR FLAG SETZM CURRPW ;CLR RPWTAB PTR SETZM LASTYP## ;CLR LAST RPW TYPE SEEN STORAGE SETZM LASCOL## ; [315] CLEAR LAST COLUMN MOVE TA,['000000'] ;INIT 6-DIGIT SIXBIT # MOVEM TA,SIXHLD > MOVE SAVPTR,ISVPTR## MOVE NODPTR,INDPTR## IFN DEBUG,< SWOFF FNDTRC; MOVE TE,CORESW## TRNE TE,TRACED## SWON FNDTRC; ;TRACE DD NODES > HRRZI TA,DD1.## PUSH NODPTR,TA PUSHJ PP,SQURL.## OUTSTR [ASCIZ /COBOLC--lost; too many POPJ's /] JRST KILL## SUBTTL ACTIONS FOR DD SYNTAX PROCESSING ;COME HERE TO POP UP ONE LEVEL IN THE SYNTAX TREE. INTER. DA0. DA0.: POP NODPTR,NODE ;POP UP CURRENT NODE IFN DEBUG, ;IF TRACING, PRINT NODE POPING UP TO POPJ PP, ;COME HERE AFTER WE SEE "DATA DIVISION" TO INITIALIZE. INTER. DA1. DA1.: SWOFF FFILSC; ;'FILE SECTION' FLAG MOVE SAVPTR,ISVPTR ;SAVE LIST POINTER HRRZI TA,1 PUSH SAVPTR,TA SETZM RDFLVL ;CLR REDEFINES NESTING LEVEL SETZM CURFIL SETZM CURDAT SETZM CURCON SETZM CURVAL## SETZM CURNAM## SETZM EAS1PC SETZM EAS2PC SETOM PCHOLD## SETZM SVDADR SETZM CFLM SETZM WSAS1P SETZM IDXLST## SETOM LSTW77## ;LAST LEVEL NUMBER WAS NOT 77. IFN RPW,< SETZM LASTRD## ;INIT LAST RD PTR > POPJ PP, INTER. DA2. DA2.: SWON FFILSC; SETOM FILSEC## ;SET FILE-SECTION-SEEN FLAG IFN RPW, ;CLR REPORT SECTION FLAG SETZM LNKSEC ;CLR LINKAGE SECTION FLAG IFN DBMS,< SETZM INVSEE## ;[%331] CLEAR THIS NOW SO ERROR HERE ;[%331] WONT CAUSE MANY LATER SKIPE SCHSEC## ;[%331] SEEN SCHEMA SECTION YET EWARNJ E.470 ;[%331] YES, OUT OF ORDER > ;[%331] END OF DBMS SPECIAL CHECK SKIPL TA,PCHOLD ;RESET EAS1PC TO PREVIOUS MOVEM TA,EAS1PC ; IF CHANGED BY LINKAGE SECTION SETOM PCHOLD MOVE TA,EAS1PC MOVEM TA,WSAS1P## SETZM EAS1PC SETZM EAS2PC SETZM CFLM POPJ PP, INTER. DA3. DA3.: SETZM LNKSEC ;CLR LINKAGE SECTION FLAG SKIPL TA,PCHOLD ;RESET EAS1PC TO PREVIOUS MOVEM TA,EAS1PC ; IF CHANGED BY LINKAGE SECTION SETOM PCHOLD DA3.0: SWOFF FFILSC; IFN RPW, ;CLR REPORT SECTION FLAG MOVE TA,WSAS1P MOVEM TA,EAS1PC SETZM EAS2PC SETZM CFLM SETZM LAST01## POPJ PP, ;WE COME HERE WHEN WE ARE FINISHED PROCESSING THE DATA DIVISION TO ; CLEAN THINGS UP. INTER. DA4. DA4.: PUSHJ PP,DA10. SKIPN SVDADR JRST D4.1 MOVE CH,SVDWRD## PUSHJ PP,PUTAS1 SETZM SVDADR D4.1: SETZM EAS2PC TSWT FFILSC; JRST D4.11 MOVE TA,WSAS1P MOVEM TA,EAS1PC D4.11: SKIPL TA,PCHOLD ;NEED TO RESTORE DATA DIV PC? MOVEM TA,EAS1PC ;YES SETOM PCHOLD ;PC HAS BEEN RESTORED SKIPN EAS1PC JRST DA4.A2 HLRZ TA,EAS1PC JUMPE TA,DA4.A2 AOS TA,EAS1PC HRRZM TA,EAS1PC DA4.A2: IFN ANS74,< SKIPN DEBSW## ;NEED DEBUG CODE? JRST DA4.A3 ;NO MOVE TB,[NAMWRD,,TBLOCK] ;NEED TO SAVE CURRENT NAME BLT TB,TBLOCK+4 ;SINCE TRACE CODE WILL PRINT IT AGAIN PUSH PP,FLGSW ;SAVE CURRENT STATE SETZM FLGSW ;ZERO SO WE DON'T FLAG DEBUG-ITEM PUSH PP,W1 ;SO TRACING IS CORRECT PUSH PP,W2 ;... PUSHJ PP,DA210. ;ALLOCATE DEBUG-ITEM POP PP,W2 POP PP,W1 POP PP,FLGSW MOVS TB,[NAMWRD,,TBLOCK] BLT TB,NAMWRD+4 ;RESTORE PREVIOUS NAME DA4.A3:> PUSHJ PP,CLEANC## ;DO CLEANC HERE SO SUM-CTRS GET ALLOCATED SKIPN SVDADR ; [315] SEE IF ANY "VALUE" ITEM LEFT JRST D4.12 ; [315] NONE LEFT MOVE CH,SVDWRD## ; [315] GET THE LAST "VALUE" DATA PUSHJ PP,PUTAS1 ; [315] PUT INTO AS1 FILE SETZM SVDADR ; [315] CLEAR IT D4.12: HRLZI CH,AS.REL## HRRI CH,1+AS.DAT## PUSHJ PP,PUTAS1 HRRZ CH,EAS1PC DA4.A: HRRZM CH,TBLOCK MOVE CH,[XWD AS.REL+1,AS.MSC##] PUSHJ PP,PUTAS1 HRRZ CH,TBLOCK CAILE CH,077777 HRRZI CH,077777 IORI CH,AS.DOT## PUSHJ PP,PUTAS1 HRRZ CH,TBLOCK SUBI CH,077777 JUMPG CH,DA4.A PUSHJ PP,CLRNAM## ;DELETE UNNECESSARY RESERVED WORDS ENDFAZ C; INTER. DA5. DA5.: MOVEM LN,TBLOCK DA5.0: MOVEM TYPE,TBLOCK+1 PUSHJ PP,GETITM## CAIE TYPE,AMRGN.+ENDIT. CAIN TYPE,ENDIT. ;EOF? POPJ PP, ;YES CAMN LN,TBLOCK JRST DA5.B MOVEM LN,TBLOCK CAIE TYPE,AMRGN.+LINKG. CAIN TYPE,AMRGN.+FILE. JRST DA5.X CAIE TYPE,AMRGN.+WORKI. CAIN TYPE,AMRGN.+PROC. JRST DA5.X IFN DBMS,< CAIE TYPE,AMRGN.+SCHEM. > CAIN TYPE,AMRGN.+FD. JRST DA5.X IFN MCS!TCS,< CAIE TYPE,AMRGN.+COMM. ;COMMUNICATION? CAIN TYPE,AMRGN.+CD. JRST DA5.X ;YES > CAIN TYPE,PRIOD. JRST DA5.0 CAIE TYPE,INTGR. CAIN TYPE,AMRGN.+INTGR. JRST DA5.X DA5.B: CAIN TYPE,PIC. PUSHJ PP,PSCAN## JRST DA5.0 DA5.X: MOVE TA,TBLOCK+1 CAIE TA,PRIOD. PUSHJ PP,CE125. SKPNAM INTER. DA7. DA7.: SWON FREGWD; POPJ PP, INTER. DA6. DA6.: SWOFF FREGWD; POPJ PP, INTER. DA8. DA8.: HLRZ TB,CURDAT JUMPE TB,DA8.X PUSHJ PP,DA54. IFN RPW, HLRZ TB,CURDAT PUSHJ PP,FNDPOP## JRST DA8.X LDB TC,[POINT 3,TB,20] CAIE TC,CD.DAT JRST DA8.X ;FATHER NOT DATTAB HRRZ TA,TB HRLZM TB,CURDAT HRRZI TA,(TB) PUSHJ PP,LNKSET HRRM TA,CURDAT JRST DA8. DA8.X: SETZM CURDAT POPJ PP, INTER. DA9. DA9.: PUSHJ PP,TRYNAM## PUSHJ PP,BLDNAM## HLRZS TA DPB TA,[POINT 15,W2,15] TLZ W1,GWNOT LDB TA,[POINT 15,W2,15] HRRZI TB,CD.FIL PUSHJ PP,FNDLNK## ;FIND A FILTAB ENTRY JRST DA9.E ;NONE FOUND MOVEM TB,CURFIL ;SAVE POINTER MOVE TA,TB LDB TB,FI.FDD## ;FD ALREADY SEEN? JUMPN TB,DA9.E2 ;YES IFN ANS74,< SKIPN FLGSW## ;NEED FIPS FLAGGER? JRST DA9.1 ;NO LDB LN,[POINT 13,W2,28] ;GET LN LDB CP,[POINT 7,W2,35] ; & CP LDB TB,FI.ORG## ;GET FILE ORGANIZATION PUSHJ PP,@[TST.L## ;SEQUENTIAL TST.LI## ;RELATIVE TST.H## ;INDEXED CPOPJ](TB) MOVE TA,CURFIL ;TA WAS DESTROYED BY TEST > DA9.1: SETO TB, DPB TB,FI.FDD DPB W2,FI.FLC## SETZM EAS1PC## SETZM EAS2PC SETZM CFLM POPJ PP, DA9.E: EWARNW E.20 DA9.E1: MOVE TA,[XWD CD.FIL,SZ.FIL] PUSHJ PP,GETENT MOVEM TA,CURFIL HRRZI TB,CD.FIL DPB TB,[POINT 3,0(TA),2] LDB TB,[POINT 15,W2,15] DPB TB,FI.NAM## DPB W2,FI.FLC HRRZI TC,%%RM LDB TE,FI.RM2## ;RECORDING MODE CLAUSE SEEN? SKIPN TE ;YES, DON'T CHANGE DPB TC,FI.ERM## DPB TC,FI.IRM## HRRZI TC,%%LBL DPB TC,FI.LBL## HRRZI TC,%%ACC DPB TC,FI.ACC## HRRZI TC,1 DPB TC,FI.NDV## AOS TC,NFILES## ;GET # OF FILES; BUMP COUNTER DPB TC,FI.NUM## ;STORE # IN FILE TABLE MOVE TA,[XWD CD.VAL,1] PUSHJ PP,GETENT MOVE TB,[ASCII /*****/] HRRZI TC,4 DPB TC,[POINT 7,TB,6] MOVEM TB,(TA) HLRZ TB,TA MOVE TA,CURFIL DPB TB,FI.VAL## LDB TB,[POINT 15,W2,15] HRRI TA,(TB) PUSHJ PP,PUTLNK MOVE TA,CURFIL JRST DA9.1 DA9.E2: EWARNW E.34 JRST DA9.E1 IFN ANS74,< INTER. DA10R. DA10R.: FLAGAT RP JRST DA10. INTER. DA10S. DA10S.: FLAGAT HI SKPNAM > INTER. DA10. DA10.: PUSHJ PP,DA8. D10A.0: MOVE TA,CURFIL JUMPE TA,DA10.X HRRZ TB,CFLM HRRZI TD,(TB) HRRZ TC,EAS2PC SUBI TD,(TC) CAIGE TD,5 HRRZI TB,5(TC) MOVE TE,EAS1PC TLNE TE,777777 HRRZI TE,1(TE) CAIGE TB,(TE) HRRZI TB,(TE) HRRZM TB,EAS1PC SETZM EAS2PC SETZM CFLM HRRZ TA,CURFIL SETZM TBLOCK LDB TA,FI.DRL## JUMPE TA,DA10.B ;NO DATA RECORDS D10A.1: HRLZM TA,CURDAT PUSHJ PP,LNKSET HRRM TA,CURDAT LDB TB,DA.DEF JUMPN TB,.+3 ;THIS RECORD IS DEFINED PUSHJ PP,D10E.1 JRST D10A.2 LDB TB,DA.EXS SKIPN TC,TBLOCK HRRZM TB,TBLOCK CAMN TB,TBLOCK ;SAME SIZE RECORDS? JRST D10A.3 ;YES CAMLE TB,TBLOCK HRRZM TB,TBLOCK HRRZ TA,CURFIL## ;POINT AT THE FILE. LDB TB,FI.ERM## ;GET ITS RECORDING MODE. SETOI TC, ;GET SOME ONES. CAIE TB,%RM.EB ;IF THE RECORDING MODE IS NOT DPB TC,FI.VLR## ; EBCDIC, SET THE VARIABLE LENGTH LDB TC,FI.VLR## ; FLAG. IF IT IS EBCDIC AND JUMPN TC,D10A.2 ; THE VARIABLE LENGTH FLAG IS HRRZ TA,CURDAT## ; NOT ON, COMPLAIN. LDB LN,DA.LN LDB CP,DA.CP MOVEI DW,E.584 ;ALL RECORDS IN A FILE WHOSE PUSHJ PP,FATAL## ; RECORDING MODE IS F OR EBCDIC ; MUST BE OF THE SAME LENGTH. D10A.2: HRRZ TA,CURDAT D10A.3: LDB TB,DA.FAL JUMPN TB,DA10.B ;NO MORE DATA RECORDS LDB TA,DA.BRO## JUMPN TA,D10A.1 ;CHECK THIS RECORD DA10.B: HRRZ TA,CURFIL LDB TB,FI.MRS ;[624] WAS THERE A RECORD CONTAINS CLAUSE? JUMPE TB,DA10.F ;[624] NO, SO NOTHING TO WORRY ABOUT HRRZ TC,TBLOCK ;[624] YES, IS IT THE SAME SIZE AS MAX. RECORD? JUMPE TC,DA10.F ;LAST RECORD WAS A RENAMES SO IGNORE IT CAIN TB,(TC) ;[624] JRST DA10.F ;[624] YES, SO NO PROBLEM LDB TB,FI.ERM ;[624] GET ITS RECORDING MODE. CAIN TB,%RM.EB ;[706] IF THE RECORDING MODE IS EBCDIC, JRST DA10.G ;[706] GO CHECK FOR VARIABLE LENGTH HRRZ TA,CURFIL ;[723] [706] OTHERWISE, IT IS NOT EBCDIC, LDB TA,FI.DRL ;[723] SO FIND MAX. RECORD JUMPE TA,[HRRZ TA,CURFIL ;[733] POINT TO FD LDB TB,FI.RPG ;[1011] IF ITS A REPORT FILE JUMPN TB,DA10.K ;[1011] THEN ITS OK NOT TO HAVE A DATA-RECORD MOVEI DW,E.201 ;[733] NO DATA RECORD LDB LN,FI.FLN## ;[733] LDB CP,FI.FCP## ;[733] JRST DA10.J] ;[733] GIVE ERROR MESSAGE DA10.E: PUSHJ PP,LNKSET ;[723] LDB TB,DA.EXS ;[723] GET SIZE CAMN TB,TBLOCK ;[723] IS THIS IT? JRST DA10.H ;[723] YES LDB TB,DA.FAL ;[723] JUMPN TB,DA10.F ;[723] GIVE UP, NO MORE RECORDS LDB TA,DA.BRO ;[723] JRST DA10.E ;[723] TRY THIS ONE DA10.H: LDB LN,DA.LN ;[723] [706] SO GET LINE LDB CP,DA.CP ;[706] AND CHARACTER POSITION MOVEI DW,E.622 ;[706] FOR WARNING PUSHJ PP,WARN ;[706] AND TELL THE USER SOMETHING MAY BE WRONG HRRZ TA,CURFIL ;[706] JRST DA10.F ;[706] AND CONTINUE DA10.G: LDB TC,FI.VLR## ;[706] [624] IT'S EBCDIC, IS IT VARIABLE LENGTH (V) JUMPN TC,DA10.F ;[624] YES, IT'S OK HRRZ TA,CURDAT ;[624] IT'S F MODE, WARN THE USER LDB LN,DA.LN ;[624] LDB CP,DA.CP ;[624] MOVEI DW,E.614 ;[624] MAX. RECORD SIZE MUST MATCH DA10.J: PUSHJ PP,FATAL ;[733] [624] RECORD CONTAINS CLAUSE IN FD HRRZ TA,CURFIL ;[624] DA10.F: HRRZ TB,TBLOCK ;[624] DPB TB,FI.MRS DA10.K: SETZ TB, ;[1011] LDB TC,FI.LBL CAIN TC,%LBL.S ;STANDARD LABELS? HRRZI TB,^D80 ;SIZE OF STANDARD LABEL HRRZM TB,TBLOCK LDB TA,FI.LRL## ;LABEL RECORD LINK JUMPE TA,DA10.C ;NO NON-STANDARD LABELS D10B.1: HRLZM TA,CURDAT PUSHJ PP,LNKSET HRRM TA,CURDAT LDB TB,DA.DEF JUMPN TB,.+3 PUSHJ PP,D10E.1 JRST D10B.2 LDB TB,DA.EXS SKIPN TC,TBLOCK HRRZM TB,TBLOCK CAMN TB,TBLOCK ;SAME SIZE RECORDS? JRST D10B.3 ;YES CAMLE TB,TBLOCK HRRZM TB,TBLOCK SETO TB, HRRZ TA,CURFIL DPB TB,FI.VLR D10B.2: HRRZ TA,CURDAT D10B.3: LDB TB,DA.FAL JUMPN TB,DA10.C ;NO MORE LABEL RECORDS LDB TA,DA.BRO JUMPN TA,D10B.1 DA10.C: HRRZ TA,CURFIL HRRZ TB,TBLOCK DPB TB,FI.LRS## ;MAXIMUM LABEL RECORD SIZE ;[236] LDB TC,FI.MRS ;COMPARE LABEL SIZE AGAINST DATA SIZE ;[236] CAMG TC,TB ;[236] DPB TB,FI.MRS ;LABEL IS BIGGER--REPLACE MRS JRST DA10.X D10E.1: HRRZ TA,CURDAT LDB LN,DA.LN## LDB CP,DA.CP HRRZI DW,E.104 ;'NOT DEFINED' JRST FATAL DA10.X: SETZM CURFIL SETZM CURDAT SETZM DATLVL ;INIT LAST DATA LEVEL HOLD SETZM LSTDAT## ;& CLR LAST DATA-ITEM-NOT-A-REDEF TABLE MOVE TA,[LSTDAT,,LSTDAT+1] BLT TA,LSTDAT+^D49 POPJ PP, INTER. DA11. DA11.: TLNE W1,GWNLIT ;IS ITEM NUMERIC LITERAL? TLNE W1,GWDP ;YES, IS IT INTEGER? JRST DA11.E ;NO HLRZ TB,W1 ANDI TB,177 ;NO. OF CHARACTERS MOVEM TB,CTR## HRRZI TA,LITVAL## PUSHJ PP,GETVAL MOVEM TC,0(SAVPTR) POPJ PP, DA11.E: SETZB TC,0(SAVPTR) EWARNJ E.25 INTER. DA12. DA12.: SETZ TC, PUSH SAVPTR,TC PUSHJ PP,DA11. POP SAVPTR,TC CAML TC,0(SAVPTR) MOVEM TC,0(SAVPTR) POPJ PP, INTER. DA13. DA13.: SETZ TB, EXCH TB,0(SAVPTR) CAIL TB,^D4096 ;REQUIRE BLK FACTOR .LE. 4095 EWARNJ E.2 ;IT ISN'T SKIPE TA,CURFIL DPB TB,FI.BLF## POPJ PP, INTER. DA13A. DA13A.: SKIPN TA,CURFIL POPJ PP, LDB TB,FI.BLF LDB TC,FI.FBS JUMPE TB,DA7. ;SHOULD HAVE SEEN RECORD JUMPN TC,DA7. ;BUT NOT CHARACTERS DPB TC,FI.BLF ;YES, SO SWAP EFFECT DPB TB,FI.FBS ;OF SEEING RECORD TOO SOON POPJ PP, INTER. DA14. DA14.: SETZ TB, EXCH TB,(SAVPTR) SKIPE TA,CURFIL DPB TB,FI.FBS## ;BUFFER SIZE POPJ PP, INTER. DA15. DA15.: SETZ TB, EXCH TB,0(SAVPTR) SKIPN TA,CURFIL POPJ PP, LDB TC,FI.MRS## ;DATA RECORD SIZE CAIGE TC,(TB) DPB TB,FI.MRS POPJ PP, INTER. DA16. DA16.: MOVE TA,FI.DRL ;DATA RECORD LINK MOVEM TA,PNTS## MOVE TA,DA.DRC## MOVEM TA,PNTS2## SETO TB, SKIPE TA,CURFIL DPB TB,FI.DRC## IFN ANS68,< POPJ PP, > IFN ANS74,< JRST DA25F. ;TEST FOR FIPS FLAGGER > IFN ANS68,< INTER. DA17. DA17.: MOVE TA,FI.LRL ;LABEL RECORD LINK MOVEM TA,PNTS MOVE TA,DA.LRC## MOVEM TA,PNTS2 POPJ PP, > INTER. DA18. DA18.: PUSHJ PP,TRYNAM PUSHJ PP,BLDNAM MOVEM TA,CURNAM TLZ W1,GWNOT HLRS TA DPB TA,[POINT 15,W2,15] DA18.P: MOVE TA,[XWD CD.DAT,SZ.DAT+SZ.DOC+SZ.MSK] PUSHJ PP,GETENT## MOVEM TA,CURDAT LDB TB,[POINT 15,W2,15] IORI TB,CD.DAT*1B20 MOVSM TB,0(TA) DPB W2,DA.LNC## SETZ TB, ;LEVEL 0 IS USED FOR 'PRE-NAMED' DATA ITEMS DPB TB,DA.LVL SETO TB, DPB TB,DA.CLA## ;CLASS DPB TB,DA.PWA TSWF FFILSC; DPB TB,DA.DFS## SKIPN TA,CURFIL JRST DA18.X MOVE TA,CURDAT DPB TB,PNTS2 ;SET 'LABEL RECORD' OR 'DATA RECORD' BIT MOVE TA,CURFIL LDB TB,PNTS ;GET 'DATA RECORD' OR 'LABEL RECORD' PTR JUMPE TB,DA18.V ;THIS IS FIRST SUCH RECORD HLRZ TC,CURDAT DPB TC,PNTS MOVE TA,CURDAT DA18.Q: DPB TB,DA.BRO ;BROTHER LINK DA18.W: LDB TB,[POINT 15,W2,15] HRRI TA,(TB) JRST PUTLNK DA18.T: PUSHJ PP,FNDNXT## JRST DA18.P LDB TC,DA.LVL## ;LEVEL OF ITEM CAIE TC,1 ;RECORD JRST DA18.T ;NO MOVEM TA,TBLOCK MOVEM TB,TBLOCK+1 HLRS TB ;GET RELATIVE ADDRESS IN R. H. PUSHJ PP,FNDPOP ;FIND FATHER LINK HLRZ TC,CURFIL CAMN TB,TC ;CURRENT FILE? EWARNJ E.35 ;YES MOVE TA,TBLOCK MOVE TB,TBLOCK+1 JRST DA18.T DA18.V: HLRZ TB,CURDAT DPB TB,PNTS SETO TB, MOVE TA,CURDAT DPB TB,DA.FAL ;'FATHER LINK' FLAG HLRZ TB,CURFIL JRST DA18.Q DA18.X: MOVE TA,CURDAT JRST DA18.W INTER. DA19. DA19.: HRRZI TC,%LBL.S ;'STANDARD LABELS' CODE CHKLBL: MOVE TA,CURFIL JUMPE TA,CPOPJ LDB TB,FI.LBL CAIE TB,%%LBL ;INITIAL STATE? EWARNJ E.16 ;NO--ERROR DPB TC,FI.LBL POPJ PP, INTER. DA20. DA20.: HRRZI TC,%LBL.O ;'OMITTED LABELS' CODE JRST CHKLBL IFN ANS68,< INTER. DA21. DA21.: HRRZI TC,%LBL.N ;'NON-STANDARD LABELS' CODE MOVE TA,FI.LRL MOVEM TA,PNTS MOVE TA,DA.LRC MOVEM TA,PNTS2 JRST CHKLBL > INTER. DA22. DA22.: MOVEI TA,%HL.VI ;'VALUE OF IDENTIFICATION' FLAG MOVEM TA,PNTS POPJ PP, INTER. DA23. DA23.: FLAGAT NS MOVEI TA,%HL.VD ;'VALUE OF DATE-WRITTEN' FLAG MOVEM TA,PNTS POPJ PP, ;GET LITERAL VALUE OF IDENTIFICATION INTER. DA24I. DA24I.: HLRZ TB,W1 ;GET LENGTH OF LITERAL ANDI TB,777 CAIG TB,^D9 ;9 CHARS OR LESS? JRST DA24I1 ;YES MOVEI TB,^D9 ;NO, TRUNCATE HRRZI DW,E.238 ;& WARN PUSHJ PP,DA24X. MOVEM TB,TBLOCK+2 JRST DA24I2 DA24I1: MOVEM TB,TBLOCK+2 ;SAVE TRUE SIZE CAIL TB,^D9 ;LESS THAN 9 CHARS? JRST DA24I2 ;NO HRRZI DW,E.334 ;YES, WARN PUSHJ PP,DA24X. MOVEI TB,^D9 DA24I2: PUSHJ PP,DA24S. ;SET PTRS & CTR SETZM TBLOCK+1 ;CLR NON-STANDARD CHAR FLAG MOVE TD,TBLOCK+2 ;GET TRUE SIZE DA24I3: SOJGE TD,DA24I4 ;SKIP IF NOT FINISHED WITH REAL CHARS MOVEI TE,40 ;GET A SPACE TO PAD OUT TO 9 CHARS JRST DA24I6 DA24I4: ILDB TE,TB ;GET LITERAL CHAR CAIN TE,40 ;MAKE SURE CHAR IS A-Z OR 0-9 OR SPACE JRST DA24I6 ;IT'S SPACE CAIL TE,"a" ; [356] IF LOWER CASE CAILE TE,"z" ; [356] TRNA ; [356] IT IS NOT. TRZ TE,40 ; [356] CONVERT TO UPPER CASE CAIL TE,"0" CAILE TE,"Z" JRST DA24I5 ;NON-STANDARD CHAR CAILE TE,"9" CAIL TE,"A" JRST DA24I6 ;CHAR IS OK DA24I5: AOS TBLOCK+1 ;REQUEST NON-STD CHAR WARNING DA24I6: IDPB TE,TC ;STORE LITERAL CHAR SOSLE TBLOCK ;COUNT CHARS INCLUDING PADDING JRST DA24I3 ;DO NEXT CHAR SKIPE TBLOCK+1 ;NEED A NON-STD CHAR WARNING? PUSHJ PP,DA24W. ;YES MOVE TD,FI.VID## ;GET PTR TO VAL-OF-ID DA24I8: HRRZ TA,CURFIL ;FILTAB ADDR HLRZ TB,CURVAL ;VALTAB REL ADDR LDB TC,TD ;VALUE SEEN BEFORE? JUMPN TC,JCE16. ;YES, DUPLICATE CLAUSE DPB TB,TD ;NO, STORE VALTAB LINK POPJ PP, ;GET LITERAL VALUE OF DATE-WRITTEN INTER. DA24D. DA24D.: HLRZ TB,W1 ;GET LENGTH OF LITERAL ANDI TB,777 CAIGE TB,6 ;FEWER THAN 6 CHARS? EWARNJ E.333 ;YES, THAT'S ILLEGAL CAIG TB,6 ;MORE THAN 6? JRST DA24D1 ;NO, OK MOVEI TB,6 ;YES, TRUNCATE HRRZI DW,E.238 ;& WARN PUSHJ PP,DA24X. DA24D1: PUSHJ PP,DA24S. ;SET PTRS & CTR SETZM TBLOCK ;CLR NON-STANDARD CHAR FLAG DA24D2: SOJL TD,DA24D3 ;SKIP IF FINISHED ILDB TE,TB ;GET LITERAL CHAR CAIL TE,"0" ;IS IT A DIGIT? CAILE TE,"9" AOS TBLOCK ;NO, REQUEST FLAG IDPB TE,TC ;STORE LITERAL CHAR JRST DA24D2 ;DO NEXT CHAR DA24D3: SKIPE TBLOCK ;NEED A NON-STD CHAR WARNING? PUSHJ PP,DA24W. ;YES MOVE TD,FI.VDW## ;GET PTR TO VAL-OF-DATE-WRITTEN JRST DA24I8 ;GET LITERAL VALUE OF PROJECT-PROGRAMMER INTER. DA24P. DA24P.: HLRZ TB,W1 ;GET LENGTH OF LITERAL ANDI TB,777 TLNE W1,GWNLIT ;IS IT A NUMERIC LITERAL? TLNE W1,GWDP ;DOES IT HAVE A DECIMAL POINT EWARNJ E.336 ;NOT AN INTEGER CAILE TB,6 ;MORE THAN 6 CHARS? EWARNJ E.336 ;YES PUSHJ PP,DA24S. ;SET PTRS & CTR DA24P2: SOJL TD,DA24P3 ;SKIP IF FINISHED ILDB TE,TB ;GET LITERAL CHAR CAIL TE,"0" ;IS IT AN OCTAL DIGIT? CAILE TE,"7" EWARNJ E.336 ;ILLEGAL CHARACTER IDPB TE,TC ;STORE LITERAL CHAR JRST DA24P2 ;DO NEXT CHAR DA24P3: HRRZ TA,CURFIL ;FILTAB ADDR HLRZ TB,CURVAL ;VALTAB REL ADDR LDB TC,FI.VPP## ;1ST HALF OF PPN ALREADY IN? SKIPN TC ;IF SO, 2ND HALF ASSUMED IN NEXT VALTAB ENTRY DPB TB,FI.VPP ;NO, STORE 1ST HALF VALTAB LINK POPJ PP, ;SUBROUTINE TO SET UP PTRS AND CTR FOR TRANSFERRING LITERAL TO VALTAB DA24S.: MOVEM TB,TBLOCK ;SAVE LENGTH OF LITERAL ADDI TB,5 IDIVI TB,5 ;NUMBER OF WORDS HRRZ TA,TB HRLI TA,CD.VAL PUSHJ PP,GETENT MOVEM TA,CURVAL ;SAVE VALTAB ADDR HLR W1,TA ;PUT POINTER IN W1 MOVE TB,[POINT 7,LITVAL] ;'GET' POINTER MOVE TC,[POINT 7,(TA),6] ;'PUT' POINTER MOVE TD,TBLOCK ;SIZE DPB TD,TC POPJ PP, ;ISSUE A WARNING FOR NON-STD CHAR IN VALUE ITEM DA24W.: HRRZI DW,E.242 ;NON-STD CHAR DA24X.: LDB LN,[POINT 13,W2,28] ;GET LINE POSITION LDB CP,[POINT 7,W2,35] JRST WARN ;2ND HALF OF PROJ-PROGRAMMER NUMBER MISSING INTER. DA24PE DA24PE: MOVE TA,[XWD CD.VAL,1] ;GET 1-WORD VALTAB ENTRY PUSHJ PP,GETENT MOVSI TB,5400 ;PUT A "0" IN VALTAB MOVEM TB,(TA) EWARNJ E.335 ;FATAL ERROR ;TEST FOR LEVEL 1 SYNTAX (I.E. SEQ 1, REL 1, IDX 1) IFN ANS74,< INTER. DA25F. DA25F.: SKIPN FLGSW## ;NEED FIPS FLAGGER? POPJ PP, ;NO MOVE TA,CURFIL LDB TB,FI.ORG## ;GET FILE ORGANIZATION JRST @[TST.L ;SEQUENTIAL TST.LI ;RELATIVE TST.H ;INDEXED CPOPJ](TB) ;TEST FOR LEVEL 2 SYNTAX (I.E. SEQ 2, REL 2, IDX 2) INTER. DA25G. DA25G.: SKIPN FLGSW## ;NEED FIPS FLAGGER? POPJ PP, ;NO MOVE TA,CURFIL LDB TB,FI.ORG## ;GET FILE ORGANIZATION JRST @[TST.HI ;SEQUENTIAL TST.HI ;RELATIVE TST.H ;INDEXED CPOPJ](TB) >;END IFN ANS74 INTER. DA25. DA25.: IFN ANS74,< PUSHJ PP,DA25G. ;SEE IF FIPS FLAGGER WANTED > PUSHJ PP,DA60S. ;SAVE NAMTAB ADDR PUSHJ PP,DA25S. ;SET UP HLDTAB ENTRY HRRZ TB,PNTS ;STORE 'VALUE OF XXX' FLAG DPB TB,HL.COD HLRZ TB,CURFIL ;STORE FILTAB LINK IN HLDTAB DPB TB,HL.LNK POPJ PP, ;SET UP HLDTAB ENTRY DA25S.: MOVE TA,[XWD CD.HLD,SZ.HLD] ;GET A HLDTAB ENTRY PUSHJ PP,GETENT MOVEM TA,CURHLD## ;SAVE ADDR HLRZ TB,CURNAM ;PUT LINK TO NAMTAB IN HLDTAB DPB TB,HL.NAM## DPB W2,HL.LNC## ;ALSO POSITION OF ITEM IN SOURCE SETZ TB, ;CLR # OF QUALIFIERS DPB TB,HL.QAL## POPJ PP, ;CHECK LEVEL NUMBER FOR 01 LEVEL ITEMS INTER. DA26. DA26.: PUSHJ PP,DA11. ;GET VALUE OF INTEGER DA26N.: SKIPG TC,0(SAVPTR) JRST DA26.E SETZM LSTW77## ;ASSUME THIS IS LEVEL 77. CAIE TC,^D77 ;IS IT? SETOM LSTW77## ;NO, REMEMBER THAT. IFN RPW,< SKIPN REPSEC ;IN REPORT SECTION? JRST DA26.1 ;NO CAILE TC,LVL.49 ;YES, ONLY 1-49 ARE LEGAL. JRST DA26.E ;COMPLAIN. CAIE TC,LVL.01 ;IF IT'S 01, NOTE THAT WE JRST DA26.A ; HAVEN'T SEEN A LINE OR SETZM RWLCS.## ; COLUMN CLAUSE YET. SETZM RWCCS.## JRST DA26.A > DA26.1: CAIN TC,^D66 JRST DA26.R ;LEVEL 66 CAILE TC,LVL.49 ;49. IS MAX. LEVEL NUMBER CAIN TC,^D77 ;EXCEPT FOR 77 JRST DA26.A DA26.E: EWARNW E.64 HRRZ TC,LEVEL CAILE TC,0 CAILE TC,LVL.49 HRRZI TC,LVL.01 MOVEM TC,0(SAVPTR) DA26.X: PUSHJ PP,SAVLVL ;LEAVE TRACKS FOR REDEFINES SETZM RUSAGE## ;INIT GROUP ITEM USAGE CHECK IFN ANS74,< SKIPN FLGSW## ;FIPS FLAGGER REQUESTED? POPJ PP, ;NO LDB TB,GWVAL## ;GET SIZE OF LITERAL CAIE TB,2 ;MUST BE TWO CHARACTERS PUSHJ PP,FLG.HI## ;NO, FLAG AT HIGH-INTERMEDIATE LEVEL > POPJ PP, DA26.A: CAIN TC,^D77 ;77. HRRZI TC,LVL.77 MOVEM TC,LEVEL CAIE TC,LVL.01 CAIN TC,LVL.77 ;77-LEVEL ITEM JRST DA26.X HRRZI TC,LVL.01 MOVEM TC,LEVEL EWARNJ E.48 DA26.R: IFN ANS74,< SKIPE FLGSW## ;FIPS FLAGGER REQUESTED? PUSHJ PP,FLG.HI## ;YES, FLAG AT HIGH-INTERMEDIATE LEVEL > HRRZI TC,LVL.66 HRRZM TC,LEVEL HRRZI NODE,DD165.## HRRZM NODE,0(NODPTR) POPJ PP, ;REMEMBER THIS DATA LEVEL FOR REDEFINES ;ALSO IF LEVEL INCREASING, CLEAN UP PART OF TABLE BELOW THIS SAVLVL: IFN RPW,< SKIPE REPSEC ;NOT NEEDED BY REPORT SECTION POPJ PP, > MOVE TA,(SAVPTR) ;NEW LEVEL CAIN TA,^D77 ;CONVERT 77 TO 1 MOVEI TA,1 CAML TA,DATLVL## ;ARE WE GOING UP A LEVEL? JRST SAVLV1 ;NO HRLZI TB,LSTDAT+1(TA) ;YES, CLEAR BELOW THIS LEVEL HRRI TB,LSTDAT+2(TA) SETZM LSTDAT+1(TA) BLT TB,LSTDAT+^D49 SAVLV1: MOVEM TA,DATLVL ;REMEMBER THIS LEVEL POPJ PP, ;SET UP DATAB ENTRY FOR 01 LEVEL ITEMS INTER. DA27. DA27.: IFN RPW,< SKIPL REPSEC ;IN REPORT SECTION AND NOT PAGE- OR LINE-CTR? JRST .+3 ;NO SKIPN NAMWRD ;YES, DOES ITEM HAVE A NAME? JRST DA27.S ;NO > IFN ANS68,< MOVE TB,NAMWRD ;[672] DON'T LET HIM DEFINE TALLY CAMN TB,[SIXBIT /TALLY/] ;[672] JRST [EWARNW E.283 ;[672] ?IMPROPER NAME FOR INDEPENDENT ITEM JRST DCA3.] ;[672] SKIP TO PERIOD AND POP NODE IN TREE >;END IFN ANS68 TLO W2,GWDEF ;PUT DEFINING REFERENCE ON CREF FILE HRRZI TB,(TYPE) ;(EXCEPT FILLERS) ANDI TB,1777 CAIE TB,FILLE. PUSHJ PP,PUTCRF## DA27A: PUSHJ PP,TRYNAM PUSHJ PP,BLDNAM MOVEM TA,CURNAM HLRZS TA ;NAMTAB POINTER DPB TA,[POINT 15,W2,15] TLZ W1,GWNOT; HRRZI TB,CD.DAT PUSHJ PP,FNDLNK ;FIND DATTAB LINK JRST DA27.N ;NONE DA27.0: MOVE TA,TB ;GET LEVEL LDB TC,DA.LVL CAIE TC,LVL.01 CAIN TC,LVL.77 JRST .+2 JUMPN TC,DA27.B ;NOT AN INDEPENDENT ITEM HRRZI TB,(TYPE) ANDI TB,1777 CAIN TB,FILLE. JRST DA27.B ;FILLER MOVEM TA,TBLOCK+15 MOVEM TB,TBLOCK+16 HLRZ TB,TA ;REL. ADDR. OF ITEM PUSHJ PP,FNDPOP SETZ TB, IFN RPW,< SKIPLE TD,REPSEC ;DOING REPORT SECTION PAGE- OR LINE-CTR? JUMPE TB,D27.E3 ;YES, IF OTHER ITEM HAS NO FATHER, ERROR JUMPN TD,D27.B0 ;ALL REPORT ITEMS NOW SKIP AHEAD > HLRZ TD,CURFIL CAIE TB,(TD) JRST D27.B0 TSWT FFILSC; JRST D27.E1 ;IN W-S==ERROR MOVE TA,TBLOCK+15 HLRZM TA,TBLOCK ;REL. ADDR. OF RECORD HRRZ TA,CURFIL LDB TB,FI.DRL ;DATA RECORDS CHAIN DA27.A: JUMPE TB,DA27.C CAMN TB,TBLOCK JRST DA27.F ;IT IS A DATA RECORD PUSHJ PP,FNDBRO## ;FIND BROTHER LINK JRST DA27.C ;NONE JRST DA27.A DA27.C: HRRZ TA,CURFIL LDB TB,FI.LRL ;LABEL RECORDS CHAIN D27.C1: JUMPE TB,D27.E2 CAMN TB,TBLOCK JRST DA27.F ;IT IS A LABEL RECORD PUSHJ PP,FNDBRO JRST D27.E2 JRST D27.C1 D27.B0: MOVE TA,TBLOCK+15 MOVE TB,TBLOCK+16 DA27.B: PUSHJ PP,FNDNXT JRST DA27.N JRST DA27.0 DA27.N: TSWF FFILSC; JRST D27.E2 ;IN FILE SECTION---ERROR DA27.S: MOVE TA,[XWD CD.DAT,SZ.DAT] D27N.1: PUSHJ PP,GETENT MOVEM TA,CURDAT IFN MCS!TCS,< SKIPN COMSEC## ;IN COMM SECTION? JRST D27MCX ;NO, NORMAL PROCESSING PUSH PP,TA PUSH PP,W1 PUSH PP,W2 MOVE TA,LAST01 PUSHJ PP,LNKSET ;GET ADDRESS OF LAST DATAB ENTRY HLRZ TC,(TA) ;GET NAMTAB LINK DPB TC,[POINT 15,W2,15] HRRZ W1,LAST01 PUSHJ PP,DA30. POP PP,W2 POP PP,W1 POP PP,TA D27MCX:> LDB TB,[POINT 15,W2,15] DPB TB,DA.NAM## HRRZI TB,CD.DAT DPB TB,[POINT 3,(TA),2] HRRZ TB,LEVEL## DPB TB,DA.LVL SETO TB, DPB TB,DA.CLA DPB TB,DA.DEF SKIPN LNKSEC ;LINKAGE SECTION? JRST D27MCY ;[***] NO MOVE TB,EAS1PC ;[***] YES, GET CURRENT VALUE OF EAS1PC MOVEM TB,LNK1PC## ;[***] AND SAVE FOR LATER SETO TB, ;[***] SETZM EAS1PC ;YES, RESET DATA PC DPB TB,DA.LKS## ; SET LINKAGE FLAG IN ENTRY D27MCY: TSWF FFILSC ;[***] DPB TB,DA.DFS DPB W2,DA.LNC LDB TB,DA.NAM IFN RPW,< SKIPL REPSEC ;RPW SECTION AND NOT PAGE- OR LINE-CTR? JRST D29XIT ;NO SETZM THSCTL ;CLR STORE FOR CURRENT CF CONTROL HRRZ TB,RPWRDL## ;LINK ITEM TO FATHER REPORT HRRZ TA,CURDAT DPB TB,DA.POP SETO TB, DPB TB,DA.FAL PUSHJ PP,GETRDL ;MAKE PTR TO RD ENTRY LDB TB,RW.FGP## ;GET LINK TO LAST GROUP ITEM SEEN HLRZ TC,CURDAT ;GET LINK TO NEW GROUP DPB TC,RW.FGP ;STORE LINK TO NEW GROUP IN RD ENTRY JUMPE TB,D27XIT ;EXIT IF THIS WAS THE 1ST GROUP ITEM HRRZ TA,CURDAT ;LINK NEW GROUP BACK TO LAST AS A BROTHER DPB TB,DA.BRO SETZ TB, DPB TB,DA.FAL D27XIT: MOVE TA,CURDAT ;SET UP FOR PUTLNK LDB TB,DA.NAM JRST D29XIT > D27.E1: MOVE TA,CURDAT SETO TB, DPB TB,DA.ERR EWARNJ E.60 D27.E2: HLRZ TB,CURFIL ;[751] GET FILE TABLE POINTER JUMPE TB,D27.E5 ;[751] ERROR IF NOT DEFINED MOVE TA,[XWD CD.DAT,SZ.DAT+SZ.DOC+SZ.MSK] PUSHJ PP,D27N.1 HLRZ TB,CURFIL HRRZ TA,CURDAT DPB TB,DA.POP## SETO TB, DPB TB,DA.FAL DPB TB,DA.DRC DPB TB,DA.PWA HRRZ TA,CURFIL LDB TB,FI.DRL HLRZ TC,CURDAT DPB TC,FI.DRL JUMPE TB,D27E22 HRRZ TA,CURDAT DPB TB,DA.BRO SETZ TB, DPB TB,DA.FAL HRRZ TA,CURFIL D27E22: LDB TB,FI.DRC JUMPE TB,D27F.1 EWARNW E.228 JRST D27F.1 DA27.F: HRLZM TB,CURDAT HRRZI TA,(TB) PUSHJ PP,LNKSET## HRRM TA,CURDAT LDB TC,DA.DEF SETO TB, DPB TB,DA.DEF HRRZ TB,LEVEL DPB TB,DA.LVL DPB W2,DA.LNC JUMPN TC,JCE16. D27F.1: HRRZ TB,EAS2PC## EXCH TB,EAS1PC TLZE TB,777777 HRRZI TB,1(TB) CAMLE TB,CFLM HRRZM TB,CFLM POPJ PP, D27.E5: PUSHJ PP,DA27.S ;[751] BUILD SMALL DATAB ENTRY MOVEI DW,E.13 ;NO FILE NAME FOR THIS RECORD [175] JRST FATALW ; FATAL ERROR AND FFATAL SW ON [175] JCE25.: EWARNJ E.25 ;?POSITIVE INTEGER REQUIRED JCE183: EWARNJ E.183 JCE268: EWARNJ E.268 JCE269: EWARNJ E.269 ;PAGE-COUNTER OR LINE-COUNTER INDEPENDENTLY DEFINED IN WORKING-STORAGE D27.E3: LDB LN,DA.LN ;GET POSITION OF W-S ITEM LDB CP,DA.CP HRRZI DW,E.399 JRST FATAL ;CHECK LEVEL NUMBER FOR ALL ITEMS BELOW 01 LEVEL INTER. DA28. DA28.: SKIPG TA,0(SAVPTR) JRST DA28.E ;ERROR IF .LE. 0 CAIN TA,LVL.01 JRST DA28.A CAIG TA,LVL.49 ;IF THE LEVEL INDICATES A SPECIAL SKIPGE LSTW77## ; ITEM, OR THE LAST ITEM WAS NOT JRST DA28.5 ; A LEVEL 77 ITEM, GO ON. EWARNW E.567 ;COMPLAIN. A LEVEL 77 ITEM WAS ; FOLLOWED BY AN ITEM WITH A LEVEL ; BETWEEN 02 AND 49. HRLZI TA,() ;FAKE AN 01 LEVEL. MOVEM TA,NAMWRD## HRLZI TA,() MOVEM TA,LITVAL JRST DA28.F ;GO PRETEND IT'S AN 01. DA28.5: IFN RPW,< SKIPN REPSEC ;IN REPORT SECTION? JRST DA28.0 ;NO CAIG TA,LVL.49 ;YES, ONLY 01-49 ALLOWED POPJ PP, ;OK JRST DA28.E ;TOO BIG > DA28.0: PUSHJ PP,SAVLVL ;LEAVE TRACKS FOR REDEFINES MOVE TA,(SAVPTR) ;RESTORE TRUE LEVEL # CAIE TA,^D77 ;LEVEL 77 JRST DA28.B TSWF FFILSC; EWARNW E.46 DA28.A: PUSHJ PP,DA7. JRST DA0. DA28.B: CAIE TA,^D88 ;88-LEVEL? JRST DA28.R HRRZI NODE,DD93A.## ;YES HRRZM NODE,(NODPTR) IFN ANS74,< SKIPE FLGSW## ;FIPS FLAGGER REQUESTED? PUSHJ PP,FLG.HI## ;YES, FLAG AT HIGH-INTERMEDIATE LEVEL > POPJ PP, DA28.R: CAIN TA,^D66 JRST DA28.S ;LEVEL 66 IFN ANS74,< SKIPN FLGSW## ;FIPS FLAGGER REQUESTED? JRST DA28.D ;NO LDB TB,GWVAL## ;GET SIZE OF LITERAL CAIG TA,LVL.10 ;YES, SEE IF IN NUCLEUS 2 (GT 10) CAIE TB,2 ;OR NOT TWO CHARACTERS PUSHJ PP,FLG.HI## ;YES, FLAG AT HIGH-INTERMEDIATE LEVEL DA28.D:> CAIG TA,LVL.49 POPJ PP, DA28.E: EWARNW E.64 ;LEVEL NUMBER NOT LEGAL HRRZ TA,LEVEL CAILE TA,0 CAILE TA,LVL.49 DA28.F: HRRZI TA,LVL.01 MOVEM TA,0(SAVPTR) JRST DA28.A DA28.S: HRRZI NODE,DD86A.## HRRZM NODE,0(NODPTR) IFN ANS74,< SKIPE FLGSW## ;FIPS FLAGGER REQUESTED? PUSHJ PP,FLG.HI## ;YES, FLAG AT HIGH-INTERMEDIATE LEVEL > JRST DA7. ;SET UP DATAB ENTRY FOR ALL ITEMS BELOW 01 LEVEL INTER. DA29. DA29.: IFN RPW,< SKIPN REPSEC ;IN REPORT SECTION? JRST .+3 ;NO SKIPN NAMWRD ;YES, DOES ITEM HAVE A NAME? JRST DA29.0 ;NO > TLO W2,GWDEF ;PUT DEFINING REFERENCE ON CREF FILE HRRZI TB,(TYPE) ;IF ITEM IS FILLER, SKIP PUTCRF ANDI TB,1777 CAIE TB,FILLE. PUSHJ PP,PUTCRF TLZN W1,GWNOT ;[373] IF DEFINED ALREADY JRST DA29.0 ;[373] THEN DON'T ENTER AGAIN PUSHJ PP,TRYNAM PUSHJ PP,BLDNAM HLRZ TB,TA DPB TB,[POINT 15,W2,15] ;NOTE: COMMENTS ADDED 9-FEB-75 /ACK ; ACTUALLY THE WHOLE THING SHOULD BE REWRITTEN, BUT THERE IS NO TIME. DA29.0: HRRZ TC,0(SAVPTR) ;GET THE LEVEL NUMBER. CAIN TC,^D66 ;LEVEL 66? JRST DA29.R ;YES, GO WORRY OVER RENAME STUFF. CAIN TC,^D77 ;LEVEL 77? HRRZI TC,LVL.01 ;YES, PRETEND IT'S LEVEL 01 FOR A WHILE. HRRZ TA,CURDAT ;GET THE CURRENT ITEM'S DATAB ADR. JUMPE TA,DA29.A ;NO CURRENT ITEM. LDB TB,DA.LVL ;PICK UP THE CURRENT ITEM'S LEVEL NUMBER. CAIL TB,(TC) ;IS THE CURRENT ITEM'S LEVEL NUMBER ; LESS THAN THE NEW ITEM'S? JRST DA29.B ;NO, NEW ITEM SAME OR LOWER LEVEL NUMBER ;WE GET HERE IF THE LEVEL NUMBER OF THE NEW ITEM IS GREATER THAN THE ; LEVEL NUMBER OF THE CURRENT ITEM. DA29.A: IFN RPW, ;[315] CLEAR THE LAST COL NO. ;WE GET HERE IF THERE IS NO CURRENT ITEM OR THE LEVEL NUMBER OF THE ; NEW ITEM IS GREATER THAN THE CURRENT ITEM'S. ; SET UP AND INITIALIZE A DATAB ENTRY. MOVE TA,[XWD CD.DAT,SZ.DAT] ;GET A DATAB ENTRY. PUSHJ PP,GETENT LDB TB,[POINT 15,W2,15] ;GET THE NAMTAB LINK. DPB TB,DA.NAM ;PUT IT IN THE DATAB ENTRY. HRRZI TB,CD.DAT ;I AM A DATAB ENTRY. DPB TB,[POINT 3,(TA),2] HRRZ TB,0(SAVPTR) ;GET THE LEVEL NUMBER BACK. CAIN TB,^D77 ;LEVEL 77? HRRZI TB,LVL.77 ;YES USE ^O77 SINCE WE ONLY HAVE 6 BITS. HRRZM TB,LEVEL ;REMEMBER WHAT LEVEL WE'RE AT. DPB TB,DA.LVL ;PUT THE LEVEL NUMBER IN DATAB. SETO TB, ;GET SOME ONES. DPB TB,DA.CLA ;CLASS NOT YET KNOWN. DPB W2,DA.LNC ;SET LN/CP. DPB TB,DA.DEF ;SET WE ARE DEFINED. SKIPN LNKSEC ;LINKAGE SECTION? JRST D29.A2 ;NO DPB TB,DA.LKS ;YES, SET LINKAGE FLAG IN ENTRY LDB TC,DA.LVL ;LEVEL 01 OR 77? CAIE TC,LVL.77 CAIN TC,LVL.01 SETZM EAS1PC ;YES, RESET DATA PC D29.A2: TSWF FFILSC; ;ARE WE IN THE FILE SECTION? DPB TB,DA.DFS ;YES, SET DEFINED IN FILE SECTION. SKIPN CURDAT ;DO WE HAVE A CURRENT ITEM? JRST D29.A1 ;NO, THEN WE DON'T HAVE A FATHER. DPB TB,DA.FAL ;FATHER/BROTHER BIT HLRZ TB,CURDAT ;SET TO INDICATE DPB TB,DA.POP ;FATHER D29.A1: EXCH TA,CURDAT ;TA==FATHER-TO-BE MOVS TB,CURDAT ;TB==SON-TO-BE PUSHJ PP,PUTSON ;SET UP SON CHAIN MOVE TA,CURDAT ;GET NEW ITEM'S DATAB ADDRESS. JRST D29.B1 ;PUT IN SAME NAME CHAIN AND SET UP SUBSCRIPTS ;WE GET HERE IF THE LEVEL NUMBER OF THE NEW ITEM IS GREATER THAN OR ; EQUAL TO THE LEVEL NUMBER OF THE CURRENT ITEM. ; IF THE LEVEL NUMBER OF THE NEW ITEM IS GREATER THAN THE LEVEL ; NUMBER OF THE CURRENT ITEM, WE FINISH OFF THE CURRENT ITEM, ; MAKE HIS FATHER THE CURRENT ITEM AND REENTER DA29. EVENTUALLY ; THE LEVEL NUMBER OF THE NEW ITEM WILL BE LESS THAN OR EQUAL TO ; THE LEVEL NUMBER OF THE CURRENT ITEM. ; IF THE LEVEL NUMBER OF THE NEW ITEM IS EQUAL TO THE LEVEL NUMBER ; OF THE CURRENT ITEM, WE FINISH OFF THE CURRENT ITEM AND THEN ; SET UP AND INITIALIZE A DATAB ENTRY. DA29.B: CAIE TB,(TC) ;ARE WE AT THE SAVE LEVEL AS THE LAST ITEM? JRST DA29.C ;NO, NEW ITEM IS LOWER LEVEL NUMBER - ; GO FINISH OFF THE CURRENT ITEM AND ; ITS ANCESTORS. PUSHJ PP,DA54. ;FINISH OFF THE LAST ITEM. MOVE TA,[XWD CD.DAT,SZ.DAT] ;GET A DATAB ENTRY. PUSHJ PP,GETENT LDB TB,[POINT 15,W2,15] ;SET THE NAMTAB LINK. DPB TB,DA.NAM HRRZI TB,CD.DAT ;I AM A DATAB ENTRY. DPB TB,[POINT 3,(TA),2] HRRZ TB,0(SAVPTR) ;GET THE LEVEL NUMBER. CAIN TB,^D77 ;LEVEL 77? HRRZI TB,LVL.77 ;YES, USE ^O77 SINCE WE ONLY HAVE 6 BITS. HRRZM TB,LEVEL ;REMEMBER WHAT LEVEL WE'RE AT. DPB TB,DA.LVL ;PUT IT IN THE DATAB ENTRY. SETO TB, ;GET SOME ONES. DPB TB,DA.CLA ;CLASS IS NOT KNOWN YET. DPB TB,DA.DEF ;WE ARE DEFINED. SKIPN LNKSEC ;LINKAGE SECTION? JRST D29.B0 ;NO DPB TB,DA.LKS ;YES, SET LINKAGE FLAG IN ENTRY LDB TC,DA.LVL ;01 OR 77 LEVEL? CAIE TC,LVL.77 CAIN TC,LVL.01 SETZM EAS1PC ;YES, RESET DATA PC D29.B0: TSWF FFILSC; ;ARE WE IN THE FILE SECTION? DPB TB,DA.DFS ;YES, SET THE DEFINED IN FILE SECTION FLAG. DPB TB,DA.FAL ;TURN ON FATHER LINK FLAG. DPB W2,DA.LNC ;SET LN/CP. EXCH TA,CURDAT ;POINT AT BROTHER'S DATAB ENTRY. HLRZ TB,CURDAT ;GET LINK TO CURRENT ENTRY. LDB TC,DA.POP ;GET POINTER TO FATHER. DPB TB,DA.BRO ;MAKE BROTHER POINT AT THIS ENTRY. SETZ TB, ;OLD ENTRY BECOMES BROTHER OF DPB TB,DA.FAL ;NEW AND FATHER OF OLD IS FATHER MOVE TA,CURDAT ;OF NEW DPB TC,DA.POP ;WE COME HERE TO FINISH UP THE DATAB ENTRY'S INITIALIZATION. D29.B1: LDB TB,DA.NAM ;GET NAMTAB LINK. HRR TA,TB ;SET UP FOR PUTLNK CALL. PUSHJ PP,PUTLNK ;GO LINK THIS ITEM INTO THE SAME NAME CHAIN. IFN ANS74,< SKIPN FLGSW## ;FIPS FLAGGER REQUESTED? JRST D29.B2 ;NO MOVE TA,CURDAT ;YES, RESET TO DATA-ITEM LDB TB,DA.SNL ;IS THIS A DUPLICATE NAME? JUMPE TB,D29.B2 ;NO HRRZI TB,(TYPE) ;(EXCEPT FILLERS) ANDI TB,1777 CAIN TB,FILLE. JRST D29.B2 ;NOT FILLER MOVE LN,WORDLN## ;SET UP LN & MOVE CP,WORDCP## ; CP PUSHJ PP,FLG.HI## ;FLAG AT HIGH-INTERMEDIATE LEVEL D29.B2:> HLRZ TB,CURDAT ;GET THE ITEM'S DATAB LINK. PUSHJ PP,FNDPOP ;FIND ITS FATHER. JRST RPWPOP ;NO FATHER, LEAVE. LDB TC,[POINT 3,TB,20] ;GET FATHER'S TABLE CODE. CAIE TC,CD.DAT ;IS HE IN DATAB? JRST RPWPOP ;NO, LEAVE. HRLZM TB,TBLOCK+13 ;SAVE FATHER LINK. HRRZI TA,(TB) ;SET UP FOR LNKSET CALL. PUSHJ PP,LNKSET ;GO CONVERT LINK TO AN ADDRESS. HRRM TA,TBLOCK+13 ;RESTORE FATHER'S LINK. LDB TD,DA.RDF## ;GET FATHER'S REDEFINITION FLAG. CAIN TD,0 ;DID FATHER HAVE A REDEFINITION CLAUSE? LDB TD,DA.RDH## ;NO, GET FATHER'S REDEFINES AT A ; HIGHER LEVEL FLAG. LDB TB,DA.VAL ;GET FATHER'S VALUE FLAG. LDB TC,DA.VHL ;AND HIS VALUE AT A HIGHER LEVEL FLAG. CAIE TB,0 ;DID FATHER HAVE A VALUE CLAUSE? SETO TC, ;YES, REMEMBER THAT. HRRZ TA,CURDAT ;GET ITEM'S DATAB ADDRESS. DPB TC,DA.VHL ;SET VALUE AT A HIGHER LEVEL FLAG APPROPRIATELY. DPB TD,DA.RDH ;SET REDEFINES AT HIGHER LEVEL FLAG APPROPRIATELY. MOVE TA,TBLOCK+13 ;GET FATHER'S DATAB ADDRESS. LDB TB,DA.SUB ;GET FATHER'S "I MUST BE SUBSCRIPTED" FLAG. JUMPE TB,RPWPOP ;NOT, SO LEAVE. LDB TD,DA.OCH## ;GET FATHER'S LINK TO HIGHER LEVEL OCCURS. LDB TE,DA.OCC ;GET FATHER'S "I HAVE OCCURS" FLAG. CAIE TE,0 ;DID HE HAVE AN OCCURS CLAUSE? HLRZ TD,TBLOCK+13 ;YES, GET FATHER'S DATAB LINK. PUSH PP,TD ;SAVE LINK TO WHOEVER HAD THE OCCURS CLAUSE. MOVE TA,[CD.DAT,,SZ.DOC] ;MAKE DATAB WORDS 8,9. PUSHJ PP,GETENT POP PP,TD ;GET LINK TO WHOEVER HAD THE OCCURS CLAUSE. HRRZ TA,CURDAT ;GET ITEM'S DATAB ADR. DPB TD,DA.OCH ;SET THE LINK TO HIGHER LEVEL OCCURS. SETO TE, ;GET SOME ONES. DPB TE,DA.SUB ;TURN ON "I MUST BE SUBSCRIPTED" FLAG. JRST RPWPOP ;EXIT ;WE COME HERE TO FINISH OFF AN ITEM AND ITS ANCESTORS. DA29.C: PUSHJ PP,DA54. ;GO FINISH OFF THE CURRENT ITEM. HLRZ TB,CURDAT ;GET THE CURRENT ITEM'S LINK. SETZM CURDAT ;NO CURRENT ITEM FOR A WHILE. PUSHJ PP,FNDPOP ;FIND EX-CURRENT ITEM'S FATHER. JRST DA29.0 ;[1003] NO FATHER, REENTER. LDB TA,[POINT 3,TB,20] ;GET FATHER'S TABLE CODE. CAIE TA,CD.DAT ;IS HE DATAB? JRST DA29.0 ;[1003] NO, REENTER. HRLZM TB,CURDAT ;FATHER BECOMES CURRENT ITEM. HRRZ TA,TB ;SET UP TO CONVERT A LINK TO AN ADR. PUSHJ PP,LNKSET ;GO DO IT TO IT. HRRM TA,CURDAT ;SET FATHER'S ADDRESS. JRST DA29.0 ;[1003] REENTER. COMMENT \ WE COME TO DA29.R TO PROCESS LEVEL 66 ITEMS. WE GET HERE WHEN WE HAVE SEEN THE FOLLOWING: 66 DATA-NAME WHAT WE DO IS: FINISH PROCESSING THE LAST ITEM VIA DA54., MAKE THE LAST ITEM'S FATHER THE CURRENT ITEM, IF HE IS A DATAB ITEM, AND REENTER DA29. EVENTUALLY CURDAT WILL BE ZERO INDICATING THAT THERE ARE NO MORE ITEMS TO BE FINISHED UP AND WE WILL COME BACK HERE WHERE WE WILL SET UP THE DATAB ENTRY FOR THE LEVEL 66 ITEM WE SAW. \ DA29.R: SKIPE CURDAT ;DO WE HAVE A CURRENT ITEM? JRST DA29.C ;YES GO FINISH IT UP. MOVE TA,[XWD CD.DAT,SZ.DAT] ;GET A DATAB ENTRY. PUSHJ PP,GETENT MOVEM TA,CURDAT ;MAKE THIS THE CURRENT ITEM. DPB W2,DA.LNC ;SET LN/CP. LDB TB,[POINT 15,W2,15] ;GET OUR NAMTAB LINK. DPB TB,DA.NAM ;PUT IT IN OUR DATAB ENTRY. HRRZI TC,CD.DAT ;I AM A DATAB ENTRY. DPB TC,[POINT 3,(TA),2] HRRZI TC,LVL.66 ;SET OUR LEVEL NUMBER TO 76. (SHOULD BE ; 102 BUT THE FIELD IS ONLY 6 BITS.) DPB TC,DA.LVL D29XIT: HRRI TA,(TB) ;SET UP OUR NAMTAB LINK. PUSHJ PP,PUTLNK ;GO LINK THIS DATAB ENTRY INTO THE SAME ; NAME CHAIN. RPWPOP: IFN RPW,< SKIPL REPSEC ;RPW SECTION? POPJ PP, ;NO MOVE TA,[CD.RPW,,SZ.RPG] ;GET A REPORT GROUP ENTRY IN RPWTAB PUSHJ PP,GETENT MOVE TB,RPWRDL ;STORE LINK TO RD ENTRY DPB TB,RW.RDL MOVEM TA,CURRPW ;SAVE PTR MOVEI TB,4 ;SET RPG BIT DPB TB,[POINT 3,(TA),2] HLRZ TB,CURDAT ;STORE DATAB LINK IN RPWTAB DPB TB,RW.DAT MOVE TB,LASTYP ;COPY LAST TYPE SEEN INTO THIS ENTRY DPB TB,RW.TYP HRRZ TA,CURDAT ;STORE RPWTAB LINK IN DATAB HLRZ TB,CURRPW DPB TB,DA.RPW > POPJ PP, COMMENT \ ROUTINE TO SET UP A SON LINK. ENTRY CONDITIONS: (TA) LH: FATHER'S TABLE LINK. RH: FATHER'S ADDRESS. (TB) LH: SON'S ADDRESS. RH: SON'S TABLE LINK. NOTE: USE IS MADE OF THE FACT THAT TA=TB+1. THERE ARE NO OUTPUT PARAMETERS. RETURN IS ALWAYS TO CALL+1. \ PUTSON: JUMPE TA, CPOPJ ;LEAVE IF NO FATHER. JUMPE TB, CPOPJ ;LEAVE IF NO SON. LDB TC, DA.SON## ;IF THERE ALREADY IS A SON JUMPN TC, PS.2 ; GO LINK NEW ONE TO THE ; YOUNGEST SON. DPB TB, DA.SON## ;OTHERWISE MAKE THIS THE SON. ROTC TB, ^D18 ;POINT AT SON'S DATAB ENTRY AND ; GET FATHER'S LINK IN RH OF TB. PS.1: DPB TB, DA.POP## ;PUT FATHER'S LINK IN SON. SETO TC, ;GET SOME ONES. DPB TC, DA.FAL## ;SET THE FATHER LINK FLAG. POPJ PP, ;RETURN. ;COME HERE IF WE ARE NOT THE ONLY SON. PS.2: MOVEM TA, TBLOCK+1 ;SAVE FATHER'S DATA. MOVEM TB, TBLOCK+2 ;SAVE NEW SON'S DATA. HRRZM TC, TBLOCK+3 ;SAVE OLDEST SON'S LINK. HRRZI TB, (TC) ;SET UP FOR FNDBRO CALL. PS.3: PUSHJ PP, FNDBRO## ;GO FIND A BROTHER. JRST PS.4 ;NO MORE BROTHERS. HRRZM TB, TBLOCK+3 ;SAVE THIS SON'S LINK. JRST PS.3 ;GO LOOK FOR ANOTHER BROTHER. ;COME HERE WHEN WE HAVE FOUND THE YOUNGEST SON. PS.4: HRRZ TA, TBLOCK+3 ;GET HIS LINK BACK. PUSHJ PP, LNKSET## ;MAKE IT AN ADDRESS. SETZ TB, ;GET SOME ZEROES. DPB TB, DA.FAL## ;CLEAR THE FATHER LINK FLAG. MOVE TB, TBLOCK+2 ;GET NEW SON'S DATA BACK. DPB TB, DA.BRO## ;MAKE HIM THE YOUNGEST SON. HLRZ TA, TB ;POINT AT NEW SON'S DATAB ENTRY. HLRZ TB, TBLOCK+1 ;GET FATHER'S LINK. JRST PS.1 ;GO PUT THE FATHER'S LINK IN THE SON. ;SET UP "REDEFINES" INTER. DA30. DA30.: JUMPL W1,JCE104 ;EXIT IF NOT DEFINED MOVE TC,DATLVL ;CURRENT LEVEL CAIE TC,1 ;DISALLOW REDEF AT 01 LEVEL IN FILE SECT. JRST DA30.0 TSWF FFILSC; EWARNJ E.66 IFN MCS!TCS,< SKIPN COMSEC; ;IN COMMUNICATIONS SECTION? JRST DA30X1 ;NO HRRZ TA,LAST01 ;YES, WE MAY HAVE ALREADY FAKED A REDEFINE HLRZ TB,CURDAT ; OF THE 01 AT D27N.1 - MAKE SURE WE'RE NOT CAMN TA,TB ; HERE A SECOND TIME BECAUSE OF "REDEFINES"! EWARNJ E.640 ; CLAUSE SPECIFIED. DA30X1: >;END IFN MCS!TCS HRRZ TA,LAST01 ;GET LINK TO LAST 01 ITEM JUMPE TA,CPOPJ ;IF ITEM REDEFINES DUPLICATE, ; TREAT THIS AS AN ORDINARY DEFN PUSHJ PP,LNKSET HLRZ TB,CURDAT ;MAKE CURRENT ITEM LAST 01'S BROTHER DPB TB,DA.BRO SETZ TB, DPB TB,DA.FAL DA30.0: LDB TB,[POINT 15,W2,15] ;GET NAMTAB LINK HRRZ TA,LSTDAT(TC) ;LAST ITEM AT THIS LEVEL NOT A REDEF DA30.1: CAIN TA,0 ;GOOD LINK? HRRI TA,B20+1 ;NO, AIM AT DUMMY ENTRY PUSHJ PP,LNKSET ;MAKE PTR LDB TD,DA.NAM ;GET NAMTAB LINK CAIN TB,(TD) ;THIS THE ONE WE ARE REDEFINING? JRST DA30.2 ;YES LDB TD,DA.FAL ;FATHER BIT ON? JUMPN TD,JCE266 ;YES, NO MORE BROTHERS LDB TD,DA.BRO ;TRY BROTHER HRRZI TA,(TD) JUMPN TD,DA30.1 JCE266: EWARNJ E.266 ;ILLEGAL REDEFINITION DA30.2: HRRZ TA,CURDAT ;GET PTR TO CURRENT ITEM IFN ANS68,< ;ANSI-68 RESTRICTION LDB TB,DA.SUB## JUMPN TB,JCE269 ;NOT PERMITTED ON OCCURS ITEM >;END IFN ANS68 SKIPN TB,EAS1PC ;[***] SKIPN LNKSEC ;[***] IN LINKAGE SECTION? CAIA ;[***] NO MOVE TB,LNK1PC ;[***] YES, USE SAVED VALUE INSTEAD MOVE TE,RDFLVL## MOVEM TB,RDEFPC##(TE) AOS TE,RDFLVL ;UPDATE LVL COUNT CAIL TE,RDFSIZ## ;SEE IF TOO DEEP JRST [SOS RDFLVL EWARNJ E.268] MOVE TC,DATLVL HRRZ TA,LSTDAT(TC) PUSHJ PP,LNKSET HRRZI TB,44 LDB TC,DA.RES SUBI TB,(TC) LDB TC,DA.LOC## HRLI TC,(TB) MOVEM TC,EAS1PC MOVE TA,CURDAT SETO TB, DPB TB,DA.RDF IFN ANS74,< LDB TD,DA.RDH ;IS THERE A REDEFINITION AT A HIGHER LEVEL? JUMPE TD,DA30.3 ;NO SKIPE FLGSW## ;YES, FIPS FLAGGER REQUESTED? PUSHJ PP,FLG.HI## ;YES, FLAG AT HIGH-INTERMEDIATE LEVEL DA30.3:> MOVE TB,DATLVL ;IF 01 LEVEL CAIN TB,LVL.01 ;SAVE LINK HLRZM TA,LAST01 POPJ PP, ;ITEM IS NOT A REDEFINITION -- REMEMBER THIS INTER. DA30N. DA30N.: IFN RPW,< SKIPE REPSEC ;NOT NEEDED IN REPORT SECTION JRST DA7. > IFN MCS!TCS,< SKIPN COMSEC ;COMMUNICATION SECTION ACTIVE? JRST DA30NN ;NO MOVE TA,LEVEL CAIE TA,LVL.01 ;01 LEVEL? JRST DA30NN ;NO MOVE TA,CURDAT HLRZ TD,CURCD DPB TD,DA.POP## ;SET FATHER LINK SETO TD, DPB TD,DA.FAL ;SET FATHER BIT CLEAR TD, DPB TD,DA.CLA## ;CLASS MOVEI TD,2 DPB TD,DA.USG ;USAGE DA30NN:> MOVE TC,DATLVL HLRZ TB,CURDAT MOVEM TB,LSTDAT(TC) MOVE TA,CURDAT ;PTR & LINK TO ITEM CAIN TC,LVL.01 ;01 LEVEL? HLRZM TA,LAST01 ;YES, STORE LINK JRST DA7. ;WANT TO REGET THIS WORD ;BLANK WHEN ZERO INTER. DA31. DA31.: LDB TB,[POINT 9,W1,17] CAIE TB,ZERO. JCE18.: EWARNJ E.18 SKIPN TA,CURDAT POPJ PP, LDB TB,DA.CLA ;CLASS CAIE TB,%%CL ;UNKNOWN CAIN TB,%CL.NU ;NUMERIC JRST DA31.A LDB LN,DA.LN LDB CP,DA.CP HRRZI DW,E.223 JRST FATAL DA31.A: LDB TB,DA.BWZ## AOSE FLOTBZ ; [403] PICTURE WITH NO 9'S, THEN OK JUMPN TB,JCE16. ;DUPLICATED SETO TB, DPB TB,DA.BWZ ;SET FLAG IFN ANS74!FT68274,< LDB TB,DA.PWA## ;SEE IF PICTURE ALLOCATED JUMPE TB,CPOPJ ;NOT YET LDB TB,DA.FSC## ;GET SUPPRESSION CHAR CAIN TB,'*' ;IS IT * EWARNJ E.701 ;YES, GIVE ERROR > POPJ PP, ;JUSTIFIED RIGHT INTER. DA32. DA32.: SKIPN TA,CURDAT POPJ PP, LDB TB,DA.JST## JUMPN TB,JCE16. ;DUPLICATED SETO TB, DPB TB,DA.JST POPJ PP, IFN ANS74,< ;SIGN CLAUSE INTER. DA32.C DA32.C: SKIPN TA,CURDAT POPJ PP, LDB TB,DA.PIC## JUMPE TB,CPOPJ ;NOT YET SEEN PICTURE LDB TB,DA.SGN## ;SIGNED JUMPN TB,CPOPJ ;YES DA32.E: EWARNJ E.710 ;LEADING SIGN INTER. DA32.L DA32.L: SKIPN TA,CURDAT POPJ PP, LDB TB,DA.LSC## JUMPN TB,JCE16. ;DUPLICATED SETO TB, DPB TB,DA.LSC POPJ PP, ;SEPARATE SIGN INTER. DA32.S DA32.S: SKIPN TA,CURDAT POPJ PP, LDB TB,DA.SSC## JUMPN TB,JCE16. ;DUPLICATED SETO TB, DPB TB,DA.SSC LDB TB,DA.PIC ;PICTURE SEEN? JUMPE TB,CPOPJ ;NOT YET HRLI TB,1 ;YES, GET [1,,1] ADDM TB,@DA.EXS## ;YES, SIZE IS BIGGER BY 1 CHAR POPJ PP, > INTER. DA33. DA33.: PUSHJ PP,DA11. ;GET NUMBER OF OCCURRENCES D33MCS: PUSHJ PP,DANXT. ;[243] SEE IF NEXT ITEM IS A 'TO' MOVEI TB,1 ;[243] IF NO MINIMUM IS 1 CAIN TYPE,TO. ;[243] IS NEXT SOURCE ITEM 'TO' SETZ TB, ;[243] YES, ALLOW 0 MOVE TC,0(SAVPTR) ;[243] GET USERS NO. OF OCCURS CAIGE TC,(TB) ;[243] SEE IF NO. OF OCCURS LEGAL JRST JCE25 ;[243] ILLEGAL CAIG TC,77777 JRST DA33.A MOVEI DW,E.593 ;[471] TO MANY FOR "OCCURS" PUSHJ PP,DA24X. ;[243] GIVE ERROR AND COME BACK HRRZI TC,77777 ;ONLY 32K OCCURRENCES ALLOWED HRRZM TC,0(SAVPTR) DA33.A: HRRZ TA,CURDAT LDB TB,DA.OCC JUMPN TB,JCE16. HRRZ TC,0(SAVPTR) DPB TC,DA.NOC LDB TB,DA.PWA ;DATAB WORDS 8,9 CREATED YET? LDB TC,DA.SUB IORI TB,(TC) JUMPN TB,.+4 ;YES MOVE TA,[CD.DAT,,SZ.DOC] ;NO, DO IT PUSHJ PP,GETENT HRRZ TA,CURDAT ;RESTORE TA SETO TB, DPB TB,DA.OCC DPB TB,DA.SUB POPJ PP, JCE25: HRRZ TA,CURDAT ;[243] GET POINTER TO DATA ITEM SETO TB, ;[243] THEN SET DPB TB,DA.ERR ;[243] ERROR BIT MOVEI DW,E.25 ;[243] GIVE ERROR MESSAGE AND RETURN JRST DA24X. ;[243] ;[243] THIS ROUTINES LOOKS AHEAD AT NEXT SOURCE ITEM DANXT.: MOVEM W2,1(SAVPTR) ;[243] SAVE CURRENT SOURCE ITEM PUSHJ PP,GETITM ;[243] GET NEXT SOURCE ITEM MOVE W2,1(SAVPTR) ;[243] RESTORE CURRENT SOURCE JRST DA7. ;[243] SET SW TO REGET SAME ITEM FOR SYNTAX SCAN ;SET UP INDEX FOR "INDEXED BY" CLAUSE INTER. DA34. DA34.: PUSHJ PP,DA60S. ;SAVE NAMTAB LINK IN CURNAM HRRZI TB,CD.DAT ;(USING TA LEFT BY DA60S.) PUSHJ PP,FNDLNK JRST DA34.B ;NO LINK EWARNJ E.297 ;BAD NAME DA34.B: TLO W2,GWDEF ;PUT DEFINING REFERENCE ON CREF FILE PUSHJ PP,PUTCRF PUSHJ PP,DA25S. ;SET UP HLDTAB ENTRY HRRZI TB,%HL.IX ; BECAUSE PUTTING INDEX IN DATAB NOW DPB TB,HL.COD ; MIGHT PUT IT BETWEEN THE ITEM INDEXED IFN MCS!TCS,< SKIPE COMSEC## ;ARE WE IN COMM SECTION? POPJ PP, ;YES, DON'T LINK DATAB TO HLDTAB > HLRZ TB,CURDAT ; AND ITS SEARCH KEYS DPB TB,HL.LNK HRRZ TA,CURDAT ;PUT HLDTAB LINK IN DATAB ENTRY HLRZ TB,CURHLD ; "INDEXED BY" FIELD LDB TC,DA.XBY## ; UNLESS ONE HAS BEEN STORED ALREADY JUMPN TC,.+2 DPB TB,DA.XBY POPJ PP, INTER. DA35. DA35.: SKIPN TA,CURDAT JRST DA35.1 LDB TB,DA.PIC JUMPN TB,JCE16. ;CLAUSE DUPLICATED DA35.1: PUSHJ PP,PSCAN HRRZ TA,CURDAT JUMPE TA,CPOPJ LDB TB,DA.PIC JUMPN TB,CPOPJ ;PICTURE SEEN BEFORE SETO TB, DPB TB,DA.PIC LDB TB,DA.USG CAIN TB,%US.IN ;USAGE INDEX? JRST DA35.E ;YES CAIE TB,%US.C1 ;COMP-1? CAIN TB,%US.C2 ; OR COMP-2? JRST DA35.E ;YES DPB SW,DA.CLA ;BITS 34-35 OF SW ARE CLASS SETZ TB, TSWF FSIGN; ;SIGNED? SETO TB, ;YES DPB TB,DA.SGN## ;STORE THE SIZE IFN ANS74,< ;IF NOT SIGNED, GIVE ERROR IF "SIGN" CLAUSE WAS GIVEN. ; IF SIGNED AND "SIGN IS SEPARATE", ADD 1 TO SIZE JUMPN TB,[LDB TE,DA.SSC## ;GET "SEP SIGN FLAG" IN TE JRST DA35.S] ;AND GO ;NOT SIGNED. LDB TE,DA.SSC## ;SEP SIGN LDB TD,DA.LSC## ;LEADING SIGN IOR TD,TE JUMPE TD,DA35.S ;NO SIGN FLAGS GIVEN, OK EWARNW E.710 ;"ITEM MUST BE SIGNED NUMERIC" MOVEI TE,0 ;GET A 0 HRRZ TA,CURDAT ;RELOAD TA INCASE IT WAS SMASHED ;HERE WITH TE= 1 IF SEP. SIGN, ELSE 0 DA35.S: HRRZ TB,INSIZE## ADD TB,TE ;ADD 0 OR 1 DPB TB,DA.INS## ;INTERNAL SIZE HRRZ TB,EXSIZE## ADD TB,TE ;ADD 0 OR 1 DPB TB,DA.EXS ;EXTERNAL SIZE >;END IFN ANS74 IFN ANS68,< HRRZ TB,INSIZE## DPB TB,DA.INS## ;INTERNAL SIZE HRRZ TB,EXSIZE## DPB TB,DA.EXS ;EXTERNAL SIZE > SKIPL TB,DPSIZE## JRST DA35.A SETO TB, DPB TB,DA.DPR## ;DECIMAL POINT TO RIGHT OF ITEM MOVN TB,DPSIZE DA35.A: DPB TB,DA.NDP## ;NUMBER OF DECIMAL PLACES TSWF FEDIT; JRST DA35.C ;YES LDB TB,DA.BWZ## ;SEE IF "BLANK WHEN ZERO" JUMPE TB,CPOPJ ;NEITHER EDITED NOR BWZ JRST DA35.D ;SAVE EDIT MASK PER NAVY TESTS DA35.C: SETO TB, DPB TB,DA.EDT## SKIPN FLOTBZ## ;PICTURE ALL FLOAT CHARS & NO 9'S? TSWF FBWZ; DPB TB,DA.BWZ DA35.D: SKIPG MSKSIZ## POPJ PP, ;NO MASK DA35.B: HRRZ TB,MSKSIZ CAILE TB,SZ.MSK HRRZI TB,SZ.MSK HRRZM TB,MSKSIZ LDB TB,DA.PWA JUMPE TB,D35B.1 ADDI TA,SZ.DAT+SZ.DOC JRST D35B.0 D35B.1: LDB TB,DA.SUB ;WORDS 8&9 ALLOCATED YET? JUMPN TB,.+4 ;YES MOVE TA,[CD.DAT,,SZ.DOC] ;NO, DO IT PUSHJ PP,GETENT HRRZ TA,CURDAT SETO TB, DPB TB,DA.PWA MOVE TA,[CD.DAT,,SZ.MSK] PUSHJ PP,GETENT ;GET ENTRY FOR MASK D35B.0: HRRZ TC,MSKSIZ ADDI TC,-1(TA) ;LAST WORD FOR STORING MASK HRLI TA,MSKWRD## BLT TA,(TC) ;MOVE MASK POPJ PP, DA35.E: HRRZI DW,E.221 LDB LN,DA.LN LDB CP,DA.CP## JRST WARN INTER. DA36. DA36.: SKIPN TA,CURDAT POPJ PP, ;NO DATTAB LINK LDB TB,DA.SYL## ;SYNC LEFT? JUMPN TB,JCE18. ;YES--ERROR LDB TB,DA.SYR## ;ALREADY SYNC RIGHT? JUMPN TB,JCE16. ;YES SETO TB, DPB TB,DA.SYR POPJ PP, INTER. DA37. DA37.: MOVE TA,CURDAT JUMPE TA,CPOPJ LDB TB,DA.SYR JUMPN TB,JCE18. LDB TB,DA.SYL JUMPN TB,JCE16. SETO TB, DPB TB,DA.SYL POPJ PP, INTER. DA38. DA38.: HRRZI TC,%US.D7 ;USAGE CODE 'DISPLAY-7' ;FALL INTO SET USAGE ROUTINE. IFN ANS68, ;SET THE USAGE OF A DATAB ITEM AND DETERMINE IF IT IS CONSISTANT WITH ; ITS ANCESTOR'S USAGES. SETUSF: FLAGAT NS SETUSG: HRRZ TA, CURDAT ;GET THE ADDRESS OF THE CURRENT ITEM. JUMPE TA, CPOPJ ;IF THERE IS NO CURRENT ITEM LEAVE. LDB TB, DA.USG## ;GET THE USAGE FIELD. IFN TCS!MCS,< ;24-SEP-80 /DAW THERE MAY HAVE ALREADY BEEN A DEFAULT USAGE (DISPLAY-7) ; ASSIGNED FOR THE 01 LEVEL. IF HE ALSO SPECIFIES A USAGE, A WARNING ; WILL BE GIVEN AND THE USAGE CLAUSE WILL BE IGNORED. CAIN TB,%%US ;USAGE ALREADY DEFINED? JRST SETSG0 ;NO, OK CAMN TB,TC ;SAME USAGE? JRST SETSG0 ;YES, DON'T COMPLAIN EWARNW E.641 ;GIVE WARNING MOVE TC,TB ;ASSUME THE DEFAULT SETSG0: >;END IFN TCS!MCS IFE TCS!MCS,< CAIE TB, %%US ;DO WE ALREADY HAVE A USAGE? EWARNJ E.16 ;YES, COMPLAIN. > HRRZM TC, TBLOCK ;SAVE THE SON'S USAGE. ;IF WE DON'T HAVE A USAGE FOR THE RECORD YET, SEE IF WE CAN USE THIS ONE. SKIPE TB, RUSAGE## ;DO WE HAVE A USAGE FOR THE REC? JRST DA38.5 ;YES, GO ON. ;SEE IF WE CAN USE THIS USAGE. CAIE TC, %US.D6 ;IF THE USAGE IS DISPLAY-6 CAIN TC, %US.D7 ; OR DISPLAY-7, THE RECORD MOVEI TB, (TC) ; IS ALSO. CAIE TC, %US.EB ;IF THE USAGE IS DISPLAY-9 OR CAIN TC, %US.C3 ; COMP-3, THE RECORD IS MOVEI TB, %US.EB ; DISPLAY-9. MOVEM TB, RUSAGE## ;SET THE RECORD'S USAGE. ;HERE WE ARE GOING TO TRY TO FIND AN ANCESTOR FOR WHICH A USAGE ; CLAUSE WAS GIVEN. DA38.5: HLRZ TB, CURDAT ;GET LINK TO CURRENT ITEM. DA38.A: PUSHJ PP, FNDPOP## ;FIND THE FATHER. JRST DA38.L ;NO FATHER. LDB TC, [POINT 3,TB,20] ;GET FATHER'S TABLE CODE. CAIE TC, CD.DAT ;IS HE IN DATAB? JRST DA38.L ;NO. HRRZM TB, TBLOCK+1 ;SAVE FATHER'S LINK. HRRZI TA, (TB) ;SET UP FOR LNKSET. PUSHJ PP, LNKSET## ;GET FATHER'S ADDRESS. LDB TC, DA.USG## ;GET HIS USAGE. HRRZ TB, TBLOCK+1 ;RESTORE FATHER'S LINK. CAIN TC, %%US ;DOES HE HAVE A USAGE? JRST DA38.A ;NO, GO LOOK AT HIS FATHER. ;FOUND A FATHER FOR WHICH A USAGE CLAUSE WAS GIVEN. HRRZ TB, TBLOCK ;RESTORE SON'S USAGE. COMMENT \ NOW WE HAVE TO MAKE SURE THAT THE USAGES ARE VALID. THE FOLLOWING ARE OK: USAGE OF FATHER USAGE OF SON DISPLAY-6 DISPLAY-6 COMP COMP-1 INDEX DISPLAY-7 DISPLAY-7 COMP COMP-1 INDEX DISPLAY-9(EBCDIC) DISPLAY-9 COMP COMP-1 COMP-3 INDEX COMP COMP COMP-1 COMP-1 COMP-3 COMP-3 INDEX INDEX \ CAIN TB, (TC) ;FATHER AND SON HAVE SAME USAGES? JRST DA38.L ;YES, ALL IS WELL. ;SON'S USAGE IS NOT THE SAME AS FATHER'S USAGE. CAIE TC, %US.D6 ;IS THE FATHER DISPLAY-6 CAIN TC, %US.D7 ; OR DSIPLAY-7? JRST DA38.F ;YES. CAIE TC, %US.EB ;HOW ABOUT EBCDIC? JRST DA38.E ;NO, COMPLAIN SINCE ONLY ITEMS ; WITH SOME FORM OF DISPLAY USAGE ; MAY HAVE SUBORDINATE ITEMS WITH ; DIFFERENT USAGES. ;FATHER IS EBCDIC - DO THE COMP-3 SPECIAL CASE. CAIN TB, %US.C3 ;IS THE SON COMP-3? JRST DA38.L ;YES, ALL IS WELL. ;FATHER IS SOME FORM OF DISPLAY AND THE SON'S USAGE IS DIFFERENT. ; MAKE SURE THE SON IS NOT DISPLAY OR COMP-3 SINCE IF IT IS ; DISPLAY IT ISN'T THE SAME FLAVOR AS THE FATHER'S AND IF IT ; IS COMP-3 THE FATHER ISN'T EBCDIC. DA38.F: CAIE TB, %US.D6 ;IS THE SON DISPLAY-6 CAIN TB, %US.D7 ; OR DISPLAY-7? JRST DA38.E ;YES, COMPLAIN. CAIE TB, %US.EB ;IS THE SON EBCDIC CAIN TB, %US.C3 ; OR COMP-3? JRST DA38.E ;YES, COMPLAIN. ;THE SON'S USAGE IS ACCEPTABLE. DA38.L: HRRZ TA, CURDAT ;RESTORE SON'S DATAB ADDRESS HRRZ TB, TBLOCK ; AND HIS USAGE CODE. DPB TB, DA.USG## ;PUT THE CODE IN THE DATAB ENTRY. POPJ PP, ;RETURN. ;USAGE ERRORS COME HERE. DA38.E: HRRZI DW, E.41 ;CONFLICT WITH HIGHER LEVEL USAGE. HRRZ TA, CURDAT ;RESTORE ITEM'S ADDRESS. LDB LN, DA.LN## ;SET UP THE LINE NUMBER LDB CP, DA.CP## ; AND THE CHARACTER POSITION. PJRST FATAL## ;GO PUT THE ERROR MESSAGE OUT ; AND DON'T COME BACK. INTER. DA39. DA39.: HRRZI TC,%US.D6 ;USAGE 'DISPLAY-6' JRST SETUSF INTER. DA39A. DA39A.: HRRZ TC,DEFDSP## ;USAGE 'DISPLAY', GET DEFAULT JRST SETUSG ;GO SET IT. INTER. DA40. DA40.: HRRZI TC,%US.1C ;USAGE 'COMP' JRST SETUSC INTER. DA41A. DA41A.: HRRZI TC,%US.C2 ;USAGE 'COMP-2' JRST DA41. ;MAKE COMP-2 BE COMP-1 FOR 12B JRST SETUSN INTER. DA41. DA41.: HRRZI TC,%US.C1 ;USAGE 'COMP-1' SETUSN: FLAGAT NS SETUSC: IFE RPW,< JRST SETUSG > IFN RPW,< SKIPN REPSEC ;IN REPORT SECTION? JRST SETUSG ;NO EWARNW E.349 ;?ILLEGAL USAGE IN REPORT GROUP JRST DA73.X ;NEXT NODE IS DD144. > INTER. DA42. DA42.: HRRZI TC,%US.C3 ;USAGE 'COMP-3'. JRST SETUSF INTER. DA43. DA43.: HRRZI TC,%US.IN ;USAGE 'INDEX' JRST SETUSC ;THIS ACTION IS USED FOR DATABASE-KEY PROCESSING. THE ;DATAB ENTRY IS SET UP WITH A SIZE OF 10 AND LATER, (AT DA54.Y) ;THE ENTRY IS CHECKED FOR THIS. INTER. DA43A. DA43A.: FLAGAT DB PUSHJ PP,DA43. ;PERFORM NORMAL INDEX STUFF HRRZ TA,CURDAT ;GET CURRENT DATAB ENTRY MOVEI TB,^D10 DPB TB,DA.EXS## ;CHANGE EXTERNAL SIZE DPB TB,DA.INS## ;AND INTERNAL SIZE POPJ PP, INTER. DA43B. DA43B.: HRRZI TC,%US.EB ;USAGE 'DISPLAY-9'. JRST SETUSF INTER. DA46. DA46.: TLO W2,GWDEF ;PUT DEFINING REFERENCE ON CREF FILE PUSHJ PP,PUTCRF PUSHJ PP,TRYNAM PUSHJ PP,BLDNAM MOVEM TA,CURNAM HLRZS TA DPB TA,[POINT 15,W2,15] TLZ W1,GWNOT HRRZI TB,CD.CON PUSHJ PP,FNDLNK JRST DA46.B ;NO CONDITION OF THIS NAME DA46.A: MOVE TA,TB LDB TC,CO.DAT## HLRZ TD,CURDAT CAIN TC,(TD) EWARNJ E.230 ;DUPLICATE CONDITION FOR THIS DATTAB ITEM PUSHJ PP,FNDNXT JRST DA46.B ;NO MORE JRST DA46.A DA46.B: MOVE TA,[XWD CD.CON,SZ.CON] PUSHJ PP,GETENT MOVEM TA,CURCON## HLRZ TB,CURNAM ANDI TB,77777 IORI TB,CD.CON*1B20 MOVSM TB,(TA) HLRZ TA,CURDAT## JUMPE TA,DA46.J ;IF THERE ISN'T A DATAB ITEM ; THERE, GO USE THE DUMMY. DA46.F: ANDI TA,77777 ;GET THE ITEM'S ADDRESS. ADD TA,DATLOC## LDB TB,DA.LVL## ;PICK UP IT'S LEVEL NUMBER. CAIE TB,LVL.01 ;IF WE ARE AT THE TOP OF CAIN TB,LVL.77 ; THE TREE, ALL IS WELL, JRST DA46.N ; GO ON. LDB TA,DA.POP## ;PICK UP THE FATHER/BROTHER LINK. JUMPN TA,DA46.F ;IF IT EXISTS, GO SEE IF WE ARE ; AT THE TOP OF THE TREE. DA46.J: SKIPA TB,[EXP CD.DAT*1B20+1] ;OTHERWISE USE THE DUMMY. DA46.N: HLRZ TB,CURDAT## ;PICK UP THE DATAB ITEM'S LINK AGAIN. MOVE TA,CURCON## ;POINT AT THE CONTAB ENTRY. DPB TB,CO.DAT LDB TB,CO.NAM## HRRI TA,(TB) IFN ANS74,< SKIPN FLGSW ;DO WE NEED THE FIPS FLAGGER? > JRST PUTLNK## IFN ANS74,< PUSHJ PP,PUTLNK ;YES HLRZ TA,CURDAT ;NOW SEE IF DATAB IS FILLER JUMPE TA,CPOPJ ;JUST A DUMMY PUSHJ PP,LNKSET ;GET DATAB ENTRY LDB TB,DA.NAM ;GET NAMTAB LINK ADD TB,NAMLOC ;PLUS BASE HLRZ TB,(TB) ;LOOK FOR "FILLER" CAIE TB,1B20+FILLE. POPJ PP, LDB LN,DA.LN LDB CP,DA.CP JRST FLG.HI > ;STORE VALUE ON CONTAB ENTRY FOR 88 ITEM INTER. DA47. DA47.: SETOM FLG88## ;[674] SET 88 LEVEL LITERAL FLAG CAIA ;[674] AND SKIP DA47.A: SETZM FLG88## ;[674] CLEAR 88 LEVEL LITERAL FLAG TLNE W1,GWFIGC ;[674] FIGURATIVE CONSTANT? JRST DA47.C ;YES TLNN W1,GWLIT EWARNJ E.45 ;LITERAL EXPECTED HLRZ TC,W1 ANDI TC,177 ;SIZE HRLM TC,TBLOCK+13 ;SAVE NO. OF CHARACTERS IDIVI TC,5 JUMPE TB,.+2 HRRZI TC,1(TC) HRRM TC,TBLOCK+13 ;SAVE NO. OF WORDS HRRZI TA,SZ.LIT(TC) HRLI TA,CD.LIT PUSHJ PP,GETENT HLR W1,TA MOVEM TA,CURLIT## HLRZ TC,TBLOCK+13 DPB TC,LI.NCH## SETO TD, TLNE W1,GWASCI ;ANY PURE ASCII CHARACTERS? DPB TD,LI.PUR## TLNE W1,GWALL DPB TD,LI.ALL## TLNN W1,GWNLIT ;NUMERIC? JRST DA47.B ;NO DPB TD,LI.NLT TLNN W1,GWDP DPB TD,LI.INT## DA47.B: HRRZ TC,TBLOCK+13 ;NO. OF WORDS JUMPE TC,JCE183 ;NULL LITERAL ADDI TC,SZ.LIT-1(TA) HRRZI TB,SZ.LIT(TA) HRLI TB,LITVAL BLT TB,(TC) SKIPN FLG88## ;[674] IS THIS 88 LEVEL? POPJ PP, ;[674] NO, DONE LDB TC,LI.NLT## ;[674] TC: NUMERIC LITERAL FLAG, 1=YES, 0=NO HRRZ TA,CURDAT## ;[674] POINT AT THE REAL ITEM (NOT 88 LEVEL) LDB TD,DA.CLA## ;[674] GET ITS CLASS CAIN TD,%%CL ;[700] IF CLASS NOT ASSIGNED YET... PUSHJ PP,[LDB TE,DA.USG ;[700] GET USAGE AND TRY TO DEFAULT CAIE TE,%US.IN ;[711] INDEX? CAIN TE,%US.C1 ;[700] COMP-1? MOVEI TD,%CL.NU ;[700] YES, SET NUMERIC CLASS CAIN TE,%US.C2 ;COMP-2? MOVEI TD,%CL.NU ; IS ALSO NUMERIC POPJ PP,] ;[700] KEEP GOING LDB TE,DA.EDT## ;[674] AND GET ITS EDIT FLAG ;[1106] If the class has not been able to be defaulted yet, it means ;[1106] that the item is subordinate to an INDEX item. We can't tell ;[1106] what class it will be until we see the next level number. It ;[1106] could be an elementary item or a group item! ;[1106] The value clauses have to be checked later (in CLEANC) after ;[1106] the usages are determined. CAIN TD,%%CL ;[1106] Still no class? POPJ PP, ;[1106] Can't check now JUMPE TC,DA47.D ;[674] LITERAL IS NOT NUMERIC, MAKE SURE ;[674] ITEM IS NOT EITHER ;[674] HERE IF THE LITERAL IS NUMERIC CAIN TD,%CL.NU ;[674] IF ITEM IS NUMERIC JUMPE TE,CPOPJ ;[674] AND NOT EDITTED, ALL IS WELL PJRST DA47.F ;[674] OTHERWISE, GIVE AN ERROR ;[674] HERE IF LITERAL IS NOT NUMERIC DA47.D: CAIN TD,%CL.NU ;[674] IF THE ITEM IS NUMERIC AND JUMPE TE,DA47.F ;[674] IS NOT EDITTED, GIVE AN ERROR POPJ PP, ;[674] OTHERWISE, ALL IS WELL ;[674] CLASS OF 88 LEVEL ITEM INCONSISTENT WITH VALUE DA47.F: HRRZI DW,E.241 ;[674] SET ERROR FLAG LDB LN,[POINT 13,W2,28] ;[674] GET LINE OF BAD VALUE LDB CP,[POINT 7,W2,35] ;[674] GET CHARACTER OF BAD VALUE PUSHJ PP,D54E.1 ;[674] GIVE WARNING EXP WARN## ;[674] DA47.C: MOVE TA,[XWD CD.LIT,SZ.LIT] PUSHJ PP,GETENT HLR W1,TA MOVEM TA,CURLIT LDB TC,[POINT 9,W1,17] DPB TC,LI.FCC## SETO TC, DPB TC,LI.FGC## POPJ PP, ;ILLEGAL VALUE FOR CONDITION INTER. DA47E. DA47E.: SWOFF FREGWD ;CLEAR REGET ITEM BIT TLO W1,GWFIGC ;SET FIG. CON. FLAG MOVEI TB,SPACE. ;ASSUME "SPACES" DPB TB,[POINT 9,W1,17] PUSHJ PP,DA47.A ;[674] PUT ASSUMED VALUE IN CONTAB EWARNJ E.258 ;"?LITERAL OR FIG. CON. REQUIRED" INTER. DA48. DA48.: SKIPN CURCON POPJ PP, MOVE TA,[XWD CD.CON,1] PUSHJ PP,GETENT HLRZ TB,CURLIT ANDI TB,077777 MOVSM TB,(TA) SETZM CURLIT HRRZ TA,CURCON LDB TB,CO.NVL## HRRZI TB,1(TB) DPB TB,CO.NVL POPJ PP, INTER. DA49. DA49.: PUSHJ PP,DA48. PUSHJ PP,DA47.A ;[674] SKIPN TA,CURCON POPJ PP, LDB TB,CO.NVL ADDI TB,SZ.CON-1(TA) HLRZ TC,CURLIT ANDI TC,077777 HLL TC,(TB) TLO TC,400000 MOVEM TC,(TB) SETZM CURLIT POPJ PP, INTER. DA51. DA51.: SETZM RENAM1## SETZM RENAM2## TLNE W1,GWNOT EWARNJ E.17 LDB TA,[POINT 15,W2,15] HRRZI TB,CD.DAT PUSHJ PP,FNDLNK EWARNJ E.17 MOVEM TB,RENAM1 POPJ PP, IFN ANS74,< INTER. DA51A. DA51A.: POPJ PP, > INTER. DA52. DA52.: TLNE W1,GWNOT EWARNJ E.17 LDB TA,[POINT 15,W2,15] HRRZI TB,CD.DAT PUSHJ PP,FNDLNK EWARNJ E.17 MOVEM TB,RENAM2 POPJ PP, INTER. DA53. DA53.: SKIPE RENAM2 JRST DA53.2 SKIPN TA,RENAM1 JRST DA53.X SETZ TB, ;CK RENAMED ITEM FOR LDB TC,DA.PWA## ; PICTURE WORDS ALLOCATED LDB TB,DA.SUB ; OR SUBSCRIPTING JUMPN TB,D53E.2 ;[253] NO SUBCRIPTS ALLOWED IN RENAMED DATA LDB TB,DA.LVL ;[253] CHECK LEVEL OF CAIN TB,LVL.01 ;[253] RENAMED DATA JRST D53E.1 ;[253] CANNOT BE 01 CAIE TB,LVL.77 ;[253] 77 CAIN TB,LVL.66 ;[253] OR 66 JRST D53E.1 ;[253] ILLEGAL IMULI TC,SZ.DOC+SZ.MSK ;FOR RENAMING ITEM JUMPE TC,DA53.1 ;NO EXTRAS NEEDED PUSH PP,TC MOVEI TA,(TC) HRLI TA,CD.DAT PUSHJ PP,GETENT HLRZ TA,RENAM1 PUSHJ PP,LNKSET HRRM TA,RENAM1 POP PP,TC DA53.1: ADDI TC,SZ.DAT ;[253] SKIPN TB,CURDAT ;[253] POPJ PP, LDB TD,DA.LNC ;[253] GET 66 ENTRY SOURCE ITEM HRRZI TB,1(TB) ;WORD 2 OF 66 ENTRY HRLI TB,1(TA) ;WORD 2 OF RENAMED ENTRY ADDI TC,-2(TB) ;LAST WORD OF 66 ENTRY BLT TB,(TC) HRRZ TA,CURDAT DPB TD,DA.LNC ;[253] KEEP ORIG 66 ENTRY SOURCE SETZ TB, DPB TB,DA.POP DPB TB,DA.SON DPB TB,DA.VAL HRRZI TC,LVL.66 ;LEVEL 66 DPB TC,DA.LVL SETO TC, DPB TC,DA.FAL D53.11: HLRZ TB,RENAM1 PUSHJ PP,FNDPOP JRST DA53.X HRLM TB,RENAM1 LDB TC,[POINT 3,TB,20] CAIE TC,CD.DAT JRST D53.12 HRRZI TA,(TB) PUSHJ PP,LNKSET LDB TC,DA.LVL CAIE TC,LVL.01 JRST D53.11 ;The level-01 item is in LH(RENAM1) ;The level-66 item is in LH(CURDAT) ; If this is the file section, store RENTAB entry. HLRZ TB,RENAM1 ;Get TB=01 link TSWF FFILSC; ;Are we in FILE SECTION? PUSHJ PP,D53FS ;Yes, make RENTAB entry. D53.12: HLRZ TB,RENAM1 HRRZ TA,CURDAT DPB TB,DA.POP DA53.X: SETZM CURDAT POPJ PP, DA53.2: HLRZ TA,RENAM1 PUSHJ PP,LNKSET HRRM TA,RENAM1 LDB TB,DA.LVL CAIN TB,LVL.01 JRST D53E.1 ;ILLEGAL LEVEL CAIE TB,LVL.77 CAIN TB,LVL.66 JRST D53E.1 LDB TB,DA.SUB JUMPN TB,D53E.2 ;MAY NOT RENAME ITEMS WITH OCCURS HLRZ TB,RENAM1 D53R.1: PUSHJ PP,FNDPOP JRST D53E.3 ;NO RECORD FOUND HLRZ TC,RENAM2 CAIN TC,(TB) JRST D53E.4 ;FIRST ITEM SUBSIDIARY TO SECOND HRLZM TB,RNREC1## HRRZI TA,(TB) PUSHJ PP,LNKSET HRRM TA,RNREC1 LDB TC,DA.LVL HLRZ TB,RNREC1 CAIE TC,LVL.01 JRST D53R.1 ;NOT YET UP TO RECORD HLRZ TA,RENAM2 PUSHJ PP,LNKSET HRRM TA,RENAM2 LDB TB,DA.LVL CAIN TB,LVL.01 JRST D53E.1 CAIE TB,LVL.77 CAIN TB,LVL.66 JRST D53E.1 LDB TB,DA.SUB JUMPN TB,D53E.2 HLRZ TB,RENAM2 D53R.2: PUSHJ PP,FNDPOP JRST D53E.3 HLRZ TC,RENAM1 CAIN TC,(TB) JRST D53E.4 ;SECOND ITEM SUBSIDIARY TO FIRST HRLZM TB,RNREC2## HRRZI TA,(TB) PUSHJ PP,LNKSET HRRM TA,RNREC2 LDB TC,DA.LVL HLRZ TB,RNREC2 CAIE TC,LVL.01 JRST D53R.2 HLRZ TC,RNREC1 CAIE TC,(TB) JRST D53E.5 ;ITEMS NOT IN SAME RECORD HRRZ TA,RENAM1 LDB TB,DA.LOC LDB TC,DA.RES## HRRZ TA,RENAM2 LDB TD,DA.LOC LDB TE,DA.RES SUBI TD,(TB) ;L2-L1 SUBI TC,(TE) ;R1-R2 IMULI TD,44 ADD TD,TC JUMPLE TD,D53E.6 ;SECOND ITEM IS BEFORE FIRST ;27-APR-79 /DAW THIRD ATTEMPT AT GETTING THE SIZE RIGHT. ; 2ND ATTEMPT WAS ACK'S ON 21-MAR-75. ;DECIDE ON SOME FORM OF DISPLAY USAGE FOR THE ITEM. HRRZ TA,RENAM2 ;POINT AT LAST ITEM LDB TB,DA.USG## ;GET ITS USAGE HRRZ TA,RENAM1 ;POINT AT THE FIRST ITEM BEING RENAMED. CAIE TB,%US.D6 ;IF THE LAST ITEM IS DISPLAY-6 CAIN TB,%US.D7 ; OR DISPLAY-7, WE WILL JRST D53R.7 ; USE ITS USAGE. CAIE TB,%US.EB ;IF THE LAST ITEM IS DISPLAY-9 CAIN TB,%US.C3 ; OR COMP-3, WE WILL USE JRST D53R.5 ; DISPLAY-9. LDB TB,DA.USG## ;GET THE FIRST ITEM'S USAGE. CAIE TB,%US.D6 ;IF THE FIRST ITEM IS DISPLAY-6 CAIN TB,%US.D7 ; OR DISPLAY-7, USE CAIA ; ITS USAGE. D53R.5: MOVEI TB,%US.EB ;OTHERWISE USE DISPLAY-9. ;PICK UP THE REST OF THE STUFF WE NEED FROM THE FIRST ITEM. D53R.7: LDB TC,DA.LOC## ;GET THE STARTING LOC. LDB TE,DA.RES## ; AND RESIDUE. ;PUT THE STUFF IN THE RENAMING ITEM. HRRZ TA,CURDAT ;POINT AT IT. DPB TB,DA.USG## ;SET ITS USAGE, DPB TC,DA.LOC## ; LOCATION DPB TE,DA.RES## ; AND RESIDUE. ;NOW WE JUST NEED SIZE OF THE TOTAL ITEM. ;WE KNOW WHERE FIRST ITEM STARTS. NOW FIND OUT WHERE ; THE LAST ITEM ENDS, AND FROM THAT INFO WE CAN CALCULATE ; THE SIZE OF THE RENAMED ITEM. HRRZ TA,RENAM2 ;POINT AT LAST ITEM. LDB TB,DA.USG## ;GET ITS USAGE LDB TD,DA.EXS## ; AND SIZE. XCT BIBYSZ(TB) ;GET THE ITEM'S ACTUAL SIZE AND ; THE NUMBER OF BITS PER BYTE. ;(TC) = NUMBER OF BITS PER BYTE. ;(TD) = NUMBER OF BYTES IN THE ITEM. HRRZ TA,RENAM2 ;GET STARTING BIT POSITION FOR 2ND ITEM LDB TB,DA.RES ;TB = # BITS LEFT OVER IN 1ST WORD OF ITEM IDIV TB,TC ;GET TB= # BYTES LEFT OVER IN 1ST WORD OF ITEM ;TA= SMASHED SUB TB,TD ;GET -NUMBER LEFT JUMPG TB,D53DW1 ;ALL FIT IN THIS WORD, BITS LEFT OVER, TOO! JUMPE TB,D53DW2 ;EXACT FIT - SET LOC TO NEXT WORD, RES TO ^D36 ;TB= -# BYTES LEFT. MOVM TD,TB ;TD= + # BYTES LEFT. MOVEI TB,^D36 ;BITS/WORD IDIV TB,TC ;TB= BYTES/WORD = (BITS/WORD) / (BITS/BYTE) ;TA= SMASHED IMUL TB,TC ;BITS/WORD (^D36 IFF DIVISIBLE BY BYTE SIZE!) IMUL TC,TD ;TC= TOTAL # BITS IN ITEM IDIVI TC,(TB) ;TC= TOTAL # WORDS ;TB= BITS LEFT OVER MOVEI TE,^D36 ;COMPUTE RES.END = ^D36- # BITS LEFT OVER SUB TE,TB HRRZI TD,1(TC) ;COMPUTE LOC.END = TOT # WORDS + LOC.BEG + 1 HRRZ TA,RENAM2 LDB TB,DA.LOC ADD TD,TB JRST D53DW3 ;DONE-- TE=RES.END, TD=LOC.END D53DW1: HRRZ TA,RENAM2 ;POINT TO LAST ITEM LDB TE,DA.RES ;RES.END = RES.BEG - TOTAL * # BITS/BYTE IMUL TD,TC ;TD= TOTAL # BYTES * BITS/BYTE SUB TE,TD ;TE= RES.END (WILL BE .GT. 0) LDB TD,DA.LOC ;LOC.END = LOC.BEG JRST D53DW3 D53DW2: HRRZ TA,RENAM2 ;POINT TO LAST ITEM MOVEI TE,^D36 ;RES.END = ^D36 LDB TD,DA.LOC ;LOC.END = LOC.BEG + 1 AOJA TD,D53DW3 ;GO FIGURE OUT SIZE OF WHOLE THING ;HERE WITH TD:= COMPUTED LOC.END ; TE: = COMPUTED RES.END D53DW3: ;** CAUTION: HORRIBLE THING ABOUT TO HAPPEN **: ; WE ARE DONE WITH "RENAM1" AND "RENAM2". SO TO GET SOME ; MORE ACS, WE WILL STORE OUR COMPUTED LOC.END AND RES.END ; AWAY IN RENAM1 AND RENAM2, RESPECTIVELY. ;(HEAVEN HELP THE PROGRAMMER WITHOUT A LISTING WHO TRIES ; TO USE DDT TO SEE WHAT IS GOING ON!) MOVEM TD,RENAM1 ;STORE LOC.END MOVEM TE,RENAM2 ;STORE RES.END ;NOW DECIDE HOW MANY BYTES THIS ITEM IS HRRZ TA,CURDAT ;STORE INFO IN THE RENAMING ITEM LDB TB,DA.USG ;GET ITS USAGE (STORED EARLIER..SOME ; FLAVOR OF DISPLAY!) XCT BIBYSZ(TB) ;TC: = BITS/BYTE LDB TD,DA.RES ;RES.ST HRRZ TE,RENAM2 ;RES.END SUB TD,TE ;RES.ST-RES.END JUMPGE TD,D53DW4 ; EVEN # WORDS, OR # + REMAINDER ;ENDS BEFORE IT STARTS IN THE WORD! ; START OFF BY CALCULATING TE:= # BYTES LEFT OVER IN THE FIRST WORD, ; THEN ADD THIS TO RESULT OBTAINED WHEN WE START AT THE NEXT ; WORD BOUNDARY LDB TE,DA.RES ;RES.ST = # BITS LEFT OVER IN 1ST WORD IDIVI TE,(TC) ;TE:= # BYTES LEFT OVER IN 1ST WORD MOVEI TD,^D36 ;TD:= RES.ST LDB TA,DA.LOC ;TA:= LOC.ST AOJA TA,D53DW5 ;PRETEND WE'RE AT START OF NEXT WORD ;EVEN # WORDS, OR # + REMAINDER D53DW4: SETZ TE, ;TE= ACCUMULATED # BYTES LDB TD,DA.RES ;TD:=RES.ST LDB TA,DA.LOC ;TA:=LOC.ST ; JRST D53DW5 ;GO TO COMMON CODE ;COME HERE WITH TA= LOC.ST, TD=RES.ST, TE=# BYTES ACCUMULATED SO FAR D53DW5: HRRZ TB,RENAM2 ;RES.END SUB TD,TB ;RES.ST-RES.END (WILL BE POSITIVE NOW!) PUSH PP,TC ;SAVE # BITS/BYTE IDIVI TD,(TC) ;TD:= BYTES, TC:= REMAINDER SKIPE TC ; ROUND UP ALWAYS! ADDI TD,1 POP PP,TC ;RESTORE TC ADD TE,TD ;ADD # BYTES AT END ;NOW TE= LEFTOVER BYTES AT BEGINNING + LEFTOVER BYTES AT END ; ADD TO THAT THE NUMBER OF BYTES FROM FULL WORDS, IF ANY HRRZ TD,RENAM1 ;LOC.END SUB TD,TA ;LOC.END-LOC.ST = # OF FULL WORDS USED ;MULTIPLY BY NUMBER OF BYTES/WORD AND ADD TO BYTE TOTAL MOVEI TB,^D36 ;BITS IN A WORD IDIVI TB,(TC) ;TB: = # BYTES/WORD ;TA = SMASHED IMUL TD,TB ;GET # BYTES FROM THE FULL WORDS. ADD TE,TD ;AND WE ARE NOW DONE! HRRZ TA,CURDAT ;STORE SIZE AWAY CAILE TE,MAXWSS## ;IF IT'S TOO BIG, JRST D53E.7 ; GO COMPLAIN. DPB TE,DA.INS## ;SET THE ITEM'S SIZE. DPB TE,DA.EXS## HLRZ TB,RNREC1 ;FATHER OF RENAMING ITEM IS THE RECORD DPB TB,DA.POP SETO TB, DPB TB,DA.FAL HRRZI TB,%CL.AN DPB TB,DA.CLA ;CLASS IS ALPHANUMERIC SETO TC, ;[253] SET AS DEFINED DPB TC,DA.DEF ;[253] TSWT FFILSC; ;Skip if we are in FILE SECTION JRST D53DW6 ;Not DPB TC,DA.DFS ;Set "defined in the file section" LDB TB,DA.POP ;Get TB:= 01-item. PUSHJ PP,D53FS ;Put item in RENAMES table SETO TC, ;Get an "on" bit. D53DW6: SKIPE LNKSEC ;[450] LINKAGE SECTION? DPB TC,DA.LKS ;[450] YES, SET FLAG IN ENTRY. SETZM CURDAT POPJ PP, ;Routine to put item in RENAMES table. ;Call: ; CURDAT/ points to 66-item ; TB/ DATAB link of the 01 item ; PUSHJ PP,D53FS ; ;Uses TB,TC,TD,TE D53FS: PUSH PP,TA ;Save TA PUSH PP,TB ;01 item link is 0(pp) D53FSA: MOVE TA,RENNXT ;Get next loc MOVE TE,RENNXT ;Get another copy ADD TE,[1,,1] ;Get new "next" loc JUMPGE TE,D53FSE ; No more room, expand table MOVEM TE,RENNXT ;Store new "next" HLRZ TB,CURDAT ;Get 66-item link DPB TB,RN.66 HRRZ TB,0(PP) ;Get 01-item link DPB TB,RN.01 POP PP,TB ;restore TB POP PP,TA ;Restore TA POPJ PP, ;Return D53FSE: PUSHJ PP,XPNREN ;Go expand the RENAMES table JRST D53FSA ; and start again D53E.1: HRRZI DW,E.253 JRST DA53.E D53E.2: HRRZI DW,E.254 JRST DA53.E D53E.3: HRRZI DW,E.255 JRST DA53.E D53E.4: HRRZI DW,E.256 JRST DA53.E D53E.5: HRRZI DW,377 JRST DA53.E D53E.6: HRRZI DW,E.257 JRST DA53.E D53E.7: HRRZI DW,E.316 DA53.E: SKIPN TA,CURDAT JRST FATAL LDB LN,DA.LN LDB CP,DA.CP SETZM CURDAT JRST FATAL ;ROUTINE TO FINISH UP PROCESSING A DATA ITEM (CHECK CONSISTANCY, ;ASSIGN DEFAULTS, ASSIGN STORAGE, ETC.) INTER. DA54. DA54.: SKIPN TA, CURDAT ;DO WE HAVE A CURRENT ITEM? POPJ PP, ;NO, LEAVE. LDB TB, [POINT 3,TA,2] CAIE TB, CD.DAT ;IS HE IN DATAB. SETZB TA, CURDAT ;NO, THEN THERE IS NO CURRENT ITEM. JUMPE TA, CPOPJ ;IF THERE IS NO CURRENT ITEM, LEAVE. LDB TB, DA.LVL## ;GET THE ITEM'S LEVEL. CAIN TB, LVL.66 ;LEVEL 66? POPJ PP, ;YES, LEAVE. ;NOTE: THE FOLLOWING TWO INSTRUCTIONS WERE IN THE ORIGINAL CODE SO ; THEY ARE LEFT HERE. I DON'T UNDERSTAND THEM, SINCE IF AN ITEM IS ; NOT DEFINED IT WOULD SEEM MORE REASONABLE TO SIMPLY RETURN RATHER ; THAN SEE IF IT HAS A VALUE CLAUSE AND IF IT DOES, WRITE IT OUT, ; ESPECIALLY SINCE NO STORAGE HAS BEEN ALLOCATED FOR THE ITEM. LDB TB, DA.DEF## JUMPE TB, D54.RX IFN ANS74!FT68274,< ;CHECK FOR ALL SUBORDINATE ITEMS TO A GROUP ITEM HAVING THE SAME LEVEL NUMBER ;IF NOT ISSUE A WARNING AND IGNORE THE PROBLEM HLRZ TB,CURDAT ;GET TABLE LINK PUSHJ PP,FNDPOP ;GET FATHER JRST D54.DB ;NO FATHER LDB TA,[POINT 3,TB,20] ;GET TABLE CODE JUST TO BE SAFE CAIE TA,CD.DAT ;IT SHOULD BE JRST D54.DB ;ITS NOT! HRRZ TA,TB PUSHJ PP,LNKSET ;CONVERT LINK TO ADDRESS LDB TA,DA.SON ;GET FIRST SON JUMPE TA,D54.DB ;MUST BE ONE PUSHJ PP,LNKSET ;CONVERT TO ADDRESS LDB TC,DA.LVL ;GET LEVEL OF FIRST SON PUSH PP,TC ;SAVE IT D54.DC: LDB TC,DA.FAL ;DOES IT HAVE A BROTHER? JUMPN TC,D54.DA ;NO, GIVE UP LDB TA,DA.BRO ;GET BROTHER PUSHJ PP,LNKSET ;CONVERT TO ADDRESS LDB TC,DA.LVL ;GET ITS LEVEL CAMN TC,0(PP) ;SAME AS FIRST SON? JRST D54.DC ;YES, TRY NEXT MOVE TC,0(PP) ;NO, GET FIRST LEVEL DPB TC,DA.LVL ;CHANGE WRONG ONE (SO WE DON'T PRINT IT AGAIN) HRRZI DW,E.721 PUSHJ PP,D54E.8 ;WARN USER JRST D54.DC ;TRY AGAIN D54.DA: POP PP,(PP) ;CLEAR STACK D54.DB: MOVE TA,CURDAT ;RELOAD CURRENT POINTER > SWON ELITEM; ;ASSUME THAT THIS IS AN ; ELEMENTARY ITEM. LDB TB, DA.SON## ;GET THE ITEM'S SON LINK. JUMPE TB, D54.JD ;IF THERE IS NO SON, THIS ; MUST BE AN ELEMENTARY ITEM ; GO PROCESS IT. ;WE HAVE A GROUP ITEM. ; (TA) = ADDRESS OF CURRENT ITEM. SWOFF ELITEM; ;NOTE THAT IT IS NOT AN ; ELEMENTARY ITEM. MOVEI TB, %CL.AN ;ALL GROUP ITEMS HAVE DPB TB, DA.CLA## ;ALPHANUMERIC CLASS. LDB TB, DA.USG## ;GET THE ITEM'S USAGE. LDB TC, DA.PIC## ;IF THE ITEM DOESN'T HAVE JUMPE TC, D54.DD ;A PICTURE, ALL IS WELL. PUSHJ PP, D54E.B ;OTHERWISE COMPLAIN. D54.DD: PUSHJ PP, D54I.D ;GO MAKE SURE THIS ITEM'S ; USAGE IS OK. ; (TA) = ADDRESS OF CURRENT ITEM ; (TB) = USAGE OF CURRENT ITEM ;HERE WE CHECK TO MAKE SURE THAT ALL OF OUR FIRST LEVEL SONS AGREE ; WITH OUR USAGE. LDB TA, DA.SON## ;GET THE SON LINK. D54.DH: ANDI TA, 77777 ;GET HIS DATAB OFFSET. ADD TA, DATLOC## ;FORM THE SON'S OFFSET. LDB TC, DA.USG## ;GET THE SON'S USAGE. CAIN TB, (TC) ;IS IT THE SAME AS THE FATHER'S? JRST D54.DP ;YES, ALL IS WELL. CAIE TC, %US.D6 ;IF THE SON'S USAGE IS DISPLAY-6 CAIN TC, %US.D7 ; OR DISPLAY-7 JRST D54.DL ; IT'S BAD NEWS. CAIN TC, %US.EB ;THE SON BEING DISPLAY-9 JRST D54.DL ; IS BAD NEWS ALSO. CAIN TC, %US.C3 ;IF THE SON IS COMP-3 AND CAIN TB, %US.EB ; THE FATHER IS DISPLAY-9 OR THE JRST D54.DP ; SON IS ANY NON DISPLAY USAGE, ; ALL IS WELL. NOTE: FATHER BEING ; ONE FLAVOR OF DISPLAY AND SON ; BEING ANOTHER WOULD HAVE BEEN ; CAUGHT BY DA38. D54.DL: PUSHJ PP, D54E.C ;OTHERWISE COMPLAIN. D54.DP: LDB TC, DA.FAL## ;GET THE FATHER/BROTHER FLAG. JUMPN TC, D54.DT ;IF THERE ARE NO MORE SONS, LEAVE. LDB TA, DA.BRO## ;OTHERWISE GET THE BROTHER LINK JRST D54.DH ; AND GO CHECK HIS USAGE. D54.DT: HRRZ TA, CURDAT ;RESTORE THE CURRENT ITEM'S ADDRESS. IFN RPW,< SKIPE REPSEC ;[315] IF IN REPORT SECTION, CHECK PUSHJ PP, RPWGPC ;[315] GROUP LEVEL PARAMETERS. HRRZ TA, CURDAT ;[315] RESTORE DATAB ADRESS LDB TB, DA.USG## ;[315] AND USAGE. > ;HERE WE FIGURE OUR WHERE THE ITEM STARTS. ; (TA) = CURRENT ITEM'S DATAB ADDRESS ; (TB) = CURRENT ITEM'S USAGE LDB TA, DA.SON## ;GET THE SON LINK. ANDI TA, 77777 ;GET HIS DATAB OFFSET. ADD TA, DATLOC## ;FORM HIS ADDRESS. LDB TC, DA.RES## ;GET HIS RESIDUE. LDB TD, DA.SYR## ;IF HE WASN'T SYNCED RIGHT JUMPE TD, D54.DX ; USE THE SON'S RESIDUE MOVEI TC, 44 ;OTHERWISE MAKE THE FATHER ; START AT THE BEGINNING OF ; THE WORD. D54.DX: LDB TD, DA.LOC## ;GET THE SON'S RUNTIME LOCATION. HRRZ TA, CURDAT ;POINT AT THE CURRENT ITEM AGAIN. DPB TC, DA.RES## ;SET HIS RESIDUE. DPB TD, DA.LOC## ; AND HIS LOCATION. ;HERE WE FIGURE OUT THE ITEM'S LENGTH IN CHARACTERS. ; (TA) = CURRENT ITEM'S DATAB ADDRESS. ; (TB) = CUARRENT ITEM'S USAGE ; (TC) = CURRENT ITEM'S RESIDUE ; (TD) = CURRENT ITEM'S LOCATION HRRZ TE, EAS1PC ;GET THE LOCATION OF THE CURRENT WORD. SUBI TE, 1(TD) ;(TE) = NUMBER OF WORDS SPANNED. HLRZ TD, EAS1PC ;NUMBER OF BITS USED IN THE ; CURRENT WORD. ADDI TD, (TC) ;NUMBER OF BITS USED IN PARTIAL WORDS. IMULI TE, 44 ;NUMBER OF BITS USED IN SPANNED WORDS. ADDI TE, (TD) ;TOTAL NUMBER OF BITS USED. IDIVI TE, 44 ;NUMBER OF WORDS USED. IDIV TD, BITBYT(TB) ;NUMBER OF BYTES IN PARTIAL WORDS. IMUL TE, BYTWRD(TB) ;NUMBER OF BYTES IN FULL WORDS. ADDI TE, (TD) ;TOTAL NUMBER OF BYTES USED. CAILE TE, MAXWSS ;IS IT LARGER THAN THE ALLOWED ; MAXIMUM? PUSHJ PP, D54E.D ;YES, COMPLAIN. DPB TE, DA.EXS## ;SET THE EXTERNAL AND DPB TE, DA.INS## ; INTERNAL SIZES. ;CHECK FOR SYNCS AT A LOWER LEVEL. ; (TA) = CURRENT ITEM'S DATAB ADDRESS ; (TB) = CURRENT ITEM'S USAGE LDB TC, DA.SLL## ;IF THE SYNC AT A LOWER LEVEL FLAG JUMPN TC, D54.FL ; IS ALREADY ON, DON'T MESS WITH IT. LDB TA, DA.SON## ;GET THE SON LINK. D54.FD: ANDI TA, 77777 ;GET HIS DATAB OFFSET. ADD TA, DATLOC## ;FORM HIS ADDRESS. LDB TC, DA.SYR## ;GET HIS SYNC RIGHT FLAG JUMPN TC, D54.FH ;IF IT'S ON GO SET HIS FATHER'S ; SLL FLAG OR IF HIS LDB TC, DA.SYL## ; SYNC LEFT FLAG IS ON GO JUMPN TC, D54.FH ; SET HIS FATHER'S SLL FLAG LDB TC, DA.SLL## ; OR IF HIS SYNC AT A LOWER JUMPN TC, D54.FH ; LEVEL FLAG IS ON GO SET HIS FATHERS. LDB TD, DA.FAL## ;IF THERE ARE NO MORE SONS, JUMPN TD, D54.FH ; LEAVE LDB TA, DA.BRO## ;OTHERWISE GET THE BROTHER LINK JRST D54.FD ; AND GO CHECK HIM FOR SYNCS. D54.FH: HRRZ TA, CURDAT ;POINT AT THE CURRENT ITEM DPB TC, DA.SLL## ;SET (OR CLEAR) THE SYNC AT A ; LOWER LEVEL FLAG. ;CHECK FOR DEPENDINGS AT A LOWER LEVEL. ; (TA) = CURRENT ITEM'S DATAB ADDRESS ; (TB) = CURRENT ITEM'S USAGE D54.FL: LDB TC, DA.DLL## ;IF THE DEPENDING AT A LOWER LEVEL FLAG JUMPN TC, D54.FN ; IS ALREADY ON, DON'T MESS WITH IT. LDB TA, DA.SON## ;GET THE SON LINK. D54.FK: ANDI TA, 77777 ;GET HIS DATAB OFFSET. ADD TA, DATLOC## ;FORM HIS ADDRESS. LDB TC, DA.DLL## ;IF HIS DEPENDING AT A LOWER JUMPN TC, D54.FJ ;[1071] LEVEL FLAG IS ON GO SET HIS FATHERS. LDB TD, DA.FAL## ;IF THERE ARE NO MORE SONS, JUMPN TD, D54.FM ; LEAVE D54.FI: LDB TA, DA.BRO## ;[1071] OTHERWISE GET THE BROTHER LINK JRST D54.FK ; AND GO CHECK HIM FOR DEPENDING. ;[1071] CHECK THAT ANY OCCURS DEPENDING ITEM IS THE LAST THING IN THE RECORD. D54.FJ: LDB TD,DA.FAL ;[1071] IF THERE ARE NO MORE SONS JUMPN TD,D54.FM ;[1071] THEN ITS OK, VARIABLE BIT IS LAST LDB TD,DA.RDF ;HOWEVER IF IT'S A REDEFINES JUMPN TD,D54.FM ; ASSUME USER KNOWS WHAT HE'S DOING HRRZI DW,E.646 ;[1071] PUSHJ PP,D54E.8 ;[1071] WARN USER SETZ TC, ;[1071] PRETEND THAT ITS NOT VARIABLE JRST D54.FI ;[1071] AND TRY NEXT BROTHER D54.FM: HRRZ TA, CURDAT ;POINT AT THE CURRENT ITEM DPB TC, DA.DLL## ;SET (OR CLEAR) THE DEPENDING AT A ; LOWER LEVEL FLAG. ;HERE WE CHECK A BUNCH OF MISCELLANEOUS STUFF. ; (TA) = ADDRESS OF CURRENT ITEM. ; (TB) = USAGE OF CURRENT ITEM. D54.FN: LDB TC, DA.BWZ## ;IF THERE WAS A BLANK WHEN JUMPE TC, D54.FP ; ZERO CLAUSE PUSHJ PP, D54E.E ; IT'S AN ERROR. D54.FP: LDB TC, DA.JST## ;IF THERE WAS A JUSTIFIED JUMPE TC, D54.FT ; CLAUSE PUSHJ PP, D54E.F ; IT'S AN ERROR. D54.FT: LDB TC, DA.SYL## ;IF THERE WAS A SYNC LEFT LDB TD, DA.SYR## ; OR SYNC RIGHT IORI TC, (TD) ; CLAUSE, JUMPE TC, D54.FX ; IT'S AN PUSHJ PP, D54E.G ; ERROR. D54.FX: PUSHJ PP, D54J.D ;GO SEE IF THERE WAS A VALUE CLAUSE ; AT THIS LEVEL AND IF THERE WAS, ; CHECK IT OUT. JRST D54.RX ;GO WORRY OVER PUTTING THE VALUE ; OUT, ALLOCATING MORE SPACE IF ; THERE WAS AN OCCURS, ETC. ;WE HAVE AN ELEMENTARY ITEM. ; (TA) = ADDRESS OF CURRENT ITEM. D54.JD: IFN RPW, LDB TB, DA.USG## ;GET THE ITEM'S USAGE. PUSHJ PP, D54I.D ;GO CHECK IT OUT OR DEFAULT ; IT, IF NECESSARY. ; (TA) = ADDRESS OF CURRENT ITEM ; (TB) = USAGE OF CURRENT ITEM ;CHECK PICTURE CLAUSE. ; IT MUST BE PRESENT UNLESS THE ITEM IS INDEX OR COMP-1. LDB TC, DA.PIC## ;GET THE PICTURE FLAG. CAIE TB, %US.IN ;IS THE ITEM INDEX OR CAIN TB, %US.C1 ; COMP-1? JRST D54.JH ;YES, GO WORRY OVER IT. CAIN TB,%US.C2 ;OR COMP-2 JRST D54.JH JUMPN TC, D54.JT ;IF THERE WAS A PICTURE CLAUSE, ; GO ON. PUSHJ PP, D54E.R ;OTHERWISE GIVE AN ERROR MESSAGE JRST D54.JT ; AND GO ON. ;WORRY OVER INDEX, COMP-1, AND COMP-2 ITEMS. D54.JH: JUMPE TC, D54.JL ;IF THERE WAS NO PICTURE CLAUSE, ; ALL IS WELL PUSHJ PP, D54E.B ;OTHERWISE COMPLAIN. D54.JL: MOVEI TC, ^D8 ;ASSUME IT IS COMP-1. CAIN TB, %US.C1 ;IS IT? JRST D54.JP ;YES, GO ON. MOVEI TC,^D18 ;TRY COMP-2 CAIN TB,%US.C2 JRST D54.JP ;IT IS LDB TC, DA.EXS## ;IF THE ITEM IS INDEX AND HAS CAIE TC, ^D10 ; A SIZE OF 10, IT'S A DATABASE KEY. MOVEI TC, 5 ;OTHERWISE MAKE THE SIZE 5. D54.JP: DPB TC, DA.EXS## ;PUT THE ITEM'S SIZE IN THE DPB TC, DA.INS## ; DATAB ENTRY. MOVEI TC, %CL.NU ;SET THE ITEM'S CLASS DPB TC, DA.CLA## ; AS NUMERIC. SETO TC, ;SET THE ITEM'S DPB TC, DA.SGN## ; SIGNED FLAG. JRST D54.JX ;SKIP CHECKING CLASS AND EDITING ; SINCE WE EITHER KNOW IT'S OK ; OR HAVE ALREADY GIVEN AN ; ERROR MESSAGE. ;CHECK ELEMENTARY ITEM'S CLASS AND EDITING. ; IF THE ITEM IS NOT DISPLAY, THE CLASS MUST BE NUMERIC AND THE ; ITEM CAN NOT BE EDITED. D54.JT: LDB TC, DA.CLA## ;GET THE ITEM'S CLASS. CAIN TC, %%CL ;DO WE KNOW ITS CLASS? JRST D54.JX ;NO, THEN DON'T TRY TO CHECK IT. CAIE TB, %US.D6 ;IF THE USAGE IS DISPLAY-6 CAIN TB, %US.D7 ; OR DISPLAY-7, WE DON'T CARE JRST D54.JX ; WHAT ITS CLASS IS. CAIN TB, %US.EB ;DON'T CARE ABOUT DISPLAY-9 JRST D54.JX ; EITHER. LDB TD, DA.EDT## ;GET THE EDIT FLAG. CAIN TC, %CL.NU ;IF IT'S NOT NUMERIC OR JUMPE TD, D54.JX ; IF IT'S EDITED PUSHJ PP, D54E.S ; COMPLAIN. ;CHECK BLANK WHEN ZERO CLAUSE. ; (TA) = ADDRESS OF CURRENT ITEM ; (TB) = USAGE OF CURRENT ITEM. D54.JX: LDB TC, DA.BWZ## ;IF THERE WAS NO BLANK WHEN ZERO JUMPE TC, D54.LP ; CLAUSE, SKIP THIS TEST. LDB TC, DA.CLA## ;GET THE ITEM'S CLASS. CAIE TC, %CL.NU ;IS IT NUMERIC? JRST D54.LD ;NO, ERROR. LDB TC, DA.PWA## ;IS PIC MASK ALLOCATED? JUMPN TC, D54.JY ;YES PUSHJ PP, DA35.B ;NO, ALLOCATE IT SO EDIT CAN WORK HRRZ TA, CURDAT ;PUT TA BACK LDB TB, DA.USG ;AND TB D54.JY: CAIE TB, %US.D6 ;IF IT'S DISPLAY-6 CAIN TB, %US.D7 ; OR DISPLAY-7, JRST D54.LP ; IT'S OK. CAIE TB, %US.EB ;DISPLAY-9 IS OK TOO. D54.LD: PUSHJ PP, D54E.T ;ANYTHING ELSE IS AN ERROR. ;CHECK JUSTIFIED CLAUSE. ; (TA) = ADDRESS OF CURRENT ITEM. ; (TB) = USAGE OF CURRENT ITEM. D54.LP: LDB TC, DA.JST## ;IF THERE WAS NO JUSTIFIED JUMPE TC, D54.LT ; CLAUSE, SKIP THIS TEST. LDB TC, DA.CLA## ;IF THE ITEM'S CLASS CAIN TC, %CL.NU ; IS NUMERIC, PUSHJ PP, D54E.U ; IT' AN ERROR. ;DEFAULT SYNC CLAUSE, IF NECESSARY. D54.LT: LDB TC, DA.SYL## ;IF THERE ALREADY WAS LDB TD, DA.SYR## ;A SYNC SPECIFIED IORI TC, (TD) ; DON'T JUMPN TC, D54.LX ; DEFAULT IT. CAIE TB, %US.D6 ;DISPLAY-6 AND CAIN TB, %US.D7 ; DISPLAY-7 DON'T HAVE JRST D54.LX ; TO BE SYNCED RIGHT. CAIE TB, %US.EB ;NEITHER DOES DISPLAY-9 CAIN TB, %US.C3 ; OR COMP-3. JRST D54.LX SETO TC, ;EVERYTHING ELSE MUST DPB TC, DA.SYR## ; BE SYNCED RIGHT. ;CHECK FOR VALUE AT A HIGHER LEVEL. ; (TA) = ADDRESS OF CURRENT ITEM ; (TB) = USAGE OF CURRENT ITEM. D54.LX: LDB TC, DA.VHL## ;IF THERE IS NO VALUE AT A JUMPE TC, D54.NH ; HIGHER LEVEL, SKIP THIS TEST. LDB TC, DA.SYR## ;SYNCS ARE NOT ALLOWED. JUMPN TC, D54.ND LDB TC, DA.SYL## JUMPN TC, D54.ND LDB TC, DA.JST## ;JUSTIFICATION IS NOT ALLOWED. JUMPN TC, D54.ND CAIE TB, %US.D6 ;DISPLAY-6 AND CAIN TB, %US.D7 ; DISPLAY-7 JRST D54.NH ; ARE OK CAIE TB, %US.EB ;DISPLAY-9 IS OK TOO. D54.ND: PUSHJ PP, D54E.V ;EVERYTHING ELSE IS AN ERROR. D54.NH: PUSHJ PP, D54J.D ;GO SEE IF THER IS A VALUE ; CLAUSE AT THIS LEVEL AND IF ; THERE IS, CHECK IT OUT. ;ALLOCATE STORAGE FOR AN ELEMENTARY ITEM. LDB TC, DA.LVL## ;IF THE ITEM IS NOT CAIE TC, LVL.01 ; LEVEL 1 CAIN TC, LVL.77 ; OR LEVEL 77 JRST D54.NK JRST D54.NL ; GO ON. ;LEVEL 1 AND LEVEL 77 ITEMS MUST START ON A WORD BOUNDARY. D54.NJ: LDB TB, DA.USG## ;REPORT WRITER COMES HERE TO ; ALLOCATE SOME STORAGE. D54.NK: HLRZ TC, EAS1PC ;GET THE NUMBER OF BITS USED IN ; THE CURRENT WORD. JUMPE TC, D54.NL ;IF NONE, ALL IS WELL. AOS TC, EAS1PC ;OTHERWISE, BUMP UP TO THE NEXT WORD. HRRZM TC, EAS1PC ;SET THE NUMBER OF BITS USED TO ZERO. D54.NL: LDB TD, DA.EXS## ;GET THE ITEM'S SIZE. ;GET THE NUMBER OF BITS PER BYTE. XCT BIBYSZ(TB) ; (TA) = CURRENT ITEM'S DATAB ADDRESS ; (TB) = CURRENT ITEM'S USAGE ; (TC) = NUMBER OF BITS PER BYTE ; (TD) = NUMBER OF BYTES REQUIRED TO HOLD THE ITEM ;WE DON'T HAVE ENOUGH AC'S SO SAVE SOME STUFF. PUSH PP, TC PUSH PP, BYTWRD(TB) ;NUMBER OF BYTES PER WORD. MOVEI TB, (TD) ; (TA) = CURRENT ITEM'S DATAB ADDRESS. ; (TB) = NUMBER OF BYTES REQUIRED TO HOLD THE ITEM ; ((PP)) = NUMBER OF BYTES PER WORD. ; ((PP)-1) = NUMBER OF BITS PER BYTE ;IN THE FOLLOWING TA IS NOT MODIFIED AND TB THROUGH TE ARE USED AS TEMPS. LDB TD, DA.SYL## ;IF THE ITEM DOESN'T LDB TE, DA.SYR## ; HAVE TO BE IORI TD, (TE) ; SYNCED, SKIP JUMPE TD, D54.RD ; THE FOLLOWING. ;THE ITEM IS SYNCED, FORCE IT TO BEGIN ON A WORD BOUNDARY. HLRZ TD, EAS1PC ;IF IT ALREADY DOES, JUMPE TD, D54.NP ; GO ON. AOS TD, EAS1PC ;OTHERWISE BUMP UP TO HRRZM TD, EAS1PC ; THE NEXT WORD. D54.NP: JUMPE TE, D54.RD ;IF THE ITEM ISN'T SYNCED ; RIGHT, GO ON. ;THE ITEM IS SYNCED RIGHT, SEE HOW MANY BITS TO WASTE. MOVEI TD, (TB) ;BYTES REQUIRED. IDIV TD, (PP) ;BYTES IN FIRST WORD = REM(BYTES ; REQUIRED / BYTES PER WORD) ; (TC) = NUMBER OF BYTES THAT WILL GO IN THE FIRST WORD. JUMPE TC, D54.RD ;IF NONE, GO ON. MOVE TD, (PP) ;(TD) = NUMBER OF BYTES PER WORD. SUBI TD, (TC) ;(TD) = NUMBER OF BYTES TO WASTE. IMUL TD, -1(PP) ;(TD) = NUMBER OF BITS TO WASTE. HRLM TD, EAS1PC ;SET NUMBER OF BITS USED (WASTED) ; IN CURRENT WORD. ;NOTE: IN THE ABOVE WE CAN'T FIGURE OUT THE NUMBER OF BITS USED AND ; THEN SUBTRACT THIS FROM 36 TO GET THE NUMBER OF BITS WASTED BECAUSE ; THIS WOULD RIGHT JUSTIFY THE BYTES IN THE FIRST WORD WHICH WOULD ; SCREW UP GROUP MOVES FOR DISPLAY-7 ITEMS. D54.RD: HLRZ TD, EAS1PC ;NUMBER OF BITS USED IN CURRENT WORD. MOVEI TE, 44 SUBI TE, (TD) ;(TE) = BITS LEFT IN CURRENT WORD. IDIV TE, -1(PP) ;(TE) = BYTES WE CAN FIT IN ; CURRENT WORD. JUMPN TE, D54.RH ;IF WE CAN FIT SOMETHING IN THE ; CURRENT WORD, GO ON. AOS TD, EAS1PC ;OTHERWISE, BUMP UP TO THE ; NEXT LOCATION. HRRZM TD, EAS1PC D54.RH: HRRZ TD, EAS1PC ;SET THE ITEM'S LOCATION. DPB TD, DA.LOC## HLRZ TD, EAS1PC ;AND RESIDUE. MOVEI TC, 44 SUBI TC, (TD) DPB TC, DA.RES## ; (TA) = ADDRESS OF THE CURRENT ITEM'S DATAB ENTRY ; (TB) = NUMBER OF BYTES REQUIRED TO HOLD THE ITEM ; (TE) = NUMBER OF BYTES WE CAN FIT IN THE CURRENT WOED. ; ((PP)) = NUMBER OF BYTES PER WORD ; ((PP)-1) = NUMBER OF BITS PER BYTE PUSHJ PP, D54L.D ;GO ALLOCATE THE STORAGE. ; (TA) = ADDRESS OF THE CURRENT ITEM'S DATAB ENTRY ; (TB) = USAGE OF THE CURRENT ITEM. ; (TC), (TD), (TE) = ? ; THE ARGUMENTS THAT WERE ON THE STACK HAVE BEEN REMOVED. ;ELEMENTARY ITEM AND GROUP ITEM PROCESSING COME TOGETHER HERE. ; (TB) = CURRENT ITEM'S USAGE. D54.RX: LDB TC, DA.VAL## ;IF THERE WAS NO VALUE JUMPE TC, D54.TD ; CLAUSE, GO ON. MOVEI TA, (TC) ;OTHERWISE GO PUSHJ PP, PUTVLU ; WRITE IT OUT. HRRZ TA, CURDAT ;RESTORE THE ADDRESS OF THE LDB TB, DA.USG## ; CURRENT ITEM AND ITS USAGE. ;IF THE ITEM IS SYNCED, THE NEXT ITEM CAN NOT START IN THE SAME ; WORD THAT THE CURRENT ITEM ENDS IN. D54.TD: LDB TC, DA.SYL## ;IF THE ITEM IS SYNCED JUMPN TC, D54.TH ; LEFT, GO BUMP UP TO THE ; NEXT WORD. LDB TC, DA.SYR## ;IF THE ITEM IS NOT SYNCED JUMPE TC, D54.TL ; RIGHT, GO ON. D54.TH: AOS TC, EAS1PC ;ASSUME WE HAVE TO BUMP UP TLZN TC, -1 ;DO WE? SOSA TC, EAS1PC ;NO, BACK UP HRRZM TC, EAS1PC ;MAKE SURE THE NUMBER OF BITS ; USED IS ZERO. ;CHECK FOR OCCURS. D54.TL: LDB TC, DA.OCC## ;IF THER WAS NO OCCURS CLAUSE JUMPE TC, D54.TV ; ON THIS ITEM, GO ON. ;ALLOCATE MORE STORAGE FOR OCCURS. LDB TC, DA.NOC## ;SEE HOW MANY OCCURANCES. SOJLE TC, D54.TV ;IF IT ONLY OCCURED ONCE, WE ; HAVE ALREADY ALLOCATED SPACE ; FOR IT. COMMENT \ CASES: NO SYNC: DISPLAY AND COMP-3 MAY START AND END ANYWHERE. EVERYTHING ELSE IS SYNCED. SYNCED ITEMS: EACH OCCURANCE BEGINS IN THE SAME RELATIVE POSITION. SYNC AT THIS LEVEL - MAY START ANYWHERE, ENDS ON A WORD BOUNDARY. SYNC AT LOWER LEVEL - MAY START AND END ANYWHERE. ALGORITHM: NO SYNC: FIND ITEM'S SIZE IN BYTES, MULTIPLY BY NUMBER OF OCCURANCES, LESS ONE, AND ALLOCATE THAT MUCH MORE SPACE. SYNCED ITEMS: MOVE UP SO THAT WE START IN THE SAME RELATIVE POSITION AS THE CURRENT ITEM, FIND THE ITEM'S SIZE IN BYTES, MULTIPLY BY NUMBER OF OCCURANCES, LESS ONE, RESTORE EAS1PC, AND ALLOCATE THE SPACE. NOTES: 1. THERE MAY BE WASTED BITS BETWEEN OCCURANCES OF AN ITEM IF IT IS SYNCED OR HAS A SYNC AT A LOWER LEVEL. 2. THERE WILL BE NO WASTED BITS BETWEEN THE LAST OCCURANCE OF THE CURRENT ITEM AND THE NEXT ITEM. \ PUSH PP, EAS1PC ;SAVE THE CURRENT EAS1PC. LDB TC, DA.SYL## ;IF THE ITEM IS SYNCED LEFT JUMPN TC, D54.TP LDB TC, DA.SYR## ;OR SYNCED RIGHT JUMPN TC, D54.TP ;GO SEE IF WE HAVE TO MOVE UP. LDB TC, DA.SLL## ;IF THE ITEM IS NOT SYNCED JUMPE TC, D54.TT ; AT ALL, DON'T MOVE UP. D54.TP: LDB TC, DA.RES## ;GET THE ITEM'S RESIDUE. MOVEI TD, 44 SUBI TD, (TC) ;(TD) = NUMBER OF BITS USED ; BY THIS ITEM IN FIRST WORD. HLRZ TC, EAS1PC ;(TC) = NUMBER OF BITS USED ; BY THIS ITEM IN LAST WORD. CAIGE TD, (TC) ;ARE WE PAST THE STARTING POSITION? AOS EAS1PC ;YES, BUMP UP TO NEXT WORD. HRLM TD, EAS1PC ;MAKE SUBSEQUENT OCCURANCES ; START IN THE SAME POSITION. ;FIND THE ITEM'S SIZE IN BYTES. D54.TT: LDB TC, DA.RES## ;GET NUMBER OF BITS USED IN ; FIRST WORD. HLRZ TD, EAS1PC ;GET NUMBER OF BITS USED IN ; LAST WORD. ADDI TD, (TC) ;(TD) = BITS USED IN FIRST AND ; LAST WORDS. IDIV TD, BITBYT(TB) ;(TD) = BYTES IN FIRST AND LAST ; WORDS. LDB TC, DA.LOC## ;GET STARTING POSITION. HRRZ TE, EAS1PC ;GET CURRENT POSITION. SUBI TE, 1(TC) ;(TE) = NUMBER OF WORDS SPANNED. IMUL TE, BYTWRD(TB) ;(TE) = NUMBER OF BYTES IN ; SPANNED WORDS. ADD TD, TE ;(TD) = SIZE OF ITEM IN BYTES. POP PP, EAS1PC ;RESTORE EAS1PC. ;(TD) = SIZE OF FIRST THROUGH NTH OCCURANCE OF THE ITEM IN BYTES (NOTE ; THAT THIS SIZE MAY NOT BE THE SAME AS THE SIZE WE ALLOCATED ALREADY ; WHICH IS THE SIZE OF THE NTH OCCURANCE OF THE ITEM.) LDB TC, DA.NOC## ;GET THE NUMBER OF OCCURANCES. IMULI TD, -1(TC) ;(TD) = NUMBER OF CHARACTERS ; TO ALLOCATE. CAILE TD,MAXWSS ;WILL IT FIT? JRST D54E.D ;NO, TOO BIG ;SET UP FOR CALL TO ALLOCATION ROUTINE. PUSH PP, BITBYT(TB) ;BITS PER BYTE. PUSH PP, BYTWRD(TB) ;BYTES PER WORD. MOVEI TB, (TD) ;(TB) = NUMBER OF BYTES TO ALLOCATE. HLRZ TC, EAS1PC ;NUMBER OF BITS USED IN CURRENT ; WORD. MOVEI TE, 44 SUBI TE, (TC) ;(TE) = NUMBER OF BITS LEFT IN ; CURRENT WORD. IDIV TE, -1(PP) ;(TE) = NUMBER OF BYTES LEFT ; IN CURRENT WORD. JUMPN TE, D54.TU ;IF WE CAN FIT SOMETHING IN THIS ; WORD, GO ON. AOS EAS1PC ;OTHERWISE BUMP UP TO THE NEXT WORD. HRRZS EAS1PC ;CLEAR THE NUMBER OF BITS USED ; IN THE CURRENT WORD. D54.TU: PUSHJ PP, D54L.D ;GO ALLOCATE THE STORAGE. ;STORAGE HAS BEEN ALLOCATED FOR THE ITEM. ; (TA) = ADDRESS OF THE CURRENT ITEM'S DATAB ENTRY. ; (TB) = USAGE OF THE CURRENT ITEM. ;IF THE ITEM IS LEVEL 01 OR LEVEL 77 IT IS AUTOMATICALY SYNCED AND ; IF WE'RE IN THE FILE SECTION WE CAN ASSIGN THE RECORDING MODE. D54.TV: LDB TC, DA.LVL## ;GET THE ITEM'S LEVEL. CAIE TC, LVL.01 ;IF IT IS LEVEL 01 CAIN TC, LVL.77 ; OR LEVEL 77 JRST D54.TX ; GO SYNC IT, IF NECESSARY. JRST D54.VH ; OTHERWISE, GO ON. ;SEE IF WE HAVE TO SYNC THE ITEM. D54.TX: AOS TC, EAS1PC ;ASSUME WE ARE NOT ALREADY SYNCED. TLNN TC, -1 ;WERE WE? SOSA EAS1PC ;YES, BACK UP. HRRZM TC, EAS1PC ;SYNC THE ITEM. ;IF WE'RE IN THE FILE SECTION, SET THE RECORDING MODE. LDB TC, DA.DFS## ;IF WE'RE NOT IN THE FILE JUMPE TC, D54.VH ; SECTION, GO ON. HRRZ TA, CURFIL## ;POINT AT THE CURRENT FILE TABLE. JUMPE TA, D54.VD ;IF THERE IS NONE, GO ON. MOVE TB, RUSAGE## ;GET THE RECORD USAGE. MOVEI TC, %RM.6B ;ASSUME DISPLAY-6. CAIN TB, %US.D7 ;IF THE RECORD IS DISPLAY-7, MOVEI TC, %RM.7B ; THE RECORDING MODE IS ASCII. CAIN TB, %US.EB ;IF THE RECORD IS DISPLAY-9 MOVEI TC, %RM.EB ; THE RECORDING MODE IS EBCDIC. ;SET THE RECORDING MODE. DPB TC, FI.IRM## ;SET THE INTERNAL RECORDING MODE. LDB TD, FI.RM2## ;IF HE DIDN'T SPECIFY AN SKIPN TD ;EXTERNAL RECORDING MODE, DPB TC, FI.ERM## ; SET IT. IFN ANS74,< ;GET THE SIZE OF THE RECORD IN WORDS ;KEEP TRACK OF THE LARGEST SO THAT IS WE ARE IN DEBUG MODE ;WE CAN ALLOCATE ENOUGH SPACE FOR DEBUG-CONTENTS HRRZ TA,CURDAT SKIPN TB,RUSAGE ;GET RECORD USAGE JRST D54.VD ;IGNORE IF NOT SET? LDB TC,DA.EXS ;GET SIZE CAILE TB,%US.EB ;ONLY FOR DISPLAY MODES JRST D54.VD IDIV TC,[EXP 6,5,4]-1(TB) ;GET SIZE IN WORDS SKIPE TB ADDI TC,1 ;COUNT REMAINDER CAMLE TC,MAXDBC## ;BIGGEST YET? MOVEM TC,MAXDBC ;YES > D54.VD: HRRZ TA, CURDAT ;RESTORE THE CURRENT ITEM'S ; DATAB ADDRESS. ;CHECK REDEFINITIONS FOR SIZE. D54.VH: LDB TC, DA.RDF## ;IF THIS ISN'T A REDEFINITION, JUMPE TC, CPOPJ ; WE ARE THROUGH - LEAVE. COMMENT \ CHECK TO MAKE SURE THAT THE SIZE OF THIS ITEM IS THE SAME AS THE SIZE OF THE REDEFINED ITEM AND IF IT ISN'T MAKE SURE WE ALLOCATE ENOUGH SPACE FOR THE LARGER OF THE TWO. \ HLRZ TB, EAS1PC ;NUMBER OF BITS USED IN CURRENT WORD. CAIG TB, ^D30 ;LESS THAN 6 LEFT? JRST D54.VL ;NO, GO ON. AOS TB, EAS1PC ;BUMP UP TO NEXT WORD. HRRZM TB, EAS1PC D54.VL: SOSGE TB, RDFLVL ;BACK UP ONE LEVEL. JRST [SETZM RDFLVL ;BACKED UP TOO FAR - DEEP SNEEKERS!! EWARNJ E.380] MOVE TB, RDEFPC(TB) ;GET THE OLD EAS1PC. HLRZ TC, TB ;GET OLD NUMBER OF BITS LEFT. CAILE TC, ^D30 ;IF THERE WERE LESS THAN SIX BITS HRRZI TB, 1(TB) ; LEFT, BUMP UP TO THE NEXT WORD. CAMN TB, EAS1PC ;IF THE CURRENT EAS1PC IS THE POPJ PP, ; SAME AS THE OLD ONE, LEAVE. ;REDEFINITION IS NOT THE SAME SIZE AS THE REDEFINED ITEM. IFN MCS!TCS,< SKIPN COMSEC ;IS THIS IN THE COMMUNICATIONS SECTION? JRST D54VL1 ;NO, GIVE USUAL ERROR MESSAGE LDB TC,DA.LVL ;IS THIS A LEVEL 01? (IMPLICIT REDEFINITION). CAIE TC,LVL.01 JRST D54VL1 ;NO, A REAL ERROR. IFN ANS74,< ;JUST IGNORE THIS "ERROR" ;SINCE FCTC TESTS GET IT ON OUTPUT CD ;WHICH HAS NON-SUBSCRIPTED DEST TABLE HRRZI DW,E.642 ;TELL HIM HIS SIZE IS WRONG WITHOUT MENTIONING ; REFERRING TO THE "REDEFINITION". PUSHJ PP,D54E.8 ;. . > JRST D54VL2 ;SKIP OTHER ERROR. ;HERE TO GIVE USUAL REDEFINITION SIZE ERROR MESSAGE D54VL1: > PUSHJ PP, D54E.W ;GO COMPLAIN. D54VL2: HRRZ TC, EAS1PC ;CURRENT ENDING LOCATION. CAIGE TC, (TB) ;IF THE CURRENT ENDING LOCATION JRST D54.VP ; IS LESS THAN THE OLD ENDING ; LOCATION, GO USE THE OLD ONE. CAIE TC, (TB) ;IF THE CURRENT ENDING LOCATION POPJ PP, ; IS GREATER THAN THE OLD ONE, ; ALL IS WELL. CAMLE TB, EAS1PC ;IF WE USED MORE BITS IN THE D54.VP: MOVEM TB, EAS1PC ; LAST WORD IN THE OLD EAS1PC, ; USE IT. POPJ PP, ;RETURN. ;ERROR ROUTINES: ;ROUTINE TO SAVE TA AND TB AND SET UP LN AND CP. D54E.0: LDB LN, DA.LN## ;SET UP LN LDB CP, DA.CP## ; AND CP. D54E.1: EXCH TA, (PP) ;[674] SAVE TA PUSH PP, TB ; AND TB. PUSHJ PP, @(TA) ;GO GENERATE THE DIAG. POP PP, TB ;RETURN TO HERE, RESTORE TB POP PP, TA ; AND TA. POPJ PP, ;RETURN TO CALLER. ;ROUTINE TO GENERATE A FATAL DIAGNOSTIC. ; (DW) = THE DIAG NUMBER. D54E.2: HRRZ TA, CURDAT ;ENTER HERE IF TA IS NOT POINTING ; AT THE CURRENT DATAB ENTRY. D54E.4: SETO TC, ;TURN ON THE ERROR IN DATA DPB TC, DA.ERR## ; DIVISION FLAG. PUSHJ PP, D54E.0 ;GO SET UP LN AND CP, SAVE TA EXP FATAL## ; AND TB AND GO GENERATE THE DIAG. ;ROUTINE TO GENERATE A WARNING DIAGNOSTIC. ; (DW) = THE DIAG NUMBER. D54E.6: HRRZ TA, CURDAT ;ENTER HERE IF TA IS NOT POINTING ; AT THE CURRENT DATAB ENTRY. D54E.8: PUSHJ PP, D54E.0 ;GO SET UP LN AND CP, SAVE TA EXP WARN## ; AND TB AND GENERATE THE DIAG. COMMENT \ 21-MAR-75 /ACK ALLOW USAGE INDEX AT GROUP LEVEL. D54E.A: HRRZI DW, E.226 ;USAGE INDEX IS NOT ALLOWED AT PJRST D54E.8 ; GROUP LEVEL. \ D54E.B: HRRZI DW, E.221 ;PICTURE NOT PERMITTED. SETZ TE, DPB TE, DA.EXS## DPB TE, DA.INS## DPB TE, DA.EDT## DPB TE, DA.NDP## DPB TE, DA.DPR## PJRST D54E.8 D54E.C: HRRZI DW, E.41 ;USAGE DISAGREES WITH GROUP'S. PJRST D54E.4 D54E.D: HRRZI DW, E.316 ;SIZE OF A RECORD EXCEEDS MAXIMUM. PJRST D54E.4 D54E.E: HRRZI DW, E.222 ;BLANK WHEN ZERO ON A GROUP. SETZ TC, DPB TC, DA.BWZ## PJRST D54E.8 D54E.F: HRRZI DW, E.224 ;JUSTIFIED CLAUSE ON A GROUP ITEM. SETZ TC, DPB TC, DA.JST## PJRST D54E.8 D54E.G: HRRZI DW, E.225 ;SYNC CLAUSE ON A GROUP ITEM. SETZ TC, DPB TC, DA.SYL## DPB TC, DA.SYR## PJRST D54E.8 D54E.I: HRRZI DW, E.237 ;VALUE CLAUSE IN FILE SECTION. D54E.J: SETZ TC, DPB TC, DA.VAL## PJRST D54E.6 D54E.K: HRRZI DW, E.234 ;VALUE CLAUSE ON AN ITEM SUBORDINATE PJRST D54E.J ; TO AN ITEM WITH A VALUE CLAUSE. D54E.L: HRRZI DW, E.235 ;VALUE CLAUSE SUBORDINATE TO AN PJRST D54E.J ; OCCURS CLAUSE. D54E.M: HRRZI DW, E.270 ;VALUE CLAUSE SUBORDINATE TO PJRST D54E.J ; A REDEFINITION. D54E.N: HRRZI DW, E.329 ;NON SIXBIT CHARACTER IN LITERAL. PJRST D54E.2 D54E.O: HRRZI DW, E.236 ;NUMERIC LITERAL IN VALUE PJRST D54E.J ; CLAUSE FOR GROUP ITEM. D54E.P: HRRZI DW, E.298 ;BAD FIGURATIVE CONSTANT FOR PJRST D54E.J ; VALUE CLAUSE. D54E.Q: HRRZI DW, E.241 ;CLASS OF ITEM CONFLICTS WITH PJRST D54E.J ; LITERAL IN VALUE CLAUSE. D54E.R: HRRZI DW, E.220 ;MISSING PICTURE. PJRST D54E.4 D54E.S: HRRZI DW, E.244 ;PICTURE/USAGE CONFLICT. PJRST D54E.4 D54E.T: HRRZI DW, E.223 ;BLANK WHEN ZERO ON A NON-NUMERIC PJRST D54E.E+1 ; OR NON-DISPLAY ITEM. D54E.U: HRRZI DW, E.69 ;JUSTIFIED CLAUSE ON A PJRST D54E.F+1 ; NUMERIC ITEM. D54E.V: HRRZI DW, E.247 ;ITEM HAS A VALUE AT A HIGHER SETZ TC, ; LEVEL AND IS SYNCED, DPB TC, DA.SYR## ; JUSTIFIED OR HAS DPB TC, DA.SYL## ; WRONG USAGE. DPB TC, DA.JST## PJRST D54E.8 D54E.W: HRRZI DW, E.271 ;REDEFINITION IS NOT THE PJRST D54E.8 ; SAME SIZE AS REDEFINED ITEM. COMMENT \ THIS ROUTINE DEFAULTS, IF NECESSARY, THE USAGE OF THE CURRENT ITEM. CALL: PUSHJ PP, D54I.D ENTRY CONDITIONS: (TA) = ADDRESS OF THE CURRENT ITEM. (TB) = USAGE OF THE CURRENT ITEM. EXIT CONDITIONS: (TA) = ADDRESS OF THE CURRENT ITEM (TB) = USAGE OF THE CURRENT ITEM. NOTES: 1. FOR GROUP ITEMS EVEN IF THE USAGE IS KNOWN UPON ENTRY A DIFFERENT USAGE MAY BE RETURNED, SINCE GROUP ITEMS MUST HAVE SOME FORM OF DISPLAY USAGE. 2. THE SUBROUTINE D54I.P IS USED TO CHECK THE USAGE AND IF IT FINDS A VIABLE USAGE IT RETURNS TO THE ROUTINE WHICH CALLED THIS ROUTINE. 3. A VIABLE USAGE IS: FOR ELEMENTARY ITEMS - ANYTHING FOR GROUP ITEMS - ANY DISPLAY USAGE OR A USAGE FROM WHICH WE CAN INFER A DISPLAY USAGE FOR THE ITEM. \ D54I.D: MOVEI TC, (TB) ;SET UP FOR SUBROUTINE CALL. JSP TD, D54I.P ;GO SEE IF WE HAVE A VIABLE USAGE. ;TRY TO DEFAULT TO AN ANCESTOR'S USAGE. HLRZ TB, CURDAT ;GET LINK TO CURRENT ITEM. D54I.F: PUSHJ PP, FNDPOP ;GO FIND FATHER. JRST D54I.H ;NO FATHER, GO USE THE RECORD'S USAGE. LDB TC, [POINT 3,TB,20] ;GET FATHER'S TABLE CODE. CAIE TC, CD.DAT ;IS FATHER DATAB? JRST D54I.H ;NO, GO USE THE RECORD'S USAGE. LDB TA, [POINT 15,TB,35] ;GET FATHER'S DATAB OFFSET. ADD TA, DATLOC## ;FORM FATHER'S ADDRESS. LDB TC, DA.USG## ;GET FATHER'S USAGE. JSP TD, D54I.P ;GO SEE IF HE HAS A VIABLE USAGE. JRST D54I.F ;HE DOESN'T, GO CHECK HIS FATHER. ;CAN'T USE AN ANCESTOR'S USAGE. D54I.H: SETZ TB, ;NOTE THAT WE DON'T HAVE A USAGE YET. JRST D54I.T ;GO USE THE RECORD'S USAGE. ;ROUTINE TO SEE IF A USAGE IS VIABLE. ;CALL: JSP TD, D54I.P ;ENTRY CONDITIONS: (TC) = USAGE TO CHECK. ;EXIT CONDITIONS: ; IF THE USAGE IS NOT VIABLE SIMPLY RETURN TO CALL+1. ; IF THE USAGE IS VIABLE, RETURN TO CALLER'S CALLER WITH. ; (TA) = ADDRESS OF CURRENT ITEM. ; (TB) = USAGE OF CURRENT ITEM AND THE USAGE IN THE ITEM'S ; DATAB ENTRY. D54I.P: CAIN TC, %%US ;IS THIS ANY KIND OF USAGE? JRST (TD) ;NO, RETURN. TSWF ELITEM; ;IS THIS AN ELEMENTARY ITEM? JRST D54I.R ;YES, THEN ANY USAGE IS OK. CAIE TC, %US.D6 ;DISPLAY-6 CAIN TC, %US.D7 ; OR DISPLAY-7 JRST D54I.R ; IS OK. CAIN TC, %US.EB ;DISPLAY-9 JRST D54I.R ; IS OK TOO. CAIE TC, %US.C3 ;IS IT COMP-3. JRST (TD) ;NO, RETURN. MOVEI TC, %US.EB ;COMP-3 IMPLIES DISPLAY-9. D54I.R: HRRZI TB, (TC) ;SET UP FOR RETURN. D54I.T: SKIPE TC, RUSAGE## ;DOES THE RECORD HAVE A USAGE? JRST D54I.X ;YES, GO ON. ;SET THE RECORD'S USAGE. NOTE THAT IF A VIABLE USAGE HAS NOT BEEN GIVEN ; BY THE TIME WE SEE THE FIRST ELEMENTARY ITEM, WE WILL COME HERE. CAIE TB, %US.D6 ;IF THE ITEM IS DISPLAY-6 CAIN TB, %US.D7 ; OR DISPLAY-7 MOVEI TC, (TB) ; USE IT. CAIE TB, %US.EB ;IF THE ITEM IS DISPLAY-9 CAIN TB, %US.C3 ; OR COMP-3 MOVEI TC, %US.EB ; USE DISPLAY-9. SKIPN TC ;IF WE HAVE A RECORD USAGE NOW, ; GO ON OTHERWISE, DEFAULT IT ;WE HAVE TO DEFAULT THE RECORD'S USAGE. HRRZ TC, DEFDSP ;GET THE DEFAULT MOVEM TC, RUSAGE## ;SET THE RECORD'S USAGE. ;IF THE ITEM DOESN'T HAVE A USAGE BY NOW, GIVE IT THE RECORD'S USAGE. ; (TB) = THE ITEM'S USAGE, IF IT HAS ONE OR 0, IF IT DOESN'T. ; (TC) = THE RECORD'S USAGE. D54I.X: SKIPN TB ;DOES THE ITEM HAVE A USAGE? MOVEI TB, (TC) ;NO, GIVE IT THE RECORD'S USAGE. HRRZ TA, CURDAT ;POINT AT THE CURRENT ITEM. DPB TB, DA.USG## ;SET ITS USAGE. POPJ PP, ;RETURN TO CALLER'S CALLER. COMMENT \ THIS ROUTINE CHECKS FOR A VALUE CLAUSE AND IF ONE WAS PRESENT, CHECKS THE CHARACTERISTICS OF THE VALUE TO MAKE SURE IT IS OK. CALL: PUSHJ PP, D54J.D ENTRY CONDITIONS: (TA) = ADDRESS OF THE CURRENT ITEM (TB) = USAGE OF THE CURRENT ITEM. EXIT CONDITIONS: (TA) = ADDRESS OF THE CURRENT ITEM (TB) = USAGE OF THE CURRENT ITEM. NOTES: 1. THIS ROUTINE ONLY CHECKS THINGS IT DOESN'T WRITE THE VALUE OUT. \ D54J.D: LDB TC, DA.VAL## ;GET THE VALUE LINK. JUMPE TC, CPOPJ ;IF THERE WAS NO VALUE CLAUSE, RETURN. LDB TD, DA.DFS## ;IF WE'RE IN THE FILE SECTION, PJUMPN TD, D54E.I ; IT'S AN ERROR. LDB TD, DA.VHL## ;IT THERE IS A VALUE AT A HIGHER PJUMPN TD, D54E.K ; LEVEL, IT'S AN ERROR. LDB TD, DA.SUB## ;IF THERE IS AN OCCURS AT THIS PJUMPN TD, D54E.L ; OR AT A HIGHER LEVEL, IT'S AN ERROR. IFN MCS!TCS,< SKIPE COMSEC ; ALLOW USER TO SET VALUE IF DEFINING JRST D54JD0 ; OWN CD AREA ;NOTE: THIS WILL CAUSE TROUBLE UNLESS WE MAKE SURE THAT THERE ARE ONLY ; VALUE CLAUSES FOR ONE OF THE IMPLICITLY REDEFINED 01'S. ; THIS IS CURRENTLY NOT CHECKED FOR, SO USERS ARE ON THEIR OWN. > LDB TD, DA.RDF## ;IF THERE IS A REDEFINITION PJUMPN TD, D54E.M ; AT THIS LEVEL LDB TD, DA.RDH## ; OR AT A HIGHER LEVEL, PJUMPN TD, D54E.M ; IT'S AN ERROR. D54JD0: HRLM TC, CURLIT## ;MAKE THIS THE CURRENT LITERAL. HRRZI TA, (TC) PUSHJ PP, LNKSET HRRM TA, CURLIT## LDB TC, LI.PUR## ;GET THE NON-SIXBIT CHAR FLAG. JUMPE TC, D54J.H ;IF EVERYTHING IS SIXBIT, ALL ; IS WELL. CAIE TB, %US.D7 ;IF THE CURRENT ITEM IS CAIN TB, %US.EB ; DISPLAY-7 OR DISPLAY-9 JRST D54J.H ; ALL IS WELL. PJRST D54E.N ;OTHERWISE, GIVE AN ERROR. D54J.H: LDB TC, LI.NLT## ;IF THE LITERAL IS NOT NUMERIC JUMPE TC, D54J.L ; ALL IS WELL. TSWT ELITEM; ;OTHERWISE, IF THE ITEM IS A PJRST D54E.O ; GROUP ITEM, IT'S AN ERROR. D54J.L: LDB TD, LI.FGC## ;IF THE LITERAL IS NOT A JUMPE TD, D54J.T ; FIGURATIVE CONSTANT GO ; CHECK IT OUT. ;THE LITERAL IS A FIGURATIVE CONSTANT. LDB TC, LI.FCC## ;SEE WHICH ONE IT IS. HRRZ TA, CURDAT## ;POINT AT THE CURRENT ITEM. LDB TD, DA.CLA## ;GET ITS CLASS. CAIN TD, %CL.NU ;IS THE ITEM NUMERIC? JRST D54J.P ;YES, GO CHECK IT. CAIE TC, QUOTE. ;IS IT QUOTE CAIN TC, SPACE. ; OR SPACE? POPJ PP, ;YES, ALL IS WELL. D54J.P: CAIE TC, HIVAL. ;IS IT HIGH VALUES CAIN TC, LOVAL. ; OR LOW VALUES? POPJ PP, ;YES, ALL IS WELL. CAIN TC, ZERO. ;IS IT ZERO? POPJ PP, ;YES, ALL IS WELL. PJRST D54E.P ;ALL IS NOT WELL, COMPLAIN. ;HERE WE CHECK REGULAR LITERALS. D54J.T: HRRZ TA, CURDAT## ;POINT AT THE CURRENT ITEM. LDB TD, DA.CLA## ;GET ITS CLASS LDB TE,DA.BWZ ;GET "BLANK WHEN ZERO" FLAG SKIPN TE ;IF ON THEN ITS EDITED BY DEFINITION LDB TE, DA.EDT## ;OTHERWISE GET ITS EDIT FLAG. CAIN TD, %%CL ;DO WE KNOW ITS CLASS. POPJ PP, ;NO, THEN DON'T CHECK ANY MORE. JUMPE TC, D54J.X ;IF THE LITERAL IS NOT NUMERIC, ; GO MAKE SURE THAT THE ITEM ; ISN'T EITHER. ;THE LITERAL IS NUMERIC. CAIN TD, %CL.NU ;IF THE ITEM IS NUMERIC JUMPE TE, CPOPJ ; AND IS NOT EDITED, ALL IS WELL. PJRST D54E.Q ;OTHERWISE, IT IS AN ERROR. ;THE LITERAL IS NOT NUMERIC. D54J.X: CAIN TD, %CL.NU ;IF THE ITEM IS NUMERIC AND JUMPE TE, D54E.Q ; IS NOT EDITED, IT'S AN ERROR. POPJ PP, ;OTHERWISE, ALL IS WELL, RETURN. COMMENT \ SUBROUTINES TO SET THE NUMBER OF BYTES IN AN ITEM AND THE NUMBER OF BITS PER BYTE. CALLS: JSP TE, D54K.D/D54K.H/D54K.L/D54K.P ENTRY CONDITIONS: (TA) = ITEM'S DATAB ADDRESS (TB) = ITEM'S USAGE (TC) = ? (TD) = ITEM'S EXTERNAL SIZE EXIT CONDITIONS: (TA) = ITEM'S DATAB ADDRESS (TB) = ITEM'S USAGE. (TC) = NUMBER OF BITS PER BYTE (TD) = NUMBER OF BYTES IN THE ITEM NOTES: 1. THE NUMBER OF BYTES IN THE ITEM AND THE SIZE OF THESE BYTES ARE ONLY USED TO CALCULATE THE AMOUNT OF STORAGE REQUIRED TO HOLD THE ITEM. THEY ARE NOT THE ITEM'S EXTERNAL OR INTERNAL SIZES (IE. A COMP ITEM WITH A PICTURE OF 99 HAS AN EXTERNAL AND INTERNAL SIZE OF 2 BUT ITS SIZE IN BYTES IS 1 AND THE SIZE OF THAT BYTE IS 36 BITS. \ ;COME HERE ON COMP ITEMS. D54K.D: CAIG TD, ^D10 ;ONE OR TWO WORDS? JRST D54K.L ;ONE, SAME AS INDEX AND COMP-1. MOVEI TB, %US.2C ;TWO, MAKE IT TWO WORD COMP. DPB TB, DA.USG## ;COME HERE ON 2 WORD COMP ITEMS. D54K.H: MOVEI TD, 2 ;TWO BYTES MOVEI TC, 44 ; OF 36 BITS EACH. JRST (TE) ;RETURN. ;COME HERE ON 1 WORD COMP, COMP-1 AND INDEX ITEMS. D54K.L: MOVEI TD, 1 ;ONE BYTE MOVEI TC, 44 ; OF 36 BITS. JRST (TE) ;RETURN. ;COME HERE ON COMP-3 ITEMS. D54K.P: ADDI TD, 2 ;ADD 1 BYTE FOR THE SIGN AND ; ONE TO FORCE ROUNDING UP. LSH TD, -1 ;NUMBER OF 9 BIT BYTES REQUIRED. MOVEI TC, ^D9 ;9 BITS PER BYTE. JRST (TE) ;RETURN. COMMENT \ SUBROUTINE TO ALLOCATE STORAGE. CALL: PUSHJ PP, D54L.D ENTRY CONDITIONS: (TA) = ADDRESS OF THE CURRENT ITEM'S DATAB ENTRY (TB) = NUMBER OF BYTES TO ALLOCATE (TC) = ? (TD) = ? (TE) = NUMBER OF BYTES WE CAN FIT IN THE CURRENT WORD. ((PP)-1) = NUMBER OF BYTES PER WORD. ((PP)-2) = NUMBER OF BITS PER BYTE. EXIT CONDITIONS: (TA) = ADDRESS OF THE CURRENT ITEM'S DATAB ENTRY (TB) = USAGE OF THE CURRENT ITEM (TC), (TD), (TE) = ? THE ARGUMENTS ON THE STACK HAVE BEEN REMOVED EAS1PC HAS BEEN UPDATED \ D54L.D: CAIL TE, (TB) ;IF WE CAN FIT THE WHOLE THING JRST D54L.L ; IN THE CURRENT WORD, GO ON. JUMPE TE, D54L.H ;IF WE CAN'T FIT ANYTHING IN THE ; CURRENT WORD, GO ON. SUBI TB, (TE) ;ALLOCATE AS MUCH AS WE CAN IN ; THE CURRENT WORD. AOS TD, EAS1PC ;BUMP UP TO THE NEXT WORD. HRRZM TD, EAS1PC D54L.H: MOVEI TC, (TB) IDIV TC, -1(PP) ;(TC) = NUMBER OF WORDS TO ALLOCATE. ;(TB) = NUMBER OF BYTES TO GO ; INTO THE LAST WORD. ADDB TC, EAS1PC ;ALLOCATE THE WORDS. ;11-MAY-79 /DAW: WE WILL CHECK THE LOW SEG SIZE EACH TIME WE GET ; HERE (ALLOCATION OF A MAJOR ITEM) TO MAKE SURE IT DOESN'T JUMP ; OVER THE MAXIMUM ALLOWED LOW SEG SIZE. IT WILL ALSO BE CHECKED ; IN PHASE G, BUT WRAPAROUND COULD OCCUR AND IN SOME RARE CASES THE ; ERROR MIGHT THEN GO UNDETECTED. LOCATION "FTOOBG" IS SET TO -1 ; IF WE CAN CATCH THE ERROR HERE, SO PHASE G GETS A LITTLE HELP ; CATCHING THIS PROBLEM IF IT OCCURS. HRRZ TC,TC ;GET PC CAIL TC,MLOWSZ ;.GE. MAX LOWSEG SIZE? SETOM FTOOBG## ;YES, MAKE SURE WE KNOW BY PHASE G. D54L.L: IMUL TB, -2(PP) ;(TB) = NUMBER OF BITS TO ALLOCATE ; IN THE LAST WORD. HLRZ TC, EAS1PC ;(TC) = NUMBER OF BITS ALREADY USED. ADDI TC, (TB) ;TOTAL BITS USED IN THE LAST WORD. HRLM TC, EAS1PC CAIGE TC, 44 ;DID WE USE IT ALL UP? JRST D54L.P ;NO, GO ON. AOS TC, EAS1PC ;YES, BUMP UP TO THE NEXT WORD. HRRZM TC, EAS1PC D54L.P: POP PP, TC ;RETURN ADDRESS. POP PP, TB ;RESTORE THE STACK. POP PP, TB LDB TB, DA.USG ;GET THE ITEM'S USAGE. JRST (TC) ;RETURN. D54ZZ.: BLOCK 0 ;MAKE SURE THAT THE TABLES BELOW DON'T GET MESSED UP. N==<%%US>!<%US.D6-1>!<%US.D7-2>!<%US.EB-3>!<%US.1C-4> N==N!<%US.2C-5>!<%US.C1-6>!<%US.IN-7>!<%US.C3-10>!<%US.C2-11> IFN N,< PRINTX %D54ZZ. - TABLES ARE MESSED UP. PASS2 END > ;TABLE OF BYTES PER WORD. BYTWRD: EXP 6 ;UNKNOWN EXP 6 ;DISPLAY-6 EXP 5 ;DISPLAY-7 EXP 4 ;DISPLAY-9 EXP 1 ;ONE WORD COMP EXP 1 ;TWO WORD COMP EXP 1 ;COMP-1 EXP 1 ;INDEX EXP 4 ;COMP-3 EXP 1 ;COMP-2 ;TABLE OF BITS PER BYTE. BITBYT: EXP 6 ;UNKNOWN EXP 6 ;DISPLAY-6 EXP 7 ;DISPLAY-7 EXP 9 ;DISPLAY-9 EXP 44 ;ONE WORD COMP EXP 44 ;TWO WORD COMP EXP 44 ;COMP-1 EXP 44 ;INDEX EXP 9 ;COMP-3 EXP 44 ;COMP-2 ;TABLE OF ROUTINES TO GET THE NUMBER OF BITS PER BYTE AND IF NECESSARY ; CHANGE THE SIZE OF THE ITEM. BIBYSZ: JRST [OUTSTR [ASCIZ / ?Compiler error - D54.NL - usage wasn't assigned/] JRST KILL##] HRRZI TC, 6 ;DISPLAY-6 ==> 6 HRRZI TC, 7 ;DISPLAY-7 ==> 7 HRRZI TC, ^D9 ;DISPLAY-9 ==> 9 JSP TE, D54K.D ;COMP (MAY BE 1 OR 2 WORDS.) JSP TE, D54K.H ;2 WORD COMP. JSP TE, D54K.L ;COMP-1. JSP TE, D54K.L ;INDEX JSP TE, D54K.P ;COMP-3. JSP TE, D54K.H ;COMP-2 PUTVLU: JUMPE TA,CPOPJ HRLZM TA,CURLIT PUSHJ PP,LNKSET HRRM TA,CURLIT PUSHJ PP,ADJUST## SKIPN TA,CURDAT POPJ PP, LDB TB,DA.ERR JUMPN TB,CPOPJ ;DD ERROR --- IGNORE VALUE LDB TB,DA.USG JRST PVDPTB(TB) ;DISPATCH TO THE APPROPRIATE ROUTINE. PUTC2: SKIPN SIGNED## ;IS IT IN BINARY OR IN THE FUNNY FORMAT. JRST PUT1WC ;BINARY, GO PRETEND IT'S COMP. SKIPN SVDADR JRST PUTC21 MOVE CH,SVDWRD PUSHJ PP,PUTAS1## SETZM SVDADR PUTC21: HLRZ CH,CURDAT ANDI CH,077777 IORI CH,1B20 HRLI CH,710000 PUSHJ PP,PUTAS1 ;RELOC TO ITEM MOVE CH,[XWD 600000+ASCF2,2] ;FLOATING POINT NUMBER HEADER JRST PUT2W2 PUTC1: SKIPN SIGNED## ;IS IT IN BINARY OR IN THE FUNNY FORMAT. JRST PUT1WC ;BINARY, GO PRETEND IT'S COMP. SKIPN SVDADR JRST PUTC11 MOVE CH,SVDWRD PUSHJ PP,PUTAS1## SETZM SVDADR PUTC11: HLRZ CH,CURDAT ANDI CH,077777 IORI CH,1B20 HRLI CH,710000 PUSHJ PP,PUTAS1 ;RELOC TO ITEM MOVE CH,[XWD 600000+ASCFLT,2] ;FLOATING POINT NUMBER HEADER JRST PUT2W2 PUT2WC: SKIPN SVDADR JRST PUT2W1 ;NOTHING SAVED MOVE CH,SVDWRD PUSHJ PP,PUTAS1 SETZM SVDADR PUT2W1: HLRZ CH,CURDAT ANDI CH,077777 IORI CH,1B20 HRLI CH,710000 ;RELOC TO ITEM PUSHJ PP,PUTAS1 MOVE CH,[XWD 600000+ASCD2,2] ;2-WORD COMP HEADER PUT2W2: PUSHJ PP,PUTAS1 ;PUT OUT HEADER MOVE CH,VALUE1## PUSHJ PP,PUTAS1 MOVE CH,VALUE2## JRST PUTAS1 PUT1WC: SKIPN SVDADR JRST PUT1W1 ;NOTHING SAVED MOVE CH,SVDWRD PUSHJ PP,PUTAS1 SETZM SVDADR PUT1W1: HLRZ CH,CURDAT ANDI CH,077777 IORI CH,1B20 HRLI CH,710000 ;RELOC TO ITEM PUSHJ PP,PUTAS1 MOVE CH,[XWD 600000+ASCD1,1] PUSHJ PP,PUTAS1 ;1-WORD COMP HEADER MOVE CH,VALUE2 JRST PUTAS1 PUTDSP: SKIPN TA,SVDADR ;IF THERE ISN'T ANYTHING LEFT OVER JRST P6 ; FROM THE LAST LITERAL, GO ON. HRRZ TB,ITMLOC CAIE TB,(TA) JRST P5 ;DIFFERENT LOCATION MOVE CH,SVDWRD MOVE TE, CONVR2## ;GET THE CONVERSION INDEX. MOVE TE, PVPTRS(TE) ;PICK UP THE APPROPRIATE POINTER. HRRZ TB,ITMRES CAILE TB,44 HRRZI TB,44 DPB TB,[POINT 6,TE,5] ;RESIDUE HRRZI TC,44 ;NEXT WORD, IF ANY, WILL START HRRZM TC,ITMRES ;IN BIT 0 P1: SOSGE NCHITM## ;IF THERE IS NO MORE ROOM IN THE JRST P4 ; ITEM, GO ON. PUSHJ PP,GETCHR## ;OTHERWISE, GET A CHAR AND IDPB TC,TE ;PUT IT IN THE WORD. LDB TB,[POINT 6,TE,5] ;RESIDUE LDB TC,[POINT 6,TE,11] ;BYTE SIZE CAIL TB,(TC) JRST P1 ;IF THERE IS ROOM FOR MORE IN THIS WORD, LOOP. ;FIRST WORD IS FULL, WRITE IT OUT. PUSHJ PP,PUTAS1 SETZ CH, AOS SVDADR ;COME HERE TO START A NEW WORD FOR A NEW ITEM. P1.5: SKIPG NCHITM ;IF THERE IS MORE ROOM IN THE ITEM GO ON. JRST P7 ;OTHERWISE, NOTE THAT WE DON'T HAVE TO ; WRITE OUT MORE LATER ON AND RETURN. HRRZI TC,44 SUB TC,ITMRES ;(TC) = # OF BITS USED IN THIS WORD. CAIGE TC,0 SETZ TC, MOVE TB,NCHWRD## ;GET BYTES PER WORD IDIV TC,PVBPB-4(TB) ;DIVIDE BY BITS PER BYTE ADD TC,NCHITM ;(TC) = # OF BYTES TO END OF ITEM FROM ; BEGINNING OF THIS WORD. IDIV TC,NCHWRD ;(TC) = # OF WORDS NEEDED. JUMPE TB,.+2 HRRZI TC,1(TC) ;THERE WILL BE SOMETHING LEFT OVER ; SO MAKE IT ONE WORD LONGER. MOVE CH,CONVR2## ;GET THE CONVERSION INDEX. HRLZ CH,PVASCD(CH) ;GET THE ASSEMBLY CODE. HRRI CH,(TC) PUSHJ PP,PUTAS1 MOVE TE, CONVR2## ;GET THE CONVERSION INDEX. MOVE CH, PVBLKS(TE) ;GET SOME FORM OF BLANKS. MOVE TE, PVPTRS(TE) ;GET THE APPROPRIATE POINTER. HRRZ TB,ITMRES DPB TB,[POINT 6,TE,5] JRST P3 P2: AOS SVDADR PUSHJ PP,PUTAS1 MOVE TE, CONVR2## ;GET THE CONVERSION INDEX. MOVE CH, PVBLKS(TE) ;GET SOME FORM OF BLANKS. MOVE TE, PVPTRS(TE) ;GET THE APPROPRIATE POINTER. P3: SOSGE NCHITM JRST P4 PUSHJ PP,GETCHR IDPB TC,TE LDB TB,[POINT 6,TE,5] ;RESIDUE LDB TC,[POINT 6,TE,11] ;BYTE SIZE CAIL TB,(TC) JRST P3 ;ROOM FOR MORE IN THIS WORD JRST P2 ;WORD IS FULL P4: LDB TB,[POINT 6,TE,5] CAIN TB,44 JRST P7 MOVEM CH,SVDWRD HRLM TB,SVDADR POPJ PP, P5: MOVE CH,SVDWRD PUSHJ PP,PUTAS1 P6: HLRZ CH,CURDAT ANDI CH,077777 IORI CH,1B20 HRLI CH,710000 PUSHJ PP,PUTAS1 HRRZ TB,ITMLOC## HRRZM TB,SVDADR HRRZ TB,ITMRES## HRLM TB,SVDADR## JRST P1.5 P7: SETZM SVDADR ;NOTE THAT WE DON'T HAVE TO POPJ PP, ; WRITE OUT MORE LATER ON AND RETURN. ;MAKE SURE THAT THE TABLE BELOW DOESN'T GET MESSED UP. N==<%%US>!<%US.D6-1>!<%US.D7-2>!<%US.EB-3>!<%US.1C-4> N==N!<%US.2C-5>!<%US.C1-6>!<%US.IN-7>!<%US.C3-10>!<%US.C2-11> IFN N,< PRINTX %PVDPTB - TABLE IS MESSED UP. PASS2 END > ;DISPATCH TABLE - INDEX BY USAGE. PVDPTB: POPJ PP, ;NOT DEFINED. JRST PUTDSP ;DISPLAY-6. JRST PUTDSP ;DISPLAY-7. JRST PUTDSP ;DISPLAY-9. JRST PUT1WC ;1-WORD COMP. JRST PUT2WC ;2-WORD COMP. JRST PUTC1 ;COMP-1. JRST PUT1WC ;INDEX. JRST PUTDSP ;COMP-3 (PRETEND IT'S DISPLAY-9) JRST PUTC2 ;COMP-2. ;TABLES USED BY PUTDSP - INDEX BY CONVR2. ;BLANKS. PVBLKS: BYTE (9)100,100,100,100 ;COMP-3. Z ;SIXBIT. ASCII / / ;ASCII. BYTE (9)100,100,100,100 ;EBCDIC. ;POINTERS. PVPTRS: POINT 9,CH ;COMP-3. POINT 6,CH ;SIXBIT. POINT 7,CH ;ASCII. POINT 9,CH ;EBCDIC. ;ASSEMBLY CODES. PVASCD: EXP AS.EBC## ;COMP-3. EXP AS.SIX## ;SIXBIT. EXP AS.ASC## ;ASCII. EXP AS.EBC## ;EBCDIC. ;NUMBER OF BITS PER BYTE - INDEX BY CHAR'S PER WORD - 4. PVBPB: EXP 9 ;EBCDIC AND COMP-3. EXP 7 ;ASCII. EXP 6 ;SIXBIT. SUBTTL REPORT WRITER SYNTAX IFN RPW, < ; CHECK REPORT ITEM FOR CORRECT PARAMETERS [315] RPWITC: SKIPGE RPWERR ; [335] ANY FATAL REPORT GENERATOR POPJ PP, ; [335] LDB TB,DA.RPW ; [315] GET DATAB LINK TO REPORT ITEM JUMPE TB,RPWITX ; [315] NOT A REPORT ITEM EXIT HRLZM TB,CURRPW ; [315] KEEP IT MOVE TA,RPWLOC ; [315] CONVERT RPWTAB RELATIVE ADDI TA,(TB) ; [315] TO REAL ONE HRRM TA,CURRPW ; [315] KEEP IT PUSHJ PP,RPWLCH ; [315] CHECK LINE NUMBER IF ANY PUSHJ PP,RWCLC ;[V10] GO CHECK LINE AND COLUMN CLAUSES. LDB TB,RW.NLC ; [315] NEXT GROUP ILLEGAL JUMPE TB,RPWITA ; [315] AT ITEM LEVEL HRRZ TA,CURDAT ; [315] UNLESS ITEM IS LDB TB,DA.LVL ; [315] AT 01 LEVEL SOJN TB,RPWIT4 ; [315] ERROR HRRZ TA,CURRPW ; [315] GET BACK REPORT ITEM RPWITA: LDB TB,RW.SCD ; [315] GET "SOURCE" CODE JUMPE TB,RPWIT2 ; [315] NONE- ERROR CAIE TB,%RG.VL ; [315] VALUE ? JRST RPWIT1 ; [315] NO- GO ON LDB TB,RW.GPI ; [315] DO WE HAVE GROUP INDICATE? JUMPE TB,RPWIT1 ; [315] IF ZERO- NO ; HERE IF GROUP INDICATE WITH A VALUE CLAUSE MAKE ENTRY INTO ; HLDTAB- IN CLEANC WE WILL CONVERT TO SOURCE ITEM FROM VALUE MOVE TA,[CD.HLD,,SZ.HLD] ; [315] MAKE A HLDTAB ENTRY PUSHJ PP,GETENT ; [315] GET THE SPACE MOVEM TA,CURHLD ; [315] SAVE HLDTAB ADDRESS HRRZI TD,%HL.GI ; [315] SET G.I. HLDTAB CODE DPB TD,HL.COD ; [315] STORE IN HLDTAB HLRZ TB,CURDAT ; [315] GET DATAB RELATIVE ADDRESS DPB TB,HL.LNK ; [315] STORE INTO HLDTAB HRRZ TA,CURDAT ; [315] GET REAL DATAB ADDRESS LDB TB,DA.VAL ; [315] GET DATAB VALUE LINK LDB TD,DA.LNC ; [315] GET LINE AND CHAR POS SETZ TC, ; [315] CLEAR DPB TC,DA.VAL ; [315] THE VALUE LINK IN DATAB HRRZ TA,CURHLD ; [315] GET BACK HLDTAB ADDRESS DPB TB,HL.NAM ; [315] STORE VALUE LINK HERE DPB TD,HL.LNC ; [315] STORE LINE AND CHAR POS HRRZ TA,CURRPW ; [315] GET REPORT TAB ITEM ADDR MOVEI TB,%RG.SR ; [315] CHANGE SOURCE CODE FROM DPB TB,RW.SCD ; [315] VALUE TO SOURCE ; THE NEW SOURCE ITEM TO MADE IN CLEANC RPWIT1: LDB TB,RW.COL ; [315] GET COLUMN NUMBER JUMPE TB,RPWITX ; [315] NONE-NO CHECK SKIPE RWLCS.## ;IF HE HAS GIVEN A LINE CLAUSE JRST RPWT1D ; ALL IS WELL. SETOM RWLCS.## ;ONLY COMPLAIN ONCE. HRRZI DW,E.497 JRST RPWITE RPWT1D: LDB TC,RW.LCD ; [315] IF IT IS A NEW LINE SKIPE TC ; [315] THEN START COLUMN NUMBER FROM ZERR SETZM LASCOL ; [315] CAMG TB,LASCOL ; [315] MUST BE GREATER THAN LAST COL IN GROUP JRST RPWIT3 ; [315] IT ISNT-ERROR MOVEM TB,LASCOL ; [315] OKAY- UPDATE LAST COL RPWITX: MOVE TA,CURDAT ; [315] RESTORE DATAB ADDRESS POPJ PP, ; [315] RPWITC EXIT POINT RPWIT2: HRRZI DW,E.475 ; [315] NO SOURCE/VALUE/SUM ERROR JRST RPWITE ; [315] RPWIT3: HRRZI DW,E.474 ; [315] COLUMN NUMBER TOO LOW JRST RPWITE ; [315] RPWIT4: HRRZ TA,CURRPW ;[527] GET CORRECT TABLE SETZ TB, ; [315] CLEAR NEXT GROUP DPB TB,RW.NLC ; [315] HRRZI DW,E.480 ; [315] NEXT GROUP ILLEGAL ; JRST RPWITE ; [315] GIVE ERROR MESSAGE AND EXIT RPWITE: MOVE TA,CURDAT ; [315] GET DATAB ADDRESS LDB LN,DA.LN ; [315] GET LINE NUMBER LDB CP,DA.CP ; [315] GET CHARACTER POSITION JRST FATAL ; [315] FATAL ERROR AND RETURN ; CHECK REPORT GROUP FOR CORRECT PARAMETERS [315] RPWGPC: SETZM LASCOL ; [315] CLEAR LAST COLUMN AT GROUP LEVEL SKIPGE RPWERR ; [335] ANY FATAL REPORT GENERATOR POPJ PP, ; [335] LDB TB,DA.RPW ; [315] GET DATAB LINK TO REPORT ITEM JUMPE TB,RPWITX ; [315] NOT A REPORT GROUP EXIT HRLZM TB,CURRPW ; [315] KEEP IT MOVE TA,RPWLOC ; [315] CONVERT RPWTAB RELATIVE ADDI TA,(TB) ; [315] TO REAL ONE HRRM TA,CURRPW ; [315] KEEP IT PUSHJ PP,RPWLCH ; [315] CHECK LINE NUMBER IF ANY LDB TB,RW.SCD ; [315] GET SOURCE CODE JUMPN TB,RPWGE1 ; [315] ERROR IF AT GROUP LEVEL RPWGP1: LDB TB,RW.COL ; [315] COLUMN NUMBER JUMPN TB,RPWGE2 ; [315] IS ILLEGAL PUSHJ PP,RWCLC ;[V10] GO CHECK LINE AND COLUMN CLAUSES. RPWGP2: LDB TB,RW.GPI ; [315] GROUP INDICATE JUMPN TB,RPWGE3 ; [315] IS ILLEGAL RPWGP3: LDB TB,RW.RSF ; [315] RESET ON FINAL LDB TC,RW.RSI ; [315] OR RESET ON IDENTIFIER JUMPN TB,RPWGE4 ; [315] ARE BOTH JUMPN TC,RPWGE4 ; [315] ILLEGAL RPWGP4: LDB TB,RW.NLC ; [315] NEXT GROUP ILLEGAL JUMPE TB,RPWITX ; [315] NONE OKAY HRRZ TA,CURDAT ; [315] NEXT GROUP OKAY LDB TB,DA.LVL ; [315] ONLY AT 01 LEVEL CAIN TB,LVL.01 ; [315] JRST RPWITX ; [315] 01 OKAY EXIT HRRZ TA,CURRPW ;[527] GET CORRECT TABLE SETZ TB, ; [315] CLEAR DPB TB,RW.NLC ; [315] NEXT GROUP CODE MOVEI DW,E.480 ; [315] NEXT GROUP ERROR RPWGEE: MOVE TA,CURDAT ; [315] GET DATAB ADDRESS LDB LN,DA.LN ; [315] GET LINE NUMBER LDB CP,DA.CP ; [315] GET CHARACTER POSITION HRRZ TA,CURRPW ; [315] RESTORE REPORT ITEM FOR MORE CHECKS JRST FATAL ; [315] FATAL ERROR AND RETURN RPWGE1: SETZ TB, ; [315] CLEAR DPB TB,RW.SCD ; [315] SOURCE TYPE MOVEI DW,E.479 ; [315] SOURCE / SUM / VALUE ERROR PUSHJ PP,RPWGEE ; [315] GIVE ERROR MESSAGE JRST RPWGP1 ; [315] DO MORE ERROR CHECKING RPWGE2: SETZ TB, ; [315] CLEAR DPB TB,RW.COL ; [315] COLUMN NUMBER MOVEI DW,E.478 ; [315] COLUMN ERROR NUMBER PUSHJ PP,RPWGEE ; [315] GIVE ERROR MESSAGE JRST RPWGP2 ; [315] DO MORE ERROR CHECKING RPWGE3: SETZ TB, ; [315] CLEAR DPB TB,RW.GPI ; [315] GROUP INDICATE MOVEI DW,E.477 ; [315] ERROR NUMBER PUSHJ PP,RPWGEE ; [315] ERROR MESSGE JRST RPWGP3 ; [315] MORE ERROR CHECKING RPWGE4: SETZ TB, ; [315] CLEAR DPB TB,RW.RSF ; [315] RESET CODES DPB TB,RW.RSI ; [315] MOVEI DW,E.476 ; [315] ERROR MESSAGE PUSHJ PP,RPWGEE ; [315] JRST RPWGP4 ; [315] MORE ERROR CHECKING ; CHECK LINE PARAMETER TO SEE IF WITHIN BOUNDS RPWLCH: LDB TD,RW.TYP ; [315] LINE TYPE JUMPE TD,CPOPJ ; [315] NONE-EXIT LDB TC,RW.LCD ; [315] GET LINE CODE CAIE TC,%RG.LN ; [315] DO WE HAVE LINE INTEGER? POPJ PP, ; [315] NOT LINE INTEGER LDB TC,RW.LIN ; [315] GET LINE NUMBER PUSHJ PP,GETRDL ; [315] MAKE PTR TO RD ENTRY LDB TB,RW.PAG## ; [315] GET PAGE-LIMIT JUMPE TB,RPWLHX ; [315] NONE-SPECIFIED NO CHECKS THEN CAIE TD,%RG.RH ; [315] REPORT HEADING CAIN TD,%RG.RF ; [315] OR REPORT FOOTING? JRST RPWLH3 ; [315] YES CHECK IT CAIN TD,%RG.PH ; [315] PAGE-HEADING ? JRST RPWLH4 ; [315] YES CHECK IT CAIG TD,%RG.DE ; [315] CONTROL HEADING OR DETAIL LINE? JRST RPWLH5 ; [315] YES CHECK IT CAIN TD,%RG.CF ; [315] CONTROL FOOTING? JRST RPWLH6 ; [315] YES CHECK IT ; [315] THEN IT IS PAGE FOOTING LDB TB,RW.CFL ; [315] PAGE FOOTING MUST BE LDB TD,RW.PAG ; [315] FROM FOOTING TO PAGE-LIMIT MOVEI DW,E.487 ; [315] SET UP ERROR NUMBER JRST RPWLH7 ; [315] GO CHECK RPWLH3: LDB TB,RW.PHL ; [315] RH OR RF- MUST BE FROM HEADING LDB TD,RW.PAG ; [315] TO PAGE-LIMIT MOVEI DW,E.486 ; [315] SET UP ERROR NUMBER JRST RPWLH7 ; [315] GO CHECK IT RPWLH4: LDB TB,RW.PHL ; [315] PH MUST BE FROM HEADING LDB TD,RW.FDE ; [315] TO FIRST DETAIL MOVEI DW,E.485 ; [315] GET ERROR NUMBER JRST RPWLH7 ; [315] GO CHECK IT RPWLH5: LDB TB,RW.FDE ; [315] CH OR DE MUST BE FROM FIRST DETAIL LDB TD,RW.LDE ; [315] TO LAST DETAIL MOVEI DW,E.484 ; [315] GET ERROR NUMBER JRST RPWLH7 ; [315] CHECK IT RPWLH6: LDB TB,RW.FDE ; [315] CF MUST BE FROM FIRST DETAIL LDB TD,RW.CFL ; [315] TO FOOTING MOVEI DW,E.483 ; [315] GET ERROR NUMBER RPWLH7: CAML TC,TB ; [315] LINE NUMBER WITHIN RANGE SET UP CAMLE TC,TD ; [315] UPPER LIMIT ; [315] OKAY- STORE LINE NUMBER JRST RPWGEE ; [315] NO- GIVE ERROR AND RETURN RPWLHX: HRRZ TA,CURRPW ;RESTORE PTR TO GROUP ITEM DPB TC,RW.LIN ;OK, STORE IT POPJ PP, ; [315] RETURN RWCLC: HRRZ TA, CURDAT ;[V10] POINT AT DATAB. LDB TB, DA.LVL## ;[V10] GET THE LEVEL. SOJN TB, RWCLCH ;[V10] IF IT'S NOT 01, GO ON. SKIPE RWLCS.## ;[V10] IF WE HAVE SEEN A SKIPE RWCCS.## ;[V10] LINE CLAUSE BUT NOT A JRST RWCLCH ;[V10] COLUMN CLAUSE, WARN THE HRRZI DW, E.586 ;[V10] USER THAT WE'RE GOING LDB LN, DA.LN## ;[V10] TO SKIP LINES WITHOUT LDB CP, DA.CP## ;[V10] PRINTING ANYTHING. PUSHJ PP, WARN## RWCLCH: HRRZ TA, CURRPW ;[V10] POINT AT THE RPWTAB ENTRY. POPJ PP, ;[V10] RETURN. >; [315] END OF IFN RPW INTER. DA55. DA55.: PUSHJ PP,DA47.A ;[674] SKIPN TA,CURDAT JRST DA55.X LDB TB,DA.VAL JUMPN TB,JCE16. HLRZ TB,CURLIT DPB TB,DA.VAL IFN RPW,< SKIPN REPSEC ;DOING A REPORT ITEM? JRST DA55.X ;NO HRRZ TA,CURRPW ;GET RPWTAB PTR HRRZI TB,%RG.VL ;GET VALUE CODE DPB TB,RW.SCD ;PUT IN SOURCE CODE FIELD > DA55.X: SKIPE LNKSEC ;LINKAGE SECTION? EWARNJ E.89 ;?VALUES ILLEGAL IN LINKAGE SECTION POPJ PP, INTER. DA56. DA56.: PUSHJ PP,DA11. HRRZ TA,CURDAT ;[243] GET CURRENT DATAB ADDRESS LDB TB,DA.ERR ;[243] DID WE HAVE AN ERROR (USER) JUMPE TB,DA56.1 ;[243] NO GO ON SETZ TC, ;[243] YES DATAB TABLE NOT EXTENED FOR OCCURS JRST DA56.B ;[243] GO TO CLEAR NO. OF OCCURS AND EXIT DA56.1: MOVE TC,0(SAVPTR) ;[243] NO OF OCCURS CAIGE TC,1 EWARNJ E.25 CAIG TC,77777 JRST DA56.A EWARNW E.593 HRRZI TC,77777 HRRZM TC,0(SAVPTR) DA56.A: HRRZ TA,CURDAT LDB TB,DA.NOC CAIG TC,(TB) EWARNJ E.272 DA56.B: DPB TC,DA.NOC ;[243] NEW LABEL POPJ PP, INTER. DA57. DA57.: PUSHJ PP,DA60S. ;SAVE NAMTAB ADDR PUSHJ PP,DA25S. ;SET UP HLDTAB ENTRY HRRZI TB,%HL.DP ;DEPENDING-FOR-OCCURS CODE DPB TB,HL.COD HLRZ TB,CURDAT ;STORE DATAB LINK IN HLDTAB DPB TB,HL.LNK HLRZ TA,CURDAT PUSHJ PP,LNKSET SETO TB, DPB TB,DA.DLL## ;MARK THAT AN OCCURS DEPENDING HAS BEEN SEEN POPJ PP, ;SD SORT-FILE-NAME INTER. DA58. DA58.: SKIPN TA,CURFIL POPJ PP, SETO TB, DPB TB,FI.DSD## ;DEFINED IN AN SD IFN ANS68,< POPJ PP, > IFN ANS74,< SKIPN FLGSW## ;NEED FIPS FLAGGER? POPJ PP, ;NO LDB LN,FI.LN## ;GET LN & CP LDB CP,FI.CP## ; OF SELECT CLAUSE MOVEI TA,%LV.HI PUSHJ PP,FLG.ES## ;AND FLAG IT AT HIGH-INTERMEDIATE MOVE TA,CURFIL LDB LN,FI.ALN## ;SEE IF WE HAVE TO FLAG "SAME [RECORD] AREA" JUMPE LN,CPOPJ ;NO LDB CP,FI.ACP## LDB TA,FI.RLC## ;GET [RECORD] FLAG SKIPN TA SKIPA TA,[%LV.HI] ;HIGH-INTERMEDIATE IF "SAME AREA" MOVEI TA,%LV.H ;HIGH IF [RECORD] JRS