Google
 

Trailing-Edge - PDP-10 Archives - BB-Z759A-SM - cobol-source/cobolc.mac
There are 20 other files named cobolc.mac in the archive. Click here to see a list.
; UPD ID= 1533 on 2/22/84 at 9:32 AM by HOFFMAN                         
TITLE	COBOLC V13
SUBTTL	DATA DIV. SYNTAX SCAN		W.NEELY/CAM/SEB

	SEARCH COPYRT
	SALL

;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, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	P
	%%P==:%%P
	DBMS==:DBMS
	DEBUG==:DEBUG
	MCS==:MCS

	IFN TOPS20,<SEARCH MONSYM,MACSYM>

TWOSEG
	.COPYRIGHT		;Put standard copyright statement in REL file
SALL
RELOC	400000

;EDITS
;NAME	DATE		COMMENTS
;JEH	14-FEB-84	[1515] If defining implied indexes for REPORT SECTION,
;				check PCHOLD for correct core assignment
;SMI	23-Feb-83	[1452] Error 370 when RPWTAB get expanded.
;JEH	18-Nov-82	[1424] Fatal error on COMP, COMP-1, and INDEX fields in ASCII file.
;RLF	 2-Aug-82	[1376] Corrects diagnostic when line before FD is too long.
;RJD	15-Jul-82	[1373] Corrects page advancing when more than 2 report header lines.
;JEH	14-Jun-82	[1366] Correct 1335, set up CURHLD properly.
;JEH	 7-Jun-82	[1362] Make HLDSAV external.
;RJD	24-May-82	[1356] Allow qualification in DATA RECORDS ARE clause.
;JEH	30-Mar-82	[1346] Fatal error if too many ascending/descending keys.
;JEH	 2-Feb-82	[1335] Declare DATAB entries for all indices if REPORT SECTION
;				is scanned for their use by REPORT WRITER statements.

;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 CATASTROPHE 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.
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
	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,<PUSHJ PP,PTPOP.##>	;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	BLDIX##		;[1335]
	SETOM	PCHOLD##
	SETZM	SVDADR
	SETZM	WSAS1P
	SETZM	IDXLST##
	SETOM	LSTW77##	;LAST LEVEL NUMBER WAS NOT 77.
	SETZM	LASTRD##	;INIT LAST RD PTR
DA1.X:	SETZM	EAS1PC##
DA1.Y:	SETZM	EAS2PC##
	SETZM	CFLM
	POPJ	PP,
	INTER.	DA2.
DA2.:	SWON	FFILSC;
	SETOM	FILSEC##	;SET FILE-SECTION-SEEN FLAG
	SETZM	REPSEC		;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##
	JRST	DA1.X

	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;
	SETZM	REPSEC		;CLR REPORT SECTION FLAG
	MOVE	TA,WSAS1P
	MOVEM	TA,EAS1PC
	SETZM	LAST01##
	JRST	DA1.Y
;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:	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
	CAIN	TYPE,AMRGN.+RD.
	JRST	DA5.X
IFN DBMS,<
	CAIE	TYPE,AMRGN.+SCHEM.
>
	CAIN	TYPE,AMRGN.+FD.
	JRST	DA5.X
IFN MCS,<
	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.
	SETZM	LASTYP		;CLR LAST RPW TYPE SEEN STORAGE
	SETZM	LASCOL		; [315] CLR LAST COLUMN SEEN IN GROUP
	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
	SKIPN	FLGSW##		;NEED FIPS FLAGGER?
	JRST	DA9.1		;NO
	LDB	LN,GWLN 	;GET LN
	LDB	CP,GWCP		; & 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##
	JRST	DA1.X

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.ORG##
	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,03
	DPB	TC,[POINT 14,TB,13]
	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
	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	TB,FI.MRS	;GET MAXIMUM SIZE WE NEED
	MOVEM	TB,TBLOCK+1	;USE SIZE AS NON-ZERO FLAG ALSO
	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
	SKIPE	TC,TBLOCK+1	;VARIABLE LENGTH SYNTAX
	CAMG	TB,TC		;MUST BE AT LEAST BIG ENOUGH
	JRST	D10A.4		;ITS OK
	LDB	LN,DA.LN
	LDB	CP,DA.CP
	MOVEI	DW,E.758	;RECORD IS NOT BIG ENOUGH
	PUSHJ	PP,FATAL
D10A.4:	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.
	SETO	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	TB,FI.DRL	;[723] SO FIND MAX. RECORD
	JUMPE	TB,[LDB	TB,FI.RPG	;[1011] IF ITS A REPORT FILE
		JUMPN	TB,DA10.X	;[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
	LDB	TA,FI.DRL	;POINT TO FIRST DATA RECORD
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.I	;[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
	JRST	DA10.I		;[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
DA10.I:	HRRZ	TA,CURFIL	;[624] 
DA10.F:	HRRZ	TB,TBLOCK	;[624]
	DPB	TB,FI.MRS

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,

D10E.1:	HRRZ	TA,CURDAT
	LDB	LN,DA.LN##
	LDB	CP,DA.CP
	HRRZI	DW,E.104	;'NOT DEFINED'
	JRST	FATAL
	INTER.	DA11.
DA11.:	TLNE	W1,GWNLIT	;IS ITEM NUMERIC LITERAL?
	TLNE	W1,GWDP		;YES, IS IT INTEGER?
	JRST	DA11.E		;NO
	LDB	TB,GWVAL	;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.:	HRLZM	LN,RCLNCP##	;SAVE LN AND CP
	HRRM	CP,RCLNCP	;SO WE CAN FLAG IT RIGHT
	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##	;MAX. DATA RECORD SIZE
	CAIGE	TC,(TB)
	DPB	TB,FI.MRS
	LDB	TC,FI.LRS
	CAIG	TC,(TB)		;MIN. GREATER THAN MAX.?
	POPJ	PP,
	EWARNJ	E.847		;YES

	INTER.	DA15T.
DA15T.:	SETZ	TB,
	EXCH	TB,0(SAVPTR)
	SKIPN	TA,CURFIL
	POPJ	PP,
	LDB	TC,FI.LRS##	;MIN. DATA RECORD SIZE
	SKIPE	TC		;BUT NOT ZERO
	CAILE	TC,(TB)
	DPB	TB,FI.LRS
	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##
	JUMPE	TA,DA25F.	;TEST FOR FIPS FLAGGER
	LDB	TB,FI.RPG##	;HAVE WE ALREADY SEEN A REPORT CLAUSE?
	JUMPE	TB,DA25F.	;NO
	EWARNW	E.749		;YES, WARN USER
	JRST	DA25F.		;TEST FOR FIPS FLAGGER

	INTER.	DA17.
DA17.:	PUSHJ	PP,TRYNAM
	  PUSHJ	PP,BLDNAM
	HLRZ	TB,TA		;GET NAMTAB LINK (ITS ALL WE HAVE)
	SKIPE	TA,CURFIL	;GET CURRENT FILE
	DPB	TB,FI.DEP##	;STORE DEPENDING VARIABLE
	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.	DA18A.		;[1356]
DA18A.:	PUSHJ	PP,TRYNAM	;[1356] IS NAME IN TABLE?
	  JRST	DA18B.		;[1356] NO
	HLRZS	TA		;[1356] SET UP REL ADDR AND
	HRRZI	TB,CD.FIL	;[1356] TYPE CODE FOR TABLE SEARCH
	PUSHJ	PP,FNDLNK	;[1356] SEARCH FILTAB
	  JRST	DA18B.		;[1356] ENTRY NOT FOUND
	MOVE	TA,CURFIL	;[1356] GET CURRENT FILE ADDR
	CAMN	TA,TB		;[1356] SAME FILE USED TO QUALIFY?
	POPJ	PP,		;[1356] YES
DA18B.:	EWARNJ	E.190		;[1356] GIVE IMPROPER QUALIFICATION MSG.
	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

	INTER.	DA21.
DA21.:	FLAGAT	NS
	MOVEI	TA,%HL.PR	;'VALUE OF PROTECTION CODE' FLAG
	MOVEM	TA,PNTS
	POPJ	PP,

	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
IFE TOPS20,<
	CAIG	TB,^D17		;17 CHARS OR LESS?
>
IFN TOPS20,<
	CAIG	TB,377		;255 CHARS OR LESS?
>
	JRST	DA24I1		;YES
IFE TOPS20,<
	MOVEI	TB,^D17		;NO, TRUNCATE
>
IFN TOPS20,<
	MOVEI	TB,377		;NO, TRUNCATE
>
	HRRZI	DW,E.238	;& WARN
	PUSHJ	PP,DA24X.
DA24I1:	MOVEM	TB,TBLOCK+2	;SAVE TRUE SIZE
	PUSHJ	PP,DA24S.	;SET PTRS & CTR
IFE TOPS20,<
	SETZM	TBLOCK+1	;CLR NON-STANDARD CHAR FLAG
>
DA24I3:
DA24I4:	ILDB	TE,TB		;GET LITERAL CHAR
IFE TOPS20,<			;ALLOW ALL CHARACTERS IN TOPS-20
	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:	CAIN	TE,"."		;ALLOW "." ALSO
	JRST	DA24I6
	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
IFE TOPS20,<
	SKIPE	TBLOCK+1	;NEED A NON-STD CHAR WARNING?
	PUSHJ	PP,DA24W.	;YES
>
	HRRZ	TA,CURFIL
	MOVE	TB,TBLOCK+2	;GET SIZE OF LITERAL
	DPB	TB,FI.SID##	;SAVE FOR RUN TIME
	SKIPA	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 PROTECTION CODE

	INTER.	DA24C.
DA24C.:	HLRZ	TB,W1		;GET LENGTH OF LITERAL
	ANDI	TB,777
	CAILE	TB,6		;MORE THAN 6 CHARS?
	EWARNJ	E.336		;YES, THAT'S ILLEGAL
	PUSHJ	PP,DA24S.	;SET PTRS & CTR
DA24C1:	SOJL	TD,DA24C2	;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	DA24C1		;DO NEXT CHAR

DA24C2:	HRRZ	TA,CURFIL	;FILTAB ADDR
	HLRZ	TB,CURVAL	;VALTAB REL ADDR
	LDB	TC,FI.PRT##	;SEEN PROTECTION BEFORE?
	JUMPN	TC,JCE16.	;YES, DUPLICATE CLAUSE
	DPB	TB,FI.PRT	;NO, STORE IT
	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,2+4		;ALLOW FOR COUNT AND REMAINDER
	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 14,(TA),13]	;COUNT POINTER
	MOVE	TD,TBLOCK	;SIZE
	DPB	TD,TC
	MOVE	TC,[POINT 7,(TA),13]	;'PUT' POINTER
	POPJ	PP,

;ISSUE A WARNING FOR NON-STD CHAR IN VALUE ITEM

DA24W.:	HRRZI	DW,E.242	;NON-STD CHAR
DA24X.:	LDB	LN,GWLN##	;GET LINE POSITION
	LDB	CP,GWCP##
	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,26		;PUT <null>,1,"0" IN VALTAB
	MOVEM	TB,(TA)
	EWARNJ	E.335		;FATAL ERROR
	INTER.	DA25.
DA25.:	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,

;TEST FOR LEVEL 1 SYNTAX (I.E. SEQ 1, REL 1, IDX 1)

	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)

;SAVE LN & CP SINCE WE DON'T KNOW WHAT CLAUSE WE HAVE JUST YET

	INTER.	DA25R.
DA25R.:	HRLZM	LN,RCLNCP##	;SAVE LN
	HRRM	CP,RCLNCP	; AND CP
	POPJ	PP,		;SO WE CAN FLAG IT RIGHT

;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.
	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
	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:	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:	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.:	SKIPL	REPSEC		;IN REPORT SECTION AND NOT PAGE- OR LINE-CTR?
	JRST	.+4		;NO
	SKIPN	NAMWRD		;YES, DOES ITEM HAVE A NAME?
	JRST	DA27.S		;NO
	SETZM	RPWPFL##	;SET PAGE FOOTING LINE CLAUSE TO ZERO
	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,
	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,D27.E2	;NO
	CAMN	TB,TBLOCK
	JRST	DA27.F		;IT IS A DATA RECORD
	PUSHJ	PP,FNDBRO##	;FIND BROTHER LINK
	  JRST	D27.E2		;NONE
	JRST	DA27.A

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,<
	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
	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		;[175] NO FILE NAME FOR THIS RECORD
	JRST	FATALW		;[175] FATAL ERROR AND FFATAL SW ON

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,(<SIXBIT '01'>)	;FAKE AN 01 LEVEL.
	MOVEM	TA,NAMWRD##
	HRLZI	TA,(<ASCII "01">)
	MOVEM	TA,LITVAL
	JRST	DA28.F		;GO PRETEND IT'S AN 01.

DA28.5:	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)
	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
	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)
	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.:	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:	SETZM	LASCOL		;[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
	PUSHJ	PP,DA29.D	;CHECK TO SEE WHAT LEVEL WE ARE AT
	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.
	PUSH	PP,TA
	PUSHJ	PP,DA29.D	;CHECK TO SEE WHAT LEVEL WE ARE AT
	POP	PP,TA
	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.
	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
	DMOVE	LN,WORDLN##	;SET UP LN & 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.

; DA29.D IS USED TO TEST THE LEVEL OF THE HEIRARCHY FOR A DATA ENTRY
; IF THE DATA ITEM IS DEFINED IN THE REPORT SECTION, THAN A MAXIMUM OF
; THREE HEIRARCHICAL LEVELS ARE PERMITTED.
DA29.D:	SKIPN	REPSEC		;IN REPORT SECTION ?
	POPJ	PP,		;NO
	HLRZ	TB,CURDAT	;GET CURRENT DATAB ENTRY
	MOVEI	TD,RW.MX	;MAX NUMBER OF LEVELS IN REPORT SECTION
DA29.1:	PUSHJ	PP,FNDPOP	;GET FATHER
	POPJ	PP,		;NO FATHER, EXIT
	CAIG	TB,1		;POINTING TO DATAB DUMMY ENTRY ?
	POPJ	PP,		;YES, EXIT
	SOJG	TD,DA29.1	;JUMP IF NOT PAST MAX LEVEL
	EWARNJ	E.779		;GENERATE ERROR AND EXIT
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:	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,<
	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
	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,<CD.DAT>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
	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
	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.:	SKIPE	REPSEC		;NOT NEEDED IN REPORT SECTION
	JRST	DA7.
IFN MCS,<
	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
	MOVEI	TD,%CL.AN
	DPB	TD,DA.CLA##	;CLASS
	MOVEI	TD,%US.D7
	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
	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,

;SIGN CLAUSE

	INTER. DA32.C
DA32.C:	SKIPN 	TA,CURDAT
	POPJ	PP,
	LDB	TB,DA.USG##	;SIGN ONLY APPLIES TO DISPLAY MODE
	CAILE	TB,%US.DS
	EWARNJ	E.554		;NO, GIVE ERROR
	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
DA32.T:	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,<
	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

;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
	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.

;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 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 MCS
IFE 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.
	HRRZM	TB,	TBLOCK+1	;[1424] SAVE LINK
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.
	CAIG	TB,%US.DS		;[1424] IF IT'S A DISPLAY MODE,
	POPJ	PP,			;[1424] EXIT
	LDB	TB,DA.DFS		;[1424] IF DATA ITEM IS NOT
	JUMPE	TB,CPOPJ		;[1424]  IN FILE SECTION, EXIT
	HRRZ	TB,TBLOCK+1		;[1424] GET LAST LINK IN TB FOR FNDFIL
	PUSHJ	PP,FNDFIL##		;[1424] FIND THE FILE TABLE
	  POPJ	PP,			;[1424] NO FILTAB LINK
	LDB	TC,FI.ERM		;[1424] GET FILE'S MODE
	CAIE	TC,%RM.7B		;[1424] IS IT ASCII?
	POPJ	PP,			;[1424] NO, EXIT
	HRRZI	DW,E.661		;[1424] GIVE ERROR
	HRRZ	TA,CURDAT		;[1424]  AT DATA FIELD DECLARATION
	LDB	LN,DA.LN		;[1424]
	LDB	CP,DA.CP		;[1424]
	PJRST	FATAL##			;[1424] 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	SETUSN

	INTER.	DA41.
DA41.:	HRRZI	TC,%US.C1	;USAGE 'COMP-1'
SETUSN:	FLAGAT	NS
SETUSC:	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)
	SKIPN	FLGSW		;DO WE NEED THE FIPS FLAGGER?
	JRST	PUTLNK##
	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
	LDB	TC,GWVAL	;SIZE
	HRLM	TC,TBLOCK+13	;SAVE NO. OF CHARACTERS
	ADDI	TC,4		;TAKE CARE OF REMAINDER
	IDIVI	TC,5
	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,GWLN		;[674] GET LINE OF BAD VALUE
	LDB	CP,GWCP		;[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,

	INTER.	DA47.S
DA47.S:	FLAGAT	8
				;COPY CODE AT DA47.A AS IF A 1 WORD LITERAL
	SETOM	FLG88		;SET 88 LEVEL LITERAL FLAG
	HRRZ	TA,W1		;GET TABLE LINK
	PUSHJ	PP,LNKSET	;GET ADDRESS
	LDB	TB,MN.SYC##	;SYMBOLIC CHARACTER?
	SKIPN	TB		;YES
	EWARNJ	E.809		;NO, WARN USER
DA47.T:	LDB	TC,MN.SCV##	;GET SYMBOLIC CHARACTER
	ROT	TC,-7		;LEFT JUSTIFY IT
	LDB	TB,MN.ESC##	;GET EBCDIC FLAG
	SKIPE	TB
	ROT	TC,-2		;IF EBCDIC MOVE 9 BITS
	HRR	TC,TB		;SAVE FLAG ALSO
	PUSH	PP,TC		;SAVE SYMBOLIC CHAR WHILE WE CAN GET TO IT
	MOVE	TA,[CD.LIT,,SZ.LIT+1]
	PUSHJ	PP,GETENT	;2 WORD LITERAL
	HLR	W1,TA
	MOVEM	TA,CURLIT
	MOVEI	TC,1
	DPB	TC,LI.NCH	;1 CHAR LITERAL
	DPB	TC,LI.ALL	;SET "ALL" BIT ON
	POP	PP,TB		;RECOVER CHAR PLUS EBCDIC FLAG
	TRZE	TB,-1		;IS IT EBCDIC?
	DPB	TC,LI.EBC##	;YES
	HLLZM	TB,1(TA)	;STORE SYMBOLIC CHAR IN LITERAL
	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,
	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.3		;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
;	<return here>
;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.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

;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.

	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:	SKIPE	REPSEC			;[315] IF IN REPORT SECTION,
	PUSHJ	PP,	RPWITC		;[315]  CHECK ITEM LEVEL PARMS.

	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 THERE IS A VALUE 
					; CLAUSE AT THIS LEVEL AND IF
					; THERE IS, CHECK IT OUT.
;CHECK FOR DEFAULTING OF SIGN CLAUSE.
;NOTE, THIS CANNOT BE DONE CORRECTLY SINCE WE HAVE NO BITS FOR [TRAILING] ONLY

	LDB	TC,DA.SCF##	;IF THERE A SEPARATE SIGN?
	JUMPN	TC,D54.NI	;YES, CONTINUE
	LDB	TB,DA.CLA##	;GET CLASS
	LDB	TC,DA.USG##	;AND USAGE
	CAIN	TB,%CL.NU	;MUST BE NUMERIC
	CAILE	TC,%US.DS	;AND DISPLAY
	JRST	D54.NF		;NO
	LDB	TB,DA.EDT	;EDITED?
	JUMPN	TB,D54.NF	;YES, GIVE UP
	LDB	TB,DA.LVL##	;GET LEVEL
	SOJLE	TB,D54.NF	;GIVE UP IF AT TOP LEVEL
D54.NE:	PUSHJ	PP,NXTTRY	;GET FATHER OF CURRENT DATAB
	  JRST	D54.NF		;DONE
	LDB	TB,[POINT 3,TBLOCK,20]	; GET TABLE CODE
	JUMPE	TB,D54.NF	;IF FATHER IN FILTAB, DONE
	HLRZ	TE,TA
	TRZ	TE,100000	;SHUT OFF DATAB TABLE CODE
	CAIG	TE,1		;POINTING TO DUMMY DATAB ENTRY ?
	 JRST	D54.NF		; YES, DONE
	LDB	TB,DA.SCF	;SIGN BITS SPECIFIED?
	JUMPE	TB,D54.NE	;NOT YET
	HRRZ	TA,CURDAT	;YES, PUT BACK ORIGINAL
	DPB	TB,DA.SCF	;COPY BITS
	LSH	TB,1		;ISOLATE DA.SSC
	JUMPE	TB,D54.NF	;JUMP IF NOT SEPARATE CHAR
	PUSHJ	PP,DA32.T	;YES, INCREMENT SIZE BY 1
D54.NF:	HRRZ	TA,CURDAT
	LDB	TB,DA.USG	;RESTORE CURRENT USAGE
;ALLOCATE STORAGE FOR AN ELEMENTARY ITEM.

D54.NI:	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.

;Check redefinition now, before sync-ing the 01 otherwise we
; can't give a warning if redefinition is more bytes, but same
; number of words. This could lead to peculiar results.

D54.TV:	PUSHJ	PP,	D54.VH		;Check for redefines clause

;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.

	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.
	POPJ	PP,			;DONE

;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,	CPOPJ		; DONE
	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.

;GET THE SIZE OF THE RECORD IN WORDS
;KEEP TRACK OF THE LARGEST SO THAT IF 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.
	POPJ	PP,			;DONE
;CHECK REDEFINITIONS FOR SIZE.

D54.VH:	LDB	TC,	DA.RDF##	;IF THIS ISN'T A REDEFINITION,
	JUMPE	TC,	D54.VI		; SAVE SIZE IN CASE IT GETS REDEFINED

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:	LDB	TC,	DA.LVL		;GET THE LEVEL NBR
	MOVE	TB,	RDFDAT##(TC)	;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,<
	SKIPN	COMSEC		;IS THIS IN THE COMMUNICATIONS SECTION?
	 JRST	D54VL0		;NO, GIVE USUAL ERROR MESSAGE
	LDB	TC,DA.LVL	;IS THIS A LEVEL 01? (IMPLICIT REDEFINITION).
	CAIE	TC,LVL.01
	 JRST	D54VL0		;NO, A REAL ERROR.
				;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	D54VL3		;SKIP OTHER ERROR.

;HERE TO GIVE USUAL REDEFINITION SIZE ERROR MESSAGE
D54VL0:
>

;IF ANSI-8x ITS OK TO BE LESS ALSO, BUT NOT GREATER
	SKIPGE	AS7482		;WANT STRICT -74?
	JRST	D54VL2		;YES, GIVE ERROR MESSAGE
;IF ANSI-8x ITS AN ERROR TO BE BIGGER
	HRRZ	TC,EAS1PC	;CURRENT ENDING LOCATION.
	CAILE	TC,(TB)		;IF THE CURRENT ENDING LOCATION IS GREATER THAN
	JRST	D54VL2		; THE OLD ENDING LOCATION, ITS AN ERROR.
	CAIE	TC,(TB)		;IF THE CURRENT ENDING LOCATION
	JRST	D54VL1		; IS LESS THAN THE OLD ONE, ALL IS WELL.
	CAME	TB,EAS1PC	;IF WE USED MORE BITS IN THE 
	JRST	D54VL2		; LAST WORD IN THE OLD EAS1PC, ITS ALSO AN ERROR.
D54VL1:	SKIPN	FLGSW		;WANT FLAGGER?
	JRST	D54VL3		;NO
	LDB	LN,DA.LN	;SET UP LN
	LDB	CP,DA.CP	;	   & CP
	MOVEI	TA,%LV.8	;THIS LEVEL
	PUSHJ	PP,FLG.ES	;SEE IF WE WANT IT
	HRRZ	TA,CURDAT	;RESTORE TA
	JRST	D54VL3		;AND SKIP ERROR MESSAGE

D54VL2:	PUSHJ	PP,	D54E.W		;GO COMPLAIN.
D54VL3:	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.

D54.VI:	SKIPN	TE,EAS1PC		;
	SKIPN	LNKSEC			;IN LINKAGE SECTION?
	CAIA				; NO
	MOVE	TE,LNK1PC		; YES, USE SAVED VALUE INSTEAD
	LDB	TC,	DA.LVL		;GET THE CURRENT LEVEL NUMBER
	MOVEM	TE,	RDFDAT(TC)	;SAVE OFF BY LVL NBR FOR REDEFINES
	POPJ	PP,			; TESTS, IF ANY
;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.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,<
	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,D54J.Y		; AND IS NOT EDITED, ALL IS WELL.
					; OTHERWISE, IT IS AN ERROR.
D54E.Q:	HRRZI	DW,	E.241		;CLASS OF ITEM CONFLICTS WITH
	PJRST		D54E.J		; LITERAL IN VALUE CLAUSE.

;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.
D54J.Y:	SKIPL	AS7482##		;IF COBOL-74
	CAIE	TD,%CL.NU		;OR NOT NUMERIC
	POPJ	PP,			;WE'RE DONE
	HRRZ	TA,CURLIT		;OTHERWISE
	LDB	TE,LI.ALL		;CHECK FOR "ALL"
	HRRZ	TA,CURDAT		;FIRST RESTORE CURRENT ITEM
	JUMPE	TE,CPOPJ		;NO, OK
	MOVEI	DW,E.826		;CANNOT HAVE "ALL" WITH NUMERIC ITEM
	JRST	D54E.J
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,4]	;FLOATING POINT NUMBER HEADER
	PUSHJ	PP,PUT2W2	;OUTPUT THE COMMON PART
	MOVE	CH,VALUE2+1
	PUSHJ	PP,PUTAS1
	MOVE	CH,VALUE2+2
	JRST	PUTAS1

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.
	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.
	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.
	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

;	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.
	INTER.	DA55.
DA55.:	PUSHJ	PP,DA47.A	;[674]
DA55.A:	SKIPN	TA,CURDAT
	JRST	DA55.X
	LDB	TB,DA.VAL
	JUMPN	TB,JCE16.
	HLRZ	TB,CURLIT
	DPB	TB,DA.VAL
	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.	DA55.Y
DA55.Y:	SKIPN	REPSEC		;DOING A REPORT ITEM ?
	POPJ	PP,		;NO
	HRRZ	TA,CURRPW	;GET RPWTAB PTR
	LDB	TB,RW.COL	;SEE IF COLUMN NUMBER SPECIFIED
	JUMPN	TB,CPOPJ	;YES, EXIT
	LDB	TA,RW.DAT	;GET DATAB PNTR
	JUMPE	TA,CPOPJ	; SHOULD NOT HAPPEN, BUT EXIT IF IT DOES
	PUSHJ	PP,LNKSET	;GET REAL ADDRESS
	LDB	TB,DA.VAL
	JUMPE	TB,CPOPJ	;IF NO VALUE CLAUSE SPECIFIED EXIT
	EWARNJ	E.750		; ELSE, WARN USER

	INTER.	DA55.S
DA55.S:	FLAGAT	8
				;COPY CODE AT DA47.A AS IF A 1 WORD LITERAL
	SETZM	FLG88		;CLEAR 88 LEVEL LITERAL FLAG
	HRRZ	TA,W1		;GET TABLE LINK
	PUSHJ	PP,LNKSET	;GET ADDRESS
	LDB	TB,MN.SYC##	;SYMBOLIC CHARACTER?
	SKIPN	TB		;YES
	EWARNJ	E.809		;NO, WARN USER
	PUSHJ	PP,DA47.T	;STORE SYMBOLIC CHAR
	JRST	DA55.A

	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
	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]
	JRST	FLG.ES
;PUT DATA-NAME QUALIFIER IN NEXT WORD OF HLDTAB

	INTER.	DA60.
DA60.:	PUSHJ	PP,DA60S.	;SAVE NAMTAB ADDR
	MOVE	TA,CURHLD	;GET # OF QUALIFIERS BEFORE THIS
	LDB	TB,HL.QAL
	AOJ	TB,		;INCREMENT COUNT
	DPB	TB,HL.QAL	;& PUT BACK
	ROT	TB,-1		;DIV BY 2
	HLRZ	TC,CURNAM	;GET NAMTAB LINK
	JUMPL	TB,DA60.A	;IF BIT0 ON, USE ODD HALF-WORD
	ADDI	TA,1(TB)	;PTR TO EVEN HALF-WORD
	HRRM	TC,(TA)		;STORE IN EVEN HALF
	POPJ	PP,

DA60.A:	PUSH	PP,CURHLD	;SAVE PTR TO HLDTAB ENTRY
	MOVE	TA,[XWD CD.HLD,1]	;GET ONE MORE WORD FOR THE ENTRY
	PUSHJ	PP,GETENT
	HLRZ	TC,CURNAM	;GET NAMTAB LINK
	HRLZM	TC,(TA)		;STORE NAMTAB LINK IN ODD HALF
	POP	PP,CURHLD	;RESTORE HLDTAB PTR
	POPJ	PP,

;STORE NAMTAB RELATIVE ADDRESS FOR NEW NAME

DA60S.:	TLNN	W1,GWNOT	;NAME IN NAMTAB?
	JRST	DA60SA		;YES
	PUSHJ	PP,BLDNAM	;NO, BUILD NAMTAB ENTRY
	MOVEM	TA,CURNAM	;SAVE ADDR
	HLRZS	TA		;LINK TO RIGHT HALF
	DPB	TA,[POINT 15,W2,15]	;& TO W2 IN CASE ANYBODY WANTS IT
	POPJ	PP,

DA60SA:	LDB	TA,[POINT 15,W2,15]	;GET NAMTAB REL ADDR
	HRLZM	TA,CURNAM	;& SAVE
	POPJ	PP,

	INTER.	DA61.
DA61.:	FLAGAT	NS
	MOVEI	TA,%HL.VP	;'VALUE OF PROJECT-PROGRAMMER' FLAG
	MOVEM	TA,PNTS
	POPJ	PP,
;BUILD REPORT TABLE ENTRY & LINK FILE TO REPORT

	INTER.	DA62A.
DA62A.:	FLAGAT	RP
	SKIPN	TA,CURFIL	;POINT TO CURRENT FILE
	POPJ	PP,
	LDB	TB,FI.DRL	;HAVE WE ALREADY SEEN A DATA RECORD CLAUSE?
	JUMPE	TB,CPOPJ	;NO
	EWARNJ	E.749		;YES, WARN USER

	INTER.	DA62.
DA62.:	PUSHJ	PP,DA62S.
	HLRZ	TB,CURFIL	;STORE FILTAB LINK IN RPWTAB
	DPB	TB,RW.FIL##
	HRRZ	TA,CURFIL	;GET FILTAB PTR
	HLRZ	TB,CURRPW	;STORE RPWTAB LINK IN FILTAB
	DPB	TB,FI.RPG##
	SETO	TB,		;FORCE ASCII MODE FOR FILE
	DPB	TB,FI.ADV##	;BY SETTING WRITE-ADVANCING FLAG
	POPJ	PP,

DA62S.:	PUSHJ	PP,BLDNAM	;PUT USERN. IN NAMTAB
	HLRZ	TB,TA		;SAVE NAMTAB LINK
	DPB	TB,[POINT 15,W2,15]
	MOVE	TA,[XWD CD.RPW,SZ.RPD]	;GET AN RPWTAB ENTRY
	PUSHJ	PP,GETENT
	MOVEM	TA,CURRPW	;SAVE RPWTAB PTR
	LDB	TB,[POINT 20,W2,35]	;STORE LINE POSITION IN RPWTAB
	DPB	TB,RW.LNC##
	LDB	TB,[POINT 15,W2,15]	;GET BACK NAMTAB LINK
	DPB	TB,RW.NAM##	;STORE NAMTAB LINK IN RPWTAB
	ADD	TB,NAMLOC##	;MAKE ABS. NAMTAB PTR
	HLRM	TA,(TB)		;STORE RPWTAB LINK IN NAMTAB
	HLRZ	TB,CURRPW	;GET LINK TO CURRENT RPWTAB ENTRY
	SKIPN	TC,LASTRD	;GET LINK TO PREVIOUS RD
	JRST	DA62SX		;NO PREVIOUS
	HRRZ	TA,RPWLOC	;MAKE ABS. PTR TO PREV. ENTRY
	ADDI	TA,(TC)
	DPB	TB,RW.BRO##	;LINK OLD ENTRY TO NEW
DA62SX:	MOVEM	TB,LASTRD	;REMEMBER CURR. ENTRY FOR NEXT TIME
	MOVE	TA,CURRPW	;RESTORE PTR TO CURRENT
	POPJ	PP,

	INTER.	DA62XE
DA62XE:	MOVEI	DW,E.359	; [335] ILLEGAL REPORT NAME
DA62XF:	SETOM	RPWERR		; [335] SET REPORT GENERATOR FATAL FLAG
	JRST	FATALW		; [335] FATAL ERROR

;INIT REPORT SECTION

	INTER.	DA63.
DA63.:	SETZM	LNKSEC		;CLR LINKAGE SECTION FLAG
	SKIPL	TA,PCHOLD	;RESET EAS1PC TO PREVIOUS
	MOVEM	TA,EAS1PC	;  IF CHANGED BY LINKAGE SECTION
	SETOM	PCHOLD
	SKIPN	FILSEC		;FILE SECTION SEEN?
	JRST	DA63E.		;NO
	SWOFF	FFILSC		;CLR FILE SECTION FLAG
	SETOM	REPSEC##	;SET REPORT SECTION FLAG
	SETZM	RPWRDL		;CLR RD RPWTAB LINK STORAGE
	POPJ	PP,

DA63E.:	HRRZI	NODE,DD204E##	;NEXT SYNTAX NODE IS DD204E
	HRRZM	NODE,(NODPTR)	;TO SKIP TO NEXT SECTION
	EWARNJ	E.339		;FILE SECTION NOT SEEN MSG
;INIT RD

	INTER.	DA64.
DA64.:	SETZM	RPTCID##	; [415] CLEAR CONTROL ID LEVEL
	LDB	TB,[POINT 15,W2,15]	;GET BACK NAMTAB LINK
	ADD	TB,NAMLOC	;MAKE ABS NAMTAB PTR
	HRRZ	TA,(TB)		;GET RPWTAB LINK TO RD ENTRY
	HRLI	TA,(TA)		;IN BOTH HALVES
	TRZE	TA,700000	;TABLE CODE = RPWTAB?
	EWARNJ	E.359		;?REPORT-NAME EXPECTED
	MOVE	TB,RPWLOC##	;MAKE FULL RPWTAB PTR
	ADDI	TA,(TB)
	MOVEM	TA,CURRPW	;SAVE PTR TO CURRENT RPWTAB ENTRY
	TLO	W2,GWDEF	;PUT DEFINING REF. IN CREF TABLE
	PUSHJ	PP,PUTCRF
	MOVE	TA,CURRPW	;RESTORE PTR TO NEW ENTRY
	HLRZM	TA,RPWRDL	;& SAVE LINK FOR GROUP ITEMS
	LDB	TB,[POINT 20,W2,35]	;STORE LINE POSITION IN RPWTAB
	DPB	TB,RW.LNC##
	SETO	TB,
	DPB	TB,RW.DEF##	;SET REPORT HAS AN RD CLAUSE
	MOVSI	TB,[SIXBIT /PAGE:COUNTER/]
	PUSHJ	PP,DA64S.	;MAKE PAGE-COUNTER ENTRY IN DATAB
	DPB	TB,RW.PC##	;PUT DATAB LINK IN RPWTAB
	HRRZ	TA,CURDAT	;DEFAULT PAGE-CTR SIZE IS 10
	HRRZI	TB,^D10
	DPB	TB,DA.EXS
	DPB	TB,DA.INS
	MOVSI	TB,[SIXBIT /LINE:COUNTER/]
	PUSHJ	PP,DA64S.	;MAKE LINE-COUNTER ENTRY IN DATAB
	DPB	TB,RW.LC##	;PUT DATAB LINK IN RPWTAB
	HRRZ	TA,CURDAT	;GET DATAB PTR
	HRRZI	TB,2		;LINE-COUNTER IS SIZE 2
	DPB	TB,DA.EXS
	DPB	TB,DA.INS
	MOVE	TA,[CD.LIT,,SZ.LIT+1]	;PUT A -1 IN LITAB
	PUSHJ	PP,GETENT
	MOVEM	TA,CURLIT
	MOVE	TB,[2,,1]	;SET UP SIZE OF CODE WORD
	MOVEM	TB,(TA)
	DPB	TB,LI.NLT##	;MAKE NUMERIC
	MOVSI	TB,(ASCII /-1/)	;"-1" TO 2ND WORD OF ENTRY
	MOVEM	TB,1(TA)
	HLRZ	TB,CURLIT	;PUT LITAB LINK IN DATAB ENTRY
	HRRZ	TA,CURDAT
	DPB	TB,DA.VAL	;AS A VALUE OF -1 TO MEAN NO INITIATE YET
	HRRZ	TA,CURRPW	;GET ADDRESS OF CURRENT RD ENTRY
	LDB	TA,RW.FIL	;GET FILTAB LINK
	ADD	TA,FILLOC	;MAKE REAL ADDRESS
	SETOM	TB
	LDB	TC,FI.ONE##
	SKIPE	TC		;ONE RD ENTRY SEEN YET ?
	DPB	TB,FI.MRE##	;YES, SET FLAG THAT AT MORE THAN ONE RD
				; PROCESSED FOR THIS FILE
	DPB	TB,FI.ONE	;SIGNAL THAT FIRST RD SEEN
	JRST	DA8.		;ALLOCATE LINE-COUNTER
;MAKE PAGE/LINE-COUNTER ENTRY IN DATAB

DA64S.:	HRRI	TB,NAMWRD
	BLT	TB,NAMWRD+1	;PUT 'XXXX-COUNTER' IN NAME STORE
	SETZM	NAMWRD+2	;CLR REST OF NAMWRD
	MOVE	TA,[NAMWRD+2,,NAMWRD+3]
	BLT	TA,NAMWRD+5
	PUSHJ	PP,DA8.		;ALLOCATE PREVIOUS ITEM
	HRRZI	TB,LVL.01	;MAKE COUNTER AN 01 LEVEL ITEM
	MOVEM	TB,(SAVPTR)
	PUSHJ	PP,DA26N.
	HRRZS	REPSEC		;PRETEND ITS AN ORDINARY W-S ITEM
	PUSHJ	PP,DA27.	;CREATE DATAB ENTRY
	SETOM	REPSEC		;RESET REPORT SECTION FLAG
	HRRZ	TA,CURDAT	;PTR TO COUNTER DATAB ENTRY
	HRRZI	TB,%CL.NU	;SET NUMERIC CLASS IN DATAB
	DPB	TB,DA.CLA
	HRRZI	TB,%US.1C	;& 1-WORD COMP USAGE
	DPB	TB,DA.USG
	SETO	TB,
	DPB	TB,DA.PIC	;& PIC SEEN BIT
	DPB	TB,DA.SGN	;& SIGNED BIT
	DPB	TB,DA.FAL	;& FATHER BIT
	DPB	TB,DA.LPC##	;THIS IS A LINE- OR PAGE-COUNTER
	HRRZ	TB,RPWRDL	;RD ENTRY IS THE FATHER LINK
	DPB	TB,DA.POP
	PUSHJ	PP,GETRDL	;GET RPWTAB PTR
	HLRZ	TB,CURDAT	;PUT PAGE/LINE-CTR DATAB LINK IN RPWTAB ENTRY
	POPJ	PP,

;GET RPWRDL & CONVERT IT TO AN ABSOLUTE PTR

GETRDL:	HRRZ	TA,RPWLOC	;TABLE BASE
	ADD	TA,RPWRDL	;PLUS RELATIVE ADDR
	POPJ	PP,

;SET UP REPORT NAME FOR RD, WHERE REPORT NAME NOT
;SPECIFIED IN A REPORT CLAUSE OF THE FILE SECTION

	INTER.	DA64E.
DA64E.:	PUSHJ	PP,DA62S.	; [335] SET UP REPORT TABLE
	SKPNAM			; [335] GO ON

	INTER.	DA64XE
DA64XE:	MOVEI	DW,E.342	; [335] ?NOT NAMED IN FILE SECTION.
	JRST	DA62XF		; [335] SET REPORT WRITER FATAL FLAG
;GET PAGE LIMIT

	INTER.	DA66.
DA66.:	PUSHJ	PP,DA11.	;GET THE INTEGER
	PUSHJ	PP,GETRDL	;GET RPWTAB PTR
	LDB	TC,RW.PAG	;PAGE LIMIT CLAUSE SEEN ALREADY?
	JUMPN	TC,JCE16.	;YES, DUPLICATE CLAUSE
	MOVE	TC,(SAVPTR)	;GET VALUE OF PAGE LIMIT
	JUMPLE	TC,DA66E	;MUST BE .GT. 0
	CAILE	TC,777		;MUST BE .LT. 512
DA66E:	EWARNJ	E.344		;?PAGE-LIMIT MUST BE LESS THAN 512
	DPB	TC,RW.PAG	;STORE PAGE LIMIT
	MOVEI	TD,2		;MAKE LINE-CTR SIZE AGREE WITH PG-LIM
	CAIL	TC,^D100
	MOVEI	TD,3
	CAIGE	TC,^D10
	MOVEI	TD,1
	LDB	TC,RW.LC
	HRRZI	TA,(TC)
	PUSH	PP,TD
	PUSHJ	PP,LNKSET
	POP	PP,TD
	DPB	TD,DA.EXS
	DPB	TD,DA.INS
	POPJ	PP,
;GET PAGE HEADING LINE NUMBER

	INTER.	DA67.
DA67.:	MOVE	TB,RW.PHL##	;PTR TO HEADING-LINE FIELD IN RPWTAB ENTRY
DA67X.:	MOVEM	TB,PNTS		;SAVE FIELD PTR
	PUSHJ	PP,DA11.	;GET VALUE OF INTEGER
	MOVE	TC,(SAVPTR)
	PUSHJ	PP,GETRDL	;GET RPWTAB PTR
	LDB	TB,RW.PAG	;GET PAGE LIMIT
	CAIGE	TB,(TC)		;INDICATED LINE .LE. PAGE LIMIT?
	EWARNJ	E.343		;NO
	DPB	TC,PNTS		;YES, STORE NUMBER IN INDICATED FIELD
	POPJ	PP,

;GET FIRST DETAIL LINE NUMBER

	INTER.	DA68.
DA68.:	MOVE	TB,RW.FDE##	;PTR TO FIRST DETAIL FIELD IN RPWTAB ENTRY
	JRST	DA67X.

;GET LAST DETAIL LINE NUMBER

	INTER.	DA69.
DA69.:	MOVE	TB,RW.LDE	;PTR TO LAST DETAIL FEILD
	JRST	DA67X.

;GET PAGE FOOTING LINE NUMBER

	INTER.	DA70.
DA70.:	MOVE	TB,RW.CFL##	;PTR TO FOOTING-LINE FIELD IN RPWTAB
	JRST	DA67X.
;CONTROL 'FINAL'

	INTER.	DA71.
DA71.:	MOVE	TA,[CD.RCO,,SZ.RCO]	;CREATE AN  RCOTAB ENTRY
	PUSHJ	PP,GETENT
	MOVEM	TA,CURRCO##	;SAVE RCOTAB PTR
	HLRZ	TC,TA		;PUT LINK TO CONTROL ENTRY INTO RD ENTRY
	PUSHJ	PP,GETRDL	;GET RPWTAB PTR
	LDB	TB,RW.CID	;IS THIS THE FIRST CONTROL?
	JUMPE	TB,DA71.C	;YES
	EWARNW	E.346		; [315] NO, FINAL MUST BE FIRST
	HLRZS	TC,
	DPB	TC,RW.FCI##
	MOVE	TA,TC
	ADD	TA,RCOLOC##
	DPB	TB,RC.BR1
	MOVE	TA,TB
	MOVE	TB,TC
	DPB	TB,RW.BRO##
	POPJ	PP,
DA71.C:	DPB	TC,RW.CID##	;SAVE LINK TO RCOTAB
	DPB	TC,RW.FCI	;SAVE LINK AS FIRST CONTROL IDENTIFIER ALSO
	POPJ	PP,
;CONTROL <DATA-NAME>

	INTER.	DA72.
DA72.:	PUSHJ	PP,DA72N	; [315] READ IDENTIFIER WITH ALL QUALS
	CAIN	TE,<CD.DAT>B20+1	; [423] IF DUMMY BECAUSE BAD QUALIFIERS
	POPJ	PP,		; [423] QUIT NOW TO PREVENT COMPILER CRASH IN D54.NJ
	PUSH	PP,TE		; [315] SAVE DATAB LINK
	MOVEM	TE,SAVDAT##	; [315] SAVE DATAB LINK FOR RWPDAT
	PUSHJ	PP,SAVTHM	; [315]  SAV CURRENT SOURCE INPUT
	PUSHJ	PP,RPWDAT	; [315] GO ENTER A NEW DATA ENTRY INTO DATAB
	PUSHJ	PP,D54.NJ	; [315] PUT NEW ENTRY INTO ASY FIL
	SETOM	REPSEC		; [315] SET US BACK TO REPORT SECTION
	MOVE	TA,[CD.RCO,,SZ.RCO]	;CREATE A NEW RCOTAB ENTRY
	PUSHJ	PP,GETENT
	MOVEM	TA,CURRCO	;SAVE RCOTAB LINK
	POP	PP,TE		;STORE DATAB LINK
	HRLZM	TE,(TA)		;IN CONTROL ENTRY
	HLRZ	TB,TA		;GET CNTRL ENTRY LINK
	HLRZ	TD,CURDAT	; [315]GET PREVIOUS DATAB ADR
	HRRM	TD,(TA)		; [315]  STORE IT
	PUSH	PP,TB
	MOVE	TB,TE		; GET POINTER TO CURRENT DATAB ENTRY
	PUSH	PP,TA
DA72.X:	MOVE	CT,TB		; NO, SAVE LAST DATAB LINK
	PUSHJ	PP,FNDPOP	; GET FATHER
	  JRST	.+3		; NO FATHER, EXIT LOOP
	TRNN	TB,700000	; POINTING AT A DATAB (NOT RPW ENTRY)?
	JRST	DA72.X		; YES, LOOP
	POP	PP,TA
	POP	PP,TB
	DPB	CT,RC.FAL##	; STORE FATHER
	PUSHJ	PP,GETRDL	; [315] GET RD RPWTAB PTR
	PUSHJ	PP,RETHM	; [315]  GET BACK SOURCE INPUT FOR GETITM REGET
	LDB	TC,RW.NCI##	; ADD ONE TO NUMBER OF CONTROL IDENTIFIERS
	AOS	TC
	DPB	TC,RW.NCI
	LDB	TC,RW.CID
	JUMPN	TC,DA72.A	; THIS THE 1ST CONTROL ID?
	DPB	TB,RW.CID	; YES, STORE LINK TO LAST CTRL ID IN RPWTAB
	DPB	TB,RW.FCI	; STORE LINK TO LAST CONTROL IDENTIFIER
	POPJ	PP,

DA72.A:	LDB	TC,RW.FCI
	DPB	TB,RW.FCI
	MOVE	TA,TB
	ADD	TA,RCOLOC
	DPB	TC,RC.BR1##
	MOVE	TA,TC
	ADD	TA,RCOLOC
	DPB	TB,RC.BRO##
; CHECK FOR DUPLICATE ENTRY, IF THERE IS AN EXISTING ENTRY, GENERATE WARNING
	MOVE	TA,TB		; GET ADDRESS OF NEW NODE
	ADD	TA,RCOLOC	; MAKE ABSOLUTE
	LDB	TE,RC.DCI##	; GET DATAB LINK FOR COMPARISON
DA72.B:	LDB	TA,RC.BR1	; GET BROTHER
	JUMPE	TA,CPOPJ	; IF NO MORE BROTHERS, EXIT
	ADD	TA,RCOLOC	; MAKE BROTHER LINK ABSOLUTE
	LDB	TD,RC.DCI	; GET BROTHER'S DATAB LINK
	CAME	TD,TE		; IS BROTHER DATAB LINK THE SAME ?
	JRST	DA72.B		; NO, REPEAT FOR NEXT BROTHER
	EWARNJ	E.772		; YES, GENERATE WARNING AND RETURN

DA72N:	DMOVEM	W1,HLDSRC##	; [315]SAVE CURRENT SOURCE INPUTS
	MOVEM	CT,HLDSRC+2	; [315]
	PJRST	DA96.		; [315]  GO GET ANY QUALIFERS AND RETURN

SAVTHM:	EXCH	W1,HLDSRC	; [315] SAV NEW SOURCE GET BACK ORIGINAL CID
	EXCH	W2,HLDSRC+1	; [315]
	EXCH	CT,HLDSRC+2	; [315]
	MOVE	TE,[NAMWRD,,HLDNAM##]	; [315]  SAVE SOURCE NAME FOR
	BLT	TE,HLDNAM+4	; [315]  LATER GETITM REGET
	POPJ	PP,		; [315] RETURN

RETHM:	DMOVE	W1,HLDSRC	; [315]  RESTORE LAST SOURCE ITEM
	MOVE	CT,HLDSRC+2	; [315]
	MOVE	TE,[HLDNAM,,NAMWRD]	; [315]
	BLT	TE,NAMWRD+4	; [315]  LAST SOURCE ITEM GOTTEN IN DA96.
	MOVEM	CT,ITEMCT##	; [315]
	POPJ	PP,		; [315]  IS RESTORED FOR A GETITM REGET.
; THIS ROUTINE PUTS A RPWITM ENTRY INTO DATAB HAVING PARRAMETERS
; SIMULAR TO THE CURRENT DATAB ITEM WHOSE RELATIVE  ADDRESS IS IN LOCATION SAVDAT

	INTER. RPWDAT
RPWDAT:	MOVE	TA,['RWITM;']	; [315] GET FAKE NAME
	MOVEM	TA,NAMWRD	; [315] STORE IT
	PUSHJ	PP,SIXDIG	; [315] GET NEXT DIGIT (IN SIXBIT)
	MOVEM	TA,NAMWRD+1	; [315] MAKE DATA NAME 'RWITM-NNNNNN'
	SETZM	NAMWRD+2	; [315] CLEAR REST OF NAME
	MOVE	TA,[NAMWRD+2,,NAMWRD+3]	; [315]
	BLT	TA,NAMWRD+5	; [315]
	MOVEI	TB,LVL.01	; [315]  SET LEVEL TO 01
	MOVEM	TB,(SAVPTR)	; [315] 
	PUSHJ	PP,DA26N.	; [315]  SET 01 LEVEL  AND USAGE
	SETZM	REPSEC		; [315] TURN OFF REPORT SECTION MOMENTARILY TO AVOID ANY RPTAB ENTRY
	PUSHJ	PP,DA27.	; [315]  SET UP DATAB ENTRY FOR NEW ENTRY- NEW ITEM ADDRESS RETURN IN CURDAT
	SETZM	CURFIL		; [315]  MAKE SURE NO FILE IS INVOLVED
	HRRZ	TA,SAVDAT	; [315] GET CURRENT DATAB RELATIVE ADDRESS
	PUSHJ	PP,LNKSET	; [315]  GET ITS REAL ADDRESS
	HRRM	TA,SAVDAT	; [315] NOW SAVE THE REAL ADDRESS
	LDB	TB,DA.CLA	; [315]  GET CURRENT CLASS
	LDB	TC,DA.SGN	; [315]  GET CURRENT SIGN
	LDB	TD,DA.BWZ	; [315] GET CURRENT BLANK WHEN ZERO
	LDB	TE,DA.EDT	; [315] GET CURRENT EDITING PARAMETER
	HRRZ	TA,CURDAT	; [315] GET NEW ITEM ADDRESS
	DPB	TB,DA.CLA	; [315] COPY CLASS
	DPB	TC,DA.SGN	; [315]  COPY SIGN
	DPB	TD,DA.BWZ	; [315]  COPY BLANK WHEN ZERO
	DPB	TE,DA.EDT	; [315]  COPY EDIT
	JUMPE	TE,RPWDT1	; [315] IF NO EDIT GO ON
	MOVE	TA,[CD.DAT,,SZ.DOC+SZ.MSK]	; [603] [315] EDIT- NEED TO
	PUSHJ	PP,GETENT	; [315] INCREASE SIZE OF DATAB TABLE
	HRLZ	TB,SAVDAT	; [315] GET CURRENT ADDRESS
	HRR	TB,CURDAT	; [315] GET NEW ADDRESS
	ADD	TB,[XWD 7,7]	; [315] SET EACH TO 8TH WORD
	HRRZ	TC,CURDAT	; [315] SET UP LAST NEW ADDRESS
	BLT	TB,14(TC)	; [315] COPY 8TH - 13 TH WORD OF CURRENT INTO NEW (I.E) EDIT PARAMS
RPWDT1:	HRRZ	TA,SAVDAT	; [315]  GET CURRENT ITEM
	LDB	TB,DA.JST	; [315]  GET JUSTIFICATION
	LDB	TC,DA.USG	; [315]  GET USAGE
	LDB	TD,DA.DPR	; [315]  GET DECIMAL PLACE
	HRRZ	TA,CURDAT	; [315]  GET NEW ITEM
	DPB	TB,DA.JST	; [315]  COPY JUSTIFIED
	DPB	TC,DA.USG	; [315]  COPY USAGE
	DPB	TD,DA.DPR	; [315]  COPY DECIMAL PLACE
	HRRZ	TA,SAVDAT	; [315] GET CURRENT ADDRESS
	LDB	TB,DA.NDP	; [315]  GET NUMBER OF DECIMAL PLACES
	LDB	TC,DA.INS	; [315]  GET INTERNAL SIZE
	LDB	TD,DA.EXS	; [315]  GET EXTERNAL SIZE
	HRRZ	TA,CURDAT	; [315] GET NEW ITEM
	DPB	TB,DA.NDP	; [315] COPY NUMBER OF DECIMAL PLACES
	DPB	TC,DA.INS	; [315]  COPY INTERNAL SIZE
	DPB	TD,DA.EXS	; [315]  COPY EXTERNAL SIZE
	SETO	TB,		; [315]  TURN ON FOLLOWING 
	DPB	TB,DA.FAK	; [315] ITEM IS FAKE
	DPB	TB,DA.PIC	; [315]  PICTURE IS DESCRIBED HERE
	POPJ	PP,		; [315] RETURN
;CHECK FOR ILLEGAL CLAUSE IN REPORT SECTION

	INTER.	DA73.F
DA73.F:	HRRZ	TA,CURDAT	;POINT TO DATAB
	LDB	TB,DA.LVL	;GET LEVEL NUMBER
	CAIE	TB,LVL.01	;LEVEL 01
	CAIN	TB,LVL.77	;	  AND 77
	FLAGAT	NS		;		 ARE NON-STANDARD
	SKPNAM

	INTER.	DA73.
DA73.:	SKIPN	REPSEC		;IN REPORT SECTION?
	POPJ	PP,		;NO
	EWARNW	E.348		;CLAUSE ILLEGAL IN REPORT SECT.
DA73.X:	HRRZI	NODE,DD115.##	;CONTINUE AT NODE DD115.
	HRRZM	NODE,(NODPTR)
	POPJ	PP,

DA73.L:	HLRZ	TA,CURDAT	;GET CURRENT DATAB ENTRY
	PUSHJ	PP,LNKSET
	LDB	TB,DA.LVL	;GET LEVEL OF CURRENT DATAB ENTRY
	CAIG	TB,1		;01 LEVEL ?
	POPJ	PP,		;YES
DA73L1:	LDB	TB,DA.FAL
	JUMPE	TB,DA73L2	;NOT FATHER LINK
	LDB	TA,DA.POP	;GET DATAB ENTRY FOR FATHER
	PUSHJ	PP,LNKSET
	PUSH	PP,TA
	LDB	TA,DA.RPW	;GET RPWTAB LINK
	ADD	TA,RPWLOC
	LDB	TC,RW.LCD
	SKIPE	TC		;LINE CODE SEEN FOR FATHER ?
	EWARNW	E.773		;YES
	POP	PP,TA
	JUMPE	TC,CPOPJ	;ERROR GENERATED, EXIT
	LDB	TC,DA.LVL	;GET LEVEL NUMBER
	CAILE	TC,1		;FINISHED ?
	JRST	DA73L1		;NO, GO REPEAT TEST
	POPJ	PP,		;FINISHED, EXIT

DA73L2:	LDB	TA,DA.BRO	;GET BROTHER LINK
	SKIPN	TA		;FINISHED ?
	POPJ	PP,		;YES, EXIT
	PUSHJ	PP,LNKSET
	JRST	DA73L1
	
DA73.N:	HLRZ	TB,CURDAT	;GET RELATIVE ADDRESS OF CURRENT DATAB ENTRY
DA73N1:	PUSHJ	PP,FNDPOP	;GET FATHER
	  POPJ	PP,		;NO FATHER, EXIT
	TRNN	TB,700000	;POINTING AT A DATAB (I.E. NOT DUMMY OR RPWTAB ENTRY)
	POPJ	PP,		;NO, EXIT
	PUSH	PP,TB
	MOVE	TA,TB
	PUSHJ	PP,LNKSET	;GET REAL ADDRESS OF FATHER
	LDB	TA,DA.RPW	;GET RPWTAB ENTRY
	ADD	TA,RPWLOC
	SETO	TB,
	DPB	TB,RW.RLS##	;SET LINE SEEN AT LOWER LEVEL FLAG
	POP	PP,TB
	JRST	DA73N1

;CHECK FOR ILLEGAL CLAUSE OUTSIDE REPORT SECTION

	INTER.	DA74.
DA74.:	SKIPE	REPSEC		;IN REPORT SECTION?
	POPJ	PP,		;YES, CLAUSE IS OK
DA74.X:	EWARNW	E.350		;NO, ILLEGAL CLAUSE
	JRST	DA73.X		;GO TO SYNTAX NODE DD144.
;IF REPORT ITEM HAS NO NAME,
;PUT NAME 'RWITM.######' ON REPORT GROUP ITEM

FAKNAM:	HRRZ	TA,CURDAT	;DATAB ADDR
	LDB	TC,DA.NAM	;HAVE A REAL NAME?
	JUMPN	TC,CPOPJ	;YES
	PUSHJ	PP,RPWNAM	;MAKE NAMTAB ENTRY "RWITM.######"
	HLRZS	TA		;LINK DATAB ENTRY TO NAMTAB
	HLL	TA,CURDAT
	PUSHJ	PP,PUTLNK
	HRRZ	TA,CURDAT	;PUT NAMTAB LINK IN DATAB
	HRRZ	TB,NAMADR##
	HRRZ	TC,NAMLOC
	SUBI	TB,(TC)
	DPB	TB,DA.NAM
	LDB	TB,DA.SNL##	;REMOVE ITEM FROM NO-NAME CHAIN
	HRRZM	TB,(TC)
	SETZ	TB,		;CLR SAME NAME LINK
	DPB	15,DA.SNL
	SETO	TB,		;SET FAKE NAME BIT
	DPB	TB,DA.FAK##
	POPJ	PP,

;MAKE A "RWITM.######" ENTRY IN NAMTAB

RPWNAM::MOVE	TA,['RWITM;']	;FIRST WORD OF SIXBIT NAME
	MOVEM	TA,NAMWRD
	PUSHJ	PP,SIXDIG	;SECOND WORD OF NAME
	MOVEM	TA,NAMWRD+1
	SETZM	NAMWRD+2	;CLR REST OF NAMWRD
	MOVE	TA,[NAMWRD+2,,NAMWRD+3]
	BLT	TA,NAMWRD+5
	PUSHJ	PP,TRYNAM
	  PUSHJ	PP,BLDNAM	;PUT NAME IN NAMTAB
	MOVEM	TA,NAMADR	;SAVE NAMTAB PTR
	POPJ	PP,

;GENERATE A 6-DIGIT SIXBIT NUMBER ONE LARGER THAN THE LAST

SIXDIG:	MOVE	TA,SIXHLD##	;GET LAST NUMBER RETURNED
	ADD	TA,[464646464647]
	MOVE	TB,TA
	TDZ	TB,[171717171717]
	MOVE	TC,TB
	LSH	TC,-3
	OR	TB,TC
	SUB	TA,TB
	ADD	TA,[202020202020]
	MOVEM	TA,SIXHLD	;STORE NEW NUMBER
	POPJ	PP,
;REPORT LINE IS NEXT PAGE

	INTER.	DA75.
DA75.:	PUSHJ	PP,DA73.L	;CHECK ALL HIGHER LEVELS FOR LINE CLAUSE
	PUSHJ	PP,DA73.N	;SET FLAGS IN RPWTAB FOR LINE SEEN
	SETOM	RPWPFL		;SET FLAG FIRST LINE CLAUSE NOT RELATIVE
	HRRZ	TA,CURRPW	;PTR TO REPORT GROUP ENTRY
	DMOVEM	LN,RPWLN##	;SAVE LN AND CP FOR POSSIBLE ERROR
	HRRZI	DW,E.771	;GET ERROR MESSAGE
	LDB	TB,RW.TYP	;GET TYPE
	CAIN	TB,%RG.RH	;TYPE RH ?
	SKIPA			;YES
	CAIN	TB,%RG.PH	;TYPE PH ?
	SKIPA			;YES
	CAIN	TB,%RG.PF	;TYPE PF ?
	PUSHJ	PP,WARN		; TYPE WAS RH,PH, OR PF
	MOVEI	TB,%RG.NP	;GET NEXT PAGE CODE
DA75.X:	SETOM	RWLCS.		;NOTE THAT WE HAVE SEEN A LINE CLAUSE.
	HRRZ	TA,CURRPW	;PTR TO REPORT GROUP ENTRY
	LDB	TC,RW.LCD##	;LINE CODE SEEN BEFORE?
	JUMPN	TC,JCE16.	;YES, DUPLICATE CLAUSE
	DPB	TB,RW.LCD	;NO, STORE IT
	POPJ	PP,

;Here to save LN & CP of NEXT when we don't know if PAGE or GROUP follows

	INTER.	DA75A.
DA75A.:	DMOVEM	LN,RPWLN2##	;SAVE LN & CP
	POPJ	PP,

;REPORT LINE IS <INTEGER>

	INTER.	DA76.
DA76.:	PUSHJ	PP,DA73.L	;CHECK ALL HIGHER LEVELS FOR LINE CLAUSE
	PUSHJ	PP,DA73.N	;SET FLAGS IN RPWTAB FOR LINE SEEN
	SETOM	RPWPFL		;SET FLAG FIRST LINE CLAUSE NOT RELATIVE
	PUSHJ	PP,DA11.	;GET THE INTEGER
	MOVE	TC,(SAVPTR)
	JUMPLE	TC,JCE25.	;MUST BE POSITIVE
	HRRZ	TA,CURRPW	;GET RPWTAB PTR
	LDB	TB,RW.LIN##	;LINE # THERE ALREADY?
	JUMPN	TB,JCE16.	;YES, DUP. CLAUSE
	PUSHJ	PP,GETRDL	;MAKE PTR TO RD ENTRY
	LDB	TB,RW.PAG##	; [315] GET PAGE-LIMIT
	HRRZ	TA,CURRPW	; GET BACK REORT ITEM
	JUMPE	TB,.+3		; IF NO PAGE-LIMIT- NO CHECK
	CAILE	TC,(TB)		; LINE MUST BE L.E. TO PAGE-LIMIT
	EWARNJ	E.352		; IT IS NOT
	DPB	TC,RW.LIN	; OKAY STORE LINE NUMBER
	HRRZI	TB,%RG.LN	; GET LINE # CODE
	JRST	DA75.X		; STORE IT AND RETURN

;REPORT LINE IS PLUS <INTEGER>

	INTER.	DA77.
DA77.:	PUSHJ	PP,DA73.L	;CHECK ALL HIGHER LEVELS FOR LINE CLAUSE
	PUSHJ	PP,DA73.N	;SET FLAGS IN RPWTAB FOR LINE SEEN
	DMOVEM	LN,RPWLN	;SAVE LN & CP FOR POSSIBLE ERROR
	HRRZ	TA,CURDAT	;GET CURRENT DATAB ENTRY
DA77.A:	LDB	TB,DA.LVL
	CAIN	TB,1		;01 LEVEL ?
	JRST	DA77.B		;YES
	HLRZ	TB,CURDAT
	PUSHJ	PP,FNDPOP	;GET FATHER
	  JRST	DA77.C		;SHOULD NEVER HAPPEN, ALWAYS SHOULD HAVE FATHER
	CAIGE	TB,1		;POINTING TO DUMMY ENTRY ?
	JRST	DA77.C		;YES, SHOULD NEVER HAPPEN
	MOVE	TA,TB
	PUSHJ	PP,LNKSET
	JRST	DA77.A

DA77.B:	LDB	TA,DA.RPW	;GET RPWTAB LINK
	ADD	TA,RPWLOC	;ADD OFFSET
	LDB	TA,RW.TYP	;GET TYPE
	SKIPN	RPWPFL		;FIRST LINE CLAUSE NOT RELATIVE
	CAIE	TA,%RG.PF	;OR REPORT TYPE NOT PAGE FOOTING
	SKIPA			;YES
	EWARNW	E.781		;FIRST LINE CLAUSE RELATIVE, AND TYPE IS PF
	SETOM	RPWPFL		;SET SO NO MORE ERRORS FOR THIS 01 ENTRY
DA77.C:	PUSHJ	PP,DA11.	;GET THE INTEGER
	MOVE	TC,(SAVPTR)
	JUMPLE	TC,JCE25.	;MUST BE POS.
	HRRZ	TA,CURRPW	;GET RPWTAB PTR
	LDB	TB,RW.LIN	;LINE # GIVEN ALREADY?
	JUMPN	TB,JCE16.	;YES
	DPB	TC,RW.LIN	;NO, STORE IT
	HRRZI	TB,%RG.PI	;PLUS INTEGER CODE
	JRST	DA75.X

;PICTURE SEEN, CHECK IF IN RPW AND LEVEL 01. IF IT IS, THEN ERROR

	INTER.	DA78.
DA78.:	SKIPN	REPSEC		;IN REPORT SECTION ?
	POPJ	PP,		;NO, RETURN
	HRRZ	TA,CURDAT	;GET ENTRIES DATAB LINK
	LDB	TA,DA.LVL	;GET LEVEL NUMBER
	CAIN	TA,1		;01 LEVEL ?
	EWARNW	E.780		;YES, GENERATE ERROR
	POPJ	PP,		;EXIT
;NEXT GROUP IS
	INTER.	DA79.
DA79.:	DMOVEM	LN,RPWLN1##	;SAVE LN & CP OF NEXT GROUP STATEMENT
DA79.C:	HRRZ	TA,CURRPW	;PTR TO CURRENT RPWTAB ENTRY
	LDB	TB,RW.TYP	;GET TYPE
	CAIN	TB,%RG.RF	;REPORT FOOTING ?
	PUSHJ	PP,DA79.B	;YES, GENERATE WARNING
	JRST	DA74.

DA79.A:	HRRZI	DW,E.776
	TRNA
DA79.B:	HRRZI	DW,E.777
	DMOVE	LN,RPWLN1	;RESTORE LN AND CP TO NEXT GROUP STATEMENT
	PJRST	WARN

;Here when we could not decide earlier if we had NEXT PAGE or NEXT GROUP
	INTER.	DA79A.
DA79A.:	DMOVE	TB,RPWLN2	;GET LN & CP OF NEXT
	DMOVEM	TB,RPWLN1	;STORE FOR NEXT GROUP NOW
	JRST	DA79.C		;CONTINUE AS IF CALLED FROM NODE DD257.

;NEXT GROUP IS NEXT PAGE

	INTER.	DA80.
DA80.:	HRRZ	TA,CURRPW	;PTR TO REPORT GROUP ENTRY
	LDB	TC,RW.TYP	;GET TYPE
	CAIN	TC,%RG.PF	;PAGE FOOTING ?
	PUSHJ	PP,DA79.A	;YES, GENERATE WARNING AND CONTINUE
	MOVEI	TB,%RG.NP	;GET NEXT PAGE CODE
DA80.X:	HRRZ	TA,CURRPW	;PTR TO REPORT GROUP ENTRY
	LDB	TC,RW.NLC##	;NEXT GROUP CODE SEEN BEFORE?
	JUMPN	TC,JCE16.	;YES, CLAUSE DUPLICATED
	DPB	TB,RW.NLC	;NO, STORE IT
	POPJ	PP,

;NEXT GROUP IS <INTEGER>

	INTER.	DA81.
DA81.:	PUSHJ	PP,DA11.	;GET THE INTEGER
	MOVE	TC,(SAVPTR)
	JUMPLE	TC,JCE25.	;MUST BE .GT. 0
	HRRZ	TA,CURRPW	;GET RPWTAB PTR
	LDB	TB,RW.NXT##	;NEXT GROUP CLAUSE SEEN ALREADY?
	JUMPN	TB,JCE16.	;YES
	PUSHJ	PP,GETRDL	; [315] GET RD ADDRESS
	LDB	TB,RW.PAG	;INTEGER MUST BE .LE. PAGE LIMIT
	SKIPN	TB		;PAGE LIMIT SEEN ?
	EWARNW	E.782		;NO, GENERATE WARNING
	JUMPE	TB,.+3
	CAILE	TC,(TB)
	EWARNJ	E.352		;TOO BIG
	HRRZ	TA,CURRPW	; [315] GET RPWTAB ADDRESS
	DPB	TC,RW.NXT	;OK, STORE IT
	HRRZI	TB,%RG.LN	;LINE # CODE
	JRST	DA80.X

;NEXT GROUP IS PLUS <INTEGER>

	INTER.	DA82.
DA82.:	PUSHJ	PP,DA11.	;GET THE INTEGER
	MOVE	TC,(SAVPTR)
	JUMPLE	TC,JCE25.	;MUST BE .GT. 0
	HRRZ	TA,CURRPW	;GET RPWTAB PTR
	LDB	TB,RW.NXT	;NEXT GROUP CLAUSE SEEN ALREADY?
	JUMPN	TB,JCE16.	;YES
	DPB	TC,RW.NXT	;STORE INTEGER
	HRRZI	TB,%RG.PI	;GET PLUS INTEGER CODE
	JRST	DA80.X


;SET GROUP INDICATE BIT

	INTER.	DA83.
DA83.:	SKIPN	REPSEC		;IN REPORT SECTION?
	JRST	DA74.X		;NO, SHOULDN'T BE HERE
	HRRZ	TA,CURRPW	;REPORT GROUP RPWTAB PTR
	LDB	TB,RW.TYP	; [315] G.I. LEGAL ONLY FOR
	CAIE	TB,%RG.DE	; [315] TYPE DETAIL
	EWARNJ	E.482		; [315] ILLEGAL
	SETO	TB,		;SET GROUP INDICATE BIT
	DPB	TB,RW.GPI##
	POPJ	PP,
;RESET ON FINAL

	INTER.	DA84.
DA84.:	HRRZ	TA,CURRPW	;GET RPWTAB PTR
	LDB	TB,RW.RSF##	;RESET ON FINAL SEEN BEFORE?
	JUMPN	TB,JCE16.	;YES
	LDB	TB,RW.RSI##	;RESET ON IDENTIFIER SEEN?
	JUMPN	TB,JCE16.	;YES
	LDB	TB,RW.TYP	;MAKE SURE IT'S CF (OR NOT YET SPECIFIED)
	CAIE	TB,0
	CAIN	TB,%RG.CF
	JRST	.+2		;OK
	EWARNJ	E.368		;?RESET ON ITEM OTHER THAN CF
	SETZ	TE,		; [315] MAKE SURE WE HAVE A CONTROL
	PUSHJ	PP,FNDCNT	; [315] FINAL
	  EWARNJ E.481		; [315] NO- ERROR
	HRRZ	TA,CURRPW	; [315] GET BACK PTR TO REPORT ITEM
	SETO	TB,		;NO, SET RESET ON FINAL BIT
	DPB	TB,RW.RSF
	POPJ	PP,

;RESET ON <IDENTIFIER>

	INTER.	DA85.
DA85.:	PUSHJ	PP,DA96.	;READ FULL IDENTIFIER
	HRRZ	TA,CURRPW	;GET RPWTAB PTR
	LDB	TB,RW.RSF	;RESET ON FINAL SEEN BEFORE?
	JUMPN	TB,JCE16.	;YES
	LDB	TB,RW.RSI	;RESET ON IDENTIFIER SEEN?
	JUMPN	TB,JCE16.	;YES
	LDB	TB,RW.TYP	;MAKE SURE IT'S CF (OR NOT YET SPECIFIED)
	JUMPE	TB,DA85.X	;NOT YET SPECIFIED, CK IT AT DA94.
	CAIE	TB,%RG.CF	;CF?
	JRST	JCE368		;?RESET ON ITEM OTHER THAN CF
	PUSHJ	PP,FNDCNT	;LOOK FOR MATCHING CONTROL ENTRY
	  JRST	JCE369		;?NOT A CONTROL
	HRRZ	TC,TB		;[1452][1475]
	HRRZ	TD,RCOLOC	;[1452]
	SUB	TC,TD		;[1452][1475] MAKE ADDRESS OF CONTROL ENTRY RELATIVE
	CAML	TC,THSCTL	;[1452][1475] IS RESET CONTROL HIGHER THAN CURRENT ITEMS CONTROL?
	JRST	JCE370		;NO
DA85.X:	HRRZ	TA,CURRPW	;GET BACK PTR TO CURRENT RPW ITEM
	SETO	TB,		;SET RESET FLAG
	DPB	TB,RW.RSI
	DPB	TE,RW.RES##	;STORE DATAB LINK TO RESET IDENTIFIER
	POPJ	PP,
JCE357:	SETZM	RPTCID		; [415] CLEAR CID LEVEL NUMBER
	HRRZI	DW,E.357
	JRST	FATAL

JCE367:	HRRZI	DW,E.367
	JRST	FATAL

JCE368:	HRRZI	DW,E.368
	JRST	FATAL

JCE369:	HRRZI	DW,E.369
	JRST	FATAL

JCE472:	HRRZI	DW,E.472	; [315]
	JRST	FATAL		; [315]

JCE473:	HRRZI	DW,E.473	; [315]
	JRST	FATAL		; [315]

JCE489:	HRRZI	DW,E.489	;[215]
	JRST	FATAL		;[215]

JCE490:	HRRZI	DW,E.490	;[215]
	JRST	FATAL		;[215]

JCE491:	HRRZI	DW,E.491	;[215]
	JRST	FATAL		;[215]
;LOCATE CONTROL ENTRY FOR DATAB ITEM IN TE
;SKIP RETURNS WITH LINK TO CONTROL ENTRY IN TB IF FOUND

FNDCNT:	HRRZ	TA,CURRPW	;PTR TO CURRENT GROUP ENTRY
	LDB	TB,RW.RDL	;MAKE PTR TO RD ENTRY
	HRRZ	TA,RPWLOC
	ADDI	TA,(TB)
	LDB	TB,RW.CID	;GET LINK TO 1ST CONTROL
FNDCN1:	ADD	TB,RCOLOC
	HRRZS	TB		;CLR LEFT HALF
	HLRZ	TD,(TB)		;GET DATAB LINK FROM CONTROL ENTRY
	CAIN	TD,(TE)		;IS IT THE ONE?
	JRST	CPOPJ1		;YES
	MOVE	TA,TB
	LDB	TB,RC.BRO	;GET BROTHER
	JUMPN	TB,FNDCN1	;GO BACK TO TRY NEXT ONE
	POPJ	PP,		;NO MORE -- TAKE ERROR RETURN


;GET COLUMN NUMBER

	INTER.	DA86.
DA86.:	PUSHJ	PP,DA11.	;GET THE INTEGER
	MOVE	TC,(SAVPTR)
	JUMPLE	TC,JCE25.	;MUST BE POSITIVE
	HRRZ	TA,CURRPW	;GET RPWTAB PTR
	LDB	TB,RW.COL##	;COLUMN # ALREADY GIVEN?
	JUMPN	TB,JCE16.	;YES
	DPB	TC,RW.COL	;YES, STORE IT IN RPWTAB
	SETOM	RWCCS.##	;NOTE THAT WE HAVE SEEN A COLUMN CLAUSE.
	POPJ	PP,
;SET REPORT ITEM TYPE

	INTER.	DA87.
DA87.:	PUSHJ	PP,GETRDL	;[1373] GET RD POINTER
	SETO	TC,		;[1373] INDICATE HAVE SEEN A REPORT
	DPB	TC,RW.RHL##	;[1373]  HEADING
	MOVEI	TC,%RG.RH	;[1373] REPORT HEADING TYPE CODE
DA87.X:	HRRZ	TA,CURRPW	;PTR TO RPWTAB ENTRY
	LDB	TB,RW.TYP##	;TYPE STORED ALREADY?
	JUMPN	TB,JCE16.	;YES
	DPB	TC,RW.TYP	;NO, STORE IT
	MOVEM	TC,LASTYP	;REMEMBER LAST TYPE SEEN
	HRRZI	DW,E.771
	DMOVE	LN,RPWLN	;RESTORE POINTER TO LINE CLAUSE
	CAIE	TC,%RG.RF	;TYPE REPORT FOOTING ?
	JRST	DA87.A		;NO
	LDB	TB,RW.NLC
	SKIPE	TB		;NEXT GROUP STATEMENT SEEN ?
	PUSHJ	PP,DA79.B	;YES, GENERATE WARNING
DA87.A:	LDB	TA,RW.RDL	;GET RPWTAB RD ENTRY
	ADD	TA,RPWLOC	;ADD OFFSET
	LDB	TB,RW.PAG	;GET PAGE CLAUSE
	CAIN	TC,%RG.PH	;TYPE PH ?
	JRST	.+3		;YES, CHECK FOR PAGE CLAUSE PRESENT
	CAIE	TC,%RG.PF	;TYPE PF ?
	JRST	.+3		;NO, DO NOT CHECK FOR PAGE CLAUSE PRESENT
	SKIPN	TB		;ANY PAGE CLAUSE ?
	EWARNW	E.783		;NO, GENERATE WARNING
	HRRZ	TA,CURRPW	;GET CURRENT RPWTAB ENTRY
	LDB	TB,RW.NLC
	CAIN	TC,%RG.RH	;TYPE RH ?
	SKIPA
	CAIN	TC,%RG.PH	;OR PH ?
	SKIPA
	CAIN	TC,%RG.PF	;OR PF ?
	SKIPA			;YES
	POPJ	PP,		;NO, RETURN
	CAIN	TB,%RG.NP	;LINE NEXT PAGE SEEN ?
	PUSHJ	PP,WARN		;YES
	CAIE	TC,%RG.PF	;TYPE PAGE FOOTING
	POPJ	PP,		;NO
	LDB	TB,RW.NLC
	CAIN	TB,%RG.NP	;NEXT GROUP IS NEXT PAGE SEEN ?
	PUSHJ	PP,DA79.A	;YES, GENERATE WARNING
	LDB	TB,RW.LCD
	CAIE	TB,%RG.PI	;LINE STATEMENT A RELATIVE LINE CLAUSE ?
	POPJ	PP,		;NO
	DMOVE	LN,RPWLN	;RESTORE LINE NUMBER OF LINE CLAUSE
	HRRZI	DW,E.781
	PUSHJ	PP,WARN		;GENERATE WARNING
	POPJ	PP,
	INTER.	DA88.
DA88.:	MOVEI	TC,%RG.PH	;PAGE HEADING TYPE
	JRST	DA87.X

	INTER.	DA89.
DA89.:	MOVEI	TC,%RG.CH	;CONTROL HEADING TYPE
	JRST	DA87.X

	INTER.	DA90.
DA90.:	MOVEI	TC,%RG.DE	;DETAIL TYPE
	JRST	DA87.X

	INTER.	DA91.
DA91.:	MOVEI	TC,%RG.CF	;CONTROL FOOTING TYPE
	JRST	DA87.X

	INTER.	DA92.
DA92.:	MOVEI	TC,%RG.PF	;PAGE FOOTING
	JRST	DA87.X

	INTER.	DA93.
DA93.:	MOVEI	TC,%RG.RF	;REPORT FOOTING
	JRST	DA87.X
;CH/CF IDENTIFIER

	INTER.	DA94.
DA94.:	PUSHJ	PP,DA96.	;GET FULL IDENTIFIER
DA94.1:	PUSHJ	PP,FNDCNT	;FIND CORRESPONDING CONTROL ENTRY
	  JRST	JCE357		;?THIS DATA ITEM IS NOT A CONTROL
	MOVEM	TC,RPTCID##	; [415] STORE CURRENT LEVEL OF THE CF
	HRRZ	TC,TB		;[1452][1475]
	HRRZ	TD,RCOLOC	;[1452]
	SUB	TC,TD		;[1452][1475] MAKE ADDRESS OF CONTROL ENTRY RELATIVE
	HRRZM	TC,THSCTL	;[1452][1475]SAVE ADDR OF CORRESP CONTROL ENTRY
	MOVE	TA,CURRPW	;GET BACK PTR TO RPW ITEM ENTRY
	LDB	TC,RW.TYP	;CH OR CF?
	CAIE	TC,%RG.CH
	JRST	DA94.A		;CF
	HLRZ	TC,1(TB)	; [315] IF CH GROUP ALREADY THERE
	JUMPN	TC,JCE472	; [315] THEN THIS IS DUPLICATE CONTROL HEADING FOR THIS ID
	HLLM	TA,1(TB)	;STORE RPWTAB LINK TO CH ITEM
	POPJ	PP,

DA94.A:	HRRZ	TC,1(TB)	; [315] IF CF GROUP ALREADY THERE
	JUMPN	TC,JCE473	; [315] THEN THIS IS DUPLICATE CONTROL FOOTING FOR THIS ID
	HLRM	TA,1(TB)	;STORE RPWTAB LINK TO CF
	LDB	TC,RW.RST##	;[651] GET RW.RSF+RW.RSI
	JUMPE	TC,CPOPJ	;NO RESET FLAGS
	MOVEM	TE,(SAVPTR)	;SAVE LINK TO CURRENT ITEMS CONTROL
	LDB	TE,RW.RES	;GET RESET LINK TO DATAB
	PUSHJ	PP,FNDCNT	;LOCATE CONTROL ENTRY MATCHING RESET
	JRST	JCE369		;NO SUCH CONTROL (CHECKED AT DA85.)
	HRRZ	TC,TB		;[1452][1475]
	HRRZ	TD,RCOLOC	;[1452]
	SUB	TC,TD		;[1452][1475] MAKE ADDRESS OF CONTROL ENTRY RELATIVE
	CAMGE	TC,THSCTL	;[1452][1475] IS RESET CONTROL HIGHER THAN CURRENT CONTROL
	POPJ	PP,		;YES
JCE370:	HRRZI	DW,E.370
	JRST	FATAL

;CH/CF FINAL

	INTER.	DA95.
DA95.:	HRRZ	TA,CURRPW	;PTR TO RPWTAB
	SETOB	TB,TE		;SET FINAL CONTROL FLAG
	DPB	TB,RW.FNC##
	AOJA	TE,DA94.1	;FINAL HAS "DATAB LINK" OF 0
;READ & FIND A DEFINED DATA-NAME WITH ALL QUALIFIERS
;RETURNS TE=DATAB LINK

	INTER.	DA96.
DA96.:	SETZM	TBLOCK##	;CLR TBLOCK
	MOVE	TA,[TBLOCK,,TBLOCK+1]
	BLT	TA,TBLOCK+24
	MOVEM	W2,TBLOCK+4	;FACTS ABOUT DATA-NAME TO TBLOCK SETUP
	MOVEM	LN,(SAVPTR)	;SAVE LINE POSITION
	MOVEM	CP,1(SAVPTR)
DA96.1:	PUSHJ	PP,GETITM	;READ NEXT SOURCE WORD
	CAIN	TYPE,LPREN.	; LEFT PAREN [247]
	JRST	DA96.4		; YES HANDLE SUBSCRIPTING [247]
	CAIE	TYPE,OF.	;IS IT "OF" OR "IN"?
	JRST	DA96.2		;NO, TIME TO EXIT
	PUSHJ	PP,GETITM	;YES, QUALIFIER SHOULD FOLLOW
	CAILE	TYPE,ENDIT.	;IS IT A RESERVED WORD?
	JRST	DA96.0		;NO, IT'S OK
	SWON	FREGWD		;YES, PREPARE TO REGET THAT ITEM
	EWARNJ	E.101		;& FLAG THIS AS ILLEGAL QUALIFIER

DA96.0:	AOS	TA,TBLOCK+1	;COUNT THE QUALIFIER
	LDB	TB,[POINT 15,W2,15]	;GET NAMTAB LINK
	JUMPL	W1,JCE104	;QUALIFIER MUST BE DEFINED
	MOVEM	TB,TBLOCK+4(TA)	;STORE NAMTAB LINK OF QUAL IN TBLOCK
	JRST	DA96.1		;ANY MORE QUALS?

DA96.2:	MOVE	LN,(SAVPTR)	;RESTORE LINE POSITION OF ITEM IN CASE ERROR
	MOVE	CP,1(SAVPTR)
	SWON	FREGWD		;REGET THIS LAST WORD THAT WASN'T "OF"
	PUSHJ	PP,FINDAT##	;FIND A DATAB MATCH FOR THE ITEM
	JUMPN	DW,DA96.3	;SKIP IF ERROR	[247]
	PUSH	PP,TE		;SAVE LINK POINTER [247]
	HRRZI	TA,(TE)		;SET UP CALL TO LNKSET  [247]
	PUSHJ	PP,LNKSET	;GET DATAB ADDRESS [247]
	POP	PP,TE		; GET IT BACK [247]
	LDB	TB,DA.SUB.	; IS ITEM SUBSCRIPTED [247]
	MOVEI	DW,E.275	;GET ERROR FOR SUBSCRIPTING [247]
	SKIPE	REPSEC		; IN REPORT SECTION [247]
	JUMPN	TB,DA96.3	; SUBCRIPTS ARE ILLEGAL [247]
	POPJ	PP,		;RETURN WITH DATAB LINK IN TE

JCE104:	MOVEI	DW,E.104	; UNDEFINED [247]
DA96.3:	PUSHJ	PP,FATAL	;[247] GIVE MESSAGE
	MOVEI	TE,<CD.DAT>B20+1	;AIM AT DUMMY ENTRY
	POPJ	PP,


DA96.4:	SKIPN	REPSEC		; IN REPORT SECTION [247]
	JRST	DA96.2		; NO GO ON [247]
DA964A:	PUSHJ	PP,GETITM	; GET NEXT SOURCE ITEM [247]
	CAIE	TYPE,ENDIT.	; EOF ON SOURCE? [247]
	CAIN	TYPE,PRIOD.	; PERIOD? [247]
	JRST	DA964B		; YES
	CAIE	TYPE,RPREN.	; RIGHT PAREN ? [247]
	JRST	DA964A		; LOOP TO GET NEXT SOURCE ITEM [247]
	SKIPA			; YES DONT REGET IT [247]
DA964B:	SWON	FREGWD		; SET TO REGET THIS ITEM [247]
	MOVE	LN,(SAVPTR)	; GET BACK POSITION OF ITEM [247]
	MOVE	CP,1(SAVPTR)	; AND ITS CHAR POS [247]
	MOVEI	DW,E.275	; SUBCRIPTS NOT ALLOWED [247]
	PUSHJ	PP,DA96.3	; GIVE ERROR [247]
	PUSHJ	PP,FINDAT	; LOOK FOR DATAB LINK [247]
	JUMPN	DW,DA96.3	; ERROR [247]
	POPJ	PP,		; [247]
;LINK REPORT ITEM TO SOURCE
; The full identifier, possibly with subscripts, has been parsed.

	INTER.	DA97.
DA97.:	HRRZ	W1,CURRPW	;ABS. PTR TO RPWTAB ENTRY
	ADDI	W1,.RWSRC	; STORE THE ITEM HERE
	PUSHJ	PP,DA230.	; STORE THE IDENTIFIER

;RESTORE "CURDAT" SO IT GETS A USAGE WHEN TREES POP BACK TO CALL DA8.
	HLRZ	TA,CURDTT##	;LH OF LINK
	HRLM	TA,CURDAT
	PUSHJ	PP,LNKSET	;GET ABS ADDR.
	HRRM	TA,CURDAT

	HRRZ	TA,CURRPW	;GET PTR AGAIN (USE TA THIS TIME)
	ADDI	TA,.RWSRC
	HRRZ	TE,1(TA)
	PUSH	PP,TE		;SAVE IT
	HRRZI	TA,(TE)		;GET PTR TO DATAB ENTRY
	PUSHJ	PP,LNKSET
	POP	PP,TE
	LDB	TB,DA.RPW##	;RPW LINK SHOULD BE 0 (I.E. W-S OR FILE)
	JUMPN	TB,JCE367	;?SOURCE ITEM MUST BE IN FILE OR W-S SECTION
	SETO	TB,		;SET SOURCE FOR DETAIL BIT
	DPB	TB,DA.RDS
	HRRZ	TA,CURRPW	;PTR TO RPWTAB ENTRY
	LDB	TB,RW.SCD##	;SEEN SOURCE, ETC YET?
	JUMPN	TB,JCE16.	;YES, DUPLICATE ITEM
	HRRZI	TB,%RG.SR	;SAY IT HAS A SOURCE CLAUSE
	DPB	TB,RW.SCD
	DPB	TE,RW.SLK##	;STORE SOURCE LINK TO DATAB
	LDB	TD,RW.DAT##	;GET LINK TO CORRESP DATAB ENTRY
	LDB	TB,RW.RDL##	;& LINK TO CORRESP RD ENTRY
	HRRZ	TA,RPWLOC	;MAKE ABS. PTR TO RD ENTRY
	ADDI	TA,(TB)
	LDB	TB,RW.PC	;GET LINK TO THIS REPORT'S PAGE-CTR
	CAIE	TB,(TE)		;IS THIS SOURCE THE PAGE-CTR?
	POPJ	PP,		;NO
	PUSH	PP,TE		;SAVE LINK TO PAGE-CTR
	HRRZI	TA,(TD)		;MAKE PTR TO DATAB ENTRY
	PUSHJ	PP,LNKSET
	LDB	TB,DA.INS	;GET ITS SIZE
	POP	PP,TE
	PUSH	PP,TB		;SAVE SIZE OF DATAB ENTRY
	HRRZI	TA,(TE)		;MAKE ABS PTR TO PAGE-CTR
	PUSHJ	PP,LNKSET
	LDB	TC,DA.INS	;GET PAGE-CTR'S SIZE
	CAIN	TC,^D10		;1ST TIME THRU?
	SETZ	TC,		;YES, PAGE-CTR IS 0
	POP	PP,TB		;GET BACK SIZE OF DATAB ENTRY
	CAIG	TB,(TC)		;PAGE CTR ALREADY BIGGER?
	POPJ	PP,		;YES
	DPB	TB,DA.EXS	;NO, PAGE-CTR MUST GROW
	DPB	TB,DA.INS
	POPJ	PP,
;ADVANCE TO NEXT ITEM

	INTER.	DA98.
DA98.:	SWOFF	FREGWD		;CLR REGET BIT
	JRST	GETITM		;GET NEXT ITEM

;PROCESS MISSING OPTIONAL DATA-NAME FOR ITEM

	INTER.	DA99.
DA99.:	SKIPN	REPSEC		;REPORT SECTION?
	JRST	DA99.8		;NO, OPTIONAL IN -8x
	SETZB	TA,NAMWRD	;YES, INDICATE REPORT ITEM HAS NO NAME
	DPB	TA,[POINT 15,W2,15]
	JRST	DA27.		;STORE FAKE REPORT WRITER NAME

	INTER.	DA99A.
DA99A.:	SKIPN	REPSEC		;IN REPORT SECTION?
	JRST	DA99.8		;NO, OPTIONAL IN -8x
	SETZB	TA,NAMWRD	;YEAS, INDICATE ITEM HAS NO NAME
	DPB	TA,[POINT 15,W2,15]
	JRST	DA29.		;STORE FAKE REPORT WRITER NAME

DA99.8:	FLAGAT	8		;NO, SIGNAL -8x STANDARD
	POPJ	PP,		;AND RETURN

;CHECK REDEFINES CLAUSE FOR REPORT SECTION ITEM

	INTER.	DA100.
DA100.:	SKIPE	REPSEC		;IN REPORT SECTION?
	EWARNJ	E.348		;YES, ILLEGAL
	POPJ	PP,
;PROCESS SUM IDENTIFIER

	INTER.	DA101.
DA101.:	HRRZ	TA,CURRPW	;GET RPWTAB PTR
	LDB	TB,RW.NSI##	;GET NUMBER OF SUM IDENTIFIERS SEEN
	ADDI	TB,1		;INCREMENT
	DPB	TB,RW.NSI	;& REPLACE
	ROT	TB,-1		;MOVE BIT 35 TO BIT 0
	MOVEM	TB,CTR		;SAVE LEFT/RIGHT FLAG
	JUMPGE	TB,DA101A	;IF EVEN, USE RT HF OF CURRENT ENTRY
	MOVE	TA,[XWD CD.RPW,1]	;IF ODD, GET ANOTHER RPWTAB WORD
	PUSHJ	PP,GETENT
	HLRZM	TA,(SAVPTR)	;SAVE RPWTAB LINK
DA101A:	PUSHJ	PP,DA60S.	;SAVE NAMTAB ENTRY ADDR
	PUSHJ	PP,DA25S.	;SET UP HLDTAB ENTRY
	HRRZ	TB,(SAVPTR)	;STORE RPWTAB LINK IN HLDTAB
	DPB	TB,HL.LNK
	HRRZI	TB,%HL.SL	;GET SUM ID (LH) FLAG
	SKIPL	CTR		;LEFT OR RIGHT HALF STORE?
	HRRZI	TB,%HL.SR	;RT., GET SUM ID (RH) FLAG
	DPB	TB,HL.COD	;STORE HLDTAB CODE
	POPJ	PP,

;SUM UPON CLAUSE

	INTER.	DA102.
DA102.:	PUSHJ	PP,DA60S.	;SAVE NAMTAB ENTRY ADDR
	PUSHJ	PP,DA25S.	;SET UP HLDTAB ENTRY
	HRRZI	TB,%HL.UP	;SET 'SUM UPON' CODE
	DPB	TB,HL.COD
	PUSH	PP,TA
	MOVE	TA,[CD.RPW,,SZ.RPU]	;GET AN UPON DATA ENTRY IN RPWTAB
	PUSHJ	PP,GETENT
	HLRZ	TB,TA		;STORE RPWTAB LINK IN HLDTAB
	POP	PP,TA
	DPB	TB,HL.LNK
	LDB	TA,HL.NAM	;GET NAMTAB ENTRY
	ADD	TA,NAMLOC
	HRRZ	TC,(TA)		;GET ADDRESS OF DATAB ENTRY
	MOVE	TA,TC
	PUSHJ	PP,LNKSET	;MAKE REAL ADDRESS
	LDB	TA,DA.RPW	;GET RPWTAB LINK
	ADD	TA,RPWLOC	;MAKE LINK REAL ADDRESS
	LDB	TD,RW.TYP	;GET TYPE OF REPORT GROUP
	CAIE	TD,%RG.DE	;DETAIL GROUP ?
	EWARNJ	E.364		;NO, GENERATE FATAL ERROR AND RETURN
	MOVE	TA,TB		;TA CONTAINS NEW ADDRESS OF RPWTAB UPON ENTRY
	ADD	TA,RPWLOC
	DPB	TC,RW.UP1##	;STORE POINTER TO RPWTAB ENTRY
	SETO	TB,
	DPB	TB,RW.RSU##	;SET REFERENCED-BY-SUM-UPON 
	HRRZ	TA,CURRPW	;GET LINK TO CURRENT RPWTAB ENTRY
	LDB	TB,RW.NUP##	;GET NUMBER OF UPON DATA ITEMS
	ADDI	TB,1		;INCREMENT
	DPB	TB,RW.NUP
	POPJ	PP,
;SET UP FOR SUM CLAUSE

	INTER.	DA103.
DA103.:	HRRZ	TA,CURRPW	;PTR TO RPWTAB
	LDB	TB,RW.SCD	;SEEN SUM, ETC YET?
	JUMPN	TB,JCE16.	;YES, DUP. CLAUSE
	LDB	TC,RW.TYP	; [315] SUM CLAUSE ALLOWED
	CAIE	TC,%RG.CF	; [315] ONLY FOR CF
	EWARNJ	E.363		; [315]- ERROR
	HRRZI	TB,%RG.SM	;NO, INDICATE ITEM HAS A SUM CLAUSE
	DPB	TB,RW.SCD
	LDB	TE,RW.DAT	;GET LINK TO CORRESP. DATAB ITEM
	PUSH	PP,TE		;SAVE
	MOVE	TA,[CD.HLD,,SZ.HLD]	;GET A HLDTAB ENTRY
	PUSHJ	PP,GETENT
	HRRZI	TB,%HL.SC	;SET "BUILD-SUM-CTR" CODE
	DPB	TB,HL.COD
	POP	PP,TE
	DPB	TE,HL.LNK	;& PUT IN LINK TO DATAB ITEM
	HRRZ	TC,RPTCID	; [415] GET LEVEL NUMBER
	DPB	TC,HL.CID##	; [415] STORE INTO HLDTAB
	HRRZ	TC,RPWRDL	; [415] GET RD LINK
	DPB	TC,HL.RD##	; [415] STORE INTO HLDTAB
	POPJ	PP,

;SET DEFAULTS FOR PAGE LIMIT CLAUSE

	INTER.	DA104.
DA104.:	PUSHJ	PP,GETRDL	;GET PTR TO RPWTAB GROUP ENTRY
	LDB	TB,RW.PHL	;GET PAGE HEADING LINE #
	JUMPN	TB,.+3		;SET?
	MOVEI	TB,1		;NO, MAKE IT 1
	DPB	TB,RW.PHL
	LDB	TC,RW.FDE	;GET FIRST DETAIL LINE #
	JUMPN	TC,.+3		;SET?
	MOVEI	TC,(TB)		;NO, DEFAULT = PHL
	DPB	TC,RW.FDE
	CAMLE	TB,TC		;[215] HEADING .LE. FIRST DETAIL?
	JRST	JCE489		;[215] NO IS AN ERROR
	LDB	TB,RW.PAG	;PAGE LIMIT
	LDB	TC,RW.LDE##	;LAST DETAIL
	LDB	TD,RW.CFL	;FOOTING
	JUMPN	TC,DA104A	;LDE SET?
	JUMPN	TD,.+2		;NO, CFL SET?
	MOVEI	TD,(TB)		;NO, NEITHER SET. MAKE BOTH = PAGE LIMIT
	MOVEI	TC,(TD)		;MAKE LDE = CFL
	JRST	.+3
DA104A:	JUMPN	TD,DA104B	;LDE SET. IS CFL SET?
	MOVEI	TD,(TC)		;NO, MAKE CFL = LDE
	DPB	TC,RW.LDE	;STORE VALUES
	DPB	TD,RW.CFL
DA104B:	CAMLE	TC,TD		;[215] LDE .LE. CFL?
	JRST	JCE491		;[215] NO - SO ERROR
	LDB	TB,RW.FDE	;[215]
	CAMLE	TB,TC		;[215] FDE .LE. LDE?
	JRST	JCE490		;[215] NO - SO ERROR
	POPJ	PP,
;CK FOR MISSING PERIOD ON DATA ITEM

	INTER.	DA105.
DA105.:	CAIE	TYPE,INTGR.
	CAIN	TYPE,2000+INTGR.
	JRST	DA105B
	CAIN	TYPE,2000+FD.	;[1376] IS IT FD?
	JRST	DA105A		;[1376] REGET WORD?
	CAIE	TYPE,2000+PROC.
	CAIN	TYPE,2000+WORKI.
	JRST	DA105A
	CAIE	TYPE,2000+REPOR.
	CAIN	TYPE,2000+LINKG.
DA105A:	SWONS	FREGWD;
	EWARNJ	E.18		;IMPROPER CLAUSE
	PUSHJ	PP,CE125.	;PERIOD ASSUMED
	JRST	DA107.		;POP UP A LEVEL IN TREE
DA105B:	LDB	TB,GWVAL	;GET THE INTEGER
	MOVEM	TB,CTR
	HRRZI	TA,LITVAL
	PUSHJ	PP,GETVAL##
	CAIN	TC,^D77
	JRST	DA105A
	CAIL	TC,1
	CAILE	TC,^D49
	EWARNJ	E.18		;IMPROPER CLAUSE
	JRST	DA105A		;THEN PERIOD ASSUMED ERROR
;STORE CODE LINK

	INTER.	DA106X
DA106X:	HRRZ	TA,CURRPW	;GET CURRENT ENTRIES RPWTAB LINK
	LDB	TA,RW.FIL	;GET FILTAB LINK
	ADD	TA,FILLOC##	;MAKE IT ABSOLUTE
	LDB	TB,FI.COD
	LDB	TC,FI.MRE
	SKIPE	TB		;CODE CLAUSE SEEN FOR OTHER REPORTS ?
	SETZ	TC,		;YES
	JUMPN	TC,DA106E	;IF MORE THAN ONE REPORT IN THIS FILE, GIVE WARNING
	SETO	TB,
	DPB	TB,FI.COD##	;SET CODE CLAUSE SEEN FOR THIS FILE
	POPJ	PP,

DA106E:	EWARNW	E.778		;CODE CLAUSE MUST APPEAR FOR ALL OR NONE
	POPJ	PP,

	INTER.	DA106.
DA106.:	FLAGAT	68
	LDB	TA,[POINT 15,W2,15]	;NAMTAB LINK
	HRRZI	TB,CD.MNE
	PUSHJ	PP,FNDLNK
	  TRN
	HLRZS	TB
DA106S:	PUSHJ	PP,GETRDL	;GET PTR TO RD ENTRY
	DPB	TB,RW.COD##
	POPJ	PP,

	INTER.	DA106A
DA106A:	HLRZ	TB,W1		;GET LENGTH OF LITERAL
	ANDI	TB,777
	CAIN	TB,2		;SHOULD BE EXACTLY 2 CHARACTERS
	JRST	DA106B		;IT IS
	HRRZI	DW,E.746	;NO WARN
	PUSHJ	PP,DA24X.
DA106B:	MOVE	TA,[CD.MNE,,SZ.MNE]
	PUSHJ	PP,GETENT	;FAKE UP A MNEMONIC TABLE ENTRY
	MOVSI	TB,700000
	MOVEM	TB,(TA)		;SET CODE
	HLRZ	TB,LITVAL	;GET LITERAL
	LSH	TB,-4		;ONLY 2 CHARACTERS
	HRL	TB,MTCODE	;AND SET CODE BIT
	MOVEM	TB,1(TA)
	HLRZ	TB,TA		;GET MNEMONIC TABLE ADDRESS
	JRST	DA106S		;AN STORE IN CURRENT RPWTAB
;END OF DATA ITEM
;IF IN REPORT SECTION AND ITEM HAS NO NAME, GIVE IT ONE

	INTER.	DA107.
DA107.:	SKIPN	REPSEC		;IN REPORT SECTION?
	JRST	DA0.		;NO, POP UP A LEVEL IN TREE
	PUSHJ	PP,FAKNAM	;YES
	HRRZ	TA,CURDAT	;GET DATAB LINK TO CURRENT DATA NAME
	LDB	LN,DA.LN	;RESTORE LN
	LDB	CP,DA.CP	; AND CP OF DATA ITEM
	HRRZI	DW,E.784	;GET READY FOR POSSIBLE ERROR
	LDB	TB,DA.PIC
	HRRZ	TA,CURRPW	;GET RPWTAB LINK TO CURRENT DATA NAME
	LDB	TC,RW.GPI	;GROUP INDICATE SEEN FOR THIS DATA ITEM ?
	JUMPE	TC,DA0.		;NO, EXIT
	LDB	TC,RW.COL
	SKIPE	TB		;PICTURE CLAUSE SEEN ?
	SKIPN	TC		;AND COLUMN CLAUSE SEEN ?
	PUSHJ	PP,WARN		;NO, GENERATE WARNING
	JRST	DA0.		;NOW POP UP A LEVEL IN TREE
SUBTTL	TABLE HANDLING SYNTAX

;ASCENDING KEY FOR OCCURS

	INTER.	DA108.
DA108.:	HRRZI	TB,%HL.KY	;ASC. KEY CODE
DA108X:	FLAGAT	HI
	MOVEM	TB,TBLOCK	;SAVE CODE UNTIL NAME SEEN
	POPJ	PP,

;DESCENDING KEY FOR OCCURS

	INTER.	DA109.
DA109.:	HRRZI	TB,%HL.DY	;DESC. KEY CODE
	JRST	DA108X

;ASCENDING/DESCENDING KEY FOR OCCURS

	INTER.	DA110.
DA110.:	PUSHJ	PP,DA60S.	;SAVE NAMTAB ADDR
	PUSHJ	PP,DA25S.	;SET UP HLDTAB ENTRY
	HRRZ	TB,TBLOCK	;STORE KEY CODE
	DPB	TB,HL.COD
	HRRZ	TA,CURDAT##	;PTR TO DATAB ENTRY
	LDB	TB,DA.PWA	;PIC WORDS ALLOCATED?
	JUMPN	TB,DA110A	;YES
	MOVE	TA,[CD.DAT,,SZ.MSK]	;NO, DO IT
	PUSHJ	PP,GETENT
	HRRZ	TA,CURDAT
	SETO	TB,		;& SAY SO
	DPB	TB,DA.PWA
DA110A:	LDB	TB,DA.KEY##	;INCREMENT KEY CTR
	ADDI	TB,1
	CAIG	TB,377		;[1346] UP TO 255 KEYS ALLOWED
	JRST	DA110C		;[1346]
	MOVEI	DW,E.756	;[1346] ELSE QUANTITY GETS TRUNCATED
	PUSHJ	PP,FATALW	;[1346]
DA110C:	DPB	TB,DA.KEY	;[1346]
	SOJE	TB,DA110B	;[220] IS THIS THE MAJOR KEY?
	LDB	TB,[POINT 15,(TA),17]	;[220] NO, GET THE GROUP'S NAMTAB REL ADR.
	HLRZ	TC,CURNAM	;[220] GET THE CURRENT ITEM'S NAMTAB REL ADR.
	CAIE	TB,(TC)		;[220] ARE THEY THE SAME ITEM?
	JRST	DA110B		;[220] NO, NO PROBLEMS.
;[220] WE GET HERE IF WE HAVE A MINOR KEY WHICH IS ALSO THE SUBJECT OF THE OCCURS.
;[220] ERROR MESSAGE:  FATAL - A GROUP ITEM MAY NOT BE A MINOR KEY
	MOVEI	DW,E.151	;[220] SET UP ERROR NUMBER.
	PUSHJ	PP,FATALW	;[220] GO PUT IT IN THE ERROR FILE.
DA110B:	MOVE	TA,[CD.DAT,,1]	;GET A WORD ON DATAB ENTRY FOR KEY
	PUSHJ	PP,GETENT
	HLRZ	TB,TA		;SAVE DATAB ADDR
	HLRZ	TC,CURHLD
	HRRZ	TA,HLDLOC##	;MAKE ABS. PTR TO HLDTAB ENTRY
	ADDI	TA,(TC)
	DPB	TB,HL.LNK	;STORE DATAB PTR IN HLDTAB
	POPJ	PP,
;INITIALIZE LINKAGE SECTION

	INTER.	DA112.
DA112.:	SETOM	LNKSEC##	;SET LINKAGE SECTION FLAG
	SETOM	SUBPRG##	;THIS IS A SUBPROGRAM
	MOVE	TB,EAS1PC	;SAVE DATA PC WHILE DOING
	MOVEM	TB,PCHOLD	;  LINKAGE SECTION
	JRST	DA3.0		;REST IS LIKE WORKING-STORAGE
SUBTTL	DBMS SYNTAX

;ACTIONS FOR INVOKE VERB

IFN DBMS,<

	INTER.	DA113.
DA113.:	SKIPE	SCHSEC##	;SCHEMA SECTION SEEN BEFORE
	EWARNW	E.408		;YES, GIVE ERROR
	FLAGAT	DB
	PUSHJ	PP,DA119B	;[476] SEE IF ANY OTHER SECTIONS SEEN
	SETOM	SCHSEC
	SETZM	INVSEE##	;[%316]
	SETZM	ACCSEE##	;[%316]
	SETZM	DBCNTC##	;CLEAR COUNT OF "INVOKE"/ACCESS'S
	POPJ	PP,		;[%316] DELAY FUDGED SECTION SETTING TILL INVOKE OR ACCESS SEEN

	INTER.	DA114A
DA114A:	DMOVEM	LN,INVLN##	;SAVE LN AND CP FOR INVOKE
	SKIPE	DBCNTC##	;[%316] ERROR IF NON-0, DELAY MSG
	POPJ	PP,		;[%316]
	SETOM	INVSEE##
	PUSHJ	PP,DA10.	;[%316] DOWN FROM DA113--PRETEND THAT IT'S A W-S SECTION
	JRST	DA3.		;[%316] DITTO

	INTER.	DA114B
	;[%316] DA114B NEW--FOR ACCESS. NOTE 114. MADE 114A FOR SYMMET.
DA114B:	DMOVEM	LN,INVLN##	;SAVE LN AND CP FOR INVOKE
	SKIPE	DBCNTC##	;[%316] ERROR IF NON-0, DELAY MSG
	POPJ	PP,		;[%316]
	SETOM	ACCSEE##
	PUSHJ	PP,DA10.	;[%316] PRETEND THAT IT'S A LINKAGE SECTION
	JRST	DA112.		;[%316] DITTO

	INTER.	DA115.
DA115.:	MOVE	TA,[NAMWRD,,S.SCH##]	;[%316] MAKE IT HANDLE 30-CHARACTER SUBSCHEMAS
	BLT	TA,S.SCH##+4		;[%316]30 SIXBIT CHARS IN 5 WORDS
	POPJ	PP,			;[%316]PASS THRU FOR COMPAT WITH PREPRO

	INTER.	DA116.
DA116.:	MOVE	TA,NAMWRD
	MOVEM	TA,SCHEMA##
	POPJ	PP,			;[%316]PASS THRU FOR COMPAT WITH PREPRO

	INTER.	DA117.
DA117.:	MOVE	TA,NAMWRD	
	MOVEM	TA,PKEY##
	POPJ	PP,			;[%316]PASS THRU FOR COMPAT WITH PREPRO
;THIS ACTION SETS UP THE WORLD FOR GETITM TO CONTINUE READING
;FROM THE NEW ###DBC.TMP FILE.

	INTER.	DA119.
DA119.:	AOS	TA,DBCNTC	;BUMP COUNT OF "INVOKE"'S
	CAILE	TA,1		;[%316]NEW RULE IS AT MOST ONE INV. PER P-U
	JRST	E.MXIN
	PUSHJ	PP,DDL.##	;CREATE DDL FILES
IFE TOPS20,<
	CALLI	TC,$PJOB	;GET JOB NUMBR
	MOVEI	TD,3
	IDIVI	TC,^D10
	ADDI	TB,"0"-40
	LSHC	TB,-6
	SOJG	TD,.-3		;LH OF TA HAS # IN DECIMAL
	HRRI	TA,'DBC'	;GET REST OF FILENAME
	MOVEM	TA,DBBLCK##
	HRLZI	TA,'TMP'	;GET EXTENSION
	MOVEM	TA,DBBLCK+1
	SETZM	DBBLCK+2
	SETZM	DBBLCK+3
	SETZM	DBOPBK##	;SET MODE TO ASCII
	MOVSI	TA,'DSK'
	MOVEM	TA,DBOPBK+1	;PUT DEVICE NAME IN
	HRRZI	TA,DBBUFH##
	MOVEM	TA,DBOPBK+2	;PUT BUFFER HEADER ADDR IN
	MOVE	TA,[POINT 7,DBUFF1+3]
	MOVEM	TA,DBBUFH+1
	MOVE	TA,[XWD	201,DBUFF1+1]
	MOVEM	TA,DBUFF1+1
	OPEN	DBCHAN,DBOPBK	;TRY AN OPEN
	  JRST	OPNERR

	MOVE	TA,[XWD	400000,DBUFF1##+1]
	MOVEM	TA,DBBUFH
	LOOKUP	DBCHAN,DBBLCK	;IS FILE THERE?
	  JRST	NOTFND
	IN	DBCHAN,		;GET A BUFFER
	TRNA			;OK
	  JRST	INPERR
>
IFN TOPS20,<
	PUSHJ	PP,SETDBS##	;OPEN "DBC" FILE FOR READ
>
	SETOM	FINVOK##	;SET INVOKE FLAG
	SETOM	FINVD##		;TELL COBOLD TO READ FILE.
	TSWFZ	FSEQ		;[453] IS /S SWITCH ON--IF YES TURN IT OFF
	SETOM	DBONLY##	;[453] IT WAS ON, REMEMBER IT
	POPJ	PP,
E.MXIN:	OUTSTR	[ASCIZ /?CBLTMI--too many "INVOKES" specified
?Cannot continue
/]
IFE TOPS20,<
	CALLI	$EXIT
>
IFN TOPS20,<
	HALTF%
	JRST	.-1
>

IFE TOPS20,<
OPNERR:	OUTSTR	[ASCIZ /?FATAL--OPEN/]
ALLERR:	OUTSTR	[ASCIZ / error on file /]
	SETZ	TA,
	MOVEI	TE,3
	MOVE	TD,[POINT  7,TA]
	MOVE	TC,[POINT  6,DBBLCK]
ALL2:	ILDB	TB,TC
	ADDI	TB,40
	IDPB	TB,TD
	SOJG	TE,ALL2
	OUTSTR	TA
	OUTSTR	[ASCIZ /DBC.TMP
?Cannot continue
/]
	CALLI	$EXIT

NOTFND:	OUTSTR	[ASCIZ "?FATAL--LOOKUP"]
	JRST	ALLERR
INPERR:	MOVE	TA,PKEY		;[513] GET PRIVACY KEY
	AOJE	TA,[EWARNJ E.429]	;[513] PRIV KEY OF -1 = BAD KEY
	OUTSTR	[ASCIZ /?FATAL--INPUT/]
	JRST	ALLERR
>

DA119A:	SKIPE	SCHSEC##	;[476] SCHEMA SECTION SEEN?
	EWARNJ	E.470		;[476] YES, ERROR
DA119B:
IFN MCS,<
	SKIPN	CSSEEN##	;[476] COMM. SECTION SEEN?
>
DA119C:	SKIPE	WRKSEC##	;[476] WORKING-STORAGE SECTION SEEN?
	EWARNJ	E.470		;[476] YES, ERROR
	SKIPGE	LNKSSN##	;[763] [476] LINKAGE SECTION SEEN ?
	SKIPGE	ACCSEE##	;[476] ACCESS VERB USED?
	SKIPE	REPSSN##	;[763] [476] REPORT SECTION SEEN?
	EWARNJ	E.470		;[476] YES, ERROR
	POPJ	PP,		;[476] OK, RETURN
	>
SUBTTL	MCS SYNTAX

IFN MCS,<

	INTER.	DA120.
DA120.:	SKIPE	CSSEEN##	;COMM SEC SEEN?
	EWARNJ	E.432
	SETOM	CSSEEN
	FLAGAT	HI
	SKIPE	REPSSN		;COMM SECTION IS LAST EXCEPT FOR REPORT SECTION
	EWARNJ	E.470
	SETOM	LSTW77##	;[476] CLEAR IN CASE WORKING-STORAGE SEEN

	SWOFF	FFILSC
	SETZM	REPSEC
	SETZM	LNKSEC
IFN DBMS,<			;[503]
	SKIPE	INVSEE##	;[412] IF INVOKE SEEN,W-S SEC STUFF DONE
	POPJ	PP,		;[412] DON'T DO IT AGAIN
	>			;[503]
	SKIPL	TA,PCHOLD
	MOVEM	TA,EAS1PC
	SETOM	PCHOLD
	SKIPE	WRKSEC		;HAVE WE SEEN WORK-SEC?
	POPJ	PP,		;YES, DON'T DO ANYTHING
	PUSHJ	PP,DA10.	;NO, PRETEND THIS IS IT
	JRST	DA3.


	INTER.	DA121.
DA121.:	TLO	W2,GWDEF
	PUSHJ	PP,PUTCRF		;PUT OUT CREF LISTING
	PUSHJ	PP,TRYNAM		;CD-NAME IN NAMTAB?
	  PUSHJ	PP,BLDNAM		;PUT IT IN
	MOVEM	TA,CURNAM
	HLRZS	TA
	DPB	TA,[POINT 15,W2,15]	;SET UP W2
	MOVE	TA,[XWD	CD.CD,SZ.CD]	;GET CDTAB CODE AND SIZE
	PUSHJ	PP,GETENT
	MOVEM	TA,CURCD##
	LDB	TB,[POINT 15,W2,15]
	CLEARM	(TA)			;CLEAR 1ST WORD
	DPB	TB,CD.NAM##		;PUT IN NMTAB LINK
	LDB	TB,[POINT 20,W2,35]	;GET LN,CP
	MOVEM	TB,1(TA)
	HLR	TA,CURNAM
	PJRST	PUTLNK			;SET SAME-NAME CHAIN
	INTER.	DA122.
DA122.:	MOVE	TA,CURCD
	SKIPE	FINITL##		;HAVE WE SEEN INITIAL BEFORE?
	EWARNJ	E.446			;YES, BOOBOO
	MOVEM	TA,FINITL		;SAVE ADDR OF INITIAL ENTRY
	MOVEI	TB,1
	DPB	TB,CD.INT##		;THIS ALSO CLEARS INPUT BIT
	POPJ	PP,

	INTER.	DA123.
DA123.:	MOVEI	TA,CDBLK##
	HRLI	TA,^D-11		;SET UP TO CLEAR CDBLK
	CLEARM	(TA)
	AOBJN	TA,.-1
	CLEARM	CDINDX##		;CLEAR INDEX TOO
	POPJ	PP,

	INTER.	DA124.
DA124.:	HRRZI	TA,^D10
SAVIDX:	MOVEM	TA,CDINDX		;SAVE CDBLK INDEX
	POPJ	PP,

	INTER.	DA125.
DA125.:	CLEARM	CDINDX
	JRST	DA7.			;REGET WORD


	INTER.	DA126.
DA126.:	CLEARM	CDINDX
	POPJ	PP,

	INTER.	DA127.
DA127.:	HRRZI	TA,1
	JRST	SAVIDX

	INTER.	DA128.
DA128.:	HRRZI	TA,2
	JRST	SAVIDX

	INTER.	DA129.
DA129.:	HRRZI	TA,3
	JRST	SAVIDX

	INTER.	DA130.
DA130.:	HRRZI	TA,6
	JRST	SAVIDX

	INTER.	DA131.
DA131.:	HRRZI	TA,4
	JRST	SAVIDX

	INTER.	DA132.
DA132.:	HRRZI	TA,5
	JRST	SAVIDX
	INTER.	DA133.
DA133.:	HRRZI	TA,7
	JRST	SAVIDX


	INTER.	DA134.
DA134.:	HRRZI	TA,^D8
	JRST	SAVIDX


	INTER.	DA135.
DA135.:	HRRZI	TA,^D9
	JRST	SAVIDX


	INTER.	DA136.
DA136.:	PUSHJ	PP,TRYNAM
	  PUSHJ	PP,BLDNAM
	MOVEI	TB,CDBLK##
	ADD	TB,CDINDX
	HLRZ	TA,TA		;GET REL. ADDR
	SKIPE	(TB)		;ENTRY ALREADY GIVEN?
	EWARNW	E.447		;YES
	DPB	TA,[POINT 15,W2,15]
	MOVEM	W2,(TB)		;PUT INTO CDBLK
	POPJ	PP,


	INTER.	DA137.
DA137.:	MOVE	TA,CDINDX
	CAIL	TA,^D12		;12 DATA-NAMES?
	EWARNJ	E.434		;YES
	PUSHJ	PP,DA136.
	AOS	CDINDX		;BUMP INDEX
	POPJ	PP,


	INTER.	DA138.
DA138.:	HRRZ	TA,CURCD
	MOVEI	TB,1
	DPB	TB,CD.OUT##
	MOVEI	TA,CDBLK
	HRLI	TA,^D-11	;SET UP TO CLEAR CDBLK
	CLEARM	(TA)
	AOBJN	TA,.-1
	POPJ	PP,
;MACRO TO DISTINGUISH BETWEEN INPUT OR OUTPUT CD:
	DEFINE	IFINP(.A)
	<HRRZ	TC,CURCD
	SKIPL	1(TC)
	JRST	.A>




	INTER.	DA139.
DA139.:	MOVEI	TA,1		;DA26.
	MOVEM	TA,DATLVL
	MOVEM	TA,LEVEL
	SETZM	RUSAGE		;---
	PUSH	PP,FLGSW	;SAVE FIPS FLAGGING BITS
	SETZM	FLGSW		;IGNORE POSSIBLE FLAGGER ERRORS
	MOVE	TA,[SIXBIT /FILLER/]
	MOVEM	TA,NAMWRD
	CLEARM	NAMWRD+1
	TLO	W2,GWDEF	;MAKE IT DEFINED
	MOVEI	CT,FILLE.	;MAKE IT "FILLER"
	PUSHJ	PP,DA27A	;DA27A
	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
	MOVE	TA,CURDAT	;REPLACE TA
	MOVEI	TD,2
	DPB	TD,DA.USG	;USAGE
	PUSHJ	PP,DA30N.	;DA30N
	MOVEI	TE,CDBLK	;TE==CDBLK PTR
	HRRZ	TB,CURCD
	ADDI	TB,2		;TB==CDTAB + 2
	LDB	TD,[POINT 7,-1(TB),35]	;SET UP LN,CP
	DPB	TD,DA.CP
	LDB	TD,[POINT 13,-1(TB),28]
	DPB	TD,DA.LN
	TLO	TB,442200	;MAKE IT A XWD BYTE PTR
	HLRZ	TD,CURDAT
	IDPB	TD,TB		;PUT IN CD LINK
	IFINP	DA139A
	ADDI	TB,2		;BUMP CDTAB PTR BY 5 XWD'S
	IBP	TB
	ADDI	TE,3		;BUMP CDBLK PTR BY 3

DA139A:	IFINP	D139AA
	CAIE	TE,CDBLK+8	;IF THIS IS ENTRY 8 OR 9...
	CAIN	TE,CDBLK+9
	SKIPA	TD,[3]		;...THEN MAKE IT LEVEL 3
D139AA:	MOVEI	TD,2		;DA11.
	MOVEM	TD,(SAVPTR)
	PUSHJ	PP,PUSHEM
	PUSHJ	PP,DA28.	;DA28.
	PUSHJ	PP,POPEM
	IFINP	D139AB
	CAIN	TE,CDBLK+6	;IF ENTRY 6, GO BUILD SPECIAL ENTRY
	JRST	D139OC
D139AB:	MOVEI	CT,USERN.
	SKIPE	W2,(TE)		;GET CDBLK ENTRY
	JRST	DA139B		;OK, WE HAVE ONE
	MOVE	TD,[SIXBIT /FILLER/]
	MOVEM	TD,NAMWRD
	CLEARM	NAMWRD+1
	MOVEI	CT,FILLE.	;MARK TYPE AS FILLER SO WE DON'T CREF IT
	PUSHJ	PP,PUSHEM
	PUSHJ	PP,TRYNAM	;IN NAMTAB? (IT SHOULD BE)
	  PUSHJ	PP,BLDNAM
	PUSHJ	PP,POPEM
	HLRZS	TA		;GET REL. ADDR
	HRRZ	TD,CURCD
	LDB	TD,[POINT 20,1(TD),35]	;GET LN,CP
	DPB	TD,[POINT 20,(TE),35]	;PUT INTO CDBLK
	DPB	TA,[POINT 15,W2,15]	;SET NAMTAB LINK
DA139B:	HLRZ	W1,CURCD
	PUSHJ	PP,PUSHEM
	PUSHJ	PP,DA29.	;DA29.
	MOVE	TE,0(PP)	;RECOVER TE
	IFINP	DA139C
	CAIN	TE,CDBLK+3	;IF ENTRY 3, SET DEFAULT VALUE
	SKIPE	CDBLK+6		;IF DESTINATION TABLE IS ZERO
	JRST	DA139C
	MOVE	TA,[CD.LIT,,SZ.LIT]
	PUSHJ	PP,GETENT	;GET SPACE FOR DEFAULT VALUE
	MOVSI	TB,1201
	MOVEM	TB,0(TA)	;STORE BITS
	MOVSI	TB,(ASCII/1/)
	MOVEM	TB,1(TA)	;STORE VALUE
	HLRZ	TB,TA		;GET REL LOCATION
	HRRZ	TA,CURDAT
	DPB	TB,DA.VAL	;STORE VALTAB LINK
DA139C:	PUSHJ	PP,DA30N.	;DA30N
	PUSHJ	PP,POPEM
	HLRZ	TA,CURDAT	;GET REL ADDR
	IDPB	TA,TB		;PUT INTO CDTAB
	HRR	TA,CURDAT	;GET ABS ADDR
	IFINP	.+3
	MOVEI	TD,OUTPIC-3(TE)	;SET UP WITH OUTPUT PIC TABLE
	SKIPA
	MOVEI	TD,INPIC(TE)
	SUBI	TD,CDBLK	;THIS GIVES ADDRESS IN INPIC
	MOVE	TD,(TD)		;GET INPIC ENTRY
	DPB	TD,DA.EXS	;EXTERNAL SIZE
	DPB	TD,DA.INS	;INTERNAL SIZE
	SKIPL	TD		;NUMERIC?
	TDZA	TC,TC		;NO, ALPHANUMERIC
	MOVEI	TC,2
	DPB	TC,DA.CLA	;SET CLASS
	MOVEI	TC,2		;DISPLAY-7
	DPB	TC,DA.USG
	LSH	TC,-1		;MAKE IT A "1"
	DPB	TC,DA.PIC	;PIC SEEN
	LDB	TC,[POINT 13,(TE),28]	;LN
	DPB	TC,DA.LN
	LDB	TC,[POINT 6,(TE),35]	;CP
	DPB	TC,DA.CP
	AOS	TE		;BUMP CDBLK PTR
	CAIGE	TE,CDBLK+^D11	;THRU CDBLK?
	JRST	DA139A		;NO
	POP	PP,FLGSW	;TURN ON FLAGGER AGAIN
	JRST	DA8.		;********EXIT*********

D139OC:	MOVE	TA,[SIXBIT /FILLER/]
	MOVEM	TA,NAMWRD
	CLEARM	NAMWRD+1
	PUSHJ	PP,PUSHEM
	PUSHJ	PP,TRYNAM
	  PUSHJ	PP,BLDNAM
	HLRZS	TA		;GET REL ADDR.
	DPB	TA,[POINT 15,W2,15]
	MOVEI	CT,FILLE.
	HLRZ	W1,CURCD	;AND TABLE LINK
	PUSHJ	PP,DA29.
	PUSHJ	PP,DA30N.	;BUILD FILLER
	PUSHJ	PP,POPEM
	HRRZ	TA,HLDSAV##	;GET SAVED HLDTAB ENTRY
	JUMPE	TA,D13902
	HLRZ	TD,CURDAT	;GET CURRENT DATAB PTR
	HLRZ	TC,CDBLK+7	;GET COUNTER
	DPB	TD,HL.LNK	;PUT DATAB LINK IN HLDTAB
	ADDI	TA,2
	SOJG	TC,.-2
	SETZM	HLDSAV		;CLEAR IT
D13902:	HRRZ	TC,CURCD
	LDB	TD,[POINT 13,1(TC),28]
	HRR	TA,CURDAT
	DPB	TD,DA.LN	;FIX LN,CP
	LDB	TD,[POINT 6,1(TC),35]
	DPB	TD,DA.CP
	MOVE	TC,(TE)		;GET # OF OCCURANCES
	ADDI	TE,2		;BUMP CDBLK PTR TO WORD 8
	JUMPE	TC,DA139A	;IF NO OCCUR.,DON'T DO ANY MORE
	MOVEM	TC,(SAVPTR)
	PUSHJ	PP,PUSHEM
	PUSHJ	PP,D33MCS	;FIX DATAB ENTRY
	PUSHJ	PP,POPEM
	MOVE	TA,CURDAT	;GET LEVEL 2 DATAB LINK
	HRRZ	TC,CDBLK+7	;GET INDEX POINTER
	SKIPE	TC		;NO INDEXED BY PHRASE
	DPB	TC,DA.XBY##	;PUT "INDXD BY" IN DATAB
	JRST	DA139A
	INTER.	DA140.
DA140.:	PUSHJ	PP,DA11.	;GET INTEGER VALUE
	JUMPLE	TC,JCE25.	;VALUE MUST BE BETWEEN 1 AND 50
	CAILE	TC,^D50
;	CAIE	TC,1		;ONLY 1 ALLOWED
	EWARNW	E.445
	MOVEM	TC,CDBLK+6
	POPJ	PP,


	INTER.	DA141.
DA141.:	SETOM	COMSEC##	;SET COMM. SECTION ACTIVE
	PUSHJ	PP,DA34.
	CLEARM	COMSEC		;THIS IS ONLY PLACE WE NEED IT
	HLRZ	TA,CDBLK+7	;GET INDEX COUNT
	AOS	TA		;BUMP IT
	HRLM	TA,CDBLK+7
	CAIE	TA,1		;IS THIS THE FIRST ONE?
	POPJ	PP,
	HLRZ	TA,CURHLD	;YES, SAVE HLDTAB LINK
	HRRM	TA,CDBLK+7
	MOVE	TB,CURHLD
	MOVEM	TB,HLDSAV##	;SAVE 1ST HLDTAB ENTRY PTR
	POPJ	PP,


	INTER.	DA142.
DA142.:	SWON	FREGWD
	JRST	DA135.


	INTER.	DA143.
DA143.:	SETOM	COMSEC		;SET COMM.SECTION ACTIVE
	JRST	DA7.


	INTER.	DA144.
DA144.:	CLEARM	COMSEC		;CLEAR COMM. SECTION ACTIVE
	POPJ	PP,
PUSHEM:	POP	PP,TD
	PUSH	PP,TB
	PUSH	PP,TE
	JRST	(TD)

POPEM:	POP	PP,TD
	POP	PP,TE
	POP	PP,TB
	JRST	(TD)

;THIS IS A TABLE INDICATING THE DATA TYPE AND LENGTH OF EACH
;ENTRY IN THE CDBLK.  THE RIGHT HALF IS THE LENGTH AND BIT 0
;IS THE CLASS----0=ALPHANUMERIC
;		   1=NUMERIC

NUMERIC==400000
INPIC:	XWD	0,^D12
	XWD	0,^D12
	XWD	0,^D12
	XWD	0,^D12
	XWD	NUMERIC,6
	XWD	NUMERIC,^D8
	XWD	0,^D12
	XWD	NUMERIC,4
	XWD	0,1
	XWD	0,2
	XWD	NUMERIC,6


;SAME TABLE FOR OUTPUT PICS (1ST 3 ENTRIES OF CDBLK DON'T HAVE ENTRIES
;IN THIS TABLE.

OUTPIC:	XWD	NUMERIC,4
	XWD	NUMERIC,4
	XWD	0,2
	Z			;DUMMY ENTRY
	Z
	XWD	0,1
	XWD	0,^D12
 IFE TOPS20,<
	XWD	0,^D8		;MCS-10 EXTENSION
 >
 IFN TOPS20,<
	XWD	0,^D12		;TCS-20 EXTENSION
 >


>;END IFN MCS
SUBTTL	RECORDING MODE CLAUSE.

;  ASCII
	INTER.	DA145.
DA145.:	HRRZI	TB,	%RM.7B
	JRST		DA150D

;  STANDARD-ASCII
	INTER.	DA146.
DA146.:	HRRZI	TB,	%RM.SA
	JRST		DA150D

;  SIXBIT
	INTER.	DA147.
DA147.:	HRRZI	TB,	%RM.6B
	JRST		DA150D

;  BINARY
	INTER.	DA148.
DA148.:	HRRZI	TB,	%RM.BN
	JRST		DA150D

;  F, V OR ERROR.
	INTER.	DA149.
DA149.:	HLRZ	TC,	NAMWRD##	;SEE WHAT WE GOT.
	CAIE	TC,	(SIXBIT /F/)	;WAS IT F OR
	CAIN	TC,	(SIXBIT /V/)	; V?
	SWOFFS	FREGWD;			;YES, DON'T REGET IT.
	EWARNJ		E.578		;NO, GO COMPLAIN.
	HRRZ	TA,	CURFIL##	;GET THE FILE TABLE ADDRESS.
	LDB	TB,	FI.RM2##	;DO WE ALREADY HAVE A RM?
	JUMPN	TB,	JCE16.		;IF WE DO, GO COMPLAIN.
	LDB	TB,	FI.VRS		;WAS 'VARYING' SPECIFIED?
	LDB	TD,	FI.VLR		;WAS 'REC CTN nn TO nn' SPECIFIED?
	SKIPN	TB			;
	SKIPE	TD			;
	SKIPA				;
	JRST	D149.A			;NEITHER WERE SPECIFIED
	CAIN	TC,	(SIXBIT /F/)	;
	EWARNW	E.584			;YES, ERROR IF RECORDING MODE F
D149.A:	SETO	TB,			;GET SOME ONES.
	CAIN	TC,	(SIXBIT /V/)	;VARIABLE LENGTH?
	DPB	TB,	FI.VLR##	;YES, TURN ON THE VLR FLAG.
	HRRZI	TB,	%RM.EB		;MAKE IT EBCDIC.

;SET THE RECORDING MODE.

DA150D:	HRRZ	TA,	CURFIL##	;GET THE FILE TABLE'S ADDRESS.
	LDB	TC,	FI.RM2##	;IF WE ALREADY HAVE A RM
	JUMPN	TC,	DA150C		; MAKE SURE ITS THE SAME OR ELSECOMPLAIN.
	DPB	TB,	FI.ERM##	;SET IT.
	SETO	TB,			;NOTE THAT WE HAVE ONE.
	DPB	TB,	FI.RM2##
	POPJ	PP,			;RETURN.

DA150C:	LDB	TC,FI.ERM		;GET CURRENT RECORDING MODE
	CAME	TC,TB			;SAME AS WHAT WE WANT?
JCE16.:	EWARNJ	E.16			;NO, DUPLICATE CLAUSE
	POPJ	PP,			;YES, ALLOW IT

;SET THE BYTE MODE.

	INTER.	DA150B
DA150B:	HRRZ	TA,CURFIL##		;GET THE FILE TABLE'S ADDRESS.
	SETO	TB,
	DPB	TB,FI.BM##		;SET BYTE MODE
	POPJ	PP,			;RETURN.
SUBTTL	COBOL-74 SYNTAX

;SET LINAGE SEEN IN FILE TABLE

	INTER.	DA200.
DA200.:	FLAGAT	HI
	HRRZ	TA,CURFIL
	SETO	TB,
	DPB	TB,FI.LCP##	;SET LINAGE COUNTER REQUIRED
	POPJ	PP,

DA200V:	TLNN	W1,GWNLIT	;IS ITEM NUMERIC LITERAL?
	JRST	DA200Z		;NO
	TLNE	W1,GWDP		;IS IT INTEGER?
	JRST	DA200Z		;NO
	LDB	TB,GWVAL	;NO. OF CHARACTERS
	MOVEM	TB,CTR##
	HRRZI	TA,LITVAL##
	PJRST	GETVAL

DA200Z:	EWARNW	E.25
	SETZ	TC,
	POPJ	PP,

;STORE LINES PER PAGE

	INTER.	DA201.
DA201.:	PUSHJ	PP,TRYNAM
	  PUSHJ	PP,BLDNAM
	HLRZ	TC,TA		;GET POINTER
	TRO	TC,(1B0)	;SIGNAL NAME NOT VALUE
	JRST	DA202A

	INTER.	DA202.
DA202.:	PUSHJ	PP,DA200V	;GET VALUE
DA202A:	HRRZ	TA,CURFIL
	DPB	TC,FI.LPP##	;STORE NO. OF LINES PER PAGE
	POPJ	PP,

;STORE FOOTING AT

	INTER.	DA203.
DA203.:	PUSHJ	PP,TRYNAM
	  PUSHJ	PP,BLDNAM
	HLRZ	TC,TA		;GET POINTER
	TRO	TC,(1B0)	;SIGNAL NAME NOT VALUE
	JRST	DA204A

	INTER.	DA204.
DA204.:	PUSHJ	PP,DA200V	;GET VALUE
DA204A:	HRRZ	TA,CURFIL
	DPB	TC,FI.WFA##	;STORE WITH FOOTING AT LINE NUMBER
	POPJ	PP,
;STORE LINES AT TOP

	INTER.	DA205.
DA205.:	PUSHJ	PP,TRYNAM
	  PUSHJ	PP,BLDNAM
	HLRZ	TC,TA		;GET POINTER
	TRO	TC,(1B0)	;SIGNAL NAME NOT VALUE
	JRST	DA206A

	INTER.	DA206.
DA206.:	PUSHJ	PP,DA200V	;GET VALUE
DA206A:	HRRZ	TA,CURFIL
	DPB	TC,FI.LAT##	;STORE NO. OF LINES AT TOP
	POPJ	PP,

;STORE LINES AT BOTTOM

	INTER.	DA207.
DA207.:	PUSHJ	PP,TRYNAM
	  PUSHJ	PP,BLDNAM
	HLRZ	TC,TA		;GET POINTER
	TRO	TC,(1B0)	;SIGNAL NAME NOT VALUE
	JRST	DA208A

	INTER.	DA208.
DA208.:	PUSHJ	PP,DA200V	;GET VALUE
DA208A:	HRRZ	TA,CURFIL
	DPB	TC,FI.LAB##	;STORE NO. OF LINES AT BOTTOM
	POPJ	PP,
;DEBUG-ITEM

DA210.:	MOVE	TB,[SIXBIT /DEBUG:/]
	MOVEM	TB,NAMWRD
	MOVE	TB,[SIXBIT /ITEM/]
	MOVEM	TB,NAMWRD+1
	SETZM	NAMWRD+2
	MOVE	TA,[NAMWRD+2,,NAMWRD+3]
	BLT	TA,NAMWRD+5	;CLEAR REST OF NAMWRD
	PUSHJ	PP,TRYNAM	;SEE IF NAME ALREADY EXISTS
	  TRNA			;NO
	EWARNJ	E.731		;YES, ERROR
	PUSH	PP,EAS1PC	;SAVE CURRENT LOCATION FOR DEBUG-CONTENTS-INDEX
	AOS	EAS1PC		;ALLOW 1 WORD FOR IT
	PUSHJ	PP,DA211.	;PUT ENTRY IN DATAB
	HLRZM	TA,DEBSW	;SAVE LINK TO DEBUG-ITEM
	PUSH	PP,DEBSW	;SAVE TABLE LINK
	MOVE	TB,[44,,^D90]
	PUSHJ	PP,DA215.	;SET SIZE, BYTE RESIDUE AND BASE ADDRESS
	LDB	TB,DA.BRO
	DPB	TB,DA.SON	;MAKE THE BROTHER BE THE SON
	SETZ	TB,
	DPB	TB,DA.BRO
	DPB	TB,DA.SLL	;SET SINC AT LOWER LEVEL FOR DEBUG-CONTENTS
	MOVEI	TB,%CL.AN	;ALPHANUMERIC
	DPB	TB,DA.CLA

	MOVE	TB,[SIXBIT /LINE/]
	PUSHJ	PP,DA212.	;PUT DEBUG-LINE IN SYMBOL TABLE
	MOVE	TB,[44,,6]
	PUSHJ	PP,DA215.	;SET SIZE, BYTE RESIDUE AND BASE ADDRESS
	PUSHJ	PP,DA214.	;SET ALPHANUMERIC CLASS AND PIC SEEN.
	AOS	EAS1PC

	MOVE	TB,[SIXBIT /NAME/]
	PUSHJ	PP,DA212.	;PUT DEBUG-NAME IN SYMBOL TABLE
	PUSHJ	PP,DA214.	;SET ALPHANUMERIC CLASS AND PIC SEEN.
	MOVE	TB,[36,,^D30]
	PUSHJ	PP,DA215.	;SET SIZE, BYTE RESIDUE AND BASE ADDRESS
	MOVEI	TB,5
	ADDM	TB,EAS1PC

	MOVE	TB,[SIXBIT /SUB:1/]
	PUSHJ	PP,DA212.	;PUT DEBUG-SUB-1 IN SYMBOL TABLE
	PUSHJ	PP,DA213.	;SET SIZE AND VARIOUS FLAGS
	AOS	EAS1PC

	MOVE	TB,[SIXBIT /SUB:2/]
	PUSHJ	PP,DA212.	;PUT DEBUG-SUB-2 IN SYMBOL TABLE
	PUSHJ	PP,DA213.	;SET SIZE AND VARIOUS FLAGS
	AOS	EAS1PC

	MOVE	TB,[SIXBIT /SUB:3/]
	PUSHJ	PP,DA212.	;PUT DEBUG-SUB-3 IN SYMBOL TABLE
	PUSHJ	PP,DA213.	;SET SIZE AND VARIOUS FLAGS
	AOS	EAS1PC

	AOS	EAS1PC		;SYNCHRONIZE LEFT (I.E. WASTE 5 BYTES)
	MOVSI	TB,'TS '
	MOVEM	TB,NAMWRD+2
	MOVE	TB,[SIXBIT /CONTEN/]
	PUSHJ	PP,DA212.	;PUT DEBUG-CONTENTS IN SYMBOL TABLE
	MOVE	TB,[44,,^D30]
	PUSHJ	PP,DA215.	;SET SIZE, BYTE RESIDUE AND BASE ADDRESS
	PUSHJ	PP,DA214.	;SET ALPHANUMERIC CLASS AND PIC SEEN.
	PUSHJ	PP,DA216A	;SET VARIOUS BITS

;NOW DEFINE THE VARIOUS REDEFINITIONS OF DEBUG-CONTENTS

	MOVE	TB,[SIXBIT /TS:DIS/]
	MOVEM	TB,NAMWRD+2
	MOVE	TB,[SIXBIT /PLAY:6/]
	MOVEM	TB,NAMWRD+3
	PUSHJ	PP,DA211.
	MOVE	TB,[44,,^D30]
	PUSHJ	PP,DA215.
	PUSHJ	PP,DA214.
	PUSHJ	PP,DA216A	;SET VARIOUS BITS

	AOS	NAMWRD+3	;DEBUG-CONTENTS-DISPLAY-7
	PUSHJ	PP,DA211.
	MOVE	TB,[44,,^D25]
	PUSHJ	PP,DA215.
	PUSHJ	PP,DA214.
	MOVEI	TB,%US.D7
	PUSHJ	PP,DA216.	;SET VARIOUS BITS

	MOVEI	TB,2		;DEBUG-CONTENTS-DISPLAY-9
	ADDM	TB,NAMWRD+3
	PUSHJ	PP,DA211.
	MOVE	TB,[44,,^D20]
	PUSHJ	PP,DA215.
	PUSHJ	PP,DA214.
	MOVEI	TB,%US.EB
	PUSHJ	PP,DA216.	;SET VARIOUS BITS

	MOVE	TB,[SIXBIT /TS:1:W/]
	MOVEM	TB,NAMWRD+2
	MOVE	TB,[SIXBIT /ORD:CO/]
	MOVEM	TB,NAMWRD+3
	MOVSI	TB,'MP '
	MOVEM	TB,NAMWRD+4
	PUSHJ	PP,DA211.	;DEBUG-CONTENTS-1-WORD-COMP
	MOVE	TB,[44,,^D10]
	PUSHJ	PP,DA215.
	PUSHJ	PP,DA214.
	MOVEI	TB,%US.1C
	PUSHJ	PP,DA217.	;SET VARIOUS BITS

	MOVEI	TB,'2:W'
	HRRM	TB,NAMWRD+2	;DEBUG-CONTENTS-2-WORD-COMP
	PUSHJ	PP,DA211.
	MOVE	TB,[44,,^D18]
	PUSHJ	PP,DA215.
	PUSHJ	PP,DA214.
	MOVEI	TB,%US.2C
	PUSHJ	PP,DA217.	;SET VARIOUS BITS

	MOVEI	TB,'COM'
	HRRM	TB,NAMWRD+2
	MOVSI	TB,'P:1'
	MOVEM	TB,NAMWRD+3	;DEBUG-CONTENTS-COMP-1
	PUSHJ	PP,DA211.
	MOVE	TB,[44,,^D10]
	PUSHJ	PP,DA215.
	PUSHJ	PP,DA214.
	MOVEI	TB,%US.C1
	PUSHJ	PP,DA217.	;SET VARIOUS BITS

	AOS	NAMWRD+3	;DEBUG-CONTENTS-COMP-2
	PUSHJ	PP,DA211.
	MOVE	TB,[44,,^D18]
	PUSHJ	PP,DA215.
	PUSHJ	PP,DA214.
	MOVEI	TB,%US.C2
	PUSHJ	PP,DA217.	;SET VARIOUS BITS

	AOS	NAMWRD+3	;DEBUG-CONTENTS-COMP-3
	PUSHJ	PP,DA211.
	MOVE	TB,[44,,^D18]
	PUSHJ	PP,DA215.
	PUSHJ	PP,DA214.
	MOVEI	TB,%US.C3
	PUSHJ	PP,DA217.	;SET VARIOUS BITS

;NOW GENERATE DEBUG-CONTENTS-INDEX
;NOTE THIS IS NOT PART OF DEBUG-ITEM
;AND IS AT DEBUG-ITEM MINUS 1
;FIRST ACCOUNT FOR LARGEST FILE DATA RECORD WE HAVE SEEN

	MOVE	TB,MAXDBC	;GET MAX RECORD
	SUBI	TB,^D30/6	;SIZE WE WOULD LIKE TO USE
	SKIPLE	TB		;IGNORE IF WE HAVE ENOUGH
	ADDM	TB,EAS1PC	;OTHERWISE USE EXTRA
	MOVEI	TB,^D10		;ACCOUNT FOR INITIAL SIZE OF DEBUG-CONTENTS
	ADDB	TB,EAS1PC
	EXCH	TB,-1(PP)	;SWAP WITH ORIGINAL EAS1PC
	MOVEM	TB,EAS1PC	;FROM BEFORE DEBUG-ITEM
	MOVE	TB,[SIXBIT /TS:IND/]
	MOVEM	TB,NAMWRD+2
	MOVSI	TB,'EX '
	MOVEM	TB,NAMWRD+3	;DEBUG-CONTENTS-INDEX
	SETZM	NAMWRD+4
	PUSHJ	PP,DA211.
	MOVE	TB,[44,,5]
	PUSHJ	PP,DA215.
	PUSHJ	PP,DA214.
	POP	PP,TB		;GET FATHER LINK
	DPB	TB,DA.POP
	SETO	TB,
	DPB	TB,DA.FAL
	DPB	TB,DA.SYR	;SET SYNCHRONIZED RIGHT
	MOVEI	TB,%US.IN
	DPB	TB,DA.USG	;RESET USAGE
	POP	PP,EAS1PC	;RESTORE LOCATION COUNTER
	POPJ	PP,

DA212.:	MOVEM	TB,NAMWRD+1	;FINISH OFF NAME
DA211.:	MOVEI	TB,LVL.01	;PRETEND ITS LEVEL 01
	MOVEM	TB,(SAVPTR)
	SETZB	W1,W2		;CLEAR THE FLAGS
	MOVEI	TYPE,USERN.	;ITEM IS A USER-NAME
	PUSHJ	PP,DA26N.
	PUSHJ	PP,DA27.	;CREATE DATAB ENTRY
	MOVE	TA,CURDAT	;POINT TO DATAB
	HLRZ	TB,TA		;GET TABLE ENTRY
	ADDI	TB,7		;ADVANCE TO NEXT ITEM
	DPB	TB,DA.BRO	;SINCE IT WILL BE BROTHER EVENTUALLY
	POPJ	PP,

DA213.:	MOVE	TB,[30,,5]	;BYTE OFFSET ,, SIZE
	PUSHJ	PP,DA215.	;SET SIZE, BYTE RESIDUE AND BASE ADDRESS
	MOVEI	TB,%CL.NU	;NUMERIC
	DPB	TB,DA.CLA
	SETO	TB,
	DPB	TB,DA.SGN	;SIGNED
	DPB	TB,DA.SSC	;SEPARATE SIGN CHAR.
	DPB	TB,DA.LSC	;LEADING SIGN CHAR.
	JRST	DA214A

DA214.:	MOVEI	TB,%CL.AN	;ALPHANUMERIC
	DPB	TB,DA.CLA
DA214A:	SETO	TB,
	DPB	TB,DA.PIC	;INDICATE PICTURE SEEN
	MOVEI	TB,02
	DPB	TB,DA.LVL	;RESET THE LEVEL TO 02
	POPJ	PP,

DA215.:	DPB	TB,DA.EXS	;EXTERNAL
	DPB	TB,DA.INS	;INTERNAL
	HLRZ	TB,TB
	DPB	TB,DA.RES	;BYTE RESIDUE
	MOVE	TB,EAS1PC	;GET BASE
	DPB	TB,DA.LOC	;STORE IT
	MOVEI	TB,%US.D6	;DISPLAY-6
	DPB	TB,DA.USG
	POPJ	PP,

DA216.:	DPB	TB,DA.USG	;RESET USAGE
DA216A:	MOVE	TB,-1(PP)	;GET FATHER LINK
	DPB	TB,DA.POP
	SETO	TB,
	DPB	TB,DA.FAL
	DPB	TB,DA.SYL	;SET SYNCH LEFT
	POPJ	PP,

DA217.:	DPB	TB,DA.USG	;RESET USAGE
	MOVEI	TB,%CL.NU
	DPB	TB,DA.CLA	;SET NUMERIC
	MOVE	TB,-1(PP)	;GET FATHER LINK
	DPB	TB,DA.POP
	SETO	TB,
	DPB	TB,DA.FAL
	DPB	TB,DA.SYR	;SET SYNCH RIGHT
	DPB	TB,DA.SGN	;SET SIGNED
	POPJ	PP,
SUBTTL	ROUTINES TO PARSE A DATANAME ALLOWING QUALIFIERS, SUBSCRIPTS

; These are essentially the same as some of the Phase D routines

;This is the PA2. routine
	INTER.	DA220.		;DATANAME OR INTEGER PARSED
DA220.:	TLNE	W1,GNLIT	;IS ITEM AN INTEGER?
	 JRST	D220L		;YES
;Item must be in NAMTAB.

D220S:	TLZ	W1,4000		;'ROUNDED BIT'
	DMOVEM	W1,ARG1##	;SAVE ITEM
	POPJ	PP,

D220L:	LDB	TB,GWVAL	;NO. OF CHARACTERS
	PUSHJ	PP,DA24S.	;SET UP COUNT AND POINTERS FOR LITER TO VALTAB MOVE
	MOVEM	TB,TBLOCK+1	;STORE POINTER TO LITERAL (WHY?)
D220LQ:	SOJL	TD,D220S	;JUMP TO STORE ITEM IN ARG1 WHEN ALL CHARS MOVED
	ILDB	TE,TB		;GET CHARACTER
	IDPB	TE,TC		;SAVE
	JRST	D220LQ

;This is the PA171. routine
	INTER.	DA221.
DA221.:	HRRZ	TC,NQUAL##
	LSH	TC,1
	CAIL	TC,144		;SIZE OF TABLE
	EWARNJ	E.190		;?TOO MANY QUALIFIERS
	MOVE	TA,ARG1
	MOVEM	TA,QUALT(TC)
	MOVE	TA,ARG1+1
	MOVEM	TA,QUALT+1(TC)
	SETZM	ARG1
	SETZM	ARG1+1
	AOS	NQUAL
	POPJ	PP,

;This is the PA170. routine
	INTER.	DA222.
DA222.:	SETZM	GOTQUA##
	SKIPN	TA,NQUAL
	 JRST	D222.1
	CAIE	TA,1
	 JRST	D222.5
	MOVE	TA,QUALT##
	TLNN	TA,GWFIGC
	 JRST	D222.5
	LDB	TB,[POINT 9,TA,17]
D222.5:	LDB	TA,[POINT 15,QUALT+1,15] ;ITEM'S NAMTAB POINTER
	HRRZI	TB,CD.DAT
	PUSHJ	PP,FNDLNK
	 JRST	D222.0		;MAY BE CONDITION-NAME
D222A:	HLRM	TB,QUALT
	PUSHJ	PP,DOQUAL
	 JRST	D222B
	SKIPN	GOTQUA		;ANY OTHER DATA NAME WITH SAME QUALIFICATION ?
	JRST	D222D		;NO
	PUSH	PP,TA
	PUSHJ	PP,LNKSET	;GET REAL ADDRESS OF DATAB ENTRY
	LDB	TC,DA.LPC
	POP	PP,TA
	SKIPE	TC		;QUALIFICATION A LINE COUNTER OR PAGE COUNTER ?
	SKIPN	REPSEC		;AND IN REPORT SECTION ?
	 JRST	D222.2		;NO, INSUFFICIENT QUALIFICATION
	PUSHJ	PP,LNKSET
	LDB	TA,DA.NAM	;GET NAMTAB ENTRY
	ADD	TA,NAMLOC	;CREATE REAL ADDRESS
	LDB	TA,[POINT 18,0(TA),35]	;GET DATAB LINK
	HRRZM	TA,GOTQUA
	HRLZM	TA,CURDAT
	PUSHJ	PP,LNKSET
	HRRM	TA,CURDAT
	HRRZI	TA,1
	HRRZM	TA,CURQUA	;CURRENT ENTRY
	HRRZM	TA,QUALT
	HLRZ	TA,CURDAT
	JRST	D222O
D222D:	HRRZM	TA,GOTQUA	;TA CONTAINS QUALT ON RETURN
D222B:	PUSHJ	PP,LNKSET
	PUSHJ	PP,FNDNXT##	;FIND THE NEXT ITEM WITH THE SAME
				; NAME IN THE CURRENT TABLE.
	SKIPA	TB,SAVE1##	;NO MORE IN THIS TABLE.
	 JRST	D222A		;GO SEE IF THIS NAME WORKS.
	CAIE	TB,CD.CON	;IF IT WAS CONTAB, WE'RE THROUGH.
	JRST	D222.0		;GO LOOK AT CONTAB.
D222C:	SKIPN	TA,GOTQUA	;ANY FOUND?
	 JRST	D222.1		;NO
D222O:	HLL	TA,QUALT
	MOVEM	TA,ARG1
	MOVE	TA,QUALT+1
	MOVEM	TA,ARG1+1
	SETZM	NQUAL
	POPJ	PP,
D222.0:	LDB	TA,[POINT 15,QUALT+1,15] ;ITEM'S NAMTAB PTR.
	HRRZI	TB,CD.CON
	PUSHJ	PP,FNDLNK
	  JRST	D222C		;NO CONTAB LINK
	JRST	D222A

D222.1:	HRRZI	DW,E.104	;NOT DEFINED
	JRST	D222E

D222.2:	HRRZI	DW,E.60	
D222E:	LDB	LN,[POINT 13,QUALT+1,28]
	LDB	CP,[POINT 7,QUALT+1,35]
IFN DEBUG,<
	PUSHJ	PP,WARN
>
IFE DEBUG,<
	PUSHJ	PP,FATAL
>
	MOVEI	TA,<CD.DAT>B20+1	;ASSUME DUMMY DATAB ENTRY
	MOVEM	TA,QUALT
	JRST	D222O
;THE following code copied (temporarily) from COBOLD.MAC:
DOQUAL:	HRRZI	TA,1
	HRRZM	TA,CURQUA##	;CURRENT ENTRY NUMBER-1
	HRRZ	TA,QUALT
	JUMPE	TA,NOPOP
	HRLZM	TA,CURDAT##
	PUSHJ	PP,LNKSET
	HRRM	TA,CURDAT
	HRRZ	TC,CURQUA
DQULUP:	CAML	TC,NQUAL
	JRST	DOOUT
NXTPOP:	PUSHJ	PP,GETPOP	;FIND FATHER OF CURDAT ITEM
	  JRST	NOPOP		;FOUND NONE
	MOVEM	TA,CURDAT	;SAVE FATHER LINK
	LDB	TB,DA.NAM##	;FATHER'S NAMTAB LINK
	HRRZ	TC,CURQUA
	LSH	TC,1
	LDB	TD,[POINT	15,QUALT+1(TC),15]	;NAMTAB LINK OF ITEM SOUGHT
	CAME	TB,TD		;ARE THEY THE SAME?
	JRST	NXTPOP		;NO --- TRY HIGHER
	HLRM	TA,QUALT(TC)	;PUT LINK IN QUALT ENTRY
	AOS	TC,CURQUA
	JRST	DQULUP		;CHECK FOR MORE QUALIFIERS

DOOUT:	MOVE	TA,QUALT
	POP	PP,TE
	JRST	1(TE)

NOPOP:	MOVE	TA,QUALT
	POPJ	PP,		;FAILURE EXIT
GETPOP:	SKIPN	TA,CURDAT
	POPJ	PP,
	LDB	TB,[POINT	3,CURDAT,2]
	CAIN	TB,CD.DAT
	JRST	NXTTRY		;DATAB ITEM
	CAIE	TB,CD.CON
	POPJ	PP,
	LDB	TA,CO.DAT##	;CONTAB ITEM FATHER LINK
	JUMPN	TA,GOTFA	;NOT NULL
	POPJ	PP,

NXTTRY:	LDB	TB,DA.FAL##	;FATHER/BROTHER FLAG
	JUMPN	TB,ISFAL	;FATHER
	LDB	TA,DA.BRO##	;GET BROTHER LINK
	JUMPE	TA,CPOPJ	;NULL
	PUSHJ	PP,LNKSET
	  JRST	NXTTRY
ISFAL:	LDB	TA,DA.POP##	;GET FATHER LINK
	JUMPE	TA,CPOPJ	;NULL
GOTFA:	HRRZM	TA,TBLOCK
	LDB	TB,LNKCOD##	;COULD BE AN RPW LINK
	JUMPE	TB,GOTRPW	;MAYBE
GOTFA1:	PUSHJ	PP,LNKSET
GOTFA2:	HRL	TA,TBLOCK
	POP	PP,TE
	JRST	1(TE)

GOTRPW:	HRRZI	TC,(TA)
	HRRZ	TA,CURDAT	;SEE IF LINE- OR PAGE-COUNTER BIT ON
	LDB	TB,DA.LPC##
	JUMPE	TB,GOTRP1	;NO, MUST BE A FILTAB LINK
	HRRZ	TA,RPWLOC	;YES, GET RPWTAB ADDRESS
	ADDI	TA,(TC)
	JRST	GOTFA2

GOTRP1:	HRRZI	TA,(TC)		;RESTORE TA
	JRST	GOTFA1

;** END OF CODE COPIED FROM COBOLD **
; This is the PA205. routine
	INTER.	DA223.		;LEFT PAREN TO START SUBSCRIPTS
DA223.:	SETZM	NSBSC1##
	MOVE	TA,[XWD NSBSC1,SBSCR1##]
	BLT	TA,SBSCR1+MAXSUB*4-1
	PUSHJ	PP,DA222.
	MOVE	TA,[XWD ARG1,ARG3##]
	BLT	TA,ARG3+1
	POPJ	PP,

;This is the PA263. routine
	INTER.	DA224.		; Improper subscript error
DA224.:	MOVEI	W1,<CD.DAT>B20+1	;USE DUMMY DATA ITEM FOR SUBSCRIPT
	TLZ	W2,777770
	DMOVEM	W1,ARG1		;NO NEED TO GIVE DIAGNOSTIC MESSAGE, PHASE E DOES IT ALREADY
	SWOFF	FREGWD		;GO ON TO NEXT SOURCE ITEM
	HRRZI	TA,(W1)		; SET UP DUMMY RELATIVE ADDRESS
	PUSHJ	PP,LNKSET	; GET DATAB ADR FOR DUMMY
	HRRM	TA,CURDAT	; STORE IT
	HRLM	W1,CURDAT	; PUT BACK DATAB RELATIVE ADDR
	POPJ	PP,


;This is the PA206. routine
	INTER.	DA225.		;Count another subscript
DA225.:	AOS	TA,NSBSC1
	CAILE	TA,MAXSUB
	JRST	[MOVEI	TA,MAXSUB	;RESTORE TO MAXIMUM
		MOVEM	TA,NSBSC1	;LIMIT
		EWARNJ	E.277]		;TOO MANY SUBSCRIPTS
	ASH	TA,2
	HRRZI	TA,SBSCR1-4(TA)
	HRRZI	TB,1(TA)
	HRLI	TA,ARG1
	BLT	TA,(TB)
	POPJ	PP,

;This is the PA206A routine
	INTER.	DA225A
DA225A:	SKIPN	REPSEC		;IN REPORT SECTION ?
	JRST	D225A		;NO
	HRRZ	TA,ARG1
	PUSHJ	PP,LNKSET	;GET ACTUAL ADDRESS OF SUBSCRIPT DATAB ENTRY
	LDB	TA,DA.LPC
	LDB	TB,DA.SCT##
	SKIPN	TB		;IS SUBSCRIPT A SUM CLAUSE ?
	SKIPE	TA		;OR IS SUBSCRIPT A LINE OR PAGE COUNTER ?
	EWARNW	E.785		;YES, GENERATE WARNING
D225A:	HRRZ	TA,ARG1		;GET SUBSCRIPT RELATIVE DATAB ADDRESS
	PUSHJ	PP,LNKSET	;GET REAL ADDRESS
	MOVEM	TA,CURDAT	;NOW STORE IT
	LDB	TB,DA.SUB##	;IS SUBSCRIPT SUBSCRIPTED?
	SKIPE	TB		;ERROR IF SO
	EWARNW	E.495		;ERROR MESSAGE
	JRST	DA225.		;OK GO ON
;This is the PA220. routine
	INTER.	DA226.
DA226.:	MOVE	TA,[XWD ARG3,ARG1]
	BLT	TA,ARG1+1
	POPJ	PP,

;This is the PA234. routine
	INTER.	DA227.		;PLUS follows subscript
DA227.:	MOVE	TA,NSBSC1	;MAKE INDEX TO SUBSCRIPT TABLE
	ASH	TA,2
	MOVSI	TB,400000	;CLR BIT 0 OF 1ST WORD IN ENTRY
	ANDCAM	TB,SBSCR1-4(TA)	; TO INDICATE PLUS
	POPJ	PP,

;This is the PA235. routine
	INTER.	DA228.		;MINUS follows subscript
DA228.:	MOVE	TA,NSBSC1
	ASH	TA,2
	MOVSI	TB,400000	;SET BIT 0 OF 1ST WORD OF ENTRY
	IORM	TB,SBSCR1-4(TA)	; TO INDICATE MINUS
	POPJ	PP,

;This is the PA236. routine
	INTER.	DA229.		;INTEGER TO BE ADDED TO SUBSCRIPT
DA229.:	PUSHJ	PP,DA220.	;PROCESS LITERAL
	MOVE	TA,NSBSC1	;MAKE INDEX TO SUBSCRIPT TABLE
	ASH	TA,2
	MOVE	TB,ARG1		;STORE WORDS FOR ADDITIVE
	MOVEM	TB,SBSCR1-2(TA)
	MOVE	TB,ARG1+1
	MOVEM	TB,SBSCR1-1(TA)
	POPJ	PP,
;PA21.-type routine, Call:  w1/ addr where item and subscripts
;				should be written
DA230.:	SETZM	TBLOCK+7	;FLAG SAYS THIS IS NOT A SUBSCRIPT
D230.0:	HRRZ	TB,ARG1		;R.H. OF GETSRC W1
	MOVE	TA,ARG1+1	;GETSRC W2
	MOVE	TE,TA		;W2
	MOVE	TD,ARG1		;W1
	AND	TA,[XWD 3,777777] ;LN,CP
	TLO	TA,400000	;SET OPERAND BIT
	TLNN	TD,GWLIT	;IS ITEM A LITERAL?
	 JRST	D230.A		;NO
	SETZM	NSBSC1
	TLO	TA,GNLIT	;YES--SET LITERAL BIT
	TLNE	TD,GWASCI	;IS ITEM 'PURE' ASCII?
	TLO	TA,020000	;YES -- SET BIT
	TLNE	TD,GWNLIT	;IS ITEM A NUMERIC LITERAL?
	TLO	TA,GNNUM	;YES--SET NUMERIC LITERAL BIT
	JUMPE	TB,D230.E
D230.B:	TLNE	TD,GWALL	;'ALL' ITEM?
	TLO	TA,GNALL	;YES--SET ALL BIT
	SETZM	ARG1
	SETZM	ARG1+1
	JRST	DA231.		;OUTPUT ARG1
D230.A:	TLNN	TD,GWFIGC	;IS ITEM A FIG. CONSTANT?
	JRST	D230.C		;NO
	SETZM	NSBSC1
	TLO	TA,GNLIT!GNFIGC ;YES---SET FIGURATIVE CONSTANT BIT
	HLRZ	TC,TD
	ANDI	TC,777		;YES--GET VALUE
	SETZ	TE,
	CAIN	TC,HIVAL.
	HRLZI	TE,GNFCHV	;HIGH-VALUE(S)
	CAIN	TC,LOVAL.
	HRLZI	TE,GNFCLV	;LOW-VALUE(S)
	CAIN	TC,QUOTE.
	HRLZI	TE,GNFCQ	;QUOTE(S)
	CAIN	TC,ZERO.
	HRLZI	TE,GNFCZ	;ZERO((E)S)
	CAIN	TC,SPACE.
	HRLZI	TE,GNFCS	;SPACE(S)
	IOR	TA,TE		;SET APPROPRIATE BITS
	JRST	D230.B
D230.C:	TLNN	TE,400000	;FLOTAB ENTRY?
	JRST	D230.D		;NO
	SETZM	NSBSC1
	TLO	TB,100000	;YES--SET BIT IN OPERAND WORD
	JRST	PUTFT

D230.D:	HRRZI	TC,(TD)		;TABLE LINK
	JUMPE	TC,D230.E	;NULL
	LSH	TC,-17		;TABLE TYPE CODE
	CAIN	TC,CD.CON	;CONTAB?
	 JRST	PUTFT		;YES, DON'T CLR NSBSC1
	CAIN	TC,CD.DAT	;DATAB?
	 JRST	.+3
	SETZM	NSBSC1
	JRST	PUTFT		;NO--OUTPUT AS IS

	MOVEM	TA,TBLOCK
	MOVEM	TB,TBLOCK+1
	MOVEM	TD,TBLOCK+2
	MOVEM	TE,TBLOCK+3
	HRRZ	TA,TB		;LINK
	PUSHJ	PP,LNKSET	;ABS. ADDR. OF DATAB ENTRY
	MOVE	TC,TA		;ENTRY ADDRESS
	MOVE	TA,TBLOCK
	MOVE	TB,TBLOCK+1
	MOVE	TD,4(TC)	;WORD 5 OF DATAB ENTRY
	TRNE	TD,100		;LINKAGE SECTION
	TLO	TA,(LKSFLG)	;YES
	TLNE	TD,100000	;SYNC LEFT?
	TLO	TA,10000	;YES
	TLNE	TD,40000	;SYNC RIGHT?
	TLO	TA,4000		;YES
	TLNE	TD,10		;JUST RIGHT?
	TLO	TA,1000		;YES
	TLO	TA,2000		;SET NUMERIC BIT
	TLNE	TD,400000	;NOT NUMERIC
	TLNE	TD,200000	;SKIP IF NUMERIC
	TLZ	TA,2000		;TURN OFF NUMERIC BIT
	TRNE	TD,400000	;DD ERROR?
	TLO	TB,400000	;YES
	EXCH	TA,TC		;PUT DATAB OFFSET IN TA & SAVE TC.
	LDB	TD,DA.USG##	;PICK UP THE ITEM'S USAGE.
	EXCH	TA,TC		;PUT THINGS BACK THE WAY THEY WERE.
	DPB	TD,[POINT 4,TA,13] ;PUT THE USAGE IN THE FIRST GENFIL WORD.
PUTFT:	SKIPN	TBLOCK+7	;DOING A SUBSCRIPT?
	JRST	PUTFT0		;NO
	MOVE	TD,TBLOCK+6	;GET INDEX TO SUBSCRIPT TABLE
	ASH	TD,2		;4 WORDS EACH
	SKIPN	SBSCR1+2(TD)	;DOES IT HAVE AN ADDITIVE?
	 JRST	PUTFT0		;NO
	MOVEI	TC,1		;ASSUME +
	SKIPGE	SBSCR1(TD)
	 MOVEI	TC,2		;NO, -
	DPB	TC,[POINT 2,TB,11] ;STORE ADDITIVE OPERATOR
PUTFT0:	SETZM	ARG1
	SETZM	ARG1+1
	HRRZI	TC,(TB)
	JUMPE	TC,D230.E
	SKIPN	TD,NSBSC1	;NUMBER OF SUBSCRIPTS
	 JRST	DA231.		;NONE, WRITE OUT INFO
	HRRZM	TD,TBLOCK+6
	MOVNI	TC,MAXSUB	;ALSO COUNT ADDITIONS TO SUBSCRIPTS
	MOVSI	TC,(TC)
PUTFT3:	SKIPE	SBSCR1+2(TC)	;THIS SUBSCRIPT HAVE AN ADDITIVE?
	 AOJ	TD,		;YES
	ADDI	TC,3		;AIM AT NEXT SUBSCRIPT
	AOBJN	TC,PUTFT3
	DPB	TD,[POINT 6,TB,17]
	PUSHJ	PP,DA231.
PUTFT1:	SOSGE	TD,TBLOCK+6
	JRST	PUTFT2
	ASH	TD,2
	HRLZI	TC,SBSCR1(TD)
	HRRI	TC,ARG1
	BLT	TC,ARG1+1
	SETZM	NSBSC1
	AOS	TBLOCK+7	;TELL DA230. WE ARE DOING A SUBSCRIPT
	PUSHJ	PP,D230.0
	MOVE	TD,TBLOCK+6	;GET INDEX TO SUBSCRIPT TABLE
	ASH	TD,2
	SKIPN	TA,SBSCR1+2(TD)	;IS THERE AN ADDITIVE?
	JRST	PUTFT1		;NO
	MOVE	TB,SBSCR1+3(TD)	;YES, GET 2ND WORD OF ADDITIVE
	MOVEM	TA,ARG1
	MOVEM	TB,ARG1+1
	PUSHJ	PP,DA230.
	JRST	PUTFT1
PUTFT2:	MOVE	TA,[XWD NSBSC1,SBSCR1]
	MOVEI	TB,MAXSUB*4-1
	BLT	TA,SBSCR1(TB)
	POPJ	PP,

D230.E:	OUTSTR	[ASCIZ/?DA230.: null table link
/]
	EWARNJ	E.263

;This is the equivalent of PUTGEN for phase C.
;Input: TA/ FIRST WORD , TB/ 2ND WORD,  W1/ INDEX WHERE TO PUT IT

DA231.:	MOVEM	TA,(W1)		;STORE FIRST WORD
	MOVEM	TB,1(W1)	;STORE 2ND WORD
	ADDI	W1,2		;BUMP W1 FOR NEXT TIME
	POPJ	PP,		;RETURN
;Here when parsed ALTERNATE and expecting RECORD KEY IS

	INTER.	DA511.
DA511.:	FLAGAT	H
	MOVE	TA,CURFIL
	LDB	TB,FI.ORG	;GET FILE ORGANIZATION
	CAIE	TB,%ACC.I	;MAKE SURE THIS IS AN INDEXED FILE
	CAIN	TB,%%ACC	;OR NOT SPECIFIED YET
	 CAIA			;ALL OK
	EWARNJ	E.624		;"ALTERNATE KEY ONLY ALLOWED WITH INDEXED FILES"
	SETOB	TB,RMSFLS##	;MAKE SURE RMS BIT IS SET, AND SET "RMS FILES" FLAG
	DPB	TB,FI.RMS##
	DPB	TB,FI.AKS##	;SET "ALTERNATE KEYS SPECIFIED" FOR THIS FILE
	POPJ	PP,		;RETURN OK

;Saw FILE-STATUS

	INTER.	DA512.
DA512.:	PUSHJ	PP,DA25F.	;TEST FIPS FLAGGER
	HRRZ	TA,CURFIL	;GET FILTAB ABS ADR.
	LDB	TB,FI.PFS##	;GET FIRST STATUS WORD LINK.
	JUMPN	TB,DA512A	;IF WE ALREADY HAVE ONE - DUP CLAUSE.
	MOVE	TB,FI.SPT##	;GET BYTE POINTER TO ENTRIES.
	MOVEM	TB,SAVLST##	;SAVE IT.
	HRREI	TB,-11		;-MAXIMUM NUMBER OF NAMES ALLOWED.
	MOVEM	TB,SAVLST+1	;SAVE IT.
	POPJ	PP,		;GO LOOK FOR NAMES.

;DUPLICATE CLAUSE - SKIP TO NEXT NON USER-NAME

DA512A:	MOVEI	TB,1
	MOVEM	TB,SAVLST+1	;FORCE SKIPPING.
	JRST	JCE16.		;GO GIVE ERROR MSG.


;SAW THE NAME OF A FILE STATUS ITEM.

	INTER.	DA513.
DA513.:	AOSGE	TA,SAVLST+1	;DO WE HAVE AN ERROR CONDITION.
	JRST	DA513A		;NO.
	JUMPN	TA,CPOPJ	;FIRST TIME?
	EWARNJ	E.227		;YES, TOO MANY NAMES.

DA513A:	PUSHJ	PP,DA709S	;GET THE NAMTAB ADDRESS.
	PUSHJ	PP,DA706S	;SET UP THE HLDTAB ENTRY.
	MOVE	TA,CURHLD	;GET THE HLDTAB ADDRESS.
	MOVEI	TB,%HL.ER	;I AM A FILE-STATUS.
	DPB	TB,HL.COD	;PUT IT IN HLDTAB.
	MOVS	TB,CURFIL	;GET THE FILTAB ADDRESS.
	DPB	TB,HL.LNK	;FILTAB LINK TO HLDTAB.
	EXCH	TA,TB
	MOVSS	TA,TA
	MOVSS	TB,TB
	IDPB	TB,SAVLST	;HLDTAB LINK TO APPROPRIATE
				; FILTAB LOCATION.
	SKIPN	FLGSW##		;NEED TO FLAG EXTENSIONS?
	POPJ	PP,		;GO LOOK FOR MORE NAMES OR FOR
				; SOME QUALIFICATION.
	HRRZ	TB,SAVLST+1	;SEE IF SECOND TIME THROUGH
	CAIN	TB,-7		;SO WE GIVE ERROR ONLY ONCE
	FLAGAT	NS		;FLAG AS NON-STANDARD EXTENSION
	POPJ	PP,		;NO


;SAW SOME QUALIFICATION.

	INTER.	DA514.
DA514.:	SKIPLE	SAVLST+1	;DO WE HAVE AN ERROR CONDITION?
	POPJ	PP,		;YES, IGNORE QUALS.
	JRST	DA709.		;GO SAVE THE QUALS.
;REPORT WRITER SYNTAX FOR COBOL-74

; Check for
;  In CONTROL FOOTING, PAGE HEADING, PAGE FOOTING, and REPORT FOOTING
;   report groups, SOURCE clauses and USE statements may not reference:
;
;	a) Grop data-item containing control data-item
;	b) Data-items subordinate to control data-item.
;	c) A redefinition or renaming of any part of a control data-item.
;
;  In a PAGE HEADING and PAGE FOOTING report groups, SOURCE clauses and
;   USE statements must not reference control data-names.
;

DA515.:	HRRZS	TB,W1		; GET SOURCE ITEMS FATHER
DA516.:	MOVE	CT,TB		; SAVE LAST DATAB LINK
	PUSHJ	PP,FNDPOP	; GET FATHER
	  JRST	.+3		; NO FATHER, EXIT
	TRNN	TB,700000	; POINTING AT A DATAB (NOT RPW ENTRY)?
	JRST	DA516.		; YES, GET FATHER
	HRRZ	TA,RCOLOC	; GET RCOTAB STARTING ADDRESS
	HRRZ	TE,RCONXT##
	CAML	TA,TE		; ANY CONTROL IDENTIFIERS ?
	POPJ	PP,		; NO, EXIT
	ADDI	TA,1		; GET FIRST IDENTIFIER
DA517.:	LDB	TB,RC.FAL	; GET FATHER
	CAMN	TB,CT		; SAME FATHER AS SOURCE ITEM ?
	JRST	DA519.		; YES
DA518.:	ADDI	TA,SZ.RCO	; GET NEXT IDENTIFIER, AND TEST IT
	HRRZ	TE,RCONXT
	CAML	TA,TE		; ANY MORE ENTRIES ?
	POPJ	PP,		; NO, RETURN
	JRST	DA517.

;FATHER OF SOURCE CLAUSE MATCHES A FATHER OF AN RCOTAB ENTRY, CHECK
;TO SEE IF IN COMMON BRANCH.
DA519.:	MOVE	TC,TA		; SAVE CONTROL IDENTIFIER LINK
	HLRZ	TA,CURDAT	; GET DATAB LINK TO ITEM CONTAINING SOURCE
	JUMPE	TA,CPOPJ	; SHOULD NEVER HAPPEN
	PUSHJ	PP,LNKSET
	LDB	TA,DA.RPW	; GET RPWTAB ENTRY FOR ITEM
	ADD	TA,RPWLOC	; MAKE REAL ADDRESS
	LDB	TB,RW.TYP	; GET ITEM'S TYPE
	CAIE	TB,%RG.PH
	CAIN	TB,%RG.PF
	JRST	DA520.		; IF PH, OR PF CHECK SOURCE ITEM
	CAIE	TB,%RG.CF
	CAIN	TB,%RG.RF
	JRST	DA521.		; IF CF, OR RF, CHECK SOURCE ITEM
	POPJ	PP,		; IF NOT PH, PF, CF, OR RF DON'T CONTINUE
;CHECK TO SEE IF SOURCE ITEM IS A CONTROL IDENTIFIER
DA520.:	MOVE	TA,TC		; RESTORE 
	LDB	TA,RC.DCI	; GET CONTROL IDENTIFIER DATAB LINK
	CAMN	TA,W1		; IS CONTROL IDENTIFIER THE SAME AS SOURCE
	EWARNJ	E.788		; RETURN IF ERROR FOUND
	
DA521.:	MOVE	TA,W1		; GET DATAB POINTER TO SOURCE ITEM
	PUSHJ	PP,LNKSET	; MAKE ABSOLUTE ADDRESS
	LDB	TB,DA.LVL	; GET LEVEL OF SOURCE ITEM
	PUSH	PP,TA		; SAVE TA FOR LATER USE
	MOVE	TA,TC		; GET ABSOLUTE ADDRESS OF CONTROL IDENTIFIER
	LDB	TA,RC.DCI	; GET DATAB LINK
	PUSHJ	PP,LNKSET	; MAKE ABSOLUTE ADDRESS
	PUSH	PP,TA		; SAVE ADDRESS OF CONTROL IDENTIFIER
	LDB	TD,DA.LVL	; GET LEVEL OF CONTROL IDENTIFIER
	CAMGE	TB,TD		; LEVEL OF SOURCE GREATER THAN THAT OF CONTROL?
	JRST	DA522.		; YES, CHECK TO SEE IF SOURCE IS THE FATHER
	CAMLE	TB,TD		; LEVEL OF SOURCE LESS THAN THAT OF CONTROL?
	JRST	DA523.		; YES, CHECK TO SEE IF SOURCE IS A SON
	POP	PP,TA		; DUMP SAVED ITEMS
	POP	PP,TA
	MOVE	TA,TC		; RESTORE POINTER INTO RCOTAB AND
	JRST	DA518.		; GO TRY NEXT IDENTIFIER

DA522.:	POP	PP,TB		; RESTORE CONTROL IDENTIFIER
	POP	PP,CT		; RESTORE SOURCE DATAB LINK
	MOVE	TA,CT
	LDB	W2,DA.LVL	; GET LEVEL OF SOURCE ITEM
	SUB	CT,DATLOC	; MAKE SOURCE DATAB LINK RELATIVE
	IORI	CT,AS.DAT
	SUB	TB,DATLOC	; MAKE CONTROL DATAB LINK RELATIVE
	IORI	TB,AS.DAT
DA522A:	PUSHJ	PP,FNDPOP	; GET FATHER
	  JRST	DA524.		; NO FATHER, TRY TEST FOR NEXT CONTROL ID
	CAMN	CT,TB		; IS CONTROL IDENTIFER A SON ?
	EWARNJ	E.789		; YES GIVE WARNING AND RETURN
	MOVE	TA,TB
	PUSHJ	PP,LNKSET	; GET ABSOLUTE ADDRESS
	LDB	TA,DA.LVL	; GET LEVEL
	CAIGE	W2,TA		; ARE THEY AT THE SAME LEVEL?
	JRST	DA522A		; NO	
	JRST	DA524.		; YES, GET NEXT ENTRY

DA523.:	POP	PP,CT		; RESTORE CONTROL IDENTIFIER
	POP	PP,TB		; RESTORE SOURCE DATAB LINK
	MOVE	TA,CT
	LDB	W2,DA.LVL	; GET LEVEL OF CONTROL IDENTIFIER
	SUB	CT,DATLOC	; MAKE DATAB CONTROL ID, RELATIVE
	IORI	CT,AS.DAT
	SUB	TB,DATLOC	; MAKE SOURCE DATAB ENTRY RELATIVE
	IORI	TB,AS.DAT
DA523A:	PUSHJ	PP,FNDPOP	; GET FATHER OF SOURCE IDENTIFIER
	  JRST	DA524.		; NO FATHER, TRY TEST FOR NEXT CONTROL ID
	CAMN	CT,TB		; IS THE CONTROL IDENTIFIER THE FATHER ?
	EWARNJ	E.790		; YES, GENERATE WARNING
	MOVE	TA,TB
	PUSHJ	PP,LNKSET	; GET ABSOLUTE ADDRESS
	LDB	TA,DA.LVL	; GET LEVEL OF SOURCE
	CAIGE	W2,TA		; ARE THEY AT THE SAME LEVEL
	JRST	DA523A		; NO
DA524.:	MOVE	TA,TC		; RESTORE POINTER INTO RCOTAB AND
	JRST	DA518.		; GO TRY NEXT IDENTIFIER
SUBTTL ANS-82 SYNTAX

;CHECK FOR MORE THAN 1 ACCESS MODE SETTING PER FILE

	INTER.	DA700.
DA700.:	HRRZ	TA,CURFIL	;AIM AT CURRENT FILTAB ENTRY
	LDB	TB,FI.FAM	;GET CURRENT SETTING OF ACCESS MODE BITS
	JUMPN	TB,JCE16.	;'DUPLICATE CLAUSE'
	POPJ	PP,		;AT INITIAL SETTING

;SET SEQUENTIAL ACCESS MODE

	INTER.	DA701.
DA701.:	MOVEI	TB,%FAM.S
	SKIPN	FLGSW##		;NEED FIPS FLAGGER?
	JRST	DA700X		;NO
	PUSHJ	PP,DA700X	;SETS UP TA = CURFIL
	LDB	TB,FI.ORG##	;GET FILE ORGANIZATION
	JRST	@[CPOPJ			;SEQUENTIAL
		TST.LI			;RELATIVE
		TST.H			;INDEXED
		CPOPJ](TB)

;SET RANDOM ACCESSS MODE

	INTER.	DA702.
DA702.:	MOVEI	TB,%FAM.R
	SKIPN	FLGSW##		;NEED FIPS FLAGGER?
	JRST	DA700X		;NO
	PUSHJ	PP,DA700X	;SETS UP TA = CURFIL
	LDB	TB,FI.ORG##	;GET FILE ORGANIZATION
	JRST	@[CPOPJ			;SEQUENTIAL
		TST.LI			;RELATIVE
		TST.H			;INDEXED
		CPOPJ](TB)

;SET DYNAMIC ACCESS MODE

	INTER.	DA703.
DA703.:	MOVEI	TB,%FAM.D
	SKIPN	FLGSW##		;NEED FIPS FLAGGER?
	JRST	DA700X		;NO
	PUSHJ	PP,DA700X	;SETS UP TA = CURFIL
	LDB	TB,FI.ORG##	;GET FILE ORGANIZATION
	JRST	@[CPOPJ			;SEQUENTIAL
		TST.HI			;RELATIVE
		TST.H			;INDEXED
		CPOPJ](TB)

DA700X:	HRRZ	TA,CURFIL
	DPB	TB,FI.FAM##	;STORE IN FILTAB
	POPJ	PP,
;SAVE RELATIVE KEY CODE FOR HLDTAB

	INTER.	DA705.
DA705.:	FLAGAT	LI
	HRRZ	TA,CURFIL	;ABS. ADDR. OF FILTAB ENTRY
	LDB	TB,FI.ORG	;GET ORGANIZATION
	CAIE	TB,%%ACC	;IS IT "DEFAULT"?
	CAIN	TB,%ACC.R	;NO, IS IT RELATIVE?
	JRST	DA705A		;YES, OK
	MOVEI	DW,E.595	;NO, ERROR - WRONG TYPE KEY
	PUSHJ	PP,FATALW##	;FLAG IT
	HRRZI	TB,%HL.SY
	TRNA
DA705A:	HRRZI	TB,%HL.AK	;GET CODE
DA705B:	MOVEM	TB,CTR		;STORE CODE IN HLDTAB
	POPJ	PP,

;PUT KEY DATA-NAME IN HLDTAB

	INTER.	DA706.
DA706.:	PUSHJ	PP,DA709S	;SAVE NAMTAB ADDR
	PUSHJ	PP,DA706S	;SET UP HLDTAB ENTRY
	HRRZ	TB,CTR		;GET KEY CODE
	DPB	TB,HL.COD	;& PUT IT IN HLDTAB
	HLRZ	TB,CURFIL	;STORE FILTAB LINK IN HLDTAB
	DPB	TB,HL.LNK
	POPJ	PP,

;SET UP HLDTAB ENTRY

DA706S:	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,

;STORE ALTERNATE RECORD KEY DATA-NAME
	INTER.	DA707.
DA707.:	PUSHJ	PP,DA709S	;SAVE NAMTAB ADDR
	PUSHJ	PP,DA707A	;SETUP ALTERNATE KEY ENTRY
	PUSHJ	PP,DA706S	;SET UP HLDTAB ENTRY
	HRRZI	TB,%HL.KA	;GET KEY CODE
	DPB	TB,HL.COD	;& PUT IN HLDTAB
	HLRZ	TB,CURAKT	;GET CURRENT ALTERNATE KEY
	DPB	TB,HL.LNK	;STORE AKTTAB LINK IN HLDTAB
	POPJ	PP,		;RETURN

;SET UP AKTTAB ENTRY

DA707A:	MOVE	TA,[XWD CD.AKT,SZ.AKT] ;GET AN AKTTAB ENTRY
	PUSHJ	PP,GETENT
	MOVEM	TA,CURAKT##	;SAVE ADDR
	HLRZ	TB,CURFIL	;PUT FILTAB ADDR IN AKTTAB
	DPB	TB,AK.FLK##
	POPJ	PP,		;RETURN

;SET "DUPLICATES" BIT
	INTER.	DA708.
DA708.:	HRRZ	TA,CURAKT	;GET CURRENT ACTUAL KEY TABLE ADDR
	SETO	TB,		;TURN ON "DUPLICATES" BIT
	DPB	TB,AK.DUP##
	POPJ	PP,		;RETURN

;PUT DATA-NAME QUALIFIER IN NEXT WORD OF HLDTAB

	INTER.	DA709.
DA709.:	PUSHJ	PP,DA709S	;SAVE NAMTAB ADDR
	MOVE	TA,CURHLD	;GET # OF QUALIFIERS BEFORE THIS
	LDB	TB,HL.QAL
	AOJ	TB,		;INCREMENT COUNT
	DPB	TB,HL.QAL	;& PUT BACK
	ROT	TB,-1		;DIV BY 2
	HLRZ	TC,CURNAM	;GET NAMTAB LINK
	JUMPL	TB,DA709A	;IF BIT0 ON, USE ODD HALF-WORD
	ADDI	TA,1(TB)	;PTR TO EVEN HALF-WORD
	HRRM	TC,(TA)		;STORE IN EVEN HALF
	POPJ	PP,

DA709A:	PUSH	PP,CURHLD	;SAVE PTR TO HLDTAB ENTRY
	MOVE	TA,[XWD CD.HLD,1]	;GET ONE MORE WORD FOR THE ENTRY
	PUSHJ	PP,GETENT
	HLRZ	TC,CURNAM	;GET NAMTAB LINK
	HRLZM	TC,(TA)		;STORE NAMTAB LINK IN ODD HALF
	POP	PP,CURHLD	;RESTORE HLDTAB PTR
	POPJ	PP,

;STORE NAMTAB RELATIVE ADDRESS FOR NEW NAME

DA709S:	TLNN	W1,GWNOT	;NAME IN NAMTAB?
	JRST	DA709N		;YES
	PUSHJ	PP,BLDNAM	;NO, BUILD NAMTAB ENTRY
	MOVEM	TA,CURNAM	;SAVE ADDR
	HLRZS	TA		;LEAVE LINK IN RIGHT HALF
	DPB	TA,[POINT 15,W2,15]	;& IN W2
	POPJ	PP,

DA709N:	LDB	TA,[POINT 15,W2,15]	;GET NAMTAB REL ADDR
	HRLZM	TA,CURNAM	;& SAVE
	POPJ	PP,

	INTER.	DA710A
DA710A:	PUSHJ	PP,DA13A.	;RECOVER FROM SCANNING ERROR
	SKPNAM

;SAVE RECORD KEY CODE FOR HLDTAB

	INTER.	DA710.
DA710.:	HRRZI	TB,%HL.RC	;GET CODE
	MOVEM	TB,CTR		;STORE CODE IN HLDTAB
	PUSHJ	PP,DA706.	;COMPLETE THE ACTION
	JRST	DA711.		;CHECK FIPS FLAGGER

;Store CHARACTERS over wrong use of RECORDS

	INTER.	DA711A
DA711A:	PUSHJ	PP,DA13A.	;RECOVER FROM SCANNING ERROR
	SKPNAM			;BUT FLAG THIS USE OF RECORD

;Flag RECORD at 8x level

	INTER.	DA711.
DA711.:	SETZM	(SAVPTR)	;MAKE SURE LOWER BOUND IZ ZERO
	SETO	TB,
	SKIPE	TA,CURFIL
	DPB	TB,FI.VRS##	;SIGNAL VARYING SYNTAX SEEN
	SKIPN	FLGSW		;NEED FIPS FLAGGER?
	POPJ	PP,		;NO
	MOVEI	TA,%LV.8
	HLRZ	LN,RCLNCP##
	HRRZ	CP,RCLNCP
	JRST	FLG.ES

;Flag RECORD at FIPS levels for RECORD CONTAINS integer-1 TO integer-1

	INTER.	DA712.
DA712.:	PUSHJ	PP,DA11.	;STORE LITERAL
	SKIPN	FLGSW		;NEED FIPS FLAGGER?
	POPJ	PP,		;NO
	MOVE	TA,CURFIL
	LDB	TB,FI.ORG##	;GET FILE ORGANIZATION
	MOVE	TA,[%LV.L		;SEQUENTIAL
		%LV.LI			;RELATIVE
		%LV.H](TB)		;INDEXED
	HLRZ	LN,RCLNCP##
	HRRZ	CP,RCLNCP
	JRST	FLG.ES
;Routines to handle contained programs

	INTER.	DA720.
DA720.:	FLAGAT	8
	EWARNJ	E.899		;NOT YET IMPLEMENTED

	INTER.	DA721.
DA721.:	FLAGAT	8
	EWARNJ	E.899		;NOT YET IMPLEMENTED

	INTER.	DA722.
DA722.:	FLAGAT	8
	EWARNJ	E.899		;NOT YET IMPLEMENTED

	INTER.	DA723.
DA723.:	FLAGAT	8
	SKPNAM

	INTER.	DA724.
DA724.:	FLAGAT	8
	EWARNW	E.899		;NOT YET IMPLEMENTED
	SKIPN	TA,CURDAT
	POPJ	PP,
	LDB	TB,DA.LVL
	CAIE	TB,LVL.01	;ONLY LEGAL FOR LEVEL 01
	EWARNJ	E.838		; SO GIVE ERROR
	POPJ	PP,
SUBTTL	COMMON ROUTINES

	INTER.	DCA1.
DCA1.:
IFN DBMS,<			;[507]
	PUSHJ	PP,DA119A	;[476] CHECK PROPER SEQUENCE
	>			;[507]
	PUSHJ	PP,DA10.
	JRST	DA2.


	INTER.	DCA2.
DCA2.:	SKIPE	WRKSEC		;WORKING-STORAGE SECTION ALREADY SEEN?
	EWARNJ	E.402		;YES, CAN'T DUPLICATE
	SETOM	WRKSEC		;[710] NOW SET FLAG TO SHOW WE'VE SEEN IT
	SKIPE	REPSSN##	;[763] [476] REPORT SECTION SEEN?
	EWARNJ	E.470		;[476] YES, ERROR
IFN DBMS,<
	SKIPE	INVSEE##	;SCHEMA SECTION SEEN?
	POPJ	PP,		;YES, DON'T SET UP
>
IFN MCS,<
	SKIPE	CSSEEN		;COMMUNICATION SECTION SEEN?
	POPJ	PP,		;YES, DON'T SET UP
>
	PUSHJ	PP,DA10.
	JRST	DA3.


	INTER.	DCA3.
DCA3.:	PUSHJ	PP,DA5.
	JRST	DA0.


	INTER.	DCA4.
DCA4.:	PUSHJ	PP,DA7.
	JRST	DA0.


	INTER.	DCA5.
DCA5.:	PUSHJ	PP,DA11.
	JRST	DA28.

	INTER.	DCA6.
DCA6.:	SKIPE	REPSSN##	;[763] REPORT SECTION ALREADY SEEN?
	EWARNJ	E.171		;[763] YES, CAN'T DUPLICATE
	SETOM	REPSSN		;[763] NOW SET FLAG TO SHOW WE'VE SEEN IT
	SETOM	BLDIX		;[1335] TURN ON BUILD INDICES FLAG
	SKIPL	TA,PCHOLD	;[1515] If linkage section preceded,
	MOVEM	TA,EAS1PC	;[1515]  then next core offset is in
	SETOM	PCHOLD		;[1515]  PCHOLD
	MOVE	TA,CURHLD	;[1335] SAVE CURHLD
	MOVEM	TA,HLDSAV##	;[1362] [1335] MAKE EXTERNAL
	HRRZ	TA,HLDLOC	;[1335] FIND START OF HLDTAB
	ADDI	TA,1		;[1335]
	MOVEM	TA,CURHLD	;[1366] [1335] STORE IN CURHLD
	PUSHJ	PP,CLNHLD##	;[1335] BUILD DATAB ENTRIES FOR INDICES
	MOVE	TA,HLDSAV	;[1335] RESTORE CURHLD
	MOVEM	TA,CURHLD	;[1335]
	SETZM	BLDIX		;[1335] TURN OFF FLAG
	PUSHJ	PP,DA10R.
	JRST	DA63.

	INTER.	DCA7.
DCA7.:	SKIPE	LNKSSN##	;[763] LINKAGE SECTION ALREADY SEEN?
	EWARNJ	E.171		;[763] YES, CAN'T DUPLICATE
	SETOM	LNKSSN		;[763] NOW SET FLAG TO SHOW WE'VE SEEN IT
	FLAGAT	LI
IFN DBMS,<			;[%316]FOR ACCESS
	SKIPE	ACCSEE##	;[%316]
	JRST	[SETZM	ACCSEE##	;[476] CLEAR ACCESS FLAG
		SETOM	LNKSEC##	;[476]
		SETOM	SUBPRG		;[476] THIS IS A SUBPROGRAM FLAG
		MOVE	TB,EAS1PC	;[476] SAVE DATA PC
		MOVEM	TB,PCHOLD	;[476] WHILE DOING LINKAGE SECTION
		POPJ	PP,]		;[476]
	>			;[%316]
	SKIPE	REPSSN##	;[763] [476] REPORT SECTION SEEN?
	EWARNJ	E.470		;[476] YES, ERROR
	PUSHJ	PP,DA10.
	JRST	DA112.


	INTER.	DCA10.
DCA10.:	PUSHJ	PP,DA9.
	JRST	DA58.


;This is the PCA42. routine
	INTER.	DCA11.
DCA11.:	PUSHJ	PP,DA220.	;PA2. routine
	JRST	DA221.		;PA171. routine


;Here to save CURDAT of the RD GROUP item in CURDTT,
; then call action routine
	INTER.	DCA12.
DCA12.:	MOVE	TE,CURDAT##
	MOVEM	TE,CURDTT##
	SETZM	NSBSC1##	;CLEAR SUBSCRIPT COUNT
	PUSH	PP,W1
	PUSH	PP,W2
	PUSHJ	PP,DA515.	;CHECK SOURCE ITEM
	POP	PP,W2
	POP	PP,W1
	JRST	DA220.		;PA2. routine
SUBTTL	ERROR ROUTINES FOR DD SYNTAX SCAN

	INTER.	CE111.
CE111.:	TLNE	W1,GWRESV
	EWARNJ	E.103
	EWARNJ	E.104

	INTER.	CE125.
CE125.:	MOVE	CP,BLNKCP##
	MOVE	LN,BLNKLN##
	HRRZI	DW,E.125
	JRST	WARN

	END	COBOLC