; UPD ID= 3443 on 3/9/81 at 8:41 PM by NIXON                            
TITLE	CLEANC FOR COBOL V12C
SUBTTL	CLEANUP AFTER PHASE C		W.NEELY/CAM

	SEARCH COPYRT
	SALL

COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE.

	SEARCH	P
	%%P==:%%P
	ISAM==:ISAM
	RPW==:RPW

;EDITS
;NAME	DATE		
;
;JEH	16-MAY-84	[1533] Fix edit 1501, jrst back to new label
;JEH	28-MAR-84	[1520] Give error if 'DEPENDING ON D-N' and D-N
;				is subscripted
;JEH	24-OCT-83	[1502] Give warning on records that are smaller than
;				maximum record size
;JEH	11-OCT-83	[1501] Syntax error if alternate key is variable length
;JEH	10-OCT-83	[1500] Warning if high/low -values on numeric item
;SMI	27-OCT-82	[1427] 68274 Gives warning SHOULD BE UNSIGNED INTEGER
;				when data item is an unsigned integer.
;SMI	15-OCT-82	[1417] FIX 68274 CONVERSION OF WRITE
;DMN	12-MAR-82	[1340] 68274 converter does not flag JUSTIFIED clause
;				in VALUE
;JEH	02-FEB-82	[1335] Declare DATAB entries for all indexes if 
;			REPORT SECTION is scanned for their use by REPORT
;			WRITER stmts
;DAW	14-Nov-80	[1072] Make VALUE clause work correctly for EBCDIC
;				signed numeric items
;DAW	29-OCT-80	[1066] BETTER ERROR RECOVERY FOR CONTAB-- PREVENTS
;			"?ILL MEM REF.." IN PHASE E WHEN PGM HAS SYNTAX ERRORS
;DAW	8-FEB-80	[770] REPLACE EDIT 742: GENERATE AN ERROR MESSAGE
;			IF AN ITEM IN "INDEXED BY" CLAUSE WAS ALSO DEFINED
;			AS AN INDEPENDENT ITEM.
;V12A****************
;
;DMN	28-FEB-79	[644] MORE ERROR RECOVERY IN CONTAB
;V12*****************

;V10*****************
;	15-DEC-76	[454] FIX RECOVERY FOR ERROR IN CONTAB
;	10-AUG-76	[434] FOR REPORT WRITER SO SUM COUNTERS OF GT 10 DIGITS ARE HANDLED PROPERLY
;	31-MAR-76	[415] FOR REPORT WRITER SORT THE SUM COUNTER CODE SO THAT LOWEST LEVEL DONE FIRST
;	31-MAR-76	[415] REPORT WRITER DO THE SUM CODE IN ORDER OF LOWEST TO HIGHEST LEVL OF CID
;ACK	12-JAN-75	FILE STATUS CODE - REPLACE THE HLDTAB LINKS BY
;			 DATAB LINKS.
;ACK	12-MAR-75	MODIFY ROUTINE WHICH ADJUSTS LITERALS SO THAT
;			 THEY HANDLE COMP-3/EBCIDC LITERALS.
;********************

; EDIT 335 REPORT WRITER ERROR CHECKING
; EDIT 315 REPORT WRITER FIXES SEE P.MAC
; EDIT 300 FLAG AS ERROR SYMBOLIC KEY, OR RECORD KEY IN LINKAGE SECTION
; 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.

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

IFN RPW,<EXTERN RPTSRT,RPTRPT,RPTNEW,RPTRHT,RPTNHT,RPTCIT,RPTCID,RPTNID,RPTFIN>
EXTERN TEMLOC,CURTEM,HL.CID,HL.RD		; [415]
%HLDCD==1	; [415] MEANS THIS HLDTAB THING DONE, SETS MSD OF CODE TO 1
EXTERN	HL.FCD,HL.COD
ENTRY	CLEANC,GETCHR,ADJUST
ENTRY	CLNHLD		;[1335]
;GENERATE LITERALS FOR FILE TABLES

CLEANC:
	PUSH	PP,TA		;[1417]
	MOVE	TA,FILLOC	;[1417] GET LOCATION OF FILE ENTRY
	CAMN	TA,FILNXT	;[1417] ANY FILTAB ENTRIES ?
	JRST	CLNAC2		;[1417] NO
	HRRZI	TA,SZ.DEV	;[1417] SET UP ABSOLUTE ADDRESS TO FILTAB
	ADDM	TA,FILTBL##	;[1417]
	HRRZI	TA,CD.FIL*1B20+1	;[1417]
CLNACC:	HRLZM	TA,CURFIL	;[1417]
	PUSHJ	PP,LNKSET	;[1417]
	HRRM	TA,CURFIL	;[1417]
	LDB	TB,FI.ACC	;[1417] GET FILE ACCESS MODE
	CAIE	TB,%%ACC	;[1417] ACCESS SPECIFIED ?
	JRST	CLNAC1		;[1417] YES
	HRRZI	TB,%ACC.S	;[1417] NO, ASSUME SEQUENTIAL
	DPB	TB,FI.ACC	;[1417] STORE ACCESS MODE
CLNAC1:	LDB	TA,FI.NXT	;[1417] GET NEXT FILTAB ENTRY
	JUMPN	TA,CLNACC	;[1417] FINISHED ?
CLNAC2:	POP	PP,TA		;[1417] YES
IFN ANS74,<
	SKIPE	TA,COLSEQ##	;IF COLLATING SEQ. SET
	TRNE	TA,700000	;IS IT NAMTAB ENTRY?
	JRST	CLNDSQ		;NO
	ADD	TA,NAMLOC
	SKIPN	TA,0(TA)	;GET SPECIAL-NAME
	JRST	[HRRZI	DW,E.718	;NOT DEFINED
		HLRZ	LN,COLNCP##	;RESTORE LN
		HRRZ	CP,COLNCP	;AND CP
		PUSHJ	PP,FATAL	;GIVE ERROR MESSAGE
		SETZM	COLSEQ		;NO COLATING SEQUENCE
		JRST	CLNDSQ]		;AND CONTINUE
	PUSHJ	PP,LNKSET
	MOVE	TA,1(TA)	;GET 2ND WORD
	TLNE	TA,(1B6)	;MAKE SURE ITS ALPHABET NAME
	TRNN	TA,%AN.AS!%AN.EB	;AND NOT A LITERAL
	JRST	CLNDSQ		;NO, LEAVE AS IS
	HRRZM	TA,COLSEQ	;YES, REPLACE BY WHAT IT IS
CLNDSQ:>
	MOVE	TA,[ XWD RPTSRT,RPTSRT+1]	; [415] CLEAR
	SETZM	RPTSRT		; [415] THE REPORT WRITER
	BLT	TA,RPTFIN	; [415] DATA
	HRRZ	TA,HLDLOC##	;START OF HLDTAB
	AOJ	TA,
	MOVEM	TA,CURHLD##	;PTR TO 1ST ENTRY
CLNHLD:	HRRZ	TA,CURHLD	;NEXT HLDTAB ENTRY
	HRRZ	TB,HLDNXT##	;PTR TO END
	CAILE	TA,(TB)		;PAST THE END YET?
	JRST	[SKIPE	BLDIX##	;[1335] IF JUST BUILDING INDEXES,
		POPJ	PP,	;[1335]  EXIT
	        SKIPN	RPTRPT	; [415]  END OF HLDTAB ANY REPORT CF TO DO?
		JRST	CLNFIL		;NO RDS,, ALL DONE
		JRST	CLRPTP ]	; [415] DO LEFT OVER REPRT
	LDB	TC,HL.FCD	; [415]
	CAIN	TC,%HL.IX	;20: CK FOR "MAKE INDEX" CODE
	JRST	CLHIDX
IFN RPW,<
	SKIPE	BLDIX		;[1335] IF JUST BUILDING INDEXES, 
	JRST 	CLNHLL		;[1335]  LOOP BACK
	CAIN	TC,%HL.SC	;14: CK FOR "BUILD-SUM-CTR" CODE
	JRST	CLNRPX		; [415] YES
	CAIN	TC,%HL.GI	; [315] G.I. ITEM
	JRST	CLHGIT		; [315] YES
	CAIL	TC,%HL.SL	; [415] FOR SUM IDS
	CAILE	TC,%HL.UP	; [415]
	SKIPA			; [415] NORMAL STUFF
	JRST	CLNHLL		; [415] SUM ID HANDLE DIFFERENTLY
	>
	LDB	TB,HLSCOD	; [415] GET MOST SIGN DIGIT OF HL.COD
	CAIN	TB,%HLDCD	; [415] SEE ALREADY DONE?
	JRST	CLNHLL		; [415] GO TO NEXT ONE
	PUSHJ	PP,CLNHLQ	; [415] DO QUALIFIER CHECKS
	XCT	.(TC)		;DO ACTION FOR TYPE
	JRST	CLHACK		;1: STORE ACTUAL KEY DATAB LINK
	JRST	CLHVID		;2: STORE VALUE OF IDENTIFICATION DATAB LINK
	JRST	CLHVDW		;3: STORE VALUE OF DATE-WRITTEN DATAB LINK
	JRST	CLHVPP		;4: STORE VALUE OF PROJ-PROG # DATAB LINK
	JRST	CLHLFL		;5: STORE LOW FILE-LIMIT DATAB LINK
	JRST	CLHHFL		;6: STORE HIGH FILE-LIMIT DATAB LINK
	JRST	CLHDOC		;7: STORE DEPENDING FOR OCCURS DATAB LINK
	JRST	CLHKOC		;10: STORE ASCN. KEY FOR OCCURS DATAB LINK
IFN RPW,<
	JRST	CLHSML		;11: STORE SUM ID DATAB LINK IN LEFT HALF
	JRST	CLHSMR		;12: STORE SUM ID DATAB LINK IN RIGHT HALF
	JRST	CLHUPN		;13: STORE SUM-UPON DATAB LINK
	0			;14: (EXECUTED 1ST IF SEEN)
	>
IFE RPW,<REPEAT 4,<0>>
IFN ISAM,<
	JRST	CLHSKY		;15: STORE SYMBOLIC KEY DATAB LINK
	JRST	CLHRKY		;16: STORE RECORD KEY DATAB LINK
	>
IFE ISAM,<REPEAT 2,<0>>
	JRST	CLHDKY		;17: STORE DESC. KEY FOR OCC. DATAB LINK
	0			;20: (EXECUTED 1ST IF SEEN)
	JRST	CLHERS		;21: PUT NAMTAB LINKS IN FILE STATUS
				;    ENTRIES OF THE FILE TABLE.
	0			;22: (EXECUTED 1ST IF SEEN)
IFN ISAM&ANS74,<JRST CLHAKY>	;23: STORE ALTERNATE KEY LINK
IFE ISAM&ANS74,<0>
;	HANDLE THE QUALIFIERS

CLNHLQ:	SETZM	TBLOCK##	; [415] CLR TBLOCK
	MOVE	TC,[TBLOCK,,TBLOCK+1]
	BLT	TC,TBLOCK+24
	MOVE	TC,(TA)		;GET 1ST WORD OF HLDTAB ENTRY (ESSENTIALLY W2)
	MOVEM	TC,TBLOCK+4	;& PUT IT IN TBLOCK SETUP
	LDB	TC,HL.QAL##	;GET # OF QUALS
	JUMPE	TC,CLNHL8	;THERE AREN'T ANY
	MOVEM	TC,CTR##
CLNHL5:	AOS	TB,TBLOCK+1	;INDEX TO NEXT QUALIFIER
	CAMLE	TB,CTR		;DONE ALL?
	JRST	CLNHL3		;YES
	ADDI	TB,3		;AIM AT THAT QUALIFIER
	ROT	TB,-1
	ADDI	TB,(TA)
	HLRZ	TD,(TB)		;GET QUALIFIER (ASSUMING INDEX ODD)
	TLNE	TB,400000	;IF INDEX EVEN, GET RIGHT QUALIFIER
	HRRZ	TD,(TB)		;TD=NAMTAB LINK FOR QUALIFIER
	MOVE	TB,TBLOCK+1	;CTR IS INDEX TO QUALIFIER STORAGE
	MOVEM	TD,TBLOCK+4(TB)	;STORE QUALIFIER
	JRST	CLNHL5		;GET NEXT QUALIFIER

CLNHL3:	SOS	TBLOCK+1	;ADJUST QUAL CTR
CLNHL8:	PUSHJ	PP,FINDAT##	;FIND DATAB LINK FOR ITEM
	JUMPE	DW,CLNHL7	;NO ERROR
	PUSHJ	PP,CLHBA1	;GIVE ERROR MESSAGE
	JRST	CLNHL4		;LEAVE TBLOCK+4 NON-ZERO
CLNHL7:	SETZM	TBLOCK+4	;CLR UNDEFINED FLAG
CLNHL4:	HRRZ	TA,CURHLD	;GET HLDTAB PTR
	LDB	TB,HL.LNK##	;LINK TO PLACE WHERE DATA LINK WANTED
	ANDI	TB,077777	;MASK OFF TABLE BITS
	LDB	TC,HL.FCD	; [415] TYPE OF THIS HLDTAB ITEM
	MOVEI	TA,(TB)
	ADD	TA,FILLOC##	;ASSUME IT'S A FILTAB REFERENCE
	POPJ	PP,		; [415]

CLNHL9:	MOVE	TA,CURHLD	;GET HLDTAB PTR
	MOVEI	TC,%HLDCD	; [415] MARK AS
	DPB	TC,HLMCOD	; [415] DONE
CLNHLL:	MOVE	TA,CURHLD	; [415] GET BACK HLDTAB POINTER
	LDB	TB,HL.QAL	;NUMBER OF QUALIFIERS
	MOVEM	TB,CTR
	ADDI	TB,5		;ROUND UP + STANDARD # OF HALFWORDS
	LSH	TB,-1		;DIVIDED BY 2
	ADDM	TB,CURHLD	;AIM AT NEXT HLDTAB ENTRY
	JRST	CLNHLD
IFN RPW,<
TEMNRD==1
;	FIRST PASS OF SUM IDS THRU HLDTAB
;	FOR EACH RD SET UP IN TEMPTAB
;	0	[ RD LINK,,LINK TO HLDTAB FOR FIRST SUM CTR
;	1	[ # OF IDS,,TEMTAB LINK TO NEST RD]
;	FOR EACH ID LEVEL ONE WORD IN TEMTAB
;		[ LEVEL #,,HLDTAB LINK TO FIRST SUM CTR THIS ID]
CLNRPX:	SKIPE	RPWERR		; [415] UNRECOVERABLE REPORT ERROR?
	JRST	CLNHL9		; [415] YES SKIP OVER
	LDB	TB,HL.RD	; [415] GET RD LINK
	CAME	TB,RPTRPT	; [415] SAME RD?
	PUSHJ	PP,CLRDOD	; [415] NEW ONE
	HRRZ	TA,CURHLD	; [415] GET CURRENT HLDTAB LOC
	LDB	TC,HL.CID	; [415] GET LEVEL NUMBER
	CAMN	TC,RPTCID	; [415] SAME ID?
	JRST	CLNHLL		; [415] YES , SKIP THIS
	MOVEM	TC,RPTCID	; [415] SAVE NEW LEVEL NUMBER
	AOS	RPTNID		; [415] COUNT NEW ID
	MOVE	TA,[CD.TEM,,SZ.TEM]; [415] GET TEMTAB LOCATION
	PUSHJ	PP,GETENT	; [415]
	MOVEM	TA,CURTEM	; [415]
	MOVE	TB,RPTCID	; [415] GET BACK NEW ID LEVEL #
	HRLZM	TB,0(TA)	; [415] STORE THE NEW ID LEVEL NUMBER INTO TEMTAB
	HRRZ	TB,CURHLD	; [415] CONVER CURRENT HLDTAB
	HRRZ	TC,HLDLOC	; [415] TO RELATIVE
	SUB	TB,TC		; [415] LINK LOCATION
	HRRM	TB,0(TA)	; [415] STORE START HLDTAB LINK INTO TEMTAB
	JRST	CLNHLL		; [415] GO TO NEXT HLDTAB

;	NEW RD FOUND- FINISH UP LINKAGE
CLRDOD:	MOVEM	TB,RPTNEW	; [415] STORE NEW RD
	MOVE	TA,[CD.TEM,,SZ.TM2]	; [415] GET TEMTAB FOR NEW
	PUSHJ	PP,GETENT	; [415] RD HEADER
	MOVEM	TA,RPTNHT	; [415] SAVE IT
	SKIPN	RPTRPT		; [415] FIRST ONE?
	JRST	CLRDOX		; [415] YES GO ON
	HLRZ	TA,RPTRHT	;[415] GET CURRENT TEMTAB POINTER
	HRRZ	TB,TEMLOC	; [415] CONVERT TO REAL
	ADDI	TA,(TB)		; [415] ADDRESS
	HLRZ	TB,RPTNHT	; [415] GET BACK NEW TEMTAB LINK
	HRRZM	TB,TEMNRD(TA)	; [415] STORE INTO CURRENT NEXT LNIK POINTER
	MOVE	TC,RPTNID	; [415] GET NUMBER OF ID FOR CURRENT
	HRLM	TC,TEMNRD(TA)	; [415] STORE IN CURRENT HEADER
	MOVE	TA,RPTNHT	; [415] GET NEW TEMTAB HDR POINTER
CLRDOX:	MOVE	TB,RPTNEW	; [415] GET NEW RD LINK
	MOVEM	TA,RPTRHT	; [415] MAKE NEW RD CURRENT ONE
	HRLZM	TB,0(TA)	; [415] STORE INTO NEW TEMTAB HDR
	MOVE	TD,RPTNEW	; [415] MAKE NEW POINTER CURRENT
	MOVEM	TD,RPTRPT	; [415]
	SETZM	RPTNID		; [415] START # OF IDS OVER
	SETOM	RPTCID		; [415] SET LEVEL CNT TO NONE
	HRRZ	TB,CURHLD	; [415] GET CURRENT HLDTAB
	HRRZ	TC,HLDLOC	; [415]  CONVERT
	SUB	TB,TC		; [415] TO REL ADDRESS
	HRRM	TB,(TA)		; [415] STORE INTO HEADER
	POPJ	PP,		; [415] RETURN END OF NEW RD

HLMCOD:	POINT	1,1(16),0	; [415] MSD OF HL.COD
HLSCOD:	POINT	1,TC,27		; [415] WHERE TO PUT MSD OF HL.COD FOR TESTING
;	END OF HLDTAB FIRST PASS - FIRST FINISH UP CURREENT RD
CLRPTP:	HLRZ	TA,RPTRHT	; [415] GET CURRENT RD IN TEMTAB
	HRRZ	TB,TEMLOC	; [415] CONVERT
	ADDI	TA,(TB)		; [415] TO REAL
	HRLZ	TB,RPTNID	; [415] GET NUMBER OF IDS
	MOVEM	TB,TEMNRD(TA)	; [415] STORE IT AND ZERO NEXT RD POINTER
;	PROCESS THE SUM COUNTER HLDTAB 
	MOVSI	TA,1		; [415] START AT
	MOVEM	TA,RPTRHT	; [415] POINT TO HEAD OF FIRST RD
	HRR	TA,TEMLOC	; [415] TOP 
	AOS	TA		; [415] OF TEMTAB

;	DO FOR EACH RD 
;	TA AND RPTRHT HAVE POINTER TO HEAD OF RD IN TEMTAB
CLRRD:	HLRZ	TB,(TA)		; [415] GET RD LINK
	MOVEM	TB,RPTRPT	; [415] SAVE AS NEW RD
	HLRZ	TE,TEMNRD(TA)	; [415] GET # OF CID'S IN THIS RD
	MOVEM	TE,RPTNID	; [415] SAVE
	ADDI	TA,2		; [415] NOW POINT TO FIRST SUM ID THIS RD
	MOVEM	TA,CURTEM	; [415] SAVE FIRST LEVEL
	HRRZM	TA,TB		; [415] GET 1ST LEVEL TEMTAB LOC
	HRRZ	TC,TEMLOC	; [415] COMPUTE ITS
	SUBI	TB,(TC)		; [415] RELATIVE LOCATION
	HRLZM	TB,RPTCIT	; [415] KEEP FOR NEXT ID
;	
;	DO FOR EACH ID
;	SEARCH THRU THE TEMP TABLE FOR LOWEST LEVEL ID LEFT TO PROCESS
;	CURTEM POINTS TO FIRST LEVEL SEEN IN THIS RD
CLNRDS:	MOVEI	TB,777777	; [415] SET ID TO HIGH TO START
	MOVEM	TB,RPTCID	; [415] RPTCID HOLDS CURRENT LOWEST ID LEVEL #
CLNRD1:	HLRZ	TB,(TA)		; [415] GET LEVEL NUMBER THIS ID
	TRNE	TB,400000	; [415] ALREADY DONE THIS ID?
	JRST	CLNRDL		; [415] YES GO TO NEXT LEVEL
	CAML	TB,RPTCID	; [415] CHOOSE LOWER OF CURRENT ID VS LOWEST 
	JRST	CLNRDL		; [415]	CURRENT ONE NOT LOWER
	MOVEM	TB,RPTCID	; [415] KEEP NEW ID LEVEL
	HRRZ	TC,(TA)		; [415] GET HLTAB POINTER FOR THIS ID
	MOVEM	TA,CURTEM	; [415] KEEP TEMTAB LOC OF LOWEST ID
CLNRDL:	SOSLE	TE		; [415] ANY MORE ID THIS TABLE?
	AOJA	TA,CLNRD1	; [415] YES GO TO NEXT
;
;	TC HAS THE HLDTAB LINK POINTER TO START PROCESSING
;	!!!!! NOW PROCESS !!!!!!
	PUSHJ	PP,RPTDO	; [415] PROCESS THIS ID LLEVEL
	SOSG	RPTNID		; [415] ANY MORE IDS
	JRST	CLRNND		; [415] ALL DONE THIS RD DO NEXT
	HRRZ	TA,CURTEM	; [415] GET TEMTAB LOCATION FOR LOWEST ID
	MOVSI	TB,777777	; [415]	SET LEVEL PROCESSED TO HIGH
	HLLM	TB,0(TA)	; [415] SET
	HLRZ	TA,RPTCIT	; [415] GET FIRST ID LOCATION IN TEMTAB
	HRRZ	TB,TEMLOC	; [415] CONVERT TO REAL
	ADDI	TA,(TB)		; [415] TEMTAB LOCATION
	MOVEM	TA,CURTEM	; [415] KEEP AS CURRENT TEMTAB POINTER
	HLRZ	TE,-1(TA)	; [415} GET BACK ORIGINAL # OF IDS
	JRST	CLNRDS		; [415] GO SEARCH AND DO NEXT ID
;	END DO FOR EACH ID
;
;	FINISHED THIS RD DO NEXT RD IF ANY
CLRNND:	HLRZ	TA,RPTRHT	; [415] GET HEADER ADDRESS OF THIS RD
	HRRZ	TB,TEMLOC	; [415] CONVERT TO REAL
	ADDI	TA,(TB)		; [415] REAL
	HRRZ	TA,TEMNRD(TA)	; [415] GET LINK TO NEXT RD
	JUMPE	TA,CLNFIL	; [415] THERE IS NO MORE ALL DONE
	HRLZM	TA,RPTRHT	; [415] SAVE LINK HEADING LINK FOR NEW RD
	ADDI	TA,(TB)		; [415] CONVERT LINK TO REAL
	JRST	CLRRD		; [415] DO NEXT RD
;	DO THE LOWEST LEVEL SUM ID IN THIS REPORT
;	TC HAS THE HLDTAB LINK TO START PROCESSING, RPTCID HAS THE LEVEL NUMBER
RPTDO:	HRRZ	TA,HLDLOC	; [415] GET REAL ADDRESS
	ADDI	TA,(TC)		; [415]
	MOVEM	TA,CURHLD	; [415] MAKE IT CURRENT HLDTAB POINTER
	LDB	TB,HL.FCD	; [415] ALREADY DONE?
	TRNE	TB,400		; [415] IF SO
	POPJ	PP,		; [415] EXIT NOW
	JRST	CLHSCT		; [415] DO TYPE 14 (BUILD SUM COUNTER)

RPTDOL:	HRRZ	TA,CURHLD	; [415] GET CURRENT HLDTAB POINTER
	HRRZ	TB,HLDNXT	; [415] END OF HLDTAB?
	CAILE	TA,(TB)		; [415] CHECK
	POPJ	PP,		; [415] RETURN
	LDB	TC,HL.FCD	; [415] GET FULL HL CODE
	LDB	TB,HLSCOD	; [415] GET MOST SIGN DIGIT OF HL.COD
	CAIN	TB,%HLDCD	; [415] SEE ALREADY DONE?
	JRST	RPTDOE		; [415] YES GO TO NEXT ONE
	CAIN	TC,%HL.SC	; [415] ANOTHER SUM ID
	JRST	RPTSCT		; [415] YES,CHECK IF OKAY
	CAIN	TC,%HL.SL	; [415] SUM ID LEFT HALF?
	JRST	CLHSML		; [415] YES DO IT
	CAIN	TC,%HL.SR	; [415] SUM ID RIGHT HALF?
	JRST	CLHSMR		; [415] YES DO IT
	CAIN	TC,%HL.UP	; [415] SUM UPON?
	JRST	CLHUPN		; [415] YES DO IT
	POPJ	PP,		; [415] SOME OTHER CODE RETURN

RPTST1:	LDB	TB,TC		; [415] SEE IF ALREADY STORED
	SKIPE	TB		; [415]
	PUSHJ	PP,CLHDUP	; [415] YES GIVE DUPLICATE ERROR
	DPB	TE,TC		; [415] STORE THE NEW ITEM
RPTDOE:	MOVE	TA,CURHLD	; [415] GET BACK CURRENT HLDTAB POINTER
	MOVEI	TC,%HLDCD	; [415] MARK AS
	DPB	TC,HLMCOD	; [415] DONE
	LDB	TB,HL.QAL	; [415]	GET NNUMBER OF QUALIFIERS
	MOVEM	TB,CTR		; [415] KEEP TRACK OF THEM
	ADDI	TB,5		; [415] GO FIND NEXT HLDTAB
	LSH	TB,-1		; [415] POINTER
	ADDM	TB,CURHLD	; [415]
	JRST	RPTDOL		; [415] GO DO THE NEXT ITEM

RPTSCT:	LDB	TB,HL.RD	; [415] IS THIS SAME RD?
	CAME	TB,RPTRPT	; [415]
	POPJ	PP,		; [415] EXIT
	LDB	TB,HL.CID	; [415} IS IT SAME
	CAME	TB,RPTCID	; [415] ID LEVEL?
	POPJ	PP,		; [415] NO ,EXIT
	JRST	CLHSCT		; [415] GO PROCESS SUM CTR
;STORE INDIVIDUAL LINKS IN APPROPRIATE TABLES

IFN RPW,<

CLHSML:	SKIPGE	RPWERR##	; [335] FATAL REPORT GENERATOR ERROR
	JRST	RPTDOE		; [415] CANT GO ON
	PUSHJ	PP,CLNHLQ	; [415] PICK UP ANY QUALIFIERS
	SUB	TA,FILLOC
	ADD	TA,RPWLOC##
	PUSHJ	PP,SUMCK	;SEE THAT ITEM IS A SUM CTR
	PUSHJ	PP,CLHSME	;ERROR
	HRLM	TE,(TA)		;STORE DATAB LINK TO SUM ADDEND IN LEFT HALF
	JRST	RPTDOE		; [415] RETURN

CLHSMR:	SKIPGE	RPWERR		; [335] FATAL REPORT GENERATOR ERROR
	JRST	RPTDOE		; [415] CANT GO ON
	PUSHJ	PP,CLNHLQ	; [415] PICK UP ANY QUALIFIERS
	SUB	TA,FILLOC
	ADD	TA,RPWLOC
	PUSHJ	PP,SUMCK	;SEE THAT ITEM IS A SUM CTR
	PUSHJ	PP,CLHSME	;ERROR
	HRRM	TE,(TA)		;STORE DATAB LINK TO SUM ADDEND IN RIGHT HALF
	JRST	RPTDOE		; [415] RETURN

CLHSME:	HRRZI	DW,E.358	;NOT A TYPE DETAIL OR CONTROL-FOOTING
	JRST	CLHBA1

CLHUPN:	PUSHJ	PP,CLNHLQ	; [415] PICK UP ANY QUALIFIERS
	SUB	TA,FILLOC	;NOT FILTAB REF. BUT RPWTAB
	ADD	TA,RPWLOC
	PUSH	PP,TE		;SAVE AC'S
	PUSH	PP,TA		;SAVE RPWTAB PTR
	HRRZI	TA,(TE)		;MAKE PTR TO DATA ITEM
	PUSHJ	PP,LNKSET##
	LDB	TB,DA.RPW	;GET LINK TO CORRESP RPW ITEM
	HRRZ	TA,RPWLOC	;MAKE PTR TO RPWTAB ENTRY
	ADDI	TA,(TB)
	LDB	TB,RW.TYP##	;MUST BE TYPE DETAIL
	CAIE	TB,%RG.DE
	PUSHJ	PP,CLHUPE	;IT'S NOT
	SETO	TB,		;SET REFERENCED-BY-SUM-UPON BIT
	DPB	TB,RW.RSU##
	POP	PP,TA		;GET BACK AC'S
	POP	PP,TE
	MOVE	TC,RW.UPN##	;GET PTR TO UPON CLAUSE LINK
	JRST	RPTST1		; [415] PUT LINK IN RPWTAB 'UPON'

CLHUPE:	HRRZI	DW,E.364	;?SUM UPON MUST REF. TYPE DETAIL
	JRST	CLHBA1
;MAKE A SUM COUNTER FOR DATAB ITEM

CLHSCT:	SKIPGE	RPWERR		; [335] FATAL REPORT GENERATOR ERROR
	JRST	RPTDOE		; [415] CANT GO ON
	LDB	TE,HL.LNK	;GET DATAB LINK
	PUSHJ	PP,SUMCTR	;GIVE ITEM A SUM-CTR
	JRST	RPTDOE		; [415] RETURN

;	GROUP INDICATE ITEM HAVING A VALUE CLAUSE- CONVERT TO ITEM WITH
; SOURCE CLAUSE BY CREATING A DATAB ITEM WITH A VALUE CLAUSE
; THEN THIS NEWLY CREATED ITEM BECOMES THE SOURCE ITEM
; FOR THE ORIGINAL ONE
CLHGIT:	SKIPGE	RPWERR		; [335] FATAL REPORT GENERATOR ERROR
	JRST	CLNHL9		; [335] CANT GO ON
	LDB	TA,HL.LNK	; [315] GET THE ORIG DATAB ITEM WITH THE VALUE CLAUSE
	HRRZM	TA,SAVDAT##	; [315] SAVE IT
	MOVEI	TYPE,1000	; [315] SET TYPE TO USER-NAME FOR NEW ITEM
	PUSHJ	PP,RPWDAT##	; [315] GO CREATE NEW ITEM USING THE CURRENT ONE ON PUSH-DOWN STACK FOR PARAMETERS
	MOVE	TA,CURHLD	; [315] GET BACK HLDTAB POINTER
	LDB	TB,HL.NAM	; [315] GET THE VALUE LINK
	ADDI	TB,<CD.LIT>B20	; [315] POINT IN LITAB TABLE ID
	MOVE	TA,CURDAT	; [315] GET ADDRESS OF NEWLY CREATED ITEM
	DPB	TB,DA.VAL##	; [315] STORE VALUE PTR TO THIS NEW ITEM
	PUSHJ	PP,D54.NJ##	; [315] SET ASIDE RUN TIME SPACE FOR NEW ITEM WTIH ITS VALUE
	HRRZ	TA,SAVDAT	; [315] GET BACK ORIGINAL DATAB ITEM
	LDB	TB,DA.RPW	; [315] GET ORIGNAL REPORT ITEM POINTER
	HRRZ	TA,RPWLOC	; [315] CONVERT LINKAGE TO REAL
	ADDI	TA,(TB)		; [315] ADDRESS
	HLRZ	TB,CURDAT	; [315] GET LINK ADDRESS OF NEW ITEM
	DPB	TB,RW.SLK	; [315] AND MAKE IT THE SOURCE ITEM FOR REPORT ITEM
	JRST	CLNHL9		; [315] GO TO NEXT HLDTAB ITEM
;CK THAT SUM-ID IS A SUM-CTR
;IF NOT, MAKE ONE FOR THE ITEM

SUMCK:	PUSH	PP,TA		;SAVE CRUCIAL AC'S
	MOVEM	TE,(SAVPTR)
	HRRZI	TA,(TE)		;MAKE PTR TO DATA ITEM
	PUSHJ	PP,LNKSET
	LDB	TB,DA.SCT##	;IS THIS A SUM-CTR?
	JUMPE	TB,SUMCKB	;NO
	DPB	TB,DA.RBS##	;YES, SET REF'D BY SUM BIT
	JRST	SUMCKX

SUMCKB:	LDB	TB,DA.RPW##	;NO, GET PTR TO CORRESP RPW ENTRY
	JUMPE	TB,SUMCKA	;MUST BE A SOURCE ITEM
	HRRZ	TA,RPWLOC
	ADDI	TA,(TB)
	LDB	TB,RW.TYP	;GET TYPE
	CAIN	TB,%RG.CF	;CONTROL-FOOTING?
	JRST	SUMCKS		;YES, MUST MAKE A SUM-CTR FOR IT
	JRST	SUMCKE		;NOT A CF & NOT A SOURCE FOR DETAIL

SUMCKA:	LDB	TB,DA.RDS##	;GET SOURCE FOR DETAIL BIT
	JUMPE	TB,SUMCKE	;NOT ON
	DPB	TB,DA.RBS	;SET REFERENCED BY SUM BIT
	JRST	SUMCKX		;EXIT

SUMCKS:	HRRZ	TE,(SAVPTR)	;MAKE A SUM-CTR FOR CF ITEM
	PUSHJ	PP,SUMCTR
	HRRZI	TA,(TB)		;GET PTR TO SUM CTR
	SETO	TB,		;SET REF'D BY SUM BIT
	DPB	TB,DA.RBS
	JRST	SUMCKY

SUMCKX:	MOVE	TE,(SAVPTR)	;RESTORE TE
SUMCKY:	AOS	-1(PP)		;SKIP RETURN
SUMCKE:	POP	PP,TA		;RESTORE TA
	POPJ	PP,
;MAKE A SUM-CTR FOR A DATA ITEM (WHOSE LINK IS IN TE)

SUMCTR:	HRRZ	TA,DATLOC	;MAKE LINK & PTR TO ITEM'S DATAB ENTRY
	ADDI	TA,(TE)
	HRLI	TA,(TE)
	SUBI	TA,TC.DAT##	;SUBTRACT TABLE CODE BITS
	MOVEM	TA,CURDAT##
	PUSHJ	PP,RPWNAM##	;MAKE A NAME FOR THE GROUP ITEM ("RWITM...")
	MOVE	TA,[CD.DAT,,SZ.DAT]	;MAKE A DATAB ENTRY FOR SUM CTR
	PUSHJ	PP,GETENT##
	MOVEM	TA,(SAVPTR)	;SAVE LINK & PTR TO SUM CTR DATAB ENTRY
	HRRZ	TA,CURDAT	;MAKE PTR TO CORRESP RPWTAB ENTRY
	LDB	TB,DA.RPW
	HRRZ	TA,RPWLOC
	ADDI	TA,(TB)
	HLRZ	TB,(SAVPTR)	;PUT SUM CTR DATAB LINK IN RPWTAB
	DPB	TB,RW.SLK##
	HRRZ	TA,CURDAT	;GET GROUP ITEMS SAME NAME LINK
	LDB	TB,DA.SNL##
	SETZ	TC,		;& PUT 0 WHERE IT WAS
	DPB	TC,DA.SNL
	SETO	TC,		;& SET FAKE NAME BIT ON GP ITEM
	DPB	TC,DA.FAK##
	LDB	TD,DA.LNC##	;ALSO GET GROUP ITEM'S LINE POSITION
	LDB	TE,DA.INS##	;& SIZE
	LDB	TC,DA.NDP##	;& # OF DECIMAL PLACES
	HRRZ	TA,(SAVPTR)	;MOVE GROUP ITEMS SNL TO SUM CTRS SNL SLOT
	DPB	TB,DA.SNL
	DPB	TD,DA.LNC	;PUT GP ITEM'S LINE POS. IN SUM CTR ENTRY
	DPB	TE,DA.INS	; " SIZE
	DPB	TE,DA.EXS##
	DPB	TC,DA.NDP	; " # DEC. PLACES
	HRRZ	TA,CURDAT	; [315] GET DATA ITEM ADDRESS
	LDB	TB,DA.FAL	; [315] GET IS FATHER
	LDB	TC,DA.POP##	; [315] AND ITS POINTER
	HRRZ	TA,(SAVPTR)	; [315] GET SUM-CTR ITEM
	DPB	TB,DA.FAL	; [315] COPY ORIGINAL FATHER
	DPB	TC,DA.POP	; [315] AND ITS LINK INTO IT
	HRRZ	TD,EAS1PC##	;GET NEXT FREE DATA LOC
	DPB	TD,DA.LOC##	;STORE ASSIGNED LOC
	AOJ	TD,		;INCREMENT FOR 1-WORD SUM-CTR
	CAILE	TE,^D10		;SUM CTR MORE THAN 10 DIGITS?
	AOJ	TD,		;YES, NEED A 2-WORD CTR
	MOVEM	TD,EAS1PC	;& SAVE LAST USED
	HRRZI	TB,%CL.NU	;SET NUMERIC CLASS IN DATAB
	DPB	TB,DA.CLA
	HRRZI	TB,%US.1C	;& 1-WORD COMP USAGE
	CAILE	TE,^D10		;[434] IS IT 2-WORD COMP
	HRRZI	TB,%US.2C	;[434] YES
	DPB	TB,DA.USG
	HRRZI	TB,CD.DAT	;SET DATAB CODE
	DPB	TB,[POINT 3,(TA),2]
	HRRZI	TB,LVL.77	;MAKE SUM-CTR LEVEL 77
	DPB	TB,DA.LVL##
	DPB	TB,DA.PIC##	;SET PIC SEEN BIT
	DPB	TB,DA.SGN	;& SIGNED BIT
	DPB	TB,DA.SCT	;& SUM-CTR BIT
	DPB	TB,DA.DEF##	;& DEFINED BIT
	HRRZ	TB,NAMADR##	;PUT GROUP ITEMS DATAB LINK IN 'RWITM' NAMTAB ENTRY
	MOVE	TA,CURDAT
	HLRM	TA,(TB)
	LDB	TC,DA.NAM##	;GET GP ITEMS NAMTAB LINK
	HLRZ	TD,NAMADR	;& PUT LINK TO 'RWITM' IN ITS PLACE
	DPB	TD,DA.NAM
	HRRZ	TA,(SAVPTR)	;MOVE GP ITEMS NAMTAB LINK TO SUM CTR
	DPB	TC,DA.NAM
	HLRZ	TE,CURDAT	;NOW SUBSTITUTE SUM CTR FOR GP ITEM IN SNL CHAIN
	HRRZ	TA,NAMLOC##
	ADDI	TA,(TC)
	HRRZ	TB,(TA)
	CAIN	TB,(TE)
	JRST	DA103X
DA103L:	HRRZI	TC,(TB)
	ANDI	TC,077777
	HRRZ	TA,DATLOC
	ADDI	TA,(TC)
	HRRZ	TB,(TA)
	CAIE	TB,(TE)
	JRST	DA103L
DA103X:	MOVE	TB,(SAVPTR)
	HLRM	TB,(TA)
	POPJ	PP,
>;END IFN RPW
CLHDOC:	SUB	TA,FILLOC	;NOT A FILTAB REFERENCE
	ADD	TA,DATLOC	;BUT A DATAB REFERENCE
	SETZ	TC,
	DPB	TC,DA.DLL##	;CLEAR DEPENDING AT LOWER LEVEL SINCE ITS NOT
	PUSHJ	PP,CLHSUB	;GET PTR TO DATA ITEM
	SKIPE	TBLOCK+4	;UNDEFINED?
	JRST	CLHDOX		;YES
IFN ANS74,<
 	LDB	TB,DA.CLA	;CK CLASS OF ITEM
 	CAIE	TB,2		;NUMERIC?
 	PUSHJ	PP,CLE264	;NO
	LDB	TB,DA.USG	;GET USAGE
	CAIE	TB,%US.1C	;NO CONVERSION IF 1-WORD COMP
	CAIN	TB,%US.IN	;OR INDEX
	JRST	CLHDOD		;OK
	SETOB	TB,RELKEY	;NO, SIGNAL CONVERSION REQUIRED
	EXCH	TA,TBLOCK+1
	DPB	TB,DA.DCR##
	EXCH	TA,TBLOCK+1
CLHDOD:>
IFN ANS68,<
	LDB	TB,DA.USG	;[164] GET USAGE
	CAIE	TB,%US.1C	;[164] LEGAL ONLY IF 1-WORD COMP
	CAIN	TB,%US.IN	;[164]  OR INDEXED
	CAIA			;[164] OK
	PUSHJ	PP,CLE347	;[164] ERROR
>
	LDB	TB,DA.SUB##	;[1520][164] SEE IF SUBSCIPTED
	SKIPE	TB		;[164]  ILLEGAL IF SO
	PUSHJ	PP,CLE275	;[164]  ERROR
	LDB	TC,DA.DPR##	;DECIMAL PT. TO RIGHT?
	JUMPN	TC,CLHDOX	;YES, OK
 	LDB	TB,DA.NDP	;[164A] NUMBER OF DECIMAL PLACES
	JUMPE	TB,CLHDOX
	PUSHJ	PP,CLE264	;NOT AN INTEGER
CLHDOX:	MOVE	TC,DA.DEP##	;GET DEP-FOR-OCC PTR
	JRST	CLNSTO

CLHKOC:	TLZA	TE,-1		;0 = ASC. KEY FLAG
CLHDKY:	HRLI	TE,400000	;DESC. KEY FLAG
	SUB	TA,FILLOC
	ADD	TA,DATLOC
	MOVEM	TE,(TA)		;PUT KEY LINK & FLAG IN DATAB ENTRY WORD
	JRST	CLNHL9

IFN ISAM,<

CLHSKY:	PUSHJ	PP,CLHLNK	; [300] SEE IF IN LINKAGE SECTION
	MOVE	TC,FI.SKY##	;GET FILTAB SYMBOLIC KEY PTR
	JRST	CLNSTO		; [300] STORE POINTER

CLHRKY:	PUSHJ	PP,CLHLNK	; [300] SEE IF IN LINKAGE SECTION
	MOVE	TC,FI.RKY##	;GET FILTAB RECORD KEY PTR
	JRST	CLNSTO		; [300] STORE POINTER

;ALTERNATE KEY ENTRY

 IFN ANS74,<
CLHAKY:	HRRZ	TA,CURHLD	;GET CURRENT HLDTAB PTR
	LDB	TB,HL.LNK##	;LINK TO PLACE WHERE DATA LINK WANTED
	HRLZM	TB,CURAKT##	;STORE CURRENT PTR
	ADD	TB,AKTLOC##	;(THAT'S IN ALTERNATE KEY TABLE)
	MOVEI	TA,(TB)		;GET ABS. LOC OF TABLE ENTRY
	DPB	TE,AK.DLK##	;STORE DATAB LINK

;IF THIS IS FIRST ENTRY FOR THIS FILE, STORE FILTAB LINK TO THIS
;	AKTTAB ENTRY

	LDB	TA,AK.FLK##	;GET FILTAB LINK
	HRLZM	TA,CURFIL##	;REMEMBER THAT
	ADD	TA,FILLOC##	;GET ABS ADDR.
	LDB	TC,FI.ALK##	;IS LINK ALREADY SETUP FOR THIS FILE?
	JUMPN	TC,CLHAK1	;YES
	HLRZ	TC,CURAKT	;NO, MAKE IT POINT TO THIS ENTRY
	DPB	TC,FI.ALK##

;MAKE SURE IT IS DEFINED IN A RECORD FOR THIS FILE
;LH (CURFIL) NOW CONTAINS THE FILTAB ENTRY OFFSET.

CLHAK1:	MOVE	TA,TE		;GET LINK TO DATA ITEM
	PUSHJ	PP,LNKSET	;LOOK AT DATAB ENTRY
	LDB	TB,DA.DFS##	;IS IT DEFINED IN THE FILE SECTION?
	JUMPE	TB,CLHAKE	;NO, GIVE ERROR
CLHAK2:	LDB	TB,DA.DLL	;[1501] IS THERE A 'DEPENDING' CLAUSE?
	JUMPE	TB,CLHK2A	;[1501] NO, NO PROBLEM
	HRRZI	DW,E.612	;[1501] YES, ERROR
	PUSHJ	PP,CLHBA1	;[1501] SET UP HLTAB LN,CP; CALL FATAL

CLHK2A:	LDB	TB,DA.POP##	;FIND FILENAME
	LDB	TD,[POINT 3,TB,20] ;GET TYPE
	CAIN	TD,CD.FIL	;FILENAME?
	 JRST	CLHAK3		;YES - SEE IF IT'S THE ONE
	MOVE	TA,TB		;NOT AT TOP YET
	PUSHJ	PP,LNKSET	;UP TO NEXT LEVEL..
	JRST	CLHK2A		;[1533] LOOP UNTIL WE GET TO FILE
CLHAK3:	HLRZ	TA,CURFIL	;GET CURRENT FILE
	CAMN	TA,TB		;SAME FILE?
	JRST	CLNHL9		;YES, GO ON

;NOT DEFINED IN THIS FILE--GIVE ERROR
CLHAKE:	HRRZI	DW,E.379	;"RECORD KEY NOT IN RECORD"
	HLRZ	TA,CURFIL
	ADD	TA,FILLOC##
	LDB	LN,FI.LN	;POINT TO FILENAME
	LDB	CP,FI.CP
	PUSHJ	PP,FATAL##	;FATAL ERROR
	JRST	CLNHL9		;GO BACK FOR NEXT HLDTAB ENTRY
 >;END IFN ANS74
>;END IFN ISAM

CLHLNK:	MOVEM	TA,TBLOCK+1	; [300] SAVE STORAGE PTR
	SKIPE	TBLOCK+4	; [300] UNDEFINED ?
	POPJ	PP,		; [300] YES RETURN
	PUSH	PP,TE		; [300] SAVE ADDRESS OF KEY
	PUSHJ	PP,CLHSUB	; [300] CHECK IF IN LINKAGE SECTION-FLAG IF SO
	POP	PP,TE		; [300] RESTORE KEY ADDRESS
	POPJ	PP,		; [300] RETURN


;ACTUAL/RELATIVE KEY

CLHACK:	MOVEM	TA,TBLOCK+1	; SAVE STORAGE PTR [264]
	SKIPE	TBLOCK+4	;UNDEFINED?
	JRST	CLHACX		;YES
	MOVEM	TA,CURFIL	;SAVE FILTAB PTR
	PUSHJ	PP,CLHSUB	;GET USAGE OF DATA ITEM
IFN ANS68,<
	MOVE	TA,CURFIL	;RESTORE FILTAB PTR
	CAIE	TB,%US.1C	;1-WORD COMP?
	PUSHJ	PP,CLHBAD	;NO
	CAILE	TC,^D10		;10 DIGITS OR LESS?
	PUSHJ	PP,CLHSIZ	;NO
>
IFN ANS74!FT68274,<
	PUSH	PP,TE
IFN FT68274,<			;[1427]
	PUSHJ	PP,CLHSUB	;[1427] GET USAGE OF DATA ITEM
>				;[1427]
	LDB	TE,DA.SGN	;SEE IF SIGNED
	LDB	TA,DA.NDP	;OR NOT INTEGER
	SKIPN	TE
	SKIPE	TA
	PUSHJ	PP,CLHE40	;SHOULD BE UNSIGNED INTEGER
	POP	PP,TE
	MOVE	TA,CURFIL	;RESTORE FILTAB PTR
>
IFN ANS74,<
	CAIN	TB,%US.1C	;1-WORD COMP
	CAILE	TC,^D10
	CAIA			;NO
	JRST	CLHACX		;OK
	DPB	TE,FI.CKA##	;STORE REAL KEY
	SETOM	RELKEY##	;SIGNAL CONVERSION REQUIRED
	MOVEI	TE,AS.MSC##	;MARK AS MISC. FOR LATER INCR. TO %PARAM
>
CLHACX:	MOVE	TC,FI.ACK##	;ACT-KEY PTR
	JRST	CLNSTO
;REPLACE THE HLDTAB LINKS IN THE FILE STATUS ENTRIES OF A FILE TABLE
; BY DATAB LINKS.

;ENTRY CONDITIONS:
;	(TA)		ABS ADR OF FILE TABLE.
;	(TBLOCK+4)	0 IF THE ITEM IS UNIQUELY DEFINED.
;	(TE)		DATAB LINK.

CLHERS:	MOVE	TB,	FI.SPT##	;GET POINTER TO FILE STATUS LINKS.
	MOVEM	TB,	TBLOCK
	HRREI	TB,	-10		;-MAXIMUM NUMBER OF LINKS.
	MOVEM	TB,	TBLOCK+1
	HRRZ	TB,	CURHLD		;CURRENT HLDTAB ADDRESS.

CLHER1:	ILDB	TC,	TBLOCK		;GET A FILE STATUS LINK.
	JUMPE	TC,	CLHER2		;IF ITS ZERO SKIP IT.
	LDB	TD,	[POINT 3,TC,20]	;GET THE TABLE CODE.
	CAIN	TD,	CD.DAT		;DATAB?
	JRST		CLHER2		;YES, SKIP IT.
	ADD	TC,	HLDLOC		;MAKE IT ABSOLUTE.
	CAIE	TB,	(TC)		;IS THIS THE ONE? (IT SHOULD BE.)
	JRST		CLHER2		;NO, NEXT LINK.

;FOUND THE LINK - NOW WHAT TO DO WITH IT.

	SKIPN		TBLOCK+4	;WAS THE NAME OK?
	JRST		CLHER4		;YES, GO CHECK IT OUT.
	SETZ	TB,			;FLUSH THE LINK.
	DPB	TB,	TBLOCK
	JRST		CLNHL9		;GO LOOK AT THE NEXT HLDTAB ENTRY.

CLHER2:	AOSGE		TBLOCK+1	;ANY MORE LINKS?
	JRST		CLHER1		;YES, GO LOOK AT THE NEXT ONE.
	JRST		CLNHL9		;OTHERWISE GO LOOK AT THE NEXT HLDTAB ENTRY.


;COME HERE WHEN WE FIND A GOOD LINK.

CLHER4:	DPB	TE,	TBLOCK		;ASSUME THAT THE DATA IS GOOD.
	PUSH	PP,	TA		;BUT SAVE THE FILE TABLE ADDRESS
					; JUST IN CASE IT ISN'T.
	HRRI	TA,	(TE)		;SET UP TO LOOK AT DATAB.
	LDB	TB,	LNKCOD##	;MAKE SURE IT'S DATAB.
	CAIE	TB,	CD.DAT
	JRST		CLHE23		;IT ISN'T - COMPLAIN.
	ANDI	TA,	077777		;GET OFFSET.
	ADD	TA,	DATLOC		;MAKE IT ABSOLUTE.

;SEE WHERE TO GO NEXT.

	MOVE	TB,	TBLOCK+1
	JRST		@.+11(TB)
	EXP		CLHE4A		;DISPLAY.
	EXP		CLHE4A		;DISPLAY.
	EXP		CLHER9		;INDEX.
	EXP		CLHE4A		;DISPLAY.
	EXP		CLHER9		;INDEX.
	EXP		CLHER9		;INDEX.
	EXP		CLHE4A		;DISPLAY.
	EXP		CLHER9		;INDEX.

;CHECK THINGS THAT ALL DISPLAY ITEMS MUST HAVE - NO SIGN, DECIMAL PLACES, ETC.

;MACROS TO MAKE LIFE EASIER.

	DEFINE	AECK1 (FIELD, LOC)<
	LDB	TB,	FIELD'##
	JUMPN	TB,	LOC
>

	DEFINE	AECK2 (LOC, NUM)<
LOC':	MOVEI	DW,	E.'NUM
	JRST		CLHE30
>

CLHE4A:	AECK1	DA.SGN,CLHE22		;SIGNED?
	AECK1	DA.BWZ,CLHE21		;BLANK WHEN ZERO?
	AECK1	DA.SUB,CLHE20		;SUBSCRIPTED?
	AECK1	DA.EDT,CLHE19		;EDITED?
	AECK1	DA.JST,CLHE18		;JUSTIFIED?
	AECK1	DA.DFS,CLHE17		;FILE SECTION?
	AECK1	DA.LKS,CLHE16		;LINKAGE SECTION?
	AECK1	DA.NDP,CLHE15		;DECIMAL PLACES?

;NOW CHECK THINGS SPECIFIC TO EACH ITEM.

	DEFINE	AECK3 (SIZE, RTN)<BYTE (11)SIZE(25)RTN>

	MOVE	TB,	TBLOCK+1	;BET YOU THOUGHT I FORGOT ABOUT TBLOCK+1.
	JRST		@.+11(TB)
CLHER5:
IFN ANS68,<
	AECK3	2,CLHER6		;NUMERIC DISPLAY, 2 CHARS.
>
IFN ANS74,<
	AECK3	2,CLHE68		;ALPHANUMERIC OR NUMERIC DISPLAY, 2 CHARS.
>
	AECK3	12,CLHER6		;NUMERIC DISPLAY, 10 CHARS.
	EXP	KILL##			;INDEX, CAN'T GET HERE.
	AECK3	11,CLHER8		;ALPHANUMERIC DISPLAY, 9 CHARS.
	EXP	KILL##			;INDEX, CAN'T GET HERE.
	EXP	KILL##			;INDEX, CAN'T GET HERE.
	AECK3	36,CLHER8		;ALPHANUMERIC DISPLAY, 30 CHARS.
;CHECK FOR NUMERIC DISPLAY.

CLHER6:	LDB	TC,DA.CLA	;GET CLASS.
	CAIE	TC,%CL.NU	;NUMERIC?
	JRST	CLHE14		;NO.
CLHER7:	LDB	TC,DA.USG	;GET USAGE.
	CAIE	TC,%%US		;SKIP IF NO USAGE ASSIGNED.
	CAILE	TC,%US.DS	; FALL IF NOT SOME KIND OF DISPLAY.
	 JRST	CLHE13		;IT ISN'T DISPLAY
	LDB	TC,DA.EXS	;GET ITS SIZE.
	LDB	TB,[POINT 11,CLHER5+10(TB),10]	;GET THE RIGHT SIZE.
	CAIE	TB,(TC)		;SAME SIZE?
	JRST	CLHE12		;NO.

;EVERYTHING CHECKS OUT.

CLHE7E:	POP	PP,TA		;RESTORE THE STACK.
	JRST	CLNHL9		;GO LOOK FOR MORE HLDTAB ITEMS.

IFN ANS74,<
;CHECK FOR EITHER NUMERIC OR ALPHANUMERIC

CLHE68:	LDB	TC,DA.CLA	;GET THE CLASS
	CAIN	TC,%CL.NU	;NUMERIC?
	JRST	CLHER7		;YES.
				;NO, TEST FOR ALPHANUMERIC
>

;CHECK FOR ALPHANUMERIC.

CLHER8:	LDB	TC,DA.CLA	;GET THE CLASS.
	CAIE	TC,%CL.AN	;SKIP IF ALPHANUMERIC.
	 JRST	CLHE11		;NOPE - ERROR.
	JRST	CLHER7		;GO LOOK AT USAGE.

;CHECK FOR INDEX.

CLHER9:	LDB	TC,DA.USG	;GET USAGE.
	CAIN	TC,%US.IN	;INDEX?
	JRST	CLHE7E		;YES.

;FALL INTO ERROR CODE..
;COME HERE ON ERRORS.

	AECK2	CLHE10,551		;USAGE MUST BE INDEX.
	AECK2	CLHE11,552		;MUST BE ALPHANUMERIC.
	AECK2	CLHE12,553		;WRONG SIZE.
	AECK2	CLHE13,554		;MUST BE DISPLAY
	AECK2	CLHE14,555		;MUST BE NUMERIC.
	AECK2	CLHE15,556		;CAN'T HAVE DECIMAL PLACES.
	AECK2	CLHE16,557		;CAN'T BE IN LINKAGE SECTION.
	AECK2	CLHE17,558		;CAN'T BE IN FILE SECTION.
	AECK2	CLHE18,559		;CAN'T BE JUSTIFIED.
	AECK2	CLHE19,560		;CAN'T BE EDITED.
	AECK2	CLHE20,561		;CAN'T BE SUBSRCRIPTED.
	AECK2	CLHE21,562		;BLANK WHEN ZERO NOT ALLOWED.
	AECK2	CLHE22,563		;CAN'T BE SIGNED.
	AECK2	CLHE23,564		;IT ISN'T DATAB!!!

;PUT OUT AN ERROR MSG.

CLHE30:	HRRZ	TA,	CURHLD		;GET THE HLDTAB ENTRY.
	LDB	LN,	HL.LN##		;SET UP FOR ERROR.
	LDB	CP,	HL.CP##
	PUSHJ	PP,	FATAL##		;FATAL ERROR.
	POP	PP,	TA		;GET FILE TABLE LOC BACK.
	SETZ	TB,			;CLEAR THE LINK IN FILTAB.
	DPB	TB,	TBLOCK
	JRST		CLNHL9		;AND GO LOOK FOR MORE.

IFN ANS74!FT68274,<
CLHE40:	HRRZI	DW,E.723
	HRRZ	TA,CURHLD		;GET THE HLDTAB ENTRY.
	LDB	LN,HL.LN##		;SET UP FOR ERROR.
	LDB	CP,HL.CP##
	PJRST	WARN##
>
;MAKE INDEX ENTRY IN DATAB & LINK ITEM INDEXED TO IT

CLHIDX:	LDB	TB,HL.NAM##	;STASH HLDTAB INFO IN TBLOCK
	MOVEM	TB,TBLOCK	;NAMTAB LINK OF INDEX
	LDB	TB,HL.LNK
	MOVEM	TB,TBLOCK+1	;DATAB LINK OF INDEXED ITEM
	LDB	TB,HL.LNC##
	MOVEM	TB,TBLOCK+2	;LINE&CHAR POS. OF INDEX

	HRRZ	TA,TBLOCK	;LOOK FOR ITEM ALREADY IN DATAB
	HRRZI	TB,CD.DAT
	PUSHJ	PP,FNDLNK##
	  JRST	CLHID2		;NONE -- MAKE ONE

	HRRZI	TA,(TB)		;GET DATAB LINK
	HLRM	TB,TBLOCK+4	;SAVE A COPY
	LDB	TB,DA.IDX##	;IS THIS AN INDEX?
	JUMPN	TB,CLHID3	;[770] YES

	HRRZI	DW,E.297	;ILLEGAL INDEX
	LDB	LN,[POINT 13,TBLOCK+2,28]
	LDB	CP,[POINT 7,TBLOCK+2,35]
	PUSHJ	PP,FATAL##
	MOVEI	TB,1		;[770] GET A DUMMY DATA ITEM
	HRRZ	TA,CURHLD	;[770] CHANGE NAMTAB LINK OF INDEX ITEM
	DPB	TB,HL.NAM	;[770]   IN HLDTAB TO DATAB LINK
	JRST	CLNHL9

CLHID2:	MOVE	TA,[XWD CD.DAT,SZ.DAT]	;MAKE INDEX
	PUSHJ	PP,GETENT
	HLRZM	TA,TBLOCK+4	;SAVE LINK TO INDEX
	MOVE	TB,TBLOCK	;GET NAMTAB LINK OF INDEX
	DPB	TB,DA.NAM
	HRRZI	TB,CD.DAT
	DPB	TB,[POINT 3,(TA),2]
	HRRZI	TB,LVL.77
	DPB	TB,DA.LVL
	HRRZI	TB,%CL.NU
	DPB	TB,DA.CLA##
	HRRZI	TB,5
	DPB	TB,DA.INS
	DPB	TB,DA.EXS
	SETO	TB,
	DPB	TB,DA.SGN
	DPB	TB,DA.PIC
	DPB	TB,DA.IDX	;SET INDEX BIT
	HRRZI	TB,%US.IN
	DPB	TB,DA.USG##
	MOVE	TB,TBLOCK+2	;SAVE LINE & CHAR POS.
	DPB	TB,DA.LNC
	HRRZ	TB,EAS1PC	;ALLOCATE WORD IN AS1FIL FOR INDEX
	DPB	TB,DA.LOC
	HRRZI	TB,44
	DPB	TB,DA.RES
	SETO	TB,
	DPB	TB,DA.DEF
	AOS	EAS1PC
	LDB	TB,DA.NAM
	HRRI	TA,(TB)
	PUSHJ	PP,PUTLNK##

CLHID3:	HRRZ	TA,CURHLD	;CHANGE NAMTAB LINK OF INDEX ITEM
	MOVE	TB,TBLOCK+4	;  IN HLDTAB TO DATAB LINK
	DPB	TB,HL.NAM
	JRST	CLNHL9
CLHVID:	MOVEM	TA,TBLOCK+1	;[152] SAVE STORAGE PTR
	SKIPE	TBLOCK+4	;UNDEFINED?
	JRST	CLHVIX		;YES
	PUSHJ	PP,CLHSUB	;GET USAGE OF DATA ITEM
	CAIE	TB,%%US		;USAGE MUST BE DISPLAY
	CAILE	TB,%US.DS
	 PUSHJ	PP,CLHBAD	;WRONG USAGE
	CAIE	TC,^D9		;9 CHARS?
	 PUSHJ	PP,CLHSIZ	;NO
CLHVIX:	MOVE	TC,FI.VID##	;VAL-OF-ID PTR
	JRST	CLNSTO

CLHVDW:	MOVEM	TA,TBLOCK+1	;[152] SAVE STORAGE PTR
	SKIPE	TBLOCK+4	;UNDEFINED?
	JRST	CLHVDX		;YES
	PUSHJ	PP,CLHSUB	;GET USAGE OF DATA ITEM
	CAIE	TB,%%US		;MUST BE DISPLAY
	CAILE	TB,%US.DS	;SKIP IF IT IS
	 PUSHJ	PP,CLHBAD	;WRONG USAGE
	CAIE	TC,6		;6 DIGITS?
	 PUSHJ	PP,CLHSIZ	;NO
CLHVDX:	MOVE	TC,FI.VDW##	;VAL-OF-DATE-WRITTEN PTR
	JRST	CLNSTO

CLHVPP:	MOVEM	TA,TBLOCK+1	;[152] SAVE STORAGE PTR
	SKIPE	TBLOCK+4	;UNDEFINED?
	 JRST	CLHVPX		;YES
	PUSHJ	PP,CLHSUB	;GET USAGE OF DATA ITEM
	CAIE	TB,%US.1C	;1-WORD COMP?
	 PUSHJ	PP,CLHBAD	;NO
	CAILE	TC,^D10		;10 DIGITS OR LESS?
	 PUSHJ	PP,CLHSIZ	;NO
CLHVPX:	MOVE	TC,FI.VPP##	;VAL-OF-PROJ-PROG PTR
CLNSTO:	MOVE	TA,TBLOCK+1	;GET BACK STORAGE PTR
CLNST1:	LDB	TB,TC		;SEE IF ITEM ALREADY STORED
	JUMPE	TB,CLNST2
	PUSHJ	PP,CLHDUP	;YES, DUPLICATE CLAUSE
CLNST2:	DPB	TE,TC		;NO, STORE ITEM
	JRST	CLNHL9		;GO BACK FOR NEXT HLDTAB ENTRY

CLHLFL:	SKIPE	TBLOCK+4	;UNDEFINED?
	JRST	CLHLFX		;YES
	PUSHJ	PP,CLHSUB	;GET USAGE OF DATA ITEM
	CAIE	TB,%US.1C	;1-WORD COMP?
	PUSHJ	PP,CLHBAD	;NO
	CAILE	TC,^D10		;10 DIGITS OR LESS?
	PUSHJ	PP,CLHSIZ	;NO
	MOVE	TA,TBLOCK+1	;GET BACK STORAGE PTR
CLHLFX:	HRLM	TE,(TA)		;STORE DATAB LINK
	JRST	CLNHL9		;GO BACK FOR NEXT HLDTAB ENTRY

CLHHFL:	SKIPE	TBLOCK+4	;UNDEFINED?
	JRST	CLHHFX		;YES
	PUSHJ	PP,CLHSUB	;GET USAGE OF DATA ITEM
	CAIE	TB,%US.1C	;1-WORD COMP?
	PUSHJ	PP,CLHBAD	;NO
	CAILE	TC,^D10		;10 DIGITS OR LESS?
	PUSHJ	PP,CLHSIZ	;NO
	MOVE	TA,TBLOCK+1	;GET BACK STORAGE PTR
CLHHFX:	HRRM	TE,(TA)		;STORE DATAB LINK
	JRST	CLNHL9		;GO BACK FOR NEXT HLDTAB ENTRY

CLHSUB:	MOVEM	TA,TBLOCK+1	;SAVE STORAGE PTR
	HRRZ	TA,CURHLD	;[162] GET HLDTAB CODE
	LDB	TC,HL.COD	;[162]  TO TC
	MOVE	TA,TE		;GET ITEM DATAB LINK
	ANDI	TA,77777	;MAKE DATAB PTR
	ADD	TA,DATLOC##
	LDB	TB,DA.LKS##	;[162] GET LINKAGE SECTION FLAG
	CAIE	TC,15		;[162] IF FLAG ON AND CODE IS SYM-KEY
 	CAIG	TC,6		;[162]  ACT-KEY, FIL-LIM, VAL-OF-ID, DW OR PPN
	JUMPN	TB,CLHLER	;[162]  GIVE ERROR MESSAGE
CLHSU2:	LDB	TB,DA.USG	;[162] GET USAGE
	LDB	TC,DA.EXS	;& SIZE
	POPJ	PP,

CLHLER:	PUSH	PP,TA		;[162] SAVE DATAB PTR
	HRRZI	DW,E.493	;[162] NOT ALLOWED IN LINKAGE SECT.
	PUSHJ	PP,CLHBA1	;[162] COMPLAIN
	POP	PP,TA		;[162] RESTORE
	JRST	CLHSU2		;[162] CONTINUE

CLHBAD:	HRRZI	DW,E.373	;WRONG USAGE
CLHBA1:
	PUSH	PP,TA		;[164] SAVE DATA-POINTER
	HRRZ	TA,CURHLD	;HLDTAB ADDR
	LDB	LN,HL.LN##	;GET LINE POSITION
	LDB	CP,HL.CP##
	PUSHJ	PP,FATAL	;GIVE ERROR MESSAGE
	MOVEI	TE,<CD.DAT>B20+1	;AIM AT DUMMY DATAB ENTRY
	POP	PP,TA		;[164] RESTORE DATA-POINTER
	POPJ	PP,

CLHDUP:	HRRZI	DW,E.16		;DUPLICATE CLAUSE MESSAGE
	JRST	CLHBA1

CLHSIZ:	HRRZI	DW,E.340	;WRONG SIZE
	JRST	CLHBA1

CLE264:	HRRZI	DW,E.264	;WRONG CLASS
	JRST	CLHBA1

CLE275:	HRRZI	DW,E.275	;[164] NO SUBSCRIPTING ALLOWED
	JRST	CLHBA1		;[164]

IFN ANS68,<
CLE347:	HRRZI	DW,E.347	;[164] DEPEND ITEM MUST BE COMP
	JRST	CLHBA1		;[164]
>
CLNFIL:	MOVE	TA,AS2BUF##	;SET
	MOVEM	TA,.JBFF##	;  UP
	OUTBUF	AS2,2		;  AS2FIL
	MOVE	TA,FILLOC
	CAMN	TA,FILNXT##
	JRST	CLNCON		;CLEAN UP CONTAB LITERALS
	HRRZI	TA,CD.FIL*1B20+1
CLNC:	HRLZM	TA,CURFIL##
	PUSHJ	PP,LNKSET
	HRRM	TA,CURFIL
	LDB	TB,FI.DRL	;ANY DATA RECORD?
	JUMPN	TB,CLNC0	;YES
IFN RPW,<
	LDB	TB,FI.RPG##	;NO - REPORT FILE?
	JUMPN	TB,CLNCRP	;YES
	>
	MOVEI	TB,<CD.DAT>B20+1	;NO, AIM AT DUMMY ENTRY
	DPB	TB,FI.DRL
	LDB	TB,FI.FDD##	;IS THERE ANY FD?
	JUMPE	TB,CLNC0	;NO, THAT'S WHY WE DIDN'T FIND A DATA RECORD.
				; DON'T GIVE THIS ERROR AND THAT ONE TOO.
	HRRZI	DW,E.38		;?NO DATA RECORD
	LDB	LN,FI.FLN##	;POINT TO FD
	LDB	CP,FI.FCP##
	PUSHJ	PP,FATAL
	JRST	CLNC0		;CONTINUE
CLNCRP:
IFN RPW,<
	PUSHJ	PP,RPWNAM	;MAKE A NAME FOR REPORT RECORD
	MOVE	TA,[CD.DAT,,SZ.DAT]
	PUSHJ	PP,GETENT
	MOVEI	TB,%US.D7	;DISPLAY-7 USAGE IN CORE
	DPB	TB,DA.USG
	MOVEI	TB,^D132	;RECORD SIZE = 132 CHARS.
	DPB	TB,DA.INS
	DPB	TB,DA.EXS
	MOVEI	TB,^D36		;BYTE RESIDUE
	DPB	TB,DA.RES
	MOVEI	TB,1		;LEVEL 01
	DPB	TB,DA.LVL
	DPB	TB,DA.PIC	;SAY PIC SEEN
	DPB	TB,DA.DFS##	;DEFINED IN FILE SECTION
	DPB	TB,DA.DRC##	;DATA RECORD
	DPB	TB,DA.DEF	;SAY DEFINED
	DPB	TB,DA.FAK	;SAY FAKE NAME
	DPB	TB,DA.FAL##	;SET FATHER LINK BIT (FILE IS FATHER)
	HLRZ	TB,NAMADR	;STORE NAMTAB LINK TO DATA ENTRY
	DPB	TB,DA.NAM
	MOVEI	TB,%CL.AN	;ALPHANUMERIC CLASS
	DPB	TB,DA.CLA
	HLRZ	TB,CURFIL	;FILE = FATHER LINK
	DPB	TB,DA.BRO##
	HRRZ	TB,NAMADR	;PUT LINK TO DATA ENTRY IN NAMTAB
	HLRM	TA,(TB)
	MOVS	TC,TA		;LINK FILE TO NEW DATA RECORD
	HRRZ	TA,CURFIL
	DPB	TC,FI.DRL
	MOVEI	TB,^D132	;RECORD SIZE
	DPB	TB,FI.MRS##
	MOVEI	TB,%RM.7B	;ASCII RECORDING MODE
	DPB	TB,FI.ERM##
	DPB	TB,FI.IRM##
	MOVEI	TB,1		;RECORDING MODE DECLARED
	DPB	TB,FI.RM2##
	LDB	TB,FI.LNC##	;GET FILE DEFINITION LINE POSITION
	MOVS	TA,TC		;GET BACK PTR TO DATAB ENTRY
	DPB	TB,DA.LNC	;RECORD DEFN POSITION = FILE DEF. POS.
	>
CLNC0:	HRRZ	TA,CURFIL
IFN ANS74,<			;SET DEFAULT ACCESS MODE
; THIS WILL INSURE THAT ALL CODE GENERATION AND PHASE D PROCESSING
;TREATS UNSPECIFIED ACCESS MODE AS IF THE USER HAD SAID "ACCESS MODE
;IS SEQUENTIAL". 
	LDB	TB,FI.FAM##	;FILE ACCESS MODE
	CAIE	TB,%FAM.U	;UNSPECIFIED?
	 JRST	.+3		;NO, USE VALUE GIVEN
	MOVEI	TB,%FAM.S	; DEFAULT TO SEQUENTIAL ALWAYS
	DPB	TB,FI.FAM##

; NOW CHECK FOR MISSING "ORGANIZATION" CLAUSE. THIS WILL DEFAULT
;TO SEQUENTIAL,DI UNLESS WE CAN GUESS THAT THE USER MEANT SOMETHING ELSE.
;HE SPECIFIED ALTERNATE KEYS WE WILL COMPLAIN AND SET THE ORGANIZATION TO "INDEXED".
	LDB	TB,FI.ORG	;GET ORGANIZATION
	CAIE	TB,%%ACC	;UNSPECIFIED?
	JRST	CLNC1		;NO, SKIP THIS
	LDB	TC,FI.AKS##	;WERE ALTERNATE KEYS SPECIFIED?
	JUMPN	TC,CLNC0A	;YES, GIVE WARNING & SET TO "INDEXED"
	LDB	TC,FI.RKY	;DO WE HAVE A RECORD KEY?
	JUMPN	TC,CLNC0I	;YES, THEN ASSUME "INDEXED"
	LDB	TC,FI.ACK	;DO WE HAVE A RELATIVE KEY?
	JUMPN	TC,CLNC0R	;YES, THEN ASSUME "RELATIVE"
	LDB	TC,FI.FAM	;GET FILE ACCESS MODE
	CAIN	TC,%FAM.S	;SEQUENTIAL?
	JRST	CLNC0S		;YES, MAKE ORGANIZATION SEQUENTIAL
	MOVEI	DW,E.205	;MUST BE REL OR INDEX ORG
	MOVEI	TB,%ACC.S	;BUT MAKE IT SEQUENTIAL SINCE WE DON'T KNOW WHICH
	JRST	CLNC0E

CLNC0R:	MOVEI	DW,E.743	;MUST BE RELATIVE IF RECORD KEY SEEN
	MOVEI	TB,%ACC.R	;SET IT
	JRST	CLNC0E

CLNC0A:	SKIPA	DW,[E.736]	;ALTERNATE KEYS ONLY ALLOWED WITH INDEXED FILES
CLNC0I:	MOVEI	DW,E.744	;MUST BE INDEXED IF RECORD KEY SEEN
	MOVEI	TB,%ACC.I	;SET TO DEFAULT "INDEXED"
CLNC0E:	DPB	TB,FI.ACC##
	LDB	LN,FI.LN##	;POINT TO "SELECT" CLAUSE
	LDB	CP,FI.CP##
	PUSHJ	PP,FATAL	;PRESERVES TA
	JRST	CLNC1

CLNC0S:	MOVEI	TB,%ACC.S	;SET TO DEFAULT "SEQUENTIAL"
	DPB	TB,FI.ORG
CLNC1:
>;END IFN ANS74
	LDB	TB,FI.NDV##	;NUMBER OF DEVICES
	JUMPLE	TB,PFL		;NONE
	MOVEM	TB,NDEV##
	SETZM	(SAVPTR)	;CLR FLAG
	CAIE	TB,1		;ONLY ONE DEVICE NAMED?
	JRST	CLNC2		;NO, FORGET THIS STUFF
IFN ANS68,	LDB	TC,FI.ACC##	;INDEXED?
IFN ANS74,	LDB	TC,FI.ORG##
	CAIE	TC,%ACC.I
	JRST	CLNC2		;NO
	SETOM	(SAVPTR)	;YES, SET FLAG
	DPB	TC,FI.NDV	;SAY 2 DEVICES
CLNC2:	LDB	TB,FI.VAL##
	JUMPE	TB,PFL		;LINK IS NULL
	HRLZM	TB,CURVAL##
	HRRZ	TA,TB
	PUSHJ	PP,LNKSET
	HRRM	TA,CURVAL
	PUSHJ	PP,GETTAG##
	HRRZ	TA,CURFIL
	DPB	CH,FI.VAL
	PUSHJ	PP,PUTTAG
	MOVE	TA,CURVAL	;SAVE CURVAL IN CASE WE NEED SAME DEV TWICE
	MOVEM	TA,1(SAVPTR)
PDEV:	SETZ	TA,
	PUSHJ	PP,PUTVAL
	AOSE	(SAVPTR)	;INDEXED FILE WITH ONLY ONE DEVICE?
	JRST	PDEV2		;NO
	MOVE	TA,1(SAVPTR)	;YES, REPEAT SAME DEVICE
	MOVEM	TA,CURVAL
	JRST	PDEV

PDEV2:	SOSLE	NDEV
	JRST	PDEV
	HRRZ	TA,CURFIL
PFL:
IFN ANS68,<
	LDB	TB,FI.NFL##
	JUMPLE	TB,CHID		;NO FILE LIMITS
	ASH	TB,1
	MOVEM	TB,CFLM##
	ADDI	TA,SZ.FIL
	HRLI	TA,442200
	MOVEM	TA,PNTS##
PFL1:	ILDB	TA,PNTS
	SETZ	TE,
	JUMPE	TA,PFCNT
	LDB	TB,[POINT	3,TA,20]
	CAIE	TB,CD.VAL
	JRST	PFC1
	PUSHJ	PP,GETTAG
	MOVEM	CH,TBLOCK+12
	PUSHJ	PP,PUTTAG
	HRLZM	TA,CURVAL
	PUSHJ	PP,LNKSET
	HRRM	TA,CURVAL
	HRRZI	TA,1
	PUSHJ	PP,PUTVAL
	MOVE	TE,TBLOCK+12
PFCNT:	DPB	TE,PNTS
PFC1:	SOSLE	CFLM
	JRST	PFL1
>
IFN ANS74,<
;HERE FOR LINAGE-COUNTER

PLC:	LDB	TB,FI.LCP##
	JUMPE	TB,CHID		;NO LINAGE-COUNTER FOR THIS FILE
	MOVE	TB,[[SIXBIT /LINAGE:COUNTER/],,NAMWRD##]
	BLT	TB,NAMWRD+2
	SETZM	NAMWRD+3
	SETZM	NAMWRD+4	;SETUP NAME
	PUSHJ	PP,TRYNAM##
	  HALT			;MUST BE THERE!
	MOVE	TB,(TA)		;GET TYPE
	HLLZ	TA,TA		;ASSUME FIRST TIME
	TLO	TA,AS.DAT##	;TURN ON DATAB BIT
	PUSH	PP,TA		;SAVE POINTER TO NAMTAB
	TLNN	TB,NAMRSV/1000000	;FIRST TIME = RESERVED WORD
	HRRM	TB,0(PP)	;NO, SAVE CURRENT DATAB
	MOVE	TA,[CD.DAT,,SZ.DAT+SZ.DOC+SZ.MSK]
	PUSHJ	PP,GETENT	;GET SPACE FOR IT
	POP	PP,(TA)		;SAVE POINTER TO NAMTAB
	HLRZ	TB,CURFIL	;GET PTR. TO FILTAB
	DPB	TB,DA.POP
	MOVEI	TB,%US.1C	;MAKE IT 1-WORD COMP
	DPB	TB,DA.USG
	MOVEI	TB,%CL.NU	;AND NUMERIC
	DPB	TB,DA.CLA
	SETO	TB,
	DPB	TB,DA.FAL	;LINK IS TO FATHER
	DPB	TB,DA.DEF	;DEFINED
	MOVEI	TB,^D10		;MAX. SIZE
	DPB	TB,DA.EXS	;EXTERNAL SIZE
	DPB	TB,DA.INS	;INTERNAL SIZE
	PUSH	PP,TA		;SAVE LINK
	PUSHJ	PP,TRYNAM	;GET NAME LINK AGAIN
	  JFCL
	POP	PP,TB
	HLRZM	TB,(TA)		;CHANGE TO DATAB ENTRY
	HRRZ	TA,CURFIL
	HLRZ	TB,TB
	DPB	TB,FI.LCP	;MAKE FILE POINT TO DATAB
>

CHID:	HRRZ	TA,CURFIL
	LDB	TB,FI.VID
	JUMPE	TB,CHID2	;NO VALUE-OF-ID
	LDB	TC,[POINT	3,TB,20]
	CAIE	TC,CD.VAL
	JRST	CHID.1		;NOT A LITERAL
	HRLZM	TB,CURVAL
	HRRZ	TA,TB
	PUSHJ	PP,LNKSET
	HRRM	TA,CURVAL
	PUSHJ	PP,GETTAG
	HRRZ	TA,CURFIL
	DPB	CH,FI.VID
	PUSHJ	PP,PUTTAG
	SETZ	TA,
	PUSHJ	PP,PUTVAL
	JRST	CHID2

CHID.1:	CAIE	TC,CD.DAT
	JRST	CHID2
	HRRZI	TA,(TB)
	PUSHJ	PP,LNKSET
	LDB	TB,DA.DEF
	JUMPE	TB,CHID2	;[270] NOT DEFINED
	LDB	TB,DA.USG
	CAIE	TB,%%US		;CHECK FOR LEGAL DISPLAY USAGE
	CAILE	TB,%US.DS	;SKIP IF SOME KIND OF DISPLAY..
	 JRST	CHIDE2		;NO, GIVE ERROR
CHID.3:	LDB	TB,DA.EXS
	CAIN	TB,^D9		;MUST BE NINE CHARACTERS
	 JRST	CHID2		;OK, GO CHECK VALUE OF PROJ-PROG

;VALUE-OF-ID WAS NOT A DISPLAY ITEM 9 CHARACTERS IN LENGTH
CHIDE2:	HRRZI	DW,E.62
	PUSHJ	PP,FATALE
;CHECK VALUE OF PROJ-PROG
CHID2:	HRRZ	TA,CURFIL
	LDB	TB,FI.VPP
	JUMPE	TB,CHID3	;NONE SPECIFIED
	LDB	TC,[POINT 3,TB,20]
	CAIE	TC,CD.VAL
	JRST	CHID.5		;NOT A LITERAL
	HRLZM	TB,CURVAL
	HRRZI	TA,(TB)
	PUSHJ	PP,LNKSET
	HRRM	TA,CURVAL
CHID.6:	PUSHJ	PP,GETTAG
	HRRZ	TA,CURFIL
	DPB	CH,FI.VPP
	PUSHJ	PP,PUTTAG
	HRLZI	CH,AS.XWD##
	HRRI	CH,1
	PUSHJ	PP,PUTAS2##
	AOS	EAS2PC##
	PUSHJ	PP,PUTOCT
	PUSHJ	PP,PUTOCT
	JRST	CHID3
CHID.5:	CAIE	TC,CD.DAT
	JRST	CHID3
	HRRZI	TA,(TB)
	PUSHJ	PP,LNKSET
	LDB	TB,DA.USG
	CAIN	TB,%US.1C
	JRST	CHID3
	HRRZI	DW,E.366	;?PPN MUST BE 1-WORD COMP
	HRRZ	TA,CURFIL
	LDB	LN,FI.LN##
	LDB	CP,FI.CP##	;[270] MAKE SOURCE CHAR POS EXT
	PUSHJ	PP,WARN##
	JRST	CHID.6
CHID3:	HRRZ	TA,CURFIL
	LDB	TB,FI.VDW
	JUMPE	TB,CHDATS	;NO VALUE-OF-DATE-WRITTEN
	LDB	TC,[POINT 3,TB,20]
	CAIE	TC,CD.VAL
	JRST	CHDATS		;NOT A LITERAL
	HRLZM	TB,CURVAL
	HRRZ	TA,TB
	PUSHJ	PP,LNKSET
	HRRM	TA,CURVAL
	LDB	TB,[POINT 7,(TA),6]
	CAIN	TB,6		;SKIP IF NOT SIX CHARACTERS
	 JRST	CH2.1
	CAILE	TB,6		;IF LESS THAN SIX,
	HRRZI	TB,6		;PRETEND IT IS SIX
	DPB	TB,[POINT 7,(TA),6]
	HRRZI	DW,E.63
	HRRZ	TA,CURFIL
	LDB	LN,FI.LN
	LDB	CP,FI.CP
	PUSHJ	PP,WARN
CH2.1:	PUSHJ	PP,GETTAG
	HRRZ	TA,CURFIL
	DPB	CH,FI.VDW
	PUSHJ	PP,PUTTAG
	SETZ	TA,
	PUSHJ	PP,PUTVAL
;CHECK TO INSURE ALL RECORDS FOR THIS FILE ARE < 4096 CHARACTERS
;AND THAT OCCURS DOES NOT APPEAR AT 01 LEVEL

CHDATS:	SETZM	RUSAGE##	;CLEAR USAGE FLAG
	HRRZ	TA,CURFIL	;GET ADDRESS OF FILTAB ENTRY
	LDB	TA,FI.DRL##	;GET RECORD LINK
	JUMPE	TA,CLNCUP	;IF ZERO--FORGET IT

CHDA.1:	PUSHJ	PP,LNKSET	;GET RECORD ADDRESS
	MOVEM	TA,CURDAT	;[1502] SAVE OFFSET
	LDB	TE,DA.USG	;GET USAGE OF RECORD
	CAIE	TE,%US.D7	;DISPLAY-7?
	HRRZI	TE,%US.D6	;NO, ASSUME DISPLAY-6

	SKIPN	RUSAGE		;SEEN 1ST RECORD BEFORE THIS?
	MOVEM	TE,RUSAGE	;NO, SAVE USAGE OF 1ST
	CAMN	TE,RUSAGE	;YES, THIS USAGE CONFLICT WITH 1ST RECORD?
	JRST	CHDA.5		;[1502] NO

	MOVEI	DW,E.33		;YES, ERROR
	HRRM	TA,CURDAT	;SAVE DATAB PTR
	HRRZ	TA,CURFIL	;GET FILTAB PTR
	LDB	LN,FI.LN
	LDB	CP,FI.CP
	PUSHJ	PP,FATAL
	HRRZ	TA,CURDAT	;GET BACK DATAB PTR

CHDA.5:	LDB	TE,DA.EXS	;[1502] GET EXTERNAL SIZE
	CAIG	TE,MAXFSS##	;GREATER THAN LARGEST ALLOWED SIZE?
	JRST	CHDA.4		;[1502] NO
	MOVEI	DW,E.322	;YES
	PUSHJ	PP,FATALE	; PUT OUT DIAGNOSTIC
	JRST	CHDA.3		;[1502] 

CHDA.4:	HRRZ	TA,CURFIL	;[1502]
	LDB	TD,FI.MRS	;[1502] GET MAX RECORD SIZE
	HRRZ	TA,CURDAT	;[1502] RESTORE HERE
	CAML	TE,TD		;[1502] IS CURRENT 01 LEVEL SMALLER
	JRST	CHDA.3		;[1502]  THAN MAX FOUND?
	MOVEI	DW,E.660	;[1502] YES, GIVE WARNING
	LDB	LN,DA.LN	;[1502] SET UP LINE NBR
	LDB	CP,DA.CP	;[1502]  AND CHARACTER POSITION
	PUSHJ	PP,WARN		;[1502]

CHDA.3:	LDB	TE,DA.OCC##	;OCCURS AT 01 LEVEL?
	JUMPE	TE,CHDA.2	;NO
	MOVEI	DW,E.325	;YES, FLAG IT
	PUSHJ	PP,FATALE

CHDA.2:	LDB	TE,DA.FAL	;IS BROTHER/FATHER LINK
	JUMPN	TE,CLNCUP	;  A FATHER?
	LDB	TA,DA.BRO	;NO--LOOK AT NEXT RECORD
	JUMPN	TA,CHDA.1

CLNCUP:	HRRZ	TA,CURFIL
	LDB	TA,FI.NXT##
	JUMPN	TA,CLNC		;NEXT FILE TABLE
CLNCON:	MOVE	TA,CONLOC##
	CAMN	TA,CONNXT##
	POPJ	PP,
	HRRZI	TA,CD.CON*1B20+1
	HRLZM	TA,CURCON##
	PUSHJ	PP,LNKSET
C0.:	HRRM	TA,CURCON
	LDB	TB,CO.NVL
	LDB	TA,CO.DAT##
	LSH	TB,1
	HRRZM	TB,TBLOCK+1
	JUMPE	TA,C3.
	CAIN	TA,CD.DAT*1B20+1	;[644] TEST FOR DUMMY DATAB ENTRY
	JRST	C3B.		;[1066] [644] WHICH IS SET IF ERROR IN 01 LEVEL
	JUMPE	TB,C3.		;[454] IF NO LITERAL ENTRIES DUE TO ERROR GO ON
	HRLZM	TA,CURDAT
	PUSHJ	PP,LNKSET
	HRRM	TA,CURDAT
	LDB	LN,DA.LN	;PREPARE TO POINT TO THE DATA ITEM (NOT
	LDB	CP,DA.CP	; THE LEVEL 88 ITEM) IF ERRORS FOUND
	MOVE	TE,[POINT 18,SZ.CON(TA)]
	MOVEM	TE,PNTS##
C1.:	HRRZ	TA,CURCON
	ILDB	TA,PNTS		;GET ADDRESS OF LITTAB ENTRY
	ANDI	TA,077777	;JUST GET OFFSET
	JUMPE	TA,C2.		;?MUST BE NON-ZERO,
				; ENTRY IS SCREWED UP, FORGET IT
	IORI	TA,CD.LIT*1B20	;LOOK AT LITAB ENTRY
	HRLZM	TA,CURLIT
	PUSHJ	PP,LNKSET
	HRRM	TA,CURLIT	;CURLIT SET UP TO POINT TO LITAB ENTRY

;31-DEC-80 /DAW: There is a check that should be made here at some later
; date. Now, there is one user error that gets through undiagnosed:
; If there is a group item usage INDEX, and a subordinate item has 88 level
; items with value clauses, they were not checked for the correct
; class in COBOLC since the class had not been determined yet at that
; point (see edit 1106 in COBOLC).
;  What should be done is to check the consistancy of the item's usage
;now, and if it is not consistant, and a father of the item is usage
;INDEX, then DIAG 241 or 236 should be given and should point to
;the value literal for the each 88 item in error. Note this requires
;that CONTAB or LITAB be expanded to contain the LN and CP of the clause.

	PUSHJ	PP,ADJUST	;CREATE LITERAL OF PROPER SIZE FOR ITEM
	HRRZ	TA,CURLIT
	LDB	TB,LI.FGC
	JUMPE	TB,C1.5
	LDB	TC,LI.FCC
	HRRZ	TA,CURCON
	LDB	TB,PNTS
	ANDI	TB,400000
	TRO	TB,200000
	CAIN	TC,SPACE.
	TRO	TB,040000
	CAIN	TC,ZERO.
	TRO	TB,20000
	CAIN	TC,QUOTE.
	TRO	TB,10000
	CAIN	TC,HIVAL.
	TRO	TB,4000
	CAIN	TC,LOVAL.
	TRO	TB,2000
	DPB	TB,PNTS
	JRST	C2.
C1.5:	PUSHJ	PP,GETTAG
	HRRZ	TA,CURCON
	LDB	TB,PNTS
	ANDI	TB,7B20
	HRRZI	TC,(CH)
	ANDI	TC,077777
	IORI	TB,(TC)
	DPB	TB,PNTS
	PUSHJ	PP,PUTTAG
	PUSHJ	PP,PUTLIT
C2.:	SOSLE	TBLOCK+1
	JRST	C1.
C3.:	HRRZ	TA,CURCON
	LDB	TB,CO.NVL##
C3A.:	ADDI	TA,SZ.CON(TB)	;[1066] NEW LABEL
	HRRZ	TC,CONNXT
	CAIG	TA,(TC)		;SKIP IF WE ARE DONE ALL ENTRIES IN CONTAB
	JRST	C0.
	POPJ	PP,

;[1066] THIS PREVENTS "?ILL MEM REF" IN PHASE E, BY TELLING
;[1066] IFCGEN THAT THERE ARE NO "VALUE" ITEMS (ACTUALLY THERE
;[1066] ARE, BUT THE CONVERSION CODE ABOVE DID NOT GET EXECUTED
;[1066] SO THE CONTAB ENTRY WOULD BE MESSED UP). NO CODE GENERATION
;[1066] IS THEN ATTEMPTED.
C3B.:	HRRZ	TA,CURCON	;[1066]
	LDB	TB,CO.NVL##	;[1066] NUMBER OF WORDS TO FOLLOW
	SETZ	TC,		;[1066] SET NUMBER OF VALUE ITEMS TO 0
	DPB	TC,CO.NVL##	;[1066] SO PHASE E KNOWS THIS IS A BOGUS ENTRY
	JRST	C3A.		;[1066] GO ON TO NEXT CONTAB ENTRY
PUTLIT:	HRRZ	TA,CURDAT
	LDB	TB,DA.USG
	JRST	.+1(TB)
	POPJ	PP,
	JRST	PTLDSP		;DISPLAY-6
	JRST	PTLDSP		;DISPLAY-7
	JRST	PTLDSP		;DISPLAY-9
	JRST	PTL1WC		;1-WORD COMP
	JRST	PTL2WC		;2-WORD COMP
	JRST	PTLC1		;COMP-1
	JRST	PTL1WC		;INDEX
	JRST	PTLDSP		;COMP-3 (PRETEND IT'S DISPLAY-9)
	JRST	PTLC2		;COMP-2

;MAKE SURE THE ABOVE TABLE 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	%PUTLIT - TABLE IS MESSED UP.
>

PTL1WC:	MOVE	CH,[XWD 600000+ASCD1,1]
	PUSHJ	PP,PUTAS2
	MOVE	CH,VALUE2
	AOS	EAS2PC
	JRST	PUTAS2

PTL2WC:	MOVE	CH,[XWD 600000+ASCD2,2]
	PUSHJ	PP,PUTAS2
	MOVE	CH,VALUE1##
	AOS	EAS2PC
	PUSHJ	PP,PUTAS2
	MOVE	CH,VALUE2##
	AOS	EAS2PC
	JRST	PUTAS2

PTLC2:	MOVE	CH,[XWD 600000+ASCF2,2]
	PUSHJ	PP,PUTAS2
	MOVE	CH,VALUE1
	PUSHJ	PP,PUTAS2
	MOVE	CH,VALUE2
	AOS	EAS2PC
	AOS	EAS2PC
	JRST	PUTAS2

PTLC1:	MOVE	CH,[XWD 600000+ASCFLT,2]
	PUSHJ	PP,PUTAS2
	MOVE	CH,VALUE1
	PUSHJ	PP,PUTAS2
	MOVE	CH,VALUE2
	AOS	EAS2PC
	JRST	PUTAS2

PTLDSP:	SKIPG	TC,NCHITM##
	POPJ	PP,
	ADD	TC,NCHWRD##
	HRRZI	TC,-1(TC)
	IDIV	TC,NCHWRD
	MOVE	CH,	CONVR2##
	HRL	CH,	ASCDS(CH)
	HRRI	CH,(TC)
	TRNA
P2.:	AOS	EAS2PC
	PUSHJ	PP,PUTAS2
	SETZ	CH,
	HRRZ	TA,CURLIT##
	MOVE	TE,	CONVR2##
	HLL	TE,	LHPTRS(TE)
	HRRI	TE,	CH
P1.:	SOSGE	NCHITM
	JRST	P3.
	PUSHJ	PP,GETCHR
	IDPB	TC,TE
	TLNE	TE,760000
	JRST	P1.
	JRST	P2.

P3.:	LDB	TB,[POINT	6,TE,5]
	CAIN	TB,44
	POPJ	PP,
	AOS	EAS2PC
	JRST	PUTAS2

;THE FOLLOWING TABLE CONTAINS:
;	LH	THE LEFT HALF OF THE POINTER FOR PUTTING CHARACTERS IN CH.
;	RH	THE ASSEMBLY CODE FOR THE ITEM.
;	INDEX BY CONVR2.

LHPTRS:	ASCDS:
	POINT	9,AS.EBC##		;COMP-3.
	POINT	6,AS.SIX##		;SIXBIT.
	POINT	7,AS.ASC##		;ASCII.
	POINT	9,AS.EBC##		;EBCDIC.
;PUT ASCII # ON AS2 AS A BINARY CONSTANT

PUTOCT:	HRRZ	TA,CURVAL
	HRLI	TA,440700
	ILDB	TD,TA
	MOVEM	TD,CTR
	SETZ	TC,
PUTOC1:	SOJL	TD,PUTOC2
	ILDB	TB,TA
	IMULI	TC,10
	ADDI	TC,-60(TB)
	JRST	PUTOC1

PUTOC2:	AOJ	TA,
	HRRM	TA,CURVAL
	HRLZI	CH,(TC)
	HRRI	CH,AS.CNB##
	JRST	PUTAS2
PUTVAL:	JUMPL	TA,PVOUT
	CAILE	TA,1
	JRST	PVOUT
	HRLZI	TB,440700
	HRR	TB,CURVAL
	MOVEM	TB,PNTR##
	ILDB	TC,PNTR
	MOVEM	TC,CTR
	JRST	.+1(TA)
	JRST	PV.SXB
	MOVE	CH,[XWD	610000,1]
	PUSHJ	PP,PUTAS2
	MOVE	TD,PNTR
	PUSHJ	PP,GETV2##
	MOVE	CH,TC
	PUSHJ	PP,PUTAS2
	AOS	EAS2PC
	POPJ	PP,

PV.SXB:	ADDI	TC,5
	IDIVI	TC,6
	MOVEM	TC,TBLOCK+1
	HRLZI	CH,620000
	HRR	CH,TC
PV.1:	PUSHJ	PP,PUTAS2
	MOVE	TA,[POINT	6,CH]
	SETZ	CH,
	HRRZI	TE,6
PV.2:	ILDB	TB,PNTR
	CAIN	TB,":"
	HRRZI	TB,"-"
	CAIN	TB,";"
	HRRZI	TB,"."
	SUBI	TB,40
	IDPB	TB,TA
	SOSG	CTR
	JRST	PV.3
	SOJG	TE,PV.2
	JRST	PV.1

PV.3:	PUSHJ	PP,PUTAS2
	MOVE	TA,CURVAL
	LDB	TC,[POINT	7,(TA),6]
	ADDI	TC,5
	IDIVI	TC,5
	HLRZS	TA
	ADD	TA,TC
	HRLZM	TA,CURVAL
	PUSHJ	PP,LNKSET
	HRRM	TA,CURVAL
	MOVE	TB,EAS2PC
	ADD	TB,TBLOCK+1
	MOVEM	TB,EAS2PC
	POPJ	PP,

PVOUT:	MOVE	CH,[XWD	610000,1]
	PUSHJ	PP,PUTAS2
	SETZ	CH,
	JRST	PUTAS2


PUTTAG:	ANDI	CH,077777
	IORI	CH,CD.TAG*1B20
	HRLI	CH,720000
	PUSHJ	PP,PUTAS2
	MOVE	TE,EAS2PC
	TRZ	TE,1B18
	ANDI	CH,077777
	ADD	CH,TAGLOC##
	HRRM	TE,(CH)
	POPJ	PP,
;ADJUST NON-NUMERIC LITERALS

ADJUST:	SETZM	NPADL		;INITIALIZE.
	SETZM	NPADR
	SETZM	NCHLIT##
	SETZM	NCHLI2
	SETZM	NCHITM
	SETZM	ITMLOC##
	SETZM	ITMRES##
	SETZM	SIGNED
	SETZM	VALUE1
	SETZM	VALUE2
	MOVE	TB,[POINT 7,SZ.LIT(TA)]
	MOVEM	TB,BYTEPT##
	MOVEM	TB,BYTEP2##

	SKIPN	TA,CURDAT
	POPJ	PP,
	LDB	LN,DA.LN	;ASSUME THAT WE WILL HAVE AN ERROR.
	LDB	CP,DA.CP
IFN ANS74,<
	LDB	TB,DA.SSC##	;SEE IF SEPARATE SIGN
	MOVEM	TB,SEPSGN##	;STORE RESULT
	LDB	TB,DA.LSC##	;SEE IF LEADING SIGN
	MOVEM	TB,LDNSGN##	;STORE RESULT
>
	SKIPN	TA,CURLIT
	POPJ	PP,
	LDB	TB,LI.NLT##	;IF THE LITERAL IS NUMERIC, GO WORRY OVER IT.
	JUMPN	TB,ADJNUM
;LITERAL IS NON NUMERIC.

	SKIPN	TA,CURDAT
CPOPJ:	POPJ	PP,
	LDB	TB,DA.LOC	;SET LOCATION.
	HRRZM	TB,ITMLOC
	LDB	TB,DA.RES##	;SET RESIDUE.
	HRRZM	TB,ITMRES
	LDB	TB,DA.EXS	;SET NUMBER OF CHARS IN THE ITEM.
	HRRZM	TB,NCHITM
IFN FT68274,<
	LDB	TC,DA.JST	;[1340]
	MOVEI	DW,E.768	;[1340]
	SKIPE	TC		;[1340] SKIP IF NO "JUSTIFIED" CLAUSE
	PUSHJ	PP,WARN		;[1340] OTHERWISE WARN USER OF DIFFERENCE
>
IFN ANS68,	LDB	TC,DA.JST##
IFN ANS74,	SETZ	TC,	;[ANS74] IGNORE JUSTIFICATION WHEN
				;PUTTING VALUES IN DATA ITEMS
	LDB	TD,DA.USG
	SETO	TE,
	CAIN	TD,%US.D6	;IS IT DISPLAY-6.
	MOVEI	TE,1		;YES.
	CAIN	TD,%US.D7	;IS IT DISPLAY-7.
	MOVEI	TE,2		;YES.
	CAIN	TD,%US.EB	;IS IT DISPLAY-9.
	MOVEI	TE,3		;YES.
	JUMPLE	TE,ADJNND	;IF THE ITEM ISN'T DISPLAY, LEAVE.
	MOVEM	TE,CONVR2##	;SET THE CONVERSION INDEX.
	HLL	TE,PADCHS(TE)	;GET THE APPROPRIATE PADD CHAR.
	HLRZM	TE,PADCHR	;REMEMBER IT.
	HRL	TE,CHSPWD(TE)	;GET THE NUMBER OF CHARS PER WORD.
	HLRZM	TE,NCHWRD	;REMEMBER IT.
	SKIPN	TA,CURLIT
	POPJ	PP,
	LDB	TD,LI.FGC##	;IF IT IS A FIGURATIVE CONSTANT,
	JUMPN	TD,AJNN.6	; GO WORRY OVER IT.
	LDB	TD,LI.NCH##	;SET THE NUMBER OF CHARS IN THE LITERAL.
	HRRZM	TD,NCHLIT
	CAIN	TD,(TB)		;IF THE LITERAL IS THE SAME SIZE
	JRST	AJNN.X		; AS THE ITEM, GO ON.
	CAIL	TD,(TB)		;IF THE LITERAL IS LARGER THAN
	JRST	AJNN.4		;THE ITEM, GO ON.
	SUBI	TB,(TD)		;SEE HOW MUCH SMALLER IT IS.
	LDB	TD,LI.ALL##
	SETOM	NPADR
	JUMPE	TD,AJNN.2
	JRST	AJNN.1

ADJNND:	SKIPN	TA,CURLIT	;POINT AT THE LITERAL.
	POPJ	PP,
	LDB	TB,LI.FGC##	;IF IT ISN'T A FIGURATIVE CONSTANT leave.
	JUMPE	TB,CPOPJ	;THE ERROR SHOULD HAVE been detected
				; BY THE SYNTAX scan.
	LDB	TB,LI.FCC##	;SEE WHICH ONE IT IS.
	JRST	ADJNM5		;GO SEE WHAT TO DO WITH IT.
;ALL WAS SPECIFIED AND THE LITERAL IS SMALLER THAN THE ITEM.
;	(TC) = 1 IF THE ITEM IS JUSTIFIED RIGHT
;		0 OTHERWISE.

AJNN.1:	JUMPE	TC,	AJNN.X		;IF THE ITEM IS NOT JUSTIFIED
					; RIGHT, GO ON.
	PUSHJ	PP,	ADJALP		;GO SEE IF THE ITEM IS ALPHABETIC.
	MOVE	TB,	NCHLIT		;NUMBER OF CHARS IN THE LITERAL.
	MOVEM	TB,	NCHLI2		;NUMBER OF CHARS IN THE 2ND THROUGH
					; NTH REPITITIONS OF THE LITERAL.
	MOVE	TC,	NCHITM		;NUMBER OF CHARS IN THE ITEM.
	IDIVI	TC,	(TB)		;(TB) = # OF CHARS IN THE FIRST
					; REPITITION OF THE LITERAL.
	MOVE	TC,	BYTEPT		;BYTE POINTER TO THE LITERAL.
	MOVEM	TC,	BYTEP2		;BYTE POINTER FOR 2ND THROUGH
					; NTH REPITITIONS OF THE LITERAL
	JUMPE	TB,	CPOPJ		;IF THERE ARE NO CHARS IN THE FIRST
					; REPITITION, LEAVE.
	EXCH	TB,	NCHLIT
	SUB	TB,	NCHLIT		;(TB) = # OF CHARS TO SKIP THE
					; FIRST TIME.
	IBP		TC		;SKIP OVER SOME CHARS.
	SOJG	TB,	.-1
	MOVEM	TC,	BYTEPT		;BYTE POINTER FOR FIRST REPITITION
					; OF THE LITERAL.
	POPJ	PP,			;RETURN.
;LITERAL IS SMALLER THAN THE ITEM AND ALL WAS NOT SPECIFIED.

AJNN.2:	JUMPE	TC,AJNN.3		;IF THE LITERAL SHOULD BE RIGHT
	HRRZM	TB,NPADL##		; JUSTIFIED, PADD ON THE LEFT.
	JRST	AJNN.X
AJNN.3:	HRRZM	TB,NPADR##		;OTHERWISE, PADD ON THE RIGHT.
	JRST	AJNN.X

;LITERAL IS LARGER THAN THE ITEM.

AJNN.4:	HRRZM	TB,NCHLIT		;MAKE THE LITERAL THE SAME SIZE
					; AS THE ITEM.
	JUMPE	TC,AJNN.5		;IF THE LITERAL SHOULD BE RIGHT
	SUBI	TD,(TB)			; JUSTIFIED SKIP SOME CHARACTERS
	IBP	BYTEPT			; SO THAT IT WILL BE TRUNCATED
	SOJG	TD,.-1			; ON THE LEFT.
AJNN.5:	HRRZI	DW,E.238		;COMPLAIN ABOUT THE SIZE.
	PUSHJ	PP,WARN
	JRST	AJNN.X

;THE LITERAL IS A FIGURATIVE CONSTANT.

AJNN.6:	HRRZM	TB,NPADL		;PADD THE WHOLE ITEM WITH IT.
	LDB	TD,LI.FCC##		;SEE WHICH ONE IT IS.
	SETZ	TC,			;IF IT ISN'T VALID WE WILL USE NULLS.
	SUBI	TD,HIVAL.
IFN ANS68,<
	CAIE	TD,TALLY-HIVAL.		;SPECIAL CASE TALLY (SEE TABLE "FIGC".)
>
	CAILE	TD,5
	JRST	AJNN.7
	IMULI	TD,3
IFN ANS74,<
	SKIPE	COLSEQ			;PROGRAM COL. SEQ.?
	CAILE	TD,3*<LOVAL.-HIVAL.>	;YES, AND EITHER LOW OR HIGH VALUE
	JRST	AJNN.8			;NO
	ADD	TD,CONVR2
	HRRZ	TC,COHVLV##-1(TD)	;GET RIGHT CHARACTER
	JRST	AJNN.7

AJNN.8:>
	ADD	TD,CONVR2##
	HRRZ	TC,FIGC-1(TD)
AJNN.7:	HRRZM	TC,PADCHR##
AJNN.X:	PUSHJ	PP,ADJALP
	MOVE	TA,BYTEPT
	MOVEM	TA,BYTEP2
	MOVE	TA,NCHLIT
	MOVEM	TA,NCHLI2##
	POPJ	PP,
;ROUTINE TO SEE IF IN ITEM IS ALPHABETIC AND IF IT IS, CHECK TO MAKE
; SURE THAT THE LITERAL CONTAINS ONLY ALPHABETIC CHARACTERS.

ADJALP:	SKIPN	TA,	CURDAT		;POINT AT THE ITEM.
	POPJ	PP,			;IF THERE IS NONE, LEAVE.
	LDB	TB,	DA.CLA##	;GET ITS CLASS.
	CAIE	TB,	%CL.AB		;IS IT ALPHABETIC?
	JRST	ADJNBR			;[1500] NO, NUMERIC
	SETZM		TBLOCK
	SKIPG	TD,	NCHLIT		;GET THE NUMBER OF CHARS IN THE
					; LITERAL.
	JRST		ADJAL6		;IF IT'S ZERO, IT'S PROBABLY A
					; FIGURATIVE CONSTANT.
	HRRZ	TA,	CURLIT		;POINT AT THE LITERAL.
	MOVE	TE,	BYTEPT
ADJAL1:	ILDB	TB,	TE		;GET A CHAR.
	CAIN	TB,	" "		;SPACE?
	JRST		ADJAL2		;YES.
	CAIL	TB,	"A"		;LETTER?
	CAILE	TB,	"Z"
	JRST		ADJAL8		;NO, GO SEE IF IT'S LOWER CASE.
ADJAL2:	SOJG	TD,	ADJAL1		;IF THERE ARE MORE CHARS, LOOP.
	SKIPN		TBLOCK		;IF THERE WERE NO NON ALPHABETIC
	POPJ	PP,			; CHARACTERS, RETURN.
ADJAL4:	HRRZI	DW,	E.298		;OTHERWISE, COMPLAIN.
	PJRST		WARN##

;LITERAL IS A FIGURATIVE CONSTANT - MAKE SURE IT IS SPACES.

ADJAL6:	MOVE	TB,	CONVR2##	;GET THE CONVERSION INDEX.
	HLRZ	TB,	PADCHS(TB)	;SEE WHAT A SPACE LOOKS LIKE.
	CAMN	TB,	PADCHR		;DOES THE FIGURATIVE CONSTANT
					; LOOK LIKE A SPACE?
	POPJ	PP,			;YES, ALL IS WELL, RETURN.
	MOVEM	TB,	PADCHR		;MAKE THE FIGURATIVE CONSTANT
					; A SPACE.
	JRST		ADJAL4		;GO COMPLAIN.

;THERE MAY BE A NON ALPHABETIC CHARACTER IN THE LITERAL.

ADJAL8:	CAIL	TB,	"a"		;IS IT A LOWER CASE LETTER?
	CAILE	TB,	"z"
	CAIA				;NO, ERROR.
	JRST		ADJAL2
	SETOM		TBLOCK		;REMEMBER THAT WE HAD AN ERROR.
	MOVEI	TB,	" "		;REPLACE THE CHARACTER BY A SPACE.
	DPB	TB,	TE
	JRST		ADJAL2		;GO SCAN THE REST OF THE LITERAL.

;VALUE CLAUSE IS FOR A NUMERIC FIELD, SEE IF FIGURATIVE CONSTANT
; AND WARN IF NOT ZERO

ADJNBR:	HRRZ	TA,CURDAT	;[1500]
	LDB	TB,DA.CLA	;[1500] GET THE CLASS
	CAIE	TB,%CL.NUM	;[1500] IF IT'S NOT NUMERIC, 
	POPJ	PP,		;[1500]  EXIT
	LDB	TC,DA.USG	;[1500] STORE OFF ITS USAGE
	HRRZ	TA,CURLIT	;[1500] GET THE LITERAL'S ADDRESS
	LDB	TB,LI.FGC	;[1500] GET LITERAL CODE
	JUMPE	TB,CPOPJ	;[1500] NOT A FIGURATIVE CONSTANT
	LDB	TB,LI.FCC	;[1500] FIND OUT WHAT KIND OF FIG CONST
	CAIN	TB,ZERO.	;[1500] IF IT'S A ZERO - OK
	POPJ	PP,		;[1500]   ALLOWED BY ANSI STANDARD
	HRRZI	DW,E.657	;[1500] OTHERWISE GIVE WARNING 
	CAIE	TB,HIVAL.	;[1500] 
	JRST	WARN##		;[1500]	
	HRRZI	DW,E.655	;[1500] HIGH-VALUES DISPLAY MODE
	CAILE	TC,%US.DS	;[1500]
	HRRZI	DW,E.656	;[1500] HIGH-VALUES NON-DISPLAY MODE
	JRST	WARN##		;[1500]

;TABLE OF FIGURATIVE CONSTANTS.

FIGC:	OCT	77		;HIGH VALUES.
	OCT	177
	OCT	377

	OCT	0		;LOW VALUES.
	OCT	0
	OCT	0

	EXP	'"'		;QUOTES.
	OCT	42
	OCT	177

	EXP	' '		;SPACES.
	EXP	" "
	OCT	100

	OCT	0		;TALLY (TO MAKE INDEXING INTO THE TABLE EASIER.)
	OCT	0
PADCHZ:	OCT	360

	EXP	'0'		;ZEROES.
	EXP	"0"
	OCT	360



;TABLE OF PADD CHARACTERS (LEFT HALF) AND CHARACTERS PER WORD (RIGHT
; HALF).  INDEX BY CONVERSION INDEX.

PADCHS:	CHSPWD:
	XWD	0,4		;COMP-3.
	XWD	' ',6		;SIXBIT.
	XWD	" ",5		;ASCII.
	XWD	100,4		;EBCDIC.
COMMENT	\

ROUTINE TO GET A CHARACTER FROM A LITERAL.

CALL:
	PUSHJ	PP,	GETCHR

ENTRY CONDITIONS:
	(NPADL)		REMAINING NUMBER OF CHARACTERS TO PADD ON THE LEFT.
	(NCHLIT)	NUMBER OF CHARACTERS REMAINING IN THE LITERAL.
	(NCHLI2)	NUMBER OF CHARACTERS IN THE LITERAL.
	(CURLIT)	ADDRESS OF THE LITAB ENTRY CONTAINING THE LITERAL.
	(BYTEPT)	BYTE POINTER TO THE NEXT CHAR IN THE LITERAL.
	(BYTEP2)	BYTE POINTER TO THE FIRST CHAR IN THE LITERAL.
	(NPADR)		IF LESS THAN ZERO "ALL" WAS SPECIFIED FOR THE LITERAL
				OTHERWISE RETURN PADD CHARS IF THERE ARE NO
				MORE CHARS IN THE LITERAL.
	(NCHITM)	NUMBER OF CHARACTERS REMAINING IN THE ITEM.
	(CONVR2)	CONVERSION INDEX:
				0 ==> CONVERT TO COMP-3.
				1 ==> CONVERT TO SIXBIT.
				2 ==> NO CONVERSION.
				3 ==> CONVERT TO EBCDIC.

EXIT CONDITIONS:
	(TC) = THE CHARACTER.

NOTES:
	1.	NPADL, BYTEPT, ETC ARE UPDATED BEFORE RETURNING.
	2.	WHEN CONVERTING TO COMP-3 TWO CHARACTERS FROM THE LITERAL
		ARE RETURNED PACKED RIGHT JUSTIFIED IN A NINE BIT BYTE.
	3.	TA AND TC ARE DESTROYED.

\

GETCHR:	SKIPN		CONVR2##	;IF THE ITEM IS COMP-3 GO GET TWO
	JRST		GETCH9		; CHARS FROM THE LITERAL AND RETURN
					; ONE NINE BIT BYTE.
IFN ANS74,<
	SKIPE	SEPSGN##		;SEPARATE SIGN
	SKIPN	LDNSGN##		;AND LEADING
	JRST	GETCH1			;NO
GETCH0:	MOVE	TC,SIGNED		;GET SIGN OF LITERAL
	MOVE	TC,[EXP "-","+","+"]+1(TC)	;GET RIGHT SIGN
	SETZM	SIGNED			;SO WE DON'T DO IT AGAIN
	SETZM	SEPSGN
	SETZM	LDNSGN
	JRST	GETCH4			;CONVERT AND RETURN
>


;THE ITEM IS DISPLAY.

GETCH1:	SOSL		NPADL		;ARE WE PADDING ON THE lEFT?
	JRST		GETCH6		;YES, GO RETURN A PADD CHAR.
	SOSL		NCHLIT		;ANY CHARS LEFT IN THE LITERAL?
	JRST		GETCH2		;YES, GO GET A CHAR FROM IT.
	SKIPL		NPADR		;WAS "ALL" SPECIFIED?
	JRST		GETCH6		;NO, GO PADD ON THE RIGHT.
;"ALL" WAS SPECIFIED FOR THE LITERAL, REPEAT THE LITERAL.

	MOVE	TA,	BYTEP2		;POINT AT THE BEGINNING OF THE LITERAL.
	MOVEM	TA,	BYTEPT
	SKIPG	TA,	NCHLI2		;IF THERE ARE NO CHARS IN THE LITERAL
	JRST		GETCH6		; IT MUST BE A FIGURATIVE CONSTANT
					; GO RETURN A PADD CHAR.
	MOVEM	TA,	NCHLIT		;SET THE NUMBER OF CHARS IN THE LITERAL.
	SOS		NCHLIT		;LESS ONE FOR THE ONE WE ARE ABOUT
					; TO RETURN.

;GET A CHAR FROM THE LITERAL.

GETCH2:	HRRZ	TA,	CURLIT		;POINT AT THE LITERAL.
	ILDB	TC,	BYTEPT		;GET A CHAR.
IFN ANS74,<
	SKIPLE	NCHITM			;IF NOT LAST CHARACTER
	JRST	[SKIPE	LDNSGN			;CHECK FOR LEADING SIGN
		SKIPL	SIGNED			;AND NEGATIVE
		JRST	GETCH4			;NO
		SETZM	LDNSGN
		SETZM	SIGNED
		JRST	GETCH3]		;MAKE LEADING CHAR NEGATIVE
	SKIPE	SIGNED			;SIGNED?
	SKIPN	TA,SEPSGN		;AND SEPARATE CHAR?
	JRST	.+3			;NO
	MOVE	TC,[EXP "-","+","+"]+1(TA)	;GET SIGN
	JRST	GETCH4			;AND RETURN IT
>
	SKIPGE		SIGNED		;IF THE LITERAL WAS NOT NEGATIVE
	SKIPLE		NCHITM		; OR THIS IS NOT THE LAST CHAR,
	JRST		GETCH4		; GO ON.

;THE LITERAL WAS NEGATIVE AND THIS IS THE LAST CHAR.  IMBED A "-" OVERPUNCH.

GETCH3:	CAIN	TC,	"0"
	JRST	GETCN0			;OVERPUNCH 0 IS SPECIAL
	ADDI	TC,	"J"-"1"

;CONVERT THE CHAR IF NECESSARY.

GETCH4:	MOVE	TA,	CONVR2##	;GET THE CONVERSION INDEX.
	XCT		GETCH5(TA)	;CONVERT THE CHAR.
	POPJ	PP,			;RETURN (COULD ELIMINATE THIS
					; INSTR BY CHANGING THE XQT TO
					; A JRST BUT IT WOULD PROBABLY
					; MAKE THINGS MORE OBSCURE.)

;TABLE TO HANDLE CONVERSIONS - INDEX BY CONVR2.

GETCH5:	JRST		GETCH7		;COMP-3, RETURN AN EBCDIC CHAR.
	SUBI	TC,	40		;SIXBIT, WILL ALWAYS WORK BECAUSE
					; WE HAVE ALREADY CHECKED THE LITERAL.
	POPJ	PP,			;ASCII, NO CONVERSION NECESSARY.
	JRST		GETC7A		;[1072] EBCDIC.

;RETURN A PADD CHAR.

GETCH6:	HRRZ	TC,	PADCHR		;GET A PADD CHAR.
IFN ANS74,<
	SKIPE	LDNSGN			;REQUIRE LEADING SIGN?
	SKIPL	SIGNED			;AND NEGATIVE?
	JRST	.+4			;NO
	SETZM	SIGNED
	SETZM	LDNSGN
	JRST	GETCN0			;YES, -0

	SKIPLE	NCHITM			;IF NOT LAST CHAR.
	POPJ	PP,			;RETURN
	SKIPE	SEPSGN			;STILL NEEDING SEPARATE SIGN?
	JRST	GETCH0			;YES
>
	SKIPGE		SIGNED		;IF THE LITERAL WAS NOT NEGATIVE
	SKIPLE		NCHITM		;OR THIS IS NOT THE LAST CHAR,
	POPJ	PP,			; RETURN.
	SKIPN		CONVR2##	;IF IT'S NOT COMP-3 OR THE
	CAIE	TC,	371		; CHAR ISN'T AN EBCDIC 9,
	JRST		GETCN0		; RETURN A "-0".
	MOVEI	TC,	331		;OTHERWISE, RETURN A "-9".
	POPJ	PP,

;RETURN AN OVERPUNCHED 0

GETCN0:	MOVE	TA,CONVR2		;GET CONVERSION INDEX
	MOVE	TC,[EXP 320,']',"}",320](TA)	;GET RIGHT 0
	POPJ	PP,
;CONVERT THE CHARACTER IN TC TO EBCDIC.

GETCH7:	PUSH	PP,	TB		;SAVE TB.
	IDIVI	TC,	4		;FORM THE INDICES.
	LDB	TC,	GETCH8(TB)	;CONVERT THE CHAR.
	POP	PP,	TB		;RESTORE TB.
	POPJ	PP,			;RETURN.

;[1072] Convert character to EBCDIC. If this is the last character,
;[1072] and the item is signed, and literal is positive, overpunch
;[1072] a "+".
GETC7A:	IDIVI	TC,4		;[1072] FORM THE INDICES
	LDB	TC,GETCH8(TB)	;[1072] CONVERT THE CHAR TO EBCDIC.
	SKIPN	NCHITM		;[1072] IS THIS THE LAST CHARACTER?
	SKIPGE	SIGNED		;[1072] YES, AND IS LITERAL POSITIVE?
	 POPJ	PP,		;[1072] NO, RETURN
	HRRZ	TA,CURDAT##	;[1072] IS ITEM SIGNED?
	LDB	TA,DA.SGN##	;[1072]
	JUMPE	TA,CPOPJ	;[1072] NO, RETURN POSITIVE DIGIT
	TRZ	TC,60		;[1072] OVERPUNCH A "+"
	POPJ	PP,		;[1072] RETURN

;TABLE OF POINTERS TO THE ASCII TO EBCDIC CONVERSION TABLE - INDEX BY
; THE LOW ORDER TWO BITS OF THE ASCII CHARACTER WITH THE HIGH ORDER FIVE
; BITS IN TC.

GETCH8:	POINT	9,ASEBC.##(TC),8
	POINT	9,ASEBC.##(TC),17
	POINT	9,ASEBC.##(TC),26
	POINT	9,ASEBC.##(TC),35

;COME HERE IF THE ITEM IS COMP-3.

GETCH9:	PUSHJ	PP,	GETCH1		;GO GET AN EBCDIC CHAR.
	SKIPLE		NCHITM		;IF THIS IS NOT THE LAST CHAR IN
	JRST		GETC10		; THE ITEM, GO ON.

;THIS IS THE LAST CHAR, WE HAVE TO RETURN A SIGN ALSO.

	LDB	TA,	[POINT 4,TC,31]	;GET THE SIGN.
	LSH	TC,	4		;POSITION THE DIGIT.
	TRO	TC,	(TA)		;COMBINE THE SIGN AND THE DIGIT.
	ANDI	TC,	377		;GET RID OF ANY JUNK.
	HRRZ	TA,	CURDAT##	;SEE IT THE ITEM IS 
	LDB	TA,	DA.SGN##	; SIGNED.
	JUMPE	TA,	CPOPJ		;IF IT ISN'T, RETURN.
	TRNE	TC,	2		;IF THE LITERAL IS NEGATIVE
					; DO NOTHING.
	TRZ	TC,	3		;OTHERWISE MAKE THE VALUE
	POPJ	PP,			; POSITIVE RATHER THAN UNSIGNED.

;RETURN TWO DIGITS IN A NINE BIT BYTE.

GETC10:	ANDI	TC,	17		;ISOLATE THE FIRST DIGIT.
	PUSH	PP,	TC		;SAVE IT.
	PUSHJ	PP,	GETCH1		;GO GET THE SECOND DIGIT.
	POP	PP,	TA		;RESTORE THE FIRST DIGIT.
	DPB	TA,	[POINT 5,TC,31]	;COMBINE THE DIGITS.
	POPJ	PP,			;RETURN.
ADJNUM:	LDB	TB,LI.FGC
	JUMPN	TB,ADJNM5	;FIGURATIVE CONSTANT
	LDB	TB,LI.NCH
	HRRZM	TB,NCHLIT
	PUSHJ	PP,EXALIT
	SKIPN	TA,CURDAT
	POPJ	PP,
	LDB	TB,DA.USG
	CAIN	TB,%US.C1
	JRST	AJUC1		;COMP-1
	CAIN	TB,%US.C2
	JRST	AJUC2		;COMP-2
	LDB	TB,DA.INS
IFN ANS74,<
	SKIPE	SEPSGN		;SEPARATE SIGN?
	SUBI	TB,1		;YES, 1 LESS DATA CHAR
>
	LDB	TC,DA.NDP
	LDB	TD,DA.DPR
	HRRZM	TB,NCHITM
	SKIPN	NINTGD
	SKIPE	NFRACD##
	JRST	ADJNM0
	HRRZM	TB,NPADL
	SETZM	NCHLIT
	SETZM	NPADR
	JRST	ADJNM3

ADJNM0:	JUMPN	TD,ADJNM2	;NDP<0
	CAIGE	TB,(TC)
	JRST	ADJNM1		;NDP>INSIZE --- P(>0)9(N)
	SUBI	TB,(TC)
	CAMGE	TB,NINTGD##	;INS-NDP>=NINTGD?
	JRST	AJUE.1		;NO---NUMBER TOO BIG
	SUB	TB,NINTGD
	MOVEM	TB,NPADL
	CAMGE	TC,NFRACD
	JRST	AJUE.2		;NDP<NFRACD --- ERROR
	SUB	TC,NFRACD
	MOVEM	TC,NPADR
	JRST	ADJNM3

ADJNM1:	SKIPLE	NINTGD
	JRST	AJUE.1		;NUMBER TOO BIG
	HRRZ	TA,CURLIT
	SUBI	TC,(TB)		;PIC IS P(NDP-INS)9(INS)
	ILDB	TE,BYTEPT
	CAIE	TE,"0"
	JRST	AJUE.3		;NUMBER TOO BIG
	SOJG	TC,.-3
	SETZM	NPADL
	HRRZ	TA,CURDAT
	LDB	TC,DA.NDP
	MOVE	TD,TB
	ADD	TB,NCHLIT
	SUB	TB,TC		;INS-NDP+NCHLIT
	MOVEM	TB,NCHLIT
	SUB	TD,TB
	MOVEM	TD,NPADR
	JRST	ADJNM3

ADJNM2:	SKIPN	NFRACD
	CAML	TC,NINTGD
	JRST	AJUE.3
	MOVE	TA,CURLIT
	MOVE	TE,NINTGD
	SUB	TE,TC		;PIC IS 9(INS)P(NDP)
	MOVE	TD,BYTEPT
	IBP	TD
	SOJG	TE,.-1
REPEAT 0,<			;[FCTC NC124] allow non-zero values
	ILDB	TE,TD
	CAIE	TE,"0"
	JRST	AJUE.3
	SOJG	TC,.-3
>
	HRRZ	TA,CURDAT
	LDB	TC,DA.NDP
	MOVE	TD,TB
	SUB	TD,NINTGD
	ADD	TD,TC
	JUMPL	TD,AJUE.3	;VALUE TOO LARGE
	MOVEM	TD,NPADL	;INS+NDP-NINTGD
	SETZM	NPADR
	SUBI	TB,(TD)
	MOVEM	TB,NCHLIT
ADJNM3:	HRRZ	TA,CURDAT
	LDB	TB,DA.SGN##
	JUMPN	TB,ADJNM4
	SKIPN	SIGNED##
	JRST	ADJNM4
	HRRZI	DW,E.249		;VALUE SHOULD BE UNSIGNED
	PUSHJ	PP,AJUC16
	SETZM	SIGNED
ADJNM4:	HRRZ	TA,	CURDAT##	;POINT AT THE ITEM.
	LDB	TE,	DA.USG##	;GET ITS USAGE.
	XCT		AJNMDP(TE)	;EITHER GET THE CONVERSION INDEX
					; OR DISPATCH TO A CONVERSION ROUTINE.

;CONVERSION INDEX IS IN TE.

AJNM4B:	HRR	TB,	PADCHZ(TE)	;GET THE PADD CHAR.
AJNM4D:	HRRZM	TB,	PADCHR##	;REMEMBER IT.
	MOVEM	TE,	CONVR2##	;REMEMBER THE CONVERSION INDEX.
	HRR	TB,	CHSPWD(TE)	;GET CHAR'S PER WORD.
	HRRZM	TB,	NCHWRD##	;REMEMBER IT.
	LDB	TB,	DA.LOC##	;SET THE LOCATION.
	HRRZM	TB,	ITMLOC##
	LDB	TB,	DA.RES##	;SET THE RESIDUE.
	HRRZM	TB,	ITMRES##
IFN ANS74,<
	SKIPE	SEPSGN			;SEPARATE SIGN?
	AOS	NCHITM			;YES, ADD SIGN IN
>
	JUMPN	TE,	CPOPJ		;IF THE ITEM IS NOT COMP-3, RETURN.
;THE ITEM IS COMP-3, CHANGE THE NUMBER OF CHARACTERS IN THE ITEM FROM
; THE NUMBER OF 9'S TO THE NUMBER OF 9 BIT BYTES REQUIRED TO HOLD THE
; ITEM.

	MOVE	TB,	NCHITM##	;NUMBER OF 9'S IN THE PICTURE.
	HRRZI	TB,	2(TB)		;ADD ONE FOR THE SIGN AND ONE TO
					; FORCE ROUNDING UPWARDS.
	LSHC	TB,	-1		;NUMBER OF 9 BIT BYTES REQUIRED.
	MOVEM	TB,	NCHITM##	;SAVE THE RESULT.
	JUMPL	TA,	CPOPJ		;IF THERE WAS A REMAINDER, WE
	AOS		NPADL##		; WILL HAVE TO PADD THE LEADING
					; CHARACTER POSITION.
	POPJ	PP,			;RETURN.

;TABLE WHICH EITHER RETURNS THE ITEM'S CONVERSION INDEX OR DISPATCHES
; TO A CONVERSION ROUTINE.

;MAKE SURE IT 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	%AJNMDP - TABLE IS MESSED UP.
>

AJNMDP:	POPJ	PP,			;UNKNOWN USAGE.
	MOVEI	TE,	1		;DISPLAY-6.
	MOVEI	TE,	2		;DISPLAY-7.
	MOVEI	TE,	3		;DISPLAY-9.
	JRST		AJU1WC		;1-WORD COMP.
	JRST		AJU2WC		;2-WORD COMP.
	JRST		AJUC1		;COMP-1.
	JRST		AJU1WC		;INDEX
	SETZ	TE,			;COMP-3.
	JRST		AJUC2		;COMP-2.

ADJNM5:	CAIE	TB,	HIVAL.		;ONLY HIGH VALUES,
	CAIN	TB,	LOVAL.		; LOW VALUES
	JRST		.+4		;[1500] AND
	CAIE	TB,	ZERO.		; ZERO ARE ALLOWED.
	JRST		AJUE.4
	SKIPA				;[1500] HV AND LV ARE SORT OF 
	PUSHJ	PP,	ADJNBR		;[1500]  ALLOWED
	HRRZ	TA,	CURDAT
	LDB	TC,	DA.INS##
	HRRZM	TC,	NPADR
	HRRZM	TC,	NCHITM
	SETZM		NINTGD
	SETZM		NFRACD
	CAIN	TB,	ZERO.
	JRST		ADJNM4
	LDB	TE,	DA.USG##
	JRST		@.+1(TE)
	EXP	CPOPJ
	EXP	ADJNM4
	EXP	ADJNM4
	EXP	ADJNM4
	EXP	AJCP
	EXP	AJCP
	EXP	AJC1
	EXP	AJCP
	EXP	AJC3
	EXP	AJC2

AJCP:	CAIE	TB,	HIVAL.
	SKIPA	TD,	[EXP	1B0]
	HRLOI	TD,	377777
	MOVE	TC,	TD
	JRST		AJU1X2

AJC2:
AJC1:	CAIE	TB,	HIVAL.
	SKIPA	TC,	[EXP	1B0+1]
	HRLOI	TC,	377777
	JRST		AJU1X2

AJC3:	SETZI	TE,
	CAIE	TB,	LOVAL.
	JRST		AJC3D
	LDB	TB,	DA.SGN##
	JUMPE	TB,	AJNM4B
	SETOM		SIGNED
AJC3D:	MOVEI	TB,	371
	JRST		AJNM4D


AJU2WC:
AJU1WC:	HRRZ	TA,CURLIT
	SETZB	TD,TC
AJU1W1:	SOSGE	NCHLIT
	JRST	AJU1WX
	ILDB	TE,BYTEPT
	CAIL	TE,"0"
	CAILE	TE,"9"
	JRST	AJU1W1
	IMULI	TD,12
	MULI	TC,12
	ADD	TD,TC
	MOVE	TC,TB
	ADDI	TC,-"0"(TE)
	TLZN	TC,1B18
	JRST	AJU1W1
	AOJA	TD,AJU1W1

AJU1WX:	SOSGE	NPADR
	JRST	AJ1WX1
	IMULI	TD,12
	MULI	TC,12
	ADD	TD,TC
	MOVE	TC,TB
	TLZN	TC,1B18
	JRST	AJU1WX
	AOJA	TD,AJU1WX

AJ1WX1:	SKIPL	SIGNED
	JRST	AJU1X2
	SETCA	TD,
	MOVNS	TC
	JUMPN	TC,AJU1X2
	TLO	TC,1B18
	AOJA	TD,AJU1X2

AJU1X2:	MOVEM	TD,VALUE1
	MOVEM	TC,VALUE2
	POPJ	PP,

AJUC2:	JFCL			;SAME AS COMP-1 FOR 12B
AJUC1:	SKIPN	TA,NINTGD
	SKIPE	NFRACD
	SKIPA			;NON-ZERO DIGITS IN SOME PART
	POPJ	PP,
	CAIGE	TA,0
	SETZ	TA,
	MOVEM	TA,VALUE1	;EXPONENT
	SETZ	TA,
	SKIPGE	SIGNED
	HRLZI	TA,740000
	SETOM	SIGNED		;NOTE THAT THIS IS A FLOATING POINT
				; NUMBER IN A FUNNY FORMAT.
	MOVEM	TA,VALUE2
	MOVE	TA,CURLIT
	HRRZI	TB,^D8		;NUMBER OF SIGNIFICANT DIGITS ALLOWED
	MOVE	TD,[POINT 4,VALUE2,3]
AJUC11:	ILDB	TE,BYTEPT
	CAIE	TE,"0"
	JRST	AJC121		;NON-ZERO DIGIT
	SOS	VALUE1		;ZERO HERE IS A ZERO FOLLOWING THE DECIMAL
				;POINT --- HENCE, DECREMENT EXPONENT
	SOSLE	NCHLIT
	JRST	AJUC11
	POPJ	PP,
AJUC12:	ILDB	TE,BYTEPT
AJC121:	IDPB	TE,TD
	SOS	TC,NCHLIT
	SOJLE	TB,AJUC13	;NO MORE SIGNIFICANT DIGITS ALLOWED
	JUMPG	TC,AJUC12	;MORE DIGITS
AJUC13:	SKIPG	NCHLIT
	POPJ	PP,
AJUC14:	ILDB	TE,BYTEPT
	CAIE	TE,"0"
	JRST	AJUC15		;NON-ZERO DIGIT AFTER 8 PLACES USED
	SOSLE	NCHLIT
	JRST	AJUC14
	POPJ	PP,

AJUC15:	HRRZ	TA,CURDAT
	HRRZI	DW,E.302	;TOO MANY DIGITS
AJUC16:	LDB	LN,DA.LN
	LDB	CP,DA.CP
	JRST	WARN

AJUE.1:	HRRZI	DW,E.245		;HIGH-PART TRUNCATION
AJUE.E:	SETZM	NCHITM
	SETZM	NPADL
	SETZM	NPADR
	SETZM	NCHLIT
	JRST	FATAL

AJUE.2:	HRRZI	DW,E.246		;LOW-PART TRUNCATION
	JRST	AJUE.E

AJUE.3:	HRRZI	DW,E.248		;VALUE OUT OF RANGE
	JRST	AJUE.E

AJUE.4:	HRRZI	DW,E.298
	JRST	AJUE.E

FATALE:	LDB	LN,DA.LN##
	LDB	CP,DA.CP##
	JRST	FATAL
EXALIT:	SETZM	SIGNED
	SETZM	NLEADZ
	SETZM	NTRALZ##
	SETZM	NINTGD
	SETZM	NFRACD
	SKIPN	TA,CURLIT
	POPJ	PP,
	LDB	TB,LI.NCH
	MOVE	TE,[POINT	7,SZ.LIT(TA)]
	MOVE	TD,TE
	ILDB	TC,TE
	CAIN	TC,"+"
	JRST	EXL.1
	CAIE	TC,"-"
	JRST	EXL.2
	SETOM	SIGNED
	JRST	EXL.3

EXL.1:	HRRZI	TC,1
	HRRZM	TC,SIGNED
	JRST	EXL.3

EXL.2:	CAIE	TC,"0"
	JRST	EXL.4
	AOS	NLEADZ##
EXL.3:	SOS	NCHLIT
	SOJLE	TB,CPOPJ
	ILDB	TC,TE
	JRST	EXL.2

EXL.4:	CAIN	TC,"."
	JRST	EXL.45
	IDPB	TC,TD
	AOS	NINTGD
	SOJLE	TB,CPOPJ
	ILDB	TC,TE
	JRST	EXL.4

EXL.45:	SOS	NCHLIT
EXL.5:	SOJLE	TB,CPOPJ
	ILDB	TC,TE
	IDPB	TC,TD
	CAIE	TC,"0"
	JRST	EXL.6
	AOS	NTRALZ
	SOS	NCHLIT
	JRST	EXL.5

EXL.6:	AOS	TC,NTRALZ
	ADDM	TC,NFRACD
	ADDM	TC,NCHLIT
	SOS	NCHLIT
	SETZM	NTRALZ
	JRST	EXL.5


	END