Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/cblsrc/cleand.mac
There are 7 other files named cleand.mac in the archive. Click here to see a list.
; UPD ID= 1330 on 7/18/83 at 1:55 PM by HOFFMAN                         
TITLE	CLEAND	FOR COBOL V13
SUBTTL	CLEANUP AFTER PHASE D		W.NEELY/CAM

	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
	SEARCH	FTDEFS		;GET FILE TABLE DEFINITIONS
IFN	TOPS20,<SEARCH	MACSYM>	;GET TX AND MOVX DEFINITIONS
IFE	TOPS20,<SEARCH	MACTEN>
	%%P==:%%P
	DBMS==:DBMS
	DEBUG==:DEBUG

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

ENTRY	CLEAND,CLENTA,PRFSUB
;The data put into the file tables must match the definitions in FTDEFS

DEFINE .WORD.	(ARG),<ZZ==^D<ARG>>

DEFINE .CHECK.	(ARG),<IF1,<IFN ZZ-1-ARG,<PRINTX CLEAND/FTDEFS mis-match for ARG>>>
;EDITS
;NAME	DATE		COMMENTS

;JEH	02-MAY-83	[1466] Give error 365 in COBOLD under WRITE stmt,
;DAW	14-Nov-80	[1074] "?Catastrophe in PHASE D" if "DYNAMIC"
;				in ACCESS MODE clause is misspelled.
;JEH	27-JUN-80	[1032] STORE EBCDIC MODE IN KEY DESCRIPTOR
;JEH	03-APR-80	[1006] PULL OUT CODE TESTING ON USE PROCEDURE CONFLICTS
;DMN	24-OCT-79	[747] COBOL-74 BAD TABLE LINK IF MISSING ISAM RECORD KEY
;CLRH	14-SEP-79	[735] GIVE ERROR IF RECORD KEY NOT DEFINED IN RIGHT FD

;V12A SHIPPED
;DAW	23-APR-79	[677] FIX PROBLEM WITH TABLES EXPANDING THAT
;			CAN MESS UP DBMS USE PROCEDURES
;EHM	17-SEP-78	[552] GIVE ERROR IF DECLARITIVES AND NO END DECL.

;V10*****************
;	10-AUG-76	[435] FIX UP USE PROCEDURE TABLE FOR DBMS
;	18-FEB-76	[407] FIX WRITING BEFORE/AFTER FOR STD ASCII
;DPL	01/29/76	[401] SET DBONLY OFF(=0) IF ONLY USE PROC IS DBMS
;ACK	14-JAN-74	GENERATE POINTERS IN THE FILE TABLE FOR FILE
;			 STATUS STUFF AND SIMULTANEOUS ACCESS STUFF.
;DBT	1/22/74		CHANGE THE PERF. UUO GENERATION TO GENERATE
;			A PUSHJ 17,PERF.
;********************


;[236] /ACK	COBOLC.MAC, CLEAND.MAC
;		RESERVE SPACE FOR LABEL RECORD IF LARGER THAN FD
;		BUT DONT CHANGE FILE TABLE MAX-REC-SIZE
; EDIT 171 MAKES ENTER COBOL EQUIVELENT TO CALL.
; EDIT 137 GIVE ERROR MESSAGE IF SUBSCRIPT IS IN LINKAGE
;		SECTION OF IF SUBSCRIPTED IS SUBSCRIPTED.
; EDIT 165 FIXES COMPILER LOOP IF RIGHT PAREN
;		MISSING FOR SUBSCRIPTED DATA-NAME.
; EDIT 155 FIXES "ADDRESS CHECK" WHEN SORT FILE SHARES SAME BUFFER AREA.
; EDIT 151 FIXES UNBALL PAREN PROBLEM IN COMPUTE STATEMENT.
; EDIT 111 FIXES COMPILER LOOP FOR SEARCH ALL... AT END STOP RUN.
; EDIT 110 OPEN STATEMENT DOES NOT GIVE PERIOD ASSUMED MESSAGE
;		IF A PERIOD IS MISSING AND STATEMENT IS LAST ONE IN A PARA.
SUBTTL	GENERATE OBJECT FILE TABLES

CLEAND:	TSWTZ	INDECL		;[552] STILL IN DECLARITIVES?
	JRST	CLND0		;[552] NO, OK
	LDB	LN,[POINT 13,DECLR.##,28]	;[552] GET LINE NUMBER
	LDB	CP,[POINT 7,DECLR.,35]		;[552] AND CHAR. POS.
	MOVEI	DW,E.608	;[552] GET ERROR MESSAGE CODE
	PUSHJ	PP,FATAL	;[552] WARN USER
CLND0:	MOVE	TA,EAS1PC##
	MOVEM	TA,FILTBL##
	SETZM	EAS1PC
	MOVE	TA,FILLOC##
	CAMN	TA,FILNXT##
	JRST	ECLND		;NO FILTAB ENTRIES
	HRRZI	TA,SZ.DEV
	ADDM	TA,FILTBL
	HRRZI	TA,CD.FIL*1B20+1
CLND:	HRLZM	TA,CURFIL##
	PUSHJ	PP,LNKSET##
	HRRM	TA,CURFIL
	SETZM	TBLOCK+20
	LDB	TB,FI.FDD##
	JUMPN	TB,CC0.
	SETOM	TBLOCK+20
	PUSHJ	PP,CLE12.	;NO FD
	HRRZ	TA,CURFIL
CC0.:	LDB	TB,FI.NDV##	;NUMBER OF DEVICES
	JUMPG	TB,CC0.1
	HRRZI	DW,E.202	;NO DEVICES
	PUSHJ	PP,CLER2.	;SHOULD BE AT LEAST ONE
CC0.1:	HRRZ	TA,CURFIL
	LDB	TB,FI.IRM##	;INTERNAL RECORDING MODE
	CAIE	TB,%%RM
	JRST	CC1.		;SPECIFIED
	HRRZI	TB,%RM.6B
	DPB	TB,FI.IRM	;ASSUME SIXBIT
CC1.:	LDB	TC,FI.PSN##	;GET POSITIONING
	LDB	TD,FI.ADV##	; AND ADVANCING FLAGS.
	JUMPE	TD,CC1.D	;IF THEY ARE BOTH ON,
	JUMPE	TC,CC1.H	; COMPLAIN.
	HRRZI	DW,E.579	;ADVANCING AND POSITIONING FOR THE SAME FILE.
	PUSHJ	PP,CLER2.
CC1.D:	DPB	TC,FI.ADV##	;IF EITHER IS ON, TURN ON ADVANCING.
CC1.H:	IORI	TC,(TD)		;GET ADV FLAG FOR LATER.
	LDB	TD,FI.ERM##	;GET EXTERNAL RECORDING MODE.
	CAIN	TD,%RM.7B	;[1466] [407] IF IT IS ASCII
	JRST	CC2.		; [407] GO ON
	TRNN	TC,1		;IS ADVANCING ON?
	JRST	CC2.		;NO, USE WHAT'S SPECIFIED OR DEFAULT TO SIXBIT
	MOVEI	TD,%RM.7B	;YES, MAKE IT ASCII.
	DPB	TD,FI.ERM##	;SET THE EXTERNAL RECORDING MODE.
;	LDB	TB,FI.RM2	;WAS IT SPECIFIED?
;	JUMPE	TB,CC2.		;NO, OK
;[1466]	HRRZI	DW,E.365	;FILE MUST BE ASCII IF WRITE ADV BIT ON
;[1466]	PUSHJ	PP,CLER2.
CC2.:	LDB	TB,FI.DRL##	;DATA RECORD LINK
	JUMPN	TB,CC3.
	HRRZI	DW,E.201	;NO DATA RECORDS
	PUSHJ	PP,CLER.
	HRRZ	TA,CURFIL
CC3.:	LDB	TB,FI.DSD##
	JUMPN	TB,CFGEN	;SORT-FILE
	LDB	TB,FI.LBL##	;TYPE OF LABELS
	LDB	TC,FI.VID##	;VALUE-OF-ID
	LDB	TD,FI.VDW##	;VALUE-OF-DATE-WRITTEN
	JRST	.+1(TB)
	  JRST	CC5.		;[157] OMITTED
	  JRST	CC4.		;STANDARD
	  JRST	.+1		;CANNOT HAPPEN, BUT JUST IN CASE
	  HRRZI	TB,%LBL.S	;NOT SPECIFIED
	DPB	TB,FI.LBL	;ASSUME STANDARD

CC4.:	JUMPN	TC,CC5.		;VALUE-OF-ID REQUIRED
	HRRZI	DW,E.199	;VAL-ID AND VAL-DW REQUIRED
	PUSHJ	PP,CLER.
	HRRZ	TA,CURFIL
CC5.:	LDB	TB,FI.POS	;MULTIPLE FILE TAPE FLAG
	JUMPE	TB,CC5.2
	LDB	TB,FI.NDV
	SOJE	TB,CC5.2	;ONLY ONE DEVICE ALLOWED
	HRRZI	DW,E.197	;ONLY ONE DEVICE ALLOWED
	PUSHJ	PP,CLER2.
	HRRZ	TA,CURFIL
	HRRZI	TB,1
	DPB	TB,FI.NDV

;CHECK DEPENDING VARIABLE FOR "SIZE IS VARYING DEPENDING ON ...

CC5.2:	LDB	TB,FI.DEP##	;GET DEPENDING VARIABLE
	JUMPE	TB,CC6.		;NONE
	ADD	TB,NAMLOC	;POINT TO NAME
	MOVE	TB,(TB)		;GET FIRST WORD
	TLNE	TB,-1		;DATAB WOULD HAVE LHS ALL ZERO
	JRST	CC5.2Z		;ERROR
	LDB	TC,[POINT 3,TB,20]
	CAIE	TC,CD.DAT	;MAKE SURE ITS A DATAB
	JRST	CC5.2Z		;NO, ERROR
	DPB	TB,FI.DEP	;OK, STORE BACK DATAB POINTER
	MOVE	TA,TB
	PUSHJ	PP,LNKSET	;POINT TO DATAB NOW
	LDB	TB,DA.SON##	;SEE IF ELEMENTARY ITEM
	JUMPN	TB,CC5.2Y	;NO
	LDB	TB,DA.CLA	;GET CLASS
	CAIE	TB,%CL.NU	;MUST BE NUMERIC
	JRST	CC5.2Y
	LDB	TE,DA.SGN	;SEE IF SIGNED
	JUMPN	TE,CC5.2Y
	LDB	TE,DA.NDP	;OR NOT INTEGER
	JUMPN	TE,CC5.2Y
	MOVE	TA,CURFIL	;OK
	JRST	CC6.

CC5.2Y:	HRRZI	DW,E.723
	LDB	LN,DA.LN##		;SET UP FOR ERROR.
	LDB	CP,DA.CP##
	PUSHJ	PP,WARN
	MOVE	TA,CURFIL
	JRST	CC6.

CC5.2Z:	SETZ	TB,
	DPB	TB,FI.DEP	;CLEAR OUT POINTER
;CHECK BLOCKING FACTOR

CC6.:	LDB	TB,FI.RMS	;IS THIS AN RMS FILE?
	JUMPN	TB,CC7.		;YES, IGNORE BLOCKING FACTOR
	LDB	TB,FI.BLF##	;BLOCKING FACTOR
	JUMPN	TB,CC7.
	LDB	TC,FI.FBS##	;GIVEN BUFFER SIZE INSTEAD?
	JUMPE	TC,CC6B.	;NO
	LDB	TB,FI.MRS##	;YES, GET RECORD SIZE
	IDIVI	TC,(TB)		;SEE HOW MANY FIT
	DPB	TC,FI.BLF	;THIS IS BLOCKING FACTOR
	JUMPN	TC,CC7.		;BETTER NOT BE ZERO
	HRRZI	DW,E.623	;BLOCKING FACTOR TOO SMALL
	PUSHJ	PP,CLER2.
	JRST	CC7.

CC6B.:	LDB	TC,FI.ORG
	CAIE	TC,%ORG.R
	JRST	CC6A.		;NOT RELATIVE
	LDB	TB,FI.ERM##	;EXTERNAL RECORDING MODE
	MOVE	TB,[EXP 6,1,5,4,4](TB)	;BYTES PER WORD
	LSH	TB,7		;ASSUME 200 WORD BUFFER
	MOVE	TC,[200000,,1]	;SEED EXCESS,,BLOCKING FACTOR
	MOVSI	CH,-4		;NO. OF PHYSICAL BUFFERS IN LOGICAL BUFFER
CC6L.:	MOVE	TE,TB		;CHARS. IN 1 BUFFERS
	IMULI	TE,1(CH)	;NO. IN LOGICAL BUFFER
	LDB	TD,FI.MRS##	;RECORD SIZE
	CAIN	TB,5*200	;ASCII?
	ADDI	TD,2		;ALLOW FOR CR-LF
	CAIN	TB,4*200	;EBCDIC?
	JRST	[PUSH	PP,TD+1		;YES, GET FREE AC
		LDB	TD+1,FI.VLR##	;IS IT VARIABLE LENGTH?
		JUMPE	TD+1,CC6M.	;NO
		ADDI	TD,4		;YES, ACCOUNT FOR 4 BYTE HEADER
		JRST	CC6M.]
	CAIE	TB,6*200	;SIXBIT?
	JRST	CC6N.		;NO
	PUSH	PP,TD+1		;SAVE TD+1
	ADDI	TD,6+5		;ROUNDING + CONTROL WORD
	IDIVI	TD,6		;NO. WHOLE WORDS
	IMULI	TD,6		;NO. OF CHARACTERS OCCUPIED BY RECORD
CC6M.:	POP	PP,TD+1
CC6N.:	IDIVI	TE,(TD)		;TE=NUMBER OF RECORDS, TD=REMAINDER
	HRL	TE,TD		;EXCESS,,BLOCKING FACTOR
	IMULI	TD,5		;TRY TO GET 80% FULL
	CAIG	TD,(TB)		;
	JRST	CC6K.		;WASTAGE LESS THAN 20% OF 1 BUFFER
	CAMGE	TE,TC		;BETTER THAN PREVIOUS?
	MOVE	TC,TE		;YES, SAVE IT
	AOBJN	CH,CC6L.	;TRY AGAIN
	MOVE	TE,TC		;GET BLOCKING FACTOR
CC6K.:	DPB	TE,FI.BLF	;STORE BLOCKING FACTOR
	JRST	CC7.

CC6A.:	CAIN	TC,%ORG.I	;IS IT INDEX?
	JRST	CC6I.		;YES, SET DEFAULT
	HRRZ	TA,CURFIL
	LDB	TB,FI.IOO##
	JUMPE	TB,CC7.
CC6I.:	MOVEI	TB,1		;USE DEFAULT OF 1
	DPB	TB,FI.BLF
	MOVEI	DW,E.733	;"BLOCK CONTAINS 1 RECORD assumed."
	LDB	LN,FI.FLN	;POINT TO THE FD
	LDB	CP,FI.FCP
	PUSHJ	PP,WARN##
	HRRZ	TA,CURFIL	;POINT TO FILE AGAIN
CC7.:	LDB	TB,FI.ORG	;ORGANIZATION
	CAIE	TB,%%ORG
	JRST	CC8.		;SPECIFIED
	HRRZI	TB,%ORG.S	;ASSUME SEQUENTIAL
	DPB	TB,FI.ORG
CC8.:	JRST	.+1(TB)
	JRST	CFGEN		;SEQUENTIAL
	JRST	CC12.		;RELATIVE
	JRST	CFGEN		;INDEXED

CC12.:	LDB	TB,FI.LBL	;LABELS MUST BE
	CAIN	TB,%LBL.S	;STANDARD
	JRST	CFGEN
	HRRZI	DW,E.198	;LABELS MUST BE STANDARD
	PUSHJ	PP,CLER.
;	JRST	CFGEN		;FALL THRU
;OUTPUT THE DEVICE TABLE - MOSTLY ZEROS
;BUT OTS EXPECTS CERTAIN FLAGS IN D.F1 AND D.RFLG TO BE SET

CFGEN:	HRRZ	TA,CURFIL

;WORDS -SZ.DEV THROUGH D.FI-1

	HRRZI	TC,SZ.DEV+D.F1	;D.F1 IS NEGATIVE
	PUSHJ	PP,PUTWZ	;OUTPUT OCTAL 0'S

;WORD D.F1

	MOVE	CH,[XWD	AS.OCT,1]
	PUSHJ	PP,PUTAS1
	LDB	TC,FI.ERM	;RECORDING MODE
	LDB	TB,FI.VLR##	;VARIABLE LENGTH FLAG
	SKIPE	TB		;IS IT VARIABLE LENGTH?
	CAIE	TC,%RM.EB	; AND EBCDIC?
	TDZA	CH,CH		;NO
	MOVX	CH,B%VLER	;YES
	LDB	TB,FI.OPT##	;FILE OPTIONAL?
	SKIPE	TB
	TXO	CH,B%OPTF	;YES
	LDB	TB,FI.LBL	;LABELS
	CAIN	TB,%%LBL	;WERE THEY OMITTED (ON A SORT FILE)?
	MOVEI	TB,%LBL.S	;YES, MAKE THEM STANDARD.
	DPB	TB,FI.LBL
	CAIN	TB,%LBL.S	;STANDARD?
	TXO	CH,B%STL	;YES
	PUSHJ	PP,PUTAS1	;OUTPUT D.F1

;WORDS D.F1+1 THROUGH D.RFLG-1

	MOVEI	TC,D.RFLG-D.F1-1	;BOTH NEGATIVE
	PUSHJ	PP,PUTWZ

;WORD D.RFLG

	MOVE	CH,[XWD	AS.OCT,1]
	PUSHJ	PP,PUTAS1
	HRRZ	TA,CURFIL
	LDB	TB,FI.ERM	;RECORDING MODE
	CAIE	TB,%RM.SA	;STANDARD ASCII?
	TDZA	CH,CH		;NO
	MOVX	CH,B%SASC	;YES, SET FLAG
	PUSHJ	PP,PUTAS1	;OUTPUT D.RFLG

;REST OF DEVICE TABLE

	MOVEI	TC,-D.RFLG-1
	PUSHJ	PP,PUTWZ	;FINISH OFF DEVICE TABLE

	MOVE	TC,EAS1PC
	HRRZ	TA,CURFIL
	DPB	TC,FI.OFT##
	ADDI	TC,SZ.DEV
	MOVEM	TC,EAS1PC
	LDB	TA,FI.LCP##	;SEE IF LINAGE-COUNTER
	JUMPE	TA,B0.1		;NO
	PUSHJ	PP,LNKSET
	HRREI	TC,D.LCV	;GET RUN-TIME FILE TABLE OFFSET (NEGATIVE)
	ADD	TC,FILTBL	;PLUS BASE OF FILE TABLE
	SUBI	TC,SZ.DEV	;DON'T COUNT SZ.DEV TWICE
	ADD	TC,EAS1PC	;DEPTH IN FILTBL
	DPB	TC,DA.LOC##	;STORE INCORE LOCATION
	HRRZ	TA,CURFIL
	LDB	TC,FI.LPP##
	TRNE	TC,700000
	JRST	B0.0
	LDB	TC,FI.WFA##
	TRNE	TC,700000
	JRST	B0.0
	LDB	TC,FI.LAT##
	TRNE	TC,700000
	JRST	B0.0
	LDB	TC,FI.LAB##
	TRNN	TC,700000
	JRST	B0.1

B0.0:	PUSHJ	PP,GETTAG	;GET NEXT TAG
	HRRZ	TA,CURFIL
	DPB	CH,FI.LCI##	;STORE IT
B0.1:	HRRZ	TA,CURFIL
	MOVE	TC,[TBLOCK,,TBLOCK+1]
	SETZM	TBLOCK##
	BLT	TC,TBLOCK+4
	LDB	TB,FI.NAM##	;NAMTAB LINK
	ADD	TB,NAMLOC##
	MOVNI	TC,5
	MOVEM	TC,CTR##
B1:	ADDI	TB,1
	MOVE	TD,(TB)		;SIX CHARACTERS OF NAME
	TLNN	TD,600000
	JRST	W1.0		;NEXT ENTRY
	MOVEM	TD,TBLOCK+5(TC)
	AOJL	TC,B1
;WORDS 1-5 - PROGRAM NAME IN SIXBIT
.WORD.	1
.CHECK.	F.WFNM

W1.0:	HRLZI	CH,AS.SIX##
	HRRI	CH,5		;5-WORD SIXBIT LITERAL
	PUSHJ	PP,PUTAS1
	MOVE	TA,[POINT 6,TBLOCK]
	HRRZI	TD,5
W1.1:	HRRZI	TC,6
	MOVE	TB,[POINT 6,CH]
	SETZ	CH,
W1.2:	ILDB	TE,TA
	JUMPE	TE,W1.3
	CAIN	TE,":"-40
	HRRZI	TE,"-"-40
	CAIN	TE,";"-40
	HRRZI	TE,"."-40
W1.3:	IDPB	TE,TB
	SOJG	TC,W1.2
	PUSHJ	PP,PUTAS1
	SOJG	TD,W1.1

.WORD.	6
.CHECK.	F.WCVR		;Bits 0-5	Compiler version number
.CHECK.	F.WBLC		;Bit 6		Buffer location assigned
.CHECK.	F.WSDF		;Bit 7		SORT file
.CHECK.	F.WDRM		;Bit 8		Default recording mode
.CHECK.	F.WNOD		;Bits 12-17	Number of devices assigned to file
.CHECK.	F.WDNM		;Bits 18-35	Address of first device table

	HRLZI	CH,AS.XWD##	;XWD
	HRRI	CH,5		;WORDS 6-10
	PUSHJ	PP,PUTAS1
	HRRZ	TA,CURFIL
	LDB	CH,FI.NDV
	DPB	CH,[F%CNOD]	;RHS GETS CLEARED LATER
	LDB	TB,FI.DSD
	SKIPE	TB
	TXO	CH,B%SDF	;THIS IS A SORT FILE
	LDB	TB,FI.RM2##
	SKIPN	TB		;IF RECORDING MODE WAS NOT SET
	TXO	CH,B%DRM	;SET FLAG FOR OTS
	LDB	TB,[POINT 6,.JBVER##,11]	;GET COBOL VERSION #
	DPB	TB,[F%CCVR]
	HRRI	CH,AS.CNB##
	PUSHJ	PP,PUTAS1	;LEFT HALF OF WORD 6
	HRRZ	TA,CURFIL
	LDB	CH,FI.VAL##
	JUMPE	CH,W6.1		;NULL LINK
	HRRZ	TA,CH
	PUSHJ	PP,REFTAG##	;REFERENCE IF TAG
	TRNA
W6.1:	HRRZI	CH,AS.CNB
	PUSHJ	PP,PUTAS1

.WORD. 7
			;Bits 0-2	Not used
.CHECK.	F.WFAM		;Bits 3-4	File access mode
.CHECK.	F.WLAB		;Bits 5-8	Tape label format bits
			;Bits 9-11	System label type
.CHECK.	F.WPMT		;Bits 12-17	File position on mag-tape
.CHECK.	F.RNFT		;Bits 18-35	Link to next file table

	HRRZI	CH,AS.CNB
	HRRZ	TA,CURFIL
	LDB	TB,FI.POS##
	DPB	TB,[F%CPMT]	;POSITION
	LDB	TB,FI.FAM	;FILE ACCESS MODE
	SKIPE	TB		;LEAVE DEFAULT AS SEQENTIAL
	SUBI	TB,1		;OTS USES 0,1,2 FOR MODES
	DPB	TB,[F%CFAM]	;FILE ACCESS MODE
	LDB	TB,FI.POS	;IS THIS A MULTI-FILE REEL?
	JUMPE	TB,W7.4		;NO
	LDB	TB,FI.DSD	;YES, BUT IS IT A SORT FILE?
	JUMPN	TB,[MOVEI DW,E.195	;YES, ITS AN ERROR
		PUSHJ	PP,CLE12A
		JRST	W7.4]		;IGNORE REST FOR NOW
	LDB	TB,FI.LBL	;GET LABEL TYPE
	LDB	TA,FI.SDL	;GET NEXT FILE ON REEL
	JUMPE	TA,W7.4		;ERROR, GIVE UP
	PUSH	PP,TB		;SAVE LABEL TYPE
W7.1:	PUSHJ	PP,LNKSET
	HRRZ	TB,CURFIL
	CAIN	TB,(TA)		;ARE WE ROUND THE LOOP?
	JRST	W7.3		;YES
	LDB	TB,FI.DSD	;IS THIS A SORT FILE?
	JUMPN	TB,W7.2	;YES, ERROR ALREADY GIVEN
	LDB	TB,FI.LBL	;GET ITS LABEL TYPE
	CAME	TB,(PP)		;SAME?
	PUSHJ	PP,CLE14.	;NO, GIVE ERROR
W7.2:	LDB	TA,FI.SDL	;GET NEXT
	JUMPN	TA,W7.1		;IF THERE IS ONE
W7.3:	POP	PP,TB		;CLEAR STACK
W7.4:	PUSHJ	PP,PUTAS1
	LDB	CH,FI.NXT##	;POINTER TO NEXT
	JUMPE	CH,W7.5		;FILE TABLE ENTRY
IFN	CD.FIL-4,<
	ANDI	CH,077777
	IORI	CH,AS.FIL
>
	TRNA
W7.5:	HRRZI	CH,AS.CNB
	PUSHJ	PP,PUTAS1
.WORD. 8
.CHECK.	F.WNAB		;Bits 0-6	Number of buffers
.CHECK.	F.WLCR		;Bit 7		LINAGE-COUNTER wanted
.CHECK.	F.RRRC		;Bits 18-35	Number of records between rerun dumps

	HRRZ	TA,CURFIL
	SETZ	CH,
	LDB	TB,FI.NBF##	;NUMBER OF BUFFERS
	DPB	TB,[F%CNAB]
	LDB	TB,FI.LCP	;LINAGE-COUNTER WANTED
	SKIPE	TB
	SETO	TB,		;YES
	DPB	TB,[F%CLCR]
	HRRI	CH,AS.CNB
	PUSHJ	PP,PUTAS1
	HRRZ	TA,CURFIL
	LDB	CH,FI.RCT##	;RE-RUN COUNT
	MOVSS	CH
	HRRI	CH,AS.CNB
	PUSHJ	PP,PUTAS1

.WORD. 9
.CHECK.	F.WFLG		;Flags
			;Bits 0-3	External recording mode
			;Bit 4		File is OPEN for INPUT
			;Bit 5		File is OPEN for OUTPUT
			;Bit 6		File is an INPUT/OUTPUT file
			;Bit 7		An EOF was seen
			;Bit 8		Device and core data modes differ
			;Bit 9		Optional file not present
			;Bit 10		RERUN dump at END-OF-REEL
			;Bit 11		RERUN dump via RECORD-COUNT
			;Bits 12-14	Core data mode
			;Bits 15-17	File organization
.CHECK.	F.RREC		;Bits 18-35	Address of record area

	HRRZ	TA,CURFIL
	SETZ	CH,		;
	LDB	TB,FI.ERM	;RECORDING MODE
	CAIE	TB,%RM.SA	;STANDARD ASCII?
	JRST	W9.1		;NO, GO ON.
	LDB	TC,FI.RD##	;GET DENSITY.
	CAIE	TC,%RD.2	;ONLY 800, 1600 AND DEFAULT
	CAIN	TC,%RD.5	; DENSITY ARE ALLOWED.
	PUSHJ	PP,[HRRZI DW,E.585	;ONLY DENSITIES OF 800 AND 1600 BPI
		PJRST	CLER2.]		; ARE ALLOWED ON STANDARD ASCII FILES.
W9.1:	LDB	TC,FI.ORG	;ORGANIZATION
	CAIE	TC,%ORG.I	;INDEXED?
	JRST	W9.2		;NO
	CAIN	TB,%RM.BN	;YES, MAY NOT BE BINARY.
	PUSHJ	PP,[HRRZI DW,E.378	;INDEXED FILE MUST BE 6BIT OR ASCII
		JRST	CLER2.]
W9.2:	IOR	CH,[B%DDMS	;SIXBIT
		B%DDMB		;BINARY
		B%DDMA		;ASCII
		B%DDME		;EBCDIC
		B%DDMA](TB)	;STANDARD-ASCII
	IOR	CH,[B%ORGS	;SEQUENTIAL
		B%ORGR		;RELATIVE
		B%ORGI](TC)	;INDEXED
	LDB	TB,FI.RER##	;RE-RUN END OF REEL
	DPB	TB,[F%CRER]
	LDB	TB,FI.RRC##	;RE-RUN ON COUNT
	DPB	TB,[F%CRRC]
	LDB	TB,FI.IRM	;INTERNAL MODE
	IOR	CH,[B%CDMS	;SIXBIT
		0		;BINARY
		B%CDMA		;ASCII
		B%CDME](TB)	;EBCDIC
	HRRI	CH,AS.CNB
	LDB	TB,FI.IOO
	JUMPE	TB,.+2
	TXO	CH,B%IOF
	PUSHJ	PP,PUTAS1
	SETZ	CH,		;WORD 9, RIGHT HALF
	HRRZ	TA,CURFIL
	LDB	CH,FI.DRL	;DATA RECORD LINK
	JUMPE	CH,W9.3
	LDB	TB,[POINT 3,CH,20]	;TYPE CODE
	CAIE	TB,CD.DAT
	JRST	W9.3
IFN	CD.DAT-1,<
	ANDI	CH,LMASKB
	IORI	CH,AS.DAT
>
	TRNA
W9.3:	HRRZI	CH,AS.CNB	;NULL
	PUSHJ	PP,PUTAS1

.WORD. 10
			;LH	Not used
.CHECK.	F.RFSD		;RH	Link to file table that shares device

	HRRZ	TA,CURFIL
	HRRZI	CH,AS.CNB	;ZERO
	PUSHJ	PP,PUTAS1
	HRRZ	TA,CURFIL
	LDB	CH,FI.SDL##
	JUMPE	CH,W10.1	;NULL
	LDB	TB,[POINT 3,CH,20]
	CAIE	TB,CD.FIL
	JRST	W10.1		;NOT A FILE
IFN	CD.FIL-4,<
 IFN	CD.FIL,<
	ANDI	CH,LMASKS
 >
	IORI	CH,AS.FIL##
>
	TRNA

W10.1:	HRRZI	CH,AS.CNB
	PUSHJ	PP,PUTAS1
.WORD. 11
.CHECK.	F.WBKF		;LH		Blocking factor
.CHECK.	F.RACK		;RH		Address of RELATIVE KEY

	MOVE	CH,[XWD	AS.XWD,1]
	PUSHJ	PP,PUTAS1	;WORD 11
	HRRZI	CH,AS.CNB	;LEFT HALF
	LDB	TB,FI.BLF
	DPB	TB,[F%CBKF]	;BLOCKING FACTOR
	PUSHJ	PP,PUTAS1
	HRRZ	TA,CURFIL
	LDB	CH,FI.ACK##	;ACTUAL KEY
	JUMPE	CH,W11.1
	LDB	TB,[POINT 3,CH,20]	;GET CODE
	CAIE	TB,AC.MSC##	;SPECIAL?
	JRST	W11.3		;NO, OUTPUT KEY
	HRLZ	CH,CH		;PUT INCREMENT IN LHS
	TLZ	CH,AS.MSC##
	TLO	CH,AS.PAR##	;RELATIVE TO %PARAM
	HRRI	CH,AS.MSC##	;SIGNAL MISC.
	JRST	W11.3		;OUTPUT IT

W11.1:	LDB	TB,FI.ORG##
	CAIE	TB,%ORG.R	;RELATIVE FILE?
	JRST	W11.2		;NO, PUT OUT A ZERO
	LDB	TB,FI.FAM##	;GET ACCESS MODE
	CAIG	TB,%FAM.S	;SEQUENTIAL DOESN'T NEED KEY
	JRST	W11.2		;SO PUT OUT A ZERO
	HRRZI	DW,E.727	;?RELATIVE KEY MUST BE SUPPLIED
	HRRZ	TA,CURFIL
	LDB	LN,FI.LN##	;POINT TO THE "SELECT"
	LDB	CP,FI.CP##
	PUSHJ	PP,FATAL
W11.2:	HRRZI	CH,AS.CNB
W11.3:	PUSHJ	PP,PUTAS1

.WORD. 12
.CHECK.	F.WVID		;Byte pointer to VALUE OF ID

	LDB	CH,FI.VID	;VALUE OF ID
	HRRZ	TA,CH
	SKIPE	TA
	PUSHJ	PP,REFTAG##	;REFERENCE IF A TAG
	HRRZ	TA,CURFIL
IFE TOPS20,<
	PUSHJ	PP,PUTBYT	;WORD 12
>
IFN TOPS20,<
	PUSHJ	PP,PUTBYA	;WORD 12
>

.WORD. 13
.CHECK.	F.WVDW		;Byte pointer to VALUE OF DATE-WRITTEN

	HRRZ	TA,CURFIL
	LDB	CH,FI.VDW
	PUSHJ	PP,PUTBYT	;WORD 13

.WORD. 14
.CHECK.	F.LSBA		;LH	Link to file table that shares buffer area
.CHECK.	F.REUP		;RH	Address of error use procedure

	HRLZI	CH,AS.XWD
	HRRI	CH,5
	PUSHJ	PP,PUTAS1
	HRRZ	TA,CURFIL
	LDB	CH,FI.SBA##	;SAME BUFFER AREA LINK
	JUMPE	CH,W14.1	;NULL
	LDB	TB,[POINT 3,CH,20]
	CAIE	TB,CD.FIL
	JRST	W14.1
IFN	CD.FIL-4,<
 IFN	CD.FIL,<
	ANDI	CH,077777>
	IORI	CH,AS.FIL
>
	TRNA

W14.1:	HRRZI	CH,AS.CNB
	PUSHJ	PP,PUTAS1

	SETZ	TD,
	HRRZ	TA,CURFIL
	LDB	CH,FI.ERR##	;'USE' POINTER
	JUMPE	CH,W14.2	;NULL
	LDB	TB,[POINT 3,CH,20]
	CAIE	TB,CD.PRO
	JRST	W14.2		;NOT PROTAB
	MOVE	TA,CH
	PUSHJ	PP,PUTPRF
	HRRZ	TA,CH
	PUSHJ	PP,REFTAG##	;GETS THE FILE USE-PROCEDURE TAGS
	JRST	W14.3

W14.2:	HRRZI	CH,AS.CNB
W14.3:	PUSHJ	PP,PUTAS1

.WORD. 15
.CHECK.	F.WMRS		;LH	Maximum record size in characters
.CHECK.	F.WLRS		;RH	Minimum record size in characters

	HRRZ	TA,CURFIL
	LDB	TB,FI.MRS##	;MAXIMUM RECORD SIZE
	HRLZ	CH,TB
	HRRI	CH,AS.CNB
	PUSHJ	PP,PUTAS1
	LDB	TB,FI.LRS##	;MINIMUM SIZE
	HRLZ	CH,TB
	HRRI	CH,AS.CNB
	PUSHJ	PP,PUTAS1

;WORDS 16-18
	MOVEI	TB,6
	MOVEM	TB,CTR
	MOVE	TA,FI.LCP##	;NOT ACTUALLY USED
	MOVEM	TA,PNTR##	;BUT START OF LINAGE STUFF

.WORD. 16
.CHECK.	F.LPP		;LH	Lines per page
.CHECK.	F.WFA		;RH	WITH FOOTING AT count

.WORD. 17
.CHECK.	F.AKS		;WD	Approx. key size for START
.CHECK.	F.LAT		;LH	Lines at top
.CHECK.	F.LAB		;RH	Lines at bottom

.WORD. 18
.CHECK.	F.DEB		;LH	DEBUGGING USE procedure
.CHECK.	F.LCI		;RH	LINAGE counter initialization routine

W18.0:	HRRZ	TA,CURFIL
	ILDB	CH,PNTR	
	TRNN	CH,(1B2)
	TRZN	CH,(1B0)	;IS IT USER NAME
	JRST	W18.1		;NO
	ADD	CH,NAMLOC	;GET POINTER TO NAME
	HRRZ	CH,(CH)		;GET DATAB PTR.
	DPB	CH,PNTR		;STORE BACK
	SETOM	RELKEY##	;SIGNAL PHASE E TO JUMP ROUND DECLARATIVES
W18.1:	TRNE	CH,700000	;TYPE SET?
	JRST	W18.2		;YES
	MOVS	CH,CH		;PUT VALUE IN LHS AND
	HRRI	CH,AS.CNB	;OUTPUT AS CONST.
W18.2:	PUSHJ	PP,PUTAS1
	SOSLE	CTR
	JRST	W18.0		;LOOP FOR ALL LINAGE STUFF
.WORD. 19
.CHECK.	F.WDNS		;Bits 0-2	Mag-tape density
			;Bit 4		Mag-tape parity
.CHECK.	F.WDIO		;Bit 5		Deferred ISAM flag
.CHECK.	F.WOUP		;Bit 6		OPEN use procedure when ENTER fails
.CHECK.	F.RMS		;Bit 7		RMS flag
.CHECK.	F.WBM		;Bit 8		BYTE mode flag
.CHECK.	F.CKP		;Bit 9		Checkpoint flag
.CHECK.	F.CRC		;Bits 10-17	Checkpoint record count
.CHECK.	F.RPPN		;Bits 18-35	Address of PPN

	MOVE	CH,[AS.XWD,,1]	;WORD 19
	PUSHJ	PP,PUTAS1
	HRRZ	TA,CURFIL	;LEFT HALF
	HRRZI	CH,AS.CNB
	LDB	TB,FI.RD##	;RECORD DENSITY
	DPB	TB,[F%CDNS]
	LDB	TB,FI.RP##	;RECORD PARITY
	LSH	TB,-1		;CONVERT 1 TO 0, 2 TO 1 FOR REAL FILE TABLE
	DPB	TB,[F%CPAR]
	LDB	TB,FI.DFR##	;GET DEFERRED OUTPUT ISAM BIT
	DPB	TB,[F%CDIO]	;SET ACCORDINGLY
	LDB	TB,FI.ENT##	;GET ERROR-PROC-ON-OPEN BIT
	DPB	TB,[F%COUP]	;SET RUN-TIME ACCORDINGLY
	LDB	TB,FI.RMS##	;GET RMS BIT
	DPB	TB,[F%CRMS]
	LDB	TB,FI.BM##	;GET BYTE MODE BIT
	LDB	TC,FI.ERM	;GET RECORDING MODE
	CAIN	TC,%RM.BN	;CANNOT BE BINARY
	JUMPN	TB,CLE29.	;AND BYTE MODE
	DPB	TB,[F%CBM]
W19.1:	LDB	TB,FI.CKP##	;GET CHECKPOINT BIT
	DPB	TB,[F%CCKP]
	LDB	TB,FI.CRC##	;GET CHECKPOINT RECORD COUNT
	DPB	TB,[F%CCRC]
	PUSHJ	PP,PUTAS1
	HRRZ	TA,CURFIL	;RIGHT HALF
	LDB	CH,FI.VPP##	;PPN LINK
	PUSHJ	PP,PUTAS1

.WORD. 20

	PUSHJ	PP,PBYT0	;ZERO FOR NOW

.WORD. 21
.CHECK.	F.WBRK		;Byte pointer to RECORD KEY

	HRRZ	TA,CURFIL
	LDB	TC,FI.ORG	;ISAM FILE?
	CAIE	TC,%ORG.I
	JRST	W22.3		;NO, OUTPUT OCTAL 0'S IN WORDS 21-22
REPEAT 1,<
	LDB	TB,FI.RKY	;MAKE SYMBOLIC KEY = RECORD KEY
	DPB	TB,FI.SKY##	;AS EASIEST WAY TO FAKE OUT ISAM
>
	LDB	TC,FI.RKY##	;RECORD KEY
	JUMPN	TC,W21.1	;OK
	HRRZI	DW,E.394	;RECORD KEY REQUIRED
	PUSHJ	PP,CLER2.
	MOVEI	TC,100001	;DUMMY DATAB ENTRY
	MOVEI	TB,100001	;[747] DUMMY DATAB ENTRY
W21.1:	MOVE	TD,[TBLOCK+1,,TBLOCK+2]	;CLR STORAGE
	MOVEM	TB,TBLOCK	;SAVE KEYS
	SETZM	TBLOCK+1
	BLT	TD,TBLOCK+4
	MOVEM	TC,TBLOCK+5
	CAIN	TC,100001	;[1074] IF DUMMY ENTRY (ERRORS EARLIER ON),
	JRST	W21.5		;[1074] SKIP THIS
	HRRZI	TA,(TB)		;MAKE PTR TO SYMBOLIC KEY
	PUSHJ	PP,LNKSET
	LDB	TB,DA.CLA##	;CLASS
	MOVEM	TB,TBLOCK+1
	LDB	TB,DA.USG##	;USAGE
	MOVEM	TB,TBLOCK+2
	LDB	TB,DA.INS##	;SIZE
	MOVEM	TB,TBLOCK+3
	LDB	TB,DA.NDP##	;# OF DECIMAL PLACES
	MOVEM	TB,TBLOCK+4
	LDB	TB,DA.DFS##	;RECORD KEY IN RECORD?
	JUMPE	TB,W21.4	;NO
W21.2:	LDB	TB,DA.POP##	;[735] FIND FILENAME
	LDB	TE,[POINT 3,TB,20]	;[735] GET TYPE
	CAIN	TE,CD.FIL	;[735] FILENAME?
	JRST	W21.3		;[735] YES - SEE IF ITS THE ONE
	MOVE	TA,TB		;[735] NOT AT TOP YET
	PUSHJ	PP,LNKSET	;[735] UP TO NEXT LEVEL...
	  JRST	W21.2		;[735] LOOP UNTIL WE GET TO FILE
W21.3:	HLRZ	TA,CURFIL	;[735] GET CURRENT FILE
	CAMN	TA,TB		;[735] SAME FILE?
	JRST	W21.5		;YES
W21.4:	HRRZI	DW,E.379	;RECORD KEY NOT IN RECORD
	HRRZ	TA,CURFIL
	LDB	LN,FI.LN##	;POINT TO THE "SELECT"
	LDB	CP,FI.CP##
	PUSHJ	PP,FATAL##
	
W21.5:	MOVE	CH,TBLOCK	;OUTPUT RECORD KEY BYTE PTR (WD 21)
	PUSHJ	PP,PUTBYT

REPEAT 0,<
	HRLZI	CH,AS.BYT##	;OUTPUT RECORD KEY BYTE PTR (WD 21)
	HRRI	CH,AS.CNB
	PUSHJ	PP,PUTAS1
	HRRZ	TA,TBLOCK+5
	PUSHJ	PP,LNKSET
	LDB	CH,DA.LOC##	;REL. LOC OF KEY IN RECORD
	PUSHJ	PP,PUTBX
>

.WORD. 22
.CHECK.	F.WIKD		;ISAM key description word

	HRLZI	CH,AS.XWD	;WORD 22
	HRRI	CH,1
	PUSHJ	PP,PUTAS1
	MOVE	TA,TBLOCK+1	;GET CLASS OF KEY
	CAIE	TA,%CL.NU	;NUMERIC
	SETZM	TBLOCK+1	;NON-NUMERIC -- SET TYPE = 0
	HRRZ	TA,TBLOCK+5	;GET PTR TO RECORD KEY
	PUSHJ	PP,LNKSET
	HRRZM	TA,TBLOCK+5
	LDB	TB,DA.EDT##	;EDITING BIT ON?
	SKIPE	TB
	SETZM	TBLOCK+1	;IF NUMERIC EDITED SET TYPE = 0
	SKIPN	TBLOCK+1	;IF TYPE = 0, SKIP NUMERIC STUFF
	JRST	W22.2
	MOVE	TA,TBLOCK+2	;USAGE
	CAIE	TA,%US.C1	;FLOATING?
	CAIN	TA,%US.C2
	JRST	[HRRZI	TA,5		;YES, SET TYPE = 5
		JRST	W22.1]
	CAIN	TA,%US.C3	;COMP-3?
	JRST	[HRRZI	TA,7		;YES, SET TYPE = 7
		JRST	W22.1]		;NOTE: IF SIZE >10, TYPE IS SET TO 10
	CAIL	TA,%US.1C	;FIXED PT?
	JRST	[HRRZI	TA,3		;YES, SET TYPE = 3
		JRST	W22.1]
	HRRZI	TA,1		;MUST BE DISPLY
W22.1:	MOVEM	TA,TBLOCK+1	;STORE TYPE
	MOVE	TA,TBLOCK+3	;GET SIZE
	CAILE	TA,^D10		;MORE THAN 10 DIGITS?
	AOS	TBLOCK+1	;YES, ADD 1 TO TYPE
	HRRZ	TA,TBLOCK+5	;PTR TO REC. KEY
	LDB	TB,DA.SGN##	;GET SIGN FLAG
	SETCA	TB,		;COMPLEMENT IT
	DPB	TB,[POINT 1,TBLOCK+3,20]
W22.2:	HRRZ	TA,CURFIL	;GET MODE
	LDB	TB,FI.ERM
	SETZ	TC,		;ASSUME SIXBIT
	CAIN	TB,%RM.7B
	MOVEI	TC,2		;[1032] ASCII
	CAIN	TB,%RM.EB	;[1032] TEST FOR EBCDIC
	MOVEI	TC,1		;[1032]
	DPB	TC,[POINT 2,TBLOCK+3,19]	;[1032] 
	HRRZI	CH,AS.CNB	;OUTPUT LEFT HALF OF WD 22
	HRL	CH,TBLOCK+1	;TYPE CODE
	PUSHJ	PP,PUTAS1
	HRRZI	CH,AS.CNB	;RT. HALF
	HRL	CH,TBLOCK+3	;OTHER CODES
	PUSHJ	PP,PUTAS1
	JRST	W23.0

W22.3:	MOVEI	TC,2		;OCTAL 0'S TO WORDS 21-22
	PUSHJ	PP,PUTWZ

.WORD. 23
.CHECK.	F.WSMU
repeat 0,<
;	BITS	0-8	OWNER ACCESS.
;	BITS	9-17	OTHER ACCESS.
;	BITS	18-35	COUNT OF RECORDS RETAINED.
>
;  F.WSMU - 	definitions of names below are in LSU.MAC
;	Bits 0-3	Owner access
;	Bits 9-12	Other access
;	Bit  13		Retained NEXT has shared access to file.
;	Bit  14		Retained NEXT needs exclusive access to the file.
;	Bit  15		LFENQ. OPEN flag
;	Bits 16-17	Retained Index Share Flag
;	Bits 18-35	Contains pointer to address of currently Retained Key.

W23.0:	HRRZ	TA,	CURFIL		;POINT AT THE CURRENT FILE TABLE.
	MOVE	CH,	[AS.XWD,,1]	;A SINGLE XWD SHOULD SUFFICE.
	PUSHJ	PP,	PUTAS1
	LDB	TB,	FI.OWA##	;OWNER ACCESS.
	DPB	TB,	[F%COWN]
	LDB	TB,	FI.OTA##	;OTHER ACCESS.
	DPB	TB,	[F%COTH]
	HRRI	CH,	AS.CNB
	PUSHJ	PP,	PUTAS1
	LDB	CH,	FI.RTC##	;COUNT OF RECORDS RETAINED.
	MOVSS	CH,	CH
	HRRI	CH,	AS.CNB
	PUSHJ	PP,	PUTAS1
;WORDS 24 THROUGH 31 ARE THE FILE STATUS WORDS.

	MOVE	TD,	FI.SPT##	;POINTER TO THEM IN THE FILE TABLE.

.WORD. 24
.CHECK.	F.WPFS		;Byte pointer to FILE-STATUS data-item
			;BITS	0-5	BYTE RESIDUE.
			;BITS	6-11	BYTE SIZE.
			;BITS	12-17	FIELD SIZE.
			;BITS	18-35	ADDRESS.

	HRREI	TE,	-10
	PUSHJ	PP,	PPTR

.WORD. 25
.CHECK.	F.WPEN		;Byte pointer to ERROR-NUMBER data-item
			;BITS	0-5	BYTE RESIDUE.
			;BITS	6-11	BYTE SIZE.
			;BITS	12-17	FIELD SIZE.
			;BITS	18-35	ADDRESS.

	AOJGE	TE,	W32.0
	PUSHJ	PP,	PPTR

.WORD. 26
.CHECK.	F.WPAC		;Byte pointer to ACTION-CODE data-item
			;BITS	0-17	0
			;BITS	18-35	ADDRESS.

	AOJGE	TE,	W32.0
	PUSHJ	PP,	PIDX

.WORD. 27
.CHECK.	F.WPID		;Byte pointer to VALUE-OF-ID data-item
			;BITS	0-5	BYTE RESIDUE.
			;BITS	6-11	BYTE SIZE.
			;BITS	12-17	FIELD SIZE.
			;BITS	18-35	ADDRESS.

	AOJGE	TE,	W32.0
	PUSHJ	PP,	PPTR
.WORD. 28
.CHECK.	F.WPBN		;Byte pointer to BLOCK-NUMBER data-item
			;BITS	0-17	0
			;BITS	18-35	ADDRESS.

	AOJGE	TE,	W32.0
	PUSHJ	PP,	PIDX

.WORD. 29
.CHECK.	F.WPRN		;Byte pointer to RECORD-NUMBER data-item
			;BITS	0-17	0
			;BITS	18-35	ADDRESS.

	AOJGE	TE,	W32.0
	PUSHJ	PP,	PIDX

.WORD. 30
.CHECK.	F.WPFN		;Byte pointer to FILE-NAME data-item
			;BITS	0-5	BYTE RESIDUE.
			;BITS	6-11	BYTE SIZE.
			;BITS	12-17	FIELD SIZE.
			;BITS	18-35	ADDRESS.

	AOJGE	TE,	W32.0
	PUSHJ	PP,	PPTR

.WORD. 31
.CHECK.	F.WPFT		;Byte pointer to FILE-TABLE data-item
			;BITS	0-17	0
			;BITS	18-35	ADDRESS.

	AOJGE	TE,	W32.0
	PUSHJ	PP,	PIDX
.WORD. 32 
.CHECK.	F.PROT		;LH	Link to protection code
			;Bits 18-27	Not used
.CHECK.	F.SZID		;Bits 28-35	Size of VALUE-OF-ID

W32.0:	HRRZ	TA,CURFIL
	MOVE	CH,[AS.XWD,,1]
	PUSHJ	PP,PUTAS1
	LDB	CH,FI.PRT##	;GET PROTECTION CODE POINTER
	PUSHJ	PP,PUTAS1
	LDB	CH,FI.SID##	;SIZE OF VALUE-OF-ID
	PUSHJ	PP,PUTAS1

.WORD. 33
.CHECK.	F.PADD		;Bits 0-35	Byte pointer to padding character
			;or
			;Bits 28-35	Padding character

	LDB	CH,FI.PAD##	;GET PADDING CHARACTER
	SKIPE	CH		;LITERAL IS 1 THROUGH 377
	CAILE	CH,377		;IS IT A LITERAL OR DATA-NAME
	JRST	[PUSHJ	PP,PUTBYT
		JRST	W34.0]
	MOVE	CH,[AS.XWD,,1]
	PUSHJ	PP,PUTAS1
	SETZ	CH,
	PUSHJ	PP,PUTAS1
	LDB	CH,FI.PAD
	PUSHJ	PP,PUTAS1

.WORD. 34
.CHECK.	F.RMKL		;LH - Address of Block of RMS Key Descriptors in constant area under START.
.CHECK.	F.APBL		;RH	Bit fields which can apply to RMS files
			;Bits	18-21	SMU Lock bits for Self. Set at Run Time.
			;Bits	22-25	SMU Lock bits for Other. Set at Run Time.
			;Bit	35	Apply Basic-Locking to this file.
			;Bit	34	Write / no-Write switch for <CR> for ASCII STM files

W34.0:	HRRZ	TA,CURFIL
	MOVE	CH,[AS.XWD,,1]
	PUSHJ	PP,PUTAS1
	LDB	CH,FI.RKL##	;GET ADDR OF RMS FILE KEY LIST
	PUSHJ	PP,PUTAS1
	LDB	CH,FI.ABL##	;GET APPLY BASIC-LOCKING BIT
	MOVSS	CH,CH		; PUT IN LEFT SIDE OF CH
	HRRI	CH,AS.CNB	;  AND "LARGE" CONST FLAG ON RIGHT
	PUSHJ	PP,PUTAS1

;WORD 35 through SZ.OFT

REPEAT SZ.OFT+1-^D35,<
	PUSHJ	PP,PBYT0
>

;ADD NEXT WORDS HERE

	MOVEI	TB,SZ.OFT
	ADDM	TB,EAS1PC	;ADD IN THE FIXED PART OF THE FILE TABLE
B5:	HRRZ	TA,CURFIL
	MOVEI	TD,^D80		;[236] 80. CHARS IF STANDARD LABELS
	LDB	TE,FI.MRS
	CAMGE	TE,TD		;[236]
	MOVE	TE,TD		;[236] USE THE LARGER
	LDB	TD,FI.IRM
	CAIN	TD,%RM.6B
	JRST	B5.1
	CAIE	TD,%RM.7B
	SKIPA	TD,[EXP 4]
	MOVEI	TD,5
	TRNA
B5.1:	MOVEI	TD,6
	IDIVI	TE,(TD)
	CAIE	TD,0
	HRRZI	TE,1(TE)
	HRRZM	TE,TBLOCK	;RECORD AREA IN WORDS
B5.2:	LDB	TB,FI.SRA##
	JUMPE	TB,B5.3		;NO SAME RECORD AREA
	HLRZ	TC,CURFIL
	CAIN	TC,(TB)
	JRST	B5.3
	HRRZI	TA,(TB)
	PUSHJ	PP,LNKSET
	LDB	TB,FI.ADR##
	JUMPN	TB,B5.5		;RECORD AREA DEFINED
	LDB	TE,FI.MRS
	LDB	TD,FI.LBL	;GET LABEL TYPE
	SKIPE	TD
	MOVEI	TD,^D80		;SIZE IS 80 FOR STANDARD LABELS
	CAIGE	TE,(TD)
	HRRZI	TE,(TD)
	LDB	TD,FI.IRM
	CAIN	TD,%RM.6B
	JRST	.+5
	CAIE	TD,%RM.7B
	SKIPA	TD,[EXP 4]
	MOVEI	TD,5
	TRNA
	MOVEI	TD,6
	IDIVI	TE,(TD)
	CAIE	TD,0
	HRRZI	TE,1(TE)
	CAMLE	TE,TBLOCK
	HRRZM	TE,TBLOCK
	JRST	B5.2
B5.3:	MOVE	TA,CURFIL
B5.4:	LDB	TB,FI.SAL##
	JUMPE	TB,B5.6		;NO SAME AREA LINK
	HLRZ	TC,CURFIL
	CAIN	TB,(TC)
	JRST	B5.6		;NO MORE
	HRRZI	TA,(TB)
	PUSHJ	PP,LNKSET
	LDB	TB,FI.ADR
	JUMPN	TB,B5.5		;RECORD AREA DEFINED
	LDB	TE,FI.MRS
	LDB	TD,FI.LBL	;GET LABEL TYPE
	SKIPE	TD
	MOVEI	TD,^D80		;SIZE IS 80 FOR STANDARD LABELS
	CAIGE	TE,(TD)
	HRRZI	TE,(TD)
	LDB	TD,FI.IRM
	CAIN	TD,%RM.6B
	JRST	.+5
	CAIE	TD,%RM.7B
	SKIPA	TD,[EXP 4]
	MOVEI	TD,5
	TRNA
	MOVEI	TD,6
	IDIVI	TE,(TD)
	CAIE	TD,0
	HRRZI	TE,1(TE)
	CAMLE	TE,TBLOCK
	HRRZM	TE,TBLOCK
	JRST	B5.4
B5.5:	LDB	TB,FI.LOC##	;LOCATION OF RECORD AREA
B5.51:	HRRZ	TA,CURFIL
	DPB	TB,FI.LOC
	SETO	TC,
	DPB	TC,FI.ADR
	JRST	B6
;PUT OUT 'RELOC .+<SIZE OF RECORD>

B5.6:	MOVEI	CH,AS.MSC##
	HRLI	CH,1+AS.REL##
	PUSHJ	PP,PUTAS1
	HRRZ	CH,TBLOCK
	ANDI	CH,077777
	HRRZ	TA,CURFIL
	LDB	TB,FI.LBL
	CAIE	TB,%LBL.S
	JRST	B5.61
	CAIGE	CH,^D21
	HRRZI	CH,^D21
	HRRZM	CH,TBLOCK
B5.61:	IORI	CH,AS.DOT##
	PUSHJ	PP,PUTAS1
	HRRZ	TB,EAS1PC
	HRRZ	TC,TBLOCK
	ADDM	TC,EAS1PC
	ADD	TB,FILTBL
	HRRZI	TB,-SZ.DEV(TB)
	JRST	B5.51


B6:	HRRZ	TA,CURFIL
	LDB	TA,FI.NXT	;NEXT FILTAB ENTRY
	JUMPN	TA,CLND

;ALL DONE WITH FILE TABLES - FALL THROUGH
;SEE IF WE HAVE TO ADJUST THE SIZE OF DEBUG-CONTENTS

	MOVE	TA,MAXDBC##	;GET MAX. RECORD SIZE
	SUBI	TA,^D30/6	;MINUS WHAT WE HAVE
	JUMPLE	TA,ECLND	;NOTHING TO DO
	MOVEM	TA,MAXDBC	;SAVE DIFFERENCE
	PUSH	PP,FLGSW##	;SAVE CURRENT SETTING
	SETZM	FLGSW		;TURN IT OFF TO AVOID SPURIOUS DEBUG-ITEM ERRORS
	MOVE	TB,[SIXBIT /DEBUG:/]
	MOVEM	TB,NAMWRD##
	MOVE	TB,[SIXBIT /ITEM/]
	MOVEM	TB,NAMWRD+1
	SETZM	NAMWRD+2
	MOVE	TB,[NAMWRD+2,,NAMWRD+3]
	BLT	TB,NAMWRD+5
	PUSHJ	PP,TRYNAM##	;NAME BETTER EXIST
	  JRST	ECLND1		;NO, GIVE UP
	HRRZ	TA,0(TA)	;GET DATAB LINK
	PUSHJ	PP,LNKSET
	MOVE	TB,MAXDBC	;GET SIZE IN WORDS
	IMULI	TB,6
	HRL	TB,TB
	ADDM	TB,5(TA)	;MAKE IT BIGGER

	MOVE	TB,[SIXBIT /CONTEN/]
	MOVEM	TB,NAMWRD+1
	MOVSI	TB,'TS '
	MOVEM	TB,NAMWRD+2
	PUSHJ	PP,TRYNAM	;NAME BETTER EXIST
	  JRST	ECLND1		;NO, GIVE UP
	HRRZ	TA,0(TA)	;GET DATAB LINK
	PUSHJ	PP,LNKSET
	MOVE	TB,MAXDBC	;GET SIZE IN WORDS
	IMULI	TB,6
	HRL	TB,TB
	ADDM	TB,5(TA)	;MAKE IT BIGGER

	MOVE	TB,[SIXBIT /TS:DIS/]
	MOVEM	TB,NAMWRD+2
	MOVE	TB,[SIXBIT /PLAY:6/]
	MOVEM	TB,NAMWRD+3
	PUSHJ	PP,TRYNAM	;NAME BETTER EXIST
	  JRST	ECLND1		;NO, GIVE UP
	HRRZ	TA,0(TA)	;GET DATAB LINK
	PUSHJ	PP,LNKSET
	MOVE	TB,MAXDBC	;GET SIZE IN WORDS
	IMULI	TB,6
	HRL	TB,TB
	ADDM	TB,5(TA)	;MAKE IT BIGGER

	AOS	NAMWRD+3	;DEBUG-CONTENTS-DISPLAY-7
	PUSHJ	PP,TRYNAM	;NAME BETTER EXIST
	  JRST	ECLND1		;NO, GIVE UP
	HRRZ	TA,0(TA)	;GET DATAB LINK
	PUSHJ	PP,LNKSET
	MOVE	TB,MAXDBC	;GET SIZE IN WORDS
	IMULI	TB,5
	HRL	TB,TB
	ADDM	TB,5(TA)	;MAKE IT BIGGER

	MOVEI	TB,2
	ADDM	TB,NAMWRD+3
	PUSHJ	PP,TRYNAM	;NAME BETTER EXIST
	  JRST	ECLND1		;NO, GIVE UP
	HRRZ	TA,0(TA)	;GET DATAB LINK
	PUSHJ	PP,LNKSET
	MOVE	TB,MAXDBC	;GET SIZE IN WORDS
	IMULI	TB,4
	HRL	TB,TB
	ADDM	TB,5(TA)	;MAKE IT BIGGER
ECLND1:	POP	PP,FLGSW	;RESTORE FIPS FLAGGER
;SET 'USEBAS' AND PREPARE TO PUT OUT 'USE' TABLE

ECLND:	SKIPE	TA,EAS1PC
	SUBI	TA,SZ.DEV	;FILTBL POINTS AROUND
				;  FIRST DEVICE TABLE
	MOVEM	TA,USEBAS##
	SETZM	EAS1PC
	SKIPE	RELKEY##	;NEED %PARAM+0 FOR CONVERSION?
	AOS	IMPPAR		;YES, RESERVE IT
IFN DBMS,<
	SETZM	DBONLY##	;[401] START IN OFF POSITION
	SETZM	TBLOCK+7	;CLR CTR OF ERROR-STATUS DECL. PROCS.
>
	PUSHJ	PP,CUSETB	;SET UP PERFORMS FOR EACH E-S PROCEDURE
	MOVEI	TC,0		;TC IS # OF WORDS PUT OUT
	MOVE	TA,[XWD -USES.L##,USES##]	;IF NO
	SKIPN	(TA)			;ENTRIES
	AOBJN	TA,.-1			;IN USE TABLE,
	JUMPGE	TA,EC1.B		;DON'T PUT OUT ANYTHING

IFN DBMS,<SETOM DBONLY##>  ;[401] TURN ON SINCE AT LEAST ONE USE IS NON-DBMS
	MOVE	CH,[XWD AS.XWD,SZ.OUS]	;PREPARE TO WRITE THE USES TABLE
	PUSHJ	PP,PUTAS1	;WRITE HEADER WORD

;EACH HALFWORD WILL BE WRITTEN OUT IN THE SAME ORDER THAT IT APPEARS
; IN USES, FOR EACH OF THE 20 WORDS.
	SETZB	TA,CTR
EC1:	HLRZ	TA,USES(TA)	;GET LH
	PUSHJ	PP,CHKUSE	;DO IT
	MOVE	TA,CTR
	HRRZ	TA,USES(TA)	;GET RH
	PUSHJ	PP,CHKUSE	;WRITE IT
	AOS	TA,CTR		;COUNT WORDS WRITTEN
	CAIGE	TA,SZ.OUS	;EXIT WHEN WROTE THEM ALL
	 JRST	EC1		;ELSE LOOP
				;COPY USE PROCEDURE ADDRESSES FOR PHASE E
	MOVEI	TC,0		;PTR TO USP.XXXX
	MOVE	TA,USES		;INPUT
	PUSHJ	PP,PUTPTE	;PUT TAG FOR PHASE E
	MOVE	TA,USES+5	;OUTPUT
	PUSHJ	PP,PUTPTE
	MOVE	TA,USES+^D10	;I-O
	PUSHJ	PP,PUTPTE
	MOVE	TA,USES+^D15	;EXTEND
	PUSHJ	PP,PUTPTE
	HRRZI	TC,SZ.OUS	;# WORDS WRITTEN
EC1.B:
IFN DBMS,<ADD	TC,TBLOCK+7>	;ADD IN COUNT OF ERROR-STATUS PROCEDURES
	EXCH	TC,IMPPAR##
	MOVEM	TC,EAS1PC
	MOVE	CH,[AS.REL+1,,AS.MSC]
	PUSHJ	PP,PUTAS1
	HRRZI	CH,AS.DAT##
	PUSHJ	PP,PUTAS1
	JUMPLE	TC,CPOPJ##
	HRRZ	CH,TC		;NUMBER OF EXIT WORDS USED
	HRLI	CH,AS.XWD
	PUSHJ	PP,PUTAS1
	HRRZI	CH,AS.CNB
EC1.L:	PUSHJ	PP,PUTAS1
	PUSHJ	PP,PUTAS1
	SOJG	TC,EC1.L
	POPJ	PP,

;CHECK TO SEE IF USE PROCEDURE IN TA HAS A TAG, IF NOT,
; CREATE A PERFORM AND OUTPUT A TAG REFERENCE.
CHKUSE:	HRRZI	CH,AS.CNB
	JUMPE	TA,PUTAS1	;NO USE PROCEDURE, OUTPUT 0
	LDB	TC,LNKCOD##
	CAIN	TC,CD.PRO
	PUSHJ	PP,PUTPRF
	PUSH	PP,TA		;NEED TO SAVE TA
	HRRZ	TA,CH
	PUSHJ	PP,REFTAG##	;REFERENCE IF IT'S A TAG
	POP	PP,TA
	JRST	PUTAS1
;SCAN USETAB FOR DEBUG AND ERROR-STATUS ENTRIES --
;  FOR EACH ONE SET UP A PERFORM OF THAT PROCEDURE, AND
;  REMEMBER TAG OF THE PERFORM

CUSETB:	SETZM	TBLOCK+5	;[677] INIT DYNAMIC USETAB PTR AT TOP
	HRRZ	TB,USELOC##	;[677] GET PTR TO START OF TABLE
	HRRZ	TA,USENXT##	;GET PTR TO END OF USETAB
	SUB	TA,TB		;[677] GET RELATIVE ADDRESS
	MOVEM	TA,TBLOCK+6	;[677] SAVE PTR TO END OF TABLE

CUSET1:	AOS	TA,TBLOCK+5	;BUMP USETAB PTR TO NEXT ENTRY
	CAMLE	TA,TBLOCK+6	;PAST END?
	POPJ	PP,		;YES, RETURN

	ADD	TA,USELOC##	;[677] MAKE ABSOLUTE ADDR.
	LDB	TB,US.TYP##	;GET TYPE CODE
	CAIN	TB,%UT.DB	;DEBUGGING?
	JRST	CUSET6		;YES
IFN DBMS,<
	CAIE	TB,%UT.ES	;THIS AN ERROR-STATUS ENTRY?
>
	JRST	CUSET4		;NO
IFN DBMS,<
	LDB	TB,US.XTR##	;ANY EXTRA WORDS ALLOCATED?
	JUMPE	TB,CUSET1	;NO, MUST HAVE BEEN A BAD ENTRY
	AOS	TBLOCK+7	;BUMP ERROR-STATUS PROC COUNTER
>
CUSET6:	HRRZ	TB,USELOC##	;[677] GET ABS. START OF TABLE
	HRRZ	TC,TA		;[677] TC:= ABS. PLACE IN TABLE
	SUB	TC,TB		;[677] GET RELATIVE PLACE
	PUSH	PP,TC		;[677] AND SAVE IT
	LDB	TA,US.PRO##	;GET PROTAB LINK OF E-S SECTION
	PUSHJ	PP,PUTPR2	;ENTER PUTPRF ROUTINE
	POP	PP,TA		;RESTORE USETAB PTR
	ADD	TA,USELOC	;[677] MAKE ABS. POINTER
	DPB	CH,US.PRO	;SAVE TAG ADDR OF PERFORM OF THAT SECTION
	LDB	TB,US.TYP
	CAIE	TB,%UT.DB	;IF DEBUG WE MAY NOT BE FINISHED
	JRST	CUSET3
	SKIPN	TB,DBPARM##	;HAVE WE ALLOCATED %PARAM+N YET?
	JRST	[AOS	TB,IMPPAR	;NO, ALLOCATE IT
		SOJA	TB,.+1]		;BUT USE PREVIOUS
	MOVEM	TB,DBPARM
	LDB	TB,US.XTR##	;ANY EXTRA WORDS?
	JUMPE	TB,CUSET1	;NO, WE ARE DONE
	LDB	TC,US.CNT##	;YES, GET THE COUNT
	MOVNI	TC,-1(TC)	;BUT NOT THE FIRST EXTRA WORD
	HRLZ	TC,TC
	HRRI	TC,2(TA)	;AOBJN POINTER TO USETAB
CUSET5:	HLRZ	TA,(TC)		;GET FLOTAB POINTER
	ADD	TA,FLOLOC##
	LDB	TA,FL.PRO##	;GET PROTAB LINK
	ANDI	TA,077777
	ADD	TA,PROLOC##
	MOVE	TB,TBLOCK+5	;GET USETAB LINK
	DPB	TB,PR.DEB##	;SAVE IT IN PROTAB
	HRRZ	TA,(TC)		;GET FLOTAB POINTER
	JUMPE	TA,CUSET7	;ALL DONE
	ADD	TA,FLOLOC##
	LDB	TA,FL.PRO##	;GET PROTAB LINK
	ANDI	TA,077777
	ADD	TA,PROLOC##
	MOVE	TB,TBLOCK+5	;GET USETAB LINK
	DPB	TB,PR.DEB##	;SAVE IT IN PROTAB
CUSET7:	AOBJN	TC,CUSET5	;LOOP
	MOVE	TA,TBLOCK+5
	ADD	TA,USELOC
	LDB	TC,US.CNT	;GET EXTRA WORDS
	ADDM	TC,TBLOCK+5
	JRST	CUSET1

CUSET4:	LDB	TC,US.XTR##	;ANY EXTRA WORDS?
	JUMPE	TC,CUSET1	;NO
CUSET3:	LDB	TC,US.CNT##	;GET COUNT OF EXTRA WORDS IN USETAB ENTRY
				;[435] THE USE TABLE LOOKS LIKE
				;[435] CNT OF ERROR-STATUS,,ERROR-STATUS-1
				;[435] ERROR-STATUS-2,,ERROR-STATUS-3  ETC
	LSH	TC,-1		;[435] DIVIDE # OF ERROR-STATUS VALUES BY 2
	AOS	TC		;[435] ROUND UP TO GET NUMBER OF WORDS NEEDED
	ADDM	TC,TBLOCK+5	;[435] ADD TO DYNAMIC USETAB PTR
	JRST	CUSET1		;TRY NEXT ENTRY
CLE12.:	HRRZI	DW,E.97			;NO FD
	HRRZ	TA,CURFIL
CLE12A:	LDB	LN,FI.LN##		;POINT TO THE "SELECT"
	LDB	CP,FI.CP##
	JRST	FATAL##

CLE14.:	MOVEI	DW,E.196	;MUST HAVE SAME KIND OF LABELS
	JRST	CLE12A		;TA IS ALREADY SET UP

CLE29.:	HRRZI	DW,E.596	;CAN NOT BE BYTE MODE AND BINARY
	PUSHJ	PP,CLER2.
	JRST	W19.1		;SO IGNORE BYTE MODE

CLER.:	SKIPE	TBLOCK+20
	POPJ	PP,
CLER2.:	HRRZ	TA,CURFIL
	LDB	LN,FI.FLN##	;POINT TO THE FD
	LDB	CP,FI.FCP##
	JRST	FATAL##
;ROUTINE TO PUT OUT A FILE STATUS POINTER FOR DISPLAY ITEMS.

PPTR:	JSP	TB,	PINT		;SET UP.
	LDB	TB,	DA.RES##	;RESIDUE.
	DPB	TB,	[POINT 6,CH,5]
	LDB	TB,	DA.USG##	;USAGE.
	CAIN	TB,	%US.D6		;SIXBIT.
	MOVEI	TC,	6
	CAIN	TB,	%US.D7		;ASCII.
	MOVEI	TC,	7
	CAIN	TB,	%US.EB		;EBCDIC.
	MOVEI	TC,	11
	DPB	TC,	[POINT 6,CH,11]
	LDB	TB,	DA.EXS##	;SIZE.
	DPB	TB,	[POINT 6,CH,17]
	HRRI	CH,	AS.CNB
PPTR1:	PUSHJ	PP,	PUTAS1
	HRRZ	TA,	CURFIL		;POINT AT THE CURRENT FILE TABLE AGAIN.
	LDB	CH,	TD		;LOCATION.
	JRST		PUTAS1		;WRITE IT AND RETURN.

;ROUTINE TO PUT OUT A FILE STATUS POINTER FOR INDEX ITEMS.

PIDX:	JSP	TB,	PINT		;SET UP.
	HRRZI	CH,	AS.CNB		;NOTHING IN THE LEFT HALF.
	JRST		PPTR1


;INITIALIZATION ROUTINE.

PINT:	HRRZ	TA,	CURFIL
	ILDB	TA,	TD		;NEXT LINK.
	JUMPN	TA,	PINT2		;JUMP IF THER IS ONE.
PINT1:	MOVE	CH,	[AS.OCT,,1]	;NONE, WRITE OUT ZEROES.
	PUSHJ	PP,	PUTAS1
	SETZ	CH,
	PUSHJ	PP,	PUTAS1
	AOJL	TE,	PINT1
	POPJ	PP,

PINT2:	LDB	TC,	LNKCOD##	;GET ITS CODE.
	CAIE	TC,	CD.DAT		;DATAB?
	JRST		PINT1		;NO, MUST HAVE BEEN AN ERROR IN
					; CLEANC.
	ANDI	TA,	077777		;GET THE OFFSET.
	ADD	TA,	DATLOC##		;MAKE IT ABSOLUTE.
	MOVE	CH,	[AS.XWD,,1]	;ONE XWD.
	PUSHJ	PP,	PUTAS1
	JRST		(TB)		;RETURN.
PUTBYT:	JUMPE	CH,PBYT0
	LDB	TB,[POINT 3,CH,20]
PUTBY1:	CAIE	TB,CD.DAT
	JRST	VALBYT
	HRRZM	CH,CURDAT##
	ANDI	CH,077777
	IORI	CH,AS.DAT
	HRLI	CH,AS.BYT##
	PUSHJ	PP,PUTAS1
	SETZ	CH,
	HRRZ	TA,CURDAT
	PUSHJ	PP,LNKSET
PUTBX:	LDB	TB,DA.RES##
	DPB	TB,[POINT 6,CH,5]

;** Note: 3-APR-80 /DAW:
; Keys that are not DISPLAY get a 9-bit byte pointer
; by the nature of the code below. Code in CBLIO will not check
; the left half of the byte pointer when the compare against
; the file parameter is done for COMP keys.
	HRRZI	TC,6
	LDB	TB,DA.USG
	CAIN	TB,%US.D6	;IS IT DISPLAY-6?
	 JRST	.+4		;YES, GO ON.
	CAIN	TB,%US.D7	;HOW ABOUT DISPLAY-7?
	AOJA	TC,.+2		;YES, MAKE IT SEVEN BITS.
	HRRZI	TC,^D9		;MUST BE EBCDIC THEN.
	DPB	TC,[POINT 6,CH,11]
	JRST	PUTAS1

VALBYT:	CAIE	TB,CD.TAG
	JRST	PBYT0
	HRLI	CH,AS.BYT	;BYTE POINTER
	PUSHJ	PP,PUTAS1
	HRLZI	CH,440600
	JRST	PUTAS1

IFN TOPS20,<
PUTBYA:	JUMPE	CH,PBYT0	;SAME AS PUTBYT BUT FOR ASCIZ
	LDB	TB,[POINT 3,CH,20]
	CAIE	TB,CD.TAG
	JRST	PUTBY1
	HRLI	CH,AS.BYT	;BYTE POINTER
	PUSHJ	PP,PUTAS1
	HRLZI	CH,440700
	JRST	PUTAS1
>
;ROUTINE TO OUTPUT OCTAL ZEROS
;ENTER WITH REPEAT COUNT IN TC

PUTWZ:	PUSHJ	PP,PBYT0
	SOJG	TC,PUTWZ
	POPJ	PP,

PBYT0:	MOVE	CH,[AS.OCT##,,1]
	PUSHJ	PP,PUTAS1##	;PUT
	SETZ	CH,		;  OUT
	JRST	PUTAS1		;    'OCT 0'

; FOR EACH DECLARATIVE PROCEDURE, STORE THE TAG FOR PHASE E
;CALLED WITH TC= INDEX INTO USP.I BLOCK
;	TA= PARAGRAPH
;EXIT WITH TAG STORED IN USP.I BLOCK, TC INCREMENTED

PUTPTE:	JUMPE	TA,PUTPT2	;JUMP IF NONE THERE
	PUSHJ	PP,PUTPRF	;GET THE TAG
	HRRZM	CH,USP.I##(TC)	;STORE THE INFO
	AOJA	TC,CPOPJ	;INCREMENT TC AND RETURN
PUTPT2:	SETZM	USP.I(TC)	;CLEAR LOCATION
	AOJA	TC,CPOPJ	;INCREMENT TC AND RETURN
;FOR EACH DECLARATIVE PROCEDURE, GENERATE THE FOLLOWING CODE:
;	%TAG:	PERF.	%PARAM-LOC
;		JRST	DECL-PROC
;		POPJ	PP,

PUTPRF:	MOVEM	TC,TBLOCK+10
	JUMPE	TA,PFZOUT
	LDB	TB,LNKCOD
	CAIE	TB,CD.PRO
	JRST	PFZOUT

;ENTER HERE FOR DEBUGGING AND ERROR-STATUS PROCEDURES
PUTPR2:	HRLZM	TA,CURPRO##
	PUSHJ	PP,LNKSET
	HRRM	TA,CURPRO
	LDB	CH,PR.PRF##
	JUMPN	CH,PRFOUT
	LDB	CH,PR.SFI	;DID WE PREVIOUSLY ALLOCATE A TAG#?
	SKIPN	CH		;YES, JUST USE IT
	PUSHJ	PP,GETTAG##
	HRRZ	TA,CURPRO
	DPB	CH,PR.PRF
	DPB	CH,PR.SFI##	;SO ERROR USE CAN FIND LABEL
	PUSHJ	PP,PRFSUB
PRFOUT:	HRRZ	TA,CURPRO
	LDB	CH,PR.PRF
	MOVE	TC,TBLOCK+10
	POPJ	PP,

PFZOUT:	HRRZI	CH,AS.CNB
	MOVE	TC,TBLOCK+10
	POPJ	PP,
PRFSUB:	HRRZ	TA,CURPRO
	LDB	TB,PR.XTW##
	JUMPN	TB,PRFXTW
	HRRZ	TB,IMPPAR
	ANDI	TB,077777
	IORI	TB,AS.PAR##
	DPB	TB,PR.XTW
	AOS	IMPPAR
PRFXTW:	SETO	TB,
	DPB	TB,PR.EXR##	;TURN ON EXIT REQUIRED FLAG
	HRLI	CH,AS.%X##
	PUSHJ	PP,PUTAS2##
	HRRZ	TB,EAS2PC##
	ANDI	CH,077777
	HRRZ	TD,CH
	ADD	TD,TAGLOC##
	HRRM	TB,(TD)
	MOVE	CH,[XWD	201700,AS.MSC]	;MOVEI 16,%PARAM-LOC
	PUSHJ	PP,PUTAS2
	LDB	CH,PR.XTW
	PUSHJ	PP,PUTAS2
	MOVE	CH,[XWD 113740,PERF%##]	;PUSHJ 17,PERF.
	PUSHJ	PP,PUTAS2
	HLRZ	CH,CURPRO
	ANDI	CH,077777
	IORI	CH,AS.PRO##
	HRLI	CH,076000	;JRST
	PUSHJ	PP,PUTAS2
	HRLZI	CH,137740	;POPJ 17,
	PUSHJ	PP,PUTAS2
	MOVEI	TB,4
	ADDM	TB,EAS2PC
	POPJ	PP,
SUBTTL	CLEAN UP TABLES AND WRITE NAMTAB

CLENTA:
IFN ANS82,<
	MOVE	TA,['FILLER']	;WE NEED TO KNOW WHERE FILLER IS
	MOVEM	TA,NAMWRD	; FOR INITIALIZE VERB
	SETZM	NAMWRD+1
	SETZM	NAMWRD+2
	SETZM	NAMWRD+3
	SETZM	NAMWRD+4
	PUSHJ	PP,TRYNAM	;SEE IF ITS BEEN DEFINED
	  SETZ	TA,		;NO, STORE ZERO
	HLRZM	TA,FLRADD##	;STORE DATAB ADDRESS OF FILLER
>
	PUSHJ	PP,CLEANT##	;CLEAN UP TABLES
IFN DEBUG,<
	MOVE	TA,CORESW##	;CK SWITCHES
	TLNE	TA,%KILL
	POPJ	PP,		;DON'T DUMP NAMTAB IF /K ON
>
	MOVE	TE,NAMNXT##	;COMPUTE SIZE OF NAMTAB
	SUB	TE,NAMLOC
	MOVEI	TE,1(TE)
	ADD	TE,NM12SZ##	;ADD SIZE OF NAMTAB
IFE TOPS20,<
	MOVNS	TE
	HRL	TE,NM2LOC##	;FORM THE NAMTAB I/O LIST
	MOVSM	TE,NAMIOL##
	SOS	NAMIOL
	SETZM	NAMIOL+1
	OUT	NAM,NAMIOL
	  JRST	CLENTB		;NO ERRORS

	OUTSTR	[ASCIZ "%Couldn't write NAMTAB, compilation continuing without maps or object listing
"]
	SWOFF	FMAP!FOBJEC
CLENTB:	CLOSE	NAM,
>
IFN TOPS20,<
	MOVNM	TE,NAMIOL+1	;-<SIZE>
	HRRZ	TE,NM2LOC##	;FORM THE NAMTAB PTR
	HRLI	TE,(POINT ^D36,)
	MOVEM	TE,NAMIOL##
	PUSHJ	PP,RITNAM##
>

	HRRZ	TE,FREESP##	;REDUCE SIZE OF IMPURE AREA
	IORI	TE,1777
IFE TOPS20,<
	CORE	TE,
	  JRST	CLENTE		;IGNORE ERRORS
>
IFN TOPS20,<
	MOVEM	TE,.JBREL##	;RESET SIZE
>

IFN DEBUG,<EXTERN LSTMES,PUTLST,LCRLF

	MOVE	TE,[POINT 7,[ASCIZ "Reduced memory to "]]
	PUSHJ	PP,LSTMES
	HRRZ	TE,.JBREL
	ADDI	TE,1
	LSH	TE,-^D9
	PUSHJ	PP,CLENTD
	MOVEI	CH,"P"
	PUSHJ	PP,PUTLST
	PUSHJ	PP,LCRLF
>
CLENTE:	MOVE	TE,.JBREL##
	ADDI	TE,1
	HRRZM	TE,TOPLOC##
	SUB	TE,FREESP
	HRLM	TE,FREESP
	POPJ	PP,

IFN DEBUG,<

CLENTD:	IDIVI	TE,^D10
	HRLM	TD,(PP)
	SKIPE	TE
	PUSHJ	PP,CLENTD
	HLRZ	CH,(PP)
	ADDI	CH,"0"
	JRST	PUTLST
>

	END