Google
 

Trailing-Edge - PDP-10 Archives - BB-H506D-SM_1983 - cobol/source/isam.mac
There are 21 other files named isam.mac in the archive. Click here to see a list.
; UPD ID= 3561 on 6/3/81 at 2:12 PM by NIXON                            

TITLE	ISAM VERSION 12.2
SUBTTL	ISAM FILE MAINTENANCE PROGRAM		AL BLACKINGTON/CAM/FLD



;COPYRIGHT (C) 1971, 1980 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


EDIT==162
VERSION==1202,,EDIT



	SEARCH	INTERM
	SEARCH	UUOSYM		;FOR TAPOP.'S ARGS
IFN TOPS20,<
	SEARCH	MONSYM		;[154]
>


LOC	137
EXP	VERSION
RELOC	0

TWOSEG
RELOC	400000
SALL

IFNDEF NEW,<NEW==1>	;ELIMINATES "SIZE OF LARGEST INPUT BLOCK:" QUESTION
$CU001==-1		; CUA  assembly switch to make isam more intelligent
IFN TOPS20,<
IFN ANS74,<		;NO VERSION 13 IN COBOL-68
$OUTPAG==0		;OUTPUT MODE SWITCH, ZERO = "OLD" (NON-PAGE) MODE,
			;		NON-ZERO = "NEW" (PAGE) MODE.
			;"PAGE-MODE" MEANS THAT LOGICAL OUTPUT BLOCKS WILL BE
			;SET UP TO CONTAIN n MULTIPLES-OF-FOUR SECTORS. THIS
			;IS TO FACILITATE PAGE I-O ANTICIPATED FOR VERSION 13.
			;  DEFAULT = NON-PAGE MODE
>>			;END IFN ANS74, IFN TOPS20
SUBTTL	HISTORY

;NAME	DATE		COMMENTS

;V12B SHIPPED
; LEM	12-AUG-80	[162] FIX USETI/O FOR BLK 777770-7777777
;	TO USE FILOP. USETI/O
; MFY	 6-AUG-79	[161] FIX TAPE LABEL ERROR ROUTINE AT LTCTST:
; HAM	 3-NOV-78	[160] ISSUE WARNING U BEFORE X IN KEY DESC.
; EHM	14-JUN-78	[157] FIX FILOP. FOR LARGE FILES

;V12 SHIPPED
; EHM	27-JAN-78	[156] FIX ILL MEM REF ON /P FROM SIXBIT TO ASCII
; EHM	29-NOV-77	[155] PUT OUT KEYS OUT OF ORDER MESSAGE 
			; CORRECTLY FOR DOUBLE WORD NUMERIC KEYS

;V11 SHIPPED
;	02/22/77	[154] FOR TOPS20, ALLOW SMU USERS TO ACCESS
;			APPENDED DATA INSTEAD OF GETTING INCORRECT
;			EOF FOR APPENDED DATA.
;MDL	02/17/77	[153] ADD 'STANDARD ASCII' SUPPORT FOR TU16
;			AND TU45 IN ADDITION TO TU70.
;MDL	11/22/76	[152] FIX " /P " FOR VARIABLE LENGTH, EBCDIC MAG
;			TAPE FILES.
;EHM	9-NOV-76	[151] FIX ILL MEM REF FOR /P
;DPL	28-SEP-76	[150] FIX SIXBIT PACK TO MAGTAPE LOSING A CHARACTER
;DPL	18-AUG-76	[147] FIX EBCDIC END OF FILE
;DPL	1/6/76		[146] FIX STANDARD LABELS FOR SIXBIT INPUT TAPE
;			WITH /B/L SWITCHES.
; 145	3/2/76		USE COREECT DATA MODE FOR LABELED MAG TAPES
;JC	16/2/76		[144] ZERO FROM .JBFF TO .JBREL SO THAT MULTIPLE
;			ISAM COMMANDS WORK W/O INTERFERENCE
;DBT	6/1/75		ADD EBCDIC AND COMP-3 KEYS
;			FIX COMP AND COMP-1 KEYS
;			EBCDIC I/O
;********************

;EDIT 143	IN FILE SPEC USE USERS IN CASE 0 IS SPECIFIED FOR PROJECT AND/OR PROGRAMMER NUMBER
;EDIT 142	ALLOW AN ASCII DEVICE TO BE USED AS OUTPUT DEVICE FOR /P
;EDIT 141	FIX "ILL-MEM-REF" PROBLEM WITH /P AND /M
;EDIT 140	FIX HANDLING OF COMMAND FILE
;EDIT 116 - EDIT 137   RESERVED FOR Q/A:S
;EDIT 115	UPDATE JOBDAT SYMBOLS
;EDIT 114	REMOVAL OF EDIT 102, REQUIRES EDIT 335 TO LIBOL
;EDIT 113	FIX WRONG ERROR MESSAGE WHEN ENTER FAILURE ON A DEVICE
;EDIT 112	FIX BUFFER SIZE FOR DECTAPE OUTPUT
;EDIT 111	ENABLE TO GET MORE THAN ONE SWITCH PER COMMAND
;EDIT 110	CORRECT QUESTION WHEN BAD ANSWER TO /P OUTPUT MODE
;EDIT 107	IMPLEMENT /I OPTION (IGNORE KEY ERRORS WHEN PACKING)
;EDIT 106	FIX COMPUTATION OF EMPTY DATA BLOCKS
;EDIT 105	GIVE WARNING THAT COMP AND COMP-1 KEYS DON'T WORK
;EDIT 104	CHANGE INITIAL BLT OF ZEROES TO FACILITATE DEBUGGING
;EDIT 103	FIX WRITING OF BLOCKED TAPES WITH /P OPTION	[EDIT#103]
;EDIT 102	WHEN BUILDING ASCII  INDEXED FILES PADD RECORDS <MAX WITH BLANKS [EDIT#102]
;EDIT 101	ALLOW MTA BUFFER SIZE TO BE GREATER THAN 128 WRDS [EDIT#101]
;EDIT 100	FIXES "KEYS OUT OF ORDER" -- INPSIZ WAS WRONG [EDIT#100]
;EDIT 77	FIXES "ILL-MEM-REF" WHEN /P TO MTA &LARGE BUFFERS [EDIT#77]
;EDIT 76	ADDS /L SWITCH FEATURE TO PERMIT READING OR WRITING
;SEQUENTIAL LABELED MAGTAPES [EDIT #76]
;EDIT 75	ELIMINATES "SIZE OF LARGEST INPUT/OUTPUT BLOCK" QUESTION [EDIT#75]
;EDIT 74	ZERO FREE CORE AT START-UP TIME [EDIT#74]
;EDIT 73	IF DEALING WITH A MTA DOESN'T REQUIRE A FILE NAME--MTA BUFFER
;SIZE IS FIGURED INCORRECTLY [EDIT #73]
SUBTTL	PARAMETERS

;ACCUMULATOR DEFINITIONS

SW=0		;SWITCH REGISTER
TA=1		;TEMP
TB=TA+1		;TEMP
TC=TB+1		;TEMP
TD=TC+1		;TEMP
TE=TD+1		;TEMP
TF=TE+1		;TEMP

IX=7		;CURRENT INPUT INDEX LEVEL
OP=10		;OUTPUT BYTE-POINTER
KT=11		;KEY TYPE
IM=12		;INPUT MODE
OM=13		;OUTPUT MODE
;	0 - SIXBIT
;	1 - EBCDIC
;	2 - ASCII
;	3 - MARVELOUS ASCII ( INTERNAL ONLY)
OC=14		;NUMBER OF CHARACTERS IN OUTPUT RECORD
CH=15		;TTY CHARACTER
DA=16		;ADDRESS OF A FILE PARAMETER BLOCK
PP=17		;PUSH-DOWN POINTER

;I/O CHANNELS

OF1==1		;PRIMARY OUTPUT FILE
OF2==2		;SECONDARY OUTPUT FILE
IF1==3		;PRIMARY INPUT FILE
IF2==4		;SECONDARY INPUT FILE
CMD==5		;INDIRECT COMMAND FILE

;MONITOR COMMUNICATION

$MTA==1B31	;DEVICE IS A MAG-TAPE
$DSK==1B19	;DEVICE IS A DISK
$CDR==1B20	;CARD DEVICE
MTIND==101	;INDUSTRU COMPATABLE MODE FUNCTION CODE FOR MTAPE UUO
MT.7TR==1B31	;7 TRACK TAPE BIT FOR MTCHR UUO
FEOT==1B25	;PHYSICAL END OF TAPE
DEFINE	MTCHR(AC) <CALLI	AC,112>

$DTA==1B29	;[112]DEVICE IS A DECTAPE
$EOF==020000	;END OF FILE FLAG FROM I/O
$ERA==740000	;ERROR FLAGS FROM I/O

$GETCH==4	;CALLI CODE FOR 'DEVCHR'
$CORE==11	;CALLI CODE FOR CORE
$DATE==14	;CALLI CODE FOR DATE

OPDEF	FILOP.	[CALLI 155]	; FILOP. TO DO USETI FUNCT WHEN BLK-NMBR GT 18 BITS
OPDEF TAPOP.	[CALLI 154]

	.TFKTP==1002	; FUNCT TO GET CONTROLER TYPE
	.TU70==3	; CODE FOR A TU70 CONTROLER
	.TM02==4	;[153] CODE FOR TU16 AND TU45 CONTROLLER
	.TFMOD==2007	; FUNCT TO SET STD ASCII MODE
	.TFM7B==4	; CODE FOR STD ASCII MODE

OPDEF	PJRST	[JRST]

;	DEVCHR BITS
DV.OUT==1	; [142] OUTPUT DEVICE (LEFT-HALF)
DV.M14==10000	; [142] BINARY MODE LEGAL FOR DEVICE (RIGHT-HALF)

$ISAMI==401	;FLAG FOR ISAM INDEX FILE
$ISAMS==1000	;FLAG FOR ISAM SIXBIT DATA FILE
$ISAMA==1100	;FLAG FOR ISAM ASCII DATA FILE
$ISAME==0	;FLAG FOR ISAM EBCDIC DATA FILE ???????

;SWITCH REGISTER FLAGS (LH)

FERROR==1B0	;ERROR IN COMMAND STRING
FNUM==1B1	;KEY IS NUMERIC
FSIGN==1B2	;'S' OR 'U' TYPED IN KEY DESCRIPTOR

FASCII==1B3	; [142] /P OUTPUT DEVICE IS ASCII
FENDL==1B4	;WE HAVE AN END-OF-LINE
FENDIB==1B5	;END OF INPUT BLOCK
FEOF==1B6	;END OF INPUT FILE
FDSK==1B7	;/B INPUT OR /P OUTPUT IS DISK
FEBVAR==1B8	;EBCDIC VARIABLE LENGTH RECORDING MODE
FMTA==1B9	;/B INPUT OR /P OUTPUT IS MAG-TAPE
FGETDC==1B10	;GETDEC ROUTINE SAW ACTUAL NUMBER
INDIR==1B11	;READING INDIRECT COMMAND FILE
FRECIN==1B12	;A DATA RECORD HAS BEEN SEEN
FDTA==1B13	;[112] /P OUTPUT IS TO DTA
FCEOFK==1B14	;END OF FILE ON CMD FILE OK		[EDIT#140]
FCEOF==1B15	;END OF FILE ON CMD FILE REACTED	[EDIT#140]
FSGND==1B16	;KEY IS SIGNED
FINDCP==1B17	;INDUSTRY COMPATABLE MODE FOR TAPE

;SWITCH REGISTER FLAGS (RH)



OPT.OP==1B23	;OUTPUT IN PAGES
FNUL==1B24	;INPUT DEVICE=NUL:
ONEBYT==1B25	; REQUEST FIRST BYTE OF RECORD
OPT.A7==1B26	; /ADV:74 SET ANS74 DEFAULT SEQ ASCII ADVANCING
OPT.C==1B27	; /C OPTION CHECK THE ISAM FILE FOR ERRORS (VERSION AND DATA)
OPT.R==1B28	; /R OPTION RENAME THE ISAM FILE (INTERNAL AND EXTERNAL)
IFN	$CU001,<	;MAKE ISAM MORE INTELLIGENT
OPT.S==1B29	;/S OPTION (SHOW STATISTICS)
	>;END OF IFN $CU001
OPT.I==1B30	;[107] /I OPTION (IGNORE ERRORS)
TEMP.==1B31	;TEMP BIT
OPT.L==1B32	;/L OPTION (PUT OR READ LABELS ON MAGTAPES)
OPT.M==1B33	;/M OPTION (MAINTAIN FILE)
OPT.P==1B34	;/P OPTION (PACK FILE)
OPT.B==1B35	;/B OPTION (BUILD INDEXED FILE)
IFN	$CU001,<	;MAKE ISAM MORE INTELLIGENT
;CUA C.D.BALDWIN ADD /S OPTION TO PRINT STATISTICS WHILE DOING RECOMMENDED
;BLOCKING FACTOR CALCULATIONS FOR BENEFIT OF THE PROGRAMMER IN CASE OF HIM/HER
;HAVING TO SELECT VALUES OTHER THAN THOSE RECOMMENDED
OPT.S==1B29	;/S OPTION (SHOW STATISTICS)
	>;END OF IFN $CU001

;CONSTANTS USED TO INDEX INTO FILE PARAMETER DATA

DEV==0		;DEVICE NAME
FILNAM==1	;FILE NAME
FILEXT==2	;FILE EXTENSION
PPNUM==3	;PROJECT-PROGRAMMER NUMBER
BUFADR==4	;3-WORD BUFFER HEADER

;MISCELLANEOUS

EXTERNAL	EASTB.			;CONVERSION TABLE

; RIGHT JUSTIFIED ASCII CR/LF

RTCRLF==6424	; $7O /0,0,0,15,12,0/

; KEYDES POINTERS

DEFINE	KY.MOD	<[POINT	2,KEYDES,19]>
DEFINE	KY.SGN	<[POINT	1,KEYDES,20]>
DEFINE	KY.TYP	<[POINT	18,KEYDES,17]>
DEFINE	KY.SIZ	<[POINT	12,KEYDES,35]>

PPSIZE==40	;SIZE OF PUSH-DOWN LIST

CMPJFN==10	;FUNCTION FOR COMPT. UUO
MTOBSZ==3	;SIZE OF MTOPR ARG BLOCK

; FILE MODE CODES

	SX.MOD==0	;SIXBIT
	EB.MOD==1	;EBCDIC
	AS.MOD==2	;ASCII
	MA.MOD==3	;35 BIT ASCII TAPE I/O

IFN	$CU001,<	;MAKE ISAM MORE INTELLIGENT
; CONSTANTS USED TO CALCULATE  RECOMMENDED BLOCKING FACTORS


IDALIM=^D32		;32. BLOCKS MAXIMUM RECOMMENDED .IDA LOG-BLK SIZE
IFE TOPS20,<
IDXLIM=5		;5. BLOCKS MAXIMUM RECOMMENDED .IDX LOG-BLK SIZE
>			;END IFE TOPS20
IFN TOPS20,<
IDXLIM=10		;2. PAGES MAXIMUM RECOMMENDED .IDX LOG-BLK SIZE
>			;END IFN TOPS20
>			;END OF IFN $CU001
SUBTTL TABLES

;FILE CODES FOR HEADER WORDS
FILCOD:	EXP	$ISAMS		;SIXBIT
	EXP	$ISAME		;EBCDIC
	EXP	$ISAMA		;ASCII
	EXP	$ISAMA		;STANDARD ASCII

;BYTE SIZE
BYTSIZ:	EXP	6
	EXP	9
	EXP	7
	EXP	7

;BYTES PER WORD
BYTWRD:	EXP	6
	EXP	4
	EXP	5
	EXP	5

;BYTES PER WORD MINUS ONE
BYWDM1:	EXP	5
	EXP	3
	EXP	4
	EXP	4

;BYTE POINTER SKELETONS
BYPTRS:	POINT	6,0
	POINT	9,0
	POINT	7,0
	POINT	7,0


INTERNAL	CVARGS		;USED BY GD ROUTINE IN LIBOL

;	TOPS10-TOPS20 COMPATIBILITY MACRO

IFE TOPS20,<
 DEFINE TYPEA (ADDR)<
	OUTSTR	ADDR
>>

IFN TOPS20,<
 DEFINE TYPEA (ADDR)<
	HRROI	1,ADDR
	PSOUT
>>
SUBTTL	INITIALIZATION

START:	CALLI	0		;RESET
	MOVEI	SW,0		;RESET SWITCHES
	SETZM	TTYKAR		;CLEAR IF NOTHING READ

;	SETZM	LOWCOR		;CLEAR IMPURE AREA (EXCEPT TTYKAR)
;	MOVE	TA,[LOWCOR,,LOWCOR+1]
;	BLT	TA,LOWCOR+LOWSIZ-1	;			[EDIT#104]
	SETZM	CMDBUF		;CLEAR IMPURE AREA (EXCEPT TTYKAR)
	MOVE	TA,[CMDBUF,,CMDBUF+1]
	BLT	TA,CMDBUF+LOWSIZ-1+CMBFSZ


	HRRZ	TA,.JBFF	;[144] GET JOBFF
	CAML	TA,.JBREL	;[144] UP AGAINST .JBREL FINISHED
	JRST	START1		;[144] DONE
	SETZM	0(TA)		;[144] CLEAR JBFF
	HRLS	TA		;[144] SET UP TO
	AOS	TA		;[144] FROM JBFF
	HRRZ	TB,.JBREL	;[144] GO TO JBREL
	BLT	TA,0(TB)	;[144] NOW ZERO THEM--LEAVING SYMBOLS IN CORE
START1:
	SETZM	LOWCOR		;CLEAR IMPURE AREA (EXCEPT TTYKAR)
	MOVE	TA,[LOWCOR,,LOWCOR+1]
	BLT	TA,LOWCOR+LOWSIZ-1
IFN TOPS20,<
IFN ANS74,<
IFN $OUTPAG,<
	TRO	SW,OPT.OP	;SET PAGE-MODE OUTPUT
>				;END IFN $OUTPAG
>>				;END IFN ANS74, END IFN TOPS20
	MOVE	PP,[IOWD PPSIZE,PPLIST]  ;INIT PDL
SUBTTL	READ COMMAND STRING

	GETPPN	TA,		; [143] GET USERS PPN
	MOVEM	TA,MYPPN	; [143] SAVE IT

RCOM:	TLNE	SW,(FCEOF)	;EOF INDIRECT COMMAND FILE?
	JRST	START		; YES, GO AROUND AGAIN
	TLNE	SW,(INDIR)	;ALREADY IN INDIRECT COMMAND FILE?
	JRST	RCOM3		; YES, NO PROMPT NEEDED
	TYPE	(
*)				;TYPE '*'
RCOM3:	PUSHJ	PP,GETTY	;GET FIRST CHARACTER OF COMMAND LINE
	CAIN	CH,15		;IF CARRIAGE-RETURN,
	JRST	RCOM		;  LOOP
	CAIN	CH,"@"		;INDIRECT?
	JRST	ICOM		;YES
	MOVEM	CH,TTYKAR	;SAVE THAT CHARACTER

	TRZ	SW, OPT.L+OPT.M+OPT.P+OPT.B+OPT.I  ;CLR OPTION FLAGS
	PUSHJ	PP,GETFIL	;GET 1ST FILENAME
	CAIN	CH,15		;END OF LINE ALREADY?
	JRST	RCOM2		;YES, THIS IS THE INPUT FILE
	TRNE	SW,OPT.C	; /C OPTION?
	JRST	RCOM1		; YES, ALLOW "=" WITH NO OUT FILE NAME
	MOVE	TA,[FILDAT,,OF1DAT]  ;NO, STORE PARAMS FOR 1ST OUT FILE
	BLT	TA,OF1DAT+BUFADR-1
	CAIE	CH,","		;IS THERE A SECONDARY OUTPUT FILENAME?
	JRST	RCOM1		;NO

	PUSHJ	PP,GETFIL	;GET NAME OF 2ND OUTPUT FILE
	MOVE	TA,[FILDAT,,OF2DAT]
	BLT	TA,OF2DAT+BUFADR-1

RCOM1:	CAIE	CH,"="		;OUTPUT SPECIFICATIONS END WITH EQUAL SIGN?
	JRST	BADCOM		;NO
	TRNN	SW,OPT.C	; /C OPTION?
	JRST	RCOM1A		; NO, CONT ON TO GET INPUT NAME
	MOVE	TA,OF1DAT+DEV	;CHECK THAT THERE IS NO 
	IOR	TA,OF1DAT+FILNAM  ;OUTPUT FILE SPEC FOR
	IOR	TA,OF1DAT+FILEXT  ;THE  /C OPTION
	IOR	TA,OF1DAT+PPNUM
	JUMPN	TA,BADCOM	; JUMP IF THERE IS AN OUTPUT FILE 

RCOM1A:	PUSHJ	PP,GETFIL	; GET INPUT FILENAME AFTER SEEING "="

RCOM2:	MOVE	TA,[FILDAT,,IF1DAT]  ;STORE PARAMS FOR INPUT FILE
	BLT	TA,IF1DAT+BUFADR-1
	CAIE	CH,15		;COMMAND END WITH EOL CHAR?
	JRST	BADCOM		;NO

	MOVE	TA,OF2DAT+DEV	;CHECK THAT THERE IS NO 2ND
	IOR	TA,OF2DAT+FILNAM  ;OUTPUT FILE SPEC FOR
	IOR	TA,OF2DAT+FILEXT  ;THE /P AND /C OPTIONS
	IOR	TA,OF2DAT+PPNUM
	TRNE	SW,OPT.P+OPT.C
	JUMPN	TA,BADCOM	;IF THERE IS -- TOO BAD


RCOMX:	TLNN	SW,(FERROR)	;IF TROUBLE,
	JRST	DEFLT		; OK
	PUSHJ	PP,SKPTTY	; BAD, SKIP TO EOL
	JRST	START		; QUIT AND TRY ANOTHER
;INIT INDIRECT COMMAND FILE

ICOM:	TLNE	SW,(INDIR)	;ALREADY INDIRECT?
	JRST	DBLIND		;CANT DO DOUBLE INDIRECT

	PUSHJ	PP,GETFIL	;GET FILE NAME
	CAIE	CH,15		;SHOULD END WITH CR
	JRST	BADCOM

	MOVEI	TA,0		;OPEN ASCII INPUT
	SKIPN	TB,FILDAT+DEV
	MOVSI	TB,(SIXBIT 'DSK')	;USE DSK BY DEFAULT
	MOVEI	TC,CMDBUF
	OPEN	CMD,TA
	  JRST	CMDERR

	MOVE	TA,FILDAT+FILNAM	;LOOKUP COMMAND FILE
	HLLZ	TB,FILDAT+FILEXT
	MOVEI	TC,0
	MOVE	TD,FILDAT+PPNUM
	LOOKUP	CMD,TA
	  JRST	[JUMPN	TB,CMDLER	;NOT NUL EXT OR NOT FOUND ERROR
		MOVSI	TB,'CMD'	;TRY CMD AS EXTENSION
		LOOKUP	CMD,TA		;TRY AGAIN
		  JRST	CMDLER		;TOTAL FAILURE
		JRST	.+1]

	INBUF	CMD,2		;GET 2 BUFFERS
	TLO	SW,(INDIR)	;INDICATE INDIRECT INPUT
	JRST	RCOM3		;START READING COMMANDS
SUBTTL	SET COMMAND STRING DEFAULTS

DEFLT:	TRNN	SW,OPT.B+OPT.M+OPT.P+OPT.R+OPT.C  ;DEFAULT OPTION IS /B
	TRO	SW,OPT.B

	; FIRST SET INPUT FILE DEFAULTS

DEFLT0:	SKIPN	TA,IF1DAT+DEV	;DEFAULT DEVICE FOR
	MOVSI	TA,(SIXBIT "DSK")  ; INPUT FILE IS
	MOVEM	TA,IF1DAT+DEV	;  'DSK'

	TRNN	SW,OPT.B	;/B OR /M /R /C?
	JRST	DEFLT1		;/M /R /C

	SKIPN	TA,IF1DAT+FILEXT  ;/B: DEFAULT EXT FOR IF1 IS 'SEQ'
	MOVSI	TA,(SIXBIT 'SEQ')
	HLLZM	TA,IF1DAT+FILEXT
	JRST	DEFLT2		; NOW SET OUTPUT DEFAULTS

DEFLT1:	SKIPN	TA,IF1DAT+FILEXT  ;/M OR /P OR /R OR /C: DEFLT IF1 EXT IS 'IDX'
	MOVSI	TA,(SIXBIT 'IDX')
	HLLZM	TA,IF1DAT+FILEXT

	TRNE	SW,OPT.C	; /C OPTION?
	JRST	OPEN1		; YES, ONLY INPUT FOR /C, NO ? SO OPEN NOW


	; NOW SET OUTPUT DEFAULTS
	; FIRST THE DEVICE


DEFLT2:	SKIPN	TA,OF1DAT+DEV	;DEFAULT DEVICE FOR
	MOVSI	TA,(SIXBIT "DSK")  ; FIRST OUTPUT FILE IS
	MOVEM	TA,OF1DAT+DEV	;  'DSK'
	SKIPN	OF2DAT+DEV	;DEFAULT DEVICE FOR 2ND OUTPUT FILE IS
	MOVEM	TA,OF2DAT+DEV	;  1ST OUTPUT DEVICE

	; THEN THE FILE NAME

	SKIPN	TA,OF1DAT+FILNAM  ;DEFAULT NAME FOR OF1 IS IF1
	MOVE	TA,IF1DAT+FILNAM
	MOVEM	TA,OF1DAT+FILNAM
	SKIPN	OF2DAT+FILNAM	;DEFAULT NAME FOR OF2 IS OF1
	MOVEM	TA,OF2DAT+FILNAM

	; FINALLY THE EXTENSION

	TRNN	SW,OPT.P	;/P?
	JRST	DEFLT3		;NO, /M /R 

	SKIPN	TA,OF1DAT+FILEXT  ;DEFAULT EXT FOR OF1 IS 'SEQ'
	MOVSI	TA,(SIXBIT 'SEQ')
	HLLZM	TA,OF1DAT+FILEXT
	MOVE	TA,[OF1DAT,,OF2DAT]	;REAL /P OUTPUT IS DONE ON OF2
	BLT	TA,OF2DAT+BUFADR-1
	JRST	OPENER		; DONE FOR /P,  DO OPEN

DEFLT3:	SKIPN	TA,OF1DAT+FILEXT  ;/B OR /M  /R: DEFAULT EXT FOR OF1 IS 'IDX'
	MOVSI	TA,(SIXBIT 'IDX')
	HLLZM	TA,OF1DAT+FILEXT
	SKIPN	TA,OF2DAT+FILEXT  ;DEFAULT EXT FOR OF2 IS 'IDA'
	MOVSI	TA,(SIXBIT 'IDA')
	HLLZM	TA,OF2DAT+FILEXT
SUBTTL	OPEN I/O FILES

OPENER:	TRNN	SW,OPT.R	; SKIP QUESTIONS IF /RENAME 

	PUSHJ	PP,IOMOD	;ASK QUESTIONS ABOUT I/O MODES NOW SO
				;THAT SPECIAL TAPE MODES CAN BE SETUP
	TRNE	SW,OPT.I	; IGNORE ERROR OPTION?		[EDIT#107]
	TRNE	SW,OPT.P+OPT.M	;AND PACKING OR MAINTAINING? [EDIT#107]
	JRST	OPN1		;YES, OK			[EDIT#107]
	TYPE	(?The /I switch can only be used with /P or /M
)				;	[EDIT#107]
	JRST	START		;TRY AGAIN			[EDIT#107]
OPN1:	TRNE	SW, OPT.L	; LABEL OPTION?
	TRNN	SW, OPT.M	; AND MAINTAIN?
	JRST	.+2
	JRST	LBLERR		; YES
	TRNN	SW,OPT.B	;INPUT SEQUENTIAL (/B)?
	JRST	OPEN1		;NO, INDEXED
	PUSHJ	PP,OP1INB	; OPEN PRIMARY INPUT BUFFERED
	JRST	OPEN2		; NOW OPEN INDEXED OUTPUTS

	; OPEN PRIMARY INDEXED INPUT

OPEN1:	PUSHJ	PP,OP1INX	; OPEN PRIMARY INPUT INDEXED
	TRNE	SW,OPT.C	; /C?
	JRST	OPEN4		; YES, NO OUTPUT SIDE
	TRNN	SW,OPT.P	; /P??
	JRST	OPEN2		; NO, OPEN INDEXED OUTPUTS
	PUSHJ	PP,OP2OTB	; YES, OPEN SEQ OUTPUT
	JRST	OPEN4		; ALL DONE FOR /P

	; HERE FOR OPENING INDEXED OUTPUT FILES (/B/M)


OPEN2:	TRNE	SW,OPT.R	; /RENAME?
	JRST	OPEN4		; YES, DON'T OPEN OUTPUT SIDE
	PUSHJ	PP,OP1OTX	; OPEN PRIMARY INDEXED OUTPUT
	PUSHJ	PP,OP2OTX	; OPEN SECONDARY INDEXED OUTPUT


OPEN4:	TLNE	SW,(FERROR)	;IF TROUBLE,
	JRST	START		; QUIT AND TRY ANOTHER
	JRST	CKMNLB		; OK, GO CHECK LABELING
	; SOME ROUTINES TO OPEN THE PRIMARY AND SECONDARY INPUT
	; AND OUTPUT FILES

	; OPEN THE PRIMARY INPUT FILE SEQ

OP1INB:	MOVEI	TA,14		;/B: BUFFERED INPUT
	MOVEI	TC,IF1BUF
	MOVE	TB,IF1DAT+DEV	;GET INPUT DEVICE
	DEVCHR	TB,		;GET CHARACTERISTICS
	TRNE	TB,DV.M14	;DOES IT SUPPORT BINARY MODE?
	JRST	OP1IN1		;YES
	TLO	SW,(FERROR)
	TYPE	(?Device )
	MOVE	TE,IF1DAT+DEV
	PUSHJ	PP,PUTSIX
	TYPE	(: does not support binary mode
)
	POPJ	PP,

	; OPEN THE PRIMARY INPUT FILE INDEXED

OP1INX:	MOVE	TB,IF1DAT+DEV	;/M OR /P /R /C: INPUT DEVICE MUST BE A DISK
	CALLI	TB,$GETCH
	TLNN	TB,$DSK
	JRST	BADDEV		;NOT A DISK

	MOVEI	TA,17		; DUMP MODE INPUT
	MOVEI	TC,0

OP1IN1:	MOVE	TB,IF1DAT+DEV	;OPEN PRIMARY INPUT FILE
	OPEN	IF1,TA
	PUSHJ	PP,CANTOP	;PROBLEMS
	POPJ	PP,		; RETURN		

	; OPEN PRIMARY OUTPUT FILE

OP1OTX:	MOVE	TA,OF1DAT+DEV	;/B OR /M /R /C: OUTPUT DEVICES MUST BE DISKS
	CALLI	TA,$GETCH
	TLNN	TA,$DSK
	JRST	BADDEV		;INDEX DEVICE NOT A DISK

	MOVEI	TA,17		;/B /M /R /C: DUMP MODE OUTPUT
	MOVEI	TC,0


	MOVE	TB,OF1DAT+DEV	;OPEN THE PRIMARY OUTPUT FILE
	OPEN	OF1,TA
	PUSHJ	PP,CANTOP	;PROBLEMS
	POPJ	PP,
	
	; OPEN SECONDARY OUTPUT FILE
	; BUFFERED (/P)

OP2OTB:	TLNN	SW,(FASCII)	; [142] SEQUENTIAL ,/P, -  IS IT ASCII? 
	JRST	OP2OT0		; [142] NO USES BINARY
	MOVEI	TA,1		; [142] ASCII SET MODE FOR OPEN
	JRST	OP2OT1 		; [142]  ASCII SET UP

	; INDEXED

OP2OTX:	MOVE	TA,OF2DAT+DEV	;/B OR /M /R /C: OUTPUT DEVICES MUST BE DISKS
	CALLI	TA,$GETCH
	TLNN	TA,$DSK
	JRST	BADDEV		;INDEX DEVICE NOT A DISK


OP2OT0:	MOVEI	TA,14		;/P: PRIMARY OUTPUT, /B /M /R /C: SEC. OUTPUT
OP2OT1:	MOVE	TB,OF2DAT+DEV	; [142]
	MOVSI	TC,OF2BUF
	OPEN	OF2,TA
	PUSHJ	PP,CANTOP	;CAN'T
	MOVEI	TE,TA		; [142] GET BUFFER SIZE
	DEVSIZ	TE,		; [142]
	MOVEI	TE,^D131	; [142] USE DSK
	SUBI	TE,2		; [142] SUBTRACT HEADR SIZE (3) - 1
	HRRZM	TE,OF2SIZ	; [142] STORE BUFFER SIZE +1
	POPJ	PP,		; RETURN
	;CHECK FOR AUTOMATIC MONITOR LABELING

CKMNLB:	SETZM	AUTOLB		;INIT MONITOR-LABEL SWITCH
	TRNE	SW,OPT.B+OPT.P	;BUILD OR PACK?
	JRST	CKMTA		; YES, CHECK FOR MTA
	TRNN	SW,OPT.L	;LABEL OPTION?
	JRST	CKNAM		; NO, GO CHECK NAMES
	JRST	LBLERR		; YES, BAD COMMAND

CKMTA:	MOVE	TA,IF1DAT	;CHANNEL FOR DEVCHR
	TRNN	SW,OPT.B	;CORRECT (BUILD/INPUT)?
	MOVE	TA,OF2DAT	;NO, IT'S PACK/OUTPUT
IFE TOPS20,<
	MOVEM	TA,MTACHN	;SAVE CHANNEL
>				;END IFE TOPS20
	CALLI	TA,$GETCH	;GET DEVICE CHARACTERISTICS
	TLNE	TA,$DSK		;DEVICE + DISK?
	JRST	[TLNN	TA,$CDR		;& CARD READER TOO?
		JRST	CKMTA1		; NO, NEXT CHECK
		TRO	SW,FNUL		; YES, DEVICE=NUL:
		JRST	CKMTA2	]	; DON'T CHECK MTA FLAG
CKMTA1:	TLNE	TA,$MTA		;MAG TAPE?
	TLO	SW,(FMTA)	; YES, SET FLAG
CKMTA2:	PUSHJ	PP,CKLBL	;CHECK AUTO LABELING

CKNAM:	SKIPE	,IF1DAT+FILNAM	;INPUT FILE NAME GIVEN?
	JRST	LOOK		;CHECKING NOT NEC
	SKIPN	,OF1DAT+FILNAM	;ALSO NULL OUTPUT NAME?
	JRST	BADCOM		; BAD COMMAND IF YES
	TRNN	SW,OPT.B	;BUILD FILE?
	JRST	BADCOM		; NO, BAD COMMAND
	TLNN	SW,(FMTA)	; YES, FROM TAPE?
	TRNE	SW,FNUL		; OR NUL:?
	JRST	LOOK		; YES, CONTINUE
	JRST	BADCOM		; NO, BAD COMMAND LINE


	; DO THE LOOKUPS AND/OR ENTERS

LOOK:	PUSHJ	PP,LOOK1I	; LOOKUP PRIMARY INPUT FILE
	TRNE	SW,OPT.R+OPT.C	; /RENAME OR /CHECK ?
	JRST	STAT		; YES, DON'T ENTER OUTPUT SIDE
	TRNN	SW,OPT.P	; /P?
	PUSHJ	PP,ENTR1	; NO, ENTER PRIMARY OUTPUT FILE
	PUSHJ	PP,ENTR2	; YES, ENTER THE SECONDARY OUTPUT FILE
	TLNE	SW,(FERROR)	; IF THERE WAS TROUBLE,
	JRST	START		;  QUIT
	JRST	LOOK1		; ELSE CONT
	; ROUTINES TO DO LOOKUP AND ENTERS


	; LOOK UP PRIMARY INPUT FILE

LOOK1I:
IFN	$CU001,<	;MAKE ISAM MORE INTELLIGENT
	MOVE	TA,IF1DAT+DEV		;GET DEVICE
	CALLI	TA,$GETCH		;SEE IF IT IS A DSK:
	TLNN	TA,$DSK
	 JRST	LOOKT1			;IF NOT DO REGULAR LOOKUP
	MOVE	TA,IF1DAT+FILNAM  ;LOOKUP THE PRIMARY INPUT FILE
	HLLZ	TB,IF1DAT+FILEXT
	MOVE	TC,IF1DAT+PPNUM
	MOVEM	TA,IF1LB+.RBNAM
	MOVEM	TB,IF1LB+.RBEXT
	MOVEM	TC,IF1LB+.RBPPN
	MOVEM	TC,IF2DAT+PPNUM		;REMEMBER PPN FOR SECOND INPUT FILE
	MOVEI	TA,.RBEST	;STORE LENGTH OF EXTENDED LOOKUP BLOCK
	MOVEM	TA,IF1LB+.RBCNT
	LOOKUP	IF1,IF1LB	;LOOKUP THE FILE
	 PUSHJ	PP,LOOKF	;WHAT HAPPENED?
	JRST	LOOKT2
LOOKT1:
	>;END OF IFN $CU001

	MOVE	TA,IF1DAT+FILNAM  ;LOOKUP THE PRIMARY INPUT FILE
	HLLZ	TB,IF1DAT+FILEXT
	MOVEI	TC,0
	MOVE	TD,IF1DAT+PPNUM
	MOVEM	TD,IF2DAT+PPNUM	;IF2PPN = IF1PPN
	LOOKUP	IF1,TA
	PUSHJ	PP,LOOKF	;ERROR   

IFN	$CU001,<	;MAKE ISAM MORE INTELLIGENT
LOOKT2:
	>;END OF IFN $CU001

	TRNE	SW, OPT.P
	MOVEM	TA+2, SA.CRE	; SAVE CREATION DATE FOR PACK OPTION

	POPJ	PP,	; RETURN



	; LOOK UP THE PRIMARY OUTPUT FILE

LOOK1O:	MOVE	TA,OF1DAT+FILNAM ; GET OUT FILE NAME
	HLLZ	TB,OF1DAT+FILEXT ; GET OUT FILE EXT	
	MOVEI	TC,0
	MOVE	TD,OF1DAT+PPNUM
	LOOKUP	OF1,TA
	 PUSHJ	PP,LOOKF	; ERROR  
	POPJ	PP,		; RETURN


	; DO ENTER FOR PRIMARY OUTPUT FILE

ENTR1:	MOVE	TA,OF1DAT+FILNAM  ;ENTER THE PRIMARY OUTPUT FILE
	HLLZ	TB,OF1DAT+FILEXT
	MOVEI	TC,0
	MOVE	TD,OF1DAT+PPNUM
	ENTER	OF1,TA
	PUSHJ	PP,ENTRFA	;ERROR  [ED#113]
	POPJ	PP,		; RETURN


	; ENTER SECONDARY OUTPUT FILE

ENTR2:	MOVE	TA,OF2DAT+FILNAM  ;/B OR /M: ENTER THE SEC. OUT FILE (/P: PRIM.)
	HLLZ	TB,OF2DAT+FILEXT
	MOVEI	TC,0
	MOVE	TD,OF2DAT+PPNUM
	ENTER	OF2,TA
	PUSHJ	PP,ENTRFB	;ERROR  [ED#113]
	POPJ	PP,		; RETURN
	; SET SOME FLAGS AND CHECK MTA STUFF

LOOK1:
	TRNE	SW,OPT.M	;ANY SEQUENTIAL I/O?
	JRST	STAT		;NO

	MOVE	TE,IF1DAT+DEV	;GET SEQUENTIAL FILE DEVICE TYPE
	TRNN	SW,OPT.B	;IF1DEV FOR /B
	MOVE	TE,OF2DAT+DEV	;OF2DEV FOR /P
	CALLI	TE,$GETCH
	TLNE	TE,$DSK		;IF DSK, SET DSK FLAG
	TLO	SW,(FDSK)
	TLNE	TE, $MTA	;IF MTA, SET MTA FLAG
	TLO	SW,(FMTA)
	TLNE	TE,$DTA		;[112]IF DTA, SET DTA FLAG
	TLO	SW,(FDTA)	;[112]

	;THIS ROUTINE SETS STANDARD ASCII MODE 
	;THE REQUEST IS IGNORED IF THE DEVICE IS NOT A TU70
SSA:	CAIE	IM,MA.MOD	; STD ASCII FOR INPUT DEVICE?
	CAIN	OM,MA.MOD	; ...FOR OUTPUT DEVICE?
	SKIPA			; DO MTA TEST IF EITHER
	JRST	SSAX		; NO, CONTINUE
	TLNN	SW,(FMTA)	; YES, IS DEVICE A MTA?
	JRST	[TRNN	SW,OPT.B	;NO, INPUT OR OUTPUT?
		SKIPA	OM,[AS.MOD]	; OUTPUT!
		MOVEI	IM,AS.MOD	; INPUT!
		JRST	SSAX		];SKIP CONTROLLER CODE;
	MOVEI	TA,.TFKTP	; FUNCT = GET CONTROLER TYPE
	MOVE	TB,IF1DAT+DEV	; GET DEVICE NAME
	TRNN	SW,OPT.B	; --
	MOVE	TB,OF2DAT+DEV	; --
	MOVE	TC,[2,,TA]	; POINT AT ARG BLOCK
	TAPOP.	TC,		; GET THE CONTROLER TYPE
	 JRST	TFCERR		; COMPLAIN
	CAIE	TC,.TU70	; IS IT A TU70?
	CAIN	TC,.TM02	;[153] NO, IS IT A TU16 OR TU45?
	SKIPA			;[153] YES, OK
	JRST	ERMVAS		;TELL THEM THEY CAN'T DO THAT

	MOVEI	TA,.TFMOD	; FUNCT = SET RECORDING MODE
	MOVE	TB,IF1DAT+DEV	; GET DEVICE NAME
	TRNN	SW,OPT.B	; --
	MOVE	TB,OF2DAT+DEV	; --
	MOVEI	TC,.TFM7B	; MODE = STANDARD ASCII
	MOVE	TD,[3,,TA]	; POINT TO AGR BLOCK
	TAPOP.	TD,		; SET STD ASCII MODE
	 JRST	TFCERR		; COMPLAIN
SSAX:
STAT:	MOVE	TE,[STHDR,,STHDR+1]  ;CLEAR STATISTICS BLOCKS
	SETZM	STHDR
	BLT	TE,STAT2+STATSZ-1

	TRNN	SW,OPT.P+OPT.M+OPT.R+OPT.C ;INDEX FILE INPUT?
	JRST	ASKM		;NO

	MOVE	TA,[IOWD STATSZ,STAT2]  ; READ INPUT FILE STAT BLK
	MOVEI	TB,0
	IN	IF1,TA
	  SKIPA	TA,[STAT2,,STHDR]  ;OK, INIT OUTPUT STAT = INPUT STAT
	JRST	STATER		;ERROR

	TRNE	SW,OPT.R	; SKIP IF NOT /RENAME 
	JRST	STAT1		; ELSE SKIP STAT CHANGES

	BLT	TA,STHDR+STATSZ-1
	HRRZS	STHDR		;EXCEPT CLR FILE FORMAT FLAG

	SETZM	LEVELS		;/M: CLEAR STAT LOCS THAT MUST BE REDONE
	SETZM	NDATB
	MOVE	TE,[NDATB,,NDATB+1]
	BLT	TE,FEISEC
	SETZM	NUMOPS
	MOVE	TE,[NUMOPS,,NUMUUO]
	BLT	TE,SATBIT
	SETZM	IDXADR


STAT1:	MOVEI	TA,17		;OPEN SECONDARY INPUT FILE
	MOVE	TB,IF1DAT+DEV
	MOVEM	TB,IF2DAT+DEV
	MOVEI	TC,0
	OPEN	IF2,TA
	PUSHJ	PP,CANTOP	;CAN'T
	TLNE	SW,(FERROR)	;RESTART IF ERROR
	JRST	START

	MOVE	TA,STNAM+I	;GET SPECIFICATIONS FOR INPUT DATA FILE
	MOVEM	TA,IF2DAT+FILNAM
	MOVE	TB,STEXT+I
	MOVEM	TB,IF2DAT+FILEXT
	MOVEI	TC,0
	MOVE	TD,IF2DAT+PPNUM

	LOOKUP	IF2,TA		;FIND DATA FILE
	PUSHJ	PP,LOOKF	;ERROR
	TLNE	SW,(FERROR)	;RESTART AFTER ERROR
	JRST	START


	; IF /R (RENAME) NOW GO DO IT

	TRNN	SW,OPT.R	; /R?
	JRST	ASKM		; NO, ASK QUESTIONS
SUBTTL	RENAME THE INPUT INDEXED FILE

	; RENAME THE PRIMARY INPUT (IDX) FILE SAME AS PRIMARY OUT FILE

	MOVE	TA,OF1DAT+FILNAM  ;ENTER THE PRIMARY OUTPUT FILE
	HLLZ	TB,OF1DAT+FILEXT
	MOVEI	TC,0
	MOVE	TD,OF1DAT+PPNUM
	RENAME	IF1,TA
	PUSHJ	PP,RENAMA	;ERROR  [ED#113]

	TLNE	SW,(FERROR)	;RESTART AFTER ERROR
	JRST	START

	; RENAME THE SECONDARY INPUT (IDA) FILE SAME AS SECONDARY OUT FILE

	MOVE	TA,OF2DAT+FILNAM  ;RENAME THE SECONDARY OUTPUT FILE
	HLLZ	TB,OF2DAT+FILEXT
	MOVEI	TC,0
	MOVE	TD,OF2DAT+PPNUM
	RENAME	IF2,TA
	PUSHJ	PP,RENAMB	;ERROR  [ED#113]

	TLNE	SW,(FERROR)	;RESTART AFTER ERROR
	JRST	START

	; NOW OPEN THE PRIMARY PUTPUT FILE (NEW IDX FILE) AND PUT THE
	; NEW IDA NEW INTO THE STAT BLOCK, WHICH HAS ALREADY BEEN 
	; READ INTO THE STAT2 AREA

	PUSHJ	PP,OP1OTX	; OPEN PRIMARY OUTPUT INDEXED FILE
	PUSHJ	PP,LOOK1O	; LOOKUP PRIMARY OUT FILE 
				;  TO SAVE REST OF DATA
	PUSHJ	PP,ENTR1	; DO ENTER ON PRIMARY OUTPUT FILE
				;  SO CAN WRITE NEW STAT BLOCK

	TLNE	SW,(FERROR)	;RESTART AFTER ERROR
	JRST	START

	MOVE	TA,OF2DAT+FILNAM ; GET OUTPUT IDA NAME
	MOVEM	TA,STNAM+I	; RESET IDA NAME IN STAT BLOCK

	MOVE	TB,OF2DAT+FILEXT ; GET OUTPUTX IDA EXT
	MOVEM	TB,STEXT+I	; RESET IDA EXT IN STAT BLOCK


	; NOW WRITE OUT THE NEW STAT BLOCK

	MOVE	TA,[IOWD STATSZ,STAT2] ; WRITE INPUT FILE STAT BLK
	MOVEI	TB,0
	OUT	OF1,TA
	  JRST	RENAMX		; AOK, FINISH UP 
	JRST	IDXERA		;ERROR

RENAMX:	CLOSE	OF1,		; CLOSE OUTPUT IDX FILE
	RELEASE	OF1,		; RELEASE
	JRST	FIN$		; AND BACK TO BEGIN
SUBTTL	GET FILE PARAMETERS

; THESE QUESTIONS ARE ASKED BEFORE FILES ARE OPENED SO THAT SPECIAL
; MODES CAN BE HANDLED THERE

IOMOD:	TRNE	SW,OPT.B	;/B?
	JRST	ASKM2		;YES

	TRNE	SW,OPT.M	;/M?
	POPJ	PP,

	MOVE	TB,OF2DAT+DEV	; [142] NO, SEQUENTIAL
	DEVCHR	TB,		; [142] GET DEVICE CHARACTERISTICS
	TLNN	TB,DV.OUT	; [142]  ALSO CHECK IF OUTPUT DEVICE
	JRST	ILLDEV 		; [142] ILLEGAL
	TRNE	TB,DV.M14	; [142] SEE IF DEVICE CAN USE BINARY
	JRST	ASKM1		; [142] IT CAN GO ON
	TLO	SW,(FASCII)	; [142] SET /P DEVICE ASCII
ASKM1:	MOVEI	TB,AS.MOD	; [142] ASSUME OUTPUT DEVICE ASCII
	TLNE	SW,(FASCII)	; [142] IS IT REALLY ASCII?
	JRST	ASKM3A		; [142] YES DONT ASK
ASKM1A:	TLNE	SW,(INDIR)	;SKIP QUESTION IF INDIR CMD FILE
	JRST	ASKM1B
	TYPE	(Mode of output file: ) ;/P
ASKM1B:	PUSHJ	PP,GETMOD				;[EDIT 107]
	JRST	.-2					;[EDIT 107]
;	NEXT LINE DELETED, CAUSES INCORRECT FLOW IN CASE OF NULL RESPONSE/BL
;	JRST	ASKM3A					;[EDIT 107]
	JUMPGE	TB,ASKM3B	;JUMP IF VALID MODE
	TYPE	(?ISMRSP	Response required.
)				;ERROR MESSAGE
	JRST	ASKM1A		;GO ASK AGAIN

ASKM2:	TLNE	SW,(INDIR)	;SKIP QUESTION IF INDIR CMD FILE
	JRST	ASKM2F
ASKM2E:	TYPE	(Mode of input file: ) ;/B
ASKM2F:	PUSHJ	PP,GETMOD
	JRST	ASKM2E		; TROUBLE, TRY AGAIN
ASKM2A:	JUMPGE	TB,ASKM2D	; JUMP IF VALID RESPONSE GIVEN
	MOVE	TE,[SIXBIT "NUL"] ; TB=-1, NO RESPONSE
	CAMN	TE,IF1DAT+DEV	; WAS INPUT DEVICE "NUL:"
	AOJA	TB,ASKM2D	; YES, DEFAULT SIXBIT
	TYPE	(?ISMRSP	Response required.
)
	JRST	ASKM2E		; ASK AGAIN


ASKM2D:	MOVEI	IM,(TB)		;SET INPUT MODE

ASKM2B:	TLNE	SW,(INDIR)	;SKIP QUESTION IF INDIR CMD FILE
	JRST	ASKM3
ASKM2C:	TYPE	(Mode of data file: )
ASKM3:	PUSHJ	PP,GETMOD
	JRST	ASKM2C		; ASK ? AGAIN
ASKM3A:	JUMPGE	TB,ASKM3B	; JUMP IF A VALID MODE WAS GIVEN
	TYPE	(?ISMRSP	Response required.
)
	JRST	ASKM2C		; ASK ? AGAIN
ASKM3B:	MOVEI	OM,(TB)		;SET OUTPUT MODE
	POPJ	PP,


ASKM:
	TRNN	SW,OPT.B	;IS IT /P OR /M?
	LDB	IM,KY.MOD  	;/M OR /P: GET INPUT MODE FROM STATISTICS
;BL	1 LINE CHANGED TO FIX ILLEGAL MEM REF-QAR10-06073
	TRNE	SW,OPT.M+OPT.C	;IS IT /M OR /C?
	HRRZI	OM,(IM)		;/M: OUTPUT MODE SAME AS INPUT MODE

	;CHECK TO SEE THAT NO ONE ASKED FOR 35 BIT ASCII I/O ON 
	; SOMETHING OTHER THAN TU-70 MAG TAPE
	;[153] OR TU-16 OR TU-45.

;BL;	1 CHANGED AT ASKM+5 TO INFORM LAZY PROGRAMMER OF RECORD SIZE
	TRNN	SW,OPT.B+OPT.S	;BUILD OR STATS?
;	JRST	ASKM8		;NO, /P OR /M  [151] WRONG PLACE
ASKM5B:	JRST	[ MOVE	TE,RECBYT	;[151] RECOMPUTE RECSIZ
		JRST	ASKM6 ]		;[151] IN CASE WE CHANGED MODE

ASKM5:	TLNE	SW,(INDIR)	;SKIP QUESTION IF INDIR CMD FILE
	JRST	ASKM5A
	TYPE	(Maximum record size: )
;BL;	6 ADDED AT ASKM5+3 TO DISPLAY RECORD SIZE TO LAZY PROGRAMMER WITH /S
	TRNE	SW,OPT.B	;BUILD?
	  JRST	  ASKM5A	;  YES
	MOVE	TE,RECBYT	;NO, MUST BE STATS, LOAD REC SIZE
	PUSHJ	PP,PUTDEC	;DISPLAY IT
	TYPE	(
)				;NEW LINE
	JRST	ASKM5B		; AND REJOIN /M/C
ASKM5A:	PUSHJ	PP,GETPOS
	JRST	.-3
	CAILE	TE,7777		;RECORD SIZE MUST BE < 4096
	JRST	SIZERR		;TOO BIG

	MOVEM	TE,RECBYT
	;CONVERT RECORD SIZE TO WORDS
ASKM6:	;[151] RECOMPUTE RECSIZ IN CASE WE CHANGED MODE WITH /P
	CAIN	OM,AS.MOD	;ASCII??
	ADDI	TE,2		;ADD 2 FOR CRLF
	ADD	TE,BYWDM1(OM)	;ADD IN BYTES PER WORD MINUS ONE
	IDIV	TE,BYTWRD(OM)	;DIVIDE BY BYTES PER WORD
ASKM7:	MOVEM	TE,RECSIZ	; AND STORE IT AWAY
ASKM8:	PUSHJ	PP,GETKEY	;GET KEY DESCRIPTOR
	TRNE	SW,OPT.M
	JRST	ASKM12		;SKIP NEXT QUESTION IF /M

	MOVE	TE,LASTKB	;IF KEY WON'T
	CAMLE	TE,RECBYT	;  FIT IN RECORD,
	JRST	BIGKEY		;  WE HAVE TROUBLE

ASKM9:	TRNE	SW,OPT.C	; /CHECK ?
	JRST	ASKM14		; YES, SKIP QUESTIONS
	TRNN	SW,OPT.P
	JRST	ASKM10		;/B

	SETZ	TE,0		; [142] ASSUME UNBLOCKED
	TLNE	SW,(FASCII)	; [142] IF /P IS ASCII DONT ASK
	JRST	ASK11A		; [142]
	TLNE	SW,(INDIR)	;SKIP QUESTION IF INDIR CMD FILE
	JRST	ASKM9A
	TYPE	(Records per output block: )  ;/P
ASKM9A:	MOVEI	TE,0		;IF NO ANSWER, ASSUME UNBLOCKED
	JRST	ASKM11

ASKM10:	TLNE	SW,(INDIR)	;SKIP QUESTION IF INDIR CMD FILE
	JRST	ASKM11
	TYPE	(Records per input block: )	;/B
ASKM11:	PUSHJ	PP,GETNUM
	JRST	.-2
	JUMPE	TE,[		; SKIP IF BLK-FTR IS NONE ZERO
				; ELSE SET EBCDIC BLOCKING FACTOR TO 1
		TLNN	SW,(FMTA)	; DEVICE A MTA?
		JRST	.+1		; NO
		TRNE	SW,OPT.P	; SETUP TEST FOR SEQ FILE MODE
		EXCH	IM,OM		; EXCHANGE 
		CAIE	IM,MA.MOD	; IS IT STANDARD ASCII?
		CAIN	IM,EB.MOD	; IS IT EBCDIC?
		MOVEI	TE,1		; YES, CHANGE BF FROM 0 TO 1
		TRNE	SW,OPT.P	; RESTORE IM AND OM
		EXCH	IM,OM
		JRST	.+1	]
ASK11A:	MOVEM	TE,INPBLK	; [142] STORE INPUT BLOCK SIZE

	TRNE	SW,OPT.P
	JRST	ASKM14
ASKM12:	TRNE	SW,OPT.M	;/M?	[EDIT#140]
	TLO	SW,(FCEOFK)	;	[EDIT#140]
	MOVE	TE,DATBLK+I	;AIM AT DATBLK
	TLNE	SW,(INDIR)	;SKIP QUESTION IF INDIR CMD FILE
	JRST	SKM12A
	TYPE	(Total records per data block)
SKM12A:	PUSHJ	PP,MCUR		;IF /M, GIVE CURRENT
IFN	$CU001,<	;MAKE ISAM MORE INTELLIGENT
	TRNE	SW,OPT.B+OPT.M	;IF /B OR /M, RECOMMEND BLOCKING FCTR
	PUSHJ	PP,RECDBF	;FOR DATA FILE BLOCKING FACTOR
	>;END OF IFN $CU001
	PUSHJ	PP,GETNUM
	JRST	.-3
;BL;	9 REPLACED AT SKM12A+7
;IFE	$CU001,<	;MAKE ISAM MORE INTELLIGENT
;	TRNN	SW,OPT.B	;IF /B, POSITIVE RESPONSE REQUIRED
;	JRST	.+4		;NOT /B
;	JUMPG	TE,.+3		;OK
;	PUSHJ	PP,POSERR	;WARNING
;	JRST	ASKM12		;TRY AGAIN
;	>;END OF IFE $CU001
;	TLZE	SW,(FGETDC)	;IF /M, LEAVE AS IS IF NULL RESPONSE
;	MOVEM	TE,DATBLK

	TLZN	SW,(FGETDC)	;RESPONSE FROM USER?
	 JRST	SKM12B		; NO, GO USE DEFAULT
	JUMPG	TE,SKM12C	;POSITIVE RESPONSE, GO USE IT
	PUSHJ	PP,POSERR	;WARNING
	JRST	ASKM12		;& TRY AGAIN
SKM12B:	MOVE	TE,DATBLK+I	;ASSUME /M, DEFAULT=CURRENT
	TRNN	SW,OPT.M	;IS IT /M?
	MOVE	TE,RECBLK	; NO, MUST BE /B, USE RECOMMENDED VALUE
SKM12C:	MOVEM	TE,DATBLK	;SET BLOCKING FACTOR

ASKM13:	MOVE	TE,EMPDAT+I	;AIM AT EMPDAT
	TLNE	SW,(INDIR)	;SKIP QUESTION IF INDIR CMD FILE
	JRST	SKM13A
	TYPE	(Empty records per data block)
SKM13A:	PUSHJ	PP,MCUR		;IF /M, GIVE CURRENT
	PUSHJ	PP,GETNUM
	JRST	.-3
	TLZE	SW,(FGETDC)	;LEAVE AS IS IF NULL RESPONSE
	MOVEM	TE,EMPDAT

ASKM14:	MOVN	TE,EMPDAT	;COMPUTE
	ADD	TE,DATBLK	;  RECORDS
	MOVEM	TE,DATRIT	;  TO USE
	JUMPLE	TE,TOOMCH	;IF NOT POSITIVE, ERROR

	MOVE	TE,RECSIZ	;COMPUTE
	ADDI	TE,1		;  NUMBER
	IMUL	TE,DATBLK	;  OF
	ADDI	TE,177		;  SECTORS
	LSH	TE,-7		;  PER DATA BLOCK
	hllzi	ch,		;clear
	movem	ch,pagbuf	; page sw
IFN TOPS20,<
	TRNN	SW,OPT.OP	;OUTPUT IN PAGES?
	JRST	.+5		;NO, SKIP SHIFT
	ADDI	TE,3		;IN PAGE MULTIPLES
	LSH	TE,-2
	LSH	TE,2
	HRROI	CH,-1		;
	MOVEM	CH,PAGBUF	;SET PAGE SW IN STAT BLOCK
>				;END IFN TOPS20
	MOVEM	TE,DATSEC

ASKM15:	TRNE	SW,OPT.P+OPT.C
	JRST	ASKM16		; /CHECK OR /PACK SKIP QUESTION

	MOVE	TE,IDXBLK+I	;AIM AT IDXBLK
	TLNE	SW,(INDIR)	;SKIP QUESTION IF INDIR CMD FILE
	JRST	SKM15A
	TYPE	(Total entries per index block)
SKM15A:	PUSHJ	PP,MCUR		;IF /M, GIVE CURRENT
IFN	$CU001,<	;MAKE ISAM MORE INTELLIGENT
	TRNE	SW,OPT.B+OPT.M	;IF /B OR/M, RECOMMEND BLOCK FCTR
	PUSHJ	PP,RECIBF
	>;END OF IFN $CU001
	PUSHJ	PP,GETNUM
	JRST	.-3

;BL;	10 REPLACED BY 11 AT ASKM15+13
;IFE	$CU001,<	;MAKE ISAM MORE INTELLIGENT
;	TRNN	SW,OPT.B	;IF /B, POSITIVE RESPONSE REQUIRED
;	JRST	.+4		;NOT /B
;	JUMPG	TE,.+3		;OK
;	PUSHJ	PP,POSERR	;WARNING
;	JRST	ASKM12		;TRY AGAIN
;	>;END OF IFE $CU001
;	TLZE	SW,(FGETDC)	;IF /M, LEAVE AS IS IF NULL RESPONSE
;	MOVEM	TE,IDXBLK
;	MOVE	TE,IDXBLK

	TLZN	SW,(FGETDC)	;RESPONSE FROM USER?
	 JRST	SKM15B		; NO, GO USE DEFAULT
	JUMPG	TE,SKM15C	;POSITIVE RESPONSE, GO USE IT
	PUSHJ	PP,POSERR	;WARNING
	JRST	ASKM15		;& TRY AGAIN
SKM15B:	MOVE	TE,IDXBLK+I	;ASSUME /M, DEFAULT=CURRENT
	TRNN	SW,OPT.M	;IS IT /M?
	MOVE	TE,RECBLK	; NO, MUST BE /B, USE RECOMMENDED VALUE
SKM15C:	CAIGE	TE,2		;MUST HAVE AT LEAST 2
	JRST	TOOFEW		;ERROR
	MOVEM	TE,IDXBLK	;SET BLOCKING FACTOR


	MOVE	TE,[IDXBLK,,IDXBLK+1]	;ALL LEVELS THE SAME
	BLT	TE,IDXBLK+^D9

ASKM16:	MOVE	TE,SIZIDX
	IMUL	TE,IDXBLK	;MULTIPLY INDEX ENTRY SIZE BY BLOCKING
	ADDI	TE,1+177	;ADD 1 WORD FOR HEADER, AND ROUND UP
	LSH	TE,-7		;CONVERT TO SECTORS
IFN TOPS20,<
	TRNN	SW,OPT.OP	;OUTPUT IN PAGES?
	JRST	.+4		;NO, SKIP SHIFT
	ADDI	TE,3		; IN PAGE MULTIPLES
	LSH	TE,-2
	LSH	TE,2
>				;END IFN TOPS20
	MOVEM	TE,IDXSEC

	MOVEI	TE,1		;FIRST EMPTY INDEX SECTOR IS
	MOVEM	TE,FEISEC	;  NUMBER 1

	MOVE	TE,SIZIDX	;COMPUTE
	IMUL	TE,IDXBLK	;  NUMBER OF
	ADDI	TE,1		;  BYTES IN
	IMULI	TE,6		;  INDEX
	MOVEM	TE,STHDR	;  BLOCK
;	CAILE	TE,7777		;IF IT IS NOT TOO BIG, ALL IS WELL
;	JRST	BIGIDX		;IT IS TOO BIG

	TRNE	SW,OPT.P+OPT.C	; /CHECK OR /PACK ?
	JRST	ASKM17		; SKIP QUESTION

	MOVE	TE,EMPIDX+I	;AIM AT EMPIDX
	TLNE	SW,(INDIR)	;SKIP QUESTION IF INDIR CMD FILE
	JRST	SKM16A
	TYPE	(Empty entries per index block)
SKM16A:	PUSHJ	PP,MCUR		;IF /M, GIVE CURRENT
	PUSHJ	PP,GETNUM
	JRST	.-3
	TLZE	SW,(FGETDC)	;LEAVE AS IS IF NULL RESPONSE
	MOVEM	TE,EMPIDX

	MOVE	TE,[EMPIDX,,EMPIDX+1]	;ALL LEVELS THE SAME
	BLT	TE,EMPIDX+^D9

ASKM17:	MOVN	TE,EMPIDX	;COMPUTE
	ADD	TE,IDXBLK	;  NUMBER OF
	MOVEM	TE,IDXRIT	;  ENTRIES TO USE
	CAIG	TE,1		;IF ONLY ONE ENTRY
	JRST	TOOFEW		;  OR IF NOT POSITIVE, ERROR

	TRNE	SW,OPT.P+OPT.C	; /CHECK OR /PACK ?
	JRST	SETIO		; ALL DONE HERE, SETUP FOR IO

ASKM18:	MOVE	TE,%DAT+I	;AIM AT %DAT
	TLNE	SW,(INDIR)	;SKIP QUESTION IF INDIR CMD FILE
	JRST	SKM18A
	TYPE	(Percentage of data file to leave empty)
SKM18A:	PUSHJ	PP,MCUR		;IF /M, GIVE CURRENT
	PUSHJ	PP,GETNUM
	JRST	.-3
	TLZE	SW,(FGETDC)	;LEAVE AS IS IF NULL RESPONSE
	MOVEM	TE,%DAT
	CAIGE	TE,^D100	;% MUST BE 0 .LE. N .LT. 100
	JUMPGE	TE,ASKM19	;OK
	JRST	ERR%DA

ASKM19:	MOVE	TE,%IDX+I	;AIM AT %IDX
	TLNE	SW,(INDIR)	;SKIP QUESTION IF INDIR CMD FILE
	JRST	SKM19A
	TYPE	(Percentage of index file to leave empty)
SKM19A:	PUSHJ	PP,MCUR		;IF /M, GIVE CURRENT
	PUSHJ	PP,GETNUM
	JRST	.-3
	TLZE	SW,(FGETDC)	;LEAVE AS IS IF NULL RESPONSE
	MOVEM	TE,%IDX
	CAIGE	TE,^D100
	JUMPGE	TE,ASKM20
	JRST	ERR%IX

ASKM20:	MOVE	TE,MAXSAT+I	;AIM AT MAX # RECORDS
	TLNE	SW,(INDIR)	;SKIP QUESTION IF INDIR CMD FILE
	JRST	SKM20A
	TYPE	(Maximum number of records file can become)
SKM20A:	PUSHJ	PP,MCUR
	PUSHJ	PP,GETNUM
	JRST	.-3
	TLZE	SW,(FGETDC)
	MOVEM	TE,MAXSAT

;NOW FILL IN SOME STATISTIC WORDS

	MOVE	TE,[XWD OF2DAT+DEV,STDEV]
	BLT	TE,STEXT

	CALLI	TE,$DATE	;FIX
	MOVEM	TE,CREATE	;  CREATION DATE AND
	MOVEM	TE,ACCDAT	;  ACCESS DTAE

;IFN TOPS20,<
;	PUSHJ	PP,ASCNAM	;PUT TOPS20 FILE-SPEC
;>

	DPB	OM,KY.MOD	;STORE OUTPUT MODE

IFE TOPS20,<

IFN	$CU001,<	;MAKE ISAM MORE INTELLIGENT
ALLM:	TRNN	SW,OPT.M	;SEE IF IN /M MODE
	 JRST	ALLB		;NO SO TEST FOR /B?
	MOVE	TA,DATBLK	;GO CALCULATE SOME THINGS
	PUSHJ	PP,FNDSTA	;TO USE FOR OUR CALCS
	MOVE	TA,NDATB+I	;GET # OF DATA BLOCKS IN FILE
	ADD	TA,NDATBE+I	;AND ADD NUMBER OF EMPTY ONES
	IMUL	TA,DATBLS	;TIMES # OF PHYSICAL DISK BLOCKS PER DATA BLOCK
	ADDI	TA,2		;ADD IN ROOM FOR THE PRIME AND SPARE RIBS
	PUSHJ	PP,ALOF2	;GO DO EXTENEDED ENTER FOR OUTPUT DATA FILE
	MOVE	TA,NSECI+I	;NOW GET # SECTORS(PHYS DISK BLOCK) IN INDEX FILE
	ADD	TA,NSECIE+I	;ADD IN NUMBER OF EMPTIES
	ADDI	TA,2		;ADD IN ROOM FOR PRIME/SPARE RIBS
	MOVE	TB,LEVELS+I	;GET # OF LEVELS
	MOVEM	TB,CLLVLS	;ADN STORE FOR LATER
	PUSHJ	PP,ALOF1	;GO DO EXTENDED ENTER FOR IDX FILE
	JRST	SETIO
ALLB:
	TRNN	SW,OPT.B	;SEE IF WE ARE BUILDING
	 JRST	SETIO		;IF NOT JUST CONTINUE SINCE NOT /M OR /B
	MOVE	TA,IF1DAT+DEV	;SEE IF INPUT FILE IS ON DISK
	CALLI	TA,$GETCH	;SINCE WE DON'T DO AN EXTENDED LOOKUP OTHERWISE
	TLNN	TA,$DSK		;IF IT ISN'T JUST CONTINUE LIKE WE ALWAYS HAVE
	 JRST	SETIO
	MOVE	TA,IF1LB+.RBSIZ	;GET ISZE OF THE FILE FOR APPROXIMATION OF OUTPUT FILE SIZES
	IMUL	TA,BYTWRD(IM)	;CALCULATE # OF BYTES THAT IS
	MOVE	TC,RECBYT	;GET RECORD SIZE IN BYTES
	CAIN	IM,AS.MOD	;AND ADD IN 2 IF IT
	 ADDI	TC,2		;IS IN ASCII MODE
	IDIV	TA,TC		;NOW SEE HOW MANY RECORDS THERE CAN BE IN INPUT
	MOVE	TC,TA		;SAVE IT FOR A WHILE
	IDIVI	TA,^D10		;GET A TENTH OF IT FOR EXTRA 10%
	SKIPN	TA		;SEE IF THERE IS ANY
	 AOS	TA		;IF NONE MAKE IT ONE
	ADD	TA,TC		;THEN PUT THEM TOGETHER
	MOVE	TB,DATRIT	;GET # OF ENTRIES TO USE
	IDIV	TA,TB		;GET APPROX NUMBER OF DATA BLOCKS NEEDED
	SKIPN	TA		;SEE IF THERE ARE
	 AOS	TA		;ANY AND IF NOT MAKE AT LEAST ONE
	MOVE	TD,TA		;PUT OUT OF THE WAY FOR A BIT
	MOVE	TA,DATBLK	;SEE IF WE NEEDE TO RECALCULATE PHYSICAL BLOCKS PER DATA BLOCK
	CAME	TA,IDABF	;IF SO GO DO IT
	 PUSHJ	PP,FNDSTA	;SO WE CAN FIND DISK BLOCKES NEEDED
	IMUL	TD,DATBLS	;CALCULATE  DISK BLOCKS REQUIRED
	MOVE	TA,TD		;RESTORE # OF BLOCKS NEEDED ON DISK
	IMUL	TA,%DAT		;SEE IF WE MUST ADD ANY EMPTIES
	MOVEI	TB,^D100
	SUB	TB,%DAT		;AND IF SO THEN ADD THEM
	IDIVI	TA,(TB)
	ADDI	TA,1		;ALWAYS ROUNDING UP
	SKIPG	TA		;MAKE SURE IS POSITIVE
	 MOVEI	TA,1		;ELSE SET TO ONE
	ADD	TD,TA		;ADD INTO TOTAL
	ADDI	TD,2		;AND INCLUDE TWO BLOCKS FOR THE RIB'S
	MOVE	TA,TD		;THEN PRIME FOR CALL TO ALOF2
	PUSHJ	PP,ALOF2	;GO DO THE EXTENDED ENTER
	MOVE	TA,IDXRIT	;GET # OF ENTRIES TO USE
	SETZB	TE,TF		;USE TE TO COUNT BLOCKS NEEDED
	MOVE	TB,TD		;GET NUMBER OF ENTRIES ON LOWEST LEVEL AGAIN
ALLBL:	IDIV	TB,TA		;GET NUMBER OF INDEX BLOCKS ON THE LOWEST LEVEL
	SKIPN	TB		;WE ARE DONE IF 0
	 JRST	ALLBX		;SO GO TO EXIT OF LOOP
	ADD	TE,TB		;ADD INTO TOTAL
	CAML	TB,TA		;ONLY INCREMENT LEVEL IF NEED TO
	 AOS	TF		;ADD ONE TO LEVELS COUNTER
	JRST	ALLBL		;GO THRU LOOP UNTIL ALL DONE
ALLBX:	AOS	TE		;ADD 1 INTO COUNTER FOR TOP INDEX BLOCK
	AOS	TF		;AND ADD 1 TO LEVEL COUNTER
	MOVEM	TF,CLLVLS	;SAVE CALCULATED LEVELS
	MOVE	TA,IDXSEC	;GET LENGTH OF INDEX BLOCK IN BITS FOR SAT BLOCK
	LSH	TA,7		;CONVERT TO WORDS
	SUBI	TA,1		;REMOVE THE HEADER WORD
	IMULI	TA,^D36		;CONVERT TO BITS
	MOVE	TB,MAXSAT	;GET WHAT USER SPECIFIED AS MAXIMUM
	IDIV	TB,DATBLK	;CONVERT TO DATA BLOCKS
	IDIV	TB,TA		;CONVERT TO NUMBER OF SAT BLOCKS NEEDED
	MOVE	TC,TE		;GET TOTAL SO FAR TO SEE IF HAVE TO ADD ANY EMPTIES
	IMUL	TC,%IDX		;CALC HOW MANY TO ADD
	MOVEI	TD,^D100
	SUB	TD,%IDX
	IDIVI	TC,(TD)
	SKIPG	TC		;MAKE SURE THAT IT IS POSSITIVE
	 MOVEI	TC,1		;ELSE JUST MAKE IT ONE
	ADD	TE,TC		;AND ADD INTO TOTAL FROM ABOVE
	ADD	TE,TB		;THEN ADD THE NUMBER OF SAT BLOCKS
	IMUL	TE,IDXSEC	;CONVERT TO ACTUAL DISK BLOCKS NEEDED
	ADDI	TE,3		;ADD ONE FOR THE STAT BLOCK, AND RIBS
	MOVE	TA,TE		;PRIME ALOF1
	PUSHJ	PP,ALOF1	;GO ALLOCATE THE FILE
	JRST	SETIO

ALOF2:	CLOSE	OF2,40			;DELETE FILE FROM ORIGINAL ENTER
	MOVEM	TA,OF2EB+.RBEST		;TELL TO ALLOCATE
	MOVE	TA,OF2DAT+FILNAM	;GET FILE NAME
	MOVE	TB,OF2DAT+FILEXT
	MOVE	TC,OF2DAT+PPNUM
	MOVEM	TA,OF2EB+.RBNAM
	MOVEM	TB,OF2EB+.RBEXT
	MOVEM	TC,OF2EB+.RBPPN
	MOVEI	TA,.RBALC		;GIVE THE LENGTH OF THE ENTER BLOCK
	MOVEM	TA,OF2EB+.RBCNT
IFN	DEBUG,<		;SHOW ALLOCATED VALUE IF DEBUGGING
	 PUSHJ	PP,DBOF2
	>	;END OF IFN DEBUG
;BL;	1 LINE INSERTED AT ALOF2+13 TO FIX PARTIAL ALLOCATION BUG
	SETZM	OF2EB+.RBALC		;RESET ALLOCATION BLOCK
	ENTER	OF2,OF2EB		;DO AN EXTENDED ENTER
;BL; CHANGES AT ALOF2+15 TO FIX PARTIAL ALLOCATION BUG
	 PUSHJ	PP,[
		IFE DEBUG,<
		HRRZ	TB,OF2EB+.RBEXT	;LOAD ERROR CODE
		CAIN	TB,17		;PARTIAL ALLOCATION?
		POPJ	PP,		; YES, FORGET IT
		>			;END IFE DEBUG
		MOVE	TB,OF2EB+.RBEXT	;CODE FOR ERROR ROUTINE 
		JRST	ENTRFB]		;GO GIVE ERROR
	HRRZ	TA,OF2EB+.RBEXT		;CHECK FOR PARTIAL ALLOCATION ERROR
	CAIN	TA,17			;IF IT IS ERROR 17
	TLZ	SW,(FERROR)		;THEN TURN ERROR BIT OFF
	TLNE	SW,(FERROR)		;BUT IF ANYTHING ELSE THEN 
	 JRST	START			;START OVER
	POPJ	PP,			;IF OK RETURN TO CALLER

ALOF1:	CLOSE	OF1,40			;DELETE FILE FROM ORIGINAL ENTER
	MOVEM	TA,OF1EB+.RBEST		;TELL HOW MUCH TO ALLOCATE
	MOVE	TA,OF1DAT+FILNAME	;GET FILE DATA AND PUT
	MOVE	TB,OF1DAT+FILEXT	;INTO THE ENTER BLOCK
	MOVE	TC,OF1DAT+PPNUM
	MOVEM	TA,OF1EB+.RBNAM
	MOVEM	TB,OF1EB+.RBEXT
	MOVEM	TC,OF1EB+.RBPPN
	MOVEI	TA,.RBALC
	MOVEM	TA,OF1EB+.RBCNT		;TELL HOW LONG THE BLOCK IS
IFN	DEBUG,<	;SHOW ALLOCATED VALUE IF DEBUGGING
	 PUSHJ	PP,DBOF1
	>	;END OF IFN DEBUG
;BL;	1 LINE INSERTED AT ALOF1+13 TO FIX PARTIAL ALLOCATION BUG
	SETZM	OF1EB+.RBALC		;RESET ALLOCATION BLOCK
	ENTER	OF1,OF1EB		;DO THE EXTENDED ENTER
;BL; CHANGES AT ALOF1+15 TO FIX PARTIAL ALLOCATION BUG
	 PUSHJ	PP,[
		IFE DEBUG,<
		HRRZ	TB,OF1EB+.RBEXT	;GET ERROR CODE IF FAILED
		CAIN	TB,17		;PARTIAL ALLOCATION?
		POPJ	PP,		; YES, FORGET IT
		>			;END IFE DEBUG
		 JRST	ENTRFA]		;GO GIVE ERROR
	HRRZ	TA,OF1EB+.RBEXT		;CHECK FOR PARTIAL ALLOCATION ERROR
	CAIN	TA,17			;AND IF IT IS TURN THE ERROR BIT OFF
	 TLZ	SW,(FERROR)
	TLNE	SW,(FERROR)		;THEN TEST FOR OTHER ERRORS
	 JRST	START			;AND START OVER IF THERE ARE ANY
	POPJ	PP,			;THEN RETURN

IFN	DEBUG,<		;ASSEMBLE ONLY IF DEBUGGING
DBOF2:	TYPE	([ISMABD Allocating )
	MOVE	TE,OF2EB+.RBEST		;SHOW ESTIMATED VALUE
	PUSHJ	PP,PUTDEC
	TYPE	( blocks for )
	MOVE	TE,OF2DAT+DEV		;SHOW FILE NAME
	PUSHJ	PP,PUTSIX
	TYPE	(:)
	MOVE	TE,OF2EB+.RBNAM
	PUSHJ	PP,PUTSIX		;SHOW FILENAME
	HLLZ	TE,OF2EB+.RBEXT		;AND EXTENSION
	TYPE	(.)
	SKIPE	TE
	 PUSHJ	PP,PUTSIX		;IF THERE IS ONE

	SKIPN	TE,OF2EB+.RBPPN		; SKIP IF THERE IS A PPN
	JRST	DBOF3

	; THERE IS A PPN, TYPE IT

	TYPE	([)
	HLRZ	TE,TE		; GET PROJ NUM
	SKIPE	TE
	PUSHJ	PP,PUTOCT
	TYPE	(,)
	HRRZ	TE,OF2EB+.RBPPN
	SKIPE	TE
	PUSHJ	PP,PUTOCT
	TYPE	(])
DBOF3:	TYPE	( ]
)
	POPJ	PP,			;THEN RETURN


DBOF1:	TYPE	([ISMABI Allocating )
	MOVE	TE,OF1EB+.RBEST		;SHOW ESTIMATED VALUE
	PUSHJ	PP,PUTDEC
	TYPE	( blocks for )
	MOVE	TE,OF1DAT+DEV		;SHOW FILE NAME
	PUSHJ	PP,PUTSIX
	TYPE	(:)
	MOVE	TE,OF1EB+.RBNAM
	PUSHJ	PP,PUTSIX		;SHOW FILENAME
	HLLZ	TE,OF1EB+.RBEXT		;AND EXTENSION
	TYPE	(.)
	SKIPE	TE
	 PUSHJ	PP,PUTSIX		;IF THERE IS ONE

	SKIPN	TE,OF1EB+.RBPPN		; GET PPN
	JRST	DBOF4			; NONE, CONT

	; TYPE PPN

	TYPE	([)
	HLRZ	TE,TE			; GET PROJ NUM
	SKIPE	TE
	PUSHJ	PP,PUTOCT
	TYPE	(,)
	HRRZ	TE,OF1EB+.RBPPN
	SKIPE	TE
	PUSHJ	PP,PUTOCT
	TYPE	(])
DBOF4:	TYPE	 ( ]
[ISMCIL Calculated )
	MOVE	TE,CLLVLS			;RESTORE # OF LEVELS
	PUSHJ	PP,PUTDEC
	TYPE	 ( levels of index.]
)
	POPJ	PP,			;THEN RETURN

	>;END OF IFN DEBUG
	>;END OF IFN $CU001
>;END IFE TOPS20
SUBTTL	GET READY FOR I/O

SETIO:
	PUSHJ	PP,LOPINI	;SOME INITIALIZATION

;bl	RELEASE	CMD,		;IN CASE INDIRECT CMD FILE WAS OPEN
	MOVE	TE,[SIXBIT/0000/]	;CLEAR REEL NUMBER
	MOVEM	TE,OREENO
	TLZ	SW,(FRECIN)	;CLR RECORD-SEEN FLAG
	SETZM	IDXLOC		;CLEAR INDEX INFO
	MOVE	TE,[XWD IDXLOC,IDXLOC+1]
	BLT	TE,IDXFLG+^D9

	TRNE	SW,OPT.B
	JRST	SETIO3

	; PACK OR MAINTAIN OR CHECK

	MOVE	TE,LEVELS+I	;GET INDEX SPACE FOR /P, /M , /C INPUT
	MOVE	TA,IDXSEC+I
	LSH	TA,7		;TA=NUMBER OF WORDS/BLK OF INDEX
	MOVEM	TA,IDXSIZ
	IMULI	TE,(TA)		;TE=TOTAL # WORDS FOR ALL INDEX LEVELS
	HRRZ	TD,.JBFF##	;[115]ADDR FOR 1ST LEVEL OF INPUT INDEX
	MOVEM	TD,IDXLIN
	PUSHJ	PP,GETCOR

	MOVE	TB,IDXLIN	;MAKE PTR TO EACH LEVEL
	MOVE	TE,IDXBLK+I	;# ENTRIES AT EACH INPUT INDEX BLK
	MOVEM	TE,IDXEIN
	MOVEI	TC,1		;START AT LEVEL 2
SETIO8:	ADD	TB,IDXSIZ
	MOVEM	TB,IDXLIN(TC)
	MOVEM	TE,IDXEIN(TC)
	CAMGE	TC,LEVELS+I
	AOJA	TC,SETIO8

	MOVE	TE,RECSIZ+I	;GET SPACE FOR /P, /M, /C  DATA INPUT
	ADDI	TE,1		;INCLUDE HEADER WORD OF EACH RECORD
	IMUL	TE,DATBLK+I
	MOVEM	TE,INSIZ
	MOVE	TD,.JBFF		;[115]
	MOVEM	TD,INDAT
	PUSHJ	PP,GETCOR

	MOVE	IX,LEVELS+I	;READ IN TOP LEVEL OF INDEX
	MOVE	TA,IDXADR+I
	MOVEM	TA,CURIDX(IX)	; SAV TOP INDEX BLK NUMBER
	TLNN	TA,-1		;[157] IF BLOCK-NMBR GT 18 BITS
	CAILE	TA,-11		; [162]  OR BETWEEN 777770 & 777777
	JRST	SETI8F		; [162] YES, DO FILOP. USETI
	JRST	SETI8A		;[157] NO GO TO USETI
SETI8F:	MOVEM	TA,FUSI+1	;[162] [157] BLK-NUMER TO ARG BLOCK
	MOVEI	TA,IF1		;[157] GET CHANNEL 
	HRLM	TA,FUSI		;[157] CHANNEL TO ARG BLOCK
	MOVE	TA,[2,,FUSI]	;[157] POINT TO ARG BLOCK
	FILOP.	TA,		;[157] DO THE FILOP. (USETI)
	  JFCL			;[157] ERROR RETURN
	SKIPA			;[157] SKIP REG. USETI
SETI8A:	USETI	IF1,(TA)	;[157] DO REG. USETI

	PUSHJ	PP,IDXREA
	MOVSI	TA,377777	;FORCE A CALL TO DATREA
	MOVEM	TA,DATFLG

SETIO3:
	SETZM	INPBPB		;EBCDIC VARIABLE BYTES PER BLOCK
	SETZM	IBPBCT		;AND COUNTER
	AOS	IBPBCT		;MAKE IT GREATER THAN ZERO

	TRNE	SW,OPT.C	; /CHECK?
	JRST	SETIO7		; YES, DON'T ASSIGN OUT BUFFERS

	OUTBUF	OF2,2		;GET 2 BUFFERS FOR DATA FILE
	MOVE	TE,BYTSIZ(OM)	;GET BYTE SIZE AND PUT IN
	DPB	TE,[POINT 6,OF2BUF+1,11]; BUFFER HEADER WORD

	TRNE	SW,OPT.P	;/P  ?
	JRST	SETIO2		;YES

	PUSHJ	PP,GETLVL	;/M OR /B: GET CORE FOR OUTPUT INDEX

	TRNE	SW,OPT.M
	JRST	SETIO7

	INBUF	IF1,2		;/B: GET 2 BUFFERS FOR INPUT FILE
	MOVE	TE,BYTSIZ(IM)	;GET BYTE SIZE FOR BUFFER HEADER WORD
	DPB	TE,[POINT 6,IF1BUF+1,11]

SETIO2:	TLNE	SW,(FMTA)	;MAG TAPE?
	PUSHJ	PP,BLDBUF	;YES, MAKE NON-STD BUFFERS

	TLNE	SW, (FMTA)	; MAG TAPE?
	TRNN	SW, OPT.L	; AND LABELS?
	JRST	.+2
	PUSHJ	PP, LABEL	; YES - SET THEM UP
	CAIN	OM,SX.MOD	;[150] IS THIS SIXBIT OUTPUT?
	TLNN	SW,(FMTA)	;[150] YES, IS IT MAG TAPE OUTPUT?
	JRST	.+2		;[150] NO, NEITHER
	AOS	OF2BUF+2	;[150] ADD ONE TO MAKE UP FOR KLUDGEY OUTPUT
SETIO7:	MOVE	TE,SIZKEY	;GET SIZE OF INDEX KEY
	MOVE	TD,.JBFF	;RESERVE
	MOVEM	TD,OLDKEY	;  AN AREA TO
	PUSHJ	PP,GETCOR	;  SAVE RECORD KEY

	MOVE	TE,SIZKEY	;DO SAME
	MOVE	TD,.JBFF	;  FOR
	MOVEM	TD,NEWKEY	;  NEW
	PUSHJ	PP,GETCOR	;  KEY

	TRNE	SW,OPT.B
	JRST	SETIO9		;/B

	MOVE	TE,SIZKEY	;GET SPACE FOR INPUT KEY
	MOVE	TD,.JBFF
	MOVEM	TD,INKEY
	PUSHJ	PP,GETCOR

SETIO9:	MOVE	TE,BYPTRS(OM)	;CHANGE THOSE 
	HLLM	TE,OLDKEY	;  TO
	HLLM	TE,NEWKEY	;  BYTE-POINTERS

	MOVE	TE,BYPTRS(IM)	;MAKE INPUT BYTE POINTERS
	HLLM	TE,INKEY

	MOVE	TE,LOWVAL(KT)	;GET LOW VALUES
	MOVE	TD,SIZKEY
	MOVE	TC,OLDKEY

	MOVEM	TE,(TC)
	AOS	TC
	SOJG	TD,.-2

	MOVE	TC,NEWKEY	;CLR NEWKEY AREA
	MOVE	TD,SIZKEY
	SETZM	(TC)
	AOS	TC
	SOJG	TD,.-2

	TLNE	SW,(FDSK)	;IF DISK INPUT & IT IS BLOCKED,
	SKIPN	INPBLK
	JRST	SETIO6
	;COMPUTE # SECTORS PER INPUT OR OUTPUT BLOCK

	PUSHJ	PP,WDPBLK	;GET WORDS PER BLOCK IN TE
	ADDI	TE,177
	LSH	TE,-7
	MOVEM	TE,INPSEC


SETIO6:	SETOM	OSECC
	SETZM	MUCHO
	SETZM	DATLOC
	SETZM	DATBPB		;EBCDIC VARIABLE BYTES PER BLOCK
	MOVEI	TE,1
	MOVEM	TE,DATLOK
	MOVE	TE,DATRIT
	MOVEM	TE,ORLEFT

	TRNN	SW,OPT.P	;[156] /P OPTION?
	JRST	SETI6A		;[156] NO

	MOVE	TE,RECBYT	;[156] YES GET NO. BYTES PER RECORD
	IDIV	TE,BYTWRD(OM)	;[156] CALC NO. OF WORDS IN OUTPUT REC.
	AOSA	TE		;[156] ROUND UP ONE ALWAYS,BUT DON'T LOAD RECORD SIZE
SETI6A:	MOVE	TE,RECSIZ	;[156] GET INPUT RECORD SIZE
	HLL	TD,BYPTRS(OM)	;BYTE POINTER SKELETON 
	TRNE	SW,OPT.A7	; IS THIS ANS74 ADVANCING?
	ADDI	TE,1		; YES,ROOM FOR A CR/LF IN FRONT IF /P+ASCII
	HRR	TD,.JBFF
	MOVEM	TD,RECPTR
	PUSHJ	PP,GETCOR	;					[EDIT#77]

	TRNN	SW,OPT.A7	; IS THIS ANS74 ADVANCING?
	JRST	SETI6B		; NO, CONT
	MOVEI	TE,RTCRLF	; GET A CR/LF, RIGHT JUSTIFIED
	MOVEM	TE,@RECPTR	; PLACE IT JUST IN FRONT OF RECORD
	AOS	RECPTR		; MAKE RECPTR POINT JUST AFTER LF
SETI6B:	TRNN	SW,OPT.P+OPT.C	;/P OR /C ?
	JRST	SETI10		;NO

	MOVE	TE,INPBLK	;FOR /P OR /C, SWITCH INPUT ARGS TO OUTPUT
	MOVEM	TE,DATBLK
	MOVEM	TE,DATRIT
	MOVEM	TE,ORLEFT	;NO EMPTY RECORDS ON /P OR /C
	SETZM	INPBLK
	MOVE	TE,INPSEC
	MOVEM	TE,DATSEC
	SETZM	INPSEC
	MOVE	TE,INPBPB		;BYTES PER BLOCK - EBCDIC VAR
	MOVEM	TE,DATBPB


	TRNE	SW,OPT.C	; /CHECK?
	JRST	LOOP7		; YES, START IO LOOP



	;PUT OUT BLOCK HEADER FOR EBCDIC VARIABLE WRITES
	CAIN	OM,EB.MOD
	TLNN	SW,(FEBVAR)
	JRST	LOOP7		;NO - FORGET IT
	;EBCDIC VARIABLE LENGTH OUTPUT
	SKIPN	DATBPB		;IS IT PACKED?
	JRST	LOOP7		;NO
	SETOM	ORLEFT		;THIS WILL CAUSE APPROPRIATE NUMBER OF
				;EMPTY SECTORS TO BE WRITTEN OUT IN LAST
				;RECORD
	PUSHJ	PP,FNEBST	;OUTPUT HEADER
	JRST	LOOP7

		;SETI10:	PUSHJ	PP,GETCOR	;		[EDIT#77]

SETI10:	PUSHJ	PP,RITID1	;WRITE OUT EMPTY BLOCK TO BE
				;  REPLACED LATER BY STATISTICS BLOCK

	;SET UP ISECC A LITTLE DIFFERENTLY FOR EBCDIC VARIABLE
	CAIN	IM,EB.MOD	;IS IT EBCIDC?
	TLNN	SW,(FEBVAR)	;AND VARIABLE?
	JRST	LOOP7		;NO
	TRNN	SW,OPT.B	;MAKE SURE THIS IS /B
	JRST	LOOP7
	MOVE	TE,INPSEC	;SET THEM EQUAL FOR FIRST TIME THRU
	MOVEM	TE,ISECC
	JRST	LOOP7A		;SKIP THE ISECC ZEROING

WDPBLK:	;COMPUTE WORDS PER BLOCK FOR INPUT OR OUTPUT FILE

	MOVE	TE,RECBYT	;COMPUTE # SECTORS PER INPUT BLK

	TRNE	SW,OPT.P	;SWAP IM AND OM IF /P
	EXCH	IM,OM

	JRST	@.+1(IM)	;BASE UPON MODE

	EXP	SETI11		;SIXBIT
	EXP	SETI12		;EBCDIC
	EXP	SETIO4		;ASCII
	EXP	SETIO4		;STANDARD ASCII

	;SIXBIT
SETI11:	ADDI	TE,^D11
	IDIVI	TE,6
	IMUL	TE,INPBLK
	JRST	SETIO5

	;EBCDIC
SETI12:	TLNE	SW,(FEBVAR)	;FIXED OR VARIABLE
	JRST	SETI13		;VARIABLE LENGTH

	;FIXED EBCDIC
	IMUL	TE,INPBLK	;TOTAL NUMBER OF BYTES
	ADDI	TE,3		;FILL OUT WORD
	IDIVI	TE,4		;COMPUTE # WORDS USED
	JRST	SETIO5

	;VARIABLE LENGTH EBCDIC
SETI13:	ADDI	TE,4		;FOR THE RECORD HEADER
	IMUL	TE,INPBLK		;TOTAL NUMBER OF BYTES
	ADDI	TE,4		;FOR HEADER WORD - BLOCK
	MOVEM	TE,INPBPB		;SAVE BYTES PER BLOCK
	ADDI	TE,3		;ROUND UP
	IDIVI	TE,4		;COMPUTE # WORDS USED
	SETZM	INPBLK		;PRETEND IT ISN'T BLOCKED - THE READ
				;AND WRITE ROUTINES WILL WORRY ABOUT
				;SUCH THINGS RATHER THAN 'LOOP'
	JRST	SETIO5

	;ASCII
SETIO4:	ADDI	TE,2
	IMUL	TE,INPBLK
	ADDI	TE,4
	IDIVI	TE,5

SETIO5:	TRNE	SW,OPT.P	;SWAP BACK
	EXCH	IM,OM		;IF /P
	POPJ	PP,
LOPINI:
	;INITIALIZE ALL THE THINGS SO THE LOOP WILL GO A LITTLE 
	;FASTER

	;CONVERSION POINTER
	MOVE	TE,@CNVPTI(IM)	;GET BYTE POINTER BASED UPON INPUT 
				; AND OUTPUT MODES
	MOVEM	TE,CONVRT

	;INPUT ROUTINE ADDRESSES
	SETZI	TF,		;CLEAR ISAM INPUT FLAG
	TRNN	SW,OPT.B	;BUILD???
	AOS	TF		;NO ISAM FILE INPUT
	SETZI	TE,
	TLNE	SW,(FEBVAR)	;VARIABLE LENGTH EBCDIC ???
	AOS	TE		;YES
	MOVEI	TE,@IROUAD(TF)	;GET ADDRESS OF ROUTINE ADDRESS BLOCK
	MOVE	TF,(TE)		;FIRST BYTE ROUTINE
	MOVEM	TF,GETFB
	MOVE	TF,1(TE)	;NORMAL BYTE ROUTINE
	MOVEM	TF,GETBYT

	TRNE	SW,OPT.C	; /CHECK ?
	POPJ	PP,		; YES, DON'T SET UP OUTPUT SIDE


	; SETUP OUTPUT ROUTINE ADDRESS
	SETZI	TF,
	TRNN	SW,OPT.P	;ISAM FILE OUTPUT???
	AOS	TF		;YES
	SETZI	TE,
	TLNE	SW,(FEBVAR)	;VARIABLE EBCDIC?
	AOS	TE		;YES
	MOVEI	TE,@OROUAD(TF)	;FINISH RECORD ROUTINE ADDRESS
	MOVEM	TE,FINREC

	POPJ	PP,


CNVPTI:	Z	@CNVP6O(OM)	;SIXBIT INPUT
	Z	@CNVP9O(OM)	;EBCDIC INPUT
	Z	@CNVP7O(OM)	;ASCII  INPUT
	Z	@CNVP7O(OM)	;ASCII	INPUT (STANDARD)

CNVP6O:	[POINT	6,CH,35]		;SIXBIT TO SIXBIT
		PTR%69##		;SIXBIT TO EBCDIC
		PTR%67##		;SIXBIT TO ASCII
		PTR%67##		;SIXBIT TO ASCII

CNVP9O:		PTR%96##		;EBCDIC TO SIXBIT
	[POINT	9,CH,35]		;EBCDIC TO EBCDIC
		PTR%97##		;EBCDIC TO ASCII
		PTR%97##		;EBCDIC TO ASCII

CNVP7O:		PTR%76##		;ASCII TO SIXBIT
		PTR%79##		;ASCII TO EBCDIC
	[POINT	7,CH,35]		;ASCII TO ASCII
	[POINT	7,CH,35]		;ASCII TO ASCII

;	CONVERT TO ASCII

CNVPI7:	PTR%67
	PTR%97
	[POINT	7,CH,35]
	[POINT	7,CH,35]

;	INPUT ROUTINE ADDRESS TABLES

IROUAD:	Z	@SEQIN(IM)	;SEQUENTIAL INPUT
	Z	IDXROU		;ISAM FILE INPUT

SEQIN:	Z	SIXROU		;SIXBIT
	Z	@SEQEB(TE)	;EBCDIC
	Z	ASCROU		;ASCII
	Z	ASCROU		;ASCII

SEQEB:	Z	EBFROU		;FIXED EBCDIC
	Z	EBVROU		;VARIABLE EBCDIC

IDXROU:	Z	IDXFB		;FIRST BYTE
	Z	GETDAT		;NORMAL BYTE

SIXROU:	Z	GETFB6
	Z	GETSM

ASCROU:	Z	GETFB7
	Z	GETAM

EBFROU:	Z	GETFBF
	Z	GETEMF

EBVROU:	Z	GETFBV
	Z	GETEMV


;	OUTPUT ROUTINE ADDRESSES

OROUAD:	Z	@OROUSQ(OM)	;SEQUENTIAL
	Z	@OROUX(OM)	;ISAM

OROUSQ:	Z	FINRCS		;SIXBIT
	Z	@OROUEB(TE)	;EBCDIC
	Z	FINRCA		;ASCII
	Z	FINRCA		;STANDARD-ASCII

OROUEB:	Z	FINRCF		;EBCDIC FIXED
	Z	FINRCV		;EBCDIC VARIABLE

OROUX:	Z	FINRXS		;ISAM SIXBIT
	Z	FINRXE		;ISAM EBCDIC
	Z	FINRXA		;ISAM ASCII
	Z	FINRXA		;ISAM ASCII
SUBTTL	THE MAIN READ/WRITE LOOP

LOOP:	TLNE	SW,(FEOF)	;AT END OF FILE?
	JRST	ALLDUN		;YES
	SETZM	OC
	MOVE	OP,RECPTR
LOOP1:	TLZ	SW,(FENDL)
	SETOM	ALLNUL		;[147] ASSUME ONE CHAR TO START
	PUSHJ	PP,@GETFB	;GET A CHARACTER
	TLNE	SW,(FEOF)	;AT END OF FILE NOW?
	JRST	ALLDUN		;YES
	TLO	SW,(FRECIN)	;A RECORD HAS BEEN SEEN
	TLNE	SW,(FENDIB)	;NO--AT END OF BLOCK?
	JRST	LOOP6		;YES
	TLNE	SW,(FENDL)	;NO--AT END OF LINE?
	JRST	LOOP1		;YES--SKIP PAST EOL
	LDB	CH,CONVRT	;CONVERT IF REQUIRED
	CAMGE	OC,RECBYT	;RECORD FULL?
	IDPB	CH,OP		; NO..BYTE TO RECORD
	ADDI	OC,1		;COUNT BYTE

	PUSHJ	PP,@GETBYT	;GETREC


	TLNE	SW,(FEOF)	;[147] WAS IT ACTUAL EOF
	JRST	[SKIPL	ALLNUL	;[147] ANY REAL CHARS SEEN
		JRST	ALLDUN	;[147] NO, EOF IS REAL
		JRST	.+1]	;[147] FINISH UP THIS REC
	PUSHJ	PP,CAMKEY	;BE SURE KEYS ARE IN ORDER
IFN DEBUG,<
	SKIPE	DBUGIT
	PUSHJ	PP,TRACKY
>

	TRNN	SW,OPT.C	; /CHECK?
;BL	1 LINE CHANGED AT LOOP+21
	JRST	LOOP2B		; NO, MOVE RECORD TO OUTPUT SIDE

	; /CHECK, DON'T MOVE RECORD, BUT CHECK SIZE

	PUSHJ	PP,FNCKSZ	; CHECK RECORD SIZE AGAINST MAX
	JRST	LOOP5		; GO GET NEXT RECORD


LOOP2A:	TRNN	SW,OPT.P	;PACKING?
	JRST	LOOP2B		; NO
	SKIPN	DATBLK		; YES, AND BLOCKED, TOO?
	JRST	LOOP2B		; NO
	SKIPE	ORLEFT		;BLOCK FULL?
	JRST	LOOP2B		; NO
	PUSHJ	PP,WRITE	; YES, DO IT
	MOVE	TE,DATRIT	;RESET
	MOVEM	TE,ORLEFT	; BLOCK COUNTER
	SETZM	OSECC		;RESET OUT COUNTER

LOOP2B:	PUSHJ	PP,@FINREC	;FINISH UP THE RECORD

	;SKIP KEY WRITING TO INDEX FILE IF /P
	TRNE	SW,OPT.P	;/P?
;BL	2 DELETED, 1 ADDED AT LOOP2B+2
	  JRST	LOOP9		;  YES, NO OUTPUT INDEX

	;OUTPUT EVERY N'TH KEY TO THE INDEX BLOCK
	MOVE	CH,ORLEFT	;IS THIS THE
	CAMN	CH,DATRIT	;  FIRST RECORD IN BLOCK?
	PUSHJ	PP,RITKEY	;YES--WRITE A KEY

	;CHECK TO SEE IF OUTPUT BLOCK IS FULL

LOOP8:	SOSLE	ORLEFT		;IS BLOCK FULL?
	JRST	LOOP5		;NO

	;BLOCKED OUTPUT AND THE LOCK IS FULL
	PUSHJ	PP,WRITE	;YES--WRITE IT OUT
LOOP3:	AOS	OF2BUF+2
	MOVE	TE,OSECC	;IF ENOUGH
	CAML	TE,DATSEC	;  SECTORS WRITTEN,
	JRST	LOOP4		;  NO MORE NEEDED
	PUSHJ	PP,WRITE	;WRITE AN EMPTY RECORD
	JRST	LOOP3		;  AND LOOP

LOOP4:	MOVE	TE,DATRIT	;RESET
	MOVEM	TE,ORLEFT	;  BLOCK COUNTER
	MOVE	TE,DATLOC	;REMEMBER LAST SECTOR USED
	MOVEM	TE,DATLOK
	SETZM	OSECC

	;CHECK BLOCKING FOR THE INPUT FILE

LOOP5:	SKIPE	INPBLK		;IS INPUT BLOCKED?
	SOSLE	IRLEFT		;YES--ANYTHING LEFT IN BLOCK?
	JRST	LOOP		;NO

	;INPUT IS BLOCKED AND THE CURRENT BLOCK IS EMPTY

LOOP6:	TLZE	SW,(FENDIB)	;NO--ANY MORE SECTORS?
	JRST	LOOP7		;NO
	PUSHJ	PP,READ		;YES--GET ANOTHER SECTOR
	JRST	LOOP6		;  AND LOOP

LOOP7:	SETZM	ISECC
LOOP7A:	SETZM	IF1BUF+2	;BE SURE A READ HAPPENS NEXT TIME
	MOVE	TE,INPBLK
	MOVEM	TE,IRLEFT
	JRST	LOOP

	; SPECIAL HANDLING FOR /P BLOCKED FILES
LOOP9:	SKIPE	DATBLK		;/P BLOCKED?
	JRST	LOOP8		;YES
	JRST	LOOP5		;NO

;NOTE:	BLOCKING PROBLEMS FOR EBCDIC VARIABLE LENGTH I/O ARE 
;	HANDLED BY THE INDIVIDUAL I/O ROUTINES BECAUSE THERE
;	ISN'T A NICE SET COUNT OF RECORDS

IFN DEBUG,<
TRACSZ:	;DISPLAY SIZE OF KEY
	TYPE	(
SIZE:)
	PUSHJ	PP,SAVAC	;SAVE AC'S
	MOVE	TE,INPSIZ
	ADDI	TE,1	;BECAUSE ITS ONE SHORT
	PUSHJ	PP,PUTDEC	;TYPE IT
	TYPE	(
)
	JRST	RESAC

TRACH:	;TYPE  CURRENT CHARACTER OF RECORD
	PUSH	PP,CH
	LDB	CH,@CNVPI7(IM)	;CONVERT TO ASCII
	TYPEC	CH
	POP	PP,CH
	POPJ	PP,

TRACKY:	;DISPLAY KEY
	PUSHJ	PP,SAVAC
	MOVE	TE,OC		;RECORD SIZE
	TYPE	(
SIZ:)
	PUSHJ	PP,PUTDEC
	MOVE	TE,NEWKEY
	TYPE	(
KEY:)
	PUSHJ	PP,@CAMKX(KT)	;DISP KEY
	TYPE	(
)
	JRST	RESAC

>

SUBTTL TRANSFER RECORD TO OUTPUT FILE

FINRCA:	;ASCII SEQUENTIAL OUTPUT

	PUSHJ	PP,FNCKSZ		;CHECK RECORD SIZE
	CAIN	OM,MA.MOD	;STANDARD ASCII?
	JRST	FNMOVE		; YES, SKIP CRLF
	TRNN	OPT.A7			; SKIP IF ANS74 STYLE ADVANCING
	PUSHJ	PP,FNCRLF		;PUT OUT CRLF
	PJRST	FNMOVE			;MOVE RECORD TO FILE


FINRCS:	;SIXBIT SEQUENTIAL OUTPUT

	PUSHJ	PP,FNCKSZ		;CHECK RECORD SIZE
	HRRZ	TE,OC			;SETUP HEADER WORD
	PUSHJ	PP,FNHDR		;OUTPUT TO FILE
	PUSHJ	PP,FNMOVE		;RECORD TOO
	PJRST	FNFILW			;FILL IN REST OF LAST WORD



FINRCF:	;SEQUENTIAL EBCDIC FIXED LENGTH

	PUSHJ	PP,FNCKSZ		;CHECK SIZE OF RECORD
	PUSH	PP,OC			;SAVE COUNT
	PUSHJ	PP,FNMOVE		;MOVE RECORD
	POP	PP,OC			;RESTORE
	SUB	OC,RECBYT		;COMPUTE #TO FILL
	JUMPE	OC,CPOPJ		;FORGET IT IF NONE
	PJRST	FNFILR			;FILL IN REST OF RECORD


FINRCV:	; VARIABLE LENGTH EBCDIC OUTPUT

	SKIPE	DATBPB		;BLOCKED?
	PUSHJ	PP,FNEBBK	;YES

	PUSHJ	PP,FNCKSZ	;CHECK RECORD SIZE

	;PUTOUT RECORD HEADER WORD
	ADDI	OC,4		;COUNT HEADER TOO
	TLNN	SW,(FINDCP)	;INDUSTRY COMPATABLE MODE?
	SKIPA	TE,[POINT 9,OC,17]	;NO
	MOVE	TE,[POINT 8,OC,19]	;YES - 8 BIT BYTES
	ILDB	CH,TE		;STORE HEADER WORD
	PUSHJ	PP,PUTBYT	;COUNT IN FIRST 2 BYTES
	ILDB	CH,TE
	PUSHJ	PP,PUTBYT
	MOVEI	CH,0		;ZERO IN REST
	PUSHJ	PP,PUTBYT
	PUSHJ	PP,PUTBYT

	SUBI	OC,4		;RESTORE COUNT
	PJRST	FNMOVE		;RECORD ALSO


FNEBBK:	;BLOCKED VARIABLE LENGTH RECORDS
	;PUT AS MANY INTO THE BLOCK AS WILL FIT

	MOVEI	TE,4		;4 FOR RECORD HEADER
	ADDM	TE,OBPBCT
	ADDM	OC,OBPBCT	;UPDATE COUNTER WITH RECORD COUNT
	SKIPG	OBPBCT		;ENOUGH ROOM LEFT?
	POPJ	PP,		;YES

	;BLOCK IS FULL
	TLNN	SW,(FMTA)	;MAG TAPE?
	JRST	FNEBK1		;NO

	;FOR MAG TAPE GO BACK AND FILL IN CORRECT BLOCK COUNT
	MOVE	TE,OBPBCT	;[152] GET COUNTER POSITIVE
	SUBI	TE,(OC)		;BACK IT UP
	SUBI	TE,4		;AND 4 FOR HEADER
	ADD	TE,DATBPB	;COMPUTE ACTUAL NUMBER OF BYTES WRITTEN
	HRLZ	TE,TE		;MOVE IT OVER
	TLNE	SW,(FINDCP)	;INDUSTRY COMPATABLE MODE??
	LSH	TE,2		;YES - MOVE IT OVER A LITTLE - 8 BIT BYTES
	HRRZ	TF,OF2BUF	;GET BUFFER POINTER
	MOVEM	TE,2(TF)	;OVER WRITE HEADER WORD WITH NEW ONE

FNEBK1:
	PUSHJ	PP,WRITE	;OUTPUT THE BLOCK
	AOS		OF2BUF+2	;[V10] ADJUST THE BYTE COUNT.
	PUSHJ	PP,FNEBST	;PUT IN NEW HEADER WORD - BLOCK
	ADDM	OC,OBPBCT	;UPDATE COUNTER
	MOVEI	TE,4		;AND 4 FOR HEADER WORD
	ADDM	TE,OBPBCT
	SKIPG	OBPBCT		;THERE HAD BETTER BE ROOM
	POPJ	PP,
	JRST	INTERR		;INTERNAL ERROR

FNEBST:	;PUT OUT BLOCK HEADER WORD AND INITIALIZE COUNTER

	MOVE	TF,DATBPB	;MAX BYTE COUNT
	HRLZ	TE,TF		;BUILD HEADER WORD WITH MAX COUNT IN IT
	SUBI	TF,4		;FOR HEADER WORD
	MOVNM	TF,OBPBCT	;STORE NEGATIVE IN COUNTER
	TLNE	SW,(FINDCP)	;INDUSTRY COMPATABLE
	LSH	TE,2		;YES - 8 BIT BYTES
	PJRST	FNHDR		;STORE IT


FINRXA:	; ASCII - ISAM DATA FILE OUTPUT

	PUSHJ	PP,FNCKSZ		;CHECK RECORD SIZE
	PUSHJ	PP,FNCRLF		;PUT IN CRLF
	MOVE	TE,OC			;GET # BYTES
	LSH	TE,1			;OVER 1 FOR ASCII
	IORI	TE,1			; AND 1 IN B0
	JRST	FINRCX

FINRXS:	;SIXBIT - ISAM DATA FILE OUTPUT

FINRXE:	;EBCDIC - ISAM DATA FILE OUTPUT

	PUSHJ	PP,FNCKSZ		;CHECK RECORD SIZE
	MOVE	TE,OC			;GET NUMBER OF BYTES

FINRCX:	;PUT OUT DATA FILE RECORD WITH RECORD HEADER WORD

	AOS	MUCHO		;COUNT DATA RECORDS
	HRL	TE,FILCOD(OM)		;FILE CODE
	PUSHJ	PP,FNHDR		;OUTPUT HEADER WORD
	PUSHJ	PP,FNMOVE		;MOVE RECORD
	PJRST	FNFILW			;FILL OUT LAST WORD


;	SUBROUTINES FOR OUTPUT

FNHDR:	;OUTPUT A HEADER WORD FOR NEXT RECORD - IN TE

	MOVEI	CH,0			;GO TO BEGINNING OF NEXT WORD
	PUSHJ	PP,PUTBYT
	MOVEM	TE,@OF2BUF+1		;STORE HEADER WORD
	MOVSI	TE,770000		;UPDATE BYTE POINTER
	ANDCAM	TE,OF2BUF+1
	MOVN	TD,BYWDM1(OM)		;UPDATE BYTE COUNT ALSO
	ADDB	TD,OF2BUF+2

	POPJ	PP,

FNMOVE:	;MOVE RECORD FROM HOLDING AREA TO FILE
	MOVE	OP,RECPTR	;HOLD AREA POINTER
	TRNN	SW,OPT.A7	; IS THIS ANS74 ADVANCING?
	JRST	FNMOV1		; NO, CONT
	TRNN	SW,OPT.P	;PACKING?
	JRST	FNMOV1		; NO, CONTINUE
	CAIE	OM,AS.MOD	; YES, AND REGULAR ASCII TOO?
	JRST	FNMOV1		; NO, CONT
	SUBI	OP,1		; THEN MAKE RECORD POINTER POINT TO
	HRLI	OP,(POINT 7,,20); THE "CRLF" JUST IN FRONT OF RECORD
	ADDI	OC,2		; COUNT CRLF

FNMOV1:	ILDB	CH,OP			;NEXT BYTE
	PUSHJ	PP,PUTBYT		;STORE IT
	SOJG	OC,FNMOV1		;LOOP IF MORE

	POPJ	PP,

FNFILW:	;FILL OUT END OF CURRENT WORD

	MOVEI	CH,0
FNFIL1:	MOVE	TE,OF2BUF+1		;GET POINTER
	TLNN	TE,760000		;AT END OF WORD??
	POPJ	PP,			;YES
	PUSHJ	PP,PUTBYT		;NO - FILL IT
	JRST	FNFIL1

FNCKSZ:	;CHECK THE SIZE OF THE RECORD

	CAMG	OC,RECBYT		;LESS THAN OR EQUAL MAX??
	POPJ	PP,			;YES - OK
	TYPE		(%ISMRTL Encountered record larger than maximum size - truncated
)
	MOVE	OC,RECBYT		;SET TO MAX
	POPJ	PP,

FNCRLF:	;PUT CRLF IN TO ASCII RECORD

	MOVEI	CH,15
	IDPB	CH,OP
	MOVEI	CH,12
	IDPB	CH,OP
	ADDI	OC,2			;INCREMENT COUNTER
	POPJ	PP,

FNFILR:	; FILL IN REST OR RECORD

	MOVEI	CH,0
	PUSHJ	PP,PUTBYT		;FILL IT
	AOJL	OC,.-1		;NEGATIVE FILL COUNT IN OC

	POPJ	PP,
SUBTTL  GET-RECORD ROUTINES

	; SIXBIT - FIRST BYTE SEQUENTIAL INPUT

GETFB6:	MOVEI	TE,1
	MOVEM	TE,INPSIZ
	TRO	SW,ONEBYT	;REQUEST ONE BYTE
	PUSHJ	PP,GETSM		;LOCATE RECORD COUNT
	MOVE	TE,@IF1BUF+1
;	MOVEM	TE,INPSIZ	;				[EDIT#100]
	HRRZM	TE,INPSIZ	;MTA RECORD SEQUENCE # IS IN LEFT HALF	[EDIT#100]
	MOVNI	TE,5
	ADDM	TE,IF1BUF+2	;IGNORE 5 BYTES
	MOVSI	TE,770000
	ANDCAM	TE,IF1BUF+1	;SET BITPLACE TO 36
	TLNE	SW,(FENDIB)
	POPJ	PP,		;RETURN IF END-OF-BLOCK

	SKIPN	INPSIZ
	JRST	GETFB6		;LOOP IF NULL RECORD
	TRO	SW,ONEBYT	;REQUEST ONE BYTE
	JRST	GETSM		;GET RECORD AND RETURN

GETFB7:	TRO	SW,ONEBYT	;REQUEST ONE BYTE
	PUSHJ	PP,GETAM
	MOVE	TE,@IF1BUF+1
	TRNN	TE,1B35		;SEQ # FLAG UP?
	POPJ	PP,
	IBP	IF1BUF+1	;IGNORE SEQ # WORD
	IBP	IF1BUF+1
	IBP	IF1BUF+1
	IBP	IF1BUF+1
	TRO	SW,ONEBYT	;REQUEST ONE BYTE
	JRST	GETAM


GETFBF:	; EBCDIC FIXED SEQUENTIAL INPUT

	MOVE	TE,RECBYT	;GET BYTES PER RECORD
	MOVEM	TE,INPSIZ	;STORE IN SIZE
	TRO	SW,ONEBYT	;REQUEST ONE BYTE
	JRST	GETEMF		;GO GET FIRST BYTE


GETFBV:	;EBCDIC VARIABLE LENGTH SEQUENTIAL INPUT

	SKIPG	INPBPB		;IS IT BLOCKED?
	JRST	GETFV1		;NO
GETFV0:	SKIPLE	IBPBCT		;YES - AT LEAST 4 LEFT?
				;COUNTER IS ALWAYS OFF BY 4
	JRST	GETFV2	;NO - GET SOME MORE
GETFV1:	PUSHJ	PP,GETFV3	;GET SIZE FROM HEADER WORD
	JUMPE	TE,GETFV2	;0 INDICATES END OF BUFFER
	ADDM	TE,IBPBCT	;SUBTRACT FROM COUNTER
	SUBI	TE,4		;FOR HEADER
	MOVEM	TE,INPSIZ	;STORE SIZE
	SKIPG	INPBPB		;IS IT BLOCKED?
	JRST	[TRO	SW,ONEBYT	; NO, REQUEST ONE BYTE
		JRST	GETEMV	]	; & GO GET CHAR
	SKIPLE	TE,IBPBCT	;MAKE SURE IT DOSEN'T GO OVER END OF BUFFER
	CAIG	TE,4		;IE. MUST BE LESS OR EQUAL TO 4
	JRST	[TRO	SW,ONEBYT	;ONE-BYTE ONLY
		JRST	GETEMV	]	;GO GET BYTE
	JRST	EBRHER		;RECORD COUNT EXCEEDS BLOCK

GETFV2:	;GET BLOCK COUNT

	;FIRST SEE IF THERE ARE EMPTY SECTORS TO BE SKIPPED
	MOVE	TE,ISECC	;SECTORS READ THIS BLOCK
	TLNE	SW,(FDSK)	;DISK
	CAML	TE,INPSEC	;YES - SECTORS LEFT
	JRST	GETV2A		;OK - MOVE ON
	PUSHJ	PP,READ		;READ ANOTHER
	JRST	GETFV2

GETV2A:	SETZM	ISECC		;CLEAR SECTOR COUNT
	SETZM	IF1BUF+2	;FORCE READ
	PUSHJ	PP,GETFV3	;GET BLOCK SIZE
	TLNE	SW,(FEOF)	;END OF FILE?
	POPJ	PP,		;YES - RETURN
	CAIGE	TE,4		;SEE IF THE COUNT IS REASONABLE
	JRST	EBBHER
	SUBI	TE,^D8		;ADJUST COUNTER FOR BLOCK HEADER
				; AND 4 MORE SO THAT SKIPLE TEST
				;WILL INDICATE AT LEAST 4 BYTES LEFT
				;I.E. POSSIBLE RECORD HEADER
	MOVNM	TE,IBPBCT	;SET COUNTER
	JRST	GETFV0

GETFV3:	;GET COUNT FROM BLOCK OR RECORD HEADER WORD

	MOVEI	TE,4		;SET UP INPSIZ
	MOVEM	TE,INPSIZ
	TRO	SW,ONEBYT	;REQUEST ONE BYTE
	PUSHJ	PP,GETEMV	; & GET IT
	MOVE	TE,CH		;SAVE IT
	LSH	TE,^D8		;ADJUST IT
	TLNN	SW,(FINDCP)	;INDUSTRY COMPATABLE?
	LSH	TE,1		;NO - 9 BIT BYTES
	TRO	SW,ONEBYT	;REQUEST NEXT BYTE
	PUSHJ	PP,GETEMV	; & GET IT
	ADDI	TE,(CH)		;ADD IT IN
	TRO	SW,ONEBYT
	PUSHJ	PP,GETEMV	;SKIP NEXT 2 BYTES
	TRO	SW,ONEBYT
	PJRST	GETEMV	

GETEMF:	

; GET A BYTE FROM EBCDIC VARIABLE INPUT FILE

GETEMV:
	TLNE	SW,(FENDIB)
	POPJ	PP,		;RETURN IF END-OF-BLOCK
	SKIPG	INPSIZ		;ANYTHING LEFT?
	JRST	[TLO	SW,(FENDL)	;NO
		POPJ	PP,]		;RETURN
	SOSG	IF1BUF+2	;UPDATE COUNTER
	PUSHJ	PP,READ		;GET ANOTHER BUFFER IF NECES.
	TLNE	SW,(FENDIB)	;END OF BUFFER?
	POPJ	PP,		; YES, RETURN
	ILDB	CH,IF1BUF+1	;GET CHARACTER IF NOT
	SETOM	ALLNUL		;[147] SET SEEN REAL CHAR
	SKIPN	CH		;[147] REAL CHAR OR NULL
	SETZM	ALLNUL		;[147] SET NULL SEEN
	SOS	INPSIZ		;DECREMENT BYTE COUNT
	TRZE	SW,ONEBYT	;REQUEST ONE BYTE?
	POPJ	PP,		; & RETURN
	LDB	CH,CONVRT	;CONVERT IF REQUIRED
	CAMGE	OC,RECBYT	;RECORD FULL?
	IDPB	CH,OP		; NO, PUT BYTE
	ADDI	OC,1		;COUNT BYTE
	JRST	GETEMV		;CONTINUE THRU RECORD
;GET FIRST BYTE OF RECORD (INDEXED FILE INPUT)


IDXFB:	MOVE	TA,DATFLG	;USED ALL RECORDS IN CURRENT BLK?
	CAMGE	TA,DATBLK+I
	JRST	GETRE1		;NO

GETRE3:	PUSHJ	PP,GETENT	;READ 1 ENTRY OF INDEX
	TLNE	SW,(FEOF)	;END-OF-FILE?
	POPJ	PP,		;YES

	MOVE	TA,IDXHD1	;GET DATA BLK #
	TLNN	TA,-1		; IS BLK-NMBR GT 18 BITS
	CAILE	TA,-11		; [162] OR BETWEEN 777770 & 777777?
	JRST	GTRE2F		; [162] YES, DO FILOP. USETI
	JRST	GETRE2		; NO

GTRE2F:	MOVEM	TA,FUSI+1	; [162] BLK-NMBR TO ARG BLOCK
	MOVEI	TA,IF2		; SAME FOR THE
	HRLM	TA,FUSI		; CHANNEL NMBR
	MOVE	TA,[2,,FUSI]	; POINT AT ARG BLOCK
	FILOP.	TA,		; FILOP. TYPE USETI
	  JFCL			; ERROR RETURN
	JRST	GETRE4		;

GETRE2:	USETI	IF2,(TA)	;AIM AT THAT BLK
GETRE4:	PUSHJ	PP,DATREA	;& READ IT IN

GETRE1:	AOS	TA,DATFLG	;INCR COUNT TO NEW RECORD
	SUBI	TA,1		;ADVANCE BYTE PTR TO NEW RECORD
	HRRZ	TA,INPTR	;INCREMENT INPTR TO 1ST WORD OF NEXT REC
	AOJ	TA,
	HLL	TA,BYPTRS(IM)	;GET PROPER POINTER
	MOVEM	TA,INPTR

	HRRZ	TA,@INPTR	;GET REC SIZE
	TRNE	IM,AS.MOD	;IS IT ASCII?
	LSH	TA,-1		;DROP BIT 35 IF ASCII FILE
	JUMPE	TA,GETRE3	;IGNORE EMPTIES
	CAIN	IM,AS.MOD	; ASCII FILE [141]
	SUBI	TA,2		; YES DONT'T COUNT CR-LF [141]
	MOVEM	TA,INPSIZ
	CAMLE	TA,RECBYT+I	;[EDIT#141]
	JRST	RECERR		;[EDIT#141]
	AOS	INPTR		;SET PTR TO 1ST REAL BYTE
	TRO	SW,ONEBYT	;REQUEST ONE BYTE
	JRST	GETDAT		; PROCESS & RETURN
;READ 1 ENTRY OF INDEX

GETENT:	MOVE	TA,IDXFLG-1(IX)	;LAST ENTRY READ AT THIS LEVEL
	CAMG	TA,IDXEIN-1(IX)	;ANYMORE THERE?
	JRST	GETEN1		;YES

GETEN2:	CAME	IX,LEVELS+I	;ARE WE ALREADY AT TOP LEVEL?
	AOJA	IX,GETENT	;NO, MOVE UP 1 LEVEL

	TLO	SW,(FEOF)	;HAVE HIT END OF FILE
CPOPJ:	POPJ	PP,

GETEN1:	MOVE	TF,IDXLIN-1(IX)	;MAKE BYTE PTR TO CURRENT ENTRY
	ADD	TF,IDXWIN-1(IX)

	MOVE	TA,(TF)		;STORE 1ST 2 WORDS OF ENTRY
	JUMPE	TA,GETEN2	;ENTRY IS EMPTY
	MOVEM	TA,IDXHD1	;BLOCK # THIS ENTRY POINTS TO
	MOVE	TA,1(TF)
	MOVEM	TA,IDXHD2	;ITS VERSION #

	MOVE	TC,SIZIDX+I	;READ & SAVE THE KEY
	SUBI	TC,2
	HRLZI	TA,2(TF)
	HRRZ	TB,INKEY
	HRRI	TA,(TB)
	ADDI	TB,-1(TC)
	BLT	TA,(TB)

	MOVE	TF,IDXWIN-1(IX)	;MAKE PTR TO NEXT INDEX ENTRY
	ADD	TF,SIZIDX+I
	MOVEM	TF,IDXWIN-1(IX)
	AOS	IDXFLG-1(IX)	;INCREMENT ENTRY USED CTR

	MOVE	TA,IDXHD1	; GET BLK NUMBER OF NEXT IDX LEVEL
	MOVEM	TA,CURIDX-1(IX)	; SAV CURRENT INDEX BLK NUMBER
	SOJE	IX,GETEN3	;EXIT IF AT LEVEL 0 INDEX
	TLNN	TA,-1		;[157] IF BLOCK-NMBR GT 18 BITS
	CAILE	TA,-11		; [162] OR BETWEEN 777770 & 777777?
	JRST	GETE1F		; [162] YES, DO FILOP. USETI
	JRST	GETE1A		;[157] NO GO TO USETI

GETE1F:	MOVEM	TA,FUSI+1	;[162] [157]  BLK-NUMER TO ARG BLOCK
	MOVEI	TA,IF1		;[157] GET CHANNEL 
	HRLM	TA,FUSI		;[157] CHANNEL TO ARG BLOCK
	MOVE	TA,[2,,FUSI]	;[157] POINT TO ARG BLOCK
	FILOP.	TA,		;[157] DO THE FILOP. (USETI)
	JFCL			;[157] ERROR RETURN
	SKIPA			;[157] SKIP REG. USETI
GETE1A:	USETI	IF1,(TA)	;[157] AIM AT DESIRED LOWER LEVEL BLK OF IDX
	PUSHJ	PP,IDXREA	;READ IT
	JRST	GETEN1

GETEN3:	CAIN	IX,0		;IF IX HAS GONE TO 0, RESET IT TO 1
	MOVEI	IX,1
	POPJ	PP,

SUBTTL	COMPARE NEW KEY VERSUS OLD KEY

CAMKEY:
	CAMGE	OC,LASTKB	;IS THE RECORD GREATER THAN OR = KEY SIZ
	JRST	RTSERR		;NO - TOO SHORT


CAMK1:	HRRZ	TA,RECPTR	;GET THIS
	ADD	TA,RECKEY	;  KEY
	MOVE	TB,NEWKEY	;  INTO
	PUSHJ	PP,@CAMKZ(KT)	;  NEWKEY

;COMPARE THE KEYS

	MOVE	TA,OLDKEY
	MOVE	TB,NEWKEY
	MOVE	TC,SIZKEY

CAMK2:	MOVE	TE,(TB)
	CAME	TE,(TA)
	JRST	CAMK2A
	SOJLE	TC,CAMK3
	ADDI	TB,1
	AOJA	TA,CAMK2
CAMK2A:	JUMPE	KT,CAMK2B
	CAML	TE,(TA)
	JRST	CAMK4
	JRST	CAMK2C

CAMK2B:	MOVE	TD,(TA)
	TLC	TD,1B18
	TLC	TE,1B18
	CAML	TE,TD
	JRST	CAMK4

;KEYS ARE OUT OF ORDER

CAMK2C:	PUSHJ	PP,CAMD		;DECIDE IF FATAL	[EDIT#107]
	TYPE	(ISMKOO	keys are out of order
)				;	[EDIT#107]
	TYPE	(	)
	MOVE	TA,NEWKEY
	PUSHJ	PP,@CAMKX(KT)
	TYPE	(
	is after
)
	TYPE	(	)
	MOVE	TA,OLDKEY
	JRST	CAMK3A
;TWO KEYS ARE EQUAL

CAMK3:	PUSHJ	PP,CAMD		;DECIDE IF FATAL		[EDIT#107]
	TYPE	(ISMDPK	two keys with equal value = ) ; [EDIT#107]
	MOVE	TA,NEWKEY
CAMK3A:	PUSHJ	PP,@CAMKX(KT)
	TYPE	(
)

	PUSHJ	PP,CAMK4	; RESET OLDKEY VALUE 
	TRNE	SW,OPT.I	;NOT FATAL IF /I OR /C		[EDIT#107]
	POPJ	PP,		;RETURN				[EDIT#107]
	TRNE	SW,OPT.C	;/CHECK?
	PJRST	DTBLK		; YES,PRINT DATA BLK INFO AND RET TO CALLER
	JRST	START

;ALL IS OK--MOVE NEW KEY TO OLD KEY

CAMK4:	MOVE	TB,SIZKEY
	MOVE	TA,NEWKEY
	MOVE	TC,OLDKEY

CAMK5:	MOVE	TE,(TA)
	MOVEM	TE,(TC)
	SOJLE	TB,CAMK5A
	ADDI	TC,1
	AOJA	TA,CAMK5
CAMK5A:	POPJ	PP,
CAMD:	TRNE	SW,OPT.I+OPT.C	;IGNORE OPTION ON OR /C?	[EDIT#107]
	JRST	CAMD1		;YES, GO OUTPUT "%"		[EDIT/107]
	TYPE	(
?)				;NO, OUTPUT "?"		[EDIT#107] 
	POPJ	PP,		;				[EDIT#107]
CAMD1:	TYPE	(
%)				;YES, WARN ONLY ;[EDIT#107]
	POPJ	PP,
;DISPLAY A KEY

CAMKX:	EXP	CAMKX1	;NON-NUMERIC
	EXP	CAMKX2	;1-WORD NUMERIC
	EXP	CAMKX3	;2-WORD NUMERIC
	EXP	CAMKX2	;1-WORD FIXED-POINT
	EXP	CAMKX3	;2-WORD FIXED-POINT
	EXP	CAMKX4	;1-WORD FLOATING-POINT
	EXP	CAMKX5	;2-WORD FLOATING-POINT
	EXP	CAMKX2	;1-WORD COMP-3
	EXP	CAMKX3	;2-WORD COMP-3

CAMKX1:	LDB	TC,KY.SIZ	;GET KEY SIZE
CAMX1A:	ILDB	CH,TA
	LDB	CH,@CNVPI7(OM)	;CONVERT TO ASCII
	TYPEC	CH				
	SOJG	TC,CAMX1A
	POPJ	PP,

;1-WORD FIXED-POINT

CAMKX2:	MOVE	TE,(TA)
	JRST	PUTDEC

;2-WORD FIXED-POINT

CAMKX3:	PUSHJ	PP,SAVAC		;[155] SAVE AC'S
	MOVE	0,(TA)			;[155] PUT KEY IN 0 
	MOVE	1,1(TA)			;[155] AND 1 FOR PD7.
	MOVEI	TB,3			;[155] 
	MOVE	TD,[POINT 7,TTYBUF]	;[155] SET UP PINTER
	MOVEM	TD,INKEY		;[155] TO PUT OUT
	TLZ	TD,7777			;[155] BUILD PARAMETER WORD
	LDB	TE,KY.SIZ		;[155] FOR PD7.
	DPB	TE,[POINT 11,TD,17]	;[155] TO CONVERT THIS TO ASCII
	SKIPGE	0			;[155] IS IT SIGNED?
	TLO	TD,4000			;[155] YES
	MOVEM	TD,GDPARM		;[155] STORE PARAMETER
	MOVEI	16,GDPARM		;[155] TELL PD7. WHERE IT IS
	PUSHJ	PP,PD7.##		;[155] DO THE CONVERSION
	MOVE 	TA,INKEY		;[155] GET RCONVERTED NUMBER
	MOVEI	TC,22			;[155] PUT OUT 18 DIGITS
CAMX3A:	ILDB	CH,TA			;[155] GET NEXT CHAR
	TYPEC	CH			;[155] PUT IT OUT
	SOJG	TC,CAMX3A		;[155] LOOP BACK
	JRST	RESAC			;[155] RESTORE AC'S AND CONTINUE


;2-WORD FLOATING-POINT IS NOT SUPPORTED

CAMKX5:	SUBI	KT,1

;1-WORD FLOATING-POINT

CAMKX4:	MOVE	TE,(TA)
	MOVE	TF,[POINT 3,TE]
	JRST	PUTOC3


;PICK UP THE NEXT KEY

CAMKZ:	EXP	CAMKZ1	;NON-NUMERIC
	EXP	CAMKZ2	;NUMERIC DISPLAY < 11 DIGITS
	EXP	CAMKZ2	;NUMERIC DISPLAY > 10 DIGITS
	EXP	CAMKZ3	;1-WORD FIXED-POINT
	EXP	CAMKZ4	;2-WORD FIXED POINT
	EXP	CAMKZ3	;1-WORD FLOATING-POINT
	EXP	CAMKZ6	;2-WORD FLOATING-POINT
	EXP	CAMKZ7	;1-WORD COMP-3
	EXP	CAMKZ7	;2-WORD COMP-3

CAMKZ1:	LDB	TE,KY.SIZ	;GET SIZE

CAMZ1A:	ILDB	CH,TA
	IDPB	CH,TB
	SOJG	TE,CAMZ1A
	POPJ	PP,

;KEY IS COMP-3

CAMKZ7:	MOVEI	TD,GC3.##	;PROPER CONVERSION ROUTINE
	JRST	CAMKZ8

CNVROC:	;COMP CONVERSION ROUTINES
	EXP	GD6.##
	EXP	GD9.##
	EXP	GD7.##
	EXP	GD7.##

	
;KEY IS NUMERIC DISPLAY

CAMKZ2:
	MOVE	TD,CNVROC(OM)	;GET CONVERSION ROUTINE

CAMKZ8:
	PUSHJ	PP,SAVAC	;SAVE AC'S 0-16
	TLZ	TA,7777		;BUILD
	LDB	TE,KY.SIZ	;  PARAMETER
	DPB	TE,[POINT 11,TA,17]; FOR
	TLNE	SW,(FSGND)	;IS IT SIGNED
	TLO	TA,4000		;  YES
	MOVEM	TA,GDPARM	;STORE PARAMETER

	MOVEI	16,GDPARM
	PUSHJ	PP,(TD)		;CALL APPROPRIATE ROUTINE

	MOVE	TE,SAVEAC+TB
	MOVEM	0,(TE)
	MOVE	TD,SIZKEY
	CAILE	TD,1
	MOVEM	1,1(TE)
	JRST	RESAC		;RESTORE AC'S AND RETURN

;KEY IS 2-WORD FLOATING .....NOT SUPPORTED

CAMKZ6:	SUBI	KT,1

;KEY IS 1-WORD (FIXED OR FLOATING)

CAMKZ3:	MOVE	TD,(TA)
	TLNN	SW,(FSGND)	;IS IT SIGNED?
	MOVMS	TD		;NO - USE MAGNITUDE
	MOVEM	TD,(TB)
	POPJ	PP,

;KEY IS 2-WORDS FIXED 


CAMKZ4:
	TLNE	SW,(FSGND)		;IS IT SIGNED?
	JRST	CAMKZ5			;NO

	PUSHJ	PP,SAVAC
	MOVE	16,(TA)
	HRLI	16,(Z TA,)
	PUSHJ	PP,MAG.##
	MOVE	TE,SAVEAC+TB
	MOVEM	TA,(TE)
	MOVEM	TA+1,1(TE)
	JRST	RESAC

CAMKZ5:	MOVE	TE,1(TA)
	MOVEM	TE,1(TB)
	MOVE	TE,(TA)
	MOVEM	TE,(TB)
	POPJ	PP,

SUBTTL	FILE IS COMPLETE--FINISH UP INDEX

ALLDUN:	CLOSE	IF1,
	RELEASE	IF1,		;BL
	TRNE	SW,OPT.C	; /CHECK ?
;	JRST	START		; YES, ALL DONE THEN
	JRST	[CLOSE	IF2,
		RELEASE	IF2,
		JRST	FIN$	]
	TRNE	SW,OPT.P	;PACK?
	TRNN	SW,OPT.A7	; AND ADVANCE AFTER?
	JRST	ALLD05		; NO, SKIP
	MOVEI	CH,15		; YES, LOAD CR
	PUSHJ	PP,PUTBYT	; AND PUT TO BUFFER
ALLD05:	MOVE	TE,ORLEFT	;IS ANYTHING
	CAMN	TE,DATRIT	;  IN DATA BUFFER?
	JRST	ALLD2		;NO

	PUSHJ	PP,WRITE	;YES--WRITE IT OUT
ALLD1:	MOVE	TE,OSECC	;MAKE SURE
	CAML	TE,DATSEC	;  ALL SECTORS
	JRST	ALLD2		;  WRITTEN
	PUSHJ	PP,WRITE	;NOT ENOUGH--WRITE EMPTY ONE
	JRST	ALLD1		;  AND LOOP

ALLD2:	TRNE	SW,OPT.P	;NO EMPTY BLKS WITH /P
	JRST	ALLD10
	MOVE	TD,%DAT		;COMPUTE
	IMUL	TD,NDATB	;  NUMBER OF EMPTY BLOCKS REQUIRED
	IDIVI	TD,^D100	;# OF ADDITIONAL BLOCKS		[EDIT #106]
	JUMPE	TE,.+2		;ANY REMAINDER?
	ADDI	TD,1		;YES, ROUND UPWARDS
	SKIPE	NDATB		;MUST HAVE AT LEAST ONE DATA BLOCK		[EDIT#106]
	JRST	ALLD12		;HAS AT LEAST ONE		[EDIT#106]
	MOVEI	TD,1		;  GIVE 1 EMPTY
	PUSHJ	PP,WRITE	;(MUST DO DUMMY OUTPUT 1ST)

ALLD12:	MOVEM	TD,NDATBE	;THAT IS NUMBER OF EMPTY DATA BLOCKS
	ADDM	TD,NDATB	;UPDATE TOTAL NUMBER OF BLOCKS
	IMUL	TD,DATSEC	;MULTIPLY BY NUMBER OF SECTORS PER BLOCK

	JUMPE	TD,ALLD10	;MIGHT HAVE 0 EXTRA		[EDIT#106]
ALLD3:	PUSHJ	PP,WRITE	;WRITE EMPTY SECTOR
	SOJG	TD,ALLD3	;LOOP UNTIL DONE

ALLD10:	TLNE	SW, (FMTA)	; MAG TAPE?
	TRNN	SW, OPT.L	; WITH LABELS?
	JRST	.+2
	PUSHJ	PP, TLABEL	; YES - PUT OUT TRAILING LABEL
;IFN TOPS20,<	PUSHJ	PP,OF2AFS	>;[154]GET ASCII FILE SPEC
	CLOSE	OF2,		;CLOSE DATA FILE
	STATZ	OF2,$ERA	;BE SURE NO ERRORS
	  JRST	DATERA

;IFN TOPS20,<
;	MOVE	TA,OF2DAT	;GET DEVICE NAME OF IDA FILE
;	CALLI	TA,$GETCH	;GET CHARACTERISTICS
;	TLNN	TA,$DSK		;A DISK?
;	JRST	ALLD13		;NO
;	TRNN	SW,OPT.P	;SKIP IF A SEQ FILE
;	PUSHJ	PP,OF1SIZ	;CHANGE .FBSIZ TO +INFINITY
;>;END IFN TOPS20

	RELEASE	OF2,		;BL
ALLD13:	TRNE	SW,OPT.P	;IF /P, WE ARE ALL DONE
	JRST	[CLOSE	IF2,
		RELEASE	IF2,
		JRST	FIN$	]

;WRITE OUT INDEX BLOCKS STILL IN CORE

ALLD4:	TLZN	SW,(FRECIN)	;IF NO DATA RECORDS SEEN,
	PUSHJ	PP,RITKEY	;  WRITE A DUMMY INDEX ENTRY
	MOVEI	TA,1		;START AT LEVEL ONE

ALLD5:	CAMN	TA,LEVELS	;IS THIS THE TOP LEVEL?
	JRST	ALLD9		;YES

	PUSH	PP,TA		;SAVE LEVEL
	PUSHJ	PP,RITKY4	;UPDATE HIGHER LEVELS AND WRITE THIS ONE
	POP	PP,TA		;RESTORE IN CASE 'RITKY4' CLOBBERED IT
	AOJA	TA,ALLD5	;GO TO NEXT HIGHER LEVEL

ALLD9:	MOVE	TE,FEISEC	;NEXT FREE SECTOR IS
	MOVEM	TE,IDXADR	;  LOCATION OF HIGHEST LEVEL INDEX BLOCK
	PUSHJ	PP,RITIDX	;WRITE OUT THAT BLOCK

;WRITE OUT SAT BLOCKS

	MOVE	TE,STHDR	;SAVE INDEX RECORD SIZE
	MOVEM	TE,SAVSTH

	MOVE	TE,IDXSEC	;COMPUTE
	LSH	TE,7		;  NUMBER
	SUBI	TE,1		;  OF CHARACTERS IN
	IMULI	TE,6		;  INDEX SECTOR
	MOVEM	TE,STHDR	;THAT IS RECORD SIZE FOR SAT BLOCKS
	IMULI	TE,6		;COMPUTE NUMBER OF BITS
	MOVEM	TE,NB1SB	;SAVE THAT

	MOVE	TD,FEISEC	;SAT BLOCKS WILL BE
	MOVEM	TD,SATADR	;  WRITTEN IN FIRST AVAILABLE BLOCK

	MOVE	TA,NDATB	;GET NUMBER OF DATA BLOCKS
	SUB	TA,NDATBE	;  LESS NUMBER OF EMPTIES
	MOVEM	TA,NBWRIT	;WE MUST PUT OUT THAT MANY 1-BITS
	JUMPE	TA,ALLD0	;NO BITS IF TA=0

ALLD6:	CAMLE	TA,NB1SB	;WILL THIS BLOCK BE FULL OF 1-BITS?
	MOVE	TA,NB1SB	;YES
	MOVN	TB,TA		;DECREMENT
	ADDM	TB,NBWRIT	;  NUMBER LEFT TO GO AFTER THIS ONE

	HRRZ	TB,IDXLOC	;BUILD
	ADD	TB,[POINT 1,1]	;  BYTE-POINTER
	MOVEI	TC,1		;FILL BLOCK WITH
	IDPB	TC,TB		;  ENOUGH
	SOJG	TA,.-1		;  ONE-BITS

ALLD0:	PUSHJ	PP,RITID1	;WRITE OUT SAT BLOCK
	AOS	NUMSAT		;INCREMENT NUMBER WRITTEN
	SKIPLE	TA,NBWRIT	;IF MORE TO GO,
	JRST	ALLD6		;  LOOP

	MOVE	TD,MAXSAT	;HOW MANY DID HE SAY HE WANTED?
	IDIV	TD,DATBLK
	MOVE	TA,NDATB
	CAIL	TA,(TD)		;IF MORE THAN WHAT WE COUNT,
	MOVE	TD,NDATB	;  GIVE THEM TO HIM
	MOVEM	TD,NDATBT

ALLD7:	MOVE	TA,NB1SB	;DO WE
	IMUL	TA,NUMSAT	;  NEED
	CAML	TA,NDATBT	;  MORE EMPTY ONES?
	JRST	ALLD8		;NO

	AOS	NUMSAT		;YES--WRITE OUT
	PUSHJ	PP,RITID1	;  AN EMPTY ONE
	JRST	ALLD7		;LOOP

ALLD8:	MOVEM	TA,SATBIT	;SAVE TOTAL NUMBER OF BITS IN ALL SAT BLOCKS

	MOVE	TE,SAVSTH	;RESTORE
	MOVEM	TE,STHDR	;  ORIGINAL RECORD SIZE
;NOW WRITE OUT ANY EMPTY INDEX BLOCKS REQUIRED

	MOVN	TE,IDXOUT	;SAVE NUMBER OF BLOCKS
	IMUL	TE,IDXSEC	;  ALREADY WRITTEN
	MOVEM	TE,NSECIE	;  AS NEGATIVE NUMBER (UPDATED LATER)

	MOVE	TC,IDXOUT	;GET NUMBER OF INDEX BLOCKS WRITTEN
	SUB	TC,NUMSAT	;  LESS NUMBER OF SAT BLOCKS
	SUBI	TC,1		;  LESS 1 FOR STATISTICS BLOCK
	IMUL	TC,%IDX		;COMPUTE # EMPTY BLKS REQUIRED
	MOVEI	TA,^D100
	SUB	TA,%IDX
	IDIVI	TC,(TA)
	JUMPE	TD,ALLD11	;ANY REMAINDER?
	ADDI	TC,1		;YES, ROUND UP
	JRST	ALLD11

	PUSHJ	PP,RITID1	;WRITE UNTIL
ALLD11:	SOJGE	TC,.-1		;  ENOUGH WRITTEN

	MOVE	TE,IDXOUT	;COMPUTE NUMBER OF
	IMUL	TE,IDXSEC	;  BLOCKS WRITTEN
	MOVEM	TE,NSECI	;  AND PUT IN STAT BLOCK
	ADDM	TE,NSECIE	;NUMBER OF FREE BLOCKS
	SUB	TE,NSECIE	;RECOMPUTE
	ADDI	TE,1		;  ADDRESS OF FIRST
	MOVEM	TE,FEISEC	;  FREE SECTOR

;WRITE OUT STATISTICS BLOCK

	MOVEI	TE,$ISAMI	;SET ISAM INDEX FLAG IN 1ST WORD
	HRLM	TE,STHDR

	MOVE	TE,.JBVER##	;PUT ISAM VERSION # IN STAT BLK
	MOVEM	TE,ISAVER

	MOVE	TE,IDXLOC	;MOVE STAT BLOCK
	HRLI	TE,STHDR	;  OVER
	MOVE	TD,TE		;  TO FIRST
	BLT	TE,STATSZ-1(TD)	;  INDEX BLOCK

	USETO	OF1,1		;WE WILL WRITE IN FIRST INDEX BLOCK
	PUSHJ	PP,RITID1

;IFN TOPS20,<	PUSHJ	PP,OF1AFS	>;[154] GET ASCIZ FILE SPEC
	CLOSE	OF1,		;CLOSE INDEX FILE
	STATZ	OF1,$ERA	;BE SURE THERE ARE
	  JRST	IDXERA		;  NO ERRORS
;IFN TOPS20,<
;	MOVE	TA,OF1DAT	;GET DEVICE NAME OF IDX FILE
;	CALLI	TA,$GETCH	;GET CHARACTERISTICS
;	TLNE	TA,$DSK		;SKIP IF NOT A DSK
;	PUSHJ	PP,OF1SIZ	;CHANGE .FBSIZ TO +INFINITY
;>;END IFN TOPS20

	RELEASE	OF1,		;RELEASE
;	RELEASE	OF2,		;  ALL
;	RELEASE	IF1,		;  FILES
;DISPLAY SOME OF THE FINAL STATISTICS

	TYPE	 (
[ISMLOV	)
	MOVE	TE,LEVELS
	PUSHJ	PP,PUTDEC
	TYPE	( Level)
	MOVE	TE,LEVELS
	CAIN	TE,1
	JRST	ALD11A
	TYPE	(s)
ALD11A:	TYPE	( of index ]
)

	TYPE	([ISMNDR	)
	MOVE	TE,MUCHO
	PUSHJ	PP,PUTDEC
	TYPE	( Data record)
	MOVE	TE,MUCHO
	CAIN	TE,1
	JRST	ALD11B
	TYPE	(s)
ALD11B:	TYPE	( ]

)
IFN	$CU001,<	;MAKE ISAM MORE INTELLIGENT
FINSTA:			;REPORT FINAL STATS ON THE INDEX BLOCKING FACTORS AND
			;THEIR  EFFICIENCY
	MOVE	TA,DATBLK	;PICK UP THE USED BLOCKING FACTOR FOR THE DATA FILE
	CAME	TA,IDABF	;AND SEE IF USER USED CORRECT ONE
	 PUSHJ	PP,FNDSTA	;NO SO GO FIGURE EVERYTHING OUT
	TYPE	([ISMWSD	Wasted )
	MOVE	TE,DATWST
	PUSHJ	PP,PUTPNT	;TELL HOW MANY WORDS ARE WASTED
	TYPE	( words of )
	MOVE	TA,RECSIZ	;GET RECORD SIZE
	ADDI	TA,1		;ADD OVERHEAD WORD
	IMUL	TA,IDABF	;AND CALC # OF USED WORDS
	ADD	TA,DATWST	;ADD IN WASTED WORDS
	MOVE	TE,TA
	PUSHJ	PP,PUTDEC	;TLL USER
	TYPE	(. )
	MOVE	TD,DATWST
	JUMPE	TD,FNSTAA	; SKIP % IF ZERO
	MOVE	TB,DATBLS
	PUSHJ	PP,CLPCN	;GO GET PERCENTAGE
	MOVE	TA,TE		;PUT INTO TA FOR FINPCN
	PUSHJ	PP,FINPCN	;GO PRINT PERCENTAGE
	TYPE	(% wasted space)
FNSTAA:	TYPE	( in the Data file.]
)
	TYPE	([ISMLDE	One logical Data block equals )
	MOVE	TE,DATBLS	;TELL USER HOW LARGE HIS BLOCK IS

IFN TOPS20,<
	TRNE	SW,OPT.OP	;OUTPUT IN PAGES?
	JRST	[PUSHJ	PP,BKTOPG	; YES, CONVERT TO PAGES
		PUSHJ	PP,PUTPNT
		TYPE	( page)
		JRST	PLURL1	]	;CHECK FOR MORE THAN ONE
>				;END IFN TOPS20

	PUSHJ	PP,PUTPNT	; OUTPUT NOT IN PAGES
	TYPE	( physical disk block)
PLURL1:	MOVE	TE,DATBLS	;SEE IF SHOULD BE BLOCKS OR BLOCK

IFN TOPS20,<
	TRNE	SW,OPT.OP	;OUTPUT IN PAGES?
	PUSHJ	PP,BKTOPG	; YES, CONVERT TO PAGES
>				;END IFN TOPS20

	SOJE	TE,FNSTAB
	TYPE	(s)
FNSTAB:	TYPE	(.]
)

FINST1:	MOVE	TA,IDXBLK	;GET BLOCKING FACTOR FOR INDEX FILE
	CAME	TA,IDXBF	;SEE IF USER USED THE CORRECT ONE
	 PUSHJ	PP,FNISTA	;NO SO GO CALC EVERYTHING
	TYPE	([ISMWSI	Wasted )
	MOVE	TE,IDXWST	;GET WASTED SPACE
	PUSHJ	PP,PUTPNT	;TELL THE USER
	TYPE	( words of )
	MOVE	TA,SIZIDX	;GET ENTRY SIZE
	IMUL	TA,IDXBF	;CALC TOTAL USED
	ADD	TA,IDXWST	;ADD IN WASTED WORDS
	ADDI	TA,2		;AND ADD OVERHEAD FOR BLOCK
	MOVE	TE,TA
	PUSHJ	PP,PUTDEC	;TELL USER
	TYPE	(. )
	MOVE	TD,IDXWST
	JUMPE	TD,FNST1A	; JUMP IF % ZERO
	MOVE	TB,IDXBLS
	PUSHJ	PP,CLPCN	;CALC %
	MOVE	TA,TE
	PUSHJ	PP,FINPCN	;GO PRINT THE PERCENTAGE
	TYPE	(% wasted space)
FNST1A:	TYPE	( in the Index file.]
)
	TYPE	 ([ISMLIE	One logical Index block equals )
	MOVE	TE,IDXBLS	;TELL USER HOW LARGE HIS INDEX BLOCK IS

IFN TOPS20,<
	TRNE	SW,OPT.OP	;OUTPUT IN PAGES?
	JRST	[PUSHJ	PP,BKTOPG	; YES,CONVERT TO PAGES
		PUSHJ	PP,PUTPNT
		TYPE	( page)
		JRST	PLURL2	]	; & CHECK FOR MORE THAN ONE
>				;END TOPS20

	PUSHJ	PP,PUTPNT	; OUTPUT NOT IN PAGES
	TYPE	( physical disk block)
PLURL2:	MOVE	TE,IDXBLS	;SEE IF SHOULD BE BLOCKS OR BLOCK

IFN TOPS20,<
	TRNE	SW,OPT.OP	;OUTPUT IN PAGES?
	PUSHJ	PP,BKTOPG	; YES, CONVERT
>				;END IFN TOPS20

	SOJE	TE,FNST1B
	TYPE	(s)
FNST1B:	TYPE	(.]
)
FINIOB:	MOVEI	TD,^D256	;CALCULATE AND REPORT STORAGE
				;REQUIREMENTS FOR LIBOL'S I/O BUFFER FOR THIS FILE
	MOVE	TB,IDXBLS	;GET # OF DISK BLOCKS PER INDEX BLOCK
	IMUL	TB,LEVELS	;CALC TOTAL FOR EACH LEVEL OF INDEX
	MOVE	TC,DATBLS	;GET # OF DISK BLOCKS PER DATA BLOCK
	IMULI	TC,2		;AND GET TOTAL FOR DATA AND SCRATCH BLOCK
	ADD	TB,TC		;GET SUB TOTAL
	LSH	TB,7		;CONVERT INTO WORDS
	ADD	TD,TB		;GET TOTAL # OF WORDS
	TYPE	([ISMIBS	LIBOL's I/O buffer will require )
	MOVE	TE,TD		;REPORT # OF WORDS
	PUSHJ	PP,PUTPNT
	TYPE	( words )
	TYPE	(<(>)		;TYPE LEFT PAREN
	ADDI	TD,777		;ROUND UP TO NEAREST PAGE BOUNDRY
	LSH	TD,-^D9		;CONVERT TO PAGES
	MOVE	TE,TD		;AND REPORT TOTAL REQUIRED
	PUSHJ	PP,PUTPNT
	TYPE	( Pages)
	TYPE	(<)>)		;TYPE RIGHT PAREN
	TYPE	( of memory.]
)
	JRST	FIN$


IFN TOPS20,<
BKTOPG:
	MOVEI	TB,0		;INIT SW
	TRNE	TE,3		;TEST FOR CARRY
	AOS	TB		;SET CARRY
	LSH	TE,-2		;DIVIDE BY 4
	ADD	TE,TB		;ADD CARRY
	POPJ	PP,		;RETURN
>				;END IFN TOPS20
FINPCN:	IDIVI	TA,^D10
	MOVE	TE,TA
	PUSHJ	PP,PUTPNT	;AND PRINT TOTAL WORDS IN BLOCK
				; AND DECIMAL POINT
	MOVE	TE,TB		;PICK UP THE REMAINDER
	JRST	PUTDEC	;WRITE IT  AND RETURN FROM PUTDEC

FNISTA:	MOVE	TB,SIZIDX	;GET SIZE OF EACH INDEX ENTRY
	MOVEM	TA,IDXBF	;SAVE USER'S BLOCKING FACTOR FOR LATER
	IMUL	TA,TB		;GET # OF WORDS USED
	ADDI	TA,2		;ADD IN THE TWO HEADER WORDS PER INDEX BLOCK
	MOVE	TC,TA		;AND SAVE FOR A LITTLE LATER
	ADDI	TA,^D127	;ROUND UP
	LSH	TA,-7		;CONVERT TO BLOCKS
	MOVEM	TA,IDXBLS	;SAVE FOR LATER
	LSH	TA,7		;CONVERT BACK TO WORDS
	SUB	TA,TC		;CALC THE # OF WASTED WRODS
	MOVEM	TA,IDXWST	;SAVE IT
	POPJ	PP,		;AND THEN RETURN

FNDSTA:	MOVE	TB,RECSIZ	;PICK UP RECORD SIZE
	ADDI	TB,1		;ADD OVERHEAD WORD FOR EACH RECORD
	MOVEM	TA,IDABF	;SAVE FOR LATER
	IMUL	TA,TB		;CALC # OF WORDS USED
	MOVE	TC,TA		;SAVE FOR A LITTLE LATER TO CALC WASTED SPACE
	ADDI	TA,^D127	;ADD TO ROUND UP
	LSH	TA,-7		;THEN SEE HOW MANY BLOCKS IT IS
	MOVEM	TA,DATBLS	;AND SAVE FOR LATER
	LSH	TA,7		;CONVERT BACK TO WORDS
	SUB	TA,TC		;AND GET # OF WASTED WORDS
	MOVEM	TA,DATWST	;AND SAVE
	POPJ	PP,		;THEN RETURN



	>;END OF IFN $CU001
FIN$:	TLNN	SW,(INDIR)	;INDIRECT COMMAND FILE?
	JRST	START		; NO, LOOP BACK TO THE BEGINNING
	TLNE	SW,(FCEOF)	;END OF CMD FILE?
	JRST	START		; YES, GO START AGAIN
	MOVEI	SW,0		; NO, CLEAR OLD SWITCHES
	TLO	SW,(INDIR)	;  & REMIND THIS IS INDIRECT
	TLO	SW,(FCEOFK)	;EOF OK TO BEGIN WITH
	JRST	START1		;GO DO IT AGAIN
IFN TOPS20,<
	;THIS CODE MAKES THE .IDX FILE'S END-OF-FILE POINTER (.FBSIZ)
	;BE 377777,,777777  - THIS ENABLES ALL "SMU" UPDATERS TO FIND
	;DATA APPENDED TO THE END OF FILE.  THIS CODE SHOULD GO AWAY
	;WHEN THE TOPS20 MONITOR IS FIXED.  I.E. VERSION 3.  [154]

OF1AFS:	SKIPA	TA,[3,,[OF1,,5
			-1,,OF1AZB
			111110,,1]]	;[154] EXCHANGE CHAN# FOR ASCIZ FILE SPEC
OF2AFS:	MOVE	TA,[3,,[OF2,,5
			-1,,OF1AZB
			111110,,1]]	;[154] EXCHANGE CHAN# FOR ASCIZ FILE SPEC
	COMPT.	TA,			;[154]
	 JFCL				;[154]
	POPJ	PP,			;[154]

OF1SIZ:	HRLZI	1,(GJ%OLD!GJ%SHT)	;[154] EXCHANGE ASCIZ STRING FOR JFN
	HRROI	2,OF1AZB		;[154]
	GTJFN				;[154]
	 JFCL				;[154]
	HRLI	1,.FBSIZ		;[154] CHANGE JFN'S .FBSIZ TO +INFINITY
	SETO	2,			;[154]
	HRLOI	3,377777		;[154]
	CHFDB				;[154]
	 ERJMP	ERRJSY			; JSYS ERROR
	POPJ	PP,			;[154]


ERRJSY:	TYPE	(?ISMJSY	Internal JSYS error, submit SPR
)

	MOVEI	1,.PRIOU	; TYPE MESSAGE ON TERMINAL
	HRLOI	2,.FHSLF	; THIS FORK, LAST ERROR
	SETZB	3,4		; NOTHING SPECIAL
	ERSTR			; PRINT LAST JSYS ERROR
	 JFCL
	 JFCL
	JRST	START



>					;[154]
SUBTTL	PUT KEY INTO AN INDEX BLOCK

RITKEY:	AOS	NDATB		;INCREMENT NUMBER OF DATA BLOCKS
	MOVEI	TA,1		;START AT LOWEST LEVEL INDEX

	MOVE	TE,IDXEIB-1(TA)	;IS THIS
	CAML	TE,IDXRIT	;  BLOCK FULL?
	PUSHJ	PP,RITKY4	;YES--UPDATE HIGHER LEVELS AND WRITE THIS

	MOVE	TB,OLDKEY	;MOVE KEY FROM 'OLDKEY'
	MOVE	TE,DATLOK	;GET 1ST SECTOR NUMBER OF DATA BLOCK

RITKY1:	MOVE	TD,IDXWRD-1(TA)	;GET DESTINATION ADDRESS
	MOVE	TC,SIZKEY	;GET KEY SIZE IN WORDS
	MOVEM	TE,(TD)		;STASH SECTOR NUMBER

RITKY2:	MOVE	TE,(TB)		;GET WORD OF KEY
	SKIPN	IDX1KY-1(TA)	;1ST KEY AT THIS LEVEL?
	MOVE	TE,LOWVAL(KT)	;YES, GET LOW VALUES FOR THIS KEY TYPE
	MOVEM	TE,2(TD)	;STORE WORD OF KEY
	SOJLE	TC,RITKY3
	ADDI	TB,1
	AOJA	TD,RITKY2

RITKY3:	AOS	IDX1KY-1(TA)	;HAVE DONE 1ST KEY AT THIS LEVEL
	AOS	IDXEIB-1(TA)	;BUMP ENTRY COUNT FOR THIS BLOCK
	ADDI	TD,3		;BUMP LOCATION FOR
	MOVEM	TD,IDXWRD-1(TA)	;  NEXT ENTRY

	POPJ	PP,		;RETURN

;CURRENT INDEX BLOCK IS COMPLETE--UPDATE HIGHER LEVELS

RITKY4:	ADDI	TA,1		;STEP UP TO NEXT LEVEL
	CAMLE	TA,LEVELS	;IF THERE IS NO NEXT LEVEL,
	PUSHJ	PP,GETLVL	;  MAKE ONE

	MOVE	TE,IDXEIB-1(TA)	;IS THAT
	CAML	TE,IDXRIT	;  BLOCK FULL?
	PUSHJ	PP,RITKY4	;YES--GO UP TO NEXT

	MOVE	TB,IDXLOC-2(TA)	;WE WILL MOVE KEY FROM 1ST ENTRY IN
	ADDI	TB,4		;  NEXT LOWER LEVEL
	MOVE	TE,FEISEC	;MOVE SECTOR NUMBER OF INDEX BLOCK

	PUSHJ	PP,RITKY1	;STASH ENTRY AND UPDATE INFO FOR THIS BLOCK

	SUBI	TA,1		;DROP DOWN ONE LEVEL
	JRST	RITIDX		;WRITE THAT BLOCK AND RETURN

;LOW VALUES FOR EACH KEY TYPE

LOWVAL:	0			;NON-NUMERIC
	1B0			;NUMERIC DISPLAY
	1B0
	1B0			;COMP
	1B0
	1B0+1B35		;COMP-1
	1B0+1B35
	1B0			;COMP-3
	1B0

GETKEY:	TLZ	SW,(FNUM!FSGND)		;CLEAR FLAGS

;BL;	5 INSERTED AT GETKEY+1 TO DISPLAY KEY DESCRIPTOR FOR LAZY PROGRAMMER /S
	TLNE	SW,(INDIR)	;SKIP QUESTION IF INDIRECT
	JRST	GETKY0
	TRNN	SW,OPT.B+OPT.S	;BUILD OR STAT?
	  JRST	  GETKY0	;  NO
	TYPE	(Key descriptor: )

GETKY0:	TRNN	SW,OPT.B		;/M OR /P GET INFO FROM STAT BLK
	JRST	GETK13

	SETZB	KT,KEYDES
	SETZM	RECKEY
;BL;	3 LINES DELETED AT GETKY-1
GETKY1:	PUSHJ	PP,GETTY

	;CHECK FOR SIGNS FIRST
	TLO	SW,(FSGND)	;SIGNED IS DEFAULT
	CAIN	CH,"S"
	JRST	[	PUSHJ	PP,GETTY	;GET NEXT CHARACTER
			CAIN	CH,"X"		;IS IT AN X??
			JRST	BADKEY		;DON'T ALLOW S WITH X
			JRST	GETKY2 		;SIGNED
		]
	CAIE	CH,"U"		;UNSIGNED SPECIFIED??
	JRST	GETKY3		;NO SIGN SPECIFIED- DEFAULT SIGNED
	PUSHJ	PP,	GETTY		;[V10] GET THE NEXT CHAR.
	CAIN	CH,	"X"		;[V10] IF IT'S "X", ALL IS WELL,
	JRST	GETK4A			;[160] ISSUE WARNING.
	TLZ	SW,(FSGND)	;TURN OFF FLAG
	MOVEI	TE,1		;SET KEYDES UNSIGNED FLAG
	DPB	TE,KY.SGN
;[V10]	PUSHJ	PP,GETTY		;ANOTHER CHARACTER
GETKY2:	HRROI	KT,-1		;DEFAULT CHANGES TO DISPLAY NUMERIC

GETKY3:	CAIN	CH,"X"		;HOW ABOUT X?
	JRST	GETKY4		;OK
	;LETS LOOK FOR NUMERIC KEYS NOW
	CAIN	CH,"N"
	MOVEI	KT,1		;NUMERIC DISPLAY
	CAIN	CH,"C"
	MOVEI	KT,3		;COMP
	CAIN	CH,"F"
	MOVEI	KT,5		;FLOATING POINT
	CAIN	CH,"P"
	MOVEI	KT,7		;COMP-3

	JUMPE	KT,GETKY5	;LEAVE IF NOTHING SEEN
	TLO	SW,(FNUM)	;SET NUMERIC FLAG

	;CHECK FOR DEFAULT NUMERIC CASE
	JUMPG	KT,GTKY3A	;OK NOT DEFAULT
	MOVEI	KT,1		;DEFAULT TO NUMERIC DISPLAY
	JRST	GETKY5		;KEEP CURRENT CHARACTER AND PROCEED

	;CHECK THE NUMERIC KEYS TO SEE IF DATA MODE IS VALID

GTKY3A:	CAIN	KT,1		;IS IT DISPLAY
	JRST	GETKY4		;YES - NO PROBLEMS

	;IT IS SOME NON-DISPLAY NUMERIC FORM
	CAIN	OM,(IM)		;INPUT AND OUTPUT MUST BE SAME
	CAIN	IM,AS.MOD	;NO ASCII ALLOWED
	JRST	IVKERR		; - CAN'T HAVE THAT

	CAIN	OM,EB.MOD	;IS IT EBCDIC
	JRST	[CAIN	KT,7	;YES - COMP-3 ONLY
		 JRST	GETKY4	;OK
		 JRST	IVKERR]	;SORRY
	CAIN	KT,7		;IF SIXBIT THEN OTHER THAN COMP-3
	JRST	IVKERR		;ERROR
	JRST	GETKY4		;[160] OK

GETK4A:	TYPE	(%U inappropriate before X, U ignored
)				;[160]
GETKY4:	PUSHJ	PP,GETTY	;GET NEXT CHARACTER

GETKY5:	MOVEM	CH,TTYKAR	;SAVE CH SO IT WILL BE PICKED UP BY 'GETDEC'

	PUSHJ	PP,GETDEC	;GET BYTE POSITION
	JUMPLE	TE,BADKEY
	CAIE	CH,"."		;MUST BE TERMINATED BY
	JRST	BADKEY		;  PERIOD
	SUBI	TE,1
	MOVEM	TE,FRSTKB	;SAVE RELATIVE BYTE POSITION

	; GENERATE THE BYTE POINTER
	IDIV	TE,BYTWRD(OM)	;DIVIDE BY BYTES PER WORD
	HLL	TE,BYPTRS(OM)	;BYTE POINTER SKELETON

	;CHECK TO SEE THAT COMP AND FLOATING FALL ON WORD BOUNDRIES
	JUMPE	TF,GETKY6	;OK IF EQUAL TO 0
	CAIE	KT,3		; OR IF NOT COMP
	CAIN	KT,5		;OR FLOATING
	JRST	CFKYER		;ERROR OTHERWISE
GETKY6:
	IMUL	TF,BYTSIZ(OM)	;COMPUTE # BITS TO LEFT
	MOVNS	TF		;COMPUTE BYTE RESIDUE
	ADDI	TF,^D36
	DPB	TF,[POINT 6,TE,5]; FINISH BYTE-POINTER
	MOVEM	TE,RECKEY

	PUSHJ	PP,GETPOS	;GET POSITIVE DECIMAL NUMBER
	JRST	BADKEY		;TROUBLE
	DPB	TE,KY.SIZ	;SAVE SIZE

	CAIG	TE,^D10		;IS BYTE-SIZE > 10?
	JRST	GETKY8		;NO
	TLNE	SW,(FNUM)	;YES--IS KEY NUMERIC?
	ADDI	KT,1		;YES--BUMP KEY TYPE BY ONE

GETKY8:	MOVE	TD,FRSTKB	;COMPUTE
	XCT	GETK12(KT)	;  LAST BYTE
	MOVEM	TD,LASTKB	;  POSITION

	DPB	KT,KY.TYP	;SAVE KEY TYPE

;COMPUTE SIZE OF AN INDEX ENTRY

GETK14:	JUMPN	KT,GETK10	;IS KEY ALPHANUMERIC?
	;COMPUTE # WORDS FOR DISPLAY
	ADD	TE,BYWDM1(OM)	;BYTES PER WORD-1
	IDIV	TE,BYTWRD(OM)	;BYTES PER WORD
	JRST	GETK11

GETK10:	; NUMERIC KEY
	MOVEI	TE,1		;ONE-WORD
	TRNN	KT,1		;  OR
	MOVEI	TE,2		;  TWO

GETK11:	MOVEM	TE,SIZKEY	;SAVE SIZE OF KEY, IN WORDS
	ADDI	TE,2		;ADD TWO WORDS FOR VERSION, POINTER
	MOVEM	TE,SIZIDX
	POPJ	PP,

;TABLE TO COMPUTE LAST BYTE POSITION OF KEY

GETK12:	ADD	TD,TE		;NON-NUMERIC
	ADD	TD,TE		;NUMERIC DISPLAY < 11 DIGITS
	ADD	TD,TE		;NUMERIC DISPLAY > 10 DIGITS
	ADD	TD,BYTWRD(OM)	;1-WORD FIXED POINT
	PUSHJ	PP,FIX2WD	;2-WORD FIXED POINT
	ADD	TD,BYTWRD(OM)	;1-WORD FLOATING POINT
	PUSHJ	PP,NO2FP	;2-WORD FLOATING POINT
	PUSHJ	PP,PAK1WD	;1-WORD COMP-3
	PUSHJ	PP,PAK2WD	;2-WORD COMP-3

FIX2WD:	;GET # BYTES IN TWO WORDS
	PUSH	PP,TE
	MOVE	TE,BYTWRD(OM)	;BYTES PER WORD
	LSH	TE,1		;TIMES 2
	ADDI	TD,(TE)		;ADD IT IN
	POP	PP,TE
	POPJ	PP,		;RETURN

PAK1WD:	;BYTE COUNT FOR PACKED DECIMAL
PAK2WD:
	PUSH	PP,TE
	ADDI	TE,2		;ROUND UP AND ONE FOR SIGN
	LSH	TE,-1		;DIVIDE BY 2
	ADDI	TD,(TE)		;ADD IT IN
	POP	PP,TE
	POPJ	PP,

NO2FP:	;COBOL DOES NOT SUPPORT ANY FORM OF TWO WORD FLOATING
	SUBI	KT,1
	XCT	GETK12(KT)
	POPJ	PP,
;/M OR /P: GET KEY INFO FROM STATISTICS BLOCK

GETK13:
	LDB	KT,KY.TYP	;GET KEY TYPE
;BL;  6 OUT, 33 IN AT GETK13+1 TO DISPLAY KEY DESCRIPTOR WITH /S
	JUMPN	KT,GETK16	;NUMERIC, GO CHECK SIGN
	TRNN	SW,OPT.S	;/S?
	  JRST	  GETK15	;  NO
	TYPE	(X)		;ALPHANUMERIC
	JRST	GETK17		;GO DISPLAY KEY POSITION
	;NUMERIC KEY
GETK16:	TLO	SW,(FNUM)	;SET FLAG
	LDB	TA,KY.SGN	;IS IT SIGNED
	SKIPN	TA		;NO, GO DISPLAY TYPE
	TLO	SW,(FSGND)	;YES
	TRNN	SW,OPT.S	;/S?
	  JRST	  GETK15	;  NO
	JUMPN	TA,CKPACK	;SKIP IF NO SIGN
	TYPE	(S)		;KEY IS SIGNED
CKPACK:	CAIG	KT,6		;PACKED?
	  JRST	  CKFLOT	;  NO
	TYPE	(P)
CKFLOT:	CAIG	KT,4		;FLOATING POINT?
	  JRST	  CKCOMP	;  NO
	TYPE	(F)
CKCOMP:	CAIG	KT,2		;COMP?
	  JRST	  NUMRIC	;  NO
	TYPE	(C)
	JRST	GETK17		;GO CHECK LENGTH
NUMRIC:	TYPE	(N)		;NUMERIC

GETK17:	HRRZ	TE,RECKEY	;GET RELATIVE BYTE POSITION
	AOS	TE		;+1 = ABSOLUTE POSITION
	PUSHJ	PP,PUTDEC	;SHOW IT
	TYPE	(.)
	LDB	TE,KY.SIZ	;GET KEY LENGTH
	PUSHJ	PP,PUTDEC	;SHOW IT
	TYPE	(
)				;NEW LINE

GETK15:	TRNE	SW,OPT.P	;IF /P, USE IM INSTEAD OF OM
	EXCH	IM,OM		;  DURING CALCULATION OF FRSTKB

	HRRZ	TD,RECKEY	;REL POSITION OF KEY IN RECORD
	IMUL	TD,BYTWRD(OM)	;TIMES # BYTES PER WORD
	LDB	TA,[POINT 6,RECKEY,5]	;PLUS EXTRA BYTES BEFORE KEY
	HRRZI	TE,^D36
	SUBI	TE,(TA)
	IDIV	TE,BYTSIZ(OM)		;DIVIDE BY BYTE SIZE
	ADDI	TD,(TE)
	MOVEM	TD,FRSTKB	;GIVES BYTE POSITION OF KEY IN REC

	TRNE	SW,OPT.P	;IF /P, RESTORE IM AND OM
	EXCH	IM,OM

	LDB	TE,KY.SIZ	;ADD SIZE OF KEY
	XCT	GETK12(KT)	;COMPUTE LAST BYTE
	MOVEM	TD,LASTKB

	TRNE	SW,OPT.M	;/M OR /P?
	JRST	GETK14		;/M: GO ON TO GET SIZE OF KEY IN WORDS

;/P: CREATE OUTPUT RECKEY OFFSET

	MOVE	TB,FRSTKB	;GET # OF BYTES BEFORE KEY
	IDIV	TB,BYTWRD(OM)	;Q= # OF OUTPUT WORDS BEFORE KEY
	MOVEM	TB,RECKEY
	MOVE	TA,BYTSIZ(OM)	;BYTE SIZE
	DPB	TA,[POINT 6,RECKEY,11]
	IMULI	TC,(TA)		;36-(R*(#BITS)) = # ODD BITS BEF. KEY
	MOVEI	TA,^D36
	SUBI	TA,(TC)
	DPB	TA,[POINT 6,RECKEY,5]
	JRST	GETK14

	SUBTTL	FORM AND WRITE LABELS FOR MAGTAPE

LABEL:	TRNN	SW, OPT.L	; NECCESSARY?
	POPJ	PP,
	TRNN	SW, OPT.P	; WRITE LABEL?
	JRST	LAB.1X		; NO - READ

	CAIN	OM,EB.MOD	;IS IT EBCDIC?
	JRST	EBLBER		;NO EBCDIC LABELS

	MOVE	TA, [XWD STDLBL, STDLBL+1]
	SETZM	STDLBL
	BLT	TA, STDLBL+14	; ZERO LABEL AREA

	MOVE	TA, [SIXBIT /  HDR1/]	; FIRST LABEL
	MOVE	TB, OF2DAT+FILNAM	; VALUE OF ID
	ROTC	TA, ^D12	; LEFT JUSTIFY
	MOVEM	TA, STDLBL
	MOVEM	TB, STDLBL+1
	SETZI	TA,
	MOVE	TB, OF2DAT+FILEXT	;
	ROTC	TA, ^D12
	ORM	TA, STDLBL+1	; ADD EXT
	MOVEM	TB, STDLBL+2

	MOVE	TB,OREENO	;STUFF IT
	PUSHJ	PP,CONREL	;CONVERT IT
	MOVEM	TB,OREENO	;REPLACE IT
	HLRZM	TB, STDLBL+4
	HRLZM	TB, STDLBL+5

	SETZB	TA, TB		; GET CREATION DATE OF INPUT FILE
	LDB	TC, [POINT 12, SA.CRE, 35]	; GET CREATION DATE OF IF1
	IDIVI	TC, ^D31
	AOJ	TD,		; GET DAY
	PUSHJ	PP, LAB.SX	; TURN TO SIXBIT AND ADD
	IDIVI	TC, ^D12	; MONTH
	AOJ	TD,
	PUSHJ	PP, LAB.SX	;
	ADDI	TC, ^D64	; BASE YEAR
	MOVEI	TD, (TC)
	PUSHJ	PP, LAB.SX
	MOVEM	TA, STDLBL+6
	MOVEM	TB, STDLBL+7	; SAVE DATE
LAB.0:	MOVE	TA, [POINT 6, STDLBL]
	MOVNI	TB, ^D80-2	; LENGTH OF LABEL (MINUS 2 FOR CR-LF)

LAB.1:	ILDB	CH, TA		; GET NEXT CHAR OF LBL
	TRNE	OM,AS.MOD	;[145] OUTPUT MODE ASCII?
	ADDI	CH,40		;[145] YES, CONVERT 6BIT TO ASCII
	PUSHJ	PP, PUTBYT
	AOJL	TB, LAB.1	; MORE

	TROE	SW, TEMP.	; DONE?
	JRST	LAB.2		; YES
	MOVNI	TB, 2
	CAIE	OM, AS.MOD	; ASCII?
	JRST	LAB.1
	MOVEI	CH, 15		; YES - PUT A CR-LF
	PUSHJ	PP, PUTBYT
	MOVEI	CH, 12
	PUSHJ	PP, PUTBYT

LAB.2:	TRZ	SW, TEMP.	; CLEAR
	JRST	WRITE		; WRITE IT AND DONE

CONREL:	ADD	TB,[OCT 464646470000]	;ADD ONE AND HANDLE CARRIES
	MOVE	TA,TB			;COPY INTO AC
	AND	TA,[OCT 606060600000]	;ISOLATE CARRY BITS
	LSH	TA,-3			;PUT THEM IN PLACE
	SUB	TB,TA			;FUDGE UP CARRIES
	AND	TB,[OCT 171717170000]	;NOW HAVE BINARY NUMBER
	IOR	TB,[OCT 202020200000]	;BACK TO SIXBIT
	POPJ	PP,			;SAY GOODBYE...
; WRITE TRAILING LABEL

TLABEL:	TRNE	SW,OPT.P	;PACKING?
	TRNN	SW,OPT.L	; WITH LABELS?
	POPJ	PP,		; NO - BACK
	MOVSI	TA, (SIXBIT /EOF/)
TLAB1:	HLLM	TA, STDLBL
	CLOSE	OF2,		; PUT OUT AN EOF (BEFORE TRAILER LABEL)
	STATZ	OF2, $ERA	; ERRORS?
	  JRST	DATERA
	JRST	LAB.0		; PUT TAIL LABEL AND DONE





VLABEL:	TRNN	SW,OPT.P		;WRITING LABELS?
	POPJ	PP,			;GO BACK
	MOVSI	TA, (SIXBIT "EOV")	;PUT OUT AN VOL
	JRST	TLAB1			;AND PROCEED WITH TRAILER
; READ STANDARD LABEL AND VERIFY NAME.

LAB.10:	AOS	IF1BUF+2	;BECAUSE INPUT ROUTINES DO SOSG NOT SOSGE
LAB.1X:
	;CHECK FOR EBCDIC
	CAIN	IM,EB.MOD
	JRST	EBLBER		;NO EBCDIC LABEL SUPPORT

	MOVNI	TA, ^D80-2	; NUMBER OF CHARS IN LABEL
	MOVMM	TA,INPSIZ	;[146] SAVE SIZE OF LABEL FOR GETSM
	MOVE	TB, [POINT 6, STDLBL]

LAB.11:	PUSHJ	PP, @GETBYT	; GET NEXT CHAR
	TLNE	SW, (FEOF)	; PRE-MATURE EOF?
	JRST	LBLEOF
	TLZE	SW, (FENDL)	; END OF LINE?
	JRST	LAB.12
	TRNE	IM,AS.MOD	; ASCII?
	LDB	CH,PTR%76##	;CONVERT IF NECESSARY
	IDPB	CH, TB		; ADD TO LABEL REC
	AOJL	TA, LAB.11	; MORE

LAB.12:	SETZM	IF1BUF+2	; CLEAR WD CNT
	MOVE	TA, STDLBL
	MOVE	TB, STDLBL+1
	ROTC	TA, -^D12
	SKIPN	,IF1DAT+FILNAM		;INPUT NAME GIVEN?
	MOVEM	TB,IF1DAT+FILNAM	; SET NAME IF NO
	CAME	TB, IF1DAT+FILNAM	; VALUE OF ID MATCH (NAME)?
	JRST	LBLERN
	MOVE	TA, STDLBL+1
	MOVE	TB, STDLBL+2
	ROTC	TA, -^D12
	SKIPN	,IF1DAT+FILEXT		; INPUT EXT GIVEN?
	MOVEM	TB,IF1DAT+FILEXT	; SET IT IF NO
	HLLZ	TA, IF1DAT+FILEXT
	CAME	TA, TB		; EXT MATCH?
	JRST	LBLERN

	POPJ	PP,		; DONE.

SUBTTL	SCAN COMMAND STRING FOR ONE FILE DESCRIPTOR

GETFIL:	SETZM	FILDAT		;CLEAR FILE
	MOVE	TE,[FILDAT,,FILDAT+1]	;  PARAMETER AREA
	BLT	TE,FILDAT+BUFADR-1

	PUSHJ	PP,GETSIX	;GET A WORD
	CAIE	CH,":"		;IS IT A DEVICE?
	JRST	GETFL1		;NO
	MOVEM	TE,DEV+FILDAT	;YES--SAVE IT
	PUSHJ	PP,GETSIX	;GET ANOTHER WORD

GETFL1:	MOVEM	TE,FILNAM+FILDAT	;SAVE FILE NAME
	CAIE	CH,"."		;IS THERE AN EXTENSION?
	JRST	GETFL2		;NO
	PUSHJ	PP,GETSIX	;YES--GET IT
	HLLZM	TE,FILEXT+FILDAT	;  AND SAVE IT
	AOS	FILEXT+FILDAT	;"." SEEN

GETFL2:	CAIN	CH,"/"		;SWITCH DELIMITER?
	JRST	GETFL3		;YES
	CAIE	CH,"["		;IS THERE A P-P NUMBER?
	POPJ	PP,		;NO--QUIT

	PUSHJ	PP,GETOCT	;YES--GET LEFT-HALF
	SKIPN	TE		; [143] IF ZERO
	HLRZ	TE,MYPPN	; [143] USE DEFAULT PROJ NUMBER
	MOVSM	TE,PPNUM+FILDAT
	CAIE	CH,","		;MUST TERMINATE WITH
	JRST	GETFL4		;  COMMA
	PUSHJ	PP,GETOCT	;GET RIGHT-HALF
	SKIPN	TE		; [143] IF ZERO
	HRRZ	TE,MYPPN	; [143] USE DEFAULT PROG NUMBER
	HRRM	TE,PPNUM+FILDAT
	CAIE	CH,"]"		;MUST TERMINATE WITH RIGHT-BRACKET
	JRST	GETFL4		;IT DIDN'T
GET.SW:	PUSHJ	PP,GETTY	;IS THERE A SWITCH?
GETSW0:	CAIE	CH,"/"
	POPJ	PP,		;NO

GETFL3:	PUSHJ	PP,GETTY	;GET SWITCH
	CAIE	CH,"B"
	JRST	.+3
	MOVEI	TA,OPT.B
	JRST	GETFL7
	CAIE	CH, "L"
	JRST	.+4
	SKIPN	AUTOLB		; DONT SET SW IF MONITOR DOES LABELING
	MOVEI	TA, OPT.L
	JRST	GETFL7
	CAIE	CH,"P"
	JRST	.+3
	MOVEI	TA,OPT.P
	JRST	GETFL7
	CAIE	CH,"M"
	JRST	.+3		;				[EDIT#107]
	MOVEI	TA,OPT.M	;				[EDIT#107]
	JRST	GETFL7		;				[EDIT#107]
	CAIE	CH,"R"		; IS IT RENAME?
	JRST	.+3		; NO
	MOVEI	TA,OPT.R	; YES, SET IT
	JRST	GETFL7		; CONT
	CAIE	CH,"C"		; IS IT CHECK?
	JRST	.+3		; NO
	MOVEI	TA,OPT.C	; YES, SET IT
	JRST	GETFL7		; CONT
IFN	$CU001,<		;MAKE ISAM MORE INTELLIGENT
	CAIE	CH,"S"		;CHECK FOR STATISTICS REQUEST
	JRST	.+3
	MOVEI	TA,OPT.S	;FLAG STAS WANTED
	JRST	GETFL7
	>;END OF IFN $CU001
	CAIE	CH,"I"		; IS THIS /I?			[EDIT#107]
	JRST	.+3		; NO,
	MOVEI	TA,OPT.I	; YES, SET IT			[EDIT#107]
	JRST	GETFL7		; CONT
IFN TOPS20,<			;CHECK PAGED OUTPUT SW
	CAIE	CH,"O"		; IS IT /O?
	JRST	CKADV		; NO, CHECK "ADVANCING"
	PUSHJ	PP,GETTY	; YES, GET ANOTHER CHAR
	CAIE	CH,":"		; COLON?
	JRST	GETFL6		; NO, ERROR
	PUSHJ	PP,GETTY	; YES, GET ANOTHER
	CAIE	CH,"N"		; "NEW"?
	JRST	.+3		; NO, CHECK FOR "OLD"
	MOVEI	TA,OPT.OP	; YES, SET IT
	JRST	GETFL7		; & CONTINUE
	CAIE	CH,"O"		; "OLD"?
	JRST	GETFL6		; NO, ERROR
	TRZ	SW,OPT.OP	; YES, RESET PAGE SW
	JRST	GET.SW		; GO GET NEXT SW
>				;END IFN TOPS20
CKADV:	CAIE	CH,"A"		; HOW ABOUT "ADV"?
	JRST	GETFL6		; NO, ERROR
	PUSHJ	PP,GETTY	;GET ANOTHER CHAR
	CAIE	CH,"D"		; "AD"?
	JRST	SWADV0		; NO, CHECK FOR :
	PUSHJ	PP,GETTY	; YEP, GET ANOTHER
	CAIE	CH,"V"		; "ADV"?
	JRST	SWADV0		; NO, CHECK FOR :
	
	; NOW CHECK FOR :, MUST BE THERE FOR /A(DV):68
	
	PUSHJ	PP,GETTY	; GET CHAR AFTER "ADV"
SWADV0:	CAIE	CH,":"		; IS IT COLON?
	JRST	GETFL6		; NO,ILLEGAL SWITCH
	PUSHJ	PP,GETSIX	; YES, GET A WORD OF SIXBIT
	CAMN	TE,[SIXBIT "6"]
	JRST	GETSW0		; DEFAULT IS CORRECT, NEXT
	CAMN	TE,[SIXBIT "68"]
	JRST	GETSW0		; DEFAULT IS CORRECT, NEXT
	CAMN	TE,[SIXBIT "B"]
	JRST	GETSW0		; DEFAULT IS CORRECT, NEXT
	CAMN	TE,[SIXBIT "BEFORE"]
	JRST	GETSW0		; DEFAULT IS CORRECT, NEXT
	CAMN	TE,[SIXBIT "A"]
	JRST	SWADV1		; GO SET ANS74 DEFAULT
	CAMN	TE,[SIXBIT "AFTER"]
	JRST	SWADV1		; GO SET ANS74 DEFAULT
	CAMN	TE,[SIXBIT "7"]
	JRST	SWADV1		; GO SET ANS74 DEFAULT
	CAME	TE,[SIXBIT "74"]
	JRST	GETFL6		; ERROR, ILLEGAL SWITCH
				; OK, CONT BELOW

	; HERE IF "AFTER" ADVANCING IS INDICATED

SWADV1:	MOVEI	TA,OPT.A7	; YES, INDICATE ANS74 STYLE
	TRO	SW,(TA)		; SET IT
	JRST	GETSW0		; CONT,DON'T GET ANOTHER CHAR

	
GETFL7:	TRO	SW,(TA)
	JRST	GET.SW		; AND TEST FOR ANOTHER SWITCH

GETFL6:	TYPE	(?Illegal switch
)
	JRST	GETFL8

GETFL4:	TYPE	(?Improper project programmer number
)
GETFL8:	TLO	SW,(FERROR)

GETFL5:	CAIE	CH,15
	CAIN	CH,"="
	POPJ	PP,

	PUSHJ	PP,GETTY
	JRST	GETFL5

SUBTTL	BUILD TWO MAG-TAPE BUFFERS OF NON-STANDARD SIZE

BLDBUF:	SKIPN	TE,INPBLK	;# RECORDS PER INPUT BLOCK SPECIFIED?
	JRST	BLDBF6		;NO -- USE STANDARD LENGTH BUFFERS

	;COMPUTE SIZE OF THE BUFFERS NEEDED AND REBUILD EXISTING ONES

	PUSHJ	PP,WDPBLK	;GET WORDS PER BLOCK IN TE

	ADDI	TE,1		;ONE FOR MONITOR OVERHEAD
	CAIGE	TE,^D21		;LEAVE ENOUGH ROOM FOR
	MOVEI	TE,^D21		;  LABELS
	HRRZ	TA,IF1BUF	;REBUILD
	TRNE	SW,OPT.P
	HRRZ	TA,OF2BUF

	MOVEI	TB,3(TA)	;  POINTER
	ADD	TB,TE		;  TO
	HRRM	TB,(TA)		;  NEXT BUFFER
	DPB	TE,[POINT 17,(TA),17]	;PUT IN SIZE OF BUFFER

	MOVEI	TD,2(TB)	;GET ENOUGH CORE FOR
	PUSHJ	PP,GETCOR	;  TWO BUFFERS

	MOVE	TD,.JBFF	;CLEAR
	MOVSI	TC,2(TA)	;  CORE
	HRRI	TC,3(TA)	;  THROUGH
	SETZM	2(TA)		;  BOTH
	BLT	TC,-1(TD)	;  BUFFERS

	MOVE	TC,-1(TA)	;CREATE
	MOVEM	TC,-1(TB)	;  NEW
	MOVE	TC,1(TA)	;  THREE-
	MOVEM	TC,1(TB)	;  WORD
	MOVE	TC,(TA)		;  BUFFER
	TRNE	SW,OPT.B
	HRR	TC,IF1BUF	;  HEADER
	TRNE	SW,OPT.P
	HRR	TC,OF2BUF
	MOVEM	TC,(TB)		;  *
	TRNN	SW,OPT.P	;DONT CLEAR IF /P		[EDIT#103]
	SETZM	INPBLK

BLDBF6:	;TAKE CARE OF INDUSTRY COMPATABLE MODE
	MOVEI	TE,IF1
	TRNE	SW,OPT.P
	MOVEI	TE,OF2
	MTCHR	TE,
	POPJ	PP,		;FORGET IT ON ERROR
	TRNE	TE,MT.7TR	;IS IT 9 TRACK?
	POPJ	PP,		;NO
	TRNE	SW,OPT.P
	JRST	BLDBF7
	CAIE	IM,EB.MOD	; IF NOT EBCDIC
	POPJ	PP,		; THEN NO IND-CMPTBL-MODE
	MTAPE	IF1,MTIND	;INDUSTRY COMPATABLE INPUT
	JRST	BLDBF8		; FINISH UP
BLDBF7:	CAIE	OM,EB.MOD	; NO INDUSTRY COMPATIBLE MODE
	POPJ	PP,		; IF NOT AN EBCDIC FILE
	MTAPE	OF2,MTIND	;INDUSTRY COMPATABLE OUTPUT
BLDBF8:	MOVEI	TE,^D8		;CHANGE BYTE SIZE TO 8
	MOVEI	TF,IF1BUF
	TRNE	SW,OPT.P
	MOVEI	TF,OF2BUF
	DPB	TE,[POINT 6,1(TF),11]
	TLO	SW,(FINDCP)	;SET INDUSTRY COMPATABLE FLAG
	POPJ	PP,
SUBTTL	ERROR ROUTINES

;ENTER FAILURE
ENTRFA:	TYPE	(?ENTER )
	TDNA			; SKIP
RENAMA:	TYPE	(?RENAME )
	TYPE	( failure on )
	MOVE	TE,DEV+OF1DAT		;[ED#113]
	PUSHJ	PP,PUTSIX
	TYPE	(:)
	MOVE	TE,FILNAM+OF1DAT	;[ED#113]
	PUSHJ	PP,PUTSIX
	HLLZ	TE,FILEXT+OF1DAT	;[ED#113]
	JUMPE	TE,ENTRF1
	TYPE	(.)
	PUSHJ	PP,PUTSIX
; INSERTED 11 INSTRUCTIONS EDIT 113
	JUMPA	ENTRF1			;[ED#113]

ENTRFB:	TYPE	(?ENTER )
	JRST	RNAMB1
RENAMB:	TYPE	(?RENAME )
RNAMB1:	TYPE	(failure on )
	MOVE	TE,DEV+OF2DAT		;[ED#113]
	PUSHJ	PP,PUTSIX		;[ED#113]
	TYPE	(:)			;[ED#113]
	MOVE	TE,FILNAM+OF2DAT	;[ED#113]
	PUSHJ	PP,PUTSIX		;[ED#113]
	HLLZ	TE,FILEXT+OF2DAT	;[ED#113]	
	JUMPE	TE,ENTRF1		;[ED#113]
	TYPE	(.)			;[ED#113]
	PUSHJ	PP,PUTSIX		;[ED#113]

ENTRF1:	TYPE	( -- )
	TYPE	(<(>)		;TYPE LEFT PAREN
	JRST	LOOKF1

;LOOKUP FAILURE

LOOKF:	TYPE	(?Lookup failure on input file -- )
	TYPE	(<(>)		;TYPE LEFT PAREN
	TRNE	TB,-1		;IS IT CODE ZERO?
	JRST	LOOKF1		;NO
	TYPE	(0)
	HRRI	TB,-1
	JRST	LOOKF2

LOOKF1:	MOVEI	TE,(TB)
	PUSHJ	PP,PUTOCT

LOOKF2:	MOVE	TE,[XWD -LISTSZ,ERALST]

LOOKF3:	HLRZ	TF,(TE)
	CAIE	TF,(TB)
	AOBJN	TE,LOOKF3

	MOVE	TF,(TE)
	TYPEA	((TF))
	TYPE	(
)
	TLO	SW,(FERROR)
	POPJ	PP,

	; TYINF1 IS A ROUTINE TO TYPE THE PRIMARY INPUT FILE NAME

TYINF1:	MOVE	TE,DEV+IF1DAT		; GET PRIMARY INPUT DEVICE NAME
	PUSHJ	PP,PUTSIX		; PRINT IT
	TYPE	(:) 
	MOVE	TE,FILNAM+IF1DAT	; GET PRIMARY INPUT FILE NAME
	PUSHJ	PP,PUTSIX		; PRINT IT
	HLLZ	TE,FILEXT+IF1DAT	; GET PRIMARY INPUT EXTENSION
	JUMPE	TE,CPOPJ		; EXIT IF NO EXTENSION
	TYPE	(.) 
	JRST	PUTSIX			; PRINT IT AND RETURN

	; TYINF2 IS A ROUTINE TO TYPE THE SECONDARY INPUT FILE NAME

TYINF2:	MOVE	TE,DEV+IF2DAT		; GET SECONDARY INPUT DEVICE NAME
	PUSHJ	PP,PUTSIX		; PRINT IT
	TYPE	(:) 
	MOVE	TE,FILNAM+IF2DAT	; GET SECONDARY INPUT FILE NAME
	PUSHJ	PP,PUTSIX		; PRINT IT
	HLLZ	TE,FILEXT+IF2DAT	; GET SECONDARY INPUT EXTENSION
	JUMPE	TE,CPOPJ		; EXIT IF NO EXTENSION
	TYPE	(.) 
	JRST	PUTSIX			; PRINT IT AND RETURN
;TABLE OF ERROR MESSAGE FOR LOOKUP/ENTER FAILURES

ERALST:	XWD	-1,[ASCIZ ") file not found"]
	XWD	0,[ASCIZ ") illegal file name"]
	XWD	1,[ASCIZ ") UFD doesn't exist"]
	XWD	2,[ASCIZ ") protection failure"]
	XWD	3,[ASCIZ ") file being modified"]
	XWD	6,[ASCIZ ") bad UFD or bad RIB"]
	XWD	14,[ASCIZ ") device full, or quota exceeded"]
	XWD	15,[ASCIZ ") device is write-locked"]
	XWD	16,[ASCIZ ") not enough monitor table space"]
	XWD	17,[ASCIZ ") Partial allocation only."]
	XWD	0,[ASCIZ ") unknown error"]

LISTSZ==.-ERALST-1

ILLDEV:	TYPE	(?Device must be an OUTPUT or I/O device
)
BADCOM:	TYPE	(?Improper command string
)
	PUSHJ	PP,SKPTTY
	JRST	START

BADDEV:	TYPE	(?Indexed file devices must be disks
)
	JRST	START

CANTOP:	TLO	SW,(FERROR)
	TYPE	(?Cannot open device )
	MOVE	TE,TB
	PUSHJ	PP,PUTSIX
	TYPE	(:
)
	POPJ	PP,
BADKEY:	TYPE	(?Improper key descriptor
)
	PUSHJ	PP,SKPTTY
	JRST	GETKEY

BIGLVL:	TYPE	(?More than 10 levels of index required
)
	JRST	START

NOCORE:	TYPE	(?Not enough memory to complete the job
)
	JRST	START

CMDINC:	TYPE	(?EOF on command file - command incomplete
)			;[EDIT#140]
	JRST	START	;[EDIT#140]

REDERA:	TYPE	(?Error reading input file
)
	MOVEI	TB,IF1		;SAVE THE CHANNEL
	JRST	LTCTST		;CHECK FOR MORE ERRORS

DATERA:	TYPE	(?Error writing Data file
)
	MOVEI	TB,OF2		;SAVE THE CHANNEL
	JRST	LTCTST		;CHECK FOR MORE ERRORS

IDXERA:	TYPE	(?Error writing Index file
)
	MOVEI	TB,OF1		;SAVE THE CHANNEL
	JRST	LTCTST		;CHECK FOR MORE ERRORS

STATER:	TYPE	(?Error reading Index file
)
	MOVEI	TB,IF1		;SAVE THE CHANNEL
	JRST	LTCTST		;CHECK FOR MORE ERRORS

SIZERR:	TYPE	(?Record size must be less than 4096
)
	JRST	ASKM5

BIGKEY:	TYPE	(?Key is outside the maximum record
)
	JRST	ASKM8

TOOMCH:	TYPE	(?Must be less than records per block
)
	JRST	ASKM13

BIGIDX:	ADDI	TE,5		;CONVERT TO
	IDIVI	TE,6		;  WORDS
	TYPE	(?Index block contains )
	PUSHJ	PP,PUTDEC
	TYPE	( words, must be less than 683.
reduce the number of entries per index block.

)
	JRST	ASKM15

TOOFEW:	TYPE	(?Must have at least two full entries per block
)
	JRST	ASKM15

DATERR:	TYPE	(?Error reading Data file
)
	MOVEI	TB,IF2		;SAVE THE CHANNEL
	JRST	LTCTST		;CHECK FOR MORE ERRORS

CMDERR:	TYPE	(?Cannot open command file
)
	JRST	START

CMDLER:	PUSHJ	PP,LOOKF
	JRST	START

CMDRER:	TYPE	(?Error reading command file
)
	MOVEI	TB,CMD		;SAVE THE CHANNEL
	JRST	LTCTST		;CHECK FOR MORE ERRORS

RECERR:	TYPE	(?Actual size of ISAM Data record )	;[EDIT#141]
	MOVE	TE,INPSIZ	;	[EDIT#141]
	PUSHJ	PP,PUTDEC	;	[EDIT#141]
	TYPE	( >ISAM maximum record size parameter ) ;[EDIT#141]
	MOVE	TE,RECBYT+I	;	[EDIT#141]
	PUSHJ	PP,PUTDEC	;	[EDIT#141]
	JRST	START		;	[EDIT#141]

DBLIND:	TYPE	(?Double indirect command
)
	JRST	START

ERR%DA:	TYPE	(?Invalid percentage
)
	JRST	ASKM18

ERR%IX:	TYPE	(?Invalid percentage
)
	JRST	ASKM19

LBLERR:	TYPE	(? Label option only applicable with build or pack for mag-tape
)
	JRST	START

LBLEOF:	TYPE	(Pre-mature EOF (within label) on MTA
)

LBLCLR:	POP	PP, TA		; DON'T CLOG PDL
	JRST	START

LBLERN:	TYPE	(? File name does not match label id
)
	JRST	LBLCLR
EBLBER:	TYPE	(?ISMLET labeled EBCDIC tapes are not supported
)
	JRST	START

TFCERR:	TYPE	(?ISMTPC TAPOP. failed, cannot set STANDARD-ASCII mode
)
	JRST	START

ERMVAS:	TYPE	(?ISMSAM STANDARD-ASCII mode requires TU70 magnetic tape drives 
)
	JRST	START

IVKERR:	TYPE	(?ISMIVK invalid key type with respect to input/output mode
)
	JRST	START

RTSERR:	PUSHJ	PP,CAMD
	TYPE	(ISMRTS record too short to contain key field
)
	TRNN	SW,OPT.I+OPT.C	;  /IGNORE OR /CHECK CONTINUE?
	JRST	START		; NOP, ERROR RESTART
	PUSHJ	PP,DTBLK	; YEP,PRINT DATA BLK WE ARE IN
	JRST	CAMK1		; AND CONT FOR MORE

INTERR:	TYPE	(?ISMITE internal ISAM error - submit SPR
)
	JRST	START

EBBHER:	TYPE	(?ISMEBH EBCDIC block header count less than 4
)
	JRST	START

EBRHER:	TYPE	(?ISMERH EBCDIC record header exceeds block size
)
	JRST	START

CFKYER:	TYPE	(?ISMCFE COMP and COMP-1 keys must begin on word boundries
)
	JRST	START
TFUERR:	TYPE	(?ISMTFU TAPOP. failed - unable to set label type
)
	JRST	START

LTCTST:	MOVE	TC,[GETSTS TC]	; SEE IF ALL THE ERROR BITS ARE ON
	DPB	TB,[POINT 4,TC,12]; LOAD THE CHANNEL FIELD
	XCT	TC		; GET THE ERROR BITS
	TRC	TC,$ERA		;
	TRCE	TC,$ERA		; IS THIS A MTA LABEL PROCESSING ERROR?
	JRST	START		; NO

	MOVEI	TA,.DFRES	;[161] RETURN ERROR CODE
	MOVE	TD,[3,,TA]	; LEN,,LOC OF ARG BLOCK
	DEVOP.	TD,		;[161] GET IT
	  SETZ	TD,		; "ERROR" GETTING ERROR CODE!
	TYPE	( monitor label processing failed
)
	LSH	TD,1		;INDEX X 2 (MACROS USE 2 WORDS)
	SKIPE	TD		;CONTINUE IF INDEX=0
	ADDI	TD,-1		;CORRECT INDEX
	XCT	@LTCTBL(TD)	;[161] DECODE THE CODE
	JRST	START

;[161] PUT ALL THE "ASCIZ /XXX/" ITEMS INSIDE LITERAL BRACKETS
;[161] ALSO CHANGE ERROR MESSAGES TO WORK FOR DEVOP. RATHER THAN TAPOP.

LTCTBL:	TYPE	(DEVOP. failed while getting error code!)
	TYPE	(Code 1)
	TYPE	(Code 2)
	TYPE	(Label type error)
	TYPE	(Header label error)
	TYPE	(Trailer label error)
	TYPE	(Volume label error)
	TYPE	(Hard device error)
	TYPE	(Parity error)
	TYPE	(Write-lock error)
	TYPE	(Illegal positioning operation)
SUBTTL	MISCELLANEOUS ROUTINES

;TYPE OUT A WORD OF SIXBIT DATA

PUTSIX:	MOVE	TF,[POINT 6,TE]
PUTSX1:	ILDB	CH,TF
	JUMPE	CH,PUTSX9
	ADDI	CH,40
	TYPEC	CH
	TLNE	TF,770000
	JRST	PUTSX1
PUTSX9:	POPJ	PP,

;TYPE OUT A WORD OF OCTAL DATA

PUTOCT:	MOVE	TF,[POINT 3,TE]
PUTOC1:	ILDB	CH,TF
	JUMPN	CH,PUTOC2
	TLNE	TF,770000
	JRST	PUTOC1

PUTOC2:	ADDI	CH,"0"
	TYPEC	CH
	TLNN	TF,770000
	POPJ	PP,
PUTOC3:	ILDB	CH,TF
	JRST	PUTOC2

; TYPE OUT DECIMAL NUMBER WITH DECIMAL POINT

PUTPNT:	PUSHJ	PP,PUTDEC	; WRITE THE DECIMAL DIGITS
	TYPE	(.)
	POPJ	PP,

;TYPE OUT A SIGNED DECIMAL NUMBER, REMOVING LEADING ZEROES

PUTDEC:	JUMPGE	TE,PUTDC1	;IF NEGATIVE,
	TYPE	(-)		;  TYPE SIGNED AND
	MOVMS	TE		;  GET MAGNITUDE

PUTDC1:	IDIVI	TE,^D10
	HRLM	TF,(PP)
	SKIPE	TE
	PUSHJ	PP,PUTDC1

	HLRZ	CH,(PP)
	ADDI	CH,"0"
	TYPEC	CH
	POPJ	PP,

;TYPE OUT AN UNSIGNED DECIMAL NUMBER, WITHOUT SUPPRESSING LEADING ZEROES

PUTDC2:	MOVEI	TD,^D10
PUTDC3:	IDIVI	TE,^D10
	HRLM	TF,(PP)
	SOSLE	TD
	PUSHJ	PP,PUTDC3
	HLRZ	CH,(PP)
	ADDI	CH,"0"
	TYPEC	(CH)
	POPJ	PP,

;PRINT DECIMAL NUMBER IN TE IF /M IS IN EFFECT

MCUR:	TLNE	SW,(INDIR)	;IF INDIR COMMANDS, DO NOTHING
	POPJ	PP,

	TRNN	SW,OPT.M
	JRST	MCUR1
	TYPE	( )
	TYPE	(<(>)		;TYPE LEFT PAREN
	PUSHJ	PP,PUTDEC
	TYPE	(<)>)		;TYPE RIGHT PAREN
MCUR1:	TYPE	(: )
	POPJ	PP,
;GET A CHARACTER FROM TTY

GETTY:	SKIPE	CH,TTYKAR	;IF ONE WAITING, USE IT
	JRST	GETTY2

	TLNE	SW,(INDIR)	;INDIRECT COMMANDS?
	JRST	GETCMD		;YES	[EDIT#140]

	INCHWL	CH		;NONE-WAITING--GET IT FROM TTY

GETTY2:	SETZM	TTYKAR

	CAIE	CH,175		;ALTMODES ARE NO LONGER LEGAL
	CAIN	CH,176		; BREAK CHARACTERS.
	JRST	BADCHR
	CAIE	CH,33
	CAIN	CH,"_"		;ALSO, BACK ARROW IS NO LONGER A 
	JRST	BADCHR		; LEGAL SUBSTITUTE FOR "=".


	CAIG	CH,40
	JRST	GETTY1
	CAIGE	CH,"A"+40
	POPJ	PP,

	CAIG	CH,"Z"+40
	SUBI	CH,40
	POPJ	PP,


GETTY1:	JUMPE	CH,GETTY
	CAIE	CH,40		;IGNORE SPACES & TABS
	CAIN	CH,11
	JRST	GETTY
	CAIN	CH,15
	JRST	GETTY
	CAILE	CH,11
	CAILE	CH,14
	POPJ	PP,
	MOVEI	CH,15
	POPJ	PP,

BADCHR:	TYPE	(?Illegal character in command string
)
	JRST	START		;RESTART.

;GET A CHARACTER FROM INDIRECT COMMAND FILE

GETCMD:	TLNE	SW,(FCEOF)	;END OF CMD?	[EDIT#140]
	JRST	GETEOF		;		[EDIT#140]
GETIND:	SOSGE	CMDBUF+2
	JRST	GETIN2

	ILDB	CH,CMDBUF+1
	JUMPE	CH,GETIND
	JRST	GETTY2

GETIN2:	IN	CMD,
	  JRST	GETIND
	TLO	SW,(FCEOF)	;CMDEOF		[EDIT#140]
	STATZ	CMD,$ERA	;INPUT ERROR	[EDIT#140]
	  JRST	CMDRER
GETEOF:	TLNN	SW,(FCEOFK)	;EOF OK				[EDIT#140]
	JRST	CMDINC		;NO, INFO MUST BE SUPPLIED	[EDIT#140]
	MOVEI	CH,15		;SET EOL CONDITION		[EDIT#140]
	POPJ	PP,		;RETURN				[EDIT#140]
;GET A WORD OF SIXBIT CHARACTERS

GETSIX:	MOVE	TF,[POINT 6,TE]
	MOVEI	TE,0

GETSX1:	PUSHJ	PP,GETTY	;GET A CHARACTER
	CAIL	CH,"0"		;IF
	CAILE	CH,"Z"		;  NOT
	POPJ	PP,		;  LETTER
	CAIG	CH,"9"		;  OR
	JRST	GETSX2		;  DIGIT,
	CAIGE	CH,"A"		;  THEN
	POPJ	PP,		;  QUIT

GETSX2:	SUBI	CH,40		;CONVERT TO SIXBIT
	TLNE	TF,770000	;IF WORD NOT FULL,
	IDPB	CH,TF		;  STASH CHARACTER IN WORD
	JRST	GETSX1		;LOOP

;GET A POSITIVE NUMBER FROM TTY

GETPOS:	PUSHJ	PP,GETDEC	;GET A DECIMAL NUMBER
	POPJ	PP,		;ERROR--RETURN
	SKIPN	TE		;IS IT ZERO?
	JRST	POSERR		; YES, PUT ERROR MESSAGE
	AOS	(PP)		;NO--SKIP RETURN
	POPJ	PP,
POSERR:	TYPE	(?Positive number required
)
	POPJ	PP,

;GET A DECIMAL NUMBER FOLLOWED BY A CARRIAGE-RETURN

GETNUM:	PUSHJ	PP,GETDEC	;GET DECIMAL NUMBER
	JRST	SKPTTY		;TROUBLE
	CAIE	CH,15		;FOLLOWED BY CARRIAGE-RETURN?
	JRST	GETDC8		;NO--TROUBLE
	AOS	(PP)		;YES--SKIP RETURN
	POPJ	PP,		;RETURN

;GET A DECIMAL NUMBER FROM TTY

GETDEC:	MOVEI	TE,0
	TLZ	SW,(FGETDC)	;CLR ACTUAL NUMBER SEEN FLAG
	AOS	(PP)		;ASSUME NO ERRORS, SO SKIP RETURN

GETDC1:	PUSHJ	PP,GETTY
	CAIL	CH,"0"		;IS IT A
	CAILE	CH,"9"		;  DIGIT?
	POPJ	PP,		;NO

	TLO	SW,(FGETDC)	;DIGIT SEEN
	JOV	.+1		;CLEAR OVERFLOW FLAG
	IMULI	TE,^D10
	ADDI	TE,-"0"(CH)
	JOV	GETDC8		;IF OVERFLOW--ERROR
	JRST	GETDC1		;LOOP

GETDC8:	TYPE	(?Bad decimal number
)
	SOS	(PP)		;REMOVE THE SKIP
	JRST	SKPTTY

;GET AN OCTAL NUMBER FROM THE TTY

GETOCT:	MOVEI	TE,0

GETOC1:	PUSHJ	PP,GETTY	;GET A CHARACTER
	CAIL	CH,"0"		;IF NOT
	CAILE	CH,"7"		;  OCTAL DIGIT,
	POPJ	PP,		;  RETURN

	LSH	TE,3
	IORI	TE,-"0"(CH)
	TLNN	TE,-1		;IF MORE THAN
	JRST	GETOC1		;  HALF-WORD,
	POPJ	PP,		;  RETURN

;GET MODE OF A FILE

	; GETMOD	Get mode of input/output file.
	; Returns:	
	;
	;	SKIP-	TB=	SX.MOD==0	;SIXBIT
	;			EB.MOD==1	;EBCDIC
	;			AS.MOD==2	;ASCII
	;			MA.MOD==3	;35 BIT ASCII TAPE I/O
	;			-1		IF JUST CRLF RESPONSE
	;
	;		TE=	WORD OF SIXBIT RESPONSE
	;
	;
	;	NONSKIP-	ERROR RESPONSE


GETMOD:	PUSHJ	PP,GETSIX	;GET A WORD
	CAIE	CH,15		;IF IT DIDN'T TERMINATE WITH <C.R.>
	JRST	GETMD1		;  ERROR

	; IF JUST A CRLF, GIVE VALID RETURN, BUT WITH TB=-1

	MOVNI	TB,1		; INITIALIZE MODE
	JUMPE	TE,GETMDX	; EXIT NOW IF NO INPUT BUT CRLF

	CAMN	TE,[SIXBIT "A"]
	MOVEI	TB,AS.MOD
	CAMN	TE,[SIXBIT "S"]
	MOVEI	TB,SX.MOD
	CAMN	TE,[SIXBIT "ASCII"]
	MOVEI	TB,AS.MOD
	CAMN	TE,[SIXBIT "SIXBIT"]
	MOVEI	TB,SX.MOD
	CAMN	TE,[SIXBIT "ST"]
	MOVEI	TB,MA.MOD
	CAMN	TE,[SIXBIT "STANDA"]
	MOVEI	TB,MA.MOD
	CAMN	TE,[SIXBIT "F"]
	MOVEI	TB,EB.MOD
	CAMN	TE,[SIXBIT "FIXED"]
	MOVEI	TB,EB.MOD
	CAMN	TE,[SIXBIT "VARIAB"]
	JRST	.+3
	CAME	TE,[SIXBIT "V"]
	JRST	.+3
	MOVEI	TB,EB.MOD
	TLO	SW,(FEBVAR)	;NOTE VARIABLE LENGTH

	JUMPL	TB,GETMD1
GETMDX:	AOS	(PP)
	POPJ	PP,

GETMD1:	TYPE	(?Improper mode
)

SKPTTY:	TLO	SW,(FERROR)
SKPTT1:	CAIN	CH,15
	POPJ	PP,
	PUSHJ	PP,GETTY
	JRST	SKPTT1
;GET A BLOCK OF FREE CORE FOR INDEX AND CLEAR IT

GETLVL:	MOVE	TE,IDXSEC	;NUMBER OF WORDS =
	LSH	TE,7		;  NUMBER OF SECTORS * 128

	HRRZ	TD,.JBFF	;GET CURRENT JOBFF
	AOS	TA,LEVELS	;BUMP NUMBER OF LEVELS
	CAILE	TA,^D10		;IF MORE THAN 10,
	JRST	BIGLVL		;  TOO BAD

	MOVEM	TD,IDXLOC-1(TA)	;SAVE LOCATION OF FREE SPACE
	PUSHJ	PP,GETCOR	;RESET JOBFF

CLRIDX:	MOVE	TD,IDXSEC	;COMPUTE
	LSH	TD,7		;  END OF
	ADD	TD,IDXLOC-1(TA)	;  INDEX CORE AREA
	MOVE	TE,IDXLOC-1(TA)	;CLEAR
	SETZM	0(TE)		;  AREA
	HRLS	TE		;  TO
	HRRI	TE,1(TE)	;  ZEROES
	BLT	TE,-1(TD)	;  *

	MOVE	TD,IDXLOC-1(TA)	;SET ADDRESS FOR FIRST ENTRY
	ADDI	TD,2
	MOVEM	TD,IDXWRD-1(TA)
	POPJ	PP,

GETCOR:	ADD	TD,TE		;COMPUTE NEW JOBFF
	HRRM	TD,.JBFF	;SET NEW JOBFF VALUE

	MOVEI	TE,(TD)		;IF
	CAMG	TE,.JBREL##	;  WE ARE
	POPJ	PP,		;  OVER JOBREL,
	IORI	TE,1777		;  GET
	CALLI	TE,$CORE	;  MORE CORE
	JRST	NOCORE		;NOT ENOUGH CORE, TROUBLE

	POPJ	PP,

;WRITE OUT AN INDEX BLOCK


;WRITE OUT FROM LEVEL 1

RITID1:	MOVEI	TA,1
	MOVE	TB,IDXLOC
	MOVE	TE,STHDR
	JRST	RITID2

;WRITE OUT FROM ANY LEVEL

RITIDX:	MOVE	TB,IDXLOC-1(TA)	;GET ADDRESS OF BLOCK
	MOVE	TE,STHDR	;GET SIZE OF BLOCK IN BYTES
	HRLI	TE,-1(TA)	;MAKE VISIBLE IDX LEVEL = 0-9 INSTEAD OF 1-10
RITID2:	MOVEM	TE,(TB)		;PUT THAT IN BLOCK

	MOVE	TE,IDXSEC	;COMPUTE SIZE OF BLOCK
	LSH	TE,7
	MOVNS	TE		;BUILD
	HRL	TB,TE		;  OUTPUT DUMP POINTER
	SUBI	TB,1
	MOVEM	TB,OUTLST
	SETZM	OUTLST+1

	MOVE	TE,IDXSEC	;UPDATE
	ADDM	TE,FEISEC	;  FIRST FREE SECTOR

	OUT	OF1,OUTLST	;WRITE OUT BLOCK
	  AOS	IDXOUT		;OK, BUMP 'NUMBER OF INDEX BLOCKS WRITTEN'
	SETZM	IDXEIB-1(TA)	;CLEAR 'NUMBER OF ENTRIES IN BLOCK'
	JRST	CLRIDX		;CLEAR THE BLOCK AND RETURN
;GET AN INPUT CHARACTER FROM ASCII FILE

GETAM:	TLNE	SW,(FENDL!FENDIB)	;ANYTHING SPECIAL GOING ON?
	JRST	GETAM5		;YES

GETAM2:	SOSG	IF1BUF+2
	PUSHJ	PP,READ		;GET ANOTHER BUFFER
	TLNE	SW,(FENDIB)	;AT END OF BLOCK?
	POPJ	PP,		;YES--QUIT
	ILDB	CH,IF1BUF+1	;GET A CHARACTER FROM INPUT FILE
	JUMPE	CH,GETAM	;IGNORE NULLS
IFN DEBUG,<
	SKIPE	DBUGIT
	PUSHJ	PP,TRACSZ	;DISPLAY RECORD SIZE
	SKIPE	DBUGIT
	PUSHJ	PP,TRACH	;DISPLAY CHARACTER
>


GETAM3:	CAIL	CH,12		;ANY
	CAILE	CH,24		;  SPECIAL PROCESSING?
	JRST	GETA3A		;NO

	CAILE	CH,15		;MAYBE
	CAIL	CH,20
	JRST	GETAM4		;YES

GETA3A:	TLZ	SW,(FENDL)	;NO--CLEAR 'END-OF-LINE'
	TRZE	SW,ONEBYT	;ONE-BYTE-ONLY?
	POPJ	PP,		; YES, RETURN
	LDB	CH,CONVRT	;CONVERT CHARACTER IF NECESSARY
	CAMGE	OC,RECBYT	;IF STILL ROOM IN RECORD,
	IDPB	CH,OP		;  STASH CHARACTER IN RECORD
	AOS	OC		;COUNT CHARACTER
	CAIN	IM,MA.MOD	;INPUT STANDARD ASCII?
	JRST	[CAML	OC,RECBYT	;YES, END OF REC?
		JRST	GETAM4	]	; YES, SET FLAG & RETURN
	JRST	GETAM		;GO GET NEXT BYTE

GETAM4:	TLOA	SW,(FENDL)	;IT IS END-OF-LINE
GETAM5:	TLNE	SW,(FENDIB)	;IF END-OF-BLOCK
	POPJ	PP,		;  RETURN
	PUSHJ	PP,GETAM2	;GRAB A CHARACTER
	TLNE	SW,(FENDL)	;STILL END-OF-LINE?
	JRST	GETAM5		;YES--LOOP
	POPJ	PP,		;NO--RETURN
;GET A BYTE FROM SIXBIT INPUT FILE


GETSM:	SKIPG	INPSIZ		;ANYTHING LEFT IN RECORD?
	JRST	GETSM1		;NO

	SOSG	IF1BUF+2	;YES--IF BUFFER IS EMPTY,
	PUSHJ	PP,READ		;  GET ANOTHER BUFFER

	TLNE	SW,(FENDIB)	;DID WE HIT END-OF-BLOCK?
	POPJ	PP,		; YES..RETURN
	ILDB	CH,IF1BUF+1	;NO--PICK UP BYTE
IFN DEBUG,<
	SKIPE	DBUGIT
	PUSHJ	PP,TRACSZ	;DISPLAY RECORD SIZE
	SKIPE	DBUGIT
	PUSHJ	PP,TRACH	;DISPLAY CHARACTER
>
	TRZE	SW,ONEBYT	;REQUEST ONE-BYTE-ONLY?
	JRST	[SOS	INPSIZ		; YES, COUNT ONE BYTE
		POPJ	PP,]		; & RETURN
	LDB	CH,CONVRT	;CONVERT IF REQUIRED
	CAMGE	OC,RECBYT	;RECORD FULL?
	IDPB	CH,OP		; NO..BYTE TO RECORD
	ADDI	OC,1		;COUNT BYTE
	SOSLE	INPSIZ		;END OF REC?
	JRST	GETSM		; NO, GET NEXT BYTE


GETSM1:	TLO	SW,(FENDL)	;SET END-OF-LINE

GETSM2:	MOVE	CH,IF1BUF+1
	TLNN	CH,770000
	POPJ	PP,
	SOS	IF1BUF+2
	IBP	IF1BUF+1
	JRST	GETSM2



GTDAT0:	LDB	CH,CONVRT	;CONVERT IF REQUIRED
	CAMGE	OC,RECBYT	;RECORD FULL?
	IDPB	CH,OP		; NO, PUT BYTE TO RECORD
	ADDI	OC,1		;COUNT BYTE

GETDAT:	SKIPG	INPSIZ		;ANY LEFT?
	JRST	GETDA1		;NO

	ILDB	CH,INPTR	;YES, GET ONE
IFN DEBUG,<
	SKIPE	DBUGIT
	PUSHJ	PP,TRACSZ	;DISPLAY RECORD SIZE
	SKIPE	DBUGIT
	PUSHJ	PP,TRACH	;DISPLAY CHARACTER
>
	TRZE	SW,ONEBYT	;REQUEST ONE BYTE?
	JRST	[SOS	INPSIZ		;DECREMENT INPUT COUNT
		POPJ	PP,	]	; & RETURN
	SOS	INPSIZ
	JRST	GTDAT0		; GET REST OF REC

GETDA1:	TLO	SW,(FENDL)	;END OF LINE
	CAIE	IM,AS.MOD	;ASCII?
	POPJ	PP,
	IBP	INPTR		;SKIP CRLF
	IBP	INPTR
	POPJ	PP,

; GET A BYTE FROM EBCDIC FIXED INPUT FILE
;NEED ANOTHER BUFFER

READ:	AOS	CH,ISECC
	SKIPE	INPBLK		;IS INPUT BLOCKED?
	JRST	READ2		;YES
READ1:	IN	IF1,		;NO
	  POPJ	PP,

	STATZ	IF1,$ERA	;IS IT AN ERROR?
	  JRST	REDERA		;YES
	TLNE	SW,(FDSK)	;TEST FOR DSK
	JRST	READ5		;SINCE NUL: HAS BOTH DSK AND MTA BITS SET
	TLNE	SW,(FMTA)		;MAGTAPE?
	JRST	READ4			;TELL HIM ABOUT IT
READ5:	TLO	SW,(FEOF!FENDIB!FENDL)	;NO--END-OF-FILE
	JRST	READ3

READ2:	TLNE	SW,(FDSK)	;NO--IS INPUT FROM DISK?
	CAMG	CH,INPSEC	;YES--HAVE WE READ ENOUGH SECTORS?
	JRST	READ1		;NO
	TLO	SW,(FENDIB!FENDL)	;NO--END-OF-LINE AND END-OF-BLOCK

READ3:	MOVEI	CH,0
	POPJ	PP,
READ4:	TRNN	SW,OPT.L		;LABELS?
	JRST	READ5			;NOPE
	CLOSE	3,			;RESET EOF STUFF
	IN	IF1,			;INPUT TRAILER
	  JRST	READ6			;LOOKS GOOD
	STATZ	IF1,$ERA		;LOOKS BAD CHECK ERRORS
	  JRST	REDERA			;ERROR!!
	JRST	READ5			;EOF---TWO IN A ROW
					;ASSUME END OF FILE
READ6:	MOVE	CH,INPSIZ		;GET CURRENT CHAR COUNT
	MOVEM	CH,SIZSAV		;SAVE IT
	PUSHJ	PP,LAB.10		;CHECK LABEL AND CONVERT ASCII
					;TO SIXBIT IF NECESSARY
	LDB	CH,[POINT 24,STDLBL,23]
	CAMN	CH,[SIXBIT "  EOF1"]	;WAS IT EOF TRAILER?
	JRST	READ5			;YES--END OF FILE
	CAMN	CH,[SIXBIT "  HDR1"]	;WAS IT A HEADER?
	JRST	[TYPE	("%Header as trailer?, assuming end-of-file")
		JRST READ5]
	CAME	CH,[SIXBIT "  EOV1"]	;WAS IT VOLUME TRAILER?
	JRST	[TYPE	("%Illegal trailer record, assuming end-of-file")
		JRST READ5]
	SKIPN	AUTOLB			;MONITOR CONTROL?
	JRST	[TYPE	($-End of input reel, mount next and cont..)
		CLOSE	IF1,		;RESET EOF
		MTUNL.	IF1,		;REWIND
		EXIT	1		;WAIT FOR RESPONSE
		JRST	READ7		];& CONTINUE
	PUSHJ	PP,VOLSWT	;YES, LET MONITOR DO IT
READ7:	PUSHJ	PP,READ1		;GET FIRST RECORD
	PUSHJ	PP,LAB.10		;MAKE SURE LEGAL FILE ETC
	MOVE	CH,SIZSAV		;GET CHAR COUNT
	MOVEM	CH,INPSIZ		;STUFF IT WHERE IT BELONGS
	JRST	READ1			;GO BACK INTO THE SWING OF THINGS

;PUT A CHARACTER INTO DATA-FILE BUFFER

PUTBYT:	SOSG	OF2BUF+2
	PUSHJ	PP,WRITE
	IDPB	CH,OF2BUF+1
	POPJ	PP,

; WRITE OUT A SECTOR OF DATA-FILE

WRITE:	AOS	DATLOC
	AOS	OSECC
	TRNE	SW,OPT.P	;DON'T FORCE FULL BUFFER FOR /P
	JRST	WRITE2
	PUSH	PP,CH		;WE
	MOVE	CH,OF2BUF	;  WILL
	ADD	CH,OF2SIZ	; [142] ADD IN BUFFER SIZE
	HLL	CH,OF2BUF+1	;  WRITE
	TLZ	CH,770000	;  128
	MOVEM	CH,OF2BUF+1	;  WORDS
WRITE1:	POP	PP,CH		;					[EDIT#101]


WRITE2:	OUT	OF2,
	  POPJ	PP,

	TLNN	SW,(FMTA)	;IS IT MAGTAPE?
	JRST	DATERA		;NO..DO THE SAME OLD THING
	GETSTS	OF2,TC		;GET FILE STATUS
	TRZN	TC,FEOT		;PHYSICAL END-OF-TAPE?(RESET)
	JRST	DATERA		;NO..ONCE AGAIN..
	SETSTS	OF2,(TC)	;YES, RESET EOT FLAG & CONTINUE
	PUSHJ	PP,SAVAC	;SAVE REGS
	PUSHJ	PP,VLABEL	;GO WRITE VOL LABEL
	PUSHJ	PP,RESAC	;RESTORE REGS
	CLOSE	OF2,		;CLEAR EOT/WRITE EOF
	SKIPE	,AUTOLB		;MONITOR CONTROL?
	JRST	WRITE3		; YES, LET MONITOR DO IT
	TYPE	($-End of output reel, mount next and cont)
	MTUNL.	OF2,		;AND UNLOAD THE TAPE
	EXIT	1,		;HOLD IT UP AND WAIT FOR RESPONSE
	JRST	WRITE4		;GO PROCESS LABELS

WRITE3:	PUSHJ	PP,VOLSWT	;CHANGE REELS
WRITE4:	PUSHJ	PP,SAVAC	;SAVE REGISTERS
	PUSHJ	PP,LABEL	;PUT LABELS
	JRST	RESAC		;RESTORE REGISTERS & RETURN

;READ IN 1 BLK OF INDEX AT CURRENT LEVEL

IDXREA:	MOVN	TA,IDXSIZ	;WORD COUNT
	HRLS	TA
	HRR	TA,IDXLIN-1(IX)	;LOCATION
	SUBI	TA,1
	MOVEI	TB,0		;END OF ARGS
	IN	IF1,TA
	  JRST	IDXRE1
	STATZ	IF1,$ERA
	  JRST	STATER		;ERROR
	TLO	SW,(FEOF!FENDIB!FENDL)	;END-OF-FILE
	POPJ	PP,

IDXRE1:	MOVEI	TA,1		;INIT ENTRY COUNT
	MOVEM	TA,IDXFLG-1(IX)
	MOVEI	TA,2
	MOVEM	TA,IDXWIN-1(IX)	;POSITION OF 1ST ENTRY
	MOVE	TA,IDXLIN-1(IX)
	MOVE	TB,(TA)
	MOVEM	TB,IBW1		;1ST BLK HEADER WD
	MOVE	TB,1(TA)
	MOVEM	TB,IBW2		;2ND WORD OF BLK HEADR

	; NOW MAKE CHECK TO MAKE SURE THAT VERSION NUMBERS ARE CORRECT

	CAME	IX,LEVELS+I	;ARE WE ALREADY AT TOP LEVEL? (NO VERSION NUM)
	CAMN	TB,IDXHD2	; IS BLK VERSION SAME AS IDX ENTRY VERSION?
	POPJ	PP,		; YES, ALL OK, CONT

	; ERROR CASE , VERSION NUMBERS DON'T MATCH

	TRNE	SW,OPT.C+OPT.I	; IS THIS /CHECK OR /IGNORE? 
	PJRST	IVERWR		; YES,GIVE WARNING AND
				; POPJ RETURN TO IDXREA CALLER

	
	; ERROR, GIVE MESSAGE AND RESTART
			
	PUSHJ	PP,IVERER	; MESSAGE
	JRST	START		; AND RESTART

	; CHECK OR IGNORE, GIVE WARNING AND TRY TO CONTINUE



	; PRINT OUT IDX VERSION NUMBER ERROR MESSAGES

IVERER:	; ERROR CASE GIVE ? ERROR
	TYPE	(
?)
	JRST	IVRWR1
IVERWR:	TYPE	(
%)
IVRWR1:	TYPE	(ISMIVD	Index version number discrepency .)
	TYPE	(
	Reading index file )
	PUSHJ	PP,TYINF1	; PRINT PRIMARY INPUT FILE NAME
	TYPE	(
	Index level )
	MOVEI	TE,1(IX)	; GET LEVEL OF UPPER BLK
	PUSHJ	PP,PUTPNT	; TYPE IT
	TYPE	( index block )
	MOVE	TE,CURIDX+1(IX)	; GET INDEX BLOCK NUMBER 
				; ACCOUNT FOR IX INCREMENTED AND UP 1 MORE
	PUSHJ	PP,PUTPNT	; TYPE IT
	TYPE	( entry )
	MOVE	TE,IDXFLG+1	; GET ENTRY NUMBER AT IDX LEVEL ABOVE
	SUBI	TE,1		; ACCOUNT FOR LAST INCREMENT
	PUSHJ	PP,PUTPNT	; TYPE IT
	TYPE	( version number )
	MOVE	TE,IDXHD2	; GET HIGHER VERSION NUMBER
	PUSHJ	PP,PUTPNT	; TYPE IT
	TYPE	( points to
)

	TYPE	(	Index block )
	MOVE	TE,IDXHD1	; GET CURRENT INDEX BLOCK NUMBER
	PUSHJ	PP,PUTPNT	; TYPE IT
	TYPE	( version number )
	MOVE	TE,TB		; GET LOWER VERSION NUMBER
	PUSHJ	PP,PUTPNT	; TYPE IT
	TYPE	( .
)				
	POPJ	PP,		; RETURN




;READ IN 1 BLK OF INDEXED DATA FILE

DATREA:	MOVN	TA,INSIZ	;WORD COUNT
	HRLS	TA
	HRR	TA,INDAT	;LOCATION
	SUBI	TA,1
	MOVEM	TA,INPTR	;INIT INPTR FOR GETREC
	MOVEI	TB,0
	IN	IF2,TA
	  TRNA			;NO ERRORS
	JRST	DATERR		;ERROR

	SETZM	DATFLG		;CLR RECORD USED CTR

	; CHECK DATA BLOCK VERSION NUMBER AGAINST IDX BLOCK
	; THAT POINTS TO IT

	HLRZ	TA,@INDAT	; GET DATA VERSION NUMBER FROM FIRST ENTRY
	TRZ	TA,-100		; CLEAR FILE FORMAT INFO
	CAMN	TA,IDXHD2	; IS IT THE SAME AS THAT FROM IDX BLK?
	POPJ	PP,		; YES, ALL OK


	; ERROR CASE , VERSION NUMBERS DON'T MATCH


	TRNE	SW,OPT.C+OPT.I	; IS THIS /CHECK OR /IGNORE? 
	PJRST	DVERWR		; YES, GIVE WARNING AND 
				; POPJ RETURN TO DATREA CALLER
	
	; ERROR, GIVE MESSAGE AND RESTART
			
	PUSHJ	PP,DVERER	; MESSAGE
	JRST	START		; AND RESTART

	; CHECK OR IGNORE, GIVE WARNING AND TRY TO CONTINUE




	; GIVE DATA FILE VERSION NUMBER MESSAGE

DVERER:	; ERROR CASE GIVE ? ERROR
	TYPE	(
?)
	JRST	DVEWR1
DVERWR:	TYPE	(
%)
DVEWR1:	TYPE	(ISMDVD	Data version number discrepency .)
	TYPE	(
	Reading data file )
	PUSHJ	PP,TYINF2	; PRINT SECONDARY INPUT FILE NAME
	TYPE	( from index file )
	PUSHJ	PP,TYINF1	; PRINT PRIMARY INPUT FILE NAME
	TYPE	(
	Index block )
	MOVE	TE,CURIDX+1	; GET INDEX BLOCK NUMBER AT BOTTOM LEVEL
	PUSHJ	PP,PUTPNT	; TYPE IT
	TYPE	( entry )
	MOVE	TE,IDXFLG+1	; GET ENTRY NUMBER AT IDX LEVEL ABOVE
	SUBI	TE,1		; ACCOUNT FOR LAST INCREMENT
	PUSHJ	PP,PUTPNT	; TYPE IT
	TYPE	( version number )
	MOVE	TE,IDXHD2	; GET HIGHER VERSION NUMBER
	PUSHJ	PP,PUTPNT	; TYPE IT
	TYPE	( points to
)

DTBLK:	TYPE	(	Data block )
	MOVE	TE,IDXHD1	; GET CURRENT INDEX BLOCK NUMBER
	PUSHJ	PP,PUTPNT	; TYPE IT
	TYPE	( version number )
	HLRZ	TE,@INDAT	; GET DATA VERSION NUMBER FROM FIRST ENTRY
	TRZ	TE,-100		; CLEAR FILE FORMAT INFO
	PUSHJ	PP,PUTPNT	; TYPE IT
	TYPE	( .
)
	POPJ	PP,		; NOW RETURN







;SAVE AC'S 0-16

SAVAC:	MOVEM	16,SAVEAC+16
	MOVEI	16,SAVEAC
	BLT	16,SAVEAC+15
	POPJ	PP,

;RESTORE AC'S 0-16

RESAC:	MOVSI	16,SAVEAC
	BLT	16,15
	MOVE	16,SAVEAC+16
	POPJ	PP,



; FORM SIXBIT DATE (IN TA AND TB - TA IS ACTIVE, TB PASSIVE)

LAB.SX:	IDIVI	TD, ^D10
	ROTC	TA, -6		; SHIFT WHAT WE'VE GOT
	MOVEI	TA, 20(TE)	; ADD LOW ORDER DIGIT
	ROTC	TA, -6		;
	MOVEI	TA, 20(TD)	; TOP DIGIT
	POPJ	PP,

IFN	$CU001,<		;MAKE ISAM MORE INTELLIGENT
RECDBF:			;SHOW RECOMENED BLOCKING FACTOR FOR THE DATA FILE

	PUSHJ	PP,SAVAC	;GO SAVE AC'S
	MOVEI	TA,^D1000	;LOAD WITH MAX % OF WASTE THERE CAN BE 100.0%
	MOVEM	TA,DATPCN	;AND REMEMBER FOR LATER

;BL;			2 LINES MOVED FROM RECDB1-2  TO  RECDBF+4
	TRNE	SW,OPT.S	;SEE IF WE ARE SHOWING STATS
	 PUSHJ	PP,STTIT	;IF YES SHOW COLUMN HEADERS
	MOVEI	TB,1		;START WITH 1 DISK BLOCK/LOGICAL DATA BLOCK
IFN TOPS20,<
	TRNE	SW,OPT.OP	;WANT OUTPUT IN PAGES?
	MOVEI	TB,4		; YES
>				;END IFN TOPS20
;BL;			2 LINES MOVE FROM RECDBF+4 TO RECDB1
RECDB1:	MOVE	TA,RECSIZ	;GET RECORD SIZE IN WORDS
	ADDI	TA,1		;ADD 1 FOR OVERHEAD CHARACTER COUNT
	MOVEI	TC,^D128	;LOAD # WORDS/DISK BLOCK
	IMUL	TC,TB		;GET TOTAL # WORDS AVAIL IN DATA BLOCK
	IDIV	TC,TA		;CALC # RECORDS THAT WILL FIT
	PUSHJ	PP,CLPCN	;GET % OF WASTE
	TRNE	SW,OPT.S	;SEE IF STATS WANTED
	 PUSHJ	PP,SHWSTA	;SHOW THEM IF SO
	CAMGE	TE,DATPCN	;CHECK IF FEWER % WASTED
	 PUSHJ	PP,SAVDBF	;YES - GO SAVE NEW VALUES
	ADDI	TB,1		;INCREMENT # OF DISK BLOCKS TO USE
IFN TOPS20,<
	TRNE	SW,OPT.OP	;WANT OUTPUT IN PAGES?
	ADDI	TB,3		; YES
>
	CAIG	TB,IDALIM	;BUT LIMIT IT AT SITE LIMIT 
	JRST	RECDB1		;IF NOT DONE LOOP THRU AGAIN
SHWDBF:	TLNE	SW,(INDIR)	; INDIR CMD FILE?
	POPJ	PP,		; YES, SKIP RECOMMENDATIONS
	TYPE	(<(>)		;TYPE LEFT PAREM
	TYPE	(Recommended = )
	PUSHJ	PP,RESAC	;RESTORE AC'S HERE SO TE WILL BE RETURNED WITH CORRECT VALUE

;BL;	1 CHANGED AT SHWDBF+5
	MOVE	TE,RECBLK	;GET RECOMMENDED BLOCKING VALUE
	PUSHJ	PP,PUTDEC	;SHOW IT TO USER
	TYPE	(<)>)		;TYPE RIGHT PAREN
	TYPE	(: )
	POPJ	PP,		;THEN JUST RETURN

SAVDBF:	MOVEM	TC,RECBLK	;SAVE NEW BLOCKING FACTOR
	MOVEM	TC,IDABF
	MOVEM	TE,DATPCN	;SAVE NEW LOW % WASTED SPACE
	MOVEM	TD,DATWST	;SAVE # OF WORDS WASTED
	MOVEM	TB,DATBLS	;REMEMBER # OF PHYS DATA BLOCKS USED
	SKIPE	DATWST		;IF WASTE = 0 WE KNOW BEST BLOCKING FACTOR
	POPJ	PP,		;IF NOT JUST RETURN
	POP	PP,TD		;FIX UP THE STACK
	JRST	SHWDBF		;GO SHOW RECOMMENDED VALUE

CLPCN:	PUSH	PP,TD		;CALC % WASTED SPACE TO ONE DECIMAL RETURN AS INTEGER IN TE
	IMULI	TD,^D1000	;ROUND TO 1 DECIMAL
	MOVE	TF,TB
	IMULI	TF,^D128	;GET TOTAL WORDS USED
	IDIV	TD,TF		;GET %
	LSH	TE,1		;SEE IF WE MUST ROUND
	CAML	TE,TF
	 AOS	TD		;YES SO ROUND UP
	MOVE	TE,TD		;RETURN IT IN TE
	POP	PP,TD		;RESTORE WASTED WORDS
	POPJ	PP,


RECIBF:			;SHOW RECOMMENDED BLOCKING FACTOR FOR THE INDEX FILE

	PUSHJ	PP,SAVAC	;GO SAVE AC'S
	MOVEI	TA,^D1000	;LOAD UP MAXIMUM WASTED % THAT CAN BE 100.0%
	MOVEM	TA,IDXPCN	;AND REMEMBER FOR LATER

;BL;	2 LINES MOVED FROM RECIB1-2 TO RECIBF+4
	TRNE	SW,OPT.S	;SEE IF WE NEED COLUMN HEADERS
	 PUSHJ	PP,STTIT	;YES GO GIVE THEM
	MOVEI	TB,1		;START WITH 1 DISK BLOCK/LOGICAL INDEX BLOCK
IFN TOPS20,<
	TRNE	SW,OPT.OP	;WANT OUTPUT IN PAGES?
	MOVEI	TB,4		;YES
>				;END TOPS20
;BL;	1 LINE MOVED FROM RECIBF+4 TO RECIB1
RECIB1:	MOVE	TA,SIZIDX	;GET INDEX ENTRY SIZE IN WORDS
	MOVEI	TC,^D128	;LOAD # WORDS/DISK BLOCK
	IMUL	TC,TB		;GET TOTAL # WORDS AVAIL IN INDEX BLOCK
	SUBI	TC,2		;REMOVE THE TWO OVERHEAD WORDS PER INDEX BLOCK
	IDIV	TC,TA		;CALC # RECORDS THAT WILL FIT
	PUSHJ	PP,CLPCN	;GET WASTED PERCENTAGE
	TRNE	SW,OPT.S	;SEE IF STATS ARE NEEDED
	 PUSHJ	PP,SHWSTA	;YES SO GIVE THEM
	CAMGE	TE,IDXPCN	;CHECK IF FEWER WASTED PERCENTAGE
	 PUSHJ	PP,SAVIBF	;YES - GO SAVE NEW VALUES
	ADDI	TB,1		;INCREMENT # OF DISK BLOCKS TO USE
IFN TOPS20,<
	TRNE	SW,OPT.OP	;WANT OUTPUT IN PAGES?
	ADDI	TB,3		; YES
>
	CAIG	TB,IDXLIM	;BUT LIMIT IT AT SITE'S LIMIT
	JRST	RECIB1		;IF NOT DONE LOOP THRU AGAIN
	JRST	SHWIBF		;ELSE SHOW CHOSEN BLOCKING FACTOR

SAVIBF:	MOVEM	TC,RECBLK	;SAVE NEW BLOCKING FACTOR
	MOVEM	TC,IDXBF
	MOVEM	TE,IDXPCN	;SAVE PERCENTAGE WASTED
	MOVEM	TD,IDXWST	;SAVE # OF WORDS WASTED
	MOVEM	TB,IDXBLS	;REMEMBER # OF PHYS INDEX BLOCKS USED
	SKIPE	IDXWST		;IF WASTE = 0 WE KNOW BEST BLOCKING FACTOR
	POPJ	PP,		;IF NOT JUST RETURN
	POP	PP,TD		;FIX UP THE STACK
SHWIBF:	TLNE	SW,(INDIR)	; INDIR CMD FILE?
	POPJ	PP,		; YES, SKIP RECOMMENDATION
	TYPE	(<(>)		;TYPE LEFT PAREN
	TYPE	(Recommended = )
	PUSHJ	PP,RESAC	;RESTORE AC'S HERE SO TE WILL BE RETURNED WITH CORRECT VALUE

;BL;	1 CHANGED AT SAVIBF+5
	MOVE	TE,RECBLK	;GET RECOMMENDED BLOCKING FACTOR
	PUSHJ	PP,PUTDEC	;SHOW IT TO USER
	TYPE	(<)>)		;TYPE RIGHT PAREN
	TYPE	(: )
	POPJ	PP,		;THEN JUST RETURN

STTIT:				;GIVE COULMN HEADERS FOR THE  STATS BEING PRINTED
	TYPE	(
     Records  Disk     Wasted  Memory
     /block   Blocks   space   (wds)
)				;GIVE INITIAL CR-LF BEFORE SHOWING THEM
	POPJ	PP,

SHWSTA:				;SHOW FIGURES AS THEY ARE BEING CALCULATING
	TYPE	(	)	;GIVE A TAB
	PUSH	PP,TE		;SAVE % WASTED SPACE UNTIL NEEDED
	MOVE	TE,TC		;SHOW BLOCKING FACTOR USED
	PUSHJ	PP,PUTDEC
	TYPE	(	)	;SPACE IT OUT A BIT
	MOVE	TE,TB		;SHOW DISK BLOCKS NEEDED
	PUSHJ	PP,PUTDEC
	TYPE	(	)	;MORE SPACE
	MOVE	TE,(PP)		;GET % WASTE BACK
	IDIVI	TE,^D10		;GET TO DECIMAL
	PUSH	PP,TF		;SAVE REMAINDER
	PUSHJ	PP,PUTPNT	;GO PRINT IT
				; AND DECIMAL POINT
	POP	PP,TE		;NOW GET REMAINDER BACK
	PUSHJ	PP,PUTDEC
	TYPE	(%	)
	MOVE	TE,TB		;GET TOTAL BLOCKS USED AGAIN
	LSH	TE,7		;CONVERT TO WORDS
	PUSHJ	PP,PUTDEC	;TELL HOW MANY NEEDED
	TYPE	(
)
	POP	PP,TE		;RESTORE % OF WASTED SPACE
	POPJ	PP,		;THEN RETURN
	>;END OF IFN $CU001

IFN TOPS20,<
ASCNAM:	HRLZI	TB,OF2		;DATA-FILE CHANNEL
	MOVE	TA,[1,,TB]	;1 ARG IN TB
	HRRI	TB,CMPJFN	;FUNCTION
	COMPT.	TA,		;GET JFN
	 JRST	[TYPE (ERROR ON GETJFN
)
		JRST START	]; RETRY
	HRRZ	TB,TA		;JFN TO TB
	HRROI	TA,NAME20	;DESTINATION
	MOVE	TC,[111110,,1]	;GET ALL PARTS OF SPEC WITH PUNCT
	HLLZI	TD,		;CLEAR
	JFNS			;FILE-SPEC TO INDEX BLOCK
	POPJ	PP,		;RETURN
>				;END IFN TOPS20
SUBTTL	TOPS20 MONITOR LABELING CHECK ROUTINE

CKLBL:	TLNN	SW,(FMTA)	;MAG TAPE?
	JRST	NLBRTN		;RESET /L & RETURN

IFN TOPS20,<
	HRLZI	TB,IF1		;CHANNEL FOR JFN REQUEST
	TRNN	SW,OPT.B	;CORRECT ONE (BUILD/INPUT)?
	HRLZI	TB,OF2		;NO, IT'S PACK/OUTPUT

	MOVE	TA,[1,,TB]	;ONE ARGUMENT IN TB
	HRRI	TB,CMPJFN	;FUNCTION
	COMPT.	TA,		;GET JFN ***********
	 JRST	[ TYPE	(Error on GETJFN
)
		JRST	START	] ;MESSAGE & RETRY
	HRRZ	TA,TA		;ZERO LEFT SIDE/TA
	MOVEM	TA,MTAJFN	;SAVE JFN
	SETZM	MTOBLK		;ZERO 1ST WORD
	MOVE	TB,[MTOBLK,,MTOBLK+1] ;INIT BLOCK POINTER
	BLT	TB,MTOBLK+MTOBSZ     ;INIT BLOCK
	MOVEI	TC,MTOBLK	;ADDR OF BLOCK
	MOVEI	TB,MTOBSZ	;WORD COUNT
	MOVEM	TB,MTOBLK	;STORE COUNT
	MOVEI	TB,.MORLI	;READ LABEL FUNCTION
	MTOPR			;GET LABEL INFO ******
	 ERJMP	MTOPER		;GO CHECK ERROR
	SETOM	AUTOLB		;SET AUTO LABEL SW
	MOVE	TB,MTOBLK+1	;LOAD LABEL TYPE
	CAIE	TB,1		;UNLABELED?
	JRST	NLBRTN		; NO, GO RESET /L & RETURN
	POPJ	PP,

MTOPER:	MOVEI	TA,.FHSLF	;CURRENT PROCESS
	GETER			;LAST ERROR #/RH TB
	CAME	TB,[.FHSLF,,MTOX1] ;INVALID FUNCTION? (VER. 4)
	 JRST	MTOERR		; NO, MTOPR ERROR, RESTART
	POPJ	PP,

MTOERR:	TYPE	(Error on MTOPR
)
	JRST	START		;GO TRY AGAIN
>				;END OF IFN TOPS20

IFE TOPS20,<
	MOVE	TA,[%SITLP]	;PID FOR TAPE LABEL
	GETTAB	TA,
	 POPJ	PP,		;ERROR, NO AUTO LABELING
	SKIPN	,TA		;DO WE HAVE PULSAR?
	POPJ	PP,		;RETURN IF NO
	MOVE	TA,[XWD 3,TB]	;3 WORDS, START IN TB
	MOVEI	TB,.TFLBL	;FUNCTION-READ LABEL TYPE
	MOVE	TC,MTACHN	;LOAD CHANNEL
	TAPOP.	TA,		;GET LABEL TYPE
	 JRST 	TFUERR		;ERROR ON CALL
	CAIN	TD,.TFLBP	;LABEL BYPASS?
	POPJ	PP,		; YES, NO AUTO LABEL
	SETOM	AUTOLB		;SET AUTO LABLING SW
	CAIE	TD,.TFLNL	;UNLABELED?
>				;END IFE TOPS20
NLBRTN:	TRZ	SW,OPT.L	; NO COBOL LABELS IF NO
	POPJ	PP,		;RETURN
SUBTTL	MTA VOLUME-SWITCHING ROUTINE

VOLSWT:
;	THIS IS A ROUTINE TO SWITCH MTA REELS WHEN UNDER MONITOR
;	CONTROL, BUT WITHOUT LABELING.

IFN TOPS20,<
	TRNN	SW,OPT.P	;WRITING?
	JRST	VOLSW1		; NOT CLOSED IF NO
	MOVE	TA,MTAJFN	;LOAD JFN
	MOVE	TB,[440000,,100000] ;36 BIT, WRITE ACCESS
	OPENF			;OPEN FOR MTOPR
	 ERJMP	VSWER1		;MESSAGE, RESTART
VOLSW1:	MOVE	TA,MTAJFN	;LOAD JFN
	MOVEI	TB,.MOVLS	;VOLUME SWITCH MTOPR
	MOVEI	TC,3		;3 WORD ARGUMENT
	MOVEI	TD,.VSMRV	;MOUNT RELATIVE VOLUME #
	MOVEI	TE,1		;NEXT VOLUME
	MTOPR			;PERFORM SWITCH *********
	 ERJMP	VSWER2		; ERROR, MESSAGE & RESTART
	POPJ	PP,		;RETURN
VSWER1:	TYPE (%VSWER1: Volume switching error-OPENF
)
	 JRST	START		; & RESTART
VSWER2:	TYPE (%VSWER2: Volume switching error-MTOPR
)
	JRST	START		; & RESTART
>				;END IFN TOPS20

IFE TOPS20,<
	MOVE	TA,[2,,2]	;2 WORDS, START TB
	MOVEI	TB,.TFFEV	;END-OF-VOLUME
	MOVE	TC,MTACHN	;CHANNEL ID
	TAPOP.	TA,		;LET MONITOR CHANGE REELS
	 JRST	VSWER1		;MESSAGE & RESTART
	POPJ	PP,		;RETURN
VSWER1:	TYPE (%VSWER1: Volume switching error-TAPOP
)
	JRST	START		; & RESTART
>				;END IFE TOPS20
SUBTTL	IMPURE AREA

RELOC

IFN	$CU001,<		;MAKE ISAM MORE INTELLIGENT
RECBLK:	BLOCK	1		;RECOMMENDED BLOCKING FACTOR
IDABF:	BLOCK	1		;PLACE TO SAVE BLOCKING FACTOR FOR DATA FILE USED TO
				;REPORT FINAL STAS 
DATWST:	BLOCK	1		;TOTAL WASTED WORDS FOR BLOCKING FACTOR CHOSEN
DATBLS:	BLOCK	1		;NUMBER OF PHYS DATA BLOCKS PER LOGICAL DATA BLOCK
DATPCN:	BLOCK	1		;% OF WASTED SPACE AS INTEGER
IDXBF:	BLOCK	1		;PLACE TO SAVE BLOCKING FACTOR FOR INDEX FILE USED
				;TO REPORT FINAL STATS
IDXWST:	BLOCK	1		;WASTED WORDS PFOR BLOCKING FACTOR
IDXBLS:	BLOCK	1		;# OF PHYS BLOCKS IN LOGICAL INDEX BLOCK
IDXPCN:	BLOCK	1		;% OF WASTED SPACE AS INTEGER (1 DECIMAL PLACE)
	>;END OF IFN $CU001
SIZSAV: BLOCK 1
OREENO:	SIXBIT /0000/
TTYKAR:	BLOCK	1	;IF NON-ZERO, THIS IS THE NEXT TTY INPUT CHARACTER
PATCH:	BLOCK	40
DBUGIT:	BLOCK	1	;SET TO NON-ZERO FOR TRACE
FUSI:	0,,11		; ARG BLOCK FOR FILOP. TYPE USETI
	BLOCK	1	; DITTO

CMBFSZ==3
CMDBUF:	BLOCK	CMBFSZ	;BUFFER HEADER FOR INDIRECT COMMAND FILE
LOWCOR:	BLOCK	0	;BASE OF IMPURE AREA (EXCEPT TTYKAR)

;INPKAR:	BLOCK	1	;IF NON-ZERO, THIS IS THE NEXT INPUT CHARACTER

;BL; 6 LINES RELOCATED TO LOWCOR+1 TO FIX PARTIAL ALLOCATION BUG
IFN	$CU001,<		;MAKE ISAM MORE INTELLIGENT
IF1LB:	BLOCK	.RBALC+1	;AREA FOR EXTENDED LOOKUP  FOR SIZE CALC
OF1EB:	BLOCK	.RBALC+1	;AREA FOR EXTENDED ENTER FOR IDX FILE
OF2EB:	BLOCK	.RBALC+1	;AREA FOR EXTENDED ENTER FOR IDA FILE
CLLVLS:	BLOCK	1		;AREA TO SAVE # OF CALCULATED LEVELS
	>;END OF IFN $CU001
FILDAT:	BLOCK	BUFADR	;GENERAL FILE DISCRIPTION PARAMETERS
OF1DAT:	BLOCK	BUFADR	;PARAMETERS FOR PRIMARY OUTPUT FILE
OF1BUF:	BLOCK	3	;BUFFER HEADER FOR 1ST OUTPUT FILE
IFN TOPS20,<OF1AZB:	BLOCK	15	>;[154] TOPS20 ASCIZ FILE SPEC
OF2DAT:	BLOCK	BUFADR	;PARAMETERS FOR SECONDARY OUTPUT FILE
OF2BUF:	BLOCK	3	;BUFFER HEADER FOR 2ND OUTPUT FILE
IF1DAT:	BLOCK	BUFADR	;PARAMETERS FOR PRIMARY INPUT FILE
IF1BUF:	BLOCK	3	;BUFFER HEADER FOR 1ST INPUT FILE
IF2DAT:	BLOCK	BUFADR	;PARAMETERS FOR SECONDARY INPUT FILE
IF2BUF:	BLOCK	3	;BUFFER HEADER FOR 2ND INPUT FILE
;CMDBUF:	BLOCK	3	;BUFFER HEADER FOR INDIRECT COMMAND FILE

TTYBUF:	BLOCK	4	;[155] BUFFER FOR TTY OUTPUT
AUTOLB:	BLOCK	1	; -1 IF MONITOR HAS LABEL PROCESSING FACILITY
OF2SIZ:	BLOCK	1	; [142] BUFFER SIZE FOR /P OUTPUT
MYPPN:	BLOCK	1	; [143] USERS PPN
PPLIST:	BLOCK	PPSIZE	;PUSH-DOWN LIST
INPBLK:	BLOCK	1	;BLOCKING FACTOR OF INPUT FILE
IDXLOC:	BLOCK	^D10	;ADDRESS IN FREE STORAGE FOR INDEX BLOCK
IDXWRD:	BLOCK	^D10	;RELATIVE WORD WITHIN INDEX BLOCK FOR NEXT KEY
IDXEIB:	BLOCK	^D10	;NUMBER OF ENTRIES IN INDEX BLOCK
IDXLIN:	BLOCK	^D10	;SAME AS IDXLOC BUT FOR INPUT
IDXWIN:	BLOCK	^D10	;  "   " IDXWRD  "   "     "
IDXEIN:	BLOCK	^D10	;  "   " IDXEIB  "   "     "
IDX1KY:	BLOCK	^D10	;SET TO 1 AFTER 1ST KEY WRITTEN AT EACH LVL
CURIDX:	BLOCK	^D11	; BLOCK NUMBER OF ACTIVE INDEX ENTRY AT EACH LEVEL
DATFLG:	BLOCK	1	;CURRENT ENTRY IN DATA BLK (INPUT)
IDXFLG:	BLOCK	^D10	;CURRENT ENTRY IN EACH INDEX BLK (INPUT)
ISECC:	BLOCK	1	;COUNT OF SECTORS READ IN CURRENT BLOCK
OSECC:	BLOCK	1	;COUNT OF SECTORS WRITTEN IN DATA FILE
IRLEFT:	BLOCK	1	;RECORDS LEFT IN INPUT BLOCK
ORLEFT:	BLOCK	1	;RECORDS LEFT TO FILL IN DATA BLOCK
OLDKEY:	BLOCK	1	;ADDRESS OF OLD KEY VALUE
NEWKEY:	BLOCK	1	;ADDRESS OF NEW KEY VALUE
INKEY:	BLOCK	1	;PTR TO INPUT KEY
SIZKEY:	BLOCK	1	;SIZE OF KEY IN WORDS
RECPTR:	BLOCK	1	;POINTER TO IN-CORE RECORD
DATSEC:	BLOCK	1	;NUMBER OF SECTORS IN DATA BLOCK
INPSEC:	BLOCK	1	;NUMBER OF SECTORS IN INPUT BLOCK
INPSIZ:	BLOCK	1	;SIZE OF CURRENT INPUT RECORD, IN BYTES
GDPARM:	BLOCK	1	;PARAMETER FOR 'GD6.' OR 'GD7.' CALL
SAVEAC:	BLOCK	17	;SAVE AREA FOR AC'S 0-16
DATLOC:	BLOCK	1	;NUMBER OF NEXT DATA SECTOR
DATLOK:	BLOCK	1	;NUMBER OF 1ST SECTOR OF CURRENT BLOCK
OUTLST:	BLOCK	2	;OUTPUT LIST FOR WRTING INDEX BLOCK
IDXOUT:	BLOCK	1	;NUMBER OF INDEX BLOCKS WRITTEN
NB1SB:	BLOCK	1	;NUMBER OF BITS IN ONE SAT BLOCK
NBWRIT:	BLOCK	1	;NUMBER OF 1-BITS WRITTEN INTO SAT
DATRIT:	BLOCK	1	;NUMBER OF DATA RECORDS PER BLOCK TO USE
IDXRIT:	BLOCK	1	;NUMBER OF INDEX ENTRIES PER BLOCK TO USE
LASTKB:	BLOCK	1	;SMALLEST RECORD SIZE WHICH CONTAINS KEY
FRSTKB:	BLOCK	1	;BYTE POSITION OF FIRST BYTE IN KEY
SAVSTH:	BLOCK	1	;TEMP TO SAVE 'STHDR' WHILE WRITING SATS
MUCHO:	BLOCK	1	;NUMBER OF DATA RECORDS WRITTEN
INDAT:	BLOCK	1	;PTR TO INPUT DATA BLK FOR /P OR /M
INSIZ:	BLOCK	1	;SIZE OF INPUT DATA BLK FOR /P OR /M
IDXSIZ:	BLOCK	1	;# WORDS/INPUT INDEX BLK
IDXHD1:	BLOCK	1	;1ST HEADER WORD OF INDEX ENTRY
IDXHD2:	BLOCK	1	;2ND "
IBW1:	BLOCK	1	;1ST HEADER WD OF INDEX BLK
IBW2:	BLOCK	1	;2ND "
NDATBT:	BLOCK	1	;TEMPORARY NDATB WHILE WRITING SAT BLKS
INPTR:	BLOCK	1	;BYTE PTR TO INDEXED DATA INPUT RECORD
IFN TOPS20,<
MTOBLK:	BLOCK	MTOBSZ+1	;ARGUMENT BLOCK FOR MTOPR
MTAJFN:
>			;END IFN TOPS20
IFE TOPS20,<
MTACHN:
>			;END IFE TOPS20
	BLOCK	1	;STORE MAG-TAPE JFN/CHANNEL
STDLBL:	BLOCK	15	; BLOCK FOR STANDARD LABEL (/L OPTION)
SA.CRE:	BLOCK	1	; SAVE CREATION DATE OF IF1 (FOR PACK)

CONVRT:	BLOCK	1	;BYTE POINTER TO CONVERT FROM INPUT TO OUTPUT
			;MODE
GETFB:	BLOCK	1	;ADDRESS OF GET FIRST BYTE ROUTINE
GETBYT:	BLOCK	1	;ADDRESS OF NORMAL GET BYTE ROUTINE
FINREC:	BLOCK	1	;ADDRESS OF END OF RECORD PROCESSING ROUTINE
DATBPB:	BLOCK	1	;EBCDIC VARIABLE LENGTH BYTES PER BLOCK - OUTPUT
INPBPB:	BLOCK	1	;INPUT
OBPBCT:	BLOCK	1	;BYTES PER BLOCK COUNTER - OUTPUT
IBPBCT:	BLOCK	1	;INPUT
ALLNUL:	BLOCK	1	;[147] EBCDIC ALL NULL INDICATOR
CVARGS:	BLOCK	2	; CONVERSION ARGUMENTS INCASE ERRORS
			; (This variable is referenced by GD).
;STATISTICS BLOCK FOR OUTPUT INDEX FILE

STHDR:	BLOCK	1	;HEADER WORD
STDEV:	BLOCK	1	;DEVICE NAME FOR DATA FILE
STNAM:	BLOCK	1	;FILE-NAME FOR DATA FILE
STEXT:	BLOCK	1	;FILE-EXTENSION FOR DATA-FILE
CREATE:	BLOCK	1	;DATE DATA-FILE CREATED
ACCDAT:	BLOCK	1	;ACCESS DATE FOR DATA-FILE
LEVELS:	BLOCK	1	;NUMBER OF INDEX LEVELS
DATBLK:	BLOCK	1	;BLOCKING FACTOR OF DATA FILE
EMPDAT:	BLOCK	1	;NUMBER OF EMPTY RECORDS PER DATA BLOCK
IDXBLK:	BLOCK	^D10	;NUMBER OF ENTRIES PER INDEX BLOCK
EMPIDX:	BLOCK	^D10	;NUMBER OF EMPTY ENTRIES PER INDEX BLOCK
NDATB:	BLOCK	1	;NUMBER OF DATA BLOCKS IN FILE
NDATBE:	BLOCK	1	;NUMBER OF EMPTY DATA BLOCKS IN FILE
NSECI:	BLOCK	1	;NUMBER OF SECTORS IN INDEX FILE
NSECIE:	BLOCK	1	;NUMBER OF EMPTY SECTORS IN INDEX FILE
FEISEC:	BLOCK	1	;FIRST EMPTY INDEX SECTOR
RECSIZ:	BLOCK	1	;SIZE OF LARGEST DATA RECORD, IN WORDS
RECKEY:	BLOCK	1	;POINTER TO RECORD KEY
NUMOPS:	BLOCK	1	;NUMBER OF I/O OPERATIONS
NUMUUO:	BLOCK	1	;NUMBER OF IN/OUT UUO'S EXECUTED
SATADR:	BLOCK	1	;ADDRESS OF FIRST SAT BLOCK
NUMSAT:	BLOCK	1	;NUMBER OF SAT BLOCKS
IDXSEC:	BLOCK	1	;NUMBER OF SECTORS IN INDEX BLOCK
SATBIT:	BLOCK	1	;NUMBER OF BITS IN ALL SAT BLOCKS
KEYDES:	BLOCK	1	;KEY DESCRIPTOR
SIZIDX:	BLOCK	1	;SIZE OF INDEX ENTRY
IDXADR:	BLOCK	1	;ADDRESS OF HIGHEST-LEVEL INDEX ENTRY
%DAT:	BLOCK	1	;PERCENTAGE OF DATA FILE TO LEAVE FREE
%IDX:	BLOCK	1	;PERCENTAGE OF INDEX FILE TO LEAVE FREE
RECBYT:	BLOCK	1	;SIZE OF LARGEST DATA RECORD, IN BYTES
MAXSAT:	BLOCK	1	;MAX # RECORDS FILE CAN BECOME
ISAVER:	BLOCK	1	;ISAM VERSION #
PAGBUF:	BLOCK	1	;I/O SW: 0=SECTOR MULTIPLES, NON 0 =PAGES
IFN TOPS20,<
NAME20:	BLOCK	62	;200 (DECIMAL) BYTES FOR FILE-SPEC
>
STATSZ==.-STHDR
I==STATSZ

;STATISTICS BLOCK FOR INPUT INDEX FILE

STAT2:	BLOCK	STATSZ	;REFERENCE AS STHDR VARIABLE + I

LOWSIZ==.-LOWCOR

X=START

RELOC

	END	START