	PROGRAM IDXGEN
C	THIS PROGRAM IS USED TO GENERATE THE CONDITIONAL
C	ASSEMBLY PARAMETERS FILE 'IDXCND.MAC' THAT 
C	CONTROL THE CONFIGURATION OF THE INDEX PROGRAM
C
C	THE FOLLOWING SYMBOLS ARE DEFINED IN THE FILE 'IDXCND.MAC'
C	TO CONTROLL THE BUILDING OF INDEX TO THE CONFIGURATION WANTED
C
C	IAS=1		****RSX-11M ONLY***
C			IF THE SYMBOL 'IAS' IS DEFINED THEN INDEX IS BEING
C			GENERATED FOR AN IAS SYSTEM. IF IT IS DEFINED
C			THEN THE SYMBOL 'RSX' IS ALSO DEFINED AS THE
C			SAME GENERATION QUESTION AND ANSWER SESSION IS
C			USED FOR BOTH TARGET OPERATING SYSTEMS
C
C	RSX=N		****RSX-11M ONLY****
C			IF THE SYMBOL 'RSX' IS DEFINED THEN INDEX IS BEING
C			GENERATED FOR AN RSX-11M SYSTEM. IF IT NOT DEFINED
C			THEN INDEX IS BEING DEFINED FOR AN RT-11 SYSTEM.
C			THE VALUE GIVEN THE SYMBOL 'RSX' IS THE DEPTH OF
C			NESTING OF INDIRECT COMMAND FILES THAT INDEX WILL
C			HANDLE
C
C	F4P=M		****RSX-11M OPTION ONLY****
C			IF THE SYMBOL 'F4P' IS DEFINED THEN INDEX IS GENERATED
C			TO HANDLE FORTRAN 4 + SOURCE FILES.
C			IF UNDEFINED THEN IT SETS UP TO HANDLE FORTRAN 4
C			ONLY. IT IS ASSUMED THAT A SYSTEM WILL HAVE ONLY
C			ONE COMPILER, IF BOTH ARE ON THE SYSTEM, USE
C			THE FORTRAN 4 + VERSION OF INDEX.
C			THE VALUE ASSIGNEG TO THE SYMBOL 'F4P' IS THE NUMBER
C			OF NESTING LEVELS ALOWED FOR 'INCLUDE' STATEMENTS.
C
C	TABCON=1	****F4+ OPTION ONLY****
C			AUTOMATICALLY DEFINED IF F4+ IS SELECTED. MODIFIES
C			THE TAB CONVENTION  TO THAT USED BY THE F4+
C			COMPILER VICE THAT OF THE F4 COMPILER
C
C	EXTK=L		****RSX-11M OPTION ONLY****
C			IF THE SYMBOL 'EXTK' IS DEFINED THEN THE USER HAS
C			AN RSX-11M SYSTEM WITHOUT THE EXTEND TASK DIRECTIVE.
C			SO INDEX MUST GENERATE A FIXED INTERNAL BUFFER. THE
C			VALUE GIVEN THE SYMBOL 'EXTK' IS THE SIZE OF THAT
C			BUFFER IN UNITS OF 1024. WORDS.
C			IF NOT DEFINED-THE PROGRAM CAN EXPAND TO CREATE
C			ITS BUFFER AT RUN TIME USEING THE EXTK$ DIRECTIVE.
C
C	.MACRO HLPGEN
C HLPDSC: .WORD X,HDEV,Y,HUIC,9.,HNAME
C HDEV:	.ASCII /DDN:/
C HUIC: .ASCII /[XXX,YYY]/
C HNAME:.ASCII /INDEX.HLP/
C	.EVEN
C	.ENDM HLPGEN
C			****RSX-11M DEFINED MACRO ONLY****
C			THIS MACRO IS ALWAYS DEFINED IN RSX SYSTEMS.
C			IT IS INVOKED IN 'BUFFER.MAC' TO DEFINE THE 
C			LOCATION OF THE HELP FILE.
C			DEFAULT IS
C			.MACRO HLPGEN
C			HLPDSC:	.WORD 4,HDEV,5,HUIC,9.,HNAME
C			HDEV: 	.ASCII	/LB0:/
C			HUIC:	.ASCII	/[1,2]/
C			HNAME:	.ASCII	/INDEX.HLP/
C				.EVEN
C				.ENDM	HLPGEN
C
C	SPOOLER=1	****RSX-11M SYMBOL ONLY****
C			IF DEFINED UNDER THE RSX-11M SYSTEM, ALL OUTPUT
C			FILES ARE AUTOMATICALLY SPOOLED TO THE LINE PRINTER.
C			IT CAN BE OVER RIDDEN BY '/-SP'. IF NOT DEFINED
C			THEN SPOOLING MUST BE FORCED BY THE '/SP'
C			SWITCH
C
C
C	.MACRO	WRKDEV
C	SDNAM:	NMBLK$	SUPER,TMP,,DD,N
C	CANAM:	NMBLK$	FLOW,TMP,,DD,N
C	.ENDM
C			****RSX-11M MACRO ONLY****
C			THIS MACRO IS ALWAYS DEFINED IN RSX-11M SYSTEMS.
C			IT IS INVOKED IN 'BUFFER.MAC' TO DEFINE THE
C			STORAGE DEVICES USED FOR THE SUPER AND ENTRY POINT
C			INDEX TEMPORARY WORK FILES. DEFAULT DEVICE IS LB:
C
C	.MACRO HLPDEV
C	.RAD50 /DDN/
C	.ENDM HLPDEV
C			****RT-11 MACRO ONLY****
C			THIS MACRO IS ALWAYS DEFINED IN RT-11 SYSTEMS.
C			IT IS INVOKED IN 'OPNCLO.MAC' TO DEFINE THE
C			HELP FILE DEVICE.DEFAULT IS
C			.MACRO	HLPDEV
C				.RAD50	/SY /
C			.ENDM	HLPDEV
C
C	.MACRO WRKDEV
C	DBLK1:	.RAD50	/DDNSUPER TMP/
C	DBLK2:	.RAD50	/DDNFLOW  TMP/
C	.ENDM
C			****RT-11 MACRO ONLY****
C			THIS MACRO IS ALWAYS DEFINED IN RT-11 SYSTEMS.
C			IT IS INVOKED IN 'OPNCLO.MAC' TO DEFINE THE
C			SUPER AND ENTRY POINT INDEX TEMPORARY WORK 
C			FILES. DEFAULT IS SY:
C
C	LPMODE=1	DEFINES THAT ALL INDEX OUTPUT IS IN LINE PRINTER
C			(132 COLLUMN) FORMAT. TO OVER RIDE BACK TO TERMINAL
C			(80 COLLUMN) FORMAT USE THE '/T' SWITCH. IF NOT
C			DEFINED, ALL OUTPUT IS IN TERMINAL MODE AND LINE
C			PRINTER MODE IS OBTAINED BY THE  '/L' SWITCH.
C
C	PAGSIZ=K	DEFINES THE NUMBER OF LINES PER PAGE. DEFAULT IS
C			60 LINES PER PAGE.
C
C	NOFF=1		IF DEFINED, THE FIRST PAGE IN AN OUTPUT FILE
C			DOES NOT START WITH A FORM FEED BUT ALL FOLLWING
C			PAGES DO (EVEN WITH THE '/M' OPTION UNDER RSX
C			THE FIRST PAGE OUTPUT TO THE EXISTING FILE DOES
C			NOT START WITH A FORM FEED. DEFAULT IF THIS SYMBOL
C			IS NOT DEFINED IS THAT ALL PAGES OUTPUT START
C			WITH FORM FEEDS. THIS OPTION IS INTENDED FOR
C			A USER THAT DOES A LOT OF SPOOLING OF FILES
C			AND DOES NOT WANT A BLANK SHEET BETWEEN THE
C			BANNER AND FIRST PAGE OF THE LISTING.
C
C	TRFF=1		IF DEFINED, THE LAST PAGE OF THE LISTING HAS A
C			FORM FEED APENDED. UNDER RSX-11M, WHEN THE USER
C			APPENDS LISTINGS TO THE END OF AN EXISTING INDEX
C			FILE, AN EXTRA BLANK PAGE IS PRODUCED. THIS OPTION
C			IS INTENDED TO FORCE THE LAST PAGE FROM THE PRINTER.
C
C	SPRIDX=1	IF DEFINED, ALL FILES INDEXED AUTOMATICALLY HAVE THEIR
C			SYMBOL TABLES SAVED FOR A SUPER INDEX. NO EXPLICIT
C			OVERRIDE EXISTS BUT IS IMPLICIDLY OVERRIDDEN BY
C			THE '/I' SWITCH. IF NOT DEFINED, THE USER MUST USE
C			THE '/S' SWITCH TO SAVE THE FILE SYMBOL TABLE FOR
C			A SUBSEQUENT SUPER INDEX.
C
C
C	PREPRC=1	IF DEFINED-ENABLES THE SWITCH 'P' TO USE THE
C			LINE NUMBERS GENERATED BY A PREPROCESOR
C			SUCH AS 'FLEX' -SUCH LINE NUMBERS PUT IN COLLS
C			73-80. CONFLICTS WITH THE SWITCH /E.
C
C
C	INDENT=N	USED IN THE INDENTED CALLING TREE TO SET THE LIMIT
C			ON HOW DEEP NESTED SUBROUTINES ARE FOLLOWED.
C			THIS NUMBER MUST BE 1 GREATER THAN THE NUMBER OF
C			NAMES THAT CAN BE LISTED ON ONE LINE ON THE
C			LINE PRINTER (GREATER THAN 32)
C
C
C		TABLE OF WHERE SYMBOLS/MACROS USED
C
C		SYMBOL/MACRO NAME
C
C		!I!R!F!T!E!H!S!W!H!L!P!N!S!P!I!T!
C		!A!S!4!A!X!L!P!R!L!P!A!O!P!R!N!R!
C		!S!X!P!B!T!P!O!K!P!M!G!F!R!E!D!F!
C		! ! ! !C!K!G!O!D!D!O!S!F!I!P!E!F!
C		! ! ! !O! !E!L!E!E!D!I! !D!R!N! !
C		! ! ! !N! !N!E!V!V!E!Z! !X!C!T! !
C MODULE NAME	! ! ! ! ! ! !R! ! ! ! ! ! ! ! ! !
C------------------------------------------------
C BUFFER        ! !*!*! !*!*! !*! ! ! ! ! ! ! ! !
C------------------------------------------------
C EVAL	        ! !*!*! ! ! ! ! ! ! ! ! ! ! ! ! !
C------------------------------------------------
C FLOW	        ! !*! ! !*! ! ! ! ! ! ! ! ! !*! !
C------------------------------------------------
C GET	        ! ! ! ! ! ! ! ! ! ! ! ! ! !*! ! !
C------------------------------------------------
C IMPURE        ! !*!*! ! ! ! ! ! ! ! ! ! !*!*! !
C------------------------------------------------
C INDEX	        ! !*!*! !*! ! !*! ! ! ! ! !*! ! !
C------------------------------------------------
C IOCHR	        ! !*!*! ! ! ! ! ! ! ! ! ! ! ! ! !
C------------------------------------------------
C IOLINE        !*!*! !*! ! ! ! ! ! !*!*! ! ! ! !
C------------------------------------------------
C LINETP        ! ! ! ! ! ! ! ! ! ! ! ! ! !*! ! !
C------------------------------------------------
C OPNCLO	! !*!*! ! ! !*! !*!*! !*!*!*! !*!
C------------------------------------------------
C OUTPUT	! !*! ! ! ! ! ! ! ! ! ! ! !*! ! !
C------------------------------------------------
C RAD50		! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
C------------------------------------------------
C STORE		! !*! ! !*! ! ! ! ! ! ! ! !*! ! !
C------------------------------------------------
C SUPER		! !*! ! !*! ! ! ! ! ! ! ! ! ! ! !
C------------------------------------------------
C TABLE		! ! !*! ! ! ! ! ! ! ! ! ! ! ! ! !
C------------------------------------------------
C
C
C	DECLARE ALL LOGICAL FLAGS , STRINGS AND COUNTERS
C
	LOGICAL IAS,YESNO
	INTEGER EXTK,INCLEV,CMDLEV
	BYTE ANSWER(16),LINE1(22),LINE2(25),LINE3(12),LINE4(12)
C
C	FILL ALL STRINGS
C
	DATA LINE1/'I','N','D','E','X','.','H','L','P','/','N','V',
	1 '=','I','N','D','E','X','.','H','L','P'/
	DATA LINE2/'I','N','D','E','X','.','T','S','K','/','N','V',
	1 '/','C','O','=','I','N','D','E','X','.','T','S','K'/
	DATA LINE3/'I','N','D','E','X','.','H','L','P','/','P','U'/
	DATA LINE4/'I','N','D','E','X','.','T','S','K','/','P','U'/
C
C	OPEN CONDITIONAL PARAMETER FILE FOR IDXGEN OUTPUT
C
	OPEN(UNIT=1,NAME='IDXCND.MAC',CARRIAGECONTROL='FORTRAN',
	1 TYPE='NEW',FORM='FORMATTED')
C
C	CONTENTS OF CONDITIONAL ASSEMBLE FILE ARE NOLIST
C
	WRITE(1,100)
100	FORMAT(' .NLIST')
	IAS=.FALSE.
C
C	OUTPUT TITLE OF THIS PROGRAM TO START OFF Q/A SESSION
C
	WRITE(5,200)
200	FORMAT(/,' IDXGEN-INDEX V6.4 ',
	1 'CONFIGURATION GENERATION PROGRAM ',/)
C
C	ASK WHAT OPERATING SYSTEM(THIS HAS TO  RUN UNDER RT/RSX/IAS)
C	TREAT IAS AS A SPECIAL CASE OF RSX
C
305	CALL GETSTR(
	1 'WHAT OPERATING SYSTEM DO YOU WANT (''RT''/''RSX''/''IAS'') ? ',
	1 55,ANSWER,,0)
C
C	SEE IF IT IS IAS
C
	IF((ANSWER(1).EQ.'I').AND.(ANSWER(2).EQ.'A').AND.
	1 (ANSWER(3).EQ.'S'))
	1 GO TO 327
C
C	CHECK FOR RT OR RSX ANSWER
C
	IF(ANSWER(1).NE.'R')GO TO 305	!FIRST LETTER MUST BE AN 'R'
	IF(ANSWER(2).EQ.'T')GO TO 301	!IF SECOND LETTER IS 'T' THEN RT-11
	IF((ANSWER(2).NE.'S').OR.(ANSWER(3).NE.'X'))GO TO 305 !FOLLOWED BY SX
C
C	RSX OPERATING SYSTEM HANDLE ALL RSX SPECIFIC CONDITIONALS
C
	GO TO 328
C

C
C	RSX/IAS SPECIFIC QUESTIONS
C
C
C	SELECTED SYSTEM IS IAS-SET IAS FLAG AND USE RSX STUFF FOR IAS
C
327	IAS=.TRUE.
C
C	CREATE THE COMMAND FILE 'REPLACE.CMD' WHICH WILL BRING IN THE
C	PROPER TASK BUILDER COMMAND FILE FOR THE OPERATEING SYSTEM
C	SELECTED RSX/IAS
C
328	OPEN(UNIT=2,NAME='REPLACE.CMD',CARRIAGECONTROL='FORTRAN',
	1 TYPE='NEW',FORM='FORMATTED')
C
C	SELECT THE BUILD FILE WANTED
C
	IF(IAS)GO TO 341
C
C	USE THE PREBUILT RSX TKB FILE
C
	WRITE(2,405)
405	FORMAT(' PIP IDXTKB.CMD=IDXTKB.RSX')
	GO TO 342
C
C	USE THE PREBUILT IAS TKB FILE
C
341	WRITE(2,406)
406	FORMAT(' PIP IDXTKB.CMD=IDXTKB.IAS')
C
C	COMMAND FILE 'REPLACE.CMD' IS FINISHED-CLOSE IT 
C
342	CLOSE(UNIT=2)	
C
C	DETERMINE IF THE RSX SYSTEM IS MAPPED OR UNMAPPED.
C	THIS SHOWS UP LATER BY SETTING THE DEFAULT STORAGE
C	LOCATION FOR INDEX TASK  [1,54] MAPPED OR [1,50] UNMAPPED
C
	II=1
	IF(YESNO('MAPPED ? ',9,,0))II=2
C
C	WHILE TAKEING INPUT FROM COMMAND FILES-HOW DEAPLY NESTED
C	DO YOU WANT INDEX TO BE ABLE TO TRACK.
C
	CALL GETNUM('COMMAND FILE NESTING LIMIT (1-6) ? ',35,CMDLEV,1,6,,0)
C
C	DEFINE SYSTEM AS RSX IN CONDITIONAL FILE AND ALSO SET COMMAND
C	FILE NESTING LEVEL
C
	WRITE(1,101)CMDLEV
101	FORMAT(' RSX=',O1)
C
C	RSX CAN HAVE EITHER F4 OR F4P FIND OUT WHICH
C	TREAT F77 ,FTN ,F+,F4+  AND F4P AS THE SAME
C	TREAT FOR , F4 AS THE SAME
C
302	CALL GETSTR(
	1 'WHAT FORTRAN IS DEFAULT (''F4''/''F4P''/''F77'') ? ',45
	1 ,ANSWER,,0)
C
C	FIRST CHAR MUST BE 'F'
C
	IF((ANSWER(1).NE.'F'))GO TO 302
C
C	CHECK F4P POSSABLE ANSWERS
C
	IF((ANSWER(2).EQ.'7').AND.(ANSWER(3).EQ.'7'))GO TO 303
	IF((ANSWER(2).EQ.'T').AND.(ANSWER(3).EQ.'N'))GO TO 303
	IF((ANSWER(2).EQ.'+'))GO TO 303
	IF((ANSWER(2).EQ.'4').AND.(ANSWER(3).EQ.'P'))GO TO 303
	IF((ANSWER(2).EQ.'4').AND.(ANSWER(3).EQ.'+'))GO TO 303
C
C	CHECK FOR F4 ANS
C
	IF((ANSWER(2).EQ.'4'))GO TO 304
	IF((ANSWER(2).EQ.'O').AND.(ANSWER(3).EQ.'R'))GO TO 304
C
C	NO RIGHT ANSWER FOUND-RETRY QUESTION
C
	GO TO 302
C
C	FORTRAN IS F4P/F77-DETERMINE NESTING LEVEL OF INCLUDE FILES
C
303	CALL GETNUM('INCLUDE FILE NESTING LEVEL (1-6) ? ',35,INCLEV,1,6,,0)
C
C	WRITE TO CONDITIONAL ASSEMBLY FILE THIS IS F4P AND INCLUDE
C	FILE NESTING LEVEL
C
C	ALSO SET THE TAB CONVENTION USED AS THE F4P TAB CONVENTION
C	THIS IS A SEPERATE SYMBOL
C
	WRITE(1,103)INCLEV	!TELL CONDITIONAL FILE F4P AND LEVEL OF INCLUD
103	FORMAT(' F4P=',O1,/,' TABCON=1     ;USE F4P TAB CONVENTION')
C
C	WILL THE TARGET RSX SYSTEM ALLOW THE INDEX TASK TO DYNAMICALLY
C	EXPAND AT RUN TIME
C
304	IF(YESNO('DOES YOUR RSX-11M SUPPORT THE EXTK$ DIRECTIVE ? ',
	1 48,,0))GO TO 321
C
C	NOT DYNAMICALLY EXPANDABLE-SET PERMINAENT BUFFER SIZE
C
	CALL GETNUM('WHAT BUFFER SIZE DO WANT (IN K WORDS 4-16) ? ',45
	1 ,EXTK,4,16,,0)
	WRITE(1,104)EXTK!OUTPUT TO CONDITIONAL FILE
104	FORMAT(' EXTK=',O3,';SPECIFY INTERNAL BUFFER NEEDED AND',
	1 ' SIZE IN KW')
C
C	DETERMINE WHER THE TASK AND HELP,FILES ARE TO RESIDE
C	CREATE THE COMMAND FILE TO COPY .HLP AND .TSK TO FINAL DESTINATION
C
321	OPEN(UNIT=2,NAME='COPY.CMD',CARRIAGECONTROL='FORTRAN',
	1 TYPE='NEW',FORM='FORMATTED')
C
C	SEE IF DEFAULT HELP FILE LOCATION IS OK
C
	IF(YESNO('HELP FILE DEFAULT STORAGE IS LB:[1,2] IS THIS OK ? '
	1 ,51,,0))GO TO 307
C
C	USER WANTS NON STANDARD HELP FILE LOCATION
C
310	CALL GETSTR('WHAT DEVICE AND UIC (XXN:[YYY,YYY]) ? ',38,ANSWER,,0)
C
C	BREAK OUT FIELDS FOR DEV AND UIC ASSUMED TO CONTAIN  NO BLANKS
C
	I2=1	!POINTER TO END OF DEVICE PART OF FIELD
308	IF(ANSWER(I2).EQ.':')GO TO 309 !FIND END OF DEVICE FIELD
	IF(I2.GE.4)GO TO 310!CHECK FOR OVERRUN(ERROR)
	I2=I2+1	!NEXT CHAR
	GO TO 308!LOOP
309	I3=I2+1!POINTER TO BEGINNING OF UIC FIELD
	IF(ANSWER(I3).NE.'[')GO TO 310 !MUST HAVE '[' OR ERROR
	I4=I3	!POINTER TO END OF UIC FIELD
311	IF(ANSWER(I4).EQ.']')GO TO 312 !SEE IF END OF FIELD FOUND YET
	IF(I4.GE.16)GO TO 310!IF OVERFLOW-ERROR
	I4=I4+1 !BUMP POINTER
	GO TO 311 !LOOP
C
C	THE STRING ANSWER HAS THE USER INPUT DEV AND UIC SPEC FOR THE 
C	HELP FILE. WITH POINTERS TO EACH SEGMENT OF THE STRING.
C	PARSED AS TO 'DDXX' AND '[GGG,UUU]' PARTS
C
312	WRITE(1,107)I2,(I4-I3+1)!OUTPUT FIRST PART OF HELP FILE LOC BLOCK
107	FORMAT(' .MACRO HLPGEN ;DEFINE HELP FILE LOCATION',/,
	1 ' HLPDSC: .WORD ',O1,',HDEV,',O2,',HUIC,9.,HNAME')
	WRITE(1,108)(ANSWER(I),I=1,I2),'/'!OUTPUT DEVICE
108	FORMAT(' HDEV: .ASCII /',5(A1:))
	WRITE(1,109)(ANSWER(I),I=I3,I4),'/'!OUTPUT UIC
109	FORMAT(' HUIC: .ASCII /',16(A1:))
	WRITE(1,110)!OUTPUT  FILE NAME AND END OF MACRO
110	FORMAT(' HNAME: .ASCII /INDEX.HLP/',/,
	1 ' .EVEN',/,' .ENDM HLPGEN')
C
C	OUTPUT TO COMMAND FILE COMMAND TO COPY HELP FILE
C	AS MUST CURRENT VERSION,PURGE OLD VERSIONS
C
	WRITE(2,400)(ANSWER(I),I=1,I4),(LINE1(I),I=1,22)
400	FORMAT(' PIP ',41(A1:))
	WRITE(2,400)(ANSWER(I),I=1,I4),(LINE3(I),I=1,12)
	GO TO 316
C
C	OUTPUT MACRO TO DEFINE HELP FILE AT STANDARD LOCATION
C
307	WRITE(1,111)
111	FORMAT(' .MACRO HLPGEN ;DEFINE HELP FILE LOCATION',/,
	1 ' HLPDSC: .WORD 4,HDEV,5,HUIC,9.,HNAME',/,
	2 ' HDEV: .ASCII /LB0:/',/,' HUIC: .ASCII /[1,2]/',/,
	3 ' HNAME: .ASCII /INDEX.HLP/',/,
	4 ' .EVEN',/,' .ENDM HLPGEN')
C
C	OUTPUT TO COMMAND THE COPY COMMAND FILE THE INSTRUCTIONS ON
C	WHERE TO COPY HELP FILE AS NEW VERSION AND PURGE OLD VERSIONS
C
	WRITE(2,400)'L','B',':','[','1',',','2',']',(LINE1(I),I=1,22)
	WRITE(2,400)'L','B',':','[','1',',','2',']',(LINE3(I),I=1,12)
C
C	ASK ABOUT THE USE OF DEFAULT STORAGE OF THE TASK-LOCATION
C	VARIES WETHER TARGET SYSTEM IS MAPPED OR UNMAPPED
C
316	GO TO (360,361)II
C
C	ASK FOR UNMAPPED DEFAULT OK
C
360	II=0
	IF(YESNO(
	1 'DEFAULT TASK STORAGE AREA IS LB:[1,50] IS THIS OK ? ',52
	1 ,,0))GO TO 317
C
C	NON STANDARD SELECTED-GO HANDLE
C
	GO TO 362
361	II=4
C
C	ASK FOR MAPPED DEFAULT OK
C
	IF(YESNO(
	1 'DEFAULT TASK STORAGE AREA IS LB:[1,54] IS THIS OK ? ',52
	1 ,,0))GO TO 317
C
C	USER WANTS NON STANDARD TASK STORAGE-HANDLE IT
C	GET THE USER SPECIFED TASK LOCATION
C
362	CALL GETSTR('WHAT DEVICE AND UIC (XXN:[YYY,YYY]) ? ',38,ANSWER,,0)
C
C	ASSUMING NO IMBEDDED BLANKS-FIND THE END OF THE SPEC--']'
C
	I2=16
C
C	SCAN BACKWARD UNTILL EITHER ']' IS FOUND
C
318	IF(ANSWER(I2).EQ.']')GO TO 319
	I2=I2-1
C
C	OR RUN OUT OF INPUT STRING
C
	IF(I2.LE.0)GO TO 316
	GO TO 318
C
C	OUTPUT TO THE COPY COMMAND FILE
C	THE COMMANDS TO COPY THE TASK TO THE WANTED LOCATION AS THE
C	MOST CURRENT VERSION, PURGE OLD VERSIONS, AND INSTALL TASK
C
319	WRITE(2,400)(ANSWER(I),I=1,I2),(LINE2(I),I=1,25)
	WRITE(2,400)(ANSWER(I),I=1,I2),(LINE4(I),I=1,12)
	WRITE(2,404)(ANSWER(I),I=1,I2),(LINE4(I),I=1,9)
404	FORMAT(' INS ',60(A1:))
	GO TO 320
C
C	STANDARD TASK STORAGE LOCATION SELECTED
C	WRITE TO COPY COMMAND FILE TO COPY TASK IMAGE AS MOST CURRENT
C	VERSION-PURGE OLD VERSIONS AND INSTALL TASK
C
317	WRITE(2,401)50+II,50+II
401	FORMAT(' PIP LB:[1,',I2,']INDEX.TSK/NV/CO=INDEX.TSK',/,
	1 ' PIP LB:[1,',I2,']INDEX.TSK/PU',/,
	1 ' INS $INDEX')
C
C	COPY COMMAND FILE TO LOAD HELP AND TASK FILES, PURGE OLD VERSIONS
C	AND INSTALL IS COMPLETE-CLOSE IT.
C
320	CLOSE(UNIT=2)
C
C	CHECK ON THE SCRATCH FILE STORAGE LOCATIONS
C
329	IF(YESNO(
	1 'DEFAULT TEMPORARY WORK FILES DEVICE IS ''LB0:'' IS THIS OK ? ',
	1 59,,0))GO TO 322
C
C	USER DOES NOT WANT DEFAULT-PROMT HIM FOR WHAT HE DOES WANT
C
	CALL GETSTR('WHAT DEVICE (XXN:) ? ',21,ANSWER,,0)
C
C	SET DEVIVE NAME AND NUMBER DEFAULTS TO BLANKS
C
	II1=' '
	II2=' '
	II3=' '
C
C	SET END OF INPUT FILED SCANNER TO 0
C
	II=0
C
C	SCAN INPUT STRING FOR TERMINATEING CHARACTER ':'
C
	DO  323 I=1,4
	IF(ANSWER(I).EQ.':')II=I
323	CONTINUE
C
C	IF ':' NOT FOUND-ERROR-RETRY
C
	IF(II.LE.1)GO TO 329
C
C	IF FIRST CHR IS NOT LETTER-ERROR-RE PROMPT
C
	IF((ANSWER(1).LT.'A').OR.(ANSWER(1).GT.'Z'))GO TO 329
C
C	LOAD FIRST LETTER OF NEMONIC
C
	II1=ANSWER(1)
C
C	IS SECOND CHAR A LETTER (COULD BE A 1 CHR NEMONIC)
C
	IF((II.GT.2).AND.(ANSWER(2).GE.'A').AND.(ANSWER(2).LE.'Z'))
	1 II2=ANSWER(2)
C
C	LOAD SECOND CHR OF DEVICE NEMONIC
C	CHCK TO SEE IF LAST CHAR BEFORE ':' IS A DIGIT (ASSUMED ONLY ONE
C	DIGET UNIT NO)
C
	IF((II.GT.2).AND.(ANSWER(II-1).GE.'0').AND.(ANSWER(II-1).LE.'9'))
	1 II3=ANSWER(II-1)
C
C	IF DIGIT SPECIFIED-LOAD ELSE USE BLANK(DEFAULT UNIT 0)
C	WRITE TO CONDITIONAL FILE THE MACRO TO DEFINE THE DEVICE
C	AND NAMES OF TE SCRATCH WORK FILES FOR THE SUPER INDEX
C	AND ENTRY POINT INDEX.
C
	WRITE(1,113)II1,II2,II3,II1,II2,II3
113	FORMAT(' .MACRO WRKDEV',/,
	1 ' SDNAM: NMBLK$ SUPER,TMP,,<',2A1,'>,',A1,/,
	1 ' CANAM: NMBLK$ FLOW,TMP,,<',2A1,'>,',A1,/,
	1 ' .ENDM')
	GO TO 313
C
C	OUTPUT THE DEFAULT SCRATCH FILE LOCATION DEFINITION MACRO
C
322	WRITE(1,113)'L','B','0','L','B','0'
C
C	CHECK TO SEE IF THE USER WANTS AUTO SPOOL OPTION
C
313	IF(.NOT.YESNO('DO YOU WANT AUTO SPOOL ? ',25,,0))GO TO 314
C
C	YES-WRITE TO CONDITONAL FILE
C
	WRITE(1,112)	!YES-SET CONDITIONAL
112	FORMAT(' SPOOLER=1 ;AUTO SPOOL ENABLE')
314	GO TO 350
C

C
C	RT-11-HANDLE ALL RT-11 SPECIFIC ITEMS
C
C
C	SINCE THIS IS AN RT-11 INDEX-NO F4P POSSABLE
301	WRITE(5,220)
220	FORMAT(/,' ''F4'' COMPILER IS ASSUMED')
C
C	CREATE THE COMMAND FILE TO COPY THE RESULTING SAVE IMAGE AND
C	HELP FILE TO RUNNING LOCATION
C
	OPEN(UNIT=2,NAME='COPY.COM',CARRIAGECONTROL='FORTRAN',
	1 TYPE='NEW',FORM='FORMATTED')
C
C	SEE IF USER WANTS DEFAULT-
C
330	IF(YESNO('DEFAULT DEVICE FOR HELP FILE IS SY: IS THIS OK ? ',47
	1 ,,0))GO TO 331
C
C	NO-USER WANTS ELSEWARE
C
	CALL GETSTR('WHAT DEVICE (XXN:) ? ',21,ANSWER,,0)
C
C	SCAN INPUT STRING FOR TERMINATEING ':'
C
	II=0
	DO 332 I=1,4	!FIND WHERE END OF INPUT IS-DON'T INCLUDE ':' IN STRIN
	IF(ANSWER(I).EQ.':')II=I
332	CONTINUE
C
C	IF NO ':' FOUND-ERROR
C
	IF(II.EQ.0)GO TO 330
C
C	WRITE TO COPY COMMAND FILE COMMAND TO COPY HELP FILE TO SEPIFIED DEST
C
	WRITE(2,402)(ANSWER(I),I=1,II)
402	FORMAT(' COPY INDEX.HLP ',4(A1:))
C
C	BLANK OUT ':'
C
	ANSWER(II)=' '
C
C	WRTIE TO CONDITONAL FILE MACRO TO DEFINE LOCATION OF HELP FILE
C
	WRITE(1,121)(ANSWER(I),I=1,3)!OUTPUT MACRO TO DEFINE HELP FILE DEVICE
121	FORMAT(' .MACRO HLPDEV ;DEFINE HELP FILE DEVICE',/,
	1 ' .RAD50 /',3A1,'/',/,' .ENDM HLPDEV')
	GO TO 333
C
C	OUTPUT TO COPY COMMAND FILE THE COMAND TO COPTY THE HELP FILE
C	TO THE DEFAULT LOCATION AND THE MACRO TO THE CONDITIONAL FILE
C	TO DEFINE ITS LOCATION FOR THE SAVE TO KNOW WHERE TO FIND IT
C
331	WRITE(1,121)'S','Y',' ' !OUTPUT MACRO WITH DEFAULT DEVICE
	WRITE(2,402)'S','Y',':'
C
C	SEE IF USER WANTS DEFAULT FOR SAVE FILE
C
333	IF(YESNO(
	1 'DEFAULT DEVICE FOR THE ''.SAV'' FILE IS ''SY:'' IS THIS OK ? '
	1 ,57,,0))GO TO 334
C
C	NOPE-SEE WHERE HE WANTS IT
C
	CALL GETSTR('WHAT DEVICE (XXN:) ? ',21,ANSWER,,0)
C
C	SCAN INPUT LINE FOR ':' 
C
	II=0
	DO 335 I=1,4
	IF(ANSWER(I).EQ.':')II=I
335	CONTINUE
C
C	IF NO ':' FOUND-ERROR
C
	IF(II.EQ.0)GO TO 333
C
C	OPUTPUT TO COPY COMMAND FILE COMMAND TO COPY SAVE IMAGE
C	TO WANTED DESTINATION
C
	WRITE(2,403)(ANSWER(I),I=1,II)
403	FORMAT(' COPY INDEX.SAV ',4(A1:))
	GO TO 336
C
C	WRITE TO COPY COMMAND FILE COMMAND TO COPY SAVE IMAGE TO DEFAULT DEST
C
334	WRITE(2,403)'S','Y',':'
336	CLOSE(UNIT=2)
C
C	SEE IF USER WANTS DEFAULT FOR SCRATCH WORK FILES
C
337	IF(YESNO(
	1 'DEFAULT DEVICE FOR TEMPORARY WORK FILES IS SY: IS THIS OK ? '
	1 ,62,,0))GO TO 338
C
C	DES NOT WANT DEFAULT(NO SATISFYING THIS GUY)
C
	CALL GETSTR('WHAT DEVICE (XXN:) ? ',21,ANSWER,,0)
C
C	SCAN FOR ':'
C
	I1=1
339	IF(ANSWER(I1).EQ.':')GO TO 340
	I1=I1+1
	IF(I1.GT.4)GO TO 337
C
C	NO ':' FOUND-ERROR
C
	GO TO 339
C
C	IF NO CHARACTERS SPECIFIED-ERROR
C
340	IF(I1.LE.1)GO TO 337
C
C	BLANK OUT ANY CHARS FOLLOWING ':'(INCLUDEING THE ':')
C
	IF(I1.LE.2)ANSWER(2)=' '
	IF(I1.LE.3)ANSWER(3)=' '
C
C	OUTPUT TO CONDITONAL FILE MACRO TO DEFINE LOCATION OF SCRATCH FILES
C
	WRITE(1,122)(ANSWER(II),II=1,3),(ANSWER(II),II=1,3)
122	FORMAT(' .MACRO WRKDEV',/,
	1 ' DBLK1: .RAD50 /',3A1,'SUPER TMP/',/,
	1 ' DBLK2: .RAD50 /',3A1,'FLOW  TMP/',/,
	1 ' .ENDM')
	GO TO 350
C
C	WRITE TO CONDITIONAL FILE MACRO TO DEFINE SCRATCH FILES
C	AT DEFAULT LOCATION
C
338	WRITE(1,122)'S','Y',' ','S','Y',' '
C

C
C	ALL O.S. COMMON Q/A CODE
C
C
C	GET LIST MODE-80/132 COLLUMN DEVICE
C
350	CALL GETSTR('LIST MODE FOR DEVICE (''TT:''/''LP:'') ? ',37,
	1 ANSWER,,0)
C
C	SEE IF LP OR TT/TI/KB WIDTHS
C
	IF(ANSWER(3).NE.':')GO TO 350
	IF((ANSWER(1).EQ.'T').AND.((ANSWER(2).EQ.'T').OR.
	1 (ANSWER(2).EQ.'I')))GO TO 352
	IF((ANSWER(1).EQ.'K').AND.(ANSWER(2).EQ.'B'))GO TO 352
	IF((ANSWER(1).EQ.'L').AND.(ANSWER(2).EQ.'P'))GO TO 351
	GO TO 350
C
C	WRTIE TO CONDITIONAL FILE-LP(WIDE) OUTPUT MODE
C
351	WRITE(1,130)
130	FORMAT(' LPMODE=1 ;OUTPUT IN LINE PRINTER MODE')
C
C	DOES HE WANT THE DEFAULT LINES/PAGE
C
352	NPAGE=60
	IF(.NOT.YESNO(
	1 'DEFAULT LINES PER PAGE IS 60 DO YOU WANT TO CHANGE IT ? '
	1 ,55,,0))GO TO 354
C
C	NO-FIND OUT JUST WHAT HE WANTS
C
	CALL GETNUM('HOW MANY LINES/PAGE ? ',22,NPAGE,20,32767,,0)
C
C	OUTPUT LINES/PAGE TO CONDITONAL FILE
C
354	WRITE(1,131)NPAGE
131	FORMAT(' PAGSIZ=',O6,' ;LINES/PAGE')
C
C	CHECK ON LEADING FORM FEED
C
	IF(.NOT.YESNO(
	1'DO YOU WANT THE FORM FEED AT THE BEGINING OF THE FIRST',54,
	1 'PAGE OF AN INDEX FILE TO BE ELIMINATED ? ',41,,0))GO TO 356
C
C	FORM FEED NOT WANTED-TELL IT TO CONDITONAL FILE
C
	WRITE(1,132)
132	FORMAT(' NOFF=1 ;NO FIRST PAGE FORM FEED')
C
C	TRAILING FORM FEED WANTED
C
356	IF(.NOT.YESNO(
	1 'DO YOU WANT A FORM FEED AT THE END',34,
	1 'OF THE LAST PAGE OF THE LISTING ? ',33))GO TO 240
	WRITE(1,136)
C
C	TELL CONDITIONAL FILE-TRAILINF FORM FEED WANTED
C
136	FORMAT(' TRFF=1')
C
C	DO YOU WANT SUPER INDEX ON ALL THE TIME
C
240	IF(.NOT.YESNO('DO YOU WANT SUPER INDEX (/S) DEFAULT ON ? ',42,,0
	1 ))GO TO 357
C
C	YES-TELL THE CONDITIONAL FILE SO
C
	WRITE(1,133)
133	FORMAT(' SPRIDX=1 ;/S SWITCH DEFAULT IS ON ')
C
C	DOU YOU WANT TO BE ABLE TO USE THE FLEX LINE NUMBERS IF WANTED
C
357	IF(.NOT.YESNO(
	1 'DO YOU WANT THE ABILITY TO USE PRE-PROCESSOR LINE',50,
	1 'NUMBERS (/P SWITCH) ? ',22))GO TO 358
C
C	YES-TELL IT TO THE CONDITONAL FILE
C
	WRITE(1,134)
134	FORMAT(' PREPRC=1')
C
C	ON GRAPHICAL PRINT OUT-HOW DEEP DO  YOU WANT TO BE ABLE TO NEST
C
358	CALL GETNUM(
	1 'HOW DEEP DO YOU WANT TO FOLLOW NESTED SUBROUTINE CALLS',54,
	1 INDENT,32,32767,
	1 'ON THE INDENTED CALLING TREE (32 MIN) ? ',40)
C
C	TELL IT TO THE CONDITIONAL FILE
C
	WRITE(1,135)INDENT
135	FORMAT(' INDENT=',O6)
C
C	ALL QUESTIONS ANSWERED-PUT LAST WRITE TO CONDITIONAL FILE
C	ALLOWING FOLLOWING CODE TO BE LISTED ON ASSEMBLY
C
	WRITE(1,199)
199	FORMAT(' .LIST')
C
C	CLOSE CONDITIONAL ASSEMBLY FILE
C
	CLOSE(UNIT=1)
	STOP '-- ISSUE "@INDEX" COMMAND'
	END
	LOGICAL FUNCTION YESNO(PRMT,LPRMT,PRMT2,LPRMT2)
C
C	FUNCTION TO ASK A YES OR NO QUESTION AND RETURN
C	EITHER .TRUE. (YES) OR .FALSE.(NO)
C
	BYTE PRMT(LPRMT),ANSWER,PRMT2(1)
C
C	ASK THE QUESTION
C
1	CALL PROMPT(PRMT,LPRMT,PRMT2,LPRMT2)
C
C	GET THE ANSWER
C
	READ(5,101,ERR=1,END=50)ANSWER
101	FORMAT(A1)
C
C	SET DEFAULTS AND CHECK IF ANSWER IS OK
C
	J=3
	YESNO=.FALSE.
	IF(ANSWER.EQ.'N')J=1
	IF(ANSWER.EQ.'Y')J=2
C
C	TAKE APPROPRIATE ACTION
C	TO SET 'YESNO' OR REPROMPT IF ANSWER NOT CORRECT
C
	GO TO (10,20,1)J
20	YESNO=.TRUE.
10	RETURN
50	STOP 'IDXGEN INCOMPLETE'
	END
	SUBROUTINE GETNUM(PRMT,LPRMT,N,LOW,HIGH,PRMT2,LPRMT2)
C
C	SUBROUTNE TO ASK FOR A NUMBER WITHIN THE LIMITS ALLOWED
C
	INTEGER HIGH
	BYTE PRMT(LPRMT),PRMT2(1)
C
C	ASK THE QUESTION
C
1	CALL PROMPT(PRMT,LPRMT,PRMT2,LPRMT2)
C	GET THE ANSWER
C
	READ(5,101,ERR=1,END=50)N
101	FORMAT(I6)
C
C	IF NOT IN ALLLOWED RANGE-REPROMPT
C
	IF((N.LT.LOW).OR.(N.GT.HIGH))GO TO 1
	RETURN
50	STOP 'IDXGEN INCOMPLETE'
	END
	SUBROUTINE PROMPT(PRMT,LPRMT,PRMT2,LPRMT2)
	BYTE PRMT(LPRMT),PRMT2(1)
C
C	SUBROUTINE TO ASK QUESTION-EITHER ONE OR TWO LINES
C
C	IF A TWO LINE QUESTION-HANDLE ELSEWARE
C
	IF(LPRMT2.NE.0)GO TO 2
C
C	OUPUT ONE LINE QUESTION WITHOUT TRAILING <CR>
C
	WRITE(5,100)(PRMT(I),I=1,LPRMT)
100	FORMAT(/,1H$,80(A1:))
	RETURN
C
C	OUTPUT FIRST LINE OF QUESTION
C
2	WRITE(5,102)(PRMT(I),I=1,LPRMT)
102	FORMAT(/,1X,80(A1:))
C
C	OUTPUT SECOND LINE OF QUESTION WITH NO TRAILING <CR>
C
	WRITE(5,103)(PRMT2(I),I=1,LPRMT2)
103	FORMAT(1H$,80(A1:))
	RETURN
	END
	SUBROUTINE GETSTR(PRMT,LPRMT,ANSWER,PRMT2,LPRMT2)
C
C	SUBROTUINE TO ASK QUESTION AND RETURN A STRING ANSWER
C
	BYTE PRMT(LPRMT),PRMT2(1),ANSWER(16)
C
C	ASK THE QUESTION
C
1	CALL PROMPT(PRMT,LPRMT,PRMT2,LPRMT2)
C
C	GET THE ANSWER
C
	READ(5,101,ERR=1,END=50)ANSWER
101	FORMAT(16(A1:))
	RETURN
50	STOP 'IDXGEN INCOMPLETE'
	END
