!Modified 5/May/82 16.30 !********************** EXPORT LIST ! ! %STRING(83) %FNSPEC ACCEPT INPUT %HALFINTEGERFNSPEC PROMPT FILE DEFIN{ITION} (%INTEGER DSNUM , %HALFINTEGER ACTION,FILE TYPE, %INTEGERNAME FD TABLE ADDR) !********************** IMPORT LIST ! ! %EXTERNALHALFINTEGERFNSPEC OPEN FD (%INTEGER DSNUM , RECL, %HALFINTEGER ACCESS, FORM, STATUS, %HALFINTEGER ACCESS ROUTE, BLANKS, %INTEGERNAME ADDR OF FD TABLE , %STRINGNAME FULL FILENAME ) %EXTERNALHALFINTEGERFNSPEC FILE EXISTENCE (%STRINGNAME FULL FILENAME ) %EXTERNALINTEGERFNSPEC LOCATE FILENAME (%STRINGNAME FULL FILENAME ) %EXTERNALROUTINESPEC EXTEND FILENAME (%INTEGER ADDR OF NAME , %HALFINTEGER FLAGS) %EXTERNALROUTINESPEC GET LINE (%INTEGER ADDR OF BUFFER, %HALFINTEGERNAME LINE LEN) %externalstring(83) %fn accept input %byteintegerarrayformat bfm(0:83) %byteintegerarrayname b %string(83) s,front,back %halfinteger i s = " " getline(addr(s)+1,i) length(s)=i+1 %cycle %if s ->front.(" ").back %then s=front.back %else %exit %repeat %if length(s)>0 %start b == array(addr(s),bfm) %cycle i=1,1,length(s) %if 'A' <= b(i) <= 'Z' %then b(i) = b(i) + 32 %repeat %finish %result=s %end %EXTERNALHALFINTEGERFN PROMPT FILE DEFIN{ITION} ( %C %INTEGER DSNUM , %HALFINTEGER ACTION, FILE TYPE, %INTEGERNAME AFD) ! ! ! ! ! A Procedure to Prompt the User for what Action to take ! ! when an attempt is made to perform I/O on a unit ! ! that is not defined. ! ! !Parameters: DSNUM = the undefined unit ! ACTION= the I/O attempted (same values as for NEW FILE OP) ! FILE TYPE= 0 for unformatted DA access ! = 1 for formatted DA access ! = 2 for unformatted SQ access ! = 3 for formatted SQ access ! = 4 for Rewind/Endfile/Backspace ! ! !At Exit: RESULT=151 if the user wants to stop ! RESULT= 0 if the user supplied a definition ! and AFD=address of FD Table ! RESULT> 0 if a fault was reported after the user supplied ! a file definition ! ! ! %ROUTINESPEC GIVE EXPLANATION (%HALFINTEGER HELP ID) %HALFINTEGERFNSPEC ANALYSE REPLY (%STRING(83) REPLY , %STRINGARRAYNAME POSSIBLE REPLIES, %HALFINTEGER ARRAY SIZE ) !-----CONSTANTS ! ! %CONSTHALFINTEGER The Console= 0, TXT File= 1, DTA File= 2 {ACCESS ROUTE's} %CONSTHALFINTEGER Sequential= 0, Direct= 1 {ACCESS types } %CONSTHALFINTEGER Unformatted= 0, Formatted= 1 { FORM types } %CONSTHALFINTEGER Scratch= 1, New= 2, Old= 3 {STATUS types } %CONSTHALFINTEGER None= 0, Not Set= 0 %CONSTHALFINTEGER False= 0 %CONSTHALFINTEGER True= 1 %CONSTHALFINTEGER Read= 1 %CONSTHALFINTEGER Unit Not Defined= 151 %CONSTHALFINTEGER Max Maxrec = 1024 !-----STRING CONSTANTS: ! ! %CONSTSTRING( 9) %ARRAY ACTION TEXT ( 1 {Read}: 5 {Endfile}) %C = "Read" , "Write" , "Rewind" , "Backspace" , "Endfile" %CONSTSTRING(12) %ARRAY ACCESS TEXT ( Sequential : Direct) %C = " sequential " , " direct " %CONSTSTRING(11) %ARRAY FORM TEXT (Unformatted:Formatted) %C = "unformatted" , "formatted" %CONSTSTRING( 4) %ARRAY BLANKS REPLIES (0:1)= "null" , "zero" %CONSTSTRING( 3) %ARRAY STOP REPLIES (0:1)= "yes" , "no" !The Following Arrays are Used to Offer the User a variable File Type %C Option list which is dependent upon the type of I/O attempted ! ! %CONSTSTRING(27) %ARRAY POSSIBLE TYPES (0:3) %C %C = "[console],permanent" , "[console],permanent,scratch" , "permanent,[scratch]" , "[permanent],scratch" %CONSTSTRING( 9) %ARRAY TYPE REPLIES (0:2)= "console" , "permanent", "scratch" %CONSTHALFINTEGERARRAY INVALID TYPE REPLIES (3:8)= %C %C 2 {for sq fmt read }, 0 {for da unf write}, 0 {for da fmt write} , 0 {for sq unf write}, 99 {for sq fmt write}, 0 {for rewind/endfile/bsp} ! !each element identifies the TYPE REPLY that is not ! acceptable for the corresponding I/O type %CONSTHALFINTEGERARRAY POSSIBLE TYPES ID (3:8)= %C %C 0 {for sq fmt read }, 3 {for da unf write}, 3 {for da fmt write} , 2 {for sq unf write}, 1 {for sq fmt write}, 2 {for rewind/endfile/bsp} ! !each element identifies the appropriate option list ! as given in POSSIBLE TYPES above %CONSTHALFINTEGERARRAY DEFAULT TYPE ID (3:8) %C %C = 1 {=>console}, 2 {=>permanent}, 2 {=>permanent}, 3 {=>scratch}, 1 {=>console }, 3 {=>scratch } !%C DEFAULT TYPE ID identifies the default File Type to be assumed %C if the user types CR/LF !-----FILENAME VARIABLES ! ! %STRING( 83) TEXT {user supplied filename} %STRING(100) FULL FILENAME {user supplied filename as a full system name} %STRING( 50) SUFFIX {suffix supplied with the filename} %STRING( 90) R {string resolution work variable} !-----CONNECTION SPECIFIC VARIABLES: ! ! %HALFINTEGER ACCESS %C ROUTE {=console (0) or TXT File (1) or DTA File (2)} %HALFINTEGER ACCESS {= direct (1) or sequential (0)} %HALFINTEGER BLANKS {= null (0) or zero (1)} %HALFINTEGER STATUS {= new (2) or scratch (1) or old (3)} %HALFINTEGER FORM {=unfmted (0) or formatted (1)} %INTEGER RECL {logical record length for new/scratch DA-files} !-----RECL SPECIFIC VARIABLES: ! ! %BYTEINTEGERARRAYNAME DIGITS {mapped onto } %BYTEINTEGERARRAYFORMAT FORM OF DIGITS (0:83) { TEXT above} ! %HALFINTEGER X {next digit from DIGITS } %HALFINTEGER L {number of digits in DIGITS } %INTEGER I { cycle variable through DIGITS} !-----UTILITY VARIABLES: ! ! %INTEGER FD ADDR; !an address of an FD Table %HALFINTEGER TEXT ID; !identifier of reply in TEXT %HALFINTEGER IO TYPE; !identifies the I/O operation attempted %C %C IO TYPE= 0 if da unf read and = 1 if da fmt read , = 2 if sq unf read and = 3 if sq fmt read , = 4 if da unf write and = 5 if da fmt write, = 6 if sq unf write and = 7 if sq fmt write, and = 8 if rewind/bsp/endfile !Initialise Variables: ! IO TYPE=FILE TYPE ! ( (ACTION>>1)<<2 ) IO TYPE= 8 %IF IO TYPE>7 !Print the Introduction: ! PRINT STRING ("Unit " ); WRITE(DSNUM,1) PRINT STRING (" Not Defined ("); %UNLESS IO TYPE=8 %THENSTART ACCESS=1-(FILE TYPE>> 1) FORM= FILE TYPE & 1 ! PRINT STRING ( FORM TEXT ( FORM)) PRINT STRING (ACCESS TEXT (ACCESS)) %FINISHELSE ACCESS= Sequential %C {AND FORM is unknown} %C %AND ACTION= (ACTION>>3)+3 PRINT STRING (ACTION TEXT (ACTION)) PRINT SYMBOL (')') JUMP0: NEWLINE JUMP1: ! ! Ask if the User wants to Stop ! PRINT STRING (" Do you wish to stop :") TEXT ID= ANALYSE REPLY (ACCEPT INPUT,STOP REPLIES,2{possibles}) %IF TEXT ID< 0 %THENSTART ! %IF TEXT ID=-1 %THEN GIVE EXPLANATION (1) -> JUMP 1 %FINISH %IF TEXT ID= 1 %THENRESULT=Unit Not Defined {----he wants to stop} !%C So The User Wants To Continue: ! %C So if IO TYPE= 0 (unf da read) %C or IO TYPE= 1 (fmt da read) %C or IO TYPE= 2 (unf sq read) we must have a permanent file that exists %IF IO TYPE> 2 %THENSTART ! ! ! Ask the User what he wants to connect to ! ! NEWLINE JUMP2: PRINT STRING (" Enter File Type <") PRINT STRING (POSSIBLE TYPES %C (POSSIBLE TYPES ID (IO TYPE))) PRINT STRING (",?>:") TEXT ID= ANALYSE REPLY(ACCEPT INPUT,TYPE REPLIES, 3{possible valid answers}) %IF TEXT ID< 0 %THENSTART ! %IF TEXT ID=-1 %THEN GIVE EXPLANATION (2) -> JUMP 2 %FINISH %IF TEXT ID= 0 %THEN TEXT ID= DEFAULT TYPE ID (IO TYPE) %C %ELSESTART %IF TEXT ID= INVALID TYPE REPLIES (IO TYPE) +1 %C %THEN PRINT STRING ("Cannot Do:") %AND -> JUMP2 %FINISH %IF TEXT ID\= 2 %THENSTART {ie Not a permanent file} ! FULL FILENAME= "" STATUS = Scratch %IF TEXT ID = 1 %THENSTART ! ! The User Wants to Connect to the Console ! ACCESS ROUTE = The Console BLANKS= 1 RECL = 0 -> OPEN THE UNIT %FINISHELSE ACCESS ROUTE=DTA File %AND -> ASK OTHER QUESTIONS %FINISH %FINISH ! ! ! Ask the User for a File Name ! ! NEWLINE JUMP3: PRINT STRING (" Enter File Name:") TEXT= ACCEPT INPUT %IF TEXT= "" %THEN PRINT STRING ("No Defaults:") %AND -> JUMP3 %IF TEXT= "?" %ORC TEXT= "/help" %THENSTART GIVE EXPLANATION (3) -> JUMP 3 %FINISH ! ! Check the Type of File Specified ! %IF TEXT-> R . (".") . SUFFIX %THENSTART ! %IF SUFFIX= "dta" %THEN ACCESS ROUTE= DTA File %C %ELSESTART %IF FILE TYPE< 3 %THEN PRINT STRING ("File Is Not Suitable: ") %C %AND -> JUMP 1 %C %ELSE ACCESS ROUTE= TXT File %FINISH %FINISHELSE %C %IF FILE TYPE< 3 %THEN TEXT= TEXT . ".dta" %C %AND ACCESS ROUTE= DTA File %C %ELSE ACCESS ROUTE= TXT File ! ! Check if the File is Already Connected ! FULL FILENAME=TEXT EXTEND FILE NAME (ADDR (FULL FILENAME),0) ! FD ADDR= LOCATE FILENAME (FULL FILENAME) %UNLESS FD ADDR= None %THENSTART ! ! Tell the User he cant have the file on two units ! PRINT STRING ("File is Already Connected To Unit") WRITE (INTEGER(FD ADDR+4),1) NEWLINE PRINT STRING ("Try Again: ") -> JUMP1 %FINISH ! ! Now See If the File Exists ! %IF FILE EXISTENCE(FULL FILENAME)=False %THENSTART ! %IF ACTION= Read %THEN PRINT STRING ("File Does Not Exist:") %C %AND -> JUMP 1 STATUS= New %FINISHELSE STATUS= Old ASK OTHER QUESTIONS: ! ! ! Now Get Any Other Pertinent Information ! ! %IF IO TYPE=8 %THENSTART %IF ACCESS ROUTE=DTA File %THENSTART ! NEWLINE JUMP6: PRINT STRING (" Enter Form :") TEXT ID= ANALYSE REPLY (ACCEPT INPUT,FORM TEXT,2) %IF TEXT ID< 0 %THENSTART ! %IF TEXT ID=-1 %THEN GIVE EXPLANATION (4) -> JUMP 6 %FINISH %IF TEXT ID= 1 %THEN FORM=Unformatted %C %ELSE FORM= Formatted %FINISH %ELSE FORM= Formatted %FINISH %IF ACCESS=Direct %AND STATUS\=Old %THENSTART ! ! Ask the User for the Record Length of the New/Scratch DA-File ! NEWLINE JUMP7: PRINT STRING (" Enter Record Length:") TEXT= ACCEPT INPUT %IF TEXT= "?" %OR TEXT="/help" %THENSTART ! GIVE EXPLANATION (5) -> JUMP7 %FINISH %IF TEXT="" %THEN PRINT STRING ("No Defaults:") %AND -> JUMP 7 ! ! Prepare to Decode Characters into a number ! DIGITS== ARRAY(ADDR(TEXT), FORM OF DIGITS) L = LENGTH(TEXT) RECL = 0 ! ! Decode the Characters into a Record Length ! %CYCLE I=1,1,L ! X=DIGITS (I) - '0' %IF X< 0 %OR %C X>10 %THEN -> JUMP8 ! RECL= X + (RECL*10) %IF RECL> Max Maxrec %THEN PRINT STRING ("Too Large - ") %C %AND -> JUMP 8 %REPEAT %IF RECL= 0 %THENSTART ! JUMP8: PRINT STRING ("Try Again:") -> JUMP7 %FINISH %FINISHELSE RECL = Not Set !---LAST QUESTION: ! %IF FORM=Formatted %THENSTART; NEWLINE ! JUMP9: PRINT STRING (" Enter Blanks <[null],zero,?>:") TEXT ID= ANALYSE REPLY (ACCEPT INPUT,BLANKS REPLIES,2) %IF TEXT ID< 0 %THENSTART ! %IF TEXT ID=-1 %THEN GIVE EXPLANATION (6) -> JUMP 9 %FINISH %IF TEXT ID= 2 %THEN BLANKS=1 { significant} %C %ELSE BLANKS=0 {not significant} %FINISH %ELSE BLANKS=0 ! ! FINALLY CONFIRM ASSUMED USER INTENTIONS ! %IF STATUS\=Scratch %THENSTART; NEWLINE ! JUMP10: PRINT STRING ("Confirm ") PRINT STRING ( FULL FILENAME) PRINT STRING (" <[y],n>:") TEXT ID= ANALYSE REPLY (ACCEPT INPUT,STOP REPLIES,2) %IF TEXT ID< 0 %THEN -> JUMP10 %IF TEXT ID= 2 %THEN -> JUMP1 %IF STATUS=Old %AND (6<=IO TYPE<=7 %OR ACTION={Endfile} 5) %THENSTART; NEWLINE ! ! WARN THE USER HE IS WRITING TO AN OLD FILE ! PRINT STRING ("Did you know ") PRINT STRING ( FULL FILENAME ) PRINT STRING (" already exists?") NEWLINES (2) JUMP11: PRINT STRING (" Re-affirm ") PRINT STRING ( FULL FILENAME ) PRINT STRING (" :") TEXT ID= ANALYSE REPLY (ACCEPT INPUT,STOP REPLIES,2) %IF TEXT ID< 0 %THEN -> JUMP11 ! -> JUMP0 %IF TEXT ID\= 1 ! %FINISH %FINISH !NOW OPEN THE FILE from scratch ! ! That is: Get a File Definition Table ! Open the File logically ! and Open the File physically ! OPEN THE UNIT: ! ! %RESULT= OPEN FD (DSNUM,RECL,ACCESS,FORM, STATUS, ACCESS ROUTE, BLANKS, AFD,FULL FILENAME) %HALFINTEGERFN ANALYSE REPLY (%STRING(83) REPLY , %STRINGARRAYNAME POSSIBLE REPLIES, %HALFINTEGER NUMBER OF POSSIBLES) ! ! ! ! ! A Utility Procedure which, given a user reply to a prompt ! ! and a list of permissible replies, will attempt to ! ! identify the response given. ! ! !NOTE: It is assumed that the user reply has been preprocessed by ACCEPT INPUT !NOTE: It is also assumed that one character is sufficient to distinguish ! between the various possible permissible replies. !NOTE: It is also assumed that the list of possible replies is ! a string array starting at element zero. ! ! ! At Exit: RESULT=-2 if the reply was not recognied ! RESULT=-1 if the reply was '?' ! RESULT= 0 if the reply was empty (ie CR/LF) ! RESULT= 1 if the reply was the 1st possible reply ! RESULT= 2 if the reply was the 2nd possible reply ! RESULT= etc ! ! ! %HALFINTEGER REPLY LEN; !length of user reply %HALFINTEGER L ; ! work variable (=NUMBER OF POSSIBLES-1) %INTEGER I ; ! cycle variable (through POSSIBLE REPLIES) ! %STRING(15) NEXT {possible reply} %IF REPLY= "" %THENRESULT= 0 {=> take the default (whatever it is) } %IF REPLY="?" %THENRESULT= -1 {=> give the relevant HELP information} !Initialise Variables: ! REPLY LEN= LENGTH(REPLY) L = NUMBER OF POSSIBLES -1 %CYCLE I=0,1,L ! ! Look for a Match ! NEXT = POSSIBLE REPLIES (I) ! %IF LENGTH(NEXT)< REPLY LEN %THENCONTINUE LENGTH(NEXT)= REPLY LEN %RESULT=I+1 %IF REPLY=NEXT %REPEAT %IF REPLY="/help" %THENRESULT=-1 PRINT STRING ("Try Again") %ANDRESULT= -2 {if the reply was not recognised} ! %END; !of ANALYSE REPLY %ROUTINE GIVE EXPLANATION (%HALFINTEGER HELP ID) ! ! ! ! ! A Utility Procedure to Print Help Information in response ! ! to a '?' typed by the User when prompted for information. ! ! !The Parameter takes one of the following values: ! %C 1 => give help to DO YOU WISH TO STOP, 2 => give help to ENTER FILE TYPE, 3 => give help to ENTER FILE NAME, 4 => give help to ENTER FORM, 5 => give help to ENTER RECORD LENGTH, 6 => give help to ENTER BLANKS ! %SWITCH EXPLAIN (1:6); NEWLINE -> EXPLAIN (HELP ID) EXPLAIN (1): !DO YOU WISH TO STOP ! ! PRINT STRING ( %C "You have the opportunity of continuing execution by supplying details of an appropriate connection to prompts given subsequently.") PRINT STRING (" If you do not want to define the unit then program execution will be stopped and you will have the opportunity to obtain diagnostics. "); PRINT STRING ( %C "Reply: Yes if you want to stop (with diagnostics) Reply: No if you want to continue (and supply a channel definition) "); PRINT STRING ( %C "Note that some prompts enclose the options within angled brackets as in DO YOU WANT TO STOP : .The default reply is enclosed within square brackets. "); PRINT STRING ( %C "When replying to a prompt you may type either the full option or as many characters as will uniquely identify it. Upper and lower case characters are interchangable. "); PRINT STRING ( %C " Reply ? to a prompt if you want help or press the HELP key. "); -> RETURN EXPLAIN (2): !ENTER FILE TYPE ! ! PRINT STRING ( %C "The options that are offered within the angled brackets represent the type of file to which Unit") WRITE (DSNUM,0) PRINT STRING (" may be connected.") NEWLINES (2) %IF FILETYPE=3 %THENSTART ! PRINT STRING ( %C "Reply: Console if you want output from this unit to be directed to the screen or if you want to type in data interactively. "); PRINT STRING ( %C " Program execution will be resumed if this option is selected and any blanks found within numeric input fields will regarded as zeros. "); NEWLINE %FINISH %IF IO TYPE\=3 %THENSTART ! PRINT STRING ( %C "Reply: Scratch if you do not want to keep any output from this unit after your program has finished. Scratch files have the property that they are deleted either when the "); PRINT STRING ( %C " unit is closed or when the program stops. "); NEWLINE %FINISH PRINT STRING ( %C "Reply: Permanent if you want to connect to an existing data file") PRINT STRING (" or if you want to create a new file") %IF ACTION\=Read PRINT STRING (". "); -> RETURN EXPLAIN (3): !ENTER FILE NAME ! ! PRINT STRING ( %C "Reply with the name of the file to be connected. The name supplied need not be a full path name, but it must be one that is acceptable to the Operating System. "); NEWLINE %IF IO TYPE< 7 %THENSTART ! PRINT STRING ("Note that for this unit, ") %IF FILE TYPE<3 %THENSTART ! PRINT STRING ( %C "a filename with the suffix "".DTA"" is required/or will be assumed") PRINT STRING (", and also ") %IF ACTION=Read %FINISH %IF ACTION=Read %THENSTART ! PRINT STRING ("the given file must exist") %FINISH PRINT STRING (". "); NEWLINE %FINISH PRINT STRING ( %C "Before resuming execution you will be asked to confirm the file name. "); -> RETURN EXPLAIN (4): !ENTER FORM ! ! PRINT STRING ( %C "The FORTRAN77 Standard requires the Form of a connection, that is whether a unit is to be used for formatted or unformatted I/O, to be set at the time the unit is open. So "); PRINT STRING ("Reply: Formatted if Unit") WRITE ( DSNUM,0) PRINT STRING (" is to be used to read or write formatted (character) data. Reply: Unformatted if Unit") WRITE ( DSNUM,0) PRINT STRING (" is to be used to read or write unformatted (binary) data. Note that the Standard prohibits a mixture of formatted and unformatted I/O for a given connection. "); -> RETURN EXPLAIN (5): !ENTER RECORD LENGTH ! ! PRINT STRING ( %C "One of the properties of a FORTRAN77 Direct-Access File is that all its records are of equal length. The record length should be at least as large as the largest logical record to be written or read from the file. "); PRINT STRING ( %C "Reply: an integer value (in the range 1 to 1024) Note that there are no defaults for this prompt. "); -> RETURN EXPLAIN (6): !ENTER BLANKS ! ! PRINT STRING ( %C "The BN and BZ edit descriptors control the interpretation of spaces other than leading spaces in numeric input fields. If no BN or BZ edit descriptor occurs within a format specification the default action is a property of the connection. Hence "); PRINT STRING ( %C "Reply: Null if, by default, any blank character found embedded within a numeric input field is to be ignored. "); PRINT STRING ( %C "Reply: Zero if, by default, any blank character found embedded within a numeric input field is to treated as a zero. "); PRINT STRING ( %C "Note that this option affects only I, F, E, D or G editing during execution of an input statement. It has no effect during execution of an output statement. "); RETURN: NEWLINE ! %END; !of GIVE EXPLANATION %END; !of PROMPT FILE DEFIN{ITION} %ENDOFFILE