*DECK LFGGFN PROC LFGGFN(TABLE,FILECNT); BEGIN # GET FILE NAMES # *IF,DEF,IMS # ** LFGGFN - GET FILE NAMES. * * D.K. ENDO 81/12/15 * * LFGGFN ATTEMPTS TO BUILD THE FILE NAME TABLE FROM THE INPUT * DIRECTIVES GIVEN. * * PROC LFNGFN(TABLE,FILECNT) * * ENTRY NONE. * * EXIT TABLE = TABLE CONTAINING FILE NAMES. * FILECNT = NUMBER OF ENTRIES IN TABLE. * * MESSAGES DIRECTIVE FILE EMPTY. * DIRECTIVE ERRORS DETECTED. * * METHOD * * WRITE HEADER FOR LISTING. * READ FIRST CARD. * IF FILE IS NOT EMPTY * THEN * FOR EACH CARD WHILE NOT END OF RECORD, * GET FIRST TOKEN. * IF TOKEN IS AN ASTERISK, * GET NEXT TOKEN. * IF TOKEN IS NOT THE KEYWORD -FILE-, * FLAG ERROR -- NO DIRECTIVE. * GET NEXT TOKEN. * FOR EACH TOKEN UNTIL END OF CARD, * SELECT CASE THAT APPLIES, * CASE 1(NAME): * IF LENGTH OF NAME IS NOT GREATER THAN MAXIMUM, * THEN, * PUT NAME IN TABLE * INCREMENT FILE NAME COUNT. * OTHERWISE, * FLAG ERROR -- FILE NAME TOO LONG. * CASE 2(DELIMITER): * IF TOKEN IS A COMMA * THEN, * IF COMMA WAS ALREADY SPECIFIED, * FLAG ERROR -- CONSECUTIVE COMMAS. * OTHERWISE, * FLAG ERROR -- ASTERISK IS INVALID DELIMITER. * CASE 3(UNKNOWN CHARACTER): * FLAG ERROR -- INVALID DELIMITER. * CASE 4(EOC): * SET END OF CARD FLAG. * IF NO FILE NAMES WERE SPECIFIED * FLAG ERROR -- NO FILE NAMES * IF LISTING FLAG SET OR ERROR DETECTED ON LINE, * WRITE DIRECTIVE CARD TO OUTPUT FILE. * READ NEXT CARD. * OTHERWISE, * SEND DAYFILE MESSAGE -- EMPTY DIRECTIVE FILE. * ABORT. * IF ERRORS DETECTED IN DIRECTIVE FILE * SEND DAYFILE MESSAGE -- DIRECTIVE ERRORS DETECTED. * ABORT. * # *ENDIF ARRAY TABLE [0:0] S(1); # TABLE TO PUT FILE NAMES # BEGIN ITEM TBL$ENT C(00,00,10); # FILE NAME ENTRY # ITEM TBL$NUM I(00,00,60); # NUMBER ENTRY # END ITEM FILECNT; # FILE COUNT # # **** PROC LFGGFN - XREF LIST BEGINS. # XREF BEGIN PROC ABORT; # ABORTS JOB ON REQUEST # ITEM INPUT; # DIRECTIVE FILE FET # PROC LFGGNT; # GET NEXT TOKEN # PROC LFGLHDR; # WRITES LISTING HEADER # PROC LFGWL; # WRITES LINE TO OUTPUT FILE # PROC MESSAGE; # SENDS MESSAGE TO DAYFILE # ITEM OUTPUT; # OUTPUT FET # PROC READH; # READ INPUT DIRECTIVE IN -H- FORMAT # PROC WRITER; # FLUSH CIO BUFFER AND WRITE EOR # END # **** # DEF ECODE1 # 1 #; # INDEX FOR MESSAGE ONE. # DEF ECODE2 # 2 #; # INDEX FOR MESSAGE TWO. # DEF ECODE3 # 3 #; # INDEX FOR MESSAGE THREE # DEF ECODE4 # 4 #; # INDEX FOR MESSAGE FOUR # DEF ECODE5 # 5 #; # INDEX FOR MESSAGE FIVE # DEF LFN$MXL # 7 #; # MAXIMUM LENGTH FOR FILE NAME # DEF TRNS$OK # 0 #; # STATUS RETURN AFTER SUCCESSFUL READ # CONTROL NOLIST; # LFGSTAN COMMON DECK # *CALL LFGSTAN CONTROL LIST; ITEM ABRTFLG B; # ABORT FLAG # ITEM CARDCNT I; # DIRECTIVE CARD COUNT # ITEM COL I; # POINTER TO CURRENT CHARACTER # ITEM COMMA$FLG B; # COMMA FLAG # ITEM DIR$FLG B; # DIRECTIVE FLAG # ITEM EOC B; # END OF CARD FLAG # ITEM ERRLINE B; # DIRECTIVE ERROR INDICATOR # ITEM I I; # SCRATCH ITEM # ITEM J I; # SCRATCH ITEM # ITEM LENGTH; # LENGTH OF TOKEN # ITEM LFN$FLG B; # LOCAL FILE NAME FLAG # ITEM LSTNG$ID; # LISTING I.D. # ITEM STATIS I; # STATUS RETURNED ON READ # ITEM TOKEN C(10); # TOKEN RETURNED FOR DIRECTIVE LINE # ITEM TYPE I; # TOKEN TYPE # ARRAY DIR$BUFF [0:9] S(1); BEGIN # DIRECTIVE LINE BUFFER # ITEM DB$LINE C(00,00,90) = [" "]; ITEM DB$ZBYT I(09,00,60) = [0]; END ARRAY DIR$ERROR [0:0] S(3); BEGIN # DIRECTIVE ERROR MESSAGE # ITEM DE$MSG C(00,00,27) = [" DIRECTIVE ERRORS DETECTED."]; ITEM DE$ZBYT I(02,42,18) = [0]; END ARRAY EMPTY$FILE [0:0] S(3); BEGIN ITEM EF$MSG C(00,00,22) = [" EMPTY DIRECTIVE FILE."]; ITEM EF$ZBYT I(02,12,48) = [0]; END DEF MXET # 5 #; ARRAY ERRMSG$TABLE [00:MXET] S(6); BEGIN ITEM ERRMSG C(00,00,50) = [" ", " **** DIRECTIVE INDICATOR -FILE- NOT FOUND. ", " **** FILE NAME MUST BE 1 TO 7 CHARACTERS. ", " **** FILE NAME MUST BE DELIMITED BY ONE COMMA.", " **** COMMA AND/OR BLANKS ARE ONLY LEGAL DELIM.", " **** AT LEAST ONE FILE NAME MUST BE SPECIFIED.", ]; ITEM ERMS$ZBYT I(05,00,60) = [, 0, 0, 0, 0, 0, ]; END SWITCH GFNSWTCH UNKNOWN, NAME, DELIM, EO$CARD; CONTROL EJECT; FUNC ZFILL(NAME) C(10); BEGIN ITEM NAME C(10); ITEM CTEMP1 C(1); ITEM CTEMP2 C(10); ITEM I I; # # # ZFILL CODE BEGINS HERE # # # FOR I=0 STEP 1 UNTIL 9 # FOR EACH CHARACTER IN NAME # DO BEGIN CTEMP1 = CNAME; IF CTEMP1 EQ " " # CHARACTER IS BLANK # THEN BEGIN CCTEMP2 = 0; # REPLACE BLANK WITH ZERO # END ELSE # CHARACTER IS NON-BLANK # BEGIN CCTEMP2 = CTEMP1; # SAVE CHARACTER # END END ZFILL = CTEMP2; # RETURN ZERO FILLED NAME # RETURN; # **** RETURN **** # END CONTROL EJECT; # # # LFGGFN CODE BEGINS HERE # # # ABRTFLG = FALSE; # CLEAR ABORT FLAG # FILECNT = 0; # INITIALIZE FILE NAME COUNT # PAGEN = 1; # INITIALIZE PAGE COUNT # LSTNG$ID = DIR$LST; # SET LISTING ID # LFGLHDR(LSTNG$ID); # WRITE LISTING HEADER # READH(INPUT,DIR$BUFF[1],8,STATIS); # READ FIRST INPUT CARD # IF STATIS EQ TRNS$OK # IF READ WAS O.K. # THEN BEGIN # KEEP READING CARDS TILL NO MORE # FOR CARDCNT=0 STEP 1 WHILE STATIS EQ TRNS$OK DO BEGIN COL = 0; # SET COLUMN POINTER # EOC = FALSE; # CLEAR END OF CARD INDICATOR # ERRLINE = FALSE; # CLEAR ERROR LINE FLAG # COMMA$FLG = FALSE; # CLEAR COMMA FLAG # LFGGNT(TOKEN,COL,LENGTH,TYPE,DIR$BUFF[1]); # GET NEXT TOKEN # IF TOKEN EQ "*" # IF TOKEN IS -*-, THIS MUST # THEN # BE A DIRECTIVE INDICATOR # BEGIN LFGGNT(TOKEN,COL,LENGTH,TYPE,DIR$BUFF[1]); #GET NEXT TOKEN # IF TOKEN NQ "FILE" # IF TOKEN IS NOT -FILE- # THEN BEGIN # FLAG ERROR -- INVALID DIRECTIVE IND. # LFGWL(ERRMSG$TABLE[ECODE1],LSTNG$ID); ERRLINE = TRUE; # SET ERROR LINE FLAG # ABRTFLG = TRUE; # SET ABORT FLAG # END LFGGNT(TOKEN,COL,LENGTH,TYPE,DIR$BUFF[1]); # GET NEXT TOKEN# DIR$FLG = TRUE; # SET DIRECTIVE FOUND FLAG # END LFN$FLG = FALSE; # CLEAR FILE NAME FLAG # FOR J=0 WHILE NOT EOC DO # FOR EACH TOKEN TILL END OF CARD # BEGIN GOTO GFNSWTCH[TYPE]; # GOTO APPROPRIATE PARAGRAPH # NAME: IF LENGTH LQ LFN$MXL # IF FILE NAME IS NOT TOO LONG # THEN BEGIN LFN$FLG = TRUE; # SET FILE NAME FLAG # FILECNT = FILECNT + 1; # INCREMENT FILE COUNT # TBL$ENT[FILECNT] = ZFILL(TOKEN); # PUT NAME INTO TABLE # COMMA$FLG = FALSE; # CLEAR COMMA FLAG # END ELSE # FILE NAME TOO LONG # BEGIN # FLAG ERROR -- FILE NAME TOO LONG # LFGWL(ERRMSG$TABLE[ECODE2],LSTNG$ID); ERRLINE = TRUE; # SET ERROR LINE FLAG # ABRTFLG = TRUE; # SET ABORT FLAG # END GOTO NEXT; DELIM: IF TOKEN EQ "," # IF TOKEN IS COMMA # THEN BEGIN IF NOT COMMA$FLG # IF A COMMA WAS NOT PREVIOUSLY # THEN # SPECIFIED # BEGIN COMMA$FLG = TRUE; # SET COMMA FOUND FLAG # END ELSE # NO FILE NAME BETWEEN COMMAS # BEGIN # FLAG ERROR -- CONSECUTIVE COMMAS # LFGWL(ERRMSG$TABLE[ECODE3],LSTNG$ID); ERRLINE = TRUE; # SET ERROR LINE FLAG # ABRTFLG = TRUE; # SET ABORT FLAG # END END ELSE # TOKEN MUST BE AN ASTERISK # BEGIN # FLAG ERROR -- INVALID DELIMITER # LFGWL(ERRMSG$TABLE[ECODE4],LSTNG$ID); ERRLINE = TRUE; # SET ERROR LINE FLAG # ABRTFLG = TRUE; # SET ABORT FLAG # END GOTO NEXT; UNKNOWN: # FLAG ERROR -- INVALID DELIMITER # LFGWL(ERRMSG$TABLE[ECODE4],LSTNG$ID); ERRLINE = TRUE; # SET ERROR LINE FLAG # ABRTFLG = TRUE; # SET ABORT FLAG # GOTO NEXT; EO$CARD: EOC = TRUE; # SET END OF CARD FLAG # NEXT: LFGGNT(TOKEN,COL,LENGTH,TYPE,DIR$BUFF[1]); # GET NEXT TOKEN# END IF NOT LFN$FLG AND # IF NO FILE NAME SPECIFIED # DIR$FLG THEN BEGIN # FLAG ERROR -- NO FILE NAME SPECIFIED # LFGWL(ERRMSG$TABLE[ECODE5],LSTNG$ID); ERRLINE = TRUE; # SET ERROR LINE FLAG # ABRTFLG = TRUE; # SET ABORT FLAG # END IF LISTFLG OR # IF LISTING WAS REQUESTED OR # ERRLINE # ERROR WAS DETECTED # THEN BEGIN # WRITE INPUT DIRECTIVE # LFGWL(DIR$BUFF,LSTNG$ID); END # READ NEXT CARD # READH(INPUT,DIR$BUFF[1],8,STATIS); END END ELSE # EMPTY DIRECTIVE FILE # BEGIN MESSAGE(EMPTY$FILE,0); # SEND MESSAGE TO DAYFILE # ABORT; # **** ABORT **** # END IF ABRTFLG # IF ERROR WAS DETECTED # THEN BEGIN MESSAGE(DIR$ERROR,0); # SEND MESSAGE TO DAYFILE # WRITER(OUTPUT); # FLUSH CIO BUFFER # ABORT; # **** ABORT **** # END RETURN; # **** RETURN **** # END # LFGGFN # TERM