C - Find specified text in SAM or DAM files anywhere in tree. C Written in Fortran IV, routine is PR1ME dependent. C Routine must NOT be built as an EPF as it relies upon the C implicit initialization of SEG or RESUME for some array analysis. C Modification History C --------------------------------------------------------------------------- C 09/27/89 Allen Egerton RN 1.0, Original design/coding. Note that C tree traversing logic was lifted directly from FIND.FILE C program with only new logic being the search for actual text. C 11/21/89 Allen Egerton RN 1.1, modified attach logic. C 11/29/89 Allen Egerton RN 1.2, Removed BINARY check logic, C replacing with filtered output. C 02/06/90 Allen Egerton RN 2.0, Added option -BIN and set default C logic to skip files based upon standard naming conventions. C Added option -LBIN. C 02/15/90 Allen Egerton RN 2.1, Added option -COMO and set default C logic to skip files based upon standard naming conventions. C Added option -LCOMO. SUBROUTINE MAIN $INSERT SYSCOM>KEYS.INS.FTN $INSERT SYSCOM>ERRD.INS.FTN IMPLICIT INTEGER*2 (A-Z) INTEGER*2 RDBUFF(40), /* For parsing command line. + RDINFO(8) /* Ditto INTEGER*4 TOKEN4 /* Make token checking easy EQUIVALENCE (RDBUFF(1), TOKEN4) LOGICAL*2 CHKBIN, /* Check binary files too? + BINAME, /* Based on name, file is BINARY + LBIN, /* List binary names skipped? + CHKCOM, /* Check COMO files too? + CONAME, /* Based on name, file is COMO + LCOMO /* List como names skipped? PARAMETER MAXTXT = 20 /* Max number of strings to search for INTEGER*2 L4TEXT(40, MAXTXT), /* Look for Text, (what we search for) + L4LENT(MAXTXT), /* Look for text length. + LINE(67), /* Line from file. + HMF, /* How many found? + TYPES(28) /* File types to display LOGICAL*2 LSUB$A, FOUND, /* For comparison + SHWNAM, /* Should we show file name? + ITFILE /* In this file? (For linefeeds) C *** Arrays for following the tree structure. PARAMETER LEVELS = 200 /* Max levels of file system INTEGER*2 T$NAME(39, LEVELS), /* File Names in PLP format + T$UNIT(LEVELS), /* Unit file opened on. + T$LEVL, /* Level currently on. + CAPNAM(320) /* Current Attach Point C *** Individual entry in file system. INTEGER*2 ENTRY(31), /* File system entry + ECW, /* Entry Control Word, Type and Length + FILNAM(21), /* Filename & password in PLP format + PWPBIT, /* Password protection bit + NDPB, /* Non default protection bit + FINFO, /* 16 bits of file info + SPARE, + SPARE2, + TRUNC /* File truncated by fix_disk? INTEGER*2 OPASS(3), /* Owner password to ufd + NPASS(3) /* Non-Owner password to ufd. C *** Equivalence entry info into component parts. EQUIVALENCE (ECW, ENTRY(1)), + (PWPBIT, ENTRY(18)), + (NDPB, ENTRY(19)), + (FINFO, ENTRY(20)), + (DATEM, ENTRY(21)), + (TIMEM, ENTRY(22)), + (SPARE1, ENTRY(23)), + (SPARE2, ENTRY(24)), + (TRUNC, ENTRY(25)), + (DATEB, ENTRY(26)), + (TIMEB, ENTRY(27)), + (DATEC, ENTRY(28)), + (TIMEC, ENTRY(29)), + (DATEA, ENTRY(30)), + (TIMEA, ENTRY(31)) DATA TYPES /'Sam Dam Segsam Segdam ', + 'Subufd Acat Unknown '/ C *** Program Header. WRITE (1, 1) 1 FORMAT (/, '[Find.Text, Rev 20.2 - 22.1, RN 2.1, 2/90]') C *** See if software is licensed. CALL CHKLIC ('FIND.TEXT ') C *** Initialize command line options. CHKBIN = .FALSE. /* Don't check binary files LBIN = .FALSE. /* Don't list files skipped C *** Initialize textstring index. IL4TXT = 0 10 CONTINUE C *** Parse command line. CALL RDTK$$ (1, RDINFO, RDBUFF, 40, ERROR) CALL ERRPR$ (K$NRTN, ERROR, 'PARSE', 5, 'FIND.TEXT', 9) C *** See if we got a token. IF (RDINFO(2) .EQ. 0) GO TO 100 /* No more tokens IF (TOKEN4 .EQ. '-BIN') GO TO 20 IF (TOKEN4 .EQ. '-LBI') GO TO 30 IF (TOKEN4 .EQ. '-COM') GO TO 40 IF (TOKEN4 .EQ. '-LCO') GO TO 50 IF (TOKEN4 .EQ. '-HEL') GO TO 900 C *** Unknown command line option. CALL TNOUA ('Invalid option: "', 17) CALL TNOUA (RDBUFF, RDINFO(2)) CALL TNOUA ('". List Usage? (Y/N): ', 23) READ (1, 11) YESNO 11 FORMAT (A1) IF ((YESNO .EQ. 'Y') .OR. (YESNO .EQ. 'y')) WRITE (1, 901) CALL ERRPR$ (K$NRTN, E$NULL, 'Invalid command line option.', 28, + 'FIND.TEXT', 9) 20 CONTINUE C *** Token of -BIN CHKBIN = .TRUE. GO TO 10 30 CONTINUE C *** Token of -LBIN LBIN = .TRUE. GO TO 10 40 CONTINUE C *** Token of -COMO CHKCOM = .TRUE. GO TO 10 50 CONTINUE C *** Token of -LCOMO LCOMO = .TRUE. GO TO 10 100 CONTINUE C *** Prompt for and get search string. CALL TNOUA ('Text to look for: ', 18) CALL COMANL CALL RDTK$$ (4, RDINFO, RDBUFF, 40, ERROR) CALL ERRPR$ (K$NRTN, ERROR, 'PARSE', 5, 'FIND.TEXT', 9) C *** Did we get anything for this prompt? IF (RDINFO(2) .EQ. 0) GO TO 120 /* Nothing input. C *** Got a text string, put it in array appropriately. IL4TXT = (IL4TXT + 1) L4LENT(IL4TXT) = RDINFO(2) NWORDS = RS((RDINFO(2) + 1), 1) DO 110 IW = 1, NWORDS L4TEXT(IW, IL4TXT) = RDBUFF(IW) 110 CONTINUE C *** Go get another. GO TO 100 120 CONTINUE C *** No more text, have we got anything to search for? IF (IL4TXT .GT. 0) GO TO 140 /* Yup C *** Didn't get anything at all to search for, message and exit. CALL ERRPR$ (K$NRTN, E$NULL, 'No text supplied for search.', 28, + 'FIND.TEXT', 9) 140 CONTINUE C *** Got necessary parameters, display and check. CALL TONL CALL TNOUA ('BINARY files will ', 18) IF (.NOT. (CHKBIN)) CALL TNOUA ('NOT ', 4) CALL TNOU ('be checked.', 11) IF (CHKBIN) LBIN = .FALSE. IF (LBIN) CALL TNOU + ('Names of skipped BINARY files will be displayed.', 48) CALL TNOUA ('COMO files will ', 16) IF (.NOT. (CHKCOM)) CALL TNOUA ('NOT ', 4) CALL TNOU ('be checked.', 11) IF (CHKCOM) LCOMO = .FALSE. IF (LCOMO) CALL TNOU + ('Names of skipped COMO files will be displayed.', 46) CALL TONL CALL TNOUA ('Okay to begin search? (Y/N): ', 31) READ (1, 141) YESNO 141 FORMAT (A1) CALL TONL IF ((YESNO .EQ. 'N') .OR. (YESNO .EQ. 'n')) + CALL ERRPR$ (K$NRTN, E$NULL, 'Aborted by User.', 16, + 'FIND.TEXT', 9) C *** Initialize variables. T$LEVL = 1 NORITC = 0 C *** Okay, let's start processing. CALL TONL CALL TNOUA ('''*'' = ', 6) CALL GPATH$ (K$CURA, DUMMY, CAPNAM, 320, CAPLEN, ERROR) CALL ERRPR$ (K$NRTN, ERROR, 'Unable to get Attach point.', 27, + 'FIND.TEXT', 9) CALL TNOU (CAPNAM, CAPLEN) 200 CONTINUE C *** Open current directory for reading, (start processing new level). CALL SRCH$$ (K$READ+K$GETU, K$CURR, 0, T$UNIT(T$LEVL), T, ERROR) CALL ERRPR$ (K$NRTN, ERROR, 'Opening ufd', 11, 'FIND.TEXT', 9) 300 CONTINUE C *** Read an entry in current directory. CALL DIR$RD (K$READ, T$UNIT(T$LEVL), LOC(ENTRY), 31, ERROR) IF (ERROR .EQ. E$EOF) GO TO 600 /* End dir, go Up a level CALL ERRPR$ (K$NRTN, ERROR, 'Reading Ufd', 11, 'FIND.TEXT', 9) C *** Set filetype. TYPE = RT(ENTRY(20), 8) + 1 IF (TYPE .GT. 6) TYPE = 7 C *** Move ENTRY into FILNAM, (PLP formatted variable). NWORDS = 0 DO 305 IW = 2, 17 FILNAM(IW) = ENTRY(IW) IF (FILNAM(IW) .NE. :120240) NWORDS = (NWORDS + 1) 305 CONTINUE NCHARS = LS(NWORDS, 1) IF (RT(FILNAM(NWORDS + 1), 8) .EQ. :240) NCHARS = (NCHARS - 1) FILNAM(1) = NCHARS C *** Let's eliminate file from search if possible. C *** See if file is a 'SPECIAL' one, (MFD, DKSRAT, BOOT or BADSPT). SPECL = RS(LS(FINFO, 3), 15) IF (SPECL .EQ. 1) GO TO 300 /* SPECIAL file C *** See if file is a sub-ufd and has to be attached to. IF (TYPE .EQ. 5) GO TO 500 /* Sub-Ufd C *** Don't search if file is not SAM or DAM type. IF (TYPE .GT. 2) GO TO 300 /* Search SAM/DAM only C *** See if file can be eliminated on basis of name --> BINARY. IF ((CHKBIN) .AND. (CHKCOM)) GO TO 309 /* Check BINs and COMOs CALL CHKNAM (FILNAM, BINAME, CONAME) IF ((.NOT. (BINAME)) .AND. (.NOT. (CONAME))) + GO TO 309 /* Go search it. IF ((BINAME) .AND. (CHKBIN)) GO TO 309 /* Go search it. IF ((CONAME) .AND. (CHKCOM)) GO TO 309 /* Go search it. C *** File appears to be BINARY or COMO from name. IF ((BINAME) .AND. (.NOT. (LBIN))) /* No messge, next entry + GO TO 300 IF ((CONAME) .AND. (.NOT. (LCOMO))) /* Ditto + GO TO 300 C *** Put out message about skipping binary or como file. CALL TNOUA ('Skipping: ', 10) IF (T$LEVL .EQ. 1) GO TO 308 /* No interim levels DO 307 I = 2, T$LEVL /* Display interim levels CALL OUTPUT(T$NAME(2, I), T$NAME(1, I)) CALL TNOUA ('>', 1) 307 CONTINUE 308 CONTINUE CALL TNOUA (FILNAM(2), FILNAM(1)) /* And the filename CALL TNOU (', due to name.', 14) CALL TONL GO TO 300 /* Next entry. 309 CONTINUE C *** We need to search file for the text strings. C *** So start by opening the file to read it. SHWNAM = .TRUE. /* We should show file name ITFILE = .FALSE. /* Text NOT in this file LINENO = 0 /* Line number NTRIES = 0 310 CONTINUE CALL SRCH$$ (K$READ+K$GETU, FILNAM(2), FILNAM(1), + FUNIT, T, ERROR) IF (ERROR .EQ. 0) GO TO 330 /* File opened IF (ERROR .NE. E$FIUS) GO TO 315 /* in-use tries again C *** File in use. CALL SLEEP$ (000100) NTRIES = (NTRIES + 1) IF (NTRIES .LT. 10) GO TO 310 /* Try to open file again. 315 CONTINUE C *** Tell user that we can't search file and go for next one. CALL TNOUA ('Can''t search *>', 15) IF (T$LEVL .EQ. 1) GO TO 325 /* No interim levels DO 320 I = 2, T$LEVL /* Display interim levels CALL OUTPUT(T$NAME(2, I), T$NAME(1, I)) CALL TNOUA ('>', 1) 320 CONTINUE 325 CONTINUE CALL TNOUA (FILNAM(2), FILNAM(1)) /* And the filename CALL TNOUA (', err = ', 8) /* And the error msg CALL ERRPR$ (K$IRTN, ERROR, 0, 0, 0, 0) GO TO 300 /* Read next entry 330 CONTINUE C *** Read another line from file. CALL RDLIN$ (FUNIT, LINE, 67, ERROR) IF (ERROR .EQ. E$EOF) GO TO 390 /* Search complete. CALL ERRPR$ (K$NRTN, ERROR, 'READ', 4, 'FIND.TEXT', 9) LINENO = (LINENO + 1) C *** Now set LINLEN, (length of line in chars). LINLEN = 136 335 CONTINUE LINLEN = (LINLEN - 2) IF (LINLEN .EQ. 0) GOTO 330 /* Read another line LINEWD = RS((LINLEN + 1), 1) IF (LINE(LINEWD) .EQ. :120240) GO TO 335 /* Subtract two more chars C *** Found either one or two chars, figure out which. IF (RT(LINE(LINEWD), 8) .EQ. :240) LINLEN = (LINLEN - 1) 345 CONTINUE C *** Search. ITEXT = 0 350 CONTINUE ITEXT = (ITEXT + 1) IF (ITEXT .GT. IL4TXT) GO TO 330 /* Next line FOUND = LSUB$A(L4TEXT(1, ITEXT), L4LENT(ITEXT), 1, L4LENT(ITEXT), + LINE, LINLEN, 1, LINLEN, + FNDBGN, FNDEND) IF (.NOT. (FOUND)) GO TO 350 /* Next string C *** Found string in file line, so let's start by seeing if we have C *** already found a match in this file, or do we need to display C *** the file name. IF (.NOT. (SHWNAM)) GO TO 370 /* Already showed it. C *** This is the first match in the file, so let's display the name. HMF = (HMF + 1) ITFILE = .TRUE. C *** Output name. CALL TNOUA (' *>', 3) IF (T$LEVL .EQ. 1) GO TO 360 /* No interim levels DO 355 I = 2, T$LEVL /* Display interim levels CALL OUTPUT(T$NAME(2, I), T$NAME(1, I)) CALL TNOUA ('>', 1) 355 CONTINUE 360 CONTINUE CALL TNOU (FILNAM(2), FILNAM(1)) /* And the filename 370 CONTINUE C *** Show user the line number that match was found in. CALL TODEC (LINENO) CALL TNOUA (': ', 2) C *** And then the actual line, filtering each character. DO 380 ILINE = 1, LINLEN IW = RS((ILINE + 1), 1) WD = LINE(IW) CHAR = RS(WD, 8) IF (RT(ILINE, 1) .EQ. 0) CHAR = RT(WD, 8) IF (CHAR .LT. :240) GO TO 378 /* Non-Printable IF (CHAR .GT. :376) GO TO 378 /* Ditto CALL T1OU (CHAR) /* ASCII printable GO TO 379 /* Close loop 378 CONTINUE /* Not printable CALL T1OU (:336) /* Carat, (up-arrow) CALL TOOCT (CHAR) /* Octal value 379 CONTINUE /* Close loop 380 CONTINUE /* End of loop CALL TONL SHWNAM = .FALSE. GO TO 330 /* Go read next line 390 CONTINUE C *** End of file. IF (ITFILE) CALL TONL CALL SRCH$$ (K$CLOS, 0, 0, FUNIT, T, ERROR) GO TO 300 /* Next entry 500 CONTINUE C *** Found a subufd to attach down into. T$LEVL = (T$LEVL + 1) C *** Get the password, (if we can). CALL GPAS$$ (FILNAM(2), FILNAM(1), OPASS, NPASS, ERROR) IF (ERROR .NE. 0) GO TO 520 /* Hope it's an acl C *** Move the password into array if needed. IF (OPASS(1) .EQ. :120240) GO TO 520 /* No password FILNAM(1) = (FILNAM(1) + 1) /* Add the space DO 510 ICPASS = 1, 6 /* Now add the password. IWP = RS((ICPASS + 1), 1) PWORD = OPASS(IWP) PCHAR = RS(PWORD, 8) IF (RT(ICPASS, 1) .EQ. 0) PCHAR = RT(PWORD, 8) FILNAM(1) = (FILNAM(1) + 1) IWF = RS((FILNAM(1) + 1), 1) FWORD = FILNAM(IWF + 1) FCHAR = LT(FWORD, 8) IF (RT(FILNAM(1), 1) .EQ. 1) FCHAR = RT(FWORD, 8) IF (RT(FILNAM(1), 1) .EQ. 1) PCHAR = LS(PCHAR, 8) FWORD = OR(FCHAR, PCHAR) FILNAM(IWF + 1) = FWORD 510 CONTINUE 520 CONTINUE C *** Move subufd name into array. DO 525 IW = 1, 21 T$NAME (IW, T$LEVL) = FILNAM(IW) 525 CONTINUE CALL AT$REL (K$SETC, FILNAM, ERROR) IF (ERROR .NE. 0) GO TO 580 GO TO 200 /* Open new level 580 CONTINUE C *** Error attaching down into new level. NORITC = (NORITC + 1) T$LEVL = (T$LEVL - 1) C *** Display meaningful error message. CALL TNOUA ('Error attaching to ', 19) CALL TNOUA (' *>', 4) IF (T$LEVL .EQ. 1) GO TO 590 /* No interim levels DO 585 I = 2, T$LEVL /* Display interim levels CALL OUTPUT(T$NAME(2, I), T$NAME(1, I)) CALL TNOUA ('>', 1) 585 CONTINUE 590 CONTINUE CALL TNOU (FILNAM(2), FILNAM(1)) /* And the filename GO TO 300 /* Go read next entry 600 CONTINUE C *** Finished processing this level, time to go up a level. C *** Start by closing out current level. CALL SRCH$$ (K$CLOS, 0, 0, T$UNIT(T$LEVL), T, ERROR) C *** Set pointer to previous level. T$LEVL = (T$LEVL - 1) C *** Begin working towards level above, begin by going to top of tree. CALL AT$HOM (K$SETC, ERROR) CALL ERRPR$ (K$NRTN, ERROR, 'Going HOME', 10, 'FIND.TEXT', 9) C *** At top of tree now, there are three possible situations: C *** 1) T$LEVL = 0 -> End of level 1 directory, End program. C *** 2) T$LEVL = 1 -> Reading top level of tree, keep going. C *** 3) T$LEVL > 1 -> Reading subordinate level of tree, keep going. IF (T$LEVL .EQ. 0) GO TO 1000 /* All done. IF (T$LEVL .EQ. 1) GO TO 300 /* Keep reading top level C *** We have to continue reading a subordinate level, so let's position C *** to the level from the top level before we continue reading. DO 610 LEVEL = 2, T$LEVL CALL AT$REL (K$SETC, T$NAME(1, LEVEL), ERROR) CALL ERRPR$ (K$NRTN, ERROR, T$NAME(2, LEVEL), + T$NAME(1, LEVEL), 'FIND.TEXT', 9) 610 CONTINUE C *** Attached back to current level, go read next entry. GO TO 300 900 CONTINUE C *** List usage. WRITE (1, 901) 901 FORMAT (/, 'Syntax: FIND.TEXT {Options}', + /, T5, 'Options:', + /, T10, ' -BIN : Examine ''BINARY'' files also.', + /, T10, ' Default is to skip files suffixed ', + 'with', + /, T10, ' .BIN, .SAVE, .RUN, or .IRUN,', + /, T10, ' as well as files prefixed by "$".', + /, T10, ' -LBIN : List names of binary files being ', + 'skipped.', + /, T10, ' Default is to suppress names.', + /, T10, ' -COMO : Examine ''COMO'' files also.', + /, T10, ' Default is to skip files suffixed ', + 'with .COMO.', + /, T10, ' -LCOMO : List names of COMO files being ', + 'skipped.', + /, T10, ' Default is to suppress names.', + /, T10, ' -HELP : Display this information.', + /) CALL EXIT CALL ERRPR$ (K$NRTN, E$NULL, 'No Re-Starts!', 13, 'FIND.FILE', 9) 1000 CONTINUE C *** Done processing tree so let's close the first unit. CALL SRCH$$ (K$CLOS, 0, 0, T$UNIT(1), T, ERROR) C *** Now output a file count WRITE (1, 1001) HMF 1001 FORMAT (B'ZZ,ZZ#', ' Files found containing desired text.') IF (NORITC .NE. 0) WRITE (1, 1002) NORITC 1002 FORMAT ('Ufds skipped, (insufficient access): ', B'ZZ,ZZ#') C *** & End program. CALL EXIT CALL ERRPR$ (K$NRTN, E$NULL, 'NO RESTARTS', 11, 'FIND.TEXT', 9) END C - Output printable characters of a string. C Written in Fortran IV, routine is PR1ME dependent. C Allen Egerton, March 1989 SUBROUTINE OUTPUT (STRING, STRLEN) IMPLICIT INTEGER*2 (A-Z) INTEGER*2 STRING(1) DO 100 IC = 1, STRLEN IW = RS((IC + 1), 1) CHAR = RS(STRING(IW), 8) IF (RT(IC, 1) .EQ. 0) CHAR = RT(STRING(IW), 8) IF ((CHAR .GT. :237) .AND. + (CHAR .LT. :377)) CALL T1OU (CHAR) CXX IF ((CHAR .LT. :240) .OR. CXX + (CHAR .GT. :376)) CALL TOOCT (CHAR) 100 CONTINUE RETURN END C - Use filename to determine if file is BINARY or COMOUTPUT. C Using Prime standard naming conventions, decide if a filename is C for a 'BINARY', (compiler product or executable), or COMOUTPUT file. C Written in Fortran IV, routine is PR1ME dependent. C Modification History C ---------------------------------------------------------------------------- C 02/06/90 Allen Egerton RN 1.0 C 02/15/90 Allen Egerton RN 1.1, added CONAME argument and logic. SUBROUTINE CHKNAM (FILNAM, BINAME, CONAME) IMPLICIT INTEGER*2 (A-Z) INTEGER*2 FILNAM(1) /* PLP fmt, name to check LOGICAL*2 BINAME, /* Return TRUE if BINARY + CONAME /* Return TRUE if COMO INTEGER*2 FNA1(32) /* Filename in A1 format. C *** Initialize return arguments. BINAME = .FALSE. CONAME = .FALSE. C *** Make sure we've got something to check. IF (FILNAM(1) .LT. 1) RETURN C *** Move the file name into A1 format array to make checking easier. DO 100 IA1 = 1, 32 IW = (RS((IA1 + 1), 1) + 1) CHAR = RS(FILNAM(IW), 8) IF (RT(IA1, 1) .EQ. 0) CHAR = RT(FILNAM(IW), 8) FNA1(IA1) = CHAR 100 CONTINUE C *** Check for x.BIN, (standard compiler output). IF (FILNAM(1) .LT. 5) GO TO 200 IF (FNA1(FILNAM(1)) .NE. :316) GO TO 200 /* 'N' IF (FNA1(FILNAM(1) - 1) .NE. :311) GO TO 200 /* 'I' IF (FNA1(FILNAM(1) - 2) .NE. :302) GO TO 200 /* 'B' IF (FNA1(FILNAM(1) - 3) .NE. :256) GO TO 200 /* '.' BINAME = .TRUE. RETURN 200 CONTINUE C *** Check for x.RUN, (BIND output). IF (FILNAM(1) .LT. 5) GO TO 300 IF (FNA1(FILNAM(1)) .NE. :316) GO TO 300 /* 'N' IF (FNA1(FILNAM(1) - 1) .NE. :325) GO TO 300 /* 'U' IF (FNA1(FILNAM(1) - 2) .NE. :322) GO TO 300 /* 'R' IF (FNA1(FILNAM(1) - 3) .NE. :256) GO TO 300 /* '.' BINAME = .TRUE. RETURN 300 CONTINUE C *** Check for x.SAVE, (SEG or LOAD output). IF (FILNAM(1) .LT. 6) GO TO 400 IF (FNA1(FILNAM(1)) .NE. :305) GO TO 400 /* 'E' IF (FNA1(FILNAM(1) - 1) .NE. :326) GO TO 400 /* 'V' IF (FNA1(FILNAM(1) - 2) .NE. :301) GO TO 400 /* 'A' IF (FNA1(FILNAM(1) - 3) .NE. :323) GO TO 400 /* 'S' IF (FNA1(FILNAM(1) - 4) .NE. :256) GO TO 400 /* '.' BINAME = .TRUE. RETURN 400 CONTINUE C *** Check for x.IRUN, (INFOBASIC executable). IF (FILNAM(1) .LT. 6) GO TO 500 IF (FNA1(FILNAM(1)) .NE. :316) GO TO 500 /* 'N' IF (FNA1(FILNAM(1) - 1) .NE. :325) GO TO 500 /* 'U' IF (FNA1(FILNAM(1) - 2) .NE. :322) GO TO 500 /* 'R' IF (FNA1(FILNAM(1) - 3) .NE. :311) GO TO 500 /* 'I' IF (FNA1(FILNAM(1) - 4) .NE. :256) GO TO 500 /* '.' BINAME = .TRUE. RETURN 500 CONTINUE C *** Check for $x, (INFOBASIC executable, (old convention)). IF (FILNAM(1) .LT. 2) GO TO 600 IF (FNA1(1) .NE. :244) GO TO 600 /* '$' BINAME = .TRUE. RETURN 600 CONTINUE C *** Next BINARY check. 1000 CONTINUE C *** Check for x.COMO. IF (FILNAM(1) .LT. 6) GO TO 2000 IF (FNA1(FILNAM(1)) .NE. :317) GO TO 2000 /* 'O' IF (FNA1(FILNAM(1) - 1) .NE. :315) GO TO 2000 /* 'M' IF (FNA1(FILNAM(1) - 2) .NE. :317) GO TO 2000 /* 'O' IF (FNA1(FILNAM(1) - 3) .NE. :303) GO TO 2000 /* 'C' IF (FNA1(FILNAM(1) - 4) .NE. :256) GO TO 2000 /* '.' CONAME = .TRUE. RETURN 2000 CONTINUE C *** Next check C *** No more checks, so return to caller with flags false. RETURN END