!*! Updated on 10-Aug-90 at 4:47 PM by Matt Badger; edit time: 0:01:46
!*************************** AMUS Program Label ******************************
! Filename: INCLUD.BAS                                      Date: 07/20/90
! Category: UTILITY      Hash Code: 074-266-441-425      Version: 1.0
! Initials: EAES         Name: Jon Dunham
! Company: E and E Specialties, Inc.               Telephone #: 9138439240
! Related Files: INCLUD.DO
! Min. Op. Sys.: AMOS/L 1.X (needs ODTIM)      Expertise Level: INT
! Special: Read the instructions- it usually helps
! Description: Creates a printout of all include modules and optionally all
! xcalls in a program and sorts the list by module name.  Optionally finds
! all the xcalls in the include modules and lists them too.
!*****************************************************************************
PROGRAM INCLUD,1.0(102)
! [100] NEW PROGRAM  11/1/89  JWD
! [101] added optional search for xcalls and output
!       to separate list 6/29/90 jwd
! [102] added optional scan of include subrs for xcalls and output
!       to the xcall list.  Also changed format of directory file to
!       allow this  7/18/90 jwd
! [102A] exclude commonly used sbrs for E&E  jwd 7/20/90
!
!    [100]
!    Looks for include modules and lists them with program name and sorts
!    list by include module name.  Very handy if you make a change to one
!    module and need to know where it is used.
!
!    [101]
!    This program lists all xcalls in the program but lists each occurrence
!    only once within a program.
!
!    [102]
!    Modified to cross reference the xcalls which are in all include
!    modules as well as in the main program.
!
!    To do this it needs to know where the include modules normally are.
!    You will also need to change the default ppn ("MAP1 INC'DEF,B,1,0")
!    when your modules are not in "0".  If you use ersatz or specific
!    devices for your includes which are not located in the library ppn
!    ("0") leave the default ppn at "0" as the program will find them
!    anyway.  If the program can't find the module it will skip over it
!    and print a comment.  This has the side benefit of letting you know
!    which modules aren't where they should be.
!
!    The include modules either must be on same physical device as the
!    files you are searching or else in an ersatz or specified device as
!    part of the include statement.  Needless to say, the stored modules
!    must have the same name and extension as in the program.
!
!    [Operation]
!    This program works with INCLUD.DO in CMD:.  Usage is "INCLUD" + any
!    valid wild card for program extensions.  A sorted list of INCLUDE
!    modules and XCALL'S results.
!
!    Be sure to DIRSEQ your programs first so they are in right Alpha order.
!    Note that normally extensions only would be wild carded, NOT program
!    names, however a range of programs can be requested I.E. "EMP???.BAS".
!
!    Adapted from SRCH.BAS originally from BILL MCCULLOUGH (MPAC).
!
!    Written by Jon Dunham, E and E Specialties, Inc., Lawrence, KS.  E and E
!    denies any liability for function of this program.  My phone number is
!    (913) 843-9240 or (800) 832-0404.
!
!       This program uses the following XCALLS:
!             STRIP, ODTIM, MESAG   also requires SORT.LIT
!
!  [INSTALLATION]
!  To install place INCLUD.BAS in BAS: and compile. Place INCLUD.DO in CMD:.
!
!  [.DO FILE FORMAT]
!  $D *.BAS
!  :R
!  LOOKUP RES:STRIP.SBR/
!  GOTO LOAD
!  GOTO DONE
!  ;LOAD
!  LOAD BAS:STRIP.SBR
!  ;DONE
!  ERASE DIR.LST
!  DIR $0
!  DIR DIR=$0/D
!  RUN INCLUD
!  [END OF .DO FILE FORMAT]
!
MAP1 MISC'JUNK
       MAP2 INSTRING,S,132             ! String from orig input file
       MAP2 NEWSTRING,S,132            ! String to be output to list file
       MAP2 LUKSTRING,S,50             ! lookup file name for include [102]
       MAP2 SPACES,S,132,SPACE(132)
       MAP2 PROGNAME,S,25
       MAP2 OUT'PROGNAME,S,10                  ![102]
       MAP2 DAY'STR,S,50
       MAP2 SEARCH'STRING(10),S,64
       MAP2 DUP'FIL,S,1
       MAP2 ANSWR,S,1                          ![101]
       MAP2 XCALS,B,1                          ![101]
       MAP2 CKINC,B,1                          ![102]
       MAP2 INC'PPN,S,9                        ![102]
       MAP2 INC'DEF,B,1,0                      ![102] default ppn for includes
       MAP2 CRLF
               MAP3 CR,S,1,CHR(13)
               MAP3 LF,S,1,CHR(10)

MAP1 XCAL'ARRAY(30)                             ![101]
       MAP2 XCAL'NAME,S,6

MAP1 CMDLIN,S,100               ! CMDLIN is approx 85 bytes long

FILEBASE 1
SIGNIFICANCE 11

START:
       CKINC = 0
       XCALS = 0
       XCALL ODTIM,DAY'STR,0,0,-1
       PRINT TAB(-1,0);
       PRINT TAB(5,1);"  This program searches the files you specified and finds INCLUDE modules." ![101]
       PRINT TAB(6,1);"  You can also search for occurrences of XCALL's.  Do you wish to also" ![101]
       PRINT TAB(7,1);"  scan for XCALL's ??"                  ![101]
       PRINT TAB(7,25);                                        ![101]
       INPUT ANSWR                                             ![101]
       ANSWR = UCS(ANSWR)
       IF ANSWR # "N" AND ANSWR # "Y" GOTO START               ![101]
       IF ANSWR = "Y" XCALS = 1 &
               ELSE &
               XCALS = 0                                       ![101]
       ! if you didn't want that option, you won't want the next one
       IF XCALS = 0 GOTO INPUT'ARGUMENT                        ![102]

START1:                 ! ENTIRE SECTION                        ![102]
       ANSWR=" "
       PRINT TAB(9,1);TAB(-1,10);"  This program can also search the ";&
               TAB(-1,34);"INCLUDE";TAB(-1,35);" modules in the files you specified"
       PRINT TAB(10,1);"  and look for XCALLS there. Do you wish to also run this option ??"
       PRINT TAB(10,70);
       INPUT ANSWR
       ANSWR = UCS(ANSWR)
       IF ANSWR # "N" AND ANSWR # "Y" GOTO START1
       IF ANSWR = "Y" CKINC = 1 &
               ELSE &
               CKINC = 0

INPUT'ARGUMENT:
       I = 1
       SEARCH'STRING(I) = "++INCLUDE"
       PRINT "SEARCH STRING: ";SEARCH'STRING(I)
       IF XCALS THEN I = I + 1 : &
       SEARCH'STRING(I) = "XCALL" : &
       PRINT "SEARCH STRING: ";SEARCH'STRING(I)
       I = I + 1
       PRINT
       SEARCH'STRING(I) = "END"

HARDCOPY:
       PRINT
       OPEN #2, "DIR.LST" ,INPUT
       LOOKUP "INCLUD.LST",FOUND
       IF FOUND # 0 CALL DUP'FILE
       OPEN #5, "INCLUD.LST" ,OUTPUT
       PRINT #5
       PRINT #5,"  LIST OF INCLUDE MODULES FOR AAAAAAAAAAA AS OF ";DAY'STR
       PRINT #5
       IF XCALS OPEN #6, "XCALL.LST" ,OUTPUT   ![101]
       IF XCALS PRINT #6                               ![101]
       IF XCALS PRINT #6,"  LIST OF  XCALL  MODULES FOR AAAAAAAAAAA AS OF ";DAY'STR
       IF XCALS PRINT #6                               ![101]

READ'DIRBAS:
       FOUND'INC = 0
       FOUND'XCL = 0                                                   ![101]
       INPUT LINE #2,PROGNAME
       IF EOF(2) OR PROGNAME = SPACES GOTO END
       PRINT PROGNAME;"**"
       PROG'COLON =  INSTR(1,PROGNAME,":")                     ![102]
       PROG'BRACK =  INSTR(1,PROGNAME,"[")                     ![102]
       OUT'PROGNAME = PROGNAME[PROG'COLON+1,PROG'BRACK-1]      ![102]
       XCALL STRIP,OUT'PROGNAME
       SEARCH'LINES = I - 1
       OPEN #3, PROGNAME, INPUT
       IF XCALS CALL CLEAR'ARRAY                       ![101]

GET'LINE:
       INPUT LINE #3, INSTRING
       IF EOF(3) GOTO PROG'DONE
       INSTRING = UCS(INSTRING)
       FOR I = 1 TO SEARCH'LINES
       START'OLD = INSTR(1,INSTRING,SEARCH'STRING(I))
       ! Requested string not in this line - get next string or line
       IF START'OLD = 0 GOTO FIND'NEXT
       ! Leave out commented stuff
       EXCLUD'EX = INSTR(1,INSTRING,"!")
       IF EXCLUD'EX = 0 GOTO DONT'CHECK
       IF EXCLUD'EX > 0 AND EXCLUD'EX < 8 GOTO FIND'NEXT

DONT'CHECK:
       IF XCALS XCAL'POS = INSTR(1,INSTRING,"XCALL")                   ![101]
       IF XCALS AND XCAL'POS > 0 CALL DO'XCAL : GOTO FIND'NEXT ![101]
       ! FOUND'INC is flag for programs that have include modules
       FOUND'INC = 1
       PLUS'POS =  INSTR(1,INSTRING,"++INCLUDE")
       NEWSTRING = INSTRING[PLUS'POS + 10,132]
       COLON'POS =  INSTR(1,NEWSTRING,":")

STRIP'SPACES:
       ! eliminate stuff like ++INCLUDE     MISC.INC (TABS OR SPACES)
       XCALL STRIP,NEWSTRING
       ZZ = LEN(NEWSTRING)
       IF COLON'POS = 0 AND NEWSTRING[1,1] = " " NEWSTRING[1;ZZ-1] = NEWSTRING[2;ZZ] : &
               NEWSTRING[ZZ;132] = SPACES : GOTO STRIP'SPACES
       IF COLON'POS = 0 AND NEWSTRING[1,1] = CHR(9) NEWSTRING[1;ZZ-1] = NEWSTRING[2;ZZ] : &
               NEWSTRING[ZZ;132] = SPACES : GOTO STRIP'SPACES
       IF COLON'POS > 0 PRINT #5,TAB(5);OUT'PROGNAME;":";TAB(30-COLON'POS);NEWSTRING &
               ELSE &
               PRINT #5,TAB(5);OUT'PROGNAME;":";TAB(30);NEWSTRING
       PRINT NEWSTRING
       IF CKINC INC'POS = INSTR(1,NEWSTRING,".")               ![102]

! variant for E & E [102A] exclude commonly used sbrs that I don't want listed
!       IF CKINC INC'EXC = INSTR(1,NEWSTRING,"ACTDEV.FIL")      ![102A]
!       IF CKINC AND INC'EXC > 0 INC'POS=0                      ![102A]
!       IF CKINC INC'EXC = INSTR(1,NEWSTRING,"KEYOPR.BSR")      ![102A]
!       IF CKINC AND INC'EXC > 0 INC'POS=0                      ![102A]
!       IF CKINC INC'EXC = INSTR(1,NEWSTRING,"MISCEE.BSR")      ![102A]
!       IF CKINC AND INC'EXC > 0 INC'POS=0                      ![102A]
!       IF CKINC INC'EXC = INSTR(1,NEWSTRING,"LOCK.BSR")        ![102A]
!       IF CKINC AND INC'EXC > 0 INC'POS=0                      ![102A]
!
       IF CKINC AND INC'POS > 0 CALL CHECK'INCL                ![102]
       I = SEARCH'LINES

FIND'NEXT:
       NEXT I
       NEWSTRING = SPACES
       GOTO GET'LINE

DUP'FILE:
       XCALL MESAG,"OUTPUT FILE ALREADY EXISTS, - DO YOU WANT TO ERASE ?",4
       INPUT DUP'FIL
       IF UCS(DUP'FIL) # "Y" GOTO END1
       RETURN

PROG'DONE:
       CLOSE #3
       PRINT
       IF FOUND'INC = 0 &
               PRINT #5,TAB(5);OUT'PROGNAME;":";TAB(30);"ZZZZZZZZZZ No INCLUDE modules found"
       IF XCALS AND FOUND'XCL = 0 &
               PRINT #6,TAB(5);OUT'PROGNAME;":";TAB(30);"ZZZZZZ   No XCALL subroutines found"
       GOTO READ'DIRBAS


CHECK'INCL:                     ! ENTIRE SECTON         ![102],[102B]
       DO'INC = 1   ! Flag to indicate that we got to this sbr
       ! take care of tabs in before comments but after sbr
       TABBS = INSTR(1,NEWSTRING,CHR(9))
       IF TABBS > 0 NEWSTRING[TABBS,132] = SPACES
       XCALL STRIP,NEWSTRING
       ! take care of spaces in before comments but after sbr  ![102B]
       SPCS = INSTR(1,NEWSTRING," ")                           ![102B]
       IF SPCS > 0 NEWSTRING[SPCS,132] = SPACES                ![102B]
       XCALL STRIP,NEWSTRING
       !If there is a colon we have a specific device so skip parsing
       IF COLON'POS > 0 LUKSTRING = NEWSTRING : GOTO SKIP'PARS
       INC'PPN = SPACES
       LUKSTRING = SPACES
       PPN'COMMA = INSTR(1,PROGNAME,",")
       INC'PPN[1,9] = PROGNAME[PROG'BRACK,PPN'COMMA]
       XCALL STRIP,INC'PPN
       PPN'LEN = LEN(INC'PPN)
       IF INC'DEF = 0 INC'PPN[PPN'LEN+1;2] = "0]" &
               ELSE &
               INC'PPN[PPN'LEN+1;4] = INC'DEF USING "#ZZ" + "]"
       LUKSTRING = PROGNAME[1,PROG'COLON]+NEWSTRING+INC'PPN


SKIP'PARS:                      ! ENTIRE SECTION        ![102]
       XCALL STRIP,LUKSTRING
       LOOKUP LUKSTRING,EX
       IF EX = 0 DO'INC = 0 : PRINT #6,TAB(5);OUT'PROGNAME;":";TAB(30);&
               "AAAAAA";"  ";"(CANNOT LOCATE>>";LUKSTRING;")" : RETURN
       OPEN #4, LUKSTRING, INPUT
       CALL GET'INC
       DO'INC = 0
       RETURN

GET'INC:                        ! ENTIRE SECTION        ![102]
       INPUT LINE #4, INSTRING
       IF EOF(4) CLOSE #4 : RETURN
       INSTRING = UCS(INSTRING)
       XCAL'POS = INSTR(1,INSTRING,"XCALL")
       ! Requested string not in this line - get next string or line
       IF XCAL'POS = 0 GOTO GET'INC
       ! Leave out commented stuff
       EXCLUD'EX = INSTR(1,INSTRING,"!")
       IF EXCLUD'EX > 0 AND EXCLUD'EX < 8 GOTO GET'INC
       IF XCAL'POS > 0 CALL DO'XCAL
       GOTO GET'INC

DO'XCAL:                        ! ENTIRE SECTON         ![101]
       ! FOUND'XCL is flag for files that have xcalls-if we made it here
       ! we certainly have one
       FOUND'XCL = 1
       NEWSTRING[1,6] = INSTRING[XCAL'POS + 6;6]
       NEWSTRING[7,132] = SPACES
       XCALL STRIP,NEWSTRING
       NEW'LEN = LEN(NEWSTRING)
       ! Elim continuation line colons from xcalls
       COLON'POS =  INSTR(1,NEWSTRING,":")
       IF COLON'POS>0 NEWSTRING[COLON'POS,6] = SPACE(6)
       ! Elim commas and stuff beyond
       COMMA'POS =  INSTR(1,NEWSTRING,",")
       IF COMMA'POS > 0 NEWSTRING[1,6] = NEWSTRING[1,COMMA'POS-1] : &
               NEWSTRING[COMMA'POS,6] = SPACE(6)
       IF COMMA'POS = 0 AND NEW'LEN < 6 NEWSTRING[NEW'LEN + 1,6] = SPACE(6)
       ! Elim dup references to xcalls
       FOR XZZ = 1 TO 30
       IF XCAL'NAME(XZZ) = SPACE(6) GOTO NXT'ZZ
       IF XCAL'NAME(XZZ) = NEWSTRING[1,6] XCAL'FLAG = 1

NXT'ZZ:                 ! ENTIRE SECTION        ![101],[102]
       NEXT XZZ
       ! found one previously in prog - outa here
       IF XCAL'FLAG NEWSTRING = SPACES : XCAL'FLAG = 0 : RETURN
       ! keep separate track of how far we got thru array
       XZ = XZ + 1
       XCAL'NAME(XZ) = NEWSTRING[1,6]
       ! Force terminator to string
       NEWSTRING[7,7] = CHR(0)
       IF CKINC AND DO'INC &
               PRINT #6,TAB(5);OUT'PROGNAME;":";TAB(30);NEWSTRING[1,6];"  ";"(";LUKSTRING;")" &
               ELSE &
               PRINT #6,TAB(5);OUT'PROGNAME;":";TAB(30);NEWSTRING[1,6];"  ";"(MAIN PROGRAM)"
       IF CKINC AND DO'INC &
               PRINT TAB(10);NEWSTRING[1,6];"  ";"(INCLUDE MODULE)" &
               ELSE &
               PRINT TAB(10);NEWSTRING[1,6];"  ";"(MAIN PROGRAM)"
       I = SEARCH'LINES
       NEWSTRING = SPACES
       RETURN

CLEAR'ARRAY:            ! ENTIRE SECTION                ![101]
       FOR XZ = 1 TO 30
       XCAL'NAME(XZ) = SPACE(6)
       NEXT XZ
       XZ = 0
       RETURN

END:
       CLOSE #5
       IF XCALS CLOSE #6
       IF XCALS PRINT : PRINT TAB(-1,34); &
               "  Your list can be 'VUE'D as 'INCLUD.LST' and 'XCALL.LST'";TAB(-1,35) &
               ELSE &
               PRINT : PRINT TAB(-1,34); &
               "  Your list can be 'VUE'D as 'INCLUD.LST'";TAB(-1,35)

END1:
       CLOSE #2
       KILL "DIR.LST"
       IF UCS(DUP'FIL) # "Y" AND FOUND END
       IF XCALS PRINT : PRINT TAB(-1,34); &
               "  sorting INCLUD.LST and XCALL.LST  - Please Wait ---";TAB(-1,35) &
               ELSE &
               PRINT : PRINT TAB(-1,34); &
               "  sorting INCLUD.LST - Please Wait ---";TAB(-1,35)
       CMDLIN = "SYS:SORT.LIT "
       CMDLIN = CMDLIN + "INCLUD.LST" + CRLF
       CMDLIN = CMDLIN + "85" + CRLF
       CMDLIN = CMDLIN + "10" + CRLF
       CMDLIN = CMDLIN + "31" + CRLF
       CMDLIN = CMDLIN + "A" + CRLF + CRLF + CRLF
       IF XCALS = 0 GOTO OUTA'HERE
       CMDLIN = CMDLIN + "SYS:SORT.LIT "
       CMDLIN = CMDLIN + "XCALL.LST" + CRLF
       CMDLIN = CMDLIN + "85" + CRLF
       CMDLIN = CMDLIN + "06" + CRLF
       CMDLIN = CMDLIN + "31" + CRLF
       CMDLIN = CMDLIN + "A" + CRLF + CRLF

OUTA'HERE:
       CHAIN CMDLIN
       END