**********************************************************************
*
*
*        PROGRAM NAME:              METASCAN
*
*        AUTHORS:                   RUTH DROZIN
*                                   JON ESCHINGER
*
*        DATE WRITTEN:              NOVEMBER 1978
*
*        PURPOSE:                   TO PROVIDE THE ASSEMBLY LANGUAGE
*                                   SUBROUTINES FOR FILESCAN.
*                                   INCLUDED ARE ROUTINES TO START
*                                   THE SCAN PROCESS, OPEN FILES,
*                                   READ RECORDS AND DETERMINE THEIR
*                                   CONTENTS.  EACH SUBROUTINE CALL
*                                   IS FURTHER DOCUMENTED AS TO ITS
*                                   PRECISE CALLING SEQUENCE AND
*                                   FUNCTION.
*
*
**********************************************************************
         PAGE
         SYSTEM   SIG7FDP
         SYSTEM   BPM
         SYSTEM   FORTLIB
*
*
*
*                 DEFS AND REFS
*
*
         DEF      STARTUP,BIGBUF,FITBUF
         DEF      NEXT,OPNF110,RDFRST
         DEF      DATESTUF,BIN2DEC,FPARAM
         DEF      OPNERR,RD1ERR,LBRDERR
         DEF      DBTEST,SPSS,LIBTST,ROMETC
         DEF      FRTBIN,LMNTXT,CLOS,FREEPG
         DEF      PROCS,SHARED,RDERR,PROCEXIT
         DEF      IANSYES,IANSNO,IANSMABE,MABEMAX,ANS
         DEF      FNDPROC,FIND1,COL1,FNBLNK,COLCOUNT
         DEF      FINDMABE
         DEF      FIND2,FIND3,FIND4,FIND5,FIND6,FIND7
         DEF      META1,META2,META3,META4,META5,META6,META7,META8
         DEF      FORT1,BASIC1,SNOBOL1,PL11
         DEF      XPL1,RPG1,MNGCOM1
         DEF      ALGOL1,MIX1,SL11,GPDS1,ECAP1
         DEF      BMDCOM1,SPSSCOM1
         DEF      KOUNT,PFIL,TEXT
         REF      9SETUPN,9SETUP0,IHOLD,INSN,INDOCM
         REF      IOUTBF,ISYNON,IERROR,IGRAN
         REF      MBS,IBYTE,IANS,F:111
         REF      KBYTE1
*
*
*
*
*
*        FILES ARE OPENED VIA THE F:110 DCB AND RECORDS READ
*        INTO THE BIGBUF BUFFER.  FITBUF CONTAINS THE
*        FPARAMS CONTAINED IN THE FILE INFORMATION TABLE.
*
*
F:110    DSECT    0
         GEN,8,16,8  96,0,1         SIZE,DCB TYPE
         GEN,15,17  1,0             FUNCTION
         GEN,8,24  10,BIGBUF        RETRYS,BUFFER
         GEN,15,17  2048,0          RECL
         DATA     0
         DATA     X'84000021'       SAVE,NACUP,KEYED,SEQUEN
         DATA     F:110+22          VLPS START HERE
         DO1      3
         DATA     0
         DATA     KB                ADDRESS OF KBUF
         DATA     FITBUF            ADDRESS OF FPARAMS
         GEN,8,24  31,0             KEYM
         DO1      9
         DATA     0
         DATA     X'01000808'       FILE NAME
         DO1      8
         TEXT     '    '
         DATA     X'02000202'       ACCOUNT
         DO1      2
         TEXT     '    '
         DATA     X'07000101'       SERIAL NO.
         TEXT     '    '
         DATA     X'11010101'       VLP SO ACCESS DATE
         DATA     X'00000500'       DOESN'T GET UPDATED
KB       EQU      $                 KEYBUFFER IS HERE
         TEXT     '    '
*
*
*
*        THIS IS THE DCB USED BY THE FORTRAN DRIVER
*        TO BUILD THE OUTPUT FILE (SCANDATA.:SYS IS
*        BY DEFAULT )
*
*
*
F:102    DSECT    0
F:102    M:DCB    (FILE,'                               ','        '),;
                  (SEQUEN),(KEYED),(OUT),(ABN,IERROR),(ERR,IERROR),;
                  (BUF,*BIGBUF),(KEYM,4),(PASS,'        '),;
                  (SAVE),(SN,'   ')
         CSECT    0
*
*
*
         PAGE
*        SUBROUTINE: STARTUP
*
*        PURPOSE: TO INITIALIZE DCB AS TO PROPER STARTING
*                 ACCOUNT AND PRIVATE VOLUMN SERIAL NUMBER.
*
*
*        CALLING SEQUENCE: CALL STARTUP
*
*        ARGUMENTS: IHOLD  - TWO WORDS INDICATING WHICH ACCOUNT
*                            TO START SCANNING AT. BLANK
*                            IF THIS IS A DEFAULT RUN.
*                   INSN   - SERIAL NO. OF PRIVATE VOLUMN. BLANK
*                            IF LOOKING AT PUBLIC ACCOUNTS.
*
*                 ( THESE ARGUMENTS ARE GLOBALED BY FORTRAN )
*
*
*
STARTUP  EQU      $
         BAL,LR   9SETUP0
STARTUP1 LI,1     -2
         LW,8     IHOLD+2,1         PUT ACCOUNT IN LOCAL
         STW,8    HOLDACCT+2,1      VARIABLE
         BIR,1    STARTUP1+1
STARTUP1A EQU     $
         LI,3     14
         LW,2     BLANKS
         STW,2    OPNF110,3         BLANK OUT THE NAME IN FPT
         CI,3     7
         BE       $+2               BRANCH IF DONE
         BDR,3    $-3               STUFF SOME MORE IF NOT
STARTUP2 EQU      $
         LW,8     HOLDACCT
         BE       STARTUP3          IF SO DEFAULT RUN
         STW,8    OPNF110+16        STORE THE FIRST WORD OF ACCT
         LW,8     HOLDACCT+1
         STW,8    OPNF110+17        STUFF THE SECOND WD OF ACCT
STARTUP3 EQU      $
         LI,1     2
         LI,3     2                 TWO VALID WORDS IN ACCT VLP
         STB,1    OPNF110+15,3      CPV - PECULIARITY
         LW,8     INSN              PUT INSN IN LOCAL VARIABLE
         STW,8    ISN
         CW,8     BLANKS            DID WE GET A SN PASSED?
         BE       $+3               NOPE
         STW,8    OPNF110+19        YEP - SO PUT IT IN FPT
         B        STARTUP4
         LI,1     0                 GOTTA ZERO OUT THE
         LI,3     2                 USEAGE BIT FOR SERIAL
         STB,1    OPNF110+18,3      NUMBER
*
*
*
*        CANT HAVE A NEXT ACCOUNT FOR A PRIVATE VOLUMN
*        SO WE TURN OFF THE NXTA IN THE FPT FOR EVER
*
*
*
STARTUP4 EQU      $
         LW,3     ONOFFLG           MASK
         LW,2     NACTOFF           TURN OFF NEXT ACCOUNT
         STS,2    OPNF110           STOW IT IN THE FPT
         M:GP     32                GET SOME PAGES FOR READS
         STW,9    BIGBUF            SAVE THE STARTING ADDRESS
         CI,8     32                DID WE GET WHAT WE WANTED?
         BL       NPGMSG            BRANCH IF NOT
         B        *15               RETURN
NPGMSG   M:TYPE   (MESS,NPAGES)
         M:XXX
         PAGE
*        SUBROUTINE: NEXT
*
*        PURPOSE: TO OPEN THE NEXT FILE THROUGH THE F:110 DCB
*                 AND PASS FILE INFORMATION BACK TO THE CALLING
*                 RECORD BEING CREATED, CALLED IOUTBF.
*
*        CALLING SEQUENCE: CALL NEXT
*
*        ARGUMENTS: IOUTBF - 112 BYTES WHICH COMPRISES THE TOTAL
*                            RECORD BEING CREATED FOR THE FILE.
*                   ISYNON - AN INTEGER VARIABLE INDICATING WHETHER
*                            OR NOT THIS IS A SYNON FILE. ONE IF
*                            YES, ZERO IF NO.
*                   IERROR - AN ERROR INDICATOR USED PRIMARILY TO
*                            SIGNAL THE END OF ACCOUNT DIRECTORY.
*                            ( IE. ERROR CODE X'0201' )
*                   IGRAN  - AN INTEGER COUNT OF THE NUMBER OF
*                            GRANULES IN THE FILE.
*
*                 ( THESE ARGUMENTS ARE GLOBALED BY FORTRAN )
*
*
*
NEXT     EQU      $
         STW,15   LINKSAVE          SAVE THE LINK ADDRESS
         LI,1     0
         STW,1    BUSY              ZAP THE BUSY FILE FLAG
,OPNF110 M:OPEN   F:110,(IN),(SAVE),(ABN,OPNERR),(ERR,OPNERR),;
                  (FILE,'                               ','        '),;
                  (SN,' '),(NXTA),(NXTF)
         LW,1     F:110+5
         OR,1     =X'04000000'
         M:SYS                      GO MASTER
         STW,1    F:110+5           DON'T UPDATE ACCESS DATE!!!
         LPSD,0   LPSDATA
         BOUND    8
LPSDATA  EQU      $
         GEN,8,4,20 0,X'E',$+2
         DATA     0
NEXTOFF  EQU      $
         LW,3     ONOFFLG           MASK
         LW,2     NACTOFF           TURN OFF NEXT ACCOUNT
         STS,2    OPNF110           STOW IT IN THE FPT
         LD,2     F:110+32          GET THE NEW ACCOUNT
*
*
*                 ACCOUNT NUMBER
*
*
NEXT1    EQU      $
         LI,1     1
         STW,1    ORIGBYTE          ORIG BYTE DISP
         LI,1     1
         STW,1    DESTBYTE          DEST BYTE DISP
         LI,1     8
         STW,1    LENGTH            NO. OF BYTES TO MOVE
         LI,14    5
         BAL,15   MBS               MOVE THE ACCOUNT TO IOUTBF
         PZE      F:110+32          ORIGINATION
         INTG     ORIGBYTE          BYTE DISPLACEMENT
         PZE      IOUTBF+2          DESTINATION
         INTG     DESTBYTE          BYTE DISPLACEMENT
         INTG     LENGTH            BYTE COUNT
*
*
*
*                 SERIAL NUMBER
*
*
*
NEXT1A   EQU      $
         LW,8     ISN               GET THE INSN
         CW,8     BLANKS            IS THERE REALLY ONE?
         BE       NEXT2             IF NOT, BRANCH
         STW,8    IOUTBF+1          IS SO STUFF IT IN IOUTBF
*
*
*                 FILE NAME
*
*
NEXT2    EQU      $
         LI,1     2
         STW,1    ORIGBYTE          ORIG BYTE DISP
         LI,1     1
         STW,1    DESTBYTE          DEST BYTE DISP
         LW,1     BUSY
         BEZ      $+3
         LB,1     F:110+23
         B        $+2
         LB,1     FITBUF+1
         STW,1    LENGTH            STOW IN LENGTH FOR MBS
         LI,14    5
         BAL,15   MBS               MOVE THE FILE NAME
         PZE      F:110+23          ORIGINATION
         INTG     ORIGBYTE          BYTE DISPLACEMENT
         PZE      IOUTBF+4          DESTINATION
         INTG     DESTBYTE
         LW,1     BUSY              IS THE FILE BUSY?
         BNEZ     NEXT8A            IF SO DONT DO REST
         LW,1     ISYNON            SYNONOMOUS FILE?
         BNEZ     NEXT8A            IF SO DON'T DO THE REST
*
*
*                 NUMBER OF GRANULES
*
*
NEXT3    EQU      $
         LI,1     X'0D'
         BAL,12   FPARAM            FIND SIZE IN GRANULES
         CI,1     0
         BE       PARAMERR          NO SUCH VLP FOUND
         CI,3     1
         BNE      PARAMERR          WRONG LENGTH
         LW,7     *2                THE WORD TO CONVERT
         STW,7    IGRAN             GIVE FORTRAN THE BINARY VERSION
         LI,2     56                BYTE DISPLACEMENT INTO IOUTBF
         LI,10    IOUTBF            BUFFER ADDRESS
         BAL,12   BIN2DEC
*
*
*                 ORGANIZATION
*
*
NEXT4    EQU      $
         LI,2     57
         LI,1     3                 INDEX INTO DCB FOR ORGANIZATION
         LB,1     F:110+5,1         GET ORG
         AND,1    =X'70'            AND OUT THE JUNK
         SLS,1    -4                SHIFT RIGHT
         STW,1    ORG               SAVE THE ORGANIZATION
         CI,1     2                 IS IT KEYED?
         BNE      $+4               NOPE, SO BRANCH
         LI,1     X'D2'             ITS KEYED
         STB,1    IOUTBF,2          SO TELL IOUTBF ABOUT IT
         B        NEXT4B
         CI,1     3                 IS IT RANDOM?
         BNE      $+4               NOPE
         LI,1     X'D9'             YEP
         STB,1    IOUTBF,2          STUFF IT IN IOUTBF
         B        NEXT4A
         STB,1    IOUTBF,2
*
*
*                 RECORD COUNT
*
*
NEXT4A   EQU      $
         CI,1     X'D9'             IS IT RANDOM?
         BNE      NEXT4A1           NOPE
         LW,7     IGRAN             RECS = GRANS WHEN RANDOM.
         LI,2     94                DISPLACEMENT INTO IOUTBF
         LI,10    IOUTBF            THE BUFFER ADDRESS
         BAL,12   BIN2DEC           STUFF IT
         B        NEXT4B
NEXT4A1  EQU      $
         CI,1     X'C3'             IT BETTER BE CONSEC!
         BNE      NEXT4B            NOPE - THIS COULD BE A BAD ERR
         LI,1     X'0C'
         BAL,12   FPARAM
         CI,1     0                 FOUND IT
         BE       PARAMERR          NOPE - BAD NEWS
         LW,7     1,2               GET THE SIZE
         AND,7    =X'FFFFFF'        POTENTIAL JUNK
         LI,2     94                DISPLACEMENT INTO IOUTBF
         LI,10    IOUTBF            THE BUFFER ADDRESS ITSELF
         BAL,12   BIN2DEC           CONVERT AND STUFF IT
NEXT4B   EQU      $
*
*
*                 CREATE DATE
*
*
NEXT5    EQU      $
         LI,1     X'0E'
         BAL,12   FPARAM            GET THE CREATE DATE
         CI,1     0
         BE       PARAMERR          NOT FOUND
         CI,3     2
         BNE      PARAMERR          WRONG LENGTH
         LI,1     58                DISPLACEMENT INTO IOUTBF
         BAL,12   DATESTUF
*
*
*                 MODIFY DATE
*
*
NEXT6    EQU      $
         LI,1     X'0A'
         BAL,12   FPARAM            GET THE MODIFY DATE
         CI,1     0
         BE       PARAMERR          NOT FOUND
         CI,3     3
         BNE      PARAMERR          WRONG LENGTH
         LI,1     64                DISPLACEMENT INTO IOUTBF
         BAL,12   DATESTUF
*
*
*                 ACCESSED DATE
*
*
NEXT7    EQU      $
         LI,1     X'0F'
         BAL,12   FPARAM            GET THE ACCESS DATE
         CI,1     0
         BE       PARAMERR          NOT FOUND
         CI,3     2
         BNE      PARAMERR          WRONG LENGTH
         LI,1     70                DISPLACEMENT INTO IOUTBF
         BAL,12   DATESTUF
*
*
*                 KEYMAX
*
*
NEXT8    EQU      $
         LW,1     ORG
         CI,1     2                 IS IT KEYED?
         BNE      NEXT8A            IF NOT - NO KEYM
         LI,1     X'09'             VLP CONTROL KEY
         BAL,12   FPARAM            GET THE PROPER PARAM
         CI,1     0
         BE       PARAMERR          NOT FOUND
         CI,3     3
         BNE      PARAMERR          WRONG LENGTH
         LI,1     1                 INDEX INTO PARAM
         LB,7     *2,1              GET THE KEYM BYTE
         LI,2     77                INDEX INTO IOUTBF
         LI,10    IOUTBF
         BAL,12   BIN2DEC           CONVERT AND STUFF IT
NEXT8A   EQU      $
         LW,1     BUSY              CHECK THE BUSY FLAG
         BEZ      $+2
         B        $+3
         LW,1     ISYNON            SYNONOMOUS?
         BEZ      NEXT8C            NOPE
         LI,4     79                DISP INTO IOUTBF
         LI,1     'N'
         STB,1    IOUTBF,4          NO JCL INDICATOR
         LI,3     14
         LW,2     BLANKS
         STW,2    OPNF110,3         BLANK OUT THE NAME VLP
         CI,3     7
         BE       $+2               BRANCH IF DONE
         BDR,3    $-3               CONTINUE IF NOT
         LI,1     X'17'             DISPLACEMENT INTO DCB
NEXT8B   EQU      $
         LW,2     F:110,1           MOVE THE FILE NAME FROM
         STW,2    OPNF110,3         DCB TO OPEN FPT
         CI,3     14
         BE       NEXT8C
         AI,1     1
         AI,3     1
         B        NEXT8B            CONTINUE
NEXT8C   EQU      $
         LI,1     0
         STW,1    BUSY              NOT BUSY ANYMORE
         LW,15    LINKSAVE          GET THE LINK BACK
         B        *15               RETURN
         PAGE
*        SUBROUTINE: RDFRST
*
*        PURPOSE: TO READ THE FIRST RECORD OF AN OPEN FILE
*                 AND PASS BACK THE NUMBER OF BYTES TO THE
*                 DRIVING PROGRAM AS WELL AS REPORT ERRORS
*
*        CALLING SEQUENCE: CALL RDFRST
*
*        ARGUMENTS: IBYTE - THE NUMBER OF BYTES IN THE FIRST RECORD
*                   IERROR - AN ERROR INDICATOR USED PRIMARILY
*                            TO INDICATE THE END OF FILE OR END
*                            OF DATA
*                   KBYTE1 - FIRST BYTE OF THE RECORD
*
*                 ( THESE ARGUMENTS ARE GLOBALED BY FORTRAN )
*
*
*
RDFRST   EQU      $
         LW,1     ORG
         CI,1     3                 IS IT RANDOM?
         BNE      RDFRST1           NO
         LI,7     X'800'            YES
         STW,7    RDFST+5           SO SET RECL TO 2048
RDFRST1  EQU      $
,RDFST   M:READ   F:110,(BUF,*BIGBUF),(WAIT),(ABN,RD1ERR),;
                  (ERR,RD1ERR),(SIZE,64000)
         STW,8    IBYTE             TELL DRIVER ABOUT IT
RDFRST2  EQU      $
         LW,8     ORG               GET ORGANIZATION
         CI,8     2                 IS IT KEYED?
         BNE      RDFRST3           IF NOT, BRANCH
         LW,8     F:110+10          GET KEYBUF
         AND,8    =X'1FFFF'
         LB,7     *8                GET KEYSIZE
         STB,7    VARKEYSZ
RDFRST3  EQU      $
         LW,8     F:110+13          GET ARS FROM RWS IN DCB
         STW,8    MAXRECL           SAVE IT
         STW,8    VARRECL           ALSO IN IS IT VARIABLE
         LB,8     *BIGBUF           GET FIRST BYTE
         CI,8     '!'               IS IT JCL?
         BNE      RDFRST4           NOPE
         LI,8     'Y'
         STB,8    JCL
RDFRST4  EQU      $
         STW,8    KBYTE1            TELL THE DRIVER
         B        *15               ABOUT BYTE ONE AND RETURN
         PAGE
*        SUBROUTINE: DBTEST
*
*        PURPOSE: TO DETERMINE IF THE CURRENTLY OPEN FILE IS
*                 ONE WHICH HAS 2048 BYTES IN ITS FIRST RECORD
*                 AND CAN BE IDENTIFIED
*
*        CALLING SEQUENCE: CALL DBTEST
*
*        ARGUMENTS: ON ENTRY - IANS = 0
*
*                   AT EXIT  - IANS = 1 ( IF A DATABASE )
*                              IANS = 2 ( IF DATABASE ASSOCIATED )
*                              IANS = 3 ( IF AN APL WORKSPACE )
*                              IANS = 4 ( IF A SAVE ME/GET ME FILE )
*                              IANS = 0 ( IF NONE OF THE ABOVE )
*
*                 ( IANS IS A GLOBAL VARIABLE DEFINED BY FORTRAN )
*
*
*
DBTEST   EQU      $
         LW,1     ORG
         BE       RANDOM            YEP - GO TEST DATABASES
NRAND    EQU      $
         CI,1     2                 IS IT KEYED?
         BNE      NRAND1            NOPE
         LW,2     ='APLW'
         LI,3     6
         CW,2     *BIGBUF,3         IS IT AN APLWS?
         BNE      NRAND1            NOPE
         LI,1     3
         STW,1    IANS              SO INFORM DRIVER
         B        DBTEST2
NRAND1   EQU      $
         LW,1     1
         LW,2     *BIGBUF,1
         AI,1     1
         LW,3     *BIGBUF,1
         CD,2     F:110+X'20'       IS IT IN RUNNING ACCOUNT
         BNE      DBTEST1           NOPE - NOT SAVEME
         LI,1     4
         STW,1    IANS              SAVEME/GETME FILE
         B        DBTEST2
RANDOM   EQU      $                 WE GET HERE FOR DB & RELATED FILES
         LW,1     *BIGBUF           GET WORD #1
         AND,1    =X'1FF'
         CI,1     0
         BE       DBTEST1
         LI,2     511
         SW,2     1                 GET DISPLACEMENT TO CHKSUM
         LI,4     0
         LI,8     0
RANDOM1  EQU      $
         LW,9     *BIGBUF,4         GET A WORD
         AW,8     9                 ADD IT IN
         BC       ADD1              BRANCH ON CARRY
RANDOM2  EQU      $
         AI,4     1
         CW,4     2                 ARE WE DONE?
         BE       RANDOM3           YEP
         B        RANDOM1           NOPE
ADD1     EQU      $
         AI,8     1
         B        RANDOM2
RANDOM3  EQU      $
         CW,8     *BIGBUF,4         DID WE FIND A VALID CHKSUM?
         BNE      RANDOM6           NOPE
RANDOM4  EQU      $
*
*
*
*        WE END UP HERE IF A DATABASE OR EDMS SCHEMA
*
*
*
         LI,2     X'22'
         LB,3     *BIGBUF,2         ALL THIS JAZZ IS TO
         CI,3     ':'               FIND OUT IF ITS AN EDMS
         BNE      RANDOM5           SCHEMA
         AI,2     3
         LB,3     *BIGBUF,2
         CB,3     BLANKS
         BNE      RANDOM5
         AI,2     4
         LB,3     *BIGBUF,2
         CB,3     BLANKS
         BNE      RANDOM5
         AI,2     3
         LB,3     *BIGBUF,2
         CI,3     ','
         BNE      RANDOM5
         LI,1     2                 FOUND AN EDMS SCHEMA
         STW,1    IANS              TELL DRIVER
         B        DBTEST2
RANDOM5  EQU      $                 GET HERE IF A DATABASE
         LI,1     1
         STW,1    IANS              TELL DRIVER
         B        DBTEST2
RANDOM6  EQU      $                 LOOK FOR SUBSCHE OR DMS SCHEMA
         LI,4     0
         LI,8     0
RANDOM7  EQU      $
         LW,9     *BIGBUF,4         GET A WORD
         AW,8     9                 ADD IT IN
         BC       ADD1A
RANDOM8  EQU      $
         AI,4     1
         CW,4     1                 ARE WE DONE?
         BE       RANDOM9           YEP
         B        RANDOM7
ADD1A    EQU      $
         AI,8     1
         B        RANDOM8
RANDOM9  EQU      $
         CW,8     *BIGBUF,4         VALID CHKSUM?
         BNE      RANDOM10          NOPE - STILL COULD BE JOURNAL
         LI,1     2
         STW,1    IANS              TELL DRIVER
         B        DBTEST2
RANDOM10 EQU      $                 LOOK FOR A JOURNAL
         LI,4     0
         LI,8     0
RANDOM11 EQU      $
         LW,9     *BIGBUF,4
         AW,8     9                 ADD THE WORD IN
         BC       ADD1B             BRANCH ON CARRY
RANDOM12 EQU      $
         AI,4     1
         CI,4     511
         BNE      RANDOM11          NOT DONE YET
         CW,8     *BIGBUF,4         IS IT A VALID CHKSUM?
         BNE      DBTEST1           NOPE - DON'T KNOW WHAT IT IS
         LI,4     X'18'
         LB,3     *BIGBUF,4
         CI,3     32                TEXTC COUNT?
         BGE      DBTEST1           NOPE - NOT JOURNAL
         LI,1     2
         STW,1    IANS              TELL DRIVER
         B DBTEST2
ADD1B    EQU      $
         AI,8     1                 BUMP ON OVERFLOW
         B        RANDOM12
DBTEST1  EQU      $
         LI,1     0
         STW,1    IANS              SOMETHING FOREIGN TO ME
DBTEST2  EQU      $
         B        *15               RETURN
         PAGE
*        SUBROUTINE: SPSS
*
*        PURPOSE: TO DETERMINE IF THIS IS AN SPSS WORKSPACE
*
*        CALLING SEQUENCE: CALL SPSS
*
*        ARGUMENTS: AT ENTRY - IANS = 0
*
*                   AT EXIT  - IANS = 1 ( IF IT IS AN SPSS WORKSPACE )
*                              IANS = 0 ( IF NOT )
*
*                 ( IANS IS A GLOBAL VARIABLE DEFINED BY FORTRAN )
*
*
*
SPSS     EQU      $
         LW,1     ORG
         CI,1     1                 IS IT CONSEC?
         BG       SPSSNO            NOPE
         LW,1     *BIGBUF           GET FIRST WORD
         CW,1     ='$FIL'           SHOULD BE $FIL
         BNE      SPSSNO            BUT ITS NOT
         LB,3     *BIGBUF,2         GET A /
         AI,2     3
         LB,4     *BIGBUF,2         GET ANOTHER /
         CW,3     4                 SHOULD BE THE SAME
         BNE      SPSSNO
         CI,3     '/'               AND SHOULD BE /
         BNE      SPSSNO
SPSSYES  EQU      $
         LI,1     1
         STW,1    IANS              TELL CALLING PROGRAM
         B        *15               RETURN
SPSSNO   EQU      $
         LI,1     0
         STW,1    IANS              TELL DRIVER NO SUCH ANIMAL
         B        *15               RETURN
         PAGE
*        SUBROUTINE: LIBTST
*
*        PURPOSE: TO FERRET OUT THE EXISTANCE OF VARIOUS LIBRARY TYPES
*
*        CALLING SEQUENCE: CALL LIBTST
*
*        ARGUMENTS: AT ENTRY - IANS = 0
*
*                   AT EXIT  - IANS = 1 ( IF :DIC/:LIB )
*                              IANS = 2 ( IF LEMUR LIBRARY )
*                              IANS = 0 ( IF NONE OF THE ABOVE )
*
*                 ( IANS IS A GLOBAL VARIABLE DEFINED BY FORTRAN )
*
*
*
LIBTST   EQU      $
         LW,1     DICFOUND          HAVE WE ALREADY FOUND :DIC?
         BEZ      LIBTST1           IF NOT KEEP ON LOOKING
         LW,2     F:110+X'17'       IF SO, IS THE NAME :LIB
         CW,2     =X'047AD3C9'
         BNE      LIBTST1
         LB,2     F:110+X'18'
         CI,2     'B'
         BNE      LIBTST1
         LI,1     1                 FOUND A :LIB AFTER A :DIC
         STW,1    IANS              SO TELL THE DRIVER
         LI,1     0
         STW,1    DICFOUND          ZAP THE DICFOUND FLAG
         B        *15               RETURN
         LW,8     F:110+13          GET THE ARS FROM RWS
         CI,8     12                BETTER BE 12 BYTES
         BNE      LIBTST3           IF NOT GET OUT
         LI,4     -8
         LW,5     BIGBUF
         AI,5     8
         LW,6     *5,4              MOVE THE KEY INTO A SAVE
         STW,6    KEYSAVE+8,4       PLACE FOR FUTURE USE
         STW,6    KEYSAVE1+8,4
         BIR,4    $-3
         LB,4     KEYSAVE           GET THE KEYSIZE
         CI,4     11                IS IT VALID?
         BG       LIBTST3           NOPE
         M:SETDCB F:110,(ERR,LBRDERR),(ABN,LBRDERR)
         LB,4     KEYSAVE1          GET THE KEYSIZE
         LI,1     0
LIBTST1A EQU      $
         AI,4     1                 BUMP THE SIZE
         LB,5     HEAD,1
         STB,5    KEYSAVE1,4        PUT IN HEAD
         AI,1     1
         CI,1     4                 DONE?
         BL       LIBTST1A          BRANCH IF NOT
         STB,4    KEYSAVE1          FIX THE KEY SIZE
         LI,4     KEYSAVE1
         M:READ   F:110,(BUF,*BIGBUF),(SIZE,64000),(KEY,*4),;
                  (ERR,LBRDERR),(ABN,LBRDERR)
         LI,1     2
         STW,1    IANS              GOT HERE BECAUSE LEMUR TYPE
         B        LIBTST4
LIBTST2  EQU      $
         LW,2     F:110+X'17'
         CW,2     =X'047AC4C9'      LOOKING TO SEE IF :DIC
         BNE      LIBTST3
         LB,2     F:110+X'18'
         CI,2     'C'
         BNE      LIBTST3
         LI,4     -2
         LW,2     OPNF110+X'12',4   MOVE THE ACCOUNT NUMBER
         STW,2    OPNF111+X'C',4
         BIR,4    $-2
,OPNF111 M:OPEN   F:111,(IN),(SAVE),(ABN,LBRDERR1),(ERR,LBRDERR1),;
         LB,4     KEYSAVE
         LI,1     4
         LI,2     0
LIBTST2A EQU      $
         LB,6     HEAD,2
         STB,6    KEYSAVE,4         ALTER THE KEY TO LOOK FOR
         AI,4     1                 A HEAD RECORD IN :LIB
         AI,2     1
         CI,2     4
         BE       LIBTST2B          WERE DONE
         B        LIBTST2A          NO WERE NOT
LIBTST2B EQU      $
         M:READ   F:111,(BUF,*BIGBUF),(WAIT),(ERR,LBRDERR1),;
                  (ABN,LBRDERR1),(SIZE,32767)
         M:CLOSE  F:111             WE GET HERE IF A VALID
         LI,1     1                 :LIB FOR :DIC WAS FOUND
         STW,1    IANS
         STW,1    DICFOUND
         B        LIBTST4
LIBTST3  EQU      $
         LI,1     0
         STW,1    IANS              TELL THE DRIVER WE CAN'T
         B        *15               FIND IT AND RETURN
LIBTST4  EQU      $
         M:REW    F:110
         M:READ   F:110,(BUF,*BIGBUF),(WAIT),(ERR,LBRDERR1),;
                  (ABN,LBRDERR1),(SIZE,64000)
         M:SETDCB F:110,(ERR,OPNERR),(ABN,OPNERR)
         B        *15               RETURN
         PAGE
*        SUBROUTINE: ROMETC
*
*        PURPOSE: TO FIND VARIOUS THINGS SUCH AS ROMS, :BLIB
*                 COMPRESSED FILES, LOCCT FILES, BMD WS,
*                 OSIRIS WS, ETC.
*
*        CALLING SEQUENCE: CALL ROMETC
*
*        ARGUMENTS: AT ENTRY - IANS = 0
*
*                   AT EXIT  - IANS = 1 ( IF A ROM )
*                              IANS = 2 ( IF A :BLIB TYPE LIBRARY )
*                              IANS = 3 ( NOT USED )
*                              IANS = 4 ( IF A COMPRESSED FILE )
*                              IANS = 6 ( IF A BMD WORKSPACE )
*                              IANS = 7 ( IF AN OSIRIS WORKSPACE )
*                              IANS = 0 ( IF NONE OF THE ABOVE )
*
*                 ( IANS IS A GLOBAL VARIABLE DEFINED BY FORTRAN )
*
*
*
ROMETC   EQU      $
         LW,2     ORG               GET THE ORGANIZATION
         CI,2     2                 IS IT KEYED?
         BL       ROMETC1
         LI,1     0                 NONE OF THE ABOVE
         B        ROMETCX1
ROMETC1  EQU      $
         LB,2     *BIGBUF           GET FIRST BYTE
         OR,2     =X'3E'            SHOULD BE SOME PERMUTATION
         CI,2     X'3E'             OF THESE BITS
         BE       $+3               IF SO, BRANCH
         LI,1     0                 NO DICE
         B        ROMETCX1
         LB,2     *BIGBUF           GET THAT BYTE AGAIN
         STB,2    HOLDBYTE          SAVE IT FOR LATER
ROMETC2  EQU      $
         M:PFIL   F:110,(EOF)       GO TO END OF FILE
         M:PRECORD F:110,(N,1),(REV)   GET LAST RECORD
         M:READ   F:110,(BUF,*BIGBUF),(WAIT),(ERR,RDLSTERR),;
                  (ABN,RDLSTERR),(SIZE,64000)
         LB,4     *BIGBUF           GET BYTE 0
         CI,4     X'18'             IS IT COMPRESSED?
         BNE      ROMETC3
         LB,2     HOLDBYTE
         CI,2     X'38'
         BNE      ROMETC3
         LI,1     78                GOTTA TELL DRIVER
         LI,2     'Y'               ABOUT BEING COMPRESSED
         STB,2    *BIGBUF,1
         LI,1     4                 FOUND COMPRESSED
         B        ROMETCX
ROMETC3  EQU      $
         BNE      ROMETC4
         CI,2     X'3E'
         BNE      ROMETC4
         LI,1     5                 FOUND A LOCCT FILE
         B        ROMETCX
ROMETC4  EQU      $
         CI,4     X'1C'             ROM OR BMD
         BE       ROMETC5
         B        OSIWS             TRY OSIRIS WS
ROMETC5  EQU      $
         CI,2     X'3C'             LOOKING FOR A ROM
         BNE      ROMETC6
         LI,1     1                 FOUND A ROM
         B        ROMETCX
ROMETC6  EQU      $
         CB,4     *BIGBUF           FIRST AND LAST THE SAME?
         BNE      OSIWS             IF NOT, HOW ABOUT OSIRIS
         CI,4     X'1C'
         BNE      OSIWS
         LI,5     3
         LB,6     *BIGBUF,5         GET BYTE 3
         CW,6     F:110+13          SEE IF THE SAME AS RWS
         BNE      $+3               NOT THE SAME SO BRANCH
         LI,1     6                 FOUND A BMD WS
         B        ROMETCX
         LW,6     IOUTBF+4          GET FIRST PART OF NAME
         CW,6     =':BLI'           IS IT :BLIB?
         BNE      ROMETC7
         LW,6     IOUTBF+5
         CW,6     ='B   '
         BNE      ROMETC7
         LI,1     2
         B        ROMETCX           FOUND A :BLIB
ROMETC7  EQU      $
         AI,5     1
         LB,6     *BIGBUF,5         GET BYTE 4
         CI,6     X'03'             SNEAKY STUFF
         BNE      $+3
         LI,1     1                 FOUND A ONE RECORD ROM
         B        ROMETCX
         LW,6     F:110+13          RWS
         CI,6     108
         BE       $+3
         CI,6     120
         BNE      $+3
         B        ROMETCX
         LI,1     0                 NOT A :BLIB
         B        ROMETCX
OSIWS    EQU      $
         M:REW    F:110
         M:READ   F:110,(BUF,*BIGBUF),(WAIT),(ERR,RDOSIERR),;
                  (ABN,RDOSIERR),(SIZE,64000)
         LD,2     *BIGBUF           GET FIRST TWO WORDS
         LB,4     2
         CI,4     'T'               IS IT A 'T' CARD?
         BNE      OSIWS+1           KEEP LOOKING TILL WE FIND ONE
         SLD,2    8                 KET RID OF THE 'T' SO NOT NEG
         LI,8     10                WE'LL LOOK AT 10 'T' CARDS
OSIWS1   EQU      $
         M:READ   F:110,(BUF,*BIGBUF),(WAIT),(ERR,RDOSIERR),;
                  (ABN,RDOSIERR),(SIZE,64000)
         LD,6     *BIGBUF           'T' CARDS SHOULD BE IN ASCENDING
         LB,4     2                 ORDER AT ALL TIMES
         CI,4     'T'               STILL IN THE 'T' CARDS
         BNE      OSIWS2            BRANCH IF NOT
         SLD,6    8
         CD,6     2
         BG       OSIWS2            BIGGER, SO KEEP LOOKING
         LI,1     0
         B        ROMETCX           FOUND A NONE OF THE ABOVE
OSIWS2   EQU      $
         LD,2     6                 MOVE THE MOST RECENTLY READ
         BDR,8    OSIWS1
         LI,1     7                 FOUND AN OSIRIS WS
         B        ROMETCX
ROMETCX  EQU      $
         M:REW    F:110
         M:READ   F:110,(BUF,*BIGBUF),(WAIT),(ERR,RDLSTERR),;
                  (ABN,RDLSTERR),(SIZE,64000)
ROMETCX1 EQU      $
         STW,1    IANS              TELL DRIVER WHAT IT IS
         B        *15               AND RETURN
RDLSTERR EQU      $
         M:XXX
RDOSIERR EQU      $
         LB,3     10
         CI,3     X'06'
         BNE      $+3
         LI,1     0
         B        ROMETCX
         M:SNAP   'RDOSIERR',(F:110,F:110+40)
         M:XXX
         PAGE
*        SUBROUTINE: SHARED
*
*        PURPOSE: TO IDENTIFIED SHARED LIBRARIES
*
*        CALLING SEQUENCE: CALL SHARED
*
*        ARGUMENTS: AT ENTRY - IANS = 0
*
*                  AT EXIT  - IANS = 1 ( IF A SHARED LIBRARY )
*                             IANS = 0 ( IF NOT )
*
*                 ( IANS IS A GLOBAL VARIABLE DEFINED BY FORTRAN )
*
*
*
SHARED   EQU      $
         LB,2     *BIGBUF           GET THE FIRST BYTE
         CI,2     X'04'
         BE       $+3
         LI,1     0
         B        SHAREDX           NONE OF THE ABOVE
         LI,2     1
         LW,3     *BIGBUF,2         GET WORD 1
         AND,3    =X'047AD7F0'      IT SHOULD HAVE EXACTLY
         CW,3     =X'047AD7F0'      THIS STUFF IN IT
         BNE      $+3
         LI,1     1
         B        SHAREDX           FOUND A SHARED LIB
         LI,2     3
         LW,3     *BIGBUF,2         GET WORD THREE
         AND,3    =X'037AD7F0'      IT SHOULD HAVE EXACTLY
         CW,3     =X'037AD7F0'      THIS IN IT
         BNE      $+3               BRANCH IF FAILED TESTS
         LI,1     1
         B        SHAREDX           FOUND A SHARED LIB
         LI,1     0
SHAREDX  EQU      $
         STW,1    IANS              TELL THE DRIVER
         B        *15               RETURN
         PAGE
*        SUBROUTINE: FRTBIN
*
*
*        CALLING SEQUENCE: CALL FRTBIN
*
*        ARGUMENTS: AT ENTRY - IANS = 0
*
*                   AT EXIT  - IANS = 1 ( IF FORTBIN )
*                              IANS = 0 ( IF NOT )
*
*                 ( IANS IS A GLOBAL VARIABLE DEFINED BY FORTRAN )
*
*
*
FRTBIN   EQU      $
         LI,6     0
         LB,2     *BIGBUF           GET THE FIRST BYTE
         LW,4     F:110+13          GET RWS
         AI,4     -4
         LB,5     *BIGBUF,4         GET BYTE ONE OF LAST WORD
         CW,2     5                 BYTES SHOULD BE THE SAME
         BNE      NOFRTBIN
         CI,2     X'3C'
         BE       $+3               OK SO FAR
         CI,2     X'1C'
         BNE      NOFRTBIN          NOT A FORTBIN
         AI,4     1
         LB,5     *BIGBUF,4
         CI,5     X'BD'             ALL GOOD FORTBINS HAVE THIS
         BNE      NOFRTBIN
FRTBIN1  EQU      $
         LI,1     1
         STW,1    IANS              TELL THE DRIVER WE HAD A HIT
         B        *15               RETURN
NOFRTBIN EQU      $
         LI,1     0
         STW,1    IANS              NOT FORTRAN BINARY
         B        *15               RETURN
         PAGE
*        SUBROUTINE: LMNTXT
*
*        PURPOSE: TO FIND LMNS, TEXT FILES, MINITAB WORKSPACES,
*                 MANAGE DICTIONARIES, ETC.
*
*        CALLING SEQUENCE: CALL LMNTXT
*
*        ARGUMENTS: AT ENTRY - IANS = 0
*
*                   AT EXIT  - IANS = 1 ( IF A LMN )
*                              IANS = 2 ( IF REGULAR TEXT FILE )
*                              IANS = 3 ( IF TEXT COMPRESSED FILE )
*                              IANS = 4 ( IF A TEXT EDIT FILE )
*                              IANS = 5 ( IF A MINITAB WORKSPACE )
*                              IANS = 6 ( IF A MANAGE DICTIONARY )
*                              IANS = 0 ( IF NONE OF THE ABOVE )
*
*                 ( IANS IS A GLOBAL VARIABLE DEFINED BY FORTRAN )
*
*
*
LMNTXT   EQU      $
         M:SETDCB F:110,(ERR,LTXTERR),(ABN,LTXTERR)
         LW,2     ORG               GET ORGANIZATION
         CI,2     2                 IS IT KEYED?
         BL       MINITXT           CANT BE LMN OR MANAGE DICT
         BG       NOLMNTXT          CANT BE RANDOM
         LB,2     F:110+12          GET THE KEYM
         CI,2     3
         BE       MINITXT           GOTTA BE MINITAB OR TEXT
         CI,2     9
         BE       MNGDICT           MANAGE DICTIONARY
         CI,2     11
         BE       LMN
         CI,2     15
         BE       LMN
         B        NOLMNTXT          NONE OF THE ABOVE
LMN      EQU      $
         LI,3     3
         LI,2     4
         STB,2    KEYSAVE           BUILD A HEAD RECORD KEY
         LB,4     HEAD,3
         STB,4    KEYSAVE,2
         AI,3     -1
         BDR,2    $-3               DO THE WHOLE THING
         LI,4     KEYSAVE           ADDRESS OF THE KEY BUFFER
         M:READ   F:110,(BUF,*BIGBUF),(WAIT),(ERR,LTXTERR),;
                  (ABN,LTXTERR),(SIZE,64000),(KEY,*4)
LMN1     EQU      $
         LW,3     *BIGBUF           GET FIRST WORD OF HEAD RECORD
         SLD,2    8
         SLS,3    -8
         CI,3     X'FF30'           ALL LMNS HAVE THIS
         BNE      NOLMNTXT
         SLS,2    24
         LB,2     2
         BE       LMN2
         CI,2     X'84'             LINK BUILT
         BE       LMN2
         CI,2     X'85'             PAGED LOAD MODULE
         BNE      NOLMNTXT
LMN2     EQU      $
         LI,1     1
         STW,1    IANS              FOUND A LMN
         B        LMNTXTX
MNGDICT  EQU      $
         LW,3     F:110+13          GET RWS
         AI,3     -12               ALL MANAGE DICTS HAVE FIRST
         LI,2     0                 RECORD WHOSE LENGTH IS
         LI,10    20                EXACTLY 12 + 20(NO. ARGS)
         DW,2     10
         CI,2     0                 ANY REMAINDER?
         BNE      NOLMNTXT          IF SO NOT A MNG DICT
         LH,2     *BIGBUF
         AND,2    =X'FFFF'
         CI,2     X'270F'           THIS IS THE BIGGEST LOGICAL REC SIZE
         BG       NOLMNTXT
         LI,4     2
         LH,3     *BIGBUF,4
         AND,3    =X'FFFF'
         CI,3     X'3E7'            THIS IS LARGEST BLOCKING FACTOR
         BG       NOLMNTXT
         LI,1     6
         STW,1    IANS              FOUND A MNG DICT
         B        LMNTXTX
MINITXT  EQU      $
         LW,2     F:110+13          GET RWS
         CI,2     8
         BNE      TEXT              MINITAB HAS 8 BYTE FIRST REC
         M:READ   F:110,(BUF,*BIGBUF),(WAIT),(ERR,LTXTERR),;
                  (ABN,LTXTERR),(SIZE,64000)
         LW,2     F:110+13          GET RWS AGAIN
         CI,2     80                GOTTA BE 80 BYTES
         BNE      NOLMNTXT
         LI,2     7
         LB,3     *BIGBUF,2         ALL GOOD LITTLE MINITABS
         CI,3     X'32'             HAVE X'32' IN BYTE 7
         BNE      NOLMNTXT
         LI,1     5
         STW,1    IANS              FOUND A MINITAB WS
         B        LMNTXTX
TEXT     EQU      $
         LW,2     IOUTBF+4          LOOKING FOR A REGULAR
         CW,2     ='TXT:'           TEXT FILE
         BE       TEXT1
         CW,2     ='PRN:'
         BE       TEXT1
         CW,2     ='HDR:'
         BNE      TEXT2
TEXT1    EQU      $
         LI,1     2
         STW,1    IANS              FOUND A REGULAR TEXT FILE
         B        LMNTXTX
TEXT2    EQU      $
         LW,2     F:110+13          GET RWS
         CI,2     160               LOOKING FOR A COMPRESSED TEXT
         BNE      TEXT3
         LI,2     14
         LW,3     *BIGBUF,2
         CW,3     ='TEXT'           ALL GOOD COMPRESSED TEXT
         BNE      TEXT3             HAVE THIS IN WORD 14
         LW,2     F:110+10          KBUF ADDRESS
         AND,2    =X'1FFFF'
         LW,3     *2
         CW,3     =X'03000000'      ZIP, ZILCH, NOTHING FOR A KEY
         BNE      TEXT3
         LI,1     3
         STW,1    IANS              FOUND A COMPRESSED TEXT
         B        LMNTXTX
TEXT3    EQU      $
         LW,2     F:110+13          RWS AGAIN
         AI,2     -1
         LB,3     *BIGBUF,2         GET LAST BYTE
         CI,3     X'0D'             MUST BE CR
         BNE      NOLMNTXT
         LB,3     *BIGBUF
         CI,3     4
         BNE      NOLMNTXT
         LI,1     4
         STW,1    IANS              FOUND AN EDIT TEXT FILE
         B        LMNTXTX
NOLMNTXT EQU      $
         LI,1     0
         STW,1    IANS              TELL THE DRIVER
LMNTXTX  EQU      $
         M:REW    F:110
         M:READ   F:110,(BUF,*BIGBUF),(WAIT),(ERR,LTXTERR),;
                  (ABN,LTXTERR),(SIZE,64000)
         B        *15               RETURN
LTXTERR  EQU      $
         LB,2     10
         CI,2     X'42'             BAD KEY?
         BE       NOLMNTXT
         CI,2     X'43'             KEY NOT FOUND?
         BE       NOLMNTXT
         CI,2     6                 EOF?
         BE       NOLMNTXT
         M:SNAP   'LTXTERR',(F:110,F:110+40)
         M:XXX
         PAGE
*        SUBROUTINE: PROCS
*
*        PURPOSE: TO FIND WHICH OF THE POSSIBLE 19 PROCESSORS
*                 THIS FILE MAY BE AND REPORT FINDINGS TO THE
*                 DRIVING PROGRAM
*
*        CALLING SEQUENCE: CALL PROCS
*
*        ARGUMENTS: AT ENTRY - INDOCM = 0 ( IF FILE NOT ORIG COMPR )
*                              INDOCM = 1 ( IF FILE WAS ORIG COMPR )
*                              IANS   = 0
*
*                   AT EXIT  - IANS  =  1 ( IF FORTRAN )
*                              IANS  =  2 ( IF COBOL )
*                              IANS  =  3 ( IF BASIC )
*                              IANS  =  4 ( IF METASYM/AP )
*                              IANS  =  5 ( IF PASCAL )
*                              IANS  =  6 ( IF RPG )
*                              IANS  =  7 ( IF ALGOL )
*                              IANS  =  8 ( IF LISP )
*                              IANS  =  9 ( IF MIX )
*                              IANS  = 10 ( IF SNOBOL )
*                              IANS  = 11 ( IF PL-1 )
*                              IANS  = 12 ( IF SL1 )
*                              IANS  = 13 ( IF GPDS )
*                              IANS  = 15 ( IF XPL )
*                              IANS  = 16 ( IF ECAP )
*                              IANS  = 17 ( IF MANAGE COMMANDS )
*                              IANS  = 18 ( IF BMD COMMANDS )
*                              IANS  = 19 ( IF SPSS COMMANDS )
*                              IANS  = 20 ( IF MORE THAN ONE FILE TYPE )
*                              IANS  =  0 ( IF NONE OF THE ABOVE)
*                              IOUTBF - WILL INDICATE THE MULTIPLE
*                                       FILE TYPES IF SUCH THINGS EXIST
*
*                 ( ALL ABOVE ARGUMENTS ARE FORTRAN GLOBAL VARIABLES )
*
FORT     EQU      1
COBOL    EQU      2
BASIC    EQU      3
AP       EQU      4
PASCAL   EQU      5
RPG      EQU      6
ALGOL    EQU      7
LISP     EQU      8
MIX      EQU      9
SNOBOL   EQU      10
PL1      EQU      11
SL1      EQU      12
GPDS     EQU      13
CIRC     EQU      14
XPL      EQU      15
ECAP     EQU      16
MNGCOM   EQU      17
BMDCOM   EQU      18
SPSSC    EQU      19
*
*
PROCS    EQU      $
         STW,15   LINKSAVE          SAVE THE RETURN ADDRESS
         M:SETDCB F:110,(ERR,RDERR),(ABN,RDERR)
         LW,2     INDOCM            ORIGIONALLY COMPRESSED?
         BEZ      $+2               NOPE
         BAL,12   COMPOPN           YES, SO MAKE ALLOWANCE FOR IT
         LB,2     *BIGBUF           GET FIRST BYTE
         CI,2     '!'               JCL CARD?
         BNE      FNDPROC           FIRST CARD NOT JCL
PROCS1   EQU      $
         BAL,12   FNDLBNG           FIND LAST ! CARD BEFORE DATA
         LW,2     F:110+13          GET RWS
         BGE      PROCS1B
         LI,7     ' '
PROCS1A  EQU      $
         STB,7    *BIGBUF,2
         AI,2     1
         CI,2     8
         BE       PROCS1B
         B        PROCS1A
PROCS1B  EQU      $
         LD,2     *BIGBUF           GET FIRST DOUBLEWORD
         LI,6     3
PROCS2   EQU      $
         LB,7     2,6               LOOKING FOR A BLANK
         CI,7     ' '
         BE       PROCS3            FOUND ONE
         AI,6     1
         CI,6     8
         BE       PROCS4            DONE LOOKING
         B        PROCS2            KEEP ON LOOKING
PROCS3   EQU      $
         AI,6     1
         CI,6     8
         BE       PROCS4            ALL DONE
         LI,9     ' '
         STB,9    2,6               BLANK OUT THE REST
         B        PROCS3
PROCS4   EQU      $
         LI,6     0
         CD,2     APNAME,6          LOOK THROUGH THE TABLE
         BE       PROCS5            FOUND A MATCH
         CI,6     NAMETOTL
         BE       PROCS6            DO IT THE HARD WAY
         AI,6     1
         B        PROCS4+1
PROCS5   EQU      $
         LB,1     APIANS,6
         LI,6     'Y'
         STB,6    IANSYES,1         RECORD THE FINDING OF A GOODIE
         M:READ   F:110,(BUF,*BIGBUF),(SIZE,64000),(WAIT),;
                  (ERR,RDERR),(ABN,RDERR)
         BAL,12   FNDNBNG           FIND NEXT BANG
         B        PROCS1
PROCS6   EQU      $
         LI,2     GARBINDX
         LW,3     *BIGBUF           GET FIRST WORD
         CW,3     GARBNAME,2
         BE       PROCS7            FOUND ONE
         BDR,2    $-2
         BNE      PROCS8            NO GARBAGE NAMES
PROCS7   EQU      $
         M:READ   F:110,(BUF,*BIGBUF),(SIZE,64000),(WAIT),;
                  (ERR,RDERR),(ABN,RDERR)
         BAL,12   FNDNBNG           FIND THE NEXT BANG
         B        PROCS1
PROCS8   EQU      $
         M:READ   F:110,(BUF,*BIGBUF),(SIZE,64000),(WAIT),;
                  (ERR,RDERR),(ABN,RDERR)
FNDPROC  EQU      $
         LB,6     *BIGBUF           GET THE FIRST BYTE
         STB,6    COL1              SAVE THE CONTENTS
         LI,4     0
         CI,6     X'40'             IS IT BLANK?
         BE       FNDPROC1          YEP
         STB,6    FNBLNK            FIRST NON BLANK
         AI,4     1
         STB,4    COLCOUNT          AND ITS COLUMN COUNT
         B        FIND1
FNDPROC1 EQU      $
         AI,4     1
         LB,6     *BIGBUF,4         GET NEXT BYTE
         CI,6     X'40'             BLANK?
         BE       FNDPROC2          YEP
         STB,6    FNBLNK            FIRST NON BLANK
         AI,4     1                 GOTTA BUMP IT
         STB,4    COLCOUNT          AND ITS COLUMN COUNT
         B        FIND1
FNDPROC2 EQU      $
         CI,4     72                TOTALLY BLANK?
         BLE      FNDPROC1          NOPE
         M:READ   F:110,(BUF,*BIGBUF),(SIZE,64000),(WAIT),;
                  (ERR,RDERR),(ABN,RDERR)
         LB,9     *BIGBUF
         CI,9     '!'               IS IT A BANG?
         BE       FNDPROC2A         YEP
         LW,9     RECOUNT
         CI,9     10                WE'LL PUT UP WITH 10 BLANK RECORDS
         BLE      FNDPROC3
         BAL,12   FNDNBNG           FIND THE NEXT BANG CARD
FNDPROC2A EQU     $
         LI,6     0
         STW,6    COL1
         STW,6    RECOUNT
         B        PROCS1            WERE GONNA BAG THIS ONE
FNDPROC3 EQU      $
         AI,9     1
         STW,9    RECOUNT
         B        FNDPROC           GO TRY ANOTHER RECORD
FIND1    EQU      $
         LI,1     0
         STW,1    RECOUNT           INIT THE RECORD COUNT
         LB,5     FNBLNK
         CI,5     'I'               LOOKING FOR IDENTIFICATION
         BE       COBOL1            DIVISION.
         CI,5     '*'               OR A COMMENT CARD
         BE       CSPLAT
         B        COBCHK            DUMB THING MAY HAVE SEQ NOS
COBOL1   EQU      $
         LB,6     COLCOUNT
         CI,6     8                 GOTTA BE IN AREA A
         BL       FIND2
         CI,6     11
         BG       FIND2
         LI,3     -4
         CB,5     IDENT+1,3         SEE IF WE CAN FIND 'IDEN'
         BNE      FIND2
         LB,5     *BIGBUF,6         GET NEXT CHARACTER
         AI,6     1
         BIR,3    $-4               KEEP ON TRUCKIN'
COBOL2   EQU      $
         LB,5     *BIGBUF,6         LOOKING FOR A 'D'
         CI,5     'D'
         BE       COBOL3            FOUND ONE
         AI,6     1
         CI,6     72
         BGE      FIND2
         B        COBOL2            KEEP LOOKING
COBOL3   EQU      $
         LI,3     -4
         CB,5     DIVISION+1,3      GOTTA FIND 'DIVI'
         BNE      FIND2             OR IT AINT COBOL
         AI,6     1
         LB,5     *BIGBUF,6
         BIR,3    $-4
COBOL4   EQU      $
         LB,5     *BIGBUF,6
         CI,5     '.'               IDENTIFICATION DIVISION.
         BE       COBYES
         AI,6     1
         CI,6     72
         BG       FIND2
         B        COBOL4            AND KEEP LOOKING
COBYES   EQU      $
         LI,6     'Y'
         LI,5     COBOL
         STB,6    IANSYES,5         FOUND A COBOL RIGHT NOW
         LB,12    JCL               WAS THERE JCL?
         CI,12    'Y'
         BNE      PROCEXIT          NO SO DON'T LOOK ANYMORE
         BAL,12   FNDNBNG           GET THE NEXT BANG CARD
         B        PROCS1            GO FIND ANOTHER TYPE
CSPLAT   EQU      $
         LI,3     6
         LB,2     *BIGBUF,3         COMMENTS HAVE * IN COL. 7
         CI,2     '*'
         BNE      FIND2             NOPE
         LI,4     0
         STW,4    RECOUNT           INITIALIZE
CSPLAT1  EQU      $
         M:READ   F:110,(BUF,*BIGBUF),(SIZE,64000),(WAIT),;
                  (ERR,RDERR),(ABN,RDERR)
         AI,4     1                 BUMP COUNT
         STW,4    RECOUNT
         LI,3     6
         LB,2     *BIGBUF,3
         CI,2     '*'               ANOTHER COMMENT?
         BE       CSPLAT1           YES SO KEEP LOOKING
         LI,2     6
         LB,5     *BIGBUF,2         GET COLUMN 7
         B        COBCHK1           DO SOME MORE CHECKING
COBCHK   EQU      $
*
*
*        THIS CODE IS HERE PRIMARILY FOR THOSE WHO DELIGHT IN
*        PUTTING SEQUENCE NUMBERS IN THEIR COBOL SOURCE
*
*
         LB,6     COLCOUNT
         CI,6     6
         BG       FIND2             CAN'T BE COBOL
         LB,5     FNBLNK
         BAL,12   DECI$MAL          MAKE SURE ITS DECIMAL
         B        FIND2             IT'S NOT, SO CAN'T BE STANDARD
         LI,2     6
         CI,5     '*'               SPLAT IN COL 7 = COMMENT
         BNE      COBCHK1
         B        CSPLAT
COBCHK1  EQU      $
         CI,5     ' '               IS COL 7 BLANK?
         BNE      FIND2             IF NOT CANT BE COBOL NOW
COBCHK2  EQU      $
         AI,2     1
         LB,5     *BIGBUF,2         GET THE NEXT NON BLANK
         CI,5     'I'
         BE       COBCHK3           FOUND AN 'I' AS IN INDENTIFICATION
         CI,2     11
         BL       COBCHK2           KEEP LOOKING
         B        FIND2             NOT IN AREA A
COBCHK3  EQU      $
         AI,2     1
         STB,2    COLCOUNT
         B        COBOL1            NOW WE CAN CHECK FOR COBOL
*
*
*        CHK FOR DECIMAL ROUTINE
*
*
DECI$MAL EQU      $
         CI,5     X'F0'
         BL       *12
         CI,5     X'F9'
         BG       *12
         AI,12    1
         B        *12
FIND2    EQU      $
         LW,4     RECOUNT
         AI,4     1
         M:PRECORD F:110,(N,*4),(REV)
         M:READ   F:110,(BUF,*BIGBUF),(SIZE,64000),(WAIT),;
                  (ERR,RDERR),(ABN,RDERR)
         LI,1     0
         STW,1    RECOUNT           REINIT
         LB,4     COL1              GET CONTENTS OF COLUMN 1
         CI,4     '*'               IS IT A SPLAT?
         BNE      FIND3             NOPE
         LD,4     *BIGBUF           GET TWO WORDS
         CD,4     CONTROL           LOOK FOR ECAP *CONTROL
         BNE      FIND2A
         LI,5     'Y'               FOUND AN ECAP
         LI,4     ECAP
         STB,5    IANSYES,4
         LB,12    JCL
         BNE      PROCEXIT          NOPE
         BAL,12   FNDNBNG           YEP, SO KEEP ON LOOKIN'
         B        PROCS1
FIND2A   EQU      $
         M:READ   F:110,(BUF,*BIGBUF),(SIZE,6400),(WAIT),;
                  (ERR,RDERR),(ABN,RDERR)
         LB,5     *BIGBUF
         CI,5     '*'               LOOKING FOR MORE COMMENTS
         BNE      FIND2B
         B        FIND2A            KEEP ON LOOKING
FIND2B   EQU      $
         LI,4     1
         LI,5     FORT
         STB,4    IANSMABE,5        THESE ARE ALL THE PROCESSORS
         LI,5     BASIC             WHICH GET THEIR MAYBE COUNT
         STB,4    IANSMABE,5        BUMPED BECAUSE OF * IN
         LI,5     AP                COLUMN 1
         STB,4    IANSMABE,5
         LI,5     SNOBOL
         STB,4    IANSMABE,5
         LI,5     GPDS
         STB,4    IANSMABE,5
         LD,4     *BIGBUF           LOOK FOR GPDS DATA
         CD,4     GPDSDATA
         BNE      FIND2C            NOT FOUND
         LI,5     'Y'
         LI,4     GPDS
         STB,5    IANSYES,4         FOUND GPDS
         LB,12    JCL
         CI,12    'Y'               JCL IN THIS FILE?
         BNE      PROCEXIT          NOPE SO BAG IT
         BAL,12   CLEANUP           CLEAN MABE'S, ETC
         BAL,12   FNDNBNG
         B        PROCS1
FIND2C   EQU      $
         LI,2     1
         LD,4     *BIGBUF,2
         SLD,4    -8
         LI,2     7
         LB,2     *BIGBUF,2
         STB,2    4
         CD,4     SIMULATE          LOOKING FOR GPDS AGAIN
         BNE      FIND2D
         LI,5     GPDS
         LB,4     IANSMABE,5
         STB,4    IANSMABE,5
FIND2D   EQU      $
         BAL,15   META1             TRY METASYM/AP
         B        PROCS1
         BAL,15   FORT1             TRY FORTRAN
         B        PROCS1
         BAL,15   BASIC1            TRY BASIC
         B        PROCS1
         BAL,15   SNOBOL1           TRY SNOBOL
         B        PROCS1
         B        FINDMABE          LAST CHANCE FOLKS
FIND3    EQU      $
         LB,4     FNBLNK            FIRST NON BLANK CHAR.
         CI,4     '('
         BNE      FIND4             NOT A '('
         LI,5     COLCOUNT
         LB,6     *BIGBUF,5
         CI,6     '*'               LOOKING FOR PASCAL
         BE       PASCALYES         FOUND IT
LISPYES  EQU      $
         LI,6     'Y'
         LI,5     LISP
         STB,6    IANSYES,5         FOUND LISP
         LB,12    JCL
         CI,12    'Y'               JCL IN THIS FILE?
         BNE      PROCEXIT          NOPE, SO DON'T LOOK FURTHER
         BAL,12   FNDNBNG
         B        PROCS1
PASCALYES EQU     $
         LI,6     'Y'
         LI,5     PASCAL
         STB,6    IANSYES,5         FOUND PASCAL
         LB,12    JCL
         CI,12    'Y'               JCL IN THIS FILE?
         BNE      PROCEXIT          NOPE, SO BAG THE REST
         BAL,12   FNDNBNG
         B        PROCS1
FIND4    EQU      $
         CI,4     'P'
         BE       $+3
         CI,4     X'97'             COULD BE LOWER CASE
         BNE      FIND5
         LB,2     COLCOUNT
         LW,3     2
         AI,3     3
         LD,4     BLANKS
         LW,8     BLANKS
         LB,7     FNBLNK
         LS,8     7                 LOAD SELECTIVE TO PRESERVE BLANKS
FIND4A   EQU      $
         SLS,8    8
         LB,7     *BIGBUF,2         GET NEXT CHAR
         LS,8     7
         AI,2     1
         CW,3     2
         BNE      FIND4A            NOT DONE
         STW,8    4                 SAVE THE FIRST PART OF 'PROG'
         LW,8     BLANKS
         AI,3     3
FIND4B   EQU      $
         SCS,8    8
         LB,7     *BIGBUF,2
         LS,8     7
         AI,2     1
         CW,3     2
         BNE      FIND4B
         SCS,8    8
         STW,8    5                 FOUND THE REST
         CD,4     LILPROG           COULD BE LOWER CASE
         BE       PASCALYES
         CD,4     PROGDATA
         BNE      FIND5
         BAL,15   SL11              CHECK SL1
         B        PROCS1
         B        PASCALYES         FOUND A SNEAKY PASCAL
FIND5    EQU      $
         LB,4     FNBLNK
         CI,4     '/'               IS IT A SLASH?
         BNE      FIND6             NOPE
FIND5A   EQU      $
         M:READ   F:110,(BUF,*BIGBUF),(SIZE,64000),(WAIT),;
                  (ERR,RDERR),(ABN,RDERR)
         LB,5     *BIGBUF
         CI,5     '/'               STILL A SLASH?
         BE       FIND5A            YEP
         CI,5     ' '               HOW ABOUT A BLANK?
         BNE      FIND5B            NOPE
         LI,1     1
         LB,5     *BIGBUF,1         GET NEXT BYTE
         AI,1     1
         CI,5     ' '               STILL BLANK?
         BE       $+3
         CI,5     '/'
         BE       FIND5A            STILL A SLASH
FIND5B   EQU      $
         BNE      $+3               CAN'T BE FORTRAN
         BAL,15   FORT1             TRY FORTRAN
         B        PROCS1
         BAL,15   PL11              TRY PL1
         B        PROCS1
         BAL,15   XPL1              TRY XPL
         B        PROCS1
         B        FINDMABE          COURT OF LAST RESORT
FIND6    EQU      $
         LB,5     FNBLNK
         BAL,12   DECI$MAL          LEGAL DECIMAL?
         B        FIND7             NOPE
         LB,5     COLCOUNT
         CI,5     5
         BG       FIND6B            ONLY BASIC IS OK
         CI,4     X'F4'
         BG       FIND6A            CAN'T BE MANAGE COMMANDS
         BAL,15   MNGCOM1
         B        PROCS1
FIND6A   EQU      $
         BAL,15   FORT1             TRY FORTRAN
         B        PROCS1
         BAL,15   RPG1              TRY RPG
         B        PROCS1
FIND6B   EQU      $
         BAL,15   BASIC1
         B        PROCS1
         B        FINDMABE          AGAIN - COURT OF LAST RESORT
FIND7    EQU      $
         LB,7     COL1
         CI,4     'C'               'C' IN COLUMN 1?
         BNE      FIND8             NOPE
         LW,4     *BIGBUF
         CW,4     CIRCDATA          CANWE FIND CIRC?
         BNE      FIND7A            NOPE
CIRCYES  EQU      $
         LI,6     'Y'
         LI,5     CIRC
         STB,6    IANSYES,5         FOUND SOME CIRC DATA
         LB,12    JCL
         CI,12    'Y'               JCL IN THIS FILE?
         BNE      PROCEXIT          NO, SO DON'T LOOK FURTHER
         BAL,12   FNDNBNG
         B        PROCS1
CIRCDATA TEXT     'CIRC'
FIND7A   EQU      $
         B        PROCS1            WHICH HAVE A 'C' IN COLUMN
         BAL,15   SNOBOL1           ONE, BUT FOR THEM IT'S
         B        PROCS1            NOT A COMMENT
         BAL,15   XPL1
         B        PROCS1
         BAL,15   MIX1
         B        PROCS1
         BAL,15   PL11
         B        PROCS1
         BAL,15   GPDS1
         B        PROCS1
         BAL,15   SPSSCOM1          MAY OR MAY NOT BE CO(MMENT)
         B        PROCS1
FIND7B   EQU      $
         M:READ   F:110,(BUF,*BIGBUF),(SIZE,64000),(WAIT),;
                  (ERR,RDERR),(ABN,RDERR)
         LB,5     *BIGBUF           THE REST OF THESE PROCESSORS
         CI,5     'C'               USE A 'C' AS COMMENT CARD
         BNE      FIND7C            FOUND A NON-COMMENT CARD
         B        FIND7B            KEEP LOOKING
FIND7C   EQU      $
         LI,4     1
         LI,5     FORT
         STB,4    IANSMABE,5
         LI,5     SL1               BUMP THEIR MABE COUNTERS
         STB,4    IANSMABE,5
         LI,5     ECAP
         STB,4    IANSMABE,5
         BAL,15   FORT1
         B        PROCS1
         BAL,15   SL11
         B        PROCS1
         BAL,15   ECAP1
         B        PROCS1
         B        FINDMABE          COURT OF LAST RESORT AGAIN
FIND8    EQU      $
         LB,4     COL1              GET COL1 CONTENTS
         CI,4     ' '               IS IT BLANK?
         BE       FIND9             YES, SO SKIP THIS JAZZ
         CI,4     'B'               IS IT A 'B'?
         BNE      $+3               NOPE, CAN'T BE ALGOL
         BAL,15   ALGOL1
         B        PROCS1
         B        PROCS1            PROCESSORS.
         BAL,15   SPSSCOM1          IF FOUND THE RETURN
         B        PROCS1            IS TO THE BAL+1 AND
         BAL,15   META1             IF NOT THEN RETURN
         B        PROCS1            TO BAL+2.
         BAL,15   MIX1
         B        PROCS1
         BAL,15   SNOBOL1
         B        PROCS1
         BAL,15   PL11
         B        PROCS1
         BAL,15   SL11
         B        PROCS1
         BAL,15   GPDS1
         B        PROCS1
         BAL,15   XPL1
         B        PROCS1
         B        FINDMABE
FIND9    EQU      $                 END UP HERE IF COLUMN
         BAL,15   FORT1             ONE IS BLANK.
         B        PROCS1
         BAL,15   BASIC1            AGAIN THE RETURN IS
         B        PROCS1            TO BAL+1 IF THE PROCESSOR
         BAL,15   META1             IS FOUND AND TO BAL+2
         B        PROCS1            IF NOT FOUND TO TRY
         BAL,15   RPG1              ANOTHER.
         B        PROCS1
         BAL,15   MIX1
         B        PROCS1
         LB,4     FNBLNK
         CI,4     'B'               IS FIRST NON BLANK A 'B'
         BNE      $+3               IF NOT CAN'T BE ALGOL
         BAL,15   ALGOL1
         B        PROCS1
         BAL,15   SNOBOL1
         B        PROCS1
         BAL,15   PL11
         B        PROCS1
         BAL,15   SL11
         B        PROCS1
         BAL,15   GPDS1
         B        PROCS1
         BAL,15   XPL1
         B        PROCS1
         BAL,15   ECAP1
         B        PROCS1
         BAL,15   MNGCOM1
         B        PROCS1
*
*
*
*
*
*        NOT YET IMPLEMENTED
*
*
         B        PROCEXIT
FINDMABE EQU      $
*
*
*        NOT YET IMPLEMENTED
*
*
         LB,12    JCL
         CI,12    'Y'               JCL IN THIS FILE?
         BNE      PROCEXIT          NOPE, SO BAG IT
         BAL,12   FNDNBNG           YEP
         B        PROCS1            SO KEEP ON LOOKING
         PAGE
*
*        SUBROUTINE: FNDSTMT
*
*        PURPOSE: TO FIND OUT IF A SPECIFIC RECORD CONTAINS
*                 ANY OF A LIST OF STATEMENTS PASSED BY THE
*                 CALLING ROUTINE.
*
*        CALLING SEQUENCE: BAL,12     FNDSTMT
*
*        ARGUMENTS: - AT ENTRY - R1 = ADDRESS OF A STATEMENT LIST
*                                     ( THEY ARE DOUBLEWORDS )
*                                R2 = NUMBER OF STATEMENTS
*                                R3 = COLUMN IN WHICH TO BEGIN
*                                     LOOKING.
*                                R4 = RWS-8 OR COLUMN TO QUIT
*                                     LOOKING.
*
*                     AT EXIT  - R4 = 1 ( IF STATEMENT FOUND )
*                                R4 = 0 ( IF NOT FOUND )
*
*
*
FNDSTMT  EQU      $
         AI,3     -1
         LB,7     *BIGBUF,3         START LOOKING HERE
         AI,3     1
         CW,3     4
         BE       FNDNO             NOT FOUND
         CI,7     ' '               BLANK?
         BE       FNDSTMT+1         YEP, SO KEEP LOOKING
         LD,10    BLANKS
         LW,8     BLANKS
         LS,8     7
         LW,5     3
         AI,5     3
FNDSTMT1 EQU      $
         SCS,8    8
         LB,7     *BIGBUF,3         GET ANOTHER BYTE
         CI,7     ' '               BLANK?
         BE       FNDSTMT2          YEP
         CW,3     4                 END OF STATEMENT?
         BE       FNDSTMT2          YEP! RWS SAYS SO!
         LS,8     7
         AI,3     1
         CW,3     5                 ARE WE DONE WITH FIRST WORD?
         BNE      FNDSTMT1          NO, SO KEEP ON
         B        FNDSTMT3          YES SO GO DO SECOND WORD
FNDSTMT2 EQU      $
         AI,3     1                 HERE WE MAKE SURE WORD IS
         SW,5     3                 PROPERLY ALIGNED WITHIN
         CI,5     0                 THE REGISTER
         BE       FNDSTMT5
         SCS,8    8
         AI,5     -1
         B        $-4
FNDSTMT3 EQU      $
         STW,8    10
         LW,8     BLANKS
         LW,5     3
         AI,5     4
FNDSTMT3A EQU     $
         LB,7     *BIGBUF,3         GET THE NEXT CHARACTER
         CI,7     ' '               BLANK?
         BE       FNDSTMT4          YEP, MUST BE DONE
         LS,8     7
         SCS,8    8
         AI,3     1
         CW,3     5                 ARE WE REALLY DONE?
         BNE      FNDSTMT3A         NOPE
         SCS,8    -8                YEP, SO ALIGN REGISTER
         STW,8    11                AND STUFF IT
         B        FNDSTMT7
FNDSTMT4 EQU      $
         AI,3     1                 AGAIN WE MUST ENSURE
         SW,5     3                 THAT REGISTER IS PROPERLY
         CI,5     0                 ALIGNED
         BE       FNDSTMT6
         AI,5     -1
         B        $-4
FNDSTMT5 EQU      $
         STW,8    10                STUFF IT
         B        FNDSTMT7
FNDSTMT6 EQU      $
         STW,8    11                STUFF THE SECOND
FNDSTMT7 EQU      $
         LI,6     0
         CD,10    *1,6              CHECK THE LIST OF STATEMENTS
         BE       FNDYES            FOUND A MATCH
         AI,6     1
         CW,6     2                 DONE WITH THE LIST?
         BE       FNDNO             YEP, CANNOT FIND IT
         B        FNDSTMT7+1        NO, SO KEEP LOOKING
FNDYES   EQU      $
         LI,4     1
         B        *12               RETURN - FOUND IT
FNDNO    EQU      $
         LI,4     0
         B        *12               RETURN - NO LUCK
         PAGE
*
*        SUBROUTINE: META1
*
*        PURPOSE: TO IDENTIFY METASYMBOL/AP SOURCE CODE
*
*        CALLING SEQUENCE: BAL,15     META1
*
*        EXIT SEQUENCE: IF META IS FOUND AND FILE HAS JCL:
*                                   BAL,12   FNDNBNG
*                                   B          *15
*                       IF META IS FOUND AND FILE HAS NO JCL:
*                                   B          PROCEXIT
*                       IF NO META IS FOUND:
*                                   AI,15      1
*                                   B          *15
*
*
*
META1    EQU      $
         LI,2     0
         LB,4     *BIGBUF,2         GET FIRST CHARACTER AFTER COMMENTS
         CI,4     ' '               BLANK?
         BNE      $+3
         AI,2     1
         B        META1+1           KEEP LOOKING
         BE       META6             YEP!
         CI,4     'D'
         BE       META2
         CI,4     'R'
         BE       META3
         CI,4     'P'
         BE       META4
         CI,4     'S'
         BE       META5
         CI,4     'T'
         BE       META7
         B        META8
         AI,15    1
         B        *15               RETURN UNSUCCESSFULLY
META2    EQU      $
         LW,3     2
         AI,3     3
         LI,5     X'FF'             MASK FOR LOAD SELECTIVE
META2A   EQU      $
         AI,2     1
         SLS,4    8                 LOOKING FOR DEF DIRECTIVE
         LB,7     *BIGBUF,2
         LS,4     7
         CW,3     2
         BE       $+2
         B        META2A
         CW,4     DEFDATA
         BE       METAYES           FOUND IT
         CW,4     DODATA            DO DIRECTIVE?
         BE       METAYES           YEP
         AI,15    1
         B        *15               RETURN, NOT FOUND
META3    EQU      $
         LW,3     2
         AI,3     3
         LI,5     X'FF'             MASK FOR LOAD SELECTIVE
META3A   EQU      $
         AI,2     1
         SLS,4    8                 LOOKING FOR REF DIRECTIVE
         LB,7     *BIGBUF,2
         LS,4     7
         CW,3     2
         BE       $+2
         B        META3A
         CW,4     REFDATA
         BE       METAYES           FOUND IT
         AI,15    1
         B        *15               RETURN, NOT FOUND
META4    EQU      $
         LW,3     2
         AI,3     3
         LI,5     X'FF'             MASK FOR LOAD SELECTIVE
META4A   EQU      $
         AI,2     1
         SLS,4    8                 LOOKING FOR PAGE DIRECTIVE
         LB,7     *BIGBUF,2
         LS,4     7
         CW,3     2
         BE       $+2
         B        META4A
         CW,4     PAGEDATA
         BE       METAYES           FOUND IT
         AI,15    1
         B        *15               RETURN, NOT FOUND
META5    EQU      $
         LW,3     2
         AI,3     4
         LD,4     BLANKS
         LW,8     BLANKS
         LI,9     X'FF'             MASK FOR LOAD SELECTIVE
         LB,7     *BIGBUF,2
         LS,8     7
         AI,2     1
META5A   EQU      $
         SLS,8    8
         LB,7     *BIGBUF,2         GET THE NEXT CHAR
         LS,8     7                 PRESERVE THE REST
         AI,2     1
         CW,3     2
         BNE      META5A            KEEP LOOKING
         STW,8    4                 GOT THE FIRST PART
         LW,8     BLANKS
         AI,3     3
META5B   EQU      $
         SCS,8    8
         LB,7     *BIGBUF,2
         LS,8     7
         AI,2     1
         CW,3     2
         BNE      META5B            KEEP LOOKING
         SCS,8    8
         STW,8    5
         CD,4     SYSTDATA          LOOKING FOR SYSTEM DIRECTIVE
         BE       METAYES
         AI,15    1
         B        *15               RETURN, NOT FOUND
META6    EQU      $
         AI,2     1
         LB,4     *BIGBUF,2
         CI,4     ' '
         BE       $+2               FOUND A BLANK
         B        META6
         AI,2     1
         LB,4     *BIGBUF,2         GET THE NEXT NON BLANK
         LW,3     2
         AI,3     3
META6A   EQU      $
         AI,2     1
         SLS,4    8
         LB,7     *BIGBUF,2         GET ANOTHER
         LS,4     7
         CW,3     2
         BE       $+2
         B        META6A
         CW,4     EQUDATA
         BE       METAYES           FOUND AN EQU RIGHT NOW
         AI,15    1
         B        *15               RETURN, NOT A SUCCESS
META7    EQU      $
         AI,2     1
         STW,2    3                 WHERE TO START LOOKING
         LW,4     F:110+13          RWS
         LI,5     8
         SW,4     5
         CW,4     2
         BLE      META7A            DONT LOOK IF LAST IS FIRST
         LI,2     1                 ONE ARG.
         LI,1     TITLEDATA         ARG LIST
         BAL,12   FNDSTMT
         CI,4     1                 FOUND?
         BE       METAYES
META7A   EQU      $
         AI,15    1
         B        *15               RETURN - NO LUCK
         BOUND    8
TITLEDATA TEXT    'TITLE   '
META8    EQU      $                 FOR SOME PROC FILES
         AI,2     1
         STW,2    3                 START LOOKING HERE
         LW,4     F:110+13          RWS
         LI,5     4
         SW,4     5                 STOP LOOKING HERE
         CW,4     2
         BLE      META8A            DON'T LOOK IS FIRST IS LAST
         LI,2     1                 NO. OF ARGS
         LI,1     OPENDATA          ADDRESS OF ARG
         BAL,12   FNDSTMT
         CI,4     1
         BE       METAYES           FOUND AP
META8A   EQU      $
         AI,15    1
         B        *15
         BOUND    8
OPENDATA TEXT     'OPEN    '
         LI,6     'Y'
         LI,5     AP
         STB,6    IANSYES,5         FOUND AP/METASYM
         LB,12    JCL
         CI,12    'Y'               JCL IN THIS FILE?
         BNE      PROCEXIT          NOPE, SO BAG IT
         BAL,12   FNDNBNG           YEP, SO KEEP ON TRUCKIN'
         B        *15
         PAGE
*
*        SUBROUTINE: FORT1
*
*        PURPOSE: TO IDENTIFY FORTRAN SOURCE CODE
*
*        CALLING SEQUENCE: BAL,15     FORT1
*
*        EXIT SEQUENCE: IF FORT IS FOUND AND FILE HAS JCL:
*                                   BAL,12   FNDNBNG
*                                   B          *15
*                       IF FORT IS FOUND AND FILE HAS NO JCL:
*                                   B          PROCEXIT
*                       IF NO FORT IS FOUND:
*                                   AI,15      1
*                                   B          *15
*
*
*
FORT1    EQU      $
         LB,5     FNBLNK            GET FIRST NON BLANK
         BAL,12   DECI$MAL          CHECK FOR LEGAL DECIMAL
         B        FORT3             NOPE!
         LI,6     5
         LB,6     *BIGBUF,6         COLUMN 6 BETTER BE BLANK
         CI,6     ' '
         BNE      FORTNO            CAN'T BE FORTRAN
FORT2    EQU      $
         LI,3     7
         LW,4     F:110+13          RWS
         AI,4     -8
         CW,4     3
         BLE      FORTNO            EVEN WITH STMT NOS. GOTTA HAVE
         LI,1     FORTFRST1         STATEMENT BEGINNING AFTER COL 6
         LI,2     FORTNUM1
         BAL,12   FNDSTMT           SEE IF A VALID STMT CAN BE FOUND
         CI,4     1
         B        FORTNO            NOPE
         BOUND    8
FORTFRST1 EQU     $
         TEXT     'READ    '
         TEXT     'WRITE   '
         TEXT     'GO      '
FORTNUM1 EQU      3
FORT3    EQU      $
         LI,3     7                 START LOOKING HERE
         LW,4     F:110+13          RWS
         AI,4     -8
         CW,4     3
         BL       FORTNO            NOT REASONABLY SIZED RECORD
         LI,1     FORTFRST2
         LI,2     FORTNUM2
         BAL,12   FNDSTMT           SEE IF WE CAN FIND ONE
         CI,4     1                 DID WE?
         BE       FORTGO            YEP!
         B        FORTNO            NOPE
         BOUND    8
FORTFRST2 EQU     $
         TEXT     'COMMON  '
         TEXT     'DIMENSIO'
         TEXT     'DOUBLE  '
         TEXT     'REAL    '
         TEXT     'INTEGER '
         TEXT     'COMPLEX '
         TEXT     'LOGICAL '
         TEXT     'FUNCTION'
         TEXT     'SUBROUTI'
         TEXT     'CALL    '
         TEXT     'IMPLICIT'
         TEXT     'GLOBAL  '
FORTNUM2 EQU      12
FORTGO   EQU      $
         LI,1     1
         STW,1    ENDSRCH
         BAL,12   FNDNBNG
         LI,1     0
         STW,1    ENDSRCH           NORMAL RETURN
         M:PRECORD F:110,(N,1),(REV)
         M:READ   F:110,(BUF,*BIGBUF),(SIZE,64000),(WAIT),;
                  (ERR,RDERR),(ABN,RDERR)
         LI,3     7
         LW,4     F:110+13          RWS
         CW,4     3
         BL       FORTNO
         LI,2     1                 NO. OF ARGS.
         LI,1     FORTLST
         BAL,12   FNDSTMT           GO FIND AN END STATEMENT
         BE       FORTYES
         B        FORTNO
         BOUND    8
FORTLST  EQU      $
         TEXT     'END     '
FORTYES  EQU      $
         LI,6     'Y'
         LI,5     FORT
         STB,6    IANSYES,5         FOUND FORTRAN!!!
         LB,12    JCL               DOES FILE HAVE JCL?
         CI,12    'Y'
         BNE      PROCEXIT          NOPE, SO BAG THE REST
         BAL,12   FNDNBNG           YEP, SO KEEP ON LOOKING.
         B        *15
FORTNO   EQU      $
         CI,13    0                 DID WE READ ONWARD?
         BE       $+3               NO, POSITION IS OK
         AI,13    -1                BACK OFF ONE DUE TO PREVIOUS PREC
         M:PRECORD F:110,(N,*13),(REV) AND POSITION TO FIRST VALID
         AI,15    1                 RECORD AND BUMP RETURN
         B        *15               RETURN.....
         PAGE
*
*        SUBROUTINE: BASIC1
*
*        PURPOSE: TO IDENTIFY BASIC SOURCE CODE
*
*        CALLING SEQUENCE: BAL,15     BASIC1
*
*        EXIT SEQUENCE: IF BASIC IS FOUND AND FILE HAS JCL:
*                                   BAL,12   FNDNBNG
*                                   B          *15
*                       IF BASIC IS FOUND AND FILE HAS NO JCL:
*                                   B          PROCEXIT
*                       IF NO BASIC IS FOUND:
*                                   AI,15      1
*                                   B          *15
*
*
*
BASIC1   EQU      $
         LB,5     FNBLNK
         BAL,12   DECI$MAL          IS IT DECIMAL?
         B        BASICNO           NO, SO CANT BE REASONABLE BASIC
         LB,5     COLCOUNT
         BG       BASICNO
         LW,4     F:110+13          GET RWS -
         LB,3     *BIGBUF,5         GET NEXT BYTE
         CI,3     ' '               IS IT BLANK
         BE       BASIC2
         AI,5     1
         CW,5     4                 DONE LOOKING?
         BGE      BASICNO           YEP, WERE DONE.
BASIC2   EQU      $
         AI,5     1                 START LOOKING AFTER THAT COL.
         LW,3     5
         LI,1     BASFRST1
         LI,2     BASNUM1
         BAL,12   FNDSTMT           GO FIND A LEGIT BASIC STMT
         CI,4     1
         BE       BASICYES          FOUND BASIC
         B        BASIC3
         BOUND    8
BASFRST1 EQU      $
         TEXT     'INPUT   '
         TEXT     'PRINT   '
         TEXT     'DIM     '
         TEXT     'OPEN    '
         TEXT     'REM     '
BASNUM1  EQU      5
BASIC3   EQU      $
         LW,4     F:110+13          GET RWS AGAIN
         LB,5     COLCOUNT          NEED TO GET SOME MORE CHARS
         AI,5     -1
BASIC3A  EQU      $
         LB,3     *BIGBUF,5
         CI,3     ' '               IS IT BLANK?
         BE       BASIC4            YEP! SO CARRY ON
         AI,5     1
         CW,5     4                 LOOKED TOO FAR?
         BGE      BASICNO           YEP
         B        BASIC3A           NOPE - KEEP LOOKING
BASIC4   EQU      $
         LB,3     *BIGBUF,5
         CI,3     ' '               BLANK AGAIN? BASIC IS FREE FORM
         BNE      BASIC5            NOPE.
         AI,5     1
         CW,5     4                 GONE TOO FAR?
         BGE      BASICNO           YEP
         B        BASIC4
         LW,2     3
         AND,2    =X'000000F0'
         SLS,2    -4
         CI,2     12
         BL       BASICNO           VAR NAME ILLEGAL.
         CI,2     14
         BG       BASICNO           VAR NAME ILLEGAL
         LW,2     3
         AND,2    =X'0000000F'
         CI,2     9
         BG       BASICNO
         BEZ      BASICNO           NOT A LEGIT LETTER.
         AI,5     1
         LB,3     *BIGBUF,5         GET NEXT CHAR
         CI,3     ' '               BLANK?
         BNE      BASIC6            NOPE
         AI,5     1
         CW,5     4                 GONE TOO FAR?
         BGE      BASICNO           YEP
         B        BASIC7
BASIC6   EQU      $
         XW,3     5                 SWITCH WORDS
         BAL,12   DECI$MAL          LEGAL DECIMAL?
         B        BASIC8            NOPE
         XW,3     5                 SWITCH 'EM BACK
         AI,5     1
BASIC7   EQU      $
         LB,3     *BIGBUF,5         GET NEXT BYTE
         CI,3     ' '               BLANK?
         BNE      BASIC8A           NOPE
         AI,5     1
         CW,5     4                 LOOKED FAR ENUF?
         BGE      BASICNO           YEP
         B        BASIC7
BASIC8   EQU      $
         XW,3     5
BASIC8A  EQU      $
         CI,3     '='               IS IT AN ASSIGNMENT STMT
         BE       BASICYES          YEP
BASICNO  EQU      $
         AI,15    1
         B        *15
BASICYES EQU      $
         LI,6     'Y'
         LI,5     BASIC
         STB,6    IANSYES,5         WE GOT BASIC
         LB,12    JCL
         CI,12    'Y'               JCL IN FILE
         BAL,12   FNDNBNG           FIND THE NEXT BANG CARD
         B        *15               RETURN
SNOBOL1  EQU      $
*
*
*        NOT YET IMPLEMENTED
*
*
         AI,15    1
         B        *15
PL11     EQU      $
*
*
*        NOT YET IMPLEMENTED
*
*
         AI,15    1
         B        *15
XPL1     EQU      $
*
*
*        NOT YET IMPLEMENTED
*
*
         AI,15    1
         B        *15
RPG1     EQU      $
*
*
*        NOT YET IMPLEMENTED
*
*
         AI,15    1
         B        *15
MNGCOM1  EQU      $
*
*
*        NOT YET IMPLEMENTED
*
*
         AI,15    1
         B        *15
ALGOL1   EQU      $
*
*
*        NOT YET IMPLEMENTED
*
*
         AI,15    1
         B        *15
MIX1     EQU      $
*
*
*        NOT YET IMPLEMENTED
*
*
         AI,15    1
         B        *15
SL11     EQU      $
*
*
*        NOT YET IMPLEMENTED
*
*
         AI,15    1
         B        *15
GPDS1    EQU      $
*
*
*        NOT YET IMPLEMENTED
*
*
         AI,15    1
         B        *15
ECAP1    EQU      $
*
*
*        NOT YET IMPLEMENTED
*
*
         AI,15    1
         B        *15
BMDCOM1  EQU      $
*
*
*        NOT YET IMPLEMENTED
*
*
         AI,15    1
SPSSCOM1 EQU      $
*
*
*        NOT YET IMPLEMENTED
*
*
         AI,15    1
         B        *15
CLEANUP  EQU      $
         LI,6     0
         STW,6    COL1
         STW,6    COLCOUNT
         STW,6    RECOUNT
         STW,6    FNBLNK
         LI,1     20
         STB,6    IANSMABE,1
         BDR,1    $-1
         LI,1     20
         LI,6     BLANKS
         STB,6    IANSNO,1
         BDR,1    $-1
         B        *12
PROCEXIT EQU      $
         LW,2     INDOCM
         BEZ      $+2
         BAL,12   COMPCLOS          SPECIAL FOR COMPRESSED FILES
         M:SETDCB F:110,(ERR,OPNERR),(ABN,OPNERR)
         LI,4     0
         LI,2     20
PROCEX1  EQU      $
         LB,3     IANSYES,2         SEARCH THE YES TABLE
         CI,3     'Y'
         BNE      PROCEX1A          NOT THIS ONE
         AI,4     1                 FOUND A YES
         LD,6     ANS
         SLD,6    -8
         STB,2    6                 STOW INFO ABOUT WHAT WE FOUND
         STD,6    ANS
         CI,4     7                 HAVE WE FOUND ALL WE CAN HANDLE
         BE       PROCEX4           IF SO, BRANCH
PROCEX1A EQU      $
         BDR,2    PROCEX1
PROCEX2  EQU      $
         CI,4     1                 ONLY ONE TYPE FOUND
         BNE      PROCEX3           NOT SO
         LB,1     ANS               IS ONLY ONE, GET IT
         STW,1    IANS              AND INFORM THE DRIVER
         B        PROCEXLST
PROCEX3  EQU      $
         CI,4     0                 DIDN'T FIND ANY?
         BNE      PROCEX5           WRONG
         LI,1     0                 RIGHT YOU ARE
         B        PROCEXLST
PROCEX4  EQU      $
         LI,1     X'F0'
         LI,2     109
         STB,1    IOUTBF,2
         AI,2     1                 PUTTING 99 IN LAST MUTIPLE
         STB,1    IOUTBF,2          FILETYPES BUFFER
PROCEX5  EQU      $
         LI,1     20
         STW,1    IANS              TELL DRIVER ABOUT MULTIPLES
         LD,8     ANS               GET ANS IN R8 & R9
         LI,2     95                DISP INTO IOUTBF
PROCEX5A EQU      $
         LB,7     8                 GET A BYTE
         CI,7     10
         BL       $+5               LESS THAN 10
         LI,1     X'F1'
         STB,1    IOUTBF,2
         AI,7     -10               SUBTRACT 10 IF NECESSARY
         B        $+3
         LI,1     X'F0'
         STB,1    IOUTBF,2
         AI,2     1                 BUMP THE INDEX
         OR,7     =X'F0'            OR IN THE REST
         STB,7    IOUTBF,2
         AI,2     1                 BUMP THE INDEX INTO IOUTBF AGAIN
         SLD,8    8                 PREPARE FOR THE NEXT
         BDR,4    PROCEX5A
PROCEXLST EQU     $
         LD,6     BLANKS
         STD,6    ANS               BLANK OUT IMPORTANT STUFF
         LI,1     20
         STB,6    IANSYES,1
         STB,6    IANSNO,1
         BDR,1    $-2
         LI,1     20
         LI,6     0
         STB,6    IANSMABE,1
         BDR,1    $-1
         LI,6     0
         STW,6    COL1
         STW,6    COLCOUNT
         STW,6    RECOUNT
         STW,6    FNBLNK
         LW,15    LINKSAVE
         B        *15               RETURN
         PAGE
*
*
*        PURPOSE: TO POSITION OURSELVES AT THE LAST BANG CARD
*                 BEFORE SOME DATA; HOPEFULLY SOURCE DATA.
*
*        CALLING SEQUENCE: BAL,12   FNDLBNG
*
*
*
FNDLBNG  EQU      $
         LB,2     *BIGBUF           GET BYTE 1
         CI,2     '!'
         BNE      FNDLBNG1          NOT A BANG
         M:READ   F:110,(BUF,*BIGBUF),(SIZE,64000),(WAIT),;
                  (ERR,RDERR),(ABN,RDERR)
         LI,4     79
         LI,8     'Y'
         STB,8    IOUTBF,4          YES VIRGINIA, THERE IS A BANG
         B        FNDLBNG           KEEP LOOKING
FNDLBNG1 EQU      $
         M:PRECORD F:110,(N,2),(REV)
         M:READ   F:110,(BUF,*BIGBUF),(SIZE,64000),(WAIT),;
                  (ERR,RDERR),(ABN,RDERR)
         B        *12               RETURN
         PAGE
*
*        SUBROUTINE: FNDNBNG
*
*        PURPOSE: TO FIND THE NEXT BANG CARD AFTER SOME DATA
*
*        CALLING SEQUENCE: BAL,12   FNDNBNG
*
*
*
FNDNBNG  EQU      $
         LI,13    0                 R13 CONTAINS NO. RECS READ.
         LB,2     *BIGBUF
         CI,2     '!'
         BE       FNDNBNG1           FOUND A BANG
         M:READ   F:110,(BUF,*BIGBUF),(SIZE,64000),(WAIT),;
                  (ERR,RDERR),(ABN,RDERR)
         AI,13    1
         B        FNDNBNG           KEEP LOOKING
FNDNBNG1 EQU      $
         LI,4     79
         LI,8     'Y'
         STB,8    IOUTBF,4          TELL IOUTBF ABOUT JCL
         B        *12               RETURN
         PAGE
*
*        SUBROUTINE: COMPOPN
*
*                 BEING SCANNED ACCOUNT.  THIS IS A TEMPOARY FILE
*                 USED BY FILESCAN TO LOOK AT ORIGIONALLY COMPRESSED
*                 FILES. IT WILL BE CLOSED AND RELEASED LATER.
*
*        CALLING SEQUENCE: BAL,12    COMPOPN
*
*
*
COMPOPN  EQU      $
         LI,2     0                 TURN OFF NEXTFILE
         LI,3     X'400'
         STS,2    OPCF110+1
         LI,3     7
         LI,2     0
COMPOPN1 EQU      $
         LW,4     OPNF110,3
         STW,4    NAMESAVE,2
         AI,2     1
         AI,3     1
         CI,2     8
         BE       COMPOPN2          DONE SAVING FILE NAME
         B        COMPOPN1
COMPOPN2 EQU      $
         LW,4     OPNF110+18        GOTTA TAKE CARE OF SN, IF ANY
         STW,4    OPCF110+18
         LW,4     OPNF110+19
         STW,4    OPCF110+19
         LW,4     F:110+32          AND THE ACCOUNT
         STW,4    OPCF110+16
         LW,4     F:110+33
         STW,4    OPCF110+17
         LI,4     3                 AND THE TEXTC COUNT OF NAME
         LI,5     28
         STB,4    OPCF110,5
COMPOPN3 EQU      $
,OPCF110 M:OPEN   F:110,(IN),(REL),(ABN,RDERR),(ERR,RDERR),(SN,'    '),;
                  (FILE,'X-$                            ','        ')
         M:READ   F:110,(BUF,*BIGBUF),(SIZE,64000),(WAIT),;
                  (ERR,RDERR),(ABN,RDERR)
         B        *12               RETURN
         PAGE
*
*        SUBROUTINE: COMPCLOS
*
*        PURPOSE: TO CLOSE F:110 (RELEASE) WHEN LOOKING AT AN
*                 ORIGIONALLY COMPRESSED FILE
*
*        CALLING SEQUENCE:  BAL,12    COMPCLOS
*
*
*
COMPCLOS EQU      $
         LI,2     X'400'            TURN ON NEXT FILE
         LI,3     X'400'
         STS,2    OPCF110+1
         LI,3     7
         LI,2     0
COMPCLOS1 EQU     $
         LW,4     NAMESAVE,2
         STW,4    OPNF110,3         PUT THE NAME BACK IN THE FPT
         AI,2     1
         AI,3     1
         CI,2     8
         BE       COMPCLOS2         DONE
         B        COMPCLOS1
COMPCLOS2 EQU     $
         M:CLOSE  F:110,(REL)
         B        *12               RETURN
         PAGE
*        SUBROUTINE: CLOS
*
*        PURPOSE: TO CLOSE THE F:110 DCB WHICH READS ALL THE
*                 BLOODY FILES WE ARE TRYING TO IDENTIFY
*
*        CALLING SEQUENCE: CALL CLOS
*
*        ARGUMENTS: IOUTBF - 112 BYTE FIELD THAT CONTAINS ALL SORTS
*                            OF INFORMATION ABOUT CURRENT FILE.
*
*        ( IOUTBF IS GLOBALED BY THE FORTRAN DRIVER PROGRAM )
*
*                                        INSERT SOME LATER
*
*
*
CLOS     EQU      $
         LW,1     =X'80000100'
         STW,1    CLOSFPT+1         VLPS ARE PRESENT
,CLOSFPT M:CLOSE  F:110,(SAVE)
         LI,3     X'FA00'
         STW,3    RDFST+5           SET IT BACK TO 64000 BYTES
         LI,3     14
         LW,2     BLANKS
         STW,2    OPNF110,3         BLANK OUT THE FILENAME FIRST
         CI,3     7                 ARE WE DONE?
         BE       $+2
         BDR,3    $-3               NOPE
         LI,3     7
         LI,1     X'17'
CLOS1    EQU      $
         LW,2     F:110,1           GET THE FILE NAME OUT OF
         STW,2    OPNF110,3         DCB AND PUT IN FPT
         BE       CLOS2             WERE DONE
         AI,1     1
         AI,3     1
         B        CLOS1             GO  GET THE REST OF FILENAME
CLOS2    EQU      $
         LI,4     79                DISPLACEMENT INTO IOUTBF
         LB,8     JCL
         STB,8    IOUTBF,4          STUFF IT IN THE JCL INDICATOR
REINIT   EQU      $
         LI,8     'N'
         STB,8    JCL
         LI,8     0
         STW,8    VARKEYSZ          ZERO OUT THE VARKEYSZ FLAG
         STW,8    MAXRECL           SAME FOR THE MAXRECL LOC
         STW,8    VARRECL           DITTO FOR THE VARIABLE REC FLAG
         B        *15               RETURN
         PAGE
*        SUBROUTINE: FREEPG
*
*        PURPOSE: TO FREE DYNAMIC PAGES USED IN READING
*                 LARGE RECORDS.
*
*        CALLING SEQUENCE: CALL FREEPG
*
*        ARGUMENTS: NONE
*
*
*
FREEPG   EQU      $
         M:FP     32
         B        *15               RETURN
         PAGE
*        SUBROUTINE: PFIL
*
*        PURPOSE: TO POSITION KEYED FILES TO THE (BOF) FOR
*                 THE DRIVING PROGRAM.  USED IN CONJUNCTION
*                 WITH THE +COUNT OPTION.
*
*        CALLING SEQUENCE: CALL PFIL
*
*        ARGUMENTS: NONE
*
*
*
PFIL     EQU      $
         M:PFIL   F:110,(BOF)
         B        *15               RETURN
         PAGE
*        SUBROUTINE: KOUNT
*
*        PURPOSE: TO CONVERT FOR THE DRIVER A BINARY  NUMBER
*                 INTO EBCDIC AND PUT IT IN THE IOUTBF.
*                 SPECIFICALLY FOR KEYED FILES.  RANDOM AND
*
*        CALLING SEQUENCE: CALL KOUNT
*
*        ARGUMENTS: NONE
*
*
*
KOUNT    EQU      $
         LI,7     32767
KOUNT1   EQU      $
         M:PRECORD F:110,(N,32767),(ABN,KOUNT2),(FWD)
         AI,7     32767
         B        KOUNT1
KOUNT2   EQU      $
         LW,1     F:110+4
         SLS,1    -17
         SW,7     1                 THIS IS THE RECORD COUNT
         LI,2     94                POSITION INTO IOUTBF
         LI,10    IOUTBF            THE BUFFER ADDRESS ITSELF
         BAL,12   BIN2DEC
         B        *15               RETURN
         PAGE
*
*
*
*        FOLLOWING ARE ASSEMBLY LANGUAGE SUBROUTINES NEEDED
*        TO PERFORM VARIOUS TASKS FOR THE MAIN AP SUBROUTINES
*        OF FILESCAN
*
*
*
*
*
*
*        SUBROUTINE: FPARAM
*
*        PURPOSE: TO SEARCH FOR A SPECIFIED VLP IN THE FPARAM TABLE
*
*        CALLING SEQUENCE: BAL,12 FPARAM
*
*        ARGUMENTS: AT ENTRY  - R1 = REQUESTED VLP CODE NO. IN HEX
*
*                   AT EXIT   - R1 = 1 IF PARAM WAS FOUND, 0 IF NOT
*                               R2 = WA OF FIRST WORD OF THE VLP
*                                    DATA IN FITBUF
*                               R3 = NUMBER OF SIGNIFICANT DATA WORDS
*
*
*
FPARAM   EQU      $
         LI,7     1                 INDEX TO LAST VLP INDICATOR
         LI,5     3                 INDEX INTO RESERVED WORD NUMBER
         LI,6     0                 INDEX INTO FITBUF
FPARAM1  EQU      $
         LW,4     FITBUF,6          GET A CONTROL WORD
         BE       FOUNDIT           YEP!
         CB,7     4,7               IS IT THE LAST ONE?
         BE       NONESUCH          YEP!
         LB,3     4,5               GET SIGNIFICANT WORDS
         AW,6     3                 BUMP WORD INDEX INTO FITBUF
         AI,6     1                 TO GET TO NEXT CONTROL WORD
         B        FPARAM1           KEEP SEARCHING
FOUNDIT  EQU      $
         LI,1     1                 FOUND INDICATOR
         LB,3     4,5               NO OF SIGNIFICANT WORDS
         LI,2     FITBUF            ADDRESS OF FITBUF LOC
         AW,2     6                 PLUS THE DISPLACEMENT
         AI,2     1
         B        *12               RETURN
NONESUCH EQU      $
         LI,1     0                 NOT FOUND INDICATOR
         B        *12               RETURN
*
*
*
*        SUBROUTINE: BIN2DEC
*
*        PURPOSE: TO CONVERT A BINARY NUMBER TO A
*                   PRINTABLE DECIMAL NUMBER
*
*        CALLING SEQUENCE: BAL,12 BIN2DEC
*
*        ARGUMENTS: ON ENTRY  - R10 = DESTINATION MESSAGE ADDRESS
*                               R2  = DISPLACEMENT OF LOW ORDER NO.
*                               R7  = THE BINARY NUMBER TO BE CONVERTED
*
*
*
BIN2DEC  EQU      $
         LI,8     10                DIVIDE BY 10(DECIMAL)
BIN2DEC1 EQU      $
         LI,6     0                 MUST BE ZERO FOR DIVIDE
         DW,6     8
         OR,6     =X'F0'            MAKE REMAINDER PRINTABLE
         STB,6    *10,2             STORE IT
         CI,7     0                 ARE WE DONE?
         BE       BIN2DEC2          IF YES, BRANCH
BIN2DEC2 EQU      $
         B        *12               RETURN
*
*
*
*        SUBROUTINE: DATESTUF
*
*        PURPOSE: TO PUT CREATE, MODIFY AND ACCESS DATES
*                 INTO PROPER POSITION IN IOUTBF
*
*        CALLING SEQUENCE: BAL,12   DATESTUF
*
*        ARGUMENTS: ON ENTRY  - R2 = WA OF WORD ONE OF DATE TO STUFF
*                               R1 = BYTE DISPLACEMENT INTO IOUTBF
*
*
*
DATESTUF EQU      $
         LI,3     0                 INDEX INTO DATE
         LB,4     *2,3              GET A BYTE
         STB,4    IOUTBF,1          JAM IT!
         AI,1     1                 BUMP THE INDICATORS
         AI,3     1
         CI,3     4                 DONE WITH MM/DD
         BL       DATESTUF+1        IF NOT, GO GET ANOTHER
DOYEAR   EQU      $
         AI,3     2                 INDEX INTO YEAR
         LB,4     *2,3              GET YY
         STB,4    IOUTBF,1          AND STOW IT
         AI,1     1                 BUMP INDEX
         AI,3     1
         CI,3     8                 ARE WE DONE?
         BL       DOYEAR+1          BRANCH IF NOT
         B        *12               ELSE RETURN
*
*
*
         PAGE
*
*
*
*        THIS AREA CONTAINS VARIOUS DATA AND CONSTANTS
*        USED BY THE ROUTINES CONTAINED IN METASCAN.
*
*
*
         BOUND    8
BLANKS   DATA,8   X'4040404040404040'
ANS      TEXT     '        '
HOLDACCT DATA     0,0
ISN      DATA     0
BIGBUF   DATA     0
ENDSRCH  DATA     0                 FLAG RE: END OF SEARCH
FITBUF   RES      90
ORG      RES      1
ONOFFLG  DATA     X'00800000'       MASK FOR NXTA
NACTOFF  DATA     X'0'
NACTON   DATA     X'00800000'       TURN IT ON
BUSY     DATA     0                 BUSY FILE FLAG
ORIGBYTE DATA     0                 ORIG BYTE DISP FOR MBS
DESTBYTE DATA     0                 DEST BYTE DISP FOR MBS
LENGTH   DATA     0                 LENGTH IN BYTES FOR MBS
NPAGES   TEXTC    'CANT GET ENOUGH DYNAMIC PAGES FOR READ'
VARKEYSZ DATA     0                 FLAG FOR VARIABLE KEY SIZE
MAXRECL  DATA     0                 HOLDS SIZE OF MAX RECL
VARRECL  DATA     0                 FLAG FOR VARIABLE REC SIZE
JCL      TEXT     'N   '            CONTAINS JCL FLAG
KEYSAVE  RES      8                 PLACE TO SAVE A KEY
KEYSAVE1 RES      8                 ANOTHER PLACE
DICFOUND DATA     0                 NON-ZERO IF A :DIC PREVIOUSLY FOUND
HEAD     TEXT     'HEAD'
HOLDBYTE DATA     0
NAMESAVE RES      8
COL1     DATA     0                 CONTENTS OF FIRST COL REGARDLESS
COLCOUNT DATA     0                 COL NO CONTAINING FIRST NON BLANK
FNBLNK   DATA     0                 THE NON-BLANK CHARACTER ITSELF
RECOUNT  DATA     0                 RECORD COUNTER
IDENT    TEXT     'IDEN'
DIVISION TEXT     'DIVI'
         BOUND    8
CONTROL  TEXT     '*CONTROL'
GPDSDATA TEXT     ' GPDS   '
SIMULATE TEXT     'SIMULATE'
SYSTDATA TEXT     'SYSTEM  '
PROGDATA TEXT     'PROGRAM '
LILPROG  DATA     X'97999687',X'99819440'
DODATA   TEXT     'DO  '
DEFDATA  TEXT     'DEF '
REFDATA  TEXT     'REF '
PAGEDATA TEXT     'PAGE'
EQUDATA  TEXT     'EQU '
         BOUND    8
APNAME   EQU      $
         TEXT     '!FORTRAN','!FORT4  ','!COBOL  ','!BASIC  ',;
                  '!FORT   ','!FLAG   ','!META   ','!SNOBOL4',;
                  '!ALGOL  ','!LISP   ','!MIX    ','!SNOBOL ',;
                  '!PL1    ','!SL1    ','!GPDS   ','!CIRC   ',;
                  '!XPL    ','!ECAP   ','!DICTNAR','!FILEUP ',;
                  '!RETRIEV','!REPORT ','!BMD    ','!SPSS   '
NAMETOTL EQU      27
         BOUND    4
GARBNAME EQU      $
         TEXT     '!PCL','!FSA','!RUN','!SOR','!MER','!PMD',;
                  '!LEM','!FRE','!BCD','!BIN'
GARBINDX EQU      $-GARBNAME-1
         BOUND    8
BANGDATA EQU      $
         TEXT     '!DATA   '
         BOUND    4
APIANS   EQU      $
         DATA,1   1,1,2,3,4,4,5,6,1,1,4,10,7,8,9,10,11,12,13,14,;
                  15,16,17,17,17,17,18,19
         BOUND    4
IANSTBL  EQU      $
         DATA,1   0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20
         BOUND    4
IANSYES  EQU      $
         DO1      21
         DATA,1   ' '
         BOUND    4
IANSNO   EQU      $
         DO1      21
         DATA,1   ' '
         BOUND    4
IANSMABE EQU      $
         DO1      21
         DATA,1   0
         BOUND    4
MABEMAX  EQU      $
         DATA,1   0,2,0,1,1,0,0,0,0,0,1,0,0,3,0,0,1,0,0,0,0
*                                   MUST BE CHANGED WHEN
*                                   THE REAL MAX IS KNOWN
         BOUND    4
*
*
         PAGE
*
*
*
*        ERROR HANDLING ROUTINES
*
*
*
*
*
*
*        THIS IS WHERE WE END UP IF AN ERROR IS ENCOUNTERED
*        DURING  AN OPEN.  SOME OF THESE ERRORS ARE VALID
*
*
*
*
OPNERR   EQU      $
         LB,1     10                GET ERRCODE
         CI,1     X'08'             IS IT SYNON
         BNE      $+4               NOPE
         LI,2     1
         STW,2    ISYNON
         B        NEXTOFF
         CI,1     X'02'             ERRCODE '02'?
         BNE      OPNERR2           NOPE - SOMETHING BAD WRONG
         LI,2     1                 INDEX PROPERLY
         LB,3     10,2              GET THE SUBCODE
         SLS,3    -1
         CI,3     1                 END OF ALL FILES?
         BNE      OPNERR1           NO JUST THE ACCT
         STW,1    IERROR            YES, SO TELL DRIVER PROGRAM
         B        *15
OPNERR1  EQU      $
         CI,3     0                 ERROR '0200'?
         BNE      OPNERR2           NOPE
         LW,3     ONOFFLG
         LW,2     NACTON            TURN ON NEXTA
         STS,2    OPNF110           STUFF IT IN THE FPT
         LI,3     14
         LW,2     BLANKS
         STW,2    OPNF110,3         BLANK OUT THE FILENAME
         CI,3     7
         BE       $+2               WERE DONE
         BDR,3    $-3               CONTINUE
         LD,2     F:110+32          GET CURRENT ACCOUNT
         STD,2    OPNF110+16        STUFF IT IN THE FPT
         B        NEXT
OPNERR2  EQU      $
         CI,1     X'14'
         BE       OPNERR2A
         CI,1     X'46'             BUSY ON A READ?
         BNE      OPNERR3
         LH,3     10                GET THE ENTIRE CODE
         AND,3    =X'00FE'
         SLS,3    -1                GET RID OF JUNK
         CI,3     X'14'
         BE       OPNERR2A
         B        OPNERR3
OPNERR2A STW,1    IERROR            TELL DRIVE
         STW,1    BUSY              SET BUSY FILE FLAG
         B        NEXTOFF           GET FID ANYWAY
OPNERR3  EQU      $
         M:SNAP   'OPNERR',(FITBUF,FITBUF+89)
         M:SNAP   'F:110',(F:110,F:110+40)
         M:XXX
*
*
*
PARAMERR EQU      $
         M:SNAP   'PARAMERR',(FITBUF,FITBUF+89)
         M:XXX
         PAGE
*
*
*
*        THIS IS WHERE WE END UP IF THERE IS AN ERROR DURING
*        A READ OF THE FIRST RECORD. SOME OF THESE ERRORS ARE
*        VALID, SUCH AS END OF FILE AND WILL BE HANDLED
*        ACCORDINGLY.  ON BAD ERRORS A SNAP IS GIVEN AND
*        CONTROL RETURNED TO CALLING PROGRAM.
*
*
*
RD1ERR   EQU      $
         LI,1     3
         LB,8     10                GET THE MAJOR ERROR CODE
         STW,8    IERROR            AND TELL THE DRIVER
         CI,8     5                 END OF DATA?
         BE       RD1ERR1           IF SO, OK
         CI,8     6                 END OF FILE?
         BE       RD1ERR1           IF SO, OK
         M:SNAP   'RD1ERR'
RD1ERR1  EQU      $
         B        *15               RETURN
         PAGE
*
*
*
*        THIS IS WHERE WE END UP IF THERE IS AN ERROR
*        READING A SUBSEQUENT RECORD OF THE FILE BEING
*        SCANNED FOR ITS CONTENTS
*
*
*
RDERR    EQU      $
         LB,2     10
         CI,2     5                 END OF DATA?
         BE       $+3               YEP, OK
         CI,2     6                 END OF FILE?
         BNE      $+2               NOT SO GOOD
RDERR1   EQU      $
         M:SNAP   'RDERR',(F:110,F:110+40)
         M:XXX
*
*
*
EOFOUND  EQU      $
         LW,1     ENDSRCH           ARE WE DONE SEARCHING?
         BNEZ     *12               NOPE
         B        PROCEXIT
*
*
*
         PAGE
*
*
*
*        THIS IS WHERE WE END UP IF THERE IS AN ERROR
*        IN TESTING FOR :DIC/:LIB OR LEMUR TYPE LIBRARIES
*
*
*
LBRDERR  EQU      $
         LB,4     10                GET THE MAJOR CODE
         CI,4     X'43'             REC WITH KEY NOT FOUND?
         BE       $+2               IF SO OK - MAYBE
         CI,4     X'42'             INVALID KEY?
         BE       $+2               OK
         B        LBRDERRX          IF NOT ABORT
         STW,15   LINKSAVE
         BAL,15   LIBTST4           GO CLEAN OUT OUR SYSTEM
         LW,15    LINKSAVE
         B        LIBTST2
LBRDERR1 EQU      $
         LB,4     10
         CI,4     3                 NO SUCH FILE?
         BE       LIBTST3
         CI,4     X'43'             REC WITH KEY NOT FOUND?
         BE       $+2               YEP
         CI,4     X'42'             INVALID KEY?
         BE       $+2               YEP
         B        LBRDERRX          NOPE - SO ABORT
         M:CLOSE  F:111,(SAVE)
         LI,1     0
         STW,1    IANS
         B        LIBTST4           GET OUTTA HERE
LBRDERRX EQU      $
         M:SNAP   'F:110',(F:110,F:110+32)
         M:SNAP   'F:111',(F:111,F:111+32)
         M:XXX
         END
