         PCC      1
         SYSTEM   SIG7
         TITLE    'LEMUR -- CONTROL MODULE'
         SPACE
*P*************************************************************
*P*
*P*  NAME:
*P*      LEMUR1   CONTROL MODULE FOR LEMUR;  CONTAINS SCANNER, DRIVERS
*P*
*P*  FUNCTION:
*P*      READS INPUT COMMANDS FROM THE SI DEVICE, PERFORMS
*P*      ALL SCANNING OF COMMAND, AND DISPATCHES TO THE
*P*      APPROPRIATE ROUTINE.  ALSO PERFORMS INITIALIZATION AS
*P*      REQUIRED.
*P*
*P*************************************************************
         SPACE
VER#     EQU      'A01'             VERSION #
         TITLE    'LEMUR1 -- REFS AND DEFS'
         SPACE
*
*  REFS & DEFS---
*
* (1)    EXTERNAL SUBROUTINES:
         SPACE
         REF      SIREAD            RTN:  READ A COMMAND.
         REF      FREESPC           RTN:  RELEASE ALLOCATED SPACE
         REF      WINDOWN           RTN:  DOES WORK TO EXIT TO MONITOR
         REF      ERRENT            RTN:  ERROR HANDLER
         REF      ADD#              RTN:  DOES WORK FOR 'ADD' COMMAND
         REF      LIB#              RTN:  DOES WORK FOR 'LIBRARY' COMMAND
         REF      OPENSI            OPENS M:SI FOR INPUT
         REF      OPENLL            OPENS M:LL FOR OUTPUT
         REF      OPENDO            OPENS M:DO FOR OUTPUT
         REF      CKCORR            DETERMINES WHICH DCB IS WHO.
         REF      WRITEDO           WRITES A RECORD TO M:DO
         REF      WRITELL           WRITES A RECORD TO M:LL
         REF      APPEND            APPENDS ONE STRING TO ANOTHER.
         REF      SETRAPS           SETS UP TRAP CONTROL
         REF      DELETE#           RTN:  DOES WORK FOR 'DELETE'
         REF      CARRY#
         REF      CLSDCB
         REF      SETNAME           SET FILE NAME IN DCB
         REF      COPY#
         PAGE
         SPACE
*
* (2)  EXTERNALLY DEFINED LITERALS  --
         REF      BLANK             CELL:  C'    ' = X'40404040'
         REF      M24               CELL:  X'00FFFFFF', USED TO
*,*                                        GET X'FF000001'.
         REF      X7F               CELL:  X'7F', USED TO BUILD SHIFT
*,*                                        COUNT IN EXTOPT.
         REF      YFF               CELL:  X'FF000000'
         REF      Y01               CELL:  X'01000000'
         PAGE
         SPACE
*
* (3)  EXTERNALLY DEFINED TABLES --
         REF      COMTBL            WORD VECTOR OF COMMAND DESCRIPTORS
         REF      CMDNDX            BYTE VECTOR OF INDICES TO COMMAND DATA
         REF      CAOPT             WORD VECTOR OF ALLOWED OPTIONS
         REF      CVECT             WORD VECTOR OF COMMAND HANDLERS
         REF      CDFOPT            WORD VECTOR OF DEFAULT OPTIONS
         SPACE
         REF      OPTBL             DOUBLE WORD VECTOR OF OPTION NAMES
         REF      OPFLGS            WORD VECTOR OF OPTION FLAGS; PARALLEL
*,*                                 TO OPTBL
         REF      SAOPT             WORD VECTOR OF OPTION HANDLERS.
         PAGE
         SPACE
*
* (4) EXTERNALLY DEFINED ERROR CODES --
         REF      E#ACTL            ACCOUNT NAME TOO LONG.
         REF      E#BFID            BAD FILE IDENTIFIER
         REF      E#BQS             BAD QUOTE STRING
         REF      E#EEOL            EXPECTED END OF LINE, DIDN'T FIND IT.
         REF      E#EH              SAW SOMETHING REALLY BIZZARE.
         REF      E#FNTL            FILE NAME TOO LONG.
         REF      E#ILCL            ILLEGAL CONTINUATION LINE.
         REF      E#IOTC            ILLEGAL OPTION FOR THIS COMMAND
         REF      E#LNTL            LIBRARY NAME TOO LONG.
         REF      E#MFID            MISSING FILE ID
         REF      E#MLID            MISSING LIBRARY ID
         REF      E#MFO             MALFORMED OPTION
         REF      E#MLTOP           MULTIPLY-USED OPTION
         REF      E#MRP             MISSING RIGHT PAREN
         REF      E#NONM            NO MODULE NAME WHEN ONE WAS EXPECTED
         REF      E#PWTL            PASSWORD TOO LONG.
         REF      E#UNKCM           UNKNOWN COMMAND
         REF      E#UNKOP           UNKNOWN OPTION
         REF      E#SLSADL
         REF      E#NES             NOT ENUFF SYMBOL SPACE.
         PAGE
         SPACE
*
* (5) EXTERNALLY DEFINED MONITOR INFORMATION --
         REF      J:TCB             CELL:  POINTER TO TCB STACK.
         REF      J:ACCN
         REF      F:LIB
         REF      F:SORS
         SPACE
*
* (6) EXTERNALLY DEFINED CONSTANTS --
         REF      COMTBLS           CONST: SIZE OF COMMAND TABLE
         REF      OPTMAX            CONST: SIZE OF OPTION TABLE
         REF      #EOL              CONST: CHARACTER WHICH INDICATES E.O.L
         REF      DEST              DEFAULT DESCRIPTS OF LIBRARY.
         SPACE    2
*
* (7) EXTERNALLY DEFINED OPTION MASKS --
         REF      O%SL              MASK:  SELECTS SL FIELD IN C%OPTS
         PAGE
         SPACE
*
* (8) EXTERNAL DYNAMIC DATA --
         REF      AOPTS             WORD:  MASK OF ALLOWED OPTIONS
         REF      C%OPTS            DWORD:  OPTION VALUES, SELECTION MASK
         REF      CHPT              WORD:   DESCRIPTOR OF UNSCANNED
*,*                                        PORTION OF INPUT LINE.
         REF      DESCNDX           WORD:   INDEX TO NEXT FREE WORD IN
*,*                                        DESCRIPTOR POOL
         REF      DO#LL             CC:    SET ==> M:DO .NE. M:LL
         REF      DSCPOOL           WORD VECTOR:  DESCRIPTORS OF SCANNED
*,*                                        ATOMS.
         REF      ERRHIT            CELL:  # OF ERRORS SEEN TO DATE.
         REF      INBUF             BYTE VECTOR:  CONTAINS INPUT LINE.
         REF      SCTBL             WORD VECTOR:  CONTAINS TYPES & INDICES
*,*                                 OF SCANNED TOKENS.
         REF      SCTBNDX           WORD:  INDEX TO NEXT FREE WORD IN
*,*                                        SCTBL.
         REF      STKPTR            DWORD: COPY OF INITIAL TEMP STACK'S
*,*                                        SPD--USEFUL FOR ERROR RECOVERY
         REF      XFLAG             CC:    SET ==> ABORT ON DETECTION OF
*,*                                        ERROR.
         REF      D:DESTLIB         3-WORD VECTOR OF DESCRIPTORS
*,*                                 FOR WORKING LIBRARY
         REF      D:DESTMOD         DESCRIPTOR OF DESTINATION MODULE.
         REF      D:SORSMOD         DESCRIPTOR FOR SOURCE MODULE.
         REF      D:SORSLIB         3-WORD VECTOR OF DESCRIPTORS
*                                   FOR SOURCE LIBRARY.
         REF      L:DCB
         REF      ROMBUF
         REF      L:BUF
         REF      WORKLIB           WORKING LIBRARY
         REF      O%ROM             ROM OR LDM
         REF      E#CCRL            ERROR: CAN'T CREATE LIBRARY.
         REF      D:J:ACCN
         PAGE
         SPACE
*
* (9) ROUTINES WHICH THIS MODULE DEFINES --
         DEF      ADD%              RTN:  SCANNER FOR 'ADD'
         DEF      END%              RTN:  SCANNER FOR 'END'
         DEF      LIB%              RTN:  SCANNER FOR 'LIBRARY'
         DEF      DELETE%           SCANNER FOR 'DELETE'
         DEF      CARRY%            SCANNER FOR 'CARRY'
         DEF      LEMUR             RTN:  START ADDRESS
         DEF      LEMUR1                  ZERO ADDRESS FOR MODULE
         DEF      DONE              RTN:  EXIT POINT FOR COMMAND HANDLERS
         DEF      DOSL              RTN:  SCANS (SL,X) OPTION
         DEF      EXTOPT            RTN:   EXTRACTS OPTION VALUE
         DEF      RESTART           RTN:   RESTARTS LEMUR
         DEF      RETURN            RTN:   DOES POPJ
         DEF      RETCC0            RTN:   DOES RETURN, CC:=0
         DEF      RETCC3            RTN:   DOES RETURN, CC:=3
*
         DEF      COMPARE
         DEF      COPY%
*  (10)  EXTERNALLY DEFINED SYMBOLS
         REF      SCTBL#            SIZE OF SCAN TABLE
         TITLE    'LEMUR1 -- MISCELLANEOUS DEFINITIONS'
         SPACE
***************************************************************
*
* REGISTER DEFINITIONS
*
I0       EQU      0
I1       EQU      1
I2       EQU      2
I3       EQU      3
T0       EQU      4
T1       EQU      5
T2       EQU      6
T3       EQU      7
R0       EQU      8
R1       EQU      9
R2       EQU      10
R3       EQU      11
A0       EQU      12
A1       EQU      13
A2       EQU      14
A3       EQU      15
RTN      EQU      A3
*
* I AGREE, THEY ARE RATHER NON-STANDARD.
*
***************************************************************
         PAGE
         SPACE
*************************************************************
*
* CONTROL SECTIONS --
*
         SPACE
CODE     CSECT    1
STRINGS  CSECT    1
         PAGE
         SPACE
***************************************************************
*
*  TYPES OF OBJECTS IN SCTBL--
*
* NAME            VALUE             MEANING                DESCRIPTORS
* ----            -----             -------                -----------
         SPACE
T%MNAME  EQU      1                 MODULE NAME            1
T%GRP    EQU      2                 GROUP NAME             1
T%DNAME  EQU      3                 SYMBOL (DEF)           1
T%LID    EQU      4                 LIBRARY NAME (N).A.P   3
T%FID    EQU      5                 FILE NAME N(.(A)(.P))  3
T%DEF    EQU      6                 DEF W/ MNAME DEF>>M    2
T%EOL    EQU      7                 END OF LINE
T%GRNCH  EQU      8                 N(.(A)(.P))<GNAM>/MNAM 5
T%UN     EQU      9                 + (UNION OP)           0
T%INT    EQU      10                - (INTERSECTION)       0
T%EQ     EQU      11                = (REPLACEMENT)        0
T%ON     EQU      12                'ON'/'TO'              0
T%OVER   EQU      13                'OVER'                 0
T%USING  EQU      14                'USING'                0
         TITLE    'LEMUR1 -- MACROS'
         SPACE
***************************************************************
*
*  MISCELLANEOUS MACROS--
*
*        CALL     ROUTINE
*                 EMITS A STANDARD (BAL,RTN) CALL TO AF(1)
*
CALL     S:SIN,1  X'6AF'
         SPACE
*
*
* SUBROUTINE:
*        GENERATES A 'PSW,15 *J:TCB'
*
SUBROUTINE ;
         CNAME
         PROC
LF       EQU,0    %
         PSW,RTN  *J:TCB
         PEND
         PAGE
         SPACE
*
*        PUSH     R                 PUSHES REGISTER 'R' ONTO TEMP STACK IN TCB
*        POP      R                 POPS TCB STACK INTO REGISTER R
*        PUSH     R1,R2             PUSHES REGISTERS R1 THROUGH R2 ON
*                                   TCB TEMP STACK
*        POP      R1,R2             POPS REGISTERS R1 THROUGH R2 FROM
*                                   TCB TEMP STACK
*
         SPACE
PUSH     CNAME    1
POP      CNAME    0
         PROC
LF       EQU,0    %
         LOCAL    I
         DO       NUM(AF)>1
I        SET      ((AF(2)-AF(1))+17)&X'F'
         DO1      I=1
I        SET      0
         LCI      I
         ELSE                       JUST A SIMPLE PSW,OR PLW, PLEASE.
I        SET      1                 PUSHING 1 WORD.
         FIN
         GEN,1,5,1,1,4,3,17 1,2,I~=1,NAME,AF(1),0,J:TCB
         PEND
         PAGE
         SPACE
*
* CHRNG --
*        GENERATES ARGUMENTS FOR RANGE ROUTINE;  TEMPLATE IS:
*
*        CHRNG (*)'X','Y'
*
*        WHERE 'X' AND 'Y' ARE SINGLE CHARACTERS, SPECIFYING THE
*        BEGINNING AND END OF A RANGE OF CHARACTERS.  THE * INDICATES
*        THAT THIS IS THE LAST ITEM IN THE LIST.
*
         SPACE
CHRNG    COM,1,15,16  AFA(1),AF(1),AF(2)
         PAGE
         SPACE
*
*  D(STRING)
*        RETURNS AS ITS VALUE THE DESCRIPTOR OF ITS ARGUMENT
D        FNAME
         PROC
         LOCAL    HERE,I
HERE     EQU      %
         USECT    STRINGS
I        TEXT     AF
         USECT    HERE
         PEND     (S:NUMC(AF)**24)+BA(I)
         SPACE
*
*  E(ERROR NUMBER)
*        RETURNS AS ITS VALUE THE ADDRESS TO BRANCH TO FOR
*        THAT ERROR CODE.
*
E        FNAME
         PROC
         PEND     AF
*
         TITLE    'LEMUR1 -- COMMAND SCANNING LOOP'
         SPACE
         USECT    CODE
LEMUR1   EQU      %
VERSION  EQU,5    %
         DATA     VER#              VERSION STAMP.
*
* READ A COMMAND, FIND IN TABLES, AND DISPATCH.
*
RESTART  LD,R0    STKPTR            REWIND STACK,
         STD,R0   *J:TCB            SO HARD.
         B        COMMAND           AND GO GET NEXT.
LEMUR    CALL     INITIAL
COMMAND  EQU      %
         LI,T2    F:SORS
         BAL,T3   CLSDCB
         LI,T2    F:LIB
         STW,T2   L:DCB
         BAL,T3   CLSDCB
         LI,R0    ROMBUF
         STW,R0   L:BUF
         CALL     READ
         BAL,T1   SPACES            SLURP UP SPACES
         BE       COMMAND           B/ IT'S NULL.  NOTHING TO DO.
         BAL,RTN  EATNAME+1         GET DESCRIPTOR OF CMD IN A2
         BNE      E(E#EH)           B/ WHAT WAS THAT?????
         LI,I1    +0                GET INDEX,
         LW,A3    YFF               GET MASK FOR LENGTH COMPARE,
         LI,R0    +COMTBLS          AND GET ITERATION COUNT.
*
COMNDL   CS,A2    COMTBL,I1         IS (A2) A SUBSTRING OF NEXT IN TABLE?
         BLE      COMNDCP           B/ YES, TRY A COMPARE.
COMNDNX  AI,I1    +1                NO:  TRY NEXT IN TABLE
         BDR,R0   COMNDL            B/ ANOTHER POSSIBILITY.
         B        E(E#UNKCM)        B/ ALL EXHAUSTED, I JUST DON'T KNOW THAT ONE
         SPACE
* WE HAVE FOUND A CANDIDATE FOR COMPARISON:
COMNDCP  LW,A0    COMTBL,I1         GET THE DESCRIPTOR,
         LW,A1    A2                GET COPY OF INPUT DESCRIPTOR,
         CBS,A0   +0                ..YAWN..
         BNE      COMNDNX           B/ IT DIDN'T MATCH.  SIGH.
         PAGE
         SPACE
* AHA... I FOUND A COMMAND WHICH MATCHES THE INPUT.
* SET UP DEFAULT OPTIONS, ALLOWED OPTIONS, AND SPLIT.
         LB,I1    CMDNDX,I1         GET DISP. TO TABLES
         LD,A0    CDFOPT,I1         GET OPTION VALUES, ALLOWED OPT MASK
         STD,A0   C%OPTS            SAVE THE OPTION DWORD,
         LW,A0    CAOPT,I1          GET ALLOWED OPTION MASK,
         STW,A0   AOPTS             AND SAVE IT AWAY.
         B        CVECT,I1          AND DISPATCH TO COMMAND
         SPACE    2
*
*  COME HERE WHEN ALL THROUGH WITH COMMAND.
DONE     CALL     FREESPC           RELEASE ALL THE TRASH,
         B        COMMAND           AND GO READ NEXT COMMAND.
         PAGE
         SPACE
*******************************************************************
*
* INITIAL:
*        LINK = RTN, NO ARGS.
*
*        DOES ALL SETUP WORK FOR LEMUR.  SREEELY TOUGH.
*
*******************************************************************
         SPACE
INITIAL  EQU,0    %
         LD,R0    *J:TCB            GET STACK POINTER DOUBLE-WORD,
         STD,R0   STKPTR            AND SAVE FOR ERRORS.
         PUSH     RTN               SAVE RETURN @ FOR LATER.
         CALL     SETRAPS           FOR TRAP CONTROL;
         CALL     OPENDO            FOR COMMENTS,
         CALL     OPENSI            FOR COMMANDS,
         CALL     OPENLL            FOR LOG,
         CALL     CKCORR            REMEMBER WHO POINTS TO WHAT.
         CALL     PRTVER#           PRINT TITLE
         LI,R0    +0                DON'T ABORT FOR ERRORS,
         STW,R0   XFLAG
         STW,R0   ERRHIT            NO ERRORS SEEN YET, NEITHER.
         CALL     FREESPC           SET UP FREE SPACE & HASH TABLE.
         CALL SETWORKLIB            INITIALIZE WORKING LIBRARY TO
*                                   :LIB, USER ACN, NO PASSWORD.
         B        RETURN            NOW EXIT.
         PAGE
         SPACE
SETWORKLIB SUBROUTINE
         LI,I1    -7
         LW,I2    BLANK
         STW,I2   WORKLIB+7,I1
         BIR,I1   %-1
*        SET :LIB.USER ACN.NO PASSWORD AS DEFAULTS FOR THE WORKING
*        LIBRARY.
         LW,I1    =':LIB'
         STW,I1   WORKLIB           SET :LIB
         LCI      2
         LM,I1    J:ACCN
         STM,I1   WORKLIB+3         SET USER ACCOUNT NO.
         LCI      3
         LM,I1    DEST
         STM,I1   D:DESTLIB
         LI,T2    F:LIB
         STW,T2   L:DCB
         LI,A1    D:DESTLIB
         BAL,T3   SETNAME
         B        RETURN
         PAGE
********************************************************************
*
* PVER#
*        LINK = RTN, NO ARGS.
*
*        PRINTS 'LEMUR XXX' ON LL AND (IF NEEDED) DO.
*
*********************************************************************
         SPACE
PRTVER#  SUBROUTINE
         LI,I3    +BA(INBUF)        THIS IS A HANDY PLACE TO PUT THIS,
         LW,I2    =D('LEMUR ',VER#)  GET HEADER STRING--
         CALL     APPEND            MOVE IT TO THE RIGHT PLACE,
         LW,A2    I3                GET RESULT,
         CALL     WRITELL           OUTPUT TO LOG,
         LC       DO#LL             AND COMMENT IF NEEDFUL.
         BE       RETURN            B/ NOTHING TO OUTPUT
         CALL     WRITEDO           ELSE OUTPUT IT,
         B        RETURN            AND EXIT WHEN DONE.
         PAGE
***************************************************************
*
*  READ AN INPUT LINE...
*
***************************************************************
         SPACE
READ     SUBROUTINE
         LI,A2    BA(INBUF)         GET INITIAL DESCRIPTOR
         CALL     SIREAD            GET THE LINE,
         BNE      WINDOWN           B/ EOF HIT, DO AN END.
         SPACE
*D*
*D*      DELETE TRAILING BLANKS FROM THE INPUT LINE, AND IF THE
*D*      LAST NON-BLANK CHARACTER ON THE LINE IS A ';', THEN
*D*      DELETE THE SEMICOLON AND APPEND A CONTINUATION LINE.
*D*      NOTE THAT CONTINUATION LINES MAY NOT GENERATE A LINE
*D*      LONGER THAN 255 BYTES, TOTAL.
*D*
         SPACE
READ0    LB,I1    A2                GET # OF BYTES IN STRING,
         BE       READ1             B/ NULL STRING; PASS IT ON TO THE
*                                          NEXT TURKEY.
         AW,I1    A2                POINT TO LAST BYTE IN STRING (+1)
         AI,I1    -1                POINT TO LAST BYTE,
         LB,I1    0,I1              GET THAT BYTE,
         CI,I1    +C';'             IS IT A CONTINUATION INDICATOR?
         BNE      READ01            B/NO, GO SEE IF THIS IS A BLANK
RD:NXT   EQU      %
         AW,A2    YFF               SEMICOLON:  DELETE IT FROM THE STRING,
         CALL     SIREAD            APPEND A NEW INPUT LINE,
         BNE      E(E#ILCL)         B/ E-O-F MEANS ILLEGAL CONTINUATION.
         B        READ0             NOW GO CHECK FOR CONTINUATION ON THIS.
         SPACE
READ01   CI,I1    +C' '             IS IT A BLANK?
         BNE      CHK:CONT          CHECK FOR CONTINUATION.
         AW,A2    YFF               TRAILING BLANKS GET DELETED.
         B        READ0             B/ NOW GO EAT NEW LAST CH.
         SPACE
CHK:CONT EQU      %
         LI,A3    0                 SET CONTINUATION FLAG (NONE)
SAV:PT   EQU      %
         STW,A2   CHPT              SAVE ARS/BA(IMAGE) (OLD/NEW)
CHK:NXT  EQU      %
         AW,A2    YFF               ARS-1
         LB,I1    A2                GET ARS
         BEZ      CHK:END           END OF SEARCH FOR ';'
         AW,I1    A2                BA(IMAGE+ARS) NEXT CHAR.+1
         AI,I1    -1                BA OF NEXT CHAR.
         LB,I1    0,I1              GET CHAR.
         CI,I1    ';'
         BNE      CHK:NXT           NOT ';' LOOK AT NEXT CHAR.
         AI,15    1                 SET ';' FOUND FLAG (# ';'S)
         B        SAV:PT            SAVE NEW CHAR. POINTER
CHK:END  EQU      %
         LW,A2    CHPT              GET FINAL ARS/BA(IMAGE)
         CI,A3    0
         BEZ      READ1             NO CONTINUATION FOUND
         B        RD:NXT            GET NEXT IMAGE
         SPACE
READ1    EQU,0    %
         LI,I1    0                 INITIALIZE SOME SCAN CONSTANTS:
         STW,I1   SCTBNDX           NOTHING IN THE SCAN TABLE,
         STW,I1   DESCNDX           NOTHING IN THE DESCRIPTOR POOL,
         STW,I1   D:DESTMOD         INITIALIZE DESTINATION MODULE,
         STW,A2   CHPT              SAVE THE INPUT DESCRIPTOR,
         B        RETURN            AND EXIT.
         PAGE
         SPACE    2
*P*
*P* FORMAT OF SCAN TABLES:
*P*
*P*      TWO WORD VECTORS ARE USED TO REPRESENT THE SCANNED LINE:
*P*      SCTBL AND DSCPOOL.  DSCPOOL IS SIMPLY A VECTOR OF DESCRIPTORS
*P*      OF SCANNED ATOMS.  SCTBL IS A VECTOR OF SCANNED TOKENS,
*P*      I.E. IT CONTAINS TYPE INFORMATION AND POINTERS INTO THE
*P*      DESCRIPTOR POOL FOR ANY ASSOCIATED ATOMS.  NOTE
*P*      THAT EACH TOKEN HAS AN IMPLICIT # OF ATOMS WITH WHICH
*P*      IT CORRESPONDS;  THE TOKEN WILL POINT TO THE HEAD OF
*P*      A LIST OF DESCRIPTORS IN THE DESCRIPTOR POOL.
*P*
         PAGE
*P*
*P* SCTBL:
*P*      SCTBNDX CONTAINS THE # OF SIGNIFICANT TOKENS IN THE SCAN TABLE;
*P*      IT IS SET TO ZERO EACH TIME A COMMAND IS READ.
*P*
*P*      THE TABLE ITSELF LOOKS LIKE THIS:
*P*
*P*      0      3  4            15   16                    31
*P*      ----------------------------------------------------
*P*      |        |                 |                       |
*P*      | UNUSED |     TYPE        |  INDEX INTO DSCPOOL   |
*P*      |        |                 |                       |
*P*      ----------------------------------------------------
*P*
*P*      IN THE ABOVE FIGURE, 'TYPE' IS THE TOKEN #, AND IS ONE
*P*      OF THE FOLLOWING CODES:
*P*
*P*      #     MNEMONIC        # OF DESCRIPTORS     MEANING
*P*      -     --------        ----------------     -------
*P*
*P*      1        T%MNAME           1              MODULE NAME
*P*      2        T%GRP             1              GROUP NAME
*P*      3        T%SYM             1              SYMBOL
*P*      4        T%LID             3              LIBRARY ID.
*P*      5        T%FID             3              FILE ID
*P*      6        T%DEF             2              SYMBOL>>MNAME
*P*      7        T%EOL             0              (END OF LINE)
*P*      8        T%GRNCH           5              N.A.P<GRP>/MNAME
*P*      9        T%UN              0              '+'  (UNION OPERATOR)
*P*     10        T%INT             0              '-' (INTERSECT OPERATOR)
*P*     11        T%EQ              0              '='
*P*     12        T%ON              0              'ON' OR 'TO'
*P*     13        T%OVER            0              'OVER'
*P*     14        T%USING           0              'USING'
*P*
         PAGE
         SPACE
ADD%     CALL     MNAME             READ THE NAME
         LW,T0    DESCNDX           THE LAST DESCRIPTOR ENTERED
         LW,T1    DSCPOOL-1,T0      WAS MODULE NAME. SAVE IT FOR
         STW,T1   D:DESTMOD         EASY ACCESS DURING THIS COMMAND.
         LW,A0    =D('FROM')        LOOK FOR 'FROM'
         LI,A1    +0                IF FOUND, DONT MARK IT IN LIST,
         LI,A2    +E(E#EH)          IF NOT FOUND, REPORT ERROR.
         CALL     TEST              IF FOUND, COME RIGHT BACK.
         CALL     FIDLIST           SCAN THE ROM LIST
         CALL     EOL               FIND END OF LINE,
         LI,I2    2                 CHECK IF LIBRARY IN RUNNING ACCOUNT.
         LM,I0    WORKLIB+3
         LM,I2    J:ACCN
         CD,I0    I2
         BCR,3    ADD#              B/  SAME ACCOUNT.
         LW,I1    O%ROM             IS IT A LOAD MODULE ?
         CW,I1    C%OPTS
         BCR,2    ADD#              B/ IF NOT LOAD MODULE..
         LI,R2    X'B5D0'           KEY FOR ERRMSG
         SLS,R2   16
         BCR,0    E(E#CCRL)         CAN NOT DO CROSS-ACCOUNT LOAD...
         SPACE    2
LIB%     CALL     SETWORKLIB        SET DEFAULTS
         CALL     ISLID             IS THERE A L.I.D.
         BNE      LIB%4             B/NO, LEAVE THE DEFAULTS.
         LW,T0    DESCNDX           YES. RESET THE WORKING LIBRARY.
         LW,I2    DSCPOOL-3,T0      IS THERE A NAME?
         BEZ      LIB%2             B/NO .LEAVE :LIB AS NAME.
         LI,I3    BA(WORKLIB)       YES. RESET THE NAME
         CALL     APPEND
         STW,I3   D:DESTLIB
LIB%2    LW,I2    DSCPOOL-2,T0      IS THERE AN ACCOUNT?
         BEZ      LIB%3             B/NO.  LEAVE USER ACCOUNT.
         LI,I3    BA(WORKLIB+3)     YES. RESET THE ACCOUNT.
         CALL     APPEND
         STW,I3   D:DESTLIB+1
LIB%3    LW,I2    DSCPOOL-1,T0      IS THERE A PASSWORD?
         BEZ      LIB%4             B/NO LEAVE NO PASSWORD.
         LI,I3    BA(WORKLIB+5)
         CALL     APPEND
         STW,I3   D:DESTLIB+2
LIB%4    CALL     EOL
         B        LIB#              B/ GO DO IT.
         SPACE    2
END%     CALL     EOL               NOTHING ELSE SHOULD FOLLOW END,
         B        WINDOWN           SO GO QUIT.
         SPACE
DELETE%  EQU      %
         CALL     ISNAME            ARE THERE ANY NAMES?
         BNE      DELETE%3          B/ NO. DELETE THE WHOLE LIBRARY.
DELETE%1 EQU      %
         LW,A0    =D(',')           NEXT CHAR A COMMA?
         LI,A1    0                 DONT MARK IT IF IT IS.
         LI,RTN   DELETE%2          COME BACK HERE IF YES.
         LI,A2    DELETE%3          FINISHED IF NEXT NOT A COMMA.
         B        TEST
DELETE%2 CALL     MNAME
         B        DELETE%1
DELETE%3 CALL     EOL
         B        DELETE#           GO DO THE DELETE.
         SPACE
CARRY%   EQU      %
         CALL     MNAME             READ DEST. MOD. NAME
         LW,T0    DESCNDX
         LW,T1    DSCPOOL-1,T0
         STW,T1   D:DESTMOD
         LW,A0    =D('FROM')        LOOK FOR 'FROM'
         LI,A1    0                 DONT MARK IT.
         LI,A2    E(E#EH)
         CALL TEST
         CALL     SORSLID
*                                   DESTINATION LIBRARY.
LIBSDIF  EQU      %
         LW,A0    =D('/')
         LI,A1    0                 LOOK FOR /. DONT MARK.
         LI,A2    NOSLASH
         CALL     TEST
         CALL     ISNAME            SCAN SOURCE MOD. NAME
         BE       %+3               NO NAME. SOURCE = DEST. NAME.
         LW,T1    D:DESTMOD
         B        CARRY%0
         LW,T0    DESCNDX
         LW,T1    DSCPOOL-1,T0
CARRY%0  STW,T1   D:SORSMOD
         CALL     EOL
CARRY%1  B        CARRY#            GO DO THE WORK
NOSLASH  EQU      %
         LW,A1    D:DESTMOD
         STW,A1   D:SORSMOD
         B        CARRY%1
         SPACE
COPY%    EQU      %
         CALL     SORSLID
         CALL     EOL               SCAN REST OF LINE
         B        COPY#
         SPACE
*        SORSLID SCANS FOR LIBRARY SOURCE NAME.ACCOUNT.PASS.
*        NO FIND IS AN ERROR.  PERFORMS A CHECK TO ENSURE
*        THAT SOURCE AND DESTINATION LIBS ARE DIFFERENT.
*        SORSLID IS USED BY CARRY AND COPY COMMANDS.
SORSLID  SUBROUTINE
         CALL     LID
         LW,I1    DESCNDX
         LCI      3
         LM,T0    DSCPOOL-3,I1
         STM,T0   D:SORSLIB
         MTW,0    D:SORSLIB+1
         BNEZ     SORSLID2          B/ SOURCE ACCOUNT WAS SPECIFIED
         LW,T1    D:J:ACCN          SET USERS ACCT BY DEFAULT/
         STW,T1   D:SORSLIB+1
SORSLID2 EQU      %
         LW,T1    D:DESTLIB
         BAL,T3   COMPARE
         BNE      SORSLID4          B/ LIBRARY NAMES ARE DIFFERENT.
         LW,T0    D:SORSLIB+1       ARE THE ACCOUNTS DIFFERNET?
         LW,T1    D:DESTLIB+1
         BAL,T3   COMPARE
         BE       E(E#SLSADL)       B/ NO. ERROR SOURCE LIB= DEST LIB.
SORSLID4 EQU      %
         B        RETURN
         PAGE
         SPACE
MNAME    SUBROUTINE
         CALL     ISNAME
         BNE      E(E#NONM)
         B        RETURN
         SPACE
         PAGE
         SPACE
ISNAME   SUBROUTINE
         CALL     EATNAME
         BNE      RETCC3
         LI,A2    +T%MNAME          MARK AS A NODULE NAME
         CALL     MARKAS
         B        RETCC0            RETURN AS TRUE
         PAGE
         SPACE
LETDIG   EQU,0    %
         BAL,T2   RANGE             ANY OF THESE CH ARE GOOD...
         PZE      LETDIGG           B/ IF ONE OF THESE WAS FOUND
         CHRNG    'A','I'
         CHRNG    'J','R'
         CHRNG    'S','Z'
         CHRNG    'a','i'
         CHRNG    'j','r'
         CHRNG    's','z'
         CHRNG    '0','9'
         CHRNG    'ž','ž'           (UNDERSCORE)
         CHRNG    '%','%'
         CHRNG    '*','*'
         CHRNG    '%','%'
         CHRNG    ':',':'
         CHRNG    *'@','@'          (END OF LIST)
*
*  NO GOOD...
         LCI      +3                RETURN APPROPRIATE CC
         B        0,T3
*
LETDIGG  LCI      +0
         B        0,T3
         PAGE
RANGE    LW,T1    0,T2              LINK = T2
         MTB,+0   CHPT              ANY CH LEFT TO READ?
         BNEZ     %+3               B/ YES, GO GET EM
         LI,T0    +#EOL             GET END OF STRING CH.,
         B        RANGEL            AND GO LOOK FOR IT.
         LW,T0    CHPT              GET THE POINTER,
         LB,T0    0,T0              GET THE BYTE. . .
         SPACE
*** LOOP POINT FOR SEARCH
RANGEL   INT,R0   +1,T2             GET START IN R0, END IN R1
         CLR,R0   T0                IS THIS ONE I LIKE?
         BCR,6    RANGEG            B/ YES.  I FOUND IT
         AI,T2    +1                POINT TO NEXT,
         LC       *T2               ALL DONE?
         BCR,8    RANGEL            B/ NO, DO NEXT
* COULDN'T FIND
         B        +1,T2
*
* FOUND A RANGE--
RANGEG   CI,T0    +#EOL             END OF LINE?
         BE       0,T1              B/ YES, DONT BOTHER TO INCREMENT.
         LCW,R0   M24               X'FFFFFF'->X'FF000001'
         AWM,R0   CHPT              *ALL THIS IS FASTER THAN...
         AW,A2    Y01               MTB'S AND MTW
         B        0,T1              ALL DONE, TAKE SUCCESS EXIT.
         PAGE
EATFID   EQU,0    %
         BAL,T3   BLANKS
         LI,A1    +1                # IS ILLEGAL!
         B        ETNM1
EATNAME  EQU,0    %
         BAL,T3   BLANKS
         LI,A1    +0                A # IS OK.
ETNM1    LW,A2    CHPT              GET STRING POINTER
         AND,A2   M24               W/O TRASH
         BAL,T3   LETDIG            GET A CHARACTER
         BE       ETNML             B/  IF LEGAL CHARACTER.
         CI,T0    C'.'              IS IT A DOT ?
         BNE      ETNM#             B/  NOT A DOT, COULD BE #
         LCI      1                 FLAG AS NOT A LETTER OR DIGIT.
         B        *RTN
ETNML    BAL,T3   LETDIG            EAT ANOTHER CHARACTER
         BE       LETDIG            GO UNTIL WE'VE EATEN OUR FILL
         AI,A1    +0                IS # OK?
         BNEZ     ETNMX             B/ NO. ALL OF NAME SEEN.
         BAL,T3   IS#               DID WE TERMINATE ON A #?
         BE       ETNML             B/ YES, CONTINUE EATING
* END OF NAME SEEN, A2 CONTAINS DESCRIPTOR.
ETNMX    BAL,T3   DESCENT           GO ENTER THE DESCRIPTOR IN THE POOL
         LCI      +0                RETURN CC --> FOUND A NAME
         B        *RTN              AND EXIT.
         SPACE
* BLEW OUT ON FIRST CHARACTER:  COULD BE A #
ETNM#    AI,A1    +0                ARE WE EATING A FILE?
         BNEZ     ETNMF             B/ YES.  # IS ILLEGAL.
         BAL,T3   IS#               (IT WILL INTRODUCE PSN IN E00)
         BE       ETNML             GO/GO/GO
*  NOT #, COULD THIS BE A STRING?
ETNMF    BAL,T3   STRING            FIND OUT...
         BNE      *RTN              B/ NOT A STRING --> NOT A NAME.
         B        ETNMX             B/ WAS A STRING:  ENTER THE DESCRIPTOR.
         PAGE
IS#      EQU,0    %
         BAL,T2   RANGE
         PZE      ITIS#
         CHRNG    *'#','#'
* NOT A #
         LCI      +3
         B        0,T3              SO EXIT
* IS A #
ITIS#    LCI      +0
         B        0,T3
         PAGE
STRING   EQU,0    %                 LINK=T3
         BAL,T2   RANGE             LOOK FOR OPEN QUOTE...
         PZE      STRING1           IF FOUND, GO EAT STRING
         CHRNG    *'''',''''
* NOT A STRING.
         LCI      +3                RETURN CC FALSE
         B        0,T3              AND EXIT.
         SPACE
* OPEN QUOTE FOUND, EAT UP TO CLOSE QUOTE.
STRING1  LW,A2    CHPT              GET DESCRIPTOR OF REST OF STRING
         AND,A2   M24               GET RID OF COUNT
STRNGL1  MTB,+0   CHPT              ANYTHING LEFT TO SCAN?
         BEZ      E(E#BQS)          B/ NO-- BAD QUOTE STRING
STRNGL   LW,T2    CHPT              GET NEXT CHAR.
         LB,R0    0,T2
         CI,R0    +C''''            IS IT A QUOTE?
         BE       STRNGL2           B/ YES, COULD BE END OF STRING.
         LCW,R0   M24               NOT A QUOTE, SCAN OFF CH.
         AW,A2    Y01               BUMP COUNT OF DESCRIPTOR
         AWM,R0   CHPT
         BC       STRNGL            B/ SOMETHING LEFT:   TRY NEXT.
         B        E(E#BQS)          NOTHING LEFT:  NO CLOSE QUOTE.
*
* QUOTE SEEN, COULD BE END OF STRING.
STRNGL2  LCW,T0   M24               T0 <- X'FF000001'
         AWM,T0   CHPT              SCAN OFF THE QUOTE,
         BNC      STRINGG           B/ END OF STRING--> ALL DONE.
         LW,T1    T2                COPY POINTER TO THIS QUOTE
         LW,T2    CHPT              GET POINTER TO NEXT CH
         LB,R0    0,T2              GET THE BYTE,
         CI,R0    +C''''            IS IT ANOTHER QUOTE?
         BE       STRINGQ           B/ YES-> NOT END OF STRING.
STRINGG  LCI      +0                ELSE RETURN DESCRIPTOR,
         B        0,T3              CC AND EXIT.
         SPACE
* STRING W/ EMBEDDED QUOTE SEEN, DELETE ONE OF THE QUOTES.
STRINGQ  AW,A2    Y01               ONE MORE CHARACTER SEEN.
         SW,T1    Y01               ONE LESS CHARACETER IN INPUT STRING
         MTW,-1   CHPT              ADJUST POINTER TO INPUT ST.
         MBS,T1   +1                AND SHUFFLE INPUT DOWN ONE BYTE.
         B        STRNGL1           SEE IF ANYTHING LEFT TO SCAN.
         PAGE
DESCENT  EQU,0    %                 LINK = T3
         LW,T2    DESCNDX           GET NEXT SPACE IN POOL,
         MTW,+1   DESCNDX           ALLOCATE THIS ONE,
         STW,A2   DSCPOOL,T2        POKE THE DESCRIPTOR AWAY,
         B        0,T3              AND EXIT.
         PAGE
SPACES   EQU,0    %                 LINK = T1
         LW,I1    CHPT              SCAN OFF LEADING SPACES,
         CBS,0    BA(BLANK)
         STW,I1   CHPT              AND RETURN PROPER CC.
         B        0,T1              EXIT.
         SPACE    2
BLANKS   EQU,0    %                 LINK = T3
         BAL,T1   SPACES            EAT LEADING BLANKS
         BE       0,T3              IF WE RAN OUT OF STRING, EXIT.
         LB,T2    0,I1              GET A CHARACTER
         CI,T2    +'('              START OF OPTION?
         BNE      0,T3              B/ NO, LET CALLER HANDLE IT.
         SW,I1    M24               SCAN OFF LEFT PAREN,
         STW,I1   CHPT              SAVE POINTER.
         PUSH     A1,A3             SAVE SOME REGISTERS
         PUSH     T3                SAVE OUR RETURN @
         CALL     EATOPT            AND EAT THE OPTION
         POP      T3                GET OUR RETURN BACK,
         POP      A1,A3             GET OTHER REGISTERS BACK,
         B        BLANKS            AND GO GET RID OF MORE BLANKS.
         PAGE
EATOPT   SUBROUTINE
         BAL,T1   SPACES            EAT LEADING SPACES
         BE       E(E#MFO)          B/ MALFORMED OPTION
         BAL,RTN  EATNAME+1         (RECURSION?!?!?) DON'T SCAN OFF BLANKS.
         BNE      E(E#MFO)          NOT A NAME-> MALFORMED OPTION
         MTW,-1   DESCNDX           IGNORE THAT LAST DESCRIPTOR, SIR.
         LI,A3    +I2**2            BA (I2)
         LW,I2    BLANK             GET PADDING...
         LW,I3    BLANK             ...
         LB,R0    A2                GET LENGTH OF OPTION
         CI,R0    +8                IS IT TOO LONG?
         BG       E(E#UNKOP)        B/ YES, I DON'T KNOW THAT ONE.
         STB,R0   A3                ELSE XFER COUNT TO ODD REG.
         MBS,A2   +0                AND GET THE OPTION.
         LI,I1    +0                GET THE SEARCH INDEX,
         LI,T0    +OPTMAX           GET ITERATION COUNT
EATOPTL  CD,I2    OPTBL,I1          IS THIS IT??
         BE       EATOPT1           B/ YES.
         AI,I1    +1                ELSE POINT TO NEXT,
         BDR,T0   EATOPTL           AND TRY ANOTHER, IF ANY.
         B        E(E#UNKOP)        UNKNOWN OPTION.
         PAGE
         SPACE
*** WE HAVE FOUND THE OPTION:  DO WHAT SEEMS NEEDFUL.
EATOPT1  LD,R2    OPFLGS,I1         GET FLAGS & MASK FOR THIS OPTION
         CW,R3    C%OPTS+1          OPTION ALREADY SPECIFIED??
         BANZ     E(E#MLTOP)        B/ YES--MULTIPLY-USED OPTION.
         STS,R2   C%OPTS            ELSE MERGE IN THE OPTIONS,
         STS,R3   C%OPTS+1          AND FLAGS.
         CW,R3    AOPTS             IS THIS AN ALLOWED OPTION?
         BAZ      E(E#IOTC)         B/ NO. ILLEGAL OPTION FOR THIS COMMAND.
         LW,R0    SAOPT,I1          IS THERE SPECIAL ACTION FOR THIS OPTION?
         BEZ      %+2               B/ NO.
         BAL,RTN  *R0               IF SO, GO DO IT.
         BAL,T1   SPACES            EAT TRAILING SPACES
         BE       E(E#MRP)          B/ MISSING RIGHT PAREN.
         LB,R0    0,I1              GET TERMINATOR,
         CI,R0    +C')'             A RIGHT PAREN??
         BNE      E(E#MRP)          B/ NO.  MISSING RIGHT PAREN.
         SW,I1    M24               POINT TO NEXT CH,
         STW,I1   CHPT              POKE AWAY NEW POINTER
         B        RETURN            AND EXIT.
         PAGE
RETCC0   PLW,RTN  *J:TCB            GET RETURN ADDRESS
         LCI      +0                GET CONDITION CODES
         B        *RTN              AND EXIT
         SPACE
RETCC3   PLW,RTN  *J:TCB            GET THE RETURN @ FROM THE STACK,
         LCI      +3                GET APPROPRIATE CC,
         B        *RTN              AND EXIT.
         SPACE
RETURN   EQU,0    %
         PLW,RTN  *J:TCB
         B        *RTN
         PAGE
MARKAS   LW,A1    DESCNDX           MARK THE LAST DESCRIPTOR AS A THING
         AI,A1    -1                WHOSE CODE IS IN A2.
         STH,A2   A1                PUT CODE IN LEFT BYTE,
         MTW,+1   SCTBNDX           MAKE AN ENTRY IN THE SCAN TABLE,
         LW,T3    SCTBNDX           GET THE INDEX,
         CI,T3    SCTBL#            HAVE WE REACHED END OF TABLE
         BG       E(E#NES)          NOT ENUFF SYMBOL SPACE. MUST
*,*                                 REASSEMBLE WITH MORE SPACE, OR
*,*                                 BREAK UP MODULE.
         STW,A1   SCTBL-1,T3        SAVE THE POINTER,
         B        *RTN              AND EXIT.
         PAGE
*
* FIDLIST-
*  READS A LIST OF FORM
*    FIDLIST ::=  FID %(, FID)
*
FIDLIST  SUBROUTINE
FIDLOOP  CALL     FID
         LW,A0    =D(',')           SEE IF COMMA IS PRESENT:
         LI,A1    +0                IF IT IS, DON'T SAVE DESCRIPTOR,
         LI,RTN   +FIDLOOP          ...BUT BRANCH BACK TO SCAN ANOTHER ID.
         LI,A2    +RETURN           IF NO ',' IS FOUND, => WE ARE DONE.
         B        TEST              NOW, GO FIND OUT.
         PAGE
FID      SUBROUTINE
         CALL     ISFID
         BNE      E(E#MFID)         MISSING FILE ID
         B        RETURN
         PAGE
         SPACE
*D*
*D* NAME:
*D*      ISFID    DETERMINES WHETHER NEXT OBJECT IS A FILE ID.
*D*
*D* CALL:
*D*      CALL     ISFID
*D*
*D* REGISTERS:
*D*      RTN IS PRESERVED; ALL OTHERS ARE DESTROYED.
*D*
*D* INTERFACE:
*D*      EATFID   --USED TO SCAN NAME, ACCOUNT, PASSWORD.
*D*      MARKAS   --USED TO SET UP ENTRY IN SCTBL.
*D*      EATAPX   --USED TO READ ACCOUNT/PASSWORD
*D*
*D*
*D* INPUT:
*D*      CHPT MARKS THE STRING BEING PROCESSED;
*D*
*D* OUTPUT:
*D*      CHPT     --POINTS TO REMAINDER OF COMMAND STRING;
*D*      CC3,4    --ARE ZERO IF A FILE ID WAS SCANNED, NON-ZERO
*D*                 OTHERWISE.
*D*
*D* DESCRIPTION:
*D*      EXPECTS A NAME OF FORM 'NAME', 'NAME.ACCOUNT',
*D*      'NAME.ACCOUNT.PASSWORD' OR 'NAME..PASSWORD'.
*D*
         PAGE
         SPACE
ISFID    SUBROUTINE
         CALL     EATFID            SLURP UP A NAME.
         BNE      RETCC3            B/ DIDN'T FIND ONE.
         LB,A3    A2                MAKE SURE THE NAME ISN'T TOO LONG:
         CI,A3    +31
         BG       E(E#FNTL)         B/ TOO LONG:  REPORT AN ERROR.
         LI,A2    +T%FID            MARK THIS DESCRIPTOR AS FILE ID,
         CALL     MARKAS
         B        EATAPX            AND GO EAT UP ACCOUNT/PASSWORD
         PAGE
         SPACE
*D*
*D* NAME:
*D*      LID      FORCES RECOGNITION OF A LIBRARY NAME.
*D*
*D* CALL:
*D*      BAL,RTN  LID
*D*
*D* DESCRIPTION:
*D*      IF A LIBRARY ID IS FOUND, THEN THE APPROPRIATE ENTRIES ARE
*D*      MADE IN SCTBL AND DSCPOOL.  OTHERWISE AN ERROR IS REPORTED.
*D*
         SPACE
LID      SUBROUTINE
         CALL     ISLID             SEE IF THERE IS A LIB NAME THERE.
         BNE      E(E#MLID)         B/ NO-- GAZORCH!  MISSING LIB ID.
         B        RETURN            OK. EXIT.
         PAGE
*D*
*D* NAME:
*D*      ISLID    CHECKS IF A LIBRARY NAME IS NEXT IN THE INPUT STRING.
*D*
*D* CALL:
*D*      BAL,RTN  ISLID
*D*
*D* INPUT:
*D*      CHPT   --USED TO DETERMINE WHAT THE NEXT ITEM IN THE INPUT
*D*               STRING IS.
*D*
*D* OUTPUT:
*D*      CHPT   --POINTS TO NEXT ITEM IN THE INPUT STRING.
*D*      CC3,4  --IF ZERO, THEN A LIBRARY ID. WAS SCANNED OFF;
*D*               IF NON-ZERO, THEN NO LIBRARY ID. WAS PRESENT.
*D*
*D* ERROR:
*D*      IF THE BEGINNING OF A LIBRARY ID IS RECOGNIZED AND THEN WE
*D*      ENCOUNTER GARBAGE, IT'S ALL OVER, BUCKWHEAT.  ERROR CODE
*D*      WILL BE E#BFID -- BAD FILE IDENTIFIER.
*D*
*D*      IF A VALID LIBRARY NAME IS RECOGNIZED, BUT THE NAME
*D*      HAS MORE THAN 31 CHARACTERS, THEN E#LNTL IS REPORTED:
*D*      LIBRARY NAME IS TOO LONG.
*D*
*D* INTERFACE:
*D*      EATFID --USED TO EAT THE NAME PORTION OF THE LIBRARY ID.
*D*      MARKAS --USED TO MARK THE ENTRY IN THE SCAN TABLE AS A
*D*               LIBRARY NAME.
*D*      DESCENT  --USED TO ENTER A NULL DESCRIPTOR FOR THE NAME OF THE
*D*               LIBRARY IF WE ENCOUNTER SOMETHING OF THE FORM,
*D*               '.ACCOUNT.PASSWORD'
*D*      EATAPX --USED TO GOBBLE UP THE ACCOUNT/PASSWORD SECTION
*D*               OF THE LIBRARY NAME.  IT IS THIS SECTION WHICH WILL
*D*               ISSUE THE ERROR CODE FOR BAD FILE ID.
*D*      SPACES --USED TO EAT LEADING BLANKS.
*D*
*D* REGISTERS:
*D*      RTN IS PRESERVED; ALL OTHERS ARE *ZAPPED*
*D*
*D* DESCRIPTION:
*D*      ISLID RECOGNIZES LIBRARY NAMES OF THE FOLLOWING FORMS:
*D*      N        (NAME ALONE)
*D*      N.A
*D*      N..P
*D*      N.A.P
*D*      .        (SPECIFIES :LIB IN THE USER'S ACCOUNT)
*D*      .A       (SPECIFIES :LIB IN ACCOUNT A)
*D*      ..P      (SPECIFIES :LIB IN USER'S ACCOUNT, WITH PASSWORD P)
*D*      .A.P     (SPECIFIES :LIB.A.P)
*D*
*D*      NOTE THAT BLANKS BETWEEN NAMES AND THE PERIODS ARE IGNORED.
*D*
         PAGE
         SPACE
ISLID    SUBROUTINE
         CALL     EATFID            EAT THE NAME PART (IF ANY).
         BNE      ISLID1            B/ NO NAME; MUST BE '.' + STUFF
         SPACE
*** WE NOW HAVE AN ENTRY IN THE DESCRIPTOR POOL FOR THE LIBRARY NAME;
*** MARK THE TYPE AND SPLIT.
         LB,A3    A2                MAKE SURE IT ISN'T TOO LONG...
         CI,A3    +31               ...FOR A FILE NAME:
         BG       E(E#LNTL)         B/ TOO LONG:  YOU LOSE.
ISLID0   LI,A2    +T%LID            GET TYPE FOR THIS TOKEN;
         CALL     MARKAS            AND STAMP THIS ATOM.
         B        EATAPX            NOW, GO EAT REST OF FILE ID.
         SPACE
*** WE DIDN'T SEE A NAME; IS THERE A '.' HERE?
ISLID1   BAL,T1   SPACES            SCAN OFF BLANKS
         BE       RETCC3            IF NULL, THEN THERE WAS NO ID.
         LB,T0    0,I1              GET NON-NULL BYTE:
         CI,T0    +C'.'             IS IT THE START OF A LIB ID?
         BNE      RETCC3            B/ NO.  BYE-BYE.
         SPACE
*** WE HAVE A NAME OF FORM '.' FOLLOWED BY ACCOUNT/PASSWORD (MAYBE).
         LW,A2    =D(':LIB')        ...SO I CHEAT A LITTLE?  YOU WANT
*                                   I SHOULD BE HONEST ALL THE TIME?
         BAL,T3   DESCENT           REMEMBER THAT LITTLE FACT,
         B        ISLID0            NOW MAKE BELIEVE IT WAS THAT ALL
*                                   ALONG.  A CHEAP & DIRTY SPECIAL.
         PAGE
         SPACE
*D*
*D* NAME:
*D*      EATAP    SCANS TRAILING PART OF FILE IDENTIFIER.
*D*
*D* ENTRY:   EATAPX
*D*
*D* CALL:
*D*      CALL     EATAP
*D*       --OR--
*D*      PUSH RETURN ADDRESS ON STACK, AND BRANCH TO EATAPX
*D*
*D* INPUT:
*D*      CHPT     --DESCIPTOR OF STRING TO SCAN.
*D*
*D* OUTPUT:
*D*      CHPT     --DESCRIPTOR OF STRING AFTER THE ACCOUNT/PASSWORD
*D*      CC3,4    --ZERO, ALWAYS.
*D*
*D* INTERFACE:
*D*      DESCENT  --USED TO ENTER DESCRIPTORS INTO DSCPOOL
*D*      SPACES   --USED TO EAT UP UNSIGHTLY BLEMISHES (AND BLANKS).
*D*      EATFID   --USED TO EAT PASSWORD AND ACCOUNT SPECIFICATIONS.
*D*
*D* ERRORS:
*D*      E#BFID IS REPORTED WHENEVER WE DISCOVER THAT SOMETHING
*D*      SYNTACTICALLY AWFUL HAS HAPPENED.
*D*
*D*      E#ACTL IS REPORTED IF THE ACCOUNT NAME IS TOO LONG (>8 CH).
*D*
*D*      E#PWTL IS REPORTED IF THE PASSWORD IS TOO LONG (>8 CH).
*D*
         PAGE
         SPACE
EATAP    SUBROUTINE
EATAPX   LW,I1    CHPT              GET CHARACTER POINTER,
         CW,I1    YFF               ANYTHING LEFT?
         BANZ     EATAP1            B/ YES; GO LOOK AT IT.
*** ACCOUNT AND PASSWORD ARE NULL; ENTER NULL DESCRIPTORS AND EXIT.
EATAP0   LI,A2    +0                ENTER A NULL DESCRIPTOR...
         BAL,T3   DESCENT           ...FOR THE ACCOUNT,
EATAPNP  LI,T3    RETCC0            (EXIT WHEN THROUGH)
         B        DESCENT           ...AND ALSO FOR THE PASSWORD.
         SPACE
*** STRING IS NOT NULL; WE MAY BE ABLE TO FIND AN ACCOUNT AND/OR PSW.
EATAP1   LB,T0    0,I1              WHAT IS THAT CHARACTER, ANYWAY.
         CI,T0    +C'.'             DOES IT INTRODUCE AN ACCOUNT?
         BNE      EATAP0            B/ NO.  GUESS THERE ISN'T ANYTHING
*                                   TO DO.
         SPACE
*** WE HAVE SEEN A '.'; TRY TO FIND ACCOUNT.
         SW,I1    M24               POINT TO NEXT CH,
         STW,I1   CHPT              (SAVE NEW POINTER)
         CW,I1    YFF               ANY LEFT?
         BAZ      EATAP0            B/ NO.  SIGH.
         LB,T0    0,I1              GET NEXT CHARACTER:
         CI,T0    +C'.'             IS IT A NULL ACCOUNT?
         BNE      EATAP#            B/ NO -- GO EAT ACCT.,PASSWORD.
         LI,A2    0
         BAL,T3   DESCENT           REMEMBER NULL ACCOUNT.
         B        EATAPSW           GO EAT A PASSWORD.
EATAP#   EQU      %
         SPACE
*** WE MIGHT HAVE AN ACCOUNT HERE...
         CALL     EATFID+1          IS IT? IS IT?
         BNE      EATAP0            B/ NOPE.  THAT'S ALL, FOLKS.
         SPACE
*** WE FOUND AN ACCOUNT!!!
         LB,A3    A2                MAKE SURE IT ISN'T TOO LONG:
         CI,A3    +8
         BG       E(E#ACTL)         B/ TOO BAD: ACN WAS TOO LONG.
         LW,I1    CHPT              GET THE CHARACTER POINTER,
         LI,A2    +0                PRELOAD A NULL DESCRIPTOR,
         CW,I1    YFF               IS THERE ANOTHER CHARACTER?
         BAZ      EATAPNP           B/ NO.  GO ENTER A NULL PSW & SPLIT
         LB,T0    0,I1              GET THE NEXT BYTE...
         CI,T0    +C'.'             IS IT A SEPARATOR?
         BNE      EATAPNP           B/ NO.  GO ENTER A NULL PSW & SPLIT
         SPACE
*** WE MAY BE ABOUT TO SCAN A PASSWORD...
EATAPSW  SW,I1    M24               POINT TO NEXT CHARACTER,
         CW,I1    YFF               ANY LEFT?
         BAZ      E(E#BFID)         B/ IF NOT, YOU LOSE.  I DON'T LIKE.
         STW,I1   CHPT              (SAVE RESULT)
         CALL     EATFID+1          GLOM THE PASSWORD,
         BNE      E(E#BFID)         B/ NOT A PASSWORD? WELL, AIN'T THAT
*                                   A SHAME.
         SPACE
*** WE FOUND A PASSWORD:
         LB,A3    A2                MAKE SURE IT ISN'T TOO MANY CH.
         CI,A3    +8
         BG       E(E#PWTL)         B/ ERROR: PASSWORD IS TOO LONG.
         SPACE
*** CONGRATULATIONS.  YOU HAVE JUST SUCESSFULLY TRAVERSED THE
*** LONGEST PATH AND HAVE ACQUITTED YOURSELF WITH HONORS.
         B        RETCC0            ALL DONE.  GO HOME.
         PAGE
         SPACE
TEST     EQU,0    %
         BAL,T3   BLANKS            SCAN OFF LEADING BLANKS...
         BEZ      *A2               B/ NOTHING LEFT >> FAIL
         LW,R0    CHPT              (FASTER FROM MEMORY)
         LW,R1    YFF               CHECK TO SEE WHETHER THE TEST...
         CS,R0    A0                ...STRING IS SHORTER THAN THE INPUT.
         BL       *A2               B/ TEST STRING IS LONGER, CAN'T MATCH.
         LW,R1    A0                ELSE COPY DESCRIPTOR, (COUNT IS OK)
         CBS,R0   +0                MATCH ATTEMPT--
         BNE      *A2               B/ STRINGS ARE NOT =
         SW,R0    CHPT              GET THE # OF MATCHED BYTES,
         LCW,R1   R0                GET DIFFERENCE IN LENGTH BYTES
         STB,R1   R0                MOVE TO ADJUST CT IN MEMORY,
         AWM,R0   CHPT              AND SAVE FOR POSTERITY.
         AI,A1    +0                TEST:  WAS ENTERING A CODE WANTED?
         BEZ      *A3               B/ NO.  ALL DONE, TAKE SUCCESS EXIT.
         SLS,A1   +16               ELSE JUSTIFY CODE,
         MTW,+1   SCTBNDX           MAKE SPACE FOR ANOTHER ENTRY IN THE...
         LW,I1    SCTBNDX           ... SCAN TABLE FOR THIS CODE,
         STW,A1   SCTBL-1,I1        AND PUT THIS CODE IN THE AFORE-MENTIONED.
         B        *A3               AT LAST!  SUCCESS COMES TO...  ETC.
         PAGE
*D*
*D* NAME:
*D*      EXTOPT
*D*
*D* CALL:
*D*      LI,R1    +O%XXX
*D*      BAL,T3   EXTOPT
*D*
*D* INPUT:
*D*      R1 IS THE ADDRESS OF THE OPTION MASK FOR OPTION XXX
*D*      C%OPTS (WORD 0) IS THE WORD FROM WHICH WE EXTRACT THE VALUES.
*D*
*D* OUTPUT:
*D*      R0 IS THE VALUE OF THE SELECTED FIELD, RIGHT JUSTIFIED.
*D*                                             ---------------
*D*
*D* SCRATCH:
*D*      NONE.
*D*
*D* REGISTERS:
*D*      R0, R1 ARE CHANGED; ALL OTHERS ARE PRESERVED.
*D*
*D* INTERFACE:
*D*      NONE.
*D*
*D* DESCRIPTION:
*D*      R1 POINTS TO A TWO-WORD VECTOR, THE FIRST WORD OF
*D*      WHICH IS USED AS A MASK TO EXTRACT THE DESIRED FIELD.
*D*      THE SECOND WORD OF THE VECTOR IS THEN USED TO GENERATE
*D*      A SHIFT COUNT WHICH WILL ALLOW US TO RIGHT-JUSTIFY THE
*D*      FIELD.
*D*
         PAGE
         SPACE
EXTOPT   EQU,0    %
         LW,R0    C%OPTS            GET THE RAW DATA,
         AND,R0   *R1               EXTRACT THE FIELD,
         AI,R1    +1                POINT TO NEXT,
         LCW,R1   *R1               GET THE SHIFT COUNT,
         AND,R1   X7F               GET THE SHIFT CONTROL GARBAGE
         S,R0     *R1               JUSTIFY THE DATA,
         B        0,T3              AND EXIT.
         PAGE
         SPACE
*D*
*D* NAME:
*D*      EOL      FORCES ERROR IF THERE IS ANYTHING LEFT TO BE SCANNED.
*D*
*D* CALL:
*D*      BAL,RTN  EOL
*D*      (IF IT COMES BACK, THEN END OF LINE WAS RECOGNIZED)
*D*      (OTHERWISE, ERROR 'E#EEOL' IS SIGNALED--EXPECTED END OF LINE)
*D*
*D* INPUT:
*D*      COMMAND STRING.
*D*
*D* OUTPUT:
*D*      CHPT POINTS TO THE END OF THE COMMAND STRING, OR TO
*D*      THE OBJECT THAT CAUSED THE ERROR.
*D*
*D* SCRATCH:
*D*      NONE.
*D*
*D* REGISTERS:
*D*      NO REGISTERS ARE PRESERVED.
*D*
*D* INTERFACE:
*D*      BLANKS IS CALLED TO DO THE WORK.
*D*
*D* DESCRIPTION:
*D*      WE ISSUE A CALL TO 'BLANKS', WHICH EATS ALL THE OPTIONS
*D*      AND/OR SPACES UP TO THE END OF STRING OR UP TO A NON-BLANK,
*D*      NON-OPTION CHARACTER IN THE STRING.  IF UPON RETURN, THE
*D*      INPUT COMMAND HAS BEEN ENTIRELY EATEN, THEN WE RETURN;
*D*      OTHERWISE, WE REPORT AN ERROR, 'WE EXPECTED AN END OF LINE'.
*D*
         PAGE
         SPACE
EOL      EQU,0    %
         BAL,T3   BLANKS            EAT UP THE REST OF THE LINE.
         BNE      E(E#EEOL)         B/ SOMETHING LEFT IN LINE: ERROR.
         B        *RTN              EXIT.
         PAGE
         SPACE
*D*
*D* NAME:
*D*      DOSL     HANDLES SCANNING OF '(SL,X)' OPTION.
*D*
*D* CALL:
*D*      BAL,RTN  DOSL              --I DO THE REST.
*D*
*D* INPUT:
*D*      CHPT     --ASSUMED TO POINT TO THE ',X)' PORTION OF
*D*               THE STRING.  '(SL' MUST HAVE ALREADY BEEN SCANNED.
*D*
*D* OUTPUT:
*D*      CHPT     --NOW POINTS TO ')' PORTION OF THE OPTION.
*D*      C%OPTS   --O%SL FIELD NOW CONTAINS THE VALUE OF THE
*D*               SECOND FIELD IN THE SL OPTION; THE MASK WORD IS
*D*               CHANGED TO HAVE THE SL BITS TURNED ON.
*D*
*D* SCRATCH:
*D*      REGISTERS.
*D*
*D* REGISTERS:
*D*      REGISTER RTN IS PRESERVED; ALL OTHERS MAY BE ZAPPED.
*D*
*D* INTERFACE:
*D*      SPACES   --CALLED TO SCAN OFF LEADING SPACES.
*D*      RANGE    --CALLED TO CHECK FOR HEX DIGIT.
*D*
*D* ERRORS:
*D*      E#MFO    --SIGNALLED IF (1) COMMA IS NOT PRESENT,
*D*                              (2) VALUE IS NOT SINGLE HEX DIGIT.
*D*
*D* DATA:
*D*      O%SL     --USED TO GET MASK & SHIFT COUNT FOR INSERTING
*D*               NEW SEVERITY LEVEL FIELD INTO C%OPTS.
*D*      M24      --USED TO INCREMENT CHPT.
*D*
         PAGE
         SPACE
DOSL     SUBROUTINE
         BAL,T1   SPACES            SCAN OFF LEADING BLANKS; I1 <= CHPT
         BE       E(E#MFO)          B/ END OF STRING, NO ',' POSSIBLE.
         LB,T1    0,I1              GET THE TERMINATOR,
         CI,T1    +C','             THIS HAD BETTER BE A COMMA!
         BNE      E(E#MFO)          B/ NOT A COMMA => MALFORMED.
         SW,I1    M24               SCAN OFF COMMA,
         BAL,T1   SPACES+1          SCAN OFF TRAILING BLANKS,
         BAL,T2   RANGE             AND SEE IF WE HAVE A HEXADECIMAL DIGIT.
         PZE      DOSL1             B/ IF WE DO, GO CONVERT TO BINARY.
         CHRNG    '0','9'
         CHRNG    'A','F'           NOTE THAT I ALLOW YOU TO USE LOWER
         CHRNG    *'a','f'          ...CASE.
         SPACE
*** IF WE GET HERE, THEN THERE WASN'T A HEX DIGIT IN THE STRING.
         B        E(E#MFO)          SO GO CRY ME A RIVER.
         SPACE    2
*** WE SAW A HEX DIGIT:  CONVERT IT TO BINARY.
DOSL1    AI,T0    -C'0'             IF IT'S NOT A NUMERAL, THE RESULT...
         BGZ      DOSL2             ...WILL BE NEGATIVE.  B/ WAS NUMERAL.
         AI,T0    +C'0'-C'A'+X'A'   (TRY UPPER CASE A-F)
         BGZ      DOSL2             B/ IT WAS UPPER CASE.  VALUE IN T0
*                                   IS GOOD.
         AI,T0    +C'A'-C'a'        (THE SECOND C'A' IS LOWER CASE)
*                                   MAKE A GOOD HEX VALUE.
         SPACE
*** WE HAVE A BINARY VALUE IN T0; MERGE IT INTO C%OPTS
DOSL2    LCI      +2                PICK UP THE NEAT STUFF FOR THE
         LM,T1    O%SL              ...SEVERITY LEVEL OPTION:
*                                   T1 <- MASK, T2 <- SHIFT COUNT.
         SLS,T0   0,T2              MOVE THE VALUE TO THE RIGHT PLACE
         STS,T0   C%OPTS            MERGE IT IN.
         STS,T1   C%OPTS+1          MARK THIS OPTION AS HAVING BEEN USED.
         B        RETURN            AND EXIT.
         PAGE
*D*                                 COMPARES TWO STRINGSS
*D*                                 WHOSE DESCRIPTIORS ARE IN T0,T1
*D*                                 CONDITION CODES REFLECT ANSWER.
*D*                                 BAL,T3  COMPARE
COMPARE  EQU      %
         LB,T2    T1
         CB,T2    T0                COMPARE LENGTHS.
         BNE      *T3               RETURN NOT EQUAL.
         AND,T0   M24               KEEP JUST THE ADDRESS.
         CBS,T0   0                 COMPARE.
         B        *T3
         SPACE
         END      LEMUR

