         PCC      0
         TITLE    ' '
         SPACE
         SYSTEM   BPM
         SYSTEM   SIG7
*
*M* LDEV INTERPRET LDEV CMND, BUILD FPT, DO CAL TO MODIFY CONTX BLK
*
*P*      NAME     LDEV
*P*
*P*      PURPOSE  THIS PROCESSOR PROCESSES THE USER'S LDEV
*P*               COMMAND AND BUILDS A CORRESPONDING FPT AND
*P*               EXECUTES A CAL.  THE LOGICAL DEVICE CHARACTERISTICS
*P*               SPECIFIED FOR THE STREAM ARE THEN MODIFIED.
*P*
*P*      DESCRIPTION  IF LDEV IS ENTERED VIA A BATCH OR ON-LINE
*P*               COMMAND, THE ELEMENTS FROM THE COMMAND ARE
*P*               COMPARED AND TESTED ACCORDING TO THE CONTENTS
*P*               OF FIVE PARALLEL TABLES WITHIN THE PROCESSOR.
*P*               IF A WORKSTATION NAME (WSN) IS SPECIFIED ON
*P*               THE COMMAND, THE CORRESPONDING RECORD IS READ
*P*               FROM THE :RBLOG.:SYS FILE AND CHARACTERISTICS
*P*               FOR THE DEVICE SPECIFIED ON THE COMMAND ARE
*P*               TRANSFERRED TO THE LDEV FPT.  SYNTAX AND OTHER
*P*               ERRORS ARE REPORTED THRU M:LL AND WILL CAUSE
*P*               LDEV TO ABORT.
*P*
*P*               LDEV MAY BE CALLED BY CCI IF A WORKSTATION NAME
*P*               APPEARS ON THE JOB CARD, IN WHICH CASE THE
*P*               :RBLOG:SYS FILE IS READ FOR THE NAMED WSN AND
*P*               ITS DATA TRANSFERRED TO THE FPT.
*P*
*P*               LDEV MAY BE LINKED TO, IN WHICH CASE THE ARGUMENTS
*P*               ARE PICKED UP INTERNALLY FROM THE USERS PAGE.
*P*
*P*               LDEV CAN ACCESS :RBLOG.:SYS BECAUSE :RBLOG WAS
*P*               CREATED BY SUPER AS (EXEC,ALL),(UNDER,LDEV).
*P*
         SPACE    2
*  DECEMBER 1972, RICK SINATRA
         SPACE    3
*        REGISTER ASSIGNMENT
X0       EQU      0
X1       EQU      1
X2       EQU      2
X3       EQU      3
         SPACE
IDX      EQU      4
KWX      EQU      5
IP       EQU      6
X        EQU      7
R        EQU      8
R1       EQU      9
R2       EQU      10
R3       EQU      11
R4       EQU      12
R5       EQU      13
R6       EQU      14
         SPACE
         SPACE
*        EXTERNAL REFERENCES
         SPACE
         REF      J:CCBUF           *CONTROL COMMAND BUFFER IN JIT
         REF      JB:CCARS          *SIZE OF COMMAND IN CCBUF
         REF      J:JIT             * VIRTUAL ADDRESS OF JIT
         REF      M:C               * C DEVICE POINTER DCB
         REF      M:EI,JB:PRIV,JRBID
         REF      J:DWSK            HOLDS WSN
         DEF      ALT,START,PATCH,NORMAL,KEYREAD
         DEF      ML1,WSNSUB,FIN1
         DEF      G:ACN1            * FOR DEBUG: GENMD FOR :RBLOG ACCT
         DEF      SECT3             * CSECT OF FPT'S.
,,SECT3  M:PT     1                   (PUT FPT'S IN CODE AREA).
         TITLE    'PROC SECTION'
         SPACE
EXITC    CNAME
         PROC
EX%R     EQU      AF(1)
         BOUND    8
EX%D     DATA     EX%B
         GEN,1,15,1,15  0,AF(2),0,0
EX%D2    GEN,1,15,1,15  0,AF(2),0,0 TO RESET
EX%B     RES      AF(2)
         PEND
         SPACE
CALL     CNAME
         PROC
LF       BAL,EX%R AF
         PEND
         SPACE
ENTER    CNAME
         PROC
LF       PSW,EX%R EX%D
         PEND
         SPACE
RETURN   CNAME
         PROC
LF       PLW,EX%R EX%D
         LIST     0
         DO       AF(1)>1
         AI,EX%R  AF(1)-1
         FIN
         B        *EX%R
         LIST     1
         PEND
         PAGE
         SPACE
*        PROC FOR RESETTING EXIT CONTROL
         SPACE
EXITCR   CNAME
         PROC
         LIST     0
LF       LI,AF    EX%B
         STW,AF   EX%D
         LW,AF    EX%D2
         STW,AF   EX%D+1
         LIST     1
         PEND
         SPACE    2
SECT1    EQU      %
         DEF      SECT1
         EXITC    15,5              EXIT CONTROL SPEC.
         SPACE
*        SYNTAX SCANNING PROCEDURE
         SPACE
SCAN     CNAME    1                 FORWARD SCAN
SCANR    CNAME    0                 REVERSE
         PROC
         LIST     0
         DO       NAME
LF       AI,IP    1                 FORWARD
         CW,IP    CEND
         BGE      CF(2)
         ELSE
LF       AI,IP    -1                REVERSE
         BLZ      CF(2)
         FIN
         LB,R     *BASE,IP
I        DO       NUM(AF)
         CW,R     SCANL+AF(I,1)
         DO       AFA(I,1)
         BNE      AF(I,2)
         ELSE
         BE       AF(I,2)
         FIN
         FIN
         B        LF
         LIST     1
         PEND
         PAGE
         TITLE    'DATA SECTION'
         SPACE
         BOUND    8
TXLOCAL  TEXT     'LOCAL   '
STRING   RES      2                 STRING DW
         TEXT     '    '            BLNKS
MLC      DATA     'MLC'**8
KEY      EQU      STRING
COMMAND  RES,1    400               HOLDS COMMAND
COMMAX   DATA     400               MAX LENGTH
LABEL    RES      64                SPACE FOR LABEL TEXTC.
CLEARP   GEN,8,24 100,BA(PLINE)
LOGSIZE  EQU      90                SIZE OF :RBLOG RECORD AS OF C01
*NEXT LINE MUST IMMEDIATELY PRECEDE 'PLINE'
CALFPT   DATA     X'1A000000'       PRECEDES FPT
PLINE    RES,1    100               FOR ERROR POINTER
         BOUND    8
RBLOG    RES      LOGSIZE           FOR :RBLOG RECORD
BASE     DATA     COMMAND
LOGKEY   RES      3                 TO HOLD WSN KEY IN TEXTC
OUTFPT   EQU      PLINE             COMPRESSED FPT AT EXIT
ONLINE   DATA     0
CEND     DATA     0
INDENT   DATA     0                 SAYS WHETHER IN () WHEN SCANNING.
TESTSW   DATA     0                 NON-ZERO DON'T CAL
ALTMODE  DATA     0                 SWITCH
EXITSW   DATA     0                 SET TO 1 IF ALT ERR
CONTSW   DATA     0                 1 IF COMND IS CONTD
PATCH    RES      100               PATCH AREA
LOCAL    DATA     0                 SET =1 IF WSN=LOCAL
         SPACE
*        'SPECIAL' IS A TWO WORD UNPRINTABLE
*        KEY TO ACCESS THE WSN NAME RECORD IN :RBLOG
         SPACE
PRIV     DATA     JB:PRIV
         BOUND    8
SPECIAL  TEXT     '///     '        KEY TO READ WSN RECORD
KEY%     TEXT     '%       '        RBLOG KEY IMPLIES WSN(RBID)
         SPACE
         SPACE    3
*        THE OUTPUT FPT IN COMPRESSED FORMAT IS LOCATED
*        AT 'OUTFPT' WHICH IS THE SAME AS 'PLINE'.
         SPACE
*        THE EXPANDED FPT IS IN 'FPT' DURING PROCESSING.
         SPACE
FPTLENG  EQU      20                SIZE OF OUTPUT FPT
FPT      DO1      FPTLENG+1
         DATA     0
PAGE     DATA     0                 PAGE ADDRESS WHEN LINKED
RETFLG   DATA     0                 -1 IF ERROR, 0 OK
EXITMODE DATA     0
,LINKRET M:LDTRC,L 'XXX'              FPT FOR RETURN TO M:LINKER.
         TITLE    'COMPOSITE PARALLEL TABLES FOR DOCUMENTATION'
         SPACE
*  KEYWORD  KWX TYP MIN MAX  FLV FPT SUBROUTINE
*---------------------------------------------*
*  DEV       1   2   2   2    1  2   SHIFT2   *
*  IN        2   0   0   0    1  4            *
*  OUT       3   0   0   0    1  4   OUTSUB   *
*  VFC       4   0   0   0    1  17           *
*  NOVFC     5   0   0   0    1  17  NVFCSUB  *
*  DRC       6   0   0   0    1  32           *
*  LINES     7   1   1   255  1  5            *
*  FORM      8   2   1   4    1  12  SHIFT4   *
*  FFORM     9   2   1   4    1  13  SHIFT4   *
*  COUNT     10  1   1   132  1  6            *
*  SPACE     11  1   0   15   1  7            *
*  SPACE(2)  1-A 1   0   15   1  19           *
*  SEQ       12  4   1   4    1  10           *
*  JDE       13  1   1   33   1  8            *
*  FPC       14  2   1   4    1  11  SHIFT4   *
*  COPIES    15  1   1   255  1  9            *
*  WSN       16  2   1   8    1  3   WSNSUB   *
*  SRCB      17  0   0   0    1  25           *
*  DIRECT    18  0   0   0    1  31           *
*  ASAVE     19  0   0   0    1  28           *
*  AREL      20  0   0   0    1  27           *
*  AINIT     21  0   0   0    0  28           *
*  NAME      22  2   1   4    1  12  SHIFT4   *
*  DELETE    23  0   0   0    1  26           *
*  TESTMODE  24  0   0   0    0  0   TESTSUB  *
*  OUTPUT    25  0   0   0    1  29           *
*  CONCURR   26  0   0   0    1  29           *
*  NOBANNER  27  0   0   0    1  24           *
*  LABEL     28  5   0   0    1  20           *
*---------------------------------------------*
         SPACE
*        KEYWORD  1-8 CHARACTER STRING ENTERED BY USER
*        KWX      KEYWORD INDEX
*        TYP      0; NO SECONDARY PARAMETER EXPECTED
*                 1; SECONDARY PARAMETER IS NUMERIC FIELD
*                 2; SECONDARY PARAMETER IS STRING
*                 3; OPTIONAL NUMERIC
*                 4; OPTIONAL STRING
*                 5; SECONDARY PARAMETER IS STRINGS.
*        MIN      MINIMUM VALUE OR STRING LENGTH
*        MAX      MAXIMUM VALUE OR STRING LENGTH
*        FLV      BIT VALUE FOR FPT P-WORD
*        FPT      INDEX TO FPT WORD FOR THIS VALUE
*        SUBR.    SPECIAL SUBROUTINE FOR THIS PARAMETER
         TITLE    'O U T P U T   F P T'
         SPACE    2
* WORD   NAME       DEFAULT
         SPACE
*---------------------------------------------*
*  01  H STREAM ID                            *
*  02  H DEV                                  *
*  03  B RBID                                 *
*  04  B IN/OUT     1 (OUT)                   *
*  05  B LINES/MINR RB:MIN,DEVX               *
*  06  B COUNT      0                         *
*  07  B SPACE      0                         *
*  08  B JDE        0                         *
*  09  B COPIES     1                         *
*  10  W SEQ        0                         *
*  11  W FPC        0                         *
*  12  W FORM       0                         *
*  13  W FFORM      0                         *
*  14  B FLAG1      RH:F2,DEVX                *
*  15  B FLAG2      RH:F2,DEVX                *
*  16  B MAXR       RB:MAX,DEVX               *
*  17  B VFC/NVFC  1(VFC)                     *
*  19  B SPACE(2)   0                         *
*  20  W LABEL      0                         *
*---------------------------------------------*
         SPACE    2
*        FLAG BITS IN WORD 0:
         SPACE
*        32  DRC
*        31  DIRECT
*        30  HASP
*        29  OUTPUT (CONCURRENT OUTPUT MODE)
*        28  ASAVE/AINIT
*        27  AREL
*        26  CONCURR
*        25       (SRCB TEMPORARY)
*        24  NOBANNER
         TITLE    'USER COMMAND KEYWORD PARALLEL TABLE'
*        SET OF PARALLEL TABLES WHICH DETERMINE THE
*        TRANSLATION FROM USER COMMAND TO FPT
         DEF      SECT4             PROCEDURE CSECT IN LDEV.
SECT4    CSECT    1
KEYLIST  EQU      %
BLANKS   EQU      %                   <GET DW OF BLANKS FOR FREE>
*                           KWX
         TEXT     '        ' 0 DUMMY
         TEXT     'DEV     ' 1
         TEXT     'IN      ' 2
         TEXT     'OUT     ' 3
         TEXT     'VFC     ' 4
         TEXT     'NOVFC   ' 5
         TEXT     'DRC     ' 6
         TEXT     'LINES   ' 7
         TEXT     'FORM    ' 8
         TEXT     'FFORM   ' 9
         TEXT     'COUNT   ' 10
         TEXT     'SPACE   ' 11
         TEXT     'SEQ     ' 12
         TEXT     'JDE     ' 13
         TEXT     'FPC     ' 14
         TEXT     'COPIES  ' 15
         TEXT     'WSN     ' 16
         TEXT     'SRCB    ' 17
         TEXT     'DIRECT  ' 18
         TEXT     'ASAVE   ' 19
         TEXT     'AREL    '  20
         TEXT     'AINIT   '  21
         TEXT     'NAME    '  22 (SAME AS 'FORM')
         TEXT     'DELETE  '  23
         TEXT     'T       '  24  FOR CHECKOUT
         TEXT     'OUTPUT  '  25
         TEXT     'CONCURR ' 26
         TEXT     'NOBANNER'  27
         TEXT     'LABEL   '  28
NKEYS    EQU      (%-KEYLIST)/2-1
         SPACE
         TITLE    'SECONDARY ARGUMENT PARALLEL TABLE'
*        SECONDARY ARGS FOR KEYWORD.
*        BITS 0-3 DESCRIBE SECONDARY ARGS.
*          0000   NO SARG. TURN FPT BIT OFF.
*          0001   NO SARG. TURN FPT BIT ON.
*          0011   NO SARG. BYTES 2-3 = VALUE FOR FPT WORD.
*          0101   SARG CHARACTERS.
*          1001   SARG NUMERIC.  MIN/MAX IN 4-15,16-31.
*          1011     SAME BUT OPTIONAL.
*          1101   SARG TEXT. LENGTH MIN/MAX IN 4-15,16-31.
*          1111     SAME BUT OPTIONAL.
         SPACE
SARG     COM,4,12,8,8  CF(2),AF(1),AF(2),AF(3)
SARG     EQU      %
         SARG,13  0,2,2               (STREAM-ID)
         SARG,13  0,2,2             DEV
         SARG,3   0,0,0             IN
         SARG,3   0,0,1             OUT
         SARG,3   0,0,0             VFC
         SARG,3   0,0,1             NOVFC
         SARG,1   0,0,0             DRC
         SARG,9   0,1,255           LINES
         SARG,13  0,1,4             FORM
         SARG,13  0,1,4             FFORM
         SARG,9   0,1,132           COUNT
         SARG,9   NKEYS+1,0,15      SPACE
         SARG,15  0,0,4             SEQ
         SARG,9   0,1,33            JDE
         SARG,13  0,1,4             FPC
         SARG,9   0,1,255           COPIES
         SARG,13  0,1,8             WSN
         SARG,1   0,0,0             SRCB
         SARG,1   0,0,0             DIRECT
         SARG,1   0,0,0             ASAVE
         SARG,1   0,0,0             AREL
         SARG,0   0,0,0             AINIT
         SARG,13  0,1,4             NAME
         SARG,1   0,0,0             DELETE
         SARG,0   0,0,0             TESTMODE
         SARG,1   0,0,0             OUTPUT
         SARG,1   0,0,0             CONCURR
         SARG,1   0,0,0             NOBANNER
         SARG,5   0,0,0             LABEL
*********  AFTER HERE ARE SECOND VALUES FOR PREV KEYWORDS.
         SARG,9   0,0,15            SPACE(2)
         TITLE    'FPT FLAG PARALLEL TABLE'
*
*        VALUE INDICATES WHICH P-FLAG BIT IS TO BE
*        SET AND INTO WHICH FPT WORD THE VALUE IS
*        TO BE PLACED.  IF THE INDEX IS GREATER THAN
*        'HIFLAG', JUST SET FLAG AND DON'T STORE VALUE
         SPACE    3
HIFLAG   EQU      20
         BOUND    4
         SPACE    2
FLAG     DATA,1   1                   (STREAM-ID)
         DATA,1   2                 DEV
         DATA,1   4                 IN
         DATA,1   4                 OUT
         DATA,1   17                VFC
         DATA,1   17                NOVFC
         DATA,1   32                DRC
         DATA,1   5                 LINES
         DATA,1   12                FORM
         DATA,1   13                FFORM
         DATA,1   6                 COUNT
         DATA,1   7                 SPACE
         DATA,1   10                SEQ
         DATA,1   8                 JDE
         DATA,1   11                FPC
         DATA,1   9                 COPIES
         DATA,1   3                 WSN
         DATA,1   25                SRCB
         DATA,1   31                DIRECT
         DATA,1   28                ASAVE
         DATA,1   27                AREL
         DATA,1   28                AINIT
         DATA,1   12                NAME
         DATA,1   26                DELETE
         DATA,1   0                 TESTMODE (NO BIT SET)
         DATA,1   29                OUTPUT
         DATA,1   29                CONCURR
         DATA,1   24                NOBANNER
         DATA,1   20                LABEL
*********  AFTER HERE ARE SECOND VALUES FOR PREV KEYWORDS.
         DATA,1   19                SPACE(2)
         TITLE    'SPECIAL SUBROUTINE PARALLEL TABLE'
         SPACE    3
         BOUND    4
SUBR     EQU      %
         DATA     SHIFT2              (STREAM-ID)
         DATA     SHIFT2            DEV
         DATA     0                 2
         DATA     0                 3
         DATA     0                 4
         DATA     0                 5
         DATA     0                 6
         DATA     0                 7
         DATA     0                 8
         DATA     0                 9
         DATA     0                 10
         DATA     0                 11
         DATA     0                 12
         DATA     0                 13
         DATA     0                 14
         DATA     0                 15
         DATA     WSNSUB            WSN
         DATA     0                 17
         DATA     0                 18
         DATA     0                 19
         DATA     0                 20
         DATA     0                 21
         DATA     0                 22
         DATA     0                 23
         DATA     TESTSUB           TEST
         DATA     0                 25
         DATA     0                 26
         DATA     0                 NOBANNER 27
         DATA     0                 LABEL 28
*********  AFTER HERE ARE SECOND VALUES FOR PREV KEYWORDS.
         DATA     0                 SPACE(2)
         PAGE
         SPACE
*        ACCESS SYMBOLS FOR FPT
         SPACE
SID      EQU      FPT+1
RBID     EQU      FPT+3
WSN      EQU      FPT+3
DEV      EQU      FPT+2
MINR     EQU      FPT+5
MAXR     EQU      FPT+16
FORM     EQU      FPT+12
FLAG1    EQU      FPT+14
FLAG2    EQU      FPT+15
INOUT    EQU      FPT+4
         SPACE    2
FBITS    DATA     X'08070000'       5,14,15,16 FLAG BITS
DIRECTBIT EQU     2                 BIT 31
HASPBIT  EQU      4                 BIT 30
SRCBBIT  EQU      X'80'             BIT 25
         SPACE    2
*        FPT BITS ARE NUMBERED 1-32, LEFT TO RIGHT.
*        BIT 1 IN THE FPT P-WORD CORRESPONDS TO THE
*        FIRST PARAMETER, FPT+1, AND SO FORTH.
*        NON-FPT BITS ARE NUMBERED 0-31
         SPACE    2
*        TWO PARALLEL DATA LISTS FOR SCAN PROC ABOVE
         SPACE    2
COMMA    EQU      0
PERIOD   EQU      1
LPAREN   EQU      2
RPAREN   EQU      3
BLANK    EQU      4
SEMI     EQU      5
         SPACE    5
SCANL    DATA     ',','.','(',')',' ',';'
         TITLE    ':RBLOG SYMBOLS'
         SPACE
         SPACE    2
RB:RBID  EQU      RBLOG+0    ID OF THIS WSN IN BYTE ZERO
R:FLAG   EQU      RBLOG+1    FLAG WORD (HASP,SYS,SLV,XP1)
RD:WSN   EQU      RBLOG+2    DW WORK STATION NAME
RB:RP    EQU      RBLOG+4    MAX PRIORITY BYTE ZERO
R:BUF    EQU      RBLOG+5    MAX BYTES IN BLOCK THIS WORK STA
RD:RWSN  EQU      RBLOG+6    DW REMOTE WORK STA NAME
R:RMT    EQU      RBLOG+8    RMT NUMBER
RB:DMS   EQU      RBLOG+8           DMS MASK BYTE 0
R:INRCB  EQU      RBLOG+9    OC INPUT RCB OR ZERO
R:HSX    EQU      RBLOG+10   HIGHEST DEVICE INDEX SO FAR
R:OUTRCB EQU      RBLOG+11   SMD OUTPUT RCB
RH:DEV   EQU      RBLOG+12   16*HW DEVICE NAME TABLE
RB:RCB   EQU      RBLOG+20   16*BY RCB TABLE
RH:F1    EQU      RBLOG+24   16*HW FLAG1 TABLE
RH:F2    EQU      RBLOG+32   16*HW FLAG2 TABLE
RH:SUS   EQU      RBLOG+40   16*HW SUSBIT TABLE
RB:MAX   EQU      RBLOG+48   16*BY MAXIMUM REC SIZE TABLE
RB:MIN   EQU      RBLOG+52   16*BY MINIMUM REC SIZE TABLE
RB:PRIV  EQU      RBLOG+56   16*BY PRIV. TABLE
RB:TYPX  EQU      RBLOG+60   16*BY TYPE INDEX OC OPTION
         TITLE     ' '
*************************************
*                                   *
*        M A I N   P R O G R A M    *
*                                   *
*************************************
         SPACE    2
START    STW,8    LINKRET+1         8= LINKOR, OR =0 IF NOT L INKED TO.
         EXITCR   0                   RESET EXIT CONTROL STACK.
         M:PC     '%'
         MTW,0    LINKRET+1
         BEZ      NORMAL            ---> NOT LINKED TO.
         SPACE
*        LDEV WAS M:LINK-ED TO. FPT(S) IN COMMON PAGE.
         M:GL                       GET PARAMETER PAGE
         LW,X1    8
         STW,X1   PAGE              ALSO ACTS AS LINKED SWITCH
         LW,X0    0,X1
         SW,X0    MLC               TEXT TO PREVENT FUNNIES.
         BGZ      %+3               SINGLE CAL REQUEST ?
         LI,X0    1                 YES.
         B        CNTSET
         CI,X0    64                MAX # POSSIBLE IN PAGE.
         BG       %-3               MUST MEAN ONE.
CNTSET   EQU      %
         STB,X0   PAGE              SET # TO DO.
         SPACE    1
LKCONT   EQU      %
         LW,X2    L(X'C0000000')
         STW,X2   FPT                 FPT HAS P1 & P2 FOR SURE.
         LW,X0    1,X1              STREAM ID
         STW,X0   SID
         SPACE
         LW,X0    4,X1              DEVICE NAME
         STW,X0   DEV
         SPACE
         LW,X0    5,X1              SRCB  0=NO
         BEZ      NOSRCB
         LI,X3    SRCBBIT
         STS,X3   FPT               SET SRCB SWITCH
         SPACE
NOSRCB   LW,X0    6,X1              FORM NAME
         STW,X0   FORM
         BEZ      NOFORM            IF FORM FIELD VACANT
         LW,X3    =X'00100000'      FORM BIT FOR FPT
         STS,X3   FPT               INTO FPT
NOFORM   EQU      %
         SPACE
         LW,X2    2,X1              WORK STATION NAME (WSN)
         LW,X3    3,X1
         STD,X2   STRING            TO BE MADE KEY
         STW,X2   WSN
         STW,X3   WSN+1
         LW,X1    =X'20000000'      WSN PRESENCE BIT
         STS,X1   FPT               INTO FPT
         SPACE
*        GO OFF AND READ IN THE WSN RECORD
         SPACE
         MTW,1    EXITMODE          SET FOR I/O ERROR
         CALL     WSNSUB
         LW,X1    PAGE              RESTORE X1 AFTER WSNSUB
         SPACE
*        IF THE FLAG WORD CONTAINS 'TEST' SET TESTMODE SW
         SPACE
NOWSN    EQU      %
         LW,X0    0,X1              FLAG WORD
         CW,X0    ='TEST'
         BNE      FIN1              TO TO PROCESS WS
         MTW,1    TESTSW            SET TEST SWITCH (NO CAL)
         B        FIN1              TO PROCESS WS
         PAGE
*************************************
*                                   *
*        N O R M A L   P A T H      *
*        (NOT M:LINK'ED-TO)         *
*************************************
         SPACE    2
NORMAL   LC       J:JIT               ONLINE OR BATCH...
         BCS,8    ONL               ---> ONLINE.
*        IF IN BATCH AND J:CCBUF WORD 1 IS !JOB, LDEV IS BEING CALLED
*        BY CCI TO DO SETUP FOR WSN ON JOB CARD.
         LW,R     J:CCBUF
         CW,R     L('!JOB')
         BE       ALT               ---> SPECIAL CCI ENTRY.
         LI,IP    0                   REGULAR BATCH.
         B        SP3               ---> GO READ CONTROL CARD.
         SPACE
ONL      LI,R     -1
         STW,R    ONLINE            0 IF BATCH, -1 IF ONLINE.
         LB,IP    JB:CCARS
         AI,IP    -1                IP= CC LENGTH LESS C/R.
         LI,R1    BA(COMMAND)         MOVE COMMAND TO 'COMMAND'
         STB,IP   R1                  FROM
         MBS,R1   BA(J:CCBUF)-BA(COMMAND)  J:CCBUF.
         SPACE
*        SCAN CONTROL COMMAND FOR CONTINUATION INDICATORS.
SPSCAN   STW,IP   CEND              CEND= # CC CHARACTERS SO FAR.
         LI,IP    0                   START AT BEGINNING.
SP00     SCAN,EM0  (*BLANK,SP01)   TO 'L'DEV
SP01     SCAN,EM0  (BLANK,SP1)     TO LDEV' ' OR LDEV.' '
SP1      SCAN,SP4 (SEMI,SP2),(PERIOD,SP4)  --->SP4 IF NO CONTINUE.
SP2      MTW,1    CONTSW              CONTINUED. SET ERRMSG FLAG.
SP3      ANLZ,R2  BASEIP
         SLD,R2   -2
         SLS,R3   -30
         M:READ   M:C,(BUF,*R2),(BTD,*R3),(SIZE,80)
         LW,R     M:C+4
         SLS,R    -17
         AW,R     ONLINE            TRUNC. CAR RET
         AW,IP    R
         CW,IP    COMMAX            MAX COM LENGTH
         BG       EM4               TOO LONG
         B        SPSCAN            ---> RE-SCAN COMMAND.
         SPACE    2
SP4      SCANR,EM0 (*BLANK,SP5)
SP5      AI,IP    1                 IP -> LAST CHAR IN COMMAND.
         STW,IP   CEND
         LI,IP    0                   RESET SCAN INDEX.
         STW,IP   INDENT              WE AREN'T NOW IN PARENTHESES.
         LI,KWX   0                   FIRST TIME STREAM-ID KEYWD #0.
A1       SCAN,EM0 (*BLANK,A2)         SKIP TO 'L' OF 'LDEV.'
A2       SCAN,EM0 (BLANK,ML3)         PAST LDEV, THEN SCAN STREAM-ID.
         PAGE
*************************************
*                                   *
*        M A I N   L O O P          *
*                                   *
*************************************
         SPACE    3
*        HOP OVER NEXT '(' AND GET KEYWORD
ML1      LI,R5    3                 R5= 3/SUBPARAM(S), 1/NO SUBPARAM
         CALL     GETFIRST            GET KEYWORD
         B        FIN1              ---> END OF COMMAND.
         LI,R5    1                 ---- ')' FOLLOWS; NO SUBPARAM.
*                                   ---- ',' FOLLOWS; SUBPARAM.
         CALL     GETKWX            KWX<= INDEX# OF KEYWORD.
         B        EM2               ***> UNRECOGNIZED KEYWORD.
         SPACE
*        GET AND PROCESS PARAMETER.  (2-SUB ARGS RECYCLE HERE).
*        SEE IF SECONDARY PARAMETER DESIRED.
ML1A     INT,R    SARG,KWX            GET SECONDARY ARG TYPE.
         BCS,12   ML20              ---> SECONDARY ARG EXPECTED.
         BDR,R5   EM0               ***> NOT EXPECTED BUT PRESENT.
         STW,R1   STRING              CANNED FPT WORD IF NEEDED.
         B        ML7               ---> NOT EXPECTED OR PRESENT.
         SPACE
*        SECONDARY PARAMETER IS DESIRED OR OPTIONAL.
ML20     BDR,R5   ML21              ---> PRESENT.
         BCR,2    EM0               ***> NEEDED BUT NOT PRESENT.
         LI,R1    0
         STW,R1   STRING              DEFAULT VALUE IS ZERO.
         B        ML6               ---> OPTIONAL AND NOT PRESENT.
ML21     BCS,8    ML3               ---> NUM OR STR PRESENT.
         SPACE
*        GET AND PROCESS TXT SECONDARY PARAMETER.
         LI,X     0
ML25A    SCAN,EM0 (RPAREN,ML25C),;
                  (*RPAREN,ML25B)
ML25B    AI,X     1
         CI,X     255
         BG       EM0               * TEXTC LIMITED TO 255.
         STB,R    LABEL,X
         B        ML25A
ML25C    STB,X    LABEL             * PUT COUNT INTO TEXTC.
         LI,X     LABEL
         STW,X    STRING
         B        ML7
         SPACE
*        GET AND PROCESS NUM OR STR SECONDARY PARAMETER.
ML3      CALL     GETNEXT
           B      EM0               COMMAND ENDS
           B      ML4               FOLLOWED BY ')'
         LW,R     SARG,KWX          FOLLOWED BY ','
         CW,R     L(X'00FF0000')
         BAZ      EM0               OKAY ONLY IF 2-PARAM KWD.
         SPACE
*        'VALUE' DW HAS SECONDARY PARA AS LEFT-JUSTIFIED STRING
*        TRAILING BLANKS.  'X' HAS STRING LENGTH.
ML4      INT,R    SARG,KWX            GET SECONDARY ARG TYPE.
         BCS,4    STR               ---> STRING.
         SPACE
*        NUMERIC FIELD.  CONVERT TO BINARY.
         LI,X3    0                 X3 WILL BE BINARY VALUE.
         LI,X2    0
NUM2     CW,X2    X
         BGE      NUM3              ---> GOT THE WHOLE VALUE.
         LB,R     STRING,X2
         AI,R     -'0'
         BLZ      EM5               ***> NOT A DIGIT.
         CI,R     9
         BG       EM5               ***> NOT A DIGIT.
         MI,X3    10
         AW,X3    R                   ACCUMULATE VALUE.
         AI,X2    1
         B        NUM2
NUM3     STW,X3   STRING              GOT THE WHOLE VALUE.
         B        MINMAX
         SPACE
*        CHARACTER STRING.  CHECK STRING LENGTH.
STR      LW,X3    X                 X3 CONTAINS LENGTH.
*        B        MINMAX
         SPACE
*        CHECK STRING LENGTH OR NUMBER VALUE AGAINST
*        VALUES IN TABLE.
MINMAX   LW,R     SARG,KWX
         LI,X     2
         LB,R1    R,X               R1= MIN
         CW,R1    X3
         BG       EM3               ***> TOO SMALL.
         LI,X     3
         LB,R1    R,X               R1= MAX
         CW,R1    X3
         BL       EM3               ***> TOO BIG.
         SPACE
*        PARAMETER VALUE NOW IN VALUE+1.
*        GO TO SPECIAL SUBROUTINE IF SPECIFIED IN TABLE.
ML6      EQU      %
ML7      LW,R     SUBR,KWX
         BEZ      %+2
         CALL     *R
         SPACE
*        PLACE VALUE IN FPT WORD ACCORDING TO TABLE.
         LB,X     FLAG,KWX          X = FPT WORD.
         BEZ      ML9               ---> NO WORD OR BIT TO SET.
         CI,X     HIFLAG
         BG       ML8               ---> SET BIT BUT NOT WORD.
         LW,R     STRING
         STW,R    FPT,X
         SPACE
*        SET BIT IN FPT PPW WORD ACCORDING TO TABLE.
ML8      LI,R     -1                  ASSUME P-BIT TO BE ONE.
         INT,R1   SARG,KWX
         BCS,1    %+2
         LI,R     0                   NO, P-BIT TO BE ZERO.
         LI,R1    1
         LCW,X    X
         SCS,R1   0,X                 GET ONE-BIT MASK.
         STS,R    FPT                 SET FPT PPW-WORD BIT.
         SPACE    1
ML9      INT,R    SARG,KWX
         AND,R    L(X'FF')          SEE IF IT'S A 2-ARG KWD.
         BEZ      ML1               NO.
         MTW,0    INDENT              IS THERE ANOTHER ARG...
         BEZ      ML1               ---> NO.
         LW,KWX   R                 PROCEED TO 2ND
         B        ML1A              AND GO DO IT.
         TITLE    'SPECIAL USER SUBROUTINES'
         SPACE
*        THIS ROUTINE READS THE :RBLOG FILE WITH
*        WSN AS A KEY.  THE RBID AND OTHER DATA ARE
*        EXTRACTED FROM THE RECORD AND PLACED IN
*        THE LDEV FPT LATER ON.
         SPACE    2
         SPACE    2
WSNSUB   ENTER
         LD,2     KEY               WORKSTATION NAME
         CW,2     ='%   '           IS WSN SPECIAL CASE '%'
         BNE      NOT%              NO,GET NAMED WSN RECORD
         SPACE
         LI,2     BA(J:JIT+JRBID)+1 RBID IN JIT
         LB,X     0,2               THE RBID INDEX
         BEZ      SETLOC            AS IF NO WSN NAMED
         SPACE
         LD,R     SPECIAL           KEY OF WSN DIRECTORY RECORD
         STD,R    KEY
         CALL     KEYREAD           GET DIRECTORY
           B      EM14              IMPOSSIBLE ERROR (NO RECORD)
         LD,R     RBLOG,X           WSN(RBID)
         STD,R    KEY               READY TO GET WSN(RBID)
         SPACE
NOT%     CD,2     TXLOCAL           WSN=LOCAL=NO WSN
         BE       SETLOC            BYPASS P-WORD SETTING
         CALL     KEYREAD           GET THE RECORD
           B      EM6               NO WSN ERROR
         RETURN                     GOT IT
         SPACE
SETLOC   MTW,1    LOCAL             SET SWITCH WSN=LOCAL
         RETURN
         PAGE
SHIFT2   ENTER
         LW,R     STRING
         SLS,R    -16
         STW,R    STRING
         RETURN
         SPACE    2
*        ENTERED IF USER SAID 'TESTMODE'. A SWITCH
*        IS SET SO NO CAL IS EXECUTED AND THE FPT
*        IS PRINTED.  THIS OPTION MAY REMAIN UNDOCUMENTED.
         SPACE
TESTSUB  ENTER
         MTW,1    TESTSW            LOADED AS ZERO
         RETURN
         PAGE
*        ENTERED TO GET WORDS FROM USER COMMAND LINE.  EXITS TO:
*        CALL+1   NO PARAMETERS REMAINING.
*        CALL+2   NO (MORE) SUBPARAMETERS.     'INDENT' = 0.
*        CALL+3   SUBPARAMETERS AFTER THIS.    'INDENT' = 1.
*        IF RETURN TO CALL+2 OR CALL+3, 'STRING' DW CONTAINS PARAMETER
*        WORD LEFT-JUSTIFIED AND 'X' CONTAINS WORD LENGTH.
         SPACE
GETFIRST ENTER                        'IP' POINTS BEFORE PARAM.
GK1      SCAN,RET ;                 ---> GO IF END OF COMMAND.
                  (COMMA,GK1),;     ---> SKIP OVER COMMAS.
                  (RPAREN,EM0),;    ***> ')' ILLEGAL HERE.
                  (LPAREN,GK1Y),;   ---> '(' SAYS TO INDENT.
                  (*BLANK,GK1N)     ---> NO '(' SAYS TO NOT INDENT.
GK1N     AI,IP    -1                  RESCAN NON-LPAREN.
         LI,X     0                   SAY NO '('.
         B        %+2
GK1Y     LI,X     1                   SAY YES '('.
         STW,X    INDENT            INDENT= 0 FOR '(' INDENT.
         B        GK2
         SPACE
*        GETNEXT GETS NEXT SUBPARAMETER.  (INDENT=1 WHEN CALLED)
GETNEXT  ENTER
GK2      LI,X     0                 X WILL BE LENGTH.
         LD,R     BLANKS
         STD,R    STRING            'STRING' WILL BE PARAM TEXT.
GK3      SCAN,GK9N ;                --->ENDCMD. END; NO ')'.
                  (COMMA,GK9N),;    ---> COMMA. END; NO ')'.
                  (RPAREN,GK9Y),;   --->  ')' . END; GOT ')'.
                  (LPAREN,EM0),;    ***> '(' ILLEGAL HERE.
                  (*BLANK,GK4),;    ---> PARAMETER CHARACTER.
                  (BLANK,GK6)       ---> BLANK. IGNORE LEADERS.
GK4      EQU      %
BASEIP   LB,R     *BASE,IP          R = NEXT CHARACTER.
         CI,X     8
         BGE      EM0               ***> WORD TOO LONG.
         STB,R    STRING,X
         AI,X     1
         B        GK3
GK6      AI,X     0                   GOT BLANK.
         BEZ      GK3               ---> IGNORE LEADING BLANKS.
GK7      SCAN,GK9N ;                --->ENDCMD. END; NO ')'.
                  (COMMA,GK9N),;    ---> COMMA. END; NO ')'.
                  (RPAREN,GK9Y),;   --->  ')' . END; GOT ')'.
                  (*BLANK,EM0)      ***> OTHERS ILLEGAL HERE.
*
GK9Y     MTW,-1   INDENT              FOUND ')'  (END OF INDENT)
GK9N     MTW,0    INDENT              FOUND ','  (INDENT CONTINUES)
         BLZ      EM0               ***> ','...')'
         BEZ      RET2              ---> ','...',' OR '('...')'
         B        RET3              ---> '('...','
RET      RETURN
RET2     RETURN   2
RET3     RETURN   3
         TITLE    'GET-KEYWORD-INDEX SUBROUTINE'
         SPACE
*        CALL     GETKWX            ENTRY
         SPACE
*        KEYWORD IN 'STRING' DW IS COMPARED TO KEYLIST
*        AND INDEX VALUE IS LEFT IN 'KWX'.  INDEX ZERO
*        NOT USED.
         SPACE
*        EXIT TO CALL+1: UNRECOGNIZED KEY
*                CALL+2: OK
         SPACE
         SPACE
GETKWX   ENTER
         LD,0     STRING
         LI,KWX   NKEYS             NUMBER OF KEYS IN LIST
         CD,0     KEYLIST,KWX
         BE       RET2              NORMAL EXIT
         BDR,KWX  %-2
         RETURN                     NOT FOUND
         TITLE    'END ROUTINE'
         SPACE
*        AT THIS POINT THE FPT CONTAINS ALL THE
*        DATA FROM USER'S COMMAND.  THE :RBLOG
*        RECORD IS IN RBLOG. MAKE VARIOUS CHECKS
*        AND TRANSFER APPROPRIATE DATA FROM RBLOG
*        TO FPT AND DO CAL
         SPACE
FIN1     EQU      %
*        WAS WSN SPECIFIED
         SPACE
         MTW,0    LOCAL             WAS WSN=LOCAL
         BEZ      FIN2              NOT LOCAL
         LW,R     FPT
         AND,R    =X'DFFFFFFF'      CLEAR WSN PRESENCE BIT
         STW,R    FPT               INTO FPT
         B        WS99
FIN2     EQU      %
         LW,R     =X'20000000'
         CW,R     FPT
         BAZ      WSN100
         SPACE
*        WAS DEV SPECIFIED
         SPACE
WSNYES   EQU      %
         LW,R      DEV
         BEZ      EM7               NO DEV ERROR
         SPACE
*        SEARCH RH:DEV FOR DEV CODE IN R
         SPACE
         LI,IDX   0
WSN2     CW,IDX   R:HSX
         BG       EM8               NOT IN TABLE
         LH,R1    RH:DEV,IDX        GET DEV NAME
         AND,R1   =X'FFFF'          RID EXTENDED SIGN
         CW,R     R1
         BE       WSN3              FOUND IT
         AI,IDX   1                 STEP INDEX
         B        WSN2
         SPACE
         SPACE
*        REPLACE FPT(DEV) WITH DEVICE CODE
         SPACE
WSN3     LB,R     RB:RCB,IDX
         LB,R1    RB:DMS            MASK
         AND,R    R1
         STW,R     DEV
         SPACE
*        SET MIN AND MAX
         SPACE
         SPACE
*        IF MIN OR MAX NOT SPECIFIED ON LDEV COMMAND,
*        USE THE CORRESPONDING VALUES FROM WSN RECORD
         SPACE
         MTW,0    MINR              ON COMMAND
         BNEZ     %+3               YES
         LB,R     RB:MIN,IDX        NO, USE WSN
         STW,R    MINR              INTO FPT
         SPACE
         MTW,0    MAXR              ON COMMAND
         BNEZ     %+3               YES
         LB,R     RB:MAX,IDX        NO, USE WSN
         STW,R    MAXR
         SPACE    2
         LH,R     RH:F2,IDX
         LI,R1    X'FF'             MASK
         STS,R    FLAG2             SPLIT HALF WORD INTO
         SLS,R    -8                TWO BYTES AND PUT IN
         STS,R    FLAG1             FPT FLAG1 AND FLAG2
         SPACE    2
         LW,R1    FBITS             SET P WORD
         STS,R1   FPT
         SPACE
*        IF RBLOG(DIRECT)=0 AND USER SAID DIRECT;ERROR
         SPACE
         LI,R1    DIRECTBIT
         CS,R1    FPT
         BNE      WSN10
         LW,R1    =X'8000'          BIT 1 OF HW
         LH,R2    RH:F2,IDX
         CS,R1    R2
         SPACE
*        IF TYPE=2780 OR 7670,TEST DEVICE TYPE AND MAXREC
*        FOR POSSIBLE MODIFICATION
         SPACE
         LW,R     MAXR              TYPE IRBT BIT
         LW,R1    =X'02000000'      TYPE IRBT BIT
         CS,R1    R:FLAG
         BE       WSN9              BRANCH IF NOT 2780 OR 7670
         SPACE
*        TYPE = 2780 OR 7670
         SPACE
         LW,R2    DEV               DEVICE NAME
         CI,R2    'CP'
         BNE      WSN4
         SPACE
*        TYPE = 2780 OR 7670 AND DEV = CP
         SPACE
         CI,R     80                USE MAX OF MAXR AND 80
         BG       WSN9              OK AS IS
         LI,R     80
         B        WSN8              PUT 80 IN MAXR
WSN4     CI,R2    'LP'
         BNE      WSN9
         SPACE
*        TYPE = 2780 OR 7670 AND DEV = LP
         SPACE
         LW,R1    =X'002000000'     TYPE 2780 FLAG BIT IF SET
         CS,R1    R:FLAG
         BE       WSN6
         SPACE
*        TYPE = 7670 AND DEV = LP
         SPACE
         CI,R     128               USE MAX OF MAXR AND 128
         BG       WSN9              OK AS IS
         LI,R     128               USE 128 FOR MAXR
         B        WSN8
         SPACE
*        TYPE = 2780 AND DEV = LP
         SPACE
WSN6     CI,R     120               USE MAX OF MAXR AND 120
         BG       WSN9
         LI,R     120
WSN8     STW,R    MAXR              REPLACEMENT VALUE INTO MAXR
WSN9     EQU      %
         BNEZ     EM9
         SPACE
WSN10    LW,R1    =X'02000000'
         CS,R1    R:FLAG
         BNE      WS12              HASP=0
         LI,R1    HASPBIT
         STS,R1   FPT               SET HASP FLAG
         SPACE    2
*        CHECK USER PRIV
         SPACE
WS12     LB,R     RB:PRIV,IDX
         CB,R     *PRIV
         BG       EM10
         LI,R     JB:PRIV
         STW,R    PRIV
         SPACE
         LB,R      RB:RBID
         STW,R     RBID
         SPACE    2
*        CHECK SRCB CONSISTANCY
         SPACE
WSN13    LI,R1    X'7'              MASK
         LI,R     X'4'
         SPACE
*        DID USER SAY SRCB ON LDEV COMMAND
         SPACE
         LI,R3    SRCBBIT           BIT 29
         CS,R3    FPT
         BNE      WSN15             NO
         SPACE
         STS,R    FLAG1             YES
         B        WSN18
         SPACE
WSN15    CS,R     FLAG1
         BE       EM12              ERROR
         SPACE
*        CHECK INPUT/OUTPUT CONSISTANCY
         SPACE
WSN18    LI,R3    X'30'
         LW,R1    =X'10000000'  IN/OUT BIT (OUT=1)
         CS,R1    FPT
         BNE      WSN25
         LI,R3    X'20'
         MTW,0    INOUT             IN FPT
         BEZ      WSN25
         LI,R3    X'10'
WSN25    CH,R3    RH:F2,IDX
         BAZ      EM13
         SPACE
*        IN-OUT CHECKS. TAKE IN/OUT VALUE FROM RBLOG
*        RECORD AND PUT INTO FPT AND SET IN/OUT FPT BIT
         SPACE
         LH,R1    RH:F1,IDX
         AI,R1    1                 TOGGLE LOW BIT
         AND,R1   =X'1'             IN/OUT (OUT=0)
         STW,R1   INOUT             INTO FPT
         LW,R1    =X'10000000'      IN/OUT P BIT
         OR,R1    FPT               INTO P WORD
         STW,R1   FPT
         SPACE
*        IF USER SAID 'SRCB' AND 'IN' AND DEVICE
*        DATA FROM :RBLOG RECORD HAS SRCB AS NOT 'U', ERROR
         SPACE
         LI,R3    SRCBBIT           P-BIT
         OR,R3    =X'10000000'      IN/OUT P-BIT
         CS,R3    FPT               SRCB AND (IN OR OUT)?
         BNE      WS99              NO, QUIT
         MTW,0    INOUT             IN?
         BNEZ     WS99              OUT, QUIT
         LI,R3    X'4'              SRCB=U BIT
         CS,R3    FLAG1             IS IT SRCB=U
         BNE      EM15              NO, ERROR
         SPACE
         SPACE
         SPACE    2
WS99     CALL     COMPFPT           COMPRESS FPT
         MTW,0    TESTSW            IN TESTMODE?
         BNEZ     EXIT              YES; NO CAL
         SPACE    2
*        IF LDEV ERROR, CC1=1 AND SR3 CONTAINS CONVENTIONAL
*        ERROR CODES: CODE=B7, SUBCODE=0,1,2, OR 3 THE
*        MEANINGS OF WHICH ARE SHOWN IN THE MESSAGES BC0-BC3
         SPACE
         SPACE
         CAL1,8   CALFPT            ******************
         BCR,8    GOODCAL           EXAMINE RETURN STATUS
         MTW,-1   RETFLG            SET FOR ABORTION
         SCS,10   15                (SR3 ERROR CODE)
         AND,10   =X'7'
         LW,X     10                ERROR INDEX
         EXU      BADCAL,X          TYPE MESSAGE
GOODCAL  MTW,0    ALTMODE
         BEZ      EXIT
         RETURN
ERREXIT  MTW,-1   RETFLG            SET ERROR FLAG FOR LINK
EXIT     LW,X1    PAGE              IN LINKED MODE 0=NO
         BEZ      NORMEX
         MTB,-1   X1
         BEZ      LNKXIT            NO MORE TO DO.
         MTW,0    RETFLG            ERROR OCCUR ???
         BNEZ     LNKXIT            YES - > EXIT.
         AI,X1    8                 BUMP TO NEXT FPT.
         STW,X1   PAGE              REMEMBER.
         B        LKCONT
LNKXIT   EQU      %
         LI,X1    X'1FE00'          PICK UP PAGE ADDRESS.
         LS,X1    PAGE
         LW,R     RETFLG
         BEZ      %+2
         LW,R     PAGE              LET USER KNOW WHICH ONE.
         STW,R    0,X1              INTO LINK PAGE
         LW,0     LINKRET+1
         BEZ      NORMEX
         M:LDTRC,E LINKRET          LINKED RETURN
NORMEX   EQU      %
         MTW,0    RETFLG            ZERO=NO ERROR
         BEZ      %+2
         M:XXX                      ABORT JOB
         MTW,0    EXITSW            CCI ERR FLG
         BEZ      %+2               0 OF NO ERROR
         M:EXIT   1                 ERROR RETURN TO CCI
         CAL1,9   X'0001'           NORMAL
         PAGE
WSN100   EQU      %
         LW,R     DEV               USER-SPECIFIED DEVICE
         BEZ      WS99              NOT PRESENT
         LI,2     BA(J:JIT+JRBID)+1
         LB,X     0,2               RBID INDEX
         BEZ      WS99              NOT PRESENT
         SPACE
*        USE SPECIAL KEY '%' SO KEYREAD SUBROUTINE WILL
*        READ IN WSN(RBID)
         SPACE
         LD,R     KEY%
         STD,R    KEY
         CALL     WSNSUB            GET WSN(RBID)
         LW,R     DEV               IF DEV=LP OR CP
         LI,R1    X'1000'           SLD FLAG BIT
         CI,R     'LP'              DEV=LP
         BE       WSN105            USE SLD AS DEVICE
         LI,R1    X'2000'           SPD FLAG BIT
         CI,R     'CP'
         BNE      WS99              NOT LO OR CP
         SPACE
WSN105   CALL     SEARCH RH:F2 FOR SLD OR SPD DEPENDING ON R1
           B      WS99              NOT THERE
         LH,R     RH:DEV,X          GET DEV NAME
         AND,R    =X'FFFF'          UPPER HALF TO ZERO
         STW,R    DEV               AS THO USER SAID IT
         LW,R1    =X'20000000'      WSN PRESENCE FLAG BIT
         STS,R1   FPT               INTO P-WORD
         B        WSNYES
         SPACE    3
BADCAL   M:PRINT  (MESS,BC0)
         M:PRINT  (MESS,BC1)
         M:PRINT  (MESS,BC2)
         M:PRINT  (MESS,BC3)
         M:PRINT  (MESS,BC4)
         M:PRINT  (MESS,BC5)
         M:PRINT  (MESS,BC6)
         M:PRINT  (MESS,BC7)
         SPACE
BC0      TEXTC    '***** UNRECOGNIZED STREAM ID'
BC1      TEXTC    '***** UNRECOGNIZED DEV SPECIFICATION'
BC2      TEXTC    '***** FUNCTION NOT LEGAL FOR DEVICE'
BC3      TEXTC    '***** NOT AUTHORIZED FOR REMOTE WSN'
BC4      TEXTC    '***** PERIPHERAL USE FLAG NOT SET FOR THIS DEVICE'
BC5  TEXTC  '***** >1 COPIES NOT ALLOWED IN CONCURRENT OUTPUT MODE'
BC6      TEXTC    '***** CONCURRENT OUTPUT MODE ILLEGAL FOR RBT'
BC7  TEXTC  '***** YOU ARE NOT AUTHORIZED FOR CONCURRENT OUTPUT MODE'
BCX      TEXTC    '*LDEV FPT PROC RETURNED BAD ERR CODE'
         TITLE    'ALTERNATE LDEV MODE'
         SPACE
*        IF IN BATCH MODE AND WORD 1 OF J:CCBUF IS
*        NOT JOB, A WSN HAS BEEN SPECIFIED ON THE JOB
*        CARD.
         SPACE    2
ALT      EQU      %
         LI,R     WS12
         STW,R    PRIV              INTO 'SWITCH'
         LD,R     J:DWSK            8 CHAR WSN
         STD,R    KEY               FOR KEYREAD SUBR.
         BEZ      ALT10             NO WSN THERE
         CD,R     TXLOCAL           WSN=LOCAL
         BE       EXIT              IGNORE IT
         LI,R     0
         STW,R    EXITSW            ERROR SWITCH= NO
         SPACE
ALT5     MTW,1    EXITMODE          FOR EXIT IF I/O ERROR
         CALL     KEYREAD
           B      ALT7              NO SUCH KEY
           B      ALT20             GOT IT
         SPACE
ALT7     MTW,1    EXITSW            ERROR SWITCH= YES
ALT10    LI,2     BA(J:JIT+JRBID)+1  THE RBID
         LB,X     0,2               RBID INDEX
         BEZ      EXIT              NO RBID
         LD,R     SPECIAL           KEY TO RBID RECORD
         STD,R    KEY
         CALL     KEYREAD           READ RBID RECORD
           B      EM14              IMPOSSIBLE ERROR
         LD,R     RBLOG,X           THE 8 CHAR WSN
         STD,R    KEY
         BEZ      EXIT              NO WSN
         B        ALT5
         SPACE
ALT20    LB,R1    RB:RBID           PLACE RBID INTO JIT
         LI,2     BA(J:JIT+JRBID)+1
         STB,R1   0,2
         LI,R1    X'1000'           LIST=3 FLAG BIT
         CALL     SEARCH            RH:F2
           B      ALT40             NONE EXISTS
         LI,R1    'L1'
         CALL     DOCAL             DO THE CAL
         SPACE
ALT40    LI,R1    WS12
         STW,R1   PRIV
         LI,R1    X'2000'           LIST=P FLAG BIT
         CALL     SEARCH            RH:F2
           B      EXIT              NONE EXISTS
         LI,R1    'P1'
         CALL     DOCAL             DO THE CAL
         B        EXIT
         TITLE
*        SUBROUTINE TO SEARCH RH:F2 FOR FLAG
*        BIT AS SPECIFIED IN R1. EXIT TO CALL+1
*        IF NOT FOUND, ELSE CALL+2
         SPACE
SEARCH   ENTER
         LW,X     R:HSX
S22      LH,R     RH:F2,X
         CS,R     R1
         BE       RET2              FOUND
         AI,X     -1
         BGEZ     S22
         RETURN                     NOT FOUND
         SPACE    2
*        SUBROUTINE TO PIECE TOGETHER AN LDEV
*        FPT AS IF USER HAD GIVEN COMMAND:
         SPACE
*LDEV XX,(DEV,YY),(WSN,ZZ)
         SPACE
*        XX IS FOUND IN R1 AND IS EITHER L1 OR P1
*        YY IS THE CORRESPONDING DEV  CODE
*        ZZ IS THE WORKSTATION NAME
         SPACE
DOCAL    ENTER
         LH,R     RH:DEV,X
         AND,R    =X'FFFF'          ELIM EXT SIGN
         STW,R    DEV               INTO FPT
         STW,R1   SID               L1 OR P1
         LW,R     ALTPBITS
         STW,R    FPT               P BITS
         MTW,1    ALTMODE           SET RETURN SWITCH
         LD,R     KEY
         STW,R    WSN
         STW,R1   WSN+1
         B        FIN1              GO DO SOME STUFF
*                                   AND RETURN
         SPACE
*        THE PRELIMINARY P-WORD FOR THE ALT CAL
*        HAS BITS FOR SID,RBID,DEV
         SPACE
ALTPBITS DATA     X'E0000000'
         TITLE    'ERROR ROUTINES AND MESSAGES'
         SPACE
*        SUBROUTINE TO PRINT POINTER TO COMMAND ERROR
         SPACE
PPOINT   ENTER
         MTW,0    CONTSW            HAS COMMAND BEEN CONT'D
         BNEZ     RET               YES, NO POINTER
         LW,1     CLEARP
         MBS,0    BA(BLANKS)        CLEAR OUT PLINE
         CW,IP    CEND
         BL       %+2                 IF WE FELL OFF END OF COMMAND,
         AI,IP    -1                  BACK UP POINTER TO BE PRINTABLE.
         LI,R     '*'               POINTER CHARACTER
         STB,R    PLINE,IP          IP INDEX TO OFFENDER
         M:WRITE  M:LL,(BUF,PLINE),(SIZE,*CEND)
         RETURN
         SPACE
EM0      CALL     PPOINT            SYNTAX ERROR
         M:PRINT  (MESS,EM0M)
         B        ERREXIT
         SPACE
EM1      CALL     PPOINT
         M:PRINT  (MESS,EM1M)
         B        ERREXIT
         SPACE
EM2      CALL     PPOINT
         M:PRINT  (MESS,EM2M)
         B        ERREXIT
         SPACE
         SPACE
EM3      CALL     PPOINT
         M:PRINT  (MESS,EM3M)
         B        ERREXIT
         SPACE
         SPACE
EM4      M:PRINT  (MESS,EM4M)
         B        ERREXIT
            SPACE
EM5      CALL     PPOINT
         M:PRINT  (MESS,EM5M)
         B        ERREXIT
         SPACE
EM6      M:PRINT  (MESS,EM6M)
         B        ERREXIT
EM7      M:PRINT  (MESS,EM7M)
         B        ERREXIT
EM8      M:PRINT  (MESS,EM8M)
         B        ERREXIT
EM9      M:PRINT  (MESS,EM9M)
         B        ERREXIT
EM10     M:PRINT  (MESS,EM10M)
         B        ERREXIT
EM11     M:PRINT  (MESS,EM11M)
         B        ERREXIT
EM12     M:PRINT  (MESS,EM12M)
         B        ERREXIT
EM13     M:PRINT  (MESS,EM13M)
         B        ERREXIT
EM14     M:PRINT  (MESS,EM14M)
         B        ERREXIT
EM15     M:PRINT  (MESS,EM15M)
         B        ERREXIT
         PAGE
         SPACE
EM0M     TEXTC    '***** SYNTAX ERROR IN ABOVE COMMAND'
EM1M     TEXTC    '***** UNRECOGNIZED STREAM I.D.'
EM2M     TEXTC    '***** UNRECOGNIZED KEYWORD'
EM3M     TEXTC    '***** ILLEGAL VALUE OR STRING LENGTH'
EM4M     TEXTC    '***** COMMAND IS TOO LONG'
EM5M     TEXTC    '***** ILLEGAL CHARACTER IN NUMERIC FIELD'
EM6M     TEXTC    '***** UNRECOGNIZED WSN'
EM7M     TEXTC    '***** NO DEV SPECIFIED'
EM8M     TEXTC    '***** DEV CODE NOT FOUND IN :RBLOG'
EM9M     TEXTC    '***** DIRECT NOT ALLOWED FOR THIS DEVICE'
EM10M    TEXTC    '***** INSUFFICIENT PRIV.'
EM11M    TEXTC    '***** USER NOT ALLOWED ACCESS'
EM12M    TEXTC    '***** SRCB WIERDNESS'
EM13M    TEXTC    '***** IN/OUT INCONSISTANCY'
EM14M    TEXTC    '***** WSN REC :RBLOG MISSING'
EM15M    TEXTC    '***** SRCBS NOT AVAILABLE FROM DEV'
         TITLE
*        SUBROUTINE TO COMPRESS FINISHED FPT
         SPACE
COMPFPT  ENTER
         MTW,0    TESTSW            IN TESTMODE
         BEZ      %+3               DON'T PRINT
         LW,3     FPT
         CALL     HPRINT
         LI,3     HIFLAG+1
         LI,1     0
         LI,2     0
         LW,R     FPT
         STW,R    OUTFPT
CFPT2    S,R      1
         BCR,8    CFPT4             BRANCH IF ABSENT
         LW,R1    FPT+1,1
         STW,R1   OUTFPT+1,2
         SPACE
         MTW,0    TESTSW            IN TEST MODE?
         BEZ      CFPT3             YES; DON'T PRINT
         XW,3     R1                  PRINT C(3); PRESERVE 3 IN R1.
         CALL     HPRINT
         LW,3     R1                  RESTORE 3.
         SPACE
CFPT3    AI,2     1
CFPT4    AI,1     1
         BDR,3    CFPT2
         RETURN
         PAGE
*        SUBROUTINE TO PRINT WORD IN REG 3 IN HEX
         SPACE
*        USES AND RESTORES REGS 0-4.
*        USES 8 WORD AREA AT 'HPR' FOR STORAGE
         SPACE
HPRINT   ENTER
         LCI      5
         STM,0    HPR
         LI,4     8
HPR2     LI,2     0
         SLD,2    4
         CI,2     9
         BG       %+2
         AI,2     X'39'
         AI,2     X'B7'
         STB,2    0
         SCD,0    8
         BDR,4    HPR2
         LI,3     X'0D'
         LCF      J:JIT
         BCR,8    %+2               NO RET OF IN BATCH
         STB,3    HPR+6
         STW,0    HPR+4
         STW,1    HPR+5
         M:WRITE  M:LL,(BUF,HPR+4),(SIZE,9)
         LCI      5
         LM,0     HPR
         RETURN
HPR      EQU      PLINE+17          WORKING AREA
         TITLE    'READ ONE RECORD VIA KEY'
         SPACE
KEYREAD  ENTER
         LH,2     M:EI
         CI,2     X'20'             ALREADY OPEN
         BAZ      %+2               NO, OPEN IT
         M:CLOSE  M:EI              YES, CLOSE IT
*        MOVE WSN FROM 'KEY' (LJBF) TO LOGKEY AND
*        COMPUTE BYTE COUNT IN TEXTC FORMAT
         SPACE
         LI,X2    0
KR02     LB,R     KEY,X2
         CI,R     X'40'
         BE       KR04
         AI,X2    1
         STB,R    LOGKEY,X2
         B        KR02
KR04     STB,X2   LOGKEY
         SPACE
KR06,,G: M:OPEN   M:EI,(FILE,':RBLOG',':SYS'),(IN),;
                       (ERR,RBERR),(ABN,RBERR),(BUF,RBLOG),;
                       (BTD,0),(INSN,0),(OUTSN,0)
G:ACN1   EQU      G:+4                ACCT# OF :RBLOG FOR GENMD.
KR08     M:READ   M:EI,(SIZE,LOGSIZE*4),(KEY,LOGKEY)
         M:CLOSE  M:EI
         RETURN   2                 ---> NORMAL RETURN FROM KEYREAD.
         SPACE
*        HANDLE I/O ERR-ABN CONDITIONS ON :RBLOG.
RBERR    STW,8    PLINE
         STW,10   PLINE+1
         LB,X2    PLINE+1
         CI,X2    X'43'
         BE       RET               ---> ABN RETURN - NO SUCH KEY.
         CI,X2    X'14'
         BNE      MERC              ---> DIE NOW.
         SLS,10   -17
         CI,10    X'14'**7+X'14'
         BE       KR08              ---> OK; MERELY EXONLY OPN ABN.
         CI,10    X'14'**7+X'01'
         BNE      MERC              ---> DIE NOW.
         M:WAIT   1                 --V  FILE BUSY; WAIT A BIT &
         B        KR06              ---> TRY AGAIN.
MERC     LW,8     PLINE             RESTORE SR1
         LW,10    PLINE+1           RESTORE SR3
         MTW,0    EXITMODE
         BEZ      %+2
         CAL1,9   X'101'            ERROR RETURN
         M:MERC
         END      START

