*M*      TERR     HANDLES ERROR MESSAGES FOR TEL
         SYSTEM   SIG7FDP
UTSPROC  SET      0
MONPROC  SET      1
BITS     SET      1
         SYSTEM   UTS
         SPACE    3
*        **********
*        *  DEFS  *
*        **********
         DEF      BLDMTEL           CREATES M:TEL DCB
         DEF      FMTELCL           FORCES M:TEL CLOSED
         DEF      KILLMTEL          DELETES M:TEL DCB
         DEF      T%ERR
         DEF      T%ERRTXT          GETS TEXT FROM ERRMSG.:SYS
         DEF      T%WRTERR          WRITES MSG & CLEANS STACK
         DEF      PPASS             PASSWORD VLP IN PLIST
         DEF      PSTAT             STATUS VLP IN PLIST
         SPACE    3
*        **********
*        *  REFS  *
*        **********
         REF      TELSTACK          MSG BUFFER BUILT HERE
         REF      WRITE             FPT FOR M:UC WRITE
         REF      HEX2EBC           CONVERSION ROUTINE
         REF      J:DCBLINK         JIT POINTER TO DCBTAB
         REF      DCBTAB2           2ND DCB TABLE IN SBUF1
         REF      M:TEL             ADDRESS OF DCB IN SBUF1
         REF      M:TELSIZ          SIZE OF M:TEL
         REF      OPENBIT           FCD BIT IN DCB WORD 0
         REF      NAME              FILE NAME VLP CONTROL WORD
         REF      PACC              ACCOUNT VLP CONTROL WORD
         REF      J:JIT             BATCH TEST
         REF      J:CCBUF           PASS ERROR MESSAGE TO CCI
         REF      J:TELFLGS         SET SETERR FLAG FOR CCI
         REF      BLANKBUF          CLEAN J:CCBUF
         PAGE
************************************************************************
*  THESE PROCS ARE USED TO MANIPULATE TEL'S STACK IN SBUF1VPA          *
************************************************************************
*
* PROC TO CHANGE STACK POINTER THE AMOUNT SPECIFIED BY THE 1ST ARGUMENT
* USING THE REGISTER SPECIFIED BY THE 2ND ARGUMENT.
*
BUMP     CNAME
         PROC
LF       LI,AF(2) AF(1)
         MSP,AF(2)  TELSTACK
         PEND
*
* PUSH OR PULL N WORDS SPECIFIED BY 1ST ARGUMENT INTO REGS STARTING
* AT 2ND ARGUMENT.
*
PUSH     CNAME    X'9',X'B'
PULL     CNAME    X'8',X'A'
         PROC
         DO       NUM(AF)=1
LF       GEN,1,7,4,3,17  0,NAME(1),AF(1),0,TELSTACK
         ELSE
         DO       AF(1)=1
LF       GEN,1,7,4,3,17  0,NAME(1),AF(2),0,TELSTACK
         ELSE
         DO       AF(1)=16
LF       LCI      0
         ELSE
LF       LCI      AF(1)
         FIN
         GEN,1,7,4,3,17  0,NAME(2),AF(2),0,TELSTACK
         FIN
         FIN
         PEND
         PAGE
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
MAXMSG   EQU      140               BYTE SIZE OF LONGEST MSG
***
DBUG     SET      0                 NORMAL MODE
***
************************************************************************
*P*      NAME:    T%ERR                                                *
*P*      PURPOSE:                                                      *
*P*               HANDLES ERROR MESSAGES FOR TEL                       *
*P*      DESCRIPTION:                                                  *
*P*               T%ERR CREATES A BUFFER IN TELSTACK AND READS THE FILE*
*P*               'ERRMSG' IN :SYS WITH THE KEY SUPPLIED BY THE CALLER.*
*P*               ON A BAD RETURN FROM THE KEYED READ, THE KEY IS      *
*P*               CONVERTED TO EBCDIC AND PRINTED WITH A DEFAULT MSG.  *
*P*                  THE BLDMTEL & KILLMTEL ROUTINES CREATE &          *
*P*               RELEASE THE M:TEL DCB IN TEL'S CONTEXT PAGE.         *
*P*      REFERENCE:                                                    *
*P*               NONE                                                 *
************************************************************************
         TITLE    'T%ERR  -  ERROR HANDLER FOR TEL'
************************************************************************
*D*      NAME:    BLDMTEL                                              *
*D*      CALL:                                                         *
*D*               BAL,R0   BLDMTEL                                     *
*D*               CALLED ON ENTRY TO TEL AFTER THE CONTEXT PAGE IS     *
*D*               OBTAINED.                                            *
*D*      REGISTERS:                                                    *
*D*               ALL REGISTERS ARE PRESERVED.                         *
*D*      INPUT:                                                        *
*D*               J:DCBLINK - ADDRESS OF CURRENT DCB TABLE             *
*D*      OUTPUT:                                                       *
*D*               M:TEL & DCBTAB2 ARE CREATED AND LINKED THRU          *
*D*               J:DCBLINK TO THE FRONT OF THE CURRENT DCBTAB.        *
*D*      DESCRIPTION:                                                  *
*D*               BLDMTEL SAVES THE CURRENT CONTENTS OF J:DCBLINK &    *
*D*               INSERTS A POINTER TO A 2ND DCBTAB IN TEL'S CONTEXT   *
*D*               PAGE.  THE NEW TABLE IS LINKED TO THE OLD DCBTAB &   *
*D*               CONTAINS A COPY OF THE M:* ENTRY IF ONE WAS PRESENT, *
*D*               FOLLOWED BY THE M:TEL ENTRY WHICH POINTS TO A DCB    *
*D*               IN THE CONTEXT PAGE.                                 *
************************************************************************
BLDMTEL  EQU      %
         PUSH     5,R1              SAVE WORKING REGS
         LW,R1    J:DCBLINK         GET CURRENT DCBLINK
         CI,R1    DCBTAB2           IS M:TEL ALREADY BUILT?
         BE       BLDEXIT           YES, EXIT IMMEDIATELY
         LW,R2    1,R1              GET 1ST DCB NAME
         CW,R2    TM:STAR           IS IT M:* ?
         BNE      NOM:STAR          NOPE
         LCI      2                 MOVE M:* ENTRY...
         LM,R2    1,R1              ...TO ...
         STM,R2   DCBTAB2+1         ...NEW TABLE
         LI,R5    DCBTAB2+3         ADDR OF NEXT ENTRY
         B        %+2
NOM:STAR LI,R5    DCBTAB2+1         ADDR OF 1ST ENTRY (NO M:*)
         LCI      2
         LM,R2    M:TELDATA         GET M:TEL NAME & ADDR
         STM,R2   0,R5                 & STORE IN TABLE
         AI,R5    2                 POINT TO TABLE END.
         STW,R5   DCBTAB2           STORE LINK POINTER
         STW,R1   0,R5              STORE FLINK TO OLD TABLE
*  CLEAR M:TEL TO ZEROES
         LI,R1    0
         LI,R2    -M:TELSIZ
         STW,R1   M:TEL+M:TELSIZ,R2
         BIR,R2   %-1
*
         LI,R1    M:TEL+22          START OF VLP'S
         STW,R1   M:TEL+FLP         INIT FLP
         LI,R1    M:TEL+34          KEY BUFFER ADDRESS
         STW,R1   M:TEL+KBUF        INIT KBUF
         LI,R3    VLPMASK           MASK OUT SIGNIF. BYTE
         LS,R2    NAME              FILE NAME
         STW,R2   M:TEL+22
         LS,R2    PACC              ACCOUNT
         STW,R2   M:TEL+26
         LW,R2    PPASS             PASSWORD
         STW,R2   M:TEL+29
         LW,R2    PSTAT             FILE STATUS
         STW,R2   M:TEL+32
         LI,R1    DCBTAB2           ***SWITCH...
         STW,R1   J:DCBLINK         ...DCBLINK***
BLDEXIT  EQU      %
         PULL     5,R1              RESTORE WORKING REGS
         B        *R0
         PAGE
************************************************************************
*D*      NAME:    KILLMTEL                                             *
*D*      CALL:                                                         *
*D*               BAL,R4   KILLMTEL                                    *
*D*               CALLED BEFORE RELEASING TEL'S PAGE ON EXIT           *
*D*      REGISTERS:                                                    *
*D*               ALL REGISTERS ARE PRESERVED                          *
*D*      INPUT:                                                        *
*D*               J:DCBLINK - JIT POINTER TO FIRST DCBTAB              *
*D*               DCBTAB2 - DCBTAB IN SBUF1 WITH OLD J:DCBLINK         *
*D*      OUTPUT:                                                       *
*D*               J:DCBLINK IS SET TO IT'S ORIGINAL VALUE              *
*D*      DESCRIPTION:                                                  *
*D*               CLOSES M:TEL IF OPEN & THEN RESTORES OLD J:DCBLINK   *
*D*               FROM DCBTAB2 FLINK.                                  *
************************************************************************
KILLMTEL EQU      %
         PUSH     4,R1
         LI,R1    DCBTAB2           IF JIT DOESN'T POINT...
         CW,R1    J:DCBLINK         ...TO OUR DCB, EXIT...
         BNE      KILLEXIT          ...SINCE OUR DCB DOESN'T EXIST
*
         BAL,R4   FMTELCL           CLOSE M:TEL IF OPEN
         LW,R1    *DCBTAB2          GET OLD J:DCBLINK...
         STW,R1   J:DCBLINK         ...& RESTORE IT
KILLEXIT EQU      %
         PULL     4,R1
         B        0,R4              RETURN
         PAGE
************************************************************************
*D*      NAME:    T%ERR                                                *
*D*      ENTRY:   T%ERRTEXT - SPECIAL ENTRY TO GET BUFFER, READ, AND   *
*D*                          SET UP REGISTERS FOR PRINTING MESSAGE     *
*D*      CALL:                                                         *
*D*               BAL,R0   T%ERR                                       *
*D*               BAL,SR4  T%ERRTXT                                    *
*D*      REGISTERS:                                                    *
*D*               NO REGISTERS ARE SAVED.                              *
*D*      INPUT:                                                        *
*D*               R0 - LINK                                            *
*D*               D1 - GROUP, ERROR CODE & SUBCODE                     *
*D*      OUTPUT:  (FROM T%ERRTXT)                                      *
*D*               R1 - ADDRESS OF ERROR MSG (IN TELSTACK)              *
*D*               R2 - BYTE SIZE OF ERROR MSG                          *
*D*               COND. CODES - 0 IF ERRMSG RECORD FOUND               *
*D*                           - 1 IF DEFAULT MSG BUILT                 *
*D*      SCRATCH:                                                      *
*D*               R3,R4,D1,D2,SR2,SR4                                  *
*D*      INTERFACE:                                                    *
*D*               HEX2EBC - TO CONVERT KEY TO EBCDIC FOR DEFAULT MSG   *
*D*               WRITE - EXTERNAL FPT USED TO WRITE THRU M:UC         *
*D*      DESCRIPTION:                                                  *
*D*               T%ERR CALLS T%ERRTXT TO DO THE WORK.                 *
*D*               T%ERRTXT RETURNS WITH THE MSG IN TELSTACK. IT        *
*D*               MAY BE CALLED EXTERNALLY TO ALLOW THE MSG TO BE      *
*D*               MODIFIED BEFORE PRINTING. IN THIS CASE, THE CALLER   *
*D*               MUST RETORE THE BUFFER TO TELSTACK.  OTHERWISE, THE  *
*D*               INTERNAL ROUTINE T%WRTERR DOES THE WRITE AND         *
*D*               CLEANUP.                                             *
************************************************************************
         PAGE
T%ERR    EQU      %
         BAL,SR4  T%ERRTXT          GET THE ERROR MSG
T%WRTERR EQU      %
         LC       J:JIT
         BCS,8    T%WRTER1          ONLINE
         PUSH     3,R0
         LI,R1    J:CCBUF
         LI,R2    80
         BAL,R4   BLANKBUF
         PULL     2,D1              GET BUFFER ADDRESS - BYTE COUNT
         PULL     R0
         CI,D2    79
         BLE      %+2               79 BYTE MAX
         LI,D2    79
         LW,R3    D2                INDEX REGISTER
         AI,R3    -1
         LB,R3    *D1,R3            SEE IF CR ON RECORD
         CI,R3    X'0D'
         BNE      %+2               NOPE -
         AI,D2    -1                YES - DONT PRINT IT IN BATCH
         SCS,D2   -8                PUT COUNT IN TOP BYTE
         AI,D2    BA(J:CCBUF)+1     DESTINATION
         SLS,D1   2                 MAKE SOURCE ADDRESS BYTE ADDRESS
         MBS,D1   0
         LW,R3    Y8                SET SETERR BIT
         STS,R3   J:TELFLGS
         B        T%WRTER2
T%WRTER1 CAL1,1   WRITE
T%WRTER2 BUMP     -(MAXMSG**-2),R4
         B        *R0               RETURN
T%ERRTXT EQU      %
         LW,R1    TELSTACK          GET TOP OF STACK
         AI,R1    1                    +1 = BUFFER ADDR
         BUMP     MAXMSG**-2,R4     CREATE THE BUFR IN TEL'S STACK
         LCI      3                 MOVE DEFAULT
         LM,R2    DFLTMSG              MSG TO BUFR
         STM,R2   0,R1                 IN CASE OF BAD READ
         BAL,R4   FMTELCL           FORCE M:TEL CLOSED
         CAL1,1   OPN               OPEN ERRMSG FILE
         LI,R3    3                 TXTC FOR KEY & DISP TO KEYBUF
         STB,R3   D1                MAKE KEY TEXTC
         AW,R3    R1                COMPUTE KEYBUF
         STW,D1   0,R3                 & STORE THE KEY
         CAL1,1   READ              READ THE RECORD
         LH,R2    M:TEL+ARS         GET ARS FIELD
         SLS,R2   -1                   AND RIGHT JUSTIFY
         CAL1,1   CLOSMTEL          CLOSE M:TEL
         LCI      0                 INDICATE MSG FOUND
         B        *SR4              RETURN
*
*  ANY ERROR CONDITION ON OPEN OR READ IS HANDLED HERE
*
OPNERR   EQU      %
OPNABN   EQU      %
READERR  EQU      %
READABN  EQU      %
         LW,SR2   D1                GET ERROR CODE KEY
         AND,SR2  M24               MASK OFF COUNT
         PUSH     SR4
         BAL,SR4  HEX2EBC           CONVERT TO EBCDIC
         PULL     SR4
         STW,D1   3,R1              STORE TEXT IN
         STW,D2   4,R1                 DEFAULT MSG
         LI,R2    DFLTSIZ           DUMMY ARS TO TYPE MSG
         BAL,R4   FMTELCL           FORCE M:TEL CLOSED IF OPEN
         LCI      1                 INDICATE DUMMY MSG
         B        *SR4              RETURN
************************************************************************
*D*      NAME:    FMTELCL                                              *
*D*      CALL:                                                         *
*D*               BAL,R4   FMTELCL                                     *
*D*      REGISTERS:                                                    *
*D*               REGISTERS USED ARE SAVED                             *
*D*      INPUT:                                                        *
*D*               M:TEL DCB                                            *
*D*      OUTPUT:                                                       *
*D*               M:TEL IS FORCED CLOSED                               *
*D*      SCRATCH:                                                      *
*D*               M:TEL - ABA & ERA ARE CLOBBERED                      *
*D*      DESCRIPTION:                                                  *
*D*               CHECKS IF M:TEL IS OPEN. IF IT IS, ABA & ERA         *
*D*               ARE CHANGED TO POINT TO OUR EXIT (IN CASE OF         *
*D*               TROUBLE) & M:TEL IS CLOSED WITH SAVE.                *
************************************************************************
FMTELCL  EQU      %
         PUSH     R3
         LW,R3    M:TEL             GET WORD 0
         CW,R3    OPENBIT           IS M:TEL OPEN?
         BAZ      FMTELX2           NO, RETURN
         LI,R3    FMTELX            SET ERA & ABA
         STW,R3   M:TEL+3
         STW,R3   M:TEL+4
         CAL1,1   CLOSMTEL          DO THE CLOSE
FMTELX   LI,R3    0                 CLEAN UP DCB
         STW,R3   M:TEL+3
         STW,R3   M:TEL+4
FMTELX2  EQU      %
         PULL     R3
         B        0,R4              RETURN
         PAGE
*
*        FPT TO OPEN ERRMSG.:SYS
*
OPN      GEN,8,24   X'14',M:TEL
         DATA     X'C7480001'
         DATA     OPNERR            ERROR
         DATA     OPNABN            ABN
         DATA     2                 KEYED
         DATA     2                 DIRECT
         DATA     1                 IN
         DATA     2                 SAVE
         DATA     4                 KEYMAX
         DO       DBUG              ***DEBUG MODE***
         DATA     X'01010202'       FILE NAME, LAST FOR DBUG
         ELSE                       ***NORMAL MODE***
         DATA     X'01000202'       FILE NAME VLP
         FIN
         TEXTC    'ERRMSG'
         DATA     X'02010202'       ACCOUNT VLP
         TEXT     ':SYS    '
*
*        FPT TO READ ERRMSG
*
READ     GEN,8,24   X'10',M:TEL
         DATA     X'F8000000'
         DATA     READERR           ERROR
         DATA     READABN           ABNORMAL
         PZE      *R1               BUFR ADDRESS
         DATA     MAXMSG            SIZE
         PZE      *R3               KEY ADDRESS
*
*  FPT TO CLOSE M:TEL
*
CLOSMTEL GEN,8,24   X'15',M:TEL
         PZE      *0
         DATA     2                 SAVE
*
*  THE FOLLOWING MESSAGE WILL BE PRINTED IF WE CAN'T GET ONE
*  FROM ERRMSG
DFLTMSG  TEXT     'ERROR, CODE=' XXXXXXXX
DFLTSIZ  EQU      (2+(%-DFLTMSG))**2   BYTE SIZE OF DEFAULT MSG
*
*  MISC. DATA
*
TM:STAR  TEXTC    'M:*'
M:TELDATA TEXTC   'M:='             SO USER CAN NEVER DO SET
         DATA     M:TEL
VLPMASK  EQU      -X'FF01'          (= X'FFFF00FF')
PPASS    GEN,8,8,8,8 3,0,0,2
PSTAT    GEN,8,8,8,8 X'11',1,1,1
         END

