*DECK ERROR 
          IDENT  T8.ERR 
          TITLE  ROUTINES ERROR, ERR.MSG, NXBITS
 ERROR    TITLE  ERROR HANDLER
* 
**    ERROR - SUBROUTINE TO HANDLE ALL ERROR PROCESSING 
* 
*         INPUT  -  B1 = 1
*                   A0 = WSA ADDRESS  (0 IF NONE) 
*                   X2 = VFD 30/TYPE OF ERROR, 30/MESSAGE ADDRESS 
* 
*         OUTPUT -  X5 = 1.0 (ERROR STATUS) 
* 
*         RETURN -  TO THE LOCATION.. (T.ENTRY)+1 
* 
*         PRESERVED  --, --, --, --, --, --, --, -- 
*                    A0, --, --, --, --, --, --, -- 
*                        B1, --, --, --, --, --, -- 
* 
*         NOTES..  FOR EVERY ERROR, A DAYFILE MESSAGE IS PUT OUT. 
* 
*                  IF THE OUTPUT FILE (FIT ENTRY POINT = OUTPUT#) CAN 
*                BE LOCATED, A MESSAGE IS ALSO PLACED IN THAT FILE. 
* 
*                  IF THE CALL APPEARS TO BE FROM FTN OR COBOL, AN
*                APPROPRIATE TRACEBACK IS ATTEMPTED.
* 
          SPACE  1
*CALL COM1
          B1=1
          SST 
          SPACE  4
 ERR.IO   SX7    B1+B1       =2, I/O ERROR
          EQ     ERR.C1 
* 
 ERR.CON  SX7    1           =1, USUAL ENTRY POINT
 ERR.C1   SX6    X2 
          PX7    X7,B0
          SA6    T.EMSG      SAVE MESSAGE ADDRESS 
          SA7    T.STATUS 
          SX6    A0 
          SA6    T.A0 
          AX2    30 
          SA3    X2+ERR.TYP  GET TYPE OF ERROR
          SA4    T.ENTRY
          BX7    X3 
          SA4    X4          ENTRY TRACE WORD 
          SA7    T.TMSG 
          MX0    42 
          SX5    1R-
          SX6    X4          ENTRY POINT ADDRESS
          LX5    12 
          SA6    T.EENT 
          BX4    X0*X4
          IX7    X4+X5
          SA7    T.TRTN      SAVE ROUTINE NAME
* 
          MESSAGE T.TMSG,LOCAL,RECALL 
* 
* LOOK FOR THE OUTPUT FILE.  THIS PROCEEDS AS FOLLOWS.. 
*         1. CALL -GETFIT- TO FIND THE FIT IF IT EXISTS.
*         2. IF THE LAST OPERATION WAS NOT A READ, PUT OUT THE MESSAGE. 
*         3. IF THE MESSAGE CANNOT BE PUT ON THE OUTPUT FILE, PUT IT
*            IN THE DAYFILE ONLY. 
* 
          MX6    1           -VAR- PARAMETER BIT
          SX1    H.ERFIL     LOCATION OF ERROR FILE NAME
          BX1    X1+X6
          RJ     =XUGTFIT.
          SX6    X1 
          SA6    T.FIT       SAVE FIT ADDRESS 
          ZR     X1,ERR.O4   DOES NOT EXIST 
* 
          FETCH   X1,WSA,X6 
          SA6    SWSA        SAVE OLD WSA 
          FETCH   X1,OC,X5
          SX6    X5-#OPE#    SEE IF FILE IS OPEN
          SA6    SOPE        SAVE RESULT
          NZ     X6,ERR.0    BR FILE-NOT-OPEN 
          FETCH   X1,WPN,X5  CHECK LAST OPERATION FOR WRITE 
          NG     X5,ERR.1    YES, WRITTEN 
* 
 ERR.O4   SA2    T.EMSG      CANNOT USE OUTPUT FILE 
          MESSAGE X2,LOCAL,RECALL   PUT INDIVIDUAL ERROR MESSAGE
          EQ     ERR.5
          SPACE  2
* 
* PUT OUT COMMON MESSAGE LINE 
* 
 ERR.0    SA1    T.FIT       OPEN OUTPUT FILE 
          STORE  X1,EX=ERR.DONX 
          SA1    T.FIT
          OPENM  X1,OUTPUT,N
* 
 ERR.1    SA1    T.EMSG 
          MX0    60-6 
          SB2    -B1         COUNT CHARACTERS IN MESSAGE
          SB3    T.MESA 
          SA1    X1 
          EQ     ERR.3
 ERR.2    SA1    A1+B1
          SB3    B3+B1
          SB2    B2+10
 ERR.3    LX7    X1          CHECK FOR ZERO BYTE
          BX2    -X0*X1 
          SA7    B3 
          NZ     X2,ERR.2    JP FULL WORD 
 ERR.4    LX1    6
          BX2    -X0*X1 
          SB2    B2+B1
          NZ     X2,ERR.4    JP NON ZERO CHARACTER
* 
          SA2    T.TRTN 
          SX6    2R 
          SA3    T.TMSG 
          BX6    X2+X6
          LX7    X3 
          SA6    T.RTNA 
          SA7    T.TYPA 
          SA1    T.FIT
          SX3    B2+L.EMESA  LENGTH OF MESSAGE
          PUT    X1,M.EMESA,X3,ERR.DONX,,,,SQ 
* 
* ANALYZE  TYPE OF CALL FOR TRACEBACK 
* 
 ERR.5    SA1    T.EENT      ENTRY POINT ADDRESS
          ZR     X1,ERR.DONA  DONE (SYMPL FORMAT CALL)
          MX0    30 
          SA1    X1          ENTRY POINT
          BX2    -X0*X1 
          LX1    30 
          NZ     X2,ERR.DONA  NOT ENTERED VIA RJ (FTN MAIN PROGRAM) 
          SA1    X1-1        WORD CONTAINING THE RJ 
          BX2    -X0*X1 
          AX1    60-9        MOVE OP-CODE TO LOW END OF X1
          SX1    X1-010B     CHECK FOR RJ 
          NZ     X1,ERR.9    NOT RJ 
          ZR     X2,ERR.9    YES, RJ. CHECK LOWER HALF FOR TRACEBACK
* 
          SA5    M.LIN       TRACE BACK INFO EXISTS 
          SX3    X2 
          BX7    X5 
          AX2    18 
          SA7    T.LOC1 
          ZR     X2,ERR.7    JP COBOL FORMAT TRACEBACK
* 
* FORTRAN FORMAT TRACEBACK
* 
          SA3    X3 
          SX7    3R 
          MX0    42 
          BX7    -X0*X7 
          SX6    X3 
          BX3    X0*X3
          SA6    T.EENT 
          BX7    X3+X7
          SA7    T.RTNB      ROUTINE NAME 
          SB6    ERR.6
          EQ     ERR.L       CONVERT LINE NUMBER FROM X2
 ERR.6    SA1    T.FIT
          ZR     X1,ERR.61
          PUT    X1,M.EMESB,L.EMESB,,,,,SQ
          EQ     ERR.5
* 
 ERR.61   MESSAGE M.EMESB,LOCAL,RECALL
          EQ     ERR.5
* 
* COBOL FORMAT TRACEBACK
* 
 ERR.7    SA5    M.COB
          SX2    X3 
          BX7    X5 
          SB6    ERR.8
          SA7    T.RTNB      ROUTINE NAME 
          EQ     ERR.L       CONVERT LINE NUMBER FROM X2
 ERR.8    SA1    T.FIT
          ZR     X1,ERR.11
          PUT    X1,M.EMESB,L.EMESB,,,,,SQ
          EQ     ERR.DONA 
* 
* NO TRACEBACK
* 
 ERR.9    SA5    M.LOC
          SA4    M.ZRO
          MX0    60-3 
          SX3    A1          CALLING ADDRESS
          BX7    X5 
          LX3    60-18
          SA7    T.RTNB 
          SB2    5
 ERR.10   LX3    3           CONVERT OCTAL TO DISPLAY 
          SX2    X3 
          LX4    6
          BX3    X0*X3
          IX4    X2+X4
          SB2    B2-B1
          PL     B2,ERR.10
          SA1    T.FIT
          BX7    X4 
          LX7    60-36
          SA7    T.LOC1 
          ZR     X1,ERR.11
          PUT    X1,M.EMESB,L.EMESC,,,,,SQ
          EQ     ERR.DONA 
* 
 ERR.11   MESSAGE M.EMESB,LOCAL,RECALL
          EQ     ERR.DON
* 
* COMMON CODE TO CONVERT LINE NUMBER FROM X2
* 
 ERR.L    NG     X2,ERR.9    JP BAD FORMAT OF LINE NUMBER 
          SA5    M.ZRO
          IX3    X2/X1,10    GET LOW DIGIT
          LX5    6*6
          IX4    X3+X3       *2 
          LX3    3           *8 
          IX2    X2-X4
          IX2    X2-X3       REMAINDER IN X2
          AX3    3
          SB2    5
          EQ     ERR.L3      FIRST DIGIT
* 
 ERR.L1   LX5    60-6 
          ZR     X3,ERR.L2
          BX2    X3 
          IX3    X2/X1,10    GET NEXT DIGIT 
          IX4    X3+X3       *2 
          LX3    3           *8 
          IX2    X2-X4
          IX2    X2-X3
          AX3    3
          EQ     ERR.L3 
 ERR.L2   SX2    55B-1R0     CONVERT TO LEADING BLANK 
 ERR.L3   IX5    X5+X2
          SB2    B2-B1
          PL     B2,ERR.L1   GET ANOTHER
* 
          LX5    60-6        SAVE RESULT
          BX7    X5 
          SA7    T.LOC2 
          JP     B6          EXIT 
* 
* 
* DONE
* 
 ERR.DONX PS     0           ERROR EXIT 
          SA1    T.FIT
          STORE  X1,EX=ERR.EXR   RESET ERROR EXIT ADDRESS 
          EQ     ERR.O4      PUT MESSAGE ON DAYFILE 
* 
 ERR.DONA SA1    T.FIT
          STORE  X1,EX=ERR.EXR   RESET ERROR EXIT ADDRESS 
 ERR.DON  SA1    T.FIT
          ZR     X1,ERR.DON1
          SA2    SWSA 
          STORE  X1,WSA=X2
          SA2    SOPE        WAS FILE OPEN
          ZR     X2,ERR.DON1 YES
          CLOSEM X1,N        N
 ERR.DON1 SA2    T.A0 
          SA1    T.ENTRY
          SA5    T.STATUS    ERROR STATUS RETURN
          SB2    X2 
          SB6    X1+B1
          SA0    X2          RESTORE A0 
          JP     B6          EXIT 
  
 SOPE     BSS    1
 SWSA     BSS    1
  
* 
* ERROR EXIT CODE, EXECUTED IF EX NOT RESET BY USER 
* 
 ERR.EXT  VFD    42/7H*ERROR*,18/ERR.EXR
 ERR.EXR  PS     0
          SX6    ERR.EXT     TRACEBACK
          SA6    T.ENTRY
          SA2    ERR.EXM     ERROR MESSAGE
          EQ     ERR.IO 
* 
 ERR.EXM  VFD    12/0,18/E.IO,12/0,18/*+1 
          DATA    C/UNRECOVERABLE ERROR ON =OUTPUT= FILE/ 
 ERR.MSG  TITLE  ERROR MESSAGE AREA 
* 
* ERROR MESSAGE PROTOTYPES
* 
 T.TMSG   DATA   C/ --TYPE--- ERROR DETECTED BY  ROUTINE./
 T.TRTN   EQU    T.TMSG+3 
* 
 M.EMESA  DATA   H/0 ERROR DETECTED BY /
 T.RTNA   DATA   H/ROUTINE.  /
 T.TYPA   DATA   H/ --TYPE---/
 T.MESA   DATA   C/ INDIVIDUAL ERROR MESSAGE GOES HERE.             / 
 L.EMESA  EQU    20+10+10 
* 
 M.EMESB  DATA   H/        CALLED FROM /
 T.RTNB   DATA   H/ROUTINE   /
 T.LOC1   DATA   H/AT LINE   /
 T.LOC2   DATA   C/NNNNNN/
 L.EMESB  EQU    20+10+10+6 
 L.EMESC  EQU    20+10+6
* 
 M.COB    DATA   H/*COBOL*/ 
 M.LOC    DATA   H/LOCATION/
 M.LIN    DATA   H/AT LINE/ 
 M.ZRO    DATA   L/000000/
* 
* MESSAGE TYPES 
* 
*                   E.PAR         E.SCN        E.TST        E.CON 
 ERR.TYP  DATA   H/PARAMETER-/,H/    SCAN-/,H/    TEST-/,H/ CONVERT-/ 
          DATA   H/    I-O -/ 
* 
* OTHER DATA
* 
          VFD    42/0,18/=XT8.GTFT  FORCE LOAD OF GETFIT. IN STATIC MODE
 NXBITS   TITLE  SUBROUTINE NXBITS - RETRIEVE N BITS FROM SOURCE        051050
*                                                                       051060
**    NXBITS - PICK UP THE NEXT N (0 .LE. N .LE. 60) BITS FROM A
*         SOURCE AREA                                                   051080
*                                                                       051090
*         INPUT  -  B1 = 1                                              051100
*                   X1 = SOURCE POINTER                                 051110
*                   X2 = NUMBER OF BITS TO GET                          051120
*                   B6 = RETURN ADDRESS                                 051130
*                                                                       051140
*         OUTPUT -  X6 = BIT FIELD, RIGHT ADJUSTED AND ZERO FILLED      051150
*                   X7 = UPDATED POINTER WORD (ALSO IN X1)              051160
*                   X0 = N-BIT MASK                                     051170
*                   X2=UNCHANGED UNLESS NUM BITS LEFT LT X2 ON INPUT
*                   THEN
*                      X2=NUM BITS LEFT 
*                                                                       051180
*         PRESERVED  --, --, --, --, --, X5, --, --                     051190
*                    A0, A1, A2, --, A4, A5, A6, A7                     051200
*                        B1, --, --, --, B5, B6, B7                     051210
*                                                                       051220
          SPACE  4                                                      051240
 NXBITS   ZR     X2,NXB.Z    ZERO BITS                                  051250
          SB2    X2-1        N-1                                        051260
          SA3    X1          PICK UP FIRST SOURCE WORD                  051270
          AX1    18          USED BIT COUNT                             051280
          SB3    X1                                                     051290
          AX1    18          REMAINING BIT COUNT                        051300
          SB3    -B3         -U                                         051310
          IX7    X1-X2       NEW REMAINING COUNT                        051320
          PL     X7,NXB.1                                               051330
          BX2    X1          OVERFLOW, ADJUST EVERYTHING TO             051340
          SX3    -B3          PICK UP ONLY RESIDUAL BITS                TB8   11
          LX1    18                                                     051360
          SX4    A3                                                     051370
          BX1    X1+X3                                                  051380
          LX1    18                                                     051390
          BX1    X1+X4                                                  051400
          EQ     NXBITS                                                 051410
*                                                                       051420
 NXB.1    SB4    B3+59       60-U-1                                     051430
          AX3    X3,B3       FIRST ACTIVE WORD LEFT ADJUSTED            051440
          MX0    1                                                      051450
          AX0    X0,B4       60-U BIT MASK                              051460
          BX6    X0*X3                                                  051470
          LE     B2,B4,NXB.2 JP IF IT ALL COMES FROM ONE WORD           051480
          SA3    A3+B1                                                  051490
          AX3    X3,B3       SHIFT INTO PLACE 
          BX3    -X0*X3      HIGH ORDER (U) BITS                        051510
          BX6    X3+X6       COMBINE WITH FIRST WORD                    TB8   13
 NXB.2    MX0    1                                                      051530
          SX1    B0-B3       RESTORE OLD USED BIT COUNT (BCP) 
          LX7    18                                                     051540
          IX4    X1+X2       X4 = USED BITS (UPDATED)                   051550
          AX0    X0,B2       N-BIT MASK                                 051560
          SX3    A3          NEW ADDRESS TO USE                         051570
          BX6    X0*X6       RESULT BIT STRING                          051580
          LT     B2,B4,NXB.3 ALL CAME FROM ONE WORD                     051590
          SX4    X4-60       ADJUST FOR SECOND WORD                     051600
          NE     B2,B4,NXB.3 JP IF SECOND WORD USED                     051610
          SX3    X3+1        ADJUST FOR FRESH SECOND WORD               051620
 NXB.3    BX7    X7+X4                                                  051630
          SB2    B2+B1                                                  051640
          LX7    18                                                     051650
          BX7    X7+X3       NEW POINTER WORD                           051660
          LX6    X6,B2                                                  051670
          LX1    X7                                                     051680
          JP     B6          EXIT                                       051690
*                                                                       051700
 NXB.Z    MX0    0           ZERO BITS CASE                             051710
          BX7    X1                                                     051720
          SX6    0                                                      051730
          JP     B6                                                     051740
          END 
