*DECK     PEM    PRINT ERROR MESSAGES 
          IDENT  PEM
 PEM      SECT   (PRINT ERROR MESSAGES.)
 PEM      SPACE  4,10 
*         IN FEC
          EXT    CHARMAP
  
*         IN FERRS
          EXT    DICT,FILL.,L.FILL
  
*         IN FTN
          EXT    CO.EL,CO.ET,CO.PW,CO.WPL,CO.WPE,CP.ERCT,CP.PW,ENOT=L 
  
*         IN LEX
          EXT    BLL,LDB
  
*         IN PUC
          EXT    ERRORS,ERRTYP,ERR.C,E=TOTAL,LINEBUF,N.ERRT,PASS,PWBUF
          EXT    T.CON,WOF,WOF=ERR,WO.LOS,WO.QC 
  
*         IN UTILITY
          EXT    MVE=,SFN 
*CALL     COMSERR            SYMBOL DEFINITIONS FOR ERROR PROCESSOR 
          TITLE  FORMAT AND PRINT ROUTINES. 
**        ANSI - CHECK ANSI-LISTING FLAG. 
*         ENTRY  (B7) _ ERROR ADDRESS.
*         USES   SAME AS *PWE*. 
*         CALLS  PWE. 
  
  
 ANSI8    RJ     PDM         PRINT ANSI DIAGNOSTIC
  
 ANSI=    SUBR   =           ENTRY/EXIT...
 ANSI.SW  BSSENT 0           FLIP-FLOP FOR *EL=A* OPTION
          EQ     ANSIX       IF OFF 
 -        EQ     ANSI8       IF ON
 MDERR=   SPACE  4,10 
**        MDERR= - CHECK MDERR-LISTING FLAG.
*         ENTRY  (B7) = ERROR ADDRESS.
*         USES   SAME AS *PDM*. 
*         CALLS  PDM. 
  
 MDERR5   RJ     PDM         PRINT MACHINE DEPENDENT DIAGNOSTIC 
  
 MDERR=   SUBR   =           ENTRY/EXIT...
 MDER.SW  BSSENT 0           FLIP-FLOP FOR *MD* OPTION
          EQ     EXIT.       IF OFF 
-         EQ     MDERR5      IF ON
 PEM      SPACE  4,10 
**        PEM -  PRINT ERROR MESSAGES.
* 
*         CALLING CODE FOR DIAGNOSTIC OUTPUT EXPECTS NO TABLE MOVEMENT
*         TO OCCUR IN THIS ROUTINE. 
* 
*         PEM    IF NORMAL ERROR. 
*         PEMS   IF DIAGNOSTIC PRESETS *FILL.N*.
*         PEMV   IF NEEDS FILLER FROM *TB*
* 
*         ENTRY  (B7) _ FWA OF MESSAGE TO BE PRINTED. 
*                IF ENTERED THRU *PEMV*, (B4) _ START OF FILLER.
*                UP TO 10 CHARACTERS WILL BE PUT INTO "FILL.".
*                IF ENTERED THRU *PEMS*, *FILL.N* WORDS WILL BE 
*                FORMATTED FOR ERROR. 
*         EXIT   FWA OF MESSAGE (B7) POINTS TO EXIT ADDRESS 
*                ALL REGISTERS SAVED AND RESTORED 
*         CALLS  WOF
  
  
**        HERE IF DIAGNOSTIC _S TYPE. 
*         *FILL.N* WORDS WILL BE CONVERTED TO PROPER FORM FOR ERROR 
*                SKELETON.
  
 PEMS     BSSENT 0           ...ENTRY 
          RJ     SVR=       SAVE ALL REGS (RJ MUST BE ALONE IN 1ST WORD)
+         MX5    WA.SYML
          SB3    L.FILL 
          MX0    -CHAR
  
 PEMS1    SA1    B3+FILL.-1 
          BX3    X5*X1
          SX4    B0 
          BX2    -X0*X1 
          LX6    X1 
          NZ     X2,PEMS5    IF WORD ALREADY PACKED.
          SX2    65B         FIRST CHARACTER FOR FILL.
          NO
          IX6    X2+X3
          SX4    DT.BIAS+11 
          LX6    60-CHAR
          ZR     X1,PEMS4    IF EMPTY WORD
  
 PEMS3    BX2    -X0*X1 
          AX1    CHAR 
          NZ     X2,PEMS5    IF END 
          SX4    X4-1        UPDATE BIAS
          EQ     PEMS3       LOOP 
  
 PEMS4    SX6    1R 
          SX4    DT.BIAS+1
          LX6    -CHAR
*         EQ     PEMS5
  
*         PUT BIASED WORD BACK INTO FILL. REGION
  
 PEMS5    BX6    X4+X6
          SB3    B3-B1
          SA6    A1          RESET FILL.
          NZ     B3,PEMS1    IF NOT END OF *FILL.S* 
          EQ     PEM1        CONTINUE...
  
  
**        HERE IF DIAGNOSTIC _V TYPE. 
*         NEXT 10 CHARACTERS FROM *TB*, STARTING AT (B4) WILL BE
*         ASSEMBLED INTO *FILL.*
* 
*         NOTE -
*                WORKS ONLY ON A NORMALIZED *TB*
  
 PEMV     BSSENT 0           ...ENTRY 
          RJ     SVR=       SAVE ALL REGS (RJ MUST BE ALONE IN 1ST WORD)
          SA3    B4 
          SB6    9*CHAR 
          MX0    -CHAR
          SB2    DT.BIAS+1
          SB3    X3 
          SX6    65B         FIRST CHARACTER FOR FILL. = _. 
          SA1    B3+CHARMAP 
          BX2    X1 
          BX1    X3 
          ZR     X2,PEMV10   IF O.(VAR,CONS,OCT,HEX,ILL)
          SA4    =0LSTRING
          BX4    X2-X4
          BX1    X2 
          NZ     X4,PEMV10   IF NOT O.(HOLL,CHAR) 
          SA2    T.CON
          LX3    -TB.SHCP 
          MX4    -TB.SHCL 
          BX4    -X4*X3      EXTRACT DPC OF TOKEN 
          SB3    X4 
          SA1    X2+B3       X1 = DPC OF TOKEN
  
 PEMV10   MX2    7*CHAR 
          BX1    X2*X1       X1 = 7 CHARS MAXIMUM 
  
 PEMV20   LX1    CHAR 
          BX2    -X0*X1 
          ZR     X2,PEMV30   IF END OF DPC
          LX6    CHAR 
          BX6    X2+X6
          SB6    B6-CHAR
          =B2    B2+1 
          EQ     PEMV20 
  
 PEMV30   SX0    B2          BIAS ADD-ON
          LX6    B6,X6       LEFT JUSTIFY 
          BX6    X6+X0
          SA6    FILL.       SET FILLER 
          EQ     PEM1 
  
  
**        HERE TO PRINT ALL DIAGNOSTICS.
  
 PEM      BSSENT 0           ...ENTRY 
          RJ     SVR=       SAVE ALL REGS (RJ MUST BE ALONE IN 1ST WORD)
  
 PEM1     SA1    B7 
          SX6    B7 
          SA6    PEMA        SAVE ERROR WORD ADDRESS. 
          LX1    -ER.TYPP 
          =A6    A6+1 
          MX0    -ER.TYPL 
          BX4    -X0*X1      ISOLATE ERROR TYPE ORDINAL 
          SA3    X4+ERRTYP
          SA2    CO.EL
          SB3    X3          ERROR LEVEL OF CURRENT DIAGNOSTIC
          SB2    X2          ERROR LEVEL FOR THE CURRENT COMPILATION
          AX3    18 
          SA1    X3          FETCH TYPE BANNER WORD 
          SB6    ERR.C
          SA4    B6+ERRTYP
          MX0    -18
          BX6    X0*X4       CLEAR OLD ERROR LEVEL
          BX6    X6+X2       INSERT CURRENT VALUE 
          SA6    A4          RESET CONTINUATION ERROR SELECTOR
          SA5    A3+N.ERRT
          =X7    X5+1 
          SX6    B3 
          SA6    UECA        SAVE CURRENT ERROR LEVEL 
          LT     B3,B2,PEM72 IF THIS TYPE NOT SELECTED
          BX6    X1 
          SA7    A5          INCREMENT COUNT OF THIS TYPE 
          SA1    =1H* 
          SA6    LINEBUF
          BX6    X1 
          SA6    A6+B1
          MX6    0
          SA6    A6+B1       POINT TO 1ST WORD FOR ERROR MESSAGE
          SB3    B0          SET TO NO CHARACTERS USED IN WORD
  
*         OUTPUT THE ERROR LINE 
  
          SA1    B7          RELOAD FIRST POINTER WORD
          SX7    N.ER1ST
          SB6    10*CHAR
          LX0    X1 
  
 PEM30    MX4    ER.WORDL 
          SB2    B0 
          BX3    X4*X0       LOAD NEXT POINTER WORD BYTE
          ZR     X3,PEM65    IF ZERO BYTE POINTER 
          LX3    ER.WORDL 
          SA1    X3+DICT-1
          MX3    -CHAR
          BX4    -X3*X1 
          SX4    X4-DT.BIAS  GET CHARACTER COUNT
          PL     X4,PEM35    IF LESS THAN 10 CHARACTERS 
          SX3    X4+DT.BIAS-1R: 
          ZR     X3,PEM33    IF GREATER THAN 10 CHARACTERS
          SX4    10 
          EQ     PEM35       EXACTLY 10 CHARACTERS
  
 PEM33    SB2    B1          FLAG CONTINUED WORD
          SX4    9
  
 PEM35    BX3    X4 
          LX4    2           MULT BY 4
          LX3    1           MULT BY 2
          IX6    X3+X4       NUMBER OF BITS IN DATA 
          SA5    A6 
  
*         PROCESS DATA WORD INTO OUTPUT BUFFER
  
          SB5    B6-B3
          SB7    X6 
          LT     B5,B7,PEM45       IF SPLIT NECESSARY 
  
*         PROCESS DATA WORD ( NO SPLIT NECESSARY )
  
 PEM40    MX4    1
          SB7    B7-B1
          AX6    X4,B7       BUILD MASK FOR DATA WORD 
          BX3    X6*X1       GET DATA WORD ONLY 
          LX5    X5,B3
          SB7    B3+B7
          BX4    -X6*X5      MASK IN PAST PARCEL
          SB3    B7+B1
          BX3    X4+X3       ADD PAST AND PRESENT TOGETHER
          LX6    X3,B5
          ZR     B2,PEM50    ADD BLANK IF END OF WORD 
          SA6    A5 
          EQ     PEM60       CONTINUE.. 
  
*         PROCESS SPLIT WORD
  
 PEM45    MX4    1
          SB3    B3-B1
          LX1    X1,B5
          SB7    B7-B5
          SB5    B6 
          AX3    X4,B3
          BX6    -X3*X1 
          SB3    B0 
          BX3    X3*X5
          SA5    A5+B1
          BX6    X3+X6
          SA6    A6 
          BX5    0           PRESET FOR PROCESSING REMAINDER
          EQ     PEM40       PROCESS REMAINDER
  
*         ADD IN SPACE BETWEEN WORDS
  
 PEM50    SX5    1R 
          SB5    9*CHAR 
          LX5    9*CHAR 
          LE     B3,B5,PEM55 IF ENOUGH ROOM FOR SPACE 
          SA6    A5 
          BX6    X5 
          SB3    CHAR        SET NUMBER OF BITS IN OUTPUT WORD
          SA6    A6+B1       STORE IN OUTPUT BUFFER 
          EQ     PEM60       CONTINUE.. 
  
 PEM55    SB5    B6-B3
          LX4    B5,X5       ADJUST 1R
          IX6    X6+X4
          SA6    A5 
          SB3    B3+CHAR     ADJUST BIT COUNT 
  
 PEM60    LX0    9
          SX7    X7-1 
          NZ     X7,PEM30    LOOP ON PRESENT POINTER WORD 
  
*         CHECK FOR CONTINUATION CARDS
  
          LX0    ER.MOREP 
          PL     X0,PEM65    IF NO CONTINUATION CARDS 
          SA3    PEMA+1 
          SX4    A7 
          =X7    X3+1 
          =A1    X3+1        LOAD NEXT POINTER WORD 
          SA7    A3 
          SA2    X4 
          BX7    X2          RESTORE (A7) 
          SA7    A2 
          SX7    N.ERREST    RESET NUMBER OF BYTES PER WORD 
          BX0    X1 
          EQ     PEM30       PROCESS NTH CARD 
  
*         END OF THIS MESSAGE, PRINT IT.
  
 PEM65    SA1    A6 
          CALL   SFN         SPACE FILL LAST WORD 
          SA6    A1 
          SA5    A1          REMEMBER (A5) = LWA OF DIAGNOSTIC
          =X6    0
          SA6    PEMB 
          SA1    ENOT=L 
          BX6    X1 
          SA6    WOF=ERR     LIST TO E-FILE IF UNIQUE 
          SX6    A5 
          SA6    PEMC        SAVE LWA OF MESSAGE
  
*         LIST THE STATEMENT THAT WAS FOUND TO BE IN ERROR. 
  
 PEM66    SA1    PASS 
          NZ     X1,PEM67    IF NOT FRONT END 
          ERRNZ  PASS=FE
          CALL   LDB         LIST DEFERRED BUFFER 
  
 PEM67    SB2    LINEBUF-1
          SX2    A5-B2
          SA4    WOF=ERR
          SA4    CO.PW+X4 
          SX4    X4-126 
          SX1    B2+B1       FWA OF DIAGNOSTIC
          PL     X4,PEM71    IF NOT PW MODE 
          SA4    WOF=ERR
          SX1    X2-2 
          ZR     X4,PEM68    IF NOT LISTING TO E-FILE 
          BX5    X2          SAVE LENGTH
          MOVE   X1,LINEBUF+2,PWBUF+1  MOVE LINE TO PWBUF 
          BX2    X5          RESTORE FULL LINE LENGTH 
          SB2    PWBUF-2     FWA OF LINE - 2
  
 PEM68    SA1    LINEBUF
          MX0    8*CHAR 
          SX4    2R*
          BX6    X0*X1
          BX7    X4+X6
          =B2    B2+1 
          =A7    B2+1        SHORT SEVERITY HEADER
          SX1    A7 
          =X2    X2-1 
*         EQ     PEM71
          SA4    WOF=ERR
          SA4    CO.WPL+X4   GET WIDTH CONTROL WORD 
          SB3    X2-1 
          SB5    X4          PAGE WIDTH IN WORDS
          SB3    B3-B5
          LE     B3,PEM71    IF LENGTH LESS THAN PAGE WIDTH 
          SB6    B2+X2       LWA = FWA-1+LEN
          SA2    X4+B2
          BX3    X2 
          SB3    -1R
          MX0    9*CHAR 
          SB5    9*CHAR 
  
 PEM69    BX6    -X0*X3 
          SX4    X6+B3
          ZR     X4,PEM70    IF BLANK CHARACTER 
          LX3    B5,X2
          SB5    B5-CHAR
          GE     B5,PEM69    IF STILL MORE CHARACTERS IN WORD 
          SA2    A2-B1
          EQ     PEM69       TRY NEXT WORD BACK 
  
 PEM70    CALL   BLL         BREAK LONG LINE
  
 PEM71    PLINE  X1,X2
          SA4    WO.LOS 
          SA2    ENOT=L 
          SA5    PEMC 
          SA5    X5 
          =X6    0
          SA6    WOF=ERR     LIST TO L-FILE 
          ZR     X2,PEM72    IF NO UNIQUE E-FILE
          ZR     X4,PEM72    IF NOT LISTING SOURCE
          SA4    PEMB 
          MX6    1
          SA6    A4 
          ZR     X4,PEM66    IF FIRST TIME THROUGH
  
*         EXIT. 
  
 PEM72    RJ     UEC         UPDATE ERROR COUNTS
          SA1    PEMA 
          SA2    X1 
          SB7    X2          SET *EXIT* ADDRESS.
          SX6    B7 
          SA6    SV=B+7 
          MI     B7,PDM1     IF *RJ* STYLE ERROR
          RJ     RSR=        RESTORE ALL REGS 
          JP     B7          EXIT 
  
 PEMA     BSS    1           SAVE ERROR WORD ADDRESS
          CON    0
 PEMB     BSS    1
 PEMC     BSS    1
 PDM      SPACE  4,10 
**        PDM - PRINT DIAGNOSTIC MESSAGE
* 
* 
*         ENTRY  (B7) = ADDR OF DIAGNOSTIC TO ISSUE 
* 
*         EXIT   NONE 
* 
*         USES   B7          (ALL OTHER REGISTERS SAVED AND RESTORED) 
* 
*         CALLS  RSR=,SVR=
  
  
 PDM      SUBR   =           ** ENTRY/EXIT ** 
          RJ     SVR=        SAVE ALL REGISTERS 
          SA1    SV=B+7      (X1) = ADDR OF ERR MSG 
          SB7    X1 
          SA2    X1          (X2) = ADDR OF ERROR PROCESSOR 
          SB2    X2 
          JP     B2-4S15+1   BEGIN APPROPRIATE ERROR FORMATTER... 
  
 PDM1     BSS    0           ** RETURN FROM ERROR PROCESSING ** 
          RJ     RSR=        RESTORE ALL REGISTERS
          EQ     EXIT.
 UEC      SPACE  4,10 
**        UEC -  UPDATE ERROR COUNT.
* 
*         ENTRY  (UECA)    = ERROR LEVEL OF CURRENT DIAGNOSTIC
*                (ERRORS)  = COUNT OF PROGRAM UNIT BINARY FATAL ERRORS
*                (E=TOTAL) = COUNT OF STATEMENT BINARY FATAL ERRORS 
*                (CP.ERCT) = COUNT OF ET= ERRORS
* 
*         EXIT   (ERRORS), (E=TOTAL), (CP.ERCT) UPDATED AS RELEVANT 
* 
*         USES   A1,A2,A3,A6,A7  X1,X2,X3,X6,X7 
  
  
 UEC      SUBR               ...ENTRY/EXIT... 
          SA1    UECA 
          SA2    ERRORS 
          SA3    E=TOTAL
          SB2    X1-EL=F
          MI     B2,UEC1     IF DIAGNOSTIC NOT FATAL TO BINARY
          =X6    X2+1 
          =X7    X3+1 
          SA6    A2          UPDATE ERRORS
          SA7    A3          UPDATE E=TOTAL 
          MX6    1
          SA6    WO.QC       GO INTO QUICK CHECK MODE AFTER FATAL ERROR 
  
 UEC1     SA2    CO.ET
          ZR     X2,EXIT.    IF NO ERROR TERMINATION
          IX1    X1-X2
          MI     X1,EXIT.    IF NOT ET=LEVEL OR HIGHER
          =X1    1
          SA2    CP.ERCT
          IX6    X1+X2
          SA6    A2          UPDATE CP.ERCT 
          EQ     EXIT.
  
 UECA     BSS    1           ERROR LEVEL OF CURRENT DIAGNOSTIC
*CALL     COMQSVR 
  
          LIST   D
          END 
