*COMDECK  CCOMRPV                  COMPILE TIME REPRIEVE PROCESSOR. 
          CTEXT  CCOMRPV - COMPILE TIME REPRIEVE PROCESSOR. 
 RPV=     SPACE  4,10 
          IF     -DEF,QUAL$,1 
          QUAL   CCOMRPV
 RPV=     SPACE  4,10 
**        RPV= - REPRIEVE PROCESSOR.
* 
*         IF THE PROGRAM IS INTERRUPTED BY THE SYSTEM, *RPV=* GAINS 
*         CONTROL TO ISSUE DAYFILE MESSAGES THAT IDENTIFY THE PROGRAM 
*         UNIT BEING COMPILED AND WHERE THE ERROR OCCURED.  A USER
*         ROUTINE IS CALLED FOR POST PROCESSING AND ALL FILES IN AN 
*         OUTPUT MODE ARE FLUSHED.  FINALLY, THE ORIGINAL ERROR 
*         CONDITION IS RESTORED TO PERMIT NORMAL *EXIT* 
*         CONDITION PROCESSING. 
* 
*         ENTRY  (RPV=CLN) = CURRENT LINE NUMBER IN BINARY
*                            IF DEF, LINE NUMBER MESSAGE ISSUED 
*                (RPV=FVT) = FIRST ENTRY OF A FILE VECTOR --
*                            42/0LLFN, 18/FET ADDRESS 
*                            TERMINATED BY A -1 WORD
*                            IF DEF, OUTPUT FILES ARE FLUSHED 
*                (RPV=LOL) = LAST OVERLAY LOADED
*                            6/PRIMARY,6/SECONDARY,48/UNUSED
*                            IF DEF, OVERLAY LOADED MESSAGE ISSUED
*                (RPV=MSG) = IF DEF AND .NE. 0, FIRST WORD OF DAYFILE 
*                             MESSAGE (=C FORMAT) TO BE ISSUED BY RPV=. 
*                (RPV=RNA) = FIRST WORD OF A ROUTINE NAME/ADDRESS TABLE 
*                            BLOCKS OF THE FORM --
*                            42/0LNAME, 18/FWA
*                            ENDED BY - 
*                            1/1,41/UNUSED,18/NEXT BLOCK FWA OR ZERO IF 
*                              LAST BLOCK.
*                            IF -DEF, ABS ADDRESS IS USED.
*                (RPV=URP) = ADDRESS OF USER REPRIEVE PROCESSING, 
*                            42/0,18/ADDRESS TO RJ TO 
* 
*                CP#RM = 0 FOR DIRECT CIO, 7 FOR SCOPE 2 RECORD MANGLER 
*                .OS = 1 FOR NOS, 2 FOR SCOPE 2, 3 FOR NOS/BE 
* 
*         EXIT   MESSAGES POSTED AND BUFFERS FLUSHED.  REINSTATES THE 
*                ERROR CONDITION AND RETURNS CONTROL TO THE OPERATING 
*                SYSTEM.
* 
*         CALLS  CDD, CIO=, COD, FRA=, MSG=, SYS=, WNB= 
  
  
 RPV=     BSS    0           SYSTEM ENTRY AT THIS ADDRESS + 21B 
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
 XJP      VFD    12/0,18/LWARPV,30/0
 #OS      ELSE
 XJP      VFD    12/0,18/LWARPV,6/0,24/77770014B
 #OS      ENDIF 
  
          BSSZ   16          EXCHANGE PACKAGE AND RA+1
 RPV=     SPACE  4,10 
**        RPV - REPRIEVE PROCESSOR SYSTEM ENTRY POINT.
* 
*         ENTRY  (XJP TO XJP+15) = EXCHANGE PACKAGE AT TIME OF ERROR
*                (XJP+16) = CONTENTS OF RA+1 AT THE TIME OF THE ERROR 
  
 RPV      SB1    1           SYSTEM RPV ENTRY 
  
*         SAVE CONTENTS OF ENTRY POINTS THAT *RPV=* WILL USE. 
  
          SA1    =XCDD
          SA2    =XCOD
          BX6    X1 
          LX7    X2 
          SA6    RPVE 
          SA7    A6+1 
  
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
          SA1    =XSYS= 
          SA2    =XWNB= 
          SA3    =XMSG= 
          BX6    X1 
          LX7    X2 
          SA6    A7+B1
          SA7    A6+B1
          BX6    X3 
          SA6    A7+B1
  
 #RM      IFEQ   CP#RM,0     IF DIRECT CIO I/O
          SA1    =XCIO= 
          BX6    X1 
          SA6    A6+B1
 #RM      ENDIF 
 #OS      ENDIF 
  
  
*         EXTRACT ERROR ADDRESS.
  
          SA5    XJP
          MX0    -17
          LX5    24 
          BX1    -X0*X5      EXTRACT P REGISTER 
          SB2    X1 
          GT     B2,B1,RPV2  IF P-REGISTER NOT CLEARED
          SA5    0+ 
          LX5    59-47+18 
          BX1    -X0*X5      EXTRACT P FROM RA+0
 RPV2     BSS    0
  
  
*         DETERMINE ROUTINE RELATIVE ADDRESS, IF *RNA* TABLE EXISTS.
  
 #RPV=    IF DEF,RPV=RNA
          SB7    RPV3        (B7) = RETURN ADDRESS
          EQ     FRA=        FIND RELATIVE ADDRESS
  
 RPV3     NZ     X7,RPV3A    IF RELATIVE
          MX0    42 
          BX6    X0*X4
 RPV3A    SA6    RPVC+1 
          SA7    A6+1 
  
*         CONVERT ABS ADDRESS IF NO *RNA* TABLE.
  
 #RPV=    ELSE
          RJ     =XCOD       CONVERT OCTAL DIGITS 
          MX0    42 
          BX6    X0*X4       ADD ZERO BYTE TERMINATOR 
          SA6    RPVC+1 
 #RPV=    ENDIF 
  
*         DETERMINE LAST OVERLAY LOADED.
  
 #RPV=    IF     DEF,RPV=LOL
          SA1    RPV=LOL     (X1) = LAST OVERLAY 6/PRI,6/SEC,48/UNUSED
          MX0    -6 
          LX1    6
          BX6    -X0*X1      PRIMARY LEVEL
          LX1    6
          BX7    -X0*X1      SECONDARY LEVEL
          LX6    12 
          SB2    X7          (B2) = SECONDARY OVERLAY LEVEL NUMBER
          BX7    X6+X7
          SA2    RPVD+2      * - (0,0)  * 
          LX7    18 
          IX6    X2+X7
          SA6    A2+
 #RPV=    ENDIF 
  
*         DETERMINE LAST SOURCE STATEMENT PROCESSED.
  
 #RPV=    IF     DEF,RPV=CLN
          SA1    RPV=CLN     CURRENT LINE NUMBER
          BX2    X1 
          AX2    59 
          BX1    -X2*X1      INSURE POSITIVE NUMBER 
          RJ     =XCDD       CONVERT DECIMAL DIGITS 
          MX0    48 
          BX6    X0*X4       CREATE 12-BIT ZERO BYTE MSG TERMINATOR 
          SA6    RPVB+3      LINE NUMBER TO MESSAGE TEXT
 #RPV=    ENDIF 
  
*         ISSUE THE DAYFILE MESSAGES. 
  
          IF     DEF,RPV=MSG,1
          MESSAGE  RPV=MSG,,RCL    *COMPILING NAME* 
  
          IF     DEF,RPV=CLN,1
          MESSAGE   RPVB,,RCL      * LAST STATEMENT BEGAN AT LINE NNNN* 
  
          MESSAGE   RPVC,,RCL      * ERROR AT XXXXXX IN YYYYYYY*
  
          IF     DEF,RPV=LOL,1
          MESSAGE   RPVD,,RCL      * LAST OVERLAY LOADED - (P,S)* 
  
*         CALL USER REPRIEVE PROCESSOR. 
  
 #RPV=    IF     DEF,RPV=URP
          SA1    RPV=URP     USER REPRIEVE PROCESSOR
          ZR     X1,RPV4     IF NO USER ROUTINE SPECIFIED 
  
          MX0    43 
          BX3    X0*X1
          NZ     X3,RPV4     IF BAD ADDRESS 
  
          SX2    RPV4 
          SB7    X1 
          LX2    32 
          MI     B7,RPV4     IF BAD ADDRESS 
  
          PX6    X2 
          LX6    -2          (X6) = *EQ RPV4* 
          SA6    B7          STORE FOR USER PROCESSOR RETURN
          JP     B7+1        CALL USER PROCESSOR... 
 RPV4     BSS    0           ...RETURN FROM USER PROCESSOR
 #RPV=    ENDIF 
  
*         FLUSH FILE I/O BUFFERS (DIRECT CIO I/O ONLY). 
  
 #RPV=    IF     DEF,RPV=FVT IF FILE VECTOR TABLE EXISTS
 #RM      IFEQ   CP#RM,0     IF DIRECT CIO I/O
          SA0    RPV=FVT
          SB7    +
 RPV5     SA2    A0+B7       (X2) = NEXT FILE FET ADDRESS 
          SB6    X2+B1
          ZR     B6,RPV7     IF END OF TABLE
          ZR     X2,RPV6     IF FILE DESELECTED BY CONTROL CARD OPTION
          SA1    X2          (X1) = FET WORD 1
          MX0    -6 
          SX6    B1 
          BX7    X1+X6
          SA3    RPVA        (X3) = SHIFT TEST MASK FOR CIO CODE
          AX1    2
          BX0    -X0*X1      EXTRACT CIO CODE 
          SB2    X0 
          LX3    B2 
          PL     X3,RPV6     IF LAST CIO OP NOT OPEN OR WRITE 
          SA7    A1          INSURE CIO COMPLETE BIT IS ON
          WRITER A1,,RCL     FLUSH BUFFER 
 RPV6     SB7    B7+1 
          EQ     RPV5        CHECK NEXT ENTRY 
 RPV7     BSS    0
 #RM      ENDIF 
 #RPV=    ENDIF 
  
*         RESTORE SAVED ENTRY POINT CONTENTS. 
  
          SA1    RPVE 
          SA2    A1+1 
          BX6    X1 
          LX7    X2 
          SA6    =XCDD
          SA7    =XCOD
  
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
          SA1    A2+B1       SYS= 
          SA2    A1+B1       WNB= 
          BX6    X1 
          LX7    X2 
          SA1    A2+1        MSG= 
          SA6    =XSYS= 
          SA7    =XWNB= 
          BX7    X1 
          SA7    =XMSG= 
  
 #RM      IFEQ   CP#RM,0     IF DIRECT CIO I/O
          SA1    A2+B1
          BX6    X1 
          SA6    =XCIO= 
 #RM      ENDIF 
 #OS      ENDIF 
  
*         REINSTATE THE ERROR CONDITON. 
  
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
          SA1    RPVF        RPV RESET WORD 
          BX6    X1 
 +        SA1    RA.MTR 
          NZ     X1,*        WAIT FOR ALL CLEAR 
          SA6    A1          REQUEST RPV RESET
 +        EQ     *           WAIT FOR OP SYS TO PICK UP ERROR 
  
 #OS      ELSE
 .TEST    IFEQ   TEST,ON,2
          SA1    XJP         EXCHANGE JUMP PACKAGE
          RJ     =XDXP=      DUMP EXCHANGE PACKAGE
          ABORT              *** TEMPORARY UNTIL SCOPE 2.0 REPRIEVE 
*                            *** RESET METHOD IS AVAILABLE. 
 #OS      ENDIF 
  
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
 RPVA     BSS    0
          ECHO   2,CIOCODE=(4B,14B,104B,120B,144B,160B) 
          POS    60-CIOCODE_S-2 
          VFD    1/1
          POS    0
          BSS    0
 #OS      ENDIF 
  
          IF     DEF,RPV=CLN,1
 RPVB     DIS    ,* LAST STATEMENT BEGAN AT LINE ........*
  
 RPVC     DIS    ,* ERROR AT 000000 IN XXXXXXX* 
  
          IF     DEF,RPV=LOL,1
 RPVD     DIS    ,* LAST OVERLAY LOADED - (0,0)*
  
 RPVE     BSSZ   2           TO SAVE (CDD) AND (COD)
  
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
          BSSZ   3           TO SAVE (SYS=), (WNB=) AND (MSG=)
  
 #RM      IFEQ   CP#RM,0     IF DIRECT CIO I/O
          BSSZ   1           TO SAVE (CIO=) 
 #RM      ENDIF 
 RPVF     VFD    18/3RRPV,6/0,1/1,35/0    RPV RESET REQUEST WORD
 #OS      ENDIF 
 FRA      SPACE  4,8
**        FRA - FIND RELATIVE ADDRESS.
* 
*                GIVEN AN ABSOLUTE ADDRESS, *FRA=* FINDS THE ROUTINE
*         NAME AND ABSOLUTE ADDRESS BY SEARCHING THE TABLES INSTALLED 
*         ORIGINALLY FOR *RPV=* PROCESSING. 
* 
*                *FRA* DOES NOT USE A RETURN JUMP CALLING SEQUENCE
*         BECAUSE IT IS LOCATED IN CODE SPACE CHECKSUMMED BY *RPV=*.
* 
* 
*         ENTRY  (X1) = ADDRESS RELATIVE TO RA+0
*                (B7) = EXIT ADDRESS
* 
*         EXIT   TO (B7), WITH ...
*                (A1,X1) = ADDRESS,CONTENTS OF RPV=RNA ENTRY
*                (X4) = ABSOLUTE ADDRESS, H FORMAT
*                (X6) = ABSOLUTE ADDRESS, DPC, *NNNNNN IN * 
*                (X7) = ROUTINE NAME, DPC, L FORMAT 
* 
*         USES   X - 1, 2, 3, 4, 6, 7 
*                A - 2, 4 
*                B - 2, 3, 4, 5 
* 
*         CANNOT DESTROY  B1  X0,5  A0,5,6,7
* 
*         CALLS  COD
  
  
 #RPV=    IF     DEF,RPV=RNA IF ROUTINE NAME ADDRESS TABLE EXISTS 
 FRA=     BSS    0           ...ENTRY 
          SA2    RPV=RNA     (X2) = FWA OF 1ST RNA TABLE
          SB2    X1          (B2) = ADDRESS RELATIVE TO RA+0
          SA2    X2          (A2,X2) = A+C OF 1ST ENTRY IN RNA TABLE
          SB3    X2 
          SB4    B0 
          SB5    A2+
  
*         SEARCH ROUTINE NAME ADDRESS TABLE.
  
 FRA2     BSS 
          ZR     X2,FRA3     IF END OF BLOCK
          SB3    X2 
          SA2    A2+B1       (X2) = NEXT TABLE ENTRY
          GT     B3,B2,FRA2  IF CURRENT ENTRY BEYOND ABS ADDR 
          GE     B4,B3,FRA2  IF CURRENT NOT CLOSER
          SB5    A2-B1       CLOSEST SO FAR 
          SB4    B3 
          EQ     FRA2        KEEP LOOKING 
  
*         CHECK FOR TABLE CONTINUATION LINK.
  
 FRA3     BSS 
          SA2    A2+B1       END OF TABLE/TABLE LINK WORD 
          ZR     X2,FRA4     IF END OF TABLE
          SA2    X2          (A2,X2) = A+C OF 1ST WORD IN NEXT BLOCK
          EQ     FRA2        CONTINUE TABLE SEARCH... 
  
*         EXTRACT ROUTINE NAME AND FORMAT ABSOLUTE ADDRESS. 
  
 FRA4     BSS 
          SX1    B2-B4       (X1) = BIN ADDR, RELATIVE TO CLOSEST FIND
          RJ     =XCOD       CONVERT TO OCTAL DISPLAY CODE
          SA1    B5          (X1) = 42/0LNAME,18/ADDRESS
          MX7    42 
          SX3    2R  &2RIN
          BX7    X7*X1       (X7) = ROUTINE NAME, 0L FORMAT 
          LX3    6
          BX6    X4-X3       (X6) = RELATIVE ADDRESS, *NNNNNN IN *
          JP     B7          EXIT ... 
 #RPV=    ENDIF 
 RPV      SPACE  4,8
 RPV=     SPACE  4,10 
          BSS    0
 LWARPV   =      *-1         *** END OF CHECKSUMMED REPRIEVE CODE *** 
 RPV=     SPACE  4,10 
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 RPV=     EQU    /CCOMRPV/RPV=
 FRA=     EQU    /CCOMRPV/FRA=
 QUAL$    ENDIF 
 CCOMRPV  ENDX
