*DECK REPLDSQ 
          IDENT     REPL$SQ 
          ENTRY     REPL$SQ 
          TITLE     REPL$SQ 
          COMMENT   CRM SQ REPLACE ROUTINE
          LIST      F,X,C 
          SST 
          B1=1
*#
*1CD  REPL$SQ 
*0D   PURPOSE 
*0        REPLACE THE LAST LOGICAL RECORD READ WITH A NEW RECORD OF 
*         EXACTLY THE SAME LENGTH 
*0D   CALL
*0                  REPLACE        FIT,WSA,,EX
*0D   PARAMETERS
*         A0        FIT ADDRESS 
*         B1        1 
*         B6        RETURN ADDRESS
*         WSA       WORKING STORAGE ADDRESS OF NEW RECORD 
*         EX        ADDRESS OF ERROR EXIT 
*0D   ACTION
*         THIS REPLACE ROUTINE BACKS A FILE OVER THE LAST RECORD READ 
*         (GET) AND REPLACES IT WITH THE CONTENTS OF THE WORKING STORAGE
*         AREA.  IT IS RESTRICTED TO FILES THAT RESIDE ON RMS DEVICES,
*         HAVE RT=F OR W, AND BT=C. 
*         THE ROUTINE IS DIVIDED INTO THE FOLLOWING MAJOR PARTS - 
*0        INITIALIZATION- CHECKS FOR VALID RECORD TYPE, DEVICE TYPE 
*                   AND FILE POSITION.
*0        REPO$SQ-  REPOSITIONS THE FILE TO THE START OF THE PRU THAT 
*                   CONTAINS THE OUT POINTER. IF THE OUT POINTER IS ON
*                   A PRU BOUNDARY IT POSITIONS THE FILE TO THAT PRU. 
*                   IF NOT IT READS THE PRU CONTAINING OUT INTO THE 
*                   FIRST OF BUFFER AFTER CALLING A ROUTINE TO SHRINK 
*                   BUFFER TO ONE PRU. IT RETURNS THE DISTANCE FROM 
*                   FIRST TO OUT. 
*0        ADJPTRS-  RESETS BUFFER POINTERS SO THAT BUFFER IS ONLY 1 PRU 
*                   LONG
*0        REPL$P -  DETERMINES NUMBER OF CHARACTERS OF RECORD THAT ARE
*                   IN THIS PRU AND MOVES THEM FROM WSA TO BUFFER.
*                   REWRITES PRU TO FILE. IF ALL OF RECORD MOVED GOS TO 
*                   RSPTRS, ELSE CALLS BK2RD1 TO POSITION FILE BACK 
*                   ONE MORE PRU AND READ IT INTO BUFFER. REPL$P IS 
*                   REPEATED. 
*0        BK2RD1 -  BACKS THE FILE TWO PRUS AND READS ONE INTO THE
*                   BUFFER. CHECKS FOR BOUNDARY CONDITIONS - WHICH IN 
*                   THIS CASE ARE AN ERROR. 
*0        RESTORE-  RESTORE BUFFER TO ORIGINAL LENGTH. IF NECESSARY 
*                   SKIP FILE TO START OF PRU CONTAINING LAST WORD OF 
*                   RECORD REPLACED AND ISSUE A READ. RETURN TO USER
*0D   REGISTERS USED
*0        ALL 
*0D   OTHER CODE REQUIRED 
*0        COMMON    /REPODSQ/, /B2R1DSQ/
*         MACROS-   TXTCRM
*         ROUTINES- 
*0D   NARATIVE DESCRIPTION
*#
 REPL$SQ  TITLE     INITIALIZATION
*#
*0D   INITIALIZATION. 
*         SAVE USERS RETURN ADDRESS 
*         CHECK FOR VALID RT
*#
 #SCO#    MICRO     1,,/0,26D,60D,00D,1,1/  SAVE OUT IN REPLACE 
 SIXTH    DATA      0.16666666666667P48 
 REPL$SQ  CAP.RM    TRANSIENT 
          SAVE
          F.RM      BT,X2,-#CT# 
          SX6       413B
          NZ        X2,=XERR$RM 
          F.RM      RT
          SX2       X1-#FT# 
          ZR        X2,RTOK 
          SX2       X1-#WT# 
          SX6       412B
          NZ        X2,=XERR$RM 
 RTOK     BSS       0 
*#
*         CHECK FOR VALID DEVICE TYPE 
*#
          SA1       A0+B1 
          SX6       406B
          NG        X1,=XERR$RM 
*#
*         CHECK FOR VALID FILE POSITION 
*#
          F.RM      FP,X2,-#EOR#
          SX6       407B
          NZ        X2,=XERR$RM 
*#
*         CHECK FOR LOP=GET 
*#
          F.RM      LOP,X2,-#GE#
          SX6       410B
          NZ        X2,=XERR$RM 
          RCL.RM    A0,AUTO        WAIT FOR I-O TO STOP 
          F.RM      OUT,A3
          SET.RM    SCO,X3         SAVE CONTENTS OF OUT FOR RESTORE 
          SET.RM    SKP            0
* CALL /REPODSQ/
*CALL /REPODSQ/ 
          NZ        B2,DSBOK
          SB2       100B           SET OUT OFFSET TO INDICATE FULL PRU
 DSBOK    BSS       0 
* 
*         REPODSQ SETS PAE AS NEEDED BY SKBLDSQ,
*         BUT REPL$SQ HAS ALREADY VERIFIED THAT IT IS AFTER 
*         A VALID RECORD - NOT A BOUNDARY CONDITION.
*         THEREFORE, FORCE PAE TO OFF.
* 
          SET.RM    PAE,0          SET FLAG TO BEFORE BOUNDARY
          SET.RM    DSB,B2
          SB2       X3             SET BACK TO OFFSET FOR BK2RD1
          F.RM      RT
          F.RM      FL,4,X0        FOR RT=F USE FL FOR LENGTH 
          SX1       X1-#FT# 
          F.RM      BCC,2                                               000650
          SET.RM    UCP,X2,,4      SAVE BCC 
          ZR        X1,REPL$P 
          F.RM      PRL,4,X0       FOR RT=W USE PRL FOR LENGTH
          SX4       10
          IX0       X0*X4          PRL IN CHARACTERS
          ZR        X2,REPL$P                                           000690
          IX4       X4-X2          UNUSED CHARACTERS                    000700
          IX0       X0-X4 
          TITLE     REPL$P
 REPL$P   BSS       0 
          ZR        X3,BK2RD1 
          IX1       X3+X3 
          LX3       3 
          IX5       X3+X1          AVAILABLE WORDS*10 
          ZR        X2,ZBCC        WORD BOUNDARY                        000740
          SX2       X2-10                                               000750
          SET.RM    UCP,0          ZERO BCC                             000760
          IX5       X5+X2          AVAILABLE CHARACTERS (AC)
 ZBCC     BSS       0 
          IX2       X5-X0          AC-RL
          F.RM      RRL 
          IX3       X1-X0          REDUCE BY RL 
          F.RM      RT,4,X6,-#WT# 
          NZ        X6,FT 
          SX3       X3+10          ADD WCW BACK 
 FT       BSS       0 
          PL        X2,USERL
          IX3       X1-X5          REDUCE BY AC 
 USERL    BSS       0 
          SET.RM    RRL,X3
          BX7       X3
          SB5       CR
          EQ        =XCHWR$RM      CONVERT TO WORDS + UBC 
 CR       BSS       0 
          SX3       X7             WORD COUNT NOT YET USED
 .MD      IFNE      #BETA#,0
          F.RM      WSAD,X1,,6
 .MD      ELSE
          F.RM      WSA,X1,,6 
 .MD      ENDIF 
          AX7       18             POSITION BIT COUNT 
          IX1       X1+X3          WSA+RES WORDS = SOURCE ADDRESS 
          SB3       X7
          ZR        X7,SSA         IF UBC ZERO
          SX1       X1-1           BACK OVER PART WORD
          SA3       SIXTH 
          PX7       X7
          FX3       X7*X3 
          UX7       X3             UNUSED CHAR
          SB3       X7-10          - UCP
          SB3       -B3            SET SOURCE BCP 
 SSA      BSS       0 
 .MD      IFNE      #BETA#,0
          F.RM      WSAB,3,X3 
          LX3       21
          BX3       X1+X3          SET SOURCE ADDRESS AND LCM FLAG
 .MD      ELSE
          BX3       X1             SET SOURCE ADDRESS 
 .MD      ENDIF 
          PL        X2,ALLIN       ALL CHAR NEEDED IN THIS PRU
          IX0       X0-X5          RESIDUAL 
          SB4       X5             SET MOVE LENGTH
          F.RM      FIRST,X5       SET DESTINATION ADDRESS
          SB6       BK2RD1
          SB5       B0             SET DESTINATION BCP
          SAVE
          SB6       MOVR
          EQ        =XMOVE$RM 
 MOVR     BSS       0 
          F.RM      SKP 
          NZ        X1,OUTOK       IF NOT FIRST PIECE OUT IS OK 
          F.RM      BCC            PICK UP NUMBER OF CHAR IN OUT
          ZR        X1,OUTOK       IF BCC ZERO
          SX2       6 
          IX1       X1*X2          NUMBER OF BITS IN OUT
          MX2       1 
          SB2       X1-1
          AX2       X2,B2          CREATE MASK FOR DATA 
          F.RM      SCO,3          PICK UP OLD CONTENTS OF OUT
          SA5       X5             PICK UP NEW CONTENTS OF OUT
          BX7       -X2*X3         PRESERVE CHAR OF NEXT RECORD 
          BX1       X2*X5          PRESERVE,CHAR OF THIS RECORD 
          BX7       X1+X7          CREATE NEW OUT 
          SA7       A5             STORE NEW OUT
 OUTOK    BSS       0 
          SX4       B1             SET SKIP COUNT 
          INC.RM    SKP,1          COUNT CALLS TO BK2RD1
          SA3       A0
          SYSY      44B,R,4 
          SX2       214B           SET REWRITE CODE 
          LX3       59-4
          PL        X3,FULL        IF FULL PRU
          SX2       224B           SET REWRITER CODE
 FULL     BSS       0 
          SYSY      X2,R           REWRITE PRU
          RESTORE 
          JP        B6             RETURN 
 ADJPTRS  BSSZ      1 
          SX2       101B
          F.RM      FIRST,X7
          SA7       A1+B1          SET IN TO FIRST
          IX2       X7+X2 
          SA7       A7+B1          SET OUT TO FIRST 
          SET.RM    LIMIT,X2       SET LIMIT TO FIRST +PRU +1 
          EQ        ADJPTRS        RETURN 
* CALL /B2R1DSQ/               /B2R1DSQ/*COMDECK /B2R1DSQ/
*CALL  /B2R1DSQ/
 BK2.JPB6 BSS       0 
          F.RM      IN,X3 
          F.RM      OUT 
          IX3       X3-X1          SET AVAIL WORD COUNT 
          F.RM      UCP,2          PICK UP BCC                          000810
          ZR        B4,REPL$P      GO REPLACE NEXT PIECE
* 
*         NO BOUNDARY SHOULD BE ENCOUNTERED IN REPLACE, 
*         SO IF ONE IS ENCOUNTERED IT IS AN ERROR 
          F.RM      FIRST,4                                             000850
          F.RM      BFS                                                 000860
          SX6       411B                                                000870
          IX4       X4+X1                                               000880
          SET.RM    LIMIT,X4                                            000890
          EQ        =XERR$RM                                            000900
          TITLE     ALLIN 
 ALLIN    BSS       0 
          SET.RM    PIN,X2         SAVE EXCESS FOR W-CONTINUATION       000920
          BX7       X2             AC-RL = EXCESS 
          SB5       CR2 
          BX5       X3             SAVE SOURCE WORD 
          EQ        =XCHWR$RM      CONVERT EXCESS TO WORDS + UBC
 CR2      BSS       0 
          SB5       X7             NO. OF WORDS FIRST TO START OF RECORD
          BX3       X5             RESTORE SOURCE WORD
          F.RM      FIRST,A5,+B5   SET DESTINATION ADDRESS
          AX7       18             POSITION BIT COUNT 
          SB5       X7
          ZR        X7,CX0         IF WORD BOUNDARY 
          SA5       A5-B1          BACK OVER PART WORD
          SA1       SIXTH 
          PX7       X7
          FX1       X1*X7 
          UX7       X1             UNUSED CHARACTERS
          SB5       X7-10          USED CHAR*-1 
          SB5       -B5            SET DESTINATION BCP
 CX0      BSS       0 
          SB4       X0             SET MOVE LENGTH
          SX0       0              RESIDUAL 
          F.RM      RT,X2,-#WT# 
          NZ        X2,MOVE 
          SB4       B4-10          REDUCE MOVE LENGTH BY WCW
          LX5       59-43          X5 CONTAINS WCW - POSITION START BIT 
          PL        X5,CMPLT       THIS CONTROL WORD STARTS RECORD
          AX5       59-43+24-0     POSITION PRL 
          SX0       X5
          SX1       10
          IX0       X0*X1          NEW RESIDUAL CHAR
 CMPLT    BSS       0 
          SA5       A5+B1          MOVE DESTINATION ADDRESS PAST WCW
 MOVE     BSS       0 
          SB6       RESTORE 
          SX5       A5             SOURCE ADDRESS 
          SAVE
          ZR        B4,MOVR        IF ONLY WCW
          SB6       MOVR
          EQ        =XMOVE$RM 
          TITLE     RESTORE 
 RESTORE  BSS       0 
          SX2       B0             ZERO BCC FOR REPL$P                  000940
          F.RM      PIN,X3         PICK UP OFFSET FOR REPL$P            000950
          NZ        X0,REPL$P      IF MORE OF W RECORD IN THIS PRU
          F.RM      FIRST,4 
          F.RM      SKP,B2,-1                                           000990
          EQ        B2,B0,NOREAD                                        001000
 READ     BSS       0                                                   001010
          SET.RM    IN,X4          SET IN AND                           001020
          SA7       A7+B1          OUT TO FIRST                         001030
          SYSY      10B,R          READ ONE PRU                         001040
          SB2       B2-B1                                               001050
          NE        B2,B0,READ     IF MORE TO READ                      001060
 NOREAD   BSS       0 
          F.RM      BFS,3                                               001080
          F.RM      DSB                                                 000970
          F.RM      BCC,5 
          ZR        X5,WB 
          SX1       X1-1
 WB       BSS       0 
          IX2       X4+X3          FIRST + BFS                          001100
          IX6       X4+X1          FIRST + DISPLACEMENT                 001110
          SET.RM    LIMIT,X2       RESET LIMIT                          001120
          SA6       A0+3           RESET;OUT                            001130
          SET.RM    STM,0          CLEAR STM
          RESTORE 
          JP        B6
          END 
