*DECK C$SQWR
          IDENT  C$SQWR 
          TITLE  CBSQWR - SEQUENTIAL WRITE, REWRITE 
  
          MACHINE  ANY,I
          COMMENT  SEQUENTIAL WRITE 
          SST 
          B1=1
          SPACE  4
**        CBSQWR - SEQUENTIAL WRITE, REWRITE
* 
*         CALLING SEQUENCE
*         ALL 
*                SX3  RECORD LENGTH IN CHARACTERS 
 CDCS     IFEQ   OP.DCS,OP.DCS1 
*                SX7  RECORD ORDINAL (IF I/O VIA CDCS)
 CDCS     ENDIF 
*                SB6  RETURN ADDRESS
*                SA0  ADDR OF FIT 
*         WRITE 
*                EQ   C.WRISQ 
*                     LINE NUMBER (LOWER) 
*         REWRITE 
*                EQ   C.REWSQ 
*                     LINE NO (LOWER) 
* 
*         DOES - ROUTES REQUEST TO CRM
*         USES - ALL REGISTERS EXCEPT A0 CHANGED
* 
 STNDRD1  EQU    CS.STND1 
 ASCII    EQU    CS.ASCII 
 EBCDIC   EQU    CS.EBCDC 
 UNIVAC   EQU    8           VALUE OF -UNI- IN -CDST- FIT FIELD 
*CALL IOMICROS
  
*CALL IODEFSC 
          ENTRY  C.REWSQ
 C.REWSQ  BSS    0
          SB5    REPLACE
          FETCH  A0,RT,X4 
          SX5    X4-#FT#
          SX6    X4-#WT#
          ZR     X5,RTOK     JP IF FIXED LEN RECS 
          NZ     X6,RTERR    JP IF NOT F OR W TYPE RECORDS
 RTOK     BSS    0
          FETCH  A0,RL,X4    GET REC LENGTH OF LAST READ
          IX4    X3-X4
          NZ     X4,RLERR    JP IF CURRENT AND LAST LENGTH DIFFER 
          EQ     OUTCOM 
          ENTRY  C.WRISQ
 C.WRISQ  BSS    0
          SB5    PUT
          FETCH  A0,WBAC,X5,,0     GET REMAINING COUNT FROM LAST WBA
          ZR     X5,OUTCOM   JP IF NONE LEFT
          EQ     =XC.WBAXL   ADVANCING PROCESSING, LAST OP WAS WRITE B A
 OUTCOM   BSS    0
 CDCS     IFEQ   OP.DCS,OP.DCS1 
          FETCH  A0,DBFO,X5,,0
          ZR     X5,INIT     JUMP IF I/O NOT VIA CDCS 
          SA7    =XC.RORD    SAVE RECORD ORDINAL
 INIT     BSS    0
 CDCS     ENDIF 
          RJ     =XC.SVRTN   SAVE RETURN
          FETCH  A0,RECA,X2  GET RECORD AREA ADDRESS
 CDCS     IFEQ   OP.DCS,OP.DCS1 
          FETCH  A0,DBFO,X5 
          ZR     X5,WRITE1   JUMP IF NOT A DATABASE FILE
          STORE  A0,WSA=X2
          STORE  A0,RL=X3 
          STORE  A0,EX==XC.EX 
          RJ     =XC.DMWR1   -PUT- VIA CDCS 
          EQ     WRITERT     EXIT 
 WRITE1   BSS    0
 CDCS     ENDIF 
          RJ     =XC.GTDF    GET DUPL FILE POINTER
          STORE  X0,WSA=X2
          STORE  X0,RL=X3 
          FETCH  A0,CDST,X2 
          SX3    X2-ASCII 
          NZ     X3,SQWR2 
          RJ     =YC.6TO12
          SX0    A0 
          EQ     WRITE1A
 SQWR2    SX3    X2-EBCDIC
          NZ     X3,SQWR4 
          RJ     =YC.6TO12
          SX0    A0 
          EQ     WRITE1A
 SQWR4    SX3    X2-STNDRD1 
          NZ     X3,SQWR6 
          RJ     =YC.6TO12
          SX0    A0 
          EQ     WRITE1A
 SQWR6    BSS    0
          SX2    X2-UNIVAC
          NZ     X2,WRITE1A        NO XLATE 
          RJ     =YC.CYUNI   DO TRANSLATE FROM CYBER TO UNIVAC
          SX0    A0          SET FILE EQUIV  PTR
 WRITE1A  BSS    0
          JP     B5 
 REPLACE  REPLACE  A0,,,=XC.EX
          EQ     WRITERT
 PUT      BSS    0
          PUT    X0,,,WREX   DO THE WRITE 
 WRITERT  BSS    0
          RJ     =XC.A0B1    RESTORE ORIGINAL A0 IF CHANGED BY DUP FILE 
          EQ     =XC.NORRT   RETURN 
 RLERR    BSS    0
          SX1    #RLERR 
          EQ     RTERR1 
  
 RTERR    BSS    0
          SX1    #RTERR 
 RTERR1   BSS    0
          RJ     =XC.SVRTN   SAVE RETURN FOR ERROR TRACE
          RJ     =XC.FIOER
 WREX     DATA   0           ERROR EXIT 
          RJ     =XC.A0B1    RESTORE ORIGINAL A0 IF CHANGED BY DUP FILE 
          RJ     =XC.GTDF    GET DUPL FILE POINTER
          FETCH  X0,ES,X5 
          STORE  A0,ES=X5    MOVE ERROR STATUS TO LOCAL FIT 
          RJ     =XC.EX      TO REGULAR ERROR EXIT
          EQ     WREX        RETURN 
          END 
