* SEQUENTIAL I/O WRITE                                  HEADER  C:WRSQ  0001.000
************************************************************************0002.000
*                                                                      *0003.000
*                    PROPRIETARY INFORMATION                           *0004.000
*                    -----------------------                           *0005.000
*   THE INFORMATION CONTAINED HEREIN IS PROPRIETARY TO ENCORE          *0006.000
*   COMPUTER CORPORATION AND/OR ITS VENDORS, AND ITS USE, DISCLOSURE,  *0007.000
*   OR DUPLICATION IS SUBJECT TO THE RESTRICTIONS STATED IN THE        *0008.000
*   STANDARD ENCORE COMPUTER CORPORATION LICENSE TERMS AND CONDITIONS  *0009.000
*   OR THE APPROPRIATE THIRD-PARTY SUBLICENSE AGREEMENT.               *0010.000
*                                                                      *0011.000
*                       RESTRICTED RIGHTS                              *0012.000
*                       -----------------                              *0013.000
*   USE, DUPLICATION, OR DISCLOSURE BY THE GOVERNMENT IS SUBJECT       *0014.000
*   TO RESTRICTIONS AS SET FOURTH IN SUBDIVISION (c) (1) (ii) OF       *0015.000
*   THE RIGHTS IN TECHNICAL DATA AND COMPUTER SOFTWARE CLAUSE AT       *0016.000
*   252.227.7013                                                       *0017.000
************************************************************************0018.000
* (C) COPYRIGHT 1989 ENCORE COMPUTER CORPORATION                       *0019.000
*     ALL RIGHTS RESERVED                                              *0020.000
************************************************************************0021.000
*                                                                       0022.000
         M.PGM     C:WRSQ,MPX-32,3.6.1,00                               0023.000
*                                                                       0024.000
************************************************************************0025.000
*                                                                       0026.000
*          VOLMGR C:WRSQ  REVISION HISTORY 3.5U02A                      0027.000
*                                                                       0028.000
************************************************************************0029.000
*                                                                       0030.000
*        VERSION 3.5U02A.01 BL4                                         0031.000
*                                                                       0032.000
*        E3RMS35   06/09/92 11464 ADDED CODE TO SUPPORT FILE    E3RMS35 0033.000
*                           WHEN SORTING ON AN RMSS NODE        E3RMS35 0034.000
*                                                                       0035.000
************************************************************************0036.000
*                                                                       0037.000
*                                                                       0038.000
         LIST      NODATA,NOMAC                                         0039.000
         DEF       C:RWSQ         ENTRY POINT                           0040.000
         DEF       C:WRSQ         ENTRY POINT                           0041.000
         DEF       C:WRTN                                               0042.000
         EXT       C:LNGX         LINAGE EXIT                           0043.000
         EXT       C:LDST                                               0044.000
         EXT       C:BFSW                                               0045.000
         EXT       C:IOER                                               0046.000
*                                                                       0047.000
*  SPECIFY COMMON AREA USED                                             0048.000
*                                                                       0049.000
COBCOM   COMMON    COBDAT(4)                                            0050.000
         ORG       COBDAT                                               0051.000
PRECEDE  RES       1W                                                   0052.000
FITLOC   RES       1W                                                   0053.000
ATTRLOC  RES       1W                                                   0054.000
SUBRTN   RES       1W                                                   0055.000
         REL                                                            0056.000
*                                                                       0057.000
*  ATTRIBUTE WORD FLAGS                                                 0058.000
ATTREOP  EQU       31              EOP ATTR PRESENT                     0059.000
ATTRPAGE EQU       30              ATTR: PAGE ADVANCE                   0060.000
ATBEFADV EQU       28              ATTR: BEFORE ADVANCING               0061.000
ATAFTADV EQU       27              ATTR: AFTER ADVANCING                0062.000
ATADVINT EQU       25              ADVANCING INTEGER ATTR PRESENT       0063.000
ATADVIDF EQU       24              ADVANCING IDENTIFIER ATTR PRESENT    0064.000
*  FILE IDENTIFICATION TABLE (FIT) MAP                                  0065.000
INSEQTBL EQU       -32            INPUT COLLATING SEQUENCE TABLE        0066.000
OUTSQTBL EQU       -28            OUTPUT COLLATING SEQUENCE TABLE       0067.000
ERRORETN EQU       -24            ERROR RETURN JET                      0068.000
LINESUBR EQU       -16            LINAGE SETUP SUBROUTINE ADDRESS       0069.000
DDRELKEY EQU       -12            DDA OF RELATIVE KEY                   0070.000
LINETABL EQU       -12            LINAGE TABLE ADDRESS                  0071.000
STATFLD  EQU       -8             DDA STATUS FIELD                      0072.000
LOGFILCD EQU       0              LOGICAL FILE CODE                     0073.000
TCW      EQU       4              ADDRESS OF RECORD AREA                0074.000
CONTSPEC EQU       8              CONTROL SPECIFICATIONS                0075.000
IOSTAT   EQU       12             CURRENT SYSTEM STATUS                 0076.000
RECSIZE  EQU       16             RECORD SIZE IN BYTES                  0077.000
BUFFADDR EQU       20             ADDRESS OF BLOCKING BUFFER            0078.000
ERRORADR EQU       24             IOCS ERROR RETURN ADDRESS             0079.000
FILSTAT  EQU       32             CURRENT FILE STATUS                   0080.000
DIVTYPE0 EQU       33             TYPE OF PHYSICAL DEVICE               0081.000
BITSTAT  EQU       34             BIT STATUS                            0082.000
STATERR0 EQU       35             CURRENT ERROR STATUS                  0083.000
RECLOC   EQU       36             ACTUAL DATA RECORD LOCATION           0084.000
BLOKSIZE EQU       40             BUFFER BLOCK SIZE                     0085.000
PBUFADDR EQU       44             PRIMARY BUFFER ADDRESS                0086.000
ABUFADDR EQU       48             ALTERNATE BUFFER ADDRESS              0087.000
BUFFPTR  EQU       52             BUFFER RECORD POINTER                 0088.000
RECPER   EQU       56             RECORDS PER BUFFER                    0089.000
RECTHIS  EQU       58             RECORDS THIS BUFFER                   0090.000
CUREOF   EQU       60             CURRENT END-OF-FILE                   0091.000
EOFEXT   EQU       64             END-OF-FILE EXTENT                    0092.000
CURRECNO EQU       68             CURRENT RECORD NUMBER                 0093.000
RTNADDR0 EQU       72             RETURN ADDRESS FOR I/O CALL           0094.000
DIVSTAT0 EQU       76             DEVICE STATUS FROM R5                 0095.000
DIVSTAT1 EQU       80             DEVICE STATUS FROM R6                 0096.000
DIVSTAT2 EQU       84             DEVICE STATUS FROM R7                 0097.000
SYSFILCD EQU       86             SYSTEM FILE CODE                      0098.000
ADVANCE  EQU       88             LINES FOR PRINTER ADVANCE             0099.000
ADVNCHAR EQU       90             PRINTER ADVANCE CHARACTER             0100.000
SIZE     EQU       92             RECORD SIZE FOR VARIABLE LENGTH       0101.000
MAXSIZE  EQU       94             SIZE OF AN I/O TRANSFER RECORD        0102.000
ADDRHOLD EQU       96             RECORD ADDRESS TEMPORARY HOLD AREA    0103.000
*  FILE STATUS FLAGS                                                    0104.000
STATOR0  EQU       1              FILE ORGANIZATION LOW ORDER BIT       0105.000
STATOR1  EQU       0              FILE ORGANIZATION HIGH ORDER BIT      0106.000
STATAC0  EQU       3              ACCESS MODE LOW ORDER BIT             0107.000
STATAC1  EQU       2              ACCESS MODE HIGH ORDER BIT            0108.000
STATOPT  EQU       4              OPTIONAL FILE                         0109.000
STATVAR  EQU       5              VARIABLE RECORDS IN FILE              0110.000
STATIO   EQU       6              FILE IS INPUT-OUTPUT                  0111.000
STATFLSH EQU       7              FLUSH RQR'D FLAG                      0112.000
STATRWT  EQU       8              REWRITE FLUSH FLAG                    0113.000
DEVCC    EQU       9              DEVICE IS CARRIAGE CONTROL            0114.000
DEVOUT   EQU       10             DEVICE AVAILABLE FOR OUTPUT           0115.000
DEVINP   EQU       11             DEVICE AVAILABLE FOR INPUT            0116.000
STATDEV  EQU       12             DEVICE TYPE                           0117.000
STATLOK  EQU       16             LOCKED FILE                           0118.000
STATEOF  EQU       17             FILE AT END-OF-FILE                   0119.000
STATOPN  EQU       18             FILE IS OPEN                          0120.000
STATREV  EQU       19             FILE IS REVERSED                      0121.000
STATINP  EQU       20             FILE IS INPUT                         0122.000
STATOUT  EQU       21             FILE IS OUTPUT                        0123.000
STATALT  EQU       22             ALTERNATE BUFFER AVAILABLE            0124.000
STATRED  EQU       23             OPERATION IS READ                     0125.000
STATNOR  EQU       24             NO REWIND                             0126.000
STATEXT  EQU       25             EXTEND OPERATION                      0127.000
STATDALC EQU       26             DEVICE DEALLOCATED FLAG               0128.000
STATFRST EQU       24             FIRST PRINTER WRITE (IN ADVANCE)      0129.000
*  STATUS MASKS                                                         0130.000
STATLOKM EQU       X'8000'                                              0131.000
STATEOFM EQU       X'4000'                                              0132.000
STATOPNM EQU       X'2000'                                              0133.000
STATREVM EQU       X'1000'                                              0134.000
STATINPM EQU       X'800'                                               0135.000
STATOUTM EQU       X'400'                                               0136.000
STATALTM EQU       X'200'                                               0137.000
STATREDM EQU       X'100'                                               0138.000
STATEXTM EQU       X'40'                                                0139.000
STATDLCM EQU       X'20'                                                0140.000
*  LINAGE TABLE                                                         0141.000
LINCTR   EQU       0                                                    0142.000
LINAGE   EQU       1W                                                   0143.000
FOOTING  EQU       2W                                                   0144.000
TOP      EQU       3W                                                   0145.000
BOTTOM   EQU       4W                                                   0146.000
*                                                                       0147.000
SLO      EQU       3                                                    0148.000
LE       EQU       6                                                    0149.000
*                                                                       0150.000
*                                                                       0151.000
*                                                                       0152.000
* PICK UP PARAMETERS FROM CALL STATEMENT                                0153.000
*                                                                       0154.000
*                                                                       0155.000
C:RWSQ   EQU       $                                                    0156.000
         TRR       0,3                                                  0157.000
         LW        1,1W,3          LOAD FIT ADDRESS                     0158.000
         TBM       STATRED,FILSTAT,1    TEST 'LAST OP WAS READ'         0159.000
         BCT       1,RWT010                                             0160.000
         LI        7,G'9O'        LAST OP NOT READ ERROR                0161.000
         BU        C:IOER                                               0162.000
RWT010   EQU       $                                                    0163.000
         ADI       0,2W                                                 0164.000
         STW       0,RTNADDR0,1                                         0165.000
*                                                                       0166.000
* RE-WRITE LAST READ RECORD TO BUFFER                                   0167.000
*                                                                       0168.000
         LW        4,BUFFPTR,1                                          0169.000
         LW        2,RECLOC,1                                           0170.000
         TRR       4,3                                                  0171.000
         SUMH      3,MAXSIZE,1                                          0172.000
RWT020   EQU       $                                                    0173.000
         LB        6,0,2                                                0174.000
         STB       6,0,3                                                0175.000
         ABR       2,31                                                 0176.000
         ABR       3,31                                                 0177.000
         CAR       3,4                                                  0178.000
         BCF       4,RWT020                                             0179.000
*  NOTE - BUFFPTR,CURRECNO,RECTHIS ALREADY UPDATED                      0180.000
         SBM       STATRWT,FILSTAT,1                                    0181.000
         ZBM       STATRED,FILSTAT,1                                    0182.000
         LI        7,G'00'        RESET COBOL STATUS                    0183.000
         BL        C:LDST                                               0184.000
         BU        *RTNADDR0,1                                          0185.000
*                                                                       0186.000
* WRITE SEQUENTIAL                                                      0187.000
*                                                                       0188.000
C:WRSQ   EQU       $              ENTRY POINT                           0189.000
         TRR       0,3                                                  0190.000
         LW        5,0,3          WRITE ATTRIBUTES                      0191.000
         LW        1,1W,3         FILE INFORMATION TABLE ADDRESS        0192.000
         LW        2,2W,3         DATA DESCRIPTOR ADDRESS               0193.000
         BNZ       WRT005                                               0194.000
         LH        7,MAXSIZE,1    LOAD DEFAULT LENGTH                   0195.000
         BU        WRT007                                               0196.000
WRT005   EQU       $                                                    0197.000
         LH        7,2,2          GET LENGTH OF RECORD                  0198.000
WRT007   EQU       $                                                    0199.000
         STH       7,SIZE,1                                             0200.000
*                                                                       0201.000
* SET UP RETURN ADDRESS                                                 0202.000
*                                                                       0203.000
WRT040   EQU       $                                                    0204.000
         ADI       0,4W           INCREMENT RETURN ADDRESS              0205.000
         STW       0,RTNADDR0,1   SAVE RETURN ADDRESS                   0206.000
*                                                                       0207.000
*                                                                       0208.000
* CHECK FILE STATUS                                                     0209.000
*                                                                       0210.000
*                                                                       0211.000
         TBM       STATOPN,FILSTAT,1                                    0212.000
         BCT       1,WRT050       FILE OPEN                             0213.000
         LI        7,G'9B'        FILE NOT OPEN ERROR                   0214.000
         BU        C:IOER                                               0215.000
WRT050   EQU       $                                                    0216.000
         TBM       STATOUT,FILSTAT,1                                    0217.000
         BCT       1,WRT055       FILE IS OUTPUT                        0218.000
         TBM       STATEXT,FILSTAT,1                                    0219.000
         BCT       1,WRT055                                             0220.000
         LI        7,G'9C'        FILE NOT OUTPUT ERROR                 0221.000
         BU        C:IOER                                               0222.000
WRT055   EQU       $                                                    0223.000
         LH        7,SIZE,1       CHECK FOR RECORD TOO LARGE            0224.000
         CAMH      7,MAXSIZE,1                                          0225.000
         BCF       2,WRT060                                             0226.000
         LI        7,G'9H'        RECORD TOO LARGE ERROR                0227.000
         BU        C:IOER                                               0228.000
WRT060   EQU       $                                                    0229.000
         TBM       STATEOF,FILSTAT,1                                    0230.000
         BCF       1,WRT070       NOT AT END-OF-FILE                    0231.000
         LI        7,G'34'        BOUNDARY VIOLATION ERROR              0232.000
         BU        C:IOER                                               0233.000
*                                                                       0234.000
*                                                                       0235.000
* HANDLE OPERATIONS BY DEVICE                                           0236.000
*                                                                       0237.000
*                                                                       0238.000
WRT070   EQU       $                                                    0239.000
         LI        6,X'F'                                               0240.000
         ANMH      6,FILSTAT,1    FETCH DEVICE TYPE                     0241.000
         CI        6,3                                                  0242.000
         BCF       4,WRT200                                             0243.000
*                                                                       0244.000
* DEVICE IS A PRINTER                                                   0245.000
*                                                                       0246.000
         LI        7,1            DEFAULT ADVANCE VALUE                 0247.000
         TBR       5,ATTRPAGE                                           0248.000
         BCF       1,WRT075                                             0249.000
         LI        7,0                                                  0250.000
WRT075   EQU       $                                                    0251.000
         STH       7,ADVANCE,1                                          0252.000
         TBR       5,ATADVINT     TEST INTEGER ADVANCE                  0253.000
         BCF       1,WRT110       NO INTEGER PRESENT                    0254.000
         LW        6,3W,3         GET INTEGER                           0255.000
         STH       6,ADVANCE,1                                          0256.000
         BU        WRT120                                               0257.000
WRT110   EQU       $                                                    0258.000
         TBR       5,ATADVIDF     TEST IDENTIFIER ADVANCE               0259.000
         BCF       1,WRT120       NO IDENTIFIER PRESENT                 0260.000
         LW        2,3W,3         GET DD ADDRESS                        0261.000
         LH        6,1H,2         OBTAIN ADVANCING VARIABLE LENGTH      0262.000
         LW        2,1W,2         POINT TO IDENTIFIER                   0263.000
         LI        7,-2           SECURE ONLY 2 BYTES                   0264.000
         CI        6,5                                                  0265.000
         BCT       3,WRT115                                             0266.000
         ADI       2,2B           SECURE FROM 4 BYTE FIELD              0267.000
         CI        6,10                                                 0268.000
         BCT       3,WRT115                                             0269.000
         ADI       2,4B           SECURE FROM 8 BYTE FIELD              0270.000
WRT115   EQU       $                                                    0271.000
         TRR       1,3                                                  0272.000
WRT119   EQU       $                                                    0273.000
         LB        6,0W,2         OBTAIN A BYTE                         0274.000
         STB       6,ADVANCE,3                                          0275.000
         ABR       2,31                                                 0276.000
         ABR       3,31                                                 0277.000
         BIB       7,WRT119                                             0278.000
WRT120   EQU       $                                                    0279.000
         LI        7,G' '         DEFAULT ADVANCE CHARACTER             0280.000
         TBR       5,ATAFTADV     TEST ADVANCING                        0281.000
         TBR       5,ATBEFADV                                           0282.000
         BCT       1,WRT125                                             0283.000
         BCF       2,WRT130                                             0284.000
WRT125   EQU       $                                                    0285.000
         LI        7,G'+'         IF ADVANCING SPECIFIED                0286.000
WRT130   EQU       $                                                    0287.000
         STB       7,ADVNCHAR,1                                         0288.000
         TBR       5,ATTREOP                                            0289.000
         BCF       1,WRT140       NO END-OF-PAGE                        0290.000
*                                                                       0291.000
* END-OF-PAGE PROCESSING                                                0292.000
*                                                                       0293.000
         LW        3,LINETABL,1                                         0294.000
         LW        7,LINCTR,3                                           0295.000
         ADMH      7,ADVANCE,1                                          0296.000
         CAMW      7,LINAGE,3      TEST END OF PAGE BY OVRFLW           0297.000
         BCF       LE,WRT140                                            0298.000
         LW        6,FOOTING,3                                          0299.000
         BZ        WRT132                                               0300.000
         CAMW      7,FOOTING,3     TEST END OF PAGE W/ FOOTING          0301.000
         BCF       3,WRT140                                             0302.000
WRT132   EQU       $                                                    0303.000
         ADI       0,2W            IF NOT, SKIP EOP PROCESSING          0304.000
         STW       0,RTNADDR0,1                                         0305.000
*                                                                       0306.000
* PROCESS ADVANCING, PRINT LINE                                         0307.000
*                                                                       0308.000
WRT140   EQU       $                                                    0309.000
         TBR       5,ATBEFADV     TEST ADVANCE BEFORE PRINT             0310.000
         BCT       1,WRT150                                             0311.000
         BL        BLANKS         GO ADVANCE LINES                      0312.000
WRT150   EQU       $                                                    0313.000
         LH        4,SIZE,1       FETCH RECORD SIZE                     0314.000
         BCT       4,WRT190       ZERO, SKIP OUTPUT                     0315.000
         LW        3,RECLOC,1                                           0316.000
         LW        2,BUFFPTR,1                                          0317.000
         ADR       3,4                                                  0318.000
         LB        7,SYSFILCD,1   CHECK IF SLO FILE                     0319.000
         CI        7,SLO                                                0320.000
         BCF       4,WRT155                                             0321.000
         SVC       1,X'3C'          SING BUFF-WAIT-ON I/O COMPLETE      0322.000
* TRANSFER RECORD TO BUFFER                                             0323.000
WRT155   EQU       $                                                    0324.000
         LB        7,ADVNCHAR,1   APPEND CONTROL CHARACTER TO FRONT     0325.000
         STB       7,0,2                                                0326.000
WRT160   EQU       $                                                    0327.000
         LB        6,0,3          LOAD RECORD CHARACTER                 0328.000
         STB       6,1,2                                                0329.000
         ABR       2,31                                                 0330.000
         ABR       3,31                                                 0331.000
         CAR       3,4                                                  0332.000
         BCF       4,WRT160                                             0333.000
         LB        7,SYSFILCD,1   CHECK IF SLO FILE                     0334.000
         CI        7,SLO                                                0335.000
         BCF       4,WRT165       IF NOT, DBL BUFFER                    0336.000
         LW        6,ABUFADDR,1                                         0337.000
         BU        WRT170                                               0338.000
* WRITE A LINE                                                          0339.000
WRT165   EQU       $                                                    0340.000
         BL        C:BFSW         SWITCH BUFFER PTRS                    0341.000
WRT170   EQU       $                                                    0342.000
         SVC       1,X'3C'          WAIT ON I/O                         0343.000
         LH        7,SIZE,1       SET UP TCW                            0344.000
         ADI       7,1                                                  0345.000
         SLL       7,20                                                 0346.000
         SBR       7,12           TURN ON 'F' BIT FOR BYTE ADDRESSING   0347.000
         ORR       7,6                                                  0348.000
         STW       6,TCW,1                                              0349.000
         TBM       7,IOSTAT,1     EOM PRINT FILE                        0350.000
         BCT       1,WRT320       YES GIVE CB34                         0351.000
         SVC       1,X'32'          PRINT THE LINE                      0352.000
WRT190   EQU       $                                                    0353.000
         TBR       5,ATBEFADV     TEST ADVANCING AFTER                  0354.000
         BCF       1,WRT800                                             0355.000
         BL        BLANKS         GO ADVANCE LINES                      0356.000
         BU        WRT800                                               0357.000
WRT200   EQU       $                                                    0358.000
*         CI        6,1                                         E3RMS35 0359.000
*         BCF       4,WRT300                                    E3RMS35 0360.000
**                                                                      0361.000
* DEVICE IS A DISK                                                      0362.000
*                                                                       0363.000
***      TBM       STATALT,FILSTAT,1 IS ALTERNATE BUFFER PRESENT        0364.000
***      BCT       1,WRT220                                             0365.000
***      CALM      X'3C'             NO,WAIT FOR LAST OPERATION COMPLETE0366.000
* TRANSFER RECORD TO BUFFER                                             0367.000
WRT220   EQU       $                                                    0368.000
         LW        2,RECLOC,1     SET UP PARAMETERS FOR RECORD MOVE     0369.000
         LW        3,BUFFPTR,1                                          0370.000
         TRR       3,4                                                  0371.000
         ADMH      4,MAXSIZE,1                                          0372.000
         BL        C:TRRB         TRANSFER RECORD TO BUFFER             0373.000
         STW       4,BUFFPTR,1    UPDATE BUFFER POINTER                 0374.000
         SBM       STATFLSH,FILSTAT,1    SET FLUSH REQUIRED FLAG        0375.000
         ABM       7,RECTHIS+1,1  INCREMENT RECORDS THIS BUFFER COUNTER 0376.000
         LH        6,RECPER,1     CHECK FOR BUFFER FULL                 0377.000
         CAMH      6,RECTHIS,1                                          0378.000
         BCF       4,WRT250       NOT FULL, SKIP PHYSICAL OUTPUT        0379.000
         SVC       1,X'3C'          WAIT FOR PENDING I/O                0380.000
         LW        7,CONTSPEC,1   INCREMENT SECTOR NUMBER               0381.000
         TRR       7,6            CHECK FOR BLOCK ZERO                  0382.000
         ANMW      6,CONTMASK                                           0383.000
         BCF       4,WRT235                                             0384.000
         ADI       7,1            BLOCK ZERO, INCREMENT BY UNITY        0385.000
         BU        WRT237                                               0386.000
WRT235   EQU       $                                                    0387.000
         ADMW      7,BLOKSIZE,1                                         0388.000
WRT237   EQU       $                                                    0389.000
         STW       7,CONTSPEC,1                                         0390.000
         TBM       STATEOF,FILSTAT,1   TEST DISK OVERWRITE              0391.000
         BCF       1,WRT240                                             0392.000
         LI        7,G'34'        DISK OVERWRITE                        0393.000
         BU        C:IOER                                               0394.000
WRT240   EQU       $                                                    0395.000
         BL        C:BFSW         SWAP BUFFER POINTERS                  0396.000
         LW        7,TCW,1        SET UP TCW                            0397.000
         ANMW      7,QUANMASK                                           0398.000
         ORR       7,6                                                  0399.000
         STW       6,TCW,1                                              0400.000
         ZMH       RECTHIS,1      RESET RECORDS THIS BUFFER COUNTER     0401.000
         SVC       1,X'32'          WRITE THE RECORD                    0402.000
         ZBM       STATFLSH,FILSTAT,1   RESET FLUSH REQUIRED FLAG       0403.000
WRT250   EQU       $                                                    0404.000
         ABM       7,CURRECNO+3,1 INCREMENT RECORD NUMBER               0405.000
         LW        6,CURRECNO,1   CHECK FOR END-OF-FILE                 0406.000
         STW       6,CUREOF,1     UPDATE END-OF-FILE                    0407.000
         CAMW      6,EOFEXT,1                                           0408.000
         BCF       4,WRT990                                             0409.000
         SBM       STATEOF,FILSTAT,1 END-OF-FILE, SET STATUS            0410.000
         BU        WRT800                                               0411.000
WRT300   EQU       $                                                    0412.000
         CI        6,2                                                  0413.000
         BCF       4,WRT400                                             0414.000
*                                                                       0415.000
* DEVICE IS TAPE UNIT                                                   0416.000
*                                                                       0417.000
***      TBM       STATALT,FILSTAT,1                                    0418.000
***      BCT       1,WRT320                                             0419.000
***      CALM      X'3C'             CHECK FOR I/O COMPLETE             0420.000
***      TBM       7,IOSTAT,1      TEST END-OF-MEDIUM                   0421.000
***      BCF       1,WRT320                                             0422.000
***      SBM       STATEOF,FILSTAT,1                                    0423.000
***      LI        7,G'34'                                              0424.000
***      BU        C:IOER                                               0425.000
* TRANSFER RECORD TO BUFFER                                             0426.000
         LW        2,RECLOC,1                                           0427.000
         LW        3,BUFFPTR,1                                          0428.000
         TRR       3,4                                                  0429.000
         ADMH      4,SIZE,1                                             0430.000
         BL        C:TRRB         TRANSFER RECORD TO BUFFER             0431.000
         STW       4,BUFFPTR,1                                          0432.000
         SBM       STATFLSH,FILSTAT,1   SET FLUSH RQR'D FLAG            0433.000
         ABM       7,RECTHIS+1,1                                        0434.000
         LH        6,RECPER,1      CHECK FOR BUFFER FULL                0435.000
         CAMH      6,RECTHIS,1                                          0436.000
         BCF       4,WRT350        NO,SKIP PHYSICAL OUTPUT              0437.000
         SVC       1,X'3C'                                              0438.000
         TBM       7,IOSTAT,1      TEST END-OF-MEDIUM                   0439.000
         BCF       1,WRT335                                             0440.000
WRT320   EQU       $      ENTRY FROM PRINTER SLO CB34                   0441.000
         SBM       STATEOF,FILSTAT,1                                    0442.000
         LI        7,G'34'                                              0443.000
         BU        C:IOER                                               0444.000
WRT335   EQU       $                                                    0445.000
         BL        C:BFSW          RESET BUFFER PTRS                    0446.000
         TBM       STATVAR,FILSTAT,1    TEST VAR LENGTH RECORDS         0447.000
         BCF       1,WRT340                                             0448.000
         LH        7,SIZE,1                                             0449.000
         ABR       7,31            ADJUST TO EVEN BYTE COUNT            0450.000
         ZBR       7,31                                                 0451.000
         BU        WRT345                                               0452.000
WRT340   EQU       $                                                    0453.000
         LW        7,BLOKSIZE,1    SET UP TCW                           0454.000
WRT345   EQU       $                                                    0455.000
         SLL       7,20                                                 0456.000
         SBR       7,12                                                 0457.000
         ORR       7,6                                                  0458.000
         STW       6,TCW,1                                              0459.000
         ZMH       RECTHIS,1       RESET RECORDS THIS BUFFER CTR        0460.000
         SVC       1,X'32'           WRITE A RECORD                     0461.000
         ZBM       STATFLSH,FILSTAT,1   RESET FLUSH RQR'D FLAG          0462.000
WRT350   EQU       $                                                    0463.000
         BU        WRT800                                               0464.000
*                                                                       0465.000
* TRANSFER RECORD UTILITY                                               0466.000
*                                                                       0467.000
* R1 - FIT ADDRESS                                                      0468.000
* R2 - RECORD LOC                                                       0469.000
* R3 - CURRENT BUFFER PTR                                               0470.000
* R4 - R3 + TRANSFER SIZE                                               0471.000
*                                                                       0472.000
C:TRRB   EQU       $              TRANSFER RECORD TO BUFFER             0473.000
*                                                                       0474.000
         LW        5,OUTSQTBL,1   CHECK FOR OUTPUT SEQUENCE TABLE       0475.000
         BZ        TRB020                                               0476.000
* TRANSLATE RECORD TO OUTPUT CHARACTER CODE-SET                         0477.000
         TRR       1,7            SAVE FIT PTR                          0478.000
TRB010   EQU       $                                                    0479.000
         TRR       5,1                                                  0480.000
         LB        6,0,2          LOAD RECORD CHARACTER                 0481.000
         ADR       6,1            OFFSET INTO TRANSLATION TABLE         0482.000
         LB        6,0,1          LOAD TRANSLATED CHARACTER             0483.000
         STB       6,0,3                                                0484.000
         ABR       2,31                                                 0485.000
         ABR       3,31                                                 0486.000
         CAR       3,4                                                  0487.000
         BCF       4,TRB010                                             0488.000
         TRR       7,1            RESTORE FIT PTR                       0489.000
         TRSW      0                                                    0490.000
* TRANSFER W/O TRANSLATION                                              0491.000
TRB020   EQU       $                                                    0492.000
         LB        6,0,2          MOVE RECORD TO BUFFER                 0493.000
         STB       6,0,3                                                0494.000
         ABR       2,31                                                 0495.000
         ABR       3,31                                                 0496.000
         CAR       3,4                                                  0497.000
         BCF       4,TRB020                                             0498.000
         TRSW      0                                                    0499.000
*                                                                       0500.000
WRT400   EQU       $                                                    0501.000
WRT800   EQU       $                                                    0502.000
WRT990   EQU       $                                                    0503.000
         ZBM       STATRED,FILSTAT,1 RESET 'LAST OPERATION WAS READ'    0504.000
         LI        7,G'00'        RESET COBOL STATUS                    0505.000
         BL        C:LDST                                               0506.000
         BU        *RTNADDR0,1    RETURN                                0507.000
*                                                                       0508.000
*                                                                       0509.000
*LOCAL SUBROUTINE FOR ADVANCING 'N' LINES OR ADVANCING A LOGICAL PAGE - 0510.000
* ENTER WITH ADVANCE ATTRIBUTE FLAGS IN R5 AND ADVANCE LINE COUNT       0511.000
* IN 'ADVANCE' CELL OF FILE INFORMATION BLOCK.                          0512.000
*                                                                       0513.000
BLANKS   EQU       $                                                    0514.000
         LW        7,TCW,1        SET UP DUMMY RECORD ADDRESS           0515.000
         STW       7,ADDRHOLD,1                                         0516.000
         LW        3,LINETABL,1                                         0517.000
         TBR       5,ATTRPAGE     TEST PAGE ADVANCE                     0518.000
         BCT       1,BNK050                                             0519.000
*                                                                       0520.000
* ADVANCE BY LINES                                                      0521.000
*                                                                       0522.000
         LH        7,ADVANCE,1    R7 <- ADVANCE COUNT                   0523.000
         TRR       3,3            CHECK FOR LINAGE                      0524.000
         BZ        BNK005                                               0525.000
* TEST PAGE OVERFLOW                                                    0526.000
         LW        6,LINCTR,3                                           0527.000
         ADMH      6,ADVANCE,1                                          0528.000
         CAMW      6,LINAGE,3                                           0529.000
         BCT       2,PAGESKP      RESET ADVANCE COUNT                   0530.000
         SVC       1,X'3C'                                              0531.000
         CI        7,1            CHECK ADVANCE 1 LINE                  0532.000
         BCF       4,BNK005                                             0533.000
         TRR       7,6                                                  0534.000
         ZR        7                                                    0535.000
         BU        BNK025                                               0536.000
BNK005   EQU       $                                                    0537.000
         LEA       2,DBLADVC                                            0538.000
         ANMW      2,ADDRMASK                                           0539.000
         ORMW      2,COUNT                                              0540.000
         STW       2,TCW,1                                              0541.000
         LI        4,1            INITIALIZE SPACING COUNTER            0542.000
         ZR        6                                                    0543.000
         DVI       6,2            CALCULATE DBL SPACING                 0544.000
BNK010   EQU       $                                                    0545.000
         SVC       1,X'3C'                                              0546.000
         CAR       7,4                                                  0547.000
         BCF       LE,BNK020      CHECK ADVANCING COMPLETE              0548.000
         TBM       7,IOSTAT,1    EOM PRINT SLO-DISK FILE                0549.000
         BCT       1,WRT320      YES CB34                               0550.000
         SVC       1,X'32'          ADVANCE A DBL LINE                  0551.000
         ABR       4,31           INCREMENT ADVANCE COUNT               0552.000
         BU        BNK010                                               0553.000
BNK020   EQU       $                                                    0554.000
         TRR       6,6            CHECK FOR SINGLE ADVANCE              0555.000
         BZ        BNK075                                               0556.000
BNK025   EQU       $                                                    0557.000
         LEA       2,LINEADVC                                           0558.000
         ANMW      2,ADDRMASK                                           0559.000
         ORMW      2,COUNT                                              0560.000
         STW       2,TCW,1                                              0561.000
         TBM       7,IOSTAT,1    EOM PRINT SLO-DISK FILE                0562.000
         BCT       1,WRT320      YES CB34                               0563.000
         SVC       1,X'32'                                              0564.000
         BU        BNK075                                               0565.000
BNK050   EQU       $                                                    0566.000
         TRR       3,3                                                  0567.000
         BNZ       PAGESKP        TEST LINAGE PRESENT                   0568.000
*                                                                       0569.000
* ADVANCE A PAGE                                                        0570.000
*                                                                       0571.000
         SVC       1,X'3C'                                              0572.000
         LEA       7,PAGEADVC                                           0573.000
         ANMW      7,ADDRMASK                                           0574.000
         ORMW      7,COUNT                                              0575.000
         STW       7,TCW,1                                              0576.000
         TBM       7,IOSTAT,1     EOM PRINT SLO-DISK FILE               0577.000
         BCT       1,WRT320       YES CB34                              0578.000
         SVC       1,X'32'                                              0579.000
         BU        BNK990                                               0580.000
PAGESKP  EQU       $                                                    0581.000
*                                                                       0582.000
* ADVANCE LINAGE PAGE                                                   0583.000
*                                                                       0584.000
         SVC       1,X'3C'                                              0585.000
         LEA       2,DBLADVC                                            0586.000
         ANMW      2,ADDRMASK                                           0587.000
         ORMW      2,COUNT                                              0588.000
         STW       2,TCW,1                                              0589.000
* PAGE OVERFLOW - RESET ADVANCE COUNT                                   0590.000
         LW        7,LINAGE,3                                           0591.000
         SUMW      7,LINCTR,3                                           0592.000
         ADI       7,1                                                  0593.000
         ADMW      7,BOTTOM,3                                           0594.000
         LI        4,1            INITIALIZE SPACING COUNTER            0595.000
         ZR        6                                                    0596.000
         DVI       6,2            CALCULATE DBL SPACING                 0597.000
BNK064   EQU       $                                                    0598.000
         SVC       1,X'3C'                                              0599.000
         CAR       7,4                                                  0600.000
         BCF       LE,BNK065      CHECK ADVANCING COMPLETE              0601.000
         TBM       7,IOSTAT,1     EOM PRINT SLO-DISK FILE               0602.000
         BCT       1,WRT320       YES CB34                              0603.000
         SVC       1,X'32'          ADVANCE TWO LINES                   0604.000
         ABR       4,31                                                 0605.000
         BU        BNK064                                               0606.000
BNK065   EQU       $                                                    0607.000
         TRR       6,6            CHECK FOR SINGLE ADVANCE              0608.000
         BZ        BNK066                                               0609.000
         LEA       2,LINEADVC                                           0610.000
         ANMW      2,ADDRMASK                                           0611.000
         ORMW      2,COUNT                                              0612.000
         STW       2,TCW,1                                              0613.000
         TBM       7,IOSTAT,1     EOM PRINT SLO-DISK FILE               0614.000
         BCT       1,WRT320       YES CB34                              0615.000
         SVC       1,X'32'                                              0616.000
* RESET LINAGE IF VARIABLE                                              0617.000
BNK066   EQU       $                                                    0618.000
         LW        2,LINESUBR,1   CHECK VARIABLE LINAGE                 0619.000
         BZ        BNK071                                               0620.000
         STW       1,FITLOC       SAVE FIT & ATTR'S                     0621.000
         STW       5,ATTRLOC                                            0622.000
         STW       0,SUBRTN                                             0623.000
         BU        0,2            RESET LINAGE TABLE                    0624.000
C:WRTN   EQU       $                                                    0625.000
         LW        3,LINETABL,1                                         0626.000
BNK071   EQU       $                                                    0627.000
         SVC       1,X'3C'                                              0628.000
         LEA       2,DBLADVC                                            0629.000
         ANMW      2,ADDRMASK                                           0630.000
         ORMW      2,COUNT                                              0631.000
         STW       2,TCW,1                                              0632.000
         LI        4,1                                                  0633.000
         LW        7,TOP,3                                              0634.000
         ZR        6                                                    0635.000
         DVI       6,2                                                  0636.000
BNK072   EQU       $                                                    0637.000
         SVC       1,X'3C'                                              0638.000
         CAR       7,4                                                  0639.000
         BCF       LE,BNK073                                            0640.000
         TBM       7,IOSTAT,1      EOM PRINT SLO DISK FILE              0641.000
         BCT       1,WRT320        YES CB34                             0642.000
         SVC       1,X'32'                                              0643.000
         ABR       4,31                                                 0644.000
         BU        BNK072                                               0645.000
BNK073   EQU       $                                                    0646.000
         TRR       6,6            CHECK FOR SINGLE ADVANCE              0647.000
         BZ        BNK074                                               0648.000
         LEA       2,LINEADVC                                           0649.000
         ANMW      2,ADDRMASK                                           0650.000
         ORMW      2,COUNT                                              0651.000
         STW       2,TCW,1                                              0652.000
         TBM       7,IOSTAT,1     EOM PRINT SLO-DISK FILE               0653.000
         BCT       1,WRT320       YES CB34                              0654.000
         SVC       1,X'32'                                              0655.000
BNK074   EQU       $                                                    0656.000
         LI        4,1            RESET LINAGE COUNTER                  0657.000
         BU        BNK080                                               0658.000
*                                                                       0659.000
* UPDATE LINAGE COUNT                                                   0660.000
*                                                                       0661.000
BNK075   EQU       $                                                    0662.000
         TRR       3,3                                                  0663.000
         BZ        BNK990         TEST LINAGE PRESENT                   0664.000
         SLL       7,1            RESTORE ADVANCE COUNT                 0665.000
         ADR       6,7                                                  0666.000
         LW        4,LINCTR,3                                           0667.000
         ADR       7,4                                                  0668.000
BNK080   EQU       $                                                    0669.000
         STW       4,LINCTR,3                                           0670.000
BNK990   EQU       $                                                    0671.000
         LW        2,ADDRHOLD,1   RESTORE RECORD ADDRESS                0672.000
         STW       2,TCW,1                                              0673.000
         TRSW      0              RETURN                                0674.000
QUANMASK DATAW     X'FFF00000'                                          0675.000
LINEADVC DATAW     C'    '                                              0676.000
DBLADVC  DATAW     C'0   '                                              0677.000
PAGEADVC DATAW     C'1   '                                              0678.000
ADDRMASK DATAW     X'7FFFF'                                             0679.000
COUNT    DATAW     X'480000'                                            0680.000
CONTMASK DATAW     X'FFFFF'                                             0681.000
         END                                                            0682.000
