* SEQUENTIAL I/O CLOSE                                  HEADER  C:CLSQ  0001.000
*                                                                       0002.000
*                                                                       0003.000
         M.PGM     C:CLSQ,MPX-32,3.6.1,00                               0004.000
         LIST      NODATA                                               0005.000
         DEF       C:CLSQ                                               0006.000
         EXT       C:LDST                                               0007.000
         EXT       C:IOER                                               0008.000
*  CLOSE SEQUENTIAL ATTRIBUTES                                          0009.000
ATNORWD  EQU       29              ATTR: CLOSE W/O REWIND               0010.000
ATCLWLCK EQU       30              ATTR: CLOSE W/LOCK                   0011.000
*  FIT MAP                                                              0012.000
INSEQTBL EQU       -32            INPUT COLLATING SEQUENCE TABLE        0013.000
OUTSQTBL EQU       -28            OUTPUT COLLATING SEQUENCE TABLE       0014.000
ERRORETN EQU       -24            ERROR RETURN JET                      0015.000
LINESUBR EQU       -16            LINAGE SETUP SUBROUTINE ADDRESS       0016.000
DDRELKEY EQU       -12            DDA OF RELATIVE KEY                   0017.000
LINETABL EQU       -12            LINAGE TABLE ADDRESS                  0018.000
STATFLD  EQU       -8             DDA STATUS FIELD                      0019.000
LOGFILCD EQU       0              LOGICAL FILE CODE                     0020.000
TCW      EQU       4              ADDRESS OF RECORD AREA                0021.000
CONTSPEC EQU       8              CONTROL SPECIFICATIONS                0022.000
IOSTAT   EQU       12             CURRENT SYSTEM STATUS                 0023.000
RECSIZE  EQU       16             RECORD SIZE IN BYTES                  0024.000
BUFFADDR EQU       20             ADDRESS OF BLOCKING BUFFER            0025.000
ERRORADR EQU       24             IOCS ERROR RETURN ADDRESS             0026.000
FILSTAT  EQU       32             CURRENT FILE STATUS                   0027.000
DIVTYPE0 EQU       33             TYPE OF PHYSICAL DEVICE               0028.000
BITSTAT  EQU       34             BIT STATUS                            0029.000
STATERR0 EQU       35             CURRENT ERROR STATUS                  0030.000
RECLOC   EQU       36             ACTUAL DATA RECORD LOCATION           0031.000
BLOKSIZE EQU       40             BUFFER BLOCK SIZE                     0032.000
PBUFADDR EQU       44             PRIMARY BUFFER ADDRESS                0033.000
ABUFADDR EQU       48             ALTERNATE BUFFER ADDRESS              0034.000
BUFFPTR  EQU       52             BUFFER RECORD POINTER                 0035.000
RECPER   EQU       56             RECORDS PER BUFFER                    0036.000
RECTHIS  EQU       58             RECORDS THIS BUFFER                   0037.000
CUREOF   EQU       60             CURRENT END-OF-FILE                   0038.000
EOFEXT   EQU       64             END-OF-FILE EXTENT                    0039.000
CURRECNO EQU       68             CURRENT RECORD NUMBER                 0040.000
RTNADDR0 EQU       72             RETURN ADDRESS FOR I/O CALL           0041.000
DIVSTAT0 EQU       76             DEVICE STATUS FROM R5                 0042.000
DIVSTAT1 EQU       80             DEVICE STATUS FROM R6                 0043.000
DIVSTAT2 EQU       84             DEVICE STATUS FROM R7                 0044.000
SYSFILCD EQU       86             SYSTEM FILE CODE                      0045.000
ADVANCE  EQU       88             LINES FOR PRINTER ADVANCE             0046.000
VOLUME   EQU       88             ORIGINAL TAPE VOLUME NUMBER           0047.000
SIZE     EQU       92             RECORD SIZE FOR VARIABLE LENGTH       0048.000
MAXSIZE  EQU       94             SIZE OF AN I/O TRANSFER RECORD        0049.000
ADDRHOLD EQU       96             RECORD ADDRESS TEMPORARY HOLD AREA    0050.000
*  FILE STATUS FLAGS                                                    0051.000
STATOR0  EQU       1              FILE ORGANIZATION LOW ORDER BIT       0052.000
STATOR1  EQU       0              FILE ORGANIZATION HIGH ORDER BIT      0053.000
STATAC0  EQU       3              ACCESS MODE LOW ORDER BIT             0054.000
STATAC1  EQU       2              ACCESS MODE HIGH ORDER BIT            0055.000
STATOPT  EQU       4              OPTIONAL FILE                         0056.000
STATVAR  EQU       5              VARIABLE RECORDS IN FILE              0057.000
STATFLSH EQU       7              FLUSH RQR'D FLAG                      0058.000
STATRWT  EQU       8              REWRITE FLUSH FLAG                    0059.000
DEVCC    EQU       9              DEVICE IS CARRIAGE CONTROL            0060.000
DEVOUT   EQU       10             DEVICE AVAILABLE FOR OUTPUT           0061.000
DEVINP   EQU       11             DEVICE AVAILABLE FOR INPUT            0062.000
STATDEV  EQU       12             DEVICE TYPE                           0063.000
STATLOK  EQU       16             LOCKED FILE                           0064.000
STATEOF  EQU       17             FILE AT END-OF-FILE                   0065.000
STATOPN  EQU       18             FILE IS OPEN                          0066.000
STATREV  EQU       19             FILE IS REVERSED                      0067.000
STATINP  EQU       20             FILE IS INPUT                         0068.000
STATOUT  EQU       21             FILE IS OUTPUT                        0069.000
STATALT  EQU       22             ALTERNATE BUFFER AVAILABLE            0070.000
STATRED  EQU       23             OPERATION IS READ                     0071.000
STATNOR  EQU       24             NO REWIND                             0072.000
STATEXT  EQU       25             EXTEND OPERATION                      0073.000
STATDALC EQU       26             DEVICE DEALLOCATED FLAG               0074.000
SHORTBLK EQU       8              SHORT BLOCK FLAG (IN VOLUME)          0075.000
*  STATUS MASKS                                                         0076.000
STATLOKM EQU       X'8000'                                              0077.000
STATEOFM EQU       X'4000'                                              0078.000
STATOPNM EQU       X'2000'                                              0079.000
STATREVM EQU       X'1000'                                              0080.000
STATINPM EQU       X'800'                                               0081.000
STATOUTM EQU       X'400'                                               0082.000
STATALTM EQU       X'200'                                               0083.000
STATREDM EQU       X'100'                                               0084.000
STATEXTM EQU       X'40'                                                0085.000
STATDLCM EQU       X'20'                                                0086.000
*                                                                       0087.000
SLO      EQU       3                                                    0088.000
*                                                                       0089.000
*                                                                       0090.000
* PICK UP PARAMETERS FROM CALL STATEMENT                                0091.000
*                                                                       0092.000
*                                                                       0093.000
C:CLSQ   EQU       $              ENTRY POINT                           0094.000
         TRR       0,3                                                  0095.000
         LW        5,0,3          CLOSE ATTRIBUTES                      0096.000
         LW        1,1W,3         FILE INFORMATION TABLE ADDRESS        0097.000
         ADI       3,2W           INCREMENT RETURN ADDRESS              0098.000
         STW       3,RTNADDR0,1   SAVE RETURN ADDRESS                   0099.000
*                                                                       0100.000
*                                                                       0101.000
* CHECK FILE STATUS                                                     0102.000
*                                                                       0103.000
*                                                                       0104.000
         TBM       STATOPN,FILSTAT,1                                    0105.000
         BCT       1,CLS010       FILE OPEN                             0106.000
         TBM       STATOPT,FILSTAT,1                                    0107.000
         BCT       1,CLS990                                             0108.000
         LI        7,G'9I'        FILE NOT OPEN ERROR                   0109.000
         BU        C:IOER                                               0110.000
*                                                                       0111.000
*                                                                       0112.000
* CHECK FOR I/O COMPLETE                                                0113.000
*                                                                       0114.000
*                                                                       0115.000
CLS010   EQU       $                                                    0116.000
         SVC       1,X'3C'                                              0117.000
*                                                                       0118.000
*                                                                       0119.000
* FLUSH BUFFER IF REQUIRED                                              0120.000
*                                                                       0121.000
*                                                                       0122.000
         LI        7,STATOUTM+STATEXTM                                  0123.000
         ANMW      7,FILSTAT,1                                          0124.000
         BZ        CLS050         NON-OUTPUT OR EXTEND, SKIP FLUSH      0125.000
         TBM       STATFLSH,FILSTAT,1                                   0126.000
         BCF       1,CLS100       FLUSH NOT REQUIRED                    0127.000
         LH        7,MAXSIZE,1    SET UP TCW FOR FLUSH                  0128.000
         MPMH      6,RECTHIS,1                                          0129.000
         ADI       7,3                                                  0130.000
         SLL       7,18                                                 0131.000
         ANMW      7,TCWMASK                                            0132.000
         ADMW      7,PBUFADDR,1                                         0133.000
         STW       7,TCW,1                                              0134.000
         LW        7,CONTSPEC,1   INCREMENT SECTOR NUMBER               0135.000
         TRR       7,6            CHECK FOR BLOCK ZERO                  0136.000
         ANMW      6,CONTMASK                                           0137.000
         BCF       4,CLS030                                             0138.000
         ADI       7,1            BLOCK ZERO,INCREMENT BY UNITY         0139.000
         BU        CLS040                                               0140.000
CLS030   EQU       $                                                    0141.000
         ADMW      7,BLOKSIZE,1                                         0142.000
CLS040   EQU       $                                                    0143.000
         STW       7,CONTSPEC,1                                         0144.000
         SVC       1,X'32'          WRITE THE RECORD                    0145.000
CLS050   EQU       $                                                    0146.000
         TBM       STATRWT,FILSTAT,1                                    0147.000
         BCF       1,CLS100       NO REWRITE REQUIRED                   0148.000
*                                                                       0149.000
* FLUSH REWRITTEN BUFFER                                                0150.000
*                                                                       0151.000
         LW        6,PBUFADDR,1                                         0152.000
         LW        7,TCW,1         TCW <- PBUFADDR FOR REWRITE          0153.000
         ANMW      7,TCWMASK                                            0154.000
         ORR       7,6                                                  0155.000
         STW       6,TCW,1                                              0156.000
         LW        7,CONTSPEC,1    SET CONTSPEC BACK                    0157.000
         SUMW      7,BLOKSIZE,1                                         0158.000
         STW       7,CONTSPEC,1                                         0159.000
         SVC       1,X'32'           REWRITE A BLOCK                    0160.000
         ZBM       STATRWT,FILSTAT,1                                    0161.000
CLS100   EQU       $                                                    0162.000
*                                                                       0163.000
*                                                                       0164.000
* UPDATE SECTOR ZERO FOR DISK                                           0165.000
*                                                                       0166.000
*                                                                       0167.000
         LI        4,X'F'         CHECK FOR DISK DEVICE                 0168.000
         ANMB      4,DIVTYPE0,1                                         0169.000
         CI        4,1                                                  0170.000
         BCF       4,CLS120       NON-DISK, SKIP UPDATE                 0171.000
         LI        7,STATOUTM+STATEXTM                                  0172.000
         ANMW      7,FILSTAT,1                                          0173.000
         BZ        CLS150         NON-OUTPUT, SKIP UNDATE               0174.000
CLS105   EQU       $                                                    0175.000
         SVC       1,X'3C'          WAIT FOR I/O COMPLETE               0176.000
         LW        3,PBUFADDR,1   GET BUFFER ADDRESS                    0177.000
         LW        7,CBSEQFL                                            0178.000
         STW       7,0,3          SEQUENTIAL FILE FLAG                  0179.000
         LW        7,CURRECNO,1                                         0180.000
         BCT       4,CLS120       NO RECORDS OUTPUT, SKIP UPDATE        0181.000
         CAMW      7,CUREOF,1                                           0182.000
         BCF       3,CLS110                                             0183.000
         LW        7,CUREOF,1                                           0184.000
CLS110   EQU       $                                                    0185.000
         STW       7,1W,3         CURRENT END-OF-FILE (RECORDS)         0186.000
         LW        7,EOFEXT,1                                           0187.000
         STW       7,2W,3         END-OF-FILE EXTENT (RECORDS)          0188.000
         LH        7,MAXSIZE,1                                          0189.000
         STW       7,3W,3         SIZE OF RECORD (BYTES)                0190.000
         LW        7,BLOKSIZE,1                                         0191.000
         STW       7,4W,3         SIZE OF A BLOCK (SECTORS)             0192.000
         LH        7,RECPER,1                                           0193.000
         STW       7,5W,3         NUMBER OF RECORDS/BLOCK               0194.000
         ADMW      3,CLSTCW       SET UP TCW FOR SECTOR ZERO            0195.000
         STW       3,TCW,1                                              0196.000
         LW        7,CONTSPEC,1   SET BLOCK NUMBER TO ZERO              0197.000
         STW       7,ADDRHOLD,1   SAVE FILE CLOSING ADDRESS             0198.000
         ANMW      7,TCWMASK                                            0199.000
         STW       7,CONTSPEC,1                                         0200.000
         SVC       1,X'32'                                              0201.000
         LW        7,ADDRHOLD,1                                         0202.000
         STW       7,CONTSPEC,1   RESTORE FILE CLOSE ADDRS              0203.000
         BU        CLS150                                               0204.000
CLS120   EQU       $                                                    0205.000
         CI        4,2                                                  0206.000
         BCF       4,CLS150                                             0207.000
*                                                                       0208.000
* DEVICE IS MAGNETIC TAPE                                               0209.000
*                                                                       0210.000
         LI        7,STATOUTM+STATEXTM                                  0211.000
         ANMW      7,FILSTAT,1                                          0212.000
         BZ        CLS125                                               0213.000
         SVC       1,X'38'          WRITE END-OF-FILE                   0214.000
CLS125   EQU       $                                                    0215.000
         ZBM       SHORTBLK,VOLUME,1                                    0216.000
         TBR       5,ATNORWD                                            0217.000
         BCT       1,CLS150       NO REWIND, BYPASS IT                  0218.000
         SVC       1,X'37'          ELSE, REWIND                        0219.000
*                                                                       0220.000
* SYSTEM CLOSE THE FILE                                                 0221.000
*                                                                       0222.000
CLS150   EQU       $                                                    0223.000
**                                                                      0224.000
         SVC       1,X'39'          CLOSE THE FILE                      0225.000
         LB        6,SYSFILCD,1   LOAD SYSTEM FILE CODE                 0226.000
         BZ        CLS155         CHECK SYSTEM FILE CLOSE               0227.000
* DE-ALLOCATE IF SYSTEM FILE                                            0228.000
         TRR       5,3                                                  0229.000
         LW        5,LOGFILCD,1                                         0230.000
* Note the compatability update                                         0231.000
         TRR       5,1                                                  0232.000
         ZR        7                                                    0233.000
         SVC       2,X'53'                                              0234.000
*        SVC       1,X'41'                                              0235.000
         CI        6,SLO                                                0236.000
         BLT       CLS155                                               0237.000
         SBM       STATDALC,FILSTAT,1                                   0238.000
         TRR       3,5                                                  0239.000
* CHECK IF DEVICE TAPE                                                  0240.000
CLS155   EQU       $                                                    0241.000
         CI        4,2                                                  0242.000
         BCF       4,CLS170                                             0243.000
* ISSUE 'DISMOUNT TAPE' MESSAGE FOR MULTI-REEL TAPES                    0244.000
         LB        7,DIVSTAT2+3,1 LOAD VOLUME NUMBER                    0245.000
         BZ        CLS170         BRANCH IF SINGLE-REEL                 0246.000
         TBR       5,ATNORWD                                            0247.000
         BCT       1,CLS170       NO REWIND, BYPASS IT                  0248.000
         TRR       5,3            SAVE CLOSE ATTR'S                     0249.000
         LW        5,LOGFILCD,1   LOAD LOGICAL FILE CODE                0250.000
         SLL       5,8            CLEAR BYTE 0                          0251.000
         SRL       5,8                                                  0252.000
         SBR       5,0            INDICATE NO ACTUAL DEALLOCATION       0253.000
** Note the compatability update                                        0254.000
         TRR       5,1                                                  0255.000
         ZR        7                                                    0256.000
         SVC       2,x'53'                                              0257.000
*        SVC       1,X'41'          ISSUE 'DISMOUNT TAPE' MESSAGE       0258.000
         SBM       STATDALC,FILSTAT,1                                   0259.000
         TRR       3,5            RESTORE CLOSE ATTR'S                  0260.000
CLS170   EQU       $                                                    0261.000
         ZMW       CURRECNO,1                                           0262.000
         ZBM       STATOPN,FILSTAT,1 TURN OFF OPEN                      0263.000
CLS175   EQU       $                                                    0264.000
         ZBM       STATEOF,FILSTAT,1                                    0265.000
         TBR       5,ATCLWLCK      CHECK FOR CLOSE W/LOCK               0266.000
         BCF       1,CLS990                                             0267.000
         SBM       STATLOK,FILSTAT,1 LOCK FILE                          0268.000
CLS990   EQU       $                                                    0269.000
         LI        7,G'00'        RESET COBOL STATUS                    0270.000
         BL        C:LDST                                               0271.000
         BU        *RTNADDR0,1    RETURN                                0272.000
TCWMASK  DATAW     X'FFF00000'                                          0273.000
CONTMASK DATAW     X'FFFFF'                                             0274.000
CLSTCW   DATAW     X'600000'                                            0275.000
CBSEQFL  DATAW     X'F0FFF0FF'                                          0276.000
         END                                                            0277.000
