* SEQUENTIAL I/O READ FOR MPX ONLY                      HEADER  C:RDSQM 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
*                                                                       0023.000
         M.PGM     C:RDSQ,MPX-32,3.6.1,00                               0024.000
************************************************************************0025.000
*                                                                       0026.000
*        MPX-32 REVISION 3 RELEASE 3.5U02 CHANGE HISTORY                0027.000
*                                                                       0028.000
************************************************************************0029.000
*        VERSION 3.5U02A.01 BL4                                         0030.000
*                                                                       0031.000
*        E3RMS35   06/09/92 11464 ADDED CODE TO SUPPORT SORTING E3RMS35 0032.000
*                  OF REMOTE FILES                              E3RMS35 0033.000
*                                                                       0034.000
************************************************************************0035.000
*                                                                       0036.000
*                                                                       0037.000
         LIST      NODATA,NOMAC                                         0038.000
         DEF       C:RDSQ                                               0039.000
         EXT       C:LDST                                               0040.000
         EXT       C:BFSW                                               0041.000
         EXT       C:IOER                                               0042.000
*  READ SEQUENTIAL ATTRIBUTES                                           0043.000
ATRATEND EQU       31             AT END ATTRIBUTE                      0044.000
*  FIT MAPPING                                                          0045.000
INSEQTBL EQU       -32            INPUT COLLATING SEQUENCE TABLE        0046.000
OUTSQTBL EQU       -28            OUTPUT COLLATING SEQUENCE TABLE       0047.000
ERRORETN EQU       -24            ERROR RETURN JET                      0048.000
LINESUBR EQU       -16            LINAGE SETUP SUBROUTINE ADDRESS       0049.000
DDRELKEY EQU       -12            DDA OF RELATIVE KEY                   0050.000
LINETABL EQU       -12            LINAGE TABLE ADDRESS                  0051.000
STATFLD  EQU       -8             DDA STATUS FIELD                      0052.000
ATENDRTN EQU       -4             AT-END CONDITION RETURN               0053.000
LOGFILCD EQU       0              LOGICAL FILE CODE                     0054.000
TCW      EQU       4              ADDRESS OF RECORD AREA                0055.000
CONTSPEC EQU       8              CONTROL SPECIFICATIONS                0056.000
IOSTAT   EQU       12             CURRENT SYSTEM STATUS                 0057.000
RECSIZE  EQU       16             RECORD SIZE IN BYTES                  0058.000
BUFFADDR EQU       20             ADDRESS OF BLOCKING BUFFER            0059.000
ERRORADR EQU       24             IOCS ERROR RETURN ADDRESS             0060.000
FILSTAT  EQU       32             CURRENT FILE STATUS                   0061.000
DIVTYPE0 EQU       33             TYPE OF PHYSICAL DEVICE               0062.000
BITSTAT  EQU       34             BIT STATUS                            0063.000
STATERR0 EQU       35             CURRENT ERROR STATUS                  0064.000
RECLOC   EQU       36             ACTUAL DATA RECORD LOCATION           0065.000
BLOKSIZE EQU       40             BUFFER BLOCK SIZE                     0066.000
PBUFADDR EQU       44             PRIMARY BUFFER ADDRESS                0067.000
ABUFADDR EQU       48             ALTERNATE BUFFER ADDRESS              0068.000
BUFFPTR  EQU       52             BUFFER RECORD POINTER                 0069.000
RECPER   EQU       56             RECORDS PER BUFFER                    0070.000
RECTHIS  EQU       58             RECORDS THIS BUFFER                   0071.000
CUREOF   EQU       60             CURRENT END-OF-FILE                   0072.000
EOFEXT   EQU       64             END-OF-FILE EXTENT                    0073.000
CURRECNO EQU       68             CURRENT RECORD NUMBER                 0074.000
RTNADDR0 EQU       72             RETURN ADDRESS FOR I/O CALL           0075.000
DIVSTAT0 EQU       76             DEVICE STATUS FROM R5                 0076.000
DIVSTAT1 EQU       80             DEVICE STATUS FROM R6                 0077.000
DIVSTAT2 EQU       84             DEVICE STATUS FROM R7                 0078.000
SYSFILCD EQU       86             SYSTEM FILE CODE                      0079.000
ADVANCE  EQU       88             LINES FOR PRINTER ADVANCE             0080.000
VOLUME   EQU       88             ORIGINAL TAPE VOLUME NUMBER           0081.000
SIZE     EQU       92             RECORD SIZE FOR VARIABLE LENGTH       0082.000
MAXSIZE  EQU       94             SIZE OF AN I/O TRANSFER RECORD        0083.000
ADDRHOLD EQU       96             RECORD ADDRESS TEMPORARY HOLD AREA    0084.000
*  FILE STATUS FLAGS                                                    0085.000
STATOR0  EQU       1              FILE ORGANIZATION LOW ORDER BIT       0086.000
STATOR1  EQU       0              FILE ORGANIZATION HIGH ORDER BIT      0087.000
STATAC0  EQU       3              ACCESS MODE LOW ORDER BIT             0088.000
STATAC1  EQU       2              ACCESS MODE HIGH ORDER BIT            0089.000
STATOPT  EQU       4              OPTIONAL FILE                         0090.000
STATVAR  EQU       5              VARIABLE RECORDS IN FILE              0091.000
STATIO   EQU       6              FILE IS INPUT-OUTPUT                  0092.000
STATFLSH EQU       7              FLUSH RQR'D FLAG                      0093.000
STATRWT  EQU       8              REWRITE FLUSH FLAG                    0094.000
DEVCC    EQU       9              DEVICE IS CARRIAGE CONTROL            0095.000
DEVOUT   EQU       10             DEVICE AVAILABLE FOR OUTPUT           0096.000
DEVINP   EQU       11             DEVICE AVAILABLE FOR INPUT            0097.000
STATDEV  EQU       12             DEVICE TYPE                           0098.000
STATLOK  EQU       16             LOCKED FILE                           0099.000
STATEOF  EQU       17             FILE AT END-OF-FILE                   0100.000
STATOPN  EQU       18             FILE IS OPEN                          0101.000
STATREV  EQU       19             FILE IS REVERSED                      0102.000
STATINP  EQU       20             FILE IS INPUT                         0103.000
STATOUT  EQU       21             FILE IS OUTPUT                        0104.000
STATALT  EQU       22             ALTERNATE BUFFER AVAILABLE            0105.000
STATRED  EQU       23             OPERATION IS READ                     0106.000
STATNOR  EQU       24             NO REWIND                             0107.000
STATEXT  EQU       25             EXTEND OPERATION                      0108.000
STATDALC EQU       26             DEVICE DEALLOCATED FLAG               0109.000
SHORTBLK EQU       8              SHORT BLOCK FLAG (IN VOLUME)          0110.000
*  STATUS MASKS                                                         0111.000
STATLOKM EQU       X'8000'                                              0112.000
STATEOFM EQU       X'4000'                                              0113.000
STATOPNM EQU       X'2000'                                              0114.000
STATREVM EQU       X'1000'                                              0115.000
STATINPM EQU       X'800'                                               0116.000
STATOUTM EQU       X'400'                                               0117.000
STATALTM EQU       X'200'                                               0118.000
STATREDM EQU       X'100'                                               0119.000
STATEXTM EQU       X'40'                                                0120.000
STATDLCM EQU       X'20'                                                0121.000
*                                                                       0122.000
*                                                                       0123.000
* PICK UP PARAMETERS FROM CALL STATEMENT                                0124.000
*                                                                       0125.000
*                                                                       0126.000
C:RDSQ   EQU       $              ENTRY POINT                           0127.000
         TRR       0,3                                                  0128.000
         LW        5,0,3          READ ATTRIBUTES                       0129.000
         LW        1,1W,3         FILE INFORMATION TABLE ADDRESS        0130.000
         TBR       5,ATRATEND                                           0131.000
         BCF       1,RED010       NO AT-END BRANCH ADDRESS              0132.000
         TRR       3,2                                                  0133.000
         ADI       2,2W           UPDATE AT-END RETURN ADDRESS          0134.000
         ADI       3,4W           FETCH NORMAL RETURN                   0135.000
         BU        RED020                                               0136.000
RED010   EQU       $                                                    0137.000
         ADI       3,2W           UPDATE NORMAL RETURN                  0138.000
         ZR        2                                                    0139.000
RED020   EQU       $                                                    0140.000
         STW       2,ATENDRTN,1                                         0141.000
         STW       3,RTNADDR0,1   SAVE RETURN ADDRESS                   0142.000
*                                                                       0143.000
*                                                                       0144.000
* CHECK FILE STATUS                                                     0145.000
*                                                                       0146.000
*                                                                       0147.000
         TBM       STATOPN,FILSTAT,1                                    0148.000
         BCT       1,RED040       FILE OPEN                             0149.000
         TBM       STATOPT,FILSTAT,1                                    0150.000
         BCT       1,RED052       FILE OPTIONAL                         0151.000
         LI        7,G'9L'        FILE NOT OPEN ERROR                   0152.000
         BU        C:IOER                                               0153.000
RED040   EQU       $                                                    0154.000
         TBM       STATINP,FILSTAT,1                                    0155.000
         BCT       1,RED050       FILE IS INPUT                         0156.000
         TBM       STATIO,FILSTAT,1                                     0157.000
         BCT       1,RED050       FILE IS INPUT-OUTPUT                  0158.000
         LI        7,G'9M'        FILE NOT INPUT ERROR                  0159.000
         BU        C:IOER                                               0160.000
RED050   EQU       $                                                    0161.000
         TBM       STATEOF,FILSTAT,1                                    0162.000
*        BCF       1,RED060        NOT AT END-OF-FILE           E3RMS35 0163.000
         BCF       1,RED200        NOT AT END OF FILE           E3RMS35 0164.000
RED052   EQU       $                                                    0165.000
         LI        7,G'10'        ATTEMPT TO READ PAST EOF              0166.000
         BU        C:IOER                                               0167.000
*                                                                       0168.000
*                                                                       0169.000
* HANDLE OPERATION BY DEVICE                                            0170.000
*                                                                       0171.000
*                                                                       0172.000
         BOUND     4                                                    0173.000
RED060   EQU       $                                                    0174.000
         LI        6,X'F'         CHECK DEVICE TYPE                     0175.000
         ANMH      6,FILSTAT,1                                          0176.000
         CI        6,4                                                  0177.000
         BCF       4,RED200                                             0178.000
*                                                                       0179.000
* DEVICE IS A CARD READER                                               0180.000
*                                                                       0181.000
RED100   EQU       $                                                    0182.000
* READ NEXT RECORD                                                      0183.000
         SVC       1,X'3C'                                              0184.000
         LW        7,MAXSIZE,1                                          0185.000
         SLL       7,20                                                 0186.000
         SBR       7,12                                                 0187.000
         ORMW      7,PBUFADDR,1                                         0188.000
         STW       7,TCW,1                                              0189.000
         SVC       1,X'31'                                              0190.000
* MOVE RECORD UPDATE TO RECORD                                          0191.000
         SVC       1,X'3C'                                              0192.000
         TBM       6,IOSTAT,1     TEST END-OF-FILE                      0193.000
         BCF       1,RED120                                             0194.000
         SBM       STATEOF,FILSTAT,1                                    0195.000
         BU        RED052                                               0196.000
RED120   EQU       $                                                    0197.000
         LW        3,PBUFADDR,1   SET UP PARAMETERS FOR RECORD MOVE     0198.000
         LW        2,RECLOC,1                                           0199.000
         TRR       3,4                                                  0200.000
         ADMH      4,MAXSIZE,1                                          0201.000
         BL        C:TRBR         TRANSFER BUFFER TO RECORD             0202.000
         ABM       7,CURRECNO+3,1 UPDATE RECORD NUMBER                  0203.000
         BU        RED990                                               0204.000
*RED200  EQU       $                                            E3RMS25 0205.000
*        CI        6,1                                          E3RMS35 0206.000
*        BCF       4,RED300                                     E3RMS35 0207.000
*                                                                       0208.000
* DEVICE IS A DISK                                                      0209.000
*                                                                       0210.000
RED200   CEQU      $                                            E3RMS35 0211.000
         LB        7,SYSFILCD,1   CHECK SYC OR SGO FILE                 0212.000
         BNZ       RED270                                               0213.000
         LH        6,RECPER,1     CHECK FOR BUFFER EMPTY                0214.000
         CAMH      6,RECTHIS,1                                          0215.000
         BCF       4,RED250       NOT EMPTY, SKIP PHYSICAL READ         0216.000
         SVC       1,X'3C'          CHECK I/O COMPLETE                  0217.000
         TBM       7,IOSTAT,1                                           0218.000
         BCF       1,RED205                                             0219.000
         LI        7,G'32'        DISK READ BOUNDARY ERR                0220.000
         BU        C:IOER                                               0221.000
RED205   EQU       $                                                    0222.000
         TBM       STATRWT,FILSTAT,1    TEST CURRENT BUFFER RE-WRITTEN  0223.000
         BCF       1,RED240                                             0224.000
*                                                                       0225.000
* FLUSH REWRITTEN BUFFER                                                0226.000
*                                                                       0227.000
RED230   EQU       $                                                    0228.000
         LW        6,PBUFADDR,1                                         0229.000
         LW        7,TCW,1         TCW <- PBUFADDR FOR REWRITE          0230.000
         ANMW      7,QUANMASK                                           0231.000
         ORR       7,6                                                  0232.000
         STW       6,TCW,1                                              0233.000
         LW        7,CONTSPEC,1    SET DISK ADDRESS BACK                0234.000
         SUMW      7,BLOKSIZE,1                                         0235.000
         STW       7,CONTSPEC,1                                         0236.000
         SVC       1,X'32'           REWRITE A BLOCK                    0237.000
         ZBM       STATRWT,FILSTAT,1                                    0238.000
RED235   EQU       $                                                    0239.000
         SVC       1,X'3C'                                              0240.000
         LW        7,BLOKSIZE,1   RESET DISK ADDRESS                    0241.000
         ARMW      7,CONTSPEC,1                                         0242.000
RED240   EQU       $                                                    0243.000
         LW        7,BLOKSIZE,1   INCREMENT SECTOR NUMBER               0244.000
         ARMW      7,CONTSPEC,1                                         0245.000
         BL        C:BFSW         SWAP BUFFER POINTERS                  0246.000
***      TBM       STATREV,FILSTAT,1                                    0247.000
***      BCF       1,RED245       NOT A REVERSED FILE                   0248.000
***      LH        5,MAXSIZE,1                                          0249.000
***      MPMH      4,RECPER,1                                           0250.000
***      ADR       5,7                                                  0251.000
***      STW       7,BUFFPTR,1    RESET BUFFER RECORD POINTER           0252.000
RED245   EQU       $                                                    0253.000
         LW        7,TCW,1        SET UP TCW                            0254.000
         ANMW      7,QUANMASK                                           0255.000
         ORR       7,6                                                  0256.000
         STW       6,TCW,1                                              0257.000
         SVC       1,X'31'                                              0258.000
         ZMH       RECTHIS,1      RESET RECORDS THIS BUFFER COUNTER     0259.000
* TRANSFER RECORD FROM BUFFER                                           0260.000
RED250   EQU       $                                                    0261.000
         LW        2,RECLOC,1     SET UP PARAMETERS FOR RECORD MOVE     0262.000
         LW        3,BUFFPTR,1                                          0263.000
         TRR       3,4                                                  0264.000
***      TBM       STATREV,FILSTAT,1                                    0265.000
***      BCF       1,RED257       NOT A REVERSED FILE                   0266.000
***      SUMH      4,MAXSIZE,1                                          0267.000
***      ADMH      2,MAXSIZE,1                                          0268.000
RED255   EQU       $                                                    0269.000
***      SUI       2,1            MOVE RECORD FOR REVERSED FILES        0270.000
***      SUI       3,1                                                  0271.000
***      LB        6,0,3                                                0272.000
***      STB       6,0,2                                                0273.000
***      CAR       3,4                                                  0274.000
***      BCF       4,RED255                                             0275.000
***      BU        RED265                                               0276.000
RED257   EQU       $                                                    0277.000
         ADMH      4,MAXSIZE,1                                          0278.000
         BL        C:TRBR         TRANSFER BUFFER TO RECORD             0279.000
RED265   EQU       $                                                    0280.000
         STW       4,BUFFPTR,1    UPDATE BUFFER POINTER                 0281.000
         ABM       7,RECTHIS+1,1  INCREMENT RECORDS THIS BUFFER COUNTER 0282.000
         SBM       STATRED,FILSTAT,1 SET LAST OPERATION AS READ         0283.000
         ABM       7,CURRECNO+3,1 INCREMENT RECORD NUMBER               0284.000
         LW        6,CURRECNO,1   CHECK FOR END-OF-FILE                 0285.000
         CAMW      6,CUREOF,1                                           0286.000
         BCF       4,RED990                                             0287.000
         SBM       STATEOF,FILSTAT,1 END-OF-FILE, SET STATUS            0288.000
      BU        RED990                                                  0289.000
* SPECIAL HANDLING FOR SYC OR SGO FILES                                 0290.000
RED270   EQU       $                                                    0291.000
         SVC       1,X'3C'          CHECK I/O COMPLETE                  0292.000
         TBM       6,IOSTAT,1     TEST END OF FILE                      0293.000
         BCF       1,RED275                                             0294.000
         SBM       STATEOF,FILSTAT,1                                    0295.000
         BU        RED052                                               0296.000
RED275   EQU       $                                                    0297.000
         LW        2,RECLOC,1                                           0298.000
         LW        3,ABUFADDR,1                                         0299.000
         TRR       3,4                                                  0300.000
         ADMH      4,MAXSIZE,1                                          0301.000
         BL        C:TRBR                                               0302.000
         ABM       7,CURRECNO+3,1                                       0303.000
         SVC       1,X'31'          READ NEXT RECORD                    0304.000
         BU        RED990                                               0305.000
RED300   EQU       $                                                    0306.000
         CI        6,2                                                  0307.000
         BCF       4,RED400                                             0308.000
*                                                                       0309.000
* DEVICE IS MAGNETIC TAPE                                               0310.000
*                                                                       0311.000
         LW        7,CURRECNO,1                                         0312.000
         BNZ       RED330                                               0313.000
RED310   EQU       $                                                    0314.000
         SVC       1,X'3C'          CHECK FOR I/O COMPLETE              0315.000
* PRIME INPUT BUFFER                                                    0316.000
         LW        6,BLOKSIZE,1                                         0317.000
         SLL       6,20                                                 0318.000
         SBR       6,12                                                 0319.000
         ADMW      6,ABUFADDR,1                                         0320.000
         STW       6,TCW,1                                              0321.000
         SVC       1,X'31'                                              0322.000
         ZMH       RECTHIS,1                                            0323.000
RED315   EQU       $                                                    0324.000
         SVC       1,X'3C'          CHECK FOR I/O COMPLETE              0325.000
         TBM       6,IOSTAT,1      TEST END-OF-FILE                     0326.000
         BCF       1,RED320                                             0327.000
         SBM       STATEOF,FILSTAT,1                                    0328.000
         BU        RED052                                               0329.000
RED320   EQU       $                                                    0330.000
* THE FOLLOWING INSTRUCTION IS DIFFERENT FROM C:RDSQR FOR RTM!!!        0331.000
* THIS IS C:RDSQM, IT IS TO BE USED IN THE MPX COBOL LIBRARY            0332.000
* THERE IS A CORRESPONDING C:RDSQR FOR RTM COBOL                        0333.000
         LW        7,RECSIZE,1          PICK UP SIZE WRD 4 FCB MPX      0334.000
*************************************************************           0335.000
         CAMW      7,BLOKSIZE,1                                         0336.000
         BCF       2,RED322        TEST TAPE RECORD TOO LARGE           0337.000
         LI        7,G'9K'                                              0338.000
         BU        C:IOER                                               0339.000
RED322   EQU       $                                                    0340.000
         TBM       STATVAR,FILSTAT,1    TEST VARIABLE-LENGTH RECORDS    0341.000
         BCF       1,RED325                                             0342.000
         STH       7,SIZE,1                                             0343.000
         LI        7,1             FORCE RECORDS PER BLOCK TO 1         0344.000
         STH       7,RECPER,1                                           0345.000
         BU        RED329                                               0346.000
* FIXED-LENGTH BLOCK                                                    0347.000
RED325   EQU       $                                                    0348.000
         TBM       SHORTBLK,VOLUME,1    PREVIOUS BLOCK SHORT?           0349.000
         BCF       1,RED327                                             0350.000
         LI        7,G'9D'        SHORT BLOCK ERROR                     0351.000
         BU        C:IOER                                               0352.000
RED327   EQU       $                                                    0353.000
         CAMW      7,BLOKSIZE,1   TEST RECORD SHORT                     0354.000
         BCF       3,RED328                                             0355.000
         SBM       SHORTBLK,VOLUME,1                                    0356.000
* FIX SP 21-09-79 TO ALLOW SHT BLK AS ONLY BLK                          0357.000
         LI        5,G'AA'         TEMP FLAG FOR LTR TEST               0358.000
RED328   EQU       $                                                    0359.000
         ZR        6                                                    0360.000
         DVMH      6,MAXSIZE,1                                          0361.000
         STH       7,RECPER,1                                           0362.000
RED329   EQU       $                                                    0363.000
***      TBM       STATALT,FILSTAT,1                                    0364.000
***      BCF       1,RED330                                             0365.000
         LH        7,RECPER,1                                           0366.000
         STH       7,RECTHIS,1     FORCE END OF BUFFER                  0367.000
* PERFORM LOGICAL READ                                                  0368.000
RED330   EQU       $                                                    0369.000
         LH        6,RECPER,1      CHECK FOR USED-UP BUFFER             0370.000
         CAMH      6,RECTHIS,1                                          0371.000
         BCF       4,RED360        NO,SKIP PHYSICAL READ                0372.000
RED335   EQU       $                                                    0373.000
         SVC       1,X'3C'                                              0374.000
         TBM       6,IOSTAT,1      TEST END-OF-FILE                     0375.000
         BCF       1,RED340                                             0376.000
         SBM       STATEOF,FILSTAT,1                                    0377.000
         BU        RED052                                               0378.000
RED340   EQU       $                                                    0379.000
* THE FOLLOWING INSTRUCTION IS DIFFERENT FROM C:RDSQR FOR RTM!!!        0380.000
* THIS IS C:RDSQM, IT IS TO BE USED IN THE MPX COBOL LIBRARY            0381.000
* THERE IS A CORRESPONDING C:RDSQR FOR RTM COBOL                        0382.000
         LW        7,RECSIZE,1          PICK UP SIZE WRD 4 FCB MPX      0383.000
*************************************************************           0384.000
         CAMW      7,BLOKSIZE,1                                         0385.000
         BCF       2,RED342                                             0386.000
         LI        7,G'9K'         TAPE RECORD TOO LARGE                0387.000
         BU        C:IOER                                               0388.000
RED342   EQU       $                                                    0389.000
         TBM       STATVAR,FILSTAT,1                                    0390.000
         BCF       1,RED345                                             0391.000
         STH       7,SIZE,1        VAR LENGTH RECORD SIZE               0392.000
         BU        RED350                                               0393.000
* FIXED-LENGTH BLOCK                                                    0394.000
RED345   EQU       $                                                    0395.000
         TBM       SHORTBLK,VOLUME,1    PREVIOUS BLOCK SHORT?           0396.000
         BCF       1,RED347                                             0397.000
* SFP 21-09-79 FIX TO ALLOW SHT BLK AS ONLY BLK                         0398.000
         CI        5,G'AA'         WAS SHT BLK 1ST BLK                  0399.000
         BCT       4,RED347        YES DO NOT ABORT YET....             0400.000
         LI        7,G'9D'        SHORT BLOCK ERROR                     0401.000
         BU        C:IOER                                               0402.000
RED347   EQU       $                                                    0403.000
         CAMW      7,BLOKSIZE,1   TEST RECORD SHORT                     0404.000
         BCF       3,RED348                                             0405.000
         SBM       SHORTBLK,VOLUME,1                                    0406.000
RED348   EQU       $                                                    0407.000
         ZR        6                                                    0408.000
         DVMH      6,MAXSIZE,1                                          0409.000
         STH       7,RECPER,1      RECPER <- PARTIAL BUFFER SIZE        0410.000
RED350   EQU       $                                                    0411.000
         BL        C:BFSW         SWITCH BUFFER POINTERS                0412.000
         LW        7,BLOKSIZE,1                                         0413.000
         SLL       7,20                                                 0414.000
         SBR       7,12                                                 0415.000
         ORR       7,6                                                  0416.000
         STW       6,TCW,1                                              0417.000
         SVC       1,X'31'                                              0418.000
         ZMH       RECTHIS,1                                            0419.000
* MOVE RECORD UPDATE TO RECORD                                          0420.000
RED360   EQU       $                                                    0421.000
         LW        2,RECLOC,1                                           0422.000
         LW        3,BUFFPTR,1                                          0423.000
         TRR       3,4                                                  0424.000
         ADMH      4,SIZE,1                                             0425.000
         BL        C:TRBR         TRANSFER BUFFER -> RECORD             0426.000
         STW       4,BUFFPTR,1    UPDATE BUFFER PTR                     0427.000
         ABM       7,RECTHIS+1,1  INCREMENT RECORDS THIS BUFFER         0428.000
         ABM       7,CURRECNO+3,1                                       0429.000
         BU        RED990                                               0430.000
*                                                                       0431.000
* TRANSFER RECORD UTILITY                                               0432.000
*                                                                       0433.000
* R1 - FIT ADDRESS                                                      0434.000
* R2 - RECORD LOC                                                       0435.000
* R3 - CURRENT BUFFER PTR                                               0436.000
* R4 - R3 + TRANSFER SIZE                                               0437.000
*                                                                       0438.000
*                                                                       0439.000
C:TRBR   EQU       $              TRANSFER BUFFER TO RECORD             0440.000
*                                                                       0441.000
         LW        5,INSEQTBL,1   CHECK FOR INPUT SEQUENCE TBL          0442.000
         BZ        TBR020                                               0443.000
* TRANSLATE RECORD TO NATIVE CHARACTER CODE-SET                         0444.000
         TRR       1,7            SAVE FIT PTR                          0445.000
TBR010   EQU       $                                                    0446.000
         TRR       5,1                                                  0447.000
         LB        6,0,3          LOAD BUFFER CHARACTER                 0448.000
         ADR       6,1            OFFSET INTO INPUT SEQUENCE TABLE      0449.000
         LB        6,0,1          LOAD TRANSLATED CHARACTER             0450.000
         STB       6,0,2                                                0451.000
         ABR       2,31                                                 0452.000
         ABR       3,31                                                 0453.000
         CAR       3,4                                                  0454.000
         BCF       4,TBR010                                             0455.000
         TRR       7,1            RESTORE FIT PTR                       0456.000
         TRSW      0                                                    0457.000
* TRANSFER W/O TRANSLATION                                              0458.000
TBR020   EQU       $                                                    0459.000
         LB        6,0,3          MOVE RECORD TO RECORD AREA            0460.000
         STB       6,0,2                                                0461.000
         ABR       2,31                                                 0462.000
         ABR       3,31                                                 0463.000
         CAR       3,4                                                  0464.000
         BCF       4,TBR020                                             0465.000
         TRSW      0                                                    0466.000
*                                                                       0467.000
RED400   EQU       $                                                    0468.000
RED990   EQU       $                                                    0469.000
         LI        7,G'00'        RESET COBOL STATUS                    0470.000
         BL        C:LDST                                               0471.000
         BU        *RTNADDR0,1    RETURN                                0472.000
CONTMASK DATAW     X'FFFFF'                                             0473.000
QUANMASK DATAW     X'FFF00000'                                          0474.000
         END                                                            0475.000
