*DECK SUBSCIO                                                           000130
          IDENT  SUBSCIO                                                000140
          ENTRY  CLSESB                                                 000150
          ENTRY  DDLCLNL                                                000160
          ENTRY  DDLOPNL                                                000170
          ENTRY  DDLRDSB                                                000180
          ENTRY  DDLRTNL                                                000190
          ENTRY  DDLRTSB                                                000200
          ENTRY  EXTSB                                                  000210
          ENTRY  GETENT                                                 000220
          ENTRY  NEWFILE                                                000230
          ENTRY  OPENSB                                                 000240
          ENTRY  OPENZZ                                                 000250
          ENTRY  OSNAME                                                 000260
          ENTRY  PUTENT                                                 000270
          ENTRY  RETNZZ                                                 000280
          EXT    CKEOF                                                  000290
          EXT    NEWLIB                                                 000300
          EXT    SBLFN                                                  000310
          IPARAMS                                                       000320
                                                                        000330
                                                                        000340
************************************************************************000350
*                                                                      *000360
*     OPEN THE SUB-SCHEMA FILE                                         *000370
*                                                                      *000380
************************************************************************000390
 OPENSB   EQ   *+1S17                                                   000400
          SA3    SBLFN             GET THE SUB-SCHEMA LFN               000410
          BX6    X3                STORE NAME IN FIT                    000420
          SA6    SUBLIB            AT SUBLIB                            000430
          SA6    NAMSTOR           END OF INFORMATION (EOI)             000440
          OPENM  SUBLIB,I-O,R                                           000450
          SA2    STSPAR                                                 000460
          MX6    36                                                     000470
          BX6    X6*X2                                                  000480
          SA6    X2                ZERO THE RECALL BIT                  000490
          SYSTEM STS,RECALL,STSPAR,3S6 CALL STS, FUNCTION 3             000500
          SA1    STSPAR+2          PICK UP PRU COUNT                    000510
          LX1    6                 MULTIPLY BY 64                       000520
          BX6    X1                                                     000530
          SA6    NEWFILE                                                000540
          EQ   OPENSB                                                   000550
                                                                        000560
                                                                        000570
************************************************************************000580
*                                                                      *000590
*      DDLRDSB (WORKING STORAGE AREA, NUMBER OF WORDS, WORD ADDRESS)   *000600
*              READ THE SUB-SCHEMA LIBRARY FILE                        *000610
*                                                                      *000620
************************************************************************000630
 DDLRDSB  EQ   *+1S17                                                   000640
          SA2    A1+1              GET ADDRESS OF NUMBER OF WORDS       000650
          SA2    X2                  TO BE READ                         000660
          SA4    A1+2              GET WORD ADDRESS OF READ             000670
          SA3    X4                                                     000680
          SA1    X1                                                     000690
          SX5    X2                                                     000700
          LX2    3                 CONVERT THE NUMBER                   000710
          LX5    1                   OF WORDS TO NUMBER                 000720
          IX2    X5+X2               OF CHARACTERS                      000730
          GET    SUBLIB,X1,X2,,X3                                       000740
          EQ   DDLRDSB                                                  000750
                                                                        000760
                                                                        000770
************************************************************************000780
*                                                                      *000790
*      DDLRTSB (WORKING STORAGE AREA, NUMBER OF WORDS, WORD ADDRESS)   *000800
*              WRITE THE SUB-SCHEMA LIBRARY FILE                       *000810
*                                                                      *000820
************************************************************************000830
 DDLRTSB  EQ   *+1S17                                                   000840
          SA2    X1                GET ADDRESS OF NUMBER OF WORDS       000850
          SA4    A1+1                TO BE WRITTEN                      000860
          SA4    X4                                                     000870
          SA5    A1+2              GET WORD ADDRESS OF WRITE            000880
          SA5    X5                                                     000890
          SX3    X4                                                     000900
          LX4    3                 CONVERT THE NUMBER                   000910
          LX3    1                   OF WORDS TO NUMBER                 000920
          IX3    X4+X3               OF CHARACTERS                      000930
          PUT    SUBLIB,X2,X3,,X5                                       000940
          EQ   DDLRTSB                                                  000950
                                                                        000960
                                                                        000970
************************************************************************000980
*                                                                      *000990
*      CLSESB - CLOSE THE SUB-SCHEMA FILE                              *001000
*                                                                      *001010
************************************************************************001020
 CLSESB   EQ   *+1S17                                                   001030
          CLOSEM SUBLIB,N    CLOSE THE SUB-SCHEMA FILE.                 001040
          EQ   CLSESB                                                   001050
                                                                        001060
                                                                        001070
************************************************************************001080
*                                                                      *001090
*     EXTEND THE FILE                                                  *001100
*                                                                      *001110
************************************************************************001120
 EXTSB    EQ   *+1S17                                                   001130
          IFC    EQ,$"OS.NAME"$SCOPE $  COMPARE STRING FOR O.S.         001140
          SA1    X1                THE FOLLOWING CODE IS FOR NOS/BE     001150
          MX0    42D                                                    001160
          BX6    X0*X1                                                  001170
          SA6    FDB                                                    001180
          PERM   FDB,RC                                                 001190
          SA1    FDB                                                    001200
          LX1    59-13                                                  001210
          NG   X1,EXTSB                                                 001220
          EXTEND FDB                                                    001230
          ENDIF                                                         001240
          EQ   EXTSB               NOS WILL AUTOMATICALLY EXT FILE      001250
                                                                        001260
                                                                        001270
************************************************************************001280
*                                                                      *001290
*     INITIAL THE NEW SUB-SCHEMA LIBRARY FILE FLAG                     *001300
*                                                                      *001310
************************************************************************001320
 INITSB   EQ   *+1S17                                                   001330
          SX7    1                                                      001340
          SA7    NEWFILE                                                001350
          EQ   INITSB                                                   001360
                                                                        001370
                                                                        001380
************************************************************************001390
*                                                                      *001400
*      OPENZZ - OPEN THE SCRATCH FILE                                  *001410
*                                                                      *001420
************************************************************************001430
 OPENZZ   EQ   *+1S17                                                   001440
          OPENM  SCRATCH,I-O,R                                          001450
          EQ   OPENZZ                                                   001460
                                                                        001470
                                                                        001480
************************************************************************001490
*                              *  G E T E N T  *                       *001500
*                                                                      *001510
*  GETENT (WORKING STORAGE AREA, NUMBER OF WORDS, WORD ADDRESS)        *001520
*  ENTRY CONDITIONS:                                                   *001530
*         THE ADDRESS OF THE WORKING STORAGE AREA WHERE THE RECORD IS  *001540
*         TO BE PLACED AND THE WORD ADDRESS WHERE THE READING          *001550
*         IS TO START IS PASSED IN THE PARAMETER LIST.                 *001560
*  EXIT CONDITIONS:                                                    *001570
*         A RECORD IS READ FROM THE SCRATCH FILE AND STORED IN THE     *001580
*         WORKING STORAGE AREA THAT WAS PASSED TO GETENT.              *001590
*  EXTERNAL REFERENCE:                                                 *001600
*         CRM MACRO GET.                                               *001610
*  DESCRIPTION:                                                        *001620
*         READS A RECORD FROM THE SUB-SCHEMA FILE AND STORES IT IN THE *001630
*         WORKING STORAGE AREA WHOSE ADDRESS WAS PASSED IN THE PARA-   *001640
*         METER LIST.                                                  *001650
************************************************************************001660
 GETENT   EQ   *+1S17                                                   001670
          SX7    A1                                                     001680
          SA7    PARMADR           SAVE THE PARAMETER ADDRESS.          001690
 RDSB     SA3    PARMADR                                                001700
          SA1    X3                STORE ADDRESS OF THE WSA             001710
          SA2    A1+1              STORE WA OF LENGTH                   001720
          SA4    A1+2              STORE ADDRESS OF WA                  001730
          SA2    X2                                                     001740
          SA3    X4                                                     001750
          SA1    X1                                                     001760
          SX3    X3+1                                                   001770
          SX5    X2                                                     001780
          LX2    3                                                      001790
          LX5    1                                                      001800
          IX2    X5+X2                                                  001810
          GET    SCRATCH,X1,X2,,X3   STORE RECORD INTO THE WSA          001820
          EQ   GETENT                RETURN TO CALLER                   001830
                                                                        001840
                                                                        001850
************************************************************************001860
*                            *  P U T E N T  *                         *001870
*                                                                      *001880
*  PUTENT (WORKING STORAGE AREA, NUMBER OF WORDS, WORD ADDRESS)        *001890
*  ENTRY CONDITIONS:                                                   *001900
*         THE ADDRESS OF THE WORKING STORAGE AREA THAT CONTAINS THE    *001910
*         RECORD THAT IS TO BE WRITTEN TO THE SUB-SCHEMA SCRATCH FILE  *001920
*         IS PASSED IN THE PARAMETER LIST.                             *001930
*  EXIT CONDITIONS:                                                    *001940
*         RECORD IN THE WORKING STORAGE AREA PASSED TO PUTENT IS       *001950
*         WRITTEN TO THE SUB-SCHEMA SCRATCH FILE.                      *001960
*  EXTERNAL REFERENCE:                                                 *001970
*         CRM MACRO PUT.                                               *001980
*  DESCRIPTION:                                                        *001990
*         WRITES A RECORD CONTAINED IN A WORKING STORAGE AREA ONTO THE *002000
*         SUB-SCHEMA SCRATCH FILE                                      *002010
*                                                                      *002020
************************************************************************002030
 PUTENT   EQ   *+1S17                                                   002040
          SA2    A1+1              STORE WA OF LENGTH                   002050
          SA2    X2                                                     002060
          SA4    A1+2              STORE ADDRESS OF WA                  002070
          SA3    X4                                                     002080
          SA1    X1                STORE WA OF WSA                      002090
          SX3    X3+1                                                   002100
          SX5    X2                                                     002110
          LX2    3                                                      002120
          LX5    1                                                      002130
          IX2    X5+X2                                                  002140
          PUT    SCRATCH,X1,X2,,X3  MOVE RECORD FROM WORKING STORAGE,   002150
*                                   PASSED IN X1, TO THE SCRATCH FILE.  002160
          EQ   PUTENT               RETURN TO CALLER                    002170
                                                                        002180
                                                                        002190
************************************************************************002200
*                                                                      *002210
*      RETNZZ - CLOSE AND UNLOAD THE SCRATCH FILE                      *002220
*                                                                      *002230
************************************************************************002240
 RETNZZ   EQ   *+1S17                                                   002250
          CLOSEM SCRATCH,U         RETURN (DISCARD) THE SCRATCH FILE    002260
          EQ   RETNZZ                                                   002270
                                                                        002280
                                                                        002290
************************************************************************002300
*                                                                      *002310
*     DDLOPNL - OPEN NEW SUB-SCHEMA LIBRARY                            *002320
*               THE LFN IN NEWLIB IS STORED IN THE FIT FOR NEWLIB, AND *002330
*               THE CRM MACRO OPENM IS CALLED TO OPEN OUTPUT FILE      *002340
*                                                                      *002350
************************************************************************002360
 DDLOPNL  EQ   *+1S17                                                   002370
          SA3    NEWLIB            PICK UP THE NEW SUB-SCHEMA           002380
          BX6    X3                LIBRARY NAME                         002390
          SA6    NULIB             STORE IT IN FIT                      002400
          OPENM  NULIB,OUTPUT,R                                         002410
          EQ   DDLOPNL                                                  002420
                                                                        002430
                                                                        002440
************************************************************************002450
*                                                                      *002460
*     DDLRTNL (WORKING STORAGE AREA, NBR WORDS, WORD ADDR ON FILE)     *002470
*              WRITES THE INDICATED NBR OF WORDS TO THE NEW SUB-SCHEMA *002480
*              LIBRARY FILE AT THE INDICATED WORD ADDRESS, FROM THE    *002490
*              SPECIFIED WORKING STORAGE AREA                          *002500
*                                                                      *002510
************************************************************************002520
 DDLRTNL  EQ   *+1S17                                                   002530
          SA2    X1                GET ADDRESS OF WSA                   002540
          SA4    A1+1              GET NUMBER OF WORDS                  002550
          SA4    X4                                                     002560
          SA5    A1+2              GET WORD ADDR ON FILE                002570
          SA5    X5                                                     002580
          SX3    X4                CONVERT NBR OF WORDS TO              002590
          LX4    3                 NUMBER OF CHARACTERS                 002600
          LX3    1                                                      002610
          IX3    X4+X3                                                  002620
          PUT    NULIB,X2,X3,,X5                                        002630
          EQ   DDLRTNL                                                  002640
                                                                        002650
                                                                        002660
************************************************************************002670
*                                                                      *002680
*     DDLCLNL - CLOSE NEW SUB-SCHEMA LIBRARY                           *002690
*                                                                      *002700
************************************************************************002710
 DDLCLNL  EQ   *+1S17                                                   002720
          CLOSEM NULIB,N                                                002730
          EQ   DDLCLNL                                                  002740
                                                                        002750
                                                                        002760
************************************************************************002770
*                                                                      *002780
*      ERRCK - CHECK FOR ERRORS IN SUB-SCHEMA INPUT/OUTPUT             *002790
*      CRM WILL PUT THE CURRENT WORKING FILE NAME IN REG. A0           *002800
*                                                                      *002810
************************************************************************002820
 ERRCK    EQ   *+1S17                                                   002830
          FETCH  A0,ES,X1                                               002840
          SX3    X1-143B                                                002850
          ZR   X3,ALTER                                                 002860
          SX4    X1-142B                                                002870
          ZR   X4,ALTER                                                 002880
          EQ   ERRCK                                                    002890
                                                                        002900
                                                                        002910
 ALTER    FETCH  A0,ECT,X1                                              002920
          SX3    X1-1                                                   002930
          STORE  A0,ECT=X3                                              002940
          EQ   ERRCK                                                    002950
                                                                        002960
                                                                        002970
************************************************************************002980
*                          *  S B E O F  *                             *002990
*                                                                      *003000
*         CHECK FOR END-OF-FILE FOR THE SCRATCH OR NEW LIBRARY FILE    *003010
*                                                                      *003020
************************************************************************003030
 SBEOF    SX1    SCRATCH           GET ADDRESS OF THE SCRATCH FILE      003040
*                                  OR NEW LIBRARY FILE                  003050
          RJ   CKEOF               CHECK FOR END OF FILE.               003060
                                                                        003070
          ZR   X7,RDSB             IF X7=0 THEN NO END-OF-FILE.         003080
          EQ   GETENT              END-OF-FILE, RETURN TO CALLER        003090
                                                                        003100
                                                                        003110
 NULIB    BSS    0                 NEW SUBSCHEMA LIBRARY FILE           003120
 SCRATCH  FILE   LFN=ZZZZZCB,LT=UL,RT=U,FO=WA,ERL=2,DX=SBEOF,FWB=SBBUF,B003130
,FS=195,MRL=100000,EX=ERRCK,EFC=3                                       003140
 SBBUF    BSSZ   195               SUBSCHEMA BUFFER                     003150
 PARMADR  BSSZ   1                                                      003160
          IFC    EQ,$"OS.NAME"$SCOPE $                                  003170
 OSNAME   DATA   0                                                      003180
          ELSE                                                          003190
 OSNAME   DATA   1                                                      003200
          ENDIF                                                         003210
 SUBLIB   FILE   LFN=SUBLIB,LT=UL,RT=U,FO=WA,ERL=1,FWB=NLBUF,BFS=102B,MR003220
,L=1310000,DX=INITSB,EX=ERRCK,EFC=3                                     003230
 NLBUF    BSSZ   102B              CRM BUFFER SIZE                      003240
 NEWFILE  BSSZ   1                                                      003250
 FDB      VFD    60/1                                                   003260
          VFD    60/0                                                   003270
 ONE      VFD    60/1D                                                  003280
 STSPAR   VFD    24/2*1+1,12/5555B,24/0                                 003290
 NAMSTOR  DATA   0                 END OF INFORMATION (EOI)             003300
          DATA   0                                                      003310
          END                                                           003320
