*COMDECK COMCBIO
          ENTRY  CLSESB 
          ENTRY  DDLOPSB
          ENTRY  DDLRTSB
          ENTRY  DDLRDSB
          ENTRY  DDLOPNL
          ENTRY  DDLRTNL
          ENTRY  DDLCLNL
          ENTRY  CBEXT
          ENTRY  NEWFILE
          SST 
          IPARAMS 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*   DDLRTSB ( WORKING STORAGE AREA, NBR WORDS, WORD ADDRESS )         * 
*                                                                     * 
*   ENTRY CONDITIONS:                                                 * 
*        THE ADDRESS OF THE WORKING STORAGE AREA THAT CONTAINS THE    * 
*        RECORD THAT IS TO BE WRITTEN INTO THE SUB-SCHEMA FILE.       * 
*                                                                     * 
*        THE NUMBER OF WORDS TO BE WRITTEN.                           * 
*                                                                     * 
*        WORD ADDRESS WHERE THE RECORD IS TO BE WRITTEN               * 
*                                                                     * 
*   EXIT CONDITIONS:                                                  * 
*        RECORD IN THE WORKING STORAGE IS WRIITEN INTO THE SUB-SCHEMA * 
*        FILE.                                                        * 
*                                                                     * 
*   EXTERNAL REFERENCE:                                               * 
*        CRM MACRO   P U T .                                          * 
*                                                                     * 
*   DESCRIPTION:                                                      * 
*        WRITES A RECORD CONTAINED IN A WORKING STORAGE AREA INTO THE * 
*        SUB-SCHEMA FILE.                                             * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
DDLRTSB   DATA   0
          SA2    A1+1            GET NUMBER OF WORDS TO BE WRITTEN
          SA2    X2 
          SA4    A1+2              GET WRD ADR WHERE REC IS TO BE WRITTN
          SA3    X4 
          SA1    X1              GET WRD ADR OF WORKING STORAGE AREA
          SX5    X2              CONVERT NUMBER OF WORDS TO CHARACTERS
          LX2    3
          LX5    1
          IX2    X5+X2
          PUT    DIRSUB,X1,X2,,X3  MOVE RECORD FROM WORKING STORAGE,
*                                  PASSED IN X1 TO THE SUB-SCHEMA FILE
          EQ     DDLRTSB
DDLRDSB   DATA   0
          SA2    A1+1        GET ADDR OF NIMBER OF WORDS TO BE READ 
          SA2    X2          NUMBER OF WORDS
          SA4    A1+2        GET WRD ADDR OF WHERE TO START READ
          SA3    X4 
          SA1    X1          GET WRD ADDR OF WORKING STORAGE AREA 
          SX5    X2 
          LX2    3           CONVERT
          LX5    1
          IX2    X5+X2                           TO CHARACTERS
          GET    DIRSUB,X1,X2,,X3 
          EQ     DDLRDSB
CLSESB    DATA   0
          CLOSEM DIRSUB,N          CLOSE THE SUB-SCHEMA FILE
          EQ     CLSESB 
DDLOPSB   DATA   0
          SA3    =XSBLFN          GET SUB-SCHEMA LFN
          BX6    X3 
          SA6    DIRSUB 
          SA6    NAMSTOR
          OPENM  DIRSUB,I-O,R 
          SA2    STSPAR 
          MX6    36 
          BX6    X6*X2
          SA6    A2          ZERO THE RECALL BIT
          SYSTEM STS,RECALL,STSPAR,3S6 CALL STS, FUNCTION 3 
          SA1    STSPAR+2    PICK UP PRU COUNT
          LX1    6           MULTIPLY BY 64 
          BX6    X1 
          SA6    NEWFILE
          EQ     DDLOPSB
CBEXT     BSSZ   1
          IFC    EQ,$"OS.NAME"$SCOPE $
          SA1    X1 
          MX0    42D
          BX6    X0*X1
          SA6    FDB
          PERM   FDB,RC 
          SA1    FDB
          LX1    59-13
          NG     X1,CBEXT 
          EXTEND FDB
          ENDIF 
          EQ     CBEXT
SETNF     DATA   0
          MX7    1
          LX7    1
          SA7    NEWFILE
          EQ     SETNF
          SPACE  3
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*  DDLOPNL  - OPEN NEW SUBSCHEMA LIBRARY
*             THE LFN IN NEWLIB IS STORED IN THE FIT FOR NEWLIB, AND THE
*             CRM MACRO OPENM IS CALLED TO OPEN THE FILE FOR OUTPUT.
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
 DDLOPNL  DATA   0
          SA3    =XNEWLIB          PICK UP NEW SUBSCH 
          BX6    X3                LIB NAME, STORE IN FIT 
          SA6    SUBLIB 
          OPENM  SUBLIB,OUTPUT,R
          EQ     DDLOPNL
          SPACE  3
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*  DDLRTNL (WORKING STORAGE AREA, NBR WORDS, WORD ADDRESS ON FILE ) 
*          - WRITES THE INDICATED NUMBER OF WORDS TO THE NEW SUBSCHEMA
*            LIBRARY FILE AT THE INDICATED WORD ADDRESS, FROM THE 
*            INDICATED WORKING STORAGE AREA.
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
DDLRTNL   DATA   0
          SA2    X1                GET ADDRESS OF WSA 
          SA4    A1+1              GET NUMBER OF WORDS
          SA4    X4 
          SA5    A1+2              GET WORD ADDR ON FILE
          SA5    X5 
          SX3    X4                CONVERT NBR OF WORDS TO
          LX4    3                 NBR OF CHARACTERS
          LX3    1
          IX3    X4+X3
          PUT    SUBLIB,X2,X3,,X5 
          EQ     DDLRTNL
          SPACE  3
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*  DDLCLNL  - CLOSE NEW SUBSCHEMA LIBRARY 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
DDLCLNL   DATA   0
          CLOSEM SUBLIB,N 
          EQ     DDLCLNL
          SPACE  3
          FILE   LFN=SUBLIB,LT=UL,RT=U,FO=WA,ERL=1,FWB=NLBUF,BFS=1002B,M
,RL=1310000 
NLBUF     BSSZ   1002B
          FILE   LFN=DIRSUB,LT=UL,RT=U,FO=WA,FWB=SBBUF,BFS=66,MRL=131071
,0,DX=SETNF,EFC=3,ERL=10
SBBUF     BSSZ   66 
NEWFILE   BSSZ   1
FDB       VFD    60/1 
          VFD    60/0 
ONE       VFD    60/1D
STSPAR    VFD    24/2*1+1,12/5555B,24/0 
NAMSTOR   DATA   0
          DATA   0
          END 
