*DECK  SCHEMIO
          IDENT  SCHEMIO
          SPACE  2
** THIS ROUTINE CONTAINS THE ROUTINES DDLRDSC AND DDLRTSC, USED 
** TO READ AND WRITE THE DDL SCHEMA, PLUS THE ROUTINES OPENSC 
** AND CLSESC, USED TO OPEN AND CLOSE THE SCHEMA AND THE ZZZZZDF
** FILE.  THE ROUTINE RFITZDF, USED TO READ THE ZZZZZDF FILE, 
** IS ALSO INCLUDED.
          SPACE  1
*  THE FOLLOWING ROUTINES ARE ADDED TO PROCESS THE SCHEMA CHECKSUM
*  SCRATCH FILE ZZZZZCB. THIS FILE IS SHARED WITH COBOL SUBSCHEMA 
*  ROUTINE ALIASIO, WHICH EXECUTES IN A NON-CONFLICTING OVERLAY. THE
*  SCRATCH FILE IS USED TO COLLECT AREA AND RELATION CHECKSUMS AS THE 
*  SCHEMA IS PROCESSED, AND IS CLOSED AT THE END OF SCHEMA COMPILATION. 
* 
*    ROUTINE/ENTRY   FUNCTION 
* 
*     SCOPCKS         OPEN CHECKSUM SCRATCH FILE
*     SCCLCKS         CLOSE CHECKSUM SCRATCH FILE 
*     SCWRCKS         WRITE CHECKSUM SCRATCH FILE 
*     SCRDCKS         READ CHECKSUM SCRATCH FILE
* 
*    METHOD 
* 
*     SCOPCKS,SCCLCKS ARE CALLED WITH NO PARAMETERS 
* 
*     SCWRCKS,SCRDCKS ARE CALLED WITH TWO PARAMETERS- 
* 
*       SCWRCKS(WSA,WA);
*       SCRDCKS(WSA,WA);
* 
*          WSA - WORKING STORAGE ADDRESS
*          WA  - WORD ADDRESS IN SCRATCH FILE 
* 
*          THE NUMBER OF WORDS TO WRITE/READ IS FIXED BY LOCAL SYMBOL 
*          CKSWDS 
* 
*     CALLS TO THESE ENTRY POINTS RESULT IN CRM OPENM, CLOSEM, GET AND
*     PUT MACRO CALLS.
* 
*     NOTE - THE BUFFER SIZE DEFINED FOR THE SCRATCH FILE IS CHOSEN TO
*            MINIMIZE PHYSICAL I/O FOR PERFORMANCE CONSIDERATIONS.
* 
*     ENTRY CONDITIONS
* 
*     A1 CONTAINS ADDRESS OF PARAMETER LIST FOR SCWRCKS,SCRDCKS 
* 
          ENTRY SCOPCKS 
          ENTRY  SCCKSRD           READ CHECKSUM SCRATCH FILE           005950
          ENTRY SCCLCKS 
          ENTRY SCWRCKS 
          ENTRY SCRDCKS 
 CKSWDS   EQU    4                 FIXED LENGTH OF A CHECKSUM ENTRY 
          EXT    ABRT7
          ENTRY  DDLRDSC
          ENTRY  DDLRTSC
          ENTRY  OPENSC 
          ENTRY  CLSESC 
          ENTRY  DDLRDSY
          ENTRY  DDLRTSY
          ENTRY  SCHBUFF
          ENTRY  LGSCHBF
          ENTRY  SCHOPEN
          ENTRY  SYMBFWA
          EXT    ABRT1
          EXT    CKEOF
          EXT    DDLMEM 
          EXT    MAXFL
          EXT    NBRITEM
          SPACE  2
          FILE   LFN=DIRSCHA,LT=UL,RT=U,FO=WA,DX=SCEOF,FWB=SCBUF,MRL=100 D2A165 
,000,BFS=195,EX=ERRCKSC,EFC=3,ERL=10                                     D2A165 
 SCBUF    BSSZ   195               SCHEMA BUFFER FOR 6RM I / O
 ZZZZZDF  FILE   LFN=ZZZZZDG,LT=UL,RT=S,BFS=264,ERL=9,FWB=DF,MBL=1280,WS
,A=ZDFBUF,DX=SETERR,BT=C,MRL=1280,EFC=3                                  D2A165 
DF        BSSZ   264               B U F F E R
          FILE   LFN=ZZZZZCB,LT=UL,RT=U,FO=WA,ERL=2,DX=CKSEOF,EX=CKSERR,
,FWB=CKSBUF,BFS=256,MRL=2560,EFC=3                                       D2A165 
 CKSBUF   BSSZ   256               CHECKSUM SCRATCH FILE BUFFER 
 ZDFBUF   BSSZ   128         WSA
          ENTRY  DFERR
DFERR     BSSZ   1                 ERROR FLAG FOR END-OF-DATA,OR NO FIND
 FLAGDF   BSSZ   1                 ZERO IF DATA, 777 IF NO DATA ON ZZZZZ
 SYMBFWA  BSSZ   1                 FWA OF SYMBOL TABLE BUF
 SYMLAST  BSSZ   1                 LWA + 1 OF SYMBOL TABLE BUF
 SCHBUFF  BSSZ   1                 FWA OF SCHEMA RECORD BUFFER
 LGSCHBF  BSSZ   1                 LENGTH IN WORDS OF SCHEMA REC BUFFER 
PARMADR   BSSZ   1
 FITLENG  EQU    35 
 FITHDR   EQU    2                     HDR WDS ON ZZZZZDG FILE FITS 
 PERIBLK  EQU    62                NUMBER FILES PER INDEX BLOCK 
          SPACE  3
************************************************************* 
** OPEN ZZZZZDF FILE.  DO A READ OF ZZZZZDF FILE, 
** SET FLAG FLAGDF IF NO DATA.
** COMPUTE RECORD BUFFER LENGTH AND FIRST WORD ADDRESS OF 
** SYMBOL TABLE, BASED ON CURRENT FIELD LENGTH. 
 OPENSC   DATA   0
          OPENM  ZZZZZDF,INPUT,R
          GET    ZZZZZDF,ZDFBUF 
          SA1    DFERR
          BX6    X1 
          SA6    FLAGDF 
          MEMORY CM,MAXFL,R 
          SA1    MAXFL
          AX1    30                RIGHT JUSTIFY
          SX6    X1 
          SA6    A1                STORE FOR LATER USE
          SA1    65B
          SX6    X1                GET HHA - FROM LOADOVL 
          SA6    SCHBUFF             STORE IT INTO SCHEMA REC BUF FWA 
          SA2    MAXFL
          SX3    X2                COMPUTE SCHEMA BUFFER LENGTH 
          SX4    X1+200B           DEFAULT MINIMUM CM REQT
          IX5    X3-X4
          PL     X5,OPENS01        MINIMUM IS AVAILABLE 
          RJ     ABRT1             INSUFFICIENT FL - ABORT
 OPENS01  IX3    X3-X6
          AX3    2                 RECORD BUFF = 1/4 AVAILABLE MEM
          BX7    X3 
          SA4    NBRITEM     CHECK NI PARAM FROM DDL CALL 
          ZR     X4,OPENS03  NOT SET
          IX5    X3-X4             ENOUGH FL
          PL     X5,OPENS02        FL OK
          RJ     ABRT1             INSUFFICIENT FL - ABORT
OPENS02   BX7    X4          USE NI 
 OPENS03  SA7    LGSCHBF           STORE BUFFER LENGTH
          IX6    X6+X7             COMPUTE FWA OF SYMBOL TABLE
          SA6    SYMBFWA
          SX6    X6+1000B 
          MX0    54 
          BX6    X0*X6
          SX6    X6+100B
          SA2    MAXFL             GET FL LIMIT 
          IX3    X2-X6             COMPARE DESIRED FL 
          PL     X3,SETREQ         IF ENOUGH
          SX6    X2                ELSE REQUEST FL
 SETREQ   BSS    0
          LX6    30 
          SA6    DDLMEM 
          MEMORY CM,DDLMEM,R,,N    GET 1K OR MAX FL 
          SA1    DDLMEM            ZERO OUT CORE OBTAINED 
          LX1    30                  BY MEMORY REQUEST
          SX6    X1 
          SA6    SYMLAST
          SB1    X6 
          SA2    SCHBUFF
          SB2    X2 
          SX7    B0 
 ZLOOP    SA7    B2 
          SB2    B2+1 
          LT   B2,B1,ZLOOP
          EQ   OPENSC 
          SPACE  2
******************************************************* 
** OPEN SCHEMA, USING SCLFN FOR FILE NAME 
SCHOPEN   DATA   0
          SA1    =XSCLFN
          BX6    X1 
          SA6    DIRSCHA
          OPENM  DIRSCHA,I-O,N
          EQ   SCHOPEN
          SPACE  2
*********************************************************** 
** GET FILE INFORMATION FROM ZZZZZDF FILE FOR FILE WHOSE
** NAME IS IN ZDFFIT BUFFER 
          ENTRY  RFITZDF
          ENTRY  ZDFFIT 
 ZDFFIT   BSSZ   FITLENG
RFITZDF   BSS    1
          SA1    FLAGDF 
          BX6    X1 
          SA6    DFERR
          NZ   X6,RFITZDF          EXIT IF NO DATA ON ZZZZZDF 
          REWINDM ZZZZZDF 
 GETIBLK  BSS    0                 GET CRM FILE INDEX BLOCK 
          GET    ZZZZZDF,ZDFBUF 
          SA1    ZDFFIT 
          SB2    PERIBLK+1
          SB1    0
          SB3    1
RFIT05    SA2    B1+ZDFBUF         SEARCH ZZZZZDF PRU 
          NZ     X2,NOTEND         JIF INDEX NOT EXHAUSTED
          RJ     SETERR            NO MORE FILES - SET ERR FLAG 
          EQ     RFITZDF           AND RETURN 
 NOTEND   IX2    X1-X2
          ZR    X2,RFIT15 
          SB1    B1+B3
          LT    B1,B2,RFIT05
          SKIPFL ZZZZZDF,PERIBLK   POSITION TO NEXT INDEX BLOCK 
          SA1    DFERR             TEST END OF DATA 
          NZ     X1,RFITZDF        FLAG SET - RETURN
          EQ     GETIBLK           CONTINUE SEARCH
          SPACE  1
RFIT15    EQ    B1,B0,RFIT20
          SX1    B1 
          SKIPFL ZZZZZDF,X1        SKIP TO PRU FOR AREA FILE
RFIT20    GET    ZZZZZDF,ZDFBUF 
          SB1    1
          SB2    FITLENG+FITHDR 
          SB3    FITHDR+1              TO SKIP HDR WDS
          SB4    B1 
 RFIT25   SA1    B3+ZDFBUF         MOVE FILE DATA TO AREA FIT 
          BX6    X1 
          SA6    B4+ZDFFIT
          SB3    B3+B1
          SB4    B4+B1
          LT     B3,B2,RFIT25        UNTIL FITLENG REACHED
          EQ   RFITZDF                *** R E T U R N *** 
          SPACE  2
************************************************************* 
*     SETERR - END-OF-DATA EXIT FOR ZZZZZDF FILE            * 
************************************************************
SETERR    BSSZ   1
          SX7    777B 
          SA7    DFERR
          EQ     SETERR 
          SPACE  2
************************************************************************003250
*                          *  D D L R D S C  *                         *003260
*                                                                      *003270
*  ENTRY CONDITIONS:                                                   *003280
*  DDLRDSC ( WORKING STORAGE AREA, NBR WORDS, WORD ADDRESS )
*         THE ADDRESS OF THE WORKING STORAGE AREA WHERE THE RECORD IS  *003290
*         TO BE PLACED IS PASSED IN THE PARAMETER LIST.                *003300
*  EXIT CONDITION:                                                     *003310
*         A RECORD IS READ FROM THE SCHEMA FILE AND STORED IN A WORKING*003320
*         STORAGE AREA THAT WAS PASSED TO DDLRDSC.                     *003330
*  EXTERNAL REFERENCE:                                                 *003340
*         6RM MACRO GET.                                               *003350
*  DESCRIPTION:                                                        *003360
*         READS A RECORD FROM THE SCHEMA FILE AND STORES IT IN A       *003370
*         WORKING STORAGE AREA WHOSE ADDRESS WAS PASSED IN THE PARA-   *003380
*         METER LIST.                                                  *003390
************************************************************************003400
 DDLRDSC  DATA   0                                                      003410
          SX7    A1                                                     003420
          SA7    PARMADR     SAVE THE PARAMETER ADDRESS.                003430
 RDSC     SA3    PARMADR                                                003440
          SA1    X3          STORE ADDRESS OF THE WSA.                  003450
          SA2    A1+1        STORE THE WA INTO X2.                      003460
          SA4    A1+2                                                   003470
          SA2    X2                                                     003480
          SA3    X4                                                     003490
          SX5    X2                                                     003510
          LX2    3                                                      003520
          LX5    1                                                      003530
          IX2    X5+X2                                                  003540
          GET    DIRSCHA,X1,X2,,X3   STORE RECORD INTO THE WSA.         003550
          EQ     DDLRDSC     RETURN TO CALLER.                          003560
************************************************************************003570
*                          *  D D L R T S C  *                         *003580
*                                                                      *003590
*  DDLRTSC ( WORKING STORAGE AREA, NBR WORDS, WORD ADDRESS )
*  ENTRY CONDITIONS:                                                   *003600
*         THE ADDRESS OF THE WORKING STORAGE AREA THAT CONTAINS THE    *003610
*         RECORD THAT IS TO BE WRITTEN ON THE SCHEMA FILE IS PASSED    *003620
*         IN THE PARAMETER LIST.                                       *003630
*  EXIT CONDITIONS:                                                    *003640
*         RECORD IN THE WORKING STORAGE AREA PASSED TO DDLRTSC IS      *003650
*         WRITTEN ONTO THE SCHEMA FILE.                                *003660
*  EXTERNAL REFERENCE:                                                 *003670
*         6RM MACRO PUT.                                               *003680
*  DESCRIPTION:                                                        *003690
*         WRITES A RECORD CONTAINED IN A WORKING STORAGE AREA ONTO THE *003700
*         SCHEMA FILE.                                                 *003710
************************************************************************003720
 DDLRTSC DATA    0                                                      003730
          SA2    A1+1        GET WORD ADDRESSABLE.                      003740
          SA2    X2                                                     003750
          SA4    A1+2                                                   003760
          SA3    X4                                                     003770
          SX5    X2                                                     003790
          LX2    3                                                      003800
          LX5    1                                                      003810
          IX2    X5+X2                                                  003820
          PUT    DIRSCHA,X1,X2,,X3 MOVE RECORD FROM WORKING STORAGE,    003830
*                                  PASSED IN X1, TO THE SCHEMA FILE.    003840
          EQ     DDLRTSC     RETURN TO CALLER.                          003850
          SPACE  2
************************************************************************005350
*                          *  S C E O F  *                             *005360
*                                                                      *005370
*  DESCRIPTION:                                                        *005380
*         CHECK FOR END-OF-FILE FOR THE SCHEMA FILE.                   *005390
************************************************************************005400
 SCEOF    SX1    DIRSCHA     GET ADDRESS OF THE SCHEMA FIT.             005410
          RJ     CKEOF       CHECK FOR END-OF-FILE.                     005420
          ZR     X7,RDSC     IF X7=0 THEN NO END-OF-FILE.               005430
          EQ     DDLRDSC     END-OF-FILE RETURN TO CALLER.              005440
          SPACE  2
************************************************************* 
** CLOSE SCHEMA AND ZZZZZDF FILES 
CLSESC    DATA   0
          CLOSEM DIRSCHA,N
          CLOSEM ZZZZZDF
          RJ     =XCALCFL          CALCULATE CM REQUIRED TO COMPILE 
          EQ   CLSESC 
          SPACE  2
*********************************************************** 
** CHECK ERRORS FOR SCHEMA I / O
 ERRCKSC  DATA   0
          SX2    DIRSCHA
          FETCH  X2,ES,X1 
          SX3    X1-99
          ZR     X3,ALTER 
          SX4    X1-98
          ZR     X4,ALTER 
          EQ   ERRCKSC
          SPACE  1
 ALTER    FETCH  X2,ECT,X1
          SX3    X1-1 
          STORE  X2,ECT=X3
          EQ   ERRCKSC
          SPACE  2
************************************************************************003860
*                          *  D D L R D S Y  *                         *003870
*                                                                      *003880
*  ENTRY CONDITIONS:                                                   *003890
*         THE ADDRESS OF THE WORKING STORAGE AREA WHERE THE RECORD IS  *003900
*         TO PLACED IS PASSED IN THE PARAMETER LIST.                   *003910
*  DESCRIPTION                                               *
*         READS FROM THE SYMBOL TABLE BUFFER AND STORES IN THE       *
*         CALLERS WORKING STORAGE AREA.                              *
*  CALLING SEQUENCE                                          *
*         DDLRDSY ( WORKING STORAGE AREA, NBR WORDS, WORD ADDRESS )  *
**************************************************************
 DDLRDSY  DATA   0                                                      004030
          SX7    A1                                                     004040
          SA7    PARMADR     SAVE THE PARAMETER ADDRESS                 004050
 RDSY     SA3    PARMADR                                                004060
          SA1    X3                                                     004070
          SA2    A1+1                                                   004080
          SA4    A1+2                                                   004090
          SA2    X2                                                     004100
          SA3    X4                                                     004110
          SB2    X2-1 
          SA4    SYMBFWA
          SB3    X4 
          SB3    B3+X3
 GLOOP    SA4    B3+B2                                                  000140
          BX6    X4                                                     000150
          SA6    X1+B2                                                  000160
          ZR     B2,DDLRDSY                                             000170
          SB2    B2-1                                                   000180
          EQ     GLOOP                                                  000190
          SPACE  1
************************************************************************004200
*                          *  D D L R T SY  *                          *004210
*                                                                      *004220
*  ENTRY CONDITIONS:                                                   *004230
*         THE ADDRESS OF THE WORKING STORAGE AREA THAT CONTAINS THE    *004240
*         DATA THAT IS TO BE WRITTEN TO THE SYMBOL FILE BUFFER, AND  *
*         THE ADDRESS IN THE BUFFER WHERE THE DATA IS TO GO.         *
*  CALLING SEQUENCE                                                *
*         DDLRTSY ( WORKING STORAGE AREA, NBR WORDS, WORD ADDRESS )  *
*  DESCRIPTION                                                     *
*         THE FIRST WORD ADDRESS OF THE SYMBOL TABLE IS STORED IN    *
*         THE LOCATION SYMBFWA, THE LWA+1 IN SYMLAST.  IF THE DATA   *
*         IS TO BE WRITTEN AT A LOCATION BEYOND THE END OF THE SYMBOL*
*         TABLE, A SCOPE MEMORY REQUEST IS MADE TO OBTAIN A 2000     *
*         WORD BLOCK OF CORE.  THE DATA IS TRANSFERRED FROM THE      *
*         CALLERS WORKING STORAGE AREA TO THE SYMBOL TABLE BUFFER.   *
************************************************************************004360
 DDLRTSY  DATA   0                                                      004370
          SX7    A1 
          SA7    PARMADR
 RTSY     SA1    PARMADR
          SA1    X1 
          SA2    A1+1                                                   004380
          SA2    X2          GET WORD ADDRESSABLE.                      004390
          SA4    A1+2                                                   004400
          SA3    X4                                                     004410
          SB2    X2-1 
          SA4    SYMBFWA
          SB3    X4 
          SB3    B3+X3
          SB4    B3+B2
          SA5    SYMLAST
          SB5    X5-7 
          GE   B4,B5,MEMLOOP
 PLOOP    SA4    X1+B2                                                  000260
          BX6    X4                                                     000270
          SA6    B3+B2                                                  000280
          ZR     B2,DDLRTSY                                             000290
          SB2    B2-1                                                   000300
          EQ     PLOOP                                                  000310
          SPACE  1
 MEMLOOP  SX6    X5+1000B 
          SA2    MAXFL             GET FL LIMIT 
          IX3    X2-X6             COMPARE DESIRED FL 
          PL     X3,STREQ          IF ENOUGH
          SX6    X2                ELSE REQUEST FL
 STREQ    BSS    0
          LX6    30 
          SA6    DDLMEM 
          MEMORY CM,DDLMEM,R,,N    GET 1K OR MAX FL 
          SA1    DDLMEM            ZERO OUT MEMORY OBTAINED 
          LX1    30                  FROM MEMORY REQUEST
          SX6    X1 
          SA1    SYMLAST
          IX1    X6-X1
          NZ     X1,FLOK
          RJ     ABRT1             FL EXHAUSTED 
 FLOK     BSS    0
          SA6    SYMLAST
          SB4    X6 
          SX7    B0 
          SB5    X5 
SZLOOP    SA7    B5 
          SB5    B5+1 
          LT   B5,B4,SZLOOP 
          EQ   RTSY 
          SPACE  2
************************************************************************
* 
* OPEN CHECKSUM SCRATCH FILE
* 
************************************************************************
 SCOPCKS  DATA   0                 ENTRY/EXIT 
          OPENM  ZZZZZCB,I-O,N     OPEN SCRATCH FILE
          EQ SCOPCKS               RETURN 
          SPACE  2
************************************************************************
* 
* CLOSE CHECKSUM SCRATCH FILE 
* 
************************************************************************
 SCCLCKS  DATA   0                 ENTRY/EXIT 
          CLOSEM ZZZZZCB,U                                               DL3A036
          EQ     SCCLCKS           RETURN 
          SPACE  2
************************************************************************
* 
* WRITE CHECKSUM SCRATCH FILE 
* 
************************************************************************
 SCWRCKS  DATA   0                 ENTRY/EXIT 
          SX2    CKSWDS*10         LENGTH OF SCRATCH FILE ENTRY (CHARS) 
          SA4    A1+1              ADDR OF FILE WORD ADDRESS
          SA3    X4                FETCH WORD ADDRESS 
          PUT    ZZZZZCB,X1,X2,,X3 WRITE CHECKSUM ENTRY 
          EQ     SCWRCKS           RETURN 
          SPACE  2
************************************************************************
* 
* READ CHECKSUM SCRATCH FILE
* 
************************************************************************
 SCRDCKS  DATA   0                 ENTRY/EXIT 
          SX2    CKSWDS*10         LENGTH OF SCRATCH FILE ENTRY (CHARS) 
          SA4    A1+1              ADDR OF FILE WORD ADDRESS
          SA3    X4                FETCH WORD ADDRESS 
          GET    ZZZZZCB,X1,X2,,X3 READ CHECKSUM ENTRY
          EQ     SCRDCKS           RETURN 
 SCCKSRD  SPACE  6,10                                                   005970
************************************************************************005980
*                                                                      *005990
*  READ CHECKSUM SCRATCH FILE (VARIABLE LENGTH READ)                   *006000
*                                                                      *006010
************************************************************************006020
                                                                        006030
 SCCKSRD  EQ   *+1S17              ENTRY/EXIT                           006040
                                                                        006050
          SA2    A1+1              CONVERT NUMBER OF WORDS              006060
          SX3    10                TO CHARS FOR CRM                     006070
          SA2    X2                                                     006080
          IX2    X2*X3                                                  006090
          SA4    A1+2              GET THE WORD ADDRESS                 006100
          SA1    X1                GET THE WSA ADDRESS                  006110
          SA3    X4                                                     006120
          GET    ZZZZZCB,X1,X2,,X3                                      006130
                                                                        006140
          EQ   SCCKSRD             EXIT                                 006150
                                                                        006160
 CKSEOF   SPACE  6,10                                                   006170
************************************************************************
* 
* PROCESS END OF DATA EXIT
* 
************************************************************************
 CKSEOF   BSS    0                 END OF DATA NOT LEGIT
          RJ     ABRT7              CALL CTLIO TO ABORT DDL 
************************************************************************
* 
* PROCESS CHECKSUM I/O ERROR
* 
************************************************************************
 CKSERR   DATA   0                 IF ERROR ON CHECKSUM FILE
          RJ     ABRT7              CALL CTLIO TO ABORT DDL 
          SPACE  2
          END 
