*DECK CTLIO 
          IDENT CTLIO                                                   000120
          LIST   F
          ENTRY  NAMEID                                                 000130
          ENTRY  DDLOPEN                                                000140
          ENTRY  DDLREAD                                                000150
          ENTRY  CKEOF
          ENTRY  CLSEIN                                                 000270
          ENTRY  CLSEOUT                                                000280
          ENTRY DDLIWSA                                                 000300
          ENTRY DDLPRNT                                                 000310
          ENTRY  INPUT
          ENTRY NBRLINE                                                 000390
          ENTRY  DDLABT                                                 000430
          ENTRY  DDLIRL                                                 000440
          ENTRY  LINECTR
          ENTRY  LINELIM
          ENTRY  LINENBR                                                000460
          ENTRY  DDLMEM                                                 000470
          ENTRY  DDLSU
          ENTRY  MAXFL
          ENTRY  INCRLNE                                                000350
          ENTRY HDR2                                                    000520
          ENTRY  HDR3 
          ENTRY  HDR4 
          ENTRY  HDR5 
          ENTRY  HDR6 
          ENTRY  ABRT1                                                  000400
          ENTRY  ABRT3                                                  000410
          ENTRY  ABRT4
          ENTRY   ABRT5 
          ENTRY  ABRT7
          ENTRY  MSSABRT
          ENTRY  ORDNUM 
          ENTRY  ORDFLAG
          ENTRY  NOLIST 
          ENTRY  BLKLINE
          ENTRY  JULDAT 
          ENTRY  CRMLEV 
          ENTRY  HDR3A
          ENTRY  ERRCNTR
          ENTRY  SKIPMSG
          EXT    MULTSS 
          EXT    TRVERR 
          SST                                                           000530
********************************************************************************
* 
*      FOLLOWING MACROS TO CAUSE STATIC LOAD OF CRM SQ AND WA 
*         MODULES IN (0,0) OVERLAY FOR DDL INTERNAL I/O 
* 
********************************************************************************
* 
 SQ       STLD.RM  USERT=(S,Z),USEBT=(C),USE=(OPENM,CLOSEM,GET,GETP,PUT,
,PUTP,FETCH,STORE,SKIPFL,REWINDM,WEOR,TGET,TPUT),OMIT=(CMM) 
 WA       STLD.RM USERT=(U),USE=(OPENM,CLOSEM,GET,PUT,FETCH,STORE),OMIT=
,CMM
* 
 PSR      MICRO  1,3,*871*
  
          IFC    EQ,*"MODLEVEL"*"JDATE"*,3
 MODLEVEL MICRO  3,3,*"JDATE"*
          IF     MIC,PSR,1
 MODLEVEL MICRO  1,3,*"PSR"*
  
 VER      MICRO  1,3,*3.2*         DDL VERSION NUMBER                   000170
LEV       MICRO  1,5,*"MODLEVEL"* 
  
 LINP     EQU    60                LINES PER PAGE 
  
************************************************************************000540
*                          *  D D L O P E N  *                         *000550
*                                                                      *000560
*  ENTRY CONDITIONS:                                                   *000570
*         NONE.                                                        *000580
*  EXTERNAL REFERENCES:                                                *000590
*         ITEMS INFILE,OUTFILE,EXHSS AND MULTSS.                       *
*         SYSTEM MACROS JDATE,DATE,CLOCK,TIME AND MEMORY.              *
*         CRM MACROS OPENM AND FETCH.                                  *
*  DESCRIPTION                                                         *
*         GENERATES THE JULIAN DATE,DATE AND TIME.                     *
*         CHECKS THE MULTIPLE COMPILATION FLAG(MULTSS) AND IF SET OPENS*
*         THE OUTPUT FILE ONLY AND STORES THE FILE NAME IN THE FIT.    *
*         IF MULTIPLE COMPILATION FLAG IS NOT SET INDICATING AN INITIAL*
*         ENTRY,IT OPENS THE INPUT AND OUTPUT FILES,USING THE FILE     *
*         NAMES IN ITEMS INFILE AND OUTFILE.STORES THE CURRENT FIELD   *
*         LENGTH(IN DDLMEM) AND THE MAXIMUM FIELD LENGTH AVAILABLE     *
*         (IN MAXFL) OBTAINED BY USING THE SYSTEM MACRO MEMORY.IF THE  *
*         OUTPUT SOURCE LISTING IS TURNED OFF,THE LFN OUTPUT IS STORED *
*         INTO THE FIT AND THE ONLY RECORDS ISSUED TO THIS FILE ARE    *
*         THE ERROR MESSAGES ISSUED BY DDLDIAG.IF THE CURRENT RUN      *
*         IS FOR THE AUDIT(EXHSS SET) OF A SUBSCHEMA LIBRARY,THE INPUT *
*         FILE IS NOT OPENED.                                          *
************************************************************************000990
 DDLOPEN  DATA   0                                                      001000
          JDATE  JULDAT 
          DATE   HDR5                                                   001010
          CLOCK  HDR6                                                   001020
          TIME   CPTIME 
          SA1    MULTSS            MULTIPLE SS FLAG 
          ZR     X1,CONT5 
          RJ     MULINIT           MULTIPLE SS FLAG SET-RE-INITIALIZE 
          EQ     SKIPINP
 CONT5    SA1    =XINFILE    GET INPUT LFN
          SA2    =XOUTFILE   GET OUTPUT LFN.                            001040
          NZ     X2,CONT2    CHECK IF THE SOURCE LISTING IS SUPPRESSED. 001200
          SX6    1                                                       BH 
          SA6    NOLIST      TURN ON THE NO LIST INDICATOR.             001230
          EQ     CONT3                                                  001240
 CONT2    BX6    X2                                                     001250
          SA6    OUTPUT      OVERLAY THE LFN IN THE OUTPUT FIT.         001260
 CONT3    BX6    X1 
          SA6    INPUT
          MEMORY CM,DDLMEM,R         GET CURRENT FIELD LENGTH 
          MEMORY CM,MAXFL,R          AND MAXIMUM ALLOWED
          SA1    MAXFL
          AX1    30                  RIGHT JUSTIFY
          SX6    X1 
          SA6    A1 
          SA2    =XEXHSS           CHECK SUBSCHEMA AUDIT FLAG 
          SA3    =XNEWLIB          CHECK NEW LIBRARY GENERATION FLAG
          IX2    X2+X3
          NZ     X2,SKIPINP        IF EITHER SET, DO NOT OPEN INPUT 
          OPENM  INPUT,INPUT,N
 SKIPINP  OPENM  OUTPUT,OUTPUT,N   OUTPUT TO DDL
          SA0    OUTPUT 
          FETCH  A0,LFN,X1   GET OUTPUT FILE NAME 
          FETCH  A0,FET,X6   AND ITS FET ADDRESS
          IX6    X1+X6
          MX7    0           STORE INTO RA+2, FOR BUFFER
          SA6    B1+B1       FLUSHING IN CASE OF ABORT
          SA7    A6+B1
          SA1    MULTSS 
          NZ     X1,SKIPPG   IF MULTIPLE SS FLAG
          GETPAGE  PGSIZE    GET PAGE SIZE PARAMETERS 
          SA3    PGSIZE      GET JOB PAGE SIZE PARAMETERS 
          MX0    -4 
          LX3    59-27       POSITION JPD 
          BX6    -X0*X3 
          SB7    X6-8 
          MX0    -8 
          LX3    8           POSITION JPS 
          BX6    -X0*X3 
          SA6    JPS         SET JPS
          SX3    3
          SA6    LINECTR     SET LINE COUNT TO MAX
          IX6    X6-X3
          SA6    LINELIM     SET LINE LIMIT 
          NZ     B7,PD6      IF PRINT DENSITY IS NOT 8
          SA3    FE8L        GET 8 LPI FORMAT EFFECTOR
          BX6    X3 
          SA6    JPD
 PD6      BSS    0
          PUT    OUTPUT,JPD,8 
 SKIPPG   BSS    0
          EQ     DDLOPEN
************************************************************************001490
*                          *  D D L R E A D *                          *001500
*                                                                      *001510
*  ENTRY CONDITION:                                                    *001520
*         LFN FOR THE INPUT FILE IS STORED IN THE EXTERNAL ITEM INFILE *001530
*         AND THE LFN FOR THE OUTPUT FILE IS STORED IN THE EXTERNAL    *001540
*         ITEM OUTFILE.                                                *001550
*  EXIT CONDITIONS:                                                    *001560
*         THE PREVIOUS RECORD IS WRITTEN TO THE OUTPUT FILE( IF LIST   *
*         OPTION IS ON ).                                              *
*  EXTERNAL REFERENCES:                                                *001580
*         ITEMS INFILE,OUTFILE AND DDLCOMP.                            *
*         CONVERSION ROUTINE CDD.                                      *
*         CRM MACROS GET,PUT AND FETCH.                                *
*  DESCRIPTION                                                         *001610
*         DDLREAD READS A RECORD FROM DDLS SOURCE INPUT. IT ALSO WRITES*001620
*         THE RECORD ONTO THE DDL OUTPUT FILE IF THE USER DID NOT      *001630
*         SUPPRESS THE OUTPUT LISTING. DDLS OUTPUT LISTING CONFORMS TO *001640
*         THE STANDARDS OF OTHER COMPILER LISTINGS. THIS ENTAILS A PAGE*001650
*         HEADER THAT CONTAINS THE SCHEMA OR SUBSCHEMA NAME, THE       *001660
*         CONSTANT * SOURCE LISTING * (DATE OF RELEASE) DDL3.0+(BUILD  *
*         LEVEL), THE DATE AND TIME OF JOB EXECUTION AND PAGE NUMBER.  *
*         DATE AND TIME OF JOB EXCUTION IS OBTAINED WITH THE USE OF THE*001710
*         CLOCK AND DATE MACRO. THE PAGE NUMBER IS A DISPLAY CODE      *001720
*         COUNTER. THE PAGE HEADER IS THE FIRST LINE PRINTED ON A PAGE,*001730
*         FOLLOWED BY TWO BLANK LINES, FOLLOWED BY A MAXIMUM OF FIFTY  *001740
*         EIGHT LINES SOURCE CODE. THE FIRST 9 PRINT POSITIONS OF THE  *001750
*         SOURCE PRINT LINE WILL CONTAIN A SEQUENCE NUMBER. DDLREAD    *
*         WILL MAINTAIN THE COUNTER IN BINARY AND WILL CONVERT IT TO   *001770
*         DISPLAY CODE FOR PRINTING. THE BINARY VALUE IS STORED IN THE *001780
*         ITEM LINENBR. DDL NOW GETS THE DDL SOURCE INPUT RECORD AND   *
*         PLACES IT INTO THE WORKING STORAGE AREA DDLIWSA. THE LENGTH  *
*         IN CHARACTERS OF THE SOURCE INPUT RECORD IS STORED IN DDLIRL.*
************************************************************************001850
 DDLREAD  DATA   0                                                      001860
          SA1    NOLIST                                                 001870
          NZ     X1,DDLRD2                                              001880
          SA3    FSTTIME                                                001890
          NZ     X3,CONT6                                               001900
          SX7    1                                                       BH 
          SA7    A3                                                     001930
          EQ     DDLRD2                                                 001940
CONT6     SA3    PRTIRL 
          SA2    ORDFLAG
          ZR     X2,CONT7 
          SX6    140
          MX7    0
          SA7    ORDFLAG
          EQ     CONT8
CONT7     SX6    X3+31
CONT8     SA6    P2 
          SA1    P                                                      001980
          RJ     DDLPRNT                                                001990
          EQ     DDLRD2                                                 000300
 INCRLNE  DATA   0                                                      000310
          SA1    DSPLNBR                                                002000
          SA2    INCRMNT                                                002010
          SA4    SIXES                                                  002020
          IX3    X2+X1                                                  002030
          BX2    -X3*X4                                                 002040
          SA5    THREES                                                 002050
          IX6    X3+X2                                                  002060
          AX2    3                                                      002070
          IX6    X6-X5                                                  002080
          SA3    BLNKEQV                                                002090
          IX6    X6+X2                                                  002100
          IX7    X6+X3                                                  002110
          SA7    NBRLINE                                                002120
          SA6    DSPLNBR                                                002130
          SA3    DDLIRL                                                 002140
          SX6    X3+30                                                  002150
          SA6    P2                                                     002160
          SA1    P                                                      002170
          SX5    1                                                       BH 
          SA4    LINENBR                                                002190
          IX7    X5+X4                                                  002210
          SA7    A4                                                     002220
          EQ     INCRLNE                                                000330
 DDLRD2   GET    INPUT,DDLIWSA,90 MOVE INPUT RECORD INTO WSA.           002230
          SX1    INPUT
          RJ     CKERR
          RJ     CKEOF             CHECK IF EOR OR EOI
          NZ    X7,DDLEND 
          FETCH  INPUT,RL,X7 GET THE RECORD LENGTH FROM THE FIT.        002240
          SA7    DDLIRL   STORE RECORD LENGTH.                          002250
          SA7    PRTIRL 
          EQ     DDLREAD                                                002260
          SPACE  1
DDLEND    BSS    0             END DDL PROCESSING 
          SX6    1                                                       BH 
          SA6    =XDDLEOF                                               006330
          SA2    BLKLINE
          BX7    X2 
          SA7    NBRLINE
          RJ     =XENDDL                                                006340
          SPACE  1
 DDLPRNT  DATA   0                                                      002270
          SX3    2
          SA2    =XDDLCOMP
          IX5    X2-X3
          ZR     X5,CONTPRT 
          SA2    LINECTR           GET LINE COUNTER.                    002280
          SA3    LINELIM
          SB1    1
          SX6    X2+B1             INCREMENT LINE COUNTER 
          IX4    X2-X3
          PL     X4,PAGENBR        CHECK IF EXCEEDED MAX LINE COUNT.    002310
          SA6    A2                STORE LINE COUNT.                    002320
CONTPRT   SA2    A1+1              GET ADDRESS OF 2ND PARAMETER 
          SA2    X2                                                     002340
 PRNTLNE  PUT    OUTPUT,X1,X2      PRINT LINE                           002350
          EQ     DDLPRNT           RETURN TO CALLER                     002360
 PAGENBR  SX7    A1                GET PARAMETER LIST ADDR.             002370
          SA7    PARMADR           SAVE ADDR                            002380
          SA1    PAGCNT            GET PAGE COUNTER                     002390
          SX6    X1+1 
          BX1    X6                INCREMENT IT 
          SA6    A1 
          RJ     =XCDD=      CONVERT TO DECIMAL 
          LX6    4*6               STORE IN HEADER LINE 
          SA6    PAGACM 
          PUT    OUTPUT,HDR1,137   WRITE PAGE HDR                       002580
          PUT    OUTPUT,SPACER,10  SKIP LINE                            002590
          SA3    PARMADR           GET ADDR OF PARAMETER LIST.          002600
          SA1    X3                                                     002610
          SX6    B1 
          SA2    A1+1                                                   002630
          SA6    LINECTR                                                002640
          SA2    X2                                                     002650
          EQ     PRNTLNE                                                002660
*********************************************************************** 005050
*                 * D D L A B T ( P A R M ) *                          *
*                                                                      *
*         IF PARM = 0, ISSUES MESSAGE 2 TO THE DAYFILE.                *
*         IF PARM = 5, ISSUES MESSAGE 8 TO THE DAYFILE.                *
*         IF PARM " 0 AND " 5, ISSUES MESSAGE 1 TO THE DAYFILE.        *
*         AFTER WHICH, THE DDL RUN IS ABORTED.                         *
*                                                                      *005100
*********************************************************************** 005110
DDLABT    DATA   0                                                      005120
          SA1    X1                                                     005130
          ZR   X1,ABRT2 
          SX3    5
          IX3    X3-X1
          ZR     X3,ABRT6 
          SA2    MSG1                                                   005150
          EQ     WRAPUP                                                 005160
 ABRT1    DATA    0                                                     000330
          SA2    MSG5                                                   000340
          EQ     WRAPUP                                                 000350
 ABRT3    DATA    0                                                     000360
          SA2    MSG6                                                   000370
          EQ     WRAPUP                                                 000380
 ABRT4    DATA   0
          MESSAGE MSG7,,RECALL                                          000460
          PUT    OUTPUT,MSG7,50 
          RJ     CLSEOUT
          ABORT 
ABRT5     DATA   0
          SA1    D99
          SA2    NBRLINE
          BX6    X2 
          SA6    A1+1 
          PUT    OUTPUT,D99,115 
          SA3    =XDDLCOMP
          SX4    1
          IX5    X3-X4
          ZR     X5,ABRT2 
          RJ     ABRT4
ABRT6     BSS    0
          SA2    MSG8 
          EQ     WRAPUP 
 ABRT7    DATA   0                 ENTRY FROM SCHEMIO - CHECKSUM ABORT
          SA2    MSG9 
          EQ     WRAPUP 
MSSABRT   DATA   0                 FOR MULTIPLE SS COMP ONLY
          PUT    OUTPUT,MSG7,50 
          RJ     CLSEOUT
          EQ     MSSABRT
ABRT2     BSS    0                                                      005170
          SA2    MSG2                                                   005180
WRAPUP    BSS    0                                                      005190
          MESSAGE A2,,RECALL                                            000480
          CLOSEM OUTPUT,N                                               005210
          ABORT                                                         005220
MSG1      DATA   28LCONTROL CARD ERROR                                  005230
MSG2      DATA   28LFATAL SYNTAX ERRORS                                 005240
MSG6     DIS    ,*EMPTY INPUT FILE      DDL ABORTED*                    000310
MSG5     DIS    ,*INSUFFICIENT FIELD LENGTH   DDL ABORTED*              000315
 MSG7     DIS    ,*    COMPILATION ERRORS-   NO SUB-SCHEMA CREATED* 
MSG8      DIS    ,*SUB-SCHEMA LIBRARY ERROR---DDL ABORTED*
 MSG9     DIS    ,*CHECKSUM I/O ERROR - DDL ABORTED*
          SPACE  1
************************************************************* 
** CLOSE OUTPUT FILE, AFTER WRITING MESSAGES GIVING FIELD   * 
** LENGTH, NUMBER OF DIAGNOSTICS, AND CP TIME USED.         * 
 CLSEOUT  DATA   0                                                      005750
          SA1     =XDDLCOMP 
          SB1    1
          SX3    B1+B1
          IX5    X3-X1
          ZR     X5,CLSOUT2        CHECK FOR EXHIBIT COMPILATION
          SA1    ERRCNTR
          RJ     =XCDD=      CONVERT ERROR COUNT TO DECIMAL 
          LX6    4*6               POSITION ERROR COUNT 
          SA2    MSG4+2            AND
          MX0    5*6               MASK 
          LX0    9*6
          BX2    -X0*X2            INTO 
          BX6    X0*X6
          BX6    X6+X2             MESSAGE
          SA6    A2 
          SA1    DDLSU       GET STORAGE USED 
          SA3    MAXSU       GET MAX STORAGE USED 
          IX5    X3-X1
          PL     X5,SKIPMSU  IF MAX LESS THAN CURRENT 
          SX6    X1 
          SA6    MAXSU       STORE CURRENT STORAGE USED AS MAX
 SKIPMSU  MX0    -6 
          IX1    X1-X0       ROUND UP TO A MULTIPLE OF 100B 
          AX1    6
          LX1    6
          RJ     =XCOD=      CONVERT TO OCTAL 
          LX6    2*6
          SX4    2RB -2R     APPEND *B* SUFFIX
          IX6    X6+X4
          SA6    MSG4A             STORE IN MESSAGE 
          TIME   PARMADR
          SA5    CPTIME      STARTING TIME
          SA1    PARMADR     CURRENT TIME 
          IX2    X1-X5       TIME DIFFERENCE
          SA1    CPTMET            ACCUMULATED TIME(FOR MULT COMP)
          IX6    X1+X2             ADD CURRENT COMP TIME TO ACCUM 
          SA6    CPTMET            NEW ACCUM TIME 
          RJ     CPTMCON           CONVERT AND FORMAT CP TIME 
          LX6    5*6
          BX6    X6-X5       COMBINE RESULTS
          SA6    MSG4A+2           STORE CP TIME IN MESSAGE 
          PUT    OUTPUT,MSG4,40 
          PUT    OUTPUT,MSG4A,40
          SA1    =XDDLCOMP
          SX5    X1-5 
          ZR   X5,CLSOUT0          IF COBOL SUBSCHEMA 
          SX5    X1-4 
          NZ   X5,CLSOUT1          IF QU/CDCS SUBSCHEMA 
 CLSOUT0  RJ   DFSSMSG             GENERATE DIFFERENT DAYFILE MESSAGES
  
          EQ     CLSOUT2
 CLSOUT1  MESSAGE MSG4,,RECALL     GENERATE NORMAL
          MESSAGE MSG4A,,RECALL    DAYFILE MESSAGES 
 CLSOUT2  CLOSEM OUTPUT,N 
          EQ     CLSEOUT                                                005770
 CLSEIN   DATA   0                                                      005780
          CLOSEM INPUT,N     CLOSE THE INPUT FILE.                      005790
          EQ     CLSEIN                                                 005800
************************************************************************
*                         *  D F S S M S G  *                          *
*                                                                      *
*         ROUTINE TO GENERATE DAYFILE MESSGES FOR COBOL AND QU/CDCS 
*         SUBSCHEMAS BECAUSE OF THE MULTIPLE COMPILE CAPABILITY.       *
*         ON ENTRY ALL MESSAGES HAVE BEEN WRITTEN TO THE OUTPUT        *
*         FILE,EXCEPTING DAYFILE MESSAGES.                             *
************************************************************************
 DFSSMSG  DATA   0
          SA1    =XABORTFL         FATAL ERRORS 
          ZR     X1,DFMSG2         IF FATAL ERRORS
          SA1    ERRCNTR           ERROR COUNT
          RJ     =XCDD=      CONVERT ERROR COUNT TO DECIMAL 
          LX6    4*6               POSITION ERROR COUNT 
          SA2    MCMSG4+1          AND
          MX0    5*6               MASK 
          LX0    9*6
          BX2    -X0*X2            INTO 
          BX6    X0*X6
          BX6    X6+X2             MESSAGE
          SA6    A2 
          SA1    NAMEID            SUBSCHEMA NAME(FIRST 10 CHARS) 
          BX6    X1 
          SA6    MCMSG4+3          STORE SS NAME IN MESSAGE 
          MESSAGE MCMSG4,,RECALL   GENERATE DAYFILE MESSAGE 
          EQ     DFMSG3 
 DFMSG2   SA1    TRVERR            TRIVIAL COMP ERROR INDICATOR 
          ZR     X1,DFMSG1         IF SET 
          MESSAGE MCMSG2,,RECALL   GENERATE MESSAGE 
 DFMSG1   SA1    NAMEID            SUBSCHEMA NAME(10 CHARS) 
          BX6    X1 
          SA6    MCMSG1+1          STORE SS NAME IN MESSAGE 
          SA1    SKIPMSG
          NZ     X1,DFMSG3
          MESSAGE MCMSG1,,RECALL
 DFMSG3   SA1    MULTSS            MULTIPLE COMPILE FLAG
          NZ     X1,DFSSMSG        IF MULT COMPILE - RETURN 
 DFMSG3A  SA2    CPTMET            ACCUMULATED COMPILATION TIMES
          RJ     CPTMCON           CONVERT AND FORMAT ACCUM CP TIME 
          LX6    5*6
          BX6    X6-X5             COMBINE RESULTS
          SA6    MCMSG3+3          STORE CP TIME IN MESSAGE 
          MESSAGE MCMSG3,,RECALL
          SA1    MAXSU             GET MAXIMUM STORAGE USED 
          MX0    -6 
          IX1    X1-X0             ROUND UP TO A MULTIPLE OF 100B 
          AX1    6
          LX1    6
          RJ     =XCOD=      CONVERT TO OCTAL 
          MX0    4*6               MASK 
          SA2    MCMSG3A+2
          BX2    X0*X2             INTO 
          BX6    -X0*X6 
          BX6    X2+X6
          SA6    MCMSG3A+2         MESSAGE
          MESSAGE MCMSG3A,,RECALL 
          EQ     DFSSMSG           RETURN 
************************************************************************006110
*                          *  C K E O F  *                             *006120
*                                                                      *006130
*  DESCRIPTION:                                                        *006140
*         CHECK FOR END-OF-FILE. IF X7 = 0 END-OF-FILE HAS NOT BEEN    *006150
*         REACHED.  IF X7 = 1  END-OF-FILE HAS OCCURRED.
************************************************************************006170
 CKEOF    DATA   0                                                      006180
          FETCH  X1,FP,X2    FETCH THE STATUS OF THE FILE POSITION FLD. 006190
          SB1    X2                                                     006200
          SB1    B1-10B      CIF E.O.S. 
          EQ     B1,SETEOF
          SB1    B1+10B-40B  CIF E.O.P. 
          EQ     B1,SETEOF
          SB1    B1+40B-100B CIF E.O.I. 
          EQ     B1,SETEOF
          SX7    0           X7 TO 1, ELSE 0.                           006230
          EQ     CKEOF       RETURN TO CALLER.                          006240
 SETEOF   SX7    1                                                      006250
          EQ     CKEOF       RETURN TO CALLER.                          006260
 CKERR    SPACE  10,20
**        CKERR - CHECK ERROR STATUS IN FIT.
* 
*         IF ERROR IS A 721 THE RUN IS ABORTED
*         ANY OTHER ERROR IS IGNORED. 
* 
*         ENTRY - 
*                X1 = FIRST WORD ADDRESS OF FIT 
* 
  
 CKERR    EQ     *+400000B         ENTRY/EXIT 
          FETCH  X1,ES,X2 
          SX2    X2-721B
          NZ     X2,CKERR          NOT 721, EXIT
          MESSAGE ERR721,,RCL 
          PUT    OUTPUT,ERR721,30 
          RJ     ABRT3
 ERR721   DIS    ,+ ***  FATAL CRM ERROR 721 *** +
 MEMORY   SPACE  10,10                                                   BI 
************************************************************************
*                         *  C P T M C O N  *                          *
*                                                                      *
*         CONVERTS THE CP TIME INTO DISPLAY DECIMAL(BOTH THE REAL      *
*         AND THE FRACTIONAL PART). THE PRIMARY PURPOSE OF THIS        *
*         CONVERSION AND FORMATTING IS FOR INSERTION INTO MESSAGES     *
*         TO BE DISPLAYED IN THE OUTPUT LISTING.                       *
*                                                                      *
*         ON ENTRY --                                                  *
*                X2 - CONTAINS THE TIME TO BE CONVERTED AND FORMATTED. *
*                     CONTENTS OF X2 ARE IN THE FORM AS GENERATED BY   *
*                     THE TIME MACRO.                                  *
*         ON EXIT --                                                   *
*                X5 - CONTAINS THE FRACTIONAL PART(*     .NNN *)       *
*                X6 - CONTAINS THE REAL PART(*       NNN*)             *
************************************************************************
 CPTMCON  DATA   0
          BX5    X2 
          LX2    -12
          SX3    1000-1S12
+         MX0    -12
          PL     X2,CPTM1          IF NO BORROW 
          IX5    X5+X3
CPTM1     BX1    -X0*X5            MILLISECONDS 
          SX1    X1+1000           FORCE LEADING ZEROS
          RJ     =XCDD=      CONVERT TO DECIMAL 
          AX5    12 
          SX1    X5                SECONDS
          SA2    CPTMA
          LX6    6                 CHANGE *1* TO *.*
          BX5    X6-X2
          RJ     =XCDD=      CONVERT SECONDS TO DECIMAL 
          EQ     CPTMCON           RETURN 
************************************************************************
*                          *  M E M O R Y  *                           *
*                                                                      *
*         ARGUMENT IS AMOUNT OF FIELD LENGTH TO REQUEST.               *
*         RETURNS WITH B<0,30> DDLMEM = NEW FIELD LENGTH.              *
************************************************************************
 MEMORY   SUBR   =           ENTRY/EXIT 
          SA1    X1 
          LX1    30 
          BX6    X1 
          SA6    DDLMEM 
          MEMORY CM,DDLMEM,R
          JP     EXIT.
  
  
**        MULINIT - RE-INITIALIZE PERTINENT FIELDS FOR MULT SS COMPILE
MULINIT   DATA   0
          SX6    B0 
          SA6    PAGCNT 
          SA6    DDLSU
          SA6    ERRCNTR
          SA6    =XLINEFLG
          SA2    INCRMNT
          BX6    X2 
          SA6    DSPLNBR
          SX6    2
          SA6    LINENBR
          SA2    LININIT
          BX6    X2 
          SA6    NBRLINE
          SA2    BLINE
          BX6    X2 
          SA6    NAMEID 
          SA6    HDR2 
          SA2    JPS         GET PAGE SIZE
          BX6    X2 
          SA6    LINECTR
          EQ     MULINIT
          FILE   LFN=OUTPUT,BFS=260,FWB=OUTBUF,MBL=2560,WSA=DDLOWSA,LT=U
,L,RT=Z,BT=C,MRL=137,EFC=3,ERL=10                                        D2A165 
          FILE   LFN=INPUT,BFS=260,FWB=INBUF,MBL=2560,WSA=DDLIWSA,LT=UL,
,RT=Z,BT=C,MRL=90,EFC=3,ERL=10                                           D2A165 
 P2       BSSZ   1                                                      006590
 BLKLINE  DATA   10H                                                    006600
*                            RRIAGE CONTROL.                            006610
 NBRLINE  DATA   10H     00001                                          006620
 BLINE    DATA   10H                                                    006630
 DDLIWSA  BSS    8           INPUT WORKING STORAGE AREA.                006640
          DATA   10H
          DATA   10H** ORDINAL
ORDNUM    DATA   10H
 DDLOWSA  EQU    *+1S17      OUTPUT WORKING STORAGE AREA
 INBUF    BSSZ   260                                                    006750
 OUTBUF   BSSZ   260                                                    006760
DDLIRL    DATA   0                                                      006820
PRTIRL    DATA   0
 JULDAT   BSS    1                 JULIAN DATE
 PARMADR  BSS    1           CONTAINS THE ADDRESS OF THE PARAMETER LIST 006840
 NOLIST   BSSZ   1           LISTIN FLAG 0 = NO LIST 1 = LISTING        006850
 LINECTR  CON    LINP        COUNT OF LINES ON CURRENT PAGE 
 LINELIM  CON    LINP-3 
LININIT   DATA   10H     00001
ORDFLAG   BSSZ   1
 DDLMEM   BSSZ   1                                                      006870
 DDLSU    BSSZ   1
 MAXFL    VFD    30/-1,30/0 
 NAMEID   DATA   10H               CONTAINS 10 CHARS OF THE SS NAME 
 LINENBR  DATA   1                                                      006950
 PGSIZE   BSSZ   2           PAGE SIZE PARAMETER BLOCK
 FE8L     DATA   8LT 8 LPI   8 LINES/INCH FORMAT EFFECTOR 
 JPD      DATA   8LS 6 LPI   JPD PRESET TO 6 LINES/INCH 
 JPS      DATA   0           PAGE SIZE
 HDR1     DATA   10H1                                                   006960
 HDR2     DATA   30H                                                    006970
 HDR3     DATA   20H  * SOURCE LISTING *
 HDR3A    DATA   10H   ("JDATE")
 HDR4     DATA   20H  DDL  "VER"+"LEV". 
 HDR5     DATA   10H                                                    006990
 HDR6     DATA   10H                                                    007000
 HDR7     DATA   10H      PAGE
 PAGACM   DATA   10H     0
 HDR8     DATA   10H                                                    007030
 SPACER   DATA   0                                                      007040
 FSTTIME  BSSZ   1                                                      007050
 PAGCNT   DATA   0
 DSPLNBR  DATA   10H0000000000                                          000410
 SIXES    DATA   10H##########                                          007080
 THREES   DATA   10H0000000000                                          007090
 BLNKEQV  DATA   5LRRRRR                                                007100
 INCRMNT  DATA   10H0000000001                                          007110
 P        CON    BLKLINE                                                007120
          CON    P2                                                     007130
 ERRCNTR  DATA   0
 MSG4     DATA   C* DDL COMPLETE.       NNNNN DIAGNOSTICS. *
 MSG4A    DATA   C*  NNNNNNB CM USED.     000.000 CP SECS. *
CPTIME    BSS    1
 CPTMA    VFD    36/6R      &1R1&1R.,24/4R
 CPTMET   BSS    1
D99       DATA   50H  ***99 ***                SOURCE WORD LONGER THAN
          DATA   50H 255 CHARACTERS, UNABLE TO CONTINUE COMPILATION  -
          DATA   15H DDL ABORTED  - 
 CRMLEV   DATA   10H1.5 
 MAXSU    DATA   0                 CONTAINS THE MAX STORAGE USED
 SKIPMSG  DATA   0
 MCMSG1   DATA   C*-DDL-  SS-                      COMPILED*
 MCMSG2   DATA   C*     NON-FATAL ERRORS--SEE LISTING      *
 MCMSG3   DATA   C*  DDL COMPLETE.  TOTAL CP SECS = NNN.NNN*
 MCMSG3A  DATA   C*    MAX. STORAGE USED = NNNNNNB WORDS   *
 MCMSG4   DATA   C+-DDL-  *** NNNNN ERRORS IN SS-          +
          END                                                           007770
