*DECK CTLIO 
          IDENT  CTLIO                                                  009330
          LIST   F
          ENTRY  NAMEID                                                 000130
          ENTRY  DMLABT                                                 009390
          ENTRY  DMLOPEN                                                009400
          ENTRY  WDMLOUT                                                009410
          ENTRY  TRACOUT                                                000590
          ENTRY  WSSOUT1                                                009420
          ENTRY  WSSOUT2                                                009430
          ENTRY  PRES1S2                                                001220
          ENTRY  LENS1S2                                                000930
          ENTRY  LENS1                                                  000170
          ENTRY  LENS2                                                  000180
          ENTRY  READS1                                                 001230
          ENTRY  READS2                                                 001240
          ENTRY  CLS1S2                                                 001250
          ENTRY  DDLOPEN                                                000140
          ENTRY  DDLREAD                                                000150
          ENTRY  CKEOF
          ENTRY  CLSEIN                                                 000270
          ENTRY  CLSEOUT                                                000280
          ENTRY DDLIWSA                                                 000300
          ENTRY DDLPRNT                                                 000310
          ENTRY  INPUT
          ENTRY  NBRLIN                                                 005850
          ENTRY  DDLABT                                                 000430
          ENTRY  DDLIRL                                                 000440
          ENTRY  LINECTR
          ENTRY  LINELIM
          ENTRY  LINNBR                                                 005870
          ENTRY  DDLMEM                                                 000470
          ENTRY  DDLSU
          ENTRY  MAXFL
          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  BLKLIN                                                 005890
          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,U),USEBT=(C),USE=(OPENM,CLOSEM,GET,GETP,PUT000130
,,PUTP,FETCH,STORE,SKIPFL,REWINDM,WEOR,TGET,TPUT),OMIT=(CMM)            000140
 WA      STLD.RM  USERT=(U,W),USE=(OPENM,CLOSEM,GET,PUT,FETCH,STORE),OMI000150
,T=(CMM)                                                                000160
 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,*1.3*
 LEV      MICRO  1,3,*"MODLEVEL"*  MODIFICATION LEVEL 
  
 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.                                          *
*          FOR FORTRAN, SCRATCH FILES FOR SSOUT (ZZZZZS1,ZZZZZS2) ARE  *000130
*          OPENED.                                                     *000140
************************************************************************000990
SSOUT1    FILE   LFN=ZZZZZS1,FO=WA,RT=W,BT=C,FWB=S1BUF,BFS=66,MRL=32000 000160
S1BUF     BSSZ   66                                                     000190
SSOUT2    FILE   LFN=ZZZZZS2,FO=WA,RT=W,BT=C,FWB=S2BUF,BFS=66,MRL=32000 000180
S2BUF     BSSZ   66                                                     000130
S1        FILE   LFN=ZZZZZS1,FO=WA,RT=U,BT=C,FWB=BUFS1,BFS=66,MRL=50000 000140
BUFS1     BSSZ   66                                                     000150
S2        FILE   LFN=ZZZZZS2,FO=WA,RT=U,BT=C,FWB=BUFS2,BFS=66,MRL=50000 000160
BUFS2     BSSZ   66                                                     000170
 DDLOPEN  DATA   0                                                      001000
DMLOPEN   EQU    DDLOPEN                                                009480
          OPENM  SSOUT1,OUTPUT                                          000210
          OPENM  SSOUT2,OUTPUT                                          000220
          STORE  SSOUT1,WA=1
          STORE  SSOUT2,WA=1
          JDATE  JULDAT 
          SA1    JULDAT                                                 009360
          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
          MX6    1                                                      001210
          LX6    1                                                      001220
          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) DDLF1.1+(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. DDLF NOW GETS THE DDLF 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
          MX7    1                                                      001910
          LX7    1                                                      001920
          SA7    A3                                                     001930
          EQ     DDLRD2                                                 001940
CONT6     SA3    PRTIRL      PICK UP LAST INPUT LINE LENGTH             000150
          SX6    X3+30       ADD 30 FOR PRINT MARGIN,STORE DDLPRNT PARAM000160
CONT8     SA6    P2 
          SA1    P                                                      001980
          RJ     DDLPRNT                                                001990
          EQ     DDLRD2                                                 000300
 INCRLN   DATA   0           ONLY DDLRD2 SHOULD CALL THIS ROUTINE       000180
          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    NBRLIN                                                 005930
          SA6    DSPLNBR                                                002130
          SA3    DDLIRL                                                 002140
          SX6    X3+30                                                  002150
          SA6    P2                                                     002160
          SA1    P                                                      002170
          MX5    1                                                      002180
          SA4    LINNBR                                                 005950
          LX5    1                                                      002200
          IX7    X5+X4                                                  002210
          SA7    A4                                                     002220
          EQ     INCRLN                                                 000200
 DDLRD2   GET    INPUT,DDLIWSA,90 MOVE INPUT RECORD INTO WSA.           002230
          SX1    INPUT
          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 
          RJ     INCRLN      INCREMENT LINE NUMBER                      000220
          EQ     DDLREAD                                                002260
          SPACE  1
DDLEND    BSS    0             END DDL PROCESSING 
          MX6    1                                                      006310
          LX6    1                                                      006320
          SA6    =XDDLEOF                                               006330
          SA2    BLKLIN                                                 008130
          BX7    X2 
          SA7    NBRLIN                                                 005970
          EQ     DDLREAD     RETURN TO SAME PLACE AS NORMAL READ        005980
          SPACE  1
 DDLPRNT  DATA   0                                                      002270
TRACOUT   EQU    DDLPRNT           DDLF TRACE OUTPUT GOES TO OUTPUT FILE000570
WDMLOUT   EQU    DDLPRNT                                                009500
          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
          ZR     X2,DDLPRNT        IF RL = 0 IGNORE LINE
 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                         000460
          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
************************************************************************000250
*                * W S S O U T 1  ,  W S S O U T 2 *                   *000260
*         WRITE TO SSOUT1 OR SSOUT2. PARAMS ARE (ADDR,LENGTH)          *000270
************************************************************************000280
WSSOUT1   SUBR   =                                                      000290
          SX7    A1                GET PARAMETER LIST ADDR FROM A1      000610
          SA7    PARMADR           SAVE ADDR                            000620
          RJ     CKTRACE           IF TRACE IS ON, PUT TO OUTPUT, TOO   002550
          SA3    PARMADR           RESTORE PARAMETER LIST ADDR TO A1    000640
          SA1    X3                                                     000650
          SA2    A1+1              GET ADDRESS OF 2ND PARAMETER         000660
          SA2    X2                                                     005270
          PUT    SSOUT1,X1,X2                                           000310
          JP     EXIT.                                                  000320
WSSOUT2   SUBR   =                                                      000330
          SX7    A1                GET PARAMETER LIST ADDR FROM A1      000680
          SA7    PARMADR           SAVE ADDR                            000690
          RJ     CKTRACE           IF TRACE IS ON, PUT TO OUTPUT, TOO   002570
          SA3    PARMADR           RESTORE PARAMETER LIST ADDR TO A1    000710
          SA1    X3                                                     000720
          SA2    A1+1              GET ADDRESS OF 2ND PARAMETER         000730
          SA2    X2                                                     005290
          PUT    SSOUT2,X1,X2                                           000350
          JP     EXIT.                                                  000360
 CKTRACE  SUBR   =                                                      002590
          SA4    =XTRSSOUT   CHECK TRACE-SSOUT FLAG                     001490
          ZR     X4,EXIT.          IF TRACE FLAG WAS EVER TURNED ON,    002650
          RJ     DDLPRNT           DDLPRNT IS CALLED                    002660
          JP     EXIT.             RETURN TO WSSOUT1/2                  002670
                                                                        002680
************************************************************************000370
*                * ADD SSOUT1, SSOUT2 TO SUBSCHEMA *                   *000380
*         ADD FORTRAN SCRATCH FILES SSOUT1 AND SSOUT2 TO SUBSCHEMA     *000390
*         PRES1S2 PREPARES FILES.                                      *000400
*         THEN SSLIB CALLS READS1/S2, DDLRTSB, AND CLS1S2.             *000410
************************************************************************000420
PRES1S2   DATA   0                                                      000430
          PUT    SSOUT2,ENDS2,10 WRITE END OF FILE MARKER               001510
          FETCH  SSOUT1,WA,X7  GET LENGTH OF FILE                       000160
          MX1    -1                                                     000162
          IX7    X7+X1                                                  000164
          SA7    LENS1                                                  000210
          FETCH  SSOUT2,WA,X6                                           000180
          IX6    X6+X1                                                  000182
          SA6    LENS2                                                  000230
          SA1    LENS1                                                  000240
          IX7    X1+X6           ADD LENGTHS OF S1, S2                  000250
          SA7    LENS1S2         STORE IN LENS1S2                       001030
          CLOSEM SSOUT1,DET                                             001450
          CLOSEM SSOUT2,DET      CLOSE, DETACH                          001460
          OPENM  S1,INPUT,R        REOPEN WITH DIFFERENT FIT            000210
          OPENM  S2,INPUT,R                                             000220
          STORE  S1,WA=1
          STORE  S2,WA=1
          EQ     PRES1S2         RETURN                                 000550
                                                                        000950
LENS1     DATA   0                                                      000280
LENS2     DATA   0                                                      000290
 LENS1S2  DATA   0               LENGTH OF SSOUT1 + SSOUT2              000960
                                                                        000560
**        READS1 - READ SSOUT1                                          000570
*                                                                       000580
*         PROC READS1 (B, S, N).                                        000590
*                                                                       000600
*         ARRAY  B           BUFFER TO READ INTO.                       000610
*         ITEM   S           BUFFER SIZE IN WORDS.                      000620
*         ITEM   N           NUMBER OF WORDS READ INTO B.               000630
                                                                        000640
                                                                        000650
 READS1   SUBR   =           ENTRY/EXIT                                 000660
          SA2    A1+1        LOC OF S                                   000670
          SA3    A1+2        LOC OF N                                   000680
          SA2    X2          VALUE OF S                                 000690
          SX6    X3          SAVE LOC OF N                              000700
          SA6    LOCN1                                                  000710
          IX3    X2+X2       S * 10                                     000720
          LX2    3                                                      000730
          IX2    X2+X3                                                  000740
          GET    S1,X1,X2  READ S WORDS INTO B                          000240
          FETCH  S1,RL,X6                                               000250
          SX1    1S20/10+1                                              000770
          IX6    X6*X1       PARTIAL TRANSFER LENGTH / 10               000780
          SA1    LOCN1                                                  000790
          AX6    20                                                     000800
          SA6    X1          STORE N                                    000810
          JP     EXIT.       RETURN                                     000820
                                                                        000830
 LOCN1    DATA   0           LOC OF N                                   000840
                                                                        000850
**        READS2 - READ SSOUT2                                          000860
*                                                                       000870
*         PROC READS2 (B, S, N).                                        000880
*                                                                       000890
*         ARRAY  B           BUFFER TO READ INTO.                       000900
*         ITEM   S           BUFFER SIZE IN WORDS.                      000910
*         ITEM   N           NUMBER OF WORDS READ INTO B.               000920
                                                                        000930
                                                                        000940
 READS2   SUBR   =           ENTRY/EXIT                                 000950
          SA2    A1+1        LOC OF S                                   000960
          SA3    A1+2        LOC OF N                                   000970
          SA2    X2          VALUE OF S                                 000980
          SX6    X3          SAVE LOC OF N                              000990
          SA6    LOCN2                                                  001000
          IX3    X2+X2       S * 10                                     001010
          LX2    3                                                      001020
          IX2    X2+X3                                                  001030
          GET    S2,X1,X2  READ S WORDS INTO B                          000270
          FETCH  S2,RL,X6                                               000280
          SX1    1S20/10+1                                              001060
          IX6    X6*X1       PARTIAL TRANSFER LENGTH / 10               001070
          SA1    LOCN2                                                  001080
          AX6    20                                                     001090
          SA6    X1          STORE N                                    001100
          JP     EXIT.       RETURN                                     001110
                                                                        001120
 LOCN2    DATA   0           LOC OF N                                   001130
                                                                        001140
**        CLS1S2 - CLOSE,UNLOAD SSOUT1,SSOUT2                           001150
CLS1S2    DATA   0                                                      001160
          CLOSEM S1,U 
          CLOSEM S2,U 
          EQ     CLS1S2                                                 001190
                                                                        001200
*********************************************************************** 005050
*                 * D D L A B T ( P A R M ) *                          *
*                                                                      *
*      CALLING SEQUENCE -                                              *
*         DDLABT(ABORT TYPE,CCPARM *OPTIONAL*)                         *
*                                                                      *
*         IF PARM = 0, ISSUES MESSAGE 2 TO THE DAYFILE.                *
*         IF PARM = 1,                                                 *
*                STORE PARAMETER 2 IN MESSAGE 10                       *
*                ISSUE MESSAGE 1 AND 10 TO THE DAYFILE                 *
*                NOTE - PARAMETER 2 IS BINARY ZERO FILLED TO           *
*                       TERMINATE PRINTING                             *
*         IF PARM = 2, ISSUE MESSAGES 1 AND 11 TO THE DAYFILE          *
*         IF PARM = 5, ISSUES MESSAGE 8 TO THE DAYFILE.                *
*                                                                      *005100
*********************************************************************** 005110
DDLABT    DATA   0                                                      005120
DMLABT    EQU    DDLABT                                                 009460
          SA4    A1+1              LOAD SECOND (OPTIONAL) PARAMETER 
          SA4    X4                VALID ONLY IF PARM 1 = 1 
          SA5    X1                LOAD ABORT TYPE
          ZR     X5,ABRT2          IF ABORT TYPE = 0 (SYNTAX ERROR) 
  
          SX3    5
          IX3    X3-X5
          ZR     X3,ABRT6          IF ABORT TYPE = 5 (LIBRARY ERROR)
  
          SA2    MSG1                                                   005150
          MESSAGE A2,,RECALL       CONTROL CARD ERROR 
          SX3    1
          IX3    X3-X5
          ZR     X3,ABRT8          IF ABORT TYPE = 1 (PARAMETER ERROR)
  
          SA2    MSG11             ELSE, ASSUME ABORT TYPE = 2
          EQ     WRAPUP            (INCOMPATIBLE PARAMETERS)
  
 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    NBRLIN                                                 006000
          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 
  
 ABRT8    BX6    X4                CNTL CARD ERROR - INVALID PARAMETER
          SA6    PPRNT             STORE PARAMETER IN MESSAGE 
          SA2    MSG10             SET POINTER TO INVALID PARM MSG
          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
          CLOSEM SSOUT1,U 
          CLOSEM SSOUT2,U 
          CLOSEM S1,U 
          CLOSEM S2,U 
          ABORT                                                         005220
MSG1      DATA   28LCONTROL CARD ERROR                                  005230
MSG2      DATA   28LFATAL SYNTAX ERRORS                                 005240
MSG6     DIS    ,*EMPTY INPUT FILE      DDLF ABORTED*                   000290
MSG5     DIS    ,*INSUFFICIENT FIELD LENGTH   DDLF ABORTED*             000300
 MSG7     DIS    ,*    COMPILATION ERRORS-   NO SUB-SCHEMA CREATED* 
MSG8      DIS    ,*SUB-SCHEMA LIBRARY ERROR---DDLF ABORTED*             000320
 MSG9     DIS    ,*CHECKSUM I/O ERROR - DDLF ABORTED*                   000330
*        ** PRINT LINE - DO NOT INSERT LINES ** 
 MSG10    DATA   20LPARAMETER IN ERROR- 
 PPRNT    DATA   10L
*                 ** END PRINT LINE **
 MSG11    DATA   28LINCOMPATIBLE PARAMETERS 
  
          SPACE  1
************************************************************* 
** CLOSE OUTPUT FILE, AFTER WRITING MESSAGES GIVING FIELD   * 
** LENGTH, NUMBER OF DIAGNOSTICS, AND CP TIME USED.         * 
 F4       EQU    10B               DDLCOMP VALUE FOR FTN4 
 F5       EQU    11B               DDLCOMP VALUE FOR FTN5 
 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             000480
          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                           000500
          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         SET X1 TO COMPILATION LANGUAGE MODE
          SX5    X1-F4             SUBTRACT MODE FOR FTN4 
          MI     X5,CLSOUT1        IF FTN4 OR FTN5 FALL THROUGH AND 
          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 MESSAGES UNIQUE TO FORTRAN       *
*         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             000520
          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 
          CLOSEM SSOUT1,U 
          CLOSEM SSOUT2,U 
  
          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                           000540
          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 *** +
 FITS     SPACE  10 
************************************************************************
*                         *  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                         000560
          AX5    12 
          SX1    X5                SECONDS
          SA2    CPTMA
          LX6    6                 CHANGE *1* TO *.*
          BX5    X6-X2
          RJ     =XCDD=      CONVERT SECONDS TO DECIMAL                 000580
          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    1                                                      000182
          SA6    LINNBR 
          SA2    LININIT
          BX6    X2 
          SA6    NBRLIN 
          SA2    BLINE
          BX6    X2 
          SA6    NAMEID 
          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 
          FILE   LFN=INPUT,BFS=260,FWB=INBUF,MBL=2560,WSA=DDLIWSA,LT=UL,
,RT=Z,BT=C,MRL=90,EFC=3,ERL=10
 P2       BSSZ   1                                                      006590
BLKLIN    DATA   10H           BLKLIN IS ENTRY HERE(BLKLINE IS SCAN ENT)008150
*                            RRIAGE CONTROL.                            006610
 NBRLIN   DATA   10H     00000                                          006040
 BLINE    DATA   10H                                                    006630
 DDLIWSA  BSS    8           INPUT WORKING STORAGE AREA.                006640
          DATA   10H
                             ORDINAL MES. IS DDLIWSA+9,+10 FOR FTPASS1  000260
          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           LISTING FLAG. 0 = LIST, 1 = NOLIST         000240
 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 
 LINNBR   DATA   0                                                      006060
 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  DDLF "VER"+"LEV".                                 005200
 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    BLKLIN                                                 008170
          CON    P2                                                     007130
 ERRCNTR  DATA   0
 MSG4     DATA   C* DDLF COMPLETE.      NNNNN DIAGNOSTICS. *            000350
 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 DDLF ABORTED -                                      000370
ENDS2     DATA   10HENDOFSSOUT                                          001530
 CRMLEV   DATA   10H1.5 
 MAXSU    DATA   0                 CONTAINS THE MAX STORAGE USED
 SKIPMSG  DATA   0
 MCMSG1   DATA   C*-DDLF- SS-                      COMPILED*
 MCMSG2   DATA   C*     NON-FATAL ERRORS--SEE LISTING      *
 MCMSG3   DATA   C* DDLF COMPLETE.  TOTAL CP SECS = NNN.NNN*
 MCMSG3A  DATA   C*    MAX. STORAGE USED = NNNNNNB WORDS   *
 MCMSG4   DATA   C+-DDLF- *** NNNNN ERRORS IN SS-          +
          END                                                           007770
