The following shows the sample program as output from the DML precompiler.
Since the /*DMLIST*/ option is specified, printed output consists of expanded code as well as diagnostics. This output is in the following format:
|
Column |
Explanation |
|---|---|
|
1 |
Sequence numbers generated by the DML precompiler |
|
12 |
Line numbers generated by the DML precompiler |
|
19 |
Line numbers generated by the user program |
|
26 |
Text of the PL/I source code including text generated by the DML precompiler |
IDMSDMLP nn.n CA, INC. DML PROCESSOR FOR PL/I DATE TIME PAGE
- - LISTING OF MESSAGES - - mm/dd/yy hhmmsshh 0001
00001 /*RETRIEVAL*/
00002 /*DMLIST*/
00003 /*NO_ACTIVITY_LOG*/
00004 /*SCHEMA_COMMENTS*/
00005 DEPTRPT: PROC OPTIONS (MAIN) REORDER;
00006 /* DECLARE SUBSCHEMA AND MODE */
DMLP 00008 DCL (EMPSS01 SUBSCHEMA, EMPSCHM SCHEMA VERSION 100)
00009 MODE (BATCH) DEBUG;
00010
00011 /* REQUIRED DECLARATIVES */
00012 DCL IDMS ENTRY OPTIONS(INTER,ASM);
00013 DCL ABORT ENTRY OPTIONS(INTER,ASM);
00014 DCL ADDR BUILTIN;
00015
00016 /* CONSTANTS */
00017 DCL DEPT_HEADER CHAR (11) INIT ('DEPT REPORT');
00018 DCL 1 HEAD_LINE,
00019 5 HEAD_DEPT_ID CHAR (9) INIT ('DEPT ID '),
00020 5 HEAD_EMP_ID CHAR (8) INIT ('EMP ID '),
00021 5 HEAD_LNAME CHAR (17) INIT ('LAST NAME '),
00022 5 HEAD_FNAME CHAR (10) INIT ('FIRST NAME');
00023
00024 DCL PRTHEAD CHAR (44) DEFINED HEAD_LINE;
00025
00026 /* LOGICAL CONSTANTS */
00027 DCL YES BIT(1) INIT ('1'B);
00028 DCL NO BIT(1) INIT ('0'B);
00029 DCL EOF BIT(1) INIT ('0'B);
00030
00031 DCL 1 PROGRAM_FLAGS,
00032 5 DB_END_OF_SET BIT(1) INIT ('0'B);
00033
00034 /* FILE DECLARATIONS */
00035 DCL INFILE FILE RECORD INPUT ENV (F BLKSIZE(80));
00036 DCL OUTFILE FILE RECORD OUTPUT ENV (F RECSIZE(133) CTLASA );
00037 DCL SYSPRINT FILE PRINT;
00038
00039 /* THE FOLLOWING RECORDS ARE DEFINED THROUGH IDD. */
00040 /* THE DML PRECOMPILER AUTOMATICALLY CONVERTS HYPHENS */
00041 /* TO UNDERSCORES. */
00042
DMLP 00044 INCLUDE IDMS (DEPT-IN-REC);
DMLP 00049 INCLUDE IDMS (PRT-OUT-REC);
00058
00059 /* REDEFINE PRT_OUT_REC */
00060 DCL PRTREC CHAR (44) DEFINED PRT_OUT_REC;
00061
00062 DCL 1 PRINT_AREA,
00063 5 CC CHAR (1),
00064 5 PRINT_LINE CHAR (132);
00065
00066 DCL 1 SPACES CHAR (132) INIT ( (132) ' ');
00067
00068 /* POSSIBLE VALUES FOR CC */
00069 DCL 1 CONTROL_CHARACTERS,
00070 5 NEW_PAGE CHAR (1) INIT ('1'),
00071 5 SINGLE_SPACE CHAR (1) INIT (' '),
00072 5 DOUBLE_SPACE CHAR (1) INIT ('0'),
00073 5 TRIPLE_SPACE CHAR (1) INIT ('-'),
00074 5 OVERPRINT CHAR (1) INIT ('+');
00075
DMLP 00077 INCLUDE IDMS (SUBSCHEMA_CTRL);
DMLP 00103 INCLUDE IDMS (DEPARTMENT);
DMLP 00110 INCLUDE IDMS (EMPLOYEE);
00140
00141 /***********************************************************/
00142 /* PROCESSING FOLLOWS */
00143 /* OPEN THE FILES */
00144 /* INFILE ── INPUT */
00145 /* OUTFILE ── OUTPUT */
00146 /* SYSPRINT ── USED BY IDMS_STATUS */
00147 OPEN FILE (INFILE);
00148 OPEN FILE (OUTFILE);
00149 OPEN FILE (SYSPRINT);
00150 ON ENDFILE (INFILE) EOF = YES;
00151
00152 /* BIND RUN UNIT AND RECORDS EXPLICITLY */
DMLP0001 00154 BIND RUN_UNIT
00155 NODENAME ('')
00156 DBNAME ('');
00167
00168 CALL IDMS_STATUS;
DMLP0002 00170 BIND RECORD (EMPLOYEE);
00179 CALL IDMS_STATUS;
DMLP0003 00181 BIND RECORD (DEPARTMENT);
00190 CALL IDMS_STATUS;
DMLP0004 00192 READY;
00199 CALL IDMS_STATUS;
00200 READ FILE (INFILE) INTO (DEPT_IN_REC);
00201
00202 DO WHILE ( EOF);
00203
00204 DB_END_OF_SET = NO;
00205 DEPT_ID_0410 = DEPT_ID_IN;
DMLP0005 00207 OBTAIN CALC RECORD (DEPARTMENT);
00216 /* 0326 MEANS */
00217 /* DEPT NOT FOUND */
00218 IF ERROR_STATUS = '0326' THEN CALL NO_DEPT;
00219 ELSE
00220 DO;
DMLP0006 00222 IF SET (DEPT_EMPLOYEE) EMPTY
00231 THEN CALL NO_EMP;
00232 ELSE
00233 CALL NEW_DEPT;
00234 DO UNTIL (DB_END_OF_SET);
DMLP0007 00236 OBTAIN NEXT RECORD (EMPLOYEE)
00237 SET (DEPT_EMPLOYEE);
00247 IF ERROR_STATUS = '0307' THEN
00248 DB_END_OF_SET = YES;
00249 ELSE
00250 CALL IDMS_STATUS;
00251 IF DB_END_OF_SET THEN
00252 DO;
00253 /* MOVE FIELDS TO */
00254 /* OUTPUT RECORD */
00255 DEPT_ID_OUT = DEPT_ID_0410;
00256 EMP_ID_OUT = EMP_ID_0415;
00257 EMP_LNAME_OUT = EMP_LAST_NAME_0415;
00258 EMP_FNAME_OUT = EMP_FIRST_NAME_0415;
00259 CC = DOUBLE_SPACE;
00260 PRINT_LINE = SPACES;
00261 PRINT_LINE = PRTREC;
00262 CALL PRINT_A_LINE;
00263 END; /* END PRINTING DO */
00264 END; /* END DO UNTIL */
00265 END; /* END 0326 ELSE DO */
00266
00267 READ FILE (INFILE) INTO (DEPT_IN_REC);
00268 END; /* END DO WHILE EOF */
00269 CALL END_PROCESSING;
00270
00271 NEW_DEPT: PROC;
00272 PRINT_LINE = SPACES; /* NEW PAGE FOR EACH */
00273 CC = NEW_PAGE; /* DEPARTMENT */
00274 PRINT_LINE = DEPT_HEADER;
00275 CALL PRINT_A_LINE;
00276
00277 PRINT_LINE = SPACES;
00278 CC = DOUBLE_SPACE;
00279 PRINT_LINE = DEPT_ID_0410;
00280 CALL PRINT_A_LINE;
00281
00282 PRINT_LINE = SPACES;
00283 CC = DOUBLE_SPACE;
00284 PRINT_LINE = PRTHEAD;
00285 CALL PRINT_A_LINE;
00286
00287 END NEW_DEPT;
00288
00289 NO_DEPT: PROC;
00290 PRINT_LINE = SPACES;
00291 CC = NEW_PAGE;
00292 PRINT_LINE = DEPT_ID_IN;
00293 CALL PRINT_A_LINE;
00294 PRINT_LINE = SPACES;
00295 CC = DOUBLE_SPACE;
00296 PRINT_LINE = '** DEPARTMENT SPECIFIED ABOVE NOT FOUND **';
00297 CALL PRINT_A_LINE;
00298 END NO_DEPT;
00299
00300 NO_EMP: PROC;
00301 PRINT_LINE = SPACES;
00302 CC = NEW_PAGE;
00303 PRINT_LINE = DEPT_ID_IN;
00304 CALL PRINT_A_LINE;
00305
00306 PRINT_LINE = SPACES;
00307 CC = DOUBLE_SPACE;
00308 PRINT_LINE = DEPT_ID_0410;
00309 CALL PRINT_A_LINE;
00310
00311 PRINT_LINE = SPACES;
00312 CC = DOUBLE_SPACE;
00313 PRINT_LINE = '** DEPARTMENT SPECIFIED IS EMPTY ***';
00314 CALL PRINT_A_LINE;
00315 END NO_EMP;
00316
00317 END_PROCESSING: PROC;
DMLP0008 00319 FINISH;
00326 CLOSE FILE (INFILE);
00327 CLOSE FILE (OUTFILE);
00328 CLOSE FILE (SYSPRINT);
00329 END END_PROCESSING;
00330
00331 PRINT_A_LINE: PROC;
00332 WRITE FILE (OUTFILE) FROM (PRINT_AREA);
00333 END PRINT_A_LINE;
00334
00335
DMLP 00336 INCLUDE IDMS (IDMS_STATUS);
00337 IDMS_STATUS: PROC;
00338 /* THE IDMS_STATUS PROCEDURE IS CALLED BY THE USER AFTER */
00339 /* EACH IDMS COMMAND HAS BEEN ISSUED AND CHECKS HAVE BEEN */
00340 /* MADE FOR ANY EXPECTED NON-ZERO ERROR_STATUS CONDITIONS. */
00341 /* IT DETECTS A NON-ZERO ERROR_STATUS AND ABNORMALLY */
00342 /* TERMINATES THE PROGRAM ACCORDINGLY. */
00343 DECLARE IDMSIN1 ENTRY OPTIONS(INTER,ASSEMBLER);
00344 IF ERROR_STATUS='0000' THEN GOTO END_STATUS;
00345 PUT SKIP EDIT ('PROGRAM NAME ------', PROGRAM,
00346 'ERROR STATUS ------', ERROR_STATUS,
00347 'ERROR RECORD ------', ERROR_RECORD,
00348 'ERROR SET ---------', ERROR_SET,
00349 'ERROR AREA --------', ERROR_AREA,
00350 'LAST GOOD RECORD --', RECORD_NAME,
00351 'LAST GOOD AREA ----', AREA_NAME)
00352 (A(19),X(5),A(8),SKIP,A(19),X(5),A(4),
00353 5(SKIP,A(19),X(5),A(16)));
00354 SSC_IN01_REQ_CODE = 39;
00355 SSC_IN01_REQ_RETURN = 0;
00356 SSC_STATUS_LABEL = ' ';
00357 DO UNTIL (SSC_IN01_REQ_RETURN > 0);
00358 CALL IDMSIN1 (IDBMSCOM(41),
00359 SSC_IN01_REQ_WK,
00360 SUBSCHEMA_CTRL,
00361 IDBMSCOM(1),
00362 DML_SEQUENCE,
00363 SSC_STATUS_LINE);
00364 IF SSC_IN01_REQ_RETURN > 4 THEN
00365 PUT SKIP EDIT ('DML SEQUENCE ------', DML_SEQUENCE)
00366 (A(19),X(5),F(10));
00367 ELSE
00368 PUT SKIP EDIT (SSC_STATUS_LABEL, '---',
00369 SSC_STATUS_VALUE)
00370 (A(16),A(3),X(5),A(12));
00371 END;
DMLP0009 00372 ROLLBACK;
00373 CALL ABORT;
00374 END_STATUS: END;
00375
00376 END DEPTRPT
|
Copyright © 2014 CA.
All rights reserved.
|
|