|
DataMuseum.dkPresents historical artifacts from the history of: IBM System/36 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about IBM System/36 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 10752 (0x2a00)
Notes: MEMBER_P, Member_Text
Names: »RPGC «
└─⟦e184f8357⟧ Bits:30009822 AS/ENTRY - S/36 SYST SUPP PROG IDENT. S/36 PTFDK3900 FC 1991/9074/9084 Refer to Memo 36714 Product Number 5727SS6 Rel 05 7 Created 19950301 Level 01 Seq 001 of 011
└─⟦d35f72f1f⟧
└─⟦this⟧ ».RPGC «
*** THIS PROCEDURE SHOULD EXIST ONLY IN #RPGLIB AS 'RPGC'********************** // MEMBER USER1-#RP#CPL1,USER2-#RP#CPL2,LIBRARY-#RPGLIB MESSAGE MEMBER // IFF ?1?/ GOTO PUTPARMS IF P1 SPECIFIED, PROCESS DIRECT // IF JOBQ-NO IF EVOKED-NO GOTO NJOBQ IF P1=BLANK AND JOBQ OR EVOKED * ISSUE ERROR MESSAGE // MSG ?WS?,?M'2100,1,75'? // RETURN // TAG NJOBQ * // HELP RPGC ,?2'?CLIB?'?,?3'NODSM'?,?4'PRINT'?,?5'NOXREF'?,+ ?6'0'?,?7'NONEP'?,?8?,?9?,?10?,?11?,?12'NOHALT'?,?13'REPLACE'?,+ ?14'LINK'?,?15'NOOBJECT'?,?16?,?17'GEN'?,?18'40'?,?19?,?20'NOMRO'? // RETURN ************************************************************************ * THE FOLLOWING OCL CHECKS ALL PARAMETERS FOR VALID VALUES AND IF SO * * STORES THE PARAMETERS IN THE PROPER AREAS OF THE SYSTEM LOCAL * * DATA AREA (SEE LAYOUT OF LDA BELOW). EACH PARAMETER IS PROCESSED * * AS SHOWN BELOW: * * * * PARAMETER RESULTS * * INVALID -----> ISSUE PROPER ERROR VIA * * #ERR WITH 0 AND 3 OPTIONS. * * 0 RESPONSE MEANS CONTINUE * * WITH DEFAULT SUBSTITUTED. * * 3 RESPONSE MEANS CANCEL. * * VALID -----> CONTINUE * * * * NOTE: P1 (SOURCE NAME) IS A REQUIRED PARAMETER. THEREFORE * * NO DEFAULT IS ASSUMED AND A 3 OPTION ONLY HALT IS * * ISSUED BY #ERR IF AN INVALID PAREMETER IS DETECTED. * * * ************************************************************************ // TAG PUTPARMS * ******************************************************************* * * IF THIS PROCEDURE WAS NOT RUN FROM THE JOBQ OR WAS NOT EVOKED * * * OR WAS NOT CALLED FROM THE RPG PROCEDURE THEN ISSUE THE 'RPGC * * * PROCEDURE IS RUNNING' MESSAGE. * * ******************************************************************* // IF JOBQ-NO IF EVOKED-NO IFF RPG/?21? * 1031 // LOCAL OFFSET-1,DATA-'RPGC',BLANK-8,AREA-SYSTEM PROC NAME // LOCAL OFFSET-237,DATA-'N00',AREA-SYSTEM USED BY COMPILER // IFF ?2?/ IFF DATAF1-?2? #ERR 1060,03,RPG ?2F'?CLIB?'? // IFF SOURCE-'?1?,?2'?CLIB?'?' #ERR 1051,3,RPG // IFF ?3'NODSM'?/NODSM IFF ?3?/DSM #ERR 1032,03,RPG ?3F'NODSM'? // IF ?3?/DSM LOCAL OFFSET-237,DATA-'Y',AREA-SYSTEM FLAG TO CALL $MAINT * TO REPLACE SOURCE * IF DSM REQUESTED. // IFF ?4'PRINT'?/ IFF ?4?/PRINT IFF ?4?/NOPRINT IFF ?4?/CRT + #ERR 1033,03,RPG ?4F'PRINT'? * ******************************************************************* * * JOBQ OR EVOKED AND CRT ARE INVALID TOGETHER. #ERR ISSUES A HALT* * * WITH 0 AND 3 OPTIONS: * * * 0 - CONTINUE WITH P4 = PRINT * * * 3 - CANCEL * * ******************************************************************* // IF JOBQ-NO IF EVOKED-NO GOTO SKIP1 // IF ?4?/CRT #ERR 1065,03,RPG ?4F'PRINT'? // TAG SKIP1 * // IFF ?5'NOXREF'?/NOXREF IFF ?5?/XREF #ERR 1034,03,RPG ?5F'NOXREF'? // IFF ?6'0'?>-1 #ERR 1054,03,RPG ?6F'0'? // IFF ?7'NONEP'?/NONEP IFF ?7?/NEP #ERR 1035,03,RPG ?7F'NONEP'? // IFF ?8?/ IFF DATAF1-?8? #ERR 1061,03,RPG ?8F'?2?'? // IFF ?9?/ IFF ?9?/SOURCE IFF ?9?/PSOURCE IFF ?9?/NOSOURCE #ERR 1036,03,RPG + ?9F''? // IFF ?10?/ IFF ?10?/DEBUG IFF ?10?/NODEBUG #ERR 1037,03,RPG ?10F''? // IFF ?11?/ IFF 65>?11? #ERR 1038,03,RPG ?11F''? // ELSE IFF ?11?/ IFF ?11?>1 #ERR 1038,03,RPG ?11F''? // IFF ?12'NOHALT'?/NOHALT IFF ?12?/HALT #ERR 1039,03,RPG ?12F'NOHALT'? // IFF ?13'REPLACE'?/REPLACE IFF ?13?/NOREPLAC #ERR 1040,03,RPG ?13F'REPLACE'? // IFF ?14'LINK'?/LINK IFF ?14?/NOLINK #ERR 1041,03,RPG ?14F'LINK'? // IFF ?15'NOOBJECT'?/NOOBJECT IFF ?15?/OBJECT #ERR 1042,03,RPG ?15F'NOOBJECT'? // IFF ?16?/ IFF DATAF1-?16? #ERR 1062,03,RPG ?16F'?2?'? // IFF ?17'GEN'?/GEN IFF ?17?/NOGEN #ERR 1043,03,RPG ?17F'GEN'? // IF ?17?/NOGEN LOCAL OFFSET-238,DATA-'1',AREA-SYSTEM // IFF ?18'40'?>0 #ERR 1053,03,RPG ?18F'40'? ************************************************************ * IF A DATA DICTIONARY NAME IS SPECIFIED, CHECK TO SEE * * IF IT EXISTS. * ************************************************************ // IF ?19?/ GOTO DCTOK // LOCAL OFFSET-443,DATA-'?19?',BLANK-8,AREA-SYSTEM // LOAD #RPDD // RUN ************************************************************ * IF THE DATA DICTIONARY DOES NOT EXIST (RETURN CODE IS * * 1), ISSUE RPG-1066. * ************************************************************ // IF '?L'451,1'?'/'1' #ERR 1066,03,RPG // TAG DCTOK // IFF ?20'NOMRO'?/NOMRO IFF ?20?/MRO #ERR 1045,03,RPG ?20F'NOMRO'? *********************************************************** * STORE THE PARAMETER VALUES IN THE PROPER AREA OF THE * * SYSTEM LOCAL DATA AREA (SEE LDA LAYOUT DATA). * *********************************************************** // LOCAL OFFSET-137,DATA-'?1?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-145,DATA-'?2?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-435,DATA-'?1?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-419,DATA-'?2?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-9,DATA-'?3?',BLANK-5,AREA-SYSTEM // LOCAL OFFSET-14,DATA-'?4?',BLANK-7,AREA-SYSTEM // LOCAL OFFSET-21,DATA-'?5?',BLANK-6,AREA-SYSTEM // LOCAL OFFSET-27,DATA-'?6?',BLANK-2,AREA-SYSTEM // LOCAL OFFSET-29,DATA-'?7?',BLANK-5,AREA-SYSTEM // LOCAL OFFSET-153,DATA-'?8?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-427,DATA-'?8?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-34,DATA-'?9?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-42,DATA-'?10?',BLANK-7,AREA-SYSTEM // LOCAL OFFSET-49,DATA-'?11?',BLANK-2,AREA-SYSTEM // LOCAL OFFSET-51,DATA-'?12?',BLANK-6,AREA-SYSTEM // LOCAL OFFSET-57,DATA-'?13?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-65,DATA-'?14?',BLANK-6,AREA-SYSTEM // LOCAL OFFSET-71,DATA-'?15?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-161,DATA-'?16?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-79,DATA-'?17?',BLANK-6,AREA-SYSTEM // LOCAL OFFSET-85,DATA-'?18?',BLANK-4,AREA-SYSTEM // LOCAL OFFSET-453,DATA-'?20?',BLANK-5,AREA-SYSTEM // LOCAL OFFSET-95,DATA-'R96',BLANK-4,AREA-SYSTEM USED BY RPGSEU ******************************************************************** * THIS BLOCK PREPARES TO CALL THE RPG COMPILER. * * THE WORK FILES ARE GIVEN AN EXTEND VALUE OF 25 BLOCKS. * * IF PARAMETER 4=CRT, THE PRINT FILE IS GIVE A PRIORITY * * OF 0, HOLDING IT ON THE SPOOL QUEUE FOR LATER VIEWING. * * PUT THE PRINTER IN CONTINUE MODE TO CONCATENATE THE LISTINGS * * FROM THE RPG COMPILER, OLE, AND THE CROSS-REFERENCE AND * * CONSOLE FILE FORMAT GENERATOR PROGRAMS. IF THE PRINTER * * IS ALREADY IN CONTINUE MODE, THE RETURN CODE WILL BE 2040. * * STORE THIS CODE AT 189-192 OF THE LOCAL AREA. * * IF PRINT SPOOLING IS NOT ACTIVE, AND CRT IS REQUESTED, * * #RPG WILL ISSUE ERROR MESSAGE RPG-1027. * ******************************************************************* // LOAD #RPG,#RPGLIB // FILE NAME-$SOURCE,RETAIN-S,DISP-NEW,BLOCKS-?18?,EXTEND-25 // FILE NAME-$WORK,RETAIN-S,DISP-NEW,BLOCKS-?18?,EXTEND-25 // IFF ?3?/DSM GOTO NOTDSM CHECK IF DSM REQUESTED, IF YES * ALLOCATE $WORK2 AND $WORK3 // FILE NAME-$WORK2,RETAIN-J,BLOCKS-?18?,LABEL-?1?,EXTEND-25 // FILE NAME-$WORK3,RETAIN-S,DISP-NEW,BLOCKS-?18?,EXTEND-25 // TAG NOTDSM // PRINTER NAME-$PRINTDM,CONTINUE-YES, // IF ?4?/CRT PRIORITY-0 // ELSE PRIORITY-1 // LOCAL OFFSET-189,DATA-'?CD?',AREA-SYSTEM // MEMBER PROGRAM1-#RP#CPL1,PROGRAM2-#RP#CPL2,LIBRARY-#RPGLIB // COMPILE INLIB-?2'?CLIB?'?,OUTLIB-?8'?2?'?,MRTMAX-?6?,SOURCE-?1?,+ DATADCT-?19?, // IF ?7?/NEP NEP-YES, // ELSE NEP-NO, // IF ?20?/MRO MRO-YES // ELSE MRO-NO // RUN ************************************************************ * THE RPG COMPILER CAN PUT A VALUE OF 1008 IN THE RETURN * * CODE FIELD OF THE JCB. ANY // RUN STATEMENT PROCESSED * * SUBSEQUENTLY WILL RESET THIS VALUE TO 0000. THEREFORE * * SAVE THE RETURN CODE IN PARAMETER 64. IT WILL BE * * RESTORED TO THE RETURN CODE FIELD IN THE JCB AT THE END * * OF THE PROCEDURE. * ************************************************************ // EVALUATE P64,4=?CD? *********************************************************************** * IF XREF AND PRINT OR CRT ARE SPECIFIED AND NO TERMINAL ERRORS,* * CALL THE RPG XREF PROGRAM. THE COMPILER WILL SET A RETURN * * CODE OF 1008 IF THE PROGRAM CONTAINS TERMINAL ERRORS. * *********************************************************************** // IFF ?CD?/1008 IF ?5?/XREF IFF ?4?/NOPRINT + INCLUDE RPGX,#RPGLIB ?1?,?18?,?2? ********************************************************************** * IF CONSOLE FILES WERE NOT IN THE PROGRAM, THE COMPILER * * WILL SET BYTE 238 OF LDA TO '1'. IF TERMINAL ERRORS THE * * COMPILER WILL SET A RETURN CODE OF 1008. IF NEITHER OF THESE* * CONDITIONS EXIST AND 'GEN' WAS SPECIFIED, CALL THE * * CONSOLE FILE FORMAT GENERATOR. * ********************************************************************** // IFF ?CD?/1008 IF ?L'238,1'?/0 INCLUDE RPGR,#RPGLIB ?1?,+ ?18?,NOSAVE,?2?,?8?,,?13?,?4? ********************************************* * IF DSM REQUESTED, USE $MAINT TO * * REPLACE THE SOURCE WITH THE DSM * ********************************************* // IFF ?L'237,1'?/Y GOTO SKIPDSM // LOAD $MAINT // FILE NAME-$WORK2,UNIT-F1,RETAIN-S,LABEL-?1? // RUN // COPY FROM-DISK,TO-?2?,RETAIN-R,FILE-$WORK2 // END // TAG SKIPDSM * ****************************************************************** * IF THE PRINTER WAS NOT IN CONTINUE MODE WHEN THIS PROCEDURE * * WAS ENTERED, OR IF CRT WAS REQUESTED, THEN RESET THE CONTINUE * * STATUS TO NO. * ****************************************************************** // IF '?L'189,4'?'/'2040' IFF ?L'14,3'?/CRT GOTO SKIP2 // PRINTER CONTINUE-NO // TAG SKIP2 ************************************************************ * THE FOLLOWING OCL IS EXECUTED IF PARAMETER 4=CRT. * * USE COPYPRT MODULES TO DO THE DISPLAY OF THE * * HELD PRINT FILE. CANCEL THE SPOOL FILE ENTRY. * * PARAMETER 30 WILL CONTAIN THE SPOOL-ID RETRIEVED * * FROM OFFSET 181-186 OF THE SYSTEM LDA. * ************************************************************ // IFF ?L'14,3'?/CRT GOTO END // EVALUATE P30='?L'181,6'?' ************************************************************************ * THE FOLLOWING 4 LINES ARE ADDED FOR PTF 52-564 . THEY REPLACE * * THE CALLS TO $UASF AND $UASC. * ************************************************************************ // INFOMSG NO // IFT DATAF1-RP?L'181,6'? DELETE RP?L'181,6'?,F1 // IFF ?L'181,6'?/ COPYPRT ?L'181,6'?,RP?L'181,6'?,CANCEL,CRT // IF DATAF1-RP?L'181,6'? DELETE RP?L'181,6'?,F1 *********************************************************** * RESTORE THE RETURN CODE SET BY THE RPG COMPILER TO THE * * RETURN CODE FIELD IN THE JCB. * *********************************************************** // TAG END // EVALUATE CD=?64? * // RETURN