|
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: 15872 (0x3e00)
Notes: MEMBER_P, Member_Text
Names: »RPGONL «
└─⟦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⟧ ».RPGONL «
*** THIS PROCEDURE SHOULD EXIST ONLY IN #RPGLIB AS 'RPGONL'******************** // LOCAL AREA-SYSTEM // MEMBER USER1-#RP#CPL1,LIBRARY-#RPGLIB ******************************************************* * THIS PROC CANNOT BE RUN FROM THE JOBQ OR BE EVOKED * ******************************************************* // IF JOBQ-NO IF EVOKED-NO GOTO NJOBQ // MSG ?WS?,?M'2100,1,75'? // RETURN // TAG NJOBQ ******************************************************* * DSU/SEU MUST BE ON THE SYSTEM * ******************************************************* ***IFF PROC-FSE IFF PROC-SEU #ERR 1064,3,RPG // IFF PROC-DSU IFF PROC-SEU #ERR 1067,3,RPG ******************************************************************* * IF THE USER SIGNED ON TO AN IGC SESSION, SET THE SCREEN FORMAT * * MEMBER NAME TO #RP$FMTS, OTHERWISE USE #RP@FMTS. * ******************************************************************* // IF DSPLY-IGC EVALUATE P64='#RP$FMTS' // ELSE EVALUATE P64='#RP@FMTS' ******************************************************************* * IF THE PRECEDING PROCEDURE WAS AN RPG PROCEDURE * * THEN DO NOT INITIALIZE THE LDA. * ******************************************************************* // IF '?L'1,3'?'/'RPG' GOTO SKIPINIT // LOCAL OFFSET-1,DATA-' NODSMPRINT NOXREF0 NONEP',BLANK-457,+ AREA-SYSTEM // LOCAL OFFSET-51,DATA-'NOHALTREPLACE LINK NOOBJECTGEN 40 COMP R96',+ AREA-SYSTEM // LOCAL OFFSET-419,DATA-'?CLIB?',BLANK-8,AREA-SYSTEM // TAG SKIPINIT ***************************************************************** * IN ORDER TO PRESERVE MEMORY, THE PARAMETERS WHICH ARE ASSUMED* * IN RPGONL (DSM,CRT,NOHALT,REPLACE) MUST BE SAVED AND RESTORED* * WHEN THIS PROCEDURE IS ENDED. USE PARAMETERS 44-47 AS A * * STORAGE AREA FOR THESE VALUES. ALSO INITIALIZE THESE AREAS * * OF THE LDA TO VALUES NEEDED BY RPGONL. * ***************************************************************** // EVALUATE P44='?L'9,5'?' P45='?L'14,7'?' P46='?L'51,6'?' P47='?L'57,8'?' // LOCAL OFFSET-9,DATA-'DSM CRT ',AREA-SYSTEM // LOCAL OFFSET-51,DATA-'NOHALTREPLACE ',AREA-SYSTEM * // LOCAL OFFSET-1,DATA-'RPGONL ',AREA-SYSTEM // LOCAL OFFSET-237,DATA-'N00',AREA-SYSTEM // LOCAL OFFSET-187,DATA-'?WS?',AREA-SYSTEM // LOCAL OFFSET-95,DATA-'R96',BLANK-4,AREA-SYSTEM *************************************************************** * MOVE DATA FROM THE LOCAL AREA INTO THE PROPER PARAMETERS * *************************************************************** // EVALUATE P1='?L'435,8'?' P2='?L'419,8'?' P3='?L'427,8'?' P5='?L'177,1'?' + P7='?L'34,8'?' P8='?L'42,7'?' P9='?L'49,2'?' P10='?L'21,6'?' // EVALUATE P11='?L'65,6'?' P12='?L'71,8'?' P13='?L'161,8'?' P14='?L'29,5'?' + P15='?L'27,2'?' P16='?L'79,5'?' P17='?L'85,4'?' P4='?L'443,8'?' P6='' // EVALUATE P18='?L'453,5'?' ********************************** * DISPLAY FIRST PROMPT SCREEN * ********************************** // TAG SCREEN1 ********************************************************************* * PARM 49 IS USED TO CONTROL WHICH * * OVERRIDE FORMAT TO DISPLAY (FORMAT RPGONLO1 ALLOWS CMD2, FORMAT * * RPGONLO2 DOES NOT ALLOW CMD2). IT IS ALSO USED AS A SWITCH TO * * UNCONDITIONALLY SKIP THE DSU/SEU STEP AFTER THE FIRST COMPILATION* * IF P49 NE. 'RPGONLO1' THEN SKIP THE DSU/SEU STEP. * ********************************************************************* // EVALUATE P49='RPGONLO1' // PROMPT FORMAT-RPGONL1,MEMBER-?64?,START-1,LENGTH-'8,8,8,8,1,60',+ LIBRARY-#RPGLIB ************************ * CHECK COMMAND KEYS * ************************ // IF ?CD?/2003 GOTO END PREVIOUS MENU // IF ?CD?/2007 GOTO END CANCEL *************************************************************************** * CHECK PARMS : EACH PARAMETER IS CHECKED FOR VALID VALUES. IF OK, * * THE VALUE IS STORED IN THE PROPER AREA OF THE SYSTEM * * LOCAL DATA AREA. IF NOT OK, THE PROPER ERROR MIC IS * * PUT IN PARAMETER 6 AND SCREEN 1 IS REDISPLAYED. * * PARAMETERS 21-24, 26 ARE USED TO POSITION THE CURSOR ON * * THE PARAMETER IN ERROR (SEE PARAMETER USAGE MAP), AND * * TO REVERSE IMAGE THE INPUT FIELD IN ERROR. * *************************************************************************** // EVALUATE P21='' P22='' P23='' P24='' P26='' // IF ?2?/ GOTO SCREEN1 ?6F'1060'? ?22F'C'? // IFF DATAF1-?2? GOTO SCREEN1 ?6F'1060'? ?22F'C'? // IFF ?3?/ IFF DATAF1-?3? GOTO SCREEN1 ?23F'C'? + ?6F'1061'? // IF ?1?/ GOTO SCREEN1 ?6F'1051'? ?21F'C'? ************************************************************ * IF A DATA DICTIONARY NAME IS SPECIFIED, CHECK TO SEE * * IF IT EXISTS. * ************************************************************ // IF ?4?/ GOTO DCTOK // EVALUATE P43,4=?CD? // LOCAL OFFSET-443,DATA-'?4?',BLANK-8,AREA-SYSTEM // LOAD #RPDD // RUN ************************************************************ * IF THE DATA DICTIONARY DOES NOT EXIST (RETURN CODE IS * * 1), ISSUE RPG-1066 AND HIGHLIGHT THE NAME. * ************************************************************ // IF '?L'451,1'?'/'1' GOTO SCREEN1 ?6F'1066'? ?26F'C'? // EVALUATE CD=?43? // TAG DCTOK // IF ?5?/Y GOTO P1OK IF DSU/SEU=YES, SKIP EXISTENCE CHECK // IFF ?5?/N GOTO SCREEN1 ?6F'1030'? ?24F'C'? // IFF SOURCE-'?1?,?2?' GOTO SCREEN1 ?6F'1051'? ?21F'C'? // TAG P1OK * // IFF ?CD?/2014 GOTO CHKSCR2 ADDITIONAL PARMS REQUESTED? ********************************************** * RESET THE ERROR PARAMETER VALUE TO BLANK * ********************************************** // EVALUATE P20='' ************************************* * DISPLAY OVERRIDE PROMPT SCREEN * ************************************* // TAG SCREEN2 // EVALUATE P19='RPGONL ?1?,?2?,?3?,?4?,?5? // PROMPT FORMAT-?49?,MEMBER-?64?,START-7,+ LENGTH-'8,7,2,6,6,8,8,5,2,5,4,5,44,60',LIBRARY-#RPGLIB // EVALUATE P51='' P52='' P53='' P54='' P55='' P56='' P57='' P58='' + P59='' P60='' P61='' P6='' P25='' ************************* * CHECK COMMAND KEYS * ************************* // IF ?CD?/2002 GOTO SCREEN1 CHECK FOR PAGE BACK // IF ?CD?/2007 GOTO END CHECK FOR END-OF-JOB *************************************************************************** * CHECK PARMS : EACH PARAMETER IS CHECKED FOR VALID VALUES. IF OK, * * THE VALUE IS STORED IN THE PROPER AREA OF THE SYSTEM * * LOCAL DATA AREA. IF NOT OK, THE PROPER ERROR MIC IS * * PUT IN PARAMETER 20 AND SCREEN 2 IS REDISPLAYED. * * PARAMETERS 51-61 ARE USED TO POSITION THE CURSOR * * ON THE PARAMETER IN ERROR. * * PARAMETERS 25 IS USED TO POSITION THE CURSOR WHEN * * THERE IS AN ERROR IN THE MRO PARAMETER * *************************************************************************** // TAG CHKSCR2 // IFF ?7?/ IFF ?7?/SOURCE IFF ?7?/NOSOURCE IFF ?7?/PSOURCE + GOTO SCREEN2 ?20F'1036'? ?51F'C'? // IFF ?8?/ IFF ?8?/DEBUG IFF ?8?/NODEBUG GOTO SCREEN2 + ?20F'1037'? ?52F'C'? // IFF ?9?/ IF 65>?9? IF ?9?>1 EVALUATE // ELSE IFF ?9?/ GOTO SCREEN2 ?20F'1038'? ?53F'C'? // IFF ?10'NOXREF'?/NOXREF IFF ?10?/XREF GOTO SCREEN2 + ?20F'1034'? ?54F'C'? // IFF ?11'LINK'?/LINK IFF ?11?/NOLINK GOTO SCREEN2 + ?20F'1041'? ?55F'C'? // IFF ?12'NOOBJECT'?/OBJECT IFF ?12?/NOOBJECT GOTO SCREEN2 + ?20F'1042'? ?56F'C'? // IFF ?13?/ IFF DATAF1-?13? GOTO SCREEN2 + ?20F'1062'? ?57F'C'? // IFF ?14'NONEP'?/NEP IFF ?14?/NONEP GOTO SCREEN2 + ?20F'1035'? ?58F'C'? // IF 100>?15'0'? IF ?15?>-1 EVALUATE // ELSE GOTO SCREEN2 ?20F'1054'? ?59F'C'? // IFF ?16'GEN'?/GEN IFF ?16?/NOGEN GOTO SCREEN2 + ?20F'1043'? ?60F'C'? // IF ?16?/NOGEN LOCAL OFFSET-238,DATA-'1',AREA-SYSTEM // IFF ?17'40'?>0 GOTO SCREEN2 ?20F'1053'? ?61F'C'? // IFF ?18'NOMRO'?/MRO IFF ?18?/NOMRO GOTO SCREEN2 + ?20F'1045'? ?25F'C'? ******************************************************* * STORE ALL THE PARAMETERS IN THE PROPER POSITIONS IN* * THE LOCAL DATA AREA (SEE LDA LAYOUT UNDER RPGCALSO)* ******************************************************* // LOCAL OFFSET-137,DATA-'?1?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-145,DATA-'?2?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-153,DATA-'?3?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-435,DATA-'?1?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-419,DATA-'?2?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-427,DATA-'?3?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-443,DATA-'?4?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-177,DATA-'?5?',AREA-SYSTEM // LOCAL OFFSET-34,DATA-'?7?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-42,DATA-'?8?',BLANK-7,AREA-SYSTEM // LOCAL OFFSET-49,DATA-'?9?',BLANK-2,AREA-SYSTEM // LOCAL OFFSET-21,DATA-'?10'NOXREF'?',BLANK-6,AREA-SYSTEM // LOCAL OFFSET-65,DATA-'?11'LINK'?',BLANK-6,AREA-SYSTEM // LOCAL OFFSET-71,DATA-'?12'NOOBJECT'?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-161,DATA-'?13?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-29,DATA-'?14'NONEP'?',BLANK-5,AREA-SYSTEM // LOCAL OFFSET-27,DATA-'?15'0'?',BLANK-2,AREA-SYSTEM // LOCAL OFFSET-79,DATA-'?16'GEN'?',BLANK-5,AREA-SYSTEM // LOCAL OFFSET-85,DATA-'?17'40'?',BLANK-4,AREA-SYSTEM // LOCAL OFFSET-453,DATA-'?18'NOMRO'?',BLANK-5,AREA-SYSTEM ************************************************ * IF THE VALUE IN P49 (FORMAT TO DISPLAY FOR * * SCREEN 2) IS NOT 'RPGONLO1', THEN THE DSU/ * * SEU STEP IS SKIPPED UNCONDITIONALLY. * * P49 WILL BE 'RPGONLO1' IF THIS IS THE FIRST * * TIME THROUGH THE LOOP FOR THIS MEMBER. * * AFTER THE FIRST TIME THROUGH, P49 IS SET TO * * 'RPGONLO2'. * ************************************************ // IFF ?49?/RPGONLO1 GOTO COMP *************************************** * VIEW SOURCE BEFORE FIRST COMPILE? * *************************************** ***IF Y/?5? IF PROC-FSE FSE ?1?,R,,,?2? YES, CALL FSE TO VIEW SOURCE // IF Y/?5? IF PROC-DSU DSU EDIT,?1?,R,,,?2? YES, CALL DSU TO VIEW SOURCE // ELSE IF Y/?5? SEU ?1?,R,,,?2? YES, CALL SEU TO VIEW SOURCE ******************************************************************** * IF THE OVERRIDE SCREEN IS REQUESTED AGAIN, SHOW THE FORMAT WITH * * CMD2 DISABLED. * ******************************************************************** // EVALUATE P49='RPGONLO2' ******************************************************************* * DO AN EXISTENCE CHECK ON THE SOURCE MEMBER AFTER THE DSU/SEU * * STEP TO INSURE A SOURCE MEMBER WAS CREATED. IF THE MEMBER * * DOES NOT EXIST, ISSUE AN ERROR MESSAGE AND RETURN TO THE * * FIRST PROMPT SCREEN. * ******************************************************************* // IFF SOURCE-'?1?,?2?' GOTO SCREEN1 ?6F'1051'? ?21F'C'? ********************************************************************** * CALL RPG COMPILER TO COMPILE SOURCE AND CREATE DSM. THE LISTING * * GENERATED BY THE COMPILER IS HELD ON THE SPOOL QUEUE BY GIVING * * PRINTER FILE A PRIORITY OF 0. WORK FILES WILL BE EXTENDED BY 25 * * BLOCKS IF NECESSARY. THE LABEL PARAMETER ON $WORK2 IS USED LATER * * BY DSU/SEU. * ********************************************************************** // TAG COMP // * 1016 // LOAD #RPG,#RPGLIB // FILE NAME-$SOURCE,RETAIN-S,DISP-NEW,BLOCKS-?17?,EXTEND-25 // FILE NAME-$WORK,RETAIN-S,DISP-NEW,BLOCKS-?17?,EXTEND-25 // FILE NAME-$WORK2,RETAIN-J,BLOCKS-?17?,LABEL-?1?,EXTEND-25 // FILE NAME-$WORK3,RETAIN-S,DISP-NEW,BLOCKS-?17?,EXTEND-25 // PRINTER NAME-$PRINTDM,CONTINUE-YES,PRIORITY-0 // MEMBER PROGRAM1-#RP#CPL1,PROGRAM2-#RP#CPL2,LIBRARY-#RPGLIB // COMPILE INLIB-?2?,MRTMAX-?15?,SOURCE-?1?,DATADCT-?4?, // IF ?14?/NEP NEP-YES, // ELSE NEP-NO, // IF ?18?/MRO MRO-YES, // ELSE MRO-NO, // IFF ?3?/ OUTLIB-?3? // ELSE OUTLIB-?2? // RUN ***************************************************************** * IF XREF SPECIFIED AND NO TERMINAL ERRORS, CALL XREF PROGRAM * ***************************************************************** // IFF ?CD?/1008 IF ?10?/XREF RPGX,#RPGLIB ?1?,?17?,?2? ***************************************************************** * IF GEN SPECIFIED AND PROGRAM CONTAINS CONSOLE FILES AND NO * * TERMINAL ERRORS CALL THE CONSOLE FILE GENERATOR PROGRAM * ***************************************************************** // IFF ?CD?/1008 IF ?L'238,1'?/0 RPGR,#RPGLIB ?1?,?17?,NOSAVE,?2?,?3? ********************************* * END PRINTER CONCATENATION * ********************************* // PRINTER CONTINUE-NO ***************************** * USE DSU/SEU TO VIEW DSM * ************************* ***IF PROC-FSE FSE ?1?,R,,,?2?,?1? // IF PROC-DSU DSU EDIT,?1?,R,,,?2?,?1? // ELSE SEU ?1?,R,,,?2?,?1? ********************************** * DISPLAY CONTINUATION SCREEN * ********************************** // EVALUATE P32='?1?' P33='?2?' P34='?3?' P35='?4?' P36='' // IF ?34?/ EVALUATE P34='?33?' // TAG SCREEN3 // PROMPT FORMAT-RPGONLC,MEMBER-?64?,START-30,+ LENGTH-'1,1,8,8,8,8,60',LIBRARY-#RPGLIB ******************************************************* * STORE WHICH COMMAND KEY WAS PRESSED FOR LATER USE * ******************************************************* // IF ?CD?/2007 EVALUATE P48='1' // ELSE IF ?CD?/2014 EVALUATE P48='2' // ELSE IF ?CD?/2001 EVALUATE P48='3' // ELSE EVALUATE P48='0' // IF ?CD?/2007 GOTO NOCHECK IF CMD KEY 7, DO NOT ERROR CHECK PARMS ************************************************************************* * CHECK PARMS : EACH PARAMETER IS CHECKED FOR VALID VALUES. IF OK, * * THE VALUE IS STORED IN THE PROPER AREA OF THE SYSTEM * * LOCAL DATA AREA. IF NOT OK, THE PROPER ERROR MIC IS * * PUT IN PARAMETER 36 AND SCREEN 3 IS REDISPLAYED. * * PARAMETER 62-63 ARE USED TO POSITION THE CURSOR ON * * THE PARAMETER IN ERROR. * ************************************************************************* // EVALUATE P62='' P63='' // IFF ?30?/N IFF ?30?/Y GOTO SCREEN3 + ?36F'1030'? ?62F'C'? // IFF ?31?/N IFF ?31?/Y GOTO SCREEN3 + ?36F'1030'? ?63F'C'? // TAG NOCHECK ******************************************************************* * IF DELETE REQUESTED OR CMD KEY 7, DELETE THE HELD SPOOL FILE * * AND GO TO END OF CYCLE PROCESSING * ******************************************************************* // IFF ?30?/N IFF ?CD?/2007 GOTO NODELT // LOAD #RPSPD THIS SSP MODULE DOES THE DELETE // RUN // GOTO ENDPROC // TAG NODELT ************************** * DO THE PRINT OR VIEW * ************************** // IFF ?30?/Y GOTO ENDPROC // EVALUATE P50='?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 ************************************************************* * END OF CYCLE PROCESSING: CMD7 : RETURN * * CMD14 : OVERRIDE SCREEN * * CMD1 : RETURN TO SCREEN1 * * PROCEED + ENTER : RECOMPILE * * ELSE PROCEDURE ENDS. * ************************************************************* // TAG ENDPROC // IF ?48?/3 GOTO SCREEN1 ?6F''? CMD1 // IF ?48?/1 GOTO END CMD7 // IF ?48?/2 GOTO SCREEN2 ?20F''? CMD14 // IF ?31?/Y GOTO COMP Y + ENTER // TAG END ************************************************************** * RESTORE THE PARAMETERS STORED AT BEGINNING OF PROCEDURE * ************************************************************** // LOCAL OFFSET-9,DATA-'?44?',BLANK-5,AREA-SYSTEM // LOCAL OFFSET-14,DATA-'?45?',BLANK-7,AREA-SYSTEM // LOCAL OFFSET-51,DATA-'?46?',BLANK-6,AREA-SYSTEM // LOCAL OFFSET-57,DATA-'?47?',BLANK-8,AREA-SYSTEM * // RETURN