|
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: 5632 (0x1600)
Notes: MEMBER_P, Member_Text
Names: »RPGR «
└─⟦ce1fc3cee⟧ Bits:30009814 REF.NO PWD33 PGM 5727-RG6 FEAT9074 RPG II US Z250-0040-2 REV/LEV 05.01 SEQ. 1/1 DISKET 2S 96TPI INTERNAL 88.05.24 31
└─⟦a01802bb8⟧
└─⟦this⟧ ».RPGR «
*** THIS PROCEDURE SHOULD EXIST ONLY IN #RPGLIB AS RPGR *********************** ******************************************************************************* // MEMBER USER1-#RP#CPL1,LIBRARY-#RPGLIB // IFF ?1?/ GOTO NAMPRES ********************************************************* * IF P1=BLANK AND JOBQ OR EVOKED, ISSUE ERROR MESSAGE * ********************************************************* // IF JOBQ-NO IF EVOKED-NO GOTO NJOBQ // MSG ?WS?,?M'2100,1,75'? // RETURN // TAG NJOBQ ********************************************************* * ELSE DISPLAY PROMPT SCREEN * ********************************************************* // HELP RPGR,?1?,?2?,?3?,?4'?CLIB?'?,?5?,,?7?,?8? // RETURN * // TAG NAMPRES // IF JOBQ-NO IF EVOKED-NO * 1020 ***************************************** * * * INITIALIZE LOCAL AREA. * * * ***************************************** // LOCAL OFFSET-1,DATA-'RPGR',BLANK-8,AREA-SYSTEM PROC NAME // LOCAL OFFSET-187,DATA-'?WS?',AREA-SYSTEM WSID FOR #RPGEN // LOCAL OFFSET-238,DATA-'0 000000 ',AREA-SYSTEM ************************************************************** * * * USE $MAINT FUNCTION TO COPY THE RPG SOURCE INTO $WORK2 * * FILE SO THAT IT CAN BE PROCESSED BY THE RPG CONSOLE FILE * * FORMAT GENERATOR PROGRAM. IF PARAMETER 9 IS '11111111' * * THEN THE SOURCE IS ALREADY IN $WORK2. THEREFORE DO NOT * * DO THE COPY WITH $MAINT. * * * ************************************************************** // IF ?9?/11111111 GOTO SKIP // LOAD $MAINT // FILE NAME-$WORK2,RETAIN-J,UNIT-F1,BLOCKS-?2'40'?,EXTEND-25 // RUN // COPY FROM-?4'?CLIB?'?,TO-DISK,LIBRARY-S,FILE-$WORK2,RECL-96,NAME-?1? // END // TAG SKIP **************************************************** * * * LOAD THE CONSOLE FILE FORMAT GENERATOR PROGRAM * * * **************************************************** // LOAD #RPGEN,#RPGLIB // FILE NAME-SOURCE,RETAIN-J,UNIT-F1,LABEL-$WORK2 // FILE NAME-WORK,RETAIN-J,UNIT-F1,LABEL-$WORK2 // FILE NAME-SFGR,RETAIN-J,UNIT-F1,BLOCKS-?2?,EXTEND-25 // RUN **************************************************** * * * THIS PROGRAM USES BYTES 243-246 OF THE SYSTEM * * LDA AS ERROR FLAG BYTES. IF ANY OF THESE BYTES * * CONTAIN '1', ISSUE THE APPROPRIATE ERROR. * * RETURN ON ALL MESSAGES EXCEPT 1024. * * * * 1021 - NO CONSOLE FILE EXISTS IN THIS PROGRAM * * 1022 - BLANK FILE NAME IN COLUMNS 7-14 FOR * * CONSOLE DEVICE * * 1023 - INCONSISTENT RECORD ID CODE USAGE ON * * 'OR' LINE * * 1024 - FORMAT FOR CONSOLE FILE DOES NOT FIT ON * * SCREEN * * * **************************************************** // IF ?L'246,1'?/1 * 'RPG-1021' // IF ?L'246,1'?/1 * 1021 // IF ?L'245,1'?/1 * 'RPG-1022' // IF ?L'245,1'?/1 * 1022 // IF ?L'244,1'?/1 * 'RPG-1023' // IF ?L'244,1'?/1 * 1023 // IF ?L'243,1'?/1 * 'RPG-1024' // IF ?L'243,1'?/1 * 1024 // IFF ?L'243,4'?/0000 PAUSE // IFF ?L'244,3'?/000 RETURN ************************************************************ * * * USE $MAINT TO COPY THE OUTPUT FROM THE FORMAT GENERATOR * * PROGRAM BACK INTO A SOURCE MEMBER SO THAT IT CAN BE * * PROCESSED BY $SFGR. * * * ************************************************************ // LOAD $MAINT // FILE NAME-SFGR,RETAIN-J,UNIT-F1 // RUN // IF ?7?/REPLACE COPY FROM-DISK,TO-?4'?CLIB?'?,FILE-SFGR,RETAIN-R // ELSE COPY FROM-DISK,TO-?4'?CLIB?'?,FILE-SFGR // END ********************************************************** * * * USE $SFGR TO CREATE A SCREEN FORMAT LOAD MEMBER FROM * * THE SOURCE CREATED BY #RPGEN. * * * ********************************************************** // LOAD $SFGR // RUN // IF ?7?/REPLACE LOADMBR NAME-?L'249,8'?,REPLACE-YES // ELSE LOADMBR NAME-?L'249,8'? // IF ?8?/NOPRINT INOUT INLIB-?4'?CLIB?'?,OUTLIB-?5'?CLIB?'?,PRINT-NO // ELSE INOUT INLIB-?4'?CLIB?'?,OUTLIB-?5'?CLIB?'?,PRINT-YES // CREATE SOURCE-?L'249,8'?,NUMBER-?L'247,2'? // END // IFF ?3?/NOSAVE RETURN *********************************************************** * * * IF 'SAVE' WAS NOT SPECIFIED, THEN USE $MAINT TO DELETE * * THE SOURCE MEMBER CREATED FROM THE INPUT LIBRARY. * * * *********************************************************** // LOAD $MAINT // RUN // DELETE NAME-?L'249,8'?,LIBRARY-S,LIBRNAME-?4? // END ******************************************************************************* * * * RPGR PGNAME,SOURCE,NOSAVE,INLIB,OUTLIB,GEN,REPLACE,PRINT * * * * THIS PROCEDURE EXECUTES THE CONSOLE SCREEN FORMAT GENERATOR * * TO PRODUCE SFGR SOURCE STATEMENTS DESCRIBING THE SCREEN FORMAT * * FOR THE CONSOLE FILE. * * * * THE POSITIONAL PARAMETERS AS INPUT ARE THE FOLLOWING- * * 1ST - PROGRAM NAME, (REQUIRED), * * 2ND - # BLOCKS FOR $SOURCE FILE, DEFAULT- 40, * * 3RD - DON'T SAVE SFGR SOURCE, DEFAULT- SAVE, * * 4TH - INPUT LIBRARY, DEFAULT- CURRENT LIBRARY * * 5TH - OUTPUT LIBRARY, DEFAULT- CURRENT LIBRARY * * 6TH - SCREEN FORMAT SIZE, DEFAULT- GEN -->1920 * * 7TH - AUTOMATICALLY REPLACE DUPLICATE MEMBERS, DEFAULT-REPLACE * * 8TH - PRINT THE SFGR OUTPUT, DEFAULT-PRINT * * 9TH - LOCAL OFFSET 169-176, WILL BE '11111111' IF THE SOURCE * * FOR WHICH FORMATS IS TO GENERATED IS ALREADY IN THE $WORK2 * * FILE (IE. RPGR WAS CALLED BY AUTOC AND THE SOURCE WAS * * NOT CATALOGED BY #AUTO) * * * *******************************************************************************