|
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: 7168 (0x1c00)
Notes: MEMBER_P, Member_Text
Names: »COBOLC «
└─⟦c8ae05145⟧ Bits:30009820 AS/ENTRY - S/36 SYST SUPP PROG IDENT. S/36 PTFDK3900 FC 1991/9074/9084 Refer to Memo 36714 Product Number 5727SS6 Rel 05 5 Created 19950301 Level 01 Seq 001 of 011
└─⟦ac51fb3f2⟧
└─⟦this⟧ ».COBOLC «
*** THIS PROCEDURE SHOULD EXIST ONLY IN #LIBRARY AS 'COBOLC' * * * THE COBOL COMPILER PROCEDURE FOR S/36 WITH $HELP SUPPORT FOR PROMP T * SCREENS (SYSLOG ERROR REPROMPTING IN THIS PROC) * // LOCAL AREA-SYSTEM LOCAL AREA=SYSTEM LDA // MEMBER USER1-#CB#M1,LIBRARY-#COBLIB MESSAGE MEMBER S // IFF /?1? GOTO RETPARMS NO HELP--INVOKED DIRECTLY VIA * OCL OR RETURN FROM HELP // IF JOBQ-NO IF EVOKED-NO GOTO NJOBQ // MSG ?WS?,?M'2000,1,60'? * ERROR PUTOUT FOR NO SOURCE MEMBER GIVEN // RETURN // TAG NJOBQ // IFF ?L'1,2'?/CO GOTO DISPLY // IFF ?L'3,2'?/BO GOTO DISPLY // IFF ?L'5,2'?/LP GOTO DISPLY // EVALUATE P1=?L'435,8'? P2=?L'419,8'? P3=?L'427,8'? P4=?L'20,5'? // EVALUATE P5=?L'31,7'? P6=?L'74,6'? P7=?L'15,5'? P8=?L'13,2'? // EVALUATE P9=?L'9,4'? P10=?L'38,8'? P11=?L'67,7'? P12=?L'46,5'? // EVALUATE P13=?L'51,8'? P14=?L'80,8'? P15=?L'88,8'? P16=?L'59,8'? // EVALUATE P17=?L'443,8'? P18=?L'116,6'? P19=?L'111,5'? // TAG DISPLY // HELP COBOLC,?1?,?2'?CLIB?'?,?3?,?4'NODSM'?,?5'PRINT'?,?6?,?7'NONEP'?+ ,?8'0'?,?9'40'?,?10?,?11?,?12?,?13?,?14?,?15?,?16?,?17?,?18?,?19? // RETURN // TAG RETPARMS // IF JOBQ-YES GOTO SETLCL // IF EVOKED-NO * 2010 // IFF ?L'1,2'?/CO GOTO SETLCL // IFF ?L'3,2'?/BO GOTO SETLCL // IFF ?L'5,2'?/LP GOTO SETLCL // LOCAL OFFSET-8,DATA-'C',BLANK-1,AREA-SYSTEM // GOTO EVAL // TAG SETLCL // LOCAL OFFSET-1,DATA-'COBOLP C',BLANK-*ALL,AREA-SYSTEM // LOCAL OFFSET-9,DATA-'004000NONEP',AREA-SYSTEM // LOCAL OFFSET-20,DATA-'NODSMNOJOBQPRINT',AREA-SYSTEM // LOCAL OFFSET-97,DATA-'#SE@XTRA',AREA-SYSTEM // LOCAL OFFSET-419,DATA-'?CLIB?',AREA-SYSTEM // TAG EVAL // LOCAL OFFSET-411,DATA-'?CLIB?',BLANK-8,AREA-SYSTEM * THE PARAMETERS ARE CHECKED FOR VALID ENTRIES. IF AN ERROR IS FOUND, * THE MIC NUMBER IS DISPLAYED ON SYSLOG. THE SCREEN IS REDISPLAYED * IF THE USER CHOOSES THE 'H' OPTION. // IFF /?2? GOTO P05K // EVALUATE P2=?CLIB? // GOTO P10K // TAG P05K // IF DATAF1-?2? GOTO P10K // IFF /?2? #ERR 4002,03,CBL // EVALUATE P2=?CLIB? DEFAULT IF SYSLOG OPTION 0 // TAG P10K // IFF /?2? LOCAL OFFSET-419,DATA-'?2?',BLANK-8,AREA-SYSTEM // IF /?1? #ERR 4001,3,CBL // IF SOURCE-'?1?,?2?' GOTO P20K // IFF /?1? #ERR 4001,3,CBL // TAG P20K // IFF /?1? LOCAL OFFSET-435,DATA-'?1?',BLANK-8,AREA-SYSTEM // IF /?3? GOTO P30K // IF DATAF1-?3? GOTO P30K // IFF /?3? #ERR 4003,03,CBL // GOTO P31K // TAG P30K // IFF /?3? LOCAL OFFSET-427,DATA-'?3?',BLANK-8,AREA-SYSTEM // TAG P31K // IFF /?4? IFF DSM/?4? IFF NODSM/?4? #ERR 4018,03,CBL // ELSE LOCAL OFFSET-20,DATA-'?4?',BLANK-5,AREA-SYSTEM // IFF /?5? IFF PRINT/?5? IFF NOPRINT/?5? IFF CRT/?5? #ERR 4005,03,CBL // ELSE LOCAL OFFSET-31,DATA-'?5?',BLANK-7,AREA-SYSTEM // TAG P38AK // IFF /?6? IFF XREF/?6? IFF NOXREF/?6? #ERR 4010,03,CBL // ELSE LOCAL OFFSET-74,DATA-'?6?',BLANK-6,AREA-SYSTEM // IFF /?7? IFF NEP/?7? IFF NONEP/?7? #ERR 4014,03,CBL // ELSE LOCAL OFFSET-15,DATA-'?7?',BLANK-5,AREA-SYSTEM // IFF ?8'00'?>-1 #ERR 4015,03,CBL // ELSE LOCAL OFFSET-13,DATA-'?8?',BLANK-2,AREA-SYSTEM // IFF ?9'0040'?>0 #ERR 4006,03,CBL // ELSE LOCAL OFFSET-9,DATA-'?9?',BLANK-4,AREA-SYSTEM // IFF /?10? IFF SOURCE/?10? IFF NOSOURCE/?10? #ERR 4007,03,CBL // ELSE LOCAL OFFSET-38,DATA-'?10?',BLANK-8,AREA-SYSTEM // IFF /?11? IFF DEBUG/?11? IFF NODEBUG/?11? #ERR 4008,03,CBL // ELSE LOCAL OFFSET-67,DATA-'?11?',BLANK-7,AREA-SYSTEM // IFF /?12? IFF MAP/?12? IFF NOMAP/?12? #ERR 4009,03,CBL // ELSE LOCAL OFFSET-46,DATA-'?12?',BLANK-5,AREA-SYSTEM // IFF /?13? IFF OFFSET/?13? IFF NOOFFSET/?13? #ERR 4011,03,CBL // ELSE LOCAL OFFSET-51,DATA-'?13?',BLANK-8,AREA-SYSTEM // IFF /?14? IFF OBJECT/?14? IFF NOOBJECT/?14? #ERR 4019,03,CBL // ELSE LOCAL OFFSET-80,DATA-'?14?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-443,DATA-'?17?',BLANK-8,AREA-SYSTEM // IF /?15? GOTO P60K // IF DATAF1-?15? GOTO P60K // IFF /?15? #ERR 4012,03,CBL // GOTO P61K // TAG P60K // IFF /?15? LOCAL OFFSET-88,DATA-'?15?',BLANK-8,AREA-SYSTEM // TAG P61K // IF /?16? GOTO P70K // IF DATAF1-?16? GOTO P70K // IFF /?16? #ERR 4013,03,CBL // GOTO P71K // TAG P70K // IFF /?16? LOCAL OFFSET-59,DATA-'?16?',BLANK-8,AREA-SYSTEM // TAG P71K // IF /?17? GOTO P84K // LOAD #RPDD // RUN // IF '?L'451,1'?'/'1' #ERR 4026,03,CBL // TAG P84K // IFF /?18? IFF LINK/?18? IFF NOLINK/?18? #ERR 4023,03,CBL // ELSE LOCAL OFFSET-116,DATA-'?18?',BLANK-6,AREA-SYSTEM // IFF /?19? IFF MRO/?19? IFF NOMRO/?19? #ERR 4022,03,CBL // ELSE LOCAL OFFSET-111,DATA-'?19?',BLANK-5,AREA-SYSTEM // IF ?18?/NOLINK IF ?19?/MRO #ERR 4024,03,CBL * * // TAG COMP * THIS BLOCK PREPARES TO CALL THE COBOL COMPILER // MEMBER USER1-#CB#M1,USER2-#CB#M2,PROGRAM1-#CB#M1,PROGRAM2-#CB#M2,+ LIBRARY-#COBLIB // LIBRARY NAME-#COBLIB // LOAD #CB00,#COBLIB // FILE NAME-$SOURCE,UNIT-F1,RETAIN-S,DISP-NEW,BLOCKS-?9'40'?,EXTEND-25 // FILE NAME-$WORK,UNIT-F1,RETAIN-S,DISP-NEW,BLOCKS-?9'40'?,EXTEND-25 // IFF ?4?/DSM GOTO NOTDSM * IF USER REQUESTED DSM, THEN ALLOCATE WORK2, WORK3 // FILE NAME-$WORK2,UNIT-F1,RETAIN-J,BLOCKS-?9'40'?,LABEL-?1?,EXTEND-25 // FILE NAME-$WORK3,UNIT-F1,RETAIN-S,DISP-NEW,BLOCKS-?9'40'?,EXTEND-25 // GOTO YESDSM // TAG NOTDSM * IF USER DID NOT REQUEST DSM, THEN ALLOCATE ONLY WORK2 // FILE NAME-$WORK2,UNIT-F1,RETAIN-S,DISP-NEW,BLOCKS-?9'40'?,EXTEND-25 // TAG YESDSM // PRINTER NAME-$PRINTDM,CONTINUE-YES, // IF ?5?/CRT PRIORITY-0 // ELSE PRIORITY-1 * IF CONTINUE-YES ALREADY IN EFFECT INDICATE Y IN LDA BYTE 106 // IF ?CD?/2040 LOCAL OFFSET-106,DATA-'Y',AREA-SYSTEM // MEMBER PROGRAM1-#CB#M1,LIBRARY-#COBLIB MESSAGE MEMBER // MEMBER PROGRAM2-#CB#M2,LIBRARY-#COBLIB MESSAGE MEMBER // COMPILE INLIB-?2'?CLIB?'?,OUTLIB-?3'?2?'?,MRTMAX-?8'00'?,SOURCE-?1?, // IFF ?17?/ DATADCT-?17?, // IF ?19?/MRO MRO-YES, // IF ?L'15,3'?/NEP NEP-YES // ELSE NEP-NO // RUN // LOCAL OFFSET-107,DATA-'?CD?',AREA-SYSTEM STORE FOR LATER USE * IF DSM REQUESTED, DISPLAY DSM FILE VIA SEU * IF CONTINUE-YES WAS IN EFFECT PRIOR, DO NOT SHUT OFF // IF ?L'106,1'?/Y IFF ?5?/CRT GOTO NCRTTAG // PRINTER CONTINUE-NO // TAG NCRTTAG // LIBRARY NAME-?L'411,8'? // IFF ?4?/DSM GOTO SKIPMNT // IF ?L'105,1'?/ GOTO SKIPMNT IF DSM IS NOT GOOD,SKIP SOURCE VIEW W // LOAD $MAINT // FILE NAME-$WORK2,UNIT-F1,RETAIN-S,LABEL-?1? // RUN // COPY FROM-DISK,TO-?2?,RETAIN-R,FILE-$WORK2 // END // TAG SKIPMNT // IF JOBQ-YES GOTO SKIPCRT // IF EVOKED-YES GOTO SKIPCRT * * IF CRT SPECIFIED, COPY SPOOL FILE ENTRY TO DISK, * AND THEN DISPLAY THE DISK FILE AT DISPLAY STATION * THE COMPILER (#CB50) HAS PUT THE SPOOL-ID INTO THE LDA // EVALUATE P5=?L'31,7'? // IFF ?5?/CRT GOTO EXIT ************************************************************************ * THE FOLLOWING 4 LINES ARE ADDED FOR PTF 52-545 . THEY REPLACE * * THE CALLS TO $UASF AND $UASC. * ************************************************************************ // INFOMSG NO // IFT DATAF1-CB?L'181,6'? DELETE CB?L'181,6'?,F1 // IFF ?L'181,6'?/ COPYPRT ?L'181,6'?,CB?L'181,6'?,CANCEL,CRT // IF DATAF1-CB?L'181,6'? DELETE CB?L'181,6'?,F1 // TAG SKIPCRT // TAG EXIT * NOW RESTORE THE ?CD? VALUE // EVALUATE CD=?L'107,4'? @@TAK // RETURN