|
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: 8960 (0x2300)
Notes: MEMBER_P, Member_Text
Names: »COBOLONL«
└─⟦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⟧ ».COBOLONL«
* * THE COBOL ONLINE DEVELOPMENT PROCEDURE FOR S/36 * // LOCAL AREA-SYSTEM LOCAL AREA=SYSTEM LDA // MEMBER USER1-#CB#M1,LIBRARY-#COBLIB MESSAGE MEMBERS // IF JOBQ-NO IF EVOKED-NO GOTO NJOBQ // MSG ?WS?,?M'2000,1,75'? CANT EVOKE OR JOBQ THIS PROC // RETURN // TAG NJOBQ // IFF PROC-DSU IFF PROC-SEU #ERR 2021,3,CBL // IFF '?L'1,2'?'/CO GOTO SETLCL IF COBOLP PRIOR, USE LDA // IFF '?L'3,2'?'/BO GOTO SETLCL IF COBOLP PRIOR, USE LDA // IFF '?L'5,2'?'/LP GOTO SETLCL IF COBOLP PRIOR, USE LDA // LOCAL OFFSET-8,DATA-'O',BLANK-1,AREA-SYSTEM // GOTO RETPARMS // TAG SETLCL * NOW SET UP THE LDA WITH DEFAULTS // LOCAL OFFSET-1,DATA-'COBOLP O004000NONEP',BLANK-*ALL,AREA-SYSTEM // LOCAL OFFSET-419,DATA-'?CLIB?',AREA-SYSTEM DEFAULT INPUT LIB // TAG RETPARMS * SOURCE NAME SOURCE LIB OUTPUT LIB VIEWSOURCE CRT-PRINT // EVALUATE P1=?L'435,8'? P2=?L'419,8'? P3=?L'427,8'? P5='N' * WORKBLOCKS SOURCE DEBUG MAP XREF // EVALUATE P6=?L'9,4'? // EVALUATE P4=?L'443,8'? * OFFSET COPYLIB SUBLIB NEP // EVALUATE P15=?L'15,5'? * MRT // EVALUATE P16=?L'13,2'? // LOCAL OFFSET-20,DATA-'DSM NOJOBQCRT ',AREA-SYSTEM // LOCAL OFFSET-96,DATA-'N#SE@XTRA',AREA-SYSTEM * PROBLEM OF SAVING INPUT LIB NAME FIXED // LOCAL OFFSET-411,DATA-'?CLIB?',BLANK-8,AREA-SYSTEM SAVE THE CUR // TAG SCREEN1A // EVALUATE P7='' // TAG SCREEN1 // PROMPT FORMAT-COBONL,LIBRARY-#COBLIB,LENGTH-'8,8,8,8,1,4,56', // IF DSPLY-IGC MEMBER-#CB$FMT // ELSE MEMBER-#CB@FMT // EVALUATE P22='' P23='' P24='' P25='' P26='' P27='' // IF ?CD?/2007 RETURN CHECK FOR END-OF-JOB // IF ?CD?/2003 RETURN // TAG CHKPARMS // IF /?2? GOTO SCREEN1 ?7F'4002'? ?23F'C'? INPUT LIB NOT GIVEN // IFF DATAF1-?2? GOTO SCREEN1 ?7F'4002'? ?23F'C'? INPUT LIB NOT FOUND // IF /?1? GOTO SCREEN1 ?7F'4001'? ?22F'C'? NO SOURCE MEMBER // IF SOURCE-'?1?,?2?' GOTO P08K // TAG P07E * SOURCE MEMBER DOESN'T EXIST. CREATE NEW MEMBER IF THEY WISH TO EDIT * PRIOR TO COMPILE ELSE GENERATE AN ERROR // IFF ?5?/Y GOTO SCREEN1 ?7F'4001'? ?22F'C'? DOESN'T WANT TO SEU // TAG P08K // IF /?3? GOTO P12K OUTLIB BLANK // IFF DATAF1-?3? GOTO SCREEN1 ?7F'4003'? ?24F'C'? OUTLIB NOT FOUND // TAG P12K // IFF ?3?/ LOCAL OFFSET-427,DATA-'?3?',BLANK-8,AREA-SYSTEM // ELSE LOCAL OFFSET-427,DATA-' ',AREA-SYSTEM // LOCAL OFFSET-443,DATA-'?4?',AREA-SYSTEM // IF /?4? GOTO P14K // EVALUATE P51,4=?CD? // LOAD #RPDD // RUN // EVALUATE CD=?51? // IF '?L'451,1'?'/'1' GOTO SCREEN1 ?7F'4026'? ?25F'C'? // TAG P14K // IFF ?5?/Y IFF ?5?/N GOTO SCREEN1 ?7F'4004'? ?26F'C'? // IFF ?6?>0 GOTO SCREEN1 ?7F'4006'? ?27F'C'? // IF ?CD?/2003 RETURN // IFF ?CD?/2014 GOTO PUTPARMS CHECK FOR MORE COMPILE OPTIONS // TAG SCREEN2C // EVALUATE P21='' // TAG SCREEN2 // EVALUATE P20='COBOLONL ?1?,?2?,?3?,?4?,?5?,?6?' // TAG SCREEN2A // PROMPT FORMAT-COBONL2,START-8,LIBRARY-#COBLIB,+ LENGTH-'8,7,5,6,8,8,8,5,2,6,5,8,72,56', // IF DSPLY-IGC MEMBER-#CB$FMT // ELSE MEMBER-#CB@FMT // EVALUATE P37='' P38='' P39='' P40='' P41='' P42='' P43='' + P44='' P45='' P48='' P49='' P50='' // IF ?CD?/2007 RETURN CHECK FOR END-OF-JOB // IF ?CD?/2003 RETURN * THIS BLOCK CHECKS PARMS 6-15 FOR INVALID ENTRIES. IF FOUND, THE * APPROPRIATE MIC NUMBER IS INSERTED AND THE SCREEN REDISPLAYED. // LOCAL OFFSET-97,DATA-'#SE@XTRA',AREA-SYSTEM // IFF /?8? IFF ?8?/SOURCE IFF ?8?/NOSOURCE + GOTO SCREEN2A ?21F'4007'? ?37F'C'? // IFF /?9? IFF ?9?/DEBUG IFF ?9?/NODEBUG + GOTO SCREEN2A ?21F'4008'? ?38F'C'? // IFF /?10? IFF ?10?/MAP IFF ?10?/NOMAP + GOTO SCREEN2A ?21F'4009'? ?39F'C'? // IFF /?11? IFF ?11?/NOXREF IFF ?11?/XREF + GOTO SCREEN2A ?21F'4010'? ?40F'C'? // IFF /?12? IFF ?12?/OFFSET IFF ?12?/NOOFFSET + GOTO SCREEN2A ?21F'4011'? ?41F'C'? // IFF /?13? IFF DATAF1-?13? GOTO SCREEN2A ?21F'4012'? ?42F'C'? // IFF /?14? IFF DATAF1-?14? GOTO SCREEN2A ?21F'4013'? ?43F'C'? // IFF /?15? IFF ?15?/NEP IFF ?15?/NONEP + GOTO SCREEN2A ?21F'4014'? ?44F'C'? // IFF ?16?>-1 GOTO SCREEN2A ?21F'4015'? ?45F'C'? // IFF /?17? IFF LINK/?17? IFF NOLINK/?17? + GOTO SCREEN2A ?21F'4023'? ?48F'C'? // IFF /?18? IFF MRO/?18? IFF NOMRO/?18? + GOTO SCREEN2A ?21F'4022'? ?49F'C'? // IF ?17?/NOLINK IF ?18?/MRO + GOTO SCREEN2A ?21F'4024'? ?48F'C'? // IFF /?19? IFF OBJECT/?19? IFF NOOBJECT/?19? + GOTO SCREEN2A ?21F'4019'? ?50F'C'? // IF ?CD?/2002 GOTO SCREEN1A CHECK FOR PAGE BACK * THIS BLOCK STORES THE PARAMETERS IN THE PROPER AREAS OF THE LDA // TAG PUTPARMS // LOCAL OFFSET-435,DATA-'?1?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-419,DATA-'?2?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-96,DATA-'?5?',AREA-SYSTEM // LOCAL OFFSET-9,DATA-'?6?',BLANK-4,AREA-SYSTEM // LOCAL OFFSET-38,DATA-'?8?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-67,DATA-'?9?',BLANK-7,AREA-SYSTEM // LOCAL OFFSET-46,DATA-'?10?',BLANK-5,AREA-SYSTEM // LOCAL OFFSET-74,DATA-'?11?',BLANK-6,AREA-SYSTEM // LOCAL OFFSET-51,DATA-'?12?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-88,DATA-'?13?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-59,DATA-'?14?',BLANK-8,AREA-SYSTEM // LOCAL OFFSET-13,DATA-'?16?',AREA-SYSTEM,BLANK-2 // LOCAL OFFSET-15,DATA-'?15?',BLANK-5,AREA-SYSTEM // LOCAL OFFSET-116,DATA-'?17?',BLANK-6,AREA-SYSTEM // LOCAL OFFSET-111,DATA-'?18?',BLANK-5,AREA-SYSTEM // LOCAL OFFSET-80,DATA-'?19?',BLANK-8,AREA-SYSTEM // TAG COMP // IFF ?5?/Y GOTO SKIPSEU // IFF PROC-DSU GOTO SEUDO DSU EDIT,?1?,S,,,?2'?CLIB?'? // EVALUATE P5='N' // IFF SOURCE-'?1?,?2?' GOTO P07E // PRINTER CONTINUE-NO // GOTO SKIPSEU // TAG SEUDO SEU ?1?,S,,,?2'?CLIB?'? // EVALUATE P5='N' BYPASS SEU NEXT PASS // IFF SOURCE-'?1?,?2?' GOTO P07E // TAG SKIPSEU // IF JOBQ-NO IF EVOKED-NO * 2011 IF PROC NOT EVOKED OR RUN FROM * JOBQ, DISPLAY IN PROCESS MSG // LIBRARY NAME-#COBLIB // LOAD #CB00,#COBLIB // FILE NAME-$SOURCE,UNIT-F1,RETAIN-S,DISP-NEW,BLOCKS-?6'40'?,EXTEND-25 // FILE NAME-$WORK,UNIT-F1,RETAIN-S,DISP-NEW,BLOCKS-?6'40'?,EXTEND-25 // FILE NAME-$WORK2,UNIT-F1,BLOCKS-?6'40'?,RETAIN-J,LABEL-?1?,EXTEND-25 // FILE NAME-$WORK3,UNIT-F1,BLOCKS-?6'40'?,RETAIN-S,DISP-NEW,EXTEND-25 // PRINTER NAME-$PRINTDM,CONTINUE-YES,PRIORITY-0 // IF ?CD?/2040 LOCAL OFFSET-106,DATA-Y,AREA-SYSTEM // MEMBER PROGRAM1-#CB#M1,PROGRAM2-#CB#M2,LIBRARY-#COBLIB // COMPILE INLIB-?2'?CLIB?'?,OUTLIB-?3'?2?'?,MRTMAX-?16'00'?,SOURCE-?1?, // IFF ?4?/ DATADCT-?4?, // IF ?18?/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 @@TAK // EVALUATE P3=?L'427,8'? RESTORE OUTLIB TO WHAT WAS ENTERED // LIBRARY NAME-?L'411,8'? // EVALUATE P35=?L'31,8'? SAVE COMPILER PRINT OPTION // IF ?L'105,1'?/ GOTO SKIPMNT IF DSM IS NOT GOOD,SKIP SOURCE VIEW // IFF PROC-DSU GOTO SEUDO2 // PRINTER CONTINUE-NO DSU EDIT,?1?,S,,,?2'?3?'?,?1? // GOTO SKIPMNT // TAG SEUDO2 SEU ?1?,S,,,?2'?3?'?,?1? // TAG SKIPMNT // LOCAL OFFSET-105,DATA-' ',AREA-SYSTEM RESET TO NO DSM // PRINTER CONTINUE-NO // EVALUATE P20='N' P21='Y' P22='' // TAG SCREEN3 // PROMPT FORMAT-COBONL3,START-20,LIBRARY-#COBLIB,LENGTH-'1,1,56', // IF DSPLY-IGC MEMBER-#CB$FMT // ELSE MEMBER-#CB@FMT // MEMBER USER1-#CB#M1,USER2-#CB#M2,PROGRAM1-#CB#M1,PROGRAM2-#CB#M2,+ LIBRARY-#COBLIB // EVALUATE P46='' P47='' // IF ?CD?/2007 LOCAL OFFSET-178,DATA-'1',AREA-SYSTEM // ELSE IF ?CD?/2014 LOCAL OFFSET-178,DATA-'2',AREA-SYSTEM // ELSE LOCAL OFFSET-178,DATA-'0',AREA-SYSTEM // IF ?CD?/2007 GOTO P105K IF CMD7 JUMP AHEAD TO END // IFF ?20?/Y IFF ?20?/N GOTO SCREEN3 ?22F'4016'? ?46F'C'? // IFF ?21?/N IFF ?21?/Y GOTO SCREEN3 ?22F'4017'? ?47F'C'? // TAG P105K // IFF ?35?/CRT GOTO NODELT * SPOOL NOT ACTIVE OR SPOOL FILE NOT CREATED FOR SOME REASON // IF ?20?/Y IFF ?CD?/2007 GOTO NODELT DETERMINE IF WE NEED * TO DELETE THE SPOOL FILE ENTRY. EXECUTE #RPSPD IF IT MUST BE DELETED. // LOCAL OFFSET-187,DATA-'?WS?',AREA-SYSTEM // LOAD #RPSPD // RUN // GOTO ENDPROC // TAG NODELT * * IF CRT SPECIFIED, COPY SPOOL FILE ENTRY TO DISK, * AND THEN DISPLAY THE DISK FILE AT DISPLAY STATION * ************************************************************************ * 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 // LOCAL OFFSET-1,DATA-'?33?',AREA-SYSTEM // LOCAL OFFSET-129,DATA-'?34?',AREA-SYSTEM // TAG ENDPROC // EVALUATE CD=?L'107,4'? // IF ?L'178,1'?/1 RETURN CMD 7 HIT // IF ?L'178,1'?/2 GOTO SCREEN2C CMD 14 HIT // EVALUATE P22='' // IF ?21?/Y IF ?20?/N GOTO COMP PROCEED NO VIEW-JUST COMPILE // IF ?21?/Y IF ?20?/Y GOTO SCREEN1A PROCEED AND VIEW-REPROMPT // RETURN