./ ADD SSI=04010241,NAME=IEMAA,SOURCE=0 GBLB &STD 00020021 &STD SETB 1 00040021 AA TITLE 'IEMAA,RESIDENT CONTROL PHASE,COMPILER CONTROL,OS/360 PLC00080015 /I COMPILER(F)' 00160015 * 00240015 * STATUS - CHANGE LEVEL 0 00320015 * 00322056 * 5.5 A 168800,173600,177600 KT 60069 00324072 * 5.5 A 588800 KT 57455 00324172 * 5.5 C 516800,528000-531200,547400-547600,549600-554400 KT 57455 00324272 * 559200-560000 KT 57455 00324372 * 5.5 D 517600,533600-543200,555200 KT 57455 00324472 * 5.4 A 000000,119200,454000,454100,749200 MCB 54703 00324621 * 5.4 C 121600,175200 MCB 54704 00325221 * 5.3B C 003600-003800 *** REWORKING OF FLAGGING COMMENTS. CRS 47664 00326056 * D 002000,003996-005176 CRS 47664 00328056 * 5.3A C 798800-798900 PG 43462 00330056 * 5.3A C 499200-506400 JLC Z2074 00332056 * D 494400-496800 JLC Z2074 00334056 * 5.3A *** THIS FIX WAS MADE FROM REL 20.0 ON BY A NUMBER CRS 31173 00336056 * *** OF PEOPLE, FOR FETCH PROTECT SUPPORT. CRS 31173 00338056 * ** THE CHANGES WERE SO COMPLEX THAT ONLY THE END CRS 31173 00340056 * ** RESULT WILL BE GIVEN, AS FOLLOWS - CRS 31173 00342056 * MCB 31173 00344056 * 5.2B C 330700-332800,358000,393200,403000-406200 JLC 31173 00346056 * D 361600-363200 PG 31173 00348056 * A 785800-786100 CRS 31173 00350056 * MAC 31173 00352056 * 5.2B A 984000 JLC Z2151 00354056 * C 715400-718400 (REPACKAGE -> IEMAK) JLC Z2151 00356056 * 5.2 A 382200,627600,641200,666800,668400,715300,717600 JLC 33893 00358056 * C 652000-652800 JLC 33893 00360056 * D 384000,654400 JLC 33893 00362056 * 00364056 * 00366056 * R18 135200*,176800,591200* PTM825 00386001 * R18 FOR CONTROL PURPOSES PTM825 WAS MADE INTO APAR H229 00392001 * R18 155200-156000,536800*,540800*,590800-591400, H229 00392301 * R18 744800*,748800,752800,798400,918400 H229 00392601 * R18 176000,177200 H235 00393001 * R18 174200,176400 H207 00395001 * R18 DUPLICATE OF H207 23263 00396001 * R18 174250,176320 H313 00397001 * R18 174300,176260 H319 00398001 * R19 APAR 21158 HAS BEEN FIXED BY I24 00398619 * R19 791400,812000,814530,818900,836800 I24 00399219 SPACE 3 00519620 * FUNCTIONS - 1)COMPILER INITIALISATION. IEMAB IS LOADED 00560015 * IN ORDER TO PERFORM THIS FUNCTION 00640015 * 2)CHARACTER TRANSLATION. EBCIDIC OR BCD TO 00720015 * INTERNAL AND BACK TO EXTERNAL. THE RELEVANT TABLE IS SUPPLIED 00800015 * DEPENDING UPON THE OPTION 00880015 * 3)DICTIONARY AND TEXT BLOCK CONTROL. THESE 00960015 * INCLUDE,EVENTUALLY,THE SPILLING OF BLOCKS ONTO SYSUT1 AND THE 01040015 * CONTROL THEREOF. 01120015 * 4)PHASE LOADING. FACILITIES ARE ALLOWED FOR 01200015 * MARKING PHASES,LOADING PHASES AND RETURNING CONTROL TO THE 01280015 * CALLER,DELETING(RELEASING) PHASES AND PASSING CONTROL TO A NEW 01360015 * PHASE. 01440015 * 5)INPUT/OUTPUT CONTROL ONTO SYSPRINT,SYSIN, 01520015 * SYSLIN AND SYSPUNCH. CONTROL TO SYSUT3 IN IEMAC 01600015 * 01680015 * 01760015 * ENTRY POINT - THE CONTROL PHASE HAS A MULTITUDE OF ENTRY 01840015 * POINTS. THE ARE LISTED IN THE TRANSFER VECTOR AT THE START OF 01920015 * THE PHASE 02000015 * 02080015 * 02160015 * INPUT - ONLY INPUT IS THE PARAMETER LIST POINTED AT BY 02240015 * GENERAL REGISTER 1 ON ENTRY 02320015 * 02400015 * 02480015 * OUTPUT - THE ONLY OUTPUT GENERATED BY THE COMPILER IS 02560015 * THE RETURN CODE PLACED IN GENERAL REGISTER 15 ON COMPLETION OF 02640015 * THE COMPILATION 02720015 * 02800015 * 02880015 * EXTERNAL ROUTINES - 1)IEMAB THE COMPILER INITIALISER. IT 02960015 * IS LOADED IMEDIATELY AFTER IEMAA HAS BEEN LOADED. 03040015 * 2)IEMAC. THE INTERMEDIATE FILE 03120015 * CONTROL. RECORDS ARE WRITTEN ON SYSUT3 AND THE READ BACK. 03200015 * 3)IEMAD. INTER-PHASE DUMPING CONTROL 03280015 * 5)IEMAF. GENERATED BY SYSGEN. IT 03440015 * WILL INDICATE THE STATUS OF THE DEFAULT OPTIONS 03520015 * 6)IEMAG. SYSUT3 FILE SWITCHING. IT 03600015 * IS CALLED BY IEMAC. 03680015 * 4)IEMAE. CLEAN-UP AFTER READIN AND 03760015 * OPEN SYSLIN AND SYSPUNCH IF NECESSARY 03840015 * 03920015 * 04000015 * EXITS - THE EXIT IS THROUGH ZEND. IT IS THERE THAT THE 04080015 * CONDITION CODE IS PICKED UP. THERE ARE NO ABNORMAL EXITS. 04160015 * 04240015 * 04320015 * ATTRIBUTES - THIS CODE IS NOT REUSABLE 04400015 EJECT 04480015 * 04560015 * BASE THE COMPILER 04640015 * 04720015 SPACE 2 04800015 * FOR THE ENTRY POINT IEMAA, REGISTER 1 IEM00 04808017 * POINTS TO A PARAMETER LIST WHICH HAS ONE OF IEM00 04816017 * THE THREE FORMS IEM00 04824017 * IEM00 04832017 * (1) A( OPTION LIST ) OR IEM00 04840017 * O IEM00 04848017 * (2) A( OPTION LIST ) IEM00 04856017 * A( ALTERNATE DDNAME LIST ) OR IEM00 04864017 * IEM00 04872017 * (3) A( OPTION LIST ) IEM00 04880017 * A( ALTERNATE DDNAME LIST ) IEM00 04888017 * A( PAGE NUMBER ) IEM00 04896017 * 04897017 * (4) A( OPTIONS LIST ) 04898017 * A( ALTERNATE DDNAME LIST ) 04899017 * A( PAGE NUMBER ) 04900017 * A( DATA ROUTINE ) 04901017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 000-TSS 04902020 SPACE 2 IEM00 04904017 IEMAA START 0 IEM00 04912017 * ----------------------------------------------------AA 000-TSS 04916020 SPACE 1 IEM00 04920017 USING *,15 IEM00 04928017 SPACE 1 IEM00 04936017 STM 14,12,12(13) STORE OS/360 REGISTERS IEM00 04944017 L CNTL,BASAD1 LOAD BASE REGISTER IEM00 04952017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 047-TSS 04954020 * ----------------------------------------------------AA 047-TSS 04956020 B ZINIT IEM00 04960017 SPACE 1 IEM00 04968017 BASAD1 DC A(SECT1) IEM00 04976017 SPACE 1 IEM00 04984017 DROP 15 IEM00 04992017 SPACE 5 IEM00 05000017 USING *,CNTL IEM00 05392017 SPACE 1 IEM00 05400017 SECT1 DC A(0) ADDRESS OF DATA ROUTINE IEM00 05408017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 021-TSS 05412020 DC A(RDDCB) ADDRESS OF SYSIN DCB IEM00 05416017 * ----------------------------------------------------AA 021-TSS 05426020 EJECT 05440015 * 05520015 * THE TRANSFER VECTOR. IT CONTAINS THE ADDRESSES OF THE 05600015 * ENTRY POINTS OF THE VARIOUS ROUTINES WITHIN THE CONTROL PHASE 05680015 * 05760015 * THE OFFSET OF EACH ADCON IS FIXED AND IS KNOWN BY ALL THE 05840015 * COMPILER PHASES. IF A COMPILER PHASE WISHES TO CALL A COMPILER 05920015 * ROUTINE THEN ITS LINK REGISTER IS LOADED WITH THE ADCON 06000015 * FROM A FIXED OFFSET WITHIN THE CONTROL PHASE. IN ALL CASES THE 06080015 * RETURN REGISTER MUST BE 14. 06160015 * 06240015 * 06320015 * THIS IS THE PRE-INITIALISER. THE OPERATIONS IT PERFORMS 06400015 * ARE 1) A GETMAIN TO FIND A SAVE AREA 06480015 * 2) READ THE TIMER IN ORDER TO TIME THE COMPILATION 06560015 * 3) LINK TO IEMAB. THIS IS THE REAL INITIALISER. THE LINK 06640015 * IS PERFORMED IN ORDER TO LOAD THE PHASE INTO LOW CORE. 06720015 * THIS WILL RESULT IN A LOW DEGREE OF FRAGMENTATION OF CORE 06800015 * BETWEEN PHASES AND TEXT AND DICTIONARY BLOCKS 06880015 * 4) ISSUE A SPIE TO ENABLE THE COMPILER TO DEAL WITH ALL 06960015 * TYPES OF PROGRAM CHECK 07040015 * 5) LOAD THE FIRST REQUESTED PHASE. THIS CAN BE 07120015 * MACRO PROCESSOR 07200015 * 48 CHARACTER SET (IEMBA) 07280015 * OR READIN PASS-1 (IEMCA) 07360015 * 07440015 DC A(0) ZUPL WILL HOLD PRINT ROUTINE 07520015 DC A(0) ZURD SYSIN 07600015 DC A(0) ZUGC SCRATCH CORE FINDER 07680015 DC A(0) ZUTXTC GET A TEXT BLOCK 07760015 DC A(0) ZURC RELEASE SCRATCH CORE 07840015 DC A(ADDLST) LIST OF ADDRESSES FOR INITIALTON 07920015 DC A(ZABORT) ABORTS COMPILER 08000015 DC A(LOADW) LOADS PHASE AND RETURNS TO CALLR 08080015 DC A(0) ZDICAB WILL HOLD DIC ENTRY-ALIGNED,ABS 08160015 DC A(0) ZDICRF -ALIGNED,REF 08240015 DC A(0) ZUERR ERROR MSSG ENTRY 08320015 DC A(0) ZDRFAB DIC REF TO ABSOLUTE 08400015 DC A(LOADX) SPECIAL ENTRY FOR RELOADED PHASE 08480015 DC A(0) USE NOT KNOWN - DUMPS MAYBE 08560001 DC A(REQEST) MARK PHASE AS REQUESTED,NOT WANT 08640015 DC A(RELESE) DELETE THE LOADED PHASE 08720015 DC A(RLSCTL) DELETE PHASE AND PASS CONTROL 08800015 DC A(0) ZUST ADDRESS OF IEMAD 08880001 DC A(0) ZTXTRF WILL HOLD TEXT ABSOLUTE TO REF 08960015 DC A(0) ZTXTAB TEXT REF TO ABSOLUTE 09040015 DC A(0) ZCHAIN NEXT TEXT BLOCK IN CHN 09120015 DC A(0) ZALTER ALTER STATUS OF TXT BL 09200015 DC A(0) ZDABRF DIC- ABS TO REF 09280015 DC A(0) ZNALRF DIC ENTRY-UNALGND,REF 09360015 DC A(0) ZNALAB UNALGND,ABS 09440015 DC A(ZEND) TERMINATE JOB-STEP 09520015 DC A(ZULF) SYSTEM LOAD FILE 09600015 DC A(ZUSP) SYSPUNCH 09680015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 044-TSS 09720020 DC A(0) HOLDS ADDRESS OF INTER FILE RTN 09760015 * ----------------------------------------------------AA 044-TSS 09800020 DC A(0) 09840015 DC A(RLSCTLX) SPECIAL ENTRY FOR OVERLAY 09920015 DC A(0) ROUTINE TO RECONST. INSTRS IN AL 10000015 DC A(DYNAMIC) DYNAMIC DUMP ROUTINE 10080015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 039-TSS 10120020 DC A(0) ADDR OF SECOND CONTROL PHASE 10160015 * ----------------------------------------------------AA 039-TSS 10200020 SPACE 10240015 EJECT 10320015 SPACE 10400015 ZINIT BALR GRA,0 GET PROGRAM MASK 10480015 ST GRA,PMASK AND RETAIN IT 10560015 LA GRA,FSTSAV POINT AT SAVE AREA 10640015 ST DICR,4(0,GRA) CHAIN FORWARDS IN NEW SAVE ARE 10720015 ST GRA,8(0,DICR) CHAIN BACKWARDS IN OS/360 SAVE 10800015 LR DICR,GRA 10880015 ST GRA,KEEP STORE ADDRESS OF THIS SAVE AREA 10960015 SPACE 11040015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 001-TSS 11090020 BATCH STIMER TASK,TUINTVL=KTIME 11140015 TIME BIN 20221 11180001 ST GR0,KTIME2 20221 11220001 * ----------------------------------------------------AA 001-TSS 11250020 SPACE 11280015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 002-TSS 11320020 LINK EP=IEMAB 11360015 * ----------------------------------------------------AA 002-TSS 11400020 SPACE 11440015 SPACE 11520015 BC B,HEREX(LR) TEST RETURN FROM INIT PHASE 11600015 HEREX BC B,KILL 11680015 SPACE 11760015 L DICR,DADDR POINT AT DICTIONARY 11840015 TM CCCODE+2(DICR),X'40' TEST IF CHECK SPECIFIED 11920015 AIF (NOT &STD).L1 11930021 LA DICR,SAVAR PROVIDE S.A. TO SPIE MACROS. 11940021 .L1 ANOP 11950021 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 003-TSS 11960020 BC BZ,CHKA BRANCH IF CHK SPECIFIED 12000015 SPIE PIH,((1,15)) WE HANDLE ALL PROGRAM CHECKS 12080015 ROPA CLI PICAD+3,X'01' HAVE WE STORED EXTERNAL PICA 54704 12160021 BNE NCHK ALREADY(BATCHING). DONT STORE 54704 12170021 ST 1,PICAD IT AGAIN IF SO. 54704 12180021 * ----------------------------------------------------AA 003-TSS 12200020 SPACE 12240015 NCHK L DICR,DADDR POIMT AT DICTIONARY 12320015 ST CNTL,ZTV(0,DICR) STORE CONTROL BASE 12400015 SPACE 12480015 CLI TERMSW(DICR),X'FF' SEE IF COMPILER MUST BE KILLED 12560015 BC BNE,LODFST 12640015 BAL RR,ABORT 12720015 SPACE 12800015 LODFST LA GR0,LODLST POINT AT AM FOR LOADW 12880015 ST GR0,PAR1(0,DICR) 12960015 BAL RR,LOADW LOAD FIRST PHASE 13040015 SPACE 13120015 L LR,PAR1(0,DICR) PICK UP LOAD POINT 13200015 LA LR,2(0,LR) BUMP OVER PHASE ID 13280015 BALR RR,LR ENTER FIRST PHASE 13360015 SPACE 13440015 KILL TM NOCRSW,X'0F' WAS THERE AN I/O ERR ON SYSPRINT AB PTM825 13480001 BO ZEND PTM825 13520001 LA LR,16 SHOW TERMINAL ERROR PTM825 13560001 BC B,HADIT 13600015 SPACE 13680015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 004-TSS 13720020 CHKA SPIE , ALLOW ABENDS ON CALLED COMPLNS 13760015 BC B,ROPA RUN WITH CHK 13840015 * ----------------------------------------------------AA 004-TSS 13880020 EJECT 13920015 * 14000015 * INITIALISAYION LIST. THIS IS USED BY INITIALISER 14080015 * TO REFERENCE LOCATIONS IN THE CONTROL PHASE . IT IS ALSO USED 14160015 * BY OTHER OPTIONAL CONTROL ROUTINES (DUMP AND INTERMEDIATE 14240015 * FILE) 14320015 * 14400015 DS 0D 14480015 ADDLST DC A(0) ALLOCA WILL HOLD SCRATCH CORE 14560015 DC A(0) ALLOCL 14640015 DC A(0) TSLOTS+24 TEXT AND 14720015 DC A(0) DSLOTS+24 DICT ALLOCATION SLOTS 14800015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 022-TSS 14840020 DC A(RDDCB) READ AND PRINT DCB 14880015 DC A(PLDCB) 14960015 * ----------------------------------------------------AA 022-TSS 15000020 DC A(LOADL) MODEL LOAD LIST 15040015 DC A(PD) PHASE DIRECTORY 15120015 DC A(0) HEDING PAGE HEADING 15200015 DC A(0) MAXPAG MAX PAGE COUNT 15280015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 023-TSS 15320020 DC A(SPDCB) ADDRESS OF SPILL DCB 15360015 * ----------------------------------------------------AA 023-TSS 15400020 DC A(DADDR) ADDRESS OF SLOT WITH DICT ADDR. 15440015 ADLF DC A(LFDCB) H229 15520001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 024-TSS 15560020 ADSYP DC A(SYPDCB) H229 15600001 * ----------------------------------------------------AA 024-TSS 15640020 DC A(CHK) ADDRESS OF INSTRUCTION TO DUMP 15680015 DC A(RDADD) ADDR OF SLOT POINTING AT RDDCB 15760015 DC A(TAB1) TRANSLATE TABLE EXTERNAL TO INT 15840015 DC A(TAB3) INTERNAL TO EXTERNAL 15920015 DC A(ERRF14) 16000015 DC A(PLMES+3) 16080015 DC A(0) PAGNO PAGE NUMBER 16160015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 020-TSS 16200020 DC A(SCNDLST) LAST HALF 16240015 * ----------------------------------------------------AA 020-TSS 16280020 DC A(DYNSW) SWITCH FOR DYNAMIC 16320015 DC A(0) NUMFRE NUMBER OF FREE TRACKS 16400015 DC A(0) FRSLOT LIST OF FREE TRACKS 16480015 DC A(0) BLKTBL 16560015 DC A(SPILL) 16640015 DC A(0) CONCNT 16720015 SPACE 16800015 KEEP DS F 16880015 DC A(SYSUT3) * A(ALT DDNAME FOR SYSUT3) 60069 16900072 DS 0D 16920015 KTIME DC A(1000000*30*60) 16960015 DC A(0) 17000015 DC A(GENSW) 17040015 DC A(0) BTCHBUF BTCH CD FOR PARM SCAN 17120015 DC A(ERCSV) 17200015 DC A(0) UTIERR ERROR RTN SYSUT1 17280015 DC A(0) ZURDAB SYSIN EOF RTN 17360015 DC A(SYSLIB) * A(ALT DDNAME FOR SYSLIB) 60069 17365072 KTIME2 DS D 20221 17370001 DC A(ATADDR) A(SLOT HOLDING A(IEMAT)). IEMAT 17380001 DC A(INPIH) ADDRESSES OF BRANCHS IN AA IEMAT 17390001 DC A(INRELS) WHICH IEMAT WILL MAKE INTO IEMAT 17400001 DC A(INLOAD) NOPS IF TRACING OR PATCHNG.IEMAT 17410001 DC A(CORSZE) ADDR OF SLOT WITH CORE SIZEH207 17420001 DC A(AEABTSW) H313 17425001 DC A(UT1BLK) ADDR OF SLOT WITH SYSUT1 H319 17430001 * 'LENGTH TO WRITE' H319 17435001 LODLST DC C'AMZZ' LIST TO GET MARKING PHASE 17440015 PICAD DC F'1' EXT.PICA ADDR. INIT EMPTY. 54704 17520021 PMASK DS F 17600015 CORSZE DC F'0' H207 17620001 UT1BLK DC H'0' H319 17626001 AEABTSW DC X'00' AE ABORT SWITCH H313 17632001 * THE FOLLOWING SWITCHES ARE ACCESSED AS OFFSETS H235 17640001 * FROM GENSW BY IEMAB/IEMAK H235 17660001 GENSW DC X'00' 17680015 NOCRSW DC X'F0' ON UNTIL COMM REGION AVAILABLE PTM825 17720001 BUFSW DC X'00' SET ON FOR LARGE SYSPRINT H235 17730001 MESSW DC X'00' SHOWS SYSIN STATUS H235 17740001 ERCSV DC X'00' 17760015 SYSUT3 DC C'SYSUT3 ' * ALT DDNAME SLOT 60069 17780072 SYSLIB DC X'0000000000000000' 60069 17800072 EJECT 17840015 * TRANSLATE TABLES 17920015 * 18000015 * THESE ARE USED TO TRANSLATE EXTERNAL CODES (WHICH MAY 18080015 * VARY EG. EBCDIC,BCD) INTO A FIXED FORMAT INTERNAL CODE. THE 18160015 * REVERSE TABLE IS ALSO INCLUDED. THE TABLE ACTUALLY USED DEPEND 18240015 * S UPON THE OPTION SPECIFIED AT INVOCATION TIME. IF BCD IS 18320015 * SPECIFIED THEN THE BELOW TABLES ARE OVERWRITTEN BY AB. THE BCD 18400015 * TRANSLATION TABLES ARE USED 18480015 * 18560015 * 18640015 * TRANSLATE TABLE EXTERNAL TO INTERNAL 18720015 * 18800015 TAB1 DC XL16'4C4E505C5D5E5FF4616C6E0B0C0D0E0F' 18880015 DC XL16'7C7A7D7EC1C2C3C4C5C61A1B1C1D1E1F' 18960015 DC XL16'7BC7C8C9D1D2D3D4D5D62A2B2C2D2E2F' 19040015 DC XL16'5B31D7D8D9E2E3E4E5E63A3B3C3D3E3F' 19120015 DC XL16'40E7E8E944F0F147F249F3466F43754B' 19200015 DC XL16'4D5152535455565758595A307945EF4F' 19280015 DC XL16'737762636465666768696A414A0A6D60' 19360015 DC XL16'707172F574F676F778F8482010426B7F' 19440015 DC XL16'808182838485868788898A8B8C8D8E8F' 19520015 DC XL16'909192939495969798999A9B9C9D9E9F' 19600015 DC XL16'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF' 19680015 DC XL16'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' 19760015 DC XL16'C0111213141516171819CACBCCCDCECF' 19840015 DC XL16'D0212223242526272829DADBDCDDDEDF' 19920015 DC XL16'E0E13233343536373839EAEBECEDEEF9' 20000015 DC XL16'00010203040506070809FAFBFCFDFEFF' 20080015 EJECT 20160015 * 20240015 * TRANSLATE TABLE INTERNAL TO EXTERNAL 20320015 * 20400015 TAB3 DC XL16'F0F1F2F3F4F5F6F7F8F96D0B0C0D0E0F' 20480015 DC XL16'7CC1C2C3C4C5C6C7C8C91A1B1C1D1E1F' 20560015 DC XL16'7BD1D2D3D4D5D6D7D8D92A2B2C2D2E2F' 20640015 DC XL16'5B31E2E3E4E5E6E7E8E93A3B3C3D3E3F' 20720015 DC XL16'406B7D4D445D4B477A496C4F0050015F' 20800015 DC XL16'025152535455565758595A3003040506' 20880015 DC XL16'6F0862636465666768696A7E096E0A4C' 20960015 DC XL16'70717260744E7661785C11201012137F' 21040015 DC XL16'808182838485868788898A8B8C8D8E8F' 21120015 DC XL16'909192939495969798999A9B9C9D9E9F' 21200015 DC XL16'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF' 21280015 DC XL16'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' 21360015 DC XL16'C0141516171819212223CACBCCCDCECF' 21440015 DC XL16'D0242526272829323334DADBDCDDDEDF' 21520015 DC XL16'E0E13536373839414243EAEBECEDEE5E' 21600015 DC XL16'4546484A0773757779EFFAFBFCFDFEFF' 21680015 EJECT 21840015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 005-TSS 21880020 SAVAR DS 18F SAVE AREA FOR NEXT LEVEL ROUTINE 21920015 FSTSAV DS 18F 22000015 * ----------------------------------------------------AA 005-TSS 22040020 DICTEM DC F'0' 22080015 TEMP DS F 22160015 TEMP4 DS F 22240015 SAVPAR DS F 22320015 ZEROS DC XL4'00' PERMANENT ZEROS LOCATION 22400015 COUNT DC X'00' 22480015 LOADAG DC X'00' 22560015 CVNAM DC C'CV' 22640015 XANAM DC C'XA' 22720015 BMNAM DC C'BM' 22800015 ASNAM DC C'AS' 22880015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 030-TSS 22900020 * ----------------------------------------------------AA 030-TSS 22920020 ABMESDC DC X'0014' 22960015 DC C'-' 23040015 DC C'IEM3855I ERROR IN ' 23120015 ABMSDC1 DC C'XY' 23200015 EJECT 23280015 * LOAD ROUTINES 23360015 * THESE ROUTINES WILL LOAD PHASES AND PASS CONTRL 23440015 * TO A NEW PHASE IF NECESSARY. INTERFACES WITH OPERATING SYSTEM 23520015 * ARE LOAD AND DELETE. 23600015 * THE VARIOUS ENTRY POINTS ARE 23680015 * 1)RELESE. THIS WILL DELETE PHASES CONTAINED IN A PHASE 23760015 * NAME LIST. THE NAME IS BUILT UP TO ITS FULL VALUE 'IEMXY ' 23840015 * AND THE THE DELETE MACRO IS ISSUED. THIS OPERATION IS PERFORMD 23920015 * FIRST IF RLSCTL IS ENTERED 24000015 * 2)RLSCTL. THIS WILL PERFORM A RELEASE AS DESCRIBED ABOVE 24080015 * AND THEN PASS CONTROL TO THE PHASE POINTED AT BY PAR2. IF PAR2 24160015 * IS ZERO THEN THE PHASE DIRECTORY IS SCANNED FOR THE NEXT 24240015 * WANTED PHASE. THIS IS LOADED AND ENTERED 24320015 * 3)LOADX. THIS IS A SPECIAL TYPE OF LOADW ENTRY.IT ALLOWS 24400015 * PHASES TO BE LOADED SEVERAL TIMES. THE ONLY DIFFERENCE FROM 24480015 * LOADW IS THAT THE RELATIVE TRACK ADDRESS IN THE DIRECTORY IS 24560015 * NOT OVERWRITTEN WITH THE LOAD ADDRESS. 24640015 * 4)LOADW. AN ENTRY WHICH CAUSES A NAMED PHASE TO BE LOADED. 24720015 * THE ADDRESS OF THE LOAD POINT IS PLACED IN PAR1. CONTROL IS 24800015 * RETURNED TO THE CALLER. 24880015 * 5)REQEST. AN ENTRY WHICH ALLOWS PHASES TO BE MARKED AS 24960015 * WANTED AND NOT WANTED. PAR1 POINTS AT A LIST OF WANTED PHASES, 25040015 * PAR2 POINTS TO A LIST OF UNWANTED PHASES. 25120015 * 6)RLSCTLX. THIS IS A SPECIAL FORM OF RLSCTL.IT ALLOWS 25140001 * PHASES TO BE LOADED SEVERAL TIMES.THE RELATIVE TRK ADDR 25160001 * IN THE PHASE DIRECTORY IS NOT OVERWRITTEN WITH THE LOAD ADDR. 25180001 * 25200015 * PHASE LISTS CONSIST OF 2 BYTE PHASE NAMES (IE THE XY OF 25280015 * IEMXY). THE LAST NAME IN THE LIST IS ZZ WHICH ACTS AS A STOPPR 25360015 * 00 CHARACTERS ARE TREATED AS A NULL ENTRY AND ARE IGNORED. THE 25440015 * LISTS ARE POINTED AT BY PAR1 OR PAR2 DEPENDING UPON ENTRY 25520015 * POINT 25600015 * 25680015 * A DESCRIPTION OF THE STATUS BYTE IN THE PHASE DIRECTORY 25760015 * WOULD BE INSTRUCTIVE AT THIS POINT. IT IS INITIALLY ZERO 25840015 * BIT 1 1 MEANS PHASE REQUESTED 0 NOT REQUESTED 25920015 * 2 1 LOADED 26000015 * 3 1 LOADING 26080015 * 4 1 ACTIVATED (EITHER ENTERED DIRECTLY 26160015 * OR BY A LOADW) 26240015 * 5 1 DELETED 26320015 * 6 1 DUMP CAN TAKE PLACE ON THIS PHASE 26400015 * 7 1 PHASE NOT WANTED 26480015 * 8 1 DUMP REQUIRED AT END OF PHASE 26560015 * THE MOST COMMON STATES OF THE BYTE ARE THUS 26640015 * X'80' REQUESTED,NOT LOADED 26720015 * X'02' NOT WANTED 26800015 * X'A0' LOADING- IF THIS APPEARS IN A DUMP WITH A LOAD 26880015 * ABEND THEN IT IS AN ERROR THAT OCCURRED WHILE TRYNG 26960015 * TO LOAD THIS PHASE. CHECK THE COMPILER LIBRARY FOR 27040015 * ITS PRESENCE 27120015 * X'F4' LOADED AND ACTIVATED 27200015 * X'FC' DELETED 27280015 * 27360015 * SEE PHASE IEMAB FOR A DESCRIPTION OF THE PHASE DIRECTORY 27440015 * BRIEFLY EACH ENTRY IS 12 BYTES LONG. PHASE NAME BYTES 1-2, 27520015 * STATUS BYTE 3 27600015 * 27680015 * UPON ENTRY TO THE ROUTINE A CHECK IS MADE TO SEE IF A 27760015 * DUMP REQUEST HAS BEEN MADE. IF YES AND IT IS A RLSCTL ENTRY 27840015 * THEN THE DUMPING ROUTINES ARE ENTERED. PHASE IEMAD IS LOADED 27920015 * AND ENTERED. THIS PHASE WILL DUMP THE PARTS OF CORE BEING USED 28000015 * BY THE COMPILER. 28100001 * 28240015 * A SPECIAL CASE EXISTS WHEN THE COMPILER IS RUNNING AT 28320015 * THE MINIMUM DESIGN POINT. READIN AND THE 48-CHARACTER SET WILL 28400015 * USE ONLY 2 TEXT AND 2 DICTIONARY BLOCKS. WHEN READIN TERMINATE 28480015 * THEN THE BLOCKS HAVE TO BE EXPANDED TO 4 OF EACH. SYSIN OR 28560015 * SYSUT3 CAN ALSO BE CLOSED. SYSPUNCH AND SYLIN WILL BE OPENED. 28640015 * ON ANYTHING. IEMAE IS LOADED AND 28720015 * ALL THE ABOVE MENTIONED OPERATIONS ARE PERFORMED BY IEMAE. THE 28800015 * PHASE IEMAE IS LINKED TO IN ORDER TO GET IT INTO LOW CORE AND 28880015 * TRY TO REDUCE FRAGMENTATION OF CORE. IT IS ONLY ENTERED ONCE 28960015 * 29040015 * WHEN A PHASE IS TO BE LOADED, THE ELEMENTS IN THE PHASE 29120015 * DIRECTORY ARE INSERTED INTO A MODEL LOAD LIST. THIS MODEL IS 29200015 * INSERTED IN THE CONTROL PHASE BY AB. IT IS ONE OF THE LOAD 29280015 * LISTS GENERATED BY THE BLDL. A SPECIAL CASE EXISTS WHEN A 29360015 * PHASE HAS MORE THAN ONE TEXT RECORD IN ITS LOAD MODULE. THE 29440015 * RELEVANT BIT IS SET. A DS OR AN ORG AT THE END OF A PHASE CAN 29520015 * CAUSE PROBLEMS AND PREVENT LOADING. IF THE STATUS BYTE IS AT 29600015 * X'A0' AND AN ERROR HAS OCCURRED THE CHECK THE LAST FEW INSTRTN 29680015 * OF THE RELEVANT PHASE FIRST 29760015 SPACE 2 29840015 RELESE MVI COUNT,X'01' COUNT INDICATES ENTRY TYPE. IT 29920015 BC B,LODON MUST BE CONTAIND IN FIRST 4K BLOCK 30160015 RLSCTLX MVI LOADAG,X'FF' SPECIAL ENTRY FOR OVERLAY 30240015 RLSCTL MVI COUNT,X'02' OF CODE. 30320015 BC B,LODON 30560015 LOADX MVI LOADAG,X'FF' SHOW IS SPECIAL LOADW ENTRY 30640015 LOADW MVI COUNT,X'04' 30720015 BC B,LODON 30960015 REQEST MVI COUNT,X'08' 31040015 SPACE 31280015 LODON STM 14,CNTL2,12(DICR) STORE OLD REGS 31330001 LA GRA,SAVAR POINT AT NEW SAVE AREA 31380001 ST DICR,4(0,GRA) CHAIN FORWARDS 31440015 L DICR,DADDR POINT AT TRUE DICTIONARY 31520015 SPACE 31600015 CLI SCNOF(DICR),X'FF' SEE IF INITIALISE AT START OF PD 31680015 BC BE,BRCHZ 31760015 MVI SCNOF(DICR),X'FF' SHOW INIT COMPLET 31840015 L GRA,PAROF(CNTL) POINT AT INIT LIST 31920015 L GRA,PDOF(GRA) HENCE AT PHASE DIRECTORY 32000015 ST GRA,SCNPNT POINT AT START OF PD 32080015 SPACE 32160015 BRCHZ TM COUNT,X'02' TEST FOR A RLSCTL 32240015 BC BZ,NODUMP 32320015 SPACE 32400015 TM CCCODE(DICR),X'80' TEST IF DUMP REQUIRED 32480015 BC BZ,NODUMP 32560015 SPACE 32640015 LA DICR,ABSAV POINT AT FREE SAVE AREA 32720015 ENTERS L LR,ZUST(0,CNTL) PICK UP ADDR OF DUMP ROUTINE 32800015 BALR RR,LR GO TO DUMPING 32880015 L DICR,DADDR POINT AT DICTIONARY 32960015 SPACE 33040015 NODUMP LM GRB,GRC,PAR1(DICR) PICK UP PARMS. 31173 33070021 TM COUNT,X'08' IS IT A REQUEST REQUEST? 31173 33100021 BO TRYREQ YES 31173 33130021 TM COUNT,X'03' IS IT A LOAD REQUEST? 31173 33160021 BZ TRYLDW YES - NO RELEASE 31173 33190021 MVC RELST,0(GRB) COPY RELEASE LIST 31173 33220021 TM COUNT,X'01' WAS THIS A RELESE CALL? 31173 33228021 BO RELSCN YES - NO LOAD LIST. 31173 33236021 LTR GRD,GRC SAVE ORIGINAL ADDR(LOADLIST) 31173 33244021 BZ RELSCN IF ZERO, NO LIST FROM RLSCTL 31173 33252021 MVC LOADLST,0(GRD) COPY LOAD LIST. 31173 33260021 RELSCN EQU * 31173 33268021 LA GRC,RELST POINT AT COPY 31173 33280021 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 006-TSS 33380020 * ----------------------------------------------------AA 006-TSS 33400020 L GRB,PAROF(CNTL) POINT AT INIT LIST 33440015 L GRB,PDOF(GRB) HENCE AT PHASE DIRECTORY 33520015 SPACE 33600015 SEZD CLC 0(2,GRC),ZEDS 33680015 BC BE,ENDRLS 33760015 CLC 0(2,GRC),ZCHARS SEE IF SIGNIFICANT ENTRY 33840015 BC BE,RLSAGN 33920015 SPACE 34000015 RLSLOP CLC 0(2,GRC),0(GRB) SEE IF NAME IN LIST IS THE NAME 34080015 BC BE,RLSTHS IN THE PHASE DIRECTORY 34160015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 031-TSS 34200020 LA GRB,12(0,GRB) BUMP TO NEXT IN PHASE DIRECTORY 34240015 * ----------------------------------------------------AA 031-TSS 34280020 CLI 0(GRB),X'00' TEST FOR END OF PHASE DIRECTORY 34320015 BC BNE,RLSLOP 34400015 SPACE 34480015 MVC PAR6+1(3,DICR),ERR9 NAME IN RELEASE LIST NOT IN PD 34560015 LR GRB,GRC SET REGISTERS TO MAKE CORRECT 34640015 BC B,NOTDIR ERROR MESSAGE ENTRY 34720015 SPACE 34800015 RLSTHS OI STAT(GRB),X'FC' MARK AS RELEASED 34880015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 007-TSS 34920020 MVC DELST+3(2),0(GRC) INSERT NAME OF PHASE TO BE 34960015 LA DICR,SAVAR DELETED. POINT AT SAVE AREA 35040015 LA 0,DELST POINT AT DELETE LIST 35120015 SPACE 35200015 DELETE EPLOC=(0) DELETE PHASE AS REQUIRED 35280015 * ----------------------------------------------------AA 007-TSS 35284020 SPACE 1 35288001 INRELS B NOTRACE3 MADE NOP BY AT IF TRACING. IEMAT 35296001 STM 14,15,STORE2 SAVE R14 & R15. IEMAT 35304001 L 15,ATADDR POINT R15 AT IEMAT. IEMAT 35312001 BAL 14,TRACRELS(0,15) LINK TO TRACRELS IN IEMAT. IEMAT 35320001 LM 14,15,STORE2 RESTORE R14 & R15. IEMAT 35328001 NOTRACE3 EQU * IEMAT 35336001 SPACE 1 35344001 SPACE 35360015 L DICR,DADDR POINT AT DICTIONARY AGAIN 35440015 RLSAGN LA GRC,2(0,GRC) BUMP TO NEXT IN RELESE LIST 35520015 BC B,SEZD 35600015 SPACE 35680015 ENDRLS EQU * 35740021 TM COUNT,X'01' TEST FOR RELESE ONLY 31173 35800021 BZ TRYCTL GO TO CONTROL OF INPUT FILES 35860001 B RETRTN RETURN TO CALLER 35960001 SPACE 36080015 EJECT 36400015 * THESE INSTRUCTIONS CONTROL THE ALLOCATIONS OF DCB'S TO 36480015 * THE INTERMEDIATE FILES. DCBS ARE SWITCHED DYNAMICALLY SO THAT 36560015 * THE ZURD ROUTINE NEED HAVE NO KNOWLEDGE OF THE FILE BEING 36640015 * CURRENTLY READ 36720015 SPACE 2 36800015 SPACE 36880015 TRYCTL BC NOP,TRYLOD ***** THIS IS SWITCHED ***** 36960001 * THIS ROUTINE IS ONLY ENTERED FOR RLSCTL AND RLSCTLX 37040001 * AND ONLY WHEN THE INPUT PHASES ARE ACTIVE. 37120001 CLC MYNAM(2,DICR),ASNAM IS IT AS RLSCTLING 37200015 BC BE,LOADAE IF YES LINK TO AE 37280015 CLC MYNAM(2,DICR),CVNAM IS IT CV RLSCTLING 37360015 BC BE,LOADAE IF YES LINK TO AE 37440015 TM CCCODE(DICR),X'40' HAS ABORT OCCURRED 37520015 BC BZ,TRYLOD IF NOT OMIT AE 37600015 CLI MYNAM(DICR),X'C3' IF YES IS IT IN READ IN 37680015 BC BNE,TRYLOD IF NOT OMIT AE 37760015 SPACE 37840015 LOADAE LA DICR,ABSAV LOAD AE 37940001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 008-TSS 38040020 LINK EP=IEMAE LOAD TEXT AND DICTIONARY CONTROL 38160015 * ----------------------------------------------------AA 008-TSS 38200020 L DICR,DADDR POINT AT DICTIONARY AGAIN 33893 38220020 BC B,AEABORT(LR) TEST IF AE WISHES TO ABORT CMPLR 38240015 AEABORT BAL RR,ABORT 38320015 CLC MYNAM(2,DICR),ASNAM 38480015 BC BE,TRYLOD 38560015 MVI TRYCTL+1,X'F0' ***** SET CODE SWITCH TO BYPASS ***** 38640001 BC B,TRYLOD 38720015 EJECT 38800015 * THESE INSTRUCTIONS LOAD THE REQUIRED PHASE. CONTROL IS 38880015 * PASSED TO THE REQUIRED PHASE IF NECESSARY. IT IS ONLY ENTERED 38960015 * BY A LOADW,LOADX(TO TRYLDW);RLSCTL,RLSCTLX(TO TRYLOD) ENTRY. 39040001 SPACE 2 39120015 TRYLOD EQU * 31173 39320021 L GRC,SCNPNT PHASE DIR CURRENT POSITION. 39520001 CLI ZDROLF(DICR),X'FF' SEE IF IN OVERLAY 39720001 BNE NOLIFT 39920001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 032-TSS 40020020 LA GRC,12(0,GRC) 40120001 * ----------------------------------------------------AA 032-TSS 40220020 NOLIFT LTR GRB,GRD PUT PAR2 IN GRB 31173 40300021 BZ NOLOP NO LOAD LIST 31173 40380021 LA GRB,LOADLST POINT AT COPY 31173 40540021 B NAMED 31173 40620021 NOLOP TM STAT(GRC),X'08' SEE IF PHASE HAS BEEN DELETED 40720015 BC BO,PHDEL 40800015 TM STAT(GRC),X'80' SEE IF REQUESTED 40880015 BC BO,LOAD LOAD IT 40960015 TM STAT(GRC),X'02' TEST IF NOT WANTED 41040015 BC BZ,LOAD 41120015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 033-TSS 41160020 PHDEL LA GRC,12(0,GRC) BUMP TO NEXT IN PHASE DIRECTORY 41200015 * ----------------------------------------------------AA 033-TSS 41240020 BC B,NOLOP 41280015 SPACE 41360015 TRYLDW L GRB,PAR1(0,DICR) POINT AT LIST GIVEN BY PAR1 41380001 L GRC,SCNPNT 41400001 NAMED CLC 0(2,GRB),0(GRC) SEE IF IT IS REQUIRED PHASE 41440015 BC BE,LOAD 41520015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 034-TSS 41560020 LA GRC,12(0,GRC) BUMP TO NEXT IN PHASE DIRECTORY 41600015 * ----------------------------------------------------AA 034-TSS 41640020 CLI 0(GRC),X'00' TEST FOR END OF DIRECTORY 41680015 BC BNE,NAMED 41760015 SPACE 41840015 MVC PAR6+1(3,DICR),ERR10 PHASE NOT IN PHASE DIRECTORY 41920015 NOTDIR ST GRB,PAR7(0,DICR) POINT AT NAME OF PHASE 42000015 TM CCCODE+3(DICR),X'10' IF MACRO RUNNING,NAME REQUIRED 42080015 BC BO,NOTR1 IN EBCDIC 42160015 TR 0(2,GRB),TAB1 TRANSLATE TO INTERNAL CODE 42240015 NOTR1 EQU * 42320015 LA GRA,2 42400015 ST GRA,PAR8(0,DICR) SHOW PHASE NAME IS 2 LONG 42480015 BAL RR,DYNAMIC 42560015 SPACE 42640015 LOAD OI STAT(GRC),X'A0' MARK AS REQUESTED AND LOADING 42720015 NI STAT(GRC),X'F3' SET DELETE AND DUMP BITS OFF 42800001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 009-TSS 42840020 * (FOR PHASES LOADED MORE THAN ONCE) 42880015 MVC LOADL+3(2),0(GRC) MOVE IN NAME 42960015 MVC CONCAT(2),CNBR(GRC) MOVE IN CONCAT NUMBER AND LIB ID 43040015 MVC TTRFTR(3),FTR(GRC) MOVE IN TTR OF FIRST TEXT RECORD 43120015 MVC TOTCOR+1(4),CONTIG(GRC) CONTIGUOUS REQUIRED CORE 43200015 NI TOTCOR-2,X'FE' SET TEXT RECOED BIT OFF 43280015 CLC CONTIG(2,GRC),CONTIG+2(GRC) SEE IF ONLY ONE TXET RECORD 43360015 BC BNE,PONTLD 43440015 OI TOTCOR-2,X'01' INDICATE ONLY 1 TEXT RCD. 47664 43520056 SPACE 43600015 PONTLD LA 0,LOADL POINT AT LOAD LIST 43680015 LA DICR,SAVAR POINT AT SAVE AREA 43760015 SPACE 43840015 LOAD DE=(0) LOAD REQUIRED PHASE 43920015 * ----------------------------------------------------AA 009-TSS 43960020 SPACE 44000015 OI STAT(GRC),X'50' MARK AS LOADED AND ACTIVE 44050001 L DICR,DADDR POINT AT D0 AGAIN 44100001 ST 0,PAR1(0,DICR) STORE LOAD ADDR 44150001 SPACE 44200001 INLOAD B NOTRACE4 MADE NOP BY AT IF TRACING. IEMAT 44250001 STM 14,15,STORE2 SAVE R14 & R15. IEMAT 44300001 LA DICR,SAVAR POINT R13 AT SAVE AREA. IEMAT 44350001 L 15,ATADDR POINT R15 AT IEMAT. IEMAT 44400001 BAL 14,TRACLOAD(0,15) LINK TO LOAD IN IEMAT. IEMAT 44450001 L DICR,DADDR POINT R13 AT DICT. AGAIN. IEMAT 44500001 LM 14,15,STORE2 RESTORE R14 & R15. IEMAT 44550001 NOTRACE4 EQU * IEMAT 44600001 SPACE 1 44650001 CLI LOADAG,X'FF' SEE IF OVERLAY ENTRY 44700001 BE NOBUMP 44750001 OI STAT(GRC),X'04' MARK AS DUMPABLE 44800001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 035-TSS 44820020 ST 0,TEMP MOVE ADDR OF PHASE 44850001 MVC FTR(3,GRC),TEMP+1 INTO PHASE DIRECTORY 44900001 * ----------------------------------------------------AA 035-TSS 44930020 CLI ZDROLF(DICR),X'FF' SEE IF OVERLAY WITH RLSCTL IS 44960015 BC BE,NOBUMP REQUIRED 45040015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 036-TSS 45080020 LA GRC,12(0,GRC) BUMP TO ONE AFTER LAST LOADED 45120015 * ----------------------------------------------------AA 036-TSS 45160020 ST GRC,SCNPNT 45200015 SPACE 45280015 NOBUMP MVI LOADAG,X'00' RESET LOAD TYPE FOR NEXT ENTRY 45360015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 045-TSS 45380020 * ----------------------------------------------------AA 045-TSS 45400020 AIF (NOT &STD).L2 45402021 LA DICR,SAVAR PROVIDE S.A. TO TTIMER. 45404021 .L2 ANOP 45406021 TTIMER 45410046 AIF (NOT &STD).L3 45412021 L DICR,DADDR POINT AT DICT AGAIN. 45414021 .L3 ANOP 45416021 ST 0,ZTIM(0,DICR) SAVE IT FOR PHASE DUMP 45420046 TM COUNT,X'04' TEST FOR A LOADW ENTRY 45440015 BC BO,RETRTN IF SO,BRANCH TO RETURNING ROUTINE 45520015 SPACE 45600015 LM 14,CNTL2,12(DICR) RELOAD REGISTERS 45680015 MVI 12(DICR),X'FF' SHOW RETURN IS COMPLETE 45760015 XC LOCK(2,DICR),LOCK(DICR) CLEAR LOCK SLOT FOR NEXT PHASE 45840015 XC ZSTAT(4,DICR),ZSTAT(DICR) SET STMNT NUMBER TO ZERO 45920015 XC PAR3(4,DICR),PAR3(DICR) CLEAR ANY UNWANTED SECOND HEADRS 46000015 L RR,PAR1(0,DICR) PICK UP RETURN ADDRESS 46080015 LA RR,2(0,RR) BUMP TO GIVE STANDARD ENTRY PONT 46160015 BCR BR,RR 46240015 EJECT 46320015 * THESE INSTRUCTIONS MARK PHASES AS REQUESTED. PHASES MUST 46400015 * BE REQUESTED IN THE ORDER THAT THEY APPEAR IN THE PHASE 46480015 * DIRECTORY. 46560015 SPACE 2 46640015 TRYREQ MVI SWACH+1,X'00' MAKE SWITCH ON, EFFECTIVELY 46720015 MVI RQSWCH,X'00' SHOW IS SCANNING FIRST LIST 46800015 MVI SET+1,X'80' SET TO MARK PHASES AS REQUESTED 46880015 L GRB,PAR1(0,DICR) PICK UP START OF REQUEST LIST 46960015 MVC SAVPAR(4),PAR2(DICR) SAVE PAR2 FOR ENTRY TO ZUERR 47040015 SPACE 47120015 REQLOP CLC 0(2,GRB),ZEDS IS IT END OF LIST 47200015 BC BE,SWACH 47280015 CLC 0(2,GRB),ZCHARS IGNORE THIS ENTRY 47360015 BC BE,JUMP 47440015 SPACE 47520015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 042-TSS 47560020 CLI RQSWCH,X'00' SEE IF IT IS IN SECOND LIST 47600015 BC BNE,SECSCAN 47680015 * ----------------------------------------------------AA 042-TSS 47720020 SPACE 47760015 OFFAGN L GRA,SCNPNT INIT SCAN AT LAST ENTERED 47840015 SPACE 47920015 RQLOP1 CLC 0(2,GRB),0(GRA) NAME IN PHASE DIRECTORY 48000015 BC BE,SET 48080015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 037-TSS 48120020 LA GRA,12(0,GRA) BUMP TO NEXT IN PHASE DIRECTORY 48160015 * ----------------------------------------------------AA 037-TSS 48200020 CLI 0(GRA),X'00' TEST IF END OF PHASE DIRECTORY 48240015 BC BNE,RQLOP1 48320015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 038-TSS 48360020 SPACE 48400015 SECSCAN L GRA,SCOF+ADDLST 48480015 MVI RQSWCH,X'FF' 48560015 SPACE 48640015 RQLOP2 CLC 0(2,GRB),0(GRA) SEE IF REQUESTED OR NOT WANTED 48720015 BC BE,SET PHASE IS IN SECOND LIST 48800015 LA GRA,3(0,GRA) BUMP TO NEXT IN SECOND LIST 48880015 CLI 0(GRA),X'00' SEE IF IT IS END OF LIST 48960015 BC BNE,RQLOP2 49040015 * ----------------------------------------------------AA 038-TSS 49080020 SPACE 49120015 MVC PAR6+1(3,DICR),ERR12 PHASE NOT IN DIRECTORY 49200015 LA GRC,0(0,GRB) POINT AT NAME OF PHASE 49280015 ST GRC,PAR7(0,DICR) 49360015 LA GRA,2 FIX LENGTH OF NAME 49760015 ST GRA,PAR8(0,DICR) 49840015 BAL RR,DYNAMIC TERMINATE COMPILATION 50240021 SPACE 50720015 SET OI 2(GRA),X'00' MARK PHASE AS REQUESTED OR NOT 50800015 JUMP LA GRB,2(0,GRB) WANTED. BUMP TO NEXT IN LIST 50880015 BC B,REQLOP 50960015 SPACE 51040015 SWACH BC NOP,RETRTN ON 2ND TIME THRU',BRANCH TO RETURN ROUTINE 51120015 MVI SWACH+1,X'F0' 51200015 MVI SET+1,X'02' SET TO MARK AS NOT WANTED 51280015 MVI RQSWCH,X'00' POINT AT FIRST LIST AGAIN 51360015 L GRB,SAVPAR POINT AT NOT-WANT LIST 51440015 BC B,REQLOP 51520015 EJECT 51600015 ONE DC X'001F' * CARD COUNT INCREMENT 57455 51680072 * ROUTINES ZULF AND ZUSP 51840015 * THESE ROUTINES PRODUCE CARD IMAGES OF THE 51920015 * COMPILED OBJECT DECK. THE DDNAMES OF THE FILES ARE SYSPUNCH 52000015 * AND SYSLIN. LOCATION COUNT MUST APPEAR IN THE FIRST 4K OF CODE 52080015 * IF PERMANENT I/O ERROR OCCURS ON THE RELEVANT FILE THEN 52160015 * A MESSAGE IS INSERTED IN THE DICTIONARY AND THE OPTION BIT SET 52240015 * TO NOLOAD OR NODECK. THE I/O IS THEN BYPASSED ON THE NEXT 52320015 * ENTRY. 52400015 * THE OUTPUT RECORDS ARE NUMBERED SEQUENTIALLY AND NAMED 52480015 * WITH THE FIRST EXTERNAL PROCEDURE NAME. THIS WILL BE FOUND IN 52560015 * ZPRNAM IN THE COMMUNICATIONS REGION OF THE DICTIONARY 52640015 SPACE 2 52720015 ZULF EQU * 52800072 STM 14,CNTL2,12(DICR) * SAVE CALLERS REGS 57455 52840072 L GRA,ADLF * POINT GRA AT SYSLIN 57455 52880072 B ZULFSP 57455 52920072 SPACE 1 52960072 ZUSP EQU * 53000072 STM 14,CNTL2,12(DICR) * SAVE CALLERS REGS 57455 53040072 L GRA,ADSYP * POINT GRA AT SYSPUNCH 57455 53080072 SPACE 1 53120072 ZULFSP LA GRB,SAVAR * POINT AT NEW SAVE AREA 57455 53160072 ST DICR,4(0,GRB) CHAIN FORWARDS 53200015 ST GRB,8(0,DICR) CHAIN BACKWARDS 53280015 PUTLS LR DICR,GRB 54400015 PUT (1) FIND BUFFER SPACE 54480015 SPACE 54560015 OUTBCK L DICR,DADDR POINT AT DICT AGAIN 54640015 L GRB,PAR1(0,DICR) PICK UP ADDRESS OF OUTPUT AREA 54720015 TM CCCODE+3(DICR),X'10' * IS THIS A MACDCK CALL 57455 54740072 BO MCD * YES, EXIT 57455 54770072 MVC 0(76,GRA),0(GRB) INSERT TEXT 54800015 TM CCCODE(DICR),X'18' SEE IF BOTH LOAD AND PUNCH 54880015 LFBR BC NOP,NOADD * FLIPPED BY NOADD 57455 54960072 AP CARNO(3),ONE(2) * INCREMENT THE CARD COUNT 57455 55050072 NOADD XI LFBR+1,X'80' * NOP -> BZ ; BZ -> NOP 57455 55140072 UNPK 75(5,GRA),CARNO(3) * INSERT SEQUENCE 57455 55230072 OI 79(GRA),X'F0' * NUMBER AND IDENTIFICATION 7455 55320072 MVC 72(4,GRA),ZPRNAM(DICR) * INTO CARD I/O AREA 57455 55410072 SPACE 55600015 NOFLE L DICR,DADDR POINT AT DICTIONARY 55680015 BC B,RETRTN BRANCH TO 'RETURN TO CALLER' ROUTINE 55760015 SPACE 55840015 MCD MVC 0(80,GRA),0(GRB) * CARD TO I/O BUFFER 57455 55920072 B NOFLE * PICK UP COMMON EXIT CODE 57455 56000072 EJECT 56080015 * THESE INSTRUCTIONS DEAL WITH THE I/O ERRORS AS THEY 56160015 * OCCUR. THE ERRORS ARE DEALT WITH AS FOLLOWS 56240015 * 1)SYSPLIN. THE ERROR RECORD IS PRINTED OUT ON SYSPRINT 56320015 * AND A MESSAGE IS INSERTED INTO THE DICTIONARY. THE RECORD IS 56400015 * ACCEPTED. 56480015 * 2)SYSLIN. ERROR MESSAGE INSERTED IN DICTIONARY AND 56560015 * GENERATION OF LOAD FILE IS TERMINATED. COMPILATION CONTINUES 56640015 * 3)SYSPRINT. A WTO IS PERFORMED AND THE COMPILATION IS 56720015 * TERMINATED WITH TERMINAL ERROR CODE 56800015 * 4)SYSPUNCH.ERROR MESSAGE INSERTED IN DICTIONARY. 56880015 * GENERATION OF PUNCHED DECK IS TERMINATED 56960015 * 5)SYSUT1. MESSAGE APPEARS ON SYSPRINT. THE ERROR HANDLNG 57040015 * TAKES PLACE IN THE SPILL MECHANISM. THE ERROR CAN APPEAR BOTH 57120015 * FROM BSAM(WRITE) AND XDAP(READ,WRITE) 57200015 * 6)SYSUT3. OPERATION DEPENDS UPON WHETHER INPUT OR OUTPUT 57280015 * ERROR. OUTPUT- CAUSES PRINT OF MESSAGE AND COMPILER TERMIATED. 57360015 * INPUT-RECORD IS PRINTED OUT AND MESSAGE INSERTED INTO DICT. 57440015 * BLOCK IS ACCEPTED. 57520015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 010-TSS 57560020 SPACE 2 57600015 LFERRX STM RR,10,LASSAV SAVE ALL REGISTERS 57680015 L DICR,DADDR POINT AT DICTIONARY 57760015 MVI IOERSW(DICR),X'FF' SHOW I/O ERROR 57840015 MVC PAR6+1(3,DICR),ERRF15 INSERT MSG NUMBER H64 57920016 OI CCCODE(DICR),X'10' SHOW LOAD FILE NO LONGER RQD 58000015 ENTERR LA DICR,ABSAV POINT AT NEW SAVE AREA 58080015 L LR,ZUEROF(CNTL) 58160015 BALR RR,LR BRANCH TO ZUERR 58240015 LM RR,10,LASSAV RESTORE ALL REGISTERS 58320015 B NOFLE * PICK UP COMMON EXIT CODE 57455 58400072 SPACE 58480015 SPERRX STM RR,10,LASSAV SAVE ALL REGISTERS 58560015 L DICR,DADDR 58640015 MVI IOERSW(DICR),X'FF' SHOW I/O ERROR 58720015 MVC PAR6+1(3,DICR),ERRF17 SHOW ERROR ON PUNCH 58800015 OI CCCODE(DICR),X'08' SYSPUNCH CANNOT CONTINUE 58880015 OI CCCODE+3(DICR),X'40' * SET OFF MACDCK OPTION 57455 58920072 BC B,ENTERR 58960015 EJECT 59040001 PLERRX SYNADAF ACSMETH=QSAM GET A SAVE AREA FOR WTO PTM825 59060001 LR GRC,GRA SAVE GRA UNTIL WTO FINISH H229 59065001 MVC 8(16,GRC),M3862A SET UP IEM3862I MESSAGE H229 59070001 MVC 24(56,GRC),49(GRC) & ERROR TYPE H229 59075001 MVC 6(2,GRC),MCSFLGS PICK UP MCS FLAGS H229 59080001 MVC 80(4,GRC),DESCRTCD & DESCRIPTOR & ROUTING CODESH229 59085001 LA GRA,76 SET LENGTH OF LIST H229 59090001 STH GRA,4(GRC) H229 59095001 LA GRA,4(GRC) POINT AT LIST H229 59100001 WTO ,MF=(E,(1)) ISSUE MESSAGE H229 59105001 MVC 17(5,GRC),M3862B SET UP REST OF MESSAGE H229 59110001 MVC 22(23,GRC),105(GRC) H229 59115001 MVC 45(4,GRC),DESCRTCD & DESCRIPTOR & ROUTING CODESH229 59120001 LA GRA,41 SET LENGTH OF LIST H229 59125001 STH GRA,4(GRC) H229 59130001 LA GRA,4(GRC) POINT AT LIST H229 59135001 WTO ,MF=(E,(1)) ISSUE MESSAGE H229 59140001 LR GRA,GRC RESTORE MSG POINTER H229 59145001 SYNADRLS PTM825 59160001 L DICR,DADDR 59200015 MVI IOERSW(DICR),X'FF' SHOW I/O ERROR 59280015 LA GR0,16 59360015 ST GR0,ERCODE(0,DICR) SHOW TERMINAL 59440015 MVI PERRSW(DICR),X'FF' APPLY SWITCH FOR USE IN IEMAK 59520015 BC B,ZEND 59600015 * ----------------------------------------------------AA 010-TSS 59640020 * 59680015 * THIS IS THE SYNAD TAKEN BY THE INPUT DCB. THE RECORD IN 59760015 * THE BUFFER IS ACCEPTED AND IS PRINTED OUT PRECEEDED BY A 59840015 * MESSAGE NUMBER. A RETURN IS THEN MADE TO CONTINUE PROCESSING 59920015 * THE RECORD. A MESSAGE IS INSERTED IN THE DICTIONARY ONCE ONLY 60000015 * 60080015 RDERRX STM RR,13,LASSAV SAVE ALL REGISTERS 60160015 LR GRB,GR0 60240015 L DICR,DADDR POINT AT TRUE DICTIONARY 60320015 LR GRC,GR0 60400015 LA GRC,0(0,GRC) CLEAR TOP BYTE 60480015 SRL GRB,24 THIS GETS REQUIRED OFFSET 60560015 AR GRB,GRC NOW POINT AT CCW 60640015 L GRB,0(0,GRB) POINT AT BUFFER 60720015 MVC PLMESDC(10),0(GRB) PICK UP FIRST 10 CHARS OF BUFFER 60800015 MVC TEMP4(4),PAR1(DICR) 60880015 MVC PAR6+1(3,DICR),ERRF14 ENTER MESSAGE TO DICTIONARY 60960015 LA GRA,PLMES 61040015 ST GRA,PAR1(0,DICR) POINT AT LINE 61120015 LA DICR,ABSAV POINT AT NEW SAVE AREA 61200015 L LR,ZUPLOF(CNTL) 61280015 BALR RR,LR BRANCH TO ZUPL 61360015 JMPBRC BC NOP,JMPE14 61440015 L LR,ZUEROF(CNTL) 61520015 BALR RR,LR BRANCH TO ZUERR 61600015 MVI JMPBRC+1,X'F0' 61680015 JMPE14 L DICR,DADDR 61760015 MVC PAR1(4,DICR),TEMP4 61840015 LM RR,13,LASSAV RESTORE ALL REGISTERS 61920015 BCR BR,RR 62000015 EJECT 62080015 * 62160015 * THIS ROUTINE IS ENTERED WHEN THE CONTROL PHASE ABORTS 62240015 * THE COMPILER. A TEST FOR THE DUMP OPTION IS MADE. IF THE DUMP 62320015 * IS REQUIRED THEN ALL THE REGISTERS AND PAR1 TO PAR8 ARE 62400015 * PRINTED OUT. THE REGISTERS PRINTED ARE THOSE THAT ARE SAVED 62480015 * WHEN THE ENTRY TO THE CONTROL PHASE IS MADE 62560015 * 62640015 DYNAMIC ST RR,DICTEM STORE INCASE RETURN ON RR RQD 62720015 STM 0,15,ABSAV SAVE REGS. BEFORE DYNAMIC 33893 62760020 TM CCCODE(DICR),X'80' SEE IF DUMP RQD 62800015 BC BZ,NABDMP 62880015 MVC SAVAR(32),PAR1(DICR) SAVE ALL PARAMETERS 62960015 MVC LASSAV+56(8),12(DICR) PICK UP REGS 14 AND 15 63040015 MVC LASSAV(44),20(DICR) PICK UP 0 TRHRU 10 63120015 STM 11,13,LASSAV+44 PICK UP 11 12 AND 13 63200015 LA GRA,SAVAR SAVE ADDRESSES OF PARS AND REGS 63280015 LA GRB,LASSAV 63360015 STM GRA,GRB,PAR1(DICR) 63440015 MVI PAR1(DICR),X'03' SAM TYPE 3 DYNAMIC DUMP 63520015 L LR,ZUST(0,CNTL) CALL AD 63600015 BALR RR,LR 63680015 NABDMP L RR,DICTEM 63760015 CLI DYNSW,X'FF' 63840015 BCR BE,RR RETURN TO CALLER 63920015 L LR,ZUEROF(CNTL) 64000015 BALR RR,LR BRANCH TO ZUERR 64080015 LM 0,15,ABSAV RESTORE REGS. AT ENTRY 33893 64120020 BAL RR,ABORT 64160015 EJECT 64240015 * THIS ROUTINE CAUSES THE COMPILER TO TERMINATE 64320015 * ABNORMALLY OWING TO AN IRREDEMABLE ERROR. ALL CURRENTLY LOADED 64400015 * PHASES ARE PLACED IN A RELEASE LIST AND CONTROL IS PASSED TO 64480015 * PHASE XA 64560015 * IF THE DUMP OPTION HAS BEEN SPECIFIED THEN A CHECK IS 64640015 * MADE TO SEE IF THE DUMP ROUTINES HAVE BEEN LOADED. THEY ARE 64720015 * THEN LOADED AND ENTERED. THIS IS MAINLY TO DEAL WITH PROGRAM 64800015 * CHECKS. 64880015 SPACE 2 64960015 * SAVE REGISTERS AND BASE AA 65040015 * 65120015 ZABORT STM 0,15,ABSAV STORE REGS. ON ENTRY 33893 65220020 * 65360015 LA GR0,ABSAV STORE ADDR OF REG SAVE AREA IN 65520015 ST GR0,FSTDIC+8(DICR) AA IN DICT 65600015 XC LOCK(2,DICR),LOCK(DICR) UNLOCK DICT BLOCK 65680015 SPACE 65760015 * TEST FOR FIRST ENTRY TO ABORT ROUTINE 65840015 * 65920015 TM CCCODE(DICR),X'40' HAS ABORT ALREADY OCCURED 66000015 BC BO,ABRTWO YES, BRANCH TO SAY SO 66080015 OI CCCODE(DICR),X'40' NO, SHOW ABORT HAS OCCURED NOW 66160015 SPACE 66240015 * TEST WHETHER DUMP REQUIRED 66320015 * 66400015 TM CCCODE(DICR),X'80' IS DUMP REQUIRED 66480015 BC BZ,ERRPHS NO, GO TO TEST FOR ERROR PHASES 66560015 MVI PAR1(DICR),X'00' YES, SHOW NOT A DYNAMIC DUMP 66640015 LA 13,LASSAV SET UP SAVE AREA FOR AD 33893 66680020 L LR,ZUST(CNTL) LINK TO PHASE AD 66720015 BALR RR,LR 66800015 L DICR,DADDR POINT AT DICTIONARY AGAIN 33893 66840020 SPACE 66880015 * TEST FOR ERROR MESSAGE PHASES IN TROUBLE 66960015 * 67040015 ERRPHS CLI MYNAM(DICR),C'X' IS IT PHASE XA 67120015 BC BNE,TRYBM NO, TRY PHASE BM 67200015 MVC ABMSDC1(2),XANAM YES, SAY SO 67280015 BC B,ABMES BRANCH TO PRINT ERROR MSG 67360015 * 67440015 TRYBM CLC MYNAM(2,DICR),BMNAM IS IT BM 67520015 BC BNE,PHSREL NO, GO TO RELEASE PHASES 67600015 MVC ABMSDC1(2),BMNAM YES, SAY SO 67680015 BC B,ABMES BRANCH TO PRINT ERROR MSG 67760015 SPACE 67840015 * MAKE A LIST OF ALL LOADED PHASES 67920015 * 68000015 PHSREL L GRA,PAROF(CNTL) POINT AT INIT LIST 68080015 L GRA,PDOF(GRA) HENCE AT PHASE DIRECTORY 68160015 LA GRB,RELLST POINT AT RELEASE LIST 68240015 * 68320015 PHSLOP TM 2(GRA),X'08' IS THIS PHASE DELETED 68400015 BC BO,BMPPHS YES, LOOK AT NEXT PHASE 68480015 TM 2(GRA),X'70' NO, IS PHASE LOADED, LOADING, OR 68560015 * ACTIVATED, OR ANY COMBINATION OF 3 68640015 BC BZ,BMPPHS NO, LOOK AT NEXT PHASE 68720015 MVC 0(2,GRB),0(GRA) YES, ADD PHASE TO RELEASE LIST 68800015 LA GRB,2(GRB) BUMP RELEASE LIST POINTER 68880015 * 68960015 BMPPHS LA GRA,12(GRA) POINT AT NEXT PHASE 69040015 CLI 0(GRA),X'00' IS IT END OF DIRECTORY 69120015 BC BNE,PHSLOP NO, GO TO TEST NEXT PHASE 69200015 MVC 0(2,GRB),RELLST+12 PUT IN STOPPER 69240015 SPACE 69280015 * DETERMINE WHICH PHASE CAN CARRY ON, AND PASS CONTROL 69360015 * 69440015 TM CCCODE+3(DICR),X'10' TEST IF MACRO RUNNING 69520015 BC BZ,TRYJZ NO, GO TO TEST FOR SECOND HALF 69600015 LA GRB,BMNAM 69800001 BC B,STMPHS RELEASE CTL TO BM 69820001 SPACE 1 69840001 TRYJZ CLI SECHF(DICR),X'FF' TEST IF 2ND HALF OF COMPILER 69920015 BC BE,LOADXA YES, GO TO RELEASE TO XA 70000015 LA GRB,JZNAM NO, POINT AT JZ 70080015 BC B,STMPHS GO TO RELEASE CONTROL TO JZ 70160015 * 70240015 LOADXA LA GRB,XANAM POINT AT XA 70320015 * 70400015 STMPHS LA GRA,RELLST POINT AT RELEASE LIST 70480015 STM GRA,GRB,PAR1(DICR) STORE PHASE NAMES 70560015 BAL RR,RLSCTL LINK TO RELEASE CONTROL 70640015 SPACE 5 70720015 * ERROR MESSAGES WHEN CONTINUATION IS IMPOSSIBLE 70800015 * 70880015 ABRTWO LA GR0,DUBAB POINT AT MSG FOR DOUBLE ABORT 70960015 BC B,ABPRNT GO TO PRINT MSG 71040015 * 71120015 ABMES LA GR0,ABMESDC POINT AT ERROR IN XA OR BM MSG 71200015 * 71280015 ABPRNT ST GR0,PAR1(DICR) STORE MSG POINTER 71360015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 049-TSS 71400020 L LR,ZUPLOF(CNTL) 71440015 * ----------------------------------------------------AA 049-TSS 71480020 BALR RR,LR BRANCH TO ZUPL 71520015 TM CCCODE(DICR),X'40' DOUBLE ABORT? 33893 71530020 MVI ERCODE+3(DICR),X'10' SET TERMINAL ERROR CODE 71600046 BNO ZEND DEPART IN PEACE 71670046 MVI 0(CNTL),X'FF' SHOW ABEND IS TO OCCUR 71740046 LA GRC,3865 PICK UP ERROR NO. FOR USER CODE 71810046 BC B,ZEND 71920015 SPACE 5 72000015 * CONSTANTS 72080015 * 72160015 RELLST DC C'000000000000ZZ' RELEASE LIST 72240015 JZNAM DC C'JZ' 72320015 * 72400015 DUBAB DC X'0020' 72480015 DC C'-' 72560015 DC C'IEM3865I ERROR IN COMPILER ABORT' 72640015 EJECT 72720015 * ROUTINE ZEND. 72800015 * THIS ROUTINE CAUSES A NORMAL RETURN TO BE MADE 72880015 * TO THE OPERATING SYSTEM. IT SS THE ONLY WAY OF NORMALLY 72960015 * TERMINATING A JOB STEP. THE EEROR COBE IS PLACED IN REGISTER 73040015 * 15. IT IS THIS ERROR CODE WHICH IS USED TO DETERMINE THE 73120015 * ACTION OF THE NEXT JOB STEP. 73200015 * THE TIMER IS READ FOR THE SECOND TIME AND THE TIME OF 73280015 * COMPILATION IS PRINTED IN MINUTES AND HUNDRETHS OF MINUTES. 73360015 SPACE 2 73440015 ZEND LA DICR,FSTSAV IEM00 73520017 * 73600015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 011-TSS 73640020 LINK EP=IEMAK 73680015 * ----------------------------------------------------AA 011-TSS 73720020 L DICR,DADDR 73760015 BC B,BTCHSWT(LR) 73840015 BTCHSWT BC B,NOLINK 73920015 MVI SCNOF(DICR),X'00' RECONSTITUTE INSTRS IN ORDER 74000015 MVI TRYCTL+1,X'00' TO MAKE CODE SERIALLY REUSABLE 74080015 MVC CARNO(3),REINCAR REINIT. CARNO 74160015 L LR,RECON(CNTL) POINT AT RTN WHICH RECONSTS 74240015 BALR RR,LR INSTRNS IN AL 74320015 OI DADDR,X'80' >HOW AB WE ARE BATCH COMPILING 74400015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 025-TSS 74440020 L GRA,4(CNTL) REPOINT ZURD AT SYSIN DCB H229 74480001 * ----------------------------------------------------AA 025-TSS 74520020 ST GRA,RDADD 74560015 L DICR,KEEP POINT AT SAVE AREA AS IF FST NTR 74640015 BC B,BATCH 74720015 * 74800015 NOLINK EQU * 74880015 TM NOCRSW,X'0F' WAS THERE AN I/O ERROR ON SYSPRINT AB H229 74900001 BO NOSPIE YES, ON EXIT FROM AB WE WENT TO KILL RTN H229 74920001 AIF (NOT &STD).L4 74925021 LA DICR,FSTSAV PROVIDE S.A. TO SPIE. 74930021 .L4 ANOP 74935021 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 012-TSS 74940020 L GRA,PICAD LOAD OLD PICA ADDRESS 74960015 * ISSUE A SPIE TO ALLOW OS TO HANDLE PROGRAM INTERRUPTS 75040015 SPIE MF=(E,(GRA)) RESET PICA 75120015 * ----------------------------------------------------AA 012-TSS 75160020 L GRA,PMASK PICK UP ORIGINAL PROGRAM MASK 75200015 SPM GRA RESET PROGRAM MASK 75280015 NOSPIE EQU * H229 75320001 LR LR,RT LOAD RETURN CODE,SAVED IN AK 75360015 HADIT L GRA,KEEP POINT REG13 AT O/S (OR CALLERS) 75440015 L 13,4(0,GRA) SAVE AREA 75520015 L 14,12(0,13) RELOAD ALL REGS EXECPT REG15 75600015 LM 0,12,20(13) 75680015 MVI 12(DICR),X'FF' SHOW RETURN IS COMPLETE 75760015 CHK BCR BR,RR GO TO OS/360 TO END JOB 75840015 EJECT 75920015 ZEDS DC C'ZZ' STOPPER IN NAME LISTS 76000015 ERR9 DC X'0F0980' 76080015 ERR10 DC X'0F0A80' 76160015 ZCHARS DC C'00' 76240015 RQSWCH DC X'00' 76320015 ERR12 DC X'0F1280' 76400015 ERRF15 DC X'0F1500' 76480016 ERRF17 DC X'0F1700' 76560015 LSTRLS DS F 76640015 SCNPNT DS F 76720015 TEMSYN DC F'0' 76800015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 026-TSS 76840020 RDADD DC A(RDDCB) POINTS AT READ DCB 76880015 * ----------------------------------------------------AA 026-TSS 76920020 CNOP 0,4 76960015 STNAME DC C'IEMAD ' 77040015 DELST DC C'IEM ' 77120015 LOADL DC C'IEMXY ' PHASE NAME 77200015 TTRMR DC XL3'00' TTR OF FIRST MEMBER RECORD 77280015 CONCAT DC X'00' CONCAT NUMBER 77360015 LIBID DC X'00' LIBRARY ID 77440015 ALIND DC X'00' ALIAS INDICATOR 77520015 TTRFTR DC XL3'00' TTR OF FIRST TEXT RECORD 77600015 ZEROBT DC X'00' ZERO BYTE 77680015 DC XL3'00' TTR OF NOTE OR SCATTER TABLE 77760015 DC X'00' NUMBER OF ENTRIES IN NOTE LIST 77840015 DC XL2'00' MODULE ATTRIBUTES 77920015 TOTCOR DC XL3'00' TOTAL CONTIGUOUS CORE REQUIRED 78000015 FSTREC DC XL2'00' LENGTH OF FIRST TEXT RECORD 78080015 DC X'00' 78160015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 013-TSS 78200020 ABSAV DS 18F 78240015 LASSAV DS 18F 78320015 * ----------------------------------------------------AA 013-TSS 78360020 DYNSW DC X'00' 78560015 RELST DS CL12 RELEASE LIST 31173 78580020 LOADLST DS CL12 LOAD LIST 31173 78610046 SPACE 78640015 STAT EQU 2 78720015 CNBR EQU 3 78800015 FTR EQU 5 78880015 CONTIG EQU 8 78960015 CARNO DC X'00000F' 79040015 REINCAR DC X'00000F' 79120015 SPACE 79130001 * TABLE USED BY PIH IMPRECISE INTERRUPT ROUTINE I24 79138019 SPACE 79146019 DC X'0B0A0F0E' I24 79154019 DC X'0D0C0908' I24 79162019 DC X'07060504' I24 79170019 ENDTAB EQU *-1 I24 79178019 INTCDE DS C ONE BYTE STORE I24 79186019 EJECT 79200015 SIGCHR DC F'72' SIGNIFICANT CHRS IN FIXED RECORD 79280015 NUMCHR DC F'80' NUMBER OF CHARS. IN FIXED RECORD 79360015 SPILL DC X'00' SPILL SWITCH 79440015 ERRF14 DC X'0F1408' 79520015 PLMES DC X'0013' 79600015 DC C'-' 79680015 DC C'IEM3860I ' 79760015 PLMESDC DC 10C' ' 79840015 M3862A DC C'IEM3862I I/O ERR' H229 79850001 M3862B DC C'CONT-' H229 79860001 MCSFLGS DC B'1000000000000000' MCS FLAGS FOR WTO H229 79870001 DESCRTCD DC B'0000010000000000' WTO DESCRIPTOR CODE (=6) 43462 79880021 DC B'0100000000100000' WTO ROUTING CODES (=2,11) 43462 79890021 EJECT 79920015 * ROUTINE PIH 80000015 * THIS ROUTINE WILL HANDLE ALL PROGRAM INTERRUPTS 80080015 * THAT OCCUR DURING THE RUNNING OF THE COMPILER. THE INTERRUPT 80160015 * TYPE IS CHECKED AGAINST THE MASK IN ARMASK. IF THE MASK 80240015 * INDICATES THAT THE PHASE IS WILLING TO DEAL WITH THIS TYPE OF 80320015 * INTERRUPT THEN CONTROL IS PASSED TO THE ADDRESS IN ARINT. 80400015 * OTHERWISE CONTROL IS PASSED TO ZABORT. REG 1 CONTAINS THE 80480015 * PIE ADDRESS ON ENTRY. 80560015 SPACE 2 80640015 CNOP 0,4 80720015 USING *,15 80800015 PIH STM GRH,RR,STORE1 STORE REGS REQUIRED BY PIH. 80820001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 014-TSS 80826020 * ----------------------------------------------------AA 014-TSS 80832020 INPIH B NOTPRIV MADE NOP BY AT IF TRACING. IEMAT 80840001 CLI 7(1),X'02' IS INTERRUPT PRIVLGD OP.. IEMAT 80860001 BNE NOTPRIV BRANCH IF NOT. IEMAT 80880001 STM 14,15,STORE2 SAVE R14 & R15. IEMAT 80900001 L 15,ATADDR POINT R15 AT IEMAT. IEMAT 80920001 BAL 14,TRACEIT(0,15) LINK TO TRACEIT IN IEMAT. IEMAT 80940001 STORE2 DC 2F'0' HOLDS R14 & R15. IEMAT 80960001 LM 14,15,0(14) RESTORE R14 & R15. IEMAT 80980001 NOTPRIV L DICR,DADDR POINT DICR AT DICTIONARY. IEMAT 81000001 L CNTL,ZTV(0,DICR) PICK UP CONTROL BASE 81040015 BC B,PSFIN 81120015 STORE1 DS 8F I24 81200019 DADDR DC F'0' 81280015 ATADDR DC F'0' LOAD POINT OF IEMAT. IEMAT 81320001 PSFIN BC NOP,0 81360015 DROP 15 81440015 SPACE 81443001 TM 7(1),X'0F' IS IT A PRECISE INTERRUPT I24 81453019 BNZ PREC BRANCH IF SO I24 81463019 SPACE 81473019 * THE FOLLOWING CODE TRANSLATES AN IMPRECISE INTERRUPTION I24 81483019 * CODE (ON MODEL 91 OR 195) INTO THE CORRESPONDING PRECISE I24 81493019 * INTERRUPTION CODE. I24 81503019 SPACE 81513019 LA GRI,ENDTAB POINT AT END OF TABLE I24 81523019 MVC INTCDE(1),6(1) PICK UP 1ST BYTE OF INT CODE I24 81533019 IMPREC1 LA GRH,128 SET TOP BIT IN 4TH BYTE I24 81543019 IMPREC2 EX GRH,TSTINT IS IT THIS INTERRUPT I24 81553019 BO TESTAR BRANCH IF SO I24 81563019 BCTR GRI,0 REDUCE TABLE POINTER I24 81573019 SRA GRH,1 SHIFT THE TEST BIT AND IF 1STI24 81583019 BNZ IMPREC2 BYTE NOT FINI GOTO TEST AGAINI24 81593019 MVC INTCDE(1),7(1) OTHERWISE PICK UP 2ND BYTE I24 81603019 B IMPREC1 AND DO IT ALL AGAIN I24 81613019 SPACE 81623019 TSTINT TM INTCDE,X'00' EXECUTED INSTRUCTION I24 81633019 SPACE 81643019 PREC LA GRI,7(1) POINT AT INT CODE I24 81653019 TESTAR TM 0(GRI),X'08' IS IT ARITH INTERRUPT I24 81663019 BC BO,ARINTX 81680015 SPACE 81760015 PIHABT MVC PAR6+1(3,DICR),ERR16 INSERT INTERRUPT MESSAGE 81840015 MVC PAR5+3(1,DICR),0(GRI) INSERT INTERRUPT TYPE I24 81890019 MVI PAR5+2(DICR),X'00' CLEAR PAR5+2 I24 81940019 LA GRB,MYNAM(DICR) POINT AT PHASE NAME 82000015 ST GRB,PAR7(0,DICR) STORE FOR ERROR MESSAGE 82080015 TR 0(2,GRB),TAB1 TRANSLATE TO INTERNAL 82160015 LA GRH,2 82240015 ST GRH,PAR8(0,DICR) SHOW NAME TWO BYTES LONG 82320015 LA DICR,ABSAV PSW. POINT AT NEW SAVE AREA 82400015 L CNTL3,ZUEROF(CNTL) 82480015 BALR RR,CNTL3 BRANCH TO ZUERR 82560015 L DICR,DADDR 82640015 TR 0(2,GRB),TAB3 TRANSLATE BACK TO EXTERNAL 82720015 OI CCCODE+2(DICR),X'02' SHOW PROGRAM CHECK HAS OCCURRED 82800015 MVC FSTDIC(8,DICR),4(1) STORE INTERRUPT ADDRESS 82880015 MVC 9(3,1),ABOTOF+1(11) INSERT OF ABORT ROUTINE 82960015 LM GRH,RR,STORE1 RELOAD REGISTERS 83040015 USING PIH,15 83120015 L DICR,DADDR LOAD DICR TO POINT AT DICTIONARY 83200015 DROP 15 83280015 L CNTL,ZTV(0,DICR) LOAD UP CONTROL BASE 83360015 BCR BR,RR BRANCH TO ABORT VIA OS 360 83440015 SPACE 83520015 ARINTX LA GRH,128 INSERT 1 IN LH BIT OF RH BYTE 83600015 MVC SHIFTI+3(1),0(GRI) PICK UP ERROR INDICATOR I24 83680019 NI SHIFTI+3,X'07' PSW IN PIE 83760015 SHIFTI SRL GRH,0 SHIFT TO BE LIKE ARMASK 83840015 STC GRH,PIHTST+1 STORE FOR COMPARISON WITH ARMASK 83920015 PIHTST TM ARMASK(DICR),X'00' SEE IF INTERRUPT IS ONE THAT CAN 84000015 BC BZ,PIHABT BE DEALT WITH 84080015 SPACE 84160015 CLC ARINT(4,DICR),ZEROS TEST IF THERE IS A LIKELY ADDRSS 84240015 BC BE,PIHABT FOR INTERRUPT HANDLER 84320015 SPACE 84400015 L 15,ARINT(0,DICR) PICK UP ADDRESS OF PHASE PIH 84480015 LM GRH,RR,STORE1 RELOAD REGISTERS 84560015 BCR BR,15 PASS CONTROL TO PHASE 84640015 ERR16 DC X'0F10E0' 84720015 EJECT 84800015 * THIS ROUTINE RETURNS TO THE CALLER * * * * * ** * * * * 84880015 RETRTN LM 14,10,12(DICR) RELOAD REGISTERS 84960015 MVI 12(DICR),X'FF' SHOW RETURN IS COMPLETE 85040015 BCR BR,RR RETURN TO CALLER 85120015 EJECT 85200015 * 85280015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 046-TSS 85320020 * SYSUT1 ERROR EXIT ROUTINE 85360015 * 85440015 UTIERA LA LR,ADDLST 85520015 L LR,UTOF(LR) POINT AT ERROR ROUTINE IN AL 85600015 BCR BR,LR 85680015 * ----------------------------------------------------AA 046-TSS 85720020 * 85760015 * SYSIN EOF ROUTINE 85840015 * 85920015 ENDCD LA LR,ADDLST 86000015 L LR,ZUROF(LR) POINT AT EOF RTN IN AL 86080015 BCR BR,LR 86160015 EJECT 86240015 * DCB MACRO DESCRIPTION FOR SPILL FILE 86320015 * 86400015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 019-TSS 86440020 SPDCB DCB DSORG=PS, C86480015 MACRF=(WP), C86560015 DDNAME=SYSUT1, C86640015 DEVD=DA, C86720015 OPTCD=W, C86800015 RECFM=U, C86880015 SYNAD=UTIERA, C86960015 NCP=1 87040015 * ----------------------------------------------------AA 019-TSS 87080020 EJECT 87120015 * 87200015 * SYSIN DCB. 87280015 * 87360015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 015-TSS 87400020 RDDCB DCB DSORG=PS, C87440015 MACRF=(GM), C87520015 DDNAME=SYSIN, C87600015 SYNAD=RDERRX, C87680015 EODAD=ENDCD, C87760015 EROPT=ACC 87840015 * ----------------------------------------------------AA 015-TSS 87880020 EJECT 87920015 * 88000015 * LOAD FILE DCB 88080015 * 88160015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 018-TSS 88200020 LFDCB DCB DSORG=PS, C88240015 MACRF=(PL), C88320015 DDNAME=SYSLIN, C88400015 RECFM=FB, C88480015 LRECL=80, C88560015 SYNAD=LFERRX, C88640015 EROPT=SKP 88720015 * ----------------------------------------------------AA 018-TSS 88760020 EJECT 88800015 * 88880015 * SYSPUNCH DCB 88960015 * 89040015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 016-TSS 89080020 SYPDCB DCB DSORG=PS, C89120015 MACRF=(PL), C89200015 DDNAME=SYSPUNCH, C89280015 RECFM=FB, C89360015 LRECL=80, C89440015 SYNAD=SPERRX, C89520015 EROPT=SKP 89600015 * ----------------------------------------------------AA 016-TSS 89640020 EJECT 89680015 * 89760015 * SYSPRINT DCB 89840015 * 89920015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 017-TSS 89960020 PLDCB DCB DSORG=PS, C90000015 MACRF=(PL), C90080015 DDNAME=SYSPRINT, C90160015 RECFM=VBA, C90240015 LRECL=125, C90320015 SYNAD=PLERRX, C90400015 EROPT=SKP 90480015 * ----------------------------------------------------AA 017-TSS 90520020 EJECT 90560015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 040-TSS 90680020 PD DS 1476C 123 ENTRIES OF 12 BYTES 90720001 SCNDLST DS 360C 120 ENTRIES OF 3 BYTES 90800001 DCBD DSORG=(BS),DEVD=DA 90880015 EJECT 90960015 * 91040015 * REGISTER EQUATES 91120015 * ----------------------------------------------------AA 040-TSS 91160020 * 91200015 GR0 EQU 0 91280015 GR1 EQU 1 91360015 GR5 EQU 5 91440015 GRA EQU 1 91520015 GRB EQU 2 91600015 GRC EQU 3 91680015 GRD EQU 4 91760015 GRE EQU 5 91840015 GRF EQU 6 - H229 91860001 GRH EQU 7 21158 91890001 GRI EQU 8 21158 91940001 CNTL EQU 11 92000015 CNTL2 EQU 10 92080015 RR EQU 14 92160015 CNTL3 EQU 9 92240015 RT EQU 12 92320015 DICR EQU 13 92400015 LR EQU 15 92480015 * 92560015 * BRANCH EQUATES 92640015 * 92720015 NOP EQU 0 92800015 B EQU 15 92880015 BR EQU 15 92960015 BH EQU 2 93040015 BL EQU 4 93120015 BNL EQU 11 93200015 BE EQU 8 93280015 BNE EQU 7 93360015 BNZ EQU 7 93440015 BNH EQU 13 93520015 BO EQU 1 93600015 BZ EQU 8 93680015 BM EQU 4 93760015 BNO EQU 14 93800015 * COMMUNICATIONS REGION EQUATES 93840015 * 93920015 * 94000015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AA 041-TSS 94020020 * ----------------------------------------------------AA 041-TSS 94040020 ABORT EQU ZABORT 94080015 TLR EQU 240 94160015 ZTV EQU 64 94240015 ZTRAN1 EQU 68 94320015 ZTRAN2 EQU ZTRAN1+4 94400015 ZNXTD EQU 76 94480015 ZSTAT EQU 124 94560015 PAR1 EQU 128 94640015 PAR2 EQU PAR1+4 94720015 PAR3 EQU PAR2+4 94800015 PAR4 EQU PAR3+4 94880015 PAR5 EQU PAR4+4 94960015 PAR6 EQU PAR5+4 95040015 PAR7 EQU PAR6+4 95120015 PAR8 EQU PAR7+4 95200015 MYNAM EQU 112 95280015 FSTDIC EQU 160 95360015 TERMSW EQU 176 95440015 PARMLEN EQU 197 95520015 IOERSW EQU 191 95600015 SPLNAM EQU 180 95680015 SCNOF EQU 184 95760015 SECHF EQU 185 95840015 ZDROLF EQU 186 95920015 DICTSP EQU 200 96000015 ZNXTOF EQU 204 96080015 FONOF EQU 208 96160015 CCCODE EQU 232 96240015 ABOTOF EQU X'20' 96320015 ZUST EQU X'4C' 96400015 ARINT EQU 248 96480015 ERCODE EQU 224 96560015 ARMASK EQU 273 96640015 DICTSZ EQU 260 96720015 TXTSZ EQU 264 96800015 ZMASK EQU 284 96880015 LOCK EQU 274 96960015 ZSHIFT EQU 280 97040015 CORLFT EQU 160 97120015 ZMASK1 EQU 286 97200015 ZPRNAM EQU 288 97280015 ZDNXT EQU 96 97360015 PERRSW EQU 189 97440015 SCOF EQU 84 97520015 PAROF EQU 28 97600015 PDOF EQU 28 97680015 RECON EQU 132 97760015 ZUEROF EQU 48 97840015 ZUPLOF EQU 8 97920015 UTOF EQU 140 98000015 ZUROF EQU 144 98080015 * 98160015 * THIS EQUATE IS FOR THE FIRST CARD READ BY THE INITIALISR 98240015 * 98320015 READSL EQU 500 98400015 ZTIM EQU X'2FC' START OF PHASE TIME Z2151 98405046 SPACE 1 98410001 TRACLOAD EQU 4 OFFSETS OF IEMAT 98420001 TRACRELS EQU 8 ENTRY POINTS IEMAT 98430001 TRACEIT EQU 12 IN IEMAT. IEMAT 98440001 END IEMAA 98480015 ./ ADD SSI=22010241,NAME=IEMAB,SOURCE=0 AB TITLE 'IEMAB,INITIALISING PHASE,COMPILER CONTROL,OS/360 PL/I CC00020015 OMPILER(F)' 00040015 * 00040856 * 00041656 * 00042472 * 5.5 C 052460,538250 MCB 62615 00042572 * 5.5 C 089625,089645-089780,089800,534155 KT 62596 00042672 * 5.5 D 532790,532950,533230,533310,533550,533430,533750, KT 62596 00042772 * 5.5 D 534240,534280,534310-534320,534390,534480, KT 62596 00042872 * 5.5 D 534690-534760,543900,535440,537370,537810,767927 KT 62596 00042972 * 5.5 D 767928 KT 62596 00043072 * 5.5 A 786000 KT 60069 00043172 * 5.5 C 085400,102600,291800,300600-300800,303000-303200 KT 60069 00043272 * 5.5 D 537490,537570 KT 60069 00043372 * 5.5 A 021988,022000,050380 KT 57480 00043472 * 5.4 C 089615 TRACK-OVERFLOW SUPPORT REMOVED MCB 54799 00044021 * D 089620,089740-089745,089765-089770 MCB 54799 00044821 * 00045656 * 5.4 A 011500,208260. PEP 54703 00046421 * C 058800,087000-087200. PEP 54703 00047321 * 00048221 * 5.3B A 056700. (MINIMUM CHANGE FOR CRS 52141 00049121 * C 057200. GETMAIN COMPATIBILITY)CRS 52141 00050021 * 00050921 * 5.3A C 021380,245100. ( MCS ) PG/CRS 43462 00051821 * 00052721 * 5.2C C 689200-703000. (SEE A38238) JLC Z2154 00053621 * 00054521 * 5.2B C 723000. KT/JLC Z2102 00055421 * 00056321 * 5.2 A 329200,537600. JRT 30333 00057221 * C 328600,537330. JRT 30333 00058121 * 00059021 * 5.1 A 089750,532910,767920. JRT H419 00059921 * C 089670,089680. JRT H419 00060821 * 5.1 A 398400. JRT 27136 00061721 * 5.1 A 083400,532150,535530,539540,752800. JRT I25 00062621 * C 156600,157460,609960,673162. JRT I25 00063521 * 5.1 C 145400,535520,607000-607200,608600-608800. JRT I24 00064421 * 5.1 C 158600-158603. JRT H350 00065321 * 5.1 C 722000. JRT 25838 00066221 * 5.1 C 450200,537100-537300. JRT H334 00067121 * 5.1 A 437000. JRT H321 00068021 * 5.1 A 051000,051060. JRT 25855 00068921 * C 049950-049956. JRT 25855 00069821 * 5.1 A 399200. JRT 25846 00070721 * D 355200. JRT 25846 00071621 * 00072521 * 5.0 A 378600,406400. JRT H320 00073421 * 5.0 A 089600,534150,786550. JRT H319 00074321 * C 091200-091400,092400. JRT H319 00075221 * D 091800. JRT H319 00076121 * 5.0 A 444400,537550,537790. H278 00077021 * C 437000,445200-445800,450550. H278 00077921 * 5.0 C 147000,147600. 23281 00078821 * 5.0 (DUPLICATE OF H207) JRT 23263 00079721 * 5.0 A 052440,786500. JRT H207 00080621 * 5.0 A 049600,086000,088000,160200,168400,219400,233900, H235 00081521 * A 792800. H235 00082421 * C 049220,244200,387000. H235 00083321 * D 532950,534670. H235 00084221 * 5.0 C 021400,245000. ( MCS ) MAH MCSR18 00085121 * 5.0 C 158616-158620. MAH I16 00086021 * 5.0 A 534910. MAH H229 00086921 * C 021300-021400,185880-185940. MAH H229 00087821 * 5.0 A 021960,086000,185800,534260,774400. MAH PTM825 00088721 * C 208240-208320,208400. MAH PTM825 00089621 * 00090521 * R17 188200,190000-192000,193200-193800. 20706 00091421 * R17 436600. 20202 00092321 * R17 049940-050040,051020,051220,183700,186400. H169 00093221 * R17 087600,088010. H106 00094121 * R17 (FIXED BY H069 CHANGES) H109 00095021 * R17 (FIXED BY H069 CHANGES) H108 00095921 * R17 (FIXED BY I14 CHANGES) H107 00096821 * R17 022200,159800-160000,160600,161400,161800,162400, H069 00097721 * 162800,163800,164800,165400-165800,166400-168800, H069 00098621 * 218000-219000,222200-237600,239600,245000,245400, H069 00099521 * 534220,534540-534620. H069 00100421 * R17 121000,160400. I16 00101321 * R17 038200-039800,049200-054600,169200-185800, I14 00102221 * 413800-427200,533710,534520-534530,538270-538590. I14 00103121 * R17 397800. IHE00 00104021 * 00104921 * 00105821 * BETWEEN R16 AND R17, THE CSECT BOUNDARIES WERE MOVED 00106721 * AND ALL CONSTANTS MOVED TO THE END OF THE MODULE. 00107621 * 00108521 * 00109421 * R16 284600. 15667 00110321 * R16 444850. H046 00111221 * THIS MODULE CONTAINS A FIX FOR APAR 12848. 00112121 SPACE 5 00113021 * STATUS - CHANGE LEVEL 0 00113921 SPACE 5 00114821 * FUNCTIONS- 1)OPEN SYSPRINT AND SYSPLIN. 00120015 * 2)CONSTRUCT THE PHASE DIRECTORY 00140015 * 3)SCAN THE OPTION LIST AND SET DEFAULT VALUES 00160015 * AND CONDITIONS WHERE NECESSARY 00180015 * 4)GET CORE FOR THE TEXT AND DICTIONARY BLOCKS 00200015 * 5)SET UP THE COMMUNICATIONS REGION IN THE 00220015 * FIRST DICTIONARY BLOCK 00240015 * 6)OPEN THE SPILL FILE IF 1K BLOCKS ARE USED 00260015 * FOR THIS COMPILATION 00280015 * 7)GET 4K OF CORE AS THE GUARENTEED AMOUNT 00300015 * 8)TEST FOR BCD OPTION AND MOVE THE CORRECT 00320015 * TRANSLATE TABLE INTO AA 00340015 * 9)TEST FOR CHAR48. IF REQUIRED THEN LOAD AC, 00360015 * SET THE BLOCKSIZE AND OPEN SYSUT3. 00380015 * 10)PRINT A LIST OF OPTIONS USED DURING THIS 00400015 * COMPILATION 00420015 * 11)INSERT ERROR MESSAGES INTO DICTIONARY 00440015 * THAT WERE GENERATED WHEN SYSPRINT AND SYSPLIN WERE OPENED 00460015 * 12)READ THE FIRST CARD AND STORE IT AS A 00480015 * HEADING 00500015 * 00520015 * 00540015 * ENTRY POINTS-1)FROM COMPILER CONTROL,IEMAA 00560015 * 00580015 * INPUT 1) BY CHAINING THROUGH THE SAVE AREAS REGISTER 1 00600015 * AT INVOCATION TIME IS FOUND. THIS IS PASSED TO THE OPTION 00620015 * SCANNER 00640015 * 2)A LIST OF ADDRESS IN THE CONTROL PHASE IS POINTD 00660015 * AT BY A WORD IN THE TRANSFER VECTOR 00680015 * 00700015 * OUTPUT- THE COMPILER IS READY TO GO 00720015 * 00740015 * EXTERNAL ROUTINES 1)OPEN TO OPEN THE REQUIRED FILES 00760015 * 2)WTO IF AN ERROR OCCURS ON OPENING 00780015 * SYSPRINT 00800015 * 3)PUT TO START LISTINGS AND PRINT 00820015 * MESSAGES 00840015 * 4)BLDL TO CONSTRUCT THE PHASE 00860015 * DIRECTORY 00880015 * 5)GETMAIN TO GET CORE FOR VARIOUS 00900015 * PURPOSES 00920015 * 6)ZUPL TO PRINT ERROR MESSAGES,OPTIONS 00940015 * 7)ZUERR TO RECORD ERRORS 00960015 * 00980015 * EXITS - NORMAL THROUGH ABOUT AND THE COMPILER CONTINUES 01000015 * ABNORMAL THROUGH KILL AND THE COMPILER TERMINATS 01020015 * AND THROUGH ABORT.COMPILER TERMINATES 01040015 * 01060015 * ATTRIBUTES - NONE 01080015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 000-TSS 01100020 EJECT 01120015 SPACE 2 01140015 * ----------------------------------------------------AB 000-TSS 01150020 GBLB &STD 54703 01153021 &STD SETB 1 54703 01156021 IEMAB CSECT 01160001 USING *,CNTLB 01180015 USING SECT2,CNTL2 01200015 USING SECT3,CNTL3 01220015 USING SECT4,CNTL4 01240015 SECT1 EQU * 01260015 STM 14,9,12(DICR) STORE REGISTERS FOR WORK 01280015 LR CNTLB,15 BASE FIRST CSECT 01300015 LM CNTL3,CNTL2,BASES BASE THIRD AND SECOND CSECT 01320015 L CNTL4,BASE4 01340015 LA GRA,SAVAR POINT AT SAVE AREA FOR THIS PHAS 01360015 ST DICR,4(0,GRA) CHAIN FORWARDS 01380015 ST GRA,8(0,DICR) CHAIN BACKWARDS 01400015 LR DICR,GRA 01420015 SPACE 01440015 * PICK UP ADDRESS OF INVOCATION PARAMETER LIST AND BRANCH 01460015 * TO THE INVOCATION PROCESSOR TO PROCESS ANY ALTERNATE DDNAMES 01480015 * AND/OR A USER SUPPLIED INITIAL PAGE NUMBER 01500015 SPACE 01520015 L GRA,4(0,DICR) PICK UP ADDRESS OF PREVIOUS SAVE 01540015 L GRA,4(0,GRA) POINT AT SAVE AREA FOR OS/360 01560015 L GRA,24(0,GRA) PICK UP REG1 ON ENTRY 01580015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 001-TSS 01590019 BC B,INVOKEPR BRANCH TO INVOCATION PROCESSOR 01600015 * ----------------------------------------------------AB 001-TSS 01610019 EJECT 01620015 * OPEN SYSIN AND SYSPRINT. IF IT IS NOT POSSIBLE TO OPEN 01640015 * EITHER THEN AN ERROR EXIT IS TAKEN,MESSAGES PRINTED AND THE 01660015 * COMPILATION TERMINATED. 01680015 SPACE 01700015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 014-TSS 01710019 OPNFILES L GRB,PAROF(0,CNTL) POINT AT INITIALISATION LIST 01720015 L GRC,RDOF(0,GRB) POINT AT SYSIN DCB 01740015 L GRD,PLOF(0,GRB) POINT AT SYSPRINT DCB 01760015 SPACE 01780015 LA GRE,EXPL POINT AT EXIT LIST FOR SYSPLIN 01800015 LA GRF,EXPR SYSPRINT 01820015 STM GRE,GRF,TEMP1 STORE READY TO PUT IN DCBS 01840015 USING IHADCB,GRC 01860015 MVC DCBEXLST+1(3),TEMP1+1 INSERT ADDRESS IN SYSPLIN DCB 01880015 DROP GRC 01900015 USING IHADCB,GRD 01920015 TM DCBOFLGS,X'10' IS SYSPRINT ALREADY OPEN H235 01926001 BC BO,PRIOROP BRANCH IF IT IS H235 01932001 MVC DCBEXLST+1(3),TEMP2+1 INSERT ADDRESS IN SYSPRINT DCB 01940015 DROP GRD 01960015 SPACE 01980015 OPEN ((GRD),(OUTPUT),(GRC),(INPUT)) OPEN SYSPRINT AND SYSIN 02000015 SPACE 02020015 USING IHADCB,GRD 02040015 TM DCBOFLGS,X'10' SEE IF SYSPRINT IS OPEN 02060015 BC BO,INOPEN 02080015 DROP GRD 02100015 SPACE 02120015 CNOP 0,4 ENSURE WORD ALIGNMENT FOR EQUS 02126001 M3876 WTO 'IEM3876I UNABLE TO OPEN SYSPRINT', MCS R18C02132001 ROUTCDE=(2,11),DESC=6 MCS 43462 02138021 MCSFLGS EQU M3876+6 H229 02144001 DESCRTCD EQU M3876+40 H229 02150001 BC B,KILL GO TO AB KILL EXIT ROUTINE 02160015 SPACE 02180015 INOPEN CLI DUDPRINT,X'FF' SEE IF SYSPRINT OPEN EXIT H69 02184017 * ROUTINE HAS FOUND INVALID H69 02188017 BC BE,KILL BLOCKSIZE. IF SO, KILL. H69 02192017 * H69 02196017 PRIOROP EQU * JUMP HERE - IF BATCHING, SYSPRINT ALREADY OPEN H235 02196201 * PICK UP THE SYNAD RTN ADDRESS PTM825 02196401 USING IHADCB,GRD FROM THE SYSPRINT DCB IN IEMAA PTM825 02196801 L GRE,DCBSYNAD AND SAVE IT IN IEMAB PTM825 02197201 ST GRE,PRSYNAA CHANGE SYNAD ADDR TO POINT PTM825 02197601 LA GRE,PRERRX TO IEMAB SYNAD EXIT RTN PTM825 02198001 ST GRE,DCBSYNAD FOR SYSPRINT. PTM825 02198401 MVC DCBIOBL,PRSYNAA RESTORE IOB LENGTH PTM825 02198801 XC DCBEXLST+1(3),DCBEXLST+1 CLEAR DCB EXLIST 57480 02199072 DROP GRD (IEMAA SYNAD RTN ADDR RESTORED IN) PTM825 02199201 * SYSPRINT DCB ON IEMAB EXIT) PTM825 02199601 USING IHADCB,GRC 02200015 XC DCBEXLST+1(3),DCBEXLST+1 CLEAR DCB EXLIST 57480 02210072 TM DCBOFLGS,X'10' SEE IF SYSIN IS OPEN. H69 02220017 BC BO,PROPEN 02240015 DROP GRC 02260015 LR GRA,GRD POINT AT SYSPRINT DCB 02280015 PUT (1) FIND BUFFER SPACE 02300015 MVC 0(36,GRA),INERR MOVE IN MESSAGE 02320015 BC B,KILL 02340015 * ----------------------------------------------------AB 014-TSS 02350019 EJECT 02360015 * 02380015 * ISSUE A BLDL TO A LIST OF PHASE NAMES. O/S 360 WILL THEN 02400015 * FILL IN THE LIST WITH USER DATA. MOST OF THIS DATA IS THEN 02420015 * DISCARDED AS THE PHASE DIRECTORY IN THE CONTROL PHASE IS 02440015 * CONSTRUCTED. THE INFORMATION THAT IS RETAINED IS 02460015 * 1)LAST TWO BYTES OF PHASE NAME 02480015 * 2)STATUS (1 BYTE) 02500015 * 3)CONCATENATION NUMBER (1 BYTE) 02520015 * 4)LIBRARY ID (1 BYTE) 02540015 * 5)TTR OF FIRST TEXT RECORD (3 BYTES) 02560015 * 6)CONTIGUOUS CORE REQUIRED (2 BYTES) 02580015 * 7)LENGTH OF FIRST TEXT RECORD (2 BYTES) 02600015 * A MODEL LOAD LIST IS INSERTED IN THE CONTROL PHASE. THIS WILL 02620015 * THEN SAVE THE DISCARDED MATERIAL. 02640015 * 02660015 PROPEN XR 1,1 SET REG 1 TO ZERO FOR BLDL 02680015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 002-TSS 02690019 LA 0,BLDLST POINT AT BLDL LIST 02700015 SPACE 02720015 BLDL (1),(0) CONSTRUCT LIST OF PHASES 02740015 SPACE 02760015 BC B,HERE(15) TEST IF 02780015 HERE BC B,OK 02800015 BC B,OK EVEN THOUGH LIST NOT FILLED 02820015 BC B,BLDERR 02840015 SPACE 02860015 OK LA GRA,PHASE1 POINT AT BLDL LIST TO SET UP 02880015 LH GRB,LNGTH REDUCTION TO A MANAGEABLE SIZE 02900015 L GRD,PAROF(0,CNTL) POINT AT INITIALISATION LIST 02920015 L GRD,PDOF(0,GRD) PICK UP START OF PHASE DIRECTORY 02940015 L GRC,PDLAST POINT TO END OF BLDL LIST 02960015 SPACE 02980015 CONTIN MVC 0(2,GRD),3(GRA) MOVE IN ID 03000015 MVC 3(2,GRD),11(GRA) CONCAT AND ZERO 03020015 MVC 5(3,GRD),14(GRA) TTR 03040015 MVC 8(2,GRD),25(GRA) TOTAL CORE 03060015 MVC 10(2,GRD),27(GRA) LENGTH OF FIRST RECORDP 03080015 MVI 2(GRD),X'00' SET STATUS TO ZERO 03100015 LA GRD,12(0,GRD) BUMP PD POINTER 03120015 BXLE GRA,GRB,CONTIN 03140015 SPACE 03160015 MVI 0(GRD),X'00' MOVE IN STOPPER BYTE 03180015 SPACE 03200015 L GRB,PAROF(0,CNTL) PICK UP ADDRESS OF ADDRESS LIST 03220015 L GRC,LOADOF(0,GRB) POINT TO MODEL LOAD REQUEST 03240015 MVC 0(30,GRC),PHASE1 MOVE IN MODEL LOAD REQUEST 03260015 EJECT 03280015 * 03300015 * CONSTRUCT THE LIST OF PHASES IN THE SECOND HALF OF THE 03320015 * COMPILER. THIS LIST IS KEPT IN THE CONTROL PHASE FOR CHECKING 03340015 * PURPOSES AND ALSO TO ALLOW EASE OF CHANGE. THE LAST PHASE OF 03360015 * THE FIRST HALF RECONSTRUCTS THE PHASE DIRECTORY 03380015 * 03400015 LA GRA,PHASE2 POINT AT SECOND HALF LIST 03420015 L GRD,SECPDOF(0,GRB) PICK UP ADDRESS OF SEC.LIST. 03440015 LH GRB,LENGTH2 PICK UP LENGTH OF EACH ENTRY 03460015 L GRC,SECLAST POINT AT END OF SECOND HALF LIST 03480015 SPACE 03500015 CONTIN2 MVC 0(2,GRD),0(GRA) PICK UP PHASE NAME 03520015 MVI 2(GRD),X'00' SET STATUS TO ZERO 03540015 LA GRD,3(0,GRD) BUMP TO NEXT ENTRY 03560015 BXLE GRA,GRB,CONTIN2 03580015 SPACE 03600015 MVI 0(GRD),X'00' INSERT STOPPER BYTE 03620015 * BRANCH TO THE OPTION PROCESSOR TO PROCESS USER SUPPLIED 03640015 * OPTIONS AND THE DEFAULT OPTIONS AS SET AT SYSGEN TIME 03660015 * ----------------------------------------------------AB 002-TSS 03670019 SPACE 03680015 BC B,OPTPROC ENTER OPTION PROCESSOR 03700015 EJECT 03720015 * 03740015 * LOAD A SECOND CONTROL PHASE. THIS WILL BE IEMAL OR IEMAN 03760015 * ACCORDING AS TO WHETHER THE COMPILATION USES A LARGE 03780015 * DICTIONARY OR NOT 03800015 * 04000015 * LOAD IEMAL AND INITIALISE 04020015 * 04040015 OPENR L GRC,PAROF(CNTL) POINT AT INIT LIST 04060015 L GRD,GENSWOF(GRC) HENCE AT SWITCH 04080015 CLI 0(GRD),X'FF' IS THIS 1ST COMPILN 04100015 BC BNE,LODCNTL BRANCH IF SO 04120015 L GRB,PAGNO(GRC) POINT AT PAGE NO 04140015 MVC PAGSV(3),0(GRB) SAVE PAGNO 04160015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 004-TSS 04170019 L GRB,DADOF(GRC) POINT AT 04180015 L GRB,0(GRB) OLD COMM REG 04200015 CLC DICBYTE(1),DICTP(GRB) ARE WE USING SAME TYPE DIC 04220015 BC BE,GETBLK BRANCH IF SO 04240015 LODCNTL CLI DICBYTE,X'FF' TEST FOR BIG DIC 04260015 BC BE,BIGD BRANCH IF SO 04280015 CLI 0(GRD),X'00' IS THIS FIRST COMPILN 04300015 BC BE,LOADAN BRANCH IF SO 04320015 DELETE EP=IEMAL 04340015 LOADAN LOAD EP=IEMAN 04360015 BC B,MVTRVC 04380015 BIGD CLI 0(GRD),X'00' IS THIS FIRST COMPILN 04400015 BC BE,LOADAL 04420015 DELETE EP=IEMAN 04440015 LOADAL LOAD EP=IEMAL 04460015 * 04480015 * MOVE IN TEXT AND DICT BLOCK SIZE PARAMS FOR BIG DIC 04500015 * 04520015 MVTRVC LR GRB,0 START OF PHASE 04540015 ST GRB,BASOF(CNTL) BASE FOR SECOND CONTROL PHASE 04560015 * ----------------------------------------------------AB 004-TSS 04570019 * 04580015 * MOVE ADDRESSES OF ROUTINES AND CONSTANTS IN SECOND CONTRIL 04600015 * PHASE INTO THE TRANSFER VECTOR AND INITIALISATION LIST IN 04620015 * IEMAA. 04640015 * 04660015 MVC 8(20,CNTL),8(GRB) 04680015 MVC 40(16,CNTL),28(GRB) 04700015 MVC 80(28,CNTL),44(GRB) 04720015 MVC 132(4,CNTL),72(GRB) 04740015 MVC 0(16,GRC),76(GRB) 04760015 MVC 32(8,GRC),92(GRB) 04780015 MVC 80(4,GRC),100(GRB) 04800015 MVC 92(20,GRC),104(GRB) 04820015 MVC 132(4,GRC),124(GRB) 04840015 MVC 140(8,GRC),132(GRB) 04860015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 069-TSS 04866019 * ----------------------------------------------------AB 069-TSS 04872019 GETBLK L GRB,PAGNO(GRC) PICK UP PAGNO ADDR 04880015 MVC 0(3,GRB),PAGSV MOVE IN PAGE NO 04900015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 079-TSS 04900619 * ----------------------------------------------------AB 079-TSS 04901219 EJECT 04902017 * WE NOW WANT TO DECIDE WHAT SIZE DICTIONARY AND TEXT I14 04904017 * BLOCKS WE ARE GOING TO USE. I14 04906017 * FIRST, HOWEVER, WE MUST SUBTRACT ANY SPACE NEEDED BY I14 04908017 * EXTRA-LARGE I/O BUFFERS FROM THE CORE AVAILABLE. I14 04910017 * I14 04911017 L GRB,PAROF(CNTL) POINT AT INIT LIST I14 04912017 * I14 04913017 L GRD,SIZE PICK UP THE SIZE. I14 04914017 S GRD,OP44K SUBTRACT THE BASIC 44K I14 04916017 * NEEDED BY THE COMPILER. I14 04918017 * I14 04920017 L GRE,GENSWOF(GRB) SET DSECT BASE OF SWS IN AA H235 04921001 USING SWABAA,GRE H235 04922001 TM MESSW,X'20' WAS BIG SYSIN ASKED FOR.. H235 04923001 BZ QBIGPRIN BRANCH IF NOT. I14 04924017 * I14 04926017 USING IHADCB,GRC I14 04928017 L GRC,PAROF(CNTL) POINT VIA THE INITIALISATN I14 04930017 L GRC,RDOF(GRC) LIST AT THE SYSIN DCB I14 04932017 LH GRC,DCBBLKSI AND PICK UP THE BLOCKSIZE. I14 04934017 DROP GRC I14 04936017 * I14 04938017 A GRD,F1000 MAKE ALLOWANCE FOR THE 1000 I14 04940017 * BYTES OF SYSIN BUFFERS I14 04942017 * INCLUDED IN THE BASIC 44K. I14 04944017 SR GRD,GRC SUBTRACT THE SPACE NEEDED I14 04946017 SR GRD,GRC FOR TWO BIG SYSIN BUFFERS I14 04948017 * FROM THE SPACE AVAILABLE. I14 04950017 BL SYSIER BRANCH IF THE AVAILABLE I14 04952017 * SPACE HAS GONE NEGATIVE. I14 04954017 SPACE 4 I14 04956017 QBIGPRIN CLI BUFSW,X'FF' WAS BIG SYSPRINT ASKED FOR. I14 04958017 BNE QPUNCH BRANCH IF NOT. I14 04960017 DROP GRE H235 04961001 * I14 04962017 USING IHADCB,GRC USING THE ADDRESS OF THE I14 04964017 L GRC,PRDCB SYSPRINT DCB WHICH WAS STORED I14 04966017 LH GRC,DCBBLKSI EARLIER IN IEMAB, PICK UP THE I14 04968017 DROP GRC SYSPRINT BLOCKSIZE. I14 04970017 * I14 04972017 A GRD,F258 MAKE ALLOWANCE FOR THE 258 I14 04974017 * BYTES OF SYSPRINT BUFFERS I14 04976017 * INCLUDED IN THE BASIC 44K. I14 04978017 SR GRD,GRC SUBTRACT THE SPACE NEEDED I14 04980017 SR GRD,GRC FOR TWO BIG SYSPRINT BUFFERS I14 04982017 * FROM THE SPACE AVAILABLE. I14 04984017 BL SYSPER BRANCH IF THE AVAILABLE I14 04986017 * SPACE HAS GONE NEGATIVE. I14 04988017 SPACE 4 I14 04990017 QPUNCH ST GRD,CORAVL STORE AWAY THE CORE-AVAIL. I14 04992017 * H169 04992617 TM CCCADE+3,X'40' IS MACDCK WANTED.. H169 04993217 BNO PUNLIN01 BRANCH IF SO. H169 04993817 PUNLIN02 TM CCCADE,X'08' IS DECK WANTED.. H169 04994417 BO PUNLIN24 BRANCH IF NOT 25855 04994719 TM CCCADE+1,X'01' IS MACRO WANTED 25855 04995019 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 091-TSS 04995120 BO PUNLIN11 BRANCH IF NOT 25855 04995319 * ----------------------------------------------------AB 091-TSS 04995420 B PUNLIN03 IF SO TEST FOR COMP 25855 04995619 * H169 04996217 PUNLIN01 TM CCCADE+1,X'01' IS MACRO WANTED.. H169 04996817 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 071-TSS 04997119 BNO PUNLIN11 BRANCH IF SO H169 04997417 * ----------------------------------------------------AB 071-TSS 04997719 * SO WE'VE BEEN ASKED FOR MACDCK AND NOMACRO. H169 04998017 OI CONFLICT,X'01' SET IEM3915I BIT ON. H169 04998617 OI CCCADE+3,X'40' SHOW MACDCK NOT WANTED. H169 04999217 B PUNLIN02 GO TO TEST FOR DECK. H169 04999817 * H169 05000417 PUNLIN03 TM CCCADE+3,X'20' IS COMP WANTED.. H169 05001017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 072-TSS 05001319 BNO PUNLIN11 BRANCH IF SO. H169 05001617 * ----------------------------------------------------AB 072-TSS 05001919 * SO WE'VE BEEN ASKED FOR DECK AND NOCOMP. H169 05002217 OI CONFLICT,X'02' SET IEM3916I BIT ON. H169 05002817 OI CCCADE,X'08' SHOW DECK NOT WANTED. H169 05003417 B PUNLIN24 NO DECK WANTED. H169 05004017 * H169 05004617 * SO WE WANT SYSPUNCH. I14 05006017 * I14 05008017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 073-TSS 05009019 PUNLIN11 L GRC,PAROF(CNTL) POINT VIA THE INITIALISATN I14 05010017 L GRC,SYPOF(GRC) LIST AT THE SYSPUNCH DCB. I14 05012017 * I14 05014017 LA RSW,PUNSW SET REGISTER TO SHOW WE I14 05016017 * ARE WORKING ON SYSPUNCH. I14 05018017 * I14 05020017 * ----------------------------------------------------AB 073-TSS 05021019 USING IHADCB,GRC I14 05022017 PUNLIN12 TM DCBOFLGS,X'10' HAS SYSPUNCH/SYSLIN BEEN I14 05024017 * LEFT OPEN FROM A PREVIOUS I14 05026017 * COMPILATION IN THE BATCH. I14 05028017 BO PUNLIN41 BRANCH IF SO. I14 05030017 * I14 05032017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 057-TSS 05033019 MVC DCBEXLST+1(3),SPEXAD INSERT THE ADDRESS OF THE I14 05034017 * OPEN EXIT LIST INTO THE DCB. I14 05036017 * ----------------------------------------------------AB 057-TSS 05037019 OPEN ((GRC),(OUTPUT)) OPEN SYSPUNCH/SYSLIN. I14 05038017 XC DCBEXLST+1(3),DCBEXLST+1 CLEAR DCB EXLIST 57480 05039072 TM DCBOFLGS,X'10' WAS OPEN SUCCESSFUL.. I14 05040017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 047-TSS 05041019 BO PUNLIN21 BRANCH IF SO. I14 05042017 OI 0(RSW),X'04' SET 'UNABLE TO OPEN' BIT ON I14 05044017 * IN PUNSW OR LINSW. I14 05046017 * ----------------------------------------------------AB 047-TSS 05047019 B PUNLIN23 I14 05048017 * I14 05050017 * WE HAVE OPENED SYSPUNCH/SYSLIN. I14 05052017 * I14 05054017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 061-TSS 05055019 PUNLIN21 TM 0(RSW),X'03' WAS AN ERROR FOUND IN THE I14 05056017 * OPEN EXIT ROUTINE.. I14 05058017 BZ PUNLIN23 BRANCH IF NOT. I14 05060017 * I14 05062017 * WE MUST RESET THE BLOCKSIZE IN THE DCB TO THE USERS I14 05064017 * VALUE BEFORE CLOSING, SO THAT WE DO NOT MODIFY THE DSCB. I14 05066017 * I14 05068017 MVC DCBBLKSI,HOLDBSZ I14 05070017 DROP GRC I14 05072017 * I14 05074017 PUNLIN22 CLOSE ((GRC)) CLOSE SYSPUNCH/SYSLIN. I14 05076017 FREEPOOL (GRC) FREE BUFFERS. I14 05078017 * ----------------------------------------------------AB 061-TSS 05079019 * I14 05080017 PUNLIN23 LA GRA,LINSW WERE WE DEALING WITH I14 05082017 CR GRA,RSW SYSLIN.. IF SO, WE HAVE I14 05084017 * DEALT WITH BOTH SYSPUNCH AND I14 05086017 BE PUNLIN31 SYSLIN, AND CAN BRANCH OUT. I14 05088017 * I14 05090017 * WE HAVE NOW DEALT WITH SYSPUNCH. I14 05092017 * WE MUST NOW SET THINGS UP FOR SYSLIN, IF NECESSARY. I14 05094017 * I14 05096017 PUNLIN24 TM CCCADE,X'10' IS LOAD WANTED.. I14 05098017 BO PUNLIN31 BRANCH IF NOT. I14 05100017 TM CCCADE+1,X'01' IS MACRO WANTED 25855 05100319 BO PUNLIN29 BRANCH IF NOT 25855 05100619 TM CCCADE+3,X'20' IS COMP WANTED.. H169 05101017 BO PUNLIN28 BRANCH IF NOT.. H169 05102017 * H169 05103017 * SO WE WANT THE LOAD-FILE, SYSLIN. I14 05104017 * I14 05106017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 048-TSS 05106319 * ----------------------------------------------------AB 048-TSS 05106619 PUNLIN29 EQU * 25855 05107019 L GRC,PAROF(CNTL) POINT VIA THE INITIALISATN I14 05108017 L GRC,LFOF(GRC) LIST AT THE SYSLIN DCB. I14 05110017 * I14 05112017 LA RSW,LINSW SET REGISTER TO SHOW I14 05114017 * WE ARE WORKING ON SYSLIN. I14 05116017 * I14 05118017 B PUNLIN12 GO TO OPEN SYSLIN. I14 05120017 SPACE 2 05120517 * SO WE'VE BEEN ASKED FOR LOAD AND NOCOMP. H169 05121017 PUNLIN28 OI CONFLICT,X'04' SET IEM3917I BIT ON. H169 05121517 OI CCCADE,X'10' SHOW LOAD NOT WANTED. H169 05122017 B PUNLIN31 H169 05122517 SPACE 2 05123017 * SYSPUNCH/SYSLIN IS ALREADY OPEN FROM A PREVIOUS COMPILATN I14 05124017 * IN THE BATCH. WE CHECK WHETHER A BLOCKSIZE GREATER THAN I14 05126017 * 400 IS IN USE, AND IF SO SUBTRACT THE SPACE OCCUPIED BY I14 05128017 * BY THE BIG BUFFERS FROM THE CORE AVAILABLE. I14 05130017 * I14 05132017 USING IHADCB,GRC I14 05134017 PUNLIN41 LH GRE,DCBBLKSI PICK UP SYSPUNCH/SYSLIN I14 05136017 DROP GRC I14 05138017 * BLOCKSIZE. I14 05140017 CL GRE,FOURHN IS BLOCKSIZE > 400.. I14 05142017 BNH PUNLIN23 BRANCH IF NOT. I14 05144017 * I14 05146017 * SO WE ARE USING A BLOCKSIZE GREATER THAN 400. I14 05148017 * I14 05150017 L GRD,CORAVL BRING IN THE CORE AVAILABLE. I14 05152017 A GRD,F400 MAKE ALLOWANCE FOR THE 400 I14 05154017 * BYTES OF BUFFER-SPACE INCLUDED I14 05156017 * IN THE BASIC 44K. I14 05158017 SR GRD,GRE SUBTRACT THE SPACE NEEDED I14 05160017 * FOR THE BIG BUFFER I14 05162017 BL PUNLIN61 BRANCH IF WE HAVE RUN OUT I14 05164017 * OF SPACE. I14 05166017 * I14 05168017 PUNLIN51 ST GRD,CORAVL STORE THE REDUCED CORE- I14 05170017 * AVAILABLE BACK INTO CORAVL. I14 05172017 B PUNLIN23 I14 05174017 SPACE 2 I14 05176017 * ACCORDING TO THE SIZE OPTION FOR THIS COMPILATION, WE DO I14 05178017 * NOT HAVE ENOUGH SPACE FOR THE BIG SYSPUNCH/SYSLIN BUFFERS I14 05180017 * REQUESTED. BUT SYSPUNCH/SYSLIN HAS ALREADY BEEN USED I14 05182017 * SUCCESSFULLY FOR A PREVIOUS COMPILATION IN THE BATCH, I14 05184017 * SO WE PRESS ON REGARDLESS. I14 05186017 * I14 05188017 PUNLIN61 SR GRD,GRD SAY NO MORE SPACE AVAILABLE I14 05190017 B PUNLIN51 I14 05192017 SPACE 3 I14 05194017 * SYSPUNCH AND SYSLIN HAVE BOTH BEEN DEALT WITH. I14 05196017 * IF ERRORS WERE FOUND, BITS WERE SET ON IN PUNSW OR LINSW I14 05198017 * AND WE NOW HAVE TO DELETE THE CORRESPONDING OPTIONS. I14 05200017 * MESSAGES WILL BE PUT IN THE DICTIONARY LATER, I14 05202017 * WHEN IT HAS BEEN SET UP I14 05204017 * I14 05206017 PUNLIN31 TM PUNSW,X'07' ANY SYSPUNCH ERRORS.. I14 05208017 BZ PUNLIN32 BRANCH IF NOT. I14 05210017 * I14 05212017 OI CCCADE,X'08' SET OPTION TO NODECK. I14 05214017 OI CCCADE+3,X'40' SET OPTION TO NOMACDCK. I14 05216017 * I14 05218017 PUNLIN32 TM LINSW,X'07' ANY SYSLIN ERRORS.. I14 05220017 BZ PUNLIN99 BRANCH IF NOT. I14 05222017 * I14 05224017 OI CCCADE,X'10' SET OPTION TO NOLOAD. I14 05226017 EJECT 05228017 * SO WE'VE GRABBED ALL THE SPACE WE NEED FOR BIG I/O I14 05230017 * BUFFERS AND WE KNOW WE STILL HAVE THE BASIC CORE- I14 05232017 * REQUIREMENT AVAILABLE. I14 05234017 * THE BASIC 44K INCLUDES 4K FOR DICTIONARY AND TEXT BLOCKS. I14 05236017 * WE NOW MAKE THIS AVAILABLE. I14 05238017 * I14 05240017 PUNLIN99 L GRD,CORAVL GET CORE-AVAILABLE VALUE. I14 05242017 A GRD,FR96 I14 05244017 SPACE 05244201 * CALCULATE THE SPACE ALREADY ALLOCATED H207 05244401 SPACE 05244601 L GRC,SIZE H207 05244801 SR GRC,GRD H207 05245001 L GRA,PAROF(CNTL) POINT AT INIT LIST H207 05245201 L GRA,CORSZOF(0,GRA) POINT AT CORSZE H207 05245401 ST GRC,0(GRA) KEEP FOR USE BY AK H207 05245601 * ALLOW FOR OFLO BLOCK IF BIGDIC. 62615 05246072 CLI DICBYTE,X'00' 62615 05246372 BE NORMD BRANCH IF NORMAL DICTIONARY62615 05246672 MVC LIM1(20),EDLIMS LIMITS FOR 9 BLOCKS. 62615 05246972 NORMD EQU * 62615 05247272 * 62615 05247572 * WE NOW DECIDE FROM THE SPACE AVAILABLE WHAT IS THE I14 05248017 * BIGGEST BLOCKSIZE WE CAN USE. I14 05250017 * I14 05252017 CL GRD,LIM1 I14 05254017 BL SET0 BASIC 4K ONLY AVAILABLE. I14 05256017 CL GRD,LIM2 I14 05258017 BL SET1 8K AVAILABLE. 1K BLOCKS. I14 05260017 CL GRD,LIM3 I14 05262017 BL SET2 16K AVAILABLE. 2K BLOCKS. I14 05264017 CL GRD,LIM4 I14 05266017 BL SET3 32K AVAILABLE. 4K BLOCKS. I14 05268017 CL GRD,LIM5 I14 05270017 BL SET4 64K AVAILABLE. 8K BLOCKS. I14 05272017 * I14 05274017 * 128K AVAILABLE. 16K BLOCKS. I14 05276017 * I14 05278017 * THE PARAMETERS ARE INITIALLY SET UP FOR 1K BLOCKS. I14 05280017 * IF WE ARE GOING TO USE BIGGER BLOCKS, WE NOW OVERWRITE I14 05282017 * THE PARAMETERS WITH THE ONES FOR OUR BLOCKSIZE. I14 05284017 * I14 05286017 LA GRA,TEXTB5 SET UP FOR 16K BLOCKS. I14 05288017 B SETBLKSZ I14 05290017 * I14 05292017 SET4 LA GRA,TEXTB4 SET UP FOR 8K BLOCKS. I14 05294017 B SETBLKSZ I14 05296017 * I14 05298017 SET3 LA GRA,TEXTB3 SET UP FOR 4K BLOCKS. I14 05300017 B SETBLKSZ I14 05302017 * I14 05304017 SET2 LA GRA,TEXTB2 SET UP FOR 2K BLOCKS. I14 05306017 * I14 05308017 * I14 05310017 SETBLKSZ MVC TEXTB1(40),0(GRA) OVERLAY THE PARAMETERS FOR I14 05312017 * 1K BLOCKS WITH THE ONES FOR I14 05314017 * OUR CHOSEN BLOCKSIZE. I14 05316017 * I14 05318017 SET1 L GR0,DICTB PICK UP THE DICTIONARY I14 05320017 * BLOCK SIZE, READY FOR GETMAIN I14 05322017 LR GRA,GR0 CALCULATE THE SPACE NEEDED I14 05324017 SLA GRA,3 FOR 8 BLOCKS I14 05326017 SR GRD,GRA AND SUBTRACT IT FROM THE I14 05328017 * CORE AVAILABLE. I14 05330017 B QBIGDIC I14 05332017 * I14 05334017 * IF ONLY THE BASIC 4K ( OR ANYTHING LESS THAN 8K ) IS I14 05336017 * AVAILABLE, WE HAVE A SPECIAL CASE, AND INSTEAD OF USING I14 05338017 * 4 DICTIONARY AND 4 TEXT BLOCKS, WE USE ONLY 2 OF EACH. I14 05340017 * BLOCKSIZE IS 1K. THE READ-IN PHASE NEEDS 4K MORE THAN I14 05342017 * OTHER PHASES. WHEN READ-IN IS COMPLETE, THE 4K FREED IS I14 05344017 * USED TO EXPAND THE NUMBER OF BLOCKS TO THE USUAL 8. I14 05346017 * I14 05348017 SET0 LA GRE,2 SET NUMBR TO 2, TO SHOW WE I14 05350017 ST GRE,NUMBR WANT ONLY 2 BLOCKS. I14 05352017 OI CCCADE+2,X'04' SHOW WE WANT EXTRA BLOCKS I14 05354017 * CREATED AFTER READ-IN. I14 05356017 S GRD,FR96 SUBTRACT THE 4K USED FROM I14 05358017 * THE CORE AVAILABLE. I14 05360017 L GR0,DICTB PICK UP THE DICTIONARY I14 05362017 * BLOCK SIZE,READY FOR GETMAIN. I14 05364017 * I14 05366017 * SO WE HAVE DECIDED THE SIZE AND NUMBER OF OUR BLOCKS. I14 05368017 * WE NOW CHECK TO SEE WHETHER EXTENDED DICTIONARY HAS BEEN I14 05370017 * REQUESTED, AND IF SO OVERLAY A FURTHER SET OF PARAMETERS. I14 05372017 QBIGDIC ST GRD,CORAVL STORE AWAY THE REMAINING I14 05374017 * CORE-AVAILABLE VALUE. I14 05376017 * I14 05378017 * I14 05380017 CLI DICBYTE,X'00' NORMAL DICTIONARY.. I14 05382017 BE PTINIT BRANCH IF SO. I14 05384017 * I14 05386017 MVC ZSHF(4),ZSHFB OVERLAY I14 05388017 MVC ZMSK(2),ZMSKB EXTENDED I14 05390017 MVC ZMSK1(2),ZMSK1B DICTIONARY I14 05392017 MVC STOPOF(4),STOPOFB PARAMETERS. I14 05394017 EJECT 05396017 * WE NOW GET 4 TEXT AND 4 DICTIONARY BLOCKS. THIS I14 05398017 * WILL HELP TO REDUCE FRAGMENTATION OF CORE. I14 05400017 * THE ADDRESSES OF THE BLOCKS ARE PUT IN TSLOTS AND I14 05402017 * DSLOTS IN AL/AN, POINTED AT BY TSLOF AND DSLOF IN THE I14 05404017 * INITIALISATION LIST IN AA. I14 05406017 * ALL BLOCKS ARE MARKED IN-CORE AND FREE (X'81'). I14 05408017 * A STOPPER IS PLACED IN DSLOTS TO LIMIT THE NUMBER OF I14 05410017 * DICTIONARY BLOCKS. THE POSITION OF THIS STOPPER DEPENDS I14 05412017 * ON THE BLOCK-SIZE USED, AND IS GIVEN BY ONE OF THE I14 05414017 * PARAMETERS SET UP ABOVE. I14 05416017 SPACE 2 I14 05418017 PTINIT L GRB,PAROF(CNTL) POINT AT THE INIT LIST. I14 05420017 XR GRF,GRF SET NAMING REGISTER TO 0. I14 05422017 L GRD,NUMBR 05480015 L GRC,DSLOF(0,GRB) POINT AT DSLOTS 05500015 L GRE,DADOF(0,GRB) POINT AT SLOT HOLDING BIT SAYING 05520015 TM 0(GRE),X'80' BATCH. TEST TO SEE IF ON 05540015 BC BZ,ZBLOOP 05560015 MVI BTSW,X'FF' SHOW AB WE ARE BATCHING 05580015 L GRA,0(0,GRE) POINT AT OLD COMM REG 05600015 LA GRA,0(0,GRA) CLEAR TOP BYTE 05620015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 010-TSS 05630019 L GR0,DICTSZ(GRA) LOAD OLD BLOCK SIZE 05640015 FREEMAIN R,LV=(0),A=(1) FREE OLD 0TH BLOCK 05660015 * ----------------------------------------------------AB 010-TSS 05670019 ZBLOOP EQU * 52141 05675056 L GR0,DICTB LOAD NEW BLOCK SIZE 05680015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 011-TSS 05690019 SPACE 05700015 GETMAIN R,LV=(0) GET ANOTHER BLOCK. 52141 05710056 * ----------------------------------------------------AB 011-TSS 05730019 SPACE 05740015 ST 1,0(0,GRC) INSERT ADDRESS IN SLOT 05760015 MBLOCK MVI 0(GRC),X'84' MARK AS IN-CORE AND BUSY 05780015 MVI MBLOCK+1,X'81' MARK OTHERS AS INCORE AND FREE 05800015 CLI BRAN+1,X'F0' SEE IF TSLOTS IS RUNNING 05820015 BC BNE,DNAME 05840015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 075-TSS 05846019 * ----------------------------------------------------AB 075-TSS 05852019 LR GRE,GRA PICK UP ADDRESS OF BLOCK 05860015 AIF (&STD).L1 54703 05880021 AR GRE,GR0 54703 05884021 AGO .L5 54703 05888021 .L1 A GRE,DICTB 54703 05892021 .L5 ANOP 54703 05896021 S GRE,EIGHT POINT AT SLOT FOR NAME AND CHAIN 05900015 MVC 0(8,GRE),ZEROS SET NAME AND CHAIN TO ZERO 05920015 STC GRF,5(0,GRE) NAME BLOCK 05940015 LA GRF,1(0,GRF) BUMP COUNT TO NAME NEXT BLOCK 05960015 DNAME LA GRC,4(0,GRC) BUMP TO NEXT SLOT 05980015 BCT GRD,ZBLOOP 06000015 SPACE 06020015 BRAN BC NOP,ENDLOP JUMP WHEN TSLOTS IS FINISHED 06040015 MVI BRAN+1,X'F0' MAKE IT A PREMANENT BRANCH 06060015 L GR0,TEXTB1 PICK UP TEXT BLOCK SIZE 06080015 L GRC,TSLOF(0,GRB) POINT AT TSLOTS 06100015 MVI MBLOCK+1,X'84' SET TO MARK FIRST AS BUSY 06120015 L GRD,NUMBR 06140015 BC B,ZBLOOP 06160015 SPACE 06180015 * SYSIN OR SYSPRINT TOO BIG FOR THIS SIZE OPTION. I14 06182017 * PUT OUT MESSAGE AND KILL. I14 06184017 * I14 06186017 SYSIER MVC BUFMES+17(5),IN SHOW SYSIN, NOT SYSPRINT. I14 06188017 MVI BUFMES+11,X'F2' CHANGE THE MESSAGE NUMBER. I14 06190017 * I14 06192017 SYSPER L GRA,PLOF(0,GRB) POINT AT SYSPRINT DCB 06200015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 031-TSS 06210019 PUT (1) 06220015 * ----------------------------------------------------AB 031-TSS 06230019 MVC 0(65,GRA),BUFMES 06240015 BC B,KILL 06260015 SPACE 06280015 ENDLOP L GRC,DSLOF(0,GRB) POINT AT DSLOTS 06300015 L GRD,0(0,GRC) PICK UP ADDRESS OF FIRST DICT 06320015 LA GRD,0(0,GRD) CLEAR STATUS BYTE 06340015 L GRE,DADOF(0,GRB) POINT AT SLOT TO HOLD DICT ADDR 06360015 ST GRD,0(0,GRE) STORE ADDRESS OF DICTIONARY 06380015 ST GRD,DICTAD STORE DICTIONARY ADDRESS 06400015 SPACE 06420015 A GRC,STOPOF FIND ADDR OF STOPPER IN DSLOTS 06440015 LR GRD,GRC COPY STOPPER ADDR 06460015 LA GRE,4 06480015 SR GRD,GRE POINT AT SLOT BEFORE STOPPER 06500015 ST GRD,STOPOF STORE ADDR OF LAST DSLOT 06520015 TM CCCADE+2,X'04' IS BLOCK EXPANDER REQUIRED 06540015 BC BZ,DSTOP OMIT NEXT INSTRUCTION IF NOT 06560015 S GRC,EIGHT IF YES SAVE 2 DICT BLOCK SLOTS 06580015 DSTOP MVC 0(4,GRC),STOPPER INSERT STOPPER 06600015 EJECT 06620015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 012-TSS 06630019 * THIS ROUTINE GETS ALL THE BLOCKS IT CAN AS SOON AS IT 06640015 * CAN TO REDUCE CORE FRAGMENTATION. THE ADDRESSES OF THE BLOCKS 06660015 * FORM A TABLE WHICH THE TRYMRD AND TRYMRT ROUTINES USE. 06680015 * 06700015 L GRB,BTBLOF(0,GRB) POINT AT BLOCK TABLE 06720015 L GRC,CORAVL LOAD AVAILABLE CORE 06740015 EXTRACT MVTTST,FIELDS=(GRS) TEST FOR MVT 06742015 CLC MVTTST(4),ZEROS 06744015 BC BZ,NOTMVT BRANCH IF NOT MVT 06746015 S GRC,FR96 SAVE 4K IF MVT TO PREVENT RUNNING 06748015 * OUT OF CORE 06750015 NOTMVT EQU * 06752015 L GRD,DICTB LOAD BLOCK SIZE 06760015 LA GRE,10 SET TABLE COUNT 06780015 SPACE 06800015 ST GRD,GETLST FILL IN GETMAIN REQUEST SIZE 06820015 ST GRD,GETLST+4 06840015 SPACE 06860015 NXBLK CR GRD,GRC TRY FOR ANOTHER BLOCK 06880015 BC BH,TBLEND END IF NO CORE AVAILABLE 06900015 GETMAIN VC,LA=GETLST,A=ANSW GET ANOTHER BLOCK 06920015 BC B,HEREA(15) CHECK IF BLOCK IS OK 06940015 HEREA BC B,OKA 06960015 BC B,TBLEND 06980015 SPACE 07000015 OKA L GRF,ANSW PUT BLOCK ADDR INTO TABLE 07020015 ST GRF,0(0,GRB) 07040015 LA GRB,4(0,GRB) BUMP TABLE POINTER 07060015 SR GRC,GRD REDUCE AVAILABLE CORE 07080015 BCT GRE,NXBLK SET NEXT BLOCK IF TABLE HAS ROOM 07100015 TBLEND L GRB,PAROF(0,CNTL) POINT AT INITIALISATION LIST 07120015 ST GRC,CORAVL STORE REDUCED CORAVL VALUE 07140015 * ----------------------------------------------------AB 012-TSS 07150019 EJECT 07160015 * 07180015 * SET UP THE DICTIONARY COMMUNICATIONS REGION. THE FIRST 07200015 * 300 (HEX) BYTES ARE SET TO ZERO AND THEN THE VARIOUS BITS OF 07220015 * INFORMATION ARE SLOTTED IN 07240015 * 07260015 SPACE 07280015 SETCOM L GRB,PAROF(CNTL) POINT AT INIT LIST 07300015 L GRC,DADOF(GRB) HENCE AT DICTIONARY 07320015 L GRC,0(0,GRC) POINT AT DICTIONARY 07340015 MVI 0(GRC),X'00' SET COMMUNICATIONS REGION TO 07360015 MVC 1(256,GRC),0(GRC) ZEROS 07380015 MVC 257(256,GRC),256(GRC) 07400015 MVC 513(256,GRC),512(GRC) 07420015 SPACE 07440015 MVC DICTP(1,GRC),DICBYTE MOVE IN DIC TYPE 07460015 CLI DICBYTE,X'FF' IS IT BIG DIC 07480015 BC BE,BDCOM BRANCH IF SO 07500015 MVC ZNXTD+2(2,GRC),FSTD FIRST AVAILABLE LOC FOR DICT ENT 07520015 MVC FSTDRF+2(2,GRC),FSTD START OF DICT 07540015 MVC ZDNXT(4,GRC),FTY1 FIRST LOCATIONS OF ERROR MESSAGE 07560015 MVC ZSNXT(4,GRC),FTY5 CHAINS 07580015 MVC ZWNXT(4,GRC),FTY9 07600015 MVC ZCNXT(4,GRC),FTYD 07620015 BC B,ALLCOM 07640015 BDCOM MVC ZNXTD+2(2,GRC),FSTBD 1ST AVAIL LOC FOR DIC ENT 07660015 MVC FSTDRF+2(2,GRC),FSTBD STAR OF DIC 07680015 MVC ZNXTOF+2(2,GRC),FSTD SET FIRST DIC ENTRY OFFSET 07700015 MVC MAXFON(2,GRC),FONOS SET MAX FREE OFFSET VALUE 07720015 MVC ZOBSAD(4,GRC),STOPOF MOVE IN OFLO BLOCK SLOT ADDR 07740015 MVC ZOBNUM(2,GRC),OBNUM MOVE IN OFLO BLOCK NO 07760015 SPACE 07780015 ALLCOM MVC HDR(4,GRC),PDOF(GRB) POINT AT PHASE DIREC 07800015 L GRD,TEXTB1 PICK UP TEXT BLOCK SIZE 07820015 S GRD,EIGHT 07840015 ST GRD,TEXTSZ(0,GRC) 07860015 L GRD,DICTB PICK UP DICTIONARY SIZE 07880015 ST GRD,DICTSZ(0,GRC) 07900015 CLI DICBYTE,X'00' BIG DIC 07920015 BC BE,NZST BRANCH IF NOT 07940015 L GRD,UDICTB LOAD USABLE DICT SPACE VALUE 07960015 ST GRD,FONOF(GRC) SET OFFSET OF FON 07980015 * 08000015 * INITIALISATION OF FON TO KEEP ZSTACH ADDRBILITY 08020015 * 08040015 LR GRE,GRD COPY OFFSET 08060015 AR GRE,GRC POINY AT FON IN FIRST BLOCK 08080015 MVC 2(1,GRE),ZEROS ZERO OUT BEGINNING OF 08086015 MVC 3(250,GRE),2(GRE) OFFSET SLOTS 08092015 MVC 0(2,GRE),FSTFON SET FON TO 94 08100015 MVC 188(2,GRE),ZSTCHOF SET OFFSET 93 TO POINT AT ZSTCH 08120015 * 08140015 NZST S GRD,THREE 08160015 ST GRD,DICTSP(0,GRC) SET USEABLE DICT SIZE 08180015 SPACE 08200015 MVC CORLFT(4,GRC),CORAVL THIS RUNS CORE ALLOCATION 08220015 MVC RDSIZE(4,GRC),FR96 ESET READ AREA SIZE 08240015 SPACE 08260015 MVC ZSHIFT(4,GRC),ZSHF 08280015 MVC ZMASK(2,GRC),ZMSK 08300015 MVC ZMASK1(2,GRC),ZMSK1 08320015 MVC CCCODE(4,GRC),CCCADE MOVE IN BIT PATTERNS FOR OPTIONS 08340015 MVC CCCODEE+1(1,GRC),SKSW MOVE IN SYNCHK SWITCH I25 08350019 MVC AREA(1,GRC),INDIC MOVE IN DUMP CONTROL BYTE. 08360015 IC GRD,OPTVLU+3 LOAD OPT BYTE 08380015 LA GRD,1(0,GRD) BUMP OPT VALUE BY 1 08400015 STC GRD,ZOPT(GRC) PUT NEW OPT VALUE IN COMM REG 08420015 MVC ZSOR(2,GRC),SORMGINS+2 SET UP SOURCE VALUE 08440015 MVC ZMAG(2,GRC),SORMGINE+2 SET UP MARGIN VALUE 08460015 CLC CNTLCOL(4),ZEROS IS THERE A CONROL CHAR 08480015 BC BE,SYSL BRANCH IF NOT 08500015 MVC ZCNCHR(2,GRC),CNTLCOL+2 MOVE IT IN 08520015 SYSL L GRD,SLIBOF(GRB) * POINT AT ALT DDNAME SLOT 60069 08540072 MVC ZSYSLIB(8,GRC),0(GRD) * SHOW THE ALT DDNAME 60069 08550072 MVC ZPAGE(2,GRC),LINECNT+2 MOVE IN LINECOUNT 08560015 MVC ZM91(1,GRC),MODBYT MOVE IN MODEL OPTION BYTE 08580015 MVI ZLINE+1(GRC),X'78' SET LINESIZE VALUE 08600015 * 08601001 * THIS CODE SETS THE STATEMENT NUMBER/OFFSET TABLE PRINT SWTCH 08602001 NI CCCODEE(GRC),X'7F' TURN OFF STMT OFFSET SW 08603001 TM CCCODE(GRC),X'20' TEST LIST 08604001 BC BZ,STOFCON BRANCH IF WANTED 08605001 TM CCCODE+3(GRC),X'80' TEST STMT 08606001 BC BZ,STOFCON BRANCH IF WANTED 08607001 TM CCCODE+2(GRC),X'80' TEST SOURCE 08608001 BC BO,STOFCON BRANCH IF NOT WANTED 08609001 OI CCCODEE(GRC),X'80' SET FLAG ON 08610001 * 08611001 STOFCON EQU * 08612001 L GRE,GENSWOF(GRB) (THESE 3 STATS FOR PTM825)AA H235 08614001 USING SWABAA,GRE H235 08616001 MVI NOCRSW,X'00' SHOW COMM-REGION READY H235 08618001 CLI NAMSW,X'00' IS THERE NAME OPTION 08620015 BC BE,SETTRAN BRANCH IF NOT 08640015 MVC LKNAME(8,GRC),NAMSAVE MOVE IN NAME 08660015 SPACE 08680015 AIF (&STD).L2 54703 08700021 SETTRAN LA GRD,TRANOF(0,GRB) 54703 08705021 MVC ZTRAN1(8,GRC),0(GRD) 54703 08710021 AGO .L3 54703 08715021 .L2 ANOP 54703 08720021 SETTRAN EQU * 54703 08725021 .L3 ANOP 54703 08730021 TM MESSW,X'01' SEE IF U-FORMAT BIT REQUIRED 08740015 BC BZ,SEVCHK H106 08760017 OI CCCODE+1(GRC),X'80' SET U-FORMAT BIT ON 08780015 NI MESSW,X'FE' 08800015 DROP GRE H235 08800501 * H106 08801017 * IF ANY NON-TERMINAL ERROR MESSAGE HAS BEEN PUT OUT DIRECT H106 08802017 * ON TO SYSPRINT, INSTEAD OF INTO THE DICTIONARY, THEN BITS H106 08803017 * WILL HAVE BEEN SET ON IN SEVBITS, AND WE NOW CHECK THESE H106 08804017 * AND SET ERCODE ACCORDINGLY. H106 08805017 * H106 08806017 * FOR A WARNING MESSAGE SEVBITS = 1 AND WE SET ERCODE TO 4 H106 08807017 * ERROR 3 8 H106 08808017 * SEVERE 7 12 H106 08809017 * H106 08810017 SEVCHK CLI SEVBITS+1,X'00' ANY SUCH MESSAGES.. H106 08811017 BE PUTDIC BRANCH IF NOT. H106 08812017 * H106 08813017 LA GRD,5 CHANGE H106 08814017 AH GRD,SEVBITS 1, 3 OR 7 H106 08815017 SRL GRD,2 INTO H106 08816017 SLL GRD,2 4, 8 OR 12. H106 08817017 * H106 08818017 ST GRD,ERCODE(GRC) STORE THE RETURN CODE. H106 08819017 * 08820015 * WE NOW FILL SLOT (IN SECOND CONTROL PHASE) 08840015 * WHICH POINTS AT DICTIONARY 08860015 * 08880015 PUTDIC L GRD,DADOF(GRB) POINT AT SLOT WITH DIC ADDR 08900015 L GRE,BASOF(CNTL) POINT AT SECOND CONTROL PHASE 08920015 MVC 128(4,GRE),0(GRD) MOVE DIC ADDR INTO A SLOT 08940015 * 08960015 EJECT 08960501 * H319 08961001 * CALCULATE THE LENGTH TO WRITE OUT ON SYSUT1. 54799 08961521 * IT IS THE SHORTER OF DEVICE MAX BLOCK SIZE 62596 08962572 * AND TEXT (OR DICTIONARY) BLOCK SIZE. 62596 08962772 * H319 08963001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 093-TSS 08963220 L GRF,SPDCB(0,GRB) POINT AT SPILL DCB H319 08963501 USING IHADCB,GRF H319 08964001 DEVTYPE DCBDDNAM,DEVRES * OBTAIN DEVICE INFO 62596 08964572 LTR LR,LR * DDNAME FOUND ? 62596 08965572 BNZ OPENSP * NO, EXIT 62596 08966572 L GRD,DEVRES+4 * GRD = MAX BLOCK SIZE 62596 08967572 L GRE,DICTSZ(GRC) * GRE = DIC BLOCK SIZE 62596 08968572 CR GRD,GRE * LENGTH TO WRITE 62596 08969572 BL WRTSIZE * IS THE SMALLER OF 62596 08970572 LR GRD,GRE * DEVICE MAX BLOCK SIZE 62596 08971572 WRTSIZE L GRA,UT1OF(GRB) * AND DIC BLOCK SIZE 62596 08972572 STH GRD,0(GRA) 62596 08973572 * ----------------------------------------------------AB 093-TSS 08979020 SPACE 4 08980072 * 09000015 * OPEN SPILL FILE IF THE BLOCK SIZE IS 1K. THIS WILL 09020015 * PREVENT FRAGMENTATION OF CORE WITHIN THE SYSTEM 09040015 * 09060015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 078-TSS 09070019 OPENSP CLC DICTSZ(4,GRC),ONEK SEE IF 1K BLOCKS 09080015 BC BNE,GETSCR 09100015 OPEN ((GRF),(OUTIN)) H319 09130001 SPACE 09160015 TM DCBOFLGS,X'10' SEE IF SPILL FILE IS OPEN 09200015 BC BO,GETSCR 09220015 DROP GRF H319 09240001 MVI OPENSW,X'FF' SHOW CANNOT OPEN SPILL FILE 09260015 * ----------------------------------------------------AB 078-TSS 09270019 EJECT 09280015 * 09300015 * SET UP HEADING LINE AND LINE COUNT 09320015 * 09340015 GETSCR L GRC,HEDOF(0,GRB) PICK UP HEADING LINE 09360015 MVC 0(120,GRC),HEDING 09380015 SPACE 09400015 L GRC,PAGOF(0,GRB) 09420015 L GRA,LINECNT PICK UP LINE COUNT CVALUE 09440015 LA GRA,1(0,GRA) BUMP TO GIVE CORRECT NUMBER OF 09460015 ST GRA,0(0,GRC) LINES FROM ZUPL. STORE IN ZUPL 09480015 SPACE 09500015 * TEST THE CORRECT BIT TO SEE IF INPUT IS IN BCD CODE. IF 09520015 * IT IS THEN MOVE THE BCD TABLES IN IEMAB OVER THE EBCDIC TABLES 09540015 * ALREADY IN EXISTENCE IN THE CONTROL PHASE (IEMAA) 09560015 SPACE 09580015 L DICR,DADOF(0,GRB) POINT AT TRUE DICTIONARY 09600015 L DICR,0(0,DICR) 09620015 LM GRD,GRE,TRANOF(GRB) PICK UP ADDR OF TABLES IN IEMAA 09640015 TM CCCODE+2(DICR),X'20' TEST TO SEE IF BCD REQUIRED 09660015 BC BZ,NOBCD 09680015 MVC 0(256,GRD),TAB1 MOVE IN BCD TRANSLATE TABLE 09700015 SPACE 09720015 * 09740015 * TEST THE DUMP OPTION BIT AND IF ON THEN LOAD THE INTER- 09760015 * PHASE DUMPING ROUTINES(IEMAD). THESE ARE THEN ENTERED IN ORDER 09780015 * TO OPEN TESTRAN. THE ENTRY POUNT TO IEMAD IS PLACED IN THE 09800015 * TRANSFER VECTOR 09820015 * 09840015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 005-TSS 09850020 NOBCD TM CCCODE(DICR),X'80' SEE IF DUMPING REQUIRED 09860015 BC BZ,NODUMP 09880015 SPACE 09900015 LOAD EP=IEMAD LOAD INTERPHASE DUMPING 09920015 SPACE 09940015 LR LR,GR0 PICK UP LOAD POINT AND STORE IN 09960015 ST LR,ZUST(0,CNTL) THE TRANSFR VECTOR 09980015 SPACE 1 09982001 NODUMP TM CCCODE+3(DICR),X'02' IS TRACE OR PATCH WANTED.. IEMAT 09984001 BNO NOTRACE BRANCH IF NOT. IEMAT 09986001 LOAD EP=IEMAT LOAD TRACE & PATCH MODULE. IEMAT 09988001 * ----------------------------------------------------AB 005-TSS 09989020 L GRC,ATADDROF(0,GRB) POINT GRC AT ATADDR IEMAT 09990001 ST GR0,0(0,GRC) AND STORE A(IEMAT) THERE. IEMAT 09992001 EJECT 10000015 * TEST IF 48 CHARACTER SET IS INPUT FOR THIS COMPILATION. 10020015 * IF YES THEN LOAD ZUBW (IEMAC) AND OPEN SYSUT3 FOR OUTPUT. 10040015 * 10060015 NOTRACE TM CCCODE+1(DICR),X'03' TEST FOR 48CHAR AND MACRO 10080001 BC BO,NOTP 10100015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 006-TSS 10110019 LA GR0,BWNAME POINT AT NAME FOR PHASE IEMAC 10120015 LOAD EPLOC=(0) WHICH IS IN FACT ZUBW 10140015 LR LR,GR0 ENTER ZUBW TO OPEN FILE 10160015 ST LR,ZUBW(0,CNTL) STORE ADDRESS IN TRANSFER VECTOR 10180015 * ----------------------------------------------------AB 006-TSS 10190019 SPACE 10200015 L GRB,BWOFF(0,LR) PICK UP ADDRESS OF BWDCB 10220015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 062-TSS 10230019 USING IHADCB,GRB 10240015 L GRA,PAROF(0,CNTL) * LOAD A(PARM LIST) 60069 10260072 L GRA,SUT3OF(0,GRA) * & HENCE A(ALT DDNAME SLOT) 069 10266072 MVC DCBDDNAM(8),0(GRA) * MOVE DDNAME TO DCB 60069 10272072 DROP GRB 10280015 SPACE 10300015 CLC DICTSZ(4,DICR),ONEK TEST FOR 1K BLOCKS (SMALL SYSTM) 10320015 BC BE,ONEBLK 10340015 CLC DICTSZ(4,DICR),TWOK 2K BLOCKS 10360015 BC BE,TWOBLK 10380015 CLC DICTSZ(4,DICR),FR96 4K BLOCKS 10400015 BC BE,FRBLK 10420015 SPACE 10440015 MVI BUFNO,X'03' BUFNO=3 10460015 MVI BLOKF,X'02' BLOCKING FACTOR = 2 10480015 BWFBT MVI RECM,X'98' FIXED,BLOCKED,STANDARD OUTPUT 10500015 * ----------------------------------------------------AB 062-TSS 10510019 SPACE 10520015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 049-TSS 10530019 RDSYSIN L GRA,PAROF(0,CNTL) 10540015 L GRC,RDOF(0,GRA) POINT AT INPUT DCB 10560015 USING IHADCB,GRC 10580015 LH GRD,DCBLRECL PICK UP INPUT BLOCKSIZE AND 10600015 LH GRE,DCBBLKSI RECORD LENGTH 10620015 MVC INRECM(1),DCBRECFM PICK UP RECORD TYPE 10640015 DROP GRC 10660015 SPACE 10680015 TM CCCODE+1(DICR),X'01' SEE IF MACRO REQUIRED 10700015 BC BZ,BWFT 10720015 TM INRECM,X'C0' SEE IF U-TYPE 10740015 BC BO,BWUT 10760015 BC B,NONU 10770015 SPACE 10780015 BWFT L GRD,ETY MACROS PUT OUT 80 BYTE RECORDS 10800015 NONU XR GRF,GRF 10820015 IC GRF,BLOKF FACTOR TO GIVE BLOCKSIZE A DIRECT 10840015 XR GRA,GRA MULTIPLE OF LRECL 10860015 SPACE 10880015 BWLOOP AR GRA,GRD ADD LRECL TO GIVE NEW BLOCK SIZE 10900015 BCT GRF,BWLOOP 10920015 LR GRE,GRA 10940015 SPACE 10960015 USING IHADCB,GRB 10980015 SETBW STH GRD,DCBLRECL SET UP THE OUTPUT DCB TO AGREE 11000015 STH GRE,DCBBLKSI WITH THE INPUT LRECL AND RECFM. 11020015 MVC DCBRECFM(1),RECM 11040015 DROP GRB 11060015 BC B,OPENBW 11080015 SPACE 11100015 BWUT MVI RECM,X'C0' SET TO U-TYPE INPUT 11120015 BC B,SETBW 11140015 SPACE 11160015 ONEBLK MVI BUFNO,X'01' SET 1 BUFFER 11180015 MVI BLOKF,X'01' ONE RECORD/BLOCK 11200015 MVI RECM,X'90' UNBLOCKED,FIXED 11220015 BC B,RDSYSIN 11240015 SPACE 11260015 TWOBLK MVI BUFNO,X'01' 1 BUFFER 11280015 MVI BLOKF,X'02' 2 RECORD2/BLOCK 11300015 BC B,BWFBT 11320015 SPACE 11340015 FRBLK MVI BUFNO,X'02' 2 BUFFERS 11360015 MVI BLOKF,X'02' 2.RECORDS/BLOCK 11380015 BC B,BWFBT 11400015 * ----------------------------------------------------AB 049-TSS 11410019 SPACE 11420015 OPENBW OPEN ((GRB),(OUTPUT)) OPEN SYSUT3 FOR OUTPUT 11440015 SPACE 11460015 USING IHADCB,GRB 11480015 TM DCBOFLGS,X'10' SEE IF IN FACT IT IS OPEN 11500015 BC BO,NOTP 11520015 DROP GRB 11540015 SPACE 11560015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 050-TSS 11570019 LA GR0,KILSU3 SAY UNABLE TO OPEN SYSUT3 11580015 * ----------------------------------------------------AB 050-TSS 11590019 ST GR0,PAR1(0,DICR) 11600015 L LR,ZUPLOF(0,CNTL) 11620015 BALR RR,LR 11640015 * 11660015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 007-TSS 11670019 LA 0,BWNAME POINT AT PHASE AC 11680015 DELETE EPLOC=(0) DELETE AC 11700015 * ----------------------------------------------------AB 007-TSS 11710019 BC B,TERMIN GO TO ROUTINE TO TERMINATE COMP 11720015 SPACE 11740015 NOTP EQU * 11760015 EJECT 11780015 * 11800015 * THESE INSTRUCTIONS WILL LIST THE OPTIONS THAT WILL BE 11820015 * USED DURING THE CURRENT COMPILATION. THE LIST IS PRODUCED BY 11840015 * SCANNING THE CODE BITS IN CCCODE. THE LIST IS PUT OUT ON 11860015 * SYSPRINT IN ALL CASES. VALUE OPTIONS WILL PRINT OUT THE VALUE 11880015 * USED. 11900015 * IF THE OPTIONS SOURCE, ATR, XREF, EXTREF AND LIST ARE 11920015 * ALL MARKED NOT WANTED THEN THE OPTIONS LIST IS NOT OUTPUT 11940015 * EITHER. 11960015 * 11980015 LSTOPT CLI OPBYTE,X'FF' OPLIST WANTED 12010015 BC BNE,LOEND BRANCH IF NOT 12040015 SPACE 12080015 * SET UP LR SO THAT THE FOLLOWING BALR INSTRUCTIONS PASS I16 12085017 * CONTROL VIA THE ROUTINE STATS TO ZUPL AND THEN BACK HERE. I16 12090017 * I16 12095017 LA LR,STATS I16 12100017 * I16 12105017 LA R2,STATOP1 POINT R2 AT THE START OF THE I16 12110017 * STATISTICS OPTIONS LINE. I16 12115017 LA GR0,ALLRST POINT AT OPTION OUTPUT LINE 12120015 ST GR0,PAR1(0,DICR) 12140015 TM CCCODE+2(DICR),X'20' TEST FOR BCD INPUT 12160015 BC BO,PBCD 12180015 MVC OPTION(6),EBCID MOVE IN EBCDIC 12200015 BC B,PJ1 12220015 PBCD MVC OPTION(3),BCDC MOVE IN BCD 12240015 PJ1 BALR RR,LR 12260015 MVC ALLRST+3(63),BLANKT REMOVE FIRST PART OF LINE 12280015 SPACE 12300015 MVI ALLRST+2,X'01' MAKE IT A SPACE 1 12320015 TM CCCODE+1(DICR),X'02' TEST FOR 48 CHARACTER SET 12340015 BC BZ,PJ2 12360015 MVC OPTION(6),CHR60 MOVE IN CHAR60 12380015 BC B,PJ3 12400015 PJ2 MVC OPTION(6),CHR48A MOVE IN CHAR48 12420015 PJ3 BALR RR,LR 12440015 MVC NOPOS(9),BLANKS 12460015 SPACE 12480015 TM CCCODE+1(DICR),X'01' TEST IF MACRO REQUIRED 12500015 BC BZ,PJ32 12520015 MVC NOPOS(2),NO SAY NOMACRO 12540015 PJ32 MVC OPTION(5),MACRODC 12560015 BALR RR,LR 12580015 MVC NOPOS(7),BLANKS 12600015 SPACE 12620015 TM CCCODE+2(DICR),X'10' TEST IF SOURCE2 REQUIRED 12640015 BC BO,PJ33 12660015 MVC NOPOS(2),NO SAY NO SOURCE2 12680015 PJ33 MVC OPTION(7),SRCE2 12700015 BALR RR,LR 12720015 MVC NOPOS(09),BLANKS 12740015 SPACE 12760015 TM CCCODE+3(DICR),X'40' TEST IF MACDECK REQUIRED 12780015 BC BZ,PJ34 12800015 MVC NOPOS(2),NO SAY NO MACDK 12820015 PJ34 MVC OPTION(6),MACDKDC SAY MACDCK 12840015 BALR RR,LR 12860015 MVC NOPOS(8),BLANKS 12880015 SKIPMD EQU * 12900015 SPACE 12920015 TM CCCODE+3(DICR),X'20' TEST IF COMPILATION REQUIRED 12940015 BC BZ,PJ35 12960015 MVC NOPOS(2),NO SAY NO COMP 12980015 PJ35 MVC OPTION(4),COMPDC 13000015 BALR RR,LR 13020015 MVC NOPOS(6),BLANKS 13040015 SPACE 13060015 TM CCCODE+2(DICR),X'80' TEST FOR SOURCE LISTING 13080015 BC BZ,PJ31 13100015 MVC NOPOS(2),NO SAY NO SOURCE 13120015 PJ31 MVC OPTION(6),SRCE 13140015 BALR RR,LR 13160015 MVC NOPOS(11),BLANKS 13180015 MVC NOPOS+11(1),BLANKS 13200015 SPACE 13220015 TM CCCODE(DICR),X'01' SEE IF ATR SPECIFIED 13240015 BC BZ,PJ5 13260015 MVC NOPOS(2),NO SAY NO ATR 13280015 PJ5 MVC OPTION(3),ATRIB 13300015 BALR RR,LR 13320015 SPACE 13340015 MVC NOPOS(2),BLANKS REMOVE NO 13360015 TM CCCODE(DICR),X'02' TEST FOR XREF 13380015 BC BZ,PJ6 13400015 MVC NOPOS(2),NO SAY NO XREF 13420015 PJ6 MVC OPTION(4),CROSSR 13440015 BALR RR,LR 13460015 SPACE 13480015 MVC NOPOS(2),BLANKS REMOVE NO 13500015 TM CCCODE(DICR),X'04' TEST IF EXTREF 13520015 BC BZ,PJ7 13540015 MVC NOPOS(2),NO SAY NO EXTREF 13560015 PJ7 MVC OPTION(6),EXTERN 13580015 BALR RR,LR 13600015 SPACE 13620015 MVC NOPOS(11),BLANKS REMOVE NO 13640015 TM CCCODE(DICR),X'20' TEST IF OBJECT LISTING 13660015 BC BZ,PJ18 13680015 MVC NOPOS(2),NO SAY NO LIST 13700015 PJ18 MVC OPTION(4),PRLIST 13720015 BALR RR,LR 13740015 SPACE 13760015 MVC NOPOS(10),BLANKS REMOVE NO AND EXTREF 13780015 TM CCCODE(DICR),X'10' TEST FOR LOAD 13800015 BC BZ,PJ8 13820015 MVC NOPOS(2),NO SAY NO LOAD 13840015 PJ8 MVC OPTION(4),LFILE 13860015 BALR RR,LR 13880015 * I16 13882017 * THE FIRST STATISTICS OPTIONS LINE IS NOW FULL. I16 13884017 * I16 13886017 LA R2,STATOP2 POINT R2 AT THE SECOND I16 13888017 * STATISTICS OPTIONS LINE. I16 13890017 * I16 13892017 SPACE 13900015 MVC NOPOS(2),BLANKS REMOVE NO 13920015 TM CCCODE(DICR),X'08' TEST FOR DECK 13940015 BC BZ,PJ9 13960015 MVC NOPOS(2),NO SAY NO DECK 13980015 PJ9 MVC OPTION(4),CARDS 14000015 BALR RR,LR 14020015 SPACE 14040015 MVC NOPOS(2),BLANKS REMOVE NO 14060015 MVC OPTION(4),FLAGC INSERT FLAGX 14080015 TM CCCODE+1(DICR),X'0C' TEST FOR FLAGW 14100015 BC BM,PJ10 14120015 MVI OPTION+4,C'W' 14140015 BC B,PJ12 14160015 PJ10 TM CCCODE+1(DICR),X'08' TEST FOR FLAGS 14180015 BC BO,PJ11 14200015 MVI OPTION+4,C'E' SAY FLAGE 14220015 BC B,PJ12 14240015 PJ11 MVI OPTION+4,C'S' SAY FLAGS 14260015 PJ12 BALR RR,LR 14280015 MVC NOPOS(7),BLANKS 14300015 SPACE 14320015 MVC NOPOS(2),BLANKS REMOVE NO 14340015 TM CCCODE+3(DICR),X'80' TEST FOR STMT 14360015 BC BZ,PJ141 14380015 MVC NOPOS(2),NO SAY NO STMT 14400015 PJ141 MVC OPTION(4),STMTDC 14420015 BALR RR,LR 14440015 SPACE 14460015 MVC NOPOS(6),BLANKS REMOVE NO AND STMT 14480015 TM ZM91(DICR),X'01' TEST FOR M91 14500015 BC BZ,PJ14 ONLY PRINT M91 NOT NOM91 14520015 PJ142 MVC OPTION(5),M91DC I24 14540019 BALR RR,LR 14560015 SPACE 14580015 MVC NOPOS(2),BLANKS 14600015 SPACE 14620015 PJ14 MVC OPTION(5),SZEQ SAY WHAT SIZE IS 14640015 L GRA,SIZE PICK UP SIZE VALUE 14660015 BAL RR,CONBIN CONVERT TO DECIMAL 14680015 MVC OPTION+5(7),UDECF+1 23281 14700001 BALR RR,LR 14720015 SPACE 14740015 MVC OPTION+1(11),BLANKS 23281 14760001 MVC OPTION(8),NOLINE SAY LINE COUNT 14780015 L GRA,LINECNT PICK UP LINE-COUNT VALUE 14800015 BAL RR,CONBIN 14820015 MVC OPTION+8(3),UDECF+5 INSERT LINE-COUNT VALUE 14840015 BALR RR,LR 14860015 MVC OPTION(11),BLANKS 14880015 MVC OPTION(4),OPTDC SAM WHAT OPT VALUE IS 14900015 L GRA,OPTVLU 14920015 BAL RR,CONBIN 14940015 MVC OPTION+4(2),UDECF+6 INSERT OPT VALUE 14960015 BALR RR,LR 14980015 SPACE 15000015 MVC OPTION(11),BLANKS SAY WHAT SOURCE MARGIN IS 15020015 L GRA,SORMGINS CONVERT SOURCE VALUE 15040015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 065-TSS 15046019 * ----------------------------------------------------AB 065-TSS 15052019 BAL RR,CONBIN 15060015 MVC SORV(3),UDECF+5 15080015 L GRA,SORMGINE CONVERT MARGIN VALUE 15100015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 066-TSS 15106019 * ----------------------------------------------------AB 066-TSS 15112019 BAL RR,CONBIN 15120015 MVC MARV(3),UDECF+5 15140015 MVC OPTION(17),SOURCM MOVE WHOLE STATEMENT FOR PRINTNG 15160015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 089-TSS 15170020 CLC CNTLCOL(4),ZEROS IS THERE CNTL CHAR 15180015 BC BE,NOCTL BRANCH IF NOT 15200015 L GRA,CNTLCOL 15220015 * ----------------------------------------------------AB 089-TSS 15230020 BAL RR,CONBIN CONVERT TO DECINAL 15240015 MVC CNTLCHAR(3),UDECF+5 MOV% IN COL NO 15260015 MVC OPTION+16(5),CONTRL MOVE IN FIR PRINTING 15280015 NOCTL BALR RR,LR 15300015 MVC OPTION+11(10),BLANKS 15320015 SPACE 15340015 TM CCCODE(DICR),X'80' SAY IF DUMP OPTION IN 15360015 BC BZ,PJ15X 15380015 MVC OPTION(11),BLANKS 15400015 MVC OPTION(4),DUMPR SAY DUMP 15420015 BALR RR,LR 15440015 SPACE 15460015 PJ15X MVC OPTION(11),BLANKS 15480015 CLI DICBYTE,X'FF' ARE WE RUNNING UNDER BIGDIC 15500015 BC BE,PJ14A BRANCH IF SO 15520015 MVC NOPOS(2),NO SAY NO BIGDIC 15540015 PJ14A MVC OPTION(6),BIGDC SAY BIGDIC 15560015 BALR RR,LR PRINT 15580015 MVC NOPOS(8),BLANKS BLANK OUT OPTION 15600015 * I16 15603017 * THE SECOND STATISTICS OPTIONS LINE MAY NOW BE FULL. I16 15606017 * I16 15609017 LA R2,STATOP3 POINT R2 AT THE THIRD I16 15612017 * STATISTICS OPTIONS LINE. I16 15615017 * 15620015 TM CCCODE+3(DICR),X'01' TEST FOR NEST 15621015 BC BO,PJ15Y 15622015 MVC NOPOS(2),NO MOVE IN NO 15623015 PJ15Y MVC OPTION(4),NESTWR MOVE IN NEST 15624015 BALR RR,LR 15625015 MVC NOPOS(2),BLANKS 15626015 SPACE 15627015 MVC OPTION(6),OPLSTW 15628015 BALR RR,LR 15629015 SPACE 15630015 PJ15 TM CCCODE+2(DICR),X'40' SEE IF CHECK OPTION 15640015 BO PJ99X I25 15660019 MVC OPTION(11),BLANKS 15680015 MVC OPTION(3),CHKRR SAY CHK 15700015 BALR RR,LR 15720015 * 15740015 PJ99X MVC OPTION+7(4),BLANKS I25 15742019 MVC OPTION(6),SKEC INSERT 'SYNCHK' I25 15744019 CLI SKSW,X'04' TEST FOR SYNCHKS I25 15746019 BL PJ99Y BRANCH IF SYNCHKT I25 15748019 BH PJ99Z AND IF SYNCHKE I25 15750019 MVI OPTION+6,C'S' SAY SYNCHKS I25 15752019 B PJ15A I25 15754019 PJ99Y MVI OPTION+6,C'T' SAY SYNCHKT I25 15756019 B PJ15A I25 15758019 PJ99Z MVI OPTION+6,C'E' SAY SYNCHKE I25 15760019 PJ15A BALR RR,LR I25 15762019 * I25 15764019 CLI NAMSW,X'00' IS NAME OPTION USED I25 15766019 BC BZ,PJ999 BRANCH IF NOT IEMAT 15780001 MVC OPTION+6(5),BLANKS 15800015 MVC OPTION(6),OBNM MOVE IN OBJNM= 15820015 MVC OPTION+6(8),NAMSAVE MOVE IN NAME 15840015 BALR RR,LR 15843019 SPACE 15846019 PJ999 TM CCCODE+3(DICR),X'02' IS TRACE OR PATCH WANTED IEMAT 15849019 BNO PJ13 BRANCH IF NOT IEMAT 15852019 MVI OPTION+13,C' ' H350 15855019 MVC OPTION(13),TRACAPA MOVE IN 'TRACE & PATCH'. IEMAT 15860401 BALR RR,LR IEMAT 15860501 * I16 15860601 * WE NOW WANT TO PRINT OUT THE STATISTICS OPTIONS LINES. I16 15860701 * I16 15860801 PJ13 BCTR R2,0 POINT AT THE LAST , I16 15861217 MVI 0(R2),C' ' AND BLANK IT OUT. I16 15861517 * *** IF WE NEED TO BYPASS *** I16 15861601 * *** PRINTING OF STATISTICS *** I16 15861701 BC NOP,LOEND *** OPTIONS LINES, SET *** I16 15861801 * *** THIS STATEMENT TO BRANCH*** I16 15861901 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 090-TSS 15862020 LA GR0,STATLIN POINT AT THE STATISTICS LINE I16 15862117 * ----------------------------------------------------AB 090-TSS 15862220 ST GR0,PAR1(0,DICR) I16 15862417 BALR RR,R1 AND GO TO ZUPL TO PUT OUT I16 15862717 * THE FIRST LINE. I16 15863017 * I16 15863317 MVI STATCC,X'40' SET UP FOR SINGLE SKIP I16 15863617 MVC STATOP1(95),STATOP2 MOVE THE SECOND LINE INTO I16 15863917 BALR RR,R1 PLACE AND PRINT IT. I16 15864217 * I16 15864517 MVC STATOP1(95),STATOP3 MOVE THE THIRD LINE INTO I16 15864817 BALR RR,R1 PLACE AND PRINT IT. I16 15865117 * I16 15865417 B LOEND I16 15865717 SPACE 3 I16 15866017 * THIS ROUTINE IS ENTERED AS EACH OPTION LINE IS SET UP. I16 15866317 * IT RETRIEVES THE OPTION AND STORES IT IN THE STATISTICS I16 15866617 * OPTION LINE. ZUPL IS THEN CALLED, TO PRINT OUT THE I16 15866917 * ORIGINAL OPTION LINE. CONTROL IS RETURNED FROM ZUPL I16 15867217 * TO THE INSTRUCTION FOLLOWING THE BALR WHICH CALLED US. I16 15867517 * I16 15867817 * R2 HOLDS THE ADDRESS OF THE NEXT AVAILABLE POSITION I16 15868117 * IN THE STATISTICS OPTION LINE. I16 15868417 * I16 15868717 STATS CLI NOPOS,C'N' IS THE OPTION PRECEDED I16 15869017 * BY 'NO' .. I16 15869317 BNE STATIN1 BRANCH IF NOT. I16 15869617 * I16 15869917 MVC 0(2,R2),NO MOVE 'NO' INTO THE STATISTICSI16 15870217 * OPTION LINE. I16 15870517 LA R2,2(0,R2) POINT R2 AT THE NEXT I16 15870817 * AVAILABLE POSITION. I16 15871117 * I16 15871417 STATIN1 LA R1,OPTION POINT R1 AT THE START OF I16 15871717 * THE OPTION. I16 15872017 STATIN2 LA R1,1(0,R1) POINT AT THE NEXT CHARACTER I16 15872317 * IN THE OPTION. I16 15872617 CLI 0(R1),C' ' IS IT A BLANK.. I16 15872917 BNE STATIN2 IF NOT, GO ROUND AGAIN I16 15873217 * TO LOOK AT NEXT CHARACTER. I16 15873517 * I16 15873817 * SO R1 POINTS AT THE BLANK AFTER THE OPTION. I16 15874117 * I16 15874417 LA R3,OPTION LOAD THE ADDRESS OF THE I16 15874717 * OPTION INTO R3. I16 15875017 SR R1,R3 AND SUBTRACT FROM R1. I16 15875317 * I16 15875617 * SO R1 HOLDS THE LENGTH OF THE OPTION. I16 15875917 * I16 15876217 EX R1,STATMVC MOVE IT INTO THE STATS LINE. I16 15876517 * I16 15876817 AR R2,R1 POINT R2 AT THE NEXT I16 15877117 * AVAILABLE POSITION. I16 15877417 MVI 0(R2),C',' MOVE IN , I16 15877717 LA R2,1(0,R2) AND POINT R2 AT THE NEXT I16 15878017 * POSITION. I16 15878317 * I16 15878617 L R1,ZUPLOF(CNTL) POINT AT ZUPL I16 15878917 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 044-TSS 15879019 * ----------------------------------------------------AB 044-TSS 15879119 BR R1 AND PASS CONTROL TO IT. I16 15879217 SPACE 15880015 LOEND EQU * 15900015 EJECT 15920015 * 15940015 * JUST A FEW INSTRUCTIONS TO INSERT IN THE DICTIONARY THE 15960015 * ERROR MESSAGES GENERATED BY THE DCB EXIT ROUTINE FOR SYSIN.H69 15970017 * THE BITS SET BY THE DCB EXIT ARE TESTED IN TURN. H69 15980017 * WE THEN TELL IEMAA TO TERMINATE, IF NECESSARY. H69 15990017 * 16020015 L GRB,PAROF(CNTL) POINT AT INIT LIST H235 16025001 L GRE,GENSWOF(GRB) SET DSECT BASE OF SWS IN AA H235 16030001 USING SWABAA,GRE H235 16035001 CLI MESSW,X'00' SEE IF ANY BUFFER MESSAGES I16 16040017 BC BE,MCD NO MESSAGES, SO WE ARE O.K. H69 16060017 SPACE 16080015 L LR,ZUERR(0,CNTL) PICK UP ADDRESS OF ERROR ROUTINE 16100015 SPACE 16120015 TM MESSW,X'80' NO RECFM. U ASSUMED. H69 16140017 BC BZ,PJ16 16160015 MVC PAR6+1(3,DICR),ERRF32 IEM3890I. H69 16180017 BALR RR,LR 16200015 SPACE 16220015 PJ16 TM MESSW,X'40' BLOCKSIZE GREATER THAN 100. H69 16240017 BC BZ,PJ181 16260015 MVC PAR6+1(3,DICR),ERRF33 IEM3891I. H69 16280017 BALR RR,LR 16300015 SPACE 16320015 PJ181 TM MESSW,X'10' BLKSIZE NOT MULTIPLE OF LRECL 16340015 BC BZ,PJ19 16360015 MVC PAR6+1(3,DICR),ERRF35 IEM3893I. H69 16380017 BALR RR,LR 16400015 SPACE 16420015 PJ19 TM MESSW,X'08' BLKSIZE NOT EQUAL LRECL 16440015 BC BZ,PJ20 16460015 MVC PAR6+1(3,DICR),ERRF36 IEM3894I. H69 16480017 BALR RR,LR 16500015 SPACE 16520015 PJ20 TM MESSW,X'04' LRECL GREATER THAN 100. H69 16540017 BC BZ,PJ21 H69 16560017 MVC PAR6+1(3,DICR),ERRF37 IEM3895I. H69 16580017 BALR RR,LR 16600015 SPACE 16620015 PJ21 TM MESSW,X'02' V - FORMAT. H69 16640017 BC BZ,PLIERRX H69 16660017 MVC PAR6+1(3,DICR),ERRF39 IEM3897I. H69 16680017 BALR RR,LR H69 16700017 * H69 16720017 * WE NOW TERMINATE IF THE BITS CORRESPONDING TO ANY OF H69 16740017 * THE TERMINAL ERROR MESSAGES ARE ON. H69 16760017 * THESE ARE X'40', X'10', X'08', X'04', X'02'. H69 16780017 * H69 16800017 PLIERRX TM MESSW,X'5E' HAS THERE BEEN A TERMINAL H69 16820017 BC BM,TERMIN ERROR.. TERMINATE IF SO. H69 16840017 DROP GRE H235 16870001 EJECT 16900015 * SIMILARLY, WE PUT IN THE DICTIONARY ANY SYSPUNCH AND I14 16930017 * SYLSIN ERROR MESSAGES NEEDED. THE CORRESPONDING OPTIONS I14 16960017 * HAVE ALREADY BEEN DELETED IF NECESSARY. I14 16990017 * I14 17020017 MCD TM PUNSW,X'07' ANY SYSPUNCH ERRORS.. I14 17050017 BZ PUNLIN71 BRANCH IF NOT. I14 17080017 * I14 17110017 TM PUNSW,X'01' WAS ERROR 'BLOCKSIZE NOT I14 17140017 * A MULTIPLE OF 80'.. I14 17170017 BZ PUNLIN62 BRANCH IF NOT. I14 17200017 MVC PAR6+1(3,DICR),ERRF30 PUT IEM3888I IN DICTIONARY I14 17230017 B PUNLIN69 I14 17260017 * I14 17290017 PUNLIN62 TM PUNSW,X'02' WAS ERROR 'BLOCKSIZE TOO I14 17320017 * BIG FOR THIS SIZE OPTION'.. I14 17350017 BZ PUNLIN63 BRANCH IF NOT. I14 17380017 MVC PAR6+1(3,DICR),ERRF49 PUT IEM3913I IN DICTIONARY I14 17410017 B PUNLIN69 I14 17440017 * I14 17470017 * SO ERROR WAS 'UNABLE TO I14 17500017 * OPEN'. I14 17530017 PUNLIN63 MVC PAR6+1(3,DICR),ERRF25 PUT IEM3877I IN DICTIONARY I14 17560017 * I14 17590017 PUNLIN69 L LR,ZUERR(0,CNTL) POINT AT ERROR HANDLER. I14 17620017 BALR RR,LR AND BRANCH TO IT. I14 17650017 SPACE 2 I14 17680017 PUNLIN71 TM LINSW,X'07' ANY SYSLIN ERRORS.. I14 17710017 BZ ENDMCD BRANCH IF NOT. I14 17740017 * I14 17770017 TM LINSW,X'01' WAS ERROR 'BLOCKSIZE NOT I14 17800017 * A MULTIPLE OF 80'.. I14 17830017 BZ PUNLIN72 BRANCH IF NOT. I14 17860017 MVC PAR6+1(3,DICR),ERRF31 PUT IEM3889I IN DICTIONARY I14 17890017 B PUNLIN79 I14 17920017 * I14 17950017 PUNLIN72 TM LINSW,X'02' WAS ERROR 'BLOCKSIZE TOO I14 17980017 * BIG FOR THIS SIZE OPTION'.. I14 18010017 BZ PUNLIN73 BRANCH IF NOT. I14 18040017 MVC PAR6+1(3,DICR),ERRF4A PUT IEM3914I IN DICTIONARY I14 18070017 B PUNLIN79 I14 18100017 * I14 18130017 * SO ERROR WAS 'UNABLE TO I14 18160017 * OPEN'. I14 18190017 PUNLIN73 MVC PAR6+1(3,DICR),ERRF23 PUT IEM3875I IN DICTIONARY I14 18220017 * I14 18250017 PUNLIN79 L LR,ZUERR(0,CNTL) POINT AT ERROR HANDLER. I14 18280017 BALR RR,LR AND BRANCH TO IT. I14 18310017 SPACE 2 I14 18340017 SPACE 3 18350017 * NOW WE PUT IN MESSAGES ABOUT CONFLICTING ATTRIBUTES. H169 18360017 * H169 18370017 ENDMCD TM CONFLICT,X'07' ANY SUCH ERRORS.. H169 18380017 BZ RDCD BRANCH IF NO ERRORS. H169 18390017 * H169 18400017 L LR,ZUERR(0,CNTL) PICK UP ADDR OF ERROR RTN. H169 18410017 * H169 18420017 TM CONFLICT,X'01' IEM3915I WANTED.. H169 18430017 BZ CONFLIC2 BRANCH IF NOT. H169 18440017 MVC PAR6+1(3,DICR),ERRF4B MOVE IN IEM3915I. H169 18450017 BALR RR,LR H169 18460017 * H169 18470017 CONFLIC2 TM CONFLICT,X'02' IEM3916I WANTED.. H169 18480017 BZ CONFLIC3 BRANCH IF NOT. H169 18490017 MVC PAR6+1(3,DICR),ERRF4C MOVE IN IEM3916I. H169 18500017 BALR RR,LR H169 18510017 * H169 18520017 CONFLIC3 TM CONFLICT,X'04' IEM3917I WANTED.. H169 18530017 BZ CONFLIC4 BRANCH IF NOT. H169 18540017 MVC PAR6+1(3,DICR),ERRF4D MOVE IN IEM3917I. H169 18550017 BALR RR,LR H169 18560017 * H169 18570017 CONFLIC4 B RDCD H169 18580017 * PTM825 18580501 * THIS IS THE I/O ERROR ROUTINE FOR SYSPRINT. IT IS ONLY USED IN PTM825 18581001 * IEMAB. THE DCBSYNAD IN AA IS CHANGED TO POINT HERE BY IEMAB ANDPTM825 18581501 * RESTORED TO THE MAIN I/O ERROR ROUTINE IN IEMAA BY IEMAB ON PTM825 18582001 * RETURN TO IEMAA. PTM825 18582501 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 077-TSS 18582719 USING *,15 GR 15 POINTS AT START OF SYNAD ON ENTRY PTM825 18583001 PRERRX SYNADAF ACSMETH=QSAM PTM825 18583501 L CNTLB,BASE1 SET UP THE BASE REGS PTM825 18584001 LM CNTL3,CNTL2,BASES PTM825 18584501 L CNTL4,BASE4 PTM825 18585001 DROP 15 PTM825 18585501 USING SECT1,CNTLB PTM825 18586001 USING SECT2,CNTL2 PTM825 18586501 USING SECT3,CNTL3 PTM825 18587001 USING SECT4,CNTL4 PTM825 18587501 LR GRC,GRA SAVE GRA UNTIL WTO FINISH H229 18587701 MVC 8(16,GRC),M3862A SET UP IEM3862I MESSAGE H229 18587901 MVC 24(56,GRC),49(GRC) & ERROR TYPE H229 18588101 MVC 6(2,GRC),MCSFLGS PICK UP MCS FLAGS H229 18588301 MVC 80(4,GRC),DESCRTCD & DESCRIPTOR & ROUTING CODESH229 18588501 LA GRA,76 SET LENGTH OF LIST H229 18588701 STH GRA,4(GRC) H229 18588901 LA GRA,4(GRC) POINT AT LIST H229 18589101 WTO ,MF=(E,(1)) ISSUE MESSAGE H229 18589301 MVC 17(5,GRC),M3862B SET UP REST OF MESSAGE H229 18589501 MVC 22(23,GRC),105(GRC) H229 18589701 MVC 45(4,GRC),DESCRTCD & DESCRIPTOR & ROUTING CODESH229 18589901 LA GRA,41 SET LENGTH OF LIST H229 18590101 STH GRA,4(GRC) H229 18590301 LA GRA,4(GRC) POINT AT LIST H229 18590501 WTO ,MF=(E,(1)) ISSUE MESSAGE H229 18590701 LR GRA,GRC RESTORE MSG POINTER H229 18590901 SYNADRLS PTM825 18591101 L GRC,PAROF(CNTL) POINT AT INIT LIST PTM825 18591301 L GRD,GENSWOF(GRC) HENCE AT GENSW AND NOCRSW PTM825 18591501 USING SWABAA,GRD H229 18591701 OI NOCRSW,X'0F' SET SW FOR SYSPRINT ERR IN AB H229 18591901 TM NOCRSW,X'F0' CAN WE USE COMMUNICATION REGION H229 18592101 BO KILL BRANCH IF NOT. H229 18592301 DROP GRD H229 18592501 L DICR,DADOF(0,GRC) GET DICTIONARY ADDRESS. PTM825 18592701 L DICR,0(0,DICR) AND POINT TO DICTIONARY PTM825 18592901 MVI IOERSW(DICR),X'FF' SHOW I/O ERROR PTM825 18593101 LA GR0,16 SHOW TERMINAL PTM825 18594501 ST GR0,ERCODE(0,DICR) ERROR PTM825 18595001 MVI PERRSW(DICR),X'FF' SET SWITCH FOR USE IN IEMAK PTM825 18595501 B KILL PTM825 18596001 BASE1 DC A(SECT1) IEMAB BASE FOR SYNAD PTM825 18596501 * ----------------------------------------------------AB 077-TSS 18597519 SPACE 2 18600015 EJECT 18602017 TEMP1 DS F 18604017 TEMP2 DS F 18606017 TEMP DS F 18608017 BASES DC A(SECT3) 18610017 DC A(SECT2) 18612017 BASE4 DC A(SECT4) 18614017 EJECT 18616017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 085-TSS 18617020 IEMAB1 CSECT 18618017 * ----------------------------------------------------AB 085-TSS 18619020 USING *,CNTL2 18620017 USING SECT1,CNTLB 18622017 USING SECT3,CNTL3 18624017 USING SECT4,CNTL4 18626017 SECT2 EQU * 18628017 EJECT 18660015 * THIS ROUTINE READS THE FIRST INPUT CARD AND IF NO HEAD- 18680015 * ING IS SUPPLIED BY THE OPTION SCANNER, THIS CARD IS USED BY 18700015 * THE CONTROL PHASE AS A HEADING. IT IS STORED TEMPORARILY IN 18720015 * THE DICTIONARY. WHEN THE FIRST COMPILER PHASE ISSUES A READ 18740015 * THEN THIS CARD IS PASSED TO THEM. THE PHASE HAS NO KNOWLEDGE 18760015 * OF THE FACT THAT THE CARD HAS BEEN PRE-READ. 18780015 SPACE 18800015 RDCD LA GRA,READSL+2(0,DICR) POINT AT TEMPORARY INPUT AREA 18820015 MVI 0(GRA),X'40' AND SET IT TO BLANKS. 20706 18826001 MVC 1(96,GRA),0(GRA) 20706 18832001 ST GRA,PAR1(0,DICR) 18840015 L GRB,PAROF(0,CNTL) EVENTUALLY POINT AT LOCATION IN 18860015 L GRB,HEDOF(0,GRB) CONTROL PHASE THAT WILL CONTAIN 18880015 L LR,ZURDOF(0,CNTL) THE HEADING 18900015 BALR RR,LR READ THE FIRST RECORD 18920015 BC B,LASTCD TAKE THIS BRANCH IF FIRST IS LST 18940015 SPACE 1 18942001 TM CCCODE+3(DICR),X'02' IS TRACE OR PATCH WANTED.. IEMAT 18944001 BNO NOTRACE2 BRANCH IF NOT. IEMAT 18946001 ST DICR,DICTEM SAVE R13. IEMAT 18948001 LA DICR,SAVAR POINT R13 AT SAVE AREA. IEMAT 18950001 L LR,PAROF(0,CNTL) POINT LR AT INITLSTN LIST IEMAT 18952001 L LR,ATADDROF(0,LR) HENCE AT ATADDR IEMAT 18954001 L LR,0(0,LR) AND HENCE AT IEMAT. IEMAT 18956001 BALR RR,LR LINK TO INIT IN IEMAT. IEMAT 18958001 L DICR,DICTEM RESTORE R13 AND BRANCH IEMAT 18960001 B LASTCD IF IEMAT FOUND 'LAST CARD'.IEMAT 18962001 L DICR,DICTEM IEMAT NORMALLY RTURNS HERE.IEMAT 18964001 SPACE 1 IEMAT 18966001 NOTRACE2 EQU * IEMAT 18968001 MVC READSL(2,DICR),PAR2+2(DICR) INSERT THE TRUE LENGTH 18980015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 067-TSS 19000020 MVC 10(97,GRB),0(GRA) MOVE FIRST CARD INTO HEADNG20706 19080001 CLC ZCNCHR(2,DICR),ZEROS 19220015 BC BE,ENDRD BRANCH IF NO CNTL CHAR 19240015 LH GRC,ZCNCHR(DICR) 19260015 * ----------------------------------------------------AB 067-TSS 19270020 LA GRC,0(GRB,GRC) POINT AT BYTE AFTER CTL CHAR IN AREA 19280015 MVI 9(GRC),X'40' BLANK CNTL CHAR 19300015 ENDRD OI CCCODE+2(DICR),X'01' SET SWITCH FOR FIRST CARD READ 19400015 BC B,EJPAG 19420015 SPACE 19440015 LASTCD L R3,PAROF(0,CNTL) POINT AT ADDLST 19460015 L R3,GENSWOF(0,R3) POINT AT SWITCH 19480015 CLI 0(R3),X'00' IS IT OFF 19500015 BC BNE,NOTFST IF SO, SHOW THAT BATCH 19520015 MVI 0(R3),X'F0' CARD IS FIRST CARD IN SYSIN 19540015 NOTFST CLI READSW,X'FF' SEE IF HEADING SUPPLIED 19560015 BC BNE,NOHED 19580015 MVC 0(120,GRB),HEDING PICK UP SUPPLIED HEADING 19600015 NOHED MVC PAR6+1(3,DICR),ERR90 SAY NO STATEMENTS 19620015 L LR,ZUERR(0,CNTL) 19640015 BALR RR,LR MAKE THE ENTRY 19660015 MVI TERMSW(DICR),X'FF' TELL AA TO ABEND COMPILER 19680015 TM CCCODE+1(DICR),X'03' CHAR48 OR MACRO 19700015 BC BO,CHECKSP BRANCH IF NOT 19720015 L GRB,ZUBW(CNTL) POINT AT IEMAC 19740015 L GRB,BWOFF(GRB) HENCE AT SYSUT3 19760015 USING IHADCB,GRB 19780015 TM DCBOFLGS,X'10' IS FILE OPEN 19800015 DROP GRB 19820015 BC BZ,CHECKSP BRANCH IF NOT 19840015 CLOSE ((GRB)) CLOSE FILE 19860015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 037-TSS 19872019 FREEPOOL (GRB) FREE BUFFERS 19880015 * ----------------------------------------------------AB 037-TSS 19886019 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 008-TSS 19892019 LA GR0,BWNAME POINT AT PHASE IEMAC 19900015 DELETE EPLOC=(0) DELETE IT 19920015 * ----------------------------------------------------AB 008-TSS 19930019 BC B,CHECKSP 19940015 BC B,CHECKSP 19960015 SPACE 19980015 * 20000015 * EJECT TO A NEW PAGE SINCE READIN WILL NOT 20020015 * 20040015 EJPAG TM CCCODE+2(DICR),X'80' SEE IF SOURCE REQUIRED 20060015 BC BZ,EJONE EJECT IF IT IS 20080015 TM CCCODE+2(DICR),X'10' SEE IF SOURCE2 REQUIRED 20100015 BC BZ,CHECKSP DONT EJECT IF NO SOURCE2 20120015 SPACE 20140015 EJONE LA GR0,EJECT POINT AT EJECT CONTROL 20160015 ST GR0,PAR1(0,DICR) 20180015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 045-TSS 20186019 * ----------------------------------------------------AB 045-TSS 20192019 L LR,ZUPLOF(0,CNTL) 20200015 BALR RR,LR 20220015 EJECT 20240015 * CHECK THE SPILL FILE TO ENSURE IT WAS OPENED CORRECTLY 20260015 * OR NOT AT ALL. IF NOT ISSUE MESSAGE ON SYSPRINT. 20280015 * 20300015 CHECKSP CLI OPENSW,X'00' TEST IF SYSUT1 OK 20320015 BC BE,ABOUT YES,GO TO AB EXIT ROUTINE 20340015 * 20360015 LA GR0,SPLMES NO,POINT AT ERR MSG 'UNABLE TO 20380015 ST GR0,PAR1(DICR) OPEN SYSUT1' 20400015 L LR,ZUPLOF(CNTL) LINK TO ZUPL 20420015 BALR RR,LR 20440015 * 20460015 * FALL THROUGH TO ABEND EXIT 20480015 SPACE 10 20500015 * SHOW AA COMPILER CANNOT CONTINUE 20520015 * 20540015 TERMIN MVI TERMSW(DICR),X'FF' TELL AA TO TERMINATE COMPILER 20560015 MVI IOERSW(DICR),X'FF' TELL AA BATCHING NOT POSSIBLE 20580015 LA GR0,16 SET TERMINAL ERROR CODE 20600015 ST GR0,ERCODE(DICR) 20620015 * FALL THROUGH AB RETURN ROUTINE 20640015 SPACE 10 20660015 * RETURN TO PRE INITIALISER IN AA TO DELETE AB AND 20680015 * CONTINUE OR ABEND, OR KILL. 20700015 * 20720015 ABOUT LA LR,4 SET RETURN CODE TO OK OR ABEND 20740015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 036-TSS 20746019 * ----------------------------------------------------AB 036-TSS 20752019 BC B,ABOUTA 20760015 * 20780015 ABOUTK LA LR,0 SET RETURN CODE TO KILL 20800015 * 20820015 USING IHADCB,GRC PTM825 20823001 ABOUTA L GRC,PAROF(0,CNTL) POINT AT INIT LIST PTM825 20826001 AIF (NOT &STD).L4 54703 20826621 LA GRD,TRANOF(0,GRC) PICK UP ADDR OF TRANS TABS 54703 20827221 MVC ZTRAN1(8,DICR),0(GRD) INSERT IN ZTRAN1,2 ,POINT 54703 20827821 .L4 ANOP 54703 20828421 L GRC,PLOF(0,GRC) HENCE AT SYSPRINT DCB PTM825 20829001 L GRD,PRSYNAA RESTORE PTM825 20832001 LTR GRD,GRD SYNAD ADDR IN IEMAA UNLESS PTM825 20836001 BZ ABOUTB SAVE AREA UNUSED - EARLY TERM PTM825 20840001 ST GRD,DCBSYNAD PTM825 20844001 DROP GRC PTM825 20848001 ABOUTB LA DICR,SAVAR POINT AT SAVE AREA PTM825 20852001 L DICR,4(DICR) POINT AT PREVIOUS SAVE AREA 20860015 L 14,12(DICR) RELOAD R14 20880015 LM 0,9,20(DICR) RELOAD R0 TO R9 20900015 MVI 12(DICR),X'FF' SHOW RETURN IS COMPLETE 20920015 BCR BR,RR RETURN TO AA 20940015 EJECT PTM825 20960001 * THE KILL ROUTINE IS USED WHEN AB WISHES TO ABORT,BUT 20980015 * CANNOT USE THE ZEND ROUTINE IN AA BECAUSE THE DICTIONARY HAS 21000015 * NOT BEEN SET UP. THE ROUTINE ENSURES THAT SYSIN AND SYSPRINT 21020015 * ARE CLOSED. 21040015 * 21060015 KILL SR GRB,GRB ZERO GRB 21080015 L GRC,PAROF(CNTL) POINT AT INITIALISATION LIST 21100015 USING IHADCB,GRD 21120015 NXTDCB EX 0,LADCB(GRB) LOAD ADDR OF REQD DCB 21140015 TM DCBOFLGS,X'10' TEST IF DCB IS OPEN 21160015 BC BZ,NOTOPN NO,GO TO FIND NEXT DCB 21180015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 043-TSS 21190019 CLOSE ((GRD)) YES,CLOSE FILE 21200015 * ----------------------------------------------------AB 043-TSS 21206019 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 038-TSS 21212019 FREEPOOL (GRD) 21220015 * ----------------------------------------------------AB 038-TSS 21230019 NOTOPN LA GRB,4(GRB) BUMP GRB TO NEXT DCB 21240015 BC B,NXTDCB 21260015 * 21280015 LADCB L GRD,RDOF(GRC) LOAD ADDR OF SYSIN 21300015 L GRD,PLOF(GRC) LOAD ADDR OF SYSPRINT 21320015 BC B,ABOUTK GO TO AB RETURN ROUTINE 21340015 DROP GRD 21360015 EJECT 21380015 * 21400015 * THIS ROUTINE WILL CONVERT A BINARY WORD TO UNPACKED 21420015 * DECIMAL. THE PRINTING ROUTINE WILL PICK UP THE REQUIRED NUMBER 21440015 * OF DIGITS. 21460015 * 21480015 CONBIN CVD GRA,PDECF CONVERT TO PACKED DECIMAL 21500015 UNPK UDECF(8),PDECF+4(4) UNPACK FIELD 21520015 OI UDECF+7,X'F0' CLEAR ZONE 21540015 BCR BR,RR 21560015 SPACE 21580015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 003-TSS 21590019 * 21600015 * SAY PERMANENT I/O ERROR FOUND DURING BLDL OPERATION. 21620015 * COMPILATION CANNOT CONTINUE. 21640015 * 21660015 BLDERR L GRA,PAROF(0,CNTL) POINT AT SYSPRINT DCB 21680015 L GRA,PLOF(0,GRA) 21700015 PUT (1) FIND BUFFER SPACE 21720015 MVC 0(46,GRA),BLDMES INSERT I/O ERROR MESSAGE 21740015 BC B,KILL 21760015 * ----------------------------------------------------AB 003-TSS 21770019 EJECT 21780015 * THIS ROUTINE IS ENTERED DURING THE OPENING OF SYSIN. H69 21784017 * 21788017 * JUST BEFORE OPENING SYSIN, IEMAB STORES THE ADDRESS OF 21792017 * THIS ROUTINE IN THE OPEN-EXIT SLOT IN THE DCB FOR SYSIN, WHICH 21796017 * IS IN IEMAA. 21800017 * 21804017 * THIS ROUTINE CHECKS THAT THE RECORD FORMAT DEFINED FOR 21808017 * SYSIN IS ACCEPTABLE. THE FORMAT MAY HAVE BEEN SPECIFIED IN 21812017 * THE DD STATEMENT OR MAY HAVE BEEN OBTAINED FROM THE DSCB OF 21816017 * AN EXISTING DATA-SET. 21820017 * 21824017 * THE ACCEPTABLE FORMATS ARE - 21828017 * 1. FIXED UNBLOCKED RECORDS WITH LOGICAL RECORD 21832017 * LENGTH UP TO 100. 21836017 * 2. FIXED BLOCKED RECORDS; LOGICAL RECORD LENGTH UP 21840017 * TO 100; BLOCKSIZE MUST BE AN EXACT MULTIPLE OF THE 21844017 * RECORD LENGTH. THERE IS ALWAYS SPACE FOR A BLOCK- 21848017 * SIZE OF UP TO 500; LARGER BLOCKSIZES ARE ACCEPTABLE 21852017 * IF THERE IS ENOUGH SPACE. 21856017 * 3. UNDEFINED FORMAT RECORDS WITH LOGICAL RECORD 21860017 * LENGTH UP TO 100. 21864017 * 21868017 * IF ERRORS ARE FOUND, FLAGS ARE SET IN MESSW, AND LATER, 21872017 * AT PJ13, THE APPROPRIATE ERROR MESSAGES ARE PUT IN THE DICT- 21876017 * IONARY AND THE COMPILATION TERMINATED. IT HAS TO BE DONE IN 21880017 * THIS WAY, AS THE DICTIONARY IS NOT YET SET UP. 21884017 * 21888017 * IF A BLOCKSIZE GREATER THAN 500 IS SPECIFIED, A FLAG IS 21892017 * SET AND THE NECESSARY CHECKING IS DONE LATER, AFTER THE SIZE 21896017 * OPTION HAS BEEN PROCESSED. H69 21900017 SPACE 21920015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 051-TSS 21930019 PLINEX LA GRA,0(0,GRA) CLEAR OUT TO BYTE IN ADDRESS 21940015 L GRB,PAROF(CNTL) POINT AT INIT LIST H235 21945001 L GRF,GENSWOF(GRB) SET DSECT BASE OF SWS IN AA H235 21950001 USING SWABAA,GRF H235 21955001 USING IHADCB,GRA 21960015 LH GRB,DCBLRECL PICK UP RECORD LENGTH 21980015 LH GRC,DCBBLKSI PICK UP BLOCK SIZE 22000015 MVC RECM(1),DCBRECFM PICK UP RECORD FORMAT TYPE 22020015 DROP GRA 22040015 STM GRB,GRC,LRECL STORE LRECL AND BLKSIZE 22060015 SPACE 22080015 LTR GRB,GRB SEE IF LRECL=0 22100015 BC BNZ,TBLK 22120015 OI PLINSW,X'80' SHOW LRECL=0 22140015 TBLK LTR GRC,GRC SEE IF BLOCKSIZE=0 22160015 BC BNZ,NBLK 22180015 OI PLINSW,X'40' SHOW BLKSIZE=0 22200015 * H69 22210017 * WHAT RECORD FORMAT HAS BEEN SPECIFIED.. H69 22220017 * H69 22230017 NBLK TM RECM,X'C0' U-FORMAT.. H69 22240017 BC BO,PL21 BRANCH IF SO. H69 22250017 TM RECM,X'80' F-FORMAT.. H69 22260017 BC BO,PL31 BRANCH IF SO. H69 22270017 TM RECM,X'40' V-FORMAT.. (ILLEGAL) H69 22280017 BC BO,PLERR1 BRANCH IF SO. H69 22290017 * H69 22300017 * SO THE FORMAT HAS NOT BEEN SPECIFIED. H69 22310017 * WE ARE FAIRLY SAFE TO SET IT TO U-FORMAT. H69 22320017 * H69 22330017 OI MESSW,X'80' CAUSE IEM3890I TO BE PUT IN H69 22340017 * THE DICTIONARY LATER. H69 22350017 USING IHADCB,GRA H69 22360017 MVI DCBRECFM,X'C0' SET THE DCB TO U-FORMAT. H69 22370017 DROP GRA H69 22380017 * H69 22390017 * WE NOW KNOW WE ARE DEALING WITH U-FORMAT RECORDS. H69 22400017 * H69 22410017 PL21 OI MESSW,X'01' SHOW WE ARE USING U-FORMAT. H69 22420017 TM PLINSW,X'40' IS THE BLOCKSIZE ZERO.. H69 22430017 BC BO,PL22 BRANCH IF SO, TO SET TO 100 H69 22440017 CL GRC,ONEH IS THE BLOCKSIZE GREATER H69 22450017 BC BH,PLERR2 THAN 100.. BRANCH IF SO. H69 22460017 BC B,R BLOCKSIZE O.K. H69 22470017 * H69 22480017 PL22 MVC BLKSIZE(4),ONEH SET THE BLOCKSIZE TO 100. H69 22490017 BC B,R WE ARE NOW O.K. H69 22500017 * H69 22510017 * WE NOW KNOW WE ARE DEALING WITH FIXED FORMAT RECORDS. H69 22520017 * H69 22530017 PL31 TM RECM,X'10' BLOCKED.. H69 22540017 BC BO,PL41 BRANCH IF SO. H69 22550017 TM PLINSW,X'40' IS THE BLOCKSIZE ZERO.. H69 22560017 BC BO,PL41 BRANCH IF SO. H69 22570017 CL GRC,ONEH IS THE BLOCKSIZE GREATER H69 22580017 BC BH,PLERR2 THAN 100.. BRANCH IF SO. H69 22590017 * H69 22600017 * SO WE HAVE FIXED UNBLOCKED RECORDS WITH VALID BLOCKSIZE. H69 22610017 * H69 22620017 TM PLINSW,X'80' IS THE LRECL ZERO.. H69 22630017 BC BO,PL32 BRANCH IF SO. H69 22640017 CR GRC,GRB DOES THE LRECL EQUAL THE H69 22650017 BC BNE,PLERR3 BLOCKSIZE.. BRANCH IF NOT. H69 22660017 BC B,R WE HAVE GOOD FIXED H69 22670017 * UNBLOCKED RECORDS. H69 22680017 * H69 22690017 PL32 ST GRC,LRECL SET THE LRECL EQUAL TO THE H69 22700017 BC B,R BLOCKSIZE. WE ARE NOW O.K. H69 22710017 * H69 22720017 * WE NOW HAVE FIXED FORMAT RECORDS, H69 22730017 * EITHER BLOCKED OR WITH A BLOCKSIZE OF ZERO. H69 22740017 * IN EITHER CASE, WE NOW CHECK THE LRECL. H69 22750017 * H69 22760017 PL41 TM PLINSW,X'80' IS THE LRECL ZERO.. H69 22770017 BC BO,PL42 BRANCH IF SO H69 22780017 * TO SET IT TO 80. H69 22790017 CL GRB,ONEH IS THE LRECL GREATER THAN H69 22800017 BC BH,PLERR4 100.. BRANCH IF SO. H69 22810017 * H69 22820017 PL43 TM PLINSW,X'40' IS THE BLOCKSIZE ZERO.. H69 22830017 BC BZ,PL51 BRANCH IF NOT. (IF WE ARE H69 22840017 * DEALING WITH FIXED BLOCKED H69 22850017 * RECORDS.) H69 22860017 ST GRB,BLKSIZE SET THE BLOCKSIZE EQUAL TO H69 22870017 * THE LRECL. H69 22880017 * H69 22890017 * WE ARE NOW O.K. THE LRECL WAS EITHER VALID, H69 22900017 * OR IT WAS ZERO AND WE SET IT TO 80. H69 22910017 * THE BLOCKSIZE WAS ZERO, AND WE SET IT EQUAL TO THE LRECL. H69 22920017 * H69 22930017 BC B,R H69 22940017 SPACE 2 H69 22950017 * WE ARE HERE DEALING WITH FIXED RECORDS, AND HAVE FOUND H69 22960017 * THAT THE LRECL IS ZERO. EITHER THE BLOCKSIZE WAS ZERO, H69 22970017 * OR WE ARE DEALING WITH BLOCKED RECORDS. H69 22980017 * IN EITHER CASE, WE SET THE LRECL TO 80. H69 22990017 * H69 23000017 PL42 MVC LRECL(4),ETY H69 23010017 L GRB,LRECL H69 23015017 BC B,PL43 H69 23020017 SPACE 2 H69 23030017 * WE ARE NOW DEALING WITH FIXED BLOCKED RECORDS. H69 23040017 * H69 23050017 PL51 XR GRD,GRD CLEAR GRD, H69 23060017 LR GRE,GRC MOVE IN BLOCKSIZE H69 23070017 DR GRD,GRB AND DIVIDE BY LRECL. H69 23080017 LTR GRD,GRD IS THE REMAINDER ZERO.. H69 23090017 BC BNZ,PLERR5 BRANCH IF NOT. H69 23100017 * H69 23110017 * SO THE BLOCKSIZE IS A MULTIPLE OF THE LRECL. H69 23120017 * WE NOW CHECK TO SEE IF THE BLOCKSIZE IS GREATER THAN 500. H69 23130017 * H69 23140017 CL GRC,FIVEH IS BLOCKSIZE GREATER.. H69 23150017 BC BNH,R BRANCH IF NOT. H69 23160017 OI MESSW,X'20' TELL PEOPLE THAT THE BLOCK- H69 23170017 * SIZE IS GREATER THAN 500, SO H69 23180017 * THAT THEY DO THE NECESSARY H69 23190017 * CHECKING. H69 23200017 BC B,R AND LEAVE. H69 23210017 SPACE 3 H69 23220017 * SET BITS ON IN MESSW TO CAUSE THE APPROPRAITE ERROR H69 23230017 * MESSAGES TO BE PUT IN THE DICTIONARY LATER. H69 23240017 * H69 23250017 PLERR1 OI MESSW,X'02' MESSAGE IEM3897I. H69 23260017 BCR BR,RR RETURN TO OPEN. H69 23270017 * H69 23280017 PLERR2 OI MESSW,X'40' MESSAGE IEM3891I. H69 23290017 BCR BR,RR RETURN TO OPEN. H69 23300017 * H69 23310017 PLERR3 OI MESSW,X'08' MESSAGE IEM3894I. H69 23320017 BCR BR,RR RETURN TO OPEN. H69 23330017 * H69 23340017 PLERR4 OI MESSW,X'04' MESSAGE IEM3895I. H69 23350017 BCR BR,RR RETURN TO OPEN. H69 23360017 * H69 23370017 PLERR5 OI MESSW,X'10' MESSAGE IEM3893I. H69 23380017 BCR BR,RR RETURN TO OPEN. H69 23390017 DROP GRF H235 23395001 SPACE 3 H69 23400017 * NORMAL EXIT. H69 23410017 * IF THE BLOCKSIZE OR LRECL WERE ZERO, WE WILL HAVE H69 23420017 * GENERATED DEFAULTS. WE NOW MOVE THESE INTO THE DCB. H69 23430017 SPACE 23780015 USING IHADCB,GRA 23800015 R MVC DCBBLKSI(2),BLKSIZE+2 SET UP BLOCK SIZE IN DCB 23820015 MVC DCBLRECL(2),LRECL+2 SET UP LRECL IN DCB 23840015 DROP GRA 23860015 BCR BR,RR RETURN TO OPEN 23880015 * ----------------------------------------------------AB 051-TSS 23890019 EJECT 23900015 * THIS ROUTINE CHECKS BLKSIZE ALLOCATION FOR SYSPRINT DCB. 23920015 * IF NONE SPECIFIED THEN 129 IS TAKEN. A MAXIMUM BLOCKSIZE OF 23940015 * 629 IS ALWAYS ALLOWED (5 RECORDS & 4). IF ENOUGH SPACE IS H69 23948017 * AVAILABLE A LARGER BLOCKSIZE IS ALLOWED. WE CHECK TO SEE H69 23956017 * WHETHER THERE IS ENOUGH SPACE AFTER PROCESSING THE SIZE H69 23964017 * OPTION. H69 23972017 SPACE 23980015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 052-TSS 23990019 PRINEX ST GRC,TEMP1 SAVE GRC 24000015 LA GRA,0(GRA) 24020015 USING IHADCB,GRA 24040015 LH GRC,DCBBLKSI PICK UP BLOCKSIZE 24060015 DROP GRA 24080015 LTR GRC,GRC SEE IF BLOCKSIZE=0 24100015 BC BZ,SET129 24120015 XR GRB,GRB TEST WHETHER 24140015 D GRB,ONE25 BLKSIZE=4+N*125 24160015 C GRB,OP4 24180015 BC BNE,PRTERR BRANCH IF NOT 24200015 C GRC,OP1 SEE IF BLOCKSIZE LARGE 24220015 BC BH,LGBLOK BRANCH IF SO 24240015 BC B,REND 24260015 SPACE 2 H69 24270017 SET129 LA GRB,129 24280015 USING IHADCB,GRA 24300015 STH GRB,DCBBLKSI MAKE BLOCKSIZE 129 24320015 DROP GRA 24340015 REND L GRC,TEMP1 PICJ UP GRC 24360015 BCR BR,RR 24380015 SPACE 2 H69 24390017 * NOTE THAT USER HAS LARGE BLKSIZE 24400015 LGBLOK L GRB,PAROF(CNTL) POINT AT INIT LIST H235 24406001 L GRE,GENSWOF(GRB) SET DSECT BASE OF SWS IN AA H235 24412001 USING SWABAA,GRE H235 24418001 MVI BUFSW,X'FF' SHOW LARGE BUFFERS H235 24424001 DROP GRE H235 24430001 BC B,REND 24440015 SPACE 2 H69 24450017 * ERROR 24460015 PRTERR ST GRA,TEMP SAVE GRA 24480015 * MCS R18 24490001 WTO 'IEM3896I SYSPRINT BLOCKSIZE IS NOT OF FORM 4 +N*125', C24500001 ROUTCDE=(2,11),DESC=6 MCS 43462 24510021 L GRA,TEMP RESTORE REG 1 24520015 MVI DUDPRINT,X'FF' SHOW THAT WE MUST ABEND. H69 25520017 BC B,REND H69 26520017 * ----------------------------------------------------AB 052-TSS 27420019 EJECT 28340015 * SYSPUNCH OPEN EXIT LIST AND ROUTINE 28340217 * 28340417 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 053-TSS 28340519 SPEXAD DC AL3(SPEXL) ADDR OF EXIT LIST 28340617 DS 0F 28340817 SPEXL DC X'85' EXIT LIST 28341017 DC AL3(SPEX) ADDR OF EXIT ROUTINE 28341217 * 28341417 * NOTE THAT THIS ROUTINE IS USED BY BOTH SYSPUNCH AND I14 28341617 * AND SYSLIN. IF WE ARE OPENING SYSPUNCH, THEN RSW POINTS I14 28341817 * AT PUNSW; IF OPENING SYSLIN, THEN RSW POINTS AT LINSW. I14 28342017 SPACE 2 28342217 USING IHADCB,GRA I14 28342417 SPEX LH GRE,DCBBLKSI PICK UP BLOCKSIZE FROM DCB. I14 28342617 MVI DCBBUFNO,X'01' SAY ONE BUFFER ONLY. I14 28342817 DROP GRA I14 28343017 LTR GRE,GRE IS THE BLOCKSIZE ZERO.. I14 28343217 BE SETB80 BRANCH IF SO. I14 28343417 * I14 28343617 XR GRD,GRD I14 28343817 D GRD,ETY DIVIDE BLOCKSIZE BY 80. I14 28344017 LTR GRD,GRD IS THE REMAINDER ZERO.. I14 28344217 BNE BLSZNX80 BRANCH IF NOT. I14 28344417 * I14 28344617 USING IHADCB,GRA I14 28344817 LH GRE,DCBBLKSI PICK UP BLOCKSIZE AGAIN. I14 28345017 DROP GRA I14 28345217 CL GRE,FOURHN IS BLOCKSIZE > 400.. I14 28345417 BH BLSZTB BRANCH IF SO. I14 28345617 BR RR OTHERWISE RETURN TO OPEN. I14 28345817 * I14 28346017 * BLOCKSIZE GREATER THAN 400 ASKED FOR. I14 28346217 * I14 28346417 BLSZTB L GRD,CORAVL BRING IN THE CORE-AVAILABLE I14 28346617 A GRD,F400 MAKE ALLOWANCE FOR THE 400 I14 28346817 * BYTES OF BUFFER SPACE I14 28347017 * INCLUDED IN THE BASIC 44K. I14 28347217 SR GRD,GRE SUBTRACT THE SPACE NEEDED I14 28347417 * FOR THE BIG BUFFER. I14 28347617 BL BLSZTB2 BRANCH IF WE HAVE RUN OUT I14 28347817 * OF SPACE. I14 28348017 ST GRD,CORAVL STORE THE REDUCED CORE I14 28348217 * AVAILABLE BACK INTO CORAVL. I14 28348417 BR RR RETURN TO OPEN. I14 28348617 * I14 28348817 * NOT ENOUGH SPACE FOR BIG BUFFER. I14 28349017 * I14 28349217 BLSZTB2 OI 0(RSW),X'02' SET BIT ON IN PUNSW OR LINSW I14 28349417 * TO SAY SO. I14 28349617 B BLSZSTOR I14 28349817 * I14 28350017 * BLOCKSIZE NOT A MULTIPLE OF 80. I14 28350217 * I14 28350417 BLSZNX80 OI 0(RSW),X'01' SET BIT ON IN PUNSW OR LINSW I14 28350617 * TO SAY SO. I14 28350817 * I14 28351017 * STORE THE USERS BLOCKSIZE, I14 28351217 * SO THAT WE CAN RESET IT BEFORE CLOSING. I14 28351417 * I14 28351617 BLSZSTOR ST GRE,HOLDBSZ I14 28351817 * I14 28352017 * SET THE BLOCKSIZE TO 80. I14 28352217 * I14 28352417 SETB80 L GRD,ETY I14 28352617 USING IHADCB,GRA I14 28352817 STH GRD,DCBBLKSI I14 28353017 DROP GRA * I14 28353217 BR RR RETURN TO OPEN. I14 28353417 * ----------------------------------------------------AB 053-TSS 28353519 EJECT 28353617 * CHECK INVOCATION PARAMETER LIST TO SEE IF ALTERNATE 28360015 * DDNAMES AND A STARTING PAGE NUMBER HAVE BEEN SUPPLIED 28380015 SPACE 28400015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 032-TSS 28410019 INVOKEPR ST R1,OPRGSV0 SAVE PARM LIST POINTER 28420015 TM 0(R1),X'80' IS THERE MORE THAN ONE POINTER 28440015 BC BO,OPNFILES BRANCH IF NO DDNAMES OR PAGE NBR 28460015 SPACE 28462016 * ARE WE BATCHING.. IF SO GO STRAIGHT TO OPNFILES. 15667 28464016 SPACE 28466016 L R2,PAROF(CNTL) 15667 28468016 L R2,DADOF(R2) 15667 28470016 TM 0(R2),X'80' 15667 28472016 BC BO,OPNFILES 15667 28474016 SPACE 28480015 * NOT THE END OF THE INVOCATION PARM LIST SO NOW CHECK TO 28500015 * SEE IF ALTERNATE DDNAMES HAVE BEEN SUPPLIED 28520015 SPACE 28540015 LA R1,4(0,R1) BUMP TO DDNAME PTR IN PARM LIST 28560015 ST R1,OPTEMP SAVE PARM PTR FOR LATER USE 28580015 L R1,0(0,R1) PICK UP DDNAME PTR 28600015 L R5,PAROF(CNTL) POINT AT INITIALIZATION LIST 28620015 * 28640015 LTR R1,R1 TEST IF DDNAME LIST EXISTS 28660015 BC BZ,INVOK9 NO, OMIT DDNAME PROCESSING 28680015 LH R2,0(R1) LOAD NO OF BYTES IN DDNAME LIST 28700015 LTR R2,R2 TEST IF DDNAME LIST IS EMPTY 28720015 BC BZ,INVOK9 NO, OMIT DDNAME PROCESSING 28740015 * 28760015 USING IHADCB,R6 ESTABLISH DCB ADDRESSABILITY 28780015 * 28800015 LA R1,2(0,R1) BUMP PTR OVER LENGTH COUNT 28820015 AR R2,R1 COMPUTE LAST ADDRESS PLUS ONE 28840015 SPACE 28860015 * SEE IF ALTERNATE FOR SYSLIN HAS BEEN SUPPLIED 28880015 SPACE 28900015 L R5,PAROF(0,CNTL) POINT AT INIT LIST 28920015 CLC 0(8,R1),OPZERO IS ALTERNATE NAME SUPPLIED 28940015 BC BE,INVOK3 BRANCH IF NOT 28960015 L R6,LFDCB(0,R5) POINT AT SYSLIN DCB 28980015 MVC DCBDDNAM(8),0(R1) INSERT ALT NAME IN SYSLIN DCB 29000015 INVOK3 LA R1,24(0,R1) BUMP DD POINTER TO SYSLIB SLOT 29020015 CLR R1,R2 IS IT END OF DDLIST 29040015 BC BNL,INVOK9 BRANCH IF END OF LIST 29060015 SPACE 29080015 * SEE IF ALTERNATE NAME FOR SYSLIB HAS BEEN SUPPLIED 29100015 SPACE 29120015 CLC 0(8,R1),OPZERO IS ALT FOR SYSLIB SUPPLIED 29140015 BC BE,INVOKA BRANCH IF NOT 29160015 L R6,SLIBOF(0,R5) * POINT AT ALT DDNAME SLOT 60069 29180072 MVC 0(8,R6),0(R1) * SAVE ALT DDNAME 60069 29190072 INVOKA LA R1,8(0,R1) BUMP DD POINTER TO SYSIN SLOT 29200015 CLR R1,R2 IS IT END OF DDLIST 29220015 BC BNL,INVOK9 BRANCH IF YES 29240015 SPACE 29260015 * SEE IF ALTERNATE FOR SYSIN HAS BEEN SUPPLIED 29280015 SPACE 29300015 CLC 0(8,R1),OPZERO IS ALT FOR SYSIN SUPPLIED 29320015 BC BE,INVOK4 BRANCH IF NOT 29340015 L R6,RDOF(0,R5) POINT AT SYSIN DCB 29360015 MVC DCBDDNAM(8),0(R1) INSERT ALT NAME IN SYSIN DCB 29380015 INVOK4 LA R1,8(0,R1) BUMP DDPTR TO SYSPRINT SLOT 29400015 CLR R1,R2 IS IT END OF DDLIST 29420015 BC BNL,INVOK9 BRANCH IF YES 29440015 SPACE 29460015 * SEE IF ALT FOR SYSPRINT HAS BEEN SUPPLIED 29480015 SPACE 29500015 CLC 0(8,R1),OPZERO IS THERE AN ALT FOR SYSPRINT 29520015 BC BE,INVOK5 BRANCH IF NOT 29540015 L R6,PLOF(0,R5) POINT AT SYSPRINT DCB 29560015 MVC DCBDDNAM(8),0(R1) INSERT ALT NAME 29580015 INVOK5 LA R1,8(R1,0) BUMP DDPTR TO SYSPUNCH SLOT 29600015 CLR R1,R2 IS IT END OF DDLIST 29620015 BC BNL,INVOK9 BRANCH IF YES 29640015 SPACE 29660015 * SEE IF ALT FOR SYSPUNCH HAS BEEN SUPPLIED 29680015 SPACE 29700015 CLC 0(8,R1),OPZERO IS THERE A SYSPUNCH ALTERNATE 29720015 BC BE,INVOK6 BRANCH IF NOT 29740015 L R6,SYPDCB(0,R5) POINT AT SYSPUNCH DCB 29760015 MVC DCBDDNAM(8),0(R1) INSERT ALT NAME 29780015 INVOK6 LA R1,8(R1,0) BUMP DDPTR TO SYSUT1 SLOT 29800015 CLR R1,R2 IS IT END OF DDLIST 29820015 BC BNL,INVOK9 BRANCH IF YES 29840015 SPACE 29860015 * SEE IF ALT FOR SYSUT1 HAS BEEN SUPPLIED 29880015 SPACE 29900015 CLC 0(8,R1),OPZERO IS THERE A SYSUT1 ALT 29920015 BC BE,INVOK7 BRANCH IF NOT 29940015 L R6,SPDCB(0,R5) POINT AT SYSUT1 DCB 29960015 MVC DCBDDNAM(8),0(R1) INSERT ALT NAME 29980015 INVOK7 LA R1,8(0,R1) BUMP DDPTR TO SYSUT2 SLOT 30000015 CLR R1,R2 IS IT END OF DDLIST 30020015 BC BNL,INVOK9 BRANCH IF END 30040015 SPACE 1 30060072 DROP R6 60069 30070072 SPACE 1 30080072 * SEE IF SYSUT2,SYSUT3 ALT NAMES SUPPLIED 60069 30090072 SPACE 30100015 CLC 0(8,R1),OPZERO IS THERE AN ALT FOR SYSUT2 30120015 BC BE,INVOK8 BRANCH IF NOT 30140015 MVC SYSUT2(8),0(R1) MOVE ALT NAME TO COMMON SLOT 30160015 INVOK8 LA R1,8(0,R1) BUMP DDPTR TO SYSUT3 SLOT 30180015 CLR R1,R2 IS IT END OF DDLIST 30200015 BC BNL,INVOK9 BRANCH IF END 30220015 SPACE 30240015 CLC 0(8,R1),OPZERO IS ALT NAME SUPPLIED 30260015 BC BE,INVOK9 BRANCH IF NOT 30280015 L R6,SUT3OF(0,R5) * POINT AT ALT DDNAME SLOT 60069 30300072 MVC 0(8,R6),0(R1) * SAVE THE ALT DDNAME 60069 30320072 SPACE 30340015 * THE DDNAME LIST IS PROCESSED,NOW CHECK TO SEE THERE ARE 30360015 * ANYMORE INVOCATION PARAMETERS 30380015 SPACE 30400015 INVOK9 L R1,OPTEMP 30420015 TM 0(R1),X'80' IS IT END OF LIST 30440015 BC BO,OPNFILES BRANCH IF NO STARTING PAGE NBR 30460015 L R1,OPTEMP PICK UP PARM PTR 30480015 LA R1,4(0,R1) BUMP TO PAGE NBR PTR 30500015 ST R1,OPTEMP3 SAVE REGISTER 30510017 L R1,0(0,R1) PICK UP PAGE NBR PTR 30520015 MVC OPTEMP(4),2(R1) EXTRACT PAGE COUNT 30540015 SPACE 30560015 * CONVERT PAGE NUMBER TO DECIMAL AND INSERT IT INTO SLOT 30580015 SPACE 30600015 L R1,OPTEMP PAGE NBR IN BINARY 30620015 CVD R1,OPTEMP1 CONVERT TO PACKED DECIMAL 30640015 MVC PAGSV(3),OPTEMP1+5 SAVE STARTING PAGE NO 30660015 SPACE 30680015 * EDIT SUPPLIED PAGE NBR TO SUPPRESS LEADING ZEROS AND 30700015 * INSERT THE NBR IN PAGE NBR SLOT OF FIRST HEADING LINE 30720015 SPACE 30740015 MVC PAGENBR1+5(6),PATRN 30760015 ED PAGENBR1+5(6),OPTEMP1+5 30780015 SPACE 30800015 * RETURN TO INITIALIZATION ROUTINE TO OPEN FILES 30820015 SPACE 30840015 L R1,OPTEMP3 30843017 TM 0(R1),X'80' 30846017 BC BO,OPNFILES BRANCH IF NO ADCON 30849017 L R1,4(R1) PICK UP ADDRESS OF ADCON 30852017 MVC 0(4,CNTL),0(R1) MOVE IN ADCON 30855017 BC B,OPNFILES RETURN TO CALLER 30860015 * ----------------------------------------------------AB 032-TSS 30870019 EJECT 30880015 * 30900015 * 30920015 * THE OPTION PROCESSING ROUTINE 30940015 * THIS ROUTINE SETS UP CODE BITS IN THE COMMUNICATIONS 30960015 * AREA TO SPECIFY TO THE COMPILER THOSE OPTIONS THAT HAVE BEEN 30980015 * SELECTED FOR THE COMPILATION. 31000015 * THE OPTIONS MAY HAVE BEEN EXPLICITLY SELECTED VIA THE 31020015 * INVOCATION PARAMETER LIST OR THEY MAY HAVE BEEN AUTOMATICALLY 31040015 * SELECTED FROM THE COMPILER DEFAULT LIST. 31060015 * 31080015 * 31100015 * PRINT A HEADING TO IDENTIFY COMPILER OUTPUT 31120015 * 31140015 OPTPROC L R2,PAROF(0,CNTL) POINT AT INITIALIZATION LIST 31160015 L R1,PLOF(0,R2) POINT AT SYSPRINT DCB 31180015 ST R1,PRDCB SAVE DCB ADDRESS 31200015 SPACE 31220015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 033-TSS 31230019 PUT (1) GET A(BUFFER) 31240015 * ----------------------------------------------------AB 033-TSS 31250019 SPACE 31260015 L R3,DADOF(0,R2) LOOK AT SLOT IN INIT LIST TO SEE 31280015 TM 0(R3),X'80' IF BATCH COMPILING 31300015 BC BZ,NOPAG 31320015 L R3,PAGNO(0,R2) PICK UP ADDRESS OF PAGE NUMBER 31340015 AP 0(3,R3),ONEPD(3) BUMP PAGE NUMBER BY 1 IN AA 31360015 MVC PAGENBR1+5(6),PATRN EDIT THIS PAGE NUMBER INTO HDIN 31380015 ED PAGENBR1+5(6),0(R3) 31400015 NOPAG EQU * 31420015 SPACE 31440015 MVC 5(120,R1),PAGENBR INSERT PAGE NUMBER 31460015 MVC 0(2,R1),OP125 INSERT RECORD LENGTH 31480015 MVI 4(R1),C'1' INSERT EJECT CONTROL CHARACTER 31500015 SPACE 31520015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 040-TSS 31530019 * PICK UP CURRENT DATE FROM THE OS/360 31540015 SPACE 31560015 TIME 31580015 ST R1,OPTEMP1 UNPACK DATE AND SAVE IT TO BE 31600015 UNPK OPTEMP1(5),OPTEMP1(4) INSERTED IN HEADING 31620015 * ----------------------------------------------------AB 040-TSS 31630019 SPACE 31640015 L R1,PRDCB POINT AT DCB 31660015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 034-TSS 31670019 PUT (1) GET A(BUFFER) 31680015 * ----------------------------------------------------AB 034-TSS 31690019 MVC 5(120,R1),HEDING1 INSERT HEADING LINE 31700015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 059-TSS 31710019 MVC 118(2,R1),OPTEMP1 INSERT YEAR 31720015 MVC 121(3,R1),OPTEMP1+2 INSERT DAY OF YEAR 31740015 * ----------------------------------------------------AB 059-TSS 31750019 MVC 0(2,R1),OP125 INSERT RECORD LENGTH 31760015 MVI 4(R1),C' ' INSERT SINGLE SPACE CONTROL 31780015 SPACE 31800015 * LOAD MODULE IEMAF WHICH CONTAINS THE OPTION DELETE AND 31820015 * DEFAULT SPECIFICATIONS AS SET AT SYSGEN TIME 31840015 SPACE 31860015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 009-TSS 31870019 LOAD EP=IEMAF LOAD OPTION SPECS 31880015 LR R1,0 PICK UP LOAD POINT 31900015 MVC AF(44),0(R1) MOVE SPECS INTO WORKSPACE 31920001 DELETE EP=IEMAF FREE SPACE USED BY IEMAF 31940015 * ----------------------------------------------------AB 009-TSS 31950019 L R2,PAROF(0,CNTL) POINT AT ADDLS 31960015 L R1,GENSWOF(0,R2) HENCE AT GENSW 31980015 CLI 0(R1),X'00' IS SWITCH OFF 32000015 BC BNE,BTCHOPS IF NOT,BRANCH 32020015 SPACE 32040015 L R1,OPRGSV0 RECLAIM PARM POINTER 32060015 L R1,0(0,R1) PICK UP ADDR OF OPTION LIST 32080015 LTR R1,R1 IS THERE OPTONS LIST 32086015 BC BZ,DFLTSCAN 32092015 * 32100015 * TEST FOR THE PRESENCE OF AN INVOCATION OPTION LIST 32120015 * 32140015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 054-TSS 32150019 CLC 0(2,R1),OPZERO ZERO INDICATES NO OPTIONS 32160015 BC BE,DFLTSCAN GO TO DEFAULT SCAN IF LIST ZERO 32180015 * ----------------------------------------------------AB 054-TSS 32190019 * 32200015 * SET UP TO PROCESS OPTIONS IN INVOCATION CHARACTER STRING 32220015 * 32240015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 046-TSS 32250019 LH R3,0(0,R1) PICK UP STRING LENGTH 32260015 LA R1,1(0,R1) ADJUST SCAN POINTER 32280015 * ----------------------------------------------------AB 046-TSS 32290019 STORINF ST R1,STADDR 32300015 ST R3,STRLNG SET UP STRING LENGTH 32320015 ST R3,OPTEMP SAVE STRING LNG FOR OPT PRINTER 32340015 ST R1,MVBAK STORE TO RESTORE OPTIONS 32360015 ST R3,STBAK SAVE STRING LENGTH 32380015 EX R3,SAVOPT 32400015 SPACE 32420015 * CALCULATE ADDRESS OF LAST CHARACTER IN THE STRING 32440015 SPACE 32460015 AR R1,R3 ADD STRING LENGTH TO START ADDR 32480015 ST R1,ENDADR TO CALCULATE LAST ADDRESS 32500015 XR R5,R5 CLEAR PAREN COUNTER 32520015 SPACE 32540015 * PRINT OPTION HEADING LINE AND ALL OPTIONS IN INVOKE LIST 32560015 SPACE 32580015 L R1,PRDCB POINT AT SYSPRINT DCB 32600015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 015-TSS 32610019 PUT (1) FIND BUFFER SPACE 32620015 SPACE 32640015 MVC 5(50,R1),HEDING2 INSERT OPTION HEADING LINE 32660015 MVC 0(2,R1),OP55 INSERT RECORD LENGTH 32680015 * ----------------------------------------------------AB 015-TSS 32690019 MVI 4(R1),C'-' INSERT TRIPLE SPACE CONTROL 32700015 SPACE 32720015 * PRINT OPTIONS 32740015 SPACE 32760015 L R3,STADDR POINT AT START OF LIST 32780015 PRN3 L R1,PRDCB POINT AT DCB 32800015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 016-TSS 32810019 PUT (1) GET A(BUFFER) 32820015 * ----------------------------------------------------AB 016-TSS 32830019 L R2,OPTEMP GET STRING LENGTH 32840015 MVC 5(9,R1),NINBLNKS SET UP LINE WITH BLANKS 30333 32860020 BCTR R2,0 ADJUST STRING LENGTH FOR MVC 32880015 EX R2,MVCINS2 INSERT OPTION LIST INTO BUFFER 32900015 LA R2,11(R2) CALC LENGTH FOR V FORMAT RECORD 32920015 C R2,FOURTEEN PAD LINE IF NECESSARY, 30333 32924020 BNL NOPAD TO PREVENT PRINTER ERRORS. 30333 32928020 L R2,FOURTEEN 30333 32932020 NOPAD EQU * 30333 32936020 ST R2,OPTEMP1 32940015 MVC 0(2,R1),OPTEMP1+2 INSERT RECORD LENGTH 32960015 MVI 4(R1),C'0' INSERT DOUBLE SPACE CONTROL 32980015 BC B,SCNKEY 33000015 * 33020015 * THIS ROUTINE PREPARES FOR BATCHING OPTIONS 33040015 * AND PUTS OUT ERROR MESSAGES IF NECESSARY 33060015 * 33080015 BTCHOPS L DICR,DADOF(0,R2) POINT AT ADDR OF DICT 33100015 L DICR,0(0,DICR) HENCE AT DICT 33120015 TM BERSW(DICR),X'F0' IS THERE AN ERROR ON *PROC CARD 33140015 BC BZ,NOERR 33160015 L R1,PRDCB POINT AT PRINT DCB 33180015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 017-TSS 33190019 PUT (1) FIND BUFFER SPACE 33200015 * ----------------------------------------------------AB 017-TSS 33205019 OI SEVBITS+1,X'03' SET SEVBITS TO ERROR. H106 33210017 TM BERSW(DICR),X'0F' IS ERROR SEVERE 33220015 BC BO,DFTS 33240015 MVC 0(40,R1),BTCHMS1 MOVE IN MESSAGE 33260015 BC B,NOERR 33280015 DFTS MVC 0(66,R1),BTCHMS2 33300015 NOERR L R1,PAR4(0,DICR) LOAD START ADDRESS POINTER 33320015 XR R3,R3 CLEAR R3 33340015 IC R3,PARMLEN(0,DICR) LOAD STRING LENGTH 33360015 L R2,OPZERO CLEAR STBAK 33380015 ST R2,STBAK FOR DFLTSCAN 33400015 LTR R3,R3 33420015 BC BZ,DFLTSCAN BRANCH IF NO OPTIONS 33440015 BC B,STORINF 33460015 EJECT 33580015 * SEARCH STRING FOR SUBSTRING DELIMITER AND WHEN FOUND 33600015 * SEARCH KEYWORD TABLE TO SEE IF THE SUBSTRING IS AN OPTION. 33620015 SPACE 33640015 SCNKEY BAL R14,DELSCAN SCAN FOR DELIMITER 33660015 LTR R4,R4 END OF STRING 33666015 BC BZ,DFLTSCAN BRANCH IF SO 33672015 CL R4,OP2 ARE DELIMITERS ADJACENT 33680015 BC BL,SCNKEY BRANCH IF YES 33700015 MVI KEYERRSW,X'00' REINITIALISE SWITCH 33720015 L R2,OSTADR PICK UP START OF SUBSTRING 33740015 STC R4,0(0,R2) INSERT LENGTH INTO SUBSTRING 33760015 SPACE 33780015 LA R1,KEYWORD 33800015 OPT04 BCTR R4,0 REDUCE LENGTH BY 1 FOR CLC INST 33820015 EX R4,CLCINS COMPARE SUBSTRING WITH KEYWORDS 33840015 LA R4,1(0,R4) RESTORE LENGTH COUNT 33860015 BC BE,OPT03 BRANCH IF KEYWORD IS FOUND 33880015 LA R1,ENTLNG(0,R1) BUMP TO NEXT ENTRY 33900015 CLI 0(R1),X'00' IS IT END OF TABLE 33920015 BC BNE,OPT04 BRANCH IF NOT AT END 33940015 BAL RR,MESOP1 GO TO PRINT IEM3904I 33960015 MVI KEYERRSW,X'FF' SHOW WE HAVE KEYWRD ERROR 33980015 BC B,SCNADJ GO TO SCAN ADJUSTER 34000015 SPACE 34020015 * SUBSTRING NOT IDENTIFIED AS A KEYWORD,PRINT ERROR MSG 34040015 SPACE 34060015 MESOP1 L R1,PRDCB POINT AT DCB 34080015 ST RR,RRSAVE SAVE RR 34100015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 018-TSS 34110019 PUT (1) GET A(BUFFER) 34120015 * ----------------------------------------------------AB 018-TSS 34125019 OI SEVBITS+1,X'03' SET SEVBITS TO ERROR. H106 34130017 L RR,RRSAVE RELOAD RR 34140015 MVC 5(120,R1),OPMSG1 INSERT MSG 34160015 CL R4,OP60 WILL SUBSTRING FIT INTO BUFFER 34180015 BC BNH,PRIN1 BRANCH IF YES 34200015 L R4,OP60 TRUNCATE STRING TO FIT 34220015 PRIN1 S R4,OP2 ADJUST LNG FOR MOVE INST 34240015 EX R4,MVCINS3 INSERT STRING INTO BUFFER 34260015 MVC 0(2,R1),OP125 INSERT RECORD LENGTH 34280015 MVI 4(R1),C'0' INSERT DOUBLE SPACE CONTROL 34300015 BCR BR,RR RETURN 34320015 * 34340015 * SUBSTRING FOUND AS A KEYWORD IN THE TABLE,NOW DETERMINE 34360015 * IF THE OPTION HAS BEEN DELETED 34380015 SPACE 34400015 OPT03 LH R2,DELETE(0,R1) PICK UP DELETE BIT NUMBER 34420015 SRDL R2,3(0) DIVIDE BY EIGHT TO CALCULATE THE 34440015 STC R2,MVCINS+5 ***** DELETE BYTE ADDRESS 34460001 XR R2,R2 34480015 SLDL R2,3(0) EXTRACT BIT POSITION LESS ONE 34500015 LA R2,1(0,R2) COMPUTE BIT POSITION WITHIN BYTE 34520015 LA R3,DFLTSWTS PICK UP ADDR OF DEFAULT SWITCHES 34540015 MVCINS MVC OPTEMP(4),0(R3) ***** MOVE BYTE TO WD BDY 34560001 L R3,OPTEMP 34580015 SLDL R2,0(R2) EXTRACT BIT 34600015 N R2,OP1 CLEAR UNWANTED BITS 34620015 BC BZ,OPT05 BRANCH IF NOT DELETED 34640015 SPACE 34660015 * OPTION DELETED,PRINT MESSAGE AND RETURN TO CONTINUE SCAN 34680015 SPACE 34700015 L R2,OSTADR START OF SUBSTRING 34720015 S R4,OP2 ADJUST LNG FOR MOVE INST 34740015 L R1,PRDCB POINT AT DCB 34760015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 019-TSS 34770019 PUT (1) GET A(BUFFER) 34780015 * ----------------------------------------------------AB 019-TSS 34785019 OI SEVBITS+1,X'03' SET SEVBITS TO ERROR. H106 34790017 MVC 5(75,R1),OPMSG2 INSERT DELETE MSG 34800015 EX R4,MVCINS3 INSERT KEYWORD 34820015 MVI 4(R1),C'0' INSERT DOUBLE SPACE CONTROL 34840015 MVC 0(2,R1),OP80 INSERT RECORD LENGTH 34860015 BC B,SCNADJ GO TO SCAN ADJUSTER 34880015 * 34900015 * OPTION NOT DELETED,MARK IT AND ANY ASSOCIATED ALTERNATE 34920015 * OPTIONS AS PROCESSED AND THEN ENTER THE PROCESSING ROUTINE. 34940015 * 34960015 OPT05 MVI PROC(R1),X'FF' MARK OPTION PROCESSED 34980015 CLC ALT(4,R1),OPZERO IS THERE AN ALTERNATE OPTION 35000015 BC BZ,OPT06 BRANCH IF NO ALTERNATE 35020015 L R2,ALT(0,R1) PICK UP ALTERNATE ADDRESS 35040015 OPT07 CLR R2,R1 IS THIS END OF CHAIN 35060015 BC BE,OPT06 BRANCH IF END 35080015 MVI PROC(R2),X'FF' MARK ALTERNATE AS PROCESSED 35100015 L R2,ALT(0,R2) PICK UP NEXT ADDRESS IN CHAIN 35120015 BC B,OPT07 35140015 * 35160015 * ENTER THE PROCESSING ROUTINE ASSOCIATED WITH THE OPTION 35180015 * 35200015 OPT06 L R15,PROC(0,R1) PICK UP A(PROCESS ROUTINE) 35220015 BALR R14,R15 ENTER PROCESS ROUTINE 35240015 SPACE 35260015 * ADJUST SCAN POINTER TO START OF NEXT KEYWORD 35280015 SPACE 35300015 SCNADJ L R1,STADDR POINT TO CURRENT DELIMITER 35320015 ST R1,OPTEMP STORE START OF ADJUSTED STRING 35340015 ADJ4 CLC STRLNG(4),ZEROS TEST FOR END OF STRING 35360015 BC BNZ,NOTEND BRANCH IF NOT END 35380015 L R2,OPTEMP POINT AT START OF ADJUST STRING 35400015 CLR R2,R1 IS ADJUST STRING LENGTH ZERO 35420015 BC BE,DFLTSCAN IF YES,NO SCAN ADJUST 35440015 BCTR R2,0 35460015 LR R4,R1 CREATE ADJUST 35480015 SR R4,R2 STRING LENGTH IN R4 35500015 CLI KEYERRSW,X'FF' IS THERE KEYWORD ERROR 35540015 BC BE,DFLTSCAN BRANCH IF SO 35560015 BAL RR,MESOP1 GO TO PRINT IEM3904I 35580015 BC B,DFLTSCAN 35600015 * 35620015 NOTEND CLI 0(R1),C',' IS DELIMITER A COMMA 35640015 BC BNE,ADJ1 BRANCH IF NOT 35660015 LTR R5,R5 IS PAREN COUNTER ZERO 35680015 BC BNE,ADJ3 BRANCH,THERE IS MORE TO SKIP 35700015 SPACE 35720015 L R2,OPTEMP POINT AT START OF ADJUST STRING 35740015 CLR R2,R1 IS ADJUST STRING LENGTH ZERO 35760015 BC BE,SCNKEY IF YES, NO SCAN ADJUST, NEXT OPT 35780015 BCTR R2,0 35800015 LR R4,R1 CREATE ADJUST STRING LENGTH IN 35820015 SR R4,R2 R4 35840015 CLI KEYERRSW,X'FF' IS THERE KEYWRD ERROR 35860015 BC BE,SCNKEY BRANCH IF SO 35880015 BAL RR,MESOP1 GO TO PRINT IEM3904I 35900015 SPACE 35920015 BC B,SCNKEY SCAN ADJUSTED,GO GET NEXT OPTION 35940015 SPACE 35960015 ADJ1 CLI 0(R1),C'(' IS DELIMITER A LEFT PARENTHESES 35980015 BC BNE,ADJ2 BRANCH IF NOT 36000015 LA R5,1(0,R5) COUNT IT 36020015 BC B,ADJ3 CONTINUE TO LOOK FOR DELIMITER 36040015 SPACE 36060015 ADJ2 CLI 0(R1),C')' IS DELIMITER A RIGHT PARENTHESES 36080015 BC BNE,ADJ3 BRANCH IF NOT 36100015 LTR R5,R5 IS PAREN COUNTER ZERO 36120015 BC BZ,ADJ3 IF ZERO DO NOT TRY TO REDUCE 36140015 BCTR R5,0 DECREMENT PAREN COUNTER 36160015 SPACE 36180015 ADJ3 BAL R14,DELSCAN SCAN FOR NEXT DELIMITER 36200015 BC B,ADJ4 LOOP BACK TO TEST FOR TYPE 36220015 EJECT 36240015 * THIS ROUTINE SCANS FOR A DELIMITER IN THE CHAR STRING 36260015 * 36280015 DELSCAN L R3,STRLNG CURRENT LENGTH OF CHAR STRING 36300015 LTR R3,R3 HAS END OF STRING BEEN REACHED 36320015 BC BNE,CONSCN BRANCH IF NOT THE END 36340015 XR R4,R4 SET SUBSTRING LENGTH TO ZERO 36360015 BC B,ENDSCAN SET UP FOR RETURN 36380015 SPACE 36400015 CONSCN L R1,STADDR CURRENT START OF CHAR STRING 36420015 ST R1,OSTADR SAVE CURRENT AS OLD START ADDR 36440015 BCTR R3,0 REDUCE LENGTH BY 1 FOR TRT INST 36460015 EX R3,TRTINS LOOK FOR DELIMITER 36480015 LA R3,1(0,R3) RESTORE LENGTH 36500015 LR R4,R3 SAVE OLD STRING LENGTH 36520015 BC BZ,OPT01 BRANCH IF AT END OF STRING 36540015 L R3,ENDADR CALCULATE A NEW CHARACTER 36560015 SR R3,R1 STRING LENGTH. 36580015 SR R4,R3 CALCULATE THE SUBSTRING LENGTH 36600015 * 36620015 * SAVE NEW START ADDR AND REMAINING STRING LENGTH 36640015 SPACE 36660015 OPT02 ST R1,STADDR NEW CURRENT START ADDRESS 36680015 ST R3,STRLNG NEW STRING LENGTH 36700015 ST R4,SUBLNG SUBSTRING LENGTH 36720015 BCR BR,R14 RETURN TO CALLER 36740015 * 36760015 * SET UP END OF STRING CONDITION 36780015 SPACE 36800015 OPT01 LA R4,1(0,R4) CALCULATE SUBSTRING LENGTH 36820015 ENDSCAN L R1,ENDADR LAST CHARACTER TRANSLATED 36840015 LA R1,1(0,R1) POINT AT IMAGINARY FINAL DELIM 36860015 XR R2,R2 CLEAR FUNCTION BYTE REGISTER 36880015 XR R3,R3 CLEAR STRING LENGTH REGISTER 36900015 BC B,OPT02 36920015 EJECT 36940015 SPACE 36960015 * THIS ROUTINE PROCESSES OPTIONS NOT SPECIFIED IN THE 36980015 * INVOCATION PARAMETER LIST 37000015 SPACE 37020015 DFLTSCAN LA R1,KEYWORD 37040015 XC STADDR,STADDR SET ZERO TO SHOW NO OPTION LIST 37060015 DFLT2 CLI PROC(R1),X'FF' WAS IT PROCESSED AT INVOKE SCAN 37080015 BC BE,DFLT1 BRANCH IF YES 37100015 SPACE 37120015 CLC ALT(4,R1),OPZERO IS THERE AN ALTERNATE,IF NOT 37140015 BC BZ,DFLT3 THEN THIS ENTRY IS THE DEFAULT 37160015 SPACE 37180015 * NOT PREVIOUSLY PROCESSED, DETERMINE IF IT IS THE DEFAULT 37200015 * 37220015 * WE TEST TO SEE WHETHER KEYWORD IS 'OPT' 37240015 * IF SO, BRANCH STRAIGHT TO PROCESSING ROUTINE 37260015 * WHICH CHECKS DEFAULT BITS ITSELF 37280015 * 37300015 C R1,ADOPT 37320015 BC BE,DFLT3 37340015 SPACE 37360015 LH R2,DEFAULT(0,R1) PICK UP DEFAULT BIT NUMBER 37380015 SRDL R2,3(0) DIVIDE BY EIGHT TO CALCULATE THE 37400015 STC R2,MOVE+5 ***** DEFAULT BYTE ADDRESS 37420001 XR R2,R2 37440015 SLDL R2,3(0) EXTRACT BIT POSITION LESS ONE 37460015 LA R2,1(0,R2) COMPUTE BIT POSITION WITHIN BYTE 37480015 LA R3,DFLTSWTS PICK UP ADDR OF DEFAULT SWITCHES 37500015 MOVE MVC OPTEMP(4),0(R3) ***** MOVE BYTE TO WD BDY 37520001 L R3,OPTEMP 37540015 SLDL R2,0(R2) EXTRACT BIT 37560015 N R2,OP1 CLEAR UNWANTED BITS 37580015 BC BZ,DFLT1 BRANCH IF NOT DEFAULT 37600015 SPACE 37620015 * OPTION IS DEFAULT,GO TO APPROPRIATE PROCESSING ROUTINE 37640015 SPACE 37660015 DFLT3 L R15,PROC(0,R1) PICK UP A(PROCESSING ROUTINE) 37680015 ST R1,DFLTSV1 SAVE KEYWORD TABLE PTR 37700015 BALR R14,R15 ENTER PROCESSING ROUTINE 37720015 SPACE 37740015 L R1,DFLTSV1 RECLAIM KEYWORD PTR 37760015 DFLT1 LA R1,ENTLNG(0,R1) BUMP TO NEXT ENTRY 37780015 CLI 0(R1),X'00' IS IT END OF TABLE 37800015 BC BNE,DFLT2 BRANCH IF NOT END 37820015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 099-TSS 37830020 SPACE 37840015 * OPTION PROCESSING COMPLETED 37860015 SPACE 37861001 TM CCCADE+1,X'40' WAS SIZE=999999 H320 37862001 * ----------------------------------------------------AB 099-TSS 37862520 BNO NOPT1 H320 37863001 TM CCCADE,X'80' WAS DP SPECIFIED H320 37864001 BNO NOPT1 BRANCH IF NOT H320 37865001 L GRD,SIZE PICK UP SIZE VALUE H320 37866001 S GRD,LIM1 SUBTRACT 8K H320 37867001 C GRD,OP44K IS IT LESS THAN 44K H320 37868001 BNL NOPT2 H320 37869001 L GRD,OP44K MAKE IT 44K H320 37870001 NOPT2 ST GRD,SIZE STORE REDUCED VALUE H320 37871001 SPACE 37872001 NOPT1 EQU * H320 37873001 L R3,MVBAK PICK UP ADDRESS OF STRING 37880015 L R1,STBAK LENGTH OF STRING 37900015 LTR R1,R1 SEE IF ANY OPTIONS SPECIFIED 37920015 BC BZ,OPENR 37940015 EX R1,RSTOPT RESTORE OPTION STRING 37960015 BC B,OPENR RETURN TO ALLOW RAKE TO PROGRESS 37980015 EJECT 38000015 * THIS ROUTINE PROCESSES THE LINECNT OPTION 38020015 * 38040015 LNCNT CLC STADDR,OPZERO IS OPTION INVOKED OR DEFAULT 38060015 BC BE,0(0,R14) RETURN IF DEFAULT IS TO BE USED 38080015 ST R14,OPTEMP SAVE LINK REG 38100015 BAL R14,DELSCAN SCAN FOR NEXT DELIMITER 38120015 CLI SUBLNG+3,X'02' IS SUBSTRING LENGTH LONG ENOUGH 38140015 BC BL,LNERR BRANCH IF NOT 38160015 * 38180015 * TEST FOR ANY NON-NUMERIC CHARACTERS 38200015 SPACE 38220015 L R2,OSTADR 38240015 NXT LA R2,1(0,R2) 38260015 CR R2,R1 IS IT END OF FIELD 38280015 BC BE,ALNUM BRANCH IF YES,FIELD IS OK 38300015 TM 0(R2),X'F0' 38320015 BC BO,NXT BRANCH IF NUMERIC 38340015 * 38360015 * ERROR IN OPTION SYNTAX,PRINT MSG AND USE DEFAULT 38380015 * 38400015 LNERR L R1,PRDCB POINT AT DCB 38420015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 020-TSS 38430019 PUT (1) GET A BUFFER 38440015 * ----------------------------------------------------AB 020-TSS 38445019 OI SEVBITS+1,X'03' SET SEVBITS TO ERROR. H106 38450017 MVC 5(88,R1),OPMSG3 INSERT STD ERROR MSG 38460015 MVC 78(15,R1),LCNT INSERT NAME 38480015 MVI 4(R1),C'0' INSERT DOUBLE SPACE CONTROL 38500015 MVC 0(2,R1),OP93 INSERT RECORD LENGTH 38520015 BC B,ALNUM1 RETURN 38540015 * 38560015 * PACK FIELD AND CONVERT TO BINARY 38580015 * 38600015 ALNUM L R2,OSTADR POINT TO START OF FIELD 38620015 S R4,OP2 ADJUST FIELD LNG FOR PACK INST 38640015 EX R4,PCKINS CHANGE TO PACKED DECIMAL FORMAT 38660015 CVB R2,OPTEMP1 CONVERT TO BINARY FORMAT 38680015 C R2,F1000 IS VALUE TOO LARGE H235 38690001 * THIS CHECK USED TO BE AGAINST 99, ALTERED FOR GRAPHICS OUTPUT 38700001 BC BH,LNERR BRANCH IF YES 38720015 LTR R2,R2 IS VALUE GREATER THAN ZERO 38740015 BC BZ,LNERR BRANCH IF NOT 38760015 ST R2,LINECNT PLACE VALUE IN PROPER SLOT 38780015 ALNUM1 L R14,OPTEMP RECLAIM LINK REGISTER 38800015 BCR BR,R14 RETURN TO OPTION SCAN ROUTINE 38820015 SPACE 38840015 SPACE 38860015 EJECT 38880015 * THIS ROUTINE PROCESSES THE SIZE OPTION 38900015 SPACE 38920015 SZE L R3,PAROF(CNTL) 38940015 L R3,DADOF(R3) POINT AT DICT ADDR SLOT 38960015 ST R14,OPTEMP SAVE LINK REGISTR 38980015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 013-TSS 38990019 TM 0(R3),X'80' ARE WE BATCHING 39000015 BC BNZ,OPINVK BTANCH IF NOT 39020015 * 39040015 * THIS ROUTINE CALCULATES THE MAXIMUM SIZE AVAILABLE 39060015 * 39080015 L R4,OP9 SET UP LOOP COUNT 39100015 LA R2,ANSWGM SET UP GETMAIN 39120015 LA R3,MINMAX PARAMETERS 39140015 CNDGET GETMAIN VC,LA=(R3),A=(R2) 39160015 LTR 15,15 39180015 BC BNZ,ADDSZS 39200015 LA R2,8(R2) POINT TO NEXT ANSWER SLOT 39220015 BCT R4,CNDGET 39240015 ADDSZS S R4,OP9 CALCULATE NUMBER 39260015 LPR R4,R4 OF ALLOCATIONS 39280015 LA R3,ANSWGM POINT AT ANSWER SLOTS 39300015 LA R2,0 39320015 FRLOOP A R2,4(R3) ADD ON LENGTH OF THIS ALLOCATION 39340015 FREEMAIN V,A=(R3) 39360015 LA R3,8(R3) POINT TO NEXT ANSWER SLOTS 39380015 BCT R4,FRLOOP 39400015 L R1,PDLAST NOW ADD SIZE OF AB AND AA (I.E. 39420015 LA CNTLB,0(CNTLB) CLEAR TOP BYTE OF AB BASE REG 39440015 SR R1,CNTLB OF CORE ALREADY USED) 39460015 L R3,PAROF(CNTL) 39480015 L R3,SECPDOF(R3) POINT AT LAST LABEL IN AA 39500015 AH R3,SPDLTH ADD LENGTH OF AA AFTER 39520015 LA CNTL,0(CNTL) CLEAR TOP BYTE OF AA BASE REG 39540015 SR R3,CNTL HENCE R3 HAS LENGTH OF AA 39560015 AR R2,R1 39580015 AR R2,R3 NOW R2 HAS SIZE VALUE 39600015 USING IHADCB,R3 39620015 L R3,PRDCB 39640015 LH R3,DCBBLKSI PICK UP SYSPRINT BLOCKSIZE 39660015 DROP R3 39680015 USING IHADCB,R4 39700015 L R4,PAROF(CNTL) 39720015 L R4,RDOF(R4) POINT AT SYSIN DCB 39740015 LH R4,DCBBLKSI PICK UP BUFFER LENGTH 39760015 DROP R4 39780015 L R14,0(CNTL) PICK UP LINK BUF SLOT IHE00 39786017 LTR R14,R14 IHE00 39792017 BC BZ,SPLOVR BRANCH IF NOT LOAD AND GO IHE00 39798017 AR R4,R4 ALLOW FOR POSSIBLE SPOOL FILEIHE00 39804017 SPLOVR AR R3,R4 BUFFERS. IHE00 39810017 AR R3,R3 NOW HAVE TOTAL BUFFER SIZES USED 39820015 LA R2,300(R2,R3) ADD 300 FOR O/S ROUTINES 39840015 S R2,TWOK LEAVE ROOM FOR 27136 39846019 * FRAGMENTATION. 27136 39852019 ST R2,SZVAL(CNTL) STORE IN SAFE PLACE 39860015 * ----------------------------------------------------AB 013-TSS 39870019 OPINVK CLC STADDR,OPZERO IS OPTION INVOKED 39880015 BC BE,SZE32 BRANCH IF NOT INVOKED 39900015 BAL R14,DELSCAN SCAN FOR NEXT DELIMITER 39920015 CLI SUBLNG+3,X'02' IS SUBSTRING LONG ENOUGH 25846 39926019 BL SZERR BRANCH IF NOT 25846 39932019 * 39940015 * TEST TO SEE WHETHER SIZE=999999 SPECIFIED 39960015 * 39980015 C R4,OP7 SEE IF FIELD 6 CHARS LONG 40000015 BC BNE,NOTMAX BRANCH IF NOT 40020015 L R2,OSTADR POINT AT = SIGN 40040015 CLC 1(6,R2),NINE99 IS FIELD 999999 40060015 BC BE,SZEMAX BRANCH IF SO 40080015 NOTMAX BCTR R1,0 40100015 CLI 0(R1),C'K' IS SIZE SPECD IN K 40120015 BC BE,SZINK BRANCH IF SO 40140015 MVC MULTBY1K(4),NOPINS OVERWRITE SHIFT WITH NOP INSTR 40160015 LA R4,1(R4) ADJUST STRING LENGTH 40180015 LA R1,1(R1) AND END ADDR OF FIELD 40200015 SPACE 40220015 * TEST FOR ANY NON-NUMERIC CHARACTERS 40240015 SPACE 40260015 SZINK L R2,OSTADR POINT TO START OF FIELD 40280015 SZE1 LA R2,1(0,R2) BUMP TO NEXT BYTE 40300015 CR R2,R1 IS IT END OF FIELD 40320015 BC BE,SZE2 BRANCH IF YES,FIELD OK 40340015 TM 0(R2),X'F0' IS IT A NUMERIC 40360015 BC BO,SZE1 BRANCH IF YES 40380015 SPACE 40400015 * SYNTAX ERROR,PRINT MSG & USE DEFAULT 40420015 SPACE 40440015 SZERR L R1,PRDCB POINT AT DCB 40460015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 041-TSS 40470019 PUT (1) GET A BUFFER 40480015 * ----------------------------------------------------AB 041-TSS 40485019 OI SEVBITS+1,X'03' SET SEVBITS TO ERROR. H106 40490017 MVC 5(88,R1),OPMSG3 INSERT STD ERROR MSG 40500015 MVC 78(15,R1),SIZ INSERT NAME 40520015 MVI 4(R1),C'0' INSERT DOUBLE SPACE CONTROL 40540015 MVC 0(2,R1),OP93 INSERT RECORD LENGTH 40560015 SZE32 L R2,SIZE PICK UP DEFAULT VALUE 40580015 C R2,MAXAMT IS SIZE=999999 DFAULT 40586015 BC BNE,SZE31 BRANCH IF NOT 40592015 SPACE 40620015 SZEMAX L R2,SZVAL(CNTL) PICK UP MAX SIZE 40640015 OI CCCADE+1,X'40' SAY SIZE=999999 H320 40650001 C R2,OP44K 40660015 BC BNL,SZE312 BRANCH IF NOT LESS THAN 44K 40680015 * 40700015 * GIVE USER WARNING THAT WE MAKE SIZE LESS THAN 44K 40720015 * 40740015 LR GRA,R2 40760015 BAL RR,CONBIN CONVERT SIZE TO UNPKD DECIMAL 40780015 LA R1,UDECF POINT R1 AT RESULT 40800015 BLNKAG CLI 0(R1),X'F0' IS IT ZERO 40820015 BC BNE,MVSIZE BRANCH IF NOT 40840015 MVI 0(R1),X'40' BLANK OUT LEADING ZERO 40860015 LA R1,1(R1) BUMP TO NEXT CHAR 40880015 BC B,BLNKAG 40900015 MVSIZE MVC SZWRMS+40(8),UDECF MOVE SIZE INTO MSSG 40920015 L R1,PRDCB POINT AT SYSPRINT DCB 40940015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 042-TSS 40950019 PUT (1) GET BUFFER SPACE 40960015 * ----------------------------------------------------AB 042-TSS 40970019 MVC 0(96,R1),SZWRMS MOVE MSSG INTO BUFFER 40980015 L R2,OP44K ASSUME SIZE=44K 41000015 BC B,SZE312 41020015 SPACE 41040015 * PACK THE FIELD AND CONVERT TO BINARY 41060015 SPACE 41080015 SZE2 L R2,OSTADR POINT TO START OF FIELD 41100015 SH R4,OP3 ADJUST FOR PACK INSTRN 41120015 EX R4,PCKINS PACK THE FIELD AND 41140015 CVB R2,OPTEMP1 CONVERT VALUE TO BINARY 41160015 * 41180015 * THIS INSTRUCTION IS CARRIED OUT ONLY IF SIZE SPECD IN K 41200015 MULTBY1K SLL R2,10 FIND VALUE OF SIZE IN BYTES 41220015 * 41240015 C R2,MINMAX+4 IS SIZE < A MILLION 41260015 BC BNL,SZERR ERROR IF NOT 41280015 SZE311 C R2,OP44K IS VALUE TOO SMALL 41300015 BC BL,SZERR BRANCH IF TOO LOW 41320015 SZE312 ST R2,SIZE PUT VALUE IN SLOT 41340015 * 41360015 SZE31 L R14,OPTEMP I14 41960017 BCR BR,R14 RETURN TO CALLER 42740015 EJECT 42960015 * THIS ROUTINE PROCESSES THE SORMGIN OPTION 42980015 SPACE 43000015 SRMGN CLC STADDR,OPZERO IS OPTION INVOKED 43020015 BC BE,0(0,R14) RETURN IF THIS IS DEFAULT ENTRY 43040015 ST R14,OPTEMP SAVE RETURN REG 43060015 BAL R14,DELSCAN SCAN FOR NEXT DELIMITER 43080015 XR R5,R5 CLEAR PAREN COUNTER 43100015 CLI 0(R1),C'(' IS IT A LEFT PAREN 43120015 BC BNE,SMGN5 BRANCH IF NOT 43140015 LA R5,1(0,R5) COUNT IT 43160015 MVI SWTCH,X'FF' SET LOOP CONTROL SWITCH 43180015 BAL R14,DELSCAN SCAN FOR DELIMITER 43200015 CLI 0(R1),C',' IS IT COMMA 43220015 BC BNE,SMGN5 BRANCH IF NOT 43240015 SMGN3 CLI SUBLNG+3,X'02' IS SUBSTRING LENGTH LONG ENOUGH 43260015 BC BL,SMGN5 BRANCH IF NOT 43280015 SPACE 43300015 * TEST FOR AN ALL NUMERIC FIELD 43320015 SPACE 43340015 L R2,OSTADR START OF FIELD 43360015 SMGN2 LA R2,1(0,R2) BUMP TO NEXT BYTE 43380015 CR R2,R1 IS IT END OF FIELD 43400015 BC BE,SMGN1 BRANCH IF END AND FIELD IS OK 43420015 TM 0(R2),X'F0' IS IT NUMERIC 43440015 BC BO,SMGN2 CONTINUE SCAN IF OK 43460015 BC B,SMGN5 NON NUMERIC,GO TO ERROR ROUTINE 43480015 SPACE 43500015 * PACK FIELD AND CONVERT TO BINARY 43520015 SPACE 43540015 SMGN1 L R2,OSTADR POINT TO START OF FIELD 43560015 S R4,OP2 ADJUST FIELD LNG FOR PACK INST 43580015 EX R4,PCKINS PACK AND 43600015 CVB R2,OPTEMP1 CONVERT TO BINARY 43620015 LTR R2,R2 TEST FOR ZERO 43640015 BC BZ,SMGNX BRANCH IF ZERO. 20202 43660001 C R2,OP100 IS VALUE TOO BIG 43680015 BH SMGN5B BRANCH IF YES H278 43700001 SPACE 43702019 USING IHADCB,R3 H321 43704019 L R3,PAROF(CNTL) POINT AT INIT LIST H321 43706019 L R3,RDOF(R3) HENCE AT SYSIN DCB H321 43708019 CH R2,DCBLRECL IS VALUE TOO BIG H321 43710019 BH SMGN5B BRANCH IF SO H321 43712019 DROP R3 H321 43714019 SPACE 43720015 CLI SWTCH,X'FF' IS THIS FIRST PASS THRU LOOP 43740015 BC BNE,SMGN4 BRANCH IF NOT 43760015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 063-TSS 43766019 * ----------------------------------------------------AB 063-TSS 43772019 ST R2,OPTEMP2 SAVE SORMGIN START VALUE 43780015 MVI SWTCH,X'00' FLIP SWITCH TO SHOW SECOND PASS 43800015 BAL R14,DELSCAN SCAN FOR NEXT DELIMITER 43820015 CLI 0(R1),C')' IS IT RIGHT PAREN 43840015 BC BNE,SMGN7 BRANCH IF NOT 43860015 BCTR R5,0 DECREMENT PAREN COUNTER 43880015 BC B,SMGN3 GO TO SCAN FOR NEXT VALUE 43900015 SPACE 43920015 * CHECK THAT START VALUE IS NOT LARGER THAN END VALUE AND 43940015 * IF OK THEN MOVE VALUES TO PROPER SLOTS 43960015 SPACE 43980015 SMGN4 CLI SWTCH,X'0F' ARE WE AT END OF THIRD FIELD 44000015 BC BE,SMGN9 BRANCH IF SO 44020015 C R2,OPTEMP2 IS END MARG LESS THAN START 44040015 BC BL,SMGN5 BRANCH TO ERROR IF IT IS LESS 44060015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 064-TSS 44066019 * ----------------------------------------------------AB 064-TSS 44072019 ST R2,SORMGINE SAVE SORMGIN END VALUE 44080015 MVC SORMGINS(4),OPTEMP2 SAVE SORMGIN START VALUE 44100015 CLI SWTCH,X'F0' IS THERE ANOTHER FIELD TO COME 44120015 BC BE,SMGN8 BRANCH IF SO 44140015 L R2,CNTLCOL TEST DEFAULT CNTLCOL 44146001 BC B,SMGN11 AGAINST SMGIN 44152001 SMGN10 L R3,STRLNG PICK UP STRING LENTH 44160015 C R3,OP1 IS IT END OF OPTIONS FIELD 44180015 BC BNH,ENDTEST1 BRANCH IF END OF FIELD 44200015 BAL R14,DELSCAN LOOK FOR NEXT DELIMITER 44220015 CLI 0(R1),C',' IS IT A COMMA 44240015 BC BNE,SMGN5 ERROR IF NOT 44260015 C R4,OP2 IS COMMA IMMEDIATELY AFTER ) 44280015 BC BNL,SMGN5 ERROR IF NOT 44300015 SMGN6 L R14,OPTEMP RECLAIM LINK REGISTER 44320015 BCR BR,R14 AND RETURN TO CALLER 44340015 SPACE 44360015 ENDTEST1 BAL R14,DELSCAN SET SCAN POINTER CORRECTLY 44380015 BC B,SMGN6 44400015 SPACE 44420015 * SYNTAX ERROR,PRINT MSG & USE DEFAULT 44440015 SPACE 44445001 SMGN5B MVI SMARGSW,X'FF' SAY ERROR IN ARGUMENT H278 44450001 * RATHER THAN SYNTAX H278 44455001 SPACE 44460015 SMGN5 C R5,ZEROS IS BRACKET LEVEL OK 44465015 BC BE,SMGN5A BRANCH IF SO 44470015 DLMLOP BAL R14,DELSCAN SCAN FOR NEXT DELIM 44475015 CLI 0(R1),C')' IS IT RIGHT BRACKET 44480015 BC BE,BKFND BRANCH IF ) H046 44481016 LTR R3,R3 H046 44482016 BC BZ,SMGN5A BRANCH IF END OF FIELD H046 44483016 BC B,DLMLOP RESCAN H046 44484016 BKFND EQU * H046 44485016 BCTR R5,0 DECREMENT BRKT COUNT 44490015 SMGN5A L R1,PRDCB POINT AT DCB 44495015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 021-TSS 44497019 PUT (1) GET A BUFFER 44500015 * ----------------------------------------------------AB 021-TSS 44505019 OI SEVBITS+1,X'03' SET SEVBITS TO ERROR. H106 44510017 MVI 4(R1),C'0' INSERT DOUBLE SPACE CONTROLH278 44516001 MVC 5(53,R1),OPMSG3 INSERT STD MSG H278 44522001 SPACE 44528001 CLI SMARGSW,X'FF' IS IT BAD ARG H278 44534001 BNE SYNERR BRANCH IF BAD SYNTAX H278 44540001 MVC 52(8,R1),ARG SAY ARGUMENT ERROR, H278 44546001 MVC 8(4,R1),ARGNO MOVE IN NEW NO, H278 44552001 MVC 0(2,R1),OP95 AND INSERT RECORD LENGTH H278 44558001 LA R1,2(0,R1) BUMP R1 H278 44564001 B BOTHERR AND BRANCH H278 44570001 SPACE 44576001 SYNERR MVC 0(2,R1),OP93 INSERT RECORD LENGTH H278 44582001 BOTHERR MVC 58(35,R1),OPMSG3A REST OF MESSAGE, H278 44588001 MVC 78(15,R1),SMGIN AND NAME H278 44594001 BC B,ENDTEST1 44600015 SMGN7 CLI 0(R1),C',' 44620015 BC BNE,SMGN5 ERROR IF NOT COMMA 44640015 MVI SWTCH,X'F0' SET STAGE REACHED SWITCH 44660015 BC B,SMGN3 44680015 * 44700015 SMGN8 BAL R14,DELSCAN LOOK FOR NEXT DELIMITER 44720015 CLI 0(R1),C')' 44740015 BC BNE,SMGN5 44760015 BCTR R5,0 44780015 MVI SWTCH,X'0F' SET STAGE REACHED SWITCH 44800015 BC B,SMGN3 44820015 SMGN9 TM DFLTSWTS+11,X'10' IS PAGE CTL DELETED 44824001 BC BZ,SMGN11 BRANCH IF NOT 44828015 L R1,PRDCB POINT AT SYSPRINT DCB 44836015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 022-TSS 44838019 PUT (1) FIND BUFFER SPACE 44840015 * ----------------------------------------------------AB 022-TSS 44842019 MVC 0(99,R1),CNDLMS MOVE IN MESSAGE 44844015 BC B,SMGN11A 44848001 SPACE 44852015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 084-TSS 44854019 SMGN11 C R2,SORMGINS IS CNTL COL BEFORE START 44856015 * ----------------------------------------------------AB 084-TSS 44858019 BC BL,CNTLOK BRANCH IF SO 44860015 C R2,SORMGINE IS COL AFTER END 44880015 BC BH,CNTLOK BRANCH IF SO 44900015 * 44920015 * WE HAVE ERROE 44940015 * 44960015 L R1,PRDCB POINT AT DCB 44980015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 023-TSS 44990019 PUT (1) GET A BUFFER 45000015 * ----------------------------------------------------AB 023-TSS 45005019 OI SEVBITS+1,X'01' SET SEVBITS TO WARNING. H106 45010017 MVC 0(91,R1),CNTLMES MOVE IN MESSAGE H334 45020019 SMGN11A MVC CNTLCOL(4),ZEROS OPTION DELETED 45030001 BC B,SMGN10 45040015 * 45045001 SMGNX CLI SWTCH,X'0F' ARE WE HANDLING THIRD ARG..20202 45050001 BNE SMGN5B IF NOT,ZERO ARG IS ERROR H278 45055001 CNTLOK ST R2,CNTLCOL STORE CONTROL CHAR COL 45060015 BC B,SMGN10 45080015 EJECT 45100015 * THIS ROUTINE PROCESSES THE OPTIMIZING OPTION 45120015 SPACE 45140015 OPTPR ST R14,OPTEMP SAVE LINK REGISTER 45160015 CLC STADDR,OPZERO INVOCATION OR DEFAULT ENTRY 45180015 BC BE,OPTPR2 BRANCH IF DEFAULT ENTRY 45200015 SPACE 45220015 BAL R14,DELSCAN SCAN FOR NEXT DELIMITER 45240015 CLI SUBLNG+3,X'03' TEST FOR MAXIMUMUM OF 2 DIGITS 45260015 BC BH,OPTPR1 45280015 SPACE 45300015 L R2,OSTADR POINT AT FIRST DELIM. 45320015 OPTLOP LA R2,1(0,R2) POINT AT NEXT BYTE 45340015 CR R2,R1 IS IT END OF FIELD 45360015 BC BE,OPTPR9 BRANCH IF YES 45380015 TM 0(R2),X'F0' IS IT NUMERIC 45400015 BC BO,OPTLOP CONTINUE SCAN IF YES 45420015 BC B,OPTPR1 BRANCH TO ERROR IF NOT 45440015 SPACE 45460015 * PACK FIELD AND CONVERT TO DECIMAL 45480015 SPACE 45500015 OPTPR9 L R2,OSTADR POINT AT FIRST DELIM 45520015 S R4,OP2 ADJUST FIELD LENGTH FOR PACK INS 45540015 EX R4,PCKINS PACK FIELD AND CONVERT IT TO 45560015 CVB R2,OPTEMP1 BINARY 45580015 SPACE 45600015 * R2 NOW CONTAINS THE OPT VALUE. TEST FOR VALIDITY AND SET 45620015 * THE REQUIRED CODE BITS 45640015 SPACE 45660015 CL R2,ZEROS SEE IF OPT LESS THAN 0 45680015 BC BL,OPTPR1 BRANCH TO ERROR IF YES 45700015 CL R2,OPTHIGH SEE IF OPT GT MAX SIZE 45720001 BC BH,OPTPR1 BRANCH TO ERROR IF YES 45740015 SETOPT ST R2,OPTVLU STORE OPT FOR LATER DICT INSERTN 45760015 OI CCCADE+2,X'08' SHOW OPTIMIZATION WANTED 45780015 OPTPR8 L R14,OPTEMP PICK UP RETURN REGISTER 45800015 BCR BR,R14 RETURN TO CALLER 45820015 SPACE 45840015 * ERROR IN OPTION SPECIFICATION,PRINT MSG & USE DEFAULT 45860015 SPACE 45880015 OPTPR1 L R1,PRDCB POINT AT DCB 45900015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 024-TSS 45910019 PUT (1) GET A BUFFER 45920015 * ----------------------------------------------------AB 024-TSS 45925019 OI SEVBITS+1,X'03' SET SEVBITS TO ERROR. H106 45930017 MVC 5(88,R1),OPMSG3 INSERT STD ERROR MSG 45940015 MVI 4(R1),C'0' INSERT DOUBLE SPACE CONTROL 45960015 MVC 78(15,R1),OPTNME INSERT NAME 45980015 MVC 0(2,R1),OP93 INSERT RECORD LENGTH 46000015 SPACE 46020015 * USE SYSGEN DEFAULT FOR OPT OPTION 46040015 SPACE 46060015 * THIS CODE IS PARAMETERISED BY NOPTLVLS,OPTDEFLT,OPTEQ0 46090001 * N.B. IF THE DEFAULT BITS FOR OPT LEVELS LIE OUTSIDE THE 46100001 * FIRST 32 BITS THEN THIS CODE MUST BE CHANGED. 46110001 OPTPR2 L R3,DFLTSWTS PICK UP SWITCHES 1-32 46120001 SLL R3,OPTEQ0-1 CLEAR UNWANTED BITS 46150001 LA R4,NOPTLVLS SET BIT COUNTER 46180001 XR R2,R2 CLEAR TEST REGISTER 46210001 OPTPR4 SLDL R2,1 GET NEXT BIT 46240001 LTR R2,R2 EXAMINE 46270001 BNZ OPTPR5 BRANCH IF YES 46300001 BCT R4,OPTPR4 46330001 LA R2,OPTDEFLT SET OPT DEFAULT 46360001 B SETOPT AND GO AND STORE IT 46390001 * 46420001 OPTPR5 LA R2,NOPTLVLS COMPUTE DEGAULT VALUE BY 46450001 SR R2,R4 SUBTRACRING COUNT FROM TOT LVLS 46480001 B SETOPT GO AND STORE IT 46510001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 068-TSS 46520019 * ----------------------------------------------------AB 068-TSS 46530019 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 100-TSS 46533020 * ----------------------------------------------------AB 100-TSS 46536020 EJECT 46541017 * 46542017 * START OF THIRD CSECT 46543017 * 46544017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 086-TSS 46544520 IEMAB2 CSECT 46545017 * ----------------------------------------------------AB 086-TSS 46545520 USING SECT1,CNTLB 46546017 USING SECT2,CNTL2 46547017 USING *,CNTL3 46548017 USING SECT4,CNTL4 46549017 SECT3 EQU * 46550017 EJECT 46560015 * THIS ROUTINE PROCESSES THE DUMP OPTION 46580015 SPACE 46600015 DMPR L R1,STADDR POINT TO KEYWORD DELIMITER 46620015 CLI 0(R1),C'=' IS IT AN = SIGN 46640015 BC BE,DMPR1 BRANCH IF YES 46660015 SPACE 46680015 * INDICATE THAT THE DUMP OPTION IS REQUIRED 46700015 SPACE 46720015 DMPR5 OI CCCADE,X'80' SET DUMP INDICATOR IN CCCADE 46740015 BCR BR,R14 RETURN TO CALLER 46760015 SPACE 46780015 DMPR1 ST R14,OPTEMP SAVE RETURN REG 46800015 BAL R14,DELSCAN SCAN FOR NEXT DELIMITER 46820015 XR R5,R5 CLEAR PAREN COUNTER 46840015 CLI 0(R1),C'(' IS DELIMITER A '(' 46860015 BC BNE,DMPR7 BRANCH IF NOT 46880015 LA R5,1(0,R5) COUNT THE LEFT PAREN 46900015 SPACE 46920015 * EXTRACT DUMP TYPE PARAMETER AND SET CONTROL BYTE. 46940015 SPACE 46960015 BAL R14,DELSCAN SCAN FOR NEXT DELIMETER. 46980015 CLI 0(R1),C',' IS IT A COMMA 47000015 BC BNE,DMPR7 BRANCH IF NOT. 47020015 CLI SUBLNG+3,X'02' IS FIELD TOO SMALL 47040015 BC BNL,FLDLG BRANCH IF NOT 47060015 OI INDIC,X'F0' INSERT DEFAULT TO DUMP DTSP 47080015 BC B,PDPTR BRANCH TO SEARCH PHASE DIRECTORY 47100015 FLDLG CLI SUBLNG+3,X'08' IS FIELD TOO LARGE 47120015 BC BH,DMPR7 BRANCH IF YES. 47140015 SPACE 47160015 * SET UP POINTER TO FIRST CHARACTER IN STRING. 47180015 SPACE 47200015 L R2,OSTADR POINT AT PREVIOUS DELIMITER. 47220015 LA R2,1(0,R2) BUMP POINTER TO FIRST CHARACTER. 47240015 LOOPCH CLI 0(R2),C'D' IS IT DICTIONARY 47260015 BC BNE,CHT BRANCH IF NOT. 47280015 OI INDIC,X'80' SET DICTIONARY BIT. 47300015 BC B,BUMPCH CONTINUE SCAN. 47320015 CHT CLI 0(R2),C'T' IS IT TEXT 47340015 BC BNE,CHS BRANCH IF NOT. 47360015 OI INDIC,X'40' SET TEXT BIT. 47380015 BC B,BUMPCH CONTINUE SCAN. 47400015 CHS CLI 0(R2),C'S' IS IT SCRATCH 47420015 BC BNE,CHP BRANCH IF NOT. 47440015 OI INDIC,X'20' SET SCRATCH BIT. 47460015 BC B,BUMPCH CONTINUE SCAN. 47480015 CHP CLI 0(R2),C'P' IS IT A PHASE 47500015 BC BNE,CHC BRANCH IF NOT. 47520015 OI INDIC,X'10' SET PHASE BIT. 47540015 BC B,BUMPCH CONTINUE SCAN. 47560015 CHC CLI 0(R2),C'C' IS IT A CONTROL PHASE 47580015 BC BNE,CHI BRANCH IF NOT 47600015 OI INDIC,X'08' SET CONTROL BIT. 47620015 BC B,BUMPCH 47640015 CHI CLI 0(R2),C'I' IS IT EXTENDED DICT 47660015 BC BNE,CHE BRANCH IF NOT 47680015 OI INDIC,X'04' SET CONTROL BIT 47700015 BC B,BUMPCH CONTINUE SCAN 47720015 CHE CLI 0(R2),C'E' IS IT EXTENDED TEXT 47740015 BC BNE,CHA BRANCH IF NOT 47760015 OI INDIC,X'02' SET EXTENDED TEXT BIT 47780015 BC B,BUMPCH CONTINUE SCAN 47800015 CHA CLI 0(R2),C'A' IS IT ANALYSIS 47820015 BC BNE,BUMPCH BRANCH IF NOT 47840015 OI INDIC,X'01' SET ANALYSIS BIT 47860015 BUMPCH LA R2,1(0,R2) BUMP POINTER TO NEXT CHARACTER. 47880015 CR R1,R2 IS IT END OF DUMP PARAM FIELD 47900015 BC BNE,LOOPCH LOOP IF NOT. 47920015 SPACE 47940015 * SET UP A POINTER TO THE PHASE DIRECTORY 47960015 SPACE 47980015 PDPTR L R6,PAROF(0,CNTL) POINT AT INITIALIZATION LIST 48000015 L R6,PDOF(0,R6) POINT TO START OF PHSE DIRECTORY 48020015 ST R6,PHDPTR SAVE PHASE DIRECTORY ADDRESS 48040015 SPACE 48060015 DMPR2 LTR R5,R5 HAS CLOSING PAREN BEEN REACHED 48080015 BC BNE,DMPR4 BRANCH IF SCAN IS NOT COMPLETE 48100015 L R3,STRLNG PICK UP STRING LENGTH 48120015 C R3,OP1 IS IT END OF OPTIONS FIELD 48140015 BC BNH,ENDTEST BRANCH IF END OF FIELD 48160015 BAL R14,DELSCAN LOOK FOR NEXT DELIMITER 48180015 CLI 0(R1),C',' IS IT A COMMA 48200015 BC BNE,DMPR7 ERROR IF NOT 48220015 C R4,OP2 IS COMMA IMMEDIATELY AFTER ) 48240015 BC BNL,DMPR7 ERROR IF NOT 48260015 RETBACK L R14,OPTEMP RECLAIM LINK REGISTER 48280015 BC B,DMPR5 MARK DUMP WANTED AND RETURN 48300015 SPACE 48320015 ENDTEST BAL R14,DELSCAN SET SCAN POINTER CORRECTLY 48340015 BC B,RETBACK 48360015 SPACE 48380015 DMPR4 BAL R14,DELSCAN SCAN FOR NEXT DELIMITER 48400015 CLI 0(R1),C',' IS IT A COMMA 48420015 BC BNE,DMPR6 BRANCH IF NOT 48440015 CLI SUBLNG+3,X'03' IS FIELD CORRECT LENGTH 48460015 BC BNE,DMPR3 BRANCH IF NOT 48480015 SPACE 48500015 * SET UP TO SEARCH THE PHASE DIRECTORY FOR THE PHASE THAT 48520015 * IS TO BE DUMPED. IF FOUND SET A BIT ON IN THE STATUS BYTE. 48540015 SPACE 48560015 DMPR9 L R2,OSTADR POINT AT DUMP PARAMETER 48580015 MVC FRSTWD,1(R2) MOVE IT INTO ARGUMENT SLOT 48600015 XC SCNDWD,SCNDWD CLEAR SECOND ARGUMENT SLOT 48620015 BAL R14,PDSRCH MARK PHASE TO SHOW DUMP WANTED 48640015 BC B,DMPR2 GO TO CONTINUE SCAN 48660015 SPACE 48680015 DMPR3 L R2,OSTADR POINT TO LAST DELIMITER 48700015 CLI 0(R2),C')' WAS IT END OF INCLUSIVE SCAN 48720015 BC BE,DMPR4 BRANCH IF YES 48740015 SPACE 48760015 * ERROR IN SYNTAX,PRINT MSG AND RETURN TO OPTION SCANNER 48780015 DMPR7 L R1,PRDCB POINT AT PRINT DCB 48800015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 025-TSS 48810019 PUT (1) GET A(BUFFER) 48820015 * ----------------------------------------------------AB 025-TSS 48825019 OI SEVBITS+1,X'07' SET SEVBITS TO SEVERE. H106 48830017 MVC 5(50,R1),OPMSG5 INSERT MSG 48840015 MVI 4(R1),C'0' INSERT DOUBLE SPACE CONTROL 48860015 MVC 0(2,R1),OP55 INSERT RECORD LENGTH 48880015 L R14,OPTEMP RECLAIM LINK REGISTER 48900015 BCR BR,R14 RETURN TO CALLER 48920015 SPACE 48940015 DMPR6 CLI 0(R1),C'(' IS IT START OF INCLUSIVE SCAN 48960015 BC BNE,DMPR8 BRANCH IF NOT INCLUSIVE SCAN 48980015 LA R5,1(0,R5) COUNT LEFT PAREN 49000015 BAL R14,DELSCAN GET NEXT DELIMITER 49020015 CLI 0(R1),C',' IS IT A COMMA 49040015 BC BNE,DMPR7 BRANCH IF NOT TO ERROR MSG 49060015 CLI SUBLNG+3,X'03' IS FIELD CORRECT LENGTH 49080015 BC BNE,DMPR7 BRANCH TO ERROR MSG IF NOT 49100015 L R2,OSTADR POINT TO START OF FIELD 49120015 MVC FRSTWD,1(R2) SET UP ARGUMENT SLOT 49140015 SPACE 49160015 BAL R14,DELSCAN GET NEXT DELIMITER 49180015 CLI 0(R1),C')' IS IT END OF INCLUSIVE SCAN 49200015 BC BNE,DMPR7 BRANCH TO ERROR MSG IF NOT END 49220015 BCTR R5,0 DECREMENT PAREN COUNTER 49240015 CLI SUBLNG+3,X'03' IS SECOND FIELD CORRECT LENGTH 49260015 BC BNE,DMPR7 GO TO ERROR MSG ROUTINE IF NOT 49280015 L R2,OSTADR POINT TO START OF FIELD 49300015 MVC SCNDWD,1(R2) SET UP END ARG SLOT 49320015 SPACE 49340015 BAL R14,PDSRCH MARK REQUESTED PHASES AS WANTED 49360015 BC B,DMPR4 49380015 SPACE 49400015 DMPR8 CLI 0(R1),C')' IS IT END OF OPTION PARAM LIST 49420015 BC BNE,DMPR7 GO TO ERROR MSG ROUTINE 49440015 BCTR R5,0 DECREMENT PAREN COUNTER 49460015 CLI SUBLNG+3,X'03' DOES DELIMITER DEFINE LAST FIELD 49480015 BC BE,DMPR9 BRANCH IF LAST NAME REACHED 49500015 SPACE 49520015 L R2,OSTADR POINT TO PREVIOUS DELIMITER 49540015 CLI 0(R2),C')' WAS IT END OF INCLUSIVE SCAN 49560015 BC BNE,DMPR7 BRANCH TO ERROR MSG IF NOT 49580015 BC B,DMPR2 49600015 SPACE 49620015 * A SUBROUTINE TO MARK PHASES THAT ARE TO BE DUMPED 49640015 SPACE 49660015 PDSRCH ST R14,OPTEMP2 SAVE RETURN REG 49680015 MVI SWTCH,X'00' TURN OFF INCLUSIVE MARKING SWTCH 49700015 MVI PDSWT,X'00' SWITCH ON 1ST HALF PD SEARCH 49720015 L R1,PHDPTR POINT AT PHASE DIRECTORY 49740015 SPACE 49760015 PDSRCH2 CLC FRSTWD,0(R1) IS THIS THE REQUESTED PHASE 49780015 BC BE,PDSRCH3 BRANCH IF FOUND 49800015 TM SWTCH,X'FF' IS IT SECOND ARG SEARCH 49820015 BC BZ,PDSRCH1 BRANCH IF NOT 49840015 OI 2(R1),X'01' SHOW DUMP WANTED 49860015 SPACE 49880015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 088-TSS 49890020 PDSRCH1 TM PDSWT,X'FF' IS IT 2ND HALF PD SEARCH 49900015 BC BO,PD2SRCH BRANCH IF YES 49920015 LA R1,12(0,R1) BUMP PHASE DIRECTORY POINTER 49940015 CLI 0(R1),X'00' IS IT END 49960015 BC BNE,PDSRCH2 BRANCH IF NOT END 49980015 SPACE 50000015 L R1,PAROF(0,CNTL) PICK UP ADDRESS OF ADDRESS LIST 50020015 L R1,SECPDOF(0,R1) PICK UP ADDRESS OF 2ND HALF PD 50040015 MVI PDSWT,X'FF' SWITCH ON 2ND HALF PD SEARCH 50060015 BC B,PDSRCH2 BRANCH TO SEARCH 50080015 SPACE 50100015 PD2SRCH LA R1,3(0,R1) BUMP 2ND HALF PD POINTER 50120015 * ----------------------------------------------------AB 088-TSS 50130020 CLI 0(R1),X'00' IS IT END 50140015 BC BNE,PDSRCH2 BRANCH IF NOT END 50160015 SPACE 50180015 * REQUESTED PHASE NOT IN DIRECTORY,PRINT MSG AND RETURN 50200015 SPACE 50220015 L R1,PRDCB POINT AT DCB 50240015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 026-TSS 50250019 PUT (1) GET A(BUFFER) 50260015 * ----------------------------------------------------AB 026-TSS 50265019 OI SEVBITS+1,X'03' SET SEVBITS TO ERROR. H106 50270017 MVC 5(84,R1),OPMSG4 INSERT MSG 50280015 MVC 86(2,R1),FRSTWD INSERT NAME NOT FOUND 50300015 MVI 4(R1),C'0' INSERT DOUBLE SPACE CONTROL 50320015 MVC 0(2,R1),OP89 INSERT RECORD LENGTH 50340015 PDSRCH4 L R14,OPTEMP2 RECLAIM LINK REGISTER 50360015 BCR BR,R14 RETURN TO CALLER 50380015 SPACE 50400015 PDSRCH3 OI 2(R1),X'01' SHOW DUMP WANTED 50420015 ST R1,PHDPTR SAVE A(LAST PROCESSED) 50440015 CLC SCNDWD,OPZERO IS THERE A SECOND ARGUMENT 50460015 BC BZ,PDSRCH4 BRANCH IF MARKING IS COMPLETE 50480015 SPACE 50500015 MVC FRSTWD,SCNDWD SET UP FOR INCLUSIVE MARKING 50520015 XC SCNDWD,SCNDWD CLEAR SECOND ARG SLOT 50540015 MVI SWTCH,X'FF' TURN ON INCLUSIVE MARKING SWITCH 50560015 BC B,PDSRCH1 CONTINUE MARKING PHASES 50580015 EJECT 50600015 * THIS ROUTINE PROCESSES THE MODEL OPTION 50620015 SPACE 50640015 M91PR MVI MODBYT,X'01' SHOW MOD 91 OPTION WANTED 50660015 BCR BR,R14 RETURN 50680015 NOM91PR MVI MODBYT,X'00' SHOW MOD 91 OPTION NOT WANTED 50700015 BCR BR,R14 RETURN 50720015 EJECT 50740015 NMPR ST R14,OPTEMP SAVE LINK REGISTER 50760015 L R1,STADDR CHECK THAT 50780015 CLI 0(R1),C'=' DELIMITER IS '=' 50800015 BC BE,FNDWRD 50820015 OBJERR L R1,PRDCB POINT AT PRINT DCB 50840015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 027-TSS 50850019 PUT (1) FIND BUFFER SPACE 50860015 * ----------------------------------------------------AB 027-TSS 50865019 OI SEVBITS+1,X'03' SET SEVBITS TO ERROR. H106 50870017 MVC 5(88,R1),OPMSG3 MOVE IN MESSAGE 50880015 MVC 78(15,R1),OBJ MOVE IN NAME 50900015 MVI 4(R1),C'0' CONTROL CHAR 50920015 MVC 0(2,R1),OP93 MOVE IN LENGTH 50940015 BC B,NONAM 50960015 FNDWRD BAL R14,DELSCAN SCAN FOR NEXT DELIMITER 50980015 L R1,OSTADR POINT 1 CHAR BEFORE NAME 51000015 LA R2,NAMSAVE POINT AT NAMSAVE 51020015 C R4,OP9 IS NAME LONGER THAN 8 CHARS 51040015 BC BH,NMERR 51060015 C R4,OP2 SEE IF NULL NAME FIELD 51080015 BC BL,OBJERR 51100015 S R4,OP2 ADJUST LENGTH FOR MOVE INSTR 51120015 EX R4,MVCINS4 MOVE NAME INTO NAMSAVE 51140015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 058-TSS 51146019 * ----------------------------------------------------AB 058-TSS 51152019 GOBACK MVI NAMSW,X'FF' TURN ON NAMSW 51160015 NONAM L R14,OPTEMP 51180015 BCR BR,R14 RETURN TO CALLER 51200015 NMERR MVC 0(8,R2),1(R1) MOVE IN FIRST 8 CHARS OF NAME 51220015 L R1,PRDCB POINT AT PRINT DCB 51240015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 028-TSS 51250019 PUT (1) FIND BUFFER SPACE 51260015 * ----------------------------------------------------AB 028-TSS 51265019 OI SEVBITS+1,X'03' SET SEVBITS TO ERROR. H106 51270017 MVC 0(83,R1),NAMMES MOVE IN MESSAGE 51280015 BC B,GOBACK 51300015 EJECT 51320015 * THE FOLLOWING ROUTINES PROCESS OPTIONS BY SETTING 51340015 * APPROPRIATE SWITCHES IN A WORD THAT WILL BE PLACED IN THE 51360015 * COMMUNICATIONS AREA.THE SWITCHES SPECIFY WHETHER A COMPILER 51380015 * FEATURE IS WANTED OR NOT. 51400015 SPACE 51420015 ATRPR NI CCCADE,X'FE' SHOW ATR LISTING WANTED 51440015 BC B,0(0,R14) RETURN 51460015 NOATRP OI CCCADE,X'01' SHOW ATR LISTING NOT WANTED 51480015 BC B,0(0,R14) RETURN 51500015 SPACE 51520015 BCDPR OI CCCADE+2,X'20' SHOW BCD INPUT 51540015 BC B,0(0,R14) RETURN 51560015 EBCDPR NI CCCADE+2,X'DF' SHOW EBCDIC INPUT 51580015 BC B,0(0,R14) RETURN 51600015 SPACE 51620015 CHR60PR OI CCCADE+1,X'02' SHOW 60 CHAR SET USED 51640015 BC B,0(0,R14) RETURN 51660015 CHR48PR NI CCCADE+1,X'FD' SHOW 48 CHAR SET USED 51680015 BC B,0(0,R14) RETURN 51700015 SPACE 51720015 DCKPR NI CCCADE,X'F7' SHOW DECK WANTED 51740015 BC B,0(0,R14) RETURN 51760015 NODKPR OI CCCADE,X'08' SHOW DECK NOT WANTED 51780015 BC B,0(0,R14) RETURN 51800015 SPACE 51820015 EXRFPR NI CCCADE,X'FB' SHOW EXTREF WANTED 51840015 BC B,0(0,R14) RETURN 51860015 NEXRFPR OI CCCADE,X'04' SHOW EXTREF NOT WANTED 51880015 BC B,0(0,R14) RETURN 51900015 SPACE 51920015 FLGWPR NI CCCADE+1,X'C3' SHOW FLAGW 51940015 BC B,0(0,R14) RETURN 51960015 FLGEPR NI CCCADE+1,X'C3' CLEAR FIELD 51980015 OI CCCADE+1,X'04' SHOW FLAGE 52000015 BC B,0(0,R14) RETURN 52020015 FLGSPR NI CCCADE+1,X'C3' CLEAR FIELD 52040015 OI CCCADE+1,X'08' SHOW FLAGS 52060015 BC B,0(0,R14) RETURN 52080015 SPACE 52100015 LISTPR NI CCCADE,X'DF' SHOW LIST WANTED 52120015 BC B,0(0,R14) RETURN 52140015 NLSTPR OI CCCADE,X'20' SHOW LIST NOT WANTED 52160015 BC B,0(0,R14) RETURN 52180015 SPACE 52200015 LOADPR NI CCCADE,X'EF' SHOW LOAD WANTED 52220015 BC B,0(0,R14) RETURN 52240015 NLODPR OI CCCADE,X'10' SHOW LOAD NOT WANTED 52260015 BC B,0(0,R14) RETURN 52280015 SPACE 52300015 XREFPR NI CCCADE,X'FD' SHOW XREF WANTED 52320015 BC B,0(0,R14) RETURN 52340015 NXRFPR OI CCCADE,X'02' SHOW XREF NOT WANTED 52360015 BC B,0(0,R14) RETURN 52380015 SPACE 52400015 SRCEPR NI CCCADE+2,X'7F' SHOW SOURCE WANTED 52420015 BC B,0(0,R14) RETURN 52440015 NSRCPR OI CCCADE+2,X'80' SHOW SOURCE NOT WANTED 52460015 BC B,0(0,R14) RETURN 52480015 SPACE 52500015 MACROPR NI CCCADE+1,X'FE' SHOW MACRO WANTED 52520015 BC B,0(0,R14) 52540015 NOMACPR OI CCCADE+1,X'01' SHOW MACRO NOT WANTED 52560015 BC B,0(0,R14) 52580015 SPACE 52600015 MACDKPR NI CCCADE+3,X'BF' SHOW MACDK WANTED 52620015 BC B,0(0,R14) 52640015 NOMDKPR OI CCCADE+3,X'40' SHOW MACDK NOT WANTED 52660015 BC B,0(0,R14) 52680015 SPACE 52700015 COMPPR NI CCCADE+3,X'DF' SHOW COMPILATION WANTED 52720015 BC B,0(0,R14) 52740015 NOCOMPR OI CCCADE+3,X'20' SHOW COMPILATION NOT WANTED 52760015 BC B,0(0,R14) 52780015 SPACE 52800015 STMTPR NI CCCADE+3,X'7F' SHOW STMT WANTED 52820015 BC B,0(0,R14) 52840015 NOSTMTPR OI CCCADE+3,X'80' SHOW NOSTMT REQUIRED 52860015 BC B,0(0,R14) 52880015 SPACE 52900015 SRC2PR OI CCCADE+2,X'10' SHOW SOURCE2 WANTED 52920015 BC B,0(0,R14) RETURN 52940015 NSC2PR NI CCCADE+2,X'EF' SHOW SOURCE2 NOT WANTED 52960015 BC B,0(0,R14) RETURN 52980015 SPACE 52981015 NESTPR OI CCCADE+3,X'01' SHOW NWST WANTED 52982015 BCR BR,R14 52983015 SPACE 52984015 NNSTPR NI CCCADE+3,X'FE' SHOW NEST UNWANTED 52985015 BCR BR,R14 52986015 SPACE 52987015 OPROC MVI OPBYTE,X'FF' OPLIST WANTED 52988015 BCR BR,R14 52989015 SPACE 52990015 NOPROC MVI OPBYTE,X'00' OPLIST UNWANTED 52991015 BCR BR,R14 52992015 SPACE 53000015 BDPR MVI DICBYTE,X'FF' SHOW BIG DIC 53020015 BCR BR,R14 53040015 NBDPR MVI DICBYTE,X'00' SHOW NORMAL DIC 53060015 BCR BR,R14 RETURN 53080015 * 53100015 * THIS IS THE CHK OPTION PROCESSING ROUTINE. IT WILL 53120015 * BE REMOVED IN THE FINAL VERSION. 53140015 SPACE 53160015 CHKPR NI CCCADE+2,X'BF' SHOW CHK WANTED 53180015 BC B,0(0,R14) RETURN 53200015 SPACE 1 53205001 TRAPAT OI CCCADE+3,X'02' SHOW TRACE OR PATCH WANTED.IEMAT 53210001 BC B,0(0,R14) IEMAT 53215001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 097-TSS 53215420 SPACE 53215819 SKEPR MVI SKSW,X'08' SHOW SKE I25 53216619 BR R14 RETURN I25 53217419 SKSPR MVI SKSW,X'04' SHOW SKS I25 53218219 SKTPR BR R14 RETURN I25 53219019 * ----------------------------------------------------AB 097-TSS 53219520 EJECT 53220015 SPACE 6 53225017 * C O N S T A N T S 53230017 * 53235017 * *************************** 53240017 * *********************** 53245017 * ******************* 53250017 * *************** 53255017 * *********** 53260017 * ******* 53265017 * *** 53270017 EJECT 53275017 OPBYTE DC X'00' 53283017 KEYERRSW DC X'00' 53287017 BTSW DC X'00' 53291017 ONEPD DC X'00001F' 53299017 BUFMES DC X'0041' 53303017 DC X'0000' 53307017 DC C'-IEM3910I SYSPRINT BLOCKSIZE TOO LARGE WITH THIS SIZE' 53311017 DC C' OPTION.' 53315017 IN DC C'IN ' 53319017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 092-TSS 53325020 MAXAMT DC F'999999' 53327017 * ----------------------------------------------------AB 092-TSS 53329020 MVBAK DS F 53335017 STBAK DC F'0' 53339017 DICBYTE DC X'00' 53347017 FSTBD DC X'0178' 53351017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 083-TSS 53357019 SAOPT DS 100C 53359017 * ----------------------------------------------------AB 083-TSS 53361019 SAVOPT MVC SAOPT(0),0(R1) SAVE OPTION STRING 53363017 RSTOPT MVC 0(0,R3),SAOPT RESTORE OPTION STRING 53367017 ADOPT DC A(OPT) 53379017 THREE DC F'3' 53383017 MODBYT DC X'00' 53387017 RRSAVE DS F 53391017 MVTTST DC F'0' 53395017 NOPINS DC X'47000000' 53399017 OP3 DC H'3' 53403017 DS 8F 53407017 BIGDC DC C'EXTDIC' 53411017 FOURHN DC F'400' 53415017 DEVRES DC 2F'0' 62596 53415572 EJECT 53416017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 082-TSS 53416519 PDLAST DC A(LAST) END OF BLDL LIST 53417017 SECLAST DC A(LAST2) 53418017 * ----------------------------------------------------AB 082-TSS 53418519 NESTWR DC C'NEST' 53419017 OPLSTW DC C'OPLIST' 53420017 ONEH DC F'100' 53421017 FIVEH DC F'500' H69 53422017 ETY DC F'80' 53423017 LRECL DC F'0' 53425017 BLKSIZE DC F'0' 53426017 PRSYNAA DC F'0' ADDR OF PRINT SYNAD IN IEMAA PTM825 53426501 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 039-TSS 53426719 SAVAR DC 18F'0' 53427017 * ----------------------------------------------------AB 039-TSS 53427519 GETLST DC 2F'0' 53429017 ANSW DC F'0' 53430017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 056-TSS 53432519 EXPL DC X'85' 53433017 DC AL3(PLINEX) 53434017 EXPR DC X'85' 53435017 DC AL3(PRINEX) 53436017 * ----------------------------------------------------AB 056-TSS 53436519 BWNAME DC CL8'IEMAC' NAME OF INTERMTE FILE WRITE RTN 53437017 NUMBR DC F'4' 53438017 PDECF DS D 53440017 UDECF DS D 53441017 FTY1 DC XL4'4F' 53442017 FTY5 DC XL4'53' 53443017 FTY9 DC XL4'57' 53444017 FTYD DC XL4'5B' 53445017 STOPPER DC X'00FF0000' 53446017 DICTAD DC F'0' 53447017 ERR90 DC X'005A00' 53449017 ERRF23 DC X'0F2300' 53450017 ERRF25 DC X'0F2500' 53451017 ERRF30 DC X'0F3004' IEM3888I. I14 53451817 ERRF31 DC X'0F3104' IEM3889I. I14 53452617 ERRF32 DC X'0F320C' IEM3890I. H69 53453417 ERRF33 DC X'0F3300' IEM3891I. H69 53454217 ERRF34 DC X'0F3400' IEM3892I. ( NOT USED.) H69 53455017 ERRF35 DC X'0F3500' IEM3893I. H69 53455817 ERRF36 DC X'0F3600' IEM3894I. H69 53456617 ERRF37 DC X'0F3700' IEM3895I. H69 53457417 ERRF38 DC X'0F3800' IEM3896I. H69 53458217 ERRF39 DC X'0F3900' IEM3897I. H69 53459017 ERRF49 DC X'0F4904' IEM3913I. I14 53459817 ERRF4A DC X'0F4A04' IEM3914I. I14 53460617 ERRF4B DC X'0F4B08' IEM3915I. H169 53460817 ERRF4C DC X'0F4C08' IEM3916I. H169 53461017 ERRF4D DC X'0F4D08' IEM3917I. H169 53461217 DUDPRINT DC X'00' SET ON IF SYSPRINT INVALID. H69 53461417 RECM DC X'00' 53463017 BUFNO DC X'00' 53464017 BLOKF DC X'00' 53465017 PLINSW DC X'00' 53466017 INRECM DC X'00' 53468017 CORAVL DC F'8192' DEFAULT CORE BEFORE BLOCKS ALLOC 53477017 ZEROS DC XL8'00' 53478017 FR96 DC F'4096' 53479017 TWOK DC F'2048' 53480017 READSW DC X'00' 53481017 OPENSW DC X'00' 53482017 CONTRL DC C',' 53483017 CNTLCHAR DC X'000000' 53484017 DC C')' 53485072 ONEK DC F'1024' 53486017 FSTFON DC X'005E' 53487017 ZSTCHOF DC X'0174' 53488017 FSTD DC XL2'0300' 53489017 PAGSV DC X'00001F' 53491017 M3862A DC C'IEM3862I I/O ERR' H229 53491301 M3862B DC C'CONT-' H229 53491601 HEDING DC C' ' 53492017 DC C' ' 53493017 DC C' PL' 53494017 DC C'/I F-COMPILER ' 53495001 DC C' ' 53496017 DC C' ' 53497017 DC C' PAGE' 53498017 DC C' 000001 ' 53499017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 096-TSS 53499520 INERR DC X'0022' 53500017 DC X'0000' 53501017 DC C'-IEM3874I UNABLE TO OPEN SYSIN' 53502017 BLDMES DC X'002E' 53503017 DC X'0000' 53504017 DC C'-IEM3841I I/O ERROR ON SEARCHING DIRECTORY' 53505017 KILSU3 DC X'001F' 53506017 DC C'-' 53507017 DC C'IEM3880I UNABLE TO OPEN SYSUT3.' 53508017 SPLMES DC X'001E' 53509017 DC C'-' 53510017 DC C'IEM3878I UNABLE TO OPEN SYSUT1' 53511017 * ----------------------------------------------------AB 096-TSS 53511520 SPACE 53512017 EJECT 53513017 ALLRST DC X'0056' 53514017 DC C'-' 53515017 DC C'THE COMPLETE LIST OF OPTIONS USED DURING THIS ' 53516017 DC C'COMPILATION IS-- ' 53517017 NOPOS DC C' ' 53518017 OPTION DC 18C' ' 53519017 BLANKT DC 63C' ' 53520017 EJECT DC X'0000' EJECT CONTROL 53521017 DC C'1' 53522017 NO DC C'NO' 53523017 BLANKS DC 11C' ' 53524017 EBCID DC C'EBCDIC' 53525017 BCDC DC C'BCD' 53526017 CHR60 DC C'CHAR60' 53527017 CHR48A DC C'CHAR48' 53528017 MACRODC DC C'MACRO' 53529017 MACDKDC DC C'MACDCK' 53530017 COMPDC DC C'COMP' 53531017 STMTDC DC C'STMT' 53532017 SRCE DC C'SOURCE' 53533017 SRCE2 DC C'SOURCE2' 53534017 ATRIB DC C'ATR' 53535017 CROSSR DC C'XREF' 53536017 EXTERN DC C'EXTREF' 53537017 PRLIST DC C'LIST' 53538017 LFILE DC C'LOAD' 53539017 CARDS DC C'DECK' 53540017 FLAGC DC C'FLAG' 53541017 SZEQ DC C'SIZE=' 53542017 NOLINE DC C'LINECNT=' 53543017 DUMPR DC C'DUMP' 53545017 OPTDC DC C'OPT=' 53546017 SOURCM DC C'SORMGIN=(' 53547017 SORV DC C'XXX' 53548017 DC C',' 53549017 MARV DC C'YYY)' 53550017 CHKRR DC C'CHK' 53551017 M91DC DC C'OBJIN' I24 53552019 OBNM DC C'OBJNM=' 53553017 SKEC DC C'SYNCHK' I25 53553219 TRACAPA DC C'TRACE && PATCH' IEMAT 53553501 NAMMES DC H'83' 53554017 DC C' 0IEM3902I OBJNM FIELD TOO LARGE.' 53555017 DC C' FIRST EIGHT CHARACTERS OF NAME HAVE BEEN USED.' 53556017 OP9 DC F'9' 53557017 OP7 DC F'7' 53558017 DS 0D 53559017 MINMAX DC F'8' 53560017 DC F'1000000' 53561017 OP4 DC F'4' 53562017 ONE25 DC F'125' 53563017 NINE99 DC C'999999' 53564017 SPDLTH DC H'352' 53565017 ANSWGM DC 9D'0' 53566017 SZWRMS DC H'96' 53567017 DC C' 0IEM3911 SIZE AVAILABLE FOUND TO BE BYTES. ' 53568017 DC C'SIZE=44K ASSUMED. ' 53569017 DC C'COMPILATION CONTINUES.' 53570017 NAMSW DC X'00' 53571017 NAMSAVE DC CL8' ' 53572017 SPACE 10 53573017 * 53593017 BTCHMS1 DC H'40' 53613017 DC C' 0IEM3900I ERROR IN PROCESS STATEMENT' 53633017 BTCHMS2 DC H'66' 53653017 DC C' 0IEM3901I ERROR IN PROCESS STATEMENT. DEFAULT OPTIONS ASSUMED.' 53673017 EJECT 53693017 PAGENBR DC CL108' ' 53695017 PAGENBR1 DC C'PAGE 1 ' 53697017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 060-TSS 53698019 HEDING1 DC C'VERSION 5.5 OS/36' 53699072 DC C'0 PL/I COMPILER (F) ' 53701001 DC C' DATE . ' 53703001 * ----------------------------------------------------AB 060-TSS 53704019 HEDING2 DC C'PL/I F COMPILER OPTIONS SPECIFIED ARE AS FOLLOWS--' 53705017 OPMSG1 DC C'IEM3904I THE FOLLOWING STRING NOT IDENTIFIED AS A KEY' 53707017 DC C'WORD- ' 53709001 DC 60C' ' 53711001 OPMSG2 DC C'IEM3905I THE FOLLOWING KEYWORD DELETED, DEFAULT USED ' 53713017 DC C'FOR-- ' 53715001 CNDLMS DC H'99' 53717017 DC C' 0IEM3905I THIRD ARGUMENT OF SORMGIN OPTION ' 53719017 DC C'DELETED. CONTROL CARRIAGE CHARACTER COLUMN NOT USED.' 53721017 OPMSG3 DC C'IEM3906I OPTION SPECIFICATION CONTAINS INVALID SYNTAX' 53723017 OPMSG3A DC C', DEFAULT USED FOR- ' 53725017 OPMSG4 DC C'IEM3907I THE FOLLOWING NAME IGNORED AS IT DOES NOT AP' 53727017 DC C'PEAR IN THE PHASE DIRECTORY- .' 53729001 OPMSG5 DC C'IEM3908I SYNTAX ERROR IN DUMP OPTION SPECIFICATION' 53731017 NINBLNKS DC C' ' NINE BLANKS CONSTANT 30333 53733020 LCNT DC CL15'LINECNT' 53735017 SIZ DC CL15'SIZE' 53739017 SMGIN DC CL15'SORMGIN' 53741017 OBJ DC CL15'OBJNM' 53743017 OPTNME DC CL15'OPT' 53745017 SYSUT2 DC C'SYSUT2 ' DDNAME SLOT FOR SYSUT2 53747017 CNTLMES DC H'91' H334 53750019 DC C' 0IEM3903I' H334 53751019 DC C' CARRIAGE CONTROL POSITION LIES WITHIN THE' H334 53752019 DC C' SOURCE MARGIN. IT HAS BEEN IGNORED.' 53755017 ARG DC C'ARGUMENT' H278 53755501 ARGNO DC C'1755' H278 53756001 SMARGSW DC X'00' H278 53756501 PATRN DC X'402020202020' PAGE NUMBER EDIT WORD 53759017 FOURTEEN DC F'14' 30333 53760020 EIGHT DC F'8' 53761017 OPZERO DC F'0' 53763017 DC F'0' 53765017 OP1 DC F'1' 53767017 OP2 DC F'2' 53769017 OP55 DC H'55' 53771017 OP60 DC F'60' 53773017 OP80 DC H'80' 53775017 OP89 DC H'89' 53777017 OP93 DC H'93' 53779017 OP95 DC H'95' H278 53780001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 074-TSS 53782019 OP100 DC F'100' 53783017 * ----------------------------------------------------AB 074-TSS 53785019 OP125 DC H'125' 53787017 OP44K DC F'45056' 53789017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 055-TSS 53789119 * ----------------------------------------------------AB 055-TSS 53789219 SPACE 2 53789319 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 094-TSS 53789420 STATOP3 DC 95C' ' I16 53789619 * ----------------------------------------------------AB 094-TSS 53789720 SEVBITS DC H'0' H106 53789919 CONFLICT DC F'0' H169 53790219 DICTEM DS F HOLDS A(DICTIONARY) IEMAT 53790519 EJECT 53791017 * 53793017 * START OF FOURTH CSECT 53795017 * 53797017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 087-TSS 53798020 IEMAB3 CSECT 53799017 * ----------------------------------------------------AB 087-TSS 53800020 USING SECT1,CNTLB 53801017 USING SECT2,CNTL2 53803017 USING SECT3,CNTL3 53805017 USING *,CNTL4 53807017 SECT4 EQU * 53809017 EJECT 53811017 SPACE 53819017 LIM1 DC F'8192' I14 53820017 LIM2 DC F'16384' I14 53821017 LIM3 DC F'32768' I14 53822017 LIM4 DC F'94208' 64K PLUS 28K EXTRA. I14 53823017 LIM5 DC F'131072' I14 53824017 * VALUES OF LIM1 THRU LIM5 FOR EXTDIC, GIVE SPACE FOR OFLO BLK. 62615 53825072 EDLIMS DC A(8192+1024),A(16384+2048),A(32768+4096) 62615 53825372 DC A(94208+8192),A(131072+16384) 62615 53825672 F258 DC F'258' I14 53826017 F400 DC F'400' I14 53827017 F1000 DC F'1000' I14 53828017 * I14 53829017 PUNSW DC F'0' HOLDS SYSPUNCH ERROR FLAGS. I14 53830017 LINSW DC F'0' HOLDS SYSLIN ERROR FLAGS. I14 53831017 * I14 53832017 HOLDBSZ DC F'0' HOLDS THE USERS SYSPUNCH I14 53833017 * OR SYSLIN BLOCKSIZE IF IT IS I14 53834017 * INVALID, SO THAT WE CAN RESET I14 53835017 * THE DCB BEFORE CLOSING. I14 53836017 * 53837017 STATLIN DC H'119' TRIPLE LINE I16 53838017 STATCC DC C'-' HOLDING OPTIONS I16 53839017 DC C'*OPTIONS IN EFFECT* ' FOR I16 53840017 STATOP1 DC 95C' ' STATISTICS. I16 53841017 STATOP2 DC 95C' ' I16 53842017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 095-TSS 53850020 * ----------------------------------------------------AB 095-TSS 53858020 SPACE 53867017 EJECT 53870017 * 53873017 * WORK SPACE FOR THE OPTION PROCESSING ROUTINE 53876017 * 53879017 OPRGSV0 DS F SLOT FOR PARAMETER LIST POINTER 53882017 OSTADR DS F START ADDRESS OF SUBSTRING 53885017 STADDR DS F START ADDRESS FOR STRING SCAN 53888017 ENDADR DS F END ADDRESS OF CHARACTER STRING 53891017 STRLNG DS F CHARACTER STRING LENGTH 53894017 SUBLNG DS F SUBSTRING LENGTH 53897017 OPTEMP DS F TEMP WORK SLOT 53900017 OPTEMP1 DS D WORK SPACE FOR DEC TO BIN CONV. 53903017 OPTEMP2 DS F TEMP WORK SLOT 53906017 OPTEMP3 DS F TEMPORARY WORK SPACE 53907017 PRDCB DS F ADDRESS OF PRINT DCB 53909017 OPTVLU DS F SLOT FOR OPT OPTION VALUE 53912017 DFLTSV1 DS F SLOT TO SAVE KEYWORD PTR 53915017 CCCADE DC X'00014060' 53918017 PHDPTR DS F ADDRESS OF PHASE DIRECTORY 53921017 FRSTWD DS H SLOT TO CONTAIN DUMP PARAMETER 53924017 SCNDWD DS H DITTO 53927017 SPACE 2 53927801 DS 0F 53928601 AF EQU * DEFAULT AND DELETE BITS 53929401 DFLTSWTS DS C 53930201 DS C 53931001 DS C 53931801 DS C 53932601 DS C 53933401 DS C 53934201 DS C 53935001 DS C 53935801 DS C 53936601 DS C 53937401 DS C 53938201 DS C 53939001 DS C 53939801 DS C SPARE 53940601 LINECNT DS F 53941401 SIZE DS F 53942201 SORMGINS DS F 53943001 SORMGINE DS F 53943801 CNTLCOL DS F 53944601 DS F SPARE 53945401 DS F SPARE 53946201 SPACE 2 53947001 SWTCH DS X BYTE USED FOR A SWITCH 53948017 PDSWT DS X BYTE USED FOR PD SWITCH 53951017 INDIC DC X'00' DUMP CONTROL BYTE. 53954017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 098-TSS 53954520 SKSW DC X'00' SYNTAX CHECK SWITCH I25 53955019 * ----------------------------------------------------AB 098-TSS 53956020 OPTHIGH DC A(NOPTLVLS-1) HIGHEST OPT LEVEL 53957001 EJECT 53960015 * THIS IS THE KEYWORD TABLE 53980015 SPACE 54000015 CNOP 0,8 54020015 KEYWORD DC X'08' KEYWORD LENGTH PLUS ONE (KL) 54040015 DC CL15'LINECNT' KEYWORD (KW) 54060015 DC X'00' PROCESSED INDICATOR BYTE (PB) 54080015 DC AL3(LNCNT) A(OPTION PROCESSING ROUTINE)(PR) 54100015 DC H'0' DEFAULT BIT POSITION NBR (DFB) 54120015 DC H'78' DELETE BIT POSTION NUMBER (DLB) 54140001 DC A(AVLC) ALT 54160015 SPACE 54180015 DC X'05' KL 54200015 DC CL15'SIZE' KW 54220015 DC X'00' PB 54240015 DC AL3(SZE) PR 54260015 DC H'0' DFB 54280015 DC H'80' DLB 54300001 DC A(0) ALT 54320015 SPACE 54340015 SORMGIN DC X'08' KL 54360015 DC CL15'SORMGIN' KW 54380015 DC X'00' PB 54400015 DC AL3(SRMGN) PR 54420015 DC H'0' DFB 54440015 DC H'81' DLB 54460001 DC A(AVM) ALT 54480015 SPACE 54500015 ATR DC X'04' KL 54520015 DC CL15'ATR' KW 54540015 DC X'00' PB 54560015 DC AL3(ATRPR) PR 54580015 DC H'0' DFB 54600015 DC H'54' DLB 54620001 DC A(NOATR) ALT 54640015 SPACE 54660015 NOATR DC X'06' KL 54680015 DC CL15'NOATR' KW 54700015 DC X'00' PB 54720015 DC AL3(NOATRP) PR 54740015 DC H'1' DFB 54760015 DC H'55' DLB 54780001 DC A(AVA) ALT 54800015 SPACE 54820015 BCD DC X'04' KL 54840015 DC CL15'BCD' KW 54860015 DC X'00' PB 54880015 DC AL3(BCDPR) PR 54900015 DC H'2' DFB 54920015 DC H'56' DLB 54940001 DC A(EBCDIC) ALT 54960015 SPACE 54980015 EBCDIC DC X'07' KL 55000015 DC CL15'EBCDIC' KW 55020015 DC X'00' PB 55040015 DC AL3(EBCDPR) PR 55060015 DC H'3' DFB 55080015 DC H'57' DLB 55100001 DC A(AVB) ALT 55120015 SPACE 55140015 CHAR60 DC X'07' KL 55160015 DC CL15'CHAR60' KW 55180015 DC X'00' PB 55200015 DC AL3(CHR60PR) PR 55220015 DC H'4' DFB 55240015 DC H'58' DLB 55260001 DC A(CHAR48) ALT 55280015 SPACE 55300015 CHAR48 DC X'07' KL 55320015 DC CL15'CHAR48' KW 55340015 DC X'00' PB 55360015 DC AL3(CHR48PR) PR 55380015 DC H'5' DFB 55400015 DC H'59' DLB 55420001 DC A(AVC60) ALT 55440015 SPACE 55460015 DECK DC X'05' KL 55480015 DC CL15'DECK' KW 55500015 DC X'00' PB 55520015 DC AL3(DCKPR) PR 55540015 DC H'6' DFB 55560015 DC H'60' DLB 55580001 DC A(NODECK) ALT 55600015 SPACE 55620015 NODECK DC X'07' KL 55640015 DC CL15'NODECK' KW 55660015 DC X'00' PB 55680015 DC AL3(NODKPR) PR 55700015 DC H'7' DFB 55720015 DC H'61' DLB 55740001 DC A(AVD) ALT 55760015 SPACE 55780015 EXTREF DC X'07' KL 55800015 DC CL15'EXTREF' KW 55820015 DC X'00' PB 55840015 DC AL3(EXRFPR) PR 55860015 DC H'8' DFB 55880015 DC H'62' DLB 55900001 DC A(NOEXTREF) ALT 55920015 SPACE 55940015 NOEXTREF DC X'09' KL 55960015 DC CL15'NOEXTREF' KW 55980015 DC X'00' PB 56000015 DC AL3(NEXRFPR) PR 56020015 DC H'9' DFB 56040015 DC H'63' DLB 56060001 DC A(AVE) ALT 56080015 SPACE 56100015 FLAGW DC X'06' KL 56120015 DC CL15'FLAGW' KW 56140015 DC X'00' PB 56160015 DC AL3(FLGWPR) PR 56180015 DC H'10' DFB 56200015 DC H'64' DLB 56220001 DC A(FLAGE) ALT 56240015 SPACE 56260015 FLAGE DC X'06' KL 56280015 DC CL15'FLAGE' KW 56300015 DC X'00' PB 56320015 DC AL3(FLGEPR) PR 56340015 DC H'11' DFB 56360015 DC H'65' DLB 56380001 DC A(FLAGS) ALT 56400015 SPACE 56420015 FLAGS DC X'06' KL 56440015 DC CL15'FLAGS' KW 56460015 DC X'00' PB 56480015 DC AL3(FLGSPR) PR 56500015 DC H'12' DFB 56520015 DC H'66' DLB 56540001 DC A(AVFW) ALT 56560015 SPACE 56580015 LIST DC X'05' KL 56600015 DC CL15'LIST' KW 56620015 DC X'00' PB 56640015 DC AL3(LISTPR) PR 56660015 DC H'13' DFB 56680015 DC H'67' DLB 56700001 DC A(NOLIST) ALT 56720015 SPACE 56740015 NOLIST DC X'07' KL 56760015 DC CL15'NOLIST' KW 56780015 DC X'00' PB 56800015 DC AL3(NLSTPR) PR 56820015 DC H'14' DFB 56840015 DC H'68' DLB 56860001 DC A(AVOL) ALT 56880015 SPACE 56900015 LOAD DC X'05' KL 56920015 DC CL15'LOAD' KW 56940015 DC X'00' PB 56960015 DC AL3(LOADPR) PR 56980015 DC H'15' DFB 57000015 DC H'69' DLB 57020001 DC A(NOLOAD) ALT 57040015 SPACE 57060015 NOLOAD DC X'07' KL 57080015 DC CL15'NOLOAD' KW 57100015 DC X'00' PB 57120015 DC AL3(NLODPR) PR 57140015 DC H'16' DFB 57160015 DC H'70' DLB 57180001 DC A(AVL) ALT 57200015 SPACE 57220015 XREF DC X'05' KL 57240015 DC CL15'XREF' KW 57260015 DC X'00' PB 57280015 DC AL3(XREFPR) PR 57300015 DC H'17' DFB 57320015 DC H'71' DLB 57340001 DC A(NOXREF) ALT 57360015 SPACE 57380015 NOXREF DC X'07' KL 57400015 DC CL15'NOXREF' KW 57420015 DC X'00' PB 57440015 DC AL3(NXRFPR) PR 57460015 DC H'18' DFB 57480015 DC H'72' DLB 57500001 DC A(AVX) ALT 57520015 SPACE 57540015 SOURCE DC X'07' KL 57560015 DC CL15'SOURCE' KW 57580015 DC X'00' PB 57600015 DC AL3(SRCEPR) PR 57620015 DC H'19' DFB 57640015 DC H'73' DLB 57660001 DC A(NOSOURCE) ALT 57680015 SPACE 57700015 NOSOURCE DC X'09' KL 57720015 DC CL15'NOSOURCE' KW 57740015 DC X'00' PB 57760015 DC AL3(NSRCPR) PR 57780015 DC H'20' DFB 57800015 DC H'74' DLB 57820001 DC A(AVS) ALT 57840015 SPACE 57860015 SOURCE2 DC X'08' KL 57880015 DC CL15'SOURCE2' KW 57900015 DC X'00' PB 57920015 DC AL3(SRC2PR) PR 57940015 DC H'21' DFB 57960015 DC H'75' DLB 57980001 DC A(NOSOURC2) ALT 58000015 SPACE 58020015 NOSOURC2 DC X'0A' KL 58040015 DC CL15'NOSOURCE2' KW 58060015 DC X'00' PB 58080015 DC AL3(NSC2PR) PR 58100015 DC H'22' DFB 58120015 DC H'76' DLB 58140001 DC A(AVS2) ALT 58160015 * 58180015 MACDK DC X'07' KL 58200015 DC CL15'MACDCK' KW 58220015 DC X'00' PB 58240015 DC AL3(MACDKPR) PR 58260015 DC H'43' DFB 58280001 DC H'92' DLB 58300001 DC A(NOMD) ALT 58320015 * 58340015 NOMD DC X'09' KL 58360015 DC CL15'NOMACDCK' KW 58380015 DC X'00' PB 58400015 DC AL3(NOMDKPR) PR 58420015 DC H'44' DFB 58440001 DC H'93' DLB 58460001 DC A(AVMD) ALT 58480015 * 58500015 SPACE 58520015 * IF 'O' IS PUT BEFORE 'OPT' IN THIS TABLE, THEN 58540015 * CODE IN 'DFLTSCAN' MUST BE CHANGED 58560015 SPACE 58580015 OPT DC X'04' KL 58600015 DC CL15'OPT' KW 58620015 DC X'00' PB 58640015 DC AL3(OPTPR) PR 58660015 DC H'24' DFB 58680001 DC H'77' DLB 58700001 DC A(AVO) ALT 58720015 SPACE 58740015 CHK DC X'04' KL 58760015 DC CL15'CHK' KW 58780015 DC X'FF' PB 58800015 DC AL3(CHKPR) PR 58820015 DC H'51' DFB 58840001 DC H'51' DLB 58860001 DC A(0) ALT 58880015 * 58900015 OBJNM DC X'06' KL 58920015 DC CL15'OBJNM' KW 58940015 DC X'FF' PB 58960015 DC AL3(NMPR) PR 58980015 DC H'51' DFB 59000001 DC H'51' DLB 59020001 DC A(AVNM) ALT 59040015 SPACE 59060015 BIGDIC DC X'07' KL 59080015 DC CL15'EXTDIC' KW 59100015 DC X'00' PB 59120015 DC AL3(BDPR) PR 59140015 DC H'45' DFB 59160001 DC H'94' DLB 59180001 DC A(NORMDIC) ALT 59200015 * 59220015 NORMDIC DC X'09' KL 59240015 DC CL15'NOEXTDIC' KW 59260015 DC X'00' PB 59280015 DC AL3(NBDPR) PR 59300015 DC H'46' DFB 59320001 DC H'95' DLB 59340001 DC A(AVBD) ALT 59360015 * 59380015 * THE FOLLOWING ENTRY IS FOR THE DUMP OPTION. NOTE THAT 59400015 * THE 'PROCESSED BYTE' IS TURNED ON AT ASSEMBLY TIME. THIS IS 59420015 * DONE IN ORDER TO PREVENT THE OPTION BEING AUTOMATICALLY SEL- 59440015 * ECTED DURING THE DEFAULT SCAN. IT IS DONE IN THIS WAY AS 59460015 * THERE IS NO 'NODUMP' OPTION THAT COULD BE SET AS DEFAULT. 59480015 * THE DEFAULT BIT POSITION NUMBER FOR THE DUMP OPTION 59500015 * POINTS TO AN UNUSED BIT POSITION AS THERE IS NO DEFAULT SET 59520015 * FOR DUMP AT SYSTEM GENERATION TIME. 59540015 SPACE 59560015 DMP DC X'05' KL 59580015 DC CL15'DUMP' KW 59600015 DC X'FF' PB 59620015 DC AL3(DMPR) PR 59640015 DC H'51' DFB 59660001 DC H'51' DLB 59680001 DC A(AVDP) ALT 59700015 SPACE 59720015 MACRO DC X'06' KL 59740015 DC CL15'MACRO' KW 59760015 DC X'00' PB 59780015 DC AL3(MACROPR) PR 59800015 DC H'35' DFB 59820015 DC H'85' DLB 59840001 DC A(NOMACRO) ALT 59860015 SPACE 59880015 NOMACRO DC X'08' KL 59900015 DC CL15'NOMACRO' KW 59920015 DC X'00' PB 59940015 DC AL3(NOMACPR) PR 59960015 DC H'36' DFB 59980015 DC H'86' DLB 60000001 DC A(AVMO) ALT 60020015 SPACE 60040015 COMP DC X'05' KL 60060015 DC CL15'COMP' KW 60080015 DC X'00' PB 60100015 DC AL3(COMPPR) PR 60120015 DC H'39' DFB 60140001 DC H'87' DLB 60160001 DC A(NOCOMP) ALT 60180015 SPACE 60200015 NOCOMP DC X'07' KL 60220015 DC CL15'NOCOMP' KW 60240015 DC X'00' PB 60260015 DC AL3(NOCOMPR) PR 60280015 DC H'40' DFB 60300001 DC H'88' DLB 60320001 DC A(AVCP) ALT 60340015 SPACE 60360015 STMT DC X'05' KL 60380015 DC CL15'STMT' KW 60400015 DC X'00' PB 60420015 DC AL3(STMTPR) PR 60440015 DC H'33' DFB 60460015 DC H'83' DLB 60480001 DC A(NOSTMT) ALT 60500015 SPACE 60520015 NOSTMT DC X'07' KL 60540015 DC CL15'NOSTMT' KW 60560015 DC X'00' PB 60580015 DC AL3(NOSTMTPR) PR 60600015 DC H'34' 60620015 DC H'84' DLB 60640001 DC A(AVST) ALT 60660015 SPACE 60680015 M91 DC X'06' KL I24 60700019 DC CL15'OBJIN' KW I24 60720019 DC X'00' PB 60740015 DC AL3(M91PR) PR 60760015 DC H'41' DFB 60780001 DC H'89' DLB 60800001 DC A(NOM91) ALT 60820015 SPACE 60840015 NOM91 DC X'07' KL I24 60860019 DC CL15'OBJOUT' KW I24 60880019 DC X'00' PB 60900015 DC AL3(NOM91PR) PR 60920015 DC H'42' DFB 60940001 DC H'90' DLB 60960001 DC A(M91) ALT 60980015 SPACE 60980515 OPLIST DC X'07' KL 60981015 DC CL15'OPLIST' KW 60981515 DC X'00' PB 60982015 DC AL3(OPROC) PR 60982515 DC H'31' DFB 60983015 DC H'96' DLB 60983501 DC A(NPLIST) ALT 60984015 SPACE 60984515 NPLIST DC X'09' KL 60985015 DC CL15'NOOPLIST' KW 60985515 DC X'00' PB 60986015 DC AL3(NOPROC) PR 60986515 DC H'32' DFB 60987015 DC H'97' DLB 60987501 DC A(AVOLI) ALT 60988015 SPACE 60988515 NEST DC X'05' KL 60989015 DC CL15'NEST' KW 60989515 DC X'00' PB 60990015 DC AL3(NESTPR) PR 60990515 DC H'37' DFB 60991015 DC H'98' DLB 60991501 DC A(NONEST) ALT 60992015 SPACE 60992515 NONEST DC X'07' KL 60993015 DC CL15'NONEST' KW 60993515 DC X'00' PB 60994015 DC AL3(NNSTPR) PR 60994515 DC H'38' DFB 60995015 DC H'99' DLB 60995501 DC A(AVNSTI) ALT 61003519 SPACE 61011519 SYNCHKE DC X'08' KL I25 61019519 DC CL15'SYNCHKE' KW I25 61027519 DC X'00' PB I25 61035519 DC AL3(SKEPR) PR I25 61043519 DC H'28' DFB I25 61051519 DC H'100' DLB I25 61059519 DC A(SYNCHKS) ALT I25 61067519 SPACE 61075519 SYNCHKS DC X'08' KL I25 61083519 DC CL15'SYNCHKS' KW I25 61091519 DC X'00' PB I25 61099519 DC AL3(SKSPR) PR I25 61107519 DC H'29' DFB I25 61115519 DC H'101' DLB I25 61123519 DC A(SYNCHKT) ALT I25 61131519 SPACE 61139519 SYNCHKT DC X'08' KL I25 61147519 DC CL15'SYNCHKT' KW I25 61155519 DC X'00' PB I25 61163519 DC AL3(SKTPR) PR I25 61171519 DC H'30' DFB I25 61179519 DC H'102' DLB I25 61187519 DC A(AVSKE) ALT I25 61195519 EJECT 61203519 AVLC DC X'03' KL 61211519 DC CL15'LC' KW 61240015 DC X'00' PB 61260015 DC AL3(LNCNT) PR 61280015 DC H'0' DFB 61300015 DC H'78' DLB 61320001 DC A(KEYWORD) ALT 61340015 SPACE 61360015 AVM DC X'03' KL 61380015 DC CL15'SM' KW 61400015 DC X'00' PB 61420015 DC AL3(SRMGN) PR 61440015 DC H'0' DFB 61460015 DC H'81' DLB 61480001 DC A(SORMGIN) ALT 61500015 SPACE 61520015 AVA DC X'02' KL 61540015 DC CL15'A' KW 61560015 DC X'00' PB 61580015 DC AL3(ATRPR) PR 61600015 DC H'0' DFB 61620015 DC H'54' DLB 61640001 DC A(AVNA) ALT 61660015 SPACE 61680015 AVNA DC X'03' KL 61700015 DC CL15'NA' KW 61720015 DC X'00' PB 61740015 DC AL3(NOATRP) PR 61760015 DC H'1' DFB 61780015 DC H'55' DLB 61800001 DC A(ATR) ALT 61820015 SPACE 61840015 AVB DC X'02' KL 61860015 DC CL15'B' KW 61880015 DC X'00' PB 61900015 DC AL3(BCDPR) PR 61920015 DC H'2' DFB 61940015 DC H'56' DLB 61960001 DC A(AVEB) ALT 61980015 SPACE 62000015 AVEB DC X'03' KL 62020015 DC CL15'EB' KW 62040015 DC X'00' PB 62060015 DC AL3(EBCDPR) PR 62080015 DC H'3' DFB 62100015 DC H'57' DLB 62120001 DC A(BCD) ALT 62140015 SPACE 62160015 AVC60 DC X'04' KL 62180015 DC CL15'C60' KW 62200015 DC X'00' PB 62220015 DC AL3(CHR60PR) PR 62240015 DC H'4' DFB 62260015 DC H'58' DLB 62280001 DC A(AVC48) ALT 62300015 SPACE 62320015 AVC48 DC X'04' KL 62340015 DC CL15'C48' KW 62360015 DC X'00' PB 62380015 DC AL3(CHR48PR) PR 62400015 DC H'5' DFB 62420015 DC H'59' DLB 62440001 DC A(CHAR60) ALT 62460015 SPACE 62480015 AVD DC X'02' KL 62500015 DC CL15'D' KW 62520015 DC X'00' PB 62540015 DC AL3(DCKPR) PR 62560015 DC H'6' DFB 62580015 DC H'60' DLB 62600001 DC A(AVND) ALT 62620015 SPACE 62640015 AVND DC X'03' KL 62660015 DC CL15'ND' KW 62680015 DC X'00' PB 62700015 DC AL3(NODKPR) PR 62720015 DC H'7' DFB 62740015 DC H'61' DLB 62760001 DC A(DECK) ALT 62780015 SPACE 62800015 AVE DC X'02' KL 62820015 DC CL15'E' KW 62840015 DC X'00' PB 62860015 DC AL3(EXRFPR) PR 62880015 DC H'8' DFB 62900015 DC H'62' DLB 62920001 DC A(AVNE) ALT 62940015 SPACE 62960015 AVNE DC X'03' KL 62980015 DC CL15'NE' KW 63000015 DC X'00' PB 63020015 DC AL3(NEXRFPR) PR 63040015 DC H'9' DFB 63060015 DC H'63' DLB 63080001 DC A(EXTREF) ALT 63100015 SPACE 63120015 AVFW DC X'03' KL 63140015 DC CL15'FW' KW 63160015 DC X'00' PB 63180015 DC AL3(FLGWPR) PR 63200015 DC H'10' DFB 63220015 DC H'64' DLB 63240001 DC A(AVFE) ALT 63260015 SPACE 63280015 AVFE DC X'03' KL 63300015 DC CL15'FE' KW 63320015 DC X'00' PB 63340015 DC AL3(FLGEPR) PR 63360015 DC H'11' DFB 63380015 DC H'65' DLB 63400001 DC A(AVFS) ALT 63420015 SPACE 63440015 AVFS DC X'03' KL 63460015 DC CL15'FS' KW 63480015 DC X'00' PB 63500015 DC AL3(FLGSPR) PR 63520015 DC H'12' DFB 63540015 DC H'66' DLB 63560001 DC A(FLAGW) ALT 63580015 SPACE 63600015 AVOL DC X'02' KL 63620015 DC CL15'L' KW 63640015 DC X'00' PB 63660015 DC AL3(LISTPR) PR 63680015 DC H'13' DFB 63700015 DC H'67' DLB 63720001 DC A(AVNOL) ALT 63740015 SPACE 63760015 AVNOL DC X'03' KL 63780015 DC CL15'NL' KW 63800015 DC X'00' PB 63820015 DC AL3(NLSTPR) PR 63840015 DC H'14' DFB 63860015 DC H'68' DLB 63880001 DC A(LIST) ALT 63900015 SPACE 63920015 AVL DC X'03' KL 63940015 DC CL15'LD' KW 63960015 DC X'00' PB 63980015 DC AL3(LOADPR) PR 64000015 DC H'15' DFB 64020015 DC H'69' DLB 64040001 DC A(AVNL) ALT 64060015 SPACE 64080015 AVNL DC X'04' KL 64100015 DC CL15'NLD' KW 64120015 DC X'00' PB 64140015 DC AL3(NLODPR) PR 64160015 DC H'16' DFB 64180015 DC H'70' DLB 64200001 DC A(LOAD) ALT 64220015 SPACE 64240015 AVX DC X'02' KL 64260015 DC CL15'X' KW 64280015 DC X'00' PB 64300015 DC AL3(XREFPR) PR 64320015 DC H'17' DFB 64340015 DC H'71' DLB 64360001 DC A(AVNX) ALT 64380015 SPACE 64400015 AVNX DC X'03' KL 64420015 DC CL15'NX' KW 64440015 DC X'00' PB 64460015 DC AL3(NXRFPR) PR 64480015 DC H'18' DFB 64500015 DC H'72' DLB 64520001 DC A(XREF) ALT 64540015 SPACE 64560015 AVS DC X'02' KL 64580015 DC CL15'S' KW 64600015 DC X'00' PB 64620015 DC AL3(SRCEPR) PR 64640015 DC H'19' DFB 64660015 DC H'73' DLB 64680001 DC A(AVNS) ALT 64700015 SPACE 64720015 AVNS DC X'03' KL 64740015 DC CL15'NS' KW 64760015 DC X'00' PB 64780015 DC AL3(NSRCPR) PR 64800015 DC H'20' DFB 64820015 DC H'74' DLB 64840001 DC A(SOURCE) ALT 64860015 SPACE 64880015 AVS2 DC X'03' KL 64900015 DC CL15'S2' KW 64920015 DC X'00' PB 64940015 DC AL3(SRC2PR) PR 64960015 DC H'21' DFB 64980015 DC H'75' DLB 65000001 DC A(AVNS2) ALT 65020015 SPACE 65040015 AVNS2 DC X'04' KL 65060015 DC CL15'NS2' KW 65080015 DC X'00' PB 65100015 DC AL3(NSC2PR) PR 65120015 DC H'22' DFB 65140015 DC H'76' DLB 65160001 DC A(SOURCE2) ALT 65180015 SPACE 65200015 AVO DC X'02' KL 65220015 DC CL15'O' KW 65240015 DC X'00' PB 65260015 DC AL3(OPTPR) PR 65280015 DC H'24' DFB 65300001 DC H'77' DLB 65320001 DC A(OPT) ALT 65340015 SPACE 65360015 AVDP DC X'03' KL 65380015 DC CL15'DP' KW 65400015 DC X'FF' PB 65420015 DC AL3(DMPR) PR 65440015 DC H'51' DFB 65460001 DC H'51' DLB 65480001 DC A(DMP) ALT 65500015 SPACE 65520015 AVMO DC X'02' KL 65540015 DC CL15'M' KW 65560015 DC X'00' PB 65580015 DC AL3(MACROPR) PR 65600015 DC H'35' DFB 65620015 DC H'85' DLB 65640001 DC A(AVNMO) ALT 65660015 SPACE 65680015 AVNMO DC X'03' KL 65700015 DC CL15'NM' KW 65720015 DC X'00' PB 65740015 DC AL3(NOMACPR) PR 65760015 DC H'36' DFB 65780015 DC H'86' DLB 65800001 DC A(MACRO) ALT 65820015 SPACE 65840015 AVCP DC X'02' KL 65860015 DC CL15'C' KW 65880015 DC X'00' PB 65900015 DC AL3(COMPPR) PR 65920015 DC H'39' DFB 65940001 DC H'87' DLB 65960001 DC A(AVNCP) ALT 65980015 SPACE 66000015 AVNCP DC X'03' KL 66020015 DC CL15'NC' KW 66040015 DC X'00' PB 66060015 DC AL3(NOCOMPR) PR 66080015 DC H'40' DFB 66100001 DC H'88' DLB 66120001 DC A(COMP) ALT 66140015 SPACE 66160015 AVST DC X'03' KL 66180015 DC CL15'ST' KW 66200015 DC X'00' PB 66220015 DC AL3(STMTPR) PR 66240015 DC H'33' DFB 66260015 DC H'83' DLB 66280001 DC A(AVNST) ALT 66300015 SPACE 66320015 AVMD DC X'03' KL 66340015 DC CL15'MD' KW 66360015 DC X'00' PB 66380015 DC AL3(MACDKPR) PR 66400015 DC H'43' DFB 66420001 DC H'92' DLB 66440001 DC A(AVNMD) ALT 66460015 * 66480015 AVNMD DC X'04' KL 66500015 DC CL15'NMD' KW 66520015 DC X'00' PB 66540015 DC AL3(NOMDKPR) PR 66560015 DC H'44' DFB 66580001 DC H'93' DLB 66600001 DC A(MACDK) ALT 66620015 * 66640015 AVBD DC X'03' KL 66660015 DC CL15'ED' KW 66680015 DC X'00' PB 66700015 DC AL3(BDPR) PR 66720015 DC H'45' DFB 66740001 DC H'94' DLB 66760001 DC A(AVNBD) ALT 66780015 * 66800015 AVNBD DC X'04' KL 66820015 DC CL15'NED' KW 66840015 DC X'00' PB 66860015 DC AL3(NBDPR) PR 66880015 DC H'46' DFB 66900001 DC H'95' DLB 66920001 DC A(BIGDIC) ALT 66940015 * 66960015 AVNST DC X'04' KL 66980015 DC CL15'NST' KW 67000015 DC X'00' PB 67020015 DC AL3(NOSTMTPR) PR 67040015 DC H'34' DFB 67060015 DC H'84' DLB 67080001 DC A(STMT) ALT 67100015 * 67120015 AVNM DC X'02' KL 67140015 DC CL15'N' KW 67160015 DC X'FF' PB 67180015 DC AL3(NMPR) PR 67200015 DC H'51' DFB 67220001 DC H'51' DLB 67240001 DC A(OBJNM) ALT 67260015 SPACE 67280015 AVOLI DC X'03' KL 67280615 DC CL15'OL' KW 67281215 DC X'00' PB 67281815 DC AL3(OPROC) PR 67282415 DC H'31' DFB 67283015 DC H'96' DLB 67283601 DC A(AVNOLI) ALT 67284215 SPACE 67284815 AVNOLI DC X'04' KL 67285415 DC CL15'NOL' KW 67286015 DC X'00' PB 67286615 DC AL3(NOPROC) PR 67287215 DC H'32' DFB 67287815 DC H'97' DLB 67288401 DC A(OPLIST) ALT 67289015 SPACE 67289615 AVNSTI DC X'03' KL 67290215 DC CL15'NT' KW 67290815 DC X'00' PB 67291415 DC AL3(NESTPR) PR 67292015 DC H'37' DFB 67292615 DC H'98' DLB 67293201 DC A(AVNNST) ALT 67293815 SPACE 67294415 AVNNST DC X'04' KL 67295015 DC CL15'NNT' KW 67295615 DC X'00' PB 67296215 DC AL3(NNSTPR) PR 67296815 DC H'38' DFB 67297415 DC H'99' DLB 67298001 DC A(NEST) ALT 67298615 SPACE 67299215 TRACE DC X'02' KL IEMAT 67300201 DC CL15'T' KW IEMAT 67301201 DC X'FF' PB 67302201 DC AL3(TRAPAT) PR 67303201 DC H'51' DFB 67304201 DC H'51' DLB 67305201 DC A(PATCH) ALT IEMAT 67306201 SPACE 1 67307201 PATCH DC X'02' KL IEMAT 67308201 DC CL15'P' KW IEMAT 67309201 DC X'FF' PB 67310201 DC AL3(TRAPAT) PR 67311201 DC H'51' DFB 67312201 DC H'51' DLB 67313201 DC A(TRACE) ALT IEMAT 67314201 SPACE 1 67315201 AVSKE DC X'04' KL I25 67317219 DC CL15'SKE' KW I25 67319219 DC X'00' PB I25 67321219 DC AL3(SKEPR) PR I25 67323219 DC H'28' DFB I25 67325219 DC H'100' DLB I25 67327219 DC A(AVSKS) ALT I25 67329219 SPACE 67331219 AVSKS DC X'04' KL I25 67333219 DC CL15'SKS' KW I25 67335219 DC X'00' PB I25 67337219 DC AL3(SKSPR) PR I25 67339219 DC H'29' DFB I25 67341219 DC H'101' DLB I25 67343219 DC A(AVSKT) ALT I25 67345219 SPACE 67347219 AVSKT DC X'04' KL I25 67349219 DC CL15'SKT' KW I25 67351219 DC X'00' PB I25 67353219 DC AL3(SKTPR) PR I25 67355219 DC H'30' DFB I25 67357219 DC H'102' DLB I25 67359219 DC A(SYNCHKE) ALT I25 67361219 SPACE 67363219 DC X'00' STOPPER BYTE MARKS END OF TABLE 67365219 EJECT 67367219 * THIS IS THE DELIMITER TABLE FOR THE OPTION SCAN 67369219 SPACE 67380015 DLMTAB DC 256X'00' 67400015 ORG DLMTAB+C' ' COMPUTE A(BLANK) 67420015 DC C' ' INSERT BLANK IN TABLE 67440015 ORG DLMTAB+C'(' COMPUTE A(LEFT PAREN) 67460015 DC C'(' INSERT LEFT PAREN IN TABLE 67480015 ORG DLMTAB+C')' COMPUTE A(RIGHT PAREN) 67500015 DC C')' INSERT RIGHT PAREN IN TABLE 67520015 ORG DLMTAB+C',' COMPUTE A(COMMA) 67540015 DC C',' INSERT COMMA IN TABLE 67560015 ORG DLMTAB+C'=' COMPUTE A(EQUAL SIGN) 67580015 DC C'=' INSERT EQUAL SIGN IN TABLE 67600015 ORG 67620015 EJECT 67640015 SPACE 68620015 * 68640015 * TABLE USED BY THE SIZE OPTION SCANNER IN ORDER TO 68660015 * DESCRIBE THE BLOCKSIZE, DICTIONARY REFERENCE AND THE NUMBER OF 68680015 * DICTIONARY BLOCKS IN THIS ENVIRONMENT. THE CORRECT LIST 68700015 * OVERWRITES THE FIRST. THE VALUES IN THE FIRST LIST ARE THE 68720015 * USED 68740015 * 68760015 TEXTB1 DC F'1024' 1K TEXT BLOCK SIZE 83238 68770046 DICTB DC F'1024' DICT. BLOCK SIZE 83238 68780046 * NORMAL DICT. PARMS. 83238 68790046 ZSHF DC F'10' SHIFT TO GET BLOCK NO. 83238 68800046 ZMSK1 DC X'FC00' MASK TO GET BLOCK NO. 83238 68810046 ZMSK DC X'03FF' MASK TO GET OFFSET 83238 68820046 STOPOF DC F'256' NO. OF DICT. BLOCKS * 4 83238 68830046 * EXTENDED DICT. PARMS. (CF. ABOVE) 83238 68840046 ZSHFB DC F'9' 83238 68850046 ZMSK1B DC X'FE00' 83238 68860046 ZMSKB DC X'01FF' 83238 68870046 STOPOFB DC F'512' 38238 68880046 UDICTB DC F'768' 3/4 SPACE AVAILABLE FOR ENTRIES38238 68890046 FONOS DC X'007E' NO. OF OFFSET SLOTS 38238 68900046 OBNUM DC X'007F' 127 OVERFLOW BLOCK NO. 38238 68910046 SPACE 1 38238 68920046 TEXTB2 DC F'2048' 2K 38238 68930046 DC F'2048' 38238 68940046 * 38238 68950046 DC F'11' 38238 68960046 DC X'F800' 38238 68970046 DC X'07FF' 38238 68980046 DC F'128' 38238 68990046 * 38238 69000046 DC F'9' 38238 69010046 DC X'FE00' 38238 69020046 DC X'01FF' 38238 69030046 DC F'512' 38238 69040046 DC F'1792' 7/8 38238 69050046 DC X'007E' 38238 69060046 DC X'007F' 127 38238 69070046 SPACE 1 38238 69080046 TEXTB3 DC F'4096' 4K 38238 69090046 DC F'4096' 38238 69100046 * 38238 69110046 DC F'12' 38238 69120046 DC X'F000' 38238 69130046 DC X'0FFF' 38238 69140046 DC F'64' 38238 69150046 * 38238 69160046 DC F'10' 38238 69170046 DC X'FC00' 38238 69180046 DC X'03FF' 38238 69190046 DC F'256' 38238 69200046 DC F'3584' 7/8 38238 69210046 DC X'00FE' 38238 69220046 DC X'003F' 63 38238 69230046 SPACE 1 38238 69240046 TEXTB4 DC F'8192' 8K 38238 69250046 DC F'8192' 38238 69260046 * 38238 69270046 DC F'13' 38238 69280046 DC X'E000' 38238 69290046 DC X'1FFF' 38238 69300046 DC F'32' 38238 69310046 * 38238 69320046 DC F'11' 38238 69330046 DC X'F800' 38238 69340046 DC X'07FF' 38238 69350046 DC F'128' 38238 69360046 DC F'7168' 7/8 38238 69370046 DC X'01FE' 38238 69380046 DC X'001F' 31 38238 69390046 SPACE 1 38238 69400046 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 076-TSS 69410046 TEXTB5 DC F'16384' 16K 38238 69420046 * ----------------------------------------------------AB 076-TSS 69430046 DC F'16384' 38238 69440046 * 38238 69450046 DC F'14' 38238 69460046 DC X'C000' 38238 69470046 DC X'3FFF' 38238 69480046 DC F'16' 38238 69490046 * 38238 69500046 DC F'12' 38238 69510046 DC X'F000' 38238 69520046 DC X'0FFF' 38238 69530046 DC F'64' 38238 69540046 DC F'14336' 7/8 38238 69550046 DC X'03FE' 38238 69560046 DC X'000F' 15 38238 69570046 SPACE 70320015 EJECT 71420015 * 71440015 * AREA CONTAINING REMOTELY EXECUTED INSTRUCTIONS 71460015 * 71480015 TRTINS TRT 1(0,R1),DLMTAB SCAN FOR FIRST DELIMITER 71500015 CLCINS CLC 0(0,R2),0(R1) SCAN FOR A KEYWORD 71520015 PCKINS PACK OPTEMP1(8),1(0,R2) PACK THE DECIMAL FIELD 71540015 MVCINS2 MVC 10(0,R1),1(R3) INSERT OPTIONS IN PRINT LINE 71560015 MVCINS3 MVC 65(0,R1),1(R2) INSERT BAD STRING IN PRINT LINE 71580015 MVCINS4 MVC 0(0,R2),1(R1) 71600015 STATMVC MVC 0(0,R2),OPTION MOVE OPTION INTO STATS LINE. I16 71610017 EJECT 71620015 * 71620917 * TRANSLATE TABLE EXTERNAL TO INTERNAL (BCD) 71621817 * 71622717 TAB1 DC XL16'4C4E505C5D5E5FC0616C6E0B0C0D0E0F' 71623617 DC XL16'7C7A7D7EC1C2C3C4C5C61A1B1C1D1E1F' 71624517 DC XL16'7BC7C8C9D1D2D3D4D5D62A2B2C2D2E2F' 71625417 DC XL16'5B31D7D8D9E2E3E4E5E63A3B3C3D3E3F' 71626317 DC X'40E7E8E944F0F147F249F346454A6F4B' 71627217 DC XL16'75515253545556575859D030794DEF4F' 71628117 DC X'737762636465666768696A41430A20F4' 71629017 DC X'707172F574F676F778F8106B42486D7F' 71629917 DC XL16'808182838485868788898A8B8C8D8E8F' 71630817 DC XL16'909192939495969798999A9B9C9D9E9F' 71631717 DC XL16'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF' 71632617 DC XL16'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' 71633517 DC XL16'60111213141516171819CACBCCCDCECF' 71634417 DC XL16'5A212223242526272829DADBDCDDDEDF' 71635317 DC XL16'E0E13233343536373839EAEBECEDEEF9' 71636217 DC XL16'00010203040506070809FAFBFCFDFEFF' 71637117 EJECT 71638017 * 71640015 * LIST OF PHASES IN SECOND HALF OF THE COMPILER. THIS LIST 71660015 * IS MOVED INTO THE CONTROL PHASE TO SUPPLY A LIST FOR PHASE 71680015 * MARKING. IT IS THEN USED BY PHASE JZ TO CONSTRUCT A SECOND 71700015 * PHASE DIRECTORY. 71720015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 081-TSS 71730019 * 71740015 NOSEC DC AL2(((LAST2-PHASE2)/2)+1) NO OF PHASES IN SECOND LIST 71760015 LENGTH2 DC H'2' 71780015 PHASE2 DC C'JZ' 71800015 DC C'KAKBKCKEKGKJKNKOKPKQ' 71805001 DC C'KT' 71810001 DC C'KUKV' 71815001 DC C'LBLCLD' 71825001 DC C'LGLH' 71840015 DC C'LRLSLTLU' 71860015 DC C'LVLWLXLY' 71880015 DC C'MA' 71890001 DC C'MBMCMDMEMF' 71900015 DC C'MGMHMI' 71920015 DC C'MJMKMLMM' 71940015 DC C'MNMOMPMS' 71960015 DC C'MT' 71980015 DC C'NANB' 72000015 DC C'NGNH' 72020015 DC C'NJNK' 72040015 DC C'NMNN' 72060015 DC C'NTNUNV' 72080015 DC C'OBOCOD' 72100015 DC C'OEOFOGOH' 72120015 DC C'OIOLOMONOO' 72140001 DC C'OPOQ' 72160015 DC C'OSOTOUPAPD' 72180015 DC C'PHPLPMPOPP' 25838 72200019 DC C'PTPUPVQFQG' 72220015 DC C'QHQJQKQLQU' 72240015 DC C'QX' 72260015 DC C'RARBRC' 72280015 DC C'RD' 72290001 DC C'RFRG' 72300042 DC C'TF' 72320015 DC C'TJTK' 72340015 DC C'TOTPTQ' 72360015 DC C'TTTU' 72380015 DC C'UAUBUCUDUE' 72400015 DC C'UFUGUHUI' 72420015 DC C'XA' 72440015 LAST2 DC C'XB' 72460015 EJECT 72480015 * 72500015 * THE FOLLOWING IS A BLDL LIST. EACH ENTRY IS 30 BYTES LONG 72520015 * 72540015 DS 0H 72560015 BLDLST DC AL2(((LAST-PHASE1)/30)+1) NO OF PHASES IN BUILD LIST 72580015 LNGTH DC H'30' 72600015 PHASE1 DC CL8'IEMAM' 72620015 DC 11H'0' 72640015 DC CL8'IEMAS' 72660015 DC 11H'0' 72680015 DC CL8'IEMAV' 72700015 DC 11H'0' 72720015 DC CL8'IEMBC' 72740015 DC 11H'0' 72760015 DC CL8'IEMBE' 72780015 DC 11H'0' 72800015 DC CL8'IEMBF' 72820015 DC 11H'0' 72840015 DC CL8'IEMBG' 72860015 DC 11H'0' 72880015 DC CL8'IEMBI' 72900015 DC 11H'0' 72920015 DC CL8'IEMBJ' 72940015 DC 11H'0' 72960015 DC CL8'IEMBM' 72980015 DC 11H'0' 73000015 DC CL8'IEMBN' 73020015 DC 11H'0' 73040015 DC CL8'IEMBO' 73060015 DC 11H'0' 73080015 DC CL8'IEMBP' 73100015 DC 11H'0' 73120015 DC CL8'IEMBR' 73140015 DC 11H'0' 73160015 DC CL8'IEMBS' 73180015 DC 11H'0' 73200015 DC CL8'IEMBT' 73220015 DC 11H'0' 73240015 DC CL8'IEMBU' 73260015 DC 11H'0' 73280015 DC CL8'IEMBV' 73300015 DC 11H'0' 73320015 DC CL8'IEMBW' 73340015 DC 11H'0' 73360015 DC CL8'IEMBX' 73380015 DC 11H'0' 73400015 DC CL8'IEMCA' 73420015 DC 11H'0' 73440015 DC CL8'IEMCC' 73460015 DC 11H'0' 73480015 DC CL8'IEMCE' 73500015 DC 11H'0' 73520015 DC CL8'IEMCG' 73540015 DC 11H'0' 73560015 DC CL8'IEMCI' 73580015 DC 11H'0' 73600015 DC CL8'IEMCK' 73620015 DC 11H'0' 73640015 DC CL8'IEMCL' 73660015 DC 11H'0' 73680015 DC CL8'IEMCM' 73700015 DC 11H'0' 73720015 DC CL8'IEMCN' 73740015 DC 11H'0' 73760015 DC CL8'IEMCO' 73780015 DC 11H'0' 73800015 DC CL8'IEMCP' 73820015 DC 11H'0' 73840015 DC CL8'IEMCR' 73860015 DC 11H'0' 73880015 DC CL8'IEMCS' 73900015 DC 11H'0' 73920015 DC CL8'IEMCT' 73940015 DC 11H'0' 73960015 DC CL8'IEMCV' 73980015 DC 11H'0' 74000015 DC CL8'IEMCW' 74020015 DC 11H'0' 74040015 DC CL8'IEMED' 74060015 DC 11H'0' 74080015 DC CL8'IEMEF' 74100015 DC 11H'0' 74120015 DC CL8'IEMEG' 74140015 DC 11H'0' 74160015 DC CL8'IEMEH' 74180015 DC 11H'0' 74200015 DC CL8'IEMEI' 74220015 DC 11H'0' 74240015 DC CL8'IEMEJ' 74260015 DC 11H'0' 74280015 DC CL8'IEMEK' 74300015 DC 11H'0' 74320015 DC CL8'IEMEL' 74340015 DC 11H'0' 74360015 DC CL8'IEMEM' 74380015 DC 11H'0' 74400015 DC CL8'IEMEP' 74420015 DC 11H'0' 74440015 DC CL8'IEMEV' 74460015 DC 11H'0' 74480015 DC CL8'IEMEW' 74500015 DC 11H'0' 74520015 DC CL8'IEMEX' 74540015 DC 11H'0' 74560015 DC CL8'IEMEY' 74580015 DC 11H'0' 74600015 DC CL8'IEMEZ' 74620015 DC 11H'0' 74640015 DC CL8'IEMFA' 74660015 DC 11H'0' 74680015 DC CL8'IEMFB' 74700015 DC 11H'0' 74720015 DC CL8'IEMFE' 74740015 DC 11H'0' 74760015 DC CL8'IEMFF' 74780015 DC 11H'0' 74800015 DC CL8'IEMFI' 74820015 DC 11H'0' 74840015 DC CL8'IEMFK' 74860015 DC 11H'0' 74880015 DC CL8'IEMFO' 74900015 DC 11H'0' 74920015 DC CL8'IEMFP' 74940015 DC 11H'0' 74960015 DC CL8'IEMFQ' 74980015 DC 11H'0' 75000015 DC CL8'IEMFT' 75020015 DC 11H'0' 75040015 DC CL8'IEMFU' 75060015 DC 11H'0' 75080015 DC CL8'IEMFV' 75100015 DC 11H'0' 75120015 DC CL8'IEMFW' 75140015 DC 11H'0' 75160015 DC CL8'IEMFX' 75180015 DC 11H'0' 75200015 DC CL8'IEMFY' 75220015 DC 11H'0' 75240015 DC CL8'IEMFZ' 75260015 DC 11H'0' 75280015 DC CL8'IEMF1' I25 75286019 DC 11H'0' I25 75292019 DC CL8'IEMGA' 75300015 DC 11H'0' 75320015 DC CL8'IEMGB' 75340015 DC 11H'0' 75360015 DC CL8'IEMGC' 75380015 DC 11H'0' 75400015 DC CL8'IEMGK' 75420015 DC 11H'0' 75440015 DC CL8'IEMGO' 75460015 DC 11H'0' 75480015 DC CL8'IEMGP' 75500015 DC 11H'0' 75520015 DC CL8'IEMGQ' 75540015 DC 11H'0' 75560015 DC CL8'IEMGR' 75580015 DC 11H'0' 75600015 DC CL8'IEMGU' 75620015 DC 11H'0' 75640015 DC CL8'IEMGV' 75660015 DC 11H'0' 75680015 DC CL8'IEMHF' 75700015 DC 11H'0' 75720015 DC CL8'IEMHG' 75740015 DC 11H'0' 75760015 DC CL8'IEMHK' 75780015 DC 11H'0' 75800015 DC CL8'IEMHL' 75820015 DC 11H'0' 75840015 DC CL8'IEMHP' 75900015 DC 11H'0' 75920015 DC CL8'IEMIA' 75940015 DC 11H'0' 75960015 DC CL8'IEMIB' 75980015 DC 11H'0' 76000015 DC CL8'IEMIC' 76020015 DC 11H'0' 76040015 DC CL8'IEMIG' 76060015 DC 11H'0' 76080015 DC CL8'IEMIK' 76100001 DC 11H'0' 76120001 DC CL8'IEMIL' 76140015 DC 11H'0' 76160015 DC CL8'IEMIM' 76180015 DC 11H'0' 76200015 DC CL8'IEMIN' 76220015 DC 11H'0' 76240015 DC CL8'IEMIP' 76300015 DC 11H'0' 76320015 DC CL8'IEMIQ' 76340015 DC 11H'0' 76360015 DC CL8'IEMIT' 76380015 DC 11H'0' 76400015 DC CL8'IEMIX' 76420015 DC 11H'0' 76440015 DC CL8'IEMJD' 76460015 DC 11H'0' 76480015 DC CL8'IEMJI' 76500015 DC 11H'0' 76520015 DC CL8'IEMJJ' 76540015 DC 11H'0' 76560015 DC CL8'IEMJK' 76580015 DC 11H'0' 76600015 DC CL8'IEMJL' 76620015 DC 11H'0' 76640015 DC CL8'IEMJM' 76660015 DC 11H'0' 76680015 DC CL8'IEMJP' 76700015 DC 11H'0' 76720015 LAST DC CL8'IEMJZ' 76740015 DC 11H'0' 76760015 * ----------------------------------------------------AB 081-TSS 76761019 EJECT 76762017 * 76764017 * ************* 76766017 * * EQUATES * 76768017 * ************* 76770017 SPACE 10 76772017 R1 EQU 1 76773017 R2 EQU 2 76774017 R3 EQU 3 76775017 R4 EQU 4 76776017 R5 EQU 5 76777017 R6 EQU 6 76778017 R14 EQU 14 76779017 R15 EQU 15 76780017 BNZ EQU 7 BRANCH IF NOT ZERO 76781017 BNO EQU 12 BRANCH IF NOT ONE 76782017 BNH EQU 13 76783017 BNL EQU 11 76784017 PROC EQU 16 OFFSET TO PROCESSED INDICATOR 76785017 DEFAULT EQU 20 OFFSET TO DEFAULT BITS IN ENTRY 76786017 DELETE EQU 22 OFFSET TO DELETE BITS IN ENTRY 76787017 ALT EQU 24 OFFSET TO ALTERNATE OPT ADDRESS 76788017 ENTLNG EQU 28 LENGTH OF KEYWORD TABLE ENTRY 76789017 LFDCB EQU 48 OFFSET TO SYSLIN DCB ADDRESS 76790017 SYPDCB EQU 52 OFFSET TO SYSPUNCH DCB ADDRESS 76791017 PAGNO EQU 80 OFFSET TO A(PAGENBRSLOT) 76792017 NOPTLVLS EQU 3 NUMBER OF OPTIMISATION LEVELS 76792201 OPTDEFLT EQU 1 DEFAULT LEVEL 76792401 OPTEQ0 EQU 24 **IF GT 32 ALTER OPTPR2 ADDR 76792601 * 76793017 * TRANSFER VECTOR EQATES 76800015 * 76820015 * 76840015 ZUPLOF EQU X'08' 76860015 PAROF EQU X'1C' 76880015 RQSTOF EQU X'40' 76900015 ZUERR EQU X'30' 76920015 RLSOF EQU X'48' 76940015 ZUBW EQU X'78' 76960015 ABORT EQU X'20' 76980015 ZURDOF EQU X'0C' 77000015 ZUST EQU X'4C' 77020015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 070-TSS 77026019 * ----------------------------------------------------AB 070-TSS 77032019 * 77040015 * COMMUNICATIONS REGION EQUATES 77060015 * 77080015 ZTRAN1 EQU 68 77100015 ZNXTD EQU 76 77120015 ZDNXT EQU 96 77140015 ZSNXT EQU 100 77160015 ZWNXT EQU 104 77180015 ZCNXT EQU 108 77200015 PAR1 EQU 128 77220015 PAR2 EQU 132 77240015 PAR3 EQU PAR2+4 77260015 PAR4 EQU PAR3+4 77280015 PAR5 EQU PAR4+4 77300015 PAR6 EQU PAR5+4 77320015 PAR7 EQU PAR6+4 77340015 PAR8 EQU PAR7+4 77360015 CORLFT EQU 160 77380015 TERMSW EQU 176 77400015 AREA EQU 187 77420015 ZM91 EQU 188 77440015 PERRSW EQU 189 PTM825 77450001 ZPAGE EQU 192 77460015 ZLINE EQU 194 77480015 ZOPT EQU 196 77500015 DICTSP EQU 200 77520015 ZNXTOF EQU 204 77540015 FONOF EQU 208 77560015 FSTDRF EQU 212 77580015 ZSYSLIB EQU 216 77600015 ERCODE EQU 224 77620015 HDR EQU 236 77640015 DICTSZ EQU 260 77660015 TEXTSZ EQU 264 77680015 RDSIZE EQU 268 77700015 CCCODE EQU 232 77720015 ZSHIFT EQU 280 77740015 ZMASK EQU 284 77760015 BASOF EQU 140 77780015 ZMASK1 EQU 286 77800015 ZSOR EQU 288 77820015 ZMAG EQU 290 77840015 CCCODEE EQU 292 EXTENSION TO CCCODE 77850001 READSL EQU 500 77860015 LKNAME EQU 164 77880015 PARMLEN EQU 197 77900015 BERSW EQU 190 77920015 IOERSW EQU 191 77940015 ZOBNUM EQU 182 77960015 MAXFON EQU 198 77980015 OFFSLOF EQU 228 78000015 ZOBSAD EQU 172 78020015 ZCNCHR EQU 118 78040015 DICTP EQU 116 78060015 * 78080015 * EQUATES FOR DCB IN IEMAC 78100015 * 78120015 BWOFF EQU X'18' 78140015 SPACE 78160015 * 78180015 * INITIALISATION LIST EQUATES 78200015 * 78220015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 080-TSS 78226019 * ----------------------------------------------------AB 080-TSS 78232019 ALLA EQU 0 78240015 ALLL EQU 4 78260015 TSLOF EQU 8 78280015 DSLOF EQU 12 78300015 RDOF EQU 16 78320015 PLOF EQU 20 78340015 LOADOF EQU 24 78360015 PDOF EQU 28 78380015 HEDOF EQU 32 78400015 PAGOF EQU 36 78420015 SPDCB EQU 40 78440015 DADOF EQU 44 78460015 LFOF EQU 48 78480015 SPOF EQU 52 78500015 SYPOF EQU 52 78520015 CHKOF EQU 56 78540015 TRANOF EQU 64 78560015 SECPDOF EQU 84 78580015 BTBLOF EQU 100 78600015 SUT3OF EQU 116 60069 78606072 SLIBOF EQU 148 60069 78612072 SZVAL EQU 60 78620015 GENSWOF EQU 128 78640015 ATADDROF EQU 160 POINTER TOWARDS A(IEMAT). IEMAT 78650001 CORSZOF EQU 176 H207 78655001 UT1OF EQU 184 H319 78657001 * 78660015 * REGISTER EQUATEE 78680015 * 78700015 GR0 EQU 0 78720015 GRA EQU 1 78740015 GRB EQU 2 78760015 GRC EQU 3 78780015 GRD EQU 4 78800015 GRE EQU 5 78820015 GRF EQU 6 78840015 CNTL3 EQU 7 78860015 CNTL2 EQU 8 78880015 CNTLB EQU 9 78900015 CNTL4 EQU 10 78920015 CNTL EQU 11 78940015 DICR EQU 13 78960015 RR EQU 14 78980015 LR EQU 15 79000015 RSW EQU 6 I14 79010017 BH EQU 2 79020015 * 79040015 * BRANCH EQUATES 79060015 * 79080015 NOP EQU 0 79100015 BO EQU 1 79120015 BL EQU 4 79140015 BM EQU 4 79160015 BNE EQU 7 79180015 BE EQU 8 79200015 BZ EQU 8 79220015 BR EQU 15 79240015 B EQU 15 79260015 EJECT 79280015 * DSECT FOR SWITCHES HELD IN IEMAA (USED IN IEMAB) H235 79282001 * H235 79284001 SWABAA DSECT H235 79286001 GENSW DS X H235 79288001 NOCRSW DS X H235 79290001 BUFSW DS X H235 79292001 MESSW DS X H235 79294001 ERCSV DS X H235 79296001 EJECT H235 79298001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 035-TSS 79299019 DCBD DSORG=(BS),DEVD=DA 79300015 * ----------------------------------------------------AB 035-TSS 79310019 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AB 101-TSS 79313020 * ----------------------------------------------------AB 101-TSS 79316020 END IEMAB 79320015 ./ ADD SSI=04011970,NAME=IEMAC,SOURCE=0 AC TITLE 'IEMAC,INTERMEDIATE FILE CONTROL,COMPILER CONTROL,OS/360C00700013 PL/I COMPILER(F)' 01400013 * 02100013 * STATUS - CHANGE LEVEL 0 02800013 * 03500013 * FUNCTIONS-1)WRITE OUT RECORDS ONTO SYSUT3 04200013 * 2)WHEN LAST RECORD WRITTEN,LOAD IEMAG TO 04900013 * ACHIEVE FILE SWITCHING 05600013 * 06300013 * ENTRY POINT - AT IEMAC. THE ADDRESS OF IEMAC IS HELD IN 07000013 * THE TRANSFER VECTOR 07700013 * 08400013 * INPUT - PAR1 POINTS AT THE RECORD TO BE WRITTEN 09100013 * 09800013 * OUTPUT - A RECORD ONTO SYSUT3 10500013 * 11200013 * EXTERNAL ROUTINES 1)PUT LOCATE USING QSAM 11900013 * 2)IEMAG 12600013 * 13300013 * EXITS - BWOUT IS ONLY EXIT FROM ROUTINE 14000013 * 14700013 * ATTRIBUTES - NONE 15400013 * 16100013 EJECT 16800013 SPACE 2 17500013 IEMAC START 0 18200013 USING *,GRBASE 18900013 STM RR,CNTL2,12(DICR) STORE IN SAVE AREA 19600013 LR GRBASE,LR LOAD BASE REGISTER 20300013 LA GRA,SAVAR POINT AT NEW SAVE AREA 21000013 ST DICR,4(0,GRA) CHAIN FORWARDS 21700013 ST GRA,8(0,DICR) CHAIN BACKWARDS 22400013 BC B,JUMP 23100013 DC A(BWDCB) THIS MUST BE A FIXED OFFSET 23800013 SPACE 24500013 JUMP LA GRA,BWDCB 25200013 CLI PAR2(DICR),X'FF' SEE IF END OF OUTPUT 25900013 BC BE,ENDED 26600013 SPACE 27300013 L GRB,PAR1(0,DICR) PICK UP ADDRESS OF OUTPUT AREA 28000013 L GRC,PAR2(0,DICR) PICK UP LENGTH TO BE WRITTEN 28700013 SPACE 29400013 USING IHADCB,GRA 30100013 STH GRC,DCBLRECL STORE LENGTH TO BE WRITTEN 30800013 DROP GRA 31500013 SPACE 32200013 FTYPE LA DICR,SAVAR POINT AT SAVE AREA 32900013 PUT (1) FIND BUFFER SPACE 33600013 BCTR GRC,0 REDUCE LENGTH BY 1 FOR MOVE 34300013 EX GRC,BWMOVE MOVE OUTPUT RECORD TO BUFFER 35000013 SPACE 35700013 BWOUT LA DICR,SAVAR 36400013 L DICR,4(0,DICR) POINT AT PREVIOUS SAVE AREA 37100013 LM RR,CNTL2,12(DICR) RELOAD REGISTERS 37800013 MVI 12(DICR),X'FF' SHOW RETURN IS COMPLETE 38500013 BCR BR,RR RETURN TO CALLER 39200013 EJECT 39900013 * THESE ARE THE FILE SWITCHING ROUTINES. THE FILES MUST BE 40600013 * MANIPULATED IN THE FOLLOWING ORDER 41300013 * 1) CLOSE OUTPUT FILE 42000013 * 2) OPEN THE SAME FILE FOR INPUT 42700013 * 3) CLOSE INPUT FILE 43400013 * 4) SWITCH THE DCB ADDRESS IN ZURD TO NEW INPUT FILE 44100013 SPACE 2 44800013 ENDED BC NOP,BWOUT ONLY ONE ENTRY TO FILE SWITCH 45500013 MVI ENDED+1,X'F0' MAKE ENDED A PERMANENT BRANCH 46200013 LA DICR,SAVAR 46900013 LINK EP=IEMAG CLOSE AND OPEN THE FILES 47600013 BC B,BWOUT 48300013 EJECT 49000013 EJECT 49700013 SAVAR DC 18F'0' 50400013 BWMOVE MVC 0(0,GRA),0(GRB) MOVE OUTPUT LINE TO BUFFER 51100013 TEMP DC F'0' 51800013 EJECT 52500013 * 53200013 * SCRATCH FILE DCB. 53900013 * 54600013 BWDCB DCB DSORG=PS, C55300013 MACRF=(PL), C56000013 DDNAME=SYSUT3 56700013 EJECT 57400013 EJECT 58100013 DCBD DSORG=(BS),DEVD=DA 58800013 * 59500013 * REGISTER EQUATES 60200013 * 60900013 GR0 EQU 0 61600013 GRA EQU 1 62300013 GRB EQU 2 63000013 GRC EQU 3 63700013 GRD EQU 4 64400013 GRE EQU 5 65100013 CNTL2 EQU 10 65800013 CNTL EQU 11 66500013 DICR EQU 13 67200013 RR EQU 14 67900013 LR EQU 15 68600013 * 69300013 * BRANCH EQUATES 70000013 * 70700013 BO EQU 1 71400013 NOP EQU 0 72100013 BM EQU 4 72800013 BNE EQU 4 73500013 BZ EQU 8 74200013 BE EQU 8 74900013 BR EQU 15 75600013 B EQU 15 76300013 EJECT 77000013 GRBASE EQU 8 77700013 * 78400013 * COMMUNICATIONS REGION OFFSETS 79100013 * 79800013 PAR1 EQU 128 80500013 PAR2 EQU PAR1+4 81200013 CCCODE EQU 232 81900013 * 82600013 * TRANSFER VECTOR EQUATES 83300013 * 84000013 PAROF EQU X'1C' 84700013 * 85400013 * INITIALISATION LIST OFFSETS 86100013 * 86800013 RDOF EQU 16 87500013 RDADOF EQU 60 88200013 END IEMAC 88900013 ./ ADD SSI=02013130,NAME=IEMAD,SOURCE=0 AD TITLE 'IEMAD,INTERPHASE DUMPING,COMPILER CONTROL,OS/360 PL/1' 00100013 * 00130064 * 00134064 * 5.4 A 280000,481000,572000,635000,649000,738000 KT 54703 00134864 * 5.4 C 040450-040850,452000-458000,463000,535000,559000 KT 54703 00135664 * 5.4 C 632100,632500 KT 54703 00136464 * 5.4 D 403000,539000-540000 KT 54703 00137264 * 5.4 A 028500,029300,279700,279800. MAC 54703 00138064 * 5.2C A 641000,717000. JLC Z2151 00142064 * C 029000-030000,040500-040700,632200-632600. JLC Z2151 00146064 * D 315000. JLC Z2151 00150064 * 5.2 A 636500. JLC 33893 00154064 * 5.2 A 725000. JLC 32317 00158064 * C 013000,278000-284000,650000,667000-669000. JLC 32317 00162064 * D 587000,600300-601000,637000. JLC 32317 00166064 * 00170064 * 00174064 SPACE 5 00178064 GBLB &STD 00182064 &STD SETB 1 00186064 SPACE 5 00190064 EJECT 00195056 SPACE 2 00200013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AD 000-TSS 00230020 * ----------------------------------------------------AD 000-TSS 00260020 * HOUSEKEEPING AND INITIALISATION FOR AD 00300013 * 00400013 IEMAD START 0 00500013 USING *,GR8 00600013 * 00700013 STM 14,10,12(13) SAVE CALLERS REGISTERS 00800013 * 00900013 L GR8,ZUST(CNTL) BASE AD 01000013 * 01100013 STM 0,15,SVRGS2 SAVE ALL REGS FOR DUMPING 01200013 MVC SVRGS3(4),52(13) SAVE CALLER'S R8 32317 01300020 * 01400013 LA GRA,SAVAR POINT AT AD SAVE AREA 01500013 ST 13,4(GRA) CHAIN BACK 01600013 ST GRA,8(13) CHAIN FORWARDS 01700013 * 01800013 L GRF,PAROF(CNTL) POINT AT INITIALISATION LIST 01900013 L GRA,DADOF(GRF) POINT AT DICT ADDRESS 02000013 L DICR,0(GRA) POINT AT DICT 02100013 ST DICR,DICTEM AND SAVE IT 02200013 * 02300013 MVC SVAREA(1),AREA(DICR) SAVE AREA BYTE 02400013 MVC PARSAV(8),PAR1(DICR) AND PAR1 AND PAR2 02500013 SPACE 5 02600013 * READ TIMER FOR STATISTICS DATA AS SOON AS POSSIBLE 02700013 * 02800013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AD 004-TSS 02850020 AIF (&STD).ASMA1 02860064 AGO .ASMO1 02870064 .ASMA1 LA DICR,SAVAR POINT AT SAVE AREA 02880064 .ASMO1 ANOP 02890064 TTIMER 02930056 AIF (&STD).ASMA2 02940064 AGO .ASMO2 02950064 .ASMA2 L DICR,DICTEM POINT AT DICTIONARY 02960064 .ASMO2 ANOP 02970064 * ---------------------------------------------------*AD 004-TSS 03010056 SPACE 3 03100013 * TEST FOR A DYNAMIC INVOCATION 03200013 * 03300013 CLI PAR1(DICR),X'00' 03400013 BC BNE,DYNAMI BRANCH FOR DYNAMIC DUMP 03500013 SPACE 3 03600013 * TEST FOR A CALL FROM ABORT 03700013 * 03800013 TM CCCODE(DICR),X'40' 03900013 BC BO,ZABCAL BRANCH FOR A CALL FROM ZABORT 04000013 SPACE 3 04010015 * DUMP ZMYNAME 04020015 TM AREA(DICR),X'10' TEST FOR PHASE DUMP REQ 04030015 BC BZ,PDPTR 04040015 MVC PHSNMS+9(2),MYNAM(DICR) 54703 04045064 LA GRA,PHSNMS 54703 04065064 BAL RR,PRTHED PRINT PHASE COMPLETION MSG. 04090056 SPACE 3 04100013 * NORMAL CALL TO DUMP FROM RLSCTL ROUTINE IN AA, DOES THE 04200013 * PHASE RELEASING CONTROL WANT A DUMP 04300013 * 04400013 PDPTR L GRA,PDOF(GRF) POINT AT PHASE DIRECTORY 04500013 PDLOOP CLC 0(2,GRA),MYNAM(DICR) SEARCH FOR MYNAM IN DIRECTORY 04600013 BC BE,NAMFND BRANCH IF FOUND 04700013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AD 005-TSS 04750020 LA GRA,12(GRA) BUMP TO NEXT IN DIRECTORY 04800013 * ----------------------------------------------------AD 005-TSS 04850020 CLI 0(GRA),X'00' TEST FOR END OF DIRECTORY 04900013 BC BNE,PDLOOP NO, CONTINUE SEARCH 05000013 BC B,ADOUT YES, EXIT 05100013 * 05200013 NAMFND TM 2(GRA),X'01' DOES PHASE REQUIRE A DUMP 05300013 BC BZ,STATT NO, ARE STATISTICS REQUIRED 05400013 * 05500013 LA GRA,FSTMES YES, POINT AT MSG 'DUMP AFTER XX' 05600013 MVC NAMMES(2),MYNAM(DICR) SAY WHICH PHASE XX IS 05700013 BAL RR,PRTHED PRINT MSG 05800013 BC B,CNTROL 05900013 EJECT 06000013 * ROUTINE ZABCAL PROCESSES A CALL TO DUMP IN AN ABORT 06100013 * STATE. 06200013 * 06300013 * COUNT ABORT DUMPS 06400013 * 06500013 ZABCAL TM ZABSW,X'FF' TEST IF ABORT DUMP ALREADY GIVEN 06600013 BC BO,ADOUT YES, EXIT 06700013 MVI ZABSW,X'FF' SHOW ABORT DUMP BEING GIVEN 06800013 * 06900013 * ALTER SPECIFIED DUMP AREAS ON AN ABORT 07000013 * 07100013 OI AREA(DICR),X'F8' DUMP AT LEAST DTSCP ON AN ABORT 07200013 NI AREA(DICR),X'FC' EXCLUDE EA DUMPS ON AN ABORT 07300013 * 07400013 * PRINT COMPILER ABORT MESSAGE 07500013 * 07600013 LA GRA,ZABMES POINT AT MSG 07700013 BAL RR,PRTHED PRINT IT 07800013 SPACE 2 07900013 * DUMP REGISTERS AND PARAMETERS ON AN ABORT CALL 08000013 * 08100013 LA GRA,REGMES POINT AT REGISTER MSG 08200013 BAL RR,PRTHED PRINT IT 08300013 * 08400013 L GRB,FSTDIC+8(DICR) POINT AT REGISTERS STORED IN AA 08500013 LA GRC,64 REGISTER LENGTH 08600013 BAL RR,ALNDMP GO TO DUMP REGISTERS 08700013 * 08800013 LA GRA,PARMES POINT AT PARAMETER MSG 08900013 BAL RR,PRTHED PRINT IT 09000013 * 09100013 LA GRB,PAR1(DICR) POINT AT PARAMETERS 09200013 MVC PAR1(8,DICR),PARSAV RESTORE PAR1 AND PAR2 09300013 LA GRC,32 PARAMETER LENGTH 09400013 BAL RR,ALNDMP GO TO DUMP PARAMETERS 09500013 SPACE 2 09600013 * MAKE SURE THAT AT LEAST ONE TEXT BLOCK CAN BE MOVED OUT 09700013 * OF CORE SO THAT THE DUMP ROUTINES CAN WORK. 09800013 * 09900013 L GRB,TSLOF(GRF) POINT AT TSLOTS 10000013 * 10100013 TXTLOP TM 1(GRB),X'FF' TEST FOR END OF TSLOTS 10200013 BC BO,NOTFND YES, LEAVE ROUTINE 10300013 CLI 0(GRB),X'84' TEST IF BLOCK IN CORE AND BUSY 10400013 BC BE,FOUNDB YES,LEAVE ROUTINE 10500013 * 10600013 LA GRB,4(GRB) NO, BUMP TO NEXT BLOCK 10700013 BC B,TXTLOP LOOP TO TEST NEXT BLOCK 10800013 * 10900013 NOTFND SR GRB,GRB ZERO GRB TO SHOW NO TXT BLK '84' 11000013 FOUNDB EQU * GRB POINTS AT SPILLABLE BLOCK 11100013 SPACE 2 11200013 * PROCEED AS IF IT WERE A NORMAL DUMP REQUEST 11300013 * 11400013 BC B,CNTROL GO TO CONTROL ROUTINE 11500013 EJECT 11600013 * EXAMINE ALL DUMP OPTIONS REQUESTED AND PASS CONTROL TO 11700013 * REQUESTED ROUTINES SEQUENTIALLY 11800013 * 11900013 CNTROL MVI SWA,X'00' SHOW CONTROL ROUTINE ENTERED 12000013 TM AREA(DICR),X'80' TEST FOR DICT DUMP 12100013 BC BO,DICTPR YES, BRANCH 12200013 ATEXTT TM AREA(DICR),X'02' TEST FOR ANNOTATED TEXT DUMP 12300013 BC BO,ATEXTPR YES, BRANCH 12400013 TEXTT TM AREA(DICR),X'40' TEST FOR TEXT DUMP 12500013 BC BO,DICTPR YES, BRANCH 12600013 SCRT TM AREA(DICR),X'20' TEST FOR SCRATCH DUMP 12700013 BC BO,SCRPR YES, BRANCH 12800013 PHASET TM AREA(DICR),X'10' TEST FOR PHASE DUMP 12900013 BC BO,PHASPR YES, BRANCH 13000013 CONLT TM AREA(DICR),X'08' TEST FOR CONTROL PHASE DUMP 13100013 BC BO,CONPR YES, BRANCH 13200013 ADICTT TM AREA(DICR),X'04' TEST FOR ANNOTATED DICT DUMP 13300013 BC BO,ADICTPR YES, BRANCH 13400013 STATT TM AREA(DICR),X'01' TEST FOR STATISTICS DUMP 13500013 BC BO,STATPR YES, BRANCH 13600013 SPACE 5 13700013 ADOUT MVC AREA(1,DICR),SVAREA RESTORE AREA BYTE*** 13800013 MVC PAR1(8,DICR),PARSAV RESTORE PAR1,PAR2. 13900013 LA DICR,SAVAR POINT AT SAVE AREA 14000013 L DICR,4(0,DICR) RELOAD ORIGINAL SAVE AREA 14100013 LM RR,10,12(DICR) RELOAD REGISTERS 14200013 MVI 12(DICR),X'FF' SHOW RETURN COMPLETE 14300013 BCR BR,RR 14400013 EJECT 14500013 * ROUTINE DICTPR PROCESSES TEXT AND DICT BLOCK DUMPS. 14600013 * 14700013 * 14800013 DICTPR CLI SWA,X'00' TEST IF BLOCK CONTROL AREA DUMPD 14900013 BC BNE,BCDONE 15000013 LA GRA,BLKMES POINT AT BLOCK CONTROL MESSAGE 15100013 BAL RR,PRTHED PRINT IT OUT 15200013 L GRD,DSLOF(0,GRF) POINT AT START OF DSLOTS 15300013 LA GRE,672(0,GRD) POINT AT END OF TSLOTS 15350001 CLI DICTP(DICR),X'FF' IF EXTDIC ON 15400001 BNE CONTD 15450001 LA GRE,256(0,GRE) INCREASE FOR TRUE END OF TSLTS 15500001 CONTD BAL RR,DUMP DUMP THE AREA 15550001 MVI SWA,X'FF' SHOW THIS HAS BEEN DONE 15600013 SPACE 15700013 TM CCCODE(DICR),X'40' TEST IF ABORT HAS OCCURRED 15800013 BC BZ,NOTZAB NO, OMIT BLOCK MARKING 15900013 LTR GRB,GRB TEST FOR A TEXT BLOCK TYPE '84' 16000013 BC BZ,NOTZAB NO, OMIT BLOCK MARKING 16100013 MVI 0(GRB),X'82' MARK BLOCK IN CORE AND UNWANTED 16200013 NOTZAB EQU * 16300013 BCDONE XR GRC,GRC SET COUNTER=0 16400013 CONLOP LR GRB,GRC PICK UP COUNT 16500013 TM AREA(DICR),X'80' TEST FOR DICT DUMP 16600013 BC BO,SETDRF 16700013 SLL GRB,16 CONSTRUCT TEXT REFERENCE 16800013 L GRA,TSLOF(0,GRF) POINT AT TSLOTS 16900013 BC B,BLKUSE 17000013 SETDRF MVC SHIFT+3(1),ZSHIFT(DICR) PICK UP NO. OF BITS IN DICT REF 17100013 SHIFT SLL GRB,0 AND THEN CONSTRUCT DICT REF 17200013 L GRA,DSLOF(0,GRF) 17300013 SPACE 17400013 BLKUSE LR GRD,GRC PICK UP COUNT 17500013 AR GRD,GRD MULTIPLY BY 4 TO POINT AT 17600013 AR GRD,GRD CORRECT SLOT IN T OR D SLOTS 17700013 AR GRA,GRD POINT AT CORRECT SLOT 17800013 CLI 1(GRA),X'FF' SEE IF STOPPER IN TABLE 17900013 BC BNE,BLKINU 18000013 TM AREA(DICR),X'80' TEST IF DUMPING THE DICTIONARY 18100013 BC BZ,SCRT IF NOT RETURN TO DUMP SCRATCH*** 18200013 NI AREA(DICR),X'7F' SWITCH DICT DUMP BIT OFF*** 18300013 BC B,ATEXTT RETURN TO DUMP ANNOTATED TEXT 18400013 SPACE 18500013 BLKINU CLI 0(GRA),X'FF' SEE IF BLOCK IN USE 18600013 BC BNE,DUMPBC 18700013 BUMPCN LA GRC,1(0,GRC) BUMP COUNTER BY 1 18800013 BC B,CONLOP 18900013 SPACE 19000013 DUMPBC ST GRB,PAR1(0,DICR) GET READY TO CONVERT TO ABSOLUTE 19100013 TM AREA(DICR),X'80' TEST TO SEE WHICH CONVERSION 19200013 BC BO,TYPED ROUTINE REQUIRED 19300013 MVI PAR1(DICR),X'80' DO NOT CHANGE STATUS OF BLOCK 19400013 LA DICR,SAVAR POINT AT NEW SAVE AREA 19500013 L LR,TXTAB(0,CNTL) CONVERT TEXT REFERENCE TO 19600013 BALR RR,LR ABSOLUTE 19700013 MVC BLKNAM(4),TEXTN SAY IT IS A TEXT BLOCK 19800013 BC B,DUMPB 19900013 SPACE 20000013 TYPED LA DICR,SAVAR POINT AT NEW SAVE AREA 20100013 L LR,ZDRFAB(0,CNTL) CONVERT DICTIONARY REFERENCE TO 20200013 BALR RR,LR ABSOLUTE 20300013 MVC BLKNAM(4),DICTN SAY IT IS A DICTIONARY BLOCK 20400013 SPACE 20500013 DUMPB L DICR,DICTEM POINT AT DICTIONARY AGAIN 20600013 BLKINC L GRA,0(0,GRA) LOAD BLOCK ADDR FROM T/D SLOTS 20700013 LA GRA,0(0,GRA) ZERO TOP BYTE OF ADDR 20800013 ST GRA,STADDR STORE START ADDR OF BLOCK 20900013 SPACE 21000013 CVD GRC,NUMBER CONVERT TO DECIMAL THE BLOCK 21100013 UNPK FINAL(4),NUMBER+5(3) COUNT AND UNPACK 21200013 OI FINAL+3,X'F0' CLEAR SIGN 21300013 MVC MESNO(4),FINAL INSERT IN MESSAGE 21400013 LA GRA,MESBLK POINT AT MESSAGE 21500013 BAL RR,PRTHED 21600013 SPACE 21700013 L GRD,STADDR PICK UP START ADDRESS OF BLOCK 21800013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AD 008-TSS 21830056 * ----------------------------------------------------AD 008-TSS 21860056 LR GRE,GRD 21900013 AH GRE,DICTSZ+2(DICR) ADD ON BLKSIZE TO GET END 22000015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AD 009-TSS 22030056 * ----------------------------------------------------AD 009-TSS 22060056 BAL RR,DUMP ADDRESS AND BRANCH TO DUMP 22100013 BC B,BUMPCN 22200013 EJECT 22300013 * ROUTINE SCRPR PROCESSES SCRATCH AREA DUMPS. ALL AREAS 22400013 * AREA DUMPED EVEN IF THEY HAVE BEEN RELEASED. 22500013 * 22600013 SCRPR L GRB,ALLOCA(0,GRF) POINT AT ALLOCA (SCRATCH AREA 22700013 LA GRB,16(0,GRB) CONTROL) AND CONDIR 22800013 LA GRA,SCRMES 22900013 BAL RR,PRTHED SAY DUMP OF SCRATCH CORE 23000013 SPACE 23100013 SCRLOP CLC 0(4,GRB),ZEROS SEE IF ANY MORE ALLOCATED 23200013 BC BE,PHASET 23300013 L GRD,0(0,GRB) PICK UP ADDRESS 23400013 L GRE,4(0,GRB) PICK UP LENGTH 23500013 AR GRE,GRD END ADDRESS 23600013 BAL RR,DUMP 23700013 LA GRB,8(0,GRB) BUMP TO NEXT IN CONDIR 23800013 BC B,SCRLOP 23900013 EJECT 24000013 * ROUTINE PHASPR PROCESSES PHASE DUMPS. OVERLAY PHASES 24100013 * CANNOT BE DUMPED SINCE THEIR LOAD POINT IS NOT INSERTED IN THE 24200013 * PHASE DIRECTORY. 24300013 * 24400013 PHASPR L GRB,PDOF(0,GRF) POINT AT PHASE DIRECTORY 24500013 SPACE 24600013 LA GRA,PDMES SAY PRINTING LOADED PHASES 24700013 BAL RR,PRTHED 24800013 SPACE 24900013 PDLOAP TM 2(GRB),X'20' SEE IF PHASE HAS BEEN LOADED 25000013 BC BO,HASLOD 25100013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AD 006-TSS 25150020 BUMPPD LA GRB,12(0,GRB) BUMP TO NEXT IN PD 25200013 * ----------------------------------------------------AD 006-TSS 25250020 CLI 0(GRB),X'00' TEST FOR END OF PD 25300013 BC BNE,PDLOAP 25400013 BC B,CONLT 25500013 SPACE 25600013 HASLOD TM 2(GRB),X'08' SEE IF IT HAS BEEN DELETED 25700013 BC BO,BUMPPD 25800013 TM 2(GRB),X'04' TEST IF CAN BE DUMPED 25900013 BC BZ,NOTHIS 26000013 SPACE 26100013 MVC PHSNAM(2),0(GRB) PICK UP PHASE NAME TO SAY IT IS 26200013 LA GRA,PDMES1 BEING DUMPED 26300013 BAL RR,PRTHED 26400013 L GRD,4(0,GRB) PICK UP LOAD ADDRESS 26500013 LH GRE,8(0,GRB) PICK UP TOTAL ALLOCATED CORE 26600013 AR GRE,GRD COMPUTE END ADDRESS 26700013 BAL RR,DUMP 26800013 BC B,BUMPPD 26900013 SPACE 27000013 NOTHIS MVC PHSNIM(2),0(GRB) SAY LOADED PHASE CANNOT BE 27100013 LA GRA,PDMES2 DUMPED 27200013 BAL RR,PRTHED 27300013 BC B,BUMPPD 27400013 EJECT 27500013 * ROUTINE CONPR PROCESSES CONTROL PHASE DUMPS. 27600013 * 27700013 CONPR LA GRA,CONMES PICK UP AA HEADING 32317 27720020 MVI CONHDG+24,C'A' CONMES NOW REFERENCES AA 32317 27730020 BAL RR,PRTHED PRINT IT 32317 27740020 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AD 010-TSS 27750056 CLI DICTP(DICR),X'FF' IS EXTDIC BEING USED? 32317 27760020 BNE NORMDIC NO 32317 27780020 MVI CONHDG+24,C'L' CONMES NOW REFERENCES AL 32317 27800020 MVI PHAZB+4,C'L' BUILD LIST REFERENCES AL 32317 27820020 B ATTST 32317 27840020 NORMDIC MVI CONHDG+24,C'N' CONMES NOW REFERENCES AN 32317 27860020 ATTST TM CCCODE+3(DICR),X'02' IS AT LOADED? 32317 27880020 BO DUMPUM YES 32317 27900020 MVC FF,=H'2' CUT AT ENTRY OUT OF BUILD 32317 27920020 * LIST 32317 27940020 DUMPUM TS CONDUMP1 IS IT THE 1ST TIME THE 32317 27950020 * CONTROL PHASES ARE DUMPED? 32317 27960020 BNZ SKIPBLD NO 32317 27970020 AIF (&STD).ASMA3 27972064 AGO .ASMO3 27974064 .ASMA3 LA DICR,SAVAR POINT AT SAVE AREA 27976064 .ASMO3 ANOP 27978064 BLDL 0,CONPHLST GET PDSDE'S FOR DUMPABLE CONTROL PHASES 32317 27980020 AIF (&STD).ASMA4 27982064 AGO .ASMO4 27984064 .ASMA4 L DICR,DICTEM POINT AT DICTIONARY 27986064 .ASMO4 ANOP 27988064 SKIPBLD EQU * 32317 27990020 * ----------------------------------------------------AD 010-TSS 27995056 L GRD,ZTV(0,DICR) PICK UP ADDRESS OF AA 32317 28000020 SH GRD,=H'16' * ALLOW FOR 1ST 16 BYTES OF AA 28006064 * BECAUSE ZTV IS ADDRESS OF ADCON LIST IN AA 54703 28012064 MVC CONPHSIZ+1(3),SIZEA MOVE SIZE TO ALIGN IT 32317 28020020 LA RR,SETUPB SET UP RETURN ADDRESS 32317 28040020 SETDUMP L GRE,CONPHSIZ PICK UP SIZE OF PHASE 32317 28060020 AR GRE,GRD CALC. END ADDRESS OF PHASE 32317 28080020 B DUMP DUMP PHASE 32317 28100020 SPACE 1 28120020 SETUPB LA GRA,CONMES PICK UP AL/AN HEADING 32317 28140020 BAL RR,PRTHED PRINT IT 32317 28160020 L GRD,BASOF(0,CNTL) PICK UP ADDRESS OF AL/AN 32317 28180020 MVC CONPHSIZ+1(3),SIZEB MOVE SIZE TO ALIGN IT 32317 28200020 BAL RR,SETDUMP 32317 28220020 SPACE 1 28240020 TM CCCODE+3(DICR),X'02' IS AT LOADED? 32317 28260020 BNO ADICTT NO 32317 28280020 LA GRA,ATMES PICK UP AT HEADING 32317 28300020 BAL RR,PRTHED PRINT IT 32317 28320020 L GRD,ATOF(0,GRF) PICK UP ADDRESS OF A(AT) 32317 28340020 L GRD,0(GRD) PICK UP ADDRESS OF AT 32317 28360020 MVC CONPHSIZ+1(3),SIZEC MOVE SIZE TO ALIGN IT 32317 28380020 LA RR,ADICTT SET UP RETURN ADDRESS 32317 28400020 B SETDUMP 32317 28420020 EJECT 28500013 * ROUTINE ADICTPR LINKS TO PHASE AH WHICH PRODUCES THE 28600013 * ANNOTATED DICT DUMPS. 28700013 * 28800013 ADICTPR CLC CANAME(2),MYNAM(DICR) COMPARE CA AND PHASE IN MYNAME 28900013 BC BH,STATT BRANCH IF BEFORE CA 29000013 LA DICR,SAVAR POINT AT SAVE AREA 29100013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AD 001-TSS 29150001 LINK EP=IEMAH 29200013 * ----------------------------------------------------AD 001-TSS 29250001 L DICR,DICTEM POINT AT DICT AGAIN 29300013 BC B,AHABORT(LR) 29400013 AHABORT BC B,ADOUT AH IN TROUBLE 29500013 BC B,STATT 29600013 EJECT 29700013 * ROUTINE ATEXTPR LINKS TO PHASE AI WHICH PRODUCES THE 29800013 * ANNOTATED TEXT DUMPS. 29900013 * 30000013 ATEXTPR CLC IANAME(2),MYNAM(DICR) COMPARE IA AND PHASE IN MYNAME 30100013 BC BH,TEXTT BRANCH IF BEFORE IA 30200013 CLC OENAME(2),MYNAM(DICR) COMPARE OE AND PHASE IN MYNAME 30300013 BL CALLAP BRANCH IF AFTER OE. 30400042 CLC FOURK(2),DICTSZ+2(DICR) TEST IF BLOCKS ARE 4K OR OVER 30500013 BC BH,DICTPR NO, BRANCH TO NORMAL TEXT DUMP 30600013 LA DICR,SAVAR POINT AT NEW SAVE AREA 30700013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AD 002-TSS 30750001 LINK EP=IEMAI 30800013 * ----------------------------------------------------AD 002-TSS 30850001 L DICR,DICTEM POINT AT DICT AGAIN 30900013 BC B,AIABORT(LR) 31000013 AIABORT BC B,ADOUT AI IN TROUBLE 31100013 BC B,TEXTT TRY NEXT OPTION 31200001 CALLAP LA DICR,SAVAR POINT AT NEW SAVE AREA. 31220042 LINK EP=IEMAP ANNOTATED TEXT PRINT. 31240042 L DICR,DICTEM POINT AT DICT AGAIN. 31260042 B TEXTT TRY NEXT OPTION. 31280042 EJECT 31300013 STATPR BC B,ADOUT 31400013 EJECT 31600013 * 31700013 * THIS IS A DYNAMIC DUMP THAT IS ENTERED DIRECTLY FROM A 31800013 * PHASE. THE ACTION TAKEN DEPENDS ON THE TOP BYTE OF PAR1 AS 31900013 * LISTED. 32000013 * 32100013 * STATUS BYTE PAR1 PAR2 32200013 * X'01' START ADDRESS END ADDRESS 32300013 * X'02' START ADDRESS LENGTH 32400013 * X'03' PARAMETER STORE REGISTER STORE 32500013 * X'05' START ADDRESS END ADDRESS 32600013 * X'06' START ADDRESS LENGTH 32700013 * 32800013 * 05 AND 06 TYPE DUMPS ARE THE SAME AS 01 AND 02 TYPES 32900013 * EXCEPT THAT THE REGISTERS ARE NOT PRINTED. 33000013 * 33100013 DYNAMI MVC DYNAM(2),MYNAM(DICR) PUT PHASE NAME IN MESSAGE 33200013 TM PAR1(DICR),X'03' IS IT A CONTROL PHASE CALL 33300013 BC BNO,NOTCON BRANCH IF NOT 33400013 MVC DYNAM(2),AANAME PUT CONTROL PHASE NAME IN 33500013 NOTCON LA GRA,DYNMS1 POINT AT HEADER MESSAGE 33600013 BAL RR,PRTHED PRINT HEADER MESSAGE 33700013 * 33800013 * MAKE BRANCHES DEPENDENT UPON STATUS BYTE 33900013 * 34000013 XR GRB,GRB ZERO GRB 34100013 IC GRB,PARSAV INSERT STATUS BYTE 34200013 CL GRB,SEVEN SEE IF STATUS IS VALID 34300013 BC BL,BRTYPE BRANCH IF VALID 34400013 LA GRA,DYNMS2 POINT AT INVALID STATUS MESSAGE 34500013 BAL RR,PRTHED PRINT IT 34600013 BC B,ADOUT RETURN 34700013 * 34800013 BRTYPE SLL GRB,2 MULT BY 4 TO GET BRANCH OFFSET 34900013 HERE BC B,HERE(GRB) 35000013 BC B,TYPE1 35100013 BC B,TYPE2 35200013 BC B,TYPE3 35300013 BC B,TYPE4 35400013 BC B,TYPE5 35500013 BC B,TYPE6 35600013 * 35700013 * TWO ADDRESSES OR ADDRESS AND LENGTH GIVEN 35800013 * 35900013 TYPE1 EQU * 36000013 TYPE2 LA GRA,REGMES POINT AT REGISTER MESSAGE 36100013 BAL RR,PRTHED PRINT IT 36200013 LA GRB,SVRGS2 POINT AT REGISTERS 36300013 LA GRC,64 REGISTER LENGTH 36400013 BAL RR,ALNDMP DUMP REGISTERS 36500013 * 36600013 TYPE5 EQU * 36700013 TYPE6 L GRD,PARSAV PICK UP START ADDRESS 36800013 L GRE,PARSAV+4 PICK UP END ADDRESS OR LENGTH 36900013 TM PARSAV,X'01' TEST DUMP TYPE AGAIN 37000013 BC BO,NOTLEN BRANCH IF '01' TYPE 37100013 AR GRE,GRD CALCULATE END ADDRESS 37200013 NOTLEN BAL RR,DUMP DUMP THE AREA 37300013 BC B,ADOUT RETURN 37400013 * 37500013 * CONTROL PHASE DUMP OF REGISTERS AND PARAMETERS 37600013 * 37700013 TYPE3 LA GRA,REGMES POINT AT REGISTER MESSAGE 37800013 BAL RR,PRTHED PRINT IT OUT 37900013 L GRB,PARSAV+4 POINT AT REGISTERS 38000013 LA GRC,64 REGISTER LENGTH 38100013 BAL RR,ALNDMP DUMP REGISTERS 38200013 * 38300013 LA GRA,PARMES POINT AT PARAMETER MESSAGE 38400013 BAL RR,PRTHED PRINT IT OUT 38500013 L GRB,PARSAV POINT AT PARAMETERS 38600013 LA GRC,32 PARAMETER LENGTH 38700013 BAL RR,ALNDMP DUMP PARAMETERS 38800013 * 38900013 * ALL OTHERS 39000013 * 39100013 TYPE4 BC B,ADOUT 39200013 * 39300013 * ALIGNED DUMP FOR USE WHEN DUMPING REGISTERS OR 39400013 * PARAMETERS. GRB POINTS AT THE START OF THE AREA TO BE DUMPED, 39500013 * AND GRC IS THE LENGTH IN BYTES OF THE AREA. 39600013 * 39700013 ALNDMP LA GRD,SVRGS2 POINT AT NON ALIGNED SAVE AREA 39800013 N GRD,AD8W POINT AT 8 W ALIGNED SAVE AREA 39900013 ST RR,STRRA STORE RETURN REGISTER 40000013 EX GRC,MVCHAR MOVE VAR. AREA ONTO AN 8 W BOUND 40100013 LA GRE,0(GRC,GRD) POINT GRE AT END OF AREA 40200013 BAL RR,DUMP DUMP THE AREA 40400013 L RR,STRRA RELOAD RETURN REGISTER 40500013 BCR BR,RR 40600013 MVCHAR MVC 0(0,GRD),0(GRB) 40700013 EJECT 40800013 * 40900013 * PRINT THE HEADINGS. THE ADDRESS OF THE OUTPUT AREA IS 41000013 * PASSED IN GRA 41100013 * 41200013 PRTHED ST RR,TEMP STORE RETURN REGISTER 41300013 ST GRA,PAR1(0,DICR) 41400013 LA DICR,SAVAR POINT AT NEW SAVE AREA 41500013 L LR,ZUPL(0,CNTL) POINT AT PRINT ROUTINE 41600013 BALR RR,LR 41700013 L DICR,DICTEM POINT AT DICTIONARY AGAIN 41800013 L RR,TEMP RELOAD RETURN REGISTER 41900013 BCR BR,RR RETURN 42000013 EJECT 42100013 * THE ROUTINE DUMP CAUSES THAT PART OF CORE WHOSE LOWER 42200013 * AND UPPER ADDRESSES ARE IN GRD AND GRE TO BE OUTPUT ON 42300013 * SYSPRINT. THE OUTPUT IS IN HEX. THERE ARE 8 WORDS PER LINE 42400013 * WITH AN ADDRESS INDEX IN THE FIRST COLUMN. A HEADING WITH THE 42500013 * LIMITS OF THE DUMPED REGION IS ALSO OUTPUT. 42600013 SPACE 2 42700013 DUMP STM RR,CNTLB,DMPSVA STORE REGISTERS IN DMPSVA. 42800013 SPACE 2 42900013 * BUILD TITLE LINE WITH DUMP BOUNDARY ADDRESSES AND PRINT. 43000013 SPACE 43100013 MVI PLC+2,X'02' DOUBLE LINE SPACING 43200013 MVI PL,X'40' SET A BLANK IN PRINTLINE 43300013 MVC PL+1(119),PL AND PROPAGATE IT. 43400013 MVC PL(28),PLTITL SET TITLE IN PRINTLINE. 43500013 SPACE 43600013 N GRD,B3MASK * ZERO THE TOP BYTE 54703 43700064 N GRE,B3MASK * ZERO THE TOP BYTE 54703 43800064 ST GRD,DMPADR * SAVE THE LOW ADDRESS 54703 43900064 LA GRB,DMPADR * POINT AT THE ADCON 54703 44000064 LA GRA,PL+SLTLA * POINT AT PRINT LINE SLOT 54703 44100064 BAL RR,DMPTRN * GO SET UP LOW ADDR IN HEADER 44200064 ST GRE,DMPADR * NOW PRINT THE HIGH ADDRESS 703 44300064 LA GRA,PL+SLTUA * POINT AT PRINT LINE SLOT 54703 44400064 BAL RR,DMPTRN * GO SET UP THE HIGH ADDRESS 703 44500064 LA GRA,PLC * POINT AT CONTROL BYTES 54703 44600064 BAL RR,PRTHED * PRINT THE HEADER LINE 54703 44700064 MVI PLC+2,X'01' * RESET CONTROL CHAR 54703 44800064 SPACE 2 45000013 * ROUND DOWN DUMP BOUNDARY ADDRESSES TO 8 WORD BOUNDARY. 45100013 * PRINT FIRST LINE OF DUMP 54703 45200064 MVI DMP41+1,X'00' * FIRST TIME, NO OP 54703 45210064 MVI DMP43+1,X'F0' * FIRST TIME, BRANCH 54703 45220064 LR GR10,GRD 54703 45230064 ST GRD,SAVEGRD 54703 45240064 N GRD,AD8W * ROUND DOWN TO 8-WORD BNDY 4703 45250064 MVI PL,X'40' * BLANK OUT 54703 45260064 MVC PL+1(40),PL * THE PRINT LINE 45270064 L GR9,ZEROS * ZERO GR9 FOR SAME LINECNT 4703 45280064 ST GR9,STADSL * ZERO 54703 45290064 BAL RR,PRTLN1 * GO PRINT HEADER LINE 54703 45300064 * WORK OUT HOW MUCH TO PRINT ON LINE ONE 54703 45310064 SR GR10,GRD * GR10 EQUALS 54703 45320064 SRL GR10,2 * NUMBER OF WORDS TO SKIP 54703 45330064 LA GRC,CW * LOAD UP WORD COUNT 54703 45340064 C GR10,FOUR * WHICH HALF OF THE PRINT 54703 45350064 BNL DMP31 * LINE ARE WE IN 54703 45360064 LA GRA,PL+SLTW1 * MUST BE FIRST HALF 54703 45370064 LA GRF,C4W 54703 45380064 B DMP32 54703 45390064 DMP31 EQU * 54703 45400064 LA GRA,PL+SLTW5 * MUST BE 2ND HALF 54703 45410064 LA GRF,1 * THIS SAYS ONLY HALF 54703 45420064 S GR10,FOUR * A LINE TO PRINT 54703 45430064 DMP32 EQU * 54703 45440064 C GR10,ZEROS * DO WE PRINT A COMPLETE 54703 45450064 BE DMP34 * LINE OR HALF LINE ,YES 54703 45460064 DMP33 EQU * 45470064 LA GRA,WSP(0,GRA) * STEP ALONG THE LINE 54703 45480064 BCTR GRC,GR0 * DECREMENT WORD COUNT 54703 45490064 BCT GR10,DMP33 * LOOP TO APPROPRIATE WORD 54703 45500064 DMP34 EQU * 45510064 L GRD,SAVEGRD * START POINT FOR DUMP 54703 45520064 LR GR10,GRE * SAVE END POINT 54703 45530064 N GRE,AD8W * ROUND DOWN TO 8-WORD BNDY 4703 45540064 S GRE,THRTYTW * BACK OFF FROM LAST LINE 54703 45550064 B DMP80 * GO INTO DUMP RTN 54703 45560064 SPACE 2 45900013 * TEST FOR END OF DUMP AREA. 46000013 SPACE 46100013 DMP40 CR GRD,GRE COMPARE ADDR INDEX AND END ADDR 46200013 BH DMP41 * PRINT LAST LINE 54703 46300064 BE DMP42 BRANCH TO PRINT LAST 8 WORDS WHEN 46400013 * ADDR INDEX AND END ADDR ARE EQUAL. 46500013 SPACE 2 46600013 * TEST FOR 8 WORDS REPEATED. 46700013 SPACE 46800013 DMP43 B DMP42 * SET TO B FOR 1ST TIME 54703 46830064 * * TO AVOID ADDRESSING OUT OF BND 46860064 CLC 0(32,GRD),0(GRG) COMP NEW AND PREVIOUS 8 WORDS. 46900013 BNE DMP42 BRANCH TO TEST SMLNCT IF NOT EQUAL 47000013 SPACE 2 47100013 * HOUSEKEEPING FOR 8 WORDS REPEATED. 47200013 SPACE 47300013 C GR9,ZEROS COMP GR9 AND ZERO, OMIT SAMELINE 47400013 BC BH,DMP44 INITIALISATION IF SMLNCT POSITIVE. 47500013 ST GRD,STADSL STORE START ADDR OF SAMELINES. 47600013 SR GR9,GR9 ZERO SMLNCT. 47700013 DMP44 LA GR9,1(0,GR9) BUMP SMLNCT BY 1. 47800013 LR GRG,GRD BUMP GRG TO POINT AT NEW 8 WORDS 47900013 LA GRD,32(0,GRD) BUMP ADDR INDEX TO NEXT 8 WORDS. 48000013 B DMP40 BRANCH TO EXAMINE NEXT 8 WORDS. 48100013 SPACE 1 48110064 DMP41 EQU * 54703 48120064 NOP DMP90 * ONE TIME NO OP 54703 48130064 MVI DMP41+1,X'F0' * NEXT TIME ,BRANCH 54703 48140064 CR GRD,GR10 * DOES EXTENT END ON A 54703 48150064 BE DMP90 * 8 WORD BNDRY , YES, EXIT 54703 48160064 MVI PL,X'40' * CLEAR THE 54703 48170064 MVC PL+1(119),PL * PRINT LINE 54703 48180064 B PRTLN * GO PRINT LAST LINE 54703 48190064 SPACE 2 48200013 * TEST FOR NUMBER OF REPEATED LINES. 48300013 SPACE 48400013 DMP42 MVI DMP43+1,X'00' * NULLTHE BRANCH 54703 48500064 BCTR GR9,GR0 * REDUCE SAME LINE COUNT BY 1. 48550064 LTR GR9,GR9 SET COND CODE TO SHOW ORIGINAL 48600013 * VALUE OF SAME LINE COUNT. 48700013 BM PRTLN BRANCH TO PRINT LINE FOR NO 48800013 * REPEAT LINES (CC=1,SMLNCT=0). 48900013 BP SMLNS BRANCH TO MSG LINE FOR MORE THAN 49000013 * ONE LINE REPEATED (CC=2,SMLNCT=1+) 49100013 BZ SMLN BRANCH TO MSG LINE FOR ONE LINE 49200013 * REPEATED (CC=0,SMLNCT=1). 49300013 SPACE 2 49400013 * CONSTRUCT MESSAGE FOR ONE LINE REPEATED. 49500013 SPACE 49600013 SMLN MVI PL,X'40' SET A BLANK IN THE PRINTLINE 49700013 MVC PL+1(119),PL AND PROPAGATE IT. 49800013 MVC PL+SLTAI(25),MSGLN MOVE MESSAGE INTO PRINTLINE. 49900013 LA GRB,STADSL POINT GRB AT STADSL, CONTAINING. 50000013 * ADDR INDEX OF REPEATED LINE. 50100013 LA GRA,PL+SLTLS POINT GRA AT PRINTLINE SLOT. 50200013 BAL RR,DMPTRN USE TRANSLATE ROUTINE ON STADSL. 50300013 B PRTMSG BRANCH TO PRINT MESSAGE LINE. 50400013 SPACE 2 50500013 * CONSTRUCT MESSAGE FOR MORE THAN ONE LINE REPEATED. 50600013 SPACE 50700013 SMLNS MVI PL,X'40' SET A BLANK IN THE PRINTLINE 50800013 MVC PL+1(119),PL AND PROPAGATE IT. 50900013 MVC PL+SLTAI(36),MSGLNS MOVE MESSAGE INTO PRINTLINE. 51000013 LA GRB,STADSL POINT GRB AT STADSL, CONTAINING 51100013 * ADDR INDEX OF FIRST REPEATED LINE. 51200013 LA GRA,PL+SLTLS1 POINT GRA AT PRINTLINE SLOT 51300013 BAL RR,DMPTRN USE TRANSLATE ROUTINE ON STADSL. 51400013 ST GRG,DMPADR PUT ADDR INDEX OF LAST REPEATED 51500013 * LINE IN DMPADR 51600013 LA GRB,DMPADR AND POINT GRB AT IT. 51700013 LA GRA,PL+SLTLS2 POINT GRA AT PRINTLINE SLOT. 51800013 BAL RR,DMPTRN USE TRANSLATE ROUTINE ON DMPADR. 51900013 SPACE 2 52000013 * PRINT MESSAGE LINE. 52100013 SPACE 52200013 PRTMSG LA GRA,PLC SET PAR1 TO POINT AT CONTROL 52300013 BAL RR,PRTHED 52400013 SPACE 2 52500013 * TIDY UP AFTER MESSAGES. 52600013 SPACE 52700013 TIDYPL MVI PL,X'40' SET A BLANK IN PRINTLINE 52800013 MVC PL+1(40),PL AND PROPAGATE AS FAR AS NECCESSARY 52900013 L GR9,ZEROS ZERO GR9 FOR SAME LINE COUNT. 53000013 ST GR9,STADSL ZERO START ADDRESS OF SAME LINE. 53100013 SPACE 2 53200013 * SET ADDRESS INDEX IN PRINTLINE. 53300013 SPACE 53400013 PRTLN EQU * 54703 53500064 LA RR,DMP60 * LOAD RETURN ADDRESS 54703 53520064 PRTLN1 EQU * 54703 53540064 LR GRG,GRD * POINT GRG AT NEW 8 WORDS 54703 53560064 ST GRD,AXPL SET ADDRESS INDEX FOR PRINTLINE 53600013 LA GRB,AXPL IN AXPL, AND POINT GRB AT IT. 53700013 LA GRA,PL+SLTAI POINT GRA AT PRINTLINE SLOT. 53800013 SPACE 2 54100013 * TRANSLATE ROUTINE. GIVEN A 3 BYTE ADDRESS IN A WORD, 54200013 * POINTED AT BY GRB, THE ROUTINE CREATES A 6 BYTE FIELD WHICH IS 54300013 * THE EBCDIC REPRESENTATION OF THE HEX FORM OF THE ADDRESS, AND 54400013 * PUTS THE FIELD IN THE LOCATION WHICH GRA POINTS AT. 54500013 SPACE 54600013 DMPTRN UNPK 0(2*LENA-1,GRA),1(LENA,GRB) UNPACK ADDR INTO PRINTLINE. 54700013 MVC 2*LENA-1(1,GRA),LENA(GRB) MOVE LAST BYTE OF ADDR TO PL. 54800013 MVZ 0(2*LENA,GRA),ZMSK8 ZERO ALL ZONES. 54900013 TR 0(2*LENA,GRA),TTAB TRANSLATE 6 BYTES IN PRINTLINE. 55000013 BR RR RETURN 55100013 SPACE 2 55200013 * CREATE 8 WORD PRINTLINE. 55300013 SPACE 55400013 DMP60 LA GRA,PL+SLTW1 SET PRINTLINE SLOT FOR WORD 1. 55500013 LA GRF,C4W INITIALIZE 4 WORD COUNTER. 55600013 DMP70 LA GRC,CW INITIALIZE WORD COUNTER. 55700013 SPACE 55800013 DMP80 EQU * 54703 55900064 CR GRD,GR10 * HAVE WE REACHED END OF EXTENT 55920064 BNL DMP85 * YES, THEN PRINT LINE 54703 55940064 UNPK 0(2*LENW-1,GRA),0(LENW,GRD) UNPACK WORD INTO LINE 4703 55960064 MVC 2*LENW-1(1,GRA),LENW-1(GRD) MOVE LAST BYTE OF WORD. 56000013 MVZ 0(2*LENW,GRA),ZMSK8 ZERO ALL ZONES. 56100013 TR 0(2*LENW,GRA),TTAB TRANSLATE 8 BYTES IN PRINTLINE. 56200013 SPACE 56300013 LA GRA,WSP(0,GRA) BUMP PRINTLINE SLOT BY SPACING. 56400013 LA GRD,LENW(0,GRD) GRD POINTS AT NEXT WORD. 56500013 BCT GRC,DMP80 REPEAT TRANSLATION FOR 4 WORDS. 56600013 SPACE 56700013 LA GRA,PL+SLTW5 SET PRINTLINE SLOT FOR WORD 5. 56800013 BCT GRF,DMP70 REPEAT FOR 2ND 4 WORDS. 56900013 SPACE 2 57000013 * OUTPUT AN 8 WORD PRINTLINE. 57100013 SPACE 1 54703 57160064 DMP85 EQU * 54703 57220064 LA GRA,PLC SET PAR1 TO POINT AT CONTROL 57300013 ST GRA,PAR1(DICR) BYTES TO PRINT PRINTLINE. 57400013 LA DICR,SAVAR POINT AT NEW SAVE AREA. 57500013 L LR,ZUPL(CNTL) LOAD ADDRESS OF PRINT ROUTINE, 57600013 BALR RR,LR SET RETURN REGISTER AND CALL ZUPL. 57700013 L DICR,DICTEM POINT AT DICTIONARY AGAIN. 57800013 SPACE 2 57900013 B DMP40 LOOP TO CREATE NEXT PRINTLINE. 58000013 SPACE 2 58100013 * RETURN TO CONTROL. 58200013 SPACE 58300013 DMP90 LM RR,CNTLB,DMPSVA RESTORE REGISTERS 58400013 BR RR RETURN. 58500013 EJECT 58600013 PLC DC X'007840' 58800015 PL DS CL120 PRINTLINE. 58900013 PLTITL DC C' CORE DUMP FROM TO' 59000013 CNOP 0,4 59100013 AD8W DC X'00FFFFE0' MASK TO GIVE 8 WORD ROUNDING. 59200013 ZMSK8 DC X'0000000000000000' USED TO ZERO ZONES IN PRINTLINE. 59300013 AXPL DS F ADDRESS INDEX FOR PRINTLINE. 59400013 DMPADR DS F DUMP BOUNDARY STORAGE. 59500013 DMPSVA DS 16F REGISTER SAVE AREA. 59600013 TTAB DC X'F0F1F2F3F4F5F6F7' TRANSLATE TABLE. 59700013 DC X'F8F9C1C2C3C4C5C6' 59800013 MSGLN DC C'LINE SAME AS ABOVE' 59900013 MSGLNS DC C'LINES TO SAME AS ABOVE' 60000013 STADSL DS F START ADDRESS OF SAME LINE. 60200013 SLTLS EQU 9 PRINTLINE OFFSET FOR SL ADDR 60300013 SLTLS1 EQU 10 1ST SL ADDR 60400013 SLTLS2 EQU 20 LST SL ADDR 60500013 LENA EQU 3 LENGTH OF ADDR. 60600013 LENW EQU 4 LENGTH OF WORD. 60700013 CW EQU 4 WORD COUNTER. 60800013 C4W EQU 2 4 WORD COUNTER. 60900013 SLTLA EQU 19 PRINTLINE OFFSET FOR LOW ADDR. 61000013 SLTUA EQU 29 HIGH ADDR. 61100013 SLTAI EQU 4 ADDR INDEX. 61200013 SLTW1 EQU 17 WORD 1. 61300013 SLTW5 EQU 76 WORD 5. 61400013 WSP EQU 11 WORD SPACING IN PRINTLINE. 61500013 BASOF EQU 140 61550015 SPACE 61600013 EJECT 61700013 FSTMES DC X'0017' 61800013 DC C'1' 61900015 DC C'PHASE ' 62000013 NAMMES DC C'XY.' 62100013 DC C' DUMP FOLLOWS.' 62200013 SWA DC X'00' 62300013 ZABSW DC X'00' 62400013 BLKMES DC X'0013' 62500013 DC C'-' 62600015 DC C'BLOCK CONTROL AREA.' 62700013 MESBLK DC X'0016' 62800013 DC C'-' 62900015 BLKNAM DC C' ' 63000013 DC C' BLOCK NUMBER ' 63100013 MESNO DC C' ' 63200013 PHSNMS DC X'0013' 54703 63210064 DC C' ' 54703 63240064 DC C'PHASE YY COMPLETED.' 54703 63270064 FOURK DC H'4096' 63300013 SEVEN DC F'7' 63400013 FOUR DC F'4' 63500013 THRTYTW DC F'32' 54703 63510064 B3MASK DC X'00FFFFFF' * MASK TO ZERO TOP BYTE 54703 63520064 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AD 003-TSS 63550001 SAVAR DS 18F 63600013 * ----------------------------------------------------AD 003-TSS 63650001 SVRGS1 DS 3D FOR 8-WORD ALIGNMENT 33893 63720020 SVRGS2 DS 4D 63800013 SVRGS3 DS 4D 63900013 DICTEM DS F 64000013 TEMP DS F 64100013 TIMTEMP DS D TEMP FOR PHASE TIME 64150056 TEXTN DC C'TEXT' 64200013 DICTN DC C'DICT' 64300013 NUMBER DS D 64400013 FINAL DS F 64500013 STADDR DS F 64600013 STRRA DS F 64700013 PARSAV DS 2F 64800013 ZEROS DC F'0' 64900013 SAVEGRD DS F 54703 64905064 CONPHSIZ DC F'0' SIZE ALIGNMENT WORD 32317 64910020 DS 0H 32317 64920020 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AD 011-TSS 64925056 CONPHLST DS 0XL79 BUILD LIST FOR DUMPABLE 32317 64930020 * CONTROL PHASES 32317 64940020 FF DC H'3' NO. OF ENTRIES 32317 64950020 LL DC H'27' LENGTH OF ENTRIES 32317 64960020 PHAZA DC CL8'IEMAA' 32317 64970020 DS XL16 32317 64980020 SIZEA DS XL3 32317 64990020 PHAZB DC CL8'IEMAN' 32317 65000020 DS XL16 32317 65010020 SIZEB DS XL3 32317 65020020 PHAZC DC CL8'IEMAT' 32317 65030020 DS XL16 32317 65040020 SIZEC DS XL3 32317 65050020 CONDUMP1 DC X'00' 1ST CONTROL PHASE DUMP SW. 32317 65070020 * ----------------------------------------------------AD 011-TSS 65080056 SCRMES DC X'0012' 65100013 DC C'-' 65200015 DC C'SCRATCH CORE AREAS' 65300013 PDMES DC X'000E' 65400013 DC C'-' 65500015 DC C'LOADED PHASES.' 65600013 PDMES1 DC X'0011' 65700013 DC C'0' 65800015 DC C'PHASE ' 65900013 PHSNAM DC C'XY' 66000013 DC C' FOLLOWS.' 66100013 PDMES2 DC X'0025' 66200013 DC C'0' 66300015 DC C'PHASE ' 66400013 PHSNIM DC C'XY LOADED BUT CANNOT BE DUMPED.' 66500013 SPACE 66600013 CONMES DC X'001A' 32317 66650020 DC C'1' 32317 66700020 CONHDG DC C'RESIDENT CONTROL PHASE AA.' 32317 66750020 ATMES DC X'0015' 32317 66800020 DC C'1' 32317 66850020 ATHDG DC C'TRACE/PATCH PHASE AT.' 32317 66900020 SPACE 67000013 DYNMS1 DC X'0019' 67100013 DC C'-' 67200015 DC C'DYNAMIC DUMP IN PHASE ' 67300013 DYNAM DC C'XY.' 67400013 SPACE 67500013 DYNMS2 DC X'0034' 67600013 DC C'1' 67700015 DC C'INVALID STATUS IN DYNAMIC' 67800013 DC C' INVOCATION, NO DUMP GIVEN.' 67900013 ZABMES DC X'003F' 68000013 DC C'1' 68100015 DC C'COMPILER ABORT. ' 68200013 DC C'DUMP GIVEN BEFORE ' 68300013 DC C'CURRENT PHASES ARE ' 68400013 DC C'RELEASED.' 68500013 REGMES DC X'0012' 68600013 DC C'0' 68700015 DC C'REGISTERS 0 TO 15.' 68800013 PARMES DC X'0012' 68900013 DC C'0' 69000015 DC C'PARAMETERS 1 TO 8.' 69100013 AANAME DC C'AA' 69200013 SVAREA DC X'00' 69300013 IANAME DC C'IA' 69400013 OENAME DC C'OE' 69500013 CANAME DC C'CA' 69600013 EJECT 69700013 * 69800013 * TRANSFER VECTOR EQUATES 69900013 * 70000013 ZUPL EQU X'08' 70100013 PAROF EQU X'1C' 70200013 ZDRFAB EQU X'34' 70300013 TXTAB EQU X'54' 70400013 ZUST EQU X'4C' 70500013 * 70600013 * COMMUNICATIONS REGION EQUATES 70700013 * 70800013 ZTV EQU 64 70900013 MYNAM EQU 112 71000013 DICTP EQU 116 71050001 PAR1 EQU 128 71100013 PAR2 EQU PAR1+4 71200013 PAR3 EQU PAR2+4 71250001 FSTDIC EQU 160 71300013 DICTSZ EQU 260 71400013 AREA EQU 187 71500013 ZSHIFT EQU 283 71600013 CCCODE EQU 232 71700013 ZTIM EQU X'2FC' PHASE STARTING TIME Z2151 71750056 * 71800013 * INITIALISATION LIST EQUATES 71900013 * 72000013 ALLOCA EQU 0 72100013 TSLOF EQU 8 72200013 DSLOF EQU 12 72300013 PDOF EQU 28 72400013 DADOF EQU 44 72500013 ATOF EQU 160 A(PTR. TO AT) 32317 72550020 * 72600013 * REGISTER EQUATES 72700013 * 72800013 GR0 EQU 0 72900013 GRA EQU 1 73000013 GRB EQU 2 73100013 GRC EQU 3 73200013 GRD EQU 4 73300013 GRE EQU 5 73400013 GRF EQU 6 73500013 GRG EQU 7 73600013 GR8 EQU 8 73700013 GR9 EQU 9 73800013 GR10 EQU 10 54703 73850064 CNTLB EQU 11 73900013 CNTL EQU 11 74000013 DICR EQU 13 74100013 RR EQU 14 74200013 LR EQU 15 74300013 * 74400013 * BRANCH EQUATES 74500013 * 74600013 NOP EQU 0 74700013 B EQU 15 74800013 BR EQU 15 74900013 BH EQU 2 75000013 BL EQU 4 75100013 BNL EQU 11 75200013 BE EQU 8 75300013 BNE EQU 7 75400013 BNZ EQU 7 75500013 BNH EQU 13 75600013 BO EQU 1 75700013 BNO EQU 14 75800013 BZ EQU 8 75900013 BM EQU 4 76000013 SPACE 76100013 END IEMAD 76200013 ./ ADD SSI=02013130,NAME=IEMAE,SOURCE=0 AE TITLE 'IEMAE,CLEAN-UP AFTER READIN,COMPILER CONTROL,OS/360 PL/C00200013 I COMPILER(F)' 00400013 SPACE 10 00450017 * 00500064 * 00510064 * 5.4 A 135000,136000,148600,150000. MAC 54703 00520064 * 5.0 A 272000,636000,664000,670000. JRT H313 00530064 * C 372000-376000,590000. JRT H313 00540064 * D 268600-269200. JRT H313 00550064 * R17 2930. SYSLIN AND SYSPUNCH ARE NO LONGER OPENED BY I14 00560064 * IEMAE. THEY ARE NOW OPENED BY IEMAB, IF I14 00570064 * REQUIRED, AND LEFT OPEN. I14 00580064 * C 148000,156000-248000,468000-554000. I14 00590064 * 00600064 * 00610064 SPACE 5 00620064 GBLB &STD 00630064 &STD SETB 1 00640064 SPACE 5 00650064 EJECT 00750017 * STATUS - CHANGE LEVEL 0 00800013 * 01000013 * FUNCTIONS-1) -DELETED- I14 01200017 * 2)CLOSE LAST INPUT DCB 01400013 * 3)DELETE IEMAC IF NECESSARY 01600013 * 4)EXPAND FROM 2 TO 4 TEXT AND DICTIONARY BLKS 01800013 * IF NECESSARY 02000013 * 02200013 * ENTRY POINTS-1)IEMAE IS THE ONLY POINT 02400013 * 02600013 * INPUT- NO SPECIAL INPUT 02800013 * 03000013 * OUTPUT- EXPANDED NUMBER OF TEXT AND DICTIONARY BLOCKS. 03300017 * 03600013 * EXTERNAL ROUTINES-1)CLOSE 03800013 * 2)DELETE 04000013 * 3)OPEN 04200013 * 4)GETMAIN (VC-TYPE) 04400013 * 04600013 * EXITS - OUT 04800013 * 05000013 * ATTRIBUTES- NONE 05200013 * 05400013 * NOTES - THIS ROUTINE IS LINKED TO BY THE LOAD ROUTINES 05600013 * WHEN READIN IS FINISHED. IT REDUCES THE SIZE OF THE RESIDENT 05800013 * CONTROL PHASE AND REDUCES CORE FRAGMENTATION. 06000013 * THIS ROUTINE IS ALSO CALLED BEFORE A COMPILER ABORT 06060001 * IN MACROS IN ORDER TO EXPAND BLOCKS SO BM CAN OPERATE. 06120001 * 06200013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AE 000-TSS 06260056 * ----------------------------------------------------AE 000-TSS 06320056 EJECT 06400013 SPACE 06600013 IEMAE CSECT 06800001 USING *,GRBASE 07000013 STM 14,GRBASE,12(DICR) STORE REGISTERS 07200013 LR GRBASE,15 LOAD UP BASE 07400013 LA GRA,OSSAVR POINT AT NEXT SAVE AREA 07600013 ST DICR,4(0,GRA) CHAIN FORWARDS 07800013 ST GRA,8(0,GRA) CHAIN BACKWARDS 08000013 ST DICR,THISD 08200013 SPACE 08400013 L GRA,PAROF(0,CNTL) PICK UP ADDRESS OF INIT LIST 08600013 L GRB,RDADD(0,GRA) ADDRESS OF ADDRESS OF INPUT DCB 08800013 L GRB,0(0,GRB) POINY AT INPUT DCB 09000013 L GRC,DADOF(0,GRA) 09200013 L DICR,0(0,GRC) POINT AT DICTIONARY 09400013 ST DICR,DICTEM 09600013 SPACE 09800013 MVC PARTMP(8),PAR1(DICR) SAVE PAR1 AND PAR2 10000013 TM CCCODE+3(DICR),X'10' SEE IF MACRO RUNNING 10200013 BC BO,NOTDCK BRANCH TO EXPAND 10400013 TM CCCODE+1(DICR),X'03' SEE IF CHAR48 OR MACRO 10600013 BC BNO,NOMANP 10800013 TM CCCODE+3(DICR),X'04' SEE IF EOF OR BATCH HAS BEEN FND 11000013 BC BO,FOUND 11200013 LA GRC,INBUF POINT AT A BUFFER INCASE ANY 11400013 ST GRC,PAR1(0,DICR) RECORDS READ 11600013 L LR,ZURDOF(0,CNTL) POINT AT THE READ ROUTINE 11800013 SPACE 12000013 RDLOOP BALR RR,LR 12200013 BC B,FOUND EXIT HERE IF EOF OR BATCH FOUND 12400013 BC B,RDLOOP 12600013 SPACE 12800013 FOUND TM CCCODE+3(DICR),X'08' SEE IF GENUINE EOF 13000013 BC BO,NOCLOSE JUMP CLOSE IF BATCHING 13200013 NOMANP EQU * 13240015 USING IHADCB,GRB 13280015 LH GRC,DCBBLKSI GIVE BACK SYSIN BUFFERS 13320015 DROP GRB 13360015 AR GRC,GRC SPACE WHEN CLOSING 13400015 A GRC,CORLFT(DICR) 13440015 ST GRC,CORLFT(DICR) 13480015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AE 004-TSS 13500001 AIF (&STD).ASMA1 13504064 AGO .ASMO1 13508064 .ASMA1 LA DICR,OSSAVR POINT AT SAVE AREA 13512064 .ASMO1 ANOP 13516064 CLSIN CLOSE ((GRB)) 13520015 FREEPOOL (GRB) 13600013 AIF (&STD).ASMA2 13620064 AGO .ASMO2 13640064 .ASMA2 L DICR,DICTEM POINT AT DICTIONARY 13660064 .ASMO2 ANOP 13680064 * ----------------------------------------------------AE 004-TSS 13700001 SPACE 13800013 NOCLOSE L GRA,PAROF(0,CNTL) 14000013 L GRB,TSLOF(0,GRA) PICK UP ADDRESS OF TSLOTS 14200013 SPACE 14400013 TM CCCODE+1(DICR),X'03' SEE IF CHAR48 OR MACRO 14600013 BC BO,NOTDCK I14 14800017 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AE 006-TSS 14860001 AIF (&STD).ASMA3 14880064 AGO .ASMO3 14900064 .ASMA3 LA DICR,OSSAVR POINT AT SAVE AREA 14920064 .ASMO3 ANOP 14940064 DELETE EP=IEMAC DELETE INTERMEDIATE FILE ROUTINE 15000013 AIF (&STD).ASMA4 15020064 AGO .ASMO4 15040064 .ASMA4 L DICR,DICTEM POINT AT DICTIONARY 15060064 .ASMO4 ANOP 15080064 * ----------------------------------------------------AE 006-TSS 15100056 SPACE 15200013 EJECT 15400013 * A TEST IS MADE TO SEE IF THE BLOCK EXPANDER IS REQUIRED. 25000013 * IT WILL ONLY BE ASKED FOR IN AN ENVIRONMENT WITH 1K TEXT AND 25200013 * DICTIONARY BLOCKS. A SEARCH IS MADE FOR FREE SLOTS IN THE TEXT 25400013 * AND DICTIONARY BLOCK COMTROL AREA. THE CORE ADDRESS OBTAINED 25600013 * BY THE GETMAIN IS INSERTED IN THE RELEVANT SLOT. THE BLOCKS 25800013 * ARE MARKED IN-CORE AND FREE. IN THIS WAY IT IS HOPED THAT 26000013 * FRAGMENTATION OF CORE WILL BE REDUCED. 26200013 SPACE 26400013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AE 001-TSS 26500001 NOTDCK TM CCCODE+2(DICR),X'04' SEE IF BLOCK EXPANSION IS RQD 26600013 BC BZ,MORCOR IF NOT GIVE T AND D AN EXTRA 4K 26800013 SPACE 27000013 L GRA,PAROF(0,CNTL) 27200013 L GRB,AEABTOF(GRA) POINT AT AE ABORT SWITCH H313 27220001 CLI 0(GRB),X'FF' HAS AE ALREADY ABORTED H313 27240001 BNE NOTOUT BRANCH IF NOT H313 27260001 MVI 0(GRB),X'00' CLEAR SW IN CASE BATCHING H313 27280001 B OUT AND LEAVE AE H313 27300001 NOTOUT EQU * H313 27320001 L GRB,TSLOF(0,GRA) PICK UP ADDRESS OF TSLOTS 27400013 L GR0,DICTSZ(0,DICR) PICK UP BLOCK SIZE 27600013 ST GR0,GETLST STORE SIZE OF BLOCK IN GETMAIN 27800013 ST GR0,GETLST+4 REQUEST LIST 28000013 L GRF,TXTSZ(0,DICR) PICK UP TEXT BLOCK SIZE 28200013 XR GRD,GRD SET COUNT TO ZERO 28400013 LA DICR,OSSAVR POINT AT NEW SAVE AREA 28600013 SPACE 28800013 ZLOOP LA GRC,2 SET TO COUNT LOOP TWICE 29000013 SPACE 29200013 GLOOP GETMAIN VC,LA=GETLST,A=ANSW GET ANOTHER BLOCK 29400013 BC B,HERE(15) CHECK TO SEE IF BLOCK IS OK 29600013 HERE BC B,OK 29800013 BC B,STOPC 30000013 SPACE 30200013 OK CLI 0(GRB),X'FF' SEE IF SLOT IS FREE 30400013 BC BE,INSERT 30600013 GLOOP1 LA GRD,1(0,GRD) BUMP COUNT BY 1 30800013 LA GRB,4(0,GRB) BUMP TO NEXT SLOT 31000013 CLI 1(GRB),X'FF' TEST FOR STOPPER 31200013 BC BNE,OK 31400013 BC B,STOPC 31800015 SPACE 32200013 INSERT MVC 0(4,GRB),ANSW MOVE ADDRESS INTO SLOTS 32400013 MVI 0(GRB),X'81' MARK BLOCK AS IN-CORE AND FREE 32600013 L GRE,ANSW 32800013 AR GRE,GRF ADD ON TEXT BLOCK SIZE 33000013 NAME STC GRD,5(0,GRE) NAME BLOCK 33200013 BCT GRC,GLOOP 33400013 SPACE 33600013 OUTBR BC NOP,OUT 33800013 L GRA,PAROF(0,CNTL) 34000013 MVI OUTBR+1,X'F0' BRANCH WHEN ENTRIES IN DSLOTS 34200013 L GRB,DSLOF(0,GRA) ARE MADE. POINT AT DSLOTS+24 34400013 SPACE 34410015 FNDEND CLI 1(GRB),X'FF' TEST IF THIS IS DSLOTS STOPPER 34420015 BC BE,FOUNDS YES, BRANCH 34430015 LA GRB,4(GRB) BUMP TO NEXT IN DSLOTS 34440015 BC B,FNDEND LOOP 34450015 * 34460015 FOUNDS CLI 9(GRB),X'FF' TEST IF STOPPER PROTECTS 2 SLOTS 34470015 BC BNE,NORMAL NO, OMIT NEXT INSTNS 34480015 MVI 1(GRB),X'00' FREE THE FIRST STOPPER 34490015 MVI 0(GRB),X'FF' SHOW SLOT UNUSED 34500015 * 34510015 NORMAL L GRB,DSLOF(0,GRA) 34520015 SPACE 34530015 MVC NAME(2),BRCHC DO NOT NAME DICTIONARY BLOCKS 34600013 LA GRC,2 34800013 BC B,GLOOP 35000013 * ----------------------------------------------------AE 001-TSS 35100001 SPACE 35200013 OUT L DICR,DICTEM POINT AT DICTIONARY 35400013 MVC PAR1(8,DICR),PARTMP RESTORE PAR1 AND PAR2 35600013 L DICR,THISD 35800013 LM 14,GRBASE,12(DICR) AREA. RELOAD REGISTERS 36000013 LA LR,4 SHOW RETURNING CORRECTLU 36200013 MVI 12(DICR),X'FF' SHOW RETURN IS COMPLETE 36400013 BCR BR,RR 36600013 SPACE 36800013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AE 002-TSS 36900001 STOPC L DICR,DICTEM POINT AT DICTIONARY 37000013 L GRA,PAROF(CNTL) POINT AT INIT LIST H313 37080001 L GRA,AEABTOF(GRA) HENCE AT AE ABORT SWITCH H313 37160001 MVI 0(GRA),X'FF' SAY AE WANTS TO ABORT H313 37240001 MVI ERCODE+3(DICR),X'10' SET TERMINAL ERROR CODE H313 37320001 LA GRA,ERR13 SAY NO CORE FOR THIS H313 37400001 ST GRA,PAR1(DICR) ENVIRONMENT H313 37480001 LA DICR,OSSAVR H313 37560001 L LR,ZUPL(CNTL) PRINT ERROR MESSAGE H313 37640001 BALR RR,LR 37800013 L DICR,THISD RELOAD REGISTERS FROM SAVE AREA 38000013 LM 14,GRBASE,12(DICR) AND PUT RETURN CODE IN 15 TO SHOW 38200013 LA LR,0 AE WANTS TO ABORT 38400013 MVI 12(DICR),X'FF' AE WISHES TO ABORT COMPILER 38600013 BCR BR,RR 38800013 * ----------------------------------------------------AE 002-TSS 38900001 EJECT 39000013 * THIS ROUTINE (SIMILAR TO ONE IN AB) GETS ALL THE BLOCKS 39200013 * IT CAN AS SOON AS IT CAN TO REDUCE CORE FRAGMENTATION. THE 39400013 * ADDRESSES OF THE BLOCKS ARE INSERTED INTO THE USED ENTRIES 39600013 * OF THE ORIGINAL TABLE BUILT IN AB 39800013 * IF THIS CALL TO AE IS AFTER MACRO, THE EXTRA 4K NOW 40000013 * AVAILABLE IS OF NO USE, SINCE IMMEDIATELY AFTER THE MACRO 40200013 * ERROR MSGS EITHER READIN OR TERMINATION FOLLOWS. IN THIS CASE 40400013 * NO ATTEMPT IS MADE TO ADD TO BLKTBL. 40600013 * 40800013 MORCOR L GRC,CORLFT(DICR) LOAD AVAILABLE CORE 41000013 A GRC,FOURK ADD CORE FREED BY MACRO OR READIN 41200013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AE 003-TSS 41300001 TM CCCODE+3(DICR),X'10' IS IT MACRO RUNNING 41400013 BC BO,TBLEND IF SO OMIT GETMAINS 41600013 L GRB,PAROF(0,CNTL) POINT AT INITIALISATION LIST 41800013 L GRB,BTBLOF(0,GRB) POINT AT BLOCK TABLE 42000013 L GRD,DICTSZ(0,DICR) LOAD BLOCK SIZE 42200013 LA GRE,10 SET TABLE COUNT 42400013 SPACE 42600013 ST GRD,GETLST FILL IN GETMAIN REQUEST SIZE 42800013 ST GRD,GETLST+4 43000013 SPACE 43200013 NXBLK CR GRD,GRC TRY FOR ANOTHER BLOCK 43400013 BC BH,TBLEND END IF NO CORE AVAILABLE 43600013 CLI 0(GRB),X'FF' TEST FOR A USED OR EMPTY SLOT 43800013 BC BNE,NOGETM BRANCH IF SLOT HOLDS GOOD ADDR 44000013 SPACE 44200013 GETMAIN VC,LA=GETLST,A=ANSW GET ANOTHER BLOCK 44400013 BC B,HEREA(15) CHECK IF BLOCK IS OK 44600013 HEREA BC B,OKA 44800013 BC B,TBLEND 45000013 SPACE 45200013 OKA L GRF,ANSW PUT BLOCK ADDR INTO TABLE 45400013 ST GRF,0(0,GRB) 45600013 SR GRC,GRD REDUCE AVAILABLE CORE 45800013 NOGETM LA GRB,4(0,GRB) BUMP TABLE POINTER 46000013 BCT GRE,NXBLK SET NEXT BLOCK IF TABLE HAS ROOM 46200013 * ----------------------------------------------------AE 003-TSS 46300001 TBLEND ST GRC,CORLFT(DICR) STORE REDUCED CORE VALUE 46400013 BC B,OUT 46600013 EJECT 55600013 ETY DC F'80' 55800013 FOURH DC F'400' 56000013 FOURK DC F'4096' 56200013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AE 007-TSS 56300001 SAVARD DC 18F'0' 56400013 * ----------------------------------------------------AE 007-TSS 56500001 ERRF23 DC X'0F2300' 56600013 ERRF25 DC X'0F2500' 56800013 ERRF30 DC X'0F3008' 57000013 ERRF31 DC X'0F3108' 57200013 DICTEM DC F'0' 57400013 SPACE 57600013 PARTMP DC 2F'0' 57800013 GETLST DC F'0' 58000013 DC F'0' 58200013 ANSW DC F'0' 58400013 OSSAVR DS 18F 58600013 THISD DC F'0' 58800013 ERR13 DC X'004660' H313 58900001 DC C'IEM3859I INSUFFICIENT CORE IS AVAILABLE' H313 59000001 DC C' TO CONTINUE THIS COMPILATION' H313 59100001 BRCHC DC X'4700' 59200013 EXSW DC X'00' 59400013 SPACE 59600013 INBUF DS 100C INPUT AREA TO RD CDS TO DELIMTER 61000013 EJECT 61200013 * 61400013 * DESCRIBE SYSPUNCH AND SYSLIN DCB 61600013 * 61800013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AE 005-TSS 61900001 DCBD DSORG=(BS),DEVD=DA 62000013 * ----------------------------------------------------AE 005-TSS 62100001 EJECT 62200013 * 62400013 * COMMUNICATIONS REGION EQUATES 62600013 * 62800013 PAR1 EQU 128 63000013 PAR6 EQU PAR1+20 63200013 CORLFT EQU 160 63400013 IOERSW EQU 191 63600013 ERCODE EQU 224 H313 63700001 CCCODE EQU 232 63800013 DICTSZ EQU 260 64000013 TXTSZ EQU 264 64200013 * 64400013 * INITIALISATION LIST EQUATES 64600013 * 64800013 TSLOF EQU 8 65000013 DSLOF EQU 12 65200013 RDOF EQU 16 65400013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AE 008-TSS 65460001 * ----------------------------------------------------AE 008-TSS 65520001 DADOF EQU 44 65600013 LFOF EQU 48 65800013 SPOF EQU 52 66000013 RDADD EQU 60 66200013 BTBLOF EQU 100 66400013 AEABTOF EQU 180 H313 66500001 * 66600013 * TRANSFER VECTOR EQUATES 66800013 * 67000013 ZUPL EQU X'08' H313 67100001 ZURDOF EQU X'0C' 67200013 PAROF EQU X'1C' 67400013 ZUERR EQU X'30' 67600013 ABORT EQU X'20' 67800013 * 68000013 * REGISTER EQUATES 68200013 * 68400013 GR0 EQU 0 68600013 GRA EQU 1 68800013 GRB EQU 2 69000013 GRC EQU 3 69200013 GRD EQU 4 69400013 GRE EQU 5 69600013 GRF EQU 6 69800013 GRBASE EQU 9 70000013 CNTL EQU 11 70200013 DICR EQU 13 70400013 RR EQU 14 70600013 LR EQU 15 70800013 * 71000013 * BRANCH EQUATES 71200013 * 71400013 NOP EQU 0 71600013 BO EQU 1 71800013 BE EQU 8 72000013 BNE EQU 7 72200013 BZ EQU 8 72400013 BH EQU 2 72600013 B EQU 15 72800013 BR EQU 15 73000013 BNO EQU 12 73200013 END IEMAE 73400013 ./ ADD SSI=02012960,NAME=IEMAG,SOURCE=0 AG TITLE 'IEMAG,INTERMEDIATE FILE SWITCHING,COMPILER CONTROL,OS/3C00600013 60 PL/I COMPILER(F)' 01200013 SPACE 10 01400017 *3280 318000 H142 01600017 * R20 319000,564000 H452 01700020 * ### +270000,+297000,+642000 ### - SEE ID# 40098 01730046 EJECT 01760046 * 01800013 * STATUS - CHANGE LEVEL 0 02400013 * 03000013 * FUNCTIONS-1)CLOSE INTERMEDIATE FILE (SYSUT3) 03600013 * 2)REOPEN FOR INPUT 04200013 * 3)CLOSE CURRENT INPUT FILE (SYSPLIN) 04800013 * 05400013 * ENTRY POINT - IEMAG 06000013 * 06600013 * INPUT- NONE 07200013 * 07800013 * OUTPUT- NONE 08400013 * 09000013 * EXTERNAL ROUTINES-1)CLOSE 09600013 * 2)OPEN 10200013 * 10800013 * EXIT - END OF CODE. THERE ARE NO BRANCHES 11400013 * 12000013 * ATTRIBUTES - NONE 12600013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AG 000-TSS 12800020 * ----------------------------------------------------AG 000-TSS 13000020 EJECT 13200013 * THIS IS ANOTHER NON-RESIDENT PHASE WHICH IS LINKED TO BY 13800013 * IEMAC WHEN THE TIME ARISES FOR THE INPUT FILE TO BE CLOSED AND 14400013 * THE OUTPUT FILE CLOSED AND OPENED FOR INPUT. THE ZURD DCB IS 15000013 * THEN IGNORED AND THE BWDCB IS USED BY ZURD. 15600013 SPACE 16200013 IEMAG START 0 16800013 USING *,BASE 17400013 STM 14,CNTL2,12(DICR) STORE ALL REGISTERS 18000013 LR BASE,LR LOAD UP BASE REGISTER 18600013 LA GRA,SAVAR POINT AT NEW SAVE AREA 19200013 ST DICR,4(0,GRA) CHAIN FORWARDS 19800013 ST GRA,8(0,DICR) CHAIN BACKWARDS 20400013 LR DICR,GRA 21000013 SPACE 21600013 L GRB,ZUBW(0,CNTL) PICK UP ADDRESS OF IEMAC 22200013 L GRC,BWOFF(0,GRB) PICK UP ADDRESS OF OUTPUT DCB 22800013 L GRD,PAROF(0,CNTL) POINT AT INITIALISATION LIST 23400013 L GRE,RDOF(0,GRD) POINT AT INPUT DCB 24000013 SPACE 24600013 USING IHADCB,GRE 25200013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AG 001-TSS 25500001 MVC TEMP(3),DCBEODAD+1 PICK UP EOF ADDRESS FROM INPUT 25800013 MVC TEMP1(3),DCBSYNAD+1 PICK UP SYNAD ADDRESS 26400013 * ----------------------------------------------------AG 001-TSS 26700001 DROP GRE 27000013 USING IHADCB,GRC 40098 27200046 LH GR8,DCBBLKSI PICK UP OLD SYSUT3 BLKSIZE 40098 27400046 CLOSE ((GRC)) CLOSE OUTPUT FILE 27600013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AG 002-TSS 27900001 FREEPOOL (GRC) 28200013 * ----------------------------------------------------AG 002-TSS 28500001 SPACE 28800013 USING IHADCB,GRC 29400013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AG 003-TSS 29700001 STH GR8,DCBBLKSI SET UP NEW SYSUT3 BLKSIZE 40098 29800046 MVI DCBMACR,X'50' MAKE IT A GET(MOVE) 30000013 MVI DCBMACR+1,X'00' CLEAR OUT PUT LOCATE BYTE 30600013 MVC DCBEODAD+1(3),TEMP PUT EOF ADDRESS IN NEW INPUT DCB 31200013 MVC DCBSYNAD+1(3),TEMP1 PUT SYNAD ADDRESS IN DCB H142 31800017 OI DCBCNTRL,X'80' WE ACCEPT BAD INPUT H452 31900020 * ----------------------------------------------------AG 003-TSS 32100001 DROP GRC 32400013 SPACE 33000013 LM GRF,GRG,UT3OF(GRD) PICK UP ADDRESSES OF ERROR 33600013 MVC 0(3,GRF),ERRF20 MESSAGE CONSTANTS 34200013 MVC 0(7,GRG),ERRMES 34800013 SPACE 35400013 OPEN ((GRC),(INPUT)) OPEN AGAIN FOR INPUT 36000013 SPACE 36600013 L GRF,DADOF(0,GRD) 37200013 L GRF,0(0,GRF) POINT AT DICTIONARY 37800013 MVC TEMP(8),PAR1(GRF) STORE PAR1 AND PAR2 TEMPORARILY 38400013 TM CCCODE+3(GRF),X'04' SEE IF EOF FOUND 39000013 BC BO,FOUND 39600013 L LR,ZURDOF(0,CNTL) POINT AT READ ROUTINE 40200013 LA GRA,INBUF POINT AT BUFFER FOR READ 40800013 ST GRA,PAR1(0,GRF) 41400013 RDLOOP BALR RR,LR READ RECORDS 42000013 BC B,FOUND EXIT HERE WHEN EOF OR BATCH FND 42600013 BC B,RDLOOP 43200013 SPACE 43800013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AG 008-TSS 44100020 FOUND TM CCCODE+3(GRF),X'08' SEE IF BATCHING THIS INPUT 44400013 BC BO,NOCLOS 45000013 CLOSE ((GRE),) CLOSE SYSIN IF NOT BATCHING 45600013 * ----------------------------------------------------AG 008-TSS 45700020 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AG 004-TSS 45900001 FREEPOOL (GRE) 46200013 * ----------------------------------------------------AG 004-TSS 46500001 SPACE 46800013 NOCLOS MVC PAR1(8,GRF),TEMP RESTORE PAR1 AND PAR2 47400013 L GRE,RDADOF(0,GRD) POINT ZURD AT NEW INPUT DCB 48000013 ST GRC,0(0,GRE) 48600013 SPACE 49200013 L DICR,4(0,DICR) POINT AT PREVIOUS SAVE AREA 49800013 LM 14,CNTL2,12(DICR) 50400013 MVI 12(DICR),X'FF' SHOW RETURN IS COMPLETE 51000013 BCR BR,RR RETURN TO IEMAC 51600013 EJECT 52200013 * 52800013 * CONSTANTS AND WORK AREAS 53400013 * 54000013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AG 005-TSS 54300001 SAVAR DC 18F'0' 54600013 * ----------------------------------------------------AG 005-TSS 54700001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AG 006-TSS 54800001 TEMP DC F'0' 55200013 TEMP1 DC F'0' 55800013 * ----------------------------------------------------AG 006-TSS 56100020 ERRF20 DC X'0F2108' H452 56400020 ERRMES DC C'IEM3873' H452 57000020 INBUF DS 100C 57600013 * 58200013 * REGISTER EQUATES 58800013 * 59400013 GR0 EQU 0 60000013 GRA EQU 1 60600013 GRB EQU 2 61200013 GRC EQU 3 61800013 GRD EQU 4 62400013 GRE EQU 5 63000013 GRF EQU 6 63600013 GRG EQU 7 64200013 GR8 EQU 8 40098 64500046 CNTL2 EQU 10 64800013 BASE EQU 9 65400013 CNTL EQU 11 66000013 DICR EQU 13 66600013 RR EQU 14 67200013 LR EQU 15 67800013 * 68400013 * EQUATES IN TRANSFER VECTOR 69000013 * 69600013 ZURDOF EQU X'0C' 70200013 ZUBW EQU X'78' 70800013 PAROF EQU X'1C' 71400013 * 72000013 * INITIALISATION LIST EQUATES 72600013 * 73200013 RDOF EQU 16 73800013 DADOF EQU 44 74400013 RDADOF EQU 60 75000013 UT3OF EQU 72 75600013 * 76200013 * OFFSET OF ADDRESS OF DCB IN IEMAC 76800013 * 77400013 BWOFF EQU X'18' 78000013 * 78600013 * BRANCH EQUATES 79200013 * 79800013 BR EQU 15 80400013 B EQU 15 81000013 BO EQU 1 81600013 BZ EQU 8 82200013 * 82800013 * COMMUNICATIONS REGION EQUATES 83400013 * 84000013 PAR1 EQU 128 84600013 PAR2 EQU PAR1+4 85200013 CCCODE EQU 232 85800013 EJECT 86400013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AG 007-TSS 86700001 DCBD DSORG=(BS),DEVD=DA 87000013 * ----------------------------------------------------AG 007-TSS 87300001 END IEMAG 87600013 ./ ADD SSI=03011340,NAME=IEMAH,SOURCE=0 AH TITLE 'IEMAH,DICTIONARY PRINT OUT' 00100015 IEMAH CSECT 00200001 SPACE 2 00400015 * FUNCTION 00500015 * PHASE AH PRINTS OUT THE WHOLE OF THE DICTIONARY, EXCEPT 00600015 * THE FIRST X'300' BYTES,ENTRY BY ENTRY. 00700015 SPACE 2 00800015 * THIS PHASE IS ENTERED FROM AD IF AN 'I' IS SPECIFIED IN 00900015 * THE DUMP OPTIONS FIELD. 01000015 SPACE 3 01100015 * ENTRY POINTS 01200015 * THIS MODULE CAN ONLY BE ENTERED FROM AD AT THE FIRST 01300015 * INSTRUCTION OF THE PROGRAM. 01400015 SPACE 3 01500015 * INPUT 01600015 * DICTIONARY BLOCKS TO BE DUMPED. 01700015 SPACE 3 01800015 * OUTPUT 01900015 * THE DICTIONARY BLOCKS, EXCLUDING THE COMMUNICATIONS 02000015 * REGION, PRINTED OUT IN THE FOLLOWING FORMAT- 02100015 * DIC.REF. CODE LENGTH DATA 02200015 * LENGTH OF BCD BCD 02300015 SPACE 3 02400015 * EXTERNAL ROUTINES 02500015 * ZUPL TO PRINT OUT A LINE 02600015 * ZDRFAB TRANSLATES DIC.REF. TO ABS. ADDR. 02700015 * ZDABRF TRANSLATES ABS. ADDR. TO DIC.REF. 02800015 SPACE 3 02900015 * EXITS 03000015 * RETURNS CONTROL TO AD. 03100015 SPACE 3 03200015 EJECT 03260001 * USE OF REGISTERS H224 03320001 * R1 - 03400015 * R2 - DIC. REF. BEING ANALYSED 03500015 * R3 - ABSOLUTE ADDRESS OF DIC. REF. 03600015 * R4 - LENGTH OF DIC. ENTRY 03700015 * R5 - POINTER TO PRINT POS. 03800015 * R6 - CHS. EMPTY IN LINOUT 03900015 * R7 - WORK REG. 04000015 * R8 - WORK REG. 04100015 * R9 04200015 * RA - BASE 04300015 * RB - POINTER TO TRANSFER VECTOR 04400015 * RC 04500015 * RD - POINTER TO 1ST. DICTIONARY BLOCK 04600015 * RE - RETURN ADDRESS 04700015 * RF - BRANCH ADDRESS 04800015 EJECT 04900015 * BRANCH MNEMONICS 05000015 BO EQU 1 05100015 BP EQU 2 05200015 BH EQU 2 05300015 BL EQU 4 05400015 BNAZ EQU 5 05500015 BNE EQU 7 05600015 BAZ EQU 8 05700015 BE EQU 8 05800015 BNL EQU 11 05900015 BNP EQU 13 06000015 B EQU 15 06100015 SPACE 2 06200015 * TRANSFER VECTOR OFFSETS 06300015 ZUPL EQU X'08' 06400015 ZDRFAB EQU X'34' 06500015 ZDABRF EQU X'60' 06600015 SPACE 2 06700015 * COMMUNICATIONS REGION OFFSETS 06800015 ZTRAN2 EQU X'48' H224 06850001 ZMYNAM EQU X'70' 06900015 FONOF EQU X'D0' 07000015 PAR1 EQU X'80' 07100015 PAR2 EQU X'84' 07200015 FSTDRF EQU X'D6' 07300015 SPACE 2 H224 07309001 * MNEMONICS USED IN ROUTINE TO TRANSLATE BCD H224 07318001 TABINEX EQU 8 R8 - ADDRESS OF TRANSLATE TABLE H224 07327001 * INTERNAL TO EXTERNAL H224 07336001 SPACE 2 H224 07345001 * MNEMONICS USED IN ROUTINE TO EXPAND CODES USED IN DIC. H224 07354001 BYTES8 EQU 3 FACTOR USED TO FIND OFFSET H224 07363001 * IN CODE LIST H224 07372001 ACODPRI EQU 8 R8 - ADDRESS OF ROUTINE H224 07381001 * TO PRINT A LINE OF CODE H224 07390001 EJECT 07400015 USING *,10 07500015 STM 14,12,12(13) STORE REGS IN AD SAVE AREA 07600015 LR 10,15 LOAD BASE REG 07700015 LA 7,AHSA POINT AT AH SAVE AREA 07800015 ST 13,4(0,7) CHAIN SAVE AREA FORWARD 07900015 ST 7,8(0,13) CHAIN SAVE AREA BACKWARDS 08000015 L 8,28(0,11) POINT AT INITIAL LIST 08100015 L 7,44(0,8) PICK UP ADDR OF SLOT 08200015 L 13,0(0,7) CONTAINING ADDR OF DICT. 08300015 MVC AHSADI(72),0(13) 08400015 EJECT 08500015 * START OF MAIN PROGRAM 08600015 * PRINT HEADINGS 08700015 * 08800015 MVC LINE(2),ZEROES SKIP TO TOP OF PAGE 08900015 MVI LINE+2,X'F1' 09000015 BAL 14,PUTRT1 09100015 MVC LINOUT(43),HEADNG 09200015 MVC LINOUT+40(2),ZMYNAM(13) 09300015 MVI LINE+2,X'F0' 09400015 BAL 14,PUTROT+4 09500015 BAL 14,PUTROT SPACE 09600015 SPACE 1 09700015 * PRINT OUT THE COMMUNICATIONS REGION 09800015 SPACE 1 09900015 MVC LINOUT(21),COMREG 10000015 BAL 14,PUTROT+4 10100015 BAL 14,PUTROT SPACE 10200015 LR 3,13 BEGINNING OF DICTIONARY 10300015 LA 6,768 X'300' 10400015 BAL 14,COMROT 10500015 SPACE 3 10600015 * GET FIRST DICTIONARY ENTRY 10700015 SPACE 1 10800015 LH 2,FSTDRF(13) LOAD 1ST. DIC.REF. 10900015 N 2,MASK5 ZEROISE TOP HALF OF WORD 11000015 ST 2,PAR1(13) 1ST. DIC.REF IN PAR1 11100015 L 15,ZDRFAB(11) DIC.REF. TO ABS. ADDR. 11200015 BALR 14,15 11300015 L 3,PAR1(13) ABS. ADDR. OF 1ST. ENTRY 11400015 ST 3,PRESBK 11500015 SH 3,NUM300 11600015 BC B,ENDBLO PRINT OFFSET TABLE 11700015 EJECT 11800015 * PRINT OUT THE NEXT DICTIONARY ENTRY 11900015 SPACE 1 12000015 MLOOP CLI 0(3),X'ED' IS IT END OF THE DICTIONARY 12100015 BC BE,ENDROT YES 12200015 CLI 0(3),X'CF' 12300015 BC BE,ENDBLK END OF DICTIONARY BLOCK 12400015 FINFUL STH 3,LENGTH 12500015 TM LENGTH+1,X'03' TEST FOR FULL WORD BOUNDARY 12600015 BC BAZ,FINEND 12700015 LA 3,1(3) 12800015 BC B,FINFUL 12900015 FINEND MVI SWBCD,X'00' SET BCD SWITCH OFF 13000015 ST 2,PAR1(13) DIC REF. OF BLOCK 13100015 ST 3,PAR2(13) ABS. ADDR. OF NEXT ENTRY 13200015 L 15,ZDABRF(11) ABS. ADDR. TO DIC.REF. 13300015 BALR 14,15 13400015 L 2,PAR1(13) DIC.REF. OF NEXT ENTRY 13500015 BAL 14,DREFTR TRANSLATE DIC. REF. 13600015 CLI 0(3),X'CF' IS IT AN ILLEGAL CODE ABOVE CF 13700015 BC BH,GASH - YES 13800015 CLI 0(3),X'81' 13900015 BC BE,ROT81 14000015 CLI 0(3),X'50' DOES DIC. ENTRY HAVE BCD 14100015 BC BNL,*+8 - NO 14200015 MVI SWBCD,X'0A' SET SWITCH ON FOR BCD 14300015 MVC LENGTH(2),1(3) 14400015 NI LENGTH,X'7F' CLEAR OUT TOP BIT IN CASE USED 14450001 LH 4,LENGTH PUT LENGTH OF ENTRY IN R4 14500015 SETR5 LA 5,LINOUT+6 R5 POINTS TO NEXT PRINT POS. 14600015 CLI 0(3),X'88' IS IT AN 88 CODE 14700015 BC BE,ROTE - YES 14800015 SETR6 LA 6,114 R6 CONTROLS NO. CHS PER LINE 14900015 BAL 14,TRANT TRANSLATE CODE BYTE 15000015 LH 7,WORK+2 CALCULATE OFFSET IN CODTAB H224 15100001 SLA 7,1 H224 15200001 LA 8,CODTAB H224 15300001 AR 8,7 ADD OFFSET TO CODTAB H224 15400001 CLI 0(8),X'EE' 15500015 BC BE,GASH 15600015 MVC 0(2,8),LINOUT+6 PUT TRANSLATED CODE IN CODTAB 15700015 LA 5,2(5) 15800015 SH 6,NUM2 H224 15900001 BAL 14,ATRAN 16000015 BAL 14,TRANT TRANSLATE 2 LENGTH BYTES 16100015 BAL 14,ATRAN 16200015 BAL 14,TRANT 16300015 LA 5,2(5) 16400015 SH 6,NUM2 H224 16500001 BAL 14,ATRAN 16600015 BTRAN BAL 14,TRANT TRANSLATION ROUTINE 16700015 BAL 14,ATRAN 16800015 BC B,BTRAN RETURN FOR NEXT CHS. 16900015 * 17000015 * 17100015 GASH BAL 14,PUTROT PRINT ILLEGAL CODE 17200015 MVC LINOUT(47),ERRDIC ERROR IN DIC.ENTRY 17300015 BC B,ENDROT+6 END PRINT OUT 17400015 * 17500015 ROTE CLI 3(3),X'FF' 17600015 BC BE,SETR6 17700015 TM 8(3),X'C0' 17800015 BC BO,SETR6 17900015 LR 7,4 CALCULATE LENGTH OF BCD PART 18000015 SH 7,NUME H224 18100001 ST 7,LEN88 SAVE LENGTH OF BCD 18200015 LA 4,14 18300015 BC B,SETR6 18400015 * 18500015 * 18600015 ROT81 LA 4,56 SET LENGTH OF ENTRY TO 56 18700015 BC B,SETR5 18800015 * 18900015 * 19000015 ATRAN LA 3,1(3) INCREMENT ABSOLUTE ADDRESS 19100015 SH 4,NUM1 DECREMENT LENGTH OF ENTRY H224 19200001 BC BNP,ENTFIN END OF ENTRY 19300015 SH 6,NUM2 DECREMENT ROOM LEFT IN LINE H224 19400001 BC BNP,LINFIN END OF LINE 19500015 BCR B,14 19600015 * 19700015 * 19800015 LINFIN BAL 14,PUTROT PRINT A LINE 19900015 LA 6,104 RESET R6 20000015 LA 5,LINOUT+16 RESET R5 20100015 BC B,BTRAN 20200015 * 20300015 * 20400015 ENTFIN BAL 14,PUTROT PRINT A LINE 20500015 TM SWBCD,X'FF' 20600015 BC BNAZ,BCDROT GO TO BCD ROUTINE 20700015 CLC LEN88,ZEROES WAS IT AN 88 CODE 20800015 BC BH,BCDC8 - YES 20900015 BC B,MLOOP RETURN FOR NEXT ENTRY 21000015 SPACE 1 21100015 * TRANSLATE DIC. REF. 21200015 SPACE 1 21300015 DREFTR ST 14,DRESAV 21400015 MVI SWBYT,X'FF' TRANSLATE DIC. REF. 21500015 LA 5,LINOUT 21600015 LR 7,2 21700015 SRL 7,12 21800015 BAL 14,TRACOM 21900015 LR 7,2 22000015 SRL 7,8 22100015 N 7,MASK1 22200015 BAL 14,TRACOM 22300015 LR 7,2 22400015 SRL 7,4 22500015 N 7,MASK1 22600015 BAL 14,TRACOM 22700015 LR 7,2 22800015 N 7,MASK1 22900015 BAL 14,TRACOM 23000015 L 14,DRESAV 23100015 BCR B,14 23200015 EJECT 23300015 * PRINT OUT THE COMMUNICATIONS REGION OR OFFSET TABLE 23400015 SPACE 1 23500015 COMROT ST 14,COMSAV SAVE RETURN ADDRESS 23600015 LA 2,0 OFFSET 23700015 COM1 LA 5,LINOUT START OF PRINT LINE 23800015 BAL 14,DREFTR TRANSLATE OFFSET 23900015 LA 5,7(5) GAP AFTER DIC.REF. 24000015 COM2 LA 4,4 4 BYTES PER BLOCK 24100015 COM3 BAL 14,TRANT TRANSLATE A BYTE 24200015 LA 2,1(2) INCREMENT OFFSET 24300015 LA 3,1(3) INCREMENT ABS. ADDR. 24400015 CR 2,6 END OF AREA 24500015 BC BNL,COM4 YES 24600015 BCT 4,COM3 4 BYTES TRANSLATED 24700015 STH 2,WORK+2 24800015 TM WORK+3,X'1F' YES - END OF LINE 24900015 BC BAZ,COM4 YES 25000015 TM WORK+3,X'0F' NO - MIDDLE OF LINE 25100015 BC BAZ,COM5 YES 25200015 LA 5,3(5) NO - GAP EVERY 4 BYTES 25300015 BC B,COM2 25400015 SPACE 1 25500015 COM5 LA 5,18(5) LARGE GAP IN MIDDLE OF LINE 25600015 BC B,COM2 25700015 SPACE 1 25800015 COM4 BAL 14,PUTROT PRINT A LINE 25900015 CR 2,6 END OF AREA 26000015 BC BL,COM1 NO 26100015 BAL 14,PUTROT YES - 2 SPACES 26200015 BAL 14,PUTROT 26300015 L 14,COMSAV 26400015 BCR B,14 26500015 EJECT 26600015 * TRANSLATE ROUTINE 26700015 * 26800015 TRANT SR 7,7 H224 26900001 MVI SWBYT,X'00' SET OFF BYTE SWITCH H224 27000001 IC 7,0(3) LOAD BYTE INTO R7 H224 27100001 ST 7,WORK H224 27200001 TRANT1 SRL 7,4 SHIFT ZONE TO NUMERIC POST. H224 27300001 TRACOM CH 7,TEN IS IT A-F H224 27400001 BC BNL,ALPHA BRANCH TO A - F ROUTINE 27500015 O 7,MASK4 MOVE X'F' TO ZONE POSITION 27600015 TRAMOV STH 7,WORK 27700015 MVC 0(1,5),WORK+1 SET UP CH. IN LINOUT 27800015 LA 5,1(5) 27900015 TM SWBYT,X'FF' HAS ALL OF BYTE BEEN TRANSLATED 28000015 BCR BNAZ,14 28100015 MVI SWBYT,X'FF' SET ON BYTE SWITCH 28200015 MVC WORK+3(1),0(3) MOVE BYTE INTO 28300015 L 7,WORK R7 28400015 N 7,MASK1 ELLIMINATE ALL BUT NUMERIC POS. 28500015 BC B,TRACOM 28600015 ALPHA SH 7,NUM9 TRANSLATE TO H224 28700001 O 7,MASK2 A-F 28800015 BC B,TRAMOV 28900015 EJECT 29000015 * ROUTINE TO TRANSLATE BCD 29100015 * 29200015 BCDROT LA 4,1 29300015 LA 6,104 29400015 LA 5,LINOUT+12 29500015 BAL 14,TRANT TO TRANSLATE LENGTH OF BCD 29600015 LA 5,2(5) 29700015 MVI LENGTH,X'00' H224 29800001 MVC LENGTH+1(1),0(3) 29900015 LH 4,LENGTH MOVE LENGTH TO R4 30000015 LA 4,1(4) ADJUST TO ACTUAL LENGTH 30100015 BCDINC LA 3,1(3) 30200015 MVC WORK,ZEROES 30300015 MVC WORK+3(1),0(3) H224 30600001 L TABINEX,ZTRAN2(13) R8-ADDR. OF TRANSLATE TABLE H224 30900001 TR WORK+3(1),0(TABINEX) INTERNAL TO EXTERNAL H224 31200001 MVC 0(1,5),WORK+3 MOVE BCD INTO LINOUT H224 31500001 LA 5,1(5) INCREMENT POINTER TO LINOUT H224 31800001 SH 4,NUM1 H224 32100001 BC BP,BCD6 IS IT END OF BCD - NO H224 32400001 LA 3,1(3) H224 32700001 BAL 14,PUTROT PRINT A LINE H224 33000001 BC B,MLOOP GET NEXT DIC. ENTRY H224 33300001 BCD6 BCT 6,BCDINC IS IT END OF LINE H224 33600001 BAL 14,PUTROT YES - PRINT LINE H224 33900001 LA 6,104 RESET R6 35100015 LA 5,LINOUT+16 RESET R5 35200015 BC B,BCDINC 35300015 * 35400015 BCDC8 L 4,LEN88 LOAD LENGTH OF BCD INTO R4 H224 35500001 MVC LEN88(4),ZEROES 35600015 LA 5,LINOUT+16 35700015 LA 6,104 35800015 BC B,BCDINC+4 35900015 EJECT 36000015 * END OF DICTIONARY BLOCK ROUTINE 36100015 * 36200015 ENDBLK BAL 14,PUTROT SPACE 1 36300015 MVC LENGTH(2),1(3) 36400015 LH 2,LENGTH 36500015 N 2,MASK5 ZEROISE TOP HALF OF WORD 36600015 ST 2,PAR1(13) DIC REF. OF NEW BLOCK 36700015 L 15,ZDRFAB(11) DIC.REF. TO ABS. ADDR. 36800015 BALR 14,15 36900015 L 3,PAR1(13) ABS.ADDR. OF NEW BLOCK 37000015 ST 3,PRESBK 37100015 ENDBLO ST 2,PRESRF 37200015 TM 116(13),X'FF' IS BIG DIC OPTION ON 37260015 BC BAZ,ENBLO1 NO 37320015 MVC LINOUT(13),OFFTAB 37400015 BAL 14,PUTROT+4 37500015 BAL 14,PUTROT 37600015 A 3,FONOF(13) START OF OFFSET TABLE 37700015 LH 6,0(3) 37800015 LA 6,1(6) 37850015 SLL 6,1 LENGTH OF OFFSET TABLE 37900015 BAL 14,COMROT PRINT OFFSET TABLE 38000015 ENBLO1 EQU * 38100015 L 3,PRESBK 38200015 L 2,PRESRF 38300015 MVC LINOUT(25),DICREF SET UP HEADING 38400015 BAL 14,PUTROT+4 38500015 BAL 14,PUTROT 38600015 BC B,MLOOP 38700015 * 38800015 * END OF DICTIONARY ROUTINE 38900015 * 39000015 ENDROT MVC LINOUT(17),ENDDIC SET UP END MESSAGE 39100015 BAL 14,PUTROT PRINT A LINE 39200015 BC B,CODEXP 39300015 ENDING MVC 0(72,13),AHSADI 39400015 LA 13,AHSA POINT AT AH SAVE AREA 39500015 L 13,4(0,13) RETRIEVE ADDR AD SAVE AREA 39600015 LM 14,12,12(13) RELOAD REGS. 39700015 LA 15,4 SET FLAG FOR AH OK. 39800015 BCR B,14 RETURN TO AD 39900015 EJECT 40000015 * ROUTINE TO EXPAND CODES USED IN DICTIONARY 40100015 * 40200015 CODEXP BAL 14,PUTROT SPACE 1 40300015 MVC LINOUT(31),DICEXP SET UP HEADINGS 40400015 BAL 14,PUTROT PRINT HEADING 40500015 BAL 14,PUTROT SPACE 1 40600015 SR 3,3 40700015 LA ACODPRI,CODPRI R8-ADDRESS OF ROUTINE TO H224 40760001 * PRINT A LINE OF CODE H224 40820001 LA 2,CODTAB 40900015 CODLOP LA 5,LINOUT+6 41000015 CLI 0(2),X'FF' IS IT END OF CODTAB - 41100015 BC BE,ENDING 41200015 CLI 0(2),X'EE' IS IT AN ILLEGAL CODE - 41300015 BC BE,CODNOT YES 41400015 CLI 0(2),X'00' HAS THE CODE BEEN USED - 41500015 BC BNE,CODDEC YES 41600015 CODNOT LA 2,2(2) 41700015 BC B,CODLOP 41800015 * 41900015 CODDEC MVC LINOUT(2),0(2) 42000015 CLI 0(2),X'F0' 42100015 BC BE,CODE0 42200015 CLI 0(2),X'F1' 42300015 BC BE,CODE1 42400015 CLI 0(2),X'F2' 42500015 BC BE,CODE2 42600015 CLI 0(2),X'F3' 42700015 BC BE,CODE3 42800015 CLI 0(2),X'F4' 42900015 BC BE,CODE4 43000015 CLI 0(2),X'F7' 43100015 BC BE,CODE7 43200015 CLI 0(2),X'F8' 43300015 BC BE,CODE8 43400015 CLI 0(2),X'F9' 43500015 BC BE,CODE9 43600015 CLI 0(2),X'C1' 43700015 BC BE,CODE2 43800015 CLI 0(2),X'C2' 43900015 BC BE,CODEB 44000015 CLI 0(2),X'C3' 44100015 BC BE,CODEC 44200015 BC B,CODNOT 44300015 * 44400015 CODE0 CLI 1(2),X'F0' 44500015 BC BL,EXPAN 44600015 CLI 1(2),X'F7' 44700015 BC BE,EXPAN 44800015 CLI 1(2),X'F8' 44900015 BC BE,CODE08 45000015 CLI 1(2),X'F9' 45100015 BC BE,CODE09 45200015 SR 7,7 CODES 00 - 06 H224 45300001 IC 7,1(2) H224 45400001 N 7,MASK1 MOVE X'0' INTO ZONE POS. H224 45500001 SLA 7,BYTES8 MULTIPLY BY 8 TO GET OFFSET H224 45600001 BC B,CODE00(7) IN CODE LIST FROM CODE00 H224 45700001 CODE00 MVC 0(24,5),MES00 H224 45800001 BCR B,ACODPRI H224 45900001 CODE01 MVC 0(24,5),MES01 46700015 BCR B,ACODPRI H224 46800001 CODE02 MVC 0(19,5),MES02 46900015 BCR B,ACODPRI H224 47000001 CODE03 MVC 0(20,5),MES03 47100015 BCR B,ACODPRI H224 47200001 CODE04 MVC 0(17,5),MES04 47300015 BCR B,ACODPRI H224 47400001 CODE05 MVC 0(54,5),MES05 47500015 BCR B,ACODPRI H224 47600001 CODE06 MVC 0(22,5),MES06 47700015 BCR B,ACODPRI H224 47800001 CODE08 MVC 0(13,5),MES08 47900015 BCR B,ACODPRI H224 48000001 CODE09 MVC 0(13,5),MES09 48100015 BCR B,ACODPRI H224 48200001 * 48300015 CODE1 MVC 0(11,5),MESDIM 48400015 LA 5,12(5) 48500015 BC B,EXPAN 48600015 * 48700015 CODE2 MVC 0(10,5),MESSTR 48800015 LA 5,11(5) 48900015 BC B,EXPAN 49000015 CODE3 CLI 1(2),X'C5' 49100015 BC BE,CODE3E 49200015 CODE37 MVC 0(26,5),MESDIM 49300015 LA 5,27(5) 49400015 BC B,EXPAN 49500015 CODE3E MVC 0(11,5),MESDIM 49600015 LA 5,12(5) 49700015 BC B,CODE2 49800015 * 49900015 CODE4 CLI 1(2),X'F0' 50000015 BC BE,CODE40 50100015 MVC 0(18,5),MES4D 50200015 BCR B,ACODPRI H224 50300001 CODE40 MVC 0(16,5),MESFOR 50400015 LA 5,17(5) 50500015 MVC 0(6,5),MES40 50600015 BCR B,ACODPRI H224 50700001 * 50800015 CODE7 MVC 0(14,5),MES70 50900015 BCR B,ACODPRI H224 51000001 * 51100015 CODE8 CLI 1(2),X'F8' 51200015 BC BE,CODE88 51300015 CLI 1(2),X'F9' 51400015 BC BE,CODE89 51500015 CLI 1(2),X'F7' 51600015 BC BE,EXPAN 51700015 CLI 1(2),X'F0' 51800015 BC BL,EXPAN 51900015 CLI 1(2),X'F6' 52000015 BC BE,CODE86 52100015 CLI 1(2),X'F5' 52200015 BC BE,CODE85 52300015 CLI 1(2),X'F4' 52400015 BC BE,CODE84 52500015 CLI 1(2),X'F3' 52600015 BC BE,CODE83 52700015 CLI 1(2),X'F2' 52800015 BC BE,CODE82 52900015 CLI 1(2),X'F1' 53000015 BC BE,CODE81 53100015 BC B,CODE80 53200015 CODE88 MVC 0(8,5),MES88 53300015 BCR B,ACODPRI H224 53400001 CODE89 MVC 0(5,5),MES89 53500015 LA 5,5(5) 53600015 MVC 0(20,5),MESFOR 53700015 LA 5,20(5) 53800015 MVC 0(14,5),MES89 53900015 BCR B,ACODPRI H224 54000001 CODE86 MVC 0(12,5),MES86 54100015 BCR B,ACODPRI H224 54200001 CODE85 MVC 0(12,5),MES85 54300015 BCR B,ACODPRI H224 54400001 CODE84 MVC 0(12,5),MES84 54500015 BCR B,ACODPRI H224 54600001 CODE83 MVC 0(12,5),MES83 54700015 BCR B,ACODPRI H224 54800001 CODE82 MVC 0(5,5),MES83 54900015 LA 5,6(5) 55000015 MVC 0(22,5),MES80A 55100015 BCR B,ACODPRI H224 55200001 CODE81 MVC 0(5,5),MES81 55300015 LA 5,6(5) 55400015 MVC 0(22,5),MES80A 55500015 BCR B,ACODPRI H224 55600001 CODE80 MVC 0(32,5),MES80 55700015 BCR B,ACODPRI H224 55800001 CODE9 CLI 1(2),X'F0' 55900015 BC BE,CODE90 56000015 CLI 1(2),X'F8' 56100015 BC BE,CODE98 56200015 BC B,CODE1 56300015 CODE90 MVC 0(16,5),MES90 56400015 BCR B,ACODPRI H224 56500001 CODE98 MVC 0(14,5),MES98 56600015 BCR B,ACODPRI H224 56700001 * 56800015 CODEB CLI 1(2),X'C5' 56900015 BC BE,CODE3E 57000015 BC B,CODE37 57100015 * 57200015 CODEC CLI 1(2),X'C5' H224 57300001 BC BE,CODECE H224 57400001 CLI 1(2),X'C4' H224 57500001 BC BE,CODECD H224 57600001 CLI 1(2),X'C3' H224 57700001 BC BE,CODECC H224 57800001 CLI 1(2),X'C2' H224 57900001 BC BE,CODECB H224 58000001 CLI 1(2),X'C1' H224 58100001 BC BE,CODEC9 H224 58200001 SR 7,7 CODES C0 - C9 H224 58300001 IC 7,1(2) H224 58400001 N 7,MASK1 MOVE X'0' INTO ZONE POS. H224 58500001 SLA 7,BYTES8 MULTIPLY BY 8 TO GET OFFSET H224 58600001 BC B,CODEC0(7) IN CODE LIST FROM CODEC0 H224 58700001 CODEC0 MVC 0(17,5),MESC0 60200015 BCR B,ACODPRI H224 60300001 CODEC1 MVC 0(10,5),MESC1 60400015 BCR B,ACODPRI H224 60500001 CODEC2 MVC 0(25,5),MESC2 60600015 BCR B,ACODPRI H224 60700001 CODEC3 MVC 0(14,5),MESC3 60800015 BCR B,ACODPRI H224 60900001 CODEC4 MVC 0(19,5),MESC4 61000015 BCR B,ACODPRI H224 61100001 CODEC5 MVC 0(14,5),MESC5 61200015 BCR B,ACODPRI H224 61300001 CODEC6 MVC 0(21,5),MESC6 61400015 BCR B,ACODPRI H224 61500001 CODEC7 MVC 0(25,5),MESC7 61600015 BCR B,ACODPRI H224 61700001 CODEC8 MVC 0(49,5),MESC8 61800015 BCR B,ACODPRI H224 61900001 CODEC9 MVC 0(21,5),MESC9 62000015 BCR B,ACODPRI H224 62100001 CODECB MVC 0(37,5),MESCB 62200015 BCR B,ACODPRI H224 62300001 CODECC MVC 0(47,5),MESCC 62400015 BCR B,ACODPRI H224 62500001 CODECD MVC 0(12,5),MES4D 62600015 BCR B,ACODPRI H224 62700001 CODECE MVC 0(15,5),MESCE 62800015 BCR B,ACODPRI H224 62900001 * 63000015 EXPAN CLI 1(2),X'C6' 63100015 BC BE,ENDF 63200015 CLI 1(2),X'C5' 63300015 BC BE,ENDE 63400015 CLI 1(2),X'C4' 63500015 BC BE,ENDD 63600015 CLI 1(2),X'C3' 63700015 BC BE,ENDC 63800015 CLI 1(2),X'F7' 63900015 BC BE,END7 64000015 * 64100015 ENDF MVC 0(13,5),MESDAT 64200015 LA 5,14(5) 64300015 BC B,TESTFO 64400015 * 64500015 ENDE SH 5,NUM2 H224 64600001 MVC 0(5,5),MESITE 64700015 LA 5,6(5) 64800015 BC B,TESTFO 64900015 * 65000015 ENDD MVC 0(14,5),MESEVE 65100015 TM 0(2),X'08' 65200015 BCR BAZ,ACODPRI H224 65300001 LA 5,15(5) 65400015 SHORTF MVC 0(16,5),MESFOR 65500015 BCR B,ACODPRI H224 65600001 * 65700015 ENDC MVC 0(15,5),MESTAS 65800015 TM 0(2),X'08' 65900015 BCR BAZ,ACODPRI H224 66000001 LA 5,16(5) 66100015 BC B,SHORTF 66200015 * 66300015 END7 MVC 0(14,5),MESLAB 66400015 LA 5,15(5) 66500015 * 66600015 TESTFO TM 0(2),X'08' 66700015 BCR BAZ,ACODPRI H224 66800001 MVC 0(29,5),MESFOR 66900015 BCR B,ACODPRI H224 67000001 * 67100015 CODPRI BAL 14,PUTROT PRINT LINE 67200015 BC B,CODNOT 67300015 EJECT 67400015 * ROUTINE TO PRINT A LINE USING ZUPL 67500015 * 67600015 PUTROT MVI LINE+2,X'40' 67700015 MVC LINE(2),LINCNT 67800015 PUTRT1 LA 7,LINE PUT ADDR OF LINE IN PAR1 67900015 ST 7,PAR1(13) ADDR. OF LINE 68000015 ST 14,KEEP SAVE RETURN ADDRESS 68100015 L 15,ZUPL(11) 68200015 BALR 14,15 68300015 L 14,KEEP RELOAD RETURN ADDRESS 68400015 MVI LINOUT,X'40' CLEAR OUTPUT AREA H224 68500001 MVC LINOUT+1(119),LINOUT 68600015 BCR B,14 68700015 * 68800015 * END OF PROGRAM 68900015 EJECT 69000015 * CONSTANTS, AREAS AND TABLES 69100015 * 69200015 CNOP 0,4 69300015 AHSA DS 18F 69400015 AHSADI DS 18F 69500015 DRESAV DS 1F 69600015 COMSAV DS 1F 69700015 PRESBK DS 1F 69800015 PRESRF DS 1F 69900015 LINE DC CL123' ' 70000015 LENGTH DS 1H 70100015 LINCNT DC XL2'78' H224 70200001 LEN88 DC F'0' H224 70300001 HEADNG DC C'PRINT OUT OF THE' 70400015 DC C' DICTIONARY' 70500015 DC C' AFTER PHASE .' 70600015 COMREG DC C'COMMUNICATIONS' 70700015 DC C' REGION' 70800015 OFFTAB DC C'OFFSETS ' 70900015 DC C'TABLE' 71000015 DICREF DC C'D.R. CD. LGTH ' 71100015 DC C' CONTENTS' 71200015 ENDDIC DC C'END OF DICTIONA' 71300015 DC C'RY' 71400015 ERRDIC DC C'ERROR IN DIC.' 71500015 DC C' ENTRY , CANNOT' 71600015 DC C' CONTINUE PRINT' 71700015 DC C' OUT' 71800015 SWBCD DC C' ' 71900015 SWBYT DC C' ' 72000015 WORK DS 1F 72100015 NUM1 DC H'1' H224 72400001 NUM2 DC H'2' H224 72700001 NUM9 DC H'9' H224 73000001 NUME DC H'14' H224 73300001 NUM300 DC H'768' H224 73600001 TEN DC H'10' H224 73900001 MASK1 DC F'15' 74300015 MASK2 DC X'000000C0' 74400015 MASK3 DC X'000000B0' 74500015 MASK4 DC X'000000F0' 74600015 MASK5 DC X'0000FFFF' 74700015 KEEP DS 1F 75100015 ZEROES DC F'0' 75200015 MESDIM DC C'DIMENSIONED ' 75300015 MESAND DC C'AND ' 75400015 MESSTR DC C'STRUCTURED' 75500015 MESLAB DC C'LABEL VARIABLE' 75600015 MESITE DC C' ITEM' 75700015 MESDAT DC C'DATA VARIABLE' 75800015 MESTAS DC C'TASK IDENTIFIER' 75900015 MESEVE DC C'EVENT VARIABLE' 76000015 MESFOR DC C'FORMAL PARAMETER' 76100015 DC C' OR TEMPORARY' 76200015 MES00 DC C'STATEMENT LABEL ' 76300015 DC C'CONSTANT' 76400015 MES01 DC C'PROCEDURE OR ' 76500015 DC C'ENTRY LABEL' 76600015 MES02 DC C'GENERIC ENTRY ' 76700015 DC C'LABEL' 76800015 MES03 DC C'EXTERNAL ENTRY ' 76900015 DC C'LABEL' 77000015 MES04 DC C'BUILT-IN ' 77100015 DC C'FUNCTION' 77200015 MES05 DC C'TEMPORY VARIABLE' 77300015 DC C' AND CONTROLLED ' 77400015 DC C'ALLOCATION ' 77500015 DC C'WORKSPACE' 77600015 MES06 DC C'BUILT-IN GENERIC' 77700015 DC C' LABEL' 77800015 MES08 DC C'FILE CONSTANT' 77900015 MES09 DC C'FILE VARIABLE' 78000015 MES40 DC C'TYPE 1' 78100015 MES4D DC C'ON CONDITION ' 78200015 DC C'ENTRY' 78300015 MES80 DC C'PROCEDURE ' 78400015 MES80A DC C'STATEMENT ENTRY ' 78500015 DC C'TYPE 1' 78600015 MES81 DC C'BEGIN' 78700015 MES83 DC C'ENTRY TYPE 5' 78800015 MES84 DC C'ENTRY TYPE 3' 78900015 MES85 DC C'ENTRY TYPE 2' 79000015 MES86 DC C'ENTRY TYPE 6' 79100015 MES88 DC C'CONSTANT' 79200015 MES89 DC C'FILE TEMPORARY' 79300015 MES90 DC C'INVOCATION COUNT' 79400015 MES98 DC C'FILE ATTRIBUTE' 79500015 MESC0 DC C'SDV FOR ' 79600015 DC C'TEMPORARY' 79700015 MESC1 DC C'DED2 ENTRY' 79800015 MESC2 DC C'INTERNAL LIBRARY' 79900015 DC C' FUNCTION' 80000015 MESC3 DC C'COMPILER LABEL' 80100015 MESC4 DC C'PREFIX ON LIST ' 80200015 DC C'ITEM' 80300015 MESC5 DC C'PARAMETER LIST' 80400015 MESC6 DC C'DOPE VECTOR ' 80500015 DC C'SKELETONS' 80600015 MESC7 DC C'SYMBOL TABLE ' 80700015 DC C'OR DED ' 80800015 DC C'ENTRY' 80900015 MESC8 DC C'ERROR MESSAGE, ' 81000015 DC C'TABLE ENTRY, ' 81100015 MESC9 DC C'WORKSPACE ' 81200015 DC C'REQUIREMENT' 81300015 MESCB DC C'SELECT A MEMBER ' 81400015 DC C'FROM A GENERIC ' 81500015 DC C'FAMILY' 81600015 MESCC DC C'AUTOMATIC CHAIN ' 81700015 DC C'DELIMETER OR SAV' 81800015 DC C'E/RESTORE ' 81900015 DC C'ENTRY' 82000015 MESCE DC C'LABEL BCD ENTRY' 82100015 MES70 DC C'PREFIX OPTIONS' 82200015 DICEXP DC C'EXPLANATION OF ' 82300015 DC C'DICTIONARY CODES' 82400015 CODTAB DC X'00000000000000000000000000000000' 82500015 DC X'00000000EEEEEEEE00000000EEEE0000' 82600015 DC X'EEEEEEEEEEEEEEEEEEEEEEEEEEEE0000' 82700015 DC X'EEEEEEEEEEEEEEEE00000000EEEE0000' 82800015 DC X'EEEEEEEEEEEEEEEEEEEEEEEEEEEE0000' 82900015 DC X'EEEEEEEEEEEEEEEE0000000000000000' 83000015 DC X'EEEEEEEEEEEEEEEEEEEEEEEEEEEE0000' 83100015 DC X'EEEEEEEEEEEEEEEE0000000000000000' 83200015 DC X'0000EEEEEEEEEEEEEEEEEEEEEEEEEEEE' 83300015 DC X'EEEEEEEEEEEEEEEEEEEE0000EEEEEEEE' 83400015 DC X'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE' 83500015 DC X'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE' 83600015 DC X'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE' 83700015 DC X'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE' 83800015 DC X'00EEEEEEEEEEEEEEEEEEEEEEEEEEEEEE' 83900015 DC X'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE' 84000015 DC X'00000000000000000000000000000000' 84100015 DC X'00000000EEEEEEEE00000000EEEE0000' 84200015 DC X'0000EEEEEEEEEEEEEEEEEEEEEEEE0000' 84300015 DC X'0000EEEEEEEEEEEE00000000EEEE0000' 84400015 DC X'EEEEEEEEEEEEEEEEEEEEEEEEEEEE0000' 84500015 DC X'EEEEEEEEEEEEEEEE0000000000000000' 84600015 DC X'EEEEEEEEEEEEEEEEEEEEEEEEEEEE0000' 84700015 DC X'EEEEEEEEEEEEEEEE0000000000000000' 84800015 DC X'00000000000000000000000000000000' 84900015 DC X'0000000000000000000000000000FFFF' 85000015 LINOUT EQU LINE+3 85100015 * 85200015 END IEMAH 85300015 ./ ADD SSI=20013130,NAME=IEMAI,SOURCE=0 * 00030064 * 00033064 * 5.4 A 095000,098000,364000,366000,758000. MAC 54703 00036064 * 5.1 C 591400. JRT H417 00039064 * 00042064 * 00045064 SPACE 5 00048064 GBLB &STD 00051064 &STD SETB 1 00054064 SPACE 00060019 AI TITLE 'IEMAI,TEXT DUMP,COMPILER CONTROL, OS/360 PL1/F' 00100013 IEMAI START 0 00200013 USING *,RBASE 00300013 USING *+X'1000',RCC 00400013 USING *+X'2000',RDIC 00500013 USING *+X'3000',RBASE2 00600013 USING *+X'4000',RF 00700013 SPACE 4 00800013 * GENERAL REGISTERS 00900013 RBASE2 EQU 12 01000013 RBASE EQU 10 PROGRAM BASE 01100013 RCC EQU 11 COMPILER CONTROL BASE 01200013 RDIC EQU 13 DICTIONARY BASE 01300013 RR EQU 14 RETURN 01400013 RBCH EQU 15 BRANCH 01500013 RTX EQU 1 SOURCE TEXT POINTER 01600013 RPC EQU 1 DITTO IN P/C SCAN 01700013 RA EQU 5 UNIT REG 01800013 RB EQU 4 STMT NO. PNTR 01900013 RC EQU 6 GENERAL 02000013 RD EQU 7 STMT NO 02100013 RE EQU 8 MISC 02200013 RF EQU 9 MISC 02300013 RDEP EQU 6 DICT PNTR 02400013 REND EQU 3 END BLK PNTR 02500013 RG EQU 3 DITTO AND OTHER USES 02600013 SPACE 4 02700013 B EQU 15 02800013 BM EQU 4 MINUS/MIXED 02900013 BP EQU 2 03000013 BH EQU 2 03100013 BL EQU 4 03200013 BE EQU 8 03300013 BHE EQU 10 03400013 BLE EQU 12 03500013 BNE EQU 7 03600013 BZ EQU 8 03700013 BO EQU 1 03800013 BNZ EQU 7 03900013 BNO EQU 14 04000013 SPACE 4 04100013 * CODE BYTES 04200013 OPB EQU X'C0' 04300013 MASK EQU X'ED' 04400013 ON EQU X'FF' 04500013 OFF EQU X'00' 04600013 FREE EQU X'01' 04700013 OTHER1 EQU 10 04800013 BLANK EQU X'40' 04900013 EDPNT EQU X'FE' 05000013 SPACE 4 05100013 * CONTROL AND OTHER OFFSETS 05200013 CC EQU IEMAI+X'1000' 05300013 DIC EQU IEMAI+X'2000' 05400013 BLKAD1 EQU *+X'3000' 05500013 BLKAD2 EQU BLKAD1+4 05600013 BLKAD3 EQU BLKAD2+X'400' 05700013 ZDRFAB EQU CC+52 05800013 RLSCTL EQU CC+72 05900013 ZTXTAB EQU CC+84 06000013 ZCHAIN EQU CC+88 06100013 ZALTER EQU CC+92 06200013 ZUPLOF EQU CC+8 06300013 ZUERR EQU CC+48 06400013 ZLOAD EQU CC+X'24' 06500013 ZEND EQU CC+X'6C' 06600013 ZUTXOF EQU 20+CC 06700013 FINBUF EQU IEMAI+X'4004' ACTUAL 120 BYTE PRNT BUFFER 06800013 XFNBUF EQU FINBUF+80 06900013 OUTBUF EQU FINBUF+120 07000013 PAROF EQU CC+X'1C' 07100013 DADOF EQU 44 07200013 SPACE 4 07300013 * OFFSETS IN DICT COMM REGION 07400013 ZTV EQU DIC+X'40' 07500013 PAR1 EQU DIC+128 07600013 PAR2 EQU PAR1+4 07700013 ZMYNAM EQU DIC+112 07800013 ZTRAN2 EQU DIC+72 07900013 ZSTAT EQU DIC+124 08000013 TXST EQU DIC+X'100' 08100013 BLOCKL EQU TXST+8 08200013 ZPAGE EQU DIC+192 LINECOUNT SLOT 08300013 EJECT 08400013 * INITIALIZATION 08500013 STM 14,12,12(RDIC) SAVE ALL REGS IN AD SAVE AREA 08600013 LR RBASE,15 LOAD BASE REG FOR AI 08700013 LA RC,AISA POINT AT AI SAVE AREA 08800013 ST RDIC,4(0,RC) CHAIN FOREARDS 08900013 ST RC,8(0,RDIC) CHAIN BACKWARDS 09000013 L RE,PAROF RESET RDIC TO POINT TO FIRST 09100013 L RC,DADOF(RE) DICT BLOCK 09200013 L RDIC,0(RC) 09300013 MVC AISA+12(60),12(RDIC) SAVE REGS IN DICT 09400013 L RCC,ZTV 09500013 AIF (&STD).ASMA1 09550064 AGO .ASMO1 09600064 .ASMA1 ST RDIC,SAVAR+4 09650064 LA RDIC,SAVAR 09700064 .ASMO1 ANOP 09750064 LOAD EP=IEMAJ 09800001 AIF (&STD).ASMA2 09860064 AGO .ASMO2 09920064 .ASMA2 L RDIC,SAVAR+4 09980064 .ASMO2 ANOP 10040064 LR RBASE2,0 SET BASE REG 10100013 SPACE 2 10200013 * ONE TEXT BLOCK NOT SUFFICIENT IF RUNNING ON 44K 10300013 MVI PAR2+3,X'00' SET STATUA BYTE FOR NO-CHAINING 10350015 L RBCH,ZUTXOF GET TXT BLOCK FOR USE AS 10400013 BALR RR,RBCH OUTBUF PRINT BUFFER 10500013 L RF,PAR2 10600013 ST RF,ADOUT SAVE ABS ADDRESS OF PRNT BUFFER 10700013 L RC,PAR1 10800013 ST RC,TXNAM2 SAVE TXT BLOCK REF 10900013 MVI PRNTSW,ON 11000013 MVI TXSW,OFF SET GROUP OF SWITCHES OFF 11100013 MVC TXSW+1(8),TXSW 11200013 LH RD,STATAB+2 LOAD STMT NO REGS 11300013 LA RB,STATAB+2 11400013 MVI INTBUF,BLANK 11500013 MVC INTBUF+1(15),INTBUF 11600013 L RBCH,TXST 11700013 ST RBCH,PAR1 OBTAIN ABS ADDR OF START 11800013 L RBCH,ZTXTAB OF 1ST TXT BLK 11900013 BALR RR,RBCH 12000013 L RTX,PAR1 SET TXT PNTR 12100013 MVC TXNAME(1),TXST+1 SAVE TXT BLK NAME 12200013 L REND,BLOCKL 12300013 AR REND,RTX 12400013 LA RC,3 BACKSPACE ENDBLK PNTR 3BYTES 12500013 SR REND,RC 12600013 ST REND,ENDBLK END OF BLK PNTR 12700013 MVC HEDING+6(2),ZMYNAM 12800013 LA RC,HEDING-3 12900013 ST RC,PAR1 13000013 L RBCH,ZUPLOF 13100013 BALR RR,RBCH 13200013 LA RC,PRTFST-3 PRINT HEADING 13300013 ST RC,PAR1 13400013 BALR RR,RBCH 13500013 MVI PRTFST-1,OFF 13600013 LA RA,1 UNIT REG 13700013 LH RC,ZPAGE 13800013 LA RE,7 13900013 SR RC,RE 14000013 STH RC,LINENO SET LINENO FOR 1ST PAGE 14100013 MVC LNCNT(2),LINENO 14200013 LA RC,OUTBUF 14300013 ST RC,FINSTK SET PRINT BUFFER PNTR 14400013 MVC ADFAC(2),ZERO 14500013 MVC FINBUF-4(4),CCHAR SET ZUPL CONTROL CHARS 14600013 MVI FINBUF,BLANK 14700013 MVC FINBUF+1(119),FINBUF 14800013 CLC ZMYNAM(2),OGNAM 14900013 BC BE,TERM BRANCH IF NO TRLS PRESENT 15000013 CLC ZMYNAM(2),LRNAME DON'T ATTEMPT PRINT FOR PHASE LR 15030015 BC BE,TERM 15060015 SPACE 4 15100013 * TEXT SCAN RTN FOR TRLS 15200013 SPACE 15300013 SCTRP ST RTX,MVEPT SET START TXT PNTR 15400013 L REND,ENDBLK 15500013 SR REND,RTX 15600013 BC BM,TERM 15700013 ST REND,RBL REM BLK LGTH 15800013 LTR REND,REND IS RBL ZERO 15900013 BC BNZ,SC2 NO CONTINUE PROCESSING 16000013 BAL RR,EOBM YES GET NEXT TEXT BLOCK 16100013 BC B,SCTRP 16200013 SC2 CLI PPSW,ON IS A PARTIAL P/C ITEM BEING 16300013 BC BNE,SCTRP1 PROCESSED 16400013 MVC PCLTH+2(2),1(RTX) IF SO DETERMINE REMAINING P/C 16500013 LH RC,PCLTH+2 16600013 SH RC,FIVE 16700013 STH RC,PCLTH+2 16800013 LA RPC,5(RPC) LENGTH AND BUMP TEXT POINTER OVER 16900013 ST RPC,MVEPT 17000013 BC B,PC8 THE JUMP TRL. 17100013 SPACE 17200013 SCTRP1 SR 2,2 TRIPLE TXT SCAN 17300013 TRT 0(1,RTX),TABTR 17400013 BC BNZ,SC1 BRANCH IF SIGNIF (MARKED) TRL 17500013 DETL2 MVC UNITL(2),FIVE SET LGTH OF TRL TO 5 17600013 LH RC,UNITL 17700013 DETL7 CR RC,RG IS RBL LESS THAN UNITL 17800013 BC BH,DETL4 17900013 DETL6 LH RC,UNITL 18000013 LA RTX,0(RTX,RC) BUMP TXT PNTR 18100013 CLI MKTLSW,ON 18200013 BC BNE,SC3 18300013 MVI MKTLSW,OFF 18400013 BC B,*(2) BRANCH ACCORDING TO TRT IF 18500013 BC B,JUMP MARKED TRL 18600013 BC B,D0TR 18700013 BC B,D2TR 18800013 BC B,EBTR 18900013 BC B,EDTR 19000013 BC B,EETR 19100013 SC3 BAL RR,PRTEST ROUTINE TRL ACTION 19200013 BC B,SCTRP 19300013 SPACE 4 19400013 SC1 MVI MKTLSW,ON SET SW FOR SEL TRL 19500013 CLI 0(RTX),X'BC' 19600013 BC BNE,DETL1 19700013 MVI MKTLSW,OFF 19800013 DETL1 CLC ZMYNAM(2),KTNAM LOOK FOR 7 BYTE TRIPLES 19900001 BC BL,DETL2 RET IF 5BYTE TRL 20000013 CLI 0(RTX),X'D2' 20100013 BC BE,DETL5 20200013 CLI 0(RTX),X'D0' 20300013 BC BE,DETL5 20400013 CLI 0(RTX),X'D4' COMP NO. TRL 20500013 BC BE,DETL5 20600013 CLI 0(RTX),X'BC' SN2 TRL -ALSO 7BYTES IN LGTH 20700013 BC BNE,DETL2 20800013 DETL5 LH RC,C7 20900013 STH RC,UNITL 21000013 BC B,DETL7 21100013 SPACE 4 21200013 DETL3 MVI PPSW,X'F7' SET PPSW 21300013 CLI MKTLSW,ON 21400013 BC BE,SPLIT BR IF MARKED TRL 21500013 DETL4 MVC UNITLX(2),UNITL 21600013 STH RG,UNITL SET UNITL EQ TO RBL 21700013 BC B,DETL6 21800013 SPLIT TM 0(RTX),X'EE' SPLIT MARKED TRL ACTION 21900013 BC BO,DETL4 22000013 TM 0(RTX),X'ED' 22100013 BC BO,DETL4 22200013 MVI MKTLSW,OFF UNSET MKTLSW IF NOT 22300013 MVI DLAYSW,ON END BLOCK OR END PROG 22400013 EX RG,SPASET STORE 1ST PART OFTRL 22500013 BC B,DETL4 22600013 SPASET MVC WS2(0),0(RTX) 22700013 SPACE 4 22800013 DETL8 CLI DLAYSW,ON RESET MKTLSW IF NECESS 22900013 BC BNE,DETL9 23000013 MVI MKTLSW,ON 23100013 DETL9 LH RC,UNITLX DET REM TRL LGTH 23200013 LA RE,WS2 FOR 2ND PASS 23300013 LH RF,UNITL 23400013 LA RE,0(RF,RE) 23500013 SR RC,RF 23600013 STH RC,UNITL 23700013 EX RC,SPAST2 STORE 2ND PART OF TRL IN WS2 23800013 BC B,DETL6 23900013 SPAST2 MVC 0(0,RE),0(RTX) 24000013 SPACE 4 24100013 DETLA BAL RR,EOBM BR TO EOB MASTER 24200013 CLI PSCSW,ON IS IT P/C 24300013 BC BE,PCSCAP 24400013 BC B,SCTRP 24500013 SPACE 4 24600013 * MARKED TRL ACTION 24700013 JUMP LH RC,EIGHT JUMP TRL. FOUND 24800013 SRA RC,1 24900013 LA RE,0(RTX) 25000013 SR RE,RC BACKSPACE TO LGTH OF P/C 25100013 MVC PCLTH+2(2),0(RE) 25200013 LH RC,PCLTH+2 25300013 SH RC,FIVE DEDUCT 5 BYTES FOR LGTH OF JMP 25400013 STH RC,PCLTH+2 IE DET ACTUAL P/C LGTH 25500013 BAL RR,PRTEST 25600013 CLC PCLTH+2(2),ZERO IS THIS A NULL JUMP TRL. 25700013 BC BE,PC7 YES PRINT RSB BYTES 25800013 BC B,PCSCAN 25900013 SPACE 4 26000013 D0TR CLI PPSW,ON 26100013 BC BNE,D0TR1 26200013 MVC ZSTAT+2(2),WS2+3 26300013 BC B,RESET 26400013 D0TR1 L RF,MVEPT UNLABELLED STMT MARKER FOUND 26500013 MVC ZSTAT+2(2),3(RF) STORE STAT NO 26600013 RESET TM PRNTSW,X'FF' 26700013 BC BO,RESET1 RESET PRNTSW IF OFF - A NEW ST 26800013 MVI PRNTSW,ON MT IS BEING PROCESSED 26900013 RESET1 BAL RR,STCHK IS NEW STMT REQ FOR PRINTING 27000013 BAL RR,PRTEST 27100013 BC B,SCTRP 27200013 SPACE 4 27300013 D2TR CLI PPSW,ON 27400013 BC BNE,LBTRIP 27500013 MVC PAR1+2(2),WS2+3 27600013 BC B,LB4 27700013 LBTRIP L RF,MVEPT LABELLED STMT MARKER FOUND 27800013 MVC PAR1+2(2),3(RF) 27900013 LB4 L RBCH,ZDRFAB OBTAIN ABS ADDR FOR DE 28000013 BALR RR,RBCH 28100013 L RDEP,PAR1 SET DICT PNTR 28200013 CLI 0(RDEP),X'00' IS IT STMT LABEL CONST ENTRY 28300013 BC BE,LB3 YES GET STMT NO 28400013 CLI 0(RDEP),X'C3' IS IT COMPILER LABEL ENTRY 28500013 BC BE,LB3 YES 28600013 TM 0(RDEP),X'01' IS THIS A BEGIN STMT ENTRY 28700013 BC BNO,LB4A NO -MUST BE X'80' ENTRY 28800013 CLI 34(RDEP),X'D2' YES -IS THIS ENTRY A PROC STMT 28900013 BC BE,LB4A ENTRY TYPE1 ENTRY 29000013 MVC ZSTAT+2(2),7(RDEP) NO -TAKE STMT NO. DIRECTLY 29100013 BC B,RESET 29200013 LB4A MVC PAR1+2(2),7(RDEP) CHAIN TO LABEL ENTRY 29300013 BALR RR,RBCH 29400013 L RDEP,PAR1 29500013 LB3 TM OTHER1(RDEP),X'20' TEST FOR STMT BEING IN CHECK 29600013 BC BO,CHKLST LIST 29700013 MVC ZSTAT+2(2),8(RDEP) STORE STMT NO 29800013 BC B,RESET 29900013 CHKLST MVC PAR1+2(2),8(RDEP) STMT LABEL OCCURS IN CHECK LIST 30000013 BALR RR,RBCH 30100013 L RC,PAR1 30200013 MVC ZSTAT+2(2),3(RC) 30300013 BC B,RESET 30400013 SPACE 4 30500013 * TRIPLE EOB ROUTINE 30600013 EDTR TM PRNTSW,ON SET PRNTSW ON 30700013 BC BO,EOB1 30800013 MVI PRNTSW,ON 30900013 EOB1 BAL RR,PRTEST OUTPUT EOB MESSAGE 31000013 BAL RR,EOBM IE THE EOBTRL -BRANCH TO EOB MAS 31100013 BC B,SCTRP TER 31200013 EBTR TM PRNTSW,ON 1ST EOP TRL -THIS IS ALWAYS 31300013 BC BO,EB1 PRINTED 31400013 MVI PRNTSW,ON 31500013 EB1 BAL RR,PRTEST 31600013 BC B,SCTRP 31700013 EETR BAL RR,PRTEST 2ND EOP TRL -PRNTSW WILL BE ON 31800013 END1 L RBCH,ZTRAN2 EOP I.E. MUST CLEAR PRINT 31900013 TM PASSW,ON BUFFER 32000013 BC BO,END2 BRANCH IF 2 PASSES THRU 32100013 LA RG,OUTBUF PRINT BUFFER HAVE BEEN MADE 32200013 MVC LINEND(2),LINENO SET LINE CNTRS 32300013 MVC LINENO(2),LNCNT 32400013 BC BM,END2A BRANCH IF 2ND PASS THRU PRINT 32500013 END1B MVI FINBUF-2,X'22' BUFFER IS INCOMPLETE 32600013 END1A MVC FINBUF(34),0(RG) TRANSFER TO OUTPUT BUFFER 32700013 BAL RR,ENDM 32800013 BC B,END1A 32900013 END2 L RG,FINSTK 33000013 END2A MVI FINBUF-2,X'4A' RESET ZUPL LENGTH 33100013 MVC FINBUF(74),0(RG) 33200013 TR FINBUF+52(22),0(RBCH) 1ST PART TRANSL IN ENDM 33300013 BAL RR,ENDM 33400013 BC B,END2A+4 33500013 ENDM ST RR,STAC 33600013 TR FINBUF+12(22),0(RBCH) 33700013 LA RC,FINBUF-3 NORMAL ZUPL PRINTING 33800013 ST RC,PAR1 33900013 L RR,ZUPLOF 34000013 BALR RR,RR 34100013 LH RC,LINENO REDUCE LINENO 34200013 SR RC,RA 34300013 STH RC,LINENO 34400013 CH RC,LINEND 34500013 BC BNE,ENDM1 34600013 CLI PASSW,X'F0' 34700013 BC BE,END3 CHANGE FROM 2LINES TO1 34800013 BC B,TERM 34900013 ENDM1 LA RG,74(RG) CONTINUE PRINTING 35000013 L RR,STAC 35100013 BCR B,RR 35200013 END3 MVC LINEND(2),ZERO 2ND PASS CASE 35300013 CH RA,LINENO STOP IF LINENO=0 35330015 BC BH,TERM 35360015 MVI PASSW,OFF 35400013 LA RG,74(RG) 35500013 BC B,END1B NOW TREAT AS 1ST PASS FOR 35600013 * COMPLETION OF PRINTING 35700013 TERM MVC PAR1+1(1),TXNAME 35800013 MVI PAR2+3,X'02' MARK LAST TXT BLK NOT WANTED 35900013 L RBCH,ZALTER 36000013 BALR RR,RBCH 36100013 MVC PAR1+1(1),TXNAM2+1 FREE PRINT BUFFER BLOCK 36200013 MVI PAR2+3,FREE 36300013 BALR RR,RBCH 36400013 AIF (&STD).ASMA3 36430064 AGO .ASMO3 36460064 .ASMA3 ST RDIC,SAVAR+4 36490064 LA RDIC,SAVAR 36520064 .ASMO3 ANOP 36550064 DELETE EP=IEMAJ 36600001 AIF (&STD).ASMA4 36640064 AGO .ASMO4 36680064 .ASMA4 L RDIC,SAVAR+4 36720064 .ASMO4 ANOP 36760064 MVC 12(60,RDIC),AISA+12 RESTORE DICT REGS 36800013 LA RDIC,AISA POINT AT SAVE AREA FOR AI 36900013 L RDIC,4(RDIC) POINT AT AD SAVE AREA 37000013 LM 14,12,12(RDIC) RELOAD REGS AS ON ENTRY TO AI 37100013 LA RBCH,4 37200013 BCR B,RR RETURN TO AD 37300013 SPACE 4 37400013 * STMT NO CHECK(FOR PRINTING) 37500013 STCHK LH RC,ZSTAT+2 37600013 ST RR,STAC STORE RETURN ADDRESS 37700013 L RF,ADOUT 37800013 CLI ALLSW,ON ARE ALL STMTS REQ FOR PRINTING 37900013 BC BNE,X3 NO GO TO X3 38000013 XX2 LH RC,ZSTAT+2 CONVERT STMT NO TO DEC 38100013 CVD RC,CNVBUF 38200013 UNPK INTBUF(3),CNVBUF+6(2) 38300013 OI INTBUF+2,X'F0' 38400013 MVI STATSW,ON SET STMT NO. PRINT SWITCH 38500013 LA RC,*+12 STORE RETURN ADDRESS 38600013 ST RC,STACX 38700013 BC B,PRB-4 38800013 X4 L RR,STAC 38900013 BCR B,RR 39000013 X3 CLR RC,RD IS STMT REQ 39100013 BC BE,XX2 YES 39200013 BC BL,X5 NO STMT NOT REQ 39300013 LA RB,2(RB) POSSIBLY -TRY NEXT REQ STMT NO 39400013 LH RD,0(RB) 39500013 BC B,X3 39600013 X5 MVI PRNTSW,X'00' SET PRNTSW OFF 39700013 BC B,X4 39800013 SPACE 4 39900013 * S PRINT RTN 40000013 PRTEST TM PRNTSW,X'FF' 40100013 BC BO,PRT1 40200013 BC B,PREXIT 40300013 PRT1 ST RR,STAC SAVE RETURN REG 40400013 CLI TWOSW,ON BRANCH IF BLANK LINE REQ 40500013 BC BE,PRB-4 40600013 PRT1A L RC,MVEPT 40700013 SR RE,RE 40800013 IC RE,0(RC) DET ADDRESS OF OPN TYPE DECODE 40900013 AR RE,RE 41000013 AR RE,RE 41100013 CLI PSCSW,ON IS TXT INTRL OR P/C FORM 41200013 BC BE,PRT8 BRANCH ACCORDINGLY 41300013 LA RE,BLKAD2(RE) 41400013 PRT9 L RF,ADOUT 41500013 L RG,FINSTK 41600013 TM PASSW,ON 41700013 BC BO,PR4 FINAL PASS 41800013 BC BM,PR5 41900013 MVC 6(4,RG),0(RE) 42000013 BC B,PRT9A PRINTING 42100013 PR4 MVC XFNBUF+6(4),0(RE) 42200013 BC B,PRT9A 42300013 PR5 MVC 46(4,RG),0(RE) 42400013 PRT9A LR RE,RTX 42500013 S RE,MVEPT DETERMINE LENGTH OF TXT TO 42600013 ST RE,REML 42700013 PRT4 LH RC,EIGHT BE PRINTED N.B. INSTRS MVO AND 42800013 L RE,REML 42900013 CR RE,RC UNPK LIMIT NO. TXT BYTES WHICH 43000013 BC BL,PRT2 CAN BE HANDLED 43100013 SH RC,ONE ACTION IF TXT FOR OUTPUT IS MOR 43200013 ST RC,NUMBYT E THAN 7 BYTES 43300013 SR RE,RC 43400013 ST RE,REML OUTPUT FIRST 7BYTES 43500013 LR RE,RC SET LENGTH REG 43600013 BAL RR,INTOEX 43700013 MVI TRSW,ON SET SW TO INDICATE ITEMGT 7 BYTE 43800013 L RC,REML 43900013 LTR RC,RC IS IT END OF P/C ITEM 44000013 BC BZ,PRTB YES 44100013 L RC,MVEPT NO BUMP MVEPT 44200013 LA RC,7(RC) 44300013 ST RC,MVEPT 44400013 BC B,PRT4 44500013 PRT2 ST RE,NUMBYT 44600013 BAL RR,INTOEX 44700013 PRTB L RR,STAC 44800013 PRTD BC B,PREXIT 44900013 PRT8 LA RE,BLKAD3(RE) 45000013 BC B,PRT9 45100013 SPACE 4 45200013 * S CONV TO PRINTABLE HEX RTN 45300013 INTOEX ST RR,STACX 45400013 LR RC,RE 45500013 STH RE,FLD STORE L 45600013 MVO FLD+1(1),FLD+1(1) SHIFT LEFT 4BITS 45700013 MVN FLD+1(1),ZERO 45800013 SH RE,ONE L-1 45900013 AH RE,FLD 46000013 STH RE,FLD L1L2=L/L-1 46100013 IC RG,FLD+1 46200013 LR RE,RC 46300013 AR RE,RE 46400013 SH RE,ONE 46500013 STH RE,FLD LENGTH FIELDS 46600013 MVO FLD+1(1),FLD+1(1) 46700013 NI FLD+1,X'F0' 46800013 AH RC,FLD L1L2=2*L-1/L 46900013 STH RC,FLD 47000013 SR RF,RF 47100013 IC RF,FLD+1 47200013 L RC,MVEPT 47300013 PRT6 EX RG,CNV1 47400013 EX RF,CNV2 47500013 PR7 EX RE,CNV3 47600013 EX RE,CNV4 47700013 TM TXSW,EDPNT IS THIS A SPECIAL PRINT CASE 47800013 BC BNO,PRB-4 NO SKIP 47900013 TM TXSW,X'01' IS IT REG STATUS BYTE CASE 48000013 BC BO,PR10 YES SKIP 48100013 MVC EOBMKR(2),INTBUF+4 MUST BE EOB -SAVE EOB MARKER 48200013 PR10 L RE,INTBUF 48300013 SRDL RE,16 48400013 SRL RF,16 48500013 STH RE,INTBUF+2 SHIFT RSB BYTES IN BUFFER 48600013 STH RF,INTBUF+4 SHIFT 48700013 MVI INTBUF,BLANK 48800013 MVI INTBUF+1,BLANK 48900013 TM TXSW,X'01' RESTORE EOB MARKER TO PRINT 49000013 BC BO,PRB-4 BUFFER IF NECESSARY 49100013 MVC INTBUF+6(2),EOBMKR 49200013 L RG,FINSTK 49300013 PRB L RF,ADOUT 49400013 TM PASSW,ON 49500013 BC BNO,PR1 49600013 LA RC,XFNBUF 49700013 BC B,OUTPUT 49800013 PR1 LR RC,RG 49900013 TM PASSW,X'F0' 50000013 BC BZ,OUTPUT 50100013 MVI 34(RC),BLANK SET BLANKS BETWEEN PASS1 AND 50200013 MVC 35(5,RC),34(RC) P ASS2 PRINT 50300013 LA RC,40(RC) 50400013 OUTPUT CLI TWOSW,ON IS PRINTING SPACE (TO INDICATE 50500013 BC BNE,TUPTUO P/C) REQUIRED 50600013 MVI 0(RC),BLANK YES - GIVE BLANK LINR 50700013 MVC 1(33,RC),0(RC) 50800013 BC B,PRA+10 50900013 TUPTUO MVI 0(RC),BLANK 51000013 CLC TXSW(2),ZERO BLANK 'TYPE' REQUIRED 51100013 BC BE,PR6 51200013 MVC 1(9,RC),0(RC) 51300013 MVI TXSW,OFF 51400013 BC B,PR6+6 51500013 PR6 MVC 1(5,RC),0(RC) 51600013 MVI 10(RC),BLANK 51700013 MVC 11(23,RC),10(RC) 51800013 CLI STATSW,ON 51900013 BC BE,PR9 BRANCH IF STMT NO. IS TO BE 52000013 LA RC,13(RC) PRINTED 52100013 MVC 0(2,RC),INTBUF HEX CODE BYTR 52200013 MVC 5(4,RC),INTBUF+2 FIELD1 52300013 MVC 11(4,RC),INTBUF+6 FIELD 2 52400013 MVC 17(4,RC),INTBUF+10 FIELD 3 52500013 CLI PPSW,ON 52600013 BC BNE,PRA 52700013 SH RC,C7 BLANK-OUT 'ERRONEOUS' DECODE 52800013 MVI 0(RC),BLANK IF PARTIAL TRL OR P/C ITEM IS 52900013 MVC 1(3,RC),0(RC) BEING PROCESSED 53000013 PRA MVI INTBUF,BLANK 53100013 MVC INTBUF+1(15),INTBUF 53200013 L RC,FINSTK 53300013 LA RC,74(RC) 53400013 ST RC,FINSTK 53500013 LH RC,LINENO 53600013 SR RC,RA DECEEASE LINE NUM 53700013 STH RC,LINENO 53800013 CLI PASSW,ON 53900013 BC BE,PRT3 54000013 BXLE RC,RA,PRTA 54100013 PRTC CLI TWOSW,ON IS THIS A BLANK LINE CASE 54200013 BC BNE,PRTCA NO 54300013 MVI TWOSW,OFF YES - RETURN TO INTOEX 54400013 CLI STATSW,ON 54500013 BC BE,PRB-4 BR IF STMT NO IS TO FOLLOW BLANK 54600013 BC B,PRT1A 54700013 PRTCA L RR,STACX 54800013 BCR B,RR 54900013 SPACE 4 55000013 PRTA L RC,MVEPT IS IT EOP 55100013 CLI 0(RC),X'EE' IF SO RETURN 55200013 BC BE,PRTC 55300013 TM PASSW,X'F0' SET PASSW FOR NEXT PASS 55400013 BC BO,PR2 55500013 MVI PASSW,X'F0' 55600013 BC B,PRTAA RESET OUTBUF PNTR 55700013 PR2 MVI PASSW,ON 55800013 PRTAA MVC LINENO(2),LNCNT 55900013 LA RC,OUTBUF 56000013 ST RC,FINSTK 56100013 BC B,PRTC 56200013 PR9 MVC 0(3,RC),INTBUF 56300013 MVI 6(RC),BLANK 56400013 MVC 7(3,RC),6(RC) 56500013 MVI STATSW,OFF 56600013 BC B,PRA 56700013 CNV1 MVO CNVBUF(0),0(0,RC) EXECUTE INSTRS 56800013 CNV2 UNPK INTBUF(0),CNVBUF(0) 56900013 CNV3 MVZ INTBUF(0),ZERO 57000013 CNV4 TR INTBUF(0),CODE E.G. 0A=11 57100013 PRT3 L RBCH,ZTRAN2 57200013 MVC FINBUF(74),0(RG) 57300013 TR FINBUF+12(22),0(RBCH) 57400013 TR FINBUF+52(22),0(RBCH) 57500013 TR FINBUF+92(22),0(RBCH) 57600013 PRT3A LA RC,FINBUF-3 57700013 ST RC,PAR1 57800013 L RBCH,ZUPLOF 57900013 BALR RR,RBCH 58000013 LH RC,LINENO 58100013 BXLE RC,RA,PR3 58200013 BC B,PRTC 58300013 PR3 LH RC,ZPAGE 58400013 SH RC,C7 58500013 CH RC,LNCNT IS THIS THE 2ND PRINT PAGE 58600013 BC BH,TERM 58700013 BC BL,PR8 58800013 LH RC,LNCNT IF SO RESET LNCNT FOR ALL 58900013 LA RC,3(RC) SUBSEQUENT PAGES 59000013 STH RC,LNCNT 59100013 PR8 L RC,MVEPT H417 59140019 CLI 0(RC),X'EE' IS IT EOP2 H417 59180019 BE TERM IF SO GET OUT H417 59220019 MVC LINENO(2),LNCNT H417 59260019 LA RC,OUTBUF 59300013 ST RC,FINSTK 59400013 MVI PASSW,OFF 59500013 LA RC,PRTFST-3 59600013 ST RC,PAR1 59700013 L RBCH,ZUPLOF 59800013 BALR RR,RBCH 59900013 BC B,PRTC 60000013 SPACE 4 60100013 PREXIT TM PPSW,X'FF' EXIT RTN FOR PRINT RTN 60200013 BC BZ,PRTE 60300013 BC BM,PRTF 60400013 MVI PPSW,OFF 60500013 PRTE CLI TWOSW,X'FF' SET DOUBLE SW OFF 60600013 BC BNE,PRT5 IF NECESS 60700013 MVI TWOSW,OFF 60800013 PRT5 MVI STATSW,OFF 60900013 MVC TXSW(2),ZERO SET SWITCHES OFF 61000013 BCR B,RR 61100013 PRTF OI PPSW,X'08' 61200013 BC B,PRTE 61300013 SPACE 4 61400013 * S MASTER EOB RTN 61500013 EOBM MVC PAR1+1(1),TXNAME OBTAIN NXT TXT BLK 61600013 MVI PAR2+3,X'02' MARK OLD BLK AS NOT WANTED 61700013 ST RR,STAC 61800013 L RBCH,ZCHAIN 61900013 BALR RR,RBCH 62000013 MVC TXNAME(1),PAR1+1 62100013 L RTX,PAR2 SET PNTR TO NEXT TRIP 62200013 L RG,BLOCKL 62300013 AR RG,RTX 62400013 LA RC,3 62500013 SR RG,RC 62600013 ST RG,ENDBLK 62700013 EOBM1 L RR,STAC 62800013 BCR B,RR 62900013 SPACE 4 63000013 * PSEUDO CODE SCAN 63100013 SPACE 4 63200013 PCSCAN MVI PSCSW,ON 63300013 MVI TWOSW,ON SET DOUBLE SPACE SW 63400013 PCSCAP ST RPC,MVEPT SET MVEPT 63500013 L REND,ENDBLK DETERMINE REMAINING BLOCK LENGTH 63600013 SR REND,RPC 63700013 BC BM,TERM 63800013 ST REND,RBL DET REM BLK LGTH 63900013 ST REND,RBL STORE IT IN RBL 64000013 LTR REND,REND IS RBL ZERO 64100013 BC BNZ,PC1 NO -CONTINUE PROCESSING 64200013 TM PRNTSW,ON EOB. CAN LAST 3 BYTES BE SKIPPED 64300013 * WITHOUT PRINTING 64400013 BC BNO,PC10 YES 64500013 LA RE,3 NO -SET LENGTH REGISTER AND TXSW 64600013 MVI TXSW,EDPNT FOR 'INTOEX' 64700013 BAL RR,INTOEX 64800013 PC10 BAL RR,EOBM GET NEW TEXT BLOCK 64900013 BC B,SCTRP RETURN TO TRL. SCAN ROUTINE 65000013 * NOTE THAT THE 1ST ITEM IN ANY BLO- 65100013 * CK MUST BE A TRL. 65200013 PC1 LH RC,UNITL 65300013 CLI TXSW,ON 65400013 BC BE,PC4 REG STATUS BYTE CASE 65500013 TM 0(RPC),OPB DET ITEM LGTH 65600013 BC BO,PC2 VARIABLE. 65700013 BC BM,PC3 5BYTE 65800013 LA RC,3 3BYTE ITEM 65900013 BC B,PC4 66000013 PC3 LH RC,FIVE 66100013 PC4 STH RC,UNITL 66200013 CR RC,RG IS RBL LT LGTH 66300013 BC BH,PC5 YAS END BLOCK PROC 66400013 PC6 LH RF,UNITL 66500013 LA RPC,0(RF,RPC) BUMP TXT PNTR 66600013 TM TXSW,X'FF' RSB TEST 66700013 BC BO,REGSB 66800013 BAL RR,PRTEST GO TO PRINT RTN 66900013 LH RF,PCLTH+2 67000013 SH RF,UNITL 67100013 STH RF,PCLTH+2 STORE REDUCED P/C LENGTH 67200013 LTR RF,RF IS THIS THE END OF THE P/C 67300013 BC BP,PCSCAP NO-CONTINUE SCANNING 67400013 L RG,ENDBLK YES - BUT IS IT END OF BLOCK 67500013 CR RG,RPC 67600013 BC BE,PCSCAP YES -HENCE PRINT LAST 3 BYTES 67700013 PC7 MVC UNITL(2),TWO PROCESS REG.STATUS BYTES 67800013 MVI TXSW,ON 67900013 BC B,PCSCAP 68000013 PC2 LA RC,3 TEST TO SEE IF LGTH BYTE 68100013 CR RC,RG IC LOCATED IN CURRENT BLK 68200013 BC BH,PC9 IF NOT GO TO PC9 68300013 IC RC,2(RPC) EXTRACT LGTH 68400013 BC B,PC4 68500013 PC9 LR RC,RG 68600013 EX RG,SPACET STACK 1ST PART OF UNIT 68700013 BC B,PC4 68800013 SPACET MVC WS1(0),0(RPC) 68900013 SPACE 2 69000013 * PSEUDO-CODE ITEM SPANS BLOCKS 69100013 PC5 MVI PPSW,X'F7' SET PART SW ON 69200013 MVC UNITLX(2),UNITL 69300013 STH RG,UNITL 69400013 BC B,PC6 69500013 PC8 SR RC,RC TEST TO SEE IF VAR LGTH 69600013 IC RC,WS1 UNIT /F UNKNOWM LGTH 69700013 LTR RC,RC 69800013 BC BNZ,VLEN 69900013 PC8A LH RC,UNITLX DET UNITL FOR NXT PASS 70000013 SH RC,UNITL 70100013 STH RC,UNITL 70200013 BC B,PC6 70300013 VLEN LH RC,UNITL UNKNOWN V LGTH CASE 70400013 LA RE,2 70500013 SR RE,RC 70600013 LA RC,0(RE,RPC) EXTRACT V LGTH 70700013 MVC UNITLX+1(1),0(RC) 70800013 MVC WS1(2),ZERO 70900013 BC B,PC8A 71000013 REGSB CLI PPSW,ON IS BLOCK OVERLAP INVOLVED 71100013 BC BNE,RSB1 71200013 MVI PPSW,OFF 71300013 STH RA,ADFAC CORRN FACTOR 71400013 RSB1 TM PRNTSW,X'FF' 71500013 BC BNO,ENDPC 71600013 LR RE,RF PRINT RS BYTES 71700013 BAL RR,INTOEX 71800013 ENDPC MVI PSCSW,OFF 71900013 MVI TWOSW,ON DOUBL 72000013 BC B,SCTRP 72100013 TABTR DC 64F'0' 72200013 ORG TABTR+X'5B' 72300013 DC X'04' 72400013 ORG TABTR+X'D0' 72500013 DC X'08' 72600013 ORG TABTR+X'D2' 72700013 DC X'0C' 72800013 ORG TABTR+X'EB' 72900013 DC X'10' 73000013 ORG TABTR+X'ED' 73100013 DC X'14' 73200013 ORG TABTR+X'EE' 73300013 DC X'18' 73400013 ORG TABTR+X'BC' 73500013 DC X'FF' 73600013 ORG TABTR+X'D4' 73700013 DC X'08' 73800013 ORG TABTR+256 73900013 STATAB DC X'FF000000' 74000013 DC 5F'0' 74100013 ALLSW EQU STATAB 74200013 INTBUF DS 4F 74300013 DS 0D 74400013 CNVBUF DS 2F 74500013 MVEPT DS F 74600013 REML DS F 74700013 STACX DS F 74800013 ENDBLK DS F 74900013 RBL DS F 75000013 NUMBYT DS F 75100013 PCLTH DS F 75200013 WS1 DC F'0' 75300013 ADOUT DS F 75400013 TXNAM2 DS F 75500013 WS2 DC 2F'0' 75600013 FINSTK DS F PRINT STACK PNTR 75700013 AISA DS 18F 75800013 AIF (&STD).ASMA5 75810064 AGO .ASMO5 75820064 .ASMA5 ANOP 75830064 SAVAR DS 18F 75840064 .ASMO5 ANOP 75850064 CCHAR DC X'00007840' 75900015 CODE DC X'0001020304050607' 76000013 DC X'0809111213141516' 76100013 STAC DS F 76200013 ZERO DC 16X'00' 76300013 DC X'00007260' 76400015 PRTFST DC C'STNO' 76500013 DC X'4040' 76600013 DC C'TYPE' 76700013 DC X'404040' 76800013 DC C'HEX' 76900013 DC X'4040' 77000013 DC C'FLD1' 77100013 DC X'4040' 77200013 DC C'FLD2' 77300013 DC X'4040' 77400013 DC C'FLD3' 77500013 DC X'404040404040' 77600013 DC C'STNO' 77700013 DC X'4040' 77800013 DC C'TYPE' 77900013 DC X'404040' 78000013 DC C'HEX' 78100013 DC X'4040' 78200013 DC C'FLD1' 78300013 DC X'4040' 78400013 DC C'FLD2' 78500013 DC X'4040' 78600013 DC C'FLD3' 78700013 DC X'404040404040' 78800013 DC C'STNO' 78900013 DC X'4040' 79000013 DC C'TYPE' 79100013 DC X'404040' 79200013 DC C'HEX' 79300013 DC X'4040' 79400013 DC C'FLD1' 79500013 DC X'4040' 79600013 DC C'FLD2' 79700013 DC X'4040' 79800013 DC C'FLD3' 79900013 DC X'000024F1' 80000015 HEDING DC C'PHASE ' 80100013 DC C'SELECTED TEXT PR' 80200013 DC C'INT FOLLOWS' 80300013 KTNAM DC C'KT' START OF PSEUDO CODE 80400001 DS 0H 80500013 P2NAME DC C'AJZZ' 80600013 FIVE DC H'05' 80700013 EIGHT DC H'8' 80800013 TWO DC H'2' 80900013 C7 DC H'7' 81000013 LINEND DC H'0' 81100013 ADFAC DS H 81200013 UNITL DS H 81300013 UNITLX DS H 81400013 TXNAME DS H 81500013 FLD DS H 81600013 ONE DC H'1' 81700013 LINENO DS H CURRENT LINE NO. 81800013 LNCNT DS H LINECOUNT-3 81900013 EOBMKR DS H 82000013 IANAM DC C'IA' 82100013 OGNAM DC C'OG' 82200013 LRNAME DC C'LR' 82250015 PRNTSW DS C 82300013 DS 0H 82400013 TXSW DS C 82500013 TRSW DS C 82600013 PSCSW DS C 82700013 PPSW DS C 82800013 MKTLSW DS C 82900013 TWOSW DS C 83000013 DLAYSW DS C 83100013 STATSW DS C 83200013 PASSW DS C PRINT SPACING SWITCH 83300013 END IEMAI 83400013 ./ ADD SSI=02012960,NAME=IEMAJ,SOURCE=0 * R20.6 *450000,*755000,*875000,895000,*938000 Z2153 00100046 EJECT 00200046 AJ TITLE 'IEMAJ,TEXT DUMP,COMPILER CONTROL, OS/360 PL1/F' 00500013 IEMAJ START 0 01000013 USING *,RBASE2 01500013 USING *+X'2000',RDIC 02000013 USING *+X'1000',RCC 02500013 USING *+X'3000',RBASE 03000013 RCC EQU 11 COMPILER CONTROL BASE 03500013 RBASE EQU 10 04000013 RBASE2 EQU 12 04500013 RDIC EQU 13 DICTIONARY BASE 05000013 BLKAD1 DC C'DGDG' 05500013 BLKAD2 DC 256F'0' 06000013 SPACE 4 06500013 * TRIPLE TEXT CODE BYTES 07000013 ORG BLKAD2+16 07500013 DC C'TITLATTRPGSZIDEN' 07800015 DC C'LNSZ INTOFROM' 08100001 DC C'SET KEY NOLKIGN ' 08400015 DC C'FILE LISTEDIT' 08900001 DC C'DATASTG SKIPLINE' 09500013 DC C'PAGECOPYKEYTTASK' 10000001 DC C'RPL IN KEYFFTL ' 10500015 DC C'UP GIVGDOWNEVNT' 11000015 DC C'PRIORPLY BYCH' 11500015 DC C'MSA MTA QFNCSTAS' 12000001 DC C'QPSIEDASDFS TNF ' 12500001 DC C'C*F C*C ' 13000013 DC C'C*PV BYAS' 13500013 DC C'ARCOSUBOPV. SSUB' 14000001 DC C'FNC SSB''SUBSNOP ' 14500001 DC C'PTCHCOMAFNCM ' 15000001 DC C'C*CMACT C*ASASSI' 15500013 DC C'DROPCAT BUYBOR ' 16000013 DC C'CNVAAND CNVBNOT ' 16500015 DC C' LST' 17000013 DC X'7D' 17500013 DC C'EDT' 18000013 DC X'7D' 18500013 DC C'DAT' 19000013 DC X'7D' 19500013 DC C'STG' 20000013 DC X'7D' 20500013 DC C'STMPMTAS' 21000013 DC C'TMPDLD TT JMP ' 21500015 DC C'RPL' 22000013 DC X'7D' 22500013 DC C' LITCFTL' 23000013 DC X'7D' 23500013 DC C'UP' 24000013 DC X'7D' 24500013 DC C' DOEQDWN' 25000013 DC X'7D' 25500013 DC C'ERR ' 26000013 DC C' LE GE ' 26500013 DC C'LEFTNE QFN' 27100015 DC X'7D' 27200015 DC C'EQ ' 27300015 DC C' GT DFS' 27500013 DC X'7D' 28000013 DC C'LT ' 28500013 DC C'C*F' 29000013 DC X'7D' 29500013 DC C' C*C' 30000013 DC X'7D' 30500013 DC C'MNUS' 31000013 DC C'C*P' 31500013 DC X'7D' 32000013 DC C'PLUSCOMRDIV ' 32500001 DC C'OFS MULTPV' 33000015 DC X'7D' 33500013 DC C' PRF-' 34000013 DC C'FNC''PRF+SUB''EXP ' 34500013 DC C'TO ALOCBY FREE' 35000013 DC C'WHYL*CV SNAP ' 35500001 DC C'SYSTWAITTHENDLAY' 36000015 DC C'CV EXIT STOP' 36500013 DC C'LINEENALPAGE ' 37000013 DC C'SKIPDSPYCOL SIG ' 37500013 DC C'E REV F ' 38000013 DC C' NULLC ASSN' 38500015 DC C'A CALLB RETN' 39000013 DC C'P GOOBR GOTO' 39500013 DC C'GOLNBUYTBUYXHSEL' 40000015 DC C'SELLBUY X BUYS' 40500013 DC C' PROC' 41000013 DC C' BGN ITDO' 41500013 DC C' DO IF ' 42000013 DC C'SN2 ELSENOSNFMT ' 42500015 DC C'TO'' BY'' ' 43000013 DC C'WHL''SORTSNP''WRYT' 43500015 DC C'SYS''READ LCAT' 44000015 DC C'CV'' DELT ' 44500015 DC C'STNOCLN1STLBCLN2' 45000046 DC C'C*NOGET C*LBPUT ' 45500013 DC C'E'' ULOCF'' REWR' 46000015 DC C' OPENC'' CLSE' 46500013 DC C' CAL'' ' 47000013 DC C'P'' ENDO' 47500015 DC C'EIDOEND G'' EOP ' 48000015 DC C'SEL''EOB EOP2 ' 48500015 DC C' EIO PRC''' 49000013 DC C' BGN''CHK ITD''' 49500015 DC C' DO'' IF''/' 50000013 DC C'VECTPREF FMT''' 50500015 SPACE 4 51000013 * PSEUDO CODE TEXT CODE BYTES 51500013 BLKAD3 DC 256F'0' 52000013 ORG BLKAD3 52500013 DC C'DCV0' 53000013 DC C'DCV1' 53500013 DC C'DCV2' 54000013 DC C'DCV3' 54500013 DC C'DCV4' 55000013 DC C'DCV8' 55500013 DC C'DROP' 56000013 DC C'EQU ' 56500013 DC C'PROC' 57000013 DC C'BGN ' 57500013 DC C'PASS' 58000001 DC C'EOP ' 58500013 DC C'EOP2' 59000013 DC C'IPRM' 59500013 DC C'EPRM' 60000013 DC C'ITDO' 60500013 DC C'OSM1' 61000013 DC C'OSM2' 61500013 DC C'ALOC' 62000013 DC C'DCA3' 62500013 DC C'DCA4' 63000013 DC C'FREE' 63500013 DC C'BUY ' 64000013 DC C'SELL' 64500013 DC C'PRC' 65000013 DC X'7D' 65500013 DC C'BGN' 66000013 DC X'7D' 66500013 DC C'ADV ' 67000013 DC C'PLBS' 67500013 DC C'PCBS' 68000013 DC C'IPR' 68500013 DC X'7D' 69000013 DC C'EPR' 69500013 DC X'7D' 70000013 DC C'ITD' 70500013 DC X'7D' 71000013 DC C'BGPEEOB PCC COSM' 71500015 DC C'ADR SN3 BCINSTOP' 72000013 DC C'BGNPBGP''DRB' 72500013 DC X'7D' 73000013 DC C'PLB' 73500013 DC X'7D' 74000013 DC C'PSLDABS ABS''ALGN' 74500013 DC C'BLBSBLB''BUYSPINS' 75000013 DC C'RWA APRMUSNGEDIT' 75500046 DC C'FMTLFMT FMT''EDT''' 76000015 DC C'ERR PFMT ' 76500015 DC C'LCR BCR HER HDR ' 77000013 DC C'BCTRNR OR XR ' 77500013 DC C'LR CR AR SR ' 78000013 DC C'MR DR SVC BALR' 78500013 DC C'LCDRSPM LTR LTER' 79000013 DC C'LTDRLNR LNERLNDR' 79500013 DC C'LDR CDR ADR SDR ' 80000013 DC C'MDR DDR AWR SWR ' 80500013 DC C'LCERCLR ALR SLR ' 81000013 DC C' LPR LPERLPDR' 81500015 DC C'LER CER AER SER ' 82000013 DC C'MER DER AUR SUR ' 82500013 DC C'LM SLA SLDASLDL' 83000013 DC C'SLL SRA SRDASRDL' 83500013 DC C'SRL STM BXH BXLE' 84000013 DC C'SL1 SN CL1 CN ' 84500013 DC C'BCA''BC DCF BCTA' 85000013 DC C'BCT N O X ' 85500013 DC C'L C A S ' 86000013 DC C'M D IC BAL ' 86500013 DC C'LH CH AH SH ' 87000013 DC C'MH STH QLA STD ' 87500046 DC C'LD CD AD SD ' 88000013 DC C'MD DD AW CVB ' 88500001 DC C'LA CL AL SL ' 89000013 DC C'STC ST EX STE ' 89500046 DC C'LE CE AE SE ' 90000013 DC C'ME DE AU CVD ' 90500001 DC C'CLI MVI NI OI ' 91000013 DC C'SSM TM XI LA'' ' 91500013 DC C'DCF2BCT' 92000015 DC X'7D' 92500013 DC C'MDRP ' 93100001 DC C'SN2 OSM3ADI BSW ' 93800046 DC C'CLC MVC MVN MVO ' 94500013 DC C'MVZ NC OC XC ' 95000013 DC C'ZAP CP AP SP ' 95500013 DC C'MP DP EP EDMK' 96000001 DC C'TR TRT PACKUNPK' 96500013 DC C'IGN CONVCNV' 97000013 DC X'7D' 97500013 DC C'USSLDRPLCNVASINL' 98000013 DC C'CVC1CVC2CVC3CVC4' 98500001 END IEMAJ 99000013 ./ ADD SSI=03013130,NAME=IEMAK,SOURCE=0 AK TITLE 'IEMAK, CLOSING PHASE, COMPILER CONTROL, OS/360 PL/1(F)' 00200013 * 00300064 * 00303064 * 5.4 A 034210,034350,040600,040800,090800,091600,122250, MAC 54703 00306064 * 122300,164000,168000,190000,204800,257000,258000, MAC 54703 00309064 * 293600,294000,298400,299200,302000,342000,362000, MAC 54703 00312064 * 364000,498000,501600,576600598000,,691000. MAC 54703 00315064 * C 340000,564500. MAC 54703 00318064 * 5.3A C 577000. PG 43462 00321064 * 5.2C A 034000. MAINT 00324064 * C 026000-030000. MAINT 00327064 * 5.2B A 040000,576000,688000. JLC 35228 00330064 * 5.2 A 376000,680400. JRT H454 00333064 * D 412000-414000. JRT H454 00336064 * 5.2 A 376500,680800,699210. JRT H452 00339064 * 5.0 C 057000,074000,086020,633060,699280,765500. JRT H207 00342064 * 5.0 DUPLICATE OF H207. JRT 23263 00345064 * 5.0 A 034000,058000,148000,292000,510000. (PTM825) MAH H229 00348064 * C 206000,298000. (PTM825) MAH H229 00351064 * R17 C 092000,716000. 20221 00354064 * 00357064 * 00360064 SPACE 5 00363064 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 000-TSS 00383020 * ----------------------------------------------------AK 000-TSS 00386020 SPACE 5 00390064 GBLB &STD 00393064 &STD SETB 1 00396064 EJECT 00400013 IEMAK CSECT 00600001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 022-TSS 00660020 * ----------------------------------------------------AK 022-TSS 00720020 USING *,BASE 00800013 * 01000013 * 01200013 * INITIALISE AK 01400013 * 01600013 STM 14,12,12(13) SAVE AA REGISTERS 01800013 * 02000013 LR BASE,LR BASE AK 02200013 * 02400013 LA RB,AKSAVE POINT AT AK SAVE AREA 02600046 ST 13,4(0,RB) CHAIN FORWARDS 02800046 ST RB,8(0,13) CHAIN BACK 03000046 * 03200013 L RI,PAROF(0,CR) POINT AT INITIALISATION LIST 03400013 TM 0(CR),X'FF' SHALL WE ABEND? 03407046 BNO CHAINAK CHICKEN 03414046 L RB,PLDCBOF(0,RI) POINT AT SYSPRINT DCB 03421046 AIF (NOT &STD).ASMO1 03422064 ST DR,THISDR 03423064 LA DR,AKSAVE POINT AT SAVE AREA 03424064 .ASMO1 ANOP 03425064 CLOSE ((RB)) CLOSE SYSPRINT 03428046 ABEND (RC),DUMP !!! THE END !!! 03435046 AIF (NOT &STD).ASMO2 03436064 L DR,THISDR 03437064 .ASMO2 ANOP 03438064 CHAINAK EQU * 03442046 L RA,GENSWOF(0,RI) PTM825 03450001 TM 1(RA),X'F0' IF ON NO COMM-REGION PTM825 03500001 BO NCR1 PTM825 03550001 L RA,DADOF(0,RI) POINT AT DICTIONARY ADDRESS 03600013 L DR,0(0,RA) POINT AT DICTIONARY 03800013 ST DR,DRSAVE SAVE DICT POINTER 04000013 SPACE 1 04020042 TM CCCODE+2(DR),X'40' IS THE CHK OPTION ON? 35228 04040042 BZ NOSPIE YES 35228 04060042 AIF (NOT &STD).ASMO3 04065064 LA DR,AKSAVE POINT AT SAVE AREA 04070064 .ASMO3 ANOP 04075064 SPIE AKPIH,((1,15)) SET UP SPIE FOR 1K 35228 04080042 AIF (NOT &STD).ASMO4 04085064 L DR,DRSAVE POINT AT DICTIONARY 04090064 .ASMO4 ANOP 04095064 SPACE 1 04100042 NOSPIE EQU * 35228 04120042 EJECT 04200013 SPACE 4 04400013 CLI IOERSW(DR),X'FF' IS THERE AN I/O ERROR 04600013 BC BNE,NOIO 04800013 NI CCCODE+3(DR),X'F7' SHOW NO BTCHG TO END COMPILN 05000013 LA RT,16 SET RETURN CODE 05200013 CLI PERRSW(DR),X'FF' TEST FOR ERROR IN SYSPRINT 05400013 BC BE,INTRUPT BRANCH IF SO 05600013 BC B,DICTSPIL H207 05700001 NCR1 LA RT,16 SET CODE TO TERMINATE PTM825 05860001 BC B,NCR2 PTM825 05920001 NOIO L RA,GENSWOF(0,RI) POINT AT SWITCH 06000013 CLI 0(RA),X'F0' IS FST CD IN SYSIN A *PROC CARD 06200013 MVI 0(RA),X'FF' TURN ON SWITCH 06400013 BC BNE,UPDATERR BRANCH IF NOT 06600013 TM CCCODE+3(DR),X'08' ARE WE BATCHING 06800013 BC BZ,UPDATERR IF NOT THEN WANT NORMAL RET CODE 07000013 LA RT,0 SET RETURN CODE 07200013 BC B,DICTSPIL H207 07400001 UPDATERR L RA,ERCSVOF(0,RI) POINT AT MAX ERCODE SO FAR 07600013 CLC 0(1,RA),ERCODE+3(DR) IS THIS ONE HIGHER 07800013 BC BNL,SAVCOD 08000013 MVC 0(1,RA),ERCODE+3(DR) MOVE IN NEW MAX ERCODE 08200013 SAVCOD SR RT,RT CLEAR REGISTER RT 08400013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 023-TSS 08500020 IC RT,0(0,RA) KEEP HIGHEST ERCODE 08600013 * ----------------------------------------------------AK 023-TSS 08600220 EJECT 08601001 * ROUTINE DICTSPIL. H207 08602001 * THIS ROUTINE CALCULATES THE SIZE NECESSARY TO AVOIDH207 08603001 * DICTIONARY SPILL. H207 08604001 * AB CONSIDERS 4 BREAKPOINTS AT WHICH THE BLOCKSIZE H207 08605001 * DOUBLES, I.E. 16K, 32K, 92K, 128K. ALLOWING FOR 4 TEXT H207 08606001 * BLOCKS GIVES DICTIONARY BREAKPOINTS OF 12K, 24K, 76K, H207 08607001 * AND 96K. THE DICT SIZE IS OBTAINED FROM A SCAN OF DSLOTS H207 08608001 * AND IS COMPARED WITH THESE TO GIVE THE NEW BLOCKSIZE. H207 08609001 * THE SIZE IS ROUNDED TO A WHOLE NO. OF BLOCKS H207 08610001 * (BECAUSE OF THIS, BREAKPOINT 76K IS CONSIDERED AS 73K H207 08611001 * IN THE CALCULATION OF BLOCKSIZE). THE BLOCKSIZE IS H207 08612001 * RECALCULATED IF THE BREAKPOINT HAS BEEN ATTAINED. H207 08613001 * SPACE FOR 4 TEXT BLOCKS AND COMPILER REQUIREMENTS H207 08614001 * IS ADDED, THE SIZE ROUNDED TO A MULTIPLE OF 1K AND THE H207 08615001 * MESSAGE PRINTED. H207 08616001 * H207 08617001 * EXTDIC: H207 08618001 * THE OVERFLOW BLOCK, IF CREATED, IS CONSIDERED H207 08619001 * SEPARATELY. ALSO, 1K BLOCKS HAVE LESS DICT SPACE PER H207 08620001 * BLOCK THAN LARGER BLOCKS, BUT MORE SPACE FOR OFFSETS, SO H207 08621001 * IF THE BLOCKSIZE HAS INCREASED FROM 1K THE NEED FOR AN H207 08622001 * OVERFLOW BLOCK IS BALANCED BY EXTRA SPACE, EXCEPT AT A H207 08623001 * BREAKPOINT. IF THE BLOCKSIZE HAS DECREASED TO 1K AN EXTRAH207 08624001 * 3K IS ADDED, TO ALLOW FOR THE SMALLER USEFUL DICTIONARY. H207 08625001 SPACE 08626001 * IF A TERMINAL ERROR HAS OCCURRED SUPPRESS THE MESSAGE H207 08627001 SPACE 08628001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 018-TSS 08628520 DICTSPIL CLI ERCODE+3(DR),X'10' HAVE WE HAD TERM ERROR H207 08629001 BC BE,TIMER IF SO OMIT DICTSPIL H207 08630001 SPACE 08631001 * FIRST COUNT THE DICTIONARY BLOCKS H207 08632001 SPACE 08633001 XR RA,RA INITIALISE BLOCK COUNT TO H207 08634001 * ZERO H207 08635001 LA RC,1 MAKE INCREMENT 1 H207 08636001 L RB,DSLOTSOF(0,RI) POINT AT DSLOTS FOR SCAN H207 08637001 NXTSLOT CLI 0(RB),X'FF' IS BLOCK IN USE H207 08638001 BC BE,BUMP NO,SO TRY NEXT ONE H207 08639001 ADDONE AR RA,RC YES,SO INCREMENT COUNT H207 08640001 NC T1FL,0(RB) AND RESET T1FL H207 08641001 BUMP LA RB,4(0,RB) BUMP TO NEXT SLOT H207 08642001 CLI 1(RB),X'FF' TEST FOR STOPPER IN LIST H207 08643001 BC BNE,NXTSLOT CONTINUE COUNT IF NOT H207 08644001 M R0,DICTSZ(0,DR) CALCULATE DICTIONARY SIZE H207 08645001 SPACE 2 08646001 * IF THE DICT SIZE IS LESS THAN 8K IT MAY BE POSSIBLEH207 08647001 * TO USE ONLY BASIC 44K. DO THIS IF TWO CONDS ARE SAT: H207 08648001 * (1) THIS COMPILATION USED BASIC 44K H207 08649001 * (2) NO DICT SPILL OCCURRED H207 08650001 SPACE 08651001 C RA,F8K IS DICT SIZE LESS THAN 8K H207 08652001 BC BNL,OVER8 NO,SO BRANCH H207 08653001 TM T1FL,X'80' WAS A BLOCK SPILLED H207 08654001 BC BO,OVER8 BRANCH IF NOT H207 08655001 TM CCCODE+2(DR),X'04' WAS BASIC USED H207 08656001 BC BO,ADCORE BRANCH IF SO H207 08657001 SPACE 2 08658001 * ALLOW FOR A POSSIBLE CHANGE IN BLOCKSIZE. IF THERE WAS ANH207 08659001 * OVERFLOW BLOCK SUBTRACT IT FIRST. H207 08660001 SPACE 08661001 OVER8 CLI OFDNAM(DR),X'00' WAS THERE AN OVERFLOW BLOCKH207 08662001 BC BE,NOOFL BRANCH IF NOT H207 08663001 S RA,DICTSZ(0,DR) SUBTRACT THE BLOCK H207 08664001 SPACE 08665001 NOOFL L RB,F1K RB HOLDS BLOCKSIZE H207 08666001 L RD,F6K H207 08667001 SHIFT SLA RD,1 GRD HOLDS THE BREAKPOINT, H207 08668001 * ALLOWING SPACE FOR TEXT H207 08669001 CR RA,RD ARE WE IN THIS REGION H207 08670001 BC BL,EXT28 YES,SO BRANCH H207 08671001 SLA RB,1 NO,SO INCREASE BLOCKSIZE H207 08672001 C RB,F16K IS BLOCKSIZE 16K H207 08673001 BC BNE,SHIFT NO,SO TRY NEXT REGION H207 08674001 SLA RD,2 YES, SO WE HAVE FINISHED H207 08675001 * MAKE BREAKPOINT>DICT SIZE H207 08676001 SPACE 08677001 * IN ABOVE ROUTINE WE HAVE USED A BREAKPOINT OF 48K H207 08678001 * INSTEAD OF 73K. ALLOW FOR THIS. H207 08679001 SPACE 08680001 EXT28 C RB,F8K WAS BLOCKSIZE 8K H207 08681001 BC BNE,DICAD NO,SO DO NOTHING H207 08682001 C RA,F73K WAS DICT SIZE LESS THAN 73KH207 08683001 BC BNL,DICAD NO,SO DO NOTHING H207 08684001 SRA RB,1 YES,SO ALTER BLOCK SIZE H207 08685001 L RD,F73K AND BREAKPOINT H207 08686001 SPACE 08687001 * ROUND UP TO A WHOLE NO OF DICT BLOCKS H207 08688001 SPACE 08689001 DICAD DR R0,RB DIVIDE DICT SIZE H207 08690001 * BY NEW BLOCKSIZE H207 08691001 LTR R0,R0 IS REMAINDER ZERO H207 08692001 BC BZ,CALNEW YES,SO BRANCH H207 08693001 AR RA,RC ADD ONE TO QUOTIENT H207 08694001 CALNEW MR R0,RB CALCULATE NEW DICT SIZE H207 08695001 SPACE 08696001 * TEST IF EXTDIC WAS USED H207 08697001 SPACE 08698001 CLI DICTP(DR),X'00' WAS IT BIG DIC H207 08699001 BC BE,NORM BRANCH IF NOT H207 08700001 SPACE 08701001 * IF HERE EXTDIC WAS USED. IF THE BLOCKSIZE HAS DEC H207 08702001 * TO 1K OR INC FROM 1K WE TAKE SPECIAL ACTION. H207 08703001 SPACE 08704001 C RB,DICTSZ(0,DR) COMPARE NEW AND OLD BLOCKS H207 08705001 BC BL,TRY1K BRANCH IF NEW IS LESS H207 08706001 BC BE,TOFL OR EQUAL H207 08707001 CLC DICTSZ(4,DR),F1K WAS BLOCKSIZE 1K H207 08708001 BC BH,TOFL BRANCH IF NOT H207 08709001 CR RA,RD ARE WE AT BREAKPOINT H207 08710001 BC BNE,NORM BRANCH IF NOT H207 08711001 BC B,ADBL IF SO GO TO ADD A BLOCK H207 08712001 SPACE 08713001 TRY1K C RB,F1K IS NEW BLOCKSIZE 1K H207 08714001 BC BH,TOFL BRANCH IF NOT H207 08715001 A RA,F3K IF SO ADD 3K TO ALLOW FOR H207 08716001 * SMALLER USEFUL DICT SIZE H207 08717001 BC B,NORM AND BRANCH H207 08718001 SPACE 08719001 * WE NOW TEST AGAIN FOR AN OVERFLOW BLOCK AND EXECUTEH207 08720001 * ONE OF TWO ROUTINES WHICH RECALCULATE THE BLOCKSIZE IF H207 08721001 * WE HAVE GONE OVER THE BREAKPOINT. H207 08722001 SPACE 08723001 TOFL CLI OFDNAM(DR),X'00' IS THERE AN OVERFLOW BLOCK H207 08724001 BC BE,NORM BRANCH IF NOT H207 08725001 SPACE 08726001 AR RA,RB ADD IN OVERFLOW BLOCK H207 08727001 CR RA,RD ARE WE OVER BREAKPOINT H207 08728001 BC BL,ADTXT BRANCH IF NOT H207 08729001 BC BH,HIGH IF GREATER GO ADD ONE BLOCKH207 08730001 ADBL AR RA,RB IF EQUAL ADD TWO BLOCKS H207 08731001 HIGH AR RA,RB H207 08732001 BC B,INC GO TO INCREASE BLOCKSIZE H207 08733001 SPACE 08734001 NORM CR RA,RD ARE WE OVER BREAKPOINT H207 08735001 BC BL,ADTXT NO,SO BRANCH H207 08736001 INC SLA RB,1 YES,SO INCREASE BLOCKSIZE H207 08737001 SPACE 08738001 * ADD IN SPACE FOR TEXT AND COMPILER CORE REQUEMENTS H207 08739001 SPACE 08740001 ADTXT SLA RB,2 CALCULATE SIZE OF FOUR H207 08741001 * TEXT BLOCKS H207 08742001 AR RA,RB ADD IT IN H207 08743001 ADCORE L RB,CORSZOF(0,RI) POINT AT CORSZE H207 08744001 A RA,0(RB) ADD IN CORSZE H207 08745001 SPACE 2 08746001 * WE HAVE THE SIZE. MAKE IT A MULTIPLE OF 1K. H207 08747001 SPACE 08748001 SLDA R0,22 DIVIDE SIZE BY 1K H207 08749001 LTR RA,RA IS REMAINDER ZERO H207 08750001 BC BZ,MESSOUT BRANCH IF YES H207 08751001 AR R0,RC NO,SO ADD 1 TO QUOTIENT H207 08752001 SPACE 08753001 MESSOUT CVD R0,SIZE PUT INTO PACKED DECIMAL H207 08754001 ED SZEPAT(4),SIZE+6 EDIT SIZE INTO MESSAGE H207 08755001 LA RA,SZEMES H207 08756001 ST RA,PAR1(0,DR) H207 08757001 L LR,ZUPLOF(0,CR) PRINT SIZE MESSAGE H207 08758001 BALR RR,LR H207 08759001 * ----------------------------------------------------AK 018-TSS 08759520 EJECT 08760001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 004-TSS 08780020 * CALCULATE THE TIME ELAPSED FOR THIS COMPILATION 08800013 * 09000013 TIMER XR R0,R0 20221 09080001 AIF (NOT &STD).ASMO5 09100064 LA DR,AKSAVE POINT AT SAVE AREA 09120064 .ASMO5 ANOP 09140064 TTIMER CANCEL 20221 09160001 AIF (NOT &STD).ASMO6 09180064 L DR,DRSAVE POINT AT DICTIONARY 09200064 .ASMO6 ANOP 09220064 LTR R0,R0 DOES INTERVAL TIMER EXIST..20221 09240001 BZ TIME2 BRANCH IF NOT. 20221 09320001 L RA,TIMEOF(RI) LOAD ORIG TIME INTERVAL 09400015 SR RA,R0 FIND ELAPSWD TIME IN UNITS OF 09600015 * 26 MICROSECONDS 09800015 XR R0,R0 10000015 M R0,TW6 MULT BY 26 10200015 D R0,SIXHTH HENCE TIME IN HUNDREDTH OF MINUTES 10400015 CVD RA,TIME PUT INTO PACKED DECIMAL 11000013 MVC TIMEMES(11),EDTWRD PUT EDIT WORD IN MESSAGE 11200013 ED TIMEMES(11),TIME+3 EDIT TIME INTO MESSAGE 11400013 * ----------------------------------------------------AK 004-TSS 11450020 LA RA,ENDMES 11600013 ST RA,PAR1(0,DR) 11800013 L LR,ZUPLOF(0,CR) PRINT TIME MESSAGE 12000013 BALR RR,LR 12200013 MVI ENDMES+2,C'0' SET SPACING TO 2 LINES. 20221 12210001 TIME2 MVC ENDMES2(7),ELAP MOVE 'ELAPSED' INTO MESSG. 20221 12220001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 012-TSS 12225001 AIF (NOT &STD).ASMO7 12226064 LA DR,AKSAVE POINT AT SAVE AREA 12227064 .ASMO7 ANOP 12228064 TIME BIN 12230001 AIF (NOT &STD).ASMO8 12232064 L DR,DRSAVE POINT AT DICTIONARY 12234064 .ASMO8 ANOP 12236064 L RA,TIMEOF2(0,RI) LOAD INITIAL TIME INTO RA. 20221 12240001 CR RA,R0 20221 12250001 BC BNH,ELAPSED PRINT 20221 12260001 S RA,H24 20221 12270001 ELAPSED SR RA,R0 ELAPSED 20221 12280001 LPR RA,RA 20221 12290001 XR R0,R0 TIME. 20221 12300001 D R0,SIXTY 20221 12310001 CVD RA,TIME 20221 12320001 MVC TIMEMES(11),EDTWRD 20221 12330001 ED TIMEMES(11),TIME+3 20221 12340001 * ----------------------------------------------------AK 012-TSS 12345001 LA RA,ENDMES 20221 12350001 ST RA,PAR1(0,DR) 20221 12360001 L LR,ZUPLOF(0,CR) 20221 12370001 BALR RR,LR 20221 12380001 SPACE 4 12400013 * 12600013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 016-TSS 12660020 * ----------------------------------------------------AK 016-TSS 12720020 INTRUPT EQU * 12800013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 014-TSS 12860001 * ----------------------------------------------------AK 014-TSS 12920001 SPACE 4 13000013 * PICK UP >WITCHES AND FLAGS BEFORE DICTIONARY DISAPPEARS 13200013 * 13400013 L RA,CCCODE(0,DR) SAVE CCCODE 13600013 ST RA,CCDSAVE IN CCDSAVE 13800013 SPACE 4 14000013 * CLOSE ALL FILES 14200013 * 14400013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 005-TSS 14500020 CLSFILE TM CCCODE+3(DR),X'08' 14600013 BC BO,CLSSPIL IF YES CLOSE SPILL FILE ONLY 14800013 * ----------------------------------------------------AK 005-TSS 14810020 NCR2 EQU * PTM825 14820001 L RB,GENSWOF(RI) POINT AT SWITCH 14850015 MVI 0(RB),X'00' TURN OFF IF NOT BTCHNG 14900015 MVC DICSV(1),DICTP(DR) SAVE DIC TYPE 14950015 * * 15000013 * 15200013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 006-TSS 15300001 USING IHADCB,RD 15400013 SR RB,RB CLEAR RB 15600013 SR RC,RC CLEAR RC 15800013 NXDCB EX RC,LRD(RB) LOAD ADDR OF REQD DCB 16000013 TM DCBOFLGS,X'10' TEST IF DCB IS OPEN 16200013 BC BZ,NOPN BRANCH IF NOT OPEN 16400013 AIF (NOT &STD).ASMO9 16440064 ST DR,THISDR 16480064 LA DR,AKSAVE POINT AT SAVE AREA 16520064 .ASMO9 ANOP 16560064 CLOSE ((RD),) CLOSE DCB 16600013 FREEPOOL (RD) 16800013 AIF (NOT &STD).ASMO9B 16850064 L DR,THISDR 16900064 .ASMO9B ANOP 16950064 NOPN LA RB,4(0,RB) BUMP REG. RB FOR NEXT DCB 17000013 BC B,NXDCB 17200013 LRD L RD,PLDCBOF(RI) LOAD ADDRESS OF PLDCB 17400013 L RD,SYPDCBOF(RI) LOAD ADDRESS OF SYPDCB 17600013 L RD,LFDCBOF(RI) LOAD ADDRESS OF LFDCB 17800013 L RD,RDDCBOF(RI) LOAD ADDRESS OF RDDCB 18000013 BC B,CLSSPIL 18200013 DROP RD 18400013 * 18600013 USING IHADCB,RD 18800013 CLSSPIL L RD,SPDCBOF(RI) POINT AT SPILL DCB 19000013 AIF (NOT &STD).ASMO10A 19040064 ST DR,THISDR 19080064 LA DR,AKSAVE 19120064 .ASMO10A ANOP 19160064 TM DCBOFLGS,X'10' IS IT OPEN 19200013 BC BZ,DNTCLS 19400013 CLOSE ((RD)) 19600013 TM 23(RD),X'01' SEE IF ANY BUFFERS USED 19800013 BC BO,DNTCLS IF NOT, DO NOT ISSUE FREEPOOL 20000013 FREEPOOL (RD) 20200013 DROP RD 20400013 * ----------------------------------------------------AK 006-TSS 20440001 DNTCLS L RA,GENSWOF(0,RI) PTM825 20480001 AIF (NOT &STD).ASMO10 20500064 L DR,THISDR 20520064 .ASMO10 ANOP 20540064 TM 1(RA),X'F0' IF ON NO COMM-REGION PTM825 20560001 BO NOCHER PTM825 20640001 TM CCCODE+2(DR),X'40' IF ON CHK NOT SPECIFIED PTM825 20720001 BC BO,NOCHER 20800013 TM ERCODE+3(DR),X'10' TEST FOR TERMINAL ERROR 21000013 BC BZ,NOCHER 21200013 MVI NOCHER,X'00' MAKE INVALID OP 21400013 * 21600013 * 21800013 * WE NOW FREE ALL THE CORE ALLOCATED TO THE COMPILER 22000013 * DURING THE COMPILATION. THIS WILL EASE THE PROBLEM OF 22200013 * MULTIPLE PROCEDURE COMPILATIONS. THE LINK FROM ONE PROCEDURE 22400013 * TO THE NEXT WILL OCCUR IN PHASE YX 22600013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 019-TSS 22700020 * 22800013 NOCHER L RB,PDOF(0,RI) POINT AT PHASE DIRECTORY 23000013 * 23200013 PHSLOOP TM 2(RB),X'F4' SEE IF HAS BEEN LOADED 23400013 BC BO,TESTDEL 23600013 NXTPHS LA RB,12(0,RB) BUMP TO NEXT PHASE IN PD 23800013 CLI 0(RB),X'00' TEST FOR END OF PD 24000013 BC BNE,PHSLOOP 24200013 BC B,SOMWAR 24400013 * 24600013 TESTDEL TM 2(RB),X'08' SEE IF IT HAS BEEN DELETED 24800013 BC BO,NXTPHS 25000013 * ----------------------------------------------------AK 019-TSS 25100020 MVC DELPHS+3(2),0(RB) PUT NAME INTO DELETE SLOT 25200013 LA R0,DELPHS 25400013 * 25600013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 007-TSS 25700020 AIF (NOT &STD).ASMO11 25720064 ST DR,THISDR 25740064 LA DR,AKSAVE POINT AT SAVE AREA 25760064 .ASMO11 ANOP 25780064 DELETE EPLOC=(0) 25800013 AIF (NOT &STD).ASMO12 25850064 L DR,THISDR 25900064 .ASMO12 ANOP 25950064 * 26000013 BC B,NXTPHS 26200013 * ----------------------------------------------------AK 007-TSS 26300020 * 26400013 SOMWAR CLI TERMSW(DR),X'FF' SEE IF EARLY TERMINATION 26500015 BC BE,BLKFRE DONT FREE SCRATCJ IF SO 26600015 L RB,CONCNTOF(RI) LOAD NUMBER OF SCRATCH ALLOCS 26700015 L RB,0(RB) OUTSTANDING 26800013 LTR RB,RB SEE IF ZERO 27000013 BC BZ,FRESCR 27200013 * 27400013 * 27600013 ST RB,PAR1(0,DR) SET UP TO FREE SCRATCH CORE 27800013 L LR,ZURCOF(0,CR) 28000013 BALR RR,LR 28200013 * 28400013 FRESCR L RA,ALLOCAOF(0,RI) PICK UP ADDRESSES OF 28600013 L RB,ALLOCLOF(0,RI) ADDR OF SCRATCH CORE AND LENGTH 28800013 L RA,0(0,RA) AND HENCE VALUES 29000013 L R0,0(0,RB) THEMSELVES 29200013 LTR RA,RA IF NO ADDR DO NOT ISSUE FREEMAIN PTM825 29260001 BC BZ,BLKFRE PTM825 29320001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 001-TSS 29360020 AIF (NOT &STD).ASMO13 29368064 ST DR,THISDR 29376064 LA DR,AKSAVE POINT AT SAVE AREA 29384064 .ASMO13 ANOP 29392064 FREEMAIN R,LV=(0),A=(1) FREE INITIAL ALLOCATION 29400013 AIF (NOT &STD).ASMO14 29420064 L DR,THISDR 29440064 .ASMO14 ANOP 29460064 * ----------------------------------------------------AK 001-TSS 29500020 * 29600013 BLKFRE L RA,GENSWOF(0,RI) PTM825 29680001 TM 1(RA),X'F0' IF ON NO COMM-REGION PTM825 29760001 BO NCR4 PTM825 29840001 AIF (&STD).ASMO15A 29880064 L R0,DICTSZ(DR) PICK UP BLOCK SIZE PTM825 29920001 .ASMO15A ANOP 29960064 L RB,TSLOTSOF(0,RI) POINT AT LIST OF TEXT BLOCKS 30000013 * 30200013 LH RE,DICTSZ+2(DR) PICK UP BLOCK SIZE 54703 30300064 TESTUSE CLI 0(RB),X'FF' SEE IF BLOCK IN USE 30400013 BC BE,NOTUSE 30600013 TM 0(RB),X'80' SEE IF BLOCK IN CORE 30800013 BC BO,INCORE 31000013 NOTUSE MVI 0(RB),X'FF' SET SLOTS FREE 31200013 LA RB,4(0,RB) BUMP TO NEXT SLOT 31400013 CLI 1(RB),X'FF' TEST FOR STOPPER IN LIST 31600013 BC BNE,TESTUSE 31800013 * 32000013 SWBRC BC NOP,MVSTOP 32200015 MVI SWBRC+1,X'F0' TURN TO PERMANENT BRANCH 32400013 L RB,DSLOTSOF(RI) POINT AT DSLOTS 32600013 TM CCCODE+3(DR),X'08' BATCHING 32800013 BC BZ,TESTUSE 33000013 LA RB,4(0,RB) DO NOT RELEASE FIRST IF BATCHING 33200013 BC B,TESTUSE 33400013 * 33600013 INCORE L RA,0(0,RB) PICK UP ADDRESS OF BLOCK 33800013 AIF (NOT &STD).ASMO15 34000064 LR R0,RE PICK UP BLOCK SIZE 54703 34020064 ST DR,THISDR 34040064 LA DR,AKSAVE POINT AT SAVE AREA 34060064 .ASMO15 ANOP 34080064 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 002-TSS 34100001 FREEMAIN R,LV=(0),A=(1) FREE BLOCK 34200013 AIF (NOT &STD).ASMO16 34220064 L DR,THISDR 34240064 .ASMO16 ANOP 34260064 * ----------------------------------------------------AK 002-TSS 34300001 BC B,NOTUSE 34400013 * 34600013 * IF BATCHING, DELETE STOPPER IN DICT CONTROL AREA 34620015 MVSTOP TM CCDSAVE+3,X'08' TEST IF BATCHING 34640015 BC BZ,RELBLK BRANCH IF NOT 34660015 L RB,DSLOTSOF(RI) POINT AT DICT CNTL AREA 34680015 STPLOP LA RB,4(0,RB) BUMP TO NEXT SLOT 34700015 CLC 0(4,RB),STOPPER IS THIS THE STOPPER 34720015 BC BNE,STPLOP BRANCH IF NOT 34740015 SR RC,RC CLEAR RC 34760015 ST RC,0(0,RB) HENCE CLEAR SLOT 34780015 MVI 0(RB),X'FF' SHOW SLOT NOT USED 34790015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 017-TSS 34793020 * ----------------------------------------------------AK 017-TSS 34796020 * 34800013 * RELEASE UNUSED CONTENTS OF BLKTBL 35000013 * 35200013 RELBLK LA RC,10 SET BLOCK ENTRY COUNT 35400015 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 003-TSS 35500001 L RB,BLKOF(0,RI) POINT AT BLKTBL 35600013 NXTFRE CLI 0(RB),X'FF' TEST FOR A USEFUL ENTRY 35800013 BC BE,NOUSE BRANCH IF NO USE 36000013 L RA,0(0,RB) LOAD ADDR OF UNUSED BLOCK 36200013 AIF (NOT &STD).ASMO17 36230064 LR R0,RE PICK UP BLOCK SIZE 54703 36260064 ST DR,THISDR 36290064 LA DR,AKSAVE POINT AT SAVE AREA 36320064 .ASMO17 ANOP 36350064 FREEMAIN R,LV=(0),A=(1) FREE THE BLOCK 36400013 AIF (NOT &STD).ASMO18 36450064 L DR,THISDR 36500064 .ASMO18 ANOP 36550064 MVI 0(RB),X'FF' SHOW BLOCK RELEASED 36600013 NOUSE LA RB,4(0,RB) BUMP TO NEXT ENTRY 36800013 BCT RC,NXTFRE LOOP IF ANY ENTRIES LEFT 37000013 * ----------------------------------------------------AK 003-TSS 37100001 SPACE 37200013 TM CCDSAVE+3,X'08' TEST IF BATCHING 37400013 BC BZ,NOTBTNG 37600013 TM CCCODE+2(DR),X'20' WAS LAST SOURCE CODE BCD? H454 37607020 BZ NOTBCD NO H454 37614020 L RC,TAB1OF(RI) PICK UP ADDRESS OF EBCDID H454 37621020 MVC 0(256,RC),TAB1 TRANSLATION TABLE IN AA AND H454 37628020 * RESET TABLE VALUES H454 37635020 NOTBCD EQU * H454 37642020 LM R2,R3,UT3OF(RI) RECONS ERROR MESSAGE H452 37650020 MVC 0(3,R2),ERRF14 CONSTANTS. H452 37700020 MVC 0(7,R3),ERRMES H452 37750020 * THIS ROUTINE SCANS THE OPTIONS FIELD ON THE *PROCESS CARD 37800013 * TO CHECK FOR SYNTACTICAL ERRORS. IT LOADS THE START ADDRESS 38000013 * (STADDR) AND STRING LENGTH (STRLNG) INTO THE 38200013 * COMMUNICATIONS REGION FOR USE BY THE OPTIONS SCANNER 38400013 * IN IEMAB 38600013 L R1,BTCHOF(0,RI) POINT AT *PROCESS RECORD 38800013 SR R3,R3 CLEAR R3 39000013 IC R3,PARMLEN(0,DR) LOAD RECORD LENGTH IN R3 39200013 AR R3,R1 POINT TO 39400013 BCTR R3,0 END OF RECORD 39600013 LA R2,1(0,0) SET UP UNIT REGISTER 39800013 BAL RR,BAT1 WEED OUT BLANKS 40200015 CLC 0(7,R1),PROCES DO WE HAVE 'PROCESS' 40600013 BC BNE,BAT4 BRANCH IF NO 'PROCESS' 40800013 LA R1,6(R1) BUMP SCANNER 41000013 BAL RR,BAT1 WEED OUT BLANKS 41600015 CLI 0(R1),C';' IS IT A ; 41800013 BC BE,BAT5 42000013 CLI 0(R1),C'(' IS IT A ( 42200013 BC BNE,BAT4 BRANCH IF NO ( 42400013 BAL RR,BAT1 WEED OUT BLANKS 42600015 CLI 0(R1),C'''' IS IT A ' 42800013 BC BNE,BAT4 43000013 ST R1,POINTSAV SAVE POINTER 43200013 TRYAGN BXH R1,R2,BATMESS BRANCH IF SCAN OFF END 43400013 CLI 0(R1),C'''' TEST FOR CLOSING QUOTE 43600013 BC BNE,TRYAGN 43800013 ST R1,ENDSAV SAVE POINTER 44000013 BAL RR,BAT1A WEED OUT BLANKS 44200015 CLI 0(R1),C')' IS IT ) 44400013 BC BNE,BATMESS1 BRANCH IF NOT ) 44600013 BAL RR,BAT1A WEED OUT BLANKS 44800015 CLI 0(R1),C';' 45000013 BC BNE,BATMESS1 45200013 L R1,ENDSAV SYNTAX CORRECT-- 45400013 BCTR R1,0 45600013 S R1,POINTSAV SAVE 45800013 STC R1,PARMLEN(0,DR) INFORMATION 46000013 L R1,POINTSAV FOR USE IN 46200013 ST R1,PAR4(0,DR) OPTION SCANNER IN IEMAB 46400013 MVI BERSW(DR),X'00' TURN OFF ERROR SWITCH 46600013 BC B,NOTBTNG 46800013 * 46810015 * 46820015 BAT1 BXH R1,R2,BAT4 BRANCH IF OFF END 46830015 CLC 0(1,R1),BLANK IS IT A BLANK 46840015 BC BE,BAT1 BRANCH IF SO 46850015 BCR BR,RR RETURN 46860015 * 46870015 * 46880015 BAT1A BXH R1,R2,BATMESS1 BRANCH IF OFF END 46890015 CLC 0(1,R1),BLANK IS IT BLANK 46900015 BC BE,BAT1A BRANCH IF SO 46910015 BCR BR,RR RETURN 46920015 * 46930015 * 46940015 BATMESS1 L R3,ENDSAV POINT R3 AT 47000013 BCTR R3,0 END OF RECORD 47200013 BATMESS MVI BERSW(DR),X'F0' PUT ERROR SWITCH HALF ON 47400013 L R1,POINTSAV 47600013 SR R3,R1 47800013 STC R3,PARMLEN(0,DR) STORE STRING LENGTH 48000013 ST R1,PAR4(0,DR) START ADDR IN PAR4 48200013 BC B,NOTBTNG 48400013 BAT4 MVI BERSW(DR),X'FF' PUT ERROR SWITCH FULL ON 48600013 BC B,ZEROLEN 48800013 BAT5 MVI BERSW(DR),X'00' TURN OFF ER SWITCH 49000013 ZEROLEN MVI PARMLEN(DR),X'00' CLEAR PARMLEN FOR DEFAULT OPTS 49200013 * 49400013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 024-TSS 49500021 NOTBTNG TM CCDSAVE,X'80' IF DUMP IS REQUESTED THEN 49600013 BC BZ,DELAD DELETE IEMAD 49800013 AIF (NOT &STD).ASMO19 49850064 LA DR,AKSAVE POINT AT SAVE AREA 49900064 .ASMO19 ANOP 49950064 DELETE EP=IEMAD 50000013 XC ZUST(4,CR),ZUST(CR) CLEAR DUMP SLOT IN AA 50040001 * 50080001 DELAD TM CCDSAVE+3,X'02' IF TRACE REQUESTED THEN 50120001 BC BZ,DELAT DELETE IEMAT 50160001 AIF (NOT &STD).ASMO20 50170064 LA DR,AKSAVE POINT AT SAVE AREA 50180064 .ASMO20 ANOP 50190064 DELETE EP=IEMAT 50200001 L R1,PAROF(CR) RECONSTRUCT AA TO NORMAL 50240001 L R3,INPIH(R1) 50280001 MVI 1(R3),X'F0' 50320001 L R3,INRELS(R1) 50360001 MVI 1(R3),X'F0' 50400001 L R3,INLOAD(R1) 50440001 MVI 1(R3),X'F0' 50480001 * 50520001 * ----------------------------------------------------AK 024-TSS 50540021 DELAT TM CCDSAVE+3,X'08' ARE WE BATCHING 50560001 LA LR,4 SET RETURN OFFSET FOR BATCHING 50600013 * (TO BE RESET IF NOT BATCHING) 50800013 BC BO,RETRN 51000013 NCR4 EQU * PTM825 51100001 L RA,KEEPOF(RI) 51200013 L DR,4(0,RA) 51400013 * 51600013 * CHECK TO SEE IF A PAGE NUMBER WAS PASSED TO THE COMPILER. 51800013 * ON INVOCATION. IF IT WAS THEN THE CURRENT PAGE NUMBER IS 52000013 * BUMPED BY 1 AND THE RESULT INSERT INTO THE PAGE NUMBER FIELD 52200013 * IN THE INVOCATION LIST. THE PAGE NUMBER IS CONVERTED FROM 52400013 * PACKED DECIMAL TO BINARY. IT IS NOT STORED ON A WORD BOUNDARY. 52600013 * 52800013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 011-TSS 52900001 L RA,24(0,DR) PICK UP RA ON ENTRY TO COMPILER 53000013 TM 0(RA),X'80' TEST FOR END IN LIST 53200013 BC BO,ENDLST 53400013 LA RA,4(0,RA) BUMP TO NEXT ADDRESS IN LIST 53600013 TM 0(RA),X'80' 53800013 BC BO,ENDLST 54000013 LA RA,4(0,RA) RA NOW POINTS AT PAGE NUMBER 54200013 L RA,0(0,RA) ADDRESS. PICK UP THE ADDRESS 54400013 LTR RA,RA SEE IF ADDRESS IS ZERO. IF IT IS 54600013 BC BZ,ENDLST THEN NO PAGE NUMBER EXISTS. 54800013 * 55000013 L RB,PAGNOOF(RI) 55200013 AP 0(3,RB),ONEPK BUMP PAGE NUMBER BY ONE 55400013 MVC PAGSAV+5(3),0(RB) AND CONVERT 55600013 CVB RC,PAGSAV TO BINARY 55800013 ST RC,ECDSAVE 56000013 MVC 2(4,RA),ECDSAVE STORE IN INVOCATION LIST 56200013 * 56400013 * ----------------------------------------------------AK 011-TSS 56420001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 021-TSS 56430020 ENDLST EQU * 56450064 AIF (NOT &STD).ASMO21 56460064 LA DR,AKSAVE POINT AT SAVE AREA 56470064 .ASMO21 CLI DICSV,X'00' IS IT NORMAL DIC 56480064 BC BNE,DELAL BRANCH IF BIGDIC 56500015 DELETE EP=IEMAN DELETE AN IF NOT BTCHG 56550015 BC B,RET0 56600015 DELAL DELETE EP=IEMAL DELETE AL IF NOT BTCHG 56650015 * ----------------------------------------------------AK 021-TSS 56670020 RET0 LA LR,0 SET FOR RETURN 56700015 RETRN LA DR,AKSAVE POINT DR AT AK SAVE AREA 56800013 L DR,4(0,DR) POINT AT PREVIOUS SAVE AREA 57000013 LM 0,11,20(13) RELOAD 57200013 L 14,12(13) AA REGISTERS 57400013 BCR BR,RR RETURN TO CONTROL PHASE 57600013 EJECT 57610042 *** AK PROGRAM INTERRUPT HANDLER. *** 35228 57620042 SPACE 1 57630042 AKPIH SR RC,RC 35228 57640042 IC RC,7(0,1) PICK UP INTERRUPT TYPE 35228 57650042 CVD RC,INTEMP 35228 57660042 AIF (NOT &STD).ASMO22 57662064 LA DR,AKSAVE POINT AT SAVE AREA 57664064 .ASMO22 ANOP 57666064 UNPK PIMSG+8+50(2),INTEMP+6(2) INSERT TYPE IN MSG. 35228 57670042 OI PIMSG+8+51,X'F0' CONVERT TO NUMERIC 35228 57680042 PIMSG WTO 'IEM3854I - COMPILER ERROR. PROGRAM INTERRUPT TYPE ## HA157690042 S OCCURRED IN PHASE AK.',ROUTCDE=(2,11),DESC=6 43462 57700021 LA RT,16 SET RETURN CODE 35228 57710042 B RET0 GET OUT 35228 57720042 EJECT 57730042 * 57800013 * REGISTER EQUS 58000013 * 58200013 R0 EQU 0 58400013 R1 EQU 1 58600013 R2 EQU 2 58800013 R3 EQU 3 59000013 RA EQU 1 59200013 RB EQU 2 59400013 RC EQU 3 59600013 RD EQU 5 59800013 RE EQU 6 54703 59900064 BASE EQU 8 60000013 RI EQU 4 60200013 RR EQU 14 60400013 LR EQU 15 60600013 CR EQU 11 60800013 DR EQU 13 61000013 RT EQU 12 61200013 * 61400013 B EQU 15 61600013 BNZ EQU 7 61800013 BO EQU 1 62000013 BNH EQU 13 62200013 BZ EQU 8 62400013 BNE EQU 7 62600013 BH EQU 2 62800013 BNL EQU 11 63000013 BE EQU 8 63200013 BL EQU 4 H207 63300001 NOP EQU 0 63400013 BR EQU 15 63600013 * 63800013 * OFFSETS FROM INITIALISATION LIST 64000013 * 64200013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 020-TSS 64260020 * ----------------------------------------------------AK 020-TSS 64320020 TSLOTSOF EQU 8 64400013 DSLOTSOF EQU 12 64600013 ALLOCAOF EQU 0 64800013 ALLOCLOF EQU 4 65000013 CONCNTOF EQU 108 65200013 PLDCBOF EQU 20 65400013 SYPDCBOF EQU 52 65600013 LFDCBOF EQU 48 65800013 SPDCBOF EQU 40 66000013 RDDCBOF EQU 16 66200013 PDOF EQU 28 66400013 KEEPOF EQU 112 66600013 TIMEOF EQU 120 66800013 BTCHOF EQU 132 67000013 GENSWOF EQU 128 67200013 ERCSVOF EQU 136 67400013 PAGNOOF EQU 80 67600013 BLKOF EQU 100 67800013 TIMEOF2 EQU 152 ELAPSED TIMER. 20221 67900001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 010-TSS 67906001 * ----------------------------------------------------AK 010-TSS 67912001 INPIH EQU 164 67920001 INRELS EQU 168 67940001 INLOAD EQU 172 67960001 CORSZOF EQU 176 COMPILER CORE REQUIREMENT H207 68040001 TAB1OF EQU 64 TRANSLATION TABLE OFFSET H454 68041020 * H454 68042020 * TRANSLATION TABLE FROM EBCDIC EXTERNAL CODE TO COMPILER H454 68043020 * INTERNAL CODE. IF PREVIOUS COMPILATION IN BATCH SPECIFIED H454 68044020 * BCD THEN EBCDIC TRANSLATION TABLE IN AA IS RESET. H454 68045020 * H454 68046020 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 026-TSS 68046521 TAB1 DC XL16'4C4E505C5D5E5FF4616C6E0B0C0D0E0F' H454 68047020 * ----------------------------------------------------AK 026-TSS 68047521 DC XL16'7C7A7D7EC1C2C3C4C5C61A1B1C1D1E1F' H454 68048020 DC XL16'7BC7C8C9D1D2D3D4D5D62A2B2C2D2E2F' H454 68049020 DC XL16'5B31D7D8D9E2E3E4E5E63A3B3C3D3E3F' H454 68050020 DC XL16'40E7E8E944F0F147F249F3466F43754B' H454 68051020 DC XL16'4D5152535455565758595A307945EF4F' H454 68052020 DC XL16'737762636465666768696A414A0A6D60' H454 68053020 DC XL16'707172F574F676F778F8482010426B7F' H454 68054020 DC XL16'808182838485868788898A8B8C8D8E8F' H454 68055020 DC XL16'909192939495969798999A9B9C9D9E9F' H454 68056020 DC XL16'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF' H454 68057020 DC XL16'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' H454 68058020 DC XL16'C0111213141516171819CACBCCCDCECF' H454 68059020 DC XL16'D0212223242526272829DADBDCDDDEDF' H454 68060020 DC XL16'E0E13233343536373839EAEBECEDEEF9' H454 68061020 DC XL16'00010203040506070809FAFBFCFDFEFF' H454 68062020 UT3OF EQU 72 H452 68080020 * 68120001 * SAVED SWITCHES AND FLAGS 68200013 * 68400013 ECDSAVE DC F'0' 68600013 PAGSAV DC D'0' 68800013 INTEMP EQU PAGSAV 35228 68850042 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 008-TSS 68900001 AKSAVE DS 18F 69000013 * ----------------------------------------------------AK 008-TSS 69100001 AIF (NOT &STD).ASMO23 69120064 THISDR DS F 69140064 .ASMO23 ANOP 69160064 DRSAVE DS F 69200013 CCDSAVE DS F 69400013 POINTSAV DS F 69600013 ENDSAV DS F 69800013 DICSV DC X'00' 69860015 STOPPER DC X'00FF0000' 69920015 ERRF14 DC X'0F1408' H452 69921020 ERRMES DC C'IEM3860' H452 69922020 SPACE 69924001 * DICTSPIL CONSTANTS H207 69928001 SPACE 69932001 F1K DC F'1024' H207 69936001 F3K DC F'3072' H207 69940001 F6K DC F'6144' H207 69944001 F8K DC F'8192' H207 69948001 F16K DC F'16384' H207 69952001 F73K DC F'74752' H207 69956001 DS 0D H207 69960001 SIZE DC 2F'0' H207 69964001 SZEMES DC X'004260' H207 69968001 DC C'AUXILIARY STORAGE WILL NOT BE USED FOR' H207 69972001 DC C' DICTIONARY WHEN SIZE =' H207 69976001 SZEPAT DC X'40202020' H207 69980001 DC C'K' H207 69984001 T1FL DC X'FF' H207 69988001 * 70000013 * TIMER CONSTANTS 70200013 * 70400013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 013-TSS 70500001 H24 DC A(24*60*60*100) 70600013 SIXHTH DC F'600000' 70700015 TW6 DC F'26' 70800015 DS 0D 71000013 TIME DC 2F'0' 71200013 ENDMES DC X'001D60' 71400015 ENDMES2 DC C'COMPILE TIME ' 20221 71600001 TIMEMES DC X'40202020202020214B2020' 71800013 DC C' MINS' 72000013 EDTWRD DC X'40202020202020214B2020' 72200013 SIXTY DC F'60' 20221 72260001 * ----------------------------------------------------AK 013-TSS 72290001 ELAP DC C'ELAPSED' 20221 72320001 * 72400013 * 72600013 * OFFSETS FROM TRANSFER VECTOR 72800013 * 73000013 * 73200013 ZUPLOF EQU 8 73400013 PAROF EQU 28 73600013 DADOF EQU 44 73800013 ZURCOF EQU 24 74000013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 015-TSS 74030001 * ----------------------------------------------------AK 015-TSS 74060001 ZUST EQU 76 DUMP ROUTINE ADDRESS 74100001 * 74200013 * OFFSETS IN COMMUNICATIONS REGION 74400013 * 74600013 PAR1 EQU 128 74800013 BERSW EQU 190 75000013 IOERSW EQU 191 75200013 PARMLEN EQU 197 75400013 PAR4 EQU 140 75600013 TERMSW EQU X'B0' 75700015 ERCODE EQU 224 75800013 CCCODE EQU 232 76000013 DICTSZ EQU 260 76200013 PERRSW EQU 189 76400013 DICTP EQU 116 76500015 OFDNAM EQU 178 H207 76550001 * 76600013 PROCES DC C'PROCESS' 76800013 BLANK DC C' ' 77000013 DELPHS DC CL8'IEM' 77200013 ONEPK DC X'00001F' 77400013 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AK 009-TSS 77500001 DCBD DSORG=(BS),DEVD=DA 77600013 * ----------------------------------------------------AK 009-TSS 77700001 END 77800013 ./ ADD SSI=22010241,NAME=IEMAL,SOURCE=0 GBLB &STD 00010021 &STD SETB 1 00020021 AL TITLE 'IEMAL,RESIDENT CONTROL PHASE,LARGE DICTIONARY,PL/I COMP*00030001 ILER(F)' 00060001 * STATUS - CHANGE LEVEL 0 00120072 * 00120372 * 5.5 C 096300-101700,225300,226800,518700-519600 MCB 62615 00120672 * 5.5 C 202800-202900 KT 60039 00120972 * 5.5 C 447600,449100,449400-450600,453600-456000 KT 60037 00121272 * 5.5 A 088780 MCB 60026 00121572 * 5.4 C 202800. MAC 52214 00122321 * 5.4 A 000000,497400. MCB 54703 00122421 * 5.3B C 188100. MCB/MAC 47635 00122656 * 5.3B A 312750. ADDITION TO R20.0 FIX FOR A32318. MAC 47635 00123256 * 5.3B C 696300 PJMG 45901 00124056 * 5.3A C 312580-312850 JLC 43391 00126056 * 5.2 A 203400,203700,247900,248100,756300 JLC 33893 00128056 * 5.2 A 061800,248700,311700,555000,760900 JRT 32318 00130056 * C 019800-020400,069000,247800-248100,309000,310200, JRT 32318 00132056 * 312600,339900,341700,358800,360000,554400 JRT 32318 00134056 * D 260400,376200-378000,567900 JRT 32318 00136056 * 5.2 A 293700 JRT 30357 00138056 * C 363900 JRT 30357 00140056 * 00142056 * R18 087000,124500,530400,716400,726400 H244 00150001 * R18 DUPLICATE OF H244 23556 00180001 * R18 243200* 23286 00210001 * R18 864800-865200,865000 H268 00240001 * R18 499200,501600-508200,594370,611400,612900,760900 H319 00250001 * R18 870000 20706 00270056 EJECT 00297046 SPACE 3 00305020 * FUNCTIONS - 1)COMPILER INITIALISATION. IEMAB IS LOADED 00330001 * IN ORDER TO PERFORM THIS FUNCTION 00360001 * 2)CHARACTER TRANSLATION. EBCIDIC OR BCD TO 00390001 * INTERNAL AND BACK TO EXTERNAL. THE RELEVANT TABLE IS SUPPLIED 00420001 * DEPENDING UPON THE OPTION 00450001 * 3)DICTIONARY AND TEXT BLOCK CONTROL. THESE 00480001 * INCLUDE,EVENTUALLY,THE SPILLING OF BLOCKS ONTO SYSUT1 AND THE 00510001 * CONTROL THEREOF. 00540001 * 4)PHASE LOADING. FACILITIES ARE ALLOWED FOR 00570001 * MARKING PHASES,LOADING PHASES AND RETURNING CONTROL TO THE 00600001 * CALLER,DELETING(RELEASING) PHASES AND PASSING CONTROL TO A NEW 00630001 * PHASE. 00660001 * 5)INPUT/OUTPUT CONTROL ONTO SYSPRINT,SYSIN, 00690001 * SYSLIN AND SYSPUNCH. CONTROL TO SYSUT3 IN IEMAC 00720001 * 00750001 * 00780001 * ENTRY POINT - THE CONTROL PHASE HAS A MULTITUDE OF ENTRY 00810001 * POINTS. THE ARE LISTED IN THE TRANSFER VECTOR AT THE START OF 00840001 * THE PHASE 00870001 * 00900001 * 00930001 * INPUT - ONLY INPUT IS THE PARAMETER LIST POINTED AT BY 00960001 * GENERAL REGISTER 1 ON ENTRY 00990001 * 01020001 * 01050001 * OUTPUT - THE ONLY OUTPUT GENERATED BY THE COMPILER IS 01080001 * THE RETURN CODE PLACED IN GENERAL REGISTER 15 ON COMPLETION OF 01110001 * THE COMPILATION 01140001 * 01170001 * 01200001 * EXTERNAL ROUTINES - 1)IEMAB THE COMPILER INITIALISER. IT 01230001 * IS LOADED IMEDIATELY AFTER IEMAA HAS BEEN LOADED. 01260001 * 2)IEMAC. THE INTERMEDIATE FILE 01290001 * CONTROL. RECORDS ARE WRITTEN ON SYSUT3 AND THE READ BACK. 01320001 * 3)IEMAD. INTER-PHASE DUMPING CONTROL 01350001 * TESTRAN IS USED 01380001 * 5)IEMAF. GENERATED BY SYSGEN. IT 01410001 * WILL INDICATE THE STATUS OF THE DEFAULT OPTIONS 01440001 * 6)IEMAG. SYSUT3 FILE SWITCHING. IT 01470001 * IS CALLED BY IEMAC. 01500001 * 4)IEMAE. CLEAN-UP AFTER READIN AND 01530001 * OPEN SYSLIN AND SYSPUNCH IF NECESSARY 01560001 * 01590001 * 01620001 * EXITS - THE EXIT IS THROUGH ZEND. IT IS THERE THAT THE 01650001 * CONDITION CODE IS PICKED UP. THERE ARE NO ABNORMAL EXITS. 01680001 * 01710001 * 01740001 * ATTRIBUTES - THIS CODE IS NOT REUSABLE 01770001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AL 000-TSS 01780020 * ----------------------------------------------------AL 000-TSS 01790020 EJECT 01800001 * 01830001 * BASE THE COMPILER 01860001 * 01890001 SPACE 2 01920001 IEMAL CSECT 01950001 USING *,CNTL2,CNTL3 32318 01990020 BASES DC A(*+4096) ADDRESS IN SECOND BASE REG.32318 02030020 DC A(BASES) 02070001 * 02100001 * THESE ADDRESSES WILL BE MOVED INTO THE TRANSFER VECTOR 02130001 * IN IEMAA BY IEMAB 02160001 * 02190001 TRVEC DC A(ZUPL) SYSPRINT 02220001 DC A(ZURD) SYSIN 02250001 DC A(ZUGC) GET SCRATCH CORE 02280001 DC A(ZUTXTC) GET A TEXT BLOCK 02310001 DC A(ZURC) RELEASE SCRATCH CORE 02340001 DC A(ZDICAB) DICT ENTRY-ALIGNED,ABSOLUTE 02370001 DC A(ZDICRF) -ALIGNED,REFERENCE 02400001 DC A(ZUERR) MAKE AN ERROR MESSAGE ENTRY 02430001 DC A(ZDRFAB) DICTIONARY REFERENCE TO ABSOLUTE 02460001 DC A(ZTXTRF) TEXT POINTER-ABSOLUTE TO REF 02490001 DC A(ZTXTAB) -REF TO ABS 02520001 DC A(ZCHAIN) FIND NEXT TEXT BLOCK IN CHAIN 02550001 DC A(ZALTER) ALTER STATUS OF TEXT BLOCK 02580001 DC A(ZDABRF) DICT-ABS TO REF 02610001 DC A(ZNALRF) DICT ENTRY-UNALIGNED,REF 02640001 DC A(ZNALAB) -UNALIGNED,ABS 02670001 DC A(RECONS) RECONST. INSTRS IN AL 02700001 DC A(ALLOCA) SCRATCH CORE 02730001 DC A(ALLOCL) 02760001 CONSLTT DC A(TSLOTS+24) TEXT ALLOCATION SLOTS 02790001 CONSLDD DC A(DSLOTS+24) DICT ALLOCATION SLOTS 02820001 DC A(HEDING) PAGE HEADING 02850001 DC A(MAXPAG) MAX. PAGE COUNT 02880001 DC A(PAGNO) PAGE NUMBER 02910001 DC A(NUMFRE) NO. FREE TRACKS 02940001 DC A(FRSLOT) LIST FREE TRACKS 02970001 DC A(BLKTBL) 03000001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AL 019-TSS 03030001 DC A(SPILL) 03060001 * ----------------------------------------------------AL 019-TSS 03090001 DC A(CONCNT) 03120001 DC A(BTCHBUF) BATCH CARD FOR PARM SCAN 03150001 DADDR DS F 03180001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AL 027-TSS 03190019 DC A(UTIERR) SYSUT1 ERROR RTN 03210001 * ----------------------------------------------------AL 027-TSS 03220019 DC A(ZURDAB) SYSIN EOF RTN 03240001 DC A(CONSLD) FOR PHASE IEMCC 03270001 BLKTBL DC 10XL4'FF000000' 03300001 EJECT 03330001 * ROUTINE ZDABRF 03360001 * THIS ROUTINE CONVERTS AN ABS ADDR (PAR2) 03390001 * INTO A DIC REF (PAR1). ON ENTRY PAR1 CONTAINS A DIC REF TO THE 03420001 * BLOCK WHICH CONTAINS THE ABS ADDR. 03450001 * IF THE REFERENCED BLOCK IS NOT IN USE, OR IS ON DISC, 03480001 * COMPILATION TERMINATES. 03510001 * THE REFERENCED BLOCK IS ADDED TO THE LAST LOOK TABLE, 03540001 * WHICH IS USED TO DETERMINE WHICH BLOCKS MUST BE KEPT IN CORE. 03570001 * A SPECIAL CASE EXISTS WHEN THE DIC REF IN PAR1 ON ENTRY 03600001 * REFERENCES THE OVERFLOW BLOCK. THIS OFLO REF MUST NOT BE USED 03630001 * (SEE ZAROFR). 03660001 SPACE 2 03690001 * HOUSEKEEPING AND INITIALISATION 03720001 * 03750001 ZDABRF STM 14,10,12(13) SAVE CALLERS REGS 03780001 L CNTL2,BASOF(CNTL) LOAD FIRST BASE REG 03810001 L CNTL3,BASES LOAD SECOND BASE 03840001 ST 13,DICTEM STORE SAVE AREA ADDR 03870001 L DICR,DADDR POINT AT DICT 03900001 SPACE 03930001 * CALL CONSLD TO FIND DSLOT ENTRY FOR REQUIRED BLOCK 03960001 * 03990001 ZARCON BAL RR,CONSLD POINTS GRA AT ADDR SLOT OF BLK 04020001 SPACE 04050001 * TEST IF REFERENCED BLOCK IS IN USE 04080001 * 04110001 CLI 0(GRA),X'FF' 04140001 BC BE,BLKERR NO, DIAGNOSE AND ABORT 04170001 SPACE 04200001 * TEST IF REFERENCED BLOCK IS THE OVERFLOW BLOCK 04230001 * 04260001 CLI OFLOSW,X'FF' TEST IF OFLO EXISTS 04290001 BC BNE,ZARTBC NO, OMIT OFLO BLK TEST 04320001 CL GRA,ZOBSAD(DICR) TEST IF PAR1 REFERENCES OFLO BLK 04350001 BC BE,ZAROFR YES, DECODE OFLO REF TO FIND BLK 04380001 SPACE 04410001 * TEST IF REFERENCED BLOCK IS IN CORE 04440001 * 04470001 ZARTBC TM 0(GRA),X'80' 04500001 BC BZ,ZARERR NO, DIAGNOSE AND ABORT 04530001 SPACE 04560001 * ADD BLOCK REFERENCE TO LAST LOOK TABLE 04590001 * 04620001 ZARALL MVC LASLOK-2(6),LASLOK 04650001 MVC LASLOK+4(2),PAR1+2(DICR) 04680001 SPACE 04710001 * GET ADDRESS OF BLOCK 04740001 * 04770001 L GRA,0(0,GRA) GET ADDR OF DICT BLOCK 04800001 N GRA,STBITS ZERO THE STATUS BYTE 04830001 SPACE 04860001 * CALCULATE ABSOLUTE OFFSET 04890001 * 04920001 L GRB,PAR2(0,DICR) LOAD THE ABSOLUTE ADDRESS 04950001 SR GRB,GRA CALC ABS OFFSET IN BLOCK 04980001 SPACE 05010001 * SET OFFSET SLOT COUNT AND POINT AT OFFSET SLOTS 05040001 * 05070001 A GRA,FONOF(DICR) POINT AT FON 05100001 LH GRC,0(GRA) LOAD FON 05130001 LR GRD,GRC COPY IT 05160001 LA GRE,2(GRA) POINT AT OFFSET SLOTS 05190001 SPACE 05220001 * TEST FOR FON EQUAL TO ZERO 05250001 * 05280001 C GRD,ZEROS 05310001 BC BE,ZARFOS YES, OMIT OFFSET SLOT SEARCH 05340001 SPACE 05370001 * SEARCH OFFSET SLOTS FOR GIVEN ABSOLUTE OFFSET 05400001 * 05430001 ZARNOS LH GRF,0(GRE) LOAD AN OFFSET 05460001 CR GRF,GRB TEST IF REQD OFFSET 05490001 BC BNE,ZARBOS NO, BUMP TO NEXT OFFSET SLOT 05520001 * 05550001 SR GRD,GRC CALC SLOT NO OF REQD OFFSET 05580001 BC B,ZARNDR BRANCH TO MAKE THE DIC REF 05610001 * 05640001 ZARBOS LA GRE,2(GRE) BUMP TO NEXT OFFSET SLOT 05670001 BCT GRC,ZARNOS LOOP TO TEST NEXT OFFSET 05700001 SPACE 05730001 * REQD OFFSET SLOT DOES NOT YET EXIST, ONE MUST BE MADE. 05760001 * TEST IF ROOM IN OFFSET SLOTS, IF NOT CALL OVERFLOW ROUTINE. 05790001 * 05820001 CH GRD,MAXFON(DICR) TEST IF FON TOO LARGE 05850001 BC BNH,ZARFOS NO, OMIT CALL TO OFLO ROUTINE 05880001 * 05910001 LA RR,ZARRET LOAD RETURN ADDR 05940001 BC B,ZOFLOR GO TO MAKE AN OFLO DIC REF 05970001 SPACE 06000001 * FILL FREE OFFSET SLOT, UPDATE FON. 06030001 * 06060001 ZARFOS STH GRB,0(GRE) SET ABS OFFSET IN OFFSET SLOT 06090001 LA GRF,1(GRD) BUMP FON BY 1 06120001 STH GRF,0(GRA) STORE NEW FON 06150001 SPACE 06180001 * CREATE THE NEW DICT REF IN PAR1 06210001 * 06240001 ZARNDR NC PAR1+2(2,DICR),ZMASK1(DICR) REMOVE OFFSET IN PAR1 06270001 SLL GRD,2 MOVE OFFSET NO INTO PLACE 06300001 O GRD,PAR1(0,DICR) AND OR TOGETHER BLOCK AND OFFSET 06330001 ST GRD,PAR1(0,DICR) STORE NEW DICT REF 06360001 SPACE 06390001 * TEST IF DICT REF HAS USED OFFSET SLOT IN ZNXTD. IF SO 06420001 * UPDATE ZNXTD. 06450001 * 06480001 CLC PAR1+2(2,DICR),ZNXTD+2(DICR) IS REF SMALLER THAN ZNXTD 06510001 BC BL,ZARRET YES, OMIT ZNXTD UPDATE 06540001 LA GRD,4(GRD) NO, BUMP DICT REF BY 1 06570001 STH GRD,ZNXTD+2(DICR) STORE NEW ZNXTD 06600001 SPACE 06630001 * RETURN TO USER 06660001 * 06690001 ZARRET L DICR,DICTEM POINT AT THIS SAVE AREA 06720001 BC B,RETRTN RETURN TO CALLER 06750001 SPACE 5 06780001 ZARERR MVC PAR6+1(3,DICR),ERRF03 SAY REFERENCED BLK NOT IN CORE 06810001 BAL RR,PASMYNAM PICK UP PHASE NAME 32318 06820020 L LR,DYNAMOF(CNTL) POINT AT DYNAMIC ROUTINE 06840001 BALR RR,LR GO TO IT 06870001 ERRF03 DC X'0F03C0' 32318 06900020 SPACE 5 06930001 * THIS ROUTINE PROVIDES AN ALTERNATIVE WAY OF DETERMINING 06960001 * THE BLOCK NUMBER OF THE REFERENCED BLOCK WHEN THE REFERENCE IS 06990001 * AN OVERFLOW DIC REF. (IF THE OFLO REF WERE USED IT COULD 07020001 * INVOLVE LOADING THE OFLO BLOCK INTO CORE, WHICH COULD CAUSE 07050001 * THE REFERENCED BLOCK TO BE SPILLED, THUS INVALIDATING THE ABS 07080001 * ADDRESS.) 07110001 * 07140001 ZAROFR L GRC,PAR2(DICR) LOAD ABS ADDR 07170001 LR GRD,GRC COPY IT 07200001 S GRD,DICTSZ(DICR) SUBTRACT BLK SIZE FROM ABS ADDR 07230001 SR GRE,GRE ZERO BLK NO 07260001 LA GRA,DSLOTS+24 POINT AT DSLOTS 07290001 * 07320001 ZARDSL TM 0(GRA),X'F0' TEST IF BLK IS IN CORE 07350001 BC BNM,ZARBDP NO,BUMP DSLOT POINTER 07380001 * 07410001 L GRB,0(GRA) LOAD BLK ADDR 07440001 N GRB,STBITS REMOVE STATUS BITS 07470001 * 07500001 CR GRC,GRB TEST IF ABS ADDR < BLK ADDR 07530001 BC BL,ZARBDP YES, BUMP DSLOT POINTER 07560001 CR GRD,GRB TEST IF ABS ADDR < BLK ADDR + 07590001 * BLK SIZE 07620001 BC BNL,ZARBDP NO, BUMP DSLOT POINTER 07650001 * 07680001 MVC ZARSLL+3(1),ZSHIFT+3(DICR) MAKE SHIFT TO BUILD NEW REF 07710001 ZARSLL SLL GRE,0 CONSTRUCT BLK NO OF REF BLK 07740001 ST GRE,PAR1(DICR) STORE BLK NO IN PAR1 07770001 BC B,ZARALL RETURN TO USE BLK NO 07800001 * 07830001 ZARBDP LA GRA,4(GRA) BUMP DSLOT POINTER 07860001 CLI 1(GRA),X'FF' TEST IF DSLOT STOPPER REACHED 07890001 BC BE,ZARERR YES, DIAGNOSE AND ABORT 07920001 * 07950001 LA GRE,1(GRE) BUMP BLK NO 07980001 BC B,ZARDSL LOOP TO TEST NEXT BLK 08010001 EJECT 08040001 * ROUTINE ZDRFAB 08070001 * THIS ROUTINE TAKES A DICTIONARY REFERENCE AND 08100001 * CONVERTS IT TO AN ABSOLUTE ADDRESS. IF BLOCK IS NOT IN CORE 08130001 * THEN TRYMRD IS ENTERED IN ORDER TO GET THE BLOCK INTO CORE 08160001 * THE DICTIONARY REFERENCE IS FOUND IN PARAMETER 1 (PAR1). THE 08190001 * ABSOLUTE ADDRESS IS RETURNED IN PAR1. THE LAST-LOOK ENTRY IS 08220001 * ALWAYS MADE SINCE THIS ROUTINE IS ALWAYS CALLED FROM ZDICRF 08250001 * ETC. ZDICRF DOES NOT MAKE ENTRIES INTO THE LAST-LOOK TABLE 08280001 * DIRECTLY. 08310001 SPACE 08340001 * ( YOU'VE GOT TO HAVE FAITH IN ZDRFAB, I TELL YOU ) 08370001 SPACE 08400001 SPACE 2 08430001 * HOUSEKEEPING FOR ZDRFAB 08460001 * 08490001 ZDRFAB STM 14,CNTL2,12(DICR) SAVE CALLERS REGISTERS 08520001 L CNTL2,BASOF(CNTL) LOAD FIRST BASE 08550001 L CNTL3,BASES AND SECOND BASE 08580001 ST DICR,DICTEM STORE CALLERS SAVE AREA ADDR 08610001 L DICR,DADDR POINT AT DICT 08640001 SPACE 3 08670001 * IF THE LOCK SLOT CONTAINS AN OVERFLOW REFERENCE AT ENTRY H244 08700001 * TO ZDRFAB THIS WILL MAKE THINGS DIFFICULT FOR DFREE, SO H244 08730001 * AT THIS POINT THE CORRECT BLOCK NUMBER IS OBTAINED AND H244 08760001 * PLACED IN THE LOCK SLOT. H244 08790001 SPACE 08820001 SPACE 08850001 SPACE 08857001 CLC PREVLOK(2),LOCK(DICR) IS THIS SAME AS LAST LOCK H244 08864001 BE ZRACON BRANCH IF SO H244 08871001 MVC LOKSV(2),LOCK(DICR) SAVE LOCK SLOT FOR THIS H244 08878001 NI LOKSV+1,X'FC' REMOVE FLAG BITS. 60026 08881072 MVC PREVLOK(2),LOCK(DICR) CALL AND NEXT H244 08885001 SPACE 08892001 CLC LOCK(2,DICR),ZEROS IS A BLOCK LOCKED H244 08899001 BE ZRACON BRANCH IF NOT H244 08910001 SPACE 08940001 TM OFLOSW,X'FF' DOES OVERFLOW BLK EXIST H244 08970001 BZ ZRACON BRANCH IF NOT H244 09000001 SPACE 09030001 MVC TEMPX(2),PAR1+2(DICR) SAVE DICT REF PASSED H244 09060001 MVC PAR1+2(2,DICR),LOCK(DICR) POINT GRA AT DSLOT H244 09090001 BAL RR,CONSLD FOR LOCKED BLOCK H244 09120001 CLI 5(GRA),X'FF' IS IT LAST DICT BLK H244 09150001 BNE ZRALOK2 BRANCH IF NOT H244 09180001 SPACE 09210001 CLC TEMPX(2),LOCK(DICR) IS DICREF PASSED SAME AS H244 09240001 * DICREF IN LOCK H244 09270001 BNE ZRALOK1 BRANCH IF NOT H244 09300001 SPACE 09330001 MVI LOKSW,X'FF' YES,SO SET SWITCH H244 09360001 B ZRACON AND BRANCH H244 09390001 SPACE 09420001 * IF HERE LOCK SLOT CONTAINS AN OVERFLOW DICT REF, H244 09450001 * DIFFERENT FROM THAT PASSED TO ZDRFAB IN PAR1 H244 09480001 SPACE 09510001 ZRALOK1 TM 0(GRA),X'80' IS OVERFLOW BLK IN CORE H244 09540001 BO ZRALOK3 BRANCH IF SO H244 09570001 SPACE 09600001 DC X'0000' STOP IF OFLO BLK HAS SPILLED. 62615 09630072 SPACE 10200001 ZRALOK3 L GRB,0(GRA) LOAD OFLO BLK ADDR H244 10230001 N GRB,STBITS ZERO STATUS BYTE H244 10260001 NC LOKSV(2),ZMASK(DICR) GET OFFSET OF DIC. REF. H244 10290020 AH GRB,LOKSV CALC. ABS. A(OFL. ENTRY) H244 10320020 MVC LOKSV(2),0(GRB) PUT TRUE BLK NO IN LOCK H244 10350001 SPACE 10380001 ZRALOK2 MVC PAR1+2(2,DICR),TEMPX RESTORE PAR1 H244 10410001 SPACE 10440001 * FIND THE BLOCK, EXAMINE STATUS AND GET IT INTO CORE 10470001 * 10500001 ZRACON BAL RR,CONSLD TO POINT GRA AT CORRECT DSLOT 10530001 CLI 0(GRA),X'FF' TEST IF BLOCK IS IN USE 10560001 BC BE,BLKERR NO, DIAGNOSE ERROR AND ABORT 10590001 * 10620001 TM 0(GRA),X'80' TEST IF BLOCK IS IN CORE 10650001 BC BO,ZRABIC YES, OMIT CODE TO GET BLK IN CORE 10680001 * 10710001 MVC RDTTR(3),1(GRA) PASS TRYMRD REL TRK ADDR OF BLK 10740001 BAL RR,TRYMRD TO GET BLOCK INTO CORE 10770001 ST GR0,0(GRA) STORE BLOCK ADDR IN DSLOTS 10800001 MVI 0(GRA),X'84' SET STATUS AS IN CORE AND BUSY 10830001 * 10860001 ZRABIC L GRB,0(GRA) LOAD BLOCK ADDR FROM DSLOTS 10890001 N GRB,STBITS ZERO STATUS BYTE 10920001 SPACE 10950001 * TEST TYPE OF CALL TO ZDRFAB 10980001 * 11010001 ZRATYP CLI SWTCH,X'00' TEST FOR A CALL FROM ZDICRF 11040001 BC BNE,ZRADRF YES, GOTO ZRADRF ROUTINE 11070001 * 11100001 TM OFLOSW,X'FF' TEST IF OFLO BLOCK EXISTS 11130001 BC BZ,ZRALLK NO, BRANCH FOR A NORMAL CALL 11160001 * 11190001 CLI 5(GRA),X'FF' TEST IF REF IS TO LAST DIC BLOCK 11220001 BC BE,ZRAOFB YES, BRANCH FOR AN OFLO DIC REF 11250001 SPACE 11280001 * ADD DICT REF TO LAST LOOK TABLE 11310001 * 11340001 ZRALLK MVC LASLOK-2(6),LASLOK 11370001 MVC LASLOK+4(2),PAR1+2(DICR) 11400001 SPACE 11430001 * TEST FOR 2ND HALF OF AN OVERFLOW REFERENCE CONVERSION 11460001 * 11490001 ZRAOFS BC NOP,ZRAOFA *MODIFIED INSTRUCTION* 11520001 SPACE 11550001 * NORMAL CALL 11580001 * 11610001 NC PAR1+2(2,DICR),ZMASK(DICR) CONSTRUCT OFFSET OF DIC REF 11640001 LH GRA,PAR1+2(DICR) LOAD SLOT NO OF DICT REF 11670001 SRL GRA,1 CONVERT SLOT NO TO A SLOT INDEX 11700001 L GRC,FONOF(DICR) LOAD OFFSET OF FON 11730001 AR GRC,GRB POINT AT FON 11760001 AH GRB,2(GRC,GRA) ADD ABS OFFSET TO BLOCK ADDR 11790001 SPACE 11820001 * STORE REQUIRED ABSOLUTE ADDRESS AND RETURN TO CALLER 11850001 * 11880001 ZRASTA ST GRB,PAR1(DICR) PAR1 HOLDS ABS ADDR 11910001 L DICR,DICTEM POINT AT CALLERS SAVE AREA 11940001 BC B,RETRTN RETURN ROUTINE 11970001 SPACE 5 12000001 * A CALL FROM ZDICRF 12030001 * 12060001 ZRADRF ST GRB,PAR2(DICR) STORE BLOCK ADDR 12090001 A GRB,ZNXTOF(DICR) CALC ADDR OF NEW DICT ENTRY 12120001 BC B,ZRASTA 12150001 SPACE 3 12180001 * AN OVERFLOW REFERENCE 12210001 * 12240001 ZRAOFB NC PAR1+2(2,DICR),ZMASK(DICR) CONSTRUCT OFFSET OF DIC REF 12270001 AH GRB,PAR1+2(0,DICR) CALC ABS ADDR OF OFLO ENTRY 12300046 MVC PAR1+2(2,DICR),0(GRB) MOVE TRUE BLOCK NO INTO PAR1 12330001 LH GRC,2(GRB) LOAD TRUE OFFSET INTO GRC 12360001 MVI ZRAOFS+1,X'F0' SET OFLO SWITCH TO BRANCH 12390001 SPACE 12420001 CLI LOKSW,X'FF' IS LOCK SWITCH ON H244 12450001 BNE ZRACON NO, SO LOOP TO GET TRUE BLKH244 12480001 SPACE 12510001 MVI LOKSW,X'00' YES, SO SET SWITCH OFF H244 12540001 MVC LOKSV(2),0(GRB) AND PUT TRUE LOCKED BLK NO H244 12570001 * IN LOCK SLOT H244 12600001 BC B,ZRACON LOOP TO GET TRUE BLK INTO CORE 12630001 SPACE 3 12660001 * AN OVERFLOW REFERENCE (2ND PART) 12690001 * 12720001 ZRAOFA AR GRB,GRC ADD TRUE BLK ADDR AND TRUE OFFST 12750001 MVI ZRAOFS+1,X'00' RESTORE OFLO SWITCH 12780001 BC B,ZRASTA 12810001 EJECT 12840001 * ROUTINES ZNALAB,ZDICAB,ZNALRF,ZDICRF 12870001 * THIS ROUTINE WILL MAKE A DICTIONARY ENTRY. 12900001 * BLOCKS ARE AUTOMATICALLY SPANNED. NO ENTRY IS MADE ACROSS A 12930001 * BLOCK BOUNDARY. THE N ROUTINES WILL MAKE ENTRIES AT THE NEXT 12960001 * AVAILABLE LOCATION,OTHERWISE ENTRIES ARE ALIGNED ON THE NEXT 12990001 * FULL WORD BOUNDARY. 13020001 * THE SEQUENCE OF OPERATIONS IS AS FOLLOWS 13050001 * 1) THE LENGTH OF THE ENTRY IS CHECKED TO SEE IF IT WILL 13080001 * FIT INTO A COMPLETE DICTIONARY BLOCK. IF IT WILL NOT THEN 13110001 * THE COMPILER CANNOT CONTINUE AND AN ABORT TAKES PLACE 13140001 * 2) THE DICT. REFERENCE TO THE NEXT AVAILABLE DICTIONARY 13170001 * SPACE IS CONVERTED TO ABSOLUTE BY ZDRFAB. THIS ALSO ENSURE 13200001 * S THAT THE BLOCK IS BROUGHT INTO CORE. AN ALIGNMENT ON THE 13230001 * NEXT WORD BOUNDARY IS PERFORMED IF NECESSARY (IE THE 13260001 * ROUTINE HAS BEEN ENTERED AT ZDICAB OR ZDICRF) 13290001 * 3) A CHECK IS MADE TO SEE IF THE ENTRY WILL FIT INTO 13320001 * THE REST OF THE CURRENT BLOCK. IF THE ENTRY WILL NOT FIT 13350001 * THEN A BRANCH TO NEWBLK IS PERFORMED. 13380001 * 4) THE ENTRY IS MOVED INTO THE BLOCK BY A MOVE-CHARACTERS 13410001 * LOOP AT MOVLOP. IF A ZERO LENGTH ENTRY (FOR ZERO LENGTH 13440001 * BIT STRINGS ETC) IS REQUIRED THIS LOOP IS BYPASSED. 13470001 * 5) THE ADDRESS OF THE LOCATION IMMEDIATELY AFTER THE LAST 13500001 * POINT IN THE ENTRY IS CONVERTED TO A REFERENCE BY ENTRY TO 13530001 * ZDABRF 13560001 * 6) RETURN 13590001 * 7) IF A NEW BLOCK IS REQUIRED, A DICTIONARY STOPPER, 13620001 * X'CF',IS ENTERED FOLLOWED BY A REFERENCE TO THE NEXT BLOCK 13650001 * TRYMRD IS ENTERED TO OBTAIN THE NEW BLOCK. THE NEW BLOCKS 13680001 * ADDRESS IS ENTERED IN THE NEXT AVAILABLE SPACE IN THE 13710001 * DICTIONARY BLOCK CONTROL AREA,DSLOTS. IT IS MARKED AS IN 13740001 * CORE AND BUSY 13770001 * THERE ARE TWO CONDITIONS WHICH WILL CAUSE THE COMPILER 13800001 * TO TERMINATE- ENTRY TOO LONG AND DICTIONARY IS FULL. 13830001 SPACE 2 13860001 SWTCH DC X'00' 13890001 ZNALAB STM 14,CNTL2,12(DICR) STORE BASES 13920001 L CNTL2,BASOF(CNTL) 13950001 MVI SWTCH,X'81' SET NALAB SWITCH 13980001 BC B,DICST 14010001 ZDICAB STM 14,CNTL2,12(DICR) STORE BASES 14040001 L CNTL2,BASOF(CNTL) LOAD FIRST BASE REGISTER 14070001 MVI SWTCH,X'41' SET DICAB SWITCH 14100001 BC B,DICST 14130001 ZNALRF STM 14,CNTL2,12(DICR) STORE BASES 14160001 L CNTL2,BASOF(CNTL) LOAD FIRST BASE REGISTER 14190001 MVI SWTCH,X'82' SET NALRF SWITCH 14220001 BC B,DICST 14250001 ZDICRF STM 14,CNTL2,12(DICR) STORE BASES 14280001 L CNTL2,BASOF(CNTL) LOAD FIRST BASE REGISTER 14310001 MVI SWTCH,X'42' SET DICRF SWITCH 14340001 SPACE 14370001 DICST L CNTL3,BASES LOAD SECOND BASE REGISTER 14400001 LA GRA,SAVARD POINT AT A NEW SAVE AREA 14430001 ST 13,4(GRA) CHAIN BACK 14460001 ST GRA,8(13) CHAIN FORWARD 14490001 L DICR,DADDR POINT AT DICT 14520001 SPACE 14550001 * TEST IF THIS ENTRY WILL FIT INTO A BLOCK 14580001 * 14610001 L GRA,DICTSP(DICR) LOAD USEABLE DICT SPACE VALUE 14640001 LM GRD,GRE,PAR1(DICR) LOAD ENTRY ADDR AND LENGTH 14670001 CR GRA,GRE TEST IF ENTRY WILL FIT IN A BLK 14700001 BC BL,ERRF04 NO, DIAGNOSE AND ABORT 14730001 SPACE 14760001 * FIND 1ST POSSIBLE SPACE FOR DICT ENTRY 14790001 * 14820001 LH GRG,ZNXTD+2(DICR) LOAD ZNXTD INTO GRG 14850001 N GRG,NEGBIT CLEAR TOP HALF WORD 14880001 STH GRG,PAR1+2(DICR) PAR1 HOLDS 1ST POSS DIC REF 14910001 LA DICR,SAVARD POINT AT A SAVE AREA 14940001 BAL RR,ZDRFAB GET ABS ADDR OF NEXT DICT SPACE 14970001 L DICR,DADDR POINT AT DICT AGAIN 15000001 LM GRB,GRC,PAR1(DICR) LOAD DIC ENTRY SPACE AND START 15030001 * OF BLOCK 15060001 ST GRE,PAR2(DICR) RESTORE ENTRY LENGTH 15090001 SPACE 15120001 * CORRECT FOR ALIGNED ENTRIES 15150001 * 15180001 TM SWTCH,X'80' IS ALIGNMENT REQUIRED 15210001 BC BO,ZDETEF OMIT NEXT INSTNS IF NOT 15240001 MVC 0(3,GRB),ZEROS ZERO BYTES BETWEEN ENTRIES 15270001 A GRB,THREE ALIGN ENTRY ADDR ON NEXT FULL 15300001 N GRB,MASKX WORD 15330001 SPACE 15360001 * TEST IF ENTRY WILL FIT IN EXISTING BLOCK 15390001 * 15420001 ZDETEF AR GRA,GRC GRA NOW POINTS AT END OF BLOCK 15450001 LR GRF,GRB COPY DIC ENTRY ADDR 15480001 AR GRF,GRE ADD ENTRY LENGTH TO POINT AT END 15510001 CR GRF,GRA TEST IF ENTRY FITS EXISTING BLK 15540001 BC BH,ZDENBK NO, GET A NEW DIC BLK 15570001 SPACE 15600001 * MARK END OF PRESENT DICT 15630001 * 15660001 ZDEMED MVI 0(GRF),X'ED' 15690001 SPACE 15720001 * UPDATE ZNXTOF 15750001 * 15780001 SR GRF,GRC CALC OFFSET OF NEXT ENTRY 15810001 ST GRF,ZNXTOF(DICR) STORE NEW OFFSET VALUE 15840001 SPACE 15870001 * MOVE THE DICTIONARY ENTRY INTO THE BLOCK 15900001 * 15930001 ZDEMEI LR GRF,GRB COPY DIC ENTRY ADDR 15960001 LTR GRE,GRE TEST IF ENTRY HAS ZERO LENGTH 15990001 BC BZ,ZDEONE YES, OMIT THE MOVE 16020001 * 16050001 ZDETEL C GRE,TW56 TEST IF LENGTH MORE THAN 256 16080001 BC BNH,ZDEMLE NO, BRANCH TO PERFORM FINAL MOVE 16110001 * 16140001 MVC 0(256,GRF),0(GRD) MOVE 256 BYTES OF ENTRY IN 16170001 A GRF,TW56 BUMP ENTRY ADDR BY 256 16200001 A GRD,TW56 BUMP DICT ADDR BY 256 16230001 S GRE,TW56 REDUCE ENTRY LENGTH BY 256 16260001 BC B,ZDETEL LOOP FOR MORE OF ENTRY 16290001 * 16320001 ZDEMLE BCTR GRE,0 REDUCE ENTRY LENGTH BY 1 FOR MVC 16350001 STC GRE,ZDEMVC+1 INSERT CORRECTED LENGTH 16380001 ZDEMVC MVC 0(0,GRF),0(GRD) MOVE LAST PART OF ENTRY IN 16410001 SPACE 16440001 * ONCE ONLY CODE. STORE THE 1ST DIC REF IN FSTDRF. MODIFY 16470001 * TWO INSTNS IN ZDENBK. 16500001 * 16530001 ZDEONE BC NOP,ZDESPR * PERM BRANCH AFTER 1ST USE 16560001 MVI ZDEONE+1,X'F0' MAKE PREV INSTN A BRANCH 16590001 STH GRG,FSTDRF+2(DICR) SET 1ST DIC REF 16620001 SPACE 16650001 * SET DIC REF AND ABS ADDR IN PAR1 AND PAR4 FOR RETURN 16680001 * 16710001 ZDESPR TM SWTCH,X'01' TEST IF ABS ADDR REQD 16740001 BC BZ,ZDEREF NO, BRANCH TO STORE DIC REF 16770001 * 16800001 ST GRB,PAR1(DICR) STORE ABS ADDR 16830001 STH GRG,PAR4+2(DICR) STORE DIC REF 16860001 BC B,ZDERET OMIT DIC REF AND OFFSET PROCESS 16890001 * 16920001 ZDEREF STH GRG,PAR1+2(DICR) STORE DIC REF 16950001 ST GRB,PAR4(DICR) STORE ABS ADDR 16980001 SPACE 17010001 * MAKE THE OFFSET SLOT ENTRY 17040001 * 17070001 SR GRB,GRC CALC OFFSET OF DIC ENTRY 17100001 * 17130001 A GRC,FONOF(DICR) POINT AT FON 17160001 LH GRA,0(GRC) LOAD FON 17190001 CH GRA,MAXFON(DICR) TEST IF FON TOO LARGE 17220001 BC BH,ZDEOFE YES, BRANCH TO MAKE AN OFLO ENTRY 17250001 * 17280001 LR GRD,GRA COPY FON 17310001 AR GRD,GRD DOUBLE FON TO MAKE SLOT OFFSET 17340001 STH GRB,2(GRD,GRC) STORE OFFSET IN REQD OFFSET SLOT 17370001 SPACE 17400001 * UPDATE FON 17430001 * 17460001 LA GRA,1(GRA) BUMP FON BY 1 17490001 STH GRA,0(GRC) STORE NEW FON 17520001 SPACE 17550001 * UPDATE ZNXTD 17580001 * 17610001 LA GRG,4(GRG) BUMP ZNXTD BY 4 17640001 ST GRG,ZNXTD(DICR) STORE NEW ZNXTD 17670001 SPACE 17700001 * HOUSEKEEPING AND RETURN 17730001 * 17760001 ZDERET MVI SWTCH,X'00' SET DICT ENTRY SWITCH OFF 17790001 LA DICR,SAVARD POINT AT PRESENT SAVE AREA 17820001 L DICR,4(DICR) POINT AT CALLERS SAVE AREA 17850001 BC B,RETRTN RETURN ROUTINE 17880001 EJECT 17910001 * CREATE A NEW DICTIONARY BLOCK 17940001 SPACE 2 17970001 ZDENBK EQU * 18000001 SPACE 18030001 * CALCULATE NEW BLOCK NUMBER AND ZNXTD 18060001 * 18090001 MVC ZDESRL+3(1),ZSHIFT+3(DICR) MAKE SHIFT TO REDUCE DIC REF 18120001 MVC ZDESLL+3(1),ZSHIFT+3(DICR) MAKE SHIFT TO BUILD NEW REF 18150001 ZDESRL SRL GRG,0 *MOD INSTN* SHIFT BLOCK NO RIGHT 18180001 LA GRG,1(GRG) BUMP BLOCK NO BY 1 18210001 LR GRB,GRG COPY NEW BLOCK NO 18240001 ZDESLL SLL GRG,0 *MOD INSTN* RESTORE NEW BLOCK NO 18270001 STH GRG,ZNXTD+2(DICR) STORE NEW ZNXTD 18300001 SPACE 18330001 * MARK END OF OLD BLOCK 18360001 * 18390001 ZDEMOB CLI DICTSZ+2(DICR),X'04' TEST IF USING 1K BLKS 18420001 BC BNE,ZDEFEB NO,MARK EOB 18450001 CLI ZNXTD+2(DICR),X'02' TEST IF 1ST DIC BLK JUST FULL 18480001 BC BE,ZDETNB YES, DO NOT MARK EOB 18510001 ZDEFEB L GRA,PAR1(DICR) POINT AT END OF LAST DIC ENTRY 18540001 MVI 0(GRA),X'CF' MAKE END OF BLOCK MARKER 18570001 MVC 1(2,GRA),ZNXTD+2(DICR) PUT NEW DIC REF AFTER EOB MARK 18600001 SPACE 18630001 * TEST IF A NEW DICT BLOCK CAN BE MADE 18660001 * 18690001 ZDETNB AR GRB,GRB CALC 4 TIMES BLK NO 18720001 AR GRB,GRB 18750001 LA GRA,DSLOTS+24(GRB) POINT AT DSLOTS SLOT FOR NEW BLK 18780001 CLI 5(GRA),X'FF' TEST FOR LAST BLOCK, 47635 18800056 * ( I.E. THE OVERFLOW BLOCK.). 47635 18820056 BC BE,ERRF0D YES, DIAGNOSE AND ABORT 18840001 SPACE 18870001 * TEST IF THE NEW BLOCK ALREADY EXISTS 18900001 * 18930001 L GR0,0(GRA) LOAD BLK ADDR IN CASE IT IS FREE 18960001 TM 0(GRA),X'F0' TEST IF BLOCK IS IN CORE 18990001 BC BM,ZDENBA YES, OMIT CALL TO TRYMRD 19020001 SPACE 19050001 * GET THE NEW BLOCK INTO CORE 19080001 * 19110001 XC RDTTR(4),RDTTR SAY NO READ REQD IN TRYMRD 19140001 BAL RR,TRYMRD GET A NEW DICT BLOCK 19170001 SPACE 19200001 * GET NEW BLOCK ADDR AND UPDATE DSLOTS 19230001 * 19260001 ST GR0,0(GRA) SET NEW BLOCK ADDR IN DSLOTS 19290001 ZDENBA MVI 0(GRA),X'84' MARK NEW BLK AS IN CORE AND BUSY 19320001 N GR0,STBITS CLEAR STATUS BYTE IN BLOCK ADDR 19350001 SPACE 19380001 * SET REGISTERS TO POINT AT NEW BLOCK CORRECTLY 19410001 * 19440001 LR GRB,GR0 POINT AT ADDR FOR DIC ENTRY 19470001 LR GRC,GR0 POINT AT START OF BLK 19500001 LR GRF,GR0 COPY ENTRY ADDR 19530001 AR GRF,GRE ADD ENTRY LEN TO POINT AT END 19560001 SPACE 19590001 * SET FON IN NEW DICT BLOCK 19620001 * 19650001 L GRA,FONOF(DICR) 19680001 AR GRA,GR0 POINT AT FON IN NEW DICT BLOCK 19710001 MVC 0(2,GRA),ZEROS SET FON TO ZERO 19740001 SPACE 19770001 * RETURN TO MAKE DICT ENTRY 19800001 * 19830001 BC B,ZDEMED 19860001 SPACE 5 19890001 * MAKE AN OVERFLOW DICTIONARY ENTRY 19920001 * 19950001 ZDEOFE LA RR,ZDERET LOAD RETURN ADDR 19980001 BC B,ZOFLOR GO TO MAKE AN OFLO DIC REF 20010001 SPACE 5 20040001 * DICTIONARY ENTRY ERROR MESSAGES 20070001 * 20100001 ERRF04 MVC PAR6+1(3,DICR),ERRM04 SAY DICT ENTRY IS TOO LONG 20130001 MVI SWTCH,X'00' REINITIALISE SWITCH 20160001 L LR,DYNAMOF(CNTL) POINT AT DYNAMIC ROUTINE 20190001 BALR RR,LR AND BRANCH TO IT 20220001 * 20250001 ERRF0D L RR,PAR1(DICR) * POINT AT END OF LAST 60039 20280072 MVI 0(RR),X'ED' * ENTRY & MARK AS E.O.D. 60039 20290072 LA GR0,ERRMS SAY TOO MANY DICT BLOCKS 52214 20300021 ST GR0,PAR1(DICR) 20310001 MVI SWTCH,X'00' REINITIALISE SWITCH 20340001 LA 13,ZSAV(0,DICR) SET UP SAVE AREA FOR ZUPL 33893 20350020 BAL RR,ZUPL PRINT ERROR MSG ONLINE 20370001 L DICR,DADDR POINT AT DICTIONARY AGAIN 33893 20380020 LA GR0,16 20400001 ST GR0,ERCODE(DICR) SET TERMINAL ERROR CODE 20430001 L LR,ABORTOF(CNTL) POINT AT ABORT ROUTINE 20460001 BALR RR,LR AND BRANCH TO IT 20490001 * 20520001 ERRM04 DC X'0F0440' 23286 20550001 EJECT 20580001 * STORE CALLERS REGISTERS 20610001 * 20640001 ZOFLOR STM GR0,GRB,OFRSAV 20670001 SPACE 20700001 * STORE BLOCK NO OF TRUE DIC REF IN OFENTY 20730001 * 20760001 L GRA,PAR1(DICR) LOAD DIC REF 20790001 N GRA,ZMASK(DICR) MAKE IT A BLOCK NO ONLY 20820001 STH GRA,OFENTY STORE BLOCK NO IN OFENTY 20850001 SPACE 20880001 * STORE OFFSET OF TRUE DIC REF IN OFENTY 20910001 * 20940001 STH GRB,OFENTY+2 20970001 SPACE 21000001 * CHECK EXISTENCE OF OVERFLOW BLOCK 21030001 * 21060001 L GRA,ZOBSAD(DICR) LOAD OFLO BLOCK SLOT ADDR 21090001 CLI 0(GRA),X'FF' TEST IF BLOCK IS IN USE 21120001 BC BE,OFINIT NO, GET AND INITIALIZE OFLO BLOCK 21150001 TM 0(GRA),X'80' TEST IF BLOCK IS IN CORE 21180001 BC BZ,OFGTIN NO, GET OFLO BLOCK INTO CORE 21210001 SPACE 21240001 * TEST IF A NEW OVERFLOW DICT REF CAN BE MADE 21270001 * 21300001 OFTNDR L GRB,OFENOF(DICR) AND NEW OFLO ENTRY OFFSET AND 21330001 N GRB,OFDCRF OFLO BLOCK NO, IF RESULT NOT ZERO 21360001 BC BNZ,OFERRA THERE ARE TOO MANY OFLO ENTRIES 21390001 SPACE 21420001 * MAKE A NEW OVERFLOW DIC REF 21450001 * 21480001 L GRB,OFENOF(DICR) OR NEW OFLO ENTRY OFFSET,AND 21510001 O GRB,OFDCRF OFLO BLOCK NO, RESULT NEW DIC REF 21540001 ST GRB,PAR1(DICR) STORE NEW DIC REF. 21570001 SPACE 21600001 * MOVE NEW OVERFLOW ENTRY IN 21630001 * 21660001 L GRA,0(GRA) LOAD OFLO BLOCK ADDR 21690001 L GRB,OFENOF(DICR) LOAD OFFSET OF NEW OFLO ENTRY 21720001 AR GRA,GRB POINT AT POSN OF NEW OFLO ENTRY 21750001 MVC 0(4,GRA),OFENTY MOVE NEW OFLO ENTRY IN 21780001 SPACE 21810001 * BUMP OFFSET OF NEXT ENTRY 21840001 * 21870001 LA GRB,4(GRB) BUMP OFLO ENTRY OFFSET 21900001 ST GRB,OFENOF(DICR) STORE NEW OFLO ENTRY OFFSET 21930001 SPACE 21960001 * RETURN TO CALLER 21990001 * 22020001 LM GR0,GRB,OFRSAV 22050001 BCR BR,RR 22080001 SPACE 22110001 * INITIALISATION FOR OVERFLOW BLOCK 22140001 * 22170001 OFINIT LH GRB,ZOBNUM(DICR) LOAD OFLO BLOCK NO 22200001 MVC OFBNSL+3(1),ZSHIFT+3(DICR) SET SHIFT VALUE IN NEXT INSTN 22230001 OFBNSL SLL GRB,0 SHIFT OFLO BLK NO TO MAKE DIC RF 22260001 ST GRB,OFDCRF STORE OFLO BLK DIC REF 22290001 MVC OFDNAM(2,DICR),MYNAM(DICR) SAY WHEN OFLO BLOCK CREATED 22320001 MVI OFLOSW,X'FF' SHOW AN OFLO BLOCK EXISTS 22350001 XC RDTTR(4),RDTTR SHOW NO READ REQD IN TRYMRD 22380001 BC B,OFGTNB GET NEW BLOCK INTO CORE 22410001 SPACE 22440001 * GET OVERFLOW BLOCK INTO CORE 22470001 * 22500001 OFGTIN DC X'0000' STOP IF OFLO BLK HAS SPILLED. 62615 22530072 OFGTNB LR GRB,RR HOLD ZOFLOR RETURN ADDR 22560001 BAL RR,TRYMRD GET OFLO BLK INTO CORE 22590001 LR RR,GRB RESTORE ZOFLOR RETURN ADDR 22620001 ST GR0,0(GRA) STORE OFLO BLK ADDR IN DSLOTS 22650001 MVI 0(GRA),X'84' LOCK IN OFLO BLK FOR EVER. 62615 22680072 BC B,OFTNDR GO TO CONSTRUCT OFLO DIC REF 22710001 SPACE 22740001 * TERMINAL ERROR IF TOO MANY OVERFLOW ENTRIES 22770001 * 22800001 OFERRA LA GR0,OFLMES SAY TOO MANY OVFLOW ENTRIES24700 22810019 ST GR0,PAR1(DICR) 24700 22820019 MVI SWTCH,X'00' REINITIALISE SWITCH 24700 22830019 BAL RR,ZUPL PRINT ERROR MSG ONLINE 24700 22840019 LA GR0,16 24700 22850019 ST GR0,ERCODE(DICR) SET TERMINAL ERROR CODE 24700 22860019 L LR,ABORTOF(CNTL) POINT AT ABORT ROUTINE 24700 22870019 BALR RR,LR AND BRANCH TO IT 24700 22880019 SPACE 22920001 * OVERFLOW CONSTANTS 22950001 * 22980001 OFLOSW DC X'00' OFLO SWITCH ON IF OFLO BK EXISTS 23040001 OFRSAV DC 3F'0' OFLO REG SAVE AREA 23070001 OFENTY DC F'0' OFLO ENTRY 23100001 OFDCRF DC F'0' DIC REF TO START OF OFLO BLOCK 23130001 EJECT 23160001 * ROUTINE ZUTXTC 23190001 * THIS ROUTINE FINDS A NEW TEXT BLOCK. IF A FREE 23220001 * BLOCK EXISTS, IT IS USED. IF NO FREE BLOCKS EXIST,A LOWER 23250001 * PRIORITY BLOCK (WANTED OR UNWANTED) IS WRITTEN ON DISK. THE 23280001 * NEW BLOCK IS MARKED AS IN-CORE AND BUSY. 23310001 * IF REQUESTED BY A NON-ZERO BYTE IN PAR2+3, THE CURRENT 23340001 * BLOCK IS CHAINED TO THE NEW BLOCK AND THE STATUS OF THE CURREN 23370001 * T BLOCK IS CHANGED. FOUR STATUS BYTES EXIST 23400001 * 1) X'01' MEANS FREE THE BLOCK. THE INFORMATION CAN BE 23430001 * OVERWRITTEN IF NECESSARY 23460001 * 2) X'02' A LOW PRIORITY OF USEFUL INFORMATION(REFERRED TO 23490001 * AS UNWANTED). THE BLOCK IS NOT NECESSARILY IN CORE 23520001 * 3) X'03' A HIGH PRIORITY OF USEFUL INFORMATION(REFERRED 23550001 * TO AS WANTED) 23580001 * 4) X'04' BUSY. THE BLOCK IS IN CORE AND WILL NOT BE 23610001 * WRITTEN OUT 23640001 * IN THIS ROUTINE A SEARCH IS MADE FOR A X'01' BLOCK. IT 23670001 * MUST BE NOTED THAT A X'80' BIT MEANS THAT A BLOCK IS IN CORE. 23700001 * THUS WHEN A NEW BLOCK IS REQUIRED A SEARCH IS MADE FOR X'81' 23730001 * BLOCK MEANING IN-CORE AND FREE. 23760001 * A LIST OF TEXT BLOCK ADDRESSES IS KEPT IN TSLOTS. IT IS 23790001 * THIS LIST WHICH IS SCANNED. 23820001 * IF A FREE BLOCK CANNOT BE FOUND THEN A ENTRY TO TRYMRT 23850001 * IS MADE. THIS WILL EITHER CREATE A NEW BLOCK OR SPILL A WANT 23880001 * OR UNWANT BLOCK ONTO DISK. 23910001 * COMPILATION IS TERMINATED IF ALL TEXT BLOCKS ARE FULL,IE 23940001 * IF TSLOTS HAS REACHED THE STOPPER 23970001 * 24000001 SPACE 2 24030001 ZUTXTC STM 14,CNTL2,12(DICR) GET WORK REGISTERS 24060001 L CNTL2,BASOF(CNTL) LOAD FIRST BASE 24090001 L CNTL3,BASES LOAD SECOND BASE 24120001 SPACE 24150001 BAL RR,CONSLT POINT AT CORRECT SLOT IN TSLOTS 24180001 TM PAR2+3(DICR),X'FF' SEE IF ZERO STATUS BYTE 24210001 BC BM,ZTCHAN 24240001 SPACE 24270001 ZTBAK LA GRC,TSLOTS+24 INITIALISE AT TSLOTS 24300001 XR GRB,GRB COUNT=0 24330001 L GRD,0(0,GRA) PICK UP ADDRESS OF BLOCK 24360001 A GRD,TXTSZ(0,DICR) ADD ON TEXT BLOCK SIZE 24390001 SPACE 24420001 ZTLOP TM 0(GRC),X'80' TEST IF BLOCK IN CORE 24450001 BC BZ,ONDSK 24480001 CLI 0(GRC),X'81' TEST FOR FREE BLOCKS 24510001 BC BE,FREBLK 24540001 CLI 0(GRC),X'FF' TEST FOR FREE SLOT 24570001 BC BE,FRSLAT 24600001 ONDSK LA GRC,4(0,GRC) BUMP TO NEXT SLOT IN TSLOTS 24630001 LA GRB,1(0,GRB) COUNT+COUNT+1 24660001 CLI 1(GRC),X'FF' TEST FOR STOPPER IN TSLOTS 24690001 BC BNE,ZTLOP 24720001 SPACE 24750001 MVC PAR6+1(3,DICR),ERRF06 ALL TEXT BLOCKS FULL 32318 24770020 BAL RR,PASMYNAM PICK UP PHASE NAME 32318 24790020 LA 13,ZSAV(0,DICR) SET UP SAVE AREA FOR ZUERR 33893 24800020 BAL RR,ZUERR GO TO ERROR ROUTINE 32318 24810020 L DICR,DADDR POINT AT DICTIONARY AGAIN 33893 24820020 L LR,ABORTOF(CNTL) POINT AT ZABORT 24840001 BALR RR,LR 24870001 ERRF06 DC X'0F06C0' 32318 24880020 SPACE 24900001 ZTCHAN TM PAR2+3(DICR),X'80' TEST IF CHAIN REQUIRED 24930001 BC BZ,NOCHAN 24960001 MVI CHANSW,X'FF' SET CHAIN SWITCH ON 24990001 NOCHAN TM PAR2+3(DICR),X'07' TEST FOR ANY STATUS CHANGE 25020001 BC BZ,ZTBAK 25050001 CLI 0(GRA),X'FF' SEE IF BLOCK IS IN USE 25080001 BC BE,BLKERR 25110001 NI 0(GRA),X'80' CLEAR PREVIOUS STATUS BITS 25140001 NI PAR2+3(DICR),X'7F' CLEAR CHAIN BIT FROM STATUS BYTE 25170001 OC 0(1,GRA),PAR2+3(DICR) INSERT NEW STATUS BYTE 25200001 BC B,ZTBAK 25230001 SPACE 25260001 FREBLK L GR0,0(0,GRC) PICK UP ADDRESS OF FREE BLOCK 25290001 N GR0,STBITS 25320001 CLI CHANSW,X'FF' IS CHAIN SWITCH ON 25350001 BC BNE,NONEW 25380001 STC GRB,1(0,GRD) STORE COUNT OF NEXT BLOCK IN 25410001 BC B,NONEW CHAIN SLOT OF CURRENT BLOCK 25440001 SPACE 25470001 FRSLAT CLI CHANSW,X'FF' TEST FOR CHAIN 25500001 BC BNE,TCJUMP 25530001 STC GRB,1(0,GRD) STORE COUNT OF NEXT BLK IN CHAIN 25560001 TCJUMP XC RDTTR(4),RDTTR SHOW THAT NO BLOCK IS REQUIRED 25590001 BAL RR,TRYMRT IN CORE AND MAKE SPACE FOR BLOCK 25620001 ST GR0,0(0,GRC) PUT ADDRESS OF BLOCK IN TSLOTS 25650001 NONEW MVI 0(GRC),X'84' MARK AS IN-CORE AND BUSY 25680001 MVI CHANSW,X'00' CLEAR CHAN-SWITCH 25710001 ST GR0,PAR2(0,DICR) INSERT ABSOLUTE ADDRESS OF BLOCK 25740001 MVI PAR2(DICR),X'00' CLEAR STATUS BYTE 25770001 XC PAR1+2(2,DICR),PAR1+2(DICR) SET OFFSET TO ZERO 25800001 STC GRB,PAR1+1(0,DICR) INSERT COUNT AS REFERENCE 25830001 LR GRA,GR0 25860001 A GRA,TXTSZ(0,DICR) POINT AT END OF NEW BLOCK 25890001 STC GRB,5(0,GRA) NAME THE NEW BLOCK 25920001 SPACE 25950001 BC B,RETRTN BRANCH TO 'RETURN TO CALLER' ROUTINE 25980001 SPACE 26010001 EJECT 26070001 * ROUTINE ZCHAIN 26100001 * THIS ROUTINE LOOKS AT CURRENT BLOCK (INDICATED 26130001 * BY A TEXT REFERENCE IN PAR1(, PICKS UP CHAIN POINTER AND 26160001 * POINTS AT NEW BLOCK. IF THE NEW BLOCK IS NOT IN CORE IT IS 26190001 * BROUGHT INTO CORE. 26220001 * THE CURRENT BLOCK NEED NOT BE IN CORE. PAR2+3 CONTAINS A 26250001 * STATUS BYTE. THIS BYTE IS AS DESCRIBED IN ZUTXTC. THIS IS USED 26280001 * TO MARK THE CURRENT BLOCK. IF A SIGN BIT IS PLACED IN PAR1 26310001 * THEN THE STATUS OF THE NEXT BLOCK IN THE CHAIN IS UNCHANGED. 26340001 * THE REFERENCE OF THE NEXT BLOCK IN THE CHAIN IS FOUND IN 26370001 * THE LAST WORD BUT ONE IN THE TEXT BLOCK. THE LAST WORD IN THE 26400001 * TEXT BLOCK CONTAINS THE NAME OF THE BLOCK. 26430001 * 26460001 SPACE 2 26490001 ZCHAIN STM 14,CNTL2,12(DICR) GET WORK REGISTERS 26520001 L CNTL2,BASOF(CNTL) LOAD FIRST BASE 26550001 L CNTL3,BASES LOAD SECOND BASE 26580001 SPACE 26610001 BAL RR,CONSLT POINT AT SLOT IN TSLOTS 26640001 SPACE 26670001 CLI 0(GRA),X'FF' SEE IF BLOCK IS IN USE 26700001 BC BE,BLKERR 26730001 TM 0(GRA),X'80' TEST IF BLOCK IN CORE 26760001 BC BZ,ZCGET 26790001 SPACE 26820001 ZCBAK1 L GRB,0(0,GRA) PICK UP ADDRESS OF BLOCK 26850001 N GRB,STBITS ELIMINATE STATUS BITS 26880001 TM PAR2+3(DICR),X'FF' TEST IF STATUS CHANGE RQD TO 26910001 BC BM,CHNST CURRENT BLOCK 26940001 SPACE 26970001 ZCBAK2 A GRB,TXTSZ(0,DICR) ADD ON SPACE IN TEXT BLOCK 27000001 XC PAR1+2(2,DICR),PAR1+2(DICR) SET OFFSET TO ZERO 27030001 MVC PAR1+1(1,DICR),1(GRB) INSERT BLOCK NUMBER OF CHAIN BLK 27060001 BAL RR,CONSLT POINT AT CHAIN SLOT IN TSLOTS 27090001 SPACE 27120001 CLI 0(GRA),X'FF' SEE IF BLOCK IS IN USE 27150001 BC BE,BLKERR 27180001 TM 0(GRA),X'80' TEST IF BLOCK IN CORE 27210001 BC BO,ZCMARK 27240001 SPACE 27270001 MVC RDTTR(3),1(GRA) MOVE IN TRACK ADDRESS OF BLOCK 27300001 BAL RR,TRYMRT GET BLOCK INTO CORE 27330001 ST GR0,TEMP PICK UP ADDRESS OF NEW BLOCK 27360001 OI 0(GRA),X'80' MARK BLOCK AS IN CORE 27390001 MVC 1(3,GRA),TEMP+1 INSERT ADDRESS IN TSLOTS 27420001 SPACE 27450001 ZCMARK TM PAR1(DICR),X'80' TEST IF STATUS CHANGE REQUIRED 27480001 BC BO,ZCJUMP 27510001 MVI 0(GRA),X'84' OTHERWISE MARK BLOCK AS BUSY 27540001 SPACE 27570001 ZCJUMP L GRA,0(0,GRA) PICK UP ADDRESS OF BLOCK 27600001 N GRA,STBITS REMOVE STATUS BITS 27630001 ST GRA,PAR2(0,DICR) MOVE ABSOLUTE ADDRESS TO PAR2 27660001 SPACE 27690001 BC B,RETRTN BRANCH TO 'RETURN TO CALLER' ROUTINE 27720001 SPACE 27750001 ZCGET MVC RDTTR(3),1(GRA) MOVE IN TR ACK ADDRESS OF BLOCK 27780001 BAL RR,TRYMRT GET THE BLOCK INTO CORE 27810001 ST GR0,TEMP PICK UP ADDRESS OF NEW BLOCK 27840001 MVC 1(3,GRA),TEMP+1 STORE ADDRESS IN TSLOTS 27870001 OI 0(GRA),X'80' MARK BLOCK AS IN CORE 27900001 BC B,ZCBAK1 27930001 SPACE 27960001 CHNST NI 0(GRA),X'80' CLEAR ALL EXCEPT INCORE BIT 27990001 OC 0(1,GRA),PAR2+3(DICR) INSERT NEW STATUS BYTE 28020001 L GRC,0(0,GRA) PICK UP ADDRESS OF BLOCK 28050001 A GRC,TXTSZ(0,DICR) POINT AT END OF BLOCK 28080001 MVC 6(2,GRC),MYNAM(DICR) MOVE IN NAME OF PHASE ISNG BLOCK 28110001 BC B,ZCBAK2 28140001 SPACE 28170001 EJECT 28200001 * ROUTINE ZALTER 28230001 * THIS ROUTINE IS USED TO CHANGE THE STATUS OF A 28260001 * TEXT BLOCK. THE BLOCK NEED NOT BE IN CORE 28290001 * IF THE BLOCK IS ON DISK AND IS THEN MADE FREE, THE SLOT 28320001 * IS MARKED AS NOT IN USE (X'FF'). THE BLOCK NUMBER WILL THEN BE 28350001 * ALLOCATED AGAIN AT A LATER DATE. THE NUMBER OF TEXT BLOCKS IS 28380001 * REDUCED BY 1 28410001 SPACE 2 28440001 ZALTER STM 14,CNTL2,12(DICR) GET WORK REGISTERS 28470001 L CNTL2,BASOF(CNTL) LOAD FIRST BASE 28500001 L CNTL3,BASES LOAD SECOND BASE 28530001 SPACE 28560001 BAL RR,CONSLT POINT AT TSLOTS FOR THIS BLOCK 28590001 SPACE 28620001 CLI 0(GRA),X'FF' SEE IF BLOCK IS IN USE 28650001 BC BE,BLKERR 28680001 NI 0(GRA),X'80' CLEAR ALL STATI EXCEPT IN-CORE 28710001 OC 0(1,GRA),PAR2+3(DICR) BIT. INSERT STATUS BYTE 28740001 CLI 0(GRA),X'01' SEE IF STATUS IS NOW ON-DISK AND 28770001 BC BNE,RETRTN FREE. IF NOT,GO TO RETURNING ROUTINE 28800001 MVI 0(GRA),X'FF' SHOW SLOT IS FREE 28830001 SPACE 28860001 BC B,RETRTN BRANCH TO 'RETURN TO CALLER' ROUTINE 28890001 EJECT 28920001 * ROUTINE ZTXTAB 28950001 * CONVERTS A TEXT REFERENCE TO AN ABSOLUTE ADDRES 28980001 * PAR1 WILL CONTAIN THE REFERENCE TO BE CONVERTED. IF THE BLOCK 29010001 * IS NOT IN CORE IT WILL BE BROUGHT INTO CORE. 29040001 * THE BLOCK WILL BE MARKED IN-CORE AND BUSY UNLESS THERE 29070001 * IS A SIGN BIT IN PAR1. IN THIS CASE THE STATUS OF THE BLOCK 29100001 * WILL NOT CHANGE 29130001 SPACE 2 29160001 ZTXTAB STM 14,CNTL2,12(DICR) GET WORK REGISTERS 29190001 L CNTL2,BASOF(CNTL) LOAD FIRST BASE 29220001 L CNTL3,BASES LOAD SECOND BASE 29250001 ST DICR,DICTEM STORE ADDRESS OF THIS SAVE AREA 29280001 L DICR,DADDR POINT AT DICTIONARY 29310001 SPACE 29340001 BAL RR,CONSLT POINT AT CORRECT TSLOTS SLOT 29370001 CLC TSLOTEND+1(3),1(GRA) IS BLOCK TTR TOO HIGH? 30357 29380020 BNH BLKERR YES 30357 29390020 SPACE 29400001 CLI 0(GRA),X'FF' SEE IF BLOCK IS IN USE 29430001 BC BE,BLKERR 29460001 TM 0(GRA),X'80' TEST IF BLOCK IS IN CORE 29490001 BC BZ,TABD 29520001 SPACE 29550001 TABR TM PAR1(DICR),X'80' SEE IF STATUS CHANGE REQUIRED 29580001 BC BO,SAME 29610001 MVI 0(GRA),X'84' MARK AS INCORE AND BUSY 29640001 SAME L GRA,0(0,GRA) PICK UP ADDRESS AND STATUS BITS 29670001 N GRA,STBITS GET RID OF STATUS BITS 29700001 AH GRA,PAR1+2(0,DICR) ADD OFFSET OF ORIGINAL REFERENCE 29730001 ST GRA,PAR1(0,DICR) INSERT ABSOLUTE ADDRESS 29760001 L DICR,DICTEM POINT AT SAVE AREA AGAIN 29790001 BC B,RETRTN BRANCH TO 'RETURN TO CALLER' ROUTINE 29820001 SPACE 29850001 TABD MVC RDTTR(3),1(GRA) PICK UP TTR OF BLOCK 29880001 BAL RR,TRYMRT GET BLOCK INTO CORE 29910001 ST GR0,TEMP PICK UP ADDRESS OF BLOCK AND 29940001 MVC 1(3,GRA),TEMP+1 STORE IN TSLOTS. STATUS LEFT ALONE 29970001 OI 0(GRA),X'80' MARK BLOCK AS IN CORE 30000001 BC B,TABR 30030001 EJECT 30060001 * ROUTINE ZTXTRF 30090001 * THIS ROUTINE CONVERTS AN ABSOLUTE ADDRESS TO 30120001 * A TEXT REFERENCE. PAR2 CONTAINS THE ABSOLUTE ADDRESS TO BE 30150001 * CONVERTED. PAR1 WILL CONTAIN ANY REFERENCE FOR THE BLOCK 30180001 * CONTAINING THE ABSOLUTE ADDRESS. 30210001 * IF THE REFERENCED BLOCK IS NOT IN CORE THEN THE COMPILER 30240001 * WILL TERMINATE 30270001 SPACE 2 30300001 ZTXTRF STM 14,CNTL2,12(DICR) GET WORK REGISTERS 30330001 L CNTL2,BASOF(CNTL) LOAD FIRST BASE 30360001 L CNTL3,BASES LOAD SECOND BASE 30390001 SPACE 30420001 BAL RR,CONSLT POINT AT TSLOTS FOR THIS REFRNCE 30450001 SPACE 30480001 CLI 0(GRA),X'FF' SEE IF BLOCK IS IN USE 30510001 BC BE,BLKERR 30540001 TM 0(GRA),X'80' TEST IF BLOCK IN CORE 30570001 BC BZ,TRFER 30600001 SPACE 30630001 L GR0,0(GRA) PICK UP ADDRESS 30660001 N GR0,STBITS REMOVE STATUS BITS 30690001 S GR0,PAR2(0,DICR) SUBTRACT ABSOLUTE ADDRESS TO GET 30720001 LPR GR0,GR0 OFFSET. SET TO A POSITIVE VALUE 30750001 STH GR0,PAR1+2(0,DICR) CREATE REFERENCE 30780001 SPACE 30810001 BC B,RETRTN BRANCH TO 'RETURN TO CALLER' ROUTINE 30840001 SPACE 30870001 TRFER MVC PAR6+1(3,DICR),ERRF05 TEXT BLOCK NOT IN CORE 32318 30890020 BAL RR,PASMYNAM PICK UP PHASE NAME 32318 30910020 L LR,DYNAMOF(CNTL) POINT AT DYNAMIC 30930001 BALR RR,LR ROUTINE IN AA 30960001 SPACE 30990001 ERRF05 DC X'0F05C0' 32318 31020020 EJECT 31050001 * THESE INSTRUCTIONS GENERATE AN ERROR MESSAGE WHEN A 31080001 * REFERENCED BLOCK IS NOT IN USE. THE COMPILER IS ABORTED. 31110001 * 31140001 BLKERR MVC PAR6+1(3,DICR),ERRF0C REFERENCED BLOCK NOT IN USE 31170001 BAL RR,PASMYNAM PICK UP PHASE NAME 32318 31180020 L LR,DYNAMOF(CNTL) POINT AT DYNAMIC 31200001 BALR RR,LR ROUTINE IN AA 31230001 ERRF0C DC X'0F0CC0' 32318 31235020 SPACE 3 31240020 * THIS ROUTINE PASSES THE NAME OF THE ACTIVE PHASE 32318 31245020 * AT ERROR-GENERATION TIME TO ZUERR. 32318 31250020 SPACE 1 31255020 PASMYNAM LH GRC,MYNAM(0,DICR) PICK UP PHASE LOADED NAME 31259021 SH GRC,=X'B0B0' CHANGE TO INTERNAL CODE 31263021 STH GRC,NAMESL SAVE NAME 31267021 LA GRC,NAMESL PASS ADDR OF NAME SAVE 31271021 ST GRC,PAR7(0,DICR) SLOT TO MSG. 31275021 MVC PAR8+2(2,DICR),K2+2 SET LGTH 2 FOR PHASE NAME 47635 31277056 BR RR ISSUE MSG. 31279021 NAMESL DS H NAME SAVE SLOT 31283021 EJECT 31290001 * ROUTINE ZUGC 31320001 * THIS ROUTINE ALLOCATES SPACE TO THE PHASES. ONE 31350001 * 4K BLOCK IS RESERVED FOR THIS PURPOSE. IF THE BLOCK IS FULLY 31380001 * USED A BLOCK OF TEXT OR DICTIONARY SIZE IS GIVEN. THIS IS TO 31410001 * REDUCE THE POSSIBILITY OF STORAGE BINDS ON SMALL SYSTEMS. THE 31440001 * BLOCKS ARE MARKED IN CONDIR AS T OR D BLOCKS. THEY ARE RELEASD 31470001 * TO THE SYSTEM BY A FREEMAIN AT THE REQUIRED TIME. THE INITIAL 31500001 * 4K BLOCK IS NEVER RELEASED TO THE SYSTEM. 31530001 * REQUESTS FOR SCRATCH CORE ARE MADE BY INSERTING A COUNT 31560001 * IN PAR1+3(1 BYTE). THIS COUNT WILL SHOW HOW MANY BLOCKS OF 512 31590001 * BYTES ARE REQUIRED IN ONE CONTIGUOUS LUMP. THIS REQUEST FOR A 31620001 * 5X512 BLOCK (SAY) IS KNOWN AS 1 ALLOCATION. THIS IS IMPORTANT 31650001 * FOR THE UNDERSTANDING OF ZURC,THE RELEASING OF SCRATCH CORE 31680001 * ALLOCATIONS 31710001 SPACE 2 31740001 ZUGC STM 14,CNTL2,12(DICR) GET WORK REGISTERS 31770001 L CNTL2,BASOF(CNTL) LOAD FIRST BASE 31800001 L CNTL3,BASES LOAD SECOND BASE 31830001 SPACE 31860001 XR GR0,GR0 31890001 IC GR0,PAR1+3(0,DICR) PICK UP NUMBER OF 512 BYTES 31920001 SLA GR0,9 NOW CONTAINS THE BYTES REQUIRED 31950001 SPACE 31980001 GCCHAN BC NOP,GCFST BRANCH ON EVERY-ONE EXCEPT FIRST 32010001 MVI GCCHAN+1,X'F0' CHANGE GCCHAN TO A PERMANENT BRC 32040001 LA GRA,CONDIR 32070001 ST GRA,POINTR POINT AT CONDIR 32100001 XC CONCNT(4),CONCNT SET NUMBER OF ENTRIES TO ZERO 32130001 SPACE 32160001 GCFST CL GR0,FR96 SEE IF REQUEST IS GRTR THAN 4K 32190001 BC BH,GCERR 32220001 SPACE 32250001 L GRA,POINTR POINT AT CONDIR 32280001 CLI 0(GRA),X'FF' IS IT AT STOPPER IN TABLE 32310001 BC BE,GCOUT NO CORE ALLOCATED IF CONDIR FULL 32340001 SPACE 32370001 CL GR0,ALLOCL ENOUGH SPACE LEFT IN FIRST 4K 32400001 BC BH,GETBLK 32430001 SPACE 32460001 LM GRB,GRC,ALLOCA PICK UP ADDRESS OF ALLOCATED COR 32490001 ST GRB,0(0,GRA) STORE ADDRESS IN CONDIR 32550001 ST GR0,4(0,GRA) STORE AMOUNT IN CONDIR 32580001 ST GRB,PAR1(0,DICR) STORE ADDRESS OF ALLOCATED CORE 32610001 AR GRB,GR0 ALLOCA=ALLOCA+AMOUNT 32640001 SR GRC,GR0 ALLOCL=ALLOCL-AMOUNT 32670001 STM GRB,GRC,ALLOCA RESTORE ALLOCA AND ALLOCL 32700001 ST GR0,PAR2(0,DICR) STORE AMOUNT OF ALLOCATED CORE 32730001 SPACE 32760001 GCBACK LA GRA,8(0,GRA) BUMP TO NEXT IN CONDIR 32790001 L GRB,CONCNT 32820001 LA GRB,1(0,GRB) COUNT NUMBER OF ENTRIES IN CONDR 32850001 STM GRA,GRB,POINTR STORE POINTR AND CONCNT 32880001 SPACE 32910001 BC B,RETRTN BRANCH TO 'RETURN TO CALLER' ROUTINE 32940001 SPACE 32970001 GETBLK LA GRB,TSLOTS+24 POINT AT TEXT BLOCK CONTROL 33000001 XR GRC,GRC THIS WILL BE USED FOR COUNTING 33030001 SPACE 33060001 GCLOOP TM 0(GRB),X'80' SEE IF BLOCK IS IN CORE 33090001 BC BZ,NOTINC 33120001 TM 0(GRB),X'70' 33150001 BC BO,NOTINC 33170001 LA GRC,1(0,GRC) COUNT 1 BLOCK AS IN CIRE 33190001 NOTINC LA GRB,4(0,GRB) BUMP TO NEXT IN CONTROL AREA 33210001 CLI 1(GRB),X'FF' SEE IF IT IS A STOPPER 33240001 BC BNE,GCLOOP 33270001 CL GRC,FOUR SEE IF ENOUGH CORE BLOCKS AVAIL 33310001 BC BNH,GCOUT -ABLE TO STEAL ONE 33350001 * THE ABOVE CODE IS UNSOPHISTICATED AND NEEDS EXPANDING TO 33390001 * TO FIND IF ALL CORE HAS BEEN UDES YET. 33430001 * TEST FOR K PHASES RUNNING 33470001 XC RDTTR(4),RDTTR INDICATE NO READ REQUIRED 33510001 BAL RR,TRYMRT GET SPARE BLOCK,SPILL IF NEC 33550001 SPACE 1 33590001 LR GRB,GR0 PICK UP NEW BLOCK ADDR 33630001 L GRC,DICTSZ(0,DICR) PICK UP LENGTH 33690001 STM GRB,GRC,PAR1(DICR) PUT IN PARAMETER WORDS 33720001 STM GRB,GRC,0(GRA) STORE IN CONDIR 33750001 OI 0(GRA),X'80' MARK AS T OR D ALLOCATION 33810001 BC B,GCBACK 33840001 SPACE 33870001 GCOUT XC PAR2(4,DICR),PAR2(DICR) SET PAR2 TO 0 TO SHOW NO ALLOCTN 33900001 BC B,RETRTN BRANCH TO 'RETURN TO CALLER' ROUTINE 33930001 SPACE 33960001 GCERR MVC PAR6+1(3,DICR),ERRF07 TOO MUCH SCRATCH REQUESTED 32318 33980020 BAL RR,PASMYNAM PICK UP PHASE NAME 32318 34000020 LA DICR,ABSAV POINT AT NEW SAVE AREA 34020001 BAL RR,ZUERR 34050001 L DICR,DADDR POINT BACK AT OLD SAVE AREA 34080001 BC B,GCOUT 34110001 SPACE 34140001 ERRF07 DC X'0F07C0' 32318 34170020 EJECT 34200001 * ROUTINE ZURC 34230001 * THIS ROUTINE WILL RELEASE CORE ALLOCATED BY 34260001 * ZUGC. THE MOST RECENT REQUESTS ARE RELEASED. A ZERO PARAMETER 34290001 * IS IGNORED. THE NUMBER OF REQUIRED RELEASES IS PASSED IN PAR1. 34320001 * IF THE BLOCK HAS BEEN OBTAINED BY A TRYMRD OR TRYMRT THEN THE 34350001 * BLOCK IS RELEASED BY A FREEMAIN. OTHERWISE ADJUSTMENTS ARE 34380001 * MADE TO ALLOCA AND ALLOCL 34410001 SPACE 2 34440001 ZURC STM 14,CNTL2,12(DICR) GET WORK REGISTERS 34470001 L CNTL2,BASOF(CNTL) LOAD FIRST BASE 34500001 L CNTL3,BASES LOAD SECOND BASE 34530001 LA GRA,SAVARD POINT AT NEXT SAVE AREA 34560001 ST DICR,4(0,GRA) CHAIN FORWARDS 34590001 ST GRA,8(0,DICR) CHAIN BACKWARDS 34620001 SPACE 34650001 XR GR0,GR0 PICK UP COUNT OF NUMBER OF 34680001 IC GR0,PAR1+3(0,DICR) REQUIRED RELEASES 34710001 SPACE 34740001 LTR GR0,GR0 TEST IF ZERO COUNT 34770001 BC BZ,RCRTN 34800001 CL GR0,CONCNT TEST IF TOO MANY RELEASES 34830001 BC BH,RCERR 34860001 SPACE 34890001 LM GRA,GRD,ALLOCA GRA=ALLOCA,GRB=ALLOCL,GRC=POINTR 34920001 RCLOP S GRC,EIGHT GRD=CONCNT. REDUCE TO PREVIOUS 34950001 TM 0(GRC),X'80' CONDIR ENTRY. TEST FOR TRYMRD OR 34980001 BC BO,RCBLOK TRYMRT MARKER 35010001 S GRA,4(0,GRC) ALLOCA=ALLOCA-LENGTH 35040001 A GRB,4(0,GRC) ALLOCL=ALLOCL+LENGTH 35070001 RCBAK BCTR GRD,0 REDUCE CONCNT BY 1 35100001 BCT GR0,RCLOP 35130001 SPACE 35160001 RCRTN STM GRA,GRD,ALLOCA RESTORE ADDRESSES,COUNTS,ETC 35190001 BC B,RETRTN BRANCH TO 'RETURN TO CALLER' ROUTINE 35220001 SPACE 35250001 RCBLOK STM 0,2,TEMP STORE AWAY REGS 35280001 L 0,4(0,GRC) PICK UP LENGTH 35310001 L 1,0(0,GRC) PICK UP ADDRESS 35340001 N 1,STBITS REMOVE BLOCK MARK FROM TOP BYTE 35370001 CLI SPILL,X'00' BRANCH IF SPILLING 35380001 BNE RCTXBL TO GIVE BACK VIA TSLOTS 35390001 LA DICR,SAVARD POINT AT SAVE AREA FOR FREEMAIN 35400001 SPACE 35430001 SPACE 35460001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AL 001-TSS 35490001 FREEMAIN R,LV=(0),A=(1) 35520001 * ----------------------------------------------------AL 001-TSS 35550001 SPACE 35580001 SPACE 35610001 L DICR,DADDR RESTORE TO PREVIOUS SAVE AREA 35640001 L 0,CORLFT(0,DICR) 35670001 A 0,4(0,GRC) CORLFT=CORLFT+LENGTH RELEASED 35700001 ST GR0,CORLFT(0,DICR) 35730001 BC B,RCTX2 35737001 SPACE 1 35744001 RCTXBL LA 2,TSLOTS+24 LOOK FOR SPARE TSLOT 35751001 RCTX3 CLI 0(2),X'FF' 35758001 BNE RCTX1 35765001 ST 1,0(2) FOUND 35772001 MVI 0(2),X'81' SPARE T BLOCK CREATED 35779001 RCTX2 LM 0,2,TEMP RESTORE REGS 35786001 B RCBAK 35793001 SPACE 1 35800001 RCTX1 LA 2,4(2) BUMP TO NEXT TSLOT 35807001 CLI 1(2),X'FF' 35814001 BNE RCTX3 35821001 SPACE 1 35828001 MVC PAR6+1(3,DICR),ERR18 END OF TSLOTS,COULD LOOK FOR 35835001 L LR,DYNAMOF(CNTL) DSLOT BUT THIS IS IDSASTER 35842001 BALR RR,LR REALLY 35849001 SPACE 1 35856001 ERR18 DC X'0F1A00' 35863001 SPACE 2 35870001 RCERR MVC PAR6+1(3,DICR),ERRF08 ATTEMPT TO RELEASE 32318 35880020 * UNALLOCATED CORE 32318 35890020 BAL RR,PASMYNAM PICK UP PHASE NAME 32318 35900020 L LR,DYNAMOF(CNTL) POINT AT DYNAMIC 35910001 BALR RR,LR ROUTINE IN AA 35940001 SPACE 35970001 ERRF08 DC X'0F08C0' 32318 36000020 EJECT 36030001 ALLOCA DC F'0' ADDRESS AND LENGTH OF SPACE 36060001 ALLOCL DC F'0' WITHIN FIRST 4K BLOCK 36090001 POINTR DC F'0' POINTER TO NEXT AVAILABLE SPACE 36120001 CONCNT DC F'0' IN CONDIR AND NUMBER OF ENTRIES 36150001 CONDIR DC 32F'0' LIST OF ALLOCATIONS 36180001 DC X'FF' STOPPER FOR LONDIR TABLE 36210001 DSLOTS DC 6F'0' 36240001 DC 128XL4'FF000000' 36270001 DC X'00FF0000' 36300001 TSLOTS DC 6F'0' 36330001 DC 90XL4'FF000000' 36360001 TSLOTEND DC X'00FF0000' END OF TSLOTS MARKER 30357 36400020 SPACE 36420001 FR96 DC F'4096' 36450001 DICTEM DC F'0' 36480001 FOUR DC F'4' 36510001 EIGHT DC F'8' 36540001 TEMP DS F 36570001 TEMP1 DS F 36600001 TEMP2 DS F 36630001 TEMP4 DS F 36660001 STBITS DC X'00FFFFFF' 36690001 ZEROS DC XL4'00' PERMANENT ZEROS LOCATION 36720001 TW56 DC F'256' 36750001 NEXTAD DC F'0' 36780001 NOTTR DC F'0' 36810001 THREE DC XL4'03' 36840001 MASKX DC X'FFFFFFFC' 36870001 NEGBIT DC X'0000FFFF' 36900001 WRTLTH DC F'0' 36930001 RDTTR DC F'0' 36960001 CNOP 0,8 36990001 CONVAR DC F'0' 37020001 DC F'0' 37050001 CHANSW DC X'00' 37080001 WRTON DC X'00' 37110001 MAKSW DC X'00' 37170001 BMNAM DC C'BM' 37200001 KTNAM DC C'KT' 37230001 FSWTCH DC X'00' 37260001 BTCHCD DC C'*' 37290001 ERRMS DC X'0036' 37320001 DC C'-' 37350001 DC C'IEM3853I SOURCE PROGRAM TOO LARGE.' 37380001 DC C' DICTIONARY IS FULL.' 37410001 OFLMES DC X'0047' 24700 37416019 DC C'-' 24700 37422019 DC C'IEM3909I EXTENDED DICTIONARY CAPACITY EXCEEDED.' 24700 37428019 DC C' COMPILATION TERMINATED.' 24700 37434019 UTIMES DC X'001C' 37440001 DC C'-' 37470001 DC C'IEM3864I I/O ERROR ON SYSUT1' 37500001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AL 030-TSS 37510020 OPERR1 DC X'001E' 37530001 DC C'-' 37560001 DC C'IEM3878I UNABLE TO OPEN SYSUT1' 37590001 * ----------------------------------------------------AL 030-TSS 37690020 EJECT 37830001 * ROUTINE ZUERR. 37860001 SPACE 37890001 * THIS ROUTINE INSERTS AN ERROR MESSAGE INTO THE 37920001 * DICTIONARY. 37950001 SPACE 37980001 *********************************************************************** 38010001 ** ** 38040001 ** INVOCATION OF THIS ROUTINE IS EQUIVALENT TO TWICE ** 38070001 ** REFERENCING THE DICTIONARY IN THAT THE TWO BLOCKS LAST ** 38100001 ** REFERENCED ARE THE LAST IN THE ERROR CHAIN AND THE ONE IN ** 38130001 ** WHICH THE CURRENT MESSAGE IS INSERTED. ** 38160001 ** ** 38190001 *********************************************************************** 38220001 SPACE 38250001 * ON ENTRY THIS ROUTINE EXPECTS TO FIND - 38280001 SPACE 38310001 * (A) LOCATION PAR6 WILL HOLD THE INDICATOR BYTES. THESE ARE 38340001 SPACE 38370001 * (1) THE FIRST BYTE IS NOT USED. 38400001 * (2) THE SECOND AND THIRD BYTES IDENTIFY THE MESSAGE. 38430001 SPACE 38460001 * (3) THE FIRST BIT OF THE FOURTH BYTE IS ONE IF TEXT 38490001 * IS TO ACCOMPANY THE MESSAGE. 38520001 SPACE 38550001 * (4) THE SECOND BIT OF THE FOURTH BYTE IS ONE IF THE 38580001 * STATEMENT NUMBER IS RELEVANT. 38610001 SPACE 38640001 * (5) THE THIRD BIT OF THE FOURTH BYTE IS ONE IF THE 38670001 * MESSAGE HAS ASSOCIATED WITH IT A NUMERIC PARAMETER. 38700001 SPACE 38730001 * (6) THE FOURTH BIT OF THE FOURTH BYTE IS ONE IF THE 38760001 * MESSAGE HAS ASSOCIATED WITH IT A DICTIONARY REFERENCE. 38790001 SPACE 38820001 * (7) THE LAST FOUR BITS OF THE FOURTH BYTE CONTAIN THE 38850001 * SEVERITY CODE - 38880001 SPACE 38910001 * 0000 DISASTROUS 38940001 * 0100 SERIOUS 38970001 * 1000 WARNING 39000001 * 1100 COMMENT 39030001 SPACE 39060001 * (B) IF THERE IS TO BE TEXT THEN PAR7 WILL HOLD A POINTER 39090001 * TO IT AND PAR8 WILL HOLD THE LENGTH COUNT. 39120001 SPACE 39150001 * (C) IF THERE IS TO BE A NUMERIC PARAMETER THEN ITS BINARY 39180001 * VALUE MUST BE IN PAR5 39210001 SPACE 39240001 * (D) IF THERE IS AN ASSOCIATED DICTIONARY REFERENCE THEN 39270001 * IT MUST APPEAR RIGHT ADJUSTED IN PAR7. 39300001 SPACE 39330001 ZUERR STM 14,CNTL2,12(GRDIC) GET SOME WORK REGISTERS 39360001 L CNTL2,BASOF(CNTL) LOAD FIRST BASE 39390001 L CNTL3,BASES LOAD SECOND BASE 39420001 LA GRA,ZA107 POUNT AT NEW SAVE AREA 39450001 ST GRDIC,4(0,GRA) CHAIN FORWARDS 39480001 ST GRA,8(0,GRDIC) CHAIN BACKWARDS 39510001 L GRDIC,DADDR POINT AT TRUE DICTIONARY 39540001 SPACE 39570001 MVC TEMPY(8),PAR1(DICR) STORE PAR1 AND 2 39600001 CLI MYNAM(GRDIC),C'X' IF THE CALL IS FROM THE ERROR 39630001 BC BE,ZR51+4 MECHANISM WE SHALL IGNORE IT. 39660001 CLC MYNAM(2,GRDIC),BMNAM IF CALL IS FROM BM 39690001 BC BE,ZR51+4 IGNORE IT 39720001 SPACE 39750001 ST GR5,ZR3+2 39780001 SPACE 39810001 LA GR1,8(0,0) MINIMUM LENGTH COUNT. 39840001 SPACE 39870001 TM PAR6+3(GRDIC),X'70' TEST FOR STATEMENT NUMBER, 39900001 BC BZ,ZR50 PARAMETER AND DICT. REFERENCE. 39930001 SPACE 39960001 IC RR,PAR6+3(0,GRDIC) GET SIXTEEN TIMES THE OPTIONS 39990001 N RR,ZR1+2 CODE INTO RR 40020001 LR LR,RR AND FOUR TIMES IT INTO LR 40050001 SRL LR,2 40080001 AR RR,LR TWENTY TIMES THE OPTIONS CODE 40110001 * INTO RR 40140001 SPACE 40170001 CNOP 0,4 40200001 SPACE 40230001 BC B,*-16(RR) BRANCH APPROPRIATELY 40260001 SPACE 40290001 * HERE THE OPTIONS BITS SAID ONE. 40320001 * WE HAVE A DICTIONARY REFERENCE ONLY. 40350001 SPACE 40380001 LA GR1,10(0,0) PUT TEN IN THE LENGTH COUNT AND 40410001 MVC ZR104(2),PAR7+2(GRDIC) MOVE IN THE DICTIONARY REFERENCE 40440001 BC B,ZR50 40470001 SPACE 40500001 ZR1 DC X'000A' TEXT LENGTH COMPARISON 40530001 DC X'00000070' MASK FOR REGISTER 40560001 SPACE 40590001 * HERE THE OPTIONS BITS SAID TWO. 40620001 * WE HAVE A NUMERIC PARAMETER ONLY. 40650001 SPACE 40680001 LA GR1,10(0,0) PUT TEN IN THE LENGTH COUNT 40710001 MVC ZR104(2),PAR5+2(GRDIC) AND MOVE IN THE PARAMETER 40740001 BC B,ZR50 40770001 SPACE 40800001 DC X'0004' 40830001 ZR2 DC X'0000000F' MASK FOR REGISTER 40860001 SPACE 40890001 * HERE THE OPTIONS BITS SAID THREE. 40920001 * WE HAVE BOTH A NUMERIC PARAMETER AND A DICTIONARY 40950001 * REFERENCE. 40980001 SPACE 41010001 LA GR1,12(0,0) LENGTH COUNT TO TWELVE AND MOVE 41040001 MVC ZR104(2),PAR5+2(GRDIC) IN FIRST THE PARAMETER AND THEN 41070001 MVC ZR105(2),PAR7+2(GRDIC) THE DICTIONARY REFERENCE. 41100001 BC B,ZR50 41130001 SPACE 41160001 * HERE THE OPTIONS BITS SAID FOUR. 41190001 * WE HAVE ONLY A STATEMENT NUMBER. 41220001 SPACE 41250001 LA GR1,10(0,0) LENGTH COUNT TO TEN AND MOVE IN 41280001 BAL RR,CONSTT PICK UP STATEMENT NUMBER 41310001 BCR NOP,0 41340001 BC B,ZR50 41370001 SPACE 41400001 ZR3 DS 1H 41430001 DS 1F TEMPORARY STORAGE 41460001 SPACE 41490001 * HERE THE OPTIONS BITS SAID FIVE. 41520001 * WE HAVE A STATEMENT NUMBER AND A DICTIONARY REFERENCE. 41550001 SPACE 41580001 LA GR1,12(0,0) LENGTH COUNT TO TWELVE AND MOVE 41610001 BAL RR,CONSTT PICK UP STATEMENT NUMBER 41640001 BCR NOP,0 41670001 MVC ZR105(2),PAR7+2(GRDIC) DICTIONARY REFERENCE 41700001 BC B,ZR50 41730001 SPACE 41760001 * HERE THE OPTIONS BITS SAID SIX. 41790001 * WE HAVE A STATEMENT NUMBER AND A NUMERIC PARAMETER. 41820001 SPACE 41850001 LA GR1,12(0,0) LENGTH COUNT TO TWELVE AND MOVE 41880001 BAL RR,CONSTT 41910001 BCR NOP,0 41940001 MVC ZR105(2),PAR5+2(GRDIC) BY THE NUMERIC PARAMETER. 41970001 BC B,ZR50 42000001 SPACE 42030001 * HERE THE OPTIONS BITS SAID SEVEN. 42060001 * WE HAVE A FULL HOUSE. 42090001 SPACE 42120001 LA GR1,14(0,0) MAXIMUM LENGTH COUNT AND MOVE 42150001 BAL RR,CONSTT PICK UP STATEMENT NUMBER 42180001 BCR NOP,0 42210001 MVC ZR105(2),PAR5+2(GRDIC) FOLLOWED BY NUMERIC PARAMETER 42240001 MVC ZR106(2),PAR7+2(GRDIC) FOLLOWED BY DICTIONARY REFRNCE. 42270001 SPACE 42300001 * WE HAVE INSERTED THE OPTIONS, IF ANY, AND ARE ABOUT TO 42330001 * COMPLETE THE ENTRY. 42360001 SPACE 42390001 ZR50 STH GR1,ZR101 PUT IN THE LENGTH COUNT AND THE 42420001 MVC ZR103(3),PAR6+1(GRDIC) INDICATOR BYTES. 42450001 SPACE 42480001 * WE NOW SLOT THE ENTRY INTO THE DICTIONARY 42510001 *********************************************************************** 42540001 ST GR1,PAR2(0,GRDIC) ON RETURN THE LOCATION PAR1 42570001 LA GR1,ZR100+1 CONTAINS THE DICTIONARY 42600001 ST GR1,PAR1(0,GRDIC) REFERENCE OF THE LAST MADE 42630001 LA GRDIC,ZA107 POINT AT SAVE AREA 42660001 BAL RR,ZDICRF ENTRY 42690001 L GRDIC,DADDR POINT AT DICTIONARY 42720001 *********************************************************************** 42750001 SPACE 42780001 MVC ZR3(2),PAR1+2(GRDIC) SLOT AWAY THE DICTIONARY 42810001 * REFERENCE 42840001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AL 011-TSS 42870001 * ----------------------------------------------------AL 011-TSS 42900001 SPACE 42930001 * WE MUST NOW LINK THIS ENTRY TO THE CORRECT ERROR CHAIN. 42960001 SPACE 42990001 L GRB,PAR6(0,GRDIC) LOAD SEVERITY CODE 43020001 N GRB,ZR2 AND USE IT AS AN INDEX 43050001 SPACE 43080001 * POINT GR1 AT THE CORRECT CHAIN TERMINATOR 43110001 SPACE 43140001 LA GR1,ZDNXT+2(GRB,GRDIC) 43170001 SPACE 43200001 * POINT GR5 AT THE LAST ENTRY IN THE CHAIN 43230001 SPACE 43260001 CLC 0(2,GR1),ZEROS TEST IF THIS IS THE 1ST ENTRY OF 43290001 * THIS SEVERITY (IF IT IS THE CHAIN 43320001 * TERMINATOR POINTER WILL BE ZERO) 43350001 BC BNE,ZR54 NO, FIND PREVIOUS ENTRY ABSOLUTELY 43380001 * 43410001 LA GR5,ZERRD-1(GRB,GRDIC) YES, POINT REG5 3 BYTES BEFORE 43440001 * APPROPRIATE HEADER SLOT (PRETEND 43470001 * THAT THE HEADER SLOT IS PART OF A 43500001 * PREVIOUS ENTRY) 43530001 BC B,ZR55 OMIT CALL TO ZDRFAB 43560001 SPACE 43590001 ZR54 MVC PAR1+2(2,GRDIC),0(GR1) 43620001 SPACE 43650001 *********************************************************************** 43680001 LA GRDIC,ZA107 POINT AT SAVE AREA 43710001 BAL RR,ZDRFAB 43740001 L GRDIC,DADDR POINT AT DICTIONARY 43770001 *********************************************************************** 43800001 SPACE 43830001 L GR5,PAR1(0,GRDIC) 43860001 SPACE 43890001 * MOVE IN THE POINTER. 43920001 SPACE 43950001 ZR55 MVC 3(2,GR5),ZR3 TO THE LAST ENTRY AND TO 43980001 MVC 0(2,GR1),ZR3 THE CHAIN TERMINATOR 44010001 SPACE 44040001 * AND PROCESS TEXT, IF ANY. 44070001 SPACE 44100001 TM PAR6+3(GRDIC),X'80' TEST THE TEXT BIT 44130001 BC BO,ZR52 44160001 SPACE 44190001 * HERE WE HAVE NO TEXT, OR WE HAVE PROCESSED IT. 44220001 SPACE 44250001 ZR51 L GR5,ZR3+2 44280001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AL 012-TSS 44310001 * ----------------------------------------------------AL 012-TSS 44340001 MVC PAR1(8,DICR),TEMPY RESTORE PAR1 AND 2 44370001 LA GRDIC,ZA107 POINT AT SAVE AREA 44400001 L GRDIC,4(0,GRDIC) PICK UP ADDR OF PREVIOUS AREA 44430001 BC B,RETRTN BRANCH TO 'RETURN TO CALLER' ROUTINE 44460001 SPACE 44490001 * HERE WE HAVE TEXT TO SLOT IN. 44520001 SPACE 44550001 * WE WILL NOT SLOT IN MORE THAN TEN CHARACTERS OF TEXT. 44580001 SPACE 44610001 ZR52 LH GR1,PAR8+2(GRDIC) LOAD TEXT LENGTH 44640001 LTR GR1,GR1 IF NEGATIVE LENGTH 44670001 BC BNM,ZR52A THEN SPECIAL 44700001 LPR GR1,GR1 STMT NO. ENTRY 44730001 MVI ZR102,X'01' * DENOTE STMT NO ENTRY 60037 44760072 BC B,ZR53 44790001 ZR52A CH GR1,ZR1 44820001 BC BL,ZR53 BTANCH IF LOWER THAN 10 44850001 LH GR1,ZR1 SET LENGTH TO TEN 44880001 MVI ZR102,X'FF' * DENOTE TRUNCATED TEXT 60037 44910072 ZR53 BCTR GR1,0 * SET UP FOR FINAL MVC OF 60037 44940072 STC GR1,DICMVC+1 * TEXT INTO DICT. ENTRY 60037 44960072 LA GR1,5(GR1) * GR1 = TOTAL LENGTH OF 60037 44980072 ST GR1,PAR2(0,GRDIC) * DICT. ENTRY TO BE MADE 60037 45000072 STH GR1,ZR101 STORE LENGTH IN SKELETON 60037 45020072 LA GR1,ZR100+1 * POINT AT SKELETON 60037 45040072 ST GR1,PAR1(0,GRDIC) * PAR1 -> SKEL. PAR2 = LENGTH 37 45060072 SPACE 45090001 *********************************************************************** 45120001 SPACE 45150001 LA GRDIC,ZA107 POINT AT SAVE AREA 45180001 BAL RR,ZDICRF 45210001 L GRDIC,DADDR POINT AT DICTIONARY 45240001 SPACE 45270001 *********************************************************************** 45300001 SPACE 45330001 * THE SKELETON DICTIONARY ENTRY HAS BEEN MADE. PAR4 NOW 60037 45360072 * CONTAINS THE ABSOLUTE ADDRESS OF THE SKELETON ENTRY IN 60037 45390072 * THE DICTIONARY. IT REMAINS TO MOVE THE TEXT INTO THE ENTRY 037 45420072 SPACE 1 45450072 L GR1,PAR4(0,GRDIC) * PICK UP A(DICT. ENTRY) 60037 45480072 L GR5,PAR7(0,GRDIC) * PICK UP A(TEXT TO BE MOVED) 37 45510072 DICMVC MVC 4(*-*,GR1),0(GR5) * MOVE TEXT TO DICT ENTRY 60037 45540072 MVI ZR102,X'00' * REINITIALIZE INDICATOR BYTE 37 45570072 B ZR51 * RETURN 60037 45600072 SPACE 45630001 CNOP 0,4 45660001 SPACE 45690001 ZR100 DC XL2'00C8' ERROR MESSAGE CODE BYTE 45720001 ZR101 DC XL2'0000' LENGTH COUNT 45750001 ZR102 DC XL2'0000' SYMBOLIC CHAIN 45780001 ZR103 DC XL3'000000' INDICATOR BYTES 45810001 ZR104 DC XL2'0000' POSSIBLE STATEMENT NUMBER 45840001 ZR105 DC XL2'0000' POSSIBLE NUMERIC PARAMETER 45870001 ZR106 DC XL2'0000' POSSIBLE DICTIONARY REFERENCE 45900001 DC XL1'00' 45930001 * HERE WE ARE BACK ON A FOUR BYTE BOUNDARY. 45960001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AL 013-TSS 45990001 ZA107 DS 18F 46020001 * ----------------------------------------------------AL 013-TSS 46050001 SPACE 46080001 * VALUES OF SYMBOLIC NAMES. 46110001 SPACE 46140001 GRDIC EQU 13 46170001 * 46200001 * PICK UP STATEMENT NUMBER AND CONVERT IT TO BINARY IF 46230001 * MACRO RUNNING 46260001 * 46290001 CONSTT TM CCCODE+3(DICR),X'10' SEE IF MACRO RUNNING 46320001 BC BZ,BINST 46350001 MVC CONVAR+4(4),ZSTAT(DICR) PICK UP PACKED DECIMAL STATEMENT 46380001 CVB GRD,CONVAR NUMBER AND CONVERT IT TO BINARY 46410001 ST GRD,CONVAR+4 46440001 MVC ZR104(2),CONVAR+6 PICK UP 2 BYTE BINARY VALUE 46470001 BCR BR,RR 46500001 BINST MVC ZR104(2),ZSTAT+2(DICR) 46530001 BCR BR,RR 46560001 EJECT 46590001 * ROUTINES CONSLT AND CONSLD 46620001 * THESE ROUTINES TAKE A TEXT OR DICTIONARY 46650001 * REFERENCE AND PROCEED TO POINT AT THE RELEVANT SLOT IN T OR D 46680001 * SLOTS. THE ADDRESS IS RETURNED IN GRA, THE REFERENCE IS TAKEN 46710001 * FROM PAR1 WHICH IS LEFT UNALTERED 46740001 SPACE 2 46770001 CONSLT XR GRA,GRA 46800001 IC GRA,PAR1+1(0,DICR) PICK UP BLOCK COUNT FROM T REF 46830001 AR GRA,GRA 46860001 AR GRA,GRA MULTIPLIED FOR WORD OFFSET 46890001 A GRA,CONSLTT THIS GIVES ABS ADD OF SLOT 46920001 BR RR RETURN 46950001 SPACE 2 46980001 CONSLD BC B,CONSLDB ***** FIRST TIME BRANCH ***** 47010001 CONSLDC LH GRA,PAR1+2(0,DICR) PICK UP D REF (OPT FOR 40) 47040001 N GRA,NEGBIT REMOVE TOP HALF 47070001 N GRA,ZMASK1-2(0,DICR) REMOVE OFFSET 47100001 CONSHF SRL GRA,0 ***** SHIFT SET BY FIRST TIME CODE ***** 47130001 A GRA,CONSLDD THIS GIVES ABS ADDR OF SLOT 47160001 BR RR RETURN 47190001 * FIRST TIME CODE SEQUENCE TO SET SHIFT 47220001 CONSLDB MVI CONSLD+1,X'00' SET BR TO NOP 47250001 L GRA,ZSHIFT(0,DICR) GET NO OF BITS IN OFFSET 47280001 S GRA,K2 REDUCE SHIFT BY 2 47310001 STC GRA,CONSHF+3 FOR WORD BLOCK OFFSET 47340001 B CONSLDC 47370001 EJECT 47400001 * ROUTINES TRYMRD AND TRYMRT. 47430001 * THESE ROUTINES INVESTIGATE THE CORE POSITION 47460001 * AND PERFORM A GETMAIN IF THERE IS CORE AVAILABLE. IF NOT THEN 47490001 * A SPILL SITUATION EXISTS AND DFREE AND TFREE ARE ENTERED. AN 47520001 * ATTEMPT TO FIND A FREE BLOCK IS MADE FIRST EXCEPT FOR ENTRIES 47550001 * FROM ZUTXTC 47580001 SPACE 2 47610001 TRYMRT STM 14,CNTL2,SAVAR+12 GET WORK REGISTERS 47640001 L CNTL2,BASOF(CNTL) LOAD FIRST BASE 47670001 L CNTL3,BASES LOAD SECOND BASE 47700001 MVI TEXTSW,X'FF' SHOW IT IS A TEXT BLOCK TYPE 47730001 LA GRA,TSLOTS+24 POINT AT TSLOTS FOR SCAN 47760001 BC B,TRYONA 47790001 SPACE 47820001 TRYMRD STM 14,CNTL2,SAVAR+12 GET WORK REGISTERS 47850001 L CNTL2,BASOF(CNTL) LOAD FIRST BASE 47880001 L CNTL3,BASES LOAD SECOND BASE 47910001 MVI TEXTSW,X'00' SHOW IT IS A DICT BLOCK TYPE 47940001 LA GRA,DSLOTS+24 POINT AT DSLOTS FOR SCAN 47970001 TRYONA MVC BLK(4),DICTSZ(DICR) PICK UP BLOCK LENGTH 48000001 CLI SPILL,X'FF' SEE IF SPILLING 48030001 BC BE,YESPIL 48060001 SPACE 48090001 TRYON CLI 0(GRA),X'81' SEE IF THIS BLOCK IS IN-CORE AND 48120001 BC BE,BLFOND FREE 48150001 LA GRA,4(0,GRA) BUMP TO NEXT SLOT 48180001 CLI 1(GRA),X'FF' TEST IF STOPPER 48210001 BC BNE,TRYON 48240001 SPACE 48270001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AL 016-TSS 48300001 * EXAMINE CONTENTS OF BLKTBL TO SEE IF IT CONTAINS ANY 48330001 * UNUSED BLOCKS 48360001 * 48390001 LA GRA,10 SET BLOCK ENTRY COUNT 48420001 LA GRB,BLKTBL POINT AT BLKTBL 48450001 NXTENT CLI 0(GRB),X'FF' TEST FOR A USEFUL ENTRY 48480001 BC BE,USDBLK BRANCH IF NO USE 48510001 L GR0,0(0,GRB) LOAD ADDR OF BLOCK INTO GR0 48540001 MVI 0(GRB),X'FF' MARK ENTRY USED 48570001 BC B,TRYRTN BRANCH TO EXIT 48600001 USDBLK LA GRB,4(0,GRB) BUMP TO NEXT ENTRY 48630001 BCT GRA,NXTENT LOOP IF ANY ENTRIES LEFT 48660001 * ----------------------------------------------------AL 016-TSS 48690001 SPACE 48720001 L GRA,CORLFT(DICR) 48750001 C GRA,BLK SEE IF ROOM FOR ANOTHER BLOCK 48780001 BC BL,TRSPIL 48810001 MVC GETLST(4),BLK PUT BLOCK LENGTH INTO GETMAIN 48840001 MVC GETLST+4(4),BLK 48870001 LA DICR,OSSAVR PICK UP SAVE AREA FOR OS/360 48900001 SPACE 48930001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AL 002-TSS 48960001 GETMAIN VC,LA=GETLST,A=ANSW 48990001 * ----------------------------------------------------AL 002-TSS 49020001 L DICR,DADDR POINT AT TRUE DICTIONARY AGAIN 49050001 SPACE 49080001 BC B,HERE(15) TEST IF CORE GOT OK 49110001 HERE BC B,OK 49140001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AL 003-TSS 49170001 BC B,TRSPIL TAKE THIS ONE IF CORE NOT AVAILB 49200001 * ----------------------------------------------------AL 003-TSS 49210020 SPACE 49230001 OK L GR0,CORLFT(0,DICR) COMPUTE NEW VALUE OF AMOUNT OF 49260001 S GR0,BLK CORE LEFT FOR TEXT AND DICTIONARY 49290001 ST GR0,CORLFT(0,DICR) BLOCKS 49320001 NOTRUE L GR0,ANSW PICK UP ADDRESS OF NEW BLOCK 49350001 SPACE 49380001 TRYRTN LM 14,15,SAVAR+12 RESTORE ALL REGISTERS 49410001 N GR0,STBITS REMOVE STATUS BYTES 49440001 LM 1,CNTL2,SAVAR+24 49470001 MVI SAVAR+12,X'FF' SHOW RETURN IS COMPLETE 49500001 BCR BR,RR 49530001 SPACE 49560001 * +++++++++++++++++++++++++++++++++++++++++++++++++++*AL 022-TSS 49590001 TRSPIL CLI SPILL,X'FF' IS A SPILL SITUATION CURRENT 49620001 BC BE,YESPIL 49650001 SPACE 49680001 L GRB,PAROF(CNTL) POINT AT 49710001 L GRB,SPDCBOF(GRB) SPILL DCB 49740001 AIF (NOT &STD).L1 49747021 LA DICR,OSSAVR SUPPLY S.A. TO OPEN. 49754021 .L1 ANOP 49761021 OPEN ((GRB),OUTIN) OPEN SPILL FILE 49770001 L DICR,DADDR POINT AT TRUE DICTIONARY AGAIN 49800001 LR GRA,GRB POINT AT SPILL DCB 49830001 USING IHADCB,GRA 49860001 TM DCBOFLGS,X'10' SEE IF SPILL FILE IS OPEN 49890001 BO YESPIL H319 49920001 LA GR0,OPERR1 PRINT CANNOT OPEN SYSUT1 49950001 ST GR0,PAR1(0,DICR) 49980001 BAL RR,ZUPL 50010001 LA GR0,16 SHOW A TERMINAL ERROR HAS 50040001 ST GR0,ERCODE(0,DICR) OCURRED 50070001 L LR,ABORTOF(CNTL) POINT AT ZABORT 50100001 BALR RR,LR 50130001 SPACE 50850001 YESPIL CLI TEXTSW,X'FF' FIND IF GETTING A TEXT OR DICT 50880001 BC BE,TGET BLOCK 50910