./ ADD SSI=07011340,NAME=IEMTP,SOURCE=0 TP TITLE 'IEMTP,ESD PHASE,FINAL ASSEMBLY,OS/360 PL1 COMPILER(F)' 00200013 * 00400013 * 00600013 * 00800013 * STATUS - CHANGE LEVEL 0 01000013 * 01200013 * 01400013 * 01600013 * FUNCTION/OPERATION 01800013 * THIS MODULE CONTAINS A TABLE OF NAMES OF ENTRY POINTS TO 02000013 * LIBRARY ROUTINES USED BY IEMTO IN GENERATING ESD ENTRIES FOR 02200013 * THE ENTRY POINTS. ONLY THE LAST 4 CHARACTERS OF EACH NAME 02400013 * APPEAR IN THE TABLE SINCE THE FIRST 3 CHARACTERS ARE ALWAYS 02600013 * 'IHE'. THE TABLE IS ARRANGED IN 2 SECTIONS, THE FIRST 02800013 * CONTAINING NAMES FOR BUILT-IN AND GENERIC BUILT-IN FUNCTIONS, 03000013 * AND THE SECOND NAMES FOR INTERNAL FUNCTIONS. 03200013 * 03400013 * 03600013 * 03800013 * ENTRY POINT - N/A 04000013 * 04200013 * 04400013 * 04600013 * EXTERNAL ROUTINES - N/A 04800013 * 05000013 * 05200013 * 05400013 * INPUT - N/A 05600013 * 05800013 * 06000013 * 06200013 * OUTPUT - N/A 06400013 * 06600013 * 06800013 * EXITS - NORMAL - N/A 07000013 * 07200013 * 07400013 * 07600013 * EXITS - ERROR - N/A 07800013 * 08000013 * 08200013 * 08400013 * NOTES - THIS MODULE IS INDEPENDENT OF THE EXTERNAL 08600013 * CHARACTER SET USED 08800013 * (EXCEPT FOR THE ROUTINES AT THE BACK.) I16 08860017 EJECT 08920017 SPACE 3 09000013 IEMTP START 0 09200013 * I16 09203017 * GENERAL REGISTER EQUATES. (AS FOR IEMTO) I16 09206017 * I16 09209017 WR1 EQU 1 I16 09212017 WR2 EQU 2 I16 09215017 WR3 EQU 3 I16 09218017 WR4 EQU 4 I16 09221017 WR5 EQU 5 I16 09224017 WR6 EQU 6 I16 09227017 WR7 EQU 7 BASE FOR IEMTP I16 09230017 WR8 EQU 8 I16 09233017 LNKR2 EQU 9 I16 09236017 BASR EQU 10 BASE FOR IEMTO I16 09239017 TVR EQU 11 I16 09242017 LNKR1 EQU 12 I16 09245017 DICR EQU 13 I16 09248017 RR EQU 14 I16 09251017 LR EQU 15 I16 09254017 SPACE 4 I16 09257017 * I16 09260017 * BRANCH MNEMONICS. I16 09263017 * I16 09266017 NOP EQU 0 I16 09269017 BO EQU 1 I16 09272017 BH EQU 2 I16 09275017 BP EQU 2 I16 09278017 BL EQU 4 I16 09281017 BM EQU 4 I16 09284017 BNE EQU 7 I16 09287017 BNZ EQU 7 I16 09290017 BE EQU 8 I16 09293017 BZ EQU 8 I16 09296017 BNL EQU 11 I16 09299017 BNM EQU 11 I16 09302017 BNH EQU 13 I16 09305017 BNP EQU 13 I16 09308017 B EQU 15 I16 09311017 SPACE 4 I16 09314017 * I16 09317017 * COMPILER CONTROL ROUTINES. I16 09320017 * I16 09323017 USING *+X'2000',TVR I16 09326017 CCTV EQU *+X'2000' I16 09329017 ZUPL EQU CCTV+8 I16 09332017 SPACE 4 I16 09335017 * I16 09338017 * COMMUNICATIONS REGION. I16 09341017 * I16 09344017 USING *+X'3000',DICR I16 09347017 DICT EQU *+X'3000' I16 09350017 PAR1 EQU DICT+128 I16 09353017 PAR2 EQU DICT+132 I16 09356017 CCCODE EQU DICT+232 I16 09359017 MACRON EQU DICT+640 MUST BE WORD ALIGNED I16 09362017 SOURCN EQU MACRON+2 HALF I16 09365017 STMNTN EQU MACRON+4 HALF I16 09368017 INSTRN EQU MACRON+6 HALF I16 09371017 BYTESN EQU MACRON+8 FULL WORD. I16 09374017 SPACE 6 I16 09377017 USING *,WR7 I16 09380017 DC C'TP' 09400016 EJECT 09600013 CODTAB DC 32D'0' IDENTIFICATION OF DICTIONARY 09800013 * ENTRIES 10000013 ORG CODTAB+X'03' ENTRY TYPE 4 10200013 DC X'04' 10400013 ORG CODTAB+X'04' BUILT-IN FUNCTION 10600013 DC X'08' 10800013 ORG CODTAB+X'06' ORIGINAL GENERIC ENTRY 11000013 DC X'18' 11200013 ORG CODTAB+X'07' LABEL VARIABLE 11400013 DC X'14' 11600013 ORG CODTAB+X'08' FILE CONSTANT 11800013 DC X'10' 12000013 ORG CODTAB+X'0C' 12040015 DC X'14' 12080015 ORG CODTAB+X'0D' 12120015 DC X'14' 12160015 ORG CODTAB+X'0F' DATA VARIABLE 12200013 DC X'14' 12400013 ORG CODTAB+X'17' LABEL ARRAY 12600013 DC X'14' 12800013 ORG CODTAB+X'1C' 12840015 DC X'14' 12880015 ORG CODTAB+X'1D' 12920015 DC X'14' 12960015 ORG CODTAB+X'1F' DATA ARRAY 13000013 DC X'14' 13200013 ORG CODTAB+X'2E' STRUCTURE 13400013 DC X'14' 13600013 ORG CODTAB+X'3E' DIMENSIONED STRUCTURE 13800013 DC X'14' 14000013 ORG CODTAB+X'4D' 14200013 DC X'1C' 14400013 ORG CODTAB+X'C2' GENERIC OR INTERNAL FUNCTION 14600013 DC X'0C' 14800013 ORG CODTAB+256 15000013 * HEADINGS FOR ESD LISTINGS 15200013 HEAD DC X'15373315292511234032382412262340' 15400013 DC X'14191333192625112938' 15600013 SUBHD DC 16X'40' 15800013 DC X'323824122623' 16000013 DC 9X'40' 16200013 DC X'33382715' 16400013 DC 5X'40' 16600013 DC X'1914' 16800013 DC 6X'40' 17000013 DC X'11141429' 17200013 DC 5X'40' 17400013 DC X'231525173318' 17600013 DC 8X'40' 17800013 CNOP 0,4 18000013 CARD DC X'02C5E2C4' ESD CARD BUFFER 18200013 DC 6X'40' 18400013 DC 2X'00' 18600013 DC 2X'40' 18800013 DC X'0001' 19000013 ENTCD DC X'4015253329384019181532112711' ENTRY CARD BUFFER ONLY 19200013 DC 22X'404040' USED ONCE AT START OF PHASE SO 19400013 DC X'0078F1' CONTROL CHARACTERS FOR PRINT 19600015 PRINT DC 15X'4040404040404040' PRINT BUFFER 19800013 EJECT 20000013 ORG IEMTP+X'280' 20200013 SPACE 3 20400013 * FIRST THE ROUTINES FOR BUILT IN AND GENERIC BUILT IN 20600013 * ROUTINES 20800013 BITAB DC X'12321600' BSF0 BOOL 21000013 DC X'13253311' CNTA COUNT 21200013 DC X'26321411' OSDA DATE 21400013 DC X'33153511' TEVA COMPLETION 21600015 DC X'13322418' CSMH HIGH 21800013 DC X'13322423' CSML LOW 22000013 DC X'32291312' SRCB ONCHAR 22200013 DC X'13161211' CFBA ONCODE 22400013 DC X'32291316' SRCF ONSOURCE 22600013 DC X'13161111' CFAA ONLOC 22800013 DC X'32291411' SRDA ONKEY 23000013 DC X'32291315' SRCE ONFILE 23200013 DC X'13161311' 23400013 DC X'26323311' OSTA TIME 23600013 DC X'11123400' ABU0 ABS 23800013 DC X'11123500' ABV0 24000013 DC X'11123600' ABN0 24200013 DC X'11123900' ABZ0 24400013 DC X'25230123' NL1L ALL,ANY 24600013 DC X'25230223' NL2L 24800013 DC X'25230111' NL1A 25000013 DC X'25230211' NL2A 25200013 DC X'25230125' NL1N 25400013 DC X'25230225' NL2N 25600013 DC X'11333201' AT5L ATAN 25800013 DC X'11332301' ATL1 26000013 DC X'11333625' ATWN 26200013 DC X'11333925' ATZN 26400013 DC X'11333202' ATS2 TAN(X,Y) 26600013 DC X'11332302' ATL2 26800013 DC X'11333203' ATS3 ATAND 27000013 DC X'11332303' ATL3 27200013 DC X'11333204' ATS4 ATAND(X,Y) 27400013 DC X'11332304' ATL4 27600013 DC X'18333200' HTS0 ATANH 27800013 DC X'18332300' HTL0 28000013 DC X'11333618' ATWH 28200013 DC X'11333918' ATZH 28400013 DC X'32253213' SNSC COS 28600013 DC X'32252313' SNLC 28800013 DC X'32253613' SNWC 29000001 DC X'32253913' SNZC 29200013 DC X'32253222' SNSK COSD 29400013 DC X'32252322' SNLK 29600013 DC X'32183213' SHSC COSH 29800013 DC X'32182313' SHLC 30000013 DC X'32253622' SNWK 30200001 DC X'32253922' SNZK 30400013 DC X'15163216' EFSF ERF 30600013 DC X'15162316' EFLF 30800013 DC X'15163213' EFSC ERFC 31000013 DC X'15162313' EFLC 31200013 DC X'15373200' EXS0 EXP 31400013 DC X'15372300' EXL0 31600013 DC X'15373600' EXW0 31800013 DC X'15373900' EXZ0 32000013 DC X'12321900' BSI0 INDEX 32200013 DC X'13321900' CSI0 32400013 DC X'23253215' LNSE LOG 32600013 DC X'23252315' LNLE 32800013 DC X'23253600' LNW0 33000013 DC X'23253900' LNZ0 33200013 DC X'23253214' LNSD LOG10 33400013 DC X'23252314' LNLD 33600013 DC X'23253202' LNS2 LOG2 33800013 DC X'23252302' LNL2 34000013 DC X'24371237' MXBX MAX 34200013 DC X'24371437' MXDX 34400013 DC X'24373237' MXSX 34600013 DC X'24372337' MXLX 34800013 DC X'24371225' MXBN MIN 35000013 DC X'24371425' MXDN 35200013 DC X'24373225' MXSN 35400013 DC X'24372325' MXLN 35600013 DC X'38171635' YGFV POLY 35800013 DC X'38173235' YGSV 36000013 DC X'38172335' YGLV 36200013 DC X'38173735' YGXV 36400013 DC X'38173635' YGWV 36600013 DC X'38173935' YGZV 36800013 DC X'38171632' YGFS 37000013 DC X'38173232' YGSS 37200013 DC X'38172332' YGLS 37400013 DC X'38173732' YGXS 37600013 DC X'38173632' YGWS 37800013 DC X'38173932' YGZS 38000013 DC X'27321600' PSF0 PROD 38200013 DC X'27323700' PSX0 38400013 DC X'27141600' PDF0 38600013 DC X'27143700' PDX0 38800013 DC X'27323200' PSS0 39000013 DC X'27323600' PSW0 39200013 DC X'27143200' PDS0 39400013 DC X'27143600' PDW0 39600013 DC X'27322300' PSL0 39800013 DC X'27323900' PSZ0 40000013 DC X'27142300' PDL0 40200013 DC X'27143900' PDZ0 40400013 DC X'12322229' BSKR REPEAT 40600013 DC X'13322229' CSKR 40800013 DC X'32253232' SNSS SIN 41000013 DC X'32252332' SNLS 41200013 DC X'32253632' SNWS 41400013 DC X'32253932' SNZS 41600013 DC X'32253239' SNSZ SIND 41800013 DC X'32252339' SNLZ 42000013 DC X'32183232' SHSS SINH 42200013 DC X'32182332' SHLS 42400013 DC X'32253639' SNWZ 42600013 DC X'32253939' SNZZ 42800013 DC X'32283200' SQS0 SQRT 43000013 DC X'32282300' SQL0 43200013 DC X'32283600' SQW0 43400013 DC X'32283900' SQZ0 43600013 DC X'32291314' SRCD ONCHAR PSEUDO-VAR 43800013 DC X'12323202' BSS2 SUBSTR 44000013 DC X'12323203' BSS3 44200013 DC X'12323203' BSS3 44400013 DC X'32291311' SRCA ONSOURCE PSEUDO-VAR 44600013 DC X'13323202' CSS2 44800013 DC X'13323203' CSS3 45000013 DC X'13323203' CSS3 45200013 DC X'32321600' SSF0 SUM 45400013 DC X'32321729' SSGR 45600013 DC X'32321829' SSHR 45800013 DC X'32241600' SMF0 46000013 DC X'32241729' SMGR 46200013 DC X'32241829' SMHR 46400013 DC X'32323700' SSX0 46600013 DC X'32321713' SSGC 46800013 DC X'32321813' SSHC 47000013 DC X'32243700' SMX0 47200013 DC X'32241713' SMGC 47400013 DC X'32241813' SMHC 47600013 DC X'33253229' TNSR TAN 47800013 DC X'33252329' TNLR 48000013 DC X'33253625' TNWN 48200013 DC X'33253925' TNZN 48400013 DC X'33253214' TNSD TAND 48600013 DC X'33252314' TNLD 48800013 DC X'33183200' THS0 TANH 49000013 DC X'33182300' THL0 49200013 DC X'33253618' TNWH 49400013 DC X'33253918' TNZH 49600013 DC X'32291313' SRCC DATAFIELD 49800013 DC X'13253312' CNTB LINENO 50000013 DC X'FFFFFFFF' STATUS 50050015 DC X'33271211' TPBA 50100015 DC X'33272911' TPRA 50150015 SPACE 1 50200013 * NOW THE ROUTINES FOR INTERNAL LIBRARY FUNCTIONS 50400013 ORG IEMTP+X'500' 50600013 ILFTAB DC X'12321100' BSA0 50800013 DC X'12321300' BSC0 51000013 DC X'12321400' BSD0 51200013 DC X'12322222' BSKK 51400013 DC X'12322416' BSMF 51600013 DC X'12322435' BSMV 51800013 DC X'12322439' BSMZ 52000013 DC X'12322500' BSN0 52200013 DC X'12322600' BSO0 52400013 DC X'13233211' CLSA 52600013 DC X'13321300' CSC0 52800013 DC X'13322222' CSKK 53000013 DC X'13322412' CSMB 53200013 DC X'13322416' CSMF 53400013 DC X'13322435' CSMV 53600013 DC X'14122511' DBNA 53800013 DC X'14132511' DCNA 54000013 DC X'14141911' DDIA 54200013 DC X'14141912' DDIB 54400013 DDOA DC X'14142611' DDOA 54600016 DC X'14142612' DDOB 54800013 DC X'14142613' DDOC 55000013 DC X'14191111' DIAA 55200013 DC X'14191112' DIAB 55400013 DC X'14191113' DIAC 55600013 DC X'14191115' DIAE 55800013 DC X'14191116' DIAF 56000013 DC X'14191211' DIBA 56200013 DC X'14191212' DIBB 56400013 DC X'14191215' DIBE 56600013 DC X'14191219' DIBI 56800013 DC X'14191311' DICA 57000013 DC X'14191312' DICB 57200013 DC X'14191411' DIDA 57400013 DC X'14191412' DIDB 57600013 DC X'14191419' DIDI 57800013 DC X'14191511' DIEA 58000013 DC X'14191611' DIFA 58200013 DC X'14191711' DIGA 58400013 DC X'14191811' DIHA 58600013 DC X'14191911' DIIA 58800013 DC X'14192111' DIJA 59000013 DC X'14192211' DIKA 59200013 DC X'14192212' DIKB 59400013 DC X'14132512' DCNB 59600013 DC X'14192411' DIMA 59800013 DC X'14251211' DNBA 60000013 DC X'14251311' DNCA 60200013 DC X'14261111' DOAA 60400013 DC X'14261112' DOAB 60600013 DC X'14261113' DOAC 60800013 DC X'14261115' DOAE 61000013 DC X'14261116' DOAF 61200013 DC X'14261211' DOBA 61400013 DC X'14261212' DOBB 61600013 DC X'14261213' DOBC 61800013 DC X'14261219' DOBI 62000013 DC X'14261311' DOCA 62200013 DC X'14261312' DOCB 62400013 DC X'14261411' DODA 62600013 DC X'14261412' DODB 62800013 DC X'14261415' DODE 63000013 DC X'14261419' DODI 63200013 DC X'14261511' DOEA 63400013 DC X'14261611' DOFA 63600013 DC X'14261811' DOHA 63800013 DC X'14261911' DOIA 64000013 DC X'14262111' DOJA 64200013 DC X'14262211' DOKA 64400013 DC X'14262212' DOKB 64600013 DC X'14262311' DOLA 64800013 DC X'14262411' DOMA 65000013 DC X'14322711' DSPA 65200013 DC X'14393600' DZW0 65400013 DC X'14393900' DZZ0 65600013 DC X'15292911' ERRA 65800013 DC X'15292912' ERRB 66000013 DC X'15292913' ERRC 66200013 DC X'15292914' ERRD 66400013 DC X'19121611' IBFA 66600013 DC X'19261112' IOAB 66800013 DC X'19261113' IOAC 67000013 DC X'19261111' IOAA 67200013 IOBA DC X'19261211' IOBA 67400016 DC X'19261212' IOBB 67600013 DC X'19261213' IOBC 67800013 DC X'19261129' IOAR 68000013 DC X'12322211' BSKA 68200013 DC X'19261311' IOCA 68400013 DC X'19261312' IOCB 68600013 DC X'19261313' IOCC 68800013 DC X'19273511' IPVA 69000013 DC X'22131111' KCAA 69200013 DC X'22131211' KCBA 69400013 DC X'22131311' KCCA 69600013 DC X'22131411' KCDA 69800013 DC X'22131511' KCEA 70000013 IOBE DC X'19261215' IOBE 70200016 DC X'26132311' OCLA 70400013 DC X'26132312' OCLB 70600013 DC X'23141911' LDIA 70800013 DC X'23141912' LDIB 71000013 DC X'19262711' IOPA 71200013 DC X'19262712' IOPB 71400013 DC X'23142611' LDOA 71600013 DC X'23142612' LDOB 71800013 DC X'19262713' IOPC 72000013 DC X'24321911' MSIA 72200013 DC X'24393414' MZUD 72400013 DC X'24393424' MZUM 72600013 DC X'24393514' MZVD 72800013 DC X'24393524' MZVM 73000013 DC X'24393600' MZW0 73200013 DC X'24393900' MZZ0 73400013 DC X'19261133' IOAT 73600013 IOBT DC X'19261233' 73800016 DC X'19261333' IOCT 74000013 DC X'26321111' OSAA 74200013 OSEA DC X'26321511' OSEA 74400015 DC X'26321717' OSGG 74600013 DC X'26321911' OSIA 74800013 DC X'26322311' OSLA 75000013 OSSA DC X'26323211' OSSA 75200015 OSWA DC X'26323611' OSWA 75400016 OSWP DC X'26323627' OSWP 75600016 OSWW DC X'26323636' OSWW 75800016 DC X'26323711' OSXA 76000013 DC X'26323811' OSYA 76200013 DC X'26323911' OSZA 76400013 IOBD DC X'19261214' IOBD 76600016 SADA DC X'32111411' SADA 76800015 SADB DC X'32111412' SADB 77000015 DC X'32111413' SADC 77200013 SADD DC X'32111414' 77400015 SAFA DC X'32111611' SAFA 77600015 SAFB DC X'32111612' SAFB 77800015 SAFC DC X'32111613' SAFC 78000015 SAFD DC X'32111614' SAFD 78200015 DC X'32111615' SAFE 78400013 SAFF DC X'32111616' SAFF 78600015 SAPA DC X'32112711' SAPA 78800015 DC X'32112712' SAPB 79000013 DC X'32111415' SADE 79200013 DC X'32151711' SEGA 79400013 DC X'32352929' SVRR 79600013 DC X'32352932' SVRS 79800013 DC X'34271111' UPAA 80000013 DC X'34271112' UPAB 80200013 DC X'34271211' UPBA 80400013 DC X'34271212' UPBB 80600013 DC X'35161111' VFAA 80800013 DC X'35161211' VFBA 81000013 DC X'35161311' VFCA 81200013 DC X'35161411' VFDA 81400013 DC X'35161511' VFEA 81600013 DC X'34221111' VKAA 81800013 DC X'34221211' VKBA 82000013 DC X'34221311' VKCA 82200013 DC X'34221411' VKDA 82400013 DC X'34221511' VKEA 82600013 DC X'34221611' VKFA 82800013 DC X'34221711' VKGA 83000013 DC X'35271111' VPAA 83200013 DC X'35271211' VPBA 83400013 DC X'35271311' VPCA 83600013 DC X'35271411' VPDA 83800013 DC X'35271511' VPEA 84000013 DC X'35271611' VPFA 84200013 DC X'35321111' VSAA 84400013 DC X'35321211' VSBA 84600013 DC X'35321311' VSCA 84800013 DC X'35321411' VSDA 85000013 DC X'35321511' VSEA 85200013 DC X'35321611' VSFA 85400013 DC X'37191200' XIB0 85600013 DC X'37191400' XID0 85800013 DC X'37192300' XIL0 86000013 DC X'37193200' XIS0 86200013 DC X'37193400' XIU0 86400013 DC X'37193500' XIV0 86600013 DC X'37193600' XIW0 86800013 DC X'37193900' XIZ0 87000013 DC X'37372300' XXL0 87200013 DC X'37373200' XXS0 87400013 DC X'37373600' XXW0 87600013 DC X'37373900' XXZ0 87800013 DC X'14241111' DMAA 88000013 DC X'32111416' SADF 88200013 DC X'19263711' IOXA 88400013 DC X'19263712' IOXB 88600013 DC X'19263713' IOXC 88800013 DC X'11141400' ADD0 89000013 DC X'11143500' ADV0 89200013 DC X'14353400' DVU0 89400013 DC X'14353500' DVV0 89600013 DC X'24273400' MPU0 89800013 DC X'24273500' MPV0 90000013 DC X'14192311' DILA 90200013 DC X'14192312' DILB 90400013 DC X'21373219' JXSI 90600013 DC X'21373238' JXSY 90800013 DC X'21371919' JXII 91000013 DC X'21371938' JXIY 91200013 DC X'21371911' JXIA 91400013 IONA DC X'19262511' I16 91600017 DC X'FFFFFFFF' I16 91800017 DC X'32112911' SARA 92000013 DC X'32332911' STRA 92200013 DC X'32332912' STRB 92400013 DC X'32332913' STRC 92600013 OSWAA DC X'26323611' OSWA 92700016 DC X'23322711' LSPA 92804015 DC X'23322712' LSPB 92808015 DC X'23322713' LSPC 92812015 DC X'23322714' LSPD 92816015 DC X'23322715' LSPE 92820015 DDOE DC X'14142615' DDOE 92822016 DC X'FFFFFFFF' 92825015 DC X'33321125' TSAN 92826215 DC X'33321133' TSAT 92826415 DC X'19261114' IOAD 92826615 DC X'32331711' STGA 92826815 DC X'32331712' STGB 92827015 DC X'33151111' TEAA 92827215 DC X'12323311' BSTA 92827301 DC X'12323511' BSVA 92827401 DC X'13323311' CSTA 92827501 DC X'13323511' CSVA 92827601 DC X'32332711' STPA 92827801 ORG IEMTP+X'900' 92828015 * 92832015 * SKELETONS FOR PROGRAM/STATIC LENGTH AND NAME MESSAGES 92836015 * 92840015 SPACE 92844015 MESS1 DC X'0078F0' 92848015 DC 10X'40' 92852015 DC X'33181540' THE 92856015 PROG1 EQU * 92858015 DC X'2729261729112440' PROGRAM 92860015 DC X'133215133340' CSECT 92864015 DC X'193240' IS 92868015 DC X'251124151440' NAMED 92872015 MESS1C DC 83X'40' 92882015 ANDIS DC X'4011251440' AND 92892015 DC X'193240' IS 92902015 BYSLNG DC X'40123833153240' BYTES 92912015 DC X'232625174640' LONG. 92922015 STATIC DC X'32331133191340' STATIC 92932015 ORG IEMTP+X'B00' 93032015 * ROUTINE NAMES 93132015 TSAP DC X'33321127' 93232015 TSAO DC X'33321126' 93332015 TSAD DC X'33321114' 93432015 TSAV DC X'33321135' 93532015 TSAE DC X'33321115' 93632015 TSAR DC X'33321129' 93732015 TSAG DC X'33321117' 93832015 TSAF DC X'33321116' 93932015 TCVA DC X'33133511' 94032015 TCVB DC X'33133512' 94132015 TSAN DC X'33321125' 94232015 TSSA DC X'33323211' 94332015 TSEA DC X'33321511' 94432015 DDTA DC X'14143311' 94437016 DDTB DC X'14143312' 94442016 DDTC DC X'14143313' 94447016 IBTA DC X'19123311' 94452016 IBTB DC X'19123312' 94457016 IBTC DC X'19123313' 94462016 IBTE DC X'19123315' 94467016 OCTA DC X'26133311' 94472016 OCTB DC X'26133312' 94477016 IBTT DC X'19123333' 94482016 IBTD DC X'19123314' 94487016 INTA DC X'19253311' I16 94492017 DC X'FFFFFFFF' I16 94497017 DDTE DC X'14143315' 94502016 TSWA DC X'33323611' 94507016 TSWP DC X'33323627' 94512016 TSWW DC X'33323636' 94517016 LIBSAV DC 18F'0' 94532015 TEM1 DC F'0' 94632015 TEM2 DC F'0' 94732015 LNKST DC F'0' 94832015 STARTA DC F'0' 94932015 STARTB DC F'0' 95032015 FRSTAD DC F'0' 95132015 SCNDAD DC F'0' 95232015 LASTAD DC F'0' 95332015 ENTABB DC F'0' 95432015 ENTABF DC F'0' 95532015 SAVER3 DC F'0' 95632015 ZERO DC 2F'0' 95732015 ONE DC F'1' 95832015 K2 DC F'2' 95932015 K4 DC F'4' 96032015 K6 DC F'6' 96132015 K7 DC F'7' 96232015 K8 DC F'8' 96332015 K12 DC F'12' 96432015 K16 DC F'16' 96532015 K48 DC H'48' 96632015 DC H'0' 96732015 WSLR00 DC F'0' 96832015 CNZERO DC F'0' 96932015 MESSC DC 8X'0' 97032015 RDMASK DC X'FFFFFFF8' 97132015 WORK DC F'0' 97232015 PATT DC X'40' 97332015 DC 9X'20' 97432015 DECAR DC D'0' 97435001 TOWORK DC F'0' 97438001 MASKX DC X'00FFFFFF' 97441001 MESSD DC 8X'0' 97444001 FLGTSK DC X'0' 97447001 EJECT 97452017 * I16 97472017 * TRANSFER VECTORS FOR ROUTINES IN THIS PHASE. I16 97492017 * I16 97512017 ORG IEMTP+X'C80' I16 97532017 STSOFF BC B,STSTCS STATISTICS ROUTINE. I16 97552017 EJECT 97572017 * I16 97592017 ******************** *STATISTICS* ROUTINE. ******************** I16 97612017 * I16 97632017 * FUNCTION - PROVIDES SYSTEM STATISTICS RECORD, ON I16 97652017 * SYSPRINT, FOR THE COMPILATION. I16 97672017 * I16 97692017 * EXTERNAL ROUTINES - ZUPL I16 97712017 * I16 97732017 * ENTRY - STSTCS, VIA TV, FROM IEMTO (BY BAL ON RR) I16 97752017 * I16 97772017 STSTCS DS 0H I16 97792017 TM CCCODE+2,X'80' IS SOURCE OPTION ON ? I16 97798001 BCR BO,RR RETURN IF NOT. I16 97804001 STM 14,5,STSAVE SAVE REGS. I16 97812017 LA WR2,STAB1 POINT WR2 AT PRINT BUFFER. I16 97832017 TM CCCODE+1,X'01' MACRO OPTION ON ? I16 97852017 BC BO,NOMAC NO. SKIP MCNT PROCESSING. I16 97872017 LH WR3,MACRON PUT MACRO COUNT IN WR3 I16 97892017 LA WR4,MCNT PUT SLOT ADDRESS IN WR4 I16 97912017 BAL WR5,CONVRT THEN BAL TO CONVERT AND EDIT. I16 97932017 BC B,SOURCE I16 97952017 SPACE 1 I16 97972017 NOMAC DS 0H I16 97992017 LA WR2,MACLEN(0,WR2) BUMP THE BUFFER POINTER, I16 98012017 MVC 0(STTLEN,WR2),STAB1 SHIFT KEYWORD ETC., I16 98032017 MVI 1(WR2),STAB2 AND ADJUST THE LENGTH. I16 98052017 SPACE 1 I16 98072017 SOURCE DS 0H I16 98092017 LH WR3,SOURCN SOURCE RECORD COUNT. I16 98112017 LA WR4,SCNT I16 98132017 BAL WR5,CONVRT I16 98152017 LH WR3,STMNTN TEXT STATEMENT COUNT. I16 98172017 LA WR4,TCNT I16 98192017 BAL WR5,CONVRT I16 98212017 L WR3,BYTESN OBJECT BYTES COUNT. I16 98232017 LA WR4,BCNT I16 98252017 BAL WR5,CONVRT I16 98272017 SPACE 2 I16 98292017 * NOW TO PRINT THE RECORD. WR2 POINTS AT THE BUFFER. I16 98312017 SPACE 1 I16 98332017 ST WR2,PAR1 I16 98352017 L LR,ZUPL POINT AT ZUPL, AND I16 98372017 BALR RR,LR GO THERE. I16 98392017 LM 14,5,STSAVE RESTORE REGS. I16 98412017 BCR B,RR RETURN. I16 98432017 EJECT 98452017 * I16 98472017 * CONVRT - UTILITY TO PERFORM CONVERSION AND EDIT. I16 98492017 * I16 98512017 * WR3 - CONTAINS BINARY INPUT I16 98532017 * WR4 - POINTS AT BUFFER SLOT I16 98552017 * WR5 - RETURN LINK. I16 98572017 * I16 98592017 CONVRT DS 0H I16 98612017 CVD WR3,DOUBLE CONVERT TO DECIMAL I16 98632017 MVC 0(8,WR4),EDMSK MOVE IN THE EDIT MASK I16 98652017 ED 0(8,WR4),DOUBLE+4 SUPPRESS LEADING ZEROS I16 98672017 BCR B,WR5 RETURN. I16 98692017 EJECT 98712017 * I16 98732017 * THE FOLLOWING CONSTANTS, DOWN TO 'BCNT', CONSTITUTE I16 98752017 * ONE OUTPUT RECORD FOR ZUPL. THEY MUST NOT BE DISTURBED. I16 98772017 * I16 98792017 STAB1 DC X'0077' 119 CHARS (JUST ONE LINE) I16 98812017 DC C'-' I16 98832017 DC C'*STATISTICS* MACRO RECORDS = ' I16 98852017 MCNT DC 8C' ' I16 98872017 DC C',SOURCE RECORDS = ' I16 98892017 SCNT DC 8C' ' I16 98912017 DC C',PROG TEXT STMNTS = ' I16 98932017 TCNT DC 8C' ' I16 98952017 DC C',OBJECT BYTES = ' I16 98972017 BCNT DC 8C' ' I16 98992017 STAB2 EQU X'5E' 94 CHARS, NO MACRO PASS. I16 99012017 STTLEN EQU 20 LENGTH OF STAB1 KEYWORD+ I16 99032017 MACLEN EQU 25 LENGTH OF MACRO PORTION I16 99052017 DOUBLE DC D'0' I16 99072017 STSAVE DC 8F'0' I16 99092017 EDMSK DC X'4020202020202120' EDIT MASK I16 99112017 END 99132017 ./ ADD SSI=03011762,NAME=IEMTQ,SOURCE=0 TQ TITLE 'IEMTQ, ESD PHASE - INCLUDE STRING GENERATION, FINAL ASSC00070013 EMBLY, OS/360 PL/1 COMPILER(F)' 00140013 * FUNCTIONS - FROM THE INCLUDE CARD MATRIX, WHICH IS AN 00210013 * ARRAY OF BITS INDICATING THE RANGE OF INTERNAL AND I/O 00280013 * CONVERSIONS WHICH MAY BE REQUIRED AT OBJECT TIME, A 00350013 * CHARACTER STRING IS CONSTRUCTED COMPRISING THE NAMES OF ALL 00420013 * LIBRARY MODULES WHICH MAY BE CALLED TO EFFECT THE CONVERSIONS. 00490013 * EACH NAME IS SEVEN CHARACTERS LONG AND THE NAMES ARE SEPARATED 00560013 * BY COMMAS. 00630013 * 00700013 * ENTRY POINT - IEMTC CALLED FROM IEMTA. 00770013 * 00840013 * INPUT - RA ADDRESSES AN ARGUMENT LIST COMPRISING TWO 00910013 * ADDRESSES- 00980013 * (1) THE ADDRESS OF A BIT STRING DOPE VECTOR (THE 01050013 * INCLUDE MATRIX). 01120013 * (2) THE ADDRESS OF THE DOPE VECTOR OF THE CHARACTER 01190013 * STRING TO BE RETURNED CONTAINING THE MODULES TO BE INCLUDED. 01260013 * 01330013 * OUTPUT - THE CHARACTER STRING PROVIDED BY THE CALLER 01400013 * CONTAINS THE SEVEN CHARACTER LIBRARY MODULE NAMES SEPARATED 01470013 * BY COMMAS,AND THE CHARACTER STRING DOPE VECTOR CONTAINS THE 01540013 * CURRENT LENGTH OF THE STRING. 01610013 * 01680013 * EXTERNAL ROUTINES - NONE 01750013 * 01820013 * EXITS - NORMAL - RETURN TO CALLER 01890013 * 01960013 * EXITS - ERROR - NONE 02030013 * 02100013 * TABLES/WORKAREAS - THREE TABLES ARE USED FOR THE 02170013 * INTERPRETATION OF THE INCLUDE MATRIX- 02240013 * (1) TAB1. THIS CONTAINS A HALFWORD FOR EACH BIT 02310013 * POSITION IN THE MATRIX. THE HALFWORD CONTAINS AN OFFSET IN 02380013 * THE SECOND TABLE TAB2. 02450013 * (2) TAB2. THIS IS A TABLE OF HALFWORD ENTRIES 02520013 * REFERENCED VIA TAB1. EACH ENTRY COMPRISES AN OFFSET IN TAB2 02590013 * OR TAB3,AND TWO HIGH ORDER FLAG BITS WHICH HAVE THE 02660013 * FOLLOWING INTERPRETATIONS- 02730013 * 00 THE OFFSET IS OF AN ENTRY IN TAB3 WHICH IS TO BE 02800013 * INCLUDED, AND THE FOLLOWING ENTRY IN TAB2 SHOULD BE EXAMINED 02870013 * 01 NO ACTION. PROCEED TO TEST NEXT BIT IN MATRIX 02940013 * 10 THE OFFSET IS OF ANOTHER ENTRY IN TAB2. GO TO 03010013 * EXAMINE THAT ENTRY AND PROCEED FROM THERE 03080013 * 11 THE OFFSET IS IN TAB3. INCLUDE THAT ROUTINE THEN 03150013 * GO TO TEST THE NEXT BIT IN THE MATRIX. 03220013 * (3) TAB3. THIS IS A TABLE OF THREE BYTE ENTRIES, 03290013 * EACH BEING THE FOURTH, FIFTH AND SIXTH CHARACTERS OF A 03360013 * LIBRARY MODULE NAME. WHEN A MODULE HAS BEEN INCLUDED THE 03430013 * FIRST CHARACTER OF THE CORRESPONDING ENTRY IN THIS TABLE IS 03500013 * SET TO 'FF'. 03570013 EJECT 03640013 IEMTQ CSECT 03710013 PRINT NODATA 03780013 SPACE 1 03850013 USING *,BR 03920013 B START 03930001 DC A(DDO) ADDRESS OF DDO FOR IEMTO. 03940001 START EQU * 03950001 STM LR,PWR,12(DR) SAVE CALLERS REGISTERS 03990013 LM RB,RD,0(RA) GET DOPE VECTOR POINTERS 04060013 L RA,0(RC) GET STRING ADDRESS 04130013 L RB,0(RB) GET ARRAY ADDRESS 04200013 SR RE,RE ZERO BIT TEST REGISTER 04270013 LR RF,RE ZERO WORD AND BIT COUNT 04340013 LR RG,RF ACCUMULATORS 04410013 LR RH,RG TARGET STRING LENGTH 04480013 LR RI,RH TABLE 1 OFFSET 04550013 LR RJ,RI TABLE 3 OFFSET 04620013 LR WR,RJ RESET STOP SWITCH 04690013 LR PR,WR TABLE 1 OFFSET 04760013 LA LR,TAB1 RESET TAB1 POINTER 04830013 LR R0,RE RESET TAB SWITCH 04900013 ST RD,RDSAV SAVE RD POINTER. 04970013 LDNXT CH RF,K010 TEST WORD COUNT 05040013 BE ENDJB BRANCH IF 10 05110013 L RD,0(RB) GET NEXT WORD OF SOURCE 05180013 LA RF,1(RF) COUNT WORD 05250013 GETNB SRDL RD,1 GET NEXT BIT 05320013 LA RG,1(RG) COUNT BIT 05390013 AGAIN LTR RE,RE TEST BIT 05460013 BM NONZO BRANCH IF ONE 05530013 LSTBT LTR R0,R0 TEST TAB SWITCH 05600013 BCTR R0,R0 SET TAB SWITCH 05670013 LA LR,TAB1A SWITCH TAB POINTER 05740013 BZ AGAIN INCLUDE FOR SECOND TAB 05810013 SR R0,R0 RESET TAB SWITCH 05880013 LA LR,TAB1 RESET TAB POINTER 05950013 LA PR,2(PR) BUMP TAB1 OFFSET 06020013 CH RG,K032 TEST BIT COUNT 06090013 BNE GETNB BRANCH IF LESS THAN 32 06160013 BUMPS LA RB,4(RB) BUMP SOURCE WORD ADDRESS 06230013 SR RG,RG ZERO BIT COUNT 06300013 B LDNXT GO GET NEXT WORD 06370013 ENDJB EQU * 06440013 L RD,RDSAV RELOAD RD POINTER 06510013 CLI OPTCD(RD),X'02' 06580013 BL ENDJB1 BRANCH IF OPT=0 06650001 CLI DIA,X'FF' HAS DIA BEEN USED 06720013 BE ENDJB2 06790013 CLI DCN,X'FF' 06860013 BNE ENDJB3 06930013 ENDJB2 EQU * 07000013 MVC 0(8,RA),KOPT2 MOVE IN IHEVQBA STRING 07070013 LA RA,8(RA) UPDATE STRING POINTER 07140013 LA RH,8(RH) UPDATE STRING LENGTH 07210013 ENDJB3 EQU * 07280013 CLI DOA,X'FF' 07350013 BE ENDJB4 07420013 CLI DNC,X'FF' 07490013 BNE ENDJB1 07560013 ENDJB4 EQU * 07630013 MVC 0(8,RA),KOPT2+8 MOVE IN IHEVQCA STRING 07700013 LA RA,8(RA) 07770013 LA RH,8(RH) 07840013 ENDJB1 BCTR RH,0 DECREMENT CURRENT LENGTH 07910013 STH RH,6(RC) SET CURRENT LEN SLOT IN SDV. 07980013 LM LR,PWR,12(DR) RESTORE CALLERS REGISTERS 08050013 BR LR RETURN 08120013 NONZO LH RI,0(LR,PR) GET OFFSET FROM TAB1(A) 08190013 LOADA LA RI,TAB2(RI) FORM TABLE 2 ADDRESS 08260013 TEST1 TM 0(RI),X'C0' TEST HIGH ORDER BITS OF TABLE 2 08330013 BO SET11 BRANCH ALL ONES 08400013 BM SET10 BRANCH MIXED 08470013 LOADH LH RJ,0(RI) LOAD OFFSET FROM TABLE 2 08540013 N RJ,MASK REMOVE CHAIN OR STOP BITS 08610013 LA RJ,TAB3(RJ) GET ADDRESS IN TABLE 3 08680013 CLI 0(RJ),X'FF' TEST FUNCTION BYTE 08750013 BNE SETFF BRANCH IF NOT USED 08820013 STSWT LTR WR,WR TEST STOP SWITCH 08890013 BZ BMPT2 BRANCH NOT SET 08960013 SR WR,WR RESET STOP SWITCH 09030013 B LSTBT BRANCH TO LAST BIT TEST 09100013 SET11 LA WR,1 SET STOP SWITCH 09170013 B LOADH GO LOAD TABLE 2 OFFSET 09240013 SET10 TM 0(RI),X'40' TEST FOR NO INCLUDES 09310013 BO LSTBT BRANCH IF NONE 09380013 LH RI,0(RI) LOAD CHAIN OFFSET 09450013 N RI,MASK REMOVE CHAIN BIT 09520013 B LOADA LOOP 09590013 BMPT2 LA RI,2(RI) BUMP TABLE 2 OFFSET 09660013 B TEST1 GO TEST NEXT FUNCTION 09730013 SETFF MVC 0(3,RA),KIHE MOVE CHARACTERS IHE INTO STRING 09800013 MVC 3(3,RA),0(RJ) MOVE MODULE NAME CHARACTERS 09870013 MVI 6(RA),C'A' APPEND ENTY POINT ONE CHARACTER 09940013 MVI 7(RA),C',' INSERT SEPARATOR. 10010013 LA RA,8(RA) BUMP STRING ADDRESS 10080013 LA RH,8(RH) BUMP STRING LENGTH 10150013 MVI 0(RJ),X'FF' SET MODULE NAME DONE 10220013 B STSWT LOOP 10290013 SPACE 2 10360013 * CONSTANTS 10430013 SPACE 1 10500013 KIHE DC C'IHE' 10570013 DS 0F 10640013 K010 DC H'10' 10710013 K032 DC H'32' 10780013 MASK DC X'00003FFF' 10850013 KOPT2 DC C'IHEVQBA,IHEVQCA,' 10920013 RDSAV DC F'0' 10990013 SPACE 2 11060013 OPTCD EQU 196 OFFSET OF OPT BYTE 11130013 EJECT 11200013 * TAB1 11270013 * THIS TABLE CONTAINS A HALFWORD ENTRY FOR EACH BIT IN THE 11340013 * INCLUDE MATRIX. 11410013 SPACE 1 11480013 TAB1 EQU * 11550013 FXDCPF DC AL2(N299-N001) 11620013 FXDNPB DC AL2(N135-N001) FUTURE N296 11690013 FXDNPS DC AL2(N294-N001) 11760013 FXDNPD DC AL2(N292-N001) 11830013 FXDBBB DC AL2(N493-N001) 11900013 FXDAAA DC AL2(N288-N001) 11970013 FXDEEE DC AL2(N286-N001) 12040013 FXDFFF DC AL2(N283-N001) 12110013 CPFFXD DC AL2(N155-N001) 12180013 NPBFXD DC AL2(N135-N001) FUTURE N161 12250013 NPSFXD DC AL2(N159-N001) 12320013 NPDFXD DC AL2(N157-N001) 12390013 BBBFXD DC AL2(N494-N001) 12460013 AAAFXD DC AL2(N156-N001) 12530013 EEEFXD DC AL2(N153-N001) 12600013 FFFFXD DC AL2(N153-N001) 12670013 FXDCCC DC AL2(N135-N001) 12740013 CCCFXD DC AL2(N135-N001) 12810013 FXDDDO DC AL2(N288-N001) 12880013 FXDLDO DC AL2(N288-N001) 12950013 DDIFXD DC AL2(N156-N001) 13020013 LDIFXD DC AL2(N156-N001) 13090013 FXDCSP DC AL2(N021-N001) 13160013 FXDCS DC AL2(N019-N001) 13230013 FXDBS DC AL2(N014-N001) 13300013 FXDNFB DC AL2(N135-N001) FUTURE N012 13370013 FXDNFS DC AL2(N010-N001) 13440013 FXDNFD DC AL2(N008-N001) 13510013 FXDFLT DC AL2(N006-N001) 13580013 FXDFXB DC AL2(N003-N001) 13650013 FXDFXD DC AL2(N001-N001) 13720013 DC AL2(N135-N001) 13790013 FXBCP DC AL2(N324-N001) 13860013 FXBNPB DC AL2(N135-N001) FUTURE N321 13930013 FXBNPS DC AL2(N319-N001) 14000013 FXBNPD DC AL2(N317-N001) 14070013 FXBBBB DC AL2(N495-N001) 14140013 FXBAAA DC AL2(N313-N001) 14210013 FXBEEE DC AL2(N311-N001) 14280013 FXBFFF DC AL2(N307-N001) 14350013 CPFFXB DC AL2(N173-N001) 14420013 NPBFXB DC AL2(N135-N001) FUTURE N179 14490013 NPSFXB DC AL2(N177-N001) 14560013 NPDFXB DC AL2(N175-N001) 14630013 BBBFXB DC AL2(N496-N001) 14700013 AAAFXB DC AL2(N174-N001) 14770013 EEEFXB DC AL2(N169-N001) 14840013 FFFFXB DC AL2(N169-N001) 14910013 FXBCCC DC AL2(N135-N001) 14980013 CCCFXB DC AL2(N135-N001) 15050013 FXBDDO DC AL2(N313-N001) 15120013 FXBLDO DC AL2(N313-N001) 15190013 DDIFXB DC AL2(N174-N001) 15260013 LDIFXB DC AL2(N174-N001) 15330013 FXBCSP DC AL2(N043-N001) 15400013 FXBCS DC AL2(N038-N001) 15470013 FXBBS DC AL2(N036-N001) 15540013 FXBNFB DC AL2(N135-N001) FUTURE N034 15610013 FXBNFS DC AL2(N032-N001) 15680013 FXBNFD DC AL2(N030-N001) 15750013 FXBFLT DC AL2(N028-N001) 15820013 FXBFXB DC AL2(N026-N001) 15890013 FXBFXD DC AL2(N023-N001) 15960013 DC AL2(N135-N001) 16030013 FLTCP DC AL2(N349-N001) 16100013 FLTNPB DC AL2(N135-N001) FUTURE N346 16170013 FLTNPS DC AL2(N344-N001) 16240013 FLTNPD DC AL2(N342-N001) 16310013 FLTBBB DC AL2(N498-N001) 16380013 FLTAAA DC AL2(N338-N001) 16450013 FLTEEE DC AL2(N336-N001) 16520013 FLTFFF DC AL2(N332-N001) 16590013 CPFFLT DC AL2(N189-N001) 16660013 NPBFLT DC AL2(N135-N001) FUTURE N195 16730013 NPSFLT DC AL2(N193-N001) 16800013 NPDFLT DC AL2(N191-N001) 16870013 BBBFLT DC AL2(N499-N001) 16940013 AAAFLT DC AL2(N190-N001) 17010013 EEEFLT DC AL2(N187-N001) 17080013 FFFFLT DC AL2(N187-N001) 17150013 FLTCCC DC AL2(N135-N001) 17220013 CCCFLT DC AL2(N135-N001) 17290013 FLTDDO DC AL2(N338-N001) 17360013 FLTLDO DC AL2(N338-N001) 17430013 DDIFLT DC AL2(N190-N001) 17500013 LDIFLT DC AL2(N190-N001) 17570013 FLTCSP DC AL2(N066-N001) 17640013 FLTCS DC AL2(N063-N001) 17710013 FLTBS DC AL2(N061-N001) 17780013 FLTNFB DC AL2(N135-N001) FUTURE N059 17850013 FLTNFS DC AL2(N057-N001) 17920013 FLTNFD DC AL2(N055-N001) 17990013 FLTFLT DC AL2(N053-N001) 18060013 FLTFXB DC AL2(N051-N001) 18130013 FLTFXD DC AL2(N048-N001) 18200013 DC AL2(N135-N001) 18270013 NFDCP DC AL2(N521-N001) 18340013 NFDNPB DC AL2(N135-N001) FUTURE N370 18410013 NFDNPS DC AL2(N368-N001) 18480013 NFDNPD DC AL2(N366-N001) 18550013 NFDBBB DC AL2(N500-N001) 18620013 NFDAAA DC AL2(N520-N001) 18690013 NFDEEE DC AL2(N360-N001) 18760013 NFDFFF DC AL2(N357-N001) 18830013 CPFNFD DC AL2(N205-N001) 18900013 NPBNFD DC AL2(N135-N001) FUTURE N211 18970013 NPSNFD DC AL2(N209-N001) 19040013 NPDNFD DC AL2(N207-N001) 19110013 BBBNFD DC AL2(N501-N001) 19180013 AAANFD DC AL2(N206-N001) 19250013 EEENFD DC AL2(N203-N001) 19320013 FFFNFD DC AL2(N203-N001) 19390013 NFDCCC DC AL2(N135-N001) 19460013 CCCNFD DC AL2(N135-N001) 19530013 NFDDDO DC AL2(N362-N001) 19600013 NFDLDO DC AL2(N362-N001) 19670013 DDINFD DC AL2(N206-N001) 19740013 LDINFD DC AL2(N206-N001) 19810013 NFDCSP DC AL2(N047-N001) 19880013 NFDCS DC AL2(N042-N001) 19950013 NFDBS DC AL2(N082-N001) 20020013 NFDNFB DC AL2(N135-N001) FUTURE N080 20090013 NFDNFS DC AL2(N078-N001) 20160013 NFDNFD DC AL2(N076-N001) 20230013 NFDFLT DC AL2(N074-N001) 20300013 NFDFXB DC AL2(N071-N001) 20370013 NFDFXD DC AL2(N069-N001) 20440013 DC AL2(N135-N001) 20510013 NFSCP DC AL2(N521-N001) 20580013 NFSNPB DC AL2(N135-N001) FUTURE N394 20650013 NFSNPS DC AL2(N392-N001) 20720013 NFSNPD DC AL2(N390-N001) 20790013 NFSBBB DC AL2(N503-N001) 20860013 NFSAAA DC AL2(N520-N001) 20930013 NFSEEE DC AL2(N384-N001) 21000013 NFSFFF DC AL2(N381-N001) 21070013 CPFNFS DC AL2(N221-N001) 21140013 NPBNFS DC AL2(N135-N001) FUTURE N227 21210013 NPSNFS DC AL2(N225-N001) 21280013 NPDNFS DC AL2(N223-N001) 21350013 BBBNFS DC AL2(N504-N001) 21420013 AAANFS DC AL2(N222-N001) 21490013 EEENFS DC AL2(N219-N001) 21560013 FFFNFS DC AL2(N219-N001) 21630013 NFSCCC DC AL2(N135-N001) 21700013 CCCNFS DC AL2(N135-N001) 21770013 NFSDDO DC AL2(N386-N001) 21840013 NFSLDO DC AL2(N386-N001) 21910013 DDINFS DC AL2(N222-N001) 21980013 LDINFS DC AL2(N222-N001) 22050013 NFSCSP DC AL2(N047-N001) 22120013 NFSCS DC AL2(N042-N001) 22190013 NFSBS DC AL2(N099-N001) 22260013 NFSNFB DC AL2(N135-N001) FUTURE N097 22330013 NFSNFS DC AL2(N095-N001) 22400013 NFSNFD DC AL2(N093-N001) 22470013 NFSFLT DC AL2(N091-N001) 22540013 NFSFXB DC AL2(N088-N001) 22610013 NFSFXD DC AL2(N086-N001) 22680013 DC AL2(N135-N001) 22750013 NFBCP DC AL2(N135-N001) FUTURE N119 22820013 NFBNPB DC AL2(N135-N001) N419 22890013 NFBNPS DC AL2(N135-N001) N417 22960013 NFBNPD DC AL2(N135-N001) N415 23030013 NFBBBB DC AL2(N135-N001) N505 23100013 NFBAAA DC AL2(N135-N001) N118 23170013 NFBEEE DC AL2(N135-N001) N409 23240013 NFBFFF DC AL2(N135-N001) N405 23310013 CPFNFB DC AL2(N135-N001) N237 23380013 NPBNFB DC AL2(N135-N001) N243 23450013 NPSNFB DC AL2(N135-N001) N241 23520013 NPDNFB DC AL2(N135-N001) N239 23590013 BBBNFB DC AL2(N135-N001) N506 23660013 AAANFB DC AL2(N135-N001) N238 23730013 EEENFB DC AL2(N135-N001) N235 23800013 FFFNFB DC AL2(N135-N001) N235 23870013 NFBCCC DC AL2(N135-N001) N135 23940013 CCCNFB DC AL2(N135-N001) N135 24010013 NFBDDO DC AL2(N135-N001) N411 24080013 NFBLDO DC AL2(N135-N001) N411 24150013 DDINFB DC AL2(N135-N001) N238 24220013 LDINFB DC AL2(N135-N001) N238 24290013 NFBCSP DC AL2(N135-N001) N119 24360013 NFBCS DC AL2(N135-N001) N118 24430013 NFBBS DC AL2(N135-N001) N116 24500013 NFBNFB DC AL2(N135-N001) N114 24570013 NFBNFS DC AL2(N135-N001) N112 24640013 NFBNFD DC AL2(N135-N001) N110 24710013 NFBFLT DC AL2(N135-N001) N108 24780013 NFBFXB DC AL2(N135-N001) N106 24850013 NFBFXD DC AL2(N135-N001) N103 24920013 DC AL2(N135-N001) N135 24990013 BSCP DC AL2(N444-N001) 25060013 BSNPB DC AL2(N135-N001) FUTURE N441 25130013 BSNPS DC AL2(N439-N001) 25200013 BSNPD DC AL2(N437-N001) 25270013 BSB DC AL2(N435-N001) 25340013 BSA DC AL2(N435-N001) 25410013 BSE DC AL2(N433-N001) 25480013 BSF DC AL2(N431-N001) 25550013 CPFBS DC AL2(N25A-N001) 25620013 NPBBS DC AL2(N135-N001) FUTURE N260 25690013 NPSBS DC AL2(N258-N001) 25760013 NPDBS DC AL2(N256-N001) 25830013 BBBBS DC AL2(N254-N001) 25900013 AAABS DC AL2(N254-N001) 25970013 EEEBS DC AL2(N507-N001) 26040013 FFFBS DC AL2(N507-N001) 26110013 BSCCC DC AL2(N528-N001) 26180013 CCCBS DC AL2(N526-N001) 26250013 BSDDO DC AL2(N435-N001) 26320013 BSLDO DC AL2(N435-N001) 26390013 DDIBS DC AL2(N508-N001) 26460013 LDIBS DC AL2(N508-N001) 26530013 BSCSP DC AL2(N135-N001) 26600013 BSCS DC AL2(N135-N001) 26670013 BSBS DC AL2(N135-N001) 26740013 BSNFB DC AL2(N135-N001) FUTURE N133 26810013 BSNFS DC AL2(N131-N001) 26880013 BSNFD DC AL2(N129-N001) 26950013 BSFLT DC AL2(N127-N001) 27020013 BSFXB DC AL2(N125-N001) 27090013 BSFXD DC AL2(N121-N001) 27160013 DC AL2(N135-N001) 27230013 CSCP DC AL2(N464-N001) 27300013 CSNPB DC AL2(N135-N001) FUTURE N461 27370013 CSNPS DC AL2(N459-N001) 27440013 CSNPD DC AL2(N457-N001) 27510013 CSB DC AL2(N042-N001) 27580013 CSA DC AL2(N042-N001) 27650013 CSE DC AL2(N454-N001) 27720013 CSF DC AL2(N451-N001) 27790013 CPFCS DC AL2(N265-N001) 27860013 NPBCS DC AL2(N135-N001) FUTURE N267 27930013 NPSCS DC AL2(N268-N001) 28000013 NPDCS DC AL2(N269-N001) 28070013 BBBCS DC AL2(N042-N001) 28140013 AAACS DC AL2(N266-N001) 28210013 EEECS DC AL2(N509-N001) 28280013 FFFCS DC AL2(N511-N001) 28350013 CSCCC DC AL2(N529-N001) 28420013 CCCCS DC AL2(N523-N001) 28490013 CSDDO DC AL2(N042-N001) 28560013 CSLDO DC AL2(N042-N001) 28630013 DDICS DC AL2(N513-N001) 28700013 LDICS DC AL2(N513-N001) 28770013 CSCSP DC AL2(N135-N001) 28840013 CSCS DC AL2(N135-N001) 28910013 CSBS DC AL2(N135-N001) 28980013 CSNFB DC AL2(N135-N001) FUTURE N151 29050013 CSNFS DC AL2(N149-N001) 29120013 CSNFD DC AL2(N147-N001) 29190013 CSFLT DC AL2(N145-N001) 29260013 CSFXB DC AL2(N142-N001) 29330013 CSFXD DC AL2(N136-N001) 29400013 DC AL2(N135-N001) 29470013 CSPCP DC AL2(N464-N001) 29540013 CSPNPB DC AL2(N135-N001) FUTURE N461 29610013 CSPNPS DC AL2(N459-N001) 29680013 CSPNPD DC AL2(N457-N001) 29750013 CSPB DC AL2(N042-N001) 29820013 CSPA DC AL2(N042-N001) 29890013 CSPE DC AL2(N454-N001) 29960013 CSPF DC AL2(N451-N001) 30030013 CPFCSP DC AL2(N273-N001) 30100013 NPBCSP DC AL2(N135-N001) FUTURE N275 30170013 NPSCSP DC AL2(N276-N001) 30240013 NPDCSP DC AL2(N277-N001) 30310013 BBBCSP DC AL2(N464-N001) 30380013 AAACSP DC AL2(N274-N001) 30450013 EEECSP DC AL2(N514-N001) 30520013 FFFCSP DC AL2(N515-N001) 30590013 CSPCCC DC AL2(N529-N001) 30660013 CCCCSP DC AL2(N524-N001) 30730013 CSPDDO DC AL2(N042-N001) 30800013 CSPLDO DC AL2(N042-N001) 30870013 DDICSP DC AL2(N516-N001) 30940013 LDICSP DC AL2(N516-N001) 31010013 CSPCSP DC AL2(N135-N001) 31080013 CSPCS DC AL2(N135-N001) 31150013 CSPBS DC AL2(N135-N001) 31220013 CSPNFB DC AL2(N135-N001) FUTURE N151 31290013 CSPNFS DC AL2(N149-N001) 31360013 CSPNFD DC AL2(N147-N001) 31430013 CSPFLT DC AL2(N145-N001) 31500013 CSPFXB DC AL2(N142-N001) 31570013 CSPFXD DC AL2(N136-N001) 31640013 DC AL2(N135-N001) 31710013 FXDSUM DC AL2(N484-N001) 31780013 FXBSUM DC AL2(N486-N001) 31850013 FXDPRD DC AL2(N484-N001) 31920013 FXBPRD DC AL2(N486-N001) 31990013 FXDPLY DC AL2(N484-N001) 32060013 FXBPLY DC AL2(N486-N001) 32130013 DDOARY DC AL2(N475-N001) 32200013 DDIARY DC AL2(N476-N001) 32270013 CMPLXA DC AL2(N489-N001) 32340013 CMPLXN DC AL2(N490-N001) 32410013 SECCON DC AL2(N477-N001) 32480013 SECREG DC AL2(N478-N001) 32550013 SECIND DC AL2(N479-N001) 32620013 DIRREG DC AL2(N480-N001) 32690013 DIRIND DC AL2(N481-N001) 32760013 ONCHCK DC AL2(N492-N001) 32830013 DC AL2(N135-N001) 32900013 DC AL2(N135-N001) 32970013 DC AL2(N135-N001) 33040013 DC AL2(N135-N001) 33110013 DC AL2(N135-N001) 33180013 DC AL2(N135-N001) 33250013 DC AL2(N135-N001) 33320013 DC AL2(N135-N001) 33390013 DC AL2(N135-N001) 33460013 DC AL2(N135-N001) 33530013 DC AL2(N135-N001) 33600013 DC AL2(N135-N001) 33670013 DC AL2(N135-N001) 33740013 DC AL2(N135-N001) 33810013 DC AL2(N135-N001) 33880013 DC AL2(N135-N001) 33950013 EJECT 34020013 TAB1A EQU * 34090013 DC AL2(N135-N001) 34160013 DC AL2(N600-N001) 34230013 DC AL2(N600-N001) 34300013 DC AL2(N600-N001) 34370013 DC AL2(N135-N001) 34440013 DC AL2(N135-N001) 34510013 DC AL2(N601-N001) 34580013 DC AL2(N601-N001) 34650013 DC AL2(N135-N001) 34720013 DC AL2(N602-N001) 34790013 DC AL2(N602-N001) 34860013 DC AL2(N602-N001) 34930013 DC AL2(N135-N001) 35000013 DC AL2(N135-N001) 35070013 DC AL2(N603-N001) 35140013 DC AL2(N603-N001) 35210013 DC AL2(N135-N001) 35280013 DC AL2(N135-N001) 35350013 DC AL2(N135-N001) 35420013 DC AL2(N135-N001) 35490013 DC AL2(N497-N001) 35560013 DC AL2(N497-N001) 35630013 DC AL2(N604-N001) 35700013 DC AL2(N604-N001) 35770013 DC AL2(N605-N001) 35840013 DC AL2(N172-N001) 35910013 DC AL2(N172-N001) 35980013 DC AL2(N172-N001) 36050013 DC AL2(N172-N001) 36120013 DC AL2(N172-N001) 36190013 DC AL2(N172-N001) 36260013 DC AL2(N135-N001) 36330013 DC AL2(N135-N001) 36400013 DC AL2(N600-N001) 36470013 DC AL2(N600-N001) 36540013 DC AL2(N600-N001) 36610013 DC AL2(N135-N001) 36680013 DC AL2(N135-N001) 36750013 DC AL2(N601-N001) 36820013 DC AL2(N601-N001) 36890013 DC AL2(N135-N001) 36960013 DC AL2(N602-N001) 37030013 DC AL2(N602-N001) 37100013 DC AL2(N602-N001) 37170013 DC AL2(N135-N001) 37240013 DC AL2(N135-N001) 37310013 DC AL2(N603-N001) 37380013 DC AL2(N603-N001) 37450013 DC AL2(N135-N001) 37520013 DC AL2(N135-N001) 37590013 DC AL2(N135-N001) 37660013 DC AL2(N135-N001) 37730013 DC AL2(N497-N001) 37800013 DC AL2(N497-N001) 37870013 DC AL2(N604-N001) 37940013 DC AL2(N604-N001) 38010013 DC AL2(N605-N001) 38080013 DC AL2(N172-N001) 38150013 DC AL2(N172-N001) 38220013 DC AL2(N172-N001) 38290013 DC AL2(N172-N001) 38360013 DC AL2(N172-N001) 38430013 DC AL2(N172-N001) 38500013 DC AL2(N135-N001) 38570013 DC AL2(N135-N001) 38640013 DC AL2(N600-N001) 38710013 DC AL2(N600-N001) 38780013 DC AL2(N600-N001) 38850013 DC AL2(N135-N001) 38920013 DC AL2(N135-N001) 38990013 DC AL2(N601-N001) 39060013 DC AL2(N601-N001) 39130013 DC AL2(N135-N001) 39200013 DC AL2(N602-N001) 39270013 DC AL2(N602-N001) 39340013 DC AL2(N602-N001) 39410013 DC AL2(N135-N001) 39480013 DC AL2(N135-N001) 39550013 DC AL2(N603-N001) 39620013 DC AL2(N603-N001) 39690013 DC AL2(N135-N001) 39760013 DC AL2(N135-N001) 39830013 DC AL2(N135-N001) 39900013 DC AL2(N135-N001) 39970013 DC AL2(N497-N001) 40040013 DC AL2(N497-N001) 40110013 DC AL2(N604-N001) 40180013 DC AL2(N604-N001) 40250013 DC AL2(N605-N001) 40320013 DC AL2(N172-N001) 40390013 DC AL2(N172-N001) 40460013 DC AL2(N172-N001) 40530013 DC AL2(N172-N001) 40600013 DC AL2(N172-N001) 40670013 DC AL2(N172-N001) 40740013 DC AL2(N135-N001) 40810013 DC AL2(N135-N001) 40880013 DC AL2(N600-N001) 40950013 DC AL2(N600-N001) 41020013 DC AL2(N600-N001) 41090013 DC AL2(N135-N001) 41160013 DC AL2(N135-N001) 41230013 DC AL2(N601-N001) 41300013 DC AL2(N601-N001) 41370013 DC AL2(N135-N001) 41440013 DC AL2(N602-N001) 41510013 DC AL2(N602-N001) 41580013 DC AL2(N602-N001) 41650013 DC AL2(N135-N001) 41720013 DC AL2(N135-N001) 41790013 DC AL2(N603-N001) 41860013 DC AL2(N603-N001) 41930013 DC AL2(N135-N001) 42000013 DC AL2(N135-N001) 42070013 DC AL2(N135-N001) 42140013 DC AL2(N135-N001) 42210013 DC AL2(N497-N001) 42280013 DC AL2(N497-N001) 42350013 DC AL2(N604-N001) 42420013 DC AL2(N604-N001) 42490013 DC AL2(N605-N001) 42560013 DC AL2(N172-N001) 42630013 DC AL2(N172-N001) 42700013 DC AL2(N172-N001) 42770013 DC AL2(N172-N001) 42840013 DC AL2(N172-N001) 42910013 DC AL2(N172-N001) 42980013 DC AL2(N135-N001) 43050013 DC AL2(N135-N001) 43120013 DC AL2(N600-N001) 43190013 DC AL2(N600-N001) 43260013 DC AL2(N600-N001) 43330013 DC AL2(N135-N001) 43400013 DC AL2(N135-N001) 43470013 DC AL2(N601-N001) 43540013 DC AL2(N601-N001) 43610013 DC AL2(N135-N001) 43680013 DC AL2(N602-N001) 43750013 DC AL2(N602-N001) 43820013 DC AL2(N602-N001) 43890013 DC AL2(N135-N001) 43960013 DC AL2(N135-N001) 44030013 DC AL2(N603-N001) 44100013 DC AL2(N603-N001) 44170013 DC AL2(N135-N001) 44240013 DC AL2(N135-N001) 44310013 DC AL2(N135-N001) 44380013 DC AL2(N135-N001) 44450013 DC AL2(N497-N001) 44520013 DC AL2(N497-N001) 44590013 DC AL2(N604-N001) 44660013 DC AL2(N604-N001) 44730013 DC AL2(N605-N001) 44800013 DC AL2(N172-N001) 44870013 DC AL2(N172-N001) 44940013 DC AL2(N172-N001) 45010013 DC AL2(N172-N001) 45080013 DC AL2(N172-N001) 45150013 DC AL2(N172-N001) 45220013 DC AL2(N135-N001) 45290013 DC AL2(N135-N001) 45360013 DC AL2(N600-N001) 45430013 DC AL2(N600-N001) 45500013 DC AL2(N600-N001) 45570013 DC AL2(N135-N001) 45640013 DC AL2(N135-N001) 45710013 DC AL2(N601-N001) 45780013 DC AL2(N601-N001) 45850013 DC AL2(N135-N001) 45920013 DC AL2(N602-N001) 45990013 DC AL2(N602-N001) 46060013 DC AL2(N602-N001) 46130013 DC AL2(N135-N001) 46200013 DC AL2(N135-N001) 46270013 DC AL2(N601-N001) 46340013 DC AL2(N601-N001) 46410013 DC AL2(N135-N001) 46480013 DC AL2(N135-N001) 46550013 DC AL2(N135-N001) 46620013 DC AL2(N135-N001) 46690013 DC AL2(N497-N001) 46760013 DC AL2(N497-N001) 46830013 DC AL2(N604-N001) 46900013 DC AL2(N604-N001) 46970013 DC AL2(N605-N001) 47040013 DC AL2(N172-N001) 47110013 DC AL2(N172-N001) 47180013 DC AL2(N172-N001) 47250013 DC AL2(N172-N001) 47320013 DC AL2(N172-N001) 47390013 DC AL2(N172-N001) 47460013 DC AL2(N135-N001) 47530013 DC AL2(N135-N001) 47600013 DC AL2(N600-N001) 47670013 DC AL2(N600-N001) 47740013 DC AL2(N600-N001) 47810013 DC AL2(N135-N001) 47880013 DC AL2(N135-N001) 47950013 DC AL2(N601-N001) 48020013 DC AL2(N601-N001) 48090013 DC AL2(N135-N001) 48160013 DC AL2(N602-N001) 48230013 DC AL2(N602-N001) 48300013 DC AL2(N602-N001) 48370013 DC AL2(N135-N001) 48440013 DC AL2(N135-N001) 48510013 DC AL2(N603-N001) 48580013 DC AL2(N603-N001) 48650013 DC AL2(N135-N001) 48720013 DC AL2(N135-N001) 48790013 DC AL2(N042-N001) 48860013 DC AL2(N135-N001) 48930013 DC AL2(N135-N001) 49000013 DC AL2(N135-N001) 49070013 DC AL2(N119-N001) 49140013 DC AL2(N118-N001) 49210013 DC AL2(N018-N001) 49280013 DC AL2(N606-N001) 49350013 DC AL2(N606-N001) 49420013 DC AL2(N606-N001) 49490013 DC AL2(N606-N001) 49560013 DC AL2(N606-N001) 49630013 DC AL2(N606-N001) 49700013 DC AL2(N135-N001) 49770013 DC AL2(N135-N001) 49840013 DC AL2(N600-N001) 49910013 DC AL2(N600-N001) 49980013 DC AL2(N600-N001) 50050013 DC AL2(N135-N001) 50120013 DC AL2(N135-N001) 50190013 DC AL2(N601-N001) 50260013 DC AL2(N601-N001) 50330013 DC AL2(N135-N001) 50400013 DC AL2(N602-N001) 50470013 DC AL2(N602-N001) 50540013 DC AL2(N602-N001) 50610013 DC AL2(N135-N001) 50680013 DC AL2(N135-N001) 50750013 DC AL2(N603-N001) 50820013 DC AL2(N603-N001) 50890013 DC AL2(N135-N001) 50960013 DC AL2(N135-N001) 51030013 DC AL2(N135-N001) 51100013 DC AL2(N135-N001) 51170013 DC AL2(N135-N001) 51240013 DC AL2(N135-N001) 51310013 DC AL2(N047-N001) 51380013 DC AL2(N042-N001) 51450013 DC AL2(N254-N001) 51520013 DC AL2(N607-N001) 51590013 DC AL2(N607-N001) 51660013 DC AL2(N607-N001) 51730013 DC AL2(N607-N001) 51800013 DC AL2(N607-N001) 51870013 DC AL2(N607-N001) 51940013 DC AL2(N135-N001) 52010013 DC AL2(N135-N001) 52080013 DC AL2(N600-N001) 52150013 DC AL2(N600-N001) 52220013 DC AL2(N600-N001) 52290013 DC AL2(N135-N001) 52360013 DC AL2(N135-N001) 52430013 DC AL2(N601-N001) 52500013 DC AL2(N601-N001) 52570013 DC AL2(N135-N001) 52640013 DC AL2(N602-N001) 52710013 DC AL2(N602-N001) 52780013 DC AL2(N602-N001) 52850013 DC AL2(N135-N001) 52920013 DC AL2(N135-N001) 52990013 DC AL2(N603-N001) 53060013 DC AL2(N603-N001) 53130013 DC AL2(N135-N001) 53200013 DC AL2(N135-N001) 53270013 DC AL2(N135-N001) 53340013 DC AL2(N135-N001) 53410013 DC AL2(N135-N001) 53480013 DC AL2(N135-N001) 53550013 DC AL2(N047-N001) 53620013 DC AL2(N042-N001) 53690013 DC AL2(N254-N001) 53760013 DC AL2(N607-N001) 53830013 DC AL2(N607-N001) 53900013 DC AL2(N607-N001) 53970013 DC AL2(N607-N001) 54040013 DC AL2(N607-N001) 54110013 DC AL2(N607-N001) 54180013 DC AL2(N135-N001) 54250013 DC AL2(N135-N001) 54320013 DC AL2(N135-N001) 54390013 DC AL2(N135-N001) 54460013 DC AL2(N135-N001) 54530013 DC AL2(N135-N001) 54600013 DC AL2(N135-N001) 54670013 DC AL2(N135-N001) 54740013 DC AL2(N135-N001) 54810013 DC AL2(N135-N001) 54880013 DC AL2(N005-N001) 54950013 * FOR VER 3 IHEVFE MUST BE INCLUDED TO COPE WITH BIN .NUM.FIELDS 55020013 DC AL2(N135-N001) 55090013 DC AL2(N135-N001) 55160013 DC AL2(N135-N001) 55230013 DC AL2(N135-N001) 55300013 DC AL2(N135-N001) 55370013 DC AL2(N135-N001) 55440013 DC AL2(N135-N001) 55510013 DC AL2(N135-N001) 55580013 DC AL2(N135-N001) 55650013 DC AL2(N135-N001) 55720013 DC AL2(N135-N001) 55790013 DC AL2(N135-N001) 55860013 DC AL2(N135-N001) 55930013 DC AL2(N135-N001) 56000013 DC AL2(N135-N001) 56070013 DC AL2(N135-N001) 56140013 DC AL2(N135-N001) 56210013 DC AL2(N135-N001) 56280013 DC AL2(N135-N001) 56350013 DC AL2(N135-N001) 56420013 DC AL2(N135-N001) 56490013 DC AL2(N135-N001) 56560013 EJECT 56630013 * TAB2 56700013 * THIS TABLE IS REFERENCED VIA TAB1 (SEE TABLES/WORKAREAS) 56770013 SPACE 1 56840013 TAB2 EQU * 56910013 N001 DC AL2(VPD-VKG) FXD TO FXD 56980013 N002 DC AL2(N005+32768-N001) 57050013 N003 DC AL2(VFB-VKG) FXD TO FXB 57120013 N004 DC AL2(VPA-VKG) 57190013 N005 DC AL2(VPF-VKG+49152) 57260013 N006 DC AL2(VFC-VKG) FXD TO FLT 57330013 N007 DC AL2(N004+32768-N001) 57400013 N008 DC AL2(VKF-VKG) FXD TO NFD 57470013 N009 DC AL2(N005+32768-N001) 57540013 N010 DC AL2(VKG-VKG) FXD TO NFS 57610013 N011 DC AL2(N005+32768-N001) 57680013 N012 DC AL2(VKE-VKG) FXD TO NFB 57750013 N013 DC AL2(N004+32768-N001) 57820013 N014 DC AL2(VPF-VKG) FXD TO BS 57890013 N015 DC AL2(VPA-VKG) 57960013 N016 DC AL2(DMA-VKG) 58030013 N017 DC AL2(VFB-VKG) 58100013 N018 DC AL2(VSA-VKG+49152) 58170013 N019 DC AL2(VPF-VKG) FXD TO CS 58240013 N020 DC AL2(N040+32768-N001) 58310013 N021 DC AL2(VPF-VKG) FXD TO CSP 58380013 N022 DC AL2(N045+32768-N001) 58450013 N023 DC AL2(VPD-VKG) FXB TO FXD 58520013 N024 DC AL2(VFA-VKG) 58590013 N025 DC AL2(VFD-VKG+49152) 58660013 N026 DC AL2(VFB-VKG) FXB TO FXB 58730013 N027 DC AL2(N025+32768-N001) 58800013 N028 DC AL2(VFC-VKG) FXB TO FLT 58870013 N029 DC AL2(N025+32768-N001) 58940013 N030 DC AL2(VKF-VKG) FXB TO NFD 59010013 N031 DC AL2(N024+32768-N001) 59080013 N032 DC AL2(VKG-VKG) FXB TO NFS 59150013 N033 DC AL2(N024+32768-N001) 59220013 N034 DC AL2(VKE-VKG) FXB TO NFB 59290013 N035 DC AL2(N025+32768-N001) 59360013 N036 DC AL2(VFD-VKG) FXB TO BS 59430013 N037 DC AL2(N016+32768-N001) 59500013 N038 DC AL2(VFD-VKG) FXB TO CS 59570013 N039 DC AL2(VFA-VKG) 59640013 DC AL2(VPD-VKG) 59710013 DC AL2(VPF-VKG) 59780013 N040 DC AL2(DMA-VKG) 59850013 N041 DC AL2(VPB-VKG) 59920013 N042 DC AL2(VSC-VKG+49152) 59990013 N043 DC AL2(VFD-VKG) FXB TO CSP 60060013 N044 DC AL2(VFA-VKG) 60130013 DC AL2(VPD-VKG) 60200013 DC AL2(VPF-VKG) 60270013 N045 DC AL2(DMA-VKG) 60340013 N046 DC AL2(VPB-VKG) 60410013 N047 DC AL2(VSE-VKG+49152) 60480013 N048 DC AL2(VPD-VKG) FLT TO FXD 60550013 N049 DC AL2(VFA-VKG) 60620013 N050 DC AL2(VFE-VKG+49152) 60690013 N051 DC AL2(VFB-VKG) FLT TO FXB 60760013 N052 DC AL2(N050+32768-N001) 60830013 N053 DC AL2(VFC-VKG) FLT TO FLT 60900013 N054 DC AL2(N050+32768-N001) 60970013 N055 DC AL2(VKF-VKG) FLT TO NFD 61040013 N056 DC AL2(N049+32768-N001) 61110013 N057 DC AL2(VKG-VKG) FLT TO NFS 61180013 N058 DC AL2(N049+32768-N001) 61250013 N059 DC AL2(VKE-VKG) FLT TO NFB 61320013 N060 DC AL2(N050+32768-N001) 61390013 N061 DC AL2(VFE-VKG) FLT TO BS 61460013 N062 DC AL2(N016+32768-N001) 61530013 N063 DC AL2(VSC-VKG) FLT TO CS 61600013 NA63 DC AL2(VFE-VKG) 61670013 N064 DC AL2(VPC-VKG) 61740013 N065 DC AL2(DMA-VKG) 61810013 NA65 DC AL2(VFA-VKG+49152) 61880013 N066 DC AL2(VSE-VKG) FLT TO CSP 61950013 N067 DC AL2(NA63-N001+32768) 62020013 N069 DC AL2(VPD-VKG) NFD TO FXD 62090013 N070 DC AL2(N073+32768-N001) 62160013 N071 DC AL2(VFB-VKG) NFD TO FXB 62230013 N072 DC AL2(VPA-VKG) 62300013 N073 DC AL2(VKB-VKG+49152) 62370013 N074 DC AL2(VFC-VKG) NFD TO FLT 62440013 N075 DC AL2(N072+32768-N001) 62510013 N076 DC AL2(VKF-VKG) NFD TO NFD 62580013 N077 DC AL2(N073+32768-N001) 62650013 N078 DC AL2(VKG-VKG) NFD TO NFS 62720013 N079 DC AL2(N073+32768-N001) 62790013 N080 DC AL2(VKE-VKG) NFD TO NFB 62860013 N081 DC AL2(N072+32768-N001) 62930013 N082 DC AL2(VKB-VKG) NFD TO BS 63000013 N083 DC AL2(N015+32768-N001) 63070013 N086 DC AL2(VPD-VKG) NFS TO FXD 63140013 N087 DC AL2(N090+32768-N001) 63210013 N088 DC AL2(VFB-VKG) NFS TO FXB 63280013 N089 DC AL2(VPA-VKG) 63350013 N090 DC AL2(VKC-VKG+49152) 63420013 N091 DC AL2(VFC-VKG) NFS TO FLT 63490013 N092 DC AL2(N089+32768-N001) 63560013 N093 DC AL2(VKF-VKG) NFS TO NFD 63630013 N094 DC AL2(N090+32768-N001) 63700013 N095 DC AL2(VKG-VKG) NFS TO NFS 63770013 N096 DC AL2(N090+32768-N001) 63840013 N097 DC AL2(VKE-VKG) NFS TO NFB 63910013 N098 DC AL2(N089+32768-N001) 63980013 N099 DC AL2(VKC-VKG) NFS TO BS 64050013 N100 DC AL2(N015+32768-N001) 64120013 N103 DC AL2(VPD-VKG) NFB TO FXD 64190013 N104 DC AL2(VFA-VKG) 64260013 N105 DC AL2(VKA-VKG+49152) 64330013 N106 DC AL2(VFB-VKG) NFB TO FXB 64400013 N107 DC AL2(N105+32768-N001) 64470013 N108 DC AL2(VFC-VKG) NFB TO FLT 64540013 N109 DC AL2(N105+32768-N001) 64610013 N110 DC AL2(VKF-VKG) NFB TO NFD 64680013 N111 DC AL2(N104+32768-N001) 64750013 N112 DC AL2(VKG-VKG) NFB TO NFS 64820013 N113 DC AL2(N104+32768-N001) 64890013 N114 DC AL2(VKE-VKG) NFB TO NFB 64960013 N115 DC AL2(N105+32768-N001) 65030013 N116 DC AL2(VKA-VKG) NFB TO BS 65100013 N117 DC AL2(N016-N001+32768) 65170013 N118 DC AL2(VSB-VKG+49152) NFB TO CS 65240013 N119 DC AL2(VSF-VKG+49152) NFB TO CSP 65310013 N121 DC AL2(DMA-VKG) BS TO FXD 65380013 N122 DC AL2(N048-N001+32768) 65450013 N125 DC AL2(DMA-VKG) BS TO FXB 65520013 N126 DC AL2(N051-N001+32768) 65590013 N127 DC AL2(DMA-VKG) BS TO FLT 65660013 N128 DC AL2(N053-N001+32768) 65730013 N129 DC AL2(DMA-VKG) BS TO NFD 65800013 N130 DC AL2(N055-N001+32768) 65870013 N131 DC AL2(DMA-VKG) BS TO NFS 65940013 N132 DC AL2(N057-N001+32768) 66010013 N133 DC AL2(DMA-VKG) BS TO NFB 66080013 N134 DC AL2(N059-N001+32768) 66150013 N135 DC AL2(16384) NO OPERATION 66220013 N136 DC AL2(VPD-VKG) CS TO FXD 66290013 N137 DC AL2(VFA-VKG) 66360013 N138 DC AL2(UPA-VKG) 66430013 NA38 DC AL2(DMA-VKG) 66500013 N139 DC AL2(VPE-VKG) 66570013 N140 DC AL2(N608-N001+32768) H165 66640017 N142 DC AL2(VFB-VKG) CS TO FXB 66710013 N143 DC AL2(VPA-VKG) 66780013 N144 DC AL2(N138+32768-N001) 66850013 N145 DC AL2(VFC-VKG) CS TO FLT 66920013 N146 DC AL2(N143+32768-N001) 66990013 N147 DC AL2(VKF-VKG) CS TO NFD 67060013 NA47 DC AL2(UPB-VKG) 67130013 DC AL2(VPF-VKG) 67200013 DC AL2(VPD-VKG) 67270013 DC AL2(VFC-VKG) 67340013 NB47 DC AL2(VFA-VKG) 67410013 N148 DC AL2(NA38-N001+32768) 67480013 N149 DC AL2(VKG-VKG) CS TO NFS 67550013 N150 DC AL2(NA47-N001+32768) 67620013 N151 DC AL2(VKE-VKG) CS TO NFB 67690013 N152 DC AL2(N143+32768-N001) 67760013 N153 DC AL2(VPD-VKG) G/E/F TO FXD 67830013 N154 DC AL2(N171-N001+32768) 67900013 N155 DC AL2(KCD-VKG) CP TO FXD 67970013 N156 DC AL2(DCN-VKG) A TO FXD 68040013 DC AL2(N136-N001+32768) 68110013 N157 DC AL2(KCA-VKG) NPD TO FXD 68180013 DC AL2(DMA-VKG) 68250013 N158 DC AL2(N069-N001+32768) 68320013 N159 DC AL2(KCB-VKG) NPS TO FXD 68390013 DC AL2(DMA-VKG) 68460013 N160 DC AL2(N086-N001+32768) 68530013 N161 DC AL2(KCC-VKG) NPB TO FXD 68600013 DC AL2(VSD-VKG) 68670013 DC AL2(DMA-VKG) 68740013 N162 DC AL2(N103-N001+32768) 68810013 N169 DC AL2(VFB-VKG) E/F/G TO FXB 68880013 N170 DC AL2(VPA-VKG) 68950013 N171 DC AL2(VPE-VKG) 69020013 N172 DC AL2(DMA-VKG+49152) 69090013 N173 DC AL2(KCD-VKG) CP TO FXB 69160013 N174 DC AL2(DCN-VKG) A TO FXB 69230013 DC AL2(N142-N001+32768) 69300013 N175 DC AL2(KCA-VKG) NPD TO FXB 69370013 DC AL2(DMA-VKG) 69440013 N176 DC AL2(N071-N001+32768) 69510013 N177 DC AL2(KCB-VKG) NPS TO FXB 69580013 DC AL2(DMA-VKG) 69650013 N178 DC AL2(N088-N001+32768) 69720013 N179 DC AL2(KCC-VKG) NPB TO FXB 69790013 DC AL2(VSD-VKG) 69860013 DC AL2(DMA-VKG) 69930013 N180 DC AL2(N106-N001+32768) 70000013 N187 DC AL2(VFC-VKG) F/E/G TO FLT 70070013 N188 DC AL2(N170-N001+32768) 70140013 N189 DC AL2(KCD-VKG) CP TO FLT 70210013 N190 DC AL2(DCN-VKG) A TO FLT 70280013 DC AL2(N145-N001+32768) 70350013 N191 DC AL2(KCA-VKG) NPD TO FLT 70420013 DC AL2(DMA-VKG) 70490013 N192 DC AL2(N074-N001+32768) 70560013 N193 DC AL2(KCB-VKG) NPS TO FLT 70630013 DC AL2(DMA-VKG) 70700013 N194 DC AL2(N091-N001+32768) 70770013 N195 DC AL2(KCC-VKG) NPB TO FLT 70840013 DC AL2(VSD-VKG) 70910013 DC AL2(DMA-VKG) 70980013 N196 DC AL2(N108-N001+32768) 71050013 N203 DC AL2(VKF-VKG) F/E/G TO NFD 71120013 N204 DC AL2(N171-N001+32768) 71190013 N205 DC AL2(KCD-VKG) CP TO NPD 71260013 N206 DC AL2(DCN-VKG) 71330013 DC AL2(N147-N001+32768) 71400013 N207 DC AL2(KCA-VKG) NPD TO NFD 71470013 DC AL2(DMA-VKG) 71540013 N208 DC AL2(N076-N001+32768) 71610013 N209 DC AL2(KCB-VKG) NPS TO NFD 71680013 DC AL2(DMA-VKG) 71750013 N210 DC AL2(N093-N001+32768) 71820013 N211 DC AL2(KCC-VKG) NPB TO NFD 71890013 DC AL2(VSD-VKG) 71960013 DC AL2(DMA-VKG) 72030013 N212 DC AL2(N110-N001+32768) 72100013 N219 DC AL2(VKG-VKG) F/E/G TO NFS 72170013 N220 DC AL2(N171-N001+32768) 72240013 N221 DC AL2(KCD-VKG) CP TO NFS 72310013 N222 DC AL2(DCN-VKG) A TO NFS 72380013 DC AL2(N149-N001+32768) 72450013 N223 DC AL2(KCA-VKG) NPD TO NFS 72520013 DC AL2(DMA-VKG) 72590013 N224 DC AL2(N078-N001+32768) 72660013 N225 DC AL2(KCB-VKG) NPS TO NFS 72730013 DC AL2(DMA-VKG) 72800013 N226 DC AL2(N095-N001+32768) 72870013 N227 DC AL2(KCC-VKG) NPB TO NFS 72940013 DC AL2(VSD-VKG) 73010013 DC AL2(DMA-VKG) 73080013 N228 DC AL2(N112-N001+32768) 73150013 N235 DC AL2(VKE-VKG) F/E/G TO NFB 73220013 N236 DC AL2(N170-N001+32768) 73290013 N237 DC AL2(KCD-VKG) CP TO NFB 73360013 N238 DC AL2(DCN-VKG) A TO NFB 73430013 DC AL2(N151-N001+32768) 73500013 N239 DC AL2(KCA-VKG) NPD TO NFB 73570013 DC AL2(DMA-VKG) 73640013 N240 DC AL2(N080-N001+32768) 73710013 N241 DC AL2(KCB-VKG) NPS-TO NFB 73780013 DC AL2(DMA-VKG) 73850013 N242 DC AL2(N097-N001+32768) 73920013 N243 DC AL2(KCC-VKG) NPB TO NFB 73990013 DC AL2(VSD-VKG) 74060013 DC AL2(DMA-VKG) 74130013 N244 DC AL2(N114-N001+32768) 74200013 N25A DC AL2(KCD-VKG) CP TO BS 74270013 N254 DC AL2(VSD-VKG+49152) A TO BS 74340013 N256 DC AL2(KCA-VKG) NPD TO BS 74410013 DC AL2(DNB-VKG) 74480013 N257 DC AL2(N082-N001+32768) 74550013 N258 DC AL2(KCB-VKG) NPS TO BS 74620013 DC AL2(DNB-VKG) 74690013 N259 DC AL2(N099-N001+32768) 74760013 N260 DC AL2(KCC-VKG) NPB TO BS 74830013 DC AL2(VSD-VKG) 74900013 DC AL2(DNB-VKG) 74970013 N261 DC AL2(N116-N001+32768) 75040013 N265 DC AL2(KCD-VKG) CP TO CS 75110013 N266 DC AL2(VSC-VKG+49152) A TO CS 75180013 N267 DC AL2(KCC-VKG) 75250013 DC AL2(VSC-VKG+49152) 75320013 N268 DC AL2(KCB-VKG) 75390013 DC AL2(VSC-VKG+49152) 75460013 N269 DC AL2(KCA-VKG+49152) 75530013 DC AL2(VSC-VKG+49152) 75600013 N273 DC AL2(KCD-VKG) 75670013 N274 DC AL2(VSE-VKG+49152) CP TO CSP 75740013 N275 DC AL2(KCC-VKG) 75810013 DC AL2(VSE-VKG+49152) 75880013 N276 DC AL2(KCB-VKG) 75950013 DC AL2(VSE-VKG+49152) 76020013 N277 DC AL2(KCA-VKG) 76090013 DC AL2(VSE-VKG+49152) 76160013 N283 DC AL2(VPB-VKG) FXD TO F 76230013 N284 DC AL2(VPF-VKG) 76300013 N285 DC AL2(DMA-VKG+49152) 76370013 N286 DC AL2(VPC-VKG) FXD TO E 76440013 N287 DC AL2(N284-N001+32768) 76510013 N288 DC AL2(DNC-VKG) FXD TO A 76580013 N289 DC AL2(N019-N001+32768) 76650013 N292 DC AL2(VKF-VKG) FXD TO NPD 76720013 N293 DC AL2(N284-N001+32768) 76790013 N294 DC AL2(VKG-VKG) FXD TO NPS 76860013 N295 DC AL2(N284-N001+32768) 76930013 N296 DC AL2(DMA-VKG) FXD TO NPB 77000013 N297 DC AL2(VSB-VKG) 77070013 N298 DC AL2(N012-N001+32768) 77140013 N299 DC AL2(DNC-VKG) FXD TO CP 77210013 N300 DC AL2(N021-N001+32768) 77280013 N307 DC AL2(VPB-VKG) FXB TO F 77350013 N308 DC AL2(VFA-VKG) 77420013 N309 DC AL2(VFD-VKG) 77490013 N310 DC AL2(DMA-VKG+49152) 77560013 N311 DC AL2(VPC-VKG) FXB TO E 77630013 N312 DC AL2(N308-N001+32768) 77700013 N313 DC AL2(DNC-VKG) FXB TO A 77770013 N314 DC AL2(N038-N001+32768) 77840013 N317 DC AL2(DMA-VKG) FXB TO NPD 77910013 N318 DC AL2(N030-N001+32768) 77980013 N319 DC AL2(DMA-VKG) FXB TO NPS 78050013 N320 DC AL2(N032-N001+32768) 78120013 N321 DC AL2(DMA-VKG) FXB TO NPB 78190013 N322 DC AL2(VSB-VKG) 78260013 N323 DC AL2(N034-N001+32768) 78330013 N324 DC AL2(DNC-VKG) FXB TO CP 78400013 N325 DC AL2(N043-N001+32768) 78470013 N332 DC AL2(VPB-VKG) FLT TO F 78540013 N333 DC AL2(VFA-VKG) 78610013 N334 DC AL2(VFE-VKG) 78680013 N335 DC AL2(DMA-VKG+49152) 78750013 N336 DC AL2(VPC-VKG) FLT TO E 78820013 N337 DC AL2(N333-N001+32768) 78890013 N338 DC AL2(DNC-VKG) FLT TO A 78960013 N339 DC AL2(N063-N001+32768) 79030013 N342 DC AL2(DMA-VKG) FLT TO NPD 79100013 N343 DC AL2(N055-N001+32768) 79170013 N344 DC AL2(DMA-VKG) FLT TO NPS 79240013 N345 DC AL2(N057-N001+32768) 79310013 N346 DC AL2(DMA-VKG) FLT TO NPB 79380013 N347 DC AL2(VSB-VKG) 79450013 N348 DC AL2(N059-N001+32768) 79520013 N349 DC AL2(DNC-VKG) FLT TO CP 79590013 N350 DC AL2(N066-N001+32768) 79660013 N357 DC AL2(VPB-VKG) NFD TO F 79730013 N358 DC AL2(VKB-VKG) 79800013 N359 DC AL2(DMA-VKG+49152) 79870013 N360 DC AL2(VPC-VKG) NFD TO E 79940013 N361 DC AL2(N358-N001+32768) 80010013 N362 DC AL2(DNC-VKG) NFD L/DDO 80080013 N363 DC AL2(N042-N001+32768) 80150013 N366 DC AL2(DMA-VKG) NFD TO NPD 80220013 N367 DC AL2(N076-N001+32768) 80290013 N368 DC AL2(DMA-VKG) NFD TO NPS 80360013 N369 DC AL2(N078-N001+32768) 80430013 N370 DC AL2(DMA-VKG) NFD TO NPB 80500013 N371 DC AL2(VSB-VKG) 80570013 N372 DC AL2(N080-N001+32768) 80640013 N381 DC AL2(VPB-VKG) NFS TO F 80710013 N382 DC AL2(VKC-VKG) 80780013 N383 DC AL2(DMA-VKG+49152) 80850013 N384 DC AL2(VPC-VKG) NFS TO E 80920013 N385 DC AL2(N382-N001+32768) 80990013 N386 DC AL2(DNC-VKG) NFS TO A 81060013 N387 DC AL2(N042-N001+32768) 81130013 N390 DC AL2(DMA-VKG) NFS TO NPD 81200013 N391 DC AL2(N093-N001+32768) 81270013 N392 DC AL2(DMA-VKG) NFS TO NPS 81340013 N393 DC AL2(N095-N001+32768) 81410013 N394 DC AL2(DMA-VKG) NFS TO NPB 81480013 N395 DC AL2(VSB-VKG) 81550013 N396 DC AL2(N097-N001+32768) 81620013 N405 DC AL2(VPB-VKG) NFB TO F 81690013 N406 DC AL2(VFA-VKG) 81760013 N407 DC AL2(VKA-VKG) 81830013 N408 DC AL2(DMA-VKG+49152) 81900013 N409 DC AL2(VPC-VKG) NFB TO E 81970013 N410 DC AL2(N406-N001+32768) 82040013 N411 DC AL2(DNC-VKG) NFB TO A 82110013 N412 DC AL2(N118-N001+32768) 82180013 N415 DC AL2(DMA-VKG) NFB TO NPD 82250013 N416 DC AL2(N110-N001+32768) 82320013 N417 DC AL2(DMA-VKG) NFB TO NPS 82390013 N418 DC AL2(N112-N001+32768) 82460013 N419 DC AL2(DMA-VKG) NFB TO NPB 82530013 N420 DC AL2(VSB-VKG) 82600013 N421 DC AL2(N114-N001+32768) 82670013 N431 DC AL2(DBN-VKG) BS TO F 82740013 N432 DC AL2(N332-N001+32768) 82810013 N433 DC AL2(DBN-VKG) BS TO E 82880013 N434 DC AL2(N336-N001+32768) 82950013 N435 DC AL2(VSB-VKG+49152) BS TO A/G 83020013 N437 DC AL2(DBN-VKG) BS TO NPD 83090013 N438 DC AL2(N129-N001+32768) 83160013 N439 DC AL2(DBN-VKG) BS TO NPS 83230013 N440 DC AL2(N131-N001+32768) 83300013 N441 DC AL2(DBN-VKG) BS TO NPB 83370013 N442 DC AL2(VSB-VKG) 83440013 N443 DC AL2(N133-N001+32768) 83510013 N444 DC AL2(VSF-VKG+49152) BS TO CP 83580013 N451 DC AL2(VPB-VKG) CSP/CS TO F 83650013 N452 DC AL2(DCN-VKG) 83720013 N453 DC AL2(NA47-N001+32768) 83790013 N454 DC AL2(VPC-VKG) CSP/CS TO E 83860013 N455 DC AL2(N452-N001+32768) 83930013 N457 DC AL2(DCN-VKG) CSP/CS TO NPD 84000013 N458 DC AL2(N147-N001+32768) 84070013 N459 DC AL2(DCN-VKG) CSP/CS TO NPS 84140013 N460 DC AL2(N149-N001+32768) 84210013 N461 DC AL2(DCN-VKG) CSP/CS TO NPB 84280013 N462 DC AL2(VSB-VKG) 84350013 N463 DC AL2(N151-N001+32768) 84420013 N464 DC AL2(VSE-VKG+49152) CSP/CS TO CP 84490013 N475 DC AL2(DDP-VKG+49152) DDO ARRAYS 84560013 N476 DC AL2(DDJ-VKG+49152) DDI ARRAYS 84630013 N477 DC AL2(ITA-VKG+49152) SEQ/CONSECUTIVE 84700013 N478 DC AL2(ITE-VKG+49152) SEQ/REGIONAL 84770013 N479 DC AL2(ITD-VKG+49152) SEQ/INDEXED 84840013 N480 DC AL2(ITB-VKG+49152) DIRECT/REGIONAL 84910013 N481 DC AL2(ITC-VKG+49152) DIRECT/INDEXED 84980013 N484 DC AL2(DMA-VKG) FXD SUM/PROD/POLY 85050013 N485 DC AL2(N006-N001+32768) 85120013 N486 DC AL2(DMA-VKG) FXB SUM/PROD/POLY 85190013 N487 DC AL2(N028-N001+32768) 85260013 N489 DC AL2(UPA-VKG+49152) CODED COMPLEX 85330013 N490 DC AL2(UPB-VKG+49152) NUMERIC COMPLEX 85400013 N492 DC AL2(DDO-VKG+49152) ON CHECK SYSTEM ACTION 85470013 N493 DC AL2(DNB-VKG) FXD TO B FORMAT 85540013 DC AL2(VSB-VKG) 85610013 DC AL2(N014-N001+32768) 85680013 N494 DC AL2(VPD-VKG) B TO FXD 85750013 N502 DC AL2(VFA-VKG) 85820013 N497 DC AL2(VPH-VKG) 85890013 DC AL2(DMA-VKG+49152) 85960013 N495 DC AL2(DNB-VKG) FXB TO B 86030013 DC AL2(VSB-VKG) 86100013 DC AL2(N036-N001+32768) 86170013 N496 DC AL2(VFB-VKG) B TO FXB 86240013 DC AL2(N497-N001+32768) 86310013 N498 DC AL2(DNB-VKG) FLT TO B 86380013 DC AL2(VSB-VKG) 86450013 DC AL2(N061-N001+32768) 86520013 N499 DC AL2(VFC-VKG) B TO FLT 86590013 DC AL2(N497-N001+32768) 86660013 N500 DC AL2(DNB-VKG) NFD TO B 86730013 DC AL2(VSB-VKG) 86800013 DC AL2(N082-N001+32768) 86870013 N501 DC AL2(VKF-VKG) B TO NFD 86940013 DC AL2(N502-N001+32768) 87010013 N503 DC AL2(DNB-VKG) NFS TO B 87080013 DC AL2(VSB-VKG) 87150013 DC AL2(N099-N001+32768) 87220013 N504 DC AL2(VKG-VKG) B TO NFS 87290013 DC AL2(N502-N001+32768) 87360013 N505 DC AL2(DNB-VKG) NFB TO B 87430013 DC AL2(VSB-VKG) 87500013 DC AL2(N116-N001+32768) 87570013 N506 DC AL2(VKE-VKG) B TO NFB 87640013 DC AL2(N497-N001+32768) 87710013 N507 DC AL2(VPE-VKG) E TO BS 87780013 DC AL2(VCA-VKG) 87850013 DC AL2(DNB-VKG) 87920013 DC AL2(N015-N001+32768) 87990013 N508 DC AL2(VSD-VKG) L/DD TO BS 88060013 DC AL2(VPG-VKG) 88130013 DC AL2(N526-N001+32768) 88200013 N509 DC AL2(VPC-VKG) F/E TO CS 88270013 N510 DC AL2(VSC-VKG) 88340013 N512 DC AL2(DNC-VKG) 88410013 DC AL2(DMA-VKG) 88480013 DC AL2(VPE-VKG) 88550013 DC AL2(VCA-VKG+49152) 88620013 N511 DC AL2(VPB-VKG) F TO CS 88690013 DC AL2(N510-N001+32768) 88760013 N513 DC AL2(VPG-VKG) LDO DDO TO CS 88830013 DC AL2(N523-N001+32768) 88900013 N514 DC AL2(VPC-VKG) E TO CSP 88970013 N517 DC AL2(VSE-VKG) 89040013 DC AL2(N512-N001+32768) 89110013 N515 DC AL2(VPB-VKG) F TO CSP 89180013 DC AL2(N517-N001+32768) 89250013 N516 DC AL2(KCD-VKG) L/DD TO CSP 89320013 DC AL2(VSE-VKG) 89390013 DC AL2(N513-N001+32768) 89460013 DC AL2(N513-N001+32768) 89530013 N520 DC AL2(DNC-VKG) NFD TO A 89600013 DC AL2(N042-N001+32768) 89670013 N521 DC AL2(DNC-VKG) NFD TO CP 89740013 DC AL2(N047-N001+32768) 89810013 N523 DC AL2(VSC-VKG) C TO CS 89880013 DC AL2(UPA-VKG) 89910001 N525 DC AL2(DNC-VKG) 89950013 N522 DC AL2(VPC-VKG) 90020013 DC AL2(VPB-VKG) 90090013 N527 DC AL2(VCS-VKG) 90160013 DC AL2(DMA-VKG) 90230013 DC AL2(VCA-VKG) 90300013 DC AL2(VPE-VKG) 90370013 DC AL2(VPD-VKG) 90440013 DC AL2(VPF-VKG) 90510013 DC AL2(VPA-VKG) 90580013 DC AL2(VFA-VKG) 90650013 DC AL2(VFB-VKG) 90720013 DC AL2(VFC-VKG) 90790013 DC AL2(VFE-VKG) 90860013 DC AL2(VFD-VKG) 90930013 DC AL2(VKB-VKG+49152) 91000013 N524 DC AL2(VSE-VKG) C TO CSP 91070013 DC AL2(N525-N001+32768) 91140013 N526 DC AL2(VSA-VKG) C TO BS 91210013 DC AL2(DNB-VKG) 91280013 DC AL2(N527-N001+32768) 91350013 N528 DC AL2(DBN-VKG) BS TO C 91420013 DC AL2(UPA-VKG) 91490013 DC AL2(VFE-VKG) 91560013 DC AL2(VFC-VKG+49152) 91630013 N529 DC AL2(VPG-VKG) CS/CSP TO C 91700013 DC AL2(VKF-VKG) 91770013 DC AL2(N522-N001+32768) 91840013 N600 DC AL2(DOE-VKG+49152) 91910013 N601 DC AL2(DOA-VKG+49152) 91980013 N602 DC AL2(DIE-VKG+49152) 92050013 N603 DC AL2(DIA-VKG+49152) 92120013 N604 DC AL2(DNC-VKG+49152) 92190013 N605 DC AL2(DNB-VKG+49152) 92260013 N606 DC AL2(DBN-VKG+49152) 92330013 N607 DC AL2(DCN-VKG+49152) 92400013 N608 DC AL2(VPG-VKG) H165 92420017 DC AL2(VFC-VKG+49152) H165 92440017 EJECT 92470013 * TAB3 92540013 * TABLE OF LIBRARY MODULE NAMES 92610013 SPACE 1 92680013 TAB3 EQU * 92750013 VKG DC C'VKG' 92820013 VKF DC C'VKF' 92890013 VKE DC C'VKE' 92960013 VKC DC C'VKC' 93030013 VKB DC C'VKB' 93100013 VKA DC C'VKA' 93170013 VPA DC C'VPA' 93240013 VPB DC C'VPB' 93310013 VPC DC C'VPC' 93380013 VPD DC C'VPD' 93450013 VPE DC C'VPE' 93520013 VPF DC C'VPF' 93590013 VPG DC C'VPG' 93660013 VPH DC C'VPH' 93730013 VFA DC C'VFA' 93800013 VFB DC C'VFB' 93870013 VFC DC C'VFC' 93940013 VFD DC C'VFD' 94010013 VFE DC C'VFE' 94080013 VSA DC C'VSA' 94150013 VSB DC C'VSB' 94220013 VSC DC C'VSC' 94290013 VSD DC C'VSD' 94360013 VSE DC C'VSE' 94430013 VSF DC C'VSF' 94500013 DMA DC C'DMA' 94570013 DCN DC C'DCN' 94640013 DNC DC C'DNC' 94710013 DBN DC C'DBN' 94780013 DNB DC C'DNB' 94850013 UPA DC C'UPA' 94920013 UPB DC C'UPB' 94990013 VCA DC C'VCA' 95060013 VCS DC C'VCS' 95130013 ITA DC C'ITA' 95200013 ITB DC C'ITB' 95270013 ITC DC C'ITC' 95340013 ITD DC C'ITD' 95410013 ITE DC C'ITE' 95480013 DDJ DC C'DDJ' 95550013 DDP DC C'DDP' 95620013 DDO DC C'DDO' 95690013 KCA DC C'KCA' 95760013 KCB DC C'KCB' 95830013 KCD DC C'KCD' 95900013 KCC DC C'KCC' 95970013 DOE DC C'DOE' 96040013 DOA DC C'DOA' 96110013 DIE DC C'DIE' 96180013 DIA DC C'DIA' 96250013 EJECT 96320013 * REGISTER DEFINITIONS 96390013 R0 EQU 0 96460013 RA EQU 1 96530013 RB EQU 2 96600013 RC EQU 3 96670013 RD EQU 4 96740013 RE EQU 5 96810013 RF EQU 6 96880013 RG EQU 7 96950013 RH EQU 8 97020013 RI EQU 9 97090013 RJ EQU 10 97160013 WR EQU 11 97230013 PR EQU 12 97300013 DR EQU 13 97370013 LR EQU 14 97440013 BR EQU 15 97510013 PWR EQU 12 97580013 END 97650013 ./ ADD SSI=04011296,NAME=IEMTT,SOURCE=0 TT TITLE 'IEMTT, SECOND PASS, FINAL ASSEMBLY, OS/360 PL/I COMPILEC00040013 R(F)' 00080013 * STATUS - CHANGE LEVEL 0 00120013 * 00160013 * 00200013 * 00240013 * FUNCTIONS - (1) SCANS INPUT TEXT ONCE WITHOUT 00280013 * MOVING IT. 00320013 * (2) MAINTAINS A LOCATION COUNTER FOR 00360013 * ASSEMBLED CODE. 00400013 * (3) GENERATES LOADER TEXT AND RELOCATION 00440013 * DIRECTORY RECORDS AND PLACES THEM IN THE REQUESTED COMBINATION 00480013 * OF LOAD AND PUNCH FILES. 00520013 * (4) ACHIEVES OBJECT TIME UNNESTING OF 00560013 * NESTED PROCEDURES BY SUITABLE MANIPULATION OF THE LOCATION 00600013 * COUNTER. 00640013 * (5) LEAVES THE VALUE OF THE OFFSET OF EACH 00680013 * PROCEDURE FROM THE START OF COMPILED CODE IN THE PROCEDURE 00720013 * DICTIONARY ENTRY TYPE 1. 00760013 * (6) NUMBERS COMPILER LABELS FOR USE BY THE 00800013 * LISTER. 00840013 * (7) SETS UP TRACE INFORMATION AT PROCEDURE 00880013 * ENTRY POINTS. 00920013 * 00960013 * 01000013 * 01040013 * ENTRY POINTS - (1) IL0000 FROM COMPILER CONTROL. THE 01080013 * MODULE BASE IS LOADED AND INITIALIZATION PERFORMED. 01120013 * 01160013 * 01200013 * 01240013 * INPUT - DICTIONARY, REGISTER ASSIGNMENT OUTPUT TEXT AS 01280013 * MODIFIED BY TF AND TJ, AND GENERATED LABEL NUMBER TABLE. 01320013 * 01360013 * 01400013 * 01440013 * OUTPUT - (1) TEXT AND RLD CARDS FOR EXECUTABLE CODE 01480013 * (I.E. ALL TEXT EXCEPT STATIC INITIALIZATION) 01520013 * (2) DICTIONARY ENTRIES FOR PROCEDURES CONTAIN 01560013 * THE FOLLOWING THREE BYTE COUNTER VALUES- 01600013 * (A) LOCN2 CONTAINS OFFSET FROM START OF PROCEDURE 01640013 * OF PROLOGUE BASE. 01680013 * (B) LOCN3 CONTAINS OFFSET FROM START OF PROCEDURE 01720013 * OF PROCEDURE BASE. 01760013 * (C) LOCN4 CONTAINS OFFSET FROM PROCEDURE BASE OF 01800013 * THE APPARENT ENTRY POINT 01840013 * (D) LOCN5 CONTAINS OFFSET OF START OF PROCEDURE 01880013 * FROM ORIGIN OF COMPILED MODULE. 01920013 * 01960013 * 02000013 * 02040013 * EXTERNAL ROUTINES - (1) ZALTOF. COMPILER CONTROL TEXT 02080013 * BLOCK STATUS CHANGE ROUTINE. 02120013 * (2) ZCHNOF. COMPILER CONTROL TEXT 02160013 * BLOCK CHAINING ROUTINE. 02200013 * (3) ZLDWOF. COMPILER CONTROL PHASE 02240013 * LOADING ROUTINE. 02280013 * (4) ZRFAOF. COMPILER CONTROL 02320013 * DICTIONARY REFERENCE TO ABSOLUTE ADDRESS ROUTINE. 02360013 * (5) ZRLSOF. COMPILER CONTROL 02400013 * RELEASE CONTROL ROUTINE. 02440013 * (6) ZTABOF. COMPILER CONTROL TEXT 02480013 * SYMBOLIC REFERENCE TO ABSOLUTE ADDRESS ROUTINE. 02520013 * (7) ZUEROF. COMPILER CONTROL ERROR 02560013 * ENTRY ROUTINE. 02600013 * (8) ZULFOF. COMPILER CONTROL LOAD 02640013 * FILE GENERATION. 02680013 * (9) ZUSPOF. COMPILER CONTROL DECK 02720013 * FILE GENERATION. 02760013 * (10) OFFSET. IN BLOCK IEMTU. GIVEN 02800013 * A DICTIONARY REFERENCE RETURNS THE OFFSET TO BE USED IN THE 02840013 * REFERENCING INSTRUCTION AND, IF REQUIRED, RELOCATION DIRECTORY 02880013 * INFORMATION. 02920013 * 02960013 * 03000013 * 03040013 * EXITS - NORMAL - RELEASE CONTROL UPON RECOGNITION OF 03080013 * END-OF-TEXT MARKER 03120013 * 03160013 * 03200013 * 03240013 * EXITS -ABNORMAL- IL0023. EXIT WITH TERMINAL MESSAGE 03280013 * WHEN INVALID PSEUDO-CODE ITEM FOUND IN TEXT. 03320013 * 03360013 * 03400013 * 03440013 * WORK AREA - THIS MODULE USES THE SCRATCH CORE OBTAINED 03480013 * BY BLOCK IEMTF FOR THE GENERATED LABEL NUMBER TABLE. IT ALSO 03520013 * USES THREE AREAS TXTCRD, RLDCRD AND RLDALT FOR BUILDING UP 03560013 * IMAGES OF LOADER TEXT, THE LATTER BEING A BUFFER FOR RLD CARD 03600013 * IMAGES PENDING OUTPUT OF ASSOCIATED TEXT CARDS. 03640013 * 03680013 * 03720013 * 03760013 * ATTRIBUTES - NOT REUSEABLE 03800013 * 03840013 * 03880013 * 03920013 * NOTES (1) THIS PHASE REQUIRES NO MODIFICATION AS A 03960013 * RESULT OF CHANGES IN THE INTERNAL REPRESENTATION OF EXTERNAL 04000013 * GRAPHICS. 04040013 * (2) REFERENCES TO EXTERNAL ROUTINES AND THE 04080013 * COMMUNICATIONS REGION ARE MADE BY MEANS OF RELOCATABLE 04120013 * SYMBOLS OBTAINED BY SUITABLE COMBINATION OF OFFSET DEFINITION 04160013 * AND USING STATEMENTS. 04200013 * (3) REGISTER USAGE. 04240013 * BASRG1. BASE FOR IEMTT 04280013 * BASRG2. BASE FOR IEMTU 04320013 * CONBAS. BASE OF COMPILER CONTROL 04360013 * DICBAS. COMMUNICATIONS REGION 04400013 * UR1 INPUT TEXT POINTER 04440013 * UR2 LOCATION COUNTER 04480013 * R0 PSEUDO-CODE OPERATION CODE BYTE 04520013 * RR RETURN REGISTER 04560013 * LR BRANCH REGISTER FOR EXTERNAL CALLS 04600013 * HR0-HR4 WORK REGISTERS 04640013 * R1,R2 ARGUMENT REGISTERS. 04680013 * (4) TECHNIQUES. 04720013 * SCANNING OF SOURCE TEXT AND HANDLING OF THE LABEL 04760013 * NUMBER TABLE IS PERFORMED IN THE SAME WAY AS IN BLOCK IEMTF 04800013 * UNNESTING OF NESTED PROCEDURES IS ACHIEVED BY 04840013 * MAINTAINING TWO CELLS PROCLC AND PROCLN. INITIALLY THE VALUE 04880013 * OF PROCLN IS ZERO AND AT ANY SUBSEQUENT TIME PROCLC CONTAINS 04920013 * THE OFFSET,FROM THE ORIGIN OF COMPILED CODE, OF THE CURRENT 04960013 * PROCEDURE, AND PROCLN THE OFFSET TO BE USED FOR THE NEXT 05000013 * PROCEDURE ENCOUNTERED IN THE SEQUENTIAL SCAN. THE DIFFERENCE 05040013 * BETWEEN THEM IS THE LENGTH OF THE CURRENT PROCEDURE OBTAINED 05080013 * FROM THE LOCN1 SLOT IN THE PROCEDURE ENTRY TYPE 1 WHERE IT 05120013 * WAS SET UP BY TF OR TJ. 05160013 EJECT 05200013 IEMTT START 0 05240013 PRINT NODATA 05280013 * DEFINITIONS OF SYMBOLS 05320013 SPACE 1 05360013 * GENERAL PURPOSE REGISTER NAMES AND USE 05400013 SPACE 1 05440013 BASRG1 EQU 9 BASE REGISTER USED FOR ADDRESSES 05480013 * IN THIS CONTROL SECTION 05520013 BASRG2 EQU 10 BASE REGISTER USED FOR ADDRESSES 05560013 * IN SECOND CONTROL SECTION IF ONE 05600013 * IS NEEDED 05640013 CONBAS EQU 11 CONTROL PHASE BASE 05680013 DICBAS EQU 13 DICTIONARY COMMUNICATION REGION 05720013 * BASE 05760013 R0 EQU 6 PSEUDO-CODE OPERATION CODE BYTE 05800013 R1 EQU 7 05840013 R2 EQU 8 05880013 SPACE 1 05920013 UR0 EQU 3 05960013 UR1 EQU 4 INPUT TEXT POSITION POINTER 06000013 UR2 EQU 5 LOCATION COUNTER 06040013 SPACE 1 06080013 RR EQU 14 RETURN REGISTER FOR SUBROUTINE 06120013 * CALLS 06160013 LR EQU 15 ENTRY POINT REGISTE FOR CONTROL 06200013 * PHASE SUBROUTINE CALLS 06240013 SPACE 1 06280013 HR0 EQU 0 THESE FIVE REGISTERS ARE USED 06320013 HR1 EQU 1 AS WORKING REGISTERS AND IN 06360013 HR2 EQU 2 INTERNAL SUBROUTINE CALLS ARE NOT 06400013 HR3 EQU RR ASSUMED TO BE PRESERVED 06440013 HR4 EQU LR 06480013 SPACE 2 06520013 * BRANCH MNEMONIC DEFINITIONS 06560013 B EQU 15 UNCONDITIONAL BRANCH 06600013 NOP EQU 0 NO OPERATION BRANCH 06640013 SPACE 1 06680013 BH EQU 2 BRANCH ON HIGH 06720013 BL EQU 4 LOW 06760013 BE EQU 8 EQUAL 06800013 BNH EQU 13 NOT HIGH 06840013 BNL EQU 11 NOT LOW 06880013 BNE EQU 7 NOT EQUAL 06920013 SPACE 1 06960013 BO EQU 1 BRANCH ON OVERFLOW OR ONES 07000013 BP EQU 2 PLUS 07040013 BM EQU 4 MINUS OR MIXED 07080013 BZ EQU 8 ZERO OR ZEROES 07120013 SPACE 1 07160013 BNM EQU BZ+BP BRANCH ON NOT MINUS 07200013 BNZ EQU BO+BP+BM NOT ZERO 07240013 BNP EQU BL+BE NOT POSITIVE 07280013 SPACE 1 07320013 * DEFINITIONS OF 4K BLOCKS USED TO EFFECT AUTOMATIC BASE 07360013 * REGISTER ASSIGNMENT FOR COMMUNICATIONS REFERENCES 07400013 SPACE 1 07440013 BLOCK1 EQU * 07480013 BLOCK2 EQU BLOCK1+X'1000' 07520013 CONBLK EQU *+X'4000' 07560013 DICBLK EQU *+X'5000' 07600013 SPACE 1 07640013 USING BLOCK1,BASRG1 07680013 USING BLOCK2,BASRG2 07720013 USING DICBLK,DICBAS 07760013 USING CONBLK,CONBAS 07800013 SPACE 2 07840013 * DEFINITIONS OF CONTROL PHASE TRANSFER VECTOR OFFSETS 07880013 SPACE 1 07920013 ZUPLOF EQU CONBLK+X'08' PRINT 07960013 ZABTOF EQU CONBLK+X'20' ABORT 08000013 ZLDWOF EQU CONBLK+X'24' LOAD AND WAIT 08040013 ZUEROF EQU CONBLK+X'30' ERROR ENTRY 08080013 ZRFAOF EQU CONBLK+X'34' DICTREF TO ABS 08120013 ZRQSOF EQU CONBLK+X'40' 08160013 ZRLSOF EQU CONBLK+X'48' RELEASE CONTROL 08200013 ZTABOF EQU CONBLK+X'54' TEXT REF TO ABSOLUTE 08240013 ZCHNOF EQU CONBLK+X'58' CHAIN 08280013 ZALTOF EQU CONBLK+X'5C' ALTER 08320013 ZULFOF EQU CONBLK+X'70' LOAD FILE 08360013 ZUSPOF EQU CONBLK+X'74' PUNCH FILE 08400013 SPACE 2 08440013 * DEFINITIONS OF DICTIONARY COMMUNICATIONS REGION OFFSETS 08480013 SPACE 1 08520013 ZCOMM EQU DICBLK+304 BASE OF INTER-PHASE COMMUNICAT- 08560013 * ION REGION 08600013 ZTRAN2 EQU DICBLK+72 INTERNAL TO EXTERNAL TRANSLATE 08640013 * TABLE 08680013 ZMYNAM EQU DICBLK+112 PHASE NAME CELL 08720013 ZSTACH EQU DICBLK+124 08740015 PAR1 EQU DICBLK+128 08760013 PAR2 EQU PAR1+4 08800013 PAR3 EQU PAR2+4 08840013 PAR4 EQU PAR3+4 08880013 PAR5 EQU PAR4+4 08920013 PAR6 EQU PAR5+4 08960013 PAR7 EQU PAR6+4 09000013 PAR8 EQU PAR7+4 09040013 CCCODE EQU DICBLK+232 CONTROL CARD CODES 09080013 CCLOAD EQU X'10' LOAD FILE SWITCH 09120013 CCPNCH EQU X'08' DECK SWITCH 09160013 STXT EQU DICBLK+256 START OF TEXT 09200013 LOCK EQU DICBLK+274 LOCK SLOT 09240013 SPACE 1 09280013 ZINCL EQU ZCOMM+28 INCLUDE MATRIX ENTRY REFERENCE 09320013 ZEQTAB EQU ZCOMM+32 LABEL TABLE ADDRESS 09360013 ZMAXEQ EQU ZCOMM+82 MAX LABEL NUMBER USED 09400013 ZTXTSZ EQU DICBLK+264 09440013 PROGL EQU ZCOMM+52 09480013 ZESDID EQU ZCOMM+74 09520013 ZFLAG4 EQU ZCOMM+19 09560013 ZCMPSR EQU X'10' 09600013 SPACE 2 09640013 * DEFINITIONS OF OFFSETS OF DICTIONARY ENTRY FIELDS 09680013 * COMPILER AND STATEMENT LABEL ENTRIES 09720013 SLCODE EQU X'00' STATEMENT LABEL IDENTIFICATION 09760013 CSLSIO EQU 5 STATIC OFFSET, IF ANY 09800013 CSLOT1 EQU 10 OTHER 1 09840013 OT1ASG EQU X'10' 'ASSIGNED' FLAG 09880013 OT1SIO EQU X'02' STATIC ADCON IN FIRST 4K OF STATIC 09920013 CSLUSE EQU 14 USE FIELD 09960013 CSLBYT EQU 18 ASSEMBLER CODE BYTE FIELD 10000013 BYTPRL EQU X'40' PROLOGUE/PROCEDURE BIT 10040013 * ENTRY LABEL ENTRY 10080013 ELCODE EQU X'01' IDENTIFICATION CODE 10120013 * PROCEDURE ENTRY TYPE 1 10160013 ET1COD EQU X'80' IDENTIFICATION CODE OF ET1 10200013 ET1BCH EQU 5 CHAIN TO NEXT OUTER ET1 10240013 ET1LBL EQU 7 REFERENCE OF FIRST ENTRY LABEL 10280013 ET1LC1 EQU 11 LOCN 1 10320013 ET1LC2 EQU 14 2 10360013 ET1LC3 EQU 17 3 10400013 ET1LC4 EQU 20 4 10440013 ET1X2 EQU 26 X2 10480013 ET1X3 EQU 27 X3 10520013 ET1LC5 EQU 28 LOCN 5 10560013 * BEGIN ENTRY 10600013 BGNCOD EQU X'81' IDENTIFICATION CODE OF BEGIN 10640013 BGNFLG EQU 34 FLAG BYTE 10680013 SL EQU X'D2' FLAG SETTING FOR LABELLED BLOCK 10720013 * ENTRY ENTRY TYPE 1 10760013 EN1COD EQU X'82' 10800013 * COMPILER LABEL 10840013 CLCODE EQU X'C3' 10880013 SPACE 2 10920013 * PSEUDO CODE OPERATION DEFINITIONS 10960013 OPOSM1 EQU X'10' OSM1 11000013 OPOSM2 EQU X'11' OSM2 11040013 OPDCA4 EQU X'14' DCA4 11080013 OPEOB EQU X'21' END OF BLOCK 11120013 OPALGN EQU X'2F' ALIGN 11160013 OPBXH EQU X'7A' BXH 11200013 OPBXLE EQU X'7B' BXLE 11240013 OPLA EQU X'A0' LA INTERNAL OP CODE 11280013 SPACE 2 11320013 * ASSEMBLY PARAMETER DEFINITIONS 11360013 CRDLNG EQU 56 NUMBER OF BYTES IN VARIABLE 11400013 * FIELD OF A CARD 11440013 RLDLN4 EQU X'0C' 4-BYTE RLD ITEM 11480013 RLDTFG EQU X'01' RLD T FLAG 11520013 INBLNK EQU X'40' INTERNAL BLANK 11560013 BLANK EQU X'40' CHARACTER WHICH PUNCHES AS A 11600013 * BLANK COLUMN. 11640013 UNWANT EQU X'02' 'UNWANTED' FLAG FOR ZCHAIN 11680013 DREQFL EQU X'80' FLAG BIT WHICH DESCRIMINATES 11720013 * EQU AND DICT. REF. 11760013 BRNREG EQU 10 BASE REGISTER 11800013 SDPREG EQU 11 STATIC DATA POINTER 11840013 EJECT 11880013 * INITIALIZATION OF PHASE 11920013 * FUNCTIONS - (1) ACCESS FIRST INPUT TEXT BLOCK AND LOAD 11960013 * INPUT TEXT POINTER. 12000013 * (2) LOAD BLOCK IEMTU AND SET UP ITS BASE. 12040013 * (3) INITILIZE SWITCHES IN THE PUNCH ROUTINE 12080013 * IN ACCORDANCE WITH SPECIFIED OPTIONS. 12120013 * (4) INITIALIZE REGISTERS AND ENTER SCAN. 12160013 * 12200013 * ENTRY POINT - IL0000 FROM COMPILER CONTROL 12240013 * 12280013 * EXTERNAL ROUTINES - (1) ZLDWOF 12320013 * (2) ZTABOF 12360013 * 12400013 * EXITS - NORMAL - ENTER TEXT SCANNING LOOP 12440013 * 12480013 * EXITS -ERROR- NONE 12520013 SPACE 2 12560013 IL0000 DC C'TT' NAME OF PHASE IEM-TT 12600013 L BASRG1,PAR1 LOAD BASE ADDRESS OF PHASE 12640013 MVC ZMYNAM(2),IL0000 INSERT NAME OF PHASE IN 12680013 * COMMUNICATION REGION 12720013 BC B,EXTEND BRANCH ROUND 'EXTERNAL' SLOTS 12760013 * USED BY OFFSET ROUTINE 12800013 SPACE 1 12840013 * DEFINITIONS OF INTER-BLOCK COMMUNICATIONS 12880013 SPACE 1 12920013 * BLOCK1 ENTRIES 12960013 OFFST0 DC F'0' OFFSET RETURNED BY OFFSET RTN 13000013 RELOC0 DC F'0' RLD REQUEST RETURNED BY OFFSET 13040013 WSBLOK DC H'0' CURRENT BLOCK REFERENCE 13080013 PROCLC DS F PROLOG LENGTH 13100001 * BLOCK2 ENTRIES 13120013 OFFSET EQU BLOCK2 OFFSET SUBROUTINE ENTRY 13160013 SOPRO EQU OFFSET+4 13166001 SOINIT EQU SOPRO+4 13172001 SOPROI EQU SOINIT+4 13178001 SOSN EQU SOPROI+4 13184001 CODTAB EQU SOSN+4 13190001 TABLE2 EQU CODTAB+256 OFFSET OF TABLE2 13200015 TABLE3 EQU TABLE2+256 OFFSET OF TABLE3 13240013 TXTCRD EQU TABLE3+256 13241015 TXTADR EQU TXTCRD+4 13242015 TXTLNG EQU TXTCRD+10 13243015 TXTESD EQU TXTCRD+14 13244015 TXTVFD EQU TXTCRD+16 13245015 TXTSEQ EQU TXTCRD+72 13246015 RLDCRD EQU TXTCRD+80 13247015 RLDLNG EQU RLDCRD+10 13248015 RLDVFD EQU RLDCRD+16 13249015 RLDSEQ EQU RLDCRD+72 13250015 RELOC1 EQU RLDCRD+80 13251015 RELOC2 EQU RELOC1+4 13252015 CNZERO EQU RELOC2+4 13253015 WS1001 EQU CNZERO+4 13254015 WS1002 EQU WS1001+4 13255015 CN0000 EQU WS1002+4 13256015 SAVERR EQU CN0000+4 13257015 EQUTXT EQU SAVERR+4 13258015 CN0003 EQU EQUTXT+4 13259015 CN0101 EQU CN0003+4 13260015 CN0103 EQU CN0101+4 13261015 RLDALT EQU CN0103+4 13262015 SPACE 1 13280013 EXTEND EQU * 13320013 * GET FIRST INPUT TEXT BLOCK 13360013 L HR1,STXT GET START OF INPUT TEXT REF. 13400013 ST HR1,WSTEXT AND SAVE IN WSTEXT FOR CHAINING 13440013 ST HR1,PAR1 PURPOSES 13480013 L LR,ZTABOF 13520013 BALR RR,LR 13560013 L UR1,PAR1 13600013 * UR1 NOW CONTAINS ADDRESS OF FIRST BYTE OF TEXT 13640013 SPACE 1 13680013 LA HR1,CNLDTU GET NAME OF BLOCK 13720013 ST HR1,PAR1 13760013 L LR,ZLDWOF 13800013 BALR RR,LR CALL ZLOADW 13840013 L BASRG2,PAR1 BASE OF SECOND CONTROL SECTION 13880013 * GO TO INITIALISING ROUTINE FOR STATEMENT/OFFSET TABLE 13890001 BAL RR,SOINIT 13900001 SPACE 1 13920013 * INITIALIZE SWITCHES IN PUNCH ROUTINE FOR LOAD FILE AND 13960013 * PUNCH FILE OPTIONS 14000013 TM CCCODE,CCLOAD 14040013 BC BZ,IL0004 IF 0, LOAD FILE REQUIRED 14080013 SPACE 1 14120013 OI SWLDFL,X'F0' IF 1, NO LOAD FILE. SET LDFL 14160013 * SWITCH TO BRANCH 14200013 IL0004 TM CCCODE,CCPNCH 14240013 BC BZ,IL0001 IF 0, DECK REQUIRED 14280013 SPACE 1 14320013 OI SWPCFL,X'F0' IF 1, NO DECK. SET PCFL SWITCH 14360013 * TO BRANCH 14400013 SPACE 14440013 IL0001 L HR1,ZTXTSZ 14480013 SRA HR1,2 TEXT BLOCK SIZE / 4 14520013 ST HR1,CN0000 14560013 SPACE 14600013 L HR2,ZEQTAB 14640013 SR HR1,HR1 14680013 ST HR1,PAR1 14720013 MVC PAR1+1(1),0(HR2) SET EQUCUR AND EQUTXT 14760013 MVC EQUCUR(1),0(HR2) 14800013 L LR,ZTABOF 14840013 BALR RR,LR 14880013 MVC EQUTXT+1(3),PAR1+1 14920013 SPACE 14960013 MVC SVMXEQ(2),ZMAXEQ SAVE MAX NO OF COMPILER LABELS 15000013 SPACE 1 15040013 * INITIALIZE REGISTERS 15080013 SR UR2,UR2 LOCATION COUNTER = 0 15120013 BC B,IL0003 15240013 * END OF INITIALIZATION 15280013 EJECT 15320013 * SCAN LOOP 15360013 SPACE 1 15400013 * FUNCTIONS - (1) DETERMINE ACTION TO BE PERFORMED FOR 15440013 * THE CURRENT PSEUDO-CODE ITEM. 15480013 * (2) UPDATE INPUT TEXT POINTER TO ADDRESS 15520013 * NEXT PSEUDO-CODE ITEM. 15560013 * 15600013 * ENTRY POINTS - IL0003 FROM INITIALIZATION AND END-OF. 15640013 * BLOCK MARKER SECTION (NO UPDATE OF TEXT POINTER) 15680013 * IL0002 FROM OTHER SECTIONS TO UPDATE 15720013 * TEXT POINTER 15760013 * 15800013 * EXITS - NORMAL - VIA BRANCH TABLE TO APPROPRIATE SECTION 15840013 * FOR CURRENT PSEUDO-CODE ITEM. 15880013 * 15920013 * EXITS - ERROR - NONE. 15960013 * 16000013 * TABLES³WORKAREAS - TABLE1 AND TABLE2 HAVE THE SAME 16040013 * SIGNIFICANCE AND DIFFER ONLY IN SMALL DETAIL FROM THOSE IN TF 16080013 SPACE 2 16120013 IL0002 SR HR1,HR1 CLEAR HR1 AND INSERT PSEUDO- 16160013 IL0024 IC HR1,TABLE2(R0) CODE ITEM LENGTH. 16200013 AR UR1,HR1 UPDATE TEXT POINTER TO ADDRESS 16240013 * NEXT PSEUDO-CODE 16280013 IL0003 SR R0,R0 16300001 SR HR1,HR1 16320001 IC R0,0(0,UR1) GET OPCODE AND USE TABLE1 TO 16340001 IC HR1,TABLE1(R0) FIND BRANCH TABLE ENTRY FOR THIS 16360013 EX 0,ILBASE(HR1) CODE. 16400013 * BRANCH TABLE OF ENTRIES TO PSEUDO-CODE ROUTINES 16440013 ILBASE EQU * 16480013 PROC BC B,IL0010 PROC 16520013 PROCP BC B,IL0011 PROC' 16560013 RROP BC B,IL0012 RR MACHINE INST. 16600013 RX BC B,IL0013 RX INSTRUCTION, NOT BRANCH 16640013 SS BC B,IL0014 SS INSTRUCTION 16680013 PLBS BC B,IL0015 PLBS 16720013 PCBS BC B,IL0016 PCBS 16760013 EOP BC B,IL0017 END-OF-TEXT MARKER 16800013 BEGIN BC B,IL0018 BEGIN 16840013 CLSL BC B,IL0019 COMPILER AND STATEMENT LABELS 16880013 BLA BC B,IL0020 BRANCHES AND LOAD ADDRESS 16920013 ADR BC B,IL0021 ADDRESSING REGISTER 16960013 EOB BC B,IL0022 END OF TEXT BLOCK 17000013 INVAL BC B,IL0023 INVALID OP.CODE 17040013 PSEUD BC B,IL0002 PSEUDO-OP IGNORED BY PASS II 17080001 CONST BC B,IL0025 DC PSEUDO.OP 17120013 RS2 BC B,IL0026 LM AND STM 17160013 RS1 BC B,IL0027 RS INSTRUCTION (SHIFT) 17200013 SI BC B,IL0028 SI INSTRUCTION 17240013 BEGINP BC B,IL0029 BEGIN' 17280013 STATNO BC B,IL0030 STATEMENT NUMBER 17300015 EJECT 17320013 * PROC PSEUDO-CODE ITEM 17360013 * FUNCTIONS - (1) SAVE THE LOCATION COUNTER VALUE IN THE 17400013 * LOCN1 SLOT OF THE CURRENT PROCEDURE ENTRY TYPE 1. 17440013 * (2) ACCESS THE PROCEDURE ET1 FOR THE 17480013 * PROCEDURE WHICH IS ABOUT TO BE ENTERED AND SET LOCN5 SLOT TO 17520013 * THE OFFSET OF THE PROCEDURE FROM THE ORIGIN OF COMPILED CODE. 17560013 * (3) UPDATE PROCLC AND PROCLN SLOTS TO OFFSET 17600013 * OF THIS PROCEDURE AND THE NEXT ONE RESPECTIVELY. 17640013 * (4) SET UP WSX2 AND WSX3 WHICH INDICATE 17680013 * RESPECTIVELY THE NUMBER OF ADDRESS CONSTANTS REQUIRED BY THE 17720013 * PROLOGUE AND THE PROCEDURE. 17760013 * (5) RESET THE LOCATION COUNTER TO ZERO. THE 17800013 * TRUE LOCATION COUNTER VALUE IS ALWAYS THE SUM OF PROCLC AND 17840013 * THE CONTENTS OF THE LOCATION COUNTER REGISTER UR2. 17880013 * (6) OUTPUT ANY OUTSTANDING TEXT FOR THE 17920013 * CURRENT PROCEDURE. 17960013 * 18000013 * NOTES. ON ENTRY TO THIS SECTION REGISTER CONTENTS ARE- 18040013 * R0 OP.CODE 18080013 * UR1 INPUT TEXT POINTER 18120013 * UR2 LOCATION COUNTER 18160013 SPACE 1 18200013 IL0010 LH HR1,WSPROC ENTRY FROM SCAN. TEST FOR 18240013 LTR HR1,HR1 OUTERMOST PROCEDURE (WSPROC=0) 18280013 BC BZ,IL1001 18320013 STH HR1,PAR1+2 IF NOT OUTERMOST, GET DICT ENTRY 18360013 L LR,ZRFAOF OF CURRENT PROCEDURE 18400013 BALR RR,LR 18440013 L R1,PAR1 SET R1=ADDR OF DICT ENTRY 18480013 SPACE 1 18520013 ST UR2,WS1000 SAVE VALUE OF LOCN COUNTER IN 18560013 MVC ET1LC1(3,R1),WS1000+1 LOCN1 SLOT OF ENTRY 18600013 BAL RR,PUNCHT PUNCH OUTSTANDING TEXT 18640013 SPACE 1 18680013 * 18720013 IL1001 MVC WSPROC(2),1(UR1) GET DICT REF OF NEW PROCEDURE 18760013 LH HR1,WSPROC AND GET DICTIONARY ENTRY OF 18800013 STH HR1,PAR1+2 PROCEDURE ET1 18840013 STH HR1,WSBLOK SET UP CURRENT BLOCK REF 18880013 L LR,ZRFAOF 18920013 BALR RR,LR 18960013 L R1,PAR1 R1=DICT ENTRY ADDRESS 19000013 SPACE 1 19040013 MVC PAR1+2(2),7(R1) GET DICTIONARY ENTRY FOR LABEL 19046015 BALR RR,LR 19052015 L HR1,PAR1 19058015 MVC ZSTACH+2(2),8(HR1) MOVE STATEMENT NO. TO ZSTACH 19064015 SPACE 19070015 MVC WSX2+1(1),ET1X2(R1) GET X2 AND X3 19080013 MVC WSX3+1(1),ET1X3(R1) 19120013 SPACE 1 19160013 MVC ET1LC5(3,R1),PROCLN+1 SET LOCN5 TO OFFSET OF THIS 19200013 * PROCEDURE FROM BEGINNING OF 19240013 * CONTROL SECTION. 19280013 MVC WS1001+1(3),ET1LC1(R1) GET LOCN1 (LENGTH OF THIS PROC) 19320013 L HR1,PROCLN PLACE PROCLN IN PROCLC AS THE 19360013 ST HR1,PROCLC START OF THIS PROCEDURE. UPDATE 19400013 A HR1,WS1001 PROCLN FOR START OF NEXT PROCEDURE 19440013 ST HR1,PROCLN IF ANY. 19480013 * GO TO INITIALISE STACK FOR THIS PROCEDURE 19490001 BAL RR,SOPRO 19500001 SPACE 1 19520013 SR UR2,UR2 SET LOCN COUNTER=0 AND RETURN 19560013 BC B,IL0002 TO SCAN. 19600013 EJECT 19640013 * PROC' PSEUDO-CODE ITEM 19680013 * FUNCTIONS - (1) PUNCH ANY OUTSTANDING TEXT FOR THE 19720013 * CURRENT PROCEDURE. 19760013 * (2) CHAIN BACK TO THE PROCEDURE ENTRY TYPE 19800013 * 1 FOR THE CONTAINING PROCEDURE (IF ANY), AND RESTORE THE 19840013 * LOCATION COUNTER REGISTER FROM LOCN1 SLOT AND PROCLC FROM 19880013 * THE LOCN5 SLOT + LOCN3 (RETURN TO A CONTAINING PROCEDURE MUST 19920013 * BE IN PROCEDURE, NOT PROLOGUE, CODE) 19960013 * NOTES. ON ENTRY TO THIS SECTION REGISTER CONTENTS ARE- 20000013 * R0 OP.CODE 20040013 * UR1 INPUT TEXT POINTER 20080013 * UR2 LOCATION COUNTER 20120013 SPACE 1 20160013 IL0011 BAL RR,PUNCHT PUNCH OUTSTANDING TEXT FOR 20200013 MVC PAR1+2(2),WSPROC BLOCK REFERENCE 20240013 L LR,ZRFAOF GET DICT ENTRY OF THIS PROC 20280013 BALR RR,LR 20320013 L R1,PAR1 20360013 * GO TO PRINT OFFSET TABLE FOR THIS BLOCK 20370001 BAL RR,SOPROI 20380001 SPACE 1 20400013 CLC ET1BCH(2,R1),CNZERO TEST BACKWARD CHAIN REF AND 20440013 BC BZ,IL0002 BRANCH IF ZERO, IE OUTERMOST PROC 20480013 SPACE 1 20520013 MVC WSBLOK(2),ET1BCH(R1) COPY CHAIN POINTER AS REFERENCE 20560013 * TO CURRENT BLOCK 20600013 IL1101 MVC PAR1+2(2),ET1BCH(R1) CHAIN BACK TO CONTAINING BLOCK 20640013 MVC WSPROC(2),PAR1+2 20680013 L LR,ZRFAOF GET DICT ENTRY REFERENCED BY 20720013 BALR RR,LR BACKWARD CHAIN POINTER 20760013 L R1,PAR1 20800013 SPACE 1 20840013 CLI 0(R1),BGNCOD IF BEGIN ET1 CONTINUE BACKWARD 20880013 BC BE,IL1101 CHAIN OTHERWISE - 20920013 SPACE 1 20960013 MVC WS1001+1(3),ET1LC1(R1) RESTORE LOCATION COUNTER 21000013 L UR2,WS1001 21040013 MVC WS1001+1(3),ET1LC3(R1) RESTORE PROCLC, USING THE 21080013 MVC PROCLC+1(3),ET1LC5(R1) OFFSET OF THE PROCEDURE (LOCN5) 21120013 L HR1,WS1001 PLUS LOCATION OF PCBS MARKER 21160013 A HR1,PROCLC (LOCN3) 21200013 ST HR1,PROCLC 21240013 BC B,IL0002 21280013 EJECT 21320013 * RR MACHINE INSTRUCTION 21360013 * R0 =OP.CODE 21400013 * UR1=INPUT TEXT POINTER 21440013 SPACE 1 21480013 IL0012 IC HR1,TABLE3(R0) USE PSEUDO-OP CODE TO OBTAIN 21520013 STC HR1,OPTEXT TRUE MACHINE OP.CODE FROM TABLE3. 21560013 MVC OPTEXT+1(1),1(UR1) PLACE THIS AND THE OPERAND BYTE IN 21600013 LA R2,2 OPTEXT AND SET TEXT LENGTH=2 21640013 SPACE 1 21680013 IL1201 LA R1,OPTEXT ENTRY HERE FROM RR,RX,RS ETC. 21720013 BAL RR,GENTXT GET ADDRESS OF TEXT AND CALL 21760013 * GENTXT TO PLACE IT IN CARD. 21800013 BC B,IL0002 RETURN TO SCAN. 21840013 EJECT 21880013 * RX,RS2 AND SI INSTRUCTIONS 21920013 * THIS SECTION PRODUCES TEXT FOR ALL SI INSTRUCTIONS, LM 21960013 * AND STM, AND ALL RX OTHER THAN LA,BC,BAL AND BCT. 22000013 * R0 =OP.CODE 22040013 * UR1=INPUT TEXT POINTER 22080013 IL0013 EQU * RX 22120013 IL0026 EQU * RS2 22160013 IL0028 EQU * SI 22200013 IC HR1,TABLE3(R0) GET MACHINE OP.CODE FROM TABLE3 22240013 STC HR1,OPTEXT AND STORE IN TEXT SKELETON 22280013 MVC OPTEXT+1(1),1(UR1) COPY NEXT INPUT TEXT BYTE WHICH 22320013 * REPRESENTS R1,X OR R1,R2 OR I 22360013 * DEPENDING ON INSTRUCTION TYPE 22400013 IC HR1,2(0,UR1) GET BASE REGISTER BYTE. SHIFT 22440013 SLL HR1,12 AND STORE IN TEXT SKELETON SO AS 22480013 STH HR1,OPTEXT+2 TO PLACE B FIELD CORRECTLY AND 22520013 * CLEAR OFFSET 12 BIT FIELD. 22560013 SPACE 1 22600013 * NOW EXAMINE PSEUDO CODE FOLLOWING CURRENT ITEM TO SEE 22640013 * IF A LITTERAL OFFSET IS REQUIRED 22680013 LR R1,UR1 SAVE CURRENT TEXT POINTER IN R1 22720013 IC R0,TABLE2(R0) UPDATE UR1 BY LENGTH OF THIS 22760013 AR UR1,R0 ITEM 22800013 SPACE 1 22840013 CLI 0(UR1),OPOSM2 TEST PSEUDO-OP CODE 22880013 BC BE,IL2601 BRANCH IF OFFSET CODE OSM2 22920013 CLI 0(UR1),OPEOB 22960013 BC BE,IL2602 BRANCH IF END OF BLOCK 23000013 SPACE 1 23040013 * NO LITTERAL OFFSET 23080013 LA R2,CNZERO SET POINTER TO 0 OFFSET 23120013 IL2605 LA R1,3(0,R1) SET POINTER TO DICT REF IN TEXT 23160013 IL2607 BAL RR,OFFSET EVALUATE OFFSET 23200013 BC B,IL2603 RETURNS TO THIS POINT IF AN RLD 23240013 * ENTRY IS REQUIRED 23280013 IL2604 L HR1,OFFST0 RETURN HERE IF NO RLD. CLEAR 23320013 N HR1,CN0102 HIGH ORDER BITS OF OFFSET AND OR 23360013 O HR1,OPTEXT OFFSET INTO OPTEXT 23400013 ST HR1,OPTEXT 23440013 LA R2,4 SET LENGTH=4 23480013 MVI WS1002+1,X'00' 23520013 IL2610 LA R1,OPTEXT ENTRY FROM SS 23560013 BAL RR,GENTXT GENERATE TEXT CARD 23600013 BC B,IL0003 UPDATING OF INPUT TEXT POINTER. 23680013 SPACE 1 23720013 * RETURN FROM OFFSET INDICATED RLD ENTRY REQUIRED 23760013 IL2603 LA HR1,2 MUST BE PSEUDO-REGISTER 23800013 O HR1,RELOC0 REFERENCE. OFFSET FROM BEGINNING 23840013 ST HR1,RELOC1 OF INSTRUCTION=2 23880013 OI SWRLD1,X'F0' SET RLD1 SWITCH ON, THEN PROCEED 23920013 BC B,IL2604 AS FOR NO RLD 23960013 SPACE 1 24000013 * PSEUDO-CODE ITEM FOLLOWING INSTRUCTION IS OSM2 24040013 IL2601 LA R2,1(0,UR1) SET R2 TO POINT AT 2 BYTE OFFSET 24080013 BC B,IL2605 FIELD, THEN PROCEED AS FOR NO 24120013 * LITTERAL OFFSET 24160013 SPACE 1 24200013 * END-OF-BLOCK PSEUDO CODE NEXT IN TEXT 24240013 IL2602 MVC WS1002+1(3),2(R1) MOVE DICT REF FROM INSTRUCTION 24280013 * PSEUDO-CODE ITEM TO TEMPORARY 24320013 BAL RR,EOBRTN GET NEXT BLOCK. ON RETURN UR1 24360013 * ADDRESSES NEXT BLOCK 24400013 LA R2,CNZERO 24440013 CLI 0(UR1),OPOSM2 TEXT NEXT PSEUDO CODE ITEM AND 24480013 BC BNE,IL2606 BRANCH IF NOT OSM2 24520013 SPACE 1 24560013 LA R2,1(0,UR1) IF OSM2 POINT R2 AT OFFSET FIELD 24600013 IL2606 LA R1,WS1002+2 POINT R1 AT SAVED DICT REF 24640013 BC B,IL2607 GO TO OFFSET ROUTINE AND PROCEED 24680013 * AS IN NORMAL CASE. 24720013 EJECT 24760013 * SS MACHINE INSTRUCTION 24800013 * THIS SECTION IS ENTERED FOR ALL SS INSTRUCTIONS, LOGICAL 24840013 * AND DECIMAL 24880013 * R0= OP.CODE 24920013 * UR1=INPUT TEXT POINTER 24960013 SPACE 1 25000013 IL0014 IC HR1,TABLE3(R0) GET MACHINE OP.CODE FROM TABLE3 25040013 STC HR1,OPTEXT AND INSERT IN TEXT SKELETON 25080013 MVC OPTEXT+1(1),1(UR1) MOVE IN LENGTH BYTE FROM INPUT 25120013 * TEXT 25160013 IC HR1,2(0,UR1) GET B1 FIELD. SET B1 IN OPTEXT 25200013 SLL HR1,12 BUFFER AND CLEAR 12 BIT D1 FIELD 25240013 STH HR1,OPTEXT+2 25280013 SPACE 1 25320013 IC HR1,5(0,UR1) GET B2 FIELD. SET B2 IN OPTEXT 25360013 SLL HR1,12 BUFFER AND CLEAR 12 BIT D2 FIELD 25400013 STH HR1,OPTEXT+4 25440013 SPACE 1 25480013 LR UR0,UR1 SAVE TEXT POINTER TO SS CODE IN 25520013 IC R0,TABLE2(R0) REGISTER UR0. UPDATE UR1 TO POINT 25560013 AR UR1,R0 TO NEXT PSEUDO-CODE ITEM 25600013 SPACE 1 25640013 * EXAMINE PSEUDO CODE FOLLOWING SS INSTRUCTION 25680013 IL1415 CLI 0(UR1),OPOSM1 25720013 BC BE,IL1401 BRANCH IF OSM1 25760013 IL1413 CLI 0(UR1),OPOSM2 25800013 BC BE,IL1402 BRANCH IF OSM2 25840013 CLI 0(UR1),OPEOB 25880013 BC BE,IL1403 BRANCH IF END OF BLOCK 25920013 SPACE 1 25960013 * THE FOLLOWING SECTION CALLS THE OFFSET SUBROUTINE TO 26000013 * DETERMINE D1 AND D2 VALUES, ORS THESE INTO THE TEXT SKELETON, 26040013 * THEN CALLS GENTXT TO PLACE THE RESULT IN THE TEXT CARD 26080013 SPACE 1 26120013 IL1414 LA R2,CNZERO SET UP PARAMETERS IN R1,R2 FOR 26160013 LA R1,3(0,UR0) CALL TO OFFSET 26200013 IL1404 BC B,IL1405 OSM1 SWITCH IS SET TO NOP IF AN 26240013 SWOSM1 EQU IL1404+1 OSM1 HAS BEEN FOUND FOLLOWING THE 26280013 OI SWOSM1,X'F0' SS CODE. WS1400 CONTAINS THE OSM1 26320013 LA R2,WS1400 OPERAND. 26360013 IL1405 BAL RR,OFFSET CALL OFFSET 26400013 BAL RR,IL1406 A RETURN TO THIS POINT IMPLIES 26440013 * THAT AN RLD ENTRY IS REQUIRED 26480013 L HR1,OFFST0 NORMAL RETURN. OR LOW ORDER 12 26520013 N HR1,CN0102 BITS OF OFFSET INTO D1 FIELD OF 26560013 O HR1,OPTEXT OPTEXT BUFFER. 26600013 ST HR1,OPTEXT 26640013 SPACE 1 26680013 LA R2,CNZERO NOW DO SAME FOR D2. SET UP R1,R2 26720013 LA R1,6(0,UR0) PARAMETERS FOR OFFSET SUBROUTINE 26760013 IL1407 BC B,IL1408 OSM2 SWITCH IS SET TO NOP IF AN 26800013 SWOSM2 EQU IL1407+1 OSM2 HAS BEEN FOUND FOLLOWING THE 26840013 OI SWOSM2,X'F0' SS CODE. UR1 STILL ADDRESSES THE 26880013 LA R2,1(0,UR1) OSM2 ITEM. 26920013 IL1408 BAL RR,OFFSET CALL OFFSET 26960013 BAL RR,IL1409 A RETURN TO THIS POINT IMPLIES 27000013 * THAT AN RLD ENTRY IS REQUIRED 27040013 L HR1,OFFST0 NORMAL RETURN. OR LOW ORDER 12 27080013 N HR1,CN0102 BITS OF OFFSET INTO D2 FIELD OF 27120013 LH HR2,OPTEXT+4 OPTEXT BUFFER 27160013 OR HR2,HR1 27200013 STH HR2,OPTEXT+4 27240013 SPACE 1 27280013 LA R2,6 SET LENGTH PARAMETER TO 6 THEN 27320013 BC B,IL2610 GO TO CALL GENTXT 27360013 SPACE 2 27400013 * THE FOLLOWING SECTION OF CODE DEALS WITH RLD RETURNS 27440013 * FROM THE CALL TO OFFSET 27480013 IL1406 LA HR1,2 OPERAND 1 REQUIRES RLD (PSEUDO- 27520013 BC B,IL1410 REGISTER). OFFSET FROM START OF 27560013 * SS INSTRUCTION IS 2 27600013 SPACE 1 27640013 IL1409 LA HR1,4 OPERAND 2 REQUIRES RLD. OFFSET 27680013 * FROM START OF SS INSTRUCTION=4 27720013 IL1410 O HR1,RELOC0 RELOC0, RETURNED BY OFFSET 27760013 * CONTAINS ALL BUT OFFSET FROM START 27800013 * OF INSTRUCTION 27840013 TM SWRLD1,X'F0' TEST RLD1 SWITCH. IF ON, AN RLD 27880013 BC BZ,IL1411 ENTRY HAS ALREADY BEEN MADE. 27920013 ST HR1,RELOC2 PLACE ENTRY REQUEST IN SECOND 27960013 BCR B,RR SLOT AND RETURN 28000013 SPACE 1 28040013 IL1411 ST HR1,RELOC1 RLD1 SWITCH OFF. PLACE RLD 28080013 OI SWRLD1,X'F0' REQUEST IN FIRST SLOT, SET SWITCH 28120013 BCR B,RR ON AND RETURN 28160013 SPACE 2 28200013 * OSM1 FOUND FOLLOWING INSTRUCTION 28240013 IL1401 MVC WS1400(2),1(UR1) SAVE OSM1 OPERAND. SET OSM1 28280013 NI SWOSM1,X'0F' SWITCH TO NOP, UPDATE INPUT TEXT 28320013 IC R0,TABLE2+OPOSM1 POINTER 28360013 AR UR1,R0 AND SEE IF NEXT ITEM IS EOB OR 28400013 BC B,IL1413 OSM2. 28440013 SPACE 1 28480013 * OSM2 FOUND FOLLOWING INSTRUCTION 28520013 IL1402 NI SWOSM2,X'0F' SET OSM2 OPERAND SWITCH TO NOP 28560013 BC B,IL1414 THEN GO TO TEXT BUFFER CONSTRUCT 28600013 SPACE 1 28640013 * END-OF-BLOCK MARKER 28680013 IL1403 MVC WS1003(5),3(UR0) SAVE LAST FIVE BYTES OF SS 28720013 MVC WS103A(1),2(UR0) 28760013 LA UR0,WS1003-3 INSTRUCTION IN TEMPORARY AND SET 28800013 BAL RR,EOBRTN UR0 TO ADDRESS THIS AS IF IT WERE 28840013 BC B,IL1415 INPUT TEXT. GET NEXT TEXT BLOCK 28880013 * AND GO TO SEE WHAT THE FIRST PC IS 28920013 EJECT 28960013 * PLBS PSEUDO-CODE ITEM 29000013 * FUNCTIONS - (1) UPDATE PROCLC BY THE LENGTH OF CODE 29040013 * FROM PROCEDURE ORIGIN TO PROLOGUE BASE AND RESET LOCATION 29080013 * COUNTER REGISTER TO ZERO. 29120013 * (2) PAD, IF NECESSARY, WITH BALR 10,0 TO 29160013 * GET PROLOGUE BASE ON WORD BOUNDARY. 29200013 * (3) GENERATE, IF NECESSARY, ADDRESS CONSTS 29240013 * FOR THE PROLOGUE AND A BRANCH ROUND THEM. 29280013 * NOTES. ON ENTRY TO THIS SECTION REGISTER CONTENTS ARE- 29320013 * R0 OP.CODE 29360013 * UR1 INPUT TEXT POINTER 29400013 * UR2 LOCATION COUNTER 29440013 SPACE 1 29480013 IL0015 A UR2,PROCLC UPDATE PROCLC TO ADDRESS THE 29520013 ST UR2,PROCLC PLBS LOCATION, THEN RESET LOCN 29560013 SR UR2,UR2 COUNTER TO ZERO 29600013 SPACE 1 29640013 TM PROCLC+3,X'02' TEST TO SEE IF THE TOTAL LOCN 29680013 BC BZ,IL1503 COUNT IS ON AN ODD HALF WORD. 29720013 * BRANCH IF FULL WORD 29760013 LA R1,PLBALR ON ODD HALFWORD, INSERT THE 29800013 LA R2,2 INST. BALR BRNREG,0 TO BRING UP TO 29840013 BAL RR,GENTXT FULL WORD, THEN BEGIN AGAIN, THIS 29880013 BC B,IL0015 TIME BRANCHING AFTER PROCLC TEST 29920013 SPACE 1 29960013 IL1503 LH HR1,WSX2 GET X2 VALUE, MULTIPLY BY 4 30000013 SLL HR1,2 IF THE RESULT IS LESS THAN EIGHT 30040013 LA R2,4 RETURN TO SCAN 30080013 CR HR1,R2 30120013 BC BNH,IL0002 30160013 SPACE 1 30200013 IL15A STH HR1,PROLBC+2 SET UP BRANCH INSTRUCTION TO 30240013 LA R1,PROLBC BRANCH ROUND ADCONS 30280013 BAL RR,GENTXT 30320013 SPACE 1 30360013 * GENERATE ADDRESS CONSTANTS FOR PROLOGUE AND PROCEDURE 30400013 * CODE. THIS SECTION IS ENTERED FROM PLBS AND PCBS 30440013 IL1501 L HR1,PROCLC 30480013 A HR1,CN0101 ADD 4096 TO PROCLC 30520013 SPACE 1 30560013 IL1502 LA R2,4 30600013 LH HR2,PROLBC+2 COUNT DOWN IN FOURS AND RETURN 30640013 SR HR2,R2 TO SCAN WHEN COUNT FALLS TO ZERO 30680013 STH HR2,PROLBC+2 30720013 BC BNP,IL0002 30760013 SPACE 1 30800013 A HR1,CN0101 ADD 4096 TO ADDRESS AND SET UP 30840013 ST HR1,PROLAC ADDRESS CONSTANT TEXT 30880013 LA R1,PROLAC POINT R1 AT TEXT 30920013 MVC RELOC1(2),TXTESD SET UP RELOC1 TO PRODUCE AN RLD 30960013 MVI RELOC1+2,RLDLN4 ENTRY FOR ITEM OF LENGTH 4 31000013 OI SWRLD1,X'F0' SET RLD FLAG ON 31040013 BAL RR,GENTXT 31080013 L HR1,PROLAC 31120013 BC B,IL1502 GO TO PRODUCE NEXT ADCON 31160013 EJECT 31200013 * PCBS PSEUDO-CODE ITEM 31240013 * FUNCTIONS - (1) UPDATE PROCLC BY LENGTH OF CODE BETWEEN 31280013 * PROLOGUE AND PROCEDURE BASES AND RESET LOCATION COUNTER 31320013 * REGISTER TO ZERO. 31360013 * (2) PAD, IF NECESSARY, WITH NOPR TO GET 31400013 * PROCEDURE BASE ON WORD BOUNDARY 31440013 * (3) GENERATE, IF NECESSARY, ADDRESS CONSTS 31480013 * FOR THE PROCEDURE. 31520013 * NOTES. ON ENTRY TO THIS SECTION REGISTER CONTENTS ARE- 31560013 * R0 OP.CODE 31600013 * UR1 TEXT POINTER 31640013 * UR2 LOCATION COUNTER 31680013 SPACE 1 31720013 IL0016 A UR2,PROCLC UPDATE PROCLC TO ADDRESS THE 31760013 ST UR2,PROCLC PCBS LOCATION, THEN RESET LOCATION 31800013 SR UR2,UR2 COUNTER TO ZERO. 31840013 SPACE 1 31880013 TM PROCLC+3,X'02' TEST TO SEE IF TOTAL LOCN COUNT 31920013 BC BZ,IL1601 ON HALFWORD BOUNDARY. BRANCH IF NO 31960013 SPACE 1 32000013 LA R1,TXNOPR BRING UP TO FULL WORD BOUNDARY 32040013 LA R2,2 BY INSERTING NOPR, THEN BEGIN 32080013 BAL RR,GENTXT THIS TIME BRANCHING AFTER PROCLC 32120013 BC B,IL0016 TEST. 32160013 SPACE 1 32200013 IL1601 LH HR1,WSX3 GET X3 VALUE, MULTIPLY BY 4 32240013 SLL HR1,2 IF THE RESULT IS LESS THAN EIGHT 32280013 LA R2,4 RETURN TO SCAN 32320013 CR HR1,R2 32360013 BC BNH,IL0002 32400013 STH HR1,PROLBC+2 SET ADDRESS CONSTANT COUNTER 32440013 BC B,IL15A OTHERWISE GO TO SET UP ADDRESS 32480013 * CONSTANTS 32520013 EJECT 32560013 * EOP (END OF INPUT TEXT MARKER) 32600013 SPACE 1 32640013 IL0017 TM ZFLAG4,ZCMPSR 32680013 BC BO,INCLUD 32720013 TM ZFLAG4,X'01' 32730015 BC BO,INCLUD BRANCH FOR STATIC ROUTINE 32740015 SPACE 32760013 IL1117 BAL RR,RUNOUT PUNCH LAST TXT AND RLD CARDS 32800013 * CARDS. 32840013 MVC PAR1(4),WSTEXT MARK THE CURRENT TEXT BLOCK 32880013 MVI PAR2+3,UNWANT AS UNWANTED 32920013 L LR,ZALTOF 32960013 BALR RR,LR 33000013 SPACE 33040013 SR HR1,HR1 33080013 ST HR1,PAR1 33120013 MVC PAR1+1(1),EQUCUR MARK CURRENT LABEL BLOCK 33160013 MVI PAR2+3,X'03' WANTED 33200013 L LR,ZALTOF 33240013 BALR RR,LR 33280013 MVC ZMAXEQ(2),SVMXEQ RESTORE MAX NO OF LABELS 33320013 SPACE 33330015 L RR,ZEQTAB 33340015 MVC 528(256,RR),CODTAB SHIFT TABLE FOR UA 33350015 SPACE 1 33360013 LA HR1,CNRLS1 GET LIST OF BLOCKS TO BE 33400013 ST HR1,PAR1 RELEASED. 33440013 SR HR1,HR1 SET PAR2 = 0 33480013 ST HR1,PAR2 33520013 L LR,ZRLSOF CALL RELSCTL. NO RETURN SINCE 33560013 BALR RR,LR PHASE RELEASE ITSELF. 33600013 SPACE 2 33640013 * BEGIN PSEUDO-CODE 33680013 SPACE 1 33720013 IL0018 MVC PAR1+2(2),1(UR1) 33760013 MVC WSBLOK(2),PAR1+2 SET UP CURRENT BLOCK REF 33800013 L LR,ZRFAOF GET ADDRESS OF BEGIN ENTRY 33840013 BALR RR,LR TYPE 1 33880013 L R1,PAR1 33920013 SPACE 1 33960013 CLI BGNFLG(R1),SL TEST FLAG AND RETURN IF NO 34000013 BC BNE,IL0002 STATEMENT LABELS. 34040013 SPACE 1 34080013 MVC PAR1+2(2),ET1LBL(R1) 34120013 BC B,IL1905 GET REFERENCE TO LABEL, THEN GO 34160013 * AND TREAT AS CL/SL ITEM 34200013 SPACE 3 34240013 * BEGIN' 34280013 SPACE 1 34320013 IL0029 MVC WSBLOK(2),1(UR1) SET UP BLOCK REFERENCE THEN 34360013 BC B,IL0002 RETURN TO SCAN 34400013 EJECT 34440013 * COMPILER AND STATEMENT LABEL PSEUDO-CODE ITEMS 34480013 SPACE 1 34520013 * FUNCTIONS - (1) FOR COMPILER LABELS UPDATE THE MAXIMUM 34560013 * GENERATED LABEL NUMBER SLOT IN THE COMMUNICATIONS REGION BY 1 34600013 * AND USE THE RESULTING VALUE AS A LABEL NUMBER FOR THIS LABEL. 34640013 * THIS IS THE NUMBER WHICH APPEARS ON THE LISTING. 34680013 * (2) FOR ENTRY LABELS GENERATE TEXT 34720013 * COMPRISING THE NAME OF THE ENTRY (OBTAINED FROM THE ENTRY 34760013 * LABEL DICTIONARY ENTRY AND TRANSLATED TO EXTERNAL CODE), A 34800013 * ONE BYTE LENGTH COUNT AND A BRANCH ROUND THEM BASED ON 15 AS 34840013 * BRANCH REGISTER. 34880013 * (3) FOR SUBSCRIPTED LABEL ENTRIES, CHAIN TO 34920013 * STATEMENT OR COMPILER LABEL, THEN TREAT AS ABOVE. 34960013 * (4) ALL OTHER LABELS ARE IGNORED 35000013 * NOTES. ON ENTRY TO THIS SECTION REGISTER CONTENTS ARE- 35040013 * R0. OP.CODE 35080013 * UR1 TEXT POINTER 35120013 * UR2 LOCATION COUNTER 35160013 SPACE 2 35200013 IL0019 MVC PAR1+2(2),3(UR1) 35240013 IL1905 L LR,ZRFAOF GET DICTIONARY ENTRY OF LABEL 35280013 BALR RR,LR REFERRED TO IN TEXT 35320013 L R1,PAR1 35360013 BAL RR,SOSN GO TO UPDATE TABLE 35380001 SPACE 1 35400013 CLI 0(R1),SLCODE 35440013 BC BNE,*+14 35460015 MVC ZSTACH+2(2),8(R1) 35480015 BC B,IL0002 35500015 SPACE 1 35520013 CLI 0(R1),ELCODE 35560013 BC BE,IL1902 BRANCH IF ENTRY LABEL 35600013 SPACE 1 35640013 CLI 0(R1),CLCODE TEST ENTRY TYPE AND BRANCH IF 35680013 BC BNE,IL0002 NOT COMPILER LABEL TO SCAN. 35720013 SPACE 1 35760013 LH HR1,ZMAXEQ COMPILER LABEL. GIVE IT A LABEL 35800013 LA HR1,1(0,HR1) NUMBER. THE USE FIELD OF THE LABEL 35840013 STH HR1,ZMAXEQ ENTRY IS USED FOR THIS NUMBER. 35880013 MVC CSLUSE(2,R1),ZMAXEQ 35920013 BC B,IL0002 RETURN TO SCAN 35960013 SPACE 1 36000013 * OPERAND IS ENTRY LABEL. GENERATE TEXT CONSISTING OF A 36040013 * BRANCH AND THE BCD NAME OF THE LABEL. 36080013 IL1902 MVC WS1002+2(2),1(R1) GET LENGTH OF ENTRY AND SET HR2 36120013 L HR2,WS1002 TO ADDRESS BCD LENGTH BYTE 36160013 AR HR2,R1 36200013 SR HR1,HR1 36240013 ST HR1,SLOT 36260015 IC HR1,0(0,HR2) HR1 NOW CONTAINS BCD LENGTH-1 36280013 EX HR1,IL1903 MOVE NAME TO BUFFER 36320013 LA R2,7(0,HR1) 36360013 SRL R2,1 SET TOTAL LENGTH OF BRANCH PLUS 36400013 AR R2,R2 BCD IN R2 36440013 CLI 2(UR1),X'00' 36444015 BC BE,IL192A NO 36448015 SR R1,R1 36452015 IC R1,2(UR1) NO OF CONSTANTS 36456015 SLL R1,2 MULTIPLY BY 4 36460015 ST R1,SLOT 36462015 AR R2,R1 36464015 AR R2,UR2 36465015 A R2,PROCLC 36466015 LA R2,3(R2) ROUND TO 4 BYTE BOUNDARY 36468015 N R2,MASK4 36472015 SR R2,UR2 36473015 S R2,PROCLC 36474015 IL192A EQU * 36476015 STC R2,ENLBBC+3 STORE IN BRANCH INSTRUCTION 36480013 * SKELETON 36520013 S R2,SLOT 36540015 LA R1,ENLBBC SET R1 TO ADDRESS TEXT 36560013 * SKELETON 36600013 L LR,ZTRAN2 GET ADDRESS OF INTERNAL TO 36640013 EX HR1,IL1904 EXTERNAL TRANSLATE TABLE. PLACE 36680013 LA HR1,1(0,HR1) AN EXTERNAL BLANK AT END OF BCD 36720013 STC HR1,ENLBBC+4 AFTER TRANSLATION,TO ALLOW FOR 36760013 IC HR2,INBLNK(0,LR) PADDING OF EVEN NUMBER OF CHARS. 36800013 STC HR2,ENLBBC+5(HR1) 36840013 BAL RR,GENTXT GENERATE TEXT AND RETURN TO 36880013 BC B,IL0002 SCAN. 36920013 EJECT 36960013 * RX BRANCH, RS BRANCH AND LOAD ADDRESSES 37000013 * FUNCTIONS - (1) THE SUBJECT INSTRUCTION IS EXAMINED TO 37040013 * DETERMINE WHETHER ITS OPERAND IS A LABEL, AND IF SO WHETHER 37080013 * IT REQUIRES A SPECIAL ADDRESSING MECHANISM. IF NOT THE 37120013 * INSTRUCTION IS TREATED AS A NORMAL CASE OF THE APPROPRIATE 37160013 * INSTRUCTION CLASS. 37200013 * (2) DETERMINE FROM THE PROPERTIES OF THE 37240013 * LABEL AND THE LENGTH OF TEXT TO BE GENERATED (IN ADRLNG) THE 37280013 * MOST EFFICIENT CODE TO PERFORM THE REQUIRED FUNCTION. THE 37320013 * PROPERTIES CONSIDERED ARE- 37360013 * (A) OFFSET LESS THAN 4096. 37400013 * (B) OFFSET LESS THAN 8192. 37440013 * (C) STATIC ADDRESS CONSTANT WITH OFFSET UNDER 4092. 37480013 * (D) FORWARD REFERENCE WITHIN 4096. 37520013 * (3) GENERATE TEXT 37560013 * NOTES. ON ENTRY TO THIS SECTION REGISTER CONTENTS ARE- 37600013 * R0 =OP.CODE 37640013 * UR1=INPUT TEXT POINTER 37680013 * UR2=LOCATION COUNTER 37720013 SPACE 1 37760013 IL0020 TM ADRLNG,X'FF' 37800013 BC BZ,IL2002 BRANCH IF ADRLNG=0 IE IF THIS 37840013 * CODE WAS NOT PRECEDED BY AN ADR 37880013 CLC CNZERO(2),3(UR1) 37920013 BC BE,IL2001 BRANCH IF NO DICTIONARY REF. IN 37960013 * PSEUDO-CODE 38000013 TM 2(UR1),DREQFL TEST FOR DICT REF OR GENERATED 38040013 BC BNZ,IL2003 LABEL NUMBER AND BRANCH IF LATTER 38080013 SPACE 1 38120013 CLI ADRLNG,4 IF ADRLNG EXCEEDS 4 CONTINUE 38160013 BC BH,IL2005 PROCESSING IN THIS SECTION. IF 38200013 CLI 0(UR1),OPLA NOT, AND THE OPERATION IS A BRANCH 38240013 BC BNE,IL2001 GO AND TREAT IT AS ANY OTHER RX OR 38280013 TM 4(UR1),X'03' RS2. IF LOAD ADDRESS, THEN PROCESS 38320013 BC BNZ,IL2001 IN THIS SECTION ONLY IF DICTIONARY 38360013 * OFFSET IS ZERO. 38400013 SPACE 1 38440013 IL2005 NI SWEQU1,X'0F' SET EQU1 SWITCH OFF 38480013 LA R2,CNZERO 38520013 LA R1,3(0,UR1) 38560013 BAL RR,OFFSET GET OFFSET. RETURNS R1=DICT.ENT 38600013 BC B,IL2004 ERROR IF RLD ENTRY RETURN MADE 38640013 SPACE 1 38680013 IL2006 IC HR1,TABLE3(R0) ENTRY HERE FROM EQU CASE. GET 38720013 STC HR1,OPTEXT MACHINE OP.CODE FROM TABLE3. MOVE 38760013 MVC OPTEXT+1(1),1(UR1) IN REGISTER FIELD AND BASE. CLEAR 38800013 IC HR1,2(0,UR1) OFFSET FIELD 38840013 SLL HR1,12 38880013 STH HR1,OPTEXT+2 38920013 SPACE 1 38960013 * NOW TEST OFFSET RETURNED BY OFFSET SUBROUTINE OR FINEQ1 39000013 L HR1,OFFST0 39040013 C HR1,CN0101 BRANCH IF OFFSET LESS THAN 39080013 BC BL,IL2007 4096. 39120013 SPACE 1 39160013 NI SWNTRY,X'0F' SET ENTRY SWITCH OFF 39200013 TM SWEQU1,X'F0' 39240013 BC BNZ,IL2023 BRANCH IF COMPILER GENERATED 39280013 * LABEL NUMBER 39320013 CLI 0(R1),ET1COD DICT. ENTRY ADDRESS IS IN R1. 39360013 BC BE,IL2015 SEE IF ENTRY IS ET1 OR EN1 AND IF 39400013 CLI 0(R1),EN1COD SO BRANCH 39440013 BC BE,IL2015 39480013 SPACE 1 39520013 IL2023 CLI 0(UR1),OPLA LOAD ADDRESS INSTRUCTION 39560013 BC BE,IL2009 REQUIRES SPECIAL TREATMENT 39600013 SPACE 1 39640013 SR HR1,UR2 39680013 BC BNP,IL2011 IF NOT POSITIVE THIS IS BACKWARD 39720013 * REFERENCE 39760013 C HR1,CN0101 BRANCH IF FORWARD REFERENCE 39800013 BC BL,IL2010 WITHIN 4096 BYTES 39840013 SPACE 1 39880013 IL2011 BC NOP,IL2008 BRANCH IF COMPILER GENERATED 39920013 SWEQU1 EQU IL2011+1 LABEL NUMBER 39960013 SPACE 1 40000013 CLI 0(UR1),OPBXH 40040013 BC BE,IL2008 BRANCH IF THE INSTRUCTION IS 40080013 CLI 0(UR1),OPBXLE AN RS-TYPE INDEXING BRANCH. 40120013 BC BE,IL2008 40160013 SPACE 1 40200013 TM CSLOT1(R1),OT1SIO TEST FOR STATIC ADCON AND 40240013 BC BZ,IL2008 BRANCH IF NONE 40280013 SPACE 1 40320013 MVC OFFST0+1(3),CSLSIO(R1) PLACE STATIC ADCON OFFSET IN 40360013 MVI AUXTXT,X'58' OFFST0, SET 'LOAD' OP.CODE IN 40400013 IC HR1,ADRREG AUXTXT BUFFER. PLACE THE ADDRESS 40440013 SLL HR1,4 REGISTER IN THE R1 FIELD, THE 40480013 STC HR1,AUXTXT+1 STATIC DATA POINTER REGISTER IN 40520013 LA HR1,SDPREG THE BASE FIELD, THEN OR IN THE 40560013 SLL HR1,12 OFFSET 40600013 STH HR1,AUXTXT+2 40640013 L HR1,OFFST0 40680013 N HR1,CN0102 40720013 LA HR1,4(0,HR1) ADD 4 SO AS TO ADDRESS SECOND 40760013 * WORD OF LABEL ADCON 40800013 O HR1,AUXTXT 40840013 ST HR1,AUXTXT 40880013 LA R1,AUXTXT CALL GENTXT TO PLACE INSTRUCTION 40920013 LA R2,4 IN AUXTXT IN THE TEXT CARD. 40960013 BAL RR,GENTXT 41000013 SPACE 1 41040013 NI OPTEXT,X'3F' NOW CONVERT THE ORIGINAL RX 41080013 OC OPTEXT+1(1),ADRREG INSTRUCTION TO RR BY SETTING THE 41120013 LA R1,OPTEXT 2 HIGH-ORDER BITS TO ZERO. PLACE 41160013 LA R2,2 THE ADDRESS REGISTER IN THE R2 41200013 BAL RR,GENTXT FIELD AND GENERATE A 2 BYTE 41240013 CLI ADRLNG,8 INSTRUCTION. 41280013 BC B,IL2012 GO AND PAD WITH A NOPR IF ADRLNG 41320013 * WAS 8. 41360013 SPACE 1 41400013 IL2015 OI SWNTRY,X'F0' SET ENTRY SWITCH ON IF DICT 41440013 * ENTRY IS ET1 OR EN1 41480013 * THE FOLLOWING SECTION MAY BE ENTERED FOR BRANCH OR LOAD 41520013 * ADDRESS AND GENERATES LAST-DITCH CODE OCCUPYING 8 BYTES 41560013 SPACE 1 41600013 IL2008 L HR1,OFFST0 41640013 C HR1,CN0103 BRANCH IF OFFSET IS LESS 41680013 BC BL,IL2013 THAN 8192 41720013 SPACE 1 41760013 SRL HR1,12 FIND WHICH ADDRESS CONST TO USE 41800013 BCTR HR1,0 HR1=FLOOR(OFFSET/4096)-1 41840013 TM SWEQU1,X'F0' 41880013 BC BZ,IL2016 BRANCH IF NOT GEN LABEL NUMBER 41920013 SPACE 1 41960013 SPACE 1 42000013 IL2016 BC NOP,IL2014 42040013 SWNTRY EQU IL2016+1 BRANCH IF ENTRY POINT ET1 OR EN1 42080013 SPACE 1 42120013 IL2014 SLL HR1,2 MULT BY 4 SO THAT HR1 CONTAINS 42160013 * 4*FLOOR(OFFSET/4096)-8 (PROCEDURE) 42200013 * 4*FLOOR(OFFSET/4096)-4 (PROLOGUE) 42240013 * NOW SET UP A LOAD INSTRUCTION TO PICK UP THE ADDRESS 42280013 * CONSTANT WHOSE OFFSET HAS JUST BEEN EVALUATED. 42320013 STH HR1,AUXTXT+2 STORE OFFSET, PUT 'LOAD' OP.CODE 42360013 MVI AUXTXT,X'58' IN AUXTXT BUFFER AND THE ADDRESS 42400013 IC HR1,ADRREG REGISTER IN THE R1 FIELD. THE 42440013 SLL HR1,4 STANDARD BASE REGISTER IS USED AS 42480013 STC HR1,AUXTXT+1 BASE. 42520013 LA HR1,BRNREG 42560013 SLL HR1,12 42600013 O HR1,AUXTXT 42640013 ST HR1,AUXTXT 42680013 SPACE 1 42720013 LA R1,AUXTXT SET UP PARAMETER REGISTERS R1 42760013 LA R2,4 AND R2 AND CALL GENTXT TO PLACE 42800013 BAL RR,GENTXT INSTRUCTION AT AUXTXT IN TEXT CARD 42840013 SPACE 1 42880013 L HR1,OFFST0 42920013 N HR1,CN0102 SET LOW ORDER 12 BITS OF OFFSET 42960013 MVI ADRLNG,4 IN HR1. SET ADRLNG=4 TO PREVENT 43000013 BC B,IL2025 PADDING WITH NOPRS, THEN GO TO 43040013 * PLACE ADDRESSING REGISTER IN 43080013 * OPTEXT AND GENERATE TEXT 43120013 SPACE 1 43160013 * OFFSET LESS THAN 8192. GENERATE LOAD ADDRESS INSTEAD OF 43200013 * LOAD. 43240013 IL2013 IC HR1,ADRREG PLACE ADDRESSING REGISTER IN 43280013 SLL HR1,4 R1 FIELD OF SKELETON LOAD ADDRESS 43320013 STC HR1,LA4095+1 LA R1,4095(0,10), THEN CALL 43360013 LA R1,LA4095 GENTXT 43400013 LA R2,4 43440013 BAL RR,GENTXT 43480013 SPACE 1 43520013 L HR1,OFFST0 SET OFFSET-4095 IN HR1. SET 43560013 S HR1,CN0102 ADRLNG TO 4 TO PREVENT PADDING 43600013 MVI ADRLNG,4 WITH NOPRS, THEN GO TO PLACE 43640013 BC B,IL2025 ADDRESSING REGISTER IN B2 FIELD OF 43680013 * OPTEXT AND GENERATE TEXT 43720013 SPACE 1 43760013 * LOAD ADDRESS INSTRUCTION 43800013 IL2009 CLI ADRLNG,8 BRANCH IF ADRLNG=8 TO GENERATE 43840013 BC BE,IL2008 L,LAOR LA,LA. 43880013 SPACE 1 43920013 TM SWEQU1,X'F0' BRANCH IF OPERAND WAS COMPILER 43960013 BC BNZ,IL2020 GENERATED LABEL NUMBER 44000013 SPACE 1 44040013 TM CSLOT1(R1),OT1SIO LABEL CONST. (ET1,EN1 ELIMIN- 44080013 BC BZ,IL2020 ATED) TEST FOR STATIC ADCON AND 44120013 * BRANCH IF NONE 44160013 BC B,IL2020 IN FACT ALWAYS BRANCH BECAUSE 44200013 * OF ASSIGNMENT TO LABEL VARIABLE 44240013 * PROBLEM 44280013 SPACE 1 44320013 MVC OFFST0+1(3),CSLSIO(R1) SET OFFST0 EQUAL TO THE STATIC 44360013 MVI OPTEXT,X'58' ADCON OFFSET. PUT 'LOAD' IN OPTEXT 44400013 L HR1,OFFST0 AND PUT THE STATIC DATA POINTER 44440013 LA HR2,SDPREG IN THE B2 FIELD 44480013 LA HR1,4(0,HR1) ADD 4 TO OFFSET TO ADDRESS 44520013 * SECOND WORD OF ADCON 44560013 BC B,IL2026 44600013 SPACE 1 44640013 IL2025 IC HR2,ADRREG 44680013 IL2026 SLL HR2,12 PLACE REGISTER IN B2 FIELD OF 44720013 STH HR2,OPTEXT+2 OPTEXT, THEN GO TO GENERATE TEXT 44760013 BC B,IL2007 44800013 SPACE 1 44840013 * LOAD ADDRESS AND NO STATIC ADCON 44880013 IL2020 BC B,IL2010 BECAUSE ADRLNG LESS THAN 8 IT 44920013 * MUST BE POSSIBLE TO ADDRESS THE 44960013 * LABEL IN 6 BYTES. 45000013 SPACE 1 45040013 * FORWARD REFERENCE WITHIN 4096. MAY BE ENTERED FOR BRANCH 45080013 * OR LOAD ADDRESS 45120013 IL2010 IC HR1,ADRREG PLACE ADDRESSING REGISTER IN 45160013 SLL HR1,4 LINK FIELD OF BALR SKELETON 45200013 STC HR1,TXBALR+1 45240013 LA R1,TXBALR SET UP PARAMETERS IN R1,R2 AND 45280013 LA R2,2 GENERATE TEXT 45320013 BAL RR,GENTXT 45360013 SPACE 1 45400013 L HR1,OFFST0 45440013 SR HR1,UR2 SET OFFSET-LOCN IN HR1 45480013 IC HR2,ADRLNG 45520013 LA HR2,254(0,HR2) SUBTRACT 2 FROM ADRLNG TO ALLOW 45560013 STC HR2,ADRLNG FOR BALR WHEN PADDING WITH NOPRS, 45600013 BC B,IL2025 THEN GO TO PLACE ADDRESSING REG. 45640013 * IN B2 FIELD OF OPTEXT 45680013 SPACE 1 45720013 * INSTRUCTION CAN BE TREATED AS NORMAL RX OR RS 45760013 IL2001 MVI ADRLNG,0 SET ADRLNG TO ZERO 45800013 * ADRLNG ZERO 45840013 IL2002 CLI 0(UR1),OPBXH 45880013 BC BE,IL0026 GO TO RS ROUTINE IF BXH OR BXLE 45920013 CLI 0(UR1),OPBXLE OTHERWISE GO TO RX ROUTINE 45960013 BC BE,IL0026 46000013 BC B,IL0013 46040013 SPACE 1 46080013 * OPERAND IS COMPILER LABEL NUMBER 46120013 IL2003 MVC WS1002+2(2),3(UR1) 46160013 L UR0,WS1002 SET UP PARAMETER AND CALL FINEQ1 46200013 BAL RR,FINEQ1 46240013 L HR1,0(0,UR0) ON RETURN UR0 ADDRESSES EQU1 46280013 ST HR1,OFFST0 SLOT. PLACE OFFSET VALUE IN OFFST0 46320013 MVI OFFST0,0 CLEAR HIGH ORDER BYTE OF OFFST0 46360013 OI SWEQU1,X'F0' AND SET EQU1 SWITCH THEN RETURN TO 46400013 BC B,IL2006 MAIN LINE 46440013 SPACE 1 46480013 * THE FOLLOWING SECTION GENERATES TEXT FOR THE ORIGINAL 46520013 * INSTRUCTION AFTER ANY MODIFICATIONS FOR ADDRESSING HAVE BEEN 46560013 * MADE, AND PADS WITH NOPR INSTRUCTIONS TO FILL OUT THE TEXT 46600013 * LENGTH SPECIFIED IN THE ADR PRECEDING. 46640013 IL2007 O HR1,OPTEXT OR OFFSET INTO OPTEXT AND 46680013 ST HR1,OPTEXT GENERATE TEXT 46720013 LA R1,OPTEXT 46760013 LA R2,4 46800013 BAL RR,GENTXT GENERATE TEXT FOLLOWED BY 0,1 OR 46840013 CLI ADRLNG,6 2 NOPRS ACCORDING AS ADRLNG=4,6,8 46880013 IL2012 BC BL,IL2021 ENTRY FROM BRANCH WITH STAT. 46920013 BC BE,IL2022 ADCON REQUIRES ONE NOPR IF ADRLNG 46960013 LA R1,TXNOPR =8. 47000013 LA R2,2 47040013 BAL RR,GENTXT GENERATE NOPR 0700 47080013 IL2022 LA R1,TXNOPR 47120013 LA R2,2 47160013 BAL RR,GENTXT GENERATE NOPR 47200013 IL2021 MVI ADRLNG,0 SET ADRLNG=0 AND RETURN TO 47240013 BC B,IL0002 SCAN LOOP. 47280013 SPACE 2 47320013 * THE FOLLOWING SECTION PRODUCES AN ERROR MESSAGE FOR 47360013 * AN ERRONEOUS RLD RETURN FROM OFFSET SUBROUTINE 47400013 IL2004 L HR1,ERID03 MAKE SERIOUS ERROR ENTRY 47440013 ST HR1,PAR6 47480013 L LR,ZUEROF 47520013 BALR RR,LR 47560013 SR HR1,HR1 SET OFFSET TO 0 AND CONTINUE 47600013 ST HR1,OFFST0 PROCESSING AS IF THIS WERE THE 47640013 BC B,IL2006 TRUE OFFSET 47680013 EJECT 47720013 * ADR PSEUDO-CODE ITEM 47760013 * ON ENTRY UR1 CONTAINS INPUT.TEXT POINTER 47800013 SPACE 1 47840013 IL0021 MVC ADRREG(1),1(UR1) SAVE REGISTER AND LENGTH 47880013 MVC ADRLNG(1),2(UR1) INDICATORS, THEN RETURN TO SCAN 47920013 BC B,IL0002 47960013 SPACE 3 48000013 * EOB (END OF TEXT BLOCK) 48040013 SPACE 1 48080013 IL0022 BAL RR,EOBRTN GO TO END OF BLOCK SUBROUTINE 48120013 * WHICH UPDATES UR1 TO POINT TO NEW 48160013 BC B,IL0003 AND ENTER SCAN LOOP 48240013 SPACE 2 48280013 * INVALID PSEUDO-CODE ITEM 48320013 * THIS SECTION IS ENTERED WHENEVER THE OP.CODE OF THE 48360013 * CURRENT PSEUDO-CODE ITEM IS UNRECOGNIZABLE. 48400013 SPACE 1 48440013 IL0023 L HR1,ERID01 GET ERROR WORD, THEN FALL 48480013 * THROUGH INTO TERMINATION SECTION 48520013 SPACE 1 48560013 TTABRT ST HR1,PAR6 HR1 CONTAINS ERROR CODE WORD 48600013 L LR,ZUEROF MAKE ERROR ENTRY 48640013 BALR RR,LR 48680013 L LR,ZABTOF ABORT COMPILATION. 48720013 BALR RR,LR 48760013 SPACE 2 48765015 * STATEMENT NUMBER 48770015 * THIS SECTION IS ENTERED WHWNEVER THE 48775015 * STATEMENT NUMBER PSEUDO-CODE ITEM IS FOUND 48780015 SPACE 48785015 IL0030 MVC ZSTACH+2(2),3(UR1) 48790015 * GO TO UPDATE STACK WITH SN AND OFFSET 48792001 BAL RR,SOSN 48794001 BC B,IL0002 48796001 EJECT 48800013 * CONSTANT PSEUDO-CODE 48840013 * THIS SECTION IS ENTERED FOR ITEMS ALGN, DCA4 48880013 * AND DCF. TEXT IS PADDED WITH NOPR TO A FULL WORD BOUNDARY 48920013 * AND THE ADCON OR LITTERAL INSERTED TO OCCUPY A FULL WORD 48960013 SPACE 1 49000013 IL0025 LR HR1,UR2 TEST LOCATION COUNTER AND 49040013 N HR1,CN0003 BRANCH IF ON FULL WORD BOUNDARY 49080013 BC BZ,IL2501 49120013 SPACE 1 49160013 LA R1,TXNOPR IF NOT FULL WORD INSERT A NOPR 49200013 LA R2,2 INSTRUCTION AS PADDING 49240013 BAL RR,GENTXT 49280013 SPACE 1 49320013 IL2501 CLI 0(UR1),OPALGN IF OPERATION IS ALIGN IT IS NOW 49360013 BC BE,IL0002 COMPLETE. RETURN TO SCAN 49400013 SPACE 1 49440013 LA R1,1(0,UR1) OTHERWISE POINT R1 AT OPERAND OF 49480013 CLI 0(UR1),OPDCA4 PSEUDO-CODE, THEN TEST PSEUDO-OP 49520013 BC BNE,IL2502 AND BRANCH IF DCF 49560013 SPACE 1 49600013 LA R2,CNZERO DCA4. POINT R2 AT 0, THEN GO TO 49640013 BAL RR,OFFSET EVALUATE OFFSET. OPERANDS OF DCA4 49680013 BC B,IL2503 SHOULD BE SUCH THAT AN RLD ENTRY 49720013 * IS ALWAYS REQUIRED 49760013 L HR1,ERID02 IF RETURN INDICATES NO RLD 49800013 ST HR1,PAR6 ENTRY, THEN MAKE AN ERROR ENTRY 49840013 L LR,ZUEROF IN THE DICTIONARY AND SET TEXT 49880013 BALR RR,LR FIELD TO ZERO 49920013 LA R1,CNZERO 49960013 BC B,IL2502 GO TO GENERATE TEXT 50000013 SPACE 1 50040013 IL2503 MVC RELOC1(4),RELOC0 SET FIRST RELOCATION REQUEST 50080013 OI SWRLD1,X'F0' SLOT, AND SET RLD SWITCH. POINT 50120013 LA R1,OFFST0 R1 AT THE OFFSET VALUE TO BE 50160013 * PLACED IN THE TEXT 50200013 SPACE 1 50240013 IL2502 LA R2,4 SET TEXT LENGTH=4 AND GENERATE 50280013 BAL RR,GENTXT TEXT. 50320013 BC B,IL0002 RETURN TO SCAN 50360013 EJECT 50400013 * RS1 MACHINE INSTRUCTION 50440013 * RS1 IS THE SUB-CLASS OF RS INSTRUCTIONS COMPRISING ALL 50480013 * SHIFT INSTRUCTIONS 50520013 * R0 =OP.CODE 50560013 * UR1=INPUT TEXT POINTER 50600013 * SPACE 1 50640013 IL0027 IC HR1,TABLE3(R0) USE PSEUDO-OP CODE TO LOOK UP 50680013 STC HR1,OPTEXT TRUE MACHINE OP.CODE IN TABLE3 50720013 MVC OPTEXT+1(3),1(UR1) COPY 3 OPERAND FIELD CHARACTERS 50760013 LA R2,4 INTO TEXT SKELETON. SET LENGTH=4 50800013 BC B,IL1201 AND GO TO GENERATE TEXT. 50840013 EJECT 50880013 * GENTXT SUBROUTINE 50920013 * THIS SUBROUTINE GENERATES LOADER TXT AND RLD CARD 50960013 * IMAGES. INPUT TO THE SUBROUTINE IS IN THE FORM OF A POINTER 51000013 * TO,AND LENGTH OF, A STRING OF CHARACTERS TO BE PLACED IN THE 51040013 * TXT CARD AND A SWITCH SETTING TO INDICATE RLD INPUT. 51080013 * INPUT. R1= ADDRESS OF TEXT 51120013 * R2= LENGTH OF TEXT 51160013 * SWRLD1 IS ON IF THERE IS AN RLD ENTRY TO BE MADE 51200013 * UP TO 2 RLD ENTRIES ARE PERMITTED FOR EACH CALL. THE CELLS 51240013 * RELOC1 AND RELOC2 CONTAIN- 51280013 * R 2 BYTE ESID NUMBER OF RELOCATION SECTION DEFN. 51320013 * F 1 BYTE RLD FLAG BYTE WITH T=0 51360013 * OFFSET 1 BYTE OFFSET OF RLD FIELD FROM CURRENT LOCN. 51400013 * COUNTER VALUE 51440013 * OUTPUT. THE ROUTINE HANDLES OUTPUT OF CARDS VIA ZUSP AND ZULF 51480013 * SWRLD1 IS SET OFF 51520013 * R1,R2 VALUES ARE NOT PRESERVED 51560013 * R0,UR1,UR2 ARE UNCHANGED 51600013 * LINKAGE.RR CONTAINS RETURN ADDRESS. 51640013 SPACE 2 51680013 GENTXT LA HR1,CRDLNG GET LENGTH OF VARIABLE FIELD OF 51720013 * A CARD 51760013 LH HR2,TXTLNG CURRENT TEXT LENGTH TO HR2 51800013 SR HR1,HR2 51840013 CR HR1,R2 COMPARE REMAINDER WITH INPUT AND 51880013 BC BL,IL0101 BRANCH IF NOT ENOUGH ROOM LEFT 51920013 SPACE 1 51960013 * ROOM IN CARD FOR TEXT.TEST FOR BEGINNING OF CARD 52000013 LTR HR2,HR2 52040013 BC BP,IL0102 BRANCH IF CARD NOT EMPTY 52080013 SPACE 1 52120013 * CARD EMPTY. PLACE LOCATION VALUE IN ADDRESS FIELD 52160013 L HR1,PROCLC 52200013 AR HR1,UR2 HR1=OFFSET FROM CONTROL SECT.ORG 52240013 ST HR1,TXTADR PLACE ADDRESS IN ADDRESS FIELD 52280013 MVI TXTADR,BLANK AND CLEAR HIGH ORDER COLUMN 52320013 SPACE 1 52360013 * MOVE TEXT INTO CARD BUFFER 52400013 IL0102 LA HR1,TXTVFD(HR2) HR1 NOW ADDRESSES NEXT BYTE IN 52440013 AR HR2,R2 CARD BUFFER. ADD NEW TEXT LENGTH 52480013 STH HR2,TXTLNG TO CURRENT AND STORE RESULT IN 52520013 * TEXT LENGTH FIELD 52560013 BCT R2,*+4 SUBTRACT 1 FROM COUNT OF BYTES 52600013 EX R2,IL0104 MOVE TEXT TO BUFFER 52640013 IL0110 BC NOP,IL0105 BRANCH IF RLD1 SWITCH IS ON 52680013 SWRLD1 EQU IL0110+1 52720013 IL0114 LA UR2,1(R2,UR2) INCREMENT LOCATION COUNTER BY 52760013 BCR B,RR LENGTH OF TEXT AND RETURN 52800013 EJECT 52840013 * THIS SECTION OF CODE COPES WITH THE CASE OF INSUFFICIENT 52880013 * ROOM IN THE TEXT BUFFER. R1,R2 ARE AS ON ENTRY, HR1=NUMBER OF 52920013 * BYTES LEFT IN BUFFER, HR2=TEXT LENGTH IN BUFFER. 52960013 SPACE 1 53000013 IL0101 ST RR,WSRR01 SAVE RETURN ADDRESS 53040013 ST UR0,WSUR01 SAVE UR0 53080013 LTR UR0,HR1 53120013 BCT UR0,*+4 UR0 NOW CONTAINS NUMBER OF BYTES 53160013 BC BZ,IL0107 LEFT-1. BRANCH IF NUMBER LEFT=0 53200013 SPACE 1 53240013 * MOVE IN TEXT TO FILL REST OF TEXT CARD 53280013 LA HR1,TXTVFD(HR2) SET ADDRESS OF NEXT BUFFER BYTE 53320013 * IN HR1 53360013 EX UR0,IL0104 MOVE TEXT 53400013 MVC TXTLNG(2),CRDVFD PLACE VARIABLE FIELD LENGTH IN 53440013 * TEXT LENGTH FIELD OF BUFFER 53480013 LA R1,1(UR0,R1) UPDATE INPUT TEXT POINTER TO 53520013 * ALLOW FOR TEXT JUST MOVED 53560013 * START A NEW CARD 53600013 IL0107 BAL RR,PUNCHT PUNCH COMPLETED TEXT CARD AND 53640013 * RESET TXTLNG TO ZERO 53680013 L HR1,TXTADR INSERT LOCN COUNTER VALUE 53720013 AH HR1,CRDVFD NOTE THAT THIS ASSUMES HR1 +VE. 53760013 ST HR1,TXTADR I.E.'BLANK' DOES NOT EXCEED 7F 53800013 MVI TXTADR,BLANK BLANK IN COL.5 53840013 LR HR2,R2 SET NUMBER OF TEXT BYTES STILL 53880013 SR HR2,UR0 TO BE MOVED IN HR2 53920013 BCT HR2,*+4 53960013 STH HR2,TXTLNG SET TEXT LENGTH= NUMBER OF BYTES 54000013 * LEFT 54040013 BCT HR2,*+4 SUBTRACT 1 FROM NUMBER STILL TO 54080013 LA HR1,TXTVFD BE MOVED, GET ADDRESS OF START OF 54120013 EX HR2,IL0104 VARIABLE FIELD, THEN MOVE TEXT 54160013 BCT R2,*+4 SUBTRACT 1 FROM NUMBER MOVED 54200013 L UR0,WSUR01 RESTORE REGISTERS 54240013 L RR,WSRR01 54280013 BC B,IL0110 RETURN TO MAIN SECTION OF THE 54320013 * ROUTINE 54360013 EJECT 54400013 * THIS SECTION OF CODE DEALS WITH RLD ENTRIES INDICATED 54440013 * BY THE SETTING OF THE RLD1 SWITCH. 54480013 * REGISTER R2 IS SAME AS ON ENTRY-1 54520013 SPACE 1 54560013 IL0105 LA HR1,CRDLNG ENTRY FROM RLD1 SWITCH TEST IN 54600013 LH HR2,RLDLNG MAIN SECTION. GET VARIABLE FIELD 54640013 SR HR1,HR2 LENGTH AND CURRENT LENGTH 54680013 BC BZ,IL0111 BRANCH IF RLD CARD FULL 54720013 SPACE 1 54760013 CLC RELOC1(2),WSRELR COMPARE ESID OF NEW ENTRY WITH 54800013 * PREVIOUS ENTRY 54840013 BC BNE,IL0112 BRANCH IF NOT EQUAL 54880013 SPACE 1 54920013 * ESIDS OF LATEST AND NEW RLD ENTRIES ARE SAME, SO ONLY 54960013 * FOUR BYTE ENTRY REQUIRED (POSITION ESID IS ALWAYS 01) 55000013 LA HR1,RLDVFD-4(HR2) GET ADDRESS OF FLAG BYTE OF 55040013 OI 0(HR1),RLDTFG PREVIOUS RLD ENTRY AND SET T FLAG 55080013 BC B,IL0113 ON 55120013 SPACE 1 55160013 * ESIDS OF LATEST AND NEW RLD ENTRIES DIFFER. AN EIGHT 55200013 * BYTE RLD ENTRY WILL BE REQUIRED 55240013 IL0112 CH HR1,CN0100 COMPARE REMAINING LENGTH WITH 4 55280013 BC BNH,IL0111 IF NOT GREATER A NEW CARD WILL BE 55320013 * REQUIRED. 55360013 LA HR1,RLDVFD(HR2) OTHERWISE THERE IS ROOM IN THE 55400013 MVC 0(2,HR1),RELOC1 CURRENT BUFFER. GET ADDRESS OF 55440013 MVC 2(2,HR1),TXTESD NEXT BYTE AND SET UP R AND P 55480013 LA HR2,4(0,HR2) ADD 4 TO RLD LENGTH 55520013 MVC WSRELR(2),RELOC1 COPY NEW ESID INTO PREVIOUS 55560013 * ENTRY SLOT. 55600013 SPACE 1 55640013 * SET UP FLAG AND OFFSET FIELDS OF RLD ENTRY 55680013 IL0113 LA HR2,4(0,HR2) ADD 4 TO RLD LENGTH 55720013 STH HR2,RLDLNG 55760013 IC HR2,RELOC1+3 GET OFFSET FROM CURRENT LOCN. 55800013 A HR2,PROCLC COUNTER AND EVALUATE OFFSET FROM 55840013 AR HR2,UR2 CONTROL SECTION ORIGIN. STORE 55880013 ST HR2,4(0,HR1) RESULT IN ENTRY OFFSET FIELD 55920013 MVC 4(1,HR1),RELOC1+2 PUT FLAG BYTE IN ENTRY 55960013 MVC RELOC1(8),RELOC2 MOVE RELOC2 INTO RELOC1 AND 56000013 * CLEAR RELOC2 56040013 CLC RELOC1(2),CNZERO 56080013 BC BNE,IL0105 GO THROUGH WHOLE PROCESS AGAIN 56120013 * IF RELOC2 WAS NOT EMPTY, OTHERWISE 56160013 NI SWRLD1,X'0F' SET RLD1 OFF AND RETURN TO MAIN 56200013 BC B,IL0114 SECTION OF ROUTINE 56240013 SPACE 1 56280013 * THIS SECTION IS ENTERED WHEN THERE IS NOT ENOUGH ROOM 56320013 * IN THE CURRENT BUFFER FOR THE RLD ENTRY. 56360013 IL0111 TM SWRLD2,X'F0' TEST RLD2 SWITCH AND BRANCH IF 56400013 BC BZ,IL0116 OFF IE RLDALT IS EMPTY 56440013 SPACE 1 56480013 ST RR,WSRR01 RLD ALT. IS FULL. PUNCH OUT TEXT 56520013 BAL RR,PUNCHT AND RLD ALT AND RETURN 56560013 L RR,WSRR01 56600013 SPACE 1 56640013 IL0116 MVC RLDALT(80),RLDCRD MOVE CURRENT RLD TO RLDALT 56680013 MVI RLDVFD,BLANK CLEAR VARIABLE FIELD 56720013 MVC RLDVFD+1(55),RLDVFD 55=CRDLNG-1 56760013 SR HR1,HR1 56800013 STH HR1,WSRELR SET PREVIOUS R ESID=0 56840013 STH HR1,RLDLNG SET RLD LENGTH FIELD TO 0 56880013 OI SWRLD2,X'F0' SET RLD2 SWITCH ON - RLDALT FULL 56920013 BC B,IL0105 RETURN TO BEGINNING OF RLD 56960013 * SECTION TO PLACE RLD ENTRIES IN 57000013 * BUFFER JUST CLEARED. 57040013 EJECT 57080013 * PUNCHT SUBROUTINE 57120013 * RUNOUT SUBROUTINE 57160013 * THIS SUBROUTINE PROVIDES AN INTERFACE BETWEEN THE PHASE 57200013 * AND COMPILER CONTROL. IT PUTS THE TEXT BUFFER CONTENTS OUT ON 57240013 * THE PUNCH FILE AND LOAD FILE AS REQUIRED. IT HAS NO INPUT 57280013 * PARAMETERS, THE TEXT BUFFER LOCATION BEING FIXED 57320013 SPACE 1 57360013 RUNOUT OI SWRUNO,X'F0' SET RUNOUT SWITCH ON 57400013 SPACE 1 57440013 PUNCHT ST RR,WSRR02 SECOND LEVEL SAVE OF LINK REG. 57480013 LH HR1,TXTLNG 57520013 CH HR1,CRDVFD COMPARE WITH FIELD LENGTH. BRA 57560013 BC BE,IL0202 IF TEXT CARD FULL 57600013 SPACE 57640013 CH HR1,CNZERO 57680013 BC BE,IL0201 BRANCH IF TEXT CARD EMPTY (AS 57720013 * WILL NORMALLY BE THE CASE FOR 57760013 * RUNOUT) 57800013 LA HR2,TXTVFD(HR1) ADDRESS OF NEXT BYTE IN CARD 57840013 MVI 0(HR2),BLANK PUT BLANK THERE 57880013 LCR HR1,HR1 57920013 LA HR1,CRDLNG-2(0,HR1) NUMBER OF BYTES LEFT-1 57960013 EX HR1,IL0203 58000013 SPACE 1 58040013 * CALL CARD ROUTINE TO PLACE TEXT CARD ON OUTPUT FILES 58080013 IL0202 LA HR1,TXTCRD 58120013 BAL RR,CARDOU 58160013 SR HR1,HR1 RESET TEXT LENGTH FIELD TO ZERO 58200013 STH HR1,TXTLNG 58240013 SPACE 1 58280013 * TEST FOR RLD CARD FULL 58320013 IL0201 BC NOP,IL0204 BRANCH IF RLD2 SWITCH ON IE 58360013 SWRLD2 EQU IL0201+1 RLDALT FULL. 58400013 * TEST FOR RUNOUT 58440013 IL0205 BC NOP,IL0206 BRANCH IF RUNOUT SWITCH ON 58480013 SWRUNO EQU IL0205+1 58520013 SPACE 1 58560013 IL0207 L RR,WSRR02 RESTORE LINK AND RETURN 58600013 BCR B,RR 58640013 SPACE 1 58680013 * ENTER HERE,IF RLD2 SWITCH ON, TO PUNCH RLD CARD 58720013 IL0204 LA HR1,RLDALT 58760013 BAL RR,CARDOU PUNCH RLD CARD AND SET RLD2 58800013 NI SWRLD2,X'0F' SWITCH OFF. 58840013 BC B,IL0205 58880013 SPACE 1 58920013 * ENTER HERE FOR RUNOUT 58960013 IL0206 CLC RLDLNG(2),CNZERO 59000013 BC BE,IL0207 DO NOTHING IF THE CURRENT RLD 59040013 * CARD IS EMPTY. 59080013 LA HR1,RLDCRD OTHERWISE PUNCH THE CARD AND 59120013 BAL RR,CARDOU RETURN 59160013 BC B,IL0207 59200013 EJECT 59240013 * CARDOU SUBROUTINE 59280013 * THIS SUBROUTINE CONTAINS SWITCHES SET DURING INITIALIZN. 59320013 * WHICH DETERMINE WHETHER THE CARD IMAGE WHOSE ADDRESS IS 59360013 * CONTAINED IN HR1 IS TO BE PLACED ON THE PUNCH OR LOAD FILE. IT 59400013 * CALLS ZUSP AND ZULF AS NECESSARY. 59440013 SPACE 1 59480013 CARDOU ST RR,WSRR03 SAVE RETURN REGISTER 59520013 IL0401 BC NOP,IL0402 LDFL SWITCH=NOP LOAD FILE REQD 59560013 SWLDFL EQU IL0401+1 =B NO LOAD FILE 59600013 ST HR1,PAR1 HR1 ADDRESSES CARD IMAGE 59640013 L LR,ZULFOF 59680013 BALR RR,LR 59720013 SPACE 1 59760013 IL0402 BC NOP,IL0403 SWPC SWITCH=NOP DECK REQUIRED 59800013 SWPCFL EQU IL0402+1 =B NO DECK 59840013 ST HR1,PAR1 ASSUMES HR1 UNCHANGED BY ZULP 59880013 L LR,ZUSPOF 59920013 BALR RR,LR 59960013 SPACE 1 60000013 IL0403 L RR,WSRR03 RESTORE RR AND RETURN 60040013 BCR B,RR 60080013 EJECT 60120013 * FINEQ1 SUBROUTINE 60160013 * THIS SUBROUTINE LOCATES THE ENTRY IN THE EQU1 TABLE 60200013 * FOR A GIVEN GENERATED LABEL NUMBER 60240013 * INPUT. UR0 CONTAINS LABEL NUMBER 60280013 * OUTPUT. UR0 CONTAINS ENTRY ADDRESS 60320013 * LINKAGE. RR CONTAINS RETURN ADDRESS 60360013 SPACE 1 60400013 FINEQ1 LR HR1,UR0 HR1 = N 60440013 BCTR HR1,0 HR1 = N-1 60480013 SR HR0,HR0 60520013 D HR0,CN0000 HR0 = 1/4 OFFSET IN TXT BLK 60560013 * HR1 = INDEX TO SYMBOLIC NAME 60600013 L HR2,ZEQTAB 60640013 AR HR1,HR2 60680013 CLC 0(1,HR1),EQUCUR TEST IF REQUESTED TEXT BLOCK 60720013 * IS THE SAME AS THE PREVIOUS ONE 60760013 BC BE,FINEQ2 60800013 ST RR,SAVERR SAVE RETURN REGISTER 60840013 SR HR2,HR2 60880013 ST HR2,PAR1 60920013 MVC PAR1+1(1),EQUCUR MARK CURRENT BLOCK WANTED 60960013 MVI PAR2+3,X'03' 61000013 L LR,ZALTOF 61040013 BALR RR,LR 61080013 ST HR2,PAR1 61120013 MVC PAR1+1(1),0(HR1) GET TEXT BLOCK FOR NEW NO. 61160013 MVC EQUCUR(1),0(HR1) 61200013 L LR,ZTABOF 61240013 BALR RR,LR 61280013 MVC EQUTXT+1(3),PAR1+1 61320013 L RR,SAVERR 61360013 FINEQ2 L UR0,EQUTXT 61400013 AR HR0,HR0 61440013 AR HR0,HR0 61480013 AR UR0,HR0 UR0 HAS ADDRESS OF SLOT 61520013 TM 0(UR0),OT1ASG TEST FOR LABEL HAVING AN OFFSET 61560013 BCR BNZ,RR ASSIGNED AND RETURN IF IT HAS. 61600013 SPACE 1 61640013 L HR1,ERID08 IF NOT ASSIGNED, LABEL IS 61680013 BC B,TTABRT UNDEFINED. ABORT WITH ERROR 61720013 * MESSAGE. 61760013 SPACE 3 61800013 * EOBRTN SUBROUTINE 61840013 * THIS SUBROUTINE ACCESSES THE NEXT TEXT BLOCK AND SETS 61880013 * UR1, THE INPUT TEXT POINTER, TO ADDRESS IT. 61920013 SPACE 1 61960013 EOBRTN ST RR,WSRR01 SAVE RETURN REGISTER 62000013 L HR1,WSTEXT GET REFERENCE TO CURRENT TEXT 62040013 ST HR1,PAR1 BLOCK, SET UNWANTED FLAG IN LOW 62080013 MVI PAR2+3,UNWANT ORDER BYTE OF PARAM 2, AND CALL 62120013 L LR,ZCHNOF ZCHAIN 62160013 BALR RR,LR 62200013 L UR1,PAR2 LOAD INPUT TEXT POINTER AND 62240013 L HR1,PAR1 SAVE REFERENCE TO NEW BLOCK 62280013 ST HR1,WSTEXT 62320013 L RR,WSRR01 RESTORE RETURN REGISTER AND 62360013 BCR B,RR RETURN 62400013 EJECT 62440013 * INCLUD SUBROUTINE 62460015 * 62480015 * THIS SUBROUTINE GENERATES LOADER TEXT 62500015 * FOR THE FOLLOWING COMPILER SUBROUTINES IF 62520015 * THEY ARE REQUIRED 62540015 * 62560015 * 1/ DYNAMIC PROLOGUE SUBROUTINE 62580015 * 2/ EPILOGUE SUBROUTINE 62600015 * 3/ STATIC PROLOGUE SUBROUTINE 62620015 SPACE 62680013 INCLUD LH R1,ZESDID SET UP RLD BUFFERS FOR PSEUDO 62720013 STH R1,RELLWF REGISTERS 62760013 LA R1,1(R1) 62800013 STH R1,RELSLA 62840013 LA R1,1(R1) 62850015 STH R1,RELLW0 62860015 SPACE 62880013 L UR2,PROGL SET LOCATION COUNTER 62920013 ST UR2,PROCLC 63040013 LA UR2,0 63080013 SPACE 63120013 TM ZFLAG4,ZCMPSR BRANCH IF DYNAMOC ROUTINE 63130015 BC BZ,INCLD1 NOT REQUIRED 63140015 SPACE 63150015 LA R1,D10 PUT OUT THE DYNAMIC ROUTINE 63160015 LA R2,D33-D10 63170015 OI SWRLD1,X'F0' 63180015 MVC RELOC1(4),RELLWF 63190015 BAL RR,GENTXT 63200015 SPACE 63201015 LA R1,D33 63202015 LA R2,D60-D33 63203015 OI SWRLD1,X'F0' 63204015 MVC RELOC1(4),RELINV 63205015 BAL RR,GENTXT 63206015 SPACE 63210015 LA R1,D60 63220015 LA R2,D70-D60 63230015 OI SWRLD1,X'F0' 63240015 MVC RELOC1(4),RELSLA 63250015 BAL RR,GENTXT 63260015 SPACE 63270015 LA R1,D70 63280015 LA R2,D180-D70 63290015 OI SWRLD1,X'F0' 63300015 MVC RELOC1(4),RELSLA 63310015 BAL RR,GENTXT 63320015 SPACE 63330015 LA R1,D180 63340015 LA R2,D200-D180 63350015 OI SWRLD1,X'F0' 63360015 MVC RELOC1(4),RELINV 63370015 BAL RR,GENTXT 63380015 SPACE 63390015 LA R1,D200 63400015 LA R2,DYNEND-D200 63410015 OI SWRLD1,X'F0' 63420015 MVC RELOC1(4),RELINV 63430015 BAL RR,GENTXT 63440015 SPACE 63450015 INCLD2 BC NOP,INCLD3 BRANCH IF EPIL HAS BEEN PUT OUT 63460015 OI INCLD2+1,X'F0' OTHERWISE SET BRANCH 63470015 SPACE 63480015 LA R1,E03 PUT OUT EPILOGUE SUBROUTINE 63490015 LA R2,E40-E03 63500015 BAL RR,GENTXT 63510015 SPACE 63520015 LA R1,E40 63530015 LA R2,E70-E40 63540015 OI SWRLD1,X'F0' 63550015 MVC RELOC1(4),RELSLA 63560015 BAL RR,GENTXT 63570015 SPACE 63580015 LA R1,E70 63590015 LA R2,EPLEND-E70 63600015 OI SWRLD1,X'F0' 63610015 MVC RELOC1(4),RELSLA 63620015 BAL RR,GENTXT 63630015 SPACE 63640015 INCLD1 TM ZFLAG4,X'01' BRANCH TO OUT PUT EPIL BEFORE 63650015 BC BO,INCLD2 STATIC- THIS WILL NOT CAUSE 63660015 BC B,IL1117 LOOPING 63670015 SPACE 63680015 INCLD3 LA R1,S10 PUT OUT STATIC SUBROUTINE 63690015 LA R2,S15-S10 63700015 OI SWRLD1,X'F0' 63710015 MVC RELOC1(4),RELINV 63720015 BAL RR,GENTXT 63730015 SPACE 63731015 LA R1,S15 63732015 LA R2,S30-S15 63733015 OI SWRLD1,X'F0' 63734015 MVC RELOC1(4),RELLW0 63735015 BAL RR,GENTXT 63736015 SPACE 63740015 LA R1,S30 63750015 LA R2,S80-S30 63760015 OI SWRLD1,X'F0' 63770015 MVC RELOC1(4),RELINV 63780015 BAL RR,GENTXT 63790015 SPACE 63800015 LA R1,S80 63810015 LA R2,S100-S80 63820015 OI SWRLD1,X'F0' 63830015 MVC RELOC1(4),RELSLA 63840015 BAL RR,GENTXT 63850015 SPACE 63860015 LA R1,S100 63870015 LA R2,S140-S100 63880015 OI SWRLD1,X'F0' 63890015 MVC RELOC1(4),RELSLA 63900015 BAL RR,GENTXT 63910015 SPACE 63920015 LA R1,S140 63930015 LA R2,STAEND-S140 63940015 SPACE 63950015 TM CCCODE+3,X'80' BRANCH IF STATEMENT 63960015 BC BZ,INCLDA OPTION IS PRESENT 63970015 SPACE 63980015 LA R1,S150 63990015 LA R2,STAEND-S150 DELETE INSTRUCTION 64000015 SPACE 64010015 INCLDA BAL RR,GENTXT 64020015 SPACE 64030015 BC B,IL1117 64040015 EJECT 64360013 * DATA FOR INCLUD SUBROUTINE 64400013 SPACE 5 64440013 CNOP 0,4 64480013 RELLWF DC X'00002402' 64520013 RELSLA DC X'00002402' 64560013 RELINV DC X'00032402' 64600013 RELLW0 DC X'00002402' 64620015 MASK4 DC X'FFFFFFFC' 64660015 SPACE 5 64720013 * THE LABEL GIVEN TO EACH SUBROUTINE 64730015 * INSTRUCTION IS THE SAME AS THAT GIVEN IN IEMJI 64740015 SPACE 5 64750015 * HERE FOLLOW THE TEXT SKELETONS FOR 64760015 * THE DYNAMIC DSA SUBROUTINE 64770015 SPACE 2 64780015 DYNAM EQU * 64790015 D10 DC X'585C0000' L 5,PR..IHEQLWF(12) 64800015 D20 DC X'1255' LTR 5,5 64810015 D30 DC X'4780F05A' BC 8,90(15) 64814015 D33 DC X'586C0000' L 6,PR..IHEQINV(12) 64818015 D35 DC X'1266' LTR 6,6 64822015 D37 DC X'4740F05A' BC 4,90(15) 64826015 D40 DC X'18D5' LR 13,5 64830015 D50 DC X'1B22' SR 2,2 64840015 D60 DC X'583C0000' L 3,PR..IHEQSLA(12) 64850015 D70 DC X'50DC0000' ST 13,PR..IHEQSLA(12) 64860015 D80 DC X'5030D004' ST 3,4(13) 64870015 D90 DC X'91803000' TM 0(3),X'80' 64880015 D100 DC X'4710F034' BC 1,52(15) 64890015 D130 DC X'58303004' L 3,4(3) 64920015 D140 DC X'47F0F024' BC B,36(15) 64930015 D150 DC X'50D03008' ST 13,8(3) 64940015 D180 DC X'584C0000' L 4,PR..IHEQINV(12) 64970015 D190 DC X'41404001' LA 4,1(4) 64980015 D200 DC X'504C0000' ST 4,PR..IHEQINV(12) 64990015 D210 DC X'5040D054' ST 4,84(13) 65000015 D220 DC X'5020D050' ST 2,80(13) 65010015 D230 DC X'5020D008' ST 2,8(13) 65020015 D240 DC X'9200D04C' MVI 76(13),X'00' 65030015 D250 DC X'5020D060' ST 2,2,96(13) 65040015 D260 DC X'07FE' BR 14 65050015 D270 DC X'58F0B020' L 15,32(11) 65060015 D280 DC X'07FF' BR 15 65070015 DYNEND EQU * 65080015 SPACE 5 65090015 * HERE FOLLOW THE TEXT SKELETONS FOR 65100015 * THE EPILOGUE SUBROUTINE 65110015 SPACE 2 65120015 EPIL EQU * 65130015 E03 DC X'9180D001' TM 1(13),X'80' 65133015 E06 DC X'4780F03C' BC 8,60(15) 65136015 E10 DC X'5820D050' L 2,80(13) 65140015 E20 DC X'1222' LTR 2,2 65150015 E30 DC X'4770F03C' BC 7,60(15) 65160015 E40 DC X'59DC0000' C 13,PR..IHEQSLA(12) 65170015 E50 DC X'4770F03C' BC 7,60(15) 65180015 E60 DC X'58D0D004' L 13,4(13) 65190015 E70 DC X'50DC0000' ST 13,PR..IHEQSLA(12) 65200015 E80 DC X'9180D000' TM 0(13),X'80' 65210015 E90 DC X'4710F032' BC 1,50(15) 65220015 E100 DC X'58D0D004' L 13,4(13) 65230015 E110 DC X'47F0F022' BC B,34(15) 65240015 E120 DC X'5020D008' ST 2,8(13) 65250015 E130 DC X'98EBD00C' LM 14,11,12(13) 65260015 E140 DC X'07FE' BR 14 65270015 E150 DC X'58F0B030' L 15,A..IHESAFA 65280015 E160 DC X'07FF' BR 15 65290015 EPLEND EQU * 65300015 SPACE 5 65310015 * HERE FOLLOW THE TEXT SKELETONS FOR 65320015 * THE STATIC DSA SUBROUTINE 65330015 SPACE 2 65340015 STAT EQU * 65350015 S10 DC X'584C0000' L 4,PR..IHEQINV(12) 65360015 S11 DC X'1244' LTR 4,4 65362015 S13 DC X'47B0F056' BC 11,86(15) 65364015 S15 DC X'587C0000' L 7,PR..IHEQLW0(12) 65366015 S17 DC X'D20330507050' MVC 80(4,3),80(7) 65368015 S20 DC X'41404001' LA 4,1(4) 65370015 S30 DC X'504C0000' ST 4,PR..IHEQINV(12) 65380015 S40 DC X'50403054' ST 4,84(3) 65390015 S50 DC X'9200304C' MVI 76(3),X'00' 65400015 S60 DC X'5030D008' ST 3,8(13) 65410015 S70 DC X'18D3' LR 13,3 65420015 S80 DC X'583C0000' L 3,PR..IHEQSLA(12) 65430015 S90 DC X'5030D004' ST 3,4(13) 65440015 S100 DC X'50DC0000' ST 13,PR..IHEQSLA(12) 65450015 S130 DC X'5020D008' ST 2,8(13) 65480015 S140 DC X'5020D060' ST 2,96(13) 65490015 S150 DC X'07FE' BR 14 65500015 STAEND EQU * 65510015 EJECT 65880013 * CONSTANTS AND BUFFERS 65920013 SPACE 1 65960013 * ERROR CODE WORDS 66000013 CNOP 0,4 66040013 ERID01 DC X'00' 66080013 DC AL2(ERCD01) 66120013 DC AL1(AERROR) 66160013 ERID02 DC X'00' 66200013 DC AL2(ERCD02) 66240013 DC AL1(SERROR) 66280013 ERID03 DC X'00' 66320013 DC AL2(ERCD03) 66360013 DC AL1(SERROR) 66400013 ERID08 DC X'00' 66440013 DC AL2(ERCD08) 66480013 DC AL1(AERROR) 66520013 ERCD01 EQU X'0B41' INVALID PSEUDO-OP 66560013 ERCD02 EQU X'0B42' INVALID DC OPERAND 66600013 ERCD03 EQU X'0B43' ERRONEOUS RLD RETURN FROM OFFSET 66640013 ERCD08 EQU X'0B48' UNDEFINED LABEL 66680013 AERROR EQU X'40' DISASTROUS ERROR FLAG BITS 66720015 SERROR EQU X'44' 66760015 SPACE 2 66800013 SPACE 1 68280013 SPACE 2 68320013 * INSTRUCTIONS EXECUTED REMOTELY 68360013 SPACE 1 68400013 IL0104 MVC 0(0,HR1),0(R1) INSTRUCTION FOR TEXT MOVING 68440013 * EXECUTED IN GENTXT 68480013 IL0203 MVC 1(0,HR2),0(HR2) INSTRUCTION EXECUTED TO CLEAR 68520013 * REST OF TEXT CARD FIELD IN PUNCHT 68560013 IL1903 MVC ENLBBC+5(0),1(HR2) MOVES ENTRY LABEL NAMES 68600013 IL1904 TR ENLBBC+5(0),0(LR) TRANSLATES ENTRY LABEL NAMES 68640013 SPACE 2 68680013 * CONSTANTS AND INITIALIZED WORKSPACE 68720013 SPACE 1 68760013 PROCLN DC F'0' OFFSET OF NEXT PROCEDURE 69240013 PROLAC DC F'0' ADCON SKELETON FOR ADDRESSING 69280013 PROLBC DC X'47FA0000' BRANCH INSTRUCTION MASK FOR PLBS 69320013 ENLBBC DC X'47F0F000' BRANCH FOR TRACE ENTRIES 69360013 DS 33C SPACE FOR ENTRY NAME 69400013 CNOP 0,4 69440013 AUXTXT L 0,0 SKELETON LOAD INSTRUCTION 69480013 LA4095 LA 0,4095(0,BRNREG) SKELETON LOAD ADDRESS 69520013 TXBALR BALR 0,0 BALR 69560013 TXNOPR BCR NOP,0 NOPR 69600013 PLBALR BALR BRNREG,0 INSERTED BEFORE PROLOGUE ADCONS 69640013 CNOP 0,4 69680013 CN0102 DC X'00000FFF' 12 BIT MASK AND 4095 69720013 CRDVFD DC AL2(CRDLNG) HALFWORD CONTAINING CARD VAR. 69760013 WSRELR DC H'0' CONTAINS RELOCATION ESID OF LAST 69800013 * RLD ENTRY 69840013 WSPROC DC H'0' DICT REF OF CURRENT PROCEDURE 69880013 WS1000 DC F'0' WORKSPACE 69920013 WSX2 DC H'0' X2 SLOT 69960013 WSX3 DC H'0' X3 SLOT 70000013 SVMXEQ DC H'0' 70040013 CN0100 DC H'4' 70080013 CNLDTU DC C'TUZZ' 70120013 CNRLS1 DC C'TTTUZZ' 70160013 ADRREG DC X'00' REGISTER SPECIFIED IN LAST ADR 70200013 ADRLNG DC X'00' LENGTH SPECIFIED IN ADR 70240013 EQUCUR DC X'00' 70280013 EJECT 70320013 * DEFINITIONS OF ARGUMENT USED IN CONSTRUCTION OF TABLE1 70360013 * EACH ARGUMENT IS THE OFFSET OF A BRANCH INSTRUCTION IN THE 70400013 * BRANCH TABLE USED BY THE SCAN LOOP. 70440013 SPACE 1 70480013 C EQU PROC-ILBASE 70520013 D EQU PROCP-ILBASE 70560013 E EQU RROP-ILBASE 70600013 F EQU RX-ILBASE 70640013 G EQU SS-ILBASE 70680013 H EQU PLBS-ILBASE 70720013 I EQU PCBS-ILBASE 70760013 J EQU EOP-ILBASE 70800013 K EQU BEGIN-ILBASE 70840013 L EQU CLSL-ILBASE 70880013 M EQU BLA-ILBASE 70920013 N EQU ADR-ILBASE 70960013 O EQU EOB-ILBASE 71000013 P EQU INVAL-ILBASE 71040013 Q EQU PSEUD-ILBASE 71080013 R EQU CONST-ILBASE 71120013 S EQU RS2-ILBASE 71160013 T EQU RS1-ILBASE 71200013 U EQU SI-ILBASE 71240013 V EQU BEGINP-ILBASE 71280013 W EQU STATNO-ILBASE 71300015 SPACE 2 71320013 * TABLE1 71360013 * TABLE1 IS A TABLE OF 256 BYTES CORRESPONDING TO 8-BIT 71400013 * PSEUDO-CODE OPERATION CODE VALUES. THE VALUE OF EACH ENTRY IN 71440013 * THE TABLE DEFINES THE ENTRY POINT TO A ROUTINE WHICH HANDLES 71480013 * THIS PARTICULAR OPERATION 71520013 TABLE1 DC AL1(P) DCV0 00 71560013 DC AL1(P) DCV1 01 71600013 DC AL1(P) DCV2 02 71640013 DC AL1(P) DCV3 03 71680013 DC AL1(P) DCV4 04 71720013 DC AL1(P) DCV8 05 71760013 DC AL1(Q) DROP 06 71800013 DC AL1(Q) EQU 07 71840013 DC AL1(C) PROC 08 71880013 DC AL1(K) BEGIN 09 71920013 DC AL1(P) STK 0A 71960013 DC AL1(J) EOP 0B 72000013 DC AL1(P) EOP2 0C 72040013 DC AL1(Q) IPRM 0D 72080013 DC AL1(Q) EPRM 0E 72120013 DC AL1(Q) ITDO 0F 72160013 DC AL1(Q) OSM1 10 72200013 DC AL1(Q) OSM2 11 72240013 DC AL1(P) 12 72280013 DC AL1(P) DCA3 13 72320013 DC AL1(R) DCA4 14 72360013 DC AL1(P) 15 72400013 DC AL1(P) 16 72440013 DC AL1(P) 17 72480013 DC AL1(D) PROC' 18 72520013 DC AL1(V) BEGIN' 19 72560013 DC AL1(Q) ADV 1A 72600013 DC AL1(H) PLBS 1B 72640013 DC AL1(I) PCBS 1C 72680013 DC AL1(Q) IPRM' 1D 72720013 DC AL1(Q) EPRM' 1E 72760013 DC AL1(Q) ITDO' 1F 72800013 DC AL1(Q) BGPE 20 72840013 DC AL1(O) EOB 21 72880013 DC AL1(Q) RRI 22 72920013 DC AL1(Q) IDV 23 72960013 DC AL1(N) ADR 24 73000013 DC AL1(P) 25 73040013 DC AL1(P) 26 73080013 DC AL1(P) 27 73120013 DC AL1(P) 28 73160013 DC AL1(P) 29 73200013 DC AL1(Q) ADV' 2A 73240013 DC AL1(Q) PLBS' 2B 73280013 DC AL1(Q) PSLD 2C 73320013 DC AL1(Q) ABS 2D 73360013 DC AL1(Q) ABS' 2E 73400013 DC AL1(R) ALGN 2F 73440013 DC AL1(Q) BLBS 30 73480013 DC AL1(Q) BLBS' 31 73520013 DC AL1(P) 32 73560013 DC AL1(P) 33 73600013 DC AL1(Q) RWA 34 73640013 DC AL1(P) 35 73680013 DC AL1(P) 36 73720013 DC AL1(Q) EDIT 37 73760013 DC AL1(Q) FORMAT LIST 38 73800013 DC AL1(Q) FORMAT 39 73840013 DC AL1(Q) FORMAT' 3A 73880013 DC AL1(Q) EDIT' 3B 73920013 DC AL1(P) 3C 73960013 DC AL1(P) 3D 74000013 DC AL1(P) 3E 74040013 DC AL1(P) 3F 74080013 DC AL1(E) LCR 40 74120013 DC AL1(E) BCR 41 74160013 DC AL1(E) HER 42 74200013 DC AL1(E) HDR 43 74240013 DC AL1(E) BCTR 44 74280013 DC AL1(E) NR 45 74320013 DC AL1(E) OR 46 74360013 DC AL1(E) XR 47 74400013 DC AL1(E) LR 48 74440013 DC AL1(E) CR 49 74480013 DC AL1(E) AR 4A 74520013 DC AL1(E) SR 4B 74560013 DC AL1(E) MR 4C 74600013 DC AL1(E) DR 4D 74640013 DC AL1(E) SVC 4E 74680013 DC AL1(E) BALR 4F 74720013 DC AL1(E) LCDR 50 74760013 DC AL1(E) SPM 51 74800013 DC AL1(E) LTR 52 74840013 DC AL1(E) LTER 53 74880013 DC AL1(E) LTDR 54 74920013 DC AL1(E) LNR 55 74960013 DC AL1(E) LNER 56 75000013 DC AL1(E) LNDR 57 75040013 DC AL1(E) LDR 58 75080013 DC AL1(E) CDR 59 75120013 DC AL1(E) ADR 5A 75160013 DC AL1(E) SDR 5B 75200013 DC AL1(E) MDR 5C 75240013 DC AL1(E) DDR 5D 75280013 DC AL1(E) AWR 5E 75320013 DC AL1(E) SWR 5F 75360013 DC AL1(E) LCER 60 75400013 DC AL1(E) CLR 61 75440013 DC AL1(E) ALR 62 75480013 DC AL1(E) SLR 63 75520013 DC AL1(E) RER 64 75560013 DC AL1(E) LPR 65 75600013 DC AL1(E) LPER 66 75640013 DC AL1(E) LPDR 67 75680013 DC AL1(E) LER 68 75720013 DC AL1(E) CER 69 75760013 DC AL1(E) AER 6A 75800013 DC AL1(E) SER 6B 75840013 DC AL1(E) MER 6C 75880013 DC AL1(E) DER 6D 75920013 DC AL1(E) AUR 6E 75960013 DC AL1(E) SUR 6F 76000013 DC AL1(S) LM 70 76040013 DC AL1(T) SLA 71 76080013 DC AL1(T) SLDA 72 76120013 DC AL1(T) SLDL 73 76160013 DC AL1(T) SLL 74 76200013 DC AL1(T) SRA 75 76240013 DC AL1(T) SRDA 76 76280013 DC AL1(T) SRDL 77 76320013 DC AL1(T) SRL 78 76360013 DC AL1(S) STM 79 76400013 DC AL1(M) BXH 7A 76440013 DC AL1(M) BXLE 7B 76480013 DC AL1(L) SL 7C 76520013 DC AL1(W) SN 7D 76560015 DC AL1(L) CL 7E 76600013 DC AL1(Q) CN 7F 76640013 DC AL1(F) LX 80 76680013 DC AL1(M) BC 81 76720013 DC AL1(R) DCF 82 76760013 DC AL1(F) SX 83 76800013 DC AL1(M) BCT 84 76840013 DC AL1(F) N 85 76880013 DC AL1(F) O 86 76920013 DC AL1(F) X 87 76960013 DC AL1(F) L 88 77000013 DC AL1(F) C 89 77040013 DC AL1(F) A 8A 77080013 DC AL1(F) S 8B 77120013 DC AL1(F) M 8C 77160013 DC AL1(F) D 8D 77200013 DC AL1(F) IC 8E 77240013 DC AL1(M) BAL 8F 77280013 DC AL1(F) LH 90 77320013 DC AL1(F) CH 91 77360013 DC AL1(F) AH 92 77400013 DC AL1(F) SH 93 77440013 DC AL1(F) MH 94 77480013 DC AL1(F) STH 95 77520013 DC AL1(F) STRD 96 77560013 DC AL1(F) STD 97 77600013 DC AL1(F) LD 98 77640013 DC AL1(F) CD 99 77680013 DC AL1(F) AD 9A 77720013 DC AL1(F) SD 9B 77760013 DC AL1(F) MD 9C 77800013 DC AL1(F) DD 9D 77840013 DC AL1(F) AW 9E 77880013 DC AL1(F) CVB 9F 77920013 DC AL1(M) LA A0 77960013 DC AL1(F) CL A1 78000013 DC AL1(F) AL A2 78040013 DC AL1(F) SL A3 78080013 DC AL1(F) STC A4 78120013 DC AL1(F) ST A5 78160013 DC AL1(F) STRE A6 78200013 DC AL1(F) STE A7 78240013 DC AL1(F) LE A8 78280013 DC AL1(F) CE A9 78320013 DC AL1(F) AE AA 78360013 DC AL1(F) SE AB 78400013 DC AL1(F) ME AC 78440013 DC AL1(F) DE AD 78480013 DC AL1(F) AU AE 78520013 DC AL1(F) CVD AF 78560013 DC AL1(U) CLI B0 78600013 DC AL1(U) MVI B1 78640013 DC AL1(U) NI B2 78680013 DC AL1(U) OI B3 78720013 DC AL1(U) SSM B4 78760013 DC AL1(U) TM B5 78800013 DC AL1(U) XI B6 78840013 DC AL1(P) LA' B7 78880013 DC AL1(R) DCF2 B8 78920013 DC AL1(P) BCT' B9 78960013 DC AL1(P) BA 79000013 DC AL1(P) BB 79040013 DC AL1(Q) SN2 BC 79080013 DC AL1(P) BD 79120013 DC AL1(Q) ADI BE 79160013 DC AL1(P) BF 79200013 DC AL1(G) CLC C0 79240013 DC AL1(G) MVC C1 79280013 DC AL1(G) MVN C2 79320013 DC AL1(G) MVO C3 79360013 DC AL1(G) MVZ C4 79400013 DC AL1(G) NC C5 79440013 DC AL1(G) OC C6 79480013 DC AL1(G) XC C7 79520013 DC AL1(G) ZAP C8 79560013 DC AL1(G) CP C9 79600013 DC AL1(G) AP CA 79640013 DC AL1(G) SP CB 79680013 DC AL1(G) MP CC 79720013 DC AL1(G) DP CD 79760013 DC AL1(G) ED CE 79800013 DC AL1(G) EDMK CF 79840013 DC AL1(G) TR D0 79880013 DC AL1(G) TRT D1 79920013 DC AL1(G) PACK D2 79960013 DC AL1(G) UNPK D3 80000013 DC AL1(Q) IGNORE D4 80040013 DC AL1(P) D5 80080013 DC AL1(P) CONV D6 80120013 DC AL1(P) D7 80160013 DC AL1(P) D8 80200013 DC AL1(P) D9 80240013 DC AL1(P) DA 80280013 DC AL1(P) DB 80320013 DC AL1(P) DC 80360013 DC AL1(P) DD 80400013 DC AL1(P) DE 80440013 DC AL1(P) DF 80480013 DC AL1(P) E0 80520013 DC AL1(P) E1 80560013 DC AL1(P) E2 80600013 DC AL1(P) E3 80640013 DC AL1(P) E4 80680013 DC AL1(P) E5 80720013 DC AL1(P) E6 80760013 DC AL1(P) E7 80800013 DC AL1(P) E8 80840013 DC AL1(P) E9 80880013 DC AL1(P) EA 80920013 DC AL1(P) EB 80960013 DC AL1(P) EC 81000013 DC AL1(P) ED 81040013 DC AL1(P) EE 81080013 DC AL1(P) EF 81120013 DC AL1(P) F0 81160013 DC AL1(P) F1 81200013 DC AL1(P) F2 81240013 DC AL1(P) F3 81280013 DC AL1(P) F4 81320013 DC AL1(P) F5 81360013 DC AL1(P) F6 81400013 DC AL1(P) F7 81440013 DC AL1(P) F8 81480013 DC AL1(P) F9 81520013 DC AL1(P) FA 81560013 DC AL1(P) FB 81600013 DC AL1(Q) IGN2 FC 81640013 DC AL1(Q) IGN4 FD 81680013 DC AL1(Q) IGN5 FE 81720013 DC AL1(Q) IGN8 FF 81760013 SPACE 1 81800013 * END OF TABLE1 81840013 SPACE 1 81880013 * WORKSPACE AREAS 81920013 WSTEXT DS F CONTAINS CURRENT TEXT BLOCK REF 81960013 WSUR01 DS F SAVE LOCN FOR UR0 82080013 WSRR01 DS F FIRST LEVEL SAVE OF LINK REG. 82120013 WSRR02 DS F SECOND DITTO. 82160013 WSRR03 DS F THIRD DITTO. 82200013 SLOT DC F'0' 82220015 WS1400 DS H USED FOR OSM1 IN SS INSTRUCTION 82240013 DS 0F ALIGN ON WORD BOUNDARY 82280013 OPTEXT DS 6C OPERATION TEXT FIELD 82320013 WS103A DS 1C 82360013 WS1003 DC 5X'00' TEMPORARY FOR OPERAND FIELD OF 82400015 * SS INSTRUCTION 82440013 END IEMTT 82520013 ./ ADD SSI=02011881,NAME=IEMTU,SOURCE=0 TU TITLE 'IEMTU, SECOND PASS, FINAL ASSEMBLY, OS/360 PL/I COMPILEC00060013 R(F)' 00120013 * FUNCTIONS - GIVEN A DICTIONARY REFERENCE THIS ROUTINE 00180013 * RETURNS THE OFFSET TO BE USED IN AN INSTRUCTION, AND ANY 00240013 * RELOCATION DICTIONARY INFORMATION WHICH MAY BE REQUIRED 00300013 * 00360013 * ENTRY POINTS - (1) OFFSET. CALLED FROM IEMTT VIA THE 00420013 * TRANSFER VECTOR AT THE BEGINNING OF THIS MODULE 00480013 * 00540013 * INPUT - (1) R1 ADDRESSES A 2 BYTE DICTIONARY REFERENCE 00600013 * (2) R2 ADDRESSES A 2 BYTE 2'S COMPLEMENT 00660013 * LITTERAL OFFSET. 00720013 * 00780013 * OUTPUT - (1) OFFST0 IN THE TRANSFER VECTOR OF IEMTT 00840013 * CONTAINS THE OFFSET VALUE. 00900013 * (2) RELOC0 IN THE TRANSFER VECTOR OF IEMTT 00960013 * CONTAINS (A) A 2 BYTE RELOCATION SECTION IDENTIFIER 01020013 * (B) A FLAG BYTE IN THE SAME FORMAT AS THE FLAG BYTE 01080013 * IN AN RLD ENTRY. 01140013 * (C) A ZERO BYTE. 01200013 * 01260013 * EXTERNAL ROUTINES - (1) ZRFAOF. COMPILER CONTROL 01320013 * DICTIONARY REFERENCE TO ABSOLUTE ADDRESS. 01380013 * (2) ZUEROF. COMPILER CONTROL ERROR 01440013 * ENTRY ROUTINE. 01500013 * 01560013 * EXITS - NORMAL - (1) RETURN TO 0(RR) IF AN RLD ENTRY 01620013 * IS REQUIRED (IN WHICH CASE RELOC0 HAS BEEN SET UP AS DESCRIBED 01680013 * ABOVE). 01740013 * (2) RETURN TO 4(RR) IF NO RLD ENTRY 01800013 * IS REQUIRED. ONLY OFFST0 HAS BEEN SET UP. 01860013 * 01920013 * EXITS - ABNORMAL - NONE. 01980013 * 02040013 * NOTES (1) REFERENCES TO EXTERNAL ROUTINES AND THE 02100013 * COMMUNICATIONS REGION ARE MADE BY MEANS OF RELOCATEABLE 02160013 * SYMBOLS OBTAINED BY SUITABLE COMBINATION OF OFFSET DEFINITION 02220013 * AND USING STATEMENTS. 02280013 * (2) TECHNIQUES. 02340013 * A TABLE LOOK UP ON THE DICTIONARY ENTRY CODE PROVIDES 02400013 * ENTRY VIA A BRANCH TABLE TO A ROUTINE SPECIFICALLY FOR THAT 02460013 * TYPE OF DICTIONARY ENTRY. 02520013 EJECT 02580013 IEMTU START 0 02640013 * R20 $964400,* $973600 32265 02670000 PRINT NODATA 02700013 * DEFINITIONS OF SYMBOLS 02760013 SPACE 1 02820013 * GENERAL PURPOSE REGISTER NAMES AND USE 02880013 SPACE 1 02940013 BASRG1 EQU 9 BASE REGISTER USED FOR ADDRESSES 03000013 * IN THIS CONTROL SECTION 03060013 BASRG2 EQU 10 BASE REGISTER USED FOR ADDRESSES 03120013 * IN SECOND CONTROL SECTION IF ONE 03180013 * IS NEEDED 03240013 CONBAS EQU 11 CONTROL PHASE BASE 03300013 DICBAS EQU 13 DICTIONARY COMMUNICATION REGION 03360013 * BASE 03420013 R0 EQU 6 PSEUDO-CODE OPERATION CODE BYTE 03480013 R1 EQU 7 03540013 R2 EQU 8 03600013 SPACE 1 03660013 UR0 EQU 3 03720013 UR1 EQU 4 INPUT TEXT POSITION POINTER 03780013 UR2 EQU 5 LOCATION COUNTER 03840013 SPACE 1 03900013 RR EQU 14 RETURN REGISTER FOR SUBROUTINE 03960013 * CALLS 04020013 LR EQU 15 ENTRY POINT REGISTE FOR CONTROL 04080013 * PHASE SUBROUTINE CALLS 04140013 SPACE 1 04200013 HR0 EQU 0 THESE FIVE REGISTERS ARE USED 04260013 HR1 EQU 1 AS WORKING REGISTERS AND IN 04320013 HR2 EQU 2 INTERNAL SUBROUTINE CALLS ARE NOT 04380013 HR3 EQU RR ASSUMED TO BE PRESERVED 04440013 HR4 EQU LR 04500013 SPACE 2 04560013 * BRANCH MNEMONIC DEFINITIONS 04620013 B EQU 15 UNCONDITIONAL BRANCH 04680013 NOP EQU 0 NO OPERATION BRANCH 04740013 SPACE 1 04800013 BH EQU 2 BRANCH ON HIGH 04860013 BL EQU 4 LOW 04920013 BE EQU 8 EQUAL 04980013 BNH EQU 13 NOT HIGH 05040013 BNL EQU 11 NOT LOW 05100013 BNE EQU 7 NOT EQUAL 05160013 SPACE 1 05220013 BO EQU 1 BRANCH ON OVERFLOW OR ONES 05280013 BP EQU 2 PLUS 05340013 BM EQU 4 MINUS OR MIXED 05400013 BZ EQU 8 ZERO OR ZEROES 05460013 SPACE 1 05520013 BNM EQU BZ+BP BRANCH ON NOT MINUS 05580013 BNZ EQU BO+BP+BM NOT ZERO 05640013 BNP EQU BL+BE NOT POSITIVE 05700013 BNO EQU 14 NOT ONES 05760013 SPACE 1 05820013 * DEFINITIONS OF 4K BLOCKS USED TO EFFECT AUTOMATIC BASE 05880013 * REGISTER ASSIGNMENT FOR COMMUNICATIONS REFERENCES 05940013 SPACE 1 06000013 BLOCK2 EQU * 06060013 BLOCK1 EQU BLOCK2+X'1000' 06120013 CONBLK EQU *+X'4000' 06180013 DICBLK EQU *+X'5000' 06240013 SPACE 1 06300013 USING BLOCK1,BASRG1 06360013 USING BLOCK2,BASRG2 06420013 USING DICBLK,DICBAS 06480013 USING CONBLK,CONBAS 06540013 SPACE 2 06600013 * DEFINITIONS OF CONTROL PHASE TRANSFER VECTOR OFFSETS 06660013 SPACE 1 06720013 ZUPLOF EQU CONBLK+X'08' PRINT 06780013 ZABTOF EQU CONBLK+X'20' ABORT 06840013 ZUEROF EQU CONBLK+X'30' ERROR ENTRY 06900013 ZRFAOF EQU CONBLK+X'34' DICTREF TO ABS 06960013 ZUPL EQU CONBLK+X'08' 06967001 ZUTXTC EQU CONBLK+X'14' 06974001 ZTXTAB EQU CONBLK+X'54' 06981001 ZCHAIN EQU CONBLK+X'58' 06988001 ZTXTRF EQU CONBLK+X'50' 06995001 ZDRFAB EQU CONBLK+X'34' 07002001 ZALTER EQU CONBLK+X'5C' 07009001 SPACE 2 07020013 * DEFINITIONS OF DICTIONARY COMMUNICATIONS REGION OFFSETS 07080013 SPACE 1 07140013 ZCOMM EQU DICBLK+304 BASE OF INTER-PHASE COMMUNICAT- 07200013 * ION REGION 07260013 ZSTACH EQU DICBLK+124 07290015 PAR1 EQU DICBLK+128 07320013 PAR2 EQU PAR1+4 07380013 PAR3 EQU PAR2+4 07440013 PAR4 EQU PAR3+4 07500013 PAR5 EQU PAR4+4 07560013 PAR6 EQU PAR5+4 07620013 PAR7 EQU PAR6+4 07680013 PAR8 EQU PAR7+4 07740013 LOCK EQU DICBLK+274 LOCK SLOT 07800013 SPACE 2 07860013 * DEFINITIONS OF OFFSETS OF DICTIONARY ENTRY FIELDS 07920013 * COMMON DICTIONARY ENTRY DEFINITIONS 07980013 OFFST1 EQU 5 08040013 OFSOT1 EQU 10 OTHER 1 08100013 OT1SYM EQU X'80' SYMBOL TABLE ENTRY REQUESTED 08160013 OFSVAR EQU 11 VARIABLE BYTE 08220013 VARAD2 EQU X'80' SECOND ADDRESS SLOT FLAG 08280013 VARALC EQU X'01' ALLOCATION ENTRY FLAG 08340013 OFSOT2 EQU 12 OTHER 2 08400013 OT2FP EQU X'08' FORMAL PARAMETER FLAG 08460013 OT2SC2 EQU X'03' STORAGE CLASS BITS 08520013 OFSOT3 EQU 13 OTHER 3 08580013 OT3DED EQU X'40' DED REQUESTED 08640013 OT3SGN EQU X'04' OFFSET 1 SIGN INDICATOR 08700013 DATSYM EQU 19 DICT REF OF SYMTAB ENTRY OR DED 08760013 DATVAR EQU 21 START OF VARIABLE FIELD FOR DATA 08820013 * VARIABLE 08880013 * COMPILER AND STATEMENT LABEL ENTRIES 08940013 SLCODE EQU X'00' STATEMENT LABEL IDENTIFICATION 09000013 CSLSIO EQU 5 STATIC ADCON OFFSET, IF ANY 09060013 CSLSTN EQU 8 STATEMENT NUMBER FIELD 09120013 CSLOT1 EQU 10 OTHER 1 09180013 OT1ASG EQU X'10' 'ASSIGNED' FLAG 09240013 CSLOFS EQU 11 OFFSET FIELD 09300013 * ENTRY LABEL ENTRY 09360013 ELCODE EQU X'01' IDENTIFICATION CODE 09420013 ELET2 EQU 11 REFERENCE TO ET2 09480013 ELOFFS EQU 13 OFFSET FIELD 09540013 * ENTRY TYPE 4 09600013 ET4COD EQU X'03' 09660013 ET4FVR EQU 8 FUNCTION VALUE OFFSET 09720013 ET4DED EQU 18 DED REFERENCE 09780013 * PROCEDURE ENTRY TYPE 1 09840013 ET1COD EQU X'80' IDENTIFICATION CODE OF ET1 09900013 ET1ESD EQU 3 ESID NUMBER OF DISPLY PR 09960013 ET1LC4 EQU 20 APPARENT ENTRY POINT OFFSET 10020013 ET1SYM EQU 23 SYMBOL TABLE ENTRY REFERENCE 10080013 ET1LC5 EQU 28 TRUE OFFSET OF PROCEDURE 10140013 ET1RSW EQU 34 RETURN SWITCH OFFSET 10200013 ET1AFV EQU 37 ADCON FOR FUNCTION VALUE 10260013 ET1CA1 EQU 31 WORKSPACE FOR CONTROLLED 10320013 ET1CA2 EQU 60 WORK SPACE FOR BUYING TEMP 10380015 * BEGIN ENTRY 10440013 BGNCOD EQU X'81' IDENTIFICATION CODE OF BEGIN 10500013 BGNCA2 EQU 52 WORK SPACE FOR BUYING TEMP 10560015 * ENTRY ENTRY TYPE 1 10620013 EN1COD EQU X'82' 10680013 EN1ET1 EQU 5 CHAIN OF ET1-EN1 10740013 EN1OFS EQU 9 APPARENT ENTRY POINT OFFSET 10800013 * CONSTANT 10860013 CONCOD EQU X'88' 10920013 CONDED EQU 10 REFERENCE TO DED ENTRY 10980013 * ENTRY TYPE 2 11040013 ET2COD EQU X'85' 11100013 ET2ET3 EQU 3 POINTER TO ET3 11160013 ET2DED EQU 12 DED REFERENCE 11220013 * ENTRY TYPE 3 11280013 ET3COD EQU X'84' 11340013 ET3ET1 EQU 3 ENTRY TYPE 1 REFERENCE 11400013 ET3FVR EQU 7 FUNCTION VALUE OFFSET 11460013 DVSKDV EQU 8 REF TO SKELETON DOPE VECTOR 11520013 * SKELETON DOPE VECTOR 11580013 SKDOFS EQU 10 OFFSET OF VIRTUAL ORIGIN 11640013 * SYMBOL TABLE/DED 11700013 SYMCOD EQU X'C7' 11760013 SYMOFS EQU 11 SYMTAB ENTRY OFFSET 11820013 SPACE 2 11830015 * ASSEMBLY PARAMETER DEFINITIONS 11840015 BLANK EQU X'40' CHARACTER WHICH PUNCHES AS A BLANK 11850015 SPACE 2 11880013 * STANDARD PSEUDO REGISTER AND CONTROL SECTION DEFINITIONS 11940013 SPACE 1 12000013 ESIDSI EQU 2 STATIC INTERNAL SECTION 12060013 ESIDIC EQU 3 INVOCATION COUNTER 12120013 ESIDER EQU 6 ERROR REGISTER 12180013 ESDQTC EQU 7 12210015 SPACE 2 12240013 EJECT 12300013 * INITIALIZATION OF PHASE 12360013 SPACE 1 12420013 * DEFINITIONS OF INTER-BLOCK COMMUNICATIONS 12480013 SPACE 1 12540013 * BLOCK1 ENTRIES 12600013 OFFST0 EQU BLOCK1+X'10' OFFSET VALUE RETURNED 12660013 RELOC0 EQU OFFST0+4 RLD REQUEST SLOT 12720013 WSBLOK EQU RELOC0+4 CURRENT BLOCK REFERENCE 12780013 PROCLC EQU WSBLOK+4 PROLOG LENGTH 12810001 * BLOCK2 ENTRIES 12840013 BC B,OFFSET 12900013 BC B,SOPRO 12910001 BC B,SOINIT 12920001 BC B,SOPROI 12930001 BC B,SOSN 12940001 * TABLE2, TABLE3 ARE ALSO ENTRIES 12960013 SPACE 12960715 * CODTAB 12961415 * THIS TABLE IS USED BY PHASE IEMUA AND IS MOVED 12962115 * TO OFFSET 528 IN SCRATCH CORE JUST BEFORE PHASE 12962815 * IEMTT RELEASES CONTROL 12963515 SPACE 12964215 CODTAB DC 16XL16'00000000000000000000000000000000' 12964915 ORG CODTAB+X'00' 12965615 DC X'30' 12966315 ORG CODTAB+X'01' 12967015 DC X'2C' 12967715 ORG CODTAB+X'03' 12968415 DC X'28' 12969115 ORG CODTAB+X'04' 12969815 DC X'20' 12970515 ORG CODTAB+X'07' 12971215 DC X'0C' 12971915 ORG CODTAB+X'08' 12972615 DC X'1C' 12973315 ORG CODTAB+X'09' 12974015 DC X'24' 12974715 ORG CODTAB+X'0C' 12975415 DC X'0C' 12976115 ORG CODTAB+X'0D' 12976815 DC X'0C' 12977515 ORG CODTAB+X'0F' 12978215 DC X'04' 12978915 ORG CODTAB+X'17' 12979615 DC X'10' 12980315 ORG CODTAB+X'1C' 12981015 DC X'10' 12981715 ORG CODTAB+X'1D' 12982415 DC X'10' 12983115 ORG CODTAB+X'1F' 12983815 DC X'08' 12984515 ORG CODTAB+X'27' 12985215 DC X'0C' 12985915 ORG CODTAB+X'2C' 12986615 DC X'0C' 12987315 ORG CODTAB+X'2D' 12988015 DC X'0C' 12988715 ORG CODTAB+X'2E' 12989415 DC X'14' 12990115 ORG CODTAB+X'2F' 12990815 DC X'04' 12991515 ORG CODTAB+X'37' 12992215 DC X'10' 12992915 ORG CODTAB+X'3C' 12993615 DC X'10' 12994315 ORG CODTAB+X'3D' 12995015 DC X'10' 12995715 ORG CODTAB+X'3E' 12996415 DC X'18' 12997115 ORG CODTAB+X'3F' 12997815 DC X'08' 12998515 ORG CODTAB+X'4D' 12999215 DC X'4C' 12999915 ORG CODTAB+X'98' 13000615 DC X'48' 13001315 ORG CODTAB+X'C1' 13002015 DC X'44' 13002715 ORG CODTAB+X'C2' 13003415 DC X'20' 13004115 ORG CODTAB+X'C3' 13004815 DC X'64' 13005515 ORG CODTAB+X'C5' 13006215 DC X'54' 13006915 ORG CODTAB+X'C6' 13007615 DC X'50' 13008315 ORG CODTAB+X'C7' 13009015 DC X'40' 13009715 ORG CODTAB+X'C8' 13010415 DC X'68' 13011115 ORG CODTAB+X'C9' 13011815 DC X'5C' 13012515 ORG CODTAB+X'CC' 13013215 DC X'60' 13013915 ORG CODTAB+X'CE' 13014615 DC X'58' 13015315 ORG CODTAB+X'100' 13016015 SPACE 1 13020013 * TABLE2 13080013 * TABLE2 IS A TABLE OF 256 BYTES CORRESPONDING TO 8-BIT 13140013 * PSEUDO-CODE OPERATION CODE VALUES. THE VALUE OF EACH ENTRY IN 13200013 * THE TABLE REPRESENTS THE LENGTH IN BYTES OF THE CORRESPONDING 13260013 * PSEUDO-CODE ITEM 13320013 SPACE 1 13380013 TABLE2 DC AL1(3) DCV0 00 13440013 DC AL1(3) DCV1 01 13500013 DC AL1(3) DCV2 02 13560013 DC AL1(3) DCV3 03 13620013 DC AL1(3) DCV4 04 13680013 DC AL1(3) DCV8 05 13740013 DC AL1(3) DROP 06 13800013 DC AL1(3) EQU 07 13860013 DC AL1(3) PROC 08 13920013 DC AL1(3) BEGIN 09 13980013 DC AL1(0) STK 0A 14040013 DC AL1(0) EOP 0B 14100013 DC AL1(0) EOP2 0C 14160013 DC AL1(3) IPRM 0D 14220013 DC AL1(3) EPRM 0E 14280013 DC AL1(3) ITDO 0F 14340013 DC AL1(3) OSM1 10 14400013 DC AL1(3) OSM2 11 14460013 DC AL1(0) 12 14520013 DC AL1(3) DCA3 13 14580013 DC AL1(3) DCA4 14 14640013 DC AL1(0) 15 14700013 DC AL1(0) 16 14760013 DC AL1(0) 17 14820013 DC AL1(3) PROC' 18 14880013 DC AL1(3) BEGIN' 19 14940013 DC AL1(3) ADV 1A 15000013 DC AL1(3) PLBS 1B 15060013 DC AL1(3) PCBS 1C 15120013 DC AL1(3) IPRM' 1D 15180013 DC AL1(3) EPRM' 1E 15240013 DC AL1(3) ITDO' 1F 15300013 DC AL1(3) BGPE 20 15360013 DC AL1(3) EOB 21 15420013 DC AL1(3) RRI 22 15480013 DC AL1(3) IDV 23 15540013 DC AL1(3) ADR 24 15600013 DC AL1(0) 25 15660013 DC AL1(0) 26 15720013 DC AL1(0) 27 15780013 DC AL1(0) 28 15840013 DC AL1(0) 29 15900013 DC AL1(3) ADV' 2A 15960013 DC AL1(3) PLBS' 2B 16020013 DC AL1(3) PSLD 2C 16080013 DC AL1(3) ABS 2D 16140013 DC AL1(3) ABS' 2E 16200013 DC AL1(3) ALGN 2F 16260013 DC AL1(3) BLBS 30 16320013 DC AL1(3) BLBS' 31 16380013 DC AL1(0) 32 16440013 DC AL1(0) 33 16500013 DC AL1(3) RWA 34 16560013 DC AL1(0) 35 16620013 DC AL1(0) 36 16680013 DC AL1(3) EDIT 37 16740013 DC AL1(3) FORMAT LIST 38 16800013 DC AL1(3) FORMAT 39 16860013 DC AL1(3) FORMAT' 3A 16920013 DC AL1(3) EDIT' 3B 16980013 DC AL1(0) 3C 17040013 DC AL1(0) 3D 17100013 DC AL1(0) 3E 17160013 DC AL1(0) 3F 17220013 DC AL1(2) LCR 40 17280013 DC AL1(2) BCR 41 17340013 DC AL1(2) HER 42 17400013 DC AL1(2) HDR 43 17460013 DC AL1(2) BCTR 44 17520013 DC AL1(2) NR 45 17580013 DC AL1(2) OR 46 17640013 DC AL1(2) XR 47 17700013 DC AL1(2) LR 48 17760013 DC AL1(2) CR 49 17820013 DC AL1(2) AR 4A 17880013 DC AL1(2) SR 4B 17940013 DC AL1(2) MR 4C 18000013 DC AL1(2) DR 4D 18060013 DC AL1(2) SVC 4E 18120013 DC AL1(2) BALR 4F 18180013 DC AL1(2) LCDR 50 18240013 DC AL1(2) SPM 51 18300013 DC AL1(2) LTR 52 18360013 DC AL1(2) LTER 53 18420013 DC AL1(2) LTDR 54 18480013 DC AL1(2) LNR 55 18540013 DC AL1(2) LNER 56 18600013 DC AL1(2) LVDR 57 18660013 DC AL1(2) LDR 58 18720013 DC AL1(2) CDR 59 18780013 DC AL1(2) ADR 5A 18840013 DC AL1(2) SDR 5B 18900013 DC AL1(2) MDR 5C 18960013 DC AL1(2) DDR 5D 19020013 DC AL1(2) AWR 5E 19080013 DC AL1(2) SWR 5F 19140013 DC AL1(2) LCER 60 19200013 DC AL1(2) CLR 61 19260013 DC AL1(2) ALR 62 19320013 DC AL1(2) SLR 63 19380013 DC AL1(2) RER 64 19440013 DC AL1(2) LPR 65 19500013 DC AL1(2) LPER 66 19560013 DC AL1(2) LPDR 67 19620013 DC AL1(2) LER 68 19680013 DC AL1(2) CER 69 19740013 DC AL1(2) AER 6A 19800013 DC AL1(2) SER 6B 19860013 DC AL1(2) MER 6C 19920013 DC AL1(2) DER 6D 19980013 DC AL1(2) AUR 6E 20040013 DC AL1(2) SUR 6F 20100013 DC AL1(5) LM 70 20160013 DC AL1(4) SLA 71 20220013 DC AL1(4) SLDA 72 20280013 DC AL1(4) SLDL 73 20340013 DC AL1(4) SLL 74 20400013 DC AL1(4) SRA 75 20460013 DC AL1(4) SRDA 76 20520013 DC AL1(4) SRDL 77 20580013 DC AL1(4) SRL 78 20640013 DC AL1(5) STM 79 20700013 DC AL1(5) BXH 7A 20760013 DC AL1(5) BXLE 7B 20820013 DC AL1(5) SL 7C 20880013 DC AL1(5) SN 7D 20940013 DC AL1(5) CL 7E 21000013 DC AL1(5) CN 7F 21060013 DC AL1(5) LX 80 21120013 DC AL1(5) BC 81 21180013 DC AL1(5) DCF 82 21240013 DC AL1(5) SX 83 21300013 DC AL1(5) BCT 84 21360013 DC AL1(5) N 85 21420013 DC AL1(5) O 86 21480013 DC AL1(5) X 87 21540013 DC AL1(5) L 88 21600013 DC AL1(5) C 89 21660013 DC AL1(5) A 8A 21720013 DC AL1(5) S 8B 21780013 DC AL1(5) M 8C 21840013 DC AL1(5) D 8D 21900013 DC AL1(5) IC 8E 21960013 DC AL1(5) BAL 8F 22020013 DC AL1(5) LH 90 22080013 DC AL1(5) CH 91 22140013 DC AL1(5) AH 92 22200013 DC AL1(5) SH 93 22260013 DC AL1(5) MH 94 22320013 DC AL1(5) STH 95 22380013 DC AL1(5) STRD 96 22440013 DC AL1(5) STD 97 22500013 DC AL1(5) LD 98 22560013 DC AL1(5) CD 99 22620013 DC AL1(5) AD 9A 22680013 DC AL1(5) SD 9B 22740013 DC AL1(5) MD 9C 22800013 DC AL1(5) DD 9D 22860013 DC AL1(5) AW 9E 22920013 DC AL1(5) CVB 9F 22980013 DC AL1(5) LA A0 23040013 DC AL1(5) CL A1 23100013 DC AL1(5) AL A2 23160013 DC AL1(5) SL A3 23220013 DC AL1(5) STC A4 23280013 DC AL1(5) ST A5 23340013 DC AL1(5) STRE A6 23400013 DC AL1(5) STE A7 23460013 DC AL1(5) LE A8 23520013 DC AL1(5) CE A9 23580013 DC AL1(5) AE AA 23640013 DC AL1(5) SE AB 23700013 DC AL1(5) ME AC 23760013 DC AL1(5) DE AD 23820013 DC AL1(5) AU AE 23880013 DC AL1(5) CVD AF 23940013 DC AL1(5) CLI B0 24000013 DC AL1(5) MVI B1 24060013 DC AL1(5) NI B2 24120013 DC AL1(5) OI B3 24180013 DC AL1(5) SSM B4 24240013 DC AL1(5) TM B5 24300013 DC AL1(5) XI B6 24360013 DC AL1(0) LA' B7 24420013 DC AL1(5) DCF2 B8 24480013 DC AL1(0) BCT' B9 24540013 DC AL1(0) BA 24600013 DC AL1(0) BB 24660013 DC AL1(5) SN2 BC 24720013 DC AL1(0) BD 24780013 DC AL1(5) ADI BE 24840013 DC AL1(0) BF 24900013 DC AL1(8) CLC C0 24960013 DC AL1(8) MVC C1 25020013 DC AL1(8) MVN C2 25080013 DC AL1(8) MVO C3 25140013 DC AL1(8) MVZ C4 25200013 DC AL1(8) NC C5 25260013 DC AL1(8) OC C6 25320013 DC AL1(8) XC C7 25380013 DC AL1(8) ZAP C8 25440013 DC AL1(8) CP C9 25500013 DC AL1(8) AP CA 25560013 DC AL1(8) SP CB 25620013 DC AL1(8) MP CC 25680013 DC AL1(8) DP CD 25740013 DC AL1(8) ED CE 25800013 DC AL1(8) EDMK CF 25860013 DC AL1(8) TR D0 25920013 DC AL1(8) TRT D1 25980013 DC AL1(8) PACK D2 26040013 DC AL1(8) UNPK D3 26100013 DC AL1(8) IGNORE D4 26160013 DC AL1(0) D5 26220013 DC AL1(0) CONV D6 26280013 DC AL1(0) D7 26340013 DC AL1(0) D8 26400013 DC AL1(0) D9 26460013 DC AL1(0) DA 26520013 DC AL1(0) DB 26580013 DC AL1(0) DC 26640013 DC AL1(0) DD 26700013 DC AL1(0) DE 26760013 DC AL1(0) DF 26820013 DC AL1(0) E0 26880013 DC AL1(0) E1 26940013 DC AL1(0) E2 27000013 DC AL1(0) E3 27060013 DC AL1(0) E4 27120013 DC AL1(0) E5 27180013 DC AL1(0) E6 27240013 DC AL1(0) E7 27300013 DC AL1(0) E8 27360013 DC AL1(0) E9 27420013 DC AL1(0) EA 27480013 DC AL1(0) EB 27540013 DC AL1(0) EC 27600013 DC AL1(0) ED 27660013 DC AL1(0) EE 27720013 DC AL1(0) EF 27780013 DC AL1(0) F0 27840013 DC AL1(0) F1 27900013 DC AL1(0) F2 27960013 DC AL1(0) F3 28020013 DC AL1(0) F4 28080013 DC AL1(0) F5 28140013 DC AL1(0) F6 28200013 DC AL1(0) F7 28260013 DC AL1(0) F8 28320013 DC AL1(0) F9 28380013 DC AL1(0) FA 28440013 DC AL1(0) FB 28500013 DC AL1(2) IGN2 FC 28560013 DC AL1(4) IGN4 FD 28620013 DC AL1(5) IGN5 FE 28680013 DC AL1(8) IGN8 FF 28740013 SPACE 1 28800013 * END OF TABLE2 28860013 * TABLE3 28920013 * TABLE3 IS A TABLE OF 256 BYTES CORRESPONDING TO 8-BIT 28980013 * PSEUDO-CODE OPERATION CODE VALUES. THE VALUE OF EACH ENTRY IN 29040013 * THE TABLE IS THE MACHINE OPERATIONCODE CORRESPONDING TO THE 29100013 * MACHINE OPERATION. 29160013 SPACE 1 29220013 TABLE3 DC X'00' DCV0 00 29280013 DC X'00' DCV1 01 29340013 DC X'00' DCV2 02 29400013 DC X'00' DCV3 03 29460013 DC X'00' DCV4 04 29520013 DC X'00' DCV8 05 29580013 DC X'00' DROP 06 29640013 DC X'00' EQU 07 29700013 DC X'00' PROC 08 29760013 DC X'00' BEGIN 09 29820013 DC X'00' STK 0A 29880013 DC X'00' EOP 0B 29940013 DC X'00' EOP2 0C 30000013 DC X'00' IPRM 0D 30060013 DC X'00' EPRM 0E 30120013 DC X'00' ITDO 0F 30180013 DC X'00' OSM1 10 30240013 DC X'00' OSM2 11 30300013 DC X'00' 12 30360013 DC X'00' DCA3 13 30420013 DC X'00' DCA4 14 30480013 DC X'00' 15 30540013 DC X'00' 16 30600013 DC X'00' 17 30660013 DC X'00' PROC' 18 30720013 DC X'00' BEGIN' 19 30780013 DC X'00' 1A 30840013 DC X'00' PLBS 1B 30900013 DC X'00' PCBS 1C 30960013 DC X'00' IPRM' 1D 31020013 DC X'00' EPRM' 1E 31080013 DC X'00' ITDO' 1F 31140013 DC X'00' 20 31200013 DC X'00' EOB 21 31260013 DC X'00' 22 31320013 DC X'00' 23 31380013 DC X'00' ADR 24 31440013 DC X'00' 25 31500013 DC X'00' 26 31560013 DC X'00' 27 31620013 DC X'00' 28 31680013 DC X'00' 29 31740013 DC X'00' 2A 31800013 DC X'00' PLBS' 2B 31860013 DC X'00' PCBS' 2C 31920013 DC X'00' 2D 31980013 DC X'00' 2E 32040013 DC X'00' 2F 32100013 DC X'00' 30 32160013 DC X'00' 31 32220013 DC X'00' 32 32280013 DC X'00' 33 32340013 DC X'00' 34 32400013 DC X'00' 35 32460013 DC X'00' 36 32520013 DC X'00' 37 32580013 DC X'00' 38 32640013 DC X'00' 39 32700013 DC X'00' 3A 32760013 DC X'00' 3B 32820013 DC X'00' 3C 32880013 DC X'00' 3D 32940013 DC X'00' 3E 33000013 DC X'00' 3F 33060013 DC X'13' LCR 40 33120013 DC X'07' BCR 41 33180013 DC X'34' HER 42 33240013 DC X'24' HDR 43 33300013 DC X'06' BCTR 44 33360013 DC X'14' NR 45 33420013 DC X'16' OR 46 33480013 DC X'17' XR 47 33540013 DC X'18' LR 48 33600013 DC X'19' CR 49 33660013 DC X'1A' AR 4A 33720013 DC X'1B' SR 4B 33780013 DC X'1C' MR 4C 33840013 DC X'1D' DR 4D 33900013 DC X'0A' SVC 4E 33960013 DC X'05' BALR 4F 34020013 DC X'23' LCDR 50 34080013 DC X'04' SPM 51 34140013 DC X'12' LTR 52 34200013 DC X'32' LTER 53 34260013 DC X'22' LTDR 54 34320013 DC X'11' LNR 55 34380013 DC X'31' LNER 56 34440013 DC X'21' LNDR 57 34500013 DC X'28' LDR 58 34560013 DC X'29' CDR 59 34620013 DC X'2A' ADR 5A 34680013 DC X'2B' SDR 5B 34740013 DC X'2C' MDR 5C 34800013 DC X'2D' DDR 5D 34860013 DC X'2E' AWR 5E 34920013 DC X'2F' SWR 5F 34980013 DC X'33' LCER 60 35040013 DC X'15' CLR 61 35100013 DC X'1E' ALR 62 35160013 DC X'1F' SLR 63 35220013 DC X'35' RER 64 35280013 DC X'10' LPR 65 35340013 DC X'30' LPER 66 35400013 DC X'20' LPDR 67 35460013 DC X'38' LER 68 35520013 DC X'39' CER 69 35580013 DC X'3A' AER 6A 35640013 DC X'3B' SER 6B 35700013 DC X'3C' MER 6C 35760013 DC X'3D' DER 6D 35820013 DC X'3E' AUR 6E 35880013 DC X'3F' SUR 6F 35940013 DC X'98' LM 70 36000013 DC X'8B' SLA 71 36060013 DC X'8F' SLDA 72 36120013 DC X'8D' SLDL 73 36180013 DC X'89' SLL 74 36240013 DC X'8A' SRA 75 36300013 DC X'8E' SRDA 76 36360013 DC X'8C' SRDL 77 36420013 DC X'88' SRL 78 36480013 DC X'90' STM 79 36540013 DC X'86' BXH 7A 36600013 DC X'87' BXLE 7B 36660013 DC X'00' SL 7C 36720013 DC X'00' SN 7D 36780013 DC X'00' CL 7E 36840013 DC X'00' CN 7F 36900013 DC X'74' LX 80 36960013 DC X'47' BC 81 37020013 DC X'00' DCF 82 37080013 DC X'77' SX 83 37140013 DC X'46' BCT 84 37200013 DC X'54' N 85 37260013 DC X'56' O 86 37320013 DC X'57' X 87 37380013 DC X'58' L 88 37440013 DC X'59' C 89 37500013 DC X'5A' A 8A 37560013 DC X'5B' S 8B 37620013 DC X'5C' M 8C 37680013 DC X'5D' D 8D 37740013 DC X'43' IC 8E 37800013 DC X'45' BAL 8F 37860013 DC X'48' LH 90 37920013 DC X'49' CH 91 37980013 DC X'4A' AH 92 38040013 DC X'4B' SH 93 38100013 DC X'4C' MH 94 38160013 DC X'40' STH 95 38220013 DC X'61' STRD 96 38280013 DC X'60' STD 97 38340013 DC X'68' LD 98 38400013 DC X'69' CD 99 38460013 DC X'6A' AD 9A 38520013 DC X'6B' SD 9B 38580013 DC X'6C' MD 9C 38640013 DC X'6D' DD 9D 38700013 DC X'6E' AW 9E 38760013 DC X'4F' CVB 9F 38820013 DC X'41' LA A0 38880013 DC X'55' CL A1 38940013 DC X'5E' AL A2 39000013 DC X'5F' SL A3 39060013 DC X'42' STC A4 39120013 DC X'50' ST A5 39180013 DC X'44' EX A6 39240015 DC X'70' STE A7 39300013 DC X'78' LE A8 39360013 DC X'79' CE A9 39420013 DC X'7A' AE AA 39480013 DC X'7B' SE AB 39540013 DC X'7C' ME AC 39600013 DC X'7D' DE AD 39660013 DC X'7E' AU AE 39720013 DC X'4E' CVD AF 39780013 DC X'95' CLI B0 39840013 DC X'92' MVI B1 39900013 DC X'94' NI B2 39960013 DC X'96' OI B3 40020013 DC X'80' SSM B4 40080013 DC X'91' TM B5 40140013 DC X'97' XI B6 40200013 DC X'00' JMP B7 40260013 DC X'00' FMT B8 40320013 DC X'00' FMT' B9 40380013 DC X'00' SN2 BA 40440013 DC X'00' OSM3 BB 40500013 DC X'00' BC 40560013 DC X'00' BD 40620013 DC X'00' ADI BE 40680013 DC X'00' BF 40740013 DC X'D5' CLC C0 40800013 DC X'D2' MVC C1 40860013 DC X'D1' MVN C2 40920013 DC X'F1' MVO C3 40980013 DC X'D3' MVZ C4 41040013 DC X'D4' NC C5 41100013 DC X'D6' OC C6 41160013 DC X'D7' XC C7 41220013 DC X'F8' ZAP C8 41280013 DC X'F9' CP C9 41340013 DC X'FA' AP CA 41400013 DC X'FB' SP CB 41460013 DC X'FC' MP CC 41520013 DC X'FD' DP CD 41580013 DC X'DE' ED CE 41640013 DC X'DF' EDMK CF 41700013 DC X'DC' TR D0 41760013 DC X'DD' TRT D1 41820013 DC X'F2' PACK D2 41880013 DC X'F3' UNPK D3 41940013 DC X'00' IGNORE D4 42000013 DC X'00' D5 42060013 DC X'00' CONV D6 42120013 DC X'00' D7 42180013 DC X'00' D8 42240013 DC X'00' D9 42300013 DC X'00' DA 42360013 DC X'00' DB 42420013 DC X'00' DC 42480013 DC X'00' DD 42540013 DC X'00' DE 42600013 DC X'00' DF 42660013 DC X'00' E0 42720013 DC X'00' E1 42780013 DC X'00' E2 42840013 DC X'00' E3 42900013 DC X'00' E4 42960013 DC X'00' E5 43020013 DC X'00' E6 43080013 DC X'00' E7 43140013 DC X'00' E8 43200013 DC X'00' E9 43260013 DC X'00' EA 43320013 DC X'00' EB 43380013 DC X'00' EC 43440013 DC X'00' ED 43500013 DC X'00' EE 43560013 DC X'00' EF 43620013 DC X'00' F0 43680013 DC X'00' F1 43740013 DC X'00' F2 43800013 DC X'00' F3 43860013 DC X'00' F4 43920013 DC X'00' F5 43980013 DC X'00' F6 44040013 DC X'00' F7 44100013 DC X'00' F8 44160013 DC X'00' F9 44220013 DC X'00' FA 44280013 DC X'00' FB 44340013 DC X'00' FC 44400013 DC X'00' FD 44460013 DC X'00' FE 44520013 DC X'00' FF 44580013 * END OF TABLE3 44640013 EJECT 44641015 * THE FOLLOWING WORK AREAS AND CONSTANTS 44642015 * HAVE BEEN TRANSFERED FROM IEMTT. THEY ALL REQUIRE 44643015 * A FULL WORD BOUNDARY 44644015 SPACE 2 44645015 * TEXT CARD BUFFER 44646015 * THE FOLLOWING 80 BYTES ARE USED AS A TEXT CARD IMAGE FOR THE 44647015 * ACCUMULATION OF INSTRUCTION TEXT AS IT IS GENERATED 44648015 SPACE 44649015 CNOP 0,4 44650015 TXTCRD DC X'02E3E7E3' 12-2-9 TXT 44651015 TXTADR DC F'0' ADDRESS COLS. 6-8 44652015 DC AL1(BLANK) BLANK 9-10 44653015 DC AL1(BLANK) 44654015 TXTLNG DC H'0' TEXT LENGTH 11-12 44655015 DC AL1(BLANK) BLANK 13-14 44656015 DC AL1(BLANK) 44657015 TXTESD DC H'1' ESDID=1 15-16 44658015 TXTVFD DC 56X'40' VAR.FIELD 17-72 44659015 TXTSEQ DC 8X'40' SEQUENCE 73-80 44660015 SPACE 44661015 * RLD CARD BUFFER 44662015 * THE FOLLOWING 80 BYTES ARE USED AS AN RLD CARD IMAGE FOR THE 44663015 * ACCUMULATION OF RELOCATION INFORMATION AS IT IS GENERATED 44664015 * DURING THE SCAN 44665015 SPACE 44666015 CNOP 0,4 44667015 RLDCRD DC X'02D9D3C4' 12-2-9 RLD 44668015 DC AL1(BLANK) BLANK 5-10 44669015 DC AL1(BLANK) 44670015 DC AL1(BLANK) 44671015 DC AL1(BLANK) 44672015 DC AL1(BLANK) 44673015 DC AL1(BLANK) 44674015 RLDLNG DC H'0' TEXT LENGTH 11-12 44675015 DC AL1(BLANK) BLANK 13-16 44676015 DC AL1(BLANK) 44677015 DC AL1(BLANK) 44678015 DC AL1(BLANK) 44679015 RLDVFD DC 56X'40' VAR.FIELD 17-72 44680015 RLDSEQ DC 8X'40' SEQUENCE 73-80 44681015 SPACE 2 44682015 RELOC1 DC F'0' FIRST RLD ENTRY 44683015 RELOC2 DC F'0' SECOND RLD ENTRY 44684015 CNZERO DC F'0' ZERO 44685015 WS1001 DC F'0' ALWAYS HAS HIGH ORDER ZERO 44686015 WS1002 DC F'0' ALWAYS HAS 2 HIGH ORDER ZEROS 44687015 CN0000 DC F'0' 44688015 SAVERR DC F'0' 44689015 EQUTXT DC F'0' 44690015 CN0003 DC F'3' MASK WITH 2 LOW ORDER ONES 44691015 CN0101 DC F'4096' 44692015 CN0103 DC F'8192' 44693015 RLDALT DC 20F'0' 44694015 EJECT 44700013 * OFFSET SUBROUTINE 44760013 SPACE 1 44820013 OFFSET ST RR,WSRR01 SAVE RETURN REGISTER, THEN PLACE 44880013 MVC DICREF(2),0(R1) DICT REF AND LITTERAL OFFSET IN 44940013 MVC LITOFF(2),0(R2) STANDARD PLACES. 45000013 SPACE 45060013 LR HR1,R1 45120013 BCTR HR1,0 POINT HR1 AT BASE REG. BYTE. 45180013 TM 0(HR1),X'80' HAS OFFSET BEEN EVALUATED 45240013 BC BO,ADDLTF YES 45300013 SPACE 45360013 SPACE 1 45420013 LH HR1,DICREF 45480013 LTR HR2,HR1 TEST DICT REF AND BRANCH IF ZERO 45540013 BC BZ,OF0001 IE NO REFERENCE 45600013 SPACE 1 45660013 N HR1,CN0003 ISOLATE 2 LOW-ORDER BITS OF DICT 45720013 STC HR1,DICOFF REF AND SAVE. CLEAR LOW ORDER 2 45780013 XR HR2,HR1 BITS FROM DICREF 45840013 STH HR2,DICREF 45900013 SPACE 1 45960013 STH HR2,PAR1+2 ACCESS DICTIONARY ENTRY 46020013 L LR,ZRFAOF 46080013 BALR RR,LR 46140013 L R1,PAR1 R1 NOW ADDRESSES DICT ENTRY 46200013 SPACE 1 46260013 SR HR1,HR1 46320013 IC HR1,0(0,R1) PICK UP IDENTIFICATION CODE OF 46380013 IC HR1,TABLE6(HR1) DICT ENTRY. GET TABLE6 CODE USING 46440013 EX 0,OFBASE(HR1) DICTIONARY ENTRY. USE THE CODE TO 46500013 * ENTER APPROPRIATE SEGMENT OF CODE 46560013 SPACE 1 46620013 * LIST OF ENTRIES TO ROUTINES WHICH OBTAIN OFFSETS ON THE 46680013 * BASIS OF DICT ENTRY TYPE AND DICT REF OFFSET. 46740013 OFBASE EQU * 46800013 OFERR BC B,OF0010 ERROR 46860013 OFCSL BC B,OF0011 COMPILER OR STATEMENT LABEL 46920013 OFET1 BC B,OF0012 ENTRY TYPE 1 46980013 OFET2 BC B,OF0013 2 47040013 OFET3 BC B,OF0014 3 47100013 OFET4 BC B,OF0015 4 47160013 OFET5 BC B,OF0016 5 47220013 OFEN1 BC B,OF0017 ENTRY ENTRY TYPE 1 47280013 OFEL BC B,OF0018 ENTRY LABEL 47340013 OFBIF BC B,OF0019 47400013 OFGEP BC B,OF0020 GENERIC ENTRY POINT 47460013 OFBGN BC B,OF0021 BEGIN BLOCK 47520013 OFLIB BC B,OF0022 LIBRARY ROUTINE 47580013 OFBGL BC B,OF0023 BUILT-IN GENERIC 47640013 OFLV BC B,OF0024 LABEL VARIABLE 47700013 OFTSK BC B,OF0025 TASK IDENTIFIER 47760013 OFDAT BC B,OF0026 DATA VARIABLE 47820013 OFFIL BC B,OF0027 FILE 47880013 OFON1 BC B,OF0028 ON CONDITION 47940013 OFON2 BC B,OF0029 ON CONDITION 48000013 OFONL BC B,OF0030 ON LIST 48060013 OFPL BC B,OF0031 PARAMETER LIST 48120013 OFDV BC B,OF0032 DOPE VECTOR 48180013 OFSTD BC B,OF0033 SYMBOL TABLE ENTRY OR DED 48240013 OFDED BC B,OF0034 DED2 48300013 OFFP BC B,OF0035 FORMAL PARAMETER 48360013 OFPSV BC B,OF0036 PSEUDO-VARIABLE 48420013 OFCON BC B,OF0037 CONSTANT 48480013 OFSTR BC B,OF0038 STRUCTURE ITEM 48540013 OFSTAT BC B,OF0039 STATIC CHAIN HEAD 48600013 OFWS BC B,OF0040 WORKSPACE 48660013 OFSVRS BC B,OF0041 SAVE/RESTORE 48720013 OFINV BC B,OF0042 INVOCATION COUNTER 48780013 OFSDV BC B,OF0043 SDV FOR TEMPORARY 48840013 OFBCD BC B,OF0044 LABEL BCD 48900013 OFFLV BC B,OF0045 FILE VARIABLE 48960013 OFOCB BC B,OF0046 OPEN CONTROL BLOCK 49020013 EJECT 49080013 * COMMON RETURN SECTION-NO RLD 49140013 SPACE 1 49200013 OF0006 MVC WSOF00+1(3),OFFST1(R1) COPY OFFSET 1 FIELD FROM DICT 49260013 * ENTRY INTO WSOF00 49320013 OF0000 L HR1,WSOF00 49380013 * HR1 CONTAINS OFFSET OBTAINED FROM DICT ENTRY 49440013 SPACE 1 49500013 OF0001 AH HR1,LITOFF ADD THE LITTERAL OFFSET TO THAT 49560013 ST HR1,OFFST0 OBTAINED FROM THE DICTIONARY, AND 49620013 MVI WSOF00,0 CLEAR HIGH BYTE OF WSOF00 49680013 L RR,WSRR01 RESTORE REGISTER AND 49740013 BC B,4(0,RR) RETURN 49800013 SPACE 2 49860013 * COMMON RETURN SECTION-RLD REQUIRED 49920013 OF0003 L HR1,WSOF00 49980013 * HR1 CONTAINS ESID OF RELOCATION SECTION IN LOW ORDER 50040013 SPACE 1 50100013 OF0008 MVI RELOC0+2,X'24' SET PSEUDO-REG FLAG BITS. ENTRY 50160013 * FOR INVOCATION COUNT 50220013 SPACE 1 50280013 OF0002 STH HR1,RELOC0 ENTRY FROM STATIC INTERNAL REF 50340013 * SET RELOCATION ID 50400013 LH HR1,LITOFF 50460013 LTR HR1,HR1 TEST LITTERAL OFFSET AND BRANCH 50520013 BC BNZ,OF0005 IF NON-ZERO (ERROR) 50580013 SPACE 1 50640013 OF0004 ST HR1,OFFST0 SET OFFST0=0 AND RETURN TO 0,RR 50700013 MVI RELOC0+3,0 CLEAR OFFSET BYTE 50760013 L RR,WSRR01 50820013 BCR B,RR 50880013 SPACE 1 50940013 OF0005 L HR1,ERID01 ERROR. LITTERAL OFFSET NON-ZERO 51000013 BAL RR,ERRMSG WHEN RLD REQUIRED 51060013 BC B,OF0004 51120013 EJECT 51180013 ADDLTF LH HR1,DICREF OFFSET IN DICREF 51240013 BC B,OF0001 51300013 * ERROR SECTION. DICTIONARY ENTRY CODE 51360013 * NOT RECOGNIZED. 51420013 SPACE 1 51480013 OF0010 L HR1,ERID02 MAKE SERIOUS ERROR ENTRY. 51540013 BAL RR,ERRMSG 51600013 BC B,OF0001 RETURN SECTION. 51660013 EJECT 51720013 * COMPILER AND STATEMENT LABELS 51780013 SPACE 1 51840013 OF0011 TM DICOFF,X'03' TEST DICT REF OFFSET 51900013 BC BZ,OF1101 00 INDICATES LABEL LOCATION 51960013 BC BO,OF1102 11 INDICATES STATIC ADCON 52020013 SPACE 1 52080013 TM DICOFF,X'01' 52140013 BC BNZ,OF1104 52200013 SPACE 1 52260013 OF1103 L HR1,ERID03 2= ERROR. MAKE ERROR 52320013 BAL RR,ERRMSG ENTRY AND RETURN 52380013 BC B,OF0001 52440013 SPACE 1 52500013 OF1101 MVC WSOF00+1(3),CSLOFS(R1) LABEL LOCATION OFFSET 52560013 TM CSLOT1(R1),OT1ASG TEST ASSIGNED BIT AND GO TO 52620013 BC BNZ,OF0000 NORMAL RETURN IF ON, I.E. LABEL 52680013 * HAS BEEN DEFINED 52740013 CLI 0(R1),SLCODE TEST FOR STATEMENT LABEL ENTRY 52800013 BC BE,OF0000 TREAT AS DEFINED IF SLBECAUSE AN 52860013 * ERROR MESSAGE WILL HAVE BEEN 52920013 * GENERATED EARLIER 52980013 L HR1,ERID08 FOR AN UNDEFINED LABEL TERMINATE 53040013 BAL RR,ERRMSG COMPILATION AFTER MAKING ERROR 53100013 L LR,ZABTOF ENTRY 53160013 BALR RR,LR 53220013 SPACE 1 53280013 OF1102 MVC WSOF00+1(3),CSLSIO(R1) STATIC ADCON OFFSET 53340013 BC B,OF0000 53400013 SPACE 1 53460013 OF1104 MVC PAR1+2(2),CSLSTN(R1) 1= BCD OFFSET 53520013 L LR,ZRFAOF GET DICT ENTRY OF LABEL BCD 53580013 BALR RR,LR (REFERENCED VIA STAT NO SLOT) AND 53640013 L R1,PAR1 USE OFFSET 1 VALUE 53700013 BC B,OF0006 53760013 EJECT 53820013 * PROCEDURE ENTRY TYPE 1 53880013 SPACE 1 53940013 OF0012 TM DICOFF,X'03' TEST REFERENCE OFFSET 54000013 BC BZ,OF1203 0=APPARENT ENTRY 54060013 BC BO,OF1205 54120013 SPACE 1 54180013 OF1201 TM DICOFF,X'01' ENTRY FROM BEGIN BLOCK 54240013 BC BZ,OF1202 54300013 SPACE 1 54360013 MVC PAR1+2(2),ET1SYM(R1) 1=SYMBOL TABLE ADDRESS 54420013 L LR,ZRFAOF 54480013 BALR RR,LR GET DICT ENTRY OF SYMBOL TABLE 54540013 L HR1,PAR1 ASSUME FOR THE MOMENT THAT CORRECT 54600013 MVC WSOF00+1(3),SYMOFS(HR1) PLACE STATIC OFFSET IN WSOF00 54660013 BC B,OF0000 54720013 SPACE 1 54780013 OF1202 MVC WSOF00+2(2),ET1ESD(R1) 2=ESID. REFERENCE TO DISPL. 54840013 BC B,OF0003 54900013 SPACE 1 54960013 OF1205 MVC WSOF00+1(3),ET1RSW(R1) 3= AUTO OFFSET OF RETURN 55020013 BC B,OF0000 SWITCH 55080013 SPACE 1 55140013 OF1203 MVC WSOF00+1(3),ET1LC4(R1) 0=APPARENT ENTRY 55200013 BC B,OF0000 55260013 SPACE 3 55320013 * BEGIN BLOCK ENTRY 55380013 SPACE 1 55440013 OF0021 TM DICOFF,X'03' TEST REFERENCE OFFSET 55500013 BC BM,OF1201 1,2 SAME AS FOR PROC ET1 55560013 BC B,OF1103 0,3= ERROR 55620013 EJECT 55680013 * ENTRY TYPE 2 55740013 SPACE 1 55800013 OF0013 CLI DICOFF,2 55860013 BC BNE,OF1103 0,1 AND 3= ERROR 55920013 SPACE 1 55980013 MVC PAR1+2(2),ET2DED(R1) 2= DED OF FUNCTION VALUE 56040013 BC B,OF1503 GET DED REFERENCE, THEN TREAT 56100013 * ET4(+2) 56160013 SPACE 3 56220013 * ENTRY TYPE 3 56280013 SPACE 1 56340013 OF0014 TM DICOFF,X'03' TEST DICTIONARY REF OFFSET 56400013 BC BM,OF1402 56460013 BC BO,OF1103 3= ERROR 56520013 SPACE 1 56580013 MVC PAR1+2(2),ET3ET1(R1) 0 IMPLIES AN OFFSET IN THE 56640013 OF1404 L LR,ZRFAOF THE PROCEDURE ET1 56700013 BALR RR,LR GET ET1 ENTRY CORRESPONDING TO 56760013 L HR1,PAR1 THIS ET3 AND GET OFFSET FROM ET1 56820013 MVC PAR1+2(2),EN1ET1(HR1) 56880013 CLI 0(HR1),EN1COD IF EN1 CONTINUE ROUND EN1-ET1 56940013 BC BE,OF1404 LOOP. OTHERWISE FALL THROUGH 57000013 SPACE 1 57060013 MVC WSOF00+1(3),ET1AFV(HR1) 0= ADCON FOR FUNCTION VALUE 57120013 BC B,OF0000 SLOT 57180013 SPACE 1 57240013 OF1402 TM DICOFF,X'01' 57300013 BC BZ,OF1103 2= ERROR 57360013 SPACE 1 57420013 MVC WSOF00+1(3),ET3FVR(R1) 1=FUNCTION VALUE SLOT 57480013 BC B,OF0000 57540013 SPACE 3 57600013 * ENTRY TYPE 4 57660013 SPACE 1 57720013 OF0015 TM DICOFF,X'03' 57780013 BC BZ,OF1501 57840013 BC BO,OF1103 3=ERROR 57900013 SPACE 1 57960013 TM DICOFF,X'01' 58020013 BC BZ,OF1502 58080013 SPACE 1 58140013 MVC WSOF00+1(3),ET4FVR(R1) 1= FUNCTION VALUE SLOT 58200013 BC B,OF0000 58260013 SPACE 1 58320013 OF1502 MVC PAR1+2(2),ET4DED(R1) 2=FUNCTION VALUE DED 58380013 OF1503 L LR,ZRFAOF ENTRY FROM ET3(+2). GET DICT 58440013 BALR RR,LR ENTRY OF DED.MOVE STATIC OFFSET 58500013 L HR1,PAR1 OF DED INTO WORKSPACE 58560013 BC B,OF0006 58620013 SPACE 1 58680013 OF1501 MVC WSOF00+1(3),OFFST1(R1) 0=ADCON OF ENTRY. ENTRY 58740013 BC B,OF0000 FROM ET5 AND EL. 58800013 SPACE 3 58860013 * ENTRY TYPE 5 58920013 SPACE 1 58980013 OF0016 EQU OF0015 SAME AS ENTRY TYPE 4 59040013 SPACE 3 59100013 * ENTRY ENTRY TYPE 1 59160013 SPACE 1 59220013 OF0017 TM DICOFF,X'03' 59280013 BC BNZ,OF1103 1,2 AND 3 ARE ERRORS 59340013 SPACE 1 59400013 MVC WSOF00+1(3),EN1OFS(R1) 0=APPARENT ENTRY POINT 59460013 BC B,OF0000 59520013 SPACE 3 59580013 * ENTRY LABEL 59640013 SPACE 1 59700013 OF0018 TM DICOFF,X'03' 59760013 BC BZ,OF1501 0=STATIC ADCON 59820013 BC BO,OF1801 59880013 SPACE 1 59940013 TM DICOFF,X'01' 60000013 BC BNZ,OF1104 1= LABEL BCD 60060013 BC B,OF1103 2= ERROR 60120013 SPACE 1 60180013 OF1801 MVC WSOF00+1(3),ELOFFS(R1) 3= REAL ENTRY POINT. THIS 60240013 MVC PAR1+2(2),ELET2(R1) 60300013 L LR,ZRFAOF CAN APPEAR ONLY IN DCA4 PSEUDO 60360013 BALR RR,LR CODE ITEMS IN PROLOGUES. WHAT IS 60420013 L R1,PAR1 REQUIRED IS THE OFFSET FROM THE 60480013 MVC PAR1+2(2),ET2ET3(R1) 60540013 L LR,ZRFAOF CONTROL SECTION ORIGIN OF THE 60600013 BALR RR,LR ENTRY LABEL PLUS AN RLD REQUIRED 60660013 L R1,PAR1 RETURN 60720013 MVC PAR1+2(2),ET3ET1(R1) 60780013 OF1803 L LR,ZRFAOF AFTER AN EL-ET2-ET3-ET1 CHAIN 60840013 BALR RR,LR R1 NOW ADDRESSES AN ENTRY TYPE 1 60900013 L R1,PAR1 60960013 SPACE 1 61020013 CLI 0(R1),EN1COD TEST AND BRANCH IF ENTRY ET1 TO 61080013 BC BE,OF1802 GO ROUND ET1-EN1 LOOP 61140013 SPACE 1 61200013 L HR1,WSOF00 FOR PROCEDURE ET1 GET LOCN5 61260013 MVC WSOF00+1(3),ET1LC5(R1) 61320013 A HR1,WSOF00 ADD THE VALUE OF LOCN5 (TRUE 61380013 * OFFSET OF PROCEDURE) TO ENTRY 61440013 * LABEL OFFSET 61500013 LA HR2,1 61560013 STH HR2,RELOC0 RELOC0 SLOT SET 4-BYTE NON-BRANCH 61620013 MVI RELOC0+2,X'0C' TYPE LOAD CONST THEN GO TO 61680013 BC B,OF0004 RLD RETURN 61740013 SPACE 1 61800013 OF1802 MVC PAR1+2(2),EN1ET1(R1) 61860013 BC B,OF1803 GO ROUND PROCEDURE-ENTRY CHAIN 61920013 * LOOKING FOR PROCEDURE ET1 61980013 SPACE 3 62040013 * GENERIC ENTRY POINT 62100013 SPACE 1 62160013 OF0020 EQU OF0010 GENERIC ENTRY POINT NOT 62220013 * EXPECTED IN PSEUDO CODE TEXT 62280013 SPACE 3 62340013 * BUILT-IN GENERIC LABEL 62400013 SPACE 1 62460013 OF0023 EQU OF0010 BUILT IN GENERIC LABEL NOT 62520013 * EXPECTED IN PSEUDO CODE TEXT 62580013 SPACE 3 62640013 * PSEUDO VARIABLE 62700013 SPACE 1 62760013 OF0036 EQU OF0010 PSEUDO-VARIABLE REFERENCE NOT 62820013 * EXPECTED IN PSEUDO CODE TEXT 62880013 EJECT 62940013 * LABEL VARIABLES AND TASK IDENTIFIERS 63000013 * FILE VARIABLES 63060013 SPACE 1 63120013 OF0024 EQU * LABEL VARIABLE 63180013 OF0025 EQU * TASK IDENTIFIER 63240013 OF0045 EQU * FILE VARIABLE 63300013 CLI DICOFF,2 63360013 BC BE,OF1103 2= ERROR SINCE NO DED 63420013 SPACE 1 63480013 OF2401 LA HR2,6 SET -6 IN HR2. THIS IS TO ALLOW 63540013 LCR HR2,HR2 USE OF TABLE7 IN CONJUNCTION WITH 63600013 BC B,OF2601 THE VARIABLE BYTE, FOR BOTH LABEL 63660013 * AND DATA VARIABLES 63720013 SPACE 3 63780013 * DATA VARIABLES 63840013 SPACE 1 63900013 OF0026 SR HR2,HR2 SET HR2=0 TO INDICATE DATA 63960013 * VARIABLE IN ENSUEING CODE 64020013 SPACE 1 64080013 OF2601 TM OFSOT2(R1),OT2SC2 ENTRY FROM LABEL, TASK, EVENT 64140013 BC BNO,OF2605 AND FILE VARIABLE ENTRIES. TEST 64200013 * TO SEE IF THE ENTRY REPRESENTS 64260013 TM OFSVAR(R1),VARALC AN ALLOCATION, AND, IF SO, CHAIN 64320013 BC BZ,OF2605 BACK TO THE ORIGINAL ENTRY TO 64380013 * OBTAIN THE REQUIRED OFFSETS 64440013 TM OFSVAR(R1),X'02' 64460015 BC BO,OF2605 64480015 SR HR1,HR1 ALLOCATED ENTRY. GET REF FROM 64500013 IC HR1,2(0,R1) VARIABLE FIELD 64560013 BCTR HR1,0 SUBTRACT 4 64620013 BCTR HR1,0 64680013 BCTR HR1,0 64740013 BCTR HR1,0 64800013 LA HR1,0(HR1,R1) HR1 NOW ADDRESSES ORIGINAL 64860013 * ENTRY REFERENCE 64920013 LTR HR2,HR2 64980013 BC BNM,OF2608 65040013 SPACE 1 65100013 BCTR HR1,0 IF HR2 -VE., IE LABEL, FILE, 65160013 BCTR HR1,0 TASK OR EVENT THEN SUBTRACT A 65220013 * FURTHER 2 TO ALLOW FOR SYMBOL SLOT 65280013 OF2608 MVC PAR1+2(2),0(HR1) 65340013 L LR,ZRFAOF GET ENTRY ADDRESS 65400013 BALR RR,LR 65460013 L R1,PAR1 65520013 SPACE 1 65580013 OF2605 CLI DICOFF,2 R1 ADDRESSES CORRECT ENTRY 65640013 BC BE,OF2604 BRANCH IF OFFSET=2 IE DED 65700013 SPACE 1 65760013 TM DICOFF,X'03' TEST OFFSET 65820013 BC BZ,OF2602 65880013 BC BM,OF2603 65940013 SPACE 1 66000013 TM OFSOT2(R1),OT2FP TEST FOR FORMAL PARAMETER 66060013 BC BNZ,OF0006 BRANCH TO USE OFFSET 1 IF IT IS 66120013 SPACE 1 66180013 TM OFSOT2(R1),OT2SC2 TEST FOR CONTROLLED 66240013 BC BNO,OF0006 BRANCH IF NOT CONTROLLED 66300013 TM OFSVAR(R1),X'02' IS IT BASED VARIABLE 66310015 BC BO,OF0006 YES 66320015 SPACE 66330015 SPACE 1 66360013 SR HR1,HR1 FOR CONTROLLED, GET ESID OF 66420013 IC HR1,2(0,R1) PSEUDO-REGISTER (LENGTH IS LESS 66480013 BCTR HR1,0 THAN 256 FOR DATA ITEMS) 66540013 BCTR HR1,0 SET UP ADDRESS OF ESID FIELD IN 66600013 LA HR1,0(HR1,R1) HR1, THEN MOVE ESID TO TEMPORARY 66660013 MVC WSOF00+2(2),0(HR1) AND GO TO RLD COMMON RETURN 66720013 BC B,OF0003 66780013 SPACE 1 66840013 OF2602 TM OFSOT3(R1),OT3SGN 0= ACTUAL OFFSET OR VIRTUAL 66900013 BC BZ,OF0006 ORIGIN. TEST FOR -VE OFFSET AND 66960013 * GO TO NORMAL OFFSET 1 EXIT IF NOT 67020013 MVC WSOF00+1(3),OFFST1(R1) IF -VE., THEN 67080013 L HR1,WSOF00 LOAD HR1 WITH -OFFSET1, THEN GO 67140013 LCR HR1,HR1 TO EXIT ROUTINE. 67200013 BC B,OF0001 67260013 SPACE 1 67320013 OF2603 TM OFSVAR(R1),VARAD2 1= OFFSET OF DOPE VECTOR. USE 67380013 BC BZ,OF2606 OFFSET 2, AFTER CHECKING 67440013 SPACE 1 67500013 LNR HR2,HR2 MAKE HR2 -VE. (MAY BE +VE. FOR 67560013 * ENTRY FOR STRUCTURE MEMBER) 67620013 LA HR1,DATVAR(HR2,R1) HR1 ADDRESSES FIRST BYTE OF 67680013 MVC WSOF00+1(3),1(HR1) VARIABLE FIELD. COPY OFFSET INTO 67740013 BC B,OF0000 TEMPORARY. 67800013 SPACE 1 67860013 OF2606 L HR1,ERID04 ERROR IF OFFSET 2 FIELD NOT USED 67920013 BAL RR,ERRMSG MAKE ERROR ENTRY AND RETURN 67980013 BC B,OF0001 68040013 SPACE 1 68100013 OF2604 TM OFSOT1(R1),OT1SYM 2= DED OFFSET REQUESTED. THIS 68160013 BC BO,OF2607 SECTION IS ENTERED ONLY FOR DATA 68220013 TM OFSOT3(R1),OT3DED VARIABLE. 68280013 BC BZ,OF2606 ERROR IF NEITHER SYMBOL NOR DED 68340013 * BIT IS ON. 68400013 OF2607 MVC PAR1+2(2),DATSYM(R1) 68460013 L LR,ZRFAOF 68520013 BALR RR,LR GET DED ENTRY ADDRESS, THEN USE 68580013 L R1,PAR1 OFFSET 1 SLOT OF ENTRY. 68640013 BC B,OF0006 68700013 SPACE 3 68760013 * STRUCTURE ITEMS 68820013 SPACE 1 68880013 OF0038 TM DICOFF,X'01' 68940013 BC BZ,OF1103 0,2 =ERROR FOR STRUCTURE ITEM 69000013 SPACE 1 69060013 LA HR2,6 CASES 1 AND 3 MAY BE TREATED 69120013 BC B,OF2601 AS DATA VARIABLES EXCEPT FOR THE 69180013 * POSITION OF VARIABLE FIELD. 69240013 SPACE 3 69300013 * FILE CONSTANT 69360013 SPACE 1 69420013 OF0027 TM DICOFF,X'03' 0= STATIC OFFSET (INTERNAL) 69480013 BC BM,OF1103 3= ADCON OFFSET (EXTERNAL) REST 69540013 BC B,OF0006 ERROR 69600013 EJECT 69660013 * SDV FOR TEMPORARIES,DED2,LIBRARY FUNCTIONS, 69720013 * PREFIX ON LIST,DOPE VECTOR SKELETONS, 69780013 * WORKSPACE, SAVE/RESTORE, LABEL BCD, ON ENTRY, 69840013 * BUILT-IN FUNCTION 69900013 SPACE 1 69960013 * ALL OF THE ABOVE ENTRIES HAVE THE COMMON PROPERTY OF 70020013 * ONE OFFSET (IN OFFSET 1) REFERRED TO BY DICT.REF+0 70080013 SPACE 1 70140013 OF0028 EQU * 70200013 OF0029 EQU * 70260013 OF0030 EQU * PREFIX ON 70320013 OF0031 EQU * PARAMETER LIST 70380013 OF0032 EQU * DOPE VECTOR SKELETON 70440013 OF0034 EQU * DED2 70500013 OF0040 EQU * WORKSPACE 70560013 OF0041 EQU * SAVE/RESTORE 70620013 OF0019 EQU * BUILT-IN FUNCTION 70680013 OF0022 EQU * LIBRARY FUNCTION 70740013 OF0044 EQU * LABEL BCD 70800013 OF0046 EQU * OPEN CONTROL BLOCK 70860013 TM DICOFF,X'03' 70920013 BC BZ,OF0006 0= OFFSET 1 FIELD REQUIRED 70980013 BC B,OF1103 1,2 OR 3= ERROR 71040013 SPACE 3 71100013 SPACE 1 71160013 * SYMBOL TABLE 71220013 SPACE 1 71280013 OF0033 EQU * SYMBOL TABLE 71340013 TM DICOFF,X'03' 71400013 BC BNZ,OF1103 1,2 AND 3= ERROR 71460013 SPACE 1 71520013 MVC WSOF00+1(3),SYMOFS(R1) 0= SYMBOL TABLE OFFSET 71580013 BC B,OF0000 71640013 SPACE 3 71700013 * FORMAL PARAMETER 71760013 SPACE 1 71820013 OF0035 EQU OF0010 ERROR. FORMAL PARAMETER TYPE 1 71880013 * SHOULD NOT APPEAR IN SOURCE TEXT 71940013 SPACE 3 72000013 * STATIC AND PROLOGUE WORKSPACE 72060013 * EXECUTION ERROR PSEUDO-REGISTER 72120013 SPACE 1 72180013 OF0039 TM DICOFF,X'03' 72240013 BC BM,OF3901 72300013 BC BO,OF3902 72360013 SPACE 1 72420013 LA HR1,ESIDSI 0= ADDRESS OF STATIC. THIS 72480013 * APPERARS ONLY AS OPERAND OF DCA4 72540013 MVI RELOC0+2,X'0C' IT IMPLIES OFFSET 0, RLD POINTER 72600013 BC B,OF0002 TO CONTROL SECTION 2 72660013 SPACE 1 72720013 OF3901 MVC PAR1+2(2),WSBLOK 72780013 L LR,ZRFAOF USE THE REFERENCE IN WSBLOK TO 72840013 BALR RR,LR ACCESS DICTIONARY ENTRY TYPE 1 OF 72900013 L R1,PAR1 CURRENT BLOCK 72960013 SPACE 1 73020013 MVC WSOF00+1(3),ET1CA1(R1) 73080013 TM DICOFF,X'01' 73140013 BC BNZ,OF0000 1= ALLOCATION WORKSPACE 73200013 MVC WSOF00+1(3),ET1CA2(R1) 2= BUY/SELL WORKSPACE 73260013 CLI 0(R1),BGNCOD 73320013 BC BNE,OF0000 RETURN UNLESS BEGIN BLOCK, IN 73380013 MVC WSOF00+1(3),BGNCA2(R1) WHICH CASE USE DIFFERENT OFFSET 73440013 BC B,OF0000 THEN RETURN 73500013 SPACE 1 73560013 OF3902 LA HR1,ESIDER 3= EXEP PSEUDO-REGISTER 73620013 BC B,OF0008 USE STANDARD ESID OF 6. 73680013 SPACE 3 73740013 * CONSTANT 73800013 SPACE 1 73860013 OF0037 TM DICOFF,X'03' 73920013 BC BZ,OF0006 0= OFFSET OF CONSTANT. 73980013 BC BO,OF1103 3= ERROR. 74040013 SPACE 1 74100013 TM DICOFF,X'01' 74160013 BC BZ,OF3701 74220013 SPACE 1 74280013 MVC WSOF00+1(3),OFFST1(R1) 1= DOPE VECTOR OFFSET. THIS 74340013 L HR1,WSOF00 IS 8 LESS THAN THE OFFSET OF THE 74400013 SH HR1,CN0008 CONSTANT ITSELF 74460013 BC B,OF0001 74520013 SPACE 1 74580013 OF3701 MVC PAR1+2(2),CONDED(R1) 2= DED OFFSET. 74640013 L LR,ZRFAOF GET DICTIONARY ENTRY OF DED. THE 74700013 BALR RR,LR OFFSET 1 FIELD OF THE DED ENTRY 74760013 L R1,PAR1 CONTAINS THE REQUIRED OFFSET VALUE 74820013 BC B,OF0006 74880013 SPACE 3 74940013 * INVOCATION COUNT 75000013 SPACE 1 REFERENCE TO INVOCATION COUNT 75060013 OF0042 EQU * 75080015 TM DICOFF,X'01' 75100015 BC BO,OF0050 75120015 LA HR1,ESIDIC 75140015 BC B,OF0008 75160015 OF0050 LA HR1,ESDQTC 75180015 BC B,OF0008 75200015 SPACE 3 75240013 * DOPE VECTOR TEMPORARY 75300013 SPACE 1 75360013 OF0043 TM DICOFF,X'03' 75420013 BC BZ,OF4301 75480013 BC BO,OF1103 3= ERROR 75540013 SPACE 1 75600013 TM DICOFF,X'01' 75660013 BC BZ,OF1103 2= ERROR 75720013 BC B,OF0006 1= DOPE VECTOR OFFSET (IN 75780013 * OFFSET 1 FIELD) 75840013 SPACE 1 75900013 OF4301 MVC PAR1+2(2),DVSKDV(R1) 0= VIRTUAL ORIGIN OR STRING 75960013 L LR,ZRFAOF ORIGIN. GET SKELETON DOPE VECTOR 76020013 BALR RR,LR ENTRY AND OBTAIN ORIGIN. 76080013 L R1,PAR1 76140013 MVC WSOF00+1(3),SKDOFS+1(R1) 76200013 BC B,OF0000 76260013 EJECT 76320013 * ERROR MESSAGE SUBROUTINE ERRMSG 76380013 * ON ENTRY HR1 CONTAINS THE ERROR MESSAGE CODE. AN ERROR 76440013 * ENTRY IS MADE IN THE DICTIONARY 76500013 SPACE 1 76560013 ERRMSG ST RR,WSRR02 SAVE RETURN REGISTER 76620013 ST HR1,PAR6 76680013 L LR,ZUEROF MAKE ERROR ENTRY 76740013 BALR RR,LR 76800013 L RR,WSRR02 76860013 SR HR1,HR1 CLEAR HR1 76920013 BCR B,RR RETURN 76980013 CNOP 0,4 77040013 ERID01 DC X'00' 77100013 DC AL2(ERCD01) 77160013 DC AL1(SERROR) 77220013 ERID02 DC X'00' 77280013 DC AL2(ERCD02) 77340013 DC AL1(SERROR) 77400013 ERID03 DC X'00' 77460013 DC AL2(ERCD03) 77520013 DC AL1(SERROR) 77580013 ERID04 DC X'00' 77640013 DC AL2(ERCD04) 77700013 DC AL1(SERROR) 77760013 ERID08 DC X'00' 77820013 DC AL2(ERCD08) 77880013 DC AL1(TERROR) 77940013 ERCD01 EQU X'0B44' PSEUDO-REG AND NON-ZERO OFFSET 78000013 ERCD02 EQU X'0B45' UNRECOGNIZABLE DICTIONARY ENTRY 78060013 ERCD03 EQU X'0B46' INVALID DICT.REF. OFFSET 78120013 ERCD04 EQU X'0B47' REQUESTED OFFSET NOT ASSIGNED 78180013 ERCD08 EQU X'0B48' UNDEFINED LABEL. 78240013 SPACE 1 78300013 SERROR EQU X'44' 78360015 TERROR EQU X'40' TERMINAL ERROR CODE 78420015 SPACE 2 78480013 WSOF00 DC F'0' 78600013 CN0008 DC H'8' 78660013 DICREF DC H'0' DICT REF 78720013 DICOFF DC H'0' DICT REF OFFSET (0,1,2 OR 3) 78780013 LITOFF DC H'0' LITTERAL OFFSET 78840013 * DEFINITION ON SYMBOLS USED IN TABLE6 78900013 CSL EQU OFCSL-OFBASE 78960013 ET1 EQU OFET1-OFBASE 79020013 ET2 EQU OFET2-OFBASE 79080013 ET3 EQU OFET3-OFBASE 79140013 ET4 EQU OFET4-OFBASE 79200013 ET5 EQU OFET5-OFBASE 79260013 EN1 EQU OFEN1-OFBASE 79320013 EL EQU OFEL-OFBASE 79380013 BIF EQU OFBIF-OFBASE 79440013 GEP EQU OFGEP-OFBASE 79500013 BGN EQU OFBGN-OFBASE 79560013 LIB EQU OFLIB-OFBASE 79620013 BGL EQU OFBGL-OFBASE 79680013 LV EQU OFLV-OFBASE 79740013 TSK EQU OFTSK-OFBASE 79800013 EVNT EQU TSK 79860013 DAT EQU OFDAT-OFBASE 79920013 FIL EQU OFFIL-OFBASE 79980013 ON1 EQU OFON1-OFBASE 80040013 ON2 EQU OFON2-OFBASE 80100013 ONL EQU OFONL-OFBASE 80160013 PL EQU OFPL-OFBASE 80220013 DV EQU OFDV-OFBASE 80280013 STD EQU OFSTD-OFBASE 80340013 DED EQU OFDED-OFBASE 80400013 FP EQU OFFP-OFBASE 80460013 PSV EQU OFPSV-OFBASE 80520013 CON EQU OFCON-OFBASE 80580013 STR EQU OFSTR-OFBASE 80640013 STAT EQU OFSTAT-OFBASE 80700013 WS1 EQU OFWS-OFBASE 80760013 WS2 EQU WS1 80820013 WS3 EQU WS1 80880013 SVRS EQU OFSVRS-OFBASE 80940013 INV EQU OFINV-OFBASE 81000013 SDV EQU OFSDV-OFBASE 81060013 BCD EQU OFBCD-OFBASE 81120013 FLV EQU OFFLV-OFBASE 81180013 OCB EQU OFOCB-OFBASE 81240013 SPACE 1 81300013 * TABLE6 81360013 * THIS IS A TABLE OF DICTIONARY ENTRY CODES AND ROUTINE 81420013 * ENTRY POINTS. 81480013 SPACE 1 81540013 TABLE6 DC AL1(CSL) 00 STATEMENT LABEL CONSTANT 81600013 DC AL1(EL) 01 ENTRY LABEL 81660013 DC X'00' 81720013 DC AL1(ET4) 03 ENTRY TYPE 4 81780013 DC AL1(BIF) 04 BUILT IN FUNCTION 81840013 DC X'00' 81900013 DC AL1(BGL) 06 BUILT-IN GENERIC LABEL 81960013 DC AL1(LV) 07 LABEL VARIABLE 82020013 DC AL1(FIL) 08 FILE CONSTANT 82080013 DC X'00' 82140013 DC 2X'00' 82200013 DC AL1(TSK) 0C TASK IDENTIFIER 82260013 DC AL1(EVNT) 0D EVENT 82320013 DC X'00' 82380013 DC AL1(DAT) 0F DATA VARIABLE 82440013 DC 7X'00' 82500013 DC AL1(LV) 17 LABEL VAR 82560013 DC 4X'00' 82620013 DC AL1(TSK) 1C TASK IDENTIFIER 82680013 DC AL1(EVNT) 1D EVENT 82740013 DC X'00' 82800013 DC AL1(DAT) 1F DATA 82860013 DC 7X'00' 82920013 DC AL1(LV) 27 LABEL VAR 82980013 DC 4X'00' 83010015 DC AL1(TSK) 2C TASK IDENTIFIER 83040015 DC AL1(EVNT) 2D EVENT IDENTIFIER 83070015 DC AL1(STR) 2E STRUCTURE ITEM 83100013 DC AL1(DAT) 2F DATA 83160013 DC 7X'00' 83220013 DC AL1(LV) 37 LABEL VAR 83280013 DC 4X'00' 83310015 DC AL1(TSK) 3C TASK IDENTIFIER 83340015 DC AL1(EVNT) 3D EVENT IDENTIFIER 83370015 DC AL1(STR) 3E STRUCTURE ITEM 83400013 DC AL1(DAT) 3F DATA 83460013 DC AL1(FP) 40 FORMAL PARAMETER TYPE 1 83520013 DC X'00' 83580013 DC AL1(GEP) 42 GENERIC ENTRY POINT 83640013 DC X'00' 83700013 DC AL1(PSV) 44 PSEUDO-VARIABLE 83760013 DC 8X'00' 83820013 DC AL1(ON2) 4D ON CONDITION 83880013 DC 2X'00' 83940013 DC AL1(STAT) 50 STATIC CHAIN HEAD 84000013 DC 47X'00' 84060013 DC AL1(ET1) 80 PROCEDURE ENTRY TYPE 1 84120013 DC AL1(BGN) 81 BEGIN BLOCK ENTRY 84180013 DC AL1(EN1) 82 ENTRY ENTRY TYPE 1 84240013 DC AL1(ET5) 83 ENTRY TYPE 5 84300013 DC AL1(ET3) 84 ENTRY TYPE 3 84360013 DC AL1(ET2) 85 ENTRY TYPE 2 84420013 DC X'00' 84480013 DC AL1(LV) 87 LABEL VAR 84540013 DC AL1(CON) 88 CONSTANT 84600013 DC AL1(FLV) 89 FILE VARIABLE 84660013 DC 2X'00' 84720013 DC AL1(TSK) 8C TASK IDENTIFIER 84780013 DC AL1(EVNT) 8D EVENT 84840013 DC X'00' 84900013 DC AL1(DAT) 8F DATA 84960013 DC AL1(INV) 90 INVOCATION COUNT 85020013 DC 6X'00' 85080013 DC AL1(LV) 97 LABEL VAR 85140013 DC AL1(OCB) 98 OPEN CONTROL BLOCK 85200013 DC 3X'00' 85260013 DC AL1(TSK) 9C TASK IDENTIFIER 85320013 DC AL1(EVNT) 9D EVENT 85380013 DC X'00' 85440013 DC AL1(DAT) 9F DATA 85500013 DC 7X'00' 85560013 DC AL1(LV) A7 LABEL VAR 85620013 DC 4X'00' 85650015 DC AL1(TSK) AC TASK IDENTIFIER 85680015 DC AL1(EVNT) AD EVENT IDENTIFIER 85710015 DC AL1(STR) AE STRUCTURE ITEM 85740013 DC AL1(DAT) AF DATA 85800013 DC 7X'00' 85860013 DC AL1(LV) B7 LABEL VAR 85920013 DC 4X'00' 85950015 DC AL1(TSK) BC TASK IDENTIFIER 85980015 DC AL1(EVNT) BD EVENT IDENTIFIER 86010015 DC AL1(STR) BE STRUCTURE ITEM 86040013 DC AL1(DAT) BF DATA 86100013 DC AL1(SDV) C0 SDV FOR TEMPORARY 86160013 DC AL1(DED) C1 DED2 86220013 DC AL1(LIB) C2 LIBRARY FUNCTION 86280013 DC AL1(CSL) C3 COMPILER LABEL 86340013 DC AL1(ONL) C4 ON LIST 86400013 DC AL1(PL) C5 PARAMETER LIST 86460013 DC AL1(DV) C6 SKELETON DOPE VECTOR 86520013 DC AL1(STD) C7 SYMBOL TABLE OR DED1 86580013 DC AL1(WS1) C8 WORKSPACE 1 86640013 DC AL1(WS2) C9 WORKSPACE 2 86700013 DC AL1(WS3) CA WORKSPACE 3 86760013 DC X'00' 86820013 DC AL1(SVRS) CC SAVE/RESTORE 86880013 DC AL1(ON1) CD ON CONDITION 86940013 DC AL1(BCD) CE LABEL BCD 87000013 DC 49X'00' 87060013 * END OF TABLE6 87120013 WSRR01 DC F'0' RR SAVE SLOT 1 87180013 WSRR02 DC F'0' 2 87240013 EJECT 87280001 * THIS ROUTINE INITIALISES THE STATEMENT / OFFSET TABLE IF IT IS 87320001 * REQUIRED. 87360001 * 87400001 SOINIT TM CCCODEE,X'80' IS TABLE WANTED 87440001 BCR BNO,RR GO IF NOT 87480001 * OFFSET TABLE IS REQUIRED SO SET ON THE 87520001 * BRANCHES WHICH ACTIVATE THE ROUTINES 87560001 ST RR,SAVE2 87640001 MVI SOSW1,FF 87680001 * NOW GET AN OUTPUT TEXT BLOCK WHICH WILL BE USED TO HOLD 87720001 * THE TABLE OF OFFSETS PRIOR TO PRINTING 87760001 MVC PAR1+1(3),ZERO 87800001 L RR,ZUTXTC 87840001 BALR RR,RR 87880001 L HR1,PAR1 SAVE TEXTREF IN SOTXT 87920001 ST HR1,SOTXT 87960001 L HR1,PAR2 INITIALISE SOSLOT POINTER 88000001 ST HR1,SOSLOT 88040001 LH HR1,TXTSZ SET LAST BYTE COUNTER FOR TEXT BLOCK 88080001 ST HR1,SOLAST CONTROL 88120001 L RR,SAVE2 88160001 BCR B,RR RETURN TO REST OF INITIALISATION 88200001 EJECT 88240001 * THIS ROUTINE INITIALISES THE STACK WITH AN FF PROCEDURE ENTRY. 88280001 SOPRO L HR1,SOLAST 88320001 ST RR,SAVE2 88360001 TM SOSW1,FF 88400001 BC BNO,SOB1A 88440001 L HR2,SOSLOT PICK UP STACK POINTER 88480001 ST HR1,0(HR2) SET COUNTER IN STACK 88520001 MVI 0(HR2),FF MOVE IN MARKER 88560001 MVC 4(4,HR2),SOPROC MOVE IN TXTREF 88600001 MVC PAR1(4),SOTXT UPDATE SOPROC TO POINT AT NEW ENTRY 88640001 MVC PAR2(4),SOSLOT GET REFERENCE OF CURRENT ADDRESS 88680001 L RR,ZTXTRF 88720001 BALR RR,RR 88760001 MVC SOPROC(4),PAR1 88800001 LA HR1,8 SET BUMP VALUE 88840001 TM 42(R1),X'40' IS THIS AN ON BLOCK 88880001 BC BNO,SONOT GO IF NOT 88920001 LH HR1,SAMST PICK UP LAST STNO 88960001 LA HR1,1(HR1) 89000001 ST HR1,8(HR2) SET IN STACK 89040001 L HR1,PROCLC SET OFFSET 89080001 ST HR1,12(HR2) IN STACK 89120001 LA HR1,16 RESET NEW BUMP VALUE 89160001 SONOT L HR2,SOLAST 89200001 SR HR2,HR1 SUBTRACT BUMP VALUE 89240001 ST HR2,SOLAST 89280001 L HR2,SOSLOT 89320001 AR HR2,HR1 ADD BUMP VALUE 89360001 ST HR2,SOSLOT 89400001 SOB1A L RR,SAVE2 89440001 BCR B,RR 89480001 EJECT 89520001 * THIS ROUTINE PRINTS THE OFFSET TABLE FOR THE PROC. REGISTER 7 POINT 89560001 * TO DICT_REF OF PROC. 89600001 * SOPROC CONTAINS TEXTREF OF PROC START 89640001 SOPROI L HR1,SOSLOT SET PROCI MARKER IN STACK 89680001 ST RR,SAVE2 89720001 TM SOSW1,FF 89760001 BC BNO,SOB2A 89800001 MVI 0(HR1),DD 89840001 MVC 1(3,HR1),SOTXT+1 SET TEXTREF IN BLOCK 89880001 MVC BUF2+16(105),BUF2+15 CLEAR BUF2 FOR PRINTING 89920001 MVC BUF2+16(58),SOHEAD MOVE IN HEADING 89960001 TM 42(R1),X'40' IS THIS AN ON BLOCK 90000001 BC BNO,SOON GO IF NOT 90040001 MVC BUF2+65(9),SOH2 90080001 BC B,SOP1 90120001 SOON MVC BUF2+65(9),SOH1 90160001 MVC PAR1+2(2),7(R1) GET BCD OF PROC AND SET IN HEADER 90200001 L RR,ZDRFAB 90240001 BALR RR,RR 90280001 L HR1,PAR1 90320001 SR HR2,HR2 90360001 IC HR2,2(HR1) 90400001 AR HR1,HR2 90440001 IC HR2,0(HR1) 90480001 EX HR2,MVCBCD 90520001 L HR2,ZTRAN2 90560001 TR HPROC(31),0(HR2) TRANSLATE TO EXT FORM 90600001 SOP1 MVC PAR3(4),ZERO PRINT HEADER 90640001 LA HR2,BUF2+16 90680001 ST HR2,PAR1 90720001 L RR,ZUPL 90760001 BALR RR,RR 90800001 * NOW RESTORE VARIOUS SLOTS AND POINTERS AND 90840001 * CHAIN BACK TO FIRST ENTRY FOR THIS PROC AND START TO PRINT 90880001 * THE TABLE 90920001 MVC PAR1(4),SOTXT SET CURRENT 90960001 MVI PAR2+3,X'83' BLOCK TO WANTED 91000001 L RR,ZALTER BEFORE GETTING START OF 91040001 BALR RR,RR THIS PROC 91080001 MVC PAR1(4),SOPROC 91120001 L RR,ZTXTAB 91160001 BALR RR,RR 91200001 L HR1,PAR1 91240001 ST HR1,SOSLOT RESET SOSLOT 91280001 MVC SOLAST+1(3),1(HR1) RESET SOLAST 91320001 CLI 0(HR1),FF MAKE SURE ITS AN FF 91360001 BC BE,SOOK 91400001 DC X'0000' STOP IF NOT 91440001 SOOK MVC SOPROC(4),4(HR1) RESET SOPROC 91480001 LA HR2,8(HR1) BUMP TO 1ST ITEM 91520001 MVC SOPROG(4),4(HR2) SET PROG LENGTH IN TO DATE 91560001 LA HR4,21 BUILD BUFFERS FOR OFFSET 91600001 LA HR3,BUF1+12 91640001 SOL1 LA HR3,5(HR3) 91680001 CLI 0(HR2),EE IS IT EOB 91720001 BC BNE,SOL2 GO IF NOT 91760001 BAL R2,SOBLK1 91800001 SOL2 CLI 0(HR2),DD IS IT PROCI MARKER 91840001 BC BE,SODD GO IF SO 91880001 ST BASRG1,SAVE SAVE TT BASE 91920001 LA HR0,4 SET LOOP COUNT 91960001 L R2,4(HR2) PICK UP OFFSET 92000001 S R2,SOPROG DEDUCT PROG LENGTH TO DATE 92040001 SOLOOP SRDL R2,4 ISOLATE INDEX 92080001 SRL BASRG1,28 VALUE 92120001 LA HR1,HEXTAB SET POINTER TO HEX 92160001 AR HR1,BASRG1 CONV TABLE 92200001 MVC 3(1,HR3),0(HR1) MOVE IN HEX CHAR 92240001 BCTR HR3,0 92280001 BCTR HR0,HR0 92320001 LTR HR0,HR0 92360001 BC BNZ,SOLOOP 92400001 LA HR3,4(HR3) 92440001 L BASRG1,SAVE 92480001 L R2,0(HR2) MOVE STATNO OVER 92520001 CVD R2,0(HR2) AFTER CONVERTING 92560001 MVC PAT1(6),PAT MOVE IN PATTERN 92600001 ED PAT1(6),5(HR2) 92640001 MVC 120(5,HR3),PAT1+1 COPY INTO BUFFER 92680001 LA HR2,8(HR2) UPDATE STACK POINTER 92720001 BCT HR4,SOL1 LOOP BACK TO FILL LINE 92760001 SOPR EQU * 92800001 LA HR4,BUF1 92840001 ST HR4,PAR1 92880001 L RR,ZUPL 92920001 BALR RR,RR 92960001 LA HR4,BUF2 93000001 ST HR4,PAR1 93040001 L RR,ZUPL 93080001 BALR RR,RR 93120001 TM SOP,FF IS IT LAST LINE 93160001 BC BO,SODD1 93200001 LA HR4,21 93240001 LA HR3,BUF1+12 RETURN 93280001 BC B,SOL1 93320001 * TABLE HAS BEEN PRINTED FOR THIS PROC. CLEAR BUFFERS AND PRINT LAST 93360001 * TWO LINES THEN RESET POINTERS 93400001 SODD C HR4,CON21 ANYTHING TO PRINT 93440001 BC BE,SODD1 GO IF NOT 93480001 MVC 0(4,HR3),BLANKS 93520001 MVC 120(5,HR3),BLANKS 93560001 LA HR3,5(HR3) 93600001 BCT HR4,SODD 93640001 MVI SOP,FF 93680001 BC B,SOPR GO TO PRINT 93720001 SODD1 MVI SOP,X'00' 93760001 MVI SOHEAD+2,X'60' RESET SKIP CODE 93800001 TM SOSW,X'81' DO ANY TEXT BLOCKS NEED FREEING 93840001 BC BNO,SODD2 GO IF NOT 93880001 BAL R2,SOBLK2 93920001 SODD2 MVI SOSW,X'00' SET SWITCH OFF 93960001 L R2,SOPROC WAS THIS LAST 94000001 LTR R2,R2 ONE 94040001 BC BNZ,SOB2A GO IF NOT 94080001 MVI PAR2+3,X'81' YES SO FREE TEXT BLOCK 94120001 MVC PAR1(4),SOTXT 94160001 L RR,ZALTER 94200001 BALR RR,RR 94240001 SOB2A L RR,SAVE2 94280001 BCR B,RR 94320001 * THIS ROUTINE TAKES CARE OF TEXT BLOCKING CONTROL 94360001 * SOBLK1 IS ENTERED FOR EOB ON PRINTING AND GETS NEXT BLOCK 94400001 * SOBLK2 HANDLES FREEING PROBLEMS 94440001 * HR2 POINTS TO EITHER EE OR DD ITEM IN STACK 94480001 SOBLK1 MVC PAR2+3(1),SOSW SET ONE-TIME SWITCH IN PAR2 94520001 MVC PAR1+1(3),1(HR2) PUT REF OF OLD BLOCK IN PAR1 94560001 ST RR,SAVE 94600001 L RR,ZCHAIN 94640001 BALR RR,RR 94680001 L RR,SAVE 94720001 TM SOSW,X'81' IS THIS FIRST TIME 94760001 BC BO,SOBK1 GO IF NOT 94800001 MVC SOTXT+1(3),1(HR2) ELSE RESET CURRENT TEXT BLOCK 94840001 SOBK1 EQU * 94880001 L HR2,PAR2 RESET STACK POINTER 94920001 MVI SOSW,X'81' SET ONE-TIME SWITCH 94960001 BCR B,R2 95000001 SOBLK2 MVI PAR2+3,X'81' SET FREE BIT 95040001 MVC PAR1+1(3),1(HR2) 95080001 L RR,ZALTER 95120001 BALR RR,RR 95160001 BCR B,R2 95200001 EJECT 95240001 * THIS ROUTINE BUILDS THE STACK FOR EACH STATEMENT NUMBER 95280001 SOSN L HR1,SOSLOT GET STACK POINTER 95320001 ST RR,SAVE2 95360001 TM SOSW1,FF 95400001 BC BNO,SOB3A 95440001 MVC 0(2,HR1),ZERO 95480001 MVC 2(2,HR1),3(UR1) MOVE IN STATNO 95520001 CLI 0(UR1),X'7D' IS THIS STATNO 95600001 BC BNE,SOSN2 GO IF NOT 95640001 SOSN4 LR HR3,UR2 MOVE IN LOCN CTR 95660001 A HR3,PROCLC ADD IN LENGTH TO DATE 95680001 CLC SAMST(2),2(HR1) SEEN THIS BEFORE 95720001 BC BE,SOB3A GO IF SO 95760001 MVC SAMST(2),2(HR1) UPDATE SAME STNO SLOT 95800001 ST HR3,4(HR1) SET CURRENT OFFSET 95840001 * NOW ENSURE THAT AT LEAST 80 BYTES 95880001 LA HR1,8(HR1) REMAIN 95920001 ST HR1,SOSLOT 95960001 L HR1,SOLAST 96000001 SH HR1,SO8 96040001 CH HR1,H23 96080001 BC BNH,SOBLK3 GO GET ANOTHER BLOCK IF NOT 96120001 ST HR1,SOLAST 96160001 BC B,SOB3A 96200001 SOSN2 CLI 0(R1),X'80' IS IT ET 1 96240001 BC BE,SOB3A GO IF SO 96280001 CLI 0(R1),X'82' IS IT ENTRY 96320001 BC BE,SOB3A GO IF SO 96360001 CLI 0(R1),X'C3' IS IT A COMPILER LABEL 96400001 BE SOCL COMPILER LABEL 32265 96420000 SOSL EQU * 32265 96440000 TM 10(R1),X'20' IS THIS LABEL IN A CHKLIST 96480001 BC BO,SOSN5 GO IF SO 96520001 MVC 2(2,HR1),8(R1) MOVE IN SN 96560001 BC B,SOSN4 96600001 SOSN5 MVC PAR1+2(2),8(R1) COPY DICREF 96640001 L RR,ZDRFAB 96680001 BALR RR,RR 96720001 L RR,PAR1 96760001 MVC 2(2,HR1),3(RR) 96800001 BC B,SOSN4 96840001 SOBLK3 MVC PAR1(4),SOTXT 96880001 MVI PAR2+3,X'83' 96920001 L RR,SOSLOT 96960001 MVI 0(RR),EE SET EOB 97000001 MVC 1(3,RR),SOTXT+1 SAVE TXTREF 97040001 L RR,ZUTXTC 97080001 BALR RR,RR 97120001 MVC SOTXT(4),PAR1 97160001 MVC SOSLOT(4),PAR2 97200001 LH RR,TXTSZ 97240001 ST RR,SOLAST RESET SOLAST 97280001 SOB3A L RR,SAVE2 97320001 BCR B,RR 97360001 * IT IS POSSIBLE THAT THIS CL HAS BEEN GENERATED 32265 97365000 * FROM A LABEL VARIABLE. IF SO CL D.R. LENGTH WILL 32265 97370000 * GREATER THAN X'13'. 32265 97375000 SOCL EQU * 32265 97380000 CLC 1(2,R1),HEX13 32265 97385000 BH SOSL SUBSCRIPTED LABEL 32265 97390000 B SOB3A COMPILER LABEL 32265 97395000 EJECT 97400001 SAMST DC H'0' SAME STNO CHECK SLOT 97440001 SO8 DC H'8' 97480001 H23 DC H'80' 97520001 SOSLOT DS F ADDRESS SLOT OF NEXT TABLE ENTRY 97560001 SOPROG DC F'0' CURRENT LENGTH OF PROG 97600001 SOPROC DC F'0' BACK CHAIN IN STACK 97640001 SOLAST DC F'0' LAST BYTE IN TEXT BLOCK 97680001 SAVE DC F'0' 97720001 SAVE2 DC F'0' 97760001 SOTXT DC F'0' TXT REF OF CURRENT PROC ENTRY 97800001 ZERO DC F'0' 97840001 CON21 DC F'21' 97880001 MVCBCD MVC HPROC(0),1(HR1) 97920001 SOHEAD DC X'0065F1' 97960001 DC C'TABLE OF OFFSETS AND STATEMENT NUMBERS WITHIN PROCEDU' 98000001 DC C'RE' 98040001 BLANKS DC C' ' 98080001 SOSW DC X'00' 98120001 SOSW1 DC X'00' 98160001 BUF1 DC X'0076F0' 98200001 DC C'OFFSET (HEX) ' 98240001 DC C' ' 98280001 DC C' ' 98320001 BUF2 DC X'007640' 98360001 DC C'STATEMENT NO ' 98400001 DC C' ' 98440001 DC C' ' 98480001 PAT DC X'402020202020' EDIT PATTERN 98520001 PAT1 DC X'000000000000' 98560001 SOP DC X'00' 98600001 SOH1 DC C'PROCEDURE' 98640001 SOH2 DC C'ON UNIT ' 98680001 HEXTAB DC X'F0F1F2F3F4F5F6F7F8F9C1C2C3C4C5C6' 98720001 HEX13 DC X'0013' LENGTH OF CL DIC ENTRY 32265 98740000 EJECT 98760001 HPROC EQU BUF2+84 PROC NAME SLOT 98800001 CCCODE EQU DICBLK+232 EXEC CARD CODES 98840001 TXTSZ EQU DICBLK+266 98880001 ZTRAN2 EQU DICBLK+72 INT -> EXT TR TABLE 98920001 CCCODEE EQU DICBLK+292 OPTION WANTED FLAG 98940001 FF EQU X'FF' PROC MARKER 98960001 EE EQU X'EE' END BLOCK MARKER 99000001 DD EQU X'DD' PROC PRIME MARKER 99040001 END IEMTU 99080001 ./ ADD SSI=20010256,NAME=IEMUA,SOURCE=0 UA TITLE 'IEMUA,STATIC INITIALISATION,FINAL ASSEMBLY,PL/I (F)' 00040015 * 00080015 * 5.5 A 474000 PEP 60073 00090072 * 5.2 C 875200,875450 KT 38257 00100072 * 5.1 C 474000 CRS 23305 00110072 * 00120015 * 00160015 * VERSION - 2 00200015 * 00240015 * STATUS - CHANGE LEVEL 0 00280015 * RLSE19 474000 A23305 00300019 * ### 875200,875450 ### - SEE ID# 38257 00310042 * 00320015 * 00360015 * 00400015 * FUNCTION / OPERATION 00440015 * 00480015 * (1) LOADS MODULES IEMUB AND IEMUC 00520015 * 00560015 * (2) OBTAINS SCRATCH CORE FOR ARRAY INITIALISATION AND 00600015 * SETS UP A CIRCULAR CHAIN OF RLD CARDS. 00640015 * 00680015 * (3) SCANS THE FIRST SECTION OF THE STATIC CHAIN FOR 00720015 * SCALAR INTERNAL VARIABLES, BCD FOR LABEL CONSTANTS AND ENTRY 00760015 * LABELS ( IF REQUIRED ) AND DEDS FOR TEMPORARIES. SIMPLE DATA 00800015 * VARIABLES AND LABEL VARIABLES ARE NOT PROCESSED BY THIS 00840015 * PHASE. 00880015 * 00920015 * (4) SCANS THE STATIC CHAIN STARTING AT THE FIRST 00960015 * CHARACTER ALIGNED ENTRY AND ENDING AFTER THE LAST EXTERNAL 01000015 * ITEM TO INITIALISE ADDRESS CONSTANTS FOR STATIC EXTERNAL 01040015 * VARIABLES, ENTRY LABELS, EXTERNAL ENTRY NAMES, BUILT-IN AND 01080015 * INTERNAL FUNCTIONS, AND STATEMENT LABELS WHICH REQUIRE THEM. 01120015 * DCB'S FOR INTERNAL FILES ARE ALSO INITIALISED. 01160015 * (5) INTIALISES THE CONSTANTS POOL 01200015 * 01240015 * (6) SCANS THE REMAINDER OF THE STATIC CHAIN TO 01280015 * INITIALISE STORAGE FOR DOPE VECTOR SKELETONS FOR AUTOMATIC 01320015 * VARIABLES, ARGUMENT LISTS, DEDS AND SYMBOL TABLE ENTRIES AND 01360015 * RDV'S AND DVD'S. 01400015 * 01440015 * 01480015 * 01520015 * ENTRY POINTS 01560015 * 01600015 * (1) UA000 FROM COMPILER CONTROL 01640015 * 01680015 * (2) UA0015 TO CONTINUE THE FIRST SCAN OF THE STATIC 01720015 * CHAIN. 01760015 * 01800015 * (3) UA021 TO CONTINUE THE THIRD SCAN OF THE STATIC 01840015 * CHAIN 01880015 * 01920015 * (4) UA100A TO TERMINATE PHASE UA AND CALL IN PHASE UD. 01960015 * 02000015 * 02040015 * 02080015 * INPUT - THE DICTIONARY 02120015 * 02160015 * 02200015 * 02240015 * OUTPUT - LOADER TEXT (TXT AND RLD CARDS) TO INITIALIZE 02280015 * THE STATIC INTERNAL CSECT AND A CSECT FOR EACH STATIC EXTERNAL 02320015 * VARIABLE AND EXTERNAL FILE. THE OUTPUT IS ON THE LOAD AND/OR 02360015 * PUNCH FILE AS SPECIFIED BY THE PROGRAMMER. 02400015 * 02440015 * 02480015 * 02520015 * EXTERNAL ROUTINES 02560015 * 02600015 * (1) TXTMOV IN IEMUB TO MOVE LOADER TEXT TO A TXT CARD 02640015 * BUFFER AND TO OUTPUT IT WHEN FULL. 02680015 * 02720015 * (2) RLDMOV IN IEMUB TO MOVE LOADER TEXT TO A RLD CARD 02760015 * BUFFER AND TO OUTPUT IT WHEN FULL. 02800015 * 02840015 * (3) LIST IN IEMUB TO LIST THE STATIC INTERNAL CSECT. 02880015 * THE ENTRY POINTS ARE LIST1, LIST2 AND LIST3. 02920015 * 02960015 * (4) UA220 AND UA225 IN IEMUC TO PRODUCE TEXT FOR 03000015 * LABEL VARIABLES AND CONSTANTS. 03040015 * 03080015 * (5) UA014 AND UA0145 IN IEMUC TO INITIALISE THE 03120015 * CONSTANTS POOL. 03160015 * 03200015 * (6) UA080 IN IEMUC TO PRODUCE TEXT FOR SYMBOL TABLE 03240015 * ENTRIES. 03280015 * 03320015 * (7) UA230 IN IEMUC TO PRODUCE TEXT FOR DEDS 03360015 * 03400015 * (8) UA0215 IN IEMUC TO PRODUCE TEXT FOR DOPE VECTOR 03440015 * SKELETONS. 03480015 * 03520015 * (9) ADDRDV IN IEMUC TO PRODUCE TEXT FOR RDVS AND DVDS. 03560015 * 03600015 * (10) LOADW IN COMPILER CONTROL TO LOAD MODULES IEMUB 03640015 * AND IEMUC. 03680015 * 03720015 * (11) RLSCTL IN COMPILER CONTROL TO RELEASE MODULE 03760015 * IEMUA AND LOAD IEMUD. 03800015 * 03840015 * (12) ZUSP IN COMPILER CONTROL TO WRITE A CARD IMAGE 03880015 * ON THE PUNCH FILE. 03920015 * 03960015 * (13) ZULF IN COMPILER CONTROL TO WRITE A CARD IMAGE 04000015 * ON THE LOAD FILE. 04040015 * 04080015 * (14) ZUERR IN COMPILER CONTROL TO ADD MESSAGES TO THE 04120015 * ERROR CHAINS. 04160015 * 04200015 * (15) ZDRFAB IN COMPILER CONTROL TO CONVERT DICTIONARY 04240015 * REFERENCES. 04280015 * 04320015 * (16) ZTRAN2 IN COMPILER CONTROL TO TRANSLATE TEXT FROM 04360015 * INTERNAL TO EXTERNAL FORM. 04400015 * 04440015 * 04480015 * 04520015 * EXITS - ERROR - NONE. 04560015 * 04600015 * 04640015 * 04680015 * ATTRIBUTES - N/A 04720015 * 04760015 * 04800015 * 04840015 * NOTES 04880015 * 04920015 * THIS MODULE IS INDEPENDENT OF THE EXTERNAL CHARACTER SET 04960015 * 05000015 * THE STATIC CHAIN HAS BEEN ORDERED IN THE FOLLOWING 05040015 * MANNER BY STORAGE ALLOCATION. 05080015 * (1) SCALAR INTERNAL VARIABLES,ENTRY LABELS,LABEL 05120015 * CONSTANTS,FILE ATTRIBUTE ENTRIES,DEDS FOR TEMPORARIES,AND 05160015 * LABEL VARIABLE BCD ENTRIES. 05200015 * (2) STATIC EXTERNAL VARIABLES,FILES,BUILT-IN AND 05240015 * INTERNAL FUNCTIONS,EXTERNAL ENTRY NAMES,AND ON CONDITION 05280015 * NAMES. 05320015 * (3) DOPE VECTOR SKELETONS FOR AUTOMATIC VARIABLES. 05360015 * (4) ARGUMENT LISTS 05400015 * (5) INTERNAL ARRAYS 05440015 * (6) INTERNAL STRUCTURES 05480015 * (7) DEDS AND SYMBOL TABLE ENTRIES 05520015 * (8) RDV AND DVD ENTRIES. 05560015 * 05600015 * REGISTER USAGE 05640015 * 05680015 * 15 BRANCH REGISTER TO COMPILER CONTROL 05720015 * 14 RETURN REGISTER 05760015 * 9 BASE REGISTER FOR UA AND UD 05800015 * 10 BASE REGISTER FOR UB 05840015 * 4 BASE REGISTER FOR UC 05880015 * 6 LOCATION COUNTER 05920015 * 12 SCAN POINTER FOR THE STATIC CHAIN SCANS. 05960015 * 7 PARAMETER REGISTERS FOR 06000015 * 8 CALLS TO TXTMOV 06040015 * 0 - 6 WORK REGISTERS. 06080015 SPACE 10 06120015 *********************************************************************** 06160015 SPACE 5 06200015 * THE LAYOUT AND USAGE OF SCRATCH CORE DURING THE 06240015 * STATIC INITIALISATION PHASES IS AS FOLLOWS 06280015 * 06320015 * BYTES 0 - 63 06360015 * 06400015 * THESE ARE SET UP BY PHASE TF AND CONTAIN THE 06440015 * NAMES OF THE TEXT BLOCKS HOLDING INFORMATION ON EQU 06480015 * LABEL VALUES. EACH NAME IS HELD IN ONE BYTE 06520015 * 06560015 * BYTES 64 - 447 06600015 * 06640015 * THESE CONTAIN THE DOPE VECTOR OF A VARYING STRING 06680015 * ARRAY DURING DOPE VECTOR INITIALISATION, OF A STRUCTURED 06720015 * ARRAY OR OF A TASK, EVENT OR AREA ARRAY DURING ELEMENT 06760015 * INITIALISATION. 06800015 * 06840015 * BYTES 448 - 527 06880015 * 06920015 * THES ARE USED IN THE INITIALISATION OF PACKED 06960015 * STRUCTURES AND CONSIST OF 20 FOUR BYTE ENTRIES. EACH 07000015 * ENTRY CONSISTS OF A FLAG BYTE AND 3-BYTE TEXT REFERENCE 07040015 * 07080015 * BYTES 528 - 783 07120015 * 07160015 * THESE CONTAIN THE TRANSLATE TABLE 'TABLE2' 07200015 * USED FOR PROVIDING COMMENTS IN THE STATIC LISTINGS 07240015 * 'TABLE2' IS PLACED IN SCRATCH CORE BY 07280015 * PHASE TT 07320015 * 07360015 * BYTES 784 - 4095 07400015 * 07440015 * THESE ARE USED FOR THE TWO COLUMN LISTING FEATURE 07480015 * AND PERMIT IT FOR A PAGE SIZE OF NOT MORE THAN 57 07520015 SPACE 5 07560015 *********************************************************************** 07600015 SPACE 10 07640015 EJECT 07680015 IEMUA START 0 07720015 * A23251 RLSE18 874000 07740001 EJECT 07760015 * SYMBOLIC REGISTERS USED IN LOGICAL PHASE UA 07800015 SPACE 2 07840015 WR1 EQU 5 WORK REGISTERS - WR2 AND WR3 , 07880015 WR2 EQU 2 AND WR6 AND WR7 MUST BE EVEN / 07920015 WR3 EQU 3 ODD PAIRS 07960015 WR4 EQU 4 08000015 WR6 EQU 0 08040015 WR7 EQU 1 08080015 WR8 EQU 7 08120015 WR9 EQU 8 08160015 SPACE 08200015 PR1 EQU 7 PARAMETER REGISTERS FOR THE 08240015 PR2 EQU 8 TEXT MOVING ROUTINE 08280015 SPACE 08320015 DICR EQU 13 DICTIONARY REGISTER 08360015 SPACE 08400015 TVR EQU 11 TRANSFER VECTOR REGISTER 08440015 SPACE 08480015 RLDR EQU 3 NEXT LOCATION IN RLD BUFFER 08520015 SPACE 08560015 CUR EQU 4 CURRENT RLD CARD BUFFER 08600015 SPACE 08640015 TXTR EQU 1 NEXT LOCATION IN TEXT CARD 08680015 LOCCTR EQU 6 STATIC LOC ATION COUNTER 08720015 SPACE 08760015 DEAR EQU 12 POINTER TO THE CURRENT DICT.ENT. 08800015 SPACE 08840015 BASR EQU 9 BASE REGISTER FOR UA 08880015 BASR2 EQU 10 BASE REGISTER FOR UB 08920015 BASR3 EQU 4 BASE REGISTER FOR UC OR UD 08960015 SPACE 09000015 RR EQU 14 LINK REGISTER 09040015 LR EQU 15 USED FOR BRANCHING TO COMPILER 09080015 EJECT 09120015 * DICTIONARY ENTRY CODE BYTES 09160015 SPACE 2 09200015 ET4 EQU X'03' ENTRY TYPE 4 09240015 BIF EQU X'04' BUILT-IN FUNCTION 09280015 LABVAR EQU X'07' SCALAR LABEL VARIABLE 09320015 FILCON EQU X'08' FILE CONSTANT 09360015 FILE EQU X'09' FILE NAME 09400015 SIMDAT EQU X'0F' SCALAR DATA VARIABLE 09440015 DIMLAB EQU X'17' DIMENSIONED LABEL VARIABLE 09480015 DIMDAT EQU X'1F' DIMENSIONED DATA VARIABLE 09520015 STRUCT EQU X'2E' SCALAR STRUCTURE 09560015 DIMSTR EQU X'3E' DIMENSIONED STRUCTURE 09600015 CONST EQU X'88' CONSTANT 09640015 ATTRIB EQU X'98' FILE ATTRIBUTE ENTRY 09680015 DED2 EQU X'C1' DED FOR TEMPORARY 09720015 ILF EQU X'C2' INTERNAL LIB FUNCTION AND 09760015 ARG EQU X'C5' ARGUMENT LIST 09800015 DVSKEL EQU X'C6' AUTOMATIC DOPE VECTOR SKELETON 09840015 SYMTAB EQU X'C7' SYMBOL TABLE AND DED 09880015 RDVRDV EQU X'C9' 09920015 DVDDVD EQU X'CC' 09960015 SPACE 10 10000015 * OFFSETS WITHIN DICTIONARY ENTRY 10040015 SPACE 2 10080015 * DATA VARIABLES 10120015 SPACE 10160015 STATCH EQU 3 STATIC CHAIN 10200015 DATOFS EQU 5 OFFSET 1 SLOT 10240015 DATINF EQU 16 DATA INFORMATION 10280015 DATOF2 EQU 21 OFFSET 2 SLOT 10320015 DATIN1 EQU 25 INITIAL DATA ENTRY WITH AND 10360015 DATIN2 EQU 21 WITHOUT PRESENCE OF OFFSET 2 SLOT 10400015 DIM1 EQU 25 DIMENSION SLOT 10440015 DATIN3 EQU 35 10480015 DATIN4 EQU 31 10520015 STCHN1 EQU 29 STRUCTURE CHAIN FOR SCALAR AND 10560015 STCHN2 EQU 32 DIMENSIONED STRUCTURE 10600015 DATSYM EQU 19 POINTER TO SYMBOL TABLE D.E. 10640015 DCLNO EQU 8 DECLARE NUMBER SLOT 10680015 SPACE 2 10720015 DATOT1 EQU 10 OTHER1 10760015 SPACE 10800015 LDCON EQU X'80' LD CONST NEEDED FOR LABEL 10840015 CHECK EQU X'20' MENTIONED IN CHECK LIST 10880015 DVDFLG EQU X'10' 10920015 SPACE 2 10960015 DATVAR EQU 11 VARIABLE 11000015 SPACE 11040015 OF2FL EQU X'80' OFFSET 2 SLOT 11080015 DIMFL EQU X'40' DIMENSIONED 11120015 STRFL EQU X'20' STRUCTURED 11160015 INITFL EQU X'08' INITIAL DATA 11200015 SPACE 2 11240015 DATOT2 EQU 12 OTHER2 11280015 SPACE 1 11320015 EXTFL EQU X'04' EXTERNAL VARIABLE 11360015 SPACE 2 11400015 DATOT3 EQU 13 OTHER3 11440015 SPACE 1 11480015 DVFL EQU X'80' DOPE VECTOR NEEDED 11520015 VONEG EQU X'04' NEGATIVE VIRTUAL ORIGIN 11560015 SPACE 2 11600015 DATOT4 EQU 14 OTHER4 11640015 SPACE 11680015 MAJPAK EQU X'08' PACKED MAJOR STRUCTURE 11720015 MAJST EQU X'04' 11760015 RDVFLG EQU X'01' 11800015 SPACE 2 11840015 DATDAT EQU 15 DATA 11880015 SPACE 1 11920015 FL1 EQU X'80' 11960015 FL3 EQU X'20' 12000015 FL4 EQU X'10' 12040015 FL5 EQU X'08' 12080015 FL6 EQU X'04' 12120015 FL7 EQU X'02' 12160015 CHARST EQU X'84' 12200015 SPACE 2 12240015 * STRUCTURE ENTRIES 12280015 SPACE 12320015 STCHN3 EQU 23 STRUCTURE CHAIN FOR SCALAR AND 12360015 STCHN4 EQU 26 DIMENSIONED STRUCTURES 12400015 SPACE 2 12440015 * LABEL ENTRIES 12480015 SPACE 1 12520015 DIM2 EQU 19 OFFSET OF DIMENSION SLOT 12560015 LABBCD EQU 8 D.R. OF LABEL BCD ENTRY 12600015 LABOF2 EQU 15 2ND OFFSET SLOT 12640015 SPACE 2 12680015 * LABEL CONSTANTS 12720015 SPACE 1 12760015 LABET1 EQU 16 PTR TO ET1 OF CONTAINING BLOCK 12800015 LABCOD EQU 18 CODE BYTE 12840015 LABOFS EQU 11 OFFSET OF LABEL WITHIN PROC 12880015 SPACE 2 12920015 * PICTURE ENTRIES 12960015 SPACE 1 13000015 PICL EQU 12 LENGTH OF PICTURE 13040015 PICOFF EQU 5 STATIC OFFSET OF PICTURE 13080015 PICPIC EQU 8 ACTUAL PICTURE 13120015 SPACE 2 13160015 * DEDS 13200015 SPACE 1 13240015 DEDDED EQU 8 ACTUAL DED 13280015 DEDL EQU 11 13320015 DEDOFS EQU 5 13360015 FEDL EQU 12 13400015 SPACE 2 13440015 * CONSTANTS 13480015 SPACE 1 13520015 CONCH EQU 3 CONSTANTS CHAIN 13560015 CONTYP EQU 8 TYPE CODE BYTE 13600015 CONDED EQU 10 13640015 CONCD EQU 8 13680015 SPACE 2 13720015 * FUNCTIONS 13760015 SPACE 1 13800015 FNTYP EQU 8 IDENTIFICATION CODE BYTE 13840015 SPACE 2 13880015 * SYMBOL TABLES 13920015 SPACE 13960015 SYMCHN EQU 14 CHAIN OF SYMBOL TABLE ENTRIES 14000015 SYMDAT EQU 16 POINTER BACK TO VARIABE 14040015 SYMOFS EQU 11 14080015 SPACE 2 14120015 * ON ENTRIES 14160015 SPACE 14200015 ONLENT EQU 11 14240015 ONNAME EQU 12 14280015 SPACE 2 14320015 * ENTRY LABELS 14360015 SPACE 1 14400015 ELET2 EQU 11 POINTER TO ET2 14440015 ELOFS EQU 13 OFFSET OF ENTRY POINT 14480015 SPACE 2 14520015 * ENTRY TYPE 1 14560015 SPACE 1 14600015 ET1BAK EQU 5 POINTER BACK UP ET1 CHAIN 14640015 ET1SYM EQU 23 POINTER TO SYMBOL TABLE CHAIN 14680015 ET1EL EQU 7 POINTER TO 1ST ENTRY LABEL 14720015 ET1OF2 EQU 14 OFFSET OF PROLOG CODE 14760015 ET1OF3 EQU 17 OFFSET OF PROCEDURE CODE 14800015 ET1OF5 EQU X'1C' OFFSET OF PROC IN PROGRAM 14840015 ET1ESD EQU 3 ESDID OF DISPLAY PSEUDO REGISTER 14880015 ET1OPT EQU 42 OPTIONS BYTE 14920015 MAIN EQU X'20' 14960015 ET1CNT EQU 25 15000015 ET1CHN EQU 9 15040015 SPACE 2 15080015 * ENTRY TYPE 2 15120015 SPACE 15160015 ET2ET3 EQU 3 POINTER TO ET3 15200015 SPACE 2 15240015 * ENTRY TYPE 3 15280015 SPACE 1 15320015 ET3ET1 EQU 3 POINTER TO ET1 FOR BLOCK 15360015 SPACE 2 15400015 * RDV ENTRIES 15440015 RDVOFS EQU 5 15480015 RDVDAT EQU 10 15520015 RDVVAR EQU 8 15560015 SPACE 2 15600015 * DVD ENTRIES 15640015 DVDOFS EQU 5 15680015 DVDDAT EQU 12 15720015 DVDVAR EQU 8 15760015 SPACE 10 15800015 * PSEUDO - CODE OPERATION CODE BYTES 15840015 SPACE 15880015 DCV1 EQU X'01' 15920015 DCV3 EQU X'03' 15960015 DCV4 EQU X'04' 16000015 DCA3 EQU X'13' 16040015 DCA4 EQU X'14' 16080015 SPACE 10 16120015 * MISCELLANEOUS FLAGS AND EQUIVALENCES 16160015 SPACE 16200015 ADFL EQU X'80' 16240015 DVFL1 EQU X'40' 16280015 CONFL EQU X'20' 16320015 SEFL EQU X'10' 16360015 NOINIT EQU X'08' 16400015 INITON EQU X'F7' 16440015 HEREBK EQU X'80' MASK FOR FIRST BIT 16480015 ONON EQU X'80' MASK TO TEST FOR INIT ON 16520015 PACKK EQU X'80' MASK TO TEST FOR PACKED ARRAY 16560015 TSTBIT EQU X'80' 16600015 TSTRDV EQU X'80' 16640015 TSTDVD EQU X'80' 16680015 MLTPL8 EQU X'07' TESTS IF N IS OF FORM 8*M 16720015 EJECT 16760015 * BRANCH MNEMONICS 16800015 SPACE 2 16840015 NOP EQU 0 16880015 BO EQU 1 16920015 BH EQU 2 16960015 BL EQU 4 17000015 BM EQU 4 17040015 BNE EQU 7 17080015 BNZ EQU 7 17120015 BE EQU 8 17160015 BZ EQU 8 17200015 BEH EQU 10 17240015 BNL EQU 11 17280015 BLE EQU 12 17320015 BNH EQU 13 17360015 BNO EQU 14 17400015 B EQU 15 17440015 EJECT 17480015 USING *,BASR BASE FOR UA OR UD 17520015 USING *+X'1000',BASR2 BASE FOR UB 17560015 USING *+X'2000',BASR3 BASE FOR UC 17600015 USING *+X'3000',TVR BASE FOR COMPILER CONTROL VECTS. 17640015 USING *+X'4000',DICR BASE FOR COMMUNICATIONS REGION 17680015 EJECT 17720015 * ENTRY POINTS IN THE FOURTH BLOCK 17760015 SPACE 2 17800015 UD EQU * 17840015 EJECT 17880015 * ENTRY POINTS IN THE SECOND BLOCK 17920015 SPACE 2 17960015 UB EQU *+X'1000' 18000015 SPACE 5 18040015 TXTMOV EQU UB+2 18080015 STRCTA EQU TXTMOV+4 18120015 STRCTB EQU STRCTA+4 18160015 STREND EQU STRCTB+4 18200015 RLDMOV EQU STREND+4 18240015 OUTPUT EQU RLDMOV+4 18280015 LIST EQU OUTPUT+4 18320015 LIST1 EQU LIST+4 18360015 LIST2 EQU LIST1+4 18400015 LIST3 EQU LIST2+4 18440015 UA912 EQU LIST3+4 18480015 SPACE 5 18520015 K1 EQU UB+X'50' 18560015 K2 EQU K1+4 18600015 K4 EQU K2+4 18640015 CONST4 EQU K4 18680015 K7 EQU K4+4 18720015 K8 EQU K7+4 18760015 K10 EQU K8+4 18800015 K16 EQU K10+4 18840015 K19 EQU K16+4 18880015 K32 EQU K19+4 18920015 CNST32 EQU K32 18960015 K56 EQU K32+4 19000015 K12 EQU K56+2 19040015 K72 EQU K12+2 19080015 K256 EQU K72+4 19120015 K31 EQU K256+4 19160015 WDMSK EQU K31+4 19200015 MASK8 EQU WDMSK+4 19240015 ADMSK EQU MASK8+4 19280015 ZERO EQU ADMSK+4 19320015 ZEROS4 EQU ZERO 19360015 BLANK EQU ZERO+4 19400015 ERRID1 EQU BLANK+8 19440015 END EQU ERRID1+2 19480015 PHSNAM EQU END+4 19520015 UANAM EQU PHSNAM+8 19560015 UBNAM EQU UANAM+4 19600015 UCNAM EQU UBNAM+4 19640015 UDNAM EQU UCNAM+4 19680015 UENAM EQU UDNAM+4 19720015 POINT EQU UENAM+4 19760015 STOREG EQU UB+X'D0' 19800015 ARRSTO EQU STOREG+24 19840015 DOUBLE EQU ARRSTO+8 19880015 SLOT EQU DOUBLE+8 19920015 ADJUST EQU SLOT+8 19960015 BAS3 EQU ADJUST+4 20000015 CHAR1 EQU BAS3+4 20040015 DESTO EQU CHAR1+4 20080015 DIMNO EQU DESTO+4 20120015 DPKEEP EQU DIMNO+4 20160015 DVST EQU DPKEEP+4 20200015 DV2STO EQU DVST+4 20240015 ECOUNT EQU DV2STO+4 20280015 FWORD EQU ECOUNT+4 20320015 FRSTSO EQU FWORD+4 20360015 FSTADD EQU FRSTSO+4 20400015 FSTBLK EQU FSTADD+4 20440015 HOLDRR EQU FSTBLK+4 20480015 HWORD EQU HOLDRR+4 20520015 KEEPRR EQU HWORD+4 20560015 KEEPR1 EQU KEEPRR+4 20600015 KEEPR3 EQU KEEPR1+4 20640015 KEEPR9 EQU KEEPR3+4 20680015 LNKST1 EQU KEEPR9+4 20720015 LNKST2 EQU LNKST1+4 20760015 LNKST3 EQU LNKST2+4 20800015 LNKST4 EQU LNKST3+4 20840015 MAXSIZ EQU LNKST4+4 20880015 NOELMS EQU MAXSIZ+4 20920015 OLD EQU NOELMS+4 20960015 OUTPTR EQU OLD+4 21000015 PR2SAV EQU OUTPTR+4 21040015 REGSTO EQU PR2SAV+4 21080015 RELOC EQU REGSTO+20 21120015 RLDSTO EQU RELOC+4 21160015 RLDBUF EQU RLDSTO+8 21200015 SAVERR EQU RLDBUF+8 21240015 SAVER9 EQU SAVERR+4 21280015 SCRCOR EQU SAVER9+4 21320015 SPILAD EQU SCRCOR+4 21360015 STOWR1 EQU SPILAD+4 21400015 STOWR9 EQU STOWR1+4 21440015 TEM1 EQU STOWR9+4 21480015 TEM2 EQU TEM1+4 21520015 TEM3 EQU TEM2+4 21560015 TEM4 EQU TEM3+4 21600015 TXTAD EQU TEM4+4 21640015 TXTSTO EQU TXTAD+4 21680015 VOST EQU TXTSTO+4 21720015 ELMLTH EQU VOST+4 21760015 M EQU ELMLTH+2 21800015 N EQU M+2 21840015 NODIMS EQU N+2 21880015 LCKSTO EQU NODIMS+2 21920015 ARRDR EQU LCKSTO+2 21960015 BITFLG EQU ARRDR+2 22000015 BITOFF EQU BITFLG+1 22040015 BITPCK EQU BITOFF+1 22080015 BITREM EQU BITPCK+1 22120015 FLAG EQU BITREM+1 22160015 INIT EQU FLAG+1 22200015 NEWCD EQU INIT+1 22240015 PRTDVD EQU NEWCD+1 22280015 PRTRDV EQU PRTDVD+1 22320015 SIXFS EQU PRTRDV+1 22360015 TXTBUF EQU UB+X'200' 22400015 CODTAB EQU TXTBUF+256 22440015 TXTCD EQU CODTAB+256 22480015 RLDCD1 EQU TXTCD+80 22520015 RLDCD2 EQU RLDCD1+84 22560015 RLDCD3 EQU RLDCD2+84 22600015 PRINT EQU RLDCD3+87 22640015 EJECT 22680015 UC EQU *+X'2000' 22720015 * ENTRY POINTS IN THE THIRD BLOCK 22760015 SPACE 2 22800015 UCINIT EQU UC+2 22840015 UCUPDT EQU UCINIT+4 22880015 TIDY EQU UCUPDT+4 22920015 STRAD1 EQU TIDY+4 22960015 UC0080 EQU STRAD1+4 23000015 UA100 EQU UC0080+4 23040015 UA220 EQU UA100+4 23080015 UA225 EQU UA220+4 23120015 PRNTHD EQU UA225+4 23160015 ONELST EQU PRNTHD+4 23200015 PRNTOU EQU ONELST 23240015 TWOLST EQU ONELST+4 23280015 RUNOUT EQU TWOLST+4 23320015 TASK EQU RUNOUT+4 23360015 EVENT EQU TASK+4 23400015 AREA EQU EVENT+4 23440015 TSKRLD EQU AREA+4 23480015 UA0215 EQU TSKRLD+4 23520015 UA100A EQU UA0215+4 23560015 DSAS EQU UA100A+4 23600015 EJECT 23640015 * OFFSETS IN COMPILER CONTROL TRANSFER VECTOR 23680015 SPACE 2 23720015 TV EQU *+X'3000' 23760015 ZUPL EQU TV+8 23800015 ZUGC EQU TV+X'10' 23840015 ZUTXTC EQU TV+X'14' 23880015 ZURC EQU TV+X'18' 23920015 LOADW EQU TV+X'24' 23960015 ZUERR EQU TV+X'30' 24000015 ZDRFAB EQU TV+X'34' 24040015 RELESE EQU TV+X'44' 24080015 RLSCTL EQU TV+X'48' 24120015 ZDUMP EQU TV+X'4C' 24140001 ZTXTAB EQU TV+X'54' 24160015 ZCHAIN EQU TV+X'58' 24200015 ZALTER EQU TV+X'5C' 24240015 ZULF EQU TV+X'70' 24280015 ZUSP EQU TV+X'74' 24320015 EJECT 24360015 * OFFSETS IN THE DICTIONARY COMMUNICATIONS REGION 24400015 SPACE 2 24440015 DICB EQU *+X'4000' 24480015 ZTRAN1 EQU DICB+68 24520015 ZTRAN2 EQU DICB+72 INTERNAL-EXTERNAL TRANSLATE TAB 24560015 ZMYNAM EQU DICB+112 NAME OF CURRENT PHASE 24600015 PAR1 EQU DICB+128 24640015 PAR2 EQU PAR1+4 24680015 PAR6 EQU PAR1+20 24720015 PAR7 EQU PAR1+24 24760015 PAR8 EQU PAR1+28 24800015 CCCODE EQU DICB+232 OPTIONS CODE BYTE 24840015 LDFIL EQU X'10' LOAD FILE REQUIRED 24880015 DECK EQU X'08' PUNCHED DECK REQUIRED 24920015 LISTFL EQU X'20' 24960015 TXTSZ EQU DICB+264 25000015 LOCK EQU DICB+274 25040015 ZCOMM EQU DICB+304 25080015 DICEXT EQU ZCOMM+48 1ST EXTERNAL ITEM 25120015 DICET1 EQU ZCOMM+66 HEAD OF ET1 CHAIN 25160015 STATH EQU ZCOMM+72 HEAD OF STATIC CHAIN 25200015 CONPOL EQU ZCOMM+2 1ST BLOCK OF CONSTANTS POOL 25240015 CONHD EQU ZCOMM+78 25280015 ZEQTAB EQU ZCOMM+32 25320015 PROGL EQU ZCOMM+52 25360015 ZFLAG4 EQU ZCOMM+19 25400015 ZCMPSR EQU X'10' 25440015 ZDSA EQU ZCOMM+94 HEAD OF STATIC DSA CHAIN 25480015 ZCPOFF EQU ZCOMM+100 25520015 ZSAVE EQU DICB+X'2C0' 25540001 EJECT 25560015 UA DC C'UA' 25600015 L BASR,PAR1 25640015 BC B,UA000 25680015 BC B,UA0015 25720015 BC B,UA021 25760015 BC B,UA033 25800015 BC B,* 25840015 BC B,* 25880015 BC B,* 25920015 BC B,* 25960015 BC B,* 26000015 BC B,* 26040015 SPACE 4 26080015 NXTPHS DC C'UBZZ' 26120015 EJECT 26160015 * BLOCK INITIALISIATION 26200015 * 26240015 * 26280015 * 26320015 * FUNCTION/OPERATION 26360015 * (1) LOADS SECONDARY BLOCKS IEMUB AND IEMUC 26400015 * (2) SETS UP CIRCULAR CHAIN OF RLD CARD BUFFERS 26440015 * (3) INITIALISES LOCATION COUNTER TO END OF STANDARD 10 26480015 * WORDS WHICH CONTAIN IN ORDER-- 26520015 * A CONSTANT OF X'1000' 26560015 * ADDRESS OF STATIC + X'1000'..ADDR OF STATIC+X'7000' 26600015 * ADDRESS OF LIBRARY ENTRY POINTS IHESADA AND IHESADB 26640015 * THE TEXT FOR THESE 10 WORDS IS ASSEMBLED INTO THE CARD BUFFERS 26680015 * 26720015 * 26760015 * 26800015 * ENTRY POINTS - UA000 FROM COMPILER CONTROL 26840015 * 26880015 * 26920015 * 26960015 * EXTERNAL ROUTINES 27000015 * LOADW IN COMPILER CONTROL TO LOAD IEMUB AND IEMUC 27040015 * LIST1 IN IEMUB TO PRINT HEADING FOR STATIC LISTING 27080015 * 27120015 * 27160015 * 27200015 * EXITS - NORMAL - FALLS THROUGH END OF ROUTINE 27240015 * 27280015 * 27320015 * 27360015 * EXITS - ERROR - NONE 27400015 SPACE 3 27440015 * SET UP BASE REGISTER FOR BLOCK , STORE PHASE NAME,AND LOAD 27480015 * SECOND BLOCK 27520015 UA000 LA WR1,NXTPHS 27560015 ST WR1,PAR1 27600015 L LR,LOADW 27640015 BALR RR,LR 27680015 L BASR2,PAR1 27720015 MVC ZMYNAM(2),UANAM 27760015 SPACE 2 27800015 * LOAD THIRD BLOCK 27840015 LA WR1,UCNAM 27880015 ST WR1,PAR1 27920015 BALR RR,LR 27960015 L WR4,PAR1 28000015 ST WR4,BAS3 28040015 SPACE 2 28080015 L WR1,ZEQTAB 28120015 LA WR1,64(WR1) 28160015 ST WR1,SCRCOR 28200015 LA WR1,384(WR1) 28240015 ST WR1,FSTBLK STRUCTURE INITIALISATION TABLE 28280015 SPACE 2 28320015 * LIST STANDARD 40 BYTES AT START OF STATIC 28360015 TM CCCODE,LISTFL 28400015 BC BNZ,*+8 28440015 BAL RR,LIST1 28480015 SPACE 2 28520015 * SET UP CIRCULAR CHAIN OF RLD CARDS 28560015 LA WR1,RLDCD2 28600015 ST WR1,RLDCD1+80 28640015 ST WR1,RLDSTO+4 STORE ADDR OF CURRENT BUFFER 28680015 MVI RLDCD1+80,X'FF' 28720015 LA WR1,RLDCD3 28760015 ST WR1,RLDCD2+80 28800015 LA WR1,RLDCD1 28840015 ST WR1,RLDCD3+80 28880015 LA WR1,TXTBUF 28920015 ST WR1,TXTAD 28960015 LA LOCCTR,48 INITIALISE LOCATION COUNTER 29000015 SPACE 5 29040015 * SET UP THE ADDRESS SLOT FOR THE COMPILER SUBROUTINE 29080015 SPACE 29120015 L WR1,PROGL 29160015 ST WR1,TXTCD+56 29200015 TM ZFLAG4,ZCMPSR 29240015 BC BZ,*+8 29280015 LA WR1,96(WR1) 29320015 ST WR1,TXTCD+60 29360015 SPACE 29400015 UA000A EQU * 29440015 * 29480015 * GENERATE RLD CARDS FOR THE ADDRESS SLOTS FOR STATIC 29520015 * DSA'S 29560015 * 29600015 SPACE 29640015 TM ZFLAG4,X'01' 29680015 BC BZ,UA000B 29720015 MVC RLDBUF(2),K2+2 SET UP RLD CARD STANDARD 29760015 MVC RLDBUF+2(2),K2+2 INFORMATION 29800015 MVI RLDBUF+4,X'0C' 29840015 MVC PAR1+2(2),ZDSA+2 29880015 UA000C CLC PAR1+2(2),ZERO 29920015 BC BE,UA000B 29960015 L LR,ZDRFAB 30000015 BALR RR,LR 30040015 L DEAR,PAR1 POINTER TO ENTRY IN STATIC 30080015 * DSA CHAIN 30120015 MVC TEM1+2(2),5(DEAR) 30160015 L PR1,12(DEAR) CLEAR FLAG BYTE 30200015 LA PR1,0(PR1) 30240015 ST PR1,TXTBUF 30280015 LA PR1,TXTBUF 30320015 LA PR2,4 30360015 BAL RR,TXTMOV PUT OUT TEXT CARD 30400015 SPACE 30440015 MVC RLDBUF+6(2),5(DEAR) 30480015 BAL RR,RLDMOV PUT OUT RLD CARD 30520015 SPACE 30560015 MVC PAR1+2(2),3(DEAR) 30600015 BC B,UA000C 30640015 UA000B EQU * 30680015 EJECT 30720015 EJECT 30760015 * INITIALISE SCALAR VARIABLES 30800015 * 30840015 * 30880015 * 30920015 * FUNCTION/OPERATION 30960015 * SCANS THE STATIC CHAIN DOWN TO THE FIRST EXTERNAL ITEM 31000015 * INITIALISING THE FOLLOWING-- 31040015 * (2) BCD FOR LABEL CONSTANTS, ENTRY LABELS, AND LABEL 31080015 * VARIABLES. 31120015 * (3) DEDS FOR TEMPORARIES 31160015 * (4) FILE ATTRIBUTES ENTRIES 31200015 * 31240015 * 31280015 * 31320015 * ENTRY POINTS 31360015 * (1) DROPS IN FROM PREVIOUS ROUTINE 31400015 * (4) UA0015 RETURN FROM EXTERNAL ROUTINES TO RESUME 31440015 * SCAN 31480015 * 31520015 * 31560015 * 31600015 * EXTERNAL ROUTINES 31640015 * (1) UA230 IN IEMUC WHICH INITIALISES DEDS FOR 31680015 * TEMPORARIES 31720015 * (2) UA220 IN IEMUC TO INITIALISE BCD FOR LABEL CONSTANTS 31760015 * OR ENTRY LABELS AND UA225 FOR LABEL VARIABLES 31800015 * (3) UA407 TO INITIALISE FILE ATTRIBUTES ENTRIES 31840015 * (5) TXTMOV IN IEMUB TO MOVE TEXT TO A CARD 31880015 * 31920015 * 31960015 * 32000015 * EXITS - NORMAL - UA010 IN THE NEXT ROUTINE 32040015 * 32080015 * 32120015 * 32160015 * EXITS - ERROR - NONE 32200015 SPACE 3 32240015 MVC PAR1+2(2),STATH PICK UP HEAD OF STATIC CHAIN 32280015 LA RR,UA0015 32320015 ST RR,LNKST1 STORE RETURN ADDRESS 32360015 BC B,UA001 32400015 SPACE 1 32440015 UA0015 MVC PAR1+2(2),STATCH(DEAR) PICK UP NEXT ENTRY IN CHAIN 32480015 UA001 CLC PAR1+2(2),ZERO TEST IF END OF STATIC CHAIN 32520015 BC BE,UA010 32560015 MVC LOCK(2),PAR1+2 LOCK DICTIONARY BLOCK CONTAINING 32600015 * CURRENT ENTRY 32640015 L LR,ZDRFAB 32680015 BALR RR,LR CONVERT D.R. TO ABS ADDR 32720015 L DEAR,PAR1 DEAR= ADDR OF DICT ENTRY 32760015 L RR,LNKST1 32800015 SPACE 1 32840015 * NOW IDENTIFY TYPE OF ENTRY AND BRANCH TO APPROPRIATE 32880015 * ROUTINE 32920015 L WR4,BAS3 32960015 CLI 0(DEAR),SIMDAT 33000015 BC BE,UA200 33040015 CLI 0(DEAR),LABVAR 33080015 BC BE,UA0015 33120015 CLI 0(DEAR),X'0C' TASK ENTRY 33160015 BC BE,UA0015 33200015 CLI 0(DEAR),X'0D' 33240015 BC BE,UA0015 TASK EVENT ENTRY 33280015 * INITIASED SO SCAN TO NEXT ITEM 33320015 CLI 0(DEAR),DED2 33360015 BC BE,UA230 DED FOR TEMPORARY 33400015 TM 0(DEAR),X'FE' 33440015 BC BE,UA220 ENTRY LABEL OR LABEL CONSTANT 33480015 CLI 0(DEAR),ATTRIB FILE ATTRIBUTES ENTRY 33520015 BC BE,UA407 33560015 CLI 0(DEAR),X'CE' IS IT LABEL VAR BCD ENTRY 33600015 BC BE,UA225 YES 33640015 CLI 0(DEAR),X'C3' 33680015 BC BE,UA220 33720015 SPACE 1 33760015 * IF ENTRY IS NOT ONE OF ABOVE TYPES WE HAVE COME TO END 33800015 * OF SIMPLE STATIC INTERNAL VARIABLES SO GO TO SCAN STATIC 33840015 * CHAIN FOR ITEMS NEEDING DOPE VECTORS 33880015 * 33920015 BC B,UA010 33960015 SPACE 5 34000015 UA200 TM DATOT2(DEAR),EXTFL 34040015 BC BNZ,UA010 34080015 TM DATDAT(DEAR),FL1 34120015 BC BNZ,UA0015 34160015 CLI CHAR1,X'00' 34200015 BC BNE,UA0015 34240015 MVC CHAR1(2),LOCK 34280015 BC B,UA0015 34320015 EJECT 34360015 * INITIALISATION OF ADDRESS CONSTANTS 34400015 * 34440015 * 34480015 * 34520015 * FUNCTION/OPERATION 34560015 * SCANS THE STATIC CHAIN STARTING AT THE FIRST CHARACTER 34600015 * ALIGNED ENTRY AND ENDING AFTER THE LAST EXTERNAL ITEM TO 34640015 * INITIALISE 4-BYTE ADDRESS CONSTANTS FOR THE FOLLOWING- STATIC 34680015 * EXTERNAL VARIABLES, EXTERNAL ENTRY NAMES, BUILT-IN AND 34720015 * INTERNAL FUNCTION, ENTRY LABELS, PROGRAMMER DECLARED CONDITION 34760015 * NAMES, AND EXTERNAL FILES. AN 8-BYTE SLOT IS INITIALISED FOR 34800015 * LABEL CONSTANTS. 34840015 * FOR INTERNAL FILES A 56-BYTE DCB IS INITIALIZED. THIS 34880015 * SUBROUTINE IS USED BY THE ROUTINE WHICH INITIALISES EXTERNAL 34920015 * VARIABLES FOR EXTERNAL FILES 34960015 * 35000015 * 35040015 * 35080015 * ENTRY POINTS 35120015 * (1) UA010 FROM PREVIOUS ROUTINE 35160015 * (2) UA407 TO MAKE UP 4 BYTES OF TEXT FOR FILE ATTRIBUTES 35200015 * ENTRY 35240015 * 35280015 * 35320015 * 35360015 * EXTERNAL ROUTINES 35400015 * (1) TXTMOV IN UB MOVES TXT TO CARD 35440015 * (2) RLDMOV IN UB MOVES RLD ENTRIES TO CARD 35480015 * 35520015 * 35560015 * 35600015 * EXITS - NORMAL 35640015 * (1) UA014 IN UC TO INITIALISE CONSTANTS POOL 35680015 * (2) UA0145 IN UC TO INITIALISE CONSTANTS POOL IF END OF 35720015 * STATIC CHAIN REACHED 35760015 * 35800015 * 35840015 * 35880015 * EXITS - ERROR - NONE 35920015 SPACE 3 35960015 UA010 MVC PAR1+2(2),CHAR1 36000015 MVI FLAG,ADFL SET FLAG TO SAY INITIALISATION 36040015 * OF ADDRESS SLOTS IN PROGRESS 36080015 BC B,UA0135 36120015 UA011 XR 2,2 36160015 TRT 0(1,DEAR),CODTAB TEST CODE BYTE 36200015 BC BZ,UA014 NOT INTERESTED SO END OF SCAN. 36240015 * NOW GO AND INSERT CONSTANTS POOL 36280015 * IN TEXT 36320015 BC B,*(2) 36360015 BC B,UA403 SCALAR VARIABLE 36400015 BC B,UA403 DIMENSIONED DATA VARIABLE 36440015 BC B,UA403 SCALAR LABEL VARIABLE 36480015 BC B,UA403 DIMENSIONED LABEL VARIABLE 36520015 BC B,UA403 STRUCTURE 36560015 BC B,UA403 DIMENSIONED STRUCTURE 36600015 BC B,UA406 36640015 BC B,UA400 LIBRARY ROUTINES 36680015 BC B,UA401 ON CONDITION 36720015 BC B,UA400 ENTRY TYPE 4 36760015 BC B,UA405 ENTRY LABELS 36800015 BC B,UA404 LABEL CNSTS. AND COMPILER LABS. 36840015 BC B,UA013 ORIGINAL ENTRY FOR GENERIC 36880015 * FUNCTION (NOT INTERESTED) 36920015 SPACE 1 36960015 * RETURN HERE FROM INSERTING TEXT AND PICK UP ADDRESS OF 37000015 * NEXT ITEM 37040015 UA013 CLC STATCH(2,DEAR),ZERO 37080015 BC BE,UA0145 END OF STATIC CHAIN SO ALL THE 37120015 * STATIC INTERNAL CSECT HAS BEEN 37160015 * INITIALISED . GO TO LOOK FOR ANY 37200015 * STATIC EXTERNAL VARIABLES AFTER 37240015 * MOVING CONSTANTS POOL 37280015 MVC PAR1+2(2),STATCH(DEAR) 37320015 UA0135 MVC LOCK(2),PAR1+2 37360015 L LR,ZDRFAB 37400015 BALR RR,LR 37440015 L DEAR,PAR1 37480015 BC B,UA011 GO TO TEST ENTRY 37520015 EJECT 37560015 * THIS ROUTINE INSERTS ONE-WORD ADDRESS CONSTANTS FOR 37600015 * EXTERNAL ITEMS 37640015 SPACE 2 37680015 * ENTER HERE FOR ENTRY TYPE 4 37720015 * SET CODE BYTE IN RLD ENTRY FOR V-TYPE CONSTANT OF 37760015 * LENGTH 4. 37800015 UA400 MVI RLDBUF+4,X'1C' 37840015 BC B,UA402 37880015 SPACE 1 37920015 * ENTER HERE FOR ALL FUNCTIONS 37960015 UA401 MVI RLDBUF+4,X'0C' SET CODE FOR A-TYPE 38000015 * CONSTANT OF LENGTH 4 38040015 UA402 MVC RLDBUF+5(3),DATOFS(DEAR) MOVE STATIC OFFSET OF ADDRESS 38080015 * SLOT TO RLD ENTRY 38120015 SR WR1,WR1 38160015 IC WR1,2(DEAR) LENGTH UPTO BCD 38200015 AR WR1,DEAR 38240015 BCTR WR1,0 38280015 BCTR WR1,0 WR1 = ADDR OF ESDID SLOT 38320015 MVC RLDBUF(2),0(WR1) SET RELOC HEADER = ESDID 38360015 BAL RR,RLDMOV MOVE RLD ENTRY TO CARD 38400015 XC TXTBUF(4),TXTBUF 38440015 CLI 0(DEAR),X'4D' TEST IF ON CONDITION NAME 38480015 BC BNE,UA4025 BRANCH IF NOT 38520015 MVI TXTBUF,X'50' IF SO 1ST BYTE OF SLOT=X'50' 38560015 UA4025 MVC TEM1+1(3),DATOFS(DEAR) 38600015 LA PR1,TXTBUF 38640015 LA PR2,4 38680015 BAL RR,TXTMOV MOVE 4 BYTES ZERO TEXT TO CARD 38720015 BC B,UA013 RETURN TO SCAN 38760015 SPACE 1 38800015 * ENTER HERE FOR DATA ITEMS . IF THE ITEM IS EXTERNAL IT 38840015 * NEEDS A 4-BYTE ADDRESS SLOT . IF IT IS AN INTERNAL ARRAY OR 38880015 * STRUCTURE THIS IS THE END OF THE EXTERNAL SECTION SO GO TO 38920015 * INSERT CONSTANTS POOL . IF THE ITEM IS AN INTERNAL SCALAR 38960015 * SCAN TO NEXT ITEM 39000015 UA403 TM DATOT2(DEAR),EXTFL 39040015 BC BNZ,UA401 BRANCH IF EXTERNAL 39080015 TM 0(DEAR),X'F0' 39120015 BC BZ,UA013 RETURN TO SCAN IF SCALAR 39160015 BC B,UA014 END OF SCAN 39200015 SPACE 1 39240015 * ENTER HERE FOR LABEL CONSTANTS . 39280015 UA404 TM DATOT1(DEAR),LDCON TEST IF LABEL REQUIRES LOAD 39320015 BC BZ,UA013 CONSTANT. RETURN TO SCAN IF NOT 39360015 SPACE 1 39400015 * TWO WORDS OF TEXT ARE REQUIRED. THE FIRST CONTAINS THE 39440015 * ADDRESS OF THE PSEUDO-REGISTER FOR THE BLOCK , AND THE 39480015 * SECOND CONTAINS THE ADDRESS OF THE LABEL 39520015 SPACE 2 39560015 * FIRST MAKE UP RLD ENTRY FOR P.R. 39600015 MVC TEM1+1(3),DATOFS(DEAR) 39640015 L WR2,TEM1 39680015 LA WR2,1(WR2) 39720015 ST WR2,RLDBUF+4 39760015 MVI RLDBUF+4,X'28' SET CODE FOR LENGTH 3 39800017 MVC PAR1+2(2),LABET1(DEAR) 39840015 L LR,ZDRFAB GET ADDRESS OF E.T.1 OF 39880015 BALR RR,LR CONTAINING BLOCK 39920015 L WR1,PAR1 39960015 MVC RLDBUF(2),ET1ESD(WR1) SET RELOC HEADER = ESD NO OF PR 40000015 * FOR BLOCK 40040015 BAL RR,RLDMOV MOVE RLD ENTRY TO CARD 40080015 SPACE 2 40120015 * NOW MAKE UP RLD ENTRY FOR ADDRESS OF LABEL 40160015 L WR2,RLDBUF+4 40200015 LA WR2,4(WR2) ADD 4 TO ASSEMBLED ADDRESS IN 40240015 ST WR2,RLDBUF+4 RLD ENTRY. 40280015 MVI RLDBUF+4,X'08' SET CODE BYTE FOR LENGTH = 3. 40320015 MVC RLDBUF(2),K1+2 SET RELOC HEADER TO ESDID OF 40360015 * PROGRAM (= 1) 40400015 BAL RR,RLDMOV MOVE RLD ENTRY TO CARD 40440015 SPACE 2 40480015 * NOW INSERT TEXT 40520015 * 40560015 * 1ST WORD IS ZERO . 2ND WORD CONTAINS ADDRESS OF LABEL AND 40600015 * THE 1ST BIT OF THE WORD IS A FLAG SET TO 1 TO INDICATE THAT 40640015 * THE 1ST WORD IS THE ADDRESS OF A PR. 40680015 XC TXTBUF(4),TXTBUF 40720015 SPACE 1 40760015 * THE LABEL MAY OCCUR EITHER IN THE PROLOG OF A PROCEDURE OR 40800015 * IN THE PROCEDURE SO THE OFFSET OF THE PROLOG OR PROCEDURE 40840015 * CODE FROM THE START OF THE PROCEDURE MUST BE ADDED TO THE 40880015 * OFFSET OBTAINED FROM THE LABEL ENTRY . TO THIS MUST ALSO BE 40920015 * ADDED THE OFFSET OF THE PROCEDURE FROM THE START OF THE 40960015 * PROGRAM 41000015 UA420 TM 0(WR1),X'01' TEST IF ET1 FROM PROCEDURE 41040015 BC BZ,UA421 41080015 MVC PAR1+2(2),ET1BAK(WR1) IF NOT SCAN BACK UP ET1 CHAIN 41120015 L LR,ZDRFAB UNTIL A PROCEDURE ENTRY IS FOUND 41160015 BALR RR,LR 41200015 L WR1,PAR1 41240015 BC B,UA420 41280015 SPACE 1 41320015 UA421 MVC TEM1+1(3),LABOFS(DEAR) 41360015 L WR2,TEM1 WR2= OFS OF LABEL IN PROC OR 41400015 * PROLOG CODE 41440015 TM LABCOD(DEAR),X'40' TEST IF LABEL IN PROC OR PROGOG 41480015 BC BNZ,UA423 CODE. BRANCH IF PROLOG 41520015 MVC TEM1+1(3),ET1OF3(WR1) TEM1= OFS OF PROC CODE 41560015 BC B,UA424 41600015 UA423 MVC TEM1+1(3),ET1OF2(WR1) TEM1= OFS OF PROLOG CODE 41640015 UA424 A WR2,TEM1 41680015 MVC TEM1+1(3),ET1OF5(WR1) 41720015 A WR2,TEM1 ADD OFFSET FROM START OF PROGRAM 41760015 ST WR2,TXTBUF+4 MOVE OFFSET TO TXT BUFFER 41800015 MVI TXTBUF+4,X'80' SET FLAG TO SAY PR IN 1ST WORD 41840015 MVC TEM1+1(3),DATOFS(DEAR) 41880015 LA PR1,TXTBUF 41920015 LA PR2,8 41960015 BAL RR,TXTMOV MOVE TEXT TO CARD 42000015 BC B,UA013 RETURN TO SCAN 42040015 SPACE 2 42080015 * ENTER HERE FOR ENTRY LABELS 42120015 * A 4-BYTE SLOT IS REQUIRED CONTAINING THE ADDRESS OF THE 42160015 * ENTRY POINT . THIS IS OBTAINED BY ADDING THE OFFSET OF THE 42200015 * LABEL IN ITS CONTAINING PROCEDURE TO THE OFFSET OF THE 42240015 * PROCEDURE FROM THE START OF THE PROGRAM 42280015 UA405 MVI RLDBUF+4,X'0C' SET CODE BYTE FOR LENGTH = 4 42320015 MVC RLDBUF+5(3),DATOFS(DEAR) MOVE STATIC OFFSET OF SLOT TO 42360015 * RLD ENTRY 42400015 MVC RLDBUF(2),K1+2 SET RELOC HEADER = ESDID OF 42440015 * PROGRAM (= 1) 42480015 BAL RR,RLDMOV 42520015 SPACE 1 42560015 MVC TEM1+1(3),ELOFS(DEAR) 42600015 L WR2,TEM1 42640015 SPACE 1 42680015 * CHAIN BACK THROUGH ET2 AND ET3 TO ET1 FOR CONTAINING 42720015 * PROCEDURE 42760015 MVC PAR1+2(2),ELET2(DEAR) 42800015 L LR,ZDRFAB 42840015 BALR RR,LR 42880015 L WR1,PAR1 42920015 MVC PAR1+2(2),ET2ET3(WR1) 42960015 BALR RR,LR 43000015 L WR1,PAR1 43040015 MVC PAR1+2(2),ET3ET1(WR1) 43080015 BALR RR,LR 43120015 L WR1,PAR1 43160015 UA4053 CLI 0(WR1),X'80' TEST IF ET1 FROM PROCEDURE 43200015 BC BE,UA4055 YES 43240015 MVC PAR1+2(2),ET1BAK(WR1) IF NOT SCAN THROUGH CIRCULAR 43280015 L LR,ZDRFAB CHAIN TILL PROC ET1 FOUND 43320015 BALR RR,LR 43360015 L WR1,PAR1 43400015 BC B,UA4053 43440015 SPACE 1 43480015 UA4055 MVC TEM1+1(3),ET1OF5(WR1) 43520015 A WR2,TEM1 ADD PROC OFFSET OT LABEL OFFSET 43560015 ST WR2,TXTBUF AND STORE IN TXT BUFFER 43600015 LA PR1,TXTBUF 43640015 LA PR2,4 43680015 MVC TEM1+1(3),DATOFS(DEAR) 43720015 BAL RR,TXTMOV MOVE TEXT TO CARD 43760015 BC B,UA013 RETURN TO SCAN 43800015 EJECT 43840015 * MAKE UP 56 BYTES OF TEXT FOR FILE CONSTANTS. THE 43880015 * TEXT IS PICKED UP FROM A D.E. POINTED AT FROM THE FILE 43920015 * CONSTANT ENTRY . EXTERNAL FILE CONSTANTS NEED A 4-BYTE 43960015 * ADDRESS SLOT 44000015 UA406 TM DATOT2(DEAR),EXTFL TEST IF EXTERNAL FILE CONSTANT. 44040015 BC BNZ,UA401 BRANCH IF SO. 44080015 * 44120015 SPACE 1 44160015 * FIRST TWO BYTES OF TEXT CONTAIN OFFSET OF PR FOR FILE SO 44200015 * MAKE RLD ENTRY 44240015 MVC RLDBUF(2),15(DEAR) SET RELOC HEADER = ESDID OF P.R. 44280015 MVI RLDBUF+4,X'24' 44320015 MVC RLDBUF+5(3),DATOFS(DEAR) 44360015 BAL RR,RLDMOV 44400015 LA WR1,UA013 44440015 ST WR1,LNKST1 SET UP RETURN ADDRESS 44480015 SPACE 1 44520015 * ENTER HERE TO MAKE UP 4 BYTES OF TEXT FOR ATTRIBUTE ENTRY 44560015 UA407 MVC TEM1+1(3),DATOFS(DEAR) 44600015 * NOW GET ADDRESS OF TXT 44640015 UA4071 MVC PAR1+2(2),8(DEAR) 44680015 L LR,ZDRFAB 44720015 BALR RR,LR 44760015 L WR1,PAR1 44800015 LA PR1,3(WR1) SET PR1 = ADDR OF TEXT 44840015 TM 0(DEAR),X'80' TEST IF ATTRIBUTES ENTRY OR FILE 44880015 BC BZ,UA4073 CONSTANT 44920015 LA PR2,4 LENGTH OF TXT = 8 FOR ATTRIBUTES 44960015 BC B,UA4074 ENTRY 45000015 UA4073 LA PR2,56 LENGTH = 56 FOR FILE CONSTANT 45040015 UA4074 BAL RR,TXTMOV MOVE TXT TO CARD 45080015 L RR,LNKST1 45120015 BCR B,RR RETURN 45160015 SPACE 2 45200015 EJECT 45240015 * SCAN OF REMAINDER OF STATIC CHAIN 45280015 * 45320015 * 45360015 * 45400015 * FUNCTION/OPERATION 45440015 * (1) INITIALISES TEXT FOR DOPE VECTOR SKELETONS OF 45480015 * AUTOMATIC VARIABLES 45520015 * (2) INITIALISES TEXT FOR ARGUMENT LISTS 45560015 * (3) SINCE ARRAYS CANNOT BE INITIALISED AT PRESENT NO 45600015 * TEXT IS PRODUCED FOR THEM BUT FOR ARRAYS WITH NEGATIVE VIRTUAL 45640015 * ORIGIN BUT NO DOPE VECTOR A 4-BYTE SLOT IS NEEDED WHICH 45680015 * CONTAINS THE VIRTUAL ORIGIN. 45720015 * (4) INITIALISES TEXT FOR ANY SCALAR INTERNAL STRUCTURE 45760015 * ELEMENTS WITH THE INITIAL ATTRIBUTE 45800015 * 45840015 * 45880015 * 45920015 * ENTRY POINTS 45960015 * (1) UA021 FROM UB AFTER INITIALISING CONSTANTS POOL 46000015 * (2) UA033 FROM ROUTINES IN UB WHICH INITIALISE DOPE 46040015 * VECTOR SKELETONS, ARGUMENT LISTS, DEDS AND SYMBOL TABLES, TO 46080015 * CONTINUE SCAN OF STATIC CHAIN 46120015 * (3) UA034 FROM STATIC EXTERNAL ROUTINE TO INITIALISE 46160015 * TEXT FOR DATA ARRAYS 46200015 * (4) UA031 FROM STATIC EXTERNAL ROUTINE TO INITIALISE 46240015 * TEXT FOR LABEL ARRAYS 46280015 * (5) UA041 FROM STATIC EXTERNAL ROUTINE TO INITIALISE 46320015 * TEXT FOR STRUCTURES 46360015 * 46400015 * 46440015 * 46480015 * EXTERNAL ROUTINES 46520015 * (1) TXTMOV IN UB TO MOVE TXT TO CARD 46560015 * (2) RLDMOV IN UB TO MOVE RLD ENTRIES TO CARD 46600015 * (3) UA0215 IN UB TO INITIALISE DOPE VECTOR SKELETONS 46640015 * (4) UA025 IN UC TO INITIALISE ARGUMENT LISTS 46680015 * (5) UA080 IN UC TO INITIALISE DEDS AND SYMBOL TABLE 46720015 * ENTRIES. 46760015 * 46800015 * 46840015 * 46880015 * EXITS - NORMAL - UA100A TO LOAD UD 46920015 * 46960015 * 47000015 * 47040015 * EXITS - ERROR - NONE 47080015 SPACE 3 47120015 * NOW MAKE UP ANY DOPE VECTOR SKELETONS FOR AUTOMATIC 47160015 * VARIABLES 47200015 SPACE 2 47240015 UA021 MVI CODTAB+X'98',X'44' SET UP ENTRIES IN TRANSLATE 47280015 MVI CODTAB+X'C1',X'40' TABLE FOR FILE ATTRIBUTES, DED2S, 47320015 MVI CODTAB+X'C7',X'48' AND SYMBOL TABLE ENTRIES 47360015 MVI CODTAB+X'C3',X'34' 47400015 MVI CODTAB+X'C9',X'44' SET RDV CODE BYTE ENTRY 60073 47410072 MVI CODTAB+X'CC',X'44' 23305 47420019 SPACE 4 47440015 UA022 L WR4,BAS3 47480015 CLI 0(DEAR),DIMLAB 47520015 BC BE,UA033 47560015 CLI 0(DEAR),DIMDAT 47600015 BC BE,UA033 47640015 CLI 0(DEAR),STRUCT 47680015 BC BE,UA033 47720015 CLI 0(DEAR),DIMSTR 47760015 BC BE,UA033 47800015 CLI 0(DEAR),ARG 47840015 BC BE,UA025 47880015 CLI 0(DEAR),DVSKEL 47920015 BC BE,UA0215 47960015 CLI 0(DEAR),SYMTAB 48000015 BC BE,UA080 48040015 CLI 0(DEAR),RDVRDV 48080015 BC BE,ADDRDV 48120015 CLI 0(DEAR),DVDDVD 48160015 BC BE,ADDRDV 48200015 SPACE 1 48240015 * NOW GET NEXT ENTRY ON STATIC CHAIN 48280015 UA033 CLC STATCH(2,DEAR),ZERO 48320015 L WR4,BAS3 48360015 BC BE,UA100A END OF CHAIN SO GO TO INITIALISE 48400015 * ANY EXTERNAL VARIABLES 48440015 MVC PAR1+2(2),STATCH(DEAR) 48480015 MVC LOCK(2),STATCH(DEAR) 48520015 L LR,ZDRFAB 48560015 BALR RR,LR 48600015 L DEAR,PAR1 48640015 L RR,LNKST1 48680015 BC B,UA022 48720015 EJECT 48760015 * ARGUMENT LIST ROUTINE 48800015 * 48840015 * 48880015 * 48920015 * FUNCTION/OPERATION 48960015 * ON FINDING A DICTIONARY ENTRY FOR AN ARGUMENT LIST 49000015 * TEXT IS MADE UP FOR IT ACCORDING TO THE 3-BYTE ITEMS IN IT. 49040015 * EACH 3-BYTE ITEM CONSISTS EITHER OF A CODE BYTE INDICATING A 49080015 * 3 OR 4 BYTE ADDRESS CONSTANT FOLLOWED BY A DICTIONARY 49120015 * REFERENCE, OR A CODE BYTE INDICATING A 1 OR 3 BYTE CONSTANT 49160015 * WITH THE CONSTANT ITSELF IN THE NEXT 2 BYTES 49200015 * THE POSSIBLE DICTIONARY REFERENCES ARE 49240015 * (1) VARIABLE (ADDRESS OF DATA) 49280015 * (2) VARIABLE + 1 (ADDRESS OF DOPE VECTOR) 49320015 * (3) VARIABLE + 2 (ADDRESS OF DED) 49360015 * (4) STRUCTURE (ADDRESS OF DOPE VECTOR) 49400015 * (5) FILE (ADDRESS OF DECLARE CONTROL BLOCK) 49440015 * (6) FUNCTION (ADDRESS OF ENTRY POINT) 49480015 * (7) ENTRY LABEL (ADDRESS OF ENTRY) 49520015 * (8) LABEL CONSTANT (ADDRESS OF LABEL) 49560015 * (9) COMPILER LABEL (ADDRESS OF LABEL) 49600015 * (10) CONSTANT ( ADDRESS OF CONSTANT) 49640015 * (11) CONSTANT +1 ( ADDRESS OF DOPE VECTOR) 49680015 * (12) CONSTANT +2 ( ADDRESS OF DED) 49720015 * (13) DED2 (ADDRESS OF DED) 49760015 * (14) FILE ATTRIBUTES (ADDRESS OF FILE ATTRIBUTES) 49800015 * (15) ENTRY TYPE 1 (ADDRESS OF FIRST SYMBOL TABLE ENTRY 49840015 * FOR THE BLOCK) 49880015 * (16) SYMBOL TABLE (ADDRESS OF SYMBOL TABLE ENTRY) 49920015 * 49960015 * 50000015 * 50040015 * ENTRY POINTS - UA025 FROM STATIC CHAIN SCAN IN UA 50080015 * 50120015 * 50160015 * 50200015 * EXTERNAL ROUTINES 50240015 * (1) TXTMOV 50280015 * (2) RLDMOV 50320015 * 50360015 * 50400015 * 50440015 * EXITS NORMAL-UA033 TO RESUME SCAN OF STATIC CHAIN 50480015 * 50520015 * 50560015 * 50600015 * EXITS - ERROR - NONE 50640015 * 50680015 * 50720015 * 50760015 * NOTES 50800015 * DEAR IS KEPT POINTING AT THE START OF THE ARGUMENT LIST 50840015 * DICTIONARY ENTRY WHICH IS LOCKED IN CORE 50880015 * WR4 IS USED TO SCAN THROUGH THE DICTIONARY ENTRY 50920015 * WR3 IS USED TO CONTAIN THE ADDRESSES OF DICTIONARY 50960015 * ENTRIES OF ITEMS IN THE LIST. 51000015 * WR1 POINTS AT THE END OF THE LIST AND IS USED FOR 51040015 * TESTING FOR THE END. 51080015 SPACE 3 51120015 * THE DICTIONARY ENTRY CONTAINS A LIST OF 3-BYTE PSEUDO-CODE 51160015 * ITEMS WHICH MAY HAVE THE OPERATORS DCV1, DCV2, DCA3, DCA4. 51200015 UA025 LA WR4,10(DEAR) WR4 POINTS TO FIRST ARGUMENT 51240015 MVC TEM1+2(2),1(DEAR) 51280015 LH WR1,TEM1+2 51320015 AR WR1,DEAR WR1 POINTS TO BYTE AFTER END OF 51360015 * LIST 51400015 MVC TEM1+1(3),DATOFS(DEAR) STORE STATIC OFFSET OF LIST 51440015 * IDENTIFY TYPE OF PSEUDO-CODE ITEM 51480015 UA026 CLI 0(WR4),DCV1 51520015 BC BE,UA0261 51560015 CLI 0(WR4),DCV3 51600015 BC BE,UA0262 51640015 CLI 0(WR4),DCV4 51680015 BC BE,UA0251 BRANCH IF DCV4 51720015 SPACE 1 51760015 * FALL THROUGH IF DCA3 OR DCA4 51800015 CLI 0(WR4),DCA3 51840015 BC BE,UA0263 BRANCH IF DCA3 51880015 CLI 0(WR4),DCA4 51920015 BC BE,*+8 IF NOT DCA4 THIS IS AN 51960015 BAL RR,UA UNEXPECTED PSEUDO CODE ITEM 52000015 SPACE 1 52040015 * 4 BYTES OF TEXT NEEDED 52080015 LA PR1,TXTBUF 52120015 LA PR2,4 52160015 XC TXTBUF(1),TXTBUF 52200015 BC B,UA0267 52240015 SPACE 1 52280015 * 3 BYTES OF TEXT NEEDED 52320015 UA0263 LA PR1,TXTBUF+1 52360015 LA PR2,3 52400015 SPACE 1 52440015 * THE OPERAND FIELD IS EITHER ZERO OR ONE OF THE FOLLOWING 52480015 * (1) DR + 0 ADDRESS OF DATA REQUIRED 52520015 * (2) DR + 1 ADDRESS OF D.V. REQUIRED 52560015 * (3) DR + 2 ADDRESS OF DED REQUIRED 52600015 * IF OPERAND IS ZERO 3OR 4 BYTES OF ZERO TEXT ARE REQUIRED 52640015 UA0267 CLC 1(2,WR4),ZERO 52680015 BC BNE,UA027 52720015 XC TXTBUF+1(3),TXTBUF+1 52760015 BAL RR,TXTMOV MOVE ZERO TEXT TO CARD 52800015 BC B,UA0269 GO TO LOOK FOR NEXT ARG 52840015 SPACE 1 52880015 * CONVERT OPERAND TO ABSOLUTE ADDRESS AND IDENTIFY D.E. 52920015 * CODE BYTE 52960015 UA027 MVC TEM2+2(2),1(WR4) 53000015 NI TEM2+3,X'FC' CLEAR LAST 2 BITS OF D.R. 53040015 MVC PAR1+2(2),TEM2+2 53080015 L LR,ZDRFAB 53120015 BALR RR,LR 53160015 L WR3,PAR1 53200015 * IDENTIFY CODE BYTE 53240015 XR 2,2 53280015 TRT 0(1,WR3),CODTAB 53320015 BC BNZ,*+8 53360015 BAL RR,UA 53400015 BC B,*(2) 53440015 BC B,UA0264 SCALAR DATA VAR 53480015 BC B,UA0264 DATA ARRAY 53520015 BC B,UA0281 LABEL VAR 53560015 BC B,UA0281 LABEL ARRAY 53600015 BC B,UA0282 STRUCTURE 53640015 BC B,UA0282 DIM. STRUCTURE 53680015 BC B,UA0271 FILE CONSTANT 53720015 BC B,UA0276 FUNCTION 53760015 BC B,UA0276 FILE OR TASK 53800015 BC B,UA0276 ENTRY TYPE 4 53840015 BC B,UA0284 ENTRY LABEL 53880015 BAL RR,UA LABEL CONSTANT 53920015 BC B,UA0285 COMPILER LABEL 53960015 BC B,UA0255 ENTRY TYPE 1 54000015 BC B,UA0256 CONSTANT 54040015 BC B,UA0257 DED2 54080015 BC B,UA0257 FILE, RDV OR DVD 54120015 BC B,UA0279 54160015 SPACE 3 54200015 * BRANCH HERE FOR DATA VARIABLES 54240015 UA0264 TM 2(WR4),X'02' TEST LAST BITS OF D.R. 54280015 BC BO,UA0274 BRANCH IF DED REQUIRED 54320015 TM 2(WR4),X'01' 54360015 BC BZ,UA0271 BRANCH IF DATA ADDR REQUIRED 54400015 SPACE 1 54440015 * ADDR OF D.V. REQUIRED 54480015 * IF VARIABLE IS INTERNAL PICK UP DV OFFSET FROM OFFSET 2 54520015 * SLOT. IF EXTERNAL THE D.V. OFFSET IS ZERO 54560015 TM DATOT2(WR3),EXTFL 54600015 BC BZ,UA0265 BRANCH IF INTERNAL 54640015 TM 0(WR3),X'20' 54680015 BC BZ,UA0276 54720015 MVC TXTBUF+1(3),DATOF2+1(WR3) 54760015 BC B,UA027X 54800015 SPACE 2 54840015 * BRANCH HERE FOR FILES,TASKS, AND ENTRY TYPE 4S WHICH CAN 54880015 * BE TREATED IN THE SAME WAY AS EXTERNAL VARIABLES 54920015 UA0276 XC TXTBUF+1(3),TXTBUF+1 54960015 UA027X MVC TEM2+2(2),1(WR3) 55000015 LH WR2,TEM2+2 55040015 AR WR2,WR3 WR2 POINTS TO BCD 55080015 BCTR WR2,0 55120015 BCTR WR2,0 WR2 POINTS TO ESDID OF CSECT 55160015 MVC RLDBUF(2),0(WR2) SET RELOC HEADER = ESDID 55200015 BC B,UA0275 GO TO MOVE TEXT TO CARD 55240015 SPACE 1 55280015 * HERE FOR SYMTAB ENTRIES 55320015 UA0279 MVC TXTBUF+1(3),SYMOFS(WR3) PICK UP STATIC OFFSET OF SYMTAB 55360015 BC B,UA0273 55400015 SPACE 1 55440015 * D.V. OF INTERNAL VARIABLE REQUIRED 55480015 UA0265 MVC TXTBUF+1(3),DATOF2+1(WR3) PICK UP OFFSET OF D.V. 55520015 UA0273 MVC RLDBUF(2),K2+2 SET RELOC HEADER =2 55560015 SPACE 1 55600015 * TEST IF ADDRESS OF LENGTH 3 OR 4 BYTES AND MAKE RLD ENTRY 55640015 UA0275 CLI 0(WR4),DCA3 55680015 BC BNE,UA0277 55720015 MVI RLDBUF+4,X'08' SET LENGTH = 3 55760015 BC B,UA0278 55800015 UA0277 MVI RLDBUF+4,X'0C' SET LENGTH = 4 55840015 UA0278 MVC RLDBUF+5(3),TEM1+1 55880015 BAL RR,RLDMOV 55920015 ST WR4,FSTADD SAVE POINTER 55960015 L WR4,BAS3 LOAD BASE OF UC 56000015 BAL RR,TXTMOV 56040015 L WR4,FSTADD RESTORE POINTER 56080015 BC B,UA0269 GO TO SCAN FOR NEXT ARG 56120015 SPACE 2 56160015 * ADDRESS OF DATA ITSELF IS REQUIRED 56200015 * IF VARIABLE INTERNAL PICK UP OFFSET FROM OFFSET 1 SLOT. IF 56240015 * EXTERNAL,OFFSET IS ZERO. 56280015 UA0271 TM DATOT2(WR3),EXTFL 56320015 BC BNZ,UA027A BRANCH IF EXTERNAL 56360015 MVC TXTBUF+1(3),DATOFS(WR3) PICK UP OFFSET OF DATA 56400015 BC B,UA0273 56440015 SPACE 2 56480015 UA027A CLI 0(WR3),X'08' 56520015 BC BE,UA0276 56560015 TM 0(WR3),X'20' 56600015 BC BNO,UA027B BRANCH IF NOT STRUCTURED 56640015 MVC TXTBUF+1(3),DATOFS(WR3) OFFSET IN STRUCTURE 56680015 BC B,UA027X 56720015 SPACE 56760015 UA027B TM 0(WR3),X'0F' 56800015 BC BNO,UA0276 BRANCH IF LABEL 56840015 TM DATDAT(WR3),FL1 OFFSET = 1 FOR CAD DATA 56880015 BC BNZ,UA0276 56920015 MVC TXTBUF+1(3),K8+1 OFFSET = 8 FOR CHAR OR BIT 56960015 BC B,UA027X 57000015 SPACE 2 57040015 * ADDRESS OF DED IS REQUIRED 57080015 * THE D.E. OF THE VARIABLE POINTS TO EITHER A DED, PICTURE, 57120015 * OR SYMBOL TABLE ENTRY. THESE ALL CONTAINS THE STATIC OFFSET 57160015 * OF THE DED 57200015 UA0274 MVC PAR1+2(2),DATSYM(WR3) 57240015 UA0270 EQU * 57280015 BALR RR,LR 57320015 L WR2,PAR1 WR2 POINTS TO DED,PICT, OR SYMTB 57360015 MVC TXTBUF+1(3),DEDOFS(WR2) PICK UP DED OFFSET 57400015 BC B,UA0273 57440015 SPACE 3 57480015 * BRANCH HERE FOR LABEL VARIABLES 57520015 UA0281 TM 2(WR4),X'01' 57560015 BC BZ,UA0271 57600015 TM DATOT2(WR3),EXTFL 57640015 BC BNZ,UA028X 57680015 MVC TXTBUF+1(3),LABOF2+1(WR3) PICK UP OFFSET OF D.V. 57720015 BC B,UA0273 57760015 UA028X TM 0(WR3),X'20' 57800015 BC BZ,UA0276 57840015 MVC TXTBUF+1(3),LABOF2+1(WR3) 57880015 BC B,UA027X 57920015 SPACE 2 57960015 * HERE FOR STRUCTURES (D.V. ADDR REQD) 58000015 UA0282 TM DATOT2(WR3),EXTFL 58040015 BC BNZ,UA028Y 58080015 MVC TXTBUF+1(3),LABOF2+1(WR3) 58120015 BC B,UA0273 58160015 UA028Y TM DATOT4(WR3),MAJST 58200015 BC BNZ,UA0276 58240015 MVC TXTBUF+1(3),LABOF2+1(WR3) 58280015 BC B,UA027X 58320015 SPACE 3 58360015 * BRANCH HERE FOR ENTRY LABELS 58400015 * THE ADDRESS OF THE ENTRY POINT ITSELF IS REQUIRED AND IS 58440015 * CALCULATED BY ADDING THE OFFSET OF THE LABEL WITHIN ITS PROC 58480015 * TO THE OFFSET OF THE PROC WITHIN THE PROGRAM. 58520015 UA0284 MVC RLDBUF(2),K1+2 SET RELOC HEADER =1 58560015 SPACE 1 58600015 * SCAN BACK THROUGH THE ENTRY TYPES 2 AND 3 TO THE ENTRY 58640015 * TYPE1 FOR THE CONTAINING PROC 58680015 MVC TXTBUF+1(3),ELOFS(WR3) 58720015 MVC PAR1+2(2),ELET2(WR3) 58760015 BALR RR,LR 58800015 L WR2,PAR1 58840015 MVC PAR1+2(2),ET2ET3(WR2) 58880015 BALR RR,LR 58920015 L WR2,PAR1 58960015 MVC PAR1+2(2),ET3ET1(WR2) 59000015 BALR RR,LR 59040015 L WR2,PAR1 59080015 SPACE 1 59120015 MVC TXTBUF+1(3),ELOFS(WR3) 59160015 MVC TXTBUF+5(3),ET1OF5(WR2) 59200015 NI TXTBUF+4,X'00' 59240015 L WR2,TXTBUF+4 59280015 A WR2,TXTBUF ADD OFFSET OF LABEL WITHIN PROC 59320015 ST WR2,TXTBUF 59360015 BC B,UA0275 59400015 SPACE 3 59440015 * BRANCH HERE FOR COMPILER LABELS 59480015 SPACE 1 59520015 UA0285 MVC PAR1+2(2),LABET1(WR3) 59560015 MVC TEM2+1(3),LABOFS(WR3) LABEL OFFSET 59570001 MVC UALAB(1),LABCOD(WR3) LABEL FLAG BYTE 59580001 * GET ADDRESS OF ET1 OF 59600015 BALR RR,LR CONTAINING BLOCK 59640015 L WR7,PAR1 59680015 * NOW MAKE UP RLD ENTRY FOR ADDRESS OF LABEL 59720015 MVC RLDBUF+5(3),TEM1+1 59760015 MVC RLDBUF(2),K1+2 SET RELOC HEADER TO ESDID OF 59800015 * PROGRAM (= 1) 59840015 SPACE 2 59880015 * NOW INSERT TEXT 59920015 * 59960015 SPACE 1 60000015 * THE LABEL MAY OCCUR EITHER IN THE PROLOG OF A PROCEDURE OR 60040015 * IN THE PROCEDURE SO THE OFFSET OF THE PROLOG OR PROCEDURE 60080015 * CODE FROM THE START OF THE PROCEDURE MUST BE ADDED TO THE 60120015 * OFFSET OBTAINED FROM THE LABEL ENTRY . TO THIS MUST ALSO BE 60160015 * ADDED THE OFFSET OF THE PROCEDURE FROM THE START OF THE 60200015 * PROGRAM 60240015 UA0286 TM 0(WR7),X'01' TEST IF CONTAINING BLOCK IS A 60280015 BC BZ,UA0287 PROCEDURE 60320015 MVC PAR1+2(2),ET1BAK(WR7) IF NOT SCAN BACK UP ET1 CHAIN 60360015 BALR RR,LR 60400015 L WR7,PAR1 60440015 BC B,UA0286 60480015 SPACE 1 60520015 * PROCEDURE ENTRY FOUND 60560015 UA0287 EQU * 60600001 L WR2,TEM2 WR2 = OFFSET OF LABEL IN PROLOG 60640015 * OR PROCEDURE 60680015 TM UALAB,X'40' TEST IF LABEL IN PROLOGUE 60720001 BC BNZ,UA0288 BRANCH IF SO 60760015 MVC TEM2+1(3),ET1OF3(WR7) TEM2 = OFFSET OF PROC CODE 60800015 BC B,UA0289 60840015 UA0288 MVC TEM2+1(3),ET1OF2(WR7) TEM2 = OFFSET OF PRO6OG CODE 60880015 UA0289 A WR2,TEM2 60920015 MVC TEM2+1(3),ET1OF5(WR7) 60960015 A WR2,TEM2 ADD PROC OFFSET 61000015 ST WR2,TXTBUF 61040015 BC B,UA0275 61080015 SPACE 1 61120015 * ENTER HERE FOR ENTRY TYPE 1. THE SLOT IS REQUIRED TO 61160015 * CONTAIN THE ADDRESS OF THE FIRST SYMBOL TABLE ENTRY FOR THE 61200015 * BLOCK 61240015 UA0254 MVC PAR1+2(2),ET1BAK(WR3) 61280015 CLC PAR1+2(2),ZERO IF NO FURTHER BACK CHAIN PROG 61320015 BC BE,UA0258 CONTAINS NO SYMTAB ENTRIES. GO 61360015 * TO WRITE ERROR MESSAGE 61400015 BALR RR,LR SCAN BACK TO FIRST ET1 WITH 61440015 L WR3,PAR1 SYMTAB CHAIN 61480015 UA0255 CLC ET1SYM(2,WR3),ZERO 61520015 BC BE,UA0254 61560015 MVC PAR1+2(2),ET1SYM(WR3) 61600015 BALR RR,LR 61640015 L WR2,PAR1 61680015 MVC PAR1+2(2),DATSYM(WR2) 61720015 BALR RR,LR 61760015 L WR2,PAR1 61800015 MVC TXTBUF+1(3),SYMOFS(WR2) 61840015 BC B,UA0273 61880015 SPACE 2 61920015 * WRITE ERROR MESSAGE 61960015 UA0258 MVC PAR6+1(3),SYMERR 62000015 L LR,ZUERR 62040015 BALR RR,LR 62080015 XC TXTBUF+1(3),TXTBUF 62120015 ST WR4,FSTADD SAVE POINTER 62160015 L WR4,BAS3 LOAD BASE OF UC 62200015 BAL RR,TXTMOV 62240015 L WR4,FSTADD RESTORE POINTER 62280015 BC B,UA0269 62320015 SPACE 62360015 SYMERR DC X'0B5204' 62400015 SPACE 2 62440015 * BRANCH HERE FOR CONSTANTS. THE TEXT MAY BE REQUIRED TO 62480015 * CONTAIN THE ADDRESS OF THE CONSTANT ITSELF, ITS D.V., OR 62520015 * ITS DED 62560015 UA0256 TM 2(WR4),X'02' 62600015 BC BZ,UA0257 62640015 * FALL THROUGH IF DED REQUIRED 62680015 MVC PAR1+2(2),CONDED(WR3) 62720015 BC B,UA0270 62760015 SPACE 1 62800015 * ADDRESS OF D.V. OR DATA REQUIRED 62840015 UA0257 MVC TXTBUF+1(3),DATOFS(WR3) 62880015 TM 2(WR4),X'01' TEST IF D.V. ADDRESS IS REQD 62920015 BC BZ,UA0273 NO 62960015 NI TXTBUF,X'00' 63000015 L WR6,TXTBUF D.V. OCCUPIES 8 BYTES 63040015 S WR6,K8 IMMEDIATELY BEFORE CONSTANT 63080015 ST WR6,TXTBUF 63120015 BC B,UA0273 63160015 SPACE 3 63200015 * PSEUDO-CODE ITEM IS A DCV . THE OPERAND FIELD CONTAINS A 63240015 * CONSTANT TO BE MOVED INTO 1, 3, OR 4 BYTES OF TEXT 63280015 UA0251 LA PR1,TXTBUF 63320015 XC TXTBUF(2),TXTBUF 63360015 MVC TXTBUF+2(2),1(WR4) 63400015 LA PR2,4 63440015 BC B,UA0268 63480015 SPACE 1 63520015 UA0261 LA PR1,2(WR4) 1 BYTE OF TXT REQUIRED 63560015 LA PR2,1 63600015 BC B,UA0268 63640015 SPACE 1 63680015 UA0262 LR PR1,WR4 63720015 XC 0(1,WR4),0(WR4) 63760015 LA PR2,3 63800015 UA0268 ST WR4,FSTADD SAVE POINTER 63840015 L WR4,BAS3 LOAD BASE OF UC 63880015 BAL RR,TXTMOV 63920015 L WR4,FSTADD RESTORE POINTER 63960015 SPACE 3 64000015 * TEST IF ANY MORE ARGUMENTS IN LIST. IF NOT CONTINUE SCAN 64040015 * OF STATIC CHAIN 64080015 UA0269 LA WR4,3(WR4) 64120015 CR WR4,WR1 64160015 BC BE,UA033 BRANCH IF NO MORE ARGS 64200015 ST LOCCTR,TEM1 UPDATE TEM1 TO STATIC OFFSET OF 64240015 BC B,UA026 NEXT ARG AND GO TO MAKE UP TEXT 64280015 * FOR IT 64320015 EJECT 64360015 * CONSTANTS POOL ROUTINE 64400015 * 64440015 * 64480015 * 64520015 * FUNCTION/OPERATION 64560015 * THE CONSTANTS HAVE BEEN ARRANGED IN A SERIES OF CHAINED 64600015 * BLOCKS IN THE DICTIONARY. THESE BLOCKS ARE MOVED BODILY TO TXT 64640015 * CARDS. RLD ENTRIES ARE MADE FOR THE ADDRESSES OF THE CONSTANTS 64680015 * IN THEIR DOPE VECTORS IF THEY HAVE ONE BY SCANNING THE CHAIN 64720015 * OF CONSTANT DICTIONARY ENTRIES. 64760015 * 64800015 * 64840015 * 64880015 * ENTRY POINTS 64920015 * (1)UA014 AFTER FINDING END OF EXTERNAL SECTION OF STATIC 64960015 * CHAIN IN SCAN TO INITIALISE ADDRESS CONSTANTS 65000015 * (2) UA0145 IF THE END OF THE STATIC CHAIN WAS FOUND IN 65040015 * THE ADDRESS CONSTANT SCAN 65080015 * 65120015 * 65160015 * 65200015 * EXTERNAL ROUTINES 65240015 * (1) TXTMOV 65280015 * (2) RLDMOV 65320015 * 65360015 * 65400015 * 65440015 * EXITS - NORMAL 65480015 * (1) UA021 TO CONTINUE SCAN OF STATIC CHAIN 65520015 * (2) UA100 TO INITIALISE EXTERNAL CSECTS IF END OF STATIC 65560015 * CHAIN HAS ALREADY BEEN FOUND 65600015 * 65640015 * 65680015 * 65720015 * EXITS ERROR - NONE 65760015 SPACE 3 65800015 UA0145 XR DEAR,DEAR ZERO DEAR TO INDICATE END OF 65840015 * STATIC CHAIN REACHED 65880015 BC B,UA0146 65920015 UA014 MVC LCKSTO(2),LOCK 65960015 UA0146 CLC CONPOL(2),ZERO 66000015 BC BE,UA016 THERE IS NO CONSTANTS POOL 66040015 SPACE 1 66080015 * GET ADDRESS OF 1ST CONSTANT 66120015 MVI FLAG,CONFL SET FLAG TO SAY CONSTANTS POOL 66160015 * BEING INITIALIZED 66200015 MVC TEM1(4),ZCPOFF 66240015 MVC PAR1+2(2),CONPOL 66280015 SPACE 1 66320015 UA015 L LR,ZDRFAB 66360015 BALR RR,LR GET ADDR OF 1ST BLOCK OF 66400015 L WR1,PAR1 CONSTANTS 66440015 LA PR1,8(WR1) PR1 = ADDR OF START OF CONSTANTS 66480015 MVC TEM2+2(2),1(WR1) 66520015 LH PR2,TEM2+2 PR2 = LENGTH OF BLOCK 66560015 S PR2,K8 PR2 = LENGTH OF CONSTANTS 66600015 BAL RR,TXTMOV MOVE BLOCK TO CARD 66640015 SPACE 1 66680015 CLI 3(WR1),X'FF' TEST IF LAST BLOCK 66720015 BC BNE,UA0157 BRANCH IF SO 66760015 MVC PAR1+2(2),4(WR1) 66800015 ST LOCCTR,TEM1 66840015 BC B,UA015 66880015 SPACE 2 66920015 * SCAN CONSTANTS CHAIN TO RELOCATE ADDRESSES IN DOPE 66960015 * VECTORS 67000015 UA0157 MVC PAR1+2(2),CONHD 67040015 MVC RLDBUF(2),K2+2 SET RELOC HEADER =2 67080015 UA0158 L LR,ZDRFAB 67120015 BALR RR,LR 67160015 L WR1,PAR1 GET ADDRESS OF D.E. OF CONSTANT 67200015 TM CONCD(WR1),X'01' TEST IF CONSTANT HAS STORAGE 67240015 BC BNZ,UA0159 NO 67280015 TM CONCD(WR1),X'C0' IS IT IN THE POOL 67320015 BC BM,UA0159 NO 67360015 TM CONCD(WR1),X'02' HAS IT A DOPE VECTOR 67400015 BC BZ,UA0159 NO 67440015 SPACE 1 67480015 * CONSTANT HAS DOPE VECTOR IN POOL 67520015 MVC TEM1+1(3),DATOFS(WR1) PICK UP STATIC OFFSET OF CONST 67560015 L WR2,TEM1 DOPE VECTOR IMMEDIATELY PRECEDES 67600015 S WR2,K7 IT. POINT WR2 AT ADDRESS OF CONST 67640015 ST WR2,RLDBUF+4 AND MAKE RLD ENTRY FOR 3-BYTE 67680015 MVI RLDBUF+4,X'08' ADDRESS 67720015 BAL RR,RLDMOV 67760015 SPACE 1 67800015 * NOW SCAN TO NEXT CONSTANT 67840015 UA0159 CLC STATCH(2,WR1),ZERO 67880015 BC BE,UA016 BRANCH IF END OF CONSTANTS CHAIN 67920015 MVC PAR1+2(2),STATCH(WR1) 67960015 BC B,UA0158 68000015 SPACE 2 68040015 * IF DEAR IS ZERO THE END OF THE STATIC CHAIN HAS BEEN 68080015 * REACHED SO GO TO INITIALIZE STATIC EXTERNAL VARIARES 68120015 UA016 NI FLAG,X'00' 68160015 L WR4,BAS3 68200015 C DEAR,ZERO 68240015 BC BE,UA100A 68280015 BC B,UA021 68320015 EJECT 68360015 * SYMBOL TABLE ROUTINE 68400015 * 68440015 * 68480015 * 68520015 * FUNCTION/OPERATION 68560015 * MAKES UP TEXT FOR THE SYMBOL TABLE ENTRIES OF VARIABLES 68600015 * WHICH REQUIRE THEM. EACH ENTRY IS CHAINED TO THE PREVIOUS 68640015 * ENTRY IN THAT BLOCK OR, IF IT IS THE FIRST FOR THE BLOCK, TO 68680015 * THE END OF THE CHAIN FOR THE CONTAINING BLOCK. IF THE 68720015 * VARIABLE NEEDS A SYMBOL TABLE ENTRY BECAUSE IT APPEARS IN A 68760015 * CHECK LIST THE ENTRY IS UNCHAINED. 68800015 * 68840015 * 68880015 * 68920015 * ENTRY POINT-UA080 FROM STATIC CHAIN SCAN IN UA 68960015 * 69000015 * 69040015 * 69080015 * EXTERNAL ROUTINES 69120015 * (1) TXTMOV 69160015 * (2) RLDMOV 69200015 * 69240015 * 69280015 * 69320015 * EXITS - NORMAL UA230 IN NEXT ROUTINE TO INITIALISE THE 69360015 * DED FOR THE VARIABLE 69400015 * 69440015 * 69480015 * 69520015 * EXITS-ERROR - NONE 69560015 * 69600015 * 69640015 * 69680015 * TABLES/WORKSPACE 69720015 * IF THE VARIABLE IS A STRUCTURE ELEMENT THE BCD IN THE 69760015 * SYMBOL TABLE ENTRY MUST BE FULLY QUALIFIED. IT IS BUILT UP 69800015 * WORKING BACKWARDS FROM THE END OF A 256-BYTE AREA TXTBUF. 69840015 * SCANNING BACKWARDS UP THE STRUCTURE THE BCD OF EACH CONTAINING 69880015 * STRUCTURE IS INSERTED IN THE BUFFER AND PRECEDED BY A 69920015 * CONCATENATING DOT (EXCEPT THE MAJOR STRUCTURE BCD). THE BCD 69960015 * AND ITS LENGTH IS THEN MOVED IN ONE BLOCK TO TXT CARDS 70000015 * 70040015 * 70080015 * 70120015 * NOTES - THE FORMAT OF A SYMBOL TABLE ENTRY IS AS FOLLOWS 70160015 * (1) 4-BYTE CHAIN ADDRESS OR ZERO 70200015 * (2) BCD OF VARIABLE PRECEDED BY ITS LENGTH IN ONE BYTE 70240015 * (3) STARTING ON NEXT 4-BYTE BOUNDARY THE NUMBER OF 70280015 * DIMENSIONS IN 1 BYTE IF VARIABLE IS DIMENSIONED 70320015 * (4) ADDRESS OF DED FOR THIS VARIABLE (3 BYTES) 70360015 * (5) CODE BYTE - BIT 2 = 1 IF VARIABLE IS IN CHECK LIST 70400015 * BIT 3 = 1 FOR LABEL VARIABLE 70440015 * BITS 7 AND 8 = 00 FOR STATIC VARIABLE 70480015 * = 01 FOR UNSTRUCTURED 70520015 * AUTOMATIC AND CONTROLLED VARS 70560015 * = 10 FOR STRUCTURED 70600015 * AUTOMATIC AND CONTROLLED VARS 70640015 * (6) 3-BYTE ADDRESS OF DATA OR ITS DOPE VECTOR (IF IT HAS 70680015 * ONE) IF STATIC, OR OFFSET WITHIN DSA IF AUTOMATIC, OR OFFSET 70720015 * FROM ADDRESS IN PSEUDO-REGISTER IF CONTROLLED. 70760015 * (7) FOR AUTOMATIC VARIABLE 2-BYTE OFFSET OF DISPLAY 70800015 * PSEUDO-REGISTER IN PRV. FOR CONTROLLED VARIABLE OFFSET OF ITS 70840015 * PSEUDO-REGISTER IN PRV. FOR STATIC NOT USED. 70880015 * 70920015 * REGISTER USAGE - GR 12 POINTS TO THE SYMBOL TABLE 70960015 * DICTIONARY ENTRY WHICH IS LOCKED IN CORE. GR 5 POINTS TO THE 71000015 * D.E. OF THE VARIABLE 71040015 SPACE 3 71080015 UA080 CLI 0(DEAR),SYMTAB 71120015 BC BE,*+8 71160015 BAL RR,UA THIS SHOULD NEVER HAPPEN BUT IT 71200015 * MEANS THERE IS A FOREIGN BODY ON 71240015 * THE STATIC CHAIN 71280015 CLI 2(DEAR),X'0B' TEST LENGTH OF D.E. TO FIND IF 71320015 BC BE,UA099 THIS IS DED . BRANCH IF SO 71360015 MVC TEM1+1(3),SYMOFS(DEAR) 71400015 SPACE 1 71440015 MVC PAR1+2(2),SYMDAT(DEAR) GET ADDRESS OF D.E. OF DATA ITEM 71480015 L LR,ZDRFAB ASSOCIATED WITH THIS SYMBOL TABLE 71520015 BALR RR,LR ENTRY 71560015 L WR1,PAR1 71600015 SPACE 1 71640015 * IF VARIABLE HAS SYM TAB ENTRY BECAUSE IT IS MENTIONED IN 71680015 * A CHECK LIST IT NEED NOT BE INCLUDED IN THE CHAIN OF SYM TAB 71720015 * ENTRIES 71760015 TM DATOT1(WR1),X'80' 71800015 BC BZ,UA0985 BRANCH IF NO SYMBOL 71840015 TM DATDAT(WR1),X'C0' 71880015 BC BO,UA0985 71920015 TM DATDAT(WR1),X'80' 71960015 BC BO,*+12 72000015 TM DATDAT(WR1),X'02' 72040015 BC BO,UA0985 72080015 SPACE 1 72120015 * CHAIN ADDRESS GOES IN UST WORD OF ENTRY SO PICK UP STATIC 72160015 * OFFSET OF PREVIOUS ENTRY 72200015 MVC PAR1+2(2),SYMCHN(DEAR) THE CHAIN SLOT EITHER POINTS TO 72240015 UA082B BALR RR,LR THE PREVIOUS VARIABLE WITH A SYM 72280015 L WR2,PAR1 TAB ENTRY OR, IF THIS IS THE 1ST 72320015 * ENTRY FOR THIS BLOCK, THE D.R. OF 72360015 * THE ET1 FOR THE BLOCK 72400015 TM 0(WR2),X'80' TEST IF VARIABLE 72440015 BC BNE,UA098 BRANCH IF NOT 72480015 SPACE 1 72520015 UA082 MVC PAR1+2(2),DATSYM(WR2) 72560015 BALR RR,LR 72600015 L WR2,PAR1 WR2= ADDR OF PREVIOUS SYMTAB 72640015 MVI TXTBUF,X'00' 72680015 MVC TXTBUF+1(3),SYMOFS(WR2) 72720015 SPACE 72760015 MVC PAR1+2(2),SYMDAT(WR2) 72800015 BALR RR,LR DECODE DATA ITEM REFERENCE 72840015 L PR1,PAR1 72880015 MVC PAR1+2(2),SYMCHN(WR2) NEXT ITEM REF ON SYMCHN 72920015 SPACE 72960015 TM DATOT1(PR1),X'80' 73000015 BC BZ,UA082B 73040015 TM DATDAT(PR1),X'C0' 73080015 BC BO,UA082B 73120015 TM DATDAT(PR1),X'80' 73160015 BC BO,*+12 73200015 TM DATDAT(PR1),X'02' 73240015 BC BO,UA082B 73280015 SPACE 73320015 LA PR1,TXTBUF 73360015 LA PR2,4 73400015 BAL RR,TXTMOV MOVE OFFSET OT TXT CARD 73440015 SPACE 1 73480015 * MAKE RLD ENTRY FOR CHAIN ADDRESS 73520015 MVC RLDBUF(2),K2+2 SET RELOC HEADER = 2 73560015 MVI RLDBUF+4,X'0C' 73600015 MVC RLDBUF+5(3),SYMOFS(DEAR) 73640015 BAL RR,RLDMOV 73680015 BC B,UA097 73720015 SPACE 1 73760015 * SYM TAB ENTRY IS FIRST FOR THIS BLOCK SO CHAIN TO LAST 73800015 * ENTRY FOR CONTAINING BLOCK 73840015 * 73880015 * CHAIN BACK TO ET1 FOR CONTAINING BLOCK 73920015 UA098 CLC ET1BAK(2,WR2),ZERO 73960015 BC BE,UA0985 OUTERMOST BLOCK SO CHAIN ADDRESS 74000015 * IS ZERO 74040015 UA0982 MVC PAR1+2(2),ET1BAK(WR2) 74080015 BALR RR,LR 74120015 L WR2,PAR1 74160015 CLC ET1SYM(2,WR2),ZERO TEST IF ANY SYM TAB ENTRIES FOR 74200015 BC BE,UA098 THIS BLOCK, IF NOT GET ADDRESS OF 74240015 * NEXT BLOCK OUT 74280015 MVC PAR1+2(2),ET1SYM(WR2) 74320015 BALR RR,LR 74360015 L WR2,PAR1 74400015 BC B,UA082 74440015 SPACE 1 74480015 * INSERT ZERO CHAIN ADDRESS, EITHER BECAUSE ENTRY IS NOT 74520015 * REQUIRED TO BE CHAINED OR IT IS FIRST ENTRY FOR EXTERNAL 74560015 * PROCEDURE 74600015 UA0985 XC TXTBUF(4),TXTBUF 74640015 LA PR1,TXTBUF 74680015 LA PR2,4 74720015 BAL RR,TXTMOV 74760015 SPACE 3 74800015 * MOVE BCD OF VARIABLE TO ENTRY. IF VARIABLE IS STRUCTURE 74840015 * MEMBER BCD IS FULLY QUALIFIED. 74880015 UA097 MVC PAR1+2(2),SYMDAT(DEAR) 74920015 L LR,ZDRFAB 74960015 BALR RR,LR 75000015 L WR1,PAR1 75040015 MVC TXTBUF(1),BLANK 75080015 MVC TXTBUF+1(255),TXTBUF 75120015 TM 0(WR1),X'20' 75160015 BC BNZ,UA0972 BRANCH IF STRUCTURE MEMBER 75200015 XR WR2,WR2 75240015 IC WR2,2(WR1) WR2 = LENGTH OF DE 75280015 AR WR2,WR1 75320015 MVC MVC6+1(1),0(WR2) 75360015 MVC6 MVC TXTBUF+1(0),1(WR2) MOVE BCD TO TXT BUF AND 75400015 MVC TR5+1(1),0(WR2) 75440015 IC PR2,0(WR2) 75480015 LA PR2,1(PR2) PR2 = LENGTH OF BCD 75520015 STC PR2,TXTBUF 75560015 * MOVE BCD PRECEDED BY ITS LENGTH TO TXT CARD 75600015 LA PR1,TXTBUF 75640015 LA PR2,1(PR2) 75680015 BC B,UA0975 75720015 SPACE 1 75760015 * VARIABLE IS STRUCTURE MEMBER SO MAKE UP FULLY QUALIFIED 75800015 * NAME. 75840015 UA0972 LA PR1,TXTBUF+256 PR1 = ADDR OF END OF TXTBUF 75880015 LR WR2,WR1 75920015 SPACE 1 75960015 * SCAN BACK THROUGH CONTAINING MINOR STRUCTURES TO THE MAJOR 76000015 * STRUCTURE INSERTING THE NAMES OF EACH SEPARATED BY A FULL 76040015 * STOP 76080015 UA0973 XR WR3,WR3 76120015 XR 15,15 76160015 IC WR3,2(WR2) 76200015 AR WR3,WR2 WR3 = ADDR OF BCD 76240015 IC 15,0(WR3) R15 = LENGTH OF BCD - 1 76280015 STC 15,MVC4+1 STORE IT IN MOVE INSTRUCTION 76320015 LA 15,1(15) POINT PR1 AT ADDRESS IN TXTBUF 76360015 SR PR1,15 76400015 * WHICH BCD WILL BE MOVED TO 76440015 C PR1,TXTAD TEST IF BCD WILL OVERRUN THE 76480015 BC BL,UA0925 START OF TXTBUF. IF SO GO TO 76520015 * INITIALISE DED 76560015 MVC4 MVC 0(0,PR1),1(WR3) MOVE BCD TO TXTBUF 76600015 TM 0(WR2),X'01' IS THIS DATA ITEM 76640015 BC BNZ,UA9006 YES 76680015 TM 0(WR2),X'10' IS IT DIMENSIONED 76720015 BC BNZ,UA9002 YES 76760015 MVC PAR1+2(2),STCHN3-2(WR2) 76800015 BC B,UA9009 76840015 UA9002 MVC PAR1+2(2),STCHN4-2(WR2) 76880015 BC B,UA9009 76920015 UA9006 TM 0(WR2),X'10' IS MINOR STRUCTURE DIMENSIONED 76960015 BC BNZ,UA9007 YES 77000015 MVC PAR1+2(2),STCHN1-2(WR2) 77040015 BC B,UA9009 77080015 UA9007 MVC PAR1+2(2),STCHN2-2(WR2) 77120015 UA9009 TM DATOT4(WR2),MAJST IS THIS MAJOR STRUCTURE 77160015 BC BNZ,UA0976 IF SO GO TO WRITE OUT NAME 77200015 SPACE 1 77240015 BCTR PR1,0 77280015 MVC 0(1,PR1),POINT MOVE CONCATENATING DOT TO TXTBUF 77320015 L LR,ZDRFAB 77360015 BALR RR,LR GET ADDRESS OF D.E. FOR 77400015 L WR2,PAR1 CONTAINING STRUCTURE 77440015 BC B,UA0973 77480015 SPACE 1 77520015 * WRITE OUT QUALIFIED NAME PRECEDED BY ITS LENGTH IN 1 BYTE 77560015 UA0976 LA PR2,TXTBUF+256 77600015 SR PR2,PR1 PR2 = LENGTH OF NAME +1 77640015 BCTR PR1,0 77680015 STC PR2,0(PR1) STORE LENGTH IN TXTBUF 77720015 BCTR PR2,0 77760015 STC PR2,TR5+1 STORE LENGTH OF NAME -1 IN 77800015 * TRANSLATE INSTRUCTION 77840015 LA PR2,2(PR2) 77880015 UA0975 L WR2,ZTRAN2 TRANSLATE NAME TO EXTERNAL 77920015 TR5 TR 1(0,PR1),0(WR2) FORN 77960015 ST LOCCTR,TEM1 78000015 LA PR2,3(PR2) 78040015 N PR2,WDMSK 78080015 BAL RR,TXTMOV MOVE NAME TO CARD 78120015 SPACE 2 78160015 * IF VARIABLE IS DIMENSIONED AND HAS A DOPE VECTOR THE NEXT 78200015 * BYTE CONTAINS THE NUMBER OF DIMENSIONS 78240015 UA086 MVC PAR1+2(2),SYMDAT(DEAR) 78280015 L LR,ZDRFAB 78320015 BALR RR,LR 78360015 L WR1,PAR1 78400015 TM 0(WR1),X'10' 78440015 BC BZ,UA087 BRANCH IF UNDIMENSIONED 78480015 SPACE 1 78520015 TM DATVAR(WR1),X'80' TEST IF ARRAY HAS OFFSET2 SLOT 78560015 BC BNZ,UA0862 BRANCH IF SO 78600015 MVC TXTBUF(1),DIM1-4(WR1) 78640015 BC B,UA0875 78680015 UA0862 MVC TXTBUF(1),DIM1(WR1) 78720015 BC B,UA0875 78760015 UA087 XC TXTBUF(1),TXTBUF ZERO DIMENSION SLOT 78800015 SPACE 1 78840015 * NEXT 3 BYTES CONTAIN ADDRESS OF DED 78880015 UA0875 MVC TXTBUF+1(3),DEDOFS(DEAR) MOVE STATIC OFFSET OF DED TO 78920015 * TXT BUF 78960015 LA WR2,1(LOCCTR) INSERT ASSEMBLED ADDRESS IN 79000015 ST WR2,RLDBUF+4 RLD ENTRY 79040015 MVI RLDBUF+4,X'08' SET LENGTH OF CONST = 3 79080015 MVC RLDBUF(2),K2+2 SET RELOC HEADER =2 79120015 BAL RR,RLDMOV 79160015 SPACE 1 79200015 * NEXT BYTE IS CODE BYTE WITH LAST 2 BITS GIVING CLASS OF 79240015 * DATA , FOLLOWED BY 3-BYTE ADDRESS OF DATA OR ITS DOPE VECTOR 79280015 * IF IT HAS ONE. 79320015 NI TXTBUF+4,X'00' 79360015 TM DATOT1(WR1),CHECK IF VARIABLE APPEARS IN CHECK 79400015 BC BZ,UA091 LIST 2ND BIT OF CODE BYTE IS SET 79440015 OI TXTBUF+4,X'40' TO 1. 79480015 BC B,UA091 79520015 SPACE 1 79560015 SPACE 1 79600015 * NOW IDENTIFY CLASS OF VARIABLE 79640015 UA091 TM DATOT2(WR1),X'03' 79680015 MVC TXTBUF+8(4),ZERO 79720015 BC BO,UA096 CONTROLLED 79760015 BC BZ,UA095 79800015 SPACE 1 79840015 * FALL THROUGH IF STATIC 79880015 XC TXTBUF+8(4),TXTBUF+8 ZERO LAST WORD OF ENTRY 79920015 LA WR2,5(LOCCTR) SET UP RLD ENTRY FOR ADDRESS OF 79960015 ST WR2,RLDBUF+4 DATA OR ITS DOPE VECTOR 80000015 MVI RLDBUF+4,X'08' LENGTH OF ADDRESS = 3 BYTES 80040015 SPACE 1 80080015 TM DATOT2(WR1),EXTFL TEST IF EXTERNAL 80120015 BC BNZ,UA0916 YES 80160015 SPACE 1 80200015 * THE ADDRESS REQUIRED FOR INTERNAL VARIABLES IS THAT OF 80240015 * THE DATA FOR NON-STRING SCALARS OR OF THE DOPE VECTOR 80280015 * OTHERWISE 80320015 MVC RLDBUF(2),K2+2 SET RELOCATION HEADER = ESDID OF 80360015 * STATIC CSECT 80400015 SPACE 1 80440015 * HERE FOR UNSTRUCTURED AUTOMATIC VARIABLES AND STRUCTURED 80480015 * STATIC EXTERNAL VARIABLES 80520015 UA0911 TM 0(WR1),X'10' IS IT ARRAY 80560015 BC BNZ,UA0914 YES 80600015 TM DATDAT(WR1),FL1 IS IT STRING 80640015 BC BZ,UA0915 YES 80680015 SPACE 1 80720015 * ADDRESS OF DATA IS IN OFFSET 1 SLOT 80760015 UA0912 MVC TXTBUF+5(3),DATOFS(WR1) 80800015 BC B,UA092 80840015 SPACE 1 80880015 * HERE FOR STRUCTURED CONTROLLED OR AUTOMATIC VARIABLES 80920015 UA0913 OI TXTBUF+4,X'02' SET CODE BYTE 80960015 SPACE 1 81000015 * ADDRESS OF DOPE VECTOR IS IN OFFSET 2 SLOT 81040015 UA0914 EQU * 81080015 UA0915 MVC TXTBUF+5(3),DATOF2+1(WR1) 81120015 BC B,UA092 81160015 SPACE 2 81200015 * HERE FOR STATIC EXTERNAL VARIABLES 81240015 UA0916 XR WR2,WR2 81280015 IC WR2,2(WR1) 81320015 AR WR2,WR1 81360015 BCTR WR2,0 POINT WR2 AT ESDID OF STATIC 81400015 BCTR WR2,0 EXTERNAL CSECT 81440015 MVC RLDBUF(2),0(WR2) SET RELOCATION HEADER = ESDID 81480015 TM 0(WR1),X'20' IS VARIABLE STRUCTURED 81520015 BC BNZ,UA0911 YES 81560015 UA0917 MVC TXTBUF+5(3),ZERO IF NOT ADDRESS OF DATA OR DOPE 81600015 * VECTOR IS ZERO 81640015 SPACE 2 81680015 * MOVE RLD ENTRY AND LAST 3 WORDS OF TEXT TO CARD 81720015 UA092 BAL RR,RLDMOV 81760015 LA PR1,TXTBUF 81800015 LA PR2,12 81840015 ST LOCCTR,TEM1 81880015 BAL RR,TXTMOV 81920015 UA0925 LA RR,UA033 81960015 ST RR,LNKST1 82000015 BC B,UA231 GO TO INITIALISE DED 82040015 SPACE 1 82080015 SPACE 2 82120015 * HERE FOR AUTOMATIC VARIABLES 82160015 SPACE 1 82200015 * FIRST HALF OF LAST WORD OF ENTRY WILL BE LOADED WITH PRV 82240015 * OFFSET OF DISPLAY PR FOR BLOCK 82280015 UA095 XR WR2,WR2 82320015 IC WR2,2(WR1) WR2 = LENGTH OF D.E. 82360015 AR WR2,WR1 82400015 BCTR WR2,0 WR2 = ADDR OF COUNT FIELD 82440015 MVC TEM1+3(1),0(WR2) 82480015 * VARIABLE 82520015 * SCAN DOWN ET1 CHAIN TO BLOCK WITH THIS NUMBER 82560015 MVC PAR1+2(2),DICET1 82600015 BC B,UA0957 82640015 UA0956 MVC PAR1+2(2),ET1CHN(15) 82680015 UA0957 L LR,ZDRFAB 82720015 BALR RR,LR 82760015 L 15,PAR1 82800015 CLC ET1CNT(1,15),TEM1+3 82840015 BC BNE,UA0956 82880015 SPACE 1 82920015 * MAKE RLD ENTRY FOR PR OFFSET 82960015 MVC RLDBUF(2),ET1ESD(15) SET RELOC HEADER = ESDID OF PR 83000015 MVC PAR1+2(2),SYMDAT(DEAR) 83040015 L LR,ZDRFAB 83080015 BALR RR,LR RELOAD WR1 WITH ADDRESS OF 83120015 L WR1,PAR1 DICTIONARY ENTRY OF VARIABLE 83160015 UA0951 LA WR2,8(LOCCTR) 83200015 ST WR2,RLDBUF+4 83240015 MVI RLDBUF+4,X'24' SET CODE BYTE FOR 2-BYTE P.R. 83280015 SPACE 1 83320015 TM 0(WR1),X'20' IS VARIABLE STRUCTURED 83360015 BC BNZ,UA0913 YES 83400015 OI TXTBUF+4,X'01' SET CODE FOR UNSTRUCTURED 83440015 * AUTOMATIC OR CONTROLLED VARIABLE 83480015 TM DATOT2(WR1),X'03' IS VARIABLE CONTROLLED 83520015 BC BNO,UA0911 NO, AUTOMATIC 83560015 TM 0(WR1),X'10' YES, CONTROLLED 83600015 BC BO,UA0917 BRANCH IF ARRAY 83640015 TM DATDAT(WR1),X'9A' 83680015 BC BNO,UA0917 BRANCH IF NOT DOUBLE FLOAT 83720015 MVC TXTBUF+5(3),K4+1 83760015 BC B,UA092 83800015 SPACE 2 83840015 * HERE FOR CONTROLLED VARIABLES 83880015 * 83920015 * LAST WORD OF SYMTAB ENTRY CONTAINS PRV OFFSET OF PSEUDO- 83960015 * REGISTER FOR VARIABLE 84000015 UA096 XR WR2,WR2 84040015 IC WR2,2(WR1) 84080015 AR WR2,WR1 84120015 BCTR WR2,0 84160015 BCTR WR2,0 WR2 = ADDR OF ESDID OF PR 84200015 MVC RLDBUF(2),0(WR2) SET RELOC HEADER = ESDID OF PR 84240015 BC B,UA0951 84280015 SPACE 2 84320015 SPACE 4 84360015 EJECT 84400015 * DED ROUTINE 84440015 * 84480015 * 84520015 * 84560015 * FUNCTION/OPERATION 84600015 * THIS ROUTINE PRODUCES TEXT FOR DEDS. THESE ARE EITHER 84640015 * FOR DECLARED VARIABLES (D.E CODE BYTE =X'C7') AND APPEAR WITH 84680015 * THE SYMBOL TABLE ENTRIES AT THE END OF STATIC, OR FOR 84720015 * TEMPORARIES (CODE BYTE = X'C1') AND APPEAR AMONG THE CHARACTER 84760015 * VARIABLES NEAR THE BEGINNING OF STATIC. 84800015 * DEDS ARE EITHER 3 BYTES LONG FOR NON-STRING VARIABLES 84840015 * OR 1 BYTE LONG FOR STRINGS. IF THE DED IS PICTURED IT IS 84880015 * FOLLOWED BY THE PICTURE. THE 2ND AND 3RD BYTES OF THE DED IN 84920015 * THE DICTIONARY ENTRY ARE REPLACED BY THE REFERENCE OF THE 84960015 * PICTURE DICTIONARY ENTRY. 85000015 * 85040015 * 85080015 * 85120015 * ENTRY POINT - UA230 FROM SYMBOL TABLE ROUTINE OR FROM 85160015 * SIMPLE VARIABLE SCAN IN UA 85200015 * 85240015 * 85280015 * 85320015 * EXTERNAL ROUTINES 85360015 * (1) TXTMOV 85400015 * 85440015 * 85480015 * 85520015 * EXITS - NORMAL - TO APPROPRIATE SCAN ROUTINE IN UA 85560015 * 85600015 * 85640015 * 85680015 * EXITS - ERROR - NONE 85720015 SPACE 3 85760015 UA099 LA RR,UA033 85800015 ST RR,LNKST1 85840015 SPACE 1 85880015 * THIS ROUTINE INSERTS DEDS IN THE TEXT. DEDS FOR 85920015 * TEMPORARIES CANNOT HAVE PICTURES. 85960015 SPACE 2 86000015 UA230 CLC 1(2,DEAR),K12 IF LENGTH IS LESS THAN 12 THIS 86040015 BC BL,UA231 IS A DED, OTHERWISE IT IS A FED. 86080015 LR WR1,DEAR IF ITS LENGTH IS GREATER THAN 12 86120015 BC BH,UA2350 THE FED HAS A PICTURE 86160015 LA PR2,4 LENGTH OF FED = 4 86200015 BC B,UA233 86240015 SPACE 1 86280015 UA231 TM DEDDED(DEAR),FL5 TEST IF DED HAS PICTUER 86320015 BC BZ,UA235 BRANCH IF SO 86360015 SPACE 1 86400015 * DED HAS NO PICTURE SO IS OF LENGTH 1 IF FOR STRING AND 3 86440015 * IF FOR CAD 86480015 TM DEDDED(DEAR),FL1 TEST IF STRING 86520015 BC BNZ,UA232 BRANCH IF NOT 86560015 NI DEDDED(DEAR),X'BF' TURN OFF ADJUSTABLE LENGTH' BIT 86600015 LA PR2,1 86640015 BC B,UA233 86680015 UA232 LA PR2,3 86720015 NI DEDDED(DEAR),X'DF' TURN OFF STERLING BIT 86760015 UA233 LA PR1,DEDDED(DEAR) PR1 = ADDRESS OF DED TO BE MOVED 86920015 MVC TEM1+1(3),DATOFS(DEAR) TEM1 =STATIC OFFSET OF DED 86960015 BAL RR,TXTMOV MOVE DED TO CARD 87000015 * SINCE THIS ROUTINE MAY HAVE BEEN INITIALISING EITHER AN 87040015 * ORDINARY DED OR A DED FOR A TEMPORARY WE MUST USE RR AS A 87080015 * RETURN REGISTER 87120015 L RR,LNKST1 87160015 BCR B,RR RETURN TO SCAN 87200015 SPACE 2 87240015 * DED HAS PICTURE SO GET PICTURE FROM D.E. AND MOVE IT TO 87280015 * TXT CARD 87320015 SPACE 1 87360015 UA235 MVC PAR1+2(2),DEDDED+1(DEAR) 87400015 * PAR1 SHOULD NOW CONTAIN THE D.R. FOR THE PICTURE. IF THE23251 87410001 * PICTURE IS USED IN A CONVERSION, HOWEVER IT WILL CONTAIN23251 87420001 * THE D.R. OF A DED2 23251 87430001 L LR,ZDRFAB 87440015 BALR RR,LR 87480015 UALOOP L WR1,PAR1 38257 87500042 TM 0(WR1),X'C8' IS IT D.R. OF A PICTURE 23251 87525001 BO PICOK YES 23251 87530001 MVC PAR1+2(2),DEDDED+1(WR1) IT IS DEC2 SO PICK UP 23251 87535001 BALR RR,LR PICTURE 23251 87540001 B UALOOP * BACK CHAIN TO DED 38257 87545042 PICOK EQU * JUMP HERE WHEN NO DED2 23251 87550001 MVC 8(1,WR1),DEDDED(DEAR) 87560015 TM 4(WR1),X'01' PICTURE ALREADY INITIALISED 87600015 BC BNZ,UA237 YES 87640015 OI 4(WR1),X'01' SET FLAG TO SAY PICTURE DEALT 87680015 UA2350 LA WR2,13(WR1) WITH 87720015 L PR1,ZTRAN2 87760015 TM PICPIC(WR1),FL1 87800015 BC BNZ,UA2352 BRANCH IF NUMERIC PPICTURE 87840015 SPACE 1 87880015 * IF PICTURE IS FOR STRING , LENGTH IS IN 2 BYTES BEFORE 87920015 * PICTURE 87960015 MVC TEM1+2(2),11(WR1) 88000015 LH PR2,TEM1+2 PR2= LENGTH OF PICTURE 88040015 LR WR3,PR2 88080015 UA2351 C WR3,K256 88120015 BC BL,UA2353 BRANCH IF LESS THAN 256 BYTES 88160015 TR 0(256,WR2),0(PR1) 88200015 LA WR2,256(WR2) 88240015 S WR3,K256 88280015 BC B,UA2351 88320015 SPACE 1 88360015 * THE LENGTH OF NUMERIC PICTURES IS IN 1 BYTE BEFORE THE 88400015 * PICTURE 88440015 UA2352 XR PR2,PR2 88480015 IC PR2,12(WR1) 88520015 LR WR3,PR2 88560015 UA2353 C WR3,ZERO 88600015 BC BE,UA2354 88640015 BCTR WR3,0 88680015 STC WR3,TR23+1 88720015 TR23 TR 0(0,WR2),0(PR1) TRANSLATE PICTURE TO EXT FORM 88760015 UA2354 LA PR2,5(PR2) 88800015 TM PICPIC(WR1),FL1 88840015 BC BNZ,UA2355 BRANCH IF NOT STRING 88880015 NI PICPIC(WR1),X'BF' TURN OFF 'ADJUSTABLE LENGTH'BIT 88920015 LA PR1,10(WR1) FOR STRING 10TH AND 11TH BYTES 88960015 MVC 10(1,WR1),8(WR1) OF PICTURE ENTRY ARE NOT REQUIRED 89000015 S PR2,K2 SO SHIFT DATA BYTE UP AND REDUCE 89040015 BC B,UA236 LENGTH IN PR2 BY 2 89080015 SPACE 1 89120015 UA2355 LA PR1,PICPIC(WR1) 89160015 TM 0(PR1),X'02' 89200015 BC BNZ,UA236 IF VARIABLE IS FIXED TURN 89240015 NI 0(PR1),X'EF' OFF 'LONG' BIT 89280015 UA236 MVC TEM1+1(3),DATOFS(WR1) TEM1=STATIC OFFSET OF PICTURE 89320015 BAL RR,TXTMOV MOVE PICTURE TO TXT CARD 89360015 UA237 L RR,LNKST1 LOAD RETURN REGISTER 89400015 BCR B,RR RETURN TO SCAN 89440015 EJECT 89480015 * THIS ROUTINE PUTS OUT INITIAL VALUES FOR RECORD 89520015 * DEFINITION VECTORS AND DOPE VECTOR DESCRIPTORS 89560015 SPACE 5 89600015 ADDRDV CLI 0(DEAR),RDVRDV 89640015 BC BNE,ADDDVD BRANCH FOR DVDS 89680015 SPACE 89720015 MVC RLDBUF(2),K2+2 89760015 MVC TEM1+1(3),RDVOFS(DEAR) 89800015 MVC RLDBUF+5(3),RDVOFS(DEAR) 89840015 MVI RLDBUF+4,X'0C' 89880015 SPACE 89920015 MVC PAR1+2(2),RDVVAR(DEAR) 89960015 L LR,ZDRFAB 90000015 BALR RR,LR 90040015 SPACE 90080015 L PR1,PAR1 90120015 TM DATOT2(PR1),EXTFL 90160015 BC BZ,A66 90200015 LR WR7,PR1 90240015 MVC HWORD(2),1(PR1) 90280015 AH WR7,HWORD 90320015 S WR7,K2 90360015 MVC RLDBUF(2),0(WR7) 90400015 SPACE 90440015 A66 TM 0(PR1),X'10' 90480015 BC BZ,A66A BRANCH IF NON DIMENSIONED 90520015 SPACE 90560015 LR RR,PR1 90600015 TM 0(PR1),X'0F' 90640015 BC BO,A11 BRANCH IF DATA 90680015 SPACE 90720015 TM 0(PR1),X'0E' 90760015 BC BNO,A11A BRACH IF NOT STRUCTURE 90800015 SPACE 90840015 A66A TM DATOT2(PR1),EXTFL 90880015 BC BZ,A22 BRANCH IF INTERNAL 90920015 SPACE 90960015 TM 0(PR1),X'0F' 91000015 BC BO,A33 BRANCH IF DATA 91040015 SPACE 91080015 TM 0(PR1),X'0E' 91120015 BC BNO,A33 BRANCH IF NOT STRUCTURE 91160015 SPACE 91200015 LR RR,PR1 91240015 TM 0(PR1),X'10' 91280015 BC BZ,*+8 BRANCH IF NOT DIMENSIONED 91320015 LA RR,3(RR) 91360015 SPACE 91400015 MVC RDVDAT+2(2,DEAR),STCHN3-2(RR) 91440015 MVC RDVDAT+1(1,DEAR),STCHN3-4(RR) 91480015 BC B,ADDRDX 91520015 SPACE 91560015 A33 TM DATOT3(PR1),DVFL 91600015 BC BO,A55 91640015 MVC RDVDAT(4,DEAR),ZERO 91680015 BC B,ADDRDX 91720015 SPACE 91760015 A55 MVC RDVDAT(4,DEAR),K8 91800015 BC B,ADDRDX 91840015 SPACE 91880015 A22 MVC RDVDAT+1(3,DEAR),DATOFS(PR1) 91920015 BC B,ADDRDX 91960015 SPACE 92000015 A11 LA RR,6(RR) 92040015 A11A TM DATVAR(PR1),OF2FL 92080015 BC BZ,*+8 BRANCH IF NO OFFSET 2 SLOT 92120015 LA RR,4(RR) 92160015 MVC PAR1+2(2),16(RR) 92200015 L LR,ZDRFAB DECODE DIMTAB REFERENCE 92240015 BALR RR,LR 92280015 L 15,PAR1 92320015 SPACE 92360015 XR WR1,WR1 92400015 IC WR1,5(15) DIMENSION COUNT 92440015 SPACE 92480015 TM DATOT2(PR1),EXTFL 92520015 BC BZ,B66 92560015 L WR6,8(15) 92600015 BC B,B77 92640015 SPACE 92680015 B66 EQU * 92720015 MVC VOST(1),DATOF2(PR1) 92760015 MVC VOST+1(3),DATOFS(PR1) 92800015 L WR6,VOST 92840015 B77 EQU * 92880015 LR WR7,WR6 92920015 N WR6,ADMSK 92960015 TM DATOT3(PR1),VONEG 93000015 BC BZ,B33 93040015 LCR WR6,WR6 93080015 N WR6,ADMSK 93120015 B33 TM 0(PR1),X'0F' 93160015 BC BNO,B44 BRANCH IF NOT DATA 93200015 TM DATDAT(PR1),CHARST 93240015 BC BNZ,B44 93280015 SLDL WR6,3 93320015 SPACE 93360015 B44 LR WR7,WR1 93400015 SLA WR7,3 93440015 SPACE 93480015 B55 L WR3,12(15,WR7) 93520015 MH WR3,14(15) 93560015 AR WR6,WR3 93600015 LA 15,8(15) 93640015 S WR7,K4 93680015 BCT WR1,B55 93720015 TM 0(PR1),X'0F' 93760015 BC BNO,C11 BRANCH IF NOT DATA 93800015 TM DATDAT(PR1),CHARST 93840015 BC BNZ,C11 93880015 SRA WR6,3 93920015 C11 ST WR6,HWORD 93960015 MVC RDVDAT(4,DEAR),HWORD 94000015 SPACE 94040015 ADDRDX MVI RDVDAT(DEAR),X'00' 94080015 LA PR1,RDVDAT(DEAR) 94120015 L PR2,K8 94160015 BAL RR,TXTMOV 94200015 BAL RR,RLDMOV 94240015 BC B,UA033 94280015 SPACE 94320015 ADDDVD MVC TEM1+1(3),DVDOFS(DEAR) 94360015 LA PR1,DVDDAT(DEAR) 94400015 MVC HWORD(2),1(DEAR) 94440015 LH PR2,HWORD 94480015 SH PR2,K12 94520015 BAL RR,TXTMOV 94560015 BC B,UA033 94600015 UALAB DC X'0' 94620001 EJECT 94640015 END IEMUA 94680015 ./ ADD SSI=21010256,NAME=IEMUB,SOURCE=0 UB TITLE 'IEMUB,STATIC INITIALISATION,FINAL ASSEMBLY,PL/I (F)' 00060015 * 00120015 * 00180015 * 5.5 C 530660 KT 62645 00182072 * 5.5 C 416400 PEP 60073 00185072 * 5.4 C 530400 PEP 52181 00190021 * A 126600,370800 PEP 52181 00200021 * 5.4 A 285600,327000,541200,573600,983400 KT 54710 00210021 * 5.1 A 417600 23305 00220021 * 5.0 A 692400,705100 H175 00230021 * 00240015 * VERSION - 2 00300015 * 00360015 * STATUS - CHANGE LEVEL 0 00420015 * 00480015 * 00540015 * 00600015 * FUNCTION / OPERATION 00660015 * THE MODULE CONTAINS ROUTINES WHICH ARE USED BY THE 00720015 * SCAN ROUTINES IN UA AND UD. IT ALSO CONTAINS ALL OF THE 00780015 * DATA AND WORKSPACES REQUIRED BY THE LOGICAL PHASE. 00840015 * 00900015 * ENTRY POINTS 00960015 * 01020015 * (1) TXTMOV WHICH MOVES TEXT TO A CARD BUFFER AND WRITES 01080015 * IT OUT WHEN FULL. IT OPTIONALLY LISTS THE TEXT AS IT IS 01140015 * MOVED. 01200015 * 01260015 * (2) STRCTB WHICH IS THE FIRST ENTRY POINT FOR 01320015 * INITIALISATION OF A STATIC STRUCTURE. 01380015 * 01440015 * (3) STRCTA WHICH IS THE MAIN ENTRY POINT TO THE 01500015 * STRUCTURE INITIALISATION ROUTINE. 01560015 * 01620015 * (4) STREND WHICH IS CALLED WHEN STRUCTURE INITIALISATION 01680015 * IS COMPLETE. IT TRANSFERS THE LOADER TEXT FROM TEXT BLOCKS 01740015 * TO CARDS. 01800015 * 01860015 * (5) RLDMOV WHICH MOVES RLD ENTRIES TO A CARD BUFFER 01920015 * AND WRITES IT OUT WHEN FULL. 01980015 * 02040015 * (6) OUTPUT IS CALLED TO PUT PUT CARD IMAGES. IT PUTS 02100015 * OUT TXT FOLLOWED BY RLD CARDS. 02160015 * 02220015 * (7) UA912 IS AN ENTRY POINT TO OUTPUT WHICH IS USED 02280015 * TO PUT OUT RLD CARDS. 02340015 * 02400015 * (8) LIST IS CALLED FROM TXTMOV TO LIST THE TEXT ALONG 02460015 * WITH SUITABLE COMMENTS. 02520015 * 02580015 * (9) LIST1 PRINTS THE HEADING. 02640015 * 02700015 * (10) LIST2 PRINTS THE NAMES OF UNINITIALISED SCALAR 02760015 * VARIABLES. 02820015 * 02880015 * (11) LISR3 PRINTS ARRAY NAMES AND BIT STRING NAMES. 02940015 * 03000015 * 03060015 * 03120015 * INPUT - THE DICTIONARY 03180015 * 03240015 * 03300015 * 03360015 * OUTPUT - LOADER TEXT (TXT AND RLD CARDS) TO INITIALISE 03420015 * THE STATIC INTERNAL CSECT AND ALL EXTERNAL CSECTS. THE OUTPUT 03480015 * IS WRITTEN ON THE PUNCH AND/OR LOAD FILE ACCORDING TO THE 03540015 * OPTIONS ON THE EXECUTE CARD. 03600015 * 03660015 * 03720015 * 03780015 * EXTERNAL ROUTINES 03840015 * 03900015 * (1) ZULF WRITES A CARD IMAGE ON THE LOAD FILE 03960015 * 04020015 * (2) ZUSP WRITES A CARD IMAGE ON THE PUNCH FILE 04080015 * 04140015 * (3) ZDRFAB CONVERTS A DICTIONARY REFERENCE TO AN ADDRESS 04200015 * 04260015 * (4) RLSCTL RELEASES CONTROL FROM THE PHASE 04320015 * 04380015 * (5) ZUTXTC TO OBTAIN TEXT BLOCKS FOR STRUCTURE 04440015 * INITIALISATION. 04500015 * 04560015 * (6) ZTXTAB TO FIND A GIVEN BLOCK. 04620015 * 04680015 * (7) ZCHAIN TO CHAIN FROM ONE BLOCK TO ANOTHER. 04740015 * 04800015 * (8) ZALTER TO CHANGE THE STATUS OF A TEXT BLOCK. 04860015 * 04920015 * (9) ZUPL TO PRINT A LINE. 04980015 * 05040015 * (10) ZUERR TO PUT OUT ERROR MESSAGES. 05100015 * 05160015 * 05220015 * 05280015 * 05340015 * EXITS - NORMAL 05400015 * 05460015 * THESE ARE MADE VIA THE LINK REGISTER 05520015 * 05580015 * 05640015 * 05700015 * EXITS - ERROR - NONE 05760015 * 05820015 * 05880015 * 05940015 * TABLES/WORK AREAS 06000015 * THIS MODULE USES 1 TXT CARD BUFFER WHICH IS OUTPUT EVERY 06060015 * TIME IT IS FILLED. THERE ARE 3 RLD CARD BUFFERS IN A CIRCULAR 06120015 * CHAIN. WHEN EACH ONE IS FILLED A FLAG IS SET TO SAY IT IS 06180015 * FILLED BUT THE CARD IS NOT OUTPUT UNTIL THE NEXT TXT CARD HAS 06240015 * BEEN FILLED. THIS ENSURES THAT RLD ENTRIES NEVER APPEAR IN A 06300015 * DECK BEFORE THE TEXT THEY REFER TO. THE NAMES OF THE BUFFERS 06360015 * ARE TXTCD, RLDCD1,2,AND 3. 06420015 * PRINT IS A 120 CHARACTER BUFFER USED FOR BUILDING UP A 06480015 * LINE OF PRINT 06540015 * TABLE2 IS A TRANSLATE TABLE USED TO IDENTIFY DICTIONARY 06600015 * ENTRIES FOR LISTING PURPOSES 06660015 * 06720015 * 06780015 * ATTRIBUTES - N/A 06840015 * 06900015 * 06960015 * 07020015 * NOTES - THIS MODULE IS INDEPENDENT OF THE EXTERNAL 07080015 * CHARACTER SET USED. 07140015 * REGISTER USAGE IS AS FOR UA EXCEPT THAT REGISTERS 1, 3, 07200015 * AND 4 ARE SAVED AT ENTRY TO TXTMOV AND RLDMOV AND RESTORED 07260015 * ON EXIT. DURING THESE ROUTINES THEY ARE USED TO ADDRESS THE 07320015 * NEXT AVAILABLE POSITION ON A TXT OP.RLD CARD. 07380015 SPACE 10 07440015 *********************************************************************** 07500015 SPACE 5 07560015 * THE LAYOUT AND USAGE OF SCRATCH CORE DURING THE 07620015 * STATIC INITIALISATION PHASES IS AS FOLLOWS 07680015 * 07740015 * BYTES 0 - 63 07800015 * 07860015 * THESE ARE SET UP BY PHASE TF AND CONTAIN THE 07920015 * NAMES OF THE TEXT BLOCKS HOLDING INFORMATION ON EQU 07980015 * LABEL VALUES. EACH NAME IS HELD IN ONE BYTE 08040015 * 08100015 * BYTES 64 - 447 08160015 * 08220015 * THESE CONTAIN THE DOPE VECTOR OF A VARYING STRING 08280015 * ARRAY DURING DOPE VECTOR INITIALISATION, OF A STRUCTURED 08340015 * ARRAY OR OF A TASK, EVENT OR AREA ARRAY DURING ELEMENT 08400015 * INITIALISATION. 08460015 * 08520015 * BYTES 448 - 527 08580015 * 08640015 * THES ARE USED IN THE INITIALISATION OF PACKED 08700015 * STRUCTURES AND CONSIST OF 20 FOUR BYTE ENTRIES. EACH 08760015 * ENTRY CONSISTS OF A FLAG BYTE AND 3-BYTE TEXT REFERENCE 08820015 * 08880015 * BYTES 528 - 783 08940015 * 09000015 * THESE CONTAIN THE TRANSLATE TABLE 'TABLE2' 09060015 * USED FOR PROVIDING COMMENTS IN THE STATIC LISTINGS 09120015 * 'TABLE2' IS PLACED IN SCRATCH CORE BY 09180015 * PHASE TT 09240015 * 09300015 * BYTES 784 - 4095 09360015 * 09420015 * THESE ARE USED FOR THE TWO COLUMN LISTING FEATURE 09480015 * AND PERMIT IT FOR A PAGE SIZE OF NOT MORE THAN 57 09540015 SPACE 5 09600015 *********************************************************************** 09660015 SPACE 10 09720015 EJECT 09780015 IEMUB START 0 09840015 EJECT 09900015 * SYMBOLIC REGISTERS U ED IN LOGICAL PHASE UA 09960015 SPACE 2 10020015 WR1 EQU 5 ORK REGISTERS - WR2 AND WR3 , 10080015 WR2 EQU 2 ND WR6 AND WR7 MUST BE EVEN / 10140015 WR3 EQU 3 DD PAIRS 10200015 WR4 EQU 4 10260015 WR6 EQU 0 10320015 WR7 EQU 1 10380015 WR8 EQU 7 10440015 WR9 EQU 8 10500015 SPACE 10560015 PR1 EQU 7 ARAMETER REGISTERS FOR THE 10620015 PR2 EQU 8 EXT MOVING ROUTINE 10680015 SPACE 10740015 DICR EQU 13 ICTIONARY REGISTER 10800015 SPACE 10860015 TVR EQU 11 RANSFER VECTOR REGISTER 10920015 SPACE 10980015 RLDR EQU 3 EXT LOCATION IN RLD BUFFER 11040015 SPACE 11100015 CUR EQU 4 URRENT RLD CARD BUFFER 11160015 SPACE 11220015 TXTR EQU 1 EXT LOCATION IN TEXT CARD 11280015 LOCCTR EQU 6 TATIC LOC ATION COUNTER 11340015 SPACE 11400015 DEAR EQU 12 OINTER TO THE CURRENT DICT.ENT. 11460015 SPACE 11520015 BASR EQU 9 ASE REGISTER FOR UA 11580015 BASR2 EQU 10 ASE REGISTER FOR UB 11640015 BASR3 EQU 4 ASE REGISTER FOR UC OR UD 11700015 SPACE 11760015 RR EQU 14 LINK REGISTER 11820015 LR EQU 15 USED FOR BRANCHING TO COMPILER 11880015 EJECT 11940015 * DICTIONARY ENTRY COD BYTES 12000015 SPACE 2 12060015 ET4 EQU X'03' NTRY TYPE 4 12120015 BIF EQU X'04' UILT-IN FUNCTION 12180015 LABVAR EQU X'07' CALAR LABEL VARIABLE 12240015 FILCON EQU X'08' ILE CONSTANT 12300015 FILE EQU X'09' ILE NAME 12360015 SIMDAT EQU X'0F' CALAR DATA VARIABLE 12420015 DIMLAB EQU X'17' IMENSIONED LABEL VARIABLE 12480015 DIMDAT EQU X'1F' IMENSIONED DATA VARIABLE 12540015 STRUCT EQU X'2E' CALAR STRUCTURE 12600015 DIMSTR EQU X'3E' IMENSIONED STRUCTURE 12660015 DISTDA EQU X'3F' DATA VAR IN DIMEN STRUCTURE 52181 12690021 CONST EQU X'88' ONSTANT 12720015 ATTRIB EQU X'98' ILE ATTRIBUTE ENTRY 12780015 DED2 EQU X'C1' ED FOR TEMPORARY 12840015 ILF EQU X'C2' NTERNAL LIB FUNCTION AND 12900015 ARG EQU X'C5' RGUMENT LIST 12960015 DVSKEL EQU X'C6' UTOMATIC DOPE VECTOR SKELETON 13020015 SYMTAB EQU X'C7' YMBOL TABLE AND DED 13080015 RDVRDV EQU X'C9' 13140015 DVDDVD EQU X'CC' 13200015 SPACE 10 13260015 * OFFSETS WITHIN DICTI NARY ENTRY 13320015 SPACE 2 13380015 * DATA VARIABLES 13440015 SPACE 13500015 STATCH EQU 3 TATIC CHAIN 13560015 DATOFS EQU 5 FFSET 1 SLOT 13620015 DATINF EQU 16 ATA INFORMATION 13680015 DATOF2 EQU 21 FFSET 2 SLOT 13740015 DATIN1 EQU 25 NITIAL DATA ENTRY WITH AND 13800015 DATIN2 EQU 21 WI HOUT PRESENCE OF OFFSET 2 SLOT 13860015 DIM1 EQU 25 IMENSION SLOT 13920015 DATIN3 EQU 35 13980015 DATIN4 EQU 31 14040015 STCHN1 EQU 29 TRUCTURE CHAIN FOR SCALAR AND 14100015 STCHN2 EQU 32 DI ENSIONED STRUCTURE 14160015 DATSYM EQU 19 OINTER TO SYMBOL TABLE D.E. 14220015 DCLNO EQU 8 ECLARE NUMBER SLOT 14280015 SPACE 2 14340015 DATOT1 EQU 10 OTHER 14400015 SPACE 14460015 LDCON EQU X'80' LD CONST NEEDED FOR LABEL 14520015 CHECK EQU X'20' ME TIONED IN CHECK LIST 14580015 DVDFLG EQU X'10' 14640015 SPACE 2 14700015 DATVAR EQU 11 VARIA LE 14760015 SPACE 14820015 OF2FL EQU X'80' OF SET 2 SLOT 14880015 DIMFL EQU X'40' DI ENSIONED 14940015 STRFL EQU X'20' TRUCTURED 15000015 INITFL EQU X'08' IN TIAL DATA 15060015 SPACE 2 15120015 DATOT2 EQU 12 OTHER 15180015 SPACE 1 15240015 EXTFL EQU X'04' EX ERNAL VARIABLE 15300015 SPACE 2 15360015 DATOT3 EQU 13 OTHER 15420015 SPACE 1 15480015 DVFL EQU X'80' DO E VECTOR NEEDED 15540015 VONEG EQU X'04' NE ATIVE VIRTUAL ORIGIN 15600015 SPACE 2 15660015 DATOT4 EQU 14 THER4 15720015 SPACE 15780015 MAJPAK EQU X'08' ACKED MAJOR STRUCTURE 15840015 MAJST EQU X'04' 15900015 RDVFLG EQU X'01' 15960015 SPACE 2 16020015 DATDAT EQU 15 DATA 16080015 SPACE 1 16140015 FL1 EQU X'80' 16200015 FL3 EQU X'20' 16260015 FL4 EQU X'10' 16320015 FL5 EQU X'08' 16380015 FL6 EQU X'04' 16440015 FL7 EQU X'02' 16500015 CHARST EQU X'84' 16560015 SPACE 2 16620015 * STRUCTURE ENTRIES 16680015 SPACE 16740015 STCHN3 EQU 23 STRUCTURE CHAIN FOR SCALAR AND 16800015 STCHN4 EQU 26 D MENSIONED STRUCTURES 16860015 SPACE 2 16920015 * LABEL ENTRIES 16980015 SPACE 1 17040015 DIM2 EQU 19 FFSET OF DIMENSION SLOT 17100015 LABBCD EQU 8 .R. OF LABEL BCD ENTRY 17160015 LABOF2 EQU 15 2ND OFFSET SLOT 17220015 SPACE 2 17280015 * LABEL CONSTANTS 17340015 SPACE 1 17400015 LABET1 EQU 16 TR TO ET1 OF CONTAINING BLOCK 17460015 LABCOD EQU 18 ODE BYTE 17520015 LABOFS EQU 11 OFFSET OF LABEL WITHIN PROC 17580015 SPACE 2 17640015 * PICTURE ENTRIES 17700015 SPACE 1 17760015 PICL EQU 12 ENGTH OF PICTURE 17820015 PICOFF EQU 5 TATIC OFFSET OF PICTURE 17880015 PICPIC EQU 8 CTUAL PICTURE 17940015 SPACE 2 18000015 * DEDS 18060015 SPACE 1 18120015 DEDDED EQU 8 CTUAL DED 18180015 DEDL EQU 11 18240015 DEDOFS EQU 5 18300015 FEDL EQU 12 18360015 SPACE 2 18420015 * CONSTANTS 18480015 SPACE 1 18540015 CONCH EQU 3 ONSTANTS CHAIN 18600015 CONTYP EQU 8 YPE CODE BYTE 18660015 CONDED EQU 10 18720015 CONCD EQU 8 18780015 SPACE 2 18840015 * FUNCTIONS 18900015 SPACE 1 18960015 FNTYP EQU 8 DENTIFICATION CODE BYTE 19020015 SPACE 2 19080015 * SYMBOL TABLES 19140015 SPACE 19200015 SYMCHN EQU 14 HAIN OF SYMBOL TABLE ENTRIES 19260015 SYMDAT EQU 16 OINTER BACK TO VARIABE 19320015 SYMOFS EQU 11 19380015 SPACE 2 19440015 * ON ENTRIES 19500015 SPACE 19560015 ONLENT EQU 11 19620015 ONNAME EQU 12 19680015 SPACE 2 19740015 * ENTRY LABELS 19800015 SPACE 1 19860015 ELET2 EQU 11 OINTER TO ET2 19920015 ELOFS EQU 13 FFSET OF ENTRY POINT 19980015 SPACE 2 20040015 * ENTRY TYPE 1 20100015 SPACE 1 20160015 ET1BAK EQU 5 OINTER BACK UP ET1 CHAIN 20220015 ET1SYM EQU 23 OINTER TO SYMBOL TABLE CHAIN 20280015 ET1EL EQU 7 OINTER TO 1ST ENTRY LABEL 20340015 ET1OF2 EQU 14 FFSET OF PROLOG CODE 20400015 ET1OF3 EQU 17 FFSET OF PROCEDURE CODE 20460015 ET1OF5 EQU X'1C' FFSET OF PROC IN PROGRAM 20520015 ET1ESD EQU 3 SDID OF DISPLAY PSEUDO REGISTER 20580015 ET1OPT EQU 42 PTIONS BYTE 20640015 MAIN EQU X'20' 20700015 ET1CNT EQU 25 20760015 ET1CHN EQU 9 20820015 SPACE 2 20880015 * ENTRY TYPE 2 20940015 SPACE 21000015 ET2ET3 EQU 3 OINTER TO ET3 21060015 SPACE 2 21120015 * ENTRY TYPE 3 21180015 SPACE 1 21240015 ET3ET1 EQU 3 OINTER TO ET1 FOR BLOCK 21300015 SPACE 2 21360015 * RDV ENTRIES 21420015 RDVOFS EQU 5 21480015 RDVDAT EQU 10 21540015 RDVVAR EQU 8 21600015 SPACE 2 21660015 * DVD ENTRIES 21720015 DVDOFS EQU 5 21780015 DVDDAT EQU 12 21840015 DVDVAR EQU 8 21900015 SPACE 10 21960015 * PSEUDO - CODE OPERAT ON CODE BYTES 22020015 SPACE 22080015 DCV1 EQU X'01' 22140015 DCV3 EQU X'03' 22200015 DCV4 EQU X'04' 22260015 DCA3 EQU X'13' 22320015 DCA4 EQU X'14' 22380015 SPACE 10 22440015 * MISCELLANEOUS FLAGS AND EQUIVALENCES 22500015 SPACE 22560015 ADFL EQU X'80' 22620015 DVFL1 EQU X'40' 22680015 CONFL EQU X'20' 22740015 SEFL EQU X'10' 22800015 NOINIT EQU X'08' 22860015 INITON EQU X'F7' 22920015 HEREBK EQU X'80' MASK FOR FIRST BIT 22980015 ONON EQU X'80' MASK TO TEST FOR INIT ON 23040015 PACKK EQU X'80' MASK TO TEST FOR PACKED ARRAY 23100015 TSTBIT EQU X'80' 23160015 TSTRDV EQU X'80' 23220015 TSTDVD EQU X'80' 23280015 MLTPL8 EQU X'07' TESTS IF N IS OF FORM 8*M 23340015 EJECT 23400015 * BRANCH MNEMONICS 23460015 SPACE 2 23520015 NOP EQU 0 23580015 BO EQU 1 23640015 BH EQU 2 23700015 BL EQU 4 23760015 BM EQU 4 23820015 BNE EQU 7 23880015 BNZ EQU 7 23940015 BE EQU 8 24000015 BZ EQU 8 24060015 BEH EQU 10 24120015 BNL EQU 11 24180015 BLE EQU 12 24240015 BNH EQU 13 24300015 BNO EQU 14 24360015 B EQU 15 24420015 EJECT 24480015 USING *,BASR2 BASE FOR UB 24540015 USING *+X'1000',BASR BASE FOR UA OR UD 24600015 USING *+X'2000',BASR3 BASE FOR UC 24660015 USING *+X'3000',TVR BASE FOR COMPILER CONTROL VECTS. 24720015 USING *+X'4000',DICR BASE FOR COMMUNICATIONS REGION 24780015 EJECT 24840015 * ENTRY POINTS IN THE FIRST BLOCK 24900015 SPACE 2 24960015 UA EQU *+X'1000' 25020015 UA000 EQU UA+6 25080015 UA0015 EQU UA000+4 25140015 UA021 EQU UA0015+4 25200015 UA033 EQU UA021+4 25260015 UA0413 EQU UA033+4 25320015 UA0345 EQU UA0413+4 25380015 UA105 EQU UA0345+4 25440015 UA1005 EQU UA105+4 25500015 DVRETU EQU UA1005+4 25560015 DVRETV EQU DVRETU+4 25620015 EJECT 25680015 * ENTRY POINTS IN THE THIRD BLOCK 25740015 SPACE 2 25800015 UC EQU *+X'2000' 25860015 UCINIT EQU UC+2 25920015 UCUPDT EQU UCINIT+4 25980015 TIDY EQU UCUPDT+4 26040015 STRAD1 EQU TIDY+4 26100015 UC0080 EQU STRAD1+4 26160015 UA100 EQU UC0080+4 26220015 UA220 EQU UA100+4 26280015 UA225 EQU UA220+4 26340015 PRNTHD EQU UA225+4 26400015 ONELST EQU PRNTHD+4 26460015 PRNTOU EQU ONELST 26520015 TWOLST EQU ONELST+4 26580015 RUNOUT EQU TWOLST+4 26640015 TASK EQU RUNOUT+4 26700015 EVENT EQU TASK+4 26760015 AREA EQU EVENT+4 26820015 TSKRLD EQU AREA+4 26880015 UA0215 EQU TSKRLD+4 26940015 UA100A EQU UA0215+4 27000015 DSAS EQU UA100A+4 27060015 EJECT 27120015 * OFFSETS IN COMPILER ONTROL TRANSFER VECTOR 27180015 SPACE 2 27240015 TV EQU *+X'3000' 27300015 ZUPL EQU TV+8 27360015 ZUGC EQU TV+X'10' 27420015 ZUTXTC EQU TV+X'14' 27480015 ZURC EQU TV+X'18' 27540015 LOADW EQU TV+X'24' 27600015 ZUERR EQU TV+X'30' 27660015 ZDRFAB EQU TV+X'34' 27720015 RELESE EQU TV+X'44' 27780015 RLSCTL EQU TV+X'48' 27840015 ZTXTAB EQU TV+X'54' 27900015 ZCHAIN EQU TV+X'58' 27960015 ZALTER EQU TV+X'5C' 28020015 ZULF EQU TV+X'70' 28080015 ZUSP EQU TV+X'74' 28140015 EJECT 28200015 * OFFSETS IN THE DICTI NARY COMMUNICATIONS REGION 28260015 SPACE 2 28320015 DICB EQU *+X'4000' 28380015 ZTRAN1 EQU DICB+68 28440015 ZTRAN2 EQU DICB+72 NTERNAL-EXTERNAL TRANSLATE TAB 28500015 ZMYNAM EQU DICB+112 AME OF CURRENT PHASE 28560015 ZSTAT EQU DICB+124 54710 28590021 PAR1 EQU DICB+128 28620015 PAR2 EQU PAR1+4 28680015 PAR6 EQU PAR1+20 28740015 PAR7 EQU PAR1+24 28800015 PAR8 EQU PAR1+28 28860015 CCCODE EQU DICB+232 PTIONS CODE BYTE 28920015 LDFIL EQU X'10' LOAD FILE REQUIRED 28980015 DECK EQU X'08' PUNCHED DECK REQUIRED 29040015 LISTFL EQU X'20' 29100015 TXTSZ EQU DICB+264 29160015 LOCK EQU DICB+274 29220015 ZCOMM EQU DICB+304 29280015 DICEXT EQU ZCOMM+48 ST EXTERNAL ITEM 29340015 DICET1 EQU ZCOMM+66 EAD OF ET1 CHAIN 29400015 STATH EQU ZCOMM+72 EAD OF STATIC CHAIN 29460015 CONPOL EQU ZCOMM+2 ST BLOCK OF CONSTANTS POOL 29520015 CONHD EQU ZCOMM+78 29580015 ZPAGE EQU DICB+192 29640015 ZEQTAB EQU ZCOMM+32 29700015 EJECT 29760015 DC C'UB' 29820015 BC B,TXTMOV 29880015 BC B,STRCTA 29940015 BC B,STRCTB 30000015 BC B,STREND 30060015 BC B,RLDMOV 30120015 BC B,OUTPUT 30180015 BC B,LIST 30240015 BC B,LIST1 30300015 BC B,LIST2 30360015 BC B,LIST3 30420015 BC B,UA912 30480015 EJECT 30540015 * WORKSPACE AND DATA FOR PHASE 30600015 SPACE 30660015 ORG IEMUB+X'50' 30720015 SPACE 1 30780015 * USEFUL CONSTANTS 30840015 K1 DC F'1' 30900015 K2 DC F'2' 30960015 K4 DC F'4' 31020015 CONST4 EQU K4 31080015 K7 DC F'7' 31140015 K8 DC F'8' 31200015 K10 DC F'10' 31260015 K16 DC F'16' 31320015 K19 DC F'19' 31380015 K32 DC F'32' 31440015 CNST32 EQU K32 31500015 K56 DC H'56' 31560015 K12 DC H'12' 31620015 K72 DC F'72' 31680015 K256 DC F'256' 31740015 K31 DC F'31' 31800015 WDMSK DC X'FFFFFFFC' 31860015 MASK8 DC X'FFFFFFF8' 31920015 ADMSK DC X'00FFFFFF' 31980015 ZERO DC F'0' 32040015 ZEROS4 EQU ZERO 32100015 BLANK DC 8X'40' 32160015 ERRID1 DC X'0B51' 32220015 END DC X'02C5D5C4' 32280015 PHSNAM DC C'UBUCUEZZ' 32340015 UANAM DC C'UAZZ' 32400015 UBNAM DC C'UBZZ' 32460015 UCNAM DC C'UCZZ' 32520015 UDNAM DC C'UDZZ' 32580015 UENAM DC C'UEZZ' 32640015 POINT DC X'46' 32700015 K76 DC F'76' 54710 32730021 EJECT 32760015 * WORKSPACE 32820015 SPACE 32880015 ORG IEMUB+X'D0' 32940015 SPACE 33000015 STOREG DC 6F'0' 33060015 ARRSTO DC 2F'0' PTR TO BOUNDS AND MULTIPLIER OF 33120015 DOUBLE DC 2F'0' 33180015 SLOT DC 2F'0' 33240015 ADJUST DC F'0' 33300015 BAS3 DC F'0' 33360015 CHAR1 DC F'0' 33420015 DESTO DC F'0' ADDRESS OF MAJOR STRUCTURE D.E. 33480015 DIMNO DC F'0' NO OF DIMS OF AN ARRAY 33540015 DPKEEP DC F'0' 33600015 DVST DC F'0' 33660015 DV2STO DC F'0' STATIC OFFSET OF 2NDARY DVS FOR 33720015 * STRUCTURE 33780015 ECOUNT DC F'0' 33840015 FWORD DC F'0' FULL WORD WORK AREA 33900015 FRSTSO DC F'0' 33960015 FSTADD DC F'0' 34020015 FSTBLK DC F'0' 34080015 HOLDRR DC F'0' 34140015 HWORD DC F'0' 34200015 KEEPRR DC F'0' 34260015 KEEPR1 DC F'0' 34320015 KEEPR3 DC F'0' 34380015 KEEPR9 DC F'0' 34440015 LNKST1 DC F'0' STORAGE 34500015 LNKST2 DC F'0' FOR 34560015 LNKST3 DC F'0' LINK 34620015 LNKST4 DC F'0' REGISTERS 34680015 MAXSIZ DC F'0' 34740015 NOELMS DC F'0' NUMBER OF ELEMENTS 34800015 OLD DC F'0' 34860015 OUTPTR DC F'0' OUTPUT POINTER FOR STATIC OFFSET 34920015 PR2SAV DC F'0' 34980015 REGSTO DS 5F TEMPORARY STORAGE FOR REGISTERS 35040015 RELOC DC F'0' 35100015 RLDSTO DC F'24' PTR TO NEXT SPACE IN RLD CARD 35160015 DC F'0' ADDRESS OF CURRENT RLD CARD 35220015 RLDBUF DC 2H'2' BUFFER FOR BUILDING UP RLD 35280015 DC F'0' ENTRIES 35340015 SAVERR DC F'0' 35400015 SAVER9 DC F'0' 35460015 SCRCOR DC F'0' 35520015 SPILAD DC F'0' 35580015 STOWR1 DC F'0' 35640015 STOWR9 DC F'0' 35700015 TEM1 DC F'0' 35760015 TEM2 DC F'0' 35820015 TEM3 DC F'0' 35880015 TEM4 DC F'0' 35940015 TXTAD DC F'0' 36000015 TXTSTO DC F'64' PTR TO NEXT SPACE IN TXT CARD 36060015 VOST DC F'0' 36120015 ELMLTH DC H'0' 36180015 M DC H'0' 36240015 N DC H'0' NO. OF BITS IN WR6 36300015 NODIMS DC H'0' 36360015 LCKSTO DC H'0' 36420015 ARRDR DC H'0' 36480015 BITFLG DC X'00' 36540015 BITOFF DC X'00' 36600015 BITPCK DC X'00' 36660015 BITREM DC X'00' 36720015 FLAG DC X'00' 36780015 INIT DC X'00' 36840015 NEWCD DC X'00' 36900015 PRTDVD DC X'00' 36960015 PRTRDV DC X'00' 37020015 SIXFS DC X'FFFFFF' 37080015 FSTEL DC F'0' 52181 37100021 FSTFLG DC X'00' 52181 37120021 EJECT 37140015 ORG IEMUB+X'200' 37200015 TXTBUF DS C BUFFER FOR BUILDING UP TXT 37260015 ORG *+255 37320015 SPACE 1 37380015 * TABLE OF CODE BYTES FOR IDENTIFYING DICTIONARY ENTRIES 37440015 SPACE 1 37500015 CODTAB DC 32D'0' 37560015 ORG CODTAB 37620015 DC X'302C' 37680015 ORG CODTAB+X'03' 37740015 DC X'2820' 37800015 ORG CODTAB+X'06' 37860015 DC X'34' 37920015 ORG CODTAB+X'07' 37980015 DC X'0C' 38040015 ORG CODTAB+X'08' 38100015 DC X'1C' 38160015 ORG CODTAB+X'09' 38220015 DC X'24' 38280015 ORG CODTAB+X'0C' 38340015 DC X'0C' 38400015 ORG CODTAB+X'0D' 38460015 DC X'0C' 38520015 ORG CODTAB+X'0F' 38580015 DC X'04' 38640015 ORG CODTAB+X'17' 38700015 DC X'10' 38760015 ORG CODTAB+X'1C' 38820015 DC X'10' 38880015 ORG CODTAB+X'1D' 38940015 DC X'10' 39000015 ORG CODTAB+X'1F' 39060015 DC X'08' 39120015 ORG CODTAB+X'27' 39180015 DC X'0C' 39240015 ORG CODTAB+X'2C' 39300015 DC X'0C' 39360015 ORG CODTAB+X'2D' 39420015 DC X'0C' 39480015 ORG CODTAB+X'2E' 39540015 DC X'14' 39600015 ORG CODTAB+X'2F' 39660015 DC X'04' 39720015 ORG CODTAB+X'37' 39780015 DC X'10' 39840015 ORG CODTAB+X'3C' 39900015 DC X'10' 39960015 ORG CODTAB+X'3D' 40020015 DC X'10' 40080015 ORG CODTAB+X'3E' 40140015 DC X'18' 40200015 ORG CODTAB+X'3F' 40260015 DC X'08' 40320015 ORG CODTAB+X'4D' 40380015 DC X'24' 40440015 ORG CODTAB+X'80' 40500015 DC X'38' 40560015 ORG CODTAB+X'81' 40620015 DC X'38' 40680015 ORG CODTAB+X'88' 40740015 DC X'3C' 40800015 ORG CODTAB+X'8F' 40860015 DC X'04' 40920015 ORG CODTAB+X'9F' 40980015 DC X'04' 41040015 ORG CODTAB+X'AF' 41100015 DC X'04' 41160015 ORG CODTAB+X'BF' 41220015 DC X'04' 41280015 ORG CODTAB+X'C2' 41340015 DC X'20' 41400015 ORG CODTAB+X'C3' 41460015 DC X'30' 41520015 ORG CODTAB+X'C9' 41580015 DC X'00' 60073 41640072 ORG CODTAB+X'CC' 41700015 DC X'34' 23305 41760019 ORG CODTAB+X'CE' 41820015 DC X'34' 41880015 SPACE 2 41940015 * CARD BUFFERS 42000015 ORG CODTAB+256 42060015 TXTCD DC X'02E3E7E3400000004040002040400002' 42120015 DC F'4096' 42180015 DC F'4096' 42240015 DC F'8192' 42300015 DC F'12288' 42360015 DC F'16384' 42420015 DC F'20480' 42480015 DC F'24576' 42540015 DC F'28672' 42600015 DC 4F'0' 42660015 DC 16X'40' 42720015 RLDCD1 DC X'02D9D3C4404040404040003840404040' 42780015 DC X'000200020D0000040D0000080D00000C' 42840015 DC X'0D0000100D0000140D0000180C00001C' 42900015 DC X'000400020C000020000500020C000024' 42960015 DC X'000100020C000028' 43020015 DC 8X'40' 43080015 DC F'0' 43140015 RLDCD2 DC X'02D9D3C4404040404040000040404040' 43200015 DC X'000100020C00002C' 43260015 DC 24X'40' 43320015 DC 32X'40' 43380015 DC F'0' 43440015 RLDCD3 DC X'02D9D3C4404040404040000040404040' 43500015 DC 32X'40' 43560015 DC 32X'40' 43620015 DC F'0' 43680015 DC X'0000F1' 43740015 PRINT DC 26X'40' 43800015 HEAD DC X'32331133191340192533152925112340' 43860015 DC X'3233262911171540241127' 43920015 DC 67X'40' 43980015 EJECT 44040015 * TEXT MOVING ROUTINE 44100015 * 44160015 * 44220015 * 44280015 * FUNCTION/OPERATION 44340015 * THIS ROUTINE MOVES TEXT TO A CARD BUFFER AND WRITES IT 44400015 * OUT WHEN FULL. IT ALSO LISTS THE TEXT AS IT IS MOVED, IF 44460015 * REQUIRED. 44520015 * 44580015 * 44640015 * ENTRY POINT - TXTMOV 44700015 * 44760015 * 44820015 * 44880015 * EXTERNAL ROUTINES - OUTPUT WRITES A TXT CARD ON THE 44940015 * PUNCH AND/OR LOAD FILES AND ALSO ANY RLD CARDS THAT ARE FULL 45000015 * LIST LISTS THE TEXT AS IT IS MOVED, WITH 45060015 EJECT 45120015 * APPROPRIATE COMMENTS. 45180015 * 45240015 * EXITS - NORMAL- RETURN USING REGISTER 14 45300015 * 45360015 * 45420015 * 45480015 * EXITS - ERROR - NONE 45540015 * 45600015 * 45660015 * 45720015 * TABLES/WORKSPACE 45780015 * TXTCD IS AN 80-BYTE TXT CARD BUFFER 45840015 * REGSTO IS USED TO STORE REGISTERS 2-5 ON ENTRY 45900015 * 45960015 * 46020015 * 46080015 * NOTES 46140015 * THE ROUTINE REQUIRES 3 PARAMETERS 46200015 * PR1 = ADDRESS FROM WHICH TEXT IS TO BE MOVED 46260015 * PR2 = LENGTH OF TEXT 46320015 * TEM1 = STATIC OFFSET OF FIRST BYTE OF TEXT 46380015 SPACE 3 46440015 TXTMOV STM WR2,WR1,REGSTO STORE WORK REGISTERS 46500015 L TXTR,TXTSTO LOAD POINTER TO NEXT AVAILABLE 46560015 * SPACE ON CARD 46620015 ST RR,LNKST3 46680015 C PR2,ZERO IF PR2 LESS THAN ZERO 46740015 BC BNL,*+8 STOP 46800015 BAL RR,UA 46860015 SPACE 1 46920015 * TEST IF CURRENT LOCATION COUNTER GREATER THAN TEM1 . IF SO 46980015 * OUTPUT CURRENT CARD AND SET LOC CTR = TEM1 47040015 C LOCCTR,TEM1 47100015 BC BE,UA901 IF EQUAL GO TO MOVE TXT 47160015 SPACE 1 47220015 * WRITE OUT CARD 47280015 UA900 C TXTR,K16 TEST IF CURRENT CARD EMPTY 47340015 BC BE,UA9004 IF SO NO NEED TO WRITE IT OUT 47400015 S TXTR,K16 47460015 STH TXTR,TXTCD+10 STORE LENGTH OF VARIABLE FIELD 47520015 L TXTR,K16 RESET TXTR =16 47580015 BAL RR,OUTPUT WRITE OUT CARD 47640015 UA9004 MVC TXTCD+5(3),TEM1+1 SET ASSEMBLED FIELD 47700015 UA9005 L LOCCTR,TEM1 47760015 SPACE 1 47820015 * MOVE TXT TO CARD 47880015 UA901 C PR2,ZERO 47940015 BC BNE,UA9010 48000015 ST TXTR,TXTSTO 48060015 BC B,UA902 IF LENGTH OF TEXT = 0 RETURN 48120015 UA9010 TM CCCODE,LISTFL 48180015 BC BNZ,*+8 48240015 BAL RR,LIST 48300015 AR LOCCTR,PR2 48360015 LA WR1,72 48420015 SR WR1,TXTR WR1 = SIZE OF REMAINING SPACE 48480015 UA9015 CR WR1,PR2 TEST IF TXT WILL FIT 48540015 BC BL,UA903 BRANCH IF NOT 48600015 SPACE 1 48660015 * TEXT FITS SO MOVE TEXT TO CARD, OUTPUT CARD IF FULL AND 48720015 * RETURN 48780015 BCTR PR2,0 48840015 STC PR2,MVC2X+1 STORE LENGTH OF TXT IN MOVE 48900015 LA PR2,1(PR2) INSTRUCTION 48960015 LA WR2,TXTCD(TXTR) 49020015 MVC2X MVC 0(0,WR2),0(PR1) 49080015 AR TXTR,PR2 UPDATE TXT CARD POINTER AND 49140015 ST TXTR,TXTSTO STORE IT 49200015 C TXTR,K72 TEST IF CARD FULL 49260015 BC BL,UA902 49320015 MVC TXTCD+10(2),K56 IF SO OUTPUT IT 49380015 BAL RR,OUTPUT 49440015 MVC TEM1+1(3),TXTCD+5 49500015 L WR2,TEM1 49560015 AH WR2,K56 49620015 ST WR2,TEM1 49680015 MVC TXTCD+5(3),TEM1+1 49740015 UA902 LM WR2,WR1,REGSTO RESTORE WORK REGISTERS 49800015 L RR,LNKST3 49860015 BCR B,RR RETURN 49920015 SPACE 2 49980015 * TEXT WILL NOT FIT IN REMAINDER OF CARD SO FILL IT UP AND 50040015 * OUTPUT IT 50100015 UA903 SR PR2,WR1 REDUCE PR2 BY LENGTH OF TXT 50160015 BCTR WR1,0 WHICH WILL FIT 50220015 STC WR1,MVC3+1 STORE LENGTH OF SPACE IN MOVE 50280015 LA WR1,1(WR1) INSTRUCTION 50340015 LA WR2,TXTCD(TXTR) 50400015 MVC3 MVC 0(0,WR2),0(PR1) FILL CARD WITH TEXT 50460015 AR PR1,WR1 UPDATE PR1 TO END OF TEXT MOVED 50520015 MVC TXTCD+10(2),K56 INSERT LENGTH OF TEXT IN CARD 50580015 BAL RR,OUTPUT OUTPUT CARD 50640015 L TXTR,K16 50700015 MVC TEM1+1(3),TXTCD+5 50760015 L WR2,TEM1 UPDATE ASSEMBLED ADDRESS OF 1ST 50820015 AH WR2,K56 BYTE OF TXT ON CARD 50880015 ST WR2,TEM1 50940015 MVC TXTCD+5(3),TEM1+1 51000015 LH WR1,K56 51060015 BC B,UA9015 NOW GO BACK TO TEST IF REMAINING 51120015 * TEXT WILL FIT ON CARD 51180015 EJECT 51240015 * PACKED STRUCTURES WITH INITIAL ELEMENTS ARE 51300015 * BUILT UP IN A SERIES OF TEXT BLOCKS. IN ORDER TO 51360015 * IMPROVE COMPILE TIME THE BLOCKS ARE NOT CHAINED TOGETHER, 51420015 * BUT ARE POINTED AT FROM A TABLE IN SCRATCH CORE. THE 51480015 * ENTRIES IN THIS TABLE CONSIST OF FOUR BYTES, THE FIRST IS 51540015 * SET TO X'00' IF THE BLOCK NAMED IN THE SECOND BYTE IS NOT 51600015 * PRESENT, AND IT IS SET TO X'FF' IF THE ASSOCIATED 51660015 * BLOCK IS PRESENT. 51720015 * 51780015 * THE FIRST ENTRY POINT TO THE STRUCTURE INITIALISATION 51840015 * ROUTINE IS STRCTB. THE TRANSFER VECTOR IS RESET AND ROUTINE 51900015 * INITIALISATION IS PERFORMED. THE MAIN BODY OF THE ROUTINE 51960015 * IS THEN ENTERED. 52020015 * 52080015 * THE MAIN ENTRY POINT IS STRCTA. THE RELEVANT TEXT 52140015 * BLOCK IS FOUND AND THE DATA IS INSERTED BY MEANS OF 'OR' 52200015 * INSTRUCTIONS. 52260015 SPACE 5 52320015 STRCTB C PR2,ZEROS4 RETURN IF NO DATA IS TO 52380015 BCR BE,RR BE INSERTED 52440015 SPACE 52500015 OI IEMUB+7,X'F0' RESET TRANSFER VECTOR 52560015 SPACE 52620015 STM WR6,WR1,STOREG SAVE REGISTERS - PRIMARY ENTRY 52680015 ST RR,HOLDRR POINT 52740015 SPACE 52800015 L WR7,FSTBLK 52860015 XC 0(80,WR7),0(WR7) 52920015 SPACE 52980015 TM 0(DEAR),DISTDA TEST IF DIM STR DATA VARIABL 52181 53040021 BC BNO,STRCTB1 52181 53050021 * 53051021 * TASK,EVENT AND AREA REQUIRE INITIAL TEXT 52181 53052021 * BUT DO NOT HAVE THE INITIAL ATTRIBUTE 52181 53053021 * 53054021 TM DATVAR(DEAR),INITFL TEST INITIAL IN VARIAB BYTE 52181 53055021 BC BNO,STRCTB1 52181 53056021 TM FLAG,DVFL1 TEST DV FLAG 52181 53060021 BC BO,STRCTB1 52181 53063021 MVC FSTADD+1(3),FSTEL+1 * SET TO 1ST STATIC OFFSET 62645 53066072 BC B,STRCTB2 52181 53070021 STRCTB1 MVC FSTADD+1(3),TEM1+1 SET TO OFFS OF 1ST INIT ITEM 52181 53080021 STRCTB2 EQU * 52181 53090021 MVC MAXSIZ(4),ZERO 53100015 BC B,STRCTE 53160015 SPACE 53220015 STRCTA C PR2,ZEROS4 RETURN IF NO DATA IS TO 53280015 BCR BE,RR BE INSERTED 53340015 SPACE 53400015 STM WR6,WR1,STOREG SAVE REGISTERS - MAIN ENTRY 53460015 ST RR,HOLDRR POINT 53520015 SPACE 53580015 STRCTE MVI TEM1,X'00' 53640015 L WR1,TEM1 53700015 S WR1,FSTADD OFFSET IN STRUCTURE IN REG 5 53760015 SR WR4,WR4 SET REG 4 TO ZERO 53820015 D WR4,TXTSZ BLOCK NO INREG 5 53880015 * OFFSET IN BLOCK IN REG 4 53940015 SPACE 54000015 AR WR1,WR1 54060015 AR WR1,WR1 54120015 C WR1,K76 * IS THIS TXT BLK # > 20 54710 54140021 BNL STRCERR YES THEN GO RAISE ERROR 54710 54160021 A WR1,FSTBLK 54180015 SPACE 54240015 CLI 0(WR1),X'00' TEST WHETHER BLOCK IS PRESENT 54300015 BC BNE,STRCTF 54360015 SPACE 54420015 BAL RR,NULLIT A NEW BLOCK IS WANTED 54480015 BC B,STRCTG 54540015 SPACE 54600015 STRCTF MVC PAR1+1(3),1(WR1) 54660015 L LR,ZTXTAB OBTAIN THE CURRENT BLOCK 54720015 BALR RR,LR 54780015 L WR7,PAR1 WR7 POINTS TO THE TEXT BLOCK 54840015 SPACE 54900015 STRCTG A PR2,TEM1 54960015 C PR2,MAXSIZ DETERMINE THE FURTHEST EXTENT 55020015 BC BNH,STRCTH OF THE STRUCTURE 55080015 ST PR2,MAXSIZ 55140015 STRCTH S PR2,TEM1 55200015 SPACE 5 55260015 * THIS PART OF THE STRUCTURE INITIALISATION ROUTINE 55320015 * TOGETHER WITH ROUTINE 'SHIFT' INSERTS THE INITIAL DATA AS 55380015 * SPECIFIED BY PARAMETERS 'PR1', 'PR2', AND 'TEM1' INTO 55440015 * THE RELEVANT TEXT BLOCKS. 55500015 SPACE 5 55560015 STRCTJ L WR3,TXTSZ 55620015 SR WR3,WR4 SPACE LEFT IN THIS BLOCK 55680015 CR WR3,PR2 55740015 BC BL,STRCTK BRANCH IF MORE DATA THAN SPACE 55800015 SPACE 55860015 NI STRCTL+1,X'0F' SET SWITCH OFF 55920015 SPACE 55980015 BAL RR,SHIFT INSERT DATA 56040015 BC B,STRCTM 56100015 SPACE 56160015 STRCTK OI STRCTL+1,X'F0' SET SWITCH ON 56220015 SPACE 56280015 SR PR2,WR3 56340015 ST PR2,PR2SAV 56400015 LR PR2,WR3 56460015 BAL RR,SHIFT FILL UP CURRENT BLOCK 56520015 L PR2,PR2SAV 56580015 SPACE 56640015 STRCTM MVC PAR1+1(3),1(WR1) 56700015 MVI PAR2+3,X'03' 56760015 L LR,ZALTER MARK CURRENT BLOCK WANTED 56820015 BALR RR,LR 56880015 SPACE 56940015 STRCTL BC B,STRCTN 57000015 SPACE 57060015 LM WR6,WR1,STOREG RESTORE REGISTERS 57120015 L RR,HOLDRR 57180015 BCR B,RR RETURN 57240015 SPACE 57300015 STRCTN LA WR1,4(WR1) UPDATE TABLE POINTER 57360015 S WR1,FSTBLK * IS THIS TXT BLK # > 20 54710 57370021 C WR1,K76 * IF SO WE CANT COPE WITH 54710 57380021 BNL STRCERR * INITIAL ATTRIBUTE 54710 57390021 A WR1,FSTBLK * IF NOT THEN CARRY ON 54710 57400021 CLI 0(WR1),X'00' 57420015 BC BNE,STRCTP 57480015 SPACE 57540015 BAL RR,NULLIT GET A NEW BLOCK 57600015 STRCTQ SR WR4,WR4 57660015 BC B,STRCTJ 57720015 SPACE 57780015 STRCTP MVC PAR1+1(3),1(WR1) 57840015 L LR,ZTXTAB GET THE BLOCK NAMED IN TABLE 57900015 BALR RR,LR 57960015 L WR7,PAR1 58020015 BC B,STRCTQ 58080015 EJECT 58140015 SHIFT LA WR7,0(WR7,WR4) 58200015 SPACE 58260015 SHIFTA C PR2,K256 58320015 BC BNH,SHIFTB BRANCH IF LESS THAN 256 BYTES 58380015 SPACE 58440015 OC 0(256,WR7),0(PR1) INSERT DATA 58500015 SPACE 58560015 S PR2,K256 58620015 LA WR7,256(WR7) UPDATE POINTERS 58680015 LA PR1,256(PR1) 58740015 BC B,SHIFTA 58800015 SPACE 58860015 SHIFTB S PR2,K1 58920015 STC PR2,SHIFTC+1 58980015 SHIFTC OC 0(1,WR7),0(PR1) 59040015 SPACE 59100015 LA WR7,1(PR2,WR7) UPDATE POINTERS 59160015 LA PR1,1(PR2,PR1) 59220015 SPACE 59280015 BCR B,RR 59340015 EJECT 59400015 * THIS ROUTINE OBTAINS A FRESH TEXT BLOCK AND SETS 59460015 * THE CONTENTS TO ZEROS 59520015 * 59580015 * NULLIT REQUIRES WR1 TO POINT TO A VACANT SLOT IN 59640015 * THE TABLE OF TEXT BLOCKS 59700015 SPACE 5 59760015 NULLIT ST RR,NULLRR SAVE RETURN REGISTER 59820015 MVI PAR2+3,X'00' 59880015 L LR,ZUTXTC 59940015 BALR RR,LR GET NEW TEXT BLOCK 60000015 SPACE 60060015 MVI 0(WR1),X'FF' 60120015 MVC 1(1,WR1),PAR1+1 SET UP TABLE ENTRY 60180015 SPACE 60240015 L WR7,PAR2 60300015 L WR2,TXTSZ 60360015 SPACE 60420015 NULL01 C WR2,K256 60480015 BC BL,NULL02 60540015 SPACE 60600015 XC 0(256,WR7),0(WR7) 60660015 LA WR7,256(WR7) 60720015 S WR2,K256 60780015 BC B,NULL01 60840015 SPACE 60900015 NULL02 XC 0(248,WR7),0(WR7) TXTSZ = 1024K - 8 60960015 SPACE 61020015 L WR7,PAR2 RESET TEXT BLOCK POINTER 61080015 L RR,NULLRR 61140015 BCR B,RR 61200015 SPACE 10 61260015 NULLRR DC F'0' 61320015 EJECT 61380015 * RLD ENTRY MOVING ROUTINE 61440015 * 61500015 * 61560015 * 61620015 * FUNCTION/OPERATION 61680015 * 61740015 * 61800015 * 61860015 * ENTRY POINT - RLDMOV 61920015 * 61980015 * 62040015 * 62100015 * EXTERNAL ROUTINES - UA912 WRITES OUT RLD CARDS WHEN ALL 62160015 * THREE ARE FULL 62220015 * 62280015 * 62340015 * 62400015 * EXITS - NORMAL RETURN TO CALLING ROUTINE 62460015 * 62520015 * 62580015 * 62640015 * EXITS - ERROR - NONE 62700015 * 62760015 * 62820015 * 62880015 * TABLES/WORKSPACE 62940015 * THERE IS A CIRCULAR CHAIN OF THREE RLD CARD BUFFERS EACH 63000015 * FOLLOWED BY 4 BYTES CONTAINING THE ADDRESS OF THE NEXT IN THE 63060015 * CHAIN. THE FIRST BYTE OF THIS WORD IS SET TO X'FF' WHEN THE 63120015 * CARD IS FULL. THE ONLY TIME THERE IS A POSSIBILITY OF ALL 63180015 * THREE BEING FULL AT ONCE IS WHEN THE CONSTANTS ARE BEING 63240015 * RELOCATED AND THE TEXT OF THE CONSTANTS POOL HAS ALREADY BEEN 63300015 * OUTPUT SO THE RLD CARDS CAN SAFELY BE WRITTEN OUT 63360015 * 63420015 * 63480015 * 63540015 * NOTES 63600015 * NO PARAMETERS ARE REQUIRED. THE RLD ENTRY IS ALWAYS IN 63660015 * RLDBUF AND IS WRITTEN INTO THE NEXT AVAILABLE SPACE ON A CARD 63720015 SPACE 3 63780015 SPACE 2 63840015 RLDMOV STM WR2,WR1,REGSTO STORE WORK REGISTERS 63900015 LM RLDR,CUR,RLDSTO LOAD CUR = ADDR OF CURRENT CARD 63960015 * RLDR = OFS OF NEXT SPACE 64020015 LA WR2,0(CUR,RLDR) WR2 = ADDR OF NEXT SPACE 64080015 * TEST IF RELOCATION AND POSITION HEADERS ARE THE SAME FOR 64140015 * THIS ENTRY AS FOR PREVIOUS ONE. IF SO ONLY A 4-BYTE ENTRY 64200015 * IS NEEDED 64260015 CLC RELOC(4),RLDBUF 64320015 BC BNE,UA922 64380015 SPACE 1 64440015 LA WR1,4(RLDR) ONLY 4-BYTE ENTRY NEEDED SO TEST 64500015 C WR1,K72 IF ROOM FOR IT ON CURRENT CARD 64560015 BC BH,UA920 BRANCH IF NO ROOM 64620015 MVC 0(4,WR2),RLDBUF+4 MOVE 2ND 4 BYTES OF RLDBUF TO 64680015 * CARD 64740015 S WR2,K4 SET T-FLAG IN PREVIOUS ENTRY TO 64800015 OI 0(WR2),X'01' SAY SAME RELOC AND POSN HEADER IN 64860015 * FOLLOWING ENTRY 64920015 LA RLDR,4(RLDR) BUMP CARD POINTER BY 4 64980015 STM RLDR,CUR,RLDSTO 65040015 LM WR2,WR1,REGSTO RELOAD WORK REGISTERS 65100015 BCR B,RR RETURN 65160015 SPACE 2 65220015 * THERE IS NO ROOM ON CARD FOR ENTRY SO MARK CARD FULL AND 65280015 * GET NEXT CARD 65340015 UA920 S RLDR,K16 STORE LENGTH OF VARIABLE FIELD 65400015 STH RLDR,10(CUR) IN CARD 65460015 L RLDR,K16 65520015 MVI 80(CUR),X'FF' SET CARD FULL 65580015 L CUR,80(CUR) LOAD CUR = ADDR OF NEXT CARD 65640015 CLI 80(CUR),X'FF' TEST IF CARD FULL 65700015 BC BNE,UA9207 BRANCH IF NOT 65760015 STM RLDR,CUR,RLDSTO 65820015 ST RR,LNKST3 65880015 LA RR,UA9205 65940015 ST RR,LNKST4 IF SO ALL THREE CARD BUFFERS 66000015 BC B,UA912 ARE FULL SO WRITE THEM OUT 66060015 UA9205 L RR,LNKST3 66120015 LM RLDR,CUR,RLDSTO 66180015 SPACE 1 66240015 * NOW MOVE ENTRY TO BEGINNING OF NEW CARD 66300015 UA9207 LA WR2,16(CUR) 66360015 UA921 MVC 0(8,WR2),RLDBUF MOVE 8-BYTE ENTRY 66420015 LA RLDR,8(RLDR) UPDATE CARD POINTER BY 8 66480015 STM RLDR,CUR,RLDSTO 66540015 LM WR2,WR1,REGSTO RELOAD WORK REGISTERS 66600015 BCR B,RR RETURN 66660015 SPACE 2 66720015 * RELOC AND POSITION HEADERS NOT SAME AS PREVIOUS ENTRY SO 66780015 * 8-BYTE ENTRY NEEDED 66840015 UA922 MVC RELOC(4),RLDBUF MOVE NEW RELOCATION AND POSITION 66900015 * HEADERS TO RELOC 66960015 LA WR1,8(RLDR) 67020015 C WR1,K72 TEST IF ROOM FOR ENTRY 67080015 BC BH,UA920 IF NOT GO TO GET NEW CARD 67140015 BC B,UA921 GO TO MAKE 8-BYTE ENTRY 67200015 EJECT 67260015 * CARD OUTPUT ROUTINE 67320015 * 67380015 * 67440015 * 67500015 * FUNCTION/OPERATION 67560015 * 67620015 * 67680015 * 67740015 * ENTRY POINTS 67800015 * (1) OUTPUT WHEN TEXT AND RLD CARDS ARE REQUIRED TO BE 67860015 * OUTPUT 67920015 * (2) UA912 WHEN RLD CARDS ONLY ARE TO BE WRITTEN OUT 67980015 * 68040015 * 68100015 * 68160015 * EXTERNAL ROUTINES 68220015 * (1) ZUSP TO WRITE A CARD ON THE PUNCH FILE 68280015 * (2) ZULF TO WRITE A CARD ON THE LOAD FILE 68340015 * 68400015 * 68460015 * 68520015 * EXITS - NORMAL-RETURN TO CALLING ROUTINE 68580015 * 68640015 * 68700015 * 68760015 * EXITS - ERROR - NONE 68820015 * 68880015 * 68940015 * 69000015 * NOTES 69060015 * THE OPTIONS CODE BYTE AS SET UP FROM THE PARAMETER LIST 69120015 * ON THE EXECUTE CARD DETERMINES WHETHER OR NOT A LOAD FILE 69180015 * AND/OR PUNCH FILE IS CREATED. 69240015 * 69250001 * 69260001 OUTPUT1 EQU * H175 69270001 SR LOCCTR,LOCCTR H175 69280001 SPACE 3 69300015 SPACE 1 69360015 * FIRST OUTPUT TXT CARD 69420015 OUTPUT LA WR4,TXTCD 69480015 ST RR,LNKST4 STORE RETURN ADDRESS 69540015 TM CCCODE,LDFIL TEST IF LOAD FILE 69600015 BC BNZ,UA911 69660015 ST WR4,PAR1 69720015 L LR,ZULF IF SO WRITE OUT CARD 69780015 BALR RR,LR 69840015 UA911 TM CCCODE,DECK TEST IF PUNCHED DECK 69900015 BC BNZ,UA9115 69960015 ST WR4,PAR1 70020015 L LR,ZUSP IF SO PUNCH CARD 70080015 BALR RR,LR 70140015 UA9115 MVC TXTCD+16(1),BLANK BLANK OUT VARIABLE FIELD 70200015 MVC TXTCD+17(55),TXTCD+16 70260015 MVC TXTSTO(4),K16 RESET CARD POINTER 70320015 SPACE 1 70380015 * ENTER HERE TO WRITE OUT RLD CARDS ONLY 70440015 * SCAN THROUGH CIRCULAR CHAIN OF 3 BUFFERS FOR ANY FULL 70500015 UA912 EQU * 70520001 L RR,LNKST4 H175 70540001 CLC TXTSTO(4),K16 H175 70560001 BNE OUTPUT1 H175 70580001 L WR4,RLDSTO+4 WR4=ADDR OF 1ST CARD 70600001 LA WR3,3 LOAD BCT REG =3 70620015 UA914 LA WR4,0(WR4) CLEAR TOP 8 BITS OF WR4 70680015 TM 80(WR4),X'FF' 70740015 BC BZ,UA917 CARD NOT FULL SO GO TO LOOK AT 70800015 * NEXT 70860015 TM CCCODE,LDFIL 70920015 BC BNZ,UA915 70980015 L LR,ZULF 71040015 ST WR4,PAR1 71100015 BALR RR,LR 71160015 UA915 TM CCCODE,DECK 71220015 BC BNZ,UA916 71280015 ST WR4,PAR1 71340015 L LR,ZUSP 71400015 BALR RR,LR 71460015 UA916 NI 80(WR4),X'00' SET CARD FREE 71520015 UA917 BCT WR3,UA918 71580015 L BASR3,BAS3 71640015 L RR,LNKST4 ALL CARDS DEALT WITH SO 71700015 BCR B,RR RETURN 71760015 SPACE 1 71820015 UA918 L WR4,80(WR4) LOAD WR4 = ADDR OF NEXT CARD 71880015 BC B,UA914 71940015 EJECT 72000015 * STATIC LISTING ROUTINE 72060015 * 72120015 * 72180015 * 72240015 * FUNCTION/OPERATION 72300015 * THIS ROUTINE IS CALLED FROM TXTMOV IN UB WHENEVER TXT IS 72360015 * MOVED TO THE CARD BUFFER TO LIST THE TEXT ALONG WITH SUITABLE 72420015 * COMMENT. IT IS ALSO CALLED TO PRINT THE NAMES OF UNINITIALISED 72480015 * VARIABLES AND THEIR STATIC OFFSET 72540015 * 72600015 * 72660015 * 72720015 * ENTRY POINTS 72780015 * (1) LIST1 TO PRINT THE HEADINGS FOR THE STATIC LISTING 72840015 * (2) LIST TO PRINT TXT IN HEX WITH ITS STATIC OFFSET AND 72900015 * A SUITABLE COMMENT 72960015 * (3) LIST2 TO PRINT UNINITIALISED SCALAR VARIABLE NAMES 73020015 * (4) LIST3 TO PRINT ARRAY NAMES 73080015 * 73140015 * 73200015 * 73260015 * EXTERNAL ROUTINES 73320015 * (1) ZUPL IN COMPILER CONTROL TO WRITE A LINE ON THE 73380015 * PRINT FILE 73440015 * 73500015 * 73560015 * 73620015 * EXITS - NORMAL - RETURN TO CALLING ROUTINE 73680015 * 73740015 * 73800015 * 73860015 * EXITS - ERROR - NONE 73920015 * 73980015 * 74040015 * 74100015 * NOTES 74160015 * THE TXT IS PRINTED WITH UP TO 8 BYTES PER LINE. AGAINST 74220015 * EACH LINE IS PRINTED THE STATIC OFFSET OF THE FIRST BYTE AND 74280015 * AGAINST THE FIRST LINE OF TEXT FOR EACH ITEM IS PRINTED AN 74340015 * IDENTIFYING COMMENT. 74400015 SPACE 3 74460015 LIST1 ST RR,LNKST5 74520015 LH LR,ZPAGE 74580015 S LR,K4 74640015 MH LR,K58 74700015 CH LR,K3312 MAX SPACE IS 3312 BYTES 74760015 BC BH,*+12 74820015 L RR,LNKST5 74880015 BC B,PRNTHD 74940015 LA WR1,PRINT-3 75000015 ST WR1,PAR1 75060015 L LR,ZUPL 75120015 BALR RR,LR EJECT PAGE 75180015 MVI PRINT-2,X'78' SET LINE LENGTH = 120 AND 75240015 MVI PRINT-1,X'F0' CARRIAGE CONTROL=DOUBLE SPACE 75300015 L WR2,ZTRAN2 TRANSLATE HEADING TO EXTERNAL 75360015 TR PRINT(120),0(WR2) FORM 75420015 ST WR1,PAR1 75480015 BALR RR,LR PRINT HEADING 75540015 MVI PRINT-1,X'40' SET CARRIAGE CONTROL=SINGLE 75600015 * SPACE 75660015 MVC PRINT(1),BLANK 75720015 MVC PRINT+1(119),PRINT 75780015 SPACE 1 75840015 L RR,LNKST5 75900015 BCR B,RR 75960015 SPACE 2 76020015 K58 DC H'58' 76080015 K3312 DC H'3312' 76140015 SPACE 2 76200015 LIST2 TM FLAG,SEFL 76260015 BCR BNZ,RR 76320015 ST RR,LNKST5 76380015 OI FLAG,NOINIT 76440015 TM TXTMOV+1,X'F0' 76500015 BC BO,UA5005 76560015 MVC LOCST(4),TEM1 76620015 BC B,UA5005+4 76680015 SPACE 2 76740015 * ENTER TO LIST ARRAYS OR BIT STRINGS IN STRUCTURES 76800015 LIST3 TM FLAG,SEFL 76860015 BCR BNZ,RR 76920015 ST RR,LNKST5 76980015 OI FLAG,NOINIT 77040015 BC B,UA5012 77100015 EJECT 77160015 * STATIC INTERNAL LISTING ROUTINE 77220015 SPACE 1 77280015 LIST TM FLAG,SEFL IF TEXT IS STATIC EXTERNAL 77340015 BCR BNZ,RR DON'T LIST IT 77400015 ST RR,LNKST5 STORE RETURN REGISTER 77460015 ST TXTR,TXTSTO 77520015 UA5005 ST LOCCTR,LOCST 77580015 LA WR1,LOCST+1 77640015 LA WR2,3 77700015 LA WR3,PRINT 77760015 BAL RR,HEX CONVERT VALUE OF LOCATION 77820015 * COUNTER TO PRINTABLE FORM 77880015 TM FLAG,CONFL 77940015 BC BNZ,UA509 BRANCH IF CONSTANTS 78000015 C DEAR,OLD IF THIS ENTRY IS SAME AS 78060015 BC BE,UA5015 PREVIOUS NO COMMENT IS NEEDED 78120015 ST DEAR,OLD STORE REF OF CURRENT ENTRY 78180015 XR 2,2 78240015 L RR,ZEQTAB ADDRESS OF SCRATCH 78300015 TRT 0(1,DEAR),528(RR) IDENTIFY DICTIONARY ENTRY FOR 78360015 BC BNZ,*+8 WHICH TEXT IS BEING PRODUCED 78420015 BAL RR,UA 78480015 BC B,*(2) 78540015 BC B,UA501 SCALAR DATA VAR 78600015 BC B,UA501 DATA ARRAY 78660015 BC B,UA501 LABEL VAR 78720015 BC B,UA501 LABEL ARRAY 78780015 BC B,UA501 SCALAR STRUCTURES 78840015 BC B,UA501 DIMENSIONED STRUCTURES 78900015 BC B,UA507 FILE CONSTANT 78960015 BC B,UA508 FUNCTION 79020015 BAL RR,UA TASK 79080015 BC B,UA504 ENTRY TYPE 4 79140015 BC B,UA506 ENTRY LABEL 79200015 BC B,UA506 LABEL CONSTANT 79260015 BAL RR,UA 79320015 BAL RR,UA 79380015 BAL RR,UA 79440015 BC B,UA5095 DED 79500015 BC B,UA510 DED2 79560015 BC B,UA510 FILE ATTRIB ENTRY 79620015 BC B,UA5075 CONDITION NEME 79680015 BC B,UA510 DV SKELETON 79740015 BC B,UA510 ARG LIST 79800015 BC B,UA5065 LABEL VARIABLE BCD 79860015 BC B,UA5098 RDV 79920015 BC B,UA5099 DVD 79980015 BC B,UACLAB COMPILER LABEL 80040015 BC B,UASDSA 80100015 SPACE 2 80160015 * VARIABLES 80220015 UA501 TM FLAG,ADFL TEST IF TEXT FOR ADDRESS 80280015 BC BNZ,UA504 CONSTANT. BRANCH IF SO 80340015 TM FLAG,DVFL1 80400015 BC BNZ,UA505 BRANCH IF SO 80460015 SPACE 80520015 UA5012 MVC FLD2+2(2),1(DEAR) 80580015 LH WR1,FLD2+2 80640015 AR WR1,DEAR 80700015 UA5013 MVC MVC1+1(1),0(WR1) MOVE BCD LENGTH TO MVC INSTRN 80760015 MVC1 MVC PRINT+36(0),1(WR1) 80820015 UA5015 TM FLAG,NOINIT 80880015 BC BNZ,UA5025 80940015 ST PR1,TXTADD 81000015 LR WR7,PR2 81060015 UA5017 C WR7,K8 TEST IF MORE THAN 8 BYTES OF 81120015 BC BL,UA502 TEXT. BRANCH IF NOT 81180015 LA WR1,LOCST+1 81240015 LA WR2,3 81300015 LA WR3,PRINT 81360015 BAL RR,HEX CONVERT LOCATION COUNTER TO 81420015 L WR2,LOCST PRINTABLE FORM 81480015 LA WR2,8(WR2) 81540015 ST WR2,LOCST 81600015 LA WR3,PRINT+8 81660015 L WR1,TXTADD 81720015 LA WR2,8 81780015 BAL RR,HEX CONVERT TEXT TO PRINTABLE FORM 81840015 ST WR4,SAVER4 81900015 L WR4,BAS3 81960015 BAL RR,PRNTOU 82020015 L WR4,SAVER4 82080015 LA WR1,8(WR1) 82140015 ST WR1,TXTADD 82200015 S WR7,K8 82260015 BC B,UA5017 82320015 SPACE 1 82380015 * PRINT REMAINING BYTES 82440015 UA502 C WR7,ZERO 82500015 BC BE,UA503 82560015 LA WR1,LOCST+1 82620015 LA WR2,3 82680015 LA WR3,PRINT CONVERT LOCATION COUNTER TO 82740015 BAL RR,HEX PRINTABLE FORM 82800015 LA WR3,PRINT+8 82860015 L WR1,TXTADD 82920015 LR WR2,WR7 82980015 BAL RR,HEX 83040015 UA5025 ST WR4,SAVER4 83100015 L WR4,BAS3 83160015 BAL RR,PRNTOU 83220015 L WR4,SAVER4 83280015 UA503 L RR,LNKST5 83340015 L TXTR,TXTSTO 83400015 NI FLAG,INITON 83460015 BCR B,RR RETURN TO TXTMOV 83520015 SPACE 1 83580015 * TEXT FOR ADDRESS CONSTANT 83640015 UA504 MVC PRINT+30(3),DCA MOVE CHARACTERS A.. 83700015 BC B,UA5012 83760015 SPACE 1 83820015 * TEXT FOR DOPE VECTOR 83880015 UA505 MVC PRINT+30(4),DV MOVE CHARACTERS DV.. 83940015 BC B,UA5012 84000015 SPACE 84060015 * STATIC DSA ENTRIES 84120015 UASDSA MVC PRINT+30(15),DSA 84180015 MVC PAR1+2(2),10(DEAR) REF OF ENTRY TYPE1 84240015 L LR,ZDRFAB 84300015 BALR RR,LR 84360015 L LR,PAR1 84420015 L WR4,BAS3 84480015 BAL RR,DSAS 84540015 BC B,UA5015 RETURN FOR LABELLED BLOCKS 84600015 SPACE 84660015 LR WR4,LR 84720015 SR RR,RR 84780015 IC RR,25(WR4) GET BLOCK NUMBER 84840015 CVD RR,WS0502 CONVERT TO PACKED DEC 84900015 MVC WS0501(9),WS0500 MOVE EDITING MASK TO WS0501 AND 84960015 EDMK WS0501(9),WS0503 EDIT RESULT OF CVD 85020015 LA WR4,WS0501+8 85080015 BC BNZ,IL0504 BRANCH IF NON ZERO 85140015 SPACE 85200015 LR 1,WR4 IF ZERO PUT INTERNAL ZERO 85260015 MVI 0(WR4),X'00' IN LAST BYTE 85320015 SPACE 85380015 IL0504 SR WR4,1 85440015 EX WR4,IL0501 CLEAR ZONES 85500015 EX WR4,IL0502 TRANSLATE TO INTERNAL FORM 85560015 EX WR4,IL0503 MOVE TO BUFFER 85620015 BC B,UA5015 85680015 SPACE 2 85740015 * ENTRY LABELS AND LABEL CONSTANTS 85800015 UA506 TM FLAG,ADFL TEST IF TEXT FOR ADDRESS 85860015 BC BNZ,UA504 CONSTANT. BRANCH IF SO 85920015 MVC PRINT+30(5),BCD MOVE CHARACTERS BCD.. 85980015 BC B,UA5012 86040015 SPACE 2 86100015 * LABEL VARIABLE BCD 86160015 UA5065 MVC PRINT+30(5),BCD MOVE CHARACTERS BCD.. TO BUFFER 86220015 MVC PAR1+2(2),8(DEAR) 86280015 BC B,UA5100 86340015 SPACE 2 86400015 * FILE CONSTANTS 86460015 UA507 TM DATOT2(DEAR),EXTFL TEST IF TEXT FOR ADDRESS 86520015 BC BNZ,UA504 CONSTANT. BRANCH IF SO 86580015 MVC PRINT+30(6),FILENM MOVE CHARACTERS FILE.. 86640015 BC B,UA5012 86700015 SPACE 2 86760015 * ONCONDITIONS NAMES 86820015 UA5075 MVC PRINT+30(4),ON 86880015 BC B,UA5012 86940015 SPACE 2 87000015 * FUNCTIONS 87060015 UA508 MVC PRINT+30(3),DCA 87120015 MVC PRINT+36(3),IHE 87180015 MVC PRINT+39(4),8(DEAR) 87240015 L WR2,ZTRAN1 87300015 TR PRINT+39(4),0(WR2) 87360015 BC B,UA5015 87420015 SPACE 2 87480015 * CONSTANTS POOL 87540015 UA509 MVC PRINT+30(9),CONSTA 87600015 BC B,UA5015 87660015 SPACE 2 87720015 * DED OR SYMBOL TABLE ENTRY 87780015 UA5095 CLI 2(DEAR),X'0B' DED AND SYM TAB ENTRIES HAVE 87840015 BC BNE,UA5097 SAME CODE BYTE BUT DIFFERENT 87900015 * LENGTH. BRANCH IF DED 87960015 MVC PRINT+30(3),DED 88020015 BC B,UA5015 88080015 UA5097 MVC PRINT+30(7),SYMTAA 88140015 BC B,UA5015 88200015 SPACE 3 88260015 * RDV ENTRY 88320015 UA5098 MVC PRINT+30(5),RDV MOVE CHARACTERS RDV.. 88380015 MVC PAR1+2(2),RDVVAR(DEAR) 88440015 BC B,UA5100 88500015 SPACE 3 88560015 * DVD ENTRY 88620015 UA5099 MVC PRINT+30(5),DVD MOVE CHARACTERS DVD.. 88680015 MVC PAR1+2(2),DVDVAR(DEAR) 88740015 UA5100 L LR,ZDRFAB 88800015 BALR RR,LR 88860015 L WR1,PAR1 88920015 TM 0(WR1),X'80' BRANCH IF FOR FORMAL PARAMETER 88980015 BC BO,UACLAG OR TEMPORARY 89040015 MVC FLD2+2(2),1(WR1) 89100015 AH WR1,FLD2+2 89160015 BC B,UA5013 89220015 SPACE 2 89280015 UACLAG TM DATOT2(WR1),X'08' BRANCH IF TEMP 89340015 BC BZ,UACLAH BRANCH IF TEMP 89400015 MVC FLD2+2(2),1(WR1) 89460015 AH WR1,FLD2+2 89520015 BCTR WR1,0 89580015 BCTR WR1,0 89640015 MVC PAR1+2(2),0(WR1) 89700015 L LR,ZDRFAB 89760015 BALR RR,LR 89820015 L WR1,PAR1 FIND BCD OF FORMAL PARAMETER 89880015 LA WR1,9(WR1) 89940015 BC B,UA5013 90000015 SPACE 2 90060015 UACLAH MVC PRINT+36(4),TEMP 90120015 BC B,UA5015 90180015 SPACE 2 90240015 * ALL OTHER POSSIBLE ENTRY HAVE NO BCD. USE GR2 AS AN 90300015 * INDEX TO PICK UP CORRECT COMMENT FROM TABLE 90360015 UA510 CLI 0(DEAR),X'C1' 90420015 BC BE,UA5102 90480015 UA5101 AR 2,2 90540015 AR 2,2 90600015 LA 2,COMTAB(2) SET GR2 = ADDR OF COMMENT 90660015 MVC PRINT+30(16),0(2) 90720015 BC B,UA5015 90780015 SPACE 1 90840015 UA5102 CLI 2(DEAR),X'0B' 90900015 BC BE,UA5101 90960015 MVC PRINT+30(3),FED 91020015 BC B,UA5015 91080015 SPACE 2 91140015 UACLAB CLC K19+2(2),1(DEAR) 91200015 BC BNE,*+8 91260015 BAL RR,UA 91320015 LA WR1,19(DEAR) 91380015 TM FLAG,ADFL 91440015 BC BNZ,UACLAD 91500015 MVC PRINT+30(5),BCD 91560015 BC B,UA5013 91620015 UACLAD MVC PRINT+30(3),DCA 91680015 BC B,UA5013 91740015 SPACE 2 91800015 * CONVERT A HEX NUMBER TO PRINTABLE FORM AND MOVE IT TO A 91860015 * PRINT BUFFER 91920015 * WR1 = ADDRESS OF DATA TO BE CONVERTED 91980015 * WR2 = LENGTH OF DATA 92040015 * WR3 = DESTINATION ADDRESS 92100015 SPACE 1 92160015 HEX MVO FLD1(9),0(8,WR1) 92220015 UNPK FLD2(16),FLD1(9) 92280015 MVZ FLD2(1),ZERO 92340015 MVZ FLD2+1(15),FLD2 92400015 TR FLD2(16),INTCOD 92460015 AR WR2,WR2 92520015 BCTR WR2,0 92580015 STC WR2,MVC2+1 92640015 MVC2 MVC 0(0,WR3),FLD2 92700015 BCR B,RR 92760015 EJECT 92820015 * CONSTANTS FOR STATIC LISTING 92880015 COMTAB EQU *-X'110' 92940015 DC X'14151440162629403315242740404040' DED2 93000015 DC X'16192315401133332919123433153240' ATTRIB 93060015 DC X'32113515772915323326291540404040' SAV/RST 93120015 DC X'14463546403222152315332625404040' DVSKEL 93180015 DC X'11291734241525334023193233404040' ARG LIST 93240015 FED DC X'161514' 93300015 DED DC X'141514' 93360015 SYMTAA DC X'32382440331112' 93420015 CONSTA DC X'132625323311253332' 93480015 FILENM DC X'161923154646' 93540015 BCD DC X'3238244646' 93600015 DV DC X'14354646' 93660015 DCA DC X'114646' 93720015 ON DC X'26254646' 93780015 RDV DC X'2914354646' 93840015 DVD DC X'1435144646' 93900015 TEMP DC X'33152427' 93960015 DSA DC X'114646143211464612232613224646' 94020015 LNKST5 DC F'0' 94080015 SAVER4 DC F'0' 94140015 IHE DC X'191815' 94200015 INTCOD DC X'00010203040506070809111213141516' 94260015 TXTADD DC F'0' 94320015 LOCST DC F'0' 94380015 FLD1 DC 2F'0' 94440015 DC X'0F' 94500015 FLD2 DC 4F'0' 94560015 DS 0D 94620015 SPACE 94680015 DC X'00' 94740015 WS0500 DC X'202020202020202020' 94800015 WS0501 DC XL6'00' 94860015 WS0502 DC XL3'00' 94920015 WS0503 DC XL5'00' 94980015 SPACE 95040015 IL0501 MVZ 0(0,1),INTCOD CLEAR ZONES 95100015 IL0502 TR 0(0,1),INTCOD TRANSLATE TO INTERNAL FORM 95160015 IL0503 MVC PRINT+45(0),0(1) MOVE TO PRINT BUFFER 95220015 EJECT 95280015 * THIS ROUTINE IS CALLED WHEN THE INITIALISATION 95340015 * OF A PACKED STRUCTURE IS COMPLETE. A SCAN IS MADE OF 95400015 * THE TABLE IN SCRATCH CORE FOR THOSE TEXT BLOCKS WHICH 95460015 * CONTAIN INITIAL DATA. 95520015 * 95580015 * STREND REQUIRES 95640015 * (1) FSTADD - THE STATIC OFFSET OF THE FIRST BYTE OF 95700015 * INITIAL DATA. 95760015 * (2) MAXSIZ - THE STATIC OFFSET OF THE BYTE FOLLOWING 95820015 * THE LAST BYTE OF INITIAL DATA. 95880015 * (3) FSTBLK - THE ADDRESS OF THE TABLE IN SCRATCH CORE. 95940015 SPACE 5 96000015 STREND ST RR,SAVERR SAVE RETURN REGISTER 96060015 OI STREN1+1,X'F0' SET LOOP SWITCH ON 96120015 SPACE 96180015 L WR6,MAXSIZ 96240015 L WR2,FSTADD STATIC OFFSET OF FIRST BYTE 96300015 SR WR6,WR2 SIZE OF STRUCTURE 96360015 L WR3,FSTBLK ADDRESS TABLE 96420015 SPACE 96480015 STREN5 C WR6,TXTSZ BRANCH IF STR.SIZE LESS THAN 96540015 BC BNH,STREN2 TEXT BLOCK SIZE 96600015 SPACE 96660015 L PR2,TXTSZ TEXT BLOCK FULL OF DATA 96720015 BC B,STREN3 96780015 SPACE 96840015 STREN2 NI STREN1+1,X'0F' SET LOOP SWITCH OFF 96900015 LR PR2,WR6 PART TEXT BLOCK OF DATA 96960015 SPACE 97020015 STREN3 CLI 0(WR3),X'00' 97080015 BC BE,STREN4 97140015 SPACE 97200015 MVC PAR1+1(3),1(WR3) 97260015 L LR,ZTXTAB GET TEXT BLOCK 97320015 BALR RR,LR 97380015 L PR1,PAR1 97440015 ST WR2,TEM1 SET UP STATIC OFFSET 97500015 BAL RR,TXTMOV PUT OUT DATA 97560015 SPACE 97620015 MVC PAR1+1(3),1(WR3) 97680015 MVI PAR2+3,X'01' 97740015 L LR,ZALTER MARK TEXT BLOCK FREE 97800015 BALR RR,LR 97860015 SPACE 97920015 STREN4 LA WR3,4(WR3) UPDATE WR3 BY 4 97980015 A WR2,TXTSZ UPDATE STATIC OFFSET 98040015 S WR6,TXTSZ REDUCE SIZE 98100015 STREN1 BC B,STREN5 REPEAT LOOP 98160015 SPACE 98220015 L RR,SAVERR RETURN 98280015 BCR B,RR 98340015 EJECT 98343021 STRCERR EQU * 98346021 CLC ARRDR,DICREF * HAVE WE ALREADY ISSUED 54710 98349021 BE STRCRET * MSG FOR THIS AGGREGATE 54710 98352021 MVC ZSTAT+2(2),8(DEAR) * GIVE DCL STMT NO 54710 98355021 MVC PAR6+1(3),BIGAGG * MOVE IN SEVERE ERR 54710 98358021 MVC PAR7+2(2),ARRDR * MSG # 2914 54710 98361021 L LR,ZUERR * CALL ZUERR 54710 98364021 BALR RR,LR 98367021 STRCRET EQU * 98370021 MVC DICREF(2),ARRDR * REMEMBER THIS DIC REF 54710 98373021 LM WR6,WR1,STOREG * RELOAD SAVED REGS 54710 98376021 L RR,HOLDRR * RELOAD LINK REG 54710 98379021 BR RR * RETURN TO CALLING POINT 54710 98382021 BIGAGG DC X'0B6254' * INDICATES SEVERE MSG 2914 4710 98385021 DICREF DC X'FFFF' 54710 98388021 EJECT 98400015 END IEMUB 98460015 ./ ADD SSI=16013193,NAME=IEMUC,SOURCE=0 UC TITLE 'IEMUC,STATIC INITIALISATION,FINAL ASSEMBLY,PL/I (F)' 00040015 * 00080015 * 00120015 * 00160015 * VERSION - 2 00200015 * 00240015 * STATUS - CHANGE LEVEL 0 00280015 * 00320015 * 00360015 * 5.4 A 136000,195600,283600,489600,490400 PEP 52181 00370064 * C 485200,486400 PEP 52181 00380064 * 00400015 * FUNCTION / OPERATION 00440015 * 00480015 * THE MODULE CONTAINS FURTHER ROUTINES WHICH ARE USED 00520015 * BY THE SCAN ROUTINES IN UA AND UD. 00560015 * 00600015 * 00640015 * 00680015 * ENTRY POINTS 00720015 * 00760015 * (1) UCINIT TO INITIALISE ARRAYS AND THEIR DOPE VECTORS 00800015 * 00840015 * (2) UCUPDT IS A RE-ENTRY POINT FOR ARRAY DOPE VECTOR 00880015 * INITIALISATION. 00920015 * 00960015 * (3) TIDY IS USED TO COMPLETE THE PACKING OF BIT 01000015 * STRINGS. 01040015 * 01080015 * (4) STRAD1 IS USED TO CALCULATE THE ADDRESSES OF 01120015 * ELEMENTS IN STRUCTURED ARRAYS. 01160015 * 01200015 * (5) UC0080 IS USED TO PACK BIT STRINGS. 01240015 * 01280015 * (6) UA100 TO INITIALISE THE IHEM AIN CSECT. 01320015 * 01360015 * (7) UA220 TO MAKE UP TEXT FOR LABEL CONSTANTS AND 01400015 * ENTRY LABELS. 01440015 * 01480015 * (8) UA225 TO MAKE UP TEXT FOR LABEL VARIABLES. 01520015 * 01560015 * (9) UA014 AND UA0145 TO INITIALISE THE CONSTANTS POOL. 01600015 * 01640015 * (10) UA080 TO INITIALISE SYMBOL TABLE ENTRIES. 01680015 * 01720015 * (11) UA230 TO INITIALISE DEDS. 01760015 * 01800015 * (12) UA0215 TO INITIALISE DOPE VECTOR SKELETONS. 01840015 * 01880015 * (13) ADDRDV TO INITIALISE RDVS AND DVDS 01920015 * 01960015 * 02000015 * 02040015 * INPUT - THE DICTIONARY 02080015 * 02120015 * 02160015 * 02200015 * 02240015 * 02280015 * 02320015 * EXITS - NORMAL - RETURN TO CALLING ROUTINE IN UA OR UB 02360015 * OR UD 02400015 * 02440015 * 02480015 * 02520015 * EXITS - ERROR - NONE 02560015 * 02600015 * 02640015 * 02680015 * ATTRIBUTES - N/A 02720015 * 02760015 * 02800015 * 02840015 * NOTES 02880015 * THIS MODULE IS INDEPENDENT OF THE EXTERNAL CHARACTER SET 02920015 * USED. 02960015 SPACE 10 03000015 *********************************************************************** 03040015 SPACE 5 03080015 * THE LAYOUT AND USAGE OF SCRATCH CORE DURING THE 03120015 * STATIC INITIALISATION PHASES IS AS FOLLOWS 03160015 * 03200015 * BYTES 0 - 63 03240015 * 03280015 * THESE ARE SET UP BY PHASE TF AND CONTAIN THE 03320015 * NAMES OF THE TEXT BLOCKS HOLDING INFORMATION ON EQU 03360015 * LABEL VALUES. EACH NAME IS HELD IN ONE BYTE 03400015 * 03440015 * BYTES 64 - 447 03480015 * 03520015 * THESE CONTAIN THE DOPE VECTOR OF A VARYING STRING 03560015 * ARRAY DURING DOPE VECTOR INITIALISATION, OF A STRUCTURED 03600015 * ARRAY OR OF A TASK, EVENT OR AREA ARRAY DURING ELEMENT 03640015 * INITIALISATION. 03680015 * 03720015 * BYTES 448 - 527 03760015 * 03800015 * THES ARE USED IN THE INITIALISATION OF PACKED 03840015 * STRUCTURES AND CONSIST OF 20 FOUR BYTE ENTRIES. EACH 03880015 * ENTRY CONSISTS OF A FLAG BYTE AND 3-BYTE TEXT REFERENCE 03920015 * 03960015 * BYTES 528 - 783 04000015 * 04040015 * THESE CONTAIN THE TRANSLATE TABLE 'TABLE2' 04080015 * USED FOR PROVIDING COMMENTS IN THE STATIC LISTINGS 04120015 * 'TABLE2' IS PLACED IN SCRATCH CORE BY 04160015 * PHASE TT 04200015 * 04240015 * BYTES 784 - 4095 04280015 * 04320015 * THESE ARE USED FOR THE TWO COLUMN LISTING FEATURE 04360015 * AND PERMIT IT FOR A PAGE SIZE OF NOT MORE THAN 57 04400015 SPACE 5 04440015 *********************************************************************** 04480015 SPACE 10 04520015 EJECT 04560015 IEMUC START 0 04600015 EJECT 04640015 * SYMBOLIC REGISTERS U ED IN LOGICAL PHASE UA 04680015 SPACE 2 04720015 WR1 EQU 5 ORK REGISTERS - WR2 AND WR3 , 04760015 WR2 EQU 2 ND WR6 AND WR7 MUST BE EVEN / 04800015 WR3 EQU 3 DD PAIRS 04840015 WR4 EQU 4 04880015 WR6 EQU 0 04920015 WR7 EQU 1 04960015 WR8 EQU 7 05000015 WR9 EQU 8 05040015 SPACE 05080015 PR1 EQU 7 ARAMETER REGISTERS FOR THE 05120015 PR2 EQU 8 05160015 SPACE 05200015 DICR EQU 13 ICTIONARY REGISTER 05240015 SPACE 05280015 TVR EQU 11 RANSFER VECTOR REGISTER 05320015 SPACE 05360015 RLDR EQU 3 EXT LOCATION IN RLD BUFFER 05400015 SPACE 05440015 CUR EQU 4 URRENT RLD CARD BUFFER 05480015 SPACE 05520015 TXTR EQU 1 EXT LOCATION IN TEXT CARD 05560015 LOCCTR EQU 6 TATIC LOC ATION COUNTER 05600015 SPACE 05640015 DEAR EQU 12 OINTER TO THE CURRENT DICT.ENT. 05680015 SPACE 05720015 BASR EQU 9 ASE REGISTER FOR UA 05760015 BASR2 EQU 10 ASE REGISTER FOR UB 05800015 BASR3 EQU 4 ASE REGISTER FOR UC OR UD 05840015 SPACE 05880015 RR EQU 14 LINK REGISTER 05920015 LR EQU 15 USED FOR BRANCHING TO COMPILER 05960015 EJECT 06000015 * DICTIONARY ENTRY COD BYTES 06040015 SPACE 2 06080015 ET4 EQU X'03' NTRY TYPE 4 06120015 BIF EQU X'04' UILT-IN FUNCTION 06160015 LABVAR EQU X'07' CALAR LABEL VARIABLE 06200015 FILCON EQU X'08' ILE CONSTANT 06240015 FILE EQU X'09' ILE NAME 06280015 SIMDAT EQU X'0F' CALAR DATA VARIABLE 06320015 DIMLAB EQU X'17' IMENSIONED LABEL VARIABLE 06360015 DIMDAT EQU X'1F' IMENSIONED DATA VARIABLE 06400015 STRUCT EQU X'2E' CALAR STRUCTURE 06440015 DIMSTR EQU X'3E' IMENSIONED STRUCTURE 06480015 CONST EQU X'88' ONSTANT 06520015 ATTRIB EQU X'98' ILE ATTRIBUTE ENTRY 06560015 DED2 EQU X'C1' ED FOR TEMPORARY 06600015 ILF EQU X'C2' NTERNAL LIB FUNCTION AND 06640015 ARG EQU X'C5' RGUMENT LIST 06680015 DVSKEL EQU X'C6' UTOMATIC DOPE VECTOR SKELETON 06720015 SYMTAB EQU X'C7' YMBOL TABLE AND DED 06760015 RDVRDV EQU X'C9' 06800015 DVDDVD EQU X'CC' 06840015 SPACE 10 06880015 * OFFSETS WITHIN DICTI NARY ENTRY 06920015 SPACE 2 06960015 * DATA VARIABLES 07000015 SPACE 07040015 STATCH EQU 3 TATIC CHAIN 07080015 DATOFS EQU 5 FFSET 1 SLOT 07120015 DATINF EQU 16 ATA INFORMATION 07160015 DATOF2 EQU 21 FFSET 2 SLOT 07200015 DATIN1 EQU 25 NITIAL DATA ENTRY WITH AND 07240015 DATIN2 EQU 21 WI HOUT PRESENCE OF OFFSET 2 SLOT 07280015 DIM1 EQU 25 IMENSION SLOT 07320015 DATIN3 EQU 35 07360015 DATIN4 EQU 31 07400015 STCHN1 EQU 29 TRUCTURE CHAIN FOR SCALAR AND 07440015 STCHN2 EQU 32 DI ENSIONED STRUCTURE 07480015 DATSYM EQU 19 OINTER TO SYMBOL TABLE D.E. 07520015 DCLNO EQU 8 ECLARE NUMBER SLOT 07560015 SPACE 2 07600015 DATOT1 EQU 10 OTHER 07640015 SPACE 07680015 LDCON EQU X'80' LD CONST NEEDED FOR LABEL 07720015 CHECK EQU X'20' ME TIONED IN CHECK LIST 07760015 DVDFLG EQU X'10' 07800015 SPACE 2 07840015 DATVAR EQU 11 VARIA LE 07880015 SPACE 07920015 OF2FL EQU X'80' OF SET 2 SLOT 07960015 DIMFL EQU X'40' DI ENSIONED 08000015 STRFL EQU X'20' TRUCTURED 08040015 INITFL EQU X'08' IN TIAL DATA 08080015 SPACE 2 08120015 DATOT2 EQU 12 OTHER 08160015 SPACE 1 08200015 EXTFL EQU X'04' EX ERNAL VARIABLE 08240015 SPACE 2 08280015 DATOT3 EQU 13 OTHER 08320015 SPACE 1 08360015 DVFL EQU X'80' DO E VECTOR NEEDED 08400015 VONEG EQU X'04' NE ATIVE VIRTUAL ORIGIN 08440015 SPACE 2 08480015 DATOT4 EQU 14 THER4 08520015 SPACE 08560015 MAJPAK EQU X'08' ACKED MAJOR STRUCTURE 08600015 MAJST EQU X'04' 08640015 RDVFLG EQU X'01' 08680015 SPACE 2 08720015 DATDAT EQU 15 DATA 08760015 SPACE 1 08800015 FL1 EQU X'80' 08840015 FL3 EQU X'20' 08880015 FL4 EQU X'10' 08920015 FL5 EQU X'08' 08960015 FL6 EQU X'04' 09000015 FL7 EQU X'02' 09040015 CHARST EQU X'84' 09080015 SPACE 2 09120015 * STRUCTURE ENTRIES 09160015 SPACE 09200015 STCHN3 EQU 23 STRUCTURE CHAIN FOR SCALAR AND 09240015 STCHN4 EQU 26 D MENSIONED STRUCTURES 09280015 SPACE 2 09320015 * LABEL ENTRIES 09360015 SPACE 1 09400015 DIM2 EQU 19 FFSET OF DIMENSION SLOT 09440015 LABBCD EQU 8 .R. OF LABEL BCD ENTRY 09480015 LABOF2 EQU 15 2ND OFFSET SLOT 09520015 SPACE 2 09560015 * LABEL CONSTANTS 09600015 SPACE 1 09640015 LABET1 EQU 16 TR TO ET1 OF CONTAINING BLOCK 09680015 LABCOD EQU 18 ODE BYTE 09720015 LABOFS EQU 11 OFFSET OF LABEL WITHIN PROC 09760015 SPACE 2 09800015 * PICTURE ENTRIES 09840015 SPACE 1 09880015 PICL EQU 12 ENGTH OF PICTURE 09920015 PICOFF EQU 5 TATIC OFFSET OF PICTURE 09960015 PICPIC EQU 8 CTUAL PICTURE 10000015 SPACE 2 10040015 * DEDS 10080015 SPACE 1 10120015 DEDDED EQU 8 CTUAL DED 10160015 DEDL EQU 11 10200015 DEDOFS EQU 5 10240015 FEDL EQU 12 10280015 SPACE 2 10320015 * CONSTANTS 10360015 SPACE 1 10400015 CONCH EQU 3 ONSTANTS CHAIN 10440015 CONTYP EQU 8 YPE CODE BYTE 10480015 CONDED EQU 10 10520015 CONCD EQU 8 10560015 SPACE 2 10600015 * FUNCTIONS 10640015 SPACE 1 10680015 FNTYP EQU 8 DENTIFICATION CODE BYTE 10720015 SPACE 2 10760015 * SYMBOL TABLES 10800015 SPACE 10840015 SYMCHN EQU 14 HAIN OF SYMBOL TABLE ENTRIES 10880015 SYMDAT EQU 16 OINTER BACK TO VARIABE 10920015 SYMOFS EQU 11 10960015 SPACE 2 11000015 * ON ENTRIES 11040015 SPACE 11080015 ONLENT EQU 11 11120015 ONNAME EQU 12 11160015 SPACE 2 11200015 * ENTRY LABELS 11240015 SPACE 1 11280015 ELET2 EQU 11 OINTER TO ET2 11320015 ELOFS EQU 13 FFSET OF ENTRY POINT 11360015 SPACE 2 11400015 * ENTRY TYPE 1 11440015 SPACE 1 11480015 ET1BAK EQU 5 OINTER BACK UP ET1 CHAIN 11520015 ET1SYM EQU 23 OINTER TO SYMBOL TABLE CHAIN 11560015 ET1EL EQU 7 OINTER TO 1ST ENTRY LABEL 11600015 ET1OF2 EQU 14 FFSET OF PROLOG CODE 11640015 ET1OF3 EQU 17 FFSET OF PROCEDURE CODE 11680015 ET1OF5 EQU X'1C' FFSET OF PROC IN PROGRAM 11720015 ET1ESD EQU 3 SDID OF DISPLAY PSEUDO REGISTER 11760015 ET1OPT EQU 42 PTIONS BYTE 11800015 MAIN EQU X'20' 11840015 ET1CNT EQU 25 11880015 ET1CHN EQU 9 11920015 SPACE 2 11960015 * ENTRY TYPE 2 12000015 SPACE 12040015 ET2ET3 EQU 3 OINTER TO ET3 12080015 SPACE 2 12120015 * ENTRY TYPE 3 12160015 SPACE 1 12200015 ET3ET1 EQU 3 OINTER TO ET1 FOR BLOCK 12240015 SPACE 2 12280015 * RDV ENTRIES 12320015 RDVOFS EQU 5 12360015 RDVDAT EQU 10 12400015 RDVVAR EQU 8 12440015 SPACE 2 12480015 * DVD ENTRIES 12520015 DVDOFS EQU 5 12560015 DVDDAT EQU 12 12600015 DVDVAR EQU 8 12640015 SPACE 10 12680015 * PSEUDO - CODE OPERAT ON CODE BYTES 12720015 SPACE 12760015 DCV1 EQU X'01' 12800015 DCV3 EQU X'03' 12840015 DCV4 EQU X'04' 12880015 DCA3 EQU X'13' 12920015 DCA4 EQU X'14' 12960015 SPACE 10 13000015 * MISCELLANEOUS FLAGS AND EQUIVALENCES 13040015 SPACE 13080015 ADFL EQU X'80' 13120015 DVFL1 EQU X'40' 13160015 CONFL EQU X'20' 13200015 SEFL EQU X'10' 13240015 NOINIT EQU X'08' 13280015 INITON EQU X'F7' 13320015 HEREBK EQU X'80' MASK FOR FIRST BIT 13360015 ONON EQU X'80' MASK TO TEST FOR INIT ON 13400015 PACKK EQU X'80' MASK TO TEST FOR PACKED ARRAY 13440015 TSTBIT EQU X'80' 13480015 TSTRDV EQU X'80' 13520015 TSTDVD EQU X'80' 13560015 MLTPL8 EQU X'07' TESTS IF N IS OF FORM 8*M 13600015 ON EQU X'FF' FSTFLG ON 52181 13610064 OFF EQU X'00' FSTFLG OFF 52181 13620064 EJECT 13640015 * BRANCH MNEMONICS 13680015 SPACE 2 13720015 NOP EQU 0 13760015 BO EQU 1 13800015 BH EQU 2 13840015 BL EQU 4 13880015 BM EQU 4 13920015 BNE EQU 7 13960015 BNZ EQU 7 14000015 BE EQU 8 14040015 BZ EQU 8 14080015 BEH EQU 10 14120015 BNL EQU 11 14160015 BLE EQU 12 14200015 BNH EQU 13 14240015 BNO EQU 14 14280015 B EQU 15 14320015 EJECT 14360015 USING *,BASR3 BASE FOR UC 14400015 USING *+X'1000',BASR BASE FOR UA OR UD 14440015 USING *+X'2000',BASR2 B ASE FOR UB 14480015 USING *+X'3000',TVR BASE FOR COMPILER CONTROL VECTS. 14520015 USING *+X'4000',DICR BASE FOR COMMUNICATIONS REGION 14560015 EJECT 14600015 * ENTRY POINTS IN THE FIRST BLOCK 14640015 SPACE 2 14680015 UA EQU *+X'1000' 14720015 UA000 EQU UA+6 14760015 UA0015 EQU UA000+4 14800015 UA021 EQU UA0015+4 14840015 UA033 EQU UA021+4 14880015 UA0413 EQU UA033+4 14920015 UA0345 EQU UA0413+4 14960015 UA105 EQU UA0345+4 15000015 UA1005 EQU UA105+4 15040015 DVRETU EQU UA1005+4 15080015 DVRETV EQU DVRETU+4 15120015 EJECT 15160015 * ENTRY POINTS IN THE SECOND BLOCK 15200015 SPACE 2 15240015 UB EQU *+X'2000' 15280015 TXTMOV EQU UB+2 15320015 STRCTA EQU TXTMOV+4 15360015 STRCTB EQU STRCTA+4 15400015 STREND EQU STRCTB+4 15440015 RLDMOV EQU STREND+4 15480015 OUTPUT EQU RLDMOV+4 15520015 LIST EQU OUTPUT+4 15560015 LIST1 EQU LIST+4 15600015 LIST2 EQU LIST1+4 15640015 LIST3 EQU LIST2+4 15680015 UA912 EQU LIST3+4 15720015 SPACE 5 15760015 K1 EQU UB+X'50' 15800015 K2 EQU K1+4 15840015 K4 EQU K2+4 15880015 CONST4 EQU K4 15920015 K7 EQU K4+4 15960015 K8 EQU K7+4 16000015 K10 EQU K8+4 16040015 K16 EQU K10+4 16080015 K19 EQU K16+4 16120015 K32 EQU K19+4 16160015 CNST32 EQU K32 16200015 K56 EQU K32+4 16240015 K12 EQU K56+2 16280015 K72 EQU K12+2 16320015 K256 EQU K72+4 16360015 K31 EQU K256+4 16400015 WDMSK EQU K31+4 16440015 MASK8 EQU WDMSK+4 16480015 ADMSK EQU MASK8+4 16520015 ZERO EQU ADMSK+4 16560015 ZEROS4 EQU ZERO 16600015 BLANK EQU ZERO+4 16640015 ERRID1 EQU BLANK+8 16680015 END EQU ERRID1+2 16720015 PHSNAM EQU END+4 16760015 UANAM EQU PHSNAM+8 16800015 UBNAM EQU UANAM+4 16840015 UCNAM EQU UBNAM+4 16880015 UDNAM EQU UCNAM+4 16920015 POINT EQU UDNAM+4 16960015 STOREG EQU UB+X'D0' 17000015 ARRSTO EQU STOREG+24 17040015 DOUBLE EQU ARRSTO+8 17080015 SLOT EQU DOUBLE+8 17120015 ADJUST EQU SLOT+8 17160015 BAS3 EQU ADJUST+4 17200015 CHAR1 EQU BAS3+4 17240015 DESTO EQU CHAR1+4 17280015 DIMNO EQU DESTO+4 17320015 DPKEEP EQU DIMNO+4 17360015 DVST EQU DPKEEP+4 17400015 DV2STO EQU DVST+4 17440015 ECOUNT EQU DV2STO+4 17480015 FWORD EQU ECOUNT+4 17520015 FRSTSO EQU FWORD+4 17560015 FSTADD EQU FRSTSO+4 17600015 FSTBLK EQU FSTADD+4 17640015 HOLDRR EQU FSTBLK+4 17680015 HWORD EQU HOLDRR+4 17720015 KEEPRR EQU HWORD+4 17760015 KEEPR1 EQU KEEPRR+4 17800015 KEEPR3 EQU KEEPR1+4 17840015 KEEPR9 EQU KEEPR3+4 17880015 LNKST1 EQU KEEPR9+4 17920015 LNKST2 EQU LNKST1+4 17960015 LNKST3 EQU LNKST2+4 18000015 LNKST4 EQU LNKST3+4 18040015 MAXSIZ EQU LNKST4+4 18080015 NOELMS EQU MAXSIZ+4 18120015 OLD EQU NOELMS+4 18160015 OUTPTR EQU OLD+4 18200015 PR2SAV EQU OUTPTR+4 18240015 REGSTO EQU PR2SAV+4 18280015 RELOC EQU REGSTO+20 18320015 RLDSTO EQU RELOC+4 18360015 RLDBUF EQU RLDSTO+8 18400015 SAVERR EQU RLDBUF+8 18440015 SAVER9 EQU SAVERR+4 18480015 SCRCOR EQU SAVER9+4 18520015 SPILAD EQU SCRCOR+4 18560015 STOWR1 EQU SPILAD+4 18600015 STOWR9 EQU STOWR1+4 18640015 TEM1 EQU STOWR9+4 18680015 TEM2 EQU TEM1+4 18720015 TEM3 EQU TEM2+4 18760015 TEM4 EQU TEM3+4 18800015 TXTAD EQU TEM4+4 18840015 TXTSTO EQU TXTAD+4 18880015 VOST EQU TXTSTO+4 18920015 ELMLTH EQU VOST+4 18960015 M EQU ELMLTH+2 19000015 N EQU M+2 19040015 NODIMS EQU N+2 19080015 LCKSTO EQU NODIMS+2 19120015 ARRDR EQU LCKSTO+2 19160015 BITFLG EQU ARRDR+2 19200015 BITOFF EQU BITFLG+1 19240015 BITPCK EQU BITOFF+1 19280015 BITREM EQU BITPCK+1 19320015 FLAG EQU BITREM+1 19360015 INIT EQU FLAG+1 19400015 NEWCD EQU INIT+1 19440015 PRTDVD EQU NEWCD+1 19480015 PRTRDV EQU PRTDVD+1 19520015 SIXFS EQU PRTRDV+1 19560015 FSTEL EQU SIXFS+3 52181 19570064 FSTFLG EQU FSTEL+4 52181 19580064 TXTBUF EQU UB+X'200' 19600015 CODTAB EQU TXTBUF+256 19640015 TXTCD EQU CODTAB+256 19680015 RLDCD1 EQU TXTCD+80 19720015 RLDCD2 EQU RLDCD1+84 19760015 RLDCD3 EQU RLDCD2+84 19800015 PRINT EQU RLDCD3+87 19840015 EJECT 19880015 * OFFSETS IN COMPILER ONTROL TRANSFER VECTOR 19920015 SPACE 2 19960015 TV EQU *+X'3000' 20000015 ZUPL EQU TV+8 20040015 ZUGC EQU TV+X'10' 20080015 ZUTXTC EQU TV+X'14' 20120015 ZURC EQU TV+X'18' 20160015 LOADW EQU TV+X'24' 20200015 ZUERR EQU TV+X'30' 20240015 ZDRFAB EQU TV+X'34' 20280015 RELESE EQU TV+X'44' 20320015 RLSCTL EQU TV+X'48' 20360015 ZTXTAB EQU TV+X'54' 20400015 ZCHAIN EQU TV+X'58' 20440015 ZALTER EQU TV+X'5C' 20480015 ZULF EQU TV+X'70' 20520015 ZUSP EQU TV+X'74' 20560015 EJECT 20600015 * OFFSETS IN THE DICTI NARY COMMUNICATIONS REGION 20640015 SPACE 2 20680015 DICB EQU *+X'4000' 20720015 ZTRAN1 EQU DICB+68 20760015 ZTRAN2 EQU DICB+72 NTERNAL-EXTERNAL TRANSLATE TAB 20800015 ZMYNAM EQU DICB+112 AME OF CURRENT PHASE 20840015 PAR1 EQU DICB+128 20880015 PAR2 EQU PAR1+4 20920015 PAR6 EQU PAR1+20 20960015 PAR7 EQU PAR1+24 21000015 PAR8 EQU PAR1+28 21040015 CCCODE EQU DICB+232 PTIONS CODE BYTE 21080015 LDFIL EQU X'10' LOAD FILE REQUIRED 21120015 DECK EQU X'08' PUNCHED DECK REQUIRED 21160015 LISTFL EQU X'20' 21200015 TXTSZ EQU DICB+264 21240015 LOCK EQU DICB+274 21280015 ZCOMM EQU DICB+304 21320015 DICEXT EQU ZCOMM+48 ST EXTERNAL ITEM 21360015 DICET1 EQU ZCOMM+66 EAD OF ET1 CHAIN 21400015 STATH EQU ZCOMM+72 EAD OF STATIC CHAIN 21440015 CONPOL EQU ZCOMM+2 ST BLOCK OF CONSTANTS POOL 21480015 CONHD EQU ZCOMM+78 21520015 ZEQTAB EQU ZCOMM+32 21560015 EJECT 21600015 DC C'UC' 21640015 BC B,UCINIT 21680015 BC B,UCUPDT 21720015 BC B,TIDY 21760015 BC B,STRAD1 21800015 BC B,UC0080 21840015 BC B,UA100 21880015 BC B,UA220 21920015 BC B,UA225 21960015 BC B,PRNTHD 22000015 SINGLE BC B,ONELST 22040015 BC B,TWOLST 22080015 BC B,RUNOUT 22120015 BC B,TASK 22160015 BC B,EVENT 22200015 BC B,AREA 22240015 BC B,TSKRLD 22280015 BC B,UA0215 22320015 BC B,UA100A 22360015 BC B,DSAS 22400015 EJECT 22440015 * ARAYDE IS USED TO HOLD THE ARRAY DICTIONARY 22480015 * ENTRY. IT IS 90 BYTES LONG WHICH IS THE 22520015 * MAXIMUM SIZE FOR A DICTIONARY ENTRY. 22560015 SPACE 2 22600015 ARAYDE DC 90X'00' 22640015 EJECT 22680015 * 22720015 * THIS ROUTINE EXAMINES ENTRIES FOR STATIC INITIAL ARRAYS 22760015 * AND TRANSFERS DATA FROM THE INITIAL VALUE STRING TO THE 22800015 * LOAD FILE OR DECK. 22840015 * THE ROUTINE IS PASSED DEAR, THE POINTER TO THE 22880015 * DICTIONARY ENTRY FOR THE INITIAL ARRAY 22920015 * 22960015 SPACE 10 23000015 * 23040015 * A TEST IS MADE FOR A BIT ARRAY, AND BITFLG IS SET ON OR 23080015 * OFF. FOR BIT ARRAYS, A FURTHER TEST IS MADE FOR THE PACKED 23120015 * ATTRIBUTE FOR WHICH BITPCK IS SET. 23160015 * 23200015 UCINIT MVC ARRDR(2),LOCK 23240015 TM DATDAT(DEAR),CHARST 23280015 BC BZ,UCINT1 23320015 NI BITFLG,X'00' 23360015 NI BITPCK,X'00' 23400015 BC B,UCINT2 23440015 UCINT1 OI BITFLG,X'80' 23480015 TM DATDAT(DEAR),FL3 23520015 BC BZ,UCINT3 23560015 NI BITPCK,X'00' 23600015 BC B,UCINT2 23640015 UCINT3 OI BITPCK,X'80' 23680015 SPACE 5 23720015 * 23760015 * THE OFFSET OF THE DIMENSION TABLE IS FOUND 23800015 * 23840015 UCINT2 LA WR8,DATOF2(DEAR) 23880015 * 23920015 * UPDATE IF THE OFFSET 2 SLOT IS PRESENT 23960015 * 24000015 TM DATVAR(DEAR),OF2FL 24040015 BC BZ,UCINT4 24080015 LA WR8,4(WR8) 24120015 UCINT4 LR WR6,WR8 24160015 * 24200015 * WR6 CONTAINS THE ADDRESS OF THE DIMENSION TABLE SLOT. 24240015 * 24280015 * UPDATE IF THE STRUCTURE SLOT IS PRESENT 24320015 * 24360015 TM DATVAR(DEAR),STRFL 24400015 BC BO,UCINT5 24440015 LA WR8,3(WR8) 24480015 BC B,UCINT6 24520015 UCINT5 LA WR8,13(WR8) 24560015 * 24600015 * WR8 POINTS TO THE INITIAL VALUE SLOT. 24640015 * 24680015 * TEST FOR A 'F0' INITIALISATION BYTE. 24720015 * 24760015 UCINT6 CLI 3(WR8),X'F0' 24800015 BC BNE,UCWYUT 24840015 SPACE 5 24880015 * 24920015 * AT THIS POINT THE ARRAY ENTRY IS MOVED TO A DUMMY SLOT 24960015 * AND LATER ON DEAR IS POINTED TO THIS DUMMY 25000015 * 25040015 MVC ARAYDE(90),0(DEAR) 25080015 LA DEAR,ARAYDE 25120015 SPACE 5 25160015 * 25200015 * WR1 IS SET TO POINT TO THE DIMENSION TABLE AND 25240015 * WR9 IS SET TO POINT TO THE INITIAL VALUE STRING. 25280015 * 25320015 LR WR1,WR6 25360015 MVC PAR1+2(2),1(WR1) 25400015 L LR,ZDRFAB 25440015 BALR RR,LR 25480015 L WR1,PAR1 25520015 SPACE 1 25560015 MVC PAR1+2(2),0(WR8) 25600015 BALR RR,LR 25640015 L WR9,PAR1 25680015 * 25720015 * THE ARRAY DR IS SAVED AND THE STRING IS LOCKED IN. 25760015 * 25800015 MVC LOCK(2),0(WR8) 25840015 SPACE 5 25880015 * 25920015 * THE STATIC OFFSET OF THE FIRST ELEMENT IS CALCULATED 25960015 * IN WR2, IN BITS FOR A BIT ARRAY, OTHERWISE IN BYTES 26000015 * FOR INTERLEAVED ARRAYS, A TABLE IS SET UP FOR ELEMENT 26040015 * ADDRESS CALCULATION. 26080015 * THE VIRTUAL ORIGIN OF BIT ARRAYS IS FIRST CONVERTED TO 26120015 * A BIT ADDRESS 26160015 * 26200015 * WR1 IS USED TO INDEX THE LOW AND HIGH BOUNDS 26240015 * WR8 IS USED AS A LOOP COUNT 26280015 * RR IS USED TO INDEX THE DIMENSION TABLE MULTIPLIERS 26320015 * LR IS USED TO INDEX THE STRUCTURE TABLE MULTIPLIERS 26360015 * 26400015 TM DATOT2(DEAR),EXTFL 26440015 BC BZ,UCINTX 26480015 L WR2,8(WR1) 26520015 BC B,UCINTY 26560015 UCINTX MVC VOST(1),DATOF2(DEAR) 26600015 MVC VOST+1(3),DATOFS(DEAR) 26640015 L WR2,VOST 26680015 UCINTY LR WR3,WR2 26720015 N WR2,ADMSK 26760015 TM DATOT3(DEAR),VONEG 26800015 BC BZ,UCINTZ 26840015 LCR WR2,WR2 26880015 N WR2,ADMSK 26920015 UCINTZ TM BITFLG,TSTBIT 26960015 BC BZ,UCIN7A 27000015 SLDL WR2,3 27040015 SPACE 2 27080015 UCIN7A EQU * 27120015 TM 0(DEAR),DIMSTR 27160015 BC BNO,UCINT7 27200015 SPACE 27240015 L WR7,ZEQTAB 27280015 SR LR,LR 27320015 IC LR,5(WR1) 27360015 STH LR,NODIMS 27400015 AR LR,LR 27440015 AR LR,LR 27480015 SPACE 27520015 LA RR,0(LR,LR) 27560015 LA LR,4(LR,RR) 27600015 C LR,K256 27640015 BC BNH,UCINT8 27680015 SPACE 27720015 MVC 64(256,WR7),8(WR1) 27760015 LA WR7,256(WR7) 27800015 LA WR1,256(WR1) 27840015 S LR,K256 27880015 SPACE 27920015 UCINT8 BCTR LR,0 27960015 STC LR,UCINT9+1 28000015 SPACE 28040015 UCINT9 MVC 64(1,WR7),8(WR1) 28080015 L WR7,ZEQTAB 28120015 LH LR,NODIMS 28160015 SPACE 28200015 UCINTB MVC 68(2,WR7),70(WR7) 28240015 LA WR7,8(WR7) 28280015 BCT LR,UCINTB 28320015 ST WR2,FRSTSO 28360015 MVI FSTFLG,ON SET FLAG FOR FIRST TIME 52181 28380064 BC B,UCINTA 28400015 SPACE 28440015 UCINT7 SR RR,RR 28480015 IC RR,5(WR1) 28520015 SLA RR,3 28560015 LA LR,12(WR1) 28600015 LA RR,0(RR,LR) 28640015 SR WR6,WR6 28680015 IC WR6,5(WR1) 28720015 UCINTC L WR7,0(RR) 28760015 MH WR7,2(LR) 28800015 AR WR2,WR7 28840015 LA RR,4(RR) 28880015 LA LR,8(LR) 28920015 BCT WR6,UCINTC 28960015 UCINTA EQU * 29000015 SPACE 10 29040015 * 29080015 * THE FOLLOWING CODE SCANS THE INITIAL VALUE TABLE AND 29120015 * PRODUCES THE OUTPUT TEXT FOR THE ARRAY. 29160015 SPACE 2 29200015 * BASIC LOOP INITIALISATION IS DONE. 29240015 * 29280015 NI INIT,X'00' 29320015 MVC ELMLTH(2),4(WR9) 29360015 MVC NOELMS(4),ZEROS4 29400015 MVC NOELMS+1(3),6(WR9) 29440015 * 29480015 * BIT STRING ARRAYS ARE EXAMINED TO SEE WHETHER THEY 29520015 * MAY BE PROCESSED IN THE SIMPLER CHARACTER STRING FASHION. 29560015 * 29600015 TM BITFLG,TSTBIT 29640015 BC BZ,UCUPDT 29680015 TM BITPCK,PACKK 29720015 BC BO,UCST01 29760015 * 29800015 * FOR ALIGNED BIT ARRAYS, THE STRING LENGTH IS REDUCED TO 29840015 * CEIL(MAX. LENGTH/8) 29880015 * 29920015 UCSTO3 LH WR1,ELMLTH 29960015 LA WR1,7(WR1) 30000015 SRA WR1,3 30040015 STH WR1,ELMLTH 30080015 SRA WR2,3 30120015 BC B,UCUPDT 30160015 * 30200015 * FOR A PACKED ARRAY, PROCESSING IS ALTERED TO THE 30240015 * CHARACTER STRING FORM IF THE STATIC OFFSET OF THE FIRST 30280015 * ELEMENT IS ON A BYTE BOUNDARY, AND IF THE MAXIMUM LENGTH 30320015 * IS A MULTIPLE OF 8. 30360015 * 30400015 UCST01 TM 0(DEAR),DIMSTR 30440015 BC BO,UCUPDT BRANCH IF ARRAY IS IN STRUCTURE 30480015 SPACE 30520015 ST WR2,FWORD 30560015 TM FWORD+3,MLTPL8 30600015 BC BNZ,UCST06 30640015 TM ELMLTH+1,MLTPL8 30680015 BC BNZ,UCST06 30720015 NI BITPCK,X'00' 30760015 BC B,UCSTO3 30800015 * 30840015 * A PACKED ARRAY HAS BEEN FOUND. N (THE COUNT OF BITS 30880015 * PUT INTO WR6) AND OUTPTR ((STATIC OFFSET - N)/8) ARE SET. 30920015 * 30960015 UCST06 SRDL WR2,3 31000015 SRL WR3,29 31040015 ST WR2,OUTPTR 31080015 STH WR3,N 31120015 SLL WR3,29 31160015 SLDL WR2,3 31200015 XR WR6,WR6 31240015 SPACE 2 31280015 UCUPDT LA WR9,9(WR9) 31320015 SPACE 10 31360015 * 31400015 * A TEST IS MADE FOR AN INITIALIZATION MARKER. 31440015 * THE CODE BYTE IS X'00' 31480015 * 31520015 UC0001 CLI 0(WR9),X'00' 31560015 BC BNE,UC0301 31600015 OI INIT,X'80' SET INIT ON 31640015 * 31680015 * THE REPLICATION FACTOR IS OBTAINED, ITS SIGN IS CHECKED 31720015 * AND NO INITIALIZATION TAKES PLACE IF IT IS NOT POSITIVE. 31760015 * THE ELEMENT COUNT IS DECREMENTED AND STORED 31800015 * THE REPLICATION FACTOR IS STORED IN WR1. 31840015 * 31880015 UC0002 MVC FWORD(4),1(WR9) 31920015 L WR1,FWORD 31960015 LTR WR1,WR1 32000015 BC BNH,UCUPDT 32040015 TM FLAG,DVFL1 32080015 BC BO,DVRETU 32120015 L WR3,NOELMS 32160015 SR WR3,WR1 32200015 ST WR3,NOELMS 32240015 AR WR3,WR1 32280015 CR WR3,WR1 32320015 BC BH,UC0010 32360015 LR WR1,WR3 32400015 SPACE 32440015 * 32480015 * THE INITIAL DATA IS LOCATED AND THE POINTER TO IT IS 32520015 * STORED IN DPKEEP. 32560015 * 32600015 MVC PAR1+2(2),7(WR9) 32640015 UC0010 MVC PAR1+2(2),7(WR9) 32680015 L LR,ZDRFAB 32720015 BALR RR,LR 32760015 MVC DPKEEP(4),PAR1 32800015 * 32840015 * THE INITIAL VALUE TABLE POINTER IS SAVED 32880015 * 32920015 ST WR9,KEEPR9 32960015 * 33000015 * THE INITIALIZING LOOP FOLLOWS. 33040015 * 33080015 UC0090 L PR1,DPKEEP 33120015 LH PR2,ELMLTH 33160015 TM 0(DEAR),DIMSTR 33200015 BC BO,UC0020 BRANCH IF STRUCTURED ARRAY 33240015 ST WR2,TEM1 33280015 AH WR2,ELMLTH 33320015 BC B,UC0025 33360015 UC0020 BAL RR,STRAD1 33400015 ST WR2,TEM1 33440015 * 33480015 * FOR NON PACKED ARRAYS, TXTMOV IS INVOKED WITHOUT FURTHER 33520015 * DELAY. 33560015 * 33600015 UC0025 TM BITPCK,PACKK 33640015 BC BO,UC0030 33680015 BAL RR,TXTMOV 33720015 BC B,UC0036 33760015 * 33800015 * INITIAL DATA FOR PACKED ARRAYS IS PUT OUT BY MEANS OF A 33840015 * LOOP. THE INITIALIZATION FOR THIS FOLLOWS. 33880015 * WR9 CONTAINS THE DATA POINTER AND WR3 CONTAINS THE REMAINING 33920015 * LENGTH. 33960015 * 34000015 UC0030 L WR9,DPKEEP 34040015 LH WR3,ELMLTH 34080015 BAL RR,UC0080 34120015 SPACE 34160015 TM 0(DEAR),DIMSTR 34200015 BC BNO,UC0036 34240015 TM BITPCK,PACKK 34280015 BC BZ,UC0036 34320015 MVC ADJUST(4),CNST32 34360015 BAL RR,TIDY 34400015 SPACE 34440015 OI INIT,X'80' RESET THE INITIALISATION FLAG 34480015 SPACE 34520015 * 34560015 * THE MAIN LOOP COUNT IS REDUCED AND TESTED FOR ZERO, IF 34600015 * NOT, THE LOOP IS REPEATED. 34640015 * 34680015 UC0036 BCT WR1,UC0090 34720015 * 34760015 * IF ELEMENTS ARE STILL TO BE INITIALIZED THEN A BRANCH 34800015 * IS TAKEN TO THE UPDATE ROUTINE. OTHERWISE THE EXIT IS TAKEN 34840015 * 34880015 L WR9,KEEPR9 34920015 L WR1,NOELMS 34960015 C WR1,ZEROS4 35000015 BC BH,UCUPDT 35040015 SPACE 35080015 * ALL OF THE ARRAY ELEMENTS HAVE BEEN PROCESSED , 35120015 * NOW CHECK IF ANY INITIALISATION IS LEFT. 35160015 SPACE 35200015 UCERR1 CLC NOELMS(4),ZEROS4 35240015 BC BNE,UCERR2 35280015 SPACE 35320015 UCERR3 LA WR9,9(WR9) 35360015 CLI 0(WR9),X'FF' 35400015 BC BE,UCFF10 35440015 CLI 0(WR9),X'3F' 35480015 BC BE,UCERR4 35520015 CLI 0(WR9),X'CF' 35560015 BC BNE,UCERR2 35600015 MVC PAR1+2(2),1(WR9) 35640015 L LR,ZDRFAB 35680015 BALR RR,LR 35720015 L WR9,PAR1 35760015 BC B,UCERR3 35800015 SPACE 35840015 UCERR4 MVC PAR1+2(2),1(WR9) 35880015 MVC FWORD(2),3(WR9) SAVE OFFSET 35920015 L LR,ZDRFAB 35960015 BALR RR,LR 36000015 L LR,PAR1 36040015 AH LR,FWORD LOCATE CORRESPONDING '0F' ITEM 36080015 CLC K1(4),5(LR) 36120015 BC BNE,UCERR2 36160015 BC B,UCERR3 36200015 SPACE 36240015 UCERR2 MVC PAR6+1(3),TOOMNY 36280015 MVC PAR7+2(2),ARRDR 36320015 L LR,ZUERR 36360015 BALR RR,LR 36400015 BC B,UCFF10 36440015 SPACE 2 36480015 TOOMNY DC X'0B541C' 36520015 SPACE 10 36560015 * 36600015 * A TEST IS MADE FOR A NO INITIALIZATION MARKER. THE 36640015 * CODE BYTE IS X'03' 36680015 * 36720015 UC0301 CLI 0(WR9),X'03' 36760015 BC BNE,UC0F01 BRANCH IF CODE IS NOT X'03' 36800015 MVC FWORD(4),1(WR9) 36840015 L WR1,FWORD REP FACTOR IN WR1 36880015 L WR3,NOELMS NO. ELEMENTS IN WR3 36920015 LTR WR1,WR1 36960015 BC BNH,UCUPDT 37000015 SR WR3,WR1 37040015 ST WR3,NOELMS 37080015 SPACE 37120015 * AT THIS POINT DVFL1 IS TESTED 37160015 SPACE 37200015 TM FLAG,DVFL1 37240015 BC BO,DVRETU 37280015 LTR WR3,WR3 37320015 BC BNH,UCERR1 37360015 SPACE 37400015 * AT THIS POINT 0(DEAR) IS TESTED FOR ARRAY IN PACKED 37440015 * STRUCTURE 37480015 SPACE 37520015 TM 0(DEAR),DIMSTR 37560015 BC BNO,UC0310 37600015 UC0320 BAL RR,STRAD1 37640015 BCT WR1,UC0320 37680015 BC B,UCUPDT 37720015 SPACE 37760015 UC0310 MH WR1,ELMLTH 37800015 AR WR2,WR1 37840015 TM BITPCK,PACKK 37880015 BC BZ,UCUPDT 37920015 ST WR1,ADJUST 37960015 LA RR,UCUPDT 38000015 BC B,TIDY 38040015 SPACE 10 38080015 * 38120015 * A TEST IS MADE FOR A GROUP HEADER. THE CODE 38160015 * BYTE IS X'0F' 38200015 * 38240015 UC0F01 CLI 0(WR9),X'0F' 38280015 BC BNE,UC3F01 BRANCH IF CODE IS NOT X'3F' 38320015 MVC FWORD(4),1(WR9) TEST FOR A NON POSITIVE REP 38360015 L WR3,FWORD FACTOR AND BRANCH IF ONE 38400015 C WR3,ZEROS4 IS FOUND 38440015 BC BNH,UC0F10 38480015 MVC 5(4,WR9),1(WR9) SHIFT COUNT AND BRANCH TO UPDATE 38520015 BC B,UCUPDT TO NEXT ENTRY 38560015 UC0F10 LA WR3,1 SET WR3 TO 1 38600015 UC0F15 LA WR9,9(WR9) UPDATE WR9 TO NEXT ENTRY 38640015 CLI 0(WR9),X'0F' TEST FOR GROUP HEADER 38680015 BC BNE,UC0F20 38720015 LA WR3,1(WR3) INCREMENT WR3 38760015 BC B,UC0F15 38800015 UC0F20 CLI 0(WR9),X'3F' TEST FOR END OF GROUP 38840015 BC BNE,UC0F25 38880015 BCT WR3,UC0F15 DECREMENT WR3. END OF GROUP 38920015 BC B,UCUPDT FOUND IF WR3 IS ZERO 38960015 UC0F25 CLI 0(WR9),X'CF' TEST FOR END OF BLOCK 39000015 BC BNE,UC0F15 39040015 MVC PAR1+2(2),1(WR9) 39080015 L LR,ZDRFAB OBTAIN NEW BLOCK AND LOCK IN 39120015 BALR RR,LR CORE 39160015 TM FLAG,DVFL1 39200015 BC BO,UC0F30 39240015 MVC LOCK(2),1(WR9) 39280015 UC0F30 L WR9,PAR1 39320015 BC B,UC0F15 39360015 SPACE 10 39400015 * 39440015 * A TEST IS MADE FOR AN END OF GROUP MARKER. THE CODE 39480015 * BYTE IS X'3F' 39520015 * 39560015 UC3F01 CLI 0(WR9),X'3F' 39600015 BC BNE,UCCF01 BRANCH IF CODE IS NOT X'3F' 39640015 ST WR9,KEEPR9 SAVE WR9 39680015 MVC PAR1+2(2),1(WR9) 39720015 MVC FWORD(2),3(WR9) SAVE OFFSET 39760015 L LR,ZDRFAB LOCATE GROUP HEADER 39800015 BALR RR,LR 39840015 L WR9,PAR1 39880015 AH WR9,FWORD LOCATE CORRESPONDING '0F' ITEM 39920015 MVC FWORD(4),5(WR9) 39960015 L WR3,FWORD REDUCE CURRENT COUNT BY ONE AND 40000015 BCT WR3,UC3F10 TEST FOR ZERO 40040015 L WR9,KEEPR9 RESET WR9 IF ZERO COUNT 40080015 BC B,UCUPDT 40120015 UC3F10 ST WR3,FWORD 40160015 MVC 5(4,WR9),FWORD 40200015 L WR3,KEEPR9 40240015 TM FLAG,DVFL1 40280015 BC BO,UCUPDT 40320015 MVC LOCK(2),1(WR3) LOCK NEW BLOCK IN CORE 40360015 BC B,UCUPDT 40400015 SPACE 10 40440015 * 40480015 * A TEST IS MADE FOR THE END OF A BLOCK. THE CODE BYTE 40520015 * IS X'CF' 40560015 * 40600015 UCCF01 CLI 0(WR9),X'CF' 40640015 BC BNE,UCFF01 BRANCH IF CODE IS NOT X'CF' 40680015 * 40720015 * THE NEW BLOCK IS OBTAINED AND IS LOCKED IN CORE 40760015 * AGAINST SPILLING. THE BLOCK POINTER IS SAVED. 40800015 * 40840015 MVC PAR1+2(2),1(WR9) 40880015 L LR,ZDRFAB 40920015 BALR RR,LR 40960015 TM FLAG,DVFL1 41000015 BC BO,UCCF10 41040015 MVC LOCK(2),1(WR9) 41080015 UCCF10 L WR9,PAR1 41120015 BC B,UCUPDT 41160015 SPACE 10 41200015 * 41240015 * A TEST IS MADE FOR THE END OF LIST MARKER. THE 41280015 * CODE BYTE IS X'FF'. 41320015 * THIS SECTION OF CODING IS ALSO THE EXIT FROM THE 41360015 * INITIALIZATION AND NON-INITIALIZATION ROUTINES 41400015 * 41440015 UCFF01 CLI 0(WR9),X'FF' 41480015 BC BNE,UCER01 BRANCH IF CODE BYTE IS NOT X'FF' 41520015 SPACE 41560015 * 41600015 * TEST FOR DOPE VECTOR INITIALISATION 41640015 * 41680015 SPACE 41720015 TM FLAG,DVFL1 41760015 BC BO,DVRETU 41800015 SPACE 41840015 C WR1,ZEROS4 41880015 BC BE,UCFF10 41920015 MVC PAR6+1(3),TOOFEW 41960015 MVC PAR7+2(2),ARRDR 42000015 L LR,ZUERR 42040015 BALR RR,LR 42080015 BC B,UCFF10 42120015 SPACE 2 42160015 TOOFEW DC X'0B531C' 42200015 SPACE 2 42240015 UCFF10 TM BITPCK,PACKK 42280015 BC BZ,UCFF15 BRANCH IF NOT PACKED ARRAY 42320015 TM FLAG,DVFL1 42360015 BC BO,DVRETU 42400015 TM INIT,ONON 42440015 BC BZ,UCFF15 BRANCH IF INIT IS OFF 42480015 TM 0(DEAR),DIMSTR BRANCH IF STRUCTURED ARRAY 42520015 BC BO,UCFF15 42560015 LH WR1,N 42600015 C WR1,ZEROS4 IS N ZERO 42640015 BC BE,UCFF15 42680015 MVC ADJUST(4),CNST32 42720015 BAL RR,TIDY 42760015 UCFF15 MVC OLD(4),ZEROS4 42800015 SPACE 10 42840015 * 42880015 * RETURN CONTROL TO THE MAIN ROUTINE IN UA. 42920015 * 42960015 UCWYUT TM 0(DEAR),X'20' 43000015 BC BO,UA0413 43040015 TM DATOT2(DEAR),EXTFL 43080015 BC BZ,UA0345 43120015 BC B,UA105 43160015 SPACE 10 43200015 *********************************************************************** 43240015 * 43280015 * AN INVALID CODE BYTE HAS BEEN FOUND. A STOP IS PUT IN 43320015 * TO FORCE AN ABNORMAL END DUMP. 43360015 * 43400015 * THIS POINT SHOULD NEVER BE REACHED 43440015 * 43480015 UCER01 BAL RR,UA 43520015 * 43560015 *********************************************************************** 43600015 EJECT 43640015 * THIS SUBROUTINE TAKES CARE OF THE RESETTING OF 43680015 * OUTPTR, N AND WR6 IN THREE CASES. 43720015 * 1/ ELMLTH IS NOT EQUAL TO TEMLTH 43760015 * 2/ NON INITIALIZATION 43800015 * 3/ FINAL OUTPUT FROM WR6 43840015 SPACE 5 43880015 TIDY ST RR,KEEPRR 43920015 STM WR8,WR9,DOUBLE 43960015 L WR8,ADJUST 44000015 AH WR8,N 44040015 C WR8,CNST32 44080015 BC BL,UCSHNT 44120015 SPACE 5 44160015 * WHEN THE ADJUSTMENT IS 32 BITS OR MORE, WR6 IS PUT OUT 44200015 * AND N AND OUTPTR ARE RESET. 44240015 SPACE 5 44280015 * 44320015 * IF INIT IS OFF A BRANCH IS MADE TO RESET N AND OUTPTR 44360015 * OTHERWISE INIT IS SET OFF 44400015 * 44440015 TM INIT,ONON 44480015 BC BZ,UCOVER 44520015 NI INIT,X'00' 44560015 * 44600015 * SHIFT THE CONTENTS OF WR6 44640015 * 44680015 L WR8,CNST32 44720015 SH WR8,N 44760015 STC WR8,INSTR3+3 44800015 INSTR3 SLL WR6,0 44840015 * 44880015 * PUT OUT THE CONTENTS OF WR6 44920015 * 44960015 ST WR6,FWORD 45000015 LA PR1,FWORD 45040015 LH PR2,N 45080015 LA PR2,7(PR2) 45120015 SRA PR2,3 45160015 MVC TEM1(4),OUTPTR 45200015 BAL RR,TXTMOV 45240015 * 45280015 * RESET N AND OUTPTR 45320015 * 45360015 UCOVER SRDL WR2,3 45400015 SRL WR3,29 45440015 ST WR2,OUTPTR 45480015 STH WR3,N 45520015 SLL WR3,29 45560015 SLDL WR2,3 45600015 XR WR6,WR6 45640015 BC B,RETURN 45680015 SPACE 5 45720015 * THE CONTENTS OF WR6 ARE SHIFTED BY THE AMOUNT OF THE 45760015 * ADJUSTMENT AND N IS RESET. 45800015 SPACE 5 45840015 UCSHNT STH WR8,N 45880015 MVC INSTR4+3(1),ADJUST+3 45920015 INSTR4 SLL WR6,0 45960015 SPACE 5 46000015 RETURN LM WR8,WR9,DOUBLE 46040015 L RR,KEEPRR 46080015 BCR B,RR 46120015 EJECT 46160015 * THIS ROUTINE CALCULATES THE ADDRESSES OF ELEMENTS 46200015 * IN STRUCTURED ARRAYS 46240015 * 46280015 * STRAD1 REQUIRES - 46320015 * ECOUNT A FULL WORD ELEMENT INDEX CONTAINING N WHEN IT 46360015 * REFERS TO THE N+1 TH ELEMENT 46400015 * FRSTSO A FULL WORD CONTAINING THE STATIC OFFSET OF THE 46440015 * FIRST ELEMENT 46480015 * SCRCOR A FULL WORD CONTAINING THE ADDRESS OF SCRATCH CORE 46520015 * THE MODIFIED DIMENSION TABLE IS OFFSET BY 512 BYTES 46560015 * IN THE SCRATCH CORE 46600015 * 46640015 * STRAD1 RETURNS - 46680015 * WR2 REGISTER 2 CONTAINING THE STATIC OFFSET FOR AN 46720015 * ELEMENT IN A BYTE ARRAY 46760015 * OR OUTPTR A FULL WORD CONTAINING THE STATIC OFFSET IN BYTES 46800015 * AND N A HALF WORD CONTAINING THE BIT OFFSET FOR ELEMENTS 46840015 * IN BIT ARRAYS 46880015 SPACE 2 46920015 * REGISTERS USED ARE - 46960015 * WR6 REG 0 HOLDS THE NUMBER OF DIMENSIONS 47000015 * WR7 REG 1 HOLDS THE ELEMENT INDEX 47040015 * WR2 REG 2 HOLDS THE STATIC OFFSET AS IT IS CALCULATED 47080015 * WR3 REG 3 IS USED TO SET OUTPTR AND N 47120015 * WR1 REG 5 INDEXES THE DIMENSION TABLE 47160015 * 47200015 * WR1 MUST BE SAVED AND RESTORED 47240015 * WR6 MUST BE CLEARED BEFORE RETURNING 47280015 SPACE 5 47320015 STRAD1 EQU * 47360015 ST WR1,PAR1 47400015 LH LR,NODIMS 47440015 L WR2,FRSTSO 47480015 LR WR3,LR 47520015 SLA WR3,3 47560015 L WR1,ZEQTAB 47600015 LA WR3,0(WR1,WR3) 47640015 STR002 L WR7,68(WR3) 47680015 MH WR7,68(WR1) 47720015 AR WR2,WR7 47760015 LA WR1,8(WR1) 47800015 LA WR3,4(WR3) 47840015 BCT LR,STR002 47880015 LH LR,NODIMS 47920015 LR WR1,LR 47960015 SLA WR1,3 48000015 A WR1,ZEQTAB 48040015 STR004 LH WR7,60(WR1) 48080015 A WR7,K1 48120015 STH WR7,60(WR1) 48160015 CH WR7,66(WR1) 48200015 BC BNH,STR003 48240015 MVC 60(2,WR1),62(WR1) 48280015 S WR1,K8 48320015 BCT LR,STR004 48360015 STR003 L WR1,PAR1 48400015 SPACE 48440015 TM BITFLG,TSTBIT 48480015 BC BNO,RR1 RETURN IF NOT BIT ARRAY 52181 48520064 SRDL WR2,3 48560015 TM BITPCK,PACKK 48600015 BC BNO,RR1 RETURN IF NOT PACKED ARRAY 52181 48640064 SPACE 48680015 SRL WR3,29 48720015 ST WR2,OUTPTR 48760015 STH WR3,N 48800015 SLL WR3,29 48840015 SLDL WR2,3 48880015 SPACE 48920015 XR WR6,WR6 48960015 CLI FSTFLG,ON TEST IF 1ST ITEM WITH INIT 52181 48968064 MVI FSTFLG,OFF RESET FLAG 52181 48976064 BC BNE,RR2 RETURN IF NOT 52181 48984064 MVC FSTEL(4),OUTPTR SET UP FSTEL 52181 48992064 SPACE 49000015 BCR B,RR 49040015 RR1 CLI FSTFLG,ON TEST IF 1ST ITEM WITH INIT 52181 49046064 MVI FSTFLG,OFF RESET FLAG 52181 49052064 BC BNE,RR2 RETURN IF NOT 52181 49058064 ST WR2,FSTEL SET UP FSTEL 52181 49064064 RR2 BCR B,RR 52181 49070064 EJECT 49080015 * THIS ROUTINE PACKS BIT STRINGS FOR SCALARS AND FOR 49120015 * ARRAYS EITHER ON THEIR OWN OR IN STRUCTURES 49160015 SPACE 5 49200015 UC0080 ST RR,SAVERR 49240015 UC0081 LTR WR3,WR3 49280015 BC BNH,UC0035 49320015 C WR3,CNST32 49360015 BC BNH,UC0040 49400015 L WR8,CNST32 49440015 BC B,UC0045 49480015 UC0040 LR WR8,WR3 49520015 UC0045 MVC FWORD(4),0(WR9) 49560015 L WR7,FWORD 49600015 * 49640015 * THE DATA OF INTEREST CONSISTS OF THE N JUNIOR BITS OF 49680015 * WR6 AND THE SENIOR M = C(WR8) BITS OF WR7. 49720015 * THE REGISTER PAIR IS SHIFTED LEFT UNTIL NO BITS REMAIN IN WR7. 49760015 * 49800015 STH WR8,M 49840015 AH WR8,N 49880015 C WR8,CNST32 49920015 BC BH,UC0050 49960015 BC BE,UC0060 50000015 * 50040015 * CASE 1 N + M IS LESS THAN 32. A STRAIGHT SHIFT OF M PLACES 50080015 * IS DONE AND N IS PUT EQUAL TO M + N 50120015 * 50160015 MVC UC0055+3(1),M+1 50200015 UC0055 SLDL WR6,0 50240015 STH WR8,N 50280015 BC B,UC0075 50320015 * 50360015 * CASE 2 N + M IS EQUAL TO 32. A SHIFT OF M PLACES IS DONE, 50400015 * C(WR6) PUT OUT, OUTPTR INCREMENTED AND N SET TO 0. 50440015 * 50480015 UC0060 MVC UC0056+3(1),M+1 50520015 UC0056 SLDL WR6,0 50560015 ST WR9,SAVER9 50600015 ST WR6,FWORD 50640015 LA PR1,FWORD 50680015 L PR2,CONST4 50720015 MVC TEM1(4),OUTPTR 50760015 BAL RR,TXTMOV 50800015 L PR2,OUTPTR 50840015 A PR2,CONST4 50880015 ST PR2,OUTPTR 50920015 L WR9,SAVER9 50960015 MVC N(2),ZEROS4 51000015 BC B,UC0075 51040015 * 51080015 * CASE 3 N + M IS GREATER THAN 32. THE REGISTER PAIR IS 51120015 * SHIFTED (32-N) PLACES. THE CONTENTS OF WR6 ARE PUT 51160015 * OUT AND THEN THE REGISTER PAIR IS SHIFTED 51200015 * (M-N+32) PLACES 51240015 * 51280015 UC0050 L WR8,CNST32 51320015 SH WR8,N 51360015 STH WR8,N 51400015 STC WR8,UC0065+3 51440015 UC0065 SLDL WR6,0 51480015 ST WR9,SAVER9 51520015 ST WR6,FWORD 51560015 LA PR1,FWORD 51600015 L PR2,CONST4 51640015 MVC TEM1(4),OUTPTR 51680015 ST WR7,KEEPR1 51720015 BAL RR,TXTMOV 51760015 L WR7,KEEPR1 51800015 L PR2,OUTPTR 51840015 A PR2,CONST4 51880015 ST PR2,OUTPTR 51920015 L WR9,SAVER9 51960015 LH WR8,M 52000015 SH WR8,N 52040015 STH WR8,N 52080015 STC WR8,UC0085+3 52120015 UC0085 SLDL WR6,0 52160015 * 52200015 * THE DATA POINTER IS BUMPED BY 4 AND THE REMAINING 52240015 * LENGTH COUNT IS REDUCED BY 32. 52280015 * 52320015 UC0075 LA WR9,4(WR9) 52360015 S WR3,CNST32 52400015 BC B,UC0081 52440015 UC0035 L RR,SAVERR 52480015 BCR B,RR 52520015 EJECT 52560015 * IHEMAIN ROUTINE 52600015 * 52640015 * 52680015 * 52720015 * FUNCTION/OPERATION 52760015 * (1) MAKES UP TEXT FOR 1-WORD CSECT (IHEMAIN) WHICH 52800015 * CONTAINS THE ADDRESS OF THE PRINCIPAL ENTRY POINT TO THE 52840015 * COMPILATION (ONLY IF THE EXTERNAL PROCEDURE HAD THE MAIN 52880015 * OPTION). 52920015 * 52960015 * 53000015 * 53040015 * ENTRY POINTS-UA100 FROM ANYWHERE THAT THE END OF THE 53080015 * END OF THE STATIC CHAIN CAN BE FOUND 53120015 * 53160015 * 53200015 * 53240015 * EXTERNAL ROUTINES 53280015 * (1) TXTMOV MOVES TXT TO A CARD BUFFER 53320015 * (2) RLDMOV MOVES RLD ENTRIES TO A CARD BUFFER 53360015 * (3) OUTPUT WRITES OUT A PARTIALLY FILLED TXT CARD 53400015 * (4) UA3005 STRING DOPE VECTOR INITIALISATION ROUTINE 53440015 * (5) UA3205 ARRAY DOPE VECTOR INITIALISATION ROUTINE 53480015 * (6) UA3605 LABEL ARRAY DOPE VECTOR INITIALISATION 53520015 * ROUTINE 53560015 * (7) UA3655 STRUCTURE DOPE VECTOR INITIALISATION ROUTINE 53600015 * (8) UA205 SCALAR DATA VARIABLE INIT. ROUTINE 53640015 * (9) UA034 DATA ARRAY INIT ROUTINE 53680015 * (10) UA031 LABEL ARRAY INIT. ROUTINE 53720015 * (11) UA041 STRUCTURE INIT ROUTINE 53760015 * (12) UA4076 FILE INIT. ROUTINE 53800015 * 53840015 * 53880015 * 53920015 * EXITS NORMAL - UA120 IN UB TO TERMINATE PHASE 53960015 * 54000015 * 54040015 * 54080015 * EXITS ERROR - NONE 54120015 SPACE 3 54160015 SPACE 1 54200015 * NOW WRITE OUT THE LAST CARD FOR STATIC INTERNAL 54240015 * IF THERE IS ONE PARTIALLY FILLED 54280015 SPACE 2 54320015 UA100 CLC TXTSTO(4),K16 TEST IF CARD POINTER AT START 54360015 BC BE,UA1002 OF VARIABLE FIELD. IF SO THERE 54400015 * IS NO CARD TO WRITE OUT 54440015 L WR2,TXTSTO 54480015 S WR2,K16 54520015 STH WR2,TXTCD+10 54560015 BAL RR,OUTPUT 54600015 SPACE 2 54640015 UA1002 MVC PAR1+2(2),DICET1 54680015 L LR,ZDRFAB LOAD DEAR WITH ADDRESS OF ET1 54720015 BALR RR,LR FOR EXTERNAL PROCEDURE 54760015 L DEAR,PAR1 54800015 MVI FLAG,SEFL SET FLAG TO SAY STATIC INTERNAL 54840015 * HAS BEEN PUT OUT 54880015 SPACE 2 54920015 TM ET1OPT(DEAR),MAIN BRANCH IF NOT MAIN PROCEDURE 54960015 BC BZ,UA100X 55000015 SPACE 2 55040015 MVC TEM1+1(3),ZERO ADDR = 000000 55080015 XC TXTCD+14(2),TXTCD+14 55120015 MVI TXTCD+15,X'08' CSECT NO =8 55160015 SPACE 2 55200015 MVC PAR1+2(2),ET1EL(DEAR) NOW GET 1ST ENRY LABELFOR 55240015 L LR,ZDRFAB EXTERNAL PROCEDURE 55280015 BALR RR,LR 55320015 L DEAR,PAR1 ADDR OF 1ST LABEL 55360015 MVC TXTBUF+1(3),ELOFS(DEAR) MOVE OFFSET TOTXTBUF 55400015 MVI TXTBUF,X'00' 55440015 SPACE 2 55480015 LA PR1,TXTBUF 55520015 LA PR2,4 55560015 BAL RR,TXTMOV MOVE TXT TO CARD 55600015 SPACE 2 55640015 LA WR2,4 PUT OUT TXT FOR IHEMAIN 55680015 STH WR2,TXTCD+10 55720015 BAL RR,OUTPUT 55760015 SPACE 2 55800015 MVI RLDBUF+4,X'0C' SET CODE FOR 4 BYTE CONSTANT 55840015 XC RLDBUF+5(3),RLDBUF+5 ADDR = 000000 55880015 XC RLDBUF+2(2),RLDBUF+2 55920015 MVI RLDBUF+3,X'08' ESDID FOR IHEMAIN CSECT 55960015 MVC RLDBUF(2),K1+2 ESDID FOR PGM CSECT 56000015 BAL RR,RLDMOV 56040015 SPACE 2 56080015 MVI RLDBUF+1,X'0A' 56120015 MVI RLDBUF+3,X'09' 56160015 MVI TXTCD+15,X'09' ESDID FOR IHENTRY WITH MAIN 56200015 BC B,UA100X+12 56240015 SPACE 2 56280015 UA100X MVI RLDBUF+1,X'09' 56320015 MVI RLDBUF+3,X'08' 56360015 MVI TXTCD+15,X'08' ESDID FOR IHENTRY NO MAIN 56400015 SPACE 2 56440015 MVC TEM1+1(3),ZERO 56480015 MVI RLDBUF+4,X'0C' 56520015 SPACE 2 56560015 LA PR1,IHENTR 56600015 LA PR2,12 56640015 BAL RR,TXTMOV 56680015 SPACE 2 56720015 MVC RLDBUF+5(3),K8+1 56760015 BAL RR,RLDMOV 56800015 BC B,UA1005 56840015 SPACE 5 56880015 IHENTR DC X'58F0F00807FF000000000000' 56920015 EJECT 56960015 * LABEL BCD ROUTINE 57000015 * 57040015 * 57080015 * 57120015 * FUNCTION/OPERATION 57160015 * THIS ROUTINE MAKES UP TEXT CONTAINING THE BCD OF LABEL 57200015 * CONSTANTS AND LABEL VARIABLES. IT IS ENTERED DURING THE FIRST 57240015 * SCAN OF THE STATIC CHAIN WHEN A DICTIONARY ENTRY FOR A LABEL 57280015 * CONSTANT OR ENTRY LABEL IS FOUND, OR THE BCD ENTRY FOR A LABEL 57320015 * VARIABLE 57360015 * (1) FOR LABEL CONSTANTS AND ENTRY LABELS THE BCD IS 57400015 * PICKED UP DIRECT FROM ITS DICTIONARY ENTRY AND THE STATIC 57440015 * OFFSET FROM A LABEL BCD ENTRY CHAINED FROM THE LABEL ENTRY 57480015 * ITSELF. THE BCD IS ONLY REQUIRED IF THE LABEL APPEARS IN A 57520015 * CHECK LIST. 57560015 * (2) FOR LABEL VARIABLES THE BCD ENTRY ITSELF IS IN THE 57600015 * STATIC CHAIN IF THE VARIABLE NEEDS ITS BCD IN STATIC . THE BCD 57640015 * IS OBTAINED FROM THE LABEL VARIABLE ENTRY WHICH IS CHAINED 57680015 * FROM THE BCD 57720015 * 57760015 * THE BCD IS PRECEDED IN STATIC BY ITS LENGTH IN 1 BYTE 57800015 * 57840015 * 57880015 * 57920015 * ENTRY POINTS 57960015 * (1) UA220 FOR LABEL CONSTANTS AND ENTRY LABELS 58000015 * (2) UA225 FOR LABEL VARIABLES 58040015 * 58080015 * 58120015 * 58160015 * EXTERNAL ROUTINES 58200015 * (1) TXTMOV 58240015 * 58280015 * 58320015 * 58360015 * EXITS NORMAL UA0015 TO RESUME SCAN 58400015 * 58440015 * 58480015 * 58520015 * EXITS ERROR - NONE 58560015 SPACE 3 58600015 UA220 CLI CHAR1,X'00' IF FIRST ENTRY IN CHARACTER 58640015 BC BNE,UA221 SECTION STORE REFERENCE OF ENTRY 58680015 MVC CHAR1(2),LOCK 58720015 SPACE 1 58760015 UA221 CLI 0(DEAR),X'C3' 58800015 BC BE,UA0015 58840015 TM DATOT1(DEAR),CHECK TEST IF LABEL APPEARS IN CHECK 58880015 BC BZ,UA0015 LIST .IF NOT NO BCD IS REQD SO 58920015 * RETURN TO SCAN OF STATIC CHAIN 58960015 MVC PAR1+2(2),LABBCD(DEAR) GET ADDRESS OF LABEL BCD ENTRY 59000015 L LR,ZDRFAB 59040015 BALR RR,LR 59080015 L WR3,PAR1 59120015 MVC TEM1+1(3),DATOFS(WR3) PICK UP OFFSET OF BCD 59160015 LR WR3,DEAR 59200015 NI LABSWI+1,X'0F' SET SWITCH TO DROP THROUGH 59240015 SPACE 1 59280015 UA222 MVC TEM2+2(2),1(WR3) 59320015 LH WR1,TEM2+2 WR1= LENGTH OF DE 59360015 AR WR1,WR3 WR1 POINTS TO BCD LENGTH 59400015 XR PR2,PR2 59440015 IC PR2,0(WR1) PR2 = LENGTH OF BCD 59480015 MVC MVC1A+1(1),0(WR1) BCD LENT IN MVC INSTRN 59520015 LA PR2,1(PR2) 59560015 STC PR2,TXTBUF STORE BCD LENGTH 59600015 MVC1A MVC TXTBUF+1(0),1(WR1) AND MOVE TO TEXT BUF 59640015 LA PR2,1(PR2) PR2=LENGTH OF BCD +1 59680015 L WR2,ZTRAN2 WR2 = ADDR OF TRANSLATE TABLE 59720015 MVC TR1+1(1),0(WR1) MOVE LENGTH OF BCD TO TR INSTRN 59760015 TR1 TR TXTBUF+1(0),0(WR2) AND TRANSLATE BCD TO EXTERNAL FORM 59800015 LA PR1,TXTBUF 59840015 MVC PAR1+2(2),LABBCD(DEAR) CONVERT D.R. OF LABEL BCD ENTRY 59880015 L LR,ZDRFAB TO ABSOLUTE ADDRESS 59920015 BALR RR,LR 59960015 L WR1,PAR1 60000015 LABSWI BC B,*+10 60040015 MVC TEM1+1(3),DATOFS(WR1) MOVE OFFSET OF BCD IN STATIC TO 60080015 * TEM1 60120015 BAL RR,TXTMOV MOVE BCD TO TXT CARD 60160015 BC B,UA0015 RETURN TO SCAN 60200015 SPACE 2 60240015 * ENTER HERE FOR LABEL VARIABLES.THE ENTRY IN THE STATIC 60280015 * CHAIN IS THE BCD ENTRY WNICH CONTAINS THE REFERENCE OF THE 60320015 * LABEL ENTRY 60360015 UA225 MVC PAR1+2(2),8(DEAR) 60400015 L LR,ZDRFAB 60440015 BALR RR,LR 60480015 L WR3,PAR1 WR3= ADDRESS OF LABEL ENTRY 60520015 MVC TEM1+1(3),DATOFS(DEAR) PICK UP OFFSET OF BCD 60560015 OI LABSWI+1,X'F0' SET SWITCH TO BRANCH 60600015 BC B,UA222 60640015 EJECT 60680015 * DOPE VECTOR SKELETON ROUTINE 60720015 * 60760015 * 60800015 * 60840015 * FUNCTION/OPERATION 60880015 * THIS ROUTINE PRODUCES TEXT FOR THE DOPE VECTOR SKELETONS 60920015 * OF AUTOMATIC VARIABLES. THE ROUTINE IS ENTERED WITH DEAR 60960015 * POINTING AT THE D.V. SKELETON DICTIONARY ENTRY. THE TEXT IS 61000015 * OBTAINED EXACTLY AS IT STANDS FROM THIS ENTRY 61040015 * 61080015 * 61120015 * 61160015 * ENTRY POINT - UA0215 FROM THE STATIC SCAN 61200015 * 61240015 * 61280015 * 61320015 * EXTERNA6 ROUTINE - TXTMOV 61360015 * 61400015 * 61440015 * 61480015 * EXITS - NORMAL - UA033 TO RESUME SCAN 61520015 * 61560015 * 61600015 * 61640015 * EXITS - ERROR - NONE 61680015 SPACE 5 61720015 UA0215 LA PR1,10(DEAR) A(START OF SKELETON) 61760015 MVC TEM1+2(2),1(DEAR) 61800015 LH PR2,TEM1+2 61840015 S PR2,K10 SET PR2=LENGTH OF SKELETON 61880015 MVC TEM1+1(3),DATOFS(DEAR) 61920015 BAL RR,TXTMOV MOVE SKELETON TO CARD 61960015 BC B,UA033 62000015 EJECT 62040015 * UA100A 62080015 * 62120015 * 62160015 * 62200015 * FUNCTIONS/OPERATION 62240015 * THIS ROUTINE RELEASES PHASE IEMUA AND PASSES 62280015 * CONTROL TO IEMUE OR TO IEMUD IF INITIALISATION 62320015 * IS REQUIRED FOR STATIC DSAS 62360015 * ENTRY POINT - UA100A 62400015 * 62440015 * 62480015 * 62520015 * EXTERNAL ROUTINE - RLSCTL 62560015 * 62600015 * 62640015 * 62680015 * EXITS - NORMAL - TO NEXT PHASE 62720015 * 62760015 * 62800015 * 62840015 * EXITS - ERROR - NONE 62880015 SPACE 5 62920015 UA100A MVI FLAG,SEFL SET EXTERNAL FLAG ON 62960015 LA WR1,UANAM 63000015 ST WR1,PAR1 63040015 MVC PAR2(4),ZERO 63080015 L LR,RLSCTL RELEASE IEMUA 63120015 BCR B,LR 63160015 EJECT 63200015 * THIS SUBROUTINE SETS UP THE INFORMATION 63240015 * NECESSARY FOR THE TWO COLUMN LISTING OF 63280015 * STATIC DATA 63320015 SPACE 5 63360015 PRNTHD ST RR,PRNTR2 63400015 NI SINGLE+1,X'0F' 63440015 MVI PRINT-2,X'78' 63480015 L RR,ZEQTAB 63520015 LA RR,784(RR) 'PAGE' STARTS AT OFFSET 784 63560015 ST RR,WSTART SET UP SLOTS FOR TWO 63600015 ST RR,WSNEXT COLUMN LISTING 63640015 LA RR,0(RR,LR) 63680015 ST RR,WSEND 63720015 BAL RR,PRNTOU PRINT HEADING 63760015 BAL RR,PRNTOU 63800015 L RR,PRNTR2 63840015 BCR B,RR AND RETURN 63880015 EJECT 63920015 * THIS SUBROUTINE SETS UP A CALL TO ZUPL IN 63960015 * THE CASE OF SINGLE COLUMN LISTING 64000015 SPACE 5 64040015 ONELST ST RR,PRNTRR 64080015 L RR,ZTRAN2 TRANSLATE THE LINE 64120015 TR PRINT(120),0(RR) 64160015 LA RR,PRINT-3 64200015 ST RR,PAR1 64240015 L LR,ZUPL 64280015 BALR RR,LR 64320015 MVC PRINT(1),BLANK 64360015 MVC PRINT+1(119),PRINT RESET LINE TO BLANKS 64400015 L RR,PRNTRR 64440015 BCR B,RR 64480015 EJECT 64520015 * THIS SUBROUTINE IS USED TO PREPARE DATA FOR 64560015 * TWO COLUMN LISTING. IT SAVES THE 'LEFT HAND SIDE OF 64600015 * THE PAGE' IN SCRATCH CORE 64640015 SPACE 5 64680015 PRNTOU EQU * 64720015 TWOLST ST RR,PRNTRR 64760015 MVC SAVE(9),PRINT+58 ALLOW FOR OVERFLOW 64800015 MVC PRINT+58(4),BLANK 64840015 MODESW BC B,STACK BRANCH IF IN STACKING MODE 64880015 L RR,WSNEXT 64920015 MVC PRINT+62(58),PRINT SET UP RHS OF PAGE 64960015 MVC PRINT(58),0(RR) SET UP LHS OF PAGE 65000015 L RR,ZTRAN2 65040015 TR PRINT(120),0(RR) TRANSLATE LINE TO EXTERNAL 65080015 LA RR,PRINT-3 65120015 ST RR,PAR1 65160015 L LR,ZUPL PRINT LINE 65200015 BALR RR,LR 65240015 MVI PRINT-1,X'40' SET CONTROL CHAR TO SINGLE SPACE 65280015 L RR,WSNEXT 65320015 LA RR,58(RR) 65360015 C RR,WSEND 65400015 BC BE,PRINT1 BRANCH IF PAGE IS FULL 65440015 PRINT2 ST RR,WSNEXT 65480015 MVI PRINT,X'40' 65520015 MVC PRINT+1(119),PRINT RESET LINE TO BLANKS 65560015 L RR,PRNTRR 65600015 CLI SAVE,X'40' ANYTHING SAVED 65640015 BCR BE,RR 65680015 MVC PRINT+30(9),SAVE 65720015 BC B,PRNTOU+4 65760015 PRINT1 OI MODESW+1,X'F0' RESET MODE TO STACKING 65800015 L RR,WSTART REST POINTER 65840015 BC B,PRINT2 65880015 STACK L RR,WSNEXT 65920015 MVC 0(58,RR),PRINT SAVE LINE IMAGE 65960015 LA RR,58(RR) 66000015 C RR,WSEND 66040015 BC BNE,PRINT2 66080015 NI MODESW+1,X'0F' MODE SET TO PRINTING 66120015 MVI PRINT-1,X'F1' CONTROL CHAR SET TO EJECT 66160015 L RR,WSTART 66200015 BC B,PRINT2 66240015 EJECT 66280015 * THIS SUBROUTINE IS USED TO COMPLETE THE 66320015 * LISTING OF STATIC WHEN IT IS IN THE TWO COLUMN MODE 66360015 SPACE 5 66400015 RUNOUT ST RR,PRNTRR 66440015 CLI MODESW+1,X'F0' BRANCH IF IN PRINTING MODE 66480015 BC BNE,PRINT5 66520015 MVC WSEND(4),WSNEXT 66560015 MVC WSNEXT(4),WSTART 66600015 MVI PRINT-1,X'F1' 66640015 PRINT5 L RR,WSNEXT 66680015 C RR,WSEND 66720015 BC BE,PRINT6 66760015 MVI PRINT,X'40' 66800015 MVC PRINT(58),0(RR) 66840015 LA RR,58(RR) 66880015 ST RR,WSNEXT 66920015 L RR,ZTRAN2 66960015 TR PRINT(120),0(RR) 67000015 LA RR,PRINT-3 67040015 ST RR,PAR1 67080015 L LR,ZUPL 67120015 BALR RR,LR 67160015 MVI PRINT-1,X'40' 67200015 BC B,PRINT5 67240015 PRINT6 L RR,PRNTRR 67280015 BCR B,RR 67320015 EJECT 67360015 * DSAS 67400015 * 67440015 * 67480015 * 67520015 * FUNCTIONS/OPERATION 67560015 * TO OBTAIN THE NAME OF THE ENTRY TYPE 1 WHOSE 67600015 * STATIC DSA ENTRY IS BEING PROCESSED. 67640015 * 67680015 * 67720015 * 67760015 * ENTRY POINT - DSAS 67800015 * 67840015 * 67880015 * 67920015 * EXTERNAL ROUTINES - ZDRFAB 67960015 * 68000015 * 68040015 * 68080015 * EXITS - NORMAL - TO 0(RR) FOR LABELLED BLOCKS 68120015 * TO 4(RR) FOR UNLABELLED BEGIN BLOCKS 68160015 * 68200015 * 68240015 * 68280015 * EXITS - ERROR - NONE 68320015 SPACE 5 68360015 DSAS CLI 0(LR),X'80' 68400015 BC BE,DSAS1 BRANCH IF PROC 68440015 SPACE 68480015 CLI 34(LR),X'D2' 68520015 BC BNE,4(RR) BRANCH IF UNLABELLED BEGIN 68560015 SPACE 68600015 DSAS1 ST RR,DSAS2 68640015 MVI PRINT+38,X'40' 68680015 MVC PRINT+39(6),PRINT+38 CLEAR PART OF BUFFER 68720015 SPACE 68760015 MVC PAR1+2(2),7(LR) 68800015 L LR,ZDRFAB 68840015 BALR RR,LR OBTAIN ENTRY LABEL 68880015 L LR,PAR1 68920015 SPACE 68960015 SR RR,RR 69000015 IC RR,2(LR) LENGTH OF LABEL ENTRY 69040015 AR LR,RR POINT TO BCD LENGTH 69080015 SPACE 69120015 IC RR,0(LR) BCD LENGTH 69160015 EX RR,DSAS3 MOVE NAME 69200015 SPACE 69240015 L RR,DSAS2 69280015 BCR B,RR RETURN 69320015 SPACE 10 69360015 DSAS2 DC F'0' 69400015 DSAS3 MVC PRINT+38(0),1(LR) 69440015 EJECT 69480015 * TSKRLD 69520015 * 69560015 * THIS ROUTINE PUTS OUT ALL OF THE RLD 69600015 * CARDS REQUIRED FOR TASKS IN PACKED STRUCTURES. 69640015 * SINCE TASKS ARE THE ONLY 'DATA' VARIABLES 69680015 * TO HAVE NEED OF RLD ENTRIES, RLDBUF WILL HAVE 69720015 * THE CORRECT IDS AND FLAGS IN IT. IT ONLY REMAINS 69760015 * TO FILL IN THE OFFSET FOR EACH TASK IN THE 69800015 * STRUCTURE BEFORE CALLING RLDMOV. 69840015 SPACE 5 69880015 TSKRLD TM DATOT1(DEAR),X'08' 69920015 BC BZ,TKRLD1 BRANCH IF NOT END OF STRUCTURE 69960015 SPACE 70000015 MVC PAR1+2(2),DESTO 70040015 L LR,ZDRFAB RESTORE MAJOS STR ENTRY 70080015 BALR RR,LR 70120015 L DEAR,PAR1 70160015 SPACE 70200015 L RR,LNKST2 AND RETURN 70240015 BCR B,RR 70280015 SPACE 70320015 TKRLD1 LR RR,DEAR 70360015 TM 0(DEAR),X'0F' 70400015 BC BNO,TKRLD2 BRANCH IF NOT DATA ITEM 70440015 LA RR,6(RR) 70480015 SPACE 70520015 TKRLD2 TM 0(DEAR),X'10' 70560015 BC BZ,TKRLD3 BRANCH IF NOT DIMENSIONED 70600015 LA RR,3(RR) 70640015 SPACE 70680015 TKRLD3 MVC PAR1+2(2),23(RR) 70720015 L LR,ZDRFAB 70760015 BALR RR,LR GET NEXT ITEM ON STR CHAIN 70800015 L DEAR,PAR1 70840015 SPACE 70880015 TM 0(DEAR),X'0E' 70920015 BC BO,TSKRLD BRANCH IF DAT A OR TASK 70960015 TM 0(DEAR),X'01' 71000015 BC BO,TSKRLD BRANCH IF LABEL OR EVENT 71040015 SPACE 71080015 TM 0(DEAR),X'10' 71120015 BC BO,TKRLD4 BRANCH IF ARRAY OF TASKS 71160015 SPACE 71200015 MVC WORK+1(3),5(DEAR) 71240015 L LR,WORK 71280015 LA LR,8(LR) OFFSET OF SYMTAB ADDR 71320015 ST LR,WORK 71360015 MVC RLDBUF+5(3),WORK+1 71400015 BAL RR,RLDMOV MAKE RLD ENTRY 71440015 BC B,TSKRLD 71480015 SPACE 71520015 TKRLD4 BAL RR,NUMERA BASIC INITIALISATION 71560015 BAL RR,SETSTR 71600015 L WR3,WORK1 71640015 SPACE 71680015 TKRLD5 ST WR3,WORK1 SAVE COUNT OF ELEMENTS 71720015 BAL RR,STRAD1 71760015 LA WR2,8(WR2) OFFSET OF SYMTAB ADDR 71800015 ST WR2,WORK 71840015 MVC RLDBUF+5(3),WORK+1 71880015 BAL RR,RLDMOV MAKE RLD ENTRY 71920015 L WR3,WORK1 71960015 BCT WR3,TKRLD5 REPEAT LOOP 72000015 BC B,TSKRLD 72040015 EJECT 72080015 * THIS ROUTINE INITIALISES TASK VARIABLES. 72120015 * BEFORE A TEST IS MADE FOR ARRAY OR SCALAR, A 28 72160015 * BYTE SLOT IS SET UP CONTAINING THE OFFSET OF 72200015 * THE SYMBOL TABLE FOR THE TASK. A RLD CARD BUFFER IS 72240015 * ALSO SET UP. 72280015 SPACE 5 72320015 *********************************************************************** 72360015 * * 72400015 * * 72440015 * SPECIAL NOTE * 72480015 * ------------ * 72520015 * * 72560015 * * 72600015 * IF TASK VARIABLES APPEAR IN A PACKED * 72640015 * STRUCTURE, THEN THE OUTPUT OF RLD CARDS MUST BE * 72680015 * DELAYED UNTIL EVERY ELEMENT OF THE STRUCTURE * 72720015 * HAS BEEN PROCESSED. THIS IS ESSENTIAL BECAUSE * 72760015 * RLD CARDS MUST FOLLOW THE TEXT CARDS TO * 72800015 * WHICH THEY RELATE. * 72840015 * * 72880015 * * 72920015 * RLD CARDS WILL BE PUT OUT BY ROUTINE TSKRLD * 72960015 * * 73000015 * * 73040015 *********************************************************************** 73080015 SPACE 5 73120015 SPACE 73160015 TASK SR WR3,WR3 73200015 IC WR3,2(DEAR) 73240015 LA WR3,0(WR3,DEAR) 73280015 S WR3,K4 73320015 MVC PAR1+2(2),0(WR3) 73360015 L LR,ZDRFAB 73400015 BALR RR,LR 73440015 L LR,PAR1 73480015 MVC SMB+1(3),5(LR) SYMBOL TAB ENTRY 73520015 MVC TEM1+1(3),5(DEAR) 73560015 SPACE 73600015 MVC RLDBUF+2(2),CSECT2 73640015 MVC RLDBUF(2),CSECT2 73680015 MVI RLDBUF+4,X'0C' 73720015 TM 12(DEAR),X'04' 73760015 BC BZ,TASKA BRANCH IF STATIC INTERNAL 73800015 MVC RLDBUF+2(2),2(WR3) CSECT NO 73840015 TM 0(DEAR),X'20' 73880015 BC BO,TASKA BRANCH IF STRUCTURED 73920015 MVC TEM1+1(3),ZERO 73960015 SPACE 74000015 TASKA TM 0(DEAR),X'10' 74040015 BC BO,TSKARR 74080015 SPACE 74120015 L LR,TEM1 74160015 LA LR,8(LR) 74200015 ST LR,WORK 74240015 MVC RLDBUF+5(3),WORK+1 74280015 LA PR1,TSKVAR 74320015 LA PR2,28 74360015 BAL RR,TXTMOV PUT OUT TEXT CARD 74400015 TM TXTMOV+1,X'F0' 74440015 BC BZ,RETUD BRANCH IF IN PACJED STRUCTURE 74480015 BAL RR,RLDMOV AND RLD CARD 74520015 BC B,RETUD 74560015 SPACE 74600015 TSKARR BAL RR,NUMERA FIND NUMBER OF ELEMENTS 74640015 * SET UP FRSTSO FOR STRAD1 74680015 BAL RR,SETSTR 74720015 L WR3,WORK1 74760015 SPACE 74800015 TASKLP ST WR3,WORK1 74840015 BAL RR,STRAD1 74880015 ST WR2,TEM1 SET UP TEXT AND RLD INFO 74920015 LA WR2,8(WR2) 74960015 ST WR2,WORK 75000015 MVC RLDBUF+5(3),WORK+1 75040015 LA PR1,TSKVAR 75080015 LA PR2,28 75120015 BAL RR,TXTMOV 75160015 TM TXTMOV+1,X'F0' 75200015 BC BZ,*+8 BRANCH IF IN PACKED STRUCTURE 75240015 BAL RR,RLDMOV 75280015 L WR3,WORK1 75320015 BCT WR3,TASKLP 75360015 BC B,RETUD 75400015 SPACE 75440015 RETUD TM 0(DEAR),X'10' 75480015 BC BO,RETUD1 BRANCH IF ARRAY 75520015 L RR,LNKST1 75560015 BCR B,RR RETURN FOR SCALAR 75600015 SPACE 75640015 RETUD1 TM 0(DEAR),X'20' 75680015 BC BO,UA0413 RETURN FOR STRUCTD ARRAYS 75720015 TM DATOT2(DEAR),EXTFL 75760015 BC BZ,UA0345 BRANCH IF INTERNAL 75800015 BC B,UA105 BRANCH IF EXTERNAL 75840015 SPACE 5 75880015 * THIS ROUTINE INITIALISES EVENT VARIABLES. 75920015 * BASIC INITIALISATION IS ONLY REQUIRED FOR ARRAYS 75960015 * AS THE TEXT PUT OUT CONSISTS OF 32 BYTES OF ZEROES. 76000015 SPACE 76040015 EVENT TM 0(DEAR),X'10' 76080015 BC BO,EVARR 76120015 SPACE 76160015 MVC TEM1+1(3),5(DEAR) *** SCALAR EVENT 76200015 TM DATOT2(DEAR),EXTFL 76240015 BC BZ,EVENT1 BRANCH IF INTERNAL 76280015 TM 0(DEAR),X'20' 76320015 BC BO,EVENT1 BRANCH IF STRUCTURED 76360015 MVC TEM1(4),ZERO 76400015 SPACE 76440015 EVENT1 LA PR1,EVNVAR ADDR OF TEXT 76480015 LA PR2,32 LENGTH OF TEXT 76520015 BAL RR,TXTMOV PUT OUT THE TEXT CARD 76560015 BC B,RETUD 76600015 SPACE 76640015 EVARR BAL RR,NUMERA FIND NUMBER OF ELEMENTS 76680015 BAL RR,SETSTR 76720015 L WR3,WORK1 76760015 SPACE 76800015 EVNLP ST WR3,WORK1 76840015 BAL RR,STRAD1 76880015 ST WR2,TEM1 76920015 LA PR1,EVNVAR 76960015 LA PR2,32 77000015 BAL RR,TXTMOV PUT OUT TEXT CARD FOR EVENT 77040015 L WR3,WORK1 77080015 BCT WR3,EVNLP 77120015 BC B,RETUD 77160015 SPACE 5 77200015 * THIS ROUTINE INITIALISES AREA VARIABLES. 77240015 * BEFORE A TEST IS MADE FOR SCALAR OR ARRAY, A 16 77280015 * IS SET UP CONTAINING THE DECLARED LENGTH OF THE 77320015 * AREA. 77360015 SPACE 77400015 AREA MVC ARVAR+2(2),16(DEAR) 77440015 TM 0(DEAR),X'10' 77480015 BC BO,ARARY 77520015 SPACE 77560015 AROUT MVC TEM1+1(3),5(DEAR) 77600015 TM DATOT2(DEAR),EXTFL 77640015 BC BZ,AREA1 INTERNAL 77680015 TM 0(DEAR),X'20' 77720015 BC BO,AREA1 STRUCTURED 77760015 MVC TEM1+1(3),K8+1 RESET TEM1 77800015 AREA1 LA PR1,ARVAR 77840015 LA PR2,16 77880015 BAL RR,TXTMOV 77920015 BC B,RETUD 77960015 SPACE 78000015 ARARY BAL RR,NUMERA FIND NUMBER OF ELEMENTS 78040015 BAL RR,SETSTR 78080015 L WR3,WORK1 78120015 SPACE 78160015 ARRLP ST WR3,WORK1 78200015 BAL RR,STRAD1 78240015 ST WR2,WORK 78280015 MVC TEM1+1(3),WORK+1 78320015 LA PR1,ARVAR PUT OUT AREA TEXT CARD 78360015 LA PR2,16 78400015 BAL RR,TXTMOV 78440015 L WR3,WORK1 78480015 BCT WR3,ARRLP 78520015 BC B,RETUD 78560015 SPACE 5 78600015 * GIVEN A POINTER TO AN ARRAY DICTIONARY ENTRY, 78640015 * THIS SUBROUTINE DOES ALL OF THE INITIALISATION REQUIRED 78680015 * FOR SUBROUTINE STRAD1. 78720015 * THIS ROUTINE USES THE DIMTAB ADDRESS WHICH HAS BEEN LEFT 78760015 * IN PAR1 BY SUBROUTINE NUMERA 78800015 SPACE 78840015 SETSTR ST RR,RRSAVE 78880015 L WR1,PAR1 DIMTAB REF 78920015 TM DATOT2(DEAR),EXTFL 78960015 BC BZ,TASK1X 79000015 L WR2,8(WR1) 79040015 BC B,TASK1Y 79080015 TASK1X LR WR2,DEAR 79120015 TM 0(DEAR),X'0F' 79160015 BC BNO,*+8 79200015 LA WR2,6(WR2) 79240015 MVC VOST(1),DATOF2-6(WR2) 79280015 MVC VOST+1(3),DATOFS(DEAR) 79320015 L WR2,VOST 79360015 TASK1Y LR WR3,WR2 79400015 N WR2,ADMSK 79440015 TM DATOT3(DEAR),VONEG 79480015 BC BZ,TASK1Z 79520015 LCR WR2,WR2 79560015 N WR2,ADMSK 79600015 TASK1Z L WR7,ZEQTAB 79640015 SR LR,LR 79680015 IC LR,5(WR1) 79720015 STH LR,NODIMS 79760015 AR LR,LR 79800015 AR LR,LR 79840015 LA RR,0(LR,LR) 79880015 LA LR,4(LR,RR) 79920015 C LR,K256 79960015 BC BNH,TASK8 80000015 MVC 64(256,WR7),8(WR1) 80040015 LA WR7,256(WR7) 80080015 LA WR1,256(WR1) 80120015 S LR,K256 80160015 TASK8 BCTR LR,0 80200015 STC LR,TASK9+1 80240015 TASK9 MVC 64(1,WR7),8(WR1) 80280015 L WR7,ZEQTAB 80320015 LH LR,NODIMS 80360015 TASKB MVC 68(2,WR7),70(WR7) 80400015 LA WR7,8(WR7) 80440015 BCT LR,TASKB 80480015 ST WR2,FRSTSO 80520015 L RR,RRSAVE 80560015 BCR B,RR 80600015 SPACE 5 80640015 * GIVEN A POINTER TO AN ARRAY DICTIONARY ENTRY THIS 80680015 * SUBROUTINE DETERMINES THE NUMBER OF ELEMENTS IN THE 80720015 * ARRAY. 80760015 * THIS NUMBER IS LEFT IN THE SLOT WORK. 80800015 SPACE 80840015 NUMERA ST RR,RRSAVE SAVE RETURN REGISTER 80880015 LR WR8,DEAR 80920015 TM 0(DEAR),X'0F' 80960015 BC BNO,*+8 81000015 LA WR8,6(WR8) 81040015 TM 11(DEAR),X'80' 81080015 BC BZ,*+8 81120015 LA WR8,4(WR8) 81160015 SR WR9,WR9 81200015 IC WR9,15(WR8) 81240015 MVC PAR1+2(2),16(WR8) 81280015 LA WR3,1 81320015 L LR,ZDRFAB 81360015 BALR RR,LR 81400015 L WR8,PAR1 81440015 LA WR8,12(WR8) 81480015 LA WR7,1 81520015 TSKX LH WR6,6(WR8) 81560015 SH WR6,2(WR8) 81600015 AR WR6,WR7 81640015 MR WR2,WR6 81680015 LA WR8,8(WR8) 81720015 BCT WR9,TSKX 81760015 ST WR3,WORK1 81800015 SPACE 81840015 L RR,RRSAVE RESTORE RETURN REGISTER 81880015 BCR B,RR 81920015 EJECT 81960015 * THE FOLLOWING WORK AREAS ARE REQUIRED 82000015 * FOR TWO COLUMN LISTING 82040015 SPACE 5 82080015 PRNTRR DC F'0' 82120015 PRNTR2 DC F'0' 82160015 WSTART DC F'0' 82200015 WSNEXT DC F'0' 82240015 WSEND DC F'0' 82280015 SAVE DC 9C' ' 82320015 DS F 82360015 ARVAR DC F'0' REQUIRES 16 BYTES 82400015 EVNVAR DC 6F'0' REQUIRES 32 BYTES 82440015 TSKVAR DC 2F'0' REQUIRES 28 BYTES 82480015 SMB DC 5F'0' 82520015 RRSAVE DC F'0' 82560015 WORK1 DC F'0' 82600015 WORK DC F'0' 82640015 CSECT2 DC X'0002' 82680015 TSKFLG DC X'0' 82720015 END IEMUC 82760015 ./ ADD SSI=02012611,NAME=IEMUD,SOURCE=0 TITLE 'IEMUD, STATIC INITIALIZATION' 00200015 IEMUD START 0 00400015 * STATUS CHANGE LEVEL - 0 00404015 * 21153 RLSE18 374000 00406001 * R20 455000,482300-483500,568600-569200,571000,783000 32243 00407000 * 00408015 * 00412015 * 00416015 * FUNCTION/OPERATION 00420015 * THE PHASE INITIALIZES THOSE PARTS OF STATIC DSA'S KNOWN 00424015 * AT LOAD TIME. I.E. THE FIRST WORD OF THE DSA AND DOPE VECTORS 00428015 * OF THOSE ITEMS WHICH APPEAR IN THE FIRST REGION OF THE COMPILE 00432015 * TIME AUTOMATIC CHAIN. 00436015 * THE RELEASE 15 VERSION INITIALIZES ONLY THE FIRST WORD. 00440015 * UNCHECKED-OUT DOPE VECTOR INITIALIZATION CODE IS PRESENT BUT 00444015 * IS NOT EXECUTED. 00448015 * THE CHAIN OF STATIC DSA'S DICTIONAY ENTRIES IS SCANNED. 00452015 * THE OFFSET OF THE DSA IN STATIC, THE DSA'S INITIAL CODE BYTE 00456015 * AND THE DSA'S LENGTH ARE FOUND IN THE ENTRY AND ARE USED TO 00460015 * GENERATE A TEXT CARD FOR THE DSA'S FIRST WORD. (THE FIRST WORD 00464015 * CONSISTS OF THE NORMAL DSA CODE BYTE FOLLOWED BY THE DSA 00468015 * LENGTH IN THREE BYTES WITH THERE HIGH ORDER BIT=1 TO IND- 00472015 * ICATE STATIC DSA). 00476015 * DOPE VECTORS ARE INITIALIZED BY SCANNING THE FIRST 00480015 * REGION OF THE AUTOMATIC CHAIN AND FINDING ITEMS REQUIRING 00484015 * DOPE VECTORS (ELEMENTS OF STRUCTURES ARE TREATED INDIVUDALLY) 00488015 * THE BIT PATTERN OF THE DOPE VECTOR IS FOUND IN THE SKELETON 00492015 * DOPE VECTOR ENTRY. THE VIRTUAL ORIGIN IS RELOCATED BY THE 00496015 * OFFSET OF THE DSA WITHIN STATIC. TEXT CARDS CONTAINING THE 00500015 * DOPE VECTOR ARE GENERATED. AN RLD CARD IS THEN GENERATED TO 00504015 * RELOCATE THE V.O. SLOT FURTHER, BY THE ADDRESS OF STATIC. 00508015 * 00512015 * 00516015 * 00520015 * ENTRY POINT - UD+2 00524015 * 00528015 * 00532015 * 00536015 * INPUT - DICTIONARY - STATIC DSA CHAIN, 00540015 * AUTOMATIC CHAIN, 00544015 * SKELETON DOPE VECTOR ENTRIES. 00548015 * 00552015 * 00556015 * 00560015 * OUT PUT - TXT CARDS, 00564015 * RLD CARDS. 00568015 * 00572015 * 00576015 * 00580015 * EXTERNAL ROUTINES - TXTMOV IN IEMUB, PUTS OUT TXT CARDS 00584015 * RLDMOV IN IEMUB, PUTS OUT RLD CARDS 00588015 EJECT 00592015 USING *,UDBASE 00600015 CC EQU *+8192 00800015 USING CC,GRCC 01000015 COMREG EQU *+12288 01200015 USING COMREG,GRDIC 01400015 UB EQU *+16384 01600015 USING UB,UBBASE 01800015 SPACE 5 02000015 * REGISTERS 02200015 R0 EQU 0 02400015 R1 EQU 5 02600015 R2 EQU 2 02800015 R3 EQU 3 03000015 R4 EQU 12 03200015 LCCTR EQU 6 03400015 PR1 EQU 7 03600015 PR2 EQU 8 03800015 UDBASE EQU 9 04000015 UBBASE EQU 10 04200015 GRCC EQU 11 04400015 GRDIC EQU 13 04600015 RR EQU 14 04800015 LR EQU 15 05000015 EJECT 05200015 * BRANCH MNEMONICS 05400015 SPACE 05600015 B EQU 15 05800015 BE EQU 8 06000015 BNE EQU 7 06200015 BH EQU 2 06400015 BNH EQU 13 06600015 BL EQU 4 06800015 BNL EQU 11 07000015 BO EQU 1 07200015 BNO EQU 14 07400015 BM EQU 4 07600015 BNM EQU 11 07800015 BZ EQU 8 08000015 BNZ EQU 7 08200015 EJECT 08400015 * COMMUNICATIONS REGION 08600015 PAR1 EQU COMREG+X'80' 08800015 PAR2 EQU PAR1+4 09000015 ZLOCK EQU COMREG+X'112' 09200015 ZMYNAM EQU COMREG+X'70' 09400015 ZCOMM EQU COMREG+X'130' 09600015 ZDSA EQU ZCOMM+94 09800015 * COMPILER CONTROL 10000015 ZDRFAB EQU CC+X'34' 10200015 RLSCTL EQU CC+X'48' 10400015 TXTMOV EQU UB+2 10600015 RLDMOV EQU UB+X'12' 10800015 * FORMATS OF DICTIONARY ENTRIES 11000015 SPACE 11200015 * STATIC DSA ENTRY 11400015 SA EQU 3 CHAIN TO NEXT 11600015 SB EQU 5 OFFSET OF ADDRESS OF DSA 11800015 SC EQU 7 SIZE OF DSA 12000015 SD EQU 10 REF OF ENTRY TYPE 1 12200015 SE EQU 12 OFFSET OF DSA WITHIN STATIC 12400015 SF EQU 16 12600015 SPACE 3 12800015 OTHER1 EQU 10 13000015 OTHER3 EQU 13 13200015 OTHER4 EQU 14 13300016 DCLNO EQU 8 13400015 VAR EQU 11 13600015 FCHN EQU X'17' 13800015 E3RTOF EQU 7 14000015 E4SET EQU 20 14200015 E4RTOF EQU 8 14400015 E3SET EQU 15 14600015 SKDVOF EQU 5 14800015 DVBIT EQU X'80' 15000015 DIMBIT EQU X'40' 15200015 LSTMEM EQU X'08' 15400015 * CODE BYTES 15600015 SPACE 15800015 DATOL EQU X'07' 16000015 MJSTR EQU X'2E' 16200015 ONDR EQU X'4D' 16400015 EVTASK EQU X'0C' 16600015 DVENT EQU X'C0' 16800015 E3 EQU X'84' 17000015 E4 EQU X'03' 17200015 E5 EQU X'83' 17400015 DELIM EQU X'CC' 17600015 EJECT 17800015 UD DC C'UD' 18000015 L UDBASE,PAR1 SET UP BASE REGISTER 18200015 MVC ZMYNAM(2),UD 18400015 SR R0,R0 18600015 * INITIALIZE TEXT AND RLD CARD SKELETONS WITH CSECT NUMBER 18800015 * OF STATIC. (I.E. 2 ). 19000015 SPACE 19200015 LA R4,2 19400015 STH R4,RLDBUF 19600015 STH R4,RLDBUF+2 19800015 STH R4,TXTCD+14 20000015 SPACE 20200015 TM X'143'(13),1 20400015 BC BE,UDEND 20600015 MVC STDSA(2),ZDSA+2 INITIALIZE NEXT DSA SLOT 20800015 A1 LH R2,STDSA PICK UP REFERENCE TO NEXT DSA 21000015 LTR R2,R2 STOPPER 21200015 BC BE,UDEND BRANCH IF SO 21400015 STH R2,PAR1+2 CONVERT REF TO ABSOLUTE 21600015 L LR,ZDRFAB 21800015 BALR RR,LR 22000015 SPACE 22200015 L R2,PAR1 SET R2 TO POINT TO DSA ENTRY 22400015 MVC STDSA(2),SA(R2) SAVE REF. OF NEXT DSA ENTRY 22600015 MVC DSAOFF+1(3),SE+1(R2) SAVE OFFSET WITHIN STATIC OF 22800015 MVC TEMP+1(3),SC(R2) 23000015 * WORD OF DSA IN TEMP. 23200015 MVC TEMP(1),SE(R2) 23400015 OI TEMP+1,X'80' 23600015 SPACE 23800015 LA PR1,TEMP 24000015 LA PR2,4 24200015 L R4,DSAOFF 24400015 ST R4,TEM1 24600015 BAL RR,TXTMOV OUT-PUT TEXT CARD 24800015 SPACE 5 25000015 EJECT 25400015 * THE AUTOMATIC CHAIN FOR THE BLOCK WILL NOW BE SCANNED 25600015 MVC AUTREF(2),SF(R2) 25800015 SPACE 5 26000015 AUTO CH R0,AUTREF 26200015 BC BE,A1 26400015 MVC PAR1+2(2),AUTREF 26600015 L LR,ZDRFAB 26800015 BALR RR,LR 27000015 L R2,PAR1 SET R2 TO POINT TO NEW MEMBER 27200015 CLI 0(R2),DELIM I4 27260016 BC BE,SKIP 27330016 TM 0(R2),DATOL 27400015 BC BO,DATLAB 27600015 TM 0(R2),MJSTR 27800015 BC BO,STRUC 28000015 TM 0(R2),ONDR 28200015 BC BO,SKIP I4 28400016 TM 0(R2),EVTASK 28600015 BC BO,DATLAB 28800015 CLI 0(R2),DVENT 29000015 BC BE,DVITEM I4 29200016 CLI 0(R2),E3 29400015 BC BE,ENT3 29600015 CLI 0(R2),E4 29800015 BC BE,ENT4 30000015 CLI 0(R2),E5 30200015 BC BE,ENT5 30400015 SKIP MVC AUTREF(2),3(R2) I4 31000016 BC B,AUTO 31200015 EJECT 31400015 DATLAB MVC AUTREF(2),3(R2) SAVE REF TO NEXT AUTO ITEN 31600015 * IF THE ITEM IS A TEMPARARY, IT MAY HAVE BEEN COMMONED. 31620016 * IF THIS IS THE CASE ITS DOPE VECTOR WILL HAVE BEEN INITIAL- 31640016 * IZED ELSEWHERE. 31660016 TM OTHER4(R2),X'60' TEMPORARY? 31680016 BC BZ,*+12 BRANCH IF NOT 31700016 TM OTHER3(R2),8 BEEN COMMONED? 31720016 BC BO,AUTO BRANCH IF SO 31740016 DTLB1 TM OTHER3(R2),DVBIT DOES THIS ITEM REQUIRE A D.V. 31800015 BC BZ,AUTO BRANCH IF NOT 32000015 SPACE 32200015 LA LR,15(0,R2) COMPUTE POINTER TO OFFSET2 SLOT 32400015 TM 0(R2),X'0F' IS THIS DATA 32600015 BC BNO,DTA 32800015 TM 0(LR),X'10' 33000015 BC BZ,DTB 33200015 TM 0(LR),X'80' 33400015 BC BO,DTB 33600015 TM VAR(R2),DIMBIT 33800015 BC BO,AUTO 34000015 DTB LA LR,6(0,LR) 34200015 DTA EQU * 34400015 SPACE 34600015 TM OTHER3(R2),X'01' IS THE OFFSET2 SLOT SET UP 34800015 BC BNO,AUTO I4 35000016 DVALSO EQU * I4 35200016 SPACE 35400015 MVC TEM1+1(3),1(LR) PICK UP OFFSET 2 SLOT 35600015 MVC PAR1+2(2),DCLNO(R2) PICK UP REF TO SKDV ENTRY 35800015 COMMON L LR,ZDRFAB CONVERT IT 36000015 BALR RR,LR 36200015 SPACE 36400015 L R3,PAR1 SET R3 TO POINT TO SKDV 36600015 CLC SKDVOF(3,R3),ONE+1 36800015 BC BH,AUTO 37000015 MVC TEMP(4),10(R3) RELOACTE V.O. SLOT 37200015 L LR,TEMP 37400015 TM 0(R2),X'40' 37410001 BO NOTSPEC NOT A SPECIAL CASE 37420001 TM 0(R2),X'04' 37430001 BNO NOTSPEC NOT DEFINABLE AUTO DATA 37440001 TM 11(R2),X'02' DEFINED? 37450001 BNO NOTSPEC NO 37460001 * ITEM COULD BE DEFINED ON 21153 37470001 * STATIC AND A STATIC DSA PRESENT. 21153 37480001 TM 12(R2),X'01' STATC BASE ITEM? 21153 37490001 BO *+8 YES DO NOT RELOCATE FROM DSA21153 37500001 NOTSPEC EQU * 37510001 A LR,DSAOFF 37600015 ST LR,TEMP 37800015 MVC 11(3,R3),TEMP+1 38000015 L PR1,TEM1 38200015 A PR1,DSAOFF BUMP BY OFFSETTOF THIS DSA 38400015 ST PR1,TEM1 38600015 ST PR1,RLDBUF+4 38800015 MVI RLDBUF+4,X'0C' 39000015 CLI 10(R3),X'FF' 39200015 BC BE,NOTBIT 39400015 CLI 10(R3),0 39600015 BC BE,NOTBIT 39800015 LA PR1,1(0,PR1) 40000015 ST PR1,RLDBUF+4 40200015 MVI RLDBUF+4,8 40400015 NOTBIT EQU * 40600015 SPACE 40800015 LA PR1,10(R3) POINT TO D.V. SKELETON 41000015 SPACE 41200015 * COMPUTE LENGTH OF SKELETON 41400015 SPACE 41600015 MVC HTEMP(2),1(R3) 41800015 LH PR2,HTEMP 42000015 SH PR2,H10 42200015 SPACE 42400015 BAL RR,TXTMOV 42600015 BAL RR,RLDMOV 42800015 BC B,AUTO 43000015 EJECT 43040016 DVITEM MVC AUTREF(2),3(R2) I4 43080016 LA LR,4(0,R2) I4 43120016 BC B,DVALSO I4 43160016 EJECT 43200015 * A STRUCTURE REQUIRING A DOPE VECTOR IS TO BE PROCESSED. 43400015 * THE V.O. SLOT FOR EACH BASE ELEMENT MUST BE BUMPED BY THE 43600015 * OFFSET OF THE START OF THIS DSA AND THEN RELOCATED FURTHER BY 43800015 * AN RLD CARD, BY THE ADDRESS OF THE START OF STATIC. 44000015 * TO AVOID TWO SCANS OF THE STRUCTURE, THE TEXT IS SET UP 44200015 * PIECE-MEAL - A SEPARATE CALL IS MADE TO TXTMOV AND RLDMOV FOR 44400015 * EACH ELEMENT 44600015 STRUC MVC AUTREF(2),3(R2) SAVE REF. TO NEXT ITEM 44800015 TM OTHER3(R2),DVBIT IS DOPE VECTOR REQUIRED. 45000015 BC BZ,AUTO BRANCH IF NOT 45200015 MVI CANTSW,0 45400015 MVI DEFSW,0 RESET DEFINED SWITCH 32243 45500000 SPACE 45600015 MVC PAR1+2(2),DCLNO(R2) PICK UP REF TO SKDV 45800015 L LR,ZDRFAB 46000015 BALR RR,LR CONVERT IT 46200015 SPACE 46400015 MVC ZLOCK(2),DCLNO(R2) LOCK IT INTO CORE 46600015 L R3,PAR1 SET R3 TO POINT TO SKDV ENTRY 46800015 CLC SKDVOF(3,R3),ONE+1 47000015 BC BH,AUTO 47200015 LA PR1,10(0,R3) INITIALIZE PR1 TO START OF SKDV 47400015 MVC HTEMP(2),1(R3) PICK UP LENGTH OF ENTRY 47600015 LR R4,R3 47800015 AH R4,HTEMP POINT TO END OF ENTRY 48000015 ST R4,SKEND AND SAVE 48200015 TM VAR(R2),X'02' IS THIS STRUC DEF? 32243 48230000 BNO STR1 NO 32243 48260000 TM 12(R2),X'01' STATIC BASE ITEM? 32243 48290000 BNO STR1 NO 32243 48320000 MVI DEFSW,X'FF' DEF ON STAT BASE 32243 48350000 SPACE 48400015 * SCAN THE STRUCTURE FOR BASE ELEMENTS 48600015 SPACE 48800015 STR1 LR R4,R2 49000015 TM VAR(R4),DIMBIT 49200015 BC BZ,*+8 49400015 LA R4,3(0,R4) IF IT IS PRESENT, JUMP DIMS SLOT 49600015 TM 0(R2),X'0F' DATA ITEM? 49800015 BC BNO,B3A 50000015 LA R4,6(0,R4) ACCOUNT FOR DATA INFORMATION I4 50900016 B3A EQU * 51800015 MVC PAR1+2(2),FCHN(R4) PICK UP FORWARD CHAIN 52000015 L LR,ZDRFAB CONVERT IT 52200015 BALR RR,LR 52400015 SPACE 52600015 L R2,PAR1 52800015 SPACE 53000015 TM 0(R2),X'0E' 53200015 BC BNO,BSELMT BRANCH IF BASE ELEMENT 53400015 TM 0(R2),X'01' 53600015 BC BZ,STR1 BRANCH IF NOT BASE EE