diff --git a/assist_no_instructionlimit_install.jcl b/assist_no_instructionlimit_install.jcl new file mode 100644 index 0000000..c39ca58 --- /dev/null +++ b/assist_no_instructionlimit_install.jcl @@ -0,0 +1,30566 @@ +//ASSIST$ JOB (SYS),'INSTALL ASSIST', +// CLASS=A,MSGCLASS=X,COND=(0,NE), +// USER=HERC01,PASSWORD=BARR +//* +//* ! ! ! DO NOT RENUMBER THIS JOBSTREAM ! ! ! +//* +//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +//* THIS JOB INSTALLS THE ASSIST LOAD MODULE. +//* STEP 1: THE SOURCE IS COPIED FROM INSTREAM STATEMENTS TO TWO +//* TEMPORARY DATASETS. +//* STEP 2: UPDATES ARE APPLIED TO THOSE DATASETS USING ADDITIONAL +//* INSTREAM STATEMENTS. IF YOU WISH TO MAKE CHANGES TO THE +//* INSTALLATION DEFAULTS, MAKE THEM TO THE STATEMENTS +//* FOLLOWING THE UPDATEA.SYSIN STATEMENT BELOW AND RE-SUBMIT +//* THE JOB. (THE SECOND SET OF UPDATES CORRECTS SOME +//* PROBLEMS WITH THE ORIGINAL SOURCE THAT SEEMS TO HAVE +//* ORIGINATED DURING TRANSMISSION AND/OR TRANSLATION. +//* STEP 3: THE UPDATED SOURCE IS ASSEMBLED AND LINK-EDITED INTO +//* SYS2.LINKLIB. IF YOU WISH TO USE A DIFFERENT LIBRARY, +//* CHANGE THE SINGLE INSTANCE WHERE SYS2.LINKLIB IS CODED +//* BELOW. +//* STEP 4: A SET OF MACROS IS ADDED TO SYS1.MACLIB THAT ARE REQUIRED +//* TO EXECUTE ASSIST. +//* STEP 5: A PROCEDURE TO INVOKE ASSIST IS ADDED TO SYS2.PROCLIB. IF +//* YOU WISH TO USE A DIFFERENT LIBRAYR, CHANGE THE SINGLE +//* INSTANCE WHERE SYS2.PROCLIB IS CODED BELOW. +//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +//* +//ASOURCE PROC +//* +//CREATEA EXEC PGM=IEBUPDTE,PARM=NEW +//SYSPRINT DD SYSOUT=* +//SYSUT2 DD DSN=&&ASSRCO1,UNIT=SYSDA,DISP=(,PASS), +// DCB=(DSORG=PS,RECFM=FB,LRECL=80,BLKSIZE=5600), +// SPACE=(TRK,(10,10)) +//* +//CREATEB EXEC PGM=IEBUPDTE,PARM=NEW +//SYSPRINT DD SYSOUT=* +//SYSUT2 DD DSN=&&ASSRCO2,UNIT=SYSDA,DISP=(,PASS), +// DCB=(DSORG=PS,RECFM=FB,LRECL=80,BLKSIZE=5600), +// SPACE=(TRK,(300,100)) +//* +//UPDATEA EXEC PGM=IEBUPDTE +//SYSPRINT DD SYSOUT=* +//SYSUT1 DD DSN=&&ASSRCO1,DISP=(OLD,DELETE) +//SYSUT2 DD DSN=&&ASSRCM1,UNIT=SYSDA,DISP=(,PASS), +// DCB=(DSORG=PS,RECFM=FB,LRECL=80,BLKSIZE=5600), +// SPACE=(TRK,(10,10)) +//* +//UPDATEB EXEC PGM=IEBUPDTE +//SYSPRINT DD SYSOUT=* +//SYSUT1 DD DSN=&&ASSRCO2,DISP=(OLD,DELETE) +//SYSUT2 DD DSN=&&ASSRCM2,UNIT=SYSDA,DISP=(,PASS), +// DCB=(DSORG=PS,RECFM=FB,LRECL=80,BLKSIZE=5600), +// SPACE=(TRK,(300,100)) +// PEND +//* +// EXEC ASOURCE +//* +//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +//* STEP 1 - COPY SOURCE TO TEMPORARY DATASETS FOR SUBSEQUENT INSTALL. +//* (DO NOT MAKE CHANGES TO THE STATEMENTS BELOW!) +//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +//* +//CREATEA.SYSIN DD * +./ ADD LIST=ALL + MACRO 00000100 + ASSYSGEN 00000150 +* 00000200 +* THIS IS THE FULL VERSION WITH EVERYTHING 00000250 +* 00000300 + GBLB &$ACCT =1 => ACCOUNT DISCRIMINATION POSSIBL 00000350 + GBLB &$ALIGN =0 -> NO BOUNDRY CHECK,=1 -> CHECKS 00000400 +* ==0: 360 ONLY(USED FOR 360 ONLY) 00000450 +* ==1:370 OR 360 ACTING AS 370'S 00000500 + GBLB &$ASMLVL =0==>DOS,=1==>OS 00000550 + GBLC &$BATCH LIMIT/DFLT: BATCH(DOS) - NOBATCH(OS) 00000600 + GBLA &$BLEN SET TO BUFFER LENGTH IN BYTES 00000650 + GBLC &$BTCC(4) BATCH CONTROL CARD ITEMS: SEE SETC'S J 00000700 + GBLA &$BUFNO THE NUMBER OF BUFFERS 00000750 + GBLB &$CMPRS =0 NO CMPRS CODE, =1 CMPRS OPTION 00000800 + GBLA &$COMNT >0 COMMENT CHECK (&$COMNT % REQ) 00000850 + GBLB &$DATARD =0 SOURCE,DATA THRU SYSIN ONLY(WATFV 00000900 +* =1 DATA MAY BE READ FROM FT05F001 00000950 +* (I.E.- SINGLE JOB PROCESSING-PSU) 00001000 + GBLB &$DEBUG 0==>DEBUG MODE, 1==> PRODUCTION MODE 00001050 + GBLB &$DECSA SHOULD ASSEMBLER PERMIT DECIMALS 00001100 + GBLB &$DECSM DOES MACHINE HAVE DECIMALS 00001150 + GBLB &$DECK =0 NO OBJ DECKS PUNCHED. =1 CAN DO 00001200 + GBLA &$DISKU 0 FOR NO DISK UTILITY 00001250 +* 1 FOR USER OPTION 00001300 +* 2 FOR ALWAYS DISK 00001350 + GBLB &$DMPAG =1 BEGIN DUMP ON NEW PAGE, 0=> NO J 00001400 + GBLC &$DSKUDV FOR DOS DISKU ONLY 00001450 + GBLA &$ERNUM # DIFFERENT ERROR MESSAGES 00001500 + GBLB &$EXINT EXTENDED INTERPRETER 1 = YES 0 = NO 00001550 + GBLB &$FLOTA SHOULD ASSEMBLER ALLOW FLOATING PT 00001600 + GBLB &$FLOTAX SHOULD ASSEMBLER ALLOW EXTENDED FP'S 00001650 + GBLB &$FLOTE =1==> WILL INTERPRET FLT,0==> (3 00001700 + GBLB &$FLOTEX =1==> WILL INTERPRET EX FP'S,0==> NO 00001750 + GBLB &$FLOTM =1==> MACHINE HAS FLTING PT,0==>NO 00001800 + GBLB &$FLOTMX =1==> MACHINE HAS FX FP'S,0==> NO 00001850 + GBLA &$FREE,&$FREEMN DEFAULT FREE=, MINIMUM FREE= (80A) J 00001900 + GBLC &$GENDAT GENERATATION DATE FOR THIS ASSIST 00001950 + GBLB &$HASPBT =1 HASP AUTOBATCH CODE SUPPORTED J 00002000 + GBLB &$HEXO =0=> NO HEXO =1=> XHEXO ALLOWED 00002050 + GBLB &$HEXI =0=> NO HEXI =1=> XHEXI ALLOWED 00002100 + GBLA &$IDF,&$IMX DRFAULT,MAXIMUM I= 00002150 + GBLC &$IOUNIT(8) DIFFERENT DDNAMES USED IN ASSIST 00002200 + GBLB &$JRM =1 FOR PSU LOCAL SPECIAL CODE: JRM 00002250 + GBLB &$KP26 =1 ALLOW KP=26 OR K&=29 OPTION 00002300 +* =0 ALLOW ONLY 029 KEYPUNCH CARDS 00002350 + GBLA &$LDF,&$LMX DEFAULT,MAX L= # LINES/PAGE 00002400 + GBLB &$MACOPC =1 => ALLOW OPEN CODE COND ASMBL 00002450 + GBLB &$MACROG =1 ==> ADD ASM G FEATURES TO ASM F 00002500 + GBLB &$MACROH =1 ==> ADD SOME ASM H FEATURES TO F 00002550 + GBLB &$MACROV OS/VS SUPPORT 00002600 + GBLB &$MACROS MACRO/CONDITIONAL ASSEMBLY ALLOWED 00002650 +* **NOTE** BASIC MACRO FACILITY IS ASSEMBLER F COMPATIBLE. 00002700 + GBLB &$MACSLB =1 ==> MACRO LIBRARY ALLOWED 00002750 + GBLC &$MCHNE SO CAN CHANGE SYSTEM TYPE 00002800 + GBLA &$MMACTR LOCAL ACTR INITIAL VALUE DEFAULT 00002850 + GBLA &$MMNEST MACRO NEST LIMIT DEFAULT 00002900 + GBLA &$MMSTMG GLOBAL MACRO STMT LIMIT DEFAULT 00002950 + GBLA &$MODEL MODEL NUMBER OF 360 BEING RUN ON 00003000 + GBLB &$OBJIN =0 CANNOT READ OBJECT DECK. =1 CAN 00003050 + GBLA &$OPTMS OPTIMIZE - 0==> MEMORY, 9==> SPEED 00003100 + GBLB &$PAGE =0 NO PAGE COINT/CONTROL CODE EXISTS 00003150 +* =1 PAGE CONTROL&OPTIONS ALLOWED 00003200 + GBLA &$PDF,&$PMX DEFAULT,MAX P= # PAGES LIMIT 00003250 + GBLA &$PDDF,&$PDMX DEFAULT,MAX PD= # PAGES SAVED FOR DP 00003300 + GBLB &$PRIVOP =0==>NO PRIV OPS, =1==> PRIV OPS OK 00003350 + GBLA &$PRTSIZ MAX # CHARS IN PRINT LINE FOR ASM J 00003400 + GBLB &$PUNCH =0 WE DON'T ACTUALLY HAVE CARD PUNCH 00003450 +* =1 REAL PUNCH EXISTS, POSSIBLE USED 00003500 + GBLA &$PXDF,&$PXMX DEFAULT,MAX PX= PAGES FOR EXECUTION 00003550 + GBLB &$P370 =1 WILL INTERPRET PRIVELEGED S/370 00003600 + GBLB &$P370A SHOULD ASSEMBLER PERMIT PRIV S/370'S 00003650 + GBLA &$RDF,&$RMX DEFAULT,MAX R= TOTAL # RECORDS 00003700 + GBLA &$RDDF,&$RDMX DEFAULT,MAX RD= RECORDS FOR DUMP 00003750 + GBLA &$RECORD =0,1=> NO $TIRC RECREM, =2=> $TIRC 00003800 + GBLB &$RECOVR (ONLY USED FOR &$RECORD=2). 00003850 +* =0 => R= DOES NOT OVERRIDE $TIRC VALUE, =1 => IT DOES. 00003900 +* (AT PSU, OUTPUT CAN GO TO BAT FILES - DON'T COUNT). 00003950 + GBLB &$RELOC =0==> NO RELOCATION CODE GENERATED 00004000 + GBLA &$REPL 0=> NO REPL,1=> LIMITED,2=> FULL 00004050 + GBLA &$RXDF,&$RXMX DEFAULT,MAX RD= RECORDS FOR EXECUTE 00004100 + GBLB &$SPECIO SPECIAL ROUTINES EXIST(TYPE=$IS+) 00004150 + GBLA &$SYHASH SIZE OF INITIAL PTR TABLE FOR SYMOPS 00004200 + GBLC &$SYSTEM SYSTEM BEGIN RUN - DOS,PCP,MFT,MVT 00004250 + GBLA &$S370 =0==> NO S/370 INSTR INTERPRETED 00004300 +* =1==> S/370 INSTR INTERPRETED ON 370 00004350 +* =2==> S/370 INSTR INTERPRETED ON 360 00004400 + GBLB &$S370A SHOULD ASSEMBLER PERMIT SYSTEM 370'S 00004450 + GBLC &$TDF,&$TMX DEFAULT,MAX T= TOTAL TIME FOR RUN 00004500 + GBLC &$TDDF,&$TDMX DEFAULT,MAX TD= TIME FOR DUMP 00004550 + GBLA &$TIMER 0==> NO TIMING AT ALL 00004600 +* 1==> STIMER/TTIMER ONLY. =2==> LOCAL TIMER FOR TIMREM 00004650 + GBLC &$TXDF,&$TXMX DEFAULT,MAX TX= TIME FOR EXECUTION 00004700 + GBLC &$VERSLV VERSION #.LEVEL # 00004750 + GBLB &$XIOS =0==>NO XIO MACROS,=1==>XIO MACROS 00004800 + GBLB &$XREF CONTROL GENERATION OF XREF FACILITYA 00004850 +* =1 FULL XREF, =0 NO XREF AT ALL A 00004900 + GBLA &$XREFDF(3) DEFAULT VALUES FOR FLAGS A 00004950 +* &$XREFDF(1)=0 NO XREF(OTHERS =3MEANS COMPRESSED LISTINGA 00005000 +* &$XREFDF(2)=3 COLLECT MODIFY AND FETCH DEFN A 00005050 +* &$XREFDF(3)=3 COLLECT REFERENCES MODIFY/FETCH A 00005100 + GBLA &$XREF#B NUMBER OF SLOTS FOR XREF BLKS A 00005150 + GBLB &$XXIOS =0 ALLOWS XGET AND XPUT 00005200 + GBLB &X$DDMOR =0 ALLOWS USER OWN DDNAMES 00005250 +** GLOBAL SET VARIABLES - INTERNAL TYPE - * 00005300 + GBLC &DEBUG DEBUG NUMBER FOR TESTING AVDEBUG 00005350 + GBLC &ID IDENT GENERATION CONTROL 00005400 + GBLC &TRACE SPECIFIES FORM OF TRACE-SNAP,*,NO 00005450 + SPACE 1 00005500 +&$ALIGN SETB 1 NEED BOUNDRY CHECKING 00005550 +&$BATCH SETC 'BATCH' DEFAULT VALUE IS BATCH RUNS 00005600 +&$BLEN SETA 3520 SET FOR HALF TRACK BUFFERS 00005650 +&$BLEN SETA 4*(&$BLEN/4) ROUND BLEN DOWN TO FULLWORD MULTIPLE 00005700 +&$BTCC(1) SETC '$' CONTROL CHARACTER FOR BATCH CARDS J 00005750 +&$BTCC(2) SETC 'JOB' JOB BEGINNING INDICATOR J 00005800 +&$BTCC(3) SETC 'ENTRY' BEGIN DATA CARD: SET = '' IF NONE NEEDEDJ 00005850 +&$BTCC(4) SETC 'STOP' TERMINATOR CARD: SET = '' IF NONE J 00005900 +&$BUFNO SETA 2 SET FOR 4 BUFFERS 00005950 +&$CMPRS SETB (1) ALLOW CMPRS OPTION 00006000 +&$COMNT SETA 80 REQUIRE 80% COMMENTS, IF COMNT OPT 00006050 +&$DATARD SETB (1) ALLOW SINGLE JOB/TWO RDRS 00006100 +&$DEBUG SETB (1) FOR QUICK RUN, KILL GENERATION 00006150 +&$DECK SETB (1) ALLOW OBJECT DECKS TO BE PUNCHED 00006200 +&$DECSA SETB (1) ASSEMBLER WILL ACCEPT DECIMAL INSTS 00006250 +&$DECSM SETB (1) PSU 360/67 HAS DECIMAL INSTRUCTIONS 00006300 +&$DISKU SETA 1 SET FOR USER OPTION ON DISK UTILITY 00006350 +&$DMPAG SETB 1 ASSUME COMPLETION DUMP ON NEW PAGE J 00006400 +&$DSKUDV SETC '2314' SET DEVICE FOR DOS DISKU CODE 00006450 +&$EXINT SETB 1 BIG OS GETS NEW INTERPRETER *** 00006500 +&$FLOTA SETB (1) ASSEMBLER ALLOWS FLOATING POINT 00006550 +&$FLOTAX SETB (1) ASSEMBLER ALLOWS EXTENDED F. P. 00006600 +&$FLOTE SETB (1) WE WILL EXECUTE FLTINGS,IF POSSIBLE 00006650 +&$FLOTEX SETB (1) WILL EXECUTE EXTENDED F. P., IF POSS 00006700 +&$FLOTM SETB (1) PSU 360/67 HAS FLOATING POINT 00006750 +&$FLOTMX SETB (1) PSU 360/67 HASN'T GOT EXTENDED F. P. 00006800 +&$FREE SETA 4096 NORMALLY RETURN 4K TO OS/360 00006850 +&$FREEMN SETA 2048 MINIMUM ALLOWED FREE=; *****NOTE J 00006900 +* IF YOU HAVE 80A ABEND'S OFTEN, RAISE THIS AS NEEDED*** J 00006950 +&$GENDAT SETC '04/28/75' CURRENT GENERATION DATE J 00007000 +&$HASPBT SETB 1 HASP BATCH ON 00007050 +&$HEXI SETB (1) XHEXI ALLOWED THIS ASSEMBLY 00007100 +&$HEXO SETB (1) XHEXO ALLOWED 00007150 +&$IDF SETA 150000 100 SECS ON /67 00007200 +&$IMX SETA 150000 100 SECS ON /67 00007250 +&$KP26 SETB (1) ALLOW 026 KEYPUNCH 00007300 +&$LDF SETA 63 DEFAULT 63 LINES/PAGE 00007350 +&$LMX SETA 63 MAXIMUM OF 63 LINES/PAGE 00007400 +* MACRO SETS: ONLY SIGNIFICANT IF &$MACROS=1. 00007450 +&$MACOPC SETB 1 OPEN CODE, COND ASSMBL WORKS 00007500 +&$MACROS SETB 1 ALLOW MACROS TO BE PROC ESSED 00007550 +&$MACROG SETB 0 NO ASM G CODE ***NOT SUPPORTED YET** 00007600 +&$MACROH SETB 0 NO ASM H CODE ***NOT SUPPORTED YET** 00007650 +&$MACROV SETB 0 NO OS/VS ASSEMBLER SUPPORT YET 00007700 +&$MACSLB SETB 1 ALLOW MACRO LIBRARY 00007750 +&$MCHNE SETC '370' MACHINE GENERATED ON 00007800 +&$MMACTR SETA 200 DEFAULT ACTR VALUE = 200 00007850 +&$MMNEST SETA 15 DEFAULT LIMIT OF 15 DEEP IN MACS 00007900 +&$MMSTMG SETA 4000 DEFAULT MAXIMUM TOTAL 4000 MAC STMTS 00007950 + SPACE 1 00008000 +&$MODEL SETA 65 DEFAULT MODEL NUMBER 00008050 +&$OBJIN SETB (1) ALLOW OBJECT DECKS TO BE READ 00008100 +&$OPTMS SETA 9 WE WANT SPEED OPTIMIZATION 00008150 +&$PAGE SETB (1) ALLOW ALL PAGE CONTROL OPTIONS 00008250 +&$PDF SETA 10 TEN TOTAL PAGES 00008300 +&$PMX SETA 25 MAXIMUM POSSIBLE OF 25 TOTAL 00008350 +&$PDDF SETA 1 NORMAL DUMP-JUST FIRST PAGE 00008400 +&$PDMX SETA 5 MAXIMUM OF 5 PAGES FOR THE DUMP 00008450 +&$PRIVOP SETB 1 ALLOW ALL PRIVILEGED OPERATIONS 00008500 +&$PRTSIZ SETA 121 LIMIT TO 121 CHARS AS DEFAULT LIM J 00008550 +&$PUNCH SETB (1) A REAL PUNCH EXISTS 00008600 +&$PXDF SETA 5 MAXIMUM PAGES FOR EXECUTION 00008650 +&$PXMX SETA 5 MAXIMUM MAXIMUM FOR EXECUTION 00008700 +&$RDF SETA 100000 DEFAULT RECORDS FOR EXEC 00008750 +&$RMX SETA 100000 MAX EXECUTION RECORDS 00008800 +&$RDDF SETA 25 DEFAULT RECORDS FOR A DUMP 00008850 +&$RDMX SETA 5000 MAXIMUM RECORDS FOR DUMP 00008900 +&$RECORD SETA 1 SHOW $TIRC RECREM CAN'T BE USED 00008950 +&$RELOC SETB (1) NEED RELOC SINCE WE HAVE REPL 00009000 +&$REPL SETA 2 COMPLETE REPLACEMENT ALLOWED 00009050 +&$RXDF SETA 10000 EXECUTION RECORDS 00009100 +&$RXMX SETA 10000 EXECUTION RECORDS 00009150 +&$SYSTEM SETC 'OS-MVT' SYSTEM IS OS OPTION MVT 00009200 +&$S370 SETA 2 PSY WANTS S/370'S ON 360/67 00009250 +&$S370A SETB (1) ASSEMBLER ALLOWS S/370'S 00009300 +&$TDDF SETC '.1' DEFAULT TIME FOR DUMP 00009350 +&$TDF SETC '100' SECONDS FOR EXECUTION 00009400 +&$TMX SETC '200' MAX POSSIBLE SECONDS FOR EXECUTION 00009450 +&$TDMX SETC '10' MAXIMUM TIME FOR A DUMP 00009500 +&$TIMER SETA 1 SHOW WE WANT OVERALL TIMING DONE 00009550 +&$TXDF SETC '100' MAX TIME FOR EXECUTION 00009600 +&$TXMX SETC '200' MAXIMUM MAXIMUM FOR EXECUTION 00009650 +&$VERSLV SETC '4.0/A' CURRENT ASSIST VERSION J 00009700 +&$XIOS SETB (1) WE'RE ALLOWING XIO MACROS 00009750 +&$XREF SETB 1 ALLOW CROSS REFERENCE 00009800 +&$XREFDF(1) SETA 0 NO XREF A 00009850 +&$XREFDF(2) SETA 3 COLLECT ALL MOD/FETCH DEFN A 00009900 +&$XREFDF(3) SETA 3 COLLECT ALL MOD/FETCH REFERENCES A 00009950 +&$XREF#B SETA 10 ALLOCATE 10 SLOTS/BLOCK A 00010000 +&$ASMLVL SETB ('&$SYSTEM'(1,2) EQ 'OS') SET LEVEL OF ASSEMBLER 00010050 +&$FLOTE SETB (&$FLOTE AND &$FLOTM) KILL GEN IF NO FLOATS 00010100 +&$FLOTEX SETB (&$FLOTEX AND &$FLOTMX) KILL GEN IF NO EXTENDED FLOATS 00010150 +&$HASPBT SETB (&$HASPBT AND &$ASMLVL) ELIM HASP IF NOT OS SYSTEM J 00010200 +&$MACSLB SETB (&$MACSLB AND &$MACROS) REMOVE LIBRARY IF NO MACROS J 00010250 +&$RELOC SETB (&$RELOC OR (&$REPL NE 0)) IF REPL, MAKE SURE RELOC J 00010300 +&ID SETC 'NO' SET NO ID FOR TIME BEING 00010350 + AIF (&$DEBUG).EQU1 LEAVE NO ID IF PRODUCTION PROG 00010400 +&ID SETC '*' DEBUG==> GENERATE ID'S AT ENTRIES 00010450 +.EQU1 ANOP 00010500 + AIF (&$ASMLVL).OSGEN SKIP IF OS GENERATION 00010550 +&$BATCH SETC 'BATCH' DEFAULT FOR DOS IS BATCH 00010560 +&$IOUNIT(1) SETC 'SYSIPT' SET DOS MAIN INPUT 00010600 +&$IOUNIT(2) SETC 'SYSRDR' SET DOS SECONDARY INPUT 00010650 +&$IOUNIT(3) SETC 'SYSLST' SET DOS PRINTER 00010700 +&$IOUNIT(4) SETC 'SYSPCH' SET DOS PUNCH 00010750 +&$IOUNIT(5) SETC 'SYS001' SET TO 'HRB' SCRATCH DEVICE 00010800 +&$BUFNO SETA 2 FOR DOS GEN INSURE ONLY 2 BUFFERS 00010850 +&$DSKUDV SETC '2314' SET DOS DISK DRIVE TYPE 00010900 + AGO .OSGEN1 00010950 +.OSGEN ANOP 00011000 +&$BATCH SETC 'NOBATCH' DEFAULT FOR OS IS NOBATCH 00011010 +&$IOUNIT(1) SETC 'SYSIN' SET OS PRIMARY INPUT 00011050 +&$IOUNIT(2) SETC 'FT05F001' SET OS SECONDARY INPUT 00011100 +&$IOUNIT(3) SETC 'FT06F001' SET OS PRINTER 00011150 +&$IOUNIT(4) SETC 'FT07F001' SET OS PUNCH 00011200 +&$IOUNIT(5) SETC 'FT08F001' SET OS DISK INTERMEDIATE 00011250 +&$IOUNIT(6) SETC 'SYSLIB' SET OS MACRO LIBRARY 00011300 +.OSGEN1 ANOP 00011350 + MEND 00011400 +//CREATEB.SYSIN DD * +./ ADD + PRINT ON,NOGEN 00000000 + TITLE 'ASSIST VERSION 4.0/A - MARCH 1975' 00001000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00001003 +* PENNSYLVANIA STATE UNIVERSITY COMPUTER SCIENCE DEPARTMENT * 00001005 +* PROJECT SUPERVISION: GRAHAM CAMPBELL * 00001010 +* PROGRAM DESIGN, CODING, DOCUMENTATION: JOHN R. MASHEY. * 00001020 +* DOS/360 CONVERSION, $SPIE, XXXXSPIE: SCOTT A. SMITH. * 00001030 +* * 00001035 +* PROGRAM WRITTEN BEGINNING SUMMER 1969. * 00001040 +* FIRST BATCH USAGE: SPRING TERM, 1970. * 00001050 +* FIRST USAGE ON STUDENT REMOTE TERMINALS: FALL TERM, 1970. * 00001060 +* FIRST DISTRIBUTION TO OTHER INSTALLATIONS: SUMMER 1971. * 00001070 +* FIRST DISTRIBUTION (DOS/360 VERSION) : FALL 1971. * 00001080 +* * 00001090 +* DISK UTILITY (DISKU) FACILITY (XXXXDK##, UTOPRS CHANGES): * 00001100 +* RICHARD FORD, PAUL WEISSER - SPRING 1972. * 00001110 +* XHEXI, XHEXO ADDITIONS: ALAN ARTZ - SPRING 1972. * 00001120 +* S/370 INSTRUCTIONS: CHARLES JOHNSON - SPRING 1972. * 00001130 +* MACRO PROCESSOR - GRAHAM CAMPBELL - SPRING, SUMMER 1972. * 00001140 +* LIBRARY MACRO FETCH AND PROCESSING: RICHARD FORD, SUMMER 1972* 00001150 +* IMPROVED MACRO PROCESSOR, OPEN CODE ALAN ARTZ, * 00001160 +* JOHN STERNBERGH - FALL,WINTER 1972 - 73 * 00001170 +* DOS DISK UTILITY - RICHARD FORD - WINTER 1973 * 00001180 +* EXTENDED I/O PACKAGE, XGET - XPUT - RICHARD FOWLER - * 00001190 +* FALL 1972 * 00001195 +* CROSS-REFERENCE- ALAN ARTZ, ALICE FELTE, RICH LONG - * 00001200 +* SPRING, SUMMER 1973. * 00001210 +* EXTENDED INTERPRETER- MARK DALTON, JOHN STERNBERGH, RICH * 00001220 +* LONG - SPRING, SUMMER, FALL 1973. * 00001230 +* DOCUMENTATION UPDATE- GLENN FADNER - FALL 1973, WINTER 1974. * 00001240 +* * 00001400 +* MANY THANKS TO SHELLY GEARHART FOR HELP WITH DISTRIBUTION * 00001410 +* MATERIALS. SPECIAL THANKS TO KAREN HOERTER (PSU CC PROGRAM * 00001420 +* LIBRARIAN)FOR HANDLING OF ASSIST TAPE DISTRIBUTION, AND FOR * 00001430 +* FACING MASSIVE PILE OF TAPES WITHOUT MOANING (TOO MUCH). * 00001440 +* * * * * NOTES ON DISTRIBUTION VERSIONS OF ASSIST * * * * * * * * * * 00001500 +* * 00001510 +* VERSION DATE AVAIL. COMMENTS * 00001520 +* * 00001530 +* 1.2/A1 09/01/71 ORIGINAL DISTRIBUTION VERSION * 00001540 +* * 00001550 +* 1.3/A 04/01/72 CONTAINS DOS/360 CODE, FIXES BUGS * 00001560 +* * 00001570 +* 2.0/A 08/72(APPROX) MACRO PROCESSOR, S/370, DISK OPTION* 00001580 +* FOR INTERMEDIATE STORAGE IF NEEDED.* 00001590 +* PREPARED BY: RICHARD FORD + JRM * 00001595 +* * 00001600 +* 2.1/A 02/01/73 OPEN CODE, DOS DISKU, XGET - XPUT * 00001610 +* PREPARED BY: ALAN ARTZ, ALICE FELTE + JRM * 00001620 +* * 00001630 +* 3.0/A 08/01/73 XREF, HASP AUTOBATCH, OVERLAYS * 00001640 +* PREPARED BY: RICH LONG + JRM * 00001650 +* * 00001651 +* 3.0/B 03/01/74 EXTENDED INTERPRETER,DOCUMENTATION * 00001652 +* UPDATES. * 00001653 +* PREPARED BY: MARK DALTON, GLENN FADNER, RICH LONG * 00001654 +* * 00001655 +* 4.0/A 3/01/75 CLEANS UP 3.0/B * 00001657 +* EXTENDED INTERP., ETC * 00001659 +* PREPARED BY THOMAS MINSKER * 00001661 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00001670 + TITLE '*** XCHAR MACRO - SAFE RIGHT-END SUBSTRING MACRO ***' 00002000 + MACRO 00004000 + XCHAR &STRING,&NUM 00006000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00008000 +.*--> MACRO: XCHAR RETURN SAFE RIGHT-END SUBSTRING OF A STRING. * 00009000 +.* JOHN R. MASHEY-JULY 1969-360/67* 00010000 +.* THIS MACRO RETURNS IN &XXCHAR THE &NUM CHARACTERS TAKEN FROM * 00012000 +.* THE RIGHT END OF THE CHARACTER STRING &STRING, WITHOUT * 00014000 +.* BLOWING UP IF THERE ARE LESS THAN &NUM CHARS IN &STRING. * 00016000 +.* THIS MACRO IS USED BY XSAVE,XRETURN, AND XSRNR * 00018000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00020000 + GBLC &XXCHAR RETURN RESULT IN THIS 00022000 + AIF (&NUM GT K'&STRING).XGA SKIP IF HE WANTS MORE 00024000 +&XXCHAR SETC '&STRING'(K'&STRING+1-&NUM,&NUM) SCOOP RIGHT AMT 00026000 + MEXIT 00028000 +.XGA ANOP 00030000 +&XXCHAR SETC '&STRING' STRING SMALLER-USE WHOLE THING 00032000 + MEND 00034000 + TITLE 'XDECI MACRO - EXTENDED DECIMAL INPUT CONVERSION' 00034020 + MACRO 00034040 +&LABEL XDECI ®,&ADDRESS 00034060 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00034065 +.*-->MACRO: XDECI EXTENDED DECIMAL INPUT CONVERSION * 00034070 +.*--> MACRO: XDECI EXTENDED DECIMAL INPUT CONVERSION * * * * * * * 00034080 +.* EXTENDED DECIMAL INPUT MACRO - ENABLES PROGRAMS * 00034100 +.* WRITTEN FOR ASSIST TO BE RUN UNDER OS/360 DIRECTLY. * 00034120 +.* USES MODULE XXXXDECI TO SCAN DECIMAL STRING BEGINNING AT * 00034140 +.* &ADDRESS, CONVERT ITS VALUE INTO REGISTER ®, AND SET * 00034160 +.* REGISTER R1 AS A SCAN POINTER TO THE DELIMITER FOLLOWING THE * 00034180 +.* STRING OF DECIMAL DIGITS. THE CONDITION CODE IS SET BY THE * 00034200 +.* VALUE IN ®, UNLESS AN ERROR OCCURRS, IN WHICH CASE CC=3. * 00034220 +.* SEE ASSIST USER MANUAL FOR USAGE INSTRUCTIONS. * 00034240 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00034260 + LCLC &XLABL FOR CREATION OF LABEL 00034280 +&XLABL SETC 'XX&SYSNDX.E' CREATE UNIQUE LABEL 00034300 + CNOP 2,4 . LINE UP ON BOUNDARY 00034320 +&LABEL STM 14,1,&XLABL . SAVE LINKAGE REGS 00034340 + LA 0,&ADDRESS . BEGINNING @ FOR SCANNING 00034360 + L 15,&XLABL-4 . GET ADCON FOR CONVERSION 00034380 + BALR 14,15 . CALL ROUTINE, PT WITH R14 00034400 + DC V(XXXXDECI) . ADCON FOR CONVERSION ROUTINE 00034420 +&XLABL DS 5F . REGS 14,15,0,1, VALUE FOR ® 00034440 + LM 14,1,4(14) . RELOAD REGS 00034460 + BO *+8 . BRANCH IF ® SHOULDN'T CHANGE 00034480 + L ®,&XLABL+16 . GET VALUE FOR ® 00034500 + AIF (T'® EQ 'N' AND '®' NE '1').XXEXIT SKIP IF SAFE 00034520 + L 1,&XLABL+12 . USER MAY HAVE REG=1, LOAD FOR SAFE 00034540 +.XXEXIT MEND 00034560 + TITLE 'XDECO MACRO - EXTENDED DECIMAL OUTPUT CONVERSION' 00034580 + MACRO 00034600 +&LABEL XDECO ®,&ADDRESS 00034620 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00034630 +.*--> MACRO: XDECO EXTENDED DECIMAL OUTPUT CONVERSION * 00034640 +.* USES MODULE XXXXDECO TO CONVERT VALUE IN REGISTER ® TO * 00034660 +.* AN EDITED 12-BYTE FIELD, WITH SIGN, AT LOCATION &ADDRESS. * 00034680 +.* EXTENDED DECIMAL OUTPUT MACRO - ENABLES PROGRAMS * 00034700 +.* WRITTEN FOR ASSIST TO BE RUN UNDER OS/360 DIRECTLY. * 00034720 +.* SEE ASSIST USER MANUAL FOR USAGE INSTRUCTIONS. * 00034740 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00034760 + LCLC &XLABL FOR CREATION OF UNIQUE LABEL 00034780 +&XLABL SETC 'XX&SYSNDX.D' CREATE UNIQUE LABEL 00034800 + CNOP 2,4 . LINE UP ON RIGHT BOUNDARY 00034820 +&LABEL STM 14,0,&XLABL . STORE LINKAGE REGS 00034840 + ST ®,&XLABL+12 . SAVE VALUE TO BE CONVERTED 00034860 + LA 0,&ADDRESS . OBTAIN @ OPERAND FILED 00034880 + L 15,&XLABL-4 . GET ADCON FOR CONVERSION PROG 00034900 + BALR 14,15 . CALL XXXXDECO, PT R14 00034920 + DC V(XXXXDECO) . ADCON FOR CONVERSION PROG 00034940 +&XLABL DS 4F . REGS 14,15,0, REG TO BE CONVERTED 00034960 + LM 14,0,4(14) . RELOAD LINKAGE REGISTERS 00034980 + MEND 00035000 + TITLE 'MACRO-->XHEXI EXTENDED HEXADECIMAL CONVERSION' 00035050 + MACRO 00035060 +&NAME XHEXI ®,&ADDR 00035070 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00035075 +.*-->MACRO: XHEXI HEXADECIMAL INPUT CONVERSION MACRO. * 00035080 +.* WRITTEN BY ALAN ARTZ 4/17/72 * 00035090 +.* THIS MACRO TAKES THE VALUE STARTING AT THE ADDRESS GIVEN BY * 00035100 +.* &ADDR AND CONVERTS IT AND PUTS THE HEXADECIMAL VALUE IN ®. * 00035110 +.* IF THERE ARE MORE THAN 8 DIGITS, R1 POINTS TO THE 9TH AND THE * 00035120 +.* FIRST 8 ARE CONVERTED. IF THERE IS A NON-BLANK, NON-HEX DIGIT * 00035130 +.* FOUND, R1 POINTS TO THAT CHARACTER AND THE CC=3, OTHERWISE CC SET * 00035140 +.* BY VALUE IN REG. * 00035150 +.* * 00035160 +.* CALLS MODULE XXXXHEXI TO DO THE ACTUAL CONVERSIONS * 00035170 +.* * 00035171 +.* SEE ASSIST USER MANUAL FOR USAGE INSTRUCTIONS. * 00035172 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00035180 + LCLC &LABEL 00035190 +&LABEL SETC 'XX&SYSNDX.H' UNIQUE LABEL 00035200 +&NAME STM 14,0,&LABEL . SAVE REGISTERS 00035210 + ST ®,&LABEL+12 . REGISTER STORE INCASE OF OVERFLOW CND 00035220 + LA 0,&ADDR . GET STRING TO BE CONVERTED 00035230 + CNOP 2,4 . GET PROPER ALIGNMENT 00035240 + L 15,&LABEL-4 . ADDRESS OF XXXXHEXI 00035250 + BALR 14,15 . GO TO APPROPRIATE PLACE 00035260 + DC V(XXXXHEXI) . VCON OF ROUTINE 00035270 +&LABEL DS 4F . STORAGE FOR REGISTERS 00035280 + LM 14,0,4(14) . RESTORE REGISTERS 00035290 + L ®,&LABEL+12 . GET CONVERTED NUMBER 00035300 + MEND 00035310 + TITLE 'MACRO-->XHEXO EXTENDED HEXADECIMAL CONVERSION' 00035320 + MACRO 00035330 +&NAME XHEXO ®,&ADDR 00035340 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00035355 +.*-->MACRO: XHEXO HEXADECIMAL OUTPUT CONVERSION MACRO * 00035360 +.* WRITTEN BY ALAN ARTZ 4/17/72 * 00035370 +.* THIS MACRO TAKES THE VALUE IN ® AND CONVERTS IT TO * 00035380 +.* PRINTABLE FORM. * 00035390 +.* IT PUTS THE CONVERTED VALUE IN AN EIGHT BYTE AREA STARTING AT* 00035400 +.* THE ADDRESS GIVEN IN &ADDR. * 00035410 +.* THE CC AND REGISTERS ARE LEFT UNCHANGED. * 00035420 +.* * 00035430 +.* CALLS MODULE XXXXHEXO TO DO THE ACTUAL CONVERSIONS. * 00035440 +.* * 00035444 +.* SEE ASSIST USER MANUAL FOR USAGE INSTRUCTIONS. * 00035445 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00035450 + LCLC &LABEL 00035455 +&LABEL SETC 'XX&SYSNDX.H' UNIQUE LABEL 00035460 +&NAME DS 0H 00035470 + STM 14,0,&LABEL . SAVE REGISTERS 00035480 + ST ®,&LABEL+12 . SAVE ® 00035490 + LA 0,&ADDR . PASS REGISTER TO XXXXHEXO 00035500 + CNOP 2,4 . GET PROPER ALIGNMENT 00035510 + L 15,&LABEL-4 . ADDRESS OF XXXXHEXO 00035520 + BALR 14,15 . CALL XXXXHEXO 00035530 + DC V(XXXXHEXO) 00035540 +&LABEL DS 4F . STORAGE FOR REGISTERS 00035550 + LM 14,0,&LABEL . RESTORE REGISTERS 00035560 + MEND 00035570 + TITLE '*** XIDENT MACRO - CREATE ID FOR XSAVE MACRO ***' 00036000 + MACRO 00038000 + XIDENT &ID,&LABEL,&XCSECT,&PRIVATE 00040000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00041000 +.*--> MACRO: XIDENT IDENTIFY ENTRY POINT FOR XSAVE,$SAVE. * 00041500 +.* MACRO USED BY XSAVE TO PRODUCE ID AT AN ENTRY POINT. WILL * 00042000 +.* USE THE FIRST NON-NULL OPERAND PASSED TO IT AS THE ID. * 00044000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00045000 + LCLA &I,&J LOCAL COUNTERS 00046000 +&I SETA 1 INITIALIZE 00048000 + AIF ('&ID' NE '*').XIDINC SKIP IF EXPLICIT ID FIELD 00050000 +.XILOOP ANOP 00052000 +&I SETA &I+1 INCREMENT TO NEXT ONE 00054000 + AIF ('&SYSLIST(&I)' EQ '').XILOOP SKIP BACK IF THIS IS NULL 00056000 +.XIDINC ANOP 00058000 +&J SETA 6+((K'&SYSLIST(&I)+1)/2)*2 GET BRANCH LENGTH 00060000 + B &J.(,15) . BRANCH AROUND ID 00062000 +&J SETA &J-5 GET ACTUAL LENGTH OF ID 00064000 + DC AL1(&J),CL&J'&SYSLIST(&I)' 00066000 + MEND 00068000 + TITLE ' *** XIONR-INNER MACRO FOR XREAD,XPRNT,XPNCH ***' 00070000 + MACRO 00072000 +&XLABEL XIONR &XNAME,&XNUM,&XAREA,&XDEFT 00074000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00076000 +.*--> MACRO: XIONR INNER MACRO-$READ,$PNCH,$PRNT,$SORC * 00077000 +.* ALSO XGET,XPUT,$GET,AND$PUT * 00077500 +.* JOHN R. MASHEY - FEB 1970 - V.4.0 * 00078000 +.* XIONR IS USED BY XIOPAK MACROS XREAD,XPRNT,XPNCH TO SET UP * 00080000 +.* THE REQUIRED CODE FOR CALLING THEIR RESPECTIVE SUBROUTINES. * 00082000 +.* *** ARGUMENTS *** * 00084000 +.* XNAME THE NAME OF THE I/O ROUTINE TO BE CALLED. * 00086000 +.* XNUM THE LENGTH OF XAREA TO BE PRINTED,PUNCHED,ETC. * 00088000 +.* XAREA THE AREA ON WHICH I/O OPERATION TO BE PERFORMED. * 00090000 +.* MAY BE SPECIFIED BY (0) OR (R0). * 00092000 +.* XDEFT DEFAULT VALUE OF XNUM TO BE USED, IF IT IS OMITTED * 00094000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00096000 + AIF (T'&XAREA EQ 'O').XERR1 PRODUCE MNOTE 00098000 +&XLABEL STM 14,0,XX&SYSNDX.R+4 . SAVE REGS WHICH WILL BE CHANGED 00100000 + AIF (T'&XNUM EQ 'O').XN1 SKIP NEXT CHECK IF OMITTED 00102000 + AIF ('&XNUM'(1,1) NE '(' OR '&XNUM'(K'&XNUM,1) NE ')').XN1 00104000 + STH &XNUM,XX&SYSNDX.R+16 . STORE LENGTH 00106000 +.XN1 AIF ('&XAREA' EQ '(0)' OR '&XAREA' EQ '(R0)').XNOLA 00108000 +.XN2 LA 0,&XAREA 00110000 +.XNOLA L 15,XX&SYSNDX.R . GET BRANCH ADDRESS 00112000 + CNOP 2,4 . ADJUST FOR RIGHT ALIGNEMNT 00114000 + BALR 14,15 . CALL ROUTINE, R14==> CONTROL BLOCK 00116000 +XX&SYSNDX.R DC V(&XNAME) . ROUTINE ADDRESS 00118000 + DS 3F . SAVE SPACE FOR REGS 14-0 00120000 + AIF ('&XNUM' EQ '').XDFT SKIP IF DEFAULT SHOULD BE 00122000 + DC AL2(&XNUM) . LENGTH OF AREA 00124000 + AGO .XDS SKIP 00126000 +.XDFT DC AL2(&XDEFT) . DEFAULT LENGTH USED 00128000 +.XDS LM 14,0,4(14) . RESTORE REGS. CON CODE ALREADY DONE 00130000 + MEXIT 00132000 +.XERR1 MNOTE 0,'**XIONR- AREA ADDRESS OMITTED-GENERATION CANCELLED' 00134000 + MEND 00136000 + TITLE '*** XLOOK MACRO - LOOK UP ELEMENT IN LIST ***' 00138000 + MACRO 00140000 + XLOOK &ARG1,&ARGL 00142000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00144000 +.*--> MACRO: XLOOK FIND POSITION OF ELEMENT IN LIST. * 00145000 +.* JOHN R. MASHEY - FEB 1970 - V.4.0 * 00146000 +.* MACRO TO FIND AND RETURN POSTION OF ARGUMENT IN A SUBLIST. * 00148000 +.* &ARG1 ARGUMENT TO BE SEARCHED FOR * 00150000 +.* &ARGL LIST OF ARGUMENTS FOR &ARG1 TO BE CHECKED FOR IN * 00152000 +.* &XXLOOK THE FIRST POSITION IN &ARGL IN WHICH &ARG1 IS * 00154000 +.* FOUND, IF ANY. IF &ARG1 IS NOT IN &ARGL, &XXLOOK = 0. * 00156000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00158000 + GBLA &XXLOOK FOR RETURN OF INDEX VALUE 00160000 +&XXLOOK SETA 1 INITIALIZE THE COUNTER 00162000 +.XLA AIF (&XXLOOK GT N'&ARGL).XLB IF GT,QUIT,NOT FOUND 00164000 + AIF ('&ARG1' EQ '&ARGL(&XXLOOK)').XXEXIT IF FOUND,RETURN 00166000 +&XXLOOK SETA &XXLOOK+1 INCREMENT COUNTER 00168000 + AGO .XLA GO BACK FOR NEXT CHECK 00170000 +.XLB ANOP 00172000 +&XXLOOK SETA 0 NOT FOUND, SET TO 0 TO SHOW THIS 00174000 +.XXEXIT MEND 00176000 + TITLE ' *** XMUSE - INNER MACRO FOR XSAVE-MULTIPLE USING ***' 00178000 + MACRO 00180000 + XMUSE &BR,&AD 00182000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00184000 +.*--> MACRO: XMUSE BASE REGISTER SETUP MACRO FOR XSAVE * 00185000 +.* JOHN R. MASHEY - FEB 1970 - V.4.0 * 00186000 +.* THIS MACRO IS CALLED BY XSAVE TO HANDLE BR AND AD OPERANDS, * 00188000 +.* AND PRODUCE APPROPRIATE USINGS. &BR AND &AD ARE FROM XSAVE. * 00190000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00192000 + LCLA &I,&N LOCAL COUNTERS 00194000 + LCLC &B(4),&V BASE REGS, USING NAME 00196000 +&N SETA N'&BR GET NUMBER WHERE HANDY 00198000 +&V SETC '*' NORMAL USE 00200000 + AIF (&N LE 4).XNOKA MAKE SURE NOT TOO MANY BASES 00202000 +&N SETA 4 IDIOT USER HAD >4 BASES, IGNORE EXTR 00204000 + MNOTE 4,'**XMUSE- MORE THAN 4 BASE REGS-EXTRAS IGNORED' 00206000 +.XNOKA AIF ('&AD' EQ '').X1LOOP SKIP IF NORMAL SITUATION 00208000 +.* USED IF AD PARAMATER WAS SPECIFIED IN XSAVE MACRO. * 00210000 + CNOP 0,4 00212000 + B *+8 . SKIP AROUND ADDRESS CONSTANT 00214000 + DC A(&AD) . ADDRESS CONSTANT FOR AD=PARAMETER 00216000 + L &BR(1),*-4 . LOAD ADCON INTO RIGHT REGISTER 00218000 +&V SETC '&AD' CHANGE NAME FOR USING 1ST OPERND 00220000 +.* NORMAL SECTION OF CODE FOR GENERATING USING. * 00222000 +.X1LOOP ANOP 00224000 +&I SETA &I+1 INCREMENT COUNTER TO BASE REG 00226000 +&B(&I) SETC ',&BR(&I)' GET I'TH BASE REGISTER 00228000 + AIF (&I LT &N).X1LOOP CONTINUE UNTIL ALL BASE REGS DONE 00230000 + DROP 15 . CLEAN UP USING SITUATION 00232000 + USING &V&B(1)&B(2)&B(3)&B(4) 00234000 + MEND 00236000 + TITLE '*** XRETURN MACRO - EXTENDED RETURN MACRO ***' 00332000 + MACRO 00334000 +&LABEL XRETURN &RGS=(14-12),&SA=,&RC=,&RP=,&T=,&TR=*,&REEN= 00336000 +.** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00338000 +.*--> MACRO: XRETURN GENERAL RETURN MACRO, OS LINKAGE * 00339000 +.* JOHN R. MASHEY - FEB 1970 - V.4.0 * 00340000 +.* EXTENDED RETURN MACRO - SEE PSU CC WRITEUP - XSAVE/XRETURN * 00342000 +.* FOR EXPLANATION AND USE OF OPERANDS. * 00344000 +.* USES MACROS: FREEMAIN,XCHAR,XSRNR * 00346000 +.** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00350000 + GBLB &XRETUST =0 TRACE GENERATION OK, =1 NO TRACE 00352000 + GBLC &XSAVE,&XXCHAR STD SAVE AREA NAME, XCHAR VARIABLE 00354000 + LCLA &I LOCAL COUNTER 00356000 + LCLB &RCA,&RCB FOR CONTROL OF RETURN CODE GENER 00358000 +.* * 00360000 +.* GENERATE LABEL IF THERE IS ONE, GENERATE TRACE CODE IF IT * 00362000 +.* IF DESIRED, AND SET UP LCLB VARIABLES TO DESCRIBE RETURN * 00364000 +.* CODE CONDITIONS. GENERATE LR IF NEEDED FOR RC OPTION. * 00366000 +.* * 00368000 + SPACE 1 00370000 + AIF (T'&LABEL EQ 'O').XNOLB SKIP IF NO LABEL USED 00372000 +&LABEL DS 0H . DEFINE LABEL 00374000 +.XNOLB AIF ('&TR' EQ 'NO' OR &XRETUST).XNORT SKIP IF NO TRACE 00376000 + XSRTR &TR,&LABEL,EXITED GET TRACE GENERATED 00378000 +.XNORT ANOP 00380000 +&RCA SETB (T'&RC EQ 'O') TRUE IF WHOLE THING OMITTED 00382000 +&RCB SETB (1) SET THIS WAY FOR NEXT TEST 00384000 + AIF (&RCA).XNRCB SKIP IMMEDIATELY IF OMITTED 00386000 +&RCB SETB ('&RC'(1,1) NE '(' OR '&RC'(K'&RC,1) NE ')') NOT RG TYP 00388000 + AIF (&RCB).XNRCB SKIP IF NOT REGISTER TYPE 00390000 + XCHAR &RC,3 GET LAST 3 CHARS 00392000 + AIF ('&XXCHAR' EQ '15)').XNRCB SKIP IF ALREADY IN 15 00394000 + LR 15,&RC . LOAD RETURN CODE FROM DESIRED REG 00396000 +.XNRCB AIF (T'&REEN EQ 'O').XNORM SKIP IF NOT REENTRANT 00398000 +.* * 00400000 +.* REENTRANT RETURN CODE GENERATION - OBTAIN ADDRESS AND LENGTH * 00402000 +.* OF AREA FROM WHERE XSAVE PUT THEM,DO FREEMAIN,FIXUP REGS. * 00404000 +.* * 00406000 + AIF ('&TR' EQ 'NO' OR &XRETUST).XGOK MAKE SURE REENT 00408000 + MNOTE 0,'**XRETURN- TR OPTION IMPLIES NON-REENTRANT CODE' 00410000 +.XGOK L 13,4(13) . GET OLD SA POINTER BACK 00412000 + STM 15,1,16(13) . SAVE REGS FROM FREEMAIN CRUNCHING 00414000 + L 1,8(13) . GET ADDRESS OF AREA BACK 00416000 +* FREEMAIN R,LV=8*((&REEN+79)/8),A=(1) FREE STORAGE 00418000 + FREEMAIN R,LV=8*((&REEN+79)/8),A=(1) FREE STORAGE 00420000 + LM 15,1,16(13) . RESTORE THE REGS 00422000 + AGO .XNORM1 GO TO PROCESS REGISTER RESTORATION 00424000 +.XNORM AIF ('&SA' EQ 'NO').XNORM1 SKIP RESTORATION IF UNUSED 00426000 +.* * 00428000 +.* REGISTER RESTORATION CODE - RESTORE REGS FROM CALLER'S * 00430000 +.* SAVE AREA,DEPENDING ON RETURN CODE AND FUNCTION OPTIONS. * 00432000 +.* * 00434000 + L 13,4(13) . RESTORE PREVIOUS SAVE AREA POINT 00436000 +.XNORM1 AIF ('&RGS' EQ 'NO').XNORM2A SKIP IF NO REGS NEEDED 00438000 + AIF ('&RGS' NE '(14-12)' OR NOT &RCB).XNORM2 00440000 + LM 14,12,12(13) . STANDARD REGISTER RESTORATION 00442000 + AGO .XNORM2A CONTINUE 00444000 +.XNORM2 ANOP 00446000 +&I SETA &I+1 INCREMENT COUNTER 00448000 + XSRNR L,&RGS(&I),&RCB HAVE RESTORE CODE GENRATED 00450000 + AIF (&I LT N'&RGS).XNORM2 LOOP UNTIL DONE 00452000 +.* * 00454000 +.* RETURN CODE(15) AND RETURN PAST(14) CODE GENERATION. * 00456000 +.* * 00458000 +.XNORM2A AIF (&RCA OR NOT &RCB).XNORM3 SKIP IF NOT LA TYPE RC= 00460000 + LA 15,&RC . PUT RETURN CODE IN 15 00462000 +.XNORM3 AIF ('&T' NE '*').XNORM4 SEE IF MVI WANTED 00464000 + MVI 12(13),X'FF' . SHOW WE HAVE RETURNED 00466000 +.XNORM4 AIF (T'&RP EQ 'O').XNORP SKIP IF RP NOT USED 00468000 + B &RP.(14) . RETURN GIVEN NUMBER PAST 14 00470000 + AGO .XNORM5 00472000 +.XNORP BR 14 . RETURN NORMALLY TO CALLER 00474000 +.* * 00476000 +.* SAVE AREA GENERATION - IF A SAVE AREA SHOULD BE CREATED, * 00478000 +.* USE EITHER ONE SPECIFIED BY MACRO,OR ELSE STANDARD ONE. * 00480000 +.* * 00482000 +.XNORM5 AIF (T'&SA EQ 'O' OR '&SA' EQ 'NO').XEXIT SKIP IF NO SAV5 00484000 + AIF ('&SA' EQ '*').XSASTD IF *,USE STANDARD SAVE 00486000 +&SA DC 18F'0' . SAVE AREA,NAMED BY MACRO 00488000 + AGO .XEXIT 00490000 +.XSASTD ANOP 00492000 +&XSAVE DC 18F'0' . SAVE AREA,USING GENERATED NAME 00494000 +.XEXIT SPACE 1 00496000 + MEND 00498000 + TITLE '*** XSAVE - EXTENDED SAVE MACRO ***' 00500000 + MACRO 00502000 +&LABEL XSAVE &RGS=(14-12),&BR=12,&SA=*,&ID=*,&TR=*,&REEN=,&OPT=,&AD= 00504000 +.** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00506000 +.*--> MACRO: XSAVE EXTENDED SAVE MACRO - OS LINKAGE. * 00507000 +.* JOHN R. MASHEY - FEB 1970 - V.4.0 * 00508000 +.* EXTENDED SAVE MACRO - SEE PSU CC WRITEUP - XSAVE/XRETURN * 00510000 +.* FOR DESCRIPTION OF ARGUMENTS FOR THIS MACRO * 00512000 +.* USES MACROS: GETMAIN,XCHAR,XIDENT,XLOOK,XMUSE,XSRNT,XSRTR * 00514000 +.** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00518000 + GBLA &XXLOOK RETURN VARIABLE FROM XLOOK MACRO 00520000 + GBLB &XSAVEST =0 TRACE GEN OK, =1 NO TRACE DONE 00522000 + GBLC &XSAVE,&XCSECT,&XXCHAR STD NAME,CSECT NAME,XCHAR VAR 00524000 + LCLA &I LOCAL COUNTER 00526000 + LCLB &XNSECT FLAG FOR NEW CSECT 00528000 + LCLC &B1,&BT 1ST BASE,LAST 2 CHARS OF 1ST BASE 00530000 +&B1 SETC '&BR(1)' GET FIRST OR ONLY BASE IN EASIER NAM 00532000 + XCHAR &B1,2 GET LAST 2 CHARS OF BASE REG 00534000 +&BT SETC '&XXCHAR' GET LAST 2 CHARACTERS 00536000 +&XNSECT SETB ('&SYSECT' NE '&XCSECT') NOTE IF NEW CSECT NEEDED 00538000 +&XCSECT SETC '&SYSECT' SET TO SYSECT, FOR NORMAL USE 00540000 +.* * 00542000 +.* CHECK OPT FIELD - GENERATE TITLE AND/OR ENTRY OR CSECT * 00544000 +.* STATEMENTS, DEPENDING ON CONTENTS OF OPT FIELD, IF USED. * 00546000 +.* * 00548000 + AIF (T'&OPT EQ 'O').XNOPS SKIP IF OPT UNUSED 00550000 + XLOOK TITLE,&OPT WAS TITLE OPTION USED 00552000 + AIF (&XXLOOK EQ 0).XNTITL SKIP IF TITLE NOT USED 00554000 + AIF (N'&OPT EQ 1).XNOPS SKIP IF TITLE ONLY 00556000 + TITLE '*** &LABEL ***' 00558000 +.XNTITL XLOOK ENTRY,&OPT WAS ENTRY USED 00560000 + AIF (&XXLOOK EQ 0).XTRCS SKIP IF NOT USED 00562000 + AIF ('&LABEL' EQ '').XENTE SKIP TO ERR IF NO LABEL 00564000 + ENTRY &LABEL . NOTE XSAVE ENTRY OPTION 00566000 + AGO .XNOPS 00568000 +.XENTE MNOTE 4,'**XSAVE- OPT=ENTRY USED WITHOUT LABEL-OPTION IGNORED' 00570000 + AGO .XNOPS 00572000 +.XTRCS XLOOK CSECT,&OPT CHECK FOR CSECT OPTION 00574000 + AIF (&XXLOOK EQ 0).XTRCS1 SKIP IF OPTION NOT THERE 00576000 +&LABEL CSECT 00578000 +&XCSECT SETC '&LABEL' SET THIS TO SHOW NEW CSECT 00580000 +&XNSECT SETB (1) NOTE THAT NEW CSECT IS NEEDED 00582000 + AGO .XENT1 SKIP OVER &LABEL DEFN 00584000 +.XTRCS1 MNOTE 0,'**XSAVE- UNKNOWN OPT=&OPT- IGNORED' 00586000 +.* * 00588000 +.* CREATE STATMENT LABEL IF ANY. IF IDENTIFIER REQUESTED,USE * 00590000 +.* SPECIFIED IDENTIFIER,STATEMENT LABEL,OR CSECT NAME IN XIDENT * 00592000 +.* TO GENERATE CORRECT IDENTIFIER WITH BRANCH AROUND IT. * 00594000 +.* * 00596000 +.XNOPS SPACE 2 00598000 +&LABEL DS 0H . DEFINE LABEL,MAKE SURE ALIGNED 00600000 +.XENT1 USING *,15 . FOR TEMPORARY ADDRESSIBILITY 00602000 + AIF ('&SA' EQ '*' OR '&SA' EQ 'NO').XCHKS1 SKIP IF NO CHANGE 00604000 +&XSAVE SETC '&SA' EXPLICIT NEW SAVE AREA NAME 00606000 + AGO .XSAOK 00608000 +.XCHKS1 AIF ('&XSAVE' NE '').XCHKS2 SKIP IF NOT NULL 00610000 +&XSAVE SETC '$PR#&SYSNDX' SET UP DEFAULT SAVE AREA NAME 00612000 + AGO .XSAOK 00614000 +.XCHKS2 AIF (NOT &XNSECT).XSAOK SKIP IF NEW SAVE NOT NEEDED 00616000 +&XSAVE SETC '&XCSECT'(1,3).'#&SYSNDX' DEFAULT SAVE AREA NAME 00618000 +.* * 00620000 +.XSAOK AIF ('&ID' EQ 'NO').XID3 SKIP IF NO ID WANTED 00622000 + XIDENT &ID,&LABEL,&XCSECT,$PRIVATE CALL TO SET UP IDENT 00624000 +.* * 00626000 +.* IF TR OPTION IN EFFECT, CALL XSRTR TO GENERATE RIGHT CODE, * 00628000 +.* THEN HAVE XSRNR GENERATE CODE TO SAVE RANGES OF REGISTERS * 00630000 +.* * 00632000 +.XID3 AIF (&XSAVEST OR '&TR' EQ 'NO').XNOTR SKIP IF NO TRACE 00634000 + XSRTR &TR,&LABEL,ENTERED GET TRACE GENERATED 00636000 +.XNOTR AIF ('&RGS' NE '(14-12)').XSRCAL SKIP IF NOT STANDARD 00638000 + STM 14,12,12(13) . SAVE STANDARD REGISTER SET 00640000 + AGO .XCHK13 00642000 +.XSRCAL AIF ('&RGS' EQ 'NO').XCHK13 SKIP IF NO REGS SAVED 00644000 +&I SETA 1 INITIALIZE COUNTER 00646000 +.XSETUP XSRNR ST,&RGS(&I) CALL XSRNR WITH EACH REG SET 00648000 +&I SETA &I+1 INCREMENT TO NEXT REGS SET 00650000 + AIF (&I LE N'&RGS).XSETUP CONTINUE PROCESSING RGS 00652000 +.XCHK13 AIF ('&BT' NE '13').XNORM1 NOT REG 13,DO NORMALLY 00654000 +.* * 00656000 +.* REGISTER 13 DOUBLE USAGE - THIS SECTION GENERATES CODE TO * 00658000 +.* USE REGISTER 13 BOTH AS A BASE AND AS THE SAVE AREA POINTER. * 00660000 +.* * 00662000 + AIF (T'&AD EQ 'O').XU2 SKIP TO NORMAL IF &AD OMITTED 00664000 + LR 14,13 . SAVE @ OLD SAVE AREA BEFORE SETTING 00666000 + XMUSE &BR,&AD HAVE ADCON SET UP 00668000 + ST 13,8(14) . SAVE NEW POINTER INTO OLD SAVEAREA 00670000 + ST 14,4(13) . SAVE OLD POINTER INTO NEW AREA 00672000 + AGO .XEND1 GO FINISH UP 00674000 +.XU2 CNOP 0,4 00676000 + ST 13,&XSAVE+4 . SAVE OLD SA POINTER INTO NEW AREA 00678000 + BAL 13,&XSAVE+72 . SET UP 13, BRANCH AROUND SA 00680000 + XMUSE &BR SET UP WHATEVER USING REQUIRED 00682000 +&XSAVE DC 18F'0' . SAVE A›EA 00684000 +.XU3 L 15,&XSAVE+4 . GET OLD SA POINTER BACK TO SET LINKS 00686000 + ST 13,8(15) . STORE NEW POINTER IN OLD AREA 00688000 + AGO .XEND1 CHECK NUMBER OF BR'S,GET LA'S SET UP 00690000 +.* * 00692000 +.XNORM1 AIF (T'&REEN EQ 'O').XNORM2 SKIP OVER REENTRANT 00694000 +.* * 00696000 +.* REENTRANT ENTRY CODE GENERATION - THIS GENERATES CODE TO * 00698000 +.* ACQUIRE SPACE FOR SAVEAREA(72 BYTES) + AS MUCH MORE SPACE * 00700000 +.* AS IS SPECIFIED IN REEN PARAMATER, IF USED. * 00702000 +.* * 00704000 + AIF ('&TR' EQ 'NO' OR &XSAVEST).XGOK MAKE SURE REENT 00706000 + MNOTE 0,'**XSAVE- USE OF TR OPTION IMPLIES NON-REENTRANT CODE' 00708000 +.XGOK ANOP 00710000 + GETMAIN R,LV=8*((&REEN+79)/8) .GET CORE ROUNDED TO DBLWRD 00714000 + ST 13,4(1) . STORE OLD POINTER IN NEW AREA 00716000 + ST 1,8(13) . STORE (EW POINTER IN OLD AREA 00718000 + LR &B1,1 . SAVE VALUE OF NEW SAVE POINTER 00720000 + LM 0,1,20(13) . RESTORE PREVIOUS VALUES OF REGS 00722000 + LR 13,&B1 . POINT 13 TO NEW SAVE AREA 00724000 + AGO .XNEWBS GO GENERATE NEW BALR,USING 00726000 +.* * 00728000 +.* NORMAL,NON-REENTRANT ENTRY CODE SECTION. * 00730000 +.* * 00732000 +.XNORM2 AIF ('&SA' EQ 'NO').XNEWBS SKIP IF NO SAVE AREA 00734000 + ST 13,&XSAVE+4 . SAVE OLD POINTER IN NEW AREA 00736000 + AIF ('&BT' NE '15').XSN15 SKIP IF NOT 15 00738000 + LA 13,&XSAVE . GET ADDRESS OF NEW SAVE AREA 00740000 + L &B1,&XSAVE+4 . GET OLD SAVE POINTER BACK 00742000 + AGO .XSOLD GO SAVE NEW POINTER 00744000 +.XSN15 LR &B1,13 . MOVE OLD POINTER OVER 00746000 + LA 13,&XSAVE . ADDRESS OF NEW SAVE AREA 00748000 +.XSOLD ST 13,8(&B1) . SAVE NEW POINTER IN OLD AREA 00750000 +.* SET UP BALR, LA'S IF REQUIRED, AND USING STATEMENT. * 00752000 +.XNEWBS AIF ('&BT' NE '15' OR N'&BR GT 1).XSET2 SKIP IF 15 00754000 + AIF ('&REEN' EQ '' AND '&SA' EQ 'NO' AND '&AD' EQ '').XEND2 00756000 +.XSET2 AIF (T'&AD NE 'O').XSET3 SKIP BALR IF ADCON USED 00758000 + BALR &B1,0 . SET UP NEW BASE REGISTER 00760000 +.XSET3 XMUSE &BR,&AD SET UP USINGS, ADCON IF NEEDED 00762000 +.XEND1 AIF (N'&BR EQ 1).XEND2 IF ONLY 1 BASE,DON'T CALL XMUSE 00764000 +&I SETA 2 INITIALIZE 00766000 +.XA2A LA &BR(&I),4095 . LOAD IN ADDRESS 00768000 + LA &BR(&I),1(&BR(&I),&BR(&I-1)) . SET USING VALUES 00770000 +&I SETA &I+1 INCREMENT TO NEXT BASE 00772000 + AIF (&I LE N'&BR AND &I LE 4).XA2A LOOP FOR # BASES 00774000 +.XEND2 SPACE 1 00776000 + MEND 00778000 + TITLE '*** XSNAP MACRO DEFINITION ***' 00780000 + MACRO 00782000 +&XLABEL XSNAP &T=PR,&LABEL=,&STORAGE=,&IF= 00784000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00786000 +.*--> MACRO: XSNAP EXTENDED SNAP MACRO-DEBUGGING-DUMPING. * 00787000 +.* JOHN R. MASHEY - FEB 1970 - V.4.0 * 00788000 +.* XSNAP IS USED FOR STORING,PRINTING OF REGISTERS AND ANY * 00790000 +.* OTHER ADDRESSABLE AREAS. XSNAP HARMS NO REGISTERS,CAN BE USED* 00792000 +.* IN ANY NUMBER OF CSECTS IN 1 ASSEMBLY,AND PRINTS REGISTERS * 00794000 +.* EXACTLY AS THEY ARE WHEN THE XSNAP IS CALLED. XSNAP * 00796000 +.* ACTION MAY BE MADE CONDITIONAL EITHER AT ASSEMBLY TIME OR * 00798000 +.* DURING EXECUTE TIME. SEE WRITEUP FOR OPERAND DESCRIPTION. * 00800000 +.* USES MACROS: XLOOK * 00801000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00802000 + GBLA &XXLOOK XLOOK RETURN VALUE 00804000 + GBLB &XSNAPST GENERATION STATUS,ON=0,OFF=1 00806000 + LCLA &I,&K,&L,&N LOCAL COUNTERS 00808000 + LCLB &XP,&XF PRINT REGS AND PRINT FLOATING REGS 00810000 + LCLC &NAM,&INST,&A(5) 00812000 +.* * 00814000 +.* CHECK FOR XSNAPS BEING CANCELLED. CREATE LABEL IF NEEDED. * 00816000 +.* * 00818000 + AIF ('&T(3)' NE '').XGOGEN SKIP SKIP IF NONCANCELLABLE 00819000 + AIF (NOT &XSNAPST).XGOGEN GENERATE IF STATUS=ON 00820000 + AIF (T'&XLABEL EQ 'O').XXEXIT SKIP IF NOTHING TO GEN 00822000 +&XLABEL DS 0H . LABEL USED ON NULLIFIED XSNAP 00824000 + MEXIT 00826000 +.XGOGEN SPACE 1 00828000 +&NAM SETC 'XX&SYSNDX' SET UP MOST OF NAME FOR LABELS 00830000 +&N SETA (N'&STORAGE/2)*2 GET ROUNDED NUMBER OF OPERANDS 00832000 +&XLABEL STM 0,15,&NAM.B . SAVE ALL REGISTERS 00834000 +.* * 00836000 +.* IF OPTION - IF IF OPTION IS USED AND HAS CORRECT ARGUMENTS, * 00838000 +.* GENERATE A CLI, C, OR CR INSTRUCTION TO PERFORM APPROPRIATE * 00840000 +.* TEST,DEPENDING ON THE KIND OF IF ARGUMENTS . NEGATE THE * 00842000 +.* CONDITION AND CREATE THE RIGHT EXTENDED MNEMONIC BRANCH * 00844000 +.* SO THAT THE XSNAP WILL BE SKIPPED IF THE STATED CONDTION IS * 00846000 +.* NOT MET. GENERATE USER'S OWN OPCODE IF HE SUPPLIED ONE. * 00848000 +.* * 00850000 + AIF (T'&IF EQ 'O').XNOIF SKIP IF IF NOT REQUESTED 00852000 + AIF (N'&IF GE 3).XOKIF SKIP IF ENOUGH ARGUMENTS 00854000 + MNOTE 0,'**XSNAP- IF=&IF:IGNORED, LACKS REQUIRED 3-4 OPERANDS' 00856000 + AGO .XNOIF CANCEL IF OPTION 00858000 +.XOKIF XLOOK &IF(2),(H,L,E,O,P,M,Z,NH,NL,NE,NO,NP,NM,NZ) 00860000 + AIF (&XXLOOK GT 0).XOKIF1 SKIP IF OK RELATION 00862000 + MNOTE 0,'**XSNAP- IF=&IF(2) UNKNOWN-CANCELLED' 00864000 + AGO .XNOIF SKIP GENERATION OF THIS OPTION 00866000 +.XOKIF1 ANOP 00868000 +&INST SETC '&IF(4)' GET INSTRUCTION 00870000 + AIF (N'&IF EQ 4).X IF OPCODE SUPPLIED,SKIP CHECKING 00872000 +&INST SETC 'CLI' MAKE TENTATIVE INSTRUCTION SETUP 00874000 + AIF ('&IF(1)'(1,1) NE '(' OR '&IF(1)'(K'&IF(1),1) NE ')').X 00876000 +&INST SETC 'C' PROBABLY WANTS RX TYPE 00878000 + AIF ('&IF(3)'(1,1) NE '(' OR '&IF(3)'(K'&IF(3),1) NE ')').X 00880000 +&INST SETC 'CR' 2 REGS-USER WANTS RR TYPE 00882000 +.X ANOP 00884000 + &INST &IF(1),&IF(3) . TEST 00886000 +&INST SETC 'BN&IF(2)' NEGATE COND, HOPE FOR 1 OF 1ST SET 00888000 + AIF (&XXLOOK LE 7).XOKIF2 SKIP IF NOW SET UP RIGHT 00890000 +&INST SETC 'B'.'&IF(2)'(2,2) REMOVE N FROM COND 00892000 +.XOKIF2 &INST &NAM.C 00894000 +.* * 00896000 +.* CREATE BRANCH AROUND THE SAVE AREA, FLAGS, ETC. * 00898000 +.* * 00900000 +.XNOIF XLOOK &T(1),(PR,PRINT,FL,FLOAT,NO,NOREGS,ST,STORE) 00902000 +&I SETA 72+4*&N LENGTH FOR T=PRINT,NOREGS 00904000 + AIF (&XXLOOK LE 6).XBRNCH SKIP IF ILLEGAL, OR PR,NO 00906000 +&I SETA 68 LENGTH FOR T=STORE 00908000 +.XBRNCH B &NAM.B+&I . BRANCH AROUND CONSTANTS 00910000 +.* * 00912000 +.* CREATE FRONT BRACKET CHARACTER STRING FOR REGISTER AREA * 00914000 +.* * 00916000 + DS 0F . ALIGN LABEL ON FULLWORD 00918000 +&L SETA 8 SET &L FOR NO LABEL= LENGTH 00920000 + AIF (T'&LABEL EQ 'O').XNOLAB IF NO LABEL,SKIP GENERATION 00922000 +&L SETA ((K'&LABEL+1)/4)*4 ROUND LENGTH UP TO FULLWORD 00924000 + AIF (&L LE 92).XLAB1 SKIP IF LABEL SMALL ENOUGH 00926000 + MNOTE 0,'**XSNAP- LABEL= OPERAND TRUNCATED TO 92 CHARACTERS' 00928000 +&L SETA 92 TRUNCATE 00930000 +.XLAB1 DC CL&L&LABEL 00932000 + AGO .XCHK1 SKIP GENRATION OF 1ST DELIMETER 00934000 +.XNOLAB DC CL8'&NAM.B' . FRONT BRACKET FOR REGISTER AREA 00936000 +.* * 00938000 +.* CREATE REGISTER AREA, BRACKETS, FLAG VALUES, AS NEEDED * 00940000 +.XCHK1 AIF (&XXLOOK LT 7).XPRINT SKIP IF PRINTED OUTPUT 00942000 +&NAM.B DC 16F'-1',4C'X' . REGISTER SAVE AREA, BRACKET X'S 00944000 + AGO .XIFLB SKIP TO CHECK FOR IF LABEL 00946000 +.XPRINT AIF (&XXLOOK GT 0).XPRINT1 SKIP IF LEGAL T= 00948000 + MNOTE 0,'**XSNAP- UNKNOWN T=&T: T=PR ASSUMED' 00950000 +.XPRINT1 ANOP 00952000 +&XP SETB (&XXLOOK LT 5) SET TO 1 IF GP REGS NEEDED 00954000 +&XF SETB (&XXLOOK GT 2 AND &XP) SET TO 1 IF T=FL OR T=FLOAT 00956000 +&XF SETB (&XF OR '&T(2)' EQ 'FL' OR '&T(2)' EQ 'FLOAT') 00958000 +&NAM.B DC 16F'-1',B'&T(3)00&XF&XP',AL1(0,&L,&N/2),V(XXXXSNAP) 00960000 +.* * 00962000 +.* GENERATE ADDRESS LIST FOR STORAGE=, WITH EITHER WORDS FOR * 00964000 +.* STORING ADDRESSES OR A-TYPE ADDRESS CONSTANTS. * 00966000 +.* * 00968000 + AIF (T'&STORAGE EQ 'O').OKN SKIP IF STORAGE= NOT USED 00970000 +&I SETA 1 INITIALIZE AS COUNTER 00972000 + AIF (&N EQ N'&STORAGE).LOOP1 SKIP IF LEGAL 00974000 + MNOTE 0,'**XSNAP- ODD OPERAND IGNORED: STORAGE=&STORAGE(&N)' 00976000 + AIF (&N EQ 0).OKN 00978000 +.LOOP1 AIF ('&STORAGE(&I)'(1,1) NE '*').LOOP1E 00980000 +&K SETA 1 INITIALIZE COUNTER 00982000 +.* PROCESS ADDRESS REQUIRING LA - ST COMBINATION * 00984000 +.LOOP1A AIF (&I+&K GT &N).LOOP1C SKIP IF WE'RE AT END 00986000 + AIF ('&STORAGE(&I+&K)'(1,1) NE '*').LOOP1C SKIP IF NOT * 00988000 +&K SETA &K+1 INCREM # CONSECUTIVE * FORMS 00990000 + AGO .LOOP1A GO CHECK NEXT 00992000 +.LOOP1C DS &K.A . WORDS WHERE ADDRESSES WILL BE STORED 00994000 +&I SETA &I+&K INCREMENT 00996000 + AGO .LOOP1G GO FOR NEXT CHECK 00998000 +.* PROCESS ADDRESS CONSTANT TYPE OF OPERAND * 01000000 +.LOOP1E DC A(&STORAGE(&I)) 01002000 +&I SETA &I+1 INCREMENT # OPERANDS DONE 01004000 +.LOOP1G AIF (&I LE &N).LOOP1 CONTINUE IF ANY MORE 01006000 +.* * 01008000 +.* CREATE LOAD ADDRESS - STORE PAIRS FOR EXPRESSION ADDRESSES * 01010000 +.* * 01012000 +&I SETA 1 01014000 +.LOOP2 AIF ('&STORAGE(&I)'(1,1) NE '*').LOOP2E SKIP IF NOT * 01016000 +&L SETA K'&STORAGE(&I)-1 GET # CHARS IN EXPRESSION 01018000 +&K SETA 1 INIT COUNTER 01020000 + AIF (&L LE 40).LOOP2A SKIP IF SMALL ENOUGH 01022000 + MNOTE 8,'**XSNAP- STORAGE(&I) LONGER THAN 40 CHARACTERS' 01024000 +&L SETA 40 TRUNCATE AND HOPE IT GOES 01026000 +.* BREAK EXPRESSION INTO 8 CHARACTER SECTIONS. * 01028000 +.LOOP2A ANOP 01030000 +&A(&K) SETC '&STORAGE(&I)'(8*&K-6,8) GET UP TO 8 NEXT CHARS 01032000 +&K SETA &K+1 INCRMENT COUNTER 01034000 + AIF (8*&K-8 LT &L).LOOP2A LOOP UNTIL HAVE WHOLE OPR 01036000 + LA 0,&A(1)&A(2)&A(3)&A(4)&A(5) 01038000 + ST 0,&NAM.B+4*&I+68 STORE ADDRESS IN LIST 01040000 +.LOOP2C ANOP 01042000 +&K SETA &K-1 DECRMENT SECTION TO NULL 01044000 +&A(&K) SETC '' NULL FOR NEXT USE 01046000 + AIF (&K GT 2).LOOP2C CONTINUE UNTIL ALL BUT &A(1) NULL 01048000 +.LOOP2E ANOP 01050000 +&I SETA &I+1 INCREMENT POSITION IN LIST 01052000 + AIF (&I LE &N).LOOP2 CONTINUE WITH LIST 01054000 +.* * 01056000 +.* CREATE CODE TO SET UP REGISTERS FOR XXXXSNAP,CALL IT,AND * 01058000 +.* RESTORE REGS ON RETURN. XXXXSNAP RESTORES THE CONDTION CODE.* 01060000 +.* * 01062000 +.OKN LA 10,&NAM.B . GET ADDRESS OF REGISTER BLOCK 01064000 + L 15,68(10) . GET V(XXXXSNAP) FOR BRANCH 01066000 + BALR 14,15 . CALL XXXXSNAP,POINT 14 AT NEXT INST 01068000 + LM 0,15,0(10) . RELOAD THE REGISTERS 01070000 +.* CREATE LABEL FOR IF OPTION, IF IT WAS USED. * 01072000 +.XIFLB AIF ('&INST' EQ '').XEXIT SKIP GEN OF IF LABEL 01074000 +&NAM.C EQU * . DEFINE LABEL FOR IF= BRANCH 01076000 +.XEXIT SPACE 2 01078000 +.XXEXIT MEND 01080000 + SPACE 2 01081000 + MACRO 01081010 + XSET &XSNAP= 01081020 + GBLB &XSNAPST =0 ==> XSNAPS, =1 ==> NONE 01081030 +.* SIMPLE XSET, JUST FOR XSNAPS. 01081040 +&XSNAPST SETB ('&XSNAP' EQ 'OFF') 1==> NO XSNAPS 01081050 + MEND 01081055 + TITLE '*** XSRNR - REGISTER LOAD-STORE FOR XRETURN-XSAVE ***' 01082000 + MACRO 01084000 + XSRNR &OP,&RG,&NO15 01086000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01088000 +.*--> MACRO: XSRNR SAVE/RESTORE REGISTERS FOR XSAVE/XRETURN * 01089000 +.* JOHN R. MASHEY- FEB 1970 - V.4.0 * 01090000 +.* THIS MACRO IS USED BY XSAVE AND XRETURN TO SET UP * 01092000 +.* REGISTER SAVING AND RESTORATION. * 01094000 +.* &OP IS THE OPCODE TO BE USED. I.E. EITHER L OR ST. * 01096000 +.* &RG IS 1 OPERAND FROM THE &RGS OPERAND USED BY XSAVE AND * 01098000 +.* XRETURN. IT IS EITHER 1 REGISTER, OR A PAIR OF REGS * 01100000 +.* SEPARATED BY A DASH. * 01102000 +.* &NO15 =0 STATES THAT A RETURN CODE IS CURRENTLY IN REG 15 * 01104000 +.* AND SHOULD NOT BE DISTURBED, REGARDLESS OF HOW THE REGS* 01106000 +.* ARE SPECIFIED. * 01108000 +.* USES MACROS: XCHAR * 01110000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01112000 + GBLC &XXCHAR FOR COMMUNICATION WITH XCHAR 01114000 + LCLA &I 01116000 + LCLC &R1,&R2 1ST REG, 2ND REG, TEMPORARY 01118000 + AIF ('&RG' EQ 'NO').XXEXIT DON'T GEN ANYTHING 01120000 +.* SCAN FOR DASH-MEANING 2 REGISTERS. * 01122000 +.XSL1 ANOP 01124000 +&I SETA &I+1 INCREMENT FOR NEXT CHARACTER 01126000 + AIF ('&RG'(&I,1) EQ '-').XDASH JUMP IF DASH FOUND 01128000 + AIF (&I LT K'&RG).XSL1 CONTINUE TO END OF OPERAND 01130000 +&R1 SETC '&RG' &RG IS 1 REGISTER BY ITSELF 01132000 + AGO .XSAA GO TO NEXT DECISION POINT 01134000 +.* FOUND DASH-NOW SEPARATE THE REGISTERS. * 01136000 +.XDASH ANOP 01138000 +&R1 SETC '&RG'(1,&I-1) GET FIRST REGISTER 01140000 + AIF (&I EQ K'&RG).XSAA DUMB USER - 1 REG FOLLOWED BY - 01142000 +&R2 SETC '&RG'(&I+1,K'&RG-&I) GET 2ND REGISTER 01144000 +.XSAA XCHAR &R1,2 GET UP TO LAST 2 CHARS OF 1ST REG 01146000 + AIF ('&XXCHAR' NE '14' AND '&XXCHAR' NE '15').XNO1415 01148000 +&I SETA 4*&XXCHAR-44 OFFSET FOR 14 OR 15 01150000 + AIF ('&R2' NE '').XS2RG SKIP IF 2 REGISTERS SPECIFIED 01152000 + AIF ('&XXCHAR' EQ '15' AND '&NO15' EQ '0').XXEXIT 01154000 + &OP &R1,&I.(13) . SAVE/RESTORE 1 REG 01156000 + MEXIT 01158000 +.XS2RG AIF ('&NO15' EQ '0').XSN15 SKIP IF 15 SHOULDN'T BE 01160000 + &OP.M &R1,&R2,&I.(13) . SAVE/RESTORE RANGE OF REGS 01162000 + MEXIT 01164000 +.XSN15 AIF ('&XXCHAR' EQ '15').XSN15A SKIP IF 15 SPECIFIED 01166000 + L &R1,12(13) . RELOAD REG 14 01168000 + XCHAR &R2,2 GET 2ND REG 01170000 + AIF ('&XXCHAR' EQ '15').XXEXIT SKIP IF 15 SPECIFIED 01172000 +.XSN15A LM 0,&R2,20(13) . RELOAD REST OF REGS 01174000 + MEXIT 01176000 +.* RESTORE 1 REG OR RANGE (NOT STARTING WITH 14 OR 15). * 01178000 +.XNO1415 AIF ('&R2' NE '').XLMSTM JUMP IF MULTIPLE REGS 01180000 + &OP &R1,&R1*4+20(13) 01182000 + MEXIT 01184000 +.XLMSTM &OP.M &R1,&R2,&R1*4+20(13) 01186000 +.XXEXIT MEND 01188000 + TITLE 'DISK UTILITY I/O DOS/OS MACROS' 01188005 + MACRO 01188010 +&LA XDKCHK &P1,&P2,&P3 01188020 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01188030 +.*-->MACRO: XDKCHK * 01188040 +.* THIS MACRO WILL PRODUCE EITHER A DOS CHECK MACRO OR A * 01188050 +.* OS VERSION OF THE CHECK MACRO * 01188060 +.* * 01188070 +.* &P1 IS THE OS CHECK MACRO PARAMETER * 01188080 +.* &P2 IS THE DOS CHECK MACRO PARAMETER * 01188090 +.* &P3 IF 'DOS' AND &$ASMLVL IS DOS GEN DOS CHECK * 01188100 +.* OTHERWISE GEN &$ASMLVL TYPE CHECK * 01188105 +.* USES INNER MACROS: CHECK (OS OR DOS VERSION) * 01188110 +.* * 01188120 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01188130 + GBLB &$ASMLVL OS/DOS LEVEL SWITCH 01188140 +&LA DS 0H . GEN LABEL AND BOUNDRY 01188150 + AIF (&$ASMLVL).XOSGEN DETERMINE LEVEL 01188160 + CHECK &P2 . GEN DOS CHECK 01188170 +.XEND MEXIT ALL DONE 01188175 +.XOSGEN AIF ('&P3' EQ 'DOS').XEND IF NOT DEFAULT QUIT 01188180 + CHECK &P1 . GEN OS TYPE CHECK 01188185 + MEND 01188190 + SPACE 10 01188205 + MACRO 01188210 +&LA XDKPT &P1,&P2 01188220 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01188230 +.*-->MACRO: XDKPT * 01188240 +.* THIS MACRO GENERATES EITHER A DOS POINTS MACRO CALL OR AN * 01188250 +.* OS POINT MACRO CALL * 01188260 +.* * 01188270 +.* &P1 IS THE DCB OR DTF NAME * 01188280 +.* &P2 IS THE POINT WORD ADDRESS (OS ONLY) * 01188290 +.* * 01188300 +.* USES INNER MACROS: POINT (OS), POINTS (DOS) * 01188310 +.* * 01188320 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01188330 + GBLB &$ASMLVL GLOBAL ASMBLY LEVEL SWITCH 01188340 + AIF (&$ASMLVL).XDKP1 GENERATE CORRECT MACRO VERSION 01188350 +&LA POINTS &P1 . DOS POINTS MACRO 01188360 + MEXIT 01188370 +.XDKP1 ANOP 01188380 +&LA POINT &P1,&P2 . OS POINT MACRO 01188390 + MEND 01188400 + SPACE 10 01188405 + MACRO 01188410 +&LA XDKWT &P1,&P2,&P3 01188420 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01188430 +.*-->MACRO:XDKWT * 01188440 +.* THIS MACRO WILL GENERATE A CORRECT WRITE MACRO CALL FOR * 01188450 +.* EITHER ASSEMBLY UNDER OS OR DOS. * 01188460 +.* * 01188470 +.* &P1 IS THE DECB NAME * 01188480 +.* &P2 IS THE FILE NAME UNDER DOS GEN AND THE DCB NAME FOR OS * 01188490 +.* &P3 IS THE AREA ADDRESS FOR BOTH LEVELS OF GENERATION * 01188500 +.* * 01188510 +.* THIS MACRO GENERATES AN EXECUTE FORM MACRO FOR OS * 01188520 +.* ALL OPERANDS ARE ASSUMED CORRECT AS NO ERROR CHECKING * 01188530 +.* IS PERFORMED * 01188540 +.* * 01188550 +.* USES INNER MACROS: WRITE (OS FORM OR DOS FORM) * 01188560 +.* * 01188570 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01188580 + GBLB &$ASMLVL GLOBAL SWITCH FOR ASSEMBLY LEVEL 01188590 + AIF (NOT &$ASMLVL).XWT1 GEN CORRECT CALL BY LEVEL SWTCH 01188600 +&LA WRITE &P1,SF,&P2,&P3,MF=E . GENERATE AN OS MACRO CALL 01188610 + MEXIT 01188620 +.XWT1 ANOP 01188630 +&LA WRITE &P2,SQ,&P3 . GENERATE A DOS MACRO CALL 01188640 + MEND 01188650 + SPACE 10 01188655 + MACRO 01188660 +&LA XDKRD &P1,&P2,&P3 01188670 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01188680 +.*-->MACRO: XDKRD * 01188690 +.* THIS MACRO WILL GENERATE A CORRECT READ MACRO CALL FOR * 01188700 +.* EITHER ASSEMBLY UNDER OS OR DOS. * 01188710 +.* * 01188720 +.* &P1 IS THE DECB NAME * 01188730 +.* &P2 IS THE DCB ADDRESS FOR OS AND THE FILENAME UNDER DOS * 01188740 +.* &P3 IS THE AREA ADDRESS FOR BOTH LEVELS OF ASSEMBLY * 01188750 +.* * 01188760 +.* THIS MACRO GENERATES AN EXECUTE FORM MACRO FOR OS * 01188770 +.* ALL OPERANDS ARE ASSUMED CORRECT AS NO ERROR CHECKING * 01188780 +.* IS PERFORMED * 01188790 +.* * 01188800 +.* USES INNER MACROS: READ (OS FORM OR DOS FORM) * 01188810 +.* * 01188820 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01188830 + GBLB &$ASMLVL GLOBAL SWITCH FOR ASSEMBLY LEVEL 01188840 + AIF (NOT &$ASMLVL).XRE1 GEN CORRECT CALL BY LEVEL SWTCH 01188850 +&LA READ &P1,SF,&P2,&P3,MF=E . GENERATE AN OS MACRO CALL 01188860 + MEXIT 01188870 +.XRE1 ANOP 01188880 +&LA READ &P2,SQ,&P3 . GENERATE A DOS MACRO CALL 01188890 + MEND 01188900 + SPACE 10 01188905 + TITLE 'XXDKDECB MACRO DEFINE CONTROL BLOCKS FOR DISK UTILITY' 01189000 + MACRO 01189020 +&LABEL XXDKDECB &II 01189040 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01189050 +.*--> MACRO: XXDKEDCB GENERATE TABLE OF DECBS FOR DISK UTILITY * 01189060 +.* THIS MACRO GENERATES A LINKED TABLE OF DECBS. * 01189080 +.* THE BUFFER ADDRESSES ARE PLACED IN THE DECB BY XXXXDKOP * 01189100 +.* USES MACRO: WRITE * 01189120 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01189140 + GBLB &$ASMLVL LEVEL OF ASSEMBLY SWITCH 01189150 + LCLA &I,&XXLNK LCL COUNTER AND LINK FACTOR(OS/DOS) 01189160 +&I SETA &II INITIALIZE FOR UNIQUE NAMES 01189180 + AIF (&$ASMLVL).OS1 GENERATE CORRECT LINK FACTOR(OS/DOS) 01189182 +&XXLNK SETA 8 DOS LEVEL LINK FACTOR 01189184 + AGO .OS2 01189186 +.OS1 ANOP 01189188 +&XXLNK SETA 24 OS LEVEL LINK FACTOR 01189190 +.OS2 ANOP 01189192 + SPACE 2 01189200 +&LABEL DS 0F . DEFINE LABEL, ALIGN TO FULLWORD 01189220 + AIF (&I EQ 1).DESTOP BRANCH IF LAST ENTRY 01189240 +.DENEXT DC A(*+&XXLNK) . LINK TO NEXT ENTRY 01189260 + AIF (&$ASMLVL).XXDK1 LEVEL DEPENDENT CODE GENERATION 01189262 + DC F'0' FULLWORD FOR FAKE DECB 01189264 + AGO .XXDK2 01189266 +.XXDK1 WRITE XXDECB&I,SF,XXDKUDCB,0,MF=L GENERATE A DECB 01189280 +.XXDK2 SPACE 2 01189300 +&I SETA &I-1 DECREMENT COUNTER 01189320 + AIF (&I GT 1).DENEXT LOOP IF NOT LAST ENTRY 01189340 +.DESTOP DC A(&LABEL) . LAST ENTRY, LINK TO TOP OF TABLE 01189360 + AIF (&$ASMLVL).XXDK3 LEVEL OF ASSEMBLY 01189362 + DC F'0' FULLWORD FOR FAKE DECB 01189364 + AGO .XXDK4 01189366 +.XXDK3 WRITE XXDECB&I,SF,XXDKUDCB,0,MF=L GENERATE A DECB 01189380 +.XXDK4 SPACE 5 01189400 + MEND 01189420 + SPACE 3 01189440 + MACRO 01189460 +&L $DISK &TYPE 01189480 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01189490 +.*--> MACRO: $DISK CALL DISK UTILITY * 01189500 +.* $DISK CALLS MACRO XIONR TO SET UP A BRANCH TO A DISK * 01189520 +.* UTILITY ROUTINE. * 01189540 +.* USES MACRO: XIONR * 01189560 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01189580 +&L XIONR XXXXDK&TYPE,0,(0) CALL DISK UTILITY 01189600 + MEND 01189620 + TITLE '$ERCGN MACRO - GENERATE COMPLETION CODE BLOCK ' 01190000 + MACRO 01192000 +&LABEL $ERCGN &CODE,&MSSG,&TYPE=SYSTEM 01194000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01195000 +.*--> MACRO: $ERCGN GENERATE COMPLETION CODE BLOCK FOR XXXXSNAP * 01196000 +.* EACH CALL CREATES 1 ENTRY DESCRIBED BY DSECT ERCOMPCD. * 01198000 +.* * 01198050 +.* &CODE CHARACTER VALUE OF ERROR CODE NUMBER. * 01198100 +.* &MSSG ERROR MESSAGE TO BE PRINTED * 01198200 +.* &TYPE TYPE OF COMPLETION CODE - SYSTEM, ASSIST, OR USER. * 01198300 +.* * 01198350 +.* *NOTE* IF &$OPTMS = 0, NO MESSAGE WILL BE GENED, ONLY CODE. * 01198400 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01199000 + GBLA &$OPTMS MEMORY OPTIMIZATION(0=SMALL) 01199500 + LCLA &I FOR LENGTH 01200000 + LCLC &T FOR TYPE 01202000 +&T SETC 'ERC&TYPE'(1,7) GET EQU FOR TYPE 01204000 +&I SETA K'&CODE+K'&MSSG-2 GET LENGTH OF TOTAL MESSAGE 01206000 + AIF (&$OPTMS GT 0).ERCA SKIP IF NOT MINIMAL MEMORY 01206100 +&I SETA K'&CODE-1 GET LENGTH - 1 OF ERROR CODE 01206200 +&LABEL DC AL2(256*&I+&T),C'&CODE' 01206300 + AGO .XXEXIT QUIT 01206400 +.ERCA ANOP 01206500 +&LABEL DC AL2(256*&I+&T),C'&CODE ',C&MSSG 01208000 +.XXEXIT MEND 01210000 + SPACE 2 S 01210500 + MACRO A 01210510 +&LABEL $MSG &NMBR,&MSG,&FLAG=0 A 01210520 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01210525 +.*--> MACRO: $MSG USED TO GENERATE LINE IN MSG TABLE * 01210530 +.* &NMBR IS MESSAGE # (3 DIGITS) * 01210540 +.* &MSG IS QUOTED STRING OF MESSAGE * 01210550 +.* &FLAG IS FLAG BYTE * 01210560 +.* GENERATES:(LENGTH-1 OF MSG): #BYTES +3 FOR LENGTH OF MSG * 01210570 +.* (FLAG BYTE): 1 BYTE * 01210580 +.* (CHAR FORM OF NMBR): 3 BYTES * 01210590 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01210595 + GBLA &$OPTMS MEMORY OPTIMIZATION(0=SMALL) S 01210600 + LCLA &K FOR K'&MSG S 01210610 + AIF (&$OPTMS EQ 0).SMALL SKIP FOR MIMIMAL MEMORY S 01210620 +&K SETA K'&MSG-2-1+3 MSG-QUOTES-1+LENGTH OF NMBR S 01210630 +&LABEL DC AL1(&K,&FLAG),CL3'&NMBR',C&MSG S 01210640 + MEXIT S 01210650 +.SMALL ANOP S 01210660 +&LABEL DC AL1(2,&FLAG),CL3'&NMBR' S 01210670 + MEND S 01210690 + TITLE '*** CARD-PUNCH, LINE-PRINT MACROS - $PNCH,$PRNT ***' 01212000 + MACRO 01214000 +&LABEL $PNCH &XAREA,&XNUM,&OVER 01216000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01217000 +.*--> MACRO: $PNCH PUNCH A CARD, BRANCH IF RECORD OVERFLOW * 01217500 +.* &XAREA,&XNUM-SEE XIONR MACRO FOR EXPLANATION, OR XPNCH WRTUP * 01218000 +.* &OVER IS LABEL TO BE BRANCHED TO IF RECORDS EXCEED LIMIT. * 01218500 +.* USES MACROS: XIONR * 01219000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01219300 +&LABEL XIONR XXXXPNCH,&XNUM,&XAREA,80 HAVE CONTROL BLOCK SET 01219600 + AIF ('&OVER' EQ '').XXEXIT SKIP IF OVER NOT SPEC 01220000 + BL &OVER . BRANCH IF EXCEEEDED RECORD COUNT 01222000 +.XXEXIT MEND 01224000 + SPACE 4 01226000 + MACRO 01228000 +&LABEL $PRNT &XAREA,&XNUM,&OVER 01230000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01230500 +.*--> MACRO: $PRNT PRINT A LINE, BRANCH IF RECORD OVERFLOW. * 01231000 +.* &XAREA,&XNUM-SEE XIONR MACRO FOR EXPLANATION, OR XPRNT WRITUP* 01231500 +.* &OVER IS LABEL TO BE BRANCHED TO IF RECORDS EXCEED LIMIT. * 01232000 +.* USES MACROS: XIONR * 01232500 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01233000 +&LABEL XIONR XXXXPRNT,&XNUM,&XAREA,133 HAVE BLOCK SETUP 01233500 + AIF ('&OVER' EQ '').XXEXIT SKIP IF NO LABEL 01234000 + BL &OVER . BRANCH IF EXCEEDED RECORDS 01236000 +.XXEXIT MEND 01238000 + TITLE '*** CARD-READ MACROS - $READ,$SORC ***' 01240000 + MACRO 01242000 +&LABEL $READ &XAREA,&XNUM,&EOF 01244000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01244400 +.*--> MACRO: $READ READ CARD DURING EXECUTION, BRANCH IF EOF. * 01244500 +.* &XAREA,&XNUM-SEE XIONR MACRO FOR EXPLANATION, OR XREAD WRITUP* 01245000 +.* &EOF LABEL TO BE BRANCHED TO IF END-FILE OCCURS. * 01245500 +.* USES MACROS: XIONR * 01246000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01246500 +&LABEL XIONR XXXXREAD,&XNUM,&XAREA,80 SET UP CONTROL BLOCK 01247000 + AIF (T'&EOF EQ 'O').XXEXIT SKIP IF NO LABEL 01247500 + BL &EOF . TAKE BRANCH IF END OF FILE 01248000 +.XXEXIT MEND 01250000 + SPACE 4 01252000 + MACRO 01254000 +&LABEL $SORC &XAREA,&XNUM,&EOF 01256000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01256500 +.*--> MACRO: $SORC READ ASSEMBLER SOURCE CARD, BRANCH IF EOF. * 01257000 +.* &XAREA,&XNUM-SEE XIONR MACRO FOR EXPLANATION, OR XREAD WRITUP* 01257500 +.* &EOF LABEL TO BE BRANCHED TO IF END-FILE OCCURS. * 01258000 +.* USES MACROS: XIONR * 01258500 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01259000 +&LABEL XIONR XXXXSORC,&XNUM,&XAREA,80 SET UP CONTROL BLOCK * 01259500 + AIF (T'&EOF EQ 'O').XXEXIT SKIP IF NO LABEL 01259600 + BL &EOF . BRANCH IF END-FILE 01260000 +.XXEXIT MEND 01262000 + TITLE 'SPECIAL XGET AND XPUT MACROES FOR ASSIST' 01262004 + MACRO 01262006 +&XLABEL $GET &XAREA,&XNUM 01262008 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01262009 +.*--> MACRO: $GET INTERNAL XGET MACRO FOR ASSIST. * 01262010 +.* RICHARD FOWLER NOV, 1972 V.5.0* 01262011 +.* LIKE XGET BUT CONVERTS USER REG1 AND SETS ACTUAL R1 TO * 01262012 +.* ACTUAL ADDRESS. ALSO CALLS XDDGET. * 01262014 +.* * 01262016 +.* EXECUTION ASSUMES USER REGISTER POINTS TO DDNAME. * 01262018 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01262020 +&XLABEL L R1,ECREG1 GET USER @ DDNAME 01262022 + AR R1,RMEM GET REAL ADDRESS 01262024 + XIONR XDDGET,&XNUM,&XAREA,80 01262026 +.XMEND MEND 01262028 + SPACE 5 01262030 + MACRO 01262032 +&XLEBEL $PUT &XAREA,&XNUM 01262034 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01262035 +.*--> MACRO: $PUT * 01262036 +.* LIKE $GET, BUT CALLS XDDPUT. * 01262038 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01262040 +&XLEBEL L R1,ECREG1 GET USER @ DDNAME 01262042 + AR R1,RMEM GET REAL ADDRESS 01262044 + XIONR XDDPUT,&XNUM,&XAREA,133 01262046 +.XMEND MEND 01262048 + TITLE 'EXTENDED I/O MACROES XGET AND XPUT' 01262050 + MACRO 01262052 +&XLABEL XGET &XAREA,&XNUM 01262054 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01262055 +.*--> MACRO: XGET GET RECORD OFF OF &DDNAME FILE * 01262056 +.* RICHARD FOWLER AUG, 1972 V.5.0 * 01262058 +.* MACRO FOR EASY READING OFF OF ANY DD FILE, READS &XNUM * 01262060 +.* CHARACTERS. CONDITION CODE SET TO 0 NORMALLY, OR TO 1 ON * 01262062 +.* END OF FILE. GENERATION CONTROLLED BY &XGETST. * 01262064 +.* EXECUTION ASSUMES REG 1 POINTS TO DD NAME * 01262066 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ** 01262068 + GBLB &XGETST GENERATION STATUS- 0=YES, 1=NO 01262070 + AIF (&XGETST).XNOGEN IF SHOULDN'T GENERATE-SKIP CALL 01262072 +&XLABEL XIONR XXXXGET,&XNUM,&XAREA,80 SET UP CONTROL BLOCK 01262074 + MEXIT 01262076 +.XNOGEN AIF (T'&XLABEL EQ 'O').XXEXIT GEN LABEL ONLY IF NEEDED 01262078 +&XLABEL DS 0H . LABEL FOR CANCELLED XGET 01262080 +.XXEXIT MEND 01262082 + SPACE 5 01262084 + MACRO 01262086 +&XLABEL XPUT &XAREA,&XNUM 01262088 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01262089 +.*--> MACRO: XPUT PUT A RECORD ONTO FILE &DDNAME * 01262090 +.* RICHARD FOWLER AUG 1972 V.5.0 * 01262092 +.* MACRO FOR EASY PRINTING ONTO ANY DD FILE. RECORD LENGTH=&XNUM* 01262094 +.* IF PRINT FILE, FIRST CHARACTER IS USED AS CARRIAGE CONTROL * 01262096 +.* GENERATION CONTROLLED BY &XPUST * 01262098 +.* EXECUTION ASSUMES REG 1 POINTS TO DD NAME * 01262100 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01262102 + GBLB &XPUTST GENERATION STATUS- 0=YES, 1=NO 01262104 + AIF (&XPUTST).XNOGEN IF SHOULDN'T GENERATE, SKIP CALL 01262106 +&XLABEL XIONR XXXXPUT,&XNUM,&XAREA,133 SET UP CONTROL BLOCK 01262108 + MEXIT 01262110 +.XNOGEN AIF (T'&XLABEL EQ 'O').XXEXIT GEN LABEL ONLY IF NEEDED 01262112 +&XLABEL DS 0H . LABEL FOR CANCELLED XPUT 01262114 +.XXEXIT MEND 01262116 + TITLE 'MACRO---XGPSRCH--- INNER MACRO FOR XGPGN MACRO' 01262118 + MACRO 01262120 + XXGPSRCH &DIREC,&TIME 01262122 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01262123 +.*-->MACRO: XXGPSRCH INNER MACRO FOR XGPGEN * 01262124 +.* ARGUMENTS: * 01262126 +.* &DIREC= G--> INPUT * 01262128 +.* P--> OUTPUT * 01262130 +.* &TIME=1 --> FIRST CALL, SETS UP EXTRA CODE AND ACTS AS &SYSND* 01262132 +.* 2--> SECOND CALL * 01262134 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01262136 + L R3,X&DIREC.ELEM . GET # LAST POINTER TO OPEN FILES 01262138 + LA R1,X&DIREC.PNTSRT . GET @ OF FIRST POINTER 01262140 + LTR R3,R3 . ARE THERE ANY ELEMENTS? 01262144 + BE X&DIREC.MAKE&TIME NO - GO CREATE ONE 01262146 + LA R2,12 . SET UP INCREMENT SIZE 01262150 +X&DIREC.LOOP&TIME CLC 0(8,R1),X&DIREC.CURENT COMPARE DD NAMES 01262152 + BE X&DIREC.CONT&TIME IF EQUAL, GO TO I/O 01262154 + BXLE R1,R2,X&DIREC.LOOP&TIME ^EQUAL, SEARCH TILL END OF TABLE 01262156 + SPACE 2 01262158 + MEND 01262160 + TITLE 'MACRO---XGPGEN--- GENERATE GENERAL I/O MODULES' 01262162 + MACRO 01262164 +&LABEL XGPGEN &DIREC=G,&FETCH=NOT,&DDNUM=20 01262166 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01262167 +.*--> MACRO: XGPGEN GENERATE GENERAL I/O MODULES * 01262168 +.* RICHARD FOWLER NOV, 1972 V.5.0 * 01262169 +.* * 01262170 +.* ARGUMENTS: * 01262172 +.* &DIREC = P --> OUTPUT * 01262174 +.* ^= P --> INPUT * 01262176 +.* &FETCH =NOT --> NO FETCH PROTECTION * 01262178 +.* =PROTECT --> FETCH PROTECTION * 01262180 +.* &DDNUM = MAXIMUM NUMBER OF DD NAMES ALLOWED AT ONCE * 01262182 +.* (**EACH DD FILE REQUIRES 3F TABLE ENTRY PLUS DCB AND BUFFER**) * 01262184 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01262186 + TITLE ' &LABEL - MODULE CREATED BY XGPGEN' 01262188 +&LABEL CSECT 01262190 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01262191 +*--> CSECT: EXTENDED I/O MODULE FOR GENERAL I/O * 01262192 +* THIS MODULE IS CALLED TO DO GENERAL I/O WORK ON A FILE * 01262194 +* SIMILAR IN OPERATION TO XIO ROUTINES, BUT CAN HANDLE * 01262196 +* MANY FILES AT ONCE. * 01262198 +* ENTRY CONDITIONS: * 01262200 +* R14 = @ OF CONTROL BLOCK * 01262202 +* R15 = ENTRY POINT ADDRESS * 01262204 +* R0 = ADDRESS OF AREA TO MOVE DATA INTO * 01262206 +* R1 = ADDRESS OF DD NAME TO BE USED * 01262208 +* CONTROL BLOCK: * 01262210 +* OFFSET LENGTH WHAT * 01262212 +* 0 1F ENTRY POINT ADDRESS * 01262214 +* 4 3F SAVE AREA * 01262216 +* 16 2 LENGTH OF AREA * 01262218 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01262220 + USING *,15 . NOTE TEMPORARY ADDRESSABILITY 01262222 + USING XIOBLOCK,R14 01262224 + STM R13,R7,X&DIREC.SAV1 SAVE REGISTERS TO BE USED A 01262226 + CNOP 0,4 . GET ON FULLWORD 01262228 + BAL R13,*+76 SET UP FAKE AREA PNTR - BASE 01262230 + USING *,R13 . NOTE NEW USING/SAVE AREA POINTER 01262232 + DS 18F . FAKE SAVE AREA 01262234 + DROP R15 . KILL OLD ADDRESSING 01262236 + SPACE 2 01262238 + USING IHADCB,R1 . SET UP ADDRESSIBILITY TO DCB S 01262240 + MVC X&DIREC.CURENT(8),0(R1) . GET CURRENT DD NAME 01262242 +* CHECK FOR CLOSE 01262244 + SR R1,R1 GET ZERO LENGTH INDICATOR 01262246 + CH R1,XIOLENG ARE THEY EQUAL? 01262248 + BE X&DIREC.EOF . YES-GO CLOSE AND FORGET FILE 01262250 + XXGPSRCH &DIREC 01262252 +* THE FOLLOWING CODE, IF EXECUTED, GENERATES A DCB AND TRIES AN OPEN 01262254 +* 01262256 +X&DIREC.MAKE C R1,=A(X&DIREC.FULL) CHECK FOR TABLE OVERFLOW 01262258 + BNL X&DIREC.CC3 NO SPACE, DON'T TRY OPEN-RETURN J 01262260 + ST R1,X&DIREC.ELEM . SAVE NEW ADDRESS, R1 ALREADY POINTIN 01262266 + MVC 0(8,R1),X&DIREC.CURENT SAVE DD NAME FOR FUTURE CALLS 01262268 + L 0,X&DIREC.LONG LOAD R2 WITH LENGTH OF DCB 01262270 + GETMAIN R,LV=(0) . GET SPACE FROM OS 01262272 + L R2,X&DIREC.ELEM . GET ADDRESS OF POINTER 01262274 + ST R1,8(R2) . SAVE @ OF DCB 01262276 +* 01262278 + ST R1,X&DIREC.FULL KLUDGE TO GET AROUND ADDRESSIBILITY 01262280 + MVC X&DIREC.OPEN+1(3),X&DIREC.FULL+1 COPY OVER DCB @ INTO J 01262282 +* 01262284 + MVC 0(X&DIREC.ELEM-X&DIREC.DCB,R1),X&DIREC.DCB BUILD DCB 01262286 + MVC DCBDDNAM,X&DIREC.CURENT MOVE DD NAME INTO DCB 01262288 + OPEN MF=(E,X&DIREC.DCBPTR) DO REMOTE OPEN 01262290 + L R1,X&DIREC.FULL . FIX R1, DESTROYED IN OPEN 01262302 + TM DCBOFLGS,X'10' . DID OPEN GO? 01262304 + BO X&DIREC.CONT4 YES, DO I/O 01262306 +* OPEN DIDN'T GO - CLEAN UP SO DOESN'T BOMB LATER J 01262307 + L R0,X&DIREC.LONG GET LENGTH OF DCB FOR FREEMAIN J 01262308 + FREEMAIN R,LV=(0),A=(1) GIVE THE SPACE BACK TO OS J 01262309 + XC 0(12,R2),0(R2) CLEAR OUT SO WON'T THINK IT'S OPEN J 01262310 +X&DIREC.CC3 TM *+1,X'FF' SET CC=3 ==> OPEN IMPOSSIBLE J 01262311 + B X&DIREC.RET RETURN TO USER 01262312 + SPACE 2 01262314 +X&DIREC.CONT L R1,8(R1) . GET DCB ADDRESS 01262316 +X&DIREC.CONT4 LH R5,XIOLENG GET LENGTH OF AREA 01262318 + AIF ('&FETCH' EQ 'PROTECT').SKPFTCH 01262320 + L R2,X&DIREC.SAV1+12 GET @ I/O AREA 01262322 +* THE FOLLOWING CODE IS USED FOR ADDRESS ILLEGAL ****************** 01262324 +***** THIS CODE WILL NOT WORK IF MACHINE HAS FETCH PROTECT *********** 01262326 + SPACE 2 01262328 + L R4,16 . GET CVT PNTR FROM LOC 16 01262330 + LA R0,0(R2,R5) . GET ENDING ADDRESS OF I/O AREA 01262332 + C R0,164(R4) . COMPARE TO CVTMZ00 - HIGHEST ADDRESS 01262334 + BNL X&DIREC.ABD3 . GO ABEND IF HIGHER 01262336 +.SKPFTCH ANOP 01262338 + AIF ('&DIREC' EQ 'P').XOUT SKIP IF OUTPUT 01262340 + LH R7,DCBLRECL GET LRECL FROM DCB J 01262341 + GET IHADCB . GET # BUFFER 01262342 + CLR R5,R7 COMPARE REQUEST LENGTH TO LRECL J 01262343 + BNH *+6 SKIP AROUND IF OK J 01262344 + LR R5,R7 TOO BIG, USE LRECL INSTEAD J 01262345 + LR R4,R5 . SET UP FOR SHIFT 01262346 + SRDL R4,8 . PUT RIGHTMOST BYTE IN R5 01262348 + SRL R5,24 . RIGHT JUSTIFY FOR MOVE 01262350 + LTR R4,R4 . ANYTHING LEFT IN R4? 01262352 + BE *+22 . NO - DO NORMAL MOVE 01262354 + MVC 0(256,R2),0(R1) . GIVE USER 256 BYTES OF DATA 01262356 + LA R2,256(R2) . GO TO NEXT BLOCK 01262358 + LA R1,256(R1) . GO TO NEXT BLOCK 01262360 + BCT R4,*-14 . IF ANYTHING LEFT IN R4, DO ANOTHER 01262362 +* NORMAL MOVE FOLLOWS 01262364 + LTR R5,R5 . IS ANYTHING IN R5? 01262366 + BE *+10 . NO - DONT MOVE LEFTOVER BYTES 01262368 + BCTR R5,0 . DECREMENT LENGTH BY 1 01262370 + EX R5,X&DIREC.MOV . MOVE INTO RIGHT PLACE 01262372 +.XCLOSE ANOP 01262374 + SR R0,R0 . SET COND CODE TO 0, USER OK 01262376 + B X&DIREC.RET . GO TO RETURN B 01262378 +X&DIREC.EOF EQU * CLOSE IHADCB 01262380 + XXGPSRCH &DIREC,2 01262382 +X&DIREC.MAKE2 B X&DIREC.RET . GO RETURN 01262384 +X&DIREC.CONT2 LR R4,R1 . SAVE THE ADDRESS 01262386 + MVC X&DIREC.PTR+1(3),9(R1) 01262390 + LA R1,X&DIREC.PTR 01262392 + CLOSE MF=(E,(1)) DO REMOTE CLOSE 01262398 + L R1,8(R4) . POINT TO DCB TO FREE 01262400 + FREEPOOL (1) FREE THE BUFFERS 01262402 + L R1,8(R4) RESET R1 IN CASE DESTROYED 01262404 + L R0,X&DIREC.LONG GET AMOUNT TO FREE 01262406 + FREEMAIN R,LV=(0),A=(1) 01262408 +* 01262410 +* DCB NO LONGER EXISTS, REMOVE CORRESPONDING ELEMENT FROM LIST 01262412 +* 01262414 + LA R3,X&DIREC.FULL . GET UPPER ADDRESS OF TABLE 01262416 + SR R3,R4 . FIND LENGTH OF REST OF TABLE 01262418 + EX R3,X&DIREC.WIPOUT WIPE OUT 12 BYTES OF MEMORY 01262420 +* 01262422 +* IF NO POINTERS REMAIN, SET POINTER TO LAST = ZERO 01262424 +* 01262426 + LA R3,12 01262428 + L R2,X&DIREC.ELEM 01262430 + SR R2,R3 01262432 + LA R1,X&DIREC.PNTSRT 01262434 + CR R1,R2 01262436 + BNH *+8 01262438 + LA R2,0 . SET POINTER TO ZERO 01262440 + ST R2,X&DIREC.ELEM SAVE POINTER 01262442 + AIF ('&DIREC' EQ 'P').XRET 01262444 + OI *+1,1 . SET COND CODE FOR END OF FILE 01262446 +.* SHOULD REMOVE DCB FROM LIST NOW 01262448 + AGO .XRET . HAVE RETURN CODE GENERATED 01262450 +.* 01262452 +.XOUT ANOP 01262454 + LH R7,82(R1) . GET LRECL 01262456 + PUT IHADCB . PRINT THE STUFF 01262458 + CLR R5,R7 COMPARE REQUEST LENGTH TO LRECL J 01262459 + BNH *+6 SKIP AROUND IF OK LENGTH J 01262460 + LR R5,R7 TOO BIG- USE LRECL INSTEAD J 01262461 + LR R4,R5 . SET UP FOR SHIFT 01262462 + LR R6,R5 SAVE FOR LATER 01262464 + SRDL R4,8 . PUT RIGHTMOST BYTE IN R5 01262466 + SRL R5,24 . RIGTH JUSTIFY FOR MOVE 01262468 + LTR R4,R4 . ANYTHING LEFT IN R4? 01262470 + BE *+22 . NO - DO NORMAL MOVE 01262472 + MVC 0(256,R1),0(R2) . PUT STUFF INTO BUFFER 01262474 + LA R2,256(R2) . GO TO NEXT BLOCK 01262476 + LA R1,256(R1) . GO TO NEXT BLOCK 01262478 + BCT R4,*-14 . IF ANYTHING LEFT IN R4, DO ANOTHER 01262480 +* NORMAL MOVE FOLLOWS 01262482 + LTR R5,R5 . IS ANYTHING IN R5? 01262484 + BE *+12 01262486 + BCTR R5,0 . DECREMENT LENGTH BY 1 01262488 + EX R5,X&DIREC.MOV . MOVE INTO RIGHT PLACE 01262490 + AR R1,R5 GET BEGINNING @ TO BLANK 01262492 + SR R7,R6 GET DIFFERENCE BETWEEN USER AND DCB 01262494 + BZ *+12 NO DIFFERENCE, DO NOTHING A 01262496 + MVI 1(R1),C' ' 01262498 + EX R7,X&DIREC.MOV2 CLEAR REST 01262500 +* ****NOTE THAT THIS ONLY WORKS FOR DIFFERENCES < 256 01262502 + AGO .XCLOSE 01262504 +.* 01262506 +.XRET ANOP 01262508 + SPACE 2 01262510 +X&DIREC.RET LM R13,R7,X&DIREC.SAV1 RESTORE REGS A 01262512 + B XIORETRN RETURN 01262514 + DROP R14 01262516 +X&DIREC.ABD3 CLI *,0 SET CC=2, SHOW EXECUTE ERROR J 01262518 + B X&DIREC.RET GO RETURN, SHOWING ERROR J 01262520 +.* 01262524 + SPACE 2 01262526 +X&DIREC.PTR CLOSE (X&DIREC.CONT),MF=L GENERAL PURPOSE CLOSE 01262527 +X&DIREC.WIPOUT MVC 0(1,R4),12(R4) 01262528 +X&DIREC.CURENT DS CL8 . AREA TO HOLD CURRENT DD NAME 01262530 +X&DIREC.SAV1 DS 11F SAVE AREA FOR REGS USED A 01262532 +X&DIREC.PNTSRT DS (&DDNUM*3)F . AREA FOR DDNUM DD NAMES & POINTERS 01262534 +X&DIREC.FULL DS F 01262536 +X&DIREC.OPEN DS 0F EXTRA LABEL 01262537 + AIF ('&DIREC' EQ 'P').XDEFSR SKIP IF OUTPUT 01262538 +X&DIREC.DCBPTR OPEN (X&DIREC.CONT,(INPUT)),MF=L OPEN CONTROL WORD J 01262539 +X&DIREC.DCB DCB DSORG=PS,MACRF=GL,EODAD=X&DIREC.EOF 01262540 +X&DIREC.ELEM DC F'0' . INITIAL # OF ELEMENTS 01262542 +XX&DIREC.LONG EQU X&DIREC.ELEM-X&DIREC.DCB GET DCB LENGTH 01262544 +X&DIREC.LONG DC A(XX&DIREC.LONG) SAVE LENGTH OF DCB 01262546 +X&DIREC.MOV MVC 0(1,R2),0(R1) . GIVES USER THE DATA 01262548 + LTORG 01262550 + DROP R13 01262552 + MEXIT DONE 01262554 +.XDEFSR ANOP 01262556 +X&DIREC.DCBPTR OPEN (X&DIREC.CONT,(OUTPUT)),MF=L OPEN CONTROL WORD J 01262557 +X&DIREC.DCB DCB DSORG=PS,MACRF=PL 01262558 +X&DIREC.ELEM DC F'0' . INITIAL # OF ELEMENTS 01262560 +XX&DIREC.LONG EQU X&DIREC.ELEM-X&DIREC.DCB GET DCB LENGTH 01262562 +X&DIREC.LONG DC A(XX&DIREC.LONG) SAVE LENGTH OF DCB 01262564 +X&DIREC.MOV MVC 0(1,R1),0(R2) . MOVE INTO LINE 01262566 +X&DIREC.MOV2 MVC 2(1,R1),1(R1) CLEAR OUT REST OF BUFFER 01262568 + LTORG 01262570 + DROP R13 01262572 + MEND 01262574 + TITLE '***MACRO*** XDDSLOT GENERATES XGET-XPUT CONTROL TABLE' 01262576 + MACRO 01262578 +&LABEL XDDSLOT &NAME,&WHICH,&POSIN=0,&POSOUT=0,&PERM=1,&REST1=00, X01262580 + &REST2=0 01262582 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01262583 +.*--> MACRO: XDDSLOT CREATE TABLE ENTRY FOR XGET-XPUT * 01262584 +.* RICHARD FOWLER OCT. 1972. V.5.0 * 01262586 +.* * 01262588 +.* THIS MACRO GENERATES AN ELEMENT TO HELP ASSIST KEEP * 01262590 +.* CONTROL OF THINGS WHILE EXECUTING XGET-XPUT. * 01262592 +.* &NAME CHAR STRING OF RESERVED DD NAME * 01262594 +.* &WHICH MISSING OR IN ERROR, USER MAY XGET-XPUT IT * 01262596 +.* =XREAD USER CAN XREAD ONLY * 01262598 +.* =XPRNT USER CAN XPRNT ONLY * 01262600 +.* =XPNCH USER CAN XPNCH ONLY * 01262602 +.* * 01262604 +.* &POSIN = 1 CAN INPUT * 01262606 +.* = 0 CANNOT INPUT * 01262608 +.* * 01262610 +.* &POSOUT = 1 CAN OUTPUT * 01262612 +.* = 0 CANNOT OUTPUT * 01262614 +.* &PERM = 1 ON REENTERING, &NAME WILL STILL EXIST * 01262616 +.* =0 &NAME WILL NOT EXIST ON REENTERING * 01262618 +.* * 01262620 +.* &REST 1,2 NOT USED * 01262622 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01262624 + AIF (T'&NAME EQ 'O').DDEMPTY CREATE AN EMPTY SLOT 01262626 +&LABEL DC CL8'&NAME' . NO, SHOVE IN DDNAME 01262628 +.* SET BITS, NOTE NOT CURRENTLY OPEN 01262630 + DC B'00&REST1&POSOUT&POSIN&REST2&PERM' 01262632 + AIF (T'&WHICH NE 'O').DDSK1 WAS &WHICH OMITTED 01262634 +.DDSK4 DC XL1'00' . YES ASSUME XGET-XPUT 01262636 + MEXIT 01262638 +.DDSK1 AIF ('&WHICH' NE 'XREAD').DDSK2 READ ONLY? 01262640 + DC XL1'04' . YES, FIX INDEX 01262642 + MEXIT 01262644 +.DDSK2 AIF ('&WHICH' NE 'XPRNT').DDSK3 DO WRITES ONLY? 01262646 + DC XL1'08' . YES, FIX INDEX 01262648 + MEXIT 01262650 +.DDSK3 AIF ('&WHICH' NE 'XPNCH').DDSK4 IF INVALID, ASSUM XGET-XPUT 01262652 + DC XL1'0C' . VALID, SET INDEX 01262654 + MEXIT 01262656 +.DDEMPTY ANOP 01262658 +&LABEL DC CL8' ' . BLANK DDNAME 01262660 + DC XL2'0C00' . BLANK EVERYTHING, XGET-XPUT ALLOWED 01262662 + MEND 01262664 + TITLE '*** LINKAGE MACROS - $CALL,$RETURN,$SAVE ***' 01264000 + MACRO 01266000 +&LABEL $CALL &ENTRY 01268000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01268200 +.*--> MACRO: $CALL SUBROUTINE CALL INSIDE ASSIST ASSEMBLER. * 01268400 +.* &ENTRY ENTRY POINT NAME TO BE CALLED, OS LINKAGE. * 01268600 +.* **NOTE** GENERATES NAME WITH AX PREFIX, SO CAN ONLY BE USED * 01268800 +.* INSIDE ASSEMBLER WHERE AVWXTABL USING HOLDS. * 01269000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01269200 +&LABEL L REP,AX&ENTRY . GET ADCON FROM THE TABLE 01270000 + BALR RET,REP . CALL THE DESIRED ROUTINE 01272000 + MEND 01274000 + SPACE 2 01276000 + MACRO 01278000 +&LABEL $RETURN &RGS=NO,&SA= 01280000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01280200 +.*--> MACRO: $RETURN RETURN FROM SUBROUTINE, OS LINKAGE. * 01280400 +.* SUPPLIES EXTRA DEBUGGING CONTROL AND DEFAULTS TO XRETURN. * 01280600 +.* USES MACROS: XRETURN * 01280800 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01281000 + GBLC &TRACE SPECIFIES FORM OF TRACE-SNAP,*,NO 01282000 +&LABEL XRETURN RGS=&RGS,SA=&SA,TR=&TRACE 01284000 + MEND 01286000 + SPACE 2 01288000 + MACRO 01290000 +&LABEL $SAVE &RGS=NO,&BR=15,&SA= 01292000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01292200 +.*--> MACRO: $SAVE SUBROUTINE ENTRY SETUP, OS LINKAGE. * 01292400 +.* SUPPLIES EXTRA DEBUGGING CONTROL AND DEFAULTS TO XSAVE MACRO.* 01292600 +.* USES MACROS: XSAVE * 01292800 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01293000 + GBLC &TRACE,&ID TRACE FORM, IDENT 01294000 +&LABEL XSAVE RGS=&RGS,BR=&BR,SA=&SA,TR=&TRACE,ID=&ID 01296000 + MEND 01298000 + SPACE 2 01300000 + MACRO 01302000 + $DBG &D,&T 01304000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01304500 +.*--> MACRO: $DBG SET TRACE, DEBUGGING SET VARIABLES FOR ASM. * 01305000 +.* &D HEX FLAG BYTE FOR USE IN TM INSTRUCTION. * 01305500 +.* &T IS TRACE MODE FOR AN XSNAP = NO,*,SNAP. * 01306000 +.* SEE MACROS $RETURN,$SAVE,XSRTR FOR GENERATION OF TRACE CODE * 01306500 +.* ON ROUTINE ENTRY/EXIT. SEE ALSO ASSIST PROGRAM LOGIC MANUAL. * 01307000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01307500 + GBLC &DEBUG,&TRACE DEBUG FLAG BYTE,TRACE MODE 01308000 + AIF ('&D' EQ '').D1 SKIP IF OMITTED,DON'T CHANGE 01310000 +&DEBUG SETC 'X''&D''' SET FLAG BYTE FOR MASK 01312000 +.D1 AIF ('&T' EQ '').D2 SKIP IF NOTRACE,DON'T CHANGE 01314000 +&TRACE SETC '&T' SET UP TRACE MODE,IF ANY 01316000 +.D2 MEND 01318000 + TITLE '*** $AL2 MACRO - CREATE AL2 JUMP INDEX CONSTANTS ***' 01320000 + MACRO 01322000 +&LABEL $AL2 &BASE,&LIST,&OFSET,&L 01324000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01324500 +.*--> MACRO: $AL2 CREATE HALFWORD ADDRESS OFFSET TABLE. * 01325000 +.* USED TO GENERATE LIST OF AL2 ADDRESS CONSTANTS WHICH * 01326000 +.* CONTAIN THE RELATIVE ADDRESS OF EACH ITEM IN &LIST FROM &BASE* 01328000 +.* &OFSET GIVES A NUMBER TO BE ADDED OR SUBTRACTED WHEN SETTING * 01330000 +.* UP THE EQU FOR THE LABEL,SO THAT INDEXING MAY START ANYWHERE * 01332000 +.* &L IS CODED IF THE OFFSET LIST SHOULD BE PRECEDED BY LENGTH * 01334000 +.* SET UP FOR BXLE . * 01336000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01337000 + LCLA &I LOCAL COUNTER 01338000 + DS 0H ALIGN 01340000 + AIF (T'&LABEL EQ 'O').XCHKL SKIP IF NO LABEL 01342000 +&LABEL EQU *&OFSET 01344000 +.XCHKL AIF (T'&L EQ 'O').XNOFS1 SKIP IF LENGTH OMITTED 01346000 +&I SETA N'&LIST*2-2 SET UP FOR BXLE-# OF OPS 01348000 + DC H'&I' 01350000 +&I SETA 0 RESET COUNTER 01352000 +.XNOFS1 ANOP 01354000 +&I SETA &I+1 01356000 + DC AL2(&LIST(&I)-&BASE) 01358000 + AIF (&I LT N'&LIST).XNOFS1 KEEP LOOPING UNTIL DONE 01360000 + MEND 01362000 + TITLE '*** $SPIE - EXTENDED INTERRUPT COMMUNICATIONS ***' 01362200 + MACRO 01362210 +&LABEL $SPIE &EXIT,&TYPES,&CE=0,&ACTION=INIT 01362220 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01362225 +.*--> MACRO: $SPIE INTERRUPT COMMUNICATIONS * 01362230 +.* SCOTT A. SMITH - FALL 1971. * 01362240 +.* MAY BE USED BY OS OR DOS SYSTEMS TO SPECIFY THE ADDRESS * 01362250 +.* OF AN INTERRUPTION EXIT ROUTINE AND TO SPECIFY THE PROGRAM * 01362260 +.* INTERRUPT TYPES THAT ARE TO CAUSE THE EXIT ROUTINE TO BE * 01362270 +.* GIVEN CONTROL. * 01362280 +.* &EXIT LABEL TO BE BRANCHED TO FOR THE INTERRUPTION * 01362290 +.* EXIT. ADDRESS MAY BE IN A REGISTER. * 01362300 +.* &TYPES A LIST OF INTERRUPTION TYPES TO CATCH. IF THIS * 01362310 +.* IS NOT SPECIFIED, A DEFAULT VALUE OF ((1,15)) * 01362320 +.* IS ASSUMED. THE FORM OF THIS OPERAND IS A LIST * 01362330 +.* OF OPERANDS SEPARATED BY COMMAS. THE LIST ITSELF * 01362340 +.* IS ENCLOSED IN PARENTHESES WITH EACH OPERAND * 01362350 +.* SPECIFYING A GROUP OF INTERRUPT TYPES TO CATCH. * 01362360 +.* EACH OF THESE IS EITHER A SINGLE INTEGER BETWEEN * 01362370 +.* 1 AND 15, OR A PAIR OF INTEGERS BETWEEN 1 & 15 * 01362380 +.* REPRESENTING AN INCLUSIVE RANGE OF INTERRUPTS. * 01362390 +.* EACH PAIR IS ENCLOSED IN PARENTHESES. * 01362400 +.* &ACTION= SPECIFIES THE ACTION THIS MACRO IS TO TAKE. * 01362410 +.* -->INIT: IDENTIFIES THIS AS AN INITIAL $SPIE CALL * 01362420 +.* AND INITIALIZATION IS TO BE PERFORMED. * 01362430 +.* -->CR: CREATE A NEW $SPIE COMMUNICATION, BUT DO * 01362440 +.* NOT REINITIALIZE. * 01362450 +.* -->(RS,(REG)) RESTORE A PREVIOUS $SPIE COMMUNICATION * 01362460 +.* LINK USING THE XSPIEBLK AT THE ADDRESS IN THE * 01362470 +.* REGISTER. ALL OTHER PARAMETERS ARE IGNORED * 01362480 +.* ***DEFAULT***INIT * 01362490 +.* &CE= THIS SPECIFIES AN OPTIONAL CALLABLE EXIT WHICH * 01362500 +.* MAY RECEIVE TEMPORARY CONTROL IMMEDIATELY FOLLOW- * 01362510 +.* ING AN INTERRUPT. THIS EXIT MUST RETURN. * 01362520 +.* *REGISTERS 14,15,0,1 ARE DESTROYED BY THIS MACRO* * 01362530 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01362540 + LCLA &I,&PTRVAL,&ENDVAL 01362550 + LCLB &BIT(15),&J,&K 01362560 + LCLC &STR,&PTR,&END,&NAME 01362570 + SPACE 1 . SEPARATE FROM MAIN LINE CODE 01362580 + AIF ('&LABEL' EQ '').NOLAB DO NOT GENERATE A LABEL IF NONE 01362590 +&LABEL DS 0H . GENERATE USER LABEL 01362600 +.NOLAB AIF ('&ACTION(1)' NE 'INIT').NOINT NO INITIALIZATION 01362610 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01362620 +.* PERFORM CALL TO XXXXSPIN FOR INITIALIZATION * 01362630 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01362640 +.INITIAL CNOP 0,4 . ALIGNMENT FOR ADCON 01362650 + BAL R14,*+8 . SKIP AROUND ADCON FOR XXXXSPIN 01362660 + DC V(XXXXSPIN) . INITIALIZATION ADCON 01362670 + L R15,0(R14) . LOAD INITIALIZATION ROUTINE ADDRESS 01362680 + BALR R14,R15 . GO INITIALIZE, RETURN FOR XXXXSPIE 01362690 + AGO .CREATE SKIP ACTION CHECK, ALREADY KNOW 01362700 +.NOINT AIF ('&ACTION(1)' EQ 'RS').RSTR RESTORE OLD XSPIEBLK 01362710 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01362720 +.* INITIALIZE A BIT STRING TO REPRESENT THE INTERRUPT TYPES * 01362730 +.* TO CATCH FOR THIS PARTICULAR $SPIE * 01362740 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01362750 +.CREATE AIF ('&TYPES' NE '').LIST IF OMMITED, GET ALL INTERRUPTS 01362760 +&PTRVAL SETA 1 SET POINTER TO START AT SOC #1 01362770 +&ENDVAL SETA 15 FLAG ALL INTERRUPTS UP TO SOC #15 01362780 + AGO .NEXT MAKE APPROPRIATE BIT MARKS 01362790 +.LIST ANOP 01362800 +&I SETA 1 START SCAN OF TYPES FIELD AT LOC9 1 01362810 +.TOP AIF ('&TYPES(&I)' EQ ' ').SKIP TO SKIP EMBEDDED BLANKS 01362820 +&STR SETC '&TYPES(&I)' SAVE NEXT CHAR IN TYPES STRING 01362830 + AIF ('&STR'(1,1) NE '(').SINGLE FOR NON-PAIRS OF TYPES 01362840 +&PTR SETC '&STR'(2,1) ASSUME ONE DIGIT LONG 01362850 + AIF ('&STR'(3,1) EQ ',').OKLOOK IT WAS ONE DIGIT, GET #2OP 01362860 +&PTR SETC '&STR'(2,2) FIRST TYPE: 2 DIGITS LONG 01362870 +&END SETC '&STR'(5,2) SHOULD BE LEN=2; IF NOT, CAUGHT LATR 01362880 + AGO .SETOK HAVE CHAR STRINGS OF TWO TYPE LIMITS 01362890 +.OKLOOK ANOP FIND TYPE LIM #2 DIGIT LENGTH 01362900 +&END SETC '&STR'(4,1) ASSUME OF LENGTH 1, SINCE FIRST WAS 01362910 + AIF ('&STR'(5,1) EQ ')').SETOK IT IS OF LENGTH 1, SO IS OK 01362920 +&END SETC '&STR'(4,2) SECOND LIMIT IS A 2 DIGIT # 01362930 +.SETOK ANOP 01362940 +&PTRVAL SETA &PTR GET INTEGER VALUE FOR BIT MARKING 01362950 +&ENDVAL SETA &END INTEGER ENDING VALUE 01362960 + AIF (&PTRVAL GT &ENDVAL OR &PTRVAL LT 1 OR &ENDVAL GT 15).ER 01362970 +.NEXT ANOP LOOP TO SET UP BIT MARKERS FOR TYPES 01362980 +&BIT(&PTRVAL) SETB 1 MARK THIS INTERRUPT TO BE CAUGHT 01362990 + AIF (&PTRVAL EQ &ENDVAL).SKIP ALL DONE, SEE IF MORE INTRPS 01363000 +&PTRVAL SETA &PTRVAL+1 FLAG NEXT INTERRUPT TYPE TO CATCH 01363010 + AGO .NEXT MARK IT IN BIT FLAG FIELD 01363020 +.SINGLE AIF (&TYPES(&I) LT 1 OR &TYPES(&I) GT 15).ER OUT OF RANGE 01363030 +&BIT(&STR) SETB 1 CATCH THIS INTERRUPT TYPE (BIT MARK) 01363040 +.SKIP ANOP GET NEXT OPERAND FROM &CATCH 01363050 +&I SETA &I+1 UP SCAN POINTER TO NEXT LOC. 01363060 + AIF (&I LE N'&TYPES).TOP GET NEXT MASK SPEC., IF IT EXIST 01363070 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01363080 +.* WE HAVE THE BIT STRING INITIALIZED, NOW WE MUST BUILD UP * 01363090 +.* THE NEW XSPIEBLK FOR NEW INTERRUPTS AND EXIT ADDRESSES. * 01363100 +.* DETERMINE THE PRESENCE & NATURE OF INTERRUPT EXIT ROUTINE * 01363110 +.* ADDRESS AND THE CALLABLE EXIT ADDRESS, AND PUT IN XSPIEBLK * 01363120 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01363130 + CNOP 2,4 . ALIGNMENT FOR ADCONS 01363140 + LA R1,*+18 . ADDRESS FOR BRANCH AROUND XSPIEBLK 01363150 + BALR R1,R1 . BR AROUND BLK; R1 <= @ XSPIEBLK 01363160 + AIF ('&EXIT' EQ '').NOEXIT NO EXIT RTN @ SUPPLIED 01363170 + AIF ('&EXIT'(1,1) EQ '(').INREG EXIT RTN @ IS IN A REGISTER 01363180 + DC AL4(&EXIT) . # OF EXIT RTN 01363190 +.CONT AIF ('&CE'(1,1) EQ '(').CEREG @ IS IN A REGISTER 01363200 + DC AL4(&CE) . CALLABLE EXIT ROUTINE ADDRESS 01363210 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01363220 +.* EXPAND BIT PATTERN FOR INTERRUPT TYPES TO CATCH. EXPANDED * 01363230 +.* TO A FULLWORD FOR EASIER MANIPULATION * 01363240 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01363250 +.INT DC B'0&BIT(1)&BIT(2)&BIT(3)&BIT(4)&BIT(5)&BIT(6)&BIT(7)&BITX01363260 + (8)&BIT(9)&BIT(10)&BIT(11)&BIT(12)&BIT(13)&BIT(14)&BIT(1X01363270 + 5)',BL2'0' . BIT PATTERN WITH PADDED ZEROS 01363280 + AIF (NOT &J).KEF SKIP IF &EXIT NOT IN REGISTER 01363290 + ST &EXIT(1),0(0,R1) . STORE REG VALUE FOR &EXIT @ 01363300 +.KEF AIF ('&CE'(1,1) NE '(').XSPYCAL . SKIP IF &CE NOT IN REG. 01363310 + ST &CE(1),4(0,R1) . STORE CALLABLE EXIT @ IN XSPIEBLK 01363320 + AGO .XSPYCAL GO FOR A CALL TO XXXXSPIE TO CHNG PT 01363330 +.INREG ANOP &EXIT IS IN A REGISTER 01363340 +&J SETB 1 FLAG THIS CONDITION SO WE STORE @ 01363350 +.NOEXIT DC AL4(0) . SET ASIDE LOCATION FOR EXIT @ 01363360 + AGO .CONT SEE ABOUT SECOND ADDRESS 01363370 +.CEREG DC AL4(0) . @ FOR RESERVING LOC. FOR CALLABLE EX 01363380 + AGO .INT GENERATE BIT PATTERN FOR INTERRUPTS 01363390 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01363400 +.* HERE WE ARE INTERESTED IN RESTORING AN OLD XSPIEBLK. GET * 01363410 +.* XSPIEBLK ADDRESS IN R1. * 01363420 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01363430 +.RSTR ANOP 01363440 +&PTR SETC '&ACTION(2)' GET SECOND ARGUMENT: REG. IN PARENS 01363450 +&END SETC '&PTR'(2,1) ASSUME ONLY A ONE DIGIT NUMBER 01363460 +&I SETA &END CONVERT CHARACTER # TO ACTUAL # 01363470 + AIF ('&PTR'(3,1) EQ ')').CHKR1 ASSUMPTION WAS RIGHT 01363480 +&END SETC '&PTR'(2,2) GET THE TWO DIGIT NUMBER 01363490 +&I SETA &END CONVERT CHARACTER # TO ACTUAL # 01363500 +.CHKR1 AIF (&I EQ 1).XSPYCAL DON'T DO A : LR 1,1 01363510 + LR R1,&I . GET @ OF OLD XSPIEBLK IN REG #1 01363520 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01363530 +.* PREPARE CALL TO XXXXSPIE AND THEN CALL IT. R1 SHOULD BE * 01363540 +.* POINTING TO THE NEW (OR OLD, IN CASE OF ACTION=(RS)) SPYBLK * 01363550 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01363560 +.XSPYCAL CNOP 0,4 . ALIGNMENT FOR UPCOMING ADCON 01363570 + B *+8 . SKIP AROUND XXXXSPIE ADCON 01363580 + DC V(XXXXSPIE) . ENTRY POINT @ FOR ACTION EXECUTION 01363590 + L R15,*-4 . R15 <- @ OF XXXXSPIE FOR CALL 01363600 + BALR R14,R15 . CHANGE XSPIEBLK POINTERS--RETURN OL@ 01363610 + AGO .XXIT RETURN 01363620 +.ER MNOTE 4,'**ERROR--INVALID SEQUENCE OF INTERRUPT TYPES--$SPIE CX01363630 + ANCELLED' 01363640 +.XXIT SPACE 1 01363650 + MEND 01363660 + TITLE '*** XSRTR-XSAVE/XRETURN TRACE-ASSIST VERSION ***' 01364000 + MACRO 01366000 + XSRTR &TR,&LABEL,&MSG 01368000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01370000 +.*--> MACRO: XSRTR CREATE SPECIAL ASSIST ENTRY/EXIT TRACE CODE. * 01371000 +.* JOHN R. MASHEY-JULY 1969-360/67* 01372000 +.* THIS MACRO IS USED BY XSAVE AND XRETURN TO GENERATE THE * 01374000 +.* TRACE CODE CALLS TO XPRNT OR XSNAP, IF THE TR OPERAND IS USED* 01376000 +.* *NOTE* THIS IS MODIFIED VERSION FOR USE IN ASSIST ONLY. * 01378000 +.* USES MACROS: XSNAP * 01379000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01380000 + GBLB &XSNAPST XSNAP STATUS;0==>ON,1==>OFF 01382000 + GBLB &$DEBUG DEBUG MODE FLAG,0==>YES,1==>NO 01384000 + GBLC &DEBUG DEBUG FLAG BITS FOR TESTING 01386000 + LCLB &XSTSAV FOR SAVING STATUS VARIABLES 01388000 + LCLC &NAME FOR EITHER LABEL OR CSECT 01390000 + LCLC &T FOR TYPE 01392000 + AIF (&$DEBUG).XXEXIT SKIP WHOLE THING IF NO DEBUG 01394000 +&NAME SETC '&LABEL' ASSUME NAME IS LABEL 01396000 + AIF (T'&LABEL NE 'O').XNOK1 SKIP IF LABEL EXISTS 01398000 +&NAME SETC '&SYSECT' USE CSECT NAME INSTEAD 01400000 + AIF ('&SYSECT' NE '').XNOK1 SKIP IF CSECT NOT PC 01402000 +&NAME SETC '$PRIVATE' USE NAME FOR PRIVATE CODE (PC) 01404000 +.XNOK1 ANOP 01406000 +&XSTSAV SETB (&XSNAPST) SAVE XSNAP STATUS, IN CASE OFF 01408000 +&XSNAPST SETB (0) MAKE SURE XSNAP WILL GENERATE 01410000 +* XSNAP LABEL=' MESSAGE ' 01412000 +&T SETC 'PR' FOR NORMAL PRINTING OF REGS 01414000 + AIF ('&TR(1)' NE '*').XDFTB SKIP AND PRINT REGS 01416000 +&T SETC 'NO' DO NOT PRINT REGISTERS 01418000 +.XDFTB XSNAP LABEL='*** &NAME &MSG ***',T=&T,IF=(AVDEBUG,O,&DEBUG,TM) 01420000 +&XSNAPST SETB (&XSTSAV) RESTORE STATUS,IN CASE IT WAS OFF 01422000 +.XXEXIT MEND 01424000 + TITLE '*** ALIGN LOCATION COUNTER MACROS - $ALIGN,$ALIGR ***' 01426000 + MACRO 01430000 +&LABEL $ALIGN &R,&A,&TAG 01432000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01432500 +.*--> MACRO: $ALIGN GET,ALIGN, RESTORE UPDATED LOCATION COUNTER. * 01433000 +.* USED TO ALIGN LOCATION COUNTER TO H, F, OR D BOUNDARIES. * 01434000 +.* &R WILL CONTAIN ALIGNED VALUE OF LOCATION COUNTER * 01436000 +.* &A GIVES ALIGNMENT REQUIRED , IF IN PARENTHESES, GIVES REG, * 01438000 +.* IF NOT, GIVES DECIMAL NUMBER 1-3-7 FOR H,F,D ALIGN * 01440000 +.* &TAG IF CODED-MEANS THAT LOCATION COUNTER IS ALREADY IN &R. * 01442000 +.* USES MACROS: $ALIGR,$GLOC,$SLOC * 01442500 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01443000 + AIF (T'&TAG EQ 'O').XNORM NORMAL USE 01444000 + AIF (T'&LABEL EQ 'O').XC SKIP IF NOT NEEDED 01446000 +&LABEL DS 0H 01448000 + AGO .XC SKIP TO DECIDE 01450000 +.XNORM ANOP 01452000 +&LABEL $GLOC &R . GET THE LOCATION COUNTER 01454000 +.XC AIF ('&A'(1,1) EQ '(').XREG SKIP IF REGISTER FORM 01456000 + LA &R,&A.(&R) . INCREMENT THE LOCATION COUNTER 01458000 + O &R,AWF&A . MAKE LAST BITS ALL 1'S 01460000 + S &R,AWF&A . SUBTRACT,GETTING RIGHT ALIGNMENT 01462000 + AGO .XST GO STORE IT BACK 01464000 +.XREG $ALIGR &R,&A 01466000 +.XST $SLOC &R . STORE LOCATION COUNTER BACK 01468000 + MEND 01470000 + SPACE 2 01472000 + MACRO 01474000 +&LABEL $ALIGR &R,&A 01476000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01476500 +.*--> MACRO: $ALIGR ALIGN VALUE IN REGISTER (USUALLY LOCCNTR). * 01477000 +.* ALIGN REGISTER MACRO-ALIGN REGISTER &R TO BOUNDARY GIVEN * 01478000 +.* BY VALUE IN REG &A, WHICH HAS 1,3,7 ETC IN IT. * 01480000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01481000 +&LABEL AR &R,&A . ADD LENGTH-1 TO LOCATION COUNTER 01482000 + OR &R,&A . MAKE LAST 1-3 BITS ALL 1'S 01484000 + SR &R,&A . ALIGN VALUE APPROPRIATELY 01486000 + MEND 01488000 + TITLE '*** MISC LOC-COUNTER MACROS-$CKALN,$GLOC,$SLOC ***' 01490000 + MACRO 01492000 +&LABEL $CKALN &MASK,&B 01494000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01494500 +.*--> MACRO: $CKALN CHECK LOC-COUNTER ALIGNMENT, BRANCH IF OK. * 01495000 +.* USED TO CHECK ALIGNMENT - &MASK IS 1-3-7, &B IS BRANCH LOC * 01496000 +.* IF LOCATION COUNTER IS PROPERLY ALIGNED. * 01498000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01499000 +&LABEL TM AVLOCNTR+3,&MASK . CHECK FOR RIGHT ALIGNMENT 01500000 + BZ &B . TAKE BRANCH IF WAS ALIGNED 01502000 + MEND 01504000 + SPACE 2 01506000 + MACRO 01508000 +&LABEL $GLOC &RG 01510000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01510500 +.*--> MACRO: $GLOC GET LOCATION COUNTER INTO REGISTER. * 01511000 +.* GET LOCATION COUNTER MACRO-PUTS LOCCNTR VALUE IN &RG * 01512000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01513000 +&LABEL L &RG,AVLOCNTR GET LOCATION COUNTER 01514000 + MEND 01516000 + SPACE 2 01518000 + MACRO 01520000 +&LABEL $SLOC &RG 01522000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01522500 +.*--> MACRO: $SLOC SET LOCATION COUNTER TO REGISTER VALUE. * 01523000 +.* SET LOCATION COUNTER MACRO - SETS &RG AS LOCCNTR VALUE * 01524000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01525000 +&LABEL ST &RG,AVLOCNTR SET LOCATION COUNTER 01526000 + MEND 01528000 + TITLE '*** SCAN POINTER MACROS - $SCOF, $SCPT ***' 01530000 + MACRO 01532000 +&LABEL $SCOF &RG,&SCP,&BYTE,&AD=AVRSBPT 01534000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01534500 +.*--> MACRO: $SCOF CONVERT REGISTER SCAN POINTER TO OFFSET VALUE.* 01535000 +.* SCAN POINTER OFFSET MACRO - PLACE SCAN POINTER REGISTER &SCP * 01536000 +.* INTO WORK REGISTER &RG. FIND OFFSET, AND STORE IT INTO &BYTE * 01538000 +.* IF &BYTE SPECIFIED. &AD= WORD GIVING BEGINNING @ FOR OFFSET.* 01540000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01541000 +&LABEL LR &RG,&SCP . MOVE SCAN POINTER ADDRESS OVER 01542000 + S &RG,&AD . SUBTRACT STARTING ADDR 01544000 + AIF (T'&BYTE EQ 'O').XEXIT SKIP IF NO STORE WANTED 01546000 + STC &RG,&BYTE . SAVE OFFSET INTO BYTE 01548000 +.XEXIT MEND 01550000 + SPACE 2 01552000 + MACRO 01554000 +&LABEL $SCPT &RG,&BYTE,&AD=AVRSBPT 01556000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01556500 +.*--> MACRO: $SCPT CONVERT OFFSET TO A SCAN POINTER @ INTO REG. * 01557000 +.* GET SCAN POINTER ADDRESS FROM OFFSET-OFFSET IS IN &BYTE,ADDR * 01558000 +.* IS CREATED IN &RG. &AD GIVES BEGINNING @ OF FIELD. * 01560000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01561500 +&LABEL SR &RG,&RG . CLEAR FOR INSERTION 01562000 + IC &RG,&BYTE . GET THE OFFSET VALUE 01564000 + A &RG,&AD . ADD START ADDR TO GET REAL ADDR 01566000 + MEND 01568000 + TITLE '*** STORAGE ALLOCATION MACROS - $ALLOCH,$ALLOCL ***' 01570000 + MACRO 01574000 +&LABEL $ALLOCH &R,&L,&OVRFL 01576000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01577000 +.*--> MACRO: $ALLOCH GET CORE IN FREEAREA HIGH END (ASSEMLBER). * 01578000 +.* &R GIVES REGISTER WHERE ADDRESS OF NEW USABLE AREA APPEARS * 01580000 +.* &L GIVES REGISTER CONTAINING THE LENGTH DESIRED * 01582000 +.* &OVRFL IS ADDRESS TO BE BRANCHED TO IF OVERFLOW OCCURS. * 01584000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01585000 +&LABEL L &R,AVADDHIH . GET CURRENT HIGH END POINTER 01586000 + SR &R,&L . GET NEW HIGH END POINTER 01588000 + C &R,AVADDLOW . MAKE SURE NO OVERFLOW 01590000 + BL &OVRFL . TAKE BRANCH IF OVERFLOW 01592000 + ST &R,AVADDHIH . RESTORE UPDATED POINTER 01594000 + MEND 01596000 + SPACE 2 01598000 + MACRO 01600000 +&LABEL $ALLOCL &R,&L,&OVRFL 01602000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01603000 +.*--> MACRO: $ALLOCL GET CORE IN LOW FREEAREA (IN ASSEMBLER). * 01604000 +.* &R GIVES REGISTER WHERE ADDRESS OF NEW USABLE AREA APPEARS * 01606000 +.* &L GIVES REGISTER CONTAINING THE LENGTH DESIRED. * 01608000 +.* &OVRFL IS ADDRESS TO BE BRANCHED TO IF OVERFLOW OCCURS. * 01612000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01613000 +&LABEL L &R,AVADDLOW . LOAD CURRENT LOW END POINTER 01614000 + AR &R,&L . ADD REQUESTED LENGTH TO POINTER 01616000 + C &R,AVADDHIH . MAKE SURE NO OVERFLOW 01618000 + BH &OVRFL . TAKE BRANCH IF OVERFLOW 01620000 + ST &R,AVADDLOW . REPLACE UPDATED POINTER 01622000 + SR &R,&L . RESTORE POINTER 01624000 + MEND 01626000 + TITLE '*** STORAGE ALLOCATION MACROS - $MALLOCL,$MALLOCH ***' 01628000 + MACRO 01628010 +&LABEL $MALLOCL &R,&L,&OVRFL=MXPNDOVR,&LENG= S 01628020 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01628030 +.*--> MACRO: &MALLOCL GET CORE IN LOW FREEAREA. SAME AS &ALLOCL * 01628040 +.* EXCEPT USES AVGEN2CD AS POINTER TO FREE HIGH AREA. USED IN * 01628050 +.* MEXPND * 01628060 +.* * 01628070 +.* &R GIVES REGISTER WHERE ADDRESS OF NEW USEABLE AREA APPEARS * 01628080 +.* &L GIVES REGISTER CONTAINING LENGTH DESIRED * 01628090 +.* &OVRFL IS @ TO BE BRANCHED TO IF OVERFLOW * 01628100 +.* &LENG IS THE LENGTH TO BE ALLOCATED * 01628105 +.* * 01628110 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01628120 +&LABEL DS 0H DEFINE LABEL S 01628130 + AIF ('&LENG' EQ '').X S 01628132 + LA &L,&LENG LOAD LENGTH TO ALLOCATE S 01628134 +.X L &R,AVADDLOW LOAD CURRENT LOW END PTR S 01628136 + AR &R,&L ADD REQUESTED LENGTH 01628140 + C &R,AVGEN2CD MAKE SURE NO OVERFLOW 01628150 + BH &OVRFL BRANCH IF OVERFLOW 01628160 + ST &R,AVADDLOW REPLACE UPDATED POINTER 01628170 + SR &R,&L RESTORE POINTER 01628180 + MEND 01628190 + SPACE 2 01628200 + MACRO 01628210 +&LABEL $MALLOCH &R,&L,&OVRFL=MXPNDOVR 01628220 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01628230 +.*--> MACRO: &MALLOCH GET CORE IN HIGH FREEAREA. SAME AS &ALLOCH * 01628240 +.* EXCEPT USES AVGEN2CD AS HIGH END POINTER. USED IN MEXPND * 01628250 +.* &R IS REG NEW USEABLE @ APPEARS IN * 01628260 +.* &L GIVES REGISTER DESIRED LENGTH IS IN * 01628270 +.* &OVRFL IS BRANCH @ IF OVERFLOW OCCURS * 01628280 +.* * 01628290 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01628300 +&LABEL L &R,AVGEN2CD LOAD CURRENT HIGH END POINTER 01628310 + SR &R,&L GET NEW HIGH END POINTER 01628320 + C &R,AVADDLOW MAKE SURE NO OVERFLOW 01628330 + BL &OVRFL BRANCH IF OVERFLOW 01628340 + ST &R,AVGEN2CD RESTORE UPDATED POINTER 01628350 + MEND 01628360 + TITLE '*** STORAGE DEALLOCATION MACRO - $DALLOCH ***' 01628370 + MACRO 01630000 +&LABEL $DALLOCH &R,&L 01632000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01632500 +.*--> MACRO: $DALLOCH RETURN CORE-HIGH FREEAREA (IN ASSEMBLER) * 01633000 +.* &R IS A WORK REGISTER, WHICH WILL BE DESTROYED * 01636000 +.* &L REPRESENTS THE LENGTH. IF 1ST CHAR IS '(', WILL BE * 01638000 +.* TAKEN AS REGISTER CONTAINING THE LENGTH, OTHER WISE TO * 01640000 +.* BE AN ACTUAL LENGTH TO BE ADDED. * 01642000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01643000 +&LABEL L &R,AVADDHIH . GET CURRENT HIGH END POINTER 01644000 + AIF ('&L'(1,1) NE '(').XLENG IF NOT REG FORM,SKIP 01646000 + AR &R,&L . ADD THE LENGTH BACK 01648000 + AGO .XST GO RESTORE 01650000 +.XLENG LA &R,&L.(&R) . INCREMENT REGISTER 01652000 +.XST ST &R,AVADDHIH . RESTORE UPDATED POINTER 01654000 + MEND 01656000 + TITLE '*** ASSEMBLER SYMBOL DEFINIITON MACRO - $SDEF ***' 01658000 + MACRO 01660000 +&LABEL $SDEF &RVAL,&RESD,&RLENG 01662000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01662500 +.*--> MACRO: $SDEF STORE VALUES IN SYMBOL TABLE ENTRY, FLAG DEFN.* 01663000 +.* &RVAL REGISTER CONTAINING SYMBOL VALUE. * 01663500 +.* &RESD REGISTER CONTAINING SECTION ID OF SYMBOL. * 01664000 +.* &RLENG REGISTER CONTAINING LENGTH ATTRIBUTE-1 FOR SYMBOL. * 01664500 +.* *NOTE* SYMSECT DSECT MUST HAVE VALID USING AT TIME OF CALL. * 01665000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01665500 +&LABEL ST &RVAL,SYVALUE . DEFINE VALUE 01666000 + STC &RESD,SYESDID . NOTE ESDID OF SYMBOL 01668000 + STC &RLENG,SYLENG . NOTE LENGTH ATTRIBUTE 01670000 + OI SYFLAGS,$SYDEF . NOTE SYMBOL NOW DEFINED 01672000 + MEND 01674000 + TITLE '*** $SERR - SET ERROR CODE EQUS AND MESSAGES' 01676000 + MACRO 01678000 +&ERR $SERR &MSG,&NM 01680000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01680200 +.*--> MACRO: $SERR SET ERROR CODE MESSAGES AND EQU SYMBOLS. * 01680400 +.* CALLED 2 TIMES FOR EACH ERROR EQU, 1 TIME TO SET UP EQU, 1 * 01680600 +.* TIME TO CREATE ERROR MESSAGE DC'S IN CSECT OUTPUT OF ASMBLER.* 01680800 +.* &ERR IS LAST 5 CHARACTERS OF ERROR MESSAGE EQU SYMBOL. * 01681200 +.* &MSG IS THE ERROR MESSAGE ASSOCIATED WITH THE EQU. * 01681400 +.* &NM IS THE ERROR CODE FOR EXTERNAL USE - AS###. * 01681600 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01681800 + GBLA &$ERNUM,&$ERFA # ERRORS, ADDRESS OFFSET VALUE 01682000 + GBLA &$OPTMS MEMORY OPTIMIZATION 01683000 + LCLA &I LOCAL COUNTER 01684000 + AIF ('&SYSECT' EQ 'OUTPUT').SGEN GO TO GEN IF IN OUTPUT 01686000 +.* GENERATE THE EQU * 01688000 +&$ERNUM SETA &$ERNUM+2 INCREMENT # ERRORS, EQU VALUE 01690000 +$ER&ERR EQU &$ERNUM 01692000 + MEXIT 01694000 +.SGEN AIF (&$OPTMS GT 2).SGEN1 SKIP UNLESS VERY SMALL SYSTEM 01694100 +.* SMALL MEMORY - GEN JUST ERROR #, DON'T USE POINTERS 01694200 +.* OR LENGTHS, SINCE LENGTHS WILL BE CONSTANT = 3. 01694300 + DC C'&NM' 01694400 + AGO .XXEXIT 01694500 +.* GENERATE POINTER TO LENGTH-1 AND ERROR MESSAGE * 01696000 +.SGEN1 ORG OUERRPT+$ER&ERR 01698000 + DC H'&$ERFA' 01700000 + ORG 01702000 +&I SETA K'&MSG+K'&NM-2 LENGTH-1 OF ERROR MESSAGE 01704000 +.SENORM DC AL1(&I),C'&NM ',C&MSG 01707000 +&$ERFA SETA &$ERFA+&I+2 INCREMENT THE OFFSET POINTER 01708000 +.XXEXIT MEND 01710000 + TITLE '*** $SETRT MACRO - BUILD TRT TABLE FOR SCANNING ***' 01712000 + MACRO 01714000 +&LABEL $SETRT &LIST 01716000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01716500 +.*--> MACRO: $SETRT SET UP TRT TABLE FOR SCANNING IN ASSEMBLER. * 01717000 +.* USED INSIDE ASSIST ASSEMBLER TO CREATE TEMPORARY TRT TABLE IN* 01718000 +.* COMMON AREA AWTZTAB (WHICH CONTAINS 256 HEX 0'S). * 01720000 +.* &LIST IS LIST OF CHARACTER/VALUE PAIRS, WITH CHARACTERS * 01722000 +.* ENCLOSED IN QUOTES. CORRESPONDONG VALUES ARE MOVED INTO * 01724000 +.* CORRESPONDING LOCATIONS IN 256-BYTE TABLE OF ZEROS. * 01726000 +.* IF VALUE IS OMITTED, ZERO IS ASSUMED. * 01726500 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01727000 + LCLA &I 01728000 + LCLC &CH1,&CH2 01730000 +&I SETA 1 01732000 + AIF (T'&LABEL EQ 'O').XNOLB 01734000 +&LABEL DS 0H 01736000 +.XNOLB ANOP 01738000 +&CH1 SETC '&LIST(&I)' GET NEXT LIST VALUE 01740000 +&CH2 SETC '&CH1'(1,2) GET UP TO 2 CHARS 01742000 + AIF ('&CH2' EQ 'X''' OR '&CH2' EQ 'C''').XGEN 01744000 + AIF ('&CH2'(1,1) EQ '''').XC 01746000 +&CH1 SETC 'C''&CH1''' ADD C' ' TO ELEMENT 01748000 + AGO .XGEN 01750000 +.XC ANOP 01752000 +&CH1 SETC 'C&CH1' ADD C TO ELEMENT 01754000 +.XGEN ANOP 01756000 +&CH2 SETC '&LIST(&I+1)' GET VALUE OP 01758000 + AIF ('&CH2' NE '').XGEN1 01760000 +&CH2 SETC '0' SET TO ZERO 01762000 +.XGEN1 MVI AWTZTAB+&CH1,&CH2 01764000 +&I SETA &I+2 INCREMENT 01766000 + AIF (&I LT N'&LIST).XNOLB CONTINUE LOOPING 01768000 + MEND 01770000 + TITLE '*** MISC. UTILITY MACROS - $GTAD,$LV,$STV ***' 01772000 + MACRO 01774000 +&LABEL $GTAD &RG,&ENTRY 01776000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01777000 +.*--> MACRO: $GTAD LOAD ADCON INTO REGISTER FORM AVWXTABL. * 01778000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01779000 +&LABEL L &RG,AX&ENTRY 01780000 + MEND 01782000 + SPACE 2 01784000 + MACRO 01786000 +&LABEL $LV &RG,&AD,&L=3 01788000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01788500 +.*--> MACRO: $LV LOAD VARIABLE LENGTH VALUE INTO REGISTER(ASMB)* 01789000 +.* LOAD VARIABLE - PLACES &L BYTES IN &RG FROM &AD * 01790000 +.* HIGH ORDER BYTES ARE ZEROED, USES AVFWORK1 * 01792000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01793000 + AIF (&L NE 3).XNO3 SKIP IF NOT 3 01794000 +&LABEL MVI AVFWORK1,0 01796000 + AGO .XMVC2 SKIP TO MOVE OVER 01798000 +.XNO3 ANOP 01800000 +&LABEL SR &RG,&RG . CLEAR REG FOR ZEROS 01802000 + ST &RG,AVFWORK1 . ZERO WORK WORD OUT 01804000 +.XMVC2 MVC AVFWORK1-&L+4(&L),&AD . MOVE BYTES OVER 01806000 + L &RG,AVFWORK1 . LOAD THE REGISTER 01808000 + MEND 01810000 + SPACE 2 01812000 + MACRO 01814000 +&LABEL $STV &RG,&AD,&L=3 01816000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01816500 +.*--> MACRO: $STV STORE VARIABLE LENGTH VALUE FROM REGISTER (AS)* 01817000 +.* STORE VARIABLE MACRO-STORES &L BYTES FROM LOW ORDER END OF * 01818000 +.* REGISTER &RG INTO ADDRESS &AD. * 01820000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01821000 +&LABEL ST &RG,AVFWORK1 . STORE REG INTO WORK WORD 01822000 + MVC &AD.(&L),AVFWORK1+4-&L 01824000 + MEND 01826000 + TITLE '*** CONG MACRO - GEN CONSTATNT CODE TABLES(CODTL1)***' 01828000 + MACRO 01830000 + CONG &C,&TYP,&LEN,&LD='''',&RD='''',&LW=1,&HI=8,&E=$CNERR 01832000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01832500 +.*--> MACRO: CONG GENERATE CONSTANT CODE TABLE (CSECT CODTL1). * 01833000 +.* USED IN CODTL1 OF ASSEMBLER TO PRODUCE 1 ENTRY IN * 01834000 +.* CONSTANT DESCRIPTION BLOCK. SEE CONBLK DSECT IN CODTL1. * 01836000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01837000 + ORG CODINXO+C'&C' ORG INTO RIGHT SPOT IN TABLE 01838000 + DC AL1(CODT&C-CONTAB1) DEFINE OFFSET VALUE 01840000 + ORG 01842000 +CODT&C DC AL1(&TYP+$CN&C+&E,&LEN-1,C&LD,C&RD,&LW-1,&HI-1) 01844000 + MEND 01846000 + TITLE '*** MACROS USED BY THE EXTENDED INTERPRETER ONLY' 01846100 + MACRO 01846105 +&LABEL EITAB &INS,&SYS,&IL,&CL,&TYPE,&OPC,&MODCHK,&OP1,&OP2,&D2B, X01846110 + &D2H,&ALN,&R1,&R2,&ROUTINE 01846115 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01846117 +.*--> MACRO: EITAB INTERPRETER CONTROL TABLE MACRO * 01846120 +.* * 01846125 +.* THIS MACRO IS USED BY THE EXTENDED INTERPRETER TO CONSTRUCT * 01846130 +.* A SINGLE CONTROL TABLE ENTRY. EACH TABLE ENTRY DEFINES THE * 01846135 +.* DECODING NECESSARY FOR ITS CORRESPONDING INSTRUCTION(S). * 01846140 +.* * 01846145 +.* IT SHOULD BE NOTED THAT: * 01846150 +.* (1) IT IS SUGGESTED THAT ASTERISKS BE PLACED IN * 01846155 +.* ARGUMENT FIELDS NOT APPLICABLE TO A PARTICULAR * 01846160 +.* INSTRUCTION DECODING FORMAT. IF THIS IS DONE, * 01846165 +.* THE ARGUMENT FIELDS WILL FORM ALIGNED COLUMNS * 01846170 +.* IN THE SOURCE LISTING, MAKING READING AND DE- * 01846175 +.* BUGGING EASIER. * 01846180 +.* (2) ONLY TWO ARGUMENTS ARE REQUIRED FOR EXTENDED * 01846185 +.* OPCODE INSTRUCTIONS IN THE MAIN TABLE. THESE * 01846190 +.* ARE &OPC AND &ROUTINE. THE LATTER SHOULD BE * 01846195 +.* THE LABEL OF THE APPROPRIATE EXTENDED OPCODE * 01846200 +.* SECONDARY TABLE (NOT THE USUAL ROUTINE LABEL). * 01846205 +.* IT IS SUGGESTED THAT ALL OTHER FIELDS CONTAIN * 01846210 +.* ASTERISKS. * 01846215 +.* * 01846220 +.* ***** ARGUMENTS ***** * 01846225 +.* * 01846230 +.* &INS = THE MNEMONIC INSTRUCTION CODE (LA,BCT,SR,ETC.) * 01846235 +.* &SYS = 360 IF THE INSTR IS GOOD ON 360'S & 370'S * 01846240 +.* = 370 IF THE INSTR IS GOOD ONLY ON 370'S * 01846245 +.* &IL = INSTRUCTION LENGTH IN BYTES (2, 4 OR 6) * 01846250 +.* &CL = AN INTEGER (1 <= &CL <= 8) SPECIFYING THE LENGTH * 01846255 +.* OF STORAGE MODIFIED OR FETCHED BY THIS INSTR * 01846260 +.* = 0 IF THE LENGTH IS CONTAINED IN THE INST ITSELF* 01846265 +.* (SS INSTRUCTIONS) * 01846270 +.* = * IF NOT APPLICABLE * 01846275 +.* &TYPE = NO IF THIS IS NOT A PRIVILEGED INSTR * 01846280 +.* = PR IF THIS IS A PRIVILEGED INSTRUCTION * 01846285 +.* &OPC = NM IF THIS INSTR'S OPCODE IS NORMAL (8 BITS) * 01846290 +.* = EX IF THIS INSTR'S OPCODE IS EXTENDED (> 8 BITS)* 01846295 +.* &MODCHK = CK IF THE STORAGE ACCESS @ AND LENGTH ARE TO BE * 01846300 +.* RANGE CHECKED IN THE MAIN DECODING LOOP (NEAR * 01846305 +.* STMT LABEL -> EINOCHK) * 01846310 +.* = NO IF CHECKING SHOULD NOT BE DONE IN THE MAIN * 01846315 +.* DECODING LOOP * 01846320 +.* = ** IF NOT APPLICABLE * 01846325 +.* &OP1 = F IF OPRND #1 SHOULD BE FETCH CHECKED * 01846330 +.* = S IF OPRND #1 SHOULD BE STORE CHECKED * 01846335 +.* = N IF NO CHECKING IS REQUIRED FOR OPRND #1 * 01846340 +.* = * IF NOT APPLICABLE * 01846345 +.* &OP2 = SAME AS &OP1, BUT FOR OPRND #2 * 01846350 +.* &D2B = RR4 IF 2ND BYTE TO BE DECODED AS 2 REGS (X 4) * 01846355 +.* = LL1 IF 2ND BYTE TO BE DECODED AS 2 FIELDS (X 1) * 01846360 +.* = IOL IF 2ND BYTE TO BE DECODED AS 1 FIELD (X 1) * 01846365 +.* &D2H = BD IF 2ND HALFWORD @ IS ONLY BASE+DISPL * 01846370 +.* = IX IF 2ND HALFWORD @ IS BASE+DISPL+INDEX * 01846375 +.* = ** IF NOT APPLICABLE * 01846380 +.* &ALN = DBL IF OPRND ALIGNMENT MUST BE DOUBLEWORD * 01846385 +.* = FUL IF OPRND ALIGNMENT MUST BE AT LEAST FULLWORD * 01846390 +.* = HAF IF OPRND ALIGNMENT MUST BE AT LEAST HALFWORD * 01846395 +.* = NON IF NO ALIGNMENT NEEDED * 01846400 +.* = *** IF NOT APPLICABLE * 01846405 +.* &R1 = E IF THE R1 FIELD MUST SPECIFY AN EVEN REG * 01846410 +.* = O IF THE R1 FIELD CAN SPECIFY AN ODD REG * 01846415 +.* = * IF NOT APPLICABLE (IF &D2B ^= RR4) * 01846420 +.* &R2 = SAME AS &R1, BUT FOR R2 FIELD * 01846425 +.* &ROUTINE = A STMT LABEL SPECIFYING A ROUTINE TO WHICH * 01846430 +.* CONTROL IS PASSED FOLLOWING PRIMARY DECODING * 01846435 +.* (E.G. - EIBAL, EILA, EINORMRR, ETC.) * 01846440 +.* = A STMT LABEL OF THE SECONDARY CONTROL TABLE * 01846445 +.* APPROPRIATE FOR AN EXTENDED OPCODE INSTRUCTION * 01846450 +.* (SEE NOTES ABOVE ARGUMENT LISTING) * 01846455 +.* * 01846460 +.** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01846465 + LCLC &BYTE BYTES ARE BUILT WITH THIS VAR 01846470 + SPACE 1 01846475 +EIT&INS EQU * LABEL FOR EIXTAB MACRO 01846480 +.* 01846485 +.* CHECK IF THIS ENTRY IS FOR AN EXTENDED OPCODE INSTR -- 01846490 +.* BRANCH IF IT IS 01846495 +.* 01846500 + AIF ('&OPC' EQ 'EX').OPEXTD 01846505 +.* 01846510 +.* ASSEMBLE AND GENERATE THE 1ST AND 2ND BYTES OF THIS 01846515 +.* TABLE ENTRY -- INCLUDING LABEL IF ANY 01846520 +.* 01846525 +&BYTE SETC '00001000' INITIAL BYTE SET-UP 01846530 + AIF (&SYS EQ 370).OPB1A SKIP IF 370-ONLY INSTR 01846535 +&BYTE SETC '00001100' ADD BIT IF 360/370 INSTR 01846540 +.OPB1A AIF ('&TYPE' NE 'PR').OPB1B SKIP IF NOT A PRIV INSTR 01846545 +&BYTE SETC '01'.'&BYTE'(3,6) ADD BIT IF PRIV INSTR 01846550 +.OPB1B AIF (&IL NE 2).OPB1C SKIP IF NOT AN RR INSTR 01846555 +&BYTE SETC '&BYTE'(1,2).'1'.'&BYTE'(4,5) ADD BIT IF RR INSTR 01846560 + AGO .OPB1D NO CHECKING IF RR INSTR 01846565 +.OPB1C AIF (('&MODCHK' EQ '') OR ('&MODCHK' EQ '**') OR ('&MODCHK' X01846570 + EQ 'NO')).OPB1D SKIP IF NO CHECKING TO BE DONE 01846575 +&BYTE SETC '&BYTE'(1,3).'1'.'&BYTE'(5,4) ADD BIT IF CHECKING 01846580 +.OPB1D ANOP 01846585 +&LABEL DC B'&BYTE',HL1'&IL' L 01846590 +.* 01846595 +.* 1ST & 2ND BYTES GENERATED -- NOW ASSEMBLE AND 01846600 +.* GENERATE BYTE # 3 01846605 +.* 01846610 +&BYTE SETC '00000000' INITIAL BYTE SET-UP 01846615 +.* SET OPERAND #1 CHECKING BITS 01846620 + AIF (('&OP1' EQ 'N') OR ('&OP1' EQ '*')).OPB3A SKIP IF NOCK 01846625 +&BYTE SETC '01000000' AT LEAST THIS BIT IS ON 01846630 + AIF ('&OP1' EQ 'F').OPB3A SKIP IF FETCH CHECKING 01846635 +&BYTE SETC '11000000' SET STORE CHECK BITS ON 01846640 +.* SET OPERAND #2 CHECKING BITS 01846645 +.OPB3A AIF (('&OP2' EQ 'N') OR ('&OP2' EQ '*')).OPB3B 01846650 +&BYTE SETC '&BYTE'(1,2).'010000' AT LEAST FETCH BIT IS ON 01846655 + AIF ('&OP2' EQ 'F').OPB3B SKIP IF FETCH CHECKING 01846660 +&BYTE SETC '&BYTE'(1,2).'110000' SET STORE CHECK BITS ON 01846665 +.* SET BIT IF THIS IS A NON-RR BRANCH INSTR 01846670 +.OPB3B AIF ((&IL EQ 2) AND ('&INS' NE 'XOPC')).OPB3E SKIP IF RR 01846675 + AIF (('&INS' NE 'BAL') AND ('&INS' NE 'BC') AND ('&INS' NE 'X01846680 + BCT') AND ('&INS' NE 'BXH') AND ('&INS' NE 'BXLE')).OPB3X01846685 + C SKIP IF NOT A NON-RR BRANCH 01846690 +&BYTE SETC '&BYTE'(1,4).'1000' SET NON-RR BRANCH INSTR BIT ON 01846695 +.* SET BIT FOR 2ND HALFWORD DECODING 01846700 +.OPB3C AIF (('&D2H' EQ '**') OR ('&D2H' EQ 'IX')).OPB3D NOT = B+D 01846705 +&BYTE SETC '&BYTE'(1,5).'100' SET BASE+DISP BIT ON 01846710 +.OPB3D ANOP 01846715 +.* SET BITS FOR 2ND BYTE DECODING (NOT HERE IF AN RR INSTR) 01846720 + AIF ('&D2B' EQ 'RR4').OPB3E SKIP IF RR4 L 01846723 +&BYTE SETC '&BYTE'(1,6).'01' ASSUME LLX1 01846725 + AIF ('&D2B' EQ 'LL1').OPB3E SKIP IF LLX1 01846730 +&BYTE SETC '&BYTE'(1,6).'11' SET BITS FOR IOL 01846735 +.OPB3E ANOP 01846740 + DC B'&BYTE.' 01846745 +.* 01846750 +.* 1ST 3 BYTES GENERATED -- NOW DO BYTE 4 01846755 +.* 01846760 +&BYTE SETC '00000000' INITIAL BYTE SET-UP 01846765 + AIF (('&ALN' EQ '') OR ('&ALN' EQ 'NON') OR ('&ALN' EQ '***'X01846770 + )).OPB4A 01846775 +&BYTE SETC '00000001' SET HALFWORD ALIGN 01846780 + AIF ('&ALN' EQ 'HAF').OPB4A JUMP IF NOW OK 01846785 +&BYTE SETC '00000011' SET FULL WORD ALIGN 01846790 + AIF ('&ALN' EQ 'FUL').OPB4A JUMP IF NOW OK 01846795 +&BYTE SETC '00000111' SET DOUBLEWORD ALIGN 01846800 +.OPB4A ANOP 01846805 + DC B'&BYTE.' 01846810 +.* 01846815 +.* 1ST 4 BYTES GENERATED -- NOW DO BYTE 5 01846820 +.* 01846825 +&BYTE SETC '00000000' INITIAL BYTE SET-UP 01846830 + AIF ('&D2B' NE 'RR4').OPB5B SKIP IF NO REGS TO CHK 01846835 + AIF ('&R1' NE 'E').OPB5A SKIP IF R1 CAN BE ODD 01846840 +&BYTE SETC '00010000' SET BIT FOR R1 EVEN 01846845 +.OPB5A AIF ('&R2' NE 'E').OPB5B SKIP IF R2 CAN BE ODD 01846850 +&BYTE SETC '&BYTE'(1,4).'0001' SET BIT FOR R2 EVEN 01846855 +.OPB5B ANOP 01846860 + DC B'&BYTE.' 01846865 +.* 01846870 +.* 1ST 5 BYTES GENERATED -- NOW DO BYTE 6 01846875 +.* AND THE HALFWORD DISPL TO THE ROUTINE 01846880 +.* 01846885 +&BYTE SETC '0' INITIAL BYTE SET-UP 01846890 + AIF (('&CL' EQ '*') OR ('&CL' EQ '') OR ('&CL' EQ '0')).OPB6X01846895 + A 01846900 +&BYTE SETC '&CL' 01846905 +.OPB6A ANOP 01846910 + DC HL1'&BYTE.',AL2(&ROUTINE.-EISPEJMP) 01846915 + SPACE 1 01846920 + MEXIT 01846925 +.* 01846930 +.* EXTENDED OPCODE IF HERE -- GENERATE TABLE ENTRY 01846935 +.* 01846940 +.OPEXTD ANOP 01846945 +&LABEL DC B'10000000',XL3'0',A(&ROUTINE) L 01846950 + SPACE 1 01846955 + MEND 01846960 + EJECT 01846965 + MACRO 01846970 +&LABEL EIXTAB &L1,&L2,&L3,&L4,&L5,&L6,&L7,&L8 01846975 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01846977 +.*--> MACRO: EIXTAB INTERPRETER SECONDARY CONTROL TABLE MACRO * 01846980 +.* * 01846985 +.* THIS MACRO IS USED BY THE EXTENDED INTERPRETER TO * 01846990 +.* GENERATE THE 256 BYTE SECONDARY TABLE. THIS TABLE IS * 01846995 +.* INDEXED INTO BY THE OPCODE OF THE INSTRUCTION BEING * 01847000 +.* EXECUTED. EACH TABLE ENTRY CONTAINS A DISPLACEMENT * 01847005 +.* INTO THE MAIN DECODING TABLE. INVALID OPCODES ALSO * 01847010 +.* ARE GIVEN DISPLACEMENTS INTO THE TABLE. THESE * 01847015 +.* POINT TO ZERO ENTRIES IN THE MAIN TABLE NOTING THE * 01847020 +.* THE OPCODES AS BEING INVALID. THE NUMBER OF * 01847025 +.* PARAMETERS USED FOR A CALL TO THIS MACRO IS 8. IF * 01847030 +.* 8 ARE NOT USED AN MNOTE IS GIVEN AND THE GENERATION * 01847035 +.* FOR THAT MACRO CALL IS TERMINATED. THE PARAMETERS * 01847040 +.* SHOULD EACH BE THE MNEMONIC OF THE INSTRUCTION OR * 01847045 +.* THE NAME OF THE GROUP OF INSTRUCTIONS REPRESENTED. * 01847050 +.* THESE NAMES MUST CORRESPOND TO NAMES IN THE MAIN * 01847055 +.* TABLE. NUMERIC PARAMETERS SHOULD BE USED FOR ALL * 01847060 +.* ILLEGAL OPCODES. THESE SHOULD BE A 2, 4 OR 6 * 01847065 +.* DEPENDING ON THE LENGTH OF THE ZERO MAIN TABLE ENTRY * 01847070 +.* BEING INDEXED. * 01847075 +.* * 01847080 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01847085 + LCLA &L 01847095 +&LABEL DC 0C' ' 01847100 + AIF (N'&SYSLIST EQ 8).EILOOP 01847105 + MNOTE 30,'***** EIGHT INSTRUCTIONS NOT SPECIFIED - ERROR ****' 01847110 + MEXIT 01847115 +.EILOOP ANOP 01847120 +&L SETA &L+1 01847125 + AIF (T'&SYSLIST(&L) NE 'N').EINONUM 01847130 + AIF ((&SYSLIST(&L) EQ 2) OR (&SYSLIST(&L) EQ 4) OR (&SYSLISTX01847135 + (&L) EQ 6)).EINONUM 01847140 + MNOTE 30,'*** NUMERIC VALUE SPECIFIED NOT EQUAL 2, 4, 6 ***' 01847145 + MEXIT 01847150 +.EINONUM ANOP 01847155 + DC AL1((EIT&SYSLIST(&L).-EICONTAB)/8) 01847160 + AIF (&L LT 8).EILOOP 01847165 + MEND 01847170 + TITLE '*** EVCG TABLE - GENERATE ROW OF EVALUT TRANSITION TAB' 01848000 + MACRO 01848100 + CROSSET &NUM 01848200 + GBLB &$XREF CONTROLS GENERATION OF MACRO 01848300 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01848350 +.*--> MACRO: CROSSET MACRO TO SET FLAGS FOR XREF * 01848400 +.* THIS MACRO IS USED IN THE ICMOP2 CSECT AND IS CALLED EVERY TIME * 01848500 +.* A NEW OPERAND IS SCANNED. IT SETS THE INSTRUCTION TYPE * 01848600 +.* AND THE FLAG AVXRTYPE. * 01848700 +.* &NUM ==> # OF OPERAND BEING SCANNED. CONTROLS TESTING * 01848800 +.* OF CORRECT FLAG. * 01848900 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01849000 + AIF (NOT &$XREF).NOXREF SKIP IF NOT CROSS REFERENCE 01849100 + OI AVXRTYPE,AVXRFTCH . SET BIT ON 01849200 + TM AVXRMDFT,AVXRMOD&NUM . SEE IF MODIFY REFERENCE 01849300 + BZ *+8 NO SKIP RESETING 01849400 + NI AVXRTYPE,X'FF'-AVXRFTCH . TURN OFF FLAG 01849500 +.NOXREF MEND 01849600 + SPACE 5 01849700 + MACRO 01850000 +&LABEL EVCG &L 01852000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01852500 +.*--> MACRO: EVCG CREATE ROW OF TRANSITION TABLE (CSECT EVALUT) * 01853000 +.* &L LIST OF PAIRS- JUMP LABEL,(ERROR CODE OR STATE #). * 01853500 +.* CREATES 1 ROW OF TABLE EVCTAB IN GENERAL EXPRESSION EVALUATOR* 01854000 +.* CSECT EVALUT. SEE EVCTDSCT DSECT FOR ENTRIES IN EACH ROW. * 01854500 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01855000 + LCLA &I LOCAL COUNTER 01856000 +&I SETA 1 INIT 01858000 +&LABEL DS 0H 01860000 +.EVCA AIF (T'&L(&I+1) EQ 'N').EVCC JUMP IF IT IS STATE # 01862000 + DC AL1(EV&L(&I)-EVDJUMP,$ERV&L(&I+1)) . OFFSET,ERROR 01864000 + AGO .EVCE 01866000 +.EVCC DC AL1(EV&L(&I)-EVDJUMP,EVCT&L(&I+1)-EVCTAB) 01868000 +.EVCE ANOP 01870000 +&I SETA &I+2 INCREMENT BY 2 FOR NEXT PAIR 01872000 + AIF (&I LT N'&L).EVCA GO BACK IF THERE'S MORE 01874000 + MEND 01876000 + TITLE '*** TABLE GENERATION MACROS -IBPRTAB, ICT ***' 01878000 + MACRO 01880000 +&LABEL IBPRTAB &OP,&VO,&VX 01880100 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01880150 +.*--> MACRO: IBPRTAB GENERATE 1 BLOCK FOR PRINT SCAN LIST * 01880200 +.*. USED ONLY IN IBASM1. CREATES 1 BLOCK: DSECT IBPSCECT * 01880300 +.*. &OP OPERAND NAME (ON, OFF, ETC). * 01880400 +.*. &VO VALUE TO BE OR'D INTO PRINT BYTE: BIT TO SET ON/OFF* 01880500 +.*. &VX VALUE TO BE XOR'D INTO PRINT CONTROL: EITHER 0 * 01880600 +.*. IF BIT ON (&VX OMITTED), OR SAME AS &VO IF * CODED.* 01880700 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01880800 + LCLA &K FOR COUNT 01880900 + LCLC &C FOR &VX VALUE 01881000 +&K SETA K'&OP-1 GET #-1 OF CHARS IN OPERAND 01881100 +&C SETC '0' ASSUME &VX OMITTED 01881200 + AIF ('&VX' EQ '').IB1 SKIP IF WAS OMITTED 01881300 +&C SETC '&VO' DUPLICATE VALUE OF EQUATE 01881400 +.IB1 ANOP 01881500 +&LABEL DC AL1(&K,&VO,&C),C'&OP' 01881600 + MEND 01881700 + SPACE 4 01910000 + MACRO 01912000 +&LABEL ICT &TYPE,&VALUE 01914000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01914500 +.*--> MACRO: ICT CREATE CONTROL CODES(ICYFLAG) VALUES(ICMOP2). * 01915000 +.* &TYPE TYPE OF INSTRUCTION FORMAT ($RR,$RX,ETC). * 01915500 +.* &VALUE VALUE OF CODE REQUIRED FOR TABLE. * 01916000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01916500 + ORG ICTTAB+&TYPE/2 01918000 +&LABEL DC AL1(&VALUE) 01920000 + MEND 01922000 + TITLE '*** OPG MACRO - GENERATE OPCODTB ENTRY FOR OPCOD1 ***' 01924000 + MACRO 01926000 + OPG &MNEM,&TYPE,&HEX,&MASK,&CODE 01928000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01928500 +.*--> MACRO: OPG CREATE 1 ENTRY IN ASM OPCODE TABLE (OPCOD1). * 01929000 +.* THE GENERATED ENTRY IS DESCRIBED BY DSECT OPCODTB. * 01929500 +.* GENERATES THE 4 FIELDS OF AN OPCODTB ENTRY - OPCTYPE,OPCHEX, * 01930000 +.* OPCMASK, AND OPCMNEM. IF &HEX OR &MASK ARE OMITTED,THEY * 01932000 +.* ARE ASSUMED TO BE 0. &CODE IS USED FOR INSTRUCTIONS WHICH * 01934000 +.* MAY NOT BE GENERATED. IF USED , IT IS 'D' FOR DECIMAL INSTS, * 01936000 +.* 'F' FOR FLOATING POINT INSTRUCTIONS, AND 'P' FOR PRIVILEGED * 01938000 +.* OPERATIONS. IF THE SPECIFIED TYPE IS NOT TO BE GENERATED, * 01940000 +.* THE APPROPRIATE GLOBAL VARIABLE WILL HAVE BEEN SET, AND THE * 01942000 +.* OPCODTB ENTRY WILL NOT BE CREATED. * 01944000 +.* &CODE = 'M' FOR MACRO OPCODES. * 01944500 +.* &CODE = 'FX' FOR EXTENDED FLOATING POINT OPCODES. * 01944600 +.* &CODE = 'S370' FOR NON-PRIVILEGED S/370 OPCODES. * 01944700 +.* &CODE = 'P370' FOR PRIVILEGED S/370 OPCODES. * 01944800 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01945000 + GBLB &OPNGN(8) USED TO KNOW IF LENGTH HAS BEEN USED 01946000 + GBLB &$DECSA,&$FLOTA,&$PRIVOP GENERATION STATUS VARS 01950000 + GBLB &$MACROS =1 GEN MACRO OPCODES 01951000 + GBLB &$FLOTAX =1 GEN EXTENDED FP OPCODES 01951500 + GBLB &$S370A =1 GEN NON-PRIVILEGED S/370 OPCODES 01951600 + GBLB &$P370A =1 GEN PRIVILEGED S/370 OPCODES 01951700 + AIF (T'&CODE EQ 'O').XNOC SKIP IF NO CODE USED 01952000 + AIF ('&CODE' EQ 'F' AND NOT &$FLOTA).XEXIT SKIP IF NOTFLOAT 01954000 + AIF ('&CODE' EQ 'FX' AND NOT &$FLOTAX).XEXIT SKIP IF NO EXFP 01955000 + AIF ('&CODE' EQ 'D' AND NOT &$DECSA).XEXIT SKIP IF NO DECS 01956000 + AIF ('&CODE' EQ 'P' AND NOT &$PRIVOP).XEXIT SKIP IF NO PRIVS 01958000 + AIF ('&CODE' EQ 'M' AND NOT &$MACROS).XEXIT SKIP IF NO MACRS 01959000 + AIF ('&CODE' EQ 'S370' AND NOT &$S370A).XEXIT SKIP IF NO 370 01959500 + AIF ('&CODE' EQ 'P370' AND NOT &$P370A).XEXIT SKIP IF NO PRV 01959600 +.XNOC ANOP 01960000 +&OPNGN(K'&MNEM) SETB 1 NOTE THAT ONE OF THIS LENGTH HAS BEEN USED 01962000 + AIF ('&HEX' EQ '' OR '&MASK' EQ '').XNOQ SKIP IF OMITTED 01966000 + DC AL1(&TYPE,&HEX,&MASK),C'&MNEM' 01968000 + MEXIT 01970000 +.XNOQ AIF (T'&HEX EQ 'O').XNOX SKIP IF HEX OMITTED. 01972000 + DC AL1(&TYPE,&HEX,0),C'&MNEM' 01974000 + MEXIT 01976000 +.XNOX AIF (T'&MASK EQ 'O').XNOMSK SKIP IF MASK FIELD OMITTED 01978000 + DC AL1(&TYPE,0,&MASK),C'&MNEM' 01980000 + MEXIT 01982000 +.XNOMSK DC AL1(&TYPE,0,0),C'&MNEM' 01984000 +.XEXIT MEND 01992000 + TITLE '*** OPGT MACRO - GENERATE OPCOD1 POINTER TABLES ***' 01994000 + MACRO 01996000 + OPGT 01998000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01998500 +.*--> MACRO: OPGT CREATE 2ND LEVEL OPCODE PTR TABLES (OPCOD1). * 01999000 +.* USES MACROS: $AL2 * 01999500 +.* NOTE &OPNGN VALUES WERE SET BY OPG MACRO. CALLED 1 TIME ONLY.* 02000000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02001000 + GBLB &OPNGN(8) LENGTH TAGS 02002000 + LCLC &O PREFIX CHARACTERS 02004000 + LCLA &I LOOP COUNTER 02006000 +.OPLOOP ANOP 02008000 +&I SETA &I+1 INCREMENT TO NEXT LENGTH 02010000 + AIF (&OPNGN(&I)).OPGEN1 GENERATE, IF ANY WERE USED 02012000 +OPF&I EQU OPADS . NAME FOR UNUSED # OF LETTERS 02014000 + AGO .OPBOT GO TO BOTTOM OF LOOP 02016000 +.OPGEN1 ANOP 02018000 +&O SETC 'OP&I' GET PREFIX CHRACTERS 02020000 +OPF&I $AL2 OPFIND, X02022000 + (&O.A,&O.B,&O.C,&O.D,&O.L,&O.M,&O.N,&O.S,&O.T,&O.END) 02024000 +.OPBOT AIF (&I LT 8).OPLOOP CONTINUE LOOPING 02026000 + MEND 02028000 + TITLE 'REPRNT MACRO - PRINT MACRO FOR REMONI INTERNAL USE' 02028020 + MACRO 02028040 +&LABEL REPRNT &MSG,&MSGL 02028060 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02028070 +.*--> MACRO: REPRNT PRINT MESSAGE MACRO FOR REMONI USE * 02028080 +.* &MSG GIVES RX-TYPE ADDRESS OF MESSAGE TO BE PRINTED. * 02028100 +.* &MSGL GIVES LENGTH OF THE MESSAGE TO BE PRINTED. * 02028120 +.* MODIFIES REGISTERS R7, R8, R14. * 02028140 +.* CALLS INSUB, REXPRINT. * 02028160 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02028180 +&LABEL LA R7,&MSG . SHOW @ MESSAGE 02028200 + LA R8,&MSGL . SHOW LENGTH OF MESSAGE 02028220 + BAL R14,REXPRINT . CALL THE INSUB 02028240 + MEND 02028260 + TITLE 'RFSGN MACRO - GENERATES 1 ENTRY IN TABLE CSECT RFSYMS' 02028280 + MACRO 02028300 +&LABEL RFSGN &CSECT,&ENTRY,&TYPE=0 02028320 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02028330 +.*--> MACRO: RFSGN GENERATE 1 ENTRY OF REPLACE NAME TABLE(RFSYMS)* 02028340 +.* RFSGN MACRO IS USED TO GENERATE THE PRIMARY TABLE * 02028360 +.* OF CSECT NAMES AND THEIR ENTRY POINT NAMES, WHICH IS USED TO * 02028380 +.* DO REPLACEMENT AND CHECKING OF STUDENT-WRITTEN CSECTS. * 02028400 +.* IF &$REPL=2 AND TYPE=2, RFSGN CREATES AN ELEMENT IN * 02028420 +.* THE SECOND SECTION OF RFSYMS, WHICH DESCRIBES A CALLABLE * 02028440 +.* ENTRYPOINT IN REAL ASSIST ROUTINES. * 02028460 +.* &CSECT NAMES A CSECT WHICH CAN BE REPLACED. * 02028480 +.* IF TYPE=2, NAMES A CALLABLE ENTRY FOR 2ND SECTION. * 02028500 +.* &ENTRY IS A LIST OF 1 OR MORE ENTRY POINT NAMES IN &CSECT.* 02028520 +.* IF TYPE=2, THIS ONE IS OMITTED. * 02028540 +.* &TYPE = 1 IF &CSECT MAY CALL OTHER CSECTS, OMITTED IF NOT* 02028560 +.* =2 IF CALL IS TO CREATE CALLABLE ENTRY ELEMENT. * 02028580 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02028600 + GBLA &$REPL REPLACE VAR. 0=NONE, 1=LIMITED 02028620 + LCLA &I,&N INDEX, L'&ENTRY 02028640 + LCLC &EN TEMPORARY ENTRY NAME FOR CONVENINCE 02028660 + AIF ('&TYPE' NE '0' AND &$REPL NE 2).RFSB SKIP IF NOT LIM R 02028680 + AIF ('&TYPE' EQ '2').RFSA2 SKIP IF TYPE 2 ELEMENT 02028700 +&N SETA N'&ENTRY GET # ENTRIES, >= 1 02028720 +.* RFSYMB,RFSENTN,RFSENTL,RFSTYPE. 02028740 +&LABEL DC CL6'&CSECT',AL1(&N,RFS$LEN*(&N+1)) 02028760 + AIF ('&TYPE' EQ '0').RFSA1 SKIP IF CAN'T CALL OTHER 02028780 + DC AL2(RI&CSECT-RFSYMS) REPLACE CSECT WHICH CAN CALL 02028800 + AGO .RFSA GO BACK FOR NEXT 02028820 +.RFSA1 DC AL2(0) 02028840 +.RFSA AIF (&I GE &N).RFSB JUMP OUT IF NO MORE ENTRIES 02028860 +&I SETA &I+1 INCREMENT INDEX TO ENTRIES 02028880 +.* RFSYMB,RFSAXPT,RFSRGPT,RFSRHPT. 02028900 +&EN SETC '&ENTRY(&I)' GET ENTRY, FOR CONVENIENCE 02028920 + DC CL6'&EN',AL2(AX&EN-AX$BASE,RG&EN-RG$BASE) 02028940 + AGO .RFSA 02028960 +.RFSA2 ANOP 02028980 +RF&CSECT DC CL6'&CSECT',AL2(AX&CSECT-AX$BASE,RH&CSECT-RH$BASE) 02029000 +.RFSB SPACE 1 02029020 + MEND 02029040 + TITLE '*** WCONG MACRO - GENERATE CONST.ADDR OFFSET TABLE ***' 02030000 + MACRO 02032000 + WCONG &C 02034000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02034500 +.*--> MACRO: WCONG CREATE OFFSETS TO CONSTANT SUBR ADCONS-VWXTABL* 02035000 +.* CREATE WCONADS TABLE IN VWXTABL FOR USE OF CODTL1 AND CNDTL2 * 02035500 +.* IN DOING TABLE-DRIVEN CONSTANT PROCESSING. CALLED 1 TIME ONLY* 02036000 +.* &C LIST OF CONSTANT TYPES ALLOWED. (A,B,C, ETC). * 02036500 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02037000 + LCLA &I COUNTER 02038000 + AIF ('&SYSECT' NE 'VWXTABL').XXEXIT SKIP IF NOT VWXT 02040000 +.LOOP ANOP 02042000 +&I SETA &I+1 INCREMENT TO NEXT 1 02044000 + ORG WCONADS+$CN&C(&I) ORG TO ADCON SPOT 02046000 + DC AL1(AXC&C(&I).CON1-AXC$BASE) 02048000 + AIF (&I LT N'&C).LOOP LOOP UNTIL DONE 02050000 + ORG 02052000 +.XXEXIT MEND 02054000 + TITLE '$TIRC MACRO - TIME OR RECORS -USED OR REMAINING(PSU)' 02056000 + MACRO 02058000 +&LABEL $TIRC &TYPE 02060000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02060500 +.*--> MACRO: $TIRC GET TIME/RECORDS DATA FROM OPERATING SYSTEM. * 02061000 +.* THIS MACRO USES PSU SVC CALL 250 TO OBTAIN TIME OR * 02062000 +.* RECORDS INFORMATION. &TYPE IS TIMREM,TIMUSE,RECREM,RECUSE. * 02064000 +.* RESULT IS RETURNED IN R0, IN EITHER RECORDS, OR IN TIMER * 02066000 +.* UNITS OF 26.04 MICROSECOND. DESTROYS R0,R1,R15. * 02068000 +.* *NOTE* MAY HAVE TO BE REWRITTEN FOR LOCAL CONDITONS. * 02069000 +.* &TYPE CAN ALSO BE OF FORM (NAME,ADDR) WHERE ADDR IS AN * 02069050 +.* RX-TYPE ADDRESS, AT WHICH THE MACRO PLACES THE FOLLOWING: * 02069100 +.* BYTES 0-4 : ACCOUNT NUMBER .... INFORMATION FROM * 02069150 +.* BYTES 5-12 : JOB NAME .... FROM * 02069200 +.* BYTES 13-32 : PROGRAMMER NAME .... JOB CARD * 02069250 +.* THIS FORM NEEDED ONLY IF &$ACCT=1, AND IS COMPLETELY LOCAL * 02069300 +.* TO PSU CC, THUS MUST BE REWRITTEN IF USED ELSEWHERE. * 02069350 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02069500 + AIF ('&TYPE(1)' NE 'NAME').TIMREC SKIP IF NOT NAME 02069550 + CNOP 0,4 ALIGN FOR LATER ADCON 02069600 +&LABEL LA R1,&TYPE(2) . GET @ WHERE INFO TO BE PUT 02069650 + ST R1,*+8 . STORE INTO PARAMATER LIST 02069700 + BAL R1,*+8 . SET R1==> ADCON, SKIP AROUND 02069750 + DS A . FOR @ AREA FOR INFORMATION 02069800 + SR R15,R15 R15 = 0 PART OF CONVENTION 02069830 + SR R0,R0 . SET R0 TO 0 FOR NAME CALL 02069850 + BCTR R0,0 . SET R0 TO -1==> WANT NAME 02069900 + SVC 250 . GET ACCOUNTING INFO****PSU CC******* 02069950 + AGO .XXEXIT QUIT GENERATING 02070000 +.TIMREC ANOP 02070050 + AIF ('&TYPE'(1,3) EQ 'TIM').TIM SKIP IF TIME DESITRED 02070100 +&LABEL SR R0,R0 02072000 + SR R15,R15 02074000 + SVC 250 . MAKE RECORD CALL 02076000 + AIF ('&TYPE'(4,3) EQ 'USE').XXEXIT SKIP IF DONE 02078000 + LR R0,R1 . MOVE RECORDS REMAINING OVER 02080000 + MEXIT 02082000 +.TIM ANOP 02084000 +&LABEL LA R0,1 02086000 + SR R15,R15 02088000 + SVC 250 . MAKE CALL FOR TIME INFO 02090000 + AIF ('&TYPE'(4,3) EQ 'USE').TIM2 SKIP IF IN RIGHT REG 02092000 + LR R0,R1 . MOVE TIME REMAINING OVER 02094000 +.TIM2 SLL R0,2 . *4 FOR # 26.04 MIC TIMER UNITS 02096000 +.XXEXIT MEND 02098000 + TITLE 'APCGN MACRO - GENERATE APCBLK IN CSECT APARMS' 02100000 + MACRO 02102000 +&LABEL APCGN &PARM,&AJOFS,&BITS,&C=0,&N=0,&D=0,&I1=0,&Y=0,&G=1,&GC=0,#02102040 + &LK=111 02102080 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02102100 +.*--> MACRO: APCGN GENERATE 1 APCBLK ELEMENT IN APARMS * 02102120 +.* GENERATES BLOCK FOR PARM OPTION SCANNING CONTROL, DEPENDING * 02102160 +.* ON DESIRED CHARACTERISTICS OF THE PARM. MAY SKIP GENERATION * 02102200 +.* IF THE REQUIRED OPTION DOES NOT EXIST IN PARTICULAR SYSTEM. * 02102240 +.* ***SEE DSECT APCBLK AND CSECT APARMS (FROM LABEL APFOUND) * 02102280 +.* FOR FURTHER INFORMATION ON HANDLING OF BLOCK CREATED BY THIS.* 02102320 +.* &PARM NAME OF THE PARM OPTION. * 02102360 +.* &AJOFS NAME OF VARIABLE IN AJOBCON TO BE SET BY THIS PARM * 02102400 +.* &BITS VALUE USED TO SET FLAG FOR YES/NO TYPE PARMS. * 02102440 +.* IF =PARM AND NOT CALL TYPE, SHOULD BE GIVEN VALUE 0. * 02102480 +.* &G,&GC USED TO CONTROL GENERATION. GENERATION IS SKIPPED * 02102520 +.* IF &G EQ &GC, THUS ALLOWING CONDITIONAL ASSEMBLY OF PARMS. * 02102560 +.* &C THRU &Y GIVE TYPE BITS TO BE PLACED INTO APCFLAG. EACH * 02102600 +.* CORRESPONDS TO 1 OR MORE EQU SYMBOLS, AS LISTED. * 02102640 +.* &C =1 IF PARM IS NONSTANDARD AND A ROUTINE MUST BE CALLED.* 02102680 +.* APPLIES ONLY TO =VALUE TYPE PARMS. THE ROUTINE CALLED MUST * 02102720 +.* BE NAMED APA&PARM. (APCCALL) * 02102760 +.* &N =1 IF VALUE CANNOT BE GIVEN ANOTHER VALUE ONCE IT HAS * 02102800 +.* BEEN SET ONCE. MAY BE USED BY ANY PARM TYPE.(APCNRSET) * 02102840 +.* &D =1 IF PARM IS PARM=DECIMAL VALUE. IF THIS IS CODED * 02102880 +.* AND PARM IS NOT A SPECIAL CALL TYPE, THEN IT IS ASSUMED THAT * 02102920 +.* THE VALUE CONVERTED IS TO BE STORED AS A FULLWORD AT THE * 02102960 +.* GIVEN VARIABLE LOCATION IN AJOBCON. (APCD) * 02103000 +.* &I1 =1 IF PARM IS A YES/NO TYPE AND 1BIT ON CORRESPONDS * 02103040 +.* TO A YES VALUE (1BIT MEANS NO OTHERWISE). (APCYES1B) * 02103080 +.* =1 IF PARM IS =DECIMAL # PARM, AND MAY NEVER BE * 02103120 +.* INCREMENTED AFTER IT HAS BEEN SET (BUT MAY BE DECREASED). * 02103160 +.* USED PARTICULARLY FOR TIME/RECORDS LIMITS. (APCNINCR) * 02103200 +.* &Y =1 IF THE PARM IS A YES/NO TYPE. OTHERWISE, IT IS * 02103240 +.* AN =PARM OF SOME SORT. (APCYESNO) * 02103280 +.* &LK DENOTES WHICH OF THE POSSIBLE CALLS IS ALLOWED TO SET * 02103320 +.* A VALUE FOR THE GIVEN PARM. CONSISTS OF 3 BITS: ###, WITH * 02103360 +.* MEANINGS AS FOLLOW: * 02103400 +.* 100 CAN BE SET BY LIMIT OR DEFAULT VALUE (APCSETLD) * 02103440 +.* 010 CAN BE SET FROM THE PARM FIELD (APCSETP) * 02103480 +.* 001 CAN BE SET BY USER FROM $JOB CARD (APCSETU) * 02103520 +.* THIS MACRO USED ONLY IN APARMS CSECT. * 02103560 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02103600 + AIF ('&G' EQ '&GC').XXEXIT SKIP IF FLAGGED THAT WAY 02103640 +&LABEL DC CL(APCP$L)'&PARM',B'&LK&C&N&D&I1&Y',AL1(&AJOFS-AJO$APC) 02103680 + DC B'0' 02103720 + AIF (&C EQ 1).APCC SKIP IF CALL TYPE 02103760 + DC AL1(&BITS) 02103800 + MEXIT 02103840 +.APCC DC AL1(APA&PARM-APAJUMP) 02103880 +.XXEXIT MEND 02118000 + TITLE '*** ASSIST CSECT MACROS: ASPRNT,ASTIME ***' 02120000 + MACRO 02120020 +&LABEL ASPRNT &XAREA,&XNUM 02120040 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02120050 +.*--> MACRO: ASPRNT PRINT LINE INSIDE MAIN PROG ASSIST. * 02120060 +.* ASPRNT SETS UP R0=@ LINE, R1=LENG, CALLS INSUB ASASPRNT OF * 02120080 +.* ASSIST. MODIFIES REGS R0,R1,R14. * 02120100 +.* &XAREA,&XNUM SAME AS THOSE FOR $PRNT = @, LENGTH TO PRINT. * 02120120 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02120140 +&LABEL LA R0,&XAREA . SHOW @ PRINT AREA 02120160 + AIF ('&XNUM'(1,1) EQ '(').ASREG SKIP IF REGISTER FORM 02120180 + LA R1,&XNUM . SHOW LENGTH 02120200 + AGO .ASBAL 02120220 +.ASREG LR R1,&XNUM . MOVE LENGTH REGISTER VALUE OVER 02120240 +.ASBAL BAL R14,ASASPRNT . CALL INSUB ASPRNT 02120260 + MEND 02120280 + SPACE 2 02120300 + MACRO 02122000 +&LABEL ASTIME &ASH,&VALUE 02124000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02124500 +.*--> MACRO: ASTIME UPDATE TIMER,PRINT TIMING MESSAGES(ASSIST). * 02125000 +.* &ASH NAME OF MESSAGE, IF OMITTED UPDATE TIMER ONLY. * 02125500 +.* &VALUE NAME OF VALUE TO BE CONVERTED, OMITTED-NO 2ND PART * 02126000 +.* *NOTE* ONLY USABLE INSIDE MAIN PROGRAM ASSIST. * 02126500 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02127000 + AIF (T'&ASH NE 'O').ASCALL1 SKIP IF OPERAND USED 02128000 +&LABEL SR R2,R2 . SHOW ASTIMER JUST UPDATE TIMER 02130000 + AGO .ASCALL2 GO HAVE BAL GENREATED 02132000 +.ASCALL1 ANOP 02134000 +&LABEL LA R2,&ASH . ENTER @ AREA TO BE PRINTED 02136000 + LA R3,&ASH.P 02138000 + LA R4,&ASH.L . LENGTH OF MESSAGE TO BE PRINTED 02140000 + AIF ('&VALUE' EQ '').ASCNV SKIP IF NO VALUE 02142000 + LA R6,&ASH.N . SHOW @ WHERE STMT/SEC GOES 02144000 + AIF ('&VALUE' EQ '*').ASCALL2 SKIP IF VALUE ALREADY IN 02146000 + L R7,&VALUE . GET VALUE TO BE CONVERTED 02148000 + AGO .ASCALL2 02150000 +.ASCNV SR R6,R6 . SHOW THERE IS NO 2ND PART MESSAGE 02152000 +.ASCALL2 BAL R14,ASTIMER . CALL TEST TIMER ROUTINE 02154000 + MEND 02156000 + TITLE '*** ASSIST MACROS: ASPAGE,ASRECL,ASTIMR ***' 02156050 + MACRO 02156100 + ASPAGE &CODE 02156150 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02156175 +.*--> MACRO: ASPAGE LINK TO SECTION OF PAGE CONTROL CODE * 02156200 +.* &CODE IS TWO-DIGIT # GIVING DESIRED SECTION OF PAGE CONTROL * 02156250 +.* CALL IS GENERATED ONLY IF &$PAGE = 1. * 02156300 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02156350 + GBLB &$PAGE =1 PAGE CONTROL CODE EXISTS 02156400 + AIF (NOT &$PAGE).XXEXIT SKIP IF NO PAGE CODE EXISTS 02156450 + BAL R9,ASPAGE&CODE . CALL SECTION OF ASPAGE## 02156500 +.XXEXIT MEND 02156550 + SPACE 2 02156600 + MACRO 02156650 + ASRECL &CODE 02156700 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02156725 +.*--> MACRO: ASRECL LINK TO RECORD LIMIT CONTROL CODE * 02156750 +.* &CODE IS TWO DIGIT NUMBER GIVING SECTION OF ASRECL## CALLED * 02156800 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02156850 + BAL R9,ASRECL&CODE . CALL SECTION OF ASRECL## 02156900 + MEND 02156950 + SPACE 2 02158000 + MACRO 02158100 +&LABEL ASTIMR &CODE,&TLEVEL 02158200 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02158250 +.*--> MACRO: ASTIMR LINK TO TIMER ROUTINES IN MAIN PROGRAM ASSIST * 02158300 +.* ASTIMR ALLOWS FOR CONDITIONAL GENERATION OF CALLS TO * 02158400 +.* VARIOUS TIMING MODULES INSIDE ASSIST MAIN PROGRAM, DEPENDING * 02158500 +.* ON THE DESIRED TIMING METHOD BEING USED. * 02158600 +.* &CODE IS 2-DIGIT CODE, GIVING SECTION OF ASTIMR TO BE CALLED* 02158700 +.* &TLEVEL IS 0,1,2. NO CODE IS CREATED IF &$TIMER<&TLEVEL. * 02158800 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02158900 + GBLA &$TIMER TIMER LEVEL BEING USED 02159000 +&LABEL DS 0H 02159100 + AIF (&$TIMER LT &TLEVEL).XXEXIT SKIP IF NOT IN USE 02159200 + BAL R9,ASTIMR&CODE . CALL ENTRY OF ASTIMR## CODE 02159300 +.XXEXIT MEND 02159400 + TITLE '*** XCALL - OS LINKAGE, LITERAL VCON ***' 02159900 + MACRO 02160000 +&LABEL XCALL &ENTRY 02162000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02162500 +.*--> MACRO: XCALL SUBROUTINE CALL, OS LINKAGE, LITERAL FORM. * 02163000 +.* &ENTRY NAME OF ENTRYPOINT TO BE CALLED. * 02163300 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02163600 +&LABEL L REP,=V(&ENTRY) . GET @ ENTRY POINT 02164000 + BALR RET,REP . CALL THE ROUTINE 02166000 + MEND 02168000 + TITLE '*** GLOBAL SET SYMBOLS AND EQUATES ***' 02170000 +** GLOBAL SET VARIABLES - SYSGEN TYPE - &$------ * 02172000 + GBLB &$ACCT =1 => ACCOUNT DISCRIMINATION POSSIBL 02173000 + GBLB &$ALIGN =0 ==> MODEL REQUIRES DATA ALIGNED 02173500 +* =1 ==> MODEL DOES NOT REQUIRE ALIGN 02173510 + GBLB &$ASMLVL =0==>DOS,=1==>OS 02174000 + GBLC &$BATCH LIMIT/DFLT: BATCH(DOS) - NOBATCH(OS) 02174500 + GBLC &$BTCC(4) BATCH CONTROL CARD ITEMS: SEE SETC'S 02174550 + GBLA &$BLEN SET TO BUFFER LENGTH IN BYTES 02174600 + GBLA &$BUFNO THE NUMBER OF BUFFERS 02174700 + GBLB &$CMPRS =0 NO CMPRS CODE, =1 CMPRS OPTION 02175000 + GBLA &$COMNT >0 COMMENT CHECK (&$COMNT % REQ) 02175500 + GBLB &$DATARD =0 SOURCE,DATA THRU SYSIN ONLY(WATFV 02175750 +* =1 DATA MAY BE READ FROM FT05F001 02175760 +* (I.E.- SINGLE JOB PROCESSING-PSU) 02175770 + GBLB &$DECSA SHOULD ASSEMBLER PERMIT DECIMALS 02176000 + GBLB &$DECSM DOES MACHINE HAVE DECIMALS 02178000 + GBLB &$DECK =0 NO OBJ DECKS PUNCHED. =1 CAN DO 02179000 + GBLB &$DMPAG =1 BEGIN DUMP ON NEW PAGE, 0=> NO J 02179050 + GBLC &$DSKUDV DEVICE TYPE FOR DISK DEFAULT TO 02179100 +* 2314 DISK DRIVE 02179101 + GBLA &$DISKU 0 FOR NO DISK UTILITY 02179200 +* 1 FOR USER OPTION 02179400 +* 2 FOR ALWAYS DISK 02179600 + GBLB &$FLOTA SHOULD ASSEMBLER ALLOW FLOATING PT 02180000 + GBLB &$FLOTAX SHOULD ASSEMBLER ALLOW EXTENDED FP'S 02181000 + GBLB &$DEBUG 0==>DEBUG MODE, 1==> PRODUCTION MODE 02182000 + GBLA &$ERNUM # DIFFERENT ERROR MESSAGES 02184000 + GBLB &$EXINT = 0 REGULAR INTERPRETER 02185000 +* = 1 EXTENDED INTERPRETER 02185005 + GBLB &$FLOTE =1==> WILL INTERPRET FLT,0==> NO 02186000 + GBLB &$FLOTEX =1==> WILL INTERPRET EX FP'S,0==> NO 02187000 + GBLB &$FLOTM =1==> MACHINE HAS FLTING PT,0==> NO 02188000 + GBLB &$FLOTMX =1==> MACHINE HAS EX FP'S,0==> NO 02188100 + GBLA &$FREE,&$FREEMN DEFAULT FREE=, MINIMUM FREE= (80A) J 02188250 + GBLC &$GENDAT GENERATATION DATE FOR THIS ASSIST 02188500 + GBLB &$HASPBT =1 HASP AUTOBATCH CODE SUPPORTED J 02188550 + GBLB &$HEXO =1==> HEXO ALLOWED,=0==> NOT ALLOWED 02188600 + GBLB &$HEXI =1==> HEXI ALLOWED,=0==> NOT ALLOWED 02188700 + GBLA &$IDF,&$IMX DEFAULT,MAXIMUM I= # INSTRUCTIONS 02189000 + GBLC &$IOUNIT(8) GLOBAL SUBLISTED VARIABLE FOR 02189050 +* DDNAMES IN DCB'S AND DTF'S 02189055 +* 02189060 +* &$IOUNIT(1)= PRIMARY INPUT, OS=> SYSIN, DOS=> SYSIPT 02189070 +* &$IOUNIT(2)= SECONDARY INPUT, OS=> FT05F001, DOS=> SYSRDR 02189080 +* &$IOUNIT(3)= PRINTER, OS=>FT06F001, DOS=> SYSLST 02189090 +* &$IOUNIT(4)= PUNCH, OS=> FT07F001, DOS=> SYSPCH 02189100 +* &$IOUNIT(5)= DISK INTERMEDIATE, OS=>FT08F001, DOS=> IJSYS01 02189110 +* &$IOUNIT(6)= MACRO LIBRARY, OS=> SYSLIB, DOS=> N/A 02189120 +* &$IOUNIT(7)= FUTURE USE 02189130 +* &$IOUNIT(8)= FUTURE USE 02189140 +* 02189150 + GBLB &$JRM =1 FOR PSU LOCAL SPECIAL CODE: JRM 02189200 + GBLB &$KP26 =1 ALLOW KP=26 OR KP=29 OPTION 02189500 +* =0 ALLOW ONLY 029 KEYPUNCH CARDS 02189510 + GBLA &$LDF,&$LMX DEFAULT,MAX L= # LINES/PAGE 02189600 + GBLB &$MACOPC =1 ==> ALLOW OPEN CODE COND ASMBL 02189940 + GBLB &$MACROG =1 ==> ADD ASM G FEATURES TO ASM F 02189950 + GBLB &$MACROH =1 ==> ADD SOME ASM H FEATURES TO F 02189980 + GBLB &$MACROV OS/VS SUPPORT 02189990 + GBLB &$MACROS MACRO/CONDITIONAL ASSEMBLY ALLOWED 02190000 +* **NOTE** BASIC MACRO FACILITY IS ASSEMBLER F COMPATIBLE. 02190005 + GBLB &$MACSLB =1 ==> MACRO LIBRARY ALLOWED 02190100 + GBLC &$MCHNE MACHINE GENERATION OF EQUIPMENT 02190200 + GBLA &$MMACTR LOCAL ACTR INITIAL VALUE DEFAULT 02190300 + GBLA &$MMNEST MACRO NEST LIMIT DEFAULT 02190400 + GBLA &$MMSTMG GLOBAL MACRO STMT LIMIT DEFAULT 02190500 + GBLA &$MODEL MODEL NUMBER OF 360/370 BEING RUN ON 02192000 + GBLB &$OBJIN =0 CANNOT READ OBJECT DECK. =1 CAN 02193000 + GBLA &$OPTMS OPTIMIZE - 0==> MEMORY, 9==> SPEED 02194000 + GBLB &$PAGE =0 NO PAGE COUNT/CONTROL CODE EXISTS 02195000 +* =1 PAGE CONTROL &OPTIONS ALLOWED 02195010 + GBLA &$PDF,&$PMX DEFAULT,MAX P= # PAGES LIMIT 02195400 + GBLA &$PDDF,&$PDMX DEFAULT,MAX PD= # PAGES FOR DUMP 02195500 + GBLB &$PRIVOP =0==>NO PRIV OPS, =1==> PRIV OPS OK 02196000 + GBLA &$PRTSIZ MAX # CHARS IN PRINT LINE FOR ASM 02196200 + GBLB &$PUNCH =0 WE DON'T ACTUALLY HAVE CARD PUNCH 02196400 +* =1 REAL PUNCH EXISTS, POSSIBLE USE 02196500 + GBLA &$PXDF,&$PXMX DEFAULT,MAX PX= PAGES FOR EXECUTION 02196600 + GBLB &$P370 =1 WILL INTERPRET PRIVELEGED S/370 02196650 + GBLB &$P370A SHOULD ASSEMBLER PERMIT PRIV S/370'S 02196700 + GBLA &$RDF,&$RMX DEFAULT,MAX R= TOTAL # RECORDS 02197000 + GBLA &$RDDF,&$RDMX DEFAULT,MAX RD= RECORDS FOR DUMP 02197300 + GBLA &$RECORD =0,1=> NO $TIRC RECREM, =2=> $TIRC 02197600 + GBLB &$RECOVR (ONLY USED FOR &$RECORD=2). 02197700 +* =0 => R= DOES NOT OVERRIDE $TIRC VALUE, =1 => IT DOES. 02197705 +* (AT PSU, OUTPUT CAN GO TO BAT FILES - DOESN'T COUNT). 02197710 + GBLB &$RELOC =0==> NO RELOCATION CODE GENERATED 02198000 + GBLA &$REPL 0=> NO REPL,1=> LIMITED,2=> FULL 02200000 + GBLA &$RXDF,&$RXMX DEFAULT,MAX RD= RECORDS FOR EXECUTE 02201000 + GBLB &$SPECIO SPECIAL ROUTINES EXIST(TYPE=$IS+) 02202000 + GBLA &$SYHASH SIZE OF INITIAL PTR TABLE FOR SYMOPS 02204000 + GBLC &$SYSTEM SYSTEM BEGIN RUN - DOS,PCP,MFT,MVT 02206000 + GBLA &$S370 =0==> NO S/370 INSTR INTERPRETED 02206500 +* =1==> S/370 INSTR INTERPRETED ON 370 02206600 +* =2==> S/370 INSTR INTERPRETED ON 360 02206700 + GBLB &$S370A SHOULD ASSEMBLER PERMIT SYSTEM 370'S 02206800 + GBLC &$TDF,&$TMX DEFAULT,MAX T= TOTAL TIME FOR RUN 02207000 + GBLC &$TDDF,&$TDMX DEFAULT,MAX TD= TIME FOR DUMP 02207500 + GBLA &$TIMER 0==> NO TIMING AT ALL 02208000 +* 1==> STIMER/TTIMER ONLY. =2==> LOCAL TIMER FOR TIMREM 02210000 + GBLC &$TXDF,&$TXMX DEFAULT,MAX TX= TIME FOR EXECUTION 02211000 + GBLC &$VERSLV VERSION #.LEVEL # 02212000 + GBLB &$XIOS =0==>NO XIO MACROS,=1==>XIO MACROS 02214000 + GBLB &$XREF CONTROL GENERATION OF XREF FACILITY 02214100 +* =1 FULL XREF, =0 NO XREF AT ALL A 02214110 + GBLA &$XREFDF(3) DEFAULT VALUES FOR FLAGS A 02214120 +* &$XREFDF(1)=0 NO XREF(OTHERS =3MEANS COMPRESSED LISTING 02214130 +* &$XREFDF(2)=3 COLLECT MODIFY AND FETCH DEFN A 02214140 +* &$XREFDF(3)=3 COLLECT REFERENCES MODIFY/FETCH A 02214150 + GBLA &$XREF#B NUMBER OF SLOTS FOR XREF BLKS A 02214155 + GBLB &$XXIOS =0==>XGET-XPUT MACROS,=1==> NO 02214500 + GBLB &X$DDMOR ALLOW USER OWN DDNAMES:=1==>YES,0==>NO 02214510 +** GLOBAL SET VARIABLES - INTERNAL TYPE - * 02216000 + GBLC &DEBUG DEBUG NUMBER FOR TESTING AVDEBUG 02218000 + GBLC &ID IDENT GENERATION CONTROL 02220000 + GBLC &TRACE SPECIFIES FORM OF TRACE-SNAP,*,NO 02222000 +&$BTCC(1) SETC '$' CONTROL CHARACTER FOR BATCH CARDS J 02223100 +&$BTCC(2) SETC 'JOB' JOB BEGINNING INDICATOR CPP 02223102 +&$BTCC(3) SETC 'ENTRY' BEGIN DATA CARD: SET = '' IF NONE NEEDED 02223104 +&$BTCC(4) SETC 'STOP' TERMINATOR INDICATOR CPP 02223106 + SPACE 1 02224000 +********* NOTE ******** SHOULD THE VALUE OF &$BLEN BE CHANGED 02224100 +* AND THE VERSION OF ASSIST TO BE GENERATED IS A DOS SYSTEM 02224110 +* THEN BE SURE TO CHANGE THE VALUE OF THE BLKSIZE PARAMETER 02224120 +* ON THE DTFSD DEFINITION IN CSECT XXXIOCO 02224130 +&$BLEN SETA 3520 HALF-TRACK SIZE FOR IBM 2316 PACK 02224250 +&$BLEN SETA 4*(&$BLEN/4) ROUND BLEN DOWN TO FULLWORD MULTIPLE 02224251 +&$BUFNO SETA 2 SET FOR 4 BUFFERS 02224750 +&$CMPRS SETB (1) ALLOW 'CMPRS' OPTION CPP 02225000 +&$COMNT SETA 80 REQUIRE 80% COMMENTS, IF COMNT OPT 02225500 +&$DATARD SETB (1) ALLOW SINGLE JOB/TWO RDRS 02226000 +&$DEBUG SETB (1) FOR QUICK RUN, KILL GENERATION 02228000 +&$DECK SETB (1) ALLOW OBJECT DECKS TO BE PUNCHED 02229000 +&$DECSA SETB (1) ASSEMBLER WILL ACCEPT DECIMAL INSTS 02230000 +&$DECSM SETB (1) PSU 360/67 HAS DECIMAL INSTRUCTIONS 02232000 +&$DISKU SETA 1 SET FOR USER OPTION ON DISK UTILITY 02233000 +&$DMPAG SETB 1 ASSUME COMPLETION DUMP ON NEW PAGE J 02233200 +&$EXINT SETB 1 USE EXTENDED INTERPRETER L 02233500 +&$FLOTA SETB (1) ASSEMBLER ALLOWS FLOATING POINT 02234000 +&$FLOTAX SETB (1) ASSEMBLER ALLOWS EXTENDED F. P. 02235000 +&$FLOTE SETB (1) WE WILL EXECUTE FLTINGS,IF POSSIBLE 02236000 +&$FLOTEX SETB (1) WILL EXECUTE EXTENDED F. P., IF POSS 02237000 +&$FLOTM SETB (1) PSU 360/67 HAS FLOATING POINT 02238000 +&$FLOTMX SETB (0) PSU 360/67 HASN'T GOT EXTENDED F. P. 02238100 +&$FREE SETA 30720 RETURN 30K TO OS/360 L 02238200 +&$FREEMN SETA 2048 MINIMUM ALLOWED FREE=; *****NOTE J 02238210 +* IF YOU HAVE 80A ABEND'S OFTEN, RAISE THIS AS NEEDED*** J 02238211 +&$GENDAT SETC '12/02/75' CURRENT GENERATION DATE 02238400 +&$IDF SETA 150000 100 SECS ON /67 02238500 +&$IMX SETA 150000 100 SECS ON /67 02239000 +&$KP26 SETB (1) ALLOW 026 KEYPUNCH 02239200 +&$LDF SETA 63 DEFAULT 63 LINES/PAGE 02239600 +&$LMX SETA 63 MAXIMUM OF 63 LINES/PAGE 02239800 +* MACRO SETS: ONLY SIGNIFICANT IF &$MACROS=1. 02239850 +&$MACOPC SETB 1 ALLOW OPEN CODE, AT LEAST FOR TEST 02239860 +&$MACROS SETB 1 ALLOW MACROS TO BE PROC ESSED 02239880 +&$MACROG SETB 0 NO ASM G CODE ***NOT SUPPORTED YET** 02239890 +&$MACROH SETB 0 NO ASM H CODE ***NOT SUPPORTED YET** 02239900 +&$MACROV SETB 0 NO OS/VS ASSEMBLER SUPPORT YET 02239910 +&$MACSLB SETB 1 ALLOW MACRO LIBRARY FETCH 02239920 +&$MCHNE SETC '370' PSU RUNS SYSTEM 370 02239925 +&$MMACTR SETA 200 DEFAULT ACTR VALUE = 200 02239930 +&$MMNEST SETA 15 DEFAULT LIMIT OF 15 DEEP IN MACS 02239940 +&$MMSTMG SETA 4000 DEFAULT MAXIMUM TOTAL 4000 MAC STMTS 02239950 + SPACE 1 02239960 +&$MODEL SETA 65 DEFAULT MODEL NUMBER 02240000 +&$OBJIN SETB (1) ALLOW OBJECT DECKS TO BE READ 02241000 +&$OPTMS SETA 4 MEDIUM OPTIMIZATION 02244000 +&$PAGE SETB (1) ALLOW ALL PAGE CONTROL OPTIONS 02244050 +&$PDF SETA 10 TEN TOTAL PAGES 02244100 +&$PMX SETA 25 MAXIMUM POSSIBLE OF 25 TOTAL 02244150 +&$PDDF SETA 1 NORMAL DUMP-JUST FIRST PAGE 02244200 +&$PDMX SETA 5 MAXIMUM OF 5 PAGES FOR THE DUMP 02244250 +&$PRIVOP SETB 1 ALLOW ALL PRIVILEGED OPERATIONS 02244280 +&$PRTSIZ SETA 121 LIMIT TO 121 CHARS AS DEFAULT LIM J 02244285 +&$PUNCH SETB (1) A REAL PUNCH EXISTS 02244300 +&$PXDF SETA 5 DEFAULT PAGES FOR EXECUTION 02244350 +&$PXMX SETA 5 MAXIMUM PAGES FOR EXECUTION 02244400 +&$RDF SETA 100000 DEFAULT RECORDS FOR EXEC 02244450 +&$RMX SETA 100000 MAX EXECUTION RECORDS 02244500 +&$RDDF SETA 25 DEFAULT RECORDS FOR A DUMP 02245000 +&$RDMX SETA 5000 MAXIMUM RECORDS FOR DUMP 02245200 +&$RECORD SETA 1 SHOW $TIRC RECREM CAN'T BE USED 02245400 +&$RELOC SETB (1) NEED RELOC SINCE WE HAVE REPL 02245440 +&$REPL SETA 2 ALLOW FULL REPL. OPTIONS CEH 02245460 +&$RXDF SETA 10000 DEFAULT EXECUTION RECORDS 02245600 +&$RXMX SETA 10000 MAXIMUM EXECUTION RECORDS 02245800 +&$SYSTEM SETC 'OS-MVT' SYSTEM IS OS OPTION MVT 02246000 +&$S370 SETA 2 PSU WANTS S/370'S ON 360/67 02247000 +&$S370A SETB (1) ASSEMBLER ALLOWS S/370'S 02247100 +&$XIOS SETB (1) WE'RE ALLOWING XIO MACROS 02248000 +&$XXIOS SETB 0 ALLOW XGET - XPUT 02248200 +&X$DDMOR SETB 0 ALLOW USER OWN DD NAMES 02248210 +&$HEXI SETB (1) XHEXI ALLOWED THIS ASSEMBLY 02249000 +&$HEXO SETB (1) XHEXO ALLOWED 02249500 +&$TDF SETC '100' DEFAULT SECONDS FOR RUN 02250000 +&$TMX SETC '200' MAX POSSIBLE SECONDS FOR RUN 02250500 +&$TDDF SETC '.1' DEFAULT TIME FOR DUMP 02251000 +&$TDMX SETC '10' MAXIMUM TIME FOR A DUMP 02251500 +&$TIMER SETA 1 SHOW WE WANT OVERALL TIMING DONE 02252000 +&$TXDF SETC '100' DEFAULT TIME FOR EXECUTION 02253000 +&$TXMX SETC '200' MAXIMUM TIME FOR EXECUTION 02253100 +&$VERSLV SETC '4.0/A2' VERSION LEVEL (CEH,CPP,TXM 12/02/75) 02253500 +&$XREF SETB 1 ALLOW CROSS REFERENCE 02253510 +&$XREFDF(1) SETA 3 PSU TESTING L 02253520 +&$XREFDF(2) SETA 3 COLLECT ALL MOD/FETCH DEFN A 02253530 +&$XREFDF(3) SETA 3 COLLECT ALL MOD/FETCH REFERENCES A 02253540 +&$XREF#B SETA 10 ALLOCATE 10 SLOTS/BLOCK A 02253545 +&$ASMLVL SETB ('&$SYSTEM'(1,2) EQ 'OS') SET LEVEL OF ASSEMBLER 02254000 +&$FLOTE SETB (&$FLOTE AND &$FLOTM) KILL GEN IF NO FLOATS 02256000 +&$FLOTEX SETB (&$FLOTEX AND &$FLOTMX) KILL GEN IF NO EXTENDED FLOATS 02257000 + AIF (&$ASMLVL).OSGEN SKIP IF OS GENERATION 02257100 +&$BATCH SETC 'BATCH' DEFAULT OF DOS IS BATCH CEH 02257105 +&$IOUNIT(1) SETC 'SYSIPT' SET DOS MAIN INPUT 02257110 +&$IOUNIT(2) SETC 'SYSRDR' SET DOS SECONDARY INPUT 02257120 +&$IOUNIT(3) SETC 'SYSLST' SET DOS PRINTER 02257130 +&$IOUNIT(4) SETC 'SYSPCH' SET DOS PUNCH 02257140 +&$IOUNIT(5) SETC 'SYS001' SET DOS DISK INTERMEDIATE 02257150 +&$BUFNO SETA 2 FOR DOS GEN INSURE ONLY 2 BUFFERS 02257160 +&$DSKUDV SETC '2314' SET DOS DISK DRIVE TYPE 02257165 + AGO .OSGEN1 02257170 +.OSGEN ANOP 02257180 +&$BATCH SETC 'NOBATCH' DEFAULT FOR OS IS NOBATCH CEH 02257185 +&$IOUNIT(1) SETC 'SYSIN' SET OS PRIMARY INPUT 02257190 +&$IOUNIT(2) SETC 'FT05F001' SET OS SECONDARY INPUT 02257200 +&$IOUNIT(3) SETC 'FT06F001' SET OS PRINTER 02257210 +&$IOUNIT(4) SETC 'FT07F001' SET OS PUNCH 02257220 +&$IOUNIT(5) SETC 'FT08F001' SET OS DISK INTERMEDIATE 02257230 +&$IOUNIT(6) SETC 'SYSLIB' SET OS MACRO LIBRARY 02257240 +.OSGEN1 ANOP 02257250 +&ID SETC 'NO' SET NO ID FOR TIME BEING 02258000 + AIF (&$DEBUG).EQU1 LEAVE NO ID IF PRODUCTION PROG 02260000 +&ID SETC '*' DEBUG==> GENERATE ID'S AT ENTRIES 02262000 +.EQU1 ANOP 02264000 + ASSYSGEN , CALL TO POSSIBLY RESET SET VARIABLES 02265100 +&$P370 SETB (&$PRIVOP AND (&$S370 NE 2)) KILL GEN IF NO PRIV OR S370 02265200 +&$P370A SETB (&$PRIVOP AND &$S370A) NO PRIV 370'S IF NO PRIV OR S370 02265300 +&$ALIGN SETB (&$ALIGN OR (&$S370 EQ 1 OR &$MODEL EQ 85)) FORCE VALUE 02265400 +&$MACSLB SETB (&$MACSLB AND &$MACROS) REMOVE LIBRARY IF NO MACROS J 02265500 +&$RELOC SETB (&$RELOC OR (&$REPL NE 0)) IF REPL, MAKE SURE RELOC J 02265600 +&$HASPBT SETB (&$HASPBT AND &$ASMLVL) ELIM HASP IF NOT OS SYSTEM J 02265700 + SPACE 2 02266000 + TITLE '*** OPCODTB DSECT - OPCODE CONTROL TABLE ENTRY ***' 02268000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02269000 +*--> DSECT: OPCODTB DESCRIBES 1 ENTRY IN OPOCDE TABLE * 02269100 +* LOCATION: ELEMENTS OF TABLE IN CSECT OPCOD1 OF ASSEMLBER. * 02269200 +* GENERATION: 1 CALL TO MACRO OPG CREATES AN ELEMENT. * 02269300 +* SECTIONS OPCTYPE,OPCHEX,OPCMASK CORRESPOND TO SIMILARLY-NAMED* 02269400 +* SECTIONS OF DUMMY SECTION RCODBLK. SEE CSECT OPCOD1. * 02269500 +* NAMES: OPC----- * 02269600 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02269900 +OPCODTB DSECT 02270000 +OPCTYPE DS C TYPE BYTE FOR MNEMONIC 02272000 +OPCHEX DS C HEX CODE FOR MACHINE OPS/SUBCODE 02274000 +OPCMASK DS C MASK/ALIGNMENT(MACHINE) / SUBCODE 02276000 +OPCMNEM DS CL8 MNEMONIC- FROM 1 TO 8 CHARACTERS 02278000 + SPACE 4 02280000 +* * * * * EQUATES USED FOR BCR INSTRUCTIONS * * * * * * * * * * * * * * 02282000 +H EQU 2 HIGH 02284000 +L EQU 4 LOW 02286000 +E EQU 8 EQUAL 02288000 +NH EQU 13 NOT HIGH 02290000 +NL EQU 11 NOT LOW 02292000 +NE EQU 7 NOT EQUAL 02294000 +O EQU 1 ONES OR OVERFLOW 02296000 +P EQU 2 POSITIVE 02298000 +M EQU 4 MINUS 02300000 +Z EQU 8 ZERO 02302000 +NP EQU 13 NOT POSITIVE 02304000 +NM EQU 11 NOT MINUS 02306000 +NZ EQU 7 NOT ZERO 02308000 +NO EQU 14 NOT ONES OR NOT OVERFLOW 02310000 + SPACE 1 02312000 +$CHN EQU 0 FOR ANY FIELD CHANGED DURING EXECUT 02314000 +$ EQU 0 FOR ANY FIELD CHANGED DURING EXECUT 02316000 + SPACE 1 02317000 +$PRGFILC EQU C'5' CHAR USED TO FILL UNUSED PROG CORE 02317100 +$PRGFILR EQU C'4' CHAR USED TO FILL USER REGS AT FIRST 02317200 + TITLE 'DSECT***X$SLOT*** FORMAT OF AN ENTRY FOR XGET-XPUT MON' 02317204 +X$SLOT DSECT 02317224 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02317234 +*-->DSECT: X$SLOT FORMAT FOR XGET-XPUT MONITOR TABLE * 02317244 +* USED IN XDDGET AND XDDPUT TO CONTROL USE OF CERTAIN * 02317264 +* DD NAMES BY USER WITH XGET-XPUT PERMITTED. * 02317284 +* * 02317304 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02317324 +X$SLNAME DS CL8 DDNAME 02317344 +X$SLFLAG DS CL1 FLAG BITS 02317364 +X$SLWAY DS CL1 02317384 +X$SLLONG EQU *-X$SLNAME GET LENGTH OF ENTRY 02317404 +X$SLOPEN EQU X'C0' THESE BITS OFF IF FILE NOT OPEN 02317424 +X$SLXGET EQU X'40' INPUT FILE 02317444 +X$SLXPUT EQU X'80' OUTPUT FILE 02317464 +X$SLPERM EQU X'01' PERMANENT FILE NAME 02317484 +X$SLCLOS EQU X'3F' OPPOSITE OF X$SLOPEN 02317504 +X$SLPOIN EQU X'0C' ON FOR POSSIBLE INPUT OR OUTPUT 02317524 +X$SLXGPT EQU X'00' BITS OFF MEAN USE XGET-XPUT 02317544 + TITLE '*** REGISTER EQUATES AND CONVENTIONS ***' 02318000 +* *** ABSOLUTE REGISTER EQUATES *** * 02320000 +F0 EQU 0 FLOATING POINT REGISTER 0 * 02322000 +F2 EQU 2 FLOATING POINT REGISTER 2 * 02324000 +F4 EQU 4 FLOATING POINT REGISTER 4 * 02326000 +F6 EQU 6 FLOATING POINT REGISTER 6 * 02328000 + SPACE 1 02330000 +R0 EQU 0 SPECIAL WORK REGISTER 0 * 02332000 +R1 EQU 1 SPECIAL WORK REGISTER 1 * 02334000 +R2 EQU 2 SPECIAL WORK REGISTER 2 * 02336000 +R3 EQU 3 GENERAL WORK REGISTER 1 * 02338000 +R4 EQU 4 GENERAL WORK REGISTER 2 * 02340000 +R5 EQU 5 GENERAL WORK REGISTER 3 * 02342000 +R6 EQU 6 GENERAL WORK REGISTER 4 * 02344000 +R7 EQU 7 PARAMETER REGISTER 1 * 02346000 +R8 EQU 8 PARAMETER REGISTER 2 * 02348000 +R9 EQU 9 PARAMETER REGISTER 3 * 02350000 +R10 EQU 10 PARAMETER REGISTER 4 * 02352000 +R11 EQU 11 PARAMETER REGISTER 5 * 02354000 +R12 EQU 12 ASSEMBLER TABLE POINTER-READ ONLY * 02356000 +R13 EQU 13 SAVE AREA POINTER/BASE REG FOR SOME* 02358000 +R14 EQU 14 RETURN ADDRESS USED IN CALLS * 02360000 +R15 EQU 15 ENTRY POINT ADDRESS/OFTEN USED BASE* 02362000 + SPACE 1 02364000 +* *** SYMBOLIC REGISTER EQUATES *** * 02366000 +RW EQU R3 GENERAL WORK REGISTER 1 * 02368000 +RX EQU R4 GENERAL WORK REGISTER 2 * 02370000 +RY EQU R5 GENERAL WORK REGISTER 3 * 02372000 +RZ EQU R6 GENERAL WORK REGISTER 4 * 02374000 +RA EQU R7 PARAMETER REGISTER 1 * 02376000 +RB EQU R8 PARAMETER REGISTER 2 * 02378000 +RC EQU R9 PARAMETER REGISTER 3 * 02380000 +RD EQU R10 PARAMETER REGISTER 4 * 02382000 +RE EQU R11 PARAMETER REGISTER 5 * 02384000 +RAT EQU R12 ASSEMBLER TABLE POINTER-READ ONLY * 02386000 +RSA EQU R13 SAVE AREA POINTER/BASE REG FOR SOME* 02388000 +RET EQU R14 RETURN ADDRESS USED IN CALLS * 02390000 +REP EQU R15 ENTRY POINT ADDRESS/OFTEN USED BASE* 02392000 + SPACE 1 02394000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02396000 +* *** REGISTER CONVENTIONS *** * 02398000 +* A. REGISTERS R0-R6 ARE PROTECTED ACROSS CALLS. * 02400000 +* B. REGISTER RAT(R12) MAY NOT BE CHANGED BY ANY ROUTINE. * 02402000 +* C.REGISTERS R7-R11 (RA-RE) ARE COMPLETELY UNPROTECTED ACROSS * 02404000 +* CALLS, AND MAY BE USED BY ANY ROUTINE . PARAMATERS WILL * 02406000 +* NORMALLY BE PLACED TO USE FIRST RA, THEN RB, ETC. IF MORE * 02408000 +* THAN 5 PARAMATERS ARE REQUIRED, REGISTER RE WILL POINT TO * 02410000 +* AN OS TYPE PARAMATER LIST. * 02412000 +* D. EXCEPT FOR THE ABOVE, THE CONVENTIONS ARE EXACTLY THE * 02414000 +* SAME AS STANDARD IBM CONVENTIONS WITH REGARD TO LINKAGE, * 02416000 +* SAVE AREA STRUCTURE, REQUIREMENTS, ETC. * 02418000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02420000 + TITLE '*** ERROR CODE EQUATE SYMBOLS - $ER----- ***' 02422000 +ALIGN $SERR 'W-ALIGNMENT ERROR-IMPROPER BOUNDARY',000 02424000 +ENTRY $SERR 'W-ENTRY ERROR-CONFLICT OR UNDEFINED',001 02426000 +EXTRN $SERR 'W-EXTERNAL NAME ERROR OR CONFLICT',002 02428000 +RGNUS $SERR 'W-REGISTER NOT USED',003 02430000 +ODDRG $SERR 'W-ODD REGISTER USED-EVEN REQUIRED',004 02432000 +NOEND $SERR 'W-END CARD MISSING-SUPPLIED',005 02434000 +ADDR $SERR 'ADDRESSIBILITY ERROR',100 02440000 +CNLNG $SERR 'CONSTANT TOO LONG',101 02442000 +CNTYP $SERR 'ILLEGAL CONSTANT TYPE',102 02444000 +CONT $SERR 'CONTINUATION CARD COLS. 1-15 NONBLANK',103 02446000 +CONTX $SERR 'MORE THAN 2 CONTINUATION CARDS',104 02448000 +CXREL $SERR 'COMPLEX RELOCATABILITY ILLEGAL',105 02450000 +DCEXT $SERR 'TOO MANY OPERANDS IN DC',106 02452000 +DPCSE $SERR 'MAY NOT RESUME SECTION CODING',107 02454000 +DUPLF $SERR 'ILLEGAL DUPLICATION FACTOR',108 02456000 +EXGTA $SERR 'EXPRESSION TOO LARGE',109 02458000 +EXLTA $SERR 'EXPRESSION TOO SMALL',110 02460000 +ICNOP $SERR 'INVALID CNOP OPERAND(S)',111 02462000 +ILLAB $SERR 'LABEL NOT ALLOWED',112 02464000 +ILORG $SERR 'ORG VALUE IN WRONG SECTION OR TOO LOW',113 02466000 +INVCN $SERR 'INVALID CONSTANT',114 02468000 +INVDM $SERR 'INVALID DELIMITER',115 02470000 +INVF $SERR 'INVALID FIELD',116 02472000 +INVSY $SERR 'INVALID SYMBOL',117 02474000 +IVOPC $SERR 'INVALID OP-CODE',118 02476000 +MULDF $SERR 'PREVIOUSLY DEFINED SYMBOL',119 02478000 +NEABS $SERR 'ABSOLUTE EXPRESSION REQUIRED',120 02480000 +NODLM $SERR 'MISSING DELIMITER',121 02482000 +NOIMP $SERR 'FEATURE NOT CURRENTLY IMPLEMENTED',122 02484000 +NOOPR $SERR 'MISSING OPERAND',123 02486000 +NONAM $SERR 'LABEL REQUIRED',124 02488000 +RELOC $SERR 'RELOCATABLE EXPRESSION REQUIRED',126 02492000 +SDINV $SERR 'INVALID SELF-DEFINING TERM',127 02494000 +START $SERR 'ILLEGAL START CARD',128 02496000 +TLIT $SERR 'ILLEGAL USE OF LITERAL',129 02498000 +UNDEF $SERR 'UNDEFINED SYMBOL',130 02500000 +UNRV $SERR 'UNRESOLVED EXTERNAL REFERENCE',131 02502000 +VILCH $SERR 'ILLEGAL CHARACTER',132 02504000 +VPARN $SERR 'TOO MANY PARENTHESIS LEVELS',133 02506000 +VRELO $SERR 'RELOCATABLE VALUE USED WITH * OR /',134 02508000 +VSYNT $SERR 'SYNTAX',135 02510000 +VTMTR $SERR 'TOO MANY TERMS IN EXPRESSION',136 02512000 +VUNEX $SERR 'UNEXPECTED END OF EXPRESSION',137 02514000 +INTPT $SERR 'STATEMENT CAUSED INTERRUPT',138 02516000 + SPACE 1 02518000 + AIF (NOT &$MACROS).SERR1 SKIP IF NO MACROS 02518050 +ILOPR $SERR 'OPERAND NOT ALLOWED',201 02518060 +STMNA $SERR 'STATEMENT OUT OF ORDER',202 02518062 +SSDIM $SERR 'SET SYMBOL DIMENSION ERROR',203 02518064 +INSBV $SERR 'INVALID NBR OF SUBSCRIPTS',204 02518066 +ILCNV $SERR 'ILLEGAL CONVERSION',205 02518068 +MISQU $SERR 'MISSING QUOTES IN CHAR EXPR',206 02518070 +ILMNM $SERR 'ILLEGAL OR DUP MACRO NAME',207 02518072 +MXDMD $SERR 'OPRND NOT COMPATIBLE WITH OPRTR',208 02518074 +UNDKW $SERR 'UNDFND OR DUP KEYWORD',209 02518076 +EXMAC $SERR 'MNEST LIMIT EXCEEDED',210 02518078 +ILAT $SERR 'ILLEGAL ATTRIBUTE USE',211 02518080 +MEXST $SERR 'GENERATED STMT TOO LONG',212 02518082 +OVRGN $SERR 'GENERATED STMTS OVERWRITTEN',298 02518100 +.SERR1 ANOP 02518150 + TITLE '*** INSTRUCTION TYPES AND CODES ***' 02522000 +* * * * * INSTRUCTION TYPES FOR MACHINE INSTRUCTIONS(OPCTYPE FIELD) * 02524000 +$IA EQU X'00' (OPCHEX)==> PREFIX FOR MACHINE OPS 02526000 +$RRM EQU 2 RR EXTENDED MNEMONICS -R2 02528000 +$RXM EQU 4 RX EXTENDED MNEMONICS - D2(X2,B2) 02530000 +$RR EQU 6 NORMAL RR - R1,R2 02532000 +$RX EQU 8 NORMAL RX - R1,D2(X2,B2) 02534000 +$RS EQU 10 RS(LM,STM,BXH,BXLE)-R1,R3,D2(B2) 02536000 +$RSH EQU 12 RS(SHIFTS) - R1,D2(B2) 02538000 +$SI EQU 14 SI NORMAL - D1(B1),I2 02540000 +$SS EQU 16 SS-1 LENGTH- D1(L,B1),D2(B2) 02542000 +$SS2 EQU 18 SS-2 LENGTHS - D1(L1,B1),D2(L2,B2) 02544000 +$RSO EQU 20 ODD RR-SI'S (SPM,SVC,LPSW,SSM,TS,IO) 02546000 +$SPC EQU 22 SPECIAL(FAKE) INSTRUCTIONS-XREAD,ETC 02548000 +$ICTMX EQU 11 MAXIMUM IC TYPE / 2 02550000 + SPACE 1 02552000 +IAA EQU X'10' (RCMASK) - R1 REQUIRED TO BE EVEN 02554000 +IAL1 EQU X'00' (RCMASK) - LITERAL OK-OP1==>NEVER! 02556000 +IAL2 EQU X'08' (RCMASK) - LITERAL PERMITTED-OP2 02558000 +IAB EQU X'20' (RCMASK) - R2 REQUIRED TO BE EVEN 02559000 + SPACE 1 02560000 +* * * * * ASSEMBLER INSTRUCTION TYPES - $I------ (OPCTYPE FIELD) * * * 02562000 +$IB EQU X'C0' OPCODTB ENTRY TAG BITS FOR AM INST 02564000 +* *NOTE* SECTIONS MO, MT DEPEND ON $IB HAVING THIS VALUE * 02566000 +$IUSING EQU 2 USING INSTRUCTION 02568000 +$IDROP EQU 4 DROP INSTRUCTION 02570000 +$ISTART EQU 6 START INSTRUCTION 02572000 +$ICSECT EQU 8 CSECT INSTRUCTION 02574000 +$IDSECT EQU 10 DSECT INSTRUCTION 02576000 +$IENTRY EQU 12 ENTRY INSTRUCTION 02578000 +$IEXTRN EQU 14 EXTRN INSTRUCTION 02580000 +$IEQU EQU 16 EQU INSTRUCTION 02582000 +$IDC EQU 18 DC INSTRUCTION 02584000 +$IDS EQU 20 DS INSTRUCTION 02586000 +$ICCW EQU 22 CCW INSTRUCTION 02588000 +$ITITLE EQU 24 TITLE INSTRUCTION 02590000 +$IEJECT EQU 26 EJECT INSTRUCTION 02592000 +$ISPACE EQU 28 SPACE INSTRUCTION 02594000 +$IPRINT EQU 30 PRINT INSTRUCTION 02596000 +$IORG EQU 32 ORG INSTRUCTION 02598000 +$ILTORG EQU 34 LTORG INSTRUCTION 02600000 +$ICNOP EQU 36 CNOP INSTRUCTION 02602000 +$IEND EQU 38 END INSTRUCTION 02604000 +$IDEBUG EQU 40 DEBUG FLAG SETTING ROUTINE 02606000 + SPACE 1 02608000 +IBNONAM EQU X'40' (OPCHEX)==> LABEL NOT PERMITTED 02610000 +IBNENAM EQU X'20' (OPCHEX)==> LABEL IS REQUIRED 02612000 +IBOMOP EQU X'10' (OPCHEX)==> OPERAND MAY BE OMITTED 02614000 +IBMOSPEC EQU X'08' (OPCHEX,RCHEX)==> REQUIRES SPECIAL 02614500 +* HANDLING OF SOME KIND IN MOCON1 (END, ALL PRINT CTRL). 02614510 +IBMOPRCT EQU X'04' (OPCHEX,RCHEX)==> IS SOME KIND OF 02614600 +* PRINT CNTRL, SO REQUIRES SPEC HANDLING BY MOCON1. 02614610 +IBMOPRCX EQU IBMOSPEC+IBMOPRCT (OPCHEX,RCHEX)==> PRT CNTRL 02614620 + TITLE '*** MISCELLANEOUS EQUATE SYMBOLS ***' 02616000 +$ESDSECT EQU 1 (AVCESDID)-IN DSECT, EVEN=>CSECT 02617900 +$IS EQU X'40' OPCTYPE CODE FOR SPECIALS 02618000 +$IM EQU X'80' OPCTYPE CODE FOR MACROS 02620000 + SPACE 1 02622000 +$IBPON EQU X'80' (AVPRINT,AVPRINT1)-PRINT ON 02624000 +$IBPGEN EQU X'40' (AVPRINT,AVPRINT1)- PRINT GEN 02626000 +$IBPDAT EQU X'20' (AVPRINT,AVPRINT1)- PRINT DATA 02628000 +* PRINT DATA, NODATA ONLY FOR COMPATIB 02628100 +$IBPLIST EQU X'02' (AVPRINT)==> LIST IS ON 02636000 + SPACE 1 02638000 +$IBSTAR1 EQU X'80' (AVTAGS1)==> START NO LONGER ALLOWED 02640000 +$IBDSEC1 EQU X'40' (AVTAGS1)==> PROCESSING DSECT NOW 02642000 +* IF THIS FLAG IS NOT SET, CURRENT SECTION IS A CSECT. * 02644000 +$IBPRCD1 EQU X'20' (AVTAGS1) - PRIVATE CODE HAS OCCURRD 02646000 + SPACE 1 02647000 +$INEND2 EQU B'10000000' (AVTAGS2)==> ENDFILE ON SYSIN-INCARD 02648000 + SPACE 1 02650000 +$OUMACH EQU 0 CODE FOR MACHINE INSTRUCTIONS 02652000 +$OUCONS EQU 2 CODE FOR CONSTANTS 02654000 +$OULIST EQU 4 LISTING CONTROL INSTRUCTONS 02656000 +$OUCOMM EQU 6 COMMENTS,ETC WITHOUT LOCATION COUNTE 02658000 + AIF (NOT &$MACROS).NOMMMMM SKIP IF NO MACROS 02658100 +* * * * * * * * EQUATES FOR MACRO-TYPE OPCODES* * * * * * * * * * * * * 02658200 + SPACE 2 02658300 +$MACRO EQU 2 MACRO DECLARATION 02658400 +$GBLA EQU 4 GLOBAL ARITHMETIC DECLARATION 02658500 +$GBLB EQU 6 GLOBAL BINARY DECLARATION 02658600 +$GBLC EQU 8 GLOBAL CHARACTER DECLARATION 02658700 +$LCLA EQU 10 LOCAL ARITHMETIC DECLARATION 02658800 +$LCLB EQU 12 LOCAL BINARY DECLARATION 02658900 +$LCLC EQU 14 LOCAL CHARACTER DECLARATION 02659000 +$ACTR EQU 16 ACTR INSTRUCTION 02659100 +$SETA EQU 18 SET ARITHMETIC INSTRUCTION 02659200 +$SETB EQU 20 SET BINARY INSTRUCTION 02659300 +$SETC EQU 22 SET CHARACTER INSTRUCTION 02659400 +$AIF EQU 24 AIF INSTRUCTION 02659500 +$AGO EQU 26 AGO INSTRUCTION 02659600 +$ANOP EQU 28 ANOP INSTRUCTION 02659700 +$MNOTE EQU 30 MNOTE INSTRUCTION 02659800 +$MEXIT EQU 32 MEXIT INSTRUCTION 02659900 +$MEND EQU 34 MEND INST 02660000 + SPACE 1 02660100 +$ARITH EQU 4 ARITHMETIC VLAUE 02660200 +$BOOL EQU 8 LOGICAL VALUE 02660300 +$CHAR EQU 12 CHARACTER VALUE 02660400 +.NOMMMMM ANOP 02660500 + SPACE 1 02660600 + TITLE '*** ICBLOCK - MACHINE INSTRUCTION CODE BLOCK ***' 02662000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02662500 +*--> DSECT: ICBLOCK MACHINE INSTRUCTION OBJECT CODE BLOCK. * 02663100 +* THIS DSECT IS USED TO TRANSMIT DATA FROM ICMOP2 CSECT TO * 02663200 +* OUTPT2 FOR PRINTING MACHINE INSTRUCTIONS. * 02663300 +* LOCATION: TABLE ICYBLOCK IN CSECT ICMOP2 OF ASSEMBLER. * 02663400 +* NAMES: ICB----- * 02663500 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02663900 +ICBLOCK DSECT 02664000 +$ICBEA1 EQU X'40' (ICBFLAG) ==> EA1 EXISTS 02666000 +$ICBEA2 EQU X'20' (ICBFLAG) ==> EA2 EXISTS 02668000 + SPACE 1 02670000 +ICBEA1 DS F 1ST ADDRESS 02672000 +ICBEA2 DS F 2ND ADDRESS 02674000 +ICBOPR1R DS 0H OPCODE - R1 - R2 02676000 +ICBOP DS C HEX OPCODE 02678000 +ICBR1R2 DS C REGISTERS OR LENGTHS OR IMMED.FIELD 02680000 +ICBOPN1 DS H 1ST BASE DISPLACEMENT IN INSTRUCTION 02682000 +ICBOPN2 DS H 2ND BASE DISPLACEMENT IN INSTRUCTION 02684000 +ICBFLAG DS C FLAG BYTE FOR EXISTENCE OF EAU,EA2 02686000 + TITLE '*** SYMSECT DSECT - SYMBOL TABLE ENTRIES ***' 02688000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02688500 +*--> DSECT: SYMSECT ASSEMBLER SYMBOL TABLE ENTRY. * 02689100 +* CREATED BY ENTRY SYENT1 OF CSECT SYMOPS, AND HAS VALUES ADDED* 02689120 +* BY MOCON1,IBASM1, FOR VALUE, SECTION ID, LENGTH ATTRIBUTE, * 02689140 +* AND BY ESDOPRS FOR SPECIAL ATTRIBUTES(CSECT,ETC). * 02689160 +* LOCATION: FREEAREA HIGH END ($ALLOCH'D). * 02689200 +* NAMES: SY------ * 02689300 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02689900 +SYMSECT DSECT 02690000 +$SYDEF EQU X'80' (SYFLAGS) - SYMBOL HAS BEEN DEFINED 02692000 +$SYENT EQU X'40' (SYFLAGS) - DECLARED AN ENTRY 02694000 +$SYCSE EQU X'20' (SYFLAGS) - DECLARED A CSECT 02696000 +$SYDSE EQU X'10' (SYFLAGS) - DECLARED A DSECT 02698000 +$SYEXT EQU X'08' (SYFLAGS) - DECLARED EXTRN 02700000 +$SYXRMD EQU X'02' (SYFLAGS) - XREF HAS MODIFY REFERS A 02700100 +$SYXRFT EQU X'01' (SYFLAGS) - XREF HAS FETCH REF A 02700200 + SPACE 1 02702000 +SYLINK DS 0F ADDRESS OF NEXT SYMBOL IN CHAIN 02704000 +SYHASH2 DS C SECONDARY HASH CODE OF NEXT SYMBOL 02706000 +SYLINKA DS CL3 ADDRESS REFERRED TO BY SYLINK 02708000 +SYVALUE DS F VALUE OF THE SYMBOL 02710000 +SYESDID DS C ESDID OF THE SYMBOL 02712000 +SYLENG DS C LENGTH ATTRIBUTE OF THE SYMBOL 02714000 +SYFLAGS DS C FLAG BYTE 02716000 +SYCHARS DS C #-1 OF BYTES IN SYMBOL (RANGE:0-7) 02718000 +SYMBOL DS CL8 4-8 CHARS OF SYMBOL,R-PADDED WITH BLK 02720000 + TITLE '*** CNCBLOCK DSECT - CONSTANT CODE BLOCK ***' 02720500 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02720750 +*--> DSECT: CNCBLOCK CONSTANT CODE BLOCK-DC'S, LITERALS. * 02721000 +* LOCATION: EACH CNCBLOCK IS CREATED IN AREA COBLK OF CODTL1. * 02721100 +* 1 OR MORE CNCBLOCKS MAY BECOME PART OF THE RCODBLK CREATED * 02721200 +* IN AREA IBRCB BY IBASM1, AND 1 CNCBLOCK BECOMES PART OF THE * 02721300 +* ENTRY FOR EACH DISTINCT LITERAL(SEE LTLENTRY DSECT, LTOPRS * 02721400 +* CSECT.) * 02721500 +* NAMES: CNC----- * 02721600 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02722000 +CNCBLOCK DSECT 02724000 +* * * * * CONSTANT TYPE,DESCRIPTOR CODES-USED IN CNCBLOCK AREAS * * * * 02726000 +$CNA EQU 0 A-TYPE CONSTANT TYPE CODE 02728000 +$CNB EQU 1 B-TYPE CONSTANT TYPE CODE 02730000 +$CNC EQU 2 C-TYPE CONSTANT TYPE CODE 02732000 +$CND EQU 3 D-TYPE CONSTANT TYPE CODE 02734000 +$CNE EQU 4 E-TYPE CONSTANT TYPE CODE 02736000 +$CNF EQU 5 F-TYPE CONSTANT TYPE CODE 02738000 +$CNH EQU 6 H-TYPE CONSTANT TYPE CODE 02740000 +$CNP EQU 7 P-TYPE CONSTANT TYPE CODE 02742000 +$CNV EQU 8 V-TYPE CONSTANT TYPE CODE 02744000 +$CNX EQU 9 X-TYPE CONSTANT TYPE CODE 02746000 +$CNZ EQU 10 Z-TYPE CONSTANT TYPE CODE 02748000 +$CNT$N EQU 11 1 MORE THAN MAX $CN# CODE=# TYPES 02750000 +$CNALN EQU X'80' (CNCTYP)==> ALIGNMENT REQUIRED 02752000 +$CNVLN EQU X'40' (CNCTYP)==> VARIABLE LENGTH (LIKE C) 02754000 +$CNMUL EQU X'20' (CNCTYP)==> MULTIPLE CONSTANTS OK 02756000 +$CNERR EQU X'10' (CNCTYP)==> RB HAS ERR CODE-PASS 2 02758000 + SPACE 1 02760000 +CNCTYP DS C FLAGS AND TYPE CODE 02762000 +CNCLEN DS C LENGTH-1 OF CONSTANT 02764000 +CNCSCAN DS C SCAN POINTER TO 1ST CHAR OF 1ST CONS 02766000 +CNCNUM DS C NUMBER OF CONSTANTS IN OPERAND 02768000 +CNCDUP DS H DUPLICATION FACTOR 02770000 +CNCTOT DS H TOTAL LENGTH OF OPERAND(<=65K) 02772000 +CNC$LEN EQU *-CNCBLOCK LENGTH OF CONSTANT CODE BLOCK 02774000 + TITLE '*** RECORD BLOCKS - RCODBLK, REBLK ***' 02776000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02776075 +*--> DSECT: RCODBLK RECORD CODE BLOCK - VARIABLE DATA FOR STMT. * 02776100 +* AN RCODBLK IS CREATED BY EITHER IAMOP1 OR IBASM1 DURING * 02776200 +* ASSEMBLER PASS 1 FOR EVERY STATEMENT WITH AN ACCEPTABLE * 02776300 +* OPERATION CODE. IT CONTAINS VARIABLE INFORMATION WHICH * 02776400 +* DEPENDS ON THE TYPE OF INSTRUCTION, AND MAY INCLUDE HEX * 02776500 +* MACHINE CODES AND MASKS, ALIGNMENT INFORMATION, LITERAL * 02776600 +* ADDRESSES, EQU SYMBOL ADDRESSES, AND 1 -10 CNCBLOCKS FOR DC * 02776700 +* COMMANDS. THE MOST COMMON LENGTHS ARE 8 AND 12. * 02776800 +* LOCATION: CREATED IN AREA IARCB(IN IAMOP1) OR IBRCB(IN * 02776900 +* IBASM1). STORED IN LOW AREA AFTER ITS RSBLOCK BY UTPUT1. * 02776950 +* FOR MACHINE INSTRUCTIONS, MOVED TO ICRCB(IN ICMOP2) IN PASS 2* 02777000 +* NAMES: RC------ * 02777100 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02778000 +RCODBLK DSECT 02780000 +RCLENG DS C LENGTH OF RCB 02782000 +RCLOC DS AL3 LOCATION COUNTER VALUE 02784000 +RCTYPE DS C PRIMARY INSTRUCTION TYPE 02786000 +RCHEX DS C HEX CODE FOR MACH OPS, 2ND CODE OTHR 02788000 +RCMASK DS C MASK-ALIGNMENT FOR MACH OPS 02790000 +RCLQ DS C SLOT FOR LENGTH ATTRIBUTE L'* 02792000 +RC$LEN EQU *-RCODBLK-1 NORMAL LENGTH,WITHOUT LITERAL/EQU 02794000 +RCLITEQ DS A LITERAL/EQU ADDRESS 02796000 +RC$LEN2 EQU *-RCODBLK-1 LENGTH-1 INCLUDING EQU OR LITERAL 02798000 + SPACE 2 02800000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02800500 +*--> DSECT: REBLK SCAN POINTER/ERROR CODE PAIR BLOCK. * 02801000 +* LOCATION: AVREBLK(AVWXTABL DSECT), CREATED BY ERRTAG SUBR. * 02801200 +* MOVED INTO LOW AREA FOLLOWING CORRESPONDING RCODBLK. MOVED * 02801400 +* BY UTGET2 BACK INTO AVREBLK AREA IN AVWXTABL DURING PASS 2. * 02801600 +* *NOTE* ONLY EXISTS FOR STATEMENTS HAVING 1 OR MORE ERROR OR * 02801800 +* WARNING MESSAGES ATTACHED TO IT. * 02801900 +* NAMES: REB----- * 02802000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02803000 +REBLK DSECT 02804000 +REBLN DS C LENGTH-1 OF ERROR BLOCK 02806000 +$ERREBMX EQU 4 MAX # ERROR MESSAGES KEPT PER STMT 02806500 +* THERE IS 1 REBLN, UP TO $ERREBMX REBSCN-REBERR PAIRS. 02807000 +REBSCN DS C SCAN OFFSET POINTER TO ERROR 02808000 +REBERR DS C ERROR CODE 02810000 + TITLE '*** RECORD BLOCKS - RSBLOCK,RSCBLK,RSOURCE ***' 02811000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02811250 +*--> DSECT: RSBLOCK RECORD SOURCE BLOCK-SOURCE CODE, FLAGS. * 02811500 +* AN RSBLOCK IS CREATED FOR EVERY SOURCE STATEMENT BY INCARD * 02812000 +* AND CONTAINS DATA COMMON TO EVERY STATEMENT, SUCH AS 1-3 * 02812500 +* SOURCE CARD IMAGES, FLAGS FOR EXISTENCE OF OTHER RECORD * 02813000 +* BLOCKS. ONLY RECORD BLOCK NECESSARY FOR A SOURCE STATEMENT. * 02813300 +* LOCATION: CREATED IN AVRSBLOC (AVWXTABL DSECT) BY INCARD, * 02813500 +* WITH MODIFICATION BY ERRTAG AND MOCON1. MOVED TO LOW END * 02814000 +* OF FREEAREA BY UTPUT1, AND REMAINS THERE. * 02814500 +* NAMES: RSB----- * 02815000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02815500 +RSBLOCK DSECT 02816000 +$RSMXCRD EQU 3 MAXIMUM # OF CARDS IN 1 STATEMENT 02818000 +$RCBX EQU X'80' (RSBFLAG)==>RECORD CODE BLOCK EXISTS 02820000 +$REBX EQU X'40' (RSBFLAG)==>RECORD ERROR BLOCK EXIST 02822000 +$RSCX EQU X'20' (RSBFLAG)==>RECORD SOURCE CODE BLOCK 02824000 +* FOLLOWING MAINLY INVOLVED WITH MACRO PROC. 02826000 +$RSBGENR EQU X'08' (RSBFLAG)==> GENERATED STMT 02826500 +* I.E., SHOULD BE PRINTED WITH + BEFORE STMT. 02826600 +$RSBNP## EQU X'04' (RSBFLAG)==> DO NOT PROCESS FURTHER, 02826700 +* EXCEPT TO PRINT. HAS STMT #. (COMMENTS, OUTER MACROS). 02826800 +$RSBNPNN EQU X'02' (RSBFLAG)==> DO NOT PROCESS FURTHER, 02826900 +* EXCEPT PRINT. NO STMT #. (INNER MACROS, SPEC ERRORS). 02827000 +$RSBMERR EQU X'01' (RSBFLAG)==> ERROR RECORD, GIVEN 02827100 +* SPECIAL TREATMENT IN OUTPT2, COUNTS AS ERROR. NOTE: 02827200 +* IF THIS FLAG ON, $RSBNPNN SHOULD BE ALSO. 02827300 + SPACE 1 02828000 +RSBLENG DS C LENGTH-1 OF THIS RSB(0-216) 02830000 +RSBFLAG DS C FLAG BITS FOR THIS RSB 02832000 +RSBNUM DS C NUMBER OF CARDS USED IN RSB 02834000 +RSBSCAN DS C SCAN POINTER OFFSET TO OPERAND FLD 02836000 +RSB$L EQU *-RSBLOCK LENGTH OF STANDARD PART OF RSBLOCK 02838000 +RSBSOURC DS 0CL71 SPACE FOR 3 CARD IMAGES 02840000 +RSBLOPC DS CL71 1ST CARD IMAGE 02842000 +RSB$LN1 EQU *-RSBLOCK-1 LENGTH-1 DEFAULT VALUE 02844000 + DS 2CL71 0-2 MORE CARD IMAGES 02846000 + SPACE 2 02848000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02848050 +*--> DSECT: RSCBLK RECORD SOURCE-CONTINUATIONS, SEQUENCE #'S * 02848100 +* CREATED BY INCARD FOR ANY STATEMENT HAVING EITHER SEQUENCE * 02848200 +* NUMBERS OR CONTINUATION PUNCHES. * 02848300 +* LOCATION: CREATED BY INCARD IN AVRSCBLK(AVWXTABL) DURING * 02848400 +* ASSEMBLY PASS 1. MOVED TO LOW END OF DYNAMIC AREA BY UTPUT1, * 02848500 +* FOLLOWING CORRESPONDING REBLK(IF ONE EXISTS). REMAINS IN * 02848600 +* THAT AREA FOR REST OF PROCESSING. * 02848700 +* NAMES: RSC----- * 02848800 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02848900 +RSCBLK DSECT 02852000 +RSCLENG DS C LENGTH-1 OF THIS RSCBLK 02854000 +* * * * * THE PREVIOUS ENTRIES ARE FIXED,THERE MAY BE UP TO 3 OF REST * 02856000 +RSCILEN DS C LENGTH OF INDIVIDUAL CARD IMAGE 02858000 +RSCONSQ DS CL9 CONTINUATION-SEQUENCE NUMBER COLUMNS 02860000 +RSC$LEN EQU *-RSCILEN LENGTH OF 1 ENTRY OF VARIABLE PART 02862000 + SPACE 2 02864000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02864050 +*--> DSECT: RSOURCE DESCRIPTION OF A SINGLE SOURCE CARD * 02864100 +* USED FOR INPUT PROCESSING BY SUBROUTINE INCARD. * 02864200 +* LOCATION: AVRSBLOC(AVWXTABL) DURING CREATION OF RSBLOCK. * 02864300 +* NAMES: RSO----- * 02864400 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02866000 +RSOURCE DSECT 02868000 +RSOLOPC DS CL15 LABEL+OPCODE,NORMAL 02870000 +RSOOPRCM DS CL56 OPERAND+COMMENTS FIELD 02872000 +RSOL1 EQU *-RSOLOPC LENGTH OF 1ST OR ONLY SOURCE CARD 02873000 +RSOLC EQU *-RSOOPRCM LENGTH OF SOURCE CONTINUATION CARD 02873500 +RSOCONT DS C CONTINUATION COLUMN 02874000 +RSOSEQN DS CL8 SEQUENCE NUMBERS,IF ANY 02876000 + AIF (NOT &$MACROS).AVNMCCC SKIP IF NO MACROS 02876100 + TITLE 'MACLIB DSECT AND EQUS' 02876150 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02876200 +*--> DSECT: MACLIB THIS DSECT GIVES THE FORMAT OF A MACRO * 02876250 +* LIBRARY ENTRY. * 02876300 +* NOTE: THIS IS ONLY MACRO DSECT NEEDED OUTSIDE MACRO PROCESSOR* 02876325 +* * 02876350 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02876400 + SPACE 02876450 +MACLIB DSECT 02876500 +MCLIBNXT DS F POINTER TO NEXT ENTRY 02876550 +MCLBNMLN DS C LENGTH OF MACRO LIB ENTRY NAME 02876600 +MCLBNAM DS CL8 MACRO LIBRARY ENTRY NAME 02876650 +MCLBFLGS DS 0C MACRO LIBRARY ENTRY FLAGS 02876700 +MCLBTAGS DS C MACLIB ENTRY FLAG BYTE 02876750 +MCLBFLG2 DS C MACRO LIBRARY ENTRY FLAGS 02876800 +MCLBFLG3 DS C MACRO LIBRARY ENTRY FLAGS 02876850 +MCPOPRNB DS H NUMBER OF OPERANDS (NOT LABEL FLD) 02876900 +MCKOPRNB DS H NUMBER OF KEYWORD OPERANDS 02876950 +MCDDVPNT DS F LINK TO LOCAL DICT DOPE VECTORS 02877000 +MCLOCDLN DS F LENGTH OF LOCAL DICTIONARY 02877050 +MCLDNBRE DS F # OF LOCAL DICT. ENTRIES 02877100 +MCPARPNT DS F POINTER TO PARAMETER DOPE VECTORS 02877150 +MCCODLNK DS F POINTER TO DEFINITION CODE 02877200 +$LMACLIB EQU *-MACLIB LENGTH OF MACLIB ENTRY 02877250 + SPACE 5 S 02877260 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02877280 +*--> DSECT: MSGBLOCK ERROR MESSAGE BLOCK * 02877300 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02877305 +MSGBLOCK DSECT S 02877310 +MSGLENM1 DS AL1 L-1 OF NUMBR+MSG S 02877315 +MSGFLAG DS AL1 MISC FLAG BYTE S 02877320 +MSGNMBR DS CL3 ERROR # S 02877325 +MSGMSG DS 0C VARYING LEN MSG S 02877330 + SPACE 5 S 02877350 +AVMCLBDF EQU X'80' MCLBTAGS - MACRO DEFINED FLAG 02877400 +AVMCLBNF EQU X'40' MCLBTAGS - MACRO SEARCHED FOR/LIBRY 02877450 +.AVNMCCC ANOP 02877500 + TITLE '*** AVWXTABL DSECT - MAIN ASSEMBLER TABLE ***' 02878000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02878010 +*--> DSECT: AVWXTABL MAIN CONTROL TABLE FOR THE ASSEMBLER. * 02878020 +* THIS DSECT IS USED BY ALMOST ALL SUBROUTINES OF THE ASSEMBLER* 02878040 +* FOR COMMUNICATION, COMMON CONSTANTS, AND WORKAREAS, AND IS * 02878060 +* ALSO USED SOMEWHAT BY THE MAIN PROGRAM ASSIST AND THE * 02878080 +* REPLACE MONITOR REMONI. * 02878100 +* LOCATION: CSECT VWXTABL, WITH SAME NAMES PREFIXED WITH 'A'. * 02878120 +* NAMES: AX------,AW------,AV------ (DEPENDS ON SECTION) * 02878140 +* THIS DSECT CONTAINS THE FOLLOWING SECTIONS: * 02878160 +* * 02878180 +* 1. ADDRESS CONSTANTS(NAMES: AX, FOLLOWED BY ENTRY NAME)* 02878200 +* THIS SECTION CONTAINS 1 ADDRESS CONSTANT FOR EVERY CALLABLE * 02878220 +* ENTRY POINT IN THE ASSIST ASSEMBLER. THESE ARE READ-ONLY, * 02878240 +* EXCEPT DURING A REPLACE RUN, IN WHICH THE ADCONS FOR A * 02878260 +* SINGLE CSECT ARE TEMPORARILY MODIFIED. THE LABEL AX$BASE IS * 02878280 +* USED AS A BASE ADDRESS FOR THE CALCULATION OF OFFSETS TO * 02878300 +* INDIVIDUAL ADCONS, FOR THOSE ROUTINES REQUIRING TABLE-DRIVEN * 02878320 +* CALLING SEQUENCES (CNDTL2,CODTL1,MPCON0,REMONI). NOTE THAT * 02878340 +* ALL ENTRY POINTS HAVE 6-CHARACTER NAMES. THE MACRO $CALL * 02878360 +* IS USED IN CONJUNCTION WITH THIS PART OF AVWXTABL. * 02878380 +* * 02878400 +* 2. CONSTANT VALUES (NAMES: AW------) * 02878420 +* THIS SECTION CONTAINS USEFUL CONSTANT VALUES, SUCH AS * 02878440 +* ZEROES, BLANKS, MASK VALUES, TRANSLATE TABLES, EDIT PATTERNS.* 02878460 +* ALL VALUES ARE READ-ONLY, EXCEPT THAT ANY ROUTINE MAY * 02878480 +* MODIFY PART OF THIS SECTION IF IT RESTORES IT BEFORE * 02878500 +* ALLOWING ANOTHER SUBROUTINE TO GAIN CONTROL. TRANSLATE * 02878520 +* TABLES INCLUDE ONES FOR SCANNING DECIMAL NUMBERS AND MACHINE * 02878540 +* INPUT CONVERSION - HEX TO BINARY, SCANNING SYMBOLS AND * 02878560 +* INSTRUCTION OPERANDS, SCANNING HEXADECIMAL CONSTANTS, DOING * 02878580 +* GENERAL EXPRESSIONS, CONVERTING BINARY TO OUPUT HEXADECIMAL. * 02878600 +* GENERATION: SECTION AWCONADS IS CREATED BY MACRO WCONG. * 02878620 +* * 02878640 +* 3. VARIABLES (NAMES: AV------) * 02878660 +* THIS SECTION CONTAINS ALL VARIABLE AREAS USED FOR * 02878680 +* COMMUNICATION INSIDE THE ASSIST ASSEMBLER, IN ADDITION TO * 02878700 +* VARIOUS WORKAREAS, WHICH MAY BE OVERLAPPED TO SAVE SPACE. * 02878720 +* THE AREAS PROVIDED INCLUDE THE RECORD BLOCKS, LOCATION * 02878740 +* COUNTER VALUES, CURRENT SECTION ID, CURRENT DYNAMIC STORAGE * 02878760 +* AREA LIMITS, AND VARIOUS FLAGS. TEMPORARY WORKAREAS ARE * 02878780 +* SUPPLIED, ALL WITH 'WORK' INCLUDED IN THEIR NAMES, WHICH * 02878800 +* CAN BE USED BY ANY ROUTINE , BUT ARE NOT SAFE ACROSS A * 02878820 +* SUBROUTINE CALL. NOTE THAT THIS SECTION REQUIRES EQU SYMBOLS* 02878840 +* FROM CNCBLOCK AND THE RECORD BLOCKS TO ASSEMBLE CORRECTLY. * 02878860 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02878880 + EJECT 02878900 +AVWXTABL DSECT 02880000 + SPACE 1 02882000 +* * * * * NAMES IN AVWXTABL DSECT ARE SAME, EXCEPT WITH A'S PREFIXED * 02884000 +* * * * * AVWXTABL SECTION X - ADDRESS CONSTANTS * * * * * * * * * * * 02886000 +AX$BASE DS 0A BASE ADDRESS FOR OFFSETS TO ROUTINES 02888000 +* *** BROPS2 ENTRY POINTS *** * 02890000 +AXBRINIT DS V(BRINIT) BASE-REG INITIALIZATION 02892000 +AXBRUSIN DS V(BRUSIN) BASE-REG SET UP USING VALUE 02894000 +AXBRDROP DS V(BRDROP) BASE REG DROP A REGISTER 02896000 +AXBRDISP DS V(BRDISP) BASE REG GET BASE-DISPLACEMENT 02898000 +AXC$BASE DS 0F BASE ADDRESS FOR CONSTANT ADDR OFFSE 02900000 +* *** CACONS ENTRY POINTS *** * 02902000 +AXCACON1 DS V(CACON1) SCAN A-TYPE CONST 02904000 +AXCACON2 DS V(CACON2) ASSEMBLE A-TYPE CONSTANT 02906000 +* *** CBCONS ENTRY POINTS *** * 02908000 +AXCBCON1 DS V(CBCON1) SCAN BINARY CONSTANT 02910000 +AXCBCON2 DS V(CBCON2) ASSEMBLE BINARY CONSTANT 02912000 +* *** CCCONS ENTRY POINTS *** * 02914000 +AXCCCON1 DS V(CCCON1) SCAN CHARACTER CONSTANT 02916000 +AXCCCON2 DS V(CCCON2) ASSEMBLE CHARACTER CONSTANT 02918000 +* *** CDECNS ENTRY POINTS *** * 02920000 +AXCDECN1 DS V(CDECN1) SCAN FLOATING PT CONST 02922000 +AXCDECN2 DS V(CDECN2) ASSEMBLE FLOATING PT CONSTANT 02924000 +AXCDCON1 EQU AXCDECN1 MAKE EQUATE FOR STANDARD NAMES 02926000 +AXCECON1 EQU AXCDECN1 MAKE EQUATE FOR STANDARD NAMES 02928000 +* *** CFHCNS ENTRY POINTS *** * 02930000 +AXCFHCN1 DS V(CFHCN1) SCAN FIXED POINT CONSTANT 02932000 +AXCFHCN2 DS V(CFHCN2) ASSEMBLE FIXED POINT CONSTANT 02934000 +AXCFCON1 EQU AXCFHCN1 MAKE EQUATE FOR STANDARD NAMES 02936000 +AXCHCON1 EQU AXCFHCN1 MAKE EQUATE FOR STANDARD NAMES 02938000 +* *** CONSTANT PROCESSOR CONTROL ROUTINES *** * 02940000 +AXCNDTL2 DS V(CNDTL2) PASS 2 CONSTANT PROCESSING 02942000 +AXCODTL1 DS V(CODTL1) DUPLICATION FACTOR-TYPE-LENGTH PROC 02944000 +* *** CPCONS ENTRY POINTS *** * 02946000 +AXCPCON1 DS V(CPCON1) SCAN PACKED CONSTANT 02948000 +AXCPCON2 DS V(CPCON2) ASSEMBLE PACKED CONSTANT 02950000 +* *** CVCONS ENTRY POINTS *** * 02952000 +AXCVCON1 DS V(CVCON1) SCAN V-TYPE CONSTANTS 02954000 +AXCVCON2 DS V(CVCON2) ASSEMBLE V-TYPE ADDRESS CONSTANTS 02956000 +* *** CXCONS ENTRY POINTS *** * 02958000 +AXCXCON1 DS V(CXCON1) SCAN HEXADECIMAL CONSTANTS 02960000 +AXCXCON2 DS V(CXCON2) ASSEMBLE HEXADECIMAL CONSTANTS 02962000 +* *** CZCONS ENTRY POINTS *** * 02964000 +AXCZCON1 DS V(CZCON1) SCAN ZONED CONSTANTS 02966000 +AXCZCON2 DS V(CZCON2) ASSEMBLE ZONED CONSTANTS 02968000 +* *** ERRORS ENTRY POINTS *** * 02970000 +AXERRTAG DS V(ERRTAG) FLAG ERROR 02972000 +AXERRLAB DS V(ERRLAB) ERROR FLAG FOR A LABEL 02974000 +* *** ESDOPRS ENTRY POINTS *** * 02976000 +AXESINT1 DS V(ESINT1) ESD ROUTINE INITIALIZATION 02978000 +AXESCSEC DS V(ESCSEC) CSECT,START, OR DSECT 02980000 +AXESENX1 DS V(ESENX1) ENTRY OR EXTRN - PASS 1 02982000 +AXESENX2 DS V(ESENX2) PASS 2 ENTRY AND EXTRN 02984000 +* *** EVALUT - EXPRESSION EVALUATOR *** * 02986000 +AXEVALUT DS V(EVALUT) GENERAL EXPRESSION EVALUATION ROUT 02988000 +* *** 2ND LEVEL PROCESSOR CSECTS *** * 02990000 +AXIAMOP1 DS V(IAMOP1) MACHINE OPCODES-PASS 1 02992000 +AXIBASM1 DS V(IBASM1) ASSEMBLER OPCODES - PASS 1 02994000 +AXICMOP2 DS V(ICMOP2) MACHINE OPCODES - PASS 2 02996000 +AXIDASM2 DS V(IDASM2) ASSEMBLER OPCODES - PASS 2 02998000 +* *** INPUT1 ENTRY POINTS *** * 03000000 +AXINCARD DS V(INCARD) INPUT CARD PROCESSOR 03002000 +* *** LTOPRS ENTRY POINTS *** * 03004000 +AXLTINT1 DS V(LTINT1) LITERAL TABLE INITIALIZATION 03006000 +AXLTENT1 DS V(LTENT1) ENTER A LITERAL INTO POOL 03008000 +AXLTDMP1 DS V(LTDMP1) RETURN LITERAL LENGTH-PASS 1 03010000 +AXLTEND1 DS V(LTEND1) END PASS 1 FOR LITERAL TABLE 03012000 +AXLTGET2 DS V(LTGET2) GET ADDRESS OF LITERAL 03014000 +AXLTDMP2 DS V(LTDMP2) PRODUCE LITERAL RECORDS-PASS 2 03016000 + AIF (NOT &$MACROS).AXNOMAC SKIP IF NO MACROS 03017000 +* ** MACROS ENTRY POINTS ** * 03017100 +AXMACINT DS V(MACINT) MACRO INITIALIZATION ENTRY 03017200 +AXMACRO1 DS V(MACRO1) BUILD MACRO DEFINITION TABLES 03017300 +AXMEXPND DS V(MEXPND) MACRO EXPANSION ENTRY 03017400 +AXMCBODY DS V(MCBODY) PROCESS MACRO DEFINITION BODY 03017405 +AXMACSCN DS V(MACSCN) SCAN MACRO STATEMENT 03017410 +AXMACFND DS V(MACFND) SEARCH MACRO LIBRARY 03017415 +AXMCVSCN DS V(MCVSCN) SCAN VARIABLE SYMBOL 03017420 +AXMCSCOP DS V(MCSCOP) SCAN STANDARD OPERAND 03017425 +AXMCGTST DS V(MCGTST) MOVE STRING TO LOW CORE 03017430 +AXMCSYSR DS V(MCSYSR) SEARCH MACRO LIBRARIES FOR VAR SYMBL 03017435 +AXMACLEX DS V(MACLEX) MACRO STMT LEX ANALYSIS 03017440 +AXMCGNCD DS V(MCGNCD) MACRO DEFINITION CODE GENERATION 03017445 +AXMXMVSR DS V(MXMVSR) MOVE GENERATED STMT TO HIGH CORE 03017450 +AXMXERRM DS V(MXERRM) GENERATE ERROR MESSAGE 03017455 +AXMCDTRM DS V(MCDTRM) CHAR TO BINARY CONVERSION 03017460 +AXMCATRM DS V(MCATRM) TEST FOR ATTRIBUTE 03017465 + DS 2V SPACE FOR MACRO ENTRY POINTS 03017500 +.AXNOMAC ANOP 03017600 +* *** MAIN PROGRAMS - PASS 1&2 *** * 03018000 +AXMOCON1 DS V(MOCON1) MAIN CONTROL - PASS 1 03020000 +AXMOSTOP DS V(MOSTOP) DISASTER EXIT-PASS 1 03022000 +AXMTCON2 DS V(MTCON2) MAIN CONTROL - PASS 2 03024000 +* *** OPCOD1 ENTRY POINTS *** * 03026000 +AXOPINIT DS V(OPINIT) INITIALIZATION,IF ANY 03028000 +AXOPFIND DS V(OPFIND) LOOKUP OPCODE 03030000 +* *** OUTPUT ENTRY POINTS *** * 03032000 +AXOUINT1 DS V(OUINT1) INITIALIZATION ENTRY FOR OUTPUT 03034000 +AXOUTPT2 DS V(OUTPT2) OUTPUT LINE PRINTER 03036000 +AXOUEND2 DS V(OUEND2) FINISH UP LAST PRINTING 03038000 +* *** SCANRS ENTRY POINTS *** * 03040000 +AXSCANBL DS V(SCANBL) SCAN TO FIRST BLANK OUTSIDE OF C' 03042000 +AXSCANCO DS V(SCANCO) SCAN TO COMMA OR BLANK 03044000 +AXSCANEQ DS V(SCANEQ) SCAN TO = OR BLANK 03046000 +* *** SDTERM ENTRY POINTS *** * 03048000 +AXSDBCDX DS V(SDBCDX) SELF DEFINING TERM-ALL 4 KINDS * 03050000 +AXSDBTRM DS V(SDBTRM) BINARY SELF-DEFINING TERM 03052000 +AXSDCTRM DS V(SDCTRM) CHARACTER SELF-DEFINING TERM 03054000 +AXSDDTRM DS V(SDDTRM) DECIMAL SELF-DEFINING TERM 03056000 +AXSDXTRM DS V(SDXTRM) HEXADECIMAL SLEF-DEFINING TERM 03058000 +* *** SYMOPS ENTRY POINTS *** * 03060000 +AXSYINT1 DS V(SYINT1) SYMBOL TABLE INITIALIZATION 03062000 +AXSYENT1 DS V(SYENT1) ENTER A SYMBOL INTO SYMBOL TABLE 03064000 +AXSYFIND DS V(SYFIND) LOOK UP A SYMBOL IN SYMBOL TABLE 03066000 +AXSYEND2 DS V(SYEND2) CLEANUP/STATISTICS AT END OF SYM TAB 03068000 +* *** UTOPRS ENTRY POINTS *** * 03070000 +AXUTINT1 DS V(UTINT1) UTILITIES INITIALIZATION 03072000 +AXUTPUT1 DS V(UTPUT1) PASS 1 OUTPUT OF EXPANDED RECORDS 03074000 +AXUTEND1 DS V(UTEND1) END PASS 1-INIT FOR PASS 2 03076000 +AXUTGET2 DS V(UTGET2) GET ADDR'S OF EXPANDED RECRDS-PASS 2 03078000 +AXUTPUT2 DS V(UTPUT2) OBJECT CODE CREATION-PASS 2 03080000 +AXUTEND2 DS V(UTEND2) FINISH UP PASS 2 03082000 + AIF (NOT &$XREF).NOXREF2 SKIP IF NO CROSS REFERENCE A 03082100 +* CROSS REFERENCE ENTRY POINTS A 03082150 +AXXRINT1 DS V(XRINT1) 1ST PASS INIT ROUTINE A 03082200 +AXXRINT2 DS V(XRINT2) 2ND PASS INIT ROUTINE A 03082250 +AXXRCOLL DS V(XRCOLL) COLLECTION ROUTINE A 03082300 +AXXRPRNT DS V(XRPRNT) PRINT ROUTINE A 03082350 +AXXRSCAN DS V(XRSCAN) CONTROL CARD SCANNING ROUTINE A 03082400 +.NOXREF2 ANOP 03082450 +AXSPECAD DS A BASE ADDRESS FOR SPECIAL ROUTINES 03084000 +AXSPECA2 DS A BASE @ LEV2-PASS 2 - 'SPECIALS' 03086000 + EJECT 03088000 +* * * * * AVWXTABL SECTION W - CONSTANTS * * * * * * * * * * * * * * * 03090000 +AWD0 DS 0D FLOATING POINT 0 FOR CDE 03092000 +AWZEROS DS 32D'0' 256 BYTES OF BINARY ZEROS 03094000 +AWD10 DS D'10' DOUBLEWORD CONSTANT 10 03095000 +AWF1 DS F'1' FULLWORD 1 CONSTANT 03096000 +AWH1 EQU AWF1+2 HALFWORD 1 CONSTANT 03098000 +AWB1 EQU AWF1+3 BYTE 1 CONSTANT 03100000 +AWF3 DS F'3' FULLWORD 3 CONSTANT 03102000 +AWH3 EQU AWF3+2 HALFWORD 3 CONSTANT 03104000 +AWB3 EQU AWF3+3 BYTE 3 CONSTANT 03106000 +AWF4 DS F'4' FULLWORD CONSTANT 4 03108000 +AWF7 DS F'7' FULLWORD 7 CONSTANT 03110000 +AWH7 EQU AWF7+2 HALFWORD 7 CONSTANT 03112000 +AWB7 EQU AWF7+3 BYTE 7 CONSTANT 03114000 +AWF10 DS F'10' FULLWORD CONSTANT 10 03115000 +AWH10 EQU AWF10+2 HALFWORD CONSTANT 10 03115100 +AWF12 DS F'12' FULLWORD CONSTANT 12 03116000 +AWF15 DS F'15' FULLWORD CONSTANT 15 (4 1 BITS) 03118000 +AWFXF EQU AWF15 FULLWORD CONSTANT,4 1-BITS 03120000 +AWFXFF DS F'255' FULLWORD CONSTANT 255 03122000 +AWF4095 DS F'4095' FULLWORD 4095 CONSTANT 03124000 +AWFXFFF EQU AWF4095 XL4'FFF' ON F BOUNDARY 03126000 +AWHXFFF EQU AWFXFFF+2 XL2'0FFF' ON H BOUNDARY 03128000 +AWFX7FFF DS X'00007FFF' MAXIMUM SIZE, MASK VALUE 03130000 +AWFXFFFF DS X'0000FFFF' 65K DECIMAL NUMBER 03132000 +AWFX6F DS XL4'FFFFFF' FULLWORD 24-BIT MASK 03134000 +AWFM4 DS F'-4' FULLWORD -4 CONSTANT 03136000 +AWFM1 DS F'-1' FULLWORD -1 CONSTANT 03138000 +AWHM1 EQU AWFM1+2 HALFWORD -1 CONSTANT 03140000 + EJECT 03141000 +* TABLE USED TO SCAN DECIMAL NUMBERS * 03142000 +* CHARACTERS 0-9 HAVE ZERO VALUES,ALL OTHERS NONZERO * 03144000 +* ALSO USED IN ICMOP2 FOR GENERAL SCANNING. * 03146000 +* TR TABLE 0 1 2 3 4 5 6 7 8 9 A B C D E F * 03148000 +AWTDECT DS X'02020202020202020202020202020202' 0 03150000 + DS X'02020202020202020202020202020202' 1 03152000 + DS X'02020202020202020202020202020202' 2 03154000 + DS X'02020202020202020202020202020202' 3 03156000 + DS X'100202020202020202020202020C0202' 4 BLANK ( 03158000 + DS X'02020202020202020202020608020202' 5 $ * 03160000 + DS X'02020202020202020202020E02020202' 6 , 03162000 + DS X'02020202020202020202020606020A02' 7 # @ = 03164000 + DS X'02020202020202020202020202020202' 8 03166000 + DS X'02020202020202020202020202020202' 9 03168000 + DS X'02020202020202020202020202020202' A 03170000 + DS X'02020202020202020202020202020202' B 03172000 + DS X'02060404060606060606020202020202' C B-C(4) ALPHS-6 03174000 + DS X'02060604060606060606020202020202' D L-(4) ALPHS-6 03176000 + DS X'02020606060606040606020202020202' E X-(4) ALPHS - 6 03178000 + DS X'00000000000000000000020202020202' F 03180000 + SPACE 1 03181000 +* TABLE USED TO SCAN HEXADECIMAL CONSTANTS FOR CORRECTNESS * 03182000 +* CHARACTERS A-F,0-9 ARE ZERO,ALL OTHERS ARE NON-ZERO * 03184000 +AWTHEXT DS X'02020202020202020202020202020202' 0 03186000 + DS X'02020202020202020202020202020202' 1 03188000 + DS X'02020202020202020202020202020202' 2 03190000 + DS X'02020202020202020202020202020202' 3 03192000 + DS X'02020202020202020202020202020202' 4 03194000 + DS X'02020202020202020202020202020202' 5 03196000 + DS X'02020202020202020202020202020202' 6 03198000 + DS X'02020202020202020202020202020202' 7 03200000 + DS X'02020202020202020202020202020202' 8 03202000 + DS X'02020202020202020202020202020202' 9 03204000 + DS X'02020202020202020202020202020202' A 03206000 + DS X'02020202020202020202020202020202' B 03208000 + DS X'02000000000000020202020202020202' C 03210000 + DS X'02020202020202020202020202020202' D 03212000 + DS X'02020202020202020202020202020202' E 03214000 + DS X'00000000000000000000020202020202' F 03216000 + SPACE 1 03217000 +* TABLE USED TO CONVERT HEXADECIMAL CONSTANTS * 03218000 +AWTHEX2 EQU *-C'A' OFFSET SYMBOL FROM TABLE CORRECTLY 03220000 +* TR TABLE 0 1 2 3 4 5 6 7 8 9 A B C D E F * 03222000 + DS X'0A0B0C0D0E0F000000000000000000' C 03224000 + DS X'00000000000000000000000000000000' D 03226000 + DS X'00000000000000000000000000000000' E 03228000 + DS X'00010203040506070809' F 03230000 + EJECT 03231000 +* USED TO SCAN ACROSS SYMBOLS,STOP ON DELIMITERS * 03232000 +* CHARACTERS $,#,@,A-Z,0-9 ARE ZERO. ALL OTHERS ARE NONZERO * 03234000 +* ALSO USED IN EVALUT FOR OPERATOR CODES- (+*)-/, * 03236000 +* TR TABLE 0 1 2 3 4 5 6 7 8 9 A B C D E F * 03238000 +AWTSYMT DS X'01010101010101010101010101010101' 0 03240000 + DS X'01010101010101010101010101010101' 1 03242000 + DS X'01010101010101010101010101010101' 2 03244000 + DS X'01010101010101010101010101010101' 3 03246000 + DS X'04010101010101010101010101020501' 4 BLANK (+ 03248000 + DS X'01010101010101010101010007030101' 5 $*) 03250000 + DS X'06080101010101010101010401010101' 6 -/, 03252000 + DS X'01010101010101010101010000010101' 7 #@ 03254000 + DS X'01010101010101010101010101010101' 8 03256000 + DS X'01010101010101010101010101010101' 9 03258000 + DS X'01010101010101010101010101010101' A 03260000 + DS X'01010101010101010101010101010101' B 03262000 + DS X'01000000000000000000010101010101' C A-I 03264000 + DS X'01000000000000000000010101010101' D J-S 03266000 + DS X'01010000000000000000010101010101' E S-Z 03268000 + DS X'00000000000000000000010101010101' F 0-9 03270000 + SPACE 1 03271000 +AWTZTAB EQU AWZEROS SPACE FOR 256-BYTE ZEROED TRT TABLE 03272000 + DS 0D LINE UP BLANKS ON D BOUNDARY 03274000 +AWBLANK DS CL132' ' BLANKS 03276000 + ORG AWBLANK+16 MAXIMUM OVERLAP OF AWBLANK&AWTHEX3 03278000 +* TABLE USED TO CONVERT INTERNAL BINARY TO EXTERNAL HEX. * 03280000 +* TR TABLE 0123456789ABCDEF0123456789ABCDEF * 03282000 +AWTHEX3 DS C' ' 0-1 03284000 + DS C' ' 2-3 03286000 + DS C' ' 4-5 03288000 + DS C' ' 6-7 03290000 + DS C' ' 8-9 03292000 + DS C' ' A-B 03294000 + DS C' ' C-D 03296000 + DS C' 0123456789ABCDEF' E-F 03298000 +AWEP4 DS X'40202120' 4-BYTE DECIMAL EDIT PATTERN 03300000 +AWEP6 DS X'402020202120' 6-BYTE EDIT PATTERN FOR DEC # 03302000 +AWP0 DS PL1'0' FOR ZEROING DECIMAL COUNTERS 03304000 +AWP1 DS P'1' DECIMAL CONSTANT 1 03306000 +AWCONADS DS ($CNT$N)AL1 OFFSETS TO CONSTANT PROG ADCONS 03308000 + EJECT 03310000 +AVOENTR EQU B'00000010' (AVTAGS1) ENTRY @ FROM END 03310100 +AVO1TXT EQU B'00000100' (AVTAGS1) >=1 TXT CARDS FND 03310110 + SPACE 1 03310120 +* * * * * AVWXTABL SECTION V - VARIABLES * * * * * * * * * * * * * * * 03312000 + DS 0D GET ALIGNMENT 03314000 +* **NOTE VARIABLES FROM HERE THRU AVAJL ARE GIVEN INITIAL * 03314500 +* VALUES BY CALLING PROGRAM BEFORE CALLING MPCON0. * 03315000 +AVADDLOW DS F POINTER TO HIGH END OF LOW AREA 03316000 +* GIVES FIRST FREE LOCATION AT LOW END. * 03318000 +AVADDHIH DS F POINTER TO LOW ADDR OF HIGH END 03320000 +* GIVES LOWEST ADDR OF ALREADY USED SPACE * 03322000 +AVECONPT DS A @ ECONTROL, IF NEEDED (REPLMON) 03322050 +AVAJOBPT DS A @ AJOBCON TABLE, IN CASE EVER NEEDED 03322100 + SPACE 1 03322150 +* VARIABLES FROM HERE TO AVAJL CORRESPOND TO AJOBOCN 03322200 +* SECTION AJONERR - AJOAVL, AND CANNOT BE CHANGED WITHOUT 03322250 +* EXTREME CARE. AJOAVL MUST = AVAJL. 03322300 + CNOP 2,4 ALIGN AVNERR LIKE AJONERR 03322350 +AVNERR DS H MAX # ACTUAL ERRORS ALLOWED 03322400 + SPACE 1 03322450 + AIF (NOT &$MACROS).AVMXX1 SKIP IF NO MACROS AT ALL 03322500 + SPACE 1 03322550 +* AVMMACTR-AVMMSTMG MUST BE IN SAME ORDER AS AJOMACTR-AJOMSTMG. 03322600 +AVMMACTR DS F DEFAULT INITIAL VALUE OF MACRO ACTR 03322650 +AVMMNEST DS F ABSOLUTE LIMIT ON MACRO NEST LEVEL 03322700 +AVMMSTMG DS F GLOBAL LIMIT ON MACRO STMTS PROCESSD 03322750 +AVTAGSM DS B MACRO OPTIONS BITS (FROM AJOASMFM) 03322800 +* BIT7=0 => NO MACROS ALLOWED. =1(AJOMACRO) => MACROS ALLOWED 03322850 +* BIT6=0 => NO ASM G FEATURES. =1(AJOMACRG) => ADD MACRO G TO ABOVE 03322900 +* BIT5=0 => NO ASM H FEATURES =1(AJOMACRH) => ADD MACRO H TO F 03322950 +* REMAINING BITS RESERVED FOR FUTURE USE WITH MACRO PROCESSING. * 03323000 +.AVMXX1 ANOP 03324000 +AVTAGS0 DS B FLAG- FUTURE USE FROM AJOBCON 03326000 + SPACE 1 03326050 +AVTAGS1 DS B 1ST BYTE OF FLAG BITS 03326100 +* BIT0=0 => START ALLOWED, =1($IBSTAR1)=> START NO LONGER ALLOWED. * 03326150 +* BIT1=0 => CURRENT SECTION IS CSECT, =1($IBDSEC1)=> IN DSECT NOW * 03326200 +* BIT2=0 => NO PRIVATE CODE, =1($IBPRCD1)=> PRIV CODE HAS OCCURREC * 03326250 +* BIT3=0 => NORMAL LOAD, =1(AJORELOC)=> LOAD RELOCATED TO REAL @'S * 03326300 +* BIT4=0 => ALL IN CORE, =1(AJODISKU) => USE DISK INTERMEDIATE. * 03326350 +* BIT5=0 => NORMAL PROGRAM, =1(AJOLARGE)=> PROG LARGE, CRUNCH MUCH * 03326400 +* BIT6=0 => LIST SOURCE, =1(AJNLIST)=> NOLIST (EXCEPT ERRORS) * 03326450 +* BIT7=0 => LOAD OBJECT CODE, =1(AJNLOAD)=> CREATE NO OBJECT CODE * 03326500 +* *NOTE* BITS 3-7 ARE SET FROM AJOASMF, BITS 0-2 INIT = 0. * 03326550 +* AVTAGS1 BITS ALSO USED BY OBJECT CODE LOADER AOBJIN. 03326560 +* BIT0=0 => NO TXT CARDS FOUND YET. =1(AVO1TXT) => >= 1 CARD FOUND. * 03326565 +* BIT1=0 => NO ENTRY @ FND ON END CARD YET. =1(AVOENTR) => FOUND. * 03326570 + SPACE 1 03326600 +AVTAGS2 DS B 2ND BYTE OF FLAG BITS 03326650 +* BIT0=0 => NO EOF FOUND, =1($INEND2)=> EOF, CREATE END CARD 03326700 +* BIT1=0 => CONTINUE ASSEMBLY. =1(AJOASTOP) ==> STOP ASSEMBLY. 03326705 +* BIT0=0 => NODECK. =1(AJODECK) => OBJECT DECK(USES ). * 03326725 +* BIT6=0 => NO COMMENT CHECK. =1 REQUIRES &$COMNT % OF MACH INSTS 03326730 +* BIT7=0=> NORMAL LISTING. =1 => CMPRS LISTING (2 STMTS/LINE) 03326740 +* OTHER BITS FOR FUTURE USE, SET FROM AJOASMF2 IN AJOBCON. * 03326750 + AIF (NOT &$XREF).NOXREF1 SKIP IF NO XREF A 03326755 +AVXRFLAG DS C FLAG BYTE FOR CROSS REFERENCE A 03326760 + SPACE 2 03326765 +* THE FOLLOWING FLAGS USED IN TESTING THE ABOVE FLAG A 03326770 + SPACE 03326775 +AVXRON EQU B'00100000' XREF FACILITY ON A 03326780 +AVXRCOMP EQU B'00110000' COMPRESSED LISTING A 03326785 +AVXRSDMD EQU B'00001000' SD OPERAND MOD REFERENCE A 03326790 +AVXRSDFT EQU B'00000100' SD OPERAND FETCH REFERENCE A 03326795 +AVXRSRMD EQU B'00000010' SR OPERAND MOD A 03326800 +AVXRSRFT EQU B'00000001' SR OPERAND FETCH A 03326805 +.NOXREF1 ANOP 03326810 +AVAJL EQU *-AVNERR LENGTH OF BLOCK FROM AJOBCON 03327000 +* VRADL,VRADH,VRELOC,VFENTER,VLOCLOW,VLOCHIH MUST BE IN * 03328000 +* THE ORDER WHICH IS GIVEN. THEY ARE USED IN LM-STM GROUPS * 03330000 +AVRADL DS A LOWEST REAL ADDRESS OF USER PROGRAM 03332000 +AVRADH DS A HIGHEST REAL ADDRESS OF USER PROGRAM 03334000 +AVRELOC DS F RELOCATION FACTOR FOR OBJECT CODE 03336000 +AVZAREA1 DS 0F VARIABLE AREA TO BE ZEROED-BEGINNING 03338000 +AVFENTER DS A PROGRAM ENTRY POINT ADDRESS 03340000 +* AVLOCLOW,AVLOCHIH,AVLOCNTR,AVCSLOW,AVCSHIH-REQUIRED ORDR 03341000 +AVLOCLOW DS F LOWEST LOCATION COUNTER(START OR 0) 03342000 +AVLOCHIH DS F HIGHEST VALUE OF AVLOCCNTR 03344000 +AVLOCNTR DS F LOCATION COUNTER 03346000 +AVCSLOW DS F CURRENT CSECT LOW LOCCNTR VALUE 03348000 +AVCSHIH DS F CURRENT CSECT HIGH VALUE 03350000 + SPACE 1 03351000 +AVSTMTNO DS H TOTAL # OF STATEMENTS 03352000 +AVSTMTER DS H TOTAL # STMTS FLAGGED 03354000 +AVNERRA DS H # FATAL ERROR MESSAGES 03358000 +AVNWARN DS H # WARNING MESSAGES 03360000 +AVOUCOUN DS H WITHIN PAGE LINE COUNT (OUTPUT) 03362000 +AVOULNCN DS PL3 STATEMENT NUMBER CURRENT 03364000 +AVOUPGCN DS PL2 NUMBER OF PAGES (OUTPUT) 03366000 + AIF (NOT &$XREF).NOXREF4 SKIP IF NO XREF 03366050 +AVXRLAVS DS F LIST OF AVAIL SPACE FOR XREF A 03366100 +AVXRHEAD DS F HEADER POINTER FOR XREF TREE A 03366150 +AVXRCNT DS H COUNTER FOR NUMBER OF REFERENCES A 03366200 +AVXRLNCN DS PL3 ADDITIONAL LINE COUNTER FOR XREF A 03366250 +AVXRMDFT DS C ADDITIONAL FLAG FOR XREF A 03366300 +* FLAG TO BE TESTED WITH THE FOLLOWING A 03366350 +AVXRMOD1 EQU B'10000000' MODIFY FIRST OPERAND A 03366400 +AVXRMOD2 EQU B'01000000' MODIFY SECOND OPERAND A 03366450 +AVXRMOD3 EQU B'00100000' MODIFY THIRD OPERAND A 03366500 +AVXRMOD4 EQU B'00010000' MODIFY FIRST THRU SECOND OPERAND A 03366550 +AVXRFET1 EQU B'00001000' FETCH FIEST OPERAND A 03366600 +AVXRFET2 EQU B'00000100' FETCH SECOND OPERAND A 03366650 +AVXRFET3 EQU B'00000010' FETCH THIRD OPERAND A 03366700 +AVXRFET4 EQU B'00000001' FETCH FIRST THRU SECOND OPERAND A 03366750 +AVXRTYPE DS C USED TO TEST M/F REFERENCE A 03366800 +AVXRFTCH EQU X'08' USED TO TEST ABOVE FLAG A 03366850 +* IF NOT TYPE , MUST BE MODIFY REFERNCE A 03366900 +.NOXREF4 ANOP 03366950 + SPACE 03367000 +AVCESDID DS C CURRENT CSECT ESDID 03368000 +* EVEN VALUE=> CSECT, ODD VALUE=> DSECT ($ESDSECT FLAG). 03370000 +AVPRINT DS C LISTING CONTROL FLAG BYTE 03380000 +AVPRINT1 DS C LISTING CONTROL: 1ST PASS ONLY 03381000 +AVPRSAVE EQU B'00000001' (AVPRINT1,AVPRINT)==> SAVE IN 1ST PS 03381020 +AVDEBUG DS C DEBUGGING FLAG TESTED BY XSNAPS 03382000 +AVTAGS3 DS B VARIOUS FLAGS 03382100 +* BIT0=0 => NO STORAGE OVERFLOW. =1(AVOVERFL) => STORAGE EXCEEDED. 03382200 +AVOVERFL EQU B'10000000' (AVTAGS3) => STORAGE OVERFLW OCCRD 03382300 +AVMTAG00 DS B MISC FLAG BYTE, MACRO COMMUNICATION 03382800 +AVMOPENC EQU B'00000001' (AVMTAG00)==> GBLX,LCLX IN OPEN COD 03382810 +AVMNOMAC EQU B'00000010' (AVMTAG00) => NO MORE MACROS S 03382820 +* BECAUSE GBLX, LCLX, ETC. FOUND S 03382830 +AVMOPDIC EQU B'00000100' (AVMTAG00) => OPEN CODE LOCAL S 03382840 +* DICTIONARY HAS BEEN ALLOCATED S 03382850 +AVMOPGO EQU B'00001000' (AVMTAG00) => SUCCESSFUL AIF/AGO S 03382860 +AVMOPMIN EQU B'00010000' (AVMTAG00) - OPEN CODE MACLIB ENTRY X03382870 + IS PROPERLY ZEROED & @ OF LOCAL SX03382871 + DUMMY HAS BEEN ENTERED S 03382872 +AVMISC00 DS B MISC FLAG BYTE, FUTURE USE 03383000 +AVMISC01 DS B MISC FLAG BYTE, FUTURE USE 03383200 +AVMISC02 DS B MISC FLAG BYTE, FUTURE USE 03383400 +AVZAREA2 DS 0D VARIABLE AREA TO BE ZEROED - END 03384000 + EJECT 03384500 +AVECONTR DS 0D ECONTROL DSECT WILL BE LOCATED HERE 03385000 +AVCONCAT DS CL256 SPACE FOR CONSTANT BUILDING(CNDTL2) 03385500 +AVCONBLD DS CL256 CONSTANT/CODE BUILDING AREA 03386000 +AVRSBLOC DS CL(RSB$L+RSOL1+80+RSOLC*($RSMXCRD-2)) RSBLOCK AREA 03390000 +AVRSCBLK DS (RSCONSQ-RSCBLK+$RSMXCRD*RSC$LEN)C AREA FOR RSCBLK 03392000 +AVREBLK DS 0C BEGINNING OF RECORD ERROR BLOCK 03394000 +AVREBLN DS C RECORD ERROR BLOCK LENGTH-1 03396000 +AVREBES DS ($ERREBMX)CL2 ERROR CODE AREAS 03398000 +AVREBSCN EQU AVREBES BYTE FOR SCAN OFFSET 03400000 +AVREBERR EQU AVREBES+1 BYTE FOR ERROR CODE 03402000 + ORG , MAKE SURE BACK FAR ENOUGH 03402100 + SPACE 1 03403000 +AVDWORK1 DS D 1ST DOUBLE WORD WORK AREA 03404000 +AVDWORK2 DS D 2ND DOUBLE WORD WORK AREA 03406000 +AVRCBPT DS A ADDRESS OF RECORD CODE BLOCK 03408000 +AVREBPT DS A ADDRESS OF RECORD ERROR BLOCK 03410000 +AVRSBPT DS A ADDRESS OF RECORD SOURCE BLOCK 03412000 +AVRSCPT DS A RECORD SOURCE CODE BLOCK POINTER 03414000 +AVLABPT DS F ADDRESS OF LABEL ENTRY,=0 IF NO LAB 03416000 +AVFWORK1 DS F 1ST FULLWORD WORKAREA 03418000 +AVMPSPIE DS A @ SPIE BLOCK WHEN ENTERED ASSEMBLER 03418100 +AVSOLAST DS A @ BLANK BEFORE ' AFTER SOURCE STMT 03418200 + AIF (&$COMNT EQ 0).AVNOCOM SKIP IF NO COMMENT CHECKING 03418300 +* FOLLOWING 2 VARIABLES MUST BE IN GIVEN ORDER. 03418400 +AVMACHIN DS H # MACHINE INSTS, SET BY IAMOP1 03418500 +AVCOMNTN DS H # MACHINE INSTS WITH COMMENTS 03418600 +.AVNOCOM ANOP 03418700 + AIF (&$DISKU EQ 0).AVDKTA SKIP IF NO DISK AT ALL 03418705 +* 03418710 +* BUFFER CONTROL BLOCK FOR DISK UTILITY I/O SYNCHRONIZATION 03418715 +* 03418720 +AVBCB DS 0F BUFFER CONTROL BLOCK 03418725 +AVDECB DS A(0) ADDRESS OF CURRENT DECB 03418730 +AVBUFF@ DS A(0) ADDRESS OF CURRENT BUFFER 03418735 +AVBUFINC DS A(0) POINTER TO 1ST UNUSED BYTE IN BUFFER 03418740 +AVBUFEND DS A(0) POINTER TO END OF BUFFER 03418745 + AIF (&$BUFNO EQ 1).AVDKTA SKIP IF ONLY 1 BUFFER 03418750 +AVDECBNX DS A(0) ADDRESS OF NEXT DECB 03418755 +AVDECBLT DS A(0) POINTER TO LAST DECB 03418760 +.AVDKTA ANOP 03418765 + AIF (NOT &$MACROS).AVNOMAC SKIP IF NO MACROS 03418800 + SPACE 2 03418810 +* VARIABLES USED IN MACRO PROCESSING. * 03418850 +AVSYSECT DS D CURRENT CSECT/DSECT NAME 03418860 +AVGEN1CD DS A @ 1ST BYTE BEYOND 1ST GEN'D CARD- 03418870 +* SET BY MEXPND. THEN USED AS PTR BY INCARD. 03418880 +AVGEN2CD DS A USED AS PTR BY INCARD. HAS @ LAST 03418890 +* CARD GENERATED BY MEXPND (ORIG SETTING OF AVADDHIH). 03418900 +AVMACSPC EQU * LABEL FOR SPACE FOR MACRO AVM'S 03418905 +* 03418910 +.AVNOMAC ANOP 03418920 + AIF (NOT &$MACROS).AVNLIB SKIP IF NO MACROS 03418930 +AVMFLD1 DS F POINTER TO CURRENT LABEL FIELD 03418935 +AVMFLDL1 DS C LENGTH OF LABEL 03418940 +AVMFLDT1 DS C TYPE OF LABEL - SEQ, VAR OR OTHER 03418945 +AVMFLD1H DS H NOT CURRENTLY USED 03418950 +AVMFLD2 DS F POINTER TO OPCODE FIELD 03418955 +AVMFLDL2 DS C LENGTH OF OPCODE FIELD 03418960 +AVMFLDT2 DS C TYPE OF OPCODE - ASM, MACR OR MAC IN 03418965 +AVMFLD2H DS H NOT CURRENTLY USED 03418970 +AVMFLD3 DS F POINTER TO OPERAND FIELD 03418975 +AVMFLDL3 DS C LENGTH OF OPERAND FIELD 03418980 +AVMFLDT3 DS C TYPE OF OPERAND FIELD 03418985 +AVMFLD3H DS H NOT CURRENTLY USED 03418990 +AVMFLD4 DS F POINTER TO COMMENT FIELD 03418995 +AVMFLDL4 DS C LENGTH OF COMMENT FIELD 03419000 +AVMFLDT4 DS C TYPE OF COMMENT FIELD - NOT USED 03419005 +AVMFLD4H DS H NOT CURRENTLY USED 03419010 +AVMFLD5 DS F 2ND CARD NON STND OPRND 03419015 +AVMFLDL5 DS C 2ND CARD NON STND OPRND LENGTH 03419020 +AVMFLDT5 DS C 2ND CARD NON STND OPRND TYPE 03419025 +AVMFLD5H DS H NOT CURRENTLY USED 03419030 +AVMFLD6 DS F 2ND NON STND CARD COMMENT 03419035 +AVMFLDL6 DS C 2ND NON STND CARD COMMENT LENGTH 03419040 +AVMFLDT6 DS C 2ND NON STND CARD COMMENT TYPE 03419045 +AVMFLD6H DS H NOT CURRENTLY USED 03419050 +AVMFLD7 DS F 3RD NON STND CARD OPRND 03419055 +AVMFLDL7 DS C 3RD NON STND CARD OPRND LENGTH 03419060 +AVMFLDT7 DS C 3RD NON STND CARD OPRND TYPE 03419065 +AVMFLD7H DS H NOT CURRENTLY USED 03419070 +AVMFLD8 DS F 3RD NON STND CARD COMMENT 03419075 +AVMFLDL8 DS C 3RD NON STND CARD COMMENT 6ENGTH 03419080 +AVMFLDT8 DS C 3RD NON STND CARD COMMENT TYPE 03419085 +AVMFLD8H DS H NOT CURRENTLY USED 03419090 +$LAVMFLD EQU *-AVMFLD1 LENGTH OF FIELD INFO POINTERS 03419095 + SPACE 1 03419100 +AVMBYTE1 DS C 1ST MACRO FLAG BYTE 03419105 +AVMBYTE2 DS C 2ND MACRO FLAG BYTE 03419110 +AVMBYTE3 DS C 3RD MACRO FLAG BYTE 03419115 +AVMBYTE4 DS C FLAG BYTE 03419120 +AVMBYTE5 DS C FLAG BYTE 03419125 + SPACE 1 03419130 +AVMSYMLN DS C LENGTH OF CURRENT SYMBOL 03419135 +AVMSYMBL DS CL8 GLOBAL AREA FOR CURRENT SYMBOL 03419140 +AVMSYSDX DS PL2 CURRENT &SYSNDX COUNT 03419145 + SPACE 1 03419150 +AVMSEQPT DS F POINTER TO SEQ SYMBOL TABLE 03419155 +AVMCRINS DS F CURRENT GENERATED INSTRUCTION @ 03419160 +AVMMACID DS F CONTAINS ID NUMBER OF CURRENT MACRO 03419165 +AVMACNST DS F CURRENT MACRO NESTING COUNT 03419170 +AVMLDICT DS F POINTER TO OPEN LOCAL DICTIONARY 03419175 +AVMGDICT DS F POINTER TO GLOBAL DICTIONARY 03419180 +AVMACLIB DS F POINTER TO MACRO LIBRARY 03419185 +AVMOVRFL DS A @ OVERFLOW EXIT ROUTINE 03419190 +AVMTSCNP DS F TEMP STORAGE FOR SCAN POINTER 03419195 + SPACE 1 03419200 +AVMBSPIE DS F TEMP STORAGE FOR MCBODY $SPIE INT @ 03419205 + ORG AVMBSPIE PUT AVMXSPIE IN SAME PLACE********** 03419210 +AVMXSPIE DS F TEMP STORAGE FOR MXPEND SPIE INT @ 03419215 + SPACE 1 03419220 +AVMCHSTR DS F @ OF CHARACTER WORK AREA 03419225 +AVMCHLIM DS F LAST AVAILABLE BYTE OF CHAR WORK 03419230 +AVMWRKL1 DS F @ OF LAST BYTE OF AVMWRK1 03419235 +AVMWRKL2 DS F @ OF LAST BYTE OF AVMWRK2 03419240 + SPACE 1 03419245 +AVMWRK1 DS CL256 MACRO WORK AREA 1 03419250 +AVMWRK2 EQU AVCONCAT USE CONCAT FOR WORK AREA 2 03419255 + SPACE 1 03419260 +AVMDWRK1 DS D 1ST DOUBLE WORD WORK AREA 03419265 +AVMDWRK2 DS D 2ND DOUBLE WORD WORK AREA 03419270 +AVMDWRK3 DS D 3RD DOUBLE WORD WORK AREA 03419275 +AVMDWRK4 DS D 4TH DOUBLE WORD WORK AREA 03419280 + SPACE 1 03419285 +AVMFWRK1 DS F 1ST FULL WORD WORK AREA 03419290 +AVMFWRK2 DS F 2ND FULL WORD WORK AREA 03419295 +AVMFWRK3 DS F 3RD FULL WORD WORK AREA 03419300 +AVMFWRK4 DS F 4TH FULL WORD WORK AREA 03419305 + SPACE 1 03419310 +AVMHWRK1 DS H 1ST HALFWORD WORK AREA 03419315 +AVMHWRK2 DS H 2ND HALFWORD WORK AREA 03419320 +AVMHWRK3 DS H 3RD HALFWORD WORK AREA 03419325 +AVMHWRK4 DS H 4TH HALFWORD WORK AREA 03419330 + SPACE 1 03419335 +AVMSNBY1 DS C CONTAINS FLAGS TO CONTROL SNAPS 03419340 +AVMSNBY2 DS C CONTAINS FLAGS TO CONTROL SNAPS 03419345 + AIF (NOT &$MACSLB).AVNLIB SKIP IF NO LIBRARY FETCH 03419350 +AVLIBBUF DS F POINTER TO LIBRARY BUFFER SPACE 03419355 +.AVNLIB ANOP 03419360 +AVWXEND DS 0D ENDING @ AVWXTABL 03419900 + TITLE 'ERCOMPCD DSECT - COMPLETION CODE MESSAGE BLOCK' 03420000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03420050 +*--> DSECT: ERCOMPCD COMPLETION CODE/ERROR MESSAGE BLOCK * 03420100 +* THIS GIVES FORMAT OF 1 COMPLETION CODE/MESSAGE BLOCK FOR * 03420200 +* USE IN A USER COMPLETION DUMP BY SUBROUTINE XXXXSNAP. THE * 03420300 +* ADDRESS OF THE APPROPRIATE BLOCK IS PLACED INTO WORD ECERRAD * 03420400 +* IN DSECT ECONTROL, AND IS USED THEN BY XXXXSNAP TO PRINT THE * 03420500 +* INFORMATION IN THE ERCOMPCD BLOCK. * 03420600 +* LOCATION: INSIDE EXECUT, WILL BE ELSEWHERE(FUTURE). * 03420700 +* GENERATION: 1 BLOCK CREATED BY 1 CALL TO $ERCGN MACRO. * 03420800 +* NAMES: ERC----- * 03420900 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03421000 + SPACE 1 03421100 +ERCOMPCD DSECT 03422000 +ERCSYST EQU 0 (ERCTYPE)==> SYSTEM COMPLETION CODE 03428000 +ERCASSI EQU 1 (ERCTYPE)==> ASSIST SPECIAL MESSAGE 03430000 +ERCUSER EQU 2 (ERCTYPE)==> USER ABEND COMPLETION 03432000 +ERCLENG DS C LENGTH-1 OF ERCMSSG 03434000 +ERCTYPE DS C CODE OF COMPLETION TYPE 03436000 +ERCMSSG DS 0C COMPLETION MESSAGE(VARIABLE LENGTH) 03438000 + TITLE 'AJOBCON - MAIN JOB CONTROL TABLE DSECT' 03440000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03440050 +*--> DSECT: AJOBCON MAIN JOB CONTROL TABLE * 03440100 +* THIS DSECT PROVIDES THE PRIMARY COMMUNICATION TABLE USED * 03440200 +* BY THE MAIN PROGRAM ASSIST, THE I/O ROUTINES(XXXXIOCO), THE * 03440300 +* PARM FIELD ANALYZER (APARMS), THE MAIN PROGRAM OF THE * 03440400 +* ASSEMBLER (MPCON0), AND THE REPLACE MONITOR (REMONI). IT * 03440500 +* PROVIDES FOR GLOBAL FLAG VALUES DEALING WITH THE OVERALL * 03440600 +* JOB IN PROGRESS, PARM FIELD VALUES, USEFUL CONSTANTS, BLANKS,* 03440700 +* ZEROES, WORKAREAS, AND DYNAMIC STORAGE AREA LIMITS. * 03440800 +* LOCATION: IN TABLE ASJOBCON OF CSECT ASSIST. * 03440900 +* NAMES: AJ------ * 03441000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03441100 + SPACE 1 03441200 +AJOBCON DSECT 03442000 +* FOLLOWING EQU'S USED FOR COMMUNICATION BETWEEN ASSIST J 03442500 +* AND XXXXSORC DURING CONTROL CARD CHECKING. VALUES ARE J 03442510 +* PLACED INTO AJOBTRQ AND ATOBTYP. J 03442520 +AJO$D EQU 0 (AJOBTRQ)- DATA READ (NORMAL CASE) J 03442530 +AJO$J EQU 1 (AJOBTRQ)- LOOKING FOR $JOB CARD J 03442540 +AJO$E EQU 2 (AJOBTRQ)- LOOKING FOR $ENTRY J 03442550 +AJOAPRSE EQU B'00000001' (AJOAPMOD)- ZERO ALL APCFLAG SET 03443000 +* BITS BEFORE SCANNING PARM OPTIONS 03443100 +AJOAPDEF EQU B'00000010' (AJOAPMOD)- DEFAULT CALL TO APARMS- 03443200 +* OVERRIDE NO VALUE ALREADY SET ANY WY 03443300 +AJOAPFIN EQU B'00000100' (AJOAPMOD)- FINAL CALL TO APARMS- 03443400 +* SET ANY FINAL FLAGS NEEDED. 03443500 +AJOAPMOV EQU B'00001000' (AJOAPMOD)- MOVE PARM FIELD INTO 03443600 +* AJOPARM, WITH BLANK PADDING. IF NOT SET, APARMS WILL 03443700 +* LEAVE PARM WHERE IT IS, AND ASSUME THAT ITS LENGTH 03443800 +* INCLUDES AT LEAST ONE BLANK FOLLOWING ACTUAL PARM. 03443900 + SPACE 1 03444000 +* ----- NEXT 2 BITS POSSIBLY SET ONLY WHEN &$TIMER=2,&$RECORD=2 03444100 +AJOAPUSR EQU B'01000000' (AJOAPMOD)- SET IF USER SUPPLIED R= 03444200 +AJOAPUST EQU B'10000000' (AJOAPMOD)- SET IF USER SUPPLIED T= 03444300 +AJOBATCH EQU B'00000001' (AJOMODE)==> BATCH MODE,DON'T CLOSE 03444400 + SPACE 1 03444500 +AJOREPLF EQU B'00000010' (AJOMODE)==> REPLACE MODE RUN 03446000 +AJOMONIT EQU B'00000100' (AJOMODE)==> RUNNING UNDER WATFR MON 03448000 +AJNSYSIN EQU B'00001000' (AJOMODE)==> NO SYSIN, ABORT RUN 03449000 +AJOSRECX EQU B'00100000' (AJOMODE)==> RECORD OVERRUN OCCURRED 03450000 +AJOSOVRT EQU B'00010000' (AJOMODE)==> TIME OVERRUN OCCURRED 03452000 +AJOREPHB EQU B'01000000' (AJOMODE)==>REPLACEMENT PHASE B 03452500 + SPACE 1 03454000 +AJOMSINT EQU B'00000001' (AJOSTEP)- MAIN STORAGE INIT DONE 03454500 +AJOSDUMP EQU B'00100000' (AJOSTEP)- PROGRAM IN DUMPING PHS 03455900 +AJOSEXEC EQU B'01000000' (AJOSTEP)==> PROGR IN EXECUTION 03456000 +AJOSASM EQU B'10000000' (AJOSTEP)==> PROG IN ASSEMBLY PHASE 03458000 + SPACE 1 03460000 +AJNLOAD EQU B'00000001' (AJOASMF)==> CHECK ONLY, NO OBJCT CD 03462000 +AJNLIST EQU B'00000010' (AJOASMF)==> NO LISTING DESIRED 03464000 +AJOLARGE EQU B'00000100' (AJOASMF)==> PROGRAM IS LARGE,OPTIM 03466000 +AJODISKU EQU B'00001000' (AJOASMF,AVTAGS1) => DISK OPTION 03468000 +AJORELOC EQU B'00010000' (AJOASMF)==> RELOC CODE TO REAL @'S 03468100 + SPACE 1 03470000 +AJOCMPRS EQU B'00000001' (AJOASMF2,AVTAGS2)-COMPRESSD LISTING 03472900 +AJOCOMNT EQU B'00000010' (AJOASMF2-AVTAGS2)- COMMENT CHECK 03472950 +AJODECK EQU B'00000100' (AJOASMF2-AVTAGS2)- PUNCH OBJ DECK 03472960 +AJOASTOP EQU B'01000000' (AJOASMF2-AVATGS2)- STOP ASSEMBLY 03472990 + SPACE 1 03473000 +AJOMACRO EQU B'00000001' (AJOASMFM,AVMTAGSM)=> MACROS(F) OK 03473500 +AJOMACRG EQU B'00000010' (AJOASMFM,AVMTAGSM)=> ASM G MACROS 03473510 +AJOMACRH EQU B'00000100' (AJOASMFM,AVMTAGSM)=> ASM H MACROS 03473520 +AJOMACRV EQU B'00001000' (AJOASMFM,AVTAGSM)=> OS/VS ASM 03473530 + SPACE 1 03473540 +AJOLIBMC EQU B'10000000' (AJOASMFM,AVMTAGSM)=>PRT LIB MACROS 03473550 +AJOSUPER EQU B'00000010' (AJOEXEF)==> INIT USER IN SUPERVISOR 03474000 +AJONALGN EQU B'00000100' (AJOEXEF-ECFLAG4)==>NO ALIGNMENT 0C6 03474500 + SPACE 1 03476000 +AJIOPEN EQU B'00000001' (AJIO-SO-RE-PR-PN)==> DCB OPEN 03478000 +AJIOEOF EQU B'00000010' (AJIO-SO-RE)==> END-FILE ENCOUNTERED 03480000 +AJIODEOF EQU B'00000100' DISK END-OF-FILE FLAG 03480250 +AJIOSYND EQU B'00010000' DISK SYNAD ERROR FLAG 03480750 +AJIOSOHS EQU B'00010000' (AJIOSO)- OUTPUT BUFFER FLUSH J 03480900 +AJIOPSEO EQU B'00000100' (AJIO-SO-RE)=> PSEUDO ENDFILE(JCL) 03481000 +AJIOPAGE EQU B'01000000' (AJIOPR)- PAGE CONTROL MODE ON 03481700 +AJIOSORR EQU B'01000000' (AJIOSO)- REREAD LAST CARD READ J 03481730 +AJIODKNO EQU B'10000000' DISK DCB COULD NOT BE OPENED 03481750 +AJIOKP26 EQU B'10000000' (AJIOSO) - KP=26 -TRANSLATE TO 029 03481800 +AJIOSING EQU B'10000000' (AJIOPR)-SINGLE SPACE CARRIAGE CONT 03481900 +* EXCEPT NEW PAGE==> DOUBLESPACE 03481910 +AJIODFLT EQU B'10000000' (AJIO-RE,PN)==> USING SO OR PR DEFLT 03482000 + SPACE 1 03482010 +AJOOBJIN EQU B'00000001' (AJODECKF) - OBJECT INPUT DECK 03482020 + SPACE 1 03486000 +AJOZEROS DC 16F'0' FOR USE IN ZEROING THINGS 03488000 +AJ1000 DS F'1000' FOR CONVERSIONS 03489000 +AJ2604 DC F'2604' FOR USE IN TIME CONVERSIONS 03490000 +AJ100000 DC F'100000' FOR USE IN TIME CONVERSIONS 03492000 +AJ100M DC F'100000000' FOR USE IN SECS==>TIMER UNITS 03494000 +AJOVWXPT DS V(VWXTABL) @ MAIN ASSEMBLER TABLE 03495000 +AJOEXECU DS V(EXECUT) ADCON FOR INTERPRETER CODE 03495500 + DS 0D 03496000 + AIF (NOT &$KP26).AJNKP26 SKIP IF NO KP=26 OPT ALLWS 03496100 +AJTRTB26 DS XL256 026-->029 KEYPUNCH TRANSLATE TABLE 03496200 +.AJNKP26 ANOP 03496300 +AJOBLANK DC CL136' ' FOR GENERAL SUPERVISOR BLANKING 03498000 +AJOPARMA DS C FOR CARRIAGE CONTROL 03500000 +AJOP$L EQU 100 MAXIMUM LENGTH OF PARM FIELD 03502000 +AJOPNDFT DS 0CL88 CARD IMAGE HERE IF NOPUNCH USED. 03503000 +AJOPARM DS CL(AJOP$L+2) SPACE FOR PARM,2 TRAILING BLANKS 03504000 +AJOCP$L EQU 5 MAX # CHARACTERS IN EACH PARM 03506000 + DS 0D MAKE AJOCOMP PART OF AJODWORK 03507000 +AJOCOMP DS 0CL(AJOCP$L) SPACE FOR COMPARE DURING PARM SCAN 03508000 + SPACE 1 03510000 +AJODWORK DS D GENERAL DOUBLEWORD WORKAREA 03512000 +AJOPADL DS A PERMANENT LOW @ WORKAREA 03514000 +AJOPADH DS A PERMANENT HIGH @ WORKAREA 03516000 +AJOTADL DS A TEMPORARY LOW @ WORKAREA 03518000 +AJOTADH DS A TEMPORARY HIGH @ WORKAREA 03520000 +AJOECOPT DS A @ ECONTROL, EXECUTION CONTROL BLK 03521000 + SPACE 1 03522000 +AJO$APC EQU * BASE @ FOR OFFSETS TO PARM VARIABLES 03523000 +AJOZER1 EQU * PLACE TO BEGIN ZEROING ON INIT 03524000 + AIF (&$REPL EQ 0).AJNREPL SKIP GEN IF NO REPL 03525000 +AJORFLAF DS 0F,H DUMMY RFLAG INTO FULLWORD-MAKES 03525400 +* CODE IN APARMS CSECT EASIER 03525450 +AJORFLAG DS H REPLACE FLAG FROM RFLAG= 03525500 +.AJNREPL ANOP 03527000 + AIF (NOT &$PAGE).AJNPAGE SKIP IF NO PAGE CONTROL 03527050 +AJOL DS F LINES/PAGE FROM PARM FIELDS 03527100 +AJOP DS F TOTAL PAGES FROM PARM FIELDS 03527150 +AJOPX DS F PAGES FOR EXECUTION TIME,PARM FIELD 03527200 +AJOPD DS F PAGES FOR DUMP IF RECORDS EXCEEDED 03527250 +* AJOLREM-AJOPREM MUST BE IN ORDER GIVEN TOGETHER 03527300 +AJOLREM DS F LINES REMAINING IN PAGE AT ANY TIME 03527350 +AJOPREM DS F PAGES REMAINING AT ANY TIME 03527400 +* FOLLOWING VARIABLES MAY BE SET WITH AJIOSING FLAG TO 03527450 +* SHOW SINGLE SPACE CRUNCHING DURING NOTED PROG PHASE. 03527500 +* SINGLE SPACE ACTION TAKEN ONLY IF PAGE CONTROL OPT USED 03527550 +AJIOSS DS B SET==> SINGLE SPACE DURING ASSEMBLY 03527600 +AJIOSSD DS B SET==> SINGLE SPACE DURING DUMP 03527650 +AJIOSSX DS B SET==> SINGLE SPACE DURING EXECUT 03527700 +.AJNPAGE ANOP 03527750 +AJORD DS F # RECORDS MINIMUM ALLLOWED FOR DUMP 03527800 +AJORX DS F RECORDS FOR EXECUTION TIME 03527850 +AJOTD DS F MINIMUM TIME SAVED FOR DUMP 03527900 +AJOTX DS F TIME(SECS) FOR EECUTION TIME 03527950 +AJOTIML DS F TIME LIMIT FOR JOB, FROM T= 03528000 +AJORECNT DS F # RECORDS REMAINING(DECREMENTED) 03530000 +AJORECL DS F RECORD LIMIT, FROM R= 03532000 +AJOINSL DS F # EXECUTED INST LJMIT, FROM I= 03534000 +AJONERRF DS 0F,H DUMMY AJONERR INTO FULLWORD. 03535900 +* SIMPLIFIES CODE IN APARMS 03535950 +* **NOTE** SECTION FROM AJONERR - AJOAVL MUST CORRESPOND * 03535980 +* EXACTLY TO SECTION AVNERR - AVAJL, INC ALIGNMENT. * 03535981 +* THIS SECTION MOVED TO CORRESPONDING SECTION IN AVWXTABL. * 03535982 +AJONERR DS H MAXIMUM # ERRORS TO STILL OK EXECUT 03536000 + SPACE 1 03538000 + AIF (NOT &$MACROS).AJNMACX SKIP IF NO MACROS 03538020 +* MACRO OPTIONS AND FLAG BYTES. 03538040 +AJOMAC01 DS 0F START OF MACRO PARAMETER OPTIONS 03538060 +AJOMACTR DS F INITIAL ACTR VALUE FOR MACROS/MAIN 03538080 +AJOMNEST DS F MAXIMUM NEST LEVEL FOR MACROS 03538100 +AJOMSTMG DS F GLOBAL LIMIT: MACRO STMTS PROCESSED 03538120 +AJOASMFM DS B MACRO FLAGS (SETS AVTAGSM) 03538140 +.AJNMACX ANOP 03540000 +AJOASMF0 DS B ASSEMBLER FLAG **FUTURE USE********* 03542000 +AJOASMF DS C FLAG BYTE FOR ASSEMBLER SECTION 03544000 +AJOASMF2 DS B 2ND BYTE OF FLAG BITS(FUTR USE) 03545000 + AIF (NOT &$XREF).NOXREF3 A 03545010 +* CROSS REFERENCE FLAG BYTE A 03545015 +AJOXREF DS C FLAG FOR XREF FACILITY A 03545020 +.NOXREF3 ANOP A 03545025 +AJOAVL EQU *-AJONERR LENGTH OF SECTION MOVED TO AVWXTABL 03545100 + SPACE 2 03545200 +AJOMODE DS B MODE FLAG, MISC FLAGS. 03545300 +AJOSTEP DS B FLAG SHOWING CURRENT STEP 03545400 +* EXECUTION CONTROL FLAGS, MUST BE IN GIVEN ORDER. SECTION 03545500 +* AJOEC - AJOECL MUST CORRESPOND WITH ECAJ - ECAJL. * 03545600 +AJOEC DS 0F BEGIN AREA -- ALIGNMENT 03545700 +AJOIECF DS F IECF= (ONLY NEEDED FOR &$EXINT=1) 03546000 +AJODMPF DS B DUMP FLAGS (SETS ECFLAG3) 03547000 +AJOEXEF DS B GENRAL EXECUTION MODE FLAGS(ECFLAG4) 03547500 +AJOEXEFA DS B EXECUTION FLAGS (ECFLAG5) **FUTURE** 03547800 +AJOECL EQU *-AJOEC LENGTH OF FLAG BYTES 03548000 + SPACE 1 03548010 +AJOAPMOD DS B FLAG BYTE FOR RUNNING MODE OF APARMS 03548100 +AJOAPSET DS B SET BYTE - OR'D BY APARMS WHEN IT 03548200 +* SETS APCFLAG TO SHOW VALUE SET. SEE APCSET,SETLD,SETU 03548300 + SPACE 1 03550000 +AJIOFLAG DS 0BL4 AREA OF FLAGS FOR DCB'S 03552000 +AJIORE DS B FLAG BYTE FOR DATA READER(XXXXREAD) 03554000 +AJIOSO DS B FLAG BYTE FOR SOURCE RDR (XXXXSORC) 03556000 +AJIOPR DS B FLAG BYTE FOR PRINTER(XXXXPRNT) 03558000 +AJIOPN DS B FLAG BYTE FOR PUNCH (XXXXPNCH) 03560000 +AJIODSK DS B FLAG BYTE FOR RUNNING MODE DISKU 03560500 +AJIOWRKB DS B WORK BYTE FOR USE OF XXXXIOCO 03561000 + SPACE 1 03562000 +AJODEBUG DS B DEBUG FLAG BYTE 03564000 +AJODECKF DS B OBJECT DECK CONTROL FLAG 03565000 +AJOBTRQ DS C ASSIST SETS FOR XXXXSORC USE J 03565500 +AJOBTYP DS C XXXXSORC SETS FOR ASSIST J 03565600 +AJOTIMR DS F TEMPORARY TIME WORK AREA 03566000 +AJOFREE DS F MEMORY TO BE FREED TO OPERATING SYST 03567600 +AJOZER$L EQU *-AJOZER1 LENGTH OF AREA TO BE ZEROED 03568000 + DS 0D 03568010 +AJOJCLCD DS CL80 ASSIST JCL STORED HERE BY READ ROUTN 03568020 +AJOJCLPM EQU AJOJCLCD+15 LOCATION OF $JOB PARM FIELD 03568030 + AIF (NOT &$ACCT).AJONACC SKIP IF NO ACCT INFO 03568100 + SPACE 1 03568200 +* ACCOUNT # CHECKING DATA - FROM $TIRC (NAME,AJOACCT) 03568300 +AJOACCT DS CL5 ACCOUNT # 03568400 +AJOJOBNM DS CL8 JOB NAME 03568500 +AJOPRGNM DS CL20 PROGRAMMER'S NAME 03568600 +.AJONACC ANOP 03568700 +AJOB$L EQU *-AJOBCON GET LENGTH OF AJOBCON 03570000 + TITLE '*** ECONTROL DSECT - EXECUTION CONTROL BLOCK ***' 03572000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03572050 +*--> DSECT: ECONTROL EXECUTION CONTROL BLOCK * 03572100 +* THIS BLOCK CONTAINS ALL DATA REQUIRED TO DESCRIBE A USER * 03572200 +* PROGRAM TO BE EXECUTED BY THE ASSIST INTERPRETER (EXECUT). * 03572300 +* IT CONTAINS SIMULATED USER REGISTERS AND PROGRAM STATUS WORD,* 03572400 +* AN INSTRUCTION STACK, POINTERS TO THE USER PROGRAM CODE, * 03572500 +* AND VARIOUS FLAGS DESCRIBING THE RUNNING MODE AND OPTIONS * 03572600 +* ALLOWED TO THE USER PROGRAM. IT IS CREATED FROM INFORMATION * 03572700 +* FROM THE ASSEMBLER, THE USER PARM FIELD, AND FROM THE * 03572800 +* OPTIONS IN ASSIST, AND IS MODIFIED BY EXECUT. IT ALSO * 03572900 +* PROVIDES ALL DATA NEEDED BY XXXXSNAP TO DO A USER DUMP. * 03573000 +* LOCATION: IN HIGH END OF DYNAMIC CORE AREA. * 03573100 +* NAMES: EC------ * 03573200 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03573300 +ECONTROL DSECT 03574000 +EC$STACK EQU 10 MAX # OF INSTS KEPT IN STACK 03576000 + SPACE 1 03578000 +$ECCONT EQU X'80' (ECFLAG0)==>CONTINUE,DO NOT INIT 03580000 +$ECADSOK EQU X'40' (ECFLAG0)==>RELOCATION&LIMIT @'S OK 03582000 +$ECEOF EQU X'20' (ECFLAG0)==>EOF ON CARD READER 03584000 +$ECPROT EQU X'10' (ECFLAG0)==> ABSOLUTE PROTECT MODE 03586000 +* I.E. THIS FLAG MEANS FETCH PROTECT IN ADDITION TO STORE* 03588000 +$ECSPIEA EQU X'08' (ECFLAG0)==> EXECUT SPIE IN EFFECT 03590000 +$ECSPIEB EQU X'04' (ECFLAG0)==> REMOVE SPIE BEFORE EXIT 03592000 + SPACE 1 03594000 +$ECBROUT EQU 2 (ECFLAG1)==> BRANCH OUT OF RANGE 03596000 +$ECTIMEX EQU 4 (ECFLAG1)==> TIME COUNT EXCEEDED 03598000 +$ECREADR EQU 6 (ECFLAG1)==> ATTEMPT READ PAST EOF 03600000 +$ECRECEX EQU 8 (ECFLAG1)==> RECORDS EXCEEDED 03602000 +$ECABEND EQU 10 (ECFLAG1)==> USER REQUESTED ABEND 03604000 +$ECBRN14 EQU 12 (ECFLAG1)==> NORMAL RETURN (R14) 03604500 + SPACE 1 03605000 +$ECREGS EQU B'00000001' (ECFLAG3)==>PRINT REGS IN DUMP 03606000 +$ECDINST EQU B'00000010' (ECFLAG3)==>PRINT INST TRACE IN DUMP 03608000 +$ECSTORG EQU B'00000100' (ECFLAG3)==> PRINT USER STORAGE 03610000 +$EC$JRM EQU B'10000000' (ECFLAG3)==> SPECIAL JRM DEBUG 03610200 + SPACE 1 03612000 +$ECPRBST EQU X'01' (ECKYAMWP) ==> PROBLEM STATE PROG 03614000 + SPACE 1 03614100 +* REPLACE MONITOR FLAGS, SET BY RFLAG= AND XREPL INSTR. 03614200 +ECR$CARD EQU B'00000001' (ECRFLAG+1)PRINT CARDIMAGE 03614300 +ECR$REGA EQU B'00000010' (ECRFLAG+1)PRINT REGS BEFORE ENTRY 03614400 +ECR$REGB EQU B'00000100' (ECRFLAG+1)PRINT RESULTS FROM REAL P 03614500 +ECR$REGC EQU B'00001000' (ECRFLAG+1)PRINT RESULTS OF USER PRG 03614600 +ECR$REGD EQU B'00010000' (ECRFLAG+1) PRT IF USER CALLS 03614700 +ECR$ERRC EQU B'10000000' (ECRFLAG+1)=> ERROR FOUND IN REGS 03614800 + SPACE 1 03616000 +* FLOATING POINT REGISTER SAVE AREA * 03618000 +ECFPREGS DS 4D DUMMY FLOATING POINT REGS 03620000 +ECDWORK EQU ECFPREGS WE CAN USE FP REGS AS WORK AREA 03621000 + SPACE 1 03622000 +* SIMULATED GENERAL PURPOSE REGISTERS * 03624000 +ECREGS DS 16F FAKE REGISTERS FOR INTERPRETER 03626000 +ECREG1 EQU ECREGS+4 FAKE R1 03626100 +ECREGRA EQU ECREGS+4*RA FAKE RA 03626200 +ECREG12 EQU ECREGS+48 FAKE R12(RAT) 03626300 +ECREG13 EQU ECREGS+52 FAKE R13 03626400 +ECREG14 EQU ECREGS+56 FAKE R14, RETURN @ REG 03626500 +ECREG15 EQU ECREGS+60 FAKE R15, ENTRY PT REG 03626600 + DS F DUMMY REG, SIMPLIFIES SINGLE SHIFTS 03628000 +* NECESSARY TO USE CURRENT CODE FOR SLL 15,1, FOR EXAMPLE 03630000 +ECR14SAV DS A ORIGINAL RETURN @ FOR COMPARISON 03631000 +ECZER1 EQU * BEGINNING FOR BLOCK ZEROING 03632000 + SPACE 1 03634000 +* SIMULATED PROGRAM STATUS WORD * 03636000 +ECPSW DS 0D PSW FOR PROG 03638000 +ECSYSMSK DS C SYSTEM MASK 03640000 +ECKYAMWP DS C PROT KEY, AMWP FIELD 03642000 +ECINTCOD DS H INTERRRUPT CODE 03644000 +ECILCMSK DS C ILC-CC-PROGRAM MASK 03646000 +ECPSWIAD DS CL3 INSTRUCTION ADDRESS 03648000 + SPACE 1 03650000 +* CONTROL FLAGS * 03652000 +ECFLAGS DS 0F A FULLWORD FOR FLAGS 03654000 +ECFLAG0 DS C MAJOR CONTROL BITS 03656000 +ECFLAG1 DS C USED TO RETURN SPECIAL ERROR CODES 03658000 +ECFLAG2 DS C CONTROLS DEBUG MODE SNAPS 03660000 +ECAJ DS 0F BEGIN AJOBCON FLAGS, ALIGN 03660400 +ECOIECF DS F ORIGINAL IECF (&$EXINT ONLY) 03660500 +ECFLAG3 DS B DUMP CONTROL FLAG (AJODMPF) 03660800 +ECFLAG4 DS B MISC. EXEC FLAGS (AJOEXEC) 03661200 +ECFLAG5 DS B MISC EXEC FLAGS (AJOEXEFA)*FUTURE*** 03661600 +ECAJL EQU *-ECAJ LENGTH OF FLAGS GROUP MUST = AJECL 03662000 +ECRFLAG DS H REPLACE MONITOR FLAG 03662500 + SPACE 1 03664000 +ECERRAD DS A @ SPECIAL ASSIST COMPLETION MESSAGE 03666000 +ECSVCADS DS A @ ADDRESS LIST OF SVC'S,=0 IF NONE 03668000 +ECZER$L EQU *-ECZER1 LENGTH OF AREA FOR BLOCK ZEROING 03670000 +ECFADHC DS A HIGH @ PROG + SAVE = ECFADH-256 03672000 +* ECILIMT-ECILIMP MUST BE IN ORDER GIVEN, USED IN LM * 03674000 +ECILIMT DS F INST COUNT LIMIT (DECREMENTED) 03676000 +ECILIMP DS F PERMANENT INSTRUCTION COUNT LIMIT 03678000 + SPACE 1 03680000 +* ECRDLIML-ECRDLIMH GIVE DUMP LIMTS. MUST BE IN GIVEN ORDR 03680100 +ECRDLIML DS A REAL DUMP LIMIT LOW(INIT=ECRADL) 03680200 +ECRDLIMH DS A REAL DUMP LIMIT HIH(INIT=ECRADH) 03680300 + SPACE 1 03680400 +* ADDRESS VALUES DESCRIBING LIMITS OF USER PROGRAM. * 03682000 +* **NOTE** THEY MUST BE IN THE ORDER GIVEN BELOW. * 03684000 +ECRADL DS F REAL LOWEST ADDRESS OF PROGRAM 03686000 +ECRADH DS F REAL HIGHEST ADDRESS 03688000 +ECRELOC DS F RELOCATION CONTINUALLY APPLIED 03690000 +ECFENTER DS A USER PROGRAM FAKE ENTRY POINT @ 03692000 +ECFADL DS F FAKE LOWEST ADDRESS OF PROGRAM 03694000 +ECFADH DS F FAKE HIGHEST ADDRESS OF PROGRAM 03696000 + SPACE 1 03698000 +ECINSTAC DS (EC$STACK)CL16 INSTRUCTION STACK 03700000 +ECRSTK DS F SAVE WORD FOR RSTK POINTER 03702000 +ECSAVE1 DS A @ FAKE SAVE AREA FOR USER PROG 03704000 +ECPICA DS F SAVE WORD FOR PREVIOUS PICA 03706000 +ECTSAVE DS 16F FOR SAVING REGS WHEN DOING CALLS 03708000 + AIF (NOT &$EXINT).ECOVER 03710000 + SPACE 2 03710010 +EC$BRSTC EQU 10 SIZE OF BRANCH STACK (# OF SLOTS) 03710015 +ECBRSTAC DS (EC$BRSTC)CL16 BRANCH STACK 03710020 +ECBSTK DS F SAVE WORD FOR BSTK POINTER 03710025 +ECBCUR DS F CURRENT STACK PTR SAVED HERE 03710030 + AIF (&$EXINT EQ 0).ECNOEXT SKIP IF NO EXTENDED INTERPRETER 03710032 + SPACE 5 03710035 +* * * * * * * * * * * * * * ##### EXTENSION ##### * * * * * * * * * * * 03710040 +* * 03710045 +* IMPORTANT--> THIS SECTION IS AN EXTENSION TO THE * 03710050 +* ECONTROL DSECT AND IS USED BY THE OPTIONAL ASSIST * 03710055 +* INTERPRETER. IT CONTAINS FLAGS, EQUATES, AND * 03710060 +* ADDRESSES FOR USER INTERRUPT HANDLING AND OTHER * 03710065 +* USER OPTIONS. SEE PSEUDO-INSTRUCTION XOPC. * 03710070 +* * 03710075 +* NOTE: DATA IN THIS AREA IS ACCESSABLE TO THE USER * 03710080 +* PROGRAMMER BY MEANS OF VARIOUS XOPC INSTRUCTION * 03710085 +* CODES, AND IN GENERAL BY XOPC 12 & 13. * 03710090 +* * 03710095 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03710100 + SPACE 2 03710105 +ECPRCB EQU * 03710110 +* FLAGS USED BY THE OPTIONAL INTERPRETER 03710115 +* 03710120 +* FLAGS FOR OPTIONS-IN-EFFECT CHECKING 03710125 +* NOTE: ECPRCBF1 WILL NOT BE USED FOR ANY OTHER 03710130 +* FLAG TYPES. 03710135 +ECPRTRCE EQU B'00000001' (ECPRFLG1)==> TRACE = ON 03710140 +ECPRMODC EQU B'00001000' (ECPRFLG1)==> MODIFICATION CHECKING X03710155 + = ON 03710160 +ECPRIECF EQU B'00000010' (ECPRFLG1)==> COUNT FACILITY ON 03710161 +ECPRCTON EQU B'00000100' (ECPRFLG1)==> HAS COUNT ON BEFORE? 03710162 +ECPRCTOF EQU B'00000000' (ECPRFLG1)==> COUNT FACILITY OFF 03710163 +ECPRNOSP EQU B'00001000' (ECPRFLG1)==> NO SPACE FOR COUNT FAC 03710164 +* 03710165 +* FLAGS FOR MACHINE EMULATION (ECPRCBF2 LOW ORDER NIBBLE) 03710170 +* AND OTHER DATA. 03710175 +* 03710180 +* NOTE: THE FLAGS FOR MACHINE EMULATION CAN BE CHANGED 03710185 +* DYNAMICALLY BY THE USER PROGRAMMER BY WAY OF THE XOPC 03710190 +* INSTRUCTION. THIS ALLOWS RUN-TIME CONTROL OF EMULATION 03710195 +* OPTIONS, SINCE THESE FLAGS ARE CHECKED BEFORE THE 03710200 +* INTERPRETATION OF EACH USER INSTRUCTION. IF THE USER 03710205 +* PROGRAM SCREWS UP THESE FLAGS, IT MAY BE 03710210 +* TERMINATED 'CONFUSINGLY' WITH AN OC-1 ON A VALID 03710215 +* INSTRUCTION. 03710220 +ECEM360 EQU B'00000100' (ECPRFLG2)==> MACHINE = 360 03710225 +ECEM370 EQU B'00001000' (ECPRFLG2)==> MACHINE = 370 03710230 +ECSUPRST EQU B'01000000' (ECPRFLG2)==> IN SUPERVISOR STATE 03710235 +ECALNCHK EQU B'10000000' (ECPRFLG2)==> ALIGNMENT CHECKING=ON 03710240 +ECSPISET EQU B'10000000' (ECPRFLG3)==> A PSEUDO SPIE IS SET 03710241 +ECINHDST EQU B'01000000' (ECPRFLG3)==> INTERRUPT HANDLING ST 03710242 +ECNOSPI EQU B'00000000' (ECPRFLG3)==> NO SPIE INTERRUPT SET 03710243 +ECLKADR EQU B'00000001' (ECPRFLG4)==> CLOCK EXIT ADDR SET 03710244 +* PRCB STORAGE BEGINS HERE 03710245 +ECPRFLG1 DS B 03710250 +ECPRFLG2 DS B 03710255 +ECPRFLG3 DS B 03710260 +ECPRFLG4 DS B 03710265 +ECPRFLG5 DS B 03710270 +ECPRFLG6 DS B 03710275 +ECPRFLG7 DS B 03710280 +ECPRFLG8 DS B 03710285 +* INSTRUCTION TRACE AND MONITOR ADDRESSES 03710290 +* ***** NOTE: DO NOT CHANGE THE ORDER OF THESE SOURCE 03710295 +* RECORDS 03710300 +ECPRTRAL DS A BEGINNING (LOW) @ OF TRACE M 03710305 +ECPRTRAH DS A ENDING (HIGH) @ OF TRACE M 03710310 +ECPRMODL DS A BEGINNING (LOW) @ OF CHECK FACILITY 03710315 +ECPRMODH DS A ENDING (HIGH) @ OF CHECK FACILITY 03710320 +* INSTRUCTION COUNTER (PSEUDO-CLOCK) INFORMATION 03710325 +ECPRCLOK DS F CLOCK (DECMTD BY 1 FOR EACH INSTR) 03710330 +ECPRCMPR DS F COMPARATOR (CHECKED AGAINST CLOCK X03710335 + FOR INTERRUPT TEST) 03710340 +ECPRCLEA DS A USER SPECIFIED CLOCK EXIT ADDRESS 03710345 +* EXIT ADDRESS FOR USER SPECIFIED PSUEDO-SPIE HANDLING 03710350 +* (IF NOT SPECIFIED, THIS ADDRESS WILL BE ZERO.) 03710355 +ECPRSCDE DS F USER SPECIFIED SPIE CODE MASK 03710360 +ECPRSPIE DS A EXIT ADDRESS FOR PSUEDO-SPIE XOPC 0 03710365 +* 2 WORD SAVE AREA FOR INTERRUPT (REGS 0 - 1) 03710370 +ECPRIRGS DS 2F DEFINE 2 WORD SAVE AREA 03710375 +* STORAGE FOR IECF (BY ADDRESS) INFORMATION 03710380 +ECPRICA DS A BEGIN @ OF IECF (BY ADDR) COUNTERS 03710385 +ECPRICAL DS F LENGTH OF COUNTING AREA 03710390 +ECPRICL DS A IECF LOW @ COMPARATOR (BEGINNING) M 03710395 +ECPRICH DS A IECF HIGH @ COMPARATOR (ENDING) M 03710400 +* MISCELLANEOUS EQUATES FOR THE OPTIONAL INTERPRETER 03710405 +EISSINST EQU B'11000000' IDENTIFIES SS INSTRUCTIONS 03710410 +ECPROPON EQU ECPRTRCE+ECPRIECF 03710415 +EC#XOPC EQU 22 # OF THE MAX LEGAL XOPC CODE 03710420 +ECREG0 EQU ECREGS FAKE REG 0 03710425 +ECREG2 EQU ECREGS+8 FAKE REG 2 03710430 + SPACE 1 03710435 +ECPRWORK DS 8F WORK AREA FOR FUTURE GENERAL USE 03710440 + SPACE 1 03710445 +ECPRCB$L EQU *-ECPRCB LENGTH OF PRCB 03710450 +.ECNOEXT ANOP 03710460 +.ECOVER ANOP 03711900 + DS 0D 03711950 +EC$LEN EQU *-ECONTROL LENGTH OF ECONTROL DSECT 03712000 + TITLE '*** ECSTACKD DSECT - ECONTROL INSTRUCTION STACK ***' 03712100 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03712150 +*--> DSECT: ECSTACKD SINGLE ENTRY IN ECONTROL INSTRUCTION STACK * 03712200 +* THE ECONTROL INSTRUCTION STACK IS A CIRCULAR LINKED LIST * 03712300 +* WHICH ALWAYS CONTAINS DATA ON UP TO THE LAST 10 INSTRUCTIONS * 03712400 +* INTERPRETED DURING EXECUTION. IT IS FILLED IN BY EXECUT, AND* 03712500 +* IS USED BY XXXXSNAP TO PROVIDE THE INSTRUCTION TRACE PART * 03712600 +* OF A USER COMPLETION DUMP. * 03712700 +* LOCATION: INSIDE AREA ECINSTAC IN DSECT ECONTROL. * 03712800 +* NAMES: EC------ (SAME AS ECONTROL NAME CHARACTERS) * 03712900 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03714000 + SPACE 1 03716000 +ECSTACKD DSECT 03718000 +ECSTENT DS 0CL16 INST STACK ENTRY 03720000 +ECSTLINK DS F ADDRESS OF NEXT STACK ENTRY 03722000 +ECSTIADD DS F INSTRUCTION ADDRESS 03724000 +ECSTCCPM DS H CON-CODE & PROGRAM MASK 03726000 + SPACE 1 03727000 +ECSTINST DS 0CL6 UP TO 6 BYTES OF INSTRUCTION 03728000 +ECOP DS C OPCODE 03730000 +ECM1R2 DS 0C M1,R2 FIELD FOR BC'S 03732000 +ECR1R2 DS 0C R1,R2 FIELD FOR RR INSTRUCTIONS 03734000 +ECR1X2 DS 0C FIELD FOR RX INSTRUCTIONS 03736000 +ECR1R3 DS 0C FIELD FOR RS INSTRUCTIONS 03738000 +ECR1M3 DS 0C FIELD FOR RS INSTRUCTIONS 03739000 +ECI2 DS 0C FIELD FOR SI INSTRUCTIONS 03740000 +ECL1I3 DS 0C FIELD FOR SRP INSTRUCTION 03741000 +ECOPEX DS 0C 2ND BYTE OF EXTENDED OP CODE 03741500 +ECL1L2 DS C FIELD FOR ALL SS INSTRUCTIONS 03742000 +ECBD DS H 1ST OR ONLY BASE-DISPLACEMENT FIELD 03744000 +ECB2D2 DS H 2ND BASE-DISP(SS & SPECIALS ONLY) 03746000 + TITLE '*** ASSIST - MAIN CONTROL - OVERALL ***' 03750000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03750500 +*--> CSECT: ASSIST MONITOR CONTROL PROGRAM FOR THE ASSIST SYSTEM * 03751000 +* ENTRY CONDITIONS * 03751200 +* R1= @ POINTER TO OS LENGTH/PARM FIELD AREA. * 03751400 +* CALLS AOBJIN,AODECK,APARMS,EXECUT,MPCON0,REENDA,REINTA * 03751590 +* CALLS XXXXFINI,XXXXINIT * 03751600 +* USES DSECTS: AJOBCON,AVWXTABL,ECONTROL * 03751800 +* USES MACROS: $DBG,$PRNT,$RETURN,$SAVE,$SORC,$TIRC * 03751900 +* USES MACROS: ASPAGE,ASPRNT,ASRECL,ASTIME,ASTIMR * 03751910 +* USES MACROS: FREEMAIN,GETMAIN,STIMER,TTIMER,XCALL,XSNAP,WTL * 03751920 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03751990 +ASSIST CSECT 03752000 +* * * * * * * * REGISTER USAGE IN ASSIST MAIN PROGRAM * * * * * * * * * 03752100 +* R0,R1,R15 USUALLY LOCAL WORK REGISTERS. PARAMETER REGS FOR SOME. * 03752200 +* R9 = INTERNAL LINK REGISTER FOR TIME/RECORDS/PAGES CONTROL . * 03752300 +* R10= ADDRESS OF EXECUTION CONTROL BLOCK ECONTROL (PART OF TIME). * 03752400 +* R11= ADDRESS OF JOB CONTROL TABLE AJOBCON(ALWAYS). * 03752500 +* R12= ADDRESS OF ASSEMBLER CONTROL TABLE AVWXTABL(PART OF TIME). * 03752600 +* R13= SAVE AREA PTR AND BASE REGISTER ALSO. * 03752700 +* R14= EXTERNAL LINK REGISTER. INTERNAL LINK REGISTER FOR LOWEST * 03752800 +* LEVEL INTERNAL SUBROUTINES. * 03752900 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03753000 + $DBG ,NO NO DEBUG,SINCE NO AVWXTABL 03754000 + AIF (&$ASMLVL).ASXSAVE SKIP FOR OS $SAVE 03754100 + BALR R15,0 SET UP TEMPORARY ADDRESSABILITY(DOS) 03754200 + USING *,R15 INFORM ASSEMBLER OF R15 USING 03754300 + CNOP 0,4 FULLWORD ALIGNMENT FOR FUTURE SAVE 03754400 + BAL R13,ASSAVE+72 BR AROUND SAVE,SET R13 = @ SAVEAREA 03754500 + USING *,R13 SHOW R13 AS ASSIST BASE REGISTER 03754600 + DROP R15 KILL USING 03754700 +ASSAVE DC 18F'0' SAVEAREA FOR CSECT ASSIST 03754800 +.ASXSAVE AIF (NOT &$ASMLVL).ASNXSAV SKIP IF UNDER DOS GENERATION 03754900 + $SAVE RGS=(R14-R12),BR=R13,SA=ASSAVE 03756000 +.ASNXSAV ANOP 03756100 + MVC ASPARMSV,0(R1) MOVE @ LENGTH/PARM FIELD OVER 03758000 + ASTIMR 00,2 INITIALIZE TIMER IF &$TIMER=2 03763000 + XCALL XXXXSPIN INITIALIZE PROGRAM INTERRUPT CODE 03763300 + LA R11,ASJOBCON GET @ FOR AJOBCON 03764000 + USING AJOBCON,R11 NOTE MAIN TABLE USING 03766000 + EJECT 03834000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03836000 +* INITIALIZE AJOBCON. CALL XXXXINIT TO INITIALIZE * 03838000 +* INPUT/OUTPUT PROCESSORS. (I.E. DO OPENS, SET FLAGS. ) * 03840000 +* MAKE SURE BOTH LINE PRINTER (PR) AND SOURCE CARD READER (SO) * 03842000 +* OPENED SUCCESSFULLY. QUIT IMMEDIATELY IF THEY DIDN'T. * 03844000 +* CALL APARMS TO ANALYZE PARM FIELD IF ANY,SET FLAGS IN AJOBCON* 03846000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03848000 + SPACE 1 03850000 +ASJINIT EQU * SECTION TO INIT AJOBCON 03852000 + XC AJOZER1(AJOZER$L),AJOZER1 ZERO OUT WHOLE SECTION 03854000 + SPACE 1 03854100 +ASJOBINT EQU * ENTRY FOR BEGINNING OF NEW $JOB 03854180 +* CALL PARM FIELD ANALYSIS ROUTINE TO SET FLAGS. * 03854200 +ASJPARMS EQU * 03854300 +* ***** LIMIT PARMS & RESETABLE DEFAULTS ***** 03854400 + LA R9,ASPARLIM SHOW @ PARM FIELD 03854410 + LA R10,ASPARL$L SHOW LENGTH OF PARM FIELD 03854420 + MVI AJOAPMOD,AJOAPRSE SHOW THIS IS RESET CALL 03854430 + MVI AJOAPSET,APCSETLD SHOW LIMIT/DEFAULT CALL TYPE 03854435 + XCALL APARMS CALL PARM FIELD SCANNER 03854440 + AIF (NOT &$ASMLVL).ASPARMC NO // EXEC PARM FIELD 03854445 + SPACE 1 03854450 +* ***** REAL PARM FIELD ANALYSIS ***** 03854490 + L R9,ASPARMSV GET PTR TO LENGTH-PARM FOR APARMS 03854500 + LH R10,0(R9) GET LENGTH OF THE REAL PARM 03854520 + LA R9,2(R9) GET @ ACTUAL PARM FIELD 03854540 + MVI AJOAPMOD,AJOAPMOV SHOW PARM SHOULD BE MOVED OVER 03854560 + MVI AJOAPSET,APCSETP SHOW THIS IS THE REAL PARM FIELD NOW 03854580 + XCALL APARMS CALL SCANNER PROGRAM 03854600 +.ASPARMC ANOP 03854620 + SPACE 1 03854700 + TM AJOSTEP,AJOMSINT HAVE GONE THRU 1-TIME INIT ALREADY 03854710 + BO ASNOT1T YES, SO DON'T DO IT AGAIN. 03854720 + SPACE 1 03854730 +* ***** ONE-TIME-PER-BATCH INITIALIZATION ***** 03854740 + BAL R14,ASMSINIT MAIN STORAGE INITIALIZATION 03854750 + TM AJOMODE,AJNSYSIN WAS NOSYSIN SPECIFIED 03854800 + BO ASZERR2 NOSYSIN, SO QUIT NOW. NO SOURCE CRDS 03854900 + SPACE 1 03855000 +* HAVE DCB'S OPEND FOR PRINTER, SOURCE RDR. CHECK FOR OK. 03855800 + XCALL XXXXINIT CALL I/O INITIALIZER 03856000 + TM AJIOPR,AJIOPEN DID PRINTER OPEN RIGHT 03858000 + BZ ASZERR1 NO,GO DO MESSAGE AND QUIT 03860000 + TM AJIOSO,AJIOPEN DID SOURCE CARD RDR OPEN RIGHT 03862000 + BZ ASZERR2 NO, BRANCH AND QUIT IMMEDIATELY 03864000 +ASNOT1T EQU * ENTER FOR EVERY-TIME PROCESSING 03866000 + TM AJOMODE,AJOBATCH WAS THIS BATCH RUN 03866050 + BZ ASPARFIN NO, SKIP TO PUT IN FINAL DEFAULTS 03866100 + AIF (NOT &$DATARD).ASNRDX SKIP IF NO DATA RDR EXISTS 03866150 + OI AJIORE,AJIODFLT SINCE BATCH, MAKE SURE NO DATA RDR 03866200 +.ASNRDX ANOP 03866250 + SPACE 1 03866300 +* ***** BATCH MODE - GET $JOB CARD AND ITS PARMS ***** 03866350 + AIF (NOT &$MACSLB).ASSNOMC 03866360 + XCALL XXXXLBED MAKE SURE THAT XXXXSORC GETS CARD RIGHT 03866370 +.ASSNOMC ANOP 03866380 + MVI AJOBTRQ,AJO$J SHOW THAT $JOB CARD IS DESIRED J 03866400 + BAL R14,ASFLUSH GO GET IT; RETURN ONLY IF FOUND J 03866500 +* ***** $JOB CARD OR EQUIV FOUND. PROCESS PARM. 03866550 + MVI AJOAPMOD,AJOAPMOV SHOW PARM SHOULD BE MOVED OVER 03866600 + MVI AJOAPSET,APCSETU SHOW USER SETTING THIS TIME 03866650 + LA R9,AJOJCLPM SHOW @ PARM FIELD ON $JOB CARD 03866700 + LA R10,80-(AJOJCLPM-AJOJCLCD) LENGTH OF PARM FIELD(MAX) 03866750 + XCALL APARMS CALL PARM ANALYSIS ROUTINE 03866800 + MVC AJOPARM(80),AJOJCLCD MOVE WHOLE JCL CARD IN INST 03866850 + SPACE 1 03866900 +* ***** DEFAULT PARM FIELDS - DON'T OVERRRIDE SET ***** 03866950 +ASPARFIN EQU * SKIP HERE IF NOBATCH 03867000 + MVI AJOAPMOD,AJOAPDEF+AJOAPFIN DEFAULT CALL, ALSO LAST 1 03867050 + MVI AJOAPSET,APCSETLD SHOW LIMIT/DEFAULT TYPE SETTING 03867100 + LA R9,ASPARDF SHOW DEFAULT PARMS 03867150 + LA R10,ASPARD$L SHOW LENGTH OF DEFAULT PARM LIST 03867200 + XCALL APARMS MAKE FINAL CALL TO PARM ROUTINE 03867250 + EJECT 03880000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03882000 +* TIME,RECORDS,PAGES INITIALIZATION FOR ASSEMBLY. * 03884000 +* PRINT ASSIST HEADER + 1 PARM FIELD. * 03885000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03886000 + SPACE 1 03888000 + ASRECL 04 CALL RECORD INIT CODE 03910000 + ASPAGE 04 CALL PAGE HANDLING, IF EXISTS 03912000 + ASTIMR 04,1 SET UP TIME/INST COUNT LIMITS 03914000 + SPACE 1 03938000 +* PRINT HEADER. PRINT REAL PARM OR $JOB PARM AREA 03940000 +ASPRHEAD EQU * ENTRY FOR MULTIPLE ASSEMBLYS/EXEC 03941000 + ASPRNT ASH1HD,ASH1H$L PRINT BEGINNING HEADER 03942000 + ASPRNT AJOPARMA,AJOP$L+1 PRINT THE PARM FIELD 03948000 + AIF (&$DEBUG).ASDA SKIP IF PRODUCTION 03952000 + XSNAP LABEL='AFTER TIME/RECORDS SET',IF=(AJODEBUG,O,8,TM), X03954000 + STORAGE=(*AJOPARMA,*AJOBCON+AJOB$L) 03956000 +.ASDA ANOP 03958000 + EJECT 03960000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03962000 +* SET UP ADDRESSES FOR CALL TO THE ASSIST ASSEMBLER. * 03964000 +* ALSO SET UP TIME,SO CAN DO TIMING FOR THE ASSEMBLER * 03966000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03968000 + SPACE 1 03970000 +ASASMCL EQU * SECTION TO CALL ASSEMBLER 03972000 + MVC AJOTADL(8),AJOPADL REINITIALIZE TEMP TO PERMANENTS 03974000 + SPACE 1 03976200 +ASASMCLR EQU * ENTRY LABEL FOR REPLACE PHAS B 03976400 + L RAT,AJOVWXPT INIT ADCON FOR ASSEMBLER TABLE 03976500 + USING AVWXTABL,RAT NOTR POINTER IN R12 03977000 + ST R11,AVAJOBPT INIT POINTER TO AJOBCON. 03977500 + MVC AVADDLOW(8),AJOTADL MOVE CURRENT CORE LIMITS OVER 03977600 + MVC AVNERR(AJOAVL),AJONERR GIVE FLAGS TO ASSEMBLER 03977700 + AIF (NOT &$OBJIN).ASNOBJ1 SKIP IF NO OBJECT DECK IN 03977705 + SPACE 1 03977710 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03977715 +* OBJECT DECK INPUT CODE * 03977720 +* IF PARM=OBJIN, CALL AOBJIN TO LOAD DECK, SKIPPING EXECUTION * 03977725 +* IF THERE IS NOT ENOUGH ROOM FOR IT. AOBJIN SETS UP VALUES * 03977730 +* IN AVWXTABL JUST AS THOUGH THERE HAD BEEN AN ASSEMBLY. * 03977735 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03977740 + TM AJODECKF,AJOOBJIN WAS THERE OBJECT DECK,INSTD OF SOURC 03977745 + BZ ASOBJINN NO, NO OBJECT DECK-SKIP TO ASSEMBLE 03977750 + AIF (&$REPL EQ 0).ASNRPX SKIP IF NO REPLACEMENT 03977755 + TM AJOMODE,AJOREPLF REPLACE RUN 03977760 + BO ASOBJINN YES, SO DON'T LET HIM READ DECK IN 03977765 +.ASNRPX ANOP 03977770 + XCALL AOBJIN CALL OBJECT INPUT ROUTINE 03977775 + TM AVTAGS1,AJNLOAD NOLOAD SET IF SOMETHING WRONG 03977780 + BO ASNOEXEC BAD DECK - SKIP EXECUTION 03977785 + B ASOBJINX OK, SKIP OVER ASSEMBLY AND CONTINUE 03977790 +ASOBJINN EQU * SKIP HERE IF NO OBJECT INPUT 03977795 +.ASNOBJ1 ANOP 03977800 + AIF (&$REPL EQ 0).ASNREP1 SKIP IF NO REPLACEMENT 03977810 +* IF REPLACEMENT POSSIBLE, CALL REINTA TO SET FLAGS,ADCONS 03977820 + XCALL REINTA CALL REPLACE PRE-ASSEMBLY INIT 03977830 +.ASNREP1 SPACE 1 03977840 + SPACE 1 03977850 +* FLAG ASSEMBLY, CALL ASSEMBLER, UNFLAG ASSEMBLY. 03977900 + OI AJOSTEP,AJOSASM SHOW WE'RE IN ASSEMBLER NOW 03978000 + XCALL MPCON0 CALL THE ASSEMBLER 03980000 + NI AJOSTEP,255-AJOSASM SHOW WE FINISHED ASSEMBLER 03982000 + SPACE 1 03986000 + ASTIMR 12,1 CALL FOR ASSEMBLY TIME,RATE PRINTING 03988000 + SPACE 1 03990000 + AIF (&$REPL EQ 0).ASNREP2 SKIP IF NO REPLACEMENT 03990100 +* IF REPLACEMENT POSSIBLE, CALL REENDA TO CHANGE ADCONS 03990200 + XCALL REENDA POST-ASSEMBLY PROCESSOR 03990300 +.ASNREP2 SPACE 1 03990400 + TM AVTAGS1,AJNLOAD WAS NO LOAD FLAG SET 03992000 + BO ASNOEXEC EITHER USER DIDN'T WANT, OR ERRS 03994000 +ASOBJINX EQU * EXIT HERE IF OBJECT INPUT 03994005 + AIF (NOT &$DECK).ASNDECK SKIP IF NO DECKS PUNCHED 03994010 + SPACE 1 03994015 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03994020 +* OBJECT DECK PUNCH CODE * 03994025 +* IF PARM=DECK, PUNCH THE CURRENT USER PROGRAM OUT, AS LONG * 03994030 +* AS IT WASN'T ONE JUST READ IN FOR PARM=OBJIN. * 03994035 +* ALSO, DON'T PUNCH IF IN REPLACE RUN. * 03994040 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03994045 + TM AJOASMF2,AJODECK DID USER WANT AN OBJECT DECK 03994050 + BZ ASDECKN NO, SKIP 03994055 + TM AJODECKF,AJOOBJIN DID HE JUST READ IT IN 03994060 + BO ASDECKN YES, IDIOT USER-DON'T PUNCH IT 03994065 + AIF (&$REPL EQ 0).ASNREDK SKIP IF NO REPLACEMENT 03994070 + TM AJOMODE,AJOREPLF ARE WE IN REPLACE RUN 03994075 + BO ASDECKN YES, DON'T ALLOW DECK PUNCHED 03994080 +.ASNREDK ANOP 03994085 + XCALL AODECK CALL TO PUNCH OBJECT DECK 03994090 +ASDECKN EQU * SKIP LABEL OVER OBJECT DECK PUNCH 03994095 +.ASNDECK ANOP 03994100 + SPACE 2 03994105 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03994200 +* PRE-EXECUTION CONTROL CARD CHECKING * 03994300 +* IF IN BATCH MODE, FLUSH CARDS UNTIL A $ENTRY CARD FOUND, * 03994400 +* AND POSSIBLY ALLOW EXECUTION, OR A $JOB CARD FOUND, IN * 03994500 +* WHICH CASE GO BACK FOR NEXT JOB. $STOP CARD FOUND WILL NOT * 03994600 +* RETURN HERE ANYWAY. NOTE THAT EXECUTION IN BATCH MODE * 03994700 +* CURRENTLY REQUIRES A $ENTRY CARD. * 03994800 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03994900 + SPACE 1 03995000 + TM AJOMODE,AJOBATCH ARE WE IN MIDDLE OF BATCH RUN 03995100 + BZ ASEXNBAT NO, NO BATCH, DON'T READ ANY CARDS 03995200 + SPACE 1 03995300 + AIF ('&$BTCC(3)' EQ '').ASBTCC1 SKIP IF NO $ENTRY NEEDED J 03995400 + MVI AJOBTRQ,AJO$E SHOW THAT $ENTRY IS WHAT WE WANT J 03995500 + BAL R14,ASFLUSH GO GET; IF RETURN, IT EXISTS J 03995600 + CLI AJOBTYP,AJO$E WAS IT ACTUALLY $ENTRY J 03995620 + BE ASEXNBAT YES, CONTINUE J 03995640 + OI AJIOSO,AJIOSORR $JOB- SET FOR REREAD, FINISH JOB J 03995660 + B ASNOEXEC GO TO END THIS JOB, PICK UP $JOB J 03995680 +.ASBTCC1 ANOP 03995700 +ASEXNBAT EQU * 03995800 + EJECT 04008000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04010000 +* PREPARE ADDRESSES AND ECONTROL BLOCK FOR EXECUTION * 04012000 +* OF USER PROGRAM BY EXECUT. SET UP ECONTROL APPROPRIATELY. * 04014000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04016000 + SPACE 1 04018000 +ASEXECAL EQU * 04019000 + LM R0,R5,AVRADL GET THE 6 @ WORDS FROM AVWXTABL 04020000 + LA R10,AVECONTR OVERLAP ECONTROL&UNNEEDED AV SECT 04021000 + DROP RAT REMOVE USING FOR TIME BEING 04022000 + AIF (&$REPL EQ 0).ASNRP1E SKIP IF NO REPLACE 04022050 + SPACE 1 04022100 +* IF IN REPLACE MODE A, THE ECONTROL BLOCK CANNOT BE 04022150 +* LOCATED IN MIDDLE OF AVWXTABL, SO ALLOCATE SPACE FOR 04022200 +* IT AT HIGH END OF DYNAMIC AREA INSTEAD. 04022250 + TM AJOMODE,AJOREPLF+AJOREPHB ARE WE IN REPL, OR PHASE B 04022300 + BNM ASREPLBM BRANCH-NOT PHASE A IN ANY CASE 04022350 + SPACE 1 04022400 + L R10,AJOTADH GET CURRENT HIGH POINTER 04022450 + SH R10,=AL2(EC$LEN) SPACE FOR ECONTROL 04022500 + ST R10,AJOTADH SAVE BACK, ALSO LEAVE IN R10 04022550 +ASREPLBM EQU * BRANCH HERE IF NOT REPL PHASE A 04022600 +.ASNRP1E SPACE 1 04022650 + USING ECONTROL,R10 NOTE EXECUTION TIME USING 04028000 + XC ECZER1(ECZER$L),ECZER1 ZERO OUT AREA IN ECONTROL 04030000 + LR R1,R5 MOVE HIGHEST FAKE @ OVER 04032000 + SR R1,R4 GET LENGTH OF PROGRAM 04034000 + AR R1,R0 GET UPPER @ LIMIT FOR PROGRAM 04036000 + LR R6,R1 SAVE ENDING @ OF PROGRAM 04038000 + LA R1,72+256(R1) INCREMENT ENDING @,SAVAR+BUFFER 04039000 + C R1,AJOTADH IS THERE ENOUGH ROOM FOR SAVA,BUFFR 04040000 + BH ASEXOVSP NO,BRANCH OUT, ABORT EXECUTION 04042000 + SPACE 1 04043000 + MVI 0(R6),$PRGFILC PUT IN FILL CORE CHARACTER 04044000 + MVC 1(71,R6),0(R6) PROPAGATE FILL THRU 1ST SAVE AREA 04046000 + MVC 72(256,R6),64(R6) FILL DUMMY 256 BYTES ALSO 04048000 + XC 4(4,R6),4(R6) ZERO INITIAL BACKWARDS SA PTR (HSA) 04050000 + STM R0,R5,ECRADL SAVE ALL THE @ POINTERS IN ECONTROL 04058000 + STM R0,R1,ECRDLIML STORE ECRADL-ECRADH==> ECRDLIML-H 04058500 + SPACE 1 04060000 + ST R1,AJOTADL STORE BACK UPDATED LOWER LIMIT 04064000 + ST R6,ECSAVE1 SAVE @ DUMMY SAVE AREA,FOR DUMPS 04066000 + SPACE 1 04068000 + S R6,ECRELOC SUBTRACT THE RELOCATION FACTOR 04070000 + L R7,=F'-100000' SET UP FOR WEIRD RETURN @ 04072000 + LR R8,R3 MOVE TO STORE IN FAKE R15- EPA 04074000 + STM R6,R8,ECREG13 STORE FAKE R13-R14-R15 INTO FAKE RGS 04076000 + MVI ECREGS,$PRGFILR PUT FILL REGISTER CHAR INTO 1ST BYTE 04078000 + MVC ECREGS+1(51),ECREGS PROPAGATE 4'S THROUGH REGS 0-12 04080000 + MVC ECFPREGS(32),ECREGS PUT 4'S IN FP REGS ALSO 04082000 + MVC ECILIMP,AJOINSL MOVE INSTRUCTION LIMIT OVER 04084000 + MVC ECAJ(ECAJL),AJOEC MOVE EXECUTION FLAGS OVER 04086000 + MVI ECSYSMSK,X'FF' SET CHANNEL MASKS TO INTERRUPT CEH 04087000 + MVI ECKYAMWP,X'C5' SET KEY-C, AMWP=0101 CEH 04088000 + SPACE 1 04088200 + OI ECFLAG0,$ECSPIEB NOTE WE WANT SPIE REMOVED AT END 04088400 +* IF 'RELOC' OPTION USED, ALLOW STORE-ONLY PROTECT 04088600 + AIF (NOT &$RELOC).ASNRELC SKIP IF NO RELOC MODE AVAIL 04088800 + TM AJOASMF,AJORELOC DID USER ASK FOR RELOC MODE 04089000 + BO *+8 YES, SKIP, DON'T SET FETCH PROTECT 04089200 +.ASNRELC ANOP 04089400 + OI ECFLAG0,$ECPROT SHOW BOTH FETCH/STORE PROTECT 04089600 + SPACE 1 04090000 + XCALL XXXXSNIN HAVE XXXXSNAP INIT CALL # 04092000 + ST R10,AJOECOPT SAVE @ ECONTROL, IN CASE TIMER 04094000 + AIF (&$DEBUG).ASXS1 SKIP XSNAP IF NOT DEBUG MODE 04096000 + XSNAP LABEL='ECONTROL BEFORE EXECUT',IF=(AJODEBUG,O,2,TM), #04104000 + STORAGE=(*ECONTROL,*ECONTROL+EC$LEN) 04106000 + LM R14,R15,ECRADL GET STORAGE LIMITS 04108000 + XSNAP T=(NO,,1),LABEL='USER STORAGE BEFORE EXEC(FAKE ADDR)', #04110000 + STORAGE=(*0(R14),*0(R15)),IF=(AJODEBUG,O,4,TM) 04112000 +.ASXS1 ANOP 04118000 + EJECT 04120000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04122000 +* EXECUTION CONTROL BLOCK PREPARATION COMPLETED. MAKE SURE * 04122500 +* THAT TIME OR RECORDS LIMITS HAVE NOT BEEN OVERRUN ALREADY. * 04123000 +* IF NOT, THEN PRINT HEADER, SET TIMER, AND EXECUTE PROGRAM. * 04124000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04124500 + SPACE 1 04126000 + TM AJOMODE,AJOSOVRT+AJOSRECX HAS ANY OVERRUN OCCURRED 04128000 + BNZ ASNOEXEC SKIP IF OVERRUN ALREADY. DON'T EXEC 04130000 + AIF (&$REPL EQ 0).ASNREP3 SKIP IF NO REPLACEMENT 04130005 + TM AJOMODE,AJOREPLF+AJOREPHB TEST REPLACE STATUS 04130010 + BNM ASREPLBZ BR-EITHER NO REPLACE(Z) OR PHS B(O) 04130015 + OI AJOMODE,AJOREPHB WAS IN PHASE A, SET NOW TO B 04130020 + MVC ECRFLAG,AJORFLAG INITIALIZE THE FLAG VALUE 04130025 + ASPAGE 14 GET PAGE CONTROL SET 04130026 + ASRECL 14 GET RECORDS SET (LIKE EXEC) 04130028 + ASTIMR 14,1 SET TIMER, AS FOR NORMAL EXEC. 04130029 + B ASASMCLR RETURN TO RUN A REPLACED CSECT 04130030 +ASREPLBZ EQU * EXIT LABEL- NO REPLACE, PHASE B 04130035 +.ASNREP3 SPACE 2 04130040 + ASPRNT ASHEXGO,L'ASHEXGO PRINT PRE-EXECUTION HEADING 04130400 + SPACE 1 04130600 + ASPAGE 16 SET PAGE LIMITS FOR EXECUTION 04130800 + ASRECL 16 SET UP RECORD LIMITS FOR EXECUTION 04130900 + SPACE 1 04131000 +* FLAG EXECUTION, CALL EXECUT, UNFLAG EXECUTION. 04131200 + OI AJOSTEP,AJOSEXEC FLAG TO SHOW WE'RE IN INTERPRETER 04132000 + ASTIMR 16,1 SET TIMER, AFTER SHOWN IN EXEC PHASE 04133000 + XCALL EXECUT CALL THE INTERPRETER 04134000 + NI AJOSTEP,255-AJOSEXEC SHOW FINISHED EXECUTION 04136000 + SPACE 1 J 04136100 +* POST-EXECUTION PHASE - USE ALL DUMP LIMITS IN ORDER TO J 04136150 +* PREVENT UNNECESSARY LOSS OF MESSAGES. J 04136200 + OI AJOSTEP,AJOSDUMP SHOW NOW IN DUMP STEP J 04136250 + ASRECL 20 RECORD LIMIT; CLEAR AJOSRECX FLAG J 04136300 + ASPAGE 20 PAGE LIMIT, IF USED J 04136400 + ASTIMR 18,0 PRINT INSTRUCTION COUNT/RATE 04136500 + ASTIMR 20,1 RESET TIMER FOR DUMP PROCESSING J 04136600 +* IF 1 OR MORE DATA CARDS WAS NOT READ DURING EXECUTION, J 04136610 +* READ IT AND PRINT WITH MESSAGE TO THAT EFFECT. J 04136620 + AIF (NOT &$DATARD).ASNDRZZ SKIP IF NO DATA RDR J 04136622 + TM AJIORE,AJIOPEN+AJIODFLT WAS RDR OPEN, OR DEFAULT USED J 04136623 + BNZ ASCARDRR YES, SAFE TO DO $READ NOW J 04136624 + MVC AJOPARM(80+L'ASCARDMS),AJOBLANK BLANK OUT WHOLE AREA J 04136625 + MVC AJOPARM+L'ASCARDMS(27),=C'NO CARDS READ:FILE UNOPENED' J 04136626 + B ASCARDMM 04136627 +.ASNDRZZ ANOP 04136628 +ASCARDRR $READ AJOPARM+L'ASCARDMS,80,ASNOMORC READ, SKIP IF EOF J 04136630 +ASCARDMM MVC AJOPARM(L'ASCARDMS),ASCARDMS COPY MESSAGE OVER J 04136640 + ASPRNT AJOPARMA,81+L'ASCARDMS PRINT THE ASSEMBLED LINE J 04136650 +* NOTE: ABOVE MESSAGE MAY OVERLAP INTO AJODWORK. BUT OK.J 04136651 +ASNOMORC EQU * COME HERE IF NO CARDS UNREAD J 04136660 + SPACE 2 04138000 +* DETERMINE WHETHER PROGRAM ENDED WITH A NORMAL RETURN OR* 04158000 +* AN ERROR. PRINT NORMAL MESSAGE IF IT WAS FLAGGED AS NORMAL. * 04176000 + CLI ECFLAG1,$ECBRN14 WAS RETURN NORMAL 04178000 + BNE ASDUMPCL NO, SO CALL DUMP ROUTINE 04180000 + ASPRNT ASNORMAL,L'ASNORMAL PRINT NORMAL COMPLETION BY RET 04182000 + B ASNOEXEC 04184000 + SPACE 1 04186000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04186200 +* USER PROGRAM DUMP PHASE * 04186400 +* SET UP CORRECT LIMITS FOR DUMP, THEN MAKE SPECIAL XSNAP * 04186600 +* CALL WHICH PRODUCES THE FINAL DUMP, USING APPROPRIATE LIMITS.* 04186800 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04187000 +ASDUMPCL EQU * 04188000 + LM R14,R15,ECRDLIML ECRDLIML-ECRDLIMH - DUMP LIMITS 04190000 + XSNAP T=(PR,FL,10),STORAGE=(*0(R14),*0(R15)) FINAL DUMP 04196000 + B ASNOEXEC GO TO MAKE BATCH CHECK 04200000 + EJECT 04202000 +* ASEXOVSP - ENTERED IF STORAGE OVERFLOW. * 04204000 +ASEXOVSP ASPRNT ASEMSG,L'ASEMSG PRINT STORAGE OVERFLOW MESSAGE 04206000 + SPACE 1 04208000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04208100 +* MAIN END-OF-$JOB EXIT - ASNOEXEC * 04208200 +* IF TIME AND RECORDS OVERRUN OCCURRED, PRINT MESSAGE. * 04208300 +* THEN TEST FOR BATCH RUN, IF SO REUTURN FOR NEXT $JOB CARD. * 04208400 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04208500 +* ASNOEXEC - PRINT OVERRUN MESSAGE IF ONE HAS OCCURRED. * 04210000 +ASNOEXEC EQU * 04210100 + TM AJOMODE,AJOSRECX+AJOSOVRT TEST FOR OVERRUN 04210110 + BZ ASTSTBAT NO OVERRUN, TEST FOR BATCH 04210120 + NI AJOMODE,255-AJOSRECX IF SPURIOUS ON, REMOVE SO FLAG 04210125 + MVI AJORECNT+3,1 ALLOW ONE PRINT LINE FOR AM005 CEH 04210127 + ASPRNT ASRTOVR,L'ASRTOVR OVERFLOW- NOTE OCCURRENCE 04210130 + SPACE 1 04210140 +* ASTSTBAT - TEST FOR BATCH RUN, CONTINUE IF SO. * 04210150 +ASTSTBAT EQU * 04210160 + AIF (&$XXIOS).ASFIN SKIP IF NO EXTENDED I/O J 04210170 + XCALL XXDDFINI CALL TO CLOSE EVERYTHING UP J 04210175 +.ASFIN ANOP 04210180 + TM AJOMODE,AJOBATCH WAS RUN A BATCH ONE 04210200 + BZ ASFINIS NO, SO WE'RE DONE. QUIT NOW 04210210 + SPACE 1 04210215 +* FOR BATCH RUN, MAKE SURE MODE/STEP BITS RESET RIGHT. 04210220 + NI AJOMODE,255-(AJOREPLF+AJOSRECX+AJOSOVRT+AJOREPHB) 04210225 + NI AJOSTEP,255-(AJOSASM+AJOSEXEC+AJOSDUMP) RESET PHASE 04210230 + B ASJPARMS GO BACK, SEARCH FOR NEXT $JOB 04210235 + EJECT 04210240 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04210242 +*--> INSUB: ASFLUSH FLUSH CARD RDR UNTIL NEXT COMMAND CARD * 04210245 +* FLUSH UNTIL ASSIST JCL CARD FOUND, PLACING SUCH CARD INTO * 04210300 +* AJOJCLCD (XXXXSORC DOES IT AUTOMATICALLY WHEN FOUND). * 04210330 +* IF END-FILE FOUND, TERMINATE RUN. NOTE $STOP == EOF. * 04210360 +* ENTRY CONDITIONS * 04210380 +* R14= RETURN ADDRESS TO CALLING CODE. * 04210400 +* EXIT CONDITIONS * 04210500 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04210800 +ASFLUSH $SORC AJOJCLCD,80,ASFINIS IF END-FILE, ALL DONE-QUIT J 04210850 + MVI AJOBTRQ,AJO$D SET TO BE DATA AGAIN J 04210860 + BR R14 RETURN TO CALLER J 04210870 + EJECT 04222000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04222005 +*--> INSUB: ASTIMR## TIMING SERVICES IN ASSIST MAIN PROGRAM. * 04222010 +* THIS SECTION CONSISTS OF A NUMBER OF ENTRIES CALLED FROM * 04222020 +* POINTS IN THE ASSIST MAIN PROGRAM, USING THE MACRO ASTIMR * 04222030 +* AND A TWO-DIGIT CODE AS ONE OPERAND. EACH ENTRY PERFORMS A * 04222040 +* SPECIFIC TIMING FUNCTION. AS OF 10/20/70, NO ENTRY IS CALLED * 04222050 +* FROM MORE THAN ONE POINT IN ASSIST, SO ACTUALLY, THE CODE FOR* 04222060 +* EACH ONE COULD BE INSERTED INLINE, SAVING SOME SPACE. THE * 04222070 +* SECTIONS ARE GROUPED THIS WAY FOR EASE OF MODIFICATION, AND * 04222080 +* EASE OF GENERATION, SINCE NOT ALL ENTRIES EXIST FOR ALL * 04222090 +* GENERATION OPTIONS (CONTROLLED BY &$TIMER). THE ASTIMR MACRO* 04222100 +* GENERATES CALLS ONLY TO THE EXISTING SECTIONS. * 04222110 +* ENTRY CONDITIONS (FOR ALL ASTIMR## ENTRIES) * 04222120 +* R9 = RETURN @ TO CALLING SECTION IN ASSIST. * 04222130 +* EXIT CONDITIONS * 04222132 +* R0,R1,R14,R15 MAY BE DESTROYED. * 04222134 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04222140 + SPACE 1 04222150 + AIF (&$TIMER LT 2).AST00A SKIP IF NO $TIRC USABLE 04222160 +* ASTIMR00 - &$TIMER=2 - INITIALIZE OVERALL TIMER * 04222170 +ASTIMR00 EQU * 04222180 + $TIRC TIMREM GET REMAINING TIME, TIMER UNITS 04222190 + ST R0,ASTBEGIN SAVE THIS INITIAL TIME 04222200 + BR R9 RETURN TO CALLER 04222210 + SPACE 1 04222220 +.AST00A AIF (&$TIMER GT 0).AST04A SKIP IF ANY TIMER AT ALL 04222230 + SPACE 1 04222350 +* ASTIMR18 - &$TIMER=0 - PRINT INSTRUCTION COUNT. * 04222360 +ASTIMR18 EQU * 04222370 + LM R0,R1,ECILIMT GET ECILIMT-ECILIMP FOR COMPUTE 04222380 + SR R1,R0 GET DIFFERENCE = # EXECUTED 04222390 + CVD R1,AJODWORK CONVERT # EXECUTED 04222400 + MVC ASHEXP2,ASPATB MOVE EDIT PATTERN OVER 04222410 + ED ASHEXP2,AJODWORK+8-ASPBL/2 EDIT # INSTRS DONE 04222420 + SPACE 1 04222430 + ASPRNT ASHEX,ASHEXL PRINT EXECUTION MESSAGE 04222440 + BR R9 RETURN TO CALLER 04222450 + SPACE 1 04222470 + AGO .AST24A SKIP OVER REST OF CODE 04222480 +.AST04A AIF (&$TIMER GT 1).AST04B SKIP IF NOT =1 04222490 +* ASTIMR04 - &$TIMER=1 - FIND TIME FOR STIMER SETTING. * 04222500 +ASTIMR04 EQU * 04222510 + L R0,AJOTIML LOAD TOTAL TIME LIMIT INTO PARM REG 04222520 + BAL R14,ASTIMSET GO SET TIMER TO VALUE IN R0(TU) 04222530 + BR R9 RETURN TO CALLER 04222540 + SPACE 1 04222650 + AGO .AST08A SKIP OVER CODE 04222660 +.AST04B ANOP 04222670 +* ASTIMR04 - &$TIMER=2 - GET TIME LEFT FOR STIMER * 04222680 +ASTIMR04 EQU * 04222690 + L R0,AJOTIML TOTAL TIME LIMIT (TIMER UNITS) 04222700 + TM AJOAPMOD,AJOAPUST DID USER ACTUALLY SUPPLY T= VALUE 04222710 + BO AST04A YES, SO LEAVE IT ALONE-OK 04222720 +* USER DID NO SUPPLY T=, USE TIMREM TO GET ACTUAL LEFT. 04222730 + $TIRC TIMREM GET ACTUAL TIME REMAINING 04222740 + SH R0,=AL2(5000/26) 5 MILLISEC FUDGE FACTOR FOR SAFETY 04222750 +AST04A BAL R14,ASTIMSET GO SET TIMER TO DESIRED VALUE 04222760 + BR R9 RETURN TO CALLER 04222770 +.AST08A SPACE 2 04222930 + SPACE 1 04223010 +* ASTIMR12 - &$TIMER=1,2 - PRINT ASSEMBLY STATISTICS. * 04223020 +* ENTRY CONDITIONS * 04223030 +* R12(RAT) = @ AVWXTABL DUMMY SECTION * 04223040 +ASTIMR12 EQU * 04223050 + USING AVWXTABL,RAT NOTE THE POINTER 04223060 + LH R7,AVSTMTNO GET # STATEMENTS FOR ASTIMER 04223070 + DROP RAT ERASE THE USING 04223080 + ASTIME ASHASM,* CALL TIMER TO PRINT MSG 04223090 + BR R9 RETURN TO CALLER 04223095 + SPACE 1 04223100 +* ASTIMR14 - SET UP FOR REPLACEMENT PHASE B EXEC. * 04223104 +ASTIMR14 EQU * (SAME AS -16, I.E., EXECUTION) 04223106 +* ASTIMR16 - &$TIMER=1,2 - SET TIMER FOR EXECUTION TIMING* 04223110 +ASTIMR16 EQU * 04223120 + L R0,AJOTIMR GET CURRETN TIME REMAINING FOR T= 04223122 + L R1,AJOTX GET DESIRED TX= LIMIT 04223124 + LA R15,AJOTD ADDRESS OF TIME TO BE SAVED FOR DUMP 04223125 + BAL R14,ASTRP16 CALL ROUTINE TO CALCULATE TIME 04223126 + BAL R14,ASTIMSET CALL STIMER CODE 04223130 + BR R9 RETURN TO CALLING SECTION OF CODE 04223139 + SPACE 1 04223140 +* ASTIMR18 - &$TIMER=1,2 CALC,PRINT EXEC TIME,RATE * 04223150 +ASTIMR18 EQU * 04223160 + LM R6,R7,ECILIMT GET ECILIMT/ECLIMP FROM ECONTROL 04223170 + SR R7,R6 GET # INSTRUCTIONS ACTUALLY DONE 04223180 + CVD R7,AJODWORK CONVERT # INSTRS DONE 04223190 + MVC ASHEXP2,ASPATB MOVE EDIT PATTERN OVER 04223200 + ED ASHEXP2,AJODWORK+8-ASPBL/2 EDIT # INSTRUCTIONS DONE 04223210 + ASTIME ASHEX,* GO TO DO TIMING 04223220 + BR R9 RETURN TO CALLING SECTION 04223221 + SPACE 1 04223222 +* ASTIMR20 - &$TIMER=1,2. SET UP FOR DUMP 04223223 +ASTIMR20 EQU * 04223224 + L R0,AJOTIMR GET CURRENT TIMER SETTING 04223225 + A R0,AJOTD ADD IN TIME FOR DUMP 04223226 + BAL R14,ASTIMSET CALL STIMER ROUTINE 04223227 + BR R9 RETURN TO CALLER 04223228 + SPACE 1 04223230 + AIF (&$TIMER LT 2).AST24A SKIP IF NO ENDING TIME 04223240 +* ASTIMR24 - &$TIMER=2 - COMPUTE,PRINT TOTAL ASSIST TIME * 04223250 +ASTIMR24 EQU * 04223260 + $TIRC TIMREM GET TIME REMAINING INTO R0 04223270 + L R1,ASTBEGIN PLACE BEGINNING TIME FOR ASTIMER 04223280 + LA R2,ASHEND SHOW @ OF MESSAGE 04223290 + LA R3,ASHENDP SHOW @ NUMBER AREA 04223300 + LA R4,ASHENDL SHOW LENGTH OF MESSAGE 04223310 + SR R6,R6 SHOW NO RATE (2ND PART OF MESSAGE) 04223320 + BAL R14,ASTIMERE ENTER MIDDLE SECTION OF TIME PRINTER 04223330 + BR R9 RETURN TO CALLER 04223335 +.AST24A ANOP 04223340 + EJECT 04223350 + AIF (&$TIMER LT 1).AST60A SKIP CODE IF UNNEEDED 04223900 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04223950 +*--> INSUB: ASTIMSET SET INTERVAL TIMER ROUTINE * 04224000 +* CALLED BY ASTIMR## SECTIONS TO SET TIMER FOR GIVEN INTERVAL. * 04226000 +* **NOTE** THIS IS ONLY USE OF IBM STIMER MACRO IN ASSIST. * 04227000 +* ALSO, UNDER DOS, ONLY USE OF STXIT MACRO. * 04228000 +* ENTRY CONDITIONS * 04228100 +* R0 = VALUE OF TIMER INTERVAL TO BE SET (TIMER UNITS = 26.04 MICS) * 04228200 +* R14= RETURN ADDRESS TO CALLING SECTION IN ASTIMR## * 04228300 +* EXIT CONDITIONS * 04228400 +* R0,R1,R15 MAY BE MODIFIED. * 04228500 +* AJOMODE IS SET TO SHOW NO TIME OVERRRUNS EXIST AT MOMENT. * 04228600 +* USES MACROS: STIMER(OS) ; STXIT,SETIME, GETIME(DOS) * 04228650 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04228700 +ASTIMSET EQU * 04228800 + ST R0,AJOTIMR STORE VALUE AS CURRENT LAST TIMER 04228900 + NI AJOMODE,255-AJOSOVRT MAKE SURE FLAG SET OFF 04229000 + AIF (&$ASMLVL).ASTDOST SKIP OVER DOS TIMING OPTIONS 04229005 + LR R1,R0 GET VALUE OF TIMER INTERVAL IN R1 04229010 + M R0,AJ2604 MULT BY MICROSEC/TU 04229015 + D R0,AJ100M CONVERT TO SEC IN R1 04229020 + SETIME (R1) SET INTERVAL TIMER 04229025 + GETIME TU R1 <= TIME OF DAY IN TIMER UNITS 04229030 + A R1,AJOTIML R1 <= TIME OF DAY FOR TIMER INTERRPT 04229035 + ST R1,ASTMRMDS SAVE TIME FOR TIMREM OPTION 04229040 + STXIT IT,ASTEXIT,ASTSAVAD ALLOW TIMER INTERRUPTION 04229045 +.ASTDOST AIF (NOT &$ASMLVL).ASTOSTM SKIP OS STIMER 04229050 + STIMER TASK,ASTEXIT,TUINTVL=AJOTIMR 04229100 +.ASTOSTM ANOP 04229150 + BR R14 RETURN TO CALLER 04229200 + EJECT 04229300 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04229350 +*--> INSUB: ASTIMER UPDATE TIMER,PRINT ELAPSED TIME,MESSAGE * 04229400 +* **NOTE** THIS IS ONLY USE OF IBM TTIMER MACRO IN ASSIST. * 04229500 +* ENTRY CONDITIONS * 04229600 +* R2 = @ MESSAGE TO BE PRINTED OUT * 04230000 +* = 0 ==> UPDATE TIMER ONLY, DO NOT PRINT MESSAGE OUT * 04232000 +* R3 = @ AREA WHERE TIME INCREMENT SHOULD BE PLACED * 04234000 +* R4 = LENGTH OF MESSAGE TO BE PRINTED * 04236000 +* R6 = @ WHERE SECOND PART OF MESSAGE TO GO (INSTS/SEC, ETC) * 04240000 +* = 0 ==> THERE IS NO 2ND PART OF MESSAGE * 04242000 +* R7 = VALUE TO BE USED IN 2ND PART OF MESSAGE, IF ANY * 04244000 +* R14= RETURN @ TO CALLING SECTION OF PROGRAM. * 04245000 +* USES MACROS: TTIMER(OS) ; GETIME(DOS) * 04245500 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04246000 + SPACE 1 04248000 +ASTIMER EQU * ENTRY FOR TIMING PRINTING MODULE 04250000 + AIF (&$ASMLVL).ASTOSGT SKIP IF OS TTIMER DESIRED 04250050 + GETIME TU R1 <= TIME OF DAY IN TIMER UNITS 04250100 + L R0,ASTMRMDS GET TIME OF DAY FOR INTERRUPT(TIME) 04250150 + SR R0,R1 YIELDS TIME (TU) LEFT IN INTERVAL 04250200 +.ASTOSGT AIF (NOT &$ASMLVL).ASTDSGT SKIP IF DOS GETIME IN EFFECT 04250250 + TTIMER , GET TIME LEFT IN INTERVAL 04251000 +.ASTDSGT ANOP 04251500 + L R1,AJOTIMR GET CURRENT TIME REMAINING 04252000 + ST R0,AJOTIMR STORE NEW TIME REMINAING 04254000 + LTR R2,R2 IS THERE A MESSAGE TO BE PRINTED 04256000 + BCR Z,R14 RETURN TO CALLER, JUST RESET TIMER 04258000 + SPACE 1 04258500 +* ASTIMERE ENTRY ONLY ENTERED FROM SECTION ASTIMR24,IF GEN 04259000 +ASTIMERE EQU * ENTRY WITH NO TIMER UPDATE. 04259500 + SR R1,R0 GET TIME DIFFERENCE 04260000 + M R0,AJ2604 MULT BY 26.04 MICROSEC/TU 04262000 + D R0,AJ100000 CONVERT TO MILLISEC IN R1 04264000 + CVD R1,AJODWORK CONVERT ELAPSED TIME 04266000 + MVC 0(ASPAL,R3),ASPATA MOVE THE EDIT PATTERN IN 04268000 + ED 0(ASPAL,R3),AJODWORK+8-ASPAL/2 EDIT VALUE OVER 04270000 + LTR R3,R6 TEST CODE AND MOVE OVER 04272000 + BZ ASTPRINT SKIP REST IF ZERO,GO PRINT 04274000 + SPACE 1 04275000 + M R6,AJ1000 MULT # STMTS, GET STMTS/SEC 04276000 + LTR R1,R1 MAKE SURE TIME >= 1MILLISEC 04278000 + BZ *+6 SKIP DIVIDE IF 0 04280000 + DR R6,R1 DIVIDE TO GET STMTS OR INSTS/SEC 04282000 + CVD R7,AJODWORK CONVERT RESULT TO DECIMAL 04284000 + MVC 0(ASPBL,R3),ASPATB MOVE EDIT PATTERN OVER 04286000 + ED 0(ASPBL,R3),AJODWORK+8-ASPBL/2 EDIT VALUE ACCROS 04288000 +ASTPRINT LR R0,R2 MOVE @ MESSAGE OVER FOR ASASPRINT 04290000 + LR R1,R4 MOVE LENGTH OVER FOR ASASPRNT 04291000 +* FALL THRU INTO ASASPRNT 04291500 +.AST60A ANOP 04292000 + SPACE 1 04292020 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04292030 +*--> INSUB: ASASPRNT CALLED BY ASPRNT MACRO TO PRINT A LINE. * 04292040 +* THIS INSUB IS USED INSTEAD OF MANY $PRNTS TO SAVE SPACE. * 04292060 +* *** MUST IMMEDIATELY FOLLOW ASTIMER SECT., IF IT EXISTS. * 04292080 +* ENTRY CONDITIONS * 04292100 +* R0 = @ LINE TO BE PRINTED * 04292120 +* R1 = LENGTH OF LINE TO BE PRINTED. * 04292140 +* R14= RETURN @ TO CALLING CODE INSIDE MAIN PROG ASSIST. * 04292160 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04292180 + SPACE 1 04292200 +ASASPRNT $PRNT (R0),(R1) PRINT THE LINE DESIRED 04292220 + BR R14 RETURN TO CALLER 04292240 + EJECT 04292300 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04292320 +* MAIN STORAGE MANAGEMENT CODE SECTIONS. * 04292340 +* THE FOLLOWING SECTIONS OF CODE CONTAIN THE INTERFACE * 04292360 +* BETWEEN ASSIST AND THE OPERATING SYSTEM WITH RESPECT TO * 04292380 +* DYNAMIC MEMORY MANAGEMENT. IF ASSIST MUST BE RUN UNDER * 04292400 +* A SYSTEM WITHOUT SUCH FACILITIES, THIS CODE CAN BE MODIFIED * 04292420 +* TO JUST SUPPLY ADDRESSES OF A FIXED STORAGE AREA. * 04292440 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04292460 + SPACE 2 04292480 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04292490 +*--> INSUB: ASMSINIT MAIN STORAGE INITIALIZATION * 04292500 +* ASMSINIT IS CALLED TO OBTAIN THE LARGEST POSSIBLE * 04292520 +* BLOCK OF MAIN STORAGE >= 8K BYTES, FREE BACK THE AMOUNT * 04292540 +* GIVEN BY ASLENOS (OR FREE= PARM, IF USED), AND SET VALUES * 04292560 +* DESCRIBING THE STORAGE AREA LEFT, WHICH IS USED AS THE * 04292580 +* SINGLE DYNAMIC STORAGE AREA FOR THE ENTIRE RUN. * 04292600 +* STORAGE ALLOCATION IS DONE 1 TIME ONLY FOR WHOLE BATCH. * 04292610 +* ENTRY CONDITIONS * 04292620 +* R14= RETURN @ TO CALLING SECTION OF CODE. * 04292640 +* EXIT CONDITIONS * 04292660 +* R0,R1,R2,R15 ARE MODIFIED BY THIS SECTION. * 04292680 +* AJOPADL,AJOPADH HAVE BEEN SET(LOWER, UPPER LIMITS OF CORE AREA). * 04292700 +* AJOSTEP SET WITH FLAG AJOMSINT TO SHOW DONE. * 04292710 +* USES MACROS: GETMAIN (ONLY USE OF GETMAIN IN ASSIST). * 04292720 +* COMRG-(DOS) * 04292730 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04292740 + SPACE 1 04292760 +ASMSINIT EQU * 04292780 + OI AJOSTEP,AJOMSINT SHOW MAIN CORE OBTAINED. HALT FREE= 04292785 + LA R2,AJOPADL GET @ WHERE @'S TO BE PUT 04292800 + AIF (&$ASMLVL).ASGETMN FOR THE OS GETMAIN 04292802 + SPACE 04292804 + COMRG GET @ OF OUR COMMUNICATIONS REGION 04292806 + LM R0,R1,32(R1) R0 <- HIGHEST PARTITION ADDRESS 04292807 +* R1 <- END @ OF LAST PHASE LOADED 04292808 + LA R1,3(R1) GET @ OF AT LEAST NEXT FULLWORD 04292809 + N R1,=X'FFFFFFFC' INSURE FULLWORD BOUNDARY 04292810 + N R0,=X'FFFFFFFC' MAKE SURE ON FULLWORD BOUNDARY 04292811 + SR R0,R1 GET LENGTH OF FREE STORAGE LEFT 04292812 + ST R1,0(R2) SAVE @ OF FREE BLOCK 04292813 + ST R0,4(R2) SAVE LENGTH OF FREE BLOCK 04292814 +.ASGETMN AIF (NOT &$ASMLVL).ASNGTMN IN CASE OF STATIC ALLOCATION 04292816 + GETMAIN VU,LA=ASSPACE,A=(2),SP=1 GET AT LEAST 8K 04292820 +.ASNGTMN ANOP 04292830 +* AT THIS PT AJOPADL=@ AREA, AJOPADH=LENGTH OF IT 04292840 + SPACE 1 04292860 + AIF (&$DEBUG).ASZX1 SKIP IF NOT DEBUG MODE 04292880 +* ZERO ENTIRE DYNAMIC MEMORY AREA FOR DEBUGGING. 04292900 + LH R0,=H'-256' FOR BXH DECREMENT 04292920 + L R15,AJOPADH GET LENGTH OF AREA 04292940 + L R1,AJOPADL GET @ AREA 04292960 + AR R15,R1 ADD BEGIN TO LENGTH TO GET END@ 04292980 + AR R15,R0 ADD -256 TO ENDING @ 04293000 + SPACE 1 04293020 + XC 0(256,R15),0(R15) ZERO A BLOCK OF MEMORY 04293040 + BXH R15,R0,*-6 LOOP BACKWARDS, ZEROING 04293060 + XC 0(256,R1),0(R1) ZERO 1ST 256 TO MAKE SURE 04293080 +.ASZX1 ANOP 04293100 + SPACE 1 04293120 + LM R0,R1,AJOPADL AJOPADL,H= AREA @, LENGTH 04293140 + LR R15,R1 SAVE THE LENGTH OF THE AREA 04293160 + AR R1,R0 GET UPPER @ LIMIT 04293180 + ST R1,AJOPADH SAVE AS PERMANENT UPPER LIMIT 04293200 + SPACE 1 04293220 +* CHECK FREE VALUE, FREE SPACE AS REQUESTED. 04293240 + L R0,AJOFREE GET FREE VALUE (INIT TO ASLENOS) 04293260 + CR R0,R15 COMPARE FREE LENGTH TO OBTAINED ONE 04293280 + BNH *+6 SKIP IF OK, FREE <= GOTTEN J 04293285 + LR R0,R15 FREE WHOLE THING (LOOK FOR AS999) J 04293290 + AIF (&$FREEMN EQ 0).ASZQQQ SKIP IF NO LOWER LIMIT ON FREE J 04293295 + CH R0,=H'&$FREEMN' COMPARE AGAINST MINIMUM ALLOWED J 04293300 + BNL *+8 SKIP IF >= MINIMUM ALLOWED J 04293305 + LH R0,=H'&$FREEMN' PROBABLY ERROR, USE MINIMUM ALLOWED 04293310 +.ASZQQQ ANOP J 04293315 + SRL R0,3 SHIFT, REMOVE 3 BITS 04293320 + SLA R0,3 SHIFT, ALIGNED ON DOUBLEWORD 04293340 + BCR Z,R14 RETURN, FREE=0, SO FREE NONE 04293360 + SR R1,R0 SUBTRACT FROM UPPER LIMIT 04293380 + ST R1,AJOPADH NEW UPPER LIMIT 04293400 + B ASMSFREE GO FREE THE SPACE REQUESTED 04293420 + EJECT 04293440 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04293450 +*--> INSUB: ASMSFINI FREE CURRENT DYNAMIC STORAGE AREA * 04293460 +* CALLED TO FREE SPACE DESCRIBED BY AJOPADL-AJOPADH PTRS. * 04293480 +* SINCE DOS USER MUST ALLOCATE OWN DYNAMIC AREA FOR THE USERS * 04293485 +* PROGRAMS, THERE IS NO NEED TO FREE THIS BLOCK. * 04293490 +* ENTRY CONDITIONS * 04293500 +* R14= RETURN @ TO CALLING SECTION OF CODE. * 04293520 +* EXIT CONDITIONS * 04293540 +* R0,R1,R15 ARE MODIFIED. * 04293560 +* STORAGE FROM (AJOPADL) TO (AJOPADH) HAS BEEN FREEMAIN'ED. * 04293580 +* USES MACROS: FREEMAIN (ONLY USE OF FREEMAIN IN ASSIST). * 04293600 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04293620 + SPACE 1 04293640 +ASMSFINI EQU * 04293660 + LM R15,R0,AJOPADL GET AJOPADL-AJOPADH 04293680 + LR R1,R15 MOVE LOWER @ OVER 04293700 + SR R0,R15 LENGTH = (AJOPADH) - (AJOPADL). 04293720 + SPACE 1 04293740 +ASMSFREE EQU * ENTRY POINT FROM ASMSINIT TO FREE 04293760 + AIF (NOT &$ASMLVL).ASNFRMN SKIP IF DOS DYNAMIC STORAGE USE 04293766 + AL R0,=XL4'01000000' SHOW SP=1 04293780 + FREEMAIN R,LV=(0),A=(1) FREE THE SPACE TO OS 04293800 +.ASNFRMN ANOP 04293810 + BR R14 RETURN TO CALLER 04293820 + EJECT 04294000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04294025 +*--> INSUB: ASRECL## RECORD LIMIT CONTROL * 04294050 +* VARIOUS ENTRIES IN THIS SECTION ARE CALLED TO MANIPULATE * 04294100 +* RECORD CONTROL VARIABLES. EACH SECTION IS NORMALLY CALLED * 04294150 +* ONLY ONE PLACE, BUT ARE GROUPED HERE FOR EASE OF CHANGE, AND * 04294200 +* SETUP FOR DIFFERING OPTIONS. * 04294250 +* ENTRY CONDTIONS * 04294300 +* R9 = RETURN ADDRESSS OF CALLING CODE * 04294350 +* EXIT CONDITIONS * 04294400 +* R0,R1,R14,R15 MAY BE DESTROYED. * 04294450 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04294500 + SPACE 1 04294550 +* ASRECL04 - INITIALIZE TOTAL RECORD COUNT * 04294600 +ASRECL04 EQU * 04294650 + AIF (&$RECORD EQ 2).ASR04A SKIP IF $TIRC EXISTS 04294700 + MVC AJORECNT,AJORECL MOVE USER VALUE OVER 04294750 + BR R9 RETURN TO CALLER 04294800 +.ASR04A AIF (&$RECORD LT 2).ASR04B SKIP IF NO $TIRC 04294850 +* CALCULATED RECORD LIMIT: =RECREM (IF USER SUPPLIED NO 04294900 +* R= PARM. OR MIN(RECREM, USER R= PARM)). 04294950 + $TIRC RECREM GET # LEFT SAID BY SYSTEM 04295000 + TM AJOAPMOD,AJOAPUSR DID USER ACTUALLY SPECIFY 04295050 + BZ ASR04A NO, SO JUST USE RECREM 04295100 + AIF (&$RECOVR).ASRPSU1 SKIP IF R= SHOULD BE USED-PSU BATS 04295125 + C R0,AJORECL CHECK AGIANST USER R= 04295150 + BNH *+8 SKIP IF MINIMUM THERE ALREADY 04295200 +.ASRPSU1 L R0,AJORECL GET USER SPECIFIED R= RECORD LIMIT 04295250 +ASR04A ST R0,AJORECNT STORE THE COUNT THERE 04295300 + BR R9 RETURN TO CALLER 04295350 +.ASR04B ANOP 04295400 + SPACE 1 04295450 +* ASRECL14 - SET RECORD COUNT BEFORE REPL PHASE B. 04295500 +ASRECL14 EQU * JUST SAME AS FOR EXECUTE TIME 04295550 + SPACE 1 04295600 +* ASRECL16 - RECORD CONTROL JUST BEFORE USER EXECUTION. 04295650 +* AJORECNT = MIN(AJORECNT, RX=) - RD= . 04295700 +* THIS METHOD ALLOWS FOR DUMP IF DESIRED. 04295750 +ASRECL16 EQU * 04295800 + L R0,AJORECNT GET CURRENT LINES LEFT-TOTAL 04295850 + L R1,AJORX GET DESIRED TOTAL FOR EXEC+DUMP 04295900 + LA R15,AJORD @ RECORDS SAVED FOR DUMP 04295950 + BAL R14,ASTRP16 CALL COMPUTING ROUTINE 04296000 + ST R0,AJORECNT STORE THE VALUE COMPUTED 04296050 + NI AJOMODE,255-AJOSRECX REMOVE POSSIBLE OVERRUN FLAG 04296100 + BR R9 RETURN TO CALLER 04296150 + SPACE 1 04296200 +* ASRECL20 - RESET RECORD CONTROL JUST BEFORE USER DUMP DONE. 04296250 +ASRECL20 EQU * 04296300 + L R0,AJORECNT GET # LEFT FROM EXECUTION 04296350 + A R0,AJORD ADD THOSE SAVED FOR DUMP 04296400 + ST R0,AJORECNT STORE CORRECT NEW VALUE 04296450 + NI AJOMODE,255-AJOSRECX REMOV OVERRRUN FLAG IF ON 04296500 + BR R9 RETURN TO CALLER 04296550 + SPACE 2 04296600 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04296625 +*--> INSUB: ASTRP16 COMPUTE VALUES FOR BEFORE EXECUTION * 04296650 +* USED BY (ASTIMR,ASRECL,ASPAGE)16 TO COMPUTE THE VALUE FOR * 04296700 +* CONTROL FOR USER EXECUTION. THE VALUE IS THE MINIMUM OF * 04296750 +* REMAINING VALUE AND THE USER EXECUTION VALUE. THEN SUBTRACT * 04296800 +* AMOUNT TO BE SAVED FOR A DUMP. * 04296850 +* ENTRY CONDITIONS * 04296900 +* R0 = CURRENT VALUE OF COUNTER (AJOTIMR,AJORECNT,AJOPREM) * 04296950 +* R1 = EXECUTION VALUE (AJOTX, AJORX, AJOPX) * 04297000 +* R15= @ DUMP VALUE (AJOTD, AJORD, AJOPD) * 04297050 +* EXIT CONDITIONS * 04297100 +* R0 = MIN ((R0), (R1)) - 0(R15). IF <0, = 0(R15) & 0(R15) = 0. * 04297150 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04297200 +ASTRP16 EQU * 04297250 + CR R0,R1 WAS REMAINING LESS THAN EXEC SPECFD 04297300 + BL *+6 YES, USE IT SINCE MIN 04297350 + LR R0,R1 NO, USE EXECUTION TIME SPECIFIED VAL 04297400 + S R0,0(,R15) SUBTRACT VALUE SAVED FOR DUMP 04297450 + BCR P,R14 RETURN IF OK 04297500 + A R0,0(,R15) ADD THE VALUE BACK TO 0 OR ABOVE 04297550 + SR R1,R1 GET A 0 04297600 + ST R1,0(,R15) ZERO OUT-SO WE DON'T GIVE HIM MORE 04297650 + BR R14 RETURN TO CALLING SECTION 04297700 + EJECT 04297750 + AIF (NOT &$PAGE).ASPG100 SKIP IF NO PAGE CONTROL 04297800 +**--> INSUB: ASPAGE## PAGE CONTROL CODE FOR PAGE MODE LIMITS + + + + 04297850 +*+ THESE SECTIONS CALLED TO SET LINE AND PAGE LIMITS. NOTE THAT+ 04297900 +*+ THEY DO NOT BOTHER TO CHECK WHETHER PAGE CONTROL MODE IS + 04297950 +*+ ON OR NOT. THIS IS SAFE BECAUSE THESE ACTIONS HAVE NO + 04298000 +*+ EFFECT WHATSOEVER IF PAGE CONTROL NOT ON, SINCE XXXXIOCO + 04298050 +*+ SECTIONS DO NO CHECKING UNLESS IT IS. + 04298100 +*+ NOTE THAT SECTIONS OF ASTIMR##, ASRECL##, AND ASPAGE## HAVING+ 04298150 +*+ SAME TWO-DIGIT CODE FOR END GENERALLY ARE CALLED TOGETHER. + 04298200 +*+ ENTRY CONDITIONS + 04298250 +*+ R9 = RETURN ADDRESS TO CALLING SECTION OF CODE. + 04298300 +*+ EXIT CONDITIONS + 04298350 +*+ R0,R1,R14,R15 MAY BE DESTROYED. + 04298400 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 04298450 + SPACE 1 04298500 +*+ ASPAGE04 - INITIALIZE FOR WHOLE RUN. SET UP FOR + 04298550 +*+ DEFINITE NEW PAGE SKIP, SINGLE SPACE IF REQUESTED. + 04298600 +ASPAGE04 EQU * 04298650 + MVC AJOPREM,AJOP SET FROM WHATEVER VALUE OF P= 04298700 + SR R0,R0 ZERO REGISTER 04298750 + ST R0,AJOLREM LINES LEFT = 0, CREATE NEW PAGE 04298800 + NI AJIOPR,255-AJIOSING REMOVE POSSIBLE SINGLE SPACE FLAG 04298850 + OC AJIOPR,AJIOSS ENTER SINGLE SPACE FLAG IF REQUIRED. 04298900 + BR R9 RETURN 04298950 + SPACE 1 04299000 + AIF (&$REPL EQ 0).ASPNR SKIP IF NO REPL 04299050 +*+ ASPAGE14 - PAGE CONTROL BEFORE REPLACE PHASE B. 04299100 +ASPAGE14 EQU * 04299150 + SR R0,R0 ZERO REGISTER 04299200 + ST R0,AJOLREM SAME AS ASPAGE16, BUT ****NEW PAGE** 04299250 +* FALL THRU INTO ASPAGE16. 04299300 +.ASPNR ANOP 04299350 + SPACE 1 04299400 +* ASPAGE16 - PAGE LIMIT SET BEFORE USER PROGRAM EXECUTE. 04299450 +ASPAGE16 EQU * 04299500 + L R0,AJOPREM GET CURRENT # PAGES LEFT 04299550 + L R1,AJOPX GET NUMBER FOR EXEC+DUMP 04299600 + LA R15,AJOPD GET VALUE FOR DUMP 04299650 + BAL R14,ASTRP16 CALL GENERAL COMPUTE FOR EXEC 04299700 + ST R0,AJOPREM STORE COMPUTED VALUE BACK 04299750 + NI AJIOPR,255-AJIOSING REMOVE POSSIBLE SINGLESPACE FLAG 04299800 + OC AJIOPR,AJIOSSX FLAG SINGLE SPACE IF DESIRED 04299850 + BR R9 RETURN TO CALLER 04299900 + SPACE 1 04299950 +*+ ASPAGE20 - SET UP PAGE LIMIT FOR DUMP. + 04300000 +ASPAGE20 EQU * 04300050 + L R0,AJOPREM GET CURRENT PAGES LEFT 04300100 + A R0,AJOPD ADD IN DUMP PAGES 04300150 + ST R0,AJOPREM STORE BACK 04300200 + NI AJIOPR,255-AJIOSING REMOVE POSSIBLE SINGLE SPACE FLAG 04300220 + OC AJIOPR,AJIOSSD PUT IN SSD FLAG IF EXISTS 04300230 + BR R9 RETURN 04300250 +.ASPG100 ANOP 04300300 + EJECT 04300350 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04300400 +* DISASTROUS TERMINATIONS. * 04300450 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04300500 + SPACE 1 04308000 +* ASZERR1 - COULD NOT OPEN PRINTER - ABORT * 04310000 + AIF (&$ASMLVL).ASOSWTL SKIP $PRNT IF UNDER OS GENERATN 04310100 +ASZERR1 $PRNT =CL50' AM001 - ASSIST COULD NOT OPEN PRINTER - ABORT',50 04310200 +.ASOSWTL AIF (NOT &$ASMLVL).ASDSPNT SKIP IF DOS GENERATED $PRNT 04310300 +ASZERR1 WTO 'AM001 ASSIST COULD NOT OPEN PRINTER FT06F001:ABORT', #04312000 + ROUTCDE=11 WRITE-TO-PROGRAMMER NOW 04312250 +.ASDSPNT ANOP 04312500 + TM AJIOSO,AJIOPEN COULD READER BE OPENED FOR SOURCE 04314000 + BO ASZERRXI SKIP IF RDR DID OPEN OK 04316000 + SPACE 1 04318000 +* ASZERR2 - COULDN'T OPEN SOURC RDR - ABORT * 04320000 + AIF (&$ASMLVL).ASRDRNO SKIP FOR OS WTL & ABORT 04320100 +ASZERR2 $PRNT =CL50' AM002 - ASSIST COULD NOT OPEN READER - ABORT',50 04320200 +.ASRDRNO AIF (NOT &$ASMLVL).ASNOWTL SKIP IF NO OS WTL ALLOWED 04320300 +ASZERR2 WTO 'AM002 ASSIST COULD NOT OPEN READER SYSIN:ABORT', #04322000 + ROUTCDE=11 WRITE-TO-PROGRAMMER RATHER THAN WTL 04322250 +.ASNOWTL ANOP 04322500 + SPACE 1 04324000 +ASZERRXI LA R2,16 SET RETURN CODE TO DISASTER 04326000 + B ASFINISZ TAKE ERROR EXIT 04328000 + EJECT 04330000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04332000 +* FINISH AND EXIT SECTION * 04334000 +* HAVE TOTAL RUN TIME COMPUTED AND PRINTED. * 04336000 +* CLOSE ALL DCB'S WHICH ARE CURRENTLY OPEN (XXXXFINI). * 04338000 +* FREE ALL THE STORAGE OBTAINED BY GETMAIN AT BEGINNING. * 04340000 +* STORE VALUE IN R2 AS RETURN CODE. * 04342000 +* RETURN TO CALLING PROGRAM. * 04344000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04346000 + SPACE 1 04348000 +ASFINIS EQU * NORMAL TERMINATION LABEL 04350000 + ASTIMR 24,2 PRINT END MESSAGE IF REQUIRED 04352000 + SPACE 1 04354000 + XCALL XXXXFINI HAVE ALL DCB'S CLOSED 04356000 + SR R2,R2 SET RETURN CODE TO 0 04358000 + SPACE 1 04360000 +* ASFINISZ ENTERED IF COULDN'T OPEN RDR OR PRINTER * 04362000 +* RETURN ALL GETMAIN'ED STORAGE TO THE SYSTEM. * 04363000 +ASFINISZ EQU * 04364000 + BAL R14,ASMSFINI GO RETURN ALL SPACE USED TO OS 04366000 + SPACE 1 04370000 + AIF (&$ASMLVL).ASNOEOJ SKIP FOR OS RETURN 04370500 + EOJ SVC RETURN TO SUPERVISOR IF DOS 04371000 +.ASNOEOJ AIF (NOT &$ASMLVL).ASDSEOJ SKIP IF DOS EOJ IN EFFECT 04371500 + L R1,4(R13) GET PREVIOUS SAVE AREA PTR 04372000 + ST R2,16(R1) STORE VALUE IN R2 AS RETURN CODE 04374000 + $RETURN RGS=(R14-R12) RETURN TO CALLER 04376000 +.ASDSEOJ ANOP 04377000 + SPACE 1 04378000 + AIF (&$TIMER LT 1).AST65A SKIP STIMER EXIT IF NON REQR 04379000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04380000 +* TIMER EXIT ROUTINE * 04382000 +* THIS SECTION IS CALLED IF A TIMER INTERRUPT OCCURS DURING * 04382100 +* AN ASSIST RUN. IT FLAGS AJOSOVRT BIT IN AJOMODE TO NOTE THE * 04382200 +* OVERRUN, THEN EXAMINES AJOSTEP TO DETERMINE WHAT STEP ASSIST * 04382300 +* IS IN. DEPENDING ON THE STEP, IT TAKES ACTION TO ENSURE * 04382400 +* THAT THE PARTICULAR PHASE WILL BE TERMINATED FAIRLY QUICKLY. * 04382500 +* PHASES CAN BE ASSEMBLY, EXECUTION, DUMP, OR ASSEMBLY+EXEC * 04382600 +* (THE LAST CASE BEING DURING A REPLACE PHASE B, IF ANY). * 04382700 +* **NOTE** UNDER DOS USE, ANY MODIFIED REGS MUST BE PLACED IN * 04382800 +* THE INTERRUPT SAVE AREA BEFORE EXITING * 04382900 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04402000 + SPACE 1 04404000 + AIF (&$ASMLVL).ASTEXIN SKIP IF UNDER OS GENERATION 04404100 +ASTEXIT BALR R15,0 ESTABLISH ADDRESSABILITY 04404200 + USING *,R15 INFORM OF BASE REG R15 USING 04404300 +.ASTEXIN AIF (NOT &$ASMLVL).ASTEXDS SKIP IF UNDER DOS GENERATION 04404400 + USING ASTEXIT,R15 NOTE TEMPORARY USING 04406000 +ASTEXIT STM R14,R12,12(R13) SAVE ALL , FOR SAFETY 04408000 +.ASTEXDS ANOP 04409000 + LA R11,ASJOBCON GET @ MAIN TABLE BACK 04410000 + OI AJOMODE,AJOSOVRT SHOW REAL TIME OVERRUN 04412000 + TM AJOSTEP,AJOSEXEC WAS INTERPRETER BEING USED 04414000 + BZ ASTEXASM NO, GO TO CHECK ASM FLAG 04416000 + L R10,AJOECOPT GET @ ECONTROL BLOCK 04418000 + MVI ECFLAG1,$ECTIMEX TELL EXECUT TO QUIT NEXT BRANCH 04420000 + SPACE 1 04420100 +ASTEXASM EQU * 04420200 +* **NOTE** THE MAIN PROGRAMS FOR BOTH PASSES OF THE 04420300 +* ASSEMBLER TEST AVTAGS2 1 TIME FOR EACH STATEMENT. 04420400 +* **NOTE** IT IS ALWAYS SAFE TO SET THE BIT THIS WAY. 04420500 + L RAT,AJOVWXPT GET @ VWXTABL 04420600 + USING AVWXTABL,RAT NOTE PTR THERE 04420700 + OI AVTAGS2,AJOASTOP SET BIT-ASSEMBLER WILL STOP 04420800 + DROP RAT ZAP USING 04420900 +* WE MAY BE IN DUMP STEP (AJOSDUMP IN AJOSTEP). IN 04421000 +* IN ANY CASE, SET AJOSRECX , WHICH WILL STOP ANY 04421100 +* ASSIST MODULE, THE NEXT TIME ANY OUTPUT IS DONE. 04421200 + TM AJOSTEP,AJOSDUMP ARE WE IN DUMP STEP J 04421250 + BZ *+8 NO, SKIP OVER OVERRUN SET 04421260 + OI AJOMODE,AJOSRECX SHOW RECORDS EXCEEDED(PSEUDO) 04421300 +ASTEXIZ EQU * 04422000 + AIF (&$ASMLVL).ASTEXEX SKIP IF UNDER OS GENERATION 04422200 + EXIT IT RETURN TO DOS SUPERVISOR 04422400 +ASTSAVAD DC 18F'-1' DOS -IT- INTERRUPT SAVE AREA 04422600 +ASTMRMDS DS F TIME OF DAY FOR TIMER INTERRUPT 04422800 +.ASTEXEX AIF (NOT &$ASMLVL).ASTEX2 SKIP IF UNDER DOS GENERATION 04423000 + LM R14,R12,12(R13) RELOAD REGS 04424000 + BR R14 RETURN TO OS/360 04426000 +.ASTEX2 ANOP 04427000 + DROP R15 KILL THE USING 04428000 +.AST65A ANOP 04429000 + EJECT 04430000 +* PRIMARY SPACE ALLOCATION CONTROL WORDS * 04432000 +ASSPACE DC A(8192,524288) GET ALL WE CAN, UP TO 512 K 04434000 +ASTBEGIN DS F FOR TIME LEFT AT BEGINNING 04442000 +ASFWORK DS F TEMPORARY WORKAREA 04444000 +ASPARMSV DS A SAVE WORD FOR @ PARM FILED,ETC 04446000 + SPACE 1 04448000 +* *** HEADER FOR BEGINNING OF EACH JOB *** 04448100 +ASH1HD DC C'1*** ASSIST &$VERSLV-&$GENDAT' CPP 04448200 + DC C' &$MCHNE/&$MODEL:&$SYSTEM' CPP 04448250 +* INSTRUCTION SET-DECIMAL,FLOAT,PRIVIL 04448300 + DC C' INS=S',(&$DECSA)C'D',(&$FLOTA)C'F',(&$PRIVOP)C'P' 04448400 + DC (&$S370A)C'7' SUPPORT DEC. FLOAT, PRIV, 370 CPP 04448450 + DC C'/X=',(&$XIOS)C'B',(1-&$XXIOS)C'G',(&$HEXI*&$HEXO)C'H' 04448460 + DC (&$EXINT)C'O' SUPPORT BASIC,XGET,HEXS,XOPC CPP 04448470 + DC ((1-(&$HEXI+&$HEXO+&$XIOS+&$EXINT+3)/4)*&$XXIOS)C'NONE' 04448480 +* TIME,RECORDS,PAGE CHECKING/CONTROL 04448500 + DC C', CHECK/TRC/=&$TIMER&$RECORD&$COMNT' CPP 04448600 +* MAJOR OPTIONALS-CMPRS,COMNT, 04448700 +* 026 KEYPUNCH, MACRO, REPLACE MONITOR 04450000 + DC C', OPTS=',(&$CMPRS)C'C',((&$DISKU+1)/2)C'D' CPP 04452000 + DC (&$KP26)C'K',(&$MACROS)C'M',(&$PAGE)C'P' CPP 04452050 + DC ((&$REPL+1)/2)C'R',(&$XREF)C'X' CPP 04453000 + DC C' PENN STATE UNIV ***' CPP 04454000 +ASH1H$L EQU *-ASH1HD LENGTH OF THIS HEADER 04458000 + SPACE 1 04460000 +* EDIT PATTERN, OUTPUT HEADINGS * 04462000 + AIF (&$TIMER LT 1).AST70A SKIP EDIT PATTERN 04463000 +ASPATA DC X'40202021204B202020' EDIT PATTERN FOR TIMING 04464000 +ASPAL EQU L'ASPATA LENGTH ATTRIB OF EDIT TIME PATTERN 04464500 +.AST70A ANOP 04465000 +ASPATB DC X'4020202020202120' EDIT PATTERN FOR # INSTRUCTIONS DONE 04466000 +ASPBL EQU L'ASPATB LENGTH ATTRIB OF STMT EDIT PATTERN 04470000 + SPACE 1 04472000 + AIF (&$TIMER GT 0).AST75A SKIP IF NOT =0 04472100 +* EXECUTION STATISTICS MESSAGE FOR &$TIMER=0 ONLY. 04472200 +ASHEX DC C'0*** EXECUTION:' 04472300 +ASHEXP2 DC ZL(ASPBL)'0',C' INSTRUCTIONS EXECUTED ***' 04472400 +ASHEXL EQU *-ASHEX LENGTH OF MESSAGE 04472500 +.AST75A AIF (&$TIMER EQ 0).AST80A SKIP MESSAGES IF UNNEEDED 04473000 +ASHASM DC C'0*** ASSEMBLY TIME =' 04474000 +ASHASMP DS CL(ASPAL) 04476000 + DC C' SECS, ' 04478000 +ASHASMN DC ZL(ASPBL)'0',C' STATEMENTS/SEC ***' 04480000 +ASHASML EQU *-ASHASM DEFINE LENGTH OF MESSAGE 04482000 + SPACE 1 04484000 +ASHEX DC C'0*** EXECUTION TIME =' 04486000 +ASHEXP DS CL(ASPAL) 04488000 + DC C' SECS. ' 04490000 +ASHEXP2 DC ZL(ASPBL)'0',C' INSTRUCTIONS EXECUTED - ' 04492000 +ASHEXN DC ZL(ASPBL)'0',C' INSTRUCTIONS/SEC ***' 04494000 +ASHEXL EQU *-ASHEX DEFINE TOTAL LENGTH OF MESSAGE 04496000 +.AST80A ANOP 04497000 +ASCARDMS DC C'*** FIRST CARD NOT READ: ' CARD MESSAGE J 04497100 + SPACE 1 04498000 +ASEMSG DC C'0*** AM003 - STORAGE OVERFLOW BEFORE EXECUTION, EXECUTX04500000 + TION DELETED ***' 04502000 + SPACE 1 04504000 +ASNORMAL DC C'0*** AM004 - NORMAL USER TERMINATION BY RETURN ***' 04506000 + SPACE 1 04508000 +ASRTOVR DC C'0*** AM005 - TIME OR RECORDS HAVE BEEN EXCEEDED' 04510000 + SPACE 1 04512000 + AIF (&$TIMER LT 2).AST90A SKIP END MESSAGE IF ^NEED 04513000 +ASHEND DC C'0*** TOTAL RUN TIME UNDER ASSIST = ' 04514000 +ASHENDP DC ZL(ASPAL)'0',C' SECS ***' 04516000 +ASHENDL EQU *-ASHEND LENGTH OF MESSAGE 04518000 + SPACE 1 04519000 +.AST90A ANOP 04519500 +ASHEXGO DC C'0*** PROGRAM EXECUTION BEGINNING - ANY OUTPUT BEFORE EX04520000 + XECUTION TIME MESSAGE IS PRODUCED BY USER PROGRAM ***' 04522000 + SPACE 2 04522100 +* ***** PARM FIELD OPTION LISTS ***** 04522200 + SPACE 1 04522300 +* ASPARLIM - SUPPLIES LIMIT VALUES FOR NUMERICAL PARMS, 04522400 +* PLUS DEFAULT VALUES FOR ANY OVERRIDABLE VALUES. 04522500 +* **NOTE** MOST OF OVERRIDABLE ONES COULD BE SUPPLIED 04522600 +* IN DEFAULT PARM FIELD BELOW ALSO. 04522700 +ASPARLIM DS 0D ALIGN 04522800 +* UPPER LIMIT VALUES-CANNOT BE INCREASED BEYOND THESE. 04522900 + DC C'I=&$IMX' MAXIMUM INSTRUCTION COUNT 04523000 + AIF (NOT &$PAGE).ASPL10 SKIP IF NO PAGE CONTROL 04523100 + DC C',L=&$LMX,P=&$PMX,PD=&$PDMX,PX=&$PXMX' PAGE LIMITS 04523200 +.ASPL10 ANOP 04523300 + DC C',R=&$RMX,RD=&$RDMX,RX=&$RXMX' RECORD LIMITS 04523400 + AIF (&$TIMER EQ 0).ASPL20 SKIP IF NO TIMING 04523500 + DC C',T=&$TMX,TD=&$TDMX,TX=&$TXMX' TIME LIMITS 04523600 +.ASPL20 ANOP 04523700 + SPACE 1 04523800 +* OVERRIDABLE DEFAULT VALUES FOR RESETTABLE PARM OPTIONS. 04523900 + DC C',&$BATCH,NOCMPRS,NOCOMNT,DUMP=0,FREE=&$FREE' 04524000 + DC C',LIST,LOAD,NOMONIT,NERR=0' (LARGE NO LONGER EXISTS) J 04524100 + AIF (NOT &$DATARD).ASPL25 SKIP IF NO DATA RDR 04524200 + DC C',DATA,SYSIN' DEFAULT - THEY BOTH EXIST 04524300 +.ASPL25 ANOP 04524400 + AIF (&$DEBUG).ASPL30 SKIP IF NO DEBUG 04524500 + DC C',DEBUG=0' NO VALUE FOR DEBUG 04524600 +.ASPL30 ANOP 04524700 +*********AIF (NOT &$EXINT).ASPL35 **********NEW INTERPRETER****** 04524710 + DC C',IECF=0' DEFAULT: NO STATISTICS 04524720 +.ASPL35 ANOP 04524730 + AIF (NOT &$KP26).ASPL40 SKIP IF NO ALTERNATE KEYPINCH 04524800 + DC C',KP=29' DEFAULT IS 029 04524900 +.ASPL40 ANOP 04525000 + AIF (NOT &$PAGE).ASPL50 SKIP IF NO PAGE CONTROL 04525100 +* CHANGE BELOW TO ---CPAGE TO PAGE CONTROL DEFAULT. 04525200 + DC C',NOSS,NOSSX,NOSSD,CPAGE' MAKE CPAGE DEFAULT IF GEN J 04525300 +.ASPL50 ANOP 04525400 + AIF (&$DISKU NE 1).ASPL60 SKIP 04525500 + DC C',NODISKU' NORMAL - DO INCORE 04525600 +.ASPL60 ANOP 04525700 + AIF (NOT &$PUNCH).ASPL70 SKIP IF NOPUNCH 04525800 + DC C',PUNCH' REAL PUNCH EXISTS 04525900 +.ASPL70 ANOP 04526000 + AIF (&$REPL EQ 0).ASPL90 SKIP IF NO REPLACE 04526100 + DC C',NOREPL,RFLAG=0' 04526200 +.ASPL90 ANOP 04526300 + AIF (NOT &$PRIVOP).ASPL100 SKIP IF NO PRIVILEGED OPS 04526400 + DC C',NOSUPER' 04526500 +.ASPL100 ANOP 04526600 + AIF (NOT (&$DECK OR &$OBJIN)).ASPL110 SKIP IF NO DECKS 04526610 + DC C',NODECK,NOOBJIN' 04526620 +.ASPL110 ANOP 04526630 + AIF (NOT &$RELOC).ASPL120 SKIP IF NO RELOC MODE 04526640 + DC C',NORELOC' MAKE NON RELOCATED NORMAL MODE 04526650 +.ASPL120 ANOP 04526660 + AIF (&$S370 NE 2).ASPL130 SKIP IF NOT SIMULATING S/370 04526666 + DC C',ALGN' MAKE DEFAULT ALGN (ALIGNMENT NEEDED) 04526668 +.ASPL130 ANOP 04526670 + AIF (NOT &$MACROS).ASPL140 SKIP IF NO MACROS 04526672 + DC C',MACRO=N,MACTR=&$MMACTR,MNEST=&$MMNEST,MSTMG=&$MMSTMG' 04526674 + AIF (NOT &$MACSLB).ASPL135 SKIP IF NO LIBRARY MACS 04526676 + DC C',NOLIBMC' DEFAULT = NO CALL LIBR MCS 04526678 +.ASPL135 ANOP 04526680 +.ASPL140 ANOP 04526682 + AIF (NOT &$XREF).NOXREF6 SKIP IF NO XREF A 04526683 + DC C',XREF=(&$XREFDF(1),&$XREFDF(2),&$XREFDF(3))' DEFAULTA 04526685 +.NOXREF6 ANOP A 04526690 + DC C' ' PUT IN BLANK AT END*****MUST HAVE*** 04526700 +ASPARL$L EQU *-ASPARLIM LENGTH OF ENTIRE FIELD 04526800 + SPACE 2 04526900 +* DEFAULT VALUES FOR LIMIT VALUES AND NONRESETTABLE PARMS. 04527000 +ASPARDF DS 0D ALIGN 04527100 + AIF (NOT &$PAGE).ASPD10 SKIP IF NO PAGE CONTROL 04527200 + DC C'L=&$LDF,P=&$PDF,PD=&$PDDF,PX=&$PXDF,' 04527300 +.ASPD10 ANOP 04527400 + DC C'R=&$RDF,RD=&$RDDF,RX=&$RXDF' RECORD DEFAULTS 04527500 + AIF (&$TIMER EQ 0).ASPD20 SKIP IF NO TIMER 04527600 + DC C',T=&$TDF,TD=&$TDDF,TX=&$TXDF' 04527700 +.ASPD20 ANOP 04527800 + DC C' ' PUT IN BLANK AT END*****MUST HAVE*** 04527900 +ASPARD$L EQU *-ASPARDF LENGTH OF THIS PARM FIELD 04528000 + SPACE 1 04528100 + LTORG 04528200 + SPACE 1 04528300 +* FOLLOWING SECTION CORRESPONDS TO AJOBCON DSECT. * 04530000 +ASJOBCON DS 0D 04532000 + DC 16F'0' FOR ZEROING 04534000 + DC F'1000' FOR CONVERSION, AJ1000 04535000 + AIF (&$ASMLVL).ASJOSTU SKIP TO SET OS TIMER UNIT=26.04 04535200 + DC F'333334' DOS TIMER UNITS(USEC) * 100 04535400 +.ASJOSTU AIF (NOT &$ASMLVL).ASJDSTU SKIP IF DOS TU OF 1/300 SEC 04535600 + DC F'2604' FOR TIME CONVERSIONS 04536000 +.ASJDSTU ANOP 04537000 + DC F'100000' FOR TIME CONVERSIONS 04538000 + DC F'100000000' 100 MILLION, TIME CONVERSIONS 04540000 + DC V(VWXTABL) @ MAIN ASSEMBLER TABLE 04541000 + DC V(EXECUT) ADCON FOR INTERPRETER CODE 04541500 + DS 0D 04542000 + AIF (NOT &$KP26).ASNKP26 SKIP IF NO 026 KEYPUNCH ALL 04542050 + SPACE 1 04542100 +* TRANSLATE TABLE - 026-->029 KEYPUNCH. ALLOWS KP=26. 04542150 +* 0 1 2 3 4 5 6 7 8 9 A B C D E F SAME EXCEPT )+(=' 04542200 + DC X'000102030405060708090A0B0C0D0E0F' 0X 04542250 + DC X'101112131415161718191A1B1C1D1E1F' 1X 04542300 + DC X'202122232425262728292A2B2C2D2E2F' 2X 04542350 + DC X'303132333435363738393A3B3C3D3E3F' 3? 04542400 + DC X'404142434445464748494A4B5D4D4E4F' 4X ) 4C 04542450 + DC X'4E5152535455565758595A5B5C5D5E5F' 5X + 50 04542500 + DC X'606162636465666768696A6B4D6D6E6F' 6X ( 6C 04542550 + DC X'707172737475767778797A7E7D7D7E7F' 7X = 7B ' 7C 04542600 + DC X'808182838485868788898A8B8C8D8E8F' 8X 04542650 + DC X'909192939495969798999A9B9C9D9E9F' 9X 04542700 + DC X'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF' AX 04542750 + DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' BX 04542800 + DC X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF' CX 04542850 + DC X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF' DX 04542900 + DC X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF' EX 04542950 + DC X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF' FX 04543000 + SPACE 1 04543050 +.ASNKP26 ANOP 04543100 + DC CL136' ' FOR BLANKING 04544000 + DC C'0' FOR CARRIAGE ONTROL 04546000 + ORG ASJOBCON+AJOB$L GET REMAINING LENGTH FOR SECTION 04548000 + DS 0D SEE WHAT LENGTH IS 04550000 + DROP R10,R11,R13 KILL LEFTOVER USINGS 04552000 + TITLE '*** APCBLK DSECT - APARMS PARM CODE BLOCK ***' 04552100 +**--> DSECT: APCBLK APARMS PARM CODE BLOCK. . . . . . . . . . . . . 04552200 +*. THIS BLOCK DESCRIBES A PARM OPTION TABLE, GIVING THE NAME OF . 04552300 +*. THE PARM, A FLAG BYTE, AND AN OFFSET ADDRESS TO A PROCESSING . 04552400 +*. SECTION OF CODE IN CSECT APARMS. IT IS USED ONLY IN APARMS. . 04552500 +*. LOCATION: INSIDE TABLE APBPARMA IN CSECT APARMS. . 04552600 +*. GENERATION: EACH APCBLK IS CREATED BY 1 CALL TO APCGN MACRO. . 04552700 +*. NAMES: APC----- . 04552800 +*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 04552900 + SPACE 1 04554000 +APCBLK DSECT 04556000 +* EQU FLAG LIST FOR APCFLAG) - GIVE HANDLING TYPES. 04556050 +APCYESNO EQU B'00000001' (APCFLAG)- YES/NO PARM;ELSE =PARM 04556100 +APCYES1B EQU B'00000010' (APCFLAG)- FOR YES/NO TYPE PARMS 04556150 +* ON=> 1BIT=>YES;OFF=> 1BIT=> NO 04556200 +APCNINCR EQU B'00000010' (APCFLAG)- IF =PARM DECIMAL VALUE 04556250 +* IF VALUE SET, DO NOT INCREMENT 04556300 +APCD EQU B'00000100' (APCFLAG)- PARM=DECIMAL # VALUE 04556350 +APCNRSET EQU B'00001000' (APCFLAG)- ONCE SET, DO NOT RESET 04556400 +APCCALL EQU B'00010000' (APCFLAG)- CALL ROUTINE -APCADDR @ 04556450 +APCSETU EQU B'00100000' (APCFLAG)-VALUE SET BY USER-$JOB CRD 04556500 +APCSETP EQU B'01000000' (APCFLAG)-VALUE SET FROM REAL PARM 04556550 +APCSETLD EQU B'10000000' (APCFLAG)- VALUE WAS SET BY LIMIT 04556600 +* OR DEFAULT VALUE. 04556650 +APCSET EQU APCSETLD+APCSETU+APCSETP VALUE SET BY ANYBODY 04556700 +APCP$L EQU AJOCP$L LENGTH OF MAXIMUM # CHARS IN PARM 04556750 + SPACE 1 04556800 +* VARIABLES IN APCBLK - GIVE PARM NAME AND FLAGS 04556850 +APCPARM DS CL(APCP$L) EBCDIC FORM OF PARM, R-PADDED BLANKS 04556900 +APCFLAG DS B FLAGS- DESCRIBE TYPE OF HANDLING 04556950 +APCAJOFS DS AL1 OFFSET OF VARIABLE FROM AJO$PARM 04557000 +APCLKSET DS B FLAG SHOWING WHICH CALL SET/IF SET 04557050 +APCBITS DS B FLAG USED TO SET FOR YES OPT OF Y/N 04557100 + ORG APCBITS BACK UP TO OVERLAY FOR =PARM 04557150 +APCADDR DS AL1 OFFSET FROM APAJUMP TO ROUTINE 04557200 +APC$L EQU *-APCBLK LENGTH OF 1 APCBLK 04576000 + TITLE '*** APARMS - USER PARM FIELD PROCESSING CSECT ***' 04577000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04577025 +*--> CSECT: APARMS USER PARM FIELD PROCESSING CSECT * 04577050 +* SCANS USER PARM FIELD, SETS VALUES IN AJOBCON DSECT. * 04577100 +* ENTRY CONDITIONS * 04577150 +* R9 = @ OF ACTUAL PARM FIELD CHARACTER STRING. * 04577200 +* R10= LENGTH OF PARM FIELD AT 0(R9). * 04577220 +* R11= ADDRESS OF AJOBCON DUMMY SECTION AREA. * 04577250 +* EXIT CONDITIONS * 04577300 +* AJOPARM IN AJOBCON NOW HAS USER PARM FIELD, RIGHT-PADDED WITH ' '.* 04577350 +* VARIOUS FLAGS IN AJOBCON ARE NOW SET(SEE CODE STARTING AT APAJUMP)* 04577400 +* USES DSECTS: AJOBCON,APCBLK * 04577420 +* USES MACROS: $DBG,$RETURN,$SAVE,$TIRC,APCGN,XDECI * 04577440 +* *NOTE* AS OF 8/12/70, THIS PROGRAM IS MORE GENERAL THAN * 04577450 +* CURRENTLY NEEDED, TO ALLOW FOR FUTURE NEW PARM OPTIONS. * 04577500 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04577550 + SPACE 1 04577600 +APARMS CSECT 04578000 + $DBG ,NO SHOW NO DEBUG CODE FROM $SAVE/RETURN 04580000 + SPACE 1 04582000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04583000 +* REGISTER USAGE AND CONVENTIONS IN APARMS CSECT * 04584000 +* R0,R1,R2 = TEMPORARY WORK REGISTERS * 04586000 +* R3 ADDRESS OF CURRENT APCBLK WHEN LOOKING DOWN PARM LIST * 04588000 +* R4 = APCP$L = LENGTH OF 1 APCBLK. USED AS INCREMENT IN BXLE'S. * 04590000 +* R5 = @ LAST APCBLK IN TABLE OR PART OF TABLE SEARCHED, BXLE LIMIT.* 04592000 +* R6 = SCAN POINTER TO NEXT CHARACTER TO BE PROCESSED IN PARM FIELD * 04594000 +* R7 = 1 CONSTANT FOR USE IN BXH'S AND INCREMENTING,DECREMENTING* 04596000 +* R8 = BASE REGISTER * 04598000 +* R9 = @ PARM FIELD ON INPUT. USED AS BYTE REGISTER THEREAFTER. * 04600000 +* R10= LENGTH OF PARM FIELD ON INPUT. @ LAST BYTE OF PARM AS LIMIT @* 04602000 +* R11= @ AJOBCON BLOCK, ON INPUT AND UNCHANGED * 04604000 +* R12 (UNUSED) * 04606000 +* R13= @ CALLING PROGRAM'S SAVE AREA, UNCHANGED * 04608000 +* R14= INTERNAL LINK REGISTER, WORK REGISTER * 04610000 +* R15= TEMPORARY WORK REGISTER * 04612000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04614000 + SPACE 1 04616000 + USING AJOBCON,R11 NOTE POINTER TO JOB TABLE 04618000 + $SAVE RGS=(R14-R12),SA=NO,BR=R8 04620000 + EJECT 04622000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04624000 +* INITIALIZATION SECTION * 04626000 +* INITIALIZE FLAGS IN LEADING NIBBLES OF APCFLAG BYTES. * 04628000 +* CHECK TO SEE IF A PARM FIELD WAS USED. IF SO, MOVE IT OVER * 04630000 +* TO INTERNAL AREA, WITH BLANKS FOLLOWING, TO MAKE SCANNING * 04632000 +* EASIER AND USE LESS REGISTERS. SET UP FOR DOING ANALYSIS. * 04634000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04636000 + SPACE 1 04638000 + LA R4,APC$L FOR INCREMENT ON MANY BXLE'S 04642000 + USING APCBLK,R3 NOTE USING, WILL USE R3 ALWAYS 04646000 + SPACE 1 04648000 +* ***** TEST FOR FLAG RESET REQUIRED. DO SO IF NEEDED **** 04648500 + TM AJOAPMOD,AJOAPRSE WAS THIS CALL A RESET CALL 04649000 + BZ APNOTRSE NO, SO SKIP RESET THIS TIME 04649500 + LA R3,APBPARMA @ BEGINNING OF TABLE 04650000 + LA R5,APBPARMB-APC$L @ LAST ELEMENT IN TABLE 04650250 + SPACE 1 04650500 + NI APCLKSET,255-APCSET REMOVE ALL SET FLAGS 04652000 + BXLE R3,R4,*-4 LOOP THRU TABLE 04654000 + SPACE 1 04656000 +APNOTRSE EQU * EXIT HERE IF NOT A RESET CALL 04657000 + LA R7,1 USEFUL CONSTANT 04658000 + LR R6,R10 MOVE LENGTH OF PARM OVER 04658200 +* IF AJOAPMOV SET, LEAVE PARM WHERE IT IS (MUST BE LIMIT 04658400 +* OR DEFAULT, WHICH HAVE BLANK AFTER PARM.) 04658600 + TM AJOAPMOD,AJOAPMOV SHOULD IT BE MOVED 04658800 + BO *+12 YES, GO TO MOVE AND PAD CODE 04659000 + LR R6,R9 MOVE BEGINNING ADDRESS OVER TO INIT 04659200 + AR R10,R9 ADD BEGIN TO LENGTH GIVING END IN 10 04659400 + B APMINIT SKIP OVER TO INIT CODE 04659600 + MVC AJOPARM,AJOBLANK+1 BLANK OUT ENTIRE PARM AREA 04659800 + SR R6,R7 DECREMENT FOR MVC,CHECK FOR SIGN 04666000 + BM APFINE THERE WAS NO PARM FIELD,BRANCH 04668000 + LA R0,AJOP$L-1 LENGTH-1 OF MAXIMUM PARM FIELD 04670000 + CR R6,R0 IS LENGTH SMALL ENOUGH 04672000 + BNH *+6 SKIP IF LEGAL 04674000 + LR R6,R0 TOO BIG,USE MAXIMUM 04676000 + STC R6,*+5 STORE THIS LENGTH INTO MVC 04678000 + MVC AJOPARM($),0(R9) MOVE PARM FIELD OVER, R-PAD WITH BL 04679000 + AIF (NOT &$KP26).APNKP2T SKIP IF NO 026 KEYPUNCH 04679100 + STC R6,*+5 PUT LENGTH INTO TR 04679200 + TR AJOPARM($),AJTRTB26 TRANSLATE SO WILL PRINT RIGHT 04679300 +.APNKP2T ANOP 04679400 + LA R10,AJOPARM(R6) SET LIMIT @ FOR SCANNING 04681000 + LA R6,AJOPARM INIT SCAN POINTER TO BEGINNING 04682000 +APMINIT EQU * ENTRY TO BEGIN INIT FOR SCANNING 04682200 + SR R9,R9 CLEAR FOR USE AS BYTE REG AFTER NOW 04682400 + MVC APFLOCKT+1(1),AJOAPSET MOVE INTO TM INSTR TO TEST LOCK 04683000 + EJECT 04684000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04686000 +* PARAMETER FIELD SCAN SECTION * 04688000 +* CHECK FOR PARM BEGINNING WITH 'NO', AND SET FLAGS IF * 04690000 +* FOUND. SCAN FOR , = OR BLANK TERMINATING PARM, SAVING UP TO * 04692000 +* FIVE CHARS OF PARM, RIGHT-PADDED WITH BLANKS, FOR LOOKUP. * 04694000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04696000 + SPACE 1 04698000 +APMSCAN EQU * BEGINNING OF SCAN FOR 1 PARM OPTION 04700000 + CLI 0(R6),C' ' SEARCH FOR NONBLANK 04702000 + BNE *+8 FOUND NONBLANK, EXIT LOOP 04704000 +APMSCANX BXH R6,R7,APFINC BUMP SCAN PTR, GO TO CHECK FOR END 04706000 + SPACE 1 04707000 + SR R2,R2 SHOW EXPECTED POSTIVE PARM 04708000 + AIF (&$DEBUG).APND1 SKIP IF PRODUCTION 04710000 + XSNAP STORAGE=(*AJOPARMA,*AJIOFLAG),LABEL='APMSCAN', X04712000 + IF=(AJODEBUG,O,1,TM) SNAP IF DEBUG ON 04714000 +.APND1 ANOP 04716000 + CLC 0(2,R6),=C'NO' IS PARM PRECEDED BY NO 04718000 + BNE APMSCA NO,SO SKIP,LEAVING R2 SET 04720000 + LA R2,2 SET TO SHOW NO VALUE 04722000 + AR R6,R2 ADD 2 TO SCAN PTR, BEYOND 'NO' 04724000 + SPACE 1 04726000 +* SEARCH FOR A POSSIBLE DELIMITER CHARACTRER (^ALPHABETIC) 04726100 +APMSCA EQU * 04726200 + LR R15,R6 SAVE @ OF BEGINNING OF PARM 04726300 + CLI 0(R6),C'A' IS IT A DELIMITER 04726400 + BL *+8 PROBABLY-BRANCH OUT 04726500 + BXH R6,R7,*-8 LOOP UNTIL FIND (NOT BLANKS END PRM) 04726600 + SPACE 1 04726700 + LR R1,R6 @ DELIMITER 04726800 + SR R1,R15 R1 = LENGTH OF PARM 04726900 + BNP APMSCANX EXTRA DELIMITER-GO TO IGNORE IT 04727000 + SR R1,R7 R1= LENGTH(PARM OPTION) - 1 04727100 + LA R0,APCP$L-1 MAXIMUM POSSIBLE LENGTH-1 OF PARM 04727200 + CR R1,R0 WAS PARM TOO LONG TO BE LEGAL ONE 04727300 + BH APMSCANX YES, SO IGNORE IT 04727400 +* **NOTE** COULD CHANGE ABOVE TO ALLOW TRUNC OF LONG PARMS 04727500 + STC R1,APMSCMVC+1 STORE LENGTH-1 INTO MVC 04727600 + MVC AJOCOMP,AJOBLANK FILL PARM WITH BLANKS 04727700 +APMSCMVC MVC AJOCOMP($),0(R15) MOVE OPTION IN, PAD WITH BLANKS 04727800 + AR R6,R7 POSITION SCAN PTR BEYOND DELIMITER 04727900 + EJECT 04758000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04760000 +* PARAMETER LOOKUP AND FLAGGING * 04762000 +* USING 1ST LETTER OF OPTION AS TABLE INDEX, SEARCH SECTION * 04762100 +* OF LOOKUP TABLE FOR IT. IF NOT FOUND, IGNORE IT. IF FOUND, * 04762200 +* USE BITS OF ITS APCFLAG TO DETERMINE HANDLING. IF THIS CALL * 04762300 +* ACTUALLY SETS A VARIABLE, OR INTO ITS APCFLAG BIT(S) SHOWING * 04762400 +* WHAT TYPE CALL PRODUCED THIS VALUE, FOR LATER CHECKING. * 04762500 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04776000 + SPACE 1 04776100 + CLI AJOCOMP,C'Z' MAKE SURE CHARACTER OK (NOT DIGIT) 04776200 + BH APFINC BAD OPTION NAME-IGNORE IT 04776300 + IC R9,AJOCOMP GET FIRST LETTER OF OPTION 04776400 + LA R5,B'00111100' MASK FOR MIDDLE 4 BITS OF OPTION 04776500 + NR R9,R5 MASK OUT ALL BUT MIDDLE BITS 04776600 + SRL R9,1 SHIFT FOR HALFWORD INDEX VALUES 04776700 + LA R3,APBPARMA BEGINNING OF TABLE @ 04776800 + AH R3,APLNDX(R9) = @ BEGINNING OF TABLE SECTION 04776900 + LA R5,APBPARMA-APC$L @ BEGINNING - 1 ELEMENT LENGTH 04777000 + AH R5,APLNDX+2(R9) = @ LAST POSSIBLE ELEMENT IN SECTION 04777100 +* AT THIS PT, R3 IS INDEX, AND R5 LIMIT FOR ENSUING BXLE 04777200 + SPACE 2 04777300 +APLOOK CLC AJOCOMP,APCPARM COMPARE NEW PARM WITH TABLE ENTRY 04780000 + BE APFOUND SKIP OUT IF FOUND 04782000 + BXLE R3,R4,APLOOK LOOP THRU TABLE 04784000 + B APFINC FELL THRU, NOT IN TABLE, IGNORE IT 04786000 + SPACE 1 04788000 +APFOUND EQU * EXIT HERE WHEN PARM IDENTIFIED 04790000 + AIF (&$DEBUG).APND2 SKIP IF PRODUCTION 04796000 + XSNAP LABEL='APFOUND',STORAGE=(*APCBLK,*APCBLK+8), #04798000 + IF=(AJODEBUG,O,1,TM) SNAP FOUND BLOCK,IF DEBUG 04800000 +.APND2 ANOP 04802000 +APFLOCKT TM APCFLAG,$ CAN THIS PARM BE SET BY CURRENT CALL 04802020 + BNO APFNOSET NO,SO IGNORE HIM 04802040 + IC R9,APCAJOFS GET OFFSET IN AJOBCON TO VARIABLE 04802060 +* IF PARM=DECIMAL #, CONVERT THE VALUE INTO R0. 04802080 + TM APCFLAG,APCD WAS THIS DECIMAL CONVERT 04802100 + BZ *+8 NO, SKIP CONVERT 04802120 + BAL R14,APDECON CALL ROUTINE TO SCAN, PUT VALU IN R0 04802140 +* IF VALUE NOT SET PREVIOUSLY, SKIP TO TEST FOR TYPE 04802160 + TM APCLKSET,APCSET HAS IT BEEN SET ALREADY BY ANYBODY 04802180 + BZ APFTYPE NO, SO SAFE TO DO IT THIS TIME 04802200 +* HAS ALREADY BEEN SET-CHECK IF CAN DO IT AGAIN. 04802220 + TM APCFLAG,APCNRSET IS IT ALLOWED TO BE RESET 04802240 + BO APFNOSET NOT ALLOWED TO RESET-SKIP OUT 04802260 + TM APCLKSET,APCSETU+APCSETP WAS IT SET BY $JOB 04802280 + BZ APFDFSK NO, SKIP CHECK FOR DEFAULT-OK TO SET 04802300 + TM AJOAPMOD,AJOAPDEF IS THIS DEFAULT TYPE CALL 04802320 + BO APFNOSET YES, JUMP OUT-DON'T OVERRIDE VALUE 04802340 +APFDFSK EQU * 04802360 +* IF PARM IS YES/NO TYPE, GO TO RESET ITS VALUE 04802380 + TM APCFLAG,APCYESNO WAS IT YES/NO TYPE 04802400 + BO APFYESNO YES, SO GO PROCESS IT 04802420 + SPACE 1 04802440 +* ***** PARM=VALUE PROCESSING ***** 04802460 + TM APCFLAG,APCNINCR SEE IF DECIMAL# AND CAN'T INCR 04802480 + BZ APFCALL ALLOWABLE TO CHANGE-GO SEE IF CALL 04802500 +* VARIABLE ALREADY SET AND NEW VALUE SUPPLIED. VALUE 04802520 +* CAN BE RESET IF IT IS LESS THAN OR EQUAL OLD ONE. 04802540 + C R0,AJO$APC(R9) COMPARE (ASSUMES FULLWORD VALUE) 04802560 + BH APFNOSET TOO HIGH-IGNORE HIM 04802580 +* IF FLAGGED, CALL INDIVIDUAL PROCESSING ROUTINE. 04802600 +* THIS TAKES CARE OF SPECIAL CASES. 04802620 +APFCALL TM APCFLAG,APCCALL DOES PARM REQUIRE CALL 04802640 + BZ APFSTORE NO, SO JUST STORE VALUE(ASSUMED F) 04802660 + IC R2,APCADDR GET OFFSET @ OF ROUTINE 04802680 + LA R14,APFSET RETURN @ TO SHOW VALUE SET 04802700 + B APAJUMP(R2) GO TO THE ROUTINE INDICATED 04802720 +* **NOTE- ROUTINE WILL EXIT TO R14(SET) OR APFNOSET. 04802740 +APFSTORE ST R0,AJO$APC(R9) STORE THE COMPUTED VALUE 04802760 + B APFSET GO TO FLAG THAT VALUE HAS BEEN SET 04802780 +* TYPE TEST - DEFINITELY LEGAL TO SET NEW VALUE. 04802800 +APFTYPE TM APCFLAG,APCYESNO WAS IT YES/NO TYPE PARM 04802820 + BZ APFCALL NO WAS = PARM OR SPECIAL-GO DO IT 04802840 +* ***** YES/NO PARM PROCESSING ***** 04802860 +* AT THIS POINT R2=0 => YES VALUE, R2=2 => NO VALUE. 04802880 +* R9 = OFFSET FROM AJO$APC TO BYTE TO BE FLAGGED. 04802900 +* DETERMINE POLARITY OF FLAG BYTE AND SET ACCORDINGLY. 04802920 +APFYESNO TM APCFLAG,APCYES1B DOES A YES VALUE => A BIT ON 04802940 + BO *+6 YES, SO LEAVE R2 AS IS/SKIP 04802960 + AR R2,R7 NO. YES VALUE=> BIT OFF-INCREM R2 04802980 + LA R14,AJO$APC(R9) GET ACTUAL @ BYTE TO BE SET 04803000 + OC 0(1,R14),APCBITS SET BIT(S) DEFINITELY ON 04803020 + IC R2,APFYNTAB(R2) GET THE BYTE FROM CONTROL TABLE 04803040 + LTR R2,R2 MUST WE NOW RESET GIVEN BIT TO 0 04803060 + BNZ *+10 NO, SKIP SINCE BIT SET TO 1 OK 04803080 + XC 0(1,R14),APCBITS YES, MUST TURN BIT OFF TO BE RIGHT 04803100 + SPACE 1 04803120 +* ***** COMMON PARM VALUE SETTING EXITS ***** 04803140 +APFSET EQU * VALUE WAS ACTUALLY SET THIS TIME 04803160 + OC APCLKSET,AJOAPSET OR IN TO SHOW WHO ACTUALLY SET VALUE 04803180 +APFNOSET EQU * EXIT HERE IF NOT SET THIS TIME 04803200 +APFINC CR R6,R10 HAVE WE REACHED END YET(R10=LIMIT @) 04826000 + BL APMSCAN NO,RETURN FOR NEXT PARM 04828000 + EJECT 04830000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04832000 +* COMPLETION SECTION * 04834000 +* IF AJOAPMOD WAS FLAGGED WITH AJOAPFIN, THE CURRENT CALL TO * 04836000 +* APARMS IS THE LAST BEFORE ASSEMBLY BEGINS. ANY OPTION NEEDING* 04837000 +* IT MAY THEN TEST THE SET BITS IN ITS APCFLAG TO DETERMINE * 04838000 +* WHERE THE PARM CAME FROM WHICH ACTUALLY SET ITS VALUE. * 04840000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04842000 + SPACE 1 04844000 +APFINE EQU * EXIT HERE AT END OF 1 COMPLETE SCAN 04844050 + TM AJOAPMOD,AJOAPFIN WAS THIS LAST CALL 04844100 + BZ APNOTLST NO, SO DON'T MAKE CHECKS 04844150 + AIF (&$TIMER LT 2).APFNNT SKIP IF NOT SPECIAL TIMER 04844200 + SPACE 1 04844250 +* FLAG AJOAPMOD IF USER ACTUALLY SUPPLIED T=. IF HE DID 04844300 +* NOT, ASSIST WE USE TIMREM VALUE INSTEAD OF DEFAULT, 04844350 +* THUS ALLOWING MORE PRECISE CONTROL OVER TIME. 04844400 + TM APBT+(APCLKSET-APCBLK),APCSETU+APCSETP VALUE FROM $J,PAR 04844450 + BZ *+8 NO,DON'T SET THE FLAG 04844500 + OI AJOAPMOD,AJOAPUST YES, USER ACTUALLY GAVE VALUE-NOTE 04844550 + SPACE 1 04844600 +.APFNNT AIF (&$RECORD LT 2).APFNNR SKIP IF NO SPECIAL RECORDS 04844650 + SPACE 1 04844700 +* FLAG AJOAPMOD IF USER ACTUALLY SUPPLIED R=. IF HE DID 04844750 +* NOT, WILL USE $TIRC RECREM FOR PRECISE RECORD COUNT. 04844800 + TM APBR+(APCLKSET-APCBLK),APCSETU+APCSETP DID HE SET VALUE 04844850 + BZ *+8 NO, SKIP OVER 04844900 + OI AJOAPMOD,AJOAPUSR SHOW USER SET R= HIMSELF 04844950 +.APFNNR ANOP 04845000 + SPACE 2 04845050 + AIF (NOT &$ACCT).APNCOM1 SKIP IF NO ACCOUNT DISCRIM 04858050 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04858100 +* ACCOUNT NUMBER CHECKING * 04858150 +* THE FOLLOWING CODE CAN BE USED TO SET DIFFERENT OPTIONS * 04858200 +* DEPENDING ON THE ACCOUNT NUMBER OF THE JOB. AS OF 03/01/71, * 04858250 +* THE ONLY DISCRIMINATION PRESENT IS TO REQUIRE COMMENT CHECKING * 04858300 +* CERTAIN ACCOUNTS, I.E., INTRODUCTORY COURSES. * 04858350 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04858400 + SPACE 1 04858450 + $TIRC (NAME,AJOACCT) GET ACCOUNTING INFO 04858500 + LA R0,L'AJOACCT INCREMENT FOR BXLE 04858550 + LA R1,APXCOMLB @ LAST ENTRY IN TABLE FOR LIMIT BXLE 04858600 + LA R2,APXCOMLA START OF ACCT# TABLE FOR INDEX BXLE 04858650 + SPACE 1 04858700 +* SEARCH TABLE FOR ACCOUNT NUMBER. 04858750 + CLC AJOACCT,0(R2) IS THIS THE ONE 04858800 + BE APXCOMFN YES, JUMP OUT OF LOOP 04858850 + BXLE R2,R0,*-10 LOOP UNTIL END OF TABLE 04858900 + B APXCOMXT NOT FOUND - IGNORE IT 04858950 +APXCOMFN OI AJOASMF2,AJOCOMNT COMMENT CHECKING NOW IN EFFECT 04859000 + SPACE 1 04859050 +APXCOMXT EQU * EXIT POINT FROM ACCT# CHECKING 04859100 +* CHECK FOR CERTAIN NAME TO ALLOW SPECIAL DEBUGGING. 04859150 + AIF (NOT &$JRM).APNCOM1 SKIP IF NOT ANY SPECIAL JRM CODE 04859200 + CLC =C'MASHEY J ',AJOPRGNM CHECK FOR NAME, SPECIAL OPT 04859220 + BNE APNOTJRM NO, NOT NAME, SO SKIP 04859230 + CLC AJOACCT,APACCJRM IS ACCOUNT CURRENT ONE 04859235 + BNE APNOTJRM NO, IT ISN'T, SKIP 04859240 + OI AJODMPF,$EC$JRM SET FLAG TO MAKE EXECUT DO EXTRA 04859250 +APNOTJRM EQU * SKIP HERE IF NOT SPECIAL DEBUG 04859260 +.APNCOM1 ANOP 04859300 +APNOTLST EQU * EXIT HERE UNLESS LAST CALL TO AP 04859700 +APRET $RETURN RGS=(R14-R12),SA=NO 04860000 + EJECT 04862000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04863000 +*--> INSUB: APDECON CONVERT DECIMAL PARM VALUE * 04864000 +* ENTRY CONDITIONS * 04866000 +* R6 = SCAN PTR TO 1ST CHARACTER OF DECIMAL # * 04868000 +* R14= RETURN @ TO CALLING SECTION OF APARMS * 04870000 +* EXIT CONDITIONS * 04872000 +* R0 = CONVERTED RESULT OF DECIMAL #, =0 IF THERE WERE NO NUMBERS * 04874000 +* R6 = SCAN POINTER TO 1ST NON-DECIMAL DIGIT FOUND * 04876000 +* THIS ROUTINE MODIFIES REGS R0,R1,R6 * 04878000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04880000 + SPACE 1 04882000 +APDECON LR R1,R6 SAVE INIT SCAN POINTER 04884000 + SR R0,R0 SET DEFAULT AMOUNT 04886000 + XDECI R0,0(R6) SCAN AND CONVERT VALUE 04888000 + LR R6,R1 MOVE SCAN PTR @ OVER INTO PTR REG 04890000 + BR R14 RETURN TO CALLING SECTION OF CODE 04892000 + EJECT 04922000 +* * * * * INDIVIDUAL PARAMETER FIELD ANALYSIS SECTIONS. * 04924000 +* ALL LABELS ARE OF FORM APA$$$$$ WHERE $$$$$ IS PARAMETER NAME* 04926000 +APAJUMP EQU * BASE @ FOR PARM ROUTINES 04928000 + SPACE 3 04930000 +* PARM=VALUE TYPE PARAMETERS * 04992000 + SPACE 1 04994000 + AIF (NOT &$ACCT).APNACCT SKIP IF NO ACCT DISCRIMINAT 04995000 +APAACCT BR R14 ACCT NUMBER OPTION *****FUTURE USE** 04996000 +.APNACCT ANOP 04997000 + SPACE 1 04998000 +APADUMP MVI AJODMPF,$ECREGS+$ECDINST+$ECSTORG DEFAULT DUMP FLAGS 05000000 + LTR R0,R0 WAS VALUE 0 (LEAVE DEFAULT OK) 05000500 + BCR Z,R14 YES, SO LEAVE FLAG THERE 05001000 + NI AJODMPF,255-$ECSTORG JUST SMALL DUMP,REMV FLAG 05001500 + BR R14 RETURN 05002000 + SPACE 1 05004000 + AIF (&$DEBUG).APNDEBG SKIP IF DEBUG NOT MODE 05006000 +APADEBUG STC R0,AJODEBUG STORE VALUE IN DEBUG FLAG 05008000 + BR R14 RETURN 05010000 + SPACE 1 05012000 +.APNDEBG ANOP 05014000 + SPACE 2 05026000 + AIF (NOT &$MACROS).APNMAC SKIP IF NO MACRO STUFF 05026100 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05026150 +* *** SCANNING CODE FOR MACRO= PARM. * 05026200 +* POSSIBLE OPTIONS ARE AS FOLLOWS: * 05026300 +* MACRO=N NO MACROS (ASSUMED IF IN ERROR) * 05026400 +* MACRO=F F-LEVEL MACRO (BASIC REQUEST) * 05026500 +* MACRO=G ADD G-LEVEL FEATURES * 05026600 +* MACRO=H ADD H-LEVEL FEATURES * 05026700 +* **NOTE** THE BASIC FACILITY IS THE F-LEVEL COMPATIBLE ONE. * 05026800 +* SOME OF THESE OPTIONS MAY NOT BE SUPPORTED, AND IN ANY CASE, * 05026900 +* CODE FOR THEM IS ALL CONDITIONAL. * 05027000 +* SEE SET VARIABLES BEGINNING &$MACRO- . * 05027100 +* ** SETS BITS IN AJOASMFM, SEE FLAGS AT BEGINNING OF AJOBCON. * 05027200 + SPACE 1 05027300 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05027350 +APAMACRO EQU * CODE FOR MACRO= 05027400 +* FOLLOWING STMT MAKES ASSUMPTION OF MACRO=N. 05027500 + NI AJOASMFM,(255-AJOMACRO-AJOMACRG-AJOMACRH) SET MACRO=N 05027600 + SR R2,R2 CLEAR, WILL BE INDEX TO TABLE 05027700 + CLI 0(R6),C'F' WAS IT MACRO=F 05027800 + BE APAMACR1 YES, SKIP, LEAVE R2=0 05027900 + AR R2,R7 SET R2=1 05028000 + CLI 0(R6),C'G' WAS IT G 05028100 + BE APAMACR1 YES, BRANCH, LEAVE R2=1 05028200 + AR R2,R7 SET R2=2 05028300 + CLI 0(R6),C'H' WAS IT MACRO = H 05028400 + BNE APAMACRZ NO, MUST BE MACRO=N, OR ERROR-SKIP 05028500 +APAMACR1 LA R2,APAMACRT(R2) GET @ FLAG BYTE FOR ACTUAL LEVEL 05028600 + OC AJOASMFM(1),0(R2) OR APPRORPIATE BITS INTO FLAG 05028700 +APAMACRZ BXH R6,R7,APFSET BUMPSCAN PTR, GO TO SHOW SET 05028800 +* AJOASMFM FLAG BYTES FOR MACRO= F, G, H . 05028900 +APAMACRT DC AL1(AJOMACRO,AJOMACRO+AJOMACRG,AJOMACRO+AJOMACRH,0) 05029000 + DS 0H MUST BE HALF ALIGNED (NOTE 0 ABOVE) 05029100 +.APNMAC ANOP 05029200 + SPACE 1 05052000 + AIF (NOT &$KP26).APKP29X SKIP IF NO 026 KEYPUNCH 05052020 +APAKP EQU * KP=26 OR KP=29. 29 DEFAULT 05052040 +* ANYTHING BUT KP=26 TREATED AS KP=29. 05052060 + NI AJIOSO,255-AJIOKP26 RESET TO DEFAULT KP=029 05052080 + LA R1,26 VALUE FOR COMPARE 05052100 + CR R0,R1 WAS KP=26 SPECIFIED 05052120 + BCR NE,R14 NO, VALUE SET RIGHT, RETURN 05052140 + OI AJIOSO,AJIOKP26 SHOW 026 KEYPUNCH 05052160 + BR R14 RETURN, GO TO APFSET 05052180 +.APKP29X ANOP 05052200 + SPACE 1 05052220 + AIF (&$TIMER EQ 0).APNOT SKIP IF NO TIMING 05052240 +* ***** SCANNING/CONVERSION FOR T=, TD=, TX= ***** * 05052260 +* THE FOLLOWING CODE ALLOWS THESE PARMS TO SPECIFY * 05052280 +* FRACTIONAL PARTS OF A SECOND. IT SCANS THE FRACTIONAL PART * 05052300 +* IF ANY AND CONVERTS THE VALUE INTO TIMER UNITS (26.04 MICSEC * 05052320 +* AND STORES IT IN APPROPRIATE LOCATION. IT ACCEPTS UP TO 3 * 05052340 +* FRACTIONAL DIGITS (I.E., MILLISECONDS). * 05052360 + SPACE 1 05052380 +APAT EQU * 05052400 +APATD EQU * 05052420 +APATX EQU * 05052440 + LR R1,R0 MOVE # SECONDS ON PARM OVER 05052460 + M R0,AJ1000 *1000 = # MILLISECONDS 05052480 + CLI 0(R6),C'.' DID HE SPECIFY FRACTION 05052500 + BNE APTINT NO,JUST INTERGER-SKIP 05052520 + LR R2,R1 MOVE MILLISEC # OVER FOR SAFETY 05052540 + AR R6,R7 BUMP SCAN PTR BEYOND . 05052560 + LR R5,R6 SAVE @ 1ST FRAFTION DIGIT 05052580 + BAL R14,APDECON CALL CONVERTER FOR SCANNING 05052600 + SR R5,R6 GET # DIGITS 05052620 + AH R5,=H'4' ADD LIMIT+1 TO GET 3-1 OF MULTS 05052640 + BNP APTIGNOR IF MORE THAN 3 DIGITS-IGNORE IT 05052660 + SPACE 1 05052680 + LR R1,R0 MOVE VALUE OF FRACTION 05052700 + LA R15,10 VALUE FOR MULTIPLY 05052720 + BAL R14,*+6 SET REG,SKIP OVER MULT & INTO LOOP 05052740 + MR R0,R15 CONVERT*10 05052760 + BCTR R5,R14 LOOP. END WITH # MILLISEC IN R1 05052780 + AR R2,R1 ADD TO PREVIOUSLY SAVED # MILLISEC 05052800 +APTIGNOR LR R1,R2 MOVE VALUE BACK TO R1 05052820 + SPACE 1 05052840 +* AT THIS PT, R1=# MILLISECONDS SPECIFIED 05052860 +APTINT EQU * 05052880 + M R0,AJ100000 GET 100*# MICROSECONDS 05052900 + D R0,AJ2604 / BY 100# MICRO SEC IN A TIMER UNIT 05052920 +* AT THIS PT R1 = # TIMER UNITS IN INTERVAL 05052940 + LR R0,R1 MOVE OVER FOR LATER STORE 05052960 + TM APCLKSET,APCSET HAS IT BEEN SET BY ANYONE 05052980 + BZ APFSTORE NO, DEFINITELY SAFE TO STORE-GO 05053000 + TM APCLKSET,APCSETU+APCSETP SET BY USER 05053020 + BZ *+12 NO, SKIP DEFAUL TEST 05053040 + TM AJOAPMOD,AJOAPDEF IS IT DEFAUL T CALL 05053060 + BO APFNOSET YES, ALREADY SET-DON'T OVERRRIDE 05053080 + SPACE 1 05053100 + C R0,AJO$APC(R9) COMPARE TO PREVIOUS VALUE 05053120 + BH APFNOSET TOO-HIGH-IGNORE HIM 05053140 + B APFSTORE OK-GOTO STORE VALUE 05053160 +.APNOT ANOP 05053180 + AIF (NOT &$XREF).NOXREF5 A 05053300 + SPACE 3 05053305 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05053310 +* THIS ROUTINE IS THE CROSS REFERENCE OPTION SCANNING ROUTINE * 05053315 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05053320 +APAXREF EQU * 05053325 + IC R0,AJOXREF GET FLAG IN A 05053330 + LR R2,R0 MOVE FLAG TO R0,R1,R2 A 05053335 + LR R1,R2 05053340 + N R0,APXRB3 GET RIGHT BITS SET A 05053345 + N R1,APXRB2 05053350 + N R2,APXRB1 A 05053355 + LR R12,R6 GET POINTER TO PARM FIELD A 05053360 + CLI 0(R12),C'(' SEE IF LIST OF VALUES A 05053365 + BNE APXRXRO PROCESS FIRST ONLY A 05053370 + AR R12,R7 BUMP PAST "(" A 05053375 + CNOP 0,4 MAKE SURE OF PROPER ALIGNMENT A 05053380 + BAL R14,APXRCHK CHECK FOR PROPER DELIMETER A 05053385 + DC A(APXRSD) WHERE TO GO IF OMITTED A 05053390 + BAL R14,APXRSET SET VALUE INTO PROPER REGISTER A 05053395 + SLL R15,4 MOVE TO RIGHT POSITION A 05053400 + LR R0,R15 MOVE TO CORRECT REGISTER 05053405 + AR R12,R7 BUMP TO NEXT CHARACTER A 05053410 +APXRSD EQU * CHECK FOR VALUES IN SD= 05053415 + AR R12,R7 BUMP PAST VALUE A 05053420 + CNOP 0,4 MAKE SURE OF ALIGNMENT A 05053425 + BAL R14,APXRCHK CHECK PROPER DELIMITER A 05053430 + DC A(APXRSR) ADDRESS TO GO TO IF USING DEFAULTS 05053435 + BAL R14,APXRSET SET CORRECT VALUE A 05053440 + SLL R15,2 MOVE TO CORRECT POSITION A 05053445 + LR R1,R15 MOVE TO RIGHT REG A 05053450 + AR R12,R7 BUMP TO NEXT CHARACTER A 05053455 +APXRSR EQU * DO SR= DEFAULT A 05053460 + AR R12,R7 BUMP POINTER A 05053465 + CLI 0(R12),C')' WAS IT OMITTED A 05053470 + BE APXRADD YES, DO ADD A 05053475 + CLI 1(R12),C')' PROPER DELIMITER A 05053480 + BNE APXRFIN NO, BAG IT A 05053485 + BAL R14,APXRSET GET NUMBER IN REG A 05053490 + LR R2,R15 MOVE TO RIGHT REG A 05053495 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05053500 +* THIS SECTION ADDS THE REGISTERS R0,R1,R2. THESE REGISTERS HAVE THE * 05053505 +* CORRECT VALUES IN THEM EITHER BY THE DEFAULT VALUES OR BY SETTING * 05053510 +* A FLAG WITH THE XREF= OPTION. * 05053515 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05053520 +APXRADD EQU * A 05053525 + AR R1,R0 COLLECT XREF AND SD VALUES A 05053530 + AR R2,R1 COLLECT ALL A 05053535 + STC R2,AJOXREF SET ACTUAL FLAG A 05053540 +APXRRET EQU * A 05053545 + LA R6,1(R12) SET PROPER DELIMITER A 05053550 + B APFSET SHOW VALUE SET A 05053555 +APXRXRO BAL R14,APXRSET GET NUMBER A 05053560 + SLL R15,4 MOVE TO RIGHT POSITION A 05053565 + LR R0,R15 MOVE TO RIGHT REGS A 05053570 + B APXRADD SET ACTUAL XREF FLAG A 05053575 + SPACE 2 05053576 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05053577 +*-->INSUB: APXRSET CONVERT NUMBER TO INTERNAL FORM * 05053580 +* CONVERTS XREF PARM NUMBERS AND CHECKS TO SEE IF THEY'RE IN THE * 05053582 +* RANGE 0-3. * 05053584 +* ENTRY CONDITIONS * 05053585 +* R12= POINTER TO NUMBER TO BE CONVERTED * 05053587 +* EXIT CONDITIONS * 05053589 +* R15= CONVERTED NUMBER * 05053590 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05053595 +APXRSET EQU * INSUB TO SET VALUE IN REGISTER 15 A 05053600 + MVC APXRWORK+7(1),0(R12) MOVE NUMBER TO WORK AREA A 05053605 + PACK APXRWORK(8),APXRWORK A 05053610 + CVB R15,APXRWORK CONVERT NUMBER TO INTERNAL FORM A 05053615 + C R15,=X'00000003' SEE IF TOO BIG A 05053620 + BH APXRFIN DENOTE ERROR A 05053625 + BR R14 RETURN A 05053630 + SPACE 2 05053632 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05053634 +*-->INSUB: APXRCHK CKECK FOR VALID DELIMITER * 05053635 +* CHECKS FOR ',' IN XREF=(A,B,C) PARM FIELD. SPECIAL RETURN * 05053637 +* FOR XREF=(A). * 05053639 +* ENTRY CONDITIONS * 05053640 +* R12= POINTER OF NEXT CHARACTER * 05053642 +* EXIT CONDITIONS * 05053645 +* R14= @ OF ROUTINE TO BRANCH TO * 05053647 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05053650 +APXRCHK EQU * A 05053655 + CLI 0(R12),C',' WAS NEXT OPERAND OMITTED? A 05053660 + BE APXRNXT YES: DO NEXT SECTION 05053665 + CLI 1(R12),C',' PROPER DELIMITER? A 05053670 + BNE APXRFIN NO: GO TO ERROR A 05053675 + B 4(R14) GO BAVK A 05053680 +APXRNXT L R14,0(R14) GET ADDRESS 05053685 + BR R14 GO TO ROUTINE 05053690 +APXRFIN EQU * 05053695 + LR R6,R12 GET @ BACK IN R6 05053700 + B APFNOSET ERROR FOUND: SHOW NOT SET A 05053705 +APXRB1 DC A(3) MASK OUT ALL BUT LOWER BITS A 05053710 +APXRB2 DC A(12) MIDDLE BITS A 05053715 +APXRB3 DC A(48) TOP BITS A 05053720 +APXRWORK DC D'0' WORK AREA A 05053725 +.NOXREF5 ANOP 05053730 +* TABLE OF APCBLKS FOR PARM FIELD ANALYSIS * 05054000 +APBPARMA DS 0D DEFINE BEGINNING SYMBOL, ALIGN 05056000 +APLAC EQU * PARMS A-C 05056020 + APCGN ACCT,AJOACCT,0,C=1,G=&$ACCT 05056040 + AIF (&$S370 NE 2).APNALGN SKIP IF NO S/370 SIMULATION 05056045 + APCGN ALGN,AJOEXEF,AJONALGN,Y=1 05056050 +.APNALGN ANOP 05056055 + APCGN BATCH,AJOMODE,AJOBATCH,I1=1,Y=1,LK=110 05056060 + APCGN CMPRS,AJOASMF2,AJOCMPRS,I1=1,Y=1,G=&$CMPRS 05056080 + APCGN COMNT,AJOASMF2,AJOCOMNT,I1=1,Y=1,G=&$COMNT,LK=110 05056100 + APCGN CPAGE,AJIOPR,AJIOPAGE,I1=1,Y=1,G=&$PAGE,LK=110 05056120 +APLDG EQU * PARMS D-G 05056140 + APCGN DATA,AJIORE,AJIODFLT,Y=1,G=&$DATARD,LK=110 05056160 + APCGN DEBUG,AJODEBUG,C=1,D=1,G=&$DEBUG,GC=1 05056180 + APCGN DECK,AJOASMF2,AJODECK,Y=1,I1=1,G=&$DECK 05056190 + APCGN DISKU,AJOASMF,AJODISKU,G=&$DISKU,Y=1,I1=1 05056195 + APCGN DUMP,AJODMPF,C=1,D=1 05056200 + APCGN FREE,AJOFREE,0,D=1,LK=110 05056220 +APLHI EQU * PARMS H-I 05056240 + APCGN I,AJOINSL,0,D=1,I1=1 05056260 + APCGN IECF,AJOIECF,0,D=1,G=&$EXINT IECF OF EXT'D INTPRTR 05056265 +APLJL EQU * PARMS J-L, GAP 05056280 + APCGN KP,AJIOSO,C=1,D=1,G=&$KP26 05056300 + APCGN L,AJOL,0,D=1,I1=1,G=&$PAGE 05056320 + APCGN LIBMC,AJOASMFM,AJOLIBMC,I1=1,Y=1,G=&$MACROS PRT LIB MCS 05056350 + APCGN LIST,AJOASMF,AJNLIST,Y=1 05056360 + APCGN LOAD,AJOASMF,AJNLOAD,Y=1 05056380 +APLMP EQU * PARMS M-P 05056400 + APCGN MACRO,AJOASMFM,C=1,G=&$MACROS MACRO LEVEL 05056420 + APCGN MACTR,AJOMACTR,0,D=1,G=&$MACROS MACRO ACTR 05056423 + APCGN MNEST,AJOMNEST,0,D=1,G=&$MACROS MACRO NEST LIMIT 05056426 + APCGN MSTMG,AJOMSTMG,0,D=1,G=&$MACROS MACRO STMT LIMIT 05056430 + APCGN MONIT,AJOMODE,AJOMONIT,I1=1,Y=1,LK=110 05056440 + APCGN NERR,AJONERRF,0,D=1 05056460 + APCGN OBJIN,AJODECKF,AJOOBJIN,Y=1,I1=1,G=&$OBJIN 05056470 + APCGN P,AJOP,0,D=1,I1=1,G=&$PAGE 05056480 +APBPD APCGN PD,AJOPD,0,D=1,I1=1,G=&$PAGE 05056500 + APCGN PUNCH,AJIOPN,AJIODFLT,Y=1,G=&$PUNCH,LK=110 05056520 +APBPX APCGN PX,AJOPX,0,D=1,I1=1,G=&$PAGE 05056540 +APLQR EQU * PARMS Q-R, GAP 05056560 +APBR APCGN R,AJORECL,0,D=1,I1=1 05056580 +APBRD APCGN RD,AJORD,0,D=1,I1=1 05056600 + APCGN RELOC,AJOASMF,AJORELOC,I1=1,Y=1,G=&$RELOC 05056620 + APCGN REPL,AJOMODE,AJOREPLF,I1=1,Y=1,G=&$REPL 05056640 + APCGN RFLAG,AJORFLAF,0,D=1,G=&$REPL 05056660 +APBRX APCGN RX,AJORX,0,D=1,I1=1 05056680 +APLST EQU * PARMS S-T 05056700 + APCGN SS,AJIOSS,AJIOSING,I1=1,Y=1,G=&$PAGE 05056720 + APCGN SSD,AJIOSSD,AJIOSING,I1=1,Y=1,G=&$PAGE 05056740 + APCGN SSX,AJIOSSX,AJIOSING,I1=1,Y=1,G=&$PAGE 05056760 + APCGN SUPER,AJOEXEF,AJOSUPER,I1=1,Y=1,G=&$PRIVOP 05056780 + APCGN SYSIN,AJOMODE,AJNSYSIN,Y=1,G=&$DATARD,LK=110 05056800 +APBT APCGN T,AJOTIML,D=1,I1=1,G=&$TIMER,C=1 05056820 + APCGN TD,AJOTD,D=1,I1=1,G=&$TIMER,C=1 05056840 +APBTX APCGN TX,AJOTX,D=1,I1=1,G=&$TIMER,C=1 05056860 +APLUX EQU * PARMS U-X 05056880 + APCGN XREF,AJOXREF,C=1,G=&$XREF A 05056890 +APLYZ EQU * PARMS Y-Z 05056900 +APBPARMB EQU * LIMIT OF APCGN'D TABLE 05056920 + SPACE 2 05056940 +* PARM TABLE LOOKUP INDEX - APLNDX 05056960 +* GIVES OFFSETS TO BEGINNING OF EACH SECTION OF TABLE, 05056980 +* DETERMINED BY INITIAL LETTER 05057000 +* DETERMINED BY MIDDLE 4 BITS OF 1ST BYTE OF OPTION NAME. 05057020 +APLNDX $AL2 APBPARMA,(APLAC,APLDG,APLHI,APLJL,APLJL,APLMP,APLQR, #05057040 + APLST,APLST,APLUX,APLYZ,APBPARMB) 05057060 + AIF (NOT &$ACCT).APNCOM2 SKIP IF NO ACCT# CHECKING 05094100 + SPACE 1 05094200 +* TABLE OF ACCOUNT NUMBERS RECEIVING SPECIAL TREATMENT. 05094300 +APXCOMLA EQU * BEGINNING OF TABLE 05094400 + DC 5CL5'ACCT#' DUMMIES, TO BE FIXED IN OBJ DECK 05094500 +APACCJRM DC C'C3338' CURRENT ACCT# FOR TESTING PURPOSES 05094600 +APXCOMLB EQU *-L'AJOACCT @ LAST 1 IN TABLE 05094700 + SPACE 1 05094800 +.APNCOM2 ANOP 05094900 + SPACE 1 05095000 +* TABLE TO DETERMINE WHETHER YES/NO PARM SHOULD HAVE ITS 05095020 +* VARIABLE BYTE BITS SET TO 1'S OR 0'S. 05095040 +APFYNTAB DS 0BL4 YES/NO BIT SETTING CONTROL TABLE 05095060 + DC B'1' YES PARM,YES1B ==> BIT = 1 05095080 + DC B'0' YES PARM, ^YES1B ==> BIT = 0 05095100 + DC B'0' NO PARM, YES1B ==> BIT = 0 05095120 + DC B'1' NO PARM, ^YES1B ==> BIT = 1 05095140 + LTORG 05096000 + DROP R3,R8,R11 KILL ALL USINGS 05098000 + AIF (NOT (&$DECK OR &$OBJIN)).AOBNONE SKIP IF NO DECKS 05098010 + TITLE 'AOBJCARD DSECT : OBJECT DECK CARDIMAGE' 05098020 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05098025 +*--> DSECT: AOBJCARD IMAGE OF OBJECT DECK CARD * 05098030 +* THIS DSECT DESCRIBES 1 CARD OF AN ASSIST OBJECT DECK. THE * 05098040 +* DECK FORMAT IS COMPATIBLE WITH NORMAL S/360 OBJECT DECKS, SO THAT * 05098050 +* THEY CAN BE USED UNDER SOME CIRCUMSTANCES. THEY ARE HOWEVER * 05098060 +* SIMPLER, IN ORDER TO ALLOW FOR PRODUCTION OF THEM FROM STUDENT- * 05098070 +* COMPILERS, I.E. XPL. LATER VERSIONS OF THE LOADER MAY PERMIT * 05098080 +* MORE COMPLEX OBJECT DECKS, BUT AS OF 9/01/71, THE ONLY TYPES OF * 05098090 +* OBJECT DECK CARDS RECOGNIZED ARE TXT AND END CARDS. * 05098100 +* NAMES: AO------ * 05098110 +* REFERENCE: ASSEMBLER(F) PROGRAMMER'S GUIDE - GC26-3756-4 * 05098120 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05098130 + SPACE 1 05098140 +AOBJCARD DSECT 05098150 + SPACE 1 05098160 +* ***** COMMON BASE BEGINNING ***** 05098170 + DS X'02' 1 (S/360) - ASSIST IGNORES 05098180 +AOBJTYPE DS CL3 2-4 TYPE OF CARD 05098190 + SPACE 1 05098200 +* ***** ESD CARD LAYOUT ***** 05098210 +******************** NOT CURRENTLY IMPLEMENTED ******************* 05098220 + SPACE 1 05098230 +* ***** TXT CARD LAYOUT ***** 05098240 + ORG AOBJTYPE BACK UP TO SHOW LAYOUT 05098250 + DS CL3'TXT' 2-4 TEXT CARD IDENTIFIACTION 05098260 +AOTADDR DS 0A,C' ' 5 ASSIST IGNORES 1ST BYTE 05098270 +AOTADDRT DS AL3 6-8 @ WHERE OBJECT CODE GOES 05098280 + DS CL2' ' 9-10 ASSIST IGNORES THESE COLS 05098290 +AOTLENG DS 0H,C 11-12 LENGTH OF CODE ON CARD 05098300 +AOTLENG2 DS AL1 12 LENGTH USED BY ASSIST 0-56 05098310 + DS CL4' ' 13-16 IGNORED *****FUTURE USE ****** 05098320 +AOTCODE DS CL56 17-72 OBJECT CODE 0-56 BYTES OF IT 05098330 +AOTSEQN DS CL8 73-78 SEQUENCE NUMBER, IGNORED 05098340 + SPACE 1 05098350 +* ***** RLD CARD LAYOUT ***** 05098360 +******************** NOT CURRENTLY IMPLEMENTED ******************* 05098370 + SPACE 1 05098380 +* ***** END CARD LAYOUT ***** 05098390 + ORG AOBJTYPE BACK TO SHOW TYPE 05098400 + DS CL3'END' 2-4 END CARD FLAG 05098410 +AOEBLNK EQU * BEGINNING OF BLANK AREA 05098420 +AOENTRY DS 0A,C' ' 5 ASSIST IGNORES LEADING BLANK 05098430 +AOENTRY2 DS AL3 6-8 GIVES ENTRY @, UNLESS BLANK 05098440 +AOEBLNKL EQU 72-(*-AOBJCARD) LENGTH TO BE BLANKED 05098450 + TITLE 'AOBJDK CSECT - OBJECT DECK PUNCH/LOAD' 05098460 +AOBJDK CSECT 05098470 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05098475 +*--> CSECT: AOBJDK OBJECT DECK HANDLING MODULE * 05098480 +* JOHN R. MASHEY - 09/01/71 * 05098490 +* THE TWO ENTRIES OF AOBJDK ARE USED TO LOAD OR PUNCH OBJECT * 05098500 +* DECKS WHICH ARE SUBSETS OF NORMAL S/360 DECKS. THE TWO ENTRIES * 05098510 +* MAY OR MAY NOT EXIST, DEPENDING ON FLAGS &$DECK AND &$OBJIN. * 05098520 +* USES DSECTS: AOBJCARD,AVWXTABL * 05098530 +* USES MACROS: $RETURN,$SAVE * 05098540 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05098550 + $DBG ,NO NO DEBUG IN $SAVE,$RETURN 05098560 + EJECT 05098570 + AIF (NOT &$OBJIN).AOBJN1 SKIP IF NO OBJECT INPUT 05098580 + ENTRY AOBJIN 05098590 +AOBJIN $SAVE RGS=(R14-R12),SA=NO,BR=R6 05098600 + USING AVWXTABL,RAT NOTE ASSEMBLER CONTROL TABLE 05098610 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05098615 +*--> ENTRY: AOBJIN LOAD OBJECT DECK * 05098620 +* ENTRY CONDITIONS * 05098630 +* R12(RAT) = @ ASSEMBLER CONTROL TABLE (AVWXTABL). * 05098640 +* EXIT CONDITIONS * 05098650 +* AVRADL,AVRADH,AVRELOC,AVFENTER,AVLOCLOW,AVLOCHIH ARE SET UP * 05098660 +* AS THEY WOULD HAVE BEEN HAD THE PROGRAM BEEN ASSEMBLED. * 05098670 +* AVTAGS1 IS FLAGGED WITH AJNLOAD IF SOME ERROR OCCURRED. * 05098680 +* NAMES: AOB----- * 05098690 +* USES MACROS: $PRNT,$RETURN,$SAVE,$SORC,XSNAP * 05098700 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05098710 + SPACE 1 05098720 +* * * * * * * * REGISTER USAGE FOR AOBJIN * * * * * * * * * * * * * * * 05098730 +* R0,R1 WORK REGISTERS. R1 USED FOR ADDRESS CALCULATIONS. * 05098740 +* R2 = LOWEST REAL @ LOADED CODE. INIT=AVADDLOW. INTO AVRADL. * 05098750 +* R3 = @+1 OF HIGHEST LOADED CODE. INIT=AVADDLOW. INTO AVRADH. * 05098760 +* R4 = LOAD RELOCATION FACTOR. = AVADDLOW - (1ST TXT @ FOUND). * 05098770 +* R5 = USER ENTRYPOINT @ (FAKE). TO BE STORED INTO AVFENTER. * 05098780 +* R6 = BASE REGISTER * 05098790 +* R7 = ADDRESS OF OBJECT CARD IMAGE (AOBJCARD DSECT). * 05098800 +* R8 = BYTE REGISTER (USED FOR INSERT OF LENGTH FROM AOTLENG2) * 05098810 +* R9 = @+1 OF HIGHEST USABLE BYTE FOR PROGRAM. = AVADDHIH. * 05098820 +* R10,R11 UNUSED * 05098830 +* R12(RAT)= @ AVWXTABL CONTROL BLOCK * 05098840 +* R13= @ CALLING PROGRAM'S SAVE AREA. * 05098850 +* R14= INTERNAL LINK REGISTER, WORK REGISTER. * 05098860 +* R15= WORK REGISTER * 05098870 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05098880 + EJECT 05098890 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05098900 +* OBJECT LOAD INITIALIZATION. * 05098910 +* 1. FILL OBJECT AREA (AVADDLOW-AVADDHIH) WITH FILL CHARS. * 05098920 +* 2. SET UP INITIAL VALUES FOR @'S IN REGISTERS. * 05098930 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05098940 + LM R8,R9,AVADDLOW AVADDLOW-AVADDHIH - CORE LIMITS 05098950 + LA R7,31(,R8) * ALIGN ACTUAL BEGINNING @ 05098960 + SRL R7,5 * TO MULTIPLE OF 32. 05098970 + SLL R7,5 * THIS IS REQUIRED BY XXXXSNAP 05098980 + ST R7,AVADDLOW * STORE ALIGNED VALUE BACK 05098990 + LA R8,32 # BYTES TO BE FILLED WITH 1 STM 05099000 + SR R9,R8 SUBTRACT 32 FOR BXLE USE 05099010 + SR R9,R8 -32 MORE FOR COMPLETE SAFETY 05099020 + BXH R7,R8,AOBINTA MAKE SURE AT LEAST 32 BYTES 05099030 + SPACE 1 05099040 + SR R7,R8 BACK UP TO BEGINNING FOR SAFETY 05099050 + MVI 0(R7),$PRGFILC PUT IN FILL CHARACTER 05099060 + MVC 1(31,R7),0(R7) PROPAGATE FILL CHARACTER 05099070 + LM R14,R5,0(R7) GET 8 REGS WORTH OF FILL CHARACTER 05099080 + SPACE 1 05099090 + STM R14,R5,0(R7) STORE 32 BYTES OF FILL CHARACTER 05099100 + BXLE R7,R8,*-4 LOOP TO FILL WHOLE AREA 05099110 + SPACE 1 05099120 +AOBINTA LM R8,R9,AVADDLOW AVADDLOW-AVADDHIH - LIMIT @'S 05099130 + LR R2,R8 R2= INIT VALUE LOWEST REAL(AVRADL) 05099140 + LR R3,R2 R3= INIT VALUE HIGHEST LIMIT(RADH) 05099150 + SR R5,R5 INIT ENTRY @ TO 0 (BEGINNING OF CD) 05099160 + NI AVTAGS1,255-AVOENTR-AVO1TXT SHOW NO TXT, ENTRY @ FOUND 05099170 + LA R7,AVCONCAT USE THIS AS WORKAREA FOR AOBJCARD 05099180 + USING AOBJCARD,R7 NOTE DSECT 05099190 + SR R8,R8 CLEAR R8 AS BYTE REGISTER FOR INSERT 05099200 + SPACE 1 05099210 +* PRINT HEADER MESSAGE AL000. 05099220 + BAL R14,AOBHEXCO CONVERT VALUES TO HEX FOR PRINT 05099230 + DC H'2' # ITEMS IN FOLLOWING LIST 05099240 + DC AL2(AVADDLOW-AVWXTABL,AOB000A-AOB) REAL @ START 05099250 + DC AL2(AVADDHIH-AVWXTABL,AOB000B-AOB) REAL LIMIT 05099260 + BAL R14,AOBPRINT GO PRINT COMPLETED MESSAGE 05099270 + DC AL2(AOB000-AOB,AOB000L) @ OFFSET, LENGTH 05099280 + EJECT 05099290 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05099300 +* READ OBJECT DECK AND LOAD LOOP HEAD * 05099310 +* READ 1 CARD OF OBJECT DECK, UNTIL EOF FOUND. DETERMINE TYPE * 05099320 +* OF CARD, BRANCH TO PROCESSING SECTION, RETURN FOR NEXT CARD. * 05099330 +* **NOTE** AS OF 9/01/71, WILL PROCESS ONLY TXT AND END CARDS, THUS * 05099340 +* SECTIONS OF CODE COMMENTED OUT ARE TO INDICATE POSSIBLE EXTENSIONS* 05099350 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05099360 +AOBREAD EQU * ENTRY LABEL FOR 1 CARD PROCESS 05099370 + $SORC AOBJCARD,80,AOBJEOF READ UNTIL END-FILE 05099380 + CLC AOBJTYPE,=C'TXT' WAS IT TEXT CARD (MOST LIKELY) 05099390 + BE AOBTXT YES (NOTE WE IGNORE COL 1 OF CARD) 05099400 + CLC AOBJTYPE,=C'END' WAS IT END CARD 05099410 + BE AOBEND YES, GO THERE TO PROCESS IT 05099420 +***** CLC AOBJTYPE,=C'RLD' WAS IT RLD 05099430 +***** BE AOBRLD YES, GO THERE 05099440 +***** CLC AOBJTYPE,=C'ESD' WAS IT ESD CARD 05099450 +***** BE AOBESD YES, GO THERE 05099460 +***** IF DESIRED, INSERT COUNTER HERE FOR UNKNOWN TYPES OF CARDS. 05099470 + B AOBREAD UNKNOWN TYPE OF CARD-IGNORE IT 05099480 + SPACE 1 05099490 +* ***** PROCESSING CODE FOR INDIVIDUAL TYPES OF CARDS ***** 05099500 + SPACE 2 05099510 +* ***** END CARD(S) ***** 05099520 +* SETS R5 = ENTRY @, IF: 1) A PREVIOUS END CARD HAS * 05099530 +* NOT ALREADY SPECIFIED ONE, AND 2) ONE IS GIVEN ON THIS * 05099540 +* END CARD. * 05099550 +AOBEND EQU * 05099560 + TM AVTAGS1,AVOENTR HAS ONE BEEN SPECIFIED ALREADY 05099570 + BO AOBREAD YES, SO DON'T DO IT AGAIN 05099580 + CLC AOENTRY2,AWBLANK+1 WAS ENTRY POINT BLANK 05099590 + BE AOBREAD YES, SO IGNORE IT 05099600 + L R5,AOENTRY GET FULLWORD CONTAINING ENTRY @ 05099610 + LA R5,0(,R5) REMOVE LEADING BYTE 05099620 + OI AVTAGS1,AVOENTR SHOW ENTRY @ FOUND, SO WONT DO AGAN 05099630 + B AOBREAD GO BACK FOR MORE (IF ANY) 05099640 + SPACE 2 05099650 +* ***** ESD CARD(S) ***** * 05099660 +*AOBESD EQU * EXTERNAL SYMBOL DICTIONARY 05099670 + SPACE 2 05099680 +* ***** RLD CARD(S) ***** * 05099690 +*AOBRLD EQU * RELOCATION DICTIONARY 05099700 + EJECT 05099710 +* ***** TXT CARD(S) ***** * 05099720 +* MOVE TEXT CODE FROM CARDIMAGE INTO MEMORY. * 05099730 +* COMPUTE RELOCATION FACTOR FROM FIRST TEXT CARD FOUND. * 05099740 +* MAINTAIN HIGH LIMIT FOR ACTUAL OBJECT CODE, AND MAKE * 05099750 +* SURE CODE DOES NOT EXCEED HIGH LIMIT, OR GO BELOW * 05099760 +* THE LOW LIMIT (AFTER FIRST TEXT CARD). * 05099770 +AOBTXT EQU * ENTRY LABEL FOR TEXT CARD 05099780 + L R1,AOTADDR GET @ CODE (USER PROG RELATIVE) 05099790 + LA R1,0(,R1) REMOVE HI-ORDER BYTE 05099800 + TM AVTAGS1,AVO1TXT HAVE WE GOTTEN AT LEAST 1 TXT CARD 05099810 + BO AOBTXT1 YES, SO SKIP 05099820 +* FIRST TEXT CARD - COMPUTE RELOCATION FACTOR 05099830 + LR R4,R2 MOVE REAL BEGINNING @ OVER 05099840 + SR R4,R1 SUBTRACT USER LOW @ FROM REAL= RELOC 05099850 + OI AVTAGS1,AVO1TXT FLAG SO WE DON'T COMPUTE IT AGAIN 05099860 + BZ AOBTXT1 NO, LEAVE ENTRY PT REG AS IS 05099870 + TM AVTAGS1,AVOENTR HAS ENTRY PT BEEN RECEIVED ALREADY 05099880 + BO AOBTXT1 YES, SO DON'T CHANGE R5 05099890 + LR R5,R1 MAKE DEFAULT ENTRY PT THE FIRST BYTE 05099900 +AOBTXT1 AR R1,R4 RELOC USER @ TO REAL ONE 05099910 + CR R1,R2 WAS IT LOWER THAN REAL LIMIT 05099920 + BL AOBTXTIL YES, GO TO FLAG OR PRINT MESSAGE 05099930 + IC R8,AOTLENG2 GET LENGTH FROM CARD OF CODE 05099940 + LA R0,0(R8,R1) GET REAL @+1 OF LAST BYTE OF CODE 05099950 + CR R0,R9 WAS IT HIGHER THAN ACTUAL SPACE 05099960 + BH AOBTXTIH YES, TOO MUCH CODE-EXIT 05099970 + CR R0,R3 WAS IT HIGHER THAN PREVIOUS HIGH 05099980 + BNH *+6 NO, SKIP 05099990 + LR R3,R0 YES, SET NEW HIGH LIMIT 05100000 + SPACE 1 05100010 + LTR R8,R8 WAS LENGTH=0 (POSSIBLE FOR DS'S) 05100020 + BZ AOBREAD YES, SO DON'T DO ANYTHING 05100030 + BCTR R8,0 DECREMENT LENGTH TO LENGTH-1 FOR MVC 05100040 + EX R8,AOBTXTMV MOVE TEXT CODE OVER 05100050 + B AOBREAD RETURN FOR NEXT CARD 05100060 +AOBTXTMV MVC 0($,R1),AOTCODE MOVE CODE TO MEMORY **MODIFIED** 05100070 + EJECT 05100080 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05100090 +* EXIT CODE - CHECK AND STORE FINAL ADDRESSES * 05100100 +* MAKE SURE WE RECIEVED AT LEAST 1 TEXT CARD, ASSURE *8 * 05100110 +* LENGTH MULTIPLE, AND STORE BLOCK OF 6 ADDRESSES APPROPRIATELY. * 05100120 +* NOTE THAT ALTERATIONS MUST BE MADE IF THE USER CODED RELOC, IN * 05100130 +* WHICH CASE HIS PROGRAM MUST EITHER BE LOADED FROM WHERE IT WAS * 05100140 +* ASSEMBLED ORIGINALLY, OR MUST CONTAIN NO ADDRESS CONSTANTS AT ALL.* 05100150 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05100160 +AOBJEOF EQU * 05100170 + TM AVTAGS1,AVO1TXT DID WE GET AT LEAST 1 TXT CARD 05100180 + BZ AOBNOTXT NO, QUIT NOW WITH ERROR 05100190 + LA R3,7(,R3) ROUND UPPER REAL @ UP 05100200 + SRL R3,3 SHIFT TO REMOVE 3 BITS 05100210 + SLL R3,3 SHIFT BACK, NOW ALIGNED 05100220 + TM AVTAGS1,AJORELOC WAS THIS TO BE RELOACTED MODE 05100230 + BZ AOBJNORM NO, NORMAL-SKIP 05100240 + AR R5,R4 RELOCATE USER LOCATION TO REAL 05100250 + SR R4,R4 MAKE EXECUTION RELOC FACTOR = 0 05100260 +AOBJNORM EQU * FINAL STORE OF @'S 05100270 + STM R2,R5,AVRADL AV(RADL-RADH-RELOC-FENTER) 05100280 + SR R2,R4 RADL-RELOC = FAKE LOW @ FOR USER 05100290 + SR R3,R4 RADH-RELOC = FAKE HIGH LIMIT @ 05100300 + STM R2,R3,AVLOCLOW AV(LOCLOW-LOCHIH) -USER RELATIVE LIM 05100310 + SPACE 1 05100320 +* SUCCESFFUL COMPLETION MESSAGE AL100. 05100330 + BAL R14,AOBHEXCO GO CONVERT VALUES TO HEX 05100340 + DC H'4' # ITEMS IN LIST 05100350 + DC AL2(AVLOCLOW-AVWXTABL,AOB100A-AOB) LOWEST USER @ 05100360 + DC AL2(AVLOCHIH-AVWXTABL,AOB100B-AOB) HIGH USER @ 05100370 + DC AL2(AVFENTER-AVWXTABL,AOB100C-AOB) FAKE ENTRY @ 05100380 + DC AL2(AVRELOC-AVWXTABL,AOB100D-AOB) RUN TIME RELOC 05100390 + BAL R14,AOBPRINT PRINT COMPLETED MESSAGE 05100400 + DC AL2(AOB100-AOB,AOB100L) MESSG OFFSET, LENGTH 05100410 + SPACE 1 05100420 +AOBJEXIT $RETURN RGS=(R14-R12),SA=NO RETURN TO CALLER 05100430 + SPACE 1 05100440 +* ***** ERROR EXITS ***** 05100450 +AOBNOTXT BAL R14,AOBPRINT PRINT AL996 - NO TEXT CARDS FOUND 05100460 + DC AL2(AOB996-AOB,AOB996L) OFFSET, LENGTH 05100470 + B AOBJBAD GO TO SHOW ABORT 05100480 +AOBTXTIL BAL R14,AOBPRINT AL997 - TXT @ TOO LOW 05100490 + DC AL2(AOB997-AOB,AOB997L) OFFSET,LENGTH 05100500 + B AOBTXTID GO TO DUMP STMT FOR USER 05100510 +AOBTXTIH BAL R14,AOBPRINT AOB998 - OVERFLOW OF AREA 05100520 + DC AL2(AOB998-AOB,AOB998L) OFFSET, LENGTH 05100530 +AOBTXTID BAL R14,AOBDUMP DUMP USER CARDIMAGE, FALL TO AOBJBAD 05100540 +AOBJBAD BAL R14,AOBPRINT GO PRINT AL999 - LOAD ABORT 05100550 + DC AL2(AOB999-AOB,AOB999L) OFFSET, LENGTH 05100560 + OI AVTAGS1,AJNLOAD FLAG NOLOAD 05100570 + B AOBJEXIT RETURN SHOWING ERROR 05100580 + EJECT 05100590 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05100595 +*--> INSUB: AOBDUMP DUMP CURRENT USER CARDIMAGE * 05100600 +* ENTRY CONDITIONS * 05100610 +* R14= RETURN ADDRESS TO CALLING CODE * 05100620 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05100630 +AOBDUMP EQU * 05100640 + XSNAP T=(NO,,0),LABEL='IMAGE OF INCORRECT OBJECT CARD', X05100650 + STORAGE=(*AOBJCARD,*AOBJCARD+80) 05100660 + BR R14 05100670 + SPACE 2 05100680 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05100685 +*--> INSUB: AOBHEXCO CONVERT VALUES TO EDITED HEXADECIMAL * 05100690 +* ENTRY CONDITIONS * 05100700 +* R14= @ PARAMETER LIST. LIST CONSISTS OF THE FOLLOWING: * 05100710 +* 1) HALFWORD GIVING # ITEMS IN LIST TO BE CONVERTED. * 05100720 +* 2) 1 OR MORE PAIRS OF OFFSET VALUES GIVING DISPLACEMENT * 05100730 +* FROM AVWXTABL TO FULLWORD VARIABLE TO BE CONVERTED, AND * 05100740 +* OFFSET FROM LABEL AOB TO 6-BYTE FIELD WHERE EDITED HEX * 05100750 +* SHOULD BE PLACED. REQUIRES FREE BYTE AFTER THIS FIELD. * 05100760 +* EXIT CONDITIONS * 05100770 +* R0,R1,R14,R15 ARE ALL MODIFIED. * 05100780 +* CONTROL RETURNED TO LOCATION AFTER PARAMETER LIST. * 05100790 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05100800 +AOBHEXCO LH R0,0(,R14) GET # ENTRIES IN FOLLOWING LIST 05100810 +AOBHEX2 LH R1,2(,R14) GET OFFSET OF FULLWORD TO CONVERT 05100820 + LA R1,AVWXTABL(R1) GET ACTUAL @ OF VARIABLE 05100830 + LH R15,4(,R14) GET OFFSET TO OUTPUT FIELD 05100840 + LA R15,AOB(R15) GET ACTUAL @ OUTPUT FIELD 05100850 + UNPK 0(7,R15),1(4,R1) UNPACK 3 BYTES, WITH EXTRA FOR EASE 05100860 + TR 0(6,R15),AWTHEX3 TRANSLATE TO PRINTABLE 05100870 + MVI 6(R15),C' ' PUT IN BLANK AFTER TO WIPE EXTRA OUT 05100880 + LA R14,4(,R14) BUMP PTR TO NEXT PAIR 05100890 + BCT R0,AOBHEX2 LOOP THORUGH LIST 05100900 + B 2(,R14) RETURN TO CALLER 05100910 + SPACE 2 05100920 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05100929 +*--> INSUB: AOBPRINT PRINT 1 LINE OF OUTPUT MESSAGE * 05100930 +* ENTRY CONDITIONS * 05100940 +* R14= @ PARAMETER LIST, WHICH HAS OFFSET @ OF MESSAGE FROM AOB, * 05100950 +* FOLLOWED BY LENGTH OF MESSAGE, BOTH IN HALFWORDS. * 05100960 +* EXIT CONDITIONS * 05100970 +* R0,R1 ARE MODIFIED. * 05100980 +* CONTROL RETURNED TO LOCATION AFTER PARAMETER LIST. * 05100990 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05101000 +AOBPRINT LA R0,AOB BASE @ FOR MESSAGE 05101010 + AH R0,0(,R14) ADD IN OFFSET @ 05101020 + LH R15,2(,R14) LENGTH OF MESSAGE 05101030 + $PRNT (R0),(R15) PRINT THE MESSAGE 05101040 + B 4(,R14) RETURN TO CALLER 05101050 + EJECT 05101060 +* AOBJIN LOADER MESSAGES - AL### * 05101070 +* AL000 - BEGINNIG HEADER LABEL. * 05101080 +* AL100 - SUCCESSFUL COMPLETION. * 05101090 +* AL996 - NO TEXT CARDS RECEIVED. * 05101100 +* AL997 - TXT CARD @ TOO LOW * 05101110 +* AL998 - TXT CARD @ TOO HIGH - OVERFLOW OF AREA * 05101120 +* AL999 - LOAD ABORTED MESSAGE * 05101130 +AOB EQU * BASE FOR OFFSET @'S IN PARM LISTS 05101140 + SPACE 1 05101150 +AOB000 DC C'0*** AL000 - ASSIST LOADER BEGINS LOAD AT ' 05101160 +AOB000A DC XL6'0' LOWEST @ = AVADDLOW 05101170 + DC C' ,USABLE CORE ENDS AT ' 05101180 +AOB000B DC XL6'0',C' ***' HIGH LIMIT = AVADDHIH 05101190 +AOB000L EQU *-AOB000 LENGTH OF THIS MESSAGE 05101200 + SPACE 1 05101210 +AOB100 DC C'0*** AL100 - LOAD COMPLETED, USER ADDRESSES: LOW ' 05101220 +AOB100A DC XL6'0',C' ,HIGH ' AVLOCLOW - LOW USER LIMT 05101230 +AOB100B DC XL6'0',C' ,ENTRY ' HIGH LIMIT AVLOCHIH 05101240 +AOB100C DC XL6'0',C' . RUN-TIME RELOCATION ' USER ENTRY @ 05101250 +AOB100D DC XL6'0',C' ***' AVRELOC - RUN-TIME RELOCATION 05101260 +AOB100L EQU *-AOB100 LENGTH OF THIS MESSAGE 05101270 + SPACE 1 05101280 +AOB996 DC C'0*** AL996 - NO TXT CARD RECEIVED ***' 05101290 +AOB996L EQU *-AOB996 LENGTH OF MESSAGE 05101300 + SPACE 1 05101310 +AOB997 DC C'0*** AL997 - TXT CARD ADDRESS BELOW 1ST TXT CARD ***' 05101320 +AOB997L EQU *-AOB997 LENGTH OF MESSAGE 05101330 + SPACE 1 05101340 +AOB998 DC C'0*** AL998 - TXT CARD ADDRESS EXCEEDED STORAGE ***' 05101350 +AOB998L EQU *-AOB998 LENGTH OF MESSAGE 05101360 + SPACE 1 05101370 +AOB999 DC C' *** AL999 - LOAD ABORTED ***' 05101380 +AOB999L EQU *-AOB999 LENGTH OF MESSAGE 05101390 + DROP R6,R7,RAT REMV USINGS: BASE,AOBJCARD,AVWXTABL 05101400 +.AOBJN1 AIF (NOT &$DECK).AOBNONE SKIP IF NO DECK 05101410 + EJECT 05101420 + ENTRY AODECK 05101430 +AODECK $SAVE RGS=(R14-R12),SA=NO,BR=R6 05101440 + USING AVWXTABL,RAT NOTE ASSEMBLER CONTROL TABLE 05101450 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05101455 +*--> ENTRY: AODECK PUNCH OBJECT DECK FOLLOWING ASSEMBLY * 05101460 +* IF THE DECK OPTION IS SPECIFIED, AODECK IS CALLED FOLLOWING * 05101480 +* A SUCCESSFULL ASSEMBLY TO PUNCH THE USER PROGRAM OUT IN OBJECT * 05101490 +* DECK FORM. THE DECK PUNCHED CONTAINS 1 OR MORE TXT CARDS AND * 05101500 +* 1 END CARD, AND FOLLOWS S/360 DECK FORMAT FAIRLY CLOSELY. * 05101510 +* **NOTE** THIS FACILITY IS VERY PRIMITIVE, AND THE DECKS * 05101520 +* PRODUCED CANNOT REALLY BE USED FOR ANYTHING BUT INPUT TO ASSIST, * 05101530 +* SINCE THERE IS NEITHER EXTERNAL SYMBOL DICTIONARY NOR RELOCATION * 05101540 +* DICTIONARY PRODUCED. ALSO, SINCE THE ENTIRE USER PROGRAM IS * 05101550 +* PUNCHED, OBJECT CARDS ARE PRODUCED FOR SPACE CONTAINING ONLY DS * 05101560 +* LOCATIONS. IN SOME CASES, THIS COULD CAUSE HUGE DECKS TO BE * 05101570 +* PUNCHED. IF A BETTER SETUP IS DESIRED, ASSEMBLER MODULE UTOPRS * 05101580 +* COULD BE CHANGED TO PRODUCE SMALLER DECKS, ALTHOUGH RLD ENTRIES * 05101590 +* WOULD STILL BE DIFFICULT TO PRODUCE. * 05101600 +* **NOTE** THE MOST LIKELY USE FOR THIS OPTION IS TO PRODUCE * 05101610 +* OBJECT DECKS TO BE USED AS UTILITY PROGRAMS FROM RJE TERMINALS. * 05101620 +* ENTRY CONDITIONS * 05101630 +* R12(RAT) = @ ASSEMBLER CONTROL TABLE (AVWXTABL). * 05101640 +* USES MACROS: $PNCH,$RETURN,$SAVE * 05101645 +* NAMES: AOD----- * 05101650 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05101660 + SPACE 1 05101670 +* * * * * * * * REGISTER USAGE FOR AODECK * * * * * * * * * * * * * * * 05101680 +* R4 = @ CURRENT BLOCK OF CODE TO BE PUNCHED (INIT = AVRADL). * 05101690 +* R5 = CURRENT LENGTH OF CODE REMAINING (INIT =AVRADH-AVRADL) * 05101700 +* R6 = BASE REGISTER * 05101710 +* R7 = @ AOBJCARD : OBJECT CARD OUTPUT IMAGE * 05101720 +* R8 = CURRENT @ OF CODE TO PUNCHED (USER PROGRAM RELATIVE). * 05101730 +* R9 = L'AOTCODE = LENGTH OF NORMAL(ALL BUT LAST) CODE ON CARD * 05101740 +* R12(RAT)= @ ASSEMBLER CONTROL TABLE (AVWXTABL). * 05101750 +* R13= @ CALLING PROGRAM'S SAVE AREA, UNCHANGED * 05101760 +* R14= INTERNAL LINK REGISTER * 05101770 +* ALL OTHERS ARE UNUSED * 05101780 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05101790 + SPACE 1 05101800 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05101810 +* INITIALIZATION FOR OBJECT PUNCH * 05101820 +* INITIALIZE REGISTERS, SEQUENCE #, AND TXT CARDIMAGE. * 05101830 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05101840 + LM R4,R5,AVRADL AV(RADL-RADH) LOWER/UPPER REAL @'S 05101850 + SR R5,R4 SIZE OF CODE = UPPER-LOWER LIMIT 05101860 + BNP AODEXIT NO MORE, QUIT 05101870 + LA R7,AVCONCAT WE WILL USE THIS AS WORKAREA 05101880 + USING AOBJCARD,R7 NOTE PTR THERE 05101890 + L R8,AVLOCLOW GET LOWEST USER PROGRAM @ 05101900 + MVC AOBJCARD(72),AWBLANK BLANK OUT CARD, EXCEPT SEQUENCE 05101910 + MVC AOBJTYPE,=C'TXT' FLAG AS TXT CARD 05101920 +***** MVI AOBJCARD,X'02' NORMAL S/360 FLAG 05101930 + LA R9,L'AOTCODE LENGTH OF NORMAL OBJECT CODE 05101940 + STH R9,AOTLENG STORE FOR NORMAL LENGTH 05101950 + ZAP AVDWORK1(5),AWP0 ZERO WORKAREA FOR SEQUENCE# 05101960 + UNPK AOTSEQN(8),AVDWORK1(5) MOVE SEQUENCE # OVER 05101970 + OI AOTSEQN+7,X'F0' MAKE PRINTABLE 05101980 + MVI AODTXTMV+1,L'AOTCODE-1 NORMAL LENGTH-1 OF OBJCODE 05101990 + SPACE 1 05102000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05102010 +* LOOP FOR PUNCHING OBJECT DECK * 05102020 +* PUNCH FULL OBJECT CARD FOR (ALL BUT POSSIBLY LAST BLOCK) * 05102030 +* OF CODE IN USER PROGRAM. * 05102040 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05102050 +AODTXT EQU * 05102060 + ST R8,AOTADDR STORE USER CODE FAKE @ INTO CARD 05102070 +***** MVI AOTADDR,C' ' BLANK OUT FOR S/360 NORMAL 05102080 + CR R5,R9 HOW MUCH IS LEFT TO BE PUNCHED 05102090 + BNL AODTNORM STILL ENOUGH FOR FULL CARD-BRANCH 05102100 + SPACE 1 05102110 + BCTR R5,0 LENGTH-1 FOR MVC 05102120 + STC R5,AODTXTMV+1 STORE INTO MVC FOR LAST PUNCH 05102130 + MVC AOTCODE,AWBLANK BLANK OUT WHOLE CARD, SINCE PART NOT 05102140 +AODTNORM EQU * 05102150 +AODTXTMV MVC AOTCODE($),0(R4) MOVE CODE FROM MEMORY 05102160 + BAL R14,AODPUNCH GO PUNCH THE CARD 05102170 + AP AVDWORK1(5),AWP1 INCREMENT THE CARD COUNTER 05102180 + UNPK AOTSEQN(8),AVDWORK1(5) UNPACK FOR NEXT CARD 05102190 + OI AOTSEQN+7,X'F0' MAKE SURE PRINTABLE 05102200 + AR R8,R9 INCREMENT USER CODE @ 05102210 + AR R4,R9 INCREMENT REAL @ IN MEMORY PTR 05102220 + SR R5,R9 DECREMENT LENGTH PUNCHED LAST TIME 05102230 + BP AODTXT IF MORE TO DO, RETURN FOR NEXT CARD 05102240 + SPACE 1 05102250 +* ***** COMPLETION - PUNCH END CARD 05102260 + MVC AOBJTYPE,=C'END' MAKE CARD AN END CARD 05102270 + MVC AOEBLNK(AOEBLNKL),AWBLANK BLANK OUT CARD(CEPT SEQN#) 05102280 + MVC AOENTRY2,AVFENTER+1 MOVE ENTRY @ IN 05102290 + BAL R14,AODPUNCH PUNCH THE ASSEMBLED END CARD 05102300 +AODEXIT $RETURN RGS=(R14-R12),SA=NO 05102310 + SPACE 1 05102320 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05102325 +*--> INSUB: AODPUNCH PUNCH 1 OBJECT CARD FOR AODECK * 05102330 +* ENTRY CONDITIONS * 05102340 +* R14= RETURN @ TO CALLING SECTION OF CODE * 05102350 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05102360 +AODPUNCH EQU * 05102370 + $PNCH AOBJCARD,80,AODEXIT PUNCH, QUIT IF OVERRUN 05102380 + BR R14 RETURN TO CALLING SECTION 05102390 + LTORG 05102400 + DROP R6,R7,RAT REMV USINGS: BASE,AOBJCARD,AVWXTABL 05102410 +.AOBNONE ANOP 05102420 + AIF (&$EXINT).EXYZ SKIP IF USING EXTENDED INTERPRETER 05102425 + TITLE '*** EXECUT - ASSIST INTERPRETER SECTION ***' 05102430 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05102435 +*--> CSECT: EXECUT INTERPRETER SECTION * 05102440 +* EXECUT PERFORMS ALL 360 INSTRUCTION SIMULATION DURING * 05102450 +* INTERPRETIVE EXECUTION OF THE USER PROGRAM. ALL CONTROL * 05102460 +* VALUES FOR THIS MODULE ARE CONTAINED IN DSECT ECONTROL, WHICH* 05102470 +* IS PASSED TO EXECUT BY THE CALLING PROGRAM. THE INSTRUCTION.* 05102480 +* SET SIMULATED INCLUDES THE FOLLOWING: * 05102490 +* 1. STANDARD INSTRUCTION SET (INCL. 370'S IF ALLOWED) * 05102500 +* 2. DECIMAL INSTRUCTION SET (IF PRESENT ON MACHINE). * 05102510 +* 3. FLOATING POINT INSTRUCTIONS (OPTIONAL). * 05102520 +* 4. X-MACRO PSEUDO INSTRUCTIONS - XDUMP, XLIMD, * 05102530 +* XPNCH, XPRNT, XREAD. * 05102540 +* THE PRIVILEGED OPERATIONS MAY BE DECODED TO THE POINT OF * 05102550 +* BRANCHING TO INDIVIDUAL INSTRUCTION HANDLERS, BUT THEY ARE * 05102600 +* ARE FLAGGED WITH AN 0C2 INTERRUPT AT PRESENT, AND ARE NOT * 05102650 +* INTERPRETED FURTHER. THE CODE PRESENT IS FOR FUTURE USE. * 05102700 +* THE SVC INSTRUCTION IS CURRENTLY FLAGGED WITH AN 0C2 IF* 05102750 +* USED, BUT CODE EXISTS TO HANDLE ALL SVC CALLS IN A TABLE- * 05102800 +* DRIVEN WAY, USING THE @ OF AN SVC CONTROL TABLE PASSED IN THE* 05102850 +* WORD ECSVCADS IN ECONTROL. AS OF 8/2/70, THERE ARE NOT SVC * 05102900 +* ROUTINES, BUT THE CODE EXISTS FOR FUTURE USE. * 05102950 +* GENERAL CODE IS ALSO PROVIDED FOR ANY ADDITIONAL NEW * 05103000 +* INSTRUCTIONS OR I/O SIMULATORS BY THE SECTION EXCALL, WHICH * 05103050 +* ALLOWS CALLS TO EXTERNAL ROUTINES (WHICH WOULD BE USED BY * 05103100 +* ANY SVC CALLS, IF THERE ARE ANY). * 05103150 +* ENTRY CONDITIONS * 05104000 +* R10= @ ECONTROL - EXECUTION CONTROL BLOCK. * 05106000 +* ECONTROL CONTAINS ALL INITIAL VALUES FOR REGS,LIMITS,ETC. * 05106050 +* EXIT CONDITIONS * 05106100 +* ECINTCOD CONTAINS INTERRRUPT CODE, IF PROGRAM INTERRUPT. * 05106150 +* ECFLAG1 CONTAINS SPECIAL COMPLETION CODE, IF ANY. * 05106200 +* ECERRAD = ADDRESS OF AN ERCOMPCD ERROR COMPLETION CODE BLOCK * 05106250 +* ECONTROL CONTAINS ALL OTHER VALUES NEEDED FOR A COMPLETION DUMP.* 05106300 +* USES DSECTS: ECONTROL,ECSTACKD * 05106350 +* USES MACROS: $AL2,$ERCGN,$PNCH,$PRNT,$READ,$RETURN,$SAVE * 05106400 +* USES MACROS: $SPIE, XDECI, XDECO, XSNAP * 05106450 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05108000 +EXECUT CSECT 05110000 + $DBG ,NO KILL TRACE CODE HERE 05114000 + SPACE 1 05115000 +EXPRFETC EQU B'10000000' (EXIPROT) - INST ACCESSES STORAGE 05116000 +EXPRSTOR EQU B'01000000' (EXIPROT) - INST MODIFIES STORAGE 05118000 +EXPRFET2 EQU B'00100000' (EXIPROT) - SS INST ACCESSES CORE 05120000 +EXPRSTO2 EQU B'00010000' (EXIPROT) - SS INST MODS CORE(2ND @) 05122000 + SPACE 1 05124000 +* *** SYMBOLIC REGISTER EQUATES *** * 05126000 +RSTK EQU R3 ADDR OF CURRENT INST. STACK ENTRY 05128000 +RIA EQU R4 INSTRUCTION ADDRESS REGISTER 05130000 +RCC EQU R5 CONDITION CODE REGISTER 05132000 +REC EQU R6 POINTER TO ECONTROL BLOCK 05134000 +RWK EQU R7 WORK REGISTER 05136000 +RR1 EQU R8 DECODING REGISTER FOR R1 FIELD 05138000 +RR2 EQU R9 REGISTER 2 (WHEN USED IN RR'S) 05140000 +RX2 EQU RR2 INDEX REGISTER(FOR RX'S) 05142000 +RR3 EQU RR2 RO OPERAND(FOR RS INST) 05144000 +RB1 EQU R10 1ST BASE-DISPLACEMENT-(B1-D1) 05146000 +RB2 EQU R11 2ND BASE-DISPLACEMENT-(B2-D2) 05148000 +RMEM EQU R12 CONTAINS RELOCATION VALUE 05150000 +RLINK EQU R14 INTERNAL LINAKGE REGISTER-RETURN ADD 05152000 +ROP EQU R15 USED TO HOLD OPCODE BYTE 05154000 +* **NOTE** DURING MAIN EXECUTION REGS R2,ROP ARE BYTE REGS. * 05156000 + SPACE 1 05158000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05160000 +* * 05162000 +* ORGANIZATION OF THE ASSIST INTERPRETER * 05164000 +* * 05166000 +* 1. INITIALIZATION CODE * 05168000 +* 2. INTERRUPT-HANDLING AND EXIT CODE * 05170000 +* 3. OCCASIONAL INTERNAL SUBROUTINE CODE * 05172000 +* 4. PRIMARY INSTRUCTION FETCH AND COMMON DECODING * 05174000 +* 5. 1ST-LEVEL DECODING, IN GROUPS : RR, RX, SI-RS, AND SS * 05176000 +* 6. 2ND-LEVEL SECTIONS-PERFORM INDIVIDUAL INSTRUCTIONS, * 05178000 +* IN GROUPS: RR, RR-RX OVERLAP, RX, SI, RS, SS,SPECIAL * 05180000 +* 7. 3RD-LEVEL INTERNAL SUBROUTINES (DECODERS,RANGE CHECK) * 05182000 +* 8. DATA AREAS, OPCODE BRANCH AND PROTECTION TABLES * 05184000 +* * 05186000 +* **WARNING** ADDRESSIBILITY IS NOW TIGHT IN EXECUT. * 05187000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05188000 + EJECT 05190000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05192000 +* INITIALIZATION PHASE - OBTAIN PARAMATER ADDRESSES FROM CALLER* 05194000 +* PERFORM CALCULATIONS TO GET THEM INTO NEEDED FORM. ZERO OUT THE * 05196000 +* INSTRUCTION STACK FINSTACK,AND INITIALIZE ANY REQUIRED REGISTER * 05198000 +* VALUES FOR THE EXECUTION. ALSO SAVE INSTRUCTION LIMIT VALUE. * 05200000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05202000 + SPACE 1 05204000 + $SAVE RGS=(R14-R12),BR=R8,SA=EXECSAVE 05206000 + LR REC,R10 MOVE ECONTROL BLOCK POINTER OVER 05210000 + USING ECONTROL,REC NOTE USAGE 05212000 + TM ECFLAG0,$ECCONT IS THIS A CONTINUE OR A NEW 05214000 + BO EXCONTIN INIT ALREADY DONE-KEEP GOING 05216000 + OI ECFLAG0,$ECCONT NOTE THAT ANY OTHERS WILL BE CONTINU 05218000 + SPACE 1 05220000 +* INSTRUCTION STACK ZEROING AND CHAINING. * 05222000 + SR R1,R1 CLEAR FOR ZEROING USE 05224000 + SR R2,R2 CLEAR FOR ZEROING 05226000 + SR R3,R3 CLEAR FOR ZEROING 05228000 + LA R4,L'ECSTENT VALUE OF SINGLE ENTRY 05230000 + LA R5,ECINSTAC+L'ECINSTAC*(EC$STACK-1) GET ENDING LIMIT 05232000 + LA R7,ECINSTAC GET BEGINNING ADDRESS OF STACK AREA 05234000 + USING ECSTACKD,R7 SET UP TEMPORARY USING 05236000 + LA R0,ECINSTAC+L'ECINSTAC GET @ 2ND ELEMENT 05238000 + SPACE 1 05240000 +EXINITST STM R0,R3,ECSTENT ZERO 1 TABLE ENTRY 05242000 + LR R7,R0 UPDATE POINTER TO STACK ENTRY 05244000 + BXLE R0,R4,EXINITST CONTINUE LOOPING 05246000 + SPACE 1 05248000 + LA R0,ECINSTAC ADDRESS FOR WRAPAROUND 05250000 + STM R0,R3,ECSTENT STORE IN LAST ENTRY 05252000 + ST R7,ECRSTK SAVE WHERE CAN BE PICKED UP 05254000 + DROP R7 DROP TEMPORARY REG TO KEEP USING STRAIGHT 05256000 + MVC ECILIMT,ECILIMP MOVE PERMANENT TO TEMPORARY 05258000 + MVC ECILCMSK(4),ECFENTER MAKE ENTRY POINT THE PSW 05260000 + MVC ECR14SAV,ECREG14 SAVE FOR ORIGINAL RETURN @ 05261000 + SPACE 1 05262000 +EXCONTIN BAL RLINK,EXADCALC GO TO RECALCULATE ADDRESSES IF NEED 05264000 + SPACE 1 05266000 +EXSPIEGO EQU * 05268000 + TM ECFLAG0,$ECSPIEA IS OUR SPIE ALREADY IN EFFECT 05270000 + BO EXSPIEA YES,WE DON'T HAVE TO RE-SPIE 05272000 + $SPIE EXSPIERT,((1,15)),CE=EXSPIEXT,ACTION=CR CATCH ALL INTRP 05274000 + ST R1,ECPICA SAVE PREVIOUS PICA, IF ANY 05276000 + OI ECFLAG0,$ECSPIEA SHOW OUR SPIE IS IN CONTROL 05278000 +EXSPIEA L RSTK,ECRSTK GET POINTER TO NEXT SLOT FOR STACK 05280000 + USING ECSTACKD,RSTK SET UP STACK USING FROM NOW ON 05282000 + L RMEM,ECRELOC GET RELOCATION VALUE IN REGISTER 05284000 + SR R2,R2 CLEAR REG FOR CONSTANT INSERTS 05286000 + STH R2,ECINTCOD SET THE INTERRUPT CODE TO 0 05288000 + SR ROP,ROP CLEAR OPCODE REG FOR CONSTANT IC'S 05292000 + L RB2,ECILCMSK LOAD INST ADDR WHERE EXFINB EXPECTS 05294000 + LR RCC,RB2 PLACE CC AND MASK OVER 05296000 + SPM RCC INITIALIZE REAL CC TO FAKE ONE 05298000 + AIF (NOT &$FLOTE).EXNOFL1 SKIP IF NOT GOING TO DO FP 05300000 + LD F0,ECFPREGS GET FP REG 05302000 + LD F2,ECFPREGS+8 GET 2ND FP REG 05304000 + LD F4,ECFPREGS+16 LOAD 3RD FP REG 05306000 + LD F6,ECFPREGS+24 GET 4TH FP REG 05308000 +.EXNOFL1 ANOP 05310000 + B EXFINB SKIP TO START RUN 05312000 +EXECSAVE DC 18F'0' SAVE AREA, ALSO BASE REGISTER HERE 05314000 + DROP R8 KILL TEMPORARY USING 05316000 + USING EXECSAVE,R13 USE R13 AS BASE/SAVEAREA POINTER 05318000 +EXJUMP DS 0H BASE FOR 2ND LEVEL INDEX JUMPS 05320000 + SPACE 1 05322000 +* * * * * 0CX INTERRUPT EXITS * * * * * * * * * * * * * * * * * * * * 05324000 +* THE LABELS ARE HERE SO THAT OTHERS MAY BE EQU'D TO THEM* 05326000 +EX0C1 LA R0,1 SHOW OPERATION INTERRUPT 05328000 + AIF (&$DEBUG).EX0C1A SKIP DEBUG CODE IF PRODUCTION 05330000 + CLI ECOP,X'83' IS CODE THE PSEUDO DIAGNOSE 05332000 + BE EXDIAG YES,GO THERE FOR OUR PSEUDO DIAGNOSE 05334000 +.EX0C1A ANOP 05336000 + B EXEXITI EXIT POINT FOR INTERRUPTS 05338000 +EX0C2C EQU * CHECK FOR PRIVILEGED OPERATION 05340000 + TM ECKYAMWP,$ECPRBST ARE WE IN PROBLEM STATE 05342000 + BCR Z,RLINK NO,SUPERVISOR STATE,SO OK-RETURN 05344000 +EX0C2 LA R0,2 PRIVILEGED OPERATION 05346000 + B EXEXITI EXIT POINT FOR INTERRUPTS 05348000 +EX0C3 LA R0,3 EXECUTE INTERRUPT 05350000 + B EXEXITI EXIT POINT FOR INTERRUPTS 05352000 +EX0C4 LA R0,4 PROTECTION INTERRUPT 05354000 + B EXEXITI EXIT POINT FOR INTERRUPTS 05356000 +*EX0C5 LA R0,5 ADDRESSING INTERRUPT 05358000 +* B EXEXITI QUIT 05360000 +EX0C6 LA R0,6 SPECIFICATION INTERRUPT 05362000 + B EXEXITI EXIT POINT FOR INTERRUPTS 05364000 +*EX0C7 LA R0,7 DATA EXCEPTION 05366000 +* B EXITI QUIT 05368000 +EX0CA LA R0,10 DECIMAL OVERFLOW 05369000 + B EXEXITI QUIT 05369500 + SPACE 2 05370000 +* ENTERED WHEN PROGRAM BRANCHES OUT OF RANGE * 05372000 +EXIAOUT MVI ECFLAG1,$ECBRN14 HOPE FOR NORMAL RETURN 05372500 + L R14,ECR14SAV GET RETURN @, ORIGINAL 05373000 + LA R14,0(R14) REMOVE LEADING BYTE 05373500 + CR RIA,R14 WAS BRANCH TO THIS @ 05374000 + BE EXITA RETURN 05374500 + MVI ECFLAG1,$ECBROUT WAS ACTUAL BRANCH OUT OF PROG,RET 05375000 + LA R1,EXCCBROU SHOW @ BRANCH OUT 05376000 + B EXITIA GO HAVE @ STORED, QUIT 05378000 + EJECT 05380000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05382000 +* INTERRUPT HANDLER - THIS SECTION IS ENTERED FOR ANY * 05384000 +* REAL INTERRUPT, SUCH AS 0C7,0C6,ETC. THE REAL INTERRUPT * 05386000 +* IS SAVED AS THE PSEUDO INTERRUPT, SINCE THEY MUST BE THE * 05388000 +* SAME. THE ADDRESS IN THE PSW PART OF THE PIE IS MODIFIED SO * 05390000 +* THAT OS WILL RETURN CONTROL TO EXSPIERT INSTEAD OF TO THE * 05392000 +* INTERRUPTED CODE, AND THEN CONTROL IS GIVEN TO OS. WHEN THE * 05394000 +* INTERPRETER REGAINS CONTROL, IT EXITS, SHOWING AN INTERRUPT. * 05396000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05400000 + SPACE 1 05402000 + USING *,R15 05404000 +EXSPIEXT LH RB1,2(R1) GET INTERRUPT CODE FROM PIE 05406000 + AIF (&$DEBUG).EXXNSP SKIP IF PRODUCTION 05410000 + XSNAP LABEL='SPIE',STORAGE=(*0(R1),*32(R1)), X05412000 + IF=(ECFLAG2,O,X'20',TM) XSNAP PIE 05414000 +.EXXNSP ANOP 05416000 + BR R14 RETURN TO OS CONTROL 05420000 + DROP R15 DROP USING TO KEEP STRAIGHT 05424000 + SPACE 1 05426000 +EXSPIERT LR R0,RB1 MOVE INTERRUPT CODE OVER WHERE NEED 05430000 + EJECT 05432000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05434000 +* EXIT AND RETURN CODE - SAVE EVERYTHING REQUIRED, * 05436000 +* REMOVE $SPIE IF NECESSARY, AND RETURN TO CALLER. * 05438000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05440000 + SPACE 1 05442000 +EXEXITI STH R0,ECINTCOD SAVE INTO INTERRUPT CODE 05444000 + MVI ECFLAG1,0 RESET, NEEDED BY REPLACE MONITOR 05444500 +* FOLLOWING FINDS MESSAGE FOR 0CX COMPLETION CODES. * 05446000 + ALR R0,R0 SLL R0,1,DOUBLE CODE FOR INDEX 05448000 + LR R1,R0 MOVE WHERE WE CAN USE FOR INDEX 05450000 + LH R1,EXCOFFS(R1) GET OFFSET TO MESSAGE BLOCK 05452000 + LA R1,EXCC0(R1) GET @ MESSAGE BLOCK 05454000 +EXITIA ST R1,ECERRAD STORE THIS @ IN ECONTROL 05456000 + SPACE 1 05458000 +EXITA ST RSTK,ECRSTK SAVE THE STACK POINTER 05460000 + N RCC,=XL4'3F000000' REMOVE @, ILC(WHICH IS WRONG) 05462000 + ALR RCC,RIA PUT THE ADDRESS AND CONCODE TOGETHER 05464000 + ST RCC,ECILCMSK SAVE INTO THE PSW 05466000 + OI ECILCMSK,X'40' SET ILC TO =1 05468000 + CLI ECOP,X'40' WAS LAST INSTRUCTION RR 05470000 + BL EXITAILC YES, SO ILC IS SET RIGHT,BRANCH 05472000 + XI ECILCMSK,X'C0' SET ILC TO 2 FOR RX-SI-RS 05474000 + CLI ECOP,X'C0' WAS INST AN SS 05476000 + BL EXITAILC NO, IT WAS SI-RX-RS, BRANCH, ILC=2 05478000 + OI ECILCMSK,X'40' SET ILC=3 FOR SS INSTS 05480000 +EXITAILC EQU * 05482000 + AIF (NOT &$FLOTE).EXNOFL3 SKIP IF NOT FLOATINGS 05484000 + STD F0,ECFPREGS STORE FIRST FP REG 05486000 + STD F2,ECFPREGS+8 STORE 2ND FP REG 05488000 + STD F4,ECFPREGS+16 SAVE THE THIRD FP REG 05490000 + STD F6,ECFPREGS+24 SAVE 4TH FP REG 05492000 +.EXNOFL3 ANOP 05494000 + TM ECFLAG0,$ECSPIEB DO WE NEED TO UNDO SPIE 05496000 + BZ EXECRET NO WE DON'T,SO DON'T SPIE 05498000 + L R1,ECPICA GET PICA ADDRESS BACK 05500000 + $SPIE ACTION=(RS,(1)) RESTORE PREVIOUS XSPIEBLK 05506000 + NI ECFLAG0,255-$ECSPIEA WE WILL HAVE TO RESPIES 05508000 +EXECRET $RETURN RGS=(R14-R12) 05510000 + EJECT 05532000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05534000 +* SPECIAL ROUTINES - THE FOLLOWING ROUTINES ARE USED AT MOST * 05536000 +* OCCASIONALLY, AND ARE NOT DIRECTLY PARTS OF THE INTERPRETER. * 05538000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05540000 + SPACE 1 05542000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05544000 +* EXTERNAL CALL ROUTINE - THIS SECTION PREPARES ALL OF * 05546000 +* THE DUMMY MACHINE AREAS, AND CALLS THE ROUTINE WHOSE ADDRESS * 05548000 +* IS IN RWK. IT CHECKS FOR AN INTERRUPT CONDITION,RESTORES * 05550000 +* ALL THE REGISTERS, AND RETURNS CONTROL TO NORMAL EXECUTION. * 05552000 +* ***NOTE*** THIS ROUTINE IS MAINLY FOR FUTURE USE, I.E. FOR * 05554000 +* IMPLEMENTATION OF CERTAIN SVC'S, MACHINE LEVEL I/O, OR * 05556000 +* ANY ADDITIONAL PSEUDO MACHINE OPCODES WHICH ARE REQUIRED. * 05558000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05560000 + SPACE 1 05562000 +EXCALL STM R0,R15,ECTSAVE SAVE THE REGS TO BE SAFE 05564000 + ST RSTK,ECRSTK SAVE POINTER IN CONTROL BLOCK 05566000 + N RCC,=XL4'3F000000' REMOVE EXTRA BITS IN CC REG 05567000 + ALR RCC,RIA PUT THE ADDRESS AND CONCODE TOGETHER 05568000 + ST RCC,ECILCMSK SAVE INTO THE PSW 05570000 + LR R15,RWK PLACE ADDRESS IN R15 FOR CALL 05572000 + BALR RLINK,R15 CALL THE ROUTINE 05574000 + LM R0,R15,ECTSAVE RESTORE THE REGS 05576000 + SR R0,R0 CLEAR THIS OUT 05578000 + CH R0,ECINTCOD SEE IF INTERRUPT CODE 05580000 + BNE EXITA IF THERE WAS CODE-RETURN 05582000 + CLI ECFLAG1,0 WAS SPECIAL CODE STILL 0 05584000 + BNE EXITA NO,SO EXIT WITH ERROR FLAG 05586000 + BAL RLINK,EXADCALC HAVE ADDRESS RECALCULATED IF NEEDED 05588000 + L RB2,ECILCMSK GET PSW BACK 05590000 + LR RCC,RB2 GET CC AND MASK BACK 05592000 + B EXFINB BRANCH THERE, IN CASE PSW CHANGED 05594000 + SPACE 1 05596000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05598000 +* ADDRESS CALCULATION SECTION - IF THE ADDRESS VALUES * 05600000 +* MAY HAVE BEEN CHANGED, OR ARE NOT ALREADY COMPUTED,THIS * 05602000 +* SECTION FINDS THE USER HIGH ADDRESS AND RELOCATION FACTOR * 05604000 +* GIVEN REAL LOW AND HIGH ADDRESSES, AND USER LOW ADDRESS. * 05606000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05608000 + SPACE 1 05610000 +EXADCALC TM ECFLAG0,$ECADSOK SEE IF THE ADDR'S NEED FIXING 05612000 + BCR O,RLINK RETURN IF CALCULATIONS UNNEEDED 05614000 + OI ECFLAG0,$ECADSOK FLAG ADDRS OK, WHICH THEY WILL BE 05616000 + L R0,ECRADH GET REAL HIGH ADDRESS LIMIT 05618000 + S R0,ECRADL GET LENGTH OF PROGRAM 05620000 + A R0,ECFADL ADD TO FAKE LOW ADDRESS 05622000 + ST R0,ECFADH STORE THIS IN FAKE HIGHEST 05624000 + SH R0,=H'256' FOR @ CHECKING DIFFERENCE 05626000 + ST R0,ECFADHC SAVE FOR @ CHECKING EXRANGE 05628000 + L R0,ECRADL GET REAL LOWEST ADDRESS 05630000 + S R0,ECFADL SUBTRACT TO GET RELOCATION EXEC 05632000 + ST R0,ECRELOC SAVE THIS FOR EXECUTION TIME RELOCAT 05634000 + BR RLINK RETURN TO CALLING SECTION 05636000 + EJECT 05638000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05640000 +* MAIN INTERPRETER LOOP HEAD. ALL SUCCESSFUL BRANCHES PASS * 05642000 +* THROUGH EFINB, WHICH CHECKS FOR ILLEGAL BRANCHES. CONTROL THEN * 05644000 +* PASSES THROUGH EFIN,WHICH CHECKS FOR LOOPING BEYOND INSTRUCTION * 05646000 +* COUNT LIMIT. ALL OTHER INSTRUCTIONS SKIP EFINB AND RETURN * 05648000 +* DIRECTLY TO EFIN. THE NEXT INSTRUCTION IS THEN ACCESSED,DECODED * 05650000 +* PARTIALLY FOR 4-WAY BRANCH (RR,RX,SI&RS,SS),AND VARIOUS * 05652000 +* BOOKKEEPING DETAILS DONE (UPDATING INSTRUCTION ADDRESS,MOVING * 05654000 +* INSTRUCTION INTO NEXT STACK LOCATION,ETC. ) * 05656000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05658000 + SPACE 1 05660000 +EXFINB LA RIA,0(RB2) MOVE BRANCH ADDRESS OVER,REM 1ST BYT 05662000 + C RIA,ECFADL COMPARE FOR BELOW LOWEST FAKE 05664000 + BL EXIAOUT BRANCHED OUT OF RANGE 05666000 + C RIA,ECFADH COMPARE TO NEXT ADDRESS BEYOND AREA 05668000 + BNL EXIAOUT ADDRESS OUT OF RANGE-ERROR 05670000 + AIF (NOT &$ALIGN).EXFT1 SKIP IF MACHINE REQUIRES ALIGN 05671000 + ST RB2,ECTSAVE SAVE ADDR: MUST DO CHECK SLOW WAY 05671100 + TM ECTSAVE+3,X'01' WAS ADDR ODD 05671200 + BO EX0C6 YES-BAD PROGRAMMER-JUMP 05671300 +.EXFT1 AIF (&$ALIGN).EXFT2 SKIP IF ALIGN NOT NEEDED 05671400 + LH R0,0(RB2,RMEM) QUICK ALIGNEMNT CHECK 05672000 +.EXFT2 ANOP 05672050 +* IF TIMER RUNOUT OCCURS, ASSIST SETS ECFLAG1=$ECTIMEX. 05672100 +* EXECUT DISCOVERS THIS NEXT TIME BRANCH IS SUCCESSFUL. 05672200 + AIF (&$TIMER EQ 0).EXNOTOA SKIP IF NO TIMER AT ALL 05672250 + CLI ECFLAG1,$ECTIMEX HAS FLAG BEEN SET BY TIMER EXIT 05672300 + BE EXOVRTIM YES, SO GO THERE, TIME RAN OUT 05672400 +.EXNOTOA ANOP 05672450 + SPACE 2 05672500 +* CHECK FOR EXCEEDING TOTAL INSTRUCTION COUNT * 05676000 +* ALL INSTRUCTIONS BUT SUCCESSFUL BRANCHES ENTER HERE * 05678000 +EXFIN L R0,ECILIMT GET THE COUNTER 05680000 +EXTIMDEC BCT R0,EXGO DECREMENT COUNTER, BRANCH IF OK 05682000 + ST R0,ECILIMT RESTORE INST COUNT FOR STATS(0) 05684000 + MVI ECFLAG1,$ECTIMEX SHOW TIME EXCEEDED(INSTR LIMIT) 05686000 + LA R1,EXCCTIME SHOW @ TIME MESSAGE 05688000 + B EXITIA GO TO FINISH AND EXIT 05692000 + AIF (&$TIMER EQ 0).EXNOTOB SKIP IF NO TIMER AT ALL 05693000 +EXOVRTIM LA R1,EXCCTIMB SHOW TIMER OVER. ECFLAG1 ALREADY SET 05694000 + B EXITIA SKIP TO EXIT SECTION 05696000 +.EXNOTOB ANOP 05697000 +EXGO ST R0,ECILIMT STORE THIS BACK IN LIMIT 05698000 + SPACE 1 05700000 +* INSTRUCTION FETCH AND PRIMARY DECODING SECTION. * 05702000 + SPACE 1 05704000 + LA RWK,0(RIA,RMEM) OBTAIN PHYSICAL REAL ADDRESS 05706000 +EXFEXENT L RSTK,ECSTLINK OBTAIN ADDRESS OF NEXT STACK SLOT 05708000 + STM RIA,RCC,ECSTIADD SAVE INSTRUCTION ADDRESS,CC,MASK 05710000 + MVC ECSTINST,0(RWK) MOVE 6 BYTES INTO NEXT SLOT 05712000 + IC ROP,ECOP GET OPCODE INTO REGISTER 05714000 + IC R2,EXOPTAB1(ROP) GET SECONDARY CODE FOR OPCODES 05716000 + LR R1,ROP GET OPCODE WHERE CAN BE CHANGED 05718000 + SRL R1,6 REMOVE ALL BUT 1ST 2 BITS 05720000 + SLL R1,2 SHIFT BACK = MULT*4 FOR INDEX 05722000 + AIF (&$DEBUG).EXSNAP1 SKIP XSNAPS GENERATION IF NOT DEBUG 05724000 + XSNAP LABEL='PRIMARY FETCH',IF=(ECFLAG2,O,X'80',TM), #05726000 + STORAGE=(*ECSTENT,*ECB2D2+2,*ECFPREGS,*ECILIMP) 05728000 + LM RB1,RB2,ECRADL GET LOW AND HIGH @ POINTERS 05730000 + XSNAP T=NO,LABEL='USER AREA',STORAGE=(*0(RB1),*0(RB2)),IF=(ECF#05732000 + LAG2,O,X'40',TM) 05734000 +.EXSNAP1 ANOP 05736000 + SPACE 1 05738000 +* UPDATE INSTRUCTION COUNTER RIA TO NEXT INSTRUCTION, * 05740000 +* TAKE 4-WAY BRANCH TO PRIMARY TYPE DECODING SECTIONS. * 05742000 +EXEXLEN A $CHN+RIA,EXILENG(R1) UPDATE RIA**CHANGED BY EXEX***** 05744000 +EXPRIME B *+4(R1) TAKE BRANCH FOR PRIMARY PROCESSING 05746000 + B EXTRR R1=0 ==> RR INSTRUCTION 05748000 + B EXTRX R1=4 ==> RX INSTRUCTION 05750000 + B EXTSIRS R1=8 ==> SI OR RS INSTRUCTION 05752000 + B EXTSS R1=12 ==> SS INSTRUCTION 05754000 + EJECT 05756000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05758000 +* RR PRIMARY DECODING - DECODE R1-R2 FIELDS,THEN MAKE * 05760000 +* SECOND LEVEL BRANCH TO INDIVIDUAL INSTRUCTION PROCESSORS. * 05762000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05764000 + SPACE 1 05766000 +EXTRR BAL RLINK,EXR1R2 GET R1,R2 FIELDS SEPARATED 05768000 + LH R1,EXSECRR(R2) GET SECOND LEVEL BRANCH INDEX VALUE 05770000 + B EXJUMP(R1) TAKE BRANCH TO INDIVIUDAL ROUTINES 05772000 + SPACE 4 05774000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05776000 +* RX PRIMARY DECODING - DECODE B2-D2 FIELDS,R1-X2 FIELDS, * 05778000 +* YIELDING 2ND OPERAND ADDRESS IN REGISTER RB2. IF INSTRUCTION IS * 05780000 +* ONE OF THOSE NOT REQUIRING ADDRESS RELOCATION(I.E. BRANCHES OF * 05782000 +* SOME TYPE,LOAD ADDRESS) TAKE SECOND LEVEL BRANCH IMMEDIATELY. * 05784000 +* FOR OTHER INSTRUCTIONS,THE 2ND OPERAND ADDRESS IS CHECKED FOR * 05786000 +* WITHIN THE PERMITTED RANGE BY EXRANGE, AND THEN THE ADDRESS IS * 05788000 +* RELOCATED TO THE ACTUAL CORE ADDRESS. THEN THE SECOND-LEVEL * 05790000 +* CHOICE IS MADE FOR THE INDIVIDUAL PROCESSORS. * 05792000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05794000 + SPACE 1 05796000 +EXTRX BAL RLINK,EXABD PERFORM B2-D2 ADDRESS CALCULATION 05798000 + BAL RLINK,EXR1R2 OBTAIN R1,X2 FIELDS 05800000 + BZ EXRXNOX IF X2=0,NO INDEXING NEED BE DONE 05802000 + AL RB2,ECREGS(RX2) PERFORM INDEXING OPERATION 05804000 + LA RB2,0(RB2) ZAP POSSIBLE 1ST BYTE FROM X2 FIELD 05806000 +EXRXNOX LH R1,EXSECRX(R2) GET BRANCH INDEX ADDRESS 05808000 + CH R2,EXNORNG COMPARE WITH HIGHEST FOR NO RANGECK 05810000 + BNH EXJUMP(R1) TAKE BRANCH TO ROUTINES 05812000 + BAL RLINK,EXRANGE HAVE THE RANGE CHECKED FOR THE INST 05814000 + AR RB2,RMEM RELOCATE FAKE @ TO REAL @ 05816000 + AIF (&$S370 NE 2).EXTRX SKIP IF NOT SIMULATING S/370'S 05816100 + TM ECFLAG4,AJONALGN MUST WE FAKE ALIGNMENT 05816200 + BZ EXJUMP(R1) NO--> BRANCH 05816300 + CH R2,EXALIGN DOES INSTRUCTION REQUIRE ALIGNMENT 05816400 + BH EXJUMP(R1) NO--> BRANCH 05816500 + LTR RB1,RB2 SAVE FOR LATER, SET CC TO ^= 05816600 + MVC EXDUBLWD(8),0(RB2) MOVE MAXIMUM OF 8 BYTES OVER 05816700 + LA RB2,EXDUBLWD LOAD ADDRESS OF ALIGNED FIELD 05816800 +.EXTRX ANOP 05816900 + B EXJUMP(R1) TAKE BRANCH TO APPROPRIATE ROUTINE 05818000 + SPACE 4 05820000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05822000 +* SI-RS PRIMARY DECODING - DECODE B1-D1 FIELD,WITH RESULTING * 05824000 +* ADDRESS APPEARING IN REGISTER RB2. THEN MAKE SECOND-LEVEL CHOICE * 05826000 +* TO THE VARIOUS INDIVIDUAL PROCESSORS. * 05828000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05830000 + SPACE 1 05832000 +EXTSIRS BAL RLINK,EXABD ADDRESSING FOR B1-D1 FIELD 05834000 + LH R1,EXSECSI(R2) GET SECOND LEVEL JUMP INDEX 05836000 + B EXJUMP(R1) TAKE BRANCH TO INDIVIUAL ROUTINE 05838000 + EJECT 05840000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05842000 +* SS PRIMARY DECODING - DECODE AND CHECK 1ST AND 2ND OPERAND * 05844000 +* ADDRESSES FOR WITHIN RANGE,USING DECODED VALUES OF L OR L1 AND L2 * 05846000 +* FIELDS AS REQUIRED. AFTER RELOCATING TO ACTUAL MACHINE ADDRESSES, * 05848000 +* MAKE SECOND-LEVEL BRANCH TO INDIVIDUAL PROCESSOR SEGMENTS. * 05850000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05852000 + SPACE 1 05854000 +EXTSS BAL RLINK,EXABD HAVE 1ST @ DECODED 05856000 + BAL RLINK,EXRANGE CHECK 1ST @ FOR WITHIN RANGE 05858000 + LA RB1,0(RB2,RMEM) RELOCATE THE 1ST @ TO REAL @ 05860000 + LH RB2,ECB2D2 GET THE BASE-DISP FOR 2ND @ 05862000 + BAL RLINK,EXABD1 HAVE 2ND @ DECODED 05864000 + SPACE 1 05866000 +* NOTE THAT THE FOLLOWING SEQUENCE IS ESSENTIALLY LIKE * 05868000 +* THE SECTION EXRANGE. THIS IS REQUIRED BECAUSE THE 1ST AND * 05870000 +* 2ND OPERANDS OF SS INSTRUCTIONS DO NOT NECESSARILY HAVE THE * 05872000 +* SAME PROTECTION ATTRIBUTES, I.E. 1ST OPERANDS ARE SOMETIMES * 05874000 +* STORE PROTECTION VIOLATION CAUSES, WHILE 2ND OPERANDS USUALLY* 05876000 +* CAUSE ONLY FETCH PROTECTION VIOLATIONS, IF ANY. * 05878000 + C RB2,ECFADL IS @ LOWER THAN LOWEST ALLOWED 05880000 + BL EXSSL TOO LOW,GO SEE IF REALLY ILLEGAL 05882000 + C RB2,ECFADHC COMP WITH ACTUAL HI LIM(ECFADH-256) 05884000 + BL EXSSL2 @ ACCEPTABLE,GO RELOCATE AND EXECUTE 05886000 + SPACE 1 05888000 +* ADDRESS OUT OF RANGE-CHECK INST TYPE/PROTECTION MODE. * 05890000 +EXSSL LA RWK,EXIPROT-64(ROP) GET @ PROTECTION CONTROL BYTE 05892000 + TM 0(RWK),EXPRSTO2+EXPRFET2 ANY CORE ACCESS AT ALL? 05894000 + BO EXRANOUT YES,AND @ OUT OF RANGE-GO TO FLAG 05896000 + SPACE 1 05898000 + BZ EXSSL2 NO IT ISN'T,SO ITS OK ANYWAY 05900000 + TM ECFLAG0,$ECPROT OUT OF RANGE,FETCH PROT,IF MODE ON 05902000 + BNZ EXRANOUT ABSOLUTE PROTECT MODE-SO PROTECT ERR 05904000 + SPACE 1 05906000 +EXSSL2 AR RB2,RMEM RELOCATE THE 2ND OP ADDRESS 05908000 + MVC EXQSS(2),ECOP MOVE THE OPCODE AND LENGTH(S) OVER 05910000 + LH R1,EXSECSS(R2) GET SECOND LEVEL BRANCH INDEX 05912000 + B EXJUMP(R1) TAKE BRANCH 05914000 + EJECT 05916000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05918000 +* SECOND-LEVEL PROCESSOR SECTIONS - THESE SECTIONS PERFORM * 05920000 +* ALL REQUIRED COMPUTING AFTER INITIAL DECODING HAS BEEN DONE IN * 05922000 +* RESPECTIVE PRIMARY SECTIONS. * 05924000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05926000 + SPACE 4 05928000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05930000 +* RR SECOND-LEVEL PROCESSOR SECTION. * 05932000 +* TO CONDENSE CODE IN RR SECTION, REMOVE THE CODE * 05934000 +* SECTIONS BELONGING TO EXLR AND EXFPRR AND EQU THOSE SYMBOLS * 05936000 +* TO EXNORMRR INSTEAD * 05938000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05940000 + SPACE 1 05942000 +* SET PROGRAM MASK * 05944000 +EXSPM L RCC,ECREGS(RR1) PLACE SPECIFIED REG INTO CC REGISTER 05946000 + SPM RCC SET REAL CC-PM TO FAKE CC-PM 05948000 + B EXFIN RETURN FOR NEXT INSTRUCTION 05950000 + SPACE 1 05952000 + AIF (&$PRIVOP).EXSSK SKIP AND GENERATE RITH CODE-PRIVS OK 05954000 +EXSSK EQU EX0C2 PRIVILEGEDS NOT ALLOWED-FLAG 05956000 +EXISK EQU EX0C2 PRIVILEGEDS NOT ALLOWED-FLAG 05958000 + AGO .EXSVC SKIP OVER GENERATION OF CODE 05960000 +.EXSSK ANOP 05962000 +EXSSK BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 05964000 +EXISK BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 05966000 +.EXSVC ANOP 05968000 + SPACE 1 05970000 +EXSVC L RWK,ECSVCADS GET @ SVC CONTROL TABLE,IF EXISTS 05972000 + LTR RWK,RWK ARE SVC'S ALLOWED 05974000 + BZ EX0C2 NO SVC'S AT ALL,SO ERROR 05976000 + IC RR1,ECI2 GET IMMEDIATE FIELD 05978000 + IC RR1,0(RR1,RWK) GET SVC OFFSET BYTE TO @ ROUTINE 05980000 + SLA RR1,2 MULT*4 FOR INDEX TO FULLWORDS 05982000 + BZ EX0C2 IF =0,MAKE IT PRIVILEGED OPERATION 05984000 + L RWK,256(RWK) GET @ SVC ROUTINE @ TABLE 05986000 + L RWK,0(RR1,RWK) PICK UP ACTUAL @ SVC ROUTINE 05988000 + B EXCALL GO TO CALL ROUTINE 05990000 +* **NOTE** AN SVC CONTROL TABLE IS 260 BYTES LONG, CONTAINING * 05992000 +* 256 BYTES OF INDIVIUDAL SVC INDICATORS, AND 1 FULLWORD PTR. * 05994000 + EJECT 05996000 +* REGULAR RR INSTRUCTIONS - 3 ENTRIES TO SEQUENCE - * 05998000 +* LR (SEPARATE SINCE CURRENT CC IS NOT CHANGED) * 06000000 +* NR,CLR,OR,XR,CR,AR,SR,ALR,SLR - NORMALS * 06002000 +* LPR,LNR,LTR,LCR (DO NOT NEED R1 LOADED) * 06004000 +EXLR L RWK,ECREGS(RR2) GET SECOND OPERAND 06006000 + ST RWK,ECREGS(RR1) PLACE INTO FIRST OPERAND 06008000 + B EXFIN RETURN FOR NEXT INSTRUCTION 06010000 + SPACE 1 06012000 +EXNORMRR L RWK,ECREGS(RR1) OBTAIN 1ST OPERAND 06014000 +EXLPNTR L RR2,ECREGS(RR2) OBTAIN 2ND OPERAND 06016000 + STC ROP,EXQRR PLACE ACTUAL OPCODE INTO INST 06018000 +EXQRR LR $CHN+RWK,RR2 **RIGHT OPCODE IS ENTERED IN ******* 06020000 + ST RWK,ECREGS(RR1) SAVE IN FAKE 1ST OPERAND LOCATION 06022000 + BAL RCC,EXFIN GET CC, RETURN FOR NEXT INST 06024000 + SPACE 1 06026000 + AIF (&$FLOTEX).EXXFPRR GO GENERATE CODE IF XFP OK 06027000 +EXXFPRR EQU EX0C1 NOTE XFP NOT ALLOWED 06027500 + AIF (&$FLOTE).EXFPRR GO GENERATE IF FLOATINGS OK 06028000 +EXFPRR EQU EX0C1 NOTE WE DO NOT ALLOW FLOATINGS 06030000 + AGO .EXFPRR2 06032000 +.EXXFPRR ANOP 06033000 +EXXFPRR EQU * CODE FOR XFP SAME AS REGULAR FP 06033500 +.EXFPRR ANOP 06034000 + SPACE 2 06036000 +* RR FLOATING POINT INSTRUCTIONS. * 06038000 +EXFPRR SPM RCC SET THE CONDITION CODE 06040000 + EX 0,ECOP EXECUTE THE ACTUAL INSTRUCTION 06042000 + BAL RCC,EXFIN GET CC, RETURN FOR NEXT INST 06044000 +.EXFPRR2 ANOP 06046000 + SPACE 2 06046010 + AIF (&$S370 NE 0).EXLONG1 SKIP IF GENERATING S/370'S 06046020 +EXLONG EQU EX0C1 NOTE S/370 RR'S NOT ALLOWED 06046030 + AGO .EXLONG3 SKIP OVER CODE GENERATION 06046040 +.EXLONG1 ANOP 06046050 +* ADDRESS CHECKING CODE FOR CLCL, AND MVCL 06046060 +EXLONG EQU * COMMON CODE FOR MVCL, CLCL CHECKING 06046070 + TM ECR1R2,X'11' DID HE SPECIFY EVEN REGS? 06046080 + BNZ EX0C6 NO--> SPECIFICATION ERROR 06046090 + L R0,EXLONGMK LOAD MASK TO ZAP TOP OF REGS 06046100 + LA R1,ECREGS(RR1) GET ADDRESS OF FIRST REGISTER PAIR 06046110 + LM RB1,RB2,0(R1) LOAD FIRST SET OF REGISTERS 06046120 + NR RB1,R0 GET RID OF UPPER BYTE OF ADDRESS 06046130 + NR RB2,R0 GET RID OF UPPER BYTE OF LENGTH 06046140 + BZ EXLONG2 IF LENGTH = 0, DON'T CHECK ADDRESS 06046150 + C RB1,ECFADL IS ADDRESS TOO LOW? 06046160 + BL EXLONG1 YES - BRANCH TO CHECK PROTECTION 06046170 + LR RWK,RB1 COPY ADDRESS TO WORK REGISTER 06046180 + AR RWK,RB2 COMPUTE HIGHEST ADDRESS 06046190 + C RWK,ECFADH IS IT ABOVE MAXIMUM FOR USER? 06046200 + BL EXLONG2 NO - BRANCH AROUND PROTECTION CHECK 06046210 +EXLONG1 CLI ECOP,14 IS THIS A MVCL INSTRUCTION 06046220 + BE EX0C4 YES - PROTECTION ERROR 06046230 + TM ECFLAG0,$ECPROT IS FETCH PROTECT ON? 06046240 + BNZ EX0C4 YES - PROTECTION ERROR 06046250 + SPACE 2 06046260 +* FIRST ADDRESS OK - CHECK SECOND 06046270 +EXLONG2 LA R2,ECREGS(RR2) GET ADDRESS OF SECOND REG. PAIR 06046280 + LM RR1,RR2,0(R2) LOAD SECOND SET OF REGISTERS 06046290 + NR RR1,R0 GET RID OF UPPER BYTE AF ADDRESS 06046300 + NR RR2,R0 GET RID OF UPPER BYTE OF LENGTH 06046310 + BZ EXLONG4 IF LENGTH = 0, DON'T CHECK ADDRESS 06046320 + C RR1,ECFADL IS ADDRESS TOO LOW? 06046330 + BL EXLONG3 YES - BRANCH TO CHECK FOR PROTECTION 06046340 + LR RWK,RR1 COPY ADDRESS INTO WORK REGISTER 06046350 + AR RWK,RR2 COMPUTE HIGHEST ADDRESS 06046360 + C RWK,ECFADH IS IT ABOVE USER MAXIMUM 06046370 + BL EXLONG4 NO - BRANCH AROUND ERROR CHECK 06046380 +EXLONG3 TM ECFLAG0,$ECPROT IS ABSOLUTE PROTECT ON 06046390 + BNZ EX0C4 YES - PROTECTION ERROR 06046400 + SPACE 2 06046410 +* BOTH ADDRESSES ARE OK - RELOCATE THEM AND PERFORM COMMAND 06046420 +EXLONG4 ALR RB1,RMEM RE-LOCATE ADDRESS TO ACTUAL 06046430 + ALR RR1,RMEM RE-LOCATE ADDRESS TO ACTUAL 06046440 + SPACE 2 06046450 + AIF (&$S370 NE 1).EXLONG2 SKIP IF NOT ON REAL 370 06046460 + L RB2,4(,R1) RESTORE UPPER BYTES IN LENGTH REGS 06046470 + L RR2,4(,R2) RESTORE UPPER BYTES IN LENGTH REGS 06046480 + STC ROP,EXQLONG STORE IN OPCODE 06046490 +EXQLONG CLCL RB1,RR1 *** OPCODE STORED IN *** 06046500 + BALR RCC,0 CAPTURE COND CODE 06046510 + AGO .EXLONG4 06046520 +.EXLONG2 ANOP 06046530 + CLI ECOP,14 IS THIS A MVCL COMMAND? 06046540 + BE EXMVCL YES - BRANCH 06046550 + SPACE 2 06046560 +* CODE FOR CLCL COMMAND 06046570 + LTR RR2,RR2 SECOND LENGTH = 0? 06046580 + BZ EXCLCL6 YES - BRANCH TO CHECK FIRST LENGTH 06046590 + LTR RB2,RB2 FIRST LENGTH = 0? 06046600 + BZ EXCLCL2 YES - BRANCH TO USE PAD & OPND 2 06046610 +EXCLCL1 CLC 0(1,RB1),0(RR1) COMPARE A CHARACTER FROM EACH FIELD 06046620 + BNE EXCLCL5 IF NOT EQUAL, WE ARE DONE - BRANCH 06046630 + LA RB1,1(,RB1) INCREMENT POINTERS 06046640 + LA RR1,1(,RR1) INCREMENT POINTERS 06046650 + BCT RB2,EXCLCL3 DECREMENT FIRST LENGTH, BRANCH ^= 0 06046660 + B EXCLCL7 LENGTH = 0 - BRANCH INTO PAD LOOP 06046670 +EXCLCL2 CLC 4(1,R2),0(RR1) COMPARE PAD TO OPND 2 06046680 + BNE EXCLCL5 IF NOT EQUAL, WE ARE DONE - BRANCH 06046690 + LA RR1,1(,RR1) INCREMENT POINTER 06046700 +EXCLCL7 BCT RR2,EXCLCL2 DECREMENT SECOND COUNT - BRANCH ^= 0 06046710 + B EXCLCL5 IF LENGTH = 0, OPNDS = - WE'RE DONE 06046720 +EXCLCL3 BCT RR2,EXCLCL1 DECREMENT SECOND LENGTH, BRANCH ^= 0 06046730 +EXCLCL4 CLC 0(1,RB1),4(R2) COMPARE FIRST OPND & PAD 06046740 + BNE EXCLCL5 IF NOT EQUAL, WE ARE DONE - BRANCH 06046750 + LA RB1,1(,RB1) INCREMENT POINTER 06046760 + BCT RB2,EXCLCL4 DECREMENT LENGTH, BRANCH ^= 0 06046770 +EXCLCL5 BAL RCC,EXLONG5 CAPTURE CON CODE AND RETURN 06046780 +EXCLCL6 LTR RB2,RB2 FIRST LENGTH = 0? 06046790 + BNZ EXCLCL4 NO, USE 1ST OPND AND PAD 06046800 + BAL RCC,EXLONG5 GET COND CODE (=0) AND RETURN 06046810 + SPACE 2 06046820 +* CODE FOR MVCL COMMAND 06046830 +EXMVCL EQU * CODE FOR MVCL COMMAND 06046840 + LR R0,RB2 ASSUME FIRST LENGTH SMALLEST 06046850 + CR RB2,RR2 COMPARE THE LENGTHS 06046860 + BALR RCC,0 CAPTURE CON CODE 06046870 + BL *+6 IF FIRST LOWER, BRANCH 06046880 + LR R0,RR2 SECOND LENGTH MUST BE THE SMALLER 06046890 + LTR R0,R0 IS SMALLEST LENGTH = 0? 06046900 + BZ EXMVCL3 IF SMALLER = 0, BRANCH 06046910 + SPACE 2 06046920 +* FOLLOWING CODE CHECKS FOR DESTRUCTIVE OVERLAP 06046930 + CR RB1,RR1 IS 1ST FIELD AFTER SECOND? 06046940 + BNH EXMVCL1 NO - NO OVERLAP - BRANCH 06046950 + AR RWK,RMEM RE-LOCATE HIGH OPND 2 ADDRESS 06046960 + CR RB1,RWK IS 1ST FIELD AFTER END OF 2ND 06046970 + BNL EXMVCL1 YES - NO OVERLAP - BRANCH 06046980 + TM *+1,1 SET CON CODE TO OVERFLOW (3) 06046990 + BAL RCC,EXLONG5 CAPTURE CON CODE AND RETURN 06047000 + SPACE 2 06047010 +EXMVCL1 SR RB2,R0 DECREMENT LENGTHS BY THE SMALLER 06047020 + SR RR2,R0 DECREMENT LENGTHS BY THE SMALLER 06047030 +EXMVCL2 MVC 0(1,RB1),0(RR1) MOVE A BYTE 06047040 + LA RB1,1(,RB1) INCREMENT POINTERS 06047050 + LA RR1,1(,RR1) INCREMENT POINTERS 06047060 + BCT R0,EXMVCL2 DECREMENT LENGTH, IF ^= 0, BRANCH 06047070 +EXMVCL3 LTR RB2,RB2 DO WE NEED PADDING? 06047080 + BZ EXLONG5 NO - WE ARE DONE - BRANCH 06047090 + MVC *+7(1),4(R2) MOVE PAD CHAR INTO MVI INSTRUCTION 06047100 +EXMVCL4 MVI 0(RB1),$CHN MOVE PAD TO FIRST OPRND 06047110 + LA RB1,1(,RB1) INCREMENT POINTER 06047120 + BCT RB2,EXMVCL4 DECREMENT LENGTH - IF ^= 0, BRANCH 06047130 + SPACE 2 06047140 +* COMMON CLCL, MVCL EXIT CODE 06047150 +EXLONG5 XC 5(3,R1),5(R1) ZAP LOWER PART OF LENGTH IN CORE 06047160 + XC 5(3,R2),5(R2) ZAP LOWER PART OF LENGTH IN CORE 06047170 + O RB2,4(,R1) PUT UPPER BYTE BACK INTO REG 06047180 + O RR2,4(,R2) PUT UPPER BYTE BACK INTO REG 06047190 + L R0,EXLONGMK GET MASK TO ZAP UPPER BYTE OF REGS 06047200 +.EXLONG4 ANOP 06047210 + SPACE 2 06047220 +* OPERATION COMPLETE - RESTORE REGISTERS AND RETURN 06047230 + SLR RB1,RMEM DE-RELOCATE FINAL ADDRESSES 06047240 + SLR RR1,RMEM DE-RELOCATE FINAL ADDRESSES 06047250 + NR RB1,R0 ZAP UPPER BYTES OF ADDRESS REGS 06047260 + NR RR1,R0 ZAP UPPER BYTES OF ADDRESS REGS 06047270 + STM RB1,RB2,0(R1) PUT REGISTERS BACK INTO CORE 06047280 + STM RR1,RR2,0(R2) PUT REGISTERS BACK INTO CORE 06047290 + SR R2,R2 RESTORE R2 AS BYTE REGISTER 06047300 + B EXFIN RETURN 06047310 +.EXLONG3 ANOP 06047320 + EJECT 06048000 +* RR-RX OVERLAP SECOND-LEVEL PROCESSOR SECTION. * 06050000 + SPACE 1 06052000 +* BRANCH AND LINK (BALR,BAL) * 06054000 +EXBALR MVI EXILC,X'40' SET ILC RIGHT 06056000 + LR RB2,RIA NO BRANCH WILL OCCUR-SET UP FOR REST 06058000 + BZ EXBAL1 IF R2=0, NO BRANCH WILL OCCUR 06060000 + L RB2,ECREGS(RR2) BRANCH DOES OCCUR-LOAD ADDR IN 06062000 + B EXBAL1 SKIP CODE TO SET FILC 06064000 +EXBAL MVI EXILC,X'80' SET ILC UP RIGHT 06066000 +EXBAL1 N RCC,=XL4'3F000000' LEAVE ONLY CC-PM IN REGISTER RCC 06068000 + AL RCC,EXILC ADD ILC INTO PSW BEING BUILT 06070000 + ALR RIA,RCC NOW HAVE ILC-CC-PM-IA FILEDS 06072000 + ST RIA,ECREGS(RR1) PLACE BUILT PSW INTO FAKE REG 06074000 + B EXFINB BRANCH TAKEN-RETURN 06076000 + SPACE 1 06078000 +* BRANCH ON COUNT (BCTR,BCT) * 06080000 +EXBCTR BNZ EXBCTR1 IF R2=0,NO BRANCH WILL OCCUR 06082000 + L RWK,ECREGS(RR1) OBTAIN VALUE OF REGISTER 06084000 + BCTR RWK,0 DECREMENT THE VALUE 06086000 + ST RWK,ECREGS(RR1) RESTORE IT TO FAKE REGISTER 06088000 + B EXFIN RETURN FOR NEXT INSTRUCTION 06090000 + SPACE 1 06092000 +EXBCTR1 L RB2,ECREGS(RR2) GET BRANCH ADDRESS IN SAME AS BCT 06094000 +EXBCT L RWK,=F'-1' PUT -1 IN 06096000 + A RWK,ECREGS(RR1) ADD VALUE IN (DOING BCT) 06098000 + ST RWK,ECREGS(RR1) RESTORE DECREMENTED VALUE TO FAKE RG 06100000 + BNZ EXFINB IF NOT=0, BRANCH IS TAKEN 06102000 + B EXFIN BRANCH FAILED 06104000 + SPACE 1 06106000 +* BRANCH ON CONDITION (BCR,BC) * 06108000 +EXBCR BZ EXFIN IF R2 IS 0, NO BRANCH OCCURS 06110000 + L RB2,ECREGS(RR2) BRANCH ADDRESS TO FIT WITH BC 06112000 +EXBC SLL RR1,2 GET MASK BACK IN RIGHT SPOT 06114000 + SPM RCC SET REAL CC = FAKE CC 06116000 + STC RR1,EXQBC+1 STORE INTO MASK FIELD 06118000 +EXQBC BC $CHN,EXFINB **MASK STORED IN** 06120000 + B EXFIN BRANCH FIALED 06122000 + SPACE 1 06124000 +* MULTIPLY AND DIVIDE (MR,DR,M,D) * 06126000 +EXMRDR LA RB2,ECREGS(RR2) MAKE ADDRESS COMPATIBLE WITH M-D 06128000 +EXMD TM ECR1R2,X'10' MAKE SURE R1 IS EVEN SPECIFICATION 06130000 + BO EX0C6 SPECIFICATION ERROR-ODD REGISTER 06132000 + LA RR1,ECREGS(RR1) OBTAIN ACTUAL ADDRESS OF FAKE R1 06134000 + LM R0,R1,0(RR1) OBTAIN 2 FAKE REGISTER VALUES 06136000 + MVN EXQMD(1),ECOP MOVE CODE - SAYS M OR D 06138000 +EXQMD M $CHN+R0,0(RB2) **CHANGED TO M OR D DURING EXEC***** 06140000 + STM R0,R1,0(RR1) RESTORE THE REGISTERS TO THE FAKES 06142000 + B EXFIN RETURN FOR NEXT INSTRUCTION 06144000 + EJECT 06146000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06148000 +* RX SECOND-LEVEL PROCESSOR SECTION. * 06150000 +* TO CONDENSE CODE IN RX SECTION, THE CODE BELONGING * 06152000 +* TO THE SECTIONS BEGINNING EXLOADS,EXSTORS,EXLA, AND EXFPRX * 06154000 +* SHOULD BE EQU'D TO EXNORMRX, AND THE ACTUAL CODE OF THOSE * 06156000 +* SECTIONS REMOVED. * 06158000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06160000 + SPACE 1 06162000 +* RX NORMAL (IC,CH,AH,SH,MH,N,CL,O,X,C,A,S,AL,SL) * 06164000 +EXNORMRX L RWK,ECREGS(RR1) OBTAIN 1ST OPERAND 06166000 + STC ROP,EXQNORMR STORE OPCODE IN 06168000 + SPM RCC SET REAL CC = FAKE CC 06170000 +EXQNORMR IC $CHN+RWK,0(RB2) **WILL BE CHANGED TO RIGHT OPCODE*** 06172000 + ST RWK,ECREGS(RR1) PLACE RESULT INTO FAKE REGISTER 06174000 + BAL RCC,EXFIN GET CC, RETURN FOR NEXT INST 06176000 + SPACE 1 06178000 +* EXECUTE -USES SECTION OF PRIMARY DECODING SECTION * 06180000 +EXEX LH RWK,0(RB2) QUICK CHECK FOR ALIGNMENT ERROR 06182000 + CLI 0(RB2),X'44' MAKE SURE NOT AN EXECUTE 06184000 + BE EX0C3 EXECUTE INTERRUPT 06186000 + LR RWK,RB2 PUT ADDRESS WHERE EXPECTED 06188000 + MVC EXEXLEN(2),EXEXBRNC REPLACE ADD BY BR RLINK 06190000 + BAL RLINK,EXFEXENT GO BACK AND DO COMMON SECTION 06192000 + SPACE 1 06194000 +* THE FOLLOWING EXECUTED AFTER PRIMARY DECODING DONE * 06196000 + SR RB2,RMEM DE-RELOCATE INSTR @ 06196500 + ST RB2,ECSTIADD STORE INTO INSTR STACK FOR DUMP 06197000 +EXEXOR MVC EXEXLEN(2),EXEXLEN2 FIX UP A TO BE ONE AGAIN 06198000 + LTR RR1,RR1 CHECK FOR R1 OPERAND BEING USED 06200000 + BZ EXPRIME+4(R1) NOTHING TO OR IN-BRANCH 06202000 + LA RB2,ECREGS+3(RR1) ADDRESS OF LAST BYTE OF GIVEN REG 06204000 + OC ECR1R2,0(RB2) OR BYTE INTO INSTRUCTION 06206000 + B EXPRIME+4(R1) TAKE PRIMARY BRANCH 06208000 +EXEXLEN2 A RIA,EXILENG(R1) INST TO REPLACE MODIFIED ONE 06210000 + ORG *-2 WE ONLY NEED 1ST 2 BYTES OF LAST INS 06212000 +EXEXBRNC BR RLINK WILL BE MOVED IN FOR EXECUTE 06214000 + SPACE 1 06216000 +* RX LOAD OPERATIONS(NO CC SETTING) (LH,CVB,L) * 06218000 +EXLOADS STC ROP,EXQLOAD STORE OPCODE IN 06220000 +EXQLOAD L $CHN+RWK,0(RB2) ** OPCODE WILL BE MOVED IN ********* 06222000 + ST RWK,ECREGS(RR1) PLACE RESULT INTO FAKE REG 06224000 + B EXFIN RETURN FOR NEXT INSTRUCTION 06226000 + SPACE 1 06228000 +* RX STORE OPERATIONS (NO CC SETTING) (STH,CVD,STC,ST) * 06230000 +EXSTORS L RWK,ECREGS(RR1) OBTAIN 1ST OPERAND 06232000 + STC ROP,EXQSTORS STORE OPCODE INTO INST 06234000 +EXQSTORS ST RWK,0(RB2) ** OPCODE WILL BE CHANGED*********** 06236000 + AIF (&$S370 NE 2).EXSTORS SKIP IF NOT SIMULATING S/370 06237000 + BZ EXFIN IF CHECKING ALIGNMENT, RETURN 06237100 + MVC 0(8,RB1),EXDUBLWD PUT ALTERED CORE BACK IN RIGHT PLACE 06237200 +.EXSTORS ANOP 06237300 + B EXFIN RETURN FOR NEXT INSTRUCTION 06238000 + SPACE 1 06240000 +* LOAD ADDRESS LA * 06242000 +EXLA ST RB2,ECREGS(RR1) PUT RESULT IN DESIRED FAKE REGISTER 06244000 + B EXFIN RETURN FOR NEXT INSTRUCTION 06246000 + AIF (&$FLOTEX).EXXFPRX SKIP IF WE HAVE EXTENDED FP 06247000 +EXXFPRX EQU EX0C1 NOTE INSTRUCTIONS NOT ALLOWED 06247500 + AIF (&$FLOTE).EXFPRX GO GEN IF FLOATINGS ALLOWED 06248000 +EXFPRX EQU EX0C1 NOTE FLOATINGS NOT ALLOWED 06250000 +EXFPRXST EQU EX0C1 NOTE FLOATINGS NOT ALLOWED 06251000 + AGO .EXFPRX2 SKIP OVER GENERATION 06252000 +.EXXFPRX ANOP 06253000 +EXXFPRX EQU * CODE FOR EXTENDED FLOATINGS 06253500 +.EXFPRX ANOP 06254000 + SPACE 1 06256000 +* FLOATING POINT RX INSTRUCTIONS. * 06258000 +EXFPRX EQU * ODD REG CHECK DONE WITH SPIE 06260000 + STC ROP,EXQFPRX STORE OPCODE IN 06262000 + SLL RR1,2 GET R1 FIELD BACK INTO PLACE 06264000 + STC RR1,EXQFPRX+1 STORE R1 FIELD INTO INST ALSO 06266000 + SPM RCC SET THE CONDITION CODE 06268000 +EXQFPRX STD $,0(,RB2) **OPCODE AND R1 FIELDS STORED IN**** 06270000 + BAL RCC,EXFIN GET CC, RETURN FOR NEXT INST 06272000 + AIF (&$S370 EQ 2).EXFPRX1 SKIP IF SIMULATING S/370 06272100 +EXFPRXST EQU EXFPRX CODE FOR STORES SAME AS OTHERS 06272200 + AGO .EXFPRX2 SKIP AROUND CODE GENERATION 06272300 +.EXFPRX1 ANOP 06272400 + SPACE 2 06272500 +* CODE FOR FLOATING POINT STORES WHEN FAKING ALIGNMENT 06272600 +EXFPRXST EQU * CODE FOR FLOATING POINT STORES 06272700 + STC ROP,EXQFPRXS STORE OPCODE IN 06272800 + SLL RR1,2 GET R1 FIELD BACK INTO PLACE 06272900 + STC RR1,EXQFPRXS+1 STORE R1 FIELD INTO INST ALSO 06273000 +EXQFPRXS STD $,0(,RB2) **OPCODE AND R1 FIELDS STORED IN**** 06273100 + BZ EXFIN IF ALIGNMENT CHECKING, RETURN 06273200 + MVC 0(8,RB1),EXDUBLWD PUT ALTERED CORE BACK IN RIGHT PLACE 06273300 + B EXFIN RETURN 06273400 +.EXFPRX2 ANOP 06274000 + SPACE 2 06276000 + AIF (NOT &$XIOS).EXCONT SKIP IF NO XMACROS 06277500 +* XDECO - EXTENDED DECIMAL OUTPUT INSTRUCTION. * 06278000 +* SPECIAL RX INSTRUCTION CONVERTS REGISTER VALUE TO EDITED * 06280000 +* 12-BYTE DECIMAL FIELD. (X'52' OPCODE). * 06282000 +EXXDECO L R0,ECREGS(RR1) GET VALUE OF THE REGISTER 06284000 + XDECO R0,0(RB2) CONVERT THE VALUE 06286000 + B EXFIN GO FOR NEXT INSTRUCTION 06288000 + SPACE 1 06308000 +* XDECI - EXTENDED DECIMAL INPUT INSTRUCTION. * 06310000 +* SPECIAL INPUT CONVERTER, SCANS 1-9 DIGIT, SIGNED/UNSIGNED * 06312000 +* DECIMAL NUMBERS WITH ANY # PRECEDING BLANKS. SETS CC TO 0,1,2* 06314000 +* ACCORDING TO VALUE OF RESULT. CC=3 IF >9 DIGITS, OR 1ST * 06316000 +* CHARACTER NOT +, -, DIGIT, OR + OR - WITHOUT DIGIT FOLLOWING.* 06318000 +* OPCODE IS HEX '53' (RX FORMAT). * 06320000 +EXXDECI XDECI R0,0(RB2) CONVERT AND SCAN VALUE 06320100 + BALR RCC,0 SAVE THE CC 06320200 + BO *+8 SKIP STORE IF VALUE WAS BAD 06320300 + ST R0,ECREGS(RR1) SAVE THE CONVERTED VALUE IF OK 06320400 + SR R1,RMEM DE-RELOCATE THE SCAN PTR VALUE 06320500 + ST R1,ECREG1 SAVE SCAN PTR IN USER REG 1 06320600 + B EXFIN GO BACK FOR NEXT INSTR 06320700 + SPACE 1 06322000 + AIF (NOT &$HEXI).EXNOHXI SKIP OF NO XHEXI 06350200 +* XHEXI-EXTENDED HEXADECIMAL INPUT INSTRUCTION * 06350300 +* SPECIAL INPUT MACRO, SCANS 1-8 DIGITS. SKIPS LEADING * 06350400 +* BLANKS. SETS CONDITION CODE TO 3 IF ILLEGAL HEX CHARACTER * 06350500 +* FOUND. IF GREATER THAN 8 DIGITS FOUND R1 POINTS TO 9TH ELSE * 06350600 +* R1 POINTS TO FIRST NON-HEX CHARACTER IN STRING * 06350700 +* (X'61' OPCODE) * 06350800 +EXXHEXI XHEXI R0,0(RB2) CONVERT AND SCAN VALUE 06350900 + BALR RCC,0 SAVE THE CC 06351000 + BO *+8 SKIP STORE IF VALUE WAS BAD 06351100 + ST R0,ECREGS(RR1) STORE CONVERTED VALUE IF OK 06351200 + SR R1,RMEM DE-RELOCATE SCAN POINTER VALUE 06351300 + ST R1,ECREG1 SAVE SCAN POINTER IN USER R1 06351400 + B EXFIN GO FOR NEXT INSTRUCTION 06351500 + AGO .EXCKHXO CHECK IF XHEXO ALLOWED 06351600 +.EXNOHXI ANOP 06351700 +EXXHEXI EQU EX0C1 INVALID OP-CODE 06351800 +.EXCKHXO AIF (NOT &$HEXO).EXNOHXO SKIP IF NOT XHEXO ALLOWED 06351900 +* XHEXO-EXTENDED HEXADECIMAL OUTPUT MACRO * 06352000 +* SPECIAL RX INSTRUCTION CONVERTS REGISTER VALUE TO OUTPUT * 06352100 +* 8 BYTE FORM. (X'62' OPCODE). * 06352200 +EXXHEXO L R0,ECREGS(RR1) GET VALUE OF THE REGISYER 06352300 + XHEXO R0,0(RB2) CONVERT VALUE 06352400 + B EXFIN GET NEXT INSTRUCTION 06352500 + AGO .EXCONT 06352600 +.EXNOHXO ANOP 06352700 +EXXHEXO EQU EX0C1 INVALID OP CODE 06352800 +.EXCONT ANOP 06352900 + EJECT 06400000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06402000 +* SI SECOND-LEVEL PROCESSOR SECTION * 06404000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06406000 + SPACE 1 06408000 +* ALL NORMAL SI'S - OP D(B),I2 * 06410000 +EXSI BAL RLINK,EXRANGE CHECK ADDRESS FOR IN RANGE 06412000 + AR RB2,RMEM RELOCATE TO REAL @ 06414000 + MVC EXQSI(2),ECOP MOVE OPCODE AND I2 FIELD IN 06416000 + SPM RCC SET REAL CON-CODE= FAKE ONE 06418000 +EXQSI TM 0(RB2),$CHN ** OP AND I2 WILL BE MOVED IN******* 06420000 + BAL RCC,EXFIN GET CC, RETURN FOR NEXT INST 06422000 + SPACE 1 06424000 + AIF (&$DEBUG).EXDIAG1 SKIP IF NOT DEBUG MODE 06426000 +* DIAG-PSEUDO SI INSTRUCTION USED FOR DEBUGGING PURPOSES * 06428000 +EXDIAG MVC ECFLAG2,ECI2 SUPPLY CONTROL FLAG TO BYTE 06430000 + B EXFIN GO BACK FOR NEXT INSTRUCTION 06432000 +.EXDIAG1 ANOP 06434000 + SPACE 1 06436000 + AIF (&$P370).EXLCTL SKIP IF PRIVILEGED 370'S ALLOWED 06436100 +EXLCTL EQU EX0C2 NO PRIVILEGED 370 OPS ALLOWED 06436200 +EXSTCTL EQU EX0C2 NO PRIVILEGED 370 OPS ALLOWED 06436300 +EXP370 EQU EX0C2 NO PRIVILEGED 370 OPS ALLOWED 06436400 + AGO .EXNP370 SKIP OVER CODE GENERATION 06436500 +.EXLCTL ANOP 06436600 +EXLCTL BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06436700 +EXSTCTL BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06436800 +EXP370 BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06436900 +.EXNP370 ANOP 06437000 + AIF (&$PRIVOP).EXSIO GENERATE CODE,IF PRIVILEGEDS EXIST 06438000 +EXSIO EQU EX0C2 NO PRIVILEGED OPS ALLOWED 06440000 +EXTIO EQU EX0C2 NO PRIVILEGED OPS ALLOWED 06442000 +EXHIO EQU EX0C2 NO PRIVILEGED OPS ALLOWED 06444000 +EXSSM EQU EX0C2 NO PRIVILEGED OPS ALLOWED 06446000 +EXTCH EQU EX0C2 NO PRIVILEGED OPS ALLOWED 06448000 +EXLPSW EQU EX0C2 NO PRIVILEGED OPS ALLOWED 06450000 +EXWRD EQU EX0C2 NO PRIVILEGED OPS ALLOWED 06452000 +EXRDD EQU EX0C2 NO PRIVILEGED OPS ALLOWED 06454000 + AGO .EXNOPRV SKIP OVER CODE GENERATION 06456000 +.EXSIO ANOP 06458000 +EXSIO BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06460000 +EXTIO BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06462000 +EXHIO BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06464000 +EXTCH BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06466000 +EXSSM BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06468000 +EXLPSW BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06470000 +EXWRD BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06472000 +EXRDD BAL RLINK,EX0C2C GO CHECK FOR SUPERVISOR STATE 06474000 +.EXNOPRV ANOP 06476000 + AIF (&$REPL GT 0).EXNREP0 SKIP IF REPL OPTION ALLOWED 06476090 +EXXREPL EQU EX0C1 NO REPLACEMENT: MAKE ILLEGAL OP 06476095 +.EXNREP0 AIF (&$REPL EQ 0).EXNREPL SKIP IF NO REPLACEMENT 06476100 + SPACE 2 06476150 +EXXREPL EQU * CODE FOR XREPL COMMAND -REPLACE 06476200 + BAL RLINK,EXRANGE HAVE @ CHECKED FOR RANGE 06476250 + AR RB2,RMEM RELOCATE TO REAL @ 06476300 + SPACE 1 06476350 + CLI ECI2,0 WAS IT SET RFLAG TYPE XREPL 06476400 + BH EXXREPL1 NO, SKIP TO NEXT TYPE 06476450 + MVC ECRFLAG,0(RB2) SET RFLAG FROM USER LOCATION 06476500 + B EXFIN GO FOR NEXT INSTR 06476550 + SPACE 1 06476600 +EXXREPL1 CLI ECI2,1 WAS IT FETCH RFLAG TYPE 06476650 + BH EXXREPL2 NO, SKIP TO NEXT TYPE 06476700 + MVC 0(L'ECRFLAG,RB2),ECRFLAG FETCH THE FLAG TO USER AREA 06476750 + B EXFIN GO FOR NEXT INSTR 06476800 + SPACE 1 06476850 +EXXREPL2 CLI ECI2,2 WAS IT INSTRUCTION COUNT 06476900 + BH EXXREPL3 NO, GO ON TO NEXT 06476950 + MVC 0(4,RB2),ECILIMT MOVE TEMPORARY INSTRUCTION COUNT OVE 06477000 + B EXFIN GO FOR NEXT INSR 06477050 +EXXREPL3 EQU EXFIN ILLEGAL I2 FIELD, IGNORE. 06477100 +.EXNREPL ANOP 06477150 + EJECT 06478000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06480000 +* RS SECOND-LEVEL PROCESSOR SECTION. * 06482000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06484000 + SPACE 1 06486000 +* BRANCH ON INDEX (BXH,BXLE) * 06488000 +EXRSBX BAL RLINK,EXR1R2 GO DECODE R1-R3 FIELDS 06490000 + L R0,ECREGS(RR3) OBTAIN REGISTER SPECIFIED BY R3 FLD 06492000 + L R1,ECREGS+4(RR3) GET NEXT REGISTER BEYOND 06494000 + TM ECR1R3,X'1' WAS REGISTER ODD 06496000 + BZ *+6 IF EVEN REG,SET UP OK,SKIP NEXT INST 06498000 + LR R1,R0 R3 WAS ODD-SO USE SAME VALUE 06500000 + STC ROP,EXQRSBX STORE OPCODE INTO INSTRUCTION 06502000 + L RWK,ECREGS(RR1) OBTAIN R1 FIELD VALUE 06504000 +EXQRSBX BXH $CHN+RWK,R0,EXRSBX1 ** CHANGED TO EITHER BXH-BXLE******* 06506000 + ST RWK,ECREGS(RR1) BRANCH FAILED-BUT STORE REG BACK 06508000 + B EXFIN RETURN FOR NEXT INSTRUCTION 06510000 +EXRSBX1 ST RWK,ECREGS(RR1) RESTORE UPDATED REGISTER 06512000 + B EXFINB GO TO FINISH-SUCC BRANCH 06514000 + SPACE 1 06516000 +* LOAD/STORE MULTIPLE (LM,STM) *CODE MAY NOT BE OBVIOUS* * 06518000 +EXLMSTM BAL RLINK,EXR1R2 GET R1 AND R3 FIELDS 06520000 + AIF (&$S370 NE 2).EXLMSTM SKIP IF NOT SIMULATING S/370 06520100 + TM ECFLAG4,AJONALGN SHOULD ALIGNMENT BE CHECKED 06520200 + BO *+8 NO - BRANCH AROUND CHECK 06520300 +.EXLMSTM ANOP 06520400 + L R0,0(RB2,RMEM) QUICK CHECK FOR FULLWORD ALIGNMENT 06522000 + LA R1,4(RR3) OBTAIN 1 PART OF LENGTH VALUE 06524000 + CR RR1,RR3 IS R1 FIELD <= R3 FIELD 06526000 + BNH EXLMSTM1 SKIP OVER IF EASY CASE(R1MOVE TO DO NR 06618660 + BZ 6(,RWK) IF 0, WE ARE ALL DONE, RETURN 06618670 + EX 0,0(,RWK) PERFORM SUPPLIED OPERATION 06618680 + LA RB2,1(,RB2) INCREMENT CORE AREA POINTER 06618690 +EXMSKC EQU *+1 POSITION OF MASK CHANGED BY CLM 06618700 + BC $+15,EXMSK1 USUALLY BRANCH TO LOOP (BE FOR CLM) 06618710 + B 6(,RWK) IF UNEQUAL COMPARE FOR CLM, RETURN 06618720 +.EXMASK3 ANOP 06618730 + EJECT 06620000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06622000 +* SS SECOND-LEVEL PROCESSOR SECTION. * 06624000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06636000 + SPACE 1 06638000 +* MOVES,TR,PACK - CHANGE NEITHER CC NOR REGISTERS. * 06640000 +EXMOVS DS 0H LOCATION FOR MOVES,ETC 06642000 +EXQSS MVN 0($CHN,RB1),0(RB2) **OPCODE AND LENGTH MOVED IN ** 06644000 + B EXFIN RETURN FOR NEXT INSTRUCTION 06646000 + SPACE 1 06648000 +* LOGICALS AND DECIMALS - MAY CHANGE CC,BUT NOT REGS * 06650000 +EXLOGS SPM RCC SET REAL CC = FAKE ONE 06652000 +EXDECS EQU EXLOGS SAME AS LOGS IF DECIMAL FEATURE IN 06654000 + EX 0,EXQSS EXECUTE PREPARED INST 06656000 + BAL RCC,EXFIN GET CC, RETURN FOR NEXT INST 06658000 + SPACE 1 06660000 +* TRT AND EDMK -CHANGE CC,POSSIBLY REGISTERS 1&2 * 06662000 +EXTRT LM R1,R2,ECREG1 GET FAKE R1,R2 06664000 +EXEDMK EQU EXTRT SAME AS TRT,IF DECIMAL FEATURE USED 06666000 + LA R1,0(R1) CLEAR UPPER BYTE FOR SAFETY 06668000 + ALR R1,RMEM RELOCATE TO REAL @, IN CASE CHANGED 06670000 + EX 0,EXQSS EXECUTE PREPARED INSTRUCTION 06672000 + BALR RCC,0 PICK UP CHANGED CONDITION CODE 06674000 + SLR R1,RMEM CONVERT BACK TO FAKE @ 06676000 + XC ECREG1+1(3),ECREG1+1 CLEAR 3 BYTES OF FAKE R1 06678000 + O R1,ECREG1 GET FAKE R1 BACK TOGETHER 06680000 + STM R1,R2,ECREG1 REPLACE FAKE REGS R1 AND R2 06682000 + SR R2,R2 CLEAR FOR BYTE REGISTER AGAIN 06684000 + B EXFIN GO FOR NEXT INSTRUCTION 06686000 + AIF (&$S370 NE 0).EXSRP1 SKIP IF WE HAVE S/370'S 06686010 + SPACE 2 06686020 +EXSRP EQU EX0C1 NOTE SRP NOT ALLOWED 06686030 + AGO .EXSRP3 SKIP OVER CODE GENERATION 06686040 +.EXSRP1 SPACE 2 06686050 +* CODE FOR SRP (SHIFT AND ROUND PACKED) S/370 COMMAND 06686060 +EXSRP EQU * CODE FOR SRP 06686070 + SR RB2,RMEM REMOVE RE-LOCATION DONE EARLIER 06686080 + AIF (&$S370 NE 1).EXSRP2 SKIP IF WE DO NOT HAVE 370 HARDWARE 06686090 + B EXDECS REST OF CODE SAME AS ALL DECIMALS 06686100 +.EXSRP2 AIF (&$S370 NE 2).EXSRP3 SKIP IF NOT SIMULATING S/370'S 06686110 + IC RR1,ECL1I3 GET LENGTH AND IMMEDIATE 06686120 + N RR1,EXSRPMK REMOVE IMMEDIATE FIELD 06686130 + LR RR2,RR1 COPY (LENGTH OF FIELD) * 4 06686140 + SRL RR1,4 GET LENGTH 06686150 + OR RR2,RR1 SET UP REG WITH 2 LENGTHS 06686160 + SPACE 06686170 + MVO EXSRPDA1(1),ECL1I3(1) MOVE IMMEDIATE OVER 06686180 + ZAP EXSRPDA1(1),EXSRPDA1(1) CHECK IMMEDIATE 06686190 + EX RR1,EXSRPZP1 CHECK USERS NUMBER 06686200 + BZ EXSRPLF5 IF NUMBER = 0, WERE DONE 06686210 + SPACE 06686220 + SLL RB2,26 EXTEND BIT 26 AS IF 06686230 + SRA RB2,26 IT IS A SIGN BIT 06686240 + BZ EXSRPLF3 IF SHIFT IS ZERO, WERE DONE 06686250 + BP EXSRPLF IF SHIFT IS POSITIVE,IT'S LEFT SHIFT 06686260 + SPACE 2 06686270 +EXSRPRT LPR RB2,RB2 MUST BE RIGHT SHIFT, GET + SHIFT 06686280 + B EXSRPRT2 BRANCH INTO LOOP 06686290 +EXSRPRT1 MVO EXSRPDA2(16),EXSRPDA2(15) SHIFT ALL BUT LAST NIBBLE 06686300 +EXSRPRT2 BCT RB2,EXSRPRT1 DECREMENT COUNT AND BRANCH 06686310 + SLL RR1,4 SHIFT LENGTH TO L1 FIELD 06686320 + MVN EXSRPDA2+15(1),EXSRPDA1 MAKE SIGN POSITIVE 06686330 + AP EXSRPDA2(16),EXSRPDA1(1) ADD IN ROUNDING FACTOR 06686340 + EX RR1,EXSRPMV1 MOVE TO USER, DOING LAST SHIFT 06686350 + B EXSRPLF3 GO TO SET COND CODE AND RETURN 06686360 + SPACE 2 06686370 +EXSRPLF LA RWK,0(RR1,RB1) GET @ LAST BYTE OF USER NUMBER 06686380 + STC RR2,EXSRPLF2+1 PUT LENGTH INTO MVO INSTR 06686390 + OI *+1,0 SET COND CODE TO ZERO 06686400 +EXSRPLF1 BNZ EXSRPLF2 HAS OVRFLOW OCCURRED? BRANCH IF SO 06686410 + TM 0(RB1),X'F0' CHECK FIRST NIBBLE FOR NON-ZERO 06686420 +EXSRPLF2 MVO 0($CHN,RB1),0($CHN,RB1) SHIFT LEFT (LENGTHS STORED IN) 06686430 + MVZ 0(1,RWK),=PL1'0' MOVE ZERO TO PROPAGATED SIGN 06686440 + BCT RB2,EXSRPLF1 DECREMENT COUNT AND BRANCH 06686450 + BNZ EXSRPLF4 OVERFLOW SO BRANCH TO CHECK FOR 0CA 06686460 +EXSRPLF3 EX RR2,EXSRPZP2 SET COND CODE FOR +, -, OR 0 06686470 + BAL RCC,EXFIN CAPTURE COND CODE AND RETURN 06686480 +EXSRPLF4 TM ECSTCCPM,X'04' CHECK MASK BIT 06686490 + BO EX0CA OVERFLOW HAS OCCURED--> ERROR 06686500 + TM *+1,1 SET COND CODE TO OVRFLOW 06686510 +EXSRPLF5 BAL RCC,EXFIN CAPTURE COND CODE AND RETURN 06686520 + SPACE 06686530 +EXSRPZP1 ZAP EXSRPDA2(16),0($CHN,RB1) CHECK AND MOVE USER NUMBER 06686540 +EXSRPZP2 ZAP 0($CHN,RB1),0($CHN,RB1) SET COND CODE TO +, -, OR 0 06686550 +EXSRPMV1 MVO 0($CHN,RB1),EXSRPDA2(15) MOVE BACK TO USERS AREA 06686560 +.EXSRP3 ANOP 06686570 + EJECT 06688000 + AIF (&$XIOS).EXXIOS SKIP TO GENERATE CODE IF EXISTS 06690000 +EXXIOS EQU EX0C1 THESE INSTRUCTIONS DO NOT EXIST 06692000 + AGO .EXNOXIO 06694000 +.EXXIOS ANOP 06696000 + SPACE 1 06698000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06699000 +* PSEUDO RX-SS EXTENDED MNEMONICS-XREAD,XPRNT,XPNCH I/O'S * 06700000 +* PSEUDO DUMP ROUTINE - XDUMP * 06702000 +* **NOTE** BECAUSE OF NO-STANDARD ADDRESSING DONE BY THESE * 06703000 +* INSTRUCTIONS, THEY DO THEIR OWN ADDRESS CHECKING, AND THUS * 06703100 +* HAVE A PROTECTION BYTE OF X'00' SO THE INITIAL SS SECTION * 06703200 +* DOESN'T STOP THEM. THEY THEN FAKE THE PROTECTION BYTES OF * 06703400 +* EITHER STM(X'C0' -XREAD), OR TM(X'80' - XPRNT,XDUMP,XPNCH). * 06703500 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06703750 +EXXIOS EQU * SECTION FOR X-MACRO I/O INSTRUCTIONS 06704000 + N RCC,=XL4'3F000000' REMOVE ALL BUT CC-PM BITS 06706000 + ALR RCC,RIA PUT CC-PM-PROG ADDRESS TOGETHER 06708000 + ST RCC,ECILCMSK STORE RESULTING PSW 06710000 + OI ECILCMSK,X'C0' SET ILC=3, FOR LENGTH OF X-INST 06712000 + CLI ECOP,X'E1' SEE IF IT WAS REGS TYPE XDUMP 06714000 + BE EXXDUMPR YES,SO GO DUMP REGS ONLY 06716000 + SR RB2,RMEM REMOVE SPURIOUS RELOCATION 06718000 + BNZ EXXLOK LENGTH OK IF NOT ZERO 06720000 + L RB2,ECREGS GET VALUE OF FAKE 0 06722000 +EXXLOK BAL RLINK,EXR1R2 GET MASK AND INDEX VALUE 06724000 + BZ EXXNOX2 SKIP IF NO INDEX REG USED 06726000 + AL RB1,ECREGS(RX2) ADD INDEX VALUE TO ADDRESS 06728000 + LA RB1,0(RB1) CHOP OFF 1ST BYTE 06730000 +EXXNOX2 EQU * 06732000 + LR RR2,RB2 SAVE THE LENGTH TO BE DONE 06734000 + LR RB2,RB1 LOAD ADDRESS OVER FOR RANGECHK 06736000 + SR RB2,RMEM GET CHECKABLE RANGE 06738000 + LA ROP,X'98' FAKE PROTECT LIKE LM INSTRC A 06739000 + BAL RLINK,EXRANGE HAVE ADDRESS-LENGTH CHECKED 06740000 + SRL RR1,3 GET MASK VALUE IN PLACE FOR INDEX 06742000 + ALR RR1,RR1 SHIFT LEFT FOR MULT OF TWO 06743000 + LH R1,EXXIOJ(RR1) GET ADDRESS VALUE 06744000 + B EXJUMP(R1) GO TO RIGHT SECTION OF CODE 06747000 + AIF (NOT &$JRM).EXNOJRM SKIP IF NO JRM SPECIAL CODE 06748050 + ORG *-4 ORG BACK OVER B EX0C1 INSTR 06748100 + TM ECFLAG3,$EC$JRM WAS SPECIAL JRM DEBUG FLAG SET 06748150 + BZ EX0C1 NO, MUST HAVE BEEN REAL ERROR 06748200 + SPACE 1 06748250 +* SPECIAL DEBUG CODE ENTERED ONLY WHEN JRM SUBMITS JOB 06748300 +* WITH CORRECT NAME/ACCT NUMBER, MODIFIES XREAD TO HAVE 06748350 +* MASK FIELD TOO LARGE FOR NORMAL CORRECTNESS. 06748400 +* IT CAUSES THE USER PROGRAM TO BE CALLED DIRECTLY: 06748450 +* R1 = ADDRESS OF SPECIAL ADDRESS LIST: A(ASSIST,ASJOBCON,VWXTABL) 06748500 +* R6(REC) = @ ECONTROL BLOCK, MAY NOT BE CHANGED BY USER PROGRAM. 06748550 +* R14,R15 NORMAL OS/360 CONVENTIONS 06748600 + LR RWK,RB1 MOVE ADDR OVER WHERE HE EXPECTS 06748650 + LA R1,=A(ASSIST,ASJOBCON,VWXTABL) USEFUL @'S 06748700 + B EXCALL GO TO GENERAL CALL ROUTINE 06748750 +.EXNOJRM ANOP 06748800 + SPACE 1 06758000 +* XREAD PSEUDO-INSTRUCTION - READ A CARD. * 06759000 +EXXREAD TM ECFLAG0,$ECEOF HAS THERE BEEN EOF ALREADY 06760000 + BO EXXREOF YES, USER TRYING TO GO PAST 06762000 + LA ROP,X'90' FOR PROTECT CHECK 06762500 + BAL RLINK,EXRANGE HAVE ADDRESS-LENGTH CHECKED 06763000 + $READ 0(RB1),(RR2),EXXREOFA 06764000 + BAL RCC,EXXIEND GO TO FINISH UP 06766000 +EXXREOFA OI ECFLAG0,$ECEOF FLAG END OF FILE 06768000 + BAL RCC,EXXIEND GO TO END UP 06770000 + SPACE 1 06772000 +EXXREOF MVI ECFLAG1,$ECREADR SHOW READ BEYOND END-OF-FILE ERROR 06774000 + LA R1,EXCCREAD SHOW END-FILE 06776000 + B EXITIA GO TO EXIT ROUTINE 06778000 + SPACE 1 06780000 +* XPRNT PSEUDO-INSTRUCTION- PRINT A LINE. * 06781000 +EXXPRNT $PRNT 0(RB1),(RR2),EXXRECEX 06782000 + B EXXIEND 06784000 + SPACE 1 06786000 +* XPNCH PSEUDO-INSTRUCTION - PUNCH A CARD. * 06787000 +EXXPNCH $PNCH 0(RB1),(RR2),EXXRECEX 06788000 + B EXXIEND DO COMMON EXIT 06790000 + AIF (&$XXIOS).EXXIOS1 SKIP IF NOT ALLOWED XGET-XPUT 06790500 +EXXGET EQU * XGET PSEUDO INSTRUCTION - DO INPUT 06790600 + LA ROP,X'90' FOR PROTECT CHECK 06790620 + BAL RLINK,EXRANGE HAVE ADDRESS-LENGTH CHECKED 06790640 + $GET 0(RB1),(RR2) 06790700 + BAL RCC,EXXIEND GO TO FINISH UP 06790800 +EXXPUT EQU * XPUT PSEUDO INSTRUCTION - DO OUTPUT 06790900 + $PUT 0(RB1),(RR2) 06791000 + BAL RCC,EXXIEND GO TO FINISH UP 06791100 + AGO .EXXIOS2 SKIP LABEL SAVING 06791200 +.EXXIOS1 ANOP SAVE LABELS 06791300 +EXXGET EQU * 06791400 +EXXPUT EQU * 06791500 +.EXXIOS2 ANOP 06791600 +EXXIEND EQU EXFIN COMMON EXIT-SAME AS EXFIN 06792000 + SPACE 1 06792500 +EXXRECHK CLI ECFLAG1,$ECRECEX DID XXXXSNAP SET FLAG 06793000 + BNE EXFIN NO, SO DON'T BOMB USER OUT 06793500 +EXXRECEX MVI ECFLAG1,$ECRECEX RECORDS EXCEEDED 06794000 + LA R1,EXCCRECE SHOW RECORDS EXCEEDED MESSAGE 06796000 + B EXITIA GO FINISH UP AND RETURN 06798000 + SPACE 1 06800000 +* XDUMP PSEUDO-INSTRUCTION - DUMP STORAGE OR REGISTERS. * 06801000 +EXXDUMP EQU * ENTRY LABEL FOR STORAGE XDUMP 06802000 + LR RB2,RB1 MOVE BEGINNING @, SINCE RB1=R10 06811000 + LR R10,REC MOVE ECONTROL PTR OVER FOR XXXXSNAP 06812000 + XSNAP T=(NO,,1),LABEL='USER STORAGE', X06814000 + STORAGE=(*0(RB2),*0(RR2,RB2)) 06816000 + B EXXRECHK GO CHECK FOR RECORD OVERFLOW 06818000 + SPACE 1 06820000 +EXXDUMPR LR R10,REC MOVE ECONTROL PTR OVER FOR XXXXSNAP 06822000 + XSNAP T=(PR,,1),LABEL='USER REGISTERS' 06824000 + B EXXRECHK GO CHECK FOR RECORD OVERFLOW 06826000 + SPACE 1 06826050 +* XLIMD PSUEDO INSTRUCTION - LIMIT DUMP AREA. * 06826100 +EXXLIMD LA RB2,0(RR2,RB1) GET 2ND LIMIT, REAL @ OF IT 06826150 + BCT RR2,*+8 IF RR2=1(OMITTED) USE END OF PROG 06826200 + L RB2,ECRADH LENGTH=1, USE HIGHEST @ INSTEAD 06826250 + STM RB1,RB2,ECRDLIML ECRDLIML-ECRDLIMH - NEW LIMTS 06826300 + B EXFIN GO FOR NEXT INSTRUCTION 06826350 + SPACE 1 06826400 +EXXIOJ $AL2 EXJUMP,(EXXREAD,EXXPRNT,EXXPNCH,EXXDUMP,EXXLIMD,EXXGET,EX06828000 + XXPUT,EX0C1) 06829000 +.EXNOXIO ANOP 06832000 + EJECT 06834000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06836000 +* UTILITY (3RD LEVEL) DECODING,ADDRESS ADDING,AND CHECKING * 06838000 +* ROUTINES. THESE ARE CALLED BY THE 1ST AND 2ND LEVEL PROCESSORS * 06840000 +* THESE ROUTINE ARE ONLY USED DURING ACTUAL INTERPRETATION. * 06842000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06844000 + SPACE 2 06846000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06848000 +* *** ADDRESS ADDER *** OBTAINS BASE-DISPLACEMENT,DECODES,AND * 06850000 +* RETURNS PROGRAM RELATIVE ADDRESS IN RB2. USES RW. * 06852000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06854000 +EXABD LH RB2,ECBD OBTAIN 1ST BASE-DISPLACEMENT 06856000 +EXABD1 LR RWK,RB2 DUPLICATE B-D OVER 06858000 + N RB2,=XL4'FFF' REMOVE BASE,LEAVING DISPLACEMENT 06860000 + N RWK,=XL4'F000' REMOVE DISPLACEMENT,LEAVE BASE 06862000 + BCR Z,RLINK IF NO BASE-DONE,RETURN TO CALLER 06864000 + SRL RWK,10 SHIFT TO GET BASE*4 FOR INDEX 06866000 + AL RB2,ECREGS(RWK) ADD VALUE FROM RIGHT FAKE REGISTER 06868000 + LA RB2,0(RB2) CHOP OFF FRONT BYTE 06870000 + BR RLINK RETURN TO CALLER 06872000 + SPACE 2 06874000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06876000 +* *** DOUBLE REGISTER DECODER - PLACES R1 AND (R2-X2-R3) * 06878000 +* FIELDS MULTIPLIED BY 4 INTO REGS RR1 AND RR2 RESPECTIVELY. * 06880000 +* THE CONDITON CODE IS SET ACCORDING TO PRESENCE OF NON-ZERO * 06882000 +* SECOND REGISTER FIELD * 06884000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06886000 + SPACE 1 06888000 +EXR1R2 IC RR1,ECR1R2 OBTAIN 2ND BYTE OF INST 06890000 + LR RR2,RR1 DUPLICATE VALUE TO OTHER REG 06892000 + N RR1,=XL4'F0' REMOVE 2ND REG,LEAVING 1ST ONLY 06894000 + SRL RR1,2 GET R1 FIELD*4,FOR INDEXING USE 06896000 + SLL RR2,2 PREPARE R2-X2-R3 FIELD FOR INDEX 06898000 + N RR2,=XL4'3C' REMOVE EXTRA BITS,SET CCODE 06900000 + BR RLINK RETURN TO CALLER 06902000 + EJECT 06904000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06906000 +* *** RANGE CHECKING ROUTINE - CHECKS THE ADDRESS PROVIDED IN * 06908000 +* RB2 FOR BEING WITHIN THE ALLOWABLE RANGE. THE METHOD USED * 06910000 +* DEPENDS ON THE FACT THAT AN EXTRA 256 BYTES OF CORE WAS * 06912000 +* ALLOCATED AT THE END OF THE USER PROGRAM,SO THAT THERE IS * 06914000 +* NO NEED TO CHECK USING THE LENGTH OF CODE AFFECTED BY THE * 06916000 +* INSTRUCTION. THIS ROUTINE USES REGISTER RWK. * 06918000 +* ENTRY CONDITIONS * 06920000 +* RB2= PROGRAM ADDRESS TO BE CHECKED FOR RANGE (ECFADL<=@ OPERATION 06976000 + EJECT 06978000 + SPACE 4 07064000 +* * * * * SECONDARY TYPE INDEX BRANCH ADDRESS TABLES * * * * * * * * * 07066000 + SPACE 1 07068000 +EXSECRR $AL2 EXJUMP,(EX0C1,EXSPM,EXBALR,EXBCTR,EXBCR,EXSSK,EXISK,EXSV#07070000 + C,EXLPNTR,EXNORMRR,EXLR,EXMRDR,EXFPRR,EXXFPRR,EXLONG) 07072000 +EXSECRX $AL2 EXJUMP,(EX0C1,EXLA,EXBAL,EXBCT,EXBC,EXNORMRX,EXMD,EXLOAD#07074000 + S,EXSTORS,EXFPRX,EXFPRXST,EXXFPRX,EXEX,EXXDECI,EXXDECO,E#07075000 + XXHEXI,EXXHEXO) 07076000 +EXSECSI $AL2 EXJUMP,(EX0C1,EXSSM,EXLPSW,EXWRD,EXRDD,EXRSBX,EXLMSTM,EX#07078000 + SHIFS,EXSHIFD,EXSI,EXSIO,EXTIO,EXHIO,EXTCH,EXCLM,EXSTCM,#07079000 + EXICM,EXLCTL,EXSTCTL,EXP370,EXXREPL) 07080000 +EXSECSS $AL2 EXJUMP,(EX0C1,EXMOVS,EXLOGS,EXTRT,EXEDMK,EXDECS,EXXIOS,E#07082000 + XSRP) 07083000 + SPACE 1 07084000 +* OFFSETS TO COMPLETION CODE MESSAGES * 07086000 +EXCOFFS $AL2 EXCC0,(EXCC1,EXCC2,EXCC3,EXCC4,EXCC5,EXCC6,EXCC7,EXCC8,E#07088000 + XCC9,EXCCA,EXCCB),-2 STANDARD INTERRRUPT PTRS 07090000 + AIF (NOT &$FLOTE).EXFL6 SKIP IF NO FLOATING INERRUPTS 07090500 + $AL2 EXCC0,(EXCCC,EXCCD,EXCCE,EXCCF) FLOATING INTERRUPTS 07091000 +.EXFL6 ANOP 07091500 +EXCC0 EQU * BASE @ FOR COMPLETION MESSAGES 07092000 +EXCC1 $ERCGN 0C1,'OPERATION' 07094000 +EXCC2 $ERCGN 0C2,'PRIVILEGED OPERATION' 07096000 +EXCC3 $ERCGN 0C3,'EXECUTE' 07098000 +EXCC4 $ERCGN 0C4,'PROTECTION' 07100000 +EXCC5 $ERCGN 0C5,'ADDRESSING' 07102000 +EXCC6 $ERCGN 0C6,'SPECIFICATION' 07104000 +EXCC7 $ERCGN 0C7,'DATA' 07106000 +EXCC8 $ERCGN 0C8,'FIXED-POINT OVERFLOW' 07108000 +EXCC9 $ERCGN 0C9,'FIXED-POINT DIVIDE' 07110000 +EXCCA $ERCGN 0CA,'DECIMAL OVERFLOW' 07112000 +EXCCB $ERCGN 0CB,'DECIMAL DIVIDE' 07114000 + AIF (NOT &$FLOTE).EXFL8 SKIP MESSAGES FOR FLOATING POINT 07115000 +EXCCC $ERCGN 0CC,'EXPONENT OVERFLOW' 07116000 +EXCCD $ERCGN 0CD,'EXPONENT UNDERFLOW' 07118000 +EXCCE $ERCGN 0CE,'SIGNIFICANCE' 07120000 +EXCCF $ERCGN 0CF,'FLOATING-POINT DIVIDE' 07122000 +.EXFL8 ANOP 07122500 + SPACE 1 07124000 +EXCCREAD $ERCGN 220,'ATTEMPTED READ PAST END-FILE',TYPE=ASSIST 07126000 +EXCCTIME $ERCGN 221,'INSTRUCTION LIMIT EXCEEDED',TYPE=ASSIST 07128000 +EXCCRECE $ERCGN 222,'RECORD LIMIT EXCEEDED',TYPE=ASSIST 07130000 + AIF (&$TIMER EQ 0).EXNOTOC SKIP IF NO TIMER AT ALL 07131000 +EXCCTIMB $ERCGN 223,'TIME LIMIT EXCEEDED',TYPE=ASSIST 07132000 +.EXNOTOC ANOP 07133000 +EXCCBROU $ERCGN 224,'BRANCH OUT OF PROGRAM AREA',TYPE=ASSIST 07134000 + SPACE 1 07136000 + AIF (&$S370 NE 2).EXDUBLW SKIP IF NOT SIMULATING S/370 07136100 +EXDUBLWD DC D'0' DOUBLE-WORD FOR ALIGNING OPERANDS 07136200 +EXSRPMK DC XL4'F0' MASK TO REMOVE IMMEDIATE FIELD 07136300 +EXALIGN DC H'22' # OF HIGH RX INST NEEDING ALIGNMENT 07136400 +EXSRPDA1 DC PL1'0' AREA FOR ROUNDING FACTOR 07136500 +EXSRPDA2 DS PL16'0' AREA FOR SHIFTING USER NUMBER 07136600 +.EXDUBLW AIF (&$S370 EQ 0).EXLONGK SKIP IF WE DON'T HAVE S/370'S 07136700 +EXLONGMK DC 0F'0',XL4'FFFFFF' MASK FOR ZAPPING UPPER BYTES OF REGS 07136800 +.EXLONGK ANOP 07136900 +EXILENG DC F'2,4,4,6' INSTRUCTION LENGTHS 07138000 +EXILC DC F'0' USED BY BAL AND BALR TO HOLD ILC 07140000 +EXNORNG DC H'8' # OF HIGH RX INST WITH NO RANGECK 07142000 + LTORG 07148000 + EJECT 07149000 + DS 0D ALIGN FOR DUMP READING EASE 07149010 +* * * * * TABLE OF SECONDARY BRANCH INDEX VALUES * 07149020 +* TR TABLE 0 1 2 3 4 5 6 7 8 9 A B C D E F * 07149030 +EXOPTAB1 DC X'00000000020406080A0C0E0000001C1C' 0 07149040 + DC X'10101010121212121412121216161212' 1 07149050 + DC X'18181818181A1A1A1818181818181818' 2 07149060 + DC X'18181818181A1A1A1818181818181818' 3 07149070 + DC X'1002100A180406080E0A0A0A0A00100E' 4 07149080 + DC X'10001C1A0A0A0A0A0E0A0A0A0C0C0A0A' 5 07149090 + DC X'141E2000000000161212121212121212' 6 07149100 + DC X'14000000000000001212121212121212' 7 07149110 + DC X'0200040006080A0A0E0E0E0E10101010' 8 07149120 + DC X'0C121212121212120C0000001416181A' 9 07149130 + DC X'28000000000000000000000000000000' A 28-XREPL 07149140 + DC X'002600000000242200000000001C1E20' B 07149150 + DC X'00000000000000000000000000000000' C 07149160 + DC X'00020202040404040000000002060A08' D 07149170 + DC X'0C0C0000000000000000000000000000' E 07149180 + DC X'0E0A0202000000000A0A0A0A0A0A0000' F 07149190 + SPACE 1 07149200 +* * * * * TABLE USED BY RANGE CHECKING ROUTINE FOR RX,SI,RS, AND SS * 07149210 +* BITS OF EACH BYTE HAVE FOLLOWING MEANING * 07149220 +* BIT 0 = 1 ==> 1ST ADDRESS IS PROTECTED IF NOT RUNNING REPLACE MODE* 07149230 +* BIT 1 = 1 ==> 1ST ADDRESS IS PROTECTED REGARDLESS OF RUNNING MODE * 07149240 +* BIT 2 = 1 ==> 2ND ADDRESS IS PROTECTED IF NOT RUNNING REPLACE MODE* 07149250 +* BIT 3 = 1 ==> 2ND ADDRESS IS PROTECTED REGARDLESS OF RUNNING MODE * 07149260 +* BITS 2-3 ARE ONLY FLAGGED FOR SS AND POSSIBLY SPECIAL INSTS * 07149270 +* **NOTE** BIT 1 = 1 ==> BIT 0 = 1, BIT 3 = 1 ==> BIT 2 = 1. * 07149280 +* TR TABLE 0 1 2 3 4 5 6 7 8 9 A B C D E F * 07149290 +EXIPROT DC X'C000C080C0000000808080808000C080' 4 07149300 + DC X'C000C080808080808080808080808080' 5 07149310 + DC X'C080C000000000808080808080808080' 6 07149320 + DC X'C0000000000000008080808080808080' 7 07149330 + DC X'00000000000000000000000000000000' 8 07149340 + DC X'C080C0C0C080C0C08000000000000000' 9 07149350 + DC X'C0000000000000000000000000000000' A 28-XREPL 07149360 + DC X'0000C0000000C080000000000080C080' B 07149370 + DC X'00000000000000000000000000000000' C 07149380 + DC X'00E0E0E0E0A0E0E000000000E0A0E0E0' D 07149390 + DC X'00000000000000000000000000000000' E A 07149400 + DC X'C0E0E0E000000000E0A0E0E0E0E00000' F 07149410 + SPACE 4 07149420 + DROP R13,REC,RSTK KILL LEFTOVER USINGS 07150000 +.EXYZ ANOP 07150005 + TITLE 'XXXXDECI - EXTENDED DECIMAL INPUT CONVERSION MODULE' 07150010 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07150015 +*--> CSECT: XXXXDECI EXTENDED DECIMAL INPUT CONVERSION MODULE * 07150020 +* XXXXDECI IS CALLED BY MACRO XDECI TO PERFORM SCANNING AND * 07150030 +* CONVERSION OF DECIMAL STRINGS. * 07150040 +* ENTRY CONDITIONS * 07150050 +* R14= ADDRESS OF XDECIB DSECT CREATED BY CALLING XDECI. * 07150060 +* R15= ENTRY POINT ADDRESS (=V(XXXXDECI)) * 07150070 +* EXIT CONDITIONS * 07150080 +* XDECIR1,XDECIRV VALUES ARE FILLED IN FOR REGS. * 07150090 +* CC IS SET ACCORDING TO SIGN OF RESULT, OR = 3 IF ERROR. * 07150100 +* USES DSECTS: XDECIB * 07150110 +* NAMES: XXDI---- * 07150120 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07150130 +XXXXDECI CSECT 07150140 + USING *,R15 NOTE ENTRY PT USING FOR BASE REG 07150150 + USING XDECIB,R14 NOTE @ CONTROL BLOCK FROM XDECI 07150160 + STM R2,R3,XXDISAVE SAVE WORK REGISTERS 07150170 + LA R1,1 USEFUL CONSTANT, IN ODD REGISTER 07150180 + LR R2,R0 MOVE BEGINNING @ OVER WHERE USABLE 07150190 +* SCAN LOOP TO SKIP OVER LEADING BLANKS. 07150200 + CLI 0(R2),C' ' IS NEXT CHARACTER A BLANK 07150210 + BNE *+8 SKIP OUT OF LOOP IF NOT 07150220 + BXH R2,R1,*-8 LOOP, INCREMENTING SCAN POINTER 07150230 + SPACE 1 07150240 + MVI XXDIS,X'10' MAKE INST AN LPR FOR NOW 07150250 + CLI 0(R2),C'+' IS THERE A LEADING + 07150260 + BE XXDII YES, BRANCH TO BUMP POINTER 07150270 + CLI 0(R2),C'-' IS THERE A LEADING - 07150280 + BNE XXDII2 NO,DON'T BUMP SCAN POINTER 07150290 + MVI XXDIS,X'11' - SIGN,SO MAKE INST AN LNR 07150300 +XXDII AR R2,R1 BUMP SCAN PTR BY 1, LEADING SIGN 07150310 +XXDII2 LR R3,R2 MOVE INIT SCAN PTR AND SAVE IT 07150320 + SPACE 1 07150330 +* SCAN TO END OF DECIMAL DIGITS. 07150340 + CLI 0(R2),C'0' IS NEXT CHARACTER A DIGIT 07150350 + BL *+16 BRANCH OUT OF LOOP IF NOT DIGIT 07150355 + CLI 0(R2),C'9' WAS IT TOO HIGH (MULTIPUNCH) 07150360 + BH *+8 YES, BRANCH OUT. IDIOT OVERPUNCHERS 07150365 + BXH R2,R1,*-16 LOOP BACK, BUMPING SCAN POINTER 07150370 + SPACE 1 07150380 + ST R2,XDECIR1 STORE VALUE FOR RETURN AS SCAN PTR 07150390 + SR R2,R3 OBTAIN LENGTH OF STRING 07150400 + BZ XXDION IF ZERO LENGTH, ERROR, BRANCH 07150410 + LA R0,9 LIMIT FOR COMPARISON 07150420 + CR R2,R0 COMPARE WITH LIMIT VALUE 07150430 + BNH *+12 SKIP IF SMALL ENOUGH TO BE OK 07150440 +XXDION TM *+1,1 SET COND CODE = 3,BAD VALUE 07150450 + B XXDIST GO TO RETURN TO CALLER 07150460 + SR R2,R1 NORMAL CODE, DECREMENT LENGTH 07150470 + EX R2,XXDIPK PACK THE VALUE 07150480 + CVB R0,XXDIDWOR CONVERT VALUE 07150490 +XXDIS LPR $+R0,R0 MAKE SIGN, SET CC RIGHT**MODIFIED*** 07150500 + ST R0,XDECIRV SAVE AS VALUE FOR REG 07150510 +XXDIST LM R2,R3,XXDISAVE RESTORE EXTRA WORK REGS 07150520 + B XDECIRET RETURN TO CALLING XDECI MACRO 07150530 + SPACE 1 07150540 +XXDIPK PACK XXDIDWOR,0($,R3) PACK TO BE EXECUTED 07150550 +XXDIDWOR DS D DOUBLEWORD WORKAREA 07150560 +XXDISAVE DS 2F WORK REGS SAVE AREA 07150570 + DROP R14,R15 KILL USINGS 07150580 + SPACE 1 07150590 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07150595 +*--> DSECT: XDECIB CONTROL BLOCK CREATED BY XDECI MACRO * 07150600 +* AN XDECIB IS CREATED BY EACH CALL TO THE XDECI MACRO, AND * 07150610 +* CONTAINS THE @ XXXXDECI, SAVEWORDS FOR REGS R14,R15,R0, AND * 07150620 +* WORDS FOR RETURN VALUES FOR REGISTER R1, AND THE ARGUMENT REG* 07150630 +* THIS DSECT IS USED ONLY IN MODULE XXXXDECI. * 07150640 +* GENERATION: XDECI * 07150650 +* NAMES: XDECI--- * 07150660 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07150670 +XDECIB DSECT 07150680 + DS V(XXXXDECI) ADCON TO GET HERE 07150690 + DS 3F REGS 14,15,0 SAVED HERE 07150700 +XDECIR1 DS A RETURN VALUE FOR REG 1 SCAN POINTER 07150710 +XDECIRV DS F VALUE CONVERTED AND RETURNED HERE 07150720 +XDECIRET LM 14,1,4(14) RETURN POINT @ 07150730 + TITLE 'XXXXDECO - EXTENDED DECIMAL OUTPUT CONVERSION PROGRAM' 07150740 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07150745 +*--> CSECT: XXXXDECO EXTENDED DECIMAL OUTPUT CONVERSION MODULE * 07150750 +* XXXXDECO IS CALLED BY MACRO XDECO TO CONVERT A REGISTER * 07150760 +* VALUE TO EDITED DECIMAL, IN A 12-BYTE AREA, WITH SIGN. * 07150770 +* ENTRY CONDITIONS * 07150780 +* R14= ADDRESS OF XDECOB DSECT CREATED BY XDECO * 07150790 +* R15= ENTRY POINT ADDRESS (=V(XXXDECO)) * 07150800 +* EXIT CONDITIONS * 07150810 +* EDITED 12-BYTE RESULT OF REGISTER ARGUMENT STORED AT ADDRESS ARG. * 07150820 +* USES DSECTS: XDECOB * 07150830 +* NAMES: XXDO---- * 07150840 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07150850 +XXXXDECO CSECT 07150860 + USING *,R15 NOTE ENTRY PT USING FOR BASE 07150870 + USING XDECOB,R14 NOTE XDECO CONTROL BLOCK 07150880 + STM R1,R2,XXDOSAVE SAVE WORK REGISTERS 07150890 + LR R2,R0 MOVE @ AREA WHERE CAN BE USED 07150900 + L R0,XDECOV GET VALUE TO BE CONVERTED 07150910 + CVD R0,XXDODWOR CONVERT THE VALUE 07150920 + MVC 0(12,R2),XXDODECP MOVE EDIT PATTERN IN 07150930 + LA R1,11(R2) SET UP FOR NEG NUMBER FOR EDMK 07150940 + EDMK 0(12,R2),XXDODWOR+2 EDIT THE VALUE OVER 07150950 + BNM XXDORETN SKIP INSERTION OF - IF >=0 07150960 + BCTR R1,0 MOVE @ POINTER BACK 1 07150970 + MVI 0(R1),C'-' INSERT - IN FRONT OF 1ST DIGIT 07150980 +XXDORETN LM R1,R2,XXDOSAVE RESTORE WORKING REGS 07150990 + SPM R14 RESTORE ORIGINAL COND CODE 07151000 + B XDECORET RETURN TO CALLING XDECO 07151010 + SPACE 1 07151020 +XXDODECP DC X'402020202020202020202120' EDIT PATTERN 07151030 +XXDODWOR DS D WORKAREA 07151040 +XXDOSAVE DS 2F SAVE AREA FOR REGS 1-2 07151050 + DROP R14,R15 KILL USINGS 07151060 + SPACE 1 07151070 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151075 +*--> DSECT: XDECOB CONTROL BLOCK CREATED BY XDECO * 07151080 +* AN XDECOB IS CREATED FOR EACH XDECO CALL, AND CONTAINS THE * 07151090 +* @ XXXXDECO MODULE, SAVE WORDS FOR REGS R14,R15,R0, AND A * 07151100 +* WORD FOR THE VALUE TO BE CONVERTED TO DECIMAL. * 07151110 +* XDECOB IS USED ONLY IN CSECT XXXXDECO. * 07151120 +* GENERATION: XDECO * 07151130 +* NAMES: XDECO--- * 07151140 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151150 +XDECOB DSECT 07151160 + DS V(XXXXDECO) ADCON TO GET HERE 07151170 + DS 3F SAVE AREA FOR REGS 14,15,0 07151180 +XDECOV DS F VALUE FOR CONVERSION 07151190 +XDECORET LM 14,0,4(14) RETURN POINT @ 07151200 + AIF (NOT &$HEXI).XXHEXI 07151210 + TITLE 'XXXXHEXI-MODULE CALLED BY XHEXI' 07151215 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151217 +*-->CSECT: XXXXHEXI EXTENDED HEXADECIMAL INPUT CONVERSION MODULE * 07151220 +* XXXXHEXI IS CALLED BY MACRO XHEXI TO SCAN THE INPUT STRING * 07151225 +* AND CONVERT IT TO HEXADECIMAL INPUT. * 07151230 +* ENTRY CONDITIONS * 07151235 +* R14= ADDRESS OF A STORAGE AREA WITH R14-R1 STORED * 07151240 +* R15= ENTRY POINT ADDRESS (V(XXXXHEXI)) * 07151245 +* R0 = ADDRESS OF STRING TO BE SCANNED. * 07151250 +* EXIT CONDITIONS * 07151255 +* VALUE OF CONVERTED STRING IN STORAGE AREA POINTED TO BY R14, * 07151260 +* STORED IN 16 PASSED R14 OR IN XHEXINUM. * 07151265 +* R1= ENDING ADDRESS OF STRING, I.E. FIRST NON-HEXADECIMAL DIGIT. * 07151270 +* CC SET=3 IF ERROR * 07151275 +* USES DSECT XHEXIB. * 07151280 +* NAMES: XXHI---- * 07151285 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151290 + SPACE 1 07151295 +XXXXHEXI CSECT 07151300 + USING *,15 SET UP BASE REGISTER 07151310 + USING XHEXIB,R14 DSECT OVERLAP 07151315 + STM R14,R6,XXHEXISA STORE APPROPRIATE REGISTERS 07151320 + LR R1,R0 START SCAN OF STRING 07151325 + LA R3,1 ODD VALUE USED IN BXH INSTR 07151330 +XXHILP CLI 0(R1),C' ' SEARCH FOR FIRST NON-BLANK 07151335 + BNE XXHIBGN BRANCH WHEN FOUND TO START TRT 07151340 + BXH R1,R3,XXHILP KEEP GOING UNTIL FIND NON-BLANK 07151345 +XXHIBGN LR R3,R1 FIRST BYTE OF STRING IN R3 AND R4 07151350 + LR R4,R3 07151355 + LR R6,R1 BEGINNING OF STRING 07151360 + LA R1,8(R1) R1 NOW HAS MAXIMUM ADDRESS IN IT 07151365 +* IF TRT DOESN'T STOP BEFORE 8TH TIME, R1 WON'T CHANGE=> NEED END 07151370 + TRT 0(8,R6),XXHITAB2 FIND LAST BYTE-8 MAXIMUM 07151375 + LR R6,R1 SAVE ENDING ADDRESS 07151380 + SR R1,R3 FIND NO OF CHARACTERS 07151385 + BZ XXHIERR IF LENGTH ZERO SET CC TO 3 07151390 + LR R3,R1 07151395 + MVC XXHIDOUB(8),=12C'0' MOVE ZEROS IN AREA TO BE CONVERTED 07151400 + LA R5,8 07151405 + SR R5,R3 # OF PADDED BLANKS 07151410 + LA R5,XXHIDOUB(R5) R5 NOW ADDRESS OF CONVERTED STRING 07151415 + BCTR R3,0 07151420 + EX R3,XXHIMOVE EX USED TO MOVE CONVERTED STRING IN 07151425 + TR XXHIDOUB(8),XXHITAB3 CONVERT C1-C6 TO FA-FF 07151430 + PACK XXHIOUT(5),XXHIDOUB(9) DO FUNNY PACK TO MAKE RIGHT LETS 07151435 + L R0,XXHIOUT CONVERTED NUMBER IN R0 07151440 + ST R0,XHEXINUM STORE CONVERTED NUMBER 07151445 + B XXHIARND BRANCH AROUND CONSTANTS 07151450 + LTORG 07151455 +XXHIMOVE MVC 0(0,R5),0(R4) MOVE FOR STRING TO BE CONVRTED 07151460 +XXHIDOUB DS D,C STORAGE AREA 07151465 +XXHIOUT DS F,C STORAGE AREA 07151470 + SPACE 1 07151475 +** TAB2 STOPS ON ANYTHING BUT VALID HEX DIGITS 07151480 +XXHITAB2 DC 256X'01' 07151485 + ORG XXHITAB2+C'A' STOPS ON ANYTHING BUT A-F 07151490 + DC 6X'00' 07151495 + ORG XXHITAB2+C'0' STOP ONLY ON 0-9 07151500 + DC 10X'00' 07151505 + ORG 07151510 + SPACE 1 07151515 +* TAB3 USED IN TR CONVERTS TO FA-FF FROM C1-C6 07151520 +XXHITAB3 EQU *-C'A' CONVERT FA-FF FROM C1-C6 07151525 + DC X'FAFBFCFDFEFF' 07151530 + ORG XXHITAB3+C'0' 07151535 + DC X'F0F1F2F3F4F5F6F7F8F9' 07151540 + ORG 07151545 +XXHIERR TM *+1,1 SET CONDITION CODE 07151550 +XXHIARND LM 14,15,XXHEXISA RESTORE REGISTERS 07151555 + LR R1,R6 ENDING ADRESS IN SRTING 07151560 + LM R2,R6,XXHEXISA+16 07151565 + B XHEXIRET RETURN TO CALLING PROG 07151570 +XXHEXISA DS 9F SAVE AREA FOR REGISTERS 07151575 + DROP R14,R15 CLEAN UP USINGS 07151580 + SPACE 5 07151585 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151587 +*--> DSECT: XHEXIB CONTROL BLOCK CREATED BY XHEXI * 07151590 +* AN XHEXIB IS CREATED FOR EACH XHEXI CALL, AND CONTAINS THE * 07151595 +* @ XXXXHEXI MODULE, SAVE WORDS R14,R15,R0, AND A WORD VALUE THAT HAS* 07151600 +* BEEN CONVERTED * 07151605 +* XHEXI IS USED ONLY IN CSECT XXXXHEXI * 07151610 +* GENERATION XHEXI * 07151615 +* NAMES XHEXI--- * 07151620 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151625 +XHEXIB DSECT 07151630 + DS V(XXXXHEXI) ADCON TO GET HERE 07151635 + DS 3F STORAGE FOR REGISTERS 07151640 +XHEXINUM DS F STORAGE FOR CONVERTED NUMBER 07151645 +XHEXIRET LM R14,0,4(R14) RESTORE REGISTERS 07151650 +.XXHEXI AIF (NOT &$HEXO).XXHEXO 07151660 + TITLE 'XXXXHEXO - MODULE TO SUPPORT XHEXO PSEUDO-OP' CPP 07151665 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151667 +*-->CSECT: XXXXHEXO EXTENDED HEXADECIMAL OUTPUT CONVERSION MODULE * 07151670 +* XXXXHEXO IS CALLED BY MACRO XHEXO TO CONVERT A REGISTER VALUE* 07151675 +* TO EDITED HEXADECIMAL IN AN 8-BYTE AREA. * 07151680 +* ENTRY CONDITIONS: * 07151685 +* R14= ADDRESS OF SAVEAREA FOR CALLING MACRO * 07151690 +* R15= ENTRY POINT ADDRESS * 07151695 +* R0 = ADDRESS OF AREA WHERE CONVERTED STRING GOES * 07151700 +* # OF REGISTER CONTAINING VALUE TO BE CONVERTED IN XHEXOREG * 07151705 +* EXIT CONDITIONS: * 07151710 +* 8-BYTE CONVERTED VALUE FROM REGISTER ARGUMENT STORED AT ADDRESS * 07151715 +* POINTED TO BY LOCATION ARGUMENT * 07151720 +* USES DSECT XHEXOB. * 07151725 +* NAMES:XXHO---- * 07151730 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151735 + SPACE 1 07151740 +XXXXHEXO CSECT 07151745 + USING *,15 BASE REGISTER 07151750 + USING XHEXOB,R14 DSECT OVERLAP 07151755 + STM R14,R1,XXHEXOSA STORE REGISTERS 07151760 + L R1,XHEXOREG REGISTER TO BE CONVERTED 07151765 + ST R1,XXHOAREA STORE NUMBER TO BE CONVERTED 07151770 + LR R1,R0 VALUE OF ADDRESS TO BE MOVED TO IN R1 07151775 + L R14,=A(XXHOTAB3-C'0') FOR CONVERSION 07151780 + UNPK XXHODOUB(9),XXHOAREA(5) CONVERT NUMBER 07151785 + TR XXHODOUB,0(R14) MAKE PRINTABLE 07151790 + MVC 0(8,R1),XXHODOUB MOVE NUMBER INTO RIGHT AREA 07151795 +XXHOBACK LM R14,R1,XXHEXOSA RESTORE REGISTERS 07151800 + B XHEXORET RETURN TO CALLING PROG 07151805 +XXHOTAB3 DC C'0123456789ABCDEF' 07151810 +XXHOAREA DS F,C STORAGE AREA 07151815 +XXHODOUB DS D,C STORAGE 07151820 +XXHEXOSA DS 4F 07151825 + LTORG 07151830 + DROP R14,R15 CLEAN UP USINGS 07151835 + SPACE 5 07151840 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151843 +*--> DSECT: XHEXOB CONTROL BLOCK CREATED BY XHEXO * 07151845 +* AN XHEXOB IS CREATED FOR XHEXO CALL, AND CONTAINS THE @ * 07151850 +* XXXXHEXO MODULE, SAVE WORDS FOR R14-R2 AND THE PLACE TO RETURN * 07151855 +* XHEXOB IS USED ONLY IN CSECT XXXXHEXO. * 07151860 +* GENERATION: XXXXHEXO * 07151865 +* NAMES: XHEXO---- * 07151870 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151875 +XHEXOB DSECT 07151880 + DS V(XXXXHEXO) STORAGE OF VCON 07151885 + DS 3F 07151890 +XHEXOREG DS F REGISTER STORAGE 07151895 +XHEXORET LM R14,R2,4(R14) RESTORE REGISTERS 07151900 +.XXHEXO ANOP 07151905 + AIF (&$XXIOS).XGPSKIP SKIP IF XGET/XPUT NOT ALLOWED 07151950 + TITLE 'CSECT***XDDTABLE*** CONTROL TABLE FOR XGET-XPUT MONIT' 07151954 +XDDTABLE CSECT 07151956 +**-->CSECT: XDDTABLE* * * * * * * * * * * * * * * * * * * * * * * * * * 07151958 +* CONTAINS INFORMATION ON EACH FILE FOR THE MONITOR * 07151960 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07151962 + XDDSLOT SYSIN,XREAD,POSIN=1 XREAD ONLY 07151964 + XDDSLOT FT05F001,XREAD,POSIN=1 XREAD ONLY 07151966 + XDDSLOT XREAD,XREAD,POSIN=1 XREAD ONLY 07151968 + XDDSLOT INPUT,XREAD,POSIN=1 XREAD ONLY 07151970 + XDDSLOT XPRNT,XPRNT,POSOUT=1 XPRNT ONLY 07151972 + XDDSLOT FT06F001,XPRNT,POSOUT=1 XPRNT ONLY 07151974 + XDDSLOT XPNCH,XPNCH,POSOUT=1 XPNCH ONLY 07151976 + XDDSLOT FT07F001,XPNCH,POSOUT=1 XPNCH ONLY 07151978 + XDDSLOT XSNAPOUT USER CAN'T TOUCH XSNAPOUT 07151980 + XDDSLOT SYSPRINT USER CAN'T TOUCH SYSPRINT 07151982 + XDDSLOT SYSLIB USER CAN'T TOUCH SYSLIB 07151984 + XDDSLOT FT08F001 USER CAN'T TOUCH FT08F001 07151986 + XDDSLOT FT16F001,POSOUT=1 USER CAN OUTPUT 07151988 + XDDSLOT FT17F001,POSOUT=1 USER CAN OUTPUT 07151990 + XDDSLOT 07151992 + XDDSLOT 07151994 + XDDSLOT 07151996 + XDDSLOT 07151998 + XDDSLOT 07152000 + XDDSLOT 07152002 +X$DDLONG EQU *-XDDTABLE BYTE LENGTH OF TABLE 07152004 +X$DDNUM EQU X$DDLONG/X$SLLONG WILL BE SET TO # OF SLOTS 07152006 + TITLE 'CSECT***XDDGET*** XGET-XPUT MONITOR' 07152008 +XDDGET CSECT 07152010 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07152011 +*-->CSECT: XDDGET (ENTRY XDDPUT) * 07152012 +* XGET - XPUT MONITOR. USES TABLE XDDTABDE TO CONTROL * 07152014 +* I/O THROUGH USER CALLS TO XGET & XPUT. * 07152016 +* CALLS $READ,$PRNT,$PNCH,XGET,XPUT MACROS. * 07152018 +* E.X. * 07152020 +* THE MONITOR WILL NOT PERMIT A USER TO XGET A $READ FILE, * 07152022 +* INSTEAD, THE MONITOR WILL CALL $READ AND THE USER WILL * 07152024 +* NOT KNOW ABOUT IT. * 07152026 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07152027 + USING XIOBLOCK,R14 07152028 + USING *,R15 07152030 + MVI XDDIOBIT,X$SLXGET SET FOR INPUT 07152032 + LA R15,XDDPUT RESET ADDRESSING 07152034 + USING XDDPUT,R15 07152036 + B XDDPUT+4 CONTINUE PROCESSING, KEEP INPUT FLAG 07152038 + ENTRY XDDPUT 07152040 +XDDPUT MVI XDDIOBIT,X$SLXPUT SET FOR OUTPUT 07152042 +* COMMON FROM NOW ON 07152044 + STM R14,R12,XDDSAVE SAVE REGS 07152046 + USING XDDPUT,12 SET NORMAL ADDRESSING 07152048 + LR R12,R15 07152050 + DROP R15 KILL R15 07152052 + L R3,=V(XDDTABLE) GET THE @ OF THE TABLE 07152054 + USING X$SLOT,R3 07152056 + LA R4,X$SLLONG GET LENGTH/INCR OF ENTRY 07152058 + LA R5,X$SLOT+X$DDLONG-1 07152060 +XDDLOOP1 CLC X$SLNAME(8),0(R1) ARE NAMES SAME? 07152062 + BE XDDFOUND YES, CHECK OUT REST OF ENTRY 07152064 + BXLE R3,R4,XDDLOOP1 07152066 +* NOT FOUND 07152068 + AIF (&X$DDMOR).XDDSK1 ALLOWED OWN DDNAMES? 07152070 +* YES TRY TO FIND SPACE 07152072 + L R3,=A(XDDTABLE) RESET BEGINNING ADDRESS 07152074 +XDDLOOP TM X$SLFLAG,X$SLPERM ENTRY TEMPORARY? 07152076 + BZ XDDMAKE YES 07152078 +XDDLPBOT BXLE R3,R4,XDDLOOP 07152080 +.XDDSK1 ANOP 07152082 +* SIGNAL ERROR 07152084 +XDDFBAD EQU * 07152086 + TM *+1,X'FF' SET COND CODE 07152088 +XDDFGOOD EQU * 07152090 + LM R14,R12,XDDSAVE RESTORE REQS 07152092 + B XIORETRN RETURN 07152094 + AIF (&X$DDMOR).XDDSK2 07152096 +* PUT DDNAME IN 07152098 +XDDMAKE TM X$SLFLAG,X$SLOPEN FILE OPEN? 07152100 + BM XDDLPBOT YES, TRY AGAIN 07152102 + MVC X$SLNAME(8),0(R1) 07152104 + MVI X$SLFLAG,X$SLPOIN SET FOR POSSIBLE IN OR OUT 07152106 + B XDDAAAA 07152108 +.XDDSK2 ANOP 07152110 +XDDFOUND TM X$SLFLAG,X$SLOPEN IS IT OPEN? 07152112 + BZ XDDNOPEN NO, GO FIX UP 07152114 + TM X$SLFLAG,$ *****CHANGES- GOING THE RIGHT WAY? 07152116 +XDDIOBIT EQU *-3 LABEL FOR IMMEDIATE BYTE 07152118 + BO XDDECIDE GOING RIGHT WAY --- BRANCH 07152120 + B XDDFBAD TAKE BAD BRANCH 07152122 +XDDNOPEN SR R2,R2 EMPTY R2 07152124 + IC R2,XDDIOBIT 07152126 + SRL R2,4 MOVE BITS OVER 07152128 + STC R2,*+5 PUT IN TM INST BELOW 07152130 + TM X$SLFLAG,$ ****CHANGES***** USER ALLOWED TO GO THIS WAY 07152132 + BZ XDDFBAD NO, GO RETURN 07152134 +XDDAAAA OC X$SLFLAG,XDDIOBIT SET TEMP DIRECTION BIT 07152136 +XDDECIDE SR R2,R2 CLEAR R2 07152138 + IC R2,X$SLWAY 07152140 + LH R8,XIOLENG SET UP LENGTH 07152142 + B *+4(R2) BRANCH INTO BRANCH TABLE 07152144 + B XDD$GPIO DO XGET-XPUT 07152146 + B XDD$READ DO NORMAL READ 07152148 + B XDD$PRNT DO NORMAL PRINT 07152150 + B XDD$PNCH DO NORMAL PUNCH 07152152 +XDD$READ EQU * 07152154 + $READ (R0),(R8) 07152156 + B XDDFGOOD GO RETURN 07152158 +XDD$PRNT EQU * 07152160 + $PRNT (R0),(R8) 07152162 + B XDDFGOOD GO RETURN 07152164 +XDD$PNCH EQU * 07152166 + $PNCH (R0),(R8) 07152168 + B XDDFGOOD GO RETURN 07152170 +XDD$GPIO EQU * 07152172 + LTR R8,R8 IS LENGTH ZERO? 07152174 + BNE *+8 NO, DON'T FORGET ELEMENT 07152176 + NI X$SLFLAG,X$SLCLOS EMPTY ELEMENT 07152178 + CLI XDDIOBIT,X$SLXPUT WAS IT OUTPUT? 07152180 + BE XDD$PUT YES, DO OUTPUT 07152182 +* NO, DO INPUT 07152184 + XGET (R0),(R8) 07152186 + B XDDCLEAN 07152188 +XDD$PUT EQU * 07152190 + XPUT (R0),(R8) 07152192 +XDDCLEAN EQU * 07152194 +* IF COND CODE IS BAD, WIPE OUT FLAG 07152196 + BE XDDFGOOD GO RETURN 07152198 + BALR R2,0 SAVE COND CODE FOR AFTER NI 07152200 + NI X$SLFLAG,X$SLCLOS WIPE OUT FLAG 07152202 + SPM R2 RESTORE COND CODE TO BEFORE NI 07152204 + B XDDFGOOD GO RETURN 07152206 +XDDSAVE DS 15F SAVE AREA FOR REGISTERS 07152208 + LTORG 07152210 + DROP R14,R3,R12 CLEAN UP USINGS 07152212 + TITLE 'CSECT***XXDDFINI*** CLOSE XGET-XPUT HANDLED FILES' 07152216 +XXDDFINI CSECT 07152218 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07152219 +*-->CSECT: XXDDFINI CLOSES XGET-XPUT FILES * 07152220 +* LIKE XXXXFINI, CALLED AT SAME TIME. * 07152222 +* BUT CLOSES ONLY THE FILES HANDLED BY XGET-XPUT * 07152224 +* * 07152226 +* SEARCHS TABLE XDDTABLE FOR FILES THAT ARE OPEN AND ARE HANDLED * 07152228 +* BY XGET-XPUT. * 07152230 +* WHEN FOUND, CLOSES THEM THROUGH XGET-XPUT. BLANKS OUT FIRST BYTE * 07152232 +* OF NAME IN TABLE. IF NOT PERMANENT, AND NOT OPEN, * 07152234 +* JUST WIPES OUT FIRST BYTE. * 07152236 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07152238 + USING XIOBLOCK,R14 ADDRESSABILITY INTO XIOBLOCK 07152240 + USING *,R15 TEMPORARY ADDRESSABILITY 07152242 + STM R14,R12,XDDFSAVE SAVE REGISTERS 07152244 + BALR R12,0 SET R12 07152246 + USING *,R12 PERMANENT ADDRESSABILITY 07152248 + DROP R15 KILL R15 07152250 + L R3,=V(XDDTABLE) GET THE @ OF THE TABLE 07152252 + USING X$SLOT,R3 . SET UP FOR TABLE 07152254 + LA R4,X$SLLONG GET INCREMENT SIZE 07152256 + LA R5,X$SLOT+X$DDLONG-1 GET UPPER BOUNDARY 07152258 +XXDDFLOP TM X$SLFLAG,X$SLOPEN IS FILE OPEN 07152260 + BZ XXDDFCHK NO, GO SEE IF IT IS PERMANENT 07152262 + CLI X$SLWAY,X$SLXGPT IS FILE HANDLED BY XGET-XPUT? 07152264 + BNE XXDDFBOT NO, CLOSED BY XXXXFINI 07152266 + LR R1,R3 POINT TO DD NAME 07152268 + TM X$SLFLAG,X$SLXGET HANDLED BY XGET? 07152270 + BO XXDDFGET YES CLOSE BY XGET 07152272 +* NO, CLOSE BY XPUT 07152274 + XPUT XDDFSAVE,0 CLOSE, USE DUMMY OUTPUT AREA 07152276 + B XXDDFCHK 07152278 +XXDDFGET EQU * 07152280 + XGET XDDFSAVE,0 CLOSE, USE DUMMY INPUT AREA 07152282 +XXDDFCHK NI X$SLFLAG,X$SLCLOS REMOVE OPEN BITS 07152284 + TM X$SLFLAG,X$SLPERM IS FILE PERMANENT 07152286 + BO XXDDFBOT YES, LEAVE ALONE 07152288 + MVI X$SLNAME,C' ' NO, BLANK OUT 07152290 +XXDDFBOT BXLE R3,R4,XXDDFLOP TRY NEXT ENTRY 07152292 +* RAN OUT OF ENTRIES, DONE 07152294 + LM R14,R12,XDDFSAVE RESTORE REGISTERS 07152296 + BR R14 RETURN 07152298 +XDDFSAVE DS 15F SAVE AREA FOR REGISTERS 07152300 + LTORG 07152302 + DROP R14,R3,R12 KILL USINGS 07152304 + PRINT GEN 07152307 +XXXXGET XGPGEN 07152308 +XXXXPUT XGPGEN DIREC=P 07152310 + PRINT NOGEN TURN OFF AFTER 07162900 +.XGPSKIP ANOP 07162999 + TITLE 'CSECT XXXXXIOCO ASSIST I/O PROCESSOR' 07163000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07163500 +*--> CSECT: XXXXIOCO ASSIST INPUT/OUTPUT CONTROL PROCESSING * 07164000 +* XXXXIOCO CONTAINS ALL ACTUAL INPUT/OUTPUT OPERATIONS. * 07166000 +* XXXXINIT AND XXXXFINI ARE USUALLY CALLED ONCE EACH, TO * 07168000 +* PERFORM INITIALIZATION AND TERMINATION RESPECTIVELY. * 07170000 +* THE ENTRIES XXXXSORC,XXXXREAD,XXXXPNCH,XXXXPRNT ARE CALLED * 07172000 +* TO READ SOURCE CARDS,READ DATA CARDS, PUNCH CARDS, OR PRINT * 07174000 +* LINES DURING EXECUTION. THE DCB'S FOR READ AND PNCH ARE NOT * 07176000 +* OPENED UNLESS THEY ARE USED, AND IF USED WITHOUT WORKABLE * 07178000 +* OPEN'S, THEY DEFAULT BACK TO SORC AND PRNT, RESPECTIVELY. * 07180000 +* THESE 4 ENTIRES SHARE A COMMON BASE REGISTER (R13,ALSO @ SAVE* 07182000 +* AREA), COMMON VALUES OF R11 (@ AJOBCON) AND R12 ( CONSTANT 1)* 07184000 +* COMMON EXIT CODE. SORC AND READ SHARE SOME COMMON CODE (GET)* 07186000 +* AND PNCH AND PRNT SHARE SOME COMMON CODE (PUT). * 07188000 +* THESE ROUTINES ARE DESIGNED TO ACCEPT THE XIOBLOCK SET UP BY * 07190000 +* THE XIONR MACRO($READ,$PRNT,$PNCH,$SORC). LOCATE MODE IS * 07192000 +* USED TO MINIMIZE MOVEMENT OF CARD AND LINE IMAGES. * 07194000 +* *NOTE* REMOTE OPEN/CLOSE PARM LISTS ARE USED TO SAVE SPACE. * 07194100 +* UNDER A DOS SYSTEM, NO SUCH LIST EXISTS DUE TO THE NON- * 07194200 +* EXISTENCE OF MACRO EXECUTE FORMS FOR THE CLOSING OF DTF'S * 07194300 +* USES MACROS: DCB,DCBD(OS) OR DTF(DOS) (OVERALL USE) * 07195000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07196000 + SPACE 1 07198000 +XXXXIOCO CSECT 07198300 + $DBG ,NO SHOW NO DEBUG CODE-$SAVE/$RETURN 07198600 + ENTRY XXXXINIT,XXXXFINI,XXXXREAD,XXXXSORC,XXXXPNCH,XXXXPRNT 07199000 + AIF (&$DISKU EQ 0).XXNOENT SKIP ENTRY DEFINITION IF NODSK 07199050 + AIF (&$ASMLVL).XXBOS1 GEN. CORRECT DISK I/O EQUATES 07199060 +XXDECBE EQU 4 . DOS 'DECB' OFFSET 07199062 +XXDECBIN EQU 0 . OFFSET INTO FAKE DECB - XXFIXUP 07199064 +XXDKOFFL EQU 8 . DOS BUFFER OFFSET, NEEDS 8 BYTES 07199066 +XXDKOPEN EQU X'15' DTF OFFSET FOR OPEN TEST 07199068 +XXMASK EQU X'04' DOS OPEN TEST MASK 07199070 + AGO .XXBOS2 07199072 +.XXBOS1 ANOP 07199074 +XXDECBE EQU 16 . OS DECB OFFSET 07199076 +XXDECBIN EQU 12 . OFFSET INTO OS DECB - XXFIXUP 07199078 +XXDKOFFL EQU 0 . OS BUFFER OFFSET, NONE NEEDED 07199080 +XXDKOPEN EQU 48 . OS DCB DISP. FOR OPEN TEST 07199082 +XXMASK EQU X'10' . OS OPEN TEST MASK. 07199084 +.XXBOS2 ANOP 07199086 + ENTRY XXXXDKOP,XXXXDKRD,XXXXDKE1,XXXXDKWT 07199100 +.XXNOENT ANOP 07199150 + AIF (NOT &$MACSLB).XXNOMET SKIP ENTRIES IF NO MACSLB 07199200 + ENTRY XXXXLBOP,XXXXLBRD,XXXXFIND,XXXXLBED 07199220 +.XXNOMET ANOP 07199240 + USING AJOBCON,R11 NOTE GLOBAL USING FOR WHOLE CSECT 07199300 + SPACE 1 07199600 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07199950 +*--> ENTRY: XXXXINIT INITIAL OPEN FOR READER/PRINTER * 07200000 +* OPENS PRINTER,SOURCE CARD RDR. INITIALIZES XXIOCPTR, WHICH * 07200100 +* ALWAYS HAS BEGINNING @ OF OPEN/CLOSE PARM LIST (OS GEN. ONLY)* 07200200 +* ENTRY CONDITIONS * 07200500 +* R11= @ AJOBCON DUMMY SECTION * 07201000 +* AJIO-- FLAGS IN AJOBCON ARE ALL ZEROS. * 07201500 +* EXIT CONDITIONS * 07202000 +* AJIOSO,AJIOPR FLAGGED WITH AJIOPEN IF DCB'S OPENED PROPERLY. * 07202500 +* USES MACROS: $RETURN,$SAVE,OPEN * 07203000 +* USES DSECT: AJOBCON * 07203500 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07203800 + SPACE 1 07203900 +XXXXINIT $SAVE RGS=(R14-R12),SA=XXIOSAVE,BR=R6 07204000 + ST R11,XXIOAJOB SAVE @ OF MAIN TABLE 07206000 + AIF (NOT &$MACSLB).XXINNOM SKIP WHEN NO MACSLB ABILITY 07206100 + MVI XXLBFLG,X'00' SHOW NO BUFFER(MACSLB) AT THIS POINT 07206200 +.XXINNOM ANOP 07206300 + AIF (&$ASMLVL).XXOSOPN SKIP FOR OS GENERATION OPEN 07206500 + OPEN XXSODCB,XXPRDCB OPEN XXSODCB, XXPRDCB RIGHT NOW 07206550 + TM XXSODCB+15,X'20' DID SOURCE READER OPEN? 07206600 + BO *+8 SKIP FLAGGING IF IT DIDN'T OPEN 07206650 + OI AJIOSO,AJIOPEN SHOW SOURCE READER OPEN 07206700 + TM XXPRDCB+15,X'20' DID LINE PRINTER OPEN? 07206750 + BO *+8 SKIP FLAGGING IF IT DIDN'T OPEN 07206800 +.XXOSOPN AIF (NOT &$ASMLVL).XXDOSOP SKIP IF A DOS OPEN 07206850 + LA R1,XXIOCSP INIT VALUE OF OPEN/CLOSE PTR 07207500 + ST R1,XXIOCPTR STORE INIT VALUE OF PTR 07208000 + OPEN MF=(E,(1)) OPEN XXSODCB,XXPRDCB RIGHT NOW 07208500 + TM XXSODCB+48,X'10' DID SOURCE READER OPEN? 07210000 + BZ *+8 SKIP FLAGGING IT OPEN IF DIDN'T 07212000 + OI AJIOSO,AJIOPEN SHOW SOURCE READER OPEN 07214000 + TM XXPRDCB+48,X'10' DID PRINTER OPEN? 07216000 + BZ *+8 SKIP FLAGGING IT OPEN IF DIDN'T 07218000 +.XXDOSOP ANOP 07218100 + OI AJIOPR,AJIOPEN SHOW PRINTER OPEN 07220000 +XXIOOPRT $RETURN RGS=(R14-R12) 07222000 + EJECT 07222100 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07222150 +*--> ENTRY: XXXXFINI CLOSE ALL DCB'S WHICH ARE OPEN * 07222200 +* XXXXFINI USES THE OPEN/CLOSE PARM LIST BUILT DURING EXECUTION* 07222300 +* TO CLOSE ALL DCB'S CURRENTLY OPEN. USES 1 EXECUTE TYPE OPEN.* 07222310 +* DOS GENERATIONS HAVE NO OPEN/CLOSE LIST, SO A CHECK MUST BE * 07222350 +* MADE TO SEE WHICH DCB'S MUST BE CLOSED. * 07222360 +* ENTRY CONDITIONS * 07222400 +* R11= @ AJOBCON DUMMY SECTION * 07222500 +* EXIT CONDITIONS * 07222600 +* AJIO-- FLAGS ARE ALL ZEROED OUT. * 07222700 +* USES DSECTS: AJOBCON * 07222800 +* USES MACROS: $RETURN,$SAVE,CLOSE * 07222900 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07224000 + SPACE 1 07226000 +XXXXFINI $SAVE RGS=(R14-R12),BR=R6,SA=XXIOSAVE 07228000 + AIF (&$ASMLVL).XXOSCLS SKIP FOR OS GENERATION CLOSE 07228200 + PUT XXPRDCB OUTPUT LAST DOS RECORD 07228250 + CLOSE XXSODCB,XXPRDCB CLOSE SOURCE READER AND PRINTER 07228300 + AIF (NOT &$DATARD).XXNORDR SKIP IF NO //DATA.INPUT RDR 07228350 + TM AJIORE,AJIOPEN WAS OTHER READER OPENED 07228400 + BNO XXFIPNCH IF NOT, THEN DON'T CLOSE IT 07228450 + CLOSE XXREDCB CLOSE DATA CARD READER 07228500 +.XXNORDR AIF (NOT &$PUNCH).XXNOPNC SKIP IF NO REAL CARD PUNCH 07228550 +XXFIPNCH TM AJIOPN,AJIOPEN WAS THE PUNCH OPENED 07228600 + BNO XXFIEXIT IF NOT, THEN DON'T CLOSE IT 07228650 + PUT XXPNDCB OUTPUT LAST PUNCHED DOS CARD 07228700 + CLOSE XXPNDCB CLOSE CARD PUNCH FILE 07228750 +.XXNOPNC AIF (&$PUNCH).XXOSCLS SKIP IF CARD PUNCH EXISTS 07228800 +XXFIPNCH EQU * EQU TO EXIT, SINCE NO REAL PUNCH 07228850 + TM AJIODSK,AJIOPEN IS DISK DTF OPEN 07228855 + BO XXFIOUT NO - SO GO RETURN 07228860 + CLOSE XXDKUDCB YES - SO CLOSE DTF 07228865 +XXFIOUT EQU * 07228870 +.XXOSCLS AIF (NOT &$ASMLVL).XXDOSCL SKIP IF DOS CLOSE IN EFFECT 07228900 + L R1,XXIOCPTR GET PTR TO BUILT UP OPEN/CLOSE LIST 07229000 + CLOSE MF=(E,(1)) REMOTE CLOSE ON ALL OPEN DCB'S 07229500 +.XXDOSCL ANOP 07230000 +XXFIEXIT XC AJIOFLAG,AJIOFLAG CLEAR ALL FLAGS OUT 07256000 + AIF (NOT &$ASMLVL).XXFIF1 SKIP IF NOT OS/360 07256200 +* FOLLOWING CODE REQUIRED FOR PROPER REUSABILITY. 07256300 + L R2,XXIOCPTR GET @ BEGINNING OF DCB @ LIST 07256400 + SPACE 1 07256500 +XXFIFREE L R1,0(,R2) GET @ NEXT DCB 07256600 + AIF ((&$DISKU EQ 0) AND (NOT &$MACSLB)).XXFINA 07256605 + USING IHADCB,R1 NOTE USING ON R1 07256610 + TM DCBBUFCB+3,1 DOES DCB OWN A BUFFER POOL OR NOT 07256625 + BO XXDCBLST SINCE ODD @, NO BUFFER POOL - BRANCH 07256630 +XXFRPOOL FREEPOOL (1) DO THE FREEPOOL TO GET RID OF BUFS 07256635 +XXDCBLST TM 0(R2),X'80' WAS THAT THE LAST? 07256640 + AGO .XXFINB 07256645 +.XXFINA ANOP 07256650 + FREEPOOL (1) DO THE FREEPOOL TO GET RID OF BUFS 07256700 + TM 0(R2),X'80' WAS THAT ONE THE LAST ONE? 07256800 +.XXFINB ANOP 07256850 + LA R2,4(R2) INCREMENT TO NEXT DCB @ 07256900 + BNO XXFIFREE NOT LAST, GO BACK FOR NEXT ONE 07257000 + SPACE 1 07257100 +.XXFIF1 ANOP 07257200 + $RETURN RGS=(R14-R12),SA=XXIOSAVE 07258000 + DROP R6 KILL USING 07260000 + EJECT 07262000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07263000 +* REGISTER USAGE FOR SECTIONS SORC,READ,PNCH,PRNT * 07264000 +* R0 = @ I/O AREA WHERE USER DESIRES DATA MOVED TO/FROM * 07266000 +* R1 = @ DCB FOR OPERATION (SET BEFORE ENTRY TO SECTIONS GET, PUT * 07268000 +* R2 = @ CONTROL BYTE FOR READER SECTIONS, SET BEFORE ENTRY TO GET * 07270000 +* R3,R4 WORK REGISTERS * 07272000 +* R5 = DOS IOREG FOR BOTH GET & PUT OPERATIONS * 07272500 +* R6,R7,R8,R9,R10 ARE NOT MODIFIED OR USED * 07273000 +* R11= @ AJOBCON, MAIN CONTROL DUMMY SECTION * 07274000 +* R12= 1, USEFUL CONSTANT * 07276000 +* R13= @ SAVE AREA XXIOSAVE, ALSO COMMON BASE REGISTER * 07278000 +* R14= @ XIOBLOCK, CONTAINING LENGTH OF I/O REQUEST * 07280000 +* R15= LOCAL WORK REGISTER, TEMPORARY SINCE I/O OPRS MODIFY. * 07281000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07282000 + SPACE 1 07284000 + USING XXIOSAVE,R13 NOTE GLOBAL USING 07286000 + USING XIOBLOCK,R14 NOTE PTR TO XIOBLOCK, GLOBAL 07288000 + AIF (NOT &$DATARD).XXNDAT0 SKIP IF NO //DATA.INPUT RDR 07288900 + SPACE 2 07290000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07290050 +*--> ENTRY: XXXXREAD READ 1 CARD AT USER EXECUTION TIME * 07290100 +* OPENS CARD READER(DDNAME FT05F001) IF NOT ALREADY OPEN, OR * 07290200 +* USES OPEN READER (DDNAME FT00F001) TO GET 1 CARD, USING THE * 07290300 +* COMMON CODE SECTION XXIOGET. IF NODATA WAS SPECIFIED IN THE * 07290400 +* USER PARM FIELD, NO OPEN WILL BE DONE FOR FT05F001, BUT * 07290500 +* SYSIN WILL BE USED INSTEAD. CALLED BY $READ MACRO. * 07290600 +* ENTRY CONDITIONS * 07290700 +* R0 = @ I/O AREA WHERE DATA TO BE READ/WRITTEN * 07290800 +* R14= @ XIOBLOCK CREATED BY THE CALLING XIONR MACRO. * 07290900 +* R15= ENTRY POINT ADDRESS * 07291000 +* EXIT CONDITIONS * 07291100 +* CC= 0 NORMAL RETURN, CARD WAS READ AND TRANSFERRED TO USER * 07291200 +* CC= 1 ENDFILE ON READER. IF ASSIST JCL, SAVED IN AJOBCON. * 07291300 +* USES MACROS: GET,OPEN * 07291400 +* USES DSECTS: AJOBCON,XIOBLOCK * 07291500 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07291600 + SPACE 1 07292000 + USING XXXXREAD,REP NOTE TEMPORARY USING 07294000 +XXXXREAD STM R11,R5,XXIOSAVT STORE REGS TO BE CHANGED 07296000 + LM R11,R13,XXIOAJOB LOAD NEEDED VALUES 07298000 + DROP REP KILL TEMPORARY USING 07300000 + TM AJIORE,AJIOPEN WAS IT ALREADY OPEN? 07302000 + BO XXREC YES,GO DO GET 07304000 + TM AJIORE,AJIODFLT ARE WE USING SOURCE RDR INSTEAD? 07306000 + BO XXSORE YES, SO USE SORC READER INSTEAD 07308000 +* CALL OPTIONAL USING OPEN ROUTINE TO OPEN RDR IF IT CAN. 07308100 + LA R2,AJIORE SHOW @ RDR CONTROL BYTE 07308200 + AIF (&$ASMLVL).XXNDTF SKIP IF UNDER OS GENERATION 07308220 + LA R1,XXREDCB SHOW @ OF DOS DCB 07308240 +.XXNDTF AIF (NOT &$ASMLVL).XXNIOCR SKIP IF UNDER DOS GENERATION 07308260 + LA R3,XXIOCRE SHOW @ OF OPEN/CLOSE PARM VALUE 07308300 +.XXNIOCR ANOP 07308320 + BAL R4,XXIOPENO CALL OPEN/FLAGGING SECTION 07308400 + BZ XXIOGET IF OK, ALL SET UP-GO READ 07308500 + B XXSORE OPEN DIDN'T GO, USE SOURCE RDR 07308600 + SPACE 1 07308700 +XXREC LA R1,XXREDCB SHOW @ DCB 07332000 + LA R2,AJIORE SHOW @ CONTROL BYTE 07334000 + B XXIOGET GO TO COMMON GET ROUTINE 07336000 +.XXNDAT0 AIF (&$DATARD).XXNDAT2 SKIP IF DATA RDR EXISTS 07336900 +XXXXREAD EQU * EQU TO XXXXSORC-DATA RDR ^EXIST 07337000 +.XXNDAT2 ANOP 07337100 + SPACE 2 07338000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07338050 +*--> ENTRY: XXXXSORC READ A CARD DURING ASSEMBLY TIME * 07338100 +* CALLED BY MACRO $SORC TO READ CARD FOR ASSEMBLER, USING * 07338200 +* ALREADY OPEN DCB (DDNAME SYSIN). * 07338300 +* ENTRY CONDITIONS - SAME AS THOSE FOR ENTRY XXXXREAD. * 07338400 +* EXIT CONDITIONS - SAME AS THOSE FOR ENTRY XXXXREAD. * 07338500 +* USES DSECTS: AJOBCON,XIOBLOCK * 07338600 +* USES MACROS: GET * 07338700 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07338800 + SPACE 1 07340000 + USING XXXXSORC,REP NOTE TEMPORARY USING 07342000 +XXXXSORC STM R11,R5,XXIOSAVT STORE REGS TO BE CHANGED 07344000 + LM R11,R13,XXIOAJOB LOAD NEEDED VALUES 07346000 + DROP REP KILL TEMPORARY USING 07348000 + AIF (NOT &$MACSLB).XXNOSOC SKIP IF NO MACRO LIBRARY 07349000 +XXSWTCH BC $,XXXXLBRD GET A CARD FROM LIBRARY-MAYBE 07349500 +.XXNOSOC ANOP 07349550 + CLI AJOBTRQ,AJO$D REQUEST FOR DATA? J 07349600 + BE XXIOBTAA YES, NO NEED FRO SPECIAL CHECKS J 07349603 +* AT THIS POINT, ASSIST IS ASKING FOR A $JOB/$ENTRY CARD J 07349606 + NI AJIOSO,255-AJIOPSEO MAKE SURE NO PSEUD-END-FILE ON J 07349610 + AIF (NOT &$HASPBT).XXIOBTA SKIP IF NO HASP AUTOBATCH J 07349613 + TM AJIOSO,AJIOSOHS DO WE NEED BUFFER FLUSH? J 07349616 + BZ XXIOBTAA NO,SKIP OVER IT J 07349620 + NI AJIOSO,255-AJIOSOHS REMOVE FLAG SO WON'T DO AGAIN J 07349630 +* JUST PREVIOUSLY, TWO OS NULL CARDS HAD BEEN FOUND, AND J 07349640 +* ASSIST WANTS TO READ FOR THE NEXT $JOB CARD, IN WHICH J 07349643 +* CASE HASP MAY WANT TO PERFORM TERMINATION. IT IS USED J 07349646 +* THUSLY. IF USING MULTIPLE BUFFERS, CONSIDER CHANGING J 07349647 +* THIS TO CLOSE/OPEN ON XXPRDCB. J 07349648 +* IT IS NECESSARY TO PUT A BLANK LINE (SINCE LOCATE MODE)J 07349650 +XXSORD PUT XXPRDCB DO PUT LOCATE 07349652 + LH R2,XXPRDCB+DCBLRECL-IHADCB GET ACTUAL RECORD LENGTH J 07349660 + BCTR R2,0 GET LENGTH-1 FOR MVC J 07349670 + STC R2,*+5 PUT LENGTH-1 INTO MVC J 07349680 + MVC 0($,R1),AJOBLANK PUT OUT A BLANK LINE TO FLUSH J 07349690 +.XXIOBTA ANOP J 07349710 +XXIOBTAA EQU * BRANCH IF DATA OR NO BUFFER FLUSH J 07349730 +XXSORE LA R1,XXSODCB SHOW @ DCB 07350500 + LA R2,AJIOSO SHOW @ CONTROL BYTE 07352000 + SPACE 2 07354000 +* * * * * XXIOGET - COMMON GET CODE FOR XXXXSORC AND XXXXREAD * 07356000 +XXIOGET TM 0(R2),AJIOEOF+AJIOPSEO WAS EITHER EOF FLAG ALREADY ON 07358000 + BNZ XXIORETA YES, REFUSE TO READ A CARD NOW 07360000 + LM R14,R0,XXIOSAVT+12 RELOAD ORIG VALUES, IN CASE CHANGED 07363000 + LH R3,XIOLENG GET THE LENGTH OF OPERATION FROM XIO 07364000 + LR R4,R0 MOVE @ AREA OVER FOR SAFEKEEPING 07366000 + TM AJIOSO,AJIOSORR WAS REREAD REQUIRED? J 07367000 + BZ *+16 NO, BRANCH AND READ NEXT CARD J 07367010 + L R1,XXIOLSTC REREAD- GET @ OF LAST BUFFER J 07367020 + NI AJIOSO,255-AJIOSORR CLEAR FLAG SO DON'T REREAD AGAIN J 07367030 + B XXIOBTBB BRANCH AROUND READ J 07367040 + GET (1) DO GET LOCATE ON DCB @ 07368000 + AIF (&$ASMLVL).XXNIORG SKIP IF OS & HAVE NO IOREG (PUT) 07368010 +* WHEN DOS ISSUES A GET, R5 IS USED AS ITS IOREG (SINCE R1 * 07368020 +* IS ILLEGAL) TO POINT TO INPUT BUFFER. MUST LOAD R1 NOW. * 07368030 + LR R1,R5 GET @ OF INPUT RECORD 07368040 +.XXNIORG ANOP 07368050 + ST R1,XXIOLSTC SAVE ADDRESS OF THIS BUFFER J 07368070 +XXIOBTBB EQU * BRANCH HERE IF DOING REREAD J 07368080 + SPACE 1 07368100 +* ***** BATCH CONTROL CARD PROCESSING ***** 07368200 +* IF NOT RUNNING BATCH MODE, ANYTHING GOES; ELSE $JOB & 07368300 +* $ENTRY CARDS CREATE PSEUDO EOF AND ARE SAVED. $STOP 07368400 +* SETS REAL EOF FLAG TO TERMINATE PROCESSING 07368500 + TM AJOMODE,AJOBATCH ARE WE IN BATCH MODE 07368600 + BNZ XXIOBTCC YES, GO LOOK FOR CONTROL CARDS J 07368700 + SPACE 1 07369700 +* THRU HERE ==> NORMAL CARD-SIMULATE READ 07369800 +XXIONORM EQU * ENTER HERE FOR NORMAL CARD 07369900 + SR R3,R12 SUBTRACT 1 FROM LENGTH 07370000 + BM XXIORETB 0 LENGTH READ(MUST BE FLUSHING) 07372000 + STC R3,*+5 STORE LENGTH - 1 INTO MOVE 07374000 + MVC 0($CHN,R4),0(R1) MOVE DESIRED PART OF CARD OVER 07376000 + AIF (NOT &$KP26).XXNKP26 SKIP IF NO 026 KEYPUNCH 07376500 + SPACE 1 07376600 +* IF KP=26 OPTION USED, TRSANSLATE CARD TO EBCDIC. 07376700 + TM AJIOSO,AJIOKP26 WAS KP=26 OPTION SPECIFIED 07376800 + BZ XXIOKP29 NO, DON'T TRANSLATE, ALREADY -29 07376900 + STC R3,*+5 STORE LENGTH-1 INTO TR 07377000 + TR 0($,R4),AJTRTB26 TRANSLATE AMOUNT READ BY RDR TO 029 07377100 +XXIOKP29 EQU * SKIP HERE IF NO TRANSLATE NEEDED 07377200 +.XXNKP26 ANOP 07377300 + B XXIORETB RETURN, SHOWING NORMAL RETURN P 07378000 + SPACE 1 J 07378200 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *J* 07378210 +* BATCH CONTROL CARD SCANNING PROCESS - NEW FOR VERSION 3.0 J* 07378215 +* THIS VERSION INCORPORATES MORE FLEXIBILITY, AND ALSO J* 07378220 +* SUPPORTS HASP AUTOBATCH CODE AS AN OPTION. MODULE ASSIST J* 07378225 +* SETS FLAG AJOBTRQ TO SHOW THE TYPE OF CONTROL CARD THAT IT J* 07378230 +* IS REQUESTING (AJOBTRQ=0 OTHERWISE). ACTIONS THEN DEPEND J* 07378235 +* ON THE TYPE REQUESTED AND THE INPUT FOUND. NOTE THAT THIS J* 07378240 +* CODE NOW PERFORMS THE FLUSH TO CONTROL CARD, RATHER THAN J* 07378245 +* HAVING ASSIST LOOP LOOKING FOR ONE. J* 07378250 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *J* 07378255 +XXIOBTCC CLI 0(R1),C'&$BTCC(1)' DOES CARD HAVE CONTROL CHARACTER? J 07378270 + BNE XXIOBTEE NO, CAN'T BE CONTROL CARD, BRANCH J 07378275 + CLC =C'&$BTCC(2)',1(R1) IS IT JOB BEGINNER? J 07378290 + LA R15,AJO$J SHOW CODE FOR JOB BEGINNER J 07378295 + BE XXIOBTFF YES, GO HANDLE IT J 07378300 + AIF ('&$BTCC(3)' EQ '').XXIOBT3 SKIP IF NO $ENTRY WANTED J 07378310 + CLC =C'&$BTCC(3)',1(R1) WAS IT $ENTRY OR EQUIVALENT? J 07378315 + LA R15,AJO$E SHOW CODE FOR $ENTRY J 07378320 + BE XXIOBTFF YES, GO TO PROCESS IT J 07378325 +.XXIOBT3 AIF ('&$BTCC(4)' EQ '').XXIOBT4 SKIP IF $STOP NOT ALLOWED J 07378340 + CLC =C'&$BTCC(4)',1(R1) IS THIS A $STOP CARD OR EQUIV? J 07378345 + BE XXIOEOF YES, TREAT AS REAL EOF J 07378350 +.XXIOBT4 ANOP J 07378355 +XXIOBTEE SR R15,R15 SET = AJOB$D, NOT A CONTROL CARD J 07378380 +XXIOBTFF EQU * COME HERE TO MAKE PROCESS DECISION J 07378400 + SPACE 1 J 07378420 + AIF (NOT &$HASPBT).XXIOBT6 SKIP IF NOT HASP AUTOBATCH J 07378440 +* HASP AUTOBATCH CODE FOLLOWS: SET UP TO READ OVER OS J 07378445 +* JOB CARDS, HANDLE TWO NULLS AS REQUIRED, ALLOW READING J 07378450 +* OF SINGLE NULL, AND MAKE UP DUMMY $JOB CARD IF OMITTED J 07378455 +* FOLLOWING OS JOB CARD. J 07378460 + CLC 0(2,R1),=C'//' WAS THIS CARD // CARD? J 07378500 + BNE XXIOBTSS NO, GO TO DETERMINE ACTION J 07378505 + CLC 2(70,R1),AJOBLANK+2 WAS IT NULL CARD (COLS 3-72)? 07378510 + BNE XXIOBTNN NO, NOT A NULL CARD AT ALL-BRANCH J 07378520 +* AT THIS POINT, WE HAVE 1 NULL. NOW CHECK FOR 2ND. J 07378530 + GET XXSODCB READ CARD, SET R1 => CARD J 07378540 + ST R1,XXIOLSTC MAKE SURE @ CARD SAVED FOR LATER J 07378545 + CLC 0(2,R1),=C'//' COULD IT BE NULL? J 07378550 + BNE XXIOBTHH NO, GO TO HANDLE SINGLE NULL(GAH) J 07378560 + CLC 2(70,R1),AJOBLANK+2 WAS IT NULL CARD (COLS 3-72)? 07378570 + BNE XXIOBTHH NOT NULL- BRANCH J 07378580 +* TWO NULL CARDS FOUND - ACTION DEPENDS ON REQUEST TYPE. J 07378600 + CLI AJOBTRQ,AJO$J WAS $JOB CARD ASKED FOR? J 07378620 + BE XXSORD YES, GO BUFFER FLUSH AND DO GET J 07378630 + OI AJIOSO,AJIOSOHS NEXT TIME-SHOW WILL NEED BUFFER FLSH 07378640 + AIF ('&$BTCC(3)' EQ '').XXIOBT5 SKIP IF NO $ENTRY J 07378650 + MVI AJOBTYP,AJO$J FAKE TO MAKE $ENTRY REQ QUIT J 07378660 + CLI AJOBTRQ,AJO$E WAS IT ACTUALLY $ENTRY? J 07378670 + BE XXIORETB RETURN NORMAL, WILL CALL FOR $JOB J 07378680 +.XXIOBT5 B XXIOASJC GO SHOW PSEUDO-END-FILE J 07378690 +* FOLLOWING CODE FOR SINGLE NULL BY ITSELF IN JOB(?) J 07378800 +XXIOBTHH MVC AJOJCLCD,AJOBLANK BLANK OUT WORK AREA J 07378805 + MVC AJOJCLCD(2),=C'//' CREATE DUMMY NULL CARD J 07378810 + LA R1,AJOJCLCD SHOW @ NULL CARD J 07378812 +XXIOBTJJ OI AJIOSO,AJIOSORR REREAD,DON'T LOSE LAST CARD J 07378815 + SR R15,R15 SHOW AJO$D => NON-CONTROL CARD J 07378820 + B XXIOBTSS GO TO DETERMINE ACTION NEEDED 4 07378830 +* FOLLOWING CODE IF // CARD, BUT NOT NULL CARD J 07378840 +XXIOBTNN CLI AJOBTRQ,AJO$J SHOULD WE BE SCANNING FOR $JOB J 07378845 + BNE XXIOBTSS NO, SO TREAT AS NORMAL DATA CARD J 07378850 +* WE ASSUME THAT WE'RE ACTUALLY LOOKING AT OS JOB CARD J 07378900 +* NOW: HERE IS PLACE FOR ACCOUNTING IF YOU WANT IT. J 07378905 + GET XXSODCB SKIP OVER THE CARD J 07378920 + ST R1,XXIOLSTC SAVE @, IN CASE NEEDED LATER J 07378925 + CLC =C'&$BTCC(1)&$BTCC(2)',0(R1) WAS IT A $JOB NEXT J 07378930 + BE XXIOBTOO YES, THIS IS WHAT WE WANTED J 07378940 +* NO $JOB CARD AFTER OS JOB: BE NICE AND FAKE ONE. J 07378950 +* FOLLOWING STATEMENT CAN BE USED TO SUPPLY PARMS, SINCE J 07378955 +* ASSIST THINKS IT'S A $JOB CARD. CHANGE AS DESIRED. J 07378960 + MVC AJOJCLCD,AJOBLANK BLANK OUT CARD WORKAREA J 07378963 + MVC AJOJCLCD(15),=CL15'&$BTCC(1)&$BTCC(2) ASSUMED' J 07378965 + LA R1,AJOJCLCD SHOW ADDRESS OF ASSEMBLED FAKE CARDJ 07378967 + OI AJIOSO,AJIOSORR MARK, SO DON'T LOSE LOOKAHEAD J 07378970 +XXIOBTOO LA R15,AJO$J FAKE CODE OF $JOB CARD J 07378975 +.XXIOBT6 ANOP 07378990 +* FOLLOWING CODE EXPECTS R15=0,1,2 TO INDICATE TYPE OF J 07379000 +* CARD FOUND (DATA, $JOB, $ENTRY(MAYBE)). USE TABLE TO J 07379010 +* DETERMINE ACTION: FUNCTION OF TYPE REQESTED&THAT FOUND.J 07379020 +XXIOBTSS STC R15,AJOBTYP SHOW THE TYPE ACTUALLY FOUND J 07379030 + MH R15,=H'3' MULTIPLY TO GET OFFSET OF TABLE ROW 07379040 + SR R14,R14 CLEAR FOR INSERT J 07379050 + IC R14,AJOBTRQ GET COLUMN SELECTOR: TYPE REQUEST J 07379060 + AR R15,R14 GET OFFSET OF CODE BYTE IN TABLE J 07379070 + IC R15,XXIOBTAB(R15) GET CODE BYTE TO DETERMINE ACTION J 07379080 +* ACTIONS: 0: LOOP (SEARCHING FOR $JOB/$ENTRY CARD); J 07379090 +* 4: RETURN NORMAL, COPYING CARD TO REQUESTED AREA; J 07379100 +* 8: EXIT WITH END-FILE (CONTROL CARD FOUND IN DATA) J 07379110 + B *+4(R15) TAKE INDEXED BRANCH J 07379200 + B XXSORE 0: LOOP, HUNTING CONTROL CARD J 07379210 + B XXIONORM 4: NORMAL RETURN, COPY CARD J 07379220 +* 8: FALL THRU INTO XXIOASJC J 07379230 +XXIOASJC OI AJIOSO,AJIOPSEO+AJIOSORR PSEUDO-EOF, REREAD TO SAVE CARD 07379500 + B XXIORETA SHOW A PSEUDO END-FILE 07379700 +XXIOEOF OI 0(R2),AJIOEOF SHOW END-FILE HAS OCCURRED 07380000 + B XXIORETA RETURN SHOWING END-FILE 07382000 +* ACTION CONTROL TABLE: USED IN XXIOBTSS CODE. CHANGE J 07382010 +* AS NEEDED IF DIFFERENT ACTIONS DESIRED. J 07382020 +* AJOBTRQ= DATA,$JOB,$ENTRY (REQUEST). ACTUAL FOUND BELOW J 07382030 +XXIOBTAB DC AL1(0004,0000,0000) DATA FOUND- NORMAL, LOOP, LOOP J 07382040 + DC AL1(0008,0004,0004) $JOB FOUND- EOF, NORMAL, NORMAL J 07382050 + DC AL1(0008,0000,0004) $ENTRY FOUND- EOF,LOOP,NORMAL J 07382060 +XXIOLSTC DS A @ LAST CARD READ, FOR REREAD USE J 07382100 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07382150 +*--> ENTRY: XXXXPNCH PUNCH A CARD, OPENING IF REQUIRED * 07382200 +* CALLED BY $PNCH MACRO TO PUNCH A CARD (DDNAME FT07F001). IF * 07382300 +* THE DCB XXPNDCB CANNOT BE OPENED, OR IF NOPUNCH WAS USED IN * 07382400 +* THE USER PARM FIELD, THE CARD IS PRINTED (DDNAME FT06F001) * 07382500 +* WITH ' CARD-->' PRECEDING IT TO NOTE USAGE. * 07382600 +* ENTRY CONDITIONS - SAME AS ENTRY XXXXREAD * 07382700 +* EXIT CONDITIONS * 07382800 +* CC= 0 NORMAL RETURN, CARD WAS PUNCHED OR PRINTED * 07382900 +* CC= 1 RECORD LIMIT HAS BEEN EXCEEDED, CARD PUNCHED ANYWAY * 07383000 +* USES DSECTS: AJOBCON,IHADCB,XIOBLOCK * 07383100 +* USES MACROS: OPEN,PUT * 07383200 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07384000 + SPACE 1 07386000 + USING XXXXPNCH,REP NOTE TEMPORARY USING 07388000 +XXXXPNCH STM R11,R5,XXIOSAVT SAVE REGS TO BE CHANGED 07390000 + LM R11,R13,XXIOAJOB LOAD NEEDED VALUES 07392000 + DROP REP KILL TEMPORARY USING 07394000 + AIF (NOT &$PUNCH).XXNPN0 SKIP IF NO REAL PUNCH 07394500 + LA R2,AJIOPN SHOW @ CONTROL BYTE 07395000 + TM AJIOPN,AJIOPEN HAS PUNCH BEEN OPENED? 07396000 + BO XXPNC YES, SO GO DO IT 07398000 + TM AJIOPN,AJIODFLT ARE WE ALREADY USING PRINTER? 07400000 + BO XXPNNOPN YES, SO GO FIX UP 07402000 + SPACE 1 07404000 +* CALL OPTIONAL UNIT OPEN ROUTINE TO OPEN PUNCH IF IT CAN. 07404100 + AIF (&$ASMLVL).XXYIOCR SKIP IF UNDER OS GENERATION 07404150 + LA R1,XXPNDCB SHOW @ OF DOS PUNCH DCB 07404200 +.XXYIOCR AIF (NOT &$ASMLVL).XXYSDTF SKIP IF UNDER DOS GENERATION 07404250 + LA R3,XXIOCPN SHOW @ OPEN/CLOSE PARM VALUE 07404300 +.XXYSDTF ANOP 07404350 + BAL R4,XXIOPENO CALL OPEN/FLAGGING ROUTINE, SETS CC 07404400 + BZ XXIOPUT IF OK, ALL SET UP, SO GO PUNCH 07404500 +XXPNNOPN EQU * SECTION TO USE PRINTER FOR PUNCH 07416100 +.XXNPN0 ANOP 07416150 + LR R2,R0 SAVE @ I/O AREA 07416200 + MVC AJOPNDFT(8),=C' CARD-->' ENTER CARD FLAG 07416300 + MVC AJOPNDFT+8(80),0(R2) MOVE POSSIBLE CARD OVER 07416400 + LA R0,AJOPNDFT FAKE I/O @ TO BE THIS AREA 07416500 + LH R3,XIOLENG GET LENGTH DESIRED TO PUNCH 07416600 + LA R3,8(R3) ADD EXTRA LENGTH OF ' CARD-->' 07416700 + LA R1,XXPRDCB SHOW @ OF PRINTER INSTEAD 07416800 + LA R2,AJIOPR SHOW @ CONTROL BYTE(IN CASE PAGE) 07416900 + B XXPRPN PRINT CARD INSTEAD OF PUNCHING 07418000 + AIF (NOT &$PUNCH).XXNPN1 SKIP IF NOPUNCH 07419000 + SPACE 1 07420000 +XXPNC LA R1,XXPNDCB SHOW @ DCB 07424000 + B XXIOPUT GO TO COMMON PUT SECTION 07426000 +.XXNPN1 ANOP 07426050 + EJECT 07426100 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07426150 +*--> ENTRY: XXXXPRNT PRINT ONE LINE OF OUTPUT * 07426200 +* CALLED BY $PRNT MACRO TO PRINT 1 LINE, USING DDNAME FT06F001.* 07426300 +* ENTRY CONDITIONS - SAME AS ENTRY XXXXREAD * 07426400 +* EXIT CONDITIONS - SAME AS XXXXPNCH * 07426500 +* USES DSECTS: AJOBCON,IHADCB,XIOBLOCK * 07426600 +* USES MACROS: PUT * 07426700 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07428000 + SPACE 1 07430000 + USING XXXXPRNT,REP NOTE TEMPORARY BASE 07432000 +XXXXPRNT STM R11,R5,XXIOSAVT SAVE REGS TO BE CHANGED 07434000 + LM R11,R13,XXIOAJOB LOAD NEEDED VALUES 07436000 + DROP REP KILL TEMPORARY USING 07438000 + LA R1,XXPRDCB SHOW @ PRINTER DCB 07440000 + LA R2,AJIOPR SHOW @ PRINTER CONTROL BYTE 07441000 + SPACE 1 07442000 +* * * * * XXIOPUT - COMMON PUT ROUTINE FOR PNCH, PRNT * 07444000 +XXIOPUT TM AJOMODE,AJOSRECX ARE RECORDS ALREADY EXCEEDED 07445000 + BO XXIORETA YES, IGNORE THIS GUY 07445300 + SPACE 1 07445600 + LH R3,XIOLENG GET LENGTH OF REQUEST 07446000 +* ***** OUTPUT RECORD COUNT AND TESTING ***** 07452040 +XXPRPN EQU * ENTRY POINT IF FAKING PUNCH ON PRNTR 07452060 + L R15,AJORECNT GET CURRENT RECORDS REMAINING 07452080 + SR R15,R12 DECREMENT 07452120 + BM XXIOVERP SKIP OUT, NO MORE-DON'T WRITE 07452160 + ST R15,AJORECNT STORE UPDATED COUNTER BACK 07452200 + SPACE 1 07452240 + AIF (NOT &$PAGE).XXNPAG2 SKIP WHOLE SECT IF NO PAGE 07452280 + LR R15,R0 MOVE @ USER AREA WHERE CAN USE IT 07452320 + MVC AJIOWRKB,0(R15) SAVE 1ST BYTE WHERE WE CAN GET IT 07452360 + TM 0(R2),AJIOPAGE ARE WE 1)PRINTING AND 2)IN PAGE CONT 07452400 + BZ XXNPAGEC NO, WE AREN'T IN PAGE CONTROL MODE-B 07452440 + SPACE 1 07452480 +* ***** PAGE CONTROL MODE - PERFORM COINT,CHECK ***** 07452520 + MVC XXIOPCLI+1(1),0(R15) MOVE CARRIAGE CONTROL IN FOR CLI 07452560 + LA R2,XXIOPGTA BEGINNING @ LEGAL CAR CON BYTE TABLE 07452600 + LA R14,4 INCREMENT FOR BXLE SEARCH 07452640 + LA R15,XXIOPGTZ @ LAST ELEMNT IN TABLE,BXLE LIMIT 07452680 + SPACE 1 07452720 +XXIOPCLI CLI 0(R2),$ COMPARE TABLE ELEMENT TO USER CARCON 07452760 + BE XXIOPFND FOUND WHAT HE USED-BRANCH 07452800 + BXLE R2,R14,XXIOPCLI LOOP UNTIL FIND IT OR RUN OUT 07452840 + SPACE 1 07452880 + LA R2,XXIOPGTB @ BLANK CARRAGE CONTROL TABLE ELEM. 07452920 +XXIOPFND EQU * CHARACTER FOUND 07452960 + TM AJIOPR,AJIOSING ARE WE IN CRUNCHED SINGLESPACE MODE? 07453000 + BZ XXIONSIN NO, NOT SINGLE SPACE MODE 07453040 +* FOLLOWING IMPLEMENTS SINGLE SPACE MODE, WHICH SINGLE 07453080 +* SPACES ANY CARRIAGE CONTROL EXCEPT '1', WHICH IS JUST 07453120 +* DOUBLE SPACED INSTEAD OF NEW PAGED. THIS MAY BE USEFUL 07453160 +* FOR CRAMMING AS MUCH OUTPUT AS POSSIBLE IN GIVEN # 07453200 +* OF PAGES, OR OBTAINING AS MUCH OF A DUMP AS POSSIBLE. 07453240 + IC R14,1(,R2) GET OFFSET TO WORD FOR REPLACEMENT 07453280 + LA R2,XXIOPGTA(R14) GET @ REPLACEMENT CARRIAGE CONTROL 07453320 +XXIONSIN EQU * SKIP HERE IF NO SINGLE SPACE 07453360 + MVC AJIOWRKB,0(R2) PICK UP CORRECT BYTE FOR CC 07453400 + SPACE 1 07453440 + LM R14,R15,AJOLREM GET AJOLREM-AJOPREM FOR TESTING 07453480 + SH R14,2(R2) LINES REMAINING-LINES FOR GIVEN CCON 07453520 + BP XXIOPSTL STILL MORE-JUMP-NO OVERFLOW 07453560 + SPACE 1 07453600 +* OVERFLOW TO NEXT PAGE- COUNT <= 0 07453640 + MVI AJIOWRKB,C'1' SHOW NEW PAGE CARRAGE CONTROL 07453680 + L R14,AJOL RESET # LEFT ON PAGE TO LIMIT 07453720 + SR R15,R12 # PAGES LEFT = # PAGES LEFT -1 07453760 + ST R15,AJOPREM STORE UPDATED PAGES REMAINING 07453800 + BM XXIOVERP PAGE COUNT EXCEEDED-SHOW OVERFLOW 07453840 +XXIOPSTL ST R14,AJOLREM STORE BACK COMPLETED LINES LEFT 07453880 +XXNPAGEC EQU * BRANCH HERE IF NO PAGE CONTROL ON 07453920 +.XXNPAG2 ANOP 07453960 + SPACE 1 07454000 + LR R2,R0 MOVE @ DATA AREA OVER WHERE SAFE 07454040 + AIF (&$ASMLVL).XXOSREC SKIP IF UNDER OS GENERATION 07455000 + L R4,8(R1) @ OF DTF CCW (CONTAINS LRECL-1) 07455020 + LH R4,6(R4) ORIGINAL DTF LRECL FIELD - 1 07455040 + LA R4,1(R4) +1 => ORIGINAL DTF LRECL 07455060 + PUT (1) DO DOS PUT, WITH IOREG AS SPECIFIED 07455080 +* WHEN DOS ISSUES A PUT, R5 IS USED AS THE IOREG (SINCE R1 IS * 07455100 +* ILLEGAL) TO POINT TO NEXT OUTPUT BUFFER. GET @ INTO R1. * 07455120 + LR R1,R5 @ OF DOS DTF OUTPUT BUFFER 07455140 +.XXOSREC AIF (NOT &$ASMLVL).XXDSREC SKIP IF UNDER DOS GENERATION 07455160 + USING IHADCB,R1 USING FOR DCB DUMMY SECTION 07455180 + LH R4,DCBLRECL GET LRECL FIELD FROM DCB 07455200 + DROP R1 KILL USING 07455220 + PUT (1) DO PUT LOCATE 07456000 +.XXDSREC ANOP 07456100 +* NEXT 3 STMTS GUARD AGAINST I/O OF LENGTH > REAL LENGTH. 07457000 + CLR R3,R4 IS I/O <= LRECL (CLR RATHER THAN CR) 07457100 + BNH *+6 YES, GOOD PERSON, SKIP OVER 07457200 + LR R3,R4 NO, BAD PERSON, USE LRECL 07457300 + SR R3,R12 DECREMENT LENGTH TO L-1 07458000 + BM XXIOPUTA SKIP IF 0 LENGTH 07460000 + STC R3,*+5 STORE LENGTH-1 FOR MOVE 07462000 + MVC 0($CHN,R1),0(R2) MOVE DATA OVER 07464000 +XXIOPUTA SR R4,R12 DECREMENT REG -LRECL FIELD 07466000 + AIF (NOT &$PAGE).XXNPAG4 SKIP IF NO PAGE CONTROL 07466900 + MVC 0(1,R1),AJIOWRKB PUT IN POSSIBLY-CHANGED CAR CON BYTE 07467000 +.XXNPAG4 ANOP 07467100 + AR R1,R3 GET @-1 OF 1ST BYTE FOR BLANK PAD 07468000 + SR R4,R3 GET # BLANKS REQUIRED FOR PAD 07470000 + BZ XXIOPUTC SKIP IF NO BLANK PAD 07472000 + SR R4,R12 DECREMENT TO L-1 FOR PAD 07474000 + STC R4,*+5 STORE L-1 INTO MOVE 07476000 + MVC 1($CHN,R1),AJOBLANK BLANK PAD AT END OF RECORD 07478000 +XXIOPUTC EQU * EXIT HERE FOR NORMAL RETURN 07480000 + SPACE 1 07492000 +* * * * * COMMON EXIT CODE FOR SORC,READ,PNCH,PRNT * 07494000 +* THIS SECTION MUST IMMEDIATELY FOLLOW XXIOPUT SECTION. * 07496000 +* XXIORETA SETS CONDITION CODE TO 1, SHOWING EITHER END-FILE * 07498000 +* ON INPUT DEVICE, OR RECORD OVERFLOW ON OUTPUT DEVICE. * 07500000 +* XXIORETB SETS CC = 0 TO SHOW NO SPECIAL CONDITION. * 07502000 +XXIORETB SR R0,R0 SET CC TO 0 07508000 +XXIORETC LM R11,R5,XXIOSAVT RELOAD CHANGED REGS 07510000 + B XIORETRN RETURN APPROPRIATELY 07512000 +XXIOVERP OI AJOMODE,AJOSRECX SHOW PAGES/RECORDS EXCEEDED 07512002 +XXIORETA OI *+1,1 SET CC TO 1 07512004 + B XXIORETC GO TO RELOAD AND RETURN 07512006 + AIF (&$DISKU EQ 0).XNODISK SKIP DISK UTILITY WHEN NODISK 07512010 + USING AVWXTABL,R7 NOTE MAIN TABLE USING 07512012 + USING XIOBLOCK,R14 07512014 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512015 +*--> ENTRY: XXXXDKOP INITIALIZES FOR DISK UTILITY RUN * 07512016 +* ALL XXXXDK ENTRIES BY RICHARD FORD, PAUL WEISSER. * 07512018 +* XXXXDKOP IS CALLED FROM UTINT1 IF THE DISK UTILITY OPTION * 07512020 +* IS ENABLED. IT PERFORMS A STANDARD FORM OPEN ON THE DISK * 07512022 +* UTILITY DCB, INITIALIZES ANY VARIABLES USED BY THE DISK * 07512024 +* UTILITY ROUTINES. XXXXDKOP ALSO COMPLETES THE DECB'S CREATED * 07512026 +* FOR BUFFER POOL MANAGEMENT BY FILLING IN THE RESPECTIVE * 07512028 +* BUFFER ADDRESS. IN BATCH MODE XXXXDKOP RESETS THE DISK DATA * 07512030 +* SET WITH A POINT MACRO INSTRUCTION. * 07512032 +* * 07512034 +* * 07512036 +* REGISTER ASSIGNMENTS * 07512038 +* R13-> SAVE AREA POINTER * 07512040 +* R14-> XIOBLOCK POINTER REGISTER * 07512042 +* R15-> TEMP. BASE REGISTER * 07512044 +* R0 -> HOLDS LOW END ROINTER TO BUFFER AREA * 07512046 +* R1 -> WORK REGISTER * 07512048 +* R3 -> HOLDS NUMBER OF BUFFERS FOR LOOP CONTROL * 07512050 +* R7 -> BASE REGISTER FOR AVWXTABL * 07512052 +* * 07512054 +* USES MACROS: POINT (OS), POINTS (DOS) * 07512056 +* USES DSECTS: AVWXTABL, XXIOBLOCK * 07512058 +* * 07512060 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512062 + USING XXXXDKOP,R15 NOTE TEMPORARY USING 07512064 +XXXXDKOP STM R11,R8,XXIOSAVT SAVE REGISTERS IN LOCAL AREA 07512066 + LM R11,R13,XXIOAJOB LOAD BASE REGISTERS AND CONSTANT 1 07512068 + USING XXIOSAVE,R13 NOTE MAIN USING 07512070 + DROP R15 KILL R15 07512072 + L R7,AJOVWXPT GET ADDRESS OF MAIN TABLE 07512074 + NI AJIODSK,255-AJIOEOF CLEAR EOF FLAG FOR BATCH RUN 07512075 + LA R8,4+XXDKOFFL GET OFFSET INTO BUFFER IN R8 07512076 + TM XXDKUDCB+XXDKOPEN,XXMASK IS DISK DCB/DTF OPEN 07512078 + BO XXOPNPT IF SO, GO ISSUE POINT MACRO 07512080 + AIF (NOT &$ASMLVL).XXDR01 SKIP IF DOS GENERATION 07512081 + XC XXDKBLKS(2),XXDKBLKS CLEAR BLKSIZE FOR JCL 07512082 +.XXDR01 LA R2,AJIODSK GET ADDRESS OF CONTROL BYTE 07512083 + AIF (&$ASMLVL).XXDR1 SKIP IF OS GENERATION 07512084 + LA R1,XXDKUDCB GET ADDR OF DTF FOR OPEN 07512085 + AGO .XXDR2 07512086 +.XXDR1 LA R3,XXIODSKU R3 <-- ADDR OF REMOTE CLOSE WORD 07512087 +.XXDR2 BAL R4,XXIOPENO OPEN DCB/DTF 07512088 + BM XXEXIT DID NOT OPEN---DISASTER 07512090 + OI AJIODSK,AJIOPEN SHOW DCB OPEN 07512092 +XXOPNPT L R0,AVADDHIH GET CURRENT HIGH CORE POINTER 07512094 + S R0,XXDKLN GET SPACE FOR FIRST BUFFER 07512096 + SR R0,R8 BUMP PAST LENGTH USED WORD 07512098 + AIF (&$BUFNO EQ 1).XXDKOPC SKIP IF ONLY ONE BUFFER 07512100 + LA R3,&$BUFNO-1 GET # OF BUFFERS - 1 FOR LOOP 07512102 +.XXDKOPC ANOP 07512104 + LA R1,XXDECB+4 GET ADDR OF 1ST DECB 07512106 + ST R1,AVDECB PUT ADDR OF DECB IN BCB 07512108 + LR R1,R0 DUPLICATE BUFFER ADDR 07512110 + AR R1,R8 BUMP PAST LENGTH USED WORD 07512112 + STM R0,R1,AVBUFF@ INITIALIZE AVBCB 07512114 + A R1,XXDKLN COMPUTE ENDING BUFFER @ 07512116 + ST R1,AVBUFEND PUT VALUE IN BCB 07512118 + AIF (&$BUFNO EQ 1).XXDKOPA SKIP IF ONLY ONE BUFFER 07512120 + L R1,XXDECB GET LINK IN R1 07512122 + ST R1,AVDECBNX PUT THIS IN BCB 07512124 +.XXDKOPA ANOP 07512126 + LA R1,XXDECB GET DECB BLOCK ADDRESS 07512128 + ST R0,XXDECBE(R1) STORE 1ST BUFF @ IN DECB 1 07512129 + AIF (&$BUFNO EQ 1 ).XXDKOPB SKIP IF ONLY 1 BUFFER 07512130 + A R8,XXDKLN GET FULL BUFF LENGTH IN R8 07512132 + SR R0,R8 GET NEXT BUFF @ 07512134 + L R1,0(R1) GET LINK TO NEXT DECB 07512136 + ST R0,XXDECBE(R1) STORE NEW BUFF @ AT NEW DECB 07512138 + BCT R3,*-10 LOOP FOR ALL DECBS 07512140 +.XXDKOPB ANOP 07512142 + ST R0,AVADDHIH STORE UPDATED LOW END POINTER 07512144 + XDKPT XXDKUDCB,XXXPOINT REPOSITION THE DISK 07512146 + SR R2,R2 CLEAR R2 TO INITIALIZE COUNT 07512148 + B XXXXDKRT RETURN TO CALLER 07512150 +XXEXIT XI AVTAGS1,AJODISKU CANCEL DISK OPTION 07512152 + OI *+1,1 SET CC TO MINUS TO FLAG UTINIT1 07512154 + B XXXDKRTB RETURN 07512156 + SPACE 2 07512158 +XXDKEOF EQU * EOF EXIT ( FUTURE USE ) 07512160 +XXDKSYND OI AJIODSK,AJIOEOF+AJIOSYND MARK END-FILE, ALSO SYNAD 07512164 + B XXXDKRTB RETURN 07512166 + SPACE 2 07512168 + AIF (NOT &$ASMLVL).XXEX1 SKIP IF OS GENERATION 07512169 +* XXDKUDCB DCB EXIT - USE BLKSIZE FROM JCL IF GIVEN, ELSE 07512170 +* USE DEFAULT &$BLEN. 07512172 +* THIS CODE ONLY USEFUL IN OS/360 SYSTEM. 07512174 + USING XXDKEXCD,R15 LOCAL USING 07512176 + USING IHADCB,R1 @ DCB, SUPPLIED BY OPEN 07512178 +XXDKEXCD LH R0,DCBBLKSI GET BLKSIZE FROM THE DCB 07512180 + SRA R0,2 DIVIDE BY 4, TEST FOR ZERO 07512182 + SLL R0,2 ALIGN TO FULLWORD MULTIPLE 07512184 + BNZ *+8 SKIP IF BLKSIZE FROM JCL 07512186 + LH R0,=AL2(&$BLEN) USE DEFAULT BUFFER LENGTH INSTEAD 07512188 + STH R0,DCBBLKSI STORE ACTUAL BLKSIZE TO BE USED 07512190 + SH R0,=H'4' WANT BLKSIZE-4 FOR LATER USE 07512192 + ST R0,XXDKLN SAVE IT WHERE EXPECTED 07512194 + BR R14 RETURN TO OPEN EXECUTOR 07512196 + DROP R1,R15 REMOVE DCB, LOCAL USINGS 07512198 +.XXEX1 ANOP 07512199 + TITLE 'DISK UTILITY READ' 07512200 + USING XXXXDKRD,REP NOTE TEMPORARY USING 07512202 + USING XIOBLOCK,R14 FORMAT FOR CONTROL BLOCK 07512204 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512205 +*-->ENTRY XXXXDKRD RETURN A SET OF RECORD BLOCKS TO UTGET2 * 07512206 +* XXXXDKRD IS CALLED BY UTGET2 WHEN IT HAS COMPLETED * 07512208 +* PROCESSING A SET OF RECORD BLOCKS. XXXXDKRD RETURNS THE * 07512210 +* ADDRESS OF THE NEXT BUFFER TO BE PROCESSD VIA THE BUFFER * 07512212 +* CONTROL BLOCK AND RE-FILLS THE BUFFER WHICH WAS JUST * 07512214 +* PROCESSED. WHEN ALL BLOCKS HAVE BEEN READ, XXXXDKRD CON- * 07512216 +* TINUES TO ACCEPT CALLS UNTIL ALL BUFFERS HAVE BEEN * 07512218 +* PROCESSED, AT WHICH TIME AN END-OF-FILE INDICATION * 07512220 +* (CC=1) IS RETURNED. * 07512222 +* * 07512224 +* REGISTER ASSIGNMENTS * 07512226 +* R13-> BASE REGISTER AND SAVE AREA POINTER * 07512228 +* R14-> XIOBLOCK POINTER REGISTER * 07512230 +* R15-> TEMP. BASE REGISTER * 07512232 +* R2 -> WORK REGISTER FOR COUNTER * 07512234 +* R3 -> DECB POINTER * 07512236 +* R4 -> BUFFER POINTER * 07512238 +* * 07512240 +* USES MACROS: READ, CHECK * 07512242 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512244 +XXXXDKRD STM R11,R8,XXIOSAVT SAVE REGISTERS IN LOCAL AREA 07512246 + LM R11,R13,XXIOAJOB LOAD BASE REGISTERS AND CONSTANT 1 07512248 + USING XXIOSAVE,R13 GLOBAL USING 07512250 + DROP REP DROP R15 07512252 + L R7,AJOVWXPT GET ADDRESS OF MAIN TABLE 07512254 + LM R3,R4,AVBCB GET BCB INFO 07512256 + TM AJIODSK,AJIOEOF TEST IF LAST BLOCK READ 07512258 + AIF (&$BUFNO NE 1).XXDKRDA SKIP IF MORE THAN 1 BUFFER 07512260 + BO XXCCSET BRANCH TO SET CONDITION CODE 07512262 +.XXDKRDA ANOP 07512264 + LH R2,XXBLKCNT SET R2 TO COUNTER VALUE 07512266 + BCT R2,XXDKNZ IF COUNT ^=0 TAKE BRANCH 07512268 + AIF (&$BUFNO EQ 1).XXDKRDB SKIP IF ONLY ONE BUFFER 07512270 + SPACE 2 07512272 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512274 +* * 07512276 +* LAST REAL READ HAS BEEN PERFORMED---RESET COUNTER TO * 07512278 +* EMPTY ALL BUFFERS; SET FLAG TO SHOW END-OF-FILE * 07512280 +* * 07512282 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512284 + BO XXCCSET IF LAST BLK PASSED, SET CC 07512286 +.XXDKRDB ANOP 07512288 + OI AJIODSK,AJIOEOF SET END-OF-FILE FLAG 07512290 + AIF (&$BUFNO EQ 1).XXDKRDC SKIP IF ONLY ONE BUFFER 07512292 + LA R2,&$BUFNO GET COUNT OF BUFFERS 07512294 + B XXDKREAD GO AND READ LAST BLOCK 07512296 + SPACE 2 07512298 +.XXDKRDC ANOP 07512300 +XXDKNZ EQU * 07512302 + AIF (&$BUFNO EQ 1).XXDKRDE SKIP IF ONLY ONE BUFFER 07512304 + BO XXDKNM IF END FLAG SET, SKIP READ 07512306 +.XXDKRDE ANOP 07512308 +XXDKREAD XDKCHK (R3),XXDKUDCB,DOS CHECK BEFORE GIVING OUT BLOCK 07512309 + XDKRD (R3),XXDKUDCB,(R4) READ A BLOCK 07512310 + AIF (&$BUFNO EQ 1).XXRDD SKIP IF ONLY 1 BUFFER 07512312 +XXDKNM BAL R14,XXFIXUP GO UPDATE POINTERS 07512314 +.XXRDD AIF (&$ASMLVL).XXRDD1 SKIP IF OS GEN 07512316 + TM AJIODSK,AJIOEOF IF EOF IS SET, 07512317 + BZ XXXXDKRT DO NOT CHECK LAST BLOCK 07512318 +.XXRDD1 XDKCHK (R3),XXDKUDCB CHECK BEFORE GIVING OUT BLOCK 07512319 + SR R0,R0 SET CC TO NOT NEGATIVE 07512320 + B XXXXDKRT RETURN TO CALLER 07512322 + SPACE 5 07512324 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512326 +* * 07512328 +* LAST BLOCK HAS ALREADY BEEN PASSED--- SET CC & RETURN * 07512330 +* * 07512332 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512334 +XXCCSET OI *+1,1 SET CC TO MINUS 07512336 + B XXXDKRTB RETURN TO CALLER 07512338 + TITLE 'END PASS1 INITIALIZE FOR PASS2' 07512340 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512341 +*--> ENTRY: XXXXDKE1 COMPLETE PASS1 PROCESSING, SET UP FOR PASS 2 * 07512342 +* XXXXDKE1 IS CALLED FROM UTEND1. XXXXDKE1 WRITES LAST BUFFER * 07512344 +* OR IF NO PREVIOUS WRITES WERE PERFORMED, PASSES UTGET2 THE * 07512346 +* INITIAL ADDRESS OF THE ONLY BUFFER USED. IF AT LEAST 1 * 07512348 +* WRITE TO DISK WAS DONE, XXXXDKE1 POINTS THE DISK TO START * 07512350 +* AND READS N-1 BUFFERS FROM THE DISK AND SETS UP FOR * 07512352 +* PASS 2 OF THE ASSIST ASSEMBLER. * 07512354 +* * 07512356 +* REGISTER ASSIGNMENTS * 07512358 +* R14-> XIOBLOCK POINTER REGISTER * 07512360 +* R15-> TEMP. BASE REGISTER * 07512362 +* R2 -> COUNTER WORK REGISTER * 07512364 +* R3 -> DECB POINTER * 07512366 +* R4 -> BUFFER POINTER * 07512368 +* R8 -> WORK REGISTER * 07512370 +* * 07512372 +* USES DSECTS: XXIOBLOCK, AVWXTABL * 07512374 +* USES MACROS: READ, WRITE, POINT, CHECK * 07512376 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512378 + USING XXXXDKE1,REP TEMPORARY USING 07512380 +XXXXDKE1 STM R11,R8,XXIOSAVT SAVE REGISTERS IN LOCAL AREA 07512382 + LM R11,R13,XXIOAJOB LOAD BASE REGISTERS AND CONSTANT 1 07512384 + USING XXIOSAVE,R13 NOTE GLOBAL USING 07512386 + DROP REP DROP TEMPORARY USING 07512388 + L R7,AJOVWXPT GET ADDRESS OF MAIN TABLE 07512390 + LH R2,XXBLKCNT GET # OF BLOCKS TO BE READ 07512392 + AIF (&$BUFNO EQ 1).XXDKEA SKIP IF JUST 1 BUFFER 07512394 + LTR R2,R2 IS IT 0? 07512396 + BNP XXONEBLK TAKE BRANCH TO ONE BLK WRITTEN 07512398 + L R6,AVDECBLT GET POINTER TO LAST DECB 07512400 + XDKCHK (R6),XXDKUDCB ISSUE CHECK 07512402 +.XXDKEA ANOP 07512404 +XXONEBLK LM R3,R5,AVBCB OBTAIN NEEDED VALUES 07512406 + SR R5,R4 GET BUFFER USED LENGTH 07512408 + ST R5,XXDKOFFL(,R4) STORE LENGTH IN BUFFER 07512410 + XDKWT (R3),XXDKUDCB,(R4) WRITE THE BLOCK 07512412 + XDKCHK (R3),XXDKUDCB CHECK COMPLETION OF LAST WRITE 07512414 + XDKPT XXDKUDCB,XXXPOINT POINT TO THE FIRST RECORD 07512416 + AIF (&$BUFNO NE 1).XXDK1 SKIP IF MORE THAN 1 BUFFER 07512418 + ST R4,AVBUFINC RESET LENGTH WORD 07512420 + AR R2,R12 INCREMENT COUNTER 07512422 + B XXXXDKRT GO RETURN 07512424 +.XXDK1 AIF (&$BUFNO EQ 1).XXDEC SKIP IF 1 BUFFER 07512426 + AR R2,R12 INCREMENT THE COUNTER 07512428 + LA R8,&$BUFNO-1 GET # OF BUFFERS LESS 1 07512430 + LR R6,R12 INITIALIZE TO GET ALL INFO 07512432 +XXEPRD1 XDKRD (R3),XXDKUDCB,(R4) READ FIRST BLOCK 07512434 + AR R6,R12 INCREMENT READ COUNTER 07512436 + SR R2,R12 DECREMENT BLOCK COUNTER 07512438 + BZ XXFEWER IF ZERO GO TO XXFEWER 07512440 + BAL R14,XXFIXUP ELSE MOVE POINTERS TO NEXT BLOCK 07512442 + BCT R8,XXEPRD1 LOOP TO CONTINUE READING 07512444 + B XXXXDKRT RETURN TO CALLER 07512446 +XXFEWER OI AJIODSK,AJIOEOF SET LAST-BLOCK-READ FLAG 07512448 + STH R6,XXBLKCNT STORE # OF FULL BUFFERS 07512450 + BAL R14,XXFIXUP BRANCH TO UPDATE POINTERS 07512452 + BCT R8,XXFIXUP LOOP TO POSITION DECB POINTERS 07512454 + B XXXDKRTB RETURN TO CALLER 07512456 +.XXDEC ANOP 07512458 + TITLE 'DISK UTILITY WRITE' 07512460 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512461 +*--> ENTRY: XXXXDKWT WRITE A FULL BUFFER TO DISK * 07512462 +* XXXXDKWT IS CALLED FROM UTPUT1 WHEN PASS1 HAS FILLED A * 07512464 +* BUFFER. XXXXDKWT WRITES THE BUFFER TO DISK AND UPDATES * 07512466 +* THE BUFFER MANAGEMENT TABLE WHICH RETURNS THE ADDRESS OF * 07512468 +* THE NEXT AVAILABLE BUFFER TO UTPUT1. * 07512470 +* * 07512472 +* REGISTER ASSIGNMENTS * 07512474 +* R13-> BASE REGISTER AND SAVE AREA POINTER * 07512476 +* R14-> XIOBLOCK POINTER REGISTER * 07512478 +* R15-> TEMP. BASE REGISTER * 07512480 +* R3 -> POINTER TO CURRENT DECB * 07512482 +* R4 -> BUFFER POINTER * 07512484 +* R5 -> BUFFER LENGTH USED ACCUMULATOR * 07512486 +* R6 -> POINTER TO OLD DECB * 07512488 +* * 07512490 +* USES DSECTS: AVWXTABL, XXIOBLOCK * 07512492 +* USES MACROS: WRITE, CHECK * 07512494 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512496 + USING XXXXDKWT,REP NOTE TEMP USING 07512498 +XXXXDKWT STM R11,R8,XXIOSAVT SAVE REGISTERS IN LOCAL AREA 07512500 + LM R11,R13,XXIOAJOB LOAD BASE REGISTERS AND CONSTANT 1 07512502 + USING XXIOSAVE,R13 NOTE GLOBAL USING 07512504 + DROP REP KILL TEMP USING 07512506 + L R7,AJOVWXPT GET ADDRESS OF MAIN TABLE 07512508 + LH R2,XXBLKCNT GET CURRENT COUNTER VALUE 07512510 + AIF (&$BUFNO EQ 1).XXWTA SKIP IF ONLY 1 BUFFER 07512512 + LTR R2,R2 IS THIS FIRST CALL TO THIS ENTRY 07512514 + BZ XXXX1ST IF IT IS, SKIP CHECK 07512516 + L R6,AVDECBLT GET POINTER TO LAST DECB 07512518 + XDKCHK (R6),XXDKUDCB ISSUE CHECK 07512520 +.XXWTA ANOP 07512522 +XXXX1ST LM R3,R5,AVBCB OBTAIN NEEDED VALUES 07512524 + SR R5,R4 SUBTRACT TO GET LENGTH OF INFO 07512526 + ST R5,XXDKOFFL(,R4) STORE LENGTH IN BUFFER 07512528 + XDKWT (R3),XXDKUDCB,(R4) WRITE THE RECORD(BLOCK) 07512530 + AIF (&$BUFNO NE 1).XXWTB SKIP IF > 1 BUFFER 07512532 + XDKCHK (R3),XXDKUDCB CHECK LAST WRITE 07512534 +.XXWTB ANOP 07512536 + AR R2,R12 INCREMENT COUNTER 07512538 + AIF (&$BUFNO EQ 1).XXWTC SKIP IF ONLY 1 BUFFER 07512540 + BAL R14,XXFIXUP GO TO FIXUP ROUTINE 07512542 +.XXWTC AIF (&$BUFNO NE 1).XXWTD SKIP IF BUFNO > 1 07512544 + LA R4,4(R4) INCREMENT POINTER PAST LENGTH WORD 07512546 + ST R4,AVBUFINC STORE AVBUFINC BACK INTO BCB 07512548 +.XXWTD ANOP 07512550 + SPACE 2 07512552 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512554 +* * 07512556 +* COMMON RETURN CODE FOR DISK ROUTINES * 07512558 +* * 07512560 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512562 +XXXXDKRT STH R2,XXBLKCNT STORE UPDATED COUNTER 07512564 +XXXDKRTB LM R11,R8,XXIOSAVT RESTORE REGISTERS 07512566 + B XIORETRN RETURN TO CALLER 07512568 + AIF (&$BUFNO EQ 1).XXFXA SKIP WHOLE SECTION IF 1 BUFFER 07512570 + TITLE 'DISK UTILITY BCB UPDATE ROUTINE' 07512572 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512573 +*--> INSUB: XXFIXUP UPDATE BCB POINTERS TO NEXT BUFFER * 07512574 +* * 07512576 +* XXFIXUP UPDATES THE POINTERS IN THE BCB, MOVING THE NEXT * 07512578 +* I/O OPERATION TO THE NEXT BUFFER. * 07512580 +* * 07512582 +* ENTRY CONDITIONS: R3-> ADDRESS OF CURRENT DECB. * 07512584 +* * 07512586 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512588 +XXFIXUP ST R3,AVDECBLT STORE ADDR FOR BACKWARD REFERENC 07512590 + L R3,AVDECBNX LINK TO NEXT DECB BLOCK 07512592 + MVC AVDECBNX(4),0(R3) MOVE LINK TO AVBCB 07512594 + LA R3,4(R3) GET DECB @ FOR NEXT BUFFER 07512596 + L R4,XXDECBIN(R3) GET BUFFER ADDRESS 07512598 + LA R5,4+XXDKOFFL(R4) BUMP PAST LENGTH USED WORD 07512600 + STM R3,R5,AVDECB FILL PART OF THE BCB 07512602 + A R5,XXDKLN GET BUFFER ENDING ADDRESS 07512604 + ST R5,AVBUFEND COMPLETE BCB BLOCK 07512606 + BR R14 RETURN TO CALLER 07512608 +.XXFXA ANOP 07512610 +XXDKLN DC A(&$BLEN-4) BUFFER LENGTH FOR HIGH END POINT 07512612 +XXXPOINT DC X'00000100' POINT CONTROL WORD 07512614 +XXBLKCNT DS H COUNTER HALF-WORD 07512616 +XXDECB XXDKDECB &$BUFNO DEFINE DECB TABLE 07512618 + DROP R7 DELETE AVWXTABL USING 07512620 +.XNODISK ANOP 07512622 + EJECT 07512624 + AIF (NOT (&$PUNCH OR &$DATARD OR (&$DISKU NE 0) OR &$MACSLB)#07512626 + ).XXNRP4 SKIP IF NO SPECIAL OPEN NEEDED 07512627 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512628 +*--> INSUB: XXIOPENO OPEN OPTIONAL DATA SET, FIX FLAGS * 07512629 +* XXIOPENO IS CALLED FROM ENTRIES XXXXREAD OR XXXXPNCH TO * 07512630 +* OPEN A DCB, FLAG ITS AJIO-- BYTE AJIODFLT IF OPEN FAILS, * 07512632 +* OR AJIOPEN IF IT GOES. IF OPEN OK, THE OPEN/CLOSE PARM WORD * 07512634 +* ADDED TO THE FRONT OF CURRENT LIST BEING BUILT FOR CLOSING. * 07512636 +* UNDER DOS GENERATIONS, NO OPEN/CLOSE PARM WORD IS PRESENT, * 07512638 +* SO JUST OPEN AND SET RETURN CODE. * 07512640 +* ENTRY CONDITIONS * 07512642 +* R1 = @ OF DCB (XXREDCB, XXPNDCB) UNDER DOS GENERATIONS ONLY * 07512644 +* R2 = @ AJIO-- CONTROL BYTE (AJIORE, AJIOPN) * 07512646 +* R3 = @ OPEN/CLOSE PARM WORD (XXIOCRE, XXIOCPN) * 07512648 +* R4 = RETURN @ TO CALLING SECTION OF CODE * 07512650 +* EXIT CONDITIONS * 07512652 +* R1 = @ OF DCB (XXREDCB, XXPNDCB) * 07512654 +* R2 = @ AJIO-- FLAG BYTE (SAME AS ON ENTRY) * 07512656 +* R0,R14 ARE PRESERVED FROM EFFECTS OF OPEN * 07512658 +* CC = 0 ==> OPEN WENT. AJIO-- FLAG FLAGGED WITH AJIOPEN. * 07512660 +* CC = 1 ==> OPEN FAILED. AJIO-- BYTE FLAGGED WITH AJIODFLT. * 07512662 +* XXIOCPTR=XXIOCPTR-4 IF OPEN OK, OPEN/CLOSE WORD MOVE ALSO. * 07512664 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07512666 + SPACE 1 07512668 + AIF (&$ASMLVL).XXNIHA SKIP IF UNDER OS GENERATION 07512670 +XXIOPENO OPEN (1) OPEN OPTIONAL DATA SET 07512672 + LM R14,R0,XXIOSAVT+12 RELOAD MESSED UP REGISTERS 07512674 + TM 15(R1),X'20' DID THE OPEN GO 07512676 + BZ XXIOPENQ YES, OPEN WENT 07512678 +.XXNIHA AIF (NOT &$ASMLVL).XXYIHA SKIP IF UNDER DOS GENERATION 07512680 +XXIOPENO LR R1,R3 MOVE PTR TO OPEN/CLOSE WORD OVER 07512682 + OPEN MF=(E,(1)) DO REMOTE OPEN 07512684 + LM R14,R0,XXIOSAVT+12 RELOAD MESSED-UP REGISTERS 07512686 + L R1,0(R3) GET @ DCB FROM OPEN/CLOSE PARM 07512688 + USING IHADCB,R1 NOTE DCB DSECT USING 07512690 + TM DCBOFLGS,X'10' DID THE OPEN GO? 07512692 + BO XXIOPENQ YES, OPEN WENT 07512694 + DROP R1 KILL USING 07512696 +.XXYIHA ANOP 07512698 + SPACE 1 07512700 + OI 0(R2),AJIODFLT OPEN FAILED, USE DEFAULT DATA SET 07512702 + BR R4 RETURN TO CALLER, CC=1 AT MOMENT 07512704 + SPACE 1 07512706 +* OPEN SUCCEEDED. MARK DATA SET OPEN. ADD ITS OPEN/CLOSE PARM * 07512708 +* WORD TO FRONT OF LIST SO IT WILL BE CLOSED LATER (OS ONLY). * 07512710 +XXIOPENQ OI 0(R2),AJIOPEN SHOW OPEN OK 07512712 + AIF (NOT &$ASMLVL).XXNPRMW NO DOS PARM WORD LIST 07512714 + L R15,XXIOCPTR GET CURRENT PTR TO OPEN/CLOSE LIST 07512716 + SH R15,=H'4' SUBTRACT TO GET NEXT POSITION 07512720 + ST R15,XXIOCPTR STORE UPDATED VALUE 07512740 + MVC 0(4,R15),0(R3) MOVE NEW OPEN/CLOSE PARM IN 07512760 + NI 0(R15),X'7F' REMOVE LEADING BIT, SINCE NOT LAST 07512780 +.XXNPRMW ANOP 07512790 + SR R15,R15 SET CC=0 TO SHOW SUCCESSFUL 07512800 + BR R4 RETURN TO CALLING CODE 07512820 + SPACE 1 07512830 +.XXNRP4 AIF (NOT &$ASMLVL).XXNPN2 NO LIST FORMS UNDER DOS 07512840 +XXIOCPTR DS A @ 1ST VALID OPEN/CLOSE PARM IN LIST 07512860 +* OPEN/CLOSE PARM VALUES. ORDER REQUIRED NEXT 2 CARDS. 07512880 + DS 2F FOR RE, PN OPEN/CLOSE PARMS 07512900 + AIF (&$DISKU LT 1).XXNDKOP 07512905 + DS F ROOM FOR DISK UTILITY PARM WORD 07512910 +.XXNDKOP AIF (NOT &$MACSLB).XXNMCLB SKIP WORD IF NOT NEEDED 07512915 + DS A SPACE FOR ANOTHER PTR WORD 07512916 +.XXNMCLB ANOP 07512917 +XXIOCSP OPEN (XXSODCB,INPUT,XXPRDCB,OUTPUT),MF=L SET UP VALUES 07512920 + SPACE 1 07512940 + AIF (NOT &$DATARD).XXNRE2 SKIP IF NO DATA RDR 07512950 +XXIOCRE OPEN (XXREDCB,INPUT),MF=L SET UP VALUE HERE 07512960 +.XXNRE2 AIF (NOT &$PUNCH).XXNPN2 SKIP IF NO REAL PUNCH 07512970 +XXIOCPN OPEN (XXPNDCB,OUTPUT),MF=L SET UP VALUE HERE 07512980 +.XXNPN2 ANOP 07512990 + AIF (&$DISKU EQ 0).XXNDOPN SKIP IF NO DISK OPTION 07512995 + AIF (NOT &$ASMLVL).XXNDOPN SKIP IF OS GENERATION 07512997 +XXIODSKU OPEN (XXDKUDCB,(OUTIN)),MF=L 07513000 +.XXNDOPN ANOP 07513005 + EJECT 07514000 + AIF (NOT &$MACSLB).XXNMCOP 07514005 +XXLIBCLS OPEN (XXLIBDCB,INPUT),MF=L LIST FORM FOR MACRO LIBRARY OPEN 07514010 + EJECT 07514015 + SPACE 10 07514020 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07514022 +*-> ENTRY: XXXXLBOP * 07514025 +* XXXXLBOP INITIALIZES FOR A MACRO LIBRARY RUN. XXXXLBOP* 07514030 +* IS CALLED BY MOCOMSYS IN MCON1. IT OPENS THE SYSTEM LIBRARY * 07514035 +* DCB IF NECESSARY, ALLOCATES BUFFER SPACE IN HIGH CORE, AND * 07514040 +* SETS SWITCH IN XXXXSORC SUCH THAT XXXXSORC PROVIDES INCARD * 07514045 +* THE ADDRESS OF A CARD IMAGE FROM THE SYSTEM LIBRARY BUFFER * 07514050 +* INSTEAD OF FROM THE NORMAL SYSIN DATA SET. ALSO SETS THE * 07514055 +* ADDRESS INTO THE GLOBAL TABLE NEEDED BY THE SUPPORTING * 07514060 +* ROUTINES. * 07514065 +* * 07514070 +* REGISTER ASSIGNMENTS: * 07514075 +* PSEUDO-STANDARD OS LINKAGE (SAVING ONLY NEEDED REG) * 07514080 +* R1=> BASE FOR IHADCB DSECT * 07514085 +* R4=> BASE FOR XLBDSECT DSECT * 07514090 +* R7=> AVWXTABL BASE REGISTER * 07514095 +* R13=> SAVE AREA POINTER AND MAIN BASE REGISTER * 07514100 +* R15=> TEMP BASE REGISTER * 07514105 +* * 07514110 +* USES MACROS: * 07514115 +* $ALLOCH * 07514120 +* * 07514125 +* USES DSECTS: * 07514130 +* AVWXTABL, XLBDSECT, IHADCB * 07514135 +* * 07514140 +* EXIT CONDITIONS: * 07514145 +* CC = 1 (MINUS) IF OPEN DID NOT GO * 07514150 +* AND ZERO (0) IF OPEN WENT * 07514155 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07514160 + SPACE 5 07514165 + USING AVWXTABL,R7 NOTE MAIN TABLE USING 07514170 + USING XXXXLBOP,R15 TEMP BASE REGISTER 07514175 +XXXXLBOP STM R11,R8,XXLBSAVT SAVE REGISTERS TO BE CHANGED 07514180 + LM R11,R13,XXIOAJOB LOAD NEEDED VALUES 07514185 + USING XXIOSAVE,R13 NOTE MAIN USING 07514190 + DROP R15 CLEAN UP USINGS 07514195 + L R7,AJOVWXPT GET MAIN TABLE ADDRESS 07514200 + MVC AVLIBBUF,AWZEROS ZERO THE GLOBAL WORD 07514205 + TM XXLIBDCB+48,X'10' IS THE LIBRARY DCB ALREADY OPEN 07514210 + BO XXLBALOP YES-- GO TO ALREADY OPEN 07514215 + LA R2,XXLBFLG R2 <-- ADDRESS OF CONTROL BYTE 07514220 + LA R3,XXLIBCLS R3 <-- DDDRESS OF REMOTE CLOSE WORD 07514225 + BAL R4,XXIOPENO GO DO OPEN 07514230 + BM XXLBOVR OPEN DID NOT GO -- HURT 07514235 + SPACE 2 07514240 +* OPEN WENT SO COMPLETE LIBRARY RUN SET UP 07514245 + SPACE 2 07514250 +XXLBALOP LA R1,XXLIBDCB GET ADDRESS OF LIBRARY DCB 07514255 + USING IHADCB,R1 SET USING FOR DCB DSECT 07514260 + LH R2,DCBBLKSI GET BLOCK SIZE FROM THE DCB 07514265 + SPACE 2 07514270 +* ROUND UP TO A D-WORD MULTIPLE TO BE SURE 07514275 + SPACE 2 07514280 + LA R2,7+XLBUFCNT(R2) ADD 7 PLUS LENGTH OF CONTROL AREA 07514285 + SRL R2,3 DIVIDE BY 8 07514290 + SLL R2,3 MULTIPLY BY 8 07514295 + SPACE 2 07514300 +* GET THE SPACE FOR THE BUFFER AND CONTROL WORDS IN HIGH CORE 07514305 + SPACE 2 07514310 + USING XLBDSECT,R4 NOTE LIBRARY DSECT 07514315 + $ALLOCH R4,R2,XXLBOVR GET THE SPACE IN HIGH CORE 07514320 + MVI XXLBFLG,X'FF' SET FLAG TO SHOW BUFFER ALLOCATED 07514325 + SPACE 2 07514330 +* INITIALIZE GLOBAL CONTROL WORD 07514335 + ST R4,AVLIBBUF STORE BUFFER AND CONTROL BLOCK 07514340 +* ADDRESS IN THE GLOBAL TABLE 07514345 + SPACE 2 07514350 +* INITIALIZE THE BUFFER CONTROL WORDS 07514355 + SPACE 2 07514360 + ST R2,XLBUFLNG STORE TOTAL LENGTH IN CONTROL WORD 1 07514365 + AR R2,R4 GET START PLUS LENGTH IN R2 07514370 + ST R2,XLBUFEND STORE IN CONTROL WORD 2 07514375 + SR R2,R4 REMOVE STARTING ADDRESS 07514380 + LA R2,XLBUFCNT(R4) GET REAL BUFFER START ADDRESS 07514385 + LR R3,R2 DUPLICATE FOR MUTIPLE STORE 07514390 + STM R2,R3,XLBUFSTR STORE IN CONTROL WORDS 2 & 3 07514395 + DROP R4,R1 CLEAN UP USINGS 07514400 + SPACE 2 07514405 +* SET XXXXSORC SWITCH TO ALWAYS BRANCH 07514410 + SPACE 2 07514415 + MVI XXSWTCH+1,X'F0' SET SWITCH TO BRANCH 07514420 + SPACE 2 07514425 + SR R0,R0 MAKE CC NOT MINUS 07514430 +XXLBOUTA LM R11,R8,XXLBSAVT RESTORE REGISTERS 07514435 + BR R14 RETURN TO CALLER 07514440 + SPACE 2 07514445 +* STORAGE OVERFLOW EXIT 07514450 + SPACE 2 07514455 +XXLBOVR OI *+1,1 SET CC TO MINUS 07514460 + B XXLBOUTA RETURN 07514465 + DROP R7,R13 CLEAN UP USINGS 07514470 + SPACE 5 07514475 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07514477 +*-> ENTRY: XXXXFIND * 07514480 +* XXXXFIND DOES A D-TYPE FIND ON EACH MACRO THAT IS * 07514485 +* REQUIRED BY THE USER PROGRAM AS DEFINED ON THE SYSLIB CARD. * 07514490 +* CALLED FROM MOCOMSYS IN THE MCON1 CSECT. * 07514495 +* * 07514500 +* REGISTER ASSIGNMENTS: * 07514505 +* R12 => AVWXTABL BASE REGISTER * 07514510 +* R13 => SAVE AREA POINTER AND MAIN BASE REGISTER * 07514515 +* R14 => DCB ADDRESS * 07514520 +* * 07514525 +* ENTRY CONDITIONS: * 07514530 +* MEMBER NAME IS IN AVMSYMBL * 07514535 +* * 07514540 +* EXIT CONDITIONS: * 07514545 +* CC SET TO ZERO IF ALL WENT WELL * 07514550 +* CC SET TO MINUS IF NAME COULD NOT BE FOUND * 07514555 +* * 07514560 +* USES MACROS: * 07514565 +* FIND * 07514570 +* * 07514575 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07514580 + SPACE 5 07514585 + USING AVWXTABL,R12 NOTE MAIN TABLE USING 07514590 + USING XXXXFIND,R15 07514595 +XXXXFIND STM R11,R1,XXLBSAVT SAVE REGISTERS THAT MIGHT CHANGE 07514600 + L R13,XXIOAJOB+8 GET BASE REGISTER SET UP 07514605 + USING XXIOSAVE,R13 NOTE MAIN USING 07514610 + DROP R15 CLEAN UP USING SITUATION 07514615 + SPACE 2 07514620 + MVC XXFNDDW,AVMSYMBL PUT NAME ON A D-WORD BOUNDRY 07514625 + SPACE 2 07514630 + FIND XXLIBDCB,XXFNDDW,D DO THE FIND 07514635 + LTR R15,R15 TEST RETURN CODE FROM FIND ROUTINE 07514640 + BNZ XXFNDERR COULDNOT FIND NAME--SET UP BAD RTN 07514645 + SPACE 2 07514650 + SR R0,R0 MAKE CC NOT MINUS 07514655 +XXXXFDOT LM R11,R1,XXLBSAVT RESTORE REGISTERS 07514660 + BR R14 RETURN TO CALLER 07514665 + SPACE 2 07514670 +XXFNDDW DS D D-WORD ALIGNED PLACE FOR MEMBER NAME 07514675 +XXFNDERR OI *+1,1 SET CC TO MINUS FOR RETURN 07514680 + B XXXXFDOT RETURN 07514685 + DROP R12,R13 CLEAN UP USINGS 07514690 + SPACE 5 07514695 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07514697 +*-> ENTRY: XXXXLBRD * 07514700 +* * 07514705 +* CALLED BY INCARD VIA XXXXSORC TO PROVIDE THE MACRO * 07514710 +* PROCESSOR WITH DEBLOCKED RECORDS FROM THE SYSTEM MACRO * 07514715 +* LIBRARIES. FUNCTIONS AS AN INSUB TO ENTRY XXXXSORC. * 07514720 +* * 07514725 +* REGISTER ASSIGNMENTS: * 07514730 +* SAME AS XXXXSORC: EXCEPT R12 IS BASE FOR AVWXTABL * 07514735 +* * 07514740 +* ENTRY CONDITIONS: * 07514745 +* SAME AS XXXXSORC * 07514750 +* ADDITIONALLY -- INCARDS DATA AREA COMES OVER IN * 07514755 +* REGISTER R0 AND MUST BE PROTECTED FROM SYSTEM ACTIONS * 07514760 +* * 07514765 +* USES DSECTS: * 07514770 +* XLBDSECT, IHADCB * 07514775 +* * 07514780 +* USES MACROS: * 07514785 +* READ, CHECK * 07514790 +* * 07514795 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07514800 + SPACE 5 07514805 + USING XXIOSAVE,R13 NOTE MAIN USING 07514810 + USING IHADCB,XXXLBDCB 07514815 +XXXXLBRD STM R6,R7,XXLBSAVT SAVE SOME WORK REGISTERS 07514820 + L R12,AJOVWXPT GET AVWXTABL BASE ADDRESS 07514825 + USING AVWXTABL,R12 NOTE MAIN TABLE USING 07514830 + L R3,AVLIBBUF GET ADDRESS OF BUFFER SPACE 07514835 + USING XLBDSECT,R3 NOTE LIBRARY DSECT USING 07514840 + LR R4,R0 MOVE DATA AREA ADDRESS OVER 07514845 + SPACE 2 07514850 +XXXLBDCB EQU R5 HOLDS THE LIBRARY DCB ADDRESS 07514855 +XXRECPT EQU R6 HOLDS ADDRESS OF CARD IMAGE 07514860 +XXBUFEND EQU R7 POINTER TO THE END OF THE BUFFER 07514865 + SPACE 2 07514870 + LM XXRECPT,XXBUFEND,XLBUFSTR GET CONTROL INFORMATION 07514875 + CR XXRECPT,XXBUFEND IS BUFFER EMPTY 07514880 + BNL XXXLIBRD YES--GO READ A NEW BUFFER FULL 07514885 + SPACE 2 07514890 +XXLBRCPT MVC 0(80,R4),0(XXRECPT) MOVE CARD WHERE INCARD EXPECTS 07514895 + LA XXRECPT,80(XXRECPT) INCREMENT TO NEW RECORD 07514900 + SPACE 2 07514905 +* SET UP FOR RETURN 07514910 + SPACE 2 07514915 + ST XXRECPT,XLBUFSTR SAVE UPDATED RECORD POINTER 07514920 +XXLBRDRT LM R6,R7,XXLBSAVT RESTORE REGISTERS 07514925 + B XXIORETB RETURN TO CALLER (INCARD) 07514930 +XXXLIBRD LA XXXLBDCB,XXLIBDCB GET DCB ADDRESS IN A REG 07514935 + LA XXRECPT,XLIBBUF GET AREA ADDRESS INTO XXRECPT REG 07514940 + READ XXLBDECB,SF,(XXXLBDCB),(XXRECPT),'S' READ A BLOCK 07514945 + CHECK XXLBDECB CHECK FOR I/O COMPLETION 07514950 + SPACE 2 07514955 + LH XXBUFEND,DCBBLKSI GET BLOCKSIZE FROM DCB 07514960 + L R2,XXLBDECB+16 GET IOB ADDRESS 07514965 + SH XXBUFEND,14(R2) GET RELATIVE END OF NEW BLOCK 07514970 + LA XXBUFEND,XLBUFCNT(R3,XXBUFEND) GET ABSOULUTE END OF NEW 07514975 +* BLOCK 07514980 + ST XXBUFEND,XLBUFCED SET CONTROL WORD 4, CURRENT END 07514985 + B XXLBRCPT GO TO DEBLOCK 07514990 +XXMCEODD MVC 0(80,R4),AWBLANK BLANK OUT AREA FOR CARD 07514995 + MVC 10(4,R4),=C'MEND' PUT MEND CARD IMAGE THERE 07515000 + B XXLBRDRT RETURN VIA XXXXSORC, INCARD 07515005 + SPACE 5 07515010 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07515013 + DROP R3,R5,R12,R13 CLEAN UP USINGS 07515015 +*-> ENTRY: XXXXLBED * 07515020 +* * 07515025 +* CALLED 1 TIME BY THE MAIN PROGRAM MCON1 TO INSURE * 07515030 +* THAT THE XXXXSORC SWITCH BRANCH IS SET FOR NORMAL PROCESSING.* 07515035 +* ALSO CALLED BY MOCOMSYS IN MCON1 TO DEALLOCATE THE BUFFER * 07515040 +* AND CONTROL WORD SPACE AND TO RESET THE XXXXSORC SWITCH * 07515045 +* BRANCH TO THE NORMAL CONDITION. * 07515050 +* * 07515055 +* REGISTER ASSIGNMENTS: * 07515060 +* R2=> AVWXTABL BASE REGISTER * 07515065 +* R13 => SAVE AREA POINTER AND MAIN BASE REGISTER * 07515070 +* R15 => TEMP BASE REGISTER * 07515075 +* * 07515080 +* USES DSECTS: * 07515085 +* XLBDSECT * 07515090 +* * 07515095 +* USES MACROS: * 07515100 +* $DALLOCH * 07515105 +* * 07515110 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07515115 + SPACE 5 07515120 + USING AVWXTABL,R2 NOTE TABLE USING 07515125 + USING XXXXLBED,R15 TEMP USING 07515130 +XXXXLBED STM R11,R2,XXLBSAVT SAVE SOME WORK REGISTERS 07515135 + LM R11,R13,XXIOAJOB GET NEEDED VALUES 07515140 + L R2,AJOVWXPT GET BASE VALUE FOR MAIN TABLE 07515145 + USING XXIOSAVE,R13 NOTE MAIN USING 07515150 + DROP R15 CLEAN UP USING SITUATION 07515155 + TM XXLBFLG,X'FF' IS THERE A BUFFER AROUND? 07515160 + BZ XXEDSET NO -- DO NOT DE-ALLOCATE THE BUFFER 07515165 + SPACE 2 07515170 +* DEALLOCATE BUFFER SPACE IN HIGH FREEAREA 07515175 + SPACE 2 07515180 + L R15,AVLIBBUF GET ADDRESS OF BUFFER AREA 07515185 + USING XLBDSECT,R15 NOTE LIBRARY DSECT USING 07515190 + L R15,XLBUFLNG GET TOTAL LENGTH OF SPACE TO BE 07515195 +* FREED 07515200 + $DALLOCH R1,(R15) DEALLOCATE THE AREA 07515205 + DROP R15 CLEAN UP USING SITUATION 07515210 + SPACE 2 07515215 +* SET XXXXSORC SWITCH BRANCH TO NORMAL NON-BRANCH 07515220 + SPACE 2 07515225 +XXEDSET MVI XXLBFLG,X'00' MARK BUFFER AS GONE 07515230 + MVI XXSWTCH+1,X'00' SET TO NEVER BRANCH IN XXXXSORC 07515235 + LM R11,R2,XXLBSAVT RESTORE REGISTERS 07515240 + BR R14 RETURN TO CALLER 07515245 + DROP R2 CLEAN UP USING SITUATION 07515250 + SPACE 2 07515255 +XXLBSAVT DS 14F SPACE FOR TEMP STORAGE OF REGISTERS 07515260 +XXLBFLG DS B DUMMY FLAG BYTE FOR REMOTE OPEN 07515265 + SPACE 5 07515270 +.XXNMCOP ANOP 07515275 +XXIOAJOB DS A SPACE FOR @ AJOBCON BLOCK 07516000 + DC A(1,XXIOSAVE) FOR REGS R12-R13-FOLLOW XXIOAJOB 07518000 +XXIOSAVT DS 14F SAVE AREA FOR I/O ROUTINES 07520000 + AIF (NOT &$PAGE).XXNPAG8 SKIP IF NO PAGE CONTROL 07520020 +* LEGAL CARRIAGE CONTROL CHARACTERS. ITEMS ARE THE 07520040 +* CHARACTER, AN OFFSET TO ITS REPLACEMENT CHARCATER 07520060 +* WORD IF IN MODE SINGL, AND DECREMENT FOR LINE COUNTER. 07520080 +XXIOPGTA DS 0H ORIGIN OF TABLE, ALIGN 07520100 +XXIOPB EQU *-XXIOPGTA OFFSET FROM TABLE TO BLANK'S BLOCK 07520120 +XXIOPGTB DC C' ',AL1(XXIOPB),H'1' SINGLE SPACE, SINGLE SPACE 07520140 +XXIOPD EQU *-XXIOPGTA OFFSET TO DOUBLE SPACE 07520160 + DC C'0',AL1(XXIOPB),H'2' DOUBLE SPACE,SINGLE SPACE 07520180 + DC C'1',AL1(XXIOPD),H'32000' NEW PAGE, DOUBLESPACE 07520200 + DC C'-',AL1(XXIOPB),H'3' TRIPLE SPACE,SINGLE SPACE 07520220 + DC C'+',AL1(*-1-XXIOPGTA),H'0' NO SPACE, NOSPACE 07520240 +XXIOPGTZ EQU *-4 @ LAST ELEMENT IN TABLE 07520260 +.XXNPAG8 ANOP 07520280 + LTORG 07520500 + SPACE 1 07522000 +* DCB'S FOR THE SOURCE AND DATA CARD READERS. 07524000 + AIF (NOT &$ASMLVL).XXNPN4 SKIP IF UNDER DOS GENERATION 07525000 +XXSODCB DCB DDNAME=&$IOUNIT(1),DSORG=PS,MACRF=GL,EODAD=XXIOEOF 07526000 + AIF (NOT &$DATARD).XXNRE4 SKIP IF NO DATA RDR 07527900 +XXREDCB DCB DDNAME=&$IOUNIT(2),DSORG=PS,MACRF=GL,EODAD=XXIOEOF 07528000 +.XXNRE4 ANOP 07528200 + SPACE 1 07530000 +* DCB'S FOR THE LINE PRINTER AND CARD PUNCH. 07532000 +XXPRDCB DCB DDNAME=&$IOUNIT(3),DSORG=PS,MACRF=PL, #07534000 + RECFM=FA,LRECL=133,BLKSIZE=133,BUFNO=1 07535000 + AIF (NOT &$PUNCH).XXNPN4 SKIP IF NO REAL PUNCH EXISTS 07535500 +XXPNDCB DCB DDNAME=&$IOUNIT(4),DSORG=PS,MACRF=PL, #07536000 + RECFM=F,LRECL=80,BLKSIZE=80,BUFNO=1 07537000 +.XXNPN4 ANOP 07537500 + AIF (&$ASMLVL).XXNPN8 SKIP IF UNDER OS GENERATION 07537520 +XXSODCB DTFCD DEVADDR=&$IOUNIT(1),EOFADDR=XXIOEOF,IOREG=(5), X07537540 + IOAREA1=XXIOLOCP,IOAREA2=XXIOLOCS,TYPEFLE=INPUT 07537560 +XXIOLOCP DC 80C' ' DOS IOAREA1 07537580 +XXIOLOCS DC 80C' ' DOS IOAREA2 07537600 + AIF (NOT &$DATARD).XXNRE8 SKIP IF NO DATA CARD READER 07537620 +XXREDCB DTFCD DEVADDR=&$IOUNIT(2),EOFADDR=XXIOEOF,IOREG=(5), X07537640 + IOAREA1=XXIOLOCP,IOAREA2=XXIOLOCS,TYPEFLE=INPUT 07537660 +.XXNRE8 ANOP 07537680 + SPACE 1 07537700 +* DCB'S FOR THE LINE PRINTER AND CARD PUNCH * 07537720 +XXPRDCB DTFPR DEVADDR=&$IOUNIT(3),BLKSIZE=133,IOREG=(5),CTLCHR=ASA, X07537740 + IOAREA1=XXIOFILP,IOAREA2=XXIOFILS 07537760 +XXIOFILP DC 133C' ' PRINTER IOAREA1 07537780 +XXIOFILS DC 133C' ' PRINTER IOAREA2 07537800 + AIF (NOT &$PUNCH).XXNPN8 SKIP IF NO REAL CARD PUNCH 07537820 +XXPNDCB DTFCD DEVADDR=&$IOUNIT(4),CRDERR=RETRY,IOREG=(5),CTLCHR=ASA, X07537840 + IOAREA1=XXIOPNCP,IOAREA2=XXIOPNCS,TYPEFLE=OUTPUT 07537860 +XXIOPNCP DC 80C' ' PUNCH IOAREA1 07537880 +XXIOPNCS DC 80C' ' PUNCH IOAREA2 07537900 +.XXNPN8 ANOP 07537920 + AIF (&$DISKU EQ 0).XXNDDCB SKIP IF NO DISK OPTION 07537925 + AIF (&$ASMLVL).XXDDCB1 SKIP IF OS GENERATION 07537926 +XXDKUDC DTFSD DEVADDR=&$IOUNIT(5),EOFADDR=XXDKEOF,TYPEFLE=WORK, X07537927 + BLKSIZE=3520,NOTEPNT=YES,DEVICE=&$DSKUDV 07537928 +XXDKUDCB EQU XXDKUDC ATTACH 7-CHAR DTFSD LABEL TO EXPECTD 07537929 + AGO .XXNDDCB 07537930 +.XXDDCB1 ANOP 07537931 +XXDKUDCB DCB DDNAME=&$IOUNIT(5),EODAD=XXDKEOF,RECFM=FB,EXLST=XXDKEXLS,#07537935 + SYNAD=XXDKSYND,DSORG=PS,NCP=&$BUFNO,MACRF=(RP,W) 07537940 +XXDKBLKS EQU XXDKUDCB+X'3E' BLKSIZE FIELD (DCBBLKSI) ADDRESS 07537945 +XXDKEXLS DC 0F'0',X'85',AL3(XXDKEXCD) DCB EXIT, FILL IN BLKSIZE 07537950 +.XXNDDCB ANOP 07537955 + EJECT 07537960 + AIF (NOT &$MACSLB).XXNMDCB 07537965 +* DCB FOR THE MACRO LIBRARY FETCH OPTION 07537970 +XXLIBDCB DCB DSORG=PO,DDNAME=&$IOUNIT(6),MACRF=R,EODAD=XXMCEODD 07537975 +.XXNMDCB ANOP 07537980 + SPACE 1 07538000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07539000 +*--> DSECT: XIOBLOCK CONTROL BLOCK FOR INPUT/OUTPUT MACROS * 07540000 +* THIS BLOCK IS CREATED FOR ANY I/O MACRO BY THE INNER MACRO * 07540100 +* XIONR, AND CONTAINS THE ADCON FOR THE DESIRED I/O ENTRYPOINT,* 07540200 +* SAVE WORDS FOR MODFIED REGS R14,R15,R0, AND THE LENGTH FOR * 07540300 +* THE I/O AREA TO BE READ OR WRITTEN. * 07540400 +* THIS DSECT IS ONLY USED IN CSECT XXXXIOCO. * 07540500 +* GENERATION: BY MACRO XIONR (FOR $READ,$SORC,$PRNT,$PNCH). * 07540600 +* NAMES: XIO----- * 07540700 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07540800 + SPACE 1 07540900 +XIOBLOCK DSECT 07542000 + DS V . @ I/O ROUTINE 07544000 + DS 3F AREA FOR REGS 15-0 TO BE SAVED 07546000 +XIOLENG DS AL2 . LENGTH OF RECORD, (CODES-FUTURE USE) 07548000 +XIORETRN LM 14,0,4(14) RETURN CODE FOR RESTORING REGISTERS 07550000 + AIF (NOT &$ASMLVL).XXNDCBD NO IHADCB UNDER DOS 07551000 + SPACE 1 07552000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07552050 +*--> DSECT: IHADCB DATA CONTROL BLOCK DSECT * 07552100 +* DCB DSECT USED BY PARTS OF XXXXIOCO. * 07552200 +* GENERATION: DCBD MACRO * 07552300 +* LOCATION: XXSODCB,XXREDCB,XXPNDCB,XXPRDCB * 07552400 +* NAMES: DCB----- * 07552500 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07552600 + SPACE 1 07552700 + DCBD DSORG=QS 07554000 +.XXNDCBD ANOP 07555000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07555025 +*-> LIBRARY DSECT -- XLBDSECT * 07555050 +* * 07555100 +* DESCRIBES LIBRARY BUFFER SPACE AND CONTROL WORDS * 07555150 +* * 07555200 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07555250 + SPACE 1 07555300 +XLBDSECT DSECT 07555350 +XLBUFLNG DS F CONTROL WORD 1 => TOTAL LENGTH 07555400 +XLBUFEND DS F CONTROL WORD 2 => PERMENENT BUFFER 07555450 +* END 07555500 +XLBUFSTR DS F CONTROL WORD 3 => START OF BUFFER 07555550 +XLBUFCED DS F CONTROL WORD 4 => END OF BLOCK 07555600 +XLBUFCNT EQU *-XLBUFLNG LENGTH OF CONTROL SECTION OF BUFFER 07555650 +XLIBBUF DS F ACTUAL BUFFER STARTS HERE 07555700 + SPACE 5 07555750 + DROP R11,R13,R14 AJOBCON,BASE REG, XIOBLOCK 07556000 + TITLE '*** XXSNAPC DSECT - XSNAP CONTROL BLOCK ***' 07556100 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07556150 +*--> DSECT: XXSNAPC CONTROL BLOCK USED BY THE XSNAP MACRO * 07556200 +* THIS BLOCK IS CREATED BY EVERY PRINTING XSNAP MACRO. IT * 07556300 +* CONTAINS THE EXACT CONTENTS OF THE GP REGISTERS BEFORE THE * 07556400 +* XSNAP WAS CALLED, A FLAG BYTE INDICATING DESIRED OUTPUT AND * 07556500 +* SPECIAL OPTIONS, THE NUMBER OF ADDRESS PAIRS USED IN THE * 07556600 +* XSNAP STORAGE= OPERAND, THE ADDRESS PAIRS THEMSELVES, AND * 07556700 +* THE ADDRESS CONSTANT FOR XXXXSNAP. THE BYTE XXSFLAGS MAY * 07556800 +* HAVE SEVERAL BITS TURNED ON REQUESTING SPECIAL ASSIST * 07556900 +* SERVICES, SUCH AS USER DEBUGGING OUTPUT AND USER DUMP. THE * 07557000 +* BITS ARE SUPPLIED BY XSNAP OPERAND T(3), AND HAVE * 07557100 +* MEANING ONLY WHEN USED INSIDE ASSIST WITH THE SPECIAL ASSIST * 07557200 +* VERSION OF THE CSECT XXXXSNAP. * 07557300 +* GENERATION: XSNAP MACRO, WITH T= ANY TYPE BUT ST OR STORE. * 07557400 +* NAMES: XXS----- * 07557500 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07557600 + SPACE 1 07558000 +XXSNAPC DSECT 07560000 +XXSGPRG EQU B'00000001' (XXSFLAGS)=> PRINT GP REGS 07562000 +XXSFLRG EQU B'00000010' (XXSFLAGS)=> PRINT FL REGS 07564000 +XXSAVTR EQU B'00000100' (XXSFLAGS)=> SAVE AREA TRACE(FUTURE) 07566000 +XXSASNAP EQU B'00010000' (XXSFLAGS)=> ASSIST EXECUTE SNAP 07568000 +XXSASDMP EQU B'00100000' (XXSFLAGS)=> ASSIST FINAL DUMP 07570000 + SPACE 1 07571000 +XXSRGSAV DS 16F REGISTER AREA, REGS SAVED BY XSNAP 07572000 +XXSFLAGS DS B OPTION BYTE FLAG 07574000 + DS AL1 **** UNUSED AS OF VERSION 4.0*** 07576000 +XXSLABLN DS AL1 LENGTH OF THE LABEL FIELD 07578000 +XXSNMSTR DS AL1 NUMBER OF @ PAIRS IN STORAGE= LIST 07580000 + DS V(XXXXSNAP) ADCON FOR CALL TO XXXXSNAP ROUTINE 07582000 +XXSADSTR DS 0A STORAGE = ADDRESS LIST(OPTIONAL) 07584000 + TITLE '*** XXXXSNAP-DEBUGGIN,DUMPING MODULE- V.4.0.AS ***' 07586000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07588000 +* JOHN R. MASHEY - MAY 1969 * 07590000 +* VERSION 4.0 - FEBRUARY 1970 * 07592000 +* VERSION 4.0.AS(SIST) FEB 1970 * 07593000 +* IBM 360/67 ASSEMBLER 'G' * 07594000 +* PENNSYLVANIA STATE UNIVERSITY * 07596000 +* ABSOLUTE REGISTER EQUATES AND USAGE * 07598000 +* EQU'S HAVE BEEN CHANGED TO COMMENTS TO PREVENT MULTIPLE* 07600000 +* DEFINITION WHEN ASSEMBLING AS PART OF ASSIST. * 07602000 +*R0 EQU 0 WORK REGISTER * 07604000 +*R1 EQU 1 USED AS WORK REGISTER * 07606000 +*R2 EQU 2 USED TO HOLD 1ST ADDRESS OF PAIR * 07608000 +*R3 EQU 3 USED TO HOLD SECOND ADDRESS OF PAIR* 07610000 +*R4 EQU 4 USED AS INCREMENT FOR BXLE'S * 07612000 +*R5 EQU 5 LIMIT ADDRESS IN VARIOUS BXLE'S * 07614000 +*R6 EQU 6 WILL CONTAIN CVTMZ00(HIGHEST ADDR) * 07616000 +*R7 EQU 7 OLD ADDRESS IN SAME LINE CHECK * 07618000 +*R8 EQU 8 INTERNAL LINKAGE REGISTER * 07620000 +*R9 EQU 9 ADDRESS OF CURRENT ADDRESS PAIR * 07622000 +*R10 EQU 10 POINTS TO XSNAP LABEL,REGISTER AREA* 07624000 +*R11 EQU 11 @ ECONTROL BLOCK, RELOCATION VALUE * 07626000 +* THIS VALUE IN R11 ONLY IF XXSFLAGS HAS XXASNAP OR XXASDMP ON.* 07626500 +*R12 EQU 12 # STORAGE= ADDRESS PAIRS TO DO * 07628000 +*R13 EQU 13 BASE REGISTER/@ DUMMY SAVE AREA * 07630000 +*R14 EQU 14 RETURN ADDR,POINTER TO LABEL LENGTH* 07632000 +*R15 EQU 15 ENTRY POINT REGISTER * 07634000 +* EQUREGS L=F,DO=(0,6,2) SET UP FLOATING EQU'S * 07636000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07638000 + SPACE 1 07640000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07642000 +* XSNAP CONTROL BLOCK AND POINTERS ON ENTRY TO XXXXSNAP. * 07644000 +* FIELD LENGTH(BYTES) DESCRIPTION/PURPOSE * 07646000 +* LABEL LABLN LABEL=, PADDED TO FULLWORD WITH ' '* 07648000 +* R10===>RGSAV 64 16 FULLWORDS, WHERE REGS WERE SAVED* 07650000 +* FLAGS 1 BYTE FOR OPTION BITS * 07652000 +* BIT 2 = 1 ==> ASSIST COMPLETION FINAL DUMP * 07652500 +* BIT 3 = 1 ==> XSNAP USER DEBUGGING DUMP(XDUMP) * 07653000 +* BIT 6 = 1 ==> PRINT FP REGISTERS. IF =0, DO NOT * 07654000 +* BIT 7 = 1 ==> PRINT GP REGISTERS. IF =0, DO NOT * 07656000 +* UNUSED 1 FOR FUTURE USE, NOT USED IN V.4.0 * 07658000 +* LABLN 1 LENGTH OF THE LABEL FIELD * 07660000 +* NMSTR 1 # 8-BYTE @ PAIRS IN STORAGE= LIST * 07662000 +* ADCON 4 V(XXXXSNAP) FOR CALL * 07664000 +* ADSTR NMSTR*8 STORAGE= @ LIST, IF PRESENT * 07666000 +* INSTRUCTS 10 3 INSTRUCTIONS - LA, L, BALR * 07668000 +* R14===>LM 0,15,0(10) RETURN POINT, RELOADS REGISTERS * 07670000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07672000 + EJECT 07674000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07674025 +*--> CSECT: XXXXSNAP DEBUGGING OUTPUT, COMPLETION DUMP * 07674050 +* THIS MODULE PROVIDES ALL REGISTER AND STORAGE DUMPING FOR * 07674100 +* DEBUGGING PURPOSES, BOTH FOR INTERNAL ASSIST DEBUGGING, AND * 07674150 +* FOR USER PROGRAMS DURING EXECUTION. IT IS CALLED BY THE * 07674200 +* MACRO XSNAP (XDUMP PSEUDO-INSTRUCTION FOR USER PROGRAMS), * 07674250 +* AND PRODUCES A USER DUMP OR DEBUGGING OUPUT IF THE CALLING * 07674300 +* XSNAP SPECIFIED A BINARY VALUE FOR OPERAND T(3). * 07674350 +* ENTRY CONDITIONS * 07674400 +* SEE XSNAP CONTROL BLOCK AND POINTERS ON ENTRY TO XSNAP COMMENTS. * 07674450 +* ALSO, IF SPECIAL ASSIST OUTPUT IS DESIRED I.E. T(3) IS USED, THE * 07674500 +* WORD IN XXSRGSAV WHERE REGISTER R10 WAS SAVED MUST CONTAIN THE * 07674550 +* ADDRESS OF THE ECONTROL DUMMY SECTION, WHICH SUPPLIES VALUES * 07674600 +* EXIT CONDITIONS * 07674650 +* ALL REGISTERS AND CONDITION CODE ARE RESTORED TO ORIGINAL VALUES * 07674700 +* AFTER EXECUTION OF THE INSTRUCTION AT THE RETURN POINT. * 07674750 +* USES DSECTS: ECONTROL,XXSNAPC * 07674800 +* USES MACROS: $PRNT(IF &$DEBUG=1), OPEN,PUT(IF&$DEBUG=0) * 07674850 +* NAMES: XX------ , ALL NAMES ADDED FOR ASSIST: XXAS---- * 07674900 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07674950 + SPACE 1 07675000 +XXXXSNAP CSECT 07676000 + USING XXXXSNAP,R15 NOTE TEMPORARY ENTRY USING 07678000 + USING XXSNAPC,R10 NOTE POINTER TO BLOCK 07680000 + CNOP 0,4 MAKE SURE ALIGNED ON FULLWORD 07684000 + BAL R13,*+76 SET UP BASE AND SAVE AREA @ 07686000 + USING *,R13 NOTE USING FOR BASE/SAVE AREA 07688000 +XXSSAVE DS 18F FAKE SAVE AREA FOR OS TO SAVE INTO 07690000 + ORG XXSSAVE ORG BACK 07692000 +XXDWORK DS 4D OVERLAP FLT WORK AREAS INTO FAKE SAV 07694000 + ORG 07696000 + DROP R15 CLEAR TEMPORARY USING 07698000 + ST R14,XXSAVE14 SAVE RETURN ADDRESS,CC PROG MAKS 07700000 + L R11,XXSRGSAV+4*R10 GET PTR (WAS IN R10) 07701000 + USING ECONTROL,R11 NOTE POINTER TO ECONTROL BLOCK 07701500 + SPACE 2 07702000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07740000 +* GET ADDRESS OF LABEL FROM FIRST POSITION IN ADDRESS LIST, * 07742000 +* AND USING REGISTER 10(THE ADDRESS OF THE REGISTER SAVE AREA) * 07744000 +* FIND THE LENGTH OF THE LABEL AND PRINT THE LABEL & HEADER LINE. * 07746000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07748000 + SPACE 2 07750000 +XXOPENOK SR R2,R2 CLEAR FOR INSERTION 07752000 + BAL R8,XXSNBLNC MAKE SURE XXLABEL BLANK, CC = 0 07753000 + TM XXSFLAGS,XXSASDMP ARE WE IN ASSIST FINAL DUMP 07754000 + BZ XXASNDMP NO, SO SKIP NEXT SECTION OF CODE *** 07756000 + EJECT 07758000 +* FOLLOWING SECTION PRINTS HEADER,COMPLETION CODE,PSW, * 07760000 +* AND INSTRUCTION TRACE(OPTIONAL) FOR AN ASSIST FINAL DUMP * 07762000 + SPACE 1 07764000 + MVC XXLABEL(L'XXAS1HD),XXAS1HD MOVE FIRST HDR, 1 CC IN 07766000 + BAL R8,XXPRINTP GO TO PRINT AS DESIRED J 07767000 + BAL R8,XXSNBLNC REBLANK XXLABEL, MAKE CC = 0 AGAIN 07768000 + SPACE 1 07770000 + MVC XXAS2HD,=C'PSW AT ABEND' MOVE HDR IN 07771000 + MVC XXAS2CC,=C'COMPLETION CODE' MOVE HDR IN 07771500 + UNPK XXAS2P1,ECPSW(5) FIRST HALF OF PSW 07772000 + UNPK XXAS2P2,ECILCMSK(5) 2ND HALF OF PSW 07774000 + TR XXAS2P1(2*L'XXAS2P1-1),XXTAB1 FIND CONVERSION 07776000 + MVI XXAS2P1+8,C' ' BLANK BETWEEN PARTS OF PSW 07778000 + MVI XXAS2P2+8,C' ' BLANK AFTER 2ND PART OF PSW 07780000 + SPACE 1 07782000 + L R1,ECERRAD GET @ ERROR BLOCK 07784000 + USING ERCOMPCD,R1 NOTE THE POINTER 07786000 + MVC *+7(1),ERCLENG MOVE LENGTH-1 OVER 07788000 + MVC XXAS2MS($CHN),ERCMSSG MOVE MESSAGE OVER 07792000 + SPACE 1 07794000 + IC R2,ERCTYPE GET TYPE OF COMPLETION 07796000 + SLL R2,3 MULT * 8 FOR INDEX TO TABLE 07798000 + DROP R1 NOTE NO LONGER USING BLOCK PTR 07800000 + LA R1,XXAS2TPM(R2) GET @ COMPLETION TYPE 07802000 + MVC XXAS2TP,0(R1) MOVE THE TYPE INTO MESSAGE 07804000 + BAL R8,XXPRINTL PRINT ASSEMBLED XXLABEL 07806000 + BAL R8,XXSNBLNK REBLANK XXLABEL 07808000 + SPACE 1 07812000 + TM ECFLAG3,$ECDINST SHOULD THERE BE INSTRUCTION TRACE 07814000 + BZ XXASREGS NO,SO DON'T PRINT INSTRUCTIONS 07816000 + LA R0,XXAS3HD SHOW @ THIS HEADER 07822000 + BAL R8,XXPRINT PRINT MESSAGE 07824000 + SPACE 1 07826000 + LA R0,XXAS4HD SHOW @ OF THIS LABEL 07828000 + BAL R8,XXPRINT PRINT (R0=@ XXLABEL STILL) 07830000 + SPACE 1 07834000 + L R9,ECRSTK GET @ CURRENT INSTRUCTION STACK 07836000 + LR R12,R9 SAVE @ FOR COMPARISON IN LOOP 07838000 + USING ECSTACKD,R9 NOTE DSECT FOR EACH STACK ENTRY 07840000 + SPACE 1 07842000 +* FIRST LOOP SEARCHES FOR 1ST ACTUAL INSTRUCTION IN THE * 07844000 +* INSTRUCTION STACK. CHECK REQUIRED IN CASE OF PROGRAM WHICH * 07846000 +* BOMBS ON 1ST INSTRUCTION, SUCH AS BEGINNING WITH DC H'0'. * 07848000 +XXASINA L R9,ECSTLINK GET @ NEXT INSTRUCTION ENTRY 07850000 + CLI ECOP,0 WAS THIS AN INSTRUCTION 07852000 + BNE XXASINB YES,SKIP TO BEGIN PRINTING 07854000 + CR R9,R12 CHECK FOR COMPLETE CYCLE 07856000 + BNE XXASINA NOT CYCLE,LOOP UNTIL 1ST INST 07858000 + SPACE 1 07860000 +* HAVING FOUND 1ST ACTUAL INSTRUCTION, OR SINGLE OPCODE * 07862000 +* OF 0 IN INSTRUCTION CYCLE, PRINT 1 OR MORE INSTRUCTIONS. * 07864000 +XXASINB NI ECSTCCPM,X'3F' ZERO OUT ILC(NOT ALREADY SAVED) 07866000 +XXASINB1 OI ECSTCCPM,$CHN OR BUILT-UP ILC FROM LAST INST 07868000 + MVI *-3,0 ZERO OUT BYTE FOR ILC 07870000 + MVC XXAS5I2(10),XXBLANKS BLANK HALFWORDS 2-3 07872000 + SPACE 1 07874000 + UNPK XXAS5I1(5),ECOP(3) CONVERT OPCODE REGS/LENGTH (ALWAYS) 07876000 + MVI XXAS5I1+4,C' ' BLANK TRAILING BYTE 07878000 + CLI ECOP,X'40' WAS INSTRUCTION RR 07880000 + BL XXASINC YES,SO DO NO MORE ON INST 07882000 + SPACE 1 07884000 + UNPK XXAS5I2(5),ECBD(3) UNPACK FIRST BASE-DISPLACEMENT 07886000 + OI XXASINB1+1,X'80' SET ILC FOR NEXT INST TO 2 07888000 + MVI XXAS5I2+4,C' ' BLANK TRAILING BYTE 07890000 + CLI ECOP,X'C0' WAS INST RX,RS,SI 07892000 + BL XXASIND YES,SO NO MORE CONVERT NEEDED 07894000 + SPACE 1 07896000 + UNPK XXAS5I3(5),ECB2D2(3) UNPACK 3RD HALFWORD- 2ND BASE-DISP 07898000 + MVI XXAS5I3+4,C' ' BLANK TRAILING BYTE 07900000 +XXASINC OI XXASINB1+1,X'40' SET NEXT ILC TO 1(RR), OR 3(SS) 07902000 +XXASIND UNPK XXAS5CC(3),ECSTCCPM CONVERT ILC(NOW RIGHT) CC PM OF PSW 07904000 + MVI XXAS5CC+2,C' ' BLANK TRAILING BYTE 07906000 + SPACE 1 07908000 + UNPK XXAS5AD(7),ECSTIADD+1(4) CONVERT INST ADDRESS 07910000 + MVI XXAS5AD+6,C' ' BLANK TRAILING BYTE 07912000 + TR XXAS5CC(XXAS5$L-2),XXTAB1 FINISH HEX CONVERT 07914000 + SPACE 1 07918000 + CR R9,R12 WAS THIS LAST ONE 07920000 + BNE *+10 BRANCH OVER MVC IF NOT LAST ONE 07922000 + MVC XXLABEL+2+XXAS5$L(L'XXAS5P),XXAS5P MOVE ERR PTR 07924000 + BAL R8,XXPRINTL PRINT ASSEMBLED XXLABEL 07926000 + CR R9,R12 WAS THIS THE LAST 1(ABENDING INSTR) 07928000 + L R9,ECSTLINK GET @ NEXT ENTRY IN TABLE 07930000 + BNE XXASINB GOBACK FOR NEXT ENTRY IN TABLE 07932000 + SPACE 1 07934000 +XXASINE MVC XXLABEL+1(XXAS5$L+2+L'XXAS5P),XXBLANKS REBLANK 07936000 + BAL R8,XXPRINTL PRINT ASSEMBLED XXLABEL 07938000 + DROP R9 DROP LEFTOVER USING CPP 07938020 + AIF (NOT &$EXINT).NOXXINT 07938050 + SPACE 3 07938100 + SPACE 2 07938340 + LA R0,XXAS7HD GET ADDR 1ST BRANCH TRACE HEADER 07938360 + BAL R8,XXPRINT BRANCH, AND PRINT THES HEADER 07938380 + SPACE 2 07938400 + LA R0,XXAS4HD GET ADDR 2ND BRANCH TREE HEADER 07938420 + BAL R8,XXPRINT PRINT THIS HEADER 07938440 + SPACE 2 07938460 +* GET BRANCH STACK ADDRESSIBILITY 07938480 + L R1,ECBSTK GET @ CURRENT BRANCH INSTR STACK 07938500 + LR R12,R1 SAVE ADDRESS FOR COMPARISON IN LOOP 07938520 + USING ECSTACKD,R1 NOTE DSECT FOR EACH BSTACK ENTRY CEH 07938540 + SPACE 2 07938560 +* FIRST LOOP SEARCHES FOR 1ST ACTUAL BRANCH INSTRUCTION IN 07938580 +* THE BRANCH INSTRUCTION STACK. CHECK REQUIRED IN CASE OF 07938600 +* PROGRAM BOMB HAVING EXECUTED NO BRANCHES. 07938620 +XXASBINA EQU * 07938640 + L R1,ECSTLINK GET @ NEXT BRANCH ENTRY CEH 07938660 + CLI ECOP,0 WAS THIS ENTRY AN INSTR. CEH 07938680 + BNE XXASBINB YES, SKIP TO BEGIN PRINTING 07938700 + CR R1,R12 CHECK FOR A COMPLETE CYCLE 07938720 + BNE XXASBINA NOT CYCLE, LOOP UNTIL 1ST BRANCH 07938740 + SPACE 2 07938760 +* HAVE FOUND 1ST ACTUAL !RANCH INSTRUCTION, OR A SINGLE * 07938780 +* OPCODE IN BRANCH INSTRUCTION CYCLE. PRINT 1 OR MORE * 07938800 +* INSTRUCTIONS * 07938820 +XXASBINB EQU * 07938840 + NI ECSTCCPM,X'3F' ZERO OUT ILC(NOT ALREADY SAVED) CEH 07938860 +XXASBIN1 OI ECSTCCPM,$CHN OR BUILT-UP ILC FROM LAST INSTR CEH 07938880 + MVI *-3,0 ZERO OUT BYTE FOR ILC 07938900 + MVC XXAS5I2(10),XXBLANKS BLANK OUT HALFWORDS 2 AND 3 07938920 + SPACE 2 07938940 + UNPK XXAS5I1(5),ECOP(3) CONVERT OPCODE, REGS. & LEN CEH 07938960 + MVI XXAS5I1+4,C' ' BLANK OUT TRAILING BYTE 07938980 + CLI ECOP,X'40' WAS THIS AN RR INSTR. CEH 07939000 + BL XXASBINC YES WE ARE FINISHED WITH THIS INSTR 07939020 + SPACE 2 07939040 + UNPK XXAS5I2(5),ECBD(3) UNPACK ONLY BASE-DISPL. CEH 07939060 + OI XXASBIN1+1,X'80' SET ILC NEXT INSTR TO 2 07939080 + MVI XXAS5I2+4,C' ' BLANK OUT TRAILING BYTE 07939100 + B XXASBIND NO MORE CONVERSION NEEDED 07939120 + SPACE 2 07939140 +XXASBINC EQU * 07939160 + OI XXASBIN1+1,X'40' SET NEXT ILC TO 1 FOR RR INSTR 07939180 +XXASBIND EQU * 07939200 + UNPK XXAS5CC(3),ECSTCCPM CONVERT GOOD ILC-CC PM OF PSW CEH 07939220 + MVI XXAS5CC+2,C' ' BLANK OUT TRAILING BYTE 07939240 + SPACE 2 07939260 + UNPK XXAS5AD(7),ECSTIADD+1(4) CONVERT BR INST. ADDR. CEH 07939280 + MVI XXAS5AD+6,C' ' BLANK OUT TRAILING BYTE 07939300 + TR XXAS5CC(XXAS5$L-2),XXTAB1 FINISH HEX CONVERT 07939320 + SPACE 2 07939340 + BAL R8,XXPRINTL PRINT ASSEMBLED XXLABEL 07939360 + CR R1,R12 WAS THIS THE FINAL BRANCH INSTR 07939380 + L R1,ECSTLINK GET NEXT ENTRY IN TABLE CEH 07939400 + BNE XXASBINB GO BACK FOR NEXT ENTRY IN TABLE 07939420 + BAL R8,XXSNBLNC CLEAR XXLABEL OF GARBAGE 07939425 + DROP R1 CLEAR AWAY BASE REGISTER 07939430 +.NOXXINT ANOP 07939440 + SPACE 1 07940000 +* FINAL DUMP==> EITHER PRINT ALL REGS OR NONE * 07942000 +XXASREGS TM ECFLAG3,$ECREGS SHOULD WE GIVE REGS 07944000 + BO XXASREG1 YES,SO GO DO IT 07946000 + B XXCHKST NO REGS AT ALL 07948000 + EJECT 07950000 +XXASNDMP EQU * ENTRY LABEL FOR NORMAL XSNAP 07952000 + IC R2,XXSLABLN GET LENGTH OF LABEL FIELD 07954000 + LR R1,R10 GET DUPLICATE OF XXSNAPC PTR 07956000 + SR R1,R2 SUBTRACT TO GET START @ FOR LABEL 07958000 + BCTR R2,0 DECREMENT TO LENGTH-1 FOR MVC 07960000 + STC R2,*+5 STORE INTO MVC 07962000 + MVC XXLABEL+38($CHN),0(R1) MOVE LABEL TO PRINT AREA 07964000 + ST R1,XXWORK1 SAVE THIS @ FOR CONVERSION 07966000 + MVC XXWORK1(1),XXSAVE14 MOVE CCMASK OVER FOR CONVERSION 07968000 + SPACE 1 07969000 + TM XXSFLAGS,XXSASNAP IS THIS A USER SNAP 07970000 + BZ *+10 NO,SO DON'T CHANGE PSW 07972000 + MVC XXWORK1(4),ECILCMSK MOVE USER PSW OVER 07974000 + MVC XXLABEL+1(XXSN1B),XXSNP1ST MOVE HEADER,PATTERN,MSG 07976000 + ED XXLABEL+L'XXSNP1ST+1(6),XXCOUNT EDIT CALL NUMBER 07978000 + UNPK XXLABEL+1+XXSN1B(9),XXWORK1(5) CONVERT CCPM,LOCN 07980000 + TR XXLABEL+1+XXSN1B(8),XXTAB1 FINISH HEX CONVERSION 07982000 + AP XXCOUNT,=P'1' INCREMENT # CALLS 07984000 + BAL R8,XXPRINTL PRINT ASSEMBLED XXLABEL 07988000 + BAL R8,XXSNBLNK REBLANK XXLABEL 07990000 + SPACE 2 07992000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07994000 +* CHECK TO SEE IF THE REGISTERS SHOULD BE PRINTED. * 07996000 +* PRINT THE HEADING FOR THE REGISTER DUMP. CONVERT AND PRINT * 07998000 +* THE REGISTERS IN 2 LINES. CHECK TO SEE IF ONLY THE REGISTERS * 08000000 +* WERE DESIRED. FINISH UP AND RETURN TO CALLING XSNAP IF SO. * 08002000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08004000 + SPACE 2 08006000 + TM XXSFLAGS,XXSGPRG DOES HE WANT GP REGS PRINTED 08008000 + BZ XXCHKFP NO, SO DONT PRINT THEM 08010000 + LR R2,R10 DUPLICATE @ RGSAV OVER 08012000 + TM XXSFLAGS,XXSASNAP WAS THIS USER XSNAP 08014000 + BZ XXGOREG NO,NORMAL XSNAP,SKIP 08016000 +XXASREG1 LA R2,ECREGS SHOW @ FAKE REGS INSTEAD 08018000 +XXGOREG EQU * ***WE HAVE DELETED REG HEADER** J 08020000 + SPACE 1 08023000 + MVC XXREGOUT(12),=CL12'0 REGS 0-7' LABEL-1ST REGS 08024000 + BAL R8,XXREGS1 CONVERT 1>T REGS BLOCK,PRINT LINE 08026000 + BAL R8,XXPRINT HAVE LINE PRINTED 08028000 + SPACE 1 08029000 + MVC XXREGOUT(12),=CL12' REGS 8-15' 2ND LINE LABEL 08030000 + BAL R8,XXREGS2 GET 2ND GROUP CONVERTED,PRINTED 08032000 + BAL R8,XXPRINT HAVE LINE PRINTED 08034000 + SPACE 1 08035000 +XXCHKFP EQU * 08036000 + AIF (NOT &$FLOTM).XXS2 SKIP IF MACHINE DOEN'T HAVE FLOT 08038000 + TM XXSFLAGS,XXSFLRG DOES HE WANT FLOATING PT REGS PRINT 08040000 + BZ XXCHKST NO,SO GO CHECK FOR STORAGE= 08042000 + SPACE 1 08044000 +* FOLLOWING SECTION PRINTS FLOATING POINT REGISTERS * 08046000 + MVC XXREGOUT(12),=CL12'0 FLTR 0-6' MOVE LABEL IN 08048000 + LA R2,ECFPREGS SHOW @ FAKE REGS 08050000 + TM XXSFLAGS,XXSASDMP+XXSASNAP WAS THIS ASSIST SNAP/DUMP 08052000 + BNZ XXFPCONV GO CONVERT THEM 08054000 + STD F0,XXDWORK SAVE REG F0 08056000 + STD F2,XXDWORK+8 SAVE F2 08058000 + STD F4,XXDWORK+16 SAVE F4 08060000 + STD F6,XXDWORK+24 SAVE F6 08062000 + LA R2,XXDWORK SET UP @ WORKAREA FOR XXREGS1 08064000 +XXFPCONV EQU * 08066000 + BAL R8,XXREGS1 CALL GP REG CONVERTER 08068000 + MVC XXREGOUT+24(12),XXREGOUT+28 PUT F0 TOGETHER 08070000 + MVC XXREGOUT+48(12),XXREGOUT+52 PUT F2 TOGETHER 08072000 + MVC XXREGOUT+72(12),XXREGOUT+76 PUT F4 TOGETHER 08074000 + MVC XXREGOUT+96(12),XXREGOUT+100 PUT F6 TOGETHER 08076000 + BAL R8,XXPRINT PRINT THE ASSEMBLED LINE 08078000 + MVC XXREGOUT,XXBLANKS REBLANK LINE LIKE ITS SUPPOSED TO BE 08080000 +.XXS2 ANOP 08082000 + SPACE 1 08084000 +XXCHKST EQU * 08086000 + SR R12,R12 CLEAR FOR INSERTION 08088000 + IC R12,XXSNMSTR GET # OF ADDRESS PAIRS 08090000 + LTR R12,R12 ARE THERE ANY @ PAIRS 08092000 + BZ XXEXIT1 NO STORAGE=, SO QUIT 08094000 + LA R9,XXSADSTR INIT R9 TO @ FIRST ADDRESS PAIR 08096000 + LA R4,4 SET UP BXLE INDEX FOR REST OF PROG 08098000 + SPACE 1 08100000 + TM XXSFLAGS,XXSASNAP+XXSASDMP ARE SPECIAL @ GAMES NEEDED 08102000 + BZ XXASTA SKIP IF NOT (I.E. NORMAL XSNAP) 08104000 + TM XXSFLAGS,XXSASDMP WAS THIS A DUMP? 08106000 + BZ XXAST SKIP IF JUST SNAP 08108000 + TM ECFLAG3,$ECSTORG SHOULD STORAGE BE DUMPED 08110000 + BZ XXEXIT3 NO STORAGE,SO QUIT 08112000 + MVC XXLABEL(L'XXAS6HD),XXAS6HD MOVE IN STORAGE DUMP HEADER 08114000 + BAL R8,XXPRINTP GO PRINT AS DESIRED J 08115000 + BAL R8,XXSNBLNC REBLANK XXLABEL, MAKE SURE CC = 0 08116000 + SPACE 1 08117000 +XXAST L R6,ECRADH GET REAL HIGH LIMIT @ 08118000 + TM ECFLAG0,$ECPROT WAS ABSOLUTE PROTECT MODE ON 08119000 + L R11,ECRELOC GET EXECUTION TIME RELOCATION FACTOR 08120000 + BZ XXASTB NO, SKIP, RESET TO NORMAL LIMIT 08121000 + DROP R11 NOTE NO LONGER USING WITH ECONTROL 08122000 + LCR R11,R11 MAKE NEGATIVE,SO CAN USE IN LA'S 08124000 + B XXASTC SKIP TO BEGIN PROCESSING 08126000 +* NOTE ASSIST DUMP REQUIRES USER CORE TO BEGIN ON REAL * 08128000 +* ADDRESS DIVISIBLE BY 32,TO GET REASONABLE OUTPUT. * 08130000 + SPACE 1 08132000 +* THE FOLLOWING 2 LINES HELP US PREVENT 0C5'S * 08134000 +XXASTA SR R11,R11 SET RELOCATION TO 0 (NORMAL XSNAP) 08136000 + AIF (NOT &$ASMLVL).XXASDOS SKIP IF OTHER THAN OS/360 08137000 +XXASTB L R6,16 CVT PTR **********OS/360 ONLY ****** 08138000 + L R6,164(R6) GET CVTMZ000 - HIGHEST CORE @ 08138050 +.XXASDOS AIF (&$ASMLVL).XXASNOS SKIP IF OS/360, CAN GET SIZ FROM CVT 08138100 +XXASTB COMRG R1 <- @ OF COMMUNICATIONS REGION 08138200 + L R6,48(R1) GET @ OF END OF MACHINE (DOS) 08138230 + LA R6,1(R6) GET @ ON NEXT NON-AVAIL BYTE 08138240 +.XXASNOS ANOP 08138300 +XXASTC SH R6,=H'32' REDUCE SO WILL NOT 0C5 08142000 + EJECT 08144000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08146000 +* SECTIONS XXMEMA - XXMEME SERVE TO PROCESS 1 ADDRESS PAIR * 08148000 +* FROM THE LIST OF ADDRESS PAIRS SPECIFYING STORAGE TO BE DUMPED. * 08150000 +* AT XXMEMF,THE 2ND ADDRESS IS TESTED TO SEE IF IT IS THE LAST ONE * 08152000 +* AND THE DUMP COMPLETED IF SO. OTHERWISE,A BRANCH IS TAKEN BACK * 08154000 +* TO XXMEMA TO PROCESS THE NEXT ADDRESS PAIR. * 08156000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08158000 + SPACE 2 08160000 +XXMEMA LM R2,R3,0(R9) OBTAIN NEXT ADDRESS PAIR 08162000 + LA R0,0(R11,R2) RELOCATE ADDRESS IF NEEDED 08164000 + ST R0,XXWORK1 SAVE FOR CONVERSION 08166000 + UNPK XXCOREL,XXWORK1+1(4) CONVERT WITH TRAILING BLANK 08168000 + LA R0,0(R11,R3) GET HIGH ADDRESS,RELOCATE 08170000 + ST R0,XXWORK1 SAVE FOR CONVERT 08172000 + UNPK XXCOREH,XXWORK1+1(4) CONVERT WITH TRAILING BLANK 08174000 + TR XXCOREL(17),XXTAB1 TRANSLATE TO COMPLETE HEX CONVERT 08176000 + MVC XXCOREL+7(2),=C'TO' PUT REST OF MSG IN 08178000 + MVC XXCORETL,=C'CORE ADDRESSES SPECIFIED-' PUT IN MSG 08180000 + BAL R8,XXPRINTL PRINT XXLABEL 08181000 + MVC XXCORETL(XXCORE$L),XXBLANKS+30 REBLANK THE AREA 08182000 + SPACE 1 08183000 + CR R3,R6 MAKE SURE HIGH ADDR ISN'T TOO HIGH 08184000 + BNH *+6 SKIP OVER IF NOT TOO HIGH 08186000 + LR R3,R6 @ WOULD 0C5-USE HIGHEST INSTEAD 08188000 + LA R3,31(R3) PREPARE TO ROUND 2ND ADDR UPWARD 08190000 + SRDL R2,5 ROUND BOTH ADDRESSES 08192000 + SLL R2,5 NOW HAVE 1ST ADDR IN R2,ROUNDED DOWN 08194000 + SLL R3,5 NOW HAVE HIGH ADDR IN R3,ROUNDED UP 08196000 + CR R2,R3 WAS USER IN ERROR: LOW ADDR>HIGH ADD 08198000 + BH XXMEMF ADDR ERROR-PRINT NOTHING,GO TO NEXT 08200000 + CR R2,R6 MAKE SURE IF 1ST=2ND>MEMORY SIZE 08202000 + BH XXMEMF PRINT NOTHING IF SO 08204000 + SPACE 2 08206000 +XXMEMB EQU * 08208000 + AR R2,R11 RELOCATE IF NEEDED 08210000 + ST R2,XXWORK1 STORE BEGINNING ADDR FOR CONVERT 08212000 + SR R2,R11 CONVERT BACK TO REAL @ 08214000 + LR R7,R2 SAVE BEGINNING ADDRESS FOR SAME CHK 08216000 + UNPK XXCORADD+1(7),XXWORK1+1(4) GET BEGINNING ADDRESS 08218000 + MVC XXCORE3,0(R2) MOVE 32 BYTES OVER FOR ALPHMERIC TR 08220000 + TR XXCORE3,XXTAB2 PERFORM ALPHAMERIC CONVERSION 08222000 + SPACE 1 08223000 + LA R1,XXCORE1 ADDRESS FOR 1ST BLOCK CONVERSION 08224000 + BAL R8,XXMEMP1 GET 1ST BLOCK OF 4 WORDS CONVERTED 08226000 + LA R1,XXCORE2 ADDRESS FOR 2ND BLOCK CONVERSION 08228000 + BAL R8,XXMEMP1 GET 2ND BLOCK CONVERTED 08230000 + SPACE 1 08231000 + TR XXCORADD+1(84),XXTAB1 FINISH HEX CONVERSION 08232000 + LA R0,XXCORADD ADDRESS OF CORE OUTPUT LINE 08234000 + BAL R8,XXPRINT GET 1 CORE LINE PRINTED 08236000 + EJECT 08238000 +* XXMEMC-XXMEME CHECK FOR DUPLICATE LINES. HAVING FOUND 1 OR * 08240000 +* MORE DUPLICATE LINES,CORE IS SCANNED UNTIL A DIFFERENT LINE IS * 08242000 +* FOUND,OR THE BLOCK FINISHED,AND THEN PRINTS SAME LINES MESSAGE. * 08244000 + SPACE 2 08246000 +XXMEMC CR R2,R3 R2 HAS BEEN INCREMENTED-ARE WE DONE 08248000 + BNL XXMEMF YES WE'RE DONE WITH THIS SECTION 08250000 + CLC 0(32,R7),0(R2) COMPARE PREVIOUS SECTION WITH NEXT 08252000 + BNE XXMEMB NOT THE SAME-WILL HAVE TO PRINT LINE 08254000 + LA R7,32(R11,R7) INCREMENT TO MAKE RIGHT @,RELOCATE 08256000 + ST R7,XXWORK1 SAVE 1ST LINE ADDRESS OF SAME AREAS 08258000 + SR R7,R11 CONVERT BACK TO REAL @ 08260000 + UNPK XXSAML,XXWORK1+1 1ST STEP TO CONVERT 08262000 + SPACE 1 08263000 +XXMEMD LA R2,32(R2) INCREMENT TO LOOK AT NEXT SECTION 08264000 + CR R2,R3 ARE WE DONE 08266000 + BNL XXMEME YES,WE'RE DONE-SAME LINES MESSAGE 08268000 + CLC 0(32,R7),0(R2) CHECK NEXT SECTION WITH 1ST OF SAMES 08270000 + BE XXMEMD SAME-KEEP LOOPING UNTIL DIFFERENT 08272000 + SPACE 1 08273000 +XXMEME LA R1,0(R11,R2) GET END @,RELOCATE,WHERE CAN DESTROY 08274000 + SH R1,=H'32' DECRMENT SO LINE ADDR RIGHT 08276000 + ST R1,XXWORK1 SAVE FOR HEX CONVERSION 08278000 + UNPK XXSAMH,XXWORK1+1 CONVERT-FIRST STEP 08280000 + TR XXSAML(13),XXTAB1 FINISH HEX CONVERSION OF SAME LINES 08282000 + MVI XXSAML+6,C'-' PLACE DASH BETWEEN ADDRESSES 08284000 + MVC XXLABEL+1+3(XXSAM$L),XXSAME MOVE SAME LINES MSG OVER 08286000 + LA R0,XXLABEL+1 SHOW @ 1 BEYOND CARRIAGE CONTROL 08287000 + BAL R8,XXPRINT PRINT THE SAME LINE MESSAGE 08288000 + CR R2,R3 HAVE WE MEANWHILE FINISHED BLOCK 08290000 + BL XXMEMB NO-KEEP GOING UNTIL BLOCK DONE 08292000 + SPACE 1 08293000 +XXMEMF LA R9,8(R9) INCREM R9 TO @ NEXT @ PAIR 08294000 + MVC XXLABEL+1+3(XXSAM$L),XXBLANKS+1+3 REBLANK AREA 08295000 + BCT R12,XXMEMA GO BACK FOR NEXT BLOCK 08296000 + B XXEXIT2 ALL STORAGE= DONE, GO RETURN 08298000 + EJECT 08300000 +* XXEXIT - PRINT ENDING LINE,THEN RETURN TO CALLING XSNAP. * 08302000 + SPACE 2 08304000 +XXEXIT1 TM XXSFLAGS,XXSGPRG+XXSFLRG WERE EITHER REGS PRINTED 08306000 + BZ XXEXIT3 NO OPTIONS, JUST LEAVE SINGLE LINE 08308000 +XXEXIT2 EQU * DON'T HAVE TO SET R0, USE XXPRINTL 08310000 + BAL R8,XXPRINTL PRINT XXLABEL FOR A BLNKA LINE 08312000 +XXEXIT3 L R14,XXSAVE14 RELOAD RETURN @, CC 08314000 + SPM R14 RESTORE CONDITION CODE 08316000 + BR R14 RETURN TO CALLING XSNAP 08318000 + EJECT 08320000 +* *** INTERNAL SUBROUTINE AREA *** * 08322000 + SPACE 1 08322100 +* XXSNBLNC BLANKS XXLABEL, SETS CARRIAGE CONTROL = 0. 08322200 +* XXSNBLNK JUST BLANKS XXLABEL, NOT CHANGING CC. 08322300 +XXSNBLNC MVI XXLABEL,C'0' MAKE NORMAL DOUBLE SPACE CC 08322400 +XXSNBLNK MVC XXLABEL+1(L'XXLABEL-1),XXBLANKS+1 REBLANK ENTIRE AREA 08322500 + BR R8 RETURN TO CALLER 08322600 + SPACE 2 08324000 +* XXREGS1 CONVERTS AND PRINTS 1 LINE OF 8 REGISTERS * 08326000 + SPACE 1 08328000 +XXREGS1 LA R4,12 INCREMENT FOR BXLE 08330000 + LA R5,XXREGOUT+16+7*12 LIMIT ADDRESS FOR BXLE 08332000 +XXREGS2 LA R3,XXREGOUT+16 START POINT,INDEX FOR COMING BXLE 08334000 +XXREGS3 UNPK 0(9,R3),0(5,R2) CONVERT 1 REGISTER VALUE 08336000 + MVI 8(R3),C' ' BLANK OUT EXTRA BYTE USED IN CONVERT 08338000 + LA R2,4(R2) INCREMENT POINTER TO REGISTER 08340000 + BXLE R3,R4,XXREGS3 LOOP-DO 1 LINE OF 8 REGISTER VALUES 08342000 + TR XXREGOUT+16(92),XXTAB1 FOR REST OF HEX CONVERT 08344000 + LA R0,XXREGOUT ADDRESS OF OUTPUT LINE 08346000 + BR R8 RETURN TO CALLER 08348000 + SPACE 2 08350000 +* XXMEMP1 CONVERTS 1 BLOCK OF 16 BYTES TO HEX. * 08352000 + SPACE 1 08354000 +XXMEMP1 LA R5,12(R2) SET UP LIMIT FOR BXLE 08356000 +XXMEMP2 UNPK 0(9,R1),0(5,R2) UNPACK 1 WORD OF MEMORY 08358000 + MVI 8(R1),C' ' BLANK OUT EXTRA BYTE UNPACKED 08360000 + LA R1,9(R1) INCREMENT POINTER TO OUTPUT AREA 08362000 + BXLE R2,R4,XXMEMP2 CONTINUE,CONVERTING 16 BYTES 08364000 + BR R8 RETURN TO CALLER 08366000 + SPACE 2 08368000 +* XXPRINTL PRINTS 121 CHARACTERS STARTING AT XXLABEL. * 08370000 +* XXPRINT PRINTS 121 CHARACTERS STARTING AT @ IN R0. * 08370050 + SPACE 1 08372000 +XXPRINTP EQU * ***COME HERE IF MIGHT BE PAGE SKIP POSSIBLE*** J 08373800 + AIF (&$DMPAG).XXNPQQQ SKIP IF PAGE EJECTS ALLOWED AT ALL J 08373810 + MVI XXLABEL,C'0' USE DOUBLE SPACE RATHER THAN EJECT J 08373820 +.XXNPQQQ ANOP J 08373830 +XXPRINTL LA R0,XXLABEL SHOW @ XXLABEL 08373900 +XXPRINT EQU * 08374000 + AIF (&$DEBUG).XXS50 SKIP IF PRODUCTION 08376000 + PUT XXSNDCB,(0) 08378000 + AGO .XXS60 SKIP 08380000 +.XXS50 $PRNT (0),121,XXSNPROV PRINT OUTPUT,GO TO LABEL IF OVERFLOW 08382000 +.XXS60 ANOP 08384000 + BR R8 RETURN TO CALLER 08386000 + EJECT 08386010 +* EXIT TAKEN IF RECORD LIMIT OVERRUN. THIS CHECKS TO * 08386020 +* SEE IF OUTPUT IS FOR AN EXECUTION-TIME XDUMP, IN WHICH CASE * 08386030 +* EXECUTION IS STOPPED, SINCE USER IS OVERRUNNING HIS LIMIT. * 08386040 +XXSNPROV EQU * 08386050 + TM XXSFLAGS,XXSASNAP WAS THIS A USER SNAP (XDUMP) 08386060 + BZ XXEXIT3 NO, FINAL DUMP-WE'RE DONE 08386070 + SPACE 1 08386080 +* OVERFLOW OCCURED. QUIT, FLAGGING ECONTROL. 08386090 + L R11,XXSRGSAV+4*R10 GET PTR TO ECONTROL, WAS IN R10 08386100 + USING ECONTROL,R11 NOTE POINTER 08386110 + MVI ECFLAG1,$ECRECEX SHOW EXECUT THAT RECORD OVERFLOWED 08386120 + B XXEXIT3 GO RETURN CONTROL 08386130 + DROP R11 NOT NEEDED ANYMORE 08386140 + SPACE 5 08386150 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08390050 +*--> ENTRY: XXXXSNIN XXXXSNAP INITIALIZATION ENTRY * 08390100 +* CALLED TO INITIALIZE 'XSNAP - CALL' NUMBER TO 1 (IN CASE * 08390200 +* BATCHED RUNS ARE USED). * 08390300 +* ENTRY CONDITIONS * 08390400 +* R14= RETURN ADDRESS * 08390500 +* R15= @ XXXXSNIN * 08390600 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08390700 + ENTRY XXXXSNIN INITIALIZATION ENTRY FOR ASSIST 08392000 + USING XXXXSNIN,R15 NOTE USING 08394000 +XXXXSNIN ZAP XXCOUNT,=P'1' INITILZE COUNTER TO 1 08396000 + BR R14 RETURN TO CALLER 08398000 + SPACE 08400000 + EJECT 08402000 +* *** OUTPUT LINE,CONSTANT, AND TRANSLATE TABLE AREA *** * 08404000 + SPACE 2 08406000 +XXSAVE14 DS A SAVE WORD FOR RETURN @, CC,MASK 08408000 +XXWORK1 DC F'0',X'04' FIELD + REVERSED BLANK FOR HEX CONVT 08410000 +XXCOUNT DC PL3'1' COUNTER FOR NUMBER OF CALLS 08412000 + AIF (&$DEBUG).XXS70 SKIP IF PRODUCTION VERSION 08414000 + PRINT NOGEN 08416000 + ENTRY XXSNDCB SO PEOPLE CAN CHANGE,IF THEY WISH 08418000 + AIF (&$ASMLVL).XXSNDTF SKIP IF UNDER OS GENERATION 08418200 +XXSNDCB DTFPR DEVADDR=SYSLST,BLKSIZE=121,CTLCHR=YES,IOAREA1=XXSNIOAR, X08418400 + WORKA=YES 08418600 +XXSNIOAR DC 121C' ' DOS XSNAP IOAREA 08418800 +.XXSNDTF AIF (NOT &$ASMLVL).XXS70 SKIP IF UNDER DOS GENERATION 08419000 +XXSNDCB DCB DSORG=PS,MACRF=PM,RECFM=FA,LRECL=121,BLKSIZE=121, #08420000 + DDNAME=XSNAPOUT,BUFNO=1 08422000 +.XXS70 ANOP 08424000 + SPACE 1 08425000 + DS 0D ALIGN FOR SPEED 08425500 +XXSNP1ST DC C'BEGIN XSNAP - CALL' HEADER TITLE 08426000 + DC X'402020202021' EDIT PATTERN FOR CALL NUMBER 08428000 + DC C' AT ' FOR XSNAP LOCATION MESSAGE 08430000 +XXSN1B EQU *-XXSNP1ST LENGTH OF HEADER,NUMBER,LOCATION 08432000 + SPACE 1 08433000 + DS 0D ALIGN FOR SPEED 08433500 +XXSAME DC CL9'LINES' BEGINNING OF SAME LINE MSG 08434000 +XXSAML DC CL7' ' LOWEST ADDRESS AREA 08436000 +XXSAMH DC CL7' ',C' SAME AS ABOVE' END OF SAME LINES MSG 08438000 +XXSAM$L EQU *-XXSAME LENGTH OF MESSAGE 08438500 + SPACE 1 08439000 + DS 0D ALIGN FOR SPEED 08440000 +XXLABEL DC CL121'0' MAIN PRINTING AREA, WITH SKIP CARCON 08442000 + DC CL7' ' PAD TO DOUBLEWORD BOUNDARY 08444000 + SPACE 1 08445000 + DS 0D ALIGN FOR SPEED 08452000 +XXBLANKS DC CL121' ',CL7' ' BLANKS, ALSO FOR XXREGLAB PRINTING 08454000 + DS 0D ALIGN FOR SPEED 08456000 +XXREGOUT DC CL121' ' REGISTER PRINTING AREA 08458000 + SPACE 1 08459000 + DS 0D ALIGN FOR SPEED 08459500 +XXTAB DC C'0123456789ABCDEF' TR TABLE FOR HEX CONVERT 08460000 +XXTAB1 EQU XXTAB-240 TO MAKE CONSTANT TR'S EASIER FOR HEX 08462000 + SPACE 1 08463000 + DS 0D ALIGN FOR SPEED 08463500 +XXTAB2 DC 64C'.',C' ',128C'.',C'ABCDEFGHI',7C'.',C'JKLMNOPQR' 08464000 + DC 8C'.',C'STUVWXYZ',6C'.',C'0123456789',6C'.' ALPH TR TAB 08466000 + SPACE 1 08467000 + DS 0D ALIGN FOR SPEED 08467900 +XXCORADD DC CL7' ',CL3' ' 10 BYTES - LINE ADDRESS 08468000 +XXCORE1 DC 4CL9' ',CL3' ' 39 BYTES - SPACE FOR 4 WORDS 08470000 +XXCORE2 DC 4CL9' ',CL3' *' 39 BYTES - SPACE FOR 2ND BLOCK 08472000 +XXCORE3 DC CL32' ',C'*' 33 BYTES - ALPHAMERICS + * 08474000 + SPACE 1 08475000 + ORG XXLABEL+30 ORG BACK TO MAIN LABEL AREA 08476000 +XXCORETL DS C'CORE ADDRESSES SPECIFIED-' SPACE FPR HDR 08477000 + ORG XXCORETL+30 SPACE UPWARD 08477500 +XXCOREL DS CL7,CL3 SPACE FOR LOW ADDR, 'TO ' 08478000 +XXCOREH DS CL7' ' SPACE FOR 2ND @ 08479000 +XXCORE$L EQU *-XXCORETL GET LENGTH OF HDR 08480000 + ORG , RESTORE NORMAL LOCATION CTR 08480500 + EJECT 08482000 + DS 0D ALIGN FOR SPEED 08484000 +XXAS1HD DC C'1 ASSIST COMPLETION DUMP' HEADER 1ST PAGE OF DUMP 08486000 + SPACE 1 08488000 + ORG XXLABEL+1 ORG BACK TO LABEL PRINTING AREA+1 08490000 +XXAS2HD DS C'PSW AT ABEND' SPACE FOR HDR, L' ATTRIBUTE SET 08492000 + DS C SPACING BYTE 08493000 +XXAS2P1 DS CL9 1ST HALF OF PSW 08494000 +XXAS2P2 DS CL9 2ND HALF OF PSW 08496000 + DS CL6' ' 08498000 +XXAS2CC DS C'COMPLETION CODE',CL3' ' SPACE, L' 08500000 +XXAS2TP DS CL8 SPACE FOR TYPE-SYTEM,ASSIST,USER = 08502000 + DS C' ' 08504000 +XXAS2MS EQU * FOR MESSAGE 08506000 + ORG , ORG BACK TO NORMAL LOCATION CTR 08508000 + SPACE 1 08510000 +XXAS2TPM DC CL8'SYSTEM =',CL8'ASSIST =',CL8' USER =' 08512000 + SPACE 1 08514000 +XXAS3HD DC CL121'0** TRACE OF INSTRUCTIONS JUST BEFORE TERMINATION:#08516000 + PSW BITS SHOWN ARE THOSE BEFORE CORRESPONDING INSTRUCTI#08518000 + ON DECODED ***' 08520000 + SPACE 1 08522000 +XXAS4HD DC CL121'0 IM LOCATION INSTRUCTION : IM = PSW BITS 32-#08524000 + 39(ILC,CC,MASK) BEFORE INSTRUCTION EXECUTED AT PROGRAM L#08526000 + OCATION SHOWN' 08528000 + SPACE 1 08530000 + ORG XXLABEL+1 ORG BACK INTO MAIN LABEL 08532000 +XXAS5HD DS C' ' SPACING 08534000 +XXAS5CC DS XL2 ILC-CC-PM 08536000 + DS C' ' SPACING 08538000 +XXAS5AD DS XL6 PSW ADDRESS 08540000 + DS CL5' ' 08542000 +XXAS5I1 DS XL5 1ST HALFWORD OF INSTRUCTION 08544000 +XXAS5I2 DS XL5 2ND HALFWORD OF INSTRUCTION 08546000 +XXAS5I3 DS XL5 3RD HALFWORD OF INSTRUCTION 08548000 +XXAS5$L EQU *-XXAS5HD DEFINE LENGTH OF THIS MESSAGE 08550000 + ORG , RESTORE NORMAL LOCATION CTR 08551000 +XXAS5P DC C'<-- LAST INSTRUCTION DONE - PROBABLE CAUSE OF TERMINAT#08552000 + ION' BOMB POINTER MSG 08554000 + SPACE 1 08556000 +XXAS6HD DC C'1 USER STORAGE' HEADER 2ND PAGE OF DUMP 08558000 + LTORG 08558050 + AIF (NOT &$EXINT).XXASNXT 08558100 + SPACE 3 08558200 +* THESE LABELS ARE ONLY USED IN THE LAST 10 BRANCH * 08558300 +* INSTRUCTION COMPLETION MESSAGE * 08558400 + SPACE 2 08558500 +XXAS7HD DC CL121'-** TRACE OF LAST 10 BRANCH INSTRUCTIONS EXECUTED:X08558600 + PSW BITS SHOWN ARE THOSE BEFORE CORRESPONDING INSTRUCTIX08558700 + ON DECODED ***' 08558800 +.XXASNXT ANOP 08558900 + DROP R10,R13 DROP REGISTERS NO LONGER USED CPP 08562000 + TITLE '*** XXXXSPIE ASSIST INTERRUPTS COMMUNICATIONS ***' 08562500 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08562502 +*--> CSECT: XXXXSPIE INTERRUPT CONTROL & COMMUNICATIONS * 08562505 +* SCOTT A SMITH - FALL 1971. * 08562510 +* THIS IS CALLED ONLY FROM THE MACRO EXPANSION OF $SPIE. IT * 08562515 +* CONTAINS THE ONLY MACROS THAT CAUSE LINKAGE TO BE SET UP * 08562520 +* BETWEEN THE SUPERVISOR AND THE EXIT ROUTINE FOR INTERRUPT * 08562525 +* HANDLING. THE INITIAL COMMUNICATIONS ARE NEVER MADE UNLESS * 08562530 +* AT LEAST ONE $SPIE IS EXPANDED. ONLY ONE ACTUAL SUPERVISOR * 08562535 +* CALL IS NECESSARY. ALL OTHER $SPIE EXPANSIONS JUST MANI- * 08562540 +* PULATE THE CONTROL BLOCKS GENERATED BY THAT EXPANSION. * 08562545 +* **NOTE** XXXXSPIE CONTAINS THE ONLY OCCURENCES OF THE * 08562550 +* MACROS SPIE (OS) OR STXIT (DOS) * 08562555 +* NAMES: XSP----- * 08562560 +* * 08562565 +* THIS ENTRY HANDLES THE UPDATING OF THE POINTER TO THE * 08562570 +* ACTIVE XSPIEBLK . * 08562575 +* ENTRY CONDITIONS * 08562580 +* R1 = @ NEWLY CREATED ACTIVE XSPIEBLK (OR RESTORED XSPIEBLK) * 08562585 +* R14= RETURN ADDRESS * 08562590 +* R15= @ ENTRY POINT * 08562595 +* EXIT CONDITIONS * 08562600 +* R1 = @ LAST PREVIOUS ACTIVE XSPIEBLK * 08562605 +* = 0 , IF NO PREVIOUS XSPIEBLK'S EXISTED * 08562610 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08562615 + SPACE 1 08562620 +XXXXSPIE CSECT 08562625 + $DBG ,NO SHOW NO DEBUG CODE - $SAVE/$RETURN 08562630 + USING XXXXSPIE,REP SHOW OF ENTRY POINT REGISTER USING 08562635 + L R0,XSPACBLK GET CURRENT XSPIEBLK @ 08562640 + ST R1,XSPACBLK SAVE THE NEW ACTIVE XSPIEBLK @ 08562645 + LR R1,R0 RETURN PREVIOUS XSPIEBLK @ 08562650 + BR RET ACTIVE XSPIEBLK PTRS CHANGED, RETURN 08562655 + DROP REP INFORM ASSEMBLER NO LONGER USING R15 08562660 + SPACE 2 08562665 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08562667 +*--> ENTRY: XXXXSPIN INITIALIZATION OF INTERRUPT COMMUNICATIONS * 08562670 +* THE ONLY NECESSARY SPIE(OS) OR STXIT(DOS) IS EXECUTED HERE * 08562675 +* TO CATCH ALL INTERRUPTS AND TO REQUEST THE RETURN OF CONTROL * 08562680 +* TO THE SAME EXIT ROUTINE HANDLER. AS SUBSEQUENT $SPIE'S * 08562685 +* ARE ISSUED, NO SVC IS NEEDED; JUST AN ANALYSIS OF THE * 08562690 +* STATUS OF THE ACTIVE CONTROL BLOCK(XSPIEBLK) BY THE COMMON * 08562695 +* INTERRUPT EXIT ROUTINE. * 08562700 +* USES MACROS: SPIE(OS) OR STXIT(DOS),$SAVE,$RETURN * 08562705 +* ENTRY CONDITIONS * 08562710 +* R14= RETURN ADDRESS * 08562715 +* R15= @ ENTRY POINT * 08562720 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08562725 + SPACE 1 08562730 + ENTRY XXXXSPIN 08562735 +XXXXSPIN $SAVE RGS=(R14-R12),SA=XSPYSAVE 08562740 + XC XSPACBLK,XSPACBLK SET PREVIOUS XSPIEBLK PTR TO ZERO 08562745 + AIF (&$ASMLVL).XSPOS SKIP IF WE ARE IN OS GENERATION 08562750 + STXIT PC,XXXXSPEX,XSPYSAVE CATCH ALL PROGRAM CHECKS 08562755 +.XSPOS AIF (NOT &$ASMLVL).XSPDOS SKIP IF SET BY DOS GENERATION 08562760 + SPIE XXXXSPEX,((1,15)) CATCH ALL PROGRAM EXCEPTIONS 08562765 +.XSPDOS ANOP 08562770 + $RETURN RGS=(R14-R12) RETURN AFTER ESTABLISHING COMMUNCTS 08562775 + SPACE 2 08562780 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08562785 +*--> INSUB: XXXXSPEX INTERRUPT EXIT ROUTINE * 08562790 +* RECEIVES CONTROL FOR ALL INTERRUPTS, REGARDLESS OF @ ON * 08562795 +* MOST PREVIOUS $SPIE CALL. XXXXSPEX MONITORS THE INTERRUPT * 08562800 +* HANDLING. IT FIRST DETERMINES IF THIS PARTICULAR INTERRUPT * 08562805 +* WAS TO BE CAUGHT, SINCE ALL REAL INTERRUPTS WILL EFFEC- * 08562810 +* TIVELY BE NAILED. IF IT WAS NOT TO BE CAUGHT, THEN CONTROL * 08562815 +* IS RETURNED TO THE SUPERVISOR TO REINITIALIZE EXECUTION * 08562820 +* WHERE IT WAS LEFT OFF. ***NOTE*** IT MIGHT BE DESIRABLE * 08562825 +* TO INSERT CODE IN THIS CASE TO EITHER PRINT OUT A MESSAGE * 08562830 +* OR TO TAKE SOME OTHER ACTION. THE CALLABLE EXIT(IF ANY) IS * 08562835 +* GIVEN CONTROL , BUT IT MUST RETURN CONTROL. UPON RETURN * 08562840 +* THE PSW IS CHANGED (IF EXIT @ GIVEN) AND SUPERVISOR GETS CNTL* 08562845 +* USES DSECTS: XSPIEBLK * 08562850 +* THIS ROUTINE PRESERVES THE CONTENTS OF R2-R12 FOR THE * 08562855 +* INSPECTION BY THE CALLABLE EXIT ROUTINE. * 08562860 +* ENTRY CONDITIONS * 08562865 +* R1 = @ OF OS PIE BLOCK (*DOS*MOST LOAD @ INTRPT SAVEAREA(PSW) * 08562870 +* R14= RETURN ADDRESS * 08562875 +* R15= @ ENTRY POINT * 08562880 +* EXIT CONDITIONS * 08562885 +* R1 = @ OF OS PIE BLOCK OR @ OF DOS PSW & SAVE. **NOTE** CALLABLE * 08562890 +* EXIT ROUTINE MUST NOT CHANGE THE CONTENTS OF REGISTER #1 * 08562895 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08562900 + SPACE 1 08562905 + AIF (&$ASMLVL).XSPNBAL SKIP IF UNDER OS GENERATION 08562910 +XXXXSPEX BALR R15,0 ESTABLISH TEMP DOS ADDRESSABILITY 08562915 + USING *,R15 INFORM OF USING 08562920 + LA R1,XSPYSAVE GET DOS @ OF PSW & SAVE AREA 08562925 +.XSPNBAL AIF (NOT &$ASMLVL).XSPADDR SKIP IF UNDER DOS GENERATION 08562930 + USING *,R15 SHOW OF ENTRY POINT REG USING 08562935 +XXXXSPEX LA R1,4(R1) GET R1 <- OS PSW IN PIEBLOCK 08562940 +.XSPADDR ANOP 08562945 + STM R13,R15,XSPSVRES STORE THE REGISTERS 08562950 + LA R13,XSPYSAVE @ OUR SAVE AREA, FOR SAFETY 08562952 + L R14,XSPACBLK LOADS @ OF ACTIVE XSPIEBLK 08562955 + USING XSPIEBLK,R14 DSECT USING FOR CONTROL BLOCK 08562960 + LTR R14,R14 SEE IF A $SPIE IS IN EFFECT 08562965 + BZ XSPNOSPY NO SPIE WAS IN EFFECT AT PRESENT 08562970 + L R0,=X'80000000' LOAD 1 BIT IN HIGH ORDER END 08562975 + MVC *+8(2),2(R1) PLACE INT. # INTO L' NEXT INSTRUCTN 08562980 + SRL R0,$ GET BIT TO MASKABLE POSITION 08562985 + N R0,XSPINTRP AND WITH INTERRUPT TYPES TO BE CAUGT 08562990 + BZ XSPNTCTH THIS INTERRUPT WAS NOT TO BE CAUGHT 08562995 + L R0,XSPEXRTN GET CALLABLE EXIT @ 08563000 + LTR R0,R0 WAS ONE ACTUALLY SUPPLIED? 08563005 + BZ XSPNOCLX IF NONE, THEN DON'T TRY TO CALL 08563010 + LR R15,R0 MOVE @ TO R15 FOR BALR, WATCH ADDRES 08563015 + BALR R14,R15 GO TO CALLABLE EXIT: MUST RETURN 08563020 + USING *,R14 NOTE TEMP USING FOR REGAIN OF R15 08563025 + L R15,XSPSVRET+4 GET ORIGINAL ENTRY POINT ADDRESS 08563030 + USING XSPIEBLK,R14 INFORM OF DSECT USING AGAIN 08563035 + AIF (&$ASMLVL).XSPNRES SKIP REGISTER SAVE IF UNDER OS 08563040 + SPACE 08563045 +* UNDER DOS, REGS THAT WERE CHANGED BY CALLABLE EXIT MUST BE * 08563050 +* UPDATED IN SAVE AREA TO SHOW NEW VALUES OVER IN EXIT ROUTINE * 08563055 + STM R2,R12,XSPYSAVE+16 SAVE NEW VALUES FROM CALLABLE EXIT 08563060 +.XSPNRES ANOP 08563065 + L R14,XSPACBLK REGAIN POINTER TO XSPIEBLK 08563070 +XSPNOCLX L R0,XSPCLBEX GET @ OF EXIT ROUTINE 08563075 + LTR R0,R0 WAS IT EVER SUPPLIED? 08563080 + BZ XSPIERTN DON'T CALL, JUST RETURN 08563085 + MVC 5(3,R1),XSPCLBAD CHANGE THE PSW ADDRESS FIELD 08563090 + B XSPIERTN GO TO RETURN TO SUPERVISOR 08563095 +XSPNTCTH EQU * COME HERE IF NO SPIE SET 08563097 +******** AIF (&$DEBUG).XXSPNBG SKIP IF NOT DEBUG MODE 08563098 + L R14,=V(VWXTABL) GET @ ASSEMBLER TABLE 08563099 + USING AVWXTABL,R14 NOTE PTR THERE 08563100 + XSNAP LABEL='ASSIST ABEND-SEND DECK TO SYSTEMS: 3-12; PSW,14-2#08563101 + ; AVTAB',STORAGE=(*0(R1),*28(R1),*AVADDLOW,*AVWXEND) CPP 08563102 + DROP R14 ZAP TEMPORARY USING 08563103 +.XXSPNBG DC H'0' BOMB HERE WITH S0C1 08563104 +XSPNOSPY EQU * MAY WISH TO PRINT A MSG. 08563105 +XSPIERTN DS 0H 08563110 + L R13,XSPSVRES RELOAD CORRECT R13 08563112 + AIF (NOT &$ASMLVL).XSPRST DON'T RESTORE R1 IF NOT OS 08563115 + S R1,=F'4' RESTORE OS R1 TO POINT TO PIE BLOCK 08563120 + L R14,XSPSVRET GET RETURN ADDRESS 08563125 + BR R14 RETURN CONTROL TO SUPERVISOR 08563130 +.XSPRST AIF (&$ASMLVL).XSPNEXT SKIP IF OS, SINCE NO EXIT PC 08563135 + EXIT PC RETURN CONTROL TO SUPERVISOR 08563140 +.XSPNEXT ANOP 08563145 +XSPACBLK DC F'-1' ACTIVE XSPIEBLK POINTER 08563150 +XSPYSAVE DC 18F'-1' SAVEAREA FOR REGS & DOS INTERRUPTS 08563155 +XSPSVRES DC F'-1' FOR REG 13 08563159 +XSPSVRET DC 2F'-1' FOR TEMP LOC. OF RET & REP REGS 08563160 + LTORG 08563165 + SPACE 2 08563170 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08563172 +*--> DSECT: XSPIEBLK INTERRUPT COMMUNICATIONS CONTROL BLOCK * 08563175 +* THIS BLOCK CONTAINS EXIT ADDRESSES AND INTERRUPT MASKS FOR * 08563180 +* USE IN HANDLING THE 15 PROGRAM EXCEPTIONS. THE INTERRUPT * 08563185 +* MASK IS EXTENDED TO A FULLWORD FOR EASE OF TESTING AGAINST * 08563190 +* THE INTERRUPTS THAT WERE DESIRED TO BE TRAPPED. THE EXIT * 08563195 +* ADDRESS IS OF LENGTH 3 FOR CHANGING THE PSW(ONLY 3 BYTE @ * 08563200 +* LOCATION: INSIDE $SPIE MACRO EXPANSION * 08563205 +* GENERATION: ONE XSPIEBLK IS GENERATED FOR EVERY $SPIE * 08563210 +* EXPANSION EXCEPT LINKAGE TERMINATION & RESTORATION * 08563215 +* NAMES: XSP----- * 08563220 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 08563225 + SPACE 1 08563230 +XSPIEBLK DSECT 08563235 +XSPCLBEX DS C ALIGNMENT FOR VL3 PSW (@ PORTION) 08563240 +XSPCLBAD DS VL3 @ OF INTERRUPT EXIT ROUTINE 08563245 +XSPEXRTN DS VL4 @ OF CALLABLE EXIT ROUTINE 08563250 +XSPINTRP DS BL2 POSSIBLE INTERRUPT MASK BITS 08563255 + DS BL2'0' TRAILING ZEROES FOR EASY TESTING 08563260 + TITLE '*** BROPS2 - BASE REGISTER OPERATIONS - PASS 2 ***' 08564000 +**--> CSECT: BROPS2 2 ALL BASE REGISTER OPERATIONS - ALL PASS 2 . . 08566000 +*. USES DSECTS: AVWXTABL . 08567000 +*. USES MACROS: $RETURN,$SAVE . 08567500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08568000 +BROPS2 CSECT 08570000 + $DBG A0,SNAP 08572000 + ENTRY BRINIT,BRUSIN,BRDROP,BRDISP 08574000 + USING AVWXTABL,RAT NOTE MAIN USING 08576000 + SPACE 2 08578000 +**--> ENTRY: BRINIT 2 INITIALIZE BASE REGISTER TABLES . . . . . . . 08580000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08582000 +BRINIT $SAVE SA=NO 08584000 + MVC BRVALS(4*16),AWZEROS ZERO OUT VALUE /ID TABLE 08586000 + $RETURN SA=NO 08588000 + SPACE 2 08590000 +**--> ENTRY: BRUSIN 2 ENTER A REGISTER-VALUE PAIR . . . . . . . . . 08592000 +*. ENTRY CONDITIONS . 08594000 +*. RA = NUMBER OF REGISTER FOR WHICH USING TO BE SET UP = 0-15 . 08596000 +*. RB = ADDRESS DECLARED IN USING FOR GIVEN REGISTER = 0-2**24-1 . 08598000 +*. RC = ESDID OF THE USING VALUE, IN LOW ORDER BYTE = 1-255 . 08600000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08602000 +BRUSIN $SAVE SA=NO 08604000 + SLL RA,2 REG #*4 FOR FULLWORD INDEXING 08608000 + ST RB,BRVALS(RA) STORE VALUE OF REG IN RIGHT SLOT 08610000 + STC RC,BRVALS(RA) STORE ID IN HI-ORDER BYTE 08611000 + $RETURN SA=NO 08612000 + SPACE 2 08614000 +**--> ENTRY: BRDROP 2 DROP A REGISTER FROM USING. . . . . . . . . . 08616000 +*. ENTRY CONDITIONS . 08618000 +*. RA = NUMBER OF REGISTER TO BE DROPPED FROM USING - = 0-15 . 08620000 +*. EXIT CONDITIONS . 08622000 +*. RB = 0 THE REGISTER WAS CURRENTLY USABLE . 08624000 +*. RB = ^0 THE REGISTER WAS NOT CURRENTLY IN USE . 08626000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08628000 +BRDROP $SAVE SA=NO 08630000 + SLL RA,2 REG# * 4 FOR INDEX TO TABLE 08631000 + LA RB,BRVALS(RA) SET RB^=0, @ WORD FOR DESIRED REG 08632000 + CLI 0(RB),0 WAS THE REG IN USE 08634000 + BE BRDRRET NO,BRANCH,LEAVING RB^=0-ERROR 08636000 + MVI 0(RB),0 SET ID = 0, DEFINITELY DROPPING REG 08638000 + SR RB,RB SET RB=0 TO SHOW OK 08640000 +BRDRRET $RETURN SA=NO 08642000 + EJECT 08644000 +**--> ENTRY: BRDISP 2 GIVEN VALUE&ESDID, RETURN BASE-DISPLACEMENT . 08646000 +*. ENTRY CONDITIONS . 08648000 +*. RA = ADDRESS VALUE TO BE DECOMPOSED TO BASE-DISPLACEMENT (24 BITS). 08650000 +*. RB = ESDID OF ADDRESS TO BE DECOMPOSED - LOW ORDER BYTE . 08652000 +*. VALUE IS FROM 1-255. 0 CAN BE USED TO MARK NONUSABLE. . 08653000 +*. EXIT CONDITIONS . 08654000 +*. RA = BASE-DISPLACEMENT FORM OF ADDRESS, IF ADDRESSABLE . 08656000 +*. RB = 0 NORMAL RETURN - ADDRESS WAS DECOMPOSABLE . 08658000 +*. = ^0 ADDRESSIBILITY ERROR(NO REG,OR DISP TOO LARGE) . 08660000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08662000 +BRDISP $SAVE RGS=R14,SA=NO 08664000 + STC RB,BRCESD+1 PLACE ESDID INTO CLI INSTRUCTION 08666000 + SLL RB,24 SHIFT ID TO HI-ORDER BYTE OF RB 08668000 + ALR RA,RB PUT SECITON ID IN WITH VALUE 08670000 + LM RC,RE,BRRGSCDE GET INITIAL VALUES FOR RC,RD,RE 08672000 + SR R14,R14 R14 = 0 ==> NO REGISTER FOUND YET 08674000 + SPACE 1 08676000 +* THE FOLLOWING LOOP EXECUTED 16 TIMES, CHECK EACH REG * 08678000 +BRCESD CLI 0(RC),$CHN COMPARE INCOMING ESDID WITH 1 OLD 08680000 + BNE BRLOOP IF NOT EQUAL,GO TO NEXT 08682000 + CL RA,0(,RC) COMP INCOMING VALUE TO ONE IN USE RG 08684000 + BL BRLOOP REGISTER HIGHER THAN ADDRESS-NO USE 08686000 + CL RB,0(,RC) COMP PREVIOUS BEST REG TO NEXT ONE 08688000 + BH BRLOOP IF PREVIOUS BEST > NEW, SKIP 08690000 + L RB,0(,RC) GET NEW BEST ID/VALUE 08692000 + LR R14,RC SAVE FOR INDEX TO BEST REG 08694000 +BRLOOP BXLE RC,RD,BRCESD BUMP TO NEXT REG, GO BACK TO CHK 08696000 + SPACE 1 08700000 + S R14,BRRGSCDE S R14,=A(BRVALS) = 4* REG #, IF OK 08702000 + BM BRNOGOOD IF R14 WAS =0, NO USABLE REG, BRANCH 08704000 + SLR RA,RB COMPUTE DISPLACEMENT FOUND 08706000 + C RA,AWF4095 C RA,=F'4095' -MAKE SURE NOT BOG 08708000 + BH BRNOGOOD JUMP IF ILLEGALLY BIG 08710000 + SLL R14,10 SHIFT REG NUMBER TO RIGHT SPOT 08712000 + AR RA,R14 PUT BASE AND SIP TOGETHER 08714000 + SR RB,RB ZERO TO SHOW SUCCESSFUL COMPLETE 08716000 +BRRET $RETURN RGS=R14,SA=NO 08718000 +BRNOGOOD LR RB,RD RB = 4 ==> ADDRESSIBLITY ERROR 08720000 + B BRRET GO RETURN TO CALLER 08722000 + SPACE 1 08724000 +BRRGSCDE DC A(BRVALS,4,BRVALS+60) 2NDEX,INCREM,LIMIT-REGS RC,RD,RE 08725000 +* * * * * INTERNAL VARIABLES * 08726000 + DS 0D FOR ALIGNEMENT 08728000 +BRVALS DS 16F TABLE OF USABLE VALUES IN REGS 08730000 +* 1ST BYTE OF EACH HAS ID, RESTS HAVE ADDRESS. 08732000 + DROP RAT,REP CLEAN UP USING 08734000 + TITLE '*** CACONS - A-TYPE CONSTANT PROCESSING ***' 08736000 +**--> CSECT: CACONS 1-2 PROCESS A-TYPE ADDRESS CONSTANTS. . . . . . . 08738000 +*. USES DSECTS: AVWXTABL . 08739000 +*. USES MACROS: $CALL,$RETURN,$SAVE . 08739500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08740000 +CACONS CSECT 08742000 + $DBG A0,SNAP 08744000 + ENTRY CACON1,CACON2 08746000 + USING AVWXTABL,RAT NOTE MAIN USING 08748000 + SPACE 2 08750000 +**--> ENTRY: CACON1 SCAN ACON, BUT DO NOT ASSEMBLE VALUE. . . . . . 08752000 +*. ENTRY CONDITIONS . 08754000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 08756000 +*. EXIT CONDITIONS . 08758000 +*. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 08760000 +*. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 08762000 +*. RB = NONZERO ==> ILLEGAL CONSTANT ($ERINVCN) . 08764000 +*. CALLS SCANCO . 08766000 +*. **NOTE** EXPRESSION ENDING IN ) INSIDE MULTIPLE CONSTANT . 08766200 +*. WILL BE PROCESSED IMPROPERLY, SUCH AS DC A(B+(C),D) . . 08766400 +*. THE CHARACTERS C) ARE TREATED AS END OF THE ACON. . 08766600 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08768000 +CACON1 $SAVE RGS=(R14-R1),BR=R1,SA=CACOSAVE 08770000 + LR R0,RA SAVE ORIG SCAN POINTER 08772000 + $CALL SCANCO SCAN TO COMMA OR BLANK 08774000 + LTR RB,RB WAS THERE ERROR 08776000 + BNZ CAC1RET YES-ERROR-RETURN WITH IT 08778000 + CR R0,RA WAS THERE A NULL CONSTANT 08780000 + BE CAC1ERR YES-ERROR-BRANCH 08782000 + SPACE 1 08782500 + BCTR RA,0 BACK UP SCAN PTR 1 BYTE 08783000 + CLI 1(RA),C',' WAS SCAN STOPPER A COMMA 08784000 + BNE CAC1RET NO, MUST BE END OF CONST: EXPR) 08786000 + SPACE 1 08788000 + CLI 0(RA),C')' MAKE SURE THS IS RIGHT PAREN 08790000 + BE CAC1RET SKIP IF SO 08792000 + LA RA,1(RA) CONST ENDED WITH EXPR, RESET PTR=>, 08794000 + B CAC1RET GO EXIT 08795000 +CAC1ERR LA RB,$ERINVCN NULL CONSTANT 08796000 +CAC1RET $RETURN RGS=(R14-R1) 08798000 + EJECT 08800000 +**--> ENTRY: CACON2 1-2 SCAN ACON, ASSEMBLE VALUE . . . . . . . . . . 08802000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 08804000 +*. RB = LENGTH-1 OF 1 CONSTANT OF 1 OPERAND TO BE ASSEMBLED . 08806000 +*. EXIT CONDITIONS . 08808000 +*. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 08810000 +*. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 08812000 +*. RB = NONZERO VALUE - ERROR CODE (FROM EVALUT) . 08814000 +*. = $ERRELOC IF SECTION ID IS A DSECT, WHICH IS NOT ALLOWED. . 08815000 +*. RC = ADDRESS OF PROPERLY ASSEMBLED CONSTANT . 08816000 +*. RD = ESDID OF CONSTANT, IF =0 ==> ABSOLUTE EXPRESSION . 08818000 +*. CALLS EVALUT . 08820000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08822000 +CACON2 $SAVE RGS=(R14-R0),BR=R13,SA=CACOSAVE 08824000 + LR R0,RB SAVE THE LENGTH-1 FOR ASSEMBLY 08826000 + $CALL EVALUT CALL EXPRESSION EVALUATOR 08828000 + LTR RB,RB WAS THERE ERROR 08830000 + BNZ CAC2RET ERROR-RETURN 08832000 +* CHECK TO MAKE SURE DON'T DC A(DSECT SYMBOL) 08833000 + STC RD,AVFWORK1 STORE FOR TEST OF EVEN/ODD 08833100 + TM AVFWORK1,$ESDSECT TEST FOR ODD 08833200 + BZ *+8 NO, EVEN=> CSECT TYPE OR ABS TERM-OK 08833300 + LA RB,$ERRELOC NO GOOD- FLAG ERROR-DSECT RELOC 08833400 + ST RC,AVCONBLD STORE THE VALUE 08834000 + LCR RE,R0 GET NEGATIVE OF LENGTH-1 FOR ASSMBLY 08836000 + LA RC,AVCONBLD+3(RE) GET REAL STARTING ADDRESS 08838000 +CAC2RET $RETURN RGS=(R14-R0) 08840000 + DROP RAT,R1,R13 08842000 + TITLE '*** CBCONS - SCAN AND/OR ASSEMBLE BINARY CONSTANTS ***' 08844000 +**--> CSECT: CBCONS 1-2 PROCESS BINARY CONSTANTS. . . . . . . . . . . 08846000 +*. USES DSECTS: AVWXTABL . 08847000 +*. USES MACROS: $RETURN,$SAVE . 08847500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08848000 +CBCONS CSECT 08850000 + $DBG A0,SNAP 08852000 + ENTRY CBCON1,CBCON2 08854000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 08856000 + SPACE 2 08858000 +**--> ENTRY: CBCON1 1 SCAN B CONSTANT, DO NOT ASSEMBLE. . . . . . . 08860000 +*. ENTRY CONDITIONS . 08862000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 08864000 +*. EXIT CONDITIONS . 08866000 +*. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 08868000 +*. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 08870000 +*. RB = NONZERO VALUE FOR ERROR CODE - INVALID CONSTANT - ($ERINVCN) . 08872000 +*. RC = NUMBER OF BYTES REQUIRED FOR CONSTANT . 08874000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08876000 +CBCON1 $SAVE RGS=(R1-R2),SA=NO 08878000 + MVC AWTDECT+C'2'(8),AWBLANK CAUSE 2-9 TO BE ^=0 08880000 + SR R1,R1 CLEAR SO TRT WORKSA RIGHT 08882000 + TRT 0(256,RA),AWTDECT MUST ENCOUNTER DELIMITER (3CRD LIM) 08884000 + MVC AWTDECT+C'2'(8),AWZEROS+C'2' REZERO TRT TABLE 08886000 + LA RC,7(R1) MOVE ENDING PTR,ROUND UP 08888000 + SR RC,RA GET # 0'S & 1'S,ROUNDED UP TO 8 08890000 + LR RA,R1 MOVE ENDING POINTER FOR RETURN 08892000 + CLI 0(RA),C'''' WAS DELIMIER ' LIKE SUPPOSED TO 08894000 + BNE CB1ERR NO, ERROR, INVALID DELIMITER 08896000 + SRA RC,3 DIVIDE BY 8, GET # BUTES REQUIRED 08898000 + BZ CB1ERR IF 0, CONST WAS B'', ERROR,BRANCH 08900000 + SR RB,RB SHOW NO ERROR 08902000 +CB1RET $RETURN RGS=(R1-R2),SA=NO 08904000 + SPACE 1 08906000 +CB1ERR LA RB,$ERINVCN INVALID CONSTANT -SET FLAG FOR RETUR 08908000 + B CB1RET GO RETURN, SHOWING ERROR 08910000 + EJECT 08912000 +**--> ENTRY: CBCON2 1-2 ASSEMBLE BINARY CONSTANT. . . . . . . . . . . 08914000 +*. ENTRY CONDITIONS . 08916000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 08918000 +*. RB = LENGTH-1 OF 1 CONSTANT OF 1 OPERAND TO BE ASSEMBLED . 08920000 +*. EXIT CONDITIONS . 08922000 +*. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 08924000 +*. RC = ADDRESS OF PROPERLY ASSEMBLED CONSTANT . 08926000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08928000 +CBCON2 $SAVE RGS=(R0-R2),SA=NO 08930000 + STC RB,*+5 STORE LENGTH-1 INTO NEXT MVC 08932000 + MVC AVCONBLD($CHN),AWZEROS ZERO OUT WHOLE AREA 08934000 + SR R1,R1 CLEAR FOR COMING TRT 08936000 + L RD,AWFM1 =F'-1' FOR DECREMENTING LATER 08938000 + TRT 0(256,RA),AWTDECT WE CHECKED IN PASS 1, LOOK FOR DLM 08940000 + LA RE,0(RD,RA) GET LIMIT FOR BXH, @ 1ST ' OF CONST 08942000 + LR RA,R1 GET @ OF ENDING ' 08944000 + BXH R1,RD,CB2L2 DECREM LAST PTR, ENTER LOOP RIGHT 08946000 + SPACE 1 08948000 +CB2L1 BCT R2,CB2L3 DECREMENT BIT POSITION POINTER,BRNCH 08950000 + STC R0,AVCONBLD(RB) STORE ASSEMBLED BYTE INTO POSITION 08952000 + AR RB,RD SUBTRACT 1 FROM BYTE COUNT 08954000 + BM CB2RETA IF <0, WE ARE DONE, QUIT 08956000 + SPACE 1 08958000 +* INITIALIZATION - 1 TIME FOR EACH BYTE REQUIRED * 08960000 +CB2L2 SR R0,R0 CLEAR FOR BUILDING UP BYTE 08962000 + LA R2,8 # BITS IN 1 BYTE 08964000 + LCR RC,RD RC = 1, FOR SHIFTING BIT TO ADD 08966000 + SPACE 1 08968000 +CB2L3 CLI 0(R1),C'0' IS NEXT CHAR A 0 08970000 + BE *+6 SKIP ADDING BIT IN, IF SO 08972000 + ALR R0,RC ADD 1 BIT IN IN RIGHT BIT POSITION 08974000 + ALR RC,RC == SLL RC,1 - SHIFT 1 BIT OVER FOR N 08976000 + BXH R1,RD,CB2L1 DECREMENT POINTER, JUMP TO CHECK 08978000 + SPACE 1 08980000 + STC R0,AVCONBLD(RB) RAN OUT OF DIGITS, STORE THE BYTE 08982000 +CB2RETA LA RC,AVCONBLD GET @ BEGINNING OF ASSEMBLED CONST 08984000 +CB2RET $RETURN RGS=(R0-R2),SA=NO 08986000 + DROP RAT,REP KILL USINGS 08988000 + TITLE '*** CCCONS - SCAN AND/OR ASSEMBLE C-TYPE CONSTANTS ***' 08990000 +**--> CSECT: CCCONS 1-2 PROCESS CHARACTER TYPE CONSTANTS. . . . . . . 08992000 +*. USES DSECTS: AVWXTABL . 08993000 +*. USES MACROS: $RETURN,$SAVE . 08993500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 08994000 +CCCONS CSECT 08996000 + $DBG A0,SNAP 08998000 + ENTRY CCCON1,CCCON2 09000000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 09002000 + SPACE 2 09004000 +**--> ENTRY: CCCON1 1 SCAN,RETURN LENGTH,DO NOT ASSEMBLE. . . . . . 09006000 +*. ENTRY CONDITIONS . 09008000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 09010000 +*. EXIT CONDITIONS . 09012000 +*. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 09014000 +*. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 09016000 +*. RB = NONZERO VALUE FOR ERROR CODE - INVALID CONSTANT - ($ERINVCN) . 09018000 +*. RC = NUMBER OF BYTES REQUIRED FOR CONSTANT . 09020000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09022000 +CCCON1 $SAVE SA=NO 09024000 + SR RC,RC INDEX FOR BXLE, WILL GO FROM 0==>255 09026000 + LA RD,1 INCREMENT FOR BXLE FOR LOOP 09028000 + LA RE,255 LIMIT=LENGTH OF MAXIMUM CONSTANT 09030000 + SPACE 1 09032000 +* INITIALIZATION DONE, NOW DO CHECKING LOOP * 09034000 +CC1LOOP CLI 0(RA),C'''' IS THE NEXT CHAR A ' 09036000 + BNE CC1CHK2 NO, GO CHECK FOR & OR OTHER 09038000 + CLI 1(RA),C'''' IS NEXT CHARACTER & ' 09040000 + BNE CC1OUT NO IT ISNT, MUST BE END OF CONSTANT 09042000 + BXH RA,RD,CC1LOOPA BUMP SCAN POINTER 1 AND BRANCH 09044000 + SPACE 1 09046000 +CC1CHK2 CLI 0(RA),C'&&' IS CHAR AN & 09048000 + BNE CC1LOOPA BRANCH IF NOT==> NORMAL CHARACTER 09050000 + AR RA,RD INCREMENT TO 2ND &,HOPEFULLY 09052000 + CLI 0(RA),C'&&' MAKE SURE 2ND & IS THERE TOO 09054000 + BNE CC1ERR ERROR IF IT ISNT-BRANCH 09056000 + SPACE 1 09058000 +CC1LOOPA AR RA,RD INCREMENT POINTER TO NEXT CHAR 09060000 + BXLE RC,RD,CC1LOOP CONTINUE LOOPING 09062000 + SPACE 1 09064000 +CC1ERR LA RB,$ERINVCN NOTE THIS IS AN INVALID CONSTANT 09066000 + B CC1RET RETURN, WITH ERROR 09068000 + SPACE 1 09070000 +CC1OUT LTR RC,RC MAKE SURE LENGTH OF CONST>0 09072000 + BZ CC1ERR NULL CONSTANT==>ERROR 09074000 + SR RB,RB CLEAR TO SHOW LEGAL CONSTANT 09076000 +CC1RET $RETURN SA=NO 09078000 + EJECT 09080000 +**--> ENTRY: CCCON2 2 SCAN, ASSEMBLE. . . . . . . . . . . . . . . . 09082000 +*. ENTRY CONDITIONS . 09084000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 09086000 +*. RB = LENGTH-1 OF 1 CONSTANT OF 1 OPERAND TO BE ASSEMBLED . 09088000 +*. EXIT CONDITIONS . 09090000 +*. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 09092000 +*. RC = ADDRESS OF PROPERLY ASSEMBLED CONSTANT . 09094000 +*. RD = LENGTH-1 OF CONSTANT (WAS IN RB ON ENTRY) CPP 09095000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09096000 +CCCON2 $SAVE SA=NO 09098000 + LA RD,1 FOR INCREMENT AND USEFUL CONST 09100000 + SR RE,RE CLEAR FOR COUNTER 09102000 +* **NOTE** BXH'S WORK OK SINCE RA>256 ALWAYS. 09104000 + SPACE 1 09106000 +CC2LOOP CLI 0(RA),C'''' IS CHAR A ' 09108000 + BNE CC2CHK2 BRANCH IF IT ISN'T 09110000 + CLI 1(RA),C'''' SEE IF NEXT 1 IS ' 09112000 + BNE CC2PAD BRANCH==>HIT END OF CONST,PAD NEEDED 09114000 + BXH RA,RD,CC2MOV INCREMENT POINT TO 2ND '&JUMP 09116000 + SPACE 1 09118000 +CC2CHK2 CLI 0(RA),C'&&' IS CHAR AN & 09120000 + BNE CC2MOV JUMP IF IT IS NORMAL CHARACTER 09122000 + AR RA,RD INCREMENT TO POINT AT 2ND & 09124000 +CC2MOV IC RC,0(RA) GET THE CHARACTER 09126000 + STC RC,AVCONBLD(RE) SAVE THIS IN THE RIGHT PLACE IN CONS 09128000 + AR RE,RD INCREMENT NUMBER OF BYTES DONE 09130000 + BXH RA,RD,CC2LOOP INCREMENT AND JUMP BACK FOR NEXT 09132000 + SPACE 1 09134000 +CC2PAD LR RD,RB SAVE LENGTH-1 OF CONSTANT CPP 09135000 + SR RB,RE RE=LENGTH-1 OF PAD, IF ANY CPP 09136000 + BM CC2RETA IF <0, NO PAD REQUIRED, QUIT 09138000 + LA RE,AVCONBLD(RE) RE=@ OF FIRST BYTE TO BLANK CPP 09140000 + STC RB,*+5 STORE LENGTH INTO MVC 09142000 + MVC 0($CHN,RE),AWBLANK PAD--BLANK OUT ENOUGH CPP 09144000 + SPACE 1 09146000 +CC2RETA LA RC,AVCONBLD POINT TO BEGINNING OF ASSEMBLED CONS 09148000 +CC2RET $RETURN SA=NO 09150000 + DROP RAT,REP CLEAN UP USING 09152000 + TITLE '*** CDECNS - D AND E TYPE CONSTANT PROCESSING ***' 09154000 +**--> CSECT: CDECNS 1-2 PROCESS D&E TYPE CONSTS . . . . . . . . . . . 09156000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09158000 +CDECNS CSECT 09160000 + $DBG A0,SNAP 09162000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 09164000 + ENTRY CDECN1,CDECN2 09166000 + SPACE 2 09168000 +**--> ENTRY: CDECN1 1 SCAN, BUT DO NOT ASSEMBLE D OR E TYPE CONSTS. 09170000 +*. ENTRY CONDITIONS . 09172000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 09174000 +*. EXIT CONDITIONS . 09176000 +*. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 09178000 +*. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 09180000 +*. RB = NONZERO VALUE FOR ERROR CODE - INVALID CONSTANT - ($ERINVCN) . 09182000 +*. CALLS CDECN2 . 09182100 +*. USES DSECTS: AVWXTABL . 09182200 +*. USES MACROS: $RETURN,$SAVE . 09182300 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09184000 +CDECN1 EQU * USE SAMEENTRY AS CDECN2 FOR THIS 09186000 + EJECT 09208000 +**--> ENTRY: CDECN2 1-2 SCAN,ASSEMBLE D&E TYPE CONSTANTS. . . . . . . 09210000 +*. ENTRY CONDITIONS . 09212000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 09214000 +*. RB = LENGTH-1 OF 1 CONSTANT OF 1 OPERAND TO BE ASSEMBLED . 09216000 +*. EXIT CONDITIONS . 09218000 +*. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 09220000 +*. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 09222000 +*. RB = NONZERO VALUE FOR ERROR CODE - INVALID CONSTANT - ($ERINVCN) . 09224000 +*. RC = ADDRESS OF PROPERLY ASSEMBLED CONSTANT . 09226000 +*. CALLS SDDTRM . 09228000 +*. USES DSECTS: AVWXTABL . 09229000 +*. USES MACROS: $CALL,$RETURN,$SAVE . 09229500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09230000 + SPACE 1 09230100 +* * * * * REGISTER ALLOCATION - CDECN2 * * * * * * * * * * * * * * * * 09230200 +* F0 = ACCUMULATOR FOR VALUE BUILT UP FOR CONSTANT * 09230300 +* F2 = FLOATING POINT 10.0 * 09230400 +* F4 = INITIALLY FLOATING POINT 10.0. MULTIPLIED BY 10 FOR FRACTION * 09230450 +* F6 = FLOATING POINT WORK REGISTER * 09230500 +* RA = SCAN POINTER ADDRESS REGISTER, ADVANCED DURING SCAN * 09230600 +* RC = UNUSED CURRENTLY * 09230700 +* RD = UNUSED CURRENTLY * 09230800 +* RE = 1 USEFUL CONSTANT IN ODD REGISTER, USED FOR BXH'ING. * 09230900 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 09231000 + AIF (&$FLOTA AND &$FLOTM).CD2FULL SKIP IF OK TO HAVE D&E 09231050 +* RESTRICTED VERSION - IF NOT ACCEPTING FLOATING PT, OR 09231100 +* NOT ON MACHINE, ASSEMBLE ONLY D'0' OR E'0'. 09231150 +CDECN2 $SAVE SA=NO 09231200 + CLI 0(RA),C'0' WAS IT LEGAL ZERO 09231250 + BNE CD2INVCN NO, BAD, WE ONLY ACCEPT 0 09231300 + LA RA,1(RA) BUMP SCAN PTR 1 09231350 + LA RC,AWZEROS SHOW @ 8 BYTES OF ZERO 09231400 + SR RB,RB SHOW ACCEPTABLE 09231450 +CD2RET $RETURN SA=NO RETURN FROM SMALL MODULE 09231500 +CD2INVCN LA RB,$ERINVCN SHOW INVALID, WASN'T 0 09231550 + B CD2RET RETURN WITH RROR 09231600 + DROP RAT,REP AVWXTABL,ENTRY BASE 09231650 + AGO .CD2MINI SKIP OVER REGULAR CODE 09231700 +.CD2FULL ANOP 09231750 + SPACE 1 09231800 +CDECN2 $SAVE SA=CDE2SAVE,RGS=(R14-R15),BR=R13 09232000 + MVI CD2CON+1,X'F0' MAKE NOOP TO BRANCH,INIT 09234000 + MVI CD2FTEST+1,0 INIT THIS TEST TO NOOP 09236000 + LD F0,AWD0 GET CONSTANT 0 09238000 + LD F2,AWD10 GET USEFUL CONSTANT 10 09240000 + STD F2,AVDWORK1 STORE VALUE WITH X'41' EXPONENT 09242000 + MVI CD2PERI+1,0 INIT . BRANCH TO NOOP 09244000 + LDR F4,F2 INIT F4 TO FLOATING PT 10 FOR DIVIDE 09246000 + LA RE,1 FOR BXHING AND OTHER INCREMNTING 09248000 + MVI CD2SIGN,X'20' MAKE INST A LPDR-ASSUME + # 09250000 + CLI 0(RA),C'0' DO WE START WITH DIGIT 09252000 + BNL CD2DIG YES,GO PROCESSES 09254000 + CLI 0(RA),C'.' DO WE HAVE . AT BEGINNING 09256000 + BE CD2PERI GO THERE IF SO 09258000 + CLI 0(RA),C'+' DO WE HAVE + 09260000 + BE CD2INCA YES,BUMP SCAN PTR,LEAVE SIGN OK 09262000 + CLI 0(RA),C'-' DO WE HAVE - 09264000 + BNE CD2INVCN NO,MUST BE ERROR 09266000 + MVI CD2SIGN,X'21' MAKE INST LNDR SINCE NEGATIVE SIGN 09268000 +CD2INCA AR RA,RE BUMP SCAN PTR BEYOND SIGN 09270000 + EJECT 09272000 +* LOOP HEAD FOR SCANNING FOLLOWS. * 09274000 +CD2LOOP CLI 0(RA),C'0' DO WE HAVE DIGIT 09276000 + BL CD2NDIG NO,BRANCH OUT 09278000 +CD2DIG MVI CD2CON+1,0 MAKE BRANCH NOOP,SHOW 1 DIGIT,AT LEA 09280000 + UNPK AVDWORK1+1(1),0(1,RA) MOVE SWITCHED NIBBLES TO WORK 09282000 + NI AVDWORK1+1,X'F0' REMOVE EXTRA NIBBLE AT END, LEAVE # 09284000 +CD2FTEST BC $CHN,CD2LDIV BRANCH OUT IF IN FRACTIONAL PART 09290000 + MDR F0,F2 MULT ACCUMULATED VALUE BY 10 09292000 + AD F0,AVDWORK1 ADD NEW VALUE INTO ACCUMUALTOR 09294000 + BXH RA,RE,CD2LOOP BUMP SCAN POINTER, GO FOR NEXT 09296000 + SPACE 1 09298000 +CD2LDIV LD F6,AVDWORK1 GET VALUE OF NEXT DIGIT 09300000 + DDR F6,F4 DIVIDE BY CURRENT POWER OF 10 09302000 + MDR F4,F2 RAISE POWER OF 10 IN F4 BY ANOTHER 09303000 + ADR F0,F6 ADD NEW VALUE IN 09304000 + BXH RA,RE,CD2LOOP BUMP SCAN PTR, GET NEXT 09306000 + SPACE 1 09308000 +CD2NDIG CLI 0(RA),C'.' IS IT PERIOD 09310000 + BNE CD2NOPR NEITHER DIG NOR PERIOD 09312000 +CD2PERI BC $CHN,CD2INVCN IF WE COME HERE 2 TIMES-GO TO ERROR 09314000 + MVI CD2PERI+1,X'F0' MAKE NOOP A BRANCH TO ERROR 09316000 + MVI CD2FTEST+1,X'F0' MAKE BRANCH-SHOW FRACTION NOW 09318000 + BXH RA,RE,CD2LOOP BUMP SCAN PTR,GET NEXT 09320000 + EJECT 09322000 +* FOLLOWING SECTION SCANS FOR AN EXPONENT E AND SIGN 09324000 +CD2NOPR CLI 0(RA),C'E' WAS THIS EXPONENT INDICATOR 09326000 + BNE CD2DLM NO,MUST BE DELIMITER 09328000 + AR RA,RE BUMP SCAN PTR BEYOND E 09330000 + MVI CD2SIGNE,X'2C' MAKE EXPONENT SIGN + (MDR INST) 09332000 + CLI 0(RA),C'0' IS NUMBER THERE 09334000 + BNL CD2EVAL IF DECIMAL,GO EVALUATE 09336000 + CLI 0(RA),C'+' WAS THERE A + SIGN 09338000 + BE CD2INCB YES,JUST BUMP SCAN PTR 09340000 + CLI 0(RA),C'-' WAS THERE - SIGN 09342000 + BNE CD2INVCN NO,ERROR 09344000 + MVI CD2SIGNE,X'2D' -EXPONENT, MAKE INST A DDR 09346000 +CD2INCB AR RA,RE BUMP SCAN PTR BY 1 09348000 + SPACE 1 09350000 +* HAVE EXPONENT VALUE CONVERTED. ADJUST FRACTION BY IT. 09352000 +CD2EVAL $CALL SDDTRM 09354000 + LTR RB,RB WAS IT OK 09356000 + BNZ CD2INVCN NO,ERROR 09358000 + LTR RC,RC WAS EXPONENT 0 09360000 + BZ CD2CON YES,DON'T DO ANYTHING 09362000 +* THERE SHOULD BE SOME MAGNITUDE CHECKING HERE 09364000 +CD2SIGNE MDR $CHN+F0,F2 **MODIFIED** MUL OR DIV,DEP ON SIGN 09366000 + BCT RC,CD2SIGNE LOOP FOR REQUIRED AMOUNT 09368000 + SPACE 1 09370000 +* MAKE ENDING CHECKS, THEN RETURN TO CALLER. 09372000 +CD2DLM CLI 0(RA),C'''' WAS THIS ' DELIMITER 09374000 + BE CD2CON YES,OK 09376000 + CLI 0(RA),C',' WAS IT , DELIM 09378000 + BNE CD2INVCN INVALID DELIMITER 09380000 +CD2CON BC $CHN,CD2INVCN BRANCH OUT IF NO FRACTIO ANYWHERE 09382000 +CD2SIGN LPDR $CHN+F0,F0 **MODIFIED** GET RIGHT SIGN 09384000 + STD F0,CD2CONB SAVE THIS VALUE 09386000 + LA RC,CD2CONB POINT TO THIS @ 09388000 + SR RB,RB SHOW OK 09390000 +CD2RET $RETURN RGS=(R14-R15) 09392000 +CD2INVCN LA RB,$ERINVCN SHOW ERROR 09394000 + B CD2RET RETURN 09396000 +CD2CONB DS D SPACE FOR SAVING CONSTANT 09400000 + DROP RAT,R13 KILL USINGS 09402000 +.CD2MINI ANOP 09402100 + TITLE '*** CFHCNS - FULLWORD-HALFWORD FIXED CONSTANTS ***' 09404000 +**--> CSECT: CFHCNS 1-2 PROCESS FULLWORD-HALFWORD CONSTANTS . . . . . 09406000 +*. USES DSECTS: AVWXTABL . 09407000 +*. USES MACROS: $RETURN,$SAVE . 09407500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09408000 +CFHCNS CSECT 09410000 + $DBG A0,SNAP 09412000 + USING AVWXTABL,RAT NOTE MAIN USING 09414000 + ENTRY CFHCN1,CFHCN2 09416000 + SPACE 2 09418000 +**--> ENTRY: CFHCN1 1 SCAN CONST, DO NOT ASSEMBLE . . . . . . . . . 09420000 +*. ENTRY CONDITIONS . 09422000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 09424000 +*. EXIT CONDITIONS . 09426000 +*. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 09428000 +*. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 09430000 +*. RB = NONZERO VALUE FOR ERROR CODE - INVALID CONSTANT - ($ERINVCN) . 09432000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09434000 +CFHCN1 $SAVE RGS=(R1-R2),SA=NO 09436000 + SPACE 1 09438000 +* INITIALIZE, CHECK FOR LEADING SIGN. **NOTE** THIS * 09440000 +* ROUTINE DOES NOT PERMIT DECIMAL POINTS INSIDE CONSTANTS. * 09442000 + SR R1,R1 CLEAR FOR ADDRESS INSERT 09444000 + CLI 0(RA),C'+' PLUS SIGN CHECK 09446000 + BE CFH1INC GO BUMP SCAN POINTER IF SO 09448000 + CLI 0(RA),C'-' MUST BE MINUS SIGN 09450000 + BNE CF1TRT SKIP IF NOT ASIGN 09452000 +CFH1INC LA RA,1(RA) INCR SCAN POINTER PAST + OR - 09454000 + SPACE 1 09456000 +* SCAN DECIMAL DIGITS, MAKE SURE THERE'S AT LEAST 1. 09458000 +CF1TRT TRT 0(11,RA),AWTDECT SCAN FOR DELIMITER 09460000 + BZ CFH1BIG BRANCH IF TOO BIG 09462000 + SR R1,RA GET NUMBER OF CHARS 09464000 + BZ CFH1INVC NO DIGITS, SO INVLAID, LIKE F'' 09466000 + SPACE 1 09468000 + AR RA,R1 GET POINTER BACK 09470000 + SR RB,RB CLEAR TO SHOW OK 09472000 +CFH1RET $RETURN RGS=(R1-R2),SA=NO 09474000 + SPACE 1 09476000 +CFH1INVC LA RB,$ERINVCN INVALID CONSTANT ERROR 09478000 + B CFH1RET GO RETUN 09480000 +CFH1BIG EQU CFH1INVC TOO BIG, USE JUST INVALID MESSAGE 09482000 + EJECT 09484000 +**--> ENTRY: CFHCN2 2 ASSEMBLE F OR H CONST . . . . . . . . . . . . 09486000 +*. ENTRY CONDITIONS . 09488000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 09490000 +*. RB = LENGTH-1 OF 1 CONSTANT OF 1 OPERAND TO BE ASSEMBLED . 09492000 +*. EXIT CONDITIONS . 09494000 +*. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 09496000 +*. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 09498000 +*. RB = NONZERO VALUE FOR ERROR CODE - INVALID CONSTANT - ($ERINVCN) . 09500000 +*. RC = ADDRESS OF PROPERLY ASSEMBLED CONSTANT . 09502000 +*. **NOTE** - THIS ROUTINE WILL ASSEMBLE VALUES INTO F OR H * 09504000 +*. CONSTANTS OF LENGTH 1-8, BUT THE VALUE OF ANY CONSTANT MUST * 09506000 +*. BE OF SIZE TO FIT INTO 1 FULLWORD, I.E. THE OTHER FULLWORD * 09508000 +*. MUST EITHER BE ALL 0'S OR ALL 1'S (BINARY). . * 09510000 +*. **NOTE** IT IS POSSIBLE FOR THIS ROUTINE TO CAUSE A FIXED PT * 09512000 +*. OVERFLOW, WHICH WILL CAUGHT AND LAGGED BY SPIE MONITOR IN * 09514000 +*. MAIN PROGRAM MPCON0. * 09516000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09518000 +CFHCN2 $SAVE RGS=(R1-R2),SA=NO 09520000 + SPACE 1 09522000 +* INITIALIZE. CHECK SIGN, KAE CFH2SIG EITHR LR OR LCR. 09524000 + SR R1,R1 CLEAR FOR ADDRESS INSERTION 09526000 + MVI CFH2SIG+1,X'FF' ASSUME + SIGN WILL OCCUR 09528000 + CLI 0(RA),C'0' IS THERE NO SIGN 09530000 + BNL CFH2TRT NO SIGN-BRANCH 09532000 + CLI 0(RA),C'+' PLUS SIGN CHECK 09534000 + BE CFH2INC BRANCH IF SO 09536000 + MVI CFH2SIG+1,X'FD' SET TO SHOW MINUS 09538000 +CFH2INC LA RA,1(RA) BUMP PAST SIGN 09540000 + SPACE 1 09542000 +* SCAN CONSTANT, CONVERT TO BIANRY FORM. 09544000 +CFH2TRT TRT 0(11,RA),AWTDECT GO FOR DELIMITER 09546000 + SR R1,RA GET DIFFERENCE=#OF DIGITS 09548000 + BCTR R1,0 DECREMENT FOR LENGTH-1 09550000 + EX R1,CFH2PACK PACK THE NUMBER 09552000 +CFH2SIG NI AVDWORK1+7,$ CHANGE SIGN TO SHOW + (F) OR - (D) 09553000 + CVB RD,AVDWORK1 CONVERT THE VALUE 09554000 + SPACE 1 09556000 +* GIVE CONSTANT RIGHT SIGN, STORE IT, POINT TO IT. 09558000 + SRDA RD,32 MAKE CONSTANT A DOUBLE WORD- 09562000 + STM RD,RE,AVCONBLD STORE IN BUILDING AREA 09564000 + LCR RB,RB MAKE LENGTH-1 NEGATIVE-GET OFFSET 09566000 + LA RC,AVCONBLD+7(RB) GET START ADDR OF DESIRED CONST 09568000 + SR RB,RB SHOW THE CONSTANT IS OK 09570000 + LA RA,1(R1,RA) GET SCAN POINTER TO ENDING ' , 09572000 +CFH2RET $RETURN RGS=(R1-R2),SA=NO 09574000 + SPACE 1 09576000 +CFH2PACK PACK AVDWORK1,0(0,RA) PACK DECIMAL STRING 09578000 + DROP RAT,REP CLEAN UP USING 09580000 + TITLE '*** CNDTL2 - CONSTANT PROCESSOR CONTROL - PASS 2 ***' 09582000 +**--> CSECT: CNDTL2 2 CONSTANT PROCESSOR CONTROL - PASS 2 . . . . . 09584000 +*. ENTRY CONDITIONS . 09586000 +*. RB = NUMBER OF CONSTANT CONTROL BLOCKS TO BE PROCESSED . 09588000 +*. RC = ADDRESS OF FIRST OR ONLY CNCBLOCK TO BE DONE . 09590000 +*. CALLS CACON2,CBCON2,CCCON2,CDECN2,CFHCN2,CPCON2,CVCON2,CXCON2. 09592000 +*. CALLS CZCON2,ERRTAG,OUTPT2,UTPUT2 . 09594000 +*. USES DSECTS: AVWXTABL,CNCBLOCK . 09594100 +*. USES MACROS: $ALIGR,$CALL,$GLOC,$GTAD,$RETURN,$SAVE . 09594200 +*. USES MACROS: $SCPT,$SLOC . 09594300 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09596000 +CNDTL2 CSECT 09598000 + $DBG A0,SNAP 09600000 +* * * * * REGISTER ALLOCATION AND USAGE FOR CNDTL2 * * * * * * * * * * 09602000 +* R0 = # CONSTANTS REMAINING TO BE DONE IN CURRENT CNCBLOCK(CNCNUM) * 09604000 +* R1 = LENGTH-1 OF CONSTANT(S) IN INDIVIDUAL OPERAND, (FROM CNCLEN) * 09606000 +* ALSO USED AS BYTE REGISTER, 3 HI-ORD* BYTES=0 * 09608000 +* R2 = DUPLICATION FACTOR FOR CONSTANT OPERAND ( FROM CNCDUP) * 09610000 +* RW = @ CURRENT CNCBLOCK BEING PROCESSED. * 09612000 +* RX = @ AREA FOR BUILDING UP MULTIPLE CONSTANTS (AVCONBL2) * 09614000 +* RY = @ SPECIFIC CONSTANT PASS 2 ROUTINE * 09616000 +* RZ = CURRENT TOTAL LENGTH OF ASSEMBLED CONSTANTS (MULTIPLE OPRNDS)* 09618000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 09620000 + SPACE 1 09622000 + USING AVWXTABL,RAT 09624000 + $SAVE RGS=(R14-R6),BR=R13,SA=CNDTSAVE 09626000 + SPACE 1 09628000 +* INITIALIZEREGISTERS, COUNTERS. ENTER CODE LOOP. 09630000 + SR R0,R0 CLEAR FOR INSERIONS 09632000 + SR R1,R1 CLEAR FOR INSERTIONS 09634000 + LR RW,RC MOVE @ 1ST OR ONLY CNCBLOCK OVER 09636000 + USING CNCBLOCK,RW NOTE POINTER 09638000 + MVC CNDOCNT,AWHM1 =H'-1' = 6-1 OF BYTES FOR PRINTING 09640000 + B CNDAA1 ENTR RIGHT SPOT TO BEGIN 09642000 + SPACE 1 09644000 +* CNDA IS ENTERED 1 TIME FOR EACH OPERAND AFTER FIRST * 09646000 +CNDA LH R15,CNCTOT GET TOTAL LENGTH OF LAST CONSTANT 09648000 + A R15,AVLOCNTR ADD LOCATION COUNTER 09650000 + LA RW,CNC$LEN(RW) INCREMENT CNCBLOCK POINTER TO NEXT 09652000 + TM CNCTYP,$CNALN DOES NEW OPERAND REQUIRE ALIGNMENT 09654000 + BZ CNDNOLN NO,SKIP ALIGNING THE LOCCNTR 09656000 + IC R1,CNCLEN GET L-1 OF CONST(NOTE R1 BYTE REG) 09658000 + $ALIGR R15,(R1) ALIGN LOCATION COUNTER 09660000 +CNDNOLN $SLOC R15 RESET LOCATION COUNTER 09662000 + SPACE 1 09664000 +* CNDAA1 IS ENTERED 1 TIME FOR EACH CNCBLOCK PROCESSED. * 09666000 +CNDAA1 STH RB,CND#CNCS SAVE CURRENT # CNCBLOCKS TO BE DONE 09668000 +CNDAA $SCPT RA,CNCSCAN CONVERT OFFSET TO ACTUAL @ PTR 09670000 + IC R1,CNCTYP GET TYPE BYTE 09672000 + N R1,AWF15 REMOVE LEADING BITS 09674000 + IC R1,AWCONADS(R1) GET OFFSET TO PASS 1 CONSTANT SUBR 09682000 + $GTAD RY,C$BASE+4(R1) GET @ PASS 2 CONSTANT ROUTINE 09684000 + IC R0,CNCNUM GET # OF CONSTANTS IN THIS OPERAND 09686000 + IC R1,CNCLEN GET THE LENGTH-1 OF EACH CONSTANT 09688000 + LA RX,AVCONCAT SET UP @ OF BUILDING AREA 09690000 + SR RZ,RZ CLEAR THE TOTAL LENGTH BUILT UP 09692000 + EJECT 09694000 +* CNDBB ENTERED ONCE FOR EACH CONSTANT IN EACH OPERAND * 09696000 +CNDBB LR RB,R1 MOVE LENGTH-1 OVER FOR CALL TO ROUTI 09698000 + LR REP,RY MOVE @ ROUTINE OVER 09700000 + BALR RET,REP CALL THE ROUTINE 09702000 + TM CNCTYP,$CNERR SHOULD WE TEST RB FOR ERRORS 09704000 + BZ CNDNERR SKIP IF NO TEST NEEDED 09706000 + LTR RB,RB WAS THERE AN ERROR 09708000 + BZ CNDNERR SKIP IF NO ERROR 09710000 + SPACE 1 09712000 +* ERROR FOUND IN PASS 2. FLAG IT,PRINT STMT, AND QUIT. * 09714000 + $CALL ERRTAG HAVE ERROR FLAGGED 09716000 + B CNDRETA RETURN TO CALLER 09718000 + SPACE 1 09720000 +CNDNERR EQU * 09722000 + LA RE,0(RX,RZ) GET @ WHERE NEXT CODE TO GO 09730000 + LA RZ,1(R1,RZ) INCREM TOTAL LENGTH BY NEW AMOUNT 09732000 + CLI CNCNUM,1 WAS THERE ONLY 1 CONSTANT(LIKELY) 09734000 + BE CNDPRNT1 SKIP TO SIMPLE CASE IF SO 09736000 + STC R1,*+5 STORE L-1 INTO NEXT INST 09738000 + MVC 0($CHN,RE),0(RC) MOVE CODE OVER 09740000 + LA RA,1(RA) BUMP THE SCAN POINTER TO NEXT OPERAN 09742000 + BCT R0,CNDBB GO BACK FOR NEXT CONSTANT IN OPERAND 09744000 + SPACE 1 09746000 +* FALL THRU AFTER ASSEMBLING 2 OR MORE CONSTS IN 1 OPRND.* 09748000 + LR RC,RX MOVE @ ASSEMBLED CONSTANT OVER 09750000 +CNDPRNT1 BCTR RZ,0 DECREMENT TOTAL LENGTH TO L-1 09752000 + LH R2,CNCDUP GET DUPLICATION FACTOR 09754000 + LTR R2,R2 TEST (MAX VAL FOR DUPL=X'7FFF') 09756000 + BZ CNDLOOP2 SKIP REST IF ZERO DUPLICATION FACTOR 09758000 + SPACE 1 09760000 +* ACCUMULATE ENOUGH BYTES FOR PRINTING, IF NOT ALREADY. * 09762000 + LH RA,CNDOCNT GET LENGTH-1 CUR›ENTLY READY 09764000 + LA R15,6 FOR COMPARISON A(D LIMIT VALUE 09766000 + CR RA,R15 IS THERE ENOUGH ALREADY 09768000 + BH CNDUTPUT BRANCH OUT IF ALREADY ENOUGH 09770000 + SPACE 1 09772000 + LA R14,1 FOR BXLE INCREME(T 09774000 + SR RD,RD INIT FOR INDEX I(TO ASSEMBLED CONT 09776000 + LR RE,R2 DUPLICATE DUPLIC"ATION FACTOR,>0 09778000 + B CNDLC ENTER LOOP APPRO&RIATELY 09780000 + SPACE 1 09782000 +* LOOP TO ACCUMULATE PRINTING CODE, 1 BYTE AT TIME. 09784000 +CNDLA AR RD,R14 INCREMENT WITHIN CONSTANT PTR TO NXT 09786000 + CR RD,RZ HAVE WE REACHED END OF CONST 09788000 + BNH CNDLC NO,KEEP GOING 09790000 + SR RD,RD END OF CONST,CLEAR TO BEGIN AGAIN 09792000 + SR RE,R14 DECREMENT TEMPORARY DUPLICATION FAC 09794000 + BNP CNDLE QUIT IF RUN OUT OF DUPLFAC 09796000 + SPACE 1 09798000 +CNDLC IC RB,0(RD,RC) GET 1 BYTE OF CONSTANT OPERAND 09800000 + STC RB,CNDOCOD+1(RA) STORE FOR PRINTING 09802000 + BXLE RA,R14,CNDLA LOOP UNTIL HAVE 8 BYTES OR RUN OUT 09804000 + SPACE 1 09806000 +CNDLE STH RA,CNDOCNT STORE BACK THE UPDATED PR COUNT 09808000 + EJECT 09810000 +* CALL UTPUT2 TO DUPLICATE AND LOAD OBJECT CODE * 09812000 +CNDUTPUT EQU * 09814000 + LR RE,R2 MOVE DUPLICATION FACTOR OVER 09818000 + $GLOC RA GET LOCATION COUNTER FOR CODE 09820000 + LR RD,RZ TOTAL L-1 OF CODE(NOT CNTING DUPL) 09822000 + $CALL UTPUT2 HAVE OBJECT CODE LOADED,DUPLICATED 09824000 + SPACE 1 09826000 +* LOOP BACK FOR NEXT OPERAND, IF >1 WAS USED. 09828000 +CNDLOOP2 LH RB,CND#CNCS GET # CNCBLOCKS LEFT TO DO 09830000 + BCT RB,CNDA GET NEXT OPERAND (UNLIKELY) 09832000 + SPACE 1 09834000 +CNDRETA EQU * INSERT $DALLOCH CODE LATER 09836000 + LA RB,$OUCONS SHOW WE WANT LOCATION COUNTER 09838000 + LA RC,CNDOCOD GET @ OF CODE TO BE PRINTED 09840000 + LH RD,CNDOCNT GET LENGTH-1 OF CONST TO PRINT 09842000 + $CALL OUTPT2 HAVE STMT PRINTED 09844000 +CNDRET $RETURN RGS=(R14-R6) 09846000 + SPACE 1 09870000 +* * * * * INTERNAL VARIABLES * 09872000 +CND#CNCS DS H # CNCBLOCKS TO BE PROCESSED (U=1) 09874000 +CNDOCNT DS H FOR LENGTH-1 OF CODE TO PRINT 09876000 +CNDOCOD DS D AREA TO BUILD UP PRINTED CODE 09878000 + DROP RAT,R13,RW KILL USINGS 09882000 + TITLE '*** CODTL1 - SCAN DUPL FAC,TYPE,LENGTH,CONST-PASS1 ***' 09884000 +**--> CSECT: CODTL1 1 SCAN DUPFAC,TYPE,LENGTH-CALL C ROUTINES . . . 09886000 +*. ENTRY CONDITIONS . 09888000 +*. RA = SCAN POINTER TO DUPLICATION FACTOR OR CONSTANT TYPE . 09890000 +*. RB = 0 CONSTANT IS IN A DEFINE STORAGE STMT . 09892000 +*. RB = 4 CONSTANT IS IN A DC STATEMENT . 09894000 +*. RB = 8 CONSTANT IS A LITERAL - (I.E. DUPLFAC ^= 0, DECIMALS) . 09896000 +*. EXIT CONDITIONS . 09898000 +*. RA = SCAN POINTER TO DELIMITER FOLLOWING CONSTANT . 09900000 +*. RB = 0 LEGAL SPECIFICATION OF CONSTANT . 09902000 +*. RB = NONZERO VALUE - ERROR CODE - ILLEGAL . 09904000 +*. RC = ADDRESS OF A CONSTANT CONTROL BLOCK . 09906000 +*. RE = TOTAL LENGTH OF OPERAND,INCLUDING MULTIPLE OPERANDS,IF ANY . 09908000 +*. CALLS CACON1,CBCON1,CCCON1,CDECN1,CFHCN1,CPCON1,CVCON1,CXCON1. 09910000 +*. CALLS CZCON1,EVALUT,SDDTRM . 09912000 +*. USES DSECTS: AVWXTABL,CONBLK . 09914000 +*. USES MACROS: $CALL,$GTAD,$RETURN,$SAVE,$SCOF,CONG 09916000 +* NOTE RESTRICTIONS - DUPLICATION FACTOR AND TOTAL LENGTH MUST * 09922000 +* BOTH BE ABLE TO FIT IN HALFWORD EACH. LENGTH MAY BE GREATER * 09924000 +* THAN 256 FOR A DS,BUT LENGTH ATTRIBUTE WILL NOT BE CORRECT * 09926000 +*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 09927000 + SPACE 1 09928000 +CODTL1 CSECT 09929000 + $DBG A0,SNAP 09929500 +* * * * * REGISTER ALLOCATION FOR CODTL1 * * * * * * * * * * * * * * * 09930000 +* R0 = 0 ==> PROCESSING DS, = 4 ==> PROCESSING DC STATEMENT. * 09932000 +* = 8 ==> LITERAL CONSTANT, I.E. REQUIRE DECIMAL MODIFIERS. * 09934000 +* R1 = 1 USED TO BUMP SCAN POINTER IN BXH'S,ETC. * 09936000 +* R2 = ADDRESS OF CONSTANT BLOCK ENTRY (CONBLK),AFTER TYPE FOUND * 09938000 +* RW = LENGTH-1 OF OPERAND BEING PROCESSED.IMPLIED OR SPECIFIED. * 09940000 +* RX = NUMBER OF CONSTANTS IN THE OPERAND * 09942000 +* RY = DUPLICATION FACTOR OF THE OPERAND * 09944000 +* RZ USED AS LINK OR WORK REGISTER * 09946000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 09948000 + SPACE 1 09950000 + USING AVWXTABL,RAT NOTE MAIN USING 09952000 + $SAVE RGS=(R14-R6),BR=R13,SA=COSAVE 09954000 + SPACE 1 09956000 +* INITIALIZATION OF REGISTERS, CONSTANT BLOCK, FLAGS. 09958000 + LR R0,RB SAVE R0=0==>DS,R0=4==>DC 09960000 + SR RB,RB SHOW NO ERRORS AT BEGINNING 09962000 + LA R1,1 HANDY CONSTANT 09964000 + LR RY,R1 SET DEFAULT DUPLICATION FACTOR=1 09966000 + LM R2,R4,AWZEROS ZERO POINTER REG,LENGTH,#OF CONSTS 09968000 + STM R2,R3,COBLK ZERO OUT BLOCK 09970000 + MVI CODXLEN+1,0 INITIALIZE TO NO EXPLICIT LENGTH 09972000 + SPACE 1 09974000 +* BEGIN PROCESSING OF DUPLICATION FACTOR, IF PRESENT. 09976000 + BAL R14,CODNUM GO GET DUPLICATION FACTOR 09978000 + B CODLOOK NO DUPLICATION FACTOR,SKIP 09980000 + SPACE 1 09982000 +* DUPLICATION FACTOR EXPLICIT-CHECK IT,MOVE TO RY. * 09984000 + C RC,AWFX7FFF =XL4'7FFF' COMPARE TO MAX SIZE LEGAL 09986000 + BH CODEDUPL BRANCH IF TOO BIG 09988000 + LTR RY,RC MOVE FACTOR OVER AND TEST 09990000 + BNZ CODLOOK BRANCH IF DEFINITELY LEGAL 09992000 + C R0,AWF7 0 DUPLICATION FACTOR, IS IT LITERL 09994000 + BNL CODEDUPL BRANCH - 0 DUPLFAC IN LITERAL -ERROR 09996000 + SPACE 1 09998000 +* CHECK TYPE FOR LEGALITY. GET ADDR OF CONBLK ENTRY. * 10000000 +CODLOOK CLI 0(RA),C'A' MAKE SURE LEGITAMATE 10002000 + BL CODERTYP NO,IT IS AN ERROR 10004000 + IC R2,0(RA) GET THE TYPE CODE 10006000 + IC R2,CODINXO(R2) GET OFFSET INTO CONTABL ENTRIES 10008000 + LTR R2,R2 IS THE TYPE LEGAL 10010000 + BZ CODERTYP NO,ERROR 10012000 + SPACE 1 10014000 + LA R2,CONTAB1(R2) GET ACTUAL ADDRESS OF RIGHT ENTRY 10016000 + USING CONBLK,R2 NOTE DUMMY SECT FOR CONTABL ENTRY 10018000 + MVC COTYP,CONTYP MOVE TYPE+FLAGS OVER 10020000 + AR RA,R1 INCREMENT SCAN POINT BEYOND TYPE 10022000 + SPACE 1 10024000 +* CHECK FOR EXPLICIT LENGTH SPECIFICATION,EVAL IT IF SO. * 10026000 + CLI 0(RA),C'L' IS THERE A LENGTH SPECIFICATION 10028000 + BNE CODEFAL NO,USE DEFAULT LENGTH 10030000 + EJECT 10032000 +* LENGTH EXPLICITLY SUPPLIED - PROCESS IT,NOTE NO ALIGN. * 10034000 + AR RA,R1 INCREMENT SCAN POINTER TO BEYOND L 10036000 + BAL R14,CODNUM GO GET LENGTH 10038000 + B CODINVD INVALID DELIMITER OR SOMETHING 10040000 +CODEDL LR RW,RC MOVE LENGTH OVER 10042000 + SR RW,R1 DECREMENT TO LENGTH-1 10044000 + NI COTYP,255-$CNALN WIPE OUT ALIGNMENT FLAG,IF ANY 10046000 + MVI CODXLEN+1,X'F0' MAKE NOP A BRANCH-EXPLICIT LENGTH 10048000 + SPACE 1 10050000 +* CHECK EXPLICIT LENGTH FOR BEEING IN RIGHT RANGE. 10052000 + SR RD,RD CLEAR REG FOR INSERT 10054000 + IC RD,CONLLW GET LOWEST LIMIT VALUE 10056000 + CR RW,RD IS LENGTH TOO LOW 10058000 + BL CODLBAD ILLEGAL LENGTH 10060000 + IC RD,CONLHI GET HIGH LIMIT ON LENGTH-1 10062000 + CR RW,RD COMPARE TO SEE IF HIGH 10064000 + BNH CODCONGO THE LENGTH IS IN RANGE 10066000 + LTR R0,R0 IS THIS IN A DS 10068000 + BNZ CODEBIG NO,IT IS DC, THEREFORE ILLEGAL 10070000 + SPACE 1 10072000 +* NOTE C & X DC'S MAY EXCEED NORMAL 256 LENGTH LIMIT. 10074000 + CLI CONTYP,$CNVLN+$CNC IS IT C TYPE 10076000 + BE CODCONGO YES,SO IT IS OK 10078000 + CLI CONTYP,$CNVLN+$CNX IS IT HEX CONST 10080000 + BE CODCONGO YES,SO ITS OK 10082000 + B CODEBIG NO,IT IS TOO LARGE,SINCE NOT X OR C 10084000 + SPACE 1 10086000 +CODEFAL IC RW,CONLEN GET DEFALUT LENGTH-1 10088000 +* HAVE GOTTEN DUPFAC-TYPE-LENGTH,NOW SCAN FOR CONSTANT. * 10090000 +CODCONGO CLI 0(RA),C' ' CHECK,IS THIS THE END 10092000 + BE *+12 SKIP NEXT 2 INSTS==> NO OPERAND 10094000 + CLI 0(RA),C',' CHECK FOR , AFTER LENGTH 10096000 + BNE CODOPR NO,THERE'S STILL MORE 10098000 + LTR R0,R0 IF FIELD OMITTED,MUST BE DS 10100000 + BNZ CODEOMOP OMITTED OPERAND IN DC==>ERROR 10102000 + BXLE RX,R1,CODFIN SET # OEPRANDS = 1 AND BRANCH 10104000 + SPACE 1 10106000 +* GET ADDRESS OF APPROPRIATE PASS 1 CONSTANT SUB&CALL IT * 10108000 +CODOPR CLC 0(1,RA),CONLD IS THE LEFT DELIMITER OK 10110000 + BNE CODINVD NO IT ISNT-BRANCH TO ERROR 10112000 + AR RA,R1 BUMP SCAN POINTER TO 1ST CHAR OF CON 10114000 + IC RD,CONTYP GET TYPE VALUE 10116000 + N RD,AWFXF =XL4'F' WIPE OUT FLAG BITS FROM NIBL 10118000 + IC RD,AWCONADS(RD) GET OFFSET TO ADDR OF TYPE 10120000 + $GTAD R0,C$BASE(RD) GET @ PASS 1 ROUTINE - C#CON1 10122000 + $SCOF R15,RA,COSCAN GET THE OFFSET AND SAVE IT 10124000 + EJECT 10126000 +* CONSTANT TYPE KNOWN. CALL ROUTINE TO PROCESS IT. * 10128000 +CODCALL LR REP,R0 MOVE ADDRESS OV ROUTIN OVER 10130000 + BALR RET,REP CALL THE ROUTINE 10132000 + LTR RB,RB WAS THERE AN ERROR 10134000 + BNZ CODRETA YES,RETURN WITH THE RROR 10136000 + AR RX,R1 INCREMENT THE # OF OPERANDS 10138000 + CLC 0(1,RA),CONRD IS DELIM THE RIGHT DELIM 10140000 + BE CODCONA YES,THIS IS END OF OPERAND 10142000 +* THE FOLLOWING TAKES CARE OF MULTIPLE OPERANDS WHERE OK * 10144000 + CLI 0(RA),C',' IS DELIMITER RIGHT 10146000 + BNE CODINVD NO,IT IS BAD DELIMITER 10148000 + TM COTYP,$CNMUL ARE MULTIPLE DELIMS ALLOWED 10150000 + BZ CODINVD SKIP IF THEY AREN'T ERROR 10152000 + BXH RA,R1,CODCALL BUMP SCAN POINTER AND CALL ROUTINE 10154000 + SPACE 1 10156000 +* HAVE PROCESSED WHOLE OPERAND. CHECK FOR OVERRIDE LENGTH* 10158000 +CODCONA AR RA,R1 INCREMENT SCAN POINTER 10160000 +CODXLEN BC $CHN,CODFIN BRANCH IF LENGTH EXPLICIT,NOP IFNOT 10162000 + TM COTYP,$CNVLN WAS LENGTH VARIABLE,ALLOWING OVERD 10164000 + BZ CODFIN NO,LEAVE THE LENGTH ALONE 10166000 + LR RW,RC MOVE THE RETURNED LENGTH OVER 10168000 + SR RW,R1 DECREMENT BY 1 TO GET CONSISTENT 10170000 + SPACE 1 10172000 +* STORE FLAGS INTO COBLK. COMPUTE TOTAL LENGTH INTO RE * 10174000 +CODFIN STC RX,CONUM STORE NUMBER OF OPERANDS 10176000 + STC RW,COLEN SAVE THE LENGTH-1 OF OPERAND 10178000 + LTR RE,RY MOVE OVER AND TEST DUPL FACTOR 10180000 + BZ CODRETA YES,0 DUP FACTOR-0 EVERYTHING 10182000 + STH RY,CODUP STORE A NONZERO DUPLICATION FACTOR 10184000 + BAL R14,*+6 SKIP 1ST AR AND GO TO BCTR 10186000 + AR RE,RY ADD DUPLFAC TO SLEF 10188000 + BCTR RX,R14 LOOP ON NUMBER OF CONSTANTS IN OPRND 10190000 +* DUPLICATION FACTOR * NUMBER OF OPERANDS IS IN RE * 10192000 + CR RE,R1 IS DUP FAC*#OPERANDS =1 10194000 + BNE CODMULT IF NOT,GIVE UP AND MULTIPLY 10196000 + LA RE,1(RW) MOVE THE LENGTH OVER&ADD 1 10198000 + B CODSTOR HAVE LENGTH SAVED AND QUIT 10200000 +CODMULT AR RW,R1 INCREMENT LENGTH-1 TO LENGTH 10202000 + MR RD,RW MULTIPLY TO GET TOTL LENGTH 10204000 +CODSTOR STH RE,COTOT SAVE THE TOTAL LENGTH 10206000 + CL RE,AWFX7FFF MAKE SURE WHOLE LENGTH NOT TOO BIG 10208000 + BH CODEBIG TOTAL LENGTH IS TOO BIG 10210000 +* POINT AT THE COBLK AND RETURN * 10212000 +CODRETA LA RC,COBLK SHOW ADDRESS OF OUR CODE BLOCK 10214000 +CODRET $RETURN RGS=(R14-R6) 10216000 + EJECT 10218000 +* * * * * CODNUM - CALLED TO EVALUATE DUPLICATION FACTOR OR LENGTH - * 10220000 +* RETURNS 0(R14) IF EXPRESSION OMITTED. RETURNS TO 4(R14) IF OK* 10222000 +* RC HAS VALUE OF EXPRESSION * 10224000 +CODNUM LA RZ,4(R14) SET UP GOOD RETURN FOR SECTIONS 10226000 + CLI 0(RA),C'0' DO WE HAVE DECIMAL NUMBER 10228000 + BNL CODECAL YES,DECIMAL NUMBER,GO CONVERT 10230000 + CLI 0(RA),C'(' EITHER EXPRESSION,OR OMITTED 10232000 + BCR NE,R14 RETURN IF IT WAS OMITTED 10234000 + SPACE 1 10236000 +* IF FALLS THRU==>EXPRESSION,ENCLOSED IN PARENS. EVALUATE* 10238000 + C R0,AWF7 ARE WE IN LITERAL 10240000 + BH CODESYNT YES, ILLEGAL DUPLFAC OR LENGTH 10242000 + AR RA,R1 BUMP SCAN POINTER PAST 1ST ( 10244000 + $CALL EVALUT 10246000 + LTR RB,RB CHECK FOR ERROR 10248000 + BNZ CODRET RETURN WITH ERROR CODE IF SO 10250000 + LTR RD,RD WAS IT RELOCATABLE 10252000 + BNZ CODNEABS RELOCATABLE RELOCATION FACTOR,ERROR 10254000 + CLI 0(RA),C')' SEE IF THIS WAS END 10256000 + BNE CODINVD INVALID DELIMITER IF NOT 10258000 + BXH RA,R1,0(RZ) INCREMENT SCAN POINTER PAST ) AND BR 10260000 + SPACE 1 10262000 +* DUPLFAC OR LENGTH WAS DECIMAL NUMBER. GET ITS VALUE * 10264000 +CODECAL $CALL SDDTRM GET DECIMAL SELF-DEFINING TERM 10266000 + LTR RB,RB WAS THERE AN ERROR 10268000 + BCR Z,RZ RETURN IF THE NUM WAS OK 10270000 + B CODRET RETURN WITH ERROR CODE IN RB 10272000 + SPACE 1 10274000 +* * * * * INDIVIDUAL ERROR CODE SECTIONS * 10276000 +CODERTYP LA RB,$ERCNTYP UNKNOWN TYPE OF CONSTANT 10278000 + B CODRET RETURN SHOWING ERROR 10280000 +CODEOMOP LA RB,$ERNOOPR MISSING OPERAND(CONSTANT) 10282000 + B CODRET RETURN SHOWING ERROR 10284000 +CODEBIG LA RB,$EREXGTA NUMBER OR EXPRESSION TOO LARGE 10286000 + B CODRET RETURN SHOWING ERROR 10288000 +CODLBAD LA RB,$EREXLTA NUMBER OR EXPRESSION TOO SMALL P 10290000 + B CODRET RETURN SHOWING ERROR 10292000 +CODINVD LA RB,$ERINVDM INVALID DELIMITER 10294000 + B CODRET RETURN,SHOWING ERROR CODE 10296000 +CODNEABS LA RB,$ERNEABS ABSOLUTE EXPRESSION REQUIRED 10298000 + B CODRET RETURN 10300000 +CODESYNT LA RB,$ERVSYNT SYNTAX - ILLEGAL () IN LITERAL 10302000 + B CODRET RETURN 10304000 +CODEDUPL LA RB,$ERDUPLF ILLEGAL DUPLICATION FACTOROR 10306000 + B CODRET RETURN 10308000 + EJECT 10310000 +* * * * * INTERNAL CONSTANTS * 10312000 +CODINX DC XL(256-C'A')'0' CONSTANT INDEX TABLE 10314000 +CODINXO EQU CODINX-C'A' GET SYMBOL WITH OFFSET 10316000 +CONTABL EQU * BEGINNING OF CONSTANT DESCRIPTOR TAB 10318000 +CONTAB1 EQU CONTABL-1 GET OFFSET SYMBOL SO OFFSETS NOT ZER 10320000 + CONG A,$CNALN+$CNMUL,4,LD='(',RD=')',HI=4 10322000 + CONG B,$CNVLN,1,HI=256,E=0 10324000 + CONG C,$CNVLN,1,HI=256,E=0 10326000 + CONG D,$CNALN+$CNMUL,8 10328000 + CONG E,$CNALN+$CNMUL,4 10330000 + CONG F,$CNALN+$CNMUL,4 10332000 + CONG H,$CNALN+$CNMUL,2 10334000 + CONG P,$CNVLN+$CNMUL,1,HI=16,E=0 10336000 + CONG V,$CNALN+$CNMUL,4,LD='(',RD=')',LW=3,HI=4 10338000 + CONG X,$CNVLN,1,HI=256,E=0 10340000 + CONG Z,$CNVLN+$CNMUL,1,HI=16,E=0 10342000 + LTORG 10344000 + SPACE 1 10346000 +* * * * * INTERNAL VARIABLES * 10348000 +* * * * * COBLK AREA - SET UP LIKE CNCBLOCK FOR CONSTANT CODES * 10350000 +COBLK DS 0D INTERNAL CONSTANT BLOCK LIKE CNCBLK 10352000 +COTYP DS C TYPE + FLAGS 10354000 +COLEN DS C LENGTH-1 OF CONSTANT OPERAND 10356000 +COSCAN DS C SCAN POINTER OFFSET TO START OF CONS 10358000 +CONUM DS C NUMBER OF OPERANDS IN CONSTANT 10360000 +CODUP DS H DUPLICATION FACTOR 10362000 +COTOT DS H TOTAL LENGTH OF CONSTANT 10364000 + SPACE 1 10366000 +**--> DSECT: CONBLK CONSTANT DESCRIPTOR CODES BLOCK(CODTL1) . . . . 10366100 +*. THIS BLOCK CONTAINS DATA FOR A GIVEN CONSTANT TYPE, AND IS . 10366200 +*. USED BY ASSEMBLER SUBR. CODTL1 IN SCANNING CONSTANTS AND . 10366300 +*. BUILDING CNCBLOCKS DURING ASSEMBLY PASS 1. THE DATA . 10366400 +*. GIVEN INCLUDES A FLAG BYTE, DEFAULT LENGTH-1, LEFT AND . 10366500 +*. RIGHT DELIMITER CHARACTERS REQUIRED FOR THE CONSTANT, AND . 10366600 +*. MINIMUM AND MAXIMUM VALUES FOR THE LENGTH-1 OF THE CONSTANT. . 10366700 +*. THE FLAG BYTE, WITH MODIFICATIONS, BECOMES THE CNCTYPE BYTE . 10366800 +*. OF THE CNCBLOCK CREATED FOR EACH CONSTANT OPERAND. . 10366900 +*. LOCATION: TABLE CONTABL OF CSECT CODTL1 . 10367000 +*. GENERATION: 1 CALL TO MACRO CONG CREATES A CONBLK ENTRY. . 10367100 +*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10367200 + SPACE 1 10368000 +CONBLK DSECT 10370000 +CONTYP DS C CONSTANT TYPE+ FLAGS 10372000 +CONLEN DS C DEFAULT LENGTH 10374000 +CONLD DS C LEFT DELIMITER 10376000 +CONRD DS C RIGHT DELIMITER 10378000 +CONLLW DS C LOWEST VALUE OF LENGTH-1 10380000 +CONLHI DS C HIGHEST VALUE OF LENGTH-1 10382000 + DROP RAT,R13,R2 CLEAN UP USING 10384000 + TITLE '*** CPCONS - PACKED DECIMAL CONSTANTS ***' 10386000 +**--> CSECT: CPCONS 1-2 PROCESS PACKED CONSTANTS. . . . . . . . . . . 10388000 +*. USES DSECTS: AVWXTABL . 10389000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10390000 +CPCONS CSECT 10392000 + $DBG A0,SNAP 10394000 + ENTRY CPCON1,CPCON2 PASS 1 AND 2 ENTRIES 10396000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 10398000 + SPACE 2 10400000 +**--> ENTRY: CPCON1 1 SCAN,DO NOT ASSEMBLE PACKED CONSTATNT . . . . 10402000 +*. ENTRY CONDITIONS . 10404000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 10406000 +*. EXIT CONDITIONS . 10408000 +*. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 10410000 +*. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 10412000 +*. RB = NONZERO VALUE FOR ERROR CODE - INVALID CONSTANT - ($ERINVCN) . 10414000 +*. RC = NUMBER OF BYTES REQUIRED FOR CONSTANT . 10416000 +*. USES MACROS: $RETURN,$SAVE . 10417500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10418000 +CPCON1 $SAVE SA=NO 10420000 + SR RC,RC CLEAR FOR USE AS FLAG 10422000 + LA RD,32 (MAX # DIGITS IN CONST) + 1 AS LIMIT 10424000 + LA RE,1 FOR INCREMENTING AND DECREMENTING 10426000 + CLI 0(RA),C'+' IS THERE A + SIGN NEXT 10428000 + BE CP1LOOP YES,BRANCH TO INCREMENT SCAN PTR 10430000 + CLI 0(RA),C'-' IS IT - SIGN 10432000 + BNE *+6 SKIP BUMPING SCAN PTR IF SO 10434000 + SPACE 1 10436000 +CP1LOOP AR RA,RE BUMP SCAN POINTER BY 1 10438000 + CLI 0(RA),C'0' IS NEXT CHAR A DIGIT 10440000 + BL CP1NODIG BRANCH IF NOT - SOME PUNCTUATION 10442000 + BCT RD,CP1LOOP DIGIT-DECREMENT LIMIT COUNTER,BRANCH 10444000 + B CP1INVCN INVALID (TOO LONG) 10446000 + SPACE 1 10448000 +CP1NODIG CLI 0(RA),C'.' WAS NON-DIGIT A PERIOD 10450000 + BNE CP1QUOT NO,MUST BE ENDING ' OR , 10452000 + BXLE RC,RE,CP1LOOP SET RC=1, BRANCH BACK IF 1ST TIME 10454000 +CP1INVCN LA RB,$ERINVCN 2 PERIODS, OR OTHER ERROR 10456000 + B CP1RET GO RETURN WITH ERROR MESSAGE 10457000 + SPACE 1 10458000 +CP1QUOT CLI 0(RA),C'''' WAS ENDING MARK A QUOT 10460000 + BE CP1DONE YES,OK,BRANCH 10462000 + CLI 0(RA),C',' WERE MULTIPLE OPS USED 10464000 + BNE CP1INVCN INVALID (PROBABLY DELIMITER) 10466000 + SPACE 1 10468000 +CP1DONE SR RB,RB SHOW NO ERRRORS 10470000 + LA RC,32 (MAX # DIGITS + 1) FOR SUBTRCT 10472000 + SR RC,RD SUBTRACT COUNTER = ACTUAL # DIGITS 10474000 + BZ CP1INVCN IF 0 DIGITS, QUIT - NULL CONTSNAT 10475000 + SRA RC,1 SHIFT TO GET # OF BYTES REQUIRED 10476000 + AR RC,RE HAD # BYTES - 1, NOW GET # BYTES 10478000 +CP1RET $RETURN SA=NO 10482000 + EJECT 10484000 +**--> ENTRY: CPCON2 1-2 SCAN AND ASSEMBLE P TYPE CONSTANT . . . . . . 10486000 +*. ENTRY CONDITIONS . 10488000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 10490000 +*. RB = LENGTH-1 OF 1 CONSTANT OF 1 OPERAND TO BE ASSEMBLED . 10492000 +*. EXIT CONDITIONS . 10494000 +*. RA = SCAN POINTER TO DELIMITER ENDING SCAN . 10495000 +*. RC = ADDRESS OF PROPERLY ASSEMBLED CONSTANT . 10496000 +*. USES MACROS: $RETURN,$SAVE,$SETRT . 10497000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10498000 +CPCON2 $SAVE RGS=(R1-R2),SA=NO 10500000 + MVC AVCONBLD(16),AWZEROS ZERO OUT WORK AREA 10502000 + LA RC,AVCONBLD(RB) @ LAST BYTE OF ASSEMBLED CONSTANT 10504000 + LA RE,1 FOR INCREMENTING,DECREMENTING 10506000 + AR RB,RE RB = ACTUAL # OF BYTES DESIRED 10508000 + SR R1,R1 CLEAR FOR INSERTION OF ADDRESS 10510000 + $SETRT ('''',1,',',1) SET UP TABLE FOR SCANNING 10512000 + TRT 1(32,RA),AWTZTAB SIGN+PERIOD+31 DIGS-1 = 32 MAX LEN 10514000 + $SETRT ('''',0,',',0) RESET TABLE TO ZEROS 10516000 + MVI CP2BRNCH+1,0 MAKE BRANCH A NOOP INITIALLY 10518000 + LA RD,X'F0' MASK FOR REMOVING ZONE NIBBLES 10520000 + MVI 0(RC),X'C' INIT SIGN TO A PLUS SIGN 10522000 + CLI 0(RA),C'+' WAS PLUS THERE 10524000 + BE CP2LOAD YES,SKIP 10526000 + CLI 0(RA),C'-' WAS MINUS THERE 10528000 + BNE CP2LOAD NO,MUST BE DIGIT OR PERIOD 10530000 + MVI 0(RC),X'D' PLACE DECIMAL MINUS SIGN IN CONST 10532000 +CP2LOAD LR RA,R1 DUPLICATE @ ENDING PUNCTUATION 10534000 + SR R1,RE BACK POINTER UP TO LAST DIG IN CONST 10536000 + SPACE 1 10538000 +CP2NUMBR CLI 0(R1),C'0' ARE WE LOOKING AT DIGIT 10540000 + BL CP2NODIG NOT DIGIT-BRANCH 10542000 + IC R2,0(R1) GET THE DIGIT 10544000 +CP2BRNCH BC $CHN,CP2EVEN COMMUTATOR - B(EVEN) NOOP(ODD) 10546000 + SLL R2,4 ODD DIGIT - GET INTO LEFT NIBBLE 10548000 + STC R2,*+5 PLACE INTO OI INSTRUCTION FOLLOWING 10550000 + OI 0(RC),$CHN WILL OR IN 1 NIBBLE TO CONSTANT 10552000 + SR RC,RE BACK POINTER UP,HAVE FINISHED THIS 1 10554000 + BCT RB,CP2FLIP DECREMENT COUNTER,BRANCH IF MORE 10556000 + B CP2RETA HAVE DONE REQUIRED # - NOW RETURN 10558000 + SPACE 1 10560000 +CP2EVEN SLR R2,RD REMOVE THE ZONE NIBBLE FROM DIGIT 10562000 + STC R2,0(RC) STORE THE NUMERIC INTO CONSTNT 10564000 +CP2FLIP XI CP2BRNCH+1,X'F0' FLIP COMMUTATOR SWITCH/EVEN/ODD 10566000 +CP2DECR BCT R1,CP2NUMBR DECREM SCN PTR, BRANCH ALWAYS 10568000 + SPACE 1 10570000 +CP2NODIG CLI 0(R1),C'.' WAS NON-DGIT THE PERIOD 10572000 + BE CP2DECR YES,DECREM SCAN PTR AND GET NEXT 10574000 + SPACE 1 10576000 +CP2RETA LA RC,AVCONBLD SHOW @ OF CONSTT,WITH L-PAD ZEROS 10578000 +CP2RET $RETURN SA=NO,RGS=(R1-R2) 10580000 + DROP RAT,REP KILL USINGS 10582000 + TITLE '*** CVCONS - V-TYPE ADDRESS CONSTANT PROCESSING ***' 10584000 +**--> CSECT: CVCONS 1-2 PROCESS V-TYPE ADCONS . . . . . . . . . . . . 10586000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10588000 +CVCONS CSECT 10590000 + $DBG A0,SNAP 10592000 + USING AVWXTABL,RAT NOTE MAIN USING 10594000 + ENTRY CVCON1,CVCON2 10596000 + SPACE 2 10598000 +**--> ENTRY: CVCON1 1 SCAN V-TYPE CONST, NO ASSEMBLE. . . . . . . . 10600000 +*. ENTRY CONDITIONS . 10602000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 10604000 +*. EXIT CONDITIONS . 10606000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 10608000 +*. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 10610000 +*. RB = NONZERO VALUE - ILLEGAL SYMBOL ($ERINVSY) . 10612000 +*. USES DSECTS: AVWXTABL . 10613000 +*. USES MACROS: $RETURN,$SAVE . 10613500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10614000 +CVCON1 $SAVE RGS=(R1-R2),SA=NO 10616000 + SR R1,R1 CLEAR FOR ADDRESS INSERT 10618000 + TRT 0(9,RA),AWTSYMT SCAN FOR SYMBOL DELIMITER 10620000 + BZ CVC1ERR ERROR IF NOT FOUND 10622000 + CLI 0(RA),C'0' IS 1ST CHAR LETTER 10624000 + BNL CVC1ERR NO-ERROR BRANCH 10626000 + CR R1,RA MAKE SURE NOT NULL 10628000 + BE CVC1ERR NULL ERROR-BRANCH 10630000 + SR RB,RB SHOW OK 10632000 + LR RA,R1 MOVE SCAN POINTER OVER 10634000 +CVC1RET $RETURN RGS=(R1-R2),SA=NO 10636000 +CVC1ERR LA RB,$ERINVSY INVALID SYMBOL 10638000 + B CVC1RET RETURN 10640000 + EJECT 10642000 +**--> ENTRY: CVCON2 2 SCAN&ASSEMBLE VCON. . . . . . . . . . . . . . 10644000 +*. ENTRY CONDITIONS . 10644500 +*. RA = SCAN POINTER TO FIRST CHARACTER OF VCON. . 10645000 +*. EXIT CONDITIONS . 10645500 +*. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 10646000 +*. RB = 0 ==> NO ERRORS, NONZERO ==> ERROR CODE . 10648000 +*. = NONZERO ERROR CODE ($ERUNRV OR $ERRELOC). . 10650000 +*. RC = ADDRESS OF PROPERLY ASSEMBLED CONSTANT . 10652000 +*. CALLS SYFIND . 10654000 +*. CALLS RESYMB (ONLY IF &$REPL=2 AND EXTRN SYMBOL USED). . 10654500 +*. USES DSECTS: AVWXTABL,SYMSECT . 10655000 +*. USES MACROS: $CALL,$RETURN,$SAVE . 10655500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10656000 +CVCON2 $SAVE RGS=(R14-R2),BR=R13,SA=CVCOSAVE 10658000 + LR R0,RB SAVE LENGTH-1 OF SSEMBLY 10660000 + SR R1,R1 CLEAR FOR ADDRESS INSERT 10662000 + TRT 0(9,RA),AWTSYMT SCAN SYMBOL 10664000 + LR RB,R1 MOVE SCAN POINTER TO END BACK 10666000 + SR RB,RA GET LENGTH OF SYMBOL 10668000 + $CALL SYFIND LOOK UP SYMBOL 10670000 + LTR RB,RB WAS IT FOUND 10672000 + BNZ CVCONUNR UNRESOLVED REFERENCE 10674000 + SPACE 1 10676000 + USING SYMSECT,RA NOTE USING 10678000 + AIF (&$REPL LT 2).CVNREPL SKIP IF NO REPL CALLS 10679000 + TM SYFLAGS,$SYEXT WAS IT FLAGGED EXTRN 10679050 + BZ CVC2NOEX NO, SO SKIP CALLING CODE 10679100 + L R15,CVRESYMB GET =V(RESYMB) 10679150 + BALR R14,R15 CALL HIM 10679200 + LTR RB,RB WAS NAME LEGITAMATE 10679250 + BZ CVC2VAL YES, RESYMB PUT VALUE INTO TABLE 10679300 + B CVCONUNR NO, SO EXTRN, THUS UNRESOLVED 10679350 +CVRESYMB DC V(RESYMB) SYMBOL CHECKING MODULE 10679400 +CVC2NOEX EQU * BRANCH HERE IF NOT EXTRN SYMBOL 10679450 +.CVNREPL ANOP 10679500 + SPACE 1 10679550 + TM SYFLAGS,$SYDEF IS IT DEFINED 10680000 + BZ CVCONUNR NO, UNDEFINED, UNRESOLVED 10682000 + TM SYFLAGS,$SYENT+$SYCSE IS IT EITHER CSECT OR ENTR 10684000 + BZ CVCONUNR NO-ERROR 10686000 +* CHECK TO SEE IF SYMBOL WAS A DSECT SYMBOL. 10688000 + TM SYESDID,$ESDSECT WAS IT A DSECT 10688200 + BZ CVC2VAL NO, OK, BRANCH 10688400 + LA RB,$ERRELOC SHOW ERROR NOT ALLOWED 10688600 + B CVC2RETA EXIT WITH ERROR 10688800 +CVC2VAL LCR RE,R0 NEGATIVE OF LENGTH-1 FOR OFFSET 10690000 + LA RC,SYVALUE+3(RE) GET ACTUAL STARTIN @ OF CONSTANT 10692000 + SPACE 1 10694000 +CVC2RETA LR RA,R1 MOVE SCAN POINTER BACK 10696000 +CVC2RET $RETURN RGS=(R14-R2) 10698000 +CVCONUNR LA RB,$ERUNRV UNRESOLVED EXTERNAL REFERENCE 10700000 + B CVC2RETA RETURN 10702000 + DROP RAT,RA,R13 REMOVE USINGS 10708000 + TITLE '*** CXCONS - SCAN AND/OR ASSEMBLE HEX CONSTANTS ***' 10710000 +**--> CSECT: CXCONS 1-2 PROCESS HEXADECIMAL CONSTANTS . . . . . . . . 10712000 +*. USES DSECTS: AVWXTABL . 10713000 +*. USES MACROS: $RETURN,$SAVE . 10713500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10714000 +CXCONS CSECT 10716000 + $DBG A0,SNAP 10718000 + ENTRY CXCON1,CXCON2 10720000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 10722000 + SPACE 2 10724000 +**--> ENTRY: CXCON1 1 SCAN HEX CONST, DO NOT ASSEMBLE . . . . . . . 10726000 +*. ENTRY CONDITIONS . 10728000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 10730000 +*. EXIT CONDITIONS . 10732000 +*. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 10734000 +*. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 10736000 +*. RB = NONZERO VALUE FOR ERROR CODE - INVALID CONSTANT - ($ERINVCN) . 10738000 +*. RC = NUMBER OF BYTES REQUIRED FOR CONSTANT . 10740000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10742000 +CXCON1 $SAVE RGS=(R1-R2),SA=NO 10744000 + SR R1,R1 CLEAR FOR INSERTION OF ADDRESS HERE 10746000 + TRT 0(256,RA),AWTHEXT SCAN AND CHECL CHARACTERS 10748000 + CLI 0(R1),C'''' DELIMITER MUST BE A ' 10750000 + BNE CX1ERR IF NOT,IT IS ERROR 10752000 + LA RC,1(R1) GET END POINTER +1 10754000 + SR RC,RA GET # OF HEX DIGITS+1 10756000 + SRA RC,1 DIVIDE BY 2 FOR NUMBER OF BYTES 10758000 + BZ CX1ERR NULL CONST==> ERROR BRANCH 10760000 + SR RB,RB CLEAR REG TO SHOW A LEGAL CONST 10762000 +CX1RETA LR RA,R1 GET SCAN POINTER OVER 10764000 +CX1RET $RETURN RGS=(R1-R2),SA=NO 10766000 +CX1ERR LA RB,$ERINVCN INVALID CONST (OR ILLEGAL DELIM) 10768000 + B CX1RETA GO RETURN 10770000 + EJECT 10772000 +**--> ENTRY: CXCON2 1-2 ASSEMBLE HEX CONSTANT . . . . . . . . . . . . 10774000 +*. ENTRY CONDITIONS . 10776000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 10778000 +*. RB = LENGTH-1 OF 1 CONSTANT OF 1 OPERAND TO BE ASSEMBLED . 10780000 +*. EXIT CONDITIONS . 10782000 +*. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 10784000 +*. RC = ADDRESS OF PROPERLY ASSEMBLED CONSTANT . 10786000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10788000 +CXCON2 $SAVE RGS=(R0-R2),SA=NO 10790000 + SR R1,R1 CLEAR FOR TRT 10792000 + SR R2,R2 CLEAR FOR LATER INSERTS 10794000 + STC RB,*+5 STORE LENGTH-1 INTO MVC 10796000 + MVC AVCONBLD($CHN),AWZEROS ZERO, IN CASE PADDING 10798000 + L RC,AWFM1 GET =F'-1' FOR DECREMENT 10800000 + TRT 0(256,RA),AWTHEXT SCAN FOR ENDING ' 10802000 + MVI CX2EVOD+1,X'F0' SET UP BRANCH FOR ODD 1ST TIME 10804000 + LA RD,0(RC,R1) GET @ LAST DIGIT OF CONST 10806000 + SR RD,RA GET NUMBER OF HEX DIGITS IN CONST 10808000 + SPACE 1 10810000 +CX2HGET IC R2,0(RD,RA) GET THE NEXT HEX DIGIT 10812000 +CX2EVOD BC $CHN,CX2ODD BRANCH IF ODD (FROM RIGHT END) 10814000 + IC RE,AWTHEX2(R2) GET VALUE OF THE BYTE 10816000 + SLL RE,4 SHIFT IT OVER 10818000 + ALR RE,R0 ADD ODD BYTE TO THE EVEN ONE 10820000 + STC RE,AVCONBLD(RB) STORE COMPLETED BYTE IN PLACE 10822000 + BXH RB,RC,CX2FLIP DECREMENT REMAIN COUNT 10824000 + B CX2RETA BRANCH IF EXACT OR TRUNCATION P 10826000 + SPACE 10828000 +CX2ODD IC R0,AWTHEX2(R2) GET THE VALUE OF THE DIGIT 10830000 +CX2FLIP XI CX2EVOD+1,X'F0' SWITH B ODD, NOOP EVEN & VICE VRSA 10832000 + BXH RD,RC,CX2HGET DECREMENT DIGITS REAMINING,LOOP 10834000 + SPACE 1 10836000 +* FALLS THRU ==> MAY BE ODD # DIGITS,STORE LAST IF SO * 10838000 + CLI CX2EVOD+1,X'F0' WAS LAST DIGIT DONE AN EVEN ONE 10840000 + BE *+8 YES,SO DON'T STORE ODD ONE 10842000 + STC R0,AVCONBLD(RB) STORE INTO POSITION 10844000 +CX2RETA LA RC,AVCONBLD SHOW @ CONSTANT 10846000 + LR RA,R1 SHOW SCAN PTR TO DELIMITING ' 10848000 +CX2RET $RETURN RGS=(R0-R2),SA=NO 10850000 + DROP RAT,REP CLEAN UP USING 10852000 + LTORG 10854000 + TITLE '*** CZCONS - ZONED DECIMAL CONSTANTS ***' 10856000 +**--> CSECT: CZCONS 1-2 PROCESS ZONED CONSTS. . . . . . . . . . . . . 10858000 +*. USES DSECTS: AVWXTABL . 10859000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10860000 +CZCONS CSECT 10862000 + $DBG A0,SNAP 10864000 + ENTRY CZCON1,CZCON2 10866000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 10868000 + SPACE 2 10870000 +**--> ENTRY: CZCON1 1 SCAN, BUT DO NOT ASSEMBLE . . . . . . . . . . 10872000 +*. ENTRY CONDITIONS . 10874000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 10876000 +*. EXIT CONDITIONS . 10878000 +*. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 10880000 +*. RB = 0 CONSTANT WAS LEGAL, NO ERRORS . 10882000 +*. RB = NONZERO VALUE FOR ERROR CODE - INVALID CONSTANT - ($ERINVCN) . 10884000 +*. RC = NUMBER OF BYTES REQUIRED FOR CONSTANT . 10886000 +*. USES MACROS: $RETURN,$SAVE . 10887500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10888000 +CZCON1 $SAVE SA=NO 10890000 + SR RC,RC CLEAR FLAG FOR # OF PERIODS 10892000 + LA RD,17 (MAX @ DIGITS) +1 10894000 + LA RE,1 FOR INCREMENTING AND DECREMENTING 10896000 + CLI 0(RA),C'+' IS THERE PLUS SIGN 10898000 + BE CZ1LOOP YES,GO BUMP SCAN PTR 10900000 + CLI 0(RA),C'-' IS THERE MINUS 10902000 + BNE *+6 SKIP IF NOT 10904000 + SPACE 1 10906000 +CZ1LOOP AR RA,RE BUMP SCAN PTR BY 1 10908000 + CLI 0(RA),C'0' IS NEXT CHAR A DIGIT 10910000 + BL CZ1NODIG BRANCH IF NO DIGIT 10912000 + BCT RD,CZ1LOOP DECREMENT LIMIT,BRANCH IF OK 10914000 + B CZ1INVCN GO FLAG (TOO MANY DIGITS) 10916000 + SPACE 1 10918000 +CZ1NODIG CLI 0(RA),C'.' WAS NONDIGIT A PERIOD 10920000 + BNE CZ1QUOT NO,MUST BE ' OR , 10922000 + BXLE RC,RE,CZ1LOOP SET RC=1,BRANCH IF FIRST TIME 10924000 + B CZ1INVCN 2 PERIODS - ERROR - BRANCH 10926000 + SPACE 1 10928000 +CZ1QUOT CLI 0(RA),C'''' WAS DELIMITER ' 10930000 + BE CZ1DONE YES,QUIT 10932000 + CLI 0(RA),C',' WAS DELIMITER , 10934000 + BNE CZ1INVCN INVALID CONSTANT 10936000 + SPACE 1 10938000 +CZ1DONE SR RB,RB SHOW NO ERROR 10940000 + LA RC,17 (MAX @ DIGITS+1) 10942000 + SR RC,RD GET ACTUAL # BYTES REQUIRED 10944000 + BNZ CZ1RET BRANCH IF LEGAL (NONZERO) LENGTH 10946000 +CZ1INVCN LA RB,$ERINVCN SHOW INVALID CONSTANT 10948000 +CZ1RET $RETURN SA=NO 10950000 + EJECT 10952000 +**--> ENTRY: CZCON2 1-2 SCAN AND ASSEMBLE Z-TYPE CONSTANT . . . . . . 10954000 +*. ENTRY CONDITIONS . 10956000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHAR AFTER PREVIOUS DELIMETER) . 10958000 +*. RB = LENGTH-1 OF 1 CONSTANT OF 1 OPERAND TO BE ASSEMBLED . 10960000 +*. EXIT CONDITIONS . 10962000 +*. RA = SCAN POINTER (ADDRESS OF DELIMITER STOPPING SCAN, OR ERROR) . 10964000 +*. RC = ADDRESS OF PROPERLY ASSEMBLED CONSTANT . 10966000 +*. USES MACROS: $RETURN,$SAVE,$SETRT . 10967500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 10968000 +CZCON2 $SAVE SA=NO,RGS=(R1-R2) 10970000 + MVI AVCONBLD,C'0' SET UP FOR PUTTING ZEROES 10972000 + MVC AVCONBLD+1(14),AVCONBLD PROPAGATE DECIMAL 0'S 10974000 + LA RC,AVCONBLD(RB) @ LAST BYTE OF CONSTANT 10976000 + LA RE,1 HANDY CONST FOR INCREM-DECREM 10978000 + AR RB,RE RB = # OF BYTES REQUIRED 10980000 + LR RD,RC SAVE @ LAST BYTE FOR SIGN LATER 10982000 + SR R1,R1 CLEAR FOR @ INSERTION 10984000 + $SETRT ('''',1,',',1) SET UP TABLE FOR SCAN 10986000 + TRT 1(17,RA),AWTZTAB SCAN TO ENDING DELIMITER 10988000 + $SETRT ('''',0,',',0) ZERO TABLE OUT AGAIN 10990000 + MVI CZ2SIGN+1,255-X'CF' SET UP FOR + SIGN 10992000 + CLI 0(RA),C'+' IS THERRE A PLUS SIGN 10994000 + BE CZ2LOAD YES,BRANCH 10996000 + CLI 0(RA),C'-' IS THERE MINUS 10998000 + BNE CZ2LOAD NO,BRANCH 11000000 + MVI CZ2SIGN+1,255-X'DF' SET UP FOR MINUS SIGN 11002000 +CZ2LOAD LR RA,R1 DUPLICATE PTR TO ENDING PUNCTUATION 11004000 + SR R1,RE BACK UP PTR TO LAST DIGIT 11006000 + SPACE 1 11008000 +CZ2NUMBR CLI 0(R1),C'0' ARE WE LOOKING AT DIGIT 11010000 + BL CZ2NODIG BRANCH IF NOT DIGIT 11012000 + MVC 0(1,RC),0(R1) MOVE DIGIT TO CONSTANT 11014000 + SR RC,RE DECREMENT CONSTANT POINTER 11016000 + SR R1,RE DECREMENT SCAN POINTER 11018000 + BCT RB,CZ2NUMBR DECREMENT,BRANCH IF MORE NEEDED 11020000 + B CZ2RETA BRANCH TO RETURN 11022000 + SPACE 1 11024000 +CZ2NODIG CLI 0(R1),C'.' WAS THIS PERIOD 11026000 + BNE CZ2RETA NO,SO MUST BE ENDING ' OR , - BRANCH 11028000 + BCT R1,CZ2NUMBR DECREM SCAN PTR,BACK FOR NEXT DIGIT 11030000 + SPACE 1 11032000 +CZ2RETA LA RC,AVCONBLD SHOW @ OF ASSEMBLEE CONSTANT 11034000 +CZ2SIGN XI 0(RD),$CHN CREAT RIGHT SIGN IN ZONE OF LAST BYT 11036000 +CZ2RET $RETURN SA=NO,RGS=(R1-R2) 11038000 + DROP RAT,REP KILL USINGS 11040000 + TITLE '*** ERRORS - ERROR FLAGGING AND POINTER SETUP ***' 11042000 +**--> CSECT: ERRORS 1-2 ERROR FLAGGING ROUTINES . . . . . . . . . . . 11044000 +*. ENTRY CONDITIONS . 11046000 +*. RA = SCAN POINTER TO CAUSE OF ERROR . 11048000 +*. RB = ERROR CODE . 11050000 +*. EXIT CONDITIONS . 11052000 +*. RA,RB ARE UNCHANGED BY ERRTAG OR ERRLAB . 11054000 +*. USES DSECTS: AVWXTABL,RSBLOCK . 11055000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11056000 +ERRORS CSECT 11058000 + $DBG 80,SNAP NOTE WE WANT TO SEE ALL ERRS 11060000 + ENTRY ERRTAG,ERRLAB 11062000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 11064000 + SPACE 2 11066000 +**--> ENTRY: ERRTAG FLAG ERROR AT SCAN POINTER POSITION . . . . . 11068000 +*. ENTRY CONDITIONS-EXIT CONDITIONS - SEE CSECT ERRORS . 11068500 +*. USES MACROS: $RETURN,$SAVE,$SCOF . 11069000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11070000 +ERRTAG $SAVE SA=NO 11072000 + L RE,AVRSBPT GET ADDR OV RECORD SOURCE BLOCK 11074000 + USING RSBLOCK,RE NOTE USING 11076000 + TM RSBFLAG,$REBX DOES A RECORD ERROR BLOCK EXIST 11078000 + BO ERREBEX REB ALREADY EXISTS 11080000 + OI RSBFLAG,$REBX FLAG==>REB EXISTS,THERE ARE ERROR(S) 11082000 + DROP RE NO LONGET USING 11084000 + MVI AVREBLN,0 INITIALIZE TO LENGTH-1 OF 0 11086000 +ERREBEX CLI AVREBLN,$ERREBMX*L'AVREBES CHECK IF MORE ROOM 11088000 + BNL ERRTRET NO MORE ROOM-RETURN 11090000 + SR RD,RD CLEAR FOR INSERT TO FOLLOW 11092000 + IC RD,AVREBLN GET THE CURRENT LENGTH-1 OF REB 11094000 + $SCOF RE,RA,AVREBSCN(RD) 11096000 + STC RB,AVREBERR(RD) PLACE ERROR CODE IN ALSO 11098000 + LA RD,L'AVREBES(RD) INCREMENT COUNTER 11100000 + STC RD,AVREBLN PLACE NEW VALUE INTO COUNTER AREA 11102000 + $DBG ,NO DON'T NEED TO SEE GOING OUT 11104000 +ERRTRET $RETURN SA=NO 11106000 + SPACE 2 11108000 +**--> ENTRY: ERRLAB FLAG ERROR FOR A LABEL. . . . . . . . . . . . 11110000 +*. ENTRY CONDITIONS-EXIT CONDITIONS - SEE CSECT ERRORS . 11110500 +*. CALLS ERRTAG . 11111000 +*. USES MACROS: $CALL,$RETURN,$SAVE . 11111500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11112000 +ERRLAB $SAVE RGS=(R14-R0),SA=NO 11114000 + LR R0,RA SAVE THE REAL SCAN POINTER 11116000 + L RE,AVRSBPT GET POINTER TO RECORD SOURCE BLOCK 11118000 + USING RSBLOCK,RE NOTE THE USING 11120000 + LA RA,RSBSOURC MAKE A FAKE POINTER TO LABEL 11122000 + DROP RE NOTE NO LONGER USING 11124000 + $CALL ERRTAG CALL FLAGGING SECTION 11126000 + USING ERRTAG,REP NOTE CHANGED USING 11128000 + LR RA,R0 RETURN REAL SCAN POINTER 11130000 +ERRLRET $RETURN RGS=(R14-R0),SA=NO 11132000 + DROP RAT,REP CLEAN UP USING 11134000 + TITLE '*** ESDOPR - EXTERNAL SYMBOL DICTIONARY ***' 11136000 +**--> CSECT: ESDOPRS 1-2 EXTERNAL SYMBOL DICTIONARY&ESDID OPERATIONS . 11138000 +*. THIS MODULE HANDLES ALL FLAGGING AND CHECKING OF SECTION . 11138500 +*. AND EXTERNAL ATTRIBUTES, INCLUDING FLAGGING SYMBOL TABLE . 11139000 +*. ENTRIES AND MANIPULATING LOCATION COUNTERS AND SECTION IDS. . 11139500 +*. USES DSECTS: AVWXTABL,SYSMSECT . 11139600 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11140000 +ESDOPR CSECT 11142000 + $DBG 90,* 11144000 + ENTRY ESINT1,ESCSEC,ESENX1,ESENX2 11146000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 11148000 + SPACE 1 11150000 +**--> ENTRY: ESINT1 INITIALIZATION . PASS 1 . . . . . . . . . . . 11152000 +*. THIS SECTION FOR COMPLETENESS, FUTURE USE. DOES NOTHING 8/70.. 11153000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11154000 +ESINT1 $SAVE SA=NO 11156000 +* ***** FUTURE USE - DOES NOTHING AT PRESENT TIME.************** 11158000 +ESINRET $RETURN SA=NO 11160000 + SPACE 1 11162000 +**--> ENTRY: ESCSEC DECLARE A CONTROL SECTION OR DUMMY SECTION. . 11164000 +*. ENTRY CONDITIONS . 11166000 +*. RB = 0 ==> CSECT . 11168000 +*. = 2 ==> DSECT . 11170000 +*. = 4 ==> START . 11172000 +*. RC = VALUE TO BE USED TO SET LOCATION COUNTER(START ONLY,RB=4) . 11174000 +*. EXIT CONDITIONS . 11176000 +*. RB = 0 ==> NO ERRORS. ^=0 ==> AN ERROR CODE TO BE SET . 11178000 +*. RB = NONZERO VALUE - ERROR CODE - ($ERDPCSE) . 11180000 +*. AVCESDID IS INCREMENTED BY 1 OR 2 FOR NEXT VALUE OF REQUIRED TYPE. 11180500 +*. I.E. CSECTS HAVE EVEN VALUES, DSECTS ODD ONES. . 11180700 +*. LOCATION COUNTERS ARE MODIFIED (AVLOCHIH,AVLOCNTR). . 11181000 +*. USES MACROS: $ALIGR,$AL2,$GLOC,$RETURN,$SAVE,$SLOC . 11181500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11182000 +ESCSEC $SAVE SA=NO 11184000 + L RE,AVLABPT GET POINTER TO LABEL ENTRY 11186000 + LTR RE,RE WAS THER A STMT LABEL 11188000 + BNZ ESCSLAB RE = @ SYMBOL TABLE ENTRY,BRANCH 11190000 + TM AVTAGS1,$IBPRCD1 HAS PRIVATE CODE OCCURRED 11192000 + BO ESCSERPC ERROR-RESUMPTION OF PRIVATE CODE 11194000 + OI AVTAGS1,$IBPRCD1 FLAG THAT PRIVATE CODE HAS NOW OCCUR 11196000 + AIF (NOT &$MACROS).ESNOMA1 SKIP IF NO MACROS 11196500 + MVC AVSYSECT,AWBLANK SET &SYSECT FOR USE OF MEXPND 11197000 +.ESNOMA1 ANOP 11197500 + B ESCSINCR GO BUMP ESDID 11198000 + SPACE 1 11200000 + USING SYMSECT,RE NOTE SYMBOL TABLE USING 11202000 +ESCSLAB TM SYFLAGS,$SYDEF HAS SYMBOL BEEN DEFINED ALREADU 11204000 + BO ESCSERPC ERROR-RESUMPTION OF CONTROL SECT 11206000 + AIF (NOT &$MACROS).ESNOMA2 SKIP IF NO MACRO EXPANDSER 11206200 +* SET UP &SYSECT FOR MACRO EXAPNDER MEXPND. 11206400 + MVC AVSYSECT,AWBLANK BLANK OUT SECTION NAME 11206600 + MVC *+7(1),SYCHARS MOVE LEN-1 INTO NEXT INSTR 11206800 + MVC AVSYSECT($),SYMBOL MOVE SYMBOL OVER, NOW RIGHT-PADDED 11207000 +.ESNOMA2 ANOP 11207400 +ESCSINCR SR RD,RD CLEAR FOR INSERTION 11208000 + IC RD,AVCESDID GET CURRENT ESDID 11210000 + LA RD,2(RD) INITIALLY INCREMENT BY 2 FOR NEXT 11212000 + STC RD,AVCESDID REPLACE UPDATED SECTION ID 11214000 + LH RB,ESCSJUMP(RB) GET OFFSET TO ROUTINE 11216000 +ESCSJ B ESCSJ(RB) TAKE BRANCH TO RIGHT SECTION 11218000 + SPACE 1 11220000 +* * * * * PROCESS CSECT STATEMENT * 11222000 +ESCSECT TM AVTAGS1,$IBDSEC1 ARE WE IN DSECT CURRENTLY 11224000 + BZ ESCSCS NO WE AREN'T,SKIP 11226000 + NI AVTAGS1,255-$IBDSEC1 REMOVE DSECT FLAG 11228000 + L RC,AVLOCHIH GET HIGHEST LOCATION COUNTER VALUE 11230000 + B ESCSTAG GO TO FLAG SYMBOL TABLE ENTRY 11232000 + SPACE 1 11234000 +ESCSCS $GLOC RC GET CURRENT LOCATION COUNTER 11236000 + C RC,AVCSHIH COMPARE TO HIGHEST IN CSECT 11238000 + BNL ESCSTAG GO TO TAG IF HIGHEST VALUE IN RC 11240000 + L RC,AVCSHIH ORG *-X MUST HAVE OCCURED-GET HIGHES 11242000 + EJECT 11244000 +* * * * * COMMON CODE FOR START AND CSECT * 11246000 +ESCSTART EQU * 11248000 +ESCSTAG LTR RE,RE WAS THERE A SYMBOL 11250000 + BZ ESCSDBL SKIP TO ALIGN IF NO SYMBOL 11252000 + OI SYFLAGS,$SYCSE NOTE SYMBOL IS A CSECT 11254000 +ESCSDBL LA RD,7 SET UP FOR D ALIGNING 11256000 + $ALIGR RC,RD ALIGN VALUE TO DOUBLEWORD 11258000 + NI AVCESDID,255-$ESDSECT FLAG AS A CSECT, EVEN VALUE 11259000 + B ESCSETL GO SET LOCATION COUNTER,ETC. 11260000 + SPACE 1 11262000 +* * * * * ESCSDSEC - PROCESS DSECT * 11264000 +ESCSDSEC SR RC,RC CLEAR FOR VALUE TO SET LOCATION COUN 11266000 + OI SYFLAGS,$SYDSE FLAG SYMBOL WITH DSECT 11268000 + OI AVCESDID,$ESDSECT MAKE SURE ODD, I.E. DSECT 11269000 + TM AVTAGS1,$IBDSEC1 ARE WE ALREADY IN DSECT 11270000 + BO ESCSETL GO SET LOCCNTR IF ALREADY IN DSECT 11272000 + L RD,AVCSHIH GET HIGH IN CURRENT CSECT 11274000 + C RD,AVLOCNTR IS IT HIGHER THAN LOCATION COUNTER 11276000 + BNL *+8 SKIP IF VALUE IN RD IS HIGH 11278000 + L RD,AVLOCNTR GET LOCATION COUNTER-IT IS HIGH 11280000 + ST RD,AVLOCHIH SAVE THIS AS HIGHEST VALUE YET ENCOU 11282000 + OI AVTAGS1,$IBDSEC1 NOTE THAT WE ARE NO WIN DSECT 11284000 + SPACE 1 11286000 +ESCSETL $SLOC RC SET NEW LOCATON COUNTER VALUE 11288000 + LR RD,RC DUPLICATE VALUE OVER FOR SETTING UP 11290000 + STM RC,RD,AVCSLOW STORE VALUE INTO AVCSLOW-AVCSHIH 11292000 + SR RB,RB SHOW NO ERRORS 11294000 +ESCSRET $RETURN SA=NO 11296000 +ESCSERPC LA RB,$ERDPCSE ILLEGAL CSECT RESUMPTION 11298000 + B ESCSRET RETURN 11300000 + SPACE 1 11302000 +* JUMP OFFSET TABLE FOR 3 TYPES OF CALLS TO ESCSEC * 11304000 +ESCSJUMP $AL2 ESCSJ,(ESCSECT,ESCSTART,ESCSDSEC) 11306000 + DROP RE CLEAR USING 11308000 + EJECT 11310000 +**--> ENTRY: ESENX1 ENTRY AND EXTRN STATEMENTS- PASS 1. . . . . . 11312000 +*. ENTRY CONDITIONS . 11314000 +*. RA = SCAN POINTER . 11316000 +*. RB = 0 ==> ENTRY . 11318000 +*. = 2 ==> EXTRN . 11320000 +*. EXIT CONDITIONS . 11322000 +*. RA = SCAN POINTER TO BLANK FOLLOWING OPERAND FIELD, OR ERROR . 11324000 +*. RB = 0 ==> NO ERRORS. ^= 0 ==> ERROR CODE TO BE SET . 11326000 +*. RB = NONZERO VALUE - ERROR CODE - ($ERINVDM,$ERINVSY) . 11328000 +*. ALL LABEL'S IN STMT HAVE SYMSECTS FLAGGED APPROPRIATELY. . 11329000 +*. CALLS SYENT1 . 11330000 +*. USES MACROS: $CALL,$GTAD,$RETURN,$SAVE . 11331000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11332000 +ESENX1 $SAVE SA=ESDOSAVE,RGS=(R14-R6),BR=RW 11334000 + LA RZ,ESNX1RET SHOW @ FOR RETURN FROM ERROR 11336000 + MVI ESENXF+1,$SYENT PLACE THIS INTO FLAGGING INST 11342000 + LTR RB,RB WAS THIS CALL FOR ENTRY 11344000 + BZ *+8 SKIP IF SO 11346000 + MVI ESENXF+1,$SYEXT WAS EXTRN-PUT FLAG BYTE IN 11348000 + LA RY,1 ST UP USEFUL 1 IN ODDREG 11350000 + SPACE 1 11352000 +ESENX1A BAL RX,ESSYMBOL GO HAVE SYMBOL SCANNED AND ENTERED 11354000 + USING SYMSECT,RC NOTE USING(SET UP BY ESSYMBOL) 11356000 +ESENXF OI SYFLAGS,$CHN WILL HAVE FLAG BYTE PLACED IN 11358000 + CLI 0(RA),C' ' WAS THIS LAST ONE 11360000 + BE ESN1RETA GO RETURN WITH NO ERRORS 11362000 + CLI 0(RA),C',' IS DELIMITER RIGHT ONE 11364000 + BNE ESERIND NO,ERROR 11366000 + BXH RA,RY,ESENX1A BUMP SCAN PTR, GO FOR NEXT NAME 11367000 + SPACE 1 11368000 +ESN1RETA SR RB,RB SHOW NO ERRORS 11370000 +ESNX1RET $RETURN RGS=(R14-R6) 11372000 + EJECT 11374000 +**--> ENTRY: ESENX2 ENTRY AND EXTRN STATEMENTS - PASS 2 . . . . . 11376000 +*. CHECKS ENTRY/EXTRN STATEMENTS FOR CONFLICTS, ERRORS. . 11377000 +*. ENTRY AND EXIT CONDITIONS EXACTLY SAME AS ESENX1 . 11378000 +*. EXCEPT EXIT VALUE OF RB MEANS NOTHING. . 11380000 +*. CALLS ERRTAG,SYENT1 . 11382000 +*. USES MACROS: $CALL,$GTAD,$RETURN,$SAVE . 11383000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11384000 +ESENX2 $SAVE SA=ESDOSAVE,RGS=(R14-R6),BR=RW 11386000 + LA RZ,ESNX2RET SHOW @ FOR ERROR RETURN, IF ANY 11388000 + LR R0,RB SAVE CODE, =0 ==> ENTRY, =2==>EXTRN 11394000 + LA RY,1 FOR BXH'ING CONSTANT IN ODD REG 11396000 + SPACE 1 11398000 +ESNX2L BAL RX,ESSYMBOL CALL SYMBOL LOOKUP ROUTINE 11400000 + LTR R0,R0 ENTRY OR EXTRN 11402000 + BNZ ESNX2EXT EXTRN-BRANCH 11404000 + SPACE 1 11406000 + TM SYFLAGS,$SYDEF WAS ENTRY DEFINED 11408000 + BZ ESNX2ERA NO IT WASNT, ERROR BRANCH 11410000 + TM SYFLAGS,$SYDSE+$SYEXT WAS IT ALSO MARKED DSECT/EX 11412000 + BZ ESNX2M NO, IT WAS LEGAL, BRANCH 11414000 +ESNX2ERA LA RB,$ERENTRY ENTRY ERROR 11416000 + B ESNX2ERR GO HAVE IT FLAGGED 11418000 + SPACE 1 11420000 +ESNX2EXT TM SYFLAGS,$SYDEF+$SYENT+$SYCSE+$SYDSE IS EXTRN OK 11422000 + BZ ESNX2M YES, BRANCH, LEGAL 11424000 + LA RB,$EREXTRN EXTERNAL NAME ERROR 11426000 +ESNX2ERR SR RA,RY BACK SCAN PTR UP 1 11428000 + $CALL ERRTAG HAVE THERROR FLAGGED 11430000 + AR RA,RY INCREMENT BACK TO DELIMITER 11432000 + SPACE 1 11434000 +ESNX2M CLI 0(RA),C' ' WAS ENDING DELIMITER BLANK 11436000 + BCR E,RZ B ESNX2RET - QUIT 11438000 + BXH RA,RY,ESNX2L BUMP SCAN PTR AND CONTINUE 11440000 + SPACE 1 11442000 +ESNX2RET $RETURN RGS=(R14-R6),SA=ESDOSAVE 11444000 + EJECT 11446000 + USING ESDOSAVE,R13 GIVE SUBR COMMON BASE FROM 1-2 11447000 +* INDIVIUDAL ERROR EXITS AND FLAGGING * 11448000 +ESERIND LA RB,$ERINVDM INVALID DELIMITER 11450000 + BR RZ RETURN TO REQUIRED LOCATION 11452000 +ESERSYM LA RB,$ERINVSY INVALID SYMBOL 11454000 + BR RZ RETURN TO REQUIRED LOCATION 11456000 + SPACE 1 11458000 +* * * * * ESSYMBOL - SCAN SYMBOL,HAVE IT ENTERED IN TABLE,RETURN @ * 11460000 +ESSYMBOL SR R1,R1 CLEAR SO TRT'S WORK 11462000 + TRT 0(9,RA),AWTSYMT SCAN FOR DELIMITER 11464000 + BZ ESERIND FLAG ERROR, IF SYMBOL TOO LONG 11465000 + CLI 0(RA),C'0' MAKE SURE NOT LEADING DIGTI 11466000 + BNL ESERSYM LEADING DIGIT-ILLEGAL 11468000 + LR RB,R1 MOVE END SCAN POINTER OVER 11470000 + SR RB,RA GET LENGTH OF SYMBOL 11472000 + BZ ESERIND ZWRO LENGTH SYMBOL -DELIMITER 11474000 + $CALL SYENT1 HAVE SYMBOL ENTRED IN TABLE 11476000 + LR RC,RA MOVE POINTER TO SYMBOL ENTRY OVER 11478000 + LR RA,R1 UPDATE SCAN POINTER 11480000 + BR RX RETURN TO CALLER 11482000 + DROP RC,RW,R13 SYMSECT, REGUALR BASE, 2ND BASE 11484000 + TITLE '*** EVALUT - EXPRESSION EVALUATOR ***' 11486000 +**--> DSECT: EVCTDSCT EVALUT TRANSITION TABLE ENTRY . . . . . . . . . 11486100 +*. THIS DESCRIBES 1 ENTRY IN 1 ROW OF THE GENERAL EXPRESSION . 11486200 +*. EVALUATOR EVALUT, AND GIVES A SECTION OFFSET @ TO USE, AND . 11486300 +*. EITHER A NEXT STATE(ROW) IN TABLE OR AN ERROR CODE FOR AN . 11486400 +*. ILLEGAL CURRENT STATE/CURRENT VALUE COMBINATION. . 11486500 +*. LOCATION: TABLE EVCTAB IN CSECT EVALUT. . 11486600 +*. GENERATION: 1 ROW OF EVCTDSCTS IS GENERATED BY 1 EVCG MACRO. . 11486700 +*. NAMES: EVCT---- . 11488000 +*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11490000 + SPACE 1 11490500 +EVCTDSCT DSECT 11492000 +EVCTADR DS AL1 JUMP OFFSET INDEX FOR ROUTINES 11494000 +EVCTCOD DS AL1 NEXT ROW OFFSET OR ERROR CODE 11496000 +EVCTL EQU *-EVCTDSCT LENGTH OF SINGLE TABLE ENTRY 11498000 +* EQU'S DEFINING OFFSETS ALONG ROWS IN EVCTAB * 11500000 +EVCLP EQU 0 ( 11502000 +EVCRP EQU EVCTL ) 11504000 +EVCPL EQU 2*EVCTL + - 11506000 +EVCMU EQU 3*EVCTL * 11508000 +EVCDI EQU 4*EVCTL / 11510000 +EVCAB EQU 5*EVCTL ABSOLUTE TERM 11512000 +EVCRE EQU 6*EVCTL RELOCATABLE TERM 11514000 +EVCBL EQU 7*EVCTL BLANK OR , 11516000 + SPACE 2 11518000 +**--> CSECT: EVALUT 1-2 GENERAL EXPRESSION EVALUATION ROUTINE . . . . 11520000 +*. ENTRY CONDITIONS . 11522000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHARACTER OF EXPRESSION) . 11524000 +*. EXIT CONDITIONS . 11526000 +*. RA = SCAN POINTER TO DELIMITER STOPPING SCAN, OR ERROR . 11528000 +*. RB = 0 ==> EXPRESSION GOOD, = NONZERO VALUE==>ERROR CODE . 11530000 +*. RC = VALUE OF EXPRESSION, IF IT WAS GOOD . 11532000 +*. RD = 0 ==> EXPRESSION WAS AN ABSOLUTE EXPRESSION . 11534000 +*. = ESDID FOR A RELOCATABLE EXPRESSION (1-255) . 11536000 +*. RE = LENGTH ATTRIBUTE - 1 OF EXPRESSION. . 11538000 +*. CALLS SDBCDX,SYFIND . 11540000 +*. USES DSECTS: AVWXTABL,EVCTDSCT,RCODBLK,RSBLOCK,SYMSECT . 11540500 +*. USES MACROS: $CALL,$GLOC,$RETURN,$SAVE,EVCG . 11541000 +*. . 11541100 +*. **NOTE** SEE IBM PLM Y26-3700-0, PP. 45-47. EVALUT SOMEWHAT . 11541200 +*. RESEMBLES IEUF7V-EXPRESSION EVALUATION ROUTINE. NOTE EVALUT . 11541300 +*. HAS 1 LESS STATE SETTING, SINCE IEUF7V COND=0 IS UNNEEDED. . 11541400 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 11542000 + EJECT 11543000 +EVALUT CSECT 11544000 + $DBG B0,SNAP 11546000 +* * * * * REGISTER ALLOCATION AND USAGE FOR EVALUT* * * * * * * * * * * 11548000 +* R0 UNRESTRICTED WORK REGISTER * 11550000 +* R1 ADDRESS WORK REGISTER - HIGH-ORDER BYTE =0 ALWAYS * 11552000 +* R2 BYTE WORK REGISTER - HIGH-ORDER 3 BYTES = 0 ALWAYS * 11554000 +* RW TERM /SIGN/ID STACK INDEX = INDEX OF NEXT EMPTY H IN EVTRID * 11556000 +* RX OPERATOR STACK POINTER = @ LAST OPERATOR CODE IN EVOPRS * 11558000 +* RY = 1 USEFUL CONSTANT IN ODD REGISTER, CAN BE USED FOR BSH'S * 11560000 +* RZ STATE REGISTER = @ ROW IN EVCTAB OR @ ENTRY IN EVCTAB * 11562000 +* RA SCAN POINTER TO NEXT CHARACTER TO BE EXAMINED * 11564000 +* RB-RE GENERAL WORK REGISTERS AND PARAMETER REGISTERS * 11566000 +* R13 BASE REGISTER AND SAVE AREA POINTER * 11568000 +* R14 INTERNAL AND EXTERNAL LINK REGISTER * 11570000 +* R15 UNRESTRICTED WORK REGISTER * 11572000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11574000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 11576000 + $SAVE RGS=(R14-R6),BR=R13,SA=EVALSAVE 11578000 +EVLPC EQU 2 AWTSYMT CODE FOR LEFT PAREN 11580000 + SPACE 1 11582000 +* INITIALIZATION SECTION * 11584000 + NI EVFLENG+1,X'0F' MAKE SURE BRANCH IS A NOPR 11586000 + LA R0,16 FOR INIT OF EVPCNT-EVTRNM 11588000 + STH R0,EVPCNT STORE EVPCNT=0, EVTRNM=16 11590000 + LM R1,RW,AWZEROS ZERO OUT 11592000 + LA RX,EVOPRS INIT TO BEFINNING OF STACK 11594000 + LA RY,1 HANDY CONSTANT IN ODD REGISTER 11596000 + USING EVCTDSCT,RZ NOTE TRANSITION TABLE ENTRY USING 11598000 + B EVCNEXTA ENTER AT RIGHT PLACE TO START 11600000 + EJECT 11602000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11604000 +* MAIN CONTROL POINT - PICK UP CODE FROM PREVIOUS ENTRY * 11606000 +* IN TRANSITION TABLE, TO MAKE IT THE CURRENT STATE. FIND FROM * 11608000 +* THIS THE @ NEW ROW INT ABLE (NEW STATE). GET THE NEXT CHAR * 11610000 +* TO BE SCANNED, GET CODE FORM AWTSYMT WHICH DESCRIBES IT. IF * 11612000 +* THE CHAR IS A DELIMITER, SKIP TO EVCOPRT. FOR A CHARACTER * 11614000 +* WHICH MIGHT BEGIN A TERM (ALPHANUMERIC), SCAN AND EVALUATE * 11616000 +* THE TERM, DETERMINING ITS RELOCATIBILITY ATTRIBUTE FOR LATER * 11618000 +* IN REGS RC & RD FOR USE BY EVTERM, IF LEGAL. * 11622000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11624000 + SPACE 1 11626000 +EVCNEXT IC R2,EVCTCOD GET CODE FROM PREVIOUS ENTRY 11628000 +EVCNEXTA LA RZ,EVCTAB(R2) GET @ REQUIRED ROW IN EVCTAB 11630000 + AIF (&$DEBUG).EVCX0 SKIP IF PRODUCTION MODE 11632000 + XSNAP IF=(AVDEBUG,O,X'B0',TM),STORAGE=(EVOPRS,EVALQ), #11634000 + LABEL='EVCNEXTA' 11636000 +.EVCX0 ANOP 11638000 + IC R2,0(RA) GET THE NEXT SOURCE BYTE 11640000 + IC R2,AWTSYMT(R2) GET THE CODE FROM THE TABLE 11642000 + CR R2,RY COMPARE TO 1 FOR TYPE 11644000 + BH EVCOPRT IF >1, CHARACTER WAS OPERATOR 11646000 + BE EVZILCH ILLEGAL CHARACTER, IF =1 11648000 + SPACE 1 11650000 +* TERM-PROCESSING SECTION - CODE IN R2 = 0 * 11652000 + CLI 0(RA),C'0' WAS IT A DIGIT 11654000 + BNL EVCSDT2 SKIP TO SELF-DEFINING TERM SECTION 11656000 + CLI 1(RA),C'''' IS NEXT CHAR A ' 11658000 + BE EVCSDT1 SKIP IF SO, I.E. L' B' C' OR X' 11660000 + SPACE 1 11662000 +* SYMBOL FOUND - HAVE IT SCANNED. GET VALUE,SECTION ID. 11664000 + BAL R14,EVSYMB CALL SYMBOL ROUTINE 11666000 + USING SYMSECT,RB NOTE POINTER 11668000 + L RC,SYVALUE GET VALUE OF SYMBOL INTO RC 11670000 + IC R2,SYLENG GET LENGTH-1 11672000 + BAL R14,EVFLENG CALL LENGTH ATTRIB SAVER 11674000 + IC R2,SYESDID GET SECTION ID 11676000 + LTR RD,R2 MOVE SECTION ID AND TEST IT 11678000 + BZ EVCABSA SKIP IF0, I.E. ABSOLUTE SYMBOL 11680000 + LA R2,EVCRE SHOW OFFSET FOR RELOCATABLE TERM 11682000 + B EVCJUMPA GO TO MAKE CHOICE 11684000 + EJECT 11686000 +* ABSOLUTE TERM - SELF-DEFINING OR LENGTH ATTRIBUTE * 11688000 +EVCSDT1 CLI 0(RA),C'L' WAS IT L' 11690000 + BNE EVCSDT2 NO, MUST BE X' B' OR C' 11692000 +* TERM IS A LENGTH ATTRIBUTE - L'SYMBOL OR L'*. 11694000 + LA RA,2(RA) BUMP SCAN PTR PAST L' 11696000 + CLI 0(RA),C'*' IS IT L'* 11698000 + BNE EVCSDT2A SKIP IF NOT (BRANCH PROBABLE) 11700000 + BAL R14,EVFLQAS CALL L'* ROUTINE 11702000 + BXH RA,RY,EVCSDT2B BRANCH, INCREM SCAN PTR BEYOND * 11704000 + SPACE 1 11718000 +* PROCESS SELF-DEFINING TERM * 11720000 +EVCSDT2 $CALL SDBCDX CALL SELF-DEF TERM PROCESSOR 11724000 + LTR RB,RB WAS RESULT OK 11726000 + BZ EVCSDT3 YES,OK,RESULT IN RC 11728000 + BP EVZERROR ERROR,BRANCH 11730000 + BXH RA,RY,EVZSYNT ' BAD, LETTER NOT B,C,X-ERROR 11732000 + SPACE 1 11734000 +EVCSDT2A BAL R14,EVSYMB CALL SYMBOL LOOKUP 11736000 + IC R2,SYLENG GET LENGTH-1 11736500 + DROP RB REMOVE SYMSECT USING 11737000 +EVCSDT2B LA RC,1(R2) MOVE, CONVERT LENGTH-1 TO LENGTH 11737500 + BAL R14,EVFLENG HAVE LENGTH ATTRIB SAVED,IF NEEDED 11738000 +* IF EVCSDT3 ENTERED THRU EVCSDT1, R2 STILL =0 (L' =1) 11738500 +EVCSDT3 BAL R14,EVFLENG HAVE LENGTH-1 SAVED, IF NOT ALREADY 11739000 + SR RD,RD SHOW ABSOLUTE TERM 11740000 +EVCABSA LA R2,EVCAB SHOW OFFSET FOR ABSOLUTE TERM 11742000 + B EVCJUMPA GO TO MAKE BRANCH 11744000 + EJECT 11746000 +* * * * * EVFLQAS - OBTAIN L'*-1, RETURN IT IN R2, IF IT EXISTS * 11748000 +* THIS ROUTINE CALLED ONLY BY TERM PROCESSING SECTION * 11750000 +* EXIT CONDITIONS * 11752000 +* R2 = L'* - 1, FOR USE AS EXPLICIT LENGTH ATTRIBUTE, OR IMPLIED L * 11754000 + SPACE 1 11756000 +EVFLQAS L R15,AVRSBPT GET RSB POINTER 11758000 + USING RSBLOCK,R15 NOTE USING FOR RSBLOCK 11760000 + SR R2,R2 SET R2=0, I.E. L'* = 1 11762000 + TM RSBFLAG,$RCBX IS THERE AN RCB 11764000 + BCR Z,R14 RETURN IF THERE ISN'T ANY,USE 1 11766000 + L R15,AVRCBPT RCB EXISTS, GET THE @ OF IT 11768000 + USING RCODBLK,R15 NOTE NEW USING 11770000 + IC R2,RCLQ GET THE L'* VALUE 11772000 +* BR R14 FALL THRU INTO EVFLENG, SET LENGTH-1 OR JUST RETURN. 11774000 + DROP R15 KILL RCODBLK USING 11776000 + SPACE 1 11778000 +* * * * * EVFLENG - STORE LENGTH ATTRIBUTE-1, IF 1ST TIME * 11780000 +* THIS ROUTINE CALLED ONLY FROM TERM PROCESSING SECTION. * 11782000 +* MUST IMMEDIATELY FOLLOW SECTION EVFLQAS. * 11783000 +* ENTRY CONDITIONS * 11784000 +* R2 = LENGTH ATTRIVUTE-1 * 11786000 + SPACE 1 11788000 +EVFLENG BCR $CHN,R14 RETURN TO CALLER IF NOT 1ST TIME 11790000 + OI EVFLENG+1,X'F0' CHANGE NOPR TO BR 11792000 + STC R2,EVALQ SAVE LENGTH ATTRIBUTE - 1 11794000 + BR R14 RETURN TO CALLER 11796000 + SPACE 1 11798000 +* * * * * EVSYMB - SCAN SYMBOL AND HAVE IT LOOKED UP BY SYFIND * 11800000 +* THIS SECTION CALLED ONLY FROM TERM PROCESSING SECTION. * 11802000 +* ENTRY CONDITIONS * 11804000 +* RA = SCAN POINTER TO 1ST CHARACTER OF SYMBOL * 11806000 +* EXIT CONDITIONS * 11808000 +* RA = SCAN POINTER TO DELIMITER FOLLOWING SYMBOL * 11810000 +* RB = @ SYMSECT ENTRY IN SYMBOL TABLE OF THE SYMBOL * 11812000 + SPACE 1 11814000 +EVSYMB TRT 0(9,RA),AWTSYMT SCAN FOR DELIMITER 11816000 + BZ EVZINVSY IF NOT FOUND,SYMBOL TOO LONG-ERROR 11818000 + LR RB,R1 GET PTR TO DELIMITER INTO RB 11820000 + SR RB,RA GET LENGTH OF SYMBOL 11822000 + BZ EVZILCH ILLEGAL CHARACTER 11824000 + LR R0,R14 SAVE RETURN @ 11826000 + SPACE 1 11828000 + $CALL SYFIND CALL LOOKUP ROUTINE 11830000 + LTR RB,RB WAS THE SYMBOL UNDEFINED 11832000 + BNZ EVZUNDEF UNDEFINED SYMBOL,ERROR 11834000 + LR RB,RA MOVE POINTER TO SYMBOL OVER 11836000 + USING SYMSECT,RB NOTE SYMBOL POINTE 11838000 + TM SYFLAGS,$SYDEF WAS SYMBOL DEFINED 11840000 + BZ EVZUNDEF NO,UNDEFINED-BRANCH 11842000 + LR RA,R1 GET SCAN PTR TO DELIMITER 11844000 + LR R14,R0 RESTORE RETURN @ 11846000 + BR R14 RETURN TO CALLING SECTION 11848000 + DROP RB KILL USING 11850000 + EJECT 11852000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11854000 +* BRANCH ACCORDING TO CURRENT STATE (GIVEN BY RZ) AND * 11856000 +* TYPE OF TERM OR DELIMITER. USE VALUES IN EVCTAB, WHICH * 11858000 +* CONTAIN OFFSET JUMP VALUES, AND EITHER A NEXT STATE VALUE, * 11860000 +* OR AN ERROR CODE IF A BRANCH TAKEN DIRECTLY TO EVCERR. * 11862000 +* THE LABELS EVERR, EVLOCNT, EVTERM, EVPCHIH, EVPCTES, EVPCZER,* 11864000 +* AND EVOPCHK MUST ALL BE WITHIN 256 BYTES OF EVDJUMP. * 11866000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11868000 + SPACE 1 11870000 +EVCOPRT LR R1,R2 SAVE OPERATOR CODE FROM AWTSYMT 11872000 + IC R2,EVCOFFS(R2) GET OFFSET FOR TRANSITION TABLE 11874000 +EVCJUMPA LA RZ,EVCTDSCT(R2) GET @ INDIVIDUAL ENTRY INTABLE 11876000 + IC R2,EVCTADR GET JUMP INDEX VALUE FROM TABLE 11878000 + AIF (&$DEBUG).EVCX1 SKIP IF PRODUCTION MODE 11880000 + XSNAP IF=(AVDEBUG,O,X'B0',TM), #11882000 + STORAGE=(*EVDJUMP(R2),*EVDJUMP+4(R2)),LABEL='EVDJUMP' 11884000 +.EVCX1 ANOP 11886000 + B EVDJUMP(R2) TAKE BRANCH TO PARTICULAR ROUTINE 11888000 +EVDJUMP EQU * BASE FOR RPUTINE JUMPS 11890000 + SPACE 1 11892000 +* * * * * EVERR - OBTAIN ERROR CODE FROM TRANSITION TABLE, EXIT. * 11894000 +EVERR IC R2,EVCTCOD GET ERROR CODE 11896000 + LR RB,R2 MOVE TO EXPECTED LOCATION 11898000 + B EVZERROR GO TO FINISH 11900000 + SPACE 1 11902000 +* * * * * EVLOCNT - PROCESS LOCATION COUNTER REFERENCE * 11904000 +EVLOCNT $GLOC RC GET LOCATION COUNTER 11906000 + IC R2,AVCESDID GET SECTION ID CURRENT 11908000 + LR RD,R2 MOVE OVER WHERE EXPECTED 11910000 + BAL R14,EVFLQAS CALL L'* ROUTINE, SAVE LENGTH-1 ATT 11912000 + AR RA,RY BUMP SCAN PTR 1, FALL THRU TO EVTERM 11916000 + SPACE 1 11918000 +* * * * * EVTERM - ENTER TERM VALUE AND ID INTO EVTRMS/EVTRID * 11920000 +* THIS SECTION MUST IMMEDIATELY FOLLOW EVLOCNT. * 11922000 +* ENTRY CONDITIONS * 11924000 +* RC = VALUE OF TERM TO BE ENTERED * 11926000 +* RD = SECTION ID (1-255) FOR RELOCATABLE, 0 FOR ABSOLUTE TERM * 11928000 +* RW = INDEX OF NEXT EMPTY SLOT IN EVTRID * 11930000 +* EXIT CONDITIONS * 11932000 +* RW = RW+2 (I.E. ONE ENTRY HAS BEEN PUSHED INTO STACK) * 11934000 + SPACE 1 11936000 +EVTERM IC R2,EVTRNM GET # TERMS LEFT TO GO 11938000 + SR R2,RY DECREMENT 11940000 + BM EVZTMTR TOO MANY TERMS IN EXPRESSION 11942000 + STC R2,EVTRNM STORE BACK UPDATED VALUE 11944000 + STH RD,EVTRID(RW) STORE SECTION ID 11946000 + LA R15,0(RW,RW) GET INDEX FOR EVTRMS ENTRY 11948000 + ST RC,EVTRMS(R15) STORE THE VALUE OF TERM 11950000 + LA RW,2(RW) INCREMENT THE OFFSET INDEX 11952000 + B EVCNEXT GO BACK FOR NEXT ONE 11954000 + EJECT 11956000 +* * * * * EVPCHIH - ( FOUND, INCREMENT AND TEST PAREN COUNT * 11958000 +EVPCHIH CLI EVPCNT,4 CHECK PAREN COUNT 11960000 + BH EVZPARN TOO MANY PARENS-BRANCH 11962000 + IC R2,EVPCNT GET PAREN COUNT 11964000 + AR R2,RY INCREMENT BY 1 11966000 + STC R2,EVPCNT STORE BACK 11968000 + B EVOPENT GO ENTER OPERATOR 11970000 + SPACE 1 11972000 +* * * * * EVPCTES - , OR BLANK FOUND, MAKE SURE PAREN COUNT = 0 * 11974000 +EVPCTES CLI EVPCNT,0 IS PAREN COUNT 0 LIKE IT SHOULD BE 11976000 + BE EVFRCA YES, GO FORCEBACK ALL OPERATORS 11978000 + B EVERR ERR-UNEXPECTED END OF EXPRESSION 11980000 + SPACE 1 11982000 +* * * * * EVPCZER - ) FOUND, TEST AND DECREMENT PAREN COUNT, FORCEBACK* 11984000 +EVPCZER IC R2,EVPCNT GET PAREN COUNT 11986000 + SR R2,RY DECREMENT PAREN COUNT 11988000 + BNM *+8 IF WAS NOT PREVIOUSLY ZERO, JUMP 11990000 + BXLE R2,RY,EVFRCA SET R2=0, BRANCH TO FINISH UP 11992000 + STC R2,EVPCNT STORE BACK 11994000 + SPACE 1 11996000 +* * * * * EVFRCP - FORCE EVALUATION BACK TO LAST LEFT PAREN * 11998000 +* LOOP UNTIL LEFT PAREN CODE FOUND IN OPERATOR STACK * 12000000 +EVFRCP BALR R14,0 SET R14 = @ NEXT INSTRUCTION, LOOP 12002000 + CLI 0(RX),EVLPC IS CURRENT CODE THAT OF LEFT PAREN 12004000 + BNE EVFRCO NO, SO EVALUATE UNTIL WE FIND ( 12006000 + SPACE 1 12008000 + SR RX,RY DECREMENT OPERATOR STACK POINTER 12010000 + AR RA,RY BUMP SCAN POINTER PAST ) 12012000 + LH R15,EVTRID-2(RW) GET CURRENT SIGN/ID 12014000 + LTR R15,R15 IS IT ABSOLUTE 12016000 + BZ EVCNEXT ABSOLUTE, SO USE NEXT STATE FROM TAB 12018000 + LA R2,EVCT4-EVCTAB OFFSET FOR RELOCATABLE 12020000 + B EVCNEXTA GO FOR NEXT 12022000 + SPACE 1 12024000 +* * * * * EVOPCHK - CHECK OPERATOR PRECEDENCE, EVALUATE IF NEEDED * 12026000 +* ENTRY CONDITIONS * 12028000 +* R1 = OPERATOR CODE OF CURRENT OPERATOR, FROM AWTSYMT * 12030000 +EVOPCHK IC R2,0(RX) GET CODE OF PREVIOUS OPERATOR 12032000 + IC R2,EVOPREC(R2) PRECEDENCE OF PREV OP +- = 0 12032500 + SR R15,R15 CLEAR FOR INSERT 12033000 + IC R15,EVOPREC(R1) GET PRECEDENCE OF NEW OPERATOR 12033500 + CR R15,R2 IF NEW PREC > OLD, SKIP EVALUATRE 12034000 + BH *+8 IF NEW CODE> OLD CODE, SKIP EVAL 12036000 + BAL R14,EVFRCO FORCE 1 OPERATOR EVALUATION 12038000 + SPACE 1 12040000 +EVOPENT AR RX,RY INCREMENT POINTER TO EMPTY SLOT 12042000 + STC R1,0(RX) STORE CODE OF NEW OPERATOR 12044000 + BXH RA,RY,EVCNEXT BUMP SCAN POINTER, GET NEXT CODE 12046000 + SPACE 1 12048000 + EJECT 12050000 +* * * * * EVFRCO - EVALUATE 1 OPERATOR AND 2 TERMS IN STACKS * 12052000 +* ENTRY CONDITIONS * 12054000 +* RW = INDEX OF NEXT EMPTY HALFWORD IN EVTRID STACK * 12056000 +* RX = @ LAST OPERATOR CODE ENTERED IN OPERATOR STACK EVOPRS * 12058000 +* R14= RETURN ADDRESS TO CALLING SECTION OF CODE. * 12060000 +* EXIT CONDITONS * 12062000 +* RC = COMPUTED RESULT OF OPERATION * 12064000 +* RW = RW-2 (I.E. 1 ENTRY OF EVTRID&EVTRMS WAS POPPED) * 12066000 +* RX = RX-1 (I.E. ONE ENTRY FROM OPERATOR STACK WAS POPPED) * 12068000 +EVFRCO SR RW,RY SUBTRACT 1 FROM INDEX 12070000 + SR RW,RY SUBTRACT ANOTHER 1, MAKING -2 12072000 + LH RE,EVTRID(RW) GET PREVIOUS SIGN CODE/SECTION ID 12074000 + LA R15,0(RW,RW) GET 2* RW FOR INDEX INTO EVTRMS 12076000 + LA R15,EVTRMS-4(R15) GET @ 2ND PREVIOUS ENTRY 12078000 + LM RC,RD,0(R15) GET 2ND PREVIOUS,PREVIOUS EVTRMS 12080000 + IC R2,0(RX) GET CURRENT OPERAOTR CODE 12082000 + IC R2,EVFRCT-5(R2) GET OFFSET VALUE FOR TYPE JUMP 12084000 + B EVFRJ(R2) TAKE BRANCH TO SECTION 12086000 +EVFRJ EQU * BASE FOR OPERATOR JUMPS 12088000 + SPACE 1 12090000 +* - OPERATOR * 12092000 +EVFRMI SR RC,RD PERFORM OPERATION 12094000 + LCR RE,RE COMPLEMENT SIGN CODE/SECTION ID 12096000 + B EVFRPLA CONTINUE WITH COMMON +- CODE 12098000 + SPACE 1 12100000 +* + OPERATOR * 12102000 +EVFRPL AR RC,RD PERFORM OPERATION 12104000 + LTR RE,RE WAS PREVIOUS AN ABS TERM(RE=0 IF SO) 12106000 +EVFRPLA BZ EVFRCOEX YES, SO LEAVE 2ND PREV CODE AS IS 12108000 + LH RB,EVTRID-2(RW) GET 2ND PREVIOUS SIGN CODE/ID 12110000 + LTR RB,RB WAS 2ND PREV TETRM ABSOLUTE 12112000 + BZ EVFRPLB YES, SO USE PREV CODE UNCHANGED-BRAN 12114000 + AR RE,RB 2 RELOCATABLE TERMS, ADD SIGN/ID 12116000 + BNZ EVZCXREL IF NO 0, COMPLEX RELOCATIBILITY 12118000 +EVFRPLB STH RE,EVTRID-2(RW) SAVE COMPUTED SIGN/ID INTO RESULT 12120000 + B EVFRCOEX HAVE RESULT SAVED AND EXIT 12122000 + SPACE 1 12124000 +* * OPERATOR * 12126000 +EVFRMU MR RB,RD 1ST OP IN RC, RESULT VALUE ALSO 12128000 + B EVFRCOEX GO HAVE RESULT STORED 12130000 + SPACE 1 12132000 +* / OPERATOR * 12134000 +EVFRDI LR RB,RC MOVE 2ND PREVIOUS VALUE OVER 12136000 + LTR RC,RD MOVE AND TEST DIVISOR OVER 12138000 + BZ EVFRCOEX IF DIVISOR =0, LEAVE RC=0,BRANCH 12140000 + SRDA RB,32 PROPAGATE SIGN,MOVE DIVIDEND BACK 12142000 + DR RB,RD PERFORM OPEATION ,HAVING CHECKED 0 12144000 + SPACE 1 12146000 +EVFRCOEX ST RC,0(R15) STORE RESULT INTO EVTRMS STACK 12148000 + AIF (&$DEBUG).EVCX2 SKIP IF PRODUCTION MODE 12150000 + XSNAP IF=(AVDEBUG,O,X'B0',TM),LABEL='EVFRCOEX' 12152000 +.EVCX2 ANOP 12154000 + BCTR RX,R14 BACK UP OPERATOR POINTER 1, RETURN 12156000 + EJECT 12158000 +* * * * * EVFRCA - FORCE EVALUATION OF ALL VALUES, RETURN TO CALLER * 12160000 +* LOOP CALLING EVFRCO UNTIL LEFT PAREN CODE FOUND * 12162000 +* NOTE THAT EVFRCO LEAVE RESULT IN RC, SO NEED NOT BE FETCHED. * 12164000 +EVFRCA BALR R14,0 SET R14 = @ NEXT INSTRUCTION 12166000 + CLI 0(RX),EVLPC IS CURRENT OP CODE LEFT PAREN 12168000 + BNE EVFRCO IF NOT, CALL FORCE 1 OPERATOR SECTIO 12170000 + SPACE 1 12172000 + LH RD,EVTRID GET 1ST RELOCATE ID HALFWORD 12174000 + LTR RD,RD IS IT ACCEPTABLE (0 OR +) 12176000 + BM EVZCXREL IF <0, NEGATIVE RELOCATABLE TERM 12178000 + CL RC,AWFX6F IS VALUE WITHIN 24 BITS 12184000 + BH EVZEXGTA NO,ERROR BRANCH 12186000 + IC R2,EVALQ GET LENGTH ATTRIBUTE - 1 12188000 + LR RE,R2 MOVE LENGTH ATTRIBUTE - 1 OVER 12190000 + SR RB,RB SHOW THE EXPRESSION WAS OK 12192000 +EVZERROR EQU * DEFINE LABEL FOR ERROR EXIT 12194000 +EVRET $RETURN RGS=(R14-R6) 12196000 + SPACE 1 12198000 +* * * * * ERROR EXIT SECTION * 12200000 +EVZCXREL LA RB,$ERCXREL COMPLEX RELOCATIBILITY ILLEGAL 12202000 + B EVZERROR EXIT, WITH ERROR CODE 12204000 +EVZEXGTA LA RB,$EREXGTA SHOW LARGER THAN 24 BITS 12206000 + LTR RC,RC WAS VALUE POSITIVE 12207000 + BP EVZERROR BRANCH IF SO, FALL THRU IS NOT 12208000 +EVZEXLTA LA RB,$EREXLTA SHOW EXPRESSION NEGATIVE 12210000 + B EVZERROR GO RETURN WITH ERROR 12212000 +EVZILCH LA RB,$ERVILCH ILLEGAL CHARACTER 12214000 + B EVZERROR EXIT, WITH ERROR CODE 12216000 +EVZINVSY LA RB,$ERINVSY SHOW INVALID SYMBOL 12218000 + B EVZERROR GO TO SHOW ERROR 12220000 +EVZPARN LA RB,$ERVPARN TOO MANY PARENS 12222000 + B EVZERROR EXIT, WITH ERROR CODE 12224000 +EVZSYNT LA RB,$ERVSYNT SYNTAX 12226000 + B EVZERROR EXIT, WITH ERROR CODE 12228000 +EVZTMTR LA RB,$ERVTMTR TOO MANY TERMS IN EXPRESSION 12230000 + B EVZERROR GO RETURN WITH ERROR 12232000 +EVZUNDEF LR RA,R1 MOVE SCAN POINTER BACK 12234000 + SR RA,RY DECREMNT BY 1 FOR BETTER POINTER 12236000 + LA RB,$ERUNDEF SHOW UNDEFINED 12238000 + B EVZERROR GO TO ERROR SECTION 12240000 + EJECT 12242000 +* * * * * INTERNAL CONSTANTS * 12244000 +EVCOFFS EQU *-2 OFFSET BACKWARDS SMALLEST INDEX 12246000 +* OFFSETS OBTAINED USING INDEX VALUE FROM AWTSYMT * 12248000 + DC AL1(EVCLP,EVCRP,EVCBL,EVCPL,EVCPL,EVCMU,EVCDI) 12250000 +* JUMP OFFSET TABLE FOR EVFRCO - FOR + - * / OPERATORS * 12252000 +EVFRCT DC AL1(EVFRPL-EVFRJ,EVFRMI-EVFRJ,EVFRMU-EVFRJ,EVFRDI-EVFRJ) 12254000 +EVOPREC EQU *-2 ORIGIN RIGHT FOR INDICES 2 UP 12254100 + DC AL1(0,0,0,1,1,2,2) PRECEDENCES: ( X X + - * / (2-8) 12254200 + SPACE 1 12256000 +EVCTAB DS 0H TRANSITION TABLE 12258000 +EVCT1 EVCG (PCHIH,1,ERR,SYNT,ERR,SYNT,LOCNT,4,ERR,SYNT,TERM,3,TERM,#12260000 + 4,ERR,UNEX) BEGINNING ( + - LAST FOUND 12262000 +EVCT2 EVCG (PCHIH,1,ERR,SYNT,ERR,SYNT,ERR,SYNT,ERR,SYNT,TERM,3,ERR,#12264000 + RELO,ERR,UNEX) * / OPERATORS LAST ENCOUNTERD 12266000 +EVCT3 EVCG (PCTES,SYNT,PCZER,3,OPCHK,1,OPCHK,2,OPCHK,2,ERR,SYNT,ERR#12268000 + ,SYNT,PCTES,UNEX) ABSOLUTE TERM WAS LAST 12270000 +EVCT4 EVCG (PCTES,SYNT,PCZER,3,OPCHK,1,ERR,RELO,ERR,RELO,ERR,SYNT,E#12272000 + RR,SYNT,PCTES,UNEX) RELOCATABLE TERM LAST PREVIOUS 12274000 + SPACE 1 12276000 +* OPERATOR STACK - 1ST ENTRY IS CODE FOR ( * 12278000 +EVOPRS DC AL1(EVLPC) BEGINNING OF OPERATOR STACK,LEFT PRN 12280000 + DS 21C REMAINING SECTION OF EVOPRS 12282000 + SPACE 1 12284000 +* TERM STACK - COMPUTED VALUES KEPT TO 32 BITS. * 12286000 +EVTRMS DS 16F TERM STACK 12288000 + SPACE 1 12290000 +* SIGN CODE/ID STACK. EACH HALFWORD IS ASSOCIATED WITH * 12292000 +* CORRESPONDING FULLWORD IN EVTRMS. FOR ABSOLUTE VALUES, THE * 12294000 +* EVTRID ENTRY = 0, FOR RELOCATABLE VALUES, THE SECTION ID IS * 12296000 +* ENTERED IN THE 2ND BYTE OF A HALFWORD, WITH ZEROS IN THE 1ST * 12298000 +* BYTE. IF THE VALUE IS NEGATIVE, THE HALFWORD IS COMPLEMENTED* 12300000 +EVTRID DS 16H SIGN CODE/ID STACK 12302000 +* EVPCNT AND EVTRNM MUST BE IN ORDER, ON H BOUNDARY * 12304000 +EVPCNT DS C PAREN COUNT - 0<=EVPCNT<=5 12306000 +EVTRNM DS C # TERMS LEFT (INIT TO 16 12308000 +EVALQ DS C LENGTH ATTRIVUTE - 1 OF EXPRESSION 12310000 + DROP RAT,R13,RZ KILL USINGS 12312000 + TITLE '*** IAMOP1 - MACHINE OPCODES - PASS 1 ***' 12314000 +**--> CSECT: IAMOP1 1 MACHINE OPERATIONS - PASS 1 . . . . . . . . . 12316000 +*. THIS IS 1 OF 2 PASS 1,LEVEL 2 PROGRAMS. IT PERFORMS ALL . 12316100 +*. PASS 1 MACHINE INSTRUCTION PROCESSING, INCLUDING ALIGNMENT . 12316200 +*. OF THE LOCATION COUNTER, SCANNING FOR LITERAL CONSTANTS, . 12316300 +*. AND BUILDING AN RCODBLK FOR THE STATEMENT. THE RCODBLK . 12316400 +*. INCLUDES THE INSTRUCTION FORMAT TYPE, THE MACHINE CODE FOR . 12316500 +*. THE GIVEN INSTRUCTION, MASK (EXTENDED MNEMONICS), FLAGS . 12316600 +*. AND ALIGNMENT VALUES NEEDED, THE LENGTH ATTRIBUTE-1 FOR THE . 12316700 +*. INSTRUCTION, AND THE ADDRESS OF A LITERAL CONSTANT IN THE . 12316800 +*. LITERAL TABLE, IF THERE IS ONE USED. . 12316900 +*. ENTRY CONDITIONS . 12318000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHARACTER OF OPERAND FIELD) . 12320000 +*. RC = ADDRESS OF OPCODE CONTROL TABLE ENTRY FOR OPCODE USED . 12322000 +*. EXIT CONDITIONS . 12324000 +*. RB = 0 NO ERRORS WERE ENCOUNTERED . 12326000 +*. = >0 ERRORS WERE FOUND IN STATEMENT . 12328000 +*. RC = @ RECORD CODE BLOCK(RCODBLK) FOR THE STATEMENT. . 12330000 +*. THE RCODBLK HAS ALL VALUES FILLED IN EXCEPT RCLOC(IARCLOC). . 12331000 +*. RD = LENGTH OF CODE - TO BE ADDED AFTER ALIGNMENT DONE . 12332000 +*. CALLS ERRTAG,LTENT1,SCANEQ . 12334000 +*. USES DSECTS: AVWXTABL,OPCODTB . 12334500 +*. USES MACROS: $CALL,$CKALN,$GLOC,$LTENT1,$RETURN,$SAVE,$SLOC . 12335000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 12336000 +IAMOP1 CSECT 12338000 + $DBG 90,* 12340000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 12342000 + $SAVE RGS=(R14-R3),BR=R13,SA=IAMOSAVE 12344000 + USING OPCODTB,RC NOTE TABLE POINTER 12348000 + MVC IARCTYPE(3),OPCTYPE MOVE CODE BYTES OVER 12350000 + DROP RC NO LONGER NEED POINTER HERE 12352000 + MVI IARCLENG,RC$LEN PUT IN NORMAL LENGTH-1 12354000 + LM R1,R3,AWZEROS GET HANDY ZEROS 12356000 + IC R1,IARCHEX GET HEX OPCODE 12360000 + SRL R1,6 SHIFT TO GET INDEX 12362000 + IC R3,IALENGS(R1) GET LENGTH-1 FOR LENGTH ATTRIBUTE 12364000 + STC R3,IARCLQ SAVE FOR L' ATTRIBUTE 12366000 + SPACE 1 12368000 + CLI AVCESDID,0 WAS CODE PRECEDED BY A CSECT 12370000 + BNE IALICHK CSECT OR DSECT BEFORE-BRANCH 12371000 + SPACE 1 12371200 + MVI AVCESDID,2 NO, UNITIATED PRIVAT CODE 12371400 + OI AVTAGS1,$IBSTAR1+$IBPRCD1 SHOW NO START, PRIV CODE IN 12371600 + SPACE 1 12372000 +IALICHK $CKALN 1,IALNOK CHECK ALIGNMENT AND BRANCH OK 12374000 + $GLOC R1 GET LOCATION COUNTER VALUE 12376000 + LA R1,1(R1) INCREMENT TO HALFWORD BOUNDARY 12378000 + $SLOC R1 SET NEW LOCATION COUNTE VALUE 12380000 + EJECT 12382000 +* SCAN FOR LITERAL OR END OF OPERAND FIELD * 12384000 +IALNOK EQU * 12386000 + $CALL SCANEQ SCAN TO = OR LBANK 12388000 + CLI 0(RA),C' ' ARE WE TO END OF STATEMENT 12390000 + BE IARETA YES,WE'RE DONE 12392000 + CLI 0(RA),C'=' MAKE SURE IT IS = 12394000 + BNE IARETA IF NOT, ERROR, BUT DON'T FLAG NOW 12396000 + SPACE 1 12398000 +* LITERAL FOUND- HAVE IT SAVED, WITH POINTER VALUES. 12400000 + $CALL LTENT1 CALL TO ENTER LITERAL 12402000 + LTR RB,RB WAS LITERAL OK 12404000 + BNZ IAERROR NO IT WASN'T,BRANCH 12406000 + MVI IARCLENG,RC$LEN2 SET LENGTH TO LENGTH WITH LITERAL 12408000 + ST RC,IARCLITA SAVE ADDRESS OF LITERAL 12410000 + SPACE 1 12412000 +IARETA EQU * EXIT LABEL 12412020 + AIF (&$COMNT EQ 0).IANOCOM SKIP IF NO COMMENT CHEK 12412040 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12412060 +* MACHINE INSTRUCTION COMMENT COUNTING ROUTINE. * 12412080 +* IF THE COMMENT CHECK OPTION IS SPECIFIED, EITHER BY THE * 12412100 +* COMNT PARM OPTION, OR BY ACCOUNT NUMBER SETTING, THIS CODE * 12412120 +* COUNTS THE NUMBER OF MACHINE INSTRUCTIONS, AND ALSO COUNTS THE * 12412140 +* APPROXIMATE NUMBER OF THEM WHICH HAVE A COMMENT OF 4 OR MORE * 12412160 +* NONBLANK CHARACTERS. (SEE VARIABLES AVMACHIN AND AVCOMNTN). * 12412180 +* THESE VALUES ARE INITIALIZED TO ZERO IN OUINT1, AND ARE USED IN * 12412200 +* OUEND2 TO MAKE SURE THAT STUDENT PROGRAMMERS PUT A GIVEN AMOUNT * 12412220 +* OF COMMENTS ON THEIR INSTRUCTIONS (I.E. &$COMNT PER CENT OF THE * 12412240 +* MACHINE INSTRUCTIONS MUST HAVE COMMENTS ARE ELSE THE PROGRAM WILL * 12412260 +* NOT BE EXECUTED.). * 12412280 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12412300 + SPACE 1 12412320 + TM AVTAGS2,AJOCOMNT IS COMMENT CHK IN EFFECT 12412340 + BZ IARETA2 NO, SO DON'T CHECK THEM 12412360 + SPACE 1 12412380 + LA R1,1 SET R1 FOR USEFUL VALUE, BXHING 12412400 + AR RA,R1 BUMP SCAN PTR BEYOND POSSIBLE '(LIT) 12412420 + LH RE,AVMACHIN GET CURRENT # MACHINE INSTS 12412440 + AR RE,R1 INCREMENT FOR THIS INSTRUCTION 12412460 + STH RE,AVMACHIN STORE UPDATED COUNTER BACK 12412480 + SPACE 1 12412500 +* SCAN TO FIND THE COMMENT FIELD, IF ANY. 12412520 + CLI 0(RA),C' ' IS NEXT CHAR BLANK 12412540 + BNE *+8 NO-JUMP OUT, COMMENT BEGUN 12412560 + BXH RA,R1,*-8 BUMP SCAN PTR BY 1, LOOP 12412580 + SPACE 1 12412600 + L RE,AVSOLAST GET @ BLANK BEFORE AFTER QUOTE 12412620 + LR RD,R1 MOVE A 1 TO REG RD FOR BXLE INCREM 12412640 + LA R1,4 ***** # NONBLANKS REQUIRED ********* 12412660 + SPACE 1 12412680 +* LOOP UNTIL EITHER AFTERQUOTE FOUND OR 4 NONBLANKS. 12412700 + CLI 0(RA),C' ' IS THIS A BLANK 12412720 + BNE *+12 NO, SKIP TO BCT TO COUNT IT 12412740 + BXLE RA,RD,*-8 INCREMENT SCN PTR, LOOP BACK 12412760 + B IARETA2 FELL THRU - SHORT COMMENT-DON'T COUN 12412780 + BCT R1,*-8 COUNT # CHARS, LOOP TO BXLE 12412800 + SPACE 1 12412820 +* LEGITAMATE COMMENT FILED-GIVE PROGRAMMER CREDIT FOR IT. 12412840 + LH RE,AVCOMNTN GET ACCUMULATD # COMMENTS 12412860 + AR RE,RD INCREMENT BY 1 FROM RD 12412880 + STH RE,AVCOMNTN RESTORE UPDATED # COMMENTS 12412900 + SPACE 1 12412920 +.IANOCOM ANOP 12412940 +* POINT TO OUR RCB AND RETURN TO MAIN CONTROL. 12414000 +IARETA2 LA RC,IARCB SHOW @ OF OUR RCB FOR MAINPROG 12416000 + LA RD,1(R3) GET TOTAL LENGTH IN RD FOR RETURN 12418000 +IARET $RETURN RGS=(R14-R3) RETURN TO CALLER 12420000 + SPACE 1 12422000 +* * * * * INDIVIDUAL ERROR SECTIONS 12424000 +IAERROR $CALL ERRTAG CALL ERROR FLAGGING ROUTINE 12428000 + B IARETA GO RETURN 12430000 + EJECT 12432000 +* * * * * INTERNAL CONSTANTS * 12434000 +IALENGS DC HL1'1,3,3,5' LENGTH-1 BYTES FOR EACH INST TYPE 12436000 + SPACE 1 12438000 +* * * * * INTERNAL VARIABLES * 12440000 +* RCB ENTRIES FOR IAMOP1 * 12442000 +IARCB DS 0D RECORD CODE BLOCK 12444000 +IARCLENG DS C LENGTH OF RCB 12446000 +IARCLOC DS AL3 LOCATION COUNTER VALUE (BY MOCON1) 12448000 +IARCTYPE DS C PRIMARY TYPE BYTE 12450000 +IARCHEX DS C HEX OPCODE FOR MACH INSTS 12452000 +IARCMASK DS C MASK/LITERAL TAGS/ALIGNMENT 12454000 +IARCLQ DS C FOR L'* 12456000 +IARCLITA DS A ADDRESS OF A LITERAL,IF EXISTS 12458000 +IARCEND DS 0C END OF RCB ENTRY 12460000 + DROP RAT,R13 CLEAR USING 12462000 + TITLE '*** IBASM1 - ASSEMBLER OPCODES - PASS 1 ***' 12464000 +**--> CSECT: IBASM1 1 ASSEMBLER INSTRUCTIONS - PASS 1 . . . . . . . 12466000 +*. THIS MODULE IS 1 OF THE 2 PASS 1,LEVEL 2 ROUTINES OF THE . 12466100 +*. ASSIST ASSEMBLER. IT PERFORMS ALL PROCESSING FOR ASSEMBLER . 12466200 +*. INSTRUCTIONS DURING PASS 1, INCLUDING SCANNING, MODIFYING . 12466300 +* LOCATION COUNTERS, AND BUILDING AN RCODBLK FOR THE STMT. . 12466400 +*. ENTRY CONDITIONS . 12468000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHARACTER OF OPERAND FIELD) . 12470000 +*. RC = ADDRESS OF OPCODE CONTROL TABLE ENTRY FOR OPCODE USED . 12472000 +*. EXIT CONDITIONS . 12474000 +*. RB = 0 NO ERRORS WERE ENCOUNTERED . 12476000 +*. = >0 ERRORS WERE FOUND IN STATEMENT . 12478000 +*. RC = ADDRESS OF RECORD CODE BLOCK (RCB) . 12480000 +*. RD = LENGTH OF CODE - TO BE ADDED AFTER ALIGNMENT DONE . 12482000 +*. CALLS CCCON1,CODTL1,ERRLAB,ERRTAG,ESCSEC,ESENX1 . 12484000 +*. CALLS EVALUT,LTDMP1,SDBCDX,SDDTRM . 12484500 +*. USES DSECTS: AVWXTABL,CNCBLOCK,IBPSECT,OPCODTB,SYMSECT . 12485000 +*. USES MACROS: $AL2,$ALIGR,$CALL,$CKALN,$GLOC,$RETURN,$SAVE . 12485500 +*. USES MACROS: $SDEF,$SLOC,IBPRTAB . 12485800 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 12486000 + SPACE 1 12487000 +IBASM1 CSECT 12488000 + $DBG 90,* 12490000 + SPACE 1 12492000 +* * * * * REGISTER ALLOCATION AND USAGE IN IBASM1 * * * * * * * * * * * 12494000 +* R0 = WORK REGISTER. SCAN POINTER SAVED HERE BY SOME INTERNAL SUBRS* 12496000 +* R1 = 1 USEFUL VALUE, IN ODD REG FOR BXH'ING SCAN POINTER. * 12498000 +* R2 = BYTE REGISTER (HI-ORDER 3 BYTES = 0). * 12500000 +* R3(IBLN) LENGTH TO BE ADDED TO LOCATION COUNTER (INIT = 0). * 12502000 +* R4(IBLB) @ IN SYMBOL TABLE OF LABEL. IF NO LABEL, = 0. * 12504000 +* R5(IBLR) INTERNAL LINKAGE REGISTER. * 12506000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12508000 + SPACE 1 12510000 +IBLN EQU R3 LENGTH REGISTER 12512000 +IBLB EQU R4 LABEL POINTER,IF EXISTS 12514000 +IBLR EQU R5 LINKAGE REGISTER 12516000 +IBMAXCON EQU 10 MAXIMUM NUMBER OF CONSTANTS 12518000 + SPACE 1 12520000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 12522000 + $SAVE RGS=(R14-R6),BR=R13,SA=IBSAVE 12524000 + SPACE 1 12526000 +* INITIALIZATION - SET UP REGISTERS,GET OPCODTB CODES * 12528000 + LA R1,1 SET UP USEFUL VALUE IN R1 12530000 + SR R2,R2 CLEAR REGISTER 12532000 + SR IBLN,IBLN SET LENGTH TO 0 12534000 + STM R2,IBLN,IBRCB ZERO OUT RCB 12536000 + USING OPCODTB,RC NOTE OPCODE TABLE 12538000 + MVC IBRCTYPE(3),OPCTYPE MOVE CODE BYRS OVER 12540000 + MVC IBRCLQ,OPCMASK PLACE DEFAULT LENGTH ATTRIBUTE IN 12542000 + DROP RC NO LONGER NEEDED 12544000 + MVI IBRCLENG,RC$LEN MOVE IN NORMAL LENGTH-1 OF RCB 12546000 + SR RB,RB CLEAR, TYPICAL NO ERROR SETTING 12548000 + SPACE 1 12550000 +* TEST FOR LEGALITY/FLAG START INSTRUCTION * 12552000 + TM AVTAGS1,$IBSTAR1+$IBDSEC1 CHECK TAGS1 SETTING 12554000 + BNZ IBALAB ALREADY SET OR SHOUDLN'T-SKIP 12556000 + TM IBRCHEX,$IBSTAR1 IS THIS A START PREVENTER 12558000 + BZ IBALAB NO IT ISN'T,DON'T FLAG 12560000 + OI AVTAGS1,$IBSTAR1 FLAG THE START NO LONGER GOOD 12562000 + CLI AVCESDID,0 DOES A CSECT EXIST 12564000 + BNE IBALAB SOMETHING EXIST-BRANCH 12565000 + MVI AVCESDID,2 UNITIATED PRIV CODE STARTS NOW 12565500 + OI AVTAGS1,$IBPRCD1 SHOW PRIV CODE EXISTS NOW 12566000 + SPACE 1 12568000 +* CHECK FOR LABEL WHERE NONE ALLOWED,OR MISSING WHERE REQ* 12570000 +IBALAB L IBLB,AVLABPT GET ADDRESS OF LABEL,IF EXISTS 12572000 + LTR IBLB,IBLB SEE IF A LABEL EXISTS 12574000 + BNZ IBANOLB SKIP IF LABEL EXISTS 12576000 + TM IBRCHEX,IBNENAM NO NAME EXISTS,SEE IF IT IS REQUIRED 12578000 + BZ IBAOPTST NO NAME NEEDED,SKIP TO CHEK OPERAND 12580000 + LA RB,$ERNONAM NAME IS NEEDED,DOESN'T EXIST-ERR 12582000 + B IBERLAB GO FLAG ERROR-NO LABEL 12584000 + SPACE 1 12586000 +IBANOLB TM IBRCHEX,IBNONAM IT HAS A LABEL,SEE IF IT IS ALLOWED 12588000 + BZ IBAOPTST NAME IS ALLOWED,GO CHK OPERAND 12590000 + LA RB,$ERILLAB LABEL NOT PERMITTED 12592000 + $CALL ERRLAB FLAG ERROR AT LABEL FIELD 12594000 + SPACE 1 12596000 +* IF OPERAND IS OMITTED, CHECK THAT ITS NOT ILLEGALLY SO * 12598000 +IBAOPTST CLI 0(RA),C' ' SEE IF OPERAND EXISTS 12600000 + BNE IBALEV2 OPERAND EXISTS-JUMP 12602000 + TM IBRCHEX,IBOMOP MAKE SURE OPERAND MAY BE OMITTED 12604000 + BZ IBERNOPR MISSING OPERAND-ILLEGAL 12606000 + SPACE 1 12608000 +IBALEV2 IC R2,IBRCTYPE GET TYPE BYTE FOR TABLE 12610000 + LH R14,IBAJUMP-$IB(R2) GET OFFSET TO INDIVIDUAL SECTION 12612000 +IBASMJ B IBASMJ(R14) BRANCH TO INDIVIDUAL SECTION 12614000 + SPACE 1 12616000 +IBARBZER SR RB,RB CLEAR RB TO SHOW NO ERRORS 12618000 +IBASCAN EQU * NO LONGER NEED SCAN TO END OF FIELDS 12620000 +* * * * * EXIT CODE * 12622000 +IBRETA LR RD,IBLN PLACE LENGTH TO BE ADDED TO LOCCNTR 12624000 + LA RC,IBRCB PLACE ADDRESS FOR MAIN PROG 12626000 +IBRET $RETURN RGS=(R14-R6) 12628000 + SPACE 2 12630000 +* * * * * CCW * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12632000 +IBCCW EQU * 12634000 + LA RB,$ERNOIMP NOT CURRENTLY IMPLEMENTED 12636000 + B IBERRORA HAVE THIS FLAGGED FOR NOW 12638000 + EJECT 12640000 +* * * * * CNOP * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12642000 +* SETS RCMASK = # BYTES TO BE GENERATED (=0,2,4,6). * 12644000 +IBCNOP $GLOC IBLB GET VALUE OF LOCATION COUNTER 12646000 + $CKALN 1,IBCNOL CHECK HALFWORD ALIGNMENT 12648000 + AR IBLB,R1 INCREMENT LOCCNTR BY 1 TO ALIGN 12650000 + $SLOC IBLB SET LOCCNTR VALUE 12652000 + SPACE 1 12654000 +IBCNOL BAL IBLR,IBCNEV CALL EXPRESSION EVAL, CHECK ROUTINE 12656000 + STC RC,AVFWORK1 STORE VALUE,SO CAN TEST FOR ODD 12660000 + TM AVFWORK1,1 WAS THE VALUE ODD 12662000 + BZ *+8 SKIP AND CONTINUE IF EVEN-OK 12664000 + BCT RA,IBERICNO MOVE SCAN PTR BACK, GO FLAG ERROR 12666000 + CLI 0(RA),C',' IS DELIM COMMA 12668000 + BNE IBERIND NO,ERROR 12670000 + AR RA,R1 ADD 1 TO SCAN POINTER 12672000 + LR IBLN,RC SAVE 1ST OPERAND HERE 12672050 + SPACE 1 12672100 + BAL IBLR,IBCNEV CALL EXPRESSION EVAL, CHECK 12672150 + SR RC,R1 GET 2ND OPERAND - 1 12672200 + C RC,AWF3 WAS 2ND OPERAND ORIGINALLY 4 12672250 + BE *+12 YES, SKIPP IF OK 12672300 + C RC,AWF7 WAS 2ND OPERAND ORIGINALLY 8 12672350 + BNE IBERICNO NO, SO ERROR 12672400 + NR IBLB,RC GET LAST 2-3 BITS OF LOCCNTR 12672450 + LA IBLN,1(IBLN,RC) GET 1ST OPERAND + 4 OR 8 12672500 + SR IBLN,IBLB GET (1ST OPRND + 4 OR 8) - LOCNTR 12672550 + NR IBLN,RC GET LAST 2-3 BITS OF RESULT = LENGTH 12672600 + STC IBLN,IBRCMASK STORE RESULTING LENGTH FOR PASS 2 12672650 + CLI 0(RA),C' ' WAS THIS ALL 12672700 + BE IBRETA YES, SO DONE 12672750 + B IBERIND NO, INVALID DELIMIETER 12672800 + SPACE 1 12672850 +IBCNEV $CALL EVALUT CALL EXPRESSION EVALUATOR 12672900 + LTR RB,RB WAS EXPRESSION OK 12672950 + BNZ IBERRORA NO ,ERROR, FLAG IT 12673000 + LTR RD,RD WAS EXPRESSION ABSOLUTE 12673050 + BCR Z,IBLR YES, RETURN TO CALLING SECTION 12673100 + B IBERICNO NO, CNOP ERROR 12673150 + SPACE 2 12716000 +* * * * * CSECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12718000 +IBCSECT SR RB,RB SHOW THIS IS A CSECT CALL 12720000 + B IBESCALL GO TO COMMON CODE SECTION 12722000 + SPACE 2 12724000 +* * * * * DROP * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12726000 +IBDROP EQU IBASCAN NOTHING TO DO THIS PASS 12728000 + AIF (&$DEBUG).IBNOD1 SKIP IF NOT DEBUG MODE 12730000 + SPACE 1 12732000 +* * * * * DEBUG * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12734000 +IBDEBUG MVC IBRCHEX,0(RA) GET 1ST CHAR,EITHER 1 OR 2 12736000 + LA RA,2(RA) BUMP SCAN POINTER PAST 1, OR 2, 12738000 + BAL IBLR,IBEVCALL CALL EXPRESSION EVALUATOR FOR VALUE 12740000 + STC RC,IBRCMASK SAVE THE BYTE CODE 12742000 + CLI IBRCHEX,C'2' WAS THIS PASS 2 ONLY 12744000 + BE IBRETA YES,DON'T CHANGE AVDEBUG 12746000 + STC RC,AVDEBUG SAVE THE NEW FLAG INTO DEBUG 12748000 + B IBRETA GO RETURN 12750000 +.IBNOD1 ANOP 12752000 + EJECT 12754000 +* * * * * DC - DS * * * * * * * * * * * * * * * * * * * * * * * * * * * 12756000 +* SETS RCMASK = # OPERANDS IN DC STMT (= 1 TO IBMAXCON). * 12758000 +* ADDS TO RCODBLK 1 CNCBLOCK FOR EACH OPERAND. * 12760000 +* SETS RCLQ = LENGTH ATTRIBUTE - 1 OF 1ST OPERAND. * 12762000 +* **NOTE** MUST CHECK FOR MISSING QUOTE, ELSE ABEND MAY OCCUR. * 12762100 + SPACE 1 12764000 +* * * * * REGISTER ALLOCATION FOR DC-DS PROCESSING * * * * * * * * * * 12766000 +* R0 = CURRENT NUMBER OF OPERANDS PROCESSED * 12768000 +* R1 = 1 CONSTANT FOR BXHING * 12770000 +* R2 = CURRENT LENGTH-1 OF IBRCB,WILL BE INCREMENTED BY DC'S * 12772000 +* RW(IBLN) = LOCATION COUNTER FOR BEGINNING OF STATEMENT * 12774000 +* RX = 0 ==> DS, 4 ==> DC STATEMENT. * 12776000 +* RY = MAXIMUM # OPERANDS ALLOWED(= IBMAXCON IF DC, = 4095 IF DS). * 12778000 +* RZ = ADDRESS OF CURRENT CNCBLOCK PART OF IBRCB BEING FILLED(DC'S) * 12780000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12782000 + SPACE 1 12784000 +IBDC LA RX,4 SHOW THIS IS A DC 12786000 + LA RZ,IBRCONS ADDRESS OF 1ST CONST BLOCK 12788000 + LA RY,IBMAXCON MAXIMUM NUMBER OF CONSTANTS ALOOWED 12790000 + B IBDCDS BRANCH TO COMMON CODE 12792000 + SPACE 1 12794000 +IBDS SR RX,RX CLEAR TO SHOW CODTL1 THIS IS DS 12796000 + LA RY,4095 PUT HUGE NUMBER SO WON'T FLAG EXCED 12798000 +IBDCDS SR R0,R0 CLEAR TO SHOW NO OPERANDS RIGHT NOW 12800000 + IC R2,IBRCLENG GET CURRENT LENGTH OF IBRCB 12802000 + $GLOC IBLN GET THE LOCATION COUNTER 12804000 + SPACE 1 12806000 +* LOOP FOR 1 OR MORE OPERANDS. * 12808000 +IBDSCAL LR RB,RX SHOW CODTL1 WHETHER DC OR DS 12810000 + $CALL CODTL1 CALL THE OPERAND PROCESSOR 12812000 + LTR RB,RB WAS THERE AND ERROR 12814000 + BNZ IBDCENDA IF RB^=0, ==> ERROR 12816000 + SPACE 1 12818000 + USING CNCBLOCK,RC RC POINTS AT CODTL1'S CNCBLOCK 12820000 + IC RB,CNCLEN GET LENGTH-1 OF CONSTANT 12822000 + TM CNCTYP,$CNALN IS ALIGNMENT REQUIRED 12824000 + BZ IBDSLQ DO NOT ALIGN UNLESS NEEDED 12826000 + $ALIGR IBLN,RB 12828000 +IBDSLQ BXH R0,R1,IBDSADD SKIP FOLLOWING 2 STMTS IF NOT 1ST 12830000 + $SLOC IBLN SET LOCATION COUNTER FOR STMT START 12832000 + STC RB,IBRCLQ SAVE THE LENGTH ATTRIBUTE 12834000 +IBDSADD AR IBLN,RE ADD THE TOTAL LENGTH OVER 12836000 + LTR RX,RX IS THIS A DS OR A DC 12838000 + BZ IBDSOPA IT IS A DS, BRANCH 12840000 + CR R0,RY COMPARE # OF OPS TO MAXIMUM ALLOWED 12842000 + BH IBDCEXT IF EXCEEDS, FLAG ERROR 12844000 + SPACE 1 12846000 +IBDCMOV MVC 0(CNC$LEN,RZ),CNCBLOCK MOVE BLOCK OVER(DC ONLY) 12848000 + LA R2,CNC$LEN(R2) INCREMENT THE LENGTH 12850000 + LA RZ,CNC$LEN(RZ) BUMP POINTER OF NEXT EMPTY SPACE 12852000 +IBDSOPA CLI 0(RA),C' ' IS THIS THE END 12854000 + BE IBDCHEKA GO TO CHECK FOR MISSING DELIMT 12856000 + CLI 0(RA),C',' IS DELIM ACTUALLY A COMMA 12857000 + BNE IBDCINDL NO, BAD USER, GET HIM 12857100 + BXH RA,R1,IBDSCAL BUMP SCAN POINT AND GET NEXT OPERAND 12858000 + SPACE 1 12858100 +IBDCHEKA C RA,AVSOLAST COMPARE TO @ BLANK BEFORE AFTER ' 12858200 + BL IBDCEND LOW, THEREFOR NO MISSING ' 12858300 + LA RB,$ERNODLM MISSING ', ERROR-SHOW IT 12858400 + B IBDCENDA HAVE IT FLAGGED, , NO ASMBLY 12858500 + SPACE 1 12860000 +IBDCINDL LA RB,$ERINVDM INVALID DELIMITER-SHOW IT 12861000 + B IBDCENDA GO FLAG ERROR 12861100 +IBDCEXT LA RB,$ERDCEXT TOO MANY CONSTANT OPERANDS IN DC 12862000 +IBDCENDA $CALL ERRTAG HAVE THE ERROR FLAGGED 12864000 + LA R2,RC$LEN GET REGULAR LENGTH-1 BACK 12866000 +IBDCEND S IBLN,AVLOCNTR GET DIFFERENCE, TO BE ADDED TO LOCCN 12868000 + STC R0,IBRCMASK SAVE NUMBER OF OPERANDS 12870000 + STC R2,IBRCLENG PLACE THE LENGTH-1 BACK INTO RCB 12872000 + B IBRETA RETURN 12874000 + DROP RC 12876000 + SPACE 2 12878000 +* * * * * DSECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12880000 +IBDSECT LA RB,4 SHOW ESD ROUTINE THIS IS DSECT 12882000 + B IBESCALL GO CALL ROUTINE 12884000 + SPACE 2 12886000 +* * * * * EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12888000 +IBEJECT EQU IBRETA NOTHING TO DO 12890000 + SPACE 2 12892000 +* * * * * END PLUS COMMON END-LTORG CODE* * * * * * * * * * * * * * * * 12894000 +IBEND LR R0,RA SAVE SCAN POINTER 12896000 + $CALL LTDMP1 CALL LITERAL DUMP 12898000 + LR IBLN,RA MOVE LENGTH REQUIRED OVER 12900000 + TM AVTAGS1,$IBDSEC1 ARE WE IN A DSECT RIGHT NOW 12902000 + BO IBEND1 SKIP OVER IF SO,AVLOCHIH IS OK 12904000 + SPACE 1 12906000 + A RA,AVLOCNTR ADD LOCATION COUNTER TO INCREMENT 12908000 + C RA,AVCSHIH IS THIS LARGE THAN PREVIOUS LARGEST 12910000 + BNL *+8 YES,SO USE JUST COMPUTED VALUE 12912000 + L RA,AVCSHIH BACKWARDS ORG,USE PREVIOUS HIGHEST 12914000 + ST RA,AVLOCHIH SAVE HIGHEST VALUE OF CODE,USE IT 12916000 +IBEND1 LR RA,R0 RESTORE THE SCAN POINTER 12918000 + B IBARBZER GO ZERO RB TO SHOW OK 12922000 + SPACE 2 12924000 +* * * * * ENTRY * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12926000 +IBENTRY SR RB,RB SHOW ESENX1 THIS IS ENTRY 12928000 + B IBENEXCL GO CALL ROUTINE 12930000 + SPACE 2 12932000 +* * * * * EQU * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12934000 +* SETS RCEQU = VALUE OF SYMBOL (IF EVALUATION COMPLETE). * 12936000 +* ALSO ZEROS AVLABPT SO THAT MPCON0 DOESNT REDEFINE SYMBOL. * 12938000 +IBEQU EQU * SHOW LENGTH 4> THAN USUAL 12944000 + MVC AVLABPT,AWZEROS ZERO IT, MOCON1 WILL THINK NO LABEL 12946000 + BAL IBLR,IBEVCALL CALL GEN EXPRESSION EVALUTAR 12962000 + BNZ IBERRORA NOGOOD, QUIT,FLAG ERROR. 12963000 + SPACE 1 12976000 + USING SYMSECT,IBLB NOT SYMBOL TABLE USING 12978000 + CLI 0(RA),C' ' RIGHT DELIMITER 12980000 + BNE IBERIND NO,ERROR 12982000 + $SDEF RC,RD,RE DEFINE THE SYMBOL 12984000 + DROP IBLB ERASE USING 12986000 + ST RC,IBRCEQU PLACE VALUE FOR LATER USE 12988000 + MVI IBRCLENG,RC$LEN2 SHOW LENGTH 4> THAN USUAL 12990000 + B IBRETA GO RETURN 12992000 + SPACE 2 12994000 +* * * * * EXTRN * * * * * * * * * * * * * * * * * * * * * * * * * * * * 12996000 +IBEXTRN LA RB,2 SHOW ESENX1 THIS IS EXTRN CALL 12998000 +IBENEXCL $CALL ESENX1 CALL EXTRN-ENTRY ROUTINE 13000000 + LTR RB,RB WERE THERE ERRORS 13002000 + BZ IBRETA NO ERRORS-QUIT 13004000 + B IBERRORA GO HAVE ERROR FLAGGED AND QUIT 13006000 + SPACE 2 13008000 +* * * * * LTORG * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13010000 +IBLTORG EQU IBEND USE SAME CODE. LTDMP1 ALIGNS LOCNTR. 13012000 + SPACE 2 13016000 +* * * * * ORG * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13018000 +IBORG CLI 0(RA),C' ' WAS OPERAND OMITTED 13020000 + BE IBORGOM YES,OMITTED 13022000 + BAL IBLR,IBEVCALL GET EXPRESSION EVALUATED 13024000 + BNZ IBERRORA IF ERROR,RETURN 13026000 + CLI 0(RA),C' ' MAKE SURE ENDS WITH ' ' 13028000 + BNE IBERIND INVALID DELIM 13030000 + IC R2,AVCESDID GET ESDID 13032000 + CR R2,RD MAKE SURE THEY ARE SAME 7 13034000 + BNE IBERORG WRONG SECTION - BAD ORG 13036000 + C RC,AVCSLOW IS IT LOWER THAN LOWEST LEGAL VALUE 13038000 + BL IBERORG LOWERR THAN LOWEST LEGAL, ERROR 13040000 + SPACE 1 13042000 + L R0,AVCSHIH GET HIGHEST VALUE 13044000 + C R0,AVLOCNTR IS HIGHEST NOT HIGHER THAN LOCCNTR 13046000 + BNL IBORGH1 SKIP IF HIGH VALUE>=LOCCNTR 13048000 + $GLOC R0 GET CURRENT LOCCNTR 13050000 +IBORGH1 CR R0,RC IS HIGHEST VALUE LESS THAN NEW 13052000 + BNL IBORGH2 NO IT ISNT,BRANCH 13054000 + LR R0,RC NEW HIGHEST VALUE 13056000 +IBORGH2 ST R0,AVCSHIH STORE NEW HIGH VALUE 13058000 + $SLOC RC SET LOCATION COUNTER 13060000 + B IBRETA GO RETURN 13062000 + SPACE 1 13064000 +* OMITTED OPERAND IN ORG==>SET TO HIGHEST UNUSED VALUE * 13066000 +IBORGOM $GLOC R0 GET LOCCNTR 13068000 + C R0,AVCSHIH COMPARE TO HIGHEST VALUE 13070000 + BNL IBORGO1 SKIP IF LOCCNTR HIGH 13072000 + L R0,AVCSHIH USE HIGHEST VALUE 13074000 +IBORGO1 ST R0,AVCSHIH SET POSSIBLY NEW HIGHEST LOCCNTR VAL 13076000 + $SLOC R0 SET NEW LOCCNTR VALUE 13078000 + B IBRETA GO RETURN 13080000 + EJECT 13082000 +* * * * * PRINT * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13084000 +* SETS RCMASK = VALUE OF PRINT CODE TO BE SET BY PRINT. * 13086000 +* ALSO IMMEDIATELY SETS AVPRINT1 TO CORECT PRINT CONTROL. * 13086100 +IBPRINT LA RE,IBPLAST ADDRSS OF LAST IN TABLE 13088000 + SR RD,RD CLEAR FOR INSERTIONS 13090000 + MVI AVFWORK1,0 INIT=0 FOR CORRECTNESS TESTS 13091000 + MVC IBRCMASK,AVPRINT1 COPY CURRENT PRINT STATUS 13091500 + SPACE 1 13092000 +* LOOP TO LOOK UP NEXT OPERAND IN LEGAL PRINT LIST * 13094000 +IBPLOOP LA R14,IBPTAB @ BEGINNING OF TABLE 13096000 + USING IBPSECT,R14 NOTE THE TABLE 13098000 + SPACE 1 13100000 +IBPLOOPA IC RD,IBPLENG GET LENGTH-1 OF ENTRY 13102000 + STC RD,*+5 STORE L-1 INTO CLC INST 13104000 + CLC 0($CHN,RA),IBPOPR COMPARE INCOMING OPERAND 13106000 + BNE IBPLOOPB GO TO BOTTOM IF NOT 13108000 + SPACE 1 13110000 + MVC *+7(1),IBPVO COPY BIT TO CHECK INTO TM NEXT 13112000 + TM AVFWORK1,$ TEST: SEE IF 2 OF SAME OR CONTRADCT 13114000 + BNZ IBERINVF INVALID 13116000 + OC AVFWORK1(1),IBPVO OR IN: RECORD FOR COMPATIBLITY TST 13117000 + OC IBRCMASK,IBPVO SET DESIRED BIT DEFINITELY = 1 13118000 + XC IBRCMASK,IBPVX XOR: SET BIT OFF IF REQUIRED OFF 13119000 + MVC AVPRINT1,IBRCMASK KEEP AVPRINT1 SAME VALUE AS RCMASK 13119500 + LA RA,1(RD,RA) BUMP SCP TO DELIMITER 13120000 + CLI 0(RA),C' ' IS THIS THE END 13122000 + BE IBRETA YES,RETURN 13124000 + CLI 0(RA),C',' CHECK DELIMITER 13126000 + BNE IBERIND ERROR IF NOT 13128000 + BXH RA,R1,IBPLOOP GO BACK FOR NEXT OP,BUMP SCPTR 13130000 + SPACE 1 13132000 +IBPLOOPB LA R14,IBPOPR-IBPSECT+1(R14) INCREMENT BY RITHT OFFSET 13134000 + BXLE R14,RD,IBPLOOPA INCREMENT WITH VARIABLE LENGTH 13136000 + B IBERINVF IF FALSS THRU==>UNRECOGNIZABLE 13138000 + DROP R14 CLEAR USING 13140000 + SPACE 2 13142000 +* * * * * SPACE * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13144000 +* SETS RCMASK = # LINES TO BE SPACED. OMITTED OPERAND ==> 1. * 13146000 +IBSPACE CLI 0(RA),C' ' IS OPERAND OMITTED 13148000 + BE IBRETA SKIP CALL,LEAVE IBRCMASK=1 13150000 + $CALL SDDTRM GET VALUE FOR SPACING 13152000 + LTR RB,RB WAS VALUE OK 13153000 + BNZ IBERRORA BRANCH IF ERROR 13154000 + LTR RC,RC WAS VALUE ^=0 13156000 + BZ IBRETA RETURN IF =0,LEAVE 1 AS SPACE VALUE 13158000 + STC RC,IBRCMASK STORE VALUE FOR PASS 2. 13160000 + B IBRETA RETURN 13162000 + EJECT 13164000 +* * * * * START PLUS COMMON START,DSECT,CSECT CODE * * * * * * * * * * 13166000 +* SETS RCMASK = NEW CURRENT ESDID NUMBER. * 13168000 +* START SETS ITS VALUE INTO AVLOCLOW&AVFENTER FOR INIT. * 13169000 +IBSTART TM AVTAGS1,$IBSTAR1 IS START NO LONGER ALLOWED 13170000 + BO IBSTERR BRANCH-ERROR 13172000 + SR RC,RC CLEAR FOR VALUE IF OMITTED 13174000 + CLI 0(RA),C' ' WAS OPERAND OMITTED. 13176000 + BE IBESCALA YES,GO CALL SED ROUTINE 13178000 + $CALL SDBCDX GET SELF-DEFINING TERM 13179000 + LTR RB,RB WAS VALUE OK 13180000 + BP IBERRORA BRANCH, ERROR CODE IN RB 13181000 + BM IBERINVF RB=-4, NOT SELF-DEFTERM, ERROR 13181500 + CLI 0(RA),C' ' MAKE SURE DELIMITER OK 13182000 + BNE IBERIND INVALID DELIMITER 13184000 + LA RB,7 FOR DBLWD ALIGNMENT 13185000 + $ALIGR RC,RB ALIGN STARTING VALUE TO *8 13185500 + ST RC,AVLOCLOW THIS IS NOW LOWEST LOC(UT WANTS IT) 13186000 + ST RC,AVFENTER STORE FOR BEGINNING @ 13187000 +IBESCALA LA RB,2 SHOW ESD ROUTINE THIS IS A START 13188000 + SPACE 1 13190000 +* COMMON CODE - START, DSECT, CSECT. 13192000 +IBESCALL LR R0,RA SAVE SCAN POINTER 13194000 + $CALL ESCSEC CALL FOR CSECT,DSECT,OR START 13196000 + OI AVTAGS1,$IBSTAR1 FLAG NO MORE STARTS 13198000 + LR RA,R0 RESTORE SCAN POINTER 13200000 + LTR RB,RB CHECK FOR ERRPRS 13202000 + BNZ IBERLAB GO HAVE ERRORS FLAGGED IF NEEDED 13204000 + MVC IBRCMASK,AVCESDID KEEP NEW ESDID VALUE 13206000 + B IBRETA RETURN 13208000 + SPACE 2 13210000 +* * * * * TITLE * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13212000 +* SETS RCMASK = LENGTH OF TITLE OPERAND FIELD. * 13214000 +IBTITLE CLI 0(RA),C'''' MAKE SURE DELIM OK 13216000 + BNE IBERIND ERROR IF NOT 13218000 + AR RA,R1 BUMP SCAN POINTER BY 1 13220000 + $CALL CCCON1 HAVE THE TITLE CHECKED 13222000 + LTR RB,RB WAS THERE ERROR 13224000 + BNZ IBERRORA YES,GO FLAG IT 13226000 + CLI 1(RA),C' ' MAKE SURE ENDS WITH QUOTE BLANK 13228000 + BNE IBERIND BRANCH IF ERROR 13230000 + C RA,AVSOLAST WAS IT >= @ BLANK BEFORE AFERQUOTE 13231000 + BNL IBERNODL TOO LONG, MISSING DELIMITER 13231500 + SR RC,R1 S RC,=F'1' GET LENGTH-1 AS NEEDED 13231900 + STC RC,IBRCMASK SAVE THE LEGNTH REQUIRED 13232000 + BXH RA,R1,IBRETA BUMP SCAN POINTER AND RETURN 13234000 + SPACE 2 13236000 +* * * * * USING * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13238000 +IBUSING EQU IBASCAN NOTHING TO DO THIS PASS 13240000 + EJECT 13242000 +* * * * * INDIVIDUAL ERROR EXITS * 13244000 +IBERNODL LA RB,$ERNODLM MISSING DELIMITER ERROR 13245000 + B IBERRORA GO FLAG AND EXIT 13245500 +IBERICNO LA RB,$ERICNOP ILLEGAL CNOP OPERAND COMBINATION 13246000 + B IBERRORA GO TO FLAG 13248000 +IBERIND LA RB,$ERINVDM INVALID DELIMITER 13250000 + B IBERRORA SET ERROR CODE AND RETUN 13252000 +IBERINVF LA RB,$ERINVF ILLEGAL FIELD OF SOME SORT 13254000 + B IBERRORA GO FLAG IT 13256000 +IBERNOPR LA RB,$ERNOOPR MISSING OPERAND 13258000 + B IBERRORA GO PUT OUT ERROR CODE 13260000 +IBERORG LA RB,$ERILORG ILLEGAL ORG 13262000 + B IBERRORA GO FLAG IT 13264000 +IBSTERR LA RB,$ERSTART SHOW BAD START, FALL THRU-IBERRORA 13270000 + SPACE 2 13272000 +* * * * * ALL ERRORS EXCEPT LABEL ERRORS * 13274000 +IBERRORA $CALL ERRTAG HAVE LABEL FLAGGED 13276000 + B IBRETA RETURN TO CALLER 13278000 + SPACE 2 13280000 +* * * * * LABEL ERRORS * 13282000 +IBERLAB $CALL ERRLAB CALL LABEL ERROR 13284000 + B IBRETA RETURN TO CALLER 13286000 + SPACE 2 13288000 +* INTERNAL SUBROUTINES. 13290000 + SPACE 2 13320000 +* * * * * EXPRESSION EVALUATION - CALL TO EVALUT * 13322000 +IBEVCALL $CALL EVALUT CALL EXPRESSION EVALUATOR 13324000 + LTR RB,RB SET THE CONDTION CODE 13326000 + BR IBLR RETURN TO CALLER 13328000 + EJECT 13330000 +* * * * * INTERNAL CONSTANTS * 13332000 +* * * * * 2ND LEVEL JUMP TABLE FOR IBASM1 * 13334000 +IBAJUMP $AL2 IBASMJ,(IBUSING,IBDROP,IBSTART,IBCSECT,IBDSECT,IBENTRY,I#13336000 + BEXTRN,IBEQU,IBDC,IBDS,IBCCW,IBTITLE,IBEJECT,IBSPACE,IBP#13338000 + RINT,IBORG,IBLTORG,IBCNOP,IBEND),-2 13340000 + AIF (&$DEBUG).IBNOD2 SKIP IF NOT DEBUG MODE 13342000 + DC AL2(IBDEBUG-IBASMJ) OFFSET TO DEBUG ROUTINE 13344000 +.IBNOD2 ANOP 13346000 + SPACE 1 13348000 +* * * * * PRINT OPERAND TABLE * 13350000 +IBPTAB IBPRTAB ON,$IBPON SET BIT ON 13350200 + IBPRTAB OFF,$IBPON,* SET 'ON' BIT OFF 13350400 + IBPRTAB GEN,$IBPGEN SERT GEN BIT ON 13350600 + IBPRTAB NOGEN,$IBPGEN,* SET 'GEN' BIT OFF 13350800 + IBPRTAB DATA,$IBPDAT SET DATA BIT ON (ONLY COMPATIBLITY) 13351000 + IBPRTAB NODATA,$IBPDAT,* SET 'DATA' BIT OFF 13352000 +IBPLAST EQU *-1 @ LAST BYTE FOR LIMIT 13354000 + SPACE 1 13356000 + LTORG 13370000 + SPACE 1 13372000 +* * * * * INTERNAL VARIABLES * 13374000 +* * * * * RCB AREA FOR IBASM1 * 13376000 +IBRCB DS 0D RECORD CODE BLOCK 13378000 +IBRCLENG DS C LENGTH OF RCB 13380000 +IBRCLOC DS AL3 LOCATION COUNTER VALUE 13382000 +IBRCTYPE DS C OPCODE TYPE 13384000 +IBRCHEX DS C 2ND LEVEL TAGS-LABLE&OPERAND 13386000 +IBRCMASK DS C FROM OPCTYPE=LENGTH ATTRIBUTE 13388000 +IBRCLQ DS C BYTE FOR LENGTH ATTRIBUTE L'* 13390000 +IBRCEQU DS 0F VALUE OF AN EQUATE SYMBOL 13392000 +IBRCONS DS (IBMAXCON)CL(CNC$LEN) CONSTANT CODE BLOCKS 13394000 + SPACE 1 13396000 +* * * * * DSECT USED BY PRINT ROUTINE FOR TABLE LOOKUP * * * * * * * * 13398000 +IBPSECT DSECT 13400000 +IBPLENG DS C NUMBER OF CHARACTERS IN CODE 13402000 +IBPVO DS B BIT TO BE OR'D IN: BIT TO TEST 13404000 +IBPVX DS B BIT TO BE XOR'D IN, RESET =0 IF NEED 13406000 +IBPOPR DS C OPERAND CHARACTERS(ON,OFF,ETC) 13408000 + DROP RAT,R13 CLEAN UP USING SIUTATION 13410000 + TITLE '*** ICMOP2 - MACHINE INSTRUCTIONS - PASS 2 ***' 13412000 +**--> CSECT: ICMOP2 2 MACHINE OPERATIONS - PASS 2 . . . . . . . . . 13414000 +*. THIS MODULE IS 1 OF THE 2 PASS 2,LEVEL 2 ROUTINES IN THE . 13414100 +*. ASSIST ASSEMBLER. IT PROCESSES ALL MACHINE INSTRUCTIONS IN . 13414200 +*. THE SECOND PASS, SCANNING ALL THE OPERAND FIELDS AND CREATING. 13414300 +*. THE OBJECT CODE FOR THEM. IT ALSO DOES THE SETUP REQUIREED . 13414400 +*. FOR OUTPT2 TO PRODUCE THE PRINTED LISTING. THIS ROUTINE HAS . 13414500 +*. MANY SPECIAL-CASE SECTIONS WHICH ARE USED FOR SPEED, AND . 13414600 +*. WHICH COULD USE LESS SPACE IF CALLS TO THE GENERAL EXPRESSION. 13414700 +*. EVALUATOR EVALUT WERE USED INSTEAD. . 13414800 +*. ENTRY CONDITIONS . 13416000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHARACTER OF OPERAND FIELD) . 13418000 +*. RC = ADDRESS OF RECORD CODE BLOCK(RCODBLK) FOR STATEMENT . 13420000 +*. RE = ADDRESS OF RECORD SOURCE BLOCK(RSBLOCK) FOR STATEMENT . 13422000 +*. CALLS BRDISP,ERRTAG,EVALUT,LTGET2,SDBCDX,SDDTRM . 13424000 +*. CALLS SDBCDX,SYFIND,OUTPT2,UTPT2 . 13424100 +*. USES MACROS: $AL2,$CALL,$GLOC,$RETURN,$SAVE,ICT . 13424200 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 13426000 + SPACE 1 13427000 +ICMOP2 CSECT 13428000 + $DBG 90,* 13430000 +ICB1D1 EQU X'10' (ICYFLAG) - ==> B(D) OPERAND FORMAT 13432000 +ICBX2 EQU X'08' (ICYFLAG) ==> D(X,B) FORMAT,NOT L 13434000 +ICBSOPN2 EQU X'04' (ICYFLAG) ==> B(D) STORED INTO OPN2 13436000 +ICBSEA2 EQU X'02' (ICYFLAG) ==> @ GOES TO ICYEA2 13438000 +ICYXLFN EQU X'80' (ICYF2) ==> X OR L FIELD PRESENT 13440000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 13442000 + USING RCODBLK,RC NOTE POINTER TO CODE BLOCK 13444000 + EJECT 13446000 +* * * * * OVERALL REGISTER USAGE FOR ICMOP2 * * * * * * * * * * * * * * 13448000 +* R1 = @ REGISTER-HI-ORDER BYTE =0. OFTEN USED TO SAVE SCAN PTR RA * 13450000 +* R2 = BYTE REGISTER - HI-ORDER 3 BYTES = 0. USED FOR INSERTIONS,ETC* 13452000 +* RW = LEVEL 1 LINK REGISTER * 13454000 +* RX = LEVEL 3 LINK REGISTER * 13456000 +* RY = 1 USED FOR INCREMENTING,DECREMENTING REGS,BXH'ING SCAN PTR* 13458000 +* RZ = LEVEL 2 LINK REGISTER * 13460000 +* RA = SCAN POINTER REGISTER - @ NEXT CHARACTER TO BE EXAMINED * 13462000 +* RB = USUAL PLACE FOR AN ESDID TO BE KEPT,IF THERE IS ONE * 13464000 +* RC = NORMAL PARAMATER REGISTER FOR RETURN OF A CONVERTED VALUE * 13466000 +* R13= @ SAVEAREA AND BASE REGISTER * 13468000 +* R14-R15 LOCAL WORK REGISTERS, EXTERNAL LINK REGISTERS * 13470000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13472000 + SPACE 1 13474000 + $SAVE RGS=(R14-R6),BR=R13,SA=ICMOSAVE 13476000 + MVC ICRCB(RCLITEQ-RCODBLK+4),RCODBLK MOVE TO FREE RC 13478000 + DROP RC NO LONGER USING,WILL NEED EVERY REG 13480000 + LM R0,R3,AWZEROS ZERO OUT THESE REGS 13482000 + STM R0,R3,ICYBLOCK ZERO OUT BLOCK FOR OBJ CODE 13484000 + LA RY,1 INITIALIZE REGISTER 13486000 + MVC ICYOP(2),ICRCHEX MOVE OPCODE-MASK OVER 13488000 + AIF (NOT &$XREF).NOXRF15 A 13488050 + IC R2,ICYOP GET OPCODE A 13488100 + IC R2,ICXRTAB(R2) GET FLAG BYTE FROM TABLE A 13488200 + STC R2,AVXRMDFT STORE FLAG BYTE IN FLAG A 13488400 +.NOXRF15 ANOP 13488410 + NI ICYR1R2,X'F0' REMOVE 2ND NIBBLE,LEAVING MASK ONLY 13490000 + SPACE 1 13490500 +* OBTAIN TYPE INFORMATION,INSTRUCTION SECTION @. TAKE 13491000 +* BRANCH TO ONE OF LEVEL 0 INSTRUCTION PROCESSORS. 13491500 + IC R2,ICRCTYPE GET TYPE BYTE 13492000 + LH R14,ICOJUMP(R2) GET OFFSET @ FOR LEVEL 0 ROUTINE 13494000 + SRL R2,1 DIVIDE BY 2 FOR BYTE INDEX 13496000 + IC R2,ICTTAB(R2) GET FLAG BYTE BELONGING TO TYPE 13498000 + STC R2,ICYFLAG STORE FLAG BYTE FOR LATER USE 13500000 +ICMOJ B ICMOJ(R14) TAKE BRANCH TO INSTRUCTION TYPE SUBR 13502000 +* * * * * JUMP OFFSET TABLE FOR INSTRUCTION TYPE PROCESSORS (LEVEL 0) * 13504000 +ICOJUMP $AL2 ICMOJ,(ICRRM,ICRXM,ICRR,ICRX,ICRS,ICRSH,ICSI,ICSS,ICSS2,#13506000 + ICRSO,ICSPC),-2 13508000 + EJECT 13510000 +* * * * * INDIVIDUAL ERROR EXITS * 13512000 +ICNUNDEF LA RB,$ERUNDEF UNDEFINED SYMBOL 13514000 + LR RA,R1 GET A SCAN POINTER BACK 13516000 + BCT RA,ICNERROR MOVE SCAN PTR BACK,GO FLAG ERR 13518000 +ICNEABS LA RB,$ERNEABS AN ABSOLUTE TERM OR EXPRESSION NEEDD 13520000 + B ICNERROR GO FLAG ERROR 13522000 +ICNBADSY LA RB,$ERINVSY INVALID SYMBOL 13524000 + BCT RA,ICNERROR MOVE SCAN PTR BACK,GO FLAG ERR 13526000 +ICNLITER LA RB,$ERTLIT ILLEGAL USE OF LITERAL 13528000 + B ICNERROR GO FLAG ERROR 13530000 +ICNRELC LA RB,$ERRELOC RELOCATABILITY ERROR 13532000 + BCT RA,ICNERROR MOVE SCAN PTR BACK,GO FLAG ERR 13534000 +ICNEXGTB AR RA,RY BUMP SCAN PTR TO ALLOW FOR BCT 13536000 +ICNEXGTA LA RB,$EREXGTA EXPRESSION TOO LARGE 13538000 + BCT RA,ICNERROR MOVE SCAN PTR BACK,GO FLAG ERR 13540000 +ICNADDR LA RB,$ERADDR ADDRESSIBILITY ERROR 13542000 + BCT RA,ICNERROR MOVE SCAN PTR BACK,GO FLAG ERR 13544000 +ICNILLEG CLI 0(RA),C' ' WAS ILLEGAL A BLANK (MISSING) 13546000 + BNE ICNINVDM NO,SOMETHING ELSE ILLEFAL 13548000 +ICNNOOPR LA RB,$ERNOOPR MISSING OPERAND 13548500 + B ICNERROR GO HAVE IT FLAGGED 13549000 +ICBLANK CLI 0(RA),C' ' FINAL CHECK FOR BLANK 13550000 + BE ICOUTPT BRANCH OUT IF OK 13552000 +ICNINVDM LA RB,$ERINVDM INVALID DELIMITER (MOST COMMON) 13554000 +ICNERROR $CALL ERRTAG HAVE ERROR FLAGGED 13556000 +ICNERRF MVC ICYEA1(14),AWZEROS ZERO THE INSTRUCTION OUT 13558000 + SPACE 1 13560000 +* * * * * ICOUTPT - COMMON EXIT - PRODUCE OBJECT CODE,PRINT STMT * 13562000 +ICOUTPT $GLOC RA GET LOCATION COUNTER FOR UTPUT2 13564000 + LA RC,ICYOP @ OBJECT CODE FOR UTPUT2 13568000 + IC R2,ICRCLQ GET LENGTH-1 OF STATEMENT CODE 13570000 + LR RD,R2 MOVE OVER FOR LENGTH-1 FOR UTPUT2 13572000 + LR RE,RY SET RE = 1 ==> PRODUCE 1 OF OBJECT 13574000 + $CALL UTPUT2 HAVE OBJECT CODE LOADED 13576000 + SPACE 1 13578000 +* SET UP AND CALL PRINTER ROUTINE * 13580000 + LA RB,$OUMACH SHOW THIS IS A MACHINE INSTRUCTION 13582000 + LA RC,ICYBLOCK GET @ BLOCK 13584000 + LR RD,R2 MOVE LENGTH-1 WHERE OUTPT2 WANTS IT 13586000 + $CALL OUTPT2 CALL OUTPUT ROUTINE 13588000 + AIF (NOT &$XREF).ICNXRF1 SKIP IF NO CROSS-REF OPTION J 13589000 + MVI AVXRTYPE,AVXRFTCH MAKE FETCH TYPE NORMAL FOR REST J 13589010 +.ICNXRF1 ANOP 13589020 +ICRET $RETURN RGS=(R14-R6) 13590000 + EJECT 13592000 +* * * * * ICRR - NORMAL RR INSTRUCTIONS,EXTENDED MNEM RR'S - LEVEL - 0* 13594000 +ICRRM BAL RZ,ICREG GO GET REG 2 FIELD 13594500 + EX RC,ICOIR HAVE IT ORED IN 13594600 + B ICBLANK GO CHECK FOR BLANK 13594700 +ICRR EQU * A 13596000 + CROSSET 1 SET FLAG M/F FIRST OPRND A 13596500 + BAL RW,ICWREG1 GO GET FIRST REGISTER A 13597000 + CROSSET 2 SET FLAG M/F 2ND OPERAND A 13598000 + BAL RZ,ICREG GO GET 2ND REGISTER 13600000 + EX RC,ICOIR HAVE IT OR'D INTO R2 FIELD 13602000 + AIF (NOT(&$FLOTA OR &$FLOTAX OR &$S370A)).ICRRNF 13604000 + TM ICRCMASK,IAB SHOULD R2 BE EVEN? 13606000 + BNO ICBLANK NO, SO BRANCH TO CHECK FOR BLANK 13608000 + TM ICYR1R2,X'01' WAS THRE AN ODD REG IN 2ND POSITION 13610000 + BZ ICBLANK NO, SO OK -BRANCH 13612000 + BAL RZ,ICWODDR HAVE ODD REG FLAGGED 13614000 +.ICRRNF B ICBLANK GO TO CHECK FOR BLANK AND QUIT 13616000 + SPACE 2 13618000 +* * * * * ICRX - NORMAL RX AND RX EXTENDED MNEMONICS - LEVEL - 0 * 13620000 +ICRX EQU * A 13620050 + CROSSET 1 SET FLAG FOR 1ST OPERAND A 13620100 + BAL RW,ICWREG1 CALL FOR 1ST REG A 13622000 +ICRXM EQU * ENTRY FOR RX EXTENDED MNEMONICS 13624000 + CROSSET 2 SET FLAG 2ND OPERAND A 13624500 + BAL RW,ICXBD GO GET THE OPERAND 13626000 + TM ICYF2,ICYXLFN WAS INDEX SPECIFIED 13628000 + BZ *+10 SKIP OVER IF SO 13630000 + OC ICYR1R2,ICYXL PLACE X2 FIELD IN,IF IT WAS SPECIFIE 13632000 + B ICBLANK GO CHECK FOR BLANK 13634000 + SPACE 2 13636000 +* * * * * ICRS - REGULAR NON-SHIFT RS INSTRUCTIONS - LEVEL - 0 * 13638000 +ICRS EQU * A 13640000 + CROSSET 1 SET 1ST OPERAND FLAG A 13640200 + BAL RW,ICWREG1 GET 1ST REGISTER A 13640400 + CROSSET 2 SET SECOND OPERAND A 13640600 + BAL RZ,ICREG GET 2ND REG 13642000 + EX RC,ICOIR HAVE 2ND REG PLACED ALSO 13644000 + CLI 0(RA),C',' IS DELIM WHAT IT SHOULD BE 13646000 + BNE ICNINVDM NO-ERROR 13648000 + CROSSET 3 SET 3RD OPERAND A 13648500 + BXH RA,RY,ICRSH1 BUMP PAST , AND GO GET D2-B2 13650000 + SPACE 2 13652000 +* * * * * ICRSH - RS SHIFT INSTRUCTIONS - LEVEL - 0 * 13654000 +ICRSH EQU * A 13656000 + CROSSET 1 SET FLAG A 13656200 + BAL RW,ICWREG1 GET 1ST REGISTER A 13656400 + CROSSET 2 SET SECOND OPERAND A 13656600 +ICRSH1 BAL RW,ICXBD GET BASE-DISP (COMMON RS CODE) 13658000 + B ICBLANK GO TEST FR BLANK AND QUIT 13660000 + EJECT 13662000 +* * * * * ICSI - NORMAL SI INSTRUCTIONS - OP D1(B1),I2 - LEVEL - 0 * 13664000 +ICSI EQU * A 13664050 + CROSSET 1 1ST OPERAND A 13664200 + BAL RW,ICXBD GET B(D) FIELD A 13666000 + CLI 0(RA),C',' CHECK FOR COMMA 13668000 + BNE ICNINVDM BRANCH IF NOT-ILLEGAL 13670000 + AR RA,RY BUMP SCAN POINTER PAST , 13672000 + SPACE 1 13674000 +ICSI1 LR R1,RA SAVE SCAN PTR, IN CASE NOT JUST SDT 13675000 + BAL RX,ICSDTRM GO GET SDT IF IT IS ONE 13676000 + BM ICSI2 NO IT WAN'T-GIVE UP AND USE EXPRESSI 13678000 + CLI 0(RA),C' ' WAS THIS ALL (WE HOPE SO) 13680000 + BE ICSI3 YES,WE GOT BY WITH SIMPLE CASE 13682000 + LR RA,R1 NOT SD TERM BY SELF-RESTORE SCP 13684000 + SPACE 1 13686000 +ICSI2 BAL RX,ICEXP GO GET EXPRESSION 13688000 + BP ICNEABS EXPRESSION HAD TO BE ABSOLUTE-ERROR 13690000 +ICSI3 CL RC,AWFXFF WAS EXPRESSION SMALL ENOUGH 13692000 + BH ICNEXGTA NO-TOO BIG 13694000 + STC RC,ICYR1R2 SAVE I2 FIELD 13696000 + B ICBLANK GO CHECK FOR BLANK AND FINISH UP 13698000 + SPACE 1 13700000 +ICSS EQU * A 13700050 +* * * * * ICSS - SS INSTRUCTIONS WITH 1 LENGTH - LEVEL - 0 * 13702000 + CROSSET 1 1ST OPERAND FLAG SET A 13702500 + BAL RW,ICXBD GET 1ST BASE DISPLACEMENT A 13704000 + BAL RX,ICULEN PICK UP LENGTH IN R2 13706000 + STC R2,ICYR1R2 SAVE INTO INSTRUCTION 13708000 + CLI 0(RA),C',' IS DELIMITER OK 13710000 + BNE ICNINVDM NO,ERROR 13712000 + AR RA,RY BUMP SCAN POINTER PAST , 13714000 + SPACE 1 13716000 + OI ICYFLAG,ICB1D1+ICBSOPN2+ICBSEA2 SET FOR 2ND OP 13718000 + CROSSET 2 2ND OPERAND A 13718500 + BAL RW,ICXBD GO PROCESS 2ND OPERAND 13720000 + B ICBLANK GO CHECK FOR BLANK AND QUIT 13722000 + SPACE 1 13724000 +* * * * * ICSS2 - SS INSTRUCTIONS WITH 2 LENGTHS - LEVEL - 0 * 13726000 +ICSS2 EQU * A 13728000 + CROSSET 1 SET 1ST OPERAND FLAG A 13728500 + BAL RW,ICXBD GET 1ST BASE DISPLACEMNT J 13728700 + BAL RX,ICULEN GO GET LENGTH 13730000 + C R2,AWF15 MAKE SURE LEGAL SIZE 13732000 + BH ICNEXGTA TOO BIG-BRANCH 13734000 + SLL R2,4 SHIFT OVER FOR L1 POSITION 13736000 + STC R2,ICYR1R2 SAVE THE LENGTH 13738000 + CLI 0(RA),C',' CHECK DELIMITER 13740000 + BNE ICNINVDM ERROR IF NOT 13742000 + AR RA,RY BUMP SCAN POINTER 13744000 + SPACE 1 13746000 + AIF (NOT &$S370A).ICSS2 SKIP IF NOT ASSEMBLING S/370'S 13746100 + CLI ICYOP,240 IS THIS A SRP INSTRUCTION? 13746200 + BE ICSS2A YES - BRANCH 13746300 + SPACE 2 13746400 +.ICSS2 ANOP 13746500 + OI ICYFLAG,ICBSOPN2+ICBSEA2 RESET FLAGS FOR 2ND OPRND 13748000 + MVI ICYF2,0 REZERO RETURN CODES FLAG 13750000 + CROSSET 2 SET FLAGS A 13751000 + BAL RW,ICXBD GET 2ND LENGTH-BASE-DISP 13752000 + BAL RX,ICULEN GO PICK UP LENGTH IN R2 13754000 + C R2,AWF15 MAKE SURE LEGAL SIZE 13756000 + BH ICNEXGTA NO-TOO BIG-ERROR 13758000 + EX R2,ICOIR HAVE THE LENGTH OR'D IN 13760000 + B ICBLANK GO CHECK FOR BLANK AND QUIT 13762000 + AIF (NOT &$S370A).ICSS2A SKIP IF NOT ASSEMBLIN& S/3 0'S 13762100 + SPACE 2 13762200 +* * * * * ICSS2A - SPECIAL CODE FOR SRP (S/370) INSTRUCTION 13762300 +ICSS2A OI ICYFLAG,ICB1D1+ICBSOPN2+ICBSEA2 SET FOR 2ND OPND 13762400 + CROSSET 2 SET 2ND OPERAND FLAG A 13762450 + BAL RW,ICXBD GO PROCESS 2ND OPERAND 13762500 + CLI 0(RA),C',' CHECK DELIMITER 13762600 + BNE ICNINVDM ERROR IF NOT 13762700 + AR RA,RY BUMP SCAN POINTER 13762800 + BAL RZ,ICREG GO GET IMMEDIATE FIELD 13762900 + CH RC,AWH10 IS IMMEDIATE TO LARGE? 13763000 + BNL ICNEXGTA YES - ERROR 13763100 + EX RC,ICOIR HAVE IMMEDIATE OR'ED IN 13763200 + B ICBLANK GO CHECK FOR BLANK AND QUIT 13763300 +.ICSS2A ANOP 13763400 + EJECT 13764000 +* * * * * ICRSO - SPM,SVC, AND IO-TYPE SI'S - LEVEL - 0 * 13766000 +ICRSO EQU * 13768000 + CLI ICYOP,X'0A' IS IT SVC 13772000 + BE ICSI1 YES, USE IMMEDIATE FIELD PART OF SI 13774000 + CLI ICYOP,X'01' IS THIS AN XOPC INSTRUCTION M 13775000 + BE ICSI1 YES, USE IMMEDIATE FIELD PART OF SIM 13775100 + CLI ICYOP,X'04' IS IT SPM 13776000 + BE ICRSO1 YES,GO PROCESS 13778000 +* FALL THRU ==> ODD SI INSTRS (TS, SIO, TCH, ETC) 13780000 + MVI ICYFLAG,$ICBEA1+ICB1D1 CHANGE FLAG FOR SEMI-SI 13782000 + AIF (NOT &$P370A).ICRSO IF NO PRIVELEGED S/370'S, BRANCH 13782100 + MVO ICYR1R2(2),ICRCMASK MOVE IN MASK DIGIT FOR S/370 13782200 +.ICRSO ANOP 13782300 + BAL RW,ICXBD GET BASE-DISPLACEMENT 13784000 + B ICBLANK GO FOR BLANK AND QUIT 13786000 + SPACE 1 13788000 +ICRSO1 BAL RZ,ICREG SPM HAS 1 REG,GO GET IT 13790000 + SLL RC,4 SHIFT OVER FOR RIGHT POSITION 13792000 + STC RC,ICYR1R2 STORE R1 FIELD 13794000 + B ICBLANK LOOK FOR BLANK AND QUIT 13796000 + SPACE 1 13798000 +* * * * * ICSPC - SPECIAL INSTRUCTIONS - XREAD,XPRNT,XPNCH - LEVEL - 0* 13800000 +ICSPC EQU * FOR SPECIAL IO INSTRUCTIONS 13802000 + AIF (NOT &$XIOS).ICXIO SKIP IF THESE SPECIALS NOT ALLOWED 13804000 + MVI ICSPCDUM+1,0 MAKE A NOOP 13806000 + CLI ICYR1R2,X'60' WAS IT XDUMP 13808000 + BNE ICSPCO SKIP IF NOT XDUMP IN 1ST PLACE 13810000 + MVI ICSPCDUM+1,X'F0' SHOW XDUMP WITH ARGUMENTS 13811000 + CLI 0(RA),C' ' ARE THERE ANY OPERANDS 13812000 + BNE ICSPCO YES, ALREADY SET RIGHT, CONTINUE 13814000 + MVI ICYOP,X'E1' CHANGE OPCODE E0 TO E1-REGS XDUMP 13816000 + B ICOUTPT GO OUTPUT CODE 13817000 + SPACE 1 13818000 +ICSPCO BAL RW,ICXBD GET ADDRESS OPERAND 13820000 + TM ICYF2,ICYXLFN WAS INDEX REG USED 13822000 + BZ *+10 NO,SKIP IT 13824000 + OC ICYR1R2,ICYXL PUT LENGTH IN 13826000 + CLI 0(RA),C' ' WAS THIS ALL 13828000 + BNE ICSPC1 SKIP IF LENGTH FOLLOWS 13830000 + IC R2,ICYR1R2 GET MASK VALUE 13832000 + SRL R2,5 SHIFT OVER FOR BYTE INDEXING 13834000 + IC R2,ICSPCDLT(R2) GET DEFAULT LENGTH VALUE 13836000 + STH R2,ICYOPN2 SAVE THE VALUE IN D(B) FIELD 13838000 + B ICOUTPT GO HAVE PRINTED AND RETURN 13840000 + SPACE 1 13842000 +ICSPC1 CLI 0(RA),C',' MAKE SURE DELIM WHAT IT'S SUPPOSED T 13844000 + BNE ICNINVDM ERROR - BRANCH 13846000 + AR RA,RY BUMP SCAN POINTER 13848000 + CLI 0(RA),C'(' IS THIS REGISTER FORM 13850000 + BNE ICSPC2 NO,MUST BE SPECIFIED LENGTH 13852000 +ICSPCDUM BC $CHN,ICNINVDM XDUMP WITH ARGS DOESN'T ALLOW (R) FM 13854000 + AR RA,RY BUMP SCAN POINTER PAST ( 13856000 + BAL RZ,ICREG GET REGISTER VALUE 13858000 + SLL RC,4 SHIFT FOR POSITION 13860000 + STC RC,ICYOPN2 SAVE INTO B POSTION 13862000 + CLI 0(RA),C')' IS DELIMITER RIGHT 13864000 + BNE ICNINVDM NO-ERROR-BRANCH 13866000 + BXH RA,RY,ICBLANK BUMP SCP AND GO CHK BLANK P 13868000 + SPACE 1 13870000 +ICSPC2 BAL RX,ICEXP GO GET EXPRESSION 13872000 + BNZ ICNEABS SHOULD BE ABSOLUTE-ERR IF NOT 13874000 + STH RC,ICYOPN2 SAVE THE VALUE 13876000 + B ICBLANK GO CHK BLANK AND FINISH UP 13878000 +ICSPCDLT DC AL1(80,133,80,4,1) DFLT L'S-READ,PRNT,PUNCH,DUMP,LIMD 13880000 +.ICXIO ANOP 13882000 + EJECT 13884000 +* * * * * ICWREG1 - PROCESS 1ST REGISTER OR MASK - LEVEL - 1 * 13886000 +* ENTRY CONDITIONS * 13888000 +* RA = SCAN POINTER TO 1ST CHAR OF 1ST REGISTER * 13890000 +* RW = RETURN ADDRESS OF CALLING SECTION * 13892000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13894000 + SPACE 1 13896000 +ICWREG1 BAL RZ,ICREG GET 1ST REG CONVERTED 13898000 + SLL RC,4 SHIFT OVER 13900000 + STC RC,ICYR1R2 STORE INTO AREA 13902000 + TM ICRCMASK,IAA MUST THE REGISTER BE EVEN 13904000 + BZ ICWR1 NO,GO FINISH UP 13906000 + TM ICYR1R2,X'10' MAKE SURE REG IS EVEN 13908000 + BZ ICWR1 REG IS OK,SKIP 13910000 + LA RZ,ICWR1 SET UP RETURN @ TO CONTINUE 13912000 + SPACE 1 13914000 +* ICWODDR MAY BE CALLED TO FLAG ODD FLT-PT REG - LEVEL-2 * 13916000 +ICWODDR SR RA,RY DECREMENT SCAN PTR BY 1 TO REG 13918000 + LA RB,$ERODDRG REGISTER IS ODD-FLAG IT 13920000 + $CALL ERRTAG FLAG ERROR 13922000 + BXH RA,RY,0(RZ) PUT SCAN PTR FORWARD 1, RETURN TO CL 13924000 + SPACE 1 13926000 +ICWR1 CLI 0(RA),C',' IS REG FOLLOWED BY , 13928000 + BNE ICNINVDM NO-ERROR 13930000 + BXH RA,RY,0(RW) BUMP PAST , AND RETURN 13932000 + EJECT 13934000 +* * * * * ICXBD - PROCESS 1 OPERAND - D(B) OR D(X-L,B) - LEVEL - 1 * 13936000 +* ENTRY CONDITIONS * 13938000 +* RW = RETURN ADDRESS OF CALLING SECTION * 13940000 +* EXIT CONDITIONS * 13942000 +* ICYEA1 OR ICYEA2 WILL BE FILLED IN. ICYOPN1 OR ICYOPN2 WIIL * 13944000 +* BE FILLED IN AND A LENGTH OR INDEX REGISTER WILL BE STORED * 13946000 +* INTO ICYFL, IF PRESENT. * 13948000 +* **NOTE** MOST OF THE CODE IN THIS SECTION IS DESIGNED TO * 13950000 +* MAKE NORMAL CASE PROCESSING AS FAST AS POSSIBLE. THE PROGRAM * 13952000 +* ATTEMPTS TO FIND ONE OF SEVERAL TYPICAL OPERAND FORMATS, AND IF * 13954000 +* SUCCESSFULL, PROCESSES THEM QUICKLY. IF NOT, IT GIVES UP AND * 13956000 +* USES THE EXPRESSION EVALUATOR EVALUT INSTEAD. THE ROUTINE WILL * 13958000 +* CONVERT ANY OF THE FOLLOWING SORTS OF OPERANDS WITHOUT CALLING * 13960000 +* THE EVALUT ROUTINE : * 13962000 +* 1. FOR OPERANDS OF FORM S OR D(B) - IF D IS A DECIMAL # OR * 13964000 +* SELF-DEFINING TERM BY ITSELF, AND (B) IS PRESENT OR NOT, OR * 13966000 +* IF S IS EITHER A SYMBOL BY ITSELF, OR SYMBOL+# OR SYMBOL-#, WHERE * 13968000 +* SYMBOL IS EITHER AN ORDINARY SYMBOL OR LOCATION COUNTER REF * 13970000 +* 2. FOR OPERANDS OF FORM S(XL) OR D(XL,B) OR D(XL) OR D(,B) * 13972000 +* SYMBOL IS EITHER AN ORDNIARY SYMBOL OR LOCATION COUNTER REFE * 13974000 +* IF S OR D ARE AS DESCRIBED BY 1., AND IF XL DESIGNATES A * 13976000 +* LENGTH, IT IS GIVEN BY A DECIMAL #. * 13978000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13984000 + AIF (&$OPTMS LT 2).ICX2 SKIP IF MEMORY TIGHT 13986000 +ICXBD ST RA,ICZ1RA SAVE THE SCAN POINTER IF BACK-UP NEE 13988000 + IC R2,0(RA) GET THE FIRST CHARACTER OF OPERAND 13990000 + IC R2,AWTDECT(R2) GET INDEX VALUE FROM TABLE 13992000 + C R2,AWF12 MAKE SURE NOT ILLEGAL 13994000 + BH ICNILLEG ILLEGAL CHAR-BRANCH 13996000 + LH R14,ICXJUMP(R2) GET THE OFFSET @ 13998000 +ICXBDJ B ICXBDJ(R14) JUMP TO RIGHT BEGINNING SECTION 14000000 +* * * * * JUMP OFFSET TABLE FOR 1ST CHARACTER FOR ICXBD ROUTINE * 14002000 +ICXJUMP $AL2 ICXBDJ,(ICXDEC,ICNINVDM,ICXSDT,ICXSYM,ICXLOC,ICXLIT,ICXL#14004000 + PARN) 14006000 +.ICX2 AIF (&$OPTMS GE 2).ICX3 SKIP IF NOT GREAT MEMORY OPT 14006100 +ICXBD CLI 0(RA),C'=' CHECK FOR LITERAL (MEMORY OPT CODE) 14006200 + BNE ICXDEXP2 NOT LITERAL, GO CALL EXPRESSION EVAL 14006300 +.ICX3 ANOP 14006400 + EJECT 14008000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14010000 +* THE FOLLOWING CODE SECTIONS PROCESS AN OPERAND SPECIFIED AS * 14012000 +* A LITERAL, A RELOCATABLE SYMBOL OR EXPRESSION, OR AN EXPLICIT * 14014000 +* DISPLACEMENT. EXPLICIT BASES,LENGTHS, OR INDEX REGISTERS ARE * 14016000 +* PROCESSED BY ICXABS-ICXRELOC * 14018000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14020000 + SPACE 1 14022000 +* * * * * ICXLIT - PROCESS A LITERAL OPERAND - 1ST CHAR WAS = * 14024000 +ICXLIT TM ICRCMASK,IAL2 IS LITERAL ALLOWED 14026000 + BZ ICNLITER NO,GO FLAG IT 14028000 + CLI ICRCLENG,RC$LEN2 DOES A LITERAL @ EXIST 14030000 + BNE ICNERRF NO,BUT IT WAS ALREADY FLAGGED-QUIT 14032000 + L RC,ICRCLITA GET @ LITERAL IN LITERAL TABLE 14034000 + $CALL LTGET2 GET THE PROGRAM @ LITERAL(IN RC) 14036000 + STC RD,ICYLQT STORE LENGTH-1 ATTRIBUTE 14038000 + NI ICYF2,255-ICYXLFN ZERO TO SHOW NO EXPLICIT LENGTH 14040000 + BAL RZ,ICGBD HAVE IT CONVERTED TO B-D FORM 14042000 + BR RW RETURN TO CALLER OF ICXBD 14044000 + AIF (&$OPTMS LT 2).ICX4 SKIP IF MEMORY OPTMIZED 14045000 + SPACE 1 14046000 +* * * * * ICXSDT - CHECK SELF-DEFING TERM OR L' - 1ST CHAR WAS BCLX * 14048000 +ICXSDT CLI 1(RA),C'''' IS ' 2ND CHAR OF OPERAND 14050000 + BNE ICXSYM NO,SO GO PROCESS SYMBOL 14052000 + BAL RX,ICSDTRM GO GET SELF-DEFINING TERM 14054000 + BZ ICXDEC1 IF WAS SDTERM-ENTER DEC ROUTINE 14056000 + B ICXDEXP2 IF NOT,MUST HAVE BEEN L'-GO EVAL EXP 14058000 + SPACE 1 14060000 +* * * * * ICXLOC - PROCESS LOCATION COUNTER REFERENCE - 1ST CHAR WAS ** 14062000 +ICXLOC $GLOC RC GET CURRENT LOCATION COUNTER VALUE 14064000 + SR RB,RB CLEAR FOR INSERTION 14066000 + IC RB,AVCESDID GET CURRENT ESDID 14068000 + IC RE,ICRCLQ GET LENGTH ATTRIBUTE,IF NEEDED 14072000 + BXH RA,RY,ICXSYM1 BUMP SCAN POINTER AND CONTINUE 14074000 + EJECT 14076000 +* * * * * ICXSYM - PROCESS SYMBOL REFERENCE - 1ST CHARACTER WAS ALPH * 14078000 +ICXSYM BAL RX,ICSYM GO GET SYMBOL VALUE,ETNRY 14080000 + USING SYMSECT,RA NOTE USING, RC=VALUE,RB=ESDID 14082000 + IC RE,SYLENG GET LENGTH ATTRIBUTE 14086000 + DROP RA NO LONGER USING 14088000 + LR RA,R1 RESTORE SCAN POINTER 14090000 + SPACE 1 14092000 +* COMMON CODE - SYMBOL AND LOCATION COUNTER REFERENCE. 14094000 +ICXSYM1 STC RE,ICYLQT SAVE LENGTH ATTRIBUTE IN CASE NEEDED 14096000 + IC R2,0(RA) GET NEXT CHARACTER 14098000 + IC R2,AWTDECT(R2) GET INDEX VALUE OF CHARACTER 14100000 + C R2,AWF12 COMPARE TO VALUE FOR ( 14102000 + BNL ICXSTEST SKIP IF ( COMMA OR BLANK-DONE 14104000 + SPACE 1 14106000 + MVI ICXSUBAD,X'1A' MAKE INSTRUCTION AN AR 14108000 + CLI 0(RA),C'+' IS IT PLUS LIKE WE HOPE 14110000 + BE ICXSINC YES,GO HAVE# CONVERTED 14112000 + CLI 0(RA),C'-' IS IT - 14114000 + BE ICXSUB YES,GO SET INSTRUCTION 14116000 + LTR RB,RB WAS THE SYMBOL ABSOLUTE 14118000 + BZ ICXDEXP1 YES,SO GO EVALUATE WHOLE EXPRESSION 14120000 + B ICNRELC NO,RELOCATABLE TERM IN * OR / 14122000 + SPACE 1 14124000 +ICXSUB MVI ICXSUBAD,X'1B' MAKE INSTRUCTION SUBTRACT TEMPORARIL 14126000 +ICXSINC AR RA,RY BUMP THE SCAN POINTER 14128000 + CLI 0(RA),C'0' ARE WE LOOKING AT DECIMAL # 14130000 + BL ICXDEXP1 IF NOT,GIVE UP AND USE EXPRESION EVA 14132000 + STM RB,RC,ICZ1A SAVE THES REGS 14134000 + BAL RX,ICDNUM GET # CONVERTED 14136000 + IC R2,0(RA) GET NEXT CHAR 14138000 + IC R2,AWTDECT(R2) GET INDEX VALUE 14140000 + C R2,AWF12 IS IT ( COMMA OR BLANK 14142000 + BL ICXDEXP1 NO,SO MUST BE MORE COMPLEX EXPR-JUMP 14144000 + SPACE 1 14146000 + LR RD,RC SAVE VALUE OF DECIMAL # 14148000 + LM RB,RC,ICZ1A GET SYMBOL VALUE-ESDID BACK 14150000 +ICXSUBAD AR $CHN+RC,RD ADD OR SUBTRACT VALUE(OPCODE CHNG) 14152000 +ICXSTEST LTR RB,RB WAS SYMBOL ABSOLUTE OR RELOCATABLE 14154000 + BZ ICXABS SKIP IF ABSOLUTE(UNLIKELY) 14156000 +.ICX4 ANOP 14157000 + SPACE 2 14158000 +* * * * * ICXRELOC - RELOCATABLE OPERAND- CONVERT TO D(B) FORM * 14160000 +* ON ENTRY TO ICXRELOC, RC = ADDRESS, RB = ESDID OF ADDRESS * 14162000 +ICXRELOC BAL RZ,ICGBD GET BASE-DISPLACEMENT FORM 14164000 + TM ICYFLAG,ICB1D1 WAS THERE ONLY BASE-DISPLACEMENT 14166000 + BCR O,RW YES RETURN TO CALLER 14168000 + CLI 0(RA),C'(' WAS INDEX OR LENGTH SPECIFIED 14170000 + BCR NE,RW NO,SO JUST RETURN TO CALLER 14172000 + AR RA,RY BUMP SCAN POINTER PAST ( 14174000 + BAL RZ,ICX2L12 GO GET INDEX OR LENGTH AS NEEDED 14176000 + STC RC,ICYXL SAVE THIS VALUE FOR LATER 14178000 + CLI 0(RA),C')' IS ) THERE LIKE IT SHOULD BE 14180000 + BNE ICNINVDM NO-ERROR 14182000 + BXH RA,RY,0(RW) BUMP SCAN POINTER AND RETURN 14184000 + EJECT 14186000 + AIF (&$OPTMS LT 2).ICX6 SKIP IF MEMORY OPT 14187500 +* * * * * ICXDEC - PROCESS DECIMAL DISPLACEMENT - 1ST CHAR WAS DEC # * 14188000 +ICXDEC BAL RX,ICDNUM GO GET DECIMAL # 14190000 +ICXDEC1 CLI 0(RA),C'(' IS NEXT ( 14192000 + BE ICXABSA YES,BASE-X-L FOLLOW 14194000 + CLI 0(RA),C' ' IS BLANK NEXT 14196000 + BE ICXABSB YES,GO INTO ABS SECTION 14198000 + CLI 0(RA),C',' IS THIS FIRST OPERAND OF SEVERAL 14200000 + BE ICXABSB YES,GO FINISH OFF 14202000 + SPACE 1 14204000 +* FALLS THRU==> NOT SIMPL,HOPED-FOR DECIMAL #-USE EXPRESSION EV* 14206000 +ICXDEXP1 L RA,ICZ1RA GET THE ORIGINAL SCAN POINTER BACK 14208000 +ICXLPARN EQU * 1ST CHAR WAS ( ==> PROCESS EXPRESSN 14210000 +.ICX6 ANOP 14210500 +ICXDEXP2 BAL RX,ICEXP GO GET EXPRESSION EVALUATED 14212000 + STC RE,ICYLQT SAVE THIS AS LENGTH ATTRIBUTE 14214000 + BNZ ICXRELOC CC SET BY ESDID TEST-GO TO RELOC IF 14216000 + SPACE 2 14218000 +* * * * * ICXABS - OPERAND DISPLACEMENT EXPLICIT - GET X,L,B,ETC * 14220000 +* ON ENTRY TO ICXABS,ICXABSA,ICXABSB, RC = DISPLACEMENT VALUE * 14222000 +ICXABS CLI 0(RA),C'(' WAS DISPLACEMENT ALONE(PROB SHIFT) 14224000 + BNE ICXABSB YES,GO FINISH UP 14226000 +ICXABSA CL RC,AWFXFFF IS DISPLACEMENT > 4095 14228000 + BH ICNEXGTA DISPLACEMENT TOO LARGE 14230000 + ST RC,ICZ1A SAVE THE DISPLACEMENT VALUE 14232000 + AR RA,RY BUMP SCAN POINTER PAST ( 14234000 + TM ICYFLAG,ICB1D1 IS THER LENGTH OR INDEX 14236000 + BO ICXABSN NO-BASE-DISPLACEMENT ONLY 14238000 + SPACE 1 14240000 + CLI 0(RA),C',' IS L OR X FIELD OMITTED 14242000 + BNE *+8 SKIP IF NOT OMITTED 14244000 + BXH RA,RY,ICXABSN BUMP PAST , AND JUMP-OMITTED X OR L 14246000 + BAL RZ,ICX2L12 GET LENGTH OR INDEX 14248000 + STC RC,ICYXL SAVE LENGTH OR INDEX 14250000 + SPACE 1 14252000 + SR RC,RC CLEAR FOR OMITTED BASE,INCASE IT IS 14254000 + CLI 0(RA),C',' IS BASE SPECIFIED 14256000 + BNE ICXABSP NO,MUST BE OMITTED 14258000 + AR RA,RY BUMP SCAN POINTER BY 1 14260000 +ICXABSN BAL RZ,ICREG GET BASE REGISTER 14262000 +ICXABSP CLI 0(RA),C')' IS THE DELIMITER AN ENDING ) 14264000 + BNE ICNINVDM NO-EEROR 14266000 + LR RD,RC MOVE VALUE OF REGISTER OVER 14268000 + SLL RD,12 SHIFT INTO RIGHT POSITOON 14270000 + L RC,ICZ1A GET DISPLACEMENT BACK 14272000 + AR RD,RC PUT BAS AND DISPLACEMENT TOGETHER 14274000 + BXH RA,RY,ICXABSB2 BUMP SCAN PTR PAST ) AND BRANCH 14276000 + EJECT 14278000 +* ICXABSB ENTERED IF DISPLACEMENT ALONE,NO X,L,B * 14280000 +ICXABSB CL RC,AWFXFFF IS DISPLACEMENT > 4095 14282000 + BH ICNEXGTA NO-ERROR -DISPLACEMNT >4095 14284000 + LR RD,RC DUPLICATE VALUE OF ADDRESS AS B-D 14286000 + SPACE 1 14288000 +* ICXABSB2 ENTERED AS COMMON EXIT FROM ICXABS. * 14290000 +ICXABSB2 BAL RX,ICPEA HAVE ADDRESS CHECKED AND STORED 14292000 + BAL RZ,ICQOPN HAVE BASE-DISPLACEMENT STORED 14294000 + BR RW RETURN TO CALLER 14296000 + EJECT 14298000 +* * * * * ICGBD - GET AND STORE BASE-DISP OF @ - LEVEL - 2 * * * * * * 14300000 +* RB = ESDID OF THE @ * 14302000 +* RC = @ FOR WHICH BASE-DISPLACEMENT IS TO BE FOUND * 14304000 +* RZ = RETURN ADDRESS OF CALLING ROUTINE * 14306000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14308000 + SPACE 1 14310000 +ICGBD BAL RX,ICPEA HAVE ACTUAL ADDRESS CHECKED AND SAVE 14312000 + LR R1,RA SAVE THE SCAN POINTER 14314000 + LR RA,RC MOVE @ OVER FOR BRDISP CALL 14316000 + $CALL BRDISP GO HAVE BASE-DISPLACEMENT FOUND 14318000 + LR RD,RA MOVE VALUE OVER TO FALL INTO ICQOPN 14320000 + LR RA,R1 RESTORE THE SCAN POINTER 14322000 + LTR RB,RB WAS BASE-DISP OK 14324000 + BNZ ICNADDR NO,ADDRESSIBILITY ERROR 14326000 + SPACE 2 14328000 +* * * * * ICQOPN - STORE BASE-DISPLACEMENT INTO OPN1-OPN2 - LEVEL - 2 * 14330000 +* ENTRY CONDITIONS * 14332000 +* RD = VALUE TO BE STORED INTO ICYOPN1-OPN2 FIELD 14334000 +* RZ = RETURN ADDRESS OF CALLING ROUTINE * 14336000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14338000 + SPACE 1 14340000 +ICQOPN TM ICYFLAG,ICBSOPN2 SHOULD IT GO INTO OPN2 14342000 + BO *+10 YES,SKIP OVER IF OPN2 14344000 + STH RD,ICYOPN1 STORE INTO 1ST OPERAND D(B) FIELD 14346000 + BR RZ RETURN TO CALLER 14348000 + STH RD,ICYOPN2 STORE INTO 2ND FIELD (SS INSTS ONLY) 14350000 + BR RZ RETURN TO CALLER 14352000 + EJECT 14354000 +* * * * * ICREG - SCAN AND CONVERT A REGISTER VALUE. - LEVEL - 2. * 14356000 +* AS OF VERSION 3.0/A, ANY ABSOLUTE EXPRESSION <= 15 IS J* 14358000 +* ALLOWED FOR REGISTER. CODE IS ORIENTED TOWARDS NORMAL CASE.J* 14360000 +* ENTRY CONDTIONS * 14362000 +* RA = @ FIRST CHARACTER OF REGISTER. * 14364000 +* RZ = RETURN ADDRESS. * 14366000 +* EXIT CONDITIONS * 14368000 +* RA = SCAN POINTER TO CHARACTER FOLLOWING REGISTER * 14370000 +* RC = VALUE OF REGISTER,RIGHT JUSTIFIED. 0 <= RC <= 15 * 14372000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14374000 + SPACE 1 14376000 +ICREG LR R0,RA SAVE @ OF 1ST CHAR OF EXPRESSION J 14377500 + BAL RX,ICSDTRM NOW GO TRY FOR SELF-DEFINING TERM J 14378000 + BZ ICREGSYC IF OK, BRANCH TO CHECK DELIM AFTER J 14380000 +* NOT SELF-DEF TERM, TRY EXPRESSION OR SYMBOL. J 14382000 + CLI 0(RA),C'(' MAKE SURE NOT EXPRESSION IN PARENS J 14384000 + BE ICREGSYE WAS EXPRESS IN PARENS-BRANCH OUT J 14386000 + BAL RX,ICSYM SYMBOL, GO TO EVALUATE IT J 14420000 + LR RA,R1 MOVE SCAN POINTER BACK RIGHT 14421000 + BNZ ICNEABS BRANCH ==> RELOCATABLE REGISTER-ERR 14422000 +* MAKE SURE ACTUALLY IS END OF REGISTER FIELD J 14422100 +ICREGSYC CLI 0(RA),C',' MOST COMMON ENDING DELIMITER J 14422200 + BE ICREGSYO YES, WAS COMMA, DONE, BRANCH OUT J 14422300 + CLI 0(RA),C' ' NEXT COMMON DELIMITER J 14422400 + BE ICREGSYO YES, IT WAS BLANK, BRANCH OUT J 14422500 + CLI 0(RA),C')' LAST CAHNCE, RIGHT PAREN J 14422600 + BE ICREGSYO BRANCH OUT, WAS END OF EXPRESSION J 14422700 +* WAS MORE COMPLEX EXPRESSSION, PROCESS IT (R), R+1, ETC.J 14422800 +ICREGSYE LR RA,R0 RESTORE ORIGINAL PTR, FROM ICREG. J 14422900 + BAL RX,ICEXP CALL GENERAL EXPRESSION EVAL (SLOW)J 14423000 + BNZ ICNEABS MUST BE ABSOLUTE EXPRESS-BR IF NOT J 14423100 +ICREGSYO C RC,AWF15 WAS IT LEGAL SIZE 14424000 + BCR NH,RZ RETURN TO CALLER IF SMALL ENOUGH 14428000 + B ICNEXGTA TOO BIG-ERROR-FLAG IT 14430000 + EJECT 14432000 +* * * * * ICX2L12 - FLAG X-L FOUND, MAKE CHOICE OF ROUTINE - LEVEL - 2* 14434000 +* ENTRY CONDITIONS * 14436000 +* RA = SCAN POINTER TO 1ST CHAR OF LENGTH OR INDEX * 14438000 +* RZ = RETURN ADDRESS OF CALLING ROUTINE * 14440000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14442000 + SPACE 1 14444000 +ICX2L12 OI ICYF2,ICYXLFN NOTE THAT LENGTH OR INDEX FOUND 14446000 + TM ICYFLAG,ICBX2 ARE WE LOOKING FOR AN INDEX REG 14448000 + BO ICREG SKIP IF REG,FLL THRU TO LENGTH IF NT 14450000 + SPACE 2 14452000 +* * * * * ICLENG - SCAN AND CONVERT A LENGTH. LEVEL - 2 * 14454000 +* ENTRY CONDITIONS * 14456000 +* RA = SCAN POINTER TO 1ST CHARACTER OF LENGTH. * 14458000 +* RZ = RETURN ADDRESS TO CALLING ROUTINE * 14460000 +* EXIT CONDITIONS * 14462000 +* RA = SCAN POINTER TO DELIMITER FOLLOWING LENGTH, EITHER , OR ) * 14464000 +* RC = LENGTH FOR ASSEMBLY(I.E. L-1,EXCEPT L=0). 0 <= RC <= 255 * 14466000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14468000 + SPACE 1 14470000 + AIF (&$OPTMS LT 2).ICX10 SKIP IF MEMORY OPT 14471500 +ICLENG CLI 0(RA),C'0' DO WE HAVE DECIMAL # (WE HOPE SO!) 14472000 + BL ICLEXP NO WE DON'T - USE EXPRESSION EVAL 14474000 + ST RA,ICZ2A SAVE THE SCAN POINTER 14476000 + BAL RX,ICDNUM GO GET DECIMAL # 14478000 + CLI 0(RA),C',' IS IT FOLLOWED BY COMMA 14480000 + BE ICLSIZE YES- LENGTH WAS JUST DECIMAL # 14482000 + CLI 0(RA),C')' IS DELIM ) 14484000 + BE ICLSIZE YES,GO CHECK FOR SIZE 14486000 + SPACE 1 14488000 + L RA,ICZ2A GET SCAN POINTER BACK-MORE THAN # 14490000 +.ICX10 AIF (&$OPTMS GE 2).ICX11 SKIP IF NOT EMMORY OPT 14490100 +ICLENG EQU * 14490200 +.ICX11 ANOP 14490300 +ICLEXP BAL RX,ICEXP GO GET EXPRESSION EVALUATED 14492000 + BNZ ICNEABS BRANCH==> RELOCATABLE EXP-ERR 14494000 +ICLSIZE SR RC,RY DECREMENT LENGTH TO LENGTH-1 14496000 + BNM *+6 SKIP IF ORIG LENGTH ^= 0 14498000 + SR RC,RC MAKE LENGTH ZERO 14500000 + C RC,AWFXFF IS THE VALUE <= 255 14502000 + BCR NH,RZ RETURN IF VALUE OK 14504000 + B ICNEXGTA LENGTH > 255-DEFINITELY BAD 14506000 + EJECT 14508000 +* * * * * ICPEA - CHECK @ ALIGNMENT, SET UP EA1 OR EA2 - LEVEL - 3 * 14510000 +* **NOTE** REGS RA-RD ARE SAFE ACROSS CALL TO ICPEA * 14512000 +* ENTRY CONDITIONS * 14514000 +* RC = ADDRESS VALUE TO BE STORED INTO ICYEA1 OR ICYEA2 * 14516000 +* RX = RETURN ADDRESS TO CALLING SECTION * 14518000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14520000 + SPACE 1 14522000 +ICPEA ST RC,ICYEA2 STORE VALUE IN 2ND SLOT ALWAYS 14524000 + TM ICYFLAG,ICBSEA2 DID VALUE ACTUALLY BELONG IN 2ND POS 14526000 + BO *+8 BRANCH IF WAS 2ND OPERAND 14528000 + ST RC,ICYEA1 STORE VALUE IN FIRST SLOT 14530000 + IC R14,ICRCMASK GET MAK FOR ALIGNMENT 14532000 + N R14,AWF7 REMOVE ALL BUT LAST 3 BITS 14534000 + NR R14,RC TEST FOR RIGHT ALIGNMENT 14536000 + BCR Z,RX IF ZERO==> ALIGNMENT OK 14538000 + SPACE 1 14540000 +* FALLS THRU ==> ALIGNMENT ERROR MESSAGE * 14542000 + STM RB,RD,ICZ3A SAVE THE VALUES OF REGS 14544000 + LA RB,$ERALIGN NOTE ALIGNMENT ERROR 14546000 + SR RA,RY MOVE SCAN PTR BACK 1 14548000 + $CALL ERRTAG HAVE IT FLAGGED 14550000 + AR RA,RY PUT SCAN PTR BACK WHERE BELONGS 14552000 + LM RB,RD,ICZ3A RESTORE REGS 14554000 + BR RX RETURN TO CALLER 14556000 + SPACE 2 14558000 +* * * * * ICDNUM - SCAN AND CONVERT DECIMAL #. LEVEL - 3 * 14560000 +* ENTRY CONDITIONS * 14562000 +* RA = SCAN POINTER TO 1ST DIGIT OF DECIMAL # * 14564000 +* RX = RETURN ADDRESS OF CALLING SECTION * 14566000 +* EXIT CONDITIONS * 14568000 +* RA = @ DELIMITER BEYOND # * 14570000 +* RC = VALUE OF #, RIGHT JUSTIFIED. * 14572000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14574000 + SPACE 1 14576000 +ICDNUM EQU * 14578000 + $CALL SDDTRM CALL DECIMAL CONVERTER 14580000 + LTR RB,RB WAS THERE ERROR 14582000 + BCR Z,RX NO ERRORS,RETURN 14584000 + B ICNERROR ERROR-GO HAVE IT FLAGGED 14586000 + EJECT 14588000 +* * * * * ICEXP - SCAN AND EVALUATE EXPRESSION - LEVEL - 3 * 14590000 +* ENTRY CONDITIONS * 14592000 +* RA = SCAN POINTER TO 1ST CHARACTER OF EXPRESSION * 14594000 +* RX = RETURN ADDRESS OF CALLING SECTION * 14596000 +* EXIT CONDITIONS * 14598000 +* RA = SCAN POINTER TO DELIMITER FOLLOWING EXPRESSION * 14600000 +* RB = ESDID OF EXPRESSION, =0 FOR ABSOLUTE EXPRESSION * 14602000 +* RC = VALUE OF EXPRESSION * 14604000 +* RE = LENGTH ATTRIBUTE - 1 OF EXPRESSION * 14606000 +* CC = SET BY TESTING ESDID * 14608000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14610000 + SPACE 1 14612000 +ICEXP $CALL EVALUT EVALUATE EXPRESSION 14614000 + LTR RB,RB WAS IT LEGAL 14616000 + BNZ ICNERROR NO-GO FLAG AND QUIT 14618000 + LTR RB,RD MOVE ESDID OVER AND SET CC 14620000 + BR RX RETURN TO CALLER 14622000 + SPACE 2 14624000 +* * * * * ICSDTRM - GET SELF-DEFINING TERM VALUE - LEVEL - 3 * 14626000 +* ENTRY CONDITIONS * 14628000 +* RA = SCAN POINTER TO 1ST CHARACTER * 14630000 +* RX = RETURN ADDRESS OF CALLING SECTION * 14632000 +* EXIT CONDITIONS * 14634000 +* RA = UNCHANGED IF NOT SD TERM, SCAN PTR TO DELIMITER IF WAS SDTERM* 14636000 +* RC = VALUE OF SELF-DEFING TERM, IF IT WAS ONE * 14638000 +* CC SET BY TESTING RB ON RETURN (<0 ==> NOT SD TERM) * 14640000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14642000 + SPACE 1 14644000 +ICSDTRM EQU * DON'T NEED TO SET RB ANYMORE 14646000 + $CALL SDBCDX CALL GENERAL SD TERM PROCESSOR 14648000 + LTR RB,RB TEST CONDITON 14650000 + BCR NP,RX RETURN IF EITHER GOOD, OR NOT SD TER 14652000 + B ICNERROR IT WAS SD TERM, BUT ILLEGAL ONE 14654000 + EJECT 14656000 +* * * * * ICSYM - SCAN AND LOOK UP SYMBOL,RETURN VALUES. LEVEL - 3 * 14658000 +* ENTRY CONDITIONS * 14660000 +* RA = SCAN POINTER TO 1ST CHARACTER OF SYMBOL * 14662000 +* RX = RETURN ADDRESS OF CALLING SECTION * 14664000 +* EXIT CONDTIONS * 14666000 +* R1 = SCAN POINTER TO DELIMITER FOLLOWING SYMBOL * 14668000 +* RA = @ SYMSECT ENTRY FOR THE SYMBOL * 14670000 +* RB = ESDID OF THE SYMBOL * 14672000 +* RC = VALUE OF THE SYMBOL * 14674000 +* CC = SET BY TESTING THE ESDID OF THE SYMBOL * 14676000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14678000 + SPACE 1 14680000 +ICSYM TRT 0(9,RA),AWTSYMT SCAN FOR END OF SYMBOL 14682000 + BZ ICNBADSY BAS SYMBOL - TOO LONG 14684000 + LR RB,R1 MOVE ENDING POINTER OVER 14686000 + SR RB,RA GET LENGTH OF SYMBOL 14688000 + BZ ICNBADSY SYMBOL OF 0 LENGTH -ERROR 14690000 + $CALL SYFIND HAVE IT LOOKED UP IN TABLE 14692000 + LTR RB,RB WAS IT ALREADY THERE 14694000 + BNZ ICNUNDEF UNDEFINED-NOT IN TABLE 14696000 + SPACE 1 14698000 + USING SYMSECT,RA NOTE SYMBOL TABLE USING 14700000 + TM SYFLAGS,$SYDEF IS SYMBOL DEFINED 14702000 + BZ ICNUNDEF NOT FLAGGED DEFINED - ERROR 14704000 + IC RB,SYESDID GET ESDID OF THE SYMBOL 14706000 + L RC,SYVALUE GET VALUE OF THE SYMBOL 14708000 + LTR RB,RB SRT CC HERE 14710000 + BR RX RETURN TO CALLER 14712000 + DROP RA KILL USING FOR SYMSECT 14713000 + SPACE 2 14714000 +* * * * * ICULEN - GET SPECIFIED LENGTH, OR IMPLIED LENGTH - LEVEL - 3* 14716000 +* ENTRY CONDITIONS * 14718000 +* RX = RETURN ADDRESS OF CALLING SECTION * 14720000 +* EXIT CONDITIONS * 14722000 +* R2 = LENGTH-1,SUITABLE FOR USE IN SS INSTRUCTION * 14724000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14726000 + SPACE 1 14728000 +ICULEN IC R2,ICYXL GET LENGTH (IF SPECIFIED) 14730000 + TM ICYF2,ICYXLFN WAS A LENGTH EXPLICITYLY SPECIFIED 14732000 + BCR O,RX YES,RETUNR NOW 14734000 + IC R2,ICYLQT NO, IMPLIED LENGTH, GET THE LENGTH-1 14736000 + BR RX RETUNR TO CALLER 14738000 + SPACE 1 14740000 +ICOIR OI ICYR1R2,$CHN REG OR LENGTH SUPPLIED BY EXECUTE 14742000 + EJECT 14744000 +* * * * * INTERNAL CONSTANTS * 14746000 +* * * * * TABLE OF ICYFLAG VALUES FOR VARIOUS INSTRUCTION TYPES. * 14748000 +* A MACRO IS USED TO KEEP INDEPENDENCE ON ACTUAL EQUATE VALUES * 14750000 +ICTTAB EQU *-1 OFFSET SYMBOL 14752000 + DS ($ICTMX)C DEFINE ENOUGH STORAGE FOR MAX TYPES 14754000 + ICT $RRM,0 14756000 + ICT $RXM,$ICBEA2+ICBX2+ICBSEA2 14758000 + ICT $RR,0 14760000 + ICT $RX,$ICBEA2+ICBX2+ICBSEA2 14762000 + ICT $RS,$ICBEA2+ICB1D1+ICBSEA2 14764000 + ICT $RSH,$ICBEA2+ICB1D1+ICBSEA2 14766000 + ICT $SI,$ICBEA1+ICB1D1 14768000 + ICT $SS,$ICBEA1+$ICBEA2 WILL BE CHANGED AFTER 1ST OP DONE 14770000 + ICT $SS2,$ICBEA1+$ICBEA2 ILL BE CHANGED AFTER 1ST OP DONE 14772000 + ICT $RSO,0 FOR SPM,SVC. OTHERS WILL CHANGE 14774000 + ICT $SPC,$ICBEA1+ICBX2 14776000 + ORG 14778000 + SPACE 1 14780000 +* * * * * INTERNAL VARIABLES * 14782000 + AIF (&$OPTMS LT 2).ICX12 SKIP IF MEMORY OPT 14782500 +ICZ1A DS 2F USED BY LEVEL 1 ROUTINES AS SAVE 14784000 +ICZ1RA DS F FOR SAVING SCAN POINTER IN ICXBD 14786000 +ICZ2A DS F SAVE WORD FOR LEVEL 2 ROUTINES 14788000 +.ICX12 AIF (&$OPTMS GE 2).ICX13 SKIP IF MEMORY NO OPT 14788100 +ICZ1A DS F LEVEL 1 SAVE WORD (MEMORY OPTMZ) 14788200 +.ICX13 ANOP 14788300 +ICZ3A DS 3F USED BY LEVEL 3 ROUTINES AS SAVE 14790000 + SPACE 1 14792000 +* INTERNAL LOCATION FOR RCODBLK VARIABLES * 14794000 +ICRCB DS 0F ALIGN ON FULLWORD 14796000 +ICRCLENG DS C LENGTH - 1 OF ICRCB 14798000 + DS AL3 ICRCLOC 14800000 +ICRCTYPE DS C INSTRUCTION TYPE 14802000 +ICRCHEX DS C HEX OPCODE 14804000 +ICRCMASK DS C MASK AND FLAG BITS 14806000 +ICRCLQ DS C LENGTH-1 ATTRIBUTE OF INSTRUCTION 14808000 +ICRCLITA DS A @ LITERAL IN LITERAL TABLE,IF EXISTS 14810000 + SPACE 1 14812000 +* INTERNAL LOCATION FOR OBJECT CODE BLOCK-ICBLOCK * 14814000 +ICYBLOCK DS 0F ALIGN ON F 14816000 +ICYEA1 DS F INSTRUCTION @ 1 FOR OUTPT2 14818000 +ICYEA2 DS F INSTRUCTION @ 2 FOR OUTPT2 14820000 +ICYOP DS C OPCODE 14822000 +ICYR1R2 DS C REGISTERS,MASK,LENGTHS 14824000 +ICYOPN1 DS H 1ST BASE DISPLACEMENT 14826000 +ICYOPN2 DS H 2ND BASE-DISPLACEMENT 14828000 +ICYFLAG DS C CONTROLS PROCESSING&PRINTING OF OPRD 14830000 +* THE ABOVE VARS ARE USED BY OUTPT2 * 14832000 +ICYF2 DS C BYTE FOR ICXBD TO RETURN STATUS 14834000 +ICYXL DS C INDEX OR LENGTH STORED HERE -ICXBD 14836000 +ICYLQT DS C FOR IMPLIED LENGTH - LENGTH-1 HERE 14838000 + AIF (NOT &$XREF).NOXRF16 14838025 +* 0 1 2 3 4 5 6 7 8 9 A B C D E F A 14838050 +ICXRTAB DC X'000000000884840C0C0C080000000C0C' 0 A 14838100 + DC X'84848484840C8484840C848484848484' 1 A 14838200 + DC X'84848484848484840C84848484848484' 2 A 14838300 + DC X'8484848484848484840C848484848484' 3 A 14838400 + DC X'488448840C84840C840C848484004884' 4 A 14838500 + DC X'48004884840C8484840C848484848484' 5 A 14838600 + DC X'4884480000000084840C848484848484' 6 A 14838700 + DC X'4800000000000000840C848484848484' 7 A 14838800 + DC X'08000800000086868484848484848484' 8 A 14838900 + DC X'2C00840C840C8484C200000000000000' 9 A 14839000 + DC X'00000000000000000000000000000000' A A 14839100 + DC X'00000000000000000000000000882C86' B A 14839200 + DC X'06000000000000000000000000000000' C A 14839300 + DC X'00848484840C84840000000084848484' D A 14839400 + DC X'00000000000000000000000000000000' E A 14839500 + DC X'84848484000000008484848484840000' F A 14839600 +.NOXRF16 ANOP A 14839700 + DROP RAT,R13 KILL USINGS 14840000 + TITLE '*** IDASM2 - ASSEMBLER INSTRUCTIONS - PASS 2 ***' 14842000 +**--> CSECT: IDASM2 2 ASSEMBLER INSTRUCTIONS - PASS 2 . . . . . . . 14844000 +*. THIS MODULE IS 1 OF THE 2 PASS 2,LEVEL 2 ROUTINES IN THE . 14844100 +*. ASSIST ASSEMBLER. IT PERFORMS ALL PROCESSING OF ASSEMBLER . 14844200 +*. INSTRUCTIONS IN THE SECOND PASS. IT PRODUCES SOME OBJECT . 14844300 +*. CODE, AND DOES SETUP FOR PRINTING. MOST OF THE WORK HAS . 14844400 +*. ALREADY BEEN DONE IN THE CORREPONDING PASS 1 MODULE, IBASM1. . 14844500 +*. ENTRY CONDITIONS . 14846000 +*. RA = SCAN POINTER (ADDRESS OF 1ST CHARACTER OF OPERAND FIELD) . 14848000 +*. RC = ADDRESS OF RECORD CODE BLOCK(RCODBLK) FOR STATEMENT . 14850000 +*. RE = ADDRESS OF RECORD SOURCE BLOCK(RSBLOCK) FOR STATEMENT . 14852000 +*. CALLS BRDROP,BRUSIN,CCCON2,CNDTL2,ERRTAG,ESENX2,EVALUT,LTDMP2. 14854000 +*. CALLS OUTPT2,UTPUT2 . 14856000 +*. USES DSECTS: AVWXTABL,RCODBLK,RSBLOCK,SYMSECT . 14856500 +*. USES MACROS: $AL2,$CALL,$GLOC,$RETURN,$SAVE,$SDEF,$STV . 14857000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 14858000 + SPACE 1 14859000 +IDASM2 CSECT 14860000 + $DBG 90,* 14862000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 14864000 + USING RCODBLK,RC RC HAS POINTER ON ENTRY 14866000 + USING RSBLOCK,RE NOTE ADDRESSIBILITY 14868000 + SPACE 1 14870000 +* * * * * REGISTER USAGE FOR IDASM2 * * * * * * * * * * * * * * * * * * 14872000 +* R2 = BYTE REGISTER (HI-ORDER 3 BYTES = 0). * 14874000 +* RW = INTERNAL LINK REGISTER - LEVEL - 1 (IDREGET,IDEVAL) * 14876000 +* RY = 1 USEFUL CONSTANT IN ODD REGISTER. * 14880000 +* RC = @ RCODBLK FOR STMT (= AVRCBPT). * 14881000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14882000 + SPACE 1 14884000 + $SAVE RGS=(R14-R6),SA=IDSAVE,BR=R13 14886000 + LA RY,1 SET UP HANDY CONSTANT FOR MANY SECTS 14894000 + SR R2,R2 CLEAR FOR INSERTIONS 14896000 + IC R2,RCTYPE GET TYPE BYTE 14898000 + LH R14,IDAJUMP-$IB(R2) GET OFFSET @ TO RIGHT SECTION 14900000 + TM RSBFLAG,$REBX DO ERRORS EXIST ALREADY 14900200 + DROP RE REMOVE RSBLOCK USING NOW 14900400 +IDASMJ BZ IDASMJ(R14) GO IF NO ERRORS 14900600 +* ERRORS EXIST - CURRENTLY, PROCESS END CARDS ONLY 14900800 + CLI RCTYPE,$IB+$IEND WAS IT AN END CARD 14901000 + BNE IDOUT2 ANYTHING ELSE - FORGET IT 14901200 + B IDEND PROCESS END WHETHER ERRS OR NOT 14902000 + EJECT 14904000 +* * * * * INDIVIDUAL ERROR EXITS * 14906000 +IDERELOC LA RB,$ERRELOC NEED RELOCATABLE VALUE 14912000 + B IDERROR GO HAVE ERROR FLAGGED 14914000 +IDERELC LA RB,$ERNEABS ABSOLUTE VALUE REQUIRED 14916000 + B IDERROR GO HAVE ERROR FLAGGED 14920000 +IDREGBIG LA RB,$EREXGTA REGISTER OR OTHER VALUE TOO LARGE 14922000 + B IDERROR GO HAVE ERROR FLAGGED 14924000 +IDERIND LA RB,$ERINVDM INVALID DELIMITER 14932000 +IDERROR $CALL ERRTAG FLAG IT 14934000 + SPACE 1 14936000 +* * * * * PRINT STATEMENT AND RETURN TO CALLER. * 14938000 +IDOUT2 L RD,AWFM4 PUT NEG # TO SHOW NO CODE PRINTED 14940000 +IDOUT2A LA RB,$OUCONS SHOW TYPE OF CALL TO OUTPT2 14942000 +IDOUT $CALL OUTPT2 HAVE LINE PRINTED 14944000 +IDRET $RETURN RGS=(R14-R6) 14946000 + EJECT 14948000 +* * * * * CCW * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14950000 +IDCCW EQU IDOUT2 **UNTIL CCW CODE WRITTEN * 14952000 + SPACE 1 14954000 +* * * * * CNOP * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14956000 +IDCNOP IC R2,RCMASK GET LENGTH 0-2-4-6 14958000 + SR R2,RY DECREMENT LENGTH TO LENGTH - 1 14960000 + BM IDOUT2 IF L<0,NO OBJECT CODE NEEDED-SKIP 14962000 + LR RD,R2 MOVE LEN-1 OVER FOR UTPUT2 14964000 + LR RE,RY PLACE A 1 IN REG RE-DUPFAC OF 1 14966000 + LA RC,=3X'0700' GET @ 3 NOPRS 14970000 + $GLOC RA GET LOCATION COUNTER FOR UTPUT2 14972000 + $CALL UTPUT2 CALL OBJECT CODE ROUTINE 14974000 + LA RC,=3X'0700' GET @ 3 NOPRS 14976000 + LR RD,R2 MOVE LENGTH-1 OVER FOR OUTPT2 14978000 + B IDOUT2A GO HAVE CODE PRINTED 14980000 + SPACE 1 14982000 +* * * * * CSECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14984000 +IDCSECT NI AVTAGS1,255-$IBDSEC1 MAKE SURE FLAGGED CSECT 14986000 + B IDESCH GO CHANGE ESDID 14988000 + SPACE 1 14990000 +* * * * * DC * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 14992000 +IDDC SR RB,RB CLEAR FOR INSERT 14994000 + IC RB,RCMASK GET THE NUMBER OF OPERANDS IN DC 14996000 + LA RC,RCLITEQ GET @ FIRST OR ONLY CNCBLOCK 14998000 + $CALL CNDTL2 CALL 2ND PASS CONSTANT PROCESSOR 15000000 + B IDRET RETURN(CNDTL2 PRINTED LINE) 15002000 + SPACE 1 15004000 + AIF (&$DEBUG).IDNOD1 SKIP OVER IF NOT DEBUG MODE 15006000 + SPACE 1 15008000 +* * * * * DEBUG * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15010000 +IDDEBUG CLI RCHEX,C'2' WAS THIS FOR PASS 2 15012000 + BNE IDOUT2 QUIT IF WASN'T FOR 2 15014000 + MVC AVDEBUG,RCMASK MOVE BYTE INTO DEBUG FIELD 15016000 + B IDOUT2 GO HAVE PRINTED OUT 15018000 +.IDNOD1 ANOP 15020000 + SPACE 1 15022000 +* * * * * DS * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15024000 +IDDS EQU IDOUT2 EVERYTHING DONE IN PASS 1 15026000 + SPACE 1 15028000 +* * * * * DROP * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15030000 +IDDROP BAL RW,IDREGET GET THE REGISTER VALUE 15032000 + $CALL BRDROP HAVE REG DROPPED 15034000 + LR RA,R1 RESTORE SCAN POINTER 15036000 + LTR RB,RB WAS THERE AN ERROR 15038000 + BZ IDDROK NO ERROR CONTINUE 15040000 + SR RA,RY BACK UP SCAN POINTER BY 1 15042000 + LA RB,$ERRGNUS REGISTER NOT USED-ONLY ERROR POSSIBL 15044000 + $CALL ERRTAG HAVE THE ERROR TAGGED 15046000 + AR RA,RY BUMP SCAN POINTER TO NEXT CHAR 15048000 + SPACE 1 15050000 +IDDROK CLI 0(RA),C' ' WAS THIS LAST REGISTER 15052000 + BE IDOUT2 YES-QUIT 15054000 + CLI 0(RA),C',' IS DELIMITER OK 15056000 + BNE IDERIND INVALID DELIMITER-NO COMMA 15058000 + BXH RA,RY,IDDROP BUMP SCAN POINTER AND GO BACK 15060000 + EJECT 15062000 +* * * * * DSECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15064000 +IDDSECT OI AVTAGS1,$IBDSEC1 FLAG DSECT NOW 15066000 +IDESCH MVC AVCESDID,RCMASK MOVE NEW ESDID OVER 15068000 + B IDOUT2 GO HAVE STATEMENT PRINTED 15070000 + SPACE 1 15072000 +* * * * * ENTRY * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15074000 +IDENTRY SR RB,RB SHOW THIS IS ENTRY CALL 15076000 + B IDENEXCL GO CALL ESENX2 ROUTINE 15078000 + SPACE 1 15080000 +* * * * * EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15082000 +IDEJECT SR RE,RE SHOW THIS IS SPACE OR EJECT 15084000 + B IDPRIN2 GO TO CALL PRINTOUT ROUTINE 15086000 + SPACE 1 15088000 +* * * * * END * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15090000 +* SETS AVFENTER=ENTRY @, LEAVES = START VALUE OR 0 IF NO END SY* 15092000 +IDEND CLI 0(RA),C' ' WAS THERE A SYMBOL ON THE END CARD 15094000 + BE IDLTORG GO HANDLE AS LTORG 15096000 + BAL RW,IDEVAL HAVE EXPRESSION EVALUATED 15102000 + ST RC,AVFENTER SAVE THIS ENTRY POINT VALUE 15108000 + B IDLTORG GO HANDLE AS LTORG NOW 15110000 + SPACE 1 15112000 +* * * * * EQU * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15114000 +* SETS RCLOC = VALUE OF EQU SYMBOL FOR LISTING. * 15116000 +IDEQU MVC RCLOC,RCLITEQ+1 MOVE VALUE OF SYMBOL OVER FOR PRINT 15116500 + B IDOUT2 GO PRINT STMT 15117000 + SPACE 1 15140000 +* * * * * EXTRN * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15142000 +IDEXTRN LA RB,2 SHOW ESENX2 THIS IS EXTRN 15144000 +IDENEXCL $CALL ESENX2 CALL ROUTINE 15146000 + B IDOUT2 PRINT STATEMENT AND RETURN 15148000 + SPACE 1 15150000 +* * * * * LTORG * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15152000 +* END CARD PROCESSING ALSO USES THIS CODE * 15154000 +IDLTORG LA RB,$OUCOMM SHOW NO LOCATION COUNTER-END-LTORG 15156000 + L RD,AWFM4 SHOW THERE IS NO CODE TO BE PRINTED 15158000 + $CALL OUTPT2 15160000 + $CALL LTDMP2 HAVE LITERALS DUMPED AND PRINTED 15162000 + B IDRET RETURN 15164000 + SPACE 1 15166000 +* * * * * ORG * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15168000 +IDORG EQU IDOUT2 EVERYTHING ALREADY DONE IN PASS 1 15170000 + EJECT 15172000 +* * * * * PRINT * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15174000 +IDPRINT LA RE,2 SHOW THIS IS A PRINT COMMAND 15176000 +IDPRIN2 LA RC,RCMASK @ TAG BITS(PRINT) OR # (SPACE,EJECT) 15178000 + B IDLIST GO TO CALL ROUTINE 15180000 + SPACE 1 15182000 +* * * * * SPACE * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15184000 +IDSPACE EQU IDEJECT HANDLED SAME AS EJECT 15186000 + SPACE 1 15188000 +* * * * * START * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15190000 +IDSTART EQU IDCSECT HANDLE SAME AS CSECT 15192000 + SPACE 1 15194000 +* * * * * TITLE * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15196000 +IDTITLE EQU * PROCESS TITLE STATEMENT CPP 15198000 + LA RA,1(RA) RA=>1ST BYTE OF TITLE (AFTER ') CPP 15199000 + SR RB,RB CLEAR FOR INSERT CPP 15200000 + IC RB,RCMASK GET LENGTH-1 OF TITLE CPP 15201000 + $CALL CCCON2 EVALUATE OPD. (SAME AS C-TYPE DC) CP 15202000 + LA RE,4 SHOW THIS IS A TITLE 15208000 +* COMMON CODE - EJECT,PRINT,SPACE,TITLE. 15210000 +IDLIST LA RB,$OULIST SHOW LISTING CONTROL 15212000 + B IDOUT GO FINALLY TO CALL OUTPT2 15214000 + SPACE 1 15216000 +* * * * * USING * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15218000 +IDUSING BAL RW,IDEVAL CALL EXPRESSION EVALUATORE 15236000 + SPACE 1 15244000 +* INITIALIZES FOR POSSIBLE MULTIPLE USING, LOOP IF SO. 15246000 +IDUSB LR RX,RC MOVE LOCATION COUNTER VALUE OVER 15248000 + L RC,AVRCBPT GET RCODBLK POINTER BACK,USING THER 15249000 + $STV RX,RCLOC SAVE LOCATION FOR PRINTING 15250000 + SPACE 1 15251000 +IDUSC CLI 0(RA),C',' MAKE SURE COMMA IS THERE 15252000 + BNE IDERIND BRANCH IF NOT-INVALIDDELIM 15254000 + AR RA,RY BUMP SCAN POINTER BEYOND , 15256000 + BAL RW,IDREGET GO GET 1ST OR AFTER REGISTER VALUE 15258000 + LR RB,RX PUT CURRENT USING VALUE IN REG 15260000 + LR RC,RZ MOVE THE ESDID OVER FOR THE CALL 15262000 + $CALL BRUSIN HAVE USING ENTERED 15264000 + SPACE 1 15266000 + CLI 0(R1),C' ' SCAN PT IN R1,CHECK FOR LAST 15268000 + BE IDOUT2 QUIT IF DONE 15270000 + LA RX,4095(RY,RX) BUMP CURRENT USING 4096 15272000 + LR RA,R1 MOVE SCAN POINTER BACK OVER 15274000 + B IDUSC BUMP SCAN POINTER AND CONTINUE 15276000 + EJECT 15286000 +**--> INSUB: IDREGET CONVERT REGISTER, CHECK VALIDITY + + + + + + + 15288000 +*+ ENTRY CONDITIONS + 15290000 +*+ RA = SCAN POINTER TO 1ST CHARACTER OF REGISTER + 15291000 +*+ RW = RETURN @ TO CALLING SECTION OF CODE + 15292000 +*+ EXIT CONDITIONS + 15294000 +*+ R1 = SCAN PTR TO @ DELIMITER FOLLOWING SCAN (IF REGISTER GOOD). + 15296000 +*+ RA = VALUE OF REGISTER IF GOOD, = SCAN PTR TO ERROR IF BAD. + 15298000 +*+ RC = VALUE OF REGISTER IF GOOD. + 15300000 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 15301000 + SPACE 1 15302000 +IDREGET $CALL EVALUT USE EXP EVAL (LOW PROB USAGE) 15303000 + LR R1,RA SAVE SCAN PTR 15304000 + LTR RB,RB WAS REGISTER OK 15305000 + BNZ IDERROR NO, BRANCH AND FLAG IT 15306000 + LTR RD,RD CHECK FOR ABSOLUTE VALUE, NOT RELOC 15310000 + BNZ IDERELC ^=0 ==> RELOCATABLE==> ERROR 15312000 + SPACE 1 15313000 +IDREGCHK C RC,AWF15 MAKE SURE REG NOT TOOT LARGE 15314000 + BH IDREGBIG NO,REGISTER TOO LARGE 15316000 + LR RA,RC PUT REGISTER WHERE DESIRED 15318000 + BR RW RETURN TO CALLER,READY FOR DROP,USIN 15320000 + SPACE 1 15382000 +**--> INSUB: IDEVAL EVALUATE RELOCATABLE EXPRESSION + + + + + + + + 15382100 +*+ ENTRY CONDITIONS + 15382200 +*+ RA = SCAN PTR TO 1ST CHARACTER OF EXPRESSION + 15382300 +*+ RW = RETURN @ TO CALLING SECTION IN IDASM2 + 15382400 +*+ EXIT CONDITIONS + 15382500 +*+ RZ = SECTION ID OFTHE EXPRESSION (SAME AS VALUE IN RD) + 15382600 +*+ RA = SCAN PTR @ TO DELIMITER IF GOOD, TO ERROR IF NOT. + 15382700 +*+ RC = VALUE OF THE EXPRESSION + 15382800 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 15384000 +IDEVAL $CALL EVALUT 15386000 + LTR RB,RB WAS EXPRESSION OK 15388000 + BNZ IDERROR NO, ERROR 15389000 + LTR RZ,RD DUPLICATE ESDID, TEST FOR RELOCATBL 15390000 + BCR NZ,RW RETURN IF RELOCATABLE (RD ^= 0) 15391000 + B IDERELOC ERROR, NEED RELOCATABLE EXPRESSION 15392000 + SPACE 1 15394000 +* * * * * INTERNAL CONSTANTS * 15396000 +* * * * * BRANCH OFFSET TABLE FOR INDIVIDUAL INSTRUCTIONS * 15398000 +IDAJUMP $AL2 IDASMJ,(IDUSING,IDDROP,IDSTART,IDCSECT,IDDSECT,IDENTRY,I#15400000 + DEXTRN,IDEQU,IDDC,IDDS,IDCCW,IDTITLE,IDEJECT,IDSPACE,IDP#15402000 + RINT,IDORG,IDLTORG,IDCNOP,IDEND),-2 15404000 + AIF (&$DEBUG).IDNOD2 SKIP IF NOT DEBUG MODE 15406000 + DC AL2(IDDEBUG-IDASMJ) OFFSET TO DEBUG ROUTINE 15408000 +.IDNOD2 ANOP 15410000 + LTORG 15412000 + DROP RAT,R13,RC KILL USINGS 15414000 + TITLE '*** INPUT1 - INPUT CARDIMAGE READER/PROCESSORS ***' 15416000 +**--> CSECT: INPUT1 1 INPUT AND MANIPULATION OF SOURCE CARDS. . . . 15418000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 15420000 +INPUT1 CSECT 15422000 + $DBG 90,* 15424000 + USING AVWXTABL,RAT MAIN TABLE USING 15426000 + ENTRY INCARD 15428000 + SPACE 2 15430000 +**--> ENTRY: INCARD CALLED TO GET CARD AND CREATE RSBLOCK . . . . 15432000 +*. THIS ENTRY READS 1 STATEMENT (1-3 CARDS), AND SETS UP THE . 15432100 +*. RECORD BLOCKS RSBLOCK, AND RSCBLK (IF CONTINUATIONS OR . 15432200 +*. SEQUENCE NUMBERS ARE USED). IT IS CALLED DURING PASS 1 OF . 15432300 +*. THE ASSEMBLY. IF AN ENDFILE INDICATION IS ENCOUNTERED, IT . 15432400 +*. CREATES A PSEUDO ENDCARD, SINCE THE MAIN PROGRAM OF PASS 1 . 15432500 +*. MOCON1 ONLY STOPS AFTER AN END CARD IS FOUND. AS OF 8/17/70,. 15432600 +*. INCARD IS THE ONLY ASSEMBLER ENTRY DOING CARD READING. . 15432700 +*. IN SETTING UP THE RSBLOCK, INCARD CONCATENATES THE SECTIONS . 15432800 +*. OF A CONTINUED STATEMENT, AND REMOVES BLANKS TO SOME DEGREE . 15432900 +*. FROM THE TRAILING EDGE OF THE STATEMENT. IT ALSO INSERTS . 15433000 +*. THE 3 CHARACTERS BLANK,APOSTROPHE,BLANK AFTER THE LAST . 15433100 +*. NONBLANK CHARACTER IN THE SOURCE STATEMENT. THIS IS CRUCIAL . 15433200 +*. TO THE PROPER SCANNING OF THE SOURCE STATEMENT WITHOUT . 15433300 +*. REQUIRING LENGTHS TO BE CARRIED FROM ROUTINE TO ROUTINE. . 15434000 +*. . 15434020 +*. IF THE MACRO PROCESSOR EXISTS (&$MACROS=1), INCARD . 15434025 +*. ALSO HANDLES RECOVERY OF GENERATED STMTS (CREATED BY MEXPND .. 15434030 +*. IN THE DYNAMIC-HIGH AREA). . 15434035 +*. IF A MACRO LIBRARY FACILITY EXISTS (&$MACSLB=1), . 15434040 +*. INCARD CAN BE SWITCHED TO READ FROM IT, INSTEAD OF $SORC. . 15434045 +*. EXIT CONDITIONS . 15434100 +*. RA = SCAN PTR TO ERROR, ONLY IF RB ^= 0. NO MEANING IF RB = 0. . 15434200 +*. RB = 0 NO ERRORS FOUND IN STATEMENT BY INCARD . 15434300 +*. RB = ERROR CODE (NONZERO) OF ERROR. RA HAS SCAN PTR OF IT. . 15434400 +*. AVSOLAST = @ BLANK IMMEDIATELY BEFORE ' IN THE 4-BYTE FIELDWHICH . 15434410 +*. INCARD PLACES AFTER THE SOURCE STMT TO STOP SCANNING OVERRUN.. 15434420 +*. USES DSECTS: AVWXTABL,RSBLOCK,RSCBLK,RSOURCE . 15434500 +*. USES MACROS: $RETURN,$SAVE,$SORC . 15435000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 15436000 + SPACE 1 15437000 +* * * * * REGISTER ALLOCATION FOR INCARD * * * * * * * * * * * * * * * 15438000 +* R1 = NUMBER OF CARDS INCLUDED IN CURRENT RSBLOCK (FROM 1-3) * 15440000 +* R2 = 0 (INITIALLY) - BYTE REGISTER FOR INSERTION * 15442000 +* RW = ADDRESS OF RSBLOCK BEING BUILT * 15444000 +* RX = ADDRESS OF RSCBLK BEING BUILT(IF ANY) * 15446000 +* RY = ADDRESS WHERE NEXT SOURCE SHOULD BE READ(RSOURCE) * 15448000 +* RZ = CURRENT LENGTH-1 OF RSBLOCK BEING BUILT * 15450000 +* R14= INTERNAL LINK REGISTER (FOR INCRSMV). * 15451000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15452000 + EJECT 15454000 +INCARD $SAVE RGS=(R14-R6),SA=NO 15456000 + AIF (&$DEBUG).INNZ SKIP IF NOT DEBUGGIN MODE 15458000 + MVC AVRSBLOC(256),AWTZTAB ZERO OUT ***DEBUGGING *** 15460000 +.INNZ LA R1,1 INIT # CARDS TO 1 15462000 + LM RW,RX,AVRSBPT VRSBPT,VRSCPT POINTERS 15464000 + USING RSBLOCK,RW NOTE RSBLOCK USING SETUP 15466000 + USING RSCBLK,RX NOTE RSCBLK USING SETUP 15468000 + LA RY,RSBSOURC INIT POINTER TO NEXT INPUT AREA 15470000 + USING RSOURCE,RY NOTE CARDIMAGE USING 15472000 + LA RZ,RSB$LN1 INIT LENGTH-1 OF RSBLOCK 15474000 + SR R2,R2 CLEAR FOR ZERO VALUE 15476000 + ST R2,RSBLENG ZERO OUT WHOLE CODES SECTION 15478000 + SR RB,RB CLEAR INITIALLLY==> NO ERRORS 15479000 + TM AVTAGS2,$INEND2 HAS THERE BEEN EOF, END CARD NEEDED 15480000 + BO INCREOF END CARD NEEDED-GO CREATE IT 15482000 + SPACE 1 15482020 + AIF (NOT &$MACROS).INNOMA SKIP IF NO MACROS 15482040 +* SEE IF EXPANDED STMTS EXIST. IF SO, PROCESS NEXT ONE. 15482060 + L RC,AVGEN1CD @ 1ST BYTE BEYOND NEXT GEN'D STMT 15482080 + C RC,AVGEN2CD CHECK AGAINST LOWER LIMIT 15482100 + BNH INNOTGEN SKIP IF THERE ARE NO MORE CARDS 15482120 + SPACE 1 15482140 + C RC,AVADDHIH MAKE SURE AVGEN1CD <= AVADDHIH 15482160 + BH INMOVRGN RAN OVER GENERATED CODE FROM TOP 15482180 + CLC AVGEN2CD,AVADDLOW CHECK FOR OVERRUN FROM BOTTO4 15482200 + BNH INMOVRGN YES IT DID (MORE LIKELY) - GO 15482220 + SPACE 1 15482240 +* MOVE NEXT EXPANDED STMT OVER TO RSBLOCK AREA. 15482260 + LA RD,RSB$L = LENGTH OF CONSTANT PART OF RSBLOCK 15482280 + SR RC,RD DECREMENT GEN PTR 15482300 + MVC RSBLOCK(RSB$L),0(RC) COPY CONSTANT PART 15482320 + IC RZ,RSBLENG GET L-1 OF GEN'D STMT 15482340 + STC RZ,INMMOVE+1 PUT L-1 INTO MVC INSTR 15482360 + SR RC,RZ GET @ 2ND BYTE OF GEN'D STMT (L-1) 15482380 + SR RC,R1 GET @ 1ST BYTE OF GEN'D STMT 15482400 +INMMOVE MVC RSBSOURC($),0(RC) MOVE WHOLE STMT OVER 15482420 + SPACE 1 15482440 +* IF THERE ARE ALREADY ERRORS IN THE STMT, MOVE THE 15482460 +* RESULTING REBLK OVER TO NORMAL LOCATION. 15482480 + TM RSBFLAG,$REBX DOES THE STMT HAVE ERRORS 15482500 + BZ INMNOREB NO, JUMP (NORMAL CASE) 15482520 + IC R2,RSBNUM GET REBLN FROM TEMPORARY LOCATION 15482540 + STC R2,AVREBLN STORE THE LENGTH-1 OF ERROR BLOCK 15482560 + SR RC,R2 RC = @ OF REST OF REBLK (NOT REBLN) 15482580 + SR R2,R1 GET L-1 OF PART OF REBLK LEFT 15482600 + STC R2,*+5 PLACE L-1 INTO MVC INSTR 15482620 + MVC AVREBES($),0(RC) MOVE REST OF ERROR BLOCK OVER 15482640 + SPACE 1 15482660 +INMNOREB ST RC,AVGEN1CD UPDATE PTR TO NEXT GEN'D STMT 15482680 + SPACE 1 15482700 +* STMT FROM MACRO PROCESSOR MAY HAVE 1-2 EXTRA BLANKS AT 15482720 +* END: REMOVE THEM SO DON'T CAUSE UNNECESSARY CONT CARDS. 15482740 + LA RC,RSBSOURC-1(RZ) @ NEXT TO LAST CHAR OF STMT 15482760 + CLI 1(RC),C' ' WAS LAST BYTE A BLANK 15482780 + BNE INMOBLN NO, SKIP, DON'T REMOVE 15482800 + CLI 0(RC),C' ' WAS NEXT TO LAST A BLANK 15482820 + BNE *+6 NO, REMOVE ONLY 1 - BRANCH 15482840 + SR RZ,R1 YES, REMOVE 2 BLANKS FROM COUNT 15482860 + SR RZ,R1 REMOVE OTHER BLANK 15482880 +* NOW CONSTRUCT RSCBLK, IF STMT REQUIRES IT BY BEING TOO * 15482900 +* LARGE TO FIT ON 1 CARD. AT THIS PT, RZ = LENGTH-1 OF STMT. * 15482920 +* (RZ) <= 70 ==> 1 CARD, NO RSCBLK. * 15482940 +* (RZ) <= 126 ==> 2 CARDS, RSCBLK, 21 BYTES LONG * 15482960 +* RSCLENG = 2*RSC$LEN; RSCILEN(1) = RSOL1; * 15482980 +* RSCILEN(2) = (RC) - (RSOL1-1) . 15483000 +* (RZ) <= 182 ==> 3 CARDS, RSCBLK, 31 BYTES LONG. * 15483020 +* RSCLEN = 3*RSC$LEN; RSCILEN(1) = RSOL1; 15483040 +* RSCILEN(2) = RSOLC; RSCILEN(3) = (RC) -(RSOL1-1)-RSOLC. 15483060 + SPACE 1 15483080 +INMOBLN LR RC,RZ GET L-1 TO BE DESTROYED 15483100 + AR RZ,RD GET L-1 OF ENTIRE RSBLOCK, AS NEEDED 15483120 + SPACE 1 15483140 + SH RC,=AL2(RSOL1-1) GET # BYTES IN GEN'D CARDS 2,3 15483160 + BNP INCNORM <=0, SO ONLY 1 CARD- BRANCH(NORMAL) 15483180 + TM RSBFLAG,$RSBMERR MACRO ERROR? J 15483182 + BO INCNORM YES, CAN'T BE CONTINUED ANYWAY J 15483183 + SPACE 1 15483200 +* CONTINUATION CARDS NEEDED, LIKEWISE RSCBLK (MOAN). 15483220 + LA RY,AWBLANK FAKE BLANK CARDIMAGE FOR INCRSMV 15483240 + LA RE,RSOLC GET LENGTH OF CONTINUED CARDIMAGE 15483260 + AR R1,R1 SET # CARDS SO FAR = 2 (AT LEAST) 15483280 + BAL R14,INCRSMV1 HAVE 1ST SECTION OF RSCBLK SET UP 15483300 + MVI RSCONSQ-RSCILEN(RD),C'X' INDICATE CONTINUED CARD 15483320 + BAL R14,INCMOV MOVE SECOND CARD SEQNO/SET CODES 15483340 + SPACE 1 15483360 + CR RC,RE ARE THERE 2 CARDS OR 3 15483380 + BNH INMCONT2 <= RSOLC ==> ONLY 2 CARDS TOTAL - GO 15483400 + SPACE 1 15483420 + SR RC,RE GET LENGTH OF 3RD CARD IMAGE 15483440 + MVI RSCONSQ-RSCILEN(RD),C'X' SHOW 2ND CARD CONINUED 15483460 + BAL R14,INCMOV SAVE 3RD AND LAST SECTION OF RSCBLK 15483480 + LA R1,1(,R1) SET TOTAL # CARDS = 3. 15483500 +* IT IS ASSUMED THAT MEXPND NEVER CREATES STMTS HAVING * 15483520 +* MORE THAN 193 (RSOL1+2*RSOLC) BYTES OF SOURCE DATA. * 15483540 +* OTHERWISE, IT WOULD BE NECESSARY TO CHECK (RC) <= RSOLC* 15483560 +INMCONT2 STC RC,RSCILEN-RSCILEN(,RD) SAVE LENGTH OF LAST PART <=56. 15483580 + B INCNORM ALL SET, NO GO PROCESS NORMALLY 15483600 + SPACE 1 15483620 +INMOVRGN EQU * COME HERE IF OVERRUN OCCURS 15483640 + MVC AVGEN1CD,AVGEN2CD COPY, SO THINKS NO MORE GEN'D STMTS 15483660 + MVC 0(80,RY),AWBLANK FAKE A BLANK CARD 15483680 + OI RSBFLAG,$RSBNPNN DON'T PROCESS FURHTER 15483700 + LA RB,$EROVRGN FLAG ERROR: GEN'D STMTS OVERRUN 15483720 + B INCHECK SKIP OVER CARD READ AND GO ON 15483740 + EJECT 15483760 + SPACE 1 15484420 +INNOTGEN EQU * ENTERED IF NOT GENRTED STMT 15484440 +.INNOMA ANOP 15484460 + $SORC 0(RY),80,INCREOF READ FIRST,HOPEFULLY ONLY,CARD 15486000 +INCHECK CLI RSOCONT,C' ' CHECK FOR CONTINUATION CAHR 15498000 + BNE INCCONT CARD MUST BE CONTINUED-BRANCH 15500000 + CLC RSOSEQN,AWBLANK IS THERE SEQUENCE INFO 15502000 + BE INCNORM NO SEQNO-BRANCH NORMAL 15504000 +INCHC BAL R14,INCRSMV CALL CONTINUATION/SENO SAVER 15506000 + EJECT 15508000 +* ENTIRE STATEMENT READ-FINISH UP AND RETURN * 15510000 +INCNORM STC R1,RSBNUM SAVE # CARDS(HOPEFULLY 1) 15512000 + LA RE,RSBLOCK(RZ) GET @ LAST ACTUAL SOURCE BYTE 15514000 +* FOLLOWING SECTION REMOVES BLANKS FROM END OF CARD. * 15516000 + BCT R1,INCBLC SKIP BLANK-CRUNCH IF >1 CARD 15518000 +* REMOVE 36 BLANKS QUICKLY, IF POSSIBLE 15520000 + LH R2,=H'-36' GET VALUE TO BACK UP @ PTR 15522000 + AR R2,RE GET @ BEGINNING OF COMMENTS FIELD 15524000 + CLC 1(36,R2),AWBLANK IS HALF OF CARD ALL BLANK 15526000 + BE INCBL YES,SO LEAVE R2 WHERE IT IS, BLANKS 15528000 + LR R2,RE WASN'T BLANK, DO WHOLE THING 15530000 +INCBL LA R1,RSBSOURC+9 LIMIT @, INCLUDING POSSIBLE LABEL 15531000 + LH R0,=H'-8' DECREMENT: 8 BLANKS PER CHUNK 15532000 + BXLE R2,R0,INCBLN DECREMENT/TEST, SKIP IF TERHE ALREAD 15533000 + SPACE 1 15534000 + CLC 1(8,R2),AWBLANK CHOP OFF 8 BLANKS IF POSSIBLE 15535000 + BNE INCBLN NOT BLANKS, TOO BAD, SKIP OUT 15536000 + BXH R2,R0,*-10 LOOP UNTIL LIMIT REACHED 15536500 +INCBLN SR R2,R0 SUBTRCT DECREMNT, PUT PTR BACK OK 15537000 + SPACE 1 15537500 + L R0,AWFM1 GET NEW DECREMENT FOR 1 AT A TIME 15538000 + SPACE 1 15540000 +* LOOP TO REMOVE BLANKS FROM END OF STMT, 1 AT A TIME. * 15542000 +INCBLA CLI 0(R2),C' ' IS THIS A BLANK 15544000 + BNE INCBLB NO IT ISNT, SO QUIT REMOVING-BRANCH 15546000 + BXH R2,R0,INCBLA LOOP UNTIL LIMIT @ REACHED 15548000 + SPACE 1 15550000 + SR R2,R0 SUBTRCT -1,PUT POINTER BACK RIGHT 15552000 +INCBLB SR R2,RE GET # BLANKS REMOVED 15554000 + AR RZ,R2 ADD DECREMENT TO LENGTH VALUE IN RZ 15556000 + AR RE,R2 OBTAIN @ LAST BYTE(NEW) 15558000 + SPACE 1 15558100 +* CONCATENATE ENDING FIELD " ' " TO SOURCE STMT TO * 15558200 +* PREVENT SCANNING BEYOND END OF STMT. SAVE LIMIT @ IN * 15558300 +* AVSOLAST, SAVE FINAL LENGTH-1 OF RSBLOCK. RETURN. * 15558400 +INCBLC EQU * FOR SKIP IF >1 CARD, NO CRUNCH 15560000 + MVC 1(4,RE),INCBQB MOVE IN DELIMITER VALUE 15562000 + LA RC,2(RE) GET @ OF BLANK BEFORE ENDING ' 15562500 + ST RC,AVSOLAST STORE THIS FOR OTHER'S USE 15563000 + LA RZ,2(RZ) INCREMENT RZ BY 1 TO GET >=2BLANKS 15564000 + STC RZ,RSBLENG SAVE L-1 OF RSBLOCK 15566000 +INCRET $RETURN RGS=(R14-R6),SA=NO 15568000 + EJECT 15570000 +* FOLLOWING SECTION ENTERED FOR CONTINUATION CARD * 15572000 +INCCONT BAL R14,INCRSMV HAVE CONTINUATION FIELD-SEQNO SAVED 15574000 + C R1,AWF3 IS # OF CARDS<3(MAXIMUM) 15576000 + BNL INCERR1 NO,WE HAVE TOO MANY CONTS(3 OR MORE) 15578000 + LA RY,RSBLOCK+1(RZ) GET NEXT ADDRESS TO BE INPUT 15580000 + $SORC 0(RY),80,INCREOFA GET NEXT CARD 15582000 + CLC RSOLOPC,AWBLANK ARE 1ST 15 COLUMNS BLANK 15584000 + BE INCCOK BRANCH IF IT IS BLANK(OK) 15586000 + LR RA,RY ERROR-MOVE ADDRESS OVER 15588000 + LA RB,$ERCONT ILLEGAL CONTINUATION-ERROR 15590000 + SPACE 1 15594000 +INCCOK MVC RSOURCE(L'RSOOPRCM),RSOOPRCM MOVE CARD IMAGE OVER 15596000 + LA RZ,L'RSOOPRCM(RZ) INCREMENT LENGTH-1 OD RSBLOCK 15598000 + LA R1,1(R1) INCRMENT NUMBER OF CARDS 15600000 + CLI RSOCONT,C' ' IS CONTINUATION CARD CONINUED ALSO 15602000 + BE INCHC NO IT ISNT,HAVE LAST CONT/SEN SAVED 15604000 + B INCCONT CONINUED AGAIN-KEEP GOING 15606000 +INCREOF MVC RSBSOURC(71),AWBLANK BLANK OUT SOURCE AREA 15608000 + SPACE 1 15610000 + MVC RSBSOURC+9(3),=C'END' MAKE UP END CARD 15612000 + LA RA,RSBSOURC+10 SET PTR TO END FOR WARNING 15614000 + LA RB,$ERNOEND WARNING-MESSAGE CODE-NO END CARD 15616000 +INCREOFA OI AVTAGS2,$INEND2 EOF==> CREATE END CARD NEXT TIME 15620000 + B INCNORM GO SET FLAGS AND RETURN 15622000 +INCERR1 LA RB,$ERCONTX TOO MANY CONTINUATIONS(>2) 15624000 + LA RA,RSOCONT-1 GET THE POINTER 15626000 + LA R14,INCNORM SET RETURN ADDR OF INCRSMV 15630000 +* FALL THRU INTO INCRSMV (WHICH MUST FOLLOW). 15632000 + SPACE 1 15634000 +**--> INSUB: INCRSMV SAVE CON/SEQNO INTO RSCBLK + + + + + + + + + + 15634200 +*+ ENTRY CONDITIONS + 15634400 +*+ RY = @ CARDIMAGE FROM WHICH CON/SEQNO TAKEN (RSOURCE DSECT) + 15634600 +*+ EXIT CONDITIONS + 15634800 +*+ RD = @ VARIABLE PART OF RSCBLK JUST CREATED (I.E. NEWEST RSCILEN) + 15635000 +*+ R14= RETURN @ TO CALLING SECTION OF CODE IN INCARD. + 15635200 +*+ R2 IS DESTROYED. + 15635400 +*++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 15635600 + SPACE 1 15636000 +INCRSMV TM RSBFLAG,$RSCX HAVE THERE BEEN PREVIOUS CONT/SEQS 15638000 + BO INCMOV YES THERE HAVE,BRANCH 15640000 +INCRSMV1 OI RSBFLAG,$RSCX SHOW 1ST ONE - RSC EXISTS 15642000 + MVI RSCLENG,0 ZERO OUT LENGTH AT FIRST 15644000 + MVI RSCILEN,RSOCONT-RSOURCE LENGTH FOR 1ST CRD(71) 15646000 +INCMOV IC R2,RSCLENG GET CURRENT L-1 OF BYTES 15648000 + LA RD,RSCILEN(R2) GET ADDR OF NEXT SLOT 15650000 + LTR R2,R2 WAS THIS 1ST CARD 15652000 + BZ *+8 SKIP MVI IF IT WAS 1ST 15654000 + MVI 0(RD),L'RSOOPRCM MOVE IN LENGTH FOR CONT CARD (56, 15656000 + MVC RSCONSQ-RSCILEN(9,RD),RSOCONT MOVE CONT/SEQ OVER 15658000 + LA R2,RSC$LEN(R2) INCREMENT LENGTH-1 15660000 + STC R2,RSCLENG UPDATE LENGTH-1 15662000 + BR R14 RETURN TO CALLING SECTION 15664000 + SPACE 1 15666000 +* * * * * INTERNAL CONSTANTS * 15668000 +INCBQB DC C' '' ' DELIMITER FIELD FOR END OF SOURCE 15670000 + LTORG 15672000 + DROP RAT,REP,RW,RX,RY REMOVE ALL USINGS 15674000 + TITLE '*** LTOPRS - LITERAL OPERATIONS ***' 15676000 +**--> CSECT: LTOPRS 1-2 ALL LITERAL TABLE OPERATIONS. . . . . . . . . 15678000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 15680000 +LTOPRS CSECT 15682000 + $DBG A0,* 15684000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15686000 +* NOTE RESTRICTION - A-TYPE ADCONS IN LITERALS MAY NOT * 15688000 +* MAKE REFERENCES TO THE LOCATION COUNTER. A WARNING * 15690000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15692000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 15694000 + ENTRY LTINT1,LTENT1,LTDMP1,LTEND1,LTGET2,LTDMP2 15696000 + SPACE 2 15698000 +**--> ENTRY: LTINT1 1 INITIALIZE LITERAL TABLE IF NEEDED. . . . . . 15700000 +*. ALLOCATES AND ZEROS 1ST LITERAL POOL BASE TABLE. INITS 1ST AND * 15702000 +*. CURRENT BLOCK POINTERS TO 1ST LTBASETB. * 15704000 +*. CALLS MOSTOP . 15704100 +*. USES DSECTS: AVWXTABL,LTBASETB . 15704200 +*. USES MACROS: $ALLOCH,$RETURN,$SAVE . 15704300 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 15706000 +LTINT1 $SAVE SA=NO 15708000 + LA RB,LTB$LEN GET LENGTH OF 1 LTBASETB ENTRY 15710000 + $ALLOCH RA,RB,LTZOVER GET NEEDED SPACE 15712000 + LR RB,RA DUPLICATE THIS VALUE 15714000 + STM RA,RB,LTBFIRST LTBFIRST-LTBNOW - SET POINTERS 15716000 + USING LTBASETB,RA NOTE USING 15718000 + MVC LTBASETB(LTB$LEN),AWZEROS ZERO OUT THE TABLE 15720000 + DROP RA CLEAN UP USING 15722000 + $RETURN SA=NO 15724000 + EJECT 15726000 +**--> ENTRY: LTENT1 1 ENTER A LITERAL INTO THE TABLE. . . . . . . . 15728000 +*. THIS ENTRY IS CALLED DURING PASS 1 TO SCAN A LITERAL BY . 15728100 +*. IAMOP1. THE LITERAL IS SCANNED BY CODTL1, AND IT IS ENTERED . 15728200 +*. IF IT IS NOT ALREADY PRESENT. NOTE THAT NO DUPLICATES . 15728300 +*. ARE EVER KEPT IN THE SAME POOL, EVEN FOR A-TYPE CONSTANTS . 15728400 +*. WITH LOCATION COUNTER REFERENCES. . 15728500 +*. ENTRY CONDITIONS . 15730000 +*. RA = SCAN POINTER (ADDRESS OF = IN LITERAL) . 15732000 +*. EXIT CONDITIONS . 15734000 +*. RA = SCAN POINTER (ADDRESS OF ERROR OR DELIMETER) . 15736000 +*. RB = 0 IF LITERAL LEGAL, ERROR CODE OTHER WISE . 15738000 +*. RC = ADDRESS OF LITERAL TABLE ENTRY . 15740000 +*. CALLS CODTL1,MOSTOP . 15741000 +*. USES DSECTS: AVWXTABL,CNCBLOCK,LTBASETB,LTLENTRY,RSBLOCK . 15742000 +*. USES MACROS: $ALLOCH,$CALL,$RETURN,$SAVE,$SCPT . 15743000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 15744000 + SPACE 1 15746000 +* * * * * REGISTER ALLOCATION FOR LTENT1 * * * * * * * * * * * * * * * 15748000 +* R1 = #-1 OF CHARACTERS IN THE LITERAL BEING PROCESSED * 15750000 +* R2 = # OF CHARACTERS IN LITERAL,ROUNDED TO FULLWORD, THEN -1 * 15752000 +* RW = BASE REGISTER * 15754000 +* RX = INITIAL SCAN POINTER TO = OF LITERAL * 15756000 +* RC = @ CNCBLOCK PROVIDED BY CODTL1 * 15758000 +* RD = TOTAL LENGTH OF NEW LTENTRY BLOCK * 15760000 +* RE = @ LTENTRY BLOCK FOR A NEW LITERAL * 15762000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 15764000 + SPACE 1 15766000 +LTENT1 $SAVE RGS=(R14-R6),SA=LTOPSAVE,BR=R3 15768000 + SPACE 1 15770000 +* INITIALIZES, CALL 1ST-PASS CONSTANT PROCESSOR. 15772000 + LR RX,RA SAVE SCAN POINTER 15774000 + LA RA,1(RA) INCREMENT POINTER PAST = 15776000 + LA RB,8 SHOW CODTL1 WE ARE IN LITERAL 15778000 + $CALL CODTL1 CALL DUPLFAC-TYPE-LENGTH PROCESSOR 15780000 + LTR RB,RB WAS THERE AN ERROR 15782000 + BNZ LTE1RET IF SO,RETURN SHOWING ERROR 15784000 + SPACE 1 15786000 +* CHECK TO MAKE SURE NO MISSING DELIMITER. 15788000 + C RA,AVSOLAST COMPARE TO @ BLANK BEFORE ' 15788500 + BNL LTE1ERR3 MISSING QUOTE ON C-CON-ERROR 15789000 + USING CNCBLOCK,RC CODTL1 HAS SET UP A CNCBLOCK 15806000 + SPACE 1 15808000 +* SET UP FOR LOOKING FOR A DUPLICATE LITERAL * 15810000 + LR R1,RA MOVE NEW SCAN POINTER OVER 15812000 + SR R1,RX GET LENGTH OF LITERAL-# OF CHARS 15814000 + LA R15,112 GET LENGTH FOR COMPARISON 15816000 + CR R1,R15 MAKE SURE NO MORE THAN 2 CARDS 15818000 + BH LTE1ERR4 BRANCH IF TOO LONG 15820000 + BCTR R1,0 GET # CHARS - 1 IN LITERAL 15822000 + BCTR RE,0 GET TOTAL LENGTH-1 OF LITERAL DC 15824000 + N RE,AWF7 REMOVE ALL BUT LAST 3 BITS OF LENGTH 15826000 + IC R15,LTEB1248(RE) GET THE OFFSET TO POINTER -LTBASETB 15828000 + L R14,LTBNOW GET @ CURRENT LTBASETB 15830000 + USING LTBASETB,R14 NOTE TABLE USING 15832000 + LA RE,LTBCH1(R15) GET @ ACTUAL POINTER -LTBCH1-2-4-8 15834000 + DROP R14 NO LONGER NEEDED 15836000 + USING LTLENTRY,RE WILL POINT AT 1ST ENTRY,IF ^=0 15838000 + STC R1,LTE1CLI+1 SAVE #-1 OF CHARS INTO CLI 15842000 + STC R1,LTE1CLC+1 SAVE #-1 OF CHARS INTO CLC ALSO 15844000 + BAL R15,LTE1L BEGIN SEARCH,SETTING REG FOR BCR TOO 15846000 + SPACE 1 15848000 +* SEARCH FOR LITERAL IN CHAIN OF RIGHT LENGTH. * 15850000 +LTE1CLI CLI LTLCHARS,$CHN CHECK 1ST FOR SAME # OF CHARS 15852000 + BNE LTE1L IF NOT,LOOP TO NEXT ON CHAIN 15854000 +LTE1CLC CLC LTLITRAL($CHN),0(RX) IS LITERAL THE SAME 15856000 + BE LTE1OLD BRANCH OUT IF SAME LITERAL 15858000 + SPACE 1 15860000 +LTE1L LR RD,RE SAVE @ OLD LTLENTRY 15862000 + L RE,LTLINK GET @ NEXT LTLENTRY FROM OLD ONE 15864000 + LA RE,0(RE) REMOVE 1ST BYTE 15866000 + LTR RE,RE IS THE LINK = 0 15868000 + BCR NZ,R15 BNZ LTE1CLI - GO BACK FOR NEXT TEST 15870000 + SPACE 1 15872000 +* FALL THRU==> THIS IS A NEW LITERAL-GET SPACE&ENTER IT * 15874000 + LA R14,LTL$LEN+4(R1) GET TOTAL LENGTH,ROUNDED OVER FULL 15876000 + O R14,AWF3 MAKE LAST 2 BITS 1'S 15878000 + S R14,AWF3 ALIGN TO FULLWORD AMOINT 15880000 + $ALLOCH RE,R14,LTZOVER GET SPACE FOR NEW ENTRY 15882000 + STC R1,*+5 PUT LENGTH-1 INTO MVC 15884000 + MVC LTLITRAL($CHN),0(RX) MOVE LITERAL OVER 15886000 + LR R15,RE MOVE POINTER OVER 15888000 + AL R15,0(RD) ADD LTLCHARS OF PREVIOUS ENTRY 15890000 + ST R15,0(RD) STORE LTLCHARS-LTLINKA BACK 15892000 + MVC LTLTYP(CNC$LEN),CNCBLOCK MOVE ALL THE CODES OVER 15894000 + DROP RC HAVE GOTTEN CODES,NO MORE USING 15896000 + SLL R1,24 SHIFT LENGTH-1 FOR POSITION TO STORE 15898000 + ST R1,LTLINK STORE LTLCHARS FIELD, WITH 0 LTLINKA 15900000 + $SCPT R15,LTLSCAN GET SCAN POINTER ADDRESS 15902000 + SR R15,RX GET OFFSET FROM = SIGN 15904000 + STC R15,LTLSCAN SAVE THIS SCAN POINTER INSTEAD 15906000 +LTE1OLD LR RC,RE MOVE @ LITERAL ENTRY FOR RETURN 15908000 +LTE1RET $RETURN RGS=(R14-R6) 15910000 + SPACE 1 15912000 +* INDIVIDUAL ERROR EXITS. * 15914000 +LTE1ERR3 LA RB,$ERNODLM MISSING DELIMITER 15916000 + B LTE1RET RETURN 15918000 +LTE1ERR4 LA RB,$ERCNLNG CONSTANT TOO LONG FOR LITERAL 15920000 + B LTE1RET GO RETURN 15922000 + EJECT 15924000 +**--> ENTRY: LTDMP1 1 DUMP LITERALS ON FINDING LTORG AND END. . . . 15926000 +*. LTDMP1 IS CALLED BY IBASM1 TO FIND LENGTH OF THE CURRENT . 15928000 +*. LITERRAL POOL, AND AVANCE THE CURRENT POOL PTR TO THE NEXT 1.. 15928050 +*. EXIT CONDITIONS . 15930000 +*. RA = TOTAL LENGTH REQUIRED FOR THE LITERAL BLOCK . 15932000 +*. CALLS MOSTOP . 15932100 +*. USES DSECTS: AVWXTABL,LTBASETB,LTLENTRY . 15932200 +*. USES MACROS: $ALIGN,$ALLOCH,$CALL,$GLOC,$RETURN,$SAVE . 15932300 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 15934000 +LTDMP1 $SAVE RGS=(R14-R0),SA=NO 15936000 + SPACE 1 15938000 +* INITIALIZE PROCESSING FOR 1 LITERAL POOL. 15940000 + SR RA,RA CLEAR TOTAL LENGTH 15942000 + L RB,LTBNOW GET POINTER TO CURRENT LTBASETB 15944000 + USING LTBASETB,RB TELL ASSEMBLER 15946000 + $GLOC RE GET LOCATION COUNTER 15948000 + $ALIGN RE,7,* ALIGN TO DOUBLEWORD 15950000 + ST RE,LTBVALUE SAVE THIS VALUE IN LTBLOCK 15952000 + LA RC,4 # OF LITERAL CHAINS - LTBCH1-2-4-8 15954000 + LA RD,LTBCH8 @ FIRST CHAING POINTER TO BE DONE 15956000 + SPACE 1 15958000 +* OUTSIDE LOOP - GET NEXT CHAIN OF LITERALS - 8-4-2-1. 15960000 +LTD1L L RE,0(RD) GET NEXT POINTER FORM LTBCH1-2-4-8 15962000 + USING LTLENTRY,RE NOTE ENTRY POINTER(@ SET LOWER DOWN) 15964000 + A RD,AWFM4 SUBTRACT 4 TO GET NEXT ONE NEXT TIME 15966000 + BAL R14,LTD1LTR GO TEST LINK PTR,ALSO SETING R14 15968000 + SPACE 1 15970000 +* LOOP ALONG LITERAL CHAINS,ADDING LENGTHS,GETTING OFSETS* 15972000 +LTD1E STH RA,LTLOFSET SAVE OFFSET OF LITERAL 15974000 + AH RA,LTLTOT ADD THE TOTAL LENGTH OF LITERAL IN 15976000 + AIF (&$DEBUG).LTXS1 SKIP IF PRODUCTION 15978000 + XSNAP STORAGE=(*LTLENTRY,*LTLITRAL),IF=(AVDEBUG,O,X'84',TM) 15980000 +.LTXS1 ANOP 15982000 + L RE,LTLINK GET @ NEXT LITERAL ON CHAIN 15984000 + LA RE,0(RE) REMOVE FIRST BYTE(LTLCHARS) 15986000 +LTD1LTR LTR RE,RE IS POINTER 0. IF SO==> LAST ON CHAIN 15988000 + BCR NZ,R14 BNZ LTD1E - KEEP GOING IF MORE 15990000 + SPACE 1 15992000 + BCT RC,LTD1L LOOP TO GET ALL LITERALS - 8-4-2-1 15994000 + DROP RE NO LONGER NEEDED 15996000 + SPACE 1 15998000 + LA RD,LTB$LEN GET LENGTH FOR NEXT LTBASETB 16000000 + $ALLOCH RE,RD,LTZOVER GET THE SPACE 16002000 + ST RE,LTBLINK SAVE POINTER TO NEW LTBASETB IN OLD 16004000 + MVC LTBESDID,AVCESDID MOVE CURRENT ESDID OVER 16006000 + DROP RB NO MORE REFS TO OLD LTBASETB 16008000 + USING LTBASETB,RE USING FOR JUST CREATED LTBASETB 16010000 + MVC LTBASETB(LTB$LEN),AWZEROS ZERO IT OUT 16012000 + ST RE,LTBNOW SAVE NEW POINTER 16014000 +LTD1RET $RETURN RGS=(R14-R0),SA=NO 16016000 + DROP RE NO LONGER USING 16018000 + EJECT 16020000 +* * * * * LTZOVER IS ENTERED IF STORAGE OVERFLOW OCCURS, PASS 1 * 16022000 +LTZOVER $GTAD REP,MOSTOP GET ADDR OF OVERFLOW ERROR EXIT 16024000 + BR REP GO THERE, WILL EVENTAULLY PRINT 999 16026000 + SPACE 1 16030000 +**--> ENTRY: LTEND1 1 CLEANUP AFTER PHASE 1 PREPARE FOR PHASE 2 . . 16032000 +*. THIS ENTRY SETS UP FOR ASSEMBLER PASS 2 LITERAL PROCESSING. . 16032500 +*. USES MACROS: $RETURN,$SAVE . 16033000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16034000 +LTEND1 $SAVE SA=NO 16036000 + MVC LTBNOW,LTBFIRST RESET ORIG POINTER TO CURRENT ONE 16038000 + $RETURN SA=NO 16040000 + SPACE 2 16042000 +**--> ENTRY: LTGET2 2 GET ADDRESS OF LITERAL IN ASSEMBLY. . . . . . 16044000 +*. LTGET2 IS CALLED BY ICMOP2 EACH TIME A LITERAL IS FOUND IN . 16044100 +*. SCANNING MACHINE INST OPERANDS DURING PASS 2. IT RETURNS THE . 16044200 +*. ATTRIBUTES OF THE LITERAL, INCLUDING THE USER PROGRAM @ FOR . 16044300 +*. THE LITERAL, THE SECTION ID OF THE LITERAL, AND THE LENGTH . 16044400 +*. ATTRIBUTE OF THE LITERAL. ICMOP2 SUPPLIES A POINTER TO THE . 16044500 +*. LTLENTRY OF THE LITERAL, WHICH HAD BEEN SAVED IN THE . 16044600 +*. STATEMENT'S RCODBLK . . 16044700 +*. ENTRY CONDITIONS . 16046000 +*. RA = SCAN POINTER TO 1ST CHAR OF LITERAL = . 16048000 +*. RC = @ LITERAL TABLE ENTRY IN LITERAL TABLE(WAS SAVED IN RCB) . 16050000 +*. EXIT CONDITIONS . 16052000 +*. RA = SCAN POINTER TO CHARACTER AFTER LITERAL . 16054000 +*. RB = ESDID OF CSECT IN WHICH LITERAL EXISTS . 16056000 +*. RC = ADDRESS OF LITERAL (PROGRAM ADDRESS-FOR LISTING,ETC) . 16058000 +*. RD = IMPLIED LENGTH-1 OF THE LITERAL(LOW ORDER BYTE, OTHERS INDTR). 16060000 +*. USES DSECTS: AVWXTABL,LTBASETB,LTLENTRY . 16060500 +*. USES MACROS: $RETURN,$SAVE . 16061000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16062000 + USING LTLENTRY,RC NOTE USING,ON ENTRANCE 16064000 +LTGET2 $SAVE SA=NO 16066000 + L RE,LTBNOW GET POINTER TO CURRENT LTBASETB 16068000 + USING LTBASETB,RE NOTE THE USING HERE 16070000 + SR RB,RB CLEAR FOR INSERT OF ESDID 16072000 + IC RB,LTLCHARS GET LENGTH-1 OF LITERAL STRING 16074000 + LA RA,1(RA,RB) BUMP SCAN POINTER PAST LITERAL 16076000 + IC RB,LTBESDID GET THE ESDID OF LITERAL POOL 16078000 + AIF (&$DEBUG).LTXS2 SKIP IF PRODUCTION 16080000 + XSNAP STORAGE=(*LTLENTRY,*LTLITRAL),IF=(AVDEBUG,O,X'84',TM) 16082000 +.LTXS2 ANOP 16084000 + IC RD,LTLLEN GET LENGTH-1 BEFORE RC ERASED 16085000 + LH RC,LTLOFSET GET OFFSET FROM LITERAL POOL BASE 16086000 + A RC,LTBVALUE GET ACTUAL ADDRESS 16088000 +LTG2RET $RETURN SA=NO 16092000 + DROP RC,RE REMOVE THE USINGS 16094000 + EJECT 16096000 +**--> ENTRY: LTDMP2 2 DUMP LITERALS IN PASS 2 . . . . . . . . . . . 16098000 +*. LTDMP2 IS CALLED BY IDASM2 DURING PASS 2, WHENEVER A LTORG . 16098100 +*. OR END STMT IS FOUND, TO PRODUCE THE OBJECT CODE AND LISTING . 16098200 +*. OF ANY LITERALS IN THE CURRENT LITERAL POOL. THE CURRENT . 16098300 +*. POOL BASE POINTER IS ADVANCED TO THE NEXT LTBASETB. . 16098400 +*. CALLS CNDTL2 . 16098500 +*. USES DSECTS: AVWXTABL,LTBASETB,LTLENTRY . 16098600 +*. USES MACROS: $CALL,$GLOC,$RETURN,$SAVE,$SLOC . 16100000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16102000 +LTDMP2 $SAVE RGS=(R14-R6),SA=LTOPSAVE,BR=R13 16104000 + SPACE 1 16106000 +* * * * * REGISTER ALLOCATION AND USAGE FOR LTDMP2 * * * * * * * * * * 16108000 +* R1 = @ CURRENT LTBASETB BEING PROCESSED. 1 IS DONE FOR EACH CALL. * 16110000 +* R2 = BYTE REGISTER FOR INSERTIONS. * 16112000 +* RW = @ LOOP HEAD FOR 1 LINK OF 1 LITERAL CHAIN. * 16114000 +* RX = @ CURRENT LTLENTRY BLOCK BEING PROCESSED. * 16116000 +* RY = -4 FOR BXH INDEX AND LIMIT VALUE. * 16118000 +* RZ = OFFSET(0-4-8-12) TO LTBCH# POINTER OF LENGTH BEGIN DONE * 16120000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 16122000 + SPACE 1 16124000 +* INITIALIZATION - SET UP FAKE RECORD PTRS,ETC. * 16126000 + LA RA,LTRCODBL GET @ FAKE RCODBLK SET UP 16128000 + ST RA,AVRCBPT SAVE THIS ADDRESS 16130000 + LA RA,LTRSBLOC GET @ FAKE RSBLOCK 16132000 + LA RB,LTRSCBLK GET @ FAKE RSCBLOCK 16134000 + STM RA,RB,AVRSBPT STORE PTRS IN AVRSBPT-AVRSCPT 16136000 + $GLOC R0 GET LOCATION COUNTER 16138000 + L R1,LTBNOW GET @ NEXT LTBASETB 16140000 + USING LTBASETB,R1 NOTE THE POINTER 16142000 + SR R2,R2 BYTE REGISTER-CLEAR FOR INSERTS 16144000 + L RY,AWFM4 GET -4 FOR BXH'ING 16146000 + LA RZ,LTBCH8-LTBCH1 GET OFFSET FROM LTBCH1-DO LENGTH 8 16148000 + EJECT 16150000 +* PROCESS CHAINS OF LITERALS, IN ORDER OF LENGTH 8-4-2-1.* 16152000 +* LTD2LRX ENTERD 4 TIMES,1 FOR EACH CHAIN OF LITERALS. * 16154000 +LTD2LRX L RX,LTBCH1(RZ) GET NEXT POINTER FROM LTBASETB 16156000 + USING LTLENTRY,RX NOTE POINTER 16158000 + BAL RW,LTD2LTR GO CHECK FOR LITERALS OF THIS LENGTH 16160000 + SPACE 1 16162000 +* FOLLOWING CODE EXECUTED 1 TIME FOR EACH LITERAL IN POOL* 16164000 +* PLACE LITERAL FOR PASS 2 SCAN AND PRINTING. * 16166000 +LTD2LTL IC R2,LTLSCAN GET SCAN POINTER OFFSET FROM = TO CN 16168000 + LA R2,LTRSBOPR-LTRSBLOC(R2) GET CORRECT OFFSET 16170000 + STC R2,LTLSCAN SAVE WHERE CNDTL2 WILL EXPECT IT 16172000 + IC R2,LTLCHARS GET #-1 OF CHARS IN LITERAL 16174000 + MVC LTRSBLOC(3),LTRSBCO1 GET CODES FOR 1 CARD LITER 16176000 + CLI LTLCHARS,55 ARE THERETOO MANY CHARS FOR 1 CARD 16178000 + BNH *+10 SKIP IF ONLY 1 CARD NEEDED 16180000 + MVC LTRSBLOC(3),LTRSBCO2 GET CODES FOR 2 CARDS 16182000 + SPACE 1 16184000 + STC R2,*+5 STORE LENGTH-1 INTO MVC 16186000 + MVC LTRSBOPR($CHN),LTLITRAL MOVE LITERAL FROM TABLE 16188000 + $SLOC R0 SET LOCATION COUNTER 16190000 + MVC LTRCLOC,AVLOCNTR+1 MOVE LOCATION COUNTER INTO FK RCB 16192000 + AH R0,LTLTOT ADD TOTAL LENGTH OF LITERAL TO LOC 16194000 + SPACE 1 16196000 + LA RB,1 SHOW CNDTL2 WE HAVE 1 OPERAND 16198000 + LA RC,LTLTYP GET @ CNCBLOCK PART OF LTLENTRY 16200000 + $CALL CNDTL2 HAVE CONSTANT PROCESSED,PRINTED 16202000 + STC R2,*+5 SAVE LENGTH-1 INTP BLANKING MVC 16204000 + MVC LTRSBOPR($CHN),AWBLANK+15+RSB$L BLANK,KEEPING BD 16206000 + L RX,LTLINK GET @ NEXT LTLENTRY ON CHAIN 16208000 + LA RX,0(RX) REMOVE 1ST BYTE IF ANY 16210000 + SPACE 1 16212000 +* CONTINUE LOOPING UNTIL LAST LITERAL FOUND ON CHAIN. * 16214000 +* THEN DECREMENT TO NEXT CHAIN BEGINNING AND PROCESS IT. * 16216000 +LTD2LTR LTR RX,RX WAS THIS LAST ONE ON CHAIN 16218000 + BCR NZ,RW BNZ LTD2LTL - GO BACK FOR NEXT 16220000 + BXH RZ,RY,LTD2LRX DONE WITH 1 CHAIN,GO ON TO NEXT 16222000 + SPACE 1 16224000 + MVC LTBNOW,LTBLINK MOVE POINTER TO NEXT LTBASETB OVER 16226000 +LTD2RET $RETURN RGS=(R14-R6) RETURN TO CALLER 16228000 + DROP R1,RX KILL USINGS 16230000 + EJECT 16232000 +* * * * * INTERNAL CONSTANTS * 16234000 +LTEB1248 DC X'000400080004000C' OFFSETS TO LTBCH1-2-4-8 FOR LENGTHS 16236000 +LTRSBCO1 DC AL1(RSB$LN1,$RCBX,1) CODES FOR FAKE RSBLOCK-1CD 16238000 +LTRSBCO2 DC AL1(RSB$LN1+56,$RCBX+$RSCX,2) CODES FOR RSBLOCK-2 CARDS 16240000 + SPACE 1 16242000 +* FAKE RSCBLK, USED IF MORE THAN 1 CARD REQUIRED FOR LIT.* 16244000 +LTRSCBLK DC AL1(1+2*RSC$LEN,71) RSCLEN,1ST RSCILEN FOR CONT/SEQ 16246000 + DC CL9'X' CONTINUATION FLAG,SEQNO 16248000 + DC AL1(56) LENGTH OF 2ND CARD IMAGE 16250000 + DC CL9' ' SEQNO OF 2ND CARD IMAGE 16252000 + SPACE 1 16254000 +* * * * * INTERNAL VARIABLES * 16256000 +LTBFIRST DS A @ FIRST LTBASETB IN EXISTENCE 16258000 +LTBNOW DS A @ CURRENT LTBASETB BEING PROCESSED 16260000 + SPACE 1 16262000 +* FAKE RCODBLK-RCLOC WILL BE USED AS LOCATION COUNTER. * 16264000 +LTRCODBL DS 0F LINE UP ON RIGHT BOUNDARY 16266000 + DC X'7' RCLENG - LENGTH-1 OF BLOCK 16268000 +LTRCLOC DS AL3 LOCATION COUNTER WILL BE PLACE HERE 16270000 + DC F'0' FILL OUT BLOCK 16272000 + SPACE 1 16274000 +* FAKE RSBLOCK - WILL BE USED TO ASSEMBLE AND PRINT. * 16276000 +LTRSBLOC DS 0D LINE UP 16278000 + DS CL4 RSBLEN-RSBFLAG,RSBNUM,RSBSCAN BYTES 16280000 +LTRSBSOU DC CL15' ' 15 BLANKS IN FRONT OF = 16282000 +LTRSBOPR DC CL56' ' OPERAND FIELD, IF ONLY 1 CARD USED 16284000 + DC CL56' ' CONTINUATION OF OPERAND FIELD 16286000 + EJECT 16288000 +**--> DSECT: LTBASETB LITERAL POOL BASE TABLE - 1 FOR EACH POOL . . . 16288050 +*. ONE LTBASETB IS CREATED FOR EACH LITERAL POOL, BY LTINT1 OR . 16288100 +*. LTDMP1. THE TOTAL # CREATED = # LTORGS + 2, WHICH INCLUDES . 16288150 +*. 1 FOR THE END STMT, AND 1 EXTRA 1 FOR CODE SIMPLIFICATION. . 16288200 +*. WHEN LTDMP1 IS CALLED, IT FILLS IN THE SECTION ID OF THE . 16288250 +*. SECTION WHERE THE POOL WILL BE ASSEMBLED, THE BEGINNING @ OF . 16288300 +*. THE POOL, AND THE OFFSET @ VALUES FROM THE BEGINNING @ TO . 16288350 +*. EACH LITERAL IN THE POOL. IN ADDITION TO ADDRESS AND SECTION. 16288400 +*. ID, THE LTBASETB ALSO CONTAINS THE LIST HEADS FOR 4 LISTS . 16288450 +*. OF LITERAL ENTRIES (LTLENTRY BLOCKS). USED ONLY IN LTOPRS. . 16288500 +*. LOCATION: HIGH END OF DYNAMIC AREA ($ALLOCH MACRO). . 16288550 +*. NAMES: LTB----- . 16288600 +*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16288650 + SPACE 1 16290000 +LTBASETB DSECT 16292000 +LTBLINK DS 0F ADDRESS OF NEXT LTB, =0 IF LAS 16294000 +LTBESDID DS C ESDID OF CSECT IN WHICH OCCURS 16296000 +LTBLINKA DS AL3 ACTUAL LINKA ADDRESS 16298000 +LTBVALUE DS F ADDRESS OF LTORG OR END,D BOUNDARY 16300000 +LTBCH1 DS A ADDRESS OF 1ST LTENRY FOR LENGTH 1 16302000 +LTBCH2 DS A ADDRESS OF 1ST ENTRY FOR LENGTH 2 16304000 +LTBCH4 DS A ADDRESS OF 1ST ENTRY FOR LENGTH 4 16306000 +LTBCH8 DS A ADDRESS OF 1ST ENTRY FOR LENGTH 8 16308000 +LTB$LEN EQU *-LTBASETB LENGTH OF 1 LITERAL BASE TABLE 16310000 + EJECT 16310050 +**--> DSECT: LTLENTRY LITERAL TABLE ENTRY FOR EACH LITERAL. . . . . . 16310100 +*. 1 LTLENTRY BLOCK IS CREATED BY LTENT1 FOR EACH UNIQUE . 16310150 +*. LITERAL IN A GIVEN LITERAL POOL. THE LTLENTRY BLOCKS ARE . 16310200 +*. ORGANIZED IN 4 LINKED LISTS, WITH LIST HEADS IN THE CURRENT . 16310250 +*. LTBASETB BLOCK. EACH LTLENTRY INCLUDES THE OFFSET FROM THE . 16310300 +*. BEGINNING OF THE CURRENT LITERAL POOL @ (ENTERED BY LTDMP1), . 16310350 +*. A COMPLETE CNCBLOCK DESCRIBING THE LITERAL CONSTANT, AND THE . 16310400 +*. CONSTANT IN CHARACTER FORM. LTGET2 USES THESE BLOCKS TO . 16310450 +*. DETERMINE THE USER PROGRAM ADDRESS FOR ANY DESIRED LITERAL, . 16310500 +*. AND LTDMP2 USES THEM TO PRINT LITERAL POOL LISTING AND . 16310550 +*. HAVE THE CODE ASSEMBLED FOR THE POOL. USED ONLY IN LTOPRS. . 16310600 +*. LOCATION: HIGH END OF DYNAMIC AREA ($ALLOCH MACRO). . 16310650 +*. NAMES: LTL----- . 16310700 +*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16312000 + SPACE 1 16314000 +LTLENTRY DSECT 16316000 +LTLINK DS 0F ADDRESS OF NEXT ENTRY ON CHAIN 16318000 +LTLCHARS DS C #-1 OF CHARACTERS IN LITERAL 16320000 +LTLINKA DS AL3 ACTUAL POINTER TO NEXT LTLENTRY 16322000 +LTLOFSET DS H OFFSET OF THIS LITERAL FROM BASE 16324000 + SPACE 1 16325000 +* FOLLOWING SECTION (INCLD LTLTOT) = 1 CNCBLOCK DSECT. 16325500 +LTLTYP DS C CONSTANT TYPE+ FLAGS 16326000 +LTLLEN DS C LENGTH-1 OF OPERAND 16328000 +LTLSCAN DS C SCAN POINTER TO 1ST CONSTANT 16330000 +LTLNUM DS C NUMBER OF CONSTANTS IN OPERAND 16332000 +LTLDUP DS H DUPLICATION FACTOR 16334000 +LTLTOT DS H TOTAL LENGTH OF OPERAND 16336000 +LTL$LEN EQU *-LTLENTRY LENGTH OF CONSTANT SECTION 16338000 +LTLITRAL DS C LITERAL, LENGTH ROUNDED UP TO F 16340000 + DROP RAT,R13 KILL USINGS 16342000 + TITLE '*** MOCON1 - MAIN CONTROL - ASSEMBLER PASS ONE ***' 16344000 +**--> CSECT: MOCON1 1 MAIN CONTROL - ASSEMBLER PASS 1 . . . . . . . 16346000 +*. MOCON1 PROVIDES OVERALL CONTROL FOR PASS 1 OF THE ASSIST . 16346050 +*. ASSEMBLER, AND SUPERVISES OR PERFORMS THE FOLLOWING: . 16346100 +*. 1. READING INPUT CARDS, CREATING RECORD BLOCKS (INCARD). . 16346150 +*. 2. SCANNING LABELS, ENTERING THEM IN SYMBOL TABLE(SYENT1). . 16346200 +*. 3. SCANNING CARD FOR THE OPCODE, IF ANY. . 16346250 +*. 4. FINDING OPCODE IN OPCODE TABLE (OPFIND). . 16346300 +*. 5. SCANNING FOR OPERAND FIELD, SAVING SCAN POINTER. . 16346350 +*. 6. 2ND LEVEL INSTRUCTION PROCESSING (IAMOP1,IBASM1). . 16346400 +*. 7. DEFINING ATTRIBUTES, VALUE OF LABEL, IF REQUIRED. . 16346450 +*. 8. UPDATING LOCATION COUNTER TO NEXT LOCATION. . 16346500 +*. 9. STORING RECORD BLOCKS FOR STMT (UTPUT1). . 16346550 +*. . 16346560 +*. NOTE: PRINT CONTROL/COMMENTS STMTS ARE PROCESSED COMPLETELY . 16346570 +*. DURING PASS 1 AND NOT SAVED, IF POSSIBLE. . 16346580 +*. . 16346590 +*. CALLS ERRLAB,ERRTAG,IAMOP1,IBASM1,INCARD,OPFIND,SYENT1,UTPUT1. 16346600 +*. CALLS OUTPT2 . 16346610 +*. USES DSECTS: AVWXTABL,OPCODTB,RCODBLK,RSBLOCK . 16346650 +*. USES MACROS: $CALL,$GLOC,$GTAD,$PRNT,$RETURN,$SAVE . 16346700 +*. USES MACROS: $SCOF,$SDEF,$SLOC . 16346750 +*. CALLS ERRLAB,ERRTAG,IAMOP1,IBASM1,INCARD,OPFIND,SYENT1 . 16348000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16350000 + SPACE 1 16351000 +MOCON1 CSECT 16352000 + $DBG 90,* 16354000 + ENTRY MOSTOP NOTE DISASTER ENTRY POINT 16356000 +* * * * * REGISTER USAGE IN MOCON1 * * * * * * * * * * * * * * * * * * 16358000 +* R0 CURRENTLY UNUSED. * 16360000 +* R2 = BYTE REGISTER, USED FOR INSERTIONS * 16362000 +* RW = ADDRESS OF RSBLOCK(NORMALLY IN AVWXTABL) * 16364000 +* RX = ADDRESS OF SYMBOL TABLE ENTRY,IF ANY,SAME AS AVLABPT. * 16366000 +* R5 = 1, USED FOR BXH'S,ETC. * 16368000 +* RA = SCAN POINTER ADDRESS REGISTER * 16369000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 16370000 + SPACE 1 16372000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 16374000 + $SAVE RGS=(R14-R6),BR=R13,SA=MOCOSAVE 16376000 + LA R2,AVREBLK RECORD ERROR BLOCK 16378000 + LA RW,AVRSBLOC RECORD SOURCE BLOCK 16380000 + USING RSBLOCK,RW RECORD SOURCE BLOCK 16382000 + LA RX,AVRSCBLK RECORD SOURCE CODE BLOCK 16384000 + STM R2,RX,AVREBPT SORE THE ADDRESSES IN TABLE 16386000 + SR R1,R1 CLEAR,SO TRT'S WILL WORK 16388000 + LR R2,R1 CLEAR THIS FOR INSERTS 16390000 + LA R5,1 INIT FOR BXH'S,ETC 16392000 + MVI MOBACK+1,X'F0' MAKE THE BC A BRANCH,UNTIL END FOUND 16394000 + AIF (NOT &$MACSLB).MONOMC1 16394500 + XCALL XXXXLBED MAKE SURE XXXXSORC SWITCH SET NORMALLY 16395000 +.MONOMC1 ANOP 16395500 + EJECT 16396000 +* MAIN LOOP - PASS 1. THRU MOSTINIT 1 TIME FOR EACH STMT.* 16398000 +MOSTINIT EQU * LOOP HEAD FOR ALL STATEMENTS 16400000 + SPACE 1 16400100 +* IF TIME/RECORDS EXCEEDED, HALT PROCESSING NOW. 16400200 + TM AVTAGS2,AJOASTOP WAS STOP BIT SET BY TIMER EXIT 16400300 + BO MORET YES, QUIT 16400400 + SPACE 1 16400500 + $CALL INCARD GET NEXT SOURCE CARD 16402000 + LTR RB,RB DID INCARD FIND AN ERROR 16402100 + BZ MOSTINIV NO, SO DON'T FLAG IT 16402200 + $CALL ERRTAG FLAG ERROR FOUND BY INCARD 16402300 + SPACE 1 16402400 +MOSTINIV EQU * 16402500 + AIF (NOT &$MACROS).MONMC1 SKIP IF NO MACROS 16403000 + TM RSBFLAG,$RSBNPNN+$RSBNP## DOES STMT NEED NO PROCESS 16403050 + BNZ MOUTOUCK NO PROC - SKIP TO SAVE OR PRINT NOW 16403100 +.MONMC1 ANOP 16403150 + SR RX,RX CLEAR TO SHOW NO LABEL YET ENCOUNTER 16408000 + LA RA,RSBSOURC SET UP ADDRESS FOR START SCAN 16410000 + SPACE 1 16411000 +* CHECK FOR COMMENT OR LACK OF LABEL ON STMT. 16411500 + CLI RSBSOURC,C' ' IS THIS NORMAL SOURCE,NO LABEL 16412000 + BE MONOLB YES,BRANCH TO HANDLE IT 16414000 + CLI RSBSOURC,C'*' IS IT A COMMENT 16416000 + BE MOCMSYSC SKIP TO CHK *SYSLIB POSSIBILITY 16418000 + SPACE 1 16420000 +* STATEMENT HAS A LABEL IF FALLS THRU HERE. * 16422000 + CLI RSBSOURC,C'0' MAKE SURE BEGINNING OF SYMBOLILLEGAL 16426000 + TRT RSBSOURC(9),AWTSYMT SCAN A SYMBOL 16428000 + BZ MOLABR1 SYMBOL 9+ CHARACTERS LONG-ERROR 16430000 + CLI 0(R1),C' ' IS DELIMITER BLANK LIKE SUPPOSED TO 16432000 + BNE MOLABR2 NO IT ISNT==> ERROR-BRANCH 16434000 + SPACE 1 16434500 +* LEGAL LABEL FOUND. ENTER IN SYMBOL TABLE. CHECK FOR 16435000 +* MULTIPLE DEFINITION, FLAG STMT IF SO. 16435500 + LR RB,R1 MOVE POINTER TO BLANK OVER 16436000 + SR RB,RA GET LENGTH OF SYMBOL 16438000 + $CALL SYENT1 HAVE SYMBOL ENTERED OR LOOKED UP 16440000 + LR RX,RA MOVE POINTER TO SYMBOL BACK OVER 16442000 + USING SYMSECT,RX NOTE SYMBOL TABLE USING 16444000 + TM SYFLAGS,$SYDEF WAS SYMBOL ALREADY DEFINED 16446000 + BZ MOLABGO NO IT WASNHT-OK 16448000 +MOLABMUL EQU * ENTER HERE IF MULTIPLE DEFINED LABEL 16449000 + LA RB,$ERMULDF MULTUPLY-DEFINED SYMBOL 16450000 + $CALL ERRLAB LABEL ERROR 16452000 +MOLABGO LR RA,R1 MOVE POINTER TO BLANK AFTER LABEL 16454000 + BXH RA,R5,MOOPC BUMP SCAN POINTER 1 AND BRANCH 16456000 + SPACE 1 16458000 +* THE FOLLOWING IS ENTERED IF THERE WAS NO LABEL * 16460000 +MONOLB CLC RSBSOURC+1(8),AWBLANK HOPE THAT THESE COLS BLANK 16462000 + BNE MOOPC NO THEY WERE'T,SKIP AND DO GENERALLY 16464000 + LA RA,RSBSOURC+9 HAPPINESS-1ST 9 COLS BLANK 16466000 +MOOPC ST RX,AVLABPT SAVE POINTER(IF LABEL) OR 0(IF NOT) 16468000 + EJECT 16470000 +* SCAN LOOP TO FIND OPCODE * 16472000 +MOOPCA CLI 0(RA),C' ' IS THIS ANOTHER BLANK 16474000 + BNE MOOPCB NO IT ISNT BLANK-BRANCH OUT 16476000 + BXH RA,R5,MOOPCA BUMP SCAN POINTER AND CONTINUE 16478000 + SPACE 1 16480000 +* OPCODE IS FOUND-RA POINTS THERE. IF OMITTED,RA==> ' * 16482000 +MOOPCB C RA,AVSOLAST COMPAE TO @ BLANK BEFORE ' AFTER 16484000 + BNL MOOPNONE BRANCH OUT - - MISSING OPCODE 16486000 + $CALL OPFIND LOOK UP TYPE OF OPCODE 16488000 + LTR RB,RB WAS IT LEGAL 16490000 + BNZ MOMACHK GO TO ERROR OR MACRO CHECK 16492000 + USING OPCODTB,RC NOTE OPCODE TABLE POINTER 16494000 + AR RA,R5 INCREMENT SCAN POINTER BY 1 16496000 + LR RE,RA SAVE SCAN POINTER FOR LATER 16498000 + SPACE 1 16500000 +* SEARCH FOR OPERAND FIELD. * 16502000 +MOOPRA CLI 0(RA),C' ' IS THIS STILL BLANK FIELD 16504000 + BNE MOOPRB NO-BRANCH OUT-WE HAVE OPERAND FIELD 16506000 + BXH RA,R5,MOOPRA BUMP SCAN POINT AND CONTINUE 16508000 + SPACE 1 16510000 +* FOUND FIRST NONBLANK CHAR IN OPERAND FIELD. TEST FOR 16512000 +* OMITTED OPERAND, EITHER COMPLETELY OR SHOWN BY ,. 16512200 +MOOPRB CLC 0(2,RA),=C', ' DOES HE SHOW OMITTED OPERAND 16512400 + BNE MOOPRB2 NO,SO SKIP TO CHK FOR TOTAL OMIT 16512600 + BXH RA,R5,MOOPRC BUMP SCAN PTR TO SHOW BLANK,FAKE OMI 16512800 + SPACE 1 16513000 +MOOPRB2 C RA,AVSOLAST CHK WITH @ BLANK BEFORE AFTERQUOTE 16514000 + BL MOOPRC OPERAND EXISTS, BRANCH 16516000 + LR RA,RE OMITTED,SO REPLACE ADDR OF 1ST BLNK 16518000 +MOOPRC $SCOF RE,RA,RSBSCAN PLACE SCAN POINTER 16520000 + SPACE 1 16521000 +* MAKE TYPE TEST TO DETERMINE WHICH 2ND LEVEL PROCESSOR. 16521500 + TM OPCTYPE,$IB MAKE TEST FOR TUPE OF OPCODE 16522000 + BZ MOCALLIA BRANCH TO CALL MACHINE INSTRUCTIONS 16524000 + BO MOCALLIB CALL ASSEMBLER INSTS 16528000 + AIF (NOT &$SPECIO).MONS SKIP IF NO SPECIALS 16530000 + AIF (NOT &$MACROS).MOSPNM SKIP IF SPECIALS,NO MACROS 16532000 + TM OPCTYPE,$IS WAS INSTRUCTION A SPECIAL 16534000 + BZ MOCALLMA BRANCH TO CALL MACRO1 16536000 +.MOSPNM IC R2,OPCTYPE GET TYPE OF OPCODE 16538000 + SLL R2,2 MULT BY 4 FOR ADDRESS 16540000 + $GTAD REP,SPECAD-4*$IS(R2) GET RIGHT ADDRESS 16542000 + B MOCALLXX GO TO CALL SECTION 16544000 +.MONS AIF (NOT &$MACROS).MONSM SKIP IF NO MACROS 16546000 +MOCALLMA TM AVTAGSM,AJOMACRO ARE WE IN MACRO MODE 16547000 + BZ MOOPNONE NO, FALG AS UNDERINFED OPCODE 16547500 +MOCALLMC EQU * ENTRY FROM OPEN CODE CHECK J 16547800 + $CALL MACRO1 CALL THE MACRO DEFINITOON PROCESSOR 16548000 + B *+4(RB) TAKE INDEXED BRANCH ACCORDINGLY 16549000 + B MOSTINIT NORMAL RETURN - GO BACK FOR NEXT CRD 16549500 + B MOSTINIV NO, PROB AIF-AGO - CARD ALREADY EXIS 16550000 + B MOPUT ERROR ALREADY FLAGGED, GO TO SAVE 16550010 +.MONSM ANOP 16552000 + SPACE 1 16554000 +MOCMSYSC EQU * COME HWERE FOR ALL COMMENT CARDS 16554500 + AIF (NOT &$MACSLB).MONSYS1 SKIP IF NO MACRO LIBRARY 16554600 + CLC RSBSOURC+1(6),=C'SYSLIB' WAS THIS *SYSLIB CARD 16554700 + BE MOCOMSYS GO TO CHECK AND PROCESS IT 16554800 +.MONSYS1 ANOP 16554900 + AIF (NOT &$XREF).NOXRF12 A 16554905 +* CHECK FOR *XREF CARD A 16554910 + CLC RSBSOURC+1(4),=C'XREF' IS IT XERF A 16554920 + BNE MOUTOUCK NO GO ON A 16554930 + LA RA,RSBSOURC+5 FOR ENTRY TO XRSCAN (@ TO BEGIN) L 16554935 + SR RD,RD CLEAR FOR PROPER ENTRY CONT L 16554940 + $CALL XRSCAN CALL SCANNING ROUTINE A 16554950 +.NOXRF12 ANOP A 16554960 + SPACE 1 16555000 +* BRANCH HERE TO DETERMINE WTHER STMT SHOULD BE SAVED VIA 16555100 +* UTPUT1, OR PRINTED IMMEDIATELY AS A COMMENT TYPE. 16555200 +MOUTOUCK TM AVPRINT1,AVPRSAVE MUST WE SAVE THE CARD 16555300 + BO MOPUT YES, SO GO DO IT 16555400 +MOOUCOMM LA RB,$OUCOMM SHOW COMMENT TYPE ( NO LC CTR) 16555500 + B MOIBOUTA GO TO PUT IT OUT TO LISTING 16555600 +* ASSEMBLER INSTRUCTIONS * 16556000 +MOCALLIB EQU * PROCESSING FOR ASSEMBLER OPS FOLLOWS 16556030 + AIF (NOT &$MACOPC).MOIBA SKIP ID NO OPEN CODE J 16556035 + BAL R14,MOOPAMPC GO CHECK FOR SUBSTITUTE OF EVAR J 16556040 +.MOIBA ANOP J 16556045 + $CALL IBASM1 CALL ASSEMBLER OPS PROCESSOR 16556060 + USING RCODBLK,RC IBASM1 RETURNED PTR TO BLK IN RC 16556090 + L RX,AVLABPT RELOAD PTR: IF EQU, MAY NOW BE = 0 16556120 + TM RCHEX,IBMOSPEC+IBMOPRCT WAS SPECIAL OF ANY KIND 16556150 + BZ MOCALLXX NO, SO SKIP TO COMPLETE PROCESSING 16556180 +* FALL THRU ==> SOME SPECIAL KIND OF HANDLING NEEDED. 16556210 + BM MOCASEND AT PRSENT, THIS COND ==> END CARD-B 16556240 + SPACE 2 16556270 +* SPECIAL HANDLING: BYPASS PASS 2 PROCESSING. * 16556300 +* DURING PASS 1, IT IS POSSIBLE TO PROCESS A STMT COMPLETELY, * 16556330 +* INCLUDING PRINTING IT, UNTIL ANY STMT EXCEPT ONE OF THE FOLLOWING * 16556360 +* IS FOUND IN THE INPUT STREAM: * 16556390 +* COMMENT CARD, PRINT, SPACE, EJECT, TITLE. * 16556420 +* MACRO DEFINITIONS, GBL OR LCL IN OPEN CODE. * 16556450 +* THESE STMTS CAN BE COMPLETELY PROCESSED, THUS SAVING SPACE * 16556480 +* AND TIME. THE SECTIONS OF CODE BELOW HANDLE THIS. * 16556510 + SPACE 1 16556540 + TM AVPRINT1,AVPRSAVE MUST WE SAVE RATHER THAN FINISH 16556570 + BO MOCALLXY YES, BRANCH, MUST SAVE IT 16556600 + SPACE 1 16556630 +* PROCESS PRINT CONTROL STMTS: SEE CORRESPOND IDASM2 CODE. 16556660 +* NOTE: SOME ERROS IN PRINT WILL CAUSE PRINT ON,NOGEN. 16556690 + CLI RCTYPE,$IB+$ITITLE IS THIS ACTUALLY TITLE STMT 16556780 + BNE MOIBPR1 NO, BRANCH FOR NEXT CHECK 16556810 + SR RB,RB YES, WAS TITLE; CLEAR FOR INSERT CP 16556840 + IC RB,RCMASK GET LENGTH-1 OF TITLE CPP 16556870 + $SCPT RA,RSBSCAN GET SCAN POINTER BACK CPP 16556930 + AR RA,R5 (R5=1) RA=>1ST BYTE TITLE CPP 16556960 + $CALL CCCON2 ASSEMBLE AS IF C-TYPE CONST. CPP 16556965 +* RETURNS: RC=> ASSEMBLED TITLE, RD=LEN-1 OF TITLE CPP 16556970 + LA RE,4 SHOW THIS WAS A TITLE CPP 16556975 + B MOIBOUTL BRANCH TO PRINT OR STORE TITLE CPP 16556980 + SPACE 1 16556990 +MOIBPR1 CLI RCTYPE,$IB+$IPRINT WAS IT ACTUALLY PRINT STMT 16557020 + LA RC,RCMASK @ CONTROL BYTE(PRINT,SPACE,EJECT) 16557050 + LA RE,2 SHOW THIS WAS A PRINT STMT. CPP 16557070 + BE MOIBOUTL WAS PRINT; ALL REGS SET, PRINT CPP 16557080 + SR RE,RE FALL THRU==> SPACE OR EJCT, RESET =0 16558000 +MOIBOUTL LA RB,$OULIST SHOW THIS WAS A LISTING CTRL CPP 16559000 + SPACE 1 16560000 +* IMMEDIATE PRINT CONTROL: CALL PRINT ROUTINE. 16562000 +MOIBOUTA $CALL OUTPT2 REGS RB,RC,RD,RE ALREADY SET UP 16564000 + B MOSTINIT GO BACK, PICK UP NEXT STMT 16566000 + SPACE 1 16568000 +MOCASEND EQU * COME HERE FOR END CARD 16570000 + MVI MOBACK+1,0 MAKE BRANCH A NOOP SO WE FALL THROUG 16572000 + B MOCALLXX GO CALL ROUTINE 16574000 + DROP RC NOTE NO LONGER USING RC BLOCK 16576000 + SPACE 1 16578000 +* MACHINE OPCODES * 16580000 +MOCALLIA EQU * COME HERE FOR MACHINE OPS J 16581000 + AIF (NOT &$MACOPC).MOIAA J 16581500 + BAL R14,MOOPAMPC GO CHECK FOR SUBSTITUTEION OF &VAR J 16582000 +.MOIAA ANOP J 16582500 + $CALL IAMOP1 CALL MACHINE OP PROCESSOR J 16583000 + EJECT 16584000 +* CALL THE 2ND LEVEL PROCESSOR ROUTINE REQUIRED. * 16586000 +MOCALLXX EQU * 16588000 +MOCALLXY EQU * SKIP HERE IF AVPRINT1 SET ALREADY 16589000 + USING RCODBLK,RC RC--> RCB OF 2ND LEVEL ROUTINE 16590000 + SPACE 1 16591000 +* FINISH CREATION OF RCODBLK,ADDING LOC.COUNTER VALUE. 16591500 + OI RSBFLAG,$RCBX NOTE THAT AN RCB EXISTS NOW 16592000 + $GLOC RE GET LOCATION COUNTER 16594000 + MVC RCLOC,AVLOCNTR+1 MOVE THE LOCATION COUNTER IN 16596000 + SPACE 1 16597000 +* DEFINE STMT LABEL, IF ANY, IF NOT ALREADY DEFINED. 16597500 + LTR RX,RX IS THERE A LABEL ON STATMENT 16598000 + BZ MONOLB2 NO,SKIP DEFINING IT 16600000 + TM SYFLAGS,$SYDEF HAS THIS BEEN DEFINED YET 16602000 + BO MONOLB2 YES,DON'T REDEFINE IF ALREADY 16604000 + IC R14,AVCESDID GET ESDID 16606000 + IC RB,RCLQ GET LENGTH ATTRIBUTE 16608000 + $SDEF RE,R14,RB DEFINE THE SYMBOL 16610000 + SPACE 1 16611000 +* INCREMENT LOCATION COUNTER BY LENGTH OF THIS STMT. 16611500 +MONOLB2 AR RE,RD ADD INCREMENT TO LOCATION COUNTER 16612000 + $SLOC RE 16614000 + ST RC,AVRCBPT SAVE ADDR OF RCB 16616000 + AIF (&$DEBUG).MONOXS SKIP IF PRODUCION 16618000 + XSNAP STORAGE=(*0(RC),*12(RC),*AVLOCNTR,*AVDWORK1-1),T=NO, #16620000 + IF=(AVDEBUG,O,X'88',TM) 16622000 +.MONOXS ANOP 16624000 + SPACE 1 16630000 +MOPUT $CALL UTPUT1 OUTPUT THE EXPANDED RECORDS 16632000 +MOBACK BC $CHN,MOSTINIT B MOSTINIT UNTIL END-BECOMES NOOP 16634000 + SPACE 1 16635000 +MORET $RETURN RGS=(R14-R6) 16636000 + EJECT 16638000 +**--> ENTRY: MOSTOP CALLED IF DISASTROUS ERROR OCCURS IN PASS 1 . . 16638500 +*. RESTORES CONDITIONS FOR MOCON1, NOTE OVERFLOW OCCURRENCE. . 16639000 +*. ENDS EXECUTION FOR PASS 1, FLAGGING PROGRAM NONEXECUTABLE. . 16639500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16641500 + USING MOSTOP,REP NOTE TEMPORARY USING 16642000 +MOSTOP L R13,=A(MOCOSAVE) GET @ SAVE AREA,BAS REG 16644000 + DROP REP KILL TEMPORARY USING,BACK TO NORMAL 16646000 + OI AVTAGS3,AVOVERFL SHOW OVERFLOW OCCURRED. 16652000 + B MORET RETURN TO MAIN CONTROL 16654000 + AIF (NOT &$MACOPC).MOAMP1 J 16654100 + SPACE 1 J 16654110 +**--> INSUB: MOOPAMPC CHECK STATEMENT FOR SET VARIABLE SUBSTITUTION *J 16654120 +*+ ENTRY CONDITIONS: +J 16654130 +*+ RA= @ OPERAND FIELD / UNCHENGED ON EXP +J 16654140 +*+ R14 = RETURN ADDRESS +J 16654150 +*+ EXIT CONDITIONS +J 16654160 +*+ RETURN IF NO POSSIBLE SUBSTITUTION +J 16654170 +*+ -->MOCALLMC IF SUBSTITUTION POSSIBLE +J 16654180 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +J 16654190 +MOOPAMPC TM AVMTAG00,AVMOPENC HAVE SET VARS FOUND ALRESDY J 16654200 + BCR Z,RET NO, NO SUBSTITUTION POSSIBLE J 16654210 + TM RSBFLAG,$RSBGENR GENERATE STATMENT J 16654220 + BCR O,RET YES, CAN'T SUBSTITUTE AGAIN J 16654230 + IC R2,RSBLENG GET LENGTH-1 OF WHOLE STMT J 16654240 + SH R2,=AL2(RSB$L) GET LENGTH-1 OF STMT J 16654250 + STC R2,MOOPAMPT+1 PUT L-1 INTO TRT J 16654260 + $SETRT ('&&',4) FLAG TO STOP ONE J 16654270 +MOOPAMPT TRT RSBSOURC($),AWTZTAB SCAN FOR & J 16654280 + $SETRT ('&&',0) REZERO J 16654290 + BCR Z,RET NO SUBSTITUTION-RET J 16654300 + LA RC,AWZEROS SHOW @ ZEROS: MACRO WANTS THIS J 16654310 + B MOCALLMC GO TO CALL MACRO1 TO SCAN J 1665432- +.MOAMP1 ANOP J 16654330 + SPACE 1 16656000 +* * * * * OUT-OF-LINE ERROR PROCESSING SECTIONS * * * * * * * * * * * * 16657000 + SPACE 2 16657500 +* ERROR IN LABEL - FLAG, MOVE SCAN PTR TO 1ST BLANK. 16658000 + SPACE 1 16658100 +MOLABR2 EQU * 16658200 + AIF (NOT &$MACOPC).MOLABR J 16658300 +* IF MACROS MAY BE PRESENT, CHECK FOR SEQUENCE SYMBOL. 16658400 + TM AVTAGSM,AJOMACRO ARE WE IN MACRO RUN A 16658500 + BZ MOLABR2B NO, SO ERROR FOR SURE 16658600 + TRT RSBSOURC+1(8),AWTSYMT SCAN SYMBOL 16659400 + BZ MOLABR1 TOO LONG, ERROR 16659500 + CLI 0(R1),C' ' TERMINATE PROPERLY 16659600 + BNE MOLABR2B NO ERROR FLAG IT J 16659610 + TM RSBFLAG,$RSBGENR WAS IT GENERATED J 16659620 + BO MOLABGO YES,SO IGNOR LABEL J 16659630 + CLI 0(RA),C'&&' SET VARIABLE J 16659640 + BE MOLABGO YES,CONTINUE J 16659650 + CLI 0(RA),C'.' SEQUENCE SYMBOL? A 16659660 + BNE MOLABR2B NO ERROR J 16659670 + CLI 1(RA),C'0' CHECK FOR LEGALITY J 16659680 + BNL MOLABR2B BAD-1ST CHAR IS DIGIT J 16659690 +* LEGAL SET SYMBOL-PLACE IT IN SYMBOL TABLE J 16659700 + LR RB,R1 @ TERMINATOR BLANK J 16659710 + SR RB,RA GET LENGTH J 16659720 + $CALL SYENT1 HAVE SYMBOL LOOKED UP J 16659730 + USING SYMSECT,RA NOT PTR J 16659740 + TM SYFLAGS,$SYDEF YES ERROR J 16659750 + BO MOLABMUL YES ERROR J 16659760 + OI SYFLAGS,$SYDEF SHOW DEFINED NOW J 16659770 + B MOLABGO CONTINUE AS USUAL J 16659780 + DROP RA ZAP USING J 16659790 + SPACE 1 16659800 +* DEFINITE ILLEGAL LABEL FIELD. 16659900 +.MOLABR ANOP 16660000 +MOLABR2B LR RA,R1 INVALID CHARACTER, SHOW SCAN PTR 16661000 +MOLABR1 LA RB,$ERINVSY INVALID SYMBOL 16662000 + $CALL ERRTAG FALG IT 16664000 +MOLABLP CLI 0(RA),C' ' SEARCH FOR BLANK 16666000 + BE MOOPC FOUND BLANK AFTER SYMBOL-BRANCH 16668000 + BXH RA,R5,MOLABLP BUMP SCAN POINTER AND CONTINUE 16670000 + SPACE 1 16680000 +* MISSING OPERATION CODE ERROR. 16681000 +MOOPNONE LA RA,RSBSOURC+9 POINT WHERE OPCODE SHOULD BE 16682000 + LA RB,$ERIVOPC OMITTED OPCODE 16684000 + B MOERRORA GO HAVE IT FLAGGED 16686000 + SPACE 1 16688000 +MOMACHK EQU * DEFINE LABEL, EITHER MACRO CHECK, ER 16690000 + AIF (NOT &$MACROS).MONMAC SKIP IF NO MACROS 16692000 +* THIS CODE ENTERED IF UNRECOGNIZED OPCODE. AT THIS PT, 16692100 +* RB = $ERIVOPC, SET BY OPFIND. MAKE SURE STMT WAS NOT 16692200 +* ALREADY A GENERATED ONE. CALL MEXPND TO SEE IF MACRO. 16692300 + TM AVTAGSM,AJOMACRO ARE WE IN MACRO MODE 16692350 + BZ MOERRORA NO, FLAG AS UNDEFINED OPCODE 16692360 + BAL R14,MOOPAMPC CHECK FOR SUBSTITUTION OF &VAR S 16692400 + $CALL MEXPND CALL TO EXPAND MACROS 16694000 +*********CODE MAY BE REQUIRED TO SHOW WE ARE IN EXPANSION MODE * 16696000 + LTR RB,RB WAS THE MACRO KNOWN 16698000 + BZ MOSTINIT OK,BRANCH IF OS 16700000 +.MONMAC ANOP 16702000 + SPACE 1 16703000 +* GENERAL 1-STMT UNRECOVERABLE ERROR SECTION. 16703500 +MOERRORA $CALL ERRTAG HAVE ERROR FLAGGED 16704000 + B MOUTOUCK GO TO CHK PRINT/SAVE OPTION 16706000 + SPACE 1 16707000 + EJECT 16707030 + AIF (NOT &$MACSLB).MONOMC2 16707035 +* . . . . MOCOMSYS SECTION . . . . . . . . . . . . . . . . . . . . . 16707040 +* . 16707045 +* THIS SECTION OF MOCON1 IS CALLED WHENEVER A '*SYSLIB CARD . 16707050 +* HAS BEEN FOUND. IT COORDINATES THE ACTIVITIES OF MACRO . 16707055 +* LIBRARY PROCESSING AND THE MACRO PROCESSOR . 16707060 +* . 16707065 +* ENTRY CONDITIONS: . 16707070 +* REGISTER RA --> SCAN POINTER TO SYSLIB CARD . 16707075 +* . 16707080 +* EXIT CONDITIONS: . 16707085 +* REGISTERS UNCHANGED . 16707090 +* . 16707095 +* USES MACROS: . 16707100 +* $CALL, $ALLOCL . 16707105 +* . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16707110 + SPACE 2 16707115 +MOCOMSYS STM RA,RE,MOCOMSVE SAVE CONDITION OF WORK REGISTERS 16707120 + MVC MOCPRTSV,AVPRINT SAVE CURRENT PRINT STATUS 16707125 + TM AVTAGSM,AJOMACRO RETURN IF MACRO DISENABLED 16707130 + BZ MOUTOUCK NOT MACRO MODE GO TO PRINT CARD 16707135 + TM AVPRINT1,AVPRSAVE IS SYSLIB CARD IN LEGAL POSITION 16707140 + BO MOCLBER1 IN ERROR--GO THERE TO FINISH 16707145 + AIF (NOT &$MACOPC).MOMXX1 SKIP IF NO OPEN CODE 16707150 + TM AVMTAG00,AVMOPENC HAVE GBLX, LCLX BEEN FOUND 16707155 + BO MOCLBER1 YES, ERROR - FLAG IT 16707160 +.MOMXX1 ANOP 16707165 + LA RA,7(RA) SYSLIB LEGAL-INCREMENT POINTER PAST 16707170 +* SYSLIB TO THE FOLLOWING BLANK 16707175 + SPACE 1 16707180 +* SCAN AND SKIP BLANKS TILL FIRXT SYMBOL OF NAME FOUND 16707185 +MOCBLNK CLI 0(RA),C' ' IS THIS A BLANK 16707190 + BNE MOCLBSC NO BRANCH OUT TO CONTINUE 16707195 + BXH RA,R5,MOCBLNK BUMP SCAN POINTER AND CONTINUE 16707200 + SPACE 1 16707205 +MOCBUMP LA RA,1(R1) KICK PAST A LEGAL DELIMITER 16707210 +MOCLBSC LR R1,RA MOVE POINTER OVER FOR ERROR FLUSH 16707215 + C RA,AVSOLAST IS SYSLIB CARD BLANK 16707220 + BNL MOCNLSYS YES--> SO SKIP NAME SCAN CODE 16707225 + CLI 0(RA),C'0' DOES NAME START WITH LEGAL CHARACTE 16707230 + BNL MOCLBER2 NOT LEGAL STARTING CHARACTER 16707235 + TRT 0(9,RA),AWTSYMT SCAN THE NAME 16707240 + BZ MOCLBER2 NAME TOO LONG--ERROR 16707245 + LR RB,R1 MOVE BLANK POINTER OVER 16707250 + SR RB,RA GET LENGTH OF NAME 16707255 + SR RB,R5 DECREMENT FOR LENGTH-1 OF NAME 16707260 + MVC AVMSYMBL,AWBLANK BLANK OUT SEARCH AREA 16707265 + EX RB,MOCMVEL MOVE NAME INTO SEARCH AREA 16707270 + L RC,AVMACLIB SET UP TO SEARCH LIST WITH MACFND 16707275 + BAL RD,MOCLOOK SEARCH LIST FOR NEW NAME 16707280 + LTR RB,RB SET CC ON RETURNED MAGNITUDE OF RB 16707285 + BNZ MOCNMADD NOT FOUND- PUT NAME IN THE LIST 16707290 +MOCNAMNT CLI 0(R1),C',' IF LEGAL NAME DELIMITER LOOP FOR ALL 16707295 +* NAMES 16707300 + BE MOCBUMP LOOP FOR ALL NAMES 16707305 + CLI 0(R1),C' ' IS SCAN CHARACTER A BLANK 16707310 + BNE MOCLBER3 NOT BLANK OR COMMA--ERROR INVALID 16707315 +* DELIMITER 16707320 +MOCNLSYS LA RB,$OUCOMM SET TO PRINT A COMMNNT 16707325 + $CALL OUTPT2 PRINT STATEMENT AND ANY ERRORS 16707330 + L RC,AVMACLIB GET BEGIN ADDRESS OF MACRO LIST M 16707331 + USING MACLIB,RC NOTE USING ON MACRO LIST DSECT M 16707332 + SR RB,RB ZERO FOR SEARCH END LIST M 16707333 + CL RB,MCLIBNXT IF LIST HEADER IS NULL M 16707334 + BE MOCLBOUT THEN NO OPEN - JUST QUIT M 16707335 + DROP RC CLEAR USING M 16707336 + XCALL XXXXLBOP CALL TO OPEN LIBRARY DCB M 16707337 + BM MOCLBER4 NO--SET UP ERROR 16707340 + SPACE 2 16707345 + TM AVTAGSM,AJOLIBMC SHOULD WE PRINT MACRO DEFINITIONS 16707350 + BO *+8 NO -- PROCESS NORMALLY 16707355 + NI AVPRINT,255-$IBPON TURN PRINT STATUS OFF 16707360 + SPACE 1 16707365 +MOCLBMOR L RC,AVMACLIB GET BEGIN ADDRESS OF MACRO LIST 16707370 + USING MACLIB,RC NOTE USING ON MACRO LIST DSECT 16707375 + SR RB,RB ZERO FOR SEARCH END TEST 16707380 + CL RB,MCLIBNXT IF LIST HEADER IS NULL 16707385 + BE MOCLBOUT THEN NOTHING TO DO -- GO HOME 16707390 + L RC,MCLIBNXT ELSE START LIST SCAN 16707395 + B MOCLBFD2 SKIP TO LOOK AT FIRST ENTRY 16707400 +MOCLBFD1 L RC,MCLIBNXT GET @ OF NEXT ENTRY 16707405 +MOCLBFD2 TM MCLBTAGS,AVMCLBDF PREVIOUSLY DEFINED? 16707410 + BO MOCLBFD5 DEFINED -- GO LOOK AT NEXT ENTRY 16707415 + TM MCLBTAGS,AVMCLBNF PREVIOUSLY SEARCHED FOR 16707420 + BNO MOCLBFND N/- GO DO FIND AND MACRO DEFINITION 16707425 +MOCLBFD5 CL RB,MCLIBNXT IS THIS FINAL ENTRY 16707430 + BNE MOCLBFD1 NO--LOOK AT NEXT 16707435 + SPACE 5 16707440 +MOCLBSP XCALL XXXXLBED CALL LIBRARY ENDUP ROUTINE 16707445 + L RC,AVMACLIB GET BEGIN @ OF MACRO LIST 16707450 + SR RB,RB ZERO FOR SEARCH EBD TEST 16707455 + B MOCLBFD4 SKIP TO LOOK AT FIRST ENTRY 16707460 +MOCLBFD3 L RC,MCLIBNXT GET @ OF NECT ENTRY 16707465 +MOCLBFD4 TM MCLBTAGS,AVMCLBDF HAS THIS MACRO BEEN DEFINED 16707470 + BO MOCLBMR1 DEFINED -- SKIP ERROR SET 16707475 + MVC MOCER7MS+10(8),MCLBNAM MOVE BAD NAME INTO MESS 16707480 + BAL RE,MOCLBER7 GO TO MARK NAME AS ERROR 16707485 +MOCLBMR1 CL RB,MCLIBNXT IS THIS FINAL ENTRY 16707490 + BNE MOCLBFD3 NO--CONTINUE SEARCH 16707495 + SPACE 2 16707500 +MOCLBOUT MVC AVPRINT,MOCPRTSV RESTORE THE PRINT STATUS 16707505 + LM RA,RE,MOCOMSVE RESTORE REGISTER TO PREVIOUS CONDIT 16707510 + SPACE 2 16707515 + B MOSTINIT RETURN FOR NEXT SOURCE CARD 16707520 + SPACE 2 16707525 +MOCLBFND MVC AVMSYMBL,MCLBNAM MOVE NAME INTO WORK AREA FOR FIND 16707530 + OI MCLBTAGS,AVMCLBNF MARK NAME AS SEARCHED FOR 16707535 + XCALL XXXXFIND CALL FIND ROUTINE 16707540 + BM MOCLBMOR ERROR NOT FOUND -- MESSAGE WILL 16707545 +* COME OUT LATER 16707550 + DROP RC KILL USING 16707555 +MOCLIBNI $CALL INCARD CALL INCARD TO READ FROM MACRO 16707560 +* LIBRARY 16707565 + LTR RB,RB TEST MAGNITUDE OF RETURN REGISTER 16707570 + BNZ MOCLBER5 ERROR ON NON-ZERO VALUE 16707575 + LA RC,MOCMAC GET OPCODTB ENTRY FOR MACRO 16707580 + $CALL MACRO1 START MACRO DEFINITION PHASE 16707585 + B MOCLBMOR GO BACK TO PICK UP REST OF NAMES 16707590 + SPACE 2 16707595 +* ERROR ROUTINES FOLLOW 16707600 + SPACE 2 16707605 +MOCLBER1 LA RB,$ERSTMNA SET ERROR-SYSLIB OUT OF ORDER 16707610 + $CALL ERRTAG CALL TO SET ERROR FLAG BIT 16707615 + $CALL UTPUT1 SEND ILLEGAL CARD OUT 16707620 + B MOCLBOUT RETURN 16707625 + SPACE 2 16707630 +MOCLBER2 BAL RB,MOCERALL GO FOR COMMON ERROR CODE 16707635 + DC AL2($ERINVSY) DEFINE ERROR--INVALID SYMBOL 16707640 + SPACE 2 16707645 +MOCLBER3 BAL RB,MOCERALL GO FOR COMMON ERROR CODE 16707650 + DC AL2($ERINVDM) DEFINE ERROR--INVALID DELIMITER 16707655 + SPACE 2 16707660 +MOCLBER4 MVC RSBLENG(RSB$L+MOCER4LN+1),MOCER4ST MOVE ERROR IN 16707665 + LA RB,$OUCOMM SET COMMENT FLAG A 16707667 + $CALL OUTPT2 PRINT ALLREADY DEFINED ERROR 16707670 + B MOCLBOUT RETURN 16707675 + SPACE 2 16707680 +MOCLBER5 $CALL ERRTAG SET ERROR BIT-DEFINED BY INCARD 16707685 + B MOCCOM GO FOR COMMON RETURN CODE 16707690 + SPACE 2 16707695 +MOCLBER7 MVC RSBLENG(RSB$L+MOCER7LN+1),MOCER7ST MOVE THE ERROR IN 16707700 +MOCCOM LA RB,$OUCOMM SET TO PRINT A COMMENT 16707705 + $CALL OUTPT2 PRINT THE MESSAGE 16707710 + SR RB,RB ER-ZERO RG TO CONTINUE 16707715 + BR RE RETURN TO CALLER 16707720 +MOCERALL LH RB,0(,RB) GET THE ERROR FLAG FOR ERRTAG 16707725 + LR RA,R1 MOVE BAD CHAR POINTER OVER 16707730 + $CALL ERRTAG CALL TO SET ERROR BIT 16707735 + B MOCNLSYS ON BAD CHAR -- PROCESS WHAT THERE 16707740 +* IS UP TO THIS POINT 16707745 + SPACE 5 16707750 + USING MACLIB,RC NOTE USING ON MACRO LIST 16707755 +MOCLOOK SR RB,RB ZERO WORK REG FOR END TEST 16707760 + B MOCLOOK2 SKIP FIRST LINK JUMP 16707765 +MOCLOOK1 L RC,MCLIBNXT LINK TO NEXT ENTRY 16707770 +MOCLOOK2 CLC AVMSYMBL,MCLBNAM IS THIS THE ONE WE ARE LOOKING FOR 16707775 + BE MOCLKRT YESYES -- GO BACK TO PRCESS 16707780 + CL RB,MCLIBNXT IS THIS THE LAST ENTRY 16707785 + BNE MOCLOOK1 NO -- LINK TO THE NEXT ENTRY 16707790 + LA RB,$ERUNDEF NAME NOT IN LIST INDICATE THIS 16707795 +MOCLKRT BR RD RETURN TO CONTINUE 16707800 + SPACE 2 16707805 +MOCNMADD LA RE,$LMACLIB GET LIST ENTRY LENGTH 16707810 + $ALLOCL RB,RE,MOCLBOUT GET LIST SPACE 16707815 + ST RB,MCLIBNXT LINK LIST TO NEW ENTRY 16707820 + DROP RC CLEAR USING 16707825 + USING MACLIB,RB NOTE USING ON MACLIB DSECT 16707830 + MVC MACLIB($LMACLIB),AWZEROS ZERO NEW ENTRY 16707835 + MVC MCLBNAM,AVMSYMBL MOVE NAME INTO LIST 16707840 + DROP RB KILL USING 16707845 + SR RB,RB REZERO REGISTER TO CONTINUE 16707850 + B MOCNAMNT CONTINUE SCAN FOR NEW NAMES 16707855 + SPACE 2 16707860 +MOCOMSVE DS 5F TEMP REGISTER SAVE AREA 16707865 +MOCPRTSV DS C SAVE BYTE FOR PRINT STATUS 16707870 +MOCMVEL MVC AVMSYMBL($),0(RA) VARIABLE LENGTH NAME MOVE 16707875 +MOCMAC DC AL1($IM,$MACRO,0) SEE OPG CALL TO MACRO 16707880 +MOCER4ST DC AL1(RSB$L+MOCER4LN,$RSBMERR,1,0) DEFINE THIS ERROR 16707885 +MOCER4MS DC C'289 UNABLE TO OPEN MACRO LIBRARY: OPTION CANCELED' 16707890 +MOCER4LN EQU *-MOCER4MS LENGTH OF THE MESSAGE 16707895 +MOCER7ST DC AL1(RSB$L+MOCER7LN,$RSBMERR,1,0) DEFINE THIS ERROR 16707900 +MOCER7MS DC C'288 MACRO COULD NOT BE FOUND' 16707905 +MOCER7LN EQU *-MOCER7MS GET LENGTH OF THE MESSAGE 16707910 +.MONOMC2 ANOP 16707915 + LTORG 16708000 + DROP RAT,R13,RW,RX CLEAN UP USINGS 16710000 + TITLE '*** MPCON0 - ASSIST ASSEMBLER MAIN CONTROL PROGRAM ***' 16712000 +**--> CSECT: MPCON0 0 MAIN PROGRAM CONTROL-INIT,SET UP TABLES,ETC.. 16714000 +*. MPCON0 INITIALIZES AVWXTABL DSECT VALUES FOR WHOLE ASSEMBLY, . 16714100 +*. SETS A $SPIE TO INTERCEPT SOME TYPES OF INTERRUPTS, SETS THE . 16714200 +*. PROGRAM AMSK TO ONLY HAVE FIXED-OVERFLOW INTRPTS, AND CALLS . 16714300 +*. ALL THE SUBROUTINES REQUIRED FOR AN ASSEMBLY IN A TABLE- . 16714400 +*. DRIVEN MANNER, USING A LIST OF POINTERS TO ADDRESS CONSTNATS.. 16714500 +*. AFTER THE ASSEMBLY IS COMPLETED, IT PRINTS VARIOUS STATISTICS. 16714600 +*. AND THEN RETURNS CONTROL TO THE ASSIST MONITOR. NOTE THAT . 16714700 +*. MPCON0 IS THE ONLY CSECT IN THE ASSEMBLER WHICH ACTUALLY . 16714800 +*. REFERS TO AJOBCON, ALTHOUGH OTHERS USE EQU FLAGS FROM IT. . 16714900 +*. ENTRY CONDITIONS . 16716000 +* R12(RAT)= @ VWXTABL CSECT, INITIALIZED BY ASSIST CONTROL PROG. . 16720500 +* AVAJOBPT,AVECONPT HAVE BEEN INITIALIZED IF NEEDED BY ASSIST. . 16721000 +*. CALLS ESINT1,LTINT1,OPINIT,SYINT1,UTINT1,OUINT1,MOCON1 . 16722000 +*. CALLS LTEND1,UTEND1,BRINIT,MTCON2 . 16724000 +*. CALLS OUEND2,SYEND2,UTEND2 . 16726000 +*. USES DSECTS: AVWXTABL . 16727000 +*. USES MACROS: $AL2, $CALL, $PRNT, $RETURN, $SAVE, $SPIE . 16727500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16728000 +MPCON0 CSECT 16730000 + $DBG ,NO 16732000 + $SAVE RGS=(R14-R12),BR=R13,SA=MPSAVE 16744000 + SPACE 1 16746000 +* INITIALIZATION FOR ASSEMBLY - OBTAIN VARIOUS VALUES * 16748000 +* FROM AJOBCON. ZERO FLAGS. SET SPIE,PROGRAM MASK. * 16750000 + SPACE 1 16752000 + USING AVWXTABL,RAT NOTE MAIN USING FROM NOW ON 16756000 + LM R2,R3,AVADDLOW GET ORIG CORE LIMITS FOR STATS LATER 16762000 + MVC AWZEROS+C' '(64),AWZEROS MAKE SURE ZERO(SEE SCANRS) 16763000 + MVC AVZAREA1(AVZAREA2-AVZAREA1),AWZEROS ZERO OUT AREA 16764000 + MVC AVRCBPT(7*4),AWZEROS ZERO AVRCBPT---AVSOLAST 16765000 +* REQUIRED FOR REPLACE, GOOD DEBUG 16765500 + NI AVTAGS1,255-$IBSTAR1-$IBDSEC1-$IBPRCD1 INIT VALUES 16766000 + NI AVTAGS2,255-$INEND2 CLEAR EOF FLAG 16768000 + SPACE 1 16770000 + $SPIE ,((7,15)),ACTION=CR,CE=MPSPIEXT GET CONTROL FOR ERRS 16772000 + ST R1,AVMPSPIE SAVE @ PREVIOUS SPIE CONTROL BLOCK 16773000 + L R0,=XL4'08000000' GET MASK FOR SPM (FIXED OVER ONLY) 16774000 + SPM R0 SET TO STOP ANY FP INTERRUPTS 16776000 + SPACE 1 16778000 +* SET UP VALUES FOR CALLS TO ALL SUBROUTINES * 16780000 + LA RZ,MPCALL1 INIT INDEX FOR BXLE CALL LOOP 16782000 + LA RX,2 INCREMENT FOR BXLE 16784000 + LA RY,MPCALL2-2 LIMIT ADDRESS FOR BXLE 16786000 + SPACE 1 16788000 +* FOLLOWING LOOP PERFORMS ENTIRE ASSEMBLY PROCESS. 16790000 +MPCALLR LH REP,0(,RZ) GET OFFSET @ FROM OFFSET LIST 16792000 + $CALL $BASE(REP) CALL THE RIGHT ROUTINE 16794000 + BXLE RZ,RX,MPCALLR LOOP THRU CALL LIST 16796000 + EJECT 16798000 +* IF 'STOP' BIT SET, FLAG NOLOAD ALSO 16799000 + TM AVTAGS2,AJOASTOP HAS STOP BIT BEEN SET FOR ANY REASON 16799100 + BZ *+8 NO, CONTINUE 16799200 + OI AVTAGS1,AJNLOAD SHOW NO LOAD CAN BE DONE 16799300 + SPACE 1 16799400 +* CONVERT AND PRINT STORAGE USAGE. NOTE THAT THIS CODE, * 16800000 +* MPCONV, AND DATA MPAT-MPHLEN ARE NOT REQUIRED FOR * 16802000 +* ACTUAL WORKING OF THE PROGRAM, AND COULD BE REMOVED. * 16804000 + LM R0,R1,AVADDLOW GET CURRENT FREE AREA POINTERS 16808000 + SPACE 1 16810000 + SR R3,R1 AJOTADH -AVADDHIH = HIGH CORE USED 16814000 + SR R0,R2 AVADDLOW-AJOTADL = LOW CORE USED 16816000 + LR R5,R0 SAVE TO CALCULATE TOTAL SPACE. 16818000 + S R1,AVADDLOW AVADDHIH-AVADDLOW = REMAINING AREA 16820000 + LA R2,MPARL @ FIRST AREA FOR LOW STORAGE 16822000 + BAL RZ,MPCONV HAVE LOW VALUE(R0) CONVERTED 16824000 + LA R2,MPARH ADDRESS OF HIGH AREA USED 16826000 + LR R0,R3 MOVE DIFFERENCE OVER WHERE EXPECTED 16828000 + SPACE 1 16830000 + BAL RZ,MPCONV CALL CONVERTER ROUTINE 16832000 + LA R2,MPREM @ REMAINING AREA TO BE PRINTED 16834000 + LR R0,R1 MOVE VALUE OVER FOR CONVERTER 16836000 + BAL RZ,MPCONV CALL CONVERTER 16838000 + SPACE 1 16840000 +* COMPUTE AVERGAE # BYTES PER STATEMENT USED. 16842000 + AR R5,R3 ADD HIGH USED (R5) TO LOW USED(R3) 16844000 + SR R4,R4 CLEAR SO DIVIDE WORKS OK 16846000 + LH R0,AVSTMTNO GET # STATEMENTS 16848000 + DR R4,R0 DIVIDE TO GET BYTES/STATEMENT 16850000 + LR R0,R5 MOVE QUOTIENT OVER 16852000 + LA R2,MPBYSTMT FOR # BYTES/STMT 16854000 + BAL RZ,MPCONV CALL CONVERTER 16856000 + SPACE 1 16858000 + $PRNT MPHEAD,MPHLEN PRINT THE ASSEMBLED LINE 16860000 + AIF (NOT &$XREF).NOXREF9 SKIP IF NO XREF A 16860100 + TM AVXRFLAG,AVXRON DO WE WANT A CROSS REFERENCE A 16860150 + BZ MPRETA NO SKIP CALL A 16860200 + $CALL XRPRNT CALL CROSS REF PRINT ROUTINE A 16860250 +.NOXREF9 ANOP A 16860300 +MPRETA EQU * 16862000 + L R1,AVMPSPIE GET @ PREVIOUS SPIE BLOCK BACK 16863000 + $SPIE ACTION=(RS,(1)) RESTORE PREVIOUS SPIE BLOCK 16863010 +MPRET $RETURN RGS=(R14-R12) 16864000 + EJECT 16868000 +* SPIE EXIT ROUTINE - FLAGS INTERRUPTS 0C7-0CF. * 16870000 + USING MPSPIEXT,R15 NOTE ENTRY PT AT SPIE 16872000 +MPSPIEXT STM R14,R12,12(R13) SAVE ALL THE REGS 16874000 + LA RB,$ERINTPT SHOW INTERRUPT MESSAGE 16876000 + $CALL ERRTAG CALL ERROR FLAGGING 16878000 + LM R14,R12,12(R13) RELOAD REGS 16880000 + BR R14 RETURN TO SUPERVISOR 16882000 + DROP R15 KILL TEMPORARY USING 16884000 + SPACE 1 16886000 + SPACE 2 16888000 +* * * * * MPCONV - CONVERT 1 ADDRESS DIFERENCE AND EDIT IT * 16890000 +* ENTRY CONDITIONS * 16892000 +* R0 = ADDRESS DIFFERENCE TO BE CONVERTED * 16894000 +* R2 = ADDRESS OF AREA WHERE EDITED VALUE TO BE PUT * 16896000 +* RZ = RETURN ADDRESS TO CALLING CODE * 16898000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 16900000 + SPACE 1 16902000 +MPCONV CVD R0,AVDWORK1 CONVERT DIFFERENCE TO DECIMAL 16904000 + MVC 0(L'MPAT,R2),MPAT MOVE THE PATTERN IN 16906000 + ED 0(L'MPAT,R2),AVDWORK1+8-L'MPAT/2 EDIT VALUE OVER 16908000 + BR RZ RETURN TO CALLER 16910000 + SPACE 1 16912000 +* * * * * INTERNAL CONSTANTS * 16914000 +* OFFSETS TO ADCONS FOR ROUTINES TO BE CALLED * 16916000 +MPCALL1 DS 0H 16918000 + $AL2 AX$BASE,(AXESINT1,AXLTINT1,AXOPINIT,AXSYINT1,AXUTINT1) 16920000 + AIF (NOT &$MACROS).MPNOMA1 SKIP IF NO MACRO MODS 16920200 + $AL2 AX$BASE,(AXMACINT) OPCODE INITIALIZATION 16920400 +.MPNOMA1 ANOP 16920600 + AIF (NOT &$XREF).NOXREF8 A 16920610 + $AL2 AX$BASE,(AXXRINT1) XREF INTIALIZATION PASS 1 A 16920620 +.NOXREF8 ANOP A 16920630 + $AL2 AX$BASE,(AXOUINT1,AXMOCON1) 16922000 +MPCALL1A $AL2 AX$BASE,(AXLTEND1,AXUTEND1,AXBRINIT) A 16924000 + AIF (NOT &$XREF).NOXRF70 SKIP IF NO XREF 16924100 + $AL2 AX$BASE,(AXXRINT2) XREF INITIALIZATION 2ND PASS 1 16924200 +.NOXRF70 ANOP 16924300 + $AL2 AX$BASE,(AXMTCON2) 16924400 + $AL2 AX$BASE,(AXOUEND2,AXSYEND2,AXUTEND2) 16926000 +MPCALL2 EQU * 16928000 + SPACE 1 16930000 +* STORAGE USAGE OUTPUT HEADING,EDIT PATTERN * 16932000 +MPAT DC X'4020202020202120' EDIT PATTERN FOR ADDRESSES 16934000 +MPHEAD DC C'0*** DYNAMIC CORE AREA USED: LOW:' 16936000 +MPARL DS CL(L'MPAT) FOR LOW AREA USAGE 16938000 + DC C' HIGH:' 16940000 +MPARH DS CL(L'MPAT) FOR HIGH AREA USAGE(SYMBOL TABLE) 16942000 + DC C' LEAVING:' 16944000 +MPREM DS CL(L'MPAT) FOR REMAINING STORAGE 16946000 + DC C' FREE BYTES. AVERAGE: ' 16948000 +MPBYSTMT DS CL(L'MPAT) FOR AVERAGE BYTES/STMT 16950000 + DC C' BYTES/STMT ***' 16952000 +MPHLEN EQU *-MPHEAD DEFINE LENGTH OF AREA 16954000 + LTORG 16956000 + DROP RAT,R13 CLEAR UP USING 16958000 + TITLE '*** MTCON2 - MAIN CONTROL - PASS 2 ***' 16960000 +**--> CSECT: MTCON2 2 MAIN CONTROL - ASSEMBLER PASS 2 . . . . . . . 16962000 +*. MTCON2 IS THE CONTROL PROGRAM FOR THE 2ND PASS OF THE ASSIST . 16962100 +*. OF THE ASSIST ASSEMBLER. IT IS RELATIVELY SMALL, SINCE . 16962200 +*. MOST OF THE WORK HAS BEEN DONE IN PASS 1. IT PERFORMS OR . 16962300 +*. SUPERVISES THE FOLLOWING ACTIONS, FOR EACH SOURCE STMT: . 16962400 +*. 1. RETRIEVES POINTERS TO THE RECORD BLOCKS (UTGET2). . 16962500 +*. 2. SETS UP THE LOCATION COUNTER AND OPERAND SCAN POINTER. . 16962600 +*. 3. CALLS 2ND LEVEL INSTRUCTION PROCESSORS(ICMOP2,IDASM2). . 16962700 +*. 4. PRINTS ANY STATEMENT WITH NO RCODBLK (OUTPT2). . 16962800 +*. FINISH BY ROUNDING UP LENGTH OF PROG TO DOUBLEWORD BOUNDARY. . 16963000 +*. CALLS ICMOP2,IDASM2,OUTPT2,UTGET2 . 16964000 +*. USES DSECTS: AVWXTABL,RCODBLK,RSBLOCK . 16965000 +*. USES MACROS: $CALL,$RETURN,$SAVE,$SLOC . 16965500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 16966000 +MTCON2 CSECT 16968000 + $DBG 90,* 16970000 + USING AVWXTABL,RAT NOTE MAIN USING 16972000 + $SAVE RGS=(R14-R6),SA=MTCOSAVE,BR=R13 16974000 + SR R2,R2 CLEAR FOR INSERTIONS 16976000 + MVI AVCESDID,2 INIT TO VALUE IN CASEE UNIT PRIV CD 16977000 + SPACE 1 16978000 +* MTGET2 ENTERED 1 TIME FOR EACH STATEMENT. CALLS UTGET2 * 16980000 +* TO GET @'S OF RECORD BLOCKS. @ RSBLOCK IS RETURNED IN RC, * 16982000 +* AND ALL EXISTING VALUES HAVE BEEN FILLED IN FOR RECORD PTRS. * 16984000 + SPACE 1 16985000 +MTGET2 EQU * ENTRY FOR LOOP HEAD FOR 1 STMT 16985100 +* IF 'STOP' BIT SET BY ANYONE, QUIT NOW. 16985200 + TM AVTAGS2,AJOASTOP HAS IT BEEN SET 16985300 + BO MTRET YES, QUIT 16985400 + SPACE 1 16985500 + $CALL UTGET2 CALL TO OBTAIN NEXT BLOCKS 16986000 + LTR RE,RE WAS THIS THE END 16988000 + BNZ MTENDOF YES,NO MORE TO DO-QUIT 16990000 + LR RE,RC MOVE @ RSBLOCK OVER 16992000 + USING RSBLOCK,RE NOTE POINTER 16994000 + TM RSBFLAG,$RCBX DOES A RCB EXIST 16996000 + BZ MTPRINT NO IT DOESN'T,EITHER ERROR OR COMM 16998000 + SPACE 1 17000000 +* GET INFORMATION FROM RCODBLK. SRT UP FOR LEVEL 2 SUBRS. 17002000 + L RC,AVRCBPT GET @ RCODBLK BACK INTO REG 17004000 + USING RCODBLK,RC NOTE THIS USING 17006000 + IC R2,RSBSCAN GET SCAN POINTER TO BEGINNING OF OPE 17008000 + LA RA,RSBLOCK(R2) GET @ OPERAND FIELD 17010000 + L RD,RCLOC-1 GET THE LOCATION COUNTER FOR STMT 17012000 + LA RD,0(RD) REMOVE 1ST BYTE 17014000 + $SLOC RD SET THE LOCATION COUNTER 17016000 + SPACE 1 17018000 +* CHOOSE CORRECT 2ND-LEVEL PROCESSOR. 17020000 + TM RCTYPE,$IB MAKE TYPE TEST 17022000 + BO MTCID BRANCH TO CALL ASSEMBLER ROUTINE 17024000 + AIF (NOT &$SPECIO).MTNOSPC SKIP IF NO SPECIALS 17026000 + BZ MTCID BRANCH IF ASSEMBLER INSTRUCTIONS 17028000 +* FALLS THRU ==> SPECIAL INST * 17030000 + IC R2,RCTYPE GET TYPE BYTE 17032000 + SLL R2,2 *4 FOR FULLWORD @ INDEXING 17034000 + $CALL SPECA2-4*$IS(R2) GET 2ND PASS SPECIAL ROUTINES 17036000 + B MTGET2 GO GET NEXT RECORD 17038000 +.MTNOSPC ANOP 17040000 +MTCIC $CALL ICMOP2 PASS 2 MACHINE INSTRUCTIONS 17042000 + B MTGET2 GO GET NEXT ONE 17044000 + SPACE 1 17046000 +MTCID $CALL IDASM2 ASSEMBLER INSTRUCTIONS 17048000 + B MTGET2 GO GET NEXT ONE 17050000 + SPACE 1 17052000 +MTPRINT LA RB,$OUCOMM SHOW OUTPT2 NO LOCCNTR OR CODE 17054000 + $CALL OUTPT2 CALL PRINTER ROUTINE 17056000 + AIF (NOT &$XREF).NOXRF13 A 17056005 +* CHECK FOR THE * XREF CARD A 17056100 + CLI RSBSOURC,C'*' IS IT A COMMENT CARD A 17056200 + BNE MTNXREFF NO, CAN'T BE * XREF CARD A 17056300 + CLC RSBSOURC+1(4),=C'XREF' IS IT XREF A 17056500 + BNE MTNXREFF NO, GO ON A 17056600 + LA RA,RSBSOURC+5 FOR ENTRY TO XRSCAN (@ TO BEGIN) L 17056625 + LA RD,8 SET ENTRY CONDITIONS TO XRSCAN L 17056650 + $CALL XRSCAN CALL SCANNING ROUTINE A 17056700 +MTNXREFF EQU * A 17056800 +.NOXRF13 ANOP A 17056900 + B MTGET2 GO GET NEXT ONE 17058000 +MTENDOF EQU * 17060000 +* ALIGN LENGTH OF PROG TO MULTIPLE OF 8. 17060100 + L R0,AVLOCHIH GET HIGHEST LOCATION COUNTER VALUE 17060200 + LA R1,7 GET VALUE FOR DOUBLEWORD ALIGN 17060300 + $ALIGR R0,R1 ALIGN UP TO DOUBLEWORD BOUNDARY 17060400 + ST R0,AVLOCHIH RESTORE UPDATED,ALIGNED VALUE 17060500 + S R0,AVLOCLOW LENGTH= HIGH LOCATION-LOW LOCATION 17061000 + A R0,AVRADL + LOWEST REAL LOCATION 17061100 + ST R0,AVRADH = HIGH LIMIT FOR REAL @'S 17061200 +MTRET $RETURN RGS=(R14-R6) 17062000 + DROP RAT,RC,RE,R13 CLEAR USINGS 17064000 + LTORG A 17064100 + TITLE '*** OPCOD1 - IDENTIFY MNEMONIC OPERATION CODES ***' 17066000 +**--> CSECT: OPCOD1 1 OPCODE TABLES AND LOOKUP CODE . . . . . . . . 17070000 +*. THIS MODULE CONTAINS THE CODE,TABLES TO IDENTIFY OPCODES. . 17070100 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 17072000 +OPCOD1 CSECT 17074000 + $DBG 90,* 17076000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 17078000 +OP1 EQU IAL2+1 COMMON MASK FIELD==>LIT ALLOWED,H AL 17080000 +OP3 EQU IAL2+3 MASK FIELD==>LIT ALLOWED, FULL ALIG 17082000 +OP7 EQU IAL2+7 MASK FIELD==>LIT ALLOWED,D ALIGN 17084000 +IAR EQU IAA+IAB MASK FIELD==>R1 AND R2 MUST BE EVEN 17085000 + ENTRY OPINIT,OPFIND 17086000 + SPACE 2 17088000 +**--> ENTRY: OPINIT 1 INITILIAZE OPCODE ROUTINE IF NEEDED . . . . . 17090000 +*. AS OF 8/17/70, THIS ENTRY DOES NOTHING. IT IS INCLUDED FOR . 17091000 +*. COMPLETENESS, POSSIBLE MODIFICATION REQUIRING INITIALIZATION.. 17091500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 17092000 +OPINIT BR R14 RETURN-NOTHING TO DO NOW 17094000 + SPACE 2 17096000 +**--> ENTRY: OPFIND 1 LOOK UP AN OPCODE . . . . . . . . . . . . . . 17098000 +*. ENTRY CONDITIONS . 17100000 +*. RA = SCAN POINTER TO 1ST CHARACTER OF OPCODE . 17102000 +*. EXIT CONDITIONS . 17104000 +*. RA = SCAN POINTER TO 1ST BLANK FOLLOWING LEGAL OPCODE,OR SAME AS O. 17106000 +*. ENTRY IF OPCODE WAS NOT RECOGNIZED. . 17108000 +*. RB = 0 IF THE OPCODE WAS FOUND IN OPCODE TABLE . 17110000 +*. RB = NONZERO VALUE - ERROR CODE FOR ILLEGAL OPCODE ($ERIVOPC) . 17112000 +*. RC = ADDRESS OF OPCODTB ENTRY FOR THE OPCODE, IF IT WAS FOUND . 17114000 +*. USES DSECTS: AVWXTABL,OPCODTB . 17115000 +*. USES MACROS: $RETURN,$SAVE,OPG,OPGT . 17115500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 17116000 +OPFIND $SAVE RGS=(R1-R2),SA=NO 17118000 + CLI 0(RA),C'A' MAKE SURE NO ILLEGAL 17120000 + BL OPFERR ILLEGAL,NOTE ERROR 17122000 + LR R1,RA DUPLICATE THE SCAN POINTER 17124000 + LA RE,6(R1) GET THE LIMIT FOR THE BXLE 17126000 + LA RD,1 GET INCREMENT FOR BXLE 17128000 + SPACE 1 17130000 +* SCAN LOOP TO FIND END OF MNEMONIC * 17132000 +OPFLOOP CLI 1(R1),C' ' LOOK FOR BLANK 17134000 + BE OPFLNG BLANK FOUND-END OF OPCODE 17136000 + BXLE R1,RD,OPFLOOP CONTINUE SEARCHING 17138000 + B OPFERR ERROR- NOT RIGHT SIZE 17140000 + SPACE 1 17142000 +* END OF MNEMONIC FOUND, GET POINTERS ET UP FOR LOOKUP * 17144000 +OPFLNG LR R2,R1 DUPLICATE PT TO LAST CHAR OF OPCODE 17146000 + SR R2,RA GET LENGTH-1 OF OPCODE = 0-7 17148000 + STC R2,OPFCOMP+1 PLACE INTO CLC INSTRUCTION 17150000 + LA RD,OPCMNEM-OPCODTB+1(R2) GET TOTAL LENGTH OF ENTRY 17152000 + IC R2,OPFL1(R2) GET 1ST OFFSET VALUE,DEPNDING ON LEN 17154000 + LTR R2,R2 MAKE SURE THERE ARE SOME OF THIS LEN 17156000 + BZ OPFERR NO THERE AREN'T-ERROR 17158000 + SPACE 1 17160000 + LA RE,OPADS(R2) ADDR OF RIGHT TABLE SET 17162000 + IC R2,0(RA) GET THE 1ST CHAR OF OPCODE 17164000 + IC R2,OPFCH1-C'A'(R2) GET 2ND OFFSET VALUE FOR LETTERS 17166000 + LH RC,0(R2,RE) GET THE CORRECT POINTER 17168000 + AR RC,R15 ADD ADDRESS OF OPFIND TO GET REAL AD 17170000 + USING OPCODTB,RC NOTE DSECT FOR TABLE ENTRY 17172000 + LH RE,2(R2,RE) GET THE LIMIT ADDRESS IN TABLE 17174000 + AR RE,R15 ADD TO GET REAL ADDRESS 17176000 + SPACE 1 17178000 +* SEARCH LOOP TO LOOK UP MNEMONIC * 17180000 +OPFCOMP CLC 0($CHN,RA),OPCMNEM COMPARE MNEMONIC WITH TABLE ENTRY 17182000 + BNH OPFCHK IF NOT HIGH, EITHER SAME, OR NO GOOD 17184000 + BXLE RC,RD,OPFCOMP CONTINUE LOOPING 17186000 +OPFCHK BNE OPFERR NE==>ERROR(GET LOOP FALL THRU TOO) 17188000 + SPACE 1 17190000 + SR RB,RB CLEAR RB TO SHOW OK. 17192000 + LA RA,1(R1) UPDATE SCAN POINTER TO BLANK 17194000 +OPFRET $RETURN RGS=(R1-R2),SA=NO 17196000 +OPFERR LA RB,$ERIVOPC INVALID OPCODE 17198000 + B OPFRET RETURN 17200000 + EJECT 17202000 +* * * * * INTERNAL CONSTANTS * 17204000 +* 1ST LEVEL POINTER TABLE-HAS OFFSET ADDRESSES OF POINTER SETS * 17206000 +* BELONGING TO EACH USABLE OPCODE LENGTH FROM 1 TO 8. * 17208000 +OPFL1 DC AL1(OPF1-OPADS,OPF2-OPADS,OPF3-OPADS,OPF4-OPADS,OPF5-OPA#17210000 + DS,OPF6-OPADS,OPF7-OPADS,OPF8-OPADS) 17212000 + SPACE 2 17214000 +* INDIVIDUAL OPCODTB ENTRY TABLES, IN ORDER BY LENGTH, THEN * 17216000 +* ALPHABETICALLY WITHIN LENGTH * 17218000 + SPACE 1 17220000 +* 1-CHARACTER INSTRUCTIONS * 17222000 +OP1A EQU * 17224000 + OPG A,$RX,90,OP3 ADD 17226000 +OP1B EQU * 17228000 + OPG B,$RXM,71,X'F0'+1 BRANCH 17230000 +OP1C EQU * 17232000 + OPG C,$RX,89,OP3 COMPARE 17234000 +OP1D EQU * 17236000 + OPG D,$RX,93,OP3+IAA DIVIDE 17238000 +OP1L EQU * 17240000 + OPG L,$RX,88,OP3 LOAD 17242000 +OP1M EQU * 17244000 + OPG M,$RX,92,OP3+IAA MULTIPLY 17246000 +OP1N EQU * 17248000 + OPG N,$RX,84,OP3 AND 17250000 + OPG O,$RX,86,OP3 OR 17252000 +OP1S EQU * 17254000 + OPG S,$RX,91,OP3 SUBTRACT 17256000 +OP1T EQU * 17258000 + OPG X,$RX,87,OP3 EXCLUSIVE OR 17260000 +OP1END EQU * 17262000 + EJECT 17264000 +* 2-CHARACTER INSTRUCTIONS * 17266000 +OP2A EQU * 17268000 + OPG AD,$RX,106,OP7+IAA,F ADD NORM LONG 17270000 + OPG AE,$RX,122,OP3+IAA,F ADD NORM SHORT 17272000 + OPG AH,$RX,74,OP1 ADD HALFWORD 17274000 + OPG AL,$RX,94,OP3 ADD LOGICAL 17276000 + OPG AP,$SS2,250,IAL2,D ADD DECIMAL 17278000 + OPG AR,$RR,26 ADD REGISTER 17280000 + OPG AU,$RX,126,OP3+IAA,F ADD UNNORM SHORT 17282000 + OPG AW,$RX,110,OP7+IAA,F ADD UNNORM LONG 17284000 +OP2B EQU * 17286000 + OPG BC,$RX,71,1 BRANCH ON CONDITION 17288000 + OPG BE,$RXM,71,X'80'+1 BRANCH ON EQUAL 17290000 + OPG BH,$RXM,71,X'20'+1 BRANCH ON HIGH 17292000 + OPG BL,$RXM,71,X'40'+1 BRANCH ON LOW 17294000 + OPG BM,$RXM,71,X'40'+1 BRANHC ON MINUS 17296000 + OPG BO,$RXM,71,X'10'+1 BRANCH ON ONES 17298000 + OPG BP,$RXM,71,X'20'+1 BRANCH ON PLUS 17300000 + OPG BR,$RRM,7,X'F0' BRANCH REGISTER 17302000 + OPG BZ,$RXM,71,X'80'+1 BRANCH ON ZERO 17304000 +OP2C EQU * 17306000 + OPG CD,$RX,105,OP7+IAA,F COMPARE LONG 17308000 + OPG CE,$RX,121,OP3+IAA,F COMPARE SHORT 17310000 + OPG CH,$RX,73,OP1 COMPARE HALFWORD 17312000 + OPG CL,$RX,85,OP3 COMPARE LOGICAL 17314000 + OPG CP,$SS2,249,IAL1+IAL2,D COMPARE DECIMAL 17316000 + OPG CR,$RR,25 COMPARE REGISTER 17318000 +OP2D EQU * 17320000 + OPG DC,$IDC+$IB,$IBSTAR1 DEFINE CONSTANT 17322000 + OPG DD,$RX,109,OP7+IAA,F DIVIDE LONG 17324000 + OPG DE,$RX,125,OP3+IAA,F DIVIDE SHORT 17326000 + OPG DP,$SS2,253,IAL2,D DIVIDE DECIMAL 17328000 + OPG DR,$RR,29,IAA DIVIDE REGISTER 17330000 + OPG DS,$IDS+$IB,$IBSTAR1 DEFINE STORAGE 17332000 + OPG ED,$SS,222,IAL2,D EDIT 17334000 + OPG EX,$RX,68,OP1 EXECUTE 17336000 + OPG IC,$RX,67,IAL2 INSERT CHARACTER 17338000 +OP2L EQU * 17340000 + OPG LA,$RX,65,IAL2 LOAD ADDRESS 17342000 + OPG LD,$RX,104,OP7+IAA,F LOAD LONG 17344000 + OPG LE,$RX,120,OP3+IAA,F LOAD SHORT 17346000 + OPG LH,$RX,72,OP1 LOAD HALFWORD 17348000 + OPG LM,$RS,152,OP3 LOAD MULTIPLE 17350000 + OPG LR,$RR,24 LOAD REGISTER 17352000 + EJECT 17353000 +OP2M EQU * 17354000 + OPG MD,$RX,108,OP7+IAA,F MULTIPLY LONG 17356000 + OPG ME,$RX,124,OP3+IAA,F MULTIPLY SHORT 17358000 + OPG MH,$RX,76,OP1 MULTIPLY HALFWORD 17360000 + OPG MP,$SS2,252,IAL2,D MULTIPLY DECIMAL 17362000 + OPG MR,$RR,28,IAA MULTIPLY REGISTER 17364000 +OP2N EQU * 17366000 + OPG NC,$SS,212,IAL2 AND CHARACTER 17368000 + OPG NI,$SI,148 AND IMMEDIATE 17370000 + OPG NR,$RR,20 AND REGISTER 17372000 + OPG OC,$SS,214,IAL2 OR CHARACTER 17374000 + OPG OI,$SI,150 OR IMMEDIATE 17376000 + OPG OR,$RR,22 OR REGISTER 17378000 +OP2S EQU * 17380000 + OPG SD,$RX,107,OP7+IAA,F SUBTRACT NORM LONG 17382000 + OPG SE,$RX,123,OP3+IAA,F SUBTRACT NORM SHORT 17384000 + OPG SH,$RX,75,OP1 SUBTRACT HALFWORD 17386000 + OPG SL,$RX,95,OP3 SUBTRACT LOGICAL 17388000 + OPG SP,$SS2,251,IAL2,D SUBTRACT DECIMAL 17390000 + OPG SR,$RR,27 SUBTRACT REGISTER 17392000 + OPG ST,$RX,80,3 STORE 17394000 + OPG SU,$RX,127,OP3+IAA,F SUBTRACT UNNORM SHORT 17396000 + OPG SW,$RX,111,OP7+IAA,F SUBTRACT UNNORM LONG 17398000 +OP2T EQU * 17400000 + OPG TM,$SI,145,IAL1 TEST UNDER MASK 17402000 + OPG TR,$SS,220,IAL2 TRANSLATE 17404000 + OPG TS,$RSO,147 TEST AND SET (ONLY NON-PRIV TYPE) 17406000 + OPG XC,$SS,215,IAL2 EXCLUSIVE OR CHARACTER 17408000 + OPG XI,$SI,151 EXCLUSIVE OR IMMEDIATE 17410000 + OPG XR,$RR,23 EXCLUSIVE OR REGISTER 17412000 +OP2END EQU * 17414000 + EJECT 17416000 +* 3-CHARACTER INSTRUCTIONS * 17418000 +OP3A EQU * 17420000 + OPG ADR,$RR,42,IAR,F ADD NORM LONG REGISTER 17422000 + OPG AER,$RR,58,IAR,F ADD NORM SHORT REGISTER 17424000 + OPG AGO,$IM,$AGO,,M 17425000 + OPG AIF,$IM,$AIF,,M 17425200 + OPG ALR,$RR,30 ADD LOGICAL REGISTER 17426000 + OPG AUR,$RR,62,IAR,F ADD UNNORM SHORT REGISTER 17428000 + OPG AWR,$RR,46,IAR,F ADD UNNORM LONG REGISTER 17430000 + OPG AXR,$RR,54,IAR,FX ADD EXTENDED REGISTER 17431000 +OP3B EQU * 17432000 + OPG BAL,$RX,69,1 BRANCH AND LINK 17434000 + OPG BCR,$RR,7 BRANCH ON CONDITION REGISTER 17436000 + OPG BCT,$RX,70,1 BRANCH ON COUNT 17438000 + OPG BER,$RRM,7,X'80' **EXTENDED BRANCH MNEMONIC** J 17439000 + OPG BHR,$RRM,7,X'20' **EXTENDED BRANCH MNEMONIC** J 17439200 + OPG BLR,$RRM,7,X'40' **EXTENDED BRANCH MNEMONIC** J 17439400 + OPG BMR,$RRM,7,X'40' **EXTENDED BRANCH MNEMONIC** J 17439800 + OPG BNE,$RXM,71,X'70'+1 BRANCH ON NOT EQUAL 17440000 + OPG BNH,$RXM,71,X'D0'+1 BRANCH ON NOT HIGH 17442000 + OPG BNL,$RXM,71,X'B0'+1 BRANCH ON NOT LOW 17444000 + OPG BNM,$RXM,71,X'B0'+1 BRANCH ON NOT MINUS 17446000 + OPG BNO,$RXM,71,X'E0'+1 BRANCH ON NOT ONES 17448000 + OPG BNP,$RXM,71,X'D0'+1 BRANCH ON NOT PLUS 17450000 + OPG BNZ,$RXM,71,X'70'+1 BRANCH ON NOT ZERO 17452000 + OPG BOR,$RRM,7,X'10' **EXTENDED BRANCH MNEMONIC** J 17452600 + OPG BPR,$RRM,7,X'20' **EXTENDED BRANCH MNEMONIC** J 17452800 + OPG BXH,$RS,134,1 BRANCH ON INDEX HIGH 17454000 + OPG BZR,$RRM,7,X'80' **EXTENDED BRANCH MNEMONIC** J 17455000 +OP3C EQU * 17456000 + OPG CCW,$ICCW+$IB,$IBSTAR1,7,P CHANNEL COMMAND WORD 17458000 + OPG CDR,$RR,41,IAR,F COMPARE LONG REGISTER 17460000 + OPG CER,$RR,57,IAR,F COMAPRE SHORT REGISTER 17462000 + OPG CLC,$SS,213,IAL1+IAL2 COMPARE LOGICAL CHARACTER 17464000 + OPG CLI,$SI,149,IAL1 COMPARE LOGICAL IMMEDIATE 17466000 + OPG CLM,$RS,189,IAL2,S370 COMPARE LOGICAL UNDER MASK 17467000 + OPG CLR,$RR,21 COMPARE LOGICAL REGISTER 17468000 + OPG CVB,$RX,79,OP7 CONVERT TO BINARY 17470000 + OPG CVD,$RX,78,7 CONVERT TO DECIMAL 17472000 +OP3D EQU * 17474000 + OPG DDR,$RR,45,IAR,F DIVIDE LONG REGISTER 17476000 + OPG DER,$RR,61,IAR,F DIVIDE SHORT REGISTER 17478000 + OPG END,$IEND+$IB,IBOMOP+IBNONAM+IBMOSPEC END 17480000 + OPG EQU,$IEQU+$IB,IBNENAM+$IBSTAR1,1 EQUATE 17482000 + OPG HDR,$RR,36,IAR,F HALVE LONG 17484000 + OPG HER,$RR,52,IAR,F HALVE SHORT 17486000 + OPG HIO,$RSO,158,,P HALT I/O 17488000 + OPG ICM,$RS,191,IAL2,S370 INSERT CHARACTERS UNDER MASK 17489000 + OPG ISK,$RR,9,,P INSERT STORAGE KEY 17490000 +OP3L EQU * 17492000 + OPG LCR,$RR,19 LOAD COMPLEMENT REGISTER 17494000 + OPG LDR,$RR,40,IAR,F LOAD LONG REGISTER 17496000 + OPG LER,$RR,56,IAR,F LOAD SHORT REGISTER 17498000 + OPG LNR,$RR,17 LOAD NEGATIVE REGISTER 17500000 + OPG LPR,$RR,16 LOAD POSITIVE REGISTER 17502000 + OPG LTR,$RR,18 LOAD AND TEST REGISTER 17504000 + EJECT 17505000 +OP3M EQU * 17506000 + OPG MDR,$RR,44,IAR,F MULTIPLY LONG REGISTR 17508000 + OPG MER,$RR,60,IAR,F MULTIPLY SHORT REGISTER 17510000 + OPG MVC,$SS,210,IAL2 MOVE CHARACTER 17512000 + OPG MVI,$SI,146 MOVE IMMEDIATE 17514000 + OPG MVN,$SS,209,IAL2 MOVE NUMERICS 17516000 + OPG MVO,$SS2,241,IAL2 MOVE WITH OFFSET (2 LENGTHS) 17518000 + OPG MVZ,$SS,211,IAL2 MOVE ZONES 17520000 + OPG MXD,$RX,103,IAA+OP7,FX MULTIPLY EXTENDED/LONG 17520100 + OPG MXR,$RR,38,IAR,FX MULTIPLY EXTENDED REGISTER 17520200 +OP3N EQU * 17522000 + OPG NOP,$RXM,71,X'00'+1 NO OPERATION 17524000 + OPG ORG,$IORG+$IB,IBNONAM+IBOMOP+$IBSTAR1 ORIGIN 17526000 + OPG RDD,$SI,133,,P READ DIRECT 17528000 +OP3S EQU * 17530000 + OPG SCK,$RSO,178,X'40'+OP7,P370 SET CLOCK 17531000 + OPG SDR,$RR,43,IAR,F SUBTRACT NORM LONG REGISTER 17532000 + OPG SER,$RR,59,IAR,F SUBTRACT NORM SHORT REGISTER 17534000 + OPG SIO,$RSO,156,,P START I/O 17536000 + OPG SLA,$RSH,139,IAL2 SHIFT LEFT ALGEBRAIC 17538000 + OPG SLL,$RSH,137,IAL2 SHIFT LEFT LOGICAL 17540000 + OPG SLR,$RR,31 SUBTRACT LOGICAL REGISTER 17542000 + OPG SPM,$RSO,4 17544000 + OPG SRA,$RSH,138,IAL2 SHIFT RIGHT ALGEBRAIC 17546000 + OPG SRL,$RSH,136,IAL2 SHIFT RIGHT LOGICAL 17548000 + OPG SRP,$SS2,240,,S370 SHIFT AND ROUND PACKED 17549000 + OPG SSK,$RR,8,,P SET STORAGE KEY 17550000 + OPG SSM,$RSO,128,,P SET SYSTEM MASK 17552000 + OPG STC,$RX,66 STORE CHARACTER 17554000 + OPG STD,$RX,96,7+IAA,F STORE LONG 17556000 + OPG STE,$RX,112,3+IAA,F STORE SHORT 17558000 + OPG STH,$RX,64,1 STORE HALFWORD 17560000 + OPG STM,$RS,144,3 STORE MULTIPLE 17562000 + OPG SUR,$RR,63,IAR,F SUBTRACT UNNORM SHORT REGISTER 17564000 + OPG SVC,$RSO,10 SUPERVISOR CALL 17566000 + OPG SWR,$RR,47,IAR,F SUBTRACT UNNORM LONG REGISTER 17568000 + OPG SXR,$RR,55,IAR,FX SUBTRACT EXTENDED REGISTER 17569000 +OP3T EQU * 17570000 + OPG TCH,$RSO,159,,P TEST CHANNEL 17572000 + OPG TIO,$RSO,157,,P TEST I/O 17574000 + OPG TRT,$SS,221,IAL1+IAL2 TRANSLATE AND TEST 17576000 + OPG WRD,$SI,132,,P WRITE DIRECT 17578000 + OPG ZAP,$SS2,248,IAL2,D ZERO AND ADD DECIMAL 17580000 +OP3END EQU * 17582000 + EJECT 17584000 +* 4-CHARACTER INSTRUCTIONS * 17586000 +OP4A EQU * 17588000 + OPG ACTR,$IM,$ACTR,,M 17588200 + OPG ANOP,$IM,$ANOP,,M 17588400 +OP4B EQU * 17590000 + OPG BALR,$RR,5 BRANCH AND LINK REGISTER 17592000 + OPG BCTR,$RR,6 BRANCH ON COUNT REGISTER 17594000 + OPG BNER,$RRM,7,X'70' **EXTENDED BRANCH MNEMONIC** J 17596200 + OPG BNHR,$RRM,7,X'D0' **EXTENDED BRANCH MNEMONIC** J 17596400 + OPG BNLR,$RRM,7,X'B0' **EXTENDED BRANCH MNEMONIC** J 17596600 + OPG BNMR,$RRM,7,X'B0' **EXTENDED BRANCH MNEMONIC** J 17596800 + OPG BNOR,$RRM,7,X'E0' **EXTENDED BRANCH MNEMONIC** J 17597000 + OPG BNPR,$RRM,7,X'D0' **EXTENDED BRANCH MNEMONIC** J 17597200 + OPG BNZR,$RRM,7,X'70' **EXTENDED BRANCH MNEMONIC** J 17597400 + OPG BXLE,$RS,135,1 BRANCH INDEX LOW OR EQUAL J 17597800 +OP4C EQU * 17598000 + OPG CLCL,$RR,15,IAR,S370 COMPARE LOGICAL CHARACTERS LONG 17599000 + OPG CNOP,$ICNOP+$IB,IBNONAM+$IBSTAR1 CONDITIONAL NOP 17600000 +OP4D EQU * 17602000 + AIF (&$DEBUG).OPDIAG SKIP DIAGNOSE IF NOT DEBUG MODE 17604000 + OPG DIAG,$SI,131 DIAGNOSE(EXECUT EQUIV OF DEBUG) 17606000 +.OPDIAG ANOP 17608000 + OPG DROP,$IDROP+$IB,IBNONAM DROP REGISTER 17610000 + OPG EDMK,$SS,223,IAL2,D EDIT AND MARK 17612000 + OPG GBLA,$IM,$GBLA,$ARITH,M 17612400 + OPG GBLB,$IM,$GBLB,$BOOL,M 17612600 + OPG GBLC,$IM,$GBLC,$CHAR,M 17612800 +OP4L EQU * 17614000 + OPG LCDR,$RR,35,IAR,F LOAD COMPLEMENT LONG REGISTER 17616000 + OPG LCER,$RR,51,IAR,F LOAD COMPLEMENT SHORT REGISTER 17618000 + OPG LCLA,$IM,$LCLA,$ARITH,M 17618200 + OPG LCLB,$IM,$LCLB,$BOOL,M 17618400 + OPG LCLC,$IM,$LCLC,$CHAR,M 17618600 + OPG LCTL,$RS,183,OP3,P370 LOAD CONTROL 17619000 + OPG LNDR,$RR,33,IAR,F LOAD NEGATIVE LONG REGISTER 17620000 + OPG LNER,$RR,49,IAR,F LOAD NEGATIVE SHORT REGISTER 17622000 + OPG LPDR,$RR,32,IAR,F LOAD POSITIVE LONG REGISTER 17624000 + OPG LPER,$RR,48,IAR,F LOAD POSITIVE SHORT REGISTER 17626000 + OPG LPSW,$RSO,130,7,P LOAD PROGRAM STATUS WORD 17628000 + OPG LRDR,$RR,37,IAR,FX LOAD ROUNDED EXTENDED ==> LONG 17629100 + OPG LRER,$RR,53,IAR,FX LOAD ROUNDED LONG ==> SHORT 17629200 + OPG LTDR,$RR,34,IAR,F LOAD AND TEST LONG REGISTER 17630000 + OPG LTER,$RR,50,IAR,F LOAD AND TEST SHORT REGISTER 17632000 +OP4M EQU * 17634000 + OPG MEND,$IM,$MEND,,M 17634200 + OPG MVCL,$RR,14,IAR,S370 MOVE CHARACTERS LONG 17635000 + OPG MXDR,$RR,39,IAR,FX MULTIPLY EXTENDED / LONG REG 17635100 +OP4N EQU * 17636000 + OPG NOPR,$RRM,7,X'00' NO OPERATION 17638000 + OPG PACK,$SS2,242,IAL2 PACK 17640000 +OP4S EQU * 17642000 + OPG SETA,$IM,$SETA,$ARITH,M 17642200 + OPG SETB,$IM,$SETB,$BOOL,M 17642400 + OPG SETC,$IM,$SETC,$CHAR,M 17642600 + OPG SIOF,$RSO,156,X'10',P370 START I/O FAST 17643000 + OPG SLDA,$RSH,143,IAL2+IAA SHIFT LEFT DOUBLE ALGEBRAI 17644000 + OPG SLDL,$RSH,141,IAL2+IAA SHIFT LEFT DOUBLE LOGICAL 17646000 + OPG SRDA,$RSH,142,IAL2+IAA SHIFT RIGHT DOUBLE ALGEBRA 17648000 + OPG SRDL,$RSH,140,IAL2+IAA SHIFT RIGHT DOUBLE LOGICAL 17650000 + OPG STCK,$RSO,178,X'50',P370 STORE CLOCK 17650500 + OPG STCM,$RS,190,,S370 STORE CHARACTERS UNDER MASK 17651000 +OP4T EQU * 17652000 + OPG UNPK,$SS2,243,IAL2 UNPACK 17654000 + AIF (&$XXIOS).OP4TSK1 SKIP IF NO XGETS ALLOWED CPP 17654200 + OPG XGET,$SPC,224,X'A0' GENERAL INPUT D 17654400 +.OP4TSK1 AIF (NOT &$EXINT).OP4TSK2 SKIP IF NO XOPC'S CPP 17654450 + OPG XOPC,$RSO,1 EXTENDED USER DEBUG CONTROL INSTR 17654500 +.OP4TSK2 AIF (&$XXIOS).OP4TSK SKIP IF NO XPUTS ALLOWED CPP 17654550 + OPG XPUT,$SPC,224,X'C0'+IAL2 GENERAL OUTPUT OP J 17654600 +.OP4TSK ANOP 17654800 +OP4END EQU * 17656000 + EJECT 17658000 +* 5-CHARACTER INSTRUCTIONS * 17660000 +OP5A EQU * 17662000 +OP5B EQU * 17664000 +OP5C EQU * 17666000 + OPG CSECT,$ICSECT+$IB,IBOMOP CSECT 17668000 +OP5D EQU * 17670000 + AIF (&$DEBUG).OPNOD1 SKIP IF NOT DEBUG MODE 17672000 + OPG DEBUG,$IDEBUG+$IB DEBUG FLAG SETTING OPCODE 17674000 +.OPNOD1 ANOP 17676000 + OPG DSECT,$IDSECT+$IB,IBOMOP+IBNENAM DUMMY SECTION 17678000 + OPG EJECT,$IEJECT+$IB,IBNONAM+IBOMOP+IBMOPRCX,255 EJECT 17680000 + OPG ENTRY,$IENTRY+$IB,IBNONAM ENTRY DECLARATION 17682000 + OPG EXTRN,$IEXTRN+$IB,IBNONAM EXTERNAL DECLARATION 17684000 +OP5L EQU * 17686000 + OPG LTORG,$ILTORG+$IB,IBOMOP+$IBSTAR1 LTORG 17688000 +OP5M EQU * 17690000 + OPG MACRO,$IM,$MACRO,,M 17690200 + OPG MEXIT,$IM,$MEXIT,,M 17690400 + OPG MNOTE,$IM,$MNOTE,,M 17690600 +OP5N EQU * 17692000 + OPG PRINT,$IPRINT+$IB,IBNONAM+IBMOPRCX,$IBPON+$IBPGEN 17694000 +OP5S EQU * 17696000 + OPG SPACE,$ISPACE+$IB,IBNONAM+IBOMOP+IBMOPRCX,1 SPACE 17698000 + OPG START,$ISTART+$IB,IBOMOP START 17700000 + OPG STCTL,$RS,182,3,P370 STORE CONTROL 17700500 + OPG STIDC,$RSO,178,X'30',P370 STORE CHANNEL ID 17701000 + OPG STIDP,$RSO,178,X'20',P370 STORE CPU ID 17701500 +OP5T EQU * 17702000 + OPG TITLE,$ITITLE+$IB,IBNONAM+IBMOPRCX,0 TITLE 17704000 + OPG USING,$IUSING+$IB,IBNONAM+$IBSTAR1 USING 17706000 + AIF (NOT &$XIOS).OPNOXIO SKIP IF NO XIOS WANTED 17708000 + OPG XDECI,$RX,83 DECIMAL INPUT 17710000 + OPG XDECO,$RX,82 DECIMAL OUTPUT 17712000 + OPG XDUMP,$SPC,224,X'60'+IAL2 DUMP 17714000 + AIF (NOT &$HEXI).OPNOHXI SKIP IF NO XHEXI 17714100 + OPG XHEXI,$RX,97 OP CODE FOR XHEXI 17714200 +.OPNOHXI ANOP 17714300 + AIF (NOT &$HEXO).OPNOHXO SKIP IF NO XHEXO 17714400 + OPG XHEXO,$RX,98 OP CODE FOR XHEXO 17714500 +.OPNOHXO ANOP 17714600 + AIF (NOT &$XIOS).OPNOXIO SKIP IF NO X-I/O PSEUDOS CPP 17714900 + OPG XLIMD,$SPC,224,X'80' LIMIT AREA (COMPLETION DUMP) 17715000 + OPG XPNCH,$SPC,224,X'40'+IAL2 PUNCH 17716000 + OPG XPRNT,$SPC,224,X'20'+IAL2 PRINT 17718000 + OPG XREAD,$SPC,224,X'00' READ 17720000 +.OPNOXIO ANOP 17722000 + AIF (&$REPL EQ 0).OPNREPL SKIP IF NOT REPLACE 17722500 + OPG XREPL,$SI,160 XREPL SPECIAL COMMAND 17723000 +.OPNREPL ANOP 17723500 +OP5END EQU * 17724000 + SPACE 2 17726000 +* SECOND LEVEL OFFSET TABLE - HAS POINTERS FOR EACH BEGINNING * 17728000 +* CHARACTER, IN TABLE DETERMINED BY LENGTH. * 17730000 +* TR TABLE 0 1 2 3 4 5 6 7 8 9 A B C D E F * 17732000 +OPFCH1 DC X'000204060606060606060606060606' C 17734000 + DC X'060606080A0C0C0C0C0C0C0C0C0C0C0C' D 17736000 + DC X'0C0C0E10101010101010101010101010' E 17738000 + DC X'10101010101010101010101010101010' F 17740000 + SPACE 2 17742000 +* OFFSET VALUES INTO OPCODTB ENTRY AREA * 17744000 +OPADS DS H BASE ADDRESS OF 2ND LEVEL OFFSET TAB 17746000 + OPGT 17748000 + DROP REP,RC CLEAN UP USINGS 17750000 + TITLE '*** OUTPUT - SOURCE AND OBJECT LISTING ***' 17752000 +**--> CSECT: OUTPUT PRINTED LISTING ROUTINE . . . . . . . . . . . 17754000 +*. OUTPUT HANDLES THE FORMATTING AND PRINTING OF THE ASSEMBLY . 17755000 +*. LISTING FOR THE ASSIST ASSEMBLER. . 17755500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 17756000 +OUTPUT CSECT 17758000 + $DBG C0,SNAP 17760000 + ENTRY OUINT1,OUTPT2,OUEND2 17764000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 17766000 + SPACE 1 17768000 +* LIST OF LINE/PAGE CONTROL EQUATE VALUES FOLLOWS. 17768100 +$OU#LNS EQU 60 MAXIMUM PRINTED LINES/PAGE 17768200 +OUH# EQU 3 # LINES USED BY STANDARD HEADING 17768300 +$OU#NORM EQU $OU#LNS-OUH# NORMAL LINES/PAGE FOR ACTIAL STMTS 17768400 +$OU#PAG1 EQU $OU#NORM-5 # LINES FOR STMTS ON 1ST PAGE ONLY 17768500 + SPACE 1 17768600 +**--> ENTRY: OUINT1 1 INITIALIZATION ENTRY - CALLED BEFORE PASS 1 . 17770000 +*. OUINT1 IS CALLED TO INITIALIZE FLAG VALUES AND COUNTERS . 17770100 +*. USED IN OUTPUT, INCLUDING LISTING CONTROL, STATEMENT #, . 17770200 +*. PAGE COUNT, WITHIN-PAGE LINE COUNT, AND TITLE AREA. . 17770300 +*. USES DSECTS: AVWXTABL . 17770400 +*. USES MACROS: $RETURN,$SAVE . 17770500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 17772000 + SPACE 1 17773000 +OUINT1 $SAVE SA=NO 17774000 + AIF (&$COMNT EQ 0).OUNCOM1 SKIP IF NO COMMENT CHK 17774500 + MVC AVMACHIN(4),AWZEROS ZERO VARIABLES(SEE IAMOP1 CSECT) 17775000 +.OUNCOM1 ANOP 17775500 + MVI AVPRINT,$IBPON+$IBPGEN PRINT ON,GEN,NODATA 17776000 + TM AVTAGS1,AJNLIST IS LIST ON OR OFF 17778000 + BO *+8 SKIP IF LIST IS OFF 17780000 + OI AVPRINT,$IBPLIST SHOW LIST IS ON FOR LATER TEST 17782000 + MVC AVPRINT1,AVPRINT COPY VALUE FOR USE DURING PASS 1 17783000 + ZAP OULNCNT,AWP1 SET CURRENT STMT # = 1 17784000 + ZAP OUPGCNT,AWP0 SET PAGE COUNT TO ZERO LASO 17786000 + MVC OUCOUNT,AWH1 INIT WITHIN PAGE COUNT TO 1 17788000 + MVC OUHEADNG,AWBLANK BLANK OUT SPOT FOR HEADING 17790000 +* FOLLOWING STMTS HELP AVOID WASTED 1ST PAGE LISTING. 17790500 + LA RE,$OU#PAG1 # LINES FOR STMTS ON 1ST PAGE ONLY 17790800 + STH RE,OUH#LINE SET COUNTERSETTER TO INITIAL VALUE 17791000 + MVI OUHEAD1,C'0' JUST DO DOUBLESPACE 1ST TIME 17791500 + AIF (NOT &$CMPRS).OUINCM SKIP IF NO COMPRESS CODE 17791510 + SPACE 2 17791520 +* CMPRS OPTION INITIALIZATION&TESTING - IF ON, GET 17791530 +* SPACE FOR OUCMPRSD BLOCK, INIT VARIABLES. 17791540 + SPACE 1 17791550 + TM AVTAGS2,AJOCMPRS IS CMPRS OPTION USED 17791560 + BZ OUINOCMP NO, SO DON'T GET SPACE 17791570 + SPACE 1 17791580 + LA RA,OUCMPR$L TOTAL LENGTH OF OUCMPRSD BLOCK 17791590 + $ALLOCH RB,RA,OUINCMOV ACQUIRE AREA 17791600 + USING OUCMPRSD,RB NOTE PTR THERE 17791610 + ST RB,OUCMPRAD STORE @ BLOCK FOR OUTPT2 USE 17791620 + LA RE,$OU#PAG1+OUH# TOTAL # LINES FOR PAGE 1 17791630 + STH RE,OUCMOPAG SET # LINES ON FIRST PAGE ONLY 17791640 + STH RE,OUCMLEFT SET # LINES LEFT IN OUCMSAVE,PAGE1 17791650 + SPACE 1 17791660 + LA RC,OUCMSAVE @ 1ST BYTE OF STORAGE AREA 17791670 + ST RC,OUCMSTMT SET @ SO 1ST STMT WILL BE THERE 17791680 + NI OUCMPHAS,255-OUCMPHSB SHOW OUTPT2 IN PHASE 'A' 17791690 + MVI OUCMCCIN,C'0' MAKE INITIAL CARRIAGE CONT D SPACE 17791700 + MVC OUCMBREK,=C'. ' INITIALZE SEPARATER FIELD 17791710 + B OUINOCMP SKIP OVER RESET CODE 17791720 + DROP RB KILL USING 17791730 + SPACE 1 17791740 +* INSUFFICIENT SPACE - CANCEL CMPRS OPTION NOW. 17791750 +OUINCMOV NI AVTAGS2,255-AJOCMPRS REMOVE CMPRS FLAG 17791760 +OUINOCMP EQU * 17791770 + SPACE 1 17791780 +.OUINCM ANOP 17791790 +OUINRET $RETURN SA=NO 17792000 + EJECT 17794000 +**--> ENTRY: OUTPUT2 PRINT 1 STATEMENT,WITH CODE AS NEEDED,ERROR . 17796000 +*. OUTPT2 PRINTS 1 STATEMENT, WITH ANY ERROR MESSAGES NEEDED, . 17796100 +*. PRINTS TITLES AND HEADINGS WHEN REQUIRED, PERFORMS PAGE AND . 17796200 +*. LINE COUNTING, MAINTAINS LISTING CONTROL STATUS, AND KEEPS . 17796300 +*. COUNTS OF NUMBER OF STATEMENTS FLAGGED, TOTAL # ERRORS, . 17796400 +*. TOTAL # WARNING MESSAGES. . 17796500 +*. ENTRY CONDITIONS . 17798000 +*. RB = PRIMARY CALL TYPE CODE . 17800000 +*. = 0 ($OUMACH) MACHINE INSTRUCTIONS . 17802000 +*. = 2 ($OUCONS) CONSTANTS,CNOPS,ETC. PRINT LOCATION COUNTER,CO. 17804000 +*. = 4 ($OULIST) - LISTING CONTROL - EJECT,SPACE,PRINT,TITLE . 17806000 +*. = 6 ($OUCOMM) - COMMENTS,ETC.-DO NOT HAVE LOCATION COUNTER . 17808000 +*. RC = AN INFORMATION ADDRESS OF SOME TYPE . 17810000 +*. = @ OBJECT CODE (RB=0,2) . 17812000 +*. = @ # LINES TO SPACE (RB=4,RE=0) . 17814000 +*. = @ PRINT CONTROL CODE BYTE (RB=4,RE=2) I.E. PRINT . 17816000 +*. = @ TITLE CODE (RB=4,RE=4) . 17818000 +*. RD = #-1 OF BYTES OF OBJECT CODE OR TITLE . 17820000 +*. RE = SECONDARY CODE OR ADDRESS . 17822000 +*. = SECONDARY CODE FOR LISTING CONTROL OPERATIONS . 17826000 +*. = 0 SPACE OR EJECT . 17828000 +*. = 2 PRINT . 17830000 +*. = 4 TITLE . 17832000 +*. USES DSECTS: AVWXTABL,ICBLOCK,RCODBLK,RSBLOCK,RSCBLK,REBLK . 17833000 +*. USES MACROS: $AL2,$PRNT,$RETURN,$SAVE,$SERR . 17833500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 17834000 + EJECT 17836000 +* * * * * REGISTER USAGE FOR OUTPT2 * * * * * * * * * * * * * * * * * * 17838000 +* RW = CURRENT VALUE OF OUCOUNT. IF =1,NEW HEADING NEEDED * 17840000 +* RX = BASE REGISTER * 17842000 +* RY = UNUSED AT PRESENT * 17844000 +* RZ = @ RSBLOCK BELONGING TO STATEMENT BEING PROCESSED. * 17846000 +* R14= INTERNAL LINK REGISTER. LOCAL WORK REGISTRE. * 17847000 +* R15= LOCAL WORK REGISTER. * 17847500 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 17848000 + SPACE 1 17850000 +OUTPT2 $SAVE RGS=(R14-R6),SA=NO LEAVE R15 AS IS 17852000 + LR RX,R15 MOVE @ OUTPT2 OVER FOR NEW BASE 17852200 + DROP R15 REMOVE OLD USING 17852400 + USING OUTPT2,RX NOTE NEW USING 17852600 + SPACE 1 17854000 +* COMMON INITIALIZATION. MAKE PROCESSOR CHOICE, BASED * 17856000 +* ON CONTENTS OF REG RB. PRINT IF PRINT ON, OR INSTRUCTION IS * 17858000 +* A LISTING CONTROL, OR ANY STMT WITH AN ERROR IN IT. * 17860000 + SPACE 1 17862000 + L RZ,AVRSBPT GET POINTER TO RSBLOCK 17864000 + USING RSBLOCK,RZ NOTE POINTER 17866000 + LH RW,OUCOUNT GET WITHIN PAGE COUNT 17868000 + MVC OUTLINE(OUTLEN),AWBLANK BLANK OUT LEFT HAND SIDE 17872000 + AIF (NOT &$MACROS).OUNGEN SKIP IF NO MACRO CODE 17872100 + SPACE 1 17872200 + TM RSBFLAG,$RSBGENR WAS THIS GENERATED STMT 17872300 + BZ OUNGEN NO, NORMAL, SKIP 17872400 + MVI OUSOURC-1,C'+' MARK OUTPUT AS GENERATED 17872500 + TM AVPRINT,$IBPGEN IS PRINT GEN: SHOULD WE PRINT 17872600 + BO OUNGEN PRINT GEN-DEFINITELY PRINT 17872700 +* FOLLOWING STMTS ALLOW GENERATED PRINT STMTS TO BE USED. 17872800 +* WARNING: EXTENSION FROM ASMBLER F. 17872900 + CH RB,=AL2($OULIST) IS IT LISTING CONTROL STMT 17873000 + BNE OUTRETE NO, NOT LISTING CONTROL - GO CHK 17873100 + CH RE,=H'2' WS IT ACTUALLY PRINT 17873200 + BNE OUTRETE NO, SO IGNORE IT 17873300 +* YES, FALL THRU AND DO IT 17873400 +OUNGEN EQU * SKIP HERE IF NOT GEN'D STMT 17873500 + SPACE 1 17873600 +.OUNGEN ANOP 17873700 + LH R14,OUJUMP1(RB) GET PRIMARY TUPE OF STATEMENT 17874000 + TM AVPRINT,$IBPON+$IBPLIST SET CC=3 IF PRINT ON AND LIST 17876000 +OUTJ1 BAL R14,OUTJ1(R14) GO TO RIGHT CODE, WITH CC SET 17878000 +* IF SPECIFIC STMT TYPE CODE DOESN'T WANT TO PROCESS IT, 17879000 +* IT CAN RETURN HERE VIA A BCR NO,R14, AND STMT WON'T BE 17880000 +* PRINTED UNLESS IT HAS ERRORS IN IT. 17881000 + SPACE 1 17888000 +OUTRETE TM RSBFLAG,$REBX+$RSBMERR ARE THERE ANY ERRORS/ERR RECRD 17890000 + BZ OUTRETA XKIP IF NONE,PRINT STMT IF SO 17892000 + EJECT 17894000 +* OUTSTMT - FORMAT AND PRINT STATEMENT,WITH ERRORS * 17896000 +* NORMALLY ENTERED AFTER INDIVIUDAL TYPE PROCESSING. 17897000 +OUTSTMT EQU * COME HERE IF STMT SHOULD BE PRINTED 17897100 + AIF (NOT &$MACROS).OUNMAC1 SKIP IF NO MACROS ALLOWED 17897200 + TM RSBFLAG,$RSBNPNN WAS THIS NOT TO BE NUMBERED 17897300 + BO OUTSTMTN NO NUMBER - SKIP EDITING 17897400 +.OUNMAC1 ANOP 17897500 + SPACE 2 17897600 + MVC OUDSTMNT-1(6),AWEP6 COPY THE EDIT PATTERN 17898000 + ED OUDSTMNT-1(6),OULNCNT FORMAT STATEMENT # 17900000 +* GET 1ST(OR ONLY) CARD-IMAGE IN PLACE FOR PRINTING * 17902000 +* NEXT STMT ASSUMES 1ST CARD OF SEVERAL IS 71 BYTES LONG. 17903990 +OUTSTMTN LA R1,RSOL1-1 NORMAL LENGTH-1, CLEAR FOR INSERT 17904000 + L R2,AVRSCPT GET @ RSCBLK,IF IT EXISTS 17906000 + USING RSCBLK,R2 NOTE USING,FOR ANY SECTION REQUIRING 17908000 + CLI RSBNUM,1 WAS THERE ONLY 1 CARD 17910000 + BNE OUTC1B NO, SKIP, R1 ALREADY SET OK 17912000 +OUTC1A IC R1,RSBLENG GET THE LENGTH OF RSBLOCK, 1 SOURCE 17924000 + LA R1,(255-RSB$L)(R1) SUBTRACT LENGTH, LOW-ORDER BYTE-WISE 17926000 + MVC OUSOURCE,AWBLANK+9 BLANK STMT, CONT/SEQNO 17926100 + SPACE 1 17926200 + AIF (NOT &$MACROS).OUNMAC2 SKIP IF NO MACRO 17926300 + TM RSBFLAG,$RSBMERR SPECIAL ERROR FORMT STMT 17926400 + BZ OUTC1B NO, SO SKIP SPECIAL FORMATTING 17926500 + SPACE 1 17926600 +* SPECIAL ERROR MESSAGE - ISSUED BY MACRO PROCESSOR - 17926700 +* STMT IMAGE IS CONSTRUCTED TEXT OF ERROR MESSAGE. 17926800 +* **NOTE** THESE ARE NOT CURRENTLY COUNTED AS ERRORS 17926900 + STC R1,OURSBMOV+1 PUT L-1 INTO MOVE FOR MESSAGE 17927000 + MVC OUTLINE+1(L'OUTERRAS-1),OUTERRAS+1 ERROR PTR ON LEFT 17927100 + MVC OUCONSQ+1(8),OUTEREND+1 ERROR PTE ON RIGHT 17927200 +OURSBMOV MVC OUTLINE+L'OUTERRAS($),RSBSOURC MOVE MESSAGE IN 17927300 + B OUTSPRNT GO PRINT WITHOUT FURHTER ADO 17927400 +.OUNMAC2 ANOP 17927500 + SPACE 1 17928000 +OUTC1B STC R1,*+5 STORE LENGTH-1 INTO NEXT INSTR 17930000 + MVC OUSOURC($CHN),RSBSOURC MOVE VARIABLE LENGTH OVER 17932000 + SPACE 1 17933000 +* PLACE CONTINUATION SEQNO IN IF NEEDED * 17934000 + TM RSBFLAG,$RSCX DO WE HAVE CONT/SEQN 17936000 + BZ OUTSPRNT NO,DON'T NEED CONT/SEQN 17938000 + MVC OUCONSQ,RSCONSQ MOVE FIELD IN 17940000 + SPACE 1 17942000 +OUTSPRNT EQU * POINT FOR PRINTING 1ST /ONLY CARD 17942100 +OUTSPRNU BAL R14,OUTLNSA HAVE THE STMT PRINTED 17942700 + CLI RSBNUM,1 WAS THERE ONLY 1 CARD(HOPE) 17946000 + BNE OUTSCON NO(GROAN)-MULTIPLE CARDS IN STMT 17948000 + TM RSBFLAG,$REBX WERE THERE ERRORS 17950000 + BNZ OUTERR BRANCH IF ERRORS(UNFORTUNATE) 17952000 + SPACE 1 17954000 +OUTRETA STH RW,OUCOUNT SAVE WITHIN PAGE COUNT 17956000 + AIF (NOT &$MACROS).OUNMAC3 SKIP IF NO MACROS 17956100 + TM RSBFLAG,$RSBNPNN SEE IF SHOULDN'T INCRE STMT # 17956200 + BO OUTRETAA SKIP OVER STMT# ADD INSTR(S) J 17956300 +.OUNMAC3 AP OULNCNT,AWP1 BUMP STMT # TO # OF NEXT ONE 17956400 + AIF (NOT &$XREF).NOXRF10 A 17956405 + AP AVXRLNCN,AWP1 INCREMENT ADDITIONAL LINE COUNTER A 17956410 +.NOXRF10 ANOP A 17956415 +OUTRETAA EQU * BRANCH HERE BEFORE EXIT J 17957000 + $DBG C0,* JUST TRACE ON EXIT 17958000 +OUTRET $RETURN RGS=(R14-R6),SA=NO 17960000 + EJECT 17962000 +* * * * * OUTSCON - HANDLE PRINTING OF CONTINUATION CARDS.SET UP OFFSE* 17964000 +* * * * * REGISTER USAGE * 17966000 +* R1 = CURRENT COUNT OF # CARDS REMAINING TO BE PRINTED(INIT-RSBNUM)* 17968000 +* R2 = @ CURRENT RSCBLK SECTION BEING PROCESSED * 17970000 +* RD = CURRENT TOTAL OFFSET. USED TO EXTRACT CARDS,SET ERROR MESSGS * 17972000 +* INIT. LOOP THOURHG OUTSCON2 FOR EACH CONT/CARD. SET * 17974000 +* UP OFFSETS IN OUTOFFS FOR USE IN ERROR POINTERS. * 17976000 + SPACE 1 17978000 +OUTSCON SR R1,R1 CLEAR FOR INSERTION 17980000 + IC R1,RSBNUM GET TOTAL # OF CARDS 17982000 + LA RC,OUTOFFS(R1) GET @ LAST BYTE FOR OFFSETS 17984000 + MVI 0(RC),RSB$L MOVE BEGINNING OFFSET IN 17986000 + SR RD,RD CLEAR FOR INSERT 17988000 + IC RD,RSCILEN GET LENGTH OF 1ST CARDIMAGE 17990000 + LA RD,RSB$L(RD) INCREMENT LENGTH BY 1ST OFFSET 17992000 + STC RD,OUTOFFS-1(R1) STORE IN APPROPRAITE PART OF OUTOFFS 17994000 + BCTR R1,0 DECREMENT # CARDS LEFT TO DO 17996000 + MVC OUTLINE,AWBLANK BLANK WHOLE LINE 17998000 + SPACE 1 18000000 +OUTSCON2 LA R2,RSC$LEN(R2) BUMP RSCB POINTER TO NEXT FIELD 18002000 + LA RC,RSBLOCK(RD) GET @ NEXT SOURCE CARD ELEMENT 18004000 + SR RB,RB CLEAR FOR INSERT 18006000 + IC RB,RSCILEN GET LENGTH OF NEXT CARD 18008000 + AR RD,RB ADD TO TOAL OFFSET LENGTH 18010000 + STC RD,OUTOFFS-1(R1) STORE NEXT OFFSET INTO LIST 18012000 + BCTR RB,0 DECREMENT FOR LENGTH-1 18014000 + STC RB,*+5 SAVE INTO MVC 18016000 + MVC OUSOURC+15($CHN),0(RC) MOVE CARD IMAGE OVER 18018000 + MVC OUCONSQ,RSCONSQ MOVE CONT/SEQNO OVER 18020000 + BAL R14,OUTLNSA HAVE STMT PRINTED 18022000 + STC RB,*+5 PUT LENGTH-1 INTO NEXT MVC 18024000 + MVC OUSOURC+15($CHN),AWBLANK BLANK OUT PART OF LINE USE 18026000 + BCT R1,OUTSCON2 LOOP UNTIL WHOLE STATEMENT FINISHED 18028000 + SPACE 1 18030000 + TM RSBFLAG,$REBX DO ERRORS EXIST 18032000 + BZ OUTRETA NO ERRORS - QUIT 18034000 + EJECT 18036000 +* * * * * OUTERR - PRINT ERROR MESSAGES AND SCAN POINTERS * 18038000 +* R2 = # ERROR CODE/SCAN POINTER PAIRS (= 1 TO $ERREBMX). * 18040000 +* RE = CUMULATIVE COUNT OF ERRORS(NOT WARNINGS) THOURGHOUT SECTION. * 18042000 +OUTERR L RD,AVREBPT GET POINTER TO ERRORS 18044000 + USING REBLK,RD NOTE USING 18046000 + LH RE,AVNERRA GET ACTUAL # ERRORS 18048000 + LH R14,AVSTMTER GET TOTAL # STMT ERRORS 18050000 + LA R14,1(R14) INCREMENT TO SHOW 1 MORE STMT FLAGD 18052000 + STH R14,AVSTMTER STORE BACK UPDATED POINTER 18054000 + SR R2,R2 CLEAR FOR INSERTION 18056000 + IC R2,REBLN GET TOTAL ELNGTH OF ERROR BLOCK 18058000 + SRL R2,1 DIVIDE BY TO=#ERRORS 18060000 + SR R1,R1 CLEAR FOR CONSTANT INSERTS 18062000 + SPACE 1 18063000 +OUTERR1 IC R1,REBSCN GET SCAN POINTER 18064000 + CLI RSBNUM,1 WAS THERE ONLY 1 STATEMENT 18066000 + BE OUTERR5 SKIP OVER MULTIPLE SECTION IF SO 18068000 + SPACE 1 18070000 +* SECTION FROM HERE TO OUTERR5 REQUIRED FOR MULT CARDS. * 18072000 + SR RC,RC CLEAR FOR INSERT 18074000 + IC RC,RSBNUM GET NUMBER OF CARDS 18076000 + SR R0,R0 CLEAR FOR INSERTS 18078000 +OUTERR3 IC R0,OUTOFFS-1(RC) GET LIMIT SCAN POINTER FOR CARD 18080000 + CR R0,R1 COMPARE WITH ERROR POINTER 18082000 + BH OUTERR4 BRANCH OUT IF CORRECT SPOT FOUND 18084000 + BCT RC,OUTERR3 LOOP FOR # OF CARDS 18086000 + B OUTERR5 NOT FOUND-WILL BE TOO HIGH 18088000 +OUTERR4 IC R0,OUTOFFS(RC) GET BEGINNING SCAN POINTER 18090000 + SR R1,R0 GET OFFSET FROM CARD BEGINNING 18092000 + LA R1,RSB$L(R1) ADD SCAN OFFSET FROM RSBLOCK 18094000 + IC R0,RSBNUM GET # OF CARDS 18096000 + CR R0,RC SEE IF SAME,I.E. IN 1ST CARDIMAGE 18098000 + BE OUTERR5 SKIP OVER-ITS IN 1ST CARD,SO OK 18100000 + LA R1,15(R1) CONTINUATION CARD-BUMP POINTER 18102000 + SPACE 1 18104000 +* FOLLOWING CONCLUDES PROCESSING FOR SINGLE CARD STMTS * 18106000 +OUTERR5 LA RC,OUTEOFF(R1) GET @ WHERE $ SHOULD GO 18108000 + LA R0,OUTEREND GERT LAST POSSIBLE SCAN POINTER 18110000 + CR R0,RC MAKE SURE POINTER NOT BEYOND END 18112000 + BNL *+6 SKIP IF OK 18114000 + LR RC,R0 USE LAST POSSIBLE OFFSET @ 18116000 +* RC = @ FOR $ SCAN POINTER AT THIS POINT. * 18118000 + IC R1,REBERR GET THE ERROR CODE 18118500 + AIF (&$OPTMS GT 2).OUOP1 SKIP IF BIG MEMORY 18118550 +* SMALL SPACE==> NO PTRS, JUST MULT CODE BY 3/2. 18118600 + LR RB,R1 MOVE ERROR CODE OVER 18118650 + SRL RB,1 ITS EVEN NUMBER, SO DIVIDE BY 2 18118700 + AR R1,RB = 3/2 CODE, DESIRED NUMBER 18118750 + LA RB,OUERRMS-3-1(R1) @-1 OF 3BYTE ERROR NUMBER 18118800 + AGO .OUOP2 18118850 +.OUOP1 ANOP 18118900 + LH RB,OUERRPT(R1) GET OFFSET TO ERROR MESSAGE 18119000 + LA RB,OUERRMS(RB) GET ACTUAL @ ERROR MESSAGE 18119500 +.OUOP2 ANOP 18119600 +* INCREMENT ERROR OR WARNING MESSAGE TOTAL COUNT. 18119700 + LA R15,1 SET UP FOR ERROR-WARNING INC 18120000 + CLI 1(RB),C'0' WAS ERR # FROM 000-099 (WARNING) 18122000 + BE *+10 YES, BRANCH IF IT IS A WARNING 18124000 + AR RE,R15 INCREMENT # ERRORS (AVNERRA) 18126000 + B *+12 BRANCH OVER WARNING CODE 18128000 + AH R15,AVNWARN INCREMENT # WARNING MESSAGES 18130000 + STH R15,AVNWARN PUT # WARNINGS BACK 18132000 + SPACE 1 18134000 +* SET UP MESSAGE, SCAN POINTER. PRINT MESSAGE. 18136000 + AIF (&$OPTMS GT 2).OUOP3 SKIP IF LARGE MEMORY 18136100 + MVC OUTERMS(3),1(RB) MOVE ERROR # INTO MSG 18136200 + AGO .OUOP4 SKIP REGUALR CODE 18136300 +.OUOP3 ANOP 18136400 + IC R1,0(RB) GET LENGTH-1 OF ERROR MESSAGE 18140000 + STC R1,OUTERR6+1 SAVE INTO BLANKING MVC 18142000 + STC R1,*+5 STORE TO MOVE MESSAGE INTO BUFFER 18144000 + MVC OUTERMS($CHN),1(RB) MOVE ERROR MESSAGE INTO BUFFER 18146000 +.OUOP4 ANOP 18147000 + MVI 0(RC),C'$' PLACE SCAN POINTER IN 18148000 + LA RA,OUTERROR SET UP @ ERROR LINE 18150000 + BAL R14,OUTLNS HAVE ERROR MESSAGE PRINTED 18152000 + SPACE 1 18153000 + AIF (&$OPTMS LE 2).OUOP5 SKIP IF SMALL MEMORY 18153500 +OUTERR6 MVC OUTERMS($CHN),OUBLDASH RESTORE BLANKS-DASHES 18154000 +.OUOP5 ANOP 18155000 + MVI 0(RC),C'-' FILL IN DASH WIPED BY $ 18156000 + LA RD,2(RD) INCREMENT ERROR BLOCK PTR 18158000 + BCT R2,OUTERR1 LOOP FOR NUMBER OF ERRORS 18160000 + SPACE 1 18162000 +* UPDATE ERROR COUNT & CHECK FOR EXCEEDING LIMIT. 18164000 + STH RE,AVNERRA STORE UPDATED ERROR COUNT 18166000 + CH RE,AVNERR COMPARE TO ERROR LIMIT 18168000 + BNH OUTRETA IF STILL OK,BRANCH 18170000 + OI AVTAGS1,AJNLOAD FLAG NOLOAD,NO MORE OBJECT CODE 18172000 + B OUTRETA GO RETURN 18174000 + EJECT 18176000 +* * * * * RB=$OUMACH - FORMAT LEFT-SIDE FOR MACHINE INSTRUCTIONS * * * 18178000 +OUMACH EQU * 18179000 + BCR NO,R14 RETURN UNLESS PRINT ON AND LIST 18180000 + L R14,AVRCBPT GET # RCB TO PICK UP INFO 18181000 + USING RCODBLK,R14 NOTE USING 18182000 + UNPK OULOC(7),RCLOC(4) UNPACK LOCATION COUNTER 18184000 + MVI OULOC+6,C' ' BLANK OT EXTRA BYE 18186000 + DROP R14 LOCATION COUNTER ALL THAT WAS NEEDED 18188000 + USING ICBLOCK,RC NOTE INSTRUCTION CODE BLOCK 18190000 +* RD = LENGTH-1 OF INSTRUCTION = 1,3,5. * 18192000 + UNPK OUOPR1R2(5),ICBOPR1R(3) GET OPCODE-R1-R2 FIELD 18194000 + MVI OUOPR1R2+4,C' ' BLANK OUT EXTRA BYTE 18196000 + C RD,AWF3 CHECK LENGTH-1 AND SET CC 18198000 + BL OUMACH1 ONLY 2 BYTE INSTRUCTION-QUIT 18200000 + UNPK OUOPN1(5),ICBOPN1(3) UNPACK 1ST BASE-DISP 18202000 + MVI OUOPN1+4,C' ' BLANK OUT END BYTE 18204000 + BE OUMACH1 IF RD=3,==> 4 BYTE INST-QUIT 18206000 + UNPK OUOPN2(5),ICBOPN2(3) 6-BYTE INST.UNPK 2ND B-D 18208000 + MVI OUOPN2+4,C' ' BLANK OUT END BYTE 18210000 + SPACE 1 18212000 +* OBJECT CODE ALL UNPACKED - NOW CHECK FOR INSTRUCT ADDRS* 18214000 +OUMACH1 TM ICBFLAG,$ICBEA1 WAS THERE A 1ST INST ADDR 18216000 + BZ OUMACH2 NO,DON'T LOOK FOR ONE 18218000 + UNPK OUEA1+1(6),ICBEA1+1(4) GET 5 BYTES OF ADDRESS OVE 18220000 +OUMACH2 TM ICBFLAG,$ICBEA2 WAS THERE A 2ND ADDRESS TO BE PRINTE 18222000 + BZ OUMACH3 NO THERE WASN'T,BRANCH 18224000 + UNPK OUEA2+1(6),ICBEA2+1(4) GET 5 BYTES OF ADDR 18226000 +OUMACH3 TR OUTLINE+1(OUTLENM),AWTHEX3 TRANSLATE TO FINISH 18228000 + B OUTSTMT GO HAVE STATEMENT PRINTED OUT 18230000 + SPACE 1 18232000 +* * * * * RB=$OUCONS - FORMAT LEFT-SIDE WITH LOC,CONSTANT IF NEEDED * * 18234000 +OUCONS EQU * 18235000 + BCR NO,R14 RETURN IF NOT PRINT ON, LIST 18236000 + L R14,AVRCBPT GET @ RCB FOR INFO THERE 18237000 + USING RCODBLK,R14 NOTE POINTER 18238000 + UNPK OULOC(7),RCLOC(4) CONVERT THE LOCATION COUNTER 18240000 + MVI OULOC+6,C' ' BLANK OT EXTRA BYE 18242000 + DROP R14 18244000 + LTR RD,RD IS LENGTH-1 <0,WHICH ==> NO CONSTANT 18246000 + BM OUCONS2 NO CONSTANT - TRANSLATE LOCCNTR&QUIT 18248000 + C RD,AWF7 IS LENGTH-1 > 7 18250000 + BNH *+8 SKIP NEXT IF WITHIN RANGE 18252000 + LA RD,7 USE ONLY 1ST 8 BYTES OF CONSTANT 18254000 + SPACE 1 18256000 + LA R14,0(RD,RD) GET 2*(L-1 OF CODE) FOR UNPACK LENGT 18258000 + LA R15,OUCONST(R14) SAVE @ LAST UNPACKED BYTE 18260000 + SLL R14,4 SHIFT OVER INTO 1ST NIBBLE OF LOW BT 18262000 + AR RD,R14 PUT LENGTHS INTO LOW-ORDER BYTE 18264000 + STC RD,*+5 STORE INTO UNPK INSTRUCTION 18266000 + UNPK OUCONST($CHN),0($CHN,RC) CONVERT CONST CODE 18268000 + UNPK 1(1,R15),0(1,R15) DUPLICATE AND REVERSE NIBBLES 18270000 + OI 0(R15),X'F0' MAKE DIGIT PRINTABLE 18272000 + OI 1(R15),X'F0' FIX UP LAST BYTE 18274000 +OUCONS2 TR OUTLINE+1(24),AWTHEX3 CONVERT OT HEX OUTPUT 18276000 + B OUTSTMT GO PRINT PUT STATEMENT 18278000 + EJECT 18280000 +* * * * * RB=$OULIST - LISTING CONTROL - SPACE,EJECT,PRINT,TITLE * * * 18282000 +OULIST EQU * ""=3 IF PRINT ON, LIST OPTION 18284000 + LH R15,OUJUMP2(RE) GET SECONDARY BRANCH CODE 18285000 +OUTJ2 B OUTJ2(R15) BRANCH TO STMT TYPE, DON'T CHANGE CC 18286000 + SPACE 1 18288000 +* * * * * OUSPEJ - PROCESS SPACE OR EJECT,USING # OF LINES TO BE SPACD* 18290000 +* AT THIS PT, CC MUST =3, ELSE NO SPACING DONE. 18292000 +OUSPEJ BCR NO,R14 QUIT, (RETURN TO OUTRETE 18294000 + LA RD,1 SET COUNTER CLEAR 18296000 + LA RA,AWBLANK @ BLANK LINE 18296050 + CLI 0(RC),255 REAL EJECT ? 18296100 + BE OUSPEJ1A YES, GO DO THE EJECT 18296200 + IC RD,0(RC) GET # OF LINES TO BE PSACED 18298000 +OUSPEJ1 SR RW,RD GET # LINES LEFT ON THIS PAGE 18298200 + BP OUSPEJ2 SKIP SOME LEFT - PRINT BLANK LINES 18298300 + LCR RD,RW # BLANKS TO BE PRINTED AFTER TITIL 18298400 + BZ OUTITL2 IF NO BLANK LINES, JUST RESET TITLE 18298500 +OUSPEJ1A BAL R14,OUTLNSTI HAVE TITLE LINES PRINTED 18298600 + B OUSPEJ1 LOOP-BE SAFE FOR PRINT 200 ETC 18298700 +OUSPEJ2 BAL R14,OUXPRNT PRINT 1 BLANK LINE 18298800 + BCT RD,OUXPRNT GO PRINT BLANK LINES 18308000 + B OUTRETA GO RETURN 18310000 + SPACE 1 18312000 +* * * * * OUPRINT - PROCESS PRINT INSTRUCTION. RC = @ CONTROL BYTE * 18314000 +OUPRINT MVC AVPRINT,0(RC) MOVE PRINT CONTROL BYTE OVER 18316000 + B OUTRETE NOT ON,GO CHECK FOR ERRORS 18332000 + SPACE 1 18334000 +* * * * * OUTITLE - BRING IN NEW TITLE,FLAG TITLE EXISTS,PRINT IF ON. * 18336000 +OUTITLE MVC OUHEADNG,AWBLANK BLANK THE HEADING OUT 18338000 + STC RD,*+5 STORE LENGTH-1 OF NEW TITLE INTO MVC 18340000 + MVC OUHEADNG($CHN),0(RC) MOVE NEW HEADING INTO FIEL 18342000 +OUTITL2 LA RW,1 SET COUNT SO WILL CREATER HEADER NXT 18344000 + B OUTRETE GO MAKE SURE THERE WAS NO ERROR 18352000 + SPACE 2 18354000 +OUCOMM EQU * COME HERE FOR COMMENTS, SPEC ERRS 18356000 + BCR NO,R14 PRINT OFF/NOLIST - RETURN 18357000 + B OUTSTMT PRINT LIST AND ON - GO PRINT STMT 18358000 + EJECT 18360000 +**--> INSUB: OUTLNSA/OUTLNS PRINT 1 LINE (WITH HEADING IF NEEDED)+ + + 18360050 +*+ PRINTS A 121 BYTE LINE, DECREMENTS REMAINING LINE COUNT. + 18360100 +*+ ENTRY CONDITIONS + 18360150 +*+ RA = @ 121-BYTE LINE TO BE PRINTED (OUTLNS ONLY). + 18360200 +*+ RW = LINE COUNT REMAINING. IF = 1, WILL PRODUCE HEADING. + 18360250 +*+ R14= RETURN @ TO CALLING SECTION OF CODE. + 18360300 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 18360350 + SPACE 1 18360400 +OUTLNSA LA RA,OUTLINE ENTRY FOR MOST COMMON @ 18360450 +OUTLNS BCT RW,OUXPRNT DECREMENT REMAINING, BRANCH IF OK 18360500 + SPACE 1 18360550 +* A HEADING AND PAGE SKIP ARE REQUIRED IF FALLS THRU HERE. 18360600 +OUTLNSTI LR RW,RA SAVE ORIG LINE @ PTR INTO RW 18360650 + LR R15,R14 SAVE THE ORIGIANL RETURN @ IN R15 18360700 + SPACE 1 18362000 + AP OUPGCNT,AWP1 INCREMENT PAGE COUNT 18366000 + MVC OUPCNT,AWEP4 MOVE EDIT PATTERN OVER 18368000 + ED OUPCNT,OUPGCNT EDIT PAGE COUNT OVER 18370000 + LA RA,OUHEAD1 SHOW @ 1ST HEADING (TITLE) 18370100 + BAL R14,OUXPRNT PRINT IT 18370200 + LA RA,OUHEAD2 SHOW @ 2ND HEADNING 18370300 + BAL R14,OUXPRNT HAVE IT PRINTED 18370400 + SPACE 1 18370500 + LR RA,RW RESTORE OLD LINE @ 18370600 + LR R14,R15 RESTORE OLD RETURN @ 18370700 + SPACE 1 18370800 + LH RW,OUH#LINE GET # LINES LEFT TO DO 18370900 + MVI OUHEAD1,C'1' MAKE SURE SET FOR PAGE SKIP 18371000 + MVC OUH#LINE,=AL2($OU#NORM) SET COUNTERSETTER NORMAL 18371100 +* FALL THRU INTO OUXPRNT TP PRINT STMT ITSELF. 18371200 + SPACE 1 18371300 +**--> INSUB: OUXPRNT LOW-LEVEL PRINT ROUTINE- 121-BYTE LINE + + + + 18380000 +*+ ROUTINE PRINTS 1 LINE (NORMAL), OR ELSE BRANCHS TO CMPRS + 18380050 +*+ OPTION CODE TO SAVE/PRINT 2 STMTS PER LINE, IF CMPRS CODE + 18380100 +*+ EXISTS AND USER SPECIFIES THE OPTION. + 18380150 +*+ ENTRY CONDITIONS + 18380200 +*+ RA = @ 121-CHARACTER LINE TO BE PRINTED + 18380250 +*+ R14= RETURN @ TO CALLING SECTION OF CODE. + 18380300 +*++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 18380350 + SPACE 1 18380400 +OUXPRNT EQU * ENTRY FOR PRINTING OR SAVING 18380450 + AIF (NOT &$CMPRS).OUXCM1 SKIP IF NO CMPRS CODE 18380500 + TM AVTAGS2,AJOCMPRS IS CMPRS OPTION IN EFFECT 18380550 + BO OUXCMINT YES, GO TO PROCESS NEW STMT 18380600 + SPACE 1 18398000 +.OUXCM1 ANOP 18400000 + $PRNT 0(RA),121 PRINT 1 NORMAL LINE 18401000 + BCR Z,R14 RETURN IF NO OVERFLOW 18401450 + OI AVTAGS2,AJOASTOP RECORDS OVER-SHOW FLAG FOR STOPPING 18401500 + BR R14 RETURN TO CALLING SECTION. 18402000 + AIF (NOT &$CMPRS).OUXCM2 SKIP IF NO CMPRS OPTION 18402010 + EJECT 18402020 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 18402030 +* CMPRS OPTION PROCESSING - 2 STMTS/LINE * 18402040 +* THIS SECTION PERFORMS ALL MANIPULATION AND PRINTING REQUIRED TO * 18402050 +* PRODUCE A LISTING IN WHICH THE FIRST HALF OF APPROX. 120 STMTS * 18402060 +* IS PRINTED ON THE LEFT SIDE OF A PAGE, AND THE OTHER HALF ON THE * 18402070 +* OTHER SIDE, THUS REDUCING THE LINES PRINTED BY THE ASSEMBLER BY * 18402080 +* APPROXIMATELY 1/2. IT CONSISTS OF THE FOLLOWING STEPS: * 18402090 +* INITIALIZATION CODE: OUXCMINT : CONVERTS NONBLANK CARRIAGE * 18402100 +* CONTROL LINES TO BLANK LINES FOLLOWED BY ACTUAL LINES. * 18402110 +* ALSO SAVES REGISTERS WHICH WILL BE MODIFIED BY THIS SECTION. * 18402120 +* PHASE 'A' CODE : ENTERED FOR EACH LINE UNTIL ENTIRE LHS OF PAGE * 18402130 +* IS STORED, THEN SETS FLAGS FOR PHASE 'B'. * 18402140 +* PHASE 'B' CODE : OUXCMB : BUILD AND PRINT LINE CONSISTING OF * 18402150 +* ONE STMT SAVED DURING PHASE 'A' AND THE LINE JUST GIVEN. * 18402160 +* WHEN ALL SAVED STMTS HAVE BEEN PRINTED, RESET TO PHASE 'A'. * 18402170 +* **NOTE** THIS SECTION IS ALSO USED FROM OUEND2 ENTRY. * 18402180 +* REGISTER USAGE IN THIS SECTION * 18402190 +* RA = @ INCOMING LINE TO BE PRINTED. * 18402200 +* RB = @ CMPRS WORKAREA (OUCMPRSD DSECT) * 18402210 +* RC = @ NEXT EMPTY STMT SLOT, NEXT TO BE PRINTED / WORK REG. * 18402220 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 18402230 + SPACE 1 18402240 +**--> INSUB: OUXCMINT ENTRY POINT FOR CMPRS HANDLING + + + + + + + + 18402250 +* INITIAL SECTION - CHECK FOR NONBLANK CARRIAGE CONTROL. + 18402260 +* ENTRY CONDTIONS (ENTIRE SECTION) + 18402270 +* RA = @ 121-BYTE LINE IMAGE FOR OUTPUT (OUSTMTIM DSECT) + 18402280 +* R14= RETURN @ TO CALLING SECTION OF CODE + 18402290 +* *NOTE* MODIFIES NO REGISTERS, DOES USE AVDWORK1&AVDWORK2. + 18402300 +* NAMES: OUXCM--- + 18402310 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 18402320 + SPACE 1 18402330 + USING OUSTMTIM,RA NOTE DSECT FOR CONVENIENCE 18402340 +OUXCMINT STM RA,RC,AVDWORK1 INTO AVDWORK1,AVDWORK2 D'S 18402350 + CLI OUSTCC,C' ' WAS CARRIAGE CONTROL NORMAL ' ' 18402360 + BE OUXCMPRT YES, DON'T NEED DO FIXUP-BRANHC 18402370 + SPACE 1 18402380 +* NONBLANK CC - INSERT BLANK LINE, SAVING/RESTORING REGS. 18402390 + ST R14,AVDWORK2+4 SAVE INTO TEMPORARY AREA 18402400 + LA RA,AWBLANK SHOW @ BLANK LINE 18402410 + BAL R14,OUXCMPRT CALL INTERIOR SECTION 18402420 + L RA,AVDWORK1 RESTORE ORIG LINE @ 18402430 + L R14,AVDWORK2+4 RESTORE REAL RETURN @ 18402440 + SPACE 1 18402450 +* OUXCMPRT - GET WORKAREA @, CHOOSE CURRENT PHASE A,B 18402460 +OUXCMPRT L RB,OUCMPRAD GET @ CMPRS CONTROL BLOCK 18402470 + USING OUCMPRSD,RB NOTE THE POINTER 18402480 + TM OUCMPHAS,OUCMPHSB IS IT PHASE B (PRINTOUT) 18402490 + BO OUXCMB YES, SO GO TO PRINT OUT 2 STMTS 18402500 + EJECT 18402510 +* PHASE 'A' - SAVE STMT IMAGES UNTIL AREA FULL. 18402520 + L RC,OUCMSTMT GET @ NEXT SLOT FOR STMT SEGMENT 18402530 + MVC 0(OUCM$L1,RC),OUSTP1 GET 1ST SECTION OF STMT 18402540 + MVC OUCM$L1(OUCM$L2,RC),OUSTP2 2ND STMT SECTION (SOURCE) 18402550 + LA RC,OUCM$LT(RC) INCREMENT SLOT PTR TO NEXT ONE 18402560 + ST RC,OUCMSTMT STORE UPDATED SLOT PROINTER BACK 18402570 + SPACE 1 18402580 + LH RC,OUCMLEFT GET # EMPTRY SLOTS LEFT THIS TIME 18402590 + S RC,AWF1 DECREMENT # EMPTRY SLOTX 18402600 + STH RC,OUCMLEFT RESTORE UPDATED # SLOTS 18402610 + BP OUXCMRET IF SLOTS LEFT, GO TO EXIT CODE 18402620 + SPACE 1 18402630 +* NO EMPTY SLOTS LEFT FOR STMTS. RESET VARIABLES AND 18402640 +* FLAG SO ENTERS PHASE 'B' OF CMPRS PROCESSING NEXT TIME. 18402650 +OUXCMA1 LA RC,OUCMSAVE INIT @ TO 1ST SAVED STMT 18402660 + ST RC,OUCMSTMT INIT PTR TO 1ST SAVED STMT 18402670 + MVC OUCMLICC,OUCMCCIN INIT CARRIAGE CONTROL 1ST STMT 18402680 + MVI OUCMCCIN,C'1' MAKE SURE NEW PAGE FOR PAGES 2- 18402690 + OI OUCMPHAS,OUCMPHSB SHOW NOW PHASE 'B' 18402700 + B OUXCMRET GO TO RETURN CODE 18402710 + SPACE 2 18402720 +* PHASE 'B' - RETIRIEVE AND PRINT SAVED STMT WITH NEW 1. 18402730 +OUXCMB L RC,OUCMSTMT GET @ NEXT STMT TO PRINT 18402740 + MVC OUCMSTMA,0(RC) MOVE THE STMTS TO PRINT AREA 18402750 + MVC OUCMSTMB(OUCM$L1),OUSTP1 GET 1ST SECTION OF NEW 1 18402760 + MVC OUCMSTMB+OUCM$L1(OUCM$L2),OUSTP2 2ND SECT OF NEW 18402770 + $PRNT OUCMLINE,133 PRINT THE ENTIRE LINE, 2 STMTS 18402780 + BM OUXCMOVR OVER NOW ON PRINTER-STOP 18402785 + SPACE 1 18402790 + MVI OUCMLICC,C' ' MAKE SURE CC IS ' ' FOR REST OF PAGE 18402800 + LA RC,OUCM$LT(RC) INCREMENT PTR TO NEXT SAVED STMT 18402810 + ST RC,OUCMSTMT STORE BACK UPDATE PTR @ 18402820 + SPACE 1 18402830 + LH RC,OUCMLEFT GET # EMPTY SLOTS LEFT 18402840 + LA RC,1(RC) INCREMNT # EMPTY (JUST PRINTED 1) 18402850 + STH RC,OUCMLEFT RESTORE UPDATED # EMPTRY SLOTS 18402860 + CH RC,OUCMOPAG IS EMPTY # = # ON PAGE 18402870 + BL OUXCMRET NO, STILL MORE TO DO, RETURN 18402880 + SPACE 1 18402890 +* HAVE PRINTED ALL SAVED STMTS, RETURN TO PHASE 'A' 18402900 + LA RC,OUCMSAVE GET @ FIRST SLOT 18402910 + ST RC,OUCMSTMT RE-INIT TO @ FIRST SLOT 18402920 + LA RC,$OU#LNS NORMAL # LINES PER PAGE 18402930 + STH RC,OUCMOPAG SET # ON PAGE TO NORMAL # FOR SURE 18402940 + STH RC,OUCMLEFT SET COUNTER VALUE NORMAL TOO 18402950 + NI OUCMPHAS,255-OUCMPHSB REST TO PHASE 'A' 18402960 + SPACE 1 18402970 +* OUXCMRET - EXIT CODE - RESTORE REGS,RETURN 18402980 +OUXCMRET LM RA,RC,AVDWORK1 RESTORE REGS FROM SAVED WORDS 18402990 + BR R14 RETURN TO CALLING SECTION OF CODE 18403000 +OUXCMOVR OI AVTAGS2,AJOASTOP FLAG OVERRRUN 18403003 + B OUXCMRET GO TO EXIT FROM CMPRS SECTION 18403006 + DROP RA,RB REMOVE USINGS 18403010 +.OUXCM2 ANOP 18403020 + EJECT 18404000 +**--> ENTRY: OUEND2 2 PRINT ENDING STATISTICS FOR ASSMBLY . . . . . 18406000 +*. OUEND2 IS CALLED AT THE END OF THE ASSEMBLY TO PRINT SUMMARY . 18406100 +*. OF ERRORS AND WARNINGS ISSUED. FIRST LINE PRINTED GIVES . 18406200 +*. TOTAL # OF STMTS FLAGGED, TOTAL # ERRORS, TOTAL # WARNINGS. . 18406300 +*. IF MAXIMUM # ERRORS IS EXCEEDED, ANOTHER LINE IS PRINTED. . 18406400 +*. USES DSECTS: AVWXTABL . 18406500 +*. USES MACROS: $PRNT,$RETURN,$SAVE . 18406600 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 18408000 +OUEND2 $SAVE SA=NO 18410000 + AIF (NOT &$CMPRS).OUENC1 SKIP IF NO COMPRS CODE 18410020 + SPACE 1 18410040 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 18410060 +* CMPRS OPTION COMPLETION CODE * 18410080 +* SET UP COMMON USING CONDITIONS WITH OUTPT2, AND TEST * 18410100 +* FOR CMPRS OPTION IN EFFECT. IF IT IS, THEN HAVE ANY * 18410120 +* STATEMENTS PRINTED WHICH HAD BEEN SAVED, BUT NOT YET * 18410140 +* PRINTED. * 18410160 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 18410180 + SPACE 1 18410200 + TM AVTAGS2,AJOCMPRS DID USER SPECIFY CMPRS OPTION 18410220 + BZ OUENCMNO NO HE DIDNT, SKIP 18410240 + SPACE 1 18410260 + STM R14,RX,12(R13) STORE REGS, ESPEC RX,R14 18410280 + L RX,=A(OUTPT2) GET ADDR (SAFE IN OVERLAY) J 18410300 + DROP R15 REMOVE OLD USING 18410320 + USING OUTPT2,RX NOTE COMMON USING WITH OUTPT2 18410340 + SPACE 1 18410360 +* TEST PHASE OF CMPRS HANDLING. IF STMTS LEFT, SET TO 18410380 +* PHASE B TO DUMP THOSE LEFT, IF NOT ALREADY PHASE B. 18410400 + L RB,OUCMPRAD GET @ CONTROL BLOCK FOR CMPRS 18410420 + USING OUCMPRSD,RB NOTE CONTROL BLOCK USING 18410440 + TM OUCMPHAS,OUCMPHSB ARE WE IN PHASE B ALREADY 18410460 + BO OUENPHSB YES, JUMP TO FINISH 18410480 + BAL R14,OUXCMA1 IN PHASE A, CALL THIS TO SET TO B 18410500 + L RB,OUCMPRAD RELOAD RB, WHICH WAS ERASED 18410520 + SPACE 1 18410540 +* CMPRS HANDLER IN PHASE 'B' - PRINT ANY REMAINING STMTS 18410560 +OUENPHSB LH RD,OUCMOPAG GET # ON PAGE 18410580 + SH RD,OUCMLEFT DIFFERENCE = # LEFT TO DO 18410600 + BNP OUENCMDN NO STMTS LEFT, NO PRINTING NEEDED 18410620 + LA RA,AWBLANK SHOW @ FAKE BLANK LINE 18410640 + SPACE 1 18410660 + BAL R14,OUXCMINT GO TO PRINT 1 MORE STMT/BLANK LINE 18410680 + BCT RD,*-4 LOOP UNTIL ALL LINES LEFT PRINTED 18410700 + SPACE 1 18410720 +OUENCMDN LM R14,RX,12(R13) RESTORE REGS, ESP RX,R14 18410740 + DROP RB REMOVE USING 18410760 + USING OUEND2,R15 RESTORE REGULAR USING 18410780 + EJECT 18410800 +OUENCMNO EQU * NORMAL OUEND2 PROCESSING 18410820 +.OUENC1 ANOP 18410840 + SPACE 1 18411000 + TM AVTAGS3,AVOVERFL DID OVERFLOW OF STORAGE OCCUR 18411100 + BZ OUNOVRFL NO, DON'T PRINT MSG 18411200 + $PRNT OUAS999,OUAS999L PRINT THE MESSAGE 18411300 +OUNOVRFL EQU * BRANCH HERE IF STORAGE OK 18411400 + SPACE 1 18411500 + ZAP AVDWORK1,OULNCNT MOVE LINE COUNT OVER FOR CONVERT 18412000 + CVB RE,AVDWORK1 CONVERT THE LINE COUNT TO BINARY 18414000 + STH RE,AVSTMTNO SAVE AS NUMBER OF STATEMENTS 18416000 + SPACE 1 18418000 + LH RE,AVSTMTER GET # STATEMENTS FLAGGED 18420000 + LA RD,OUSTMTER GET @ TO PUT RESULT 18422000 + BAL RC,OUENCONV GO CONVERT VALUE 18424000 + SPACE 1 18426000 + LH RE,AVNWARN # WARNINGS ISSUED 18428000 + LA RD,OUNWARN @ FOR RESULT 18430000 + BAL RC,OUENCONV GO CONVERT VALUE 18432000 + SPACE 1 18434000 + LH RE,AVNERRA ACTUAL # ERRORS 18436000 + LA RD,OUNERRA @ FOR RESULT 18438000 + BAL RC,OUENCONV CONVERT VALUE 18440000 + $PRNT OUEND2M,OUEND2ML PRINT 1ST MESSAGE 18442000 + SPACE 1 18444000 + LH RE,AVNERR GET LIMIT # ERRORS 18446000 + CH RE,AVNERRA COMPARE TO ACTUAL 18448000 + BNL OUENDREA SKIP TO EXIT CODE IF OK 18450000 + SPACE 1 18451000 + LA RD,OUNERR GET @ FOR CONVERTED RESULT 18452000 + BAL RC,OUENCONV GO CONVERT ACTUAL # 18454000 + $PRNT OUEND2N,OUEND2NL PRINT 2ND MESSAGE 18456000 + SPACE 1 18457000 +OUENDREA EQU * EXIT CODE LABEL 18457050 + AIF (&$COMNT EQ 0).OUNCOM2 SKIP IF NO COMMENT CHEKCING 18457100 + EJECT 18457150 +* FINAL CHECK - IF COMMENT CHECK OPTION IN EFFECT, 18457200 +* MAKE SURE PROGRAMMER HAS SUPPLIED COMMENTS ON AT LEAST 18457250 +* &$COMNT PER CENT OF MACHINE INSTRUCTIONS. IF NOT, 18457300 +* DELETE HIS EXECUTION. SEE OUINT1 AND IAMOP1 FOR CODE. 18457350 + SPACE 1 18457400 + TM AVTAGS2,AJOCOMNT IS COMMENT OPTION IN EFFECT 18457450 + BZ OUENDRET NO, SO SKIP 18457500 + SPACE 1 18457550 + LH RE,AVMACHIN # MACHINE INSTRUCTIONS 18457600 + MH RE,=H'&$COMNT' * PERCENT REQUIRED TO HAVE COMMENTS 18457650 + LH RD,AVCOMNTN # COMMENTS ON THE MACH INSTRS 18457700 + MH RD,=H'100' BY 100 FOR COMPARISON 18457750 + CR RD,RE IS COMNTN>= MACHIN*&$COMNT/100 18457800 + BNL OUENDRET YES, SO HE HAD ENOUGH COMMENTS-OK 18457850 + SPACE 1 18457900 +* INSUFFICIENT COMMENTS - ZAP USER WITH MESSAGE. 18457950 + OI AVTAGS1,AJNLOAD NO EXECUTION 18458000 + $PRNT OUEND2P,OUEND2PL PRINT THE MESSAGE 18458050 + SPACE 1 18458100 +.OUNCOM2 ANOP 18458150 +OUENDRET $RETURN SA=NO RETURN TO CALLER 18458200 + SPACE 1 18460000 +* * * * * OUENCONV - CONVERT AND EDIT INTEGER TO 6 BYTE FIELD * 18462000 +* ENTRY CONDTIONS * 18464000 +* RC = RETURN @ TO CALLING SECTION * 18466000 +* RD = @ 6-BYTE FIELD WHERE CONVERTED AND EDITED RESULT TO BE PLACED* 18468000 +* RE = VALUE TO BE CONVERTED TO DECIMAL * 18470000 +* EXIT CONDTIONS * 18472000 +* 6-BYTE FIELD AT 0(RD) HAS EDITED RESULT, WITH 'NO' IF RE=0. * 18474000 +OUENCONV LTR RE,RE IS RESULT 0 18476000 + BZ OUENCONO YES, SO PU 'NO' IN 18478000 + CVD RE,AVDWORK1 CONVERT VALUE TO DECIMAL 18480000 + MVC 0(6,RD),AWEP6 MOVE 6-BYTE EDIT PATTERN IN 18482000 + ED 0(6,RD),AVDWORK1+5 EDIT THE FIELD 18484000 + BR RC RETURN TO CALLER 18486000 +OUENCONO MVC 0(6,RD),=CL6' NO ' VALUE = 0, USE 'NO' INSTEAD 18488000 + BR RC RETURN TO CALLER 18490000 + EJECT 18492000 +* * * * * INTERNAL CONSTANTS * 18494000 +* PRIMARY TYPE BRANCH OFFSETS * 18496000 +OUJUMP1 $AL2 OUTJ1,(OUMACH,OUCONS,OULIST,OUCOMM) 18498000 +* SECONDARY BRANCH OFFSETS FOR LISTING CONTROL. * 18500000 +OUJUMP2 $AL2 OUTJ2,(OUSPEJ,OUPRINT,OUTITLE) 18502000 + SPACE 1 18504000 +* * * * * INTERNAL VARIABLES * 18506000 +OUCOUNT EQU AVOUCOUN H, WITHIN-PAGE LINES REMAINING 18508000 +OULNCNT EQU AVOULNCN PL3 - STATEMENT # 18510000 +OUPGCNT EQU AVOUPGCN PL2 - # PAGES 18512000 +OUTOFFS DS ($RSMXCRD+1)C SPACE FOR SAVING OFFSETS FOR CARDS 18514000 +OUH#LINE DS H # LINES PER PAGE, EXCEPT HEADING 18514500 + AIF (NOT &$CMPRS).OUECMPA SKIP IF NO CMPRS MODE 18514600 +OUCMPRAD DS A @ OUCMPRSD AREA, IF CMPRS OPT USED 18514700 +.OUECMPA ANOP 18514800 + SPACE 1 18516000 +* PAGE HEADING 1 - TITLE FIELD,IF ANY, PAGE NUMBER * 18518000 + DS 0D ALIGNMENT FOR MODEL 65+ 18520000 +OUHEAD1 DS 0CL121 18522000 + DC CL8'1' CARRIAGE CONTROL 18524000 +OUHEADNG DS CL100 SPACE FOR TITLE FIELD 18526000 + DC CL9' PAGE ' 18528000 +OUPCNT DS ZL4 PAGE NUMBER 18530000 + SPACE 1 18532000 +* PAGE HEADING 2 - COLUMN HEADINGS AND DATE * 18534000 + DS 0D ALIGNMENT FOR MODEL 65+ 18536000 +OUHEAD2 DS 0CL121 18538000 + DC C'0 LOC ' CARRIAGE CONTROL, LOCATION COUNTER 18540000 + DC C'OBJECT CODE ADDR1 ADDR2 STMT SOURCE STATEMENT' 18542000 + DC CL54' ' 18544000 +OUDATE DC CL8' ' DATE (IF AVAILABLE) 18546000 + EJECT 18548000 +* OUTPUT BUFFER SETUP FOR ALL STATEMENTS * 18550000 + DS 0D ALIGNMENT FOR SPEED IN MODELS 65+ 18552000 +OUTLINE DS 0CL121 18554000 + DS C CARRIAGE CONTROL 18556000 +OULOC DS XL6 SPACE FORLOCATION COUNTER 18558000 + DS C 18560000 +OUCONST DS 0XL16 SPACE FOR UP TO 8 BYTES CONVERTED 18562000 +OUOPR1R2 DS XL4 SPACE FOR CONVERTED OPCODE-R1-R2 18564000 + DS C 18566000 +OUOPN1 DS XL4 CONVERTED 1ST BASE-DISPLACEMENT 18568000 + DS C 18570000 +OUOPN2 DS XL4 CONVERTED 2ND BASE DISPLACEMENT 18572000 +OUEA1 DS XL6 CONVERTED 1ST INSTRUCTION ADDRESS 18574000 +OUEA2 DS XL6 CONVERTED 2ND INSTRUCTION ADDRESS 18576000 + DS C 18578000 +OUTLENM EQU *-OULOC LENGTH FOR TRANSLATE: MACHINE OPS 18578010 + SPACE 1 18580000 +OUDSTMNT DS ZL5 STATEMENT NUMBER 18582000 + DS C BLANK OR PLUS 18584000 +OUTLEN EQU *-OUTLINE LENGTH FOR BLANKING ORIGINAL 18585000 +OUSOURCE DS 0CL80 SOURCE STATEMENT 18586000 +OUSOURC DS CL71 SOURCE CARD,WITHOUT CONT/SEQNO 18588000 +OUCONSQ DS CL9 CONTINUATION/SEQUENCE # FIELD 18590000 + SPACE 1 18592000 +* OUTPUT BUFFER SETUP FOR ERROR MESSAGES * 18594000 + DS 0D 18596000 +OUTERROR DS 0CL121 ERROR LINE 18598000 +OUTERRAS DC CL9' ----->AS' ERROR FLAG - LEFT 18600000 +OUTERMS DC CL32' ' SPACE FOR ERROR MESSAGE 18602000 +OUTEOFF EQU *-RSB$L OFFSET FROM SOURCE IMAGE 18604000 + DC 72C'-',CL8' <-ERROR' SPACE FOR $, END FLAG 18606000 +OUTEREND EQU *-9 @ LAST POSSIBLE SCAN POINTER 18608000 + AIF (&$OPTMS LE 2).OUOP5A SKIP IF SMALL MEMORY 18609000 +OUBLDASH DC CL(L'OUTERMS)' ',18C'-' FOR REBLANKING ERROR FIELD 18610000 +.OUOP5A ANOP 18611000 + SPACE 1 18612000 +* FINAL MESSAGE(S) ON STATEMENTS FLAGGED,WARNINGS,ETC. * 18614000 +* THIS SECTION USED BY ENTRYPT OUEND2. 18615000 +OUEND2M DC C'0***' 18616000 +OUSTMTER DC ZL6'0',C' STATEMENTS FLAGGED -' 18618000 +OUNWARN DC ZL6'0',C' WARNINGS,' # WARNINGS ISSUED 18620000 +OUNERRA DC ZL6'0',C' ERRORS' # ERRORS 18622000 +OUEND2ML EQU *-OUEND2M LENGTH OF THIS MESSAGE 18624000 + SPACE 1 18626000 +OUEND2N DC C'0***** NUMBER OF ERRORS EXCEEDS LIMIT OF' 18628000 +OUNERR DC ZL6'0',C' ERRORS - PROGRAM EXECUTION DELETED *****' 18630000 +OUEND2NL EQU *-OUEND2N LENGTH OF THIS ERROR MESSAGE 18632000 + AIF (&$COMNT EQ 0).OUNCOM3 SKIP IF NO COMMENT CHEK 18632100 +OUEND2P DC C'0***** EXECUTION DELETED - LESS THAN &$COMNT ' 18632200 + DC C'PER CENT OF MACHINE INSTRUCTIONS HAVE COMMENTS *****' 18632300 +OUEND2PL EQU *-OUEND2P GET LENGTH OF WHOLE MESSAGE 18632400 + SPACE 1 18632500 +.OUNCOM3 ANOP 18632600 + SPACE 1 18632800 +OUAS999 DC C'0AS999' MESSAGE NUMBER 18632810 + AIF (&$OPTMS LE 2).OUAS999 SKIP IF LOW CORE USAGE 18632820 + DC C' DYNAMIC STORAGE EXCEEDED' 18632830 +.OUAS999 ANOP 18632840 +OUAS999L EQU *-OUAS999 LENGTH OF MESSAGE 18632850 + LTORG 18634000 + EJECT 18636000 +* ERROR POINTERS AND ERROR MESSAGES * 18638000 +* FOR ADDRESSIBILITY, THIS SECTION SHOULD BE LAST. * 18640000 +* **NOTE** FOR SMALL COMPUTERS, THIS CODE CAN BE GREATLY * 18642000 +* BY MODIFYING MACRO $SERR TO GENERATE ONLY THE ERROR NUMBERS. * 18644000 + AIF (&$OPTMS LE 2).OUOP6 SKIP IF SMALL MEMORY 18645000 +* THE PROGRAM LOGIC REMIANS UNCHNAGED, BUT 1100 BYTES CAN BE * 18646000 +* SAVED WHICH ARE CURRENTLY TAKEN BY THE ERROR MESSAGES. * 18648000 +* THE TABLE CONSISTS OF 2 SECTIONS: A HALFWORD OFFSET * 18648100 +* @ LIST, AND A LIST OF MESSAGES CREATED BY $SERR'S, * 18648200 +* WHICH ARE POINTED TO BY THE OFFSET @'S. * 18648300 + SPACE 1 18648400 + DS 0H ALIGN ON HALF WORD BPUNDARY 18650000 +OUERRPT EQU *-2 . OFFSET TO 1 ' BACKWARDS 18652000 + DS (&$ERNUM/2)H . SPACE FOR HALFWORD ERROR POINTERS 18654000 +.OUOP6 ANOP 18654100 + EJECT 18655000 +OUERRMS EQU * BASE ADDRESS FOR ERROR MESSAGES 18656000 +ALIGN $SERR 'W-ALIGNMENT ERROR-IMPROPER BOUNDARY',000 18658000 +ENTRY $SERR 'W-ENTRY ERROR-CONFLICT OR UNDEFINED',001 18660000 +EXTRN $SERR 'W-EXTERNAL NAME ERROR OR CONFLICT',002 18662000 +RGNUS $SERR 'W-REGISTER NOT USED',003 18664000 +ODDRG $SERR 'W-ODD REGISTER USED-EVEN REQUIRED',004 18666000 +NOEND $SERR 'W-END CARD MISSING-SUPPLIED',005 18668000 +ADDR $SERR 'ADDRESSIBILITY ERROR',100 18670000 +CNLNG $SERR 'CONSTANT TOO LONG',101 18672000 +CNTYP $SERR 'ILLEGAL CONSTANT TYPE',102 18674000 +CONT $SERR 'CONTINUATION CARD COLS. 1-15 NONBLANK',103 18676000 +CONTX $SERR 'MORE THAN 2 CONTINUATION CARDS',104 18678000 +CXREL $SERR 'COMPLEX RELOCATABILITY ILLEGAL',105 18680000 +DCEXT $SERR 'TOO MANY OPERANDS IN DC',106 18682000 +DPCSE $SERR 'MAY NOT RESUME SECTION CODING',107 18684000 +DUPLF $SERR 'ILLEGAL DUPLICATION FACTOR',108 18686000 +EXGTA $SERR 'EXPRESSION TOO LARGE',109 18688000 +EXLTA $SERR 'EXPRESSION TOO SMALL',110 18690000 +ICNOP $SERR 'INVALID CNOP OPERAND(S)',111 18692000 +ILLAB $SERR 'LABEL NOT ALLOWED',112 18694000 +ILORG $SERR 'ORG VALUE IN WRONG SECTION OR TOO LOW',113 18696000 +INVCN $SERR 'INVALID CONSTANT',114 18698000 +INVDM $SERR 'INVALID DELIMITER',115 18700000 +INVF $SERR 'INVALID FIELD',116 18702000 +INVSY $SERR 'INVALID SYMBOL',117 18704000 +IVOPC $SERR 'INVALID OP-CODE',118 18706000 +MULDF $SERR 'PREVIOUSLY DEFINED SYMBOL',119 18708000 +NEABS $SERR 'ABSOLUTE EXPRESSION REQUIRED',120 18710000 +NODLM $SERR 'MISSING DELIMITER',121 18712000 +NOIMP $SERR 'FEATURE NOT CURRENTLY IMPLEMENTED',122 18714000 +NOOPR $SERR 'MISSING OPERAND',123 18716000 +NONAM $SERR 'LABEL REQUIRED',124 18718000 +RELOC $SERR 'RELOCATABLE EXPRESSION REQUIRED',126 18722000 +SDINV $SERR 'INVALID SELF-DEFINING TERM',127 18724000 +START $SERR 'ILLEGAL START CARD',128 18726000 +TLIT $SERR 'ILLEGAL USE OF LITERAL',129 18728000 +UNDEF $SERR 'UNDEFINED SYMBOL',130 18730000 +UNRV $SERR 'UNRESOLVED EXTERNAL REFERENCE',131 18732000 +VILCH $SERR 'ILLEGAL CHARACTER',132 18734000 +VPARN $SERR 'TOO MANY PARENTHESIS LEVELS',133 18736000 +VRELO $SERR 'RELOCATABLE VALUE USED WITH * OR /',134 18738000 +VSYNT $SERR 'SYNTAX',135 18740000 +VTMTR $SERR 'TOO MANY TERMS IN EXPRESSION',136 18742000 +VUNEX $SERR 'UNEXPECTED END OF EXPRESSION',137 18744000 +INTPT $SERR 'STATEMENT CAUSED INTERRUPT',138 18746000 + AIF (NOT &$MACROS).OUSERR1 SKIP IF NO MACROS 18746050 +ILOPR $SERR 'OPERAND NOT ALLOWED',201 18746052 +STMNA $SERR 'STATEMENT OUT OF ORDER',202 18746054 +SSDIM $SERR 'SET SYMBOL DIMENSION ERROR',203 18746056 +INSBV $SERR 'INVALID NBR OF SUBSCRIPTS',204 18746058 +ILCNV $SERR 'ILLEGAL CONVERSION',205 18746060 +MISQU $SERR 'MISSING QUOTES IN CHAR EXPR',206 18746062 +ILMNM $SERR 'ILLEGAL OR DUP MACRO NAME',207 18746064 +MXDMD $SERR 'OPRND NOT COMPATIBLE WITH OPRTR',208 18746066 +UNDKW $SERR 'UNDFND OR DUP KEYWORD',209 18746068 +EXMAC $SERR 'MNEST LIMIT EXCEEDED',210 18746070 +ILAT $SERR 'ILLEGAL ATTRIBUTE USE',211 18746072 +MEXST $SERR 'GENERATED STMT TOO LONG',212 18746074 +OVRGN $SERR 'GENERATED STMTS OVERWRITTEN',298 18746100 +.OUSERR1 SPACE 1 18746150 + DROP RAT,R2,RC,RD,RX,RZ REMV USINGS 18748000 + AIF (NOT &$CMPRS).OUCMDSE SKIP IF NO CMPRS CODE 18748020 + EJECT 18748040 +**--> DSECT: OUCMPRSD CONTROL BLOCK FOR OUTPUT CMPRS OPTION . . . . . 18748060 +*. THIS BLOCK DESCRIBES AREA USED BY OUTPT2 WHEN DOING THE . 18748080 +*. CMPRS LISTING OPTION (2 STMTS/LINE). IT CONTAINS VARIABLES, . 18748100 +*. FLAGS, AND SPACE FOR $OU#NORM PARTIAL CARD IMAGES, WHICH . 18748120 +*. ARE SAVED AND USED FOR THE LEFT-HAND-SIDE OF THE PAGE. . 18748140 +*. THIS BLOCK IS ALLOCATED SPACE ONLY IF THE CMPRS PARM IS . 18748160 +*. USED. THE @ OUCMPRSD IS STORED IN OUCMPRAD VARIABLE. . 18748180 +*. LOCATION: IN DYNAMIC AREA, ACQUIRED BY $ALLOCH IN OUINT1. . 18748200 +*. NAMES: OUCM---- . 18748220 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 18748240 + SPACE 1 18748260 +OUCMPRSD DSECT 18748280 +* LENGTH EQUS FOR PARTS OF STMT ACTUALLY PRINTED/SAVED. 18748300 +OUCM$LT EQU (&$PRTSIZ-3)/2 TOTAL # BYTES SAVED PER CMPRS STMT 18748320 +OUCM$L1 EQU OUEA1-OULOC # BYTES IN FIRST PART OF STMT 18748340 +OUCM$L2 EQU OUCM$LT-OUCM$L1 # BYTES SAVED, FROM OUDSTMT-1 18748360 + SPACE 1 18748380 +* CMPRS OPTION PHASE EQUATE FLAGS. 18748400 +OUCMPHSB EQU B'00000001' (OUCMPHAS)- PHASE B - PRINTING CARDS 18748420 + SPACE 1 18748440 +* CMPRS PROCESSING VARIABLES. 18748460 +OUCMSTMT DS A @ SLOT FOR NEXT CARD SAVED/PRINTED 18748480 +OUCMOPAG DS H # STMTS TOTAL ON CURRENT PAGE 18748500 +OUCMLEFT DS H # SLOTS LEFT/ # ALREADY PRINTED 18748520 +OUCMPHAS DS B PHASE FLAG - A OR B. 18748540 +OUCMCCIN DS C CARRIAGE CONTROL INIT - '0' OR '1' 18748560 + SPACE 1 18748580 +* STATEMENT ASSEMBLY AREA - HOLDS BOTH HALVES OF A 18748600 +* LINE FOR PRINTING, DURING PHASE B OF PROCESSING. 18748620 + DS 0F ALIGN FOR POSSIBLE SPEED 18748640 +OUCMLINE DS 0CL133 18748660 +OUCMLICC DS C CARRIAGE CONTROL BYTE 18748680 +OUCMSTMA DS CL(OUCM$LT) SPACE FOR CARD SAVED IN PHASE A 18748700 +OUCMBREK DS CL2' ' BREAK - MUST INIT TO C' ' 18748720 +OUCMSTMB DS CL(OUCM$LT) SPACE FOR CARD FROM PHASE B 18748740 + SPACE 1 18748760 +* CARD SEGMENT SAVE AREA - DURING PHASE A, ENOUGH CARDS 18748780 +* ARE SAVED HERE FOR LEFT-HAND-SIDE OF PAGE. 18748800 +OUCMSAVE DS ($OU#LNS)CL(OUCM$LT) 1 PAGE OF STMT SEGMENTS 18748820 + SPACE 1 18748840 +OUCMPR$L EQU ((*-OUCMPRSD+3)/4)*4 DSECT TOTAL LENGTH, ROUNDED 18748860 + SPACE 2 18748880 +**--> DSECT: OUSTMTIM STATEMENT IMAGE USED IN OUTPUT . . . . . . . . 18748900 +*. USED IN CMPRS OPTION HANDLER OF OUTPT2 TO ACCESS PORTIONS . 18748920 +*. OF INCOMING STATEMENTS TO BE SAVED. . 18748940 +*. NAMES: OUST---- . 18748960 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 18748980 + SPACE 1 18749000 +OUSTMTIM DSECT 18749020 +OUSTCC DS C CARRIAGE CONTROL 18749040 +OUSTP1 DS CL(OUCM$L1) FIRST PART - LOC, OBJ CODE 18749060 + DS 2XL6 SKIP ADDR1-ADDR2, DON'T SAVE 18749080 +OUSTP2 DS CL(OUCM$L2) 2ND PART - STMT #, PART OF CARD 18749100 +.OUCMDSE ANOP 18749120 + TITLE '*** SCANRS - SCANNING ROUTINES -SCAN-BL,CO,EQ ***' 18750000 +**--> CSECT: SCANRS 1-2 SCANNING ROUTINES . . . . . . . . . . . . . . 18752000 +*. SCANRS CONTAINS VARIOUS UTILITY SCANNING ROUTINES. ALL 3 . 18752100 +*. ENTRIES TERMINATE SCANNING ON FINDING A BLANK. 1 ENTRY ALSO . 18752200 +*. STOPS FOR A COMMA, AND THE OTHER STOPS FOR AN EQUALS SIGN. . 18752300 +*. ****NOTE**** THIS ROUTINE MODIFIES TABLE AWTZTAB IN AVWXTABL.. 18752400 +*. IT MAY THEN CALL SDBCDX WITHOUT RESETTING THE TABLE. THIS . 18752500 +*. IS AN EXCEPTION TO THE RULE OF NOT PERMITTING MODIFICATION . 18752600 +*. TO AV------ SECTIONS WHEN CALLING ANOTHER MODULE. . 18752700 +*. CALLS SDBCDX . 18752800 +*. USES DSECTS: AVWXTABL . 18752900 +*. USES MACROS: $CALL,$RETURN,$SAVE,$SETRT . 18753000 +*. NAMES: SCAN---- . 18753100 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 18754000 +SCANRS CSECT 18756000 + $DBG 90,* 18758000 + USING AVWXTABL,RAT NOTE MAIN USING 18760000 + ENTRY SCANBL,SCANCO,SCANEQ 18762000 + SPACE 2 18764000 +**--> ENTRY: SCANEQ SCAN TO = OR BLANK(USED BY IAMOP1 FOR LITERA. 18766000 +*. ENTRY CONDITIONS . 18768000 +*. RA = SCAN POINTER . 18770000 +*. EXIT CONDITIONS . 18772000 +*. RA = SCAN POINTER TO = OR BLANK, OR ERROR IF ANY . 18774000 +*. RB = 0 IF SCAN OK, = ERROR CODE IF ERROR FOUND(IN SELF-DEF TRM). 18776000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 18780000 +SCANEQ $SAVE RGS=(R14-R2),SA=SCANSAVE SAVE REGS,SET UP SA @ 18782000 + $SETRT ('=',4) SET UP CODE FOR = 18784000 + B SCANGO GO TO COMMON SECTION OF CODE 18786000 + SPACE 2 18790000 +**--> ENTRY: SCANCO SCAN TO COMMA OR BLANK (USED BY A-TYPE ADCON. 18792000 +*. ENTRY AND EXIT CONDITIONS SAME AS SCANEQ . 18794000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 18798000 +SCANCO $SAVE RGS=(R14-R2),SA=SCANSAVE SAVE REGS,SET UP SA @ 18800000 + $SETRT (',',4) SET THE SCAN CODE FOR , 18802000 + B SCANGO GO TO COMMON SECTION OF CODE 18804000 + SPACE 2 18808000 +**--> ENTRY: SCANBL SCAN TO BLANK ONLY. . . . . . . . . . . . . . 18810000 +*. ENTRY AND EXIT CONDITIONS SAME AS SCANEQ . 18812000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 18816000 +SCANBL $SAVE RGS=(R14-R2),SA=SCANSAVE,BR=R13 SAVE REGS, SET UP SA @ 18818000 +* FALL THRU INTO COMMON SECTION OF CODE, SCANGO. 18820000 + EJECT 18822000 +* * * * * COMMON CODE SECTION FOR SCANNING AND RESETTING TRT TABLE * 18824000 +SCANGO $SETRT (' ',4,'''',8) SET FOR QUOTE AND BLANK 18826000 + SR R1,R1 CLEAR FOR INSERTING ADDRESS 18828000 + SR R2,R2 CLEAR CODE INSERTION 18830000 + SR RB,RB CLEAR TO SHOW OK 18832000 +* INITIALIZATION DONE. REMAINDER IS SCAN LOOP * 18834000 +SCANTRT TRT 0(256,RA),AWTZTAB SCAN FOR ',BLANK OR EITHER = OR , 18836000 + LR RA,R1 MOVE THE SCAN POINTER OVER 18838000 + B *(R2) BRANCH APPROPRAITELY(CC=0 IMPOSSIB) 18840000 + B SCANRETA CHAR WAS =, OR BLANK-RETURN 18842000 + BCTR R1,0 CHAR WAS QUOTE-BACK UP TO SEE BEFORE 18844000 + CLI 0(R1),C'L' WAS THIS LENGTH ATTRIBUTE 18846000 + BNE SCANSDT NO-MUST BE SELF-DEFINING TERM-BRANCH 18848000 + LA RA,2(R1) INCREMENT SCAN POINTER PAST L' 18850000 + B SCANTRT GO BACK FOR NEXT SCAN 18852000 +* SELF-DEFINING TERM TENTATIVELY FOUND-CHECK * 18854000 +SCANSDT LR RA,R1 MOVE THE SCAN POINTER OVER 18856000 + $CALL SDBCDX CALL ROUTINE(RB=0==>SCAN ONLY) 18858000 + LTR RB,RB DETERMINE RESULT 18860000 + BP SCANRETA ERROR FOUND,RETURN WITH IT 18862000 + BM *+12 INVALID, ' BUT NOT X' B' C' L' 18864000 + CLI 0(RA),C'''' CHECK FOR CL21' ' TYPE ERROR IN OPRN 18866000 + BNE SCANTRT IF NOT,OK, CONTINUE, ELSE ERROR 18868000 + LA RB,$ERINVDM WE HAVE ',BUT NOTSDTRM-ERROR 18870000 +SCANRETA $SETRT (' ',0,'''',0,'=',0,',',0) REZERO ALL BYTES USED 18872000 + SPACE 1 18874000 +SCANRET $RETURN RGS=(R14-R2) RETURN TO CALLER 18876000 + DROP RAT,R13 CLEAN UP USING SITUATION 18878000 + TITLE '*** SDTERM - SELF-DEFINING TERM PROCESSORS ***' 18880000 +**--> CSECT: SDTERM SELF-DEFINING TERM CONVERSIONS. . . . . . . . . 18880100 +*. SDTERM INCLUDES AN ENTRY POINT FOR CONVERTING EACH TYPE OF . 18880200 +*. SELF-DEFINING TERM, AND AN ENTRY POINT WHICH FIRST DECIDES . 18880300 +*. WHICH TYPE(IF ANY) THE SCAN POINTER IS POINTING AT, THEN . 18880400 +*. BRANCHES TO THE CORRECT SECTION TO CONVERT THE TERM. . 18880500 +*. USES DSECTS: AVWXTABL . 18880600 +*. USES MACROS: $RETURN,$SAVE . 18882000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 18884000 +SDTERM CSECT 18886000 + $DBG 90,SNAP 18888000 + ENTRY SDBCDX,SDBTRM,SDCTRM,SDDTRM,SDXTRM 18890000 + USING AVWXTABL,RAT NOTE MAIN USING 18892000 + SPACE 2 18894000 +**--> ENTRY: SDBCDX 1-2 DETERMINE TYPE OF SELF-DEFINING TERM-CHECK. . 18896000 +*. DECIDE TYPE OF SELF-DEFINING TERM, BRANCH TO RIGHT SECTION. . 18897000 +*. ENTRY CONDITIONS . 18898000 +*. RA = SCAN POINTER TO BEGINNING OF TERM- TO C,B,X, OR 1ST DIGIT . 18900000 +*. EXIT CONDITIONS . 18902000 +*. RA = SCAN POINTER TO DELIMITER BEYOND TERM,(NOT ' ENDING B,C,X) . 18904000 +*. RB = 0 SELF DEFINING TERM WAS LEGAL . 18906000 +*. EB = >0 - ERROR CODE - ILLEGAL TERM ($ERSDINV) . 18908000 +*. RB = -4 ==> SCAN POINTER DID NOT POINT AT SELF-DEFINING TERM . 18910000 +*. RC = VALUE OF SELF-DEFINING TERM, FROM 0 TO 2**24-1 . 18912000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 18922000 +SDBCDX $SAVE SA=NO 18924000 + CLI 0(RA),C'0' CHECK FOR DIGITS 18926000 + BNL SDDTRM1 GO PROCESS DECIMAL FIELD 18928000 + CLI 1(RA),C'''' IS 2ND CAHR A ' 18930000 + BNE SDBCDX1 NO, SO RETURN SHOWING NO SELF-DEF TR 18932000 + CLI 0(RA),C'C' CHARACTER TYPE 18934000 + BH SDTX HIGHER THAN C,TRY X 18936000 + BE SDCTRM1 PROCESS C'---- 18938000 + CLI 0(RA),C'B' BINARY TYPE 18940000 + BE SDBTRM1 PROCESS BINARY TERM 18942000 + B SDBCDX1 EROR, NOT ONE OF THESE 18944000 +SDTX CLI 0(RA),C'X' HEXADECIMAL TYPE 18946000 + BE SDXTRM1 PROCESS HEX TERM 18948000 +SDBCDX1 L RB,AWFM4 PUT NEGATIVE 4 IN FOR RETURN CODE 18950000 + $RETURN SA=NO 18952000 + EJECT 18954000 +**--> ENTRY: SDBTRM 1-2 SCAN, COMPUTE BINARY SELF-DEFINING TERM . . . 18956000 +*. ENTRY,EXIT CONDITONS SAME AS SDBCDX, EXCEPT RB >= 0 ON EXIT. . 18957000 +*. NAMES: SDB----- . 18957500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 18958000 +SDBTRM1 BALR R15,0 SET UP ADDRESS AS EXPECTED ON ENTRY 18960000 +SDBTRM $SAVE RGS=NO,SA=NO 18962000 + LA RA,2(RA) INCREMENT BEYOND B' 18964000 + CLI 0(RA),C'''' MAKE SURE NOT NULL CONST 18966000 + BE SDBINVCN NULL CONSTANT-ILLEGAL 18968000 + SR RC,RC CLEAR REGISTER RESULT APPEARS IN 18970000 + LA RD,1 FOR LOOP INCREMENT 18972000 + LA RE,24(RA) FOR LIMIT ADDRESS 18974000 + SPACE 1 18975000 +SDBLOOP CLI 0(RA),C'0' CHECK FOR 0 18976000 + BE SDBLOOPB IF SO, JUST SHIFT RESULT 18978000 + CLI 0(RA),C'1' CHECK FOR A 1 18980000 + BNE SDBOUT BRANCH IF NOT, SHOULD BE ' 18982000 + AR RC,RD ADD A 1 INTO REGISTER 18984000 +SDBLOOPB AR RC,RC = SLL RC,1 - SHIFT TO NEXT 18986000 + BXLE RA,RD,SDBLOOP CONTINUE LOOPING 18988000 + BCT RA,SDBINVCN TOO LARGE, BACK UP AND FLAG 18990000 + SPACE 1 18991000 +SDBOUT CLI 0(RA),C'''' MAKE SURE DELIMETER IS ' 18992000 + BNE SDBINVCN IF NOT , ILLEGAL 18994000 + AR RA,RD POINT TO NEXT BEYOND 18996000 + SRL RC,1 SHIFT BACK FOR CORRECT RESULT 18998000 + SR RB,RB SHOW NO ERRORS 19000000 +SDBRET $RETURN SA=NO,RGS=NO 19002000 +SDBINVCN LA RB,$ERSDINV SHOW ILLEGAL 19004000 + B SDBRET RETURN 19006000 + EJECT 19008000 +**--> ENTRY: SDCTRM 1-2 SCAN, COMPUTE CHARACTER SELF-DEFINING TERM. . 19010000 +*. ENTRY,EXIT CONDITONS SAME AS SDBCDX, EXCEPT RB >= 0 ON EXIT. . 19011000 +*. NAMES: SDC----- . 19011500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 19012000 +SDCTRM1 BALR R15,0 SET UP ADDRESS AS EXPECTED ON ENTRY 19014000 +SDCTRM $SAVE RGS=NO,SA=NO 19016000 + SR RC,RC CLEAR REGISTER FOR RESULT 19018000 + LA RD,1 FOR USEFUL CONTANT 19020000 + AR RA,RD INCREMENT FOR C TO ' 19022000 + LA RE,4 LIMIT = MAX CHARS(3)+1 19024000 + SPACE 1 19026000 +* SCAN LOOP - CHECK FOR 'S AND &S AND LENGTH <4 BYTES. 19028000 +SDCLOOP AR RA,RD INCREMENT TO LOOK AT NEXT SLOT 19030000 + CLI 0(RA),C'''' IS IT A QUOTE 19032000 + BE SDCQUOT YES-BRANCH 19034000 + CLI 0(RA),C'&&' IS IT AN & 19036000 + BNE SDCNORM NO, GO DO NORMAL CASE 19038000 + AR RA,RD INCREMENT TO NEXT SLOT 19040000 + CLI 0(RA),C'&&' IS THIS ONE & ALSO 19042000 + BE SDCNORM 2 &&'S TOGETHER-OK 19044000 + B SDCINVCN INVALID - SINGLE & BY ITSELF 19046000 + SPACE 1 19048000 +SDCQUOT AR RA,RD LOOK AT NEXT CHAR 19050000 + CLI 0(RA),C'''' IS IS FOLLOWED BY ' 19052000 + BNE SDCOUT NO, IT IS END OF CONST 19054000 +SDCNORM SLL RC,8 SHIFT 1 CHRACTER WORTH 19056000 + IC RC,0(RA) GET THE CHARACTER 19058000 + BCT RE,SDCLOOP KEEP GOING-UP TO 24 BITS WORTH 19060000 + SPACE 1 19062000 + B SDCINVCN FELL THRU-MORE THAN 3 CHARS-ILLEGAL 19064000 +SDCOUT C RE,AWF3 WAS THERE A NULL CONSTANT 19066000 + BH SDCINVCA RE = 4 ==> NULL CONST,ILLEGAL 19068000 + SR RB,RB SHOW NO ERRORS 19070000 +SDCRET $RETURN RGS=NO,SA=NO 19072000 +SDCINVCA SR RA,RD NULL CONST-BACK UP SCAN PTR 1 19074000 +SDCINVCN LA RB,$ERSDINV SHOW INVALID 19076000 + B SDCRET GO RETURN 19078000 + EJECT 19080000 +**--> ENTRY: SDDTRM 1-2 CHECK OR CONVERT DECIMAL SELF-DEFINING TERM . 19082000 +*. ENTRY,EXIT CONDITONS SAME AS SDBCDX, EXCEPT RB >= 0 ON EXIT. . 19083000 +*. NAMES: SDD----- . 19083500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 19084000 +SDDTRM1 BALR R15,0 SET UP ADDRESS AS EXPECTED ON ENTRY 19086000 +SDDTRM $SAVE RGS=(R1-R2),SA=NO 19088000 + LR RD,RA DUPLICATE SCAN POINTER 19090000 + SR R1,R1 CLEAR FOR USE WITH TRT 19092000 + TRT 0(9,RD),AWTDECT TRANSLATE WITH DECIMAL TABLE 19094000 + BZ SDDINVCN MORE THAN 9 DIGITS, ERROR 19096000 + LR RA,R1 MAKE R1 NEW SCAN POINTER 19098000 + SR R1,RD SUBTRACT TO GET LENGTH 19100000 + BZ SDDINVCN IF ZERO LENGTH,ILLEGAL 19102000 + SPACE 1 19103000 + BCTR R1,0 GET LENGTH-1 FOR EXECUTE 19104000 + EX R1,SDDPACK PACK THE CHARS IN 19106000 + CVB RC,AVDWORK1 CONVERT THE NUMBER 19108000 + C RC,AWFX6F COMPARE TO HIGHEST VALUE 19110000 + BH SDDINVCM IF TOO BIG, BACK UP SCAN PTR,RETURN 19112000 + SPACE 1 19113000 + SR RB,RB SHOW NO ERRORS EXIST 19114000 +SDDRET $RETURN RGS=(R1-R2),SA=NO 19116000 +SDDINVCM BCTR RA,0 DECREMENT SCAN POINTER BY 1 19118000 +SDDINVCN LA RB,$ERSDINV SHOW INVALID SD TERM 19120000 + B SDDRET GO RETURN WITH ERROR 19122000 + SPACE 1 19124000 +SDDPACK PACK AVDWORK1(8),0($CHN,RD) PACK A DECIMAL FIELD 19126000 + EJECT 19128000 +**--> ENTRY: SDXTRM 1-2 SCAN, COMPUTE HEXADECIMAL SELF-DEFINING TERM. 19130000 +*. ENTRY,EXIT CONDITONS SAME AS SDBCDX, EXCEPT RB >= 0 ON EXIT. . 19131000 +*. NAMES: SDX----- . 19131500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 19132000 +SDXTRM1 BALR R15,0 SET UP ADDRESS AS EXPECTED ON ENTRY 19134000 +SDXTRM $SAVE RGS=(R1-R2),SA=NO 19136000 + LA RA,2(RA) INCREMENT PAST X' 19138000 + SR R1,R1 CLEAR FOR TRT 19140000 + TRT 0(7,RA),AWTHEXT CHECK FOR LEGALITY 19142000 + BZ SDXINVCX TOO LARGE, GO FLAG IT 19144000 + CLI 0(R1),C'''' CHECK FOR PROPER DELIMIETER 19146000 + BNE SDXINVCY INVALID CHARACTER,ERROR 19148000 + SPACE 1 19149000 + LR RD,RA SAVE THE SCAN POINTER 19150000 + LA RA,1(R1) INCREMENT THE SCAN POINTER 19152000 + SR R1,RD GET THE LENGTH 19154000 + BZ SDXINVCW NULL CONSTANT-BRANCH ERROR 19156000 + SPACE 1 19158000 + EX R1,SDXMOVE MOVE THE CONST+1 EXTRA BYTE OVER 19160000 + EX R1,SDXTRAN TRANSLATE THE BYTES APPROPRIATELY 19162000 + EX R1,SDXPACK PACK THEM TOGETHER 19164000 + L RC,AVDWORK1 LOAD FULLWORD VALUE INTO REG 19166000 + SR RB,RB SHOW LEGAL VALUE 19168000 +SDXRET $RETURN RGS=(R1-R2),SA=NO 19170000 + SPACE 1 19172000 +SDXINVCW BCT RA,SDXINVCN BACK UP SCAN PTR,GO RETURN ERR 19174000 +SDXINVCX LA R1,6(RA) TOO LONG-PLACE SCAN PTR RIGHT 19176000 +SDXINVCY LR RA,R1 MOVE SCAN POINTER OVER 19178000 +SDXINVCN LA RB,$ERSDINV INVALID SELF-DEFINING TERM 19180000 + B SDXRET GO RETURN 19182000 + SPACE 1 19184000 +SDXMOVE MVC AVDWORK2($CHN),0(RD) MOVE HEX TERM TO WORKAREA 19186000 +SDXTRAN TR AVDWORK2($CHN),AWTHEX2 CONVERT HEX TO BINARY 19188000 +SDXPACK PACK AVDWORK1(5),AVDWORK2($CHN) DO CORRECT PACK-INTERNAL 19190000 + DROP RAT,REP CLEAN UP USING 19192000 + TITLE '*** SYMOPS - ASSIST SYMBOL TABLE OPERATIONS ***' 19194000 +**--> CSECT: SYMOPS 1-2 ALL NORMAL SYMBOL TABLE OPERATIONS. . . . . . 19196000 +*. SYMOPS BUILDS, MAINTAINS, AND RETRIEVES FROM THE SYMBOL . 19196050 +*. TABLE OF THE ASSIST ASSEMBLER. THE SYMBOL TABLE IS A VIRUTAL. 19196100 +*. SCATTER TABLE, WITH CHAIN ORDERING BY A SECONDARY HASH CODE. . 19196150 +*. ALL SYMBOLS ARE HASHED INTO A SMALL PRIMARY POINTER TABLE. . 19196200 +*. EACH WORD IN THE PRIMARY TABLE POINTS TO A LINKED LIST OF . 19196250 +*. SYMBOLS HASHING TO THAT LOCATION IN THE PRIMARY TABLE. THE . 19196300 +*. SYMBOLS ARE ORDERED ON THE LIST IN DESCENDING ORDER BY THE . 19196350 +*. VALUE OF A SECOND HASH CODE, WHICH IS KEPT IN THE LINK . 19196400 +*. POINTER POINTING TO THE SYMBOL TO WHICH IT BELONGS. THIS . 19196450 +*. METHOD IS USED BECAUSE MAKES NO ASSUMPTIONS ABOUT THE FINAL . 19196500 +*. SIZE OF THE FINAL SYMBOL TABLE, PERMITTING ALLOCATION OF . 19196550 +*. ENTRIES FROM THE DYNAMIC AREA. IT ALSO PERMITS A VERY FAST . 19196600 +*. (3 FAST INSTRUCTIONS) MAJOR SEARCH LOOP, WHICH STILL GIVES . 19196650 +*. GOOD PERFORMACNE EVEN WITH A SMALL INITIAL POINTER TABLE . 19196700 +*. AND LONG LISTS OF SYMBOLS. . 19196750 +*. CALLS MOSTOP . 19196800 +*. USES DSECTS: AVWXTABL,SYMSECT . 19196850 +*. USES MACROS: $ALLOCH,$CALL,$RETURN,$SAVE . 19196900 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 19198000 + SPACE 1 19199000 +SYMOPS CSECT 19200000 + $DBG 90,* 19202000 +&$SYHASH SETA 8 SET UP 1ST VALUE 19204000 + AIF (&$OPTMS EQ 0).SYHA 19206000 +&$SYHASH SETA 16 TRY ALRGER VALUE 19208000 + AIF (&$OPTMS LE 3).SYHA SKIP IF NOW HAVE RIGHT VALUE 19210000 +&$SYHASH SETA 32 LARGER VALUE 19212000 + AIF (&$OPTMS LE 6).SYHA SKIP IF NOW HAVE VALUE 19214000 +&$SYHASH SETA 64 LARGEST VALUE CURRENTLY 19216000 +.SYHA ANOP 19218000 +* USING VALUE OF &$OPTMS, DETERMINE SIZE OF INITIAL POINT* 19220000 +* HASH TABLE. VALUES ARE (&$OPTMS)-&$SYHASH - * 19222000 +* (0)-8, (1-3)-16, (4-6)-32, (7-9)-64. THE RELATIVELY SMALL * 19224000 +* SIZES CAN BE TOLERATED BECAUSE OF THE SECONDARY KEY ORDERING.* 19226000 + SPACE 1 19228000 + ENTRY SYINT1,SYENT1,SYFIND,SYEND2 19230000 + USING AVWXTABL,RAT NOTE MAIN USING 19232000 + EJECT 19234000 +**--> ENTRY: SYINT1 1 INITIALIZE SYMBOL TABLE . . . . . . . . . . . 19236000 +*. OBTAINS SPACE FOR INITIAL POINTER TABLE, ZEROES IT. . 19238000 +*. ALSO SAVES THE ADDRESS OF THE INITIAL POINTER TABLE. . 19239000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 19240000 +SYINT1 $SAVE RGS=(R14-R6),SA=NO 19242000 + LM R0,R7,AWZEROS GET ZEROS FOR ZEROING HASH TABLE 19244000 + LA R10,32 # BYTES ZEROED BY EACH STM 19246000 + LA R11,4*&$SYHASH GET LENGTH OF INITIAL PTR TABLE 19248000 + $ALLOCH R9,R11,SYOVER ALLOCATE THE REQUIRED SPACE 19250000 + AR R11,R9 END TABLE @ = BEGIN TABLE @ + LENGTH 19252000 + SPACE 1 19254000 + SR R11,R10 BXLE LIMIT = END @ - LOOP INCREMENT 19256000 + ST R9,SYRA SAVE THE BEGIN TABLE @ FOR LATER 19258000 +SYIZERO STM R0,R7,0(R9) ZERO 32 BYTES OF INDEX TABLE 19260000 + BXLE R9,R10,SYIZERO CONTINUE ZEROING 19262000 + $RETURN RGS=(R14-R6),SA=NO 19264000 + EJECT 19266000 +**--> ENTRY: SYENT1 1 ENTER A SYMBOL INTO TABLE,RETURN ADDRESS. . . 19268000 +*. ENTRY CONDITIONS . 19270000 +*. RA = SCAN POINTER TO FIRST CHARACTER OF THE SYMBOL . 19272000 +*. RB = NUMBER OF CHARACTERS IN THE SYMBOL = 1 - 8 . 19274000 +*. EXIT CONDITIONS . 19276000 +*. RA = ADDRESS IN THE SYMBOL TABLE WHERE SYMBOL IS . 19278000 +*. RB = 0 THE SYMBOL WAS ALREADY PRESENT IN THE TABLE . 19280000 +*. = 4 THE SYMBOL WAS NOT ALREADY PRESENT IN THE TABLE . 19282000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 19284000 + AIF (NOT &$XREF).NOXRF19 19284100 +SYENT1 $SAVE RGS=(R14-R6),SA=SYXRSA,BR=R2 **NOTE ODD BASE REG*** 19284200 + AGO .NOXRF20 SKIP OLD SAVE MACRO 19284300 +.NOXRF19 ANOP 19284400 +SYENT1 $SAVE RGS=(R3-R6),SA=NO 19286000 +.NOXRF20 ANOP A 19286100 + LA RC,SYENTER SET UP FOR BRANCH LATER ON 19288000 + LA RW,SYRETB SET UP FOR BRANCH LATER L 19288050 + AIF (NOT &$XREF).NOXRF22 SKIP IF NO XREF A 19288100 + B SYXFINDX GO TO ROUTINE A 19288200 + AGO .NOXRF23 SKIP OLD CODE IF XREF A 19288350 +.NOXRF22 ANOP A 19288400 + LA REP,SYFIND SET UP FOR NEW USING 19290000 + USING SYFIND,REP SET SO BRANCH WILL WORK 19292000 + B SYFINDA GO TO COMMON CODE SECTION 19294000 +.NOXRF23 ANOP A 19294100 + SPACE 2 19296000 +**--> ENTRY: SYFIND 1-2 LOOK UP SYMBOL,REPORT PRESENCE/ADDRESS. . . . 19298000 +*. ENTRY CONDITIONS . 19300000 +*. RA = SCAN POINTER TO FIRST CHARACTER OF THE SYMBOL . 19302000 +*. RB = NUMBER OF CHARACTERS IN THE SYMBOL = 1 - 8 . 19304000 +*. EXIT CONDITIONS . 19306000 +*. RA = ADDRESS OF THE SYMBOL IN THE SYMBOL TABLE, IF IT IS THERE . 19308000 +*. RB = 0 THE SYMBOL IS IN THE TABLE . 19310000 +*. = 4 THE SYMBOL IS NOT IN THE TABLE . 19312000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 19314000 + AIF (NOT &$XREF).NOXRF24 A 19314100 +SYFIND $SAVE RGS=(R14-R6),SA=SYXRSA,BR=R2 ***NOTE ODD BASE REG A 19314150 + AGO .NOXRF25 A 19314200 +.NOXRF24 ANOP A 19314300 +SYFIND $SAVE RGS=(R3-R6),SA=NO 19316000 +.NOXRF25 ANOP A 19316100 + LA RC,SYRETA SET ADDRESS FOR LATER 19318000 + LA RW,SYRET SET UP FOR BRANCH LATER L 19318050 + AIF (NOT &$XREF).NOXRF88 SKIP IF NO XREF A 19318100 +SYXFINDX BALR R2,0 SET UP BASE REG A 19318200 + USING *,R2 A 19318300 +.NOXRF88 ANOP A 19318400 + SPACE 1 19320000 +* GET SYMBOL, PAD WITH BLANKS, GET LENGTH OF SYMBOL * 19322000 +* THE FOLLOWING CODE IS COMMON TO BOTH SYFIND AND SYENT1 * 19324000 +SYFINDA STC RB,SYCOMP2+1 SAVE THE LENGTH INTO CLC 19326000 + BCTR RB,0 DECRMENT LENGTH FOR MOVE 19328000 + MVC SYMTEMP,AWBLANK FILL WITH BLANKS FOR PADDING 19330000 + STC RB,SYMTEMPC SAVE VALUE IN FRONT OF SYMBOL 19332000 + STC RB,*+5 PUT LENGTH INTO MVC INSTRUCTION 19334000 + MVC SYMTEMP($CHN),0(RA) MOVE AND PAD SYMBOL 19336000 + EJECT 19338000 +* HASH SYMBOL, GET ADDRESS OF 1ST POINTER, GET 2ND HASH * 19340000 + LM RD,RE,SYMTEMP GET HALVES OF SYMBOL FOR HASHING 19342000 + MR RD,RD MULT 1ST HALF * 2ND HALF OF SYMBOL 19344000 + LM RX,RB,SYREGS GET WHOLE BLOCK OF REGS L 19346000 + NR RD,RZ COMPUTE PRIMARY HASH CODE 19348000 + AR RA,RD GET ADDRESS OF 1ST HASHTAB ENTRY 19350000 + USING SYMSECT,RA NOTE USAGE OF DSECT FROM NOW ON 19352000 +* FIRST HASH CODE COMPLETE. NOW GET SECONDARY HASH CODE. * 19354000 + SR RD,RD CLEAR REG OUT BEFORE SHIFTING CODE 19356000 + SLDL RD,8 MOVE 8 BITS FOR SECONDARY CODE 19358000 + LTR RD,RD IS SECONDARY CODE ZERO 19360000 + BNZ SYKEY2A IF NOT ZERO,OK 19362000 + LA RD,255 PUT THIS VALUE FOR SECONDARY KEY 19364000 +SYKEY2A STC RD,SYCOMP1+1 PLACE SECONDARY KEY INTO CLI INST 19366000 + BAL RE,SYCOMP1 SKIP L 1ST TIME,SET UP ADDR IN REG 19368000 + SPACE 1 19370000 +* FOLLOWING THREE INSTRUCTIONS - MAIN SEARCH LOOP * 19372000 +* EACH LOOP CHECKS SECONDARY CODE OF NEXT SYMBOL IN LIST.* 19374000 +SYLOOP1 L RA,SYLINK GET NEXT POINTER 19376000 +SYCOMP1 CLI SYHASH2,$CHN COMPARE SECONDARY CODES 19378000 + BCR H,RE BH SYLOOP1 - CONTINUE IF HIGH 19380000 + BCR L,RC BL SYENTER OR SYRETA IF NOT PRESENT 19382000 + SPACE 1 19384000 +* SEARCH LOOP FOR ACTUAL SYMBOL COMPARISON * 19386000 +* THIS IS ONLY ENTERED FOR SYMBOLS WITH IDENTICAL CODES * 19388000 +SYLOOP2 LR RE,RA DUPLICATE OLD POINTER VALUE 19390000 + L RA,SYLINK GET @ NEXT POINTER ON CHAIN 19392000 +SYCOMP2 CLC SYMTEMPC($CHN),SYCHARS COMPARE # OF CHARS,SYMBOLS 19394000 + BCR E,RW BE->SYRETB(PASS1),SYRET(PASS2) L 19396000 + EX 0,SYCOMP1 MAKE SURE SECONDARY IS SAME 19398000 + BCR E,RX BE SYLOOP2 - KEEP CHECKING 19400000 + LR RA,RE RESTORE REG POINTER FOR ENTRY 19402000 + BR RC B SYENTER OR SYRETA,DEPENDING 19404000 + SPACE 1 19406000 + SPACE 1 L 19406050 +* ENTERS PASS 2 WHEN SYMBOL IS IN SMBL TABLE (RB=0) L 19406100 +SYRET EQU * ENTER WHEN SYMBOL PRESENT L 19406200 + AIF (NOT &$XREF).NOXRF17 L 19406300 + TM AVXRFLAG,AVXRON FLAG MAY HAVE BEEN DISARMED(XRCOLL)L 19406400 + BZ SYRETB RETURN IF NOT ON (=0) L 19406500 + MVC AVFWORK1(1),AVXRFLAG SET UP FOR REF COLLECT TESTING L 19406600 + NC AVFWORK1(1),SYFLAGS AND WITH SD= BITS L 19406700 +* SEE IF MODIFY OR FETCH L 19406800 + TM AVXRTYPE,AVXRFTCH FETCH REFERENCE L 19406900 + BZ SYCKMOD NO,MODIFY REF L 19407000 + TM AVFWORK1,AVXRSRFT FETCH REFS? L 19407100 + BZ SYRETB NO, RETURN L 19407200 + B SYXRCALL GO COLLECTBREFS L 19407300 +SYCKMOD TM AVFWORK1,AVXRSRMD COLLECT MOD REFS? L 19407400 + BZ SYRETB NO,RETURN L 19407500 +SYXRCALL EQU * CALLING XRCOLL TO COLLECT REFERENCEL 19407600 + $CALL XRCOLL CALL COLLECTIMG ROUTINE L 19407700 + SR RB,RB SET RETURN CODE L 19407800 +.NOXRF17 ANOP F 19407850 + B SYRETB GO RETURN L 19407900 +* ENTER NEW SYMBOL-MUST HAVE BEEN CALLED AT SYENT1 * 19408000 +SYENTER CLI SYMTEMPC,4 CHECK FOR LENGTH 19410000 + BL *+8 L<=4==> LEAVE 4 IN RW-PREV LOADED 19412000 + LA RY,8 WILL NEED 8 BYTES L 19414000 + LA RC,SYMBOL-SYMSECT(RY) GET LENGTH OF ENTRY L 19416000 + $ALLOCH RE,RC,SYOVER GET NEEDED SPACE 19418000 + L RC,SYLINK GET THE OLD SYLINK-SYHASH2 FIELD 19420000 + ST RE,SYLINK SAVE THE POINTER INTO OLD POINTER 19422000 + STC RD,SYHASH2 SAVE 2ND HASH CODE IN THERE TOO 19424000 + LR RA,RE MAKE DSECT LOCATED AT NEW AREA 19426000 + ST RC,SYLINK STORE OLD SYLINK-SYHASH2 INTO NEW 19428000 + MVC SYVALUE(SYCHARS-SYVALUE),AWZEROS ZERO FLAGS,ETC 19430000 + STC RY,*+5 MOVE LENGTH INTO MVC L 19432000 + MVC SYCHARS($CHN),SYMTEMPC MOVE LENGTH&SYMBOL OVER 19434000 + SPACE 5 A 19434050 + AIF (NOT &$XREF).NOXRF55 SKIP ID NO CROSS REF A 19434100 +* THE FOLLWING SECTION OF CODE IS USED FOR THE CROSS REFERENCE A 19434150 +* FACILITY. THE BYTE SYFLAGS IS SET BY THE BITS IN AVXRFLAG, THIS A 19434200 +* ARE LATER TESTED TO SEE WHICH REFERENCES WE ARE COLLOECTING A 19434250 +* A 19434400 + TM AVXRFLAG,AVXRSDFT+AVXRSDMD ARE WE COLLECTIOG DEFS A 19434410 + BZ SYRETA NO, RETURN A 19434450 + LH RB,AVXRCNT GET # OF REFS COLLECTED A 19434500 + LA RB,1(RB) INCREASE BY ONE A 19434550 + STH RB,AVXRCNT RESTORE IT A 19434600 + IC RB,AVXRFLAG GET FLAG IN REG TO SET BITS A 19434650 + N RB,=A(AVXRSDFT+AVXRSDMD) FOR SETTING SYFLAGS L 19434655 + SRL RB,2 MOVE TO RIGHT POSITION A 19434660 + IC RY,SYFLAGS PREPARE TO OR FLAGS L 19434665 + OR RB,RY SET PROPER BITS IN SYFLAGS L 19434670 + STC RB,SYFLAGS STORE IT IN FLAG A 19434675 +.NOXRF55 ANOP A 19434700 + SPACE 1 19436000 +* RETURN,SHOWING SYMBOL PRESENT/NOT PRESENT/OVERFLOW * 19438000 +SYRETA LA RB,4 SHPW THE SYMBOL WAS NEW 19440000 +SYRETB EQU * A 19443200 + AIF (NOT &$XREF).NOXRF18 F 1944322 + $RETURN RGS=(R14-R6),SA=* RETURN IF XREF IS ON F 19443250 + AGO .NOXRF99 F 19443300 +.NOXRF18 ANOP F 19443400 + $RETURN RGS=(R3-R6),SA=NO RETURN IF XREF IS OFF F 19443500 +.NOXRF99 ANOP F 19443550 + EJECT 19444000 +* EXIT FOR STORAGE EXCEEDED. AS 999 MESSAGE. 19446000 +SYOVER $GTAD REP,MOSTOP GET ADDR OF EXIT 19448000 + BR REP GO THERE, NVER TO RETURN 19450000 + SPACE 2 19452000 +**--> ENTRY: SYEND2 2 CLEANUP AT END OF PASS 2. . . . . . . . . . . 19454000 +*. *** FUTURE USE - WILL COMPUTE SYMBOL TABLE STATISTICS. . 19456000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 19458000 +SYEND2 BR RET RETURN,NOTHING EXISTS RIGHT NOW 19460000 + SPACE 2 19462000 +* * * * * INTERNAL CONSTANTS * 19464000 +SYREGS DS 0F FOLLOWING IS REGISTER BLOCK FOR LM 19466000 +SYRX DC A(SYLOOP2) ADCON FOR BRANCHES 19470000 +SYRY DC F'4' FIRST GUESS FOR ROUNDED SYMBL LEN L 19472000 +SYRZ DC A(4*(&$SYHASH-1)) SHIFTED MASK FOR 1ST HASH CODE 19474000 +SYRA DS A BEGINNING @ HASH INDEX TABLE 19476000 +SYRB DC F'0' RETURN CODE= SYMBOL ALREADY PRESENT 19478000 + SPACE 1 19480000 +* * * * * INTERNAL VARIABLES * 19482000 +SYMTEMP EQU AVDWORK2 DS D, SPACE FOR SYMBOL 19484000 +SYMTEMPC EQU SYMTEMP-1 FOR # CHARACTERS IN SYMBOL 19486000 + AIF (NOT &$XREF).NOXRF50 A 19486100 + DROP RAT,R2,RA CLEAN UP USINGS A 19486200 + LTORG A 19486250 + AGO .NOXRF51 A 19486300 +.NOXRF50 ANOP A 19486400 + DROP RAT,REP,RA CLEAN UP USING SITUATION 19488000 +.NOXRF51 ANOP A 19488100 + TITLE '*** UTOPRS - INCORE DISK UTILITY OPERATIONS ***' 19490000 +**--> CSECT: UTOPRS 1-2 UTILITY DATA SET ROUTINES . . . . . . . . . . 19492000 +*. THIS MODULE PERFORMS ALL THE HANDLING WHICH WOULD . 19494000 +*. NORMALLY BE DONE USING SECONDARY STORAGE FOR INTERMEDIATE . 19496000 +*. SOURCE RECORDS AND FOR OBJECT CODE. IT USES THE LOWER END . 19498000 +*. OF THE DYNAMIC CORE AREA TO STORE THE RECORD BLOCKS (RSBLOCK,. 19500000 +*. RSCBLK,REBLK) RESULTING FROM THE SOURCE PROGRAM, AND PLACING . 19502000 +*. THEM DURING PASS 1 SO THAT THE OBJECT CODE CAN BE OVERLAID . 19504000 +*. INTO THE SAME AREA. I.E. IN NO CASE WILL THE RECORDS BLOCKS . 19506000 +*. FOR A SOURCE STATEMENT BE PLACED NEARER THE BEGINNING OF THE . 19508000 +*. AREA THAN THE OBJECT CODE RESULTING FROM THE STATEMENT. . 19510000 +*. . 19510500 +*. CODE FOR THIS MODULE DEPENDS HEAVILY ON &$DISKU, WHICH . 19510510 +*. CAN ALLOW UTOPRS TO USE DISK FOR INTERMEDIATE STORAGE. . 19510520 +*. &$DISKU = 0 ==> EVERYTHING IN CORE (NORMAL ASSIST). . 19510530 +*. &$DISKU = 1 ==> USER HAS INCROEE/DISK OPTION (DISKU,NODISKU) . 19510540 +*. &$DISKU = 2 ==> ALWAYS GO TO DISK, NO INCORE CODE EXISTS. . 19510550 +*. . 19510560 +*. USES MACROS: $DISK,$RETURN,$SAVE . 19510570 +*. CALLS XXXXDKOP,XXXXDKRD,XXXXDKE1,XXXXDKWT . 19510580 +*. USES DSECTS: AVWXTABL . 19511000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 19512000 +UTOPRS CSECT 19514000 + $DBG C0,* 19516000 + ENTRY UTINT1,UTPUT1,UTEND1,UTGET2,UTPUT2,UTEND2 19518000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 19520000 + SPACE 2 19522000 +**--> ENTRY: UTINT1 1 INITIALIZE UTILITY ROUTINES . . . . . . . . . 19524000 +*. INITIALIZES UT POINTER TO BEGINNING OF RECORD BLOCK AREA. . 19524500 +*. USES DSECTS: AVWXTABL . 19525000 +*. USES MACROS: $RETURN,$SAVE . 19525500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 19526000 +UTINT1 $SAVE SA=NO 19528000 + AIF (&$DISKU NE 1).UTINADK SKIP UNLESS DISKU OPTIONAL 19528005 + TM AVTAGS1,AJODISKU IS DISK UTILITY ON? 19528010 + BNO UTINODSK N/--NODISK--CONTINUE NORMALLY 19528015 +.UTINADK AIF (&$DISKU LT 1).UTINODK SKIP IF NO DISK 19528020 + $DISK OP INITIALIZE DISK UTILITY 19528025 + BM UTINODSK DISK DCB NOT OPEN-CANCEL DISK OPTION 19528030 + LA RE,AVBUFINC GET @ OF BUFFE @ 19528035 + ST RE,UTCONTRL SAVE IN UTOPS CONTROL WORD 19528040 + AIF (&$DISKU EQ 2).UTINODK SKIP UNNEC CODE FOR 2 19528042 + MVI UTBRCHNG+1,X'F0' SET UTPUT1 TO ALWAYS BRANCH 19528045 + B UTDISKON DISK IS ON--SKIP NEXT CODE 19528050 +UTINODSK EQU * ESTABLISH DESTINATION LABEL 19528055 + LA RE,AVADDLOW INITIALIZE UTCONTROL WORD 19528060 + ST RE,UTCONTRL WITH @ OF AVADDLOW 19528065 + MVI UTBRCHNG+1,X'00' SET BRANCH MASK TO 0 19528070 +.UTINODK AIF (&$DISKU EQ 2).UTINODL SKIP UNNNEC CODE FOR 2 19528072 + MVI UTP1RSB1+1,X'00' MAKE INCORE CODE NOP FIRST TIME 19528075 +.UTINODL ANOP 19528080 +* FOLLOWING CODE MAKES SURE REAL LOWEST @ OF USER PROGRAM 19528100 +* IS MULTIPLE OF 32. XXXXSNAP REQUIRES THIS TO GET 19528200 +* REASONABLE COMPLETION DUMPS AND XDUMPS. 19528300 +* OTHERWISE, CODE MVC UTSTART,AVADDLOW WOULD SUFFICE. 19528400 +UTDISKON L RE,AVADDLOW GET LOWEST LIMIT VALUE 19528500 + LA RD,31 SET UPF ALIGNMENT VALUE 19528600 + $ALIGR RE,RD ALIGN TO 32-MULTIPLE 19528700 + ST RE,AVADDLOW STORE BACK, NOW ALIGNED 19528800 + ST RE,AVRADL STORE BACK, ALIGNED OK 19530000 + AIF (NOT &$RELOC).UTINREL SKIP IF NO RELOCATION 19531000 + TM AVTAGS1,AJORELOC SHOULD CODE BE RELOCATED 19531100 + BZ UTINTRET NO,DON'T FIXUP ADDRESSES 19531200 +* FOLLOWING CODE SIMULATES A USER START CARD WITH VALUE 19531300 +* OF ACTUAL LOAD POINT IN MEMORY. RELOCATION IS THUS AUTOMATIC. 19531400 + MVC AVFENTER,AVADDLOW MOVE IN LOWEST ADDR AS DEFAULT ENTRY 19531500 + MVC AVLOCLOW(20),AVFENTER FILL IN @'S INSTEAD OF ZEROES 19531600 + OI AVTAGS1,$IBSTAR1 FLAG A START, FINISH FAKERY 19531700 +.UTINREL ANOP 19531800 +UTINTRET $RETURN SA=NO 19532000 + AIF (&$DISKU NE 2).UTINODM SKIP IF NOT DISK ONLY 19533000 +UTINODSK $GTAD REP,MOSTOP GET ADDR OF EXIT/OVERFL 19533010 + BR REP GO TO FLAG, END PASS 1 19533020 +.UTINODM ANOP 19533030 + EJECT 19534000 +**--> ENTRY: UTPUT1 1 WRITE TO UTILITY DURING PASS 1. . . . . . . . 19536000 +*. UTPUT1 MOVES ALL EXISISTING RECORD BLOCKS FOR A STATEMENT . 19536050 +*. INTO THE LOW END OF THE DYNAMIC CORE AREA, AT THE END OF . 19536100 +*. PROCESSING EACH STATEMENT DURING PASS 1. THE BLOCKS ARE . 19536150 +*. NEVER PLACED CLOSER TO THE BEGINNING OF THE RECORD BLOCK . 19536200 +*. AREA THAN ANY OBJECT CODE WHICH COULD BE PRODUCED BY THE . 19536250 +*. STATEMENT. THIS MAKES IT SAFE IN PASS 2 TO JUST MOVE . 19536300 +*. OBJECT CODE INTO THE SAME OVERALL AREA, WITH NO FEAR OF . 19536350 +*. OVERWRITING RECORD BLOCKS STILL NEEDED FOR THE SAME OR . 19536400 +*. LATER STATEMENTS. THE BLOCKS ARE PLACED IN THIS ORDER: . 19536450 +*. RSBLOCK, (RCODBLK), (REBLK), (RSCBLK) WITH THE BLOCKS . 19536500 +*. IN ( ) PLACED IF THEY EXIST. **NOTE** BLOCKS RSBLOCK AND . 19536550 +*. RCODBLK ARE ALWAYS ALIGNED TO FULLWORD BOUNDARY. . 19536600 +*. CALLS MOSTOP . 19536650 +*. USES DSECTS: AVWXTABL,RSBLOCK . 19536700 +*. USES MACROS: $ALIGR,$CALL,$GLOC,$RETURN,$SAVE . 19536750 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 19538000 + SPACE 1 19540000 +* * * * * REGISTER ALLOCATION FOR UTPUT1 * * * * * * * * * * * * * * * 19542000 +* RX = INTERNAL LINK REGISTER (FOR CALLING UTPMOVE). * 19550000 +* RY = CURRENT FREEAEA POINTER (AVADDLOW) * 19552000 +* RZ = CURRENT HIGH END POINTER (AVADDHIH) * 19554000 +* RA = 3 USED TO ALIGN LOCATIONS TO FULLWORD BOUNDARY($ALIGR) * 19556000 +* RB = BYTE REGISTER FOR INSERTS(HI-ORDRR 3 BYTES = 0). * 19558000 +* RC = VRSBPT (FROM AVWXTABL) * 19560000 +* RD = PARAMATER REGISTER FOR UTPMOVE INTERNAL SUBR (@ BLOCK). * 19562000 +* RE = WORK REGISTER * 19564000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 19566000 + SPACE 1 19568000 +UTPUT1 $SAVE RGS=(R3-R6),SA=NO RW-RZ, USE AS FEW REGS AS CAN 19570000 + OI AVPRINT1,AVPRSAVE MAKE SURE SAVED FROM NOW ON 19571000 + LA RA,3 SET UP ALIGNMENT VALUE 19572000 + SR RB,RB CLEAR FOR INSERTIONS 19574000 + AIF (&$DISKU NE 1).UTPT1A NO USER OPTION ON DISK UTILITY 19574250 + L RW,UTCONTRL SET UP CONTROL WITH USER OPTION 19574500 + LM RY,RZ,0(RW) LOAD FROM EITHER AVADDLOW OR 19574750 +* AVBUFINC 19575000 +UTBRCHNG BC $,UTPNOFF ALWAYS/NEVER BRANCH-DISK/NODISK 19575250 +* AROUND NORMALL PROCESSING IF DKU 19575500 +* NO BRANCH IF NOT DISK 19575750 +.UTPT1A AIF (&$DISKU NE 2).UTPT1B NO DISK AT ALL 19576000 + LM RY,RZ,AVBUFINC ALWAYS DISK, GET BUFFER PARMS 19576250 + AGO .UTPT1DK SKIP ALL INCORE ONLY CODE 19576300 +.UTPT1B AIF (&$DISKU NE 0).UTPT1X SKIP WHEN DISK UTILITY ON 19576750 + LM RY,RZ,AVADDLOW GET LOW-HIGH CORE POINTERS 19576800 +.UTPT1X ANOP 19576850 + $GLOC RE GET LOCATION COUNTER VALUE 19578000 + S RE,AVLOCLOW GET OFFSET 19580000 +UTP1RSB1 BC $,UTP1RSBX SKIP IF NOT 1ST INCORE RSBLOCK SAVED 19581000 + MVI UTP1RSB1+1,X'F0' MAKE NOP A BRANCH AFTER 1ST TIME 19581010 + MVC UTG2PT,AVADDLOW INIT @ 1ST RSBLOCK, IF ANY INCORE 19581020 +UTP1RSBX EQU * BRANCH HERE AFTER 1ST TIME THRU 19581030 + A RE,AVRADL ADD BASE @ OF UT CORE AREA 19582000 + SR RE,RY GET OFFSET REQUIRED,IF ANY 19584000 + BNP UTPNOFF BRANCH IF NO FURTHER OFFSET NEEDED 19586000 + TM AVTAGS1,$IBDSEC1+AJNLOAD IS EITHER DSECT OR NOLOAD 19588000 + BNZ UTPNOFF DSECT OR NOLAD, SO NO OFFSET REQUIRD 19590000 + SPACE 1 19592000 +* IF FALLS THRU-MUST OFFSET NEXT ENTRY BEYOND LOCCNTR * 19594000 + $ALIGR RE,RA ROUND OFFSET TO FULLWORD MULTIPLE 19596000 + AR RE,RY GET BACK ACTUAL @ FOR NEXT RSB TO GO 19598000 + CR RE,RZ MAKE SURE WE HAVE ROOM 19600000 + BNL UTPOVER DISASTER EXIT-OVERFLOW 19602000 + ST RE,0(RY) SAVE ADDRESS OF NEXT BLOCK 19604000 + LR RY,RE MOVE NEW POINTER OVER 19606000 +.UTPT1DK ANOP 19606050 + SPACE 1 19608000 +* GET ALL THE RECORD POINTERS AND MOVE EXISTING ONES. * 19610000 +UTPNOFF L RC,AVRSBPT GET ONLY DEFINITE EXISTING BLOCK 19612000 + USING RSBLOCK,RC NOTE RECORD SOURCE BLOCK USING 19614000 + AIF (NOT &$XREF).NOXRF11 SKII IF NO XREF A 19614005 + TM RSBFLAG,$RSBNPNN IS STMT TO BE NUMBERED A 19614100 + BZ UTPTNPRC NO, DON'T INCREMENT A 19614150 + AP AVXRLNCN,AWP1 APP 1 TO LINE COUNTER(CROSS REF) A 19614200 +UTPTNPRC EQU * A 19614300 +.NOXRF11 ANOP A 19614400 + LR RD,RC MOVE PTR OVER FOR UTPMOVE 19616000 + BAL RX,UTPMOVE CALL MOVER SUBROUTINE 19618000 + SPACE 1 19620000 + $ALIGR RY,RA GET FULLWORD ALIGNMENT 19622000 + TM RSBFLAG,$RCBX DO WE HAVE A RCB WITH THIS 19624000 + BZ UTPREB NO RCB-TRY FOR REB 19626000 + L RD,AVRCBPT GET @ RCODBLK 19628000 + BAL RX,UTPMOVE CALL MOVER ROUTINE 19630000 + SPACE 1 19632000 +UTPREB TM RSBFLAG,$REBX DO WE HAVE A REB 19634000 + BZ UTPRSC NO REB,LOOK FOR RSCB 19636000 + L RD,AVREBPT GET @ REBLK (AVREBLK) 19638000 + BAL RX,UTPMOVE CALL MOVER ROUTINE 19640000 + SPACE 1 19642000 +UTPRSC TM RSBFLAG,$RSCX TEST FOR RSC 19644000 + BZ UTPEND1 NO RSC-SKIP TO END 19646000 + L RD,AVRSCPT GET @ RSCBLK 19648000 + BAL RX,UTPMOVE CALL MOVER ROUTINE 19650000 + DROP RC NO LONGER NEEDED FOR RSB 19652000 + SPACE 1 19654000 +UTPEND1 $ALIGR RY,RA ALIGN POINTER TO FULLWORD 19656000 + AIF (&$DISKU NE 0).UTPT1D 19656500 + ST RY,AVADDLOW STORE POINTER BACK 19657000 + AGO .UTPT1F 19657500 +.UTPT1D AIF (&$DISKU NE 1).UTPT1E GO TO ALWAYS DISK CODE 19658000 + ST RY,0(RW) STORE POINTER BACK 19658500 + AGO .UTPT1F 19659000 +.UTPT1E ST RY,AVBUFINC STORE POINTER BACK 19659500 +.UTPT1F ANOP 19659750 +UTPRET $RETURN RGS=(R3-R6),SA=NO RETURN 19660000 + SPACE 2 19662000 +**--> INSUB: UTPMOVE MOVE 1 RECORD BLOCK INTO DYNAMIC AREA + + + + + 19662100 +*+ ENTRY CONDITIONS + 19662200 +*+ RD = ADDRESS OF THE BLOCK TO BE MOVED. ITS FIRST BYTE GIVES LEN-1 + 19662300 +*+ RY = ADDRESS WHERE BLOCK SHOULD BE PLACED + 19662400 +*+ EXIT CONDITIONS + 19662500 +*+ RY = ADDRESS OF NEXT FREE SPACE FOR BLOCKS. + 19664000 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 19666000 +UTPMOVE IC RB,0(,RD) GET LENGTH-1 OF BLOCK 19668000 + LA RE,1(RB,RY) INCREMENT @ PTR BY WHOLE LENGTH 19670000 + CR RE,RZ MAKE SURE WE HAVE ROOM 19672000 + BNL UTPOVER NO MORE ROOM-DISASTER 19674000 + STC RB,*+5 STORE LENGTH-1 INTO MVC INSTUCTION 19676000 + MVC 0($,RY),0(RD) MOVE BLOCK INTO DYNAMIC AREA 19678000 + LR RY,RE MOVE UPDATED LOW END POINTER BACK 19680000 + BR RX RETURN TO CALLING SECTION OF UTPUT1 19682000 + SPACE 1 19684000 + AIF (&$DISKU NE 0).UTPOVRA 19685000 +UTPOVER $GTAD REP,MOSTOP GET ADDR OF EXIT - AS999 MESSAGE 19686000 + BR REP GO THERE, ENDING PASS 1 19688000 + AGO .UTPOVRB 19688100 +.UTPOVRA AIF (&$DISKU EQ 1).UTPOVRC SKIP IF DISK UTILITY OPTIONAL 19688200 +UTPOVER $DISK WT CALL DISK UTILITY TO WRITE A BLOCK 19688300 + LM RY,RZ,AVBUFINC GET PARMS FROM CONTROL BLOCK 19688400 + B UTPNOFF PROCESS AT UTPNOFF 19688500 + AGO .UTPOVRB 19688600 +.UTPOVRC ANOP 19688700 +UTPOVER TM AVTAGS1,AJODISKU IS DISK ENABLED? 19688800 + BNO UTPEXIT NOT ENABLED TAKE EXIT 19688900 + $DISK WT DISK ENABLED WRITE A BLOCK TO DISK 19689000 + LM RY,RZ,AVBUFINC GRAB SOME CONTROL INFORMATION 19689100 +* ADDRESS OF NEXT BUFFER TO BE FILLED 19689200 + B UTPNOFF PROCEES AT UTPNOFF 19689300 +UTPEXIT $GTAD REP,MOSTOP GET ADDRESS OF EXIT--AS999 MESSAGE 19689400 + BR REP TAKE EXIT NOW 19689500 +.UTPOVRB ANOP 19689600 + EJECT 19694000 +**--> ENTRY: UTEND1 1 END PASS 1, PREPARE FOR PASS 2 OF ASSEMBLER . 19696000 +*. UTEND1 RESETS CORE POINTERS AND CALCULATES RELOCATION FACTOR.. 19697000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 19698000 +UTEND1 $SAVE SA=NO 19700000 + L RD,AVRADL GET @ 1ST BYTE WHERE OBJ CODE GOES 19702000 + AIF (&$DISKU EQ 2).UTE1A1 SKIP IF NO INCORE CODE AT ALL 19703000 + L RE,AVADDLOW CURRENT ENDING POINTER 19704000 + ST RE,UTG2END PTR TO END OF CORE USED (IF INCORE) 19706000 +* FOLLOWING STMT ONLY NEEDED IF UNUSED CORE FILL DONE. 19706500 + ST RD,UTP2LAST SAVE AVRADL AS INIT @ LAST CODE LOAD 19707000 + S RD,AVLOCLOW GET RELOCATION FACTOR 19708000 + ST RD,AVRELOC SAVE THE RELOCATION FACTOR 19710000 + AIF (&$DISKU EQ 0).UTRET SKIP WHEN NO DISK AT ALL 19712000 + AIF (&$DISKU EQ 2).UTALW SKIP WHEN ALWAYS DISK 19712100 + TM AVTAGS1,AJODISKU IS DISK UTILITY ON? 19712200 + BNO UTRETE1 NO RETURN AFTER THIS CODE 19712300 + SPACE 1 19712400 +* IF DISKU OPTION ON, MAKE SURE OBJECT CODE FITS INTO THE * 19712500 +* ALLOWED AREA. (THIS CHECK IS MADE CONSTANTLY DURING UTPUT1 * 19712600 +* FOR THE INCORE VERSION). THIS ASSUMES AVADDHIH WILL REMAIN * 19712700 +* CONSTANT FROM THIS POINT ON. IF AVADDHIH MAY BE CHANGED, * 19712800 +* IT WILL BE NECESSARY TO CHECK DURING UTPUT2 . * 19712900 + SPACE 1 19713000 + A RD,AVLOCHIH RD = REAL @ OF END OF OBJ CODE 19713100 + C RD,AVADDHIH CHECK AGAINST LOWER LIMIT OF UPPER 19713200 + BNH *+12 IF NEEDED <= AVAIL, SKIP, OK 19713300 + OI AVTAGS3,AVOVERFL SHOW STORAGE EXCEEDED 19713400 + OI AVTAGS1,AJNLOAD KILL OBJECT CODE GENERATION 19713500 + SPACE 1 19713600 +.UTALW $DISK E1 CALL END-PASS-1 FIX ROUTINE 19713700 + LR RD,RE DUPLICATE RE 19713800 + STM RD,RE,UTG2PT SET POINTERS TO FORCE CALL TO DISKU 19713900 +.UTRET ANOP 19714000 +UTRETE1 $RETURN SA=NO RETURN TO MASTER CONTROL 19716000 + EJECT 19718000 +**--> ENTRY: UTGET2 2 GET FROM UTILITY DUIRNG PASS 2. . . . . . . . 19720000 +*. UTGET2 IS CALLED DURING PASS 2 TO RETRIEVE THE ADDRESSES OF . 19720100 +*. THE SET OF RECORD BLOCKS BELONGING TO THE NEXT STATEMENT. A . 19720200 +*. CHECK IS REQUIRED FOR ANY OFFSET ADJUSTMENT MADE BY UTPUT1, . 19720300 +*. WHICH MADE SURE THAT NO RECORD BLOCK COULD BE OVERLAID BY . 19720400 +*. ITS OWN CODE. 19720500 +*. EXIT CONDITIONS . 19722000 +*. RC = @ RSBLOCK (THE ONLY BLOCK DEFINITELY PRESENT). . 19731000 +*. RE = 0 NORMAL RETURN. RE = 4 ==> END-FO-FILE-QUIT . 19732000 +*. AVRSBPT,AVRCBPT,AVRSCPT NOW POINT TO THEIR BLOCKS, IF THEY EXIST. . 19732100 +*. AVREBLK HAS HAD THE REBLK MOVED INTO IT, IF THERE WAS ONE. . 19732200 +*. AVREBPT IS NOT CHANGED, STILL POINTS AT AVREBLK, AS ALWAYS. . 19732300 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 19734000 + SPACE 1 19736000 +* * * * * REGISTER ALLOCATION FOR UTGET2 * * * * * * * * * * * * * * * 19738000 +* RA = 3 MASK FOR DOING FULLWORD ALIGNMENT. * 19740000 +* RB = BYTE REGISTER FOR INSERTIONS (HI-ORDER 3 BYTES = 0). * 19742000 +* RC = @ RSBLOCK, USED TO TEST FOR EXISTENCE OF OTHERS. * 19744000 +* RD = CURRENT @ NEXT BLOCK, INITIALIZED = UTG2PT * 19746000 +* RE = UTG2END-LIMIT @, USED TO DETERMINE END OF RECORDS. * 19747000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 19748000 + SPACE 1 19750000 + AIF (&$ASMLVL).UTOS SKIP FOR OS GENERATION 19751000 +UTDKDISP EQU 8 GEN DOS BUFFER DISP 19751100 + AGO .UTGLVL 19751200 +.UTOS ANOP 19751300 +UTDKDISP EQU 0 GEN OS BUFFER DISP 19751400 +.UTGLVL SPACE 1 19751500 +UTGET2 $SAVE RGS=NO,SA=NO USE ONLY TEMP REGS 19752000 + LA RA,3 SET UP FOR FULLWORD ALIGNMENT 19754000 + SR RB,RB CLEAR FOR INSERTIONS 19756000 + LM RC,RD,UTG2PT UTG2PT-UTG2END VALUES FOR COMPARE 19758000 + CR RC,RD COMPARE CURRENT POINTER TO END @ 19760000 + BNL UTG2DONE NO MORE RECORDS-BRANCH-DONE 19762000 + SPACE 1 19764000 +* THE FOLLOWING CHECKS FOR AN OFFSET ADJUSTMENT @ FOLLWING THE * 19766000 +* LAST RSB, INSTEAD OF ANOTHER RSB. THE 1ST BYTE FOR AN OFFSET* 19768000 +* WILL =0, BUT AN RSBLENG NEVER = 0. 19770000 + CLI 0(RC),0 IS NEXT BYTE 0, IF SO RC==> OFFSET@ 19772000 + BNE *+8 BRANCH IF NORMAL RSB FOLLOWS 19774000 + L RC,0(RC) OFFSET @ ==> NEXT RSBLOCK, LOAD IT 19776000 +UTG2DKCT ST RC,AVRSBPT STORE THE @ OF THE RSBLOCK 19778000 + USING RSBLOCK,RC NOTE ADDRESS 19780000 + SPACE 1 19782000 + IC RB,RSBLENG GET THELENGTH-1 OF BLOCK 19784000 + LA RD,4(RB,RC) MOVE @ OVER, ADD LENGTH+ALIGN 19786000 + OR RD,RA MAKE LAST 2 BITS 1'S 19788000 + SR RD,RA HAVE ROUNDED UP TO NEXT FULLWORD B 19790000 + SPACE 1 19792000 + TM RSBFLAG,$RCBX DO WE HAVE RCB 19794000 + BZ UTG2REB NO RCB-SKIP 19796000 + ST RD,AVRCBPT STORE @ RCODBLK 19798000 + USING RCODBLK,RD NOTE POINTER 19800000 + IC RB,RCLENG GET LENGTH-1 OF RCODBLK 19802000 + LA RD,1(RB,RD) INCREMENT POINTER BY FULL LENGTH 19804000 + SPACE 1 19806000 +UTG2REB TM RSBFLAG,$REBX DOES REB EXIST 19808000 + BZ UTG2RSC NO IT DOESN'T - SKIP 19812000 + USING REBLK,RD NOTE PTR TO ERROR BLOCK 19813000 + IC RB,REBLN GET LENGTH-1 OF THE BLOCK 19814000 + STC RB,*+5 STORE LENGTH-1 INTO NEXT INSTR 19816000 + MVC AVREBLK($),REBLK MOVE THE ERROR BLOCK OVER 19818000 + LA RD,1(RB,RD) INCREMENT POINTER TO NEXT POSITION 19820000 + SPACE 1 19822000 +UTG2RSC TM RSBFLAG,$RSCX DOES RECORD SOURCE CODE BLOCK EXIST 19824000 + BZ UTG2EXIT NO,SKIP OVER 19826000 + ST RD,AVRSCPT STORE @ RSCBLK WHERE NEEDED 19828000 + USING RSCBLK,RD NOTE POINTER 19830000 + IC RB,RSCLENG GET LENGTH-1 OF RSCBLK 19832000 + LA RD,1(RB,RD) INCREMENT BY LENGTH TO NEXT POSITION 19834000 + SPACE 1 19836000 +UTG2EXIT $ALIGR RD,RA ALIGN TO FULLWORD FOR NEXT RSBLOCK 19838000 + ST RD,UTG2PT STORE THE POINTER BACK, NEXT RSBLOCK 19840000 + SR RE,RE CLEAR TO SHOW NORMAL 19844000 + $DBG C0,SNAP 19846000 +UTG2RET $RETURN RGS=NO,SA=NO RETURN 19848000 +UTG2DONE EQU * ESTABLISH LABEL 19850000 + AIF (&$DISKU GT 1).UTG2DA DISK ONLY 19852000 + AIF (&$DISKU LT 1).UTG2DB USER OPTION--DISK OR NO DISK 19853000 + TM AVTAGS1,AJODISKU IS DISK ON? 19853200 + BNO UTG2EOF NO--SET E-O-F FLAG 19853400 +.UTG2DA ANOP 19853600 + $DISK RD GET NEXT BUFFER OF INFO 19853800 + BM UTG2EOF ON REAL EOF--SET FLAG AND RTURN 19854000 + L RC,AVBUFF@ GET BUFFER ADDRESS 19854200 + LR RD,RC DUPLICATE FOR BUFFER LENGTH 19854400 + A RD,0+UTDKDISP(RC) ADD IN BUFFER USED LENGTH 19854600 + LA RC,4+UTDKDISP(RC) BUMP PAST LENGTH USED WORD 19854800 + ST RD,UTG2END STORE ENDING ADDRESS 19854900 + B UTG2DKCT GO BACK AND PROCESS 19855000 +.UTG2DB ANOP 19855200 +UTG2EOF LA RE,4 SHOW E-O-F NO MORE SOURCE 19855400 + B UTG2RET 19855600 + DROP RC,RD KILL THESE USINGS 19855700 + EJECT 19855800 +**--> ENTRY: UTPUT2 PRODUCES AND RELOCATES OBJECT CODE. . . . . . 19856000 +*. UTPUT2 MOVES OBJECT CODE PRODUCED BY THE ASSEMBLER INTO IT . 19856100 +*. PROPER LOCATION IN THE OBJECT PROGRAM, APPLYING DUPLICATION . 19856200 +*. FACTOR AT THIS TIME, IF NECESSARY. BECAUSE OF THE WAY THE . 19856300 +*. ASSIST INTERPRETER EXECUT WORKS, AND BECAUSE OF THE PSEUDO . 19856400 +*. START CARD USED BY THE REPLACE MONITOR, NO RELOCATION NEED . 19856500 +*. EVER BE DONE BY THIS PROGRAM, MAKING IT FAST AND SMALL. THE . 19856600 +*. MODULE ALSO FILLS IN AREAS OF THE OBJECT PROGRAM HAVING NO . 19856700 +*. CODE WITH CHARACTER 5'S, WHICH HELP REDUCE THE SIZE OF ANY . 19856800 +*. COMPLETION DUMPS, AND AID DEBUGGING (X'F5F5F5' SHOWS UP . 19856900 +* DISTINCTIVELY IN A DUMP, AND IS NOT A LEGAL INSTRUCTION). . 19859000 +*. ENTRY CONDITIONS . 19860000 +*. RA = PROGRAM LOCATION COUNTER OF THE OBJECT CODE . 19862000 +*. RC = @ ASSEMBLED CODE IN MEMORY . 19870000 +*. RD = LENGTH-1 OF OBJECT CODE . 19872000 +*. RE = DUPLICATION FACTOR FOR THE CODE - 1 OR GREATER . 19874000 +*. USES DSECTS: AVWXTABL . 19875000 +*. USES MACROS: $RETURN,$SAVE . 19875500 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 19876000 +UTPUT2 $SAVE RGS=NO,SA=NO NO REGS NEEDED 19878000 + SPACE 1 19880000 + TM AVTAGS1,$IBDSEC1+AJNLOAD DSECT OR NOLOAD 19882000 + BNZ UTP2RET RETURN IF SO, DON'T LOAD ANY CODE 19884000 + A RA,AVRELOC ADD RELOCATION FACTOR TO ADDRESS 19886000 + STC RD,UTP2MOVE+1 STORE LENGTH-1 INTO MVC IMMEDIATLY 19887000 + SPACE 1 19888000 +* FOLLOWING SECTION PLACES CHARACTER 5'S IN ANY UNUSED * 19890000 +* LOCATIONS OF MEMORY, EXCEPT POSSIBLY A BLOCK OF DS AREAS * 19892000 +* ENDING PROGRAM, WITH NO FOLLOWING LITERALS, DC'S. * 19894000 +* SECTION NOT REALLY NECESSARY, COULD BE REMOVED WITH NO HARM. * 19896000 + LR RB,RA DUPLICATE VALUE OF CODE @ 19900000 + S RB,UTP2LAST SUB @ LAST CODE, GET # FILLED 19902000 + BNP UTP2MOVE SKIP, NO PADDING NEED BE DONE 19904000 + SPACE 1 19906000 + STM R1,R2,24(R13) SAVE WORK REGISTERS 19907000 + L R2,UTP2LAST GET STARTING @ AREA TO BE TWOED 19908000 + MVI 0(R2),$PRGFILC PUT IN CORE FILL CHARACTER 19910000 + LA R1,256 SET UP FOR LENG FILL IF NEEDED 19912000 + BCT RB,UTP2ZB DECREMENT COUNT 1, BRANCH >1 ORIG 19914000 + B UTP2NT 1 BYTE ONLY, ALREADY DONE,QUIT 19916000 + SPACE 1 19918000 +UTP2ZA MVC 1(256,R2),0(R2) PROPAGATE 5'S FOR 256 BYTES 19920000 + AR R2,R1 ADD 256 TO BEGINNING @ OF CODE 19922000 + SR RB,R1 DECREMENT COUNT REMAINING BY 256 19924000 + BZ UTP2NT BRANCH IF NOTHING LEFT TO DO 19926000 + SPACE 1 19928000 +UTP2ZB CR RB,R1 COMPARE COUNT REMAINING TO 256 19930000 + BH UTP2ZA IF STILL HIGH, FILL ANOTHER 256 19932000 + BCTR RB,0 DECREMENT COUNT TO LENGTH-1 FOR MVC 19934000 + STC RB,*+5 STORE LENGTH-1 INTO MVC 19936000 + MVC 1($,R2),0(R2) PROPAGATE 5'S FOR LAST TIME 19938000 +UTP2NT LM R1,R2,24(R13) RELOAD DESTOYED WORK REGS 19940000 +* END OF CORE-FILLING SEGMENT. * 19942000 + EJECT 19944000 +* FOLLOWING 3 STMTS DO ACTUAL CODE LOAD/DUPLICATION. 19946000 +UTP2MOVE MVC 0($CHN,RA),0(RC) MOVE OBJECT CODE OVER 19950000 + LA RA,1(RD,RA) BUMP ADDRESS TO NEXT LOCATION 19952000 + BCT RE,UTP2MOVE DUPLICATE AS MANY TIMES AS NEEDED 19954000 + SPACE 1 19956000 +* FOLLOWING 3 STMTS USED ONLY FOR CORE-FILL ACTIONS. * 19958000 + C RA,UTP2LAST WAS END @ OF CODE HIGHEST SO FAR 19960000 + BNH *+8 SKIP IF NOT SO 19962000 + ST RA,UTP2LAST STORE NEW HIGHEST CODE @ 19964000 + SPACE 1 19966000 + $DBG C0,* 19968000 +UTP2RET $RETURN SA=NO 19970000 + SPACE 2 19972000 +**--> ENTRY: UTEND2 2 CLEANUP AFTER PHASE 2 DONE. . . . . . . . . . 19976000 +*. UTEND2 IS CALLED AT THE END OF ASSEMBLY PASS 2. IT ASSURES . 19976100 +*. THAT ANY DS STATEMENTS ENDING THE PROGRAM WILL BE FILLED IN . 19976200 +*. WITH 5'S, LIKE ANY OTHER DS'S FOLLOWED BY CODE (THE VERY LAST. 19976300 +*. STRING OF DS'S MAY NOT BE CAUGHT BY UTPUT2). IT DOES THIS BY. 19976400 +*. CALLING UTPUT2 WITH SOME NONEXISTENT OBJECT CODE. . 19976500 +*. CALLS UTPUT2 . 19976600 +*. USES DSECTS: AVWXTABL . 19976700 +*. USES MACROS: $SAVE . 19978000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 19980000 + SPACE 1 19980100 +UTEND2 $SAVE RGS=NO,SA=NO NO REGS NEED BE SAVED 19980200 + NI AVTAGS1,255-$IBDSEC1 MAKE SURE DSECT FLAG OFF 19980250 + L RA,AVLOCHIH GET @ 1 BYTE BEYOND HIGHEST LOCNTR 19980300 + LA RC,=AL1($PRGFILC) SET @ 1 BYTE CORE FILL CHARACTER 19980400 + SR RD,RD SHOW LENGTH-1 OF 0 FOR FAKE CODE 19980500 + LA RE,1 SHOW DUPLICATION FACTOR OF 1 19980600 + $GTAD REP,UTPUT2 GET ADCON FOR OTHER SECTION 19982000 + BR REP GO TO UTPUT2, IT WILL FILL IF NEEDED 19984000 + LTORG 19986000 + SPACE 2 19988000 +* * * * * INTERNAL VARIABLES * 19990000 +* USED BY PASS 1 * 19992000 + AIF (&$DISKU NE 1).UTCNTRL SKIP UNLESS DISK IS OPTION 19996200 +UTCONTRL DS F @ AVBUFINC/AVADDLOW-DEPENDS ON DISKU 19996400 +.UTCNTRL ANOP 19996600 +* USED BY PASS 2 * 19998000 +UTG2PT DS A POINTER TO NEXT RSBLOCK TO BE GOTTEN 20000000 +UTG2END DS A POINTER TO END OF CORE AREA USED 20002000 +UTP2LAST DS A @ HIGHEST CODE LOADED,**FILL USE**** 20004000 + DROP RAT,REP 20006000 + TITLE '*** VWXTABL - MAIN ASSEMBLER CONTROL TABLE ***' 20008000 +**--> CSECT: VWXTABL MAIN ASSEMBLER COMMUNICATION TABLE. . . . . . . 20008100 +*. THIS IS ACTUAL TABLE THAT AVWXTABL DSECT CORREPSONDS TO. . 20008200 +*. SEE AVWXTABL COMMENTS FOR DESCRIPTION. . 20008300 +*. USES MACROS: WCONG . 20008400 +*. NAMES: X------, W------, V------ . 20008500 +*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 20008600 + SPACE 1 20008700 +VWXTABL CSECT 20010000 + SPACE 1 20012000 +* * * * * NAMES IN AVWXTABL DSECT ARE SAME, EXCEPT WITH A'S PREFIXED * 20014000 +* * * * * AVWXTABL SECTION X - ADDRESS CONSTANTS * * * * * * * * * * * 20016000 +X$BASE DS 0A BASE ADDRESS FOR OFFSETS TO ROUTINES 20018000 +* *** BROPS2 ENTRY POINTS *** * 20020000 +XBRINIT DC V(BRINIT) BASE-REG INITIALIZATION 20022000 +XBRUSIN DC V(BRUSIN) BASE-REG SET UP USING VALUE 20024000 +XBRDROP DC V(BRDROP) BASE REG DROP A REGISTER 20026000 +XBRDISP DC V(BRDISP) BASE REG GET BASE-DISPLACEMENT 20028000 +XC$BASE DS 0F BASE ADDRESS FOR CONSTANT ADDR OFFSE 20030000 +* *** CACONS ENTRY POINTS *** * 20032000 +XCACON1 DC V(CACON1) SCAN A-TYPE CONST 20034000 +XCACON2 DC V(CACON2) ASSEMBLE A-TYPE CONSTANT 20036000 +* *** CBCONS ENTRY POINTS *** * 20038000 +XCBCON1 DC V(CBCON1) SCAN BINARY CONSTANT 20040000 +XCBCON2 DC V(CBCON2) ASSEMBLE BINARY CONSTANT 20042000 +* *** CCCONS ENTRY POINTS *** * 20044000 +XCCCON1 DC V(CCCON1) SCAN CHARACTER CONSTANT 20046000 +XCCCON2 DC V(CCCON2) ASSEMBLE CHARACTER CONSTANT 20048000 +* *** CDECNS ENTRY POINTS *** * 20050000 +XCDECN1 DC V(CDECN1) SCAN FLOATING PT CONST 20052000 +XCDECN2 DC V(CDECN2) ASSEMBLE FLOATING PT CONSTANT 20054000 +XCDCON1 EQU XCDECN1 MAKE EQUATE FOR STANDARD NAMES 20056000 +XCECON1 EQU XCDECN1 MAKE EQUATE FOR STANDARD NAMES 20058000 +* *** CFHCNS ENTRY POINTS *** * 20060000 +XCFHCN1 DC V(CFHCN1) SCAN FIXED POINT CONSTANT 20062000 +XCFHCN2 DC V(CFHCN2) ASSEMBLE FIXED POINT CONSTANT 20064000 +XCFCON1 EQU XCFHCN1 MAKE EQUATE FOR STANDARD NAMES 20066000 +XCHCON1 EQU XCFHCN1 MAKE EQUATE FOR STANDARD NAMES 20068000 +* *** CONSTANT PROCESSOR CONTROL ROUTINES *** * 20070000 +XCNDTL2 DC V(CNDTL2) PASS 2 CONSTANT PROCESSING 20072000 +XCODTL1 DC V(CODTL1) DUPLICATION FACTOR-TYPE-LENGTH PROC 20074000 +* *** CPCONS ENTRY POINTS *** * 20076000 +XCPCON1 DC V(CPCON1) SCAN PACKED CONSTANT 20078000 +XCPCON2 DC V(CPCON2) ASSEMBLE PACKED CONSTANT 20080000 +* *** CVCONS ENTRY POINTS *** * 20082000 +XCVCON1 DC V(CVCON1) SCAN V-TYPE CONSTANTS 20084000 +XCVCON2 DC V(CVCON2) ASSEMBLE V-TYPE ADDRESS CONSTANTS 20086000 +* *** CXCONS ENTRY POINTS *** * 20088000 +XCXCON1 DC V(CXCON1) SCAN HEXADECIMAL CONSTANTS 20090000 +XCXCON2 DC V(CXCON2) ASSEMBLE HEXADECIMAL CONSTANTS 20092000 +* *** CZCONS ENTRY POINTS *** * 20094000 +XCZCON1 DC V(CZCON1) SCAN ZONED CONSTANTS 20096000 +XCZCON2 DC V(CZCON2) ASSEMBLE ZONED CONSTANTS 20098000 +* *** ERRORS ENTRY POINTS *** * 20100000 +XERRTAG DC V(ERRTAG) FLAG ERROR 20102000 +XERRLAB DC V(ERRLAB) ERROR FLAG FOR A LABEL 20104000 +* *** ESDOPRS ENTRY POINTS *** * 20106000 +XESINT1 DC V(ESINT1) ESD ROUTINE INITIALIZATION 20108000 +XESCSEC DC V(ESCSEC) CSECT,START, OR DSECT 20110000 +XESENX1 DC V(ESENX1) ENTRY OR EXTRN - PASS 1 20112000 +XESENX2 DC V(ESENX2) PASS 2 ENTRY AND EXTRN 20114000 +* *** EVALUT - EXPRESSION EVALUATOR *** * 20116000 +XEVALUT DC V(EVALUT) GENERAL EXPRESSION EVALUATION ROUT 20118000 +* *** 2ND LEVEL PROCESSOR CSECTS *** * 20120000 +XIAMOP1 DC V(IAMOP1) MACHINE OPCODES-PASS 1 20122000 +XIBASM1 DC V(IBASM1) ASSEMBLER OPCODES - PASS 1 20124000 +XICMOP2 DC V(ICMOP2) MACHINE OPCODES - PASS 2 20126000 +XIDASM2 DC V(IDASM2) ASSEMBLER OPCODES - PASS 2 20128000 +* *** INPUT1 ENTRY POINTS *** * 20130000 +XINCARD DC V(INCARD) INPUT CARD PROCESSOR 20132000 +* *** LTOPRS ENTRY POINTS *** * 20134000 +XLTINT1 DC V(LTINT1) LITERAL TABLE INITIALIZATION 20136000 +XLTENT1 DC V(LTENT1) ENTER A LITERAL INTO POOL 20138000 +XLTDMP1 DC V(LTDMP1) RETURN LITERAL LENGTH-PASS 1 20140000 +XLTEND1 DC V(LTEND1) END PASS 1 FOR LITERAL TABLE 20142000 +XLTGET2 DC V(LTGET2) GET ADDRESS OF LITERAL 20144000 +XLTDMP2 DC V(LTDMP2) PRODUCE LITERAL RECORDS-PASS 2 20146000 + AIF (NOT &$MACROS).XNOMAC SKIP IF NO MACROS 20147000 +* ** MACROS ENTRY POINTS ** * 20147100 +XMACINT DC V(MACINT) MACRO INITIALIZATION ENTRY 20147200 +XMACRO1 DC V(MACRO1) BUILD MACRO DEFINITION TABLES 20147300 +XMEXPND DC V(MEXPND) MACRO EXPANSION ENTRY 20147400 +XMCBODY DC V(MCBODY) PROCESS MACRO DEFINITION BODY 20147405 +XMACSCN DC V(MACSCN) SCAN MACRO STATEMENT 20147410 +XMACFND DC V(MACFND) SEARCH MACRO LIBRARY 20147415 +XMCVSCN DC V(MCVSCN) SCAN VARIABLE SYMBOL 20147420 +XMCSCOP DC V(MCSCOP) SCAN STANDARD OPERAND 20147425 +XMCGTST DC V(MCGTST) MOVE STRING TO LOW CORE 20147430 +XMCSYSR DC V(MCSYSR) SEARCH MACRO LIBRARIES FOR VAR SYMB 20147435 +XMACLEX DC V(MACLEX) MACRO STMT LEX ANALYSIS 20147440 +XMCGNCD DC V(MCGNCD) MACRO DEFINITION CODE GENERATION 20147445 +XMXMVSR DC V(MXMVSR) MOVE GENERATED STMT TO HIGH CORE 20147450 +XMXERRM DC V(MXERRM) GENERATE ERROR MESSAGE 20147455 +XMCDTRM DC V(MCDTRM) CHAR TO BINARY CONVERSION 20147460 +XMCATRM DC V(MCATRM) TEST FOR ATTRIBUTE 20147465 + DS 2V SPACE FOR MACRO ENTRY POINTS 20147500 +.XNOMAC ANOP 20147600 +* *** MAIN PROGRAMS - PASS 1&2 *** * 20148000 +XMOCON1 DC V(MOCON1) MAIN CONTROL - PASS 1 20150000 +XMOSTOP DC V(MOSTOP) DISASTER EXIT-PASS 1 20152000 +XMTCON2 DC V(MTCON2) MAIN CONTROL - PASS 2 20154000 +* *** OPCOD1 ENTRY POINTS *** * 20156000 +XOPINIT DC V(OPINIT) INITIALIZATION,IF ANY 20158000 +XOPFIND DC V(OPFIND) LOOKUP OPCODE 20160000 +* *** OUTPUT ENTRY POINTS *** * 20162000 +XOUINT1 DC V(OUINT1) INITIALIZATION ENTRY FOR OUTPUT 20164000 +XOUTPT2 DC V(OUTPT2) OUTPUT LINE PRINTER 20166000 +XOUEND2 DC V(OUEND2) FINISH UP LAST PRINTING 20168000 +* *** SCANRS ENTRY POINTS *** * 20170000 +XSCANBL DC V(SCANBL) SCAN TO FIRST BLANK OUTSIDE OF C' 20172000 +XSCANCO DC V(SCANCO) SCAN TO COMMA OR BLANK 20174000 +XSCANEQ DC V(SCANEQ) SCAN TO = OR BLANK 20176000 +* *** SDTERM ENTRY POINTS *** * 20178000 +XSDBCDX DC V(SDBCDX) SLEF DEFINING TERM-ALL 4 KINDS * 20180000 +XSDBTRM DC V(SDBTRM) BINARY SELF-DEFINING TERM 20182000 +XSDCTRM DC V(SDCTRM) CHARACTER SELF-DEFINING TERM 20184000 +XSDDTRM DC V(SDDTRM) DECIMAL SELF-DEFINING TERM 20186000 +XSDXTRM DC V(SDXTRM) HEXADECIMAL SLEF-DEFINING TERM 20188000 +* *** SYMOPS ENTRY POINTS *** * 20190000 +XSYINT1 DC V(SYINT1) SYMBOL TABLE INITIALIZATION 20192000 +XSYENT1 DC V(SYENT1) ENTER A SYMBOL INTO SYMBOL TABLE 20194000 +XSYFIND DC V(SYFIND) LOOK UP A SYMBOL IN SYMBOL TABLE 20196000 +XSYEND2 DC V(SYEND2) CLEANUP/STATISTICS AT END OF SYM TAB 20198000 +* *** UTOPRS ENTRY POINTS *** * 20200000 +XUTINT1 DC V(UTINT1) UTILITIES INITIALIZATION 20202000 +XUTPUT1 DC V(UTPUT1) PASS 1 OUTPUT OF EXPANDED RECORDS 20204000 +XUTEND1 DC V(UTEND1) END PASS 1-INIT FOR PASS 2 20206000 +XUTGET2 DC V(UTGET2) GET ADDR'S OF EXPANDED RECRDS-PASS 2 20208000 +XUTPUT2 DC V(UTPUT2) OBJECT CODE CREATION-PASS 2 20210000 +XUTEND2 DC V(UTEND2) FINISH UP PASS 2 20212000 + AIF (NOT &$XREF).NOXREF7 SKIP ID NO XREF A 20212025 +* *** CROSS REFERENCE ENTRY POINTES *** A 20212050 +XXRINT1 DC V(XRINT1) 1ST PASS INIT ROUTINE A 20212100 +XXRINT2 DC V(XRINT2) 2ND PASS INIT ROUTINE A 20212200 +XXRCOLL DC V(XRCOLL) COLLECTION ROUTINE A 20212300 +XXRPRNT DC V(XRPRNT) PRINT ROUTINE A 20212400 +XXRSCAN DC V(XRSCAN) SCANNING ROUTINE A 20212600 +.NOXREF7 ANOP A 20212700 +XSPECAD DS A BASE ADDRESS FOR SPECIAL ROUTINES 20214000 +XSPECA2 DS A BASE @ LEV2-PASS 2 - 'SPECIALS' 20216000 + EJECT 20218000 +* * * * * AVWXTABL SECTION W - CONSTANTS * * * * * * * * * * * * * * * 20220000 +WD0 DS 0D FLOATING POINT 0 FOR CDE 20222000 +WZEROS DC 32D'0' 256 BYTES OF BINARY ZEROS 20224000 +WD10 DC D'10' DOUBLEWORD FLOATING CONSTANT 10 20225000 +WF1 DC F'1' FULLWORD 1 CONSTANT 20226000 +WH1 EQU WF1+2 HALFWORD 1 CONSTANT 20228000 +WB1 EQU WF1+3 BYTE 1 CONSTANT 20230000 +WF3 DC F'3' FULLWORD 3 CONSTANT 20232000 +WH3 EQU WF3+2 HALFWORD 3 CONSTANT 20234000 +WB3 EQU WF3+3 BYTE 3 CONSTANT 20236000 +WF4 DC F'4' FULLWORD CONSTANT 4 20238000 +WF7 DC F'7' FULLWORD 1 20240000 +WH7 EQU WF7+2 HALFWORD 7 CONSTANT 20242000 +WB7 EQU WF7+3 BYTE 7 CONSTANT 20244000 +WF10 DC F'10' FULLWORD CONSTANT 10 20245000 +WH10 EQU WF10+2 HALFWORD CONSTANT 10 20245100 +WF12 DC F'12' FULLWORD CONSTANT 12 20246000 +WF15 DC F'15' FULLWORD CONSTANT 15 (4 1 BITS) 20248000 +WFXF EQU WF15 FULLWORD CONSTANT,4 1-BITS 20250000 +WFXFF DC F'255' FULLWORD CONSATNT 255 20252000 +WF4095 DC F'4095' FULLWORD 4095 CONSTANT 20254000 +WFXFFF EQU WF4095 XL4'FFF' ON F BOUNDARY 20256000 +WHXFFF EQU WFXFFF+2 XL2'0FFF' ON H BOUNDARY 20258000 +WFX7FFFF DC X'00007FFF' MAXIMUM SIZE, MASK VALUE 20260000 +WFXFFFF DC X'0000FFFF' 65K DECIMAL NUMBER 20262000 +WFX6F DC XL4'FFFFFF' FULLWORD 24-BIT MASK 20264000 +WFM4 DC F'-4' FULLWORD -4 CONSTANT 20266000 +WFM1 DC F'-1' FULLWORD -1 CONSTANT 20268000 +WHM1 EQU WFM1+2 HALWORD -1 CONSTANT 20270000 + EJECT 20272000 +* TABLE USED TO SCAN DECIMAL NUMBERS * 20274000 +* CHARACTERS 0-9 HAVE ZERO VALUES,ALL OTHERS NONZERO * 20276000 +* ALSO USED IN ICMOP2 FOR GENERAL SCANNING. * 20278000 +* TR TABLE 0 1 2 3 4 5 6 7 8 9 A B C D E F * 20280000 +WTDECT DC X'02020202020202020202020202020202' 0 20282000 + DC X'02020202020202020202020202020202' 1 20284000 + DC X'02020202020202020202020202020202' 2 20286000 + DC X'02020202020202020202020202020202' 3 20288000 + DC X'100202020202020202020202020C0202' 4 BLANK ( 20290000 + DC X'02020202020202020202020608020202' 5 $ * 20292000 + DC X'02020202020202020202020E02020202' 6 , 20294000 + DC X'02020202020202020202020606020A02' 7 # @ = 20296000 + DC X'02020202020202020202020202020202' 8 20298000 + DC X'02020202020202020202020202020202' 9 20300000 + DC X'02020202020202020202020202020202' A 20302000 + DC X'02020202020202020202020202020202' B 20304000 + DC X'02060404060606060606020202020202' C B-C(4) ALPHS-6 20306000 + DC X'02060604060606060606020202020202' D L-(4) ALPHS-6 20308000 + DC X'02020606060606040606020202020202' E X-(4) ALPHS - 6 20310000 + DC X'00000000000000000000020202020202' F 20312000 +* TABLE USED TO SCAN HEXADECIMAL CONSTANTS FOR CORRECTNESS * 20314000 +* CHARACTERS A-F,0-9 ARE ZERO,ALL OTHERS ARE NON-ZERO * 20316000 +WTHEXT DC X'02020202020202020202020202020202' 0 20318000 + DC X'02020202020202020202020202020202' 1 20320000 + DC X'02020202020202020202020202020202' 2 20322000 + DC X'02020202020202020202020202020202' 3 20324000 + DC X'02020202020202020202020202020202' 4 20326000 + DC X'02020202020202020202020202020202' 5 20328000 + DC X'02020202020202020202020202020202' 6 20330000 + DC X'02020202020202020202020202020202' 7 20332000 + DC X'02020202020202020202020202020202' 8 20334000 + DC X'02020202020202020202020202020202' 9 20336000 + DC X'02020202020202020202020202020202' A 20338000 + DC X'02020202020202020202020202020202' B 20340000 + DC X'02000000000000020202020202020202' C 20342000 + DC X'02020202020202020202020202020202' D 20344000 + DC X'02020202020202020202020202020202' E 20346000 + DC X'00000000000000000000020202020202' F 20348000 +* TABLE FOR HEXADECIMAL INPUT CONVERSIONS. * 20350000 +WTHEX2 EQU *-C'A' OFFSET SYMBOL FROM TABLE CORRECTLY 20352000 +* TR TABLE 0 1 2 3 4 5 6 7 8 9 A B C D E F * 20354000 + DC X'0A0B0C0D0E0F000000000000000000' C 20356000 + DC X'00000000000000000000000000000000' D 20358000 + DC X'00000000000000000000000000000000' E 20360000 + DC X'00010203040506070809' F 20362000 + EJECT 20364000 +* USED TO SCAN ACROSS SYMBOLS,STOP ON DELIMITERS * 20366000 +* CHARACTERS $,#,@,A-Z,0-9 ARE ZERO. ALL OTHERS ARE NONZERO * 20368000 +* ALSO USED IN EVALUT FOR OPERATOR CODES- (+*)-/, * 20370000 +* TR TABLE 0 1 2 3 4 5 6 7 8 9 A B C D E F * 20372000 +WTSYMT DC X'01010101010101010101010101010101' 0 20374000 + DC X'01010101010101010101010101010101' 1 20376000 + DC X'01010101010101010101010101010101' 2 20378000 + DC X'01010101010101010101010101010101' 3 20380000 + DC X'04010101010101010101010101020501' 4 BLANK (+ 20382000 + DC X'01010101010101010101010007030101' 5 $*) 20384000 + DC X'06080101010101010101010401010101' 6 -/, 20386000 + DC X'01010101010101010101010000010101' 7 #@ 20388000 + DC X'01010101010101010101010101010101' 8 20390000 + DC X'01010101010101010101010101010101' 9 20392000 + DC X'01010101010101010101010101010101' A 20394000 + DC X'01010101010101010101010101010101' B 20396000 + DC X'01000000000000000000010101010101' C A-I 20398000 + DC X'01000000000000000000010101010101' D J-S 20400000 + DC X'01010000000000000000010101010101' E S-Z 20402000 + DC X'00000000000000000000010101010101' F 0-9 20404000 +WTZTAB EQU WZEROS SPACE FOR 256-BYTE ZEROED TRT TABLE 20406000 + DS 0D LINE UP BLANKS ON D BOUNDARY 20408000 +WBLANK DC CL132' ' BLANKS 20410000 + ORG WBLANK+16 OVERLAP WBLANK&WTHEX3 20412000 + SPACE 1 20414000 +* TABLE USED TO CONVERT INTERNAL BINARY TO EXTERNAL HEX. * 20416000 +* TR TABLE 0123456789ABCDEF0123456789ABCDEF * 20418000 +WTHEX3 DC C' ' 0-1 20420000 + DC C' ' 2-3 20422000 + DC C' ' 4-5 20424000 + DC C' ' 6-7 20426000 + DC C' ' 8-9 20428000 + DC C' ' A-B 20430000 + DC C' ' C-D 20432000 + DC C' 0123456789ABCDEF' E-F 20434000 + SPACE 1 20436000 +WEP4 DC X'40202120' 4-BYTE DECIMAL EDIT PATTERN 20438000 +WEP6 DC X'402020202120' 6-BYTE EDIT PATTERN FOR DEC # 20440000 +WP0 DC PL1'0' FOR ZEROING DECIMAL COUNTERS 20442000 +WP1 DC P'1' DECIMAL CONSTANT 1 20444000 +WCONADS DS ($CNT$N)AL1 SPACE FOR CONSTANT OFFSET TABLE 20446000 + WCONG (A,B,C,D,E,F,H,P,V,X,Z) GENERATE OFFSETS IN WCONAD 20448000 + EJECT 20450000 +* * * * * AVWXTABL SECTION V - VARIABLES * * * * * * * * * * * * * * * 20452000 + DS 0D GET ALIGNEMENT 20454000 +* **NOTE** FOLLOWING SECTION SHOULD MIRROR AV- SECTION OF * 20455000 +* AVWXTABL DSECT, BUT HAS BEEN REMOVED, BECAUSE NO CODE IS * 20456000 +* ACTUALLY GENERATED, AND FINAL ORG TAKES CARE OF LENGTH. * 20458000 + ORG VWXTABL+AVWXEND-AVWXTABL MAKE SURE AS BIG AS AVWXTB 20700000 + AIF (NOT &$XREF).XXNOXRF J 21000000 +XREFTAB DSECT 21000010 +XREFSYM DS F @ OF SYMBOL'S SYMSECT ENTRY 21000020 +XREFLLNK DS H LEFT LINK TO NEXT SYMBOL IN TREE 21000030 +XREFRLNK DS H RIGHT LINK TO NEXT SYMBOL IN TREE 21000040 +XREFBLCK DS F @ OF BLOCK WITH STATEMENT NUMBERS 21000050 +XREFTLGN EQU *-XREFTAB LENGTH OF XREF TABLE ENTRY 21000060 +XREFBLK DSECT 21000070 +XRBLKNUM DS F NEG # OF SLOTS LEFT IN BLOCK OR 21000080 +* POINTER TO NEXT BLOCK OF REFERENCES 21000090 + DS &$XREF#B.H SLOTS FOR STMT NUMBERS 21000100 +XREFBLGN EQU *-XREFBLK LENGTH OF BLOCK OF STMT # 21000110 +XRPL EQU &$PRTSIZ SET UP XREF LINE LENGTH = MAX LENG J 21000120 +XRPLAST EQU XRPL-18 OFFSET: LAST PLACE TO START L 21000130 + TITLE 'XREFA - CROSS REFERENCE FACILITY' 21000140 +**--> CSECT: XREFA CROSS REFERENCE CONTROL SECTION................... 21000150 +*. WRITTEN BY ALICE FELTE,ALAN ARTZ, AND RICH LONG . 21000160 +*. ---SPRING/SUMMER 1973 . 21000170 +*. . 21000180 +*. THIS CSECT IS THE MAIN CONTROL SECTION FOR THE CROSS REFERENCE . 21000190 +*. FOR ASSIST. IT HAS THREE ENTRY POINTS WHICH WILL BE DESCRIBED LATER. 21000200 +*. THIS ROUTINE CONTROLS ALL THE CROSS-REFERENCE FACILITY IF IT IS TO . 21000210 +*. BE GENERATED. THE FIRST PASS THE FLAGS AND LOCATION COUNTER ARE . 21000220 +*. INITIALIZED--XRINT1. SPACE IS ALLOCATED FOR THE CROSS-REFERENCE . 21000230 +*. ENTRIES AND NECESSARY FLAGS ARE SET FOR THE SECOND PASS--XRINT2. . 21000240 +*. THE *XREF CARD WILL BE SCANNED BY XRSCAN. . 21000250 +*. . 21000260 +*. XRINT1: PASS ONE INITIALIZATION . 21000270 +*. CALLED FROM MPCON0. . 21000280 +*. 1) INITIALIZE THE ADDITIONAL LOCATION COUNTER, . 21000290 +*. AVXRLNCN, TO 1. . 21000300 +*. 2) INITIALIZE THE COUNTER, AVXRCNT, FOR THE NUMBER OF . 21000310 +*. REFERENCES TO 0. . 21000320 +*. . 21000330 +*. XRINT2: PASS TWO INITIALIZATION . 21000340 +*. CALLED FROM MTCON2. . 21000350 +*. 1) ALLOCATE SPACE USING THE MACRO $ALLOCH TO THE . 21000360 +*. DSECT, XREFTAB, SIZE * THE NUMBER OF REFERENCES . 21000370 +*. TO BE COLLECTED AND INITIALIZE ALL SPACE TO 0. . 21000380 +*. 2) SET AVXRLAVS TO FIRST FREE NODE. . 21000390 +*. 3) SET HEADER NODE FOR THE TREE STRUCTRUE EQUAL TO 0. . 21000400 +*. . 21000410 +*. XRSCAN: CARD SCANNING ROUTINE. . 21000420 +*. A FLAG IS PASSED IN A REGISTER TO DETERMINE WHICH . 21000430 +*. PASS IS BEING PROCESSED. FOR THE FIRST PASS, SCAN THE . 21000440 +*. CARD AND SET THE SD FLAG ACCORDINGLY. FOR THE SECOND . 21000450 +*. PASS, SCAN THE CARD AND SET THE SR FLAG ACCORDINGLY. . 21000460 +*. . 21000470 +*...................................................................... 21000480 +XREFA CSECT 21000500 + ENTRY XRINT1,XRINT2,XRSCAN 21000510 + EJECT 21000520 +**--> ENTRY: XRINT1 PASS ONE INITIALIZATION........................ 21000530 +*. THIS IS CALLED FROM MPCON0 ONLY ONCE . 21000540 +*. MODULE DESCRIPTION-- . 21000550 +*. INITIALIZES AVXRLNCT, THE ADDITIONAL LINE COUNTER, TO 1 . 21000560 +*. AND AVXRCNT, COUNTER FOR THE NUMBER OF REFERENCES FOUND, TO 0. 21000570 +*. . 21000580 +*...................................................................... 21000590 + SPACE 2 21000600 +XRINT1 EQU * ENTRY INITIALIZATION FIRST PASS 21000610 + USING *,R15 21000620 + USING AVWXTABL,RAT MAIN TABLE USING 21000630 + ZAP AVXRLNCN(3),AWP1 INITIALIZE ADDITIONAL LINE COUNTER 21000640 + MVC AVXRCNT(2),AWZEROS INITIALIZE # OF REFERENCES TO 0 21000650 + MVI XRSDORSR,C'D' FOR SD= SCAN ON *XREF CARDS L 21000655 + MVC XRFLAGSV,AVXRFLAG SAVE FLAG 21000660 + NI AVXRFLAG,X'FF'-AVXRSRFT-AVXRSRMD ZAP, NO PASS 1 REFS 21000680 +XRI1RET BR R14 RETURN 21000690 + DROP R15,RAT 21000700 + SPACE 3 21000710 +**--> ENTRY: XRINT2 PASS TWO INITIALIZATION........................ 21000720 +*. THIS IS CALLED FROM MPCON0 ONLY ONCE. . 21000730 +*. MODULE DESCRIPTION-- . 21000740 +*. ALLOCATES A BLOCK OF SPACE USING $ALLOCH WHERE THE SIZE . 21000750 +*. IS AVXRCNT * XRSIZE. IT SET AVXRLAVS TO THE ADDRESS OF THE . 21000760 +*. BEGINNING OF THE BLOCK OR FIRST FREE NODE AS RETURNED BY . 21000770 +*. $ALLOCH. IT ALSO SETS AVXRHEAD, THE HEADER POINTING TO THE . 21000780 +*. FIRST ENTRY IN THE TREE, EQUAL TO 0. . 21000790 +*. . 21000800 +*...................................................................... 21000810 + SPACE 2 21000820 +XRINT2 EQU * ENTRY INITIALIZATION SECOND PASS 21000830 + USING *,R15 21000840 + USING AVWXTABL,RAT MAIN TABLE USING 21000850 + USING XREFTAB,RB CROSS REFERENCE TABLE 21000860 + TM AVXRFLAG,AVXRON IS XREF WANTED 21000870 + BZ XRI2RET NO, RETURN 21000880 + MVI XRSDORSR,C'R' FOR SR= SCAN ON *XREF CARDS L 21000885 + MVC AVXRFLAG,XRFLAGSV RESTORE FOR REF COLL BITS 21000890 + LA RC,XREFTLGN GET LENGTH OF XREF TABLE ENTRY 21000900 + MH RC,AVXRCNT GET AMOUNT OF SPACE TO BE ALLOCATED 21000910 +XRI2ALLO $ALLOCH RB,RC,XRI2OVFL ALLOCATE SPACE FOR TABLE 21000920 + MVC AVXRHEAD(4),AWZEROS HEADER WILL BE NULL 21000930 + ST RB,AVXRLAVS PUT @ OF SPACE IN FREE SPACE LIST 21000950 + MVI AVXRTYPE,AVXRFTCH MAKE SURE FETCH TYPE REF NORMAL J 21000980 + MVC AVXRLNCN(3),AVOULNCN INITIALIZE LINE COUNTER 21000990 + BR R14 RETURN 21001000 +* CANCEL XREF OPTION AND SET OVERFLOW FLAG 21001010 +XRI2OVFL NI AVXRFLAG,X'FF'-AVXRON TURN XREF OFF 21001020 + OI AVTAGS3,AVOVERFL SHOW OVERFLOW OCCURRED 21001030 +XRI2RET BR R14 RETURN 21001040 +XRFLAGSV DC AL1($),X'0' SAVE WORD, PAD 21001050 + DROP RAT,RB 21001060 + EJECT 21001070 +**--> ENTRY: XRSCAN CARD SCANNING ROUTINE.......................... 21001080 +*. THIS IS CALLED FROM MOCON1 AND MTCON2 TO SCANN THE *XREF CARD. 21001090 +*. . 21001100 +*. ENTRY CONDITIONS-- RA @ TO BEGIN *XREF PARM SCAN . 21001110 +*. RD IDX TO SET FLAGS(0=PASS 1,8=PASS 2) . 21001120 +*. . 21001170 +*. MODULE DESCRIPTION-- . 21001180 +*. CHECK TO SEE WHICH PASS IT IS IN. DEPENDING ON WHICH . 21001190 +*. PASS IT IS, THE *XREF CARD IS SCANNED AND THE FLAGS SET. . 21001200 +*. IF IT IS PASS ONE, THE CARD IS SCANNED FOR SD=. IF IT . 21001210 +*. NOT THERE, AVXRFLAG IS NOT CHANGED. IF IT IS, CHECK FOR . 21001220 +*. LEGAL VALUES OF *, 0, OR 1. IF IT IS NONE OF THESE THREE, . 21001230 +*. THE STATEMENT IS FLAGGED WITH A SYNTAX ERROR. IF IT IS A . 21001240 +*. LEGAL VALUE, THE AVXRFLAG IS SET ACCORDINGLY. . 21001250 +*. IF IT IS PASS TWO, THE CARD IS SCANNED SR= AND IS . 21001260 +*. PROCESSED SIMILARLY TO SD= ABOVE. . 21001270 +*. . 21001280 +*...................................................................... 21001290 + SPACE 2 21001300 +XRSCAN $SAVE RGS=(R14-R6),SA=NO SAVE REGISTERS TO BE USED 21001310 + USING AVWXTABL,RAT MAIN TABLE USING 21001320 + TM AVXRFLAG,AVXRON IS XREF ON? 21001330 + BZ XRRETURN NO, RETURN 21001340 + LA RC,1 USEFUL CONSTANT 21001360 + $SETRT ('S',1) SET UP AWTZTAB TO STOP ON S L 21001370 + LA RE,65(RA) LAST @ TO CHECK FOR 'S' L 21001380 +* 21001450 +* PASS 1 -- SCAN FOR SD= AND SET AVWXFLAG ACCORDINGLY F 21001460 +* PASS 2 -- SCAN FOR SR= AND SET AVWXFLAG ACCORDINGLY L 21001470 +* 21001480 +XRSTRT LR RB,RE RB=END OF SCAN L 21001485 + SR RB,RA DETERMINE MACHINE LENGTH FOR EX INST 21001490 + EX RB,XRSEXTRT SCAN FOR 'S' L 21001510 + BZ XRRETURN IF NOT FOUND,RETURN F 21001520 + CLC 1(2,R1),XRSDORSR CHK FOR D= (PASS1),R= (PASS2) L 21001530 + BE *+8 YES, CHECK FOR LEGAL NUMBER L 21001540 + BXH RA,RC,XRSTRT INCR & CHECK FOR ANOTHER S L 21001550 +* 21001560 +* CHECK MODIFY CHAR FOR '*', '0', OR '1'. ANYTHING ELSE IS ILLEGAL F 21001570 +* 21001580 + LA RA,3(R1) GET @ OF MODIFY CHAR L 21001590 + CLI 0(RA),C'0' IS IT 0 F 21001600 + BE XRM0(RD) YES, SET FLAG L 21001610 + CLI 0(RA),C'1' IS IT 1 F 21001620 + BE XRM1(RD) YES SET FLAG L 21001630 + CLI 0(RA),C'*' IS IT * L 21001640 + BNE XRSDSRER ERROR IF NOT L 21001650 +* F 21001660 +* CHECK FETCH CHAR FOR '*', '0', '1', ',', OR ' '. ANYTHING ELSE F 21001670 +* IS AN ERROR. MARK IT SYNTAX ERROR F 21001680 +* F 21001690 +XRNUM2 AR RA,RC GET @ OF FETCH CHAR L 21001700 + CLI 0(RA),C'0' IS IT 0 F 21001710 + BE XRF0(RD) YES, SET AVXRFLAG L 21001720 + CLI 0(RA),C'1' IS IT 1 F 21001730 + BE XRF1(RD) YES, SET AVXRFLAG L 21001740 + CLI 0(RA),C'*' IS IT * 21001750 + BNE *+6 NO, CHECK FOR ',' OR ' ' L 21001760 +* F 21001770 +* CHECK FOR A BLANK OR COMMA. IF IT IS BLANK, RETURN F 21001780 +* IF IT IS COMMA, SCAN REST OF CARD F 21001790 +* F 21001800 +XRBLNK AR RA,RC NO CHANGE NECESSARY CHECK FOR ',' L 21001810 + CLI 0(RA),C' ' IS IT BLANK L 21001820 + BE XRRETURN YES, RETURN F 21001830 + CLI 0(RA),C',' IS IT A COMMA F 21001840 + BE XRSTRT GO TO SCAN REST OF THE CARD L 21001850 +XRSDSRER LA RB,$ERVSYNT SET ERROR CODE 21001860 + $CALL ERRTAG CALL ERROR ROUTINE 21001870 +* 21001880 +* RETURN TO CALLING ROUTINE 21001890 +XRRETURN $SETRT ('S',0) RESET AWTZTAB TO ZERO 21001900 + $RETURN RGS=(R14-R6),SA=NO 21001920 +* SET AVXRFLAG APPROPRIATELY L 21001930 +XRM0 NI AVXRFLAG,X'FF'-AVXRSDMD SET SD MODIFY OFF L 21001940 + B XRNUM2 GET 2ND # L 21001950 + NI AVXRFLAG,X'FF'-AVXRSRMD SET SR MODIFY OFF L 21001960 + B XRNUM2 GET 2ND # L 21001970 +XRM1 OI AVXRFLAG,AVXRSDMD SET SD MODIFY ON L 21001980 + B XRNUM2 GET 2ND # L 21001990 + OI AVXRFLAG,AVXRSRMD SET SR MODIFY L 21002000 + B XRNUM2 GET 2ND # L 21002010 +XRF0 NI AVXRFLAG,X'FF'-AVXRSDFT SET SD FETCH OFF L 21002020 + B XRBLNK GO CHECK FOR ',' OR ' ' L 21002030 + NI AVXRFLAG,X'FF'-AVXRSRFT SET SR FETCH FLAG OFF L 21002040 + B XRBLNK GO CHECK FOR ',' OR ' ' L 21002050 +XRF1 OI AVXRFLAG,AVXRSDFT SET SD FETCH ON L 21002060 + B XRBLNK GO CHECK FOR ',' OR ' ' L 21002070 + OI AVXRFLAG,AVXRSRFT SET SR FETCH FLAG ON L 21002080 + B XRBLNK GO CHECK FOR ',' OR ' ' L 21002090 +XRSEXTRT TRT 0($,RA),AWTZTAB SEARCH FOR AN S L 21002095 + DROP RAT L 21002100 +XRSDORSR DC C'$=' $ REPLACED BY D(PASS 1) OR R(PASS2) 21002110 + LTORG 21002120 + TITLE 'XRCOLL - CROSS REFERENCE COLLECTION ROUTINE' 21002730 +**--> CSECT: XRCOLL COLLECTION ROUTINE............................. 21002740 +*. THIS IS CALLED BY SYFIND AFTER IT IS FOUND THAT THE SYMBOL . 21002750 +*. IS DEFINED AND THE REFERENCE IS TO BE COLLECTED. . 21002760 +*. . 21002770 +*. ENTRY CONDITIONS-- RA HAS THE ADDRESS OF THE SYMBOL IN THE . 21002780 +*. SYMBOL TABLE. . 21002790 +*. . 21002800 +*. MODULE DESCRIPTION-- . 21002810 +*. AVXRHEAD HAS THE ADDRESS OF THE FIRST NODE IN THE TREE. . 21002820 +*. AVXRLAVS HAS THE ADDRESS OF THE FIRST AVAILABEL FREE NODE . 21002830 +*. . 21002840 +*. THE FOLLOWING ALGORITHM IS FROM "THE ART OF COMPUTER . 21002850 +*. PROGRAMMING" VOL. 1 'FUNDAMENTAL ALGORITHMS' BY DONALD KNUTH. 21002860 +*. CHECK HEADER 'AVXRHEAD' FOR EMPTY TREE(= 0). IF EMPTY, . 21002870 +*. EXECUTE INSUB 'XRCLAVS' TO GET FREE NODE FOR PROCESSING. . 21002880 +*. 'XRCLAVS' INSERTS SYMBOL AND INITIALIZES LINKS IN NODES--- . 21002890 +*. LEFT LINK=0,RIGHT KINK=-1 (ODD DISPLACEMENT IMPOSSIBLE, NEGA-. 21002900 +*. TIVE TO SIMPLIFY CHECKS IN XRPRNT ROUTINE). IF NOT EMPTY, . 21002910 +*. DETERMINE WHETHER OR NOT A NODE HAS ALREADY BEEN CREATED FOR . 21002920 +*. THE PRESENT SYMBOL BY COMPARING THE ADDRESS OF THE SYMBOL . 21002930 +*. IN REG RA TO THE ADDRESSES OF SYMBOLS ALREADY IN THE TREE . 21002940 +*. NODES. IF EQUAL, PROCESS THE REFERENCE (DESCRIBED LATER). . 21002950 +*. OTHERWISE, COMPARE ACTUAL SYMBOLS TO DETERMINE WHERE IN THE . 21002960 +*. TREE THE NEWLY CREATED NODE SHOULD BE INSERTED. IF THE NEW . 21002970 +*. SYMBOL IS SMALLER IN VALUE THAN THAT OF A NODE IN TREE, THE . 21002980 +*. COMPARISON CONTINUES WITH IT'S LEFT SUBTREE. IF LARGER, COM-. 21002990 +*. PARISON CONTINUES WITH RIGHT SUBTREE. WHEN A ZERO LEFT LINK . 21003000 +*. IS FOUND, OR NEGATIVE RIGHT LINK, THE LINK IS CHANGED TO . 21003010 +*. POINT TO THE NODE WHICH WILL CONTAIN THE INFO FOR THE NEW . 21003020 +*. SYMBOL(NODE FETCHED AND INITIALIZED BY 'XRCLAVS'. . 21003030 +*. . 21003040 +*. PROCESSING THE REFERENCES: . 21003050 +*. ONCE THE SYMBOL IS PLACED IN THE TREE, THE REFERENCE . 21003060 +*. MUST BE ENTERED IN A BLOCK OF REFERENCES. THIS IS DONE IN . 21003070 +*. THE FOLLOWING MANNER: . 21003080 +*. 1) IF THE PTR TO THE BLOCK OF REFERENCES IS NULL . 21003090 +*. (I.E. FIRST REFERENCE), A BLOCK MUST BE . 21003100 +*. ALLOCATED AND THE ADDRESS PLACED IN THE POINTER . 21003110 +*. OF THE XREFTAB. . 21003120 +*. 2) IF IT IS NOT NULL, THE POINTER IS AN ADDRESS AND . 21003130 +*. THE BLOCK CAN BE LOCATED. . 21003140 +*. . 21003150 +*. 3) THE FIRST FULLWORD OF THE REFERENCE-BLOCK . 21003160 +*. CONTAINS EITHER: . 21003170 +*. A) THE NUMBER OF SLOTS LEFT IN THE BLOCK. . 21003180 +*. THE REFERENCE MAY BE ENTERED IN THE BLOCK, THE . 21003190 +*. NUMBER OF SLOTS IS DECREMENTED BY 1. . 21003200 +*. B) NEGATIVE ADDRESS OF AN ADDITIONAL BLOCK . 21003210 +*. C) ZERO, MEANING A NEW BLOCK MUST BE ALLOCATED. . 21003220 +*. ALLOCATE A NEW BLOCK AND SET THE POINTER IN . 21003230 +*. PRECEDING BLOCK TO IT (NEGATIVE ADDRESS). THEN . 21003240 +*. A) MAY BE FOLLOWED. . 21003250 +*...................................................................... 21003260 + SPACE 2 21003270 +* * * * REGISTER USAGE: XRCOLL * * * * * * * * * * * * * * * * * * * * 21003280 +* R0= X'0000FFFF' USED TO INITIALIZE NODE LINKS * 21003290 +* RW= @ NODE IN XREF LIST BEING CHECKED (@ XREFTAB) * 21003300 +* RX= @ SYMSECT OF SYMBOL ALREADY IN XREF TABLE * 21003310 +* RA= @ SYMSECT OF SYMBOL TO BE CHECKED IN XREFTAB * 21003320 +* RB= @ BEGIN OF XREF TABLE (FROM WHICH OFFSETS COMPUTED) * 21003330 +* RC,RD,RE,RY,RZ WORK REGISTERS * 21003340 +* R14= INTERNAL LINKAGE * 21003350 +* R15= BASE REGISTER * 21003360 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 21003370 + SPACE 2 21003380 +XRCOLL CSECT 21003390 + $SAVE RGS=(R14-R6),SA=NO 21003400 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 21003420 + USING XREFTAB,RW CROSS TABLE (POINTERS) 21003430 + L R0,AWFXFFFF =X'0000FFFF' USED TO INIT PTRS J 21003440 + MVC AVDWORK2,AWBLANK PREPARE FOR SYMBOL TO BE CHECKED 21003450 + USING SYMSECT,RA 21003460 + IC RD,SYCHARS GET LENGTH OF LABEL 21003480 + EX RD,XRCSYMO MOVE SYMBOL TO PADDED AREA FOR COMP 21003490 + DROP RA DROP SO USING ON RX OK 21003500 + L RW,AVXRHEAD GET HEADER POINTER TO FIRST NODE 21003510 + LTR RB,RW IS IT ZERO, NO NODES ALLOCATED 21003520 + BNZ XRCSYMCK SYMBOLS IN TABLE - BRANCH 21003530 + SPACE 1 21003540 +* FIRST SYMBOL - ALLOC SPACE,SET AVXRHEAD 21003550 + BAL R14,XRCLAVS CALL ALLOCATE ROURINE 21003560 + ST RW,AVXRHEAD POINTER TO 1ST ENTRY 21003570 + LR RB,RW RB--> TOP OF TREE 21003580 + B XRCNUENT GO TO FILL IN 21003590 + SPACE 1 21003600 +XRCSYMCL LA RW,0(RY,RB) GET @ NEXT NODE 21003610 + USING SYMSECT,RX SYMBOL TABLE USING 21003620 +XRCSYMCK L RX,XREFSYM GET @ OF SYMSECT ENTRY FOR SYMBOL 21003630 + MVC AVDWORK1(8),AWBLANK INITIALIZE WORK AREA TO BLANKS 21003640 + IC RD,SYCHARS GET LENGTH OF LABEL 21003650 + EX RD,XRCSYMN MOVE SYMBOL TO PADDED FIELD 21003660 + DROP RX 21003670 + CLC AVDWORK2(8),AVDWORK1 COMPARE SYMBOLS TO SEE IF WANTED 21003680 + BE XRCENTER IF EQUAL, HAVE TO ENTER STMT # INTO 21003690 + BH XRCRIGHT IF> GO TO RIGHT LINK AND CHECK AGAIN 21003700 +* IF < GO TO LEFT LINK AND CHECK AGAIN 21003710 + LH RY,XREFLLNK GET DISP OF LINK IN TABLE 21003720 + LTR RY,RY IS IT THE END OF TREE 21003730 + BNZ XRCSYMCL NO, LOOP 21003740 +* 21003750 +* ENTER NEW NODE INTO TREE - LEFT LINKED 21003760 +* 21003770 +XRCNULEF BAL R14,XRCLAVS GET A NEW NODE 21003780 + LR RZ,RB TO SAVE @ OF OLD NODE 21003790 + SR RZ,RX COMPUTE DISPLACEMENT OF OLD NODE 21003800 + STH RZ,XREFRLNK STORE THREAD TO PREVIOUS NODE 21003810 + USING XREFTAB,RX 21003820 + LR RZ,RW TO SAVE @ OF NEW NODE 21003830 + SR RZ,RB COMPUTE DISP OF NEW NODE 21003840 + STH RZ,XREFLLNK STORE INTO LEFT LINK OF PREV NODE 21003850 + DROP RX 21003860 + B XRCNUENT NOW READY TO ENTER STMT NUMBER 21003870 + SPACE 1 21003880 +XRCRIGHT LH RY,XREFRLNK DET DISP OF LINK IN TABLE 21003890 + LTR RY,RY IS IT THE END OF THE LIST 21003900 + BP XRCSYMCL NO,LOOP 21003910 +* 21003920 +* ENTER NEW NODE INTO TREE - RIGHT LINKED 21003930 +* 21003940 +XRCNURIT BAL R14,XRCLAVS GET A NEW NODE 21003950 + LR RZ,RW TO SAVE @ OF NEW NODE 21003960 + SR RZ,RB GET DISP OF NEW NODE 21003970 + USING XREFTAB,RX 21003980 + LH RY,XREFRLNK GET RIGHT LINK OF OLD NODE 21003990 + STH RZ,XREFRLNK STORE DISP OF NEW NODE IN RLINK OF L 21004000 + DROP RX 21004010 + STH RY,XREFRLNK STORE RLINK OF OLD NODE IN NEW 21004020 +* 21004030 +* ALLOCATE NEW BLOCK FOR REFERENCES 21004040 +* 21004050 +XRCNUENT LA RY,XREFBLGN GET LENGTH OF BLOCK TO BE ALLOCATED 21004060 + $ALLOCH RX,RY,XRCOVFLW ALLOCATE A BLOCK FOR REFERENCE 21004070 + USING XREFBLK,RX XREF BLOCK OF STMT NUMBERS 21004080 + ST RX,XREFBLCK STORE POINTER TO BLK OF REFERENCES 21004090 + USING SYMSECT,RA 21004100 + B XRCLBLK GO INSERT STATEMENT NUMBER 21004110 +* ENTER HERE IF OLD SYMBOL 21004120 +XRCENTER L RX,XREFBLCK GET ADDRESS OF REFERENCE BLOCK 21004130 +XRCNXBLK L RY,XRBLKNUM GET NUB OF SPACES LEFT OR @ NEXT BLK 21004140 + LTR RY,RY IS IT ZERO 21004150 + BP XRCSTMT# POSITIVE, PUT STMT # INTO BLOCK 21004160 + BZ XRCALLOC ALLOCATE NEW BLOCK IF 0 21004170 + LPR RX,RY RX--> NEXT REFERENCE BLOCK 21004180 + B XRCNXBLK GO SEE IF THIS BLOCK HAS ROOM 21004190 +* ALLOCATE ADDITIONAL REFERENCE BLOCK 21004200 +XRCALLOC LA RY,XREFBLGN GET LENGTH TO BE ALLOCATED 21004210 + LR RZ,RX SAVE @ OF FILLER REFERENCE BLOCK 21004220 + $ALLOCH RX,RY,XRCOVFLW ALLOCATE NEW BLOCK OF REFERENCES 21004230 + LNR RY,RX ADDITIONAL BLK @ IS NEGATIVE 21004240 + ST RY,0(RZ) STORE @ OF NEW BLOCK INTO FILLED BLK 21004250 +XRCLBLK LA RY,&$XREF#B GET MAX AVAIL STMT SLOTS,IDX TO 1ST 21004260 +* 21004270 +* INSERT STATEMENT NUMBER INTO REFERENCE BLOCK (- IF MODIFY) 21004280 +* 21004290 +XRCSTMT# LA RC,2(RY,RY) GET DISPLACEMENT OF OPEN SLOT 21004300 + ZAP AVDWORK1(8),AVXRLNCN GET STMT # OF REFERENCE 21004310 + CVB RZ,AVDWORK1 GET STMT # OF REFERENCE 21004320 + TM AVXRTYPE,AVXRFTCH IS IT A FETCH REF 21004330 + BNZ *+6 NO, MUST BE A MODIFY REFERENCE 21004340 + LNR RZ,RZ GET NEGATIVE STMT # INTO REF BLOCK 21004350 + STH RZ,0(RC,RX) STORE STMT # OF REFERENCE 21004360 + BCTR RY,0 DECREMENT # OF SLOTS 21004370 + ST RY,XRBLKNUM STORE REMAINING # OF SLOTS 21004380 +XRCRET $RETURN RGS=(R14-R6),SA=NO 21004410 + DROP RX 21004420 + SPACE 3 21004430 +*.--> INSUB: XRCLAVS . . . . . . . . . . . . . . . . . . . . . . . . . 21004440 +*. GET THE FIRST FREE NODE FROM THE LIST OF AVAILABLE . 21004450 +*. SPACE, AVXRLAVS. SETS AVXRLAVS TO POINT TO THE NEW FIRST . 21004460 +*. FREE NODE. STORES THE ADDRESS OF THE SUMBOL'S SYMSECT ENTRY . 21004470 +*. IN THE NEW NODE. . 21004480 +*. RW HAS THE ADDRESS OF THE NEW NODE . 21004490 +*. RX HAS ADDRESS OF OLD NODE . 21004500 +*. LEFT LINK INITIALIZED TO ZERO; RIGHT LINK TO -1 . 21004510 +*. NOTE: IT IS POSSIBLE TO HAVE THREAD OF A NODE POINT BACK TO . 21004520 +*. ROOT NODE WHICH HAS INDEX DISPLACEMENT OF ZERO. SINCE -0 IS . 21004530 +*. NOT DISTINGUISHABLE FROM +0, THE END OF THE TREE IS DENOTED . 21004540 +*. BY -1 VICE 0 . 21004550 +*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 21004560 + SPACE 2 21004570 +XRCLAVS LR RX,RW SAVE ADDRESS OF OLD NODE 21004580 + L RW,AVXRLAVS ADDRESS OF FIRST FREE NODE 21004590 + LA RZ,XREFTLGN(RW) GET @ OF NEXT FREE NODE 21004600 + ST RZ,AVXRLAVS SAVE @ OF NEW FIRST FREE NODE 21004610 + ST RA,XREFSYM STORE @ OF SYMBOLS' SYMSECT ENTRY IN 21004620 + ST R0,XREFLLNK ZERO BOTH LINKS 21004630 + BR R14 RETURN 21004640 + SPACE 3 21004650 +* 21004660 +* COMES HERE WHEN IT DOES NOT HAVE ENOUGH SPACE TO ALLOCATE A NEW 21004670 +* REFERENCE BLOCK 21004680 +* 21004690 +XRCOVFLW OI AVTAGS3,AVOVERFL SET OVERFLOW FLAG ON 21004700 + MVI AVXRFLAG,X'00' DISARM FLAG NEVER TO RETURN L 21004705 + B XRCRET RETURN 21004710 +XRCSYMN MVC AVDWORK1($),SYMBOL-SYMSECT(RX) MOVE SYMBOL ALREADY IN 21004720 +* TREE TO WORK AREA 21004730 +XRCSYMO MVC AVDWORK2($),SYMBOL MOVE NEW SYMBOL TO WORK AREA 21004740 + DROP RW,RA,RAT 21004750 + LTORG 21004755 + TITLE 'XRPRNT - CROSS REFERENCE PRINT ROUTINE' 21004760 +**--> CSECT: XRPRNT PRINT ROUTINE.................................. 21004770 +*. CALLED FROM MPCON0 TO PRINT OUT THE CROSS REFERENCE. . 21004780 +*. THE COMPRESS BIT OF AVXRFLAG IS TESTED BY AVXRCOMP TO . 21004790 +*. DETERMINE WHICH FORMAT TO USE FOR PRINTING. IF IT IS OFF, . 21004800 +*. EACH REFERENCE SYMBOL IS PRINTED ON A NEW LINE. IF IT IS ON,. 21004810 +*. THE REFERENCED LABELS ARE PRINTED MORE THAN ONE PER LINE IF . 21004820 +*. THERE IS ROOM. . 21004830 +*. THE FOLLOWING ALGORITHM IS FROM "THE ART OF COMPUTER . 21004840 +*. PROGRAMMING" VOL. 1 'FUNDAMENTAL ALGORITHMS' BY DONALD KNUTH. 21004850 +*. THE TREE IS THEN TRAVERSED IN POSTORDER. . 21004860 +*. GET THE ADDRESS OF THE FIRST NODE IN THE TREE FROM . 21004870 +*. AVXRHEAD. IF IT IS 0, PRINT A MESSAGE THAT NO SYMBOLS . 21004880 +*. HAVE BEEN REFERENCED. IF IT IS NOT 0, FOLLOW THE LEFT . 21004890 +*. LINKS UNTIL IT IS 0. THEN PRINT THE SYMBOL FROM THE . 21004900 +*. NODE AND ALL ITS REFERENCES. NOTE: A NEGATIVE . 21004910 +*. REFERENCE IS A MODIFY AND A POSITIVE REFERENCE IS A . 21004920 +*. FETCH. IT IS PRINTED ACCORDING TO THE FORMAT DESCRIBED . 21004930 +*. ABOVE. . 21004940 +*. THEN THE RIGHT LINK IS CHECKED. IF IT IS -1,WE ARE . 21004950 +*. AT THE END OF THE TREE AND RETURN TO ASSIST. . 21004960 +*. IF IT IS LESS THAN -1,IT IS A THREAD BACK TO A NODE. . 21004970 +*. GET THE POSITIVE ADDRESS OF THE NODE, PRINT THE SYMBOL . 21004980 +*. AND ITS REFERENCES. CHECK THE RIGHT LINK AGAIN. . 21004990 +*. IF IT IS POSITIVE, IT IS THE ADDRESS OF THE NEXT NODE. . 21005000 +*. GO TO THAT NODE AND CHECK ITS LEFT LINK AS ABOVE. . 21005010 +*. . 21005020 +*...................................................................... 21005030 + SPACE 2 21005040 +* * * * REGISTER USAGE: XRPRNT * * * * * * * * * * * * * * * * * * * * 21005050 +* RW= @ CURRENT XREFTAB ENTRY PROCESSED * 21005060 +* R0= LAST @ TO START STMT # (COMPRESSED OUTPUT) * 21005070 +* R2= -1 DENOTES END OF TREE * 21005080 +* RA= LAST @ TO START A SYMBOL (COMPRESSED OUTPUT) * 21005090 +* RB= @ XREFBLK BEING PROCESSED * 21005100 +* RC,RD,RZ WORK REGISTERS * 21005110 +* RE= @ OF 1ST ELEMENT (BASE FROM WHICH OFFSETS GIVEN) * 21005120 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 21005130 + SPACE 2 21005140 +XRPRNT CSECT 21005150 + $SAVE RGS=(R14-R6),SA=NO 21005160 + USING AVWXTABL,RAT MAIN TABLE USING 21005170 + USING XREFTAB,RW SET UP USINGS ON POINTER TABLE 21005180 +* 21005190 +* PRINT CROSS REFERENCE HEADERS 21005200 +* 21005210 + L RW,AVXRHEAD GET @ OF FIRST NODE IN TREE 21005220 + LTR RE,RW IS THERE AN @ THERE? 21005230 + BZ XRPRRET NO,RETURN 21005240 + $PRNT XREFTTL1,L'XREFTTL1 FIRST LINE OF HEADER 21005250 + LA RZ,XRPOUTPT+1 GET ADDRESS OF OUTPUT LINE 21005260 + LA RA,XRPOUTPT+XRPLAST LAST @ TO START SYMBOL 21005270 + LA R0,11(RA) LAST @ TO START STMT # 21005280 + SR R2,R2 SET UP REG TO FIND END OF TREE 21005290 + BCTR R2,0 -1 DENOTES END OF TREE 21005300 + MVC XRPOUTPT(XRPL),AWBLANK BLANK OUT OUTPUT LINE 21005310 + MVI XRPOUTPT,C'0' CC FOR 1ST LINE 21005320 +XRPLLNK LH RX,XREFLLNK GET LEFT LINK 21005330 + LTR RX,RX IS IT THE NODE TO BE PRINTED 21005340 + BZ XRPRNODE YES,PRINT NODE 21005360 + LA RW,0(RX,RE) @ OF NODE IN RW 21005370 + B XRPLLNK IS IT THE LAST NODE 21005380 +XRPRLNK LH RX,XREFRLNK GET RIGHT LINK 21005390 + CR RX,R2 END OF TREE? 21005400 + BE XRPRRETP -1, END OF TREE 21005420 + TM AVXRFLAG,AVXRCOMP IS IT TO BE COMPRESSED OUTPUT 21005430 + BNO XRPSYMBL NO,GO PRINT LINE 21005440 +* OUTPUT IS TO BE COMPRESSED 21005450 + LA RZ,3(RZ) SKIP 3 SPACES BEFORE NEXT SYMBOL 21005460 + CR RZ,RA IS PTR TO OR PAST THAT POINT? 21005470 + BL *+8 NO,MOVE CHARACTERS INTO LINE 21005480 +XRPSYMBL BAL R14,XRPRLINE PRINT OUTPUT LINE 21005490 + LTR RX,RX THREAD OR NODE? 21005500 + BNP *+12 A THREAD, PRINT NODE 21005510 + LA RW,0(RX,RE) @ OF NODE IN RW 21005520 + B XRPLLNK CHECK FOR LEFT 21005530 + LPR RW,RX @ OF NODE TO PRINTED 21005540 + LA RW,0(RW,RE) @ OF NODE TO BE PRINTED 21005550 + SPACE 1 21005560 +* OBTAIN AND PRINT SYMBOL 21005570 +XRPRNODE L RY,XREFSYM GET @ OF SYMBOL'S SYMSECT ENTRY 21005580 + USING SYMSECT,RY DO USING 21005590 + IC RD,SYCHARS GET LENGTH OF SYMBOL 21005600 + EX RD,XRPMOVE MOVE SYMBOL TO OUTPUT LINE 21005610 + LA RZ,9(RZ) INVREMENT PTR TO POSITION IN OUTPUT 21005620 + L RB,XREFBLCK GET @ OF REFERENCE BLOCK 21005630 + USING XREFBLK,RB SET UP REFERENCE BLOCK DSECT 21005640 + UNPK 0(7,RZ),SYVALUE+1(4) UNPACK 21005650 + MVI 6(RZ),C' ' MAKE BLANK 21005660 + TR 0(6,RZ),AWTHEX3 FINISH HEX CONVERT 21005670 + LA RZ,6(RZ) INCR PTR TO POSITION IN OUTPUT LINE 21005680 + BAL R14,XRPNUMSL GET NUM OF SLOTS USED AND TIMES LOOP 21005690 +XRPNEXT# CR RZ,R0 IS IT THE END OF THE LINE? 21005700 + BL *+8 NO GET STMT NO. 21005710 + BAL R14,XRPRLINE YES PRINT LINE 21005720 + LA RC,2(RX,RX) SAVE NUMBER TO BE PRINTED 21005730 + LH RC,0(RC,RB) PUT STM # IN REG 21005740 + CVD RC,AVDWORK2 PACKED DECIMAL VALUE OF STMT # 21005750 + MVC 0(6,RZ),AWEP6 MOVE EDIT PATTERN IN 21005760 + LA R1,5(RZ) DO NOT REMOVE..A MUST FOR 1 DIGIT,NEGATIVE L 21005762 +* STATEMENT NUMBERS..EDMK NEEDS THIS @ L 21005763 + EDMK 0(6,RZ),AVDWORK2+5 EDIT STMT # TO PRINTABLE FORM 21005770 + BNM *+10 POSITIVE STMT # (MOD REF) 21005780 + BCTR R1,0 GET @ TO INSERT - 21005790 + MVI 0(R1),C'-' INSERT MINUS SIGN TO SHOW MODIFY 21005800 + LA RZ,6(RZ) INREMENT PTR TO POS IN OUTPUT LINE 21005810 + BCTR RX,0 DECREMENT TIMES THRU LOOP 21005820 + CR RD,RX HAVE ALL REFS IN BLK BEEN COLLECTED? 21005830 + BL XRPNEXT# NO,IF LOW 21005840 + SPACE 1 21005850 + LTR RY,RY IS THERE ANOTHER BLOCK OF REFERENCES 21005860 + BNM XRPRLNK NO GET NEXT SYMBOL IN TREE 21005870 + LPR RB,RY PUT @ OF NEXT BLOCK IN RB 21005880 + BAL R14,XRPNUMSL GET NUMBER OF SLOTS USED; TIMES THRU 21005890 + B XRPNEXT# PRINT NEXT REFERENCE 21005900 +XRPMOVE MVC 0($,RZ),SYMBOL MOVE SYMBOL TO OUTPUT LINE EXECUTED 21005910 + SPACE 3 21005920 +*.--> INSUB: XRPRLINE PRINTS A LINE OF REFERENCES . . . . . . . . 21005930 +*. SETS RZ TO POINT TO THE BEGINNING OF THE LINE. CLEAR . 21005940 +*. OUTPUT LINE TO ALL BLANKS. . 21005950 +*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .. 21005960 + SPACE 2 21005970 +XRPRLINE $PRNT XRPOUTPT,XRPL,XRPMSG PRINT OUT THE LINE OF REFERENCES 21005980 + LA RZ,XRPOUTPT+1 GET ADDRESS OF OUTPUT LINE 21005990 + MVC XRPOUTPT(XRPL),AWBLANK CLEARS OUTPUT LINE 21006000 + BR R14 RETURN 21006010 + SPACE 3 21006020 +*.--> INSUB: XRPNUMSL . . . . . . . . . . . . . . . . . . . . . . . . . 21006030 +*. GETS INDEX TO 1ST REFERENCE OF BLOCK, INDEX TO LAST REFERENCE. 21006040 +*. TO PRINT, AND VALUE FROM XRBLKNUM TO USE AS FLAG FOR TEST FOR. 21006050 +*. ADDITIONAL BLOCKS LATER IN MAIN SECTION OF CODE. . 21006060 +*. RX= INDEX TO 1ST REFERENCE TO BE PRINTED . 21006070 +*. RD= INDEX TO LAST REFERENCE TO BE PRINTED . 21006080 +*. RY= FLAG USED LATER(IF - THERE IS AN ADDITIONAL BLOCK) . 21006090 +*...................................................................... 21006100 + SPACE 2 21006110 +XRPNUMSL LA RX,&$XREF#B RX=POSS # REFS(ASSUME 1ST BLOCK 21006120 + L RY,XRBLKNUM GET # OF UNUSED SLOTS 21006130 + LTR RD,RY IS IT AN @ OR # OF SLOTS 21006140 + BCR NM,R14 RD=LAST REFERENCE 21006150 + SR RD,RD RD=LAST REFERENCE 21006160 + BR R14 RETURN 21006170 + SPACE 3 21006180 +* XRPMSG EQU XRPRRET ***** RETURN ON RECORDS EXCEEDED CEH 21006190 +XRPRRETP $PRNT XRPOUTPT,XRPL,XRPMSG PRINT LAST LINE 21006200 +XRPRRET $RETURN RGS=(R14-R6),SA=NO 21006210 +XRPMSG EQU XRPRRET RETURN ON RECORDS EXCEEDED CEH 21006215 +XRPOUTPT EQU AVCONCAT WORK AREA 21006220 +XREFTTL1 DC C'0*** CROSS-REFERENCE: VALUE(HEX) LOCATION REF REF ...X21006230 + (- SHOWS MODIFY) ***' 21006240 + DROP RW,RY,RB,RAT 21006250 +.XXNOXRF ANOP 21006260 + AIF (&$REPL EQ 0).RENREPL SKIP IF NO REPLACE AT ALL 30000000 + TITLE 'RECORBLK DSECT - REPLACE CORRESPONDENCE TABLE' 30002000 +**--> DSECT: RECORBLK REPLACE MODULE-DESCRIBES 1 REAL-REPLACE PAIR. . 30004000 +*. THIS DSECT DESCRIBES 1 ENTRY IN THE TABLE RECORRAD. . 30006000 +*. WHEN AN ENTRY POINT IS REPLACED, A RECORBLK IS CREATED FOR . 30008000 +*. IT AND FILLED WITH VALUES FROM THE ENTRY POINT'S RFSYMBLK. . 30010000 +*. THE ENTRY ADDRESS OF THE NEW ENTRY IS FOUND FROM THE SYMBOL . 30012000 +*. TABLE (WHICH STILL EXISTS), AND IS SAVED INTO THE RECFPSW . 30014000 +*. FIELD (OR A -1 PLACED HERE TO SHOW THE ENTRY COULD NOT BE . 30016000 +*. FOUND IN THE USER PROGRAM). USING THE RECAXAD FIELD, WHICH . 30018000 +*. POINTS TO THE ADCON IN AVWXTABL OF THE REAL ROUTINE, THE REAL. 30020000 +*. ADCON IS SAVED IN RECADRE, AND IT IS REPLACED BY THE ADDRESS . 30022000 +*. OF REFAKE. A CODE IS PLACED INTO THE HI-ORDER BYTE OF THE . 30024000 +*. WORD IN AVWXTABL, WHICH IS USED BY REFAKE TO IDENTIFY WHICH . 30026000 +*. ENTRY IS CALLED. . 30028000 +*. AT THE END OF A REPLACE RUN, THE REAL ADCONS ARE MOVED . 30030000 +*. BACK TO THEIR PROPER PLACES IN AVWXTABL, USING THE RECAXAD . 30032000 +*. FIELD OF EACH RECORBLK ELEMENT IN THE RECORRAD TABLE. . 30034000 +*. **NOTE** FIRST SECTION OF DSECT SAME AS DSECT RFSYMBLK. . 30036000 +*. LOCATION: CSECT REMONI, TABLE RECORRAD. . 30038000 +*. NAMES: REC----- . 30040000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 30042000 + SPACE 1 30044000 +RECORBLK DSECT 30046000 +* DATA TRANSFERRED FROM RFSYMS CSECT TABLES. 30048000 +RECSYMB DS CL6 ENTRY POINT NAME 30050000 +RECAXAD DS H OFFSET IN AVWXTABL=AX#-AX$BASE 30052000 +RECRGAD DS H OFFSET FOR CHECK CODE=RG#-RGENTS 30054000 + SPACE 1 30056000 +RECADRE DS V SPACE TO SAVE REAL ADDRESS CONSTNAT 30058000 +RECFPSW DS 0F BEGINNING PSW FOR ONE ENTRY POINT 30060000 +RECFPCC DS C ILC-CC-PM, ALSO USED AS FLAG 30062000 +RECFPAD DS AL3 BEGINNING @ FOR ENTRY POINT IN FAKE 30064000 + SPACE 1 30066000 +* RUN STATISTICS VARIABLES 30068000 +RECINSTS DS F CUMULATIVE # INSTRUCTIONS DONE 30070000 +RECCALLS DS H CUMULATIVE # TIMES ENTRY CALLED 30072000 +RECWRONG DS H CUMULATIVE # TIMES PROG WRONG VALUES 30074000 +RECZ$L EQU *-RECINSTS LENGTH TO BE ZEROED-COUNTERS 30076000 +REC$LEN EQU ((*-RECORBLK+3)/4)*4 LENGTH, RNDED TO FULLWRD 30078000 + TITLE 'RFSYMBLK DSECT - REPLACE ENTRY INFORMATION TABLE' 30080000 +**--> DSECT: RFSYMBLK REPLACE MODULE: 1 ENTRY IN TABLE CSECT RFSYMS . 30082000 +*. EACH SECTION OF RFSYMS GIVES EITHER A REPLACABLE . 30084000 +*. CSECT NAME OR ONE OF ITS ENTRY POINT NAMES. THE ENTRY . 30086000 +*. POINT ELEMENTS CONTAIN VARIOUS POINTERS WHICH ARE USED TO . 30088000 +*. GIVE OFFSET ADDRESSES FOR REAL ENTRY ADDRESS CONSTANTS OR . 30090000 +*. FOR VARIOUS CHECKING CODE IN THE REPLACE MONITOR. . 30092000 +*. **NOTE** THIS DSECT IS SAME AS FIRST PART OF RECORBLK DSECT. . 30094000 +*. GENERATION: 1 CALL TO RFSGN MACRO CREATS 1 CSECT ELEMENT . 30096000 +*. AND 1 TO REC$MAX ENTRY ELEMENTS. . 30098000 +*. LOCATION: CSECT RFSYMS. . 30100000 +*. NAMES: RFS----- . 30102000 +*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 30104000 + SPACE 1 30106000 +RFSYMBLK DSECT 30108000 +RFSYMB DS CL6 CSECT/ENTRY NAME, ALPHAMERIC 30110000 +RFSENTN DS AL1 CSECT: NUMBER OF ENTRY POINTS 30112000 +RFSENTL DS AL1 CSECT: LENGTH OF CSECT+ENTRY BLKS 30114000 +RFSRIAD DS H OFFSET TO RI&CSECT-PTRS TO CALLABLES 30116000 + SPACE 1 30118000 + ORG RFSENTN ORG BACK . DEFINE ENTRY FIELDS 30120000 +RFSAXAD DS H OFFSET TO ENTRY ADCON IN AVWXTABL 30122000 +* = AXENTRY - AX$BASE 30124000 +RFSRGAD DS H OFFSET TO REG CHECKING CODE FOR 30126000 +* RETURN VALUES. = RGENTRY-RGENTS 30128000 + ORG RFSRGAD BACK OVER, REALLY FOR RFSYMS PART 2 30130000 +RFSRHAD DS H OFFSET TO CODE TO CHECK REGS FOR 30132000 +* CALLING OTHER PROGS.=RHENTRY-RHENTS 30134000 +RFS$LEN EQU ((*-RFSYMBLK+1)/2)*2 LENGTH OF BLOCK,RD FULLWORD 30136000 + TITLE 'REMONI - REPLACE MONITOR CONTROL PROGRAM' 30138000 + PRINT NOGEN 30140000 +REMONI CSECT 30142000 +**--> CSECT: REMONI REPLACE MONITOR CONTROL PROGRAM . . . . . . . . 30144000 +*. REMONI HANDLES MOST OF THE DETIALS REQUIRED FOR A STUDENT TO . 30146000 +*. WRITE AN ASSIST CSECT, HAVE IT ASSEMBLED BY ASSIST, AND THEN RUN . 30148000 +*. A TEST PROGRAM. THE ENTRYPOINTS OF HIS PROGRAM ARE CALLED ALONG . 30150000 +*. WITH THE ORIGINALS, AND HIS RESULTS CHECKED FOR ACCURACY. WHILE . 30152000 +*. ADDRESS CONSTANT MODIFCATION IS PERFORMED, THE ENTIRE PROCESS IS . 30154000 +*. STILL A SERIALLY RESUABLE PROGRAM. SEE THE ASSIST REPLACE USER'S . 30156000 +*. GUIDE FOR DETAILS ON USING THE REPLACE MONITOR. . 30158000 +*. NAMES: RE------ MAIN CODE BODY AND INSUBS. . 30160000 +*. NAMES: RG------ CHECKING CODE FOR RETURN VALUES. . 30162000 +*. NAMES: RH------ EXTERNAL CALL CHECKING (&$REPL=2) . 30164000 +*. CALLS SYFIND . 30166000 +*. USES DSECTS: AJOBCON,AVWXTABL,ECONTROL,RECORBLK,RFSYMBLK . 30168000 +*. USES MACROS: $CALL,$PRNT,$RETURN,$SAVE,REPRNT,XDECO,XSNAP . 30170000 +*. . 30172000 +*. OVERALL REGISTER CONVENTIONS AND USAGE. . 30174000 +*. R0,R1,R2,R3,R4,R15 WORK REGISTERS . 30176000 +*. R5 = @ RECORBLK ELEMENT FOR CURRENT ENTRY BEING PROCESSED. . 30178000 +*. R6 = BASE REGISTER FOR MAIN CODE OF EACH REMONI ENTRY POINT. . 30180000 +*. R7,R8 USUAL PARAMETER REGS FOR INTERNAL SUBROUTINES. . 30182000 +*. R9 = LINK REGISTER FOR INSUBS WHICH MUST CALL OTHERS WITH R14. . 30184000 +*. R10= @ ECONTROL (EXECUTION CONTROL BLOCK, USER PSEUDO REGISTERS. . 30186000 +*. R11= @ AJOBCON DSECT (MAIN JOB CONTROL TABLE) . 30188000 +*. R12(RAT)= @ VWXTABL CSECT (AVWXTABL DSECT). . 30190000 +*. R13= SAVE AREA ADDRESS, BASE REGISTER FOR DATA, INTERNAL SUBRS. . 30192000 +*. R14= INTERNAL LINK REGISTER. LOCAL WORK REGISTER. . 30194000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 30196000 + SPACE 1 30198000 + $DBG ,NO NO DEBUG 30200000 + ENTRY REINTA,REENDA,REFAKE ENTRIES ALWAYS PRESENT 30202000 + SPACE 1 30204000 +* REMONI FLAG EQUATES 30206000 +READMOD EQU B'00000001' (REFLAGS)=>ADCONS IN AX ARE MODIFID 30208000 +REFPRT EQU B'00000010' (REFLAGS)=> REFAKE PRTED >=1 MSG,SKP 30210000 + SPACE 1 30212000 +REC$MAX EQU 5 MAXIMUM # ENTRIES TO BE REPLACED 30214000 + EJECT 30216000 +**--> ENTRY: REINTA INITIALZE BEFORE ASSEMBLER CALLED . . . . . . . 30218000 +*. THIS ENTRY IS CALLED 1 TIME BEFORE ASSIST ASSEMBLER IS CALLED. 30220000 +*. IT CHECKS FOR PRESENCE OF REAL ADDRESS CONSTANTS IN VWXTABL, AND . 30222000 +*. REPLACES THEM IF THEY HAVE BEEN MODIFIED IN PREVIOUS REPLACE RUN. . 30224000 +*. IT ALSO MAY SET FLAGS IN AVWXTABL IF THE SYSTEM IS IN . 30226000 +*. REPLACE PHASE A (ASSEMBLE REPLACEMENT PROGRAM AND LINK IT). . 30228000 +*. ENTRY CONDITIONS . 30230000 +*. R11= @ AJOBCON (MAIN JOB CONTROL BLOCK). . 30232000 +*. R12(RAT)= @ VWXTABL CSECT (AVWXTABL DSECT). . 30234000 +*. . 30236000 +*. AVWXTABL: HAS BEEN COMPLETELY INITIALIZED BY MAIN PROGRAM ASSIST. . 30238000 +*. THIS PERMITS REINTA TO MODIFY ASSEMBLER CONTROL FLAGS IF . 30240000 +*. NEEDED TO MAKE ASSEMBLER PERFORM REQUIRED ACTIONS. . 30242000 +*. USES DSECTS: AJOBCON,AVWXTABL . 30244000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 30246000 +REINTA $SAVE RGS=(R14-R12),BR=R6,SA=RESAVE 30248000 + USING RESAVE,R13 NOTE AVAIL AS BASE 30250000 + USING AVWXTABL,RAT NOTE ASSEMBLER TABLE USING 30252000 + USING AJOBCON,R11 NOTE MAIN JOB CONTROL TABLE 30254000 + TM AJOMODE,AJOREPLF+AJOREPHB TEST REPLACE STATUS 30256000 + BZ REINREAL NOT REPLACE AT ALL, RESTORE ADCONS 30258000 + BM REINPHSA AJOREPLF ONLY==> REPLACE PHASE A-BR 30260000 + SPACE 2 30262000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30264000 +* PRE-ASSEMBLY -- REPLACEMENT PHASE B * 30266000 +* THIS ACTION OCCURS JUST BEFORE THE ASSEMBLER IS CALLED WITH * 30268000 +* MODIFIED ADCON TABLE FOR THE TEST RUN OF USER-WRITTEN CSECT. * 30270000 +* DON'T MODIFY ADCONS AGAIN, BUT FIX AVWXTABL FLAGS SO RUN * 30272000 +* WILL BE NORMAL. * 30274000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30276000 + OI AJOSTEP,AJOSEXEC SHOW MAY BE IN INTERP FROM NOW ON 30278000 + NI AVTAGS1,255-AJORELOC SHOW NO RELOCATION 30280000 + B REINRETA BRANCH TO EXIT CODE 30282000 + SPACE 2 30284000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30286000 +* PRE-ASSEMBLY -- REPLACEMENT PHASE A * 30288000 +* THIS SECTION IS ENTERED JUST BEFORE A USER-WRITTEN REPLACE * 30290000 +* CSECT IS ASSEMBLED. MAKE SURE THAT THE REAL ADCONS ARE IN * 30292000 +* AVWXTABL (MAY HAVE BEEN CHANGED BY PREVIOUS REPLACE RUN), * 30294000 +* AND SET FLAGS REQUIRED FOR REPLACEMENT. THIS INCLUDES * 30296000 +* MAKING THE ASSEMBLER RELOACTE THE OBJECT CODE TO ITS * 30298000 +* ACTUAL LOCATION IN MEMORY, SIMPLIFYING DUMP PRINTING AND * 30300000 +* DATA TRANSFERS. * 30302000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30304000 +REINPHSA EQU * ENTRY LABEL: REPLACE PHASE A 30306000 + OI AVTAGS1,AJORELOC WE WANT USER PROGR AT REAL ADDRESS 30308000 +* FALL THRU, HAVE ANY MODIFIED ADCONS RESTORED IF NEEDED. 30310000 + SPACE 1 30312000 +REINREAL BAL R14,REREAL HAVE REAL ADCONS REPLACED, IF NEED 30314000 +REINRETA EQU * EXIT LABEL 30316000 +REINRET $RETURN RGS=(R14-R12) 30318000 + DROP R6,R11,RAT,R13 REMV USINGS 30320000 + AIF (&$REPL LT 2).RESY1 SKIP IF NO CALLING ALLOWED 30322000 + EJECT 30324000 +**--> ENTRY: RESYMB ENTER CODE IN SYMBOL TABLE OF CALLABLE ENTRY. . 30326000 +*. RESYMB IS CALLED FROM CVCON2 IF A SYMBOL FLAGGED EXTRN IS . 30328000 +*. USED IN A VCON. IT PLACES A CODE INTO THE SYVALUE ENTRY OF THE . 30330000 +*. SYMBOLS SYMSECT. THIS CODE (THE OFFSET TO A CALLABLE ENTRY . 30332000 +*. ELEMENT IN THE SECOND SECTION OF RFSYMS), IS USED FOR CHECKING . 30334000 +*. WHEN THE USER PROGRAM ACTUALLY CALLS THE ROUTINE. . 30336000 +*. ENTRY CONDITIONS . 30338000 +*. RA = @ SYMSECT FOR THE EXTRN SYMBOL. . 30340000 +*. ALL OTHER REGS: SAME AS ASSEMBLER REGISTER CONVENTIONS. . 30342000 +*. EXIT CONDITIONS . 30344000 +*. RA = @ SAME SYMSECT, BUT CODE HAS BEEN ENTERED IN SYVALUE. . 30346000 +*. RB = 0 IF SYMBOL WAS LEGITAMATE. . 30348000 +*. = 4 IF SYMBOL WAS NOT LEGITAMETE ENTRY TO BE CALLED. . 30350000 +*. NAMES: RES----- . 30352000 +*. USES DSECTS: RFSYMBLK,SYMSECT . 30354000 +*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 30356000 + SPACE 1 30358000 + ENTRY RESYMB DECLARE HERE, SINCE MAY NOT EXIST 30360000 +RESYMB $SAVE RGS=(R14-R6),SA=RESAVE,BR=R6 30362000 + USING RESAVE,R13 NOTE FOR SAFETY 30364000 + USING SYMSECT,RA NOTE SYMBOL TABLE PTR 30366000 + L R3,RERFSYMS =V(RFSYMS) 30368000 + USING RFSYMS,R3 NOTE PTR TO TABLE CSECT 30370000 + LA R0,RFS$LEN INCREMENT FOR BXLE SEARCH 30372000 + LA R1,RFSCALLZ-RFS$LEN LIMIT @ FOR BXLE 30374000 + LA R2,RFSCALLA INDEX FOR BXLE 30376000 + USING RFSYMBLK,R2 NOTE BLOCK PTR 30378000 + SPACE 1 30380000 +* SEARCH CALLABLE ENTRY TABLE FOR THE GIVEN ENTRY. 30382000 + CLC RFSYMB,SYMBOL IS IT? (IGNORE 7-8 CHAR SYMBOLS) 30384000 + BE RESFOUND YES, SKIP OUT 30386000 + BXLE R2,R0,*-10 LOOP THROUTHE TABLE 30388000 + SPACE 1 30390000 + LA RB,4 COULDNT FIND IT, FLAG SO ANDRETRN 30392000 +RESRETA EQU * EXIT LABEL 30394000 + $RETURN RGS=(R14-R6) RTURN, RESTORE ALL BUT PARM REGS 30396000 + SPACE 1 30398000 +* SYMBOL FOUND - PUT OFFSET TO TABLE ELEMENT IN SYMTAB. 30400000 +RESFOUND SR R2,R3 GET OFFSET FROM RFSYMS TO ELEMENT 30402000 + ST R2,SYVALUE SAVE THIS AS SYMBOL VALUE 30404000 + SR RB,RB CLEAR TO SHOW OK 30406000 + B RESRETA GO RETURN 30408000 + DROP R2,R3,R6,RA,R13 RFSYMBLK,RFSYMS,BASE1,SYMSECT,BASE2 30410000 +.RESY1 ANOP 30412000 + EJECT 30414000 +**--> ENTRY: REENDA REPLACE MODULE: POST-ASSEMBLY PROCESSING . . . 30416000 +*. REENDA IS CALLED JUST AFTER AN ASSEMBLY IS COMPLETED. . 30418000 +*. IF THE RUN IS NOT A REPLACE RUN, NOTHING IS DONE. . 30420000 +*. IF IT IS REPLACE PHASE A, THE ASSEMBLED PROGRAM WAS A REPLACE. 30422000 +*. VERSION OF AN ASSIST MODULE, SO CHECK AND MODIFY ASSEMBLER ADCONS.. 30424000 +*. IF THE RUN IS IN PHASE B, THE ASSEMBLY JUST FINISHED WAS . 30426000 +*. A TEST PROGRAM, SO PRINT PERFORMANCE STATISTICS FOR THE MODULE. . 30428000 +*. ENTRY CONDITIONS . 30430000 +*. R11= @ AJOBCON (MAIN JOB CONTROL BLOCK). . 30432000 +*. R12(RAT)= @ VWXTABL CSECT (AVWXTABL DSECT). . 30434000 +*. CALLS SYFIND . 30436000 +*. USES DSECTS: AJOBCON,AVWXTABL,RECORBLK,RFSYMBLK,SYMSECT . 30438000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 30440000 +REENDA $SAVE RGS=(R14-R12),BR=R6,SA=RESAVE 30442000 + USING RESAVE,R13 NOTE 2ND BASE REGISTER 30444000 + USING AVWXTABL,RAT NOTE MAIN ASSEMBLER TABLE USING 30446000 + USING AJOBCON,R11 NOTE POINTER THERE 30448000 + SPACE 1 30450000 +* DETERMINE REPLACE PHASE (IF ANY). IF PHASE A, LINK 30452000 +* REPLACEMENT PROGRAM. IF PHASE B, PRINT STATISTICS. 30454000 + TM AJOMODE,AJOREPLF+AJOREPHB REPLACE STATUS 30456000 + BZ REENRET NO REPLACE, DON'T DO ANYTHING 30458000 + BO REEPHSB BOTH FLAGS==> PHASE B-BRANCH 30460000 + SPACE 1 30462000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30464000 +* POST-ASSEMBLY -- REPLACEMENT PHASE A * 30466000 +* FIND CSECT NAME IN RFSYMS TABLE. CREATE A RECORBLK BLOCK * 30468000 +* FOR EACH ENTRY POINT, FILLING IN VALUES. MODIFY THE ADCONS * 30470000 +* IN AVWXTABL WHICH BELONG TO ENTRYPOINTS OF THE CSECT. * 30472000 +* PRINT ERROR MESSAGES FOR ANY MISSING NAMES. * 30474000 +* ***** PHASE A REGISTER USAGE ***** * 30476000 +* R1 = @ RFSYMBLK OF CSECT, THEN ENTRY POINT BEING PROCESSED * 30478000 +* R2 = INCREMENT FROM EACH CSECT ELEMENT TO THE NEXT DURING SEARCH. * 30480000 +* R3 = OFFSET VALUE OF RECORBLK FROM BEGINNING OF RECORRAD * 30482000 +* = NUMBER OF ENTRY ELEMENTS LEFT TO PROCESS FOR GIVEN CSECT * 30484000 +* R4 = @ SYFIND. MUST BE SAVED HERE BECUASE IT IS LEGAL TO REPLACE * 30486000 +* SYFIND, THUS LEADING TO INTERCEPTED CALL WHEN SYFIND IS * 30488000 +* CALLED TO LOOKUP SYEND2, WITH ADCON ALREADY MODIFIED. * 30490000 +* R5 = @ RECORBLK ELEMENT IN RECORRAD OF ENTRY BEING PROCESSED * 30492000 +* R7(RA)= @ ENTRYPOINT SYMSECT, THEN ADDRESS OF THAT ENTRY * 30494000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30496000 + SPACE 1 30498000 +* INITIALIZE FOR SEARCH FOR AJOREPL IN RFSYMS LIST. 30500000 + L R1,RERFSYMS GET ADCON FOR RFSYMS 30502000 + SR R2,R2 CLEAR FOR INSERTIONS 30504000 + LA R3,RFSYMS$L-RFS$LEN(R1) ADEQUATE LIMIT FOR BXLE 30506000 + USING RFSYMBLK,R1 OVERLAY DSECT ON 1ST SECTION RFSYMS 30508000 + L R4,AXSYFIND =V(SYFIND), GET IT NOW, SO SAFE 30510000 + EJECT 30512000 +* SEARCH FOR CSECT NAME TO BE REPLACED. 30514000 +* LOOK AT EACH CSECT NAME IN RFSYMS, UNTIL ONE IS FOUND 30516000 +* WHICH IS IN THE SYMBOL TABLE AND DECLARED CSECT. 30518000 +REESEARC LA RA,RFSYMB SHOW @ OF CSECT NAME 30520000 + LA RB,L'RFSYMB SHOW LENGTH OF IT (ALWAYS 6) 30522000 + LR REP,R4 REP= =V(SYFIND). MOVE OVER FOR CALL 30524000 + BALR RET,REP CALL SYFIND TO LOOKUP THE SYMBOL 30526000 + L R11,AVAJOBPT RESTORE THE PTR IN CASE NEEDED 30528000 + SPACE 1 30530000 + LTR RB,RB WAS THE SYMBOL IN THE SYMBOL TABLE 30532000 + BNZ REESEARE NO, SO SKIP TO LOOK AT NEXT ONE 30534000 + USING SYMSECT,RA NOTE SYMBOL TABLE PTR, IT WAS IN 30536000 + TM SYFLAGS,$SYCSE WAS IT FLAGGED A CSECT (A MUST) 30538000 + BO REEFOUND YES, THIS IS ONE WE'RE LOOKING FOR 30540000 + DROP RA REMOVE SYMSECT USING 30542000 + SPACE 1 30544000 +REESEARE IC R2,RFSENTL GET LENGTH OF CSECT+ENTRY ENTIRES 30546000 + BXLE R1,R2,REESEARC ADD INCREM TO NEXT CSECT, LOOP OK 30548000 + SPACE 1 30550000 +* FALLS THRU==> CSECT NAME TO BE REPLACED NOT FOUND. 30552000 +* FLAG PROGRAM UNEXECUTABLE, NEVER ENTER PHASE B. 30554000 + OI AVTAGS1,AJNLOAD SHOW THE REPLACE PROG NOGOOD,NO EXEC 30556000 + REPRNT REZAR100,L'REZAR100 MISSING NAME MESSAGE 30558000 + B REENRET RETURN, NO ADCONS CHANGED 30560000 + SPACE 1 30562000 +* CSECT NAME FOUND, NOW LINK ITS ENTRY POINTS IN VWXTABL. 30564000 +REEFOUND MVC REZCSECT,RFSYMB MOVE REPLACED CSECT NAME OVER 30566000 + REPRNT REZAR000,REZ000L PRINT MESSAGE WITH CSECT NAME 30568000 + SPACE 1 30570000 + IC R2,RFSENTN GET # ENTRIES BELONGING TO CSECT 30572000 + STH R2,RECORNUM STORE COUNT INTO CORRESPONDENCE # 30574000 + MVC REFRIAD,RFSRIAD SAVE @ OFFSET TO CALL LIST CHK VALS 30576000 + LA R1,RFS$LEN(R1) SET RFSYMBLK TO 1ST ENTRY-TYPE ENTRY 30578000 + LA R5,RECORRAD INIT TO BEGINNING @ OF CORRES TABLE 30580000 + USING RECORBLK,R5 NOTE DSECT PTR 30582000 + SR R3,R3 CLEAR, WILL BE INDEX TO RECORRAD 30584000 + SPACE 1 30586000 +* LOOP THRU ENTRY LIST. LOOK EACH ONE UP IN SYMBOL 30588000 +* TABLE. OBTAIN EACH ENTRY POINT @ AND CREATE A RECORBLK 30590000 +* ELEMENT FOR IT. MODIFY ADCON IN AVWXTABL. 30592000 +REESYCAL LA RA,RFSYMB @ SYMBOLIC ENTRYPT NAME 30594000 + LA RB,L'RFSYMB LENGTH OF NAME(ALWAYS 6) 30596000 +* SYFIND MAY ERASE REGISTERS RA-RE (R7-R11). 30598000 + LR REP,R4 REP= =V(SYFIND). MOVE OVER FOR CALL 30600000 + BALR RET,REP CALL SYFIND TO LOOKUP THE SYMBOL 30602000 + L R11,AVAJOBPT RESTORE R11 IN CASE WE NEED IT 30604000 + LTR RB,RB WAS IT THERE 30606000 + BNZ REENOENT NO, UNDEFINED, NOT IN TABLE AT ALL 30608000 + USING SYMSECT,RA NOTE SYMBOL TABLE POINTER 30610000 + TM SYFLAGS,$SYDEF WAS SYMBOL DEFINED 30612000 + BZ REENOENT NO,FLAG IT 30614000 + TM SYFLAGS,$SYENT+$SYCSE WAS IT EITHER CSECT OR ENTRY 30616000 + BZ REENOENT NO, SO FLAG IT 30618000 + L R7,SYVALUE GET VALUE OF SYMBOL, FOR ENTRY 30620000 + DROP RA NO MORE SYMBOL DSECT 30622000 + B REENLINK BRANCH TO LINKAGE SEGMENT 30624000 + EJECT 30626000 +* ENTRY NOT FOUND OR UNDEFINED - PRINT MESSAGE, FLAG. 30628000 +REENOENT MVC REZEN002,RFSYMB MOVE THE ENTRY NAME OVER 30630000 + REPRNT REZAR002,REZ002L MESSAGE SHOWING ENTRY NOT FOUND 30632000 + L R7,AWFM1 TO GO INTO RECFPSW, SHOW NOGOOD 30634000 + SPACE 1 30636000 +* LINK NEEDED POINTERS AND CORRESPONDENCE TABLE RECORRAD. 30638000 +REENLINK MVC RECSYMB(RFS$LEN),RFSYMB MOVE RFSYMBLK OVER 30640000 + ST R7,RECFPSW SAVE ENTRYPT IN USER PROGRAM 30642000 + LH R14,RECAXAD GET OFFSET INTO AVWXTABL FOR ADCON 30644000 + LA R14,AX$BASE(R14) GET ACTUAL @ OF THE ADCON 30646000 + MVC RECADRE,0(R14) SAVE THE REAL ADCON 30648000 + MVC RECINSTS(RECZ$L),AWZEROS ZERO STATS COUNTERS 30650000 +* FILL IN AVWXTABL WORD- @ REFAKE, OFFSET ID OF ENTRYPT 30652000 + MVC 0(4,R14),REREFAKE PUT IN @ FAKE/CHECK ROUTINE 30654000 + STC R3,0(,R14) STORE RECORBLK OFFSET INTO ADCON BYT 30656000 + SPACE 1 30658000 +* CHECK IF ENTRY OK, PRINT MESSAGE IF SO. 30660000 + LTR R7,R7 WAS ENTRY @ < 0 (I.E. NOT FOUND) 30662000 + BM REENOENS NO, MESSAGE ALREADY PRINTED 30664000 + LA R8,REZLOCAT SHOW @ FOR HEX CONVERSION 30666000 + BAL R14,REXCON3 CONVERT TO HEX 30668000 + MVC REZEN001,RFSYMB MOVE SYMBOL IN FOR ENTRY NAME 30670000 + REPRNT REZAR001,REZ001L MESSAGE DESCRIBNG OK ENTRY 30672000 + SPACE 1 30674000 +REENOENS LA R1,RFS$LEN(R1) BUMP PTR TO NEXT RFSYMBLK ENTRY 30676000 + LA R3,REC$LEN(R3) INCREMENT OFFSET VALUE IN RECORRAD 30678000 + LA R5,REC$LEN(R5) BUMP PTR TO NEXT RECORBLK ELEMENT 30680000 + BCT R2,REESYCAL GO BACK FOR NEXT ENTRY. LOOP ON # 30682000 + DROP R1,R5 REMV RFSYMBLK,RECORBLK 30684000 + SPACE 1 30686000 + OI REFLAGS,READMOD SHOW WE'VE MODIFIED ADCONS 30688000 + B REENRET RETURN TO CALLING PROGRAM 30690000 + EJECT 30692000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30694000 +* POST-ASSEMBLY -- REPLACEMENT PHASE B * 30696000 +* PRINT STATISTICS OF USER-PROGRAM PERFORMANCE. * 30698000 +* ***** PHASE B REGISTER USAGE ***** * 30700000 +* R0,R1,R2,R8,R9 WORK REGISTERS * 30702000 +* R4 = NUMBER OF RECORBLK ENTRIES LEFT TO PROCESS * 30704000 +* R5 = @ RECORBLK OF ENTRY WHOSE STATISTICS ARE BEING CALCULATED. * 30706000 +* R7 = @ 12-BYTE FIELD WHERE NEXT OUTPUT NUMBER TO BE PLACED * 30708000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30710000 +REEPHSB REPRNT REZAR003,REZ003L PRINT HEADER LINE 30712000 + LH R4,RECORNUM # ENTRY POINTS FOR LOOP COINTER 30714000 + LA R5,RECORRAD INIT @ TO BEGINNING OF TABLE 30716000 + USING RECORBLK,R5 NOTE POINTER 30718000 + SPACE 1 30720000 +REESTATS MVC REZ004EN,RECSYMB MOVE ENTRYPOINT NAME OVER 30722000 + LA R7,REZ004NS @ 1ST OUTPUT NUMBER, INCRD BY DECO 30724000 + SPACE 1 30726000 + L R8,RECINSTS # INSTRUCTIONS DONE 30728000 + BAL R14,REEXDECO PRINT IT, ADVANCE R7 PTR 30730000 + SPACE 1 30732000 + LR R1,R8 SAVE # INSTRUCTIONS DONE FOR LATER 30734000 + LH R8,RECCALLS # CALLS TO ROUTINE 30736000 + BAL R14,REEXDECO CONVERT # CALLS, ADVANCE R7 30738000 + SPACE 1 30740000 + LR R2,R8 SAVE # CALLS FOR LATER DIVIDESX 30742000 + LH R8,RECWRONG GET # WRONG RETURN TIMES 30744000 + BAL R14,REEXDECO CONVERT # WRONG, ADVANCE R7 30746000 + SPACE 1 30748000 + LR R9,R8 SAVE # WRONG 30750000 + LTR R2,R2 WAS # CALLS ZERO 30752000 + BNZ *+8 NO, SO LEAVE AS IS 30754000 + LA R2,1 YES, =0, SO MAKE =1 FOR SAFE DIVIDES 30756000 + SR R0,R0 CLEAR FOR DIVIDE SETUP 30758000 + DR R0,R2 AVG # INSTRS/CALL 30760000 + LR R8,R1 MOVE QUOTIENT OVER FOR CONVERT 30762000 + BAL R14,REEXDECO CALL CONVERT ROUTINE, ADVANCE R7 30764000 + SPACE 1 30766000 + LA R8,100 VALUE FOR PERCENT CONVERT 30768000 + MR R8,R8 # WRONG * 100, RESULT IN R9 30770000 + DR R8,R2 #WRONG*100/#CALLS = PERCENT 30772000 + LR R8,R9 MOVE QUOTIENT FOR CONVERT 30774000 + BAL R14,REEXDECO CONVERT, ADVANCE R7 30776000 + SPACE 1 30778000 + REPRNT REZAR004,REZ004L PRINT MESSAGE FOR THIS ENTRY 30780000 + LA R5,REC$LEN(R5) INCREMENT THE RECORBLK PTR 30782000 + BCT R4,REESTATS LOOP BACK FOR NEXT RECORBLK VALS 30784000 + DROP R5 DON'T NEED RECORBLK ANYMORE 30786000 + SPACE 1 30788000 +REENRET $RETURN RGS=(R14-R12) 30790000 + DROP R6,R11,RAT,R13 DROP TABLE USINGS, BASE REGS 30792000 + EJECT 30794000 +**--> ENTRY: REFAKE INTERCEPT REPLACED CALLS, CHECK REAL/USER . . . 30796000 +*. ENTRY CONDITIONS . 30798000 +*. R15(BITS 0-7)= OFFSET CODE # FOR SPECIFIC ENTRY BEING CALLED. . 30800000 +*. R0-R14 ARE AS DESCRIBED IN ASSEMBLER CALLING CONVENTIONS. . 30802000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 30804000 + SPACE 1 30806000 +* * * * * REFAKE ENTRY REGISTER USAGE * * * * * * * * * * * * * * * * * 30808000 +* R0,R1,R2,R3,R4,R15 WORK REGISTERS * 30810000 +* R5 = @ RECORBLK ELEMENT FOR THE ENTRY POINT BEING CALLED. * 30812000 +* R6 = FIRST BASE REGISTER, USED FOR MAIN CODE. * 30814000 +* R9 = LINK REGISTER FOR INSUBS WHICH MUST CALL OTHERS WITH R14. * 30816000 +* R10= @ ECONTROL (EXECUTION CONTROL BLOCK, USER PSEUDO REGISTERS. * 30818000 +* R13= SAVE AREA @, ALSO SECOND BASE REGISTER, FOR INSUBS. * 30820000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30822000 + SPACE 1 30824000 +REFAKE $SAVE RGS=(R14-R6),BR=R6,SA=RESAVE SAVE ALL BUT PARM RGS 30826000 + USING AVWXTABL,RAT NOTE MAIN ASM TABLE USING 30828000 + USING RESAVE,R13 NOTE SECONDARY BASE REG USING 30830000 + SPACE 1 30832000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30834000 +* REFAKE IS ENTERED VIA A MODIFIED ADCON IN AVWXTABL, WHICH * 30836000 +* ALSO CONTAINS THE OFFSET IN RECORRAD OF THE RECORBLK FOR THE * 30838000 +* REPLACED ENTRY BEING CALLED. SET R5 TO THE @ THIS RECORBLK, TO BE* 30840000 +* USED THROUGHOUT THIS CODE. CALL THE CORRESPONDING REAL ASSIST * 30842000 +* ROUTINE. SAVE INITIAL PARM REGISTER VALUES AND THOSE RETURNED * 30844000 +* BY REAL ROUTINE FOR TESTING, OR PRINTING. ALSO PRINT VARIOUS * 30846000 +* REGISTER SETS OR THE CURRENT STATEMENT, IF REQUIRED BY SETTING * 30848000 +* OF VARIOUS BITS IN ECRFLAG OF THE ECONTROL BLOCK. * 30850000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30852000 + SPACE 1 30854000 + STM RA,RE,REGSAVA SAVE ORIGINAL PARM REG VALUES 30856000 + SRL R15,24 GET HI-ORDER BYTE BY ITSELF 30858000 + LA R5,RECORRAD(R15) ADD OFFSET TO TABLE @==>@RECORBLK 30860000 + USING RECORBLK,R5 NOTE @ TABLE ELEMENT 30862000 +* INCREMENT TOTAL NUMBER OF TIMES CALLED. 30864000 + LH R15,RECCALLS CURRENT TOTAL NUMBER OF CALLS 30866000 + LA R15,1(R15) +1 FOR THIS TIME 30868000 + STH R15,RECCALLS = NEW CURRENT TOTAL # CALLS 30870000 + SPACE 1 30872000 +* CALL THE REAL ASSIST ROUTINE FIRST. SAVE THE VALUES 30874000 +* IT RETURNS IN REGISTERS RA-RE FOR LATER USE. 30876000 + SPACE 1 30878000 + L R15,RECADRE GET REAL ENTRY POINT @ 30880000 + BALR RET,REP CALL THE REAL ROUTINE 30882000 + STM RA,RE,REGSAVB SAVE THE RETURNED PARAMETERS 30884000 + SPACE 2 30886000 +* ENTRY ACCEPTED, SET UP FOR INTERPRETATION 30888000 + L R11,AVAJOBPT GET PTR TO ,AIN CONTROL BLOCK 30890000 + USING AJOBCON,R11 NOTE PTR 30892000 + L R10,AJOECOPT GET PTR TO PARTIALLY-FILLED ECONTROL 30894000 + USING ECONTROL,R10 NOTE PTR 30896000 + EJECT 30898000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30900000 +* DEPENDING ON ECRFLAG (WHICH CAN BE CHANGED BY THE USER PROG * 30902000 +* DURING EXECUTION), PRINT THE CURRENT CARDIMAGE (IF ANY), THE 5 * 30904000 +* PARAMETER REGISTERS ON ENTRY, AND/OR THE PARAMETER REGISTERS * 30906000 +* RETURNED BY THE REAL ASSIST ROUTINE. * 30908000 +* THEN FLIP THESE BIT FLAGS, SO THAT IF AN ERROR OCCURS, WE * 30910000 +* CAN PRINT ANYTHING WE DIDN'T ALREADY PRINT . * 30912000 +* INIT REFPRT BIT IN REFLAGS OFF. USE OF REXPRINT INSUB * 30914000 +* SETS THIS BIT ON. IF IT IS ON WHEN REFAKE EXITS, 2 LINES ARE* 30916000 +* SKIPPED TO SEPARATE OUR MESSAGES FROM FOLLOWING LISTING. THE * 30918000 +* LISTING IS VERY HARD TO FOLLOW IF THIS IS NOT DONE. * 30920000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30922000 + NI REFLAGS,255-REFPRT INIT FLAG TO SHOW NO MSGS PRT YT 30924000 + MVC REFRFLAG,ECRFLAG SAVE THE BYTES FOR LATER 30926000 + BAL R9,REFRFC CALL INSUB FOR 3 CHECKS/PRINTS 30928000 + XI REFRFLG1,ECR$REGB+ECR$REGA+ECR$CARD FLIP BITS 30930000 + SPACE 2 30932000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30934000 +* FINISH CONSTRUCTION OF ECONTROL FOR INTERPRETIVE CALL TO * 30936000 +* USER-WRITTEN REPLACEMENT PROGRAM. CALL THE INTERPRETER, WITH THE * 30938000 +* USER PROGRAM AS ARGUMENT. INCREMENT STATISTICS, AND BRANCH TO * 30940000 +* PROCESS POSSIBLE ERROR IF ANY BUT NORMAL RETURN INDICATED. * 30942000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30944000 + SPACE 1 30946000 +* TEST USER ENTRYPT TO MAKE SURE HAS BEEN FOUND. 30948000 + CLI RECFPCC,0 WAS BYTE 0, I.E. LEGAL @ 30950000 + BNE REFNOCAL NO, SO QUIT NOW, CAN'T EXECUT 30952000 + SPACE 1 30954000 + MVC ECFENTER,RECFPSW INIT ENTRY POINT TO RIGHT @ 30956000 + MVI ECFLAG0,$ECSPIEB+$ECEOF SET FLAG PROPERLY 30958000 + SPACE 1 30960000 +* INITIALIZE REGISTER CONTENTS FOR USER PROGRAM. 30962000 + MVC ECREGS(7*4),REFILLRG PUT IN REGISTER FILLER 30964000 + MVC ECREGRA(5*4),REGSAVA MOVE ORIG PARM REGS TO FAKE 30966000 + MVC ECFPREGS(32),ECREGS PUT 4'S OVER HERE ALSO 30968000 + ST RAT,ECREG12 SAVE AVWXTABL PTR HERE 30970000 + MVC ECREG13,ECSAVE1 MOVE @ DUMMY SAVEAREA INTO FAKE 13 30972000 + MVC ECREG14,RERFSYMS PUT DISTINCT, EASY-TO-CHECK RET @ 30974000 + MVC ECREG15,ECFENTER PUT ENTRY PT @ IN FAKE R15 30976000 + SPACE 1 30978000 +REEXECUT EQU * ENTER HERE AFTER USER CALLED AN 30980000 +* ASSIST MODULE AND IT REURNED OK 30982000 + L REP,AJOEXECU =V(EXECUT) PUT IN ADCON 30984000 + BALR RET,REP CALL THE INTERPRETER 30986000 + SPACE 1 30988000 +* UPDATE TOTAL NUMBER OF INSTRUCTIONS PERFORMED. 30990000 + LM R14,R15,ECILIMT GET ECILIMT-ECILIMP 30992000 + SR R15,R14 # INSTRUCTIONS EXECUTED THIS TIME 30994000 + A R15,RECINSTS + CUMULATIVE TOTAL FROM BEFORE 30996000 + ST R15,RECINSTS = NEW CUMULATIVE TOTAL INSTRUCTIONS 30998000 + SPACE 1 31000000 + MVI RERGEFLG,0 ZERO OUT RETURN CODE FLAG 31002000 + MVC REZ059MS(REZ059ML),AWBLANK BLANK OUT MESSAGE AREA 31004000 + SPACE 1 31006000 + CLI ECFLAG1,$ECBRN14 WAS A PROPER RETURN DONE 31008000 + BNE REFNORET NO GOOD RETURN-BRANCH 31010000 + EJECT 31012000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 31014000 +* CHECKING SECTION FOR USER-RETURNED REGISTERS * 31016000 +* 1. CALL INSUB RGENTS TO CHECK REGS RA-RE FOR INDIVIDUAL CASES* 31018000 +* 2. MAKE COMMON CHECK FOR MODIFIED REGS - R0-R6, R12, R13. * 31020000 +* 3. SET ECRFLAG IF NEEDED AND PRINT MESSAGE AR059 AND OTHER * 31022000 +* MESSAGES, IF THERE WERE ONE OR MORE ERRORS. * 31024000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 31026000 + LH R15,RECRGAD GET OFFSET FOR SPECIFIC ERROR 31028000 + BAL R14,RGENTS CALL CHECKING ROUTINE.INITS RERGEFLG 31030000 + SPACE 1 31032000 + NI ECRFLAG+1,255-ECR$ERRC INIT TO SHOW NO ERRORS 31034000 + SPACE 1 31036000 + CLC ECREGS(7*4),REFILLRG MAKE SURE DIDN'T MESS UP 31038000 + BE *+14 OK, SKIP ERROR 31040000 + OI RERGEFLG,RGE06 FLAG THIS ERROR 31042000 + MVC REZ059R0,=C'R0-R6' MOVE MESSAGE IN 31044000 + SPACE 1 31046000 + BAL R14,REGC1213 CALL R1K R13 CHECKER 31048000 + SPACE 1 31050000 + TM RERGEFLG,X'FF' WERE THERE ANY ERRORS AT ALL 31052000 + BZ REFNOERR NO, SO SKIP PRINTING 31054000 + SPACE 1 31056000 + OI ECRFLAG+1,ECR$ERRC SET ERROR FLAG FOR THE USER 31058000 + BAL R9,REFRFC PRINT OUT ANYTHING NOT ALREADY DONE 31060000 + B REF059PR SKIP TEST, GO PRINT AR058-AR059 31062000 + SPACE 1 31064000 +* TEST FOR PRINTING REGS RETURNED BY USER PROGRAM. 31066000 +REFNOERR TM ECRFLAG+1,ECR$REGC DID HE WANT TO SEE RETURN REGS 31068000 + BZ REFRFZ08 NO, SKIP 31070000 + SPACE 1 31072000 +REF059PR MVI REZ05XN,C'8' SHOW AR058 MESSAGE 31074000 + BAL R14,REREGSRA CALL REREGS, PRINT ECREGSRA- 31076000 +REFRFZ08 EQU * BRANCH LABEL IF PREVIOUS CODE SKIPPE 31078000 + SPACE 1 31080000 + TM RERGEFLG,X'FF' WERE THERE ANY ERRORS 31082000 + BZ REFNOERS NO ERRORS, BRANCH OUT AGAIN 31084000 + SPACE 1 31086000 +* AR058 MESSAGE JUST PRINTED. ADD AR059 WITH ERROR FLAGS. 31088000 + BAL R9,REGCRARE CALL TO CHK BITS, FLAG, PRINT AR059 31090000 + SPACE 1 31092000 + LH R1,RECWRONG GET CURRENT # WRONG 31094000 + LA R1,1(R1) +1 FOR THIS TIME 31096000 + STH R1,RECWRONG = NEW TOTAL # WRONG 31098000 + B REFARETA GO RESTORE PARM REGS, RETURN 31100000 + EJECT 31102000 +* EXIT TAKEN IF UNFOUND ENTRY POINT CALLED DURING EXEC. 31104000 +REFNOCAL EQU * CALLED ENTRY NOT FOUND EXIT 31106000 + MVC REZEN101,RECSYMB MOVE NAME OF ENTRY OVER-ERROR 31108000 + REPRNT REZAR101,REZ101L PRINT UNFOUND ENTRY CALLED DURING EX 31110000 + LM R14,R15,ECRDLIML ECRDLIML-H - DUMP LIMITS 31112000 + XSNAP T=(PR,FL,1),STORAGE=(*0(R14),*0(R15)), #31114000 + LABEL='REPLACE MONITOR AR101 DUMP' 31116000 + B REFAREAL GO RESTORE ADCONS 31118000 + SPACE 2 31120000 +REFNORET EQU * BRANCH HERE IF NOT RIGHT RETURN 31122000 + AIF (&$REPL LT 2).REFNOBR SKIP IF CAN'T CALL OTEHRS 31124000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 31126000 +* CHECK USER FOR CALLING ASSIST ROUTINE PROPERLY * 31128000 +* CHECK USER ROUTINE FOR BRANCHING OUT IF ITSELF, USING A LEGAL* 31130000 +* OFFSET CODE GIVEN TO IT BY RESYMB. * 31132000 +* REGISTER USAGE IN CALL CHECKING SECTION * 31134000 +* R4 = @ RFSYMBLK OF CALLED ROUTINE (SECTION 2 OR RFYSMS). * 31136000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 31138000 + SPACE 1 31140000 + CLI ECFLAG1,$ECBROUT WAS ERROR BRANCH OUT OF RANGE 31142000 + BNE REFABEND NO, SO MUST BE ACTUAL ERROR 31144000 + SPACE 1 31146000 + LH R15,REFRIAD GET OFFSET TO RI&CSECT IF ANY 31148000 + LTR R15,R15 IS THIS CSECT ALLOWED TO CALL 31150000 + BZ REFABEND =0 ==> CAN'T CALL-BRANCH -ERROR 31152000 + SPACE 1 31154000 + L R1,RERFSYMS =V(RFYSMS), @ CONTROL TABLE 31156000 + LH R0,0(R15,R1) GET # ENTRY PTS CALLABLE FROM CSECT 31158000 + L R4,ECREG15 GET USER REGISTER 15 31160000 + LA R4,0(R4) REMOVE ANY GARBAGE FROM FRONT 31162000 + SPACE 1 31164000 +* SEE IF USER BRANCHED TO LEGAL OFFSET GIVEN HIM BY RESYMB 31166000 +REHSEARC LA R15,2(R15) INCREMENT COUNTER TO NEXT HALF 31168000 + LH R2,0(R15,R1) GET NEXT VALUE, EXPAND 31170000 + CR R4,R2 WAS VALUE THE SAME 31172000 + BE *+12 YES, ITS OK, SO JUMP OUT OF LOOP 31174000 + BCT R0,REHSEARC LOOP BACK FOR LIST OF CALLABLES 31176000 + B REFABEND VALUE WASN'T ONE OF OURS-QUIT 31178000 + SPACE 1 31180000 +* OFFSET INTO SECTION 2 OF RFSYMS CHECKED AND OK. 31182000 + AR R4,R1 ADD =V(RFYSMS), GET @ ELEMENT 31184000 + DROP R5 TEMPORARILY REMOVE USING FOR USER 31186000 + USING RFSYMBLK,R4 NOTE PTR TO CALLED ASSIST PROG 31188000 + LH R15,RFSRHAD GET OFFSET OF CHECKING CODE 31190000 + BAL R14,RHENTS CALL CHECKER, NOTE RERGEFLG =0 ALRED 31192000 + SPACE 1 31194000 + BAL R14,REGC1213 GET R12 CHECKED, R13 PARTIALLY 31196000 + TM RERGEFLG,RGE13 WAS R13 FLAGGED 31198000 + BZ REHN13 NO, SO IT WAS OLD SA PTR, OK 31200000 + SPACE 1 31202000 + TM ECREG13+3,3 AS IT ON F BOUNDARY 31204000 + BNZ REHN13 NO, ERROR, LEAVE IT FLAGGED 31206000 + L R15,ECREG13 GET USER R13 31208000 + LA R15,0(R15) REMOVE LEADING BYTE 31210000 + C R15,ECFADL LOWER THAN LOWEST USER @ 31212000 + BL REHN13 OUT OF AREA, ALREADY MARKED,BR 31214000 + C R15,ECFADHC COMPARE TO HIGH LIMIT FOR USER 31216000 + BH REHN13 OUTSIDE, NOGOOD, LAREADY FLAGGED 31218000 + NI RERGEFLG,255-RGE13 IN USER AREA, OS OK, REMOVE FLAG 31220000 + MVC REZ05913,AWBLANK REMOVE R13 MESSAGE TOO 31222000 + EJECT 31224000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 31226000 +* IF USER WANTS TO SEE THEM, OR IF THERE IS AN ERROR, * 31228000 +* PRINT PARAMETER REGISTERS PASSED BY USER PROGRAM. IF IN * 31230000 +* ERROR, PRINT ERROR MESSAGE AND ABEND THE USER. IF CORRECT, * 31232000 +* CALL THE ASSIST ROUTINE, AND PASS ITS ANSWERS BACK TO THE * 31234000 +* USER PROGRAM. THE INTERPRETR CONTINUES FROM WHERE IT LEFT * 31236000 +* OFF, WITHOUT REINITIALIZING INSTRUCTION STACK. * 31238000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 31240000 + SPACE 1 31242000 +REHN13 TM ECRFLAG+1,ECR$REGD DID USER WANT REGS PRINTED ON CALL 31244000 + BO REF050PR YES, OS GO PRINT 31246000 + SPACE 1 31248000 + TM RERGEFLG,X'FF' WAS NAYTHING WRONG WITH HIS REGS 31250000 + BZ REHNOERS NO, SO LEGIT CALL, GO DO IT 31252000 + SPACE 1 31254000 +REF050PR MVI REZ05XN,C'0' SHOW AR050 MESSAGE 31256000 + MVC REZ05XMS,=CL9'CALL TO' MOVE IN MESSAGE 31258000 + MVC REZ05XEN,RFSYMB MOVE IN SYMBOL OF ENTRY CALLED 31260000 + BAL R14,REREGSRA GO PRINT USER REGS OUT 31262000 + SPACE 1 31264000 + TM RERGEFLG,X'FF' WERE THER ANY ERRORS 31266000 + BZ REHNOERS NO, USER JUST WANTED TO SEE, SKIP 31268000 + SPACE 1 31270000 + BAL R9,REGCRARE HAVE REGS RA-RE FLAGGED IF NEED,PRT 31272000 + B REFABEND USER MADE HIS MISTAKE-ABEND 31274000 + SPACE 1 31276000 +REHNOERS LH R15,RFSAXAD OFFSET IN AVWXTABL OF V(REAL ROUT) 31278000 + DROP R4 DON'T NEED CALLED RFSYMBLK ANYMORE 31280000 + USING RFSYMBLK,R5 RESTORE NOREMAL USING FOR ELSEWHERE 31282000 + L R15,AX$BASE(R15) GET ACTUAL @ CALLED ROUTINE 31284000 + SPACE 1 31286000 + LR R1,R10 SAVE @ ECONTROL 31288000 + LM RA,R13,ECREGRA GET USER REGS RA-RE,R12,R13 31290000 + USING ECONTROL,R1 TEMPORARY USING 31292000 + DROP R10 REMOVE USING SO WE CAN USE R1 TEMPRL 31294000 + DROP R13 WIPED OUT REG, SO ERASE USING 31296000 + BALR R14,R15 CALL REAL ASSIST ROUTINE 31298000 + SPACE 1 31300000 + STM RA,RE,ECREGRA SAVE THE PARM REGS 31302000 + LR R10,R1 GET @ ECONTROL BACK IN USUAL REG 31304000 + DROP R1 REMOVE TGEMP USING 31306000 + USING ECONTROL,R10 RESTORE NORMAL USING 31308000 + L R11,AVAJOBPT GET @ AJOBCON BACK 31310000 + LA R13,RESAVE GET @ OF OUR SAVE AREA BACK 31312000 + USING RESAVE,R13 RESOTRE NORMAL USING HERE 31314000 + SPACE 1 31316000 + MVC ECPSWIAD,ECREG14+1 MOVE TO PSW @ SO STARTS THERE 31318000 + B REEXECUT GO TO START INTEPRETER UP AGAIN 31320000 + EJECT 31322000 +.REFNOBR ANOP 31324000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 31326000 +* REFAKE EXIT CODE SECTIONS * 31328000 +* IF USER ABENDED FOR ANY REASON, GIVE HIM A DUMP AND * 31330000 +* HAVE ALL ADCONS REPLACED, THUS TERMINATING REPLACEMENT. * 31332000 +* IN ANY CASE, PLACE THE CORRECT RETURN VALUES IN PARAMETER * 31334000 +* REGISTERS RA-RE. THEN RETURN TO THE ASSIST ASSEMBLER * 31336000 +* ROUTINE WHICH UNWITTINGLY CALLED REFAKE. * 31338000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 31340000 + SPACE 1 31342000 +REFABEND EQU * USER PROGRAM ABEND EXIT 31344000 + REPRNT REZAR102,REZ102L ABEND MESSAGE 31346000 + BAL R9,REFRFC PRINT ANYTHING NOT ALREADY PRINTED 31348000 +REFADUMP EQU * ENTER HERE TO DUMP USER AND RESTORE 31350000 + LM R14,R15,ECRDLIML GET DUMP LIMITS 31352000 + XSNAP T=(PR,FL,10),STORAGE=(*0(R14),*0(R15)) GIVE DUMP 31354000 +REFAREAL EQU * ENTER HERE IF CANNOT USE DUMP ABOVE 31356000 + BAL R14,REREAL CANCEL REPLACEMENT 31358000 + SPACE 1 31360000 +REFNOERS EQU * BRANCH HERE IF NO ERRORS IN REG CHEC 31362000 +REFARETA EQU * EXIT LABEL FOR ENTIRE REFAKE 31364000 + TM REFLAGS,REFPRT HAVE WE PRINTED ANY MESSAGE 31366000 + BZ REFARETE NO, SO DON'T DO ANYTHING 31368000 + REPRNT REZAR000,1 =C'0'. SKIP 2 LINES FOR READABLE 31370000 +REFARETE EQU * BRANCH HERE IF DON'T HAVE TO SKIP 31372000 + LM RA,RE,REGSAVB RELOAD REAL SUBR'S RIGHT PARM RGS 31374000 +REFARET $RETURN RGS=(R14-R6) RESTORE ALL BUT PARM REGS 31376000 + DROP R5,R6,R10,R11,RAT,R13 ERASE ALL USINGS 31378000 + TITLE 'REPLACE MONITOR - INTERNAL DATA AREAS - BASE R13' 31380000 +RESAVE DS 18F SAVE AREA, SECONDARY BASE REG 31382000 + SPACE 1 31384000 +REREFAKE DC A(REFAKE) ADCON TO PLACE INTO AVWXTABL 31386000 +RERFSYMS DC V(RFSYMS) SYMBOLIC ENTRY TABLE CSECT 31388000 +REFILLRG DC (7*4)AL1($PRGFILR) FILL CHARS FOR REGISTERS 31390000 +REGSAVA DS 5F REGS RA-RE BEFORE REAL PROG CALLED 31392000 +REGSAVB DS 5F REGS RA-RE AFTER CALL TO REAL SUBR 31394000 +RECORRAD DS 0F,(REC$MAX)CL(REC$LEN) ADCON CORRESPONDENCE TABLE 31396000 +REXFWORK DC F'0',X'04' WORKAREA, WITH REVERSED ' ' FOR HEX 31398000 +REFLAGS DC B'0' FLAG BYTE 31400000 +RECORNUM DC H'0' CURRENT # ENTRIES IN RECORRAD 31402000 +REFRFLAG DS H SAVE AREA FOR ECRFLAG OVER CALL 31404000 +REFRFLG1 EQU *-1 @ 2ND BYTE REFRFLAG, WHERE BITS ARE 31406000 +REFRIAD DS H OFFSET @ FROM RFSYMS TO COUNT, THEN 31408000 +* LIST OF OFFSETS TO RFSYMBLK ELEMENTS FOR CALLABLE SUBS 31410000 +* FOR REPLACED CSECT. ONLY USED IF &$REPL=2. 31412000 +RERGEFLG DS B FLAG FOR ERROR CONDTIONS IN USER RGS 31414000 + SPACE 2 31416000 +* INFORMATION, WARNING MESSAGES - AR00# MESSAGES. * 31418000 +* ///AR000 - LIST NAME OF CSECT BEING REPLACED. * 31420000 +* ///AR001 - LIST NAME AND LOCATION OF EACH ENTRY BEING REPPD. * 31422000 +* ///AR002 - LIST NAME OF ENTRY REQUIRED BUT NOT FOUND. * 31424000 +* ///AR003 - OUTPUT HEADER FOR PERFORMANCE STATISTICS * 31426000 +* ///AR004 - LIST PERFORMANCE STATISTICS FOR SINGLE ENTRY. * 31428000 + SPACE 1 31430000 +REZAR000 DC C'0///AR000 REPLACE CSECT: ' 31432000 +REZCSECT DC CL6' ',C' ///' 31434000 +REZ000L EQU *-REZAR000 LENGTH OF MESSAGE 31436000 + SPACE 1 31438000 +REZAR001 DC C'0///AR001 REPLACE ENTRY: ' 31440000 +REZEN001 DC CL6' ',C' AT LOCATION: ' 31442000 +REZLOCAT DC XL6'0',C' ///' 31444000 +REZ001L EQU *-REZAR001 LENGTH OF MESSAGE 31446000 + SPACE 1 31448000 +REZAR002 DC C'0///AR002 REPLACE ENTRY: ' 31450000 +REZEN002 DC CL6' ',C' NOT FOUND AS CSECT OR ENTRY ///' 31452000 +REZ002L EQU *-REZAR002 LENGTH OF MESSAGE 31454000 + SPACE 1 31456000 +REZAR003 DC C'0///AR003 STATISTICS : # INSTRUCTIONS # CALLS ' 31458000 + DC C'# WRONG INSTRS/CALL % WRONG' 31460000 +REZ003L EQU *-REZAR003 LENGTH OF MESSAGE 31462000 + SPACE 1 31464000 +REZAR004 DC C' ///AR004 ' 31466000 +REZ004EN DC CL6' ',C' : ' SPACE OFR ENTRY NAME 31468000 +REZ004NS DS 5ZL12 5 SLOTS FOR OUTPUT NUMBERS 31470000 + DC C' %' 31472000 +REZ004L EQU *-REZAR004 LENGTH OF MESSAGE 31474000 + EJECT 31476000 +* DEBUG SERVICE MESSAGES - AR05# MESSAGES AND ITEMS. 31478000 +* ///AR050 - PARM REGISTERS ON CALL TO ANOTHER ROUTINE. * 31480000 +* ///AR051 - CARDIMAGE BEFORE ENTRY TO ROUTINE. * 31482000 +* ///AR052 - PARM REGISTERS BEFORE ENTRY TO ROUTINE. * 31484000 +* ///AR054 - PARM REGISTERS RETURNED BY REAL ROUTINE. * 31486000 +* ///AR058 - PARM REGISTERS RETURNED BY USER ROUTINE. * 31488000 +* ///AR059 - REGISTER ERROR MESSAGE, SHOWING ONES IN ERROR * 31490000 + SPACE 1 31492000 +REZAR051 DC C'0///AR051 ON ENTRY TO ' 31494000 +REZ051EN DC CL6' ',C' STMT ADDR: ' ENTRY NAME 31496000 +REZ051AD DC XL6'0',C' ->' @ CARDIMAGE, PTR TO IT 31498000 +REZ051CD DS CL71 SPACE FOR MOST OF CARD 31500000 +REZ051L EQU *-REZAR051 LENGTH OF MESSAGE 31502000 + SPACE 2 31504000 +REZ05ENT DC C'ENTRY TO ' ... THESE TWO CONSTANTS MUST 31506000 +REZ05EXT DC C'EXIT FROM' ... BE OF THE SAME LENGTH. 31508000 + SPACE 1 31510000 +REZAR05X DC C'0///AR05' HEADER BEGINNING 31512000 +REZ05XN DC X'0',C' ON ' LAST DIGIT OF MESSAGE NUMBER 31514000 +REZ05XMS DC CL(L'REZ05ENT)' ',C' ' 'ENTRY TO' OR 'EXIT FROM' 31516000 +REZ05XEN DC CL6' ',C' REGISTERS RA-RE: ' ENTRY NAME 31518000 + DC C'RA/7/: ' 31520000 +REZ05XRG DC XL8'0',C' RB/8/: ',XL8'0',C' RC/9/: ',XL8'0',C' RD/A/: ' 31522000 + DC XL8'0',C' RE/B/: ',XL8'0',C' ' 31524000 +REZ05XL EQU *-REZAR05X LENGTH OF MESSAGE AREA 31526000 + SPACE 1 31528000 +REZAR059 DC C' ///AR059 WARNING: ERROR IN USER REGS: ' 31530000 +REZ059MS EQU * BEGINNING OF AREA TO BE BLANKED 31532000 +REZ059R0 DS C'R0-R6',C' ' ERR IN ANY OF THESE 31534000 +REZ05912 DS C'R12',C' ' ASM TABLE REG-CAN'T CHANGE 31536000 +REZ05913 DS C'R13',C' ' SAVE AREA PTR 31538000 + ORG REZAR059+(REZ05XRG-REZAR05X) ORG TO SIMILAR OFFSET 31540000 +REZ059RG EQU * BEGINNING OF MESSAGES FOR REGS 31542000 + ORG REZAR059+REZ05XL LEAVE SAME AMOUNT OF SPACE 31544000 +REZ059ML EQU *-REZ059MS LENGTH TO BLANK OUT 31546000 +REZ059L EQU *-REZAR059 LENGTH OF MESSAGE 31548000 + SPACE 2 31550000 +* SEVERE ERROR MESSAGES - AR10# MESSAGES. * 31552000 +* THESE ERRORS TERMINATE REPLACEMENT IMMEDIATELY. * 31554000 +* ///AR100 - REPL= NAME COULD NOT BE FOUND. * 31556000 +* ///AR101 - UNFINDABLE ENTRY NAME CALLED DURING EXECUTION. * 31558000 +* ///AR102 - USER PROGRAM ABENDED. * 31560000 + SPACE 1 31562000 +REZAR100 DC C'0///AR100 REPLACE CSECT NOT FOUND - REPLACE ABORT ///' 31564000 + SPACE 1 31566000 +REZAR101 DC C'0///AR101 INVALID ENTRYPOINT NAME: ' 31568000 +REZEN101 DC CL6' ',C' CALLED. REPLACE ACTION ABORTED ///' 31570000 +REZ101L EQU *-REZAR101 LENGTH OF MESSAGE 31572000 + SPACE 1 31574000 +REZAR102 DC C'0///AR102 USER PROGRAM ABENDED DURING REPLACEMENT ///' 31576000 +REZ102L EQU *-REZAR102 31578000 + TITLE 'REPLACE MONITOR INTERNAL SUBROUTINES - BASE R13' 31580000 + SPACE 1 31582000 +* ***NOTE*** THE FOLLOWING USINGS ARE ASSUMED WHEN 31584000 +* NECESSARY BY ANY OF THE INSUBS WHICH NEED THEM. 31586000 + USING RECORBLK,R5 INDIVIDUAL ENTRY INFORMATION 31588000 + USING ECONTROL,R10 EXECUTION CONTROL TABLE 31590000 + USING AJOBCON,R11 JOB CONTROL TABLE PTR 31592000 + USING AVWXTABL,RAT NOTE FOR REST OF CODE 31594000 + USING RESAVE,R13 NOTE SECONDARY BASE REGISTER 31596000 + SPACE 2 31598000 +* ***** LIST OF INSUBS ***** * 31600000 +* REEXDECO - CONVERT NUMBER FROM BINARY TO EDITED DECIMAL * 31602000 +* REFRFC - PRINT REGISTER SETS DETERMINED BY USER * 31604000 +* REGC1213 - CHECK USER REGS 12 AND 13, SET FLAGS * 31606000 +* REGCRARE - TEST FLAGS FOR REGS RA-RE. FORMAT AND PRINT MSG * 31608000 +* REREAL - RESTORE NORMAL ADDRESS CONSTANTS IN AVWXTABL * 31610000 +* REREGS - FORMAT,PRINT PARM REGS. REREGSRA PRINTS ECREGRA- * 31612000 +* REXCON3 - CONVERT REGISTER VALUE TO 3 BYTES OF HEXADECIMAL * 31614000 +* REXPRINT - PRINT A LINE (CALLED BY REPRNT MACRO) * 31616000 +* * 31618000 +* RGENTS - RETURN VALUE CHECKING SECTION * 31620000 +* RGRAADDR - (RGENTS INTERNAL) - CHECK RA FOR LEGAL SCAN PTR * 31622000 +* RGRCADDR - (RGENTS INTERNAL) - CHECK RC FOR @ IN USER PROGR * 31624000 +* * 31626000 +* RHENTS - CHECK PARM REGS USER PASSED TO ASSIST SUBR. * 31628000 +* RHRAADDR - (RHENTS INTERNAL) CHECK RA FOR LEGALITY * 31630000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 31632000 + SPACE 4 31634000 +**--> INSUB: REEXDECO CONVERT NUMBER TO DECIMAL + + + + + + + + + + 31636000 +*+ CALLED FROM REENDA, PHASE B, CONVERT NUMBER, ADVANCE PTR. + 31638000 +*+ ENTRY CONDITIONS + 31640000 +*+ R7 = @ 12-BYTE FIELD WHERE NUMBER SHOULD BE PLACED. + 31642000 +*+ R8 = NUMBER TO BE CONVERTED TO DECIMAL AND PLACED AT 0(R7). + 31644000 +*+ R14= RETURN @ TO CALLING CODE IN REENDA. + 31646000 +*+ EXIT CONDITIONS + 31648000 +*+ R7 = INPUT VALUE OF R7 + 12, I.E., ADVANCED 1 POSITION. + 31650000 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 31652000 + SPACE 1 31654000 +REEXDECO XDECO R8,0(R7) CONVERT NUMBER 31656000 + LA R7,12(R7) INCREMENT FIELD POINTER 31658000 + BR R14 RETURN 31660000 + EJECT 31662000 +**--> INSUB: REFRFC TEST ECRFLAG AND PRINT NEEDED INFOR + + + + + + 31664000 +*+ ENTERED BEFORE USER PROGRAM EXECUTION (AND POSSIBLY AFTER, + 31666000 +*+ IF IT ABENDED), TO PRINT STATEMENT/AND/OR REGISTERS. + 31668000 +*+ ENTRY CONDITIONS + 31670000 +*+ R9 = RETURN @ TO CALLING CODE. + 31672000 +*+ R10= @ ECONTROL + 31674000 +*+ EXIT CONDITIONS + 31676000 +*+ R7,R8,R14,R15 MAY BE CHANGED. + 31678000 +*+ MESSAGES AR051, AR052, AND/OR AR054 MAY BE PRINTED. + 31680000 +*+ MAY CALL INSUBS REREGS,REXCON3,REXPRINT. + 31682000 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 31684000 + SPACE 1 31686000 +* TEST FOR CARDIMAGE PRINTING AND DO IT IF NEEDED. 31688000 +* **NOTE** REQUIRES AVRSBPT=0 IF NO CARD YET PROCESSED. 31690000 +REFRFC TM REFRFLG1,ECR$CARD DOES HE WANT CARDIMAGE 31692000 + BZ REFRFZ01 NO, SO SKIP ENTIRELY 31694000 + L R8,AVRSBPT GET @ RSBLOCK, IF ANY 31696000 + LTR R8,R8 =0 IF THERE ISN'T ANY CARD YET 31698000 + BZ REFRFZ01 NO CARDIMAGE, CAN'T PRINT-BRANCH 31700000 + USING RSBLOCK,R8 NOTE POINTER TO RSBLOCK 31702000 + SPACE 1 31704000 + MVC REZ051EN,RECSYMB MOVE ENTRY NAME INTO MESSAGE 31706000 + SR R7,R7 CLEAR FOR INSERTION 31708000 + IC R7,RSBLENG GET LENGTH-1 OF ENTRIE BLOCK 31710000 + SH R7,=AL2(RSB$L) - LENGTH BEFORE CARDIMAGE STARTS 31712000 + LA R15,RSOL1-1 LENGTH-1 OF SINGLE CARD (MAX ALLWD) 31714000 + CR R7,R15 WAS ACTUAL L-1 > MAX 31716000 + BNH *+6 NO, SKIP, USE ACTUAL L-1 31718000 + LR R7,R15 YES, USE JUST 1 CARD OF SEVERAL 31720000 + SPACE 1 31722000 + MVC REZ051CD,AWBLANK BLANK PUT THE CARDIMAGE 31724000 + STC R7,*+5 STORE LENGTH-1 INTO NEXT MVC 31726000 + MVC REZ051CD($),RSBSOURC MOVE VARIABLE SIZE CARD OVR 31728000 +REFRFX01 LA R7,RSBSOURC PUT @ IN REG FOR CONVERSION 31730000 + DROP R8 DON'T NEED RSBLOCK USING ANY MORE 31732000 + LA R8,REZ051AD SHOW @ WHERE CONVERTED VALUE GOES 31734000 + BAL R14,REXCON3 CALL CONVERT ROUTINE 31736000 + REPRNT REZAR051,REZ051L PRINT CARDIMAGE, MESSAGE 31738000 +REFRFZ01 EQU * BRANCH LABEL, PREVIOUS CODE SKIPPED 31740000 + EJECT 31742000 +* TEST FOR INITIAL REGISTER VALUE PRINTING. 31744000 + MVC REZ05XEN,RECSYMB MOVE ENTRY NAME NOW. CAN USE # TIMES 31746000 + TM REFRFLG1,ECR$REGA DOES HE WANT INPUT REGISTERS 31748000 + BZ REFRFZ02 NO, SO DON'T DO IT, BRANCH 31750000 + SPACE 1 31752000 + MVC REZ05XMS,REZ05ENT MV ENTRY TO MESSAGE IN 31754000 + MVI REZ05XN,C'2' MAKE MESSAGE ***AR052 31756000 + LA R7,REGSAVA SHOW @ BLOCK OF 5 ORIGINAL REGS 31758000 + BAL R14,REREGS CALL REGISTER CONVERT AND PRINT CODE 31760000 +REFRFZ02 EQU * BRANCH LABEL FOR SKIP PREVIOUS CODE 31762000 + SPACE 1 31764000 +* TEST FOR PRINTING OF REGS RETURNED BY REAL PROGRAM. 31766000 + MVC REZ05XMS,REZ05EXT PUT 'EXIT FROM' IN NOW 31768000 + TM REFRFLG1,ECR$REGB DOES HE WANT RETURNED VALUES 31770000 + BCR Z,R9 NO RETURN TO CALLER 31772000 + SPACE 1 31774000 + MVI REZ05XN,C'4' MESSAGE IS ***AR054 31776000 + LA R7,REGSAVB SHOW @ 5 REGISTERS 31778000 + BAL R14,REREGS CALL REG CONVERT AND PRINT 31780000 + BR R9 RETURN TO CALLER 31782000 + EJECT 31784000 +**--> INSUB: REGCRARE USING RERGEFLG, FLAG AND PRINT REG MSG + + + + 31786000 +*+ **NOTE** SEE SECTION RGENTS FOR RGE-- FLAGS, AS FOLLOWING + 31788000 +*+ CODE MAY NOT BE OBVIOUS WITHOUT THEM. + 31790000 +*+ ENTRY CONDITIONS + 31792000 +*+ R9 = RETURN @ TO CALLING CODE + 31794000 +*+ RERGEFLG IS NONZERO, I.E. AT LEAST 1 ERROR EXISTS. + 31796000 +*+ EXIT CONDITIONS + 31798000 +*+ REZAR059 MESSAGE IS COMPLETED AND PRINTED. + 31800000 +REGCRARE IC R0,RERGEFLG GET THE FLAG, WITHS BITS POSS IN 3-7 31802000 + SLL R0,32-5 SHIFT SO 5 BITS AT LEFT END OF REG 31804000 + LA R1,REZ059RG @ 1ST SLOT FOR FLAGGING 31806000 + SPACE 1 31808000 +REFRAREF ALR R0,R0 SET CC BY 1ST BIT, REST OF REG 31810000 + BC Z+M,*+10 SKIP IF 1ST BIT=0, NOT ERROR 31812000 + MVC 0(8,R1),=8C'$' FLAG THIS REG 31814000 + LA R1,8+8(R1) INCREMENT POINTER TO NEXT AREA 31816000 + BC M+O,REFRAREF LOOP BACK IF ANY MORE TO DO 31818000 + SPACE 1 31820000 + REPRNT REZAR059,REZ059L PRINT ERROR FLAG LINE 31822000 + BR R9 RETURN TO CALLER 31824000 + SPACE 4 31826000 +**--> INSUB: REGC1213 CHECK USER REGS 12-13,FLAG RERGEFLG + + + + + + 31828000 +*+ ENTRY CONDITIONS + 31830000 +*+ R14= RETURN @ TO CALLING CODE + 31832000 +*+ REZAR059MS IS ASSUMED TO BE BLANKED OUT + 31834000 +*+ EXIT CONDITIONS + 31836000 +*+ RERGEFLG MAY BE FLAGGED WITH RGE12 OR RGE13 OR BOTH + 31838000 +*+ REZ059MS MAY CONTAIN REGISTER FLAGS R12 OR R13 + 31840000 +*++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 31842000 + SPACE 1 31844000 +REGC1213 C RAT,ECREG12 DID HE LEAVE R12 ALONE 31846000 + BE *+14 YES, SKIP 31848000 + OI RERGEFLG,RGE12 SHOW R12 IN ERROR 31850000 + MVC REZ05912,=C'R12' SHOW ERROR MESSAGE 31852000 + SPACE 1 31854000 + CLC ECREG13,ECSAVE1 DID HE SAVE SA PTR OK 31856000 + BCR E,R14 YES, OK, RETURN 31858000 + OI RERGEFLG,RGE13 NO, MODIFIED R13 ERROR 31860000 + MVC REZ05913,=C'R13' SHOW ERROR MESSAGE 31862000 + BR R14 RETURN TO CALLER 31864000 + EJECT 31866000 +*+--> INSUB: REREAL REPLACE REAL ADCONS IN VWXTABL IF NOT THERE. + 31868000 +*+ ENTRY CONDITIONS + 31870000 +*+ R11= @ AJOBCON JOB CONTROL TABLE. + 31872000 +*+ R12(RAT)= ADDRESS OF VWXTABL CSECT (FOR DSECT AVWXTABL) + 31874000 +*+ R14= RETURN ADDRESS TO CALLING CODE IN REMONI + 31876000 +*+ EXIT CONDITIONS + 31878000 +*+ ALL ADCONS IN VWXTABL ARE CORRECT, REFLAGS IS MARKED UNMODIFIED. + 31880000 +*+ AJOSTEP IS FLAGGED TO SHOW NOT IN EXECUTION PHASE FOR SURE. + 31882000 +*+ USES REGS: R0,R1,R2,R15 + 31884000 +*+ USES DSECTS: AVWXTABL,RECORBLK + 31886000 +*++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 31888000 +REREAL EQU * ENTRY FOR RESTORATION 31890000 + NI AJOSTEP,255-AJOSEXEC REMOVE INTERP FLAG FOR SURE 31892000 + TM REFLAGS,READMOD HAVE ADCONS BEEN MODIFIED 31894000 + BCR Z,R14 NO,JUST RETURN TO CALLER 31896000 +* INITIALIZE FOR LOOP TO RESTORE ADCONS. 31898000 + LH R0,RECORNUM GET # ENTRIES IN RECORRAD 31900000 + LA R1,RECORRAD GET @ 1ST ENTRY IN RECORRAD 31902000 + USING RECORBLK,R1 NOTE DSECT POINTER 31904000 + DROP R5 ZAP NORMAL USING SO WE CAN USE R1 31906000 + SPACE 1 31908000 +* LOOP, RESTORING ADCONS FROM RECORRAD BACK TO VWXTABL. 31910000 +REREALA LH R2,RECAXAD GET ADCON OFFSET VALUE 31912000 + L R15,RECADRE GET ADCON FROM TABLE 31914000 + ST R15,AX$BASE(R2) STORE ADCON BACK IN ORIGINAL LOCAT 31916000 + LA R1,REC$LEN(R1) BUMP DSECT POINTER TO NEXT ONE 31918000 + BCT R0,REREALA LOOP ON # ENTRIES IN RECORRAD TABLE 31920000 + SPACE 1 31922000 + NI REFLAGS,255-READMOD SHOW VWXTABL NOW IN UNMODIFIED STATE 31924000 + BR R14 RETURN TO CALLING SECTION 31926000 + DROP R1 KILL USING 31928000 + USING RECORBLK,R5 RESORE NORMAL USING FOR REST OF INSU 31930000 + EJECT 31932000 +**--> INSUB: REREGS FORMAT PARAMETER REGS AND PRINT THEM + + + + + 31934000 +*+ CONVERTS BLOCK OF 5 REGISTERS TO HEXADECIMAL, PLACES THEM + 31936000 +*+ IN LOCATIONS IN MESSAGE AREA REZAR05X, AND PRINTS MESSAGE. + 31938000 +*+ ENTRY CONDITIONS + 31940000 +*+ R7 = @ 5-WORD BLOCK OF REGISTERS TO BE PRINTED + 31942000 +*+ R14= RETURN @ TO CALLING CODE + 31944000 +*+ EXIT CONDITIONS + 31946000 +*+ R7 = @ REZAR05X MESSAGE, WITH REGS FILLED IN, USED TO PRINT IT. + 31948000 +*+ R8 = LENGTH OF REZAR05X MESSAGE AREA, FOR PRINTING ALSO. + 31950000 +*+ R15 IS USED AS WORK REGISTER AND MODIFIED + 31952000 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 31954000 + SPACE 1 31956000 +REREGSRA LA R7,ECREGRA @ 5 REGS IN ECONTROL BLOCK 31958000 + SPACE 1 31960000 +REREGS LA R15,5 LOOP COUNTER = # REGS TO BE DONE 31962000 + LA R8,REZ05XRG INIT TO @ FIRST SLOT FOR HEX REG 31964000 + SPACE 1 31966000 +REREGSA UNPK 0(9,R8),0(5,R7) UNPK 1 REGISTER VALUE, EXTRA BYTE 31968000 + TR 0(8,R8),AWTHEX3 TRANSLATE PROPERLY 31970000 + MVI 8(R8),C' ' ADD BLANK AFTERWARD 31972000 + LA R7,4(R7) ADVANCE REG PTR TO NEXT REGISTER 31974000 + LA R8,8+8(R8) ADVANCE HEX PTR TO NEXT SLOT 31976000 + BCT R15,REREGSA LOOP FOR 5 REGS TO BE DONE 31978000 + SPACE 1 31980000 + LA R7,REZAR05X SHOW @ MESSAGE AREA 31982000 + LA R8,REZ05XL SHOW LENGTH 31984000 + B REXPRINT BRANCH TO PRINT ROUTINE 31986000 + EJECT 31988000 +**--> INSUB: REXCON3 CONVERT 3 BYTES OF REGISTER R7 TO HEX. + + + + 31990000 +*+ ENTRY CONDITIONS + 31992000 +*+ R7 = VALUE TO BE CONVERTED ( IN 3 LOW-ORDER BYTES ) + 31994000 +*+ R8 = ADDRESS OF 7 BYTE AREA FOR FIELD TO BE PLACED (WITH TRL ' ') + 31996000 +*+ RAT(R12)= ADDRESS OV VWXTABL CSECT, NEEDED FOR TRANSLATE TABL + 31998000 +*+ R14= RETURN @ TO CALLING SECTION IN REMONI + 32000000 +*+ USES DSECTS: AVWXTABL + 32002000 +*++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 32004000 + SPACE 1 32006000 +REXCON3 ST R7,REXFWORK SAVE THE WORD FOR UNPK 32008000 + UNPK 0(7,R8),REXFWORK+1(4) UNPK WITH TRAILING ' ' 32010000 + TR 0(6,R8),AWTHEX3 TRANSLATE TO PRINTABLE HEX 32012000 + BR R14 RETURN TO CALLER 32014000 + SPACE 4 32016000 +**--> INSUB: REXPRINT PRINT MESSAGE + + + + + + + + + + + + + + + + + 32018000 +*+ PRINT MESSAGE AND FLAG REFLAGS WITH REFPRT TO SHOW PRINTED. + 32020000 +*+ ENTRY CONDITIONS + 32022000 +*+ R7 = ADDRESS OF MESSAGE TO BE PRINTED + 32024000 +*+ R8 = LENGTH OF MESSAGE TO BE PRINTED + 32026000 +*+ R14= RETURN ADDRESS TO CALLING SECTION OF REMONI + 32028000 +*++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 32030000 + SPACE 1 32032000 +REXPRINT $PRNT 0(R7),(R8) PRINT MESSAGE 32034000 + OI REFLAGS,REFPRT SHOW SOMETHING PRTED DURING REFAKE 32036000 + BR R14 RETURN TO CALLING CODE 32038000 + TITLE 'REMONI: INSUB RGENTS: PARAMETER REGISTER CHECKING' 32040000 +**--> INSUB: RGENTS CHECK USER VALUES IN PARAMETER REGISTERS+ + + + 32042000 +*+ THIS CODE CHECKS THE VALUES RETUNRED IN USER REGISTERS RA-RE + 32044000 +*+ AGAINST THE VALUES RETURNED BY THE REAL ASSIST ROUTINE. THE + 32046000 +*+ BYTE FLAG RERGEFLG IS SET ACCORDINGLY, FOR ANY OF THE REGISTERS + 32048000 +*+ WHICH MAY HAVE INCORRECT VALUES. NOTE THAT THE REGISTERS CAN'T + 32050000 +*+ JUST BE COMPARED DIRECTLY, SINCE SOME REGISTERS MAY BE IGNORED, + 32052000 +*+ DEPENDING ON THE CONTENTS OF OTHERS (FOR INSTANCE, IF RB HAS AN + 32054000 +*+ ERROR CODE, RA AND RC ARE INDETERMINATE FOR MANY ENTRIES.) + 32056000 +*+ ENTRY CONDITIONS + 32058000 +*+ R5 = @ RECORBLK ELEMENT FOR THE ENTRYPOINT CALLED. + 32060000 +*+ R6,R13 = FIRST AND SECOND BASE REGISTERS FOR REMONI(REFAKE). + 32062000 +*+ R10= @ ECONTROL BLOCK (WHICH CONTAINS USER RETURN REGS) + 32064000 +*+ R12(RAT) = @ AVWXTABL CONTROL BLOCK + 32066000 +*+ R14= RETURN @ TO CALLING SECTION OF REMONI. + 32068000 +*+ R15= OFFSET FROM RG$BASE TO CODE FOR CHECKING ENTRYPOINT CALLED. + 32070000 +*+ = 0 IF NO CHECKS ARE REQUIRED. + 32072000 +*+ EXIT CONDITIONS + 32074000 +*+ R5,R6,R10,R11,R12,R13,R14,R15 ARE PRESERVED ACROSS THIS CODE. + 32076000 +*+ RERGEFLG CONTAINS BITS SHOWING ERROR FLAGS, REGS RA-RE. + 32078000 +*+ NAMES: RG------ + 32080000 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 32082000 + SPACE 2 32084000 +* * * * * * * * RGENTS REGISTER ALLOCATION * * * * * * * * * * * * * * 32086000 +* R0 = WORK REGISTER * 32088000 +* R1 = LINK REGISTER FOR INTERNAL SUBROUTINES (INTERNAL TO RGENTS) * 32090000 +* R2,R3,R4 (RGRA,RGRB,RGRC) HAVE REAL ROUTINES RETURN VALUES. * 32092000 +* R7,R8,R9 (RA,RB,RC) HAVE USER RETURN VALUES OF THESE REGS. * 32094000 +* (NOTE MOST PROGS RETURN VALUES IN NOR MORE THAN THESE. * 32096000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32098000 + SPACE 1 32100000 +* LOCAL REGISTER EQUATES FOR RGENTS. THESE ARE USED FOR 32102000 +* EASE OF PROGRAMMING, AND MAY BE READ AS: RGRA: 32104000 +* REGISTER(GOOD) VALUE OF RA. 32106000 +RGRA EQU R2 GOOD VALUE OF RETURNED RA 32108000 +RGRB EQU R3 GOOD VALUE OF RETURNED RB 32110000 +RGRC EQU R4 GOOD VALUE OF RETURNED RC 32112000 + SPACE 1 32114000 +* ERROR EQUS USED IN USER-RETURN REGISTER CHECKING. 32116000 +RGERE EQU B'00000001' (RERGEFLG)- RE FOUND IN ERROR 32118000 +RGERD EQU B'00000010' (RERGEFLG)- RD FOUND IN ERROR 32120000 +RGERC EQU B'00000100' (RERGEFLG)- RC FOUND IN ERROR 32122000 +RGERB EQU B'00001000' (RERGEFLG)- RB FOUND IN ERROR 32124000 +RGERA EQU B'00010000' (RERGEFLG)- RA FOUND IN ERROR 32126000 +RGE13 EQU B'00100000' (RERGEFLG)- R13 MODFIED 32128000 +RGE12 EQU B'01000000' (RERGEFLG)- R12 MODIFIED 32130000 +RGE06 EQU B'10000000' (RERGEFLG)- >=1 OF R0-R6 MODIFIED 32132000 + SPACE 1 32134000 +RGENTS EQU * ENTRY FOR CHECKING CODE 32136000 + LM RGRA,RGRC,REGSAVB GET THE CORRECT VALUES RETURNED 32138000 + LM RA,RC,ECREGRA GET THE USER'S REGS 32140000 + B RG$BASE(R15) BRANCH TO CORRECT CODE 32142000 + EJECT 32144000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32146000 +* INDIVIDUAL ROUTINE REGISTER CHECKING CODE * 32148000 +* THE OFFSET VALUES STORED IN RFSYMS WERE CALCULATED RELATIVE * 32150000 +* TO LABEL RG$BASE, WITH AN OFFSET OF 0 MEANING THAT NO * 32152000 +* REGISTER CHECKING IS REQUIRED. THE ENTRY LABELS IN THIS * 32154000 +* SECTION ARE ALL OF THE FORM 'RG' FOLLOWED BY THE NAME OF * 32156000 +* THE DESIRED ENTRY POINT. NOTE THAT MANY OF THEM ARE EQU'D * 32158000 +* TOGETHER AND USE EXACTLY THE SAME CODE FOR CHECKING. * 32160000 +* THE ENTRY LABELS ARE IN ORDER FIRST BY WHETHER THEY * 32162000 +* MAY CALL OTHER MODULES OR NOT, AND THEN ALPHABETICALLY. * 32164000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32166000 + SPACE 1 32168000 +RG$BASE EQU * BASE LABEL FOR OFFSETS 32170000 + BR R14 RETURN, NO CHECKING 32172000 + SPACE 2 32174000 +RGBRUSIN EQU RG$BASE NO CHECKING 32176000 + SPACE 1 32178000 +RGBRINIT EQU RG$BASE NO CHECKING 32180000 + SPACE 1 32182000 +RGBRDROP EQU * RB AND GRB BOTH =0 OR ^=0 32184000 + LTR RGRB,RGRB WAS REAL RETURN CODE 0 32186000 + BNZ RGBR10 NO, BRANCH 32188000 + LTR RB,RB WAS USER RETURN CODE ALSO ZERO 32190000 + BCR Z,R14 YES, NO MORE, QUIT 32192000 + B RGRBERR RGRB=0, RB^=08 ERROR 32194000 + SPACE 1 32196000 +RGBRDISP EQU * GRB=0==>RB=0 AND RA=GRA. 32198000 +* GRB^=0 ==> RB^=0 32200000 + LTR RGRB,RGRB WAS REAL RB =0 32202000 + BNZ RGBR10 ^=0, GO CHECK USER RB 32204000 + LTR RB,RB RB MUST =0 ALSO 32206000 + BNZ RGRBERR IT DOESN'T, SO WORNG 32208000 + CR RA,RGRA RB=GRB=0, SO CHECK RA TOO 32210000 + BCR E,R14 SAME, OK, RETURN 32212000 + B RGRAERR NO, ERRO, GO FLAG IT 32214000 +RGBR10 LTR RB,RB WAS USER RB ALSO NOT ZERO 32216000 + BCR NZ,R14 YES, OK, QUIT 32218000 + B RGRBERR NO, RGRB^=0, RB=0, ERROR 32220000 + SPACE 2 32222000 +RGCBCON1 EQU * GRB=$ERINVCN==> RB=$ERINVCN, RA OK 32224000 +* GRB=0 ==> RA=GRA, RC=GRC 32226000 + CR RB,RGRB ARE THEY SAME 32228000 + BNE RGRBERR NO, GO FLAG, DON'T DO MORE 32230000 + LTR RGRB,RGRB WAS CONSTNAT GOOD 32232000 + BZ RGCB10 YES, GO CONTINUE CHECK 32234000 + BAL R1,RGRAADDR BAD CONSTANT, BUT CHECK SCAN PTR 32236000 + BR R14 IF RETURNED HERE, OK 32238000 +RGCB10 CR RC,RGRC SAME VALUE OF RC 32240000 + BE RGCB20 YES, SKIP, OK 32242000 + OI RERGEFLG,RGERC NO, ERROR, FLAG IT 32244000 +RGCB20 CR RA,RGRA WAS RA SAME 32246000 + BNE RGRAERR NO, ERROR, GO FLAG IT 32248000 + BR R14 RETURN, OK 32250000 + EJECT 32252000 +RGCBCON2 EQU * RA=GRA. CODE AT @RC = CODE @GRC. 32254000 +* LENGTH-1 FOR CLC FROM ORIG. RB 32256000 + CR RA,RGRA MAKE SURE SAME SCAN PTR 32258000 + BE *+8 SKIP IF OK 32260000 + OI RERGEFLG,RGERA FLAG SCAN PTR ERR 7 32262000 + BAL R1,RGRCADDR MAKE SURE RC HAS OK @, SO DON'T 0C5 32264000 + L RB,REGSAVA+4 GET ORIGINAL INPUT VALUE OF RB 32266000 + EX RB,RGCBCLC SUPPY LENGTH-1 TO THE CLC 32268000 + BCR E,R14 SAME, SO OK, RETURN 32270000 + B RGRCERR BAD, GO FLAG IT 32272000 +RGCBCLC CLC 0($,RC),0(RGRC) COMPARE VALUE, EX SUPPLIES LENGTH 32274000 + SPACE 2 32276000 +RGCCCON1 EQU RGCBCON1 SAME CODE AS ABOVE 32278000 + SPACE 1 32280000 +RGCCCON2 EQU RGCBCON2 SAME CODE AS ABOVE 32282000 + SPACE 2 32284000 +RGCDECN1 EQU * RB=GRB. GRB=0==> RA=GRA. 32286000 + LR RC,RGRC DUPLICATE VALUE SO CHECK OK 32288000 + B RGCBCON1 BRANCH BACK TO USE SAME CODE 32290000 + SPACE 1 32292000 +RGCDECN2 EQU * RB=GRB. OTHERWISE, SAME AS CBCON2 32294000 + CR RB,RGRB WAS IT SAME 32296000 + BE RGCBCON2 YES SO GO CONTIUE CHECK 32298000 + B RGRBERR NO, GO FLAG AS ERROR 32300000 + SPACE 2 32302000 +RGCFHCN1 EQU RGCDECN1 SAME AS DE CONSTANTS 32304000 + SPACE 1 32306000 +RGCFHCN2 EQU RGCDECN2 SAME AS DE CONSTANTS 32308000 + SPACE 2 32310000 +RGCPCON1 EQU RGCBCON1 SAME AS ABOVE 32312000 + SPACE 1 32314000 +RGCPCON2 EQU RGCBCON2 SAME AS ABOVE 32316000 + SPACE 2 32318000 +RGCXCON1 EQU RGCBCON1 SAME CODE AS ABOVE 32320000 + SPACE 1 32322000 +RGCXCON2 EQU RGCBCON2 SAME CODE AS ABOVE 32324000 + SPACE 2 32326000 +RGCZCON1 EQU RGCBCON1 SAME CODE AS ABOVE 32328000 + SPACE 1 32330000 +RGCZCON2 EQU RGCBCON2 SAME CODE AS ABOVE 32332000 + EJECT 32334000 +RGOPINIT EQU RG$BASE NO CHECKING REQUIRED 32336000 + SPACE 1 32338000 +RGOPFIND EQU * RA=GRA. RG=GRB. RGRB=0 ==> RC OK 32340000 + CR RA,RGRA IS IT OK 32342000 + BE *+8 YES, SKIP 32344000 + OI RERGEFLG,RGERA NO, FLAG RA ERROR 32346000 + CR RB,RGRB WAS RETURN CODE OK 32348000 + BNE RGRBERR NO, GO FLAG IT AND QUIT 32350000 + LTR RGRB,RGRB WSS RETURN CODE ZERO 32354000 + BCR NZ,R14 NO, QUIT NOW, OK 32356000 + BAL R1,RGRCADDR MAKE SURE OPCODTB PTR IN LEGAL AREA 32357000 + S RA,REGSAVA GET LENGTH OF OPCODE 32358000 + BCTR RA,0 GET LENGTH-1 32360000 + USING OPCODTB,RC NOTE PTR THERE 32362000 + EX RA,RGOPCLC IS SYMBOL THE SAME 32364000 + BCR E,R14 YES, OK RETURN 32366000 + B RGRCERR NO, GO FLAG ERROR 32368000 +RGOPCLC CLC OPCMNEM($),OPCMNEM-OPCODTB(RGRC) COMPARE OPCODES 32370000 + DROP RC REMOVE OPCODTB USING 32372000 + BR R14 RETURN , OK 32374000 + SPACE 2 32376000 +RGSDBCDX EQU * RB=GRB. GRB=0 OR -4 ==> RA=GRA,RC= 32378000 + CR RB,RGRB SAME 32380000 + BNE RGRBERR NO, QUIT NOW, ERROR 32382000 + LTR RGRB,RGRB WAS RETURN CODE 0 OR -4 32384000 + BNP RGCB10 YES, SO GO TO COMMON CHECKING CODE 32386000 + BAL R1,RGRAADDR CHECK SCAN PTR FOR LEGALITY 32388000 + BR R14 RETURN, OK 32390000 + SPACE 1 32392000 +RGSDBTRM EQU RGSDBCDX SAME CODE 32394000 + SPACE 1 32396000 +RGSDCTRM EQU RGSDBCDX SAME CODE AS ABOVE 32398000 + SPACE 1 32400000 +RGSDDTRM EQU RGSDBCDX SAME CODE AS ABOVE 32402000 + SPACE 1 32404000 +RGSDXTRM EQU RGSDBCDX SAME CODE AS ABOVE 32406000 + EJECT 32408000 +RGSYINT1 EQU RG$BASE NO CHECKING 32410000 + SPACE 1 32412000 +RGSYENT1 EQU * RB=GRB. (RA==> SYMBOL)=(GRA=>SYM) 32414000 + CR RB,RGRB SAME OR NOT 32416000 + BE RGSY10 YES, OK 32418000 + OI RERGEFLG,RGERB NO, ERROR 32420000 + B RGSY10 GO CONTINUE CHECKING 32422000 + SPACE 1 32424000 +RGSYFIND EQU * RG=GRB. GRB=0 ==> SYMBOLS SAME 32426000 + CR RB,RGRB RETURN CODE SAME 32428000 + BNE RGRBERR NO, ERROR RIGHT OFF 32430000 + LTR RGRB,RGRB WAS SYMBOL IN TABLE(RGRB=4) 32432000 + BCR NZ,R14 NO, SO DON'T LOOK, RETURN 32434000 +RGSY10 C RA,ECFADL BEGIN CHECK FOR WITHIN USER PROG 32436000 + BL RGRAERR RA TOO LOW-ERROR 32438000 + C RA,ECFADHC COMPARE WITH HIGH CHECK LIMIT 32440000 + BH RGRAERR TOO HIGH-BRANCH-ERROR 32442000 + L RB,REGSAVA+4 GET ORIGINAL LENGTH OF SYMBOL 1-8. 32444000 + BCTR RB,0 OBTAIN LENGTH-1 FOR EXECUTE MVC 32445000 + USING SYMSECT,RA NOTE SYMBOL TABLE DSECT 32446000 + EX RB,RGSYCLC COMPARE THE SYMBOLS 32448000 + BNE RGRAERR NOT SAME SYMBOL, ERROR 32450000 + BR R14 OK, RETURN 32452000 +RGSYCLC CLC SYMBOL($),SYMBOL-SYMSECT(RGRA) COMPARE SYMBOLS 32454000 + DROP RA REMOVE SYMSECT USING 32456000 + SPACE 1 32458000 +RGSYEND2 EQU RG$BASE NO CHECKING 32460000 + SPACE 2 32462000 + AIF (&$REPL LT 2).RGNERE2 SKIP IF REPL ENTRIES MAY NOT CALL 32464000 +* ASSIST SUBROUTINES 32464007 + EJECT 32466000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32468000 +* CHECKING CODE - ENTRIES WHICH MAY CALL OTHERS. * 32470000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32472000 + SPACE 2 32474000 +RGEVALUT EQU * GRB^=0 ==> RB^=0. GRB=0 ==> RA=GRA. 32476000 +* GRB=0 ==> RC=GRC, RD=GRD, RE=GRE. 32478000 + LTR RGRB,RGRB WAS REAL RETURN CODE ZERO 32480000 + BZ RGEV10 YES, SKIP 32482000 + LTR RB,RB WAS USER CODE NO TZERO 32484000 + BZ RGRBERR DIDN'T MATCH, ERROR BRANCH 32486000 + BAL R1,RGRAADDR ERROR IN EXP-GO CHECK FOR OK SCAN PT 32488000 + BR R14 RETURN, SCAN PTR OK 32490000 +RGEV10 LTR RB,RB WAS FAKE USER RB ZERO ALSO 32492000 + BNZ RGRBERR NO, ERROR, QUIT 32494000 + LM R0,R1,ECREGRA+12 GET USER REGS RD-RE 32496000 + C R0,REGSAVB+12 COMPARE WITH REAL RD 32498000 + BE *+8 SKIP IF OK 32500000 + OI RERGEFLG,RGERD FLAG RD WRONG 32502000 + C R1,REGSAVB+16 COMPARE WITH REAL RE RETURNED 32504000 + BE RGCB10 OK, GO CONTINUE CHK FOR RC,RA 32506000 + OI RERGEFLG,RGERE FLAG RE IN ERROR 32508000 + B RGCB10 GO TO CHECK RC,RA 32510000 +.RGNERE2 ANOP 32512000 + EJECT 32514000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32516000 +* MISC. CHECKING AND EXIT CODE SECTIONS. * 32518000 +* THESE SECTIONS OF CODE CAN BE CALLED OR BRANCHED TO BY ANY * 32520000 +* OF THE INDIVIDUAL SECTIONS ABOVE. * 32522000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32524000 + SPACE 2 32526000 +**--> INSUB: RGRAADDR CHECK LEGITAMACY OF SCAN PTR RA + + + + + + + + 32528000 +*+ ENTRY CONDITIONS + 32530000 +*+ R1 = RETURN @ OF CALLING PROGRAM CODE. + 32532000 +*+ RA = VALUE OF SCAN POINTER TO BE CHECKED. + 32534000 +*+ R14= RETURN @ TO BE TAKEN IF RA IS IN ERROR. + 32536000 +*+ EXIT CONDITIONS + 32538000 +*+ RB,RC ARE DESTROYED. MUST BE RELOADED IF CALLER NEEDS THEM. + 32540000 +*+ RERGEFLG IS MARKED WITH RGERA IF RA IS INCORRECT. + 32542000 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 32544000 +RGRAADDR C RA,REGSAVA COMPARE TO ORIGINAL SCAN PTR 32546000 + BL RGRAERR ROUTINE BACKED UP SCAN PTR-ERROR 32548000 + LA R0,200 MAXIMUM POSSIBLE DIF IN SCAN PTRS 32550000 + A R0,REGSAVA ADD ORIG RA TO MAX DIFFERENCE 32552000 + CR RA,R0 CHECK GAINST THIS LIMIT 32554000 + BCR L,R1 YES, OK, NO ERROR 32556000 + SPACE 1 32558000 +* EXIT POINT - FLAG RA IN ERROR, QUIT CHECKING. 32560000 +RGRAERR OI RERGEFLG,RGERA SHOW RA WRONG 32562000 + BR R14 RETURN, QUIT CHECKING 32564000 + SPACE 2 32566000 +* EXIT POINT - FLAG RB IN ERROR, QUIT CHECKING. 32568000 +RGRBERR OI RERGEFLG,RGERB FLAG RB IN ERROR 32570000 + BR R14 RETURN, NO MORE CHECKING 32572000 + SPACE 2 32574000 +**--> INSUB: RGRCADDR CHECK RC FOR @ INSIDE USER PROG.+ + + + + + + + 32576000 +*+ ENTRY CONDITIONS + 32578000 +*+ R1 = RETURN @ TO CALLING CODE IN RGENTS + 32580000 +*+ RC = VALUE TO BE CHECKED + 32582000 +*+ R14= RETURN @ TO BE TAKEN IF RC HAS INCORRECT VALUE. + 32584000 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 32586000 +RGRCADDR C RC,ECFADL MUST BE >= LOWER FAKE LIMIT 32588000 + BL RGRCERR IT WASNT, SO ERROR-BRANCH 32590000 + C RC,ECFADHC MUST BE <= HIGH LIMIT FOR CHECKING 32592000 + BCR NH,R1 NOT HIGH, SO OK, RETURN TO CALLER 32594000 + SPACE 1 32596000 +* EXIT POINT - FLAG RC IN ERROR, QUIT CHECKING 32598000 +RGRCERR OI RERGEFLG,RGRC FLAG ERROR IN RC 32600000 + BR R14 RETURN TO REGULAR PROG. QUIT CHECK 32602000 + AIF (&$REPL LT 2).RHNREP SKIP IF NO REPL CALLS 32604000 + TITLE 'REMONI - RHENTS SECTION - CHECK CALLING VALUES' 32606000 +**--> INSUB: RHENTS CHECK PARM REGS PASSED TO CALLED PROGRAM+ + + + 32608000 +*+ RHENTS IS CALLED ONLY WHEN A CALL TO A REAL ASSIST MODULE + 32610000 +*+ IS MADE BY A REPLACABLE MODULE PERMITTED TO CALL OTHERS. ITS + 32612000 +*+ PURPOSE IS TO PROTECT ASSIST FROM ABENDS CAUSED BY IMPROPER VALUES+ 32614000 +*+ BEING PASSED TO REAL ASSIST ROUTINES, WHICH EXECUTE DIRECTLY. + 32616000 +*+ ENTRY CONDITIONS + 32618000 +*+ R14= RETURN @ TO CALLLING CODE IN MAIN SECTION OF REFAKE. + 32620000 +*+ R15= OFFSET @ FROM RH$BASE TO INDIVIDUAL CODE CHECKING SECTION. + 32622000 +*+ RERGEFLG BITS FOR RGERA-RGERE ARE ZEROED. + 32624000 +*+ EXIT CONDITIONS + 32626000 +*+ R0,R1,RA,RB,RC MAY BE MODIFED. + 32628000 +*+ R4-R6,R10-R15 ARE PRESERVED ACROSS CALLS TO RHENTS. + 32630000 +*+ RERGEFLG BITS ARE SET AS NEEDED. + 32632000 +*+ NAMES: RH------ + 32634000 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 32636000 + SPACE 1 32638000 +* * * * * * * * RHENTS REGISTER ALLOCATION * * * * * * * * * * * * * * 32640000 +* R0 = WORK REGISTER * 32642000 +* R1 = INTERNAL LINK REGISTER FOR CHECKING ROUTINES. * 32644000 +* R2,R3 UNUSED AT PRESENT, MAY BE USED IF REQUIRED IN FUTURE. * 32646000 +* RA,RB,RC HOLD VALUES OF CORRESPONDING USER REGISTERS. * 32648000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32650000 + SPACE 1 32652000 +RHENTS EQU * 32654000 + LM RA,RC,ECREGRA GET PARM REGS, MOST USUAL ONES 32656000 + B RH$BASE(R15) BRANCH TO RIGHT SECTION OF CODE 32658000 + SPACE 1 32660000 +RH$BASE EQU * BASE LABEL FOR CALL CHECKING SECTS 32662000 + BR R14 IF COMES HERE, NO CHECKING 32664000 + SPACE 2 32666000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32668000 +* INDIVIDUAL ROUTINE REGISTER CHECKING CODE SECTIONS * 32670000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 32672000 + SPACE 2 32674000 +RHSDBCDX EQU * RA IN MACHINE REASONABLY 32676000 + BAL R1,RHRAADDR CALL CHECKING ROUTINE 32678000 + BR R14 RETURN 32680000 + SPACE 1 32682000 +RHSDBTRM EQU RHSDBCDX SAME CODE 32684000 +RHSDCTRM EQU RHSDBCDX SAME CODE 32686000 +RHSDDTRM EQU RHSDBCDX SAME CODE 32688000 +RHSDXTRM EQU RHSDBCDX SAME CODE 32690000 + SPACE 2 32692000 +RHSYFIND EQU * RA REASONBALE, 1<= RB <= 7 32694000 + BAL R1,RHRAADDR CHECK RA FOR REAONABLENESS 32696000 + C RB,AWF1 TEST 32698000 + LTR RB,RB WAS RB<=0 32700000 + BNP RHRBERR YES, ILLEGAL-BRANCH 32702000 + C RB,AWF7 WAS IT TOO BIG 32704000 + BCR NH,R14 NO,OK,RETURN 32706000 +RHRBERR OI RERGEFLG,RGERB RB IN ERROR 32708000 + BR R14 RETURN 32710000 + EJECT 32712000 +* RHENTS INTERNAL SUBROUTINES * 32714000 + SPACE 2 32716000 +**--> INSUB: RHRAADDR CHECK RA FOR REASONABLE @ + + + + + + + + + + + 32718000 +*+ ENTRY CONDITIONS + 32720000 +*+ R1 = RETURN @ TO CALLING CODE + 32722000 +*+ RA = VALUE TO BE CHECKED FOR LEGALITY. + 32724000 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 32726000 + SPACE 1 32728000 +RHRAADDR EQU * 32730000 +* CHECK FOR @ IN USER PROGRAM. 32732000 + C RA,ECFADL LOWER LIMIT OF USER 32734000 + BL RHRA2 NO, NOT IN USER PROG 32736000 + C RA,ECFADHC HIGH CHECKING LIMIT 32738000 + BCR NH,R1 INSIDE USER, OK, RETURN 32740000 + SPACE 1 32742000 +* CHECK FOR IN AVWXTABL 32744000 +RHRA2 EQU * 32746000 + CR RA,RAT LOWER TAHN PTR 32748000 + BL RHRA3 YES, NOT THERE EIEHRE 32750000 + LA R0,AVWXEND-8 HIGHEST @ IN TABLE 32752000 + CR RA,R0 COMPARE TO UPPER LIMIT POSSIBLE 32754000 + BCR NH,R1 IN THERE, OK RETURN 32756000 + SPACE 1 32758000 +* CHECK FOR @ IN DYNAMIC AREA. 32760000 +RHRA3 EQU * 32762000 + C RA,AJOTADL LOWER THAN LOWEST 32764000 + BL RHRA4 YES 32766000 + C RA,AJOTADH HIGHER THAN HIGHEST 32768000 + BCR NH,R1 NO, SO OK, RETURN 32770000 + SPACE 1 32772000 +RHRA4 EQU * 32774000 +RHRAERR OI RERGEFLG,RGERA FLAG RA WORNG 32776000 + BR R1 RETURN TO CALLER 32778000 +.RHNREP ANOP 32780000 + LTORG 32782000 + DROP R5,R10,R11,RAT,R13 REMOVE ALL USINGS 32784000 + TITLE 'RFSYMS - REPLACE TABLE CSECT - CSECT,ENTRY NAMES' 32786000 + PRINT GEN 32788000 +**--> CSECT: RFSYSMS TABLE OF CSECT-ENTRY NAMES-REPLACE . . . . . . 32790000 +*. RFYSMS (SECT.1) HAS AN ELEMENT FOR EACH CSECT WHICH CAN. 32792000 +*. BE DYNAMMICALLY REPLACED BY A USER-WRITTEN ROUTINE. EACH . 32794000 +*. ELEMENT CONTAINS THE NAME OF THE CSECT, THE NUMBER OF . 32796000 +*. ENTRY POINTS IN IT, AND A LIST OF ENTRY POINT NAMES AND . 32798000 +*. OFFSETS TO THEIR ADCONS IN AVWXTABL, SO THEY CAN BE CHANGED. . 32800000 +*. THE 2ND SECTION IS PRESENT IF &$REPL=2. IT LISTS ALL . 32802000 +*. ENTRYPOINTS WHICH CAN BE CALLED FROMA USER PROGRAM, WITH . 32804000 +*. OFFSET @ PTRS TO THEIR ADCONS IN AVWXTABL, AND TO CODE IN . 32806000 +*. SECTION RHENTS OF REMONI. THIS CODE IS USED TO CHECK THE . 32808000 +*. REGISTERS PASSED BY THE USER TO THE CALLED PROGRAM. . 32810000 +*. THE 3RD SECTION IS ALSO PRESENT ONLY IF &$REPL=2. IT . 32812000 +*. HAS LABELS OF THE FORM RI&CSECT, WITH &CSECT BEING ONE WHICH . 32814000 +*. NOT ONLY CAN BE REPLACED, BUT CAN ALSO CALL OTHER ROUTINES. . 32816000 +*. EACH ELEMNT CONTAINS A HALFWORD WITH THE NUMBER OF DIFFERENT . 32818000 +*. SUBROUTINE ENTRIES WHICH THIS CSECT IS PERMITTED TO CALL, . 32820000 +*. FOLOWED BY THAT # OFFSET VALUES TO THE ELEMENTS IN THE 2ND . 32822000 +*. SECTION OF THOSE ENTRIES IT CAN CALL. REMONI OBTAINS AN . 32824000 +*. OFFSET FROM RFSYMS TO RI&CSECT FROM THE RFSYMBLK BELONGING . 32826000 +*. TO THAT CSECT. NOTE, IF A CSECT CAN CALL NO OTHER, THE . 32828000 +*. VALUE SAVED IS = 0. . 32830000 +*. NAMES: RF------ . 32832000 +*. NAMES: RI------ (IN SECTION 3, IF &$REPL=2) 32834000 +*. DSECT RFSYMBLK IS USED TO DESCRIBE EACH ENTRY IN SECTS.1&2. . 32836000 +*. USES MACROS: $AL2,RFSGN . 32838000 +*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 32840000 + SPACE 1 32842000 +RFSYMS CSECT 32844000 +* **NOTE** COMMENTED ENTRIES ARE NOT CURRENTLY AVAILABLE. 32846000 + RFSGN BROPS2,(BRINIT,BRUSIN,BRDROP,BRDISP) 32848000 +* RFSGN CACONS,(CACON1,CACON2),TYPE=1 32850000 + RFSGN CBCONS,(CBCON1,CBCON2) 32852000 + RFSGN CCCONS,(CCCON1,CCCON2) 32854000 + RFSGN CDECNS,(CDECN1,CDECN2) 32856000 + RFSGN CFHCNS,(CFHCN1,CFHCN2) 32858000 +* RFSGN CODTL1,CODTL1,TYPE=1 32860000 + RFSGN CPCONS,(CPCON1,CPCON2) 32862000 +* RFSGN CVCONS,(CVCON1,CVCON2),TYPE=1 32864000 + RFSGN CXCONS,(CXCON1,CXCON2) 32866000 + RFSGN CZCONS,(CZCON1,CZCON2) 32868000 + RFSGN EVALUT,EVALUT,TYPE=1 32870000 + RFSGN OPCOD1,(OPINIT,OPFIND) 32872000 +* RFSGN SCANRS,(SCANBL,SCANCO,SCANEQ),TYPE=1 32874000 + RFSGN SDTERM,(SDBCDX,SDBTRM,SDCTRM,SDDTRM,SDXTRM) 32876000 + RFSGN SYMOPS,(SYINT1,SYENT1,SYFIND,SYEND2) 32878000 +RFSYMS$L EQU *-RFSYMS LENGTH OF SEARCH IN RFSYMS CSECT 32880000 + SPACE 1 32882000 + AIF (&$REPL LT 2).RENREPA SKIP IF NO SECTS 2 & 3 32884000 + SPACE 2 32886000 +* SECTION 2 - CALLABLE ENTRY POINT INFORMATION. 32888000 +RFSCALLA DS 0H BEGINNING OF LIST 32890000 + RFSGN SDBCDX,TYPE=2 32892000 + RFSGN SDBTRM,TYPE=2 32894000 + RFSGN SDCTRM,TYPE=2 32896000 + RFSGN SDDTRM,TYPE=2 32898000 + RFSGN SDXTRM,TYPE=2 32900000 + RFSGN SYFIND,TYPE=2 32902000 +RFSCALLZ EQU *-RFS$LEN END @ - LENGTH FOR BXLE LIMIT 32904000 + SPACE 2 32906000 +* SECTION 3 - OFFSETS TO CALLABLES FROM EACH REPLACABLE. 32908000 +* ALTHOUGH EVALUT IS ONLY ONE NOW, OTHERS COULD BE ADDED. 32910000 + SPACE 1 32912000 +RIEVALUT DC H'6' EVALUT CAN CALL 6 ENTRIES IF IT WANT 32914000 + $AL2 RFSYMS,(RFSDBCDX,RFSDBTRM,RFSDCTRM,RFSDDTRM,RFSDXTRM,RFS#32916000 + YFIND) OFFSETS TO SECTION 2 BLOCKS ABOVE 32918000 + SPACE 2 32920000 + PRINT NOGEN TURN OFF GENERATION IN REST CPP 32921000 +.RENREPA ANOP 32922000 +.RENREPL ANOP 32924000 + TITLE '*** EQU''S FOR MACRO ROUTINES ' 40000000 + AIF (NOT &$MACROS).MAXXXX SKIP MACROS J 40000001 +* FOLLOWING EQU'S HANDLE ERROR MESSAGES IN MEXPND NOT TAKEN CAREOF 40005000 +* BY ERRTAG 40010000 +$ER#ACTR EQU 2 ACTR EXCEEDED S 40015000 +$ER#DMER EQU 4 SET SYMBOL SUBSCRIPT S 40020000 +$ER#SBST EQU 6 SUBSTRING EXPRESSION S 40025000 +$ER#CVCA EQU 8 CHAR TO ARITH CONV ERR S 40030000 +$ER#CVAB EQU 10 ARITH TO BOOL CONV ERR S 40035000 +$ER#CVCB EQU 12 CHAR TO BOOL CONV ERR S 40040000 +$ER#ATER EQU 14 ATTRIBUTE USE ERR S 40045000 +$ER#SYSL EQU 16 &SYSLIST ERR S 40050000 +$ER#SYER EQU 18 SYSTEM ERR S 40055000 +$ER#EXBF EQU 20 CHAR BUFFER EXCEEDED S 40060000 +$ER#MXST EQU 22 MAX # OF STMTS EXCEEDED S 40065000 +$ER#ZDIV EQU 24 FIXED PT OVERFLOW OR ZERO DIVIDE S 40070000 +$ER#PRVR EQU 26 A 40070100 + SPACE 2 40075000 +* FOLLOWING FLAGS SET IN AVMSNBY1 WILL TURN ON RESPECTIVE SNAPS 40080000 +$MSNP01 EQU X'80' MACINT SNAP FLAG 40085000 +$MSNP02 EQU X'40' MACRO1 SNAP FLAG 40090000 +$MSNP03 EQU X'20' MACSCN SNAP FLAG 40095000 +$MSNP04 EQU X'10' MCSCOP SNAP FLAG 40100000 +$MSNP05 EQU X'08' MACFND,MCVSCN SNAP FLAG 40105000 +$MSNP06 EQU X'04' MCSYSR, DECTRM, MCGTST, ATTERM SNAP FLAG 40110000 +$MSNP07 EQU X'02' MCBODY SNAP FLAG 40115000 +$MSNP08 EQU X'01' BSU'S SNAP FLAG 40120000 + SPACE 40125000 +* FOLLOWING FLAGS SET IN AVMSNBY2 WILL TURN ON RESPECTIVE SNAPS 40130000 +$MSNP09 EQU X'80' MACLEX SNAP FLAG 40135000 +$MSNP10 EQU X'40' MCGNCD SNAP FLAG - ONE OPS 40140000 +$MSNP11 EQU X'20' MEXPND SNAP - INIT AND INTERPRET 40145000 +$MSNP12 EQU X'10' MEXPND SNAP - INTERNAL ROUTINES 40150000 +$MSNP13 EQU X'08' MXERRM, MXMVSR SNAP CONTROL 40155000 +$MSNP14 EQU X'04' SET MEXPND ENTER EXIT SNAPS 40160000 + SPACE 40165000 +$MINDEF EQU X'80' AVMBYTE1 - IN MACRO DEFINITION 40170000 +$MINEXP EQU X'40' AVMBYTE1 - IN MACRO EXPANSION 40175000 +$MGBLFLG EQU X'80' MCLBFLG2 - GLOBALS NO LONGER OK S 40180000 +$MLCLFLG EQU X'40'+$MGBLFLG MCLBFLG2 - LOCALS NO LONGER OK S 40185000 +$MACTFLG EQU X'20'+$MLCLFLG MCLBFLG2 - ACTR NO LONGER OK S 40190000 +$MCOCFL1 EQU B'00000001' (MCLBFLG2) - OPEN CODE - DECLARE S#40190100 + TYPES ALLOWED S 40190150 +$MCOCFL2 EQU B'00000011' (MCLBFLG2) - OPEN CODE - DECLARE S#40190200 + TYPES NOT ALLOWED S 40190201 +$MC1DCL EQU B'10000000' DECLARE TYPE S 40190500 +$MC1ERR EQU B'01000000' ORDER ERROR S 40190600 +$MC1SKIP EQU B'00100000' DON'T CALL MXINST S 40190700 +$MC1RET EQU B'00010000' RETURN AFTER MXINST S 40190800 +$MSBLIST EQU X'04' AVMBYTE1 - PROCESSING OPERAND SUBLST 40195000 +$MINQUOT EQU X'02' AVMBYTE1 - INSIDE QUOTED STRING 40200000 +$MKEYOPR EQU X'01' KEYWORD OPRND PROCESSSED, POSIT NOGO 40205000 + SPACE 1 40210000 +$MOPRTR EQU X'80' AVMBYTE2 - PREV SYMBOL = OPRTR 40215000 +$MTERM EQU X'40' AVMBYTE2 - PREV SYMBOL = TERM 40220000 +$MINARIT EQU X'20' AVMBYTE2 - IN ARITHMETIC EXPRESSION 40225000 +$MINBOOL EQU X'10' AVMBYTE2 - IN BOOLEAN EXPRESSION 40230000 +$MINCHAR EQU X'08' AVMBYTE2 - IN CHARACTER EXPRESSION 40235000 +$MDIMVAR EQU X'04' AVMBYTE2 - PREV SYMBOL = DIMEN SYMB 40240000 +$MINAPAR EQU X'02' AVMBYTE2 - IN ARITH SUBSCR EXPRESS 40245000 +$MINPEXP EQU X'01' AVMBYTE2 - DO EXPRES IN PARENS ONLY 40250000 + SPACE 1 40255000 +$MRPARST EQU X'80' AVMBYTE4 - RIGHT PAREN IN INPUT 40260000 +$MINSTRN EQU X'40' AVMBYTE4 - PROC VAR SYMB IN STRING 40265000 +$MCOMST EQU X'20' AVMBYTE4 - COMMA IN BSU INPUT STRM 40270000 +$MGENSTP EQU X'10' AVMBYTE4 - STOP MACRO GENERATION 40275000 +$MXJMPFL EQU X'08' AVMBYTE4 - AGO OR SUCCESSFUL AIF SWT 40280000 +$MSTOPEX EQU X'04' AVMBYTE4 - DON'T EXPAND CRRNT MACRO 40285000 + SPACE 2 40290000 +$GLOBAL EQU 4 40295000 +$LOCAL EQU 8 40300000 +$SYMPAR EQU 12 40305000 +$SYSVAR EQU 16 SYSTEM VARIABLE INDEX 40310000 + SPACE 2 40315000 +$LCHWRK EQU 1024 40320000 +$LSUBENT EQU 12 LENGTH OF SUB-OPERAND ENTRY 40325000 +$LMSRCMX EQU (RSOL1+2*RSOLC)-1 MAXIMUM LENGTH-1 OF GEN'D STMT 40330000 + SPACE 2 40345000 +$BSAR EQU X'20' MCBSFLGS, ARITHMETIC TYPE 40350000 +$BSBOOL EQU X'10' MCBSFLGS, BOOLEAN TYPE 40355000 +$BSCHAR EQU X'08' MCBSFLGS, CHARACTER TYPE 40360000 + SPACE 2 40365000 +* EQUATES FOR INDEX VALUES FOR OPERATOR BSU'S 40370000 +$BSPLUS EQU 2 40375000 +$BSMIN EQU 4 40380000 +$BSMULT EQU 6 40385000 +$BSDIV EQU 8 40390000 +$BSOR EQU 10 40395000 +$BSAND EQU 12 40400000 +$BSNOT EQU 14 40405000 +$BSNE EQU 16 40410000 +$BSGE EQU 18 40415000 +$BSLE EQU 20 40420000 +$BSLT EQU 22 40425000 +$BSEQ EQU 24 40430000 +$BSGT EQU 26 40435000 +$BSCAT EQU 28 40440000 +$BSAGO EQU 30 40445000 +$BSAIF EQU 32 40450000 +$BSETA EQU 34 40455000 +$BSETB EQU 36 40460000 +$BSETC EQU 38 40465000 +$BSRPAR EQU 40 40470000 +$BSLPAR EQU 42 40475000 +$BSBSCRP EQU 44 40480000 +$BSBSTR EQU 46 40485000 +$BSBSYL EQU 48 40490000 +$BSCOMMA EQU 50 HIERARCHY = ZERO 40495000 +$BSPRINT EQU 52 HIERARCHY = 2 40500000 +$BSMEXIT EQU 54 HIERARCHY = 2 40505000 +$BSMEND EQU 56 HIERARCHY = 2 40510000 +$BSANOP EQU 58 HIERARCHY = 2 40515000 +$BSERR01 EQU 60 HIERARCHY = 2 40520000 +$BSINMAC EQU 62 SET INNER MACRO CALL CODE HIER = 2 40525000 +$BSMVSTM EQU 64 BSU INDEX FOR MOVE STMT 40530000 +$BSMNTER EQU X'80' FLAG TO FORCE ERR MSSGE ON MNOTE 40535000 +$BSRLCHR EQU X'80' FLAG FOR CHAR TYPE RELATIONAL OPRTR 40540000 +$MPRCOM EQU 1 (MCBSFLGS)=> SPECIAL PRINT A 40542000 + SPACE 2 40545000 +* EQUATES FOR OPERATOR HIERARCHIES 40550000 +$MCOMMHR EQU 0 40555000 +$MPARHR EQU 0 40560000 +$MPRNTHR EQU 2 40565000 +$MSETHR EQU 2 40570000 +$MORHR EQU 4 40575000 +$MANDHR EQU 6 40580000 +$MRELHR EQU 8 40585000 +$MCATHR EQU 10 40590000 +$MPLUSHR EQU 12 40595000 +$MMULTHR EQU 14 40600000 +$MNOTHR EQU 16 40605000 +$MAGOHR EQU 16 40610000 +$MAIFHR EQU 16 40615000 + SPACE 2 40620000 +* EQUATES FOR TERM BSU INDEXES 40625000 +$BSTSYAG EQU 2 GLOBAL ARITH SET SYMBOL 40630000 +$BSTSYBG EQU 4 GLOBAL BOOLEAN SET SYMBOL 40635000 +$BSTSYCG EQU 6 GLOBAL CHAR SET SYMBOL 40640000 +$BSTSYAL EQU 8 LOCAL ARITH SET SYMBOL 40645000 +$BSTSYBL EQU 10 LOCAL BOOL SET SYMBOL 40650000 +$BSTSYCL EQU 12 LOCAL CHAR SET SYMBOL 40655000 +$BSYMPAR EQU 14 SYMBOLIC PARAMETER 40660000 +$BSIMMA EQU 16 ARITH IMMEDIATE BALUE 40665000 +$BSIMMB EQU 18 BOOLEAN IMMEDIATE VALUE 40670000 +$BSTRING EQU 20 STRING VALUE 40675000 +$BSYSNDX EQU 22 &SYSNDX SYSTEM VARIABLE 40680000 +$BSYSLST EQU 24 &SYSLIST SYSTEM VARIABLE 40685000 +$BSYSECT EQU 26 &SYSECT SYSTEM VARIABLE 40690000 +$BSLABEL EQU 28 40695000 +$BSTEMP EQU 30 40700000 +$BSATI EQU 34 BSU NBR FOR I' ATTRIBUTE 40705000 +$BSATK EQU 36 BSU NBR FOR K' ATTRIBUTE 40710000 +$BSATL EQU 38 BSU NBR FRR L' ATTRIBUTE 40715000 +$BSATN EQU 40 BSU NBR FOR N' ATTRIBUTE 40720000 +$BSATS EQU 42 BSU NBR FOR S' ATTRIBUTE 40725000 +$BSATT EQU 44 BSU NBR FOR T' ATTRIBUTE 40730000 +$BSADDRA EQU 46 BSU NBR FOR ARITH TYPE @ 40735000 +$BSADDRB EQU 48 BSU NBR FOR BOOL @ 40740000 +$BSADDRC EQU 50 BSU NBR FOR CHAR TYPE @ 40745000 + SPACE 2 40750000 +* EQUATES FOR VARIOUS LEFT PAREN TYPES 40755000 +$MINLPAR EQU X'80' ARITH LEFT PAREN 40760000 +$MINSBST EQU X'40' SUBSTRING LEFT PAREN 40765000 +$MINSBSC EQU X'20' SUBSCRIPT LEFT PAREN 40770000 +$MINSYSL EQU X'10' &SYSLIST LEFT PAREN 40775000 + TITLE '*** DSECTS FOR MACRO CAPABILITY IN ASSIST***' 40780000 +**--> DSECT: MCGLBDCT FORMAT FOR GLOBAL DICTIONARY ENTRY * 40785000 +*. * 40790000 +*.********************************************************************* 40795000 + SPACE 40800000 +MCGLBDCT DSECT 40805000 +MCGLBNXT DS F LINK TO NEXT GLOBAL ENTRY 40810000 +MCGLBLEN DS C LENGTH OF GLOBAL NAME 40815000 +MCGLBNAM DS CL8 GLOBAL DICT ENTRY NAME 40820000 +MCGLBTYP DS C ENTRY TYPE, ARITH, BOOL OR CHAR 40825000 +MCGLBDIM DS H DIMENSION OF SET VARIABLE 40830000 +MGLCLPNT DS 0F POINTER OFFSET FOR LOCAL VALUE 40835000 +MCGLBDEF DS F COUNT # OF MACRO DEFINITION 40840000 +$LGLBENT EQU *-MCGLBDCT LEN OF GLOBAL DICT ENTRY STND PART 40845000 +MCGBAVAL DS 0F GLOBAL ARITH VALUE 40850000 +MCGBBVAL DS 0F GLOBAL BOOL VALUE 40855000 +MCGBCLEN DS F GOBAL CHAR VALUE LENGTH 40860000 +MCGBCVAL DS CL8 GLOBAL CHAR VALUE 40865000 + EJECT 40870000 +**--> DSECT: MCLCLDPV FORMAT FOR LOCAL DICTIONARY DOPE VECTOR * 40875000 +*. * 40880000 +*.********************************************************************* 40885000 + SPACE 40890000 +MCLCLDPV DSECT 40895000 +MCLOCNXT DS F POINTER TO NEXT ENTRY 40900000 +MCLCLLEN DS C LOCAL ENTRY NAME LENGTH 40905000 +MCLCLNAM DS CL8 LOCAL ENTRY NAME 40910000 +MCLCLTYP DS C TYPE, IE ARITH, BOOL OR CHAR 40915000 +MCLCLDIM DS H DIMENSION OF LOCAL ENTRY 40920000 +MCLCLPNT DS F OFFSET POINTER FOR VALUE 40925000 +$LLCLDV EQU *-MCLCLDPV LEN OF LOCAL DICT D.V. 40930000 + SPACE 2 40935000 +**--> DSECT: MCPARENT FORMAT FOR SYMBOLIC PARAMETER ENTRY * 40940000 +*. * 40945000 +*.********************************************************************* 40950000 + SPACE 40955000 +MCPARENT DSECT 40960000 +MCPARNXT DS F POINTER TO NEXT ENTRY 40965000 +* NOTE: NEXT 3 ENTRIES MUST BE IN ORDER GIVEN. JRM. J 40969900 +MCPARNLN DS C PARAM ENTRY NAME LENGTH 40970000 +MCPARNAM DS CL8 SYMBOLIC PARAM NAME 40975000 +MCPARTYP DS C PARAMETER TYPE, POSIT OR KEYWORD 40980000 +MCPARNTL EQU *-MCPARNLN LENGTH MOVED TOGETHER J 40981000 +MCPARNDX DS H PARAMETER POSITION IN LIST 40985000 +MCPROPLN DS C LENGTH OF OPERAND 40990000 +MCPRATYP DS C ATTRIBUTE TYPE, IE 'N', 'O' 40995000 +MCPARNB DS C UNUSED AT PRESENT J 41000000 +MCPARFIL DS C UNUSED AT MOMENT JRM 41005000 +MCPROPRN DS F OPERAND STANDARD VALUE POINTER 41010000 +$LPARENT EQU *-MCPARENT LEN OF SYM PARAM ENTRY 41015000 + SPACE 2 41020000 +**--> DSECT: MCBSU FORMAT OF BASIC SYNTACTIC UNIT * 41025000 +*. * 41030000 +*.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 41035000 + SPACE 41040000 +MCBSU DSECT 41045000 +MCBSFLGS DS C INDICATES OPRTR, TERM ETC 41050000 +MCBSINDX DS C BSU INDEX OF SYMBOL 41055000 +MCBSOFST DS C SYMBOL OFFSET RELATIVE TO SOURCE 41060000 +MCBSTRLN DS 0C STRING LENGTH 41065000 +MCBSHIER DS C HIERARCHY OF OPERATOR, IF OPRTR 41070000 +MCBSVALU DS 0F ARITH OR BOOL IMMEDIATE VALUE 41075000 +MCBSLOC DS F LOCATION OF TERM VALUE 41080000 +$LMCBSU EQU *-MCBSU LENGTH OF BSU ENTRY 41085000 + SPACE 2 41090000 +**--> DSECT: MCSEQ FORMAT OF SEQUENCE SYMBOL ENTRY * 41095000 +*. * 41100000 +*.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 41105000 + SPACE 41110000 +MCSEQ DSECT 41115000 +MCSEQNXT DS F POINTER TO NEXT ENTRY 41120000 +MCSEQNLN DS C LENGTH OF NAME 41125000 +MCSEQNAM DS CL8 NAME OF SEQ SYMBOL 41130000 +MCSEQFLG DS C ENTRY FLAG BYTE 41135000 +MCSEQDUM DS H UNUSED 41140000 +MCSEQVAL DS F POINTER TO SEQ SYMBOL LOCATION * 41145000 +$LMCSEQ EQU *-MCSEQ LENGTH OF SEQ SYMBOL ENTRY 41150000 + SPACE 2 41155000 +**--> DSECT: MCOPQUAD FORMAT OF ONE OP ENTRY. MACRO DEFINITIONS * 41160000 +*. ARE TRANSLATED INTO ONE OPS FOR SUBSEQUENT INTERPRETATION * 41165000 +*. * 41170000 +*.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 41175000 + SPACE 41180000 +MCOPQUAD DSECT 41185000 +* EACH STATEMENT BEGINS WITH A PARTIAL ONE OP GIVEN FIRST, A 41186000 +* FOLLOWED BY 0 OR MORE NORMAL-SIZE ONE-OPS A 41186100 +MCQUDNXT DS A ADDRESS OF NEXT STMT'S CODE A 41186200 +MCQSTMNO DS PL3 STATEMENT NUMBER A 41186300 +MCQS1FLG DS C FLAGE BYTE OR UNUSED A 41186400 +$LMCOPL1 EQU *-MCOPQUAD LENGTH OF 1ST ONE-OP IN STMY A 41186500 + SPACE 1 A 41186600 +* FORMAT OF NORMAL ONE-OPS IN STATEMENT FOLLOWS A 41186700 + ORG MCOPQUAD BACK TO BEGINNING A 41186800 +MCBOPRTR DS C OP CODE 41190000 +MCARG1DX DS C ARG #1 BSU INDEX 41195000 +MCARG2DX DS C ARG #2 BSU INDEX 41200000 +MCRSLTYP DS C RESULT TYPE 41205000 +MCARG1LC DS F ARG #1 LOCATION 41215000 +MCARG2LC DS A ADDRESS OF ARGUMENT #1 A 41220000 +MCRESULT DS F RESULT 41235000 +$LMCQUAD EQU *-MCOPQUAD LENGHT OF ONE-OP 41240000 + SPACE 2 41245000 +**--> DSECT: MCBSTRMS FORMAT OF TWO BSU'S FOR EASE * 41250000 +*. OF MANIPULATION IN TERM STACK * 41255000 +*. * 41260000 +*.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 41265000 + SPACE 41270000 +MCBSTRMS DSECT 41275000 +MCBSFLG1 DS C TERM #1 FLAG BYTE 41280000 +MCBSNDX1 DS C TERM #1 BSU INDEX 41285000 +MCBOFST1 DS C TERM #1 OFFSET 41290000 +MCBLN1 DS C TERM #1 LENGTH 41295000 +MCBSLOC1 DS F TERM #1 LOCATION OR VALUE 41300000 +MCBSFLG2 DS C TERM#2 FLAG BYTE 41305000 +MCBSNDX2 DS C TERM #2 BSU INDEX 41310000 +MCBOFST2 DS C TERM #2 OFFSET 41315000 +MCBLN2 DS C TERM #2 LENGTH 41320000 +MCBSLOC2 DS F TERM #2 LOCATION OR VALUE 41325000 + SPACE 2 41330000 +*.--> DSECT: MCBOPRST FORMAT OF OPERATOR STACK ENTRY * 41335000 +*. * 41340000 +*.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 41345000 +MCBOPRST DSECT 41350000 +MCBOPFL DS C OPERATOR FLAGS 41355000 +MCBSOPST DS C OPERATOR BSU INDEX 41360000 +MCBOPOF DS C OFFSET 41365000 +MCBOPHR DS C OPRTR HIERARCHY 41370000 +MCBOPVAL DS F NOT USED 41375000 + SPACE 2 41380000 +**--> DSECT: MXPNTSAV CONTROL FOR LEVEL OF MACRO EXPANSION * * S 41385000 +*. ONE IS ALLOCATED FOR EACH LEVEL OF MACRO CALL A 41390000 +*. NAMES:MXP_____ A 41395000 +*.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 41400000 + SPACE 41405000 +MXPNTSAV DSECT 41410000 +MXPNLINK DS A @ LAST PREVIOUS MXPNTSAV A 41415000 +MXPLSYPT DS F PNTR TO SYM PARAM D.V.'S 41420000 +MXPSYSDX DS PL3 CURRENT SYSNDX VALUE 41430000 +MXPNFLG1 DS C FLAG BYTE 41435000 +MXPCHRBF DS F PNTR TO CHAR BUFFER FOR CATEN OPRTNS 41440000 +MXPNMCLB DS F PNTR TO MAC LIB ENTRY 41445000 +MXPNKYPT DS F PNTR TO 1ST KEYWORD SYM PAR DV 41450000 +MXPNKLPT DS F PNTR TO 1ST KEYWORD DICT ENTRY 41455000 +MXPNLDBS DS F PNTR TO SET SYMB LOCAL DICT 41460000 +MXPNCDPT DS F PNTR TO 1ST INSTRUCTION 41465000 +MXPNCRCD DS F PNTR TO CURRENT INST 41470000 +MXPNBOPS DS F NBR OF POSITIONAL OPRNDS 41480000 +MXPNLSPT DS F PNTR TO SYM PAR DICT ENTRIES 41485000 +$LMXPTSV EQU *-MXPNTSAV LEN OF DYNAMIC WORK AREA IN MEXPND 41490000 + SPACE 2 41495000 +**--> DSECT: MCPAROPR FORMAT FOR SYMBOLIC PARAMETER DICTIONARY * 41500000 +*. ENTRY. ONE ENTRY FOR EACH SYM PARAM ON ENTRY TO MEXPND * 41505000 +*. * 41510000 +*.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 41515000 + SPACE 41520000 +MCPAROPR DSECT 41525000 +MCPAROFL DS C OPRNDS FLAGS 41530000 +MCPAROLN DS C OPRND LENGTH, IE K' 41535000 +MCPARONB DS C # OF SUBOPRNDS IE N' 41540000 +MCPAROTP DS C OPRND TYPE, IE N, O OR U 41545000 +MCPAROPT DS F POINTER TO OPRND 41550000 +MCPRSBPT DS F POINTER TO LSUB OPRND LIST 41555000 +$LMPAROP EQU *-MCPAROPR LEN OF SYM PAR DICT ENTRY 41560000 + SPACE 2 41565000 +**--> DSECT: MCPARSUB FORMAT FOR DICT ENTRY FOR SUBLIST OPRNDS * 41570000 +*. ONE ENTRY FOR EACH ELEMENT OF SUBLIST OF SYM PARAM ENTRY * 41575000 +*. * 41580000 +*.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 41585000 + SPACE 41590000 +MCPARSUB DSECT 41595000 +MCPARSFL DS C SUBOPRND FLAGS 41600000 +MCPARSNU DS C NOT USED 41605000 +MCPARSTP DS C SUB OPRND TYPE 41610000 +MCPARSLN DS C SUB OPRND LENGTH 41615000 +MCPARSPT DS F PNTR TO SUB OPRND 41620000 +$LMPARSB EQU *-MCPARSUB LEN OF SUBLIST OPRND ENTRY 41625000 + AIF (NOT &$DEBUG).MACDBG SKIP IF DEBUG 41635000 + XSET XSNAP=OFF KILL REMAINING XSANPS 41640000 +.MACDBG ANOP 41645000 + PRINT ON,NOGEN 41650000 + TITLE '*** MACINT - MACRO INITIALIZATION ROUTINE' S 41651000 +**--> CSECT: MACINT THIS ROUTINE IS CALLED IN INITIALIZATION * 41655000 +*. PHASE OF ASSIST. IT PERFORMS CERTAIN REQUIRED STORAGE * 41660000 +*. ALLOCATION AND SETS POINTERS AVGEN1CD AND AVGEN2CD. * 41665000 +*. OVERFLOW MESSAGE FOR GENERAL USE IS ALSO CREATED. * 41670000 +*. G.M.CAMPBELL - SUMMER - 1972 * 41675000 +*. * 41680000 +*. USES MACROS: $ALLOCL, $SAVE, $RETURN, $CALL * 41685000 +*. USES DSECTS: AVWXTABL * 41690000 +*. * 41695000 +*. REGISTER USAGE: S 41695050 +*. WORK REGS: RA,RB S 41695100 +*. * 41700000 +*.********************************************************************* 41705000 + SPACE 41710000 +MACINT CSECT 41715000 + $DBG ,NO 41720000 + $SAVE SA=NO 41725000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 41730000 + MVI AVMSNBY1,X'FF' TURN OFF SNAPS S 41730100 + MVI AVMSNBY2,X'FF' TURN OFF SNAPS S 41730200 + AIF (&$DEBUG).MACINT1 SKIP IF IF NOT DEBUG 41735000 + MVI AVMSNBY1,X'00' CLEAR SNAP BYTE 1 41740000 + MVI AVMSNBY2,X'00' CLEAR SNAP BYTE 2 41745000 + XSNAP LABEL='***MACINT ENTERED***',IF=(AVMSNBY1,O,$MSNP01,TM) 41750000 +.MACINT1 ANOP 41755000 + MVC AVMBYTE1(4),AWZEROS CLEAR FLAGS 41760000 + LA RA,AVMWRK1+255 GET UPPER LIMIT OF WORK AREA1 41765000 + ST RA,AVMWRKL1 SAVE IN MAIN CONTROL AREA 41770000 + LA RA,AVMWRK2+255 GET WORK AREA2 LIMIT 41775000 + ST RA,AVMWRKL2 SAVE IN MAIN CONTROL AREA 41780000 + SPACE 2 41785000 + XC AWZEROS(256),AWZEROS ZERO TABLE S 41790000 + TM AVTAGSM,AJOMACRO MACRO OPTION USED? 41800000 + BZ MACINTRT RETURN IF NOT 41805000 + SPACE 1 41810000 +* CONSIDER MODIFYING CODE FOR LIST HANDLING ******************** 41815000 + LA RB,$LMACLIB+$LGLBENT+$LCHWRK TOTAL WORKAREA LENGTH J 41820000 + $ALLOCL RA,RB,MCINITOV GET DUMMY AREA FOR MACLIB 41825000 + ST RA,AVMACLIB STORE @ IN MAIN TABLE 41830000 + MVC 0($LMACLIB+$LGLBENT,RA),AWZEROS ZERO MAC,GBLX TABLES A 41835000 + USING MACLIB,RA NOTE USING ON MACLIB ENTRY 41840000 + OI MCLBTAGS,AVMCLBDF SET DEFINED FLAG ON DUMMY 41845000 + DROP RA 41850000 +* SPACE FOR 1 DUMMY MCGLBDCT. J 41855000 + LA RA,$LMACLIB(,RA) BUMP PTR BEYOND MACRO ENTRY J 41860000 + ST RA,AVMGDICT STORE @ IN MAIN TABLE 41865000 + SPACE 1 REMV OLD MVC J 41870000 +* BUMP, POINT AT $LCHWORK BYTES FOR CHARACTER WORKAREA. J 41875000 + LA RA,$LGLBENT(,RA) BUMP PTR BEYOND GBLX ENTRY J 41880000 + ST RA,AVMCHSTR SAVE @ IN AVWXTABL 41885000 + LA RA,$LCHWRK-1(RA) GET @ OF LAST BYTE 41890000 + ST RA,AVMCHLIM SAVE @ IN AVWXTABL 41895000 + LA RA,MCINITOV GET @ OF OVRFLW ROUTINE 41900000 + ST RA,AVMOVRFL SAVE IN AVWXTABL 41905000 + MVC AVMACNST,AWZEROS INIT NEXTING COUNT TO ZERO 41910000 + MVC AVMMACID,AWZEROS INITIALIZE MACRO ID TO ZERO 41915000 + ZAP AVMSYSDX,AWP0 INIT SYSNDX TO ZERO 41920000 +MACINTRT EQU * 41925000 + MVC AVGEN1CD,AVADDHIH INIT EXPANSION POINTER 1 41930000 + MVC AVGEN2CD,AVADDHIH INIT EXPANSION POINTER 2 41935000 + XSNAP LABEL='***MACINT EXITED*** ',IF=(AVMSNBY1,O,$MSNP01,TM) 41940000 + $RETURN SA=NO 41945000 + SPACE 2 S 41950000 +**--> INSUB: MCINITOV OVERFLOW ROUTINE + + + + + + + + + + + + +S 41950100 +*+ CALLED BY ANY ROUTINE WHEN STORAGE OVERFLOW OCCURS. +S 41950200 +*+ -- TERMINATES SECOND PASS +S 41950300 +*+ +S 41950400 +*+ USES MACROS: $SPIE,$CALL +S 41950500 +*+ EXIT CONDITIONS: PROGRAM MARKED NON-EXECUTABLE +S 41950600 +*+ CALLED BY: MACRO1,MCGTEST,MCBODY, AND MCGNCD +S 41950700 +*+ +S 41955000 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 41960000 + SPACE 2 S 41965000 +MCINITOV EQU * PROGRAM EXITS TO HERE IF OVERFLOW 41970000 + BALR R15,0 **KLUDGE** NONSTANDRD BR'S ********* 41975000 + USING *,R15 SHOULD HAVE THIS USING 41980000 +* **WARNING** MACRO1 & MEXPND CANNOT BOTHE BE ACTIVE FOR THIS. 41985000 + L R1,AVMBSPIE GET @ LAST PREVIOUS SPIE BLK 41990000 + OI AVTAGS2,AJOASTOP STOP 2ND PASS PROCESSING 41995000 + $SPIE ACTION=(RS,(1)) RESTORE PREVIOUS PTR 42000000 + $CALL MOSTOP GO TO MOSTOP TO QUIT 42005000 + LTORG 42010000 + DROP RAT,R15 42015000 + TITLE '*** MACRO1 - MAIN ROUTINE FOR MACRO DEFINITION' 42020000 +**--> CSECT: MACRO1 CALLED BY MAIN CONTROL WHEN MACRO OPCODE * 42025000 +*. ENCOUNTERED. AT PRESENT (DEC 31, 1971) ONLY MACRO * 42030000 +*. DEFINITIONS ARE ALLOWED, NO CONDITIONAL ASSEMBLY. MACRO1 * 42035000 +*. CREATES ENTRY IN MACLIB FOR FUTURE EXPANSION BY MEXPND * 42040000 +*. ENTRY CONDITIONS * 42045000 +*. RA = SCAN POINTER @ OF OPERAND * 42050000 +*. RC = @ OPCODTB ENTRY FOR OPERATION * 42055000 +*. * 42060000 +*. CALLS MACSCN,OUTPT2,MACFND,ERRTAG,ERRLAB,MCVSCN,MCSCOP, * 42065000 +*. MCBODY * 42070000 +*. USES MACROS: $SAVE,$RETURN,$CALL,$ALLOCL * 42075000 +*. USES DSECTS: RSBLOCK,OPCODTB,AVWXTABL,MACLIB,MCPARENT * 42080000 +*. * 42085000 +*. REGISTER USAGE: S 42085100 +*. WORK REGS: R0,R1,R2,RA,RB,RD,RE S 42085200 +*. BASE REGS: RAT,RW,RX,RY,R13,RC S 42085300 +*. UNUSED: RZ S 42085400 +*. S 42085500 +*.********************************************************************* 42090000 + XSET XSNAP=OFF A 42090100 + SPACE 42095000 +MACRO1 CSECT 42100000 + $SAVE RGS=(R14-R6),SA=*,BR=13 42105000 + USING AVWXTABL,RAT NOT MAIN TABLE USING 42110000 + XSNAP LABEL='***MACRO1 ENTERED***',IF=(AVMSNBY1,O,$MSNP02,TM) 42115000 + L RW,AVRSBPT GET @ OF SOURCE STATEMENT 42120000 + USING RSBLOCK,RW ESTAB BASE FOR SOURCE 42125000 + USING OPCODTB,RC ESTAB BASE FOR OPCODE ENTRY 42130000 + AIF (&$DEBUG).MACQQ00 SKIP IF NO DEBUF 42135000 + $SPIE ,,ACTION=CR,CE=MCBSPIEP 42140000 + ST R1,AVMBSPIE SAVE PREV INT @ 42145000 +.MACQQ00 ANOP 42150000 + LA RA,RSBSOURC SET SCAN POINTER 42155000 + LR R0,RC SAVE RC ACROSS MACSCN CALL A 42155100 + $CALL MACSCN SCAN SOURCE STATEMENT FOR FIELDS 42160000 + LR RC,R0 RESTORE RC A 42160100 + L RA,AVMFLD2 GET OPCODE ADDRESS 42165000 + CLI OPCHEX,$MACRO OPCODE=MACRO? 42170000 + BNE MACR1R01 ERROR IF NOT 42175000 + TM AVPRINT1,AVPRSAVE AFTER START STMNT OR EQUIV? 42180000 + BO MACR1R01 ERROR IF YES 42185000 + AIF (NOT &$MACOPC).MAC1A BRANCH IF NO OPEN CODE S 42185100 + TM AVMTAG00,AVMNOMAC MACROS ALLOWED? S 42185200 + BO MACR1R01 MACROS NOT ALLOWED S 42185300 +.MAC1A ANOP S 42185400 + CLI AVMFLDT1,X'00' LABEL PRESENT? 42190000 + BE MACRO101 OK IF NOT 42195000 + LA RB,$ERILLAB SET ERROR FLAG IF YES 42200000 + $CALL ERRLAB MARK STATEMENT 42205000 +MACRO101 EQU * 42210000 +MCR1PRNT EQU * 42215000 + LA RB,$OUCOMM SET PRINT FLAG 42220000 + $CALL OUTPT2 PRINT STATEMENT 42225000 + MVC AVMBYTE1(3),AWZEROS CLEAR ALL FLAGS 42230000 + L RA,AVMMACID GET PREV MACRO ID 42235000 + LA RA,1(RA) INCREMENT BY ONE 42240000 + ST RA,AVMMACID RESTORE CURRENT ID 42245000 +* 42255000 +* NEXT SECTION READS AND PROCESSES THE PROTOTYPE STATEMENT 42260000 +* 42265000 + BAL RET,MACRORD READ PROTOTYPE STMT 42270000 + LA RA,RSBSOURC SET SCAN POINTER TO ASTART 42275000 +MACPROT1 EQU * 42280000 + $CALL MACSCN SCAN SOURCE FOR FIELDS 42285000 + CLI AVMFLDT2,C'I' OPCODE = MACRO INSTRUCTION? 42300000 + BNE MACR1DUM IF ERR-BRANCH-BAD PROTOTYPE S 42305000 +* S 42305100 +* IMPROPER PROTOTYPE STMT FOUND OR PREVIOUSLY DEFINED MACRO- S 42305200 +* ERROR FLAGS SET AND UNIQUE NAME INSERTED. S 42305300 +* S 42305400 +* S 42370100 +* SCAN MACRO LIBRARY FOR MACRO NAME -- S 42370200 +* PREVIOUSLY DEFINED FLAGGED AS ERROR S 42370300 +* NOT PREVIOUSLY DEFINED ==> OK S 42370400 +* S 42370500 +MACPROT2 EQU * 42375000 + SR RE,RE ZERO RE FOR EX USE 42380000 + IC RE,AVMFLDL2 GET LENGTH OF SYMBOL 42385000 + BCTR RE,0 DECR LENGTH FOR EX INST 42390000 + MVC AVMSYMBL,AWBLANK BLANK OUT COMMON SYMBOL FIELD 42395000 + L RA,AVMFLD2 MOVE @ OPCODE TO SCAN PNTR 42400000 + EX RE,MCMVSYM MOVE SYMBOL INTO AVMSYMBL FOR SEARCH 42405000 + MVC AVMSYMLN(1),AVMFLDL2 MOVE SYMBOL LENGTH INTO COMMON AREA 42410000 + L RC,AVMACLIB GET @ OF MACRO LIBRARY 42415000 + USING MACLIB,RX SET USING FOR MACLIB ENTRY 42420000 + $CALL MACFND SEARCH MACRO LIBRARY FOR SYMBOL 42425000 + LTR RB,RB ALREADY THERE? 42430000 + BNZ MACPROT3 IF NOT, ENTER 42435000 + LR RX,RC MOVE BASE TO RX 42440000 + TM MCLBTAGS,AVMCLBDF PREVIOUSLY DEFINED? 42445000 + BNO MACPROT4 NO, JUST MARK DEFINED NOW S 42450000 + SPACE 1 S 42450500 +* EITHER INCORRECT OR DUPLICATE MACRO NAME - GET @ S 42451000 +* OF DUMMY MACLIB HAVING X'00' AS MACRO NAME (ALWAYS S 42451500 +* POINTED TO BY AVMACLIB - THIS DUMMY IS REUSED FOR ALL S 42452000 +* SUCH ERRONEOUS MACROS. ALSO FLAG ERROR. S 42452500 +MACR1DUM LA RB,$ERILMNM DUPLICATE/BAD MACRO NAME S 42453000 + L RA,AVMFLD2 GET @ OF OPCODE S 42453500 + $CALL ERRTAG CALL ERROR FLAGGING S 42454000 + L RX,AVMACLIB GET @ OF DUMMY ELEMENT S 42454250 + MVC MCLBFLG2($LMACLIB-(MCLBFLG2-MACLIB)),AWZEROS RECLEAR S 42454500 + B MACPROT4 AND PROCEED 42455000 +* S 42455100 +* MACRO NAME DEFINED AND ENTERED IN LIBRARY, SPACE ALLOCATED S 42455200 +* S 42455300 +MACPROT3 EQU * 42460000 + LR RX,RC MOVE LIB ENTRY PNTR TO RX 42465000 + LA RE,$LMACLIB GET LENGTH OF MACRO LIN ENTRY 42470000 + $ALLOCL RD,RE,MCOVRPR GET AREA FOR NEW ENTRY 42475000 + ST RD,MCLIBNXT SAVE @ OF NEW ENTRY IN PREV ENTRY 42480000 + LR RX,RD MOVE BASE TO RD 42485000 + MVC MACLIB($LMACLIB),AWZEROS ZERO NEW ENTRY 42490000 + MVC MCLBNMLN(9),AVMSYMLN MOVE NAME INTO LIBRARY 42495000 + SPACE 42500000 +* MACLIB ENTRY ESTABLISHED. &SYSECT, &SYSNDX AND &SYSLIST ARE NEXT 42505000 +* ENTERED IN PARAMETER LIST 42510000 + SPACE 42515000 +MACPROT4 EQU * 42520000 + OI MCLBTAGS,AVMCLBDF SET DEFINED FLAG 42525000 + USING MCPARENT,RY SET USING FOR PARAM ENTRY 42530000 + LA RE,(MACSVAR#+1)*$LPARENT GET SLOTS FOR SYSTEM A 42535000 + $ALLOCL RY,RE,MCOVRPR GET SPACE FOR ENTRY 42540000 + MVC MCPARNLN(MCPARNTL),MACSVAR1 MOVE &SYSECT ENTRIES J 42545000 + LA R1,AVSYSECT GET @ OF CURRENT CSECT NAME 42560000 + ST R1,MCPROPRN SAVE IN ENTRY 42565000 + ST RY,MCPARPNT SAVE POINTER IN MACLIB ENTRY 42570000 + LA RC,$LPARENT(,RY) @ OF NEXT ENTRY A 42575000 + ST RC,MCPARNXT SAVE POINTER IN PREV ENTRY 42580000 + LR RY,RC MOVE BASE TO NEW ENTRY 42585000 + MVC MCPARNLN(MCPARNTL),MACSVAR2 MOVE &SYSNDX ENTY J 42590000 + MVC MCPROPRN,AWZEROS SET POINTER TO ZERO 42605000 + LA RC,$LPARENT(,RC) @ OF NEXT ENTRY A 42610000 + ST RC,MCPARNXT SAVE POINTER IN PREV ENTRY 42615000 + LR RY,RC MOVE AASE TO NEW ENTRY 42620000 + MVC MCPARNLN(MCPARNTL),MACSVAR3 MOVE &SYSLIST ENTRY J 42625000 + SPACE 42640000 +* SYSTEM VARIABLES ENTERED IN PARAM LEST. NEXT GET LABEL IF ANY 42645000 + SPACE 42650000 + LA RC,$LPARENT(,RC) @ OF NEXT ENTRY 42655000 + ST RC,MCPARNXT SAVE LINK IN PREV ENTRY 42660000 + LR RY,RC MOVE BASE TO NEW ENTRY 42665000 + MVC MCPARENT($LPARENT),AWZEROS ZERO OUT ENTRY 42670000 + L RA,AVMFLD1 GET @ OF LABEL, IF ANY 42675000 + LTR RA,RA IS THERE A LABEL 42680000 + BZ MCPARSCN IF NOT, PROCEED WITH OPERAND SCAN 42685000 + $CALL MCVSCN ELSE SCAN LABEL FIELD 42690000 + LTR RB,RB VARIABLE SYMBOL? 42695000 + BZ MCLAB01 OKAY IF RB = 0 42700000 + LA RB,$ERINVSY ELSE FLAG INVALID SYMBOL 42705000 +MACLABER EQU * 42710000 + $CALL ERRLAB FLAG ERROR 42715000 + B MCPARSCN RESUME SCAN AFTER FLAGGING ERROR 42720000 + SPACE 42725000 +MCMVSYM MVC AVMSYMBL($),0(RA) DUMMY FOR EX INST TO MOVE SYMBOL 42730000 + SPACE 42735000 +* S 42735100 +* SCAN FOR &LABEL -- IF NOT MULTIPLY DEFINED ENTER IN S 42735200 +* PARAMETER LIST S 42735300 +* S 42735400 +MCLAB01 EQU * 42740000 + L RC,MCPARPNT GET @ OF PARAM LIST 42745000 + $CALL MACFND SCAN LIST 42750000 + LTR RB,RB NAME ALREADY PRESENT 42755000 + BNZ MCLAB02 OKAY IF NONZERO 42760000 + LA RB,$ERMULDF ELSE SET MULTIPLE DEF FLAG 42765000 + B MACLABER BRANCH AND FLAG ERROR 42770000 +MCLAB02 EQU * 42775000 + MVC MCPARNLN(9),AVMSYMLN MOVE LABEL NAME INTO ENTRY 42780000 + MVI MCPARTYP,C'P' SET ENTRY TYPE TO POSITIONAL 42785000 + SPACE 42790000 +* START SCAN OF PARAMETER OPERAND FIELD 42795000 + SPACE 42800000 +MCPARSCN CLI AVMFLDL3,X'00' OPERAND PRESENT? 42805000 + BE MACRO1RT IF NOT, FINI 42810000 + L RA,AVMFLD3 ELSE GET @ OF OPERAND IN SCAN PNTR 42815000 + SPACE 2 S 42815100 +* BEGIN LOOP TO SCAN MACRO PARAMETER LIST S 42815200 + SPACE 1 S 42815300 +MCPARST EQU * 42820000 + LR R0,RA COPY SCAN POINTER TEMPORRARILY 42825000 + $CALL MCVSCN SCAN NEXT SYMBOL 42830000 + LTR RB,RB VAR SYMBOL OK? 42835000 + BZ MCPRSC01 IF YES, PROCEED 42840000 + LA RB,$ERINVSY IF RB ^= 0, ILLEGAL S 42850000 + B MACR1TG1 FLAG STNT 42855000 + SPACE 42860000 +* HAVE LEGAL PARAMETER -- SCAN, DETERMINE TYP) AND INSERT S 42860100 +* S 42860200 +MCPRSC01 EQU * 42865000 + CLI 0(RA),C'=' KEYWORD PARAMETER? 42870000 + BE MCPRSC11 IF YES, OKAY 42875000 + TM AVMBYTE1,$MKEYOPR KEYWORD ALREADY PROCESSED? 42880000 + BO MACR1R03 ERROR IF YES 42885000 +*************** POSSIBLE CHANGE FOR ASM H OR VS *************** S 42890000 +* S 42915100 +* LEGAL PARM FOUND -- INSERT IF NOT DUPLICATE S 42915200 +* S 42915300 +MCPRSC11 EQU * 42920000 + ST RA,AVMTSCNP SAVE SCAN POINTER TEMPORARILY 42925000 + L RC,MCPARPNT GET @ OF PAR LIST 42930000 + $CALL MACFND SEARCH PARAMETER LIST 42935000 + LTR RB,RB SYMBOL ALREADY PRESENT? 42940000 + BNZ MCPRSC02 IF NOT, OKAY 42945000 + LR RA,R0 RESTORE SCAN POINTER FOR ERROR MSG 42950000 +MCPRSCMD LA RB,$ERMULDF SET MULT DEF FLAG 42955000 + B MACR1TG1 BRANCH AND FLAG STMT 42960000 +* 42965000 +* ALLOCATE SPACE FOR PARM ENTRY, CHACK TYPE AND BUMP COUNTERS S 42965100 +* S 42965200 +MCPRSC02 LA RE,$LPARENT GET LENGTH OF PAR ENTRY 42970000 + $ALLOCL R1,RE,MCOVRPR GET AREA FOR NEW ENTRY 42975000 + ST R1,MCPARNXT PUT POINTER IN PREV ENTRY 42980000 + LH R2,MCPARNDX GET CURRENT OPERAND COUNT 42985000 + LR RY,R1 MOVE BASE TO NEW ENTRY 42990000 + MVC MCPARENT($LPARENT),AWZEROS CLEAR ENTRY 42995000 + MVC MCPARNLN(9),AVMSYMLN MOVE SYMBOL INTO NIE ENTRY 43000000 + LA R1,1(R2) BUMP OPERAND COUNT BY ONE 43005000 + STH R1,MCPARNDX RESTORE NEW COUNT 43010000 + STH R1,MCPOPRNB UPDATE TOTAL NBR OF OPRNDS 43015000 + L RA,AVMTSCNP RESTORE SCAN POINTER 43020000 + CLI 0(RA),C'=' KEYWORD PARAMETER? 43025000 + MVI MCPARTYP,C'P' ELSE SET TYPE = POSITIONAL 43035000 + BNE MCPRSC06 JUMP OUT IF POSITIONAL A 43040000 + SPACE 43045000 +* KEYWORD PARM FOUND -- PROCESS ACCORDINGLY S 43045100 +* S 43045200 +MCPRSCK LA RA,1(RA) BUMP SCAN PNTR PAST '=' 43050000 + MVI MCPARTYP,C'K' IDENTIFY AS KEYWORD OPERAND 43055000 + ST RA,AVMTSCNP SAVE SCAN PNTR TEMPORARILY 43060000 + NI AVMBYTE1,X'FF'-$MSBLIST TURN OFF SUBLIST FLAG 43065000 + OI AVMBYTE1,$MKEYOPR SET KEYWORD OPRND FLAG 43070000 + $CALL MCSCOP SCAN OPERAND 43075000 + LTR RB,RB OPERAND OK? 43080000 + BNZ MACR1TG1 IF NOT, BRANCH AND FLAG 43085000 + STC RD,MCPRATYP SAVE ATTRIBUTE TYPE 43090000 + STC RC,MCPROPLN STORE LENGTH 43095000 + LH RE,MCKOPRNB GET KEYWORD COUNT 43100000 + LA RE,1(RE) BUMP KEYWORD COUNT 43105000 + STH RE,MCKOPRNB RESTORE NEW COUNT 43110000 + LTR RC,RC CHECK FOR NULL STRING 43115000 + BZ MCPRSC03 IF YES, GO TO NEXT OPERAND 43120000 + LA RE,3+1(,RC) ROUND TO FULLWORD+1 FOR DELIM AFTERJ 43130000 + SRL RE,2 SHIFT RIGHT TO TRUNCATE 2 BITS 43135000 + SLL RE,2 SHIFT LEFT TO RESTORE 43140000 + $ALLOCL RB,RE,MCOVRPR GET AREA FOR KEYWORD VALUE 43145000 + ST RB,MCPROPRN SAVE STND VALUE @ IN ENTRY 43150000 +* OMIT BCTR RC,0 : USE LENG RATHER THAN LENG-1, SO WILL J 43155000 +* PICK UP DELIMITER AFTER VALUE. HELPS MEXPND SCAN OK J 43155010 + L RE,AVMTSCNP RESTORE SCAN POINTER FOR OPRND MOVE 43160000 + EX RC,MCMVOPRN MOVE KEYWORD VALUE INTO ENTRY 43165000 +* S 43165100 +* PROCESS SUBLISTED PARAMETERS S 43165200 +* S 43165300 +MCPRSC03 EQU * 43170000 + CLI MCPRATYP,C'S' SUBLIST? 43175000 + BNE MCPRSC06 PROCEED IF NOT 43180000 + LR R0,RA COPY SCAN PNTR 43205000 + L RA,AVMTSCNP GET ORIGINAL SCAN PNTR 43210000 + LA RA,1(RA) BUMP PAST '(' 43215000 + OI AVMBYTE1,$MSBLIST SET SUBLIST FLAG 43220000 +* S 43220100 +* BEGIN LOOP TO PROCESS SUBOPERANDS S 43220200 +* S 43220300 +MCPRSC05 EQU * 43230000 + $CALL MCSCOP SCAN SUBOPRND 43235000 + LTR RB,RB OKAY? 43240000 + BNZ MACR1TG1 IF NOT, BRANCH AND FLAG 43245000 + CLI 0(RA),C')' END OF SUBLIST? 43255000 + LA RA,1(RA) BUMP PAST DELIM 43260000 + BNE MCPRSC05 RESUME SCAN IF NOT END 43265000 + LR RA,R0 ELSE RESTORE SCAN PNTR 43270000 +* S 43275000 +* DELIMETER CHECK S 43275100 +* S 43275200 +MCPRSC06 EQU * 43280000 + CLI 0(RA),C' ' END OF OPERAND? 43285000 + BE MACRO1RT BRANCH AND PRINT IF YES 43290000 + CLI 0(RA),C',' DELIM = ','? 43295000 + BE MCPRBMP OK IF YES 43300000 + LA RB,$ERINVDM ELSE SET BAD DELIM FLAG 43305000 + B MACR1TG1 BRANCH AND FLAG 43310000 +MCPRBMP EQU * 43315000 + LA RA,1(RA) BUMP SCAN POINTER 43320000 + CLI 0(RA),C' ' BLANK AFTER ','? 43325000 + BNE MCPARST RESUME SCAN IF NOT 43330000 + SPACE 1 43335000 +* POSSIBLE NON-STD CONT CARDS -- MACROS ONLY S 43340000 + CLI RSBNUM,1 ONLY 1 CARD? 43345000 + BE MCPARST RESUME SCAN IF YES 43350000 + LA RB,RSBLOCK+RSB$L+RSOL1 POINT TO 1ST BYTE, 2ND CARD 43355000 + CR RA,RB POINTING AT WHICH CARD? 43360000 + BNH MCPRCO#2 PROCESS 2ND CARD IF LOW 43365000 + CLI RSBNUM,3 TWO CONT CARDS? 43370000 + BNE MCPARST RESUME SCAN IF NOT 43375000 + LA RB,RSOLC(RB) POINT TO 1ST BYTE, 3RD CARD 43380000 + CR RA,RB WHERE IS SCAN POINTER? 43385000 + BH MCPRCO#3 CHECK FOR 4TH CARD 43390000 +MCPRCO#2 EQU * 43395000 + LR RA,RB MOVE SCAN POINTER TO CONT CARD 43400000 + B MCPARST GO BACK FOR NEXT OPRND 43405000 + SPACE 2 43410000 +MCPRCO#3 EQU * 43415000 + CLI AVMBYTE5,$ERCONTX MORE THAN THREE CARDS? 43420000 + BNE MCPARST RESUME SCAN IF NOT 43425000 + LA RB,$OUCOMM SET PRINT FLAG 43430000 + $CALL OUTPT2 PRINT STMT 43435000 + BAL RET,MACRORD GET NEXT STMT 43440000 + OI RSBFLAG,$RSBNPNN SET NO ACTION FLAG 43445000 + LA RA,RSBSOURC POINT TO START OF STMT 43450000 + CLC 0(15,RA),AWBLANK ALL BLANKS IN COL 1-15? 43455000 + BE MCPRCO#4 OKAY IF YES 43460000 + LA RB,$ERCONT ELSE SET ERROR FLAG 43465000 + $CALL ERRTAG FLAG STMT 43470000 +MCPRCO#4 EQU * 43475000 + LA RA,15(RA) BUMP SCN PNTR TO COL 16 43480000 + B MCPARST AND RESUME SCAN 43485000 +MCMVOPRN MVC 0($,RB),0(RE) DUMMY FOR EX INSTR TO MOVE OPRND S 43485100 + SPACE 2 43490000 +**--> INSUB: MACRORD MACRO READER + + + + + + + + + + + + + + +S 43490100 +*+ CALLED BY MACRO1 THREE PLACES: +S 43490150 +*+ 1ST TO READ PROTOTYPE STMT +S 43490200 +*+ 2ND TO CHECK FOR CONT CARDS (MACRO) +S 43490250 +*+ 3RD TO GET NEXT CONT CARD (NON-MACRO) +S 43490300 +*+ ENTRY CONDS: +S 43490350 +*+ RETURN POINT = RET +S 43490400 +*+ EXIT CONDS: +S 43490450 +*+ AVMBYTE5 (ERROR FLAG) SET IF MORE THAN ALLOWED +S 43490500 +*+ CONTINUATION CARDS (LIMIT = 3) +S 43490550 +*+ CALLS: INCARD TO ACTUALLY READ CARDS +S 43490600 +*+ ERRTAG FOR ERROR PROCESSING +S 43490650 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 43490700 + SPACE 2 S 43490750 +MACRORD EQU * 43495000 + ST RET,MACRDSAV SAVE RETURN @ 43500000 + $CALL INCARD READ NEXT STMT 43505000 + STC RB,AVMBYTE5 SAVE ERROR FLAG 43510000 + CLI AVMBYTE5,$ERCONTX MORE THAN THREE CARDS? 43515000 + BE MACRDRTN PROCEED IF YES 43520000 + LTR RB,RB ELSE TEST FOR OTHER ERROR 43525000 + BZ MACRDRTN RETURN IF NONE 43530000 + $CALL ERRTAG ELSE FLAG STMT 43535000 + TM AVTAGS2,$INEND2 END OF FILE ERROR? 43540000 + BO MACRO1RT RETURN IF YES 43545000 +MACRDRTN EQU * 43550000 + L RET,MACRDSAV RESTORE RETURN @ 43555000 + BR RET AND RETURN 43560000 +MACRDSAV DS F SPACE FOR RETURN @ 43565000 + SPACE 4 43595000 +* ERROR ROUTINE CALLED WHEN ERROR FOUND IN MAC DEF S 43595100 +* S 43595200 +MACR1R01 EQU * 43600000 + AIF (NOT &$MACOPC).MAC1B BRANCH IF NO OPEN CODE S 43600020 + EJECT S 43600040 +* MAIN CONTROL BLOCK FOR OPEN CODE CONDITIONAL ASSEMBLY S 43600060 +* S 43600062 +* REGISTER USAGE FOR THIS SECTION: S 43600064 +* S 43600066 +* R0 - WORK REG S 43600068 +* R1 - PTR TO CONTROL TABLE AND TRT REG S 43600070 +* R2 - PTR TO CONTROL TABLE S 43600072 +* RW - BASE FOR RSBLOCK S 43600074 +* RX - BASE FOR MACLIB S 43600076 +* RY - UNUSED (BUT --> BASE FOR MCPARENT IN MACRO1) S 43600078 +* RZ - BASE FOR MXPNTSAV AND WORK REG S 43600080 +* RA - WORK REG S 43600082 +* RB - BASE FOR MCLCLDPV AND WORK REG S 43600084 +* RC - BASE FOR OPCODTB AND WORK REG S 43600086 +* RD - UNUSED S 43600088 +* RE - UNUSED S 43600090 +* RAT - BASE FOR AVWXTABL S 43600092 +* R13 - BASE FOR THIS CSECT --> MACRO1 S 43600094 +* S 43600096 + OI AVMTAG00,AVMNOMAC FLAG => NO MORE MACROS S 43600100 + SR R1,R1 CLEAR FOR TABLE INDEX S 43600120 + IC R1,OPCHEX GET OPCODE INDEX S 43600140 + LA R1,MC1CONTB(R1) LOAD @ OF TABLE ENTRY S 43600160 + L RX,AVMACLIB GET @ OF OPEN CODE MACLIB S 43600180 +* SET UP MACLIB ENTRY AND LOCAL DICTIONARY DUMMY ENTRY, S 43600220 +* IF NOT ALREADY DONE S 43600240 + TM AVMTAG00,AVMOPMIN IS LOCAL DUMMY BUILT ? S 43600260 + BO MC1CLMCB BRANCH IF YES S 43600280 + L RD,AVMMACID INCRESE MACID A 43600285 + LA RD,1(RD) INCREASE BY ONE A 43600290 + ST RD,AVMMACID STORE IT BACK A 43600295 + MVC MACLIB+4($LMACLIB-4),AWZEROS ZERO OUT MACLIB ENTRY S 43600300 + MVC MCLBNMLN(9),MC1OPNCD ENTER NAME AND LENGTH INTO MACLIBS 43600320 +* ALLOCATE CORE FOR LOCAL DUMMY ENTRY (SEE MCBODY START) S 43600340 + LA RA,$LLCLDV+$LGLBENT GET LENGTH OF DICTS A 43600360 + USING MCLCLDPV,RB NOTE USING ON LOCAL DICT DOPE VECT S 43600370 + $ALLOCH RB,RA,MC1OVRFL GET AREA FOR ENTRY S 43600380 + ST RB,MCDDVPNT SAVE @ IN MACLIB S 43600400 + MVC 0($LLCLDV+$LGLBENT,RB),AWZEROS CLEAR ENTRY A 43600420 + MVI MCLCLTYP,$ARITH SET TYPE = ARITH FOR LENGTH S 43600440 + MVI MCLCLDIM+1,1 SET DIMENSION TO 1 S 43600460 + DROP RB S 43600470 + MVI MCLOCDLN+3,4 INIT LENGTH OF DICT TO 4 S 43600480 + OI AVMTAG00,AVMOPMIN+AVMNOMAC SET FLAGS A 43600500 + OI MCLBFLG2,$MCOCFL1 SHOW OPEN CODE A 43600510 + XSNAP LABEL='AFTER OPEN MACLIB',STORAGE=(*MACLIB,*MACLIB+100),X43600511 + IF=(AVTAGSM,O,AJOMACRH,TM) A 43600512 +MC1CLMCB EQU * S 43600520 + XSNAP LABEL='MCICLMB,R1 TABLE ENTRY' A 43600521 + TM 0(R1),$MC1DCL DECLARE TYPE OPCODE ? S 43600540 + BNO MC1ACTON NO, ACTION TYPE S 43600560 + TM AVPRINT1,AVPRSAVE LISTING CONTROL = SAVE ? S 43600580 + BO MC1NORM BRANCH IF YES S 43600600 + TM MCLBFLG2,$MCOCFL2 DECLARE TYPE ALLOWED ? S 43600620 + BO MC1NORM NO, OUT OF ORDER S 43600640 + OI AVMTAG00,AVMOPENC SET FLAG TO SHOW IN OPEN A 43600645 + LR RC,RX COPY @ MACLIB WHERE EXPECTED J 43600650 + $CALL MCBODY PROCESS STATEMENT S 43600660 + B MC1RTN0 RETURN, RB=0 S 43600680 +* ACTION TYPE MACRO OPCODE PROCESSED BELOW S 43600700 +MC1ACTON EQU * S 43600720 + XSNAP LABEL='ACTION TYPE FOUND' A 43600721 + TM 0(R1),$MC1ERR ERROR FLAG ON ? S 43600740 + BO MC1NORM BRANCH IF YES S 43600760 + OI MCLBFLG2,$MCOCFL2 DECLARE TYPES NO LONGER ALLOWED S 43600780 + TM AVMTAG00,AVMOPDIC HAS OPEN CODE LOCAL DICT BEEN S#43600800 + ALLOCATED ? S 43600820 + BO MC1SAVLO BRANCH IF YES S 43600840 +* ALLOCATE SPACE FOR OPEN CODE LOCAL DICTIONARY AND MXPNTSAV S 43600860 + L RA,MCLOCDLN GET LENGTH OF LOCAL DICT S 43600880 + LA RA,$LMXPTSV(RA) ADD LENGTH OF MXPNTSAV S 43600900 + $ALLOCH RB,RA,MC1OVRFL GET CORE FOR LOCAL DICT S 43600920 +* INITIALIZE LOCAL DICTIONARY AND MXPNTSAV TO ZEROS S 43600940 + ST RB,MC1PTSAV SAVE POINTER TO ALLOCATED CORE S 43600960 + LR R0,RA COPY OVER LENGTH FOR LATER USE J 43600970 + BCTR RA,0 DECR COUNT S 43600980 + EX RA,MC1MOVZR CLEAR LENGTH MOD 256 S 43601000 + SRA RA,8 SHIFT TO GET # 256 BYTE BLOCKS LEFTS 43601040 + BNP MC1DNZER SKIP IF NO MORE TO DO S 43601060 + N R0,AWFXFF REMOVE ALL BUT LAST BYTE OF LENGTH J 43601065 + AR RB,R0 ADD LENGTH, GET @ FIRST BYTE TO 0 J 43601070 + MVC 0(256,RB),AWZEROS CLEAR 256 BYTES AT A TIME S 43601080 + LA RB,256(,RB) INCMT TO NEXT BLOCK S 43601100 + BCT RA,*-10 LOOP, CLEAR TILL DONE S 43601120 +* SET UP MXPNTSAV AND SET ACTR LIMIT S 43601140 +MC1DNZER EQU * S 43601160 + USING MXPNTSAV,RZ BASE REG FOR MXPNTSAV S 43601180 + L RZ,MC1PTSAV BASE REG FOR MXPNTSAV S 43601200 + ST RX,MXPNMCLB STORE @ OF MACLIB ENTRY A 43601210 + LA RB,$LMXPTSV(RZ) GET ADDR OF LOCAL DICTIONARY S 43601220 + ST RB,MXPNLDBS SAVE @ IN MXPNTSAV S 43601240 + MVC 0(4,RB),AVMMACTR SET ACTR LIMIT S 43601260 + OI AVMTAG00,AVMOPDIC FLAG => DICT ALLOCATED S 43601280 +* CALL MCBODY TO CREATE ONE-OPS. IF NO ERROR ON RETURN, S 43601320 +* CALL MXINST TO INTERPRET THE ONE-OPS. OTHERWISE RETURN. S 43601340 +MC1SAVLO EQU * S 43601360 + MVC MC1LOPTR(4),AVADDLOW SAVE CURRENT LO PTR S 43601380 + LR RC,RX COPY @ MACLIB WHERE EXPECTED J 43601390 + XSNAP LABEL='BEFORE CALL MCBODY OC', X43601391 + IF=(AVTAGSM,O,AJOMACRH,TM) A 43601392 + L RD,AVADDHIH GET HIGH PTR A 43601394 + LR RE,RD COPY INTO RE A 43601396 + STM RD,RE,AVGEN1CD STORE INTO AVGEN1DC,AVGEN2DC A 43601398 + $CALL MCBODY PROCESS STATEMENT S 43601400 + L RA,MCCODLNK GET # FIRST INSTRUCTION A 43601420 + USING MCOPQUAD,RA NOTE ONE/OP PTR A 43601430 + CLI MCQS1FLG,$BSERR01 WAS IT IN ERROR A 43601440 + BNE *+8 SKIP AROUND RESET IF O.K. A 43601460 + LA R1,=AL1($MC1SKIP,$MC1RET) FAKE NO MORE ACTION A 43601462 + NI AVMTAG00,255-AVMOPGO TURN OFF AIF/AGO FLAG (AVMOPGO) S 43601480 + TM 0(R1),$MC1SKIP IS SKIP BIT ON ? (SKIP MXINST) S 43601500 + BO MC1RSTLO IF YES, SKIP CALL TO MXINST S 43601520 + L RC,MC1PTSAV LOAD @ OF MXPNTSAV S 43601540 + USING MXPNTSAV,RC SET UP ANOTHER USING Z 43601545 + MVC MXPNCRCD(4),MCCODLNK LOAD @ OF UST INSTR A 43601560 + DROP RZ,RC,RA A 43601570 + XSNAP LABEL='BEFORE CALL TO MXINST' A 43601571 + XCALL MXINST CALL TO INTERPRET ONE-OPS S 43601580 + L RD,AVGEN1CD A 43601582 + L RE,AVADDHIH A 43601584 + XSNAP LABEL='AFTER MXINST',STORAGE=(*0(RD),*4(RD),*0(RE),*4(REX43601586 + )) A 43601587 +* WIPE OUT ONE-OPS AND RETURN IF DONE S 43601600 +MC1RSTLO EQU * S 43601620 + MVC AVADDLOW(4),MC1LOPTR RESTORE AVADDLOW S 43601640 +* IF ORIGINAL STATEMENT NOT ALREADY PRINTED, GET IT A 43601643 +* BACK FROM HIGH AREA AND SAVE IT VIA UTPUT1 A 43601645 + TM AVPRINT1,AVPRSAVE ALREADY IN SAVE MODE A 43601647 + BZ MC1ALPRT NO, SO PRINTED STMT ALREADY A 43601650 + $CALL INCARD GET STMT BACK A 43601653 + OI RSBFLAG,$RSBNP## SHOW NO MORE PROCESSING A 43601655 + $CALL UTPUT1 HAVE IT SAVED A 43601657 +MC1ALPRT TM 0(R1),$MC1RET IS RETURN BIT ON ? S 43601660 + BO MC1RTN0 BRANCH IF YES S 43601680 +* PROCESS AIF, AGO AND ANYTHING ELSE NEEDING ACTION S 43601700 + SR R2,R2 CLEAR R2 FOR INDEX S 43601720 + IC R2,1(R1) LOAD JUMP CODE FROM CONTROL TABLE S 43601740 + B *+4(R2) BRANCH ON INDEX S 43601760 + B MC1AGO BRANCH TO PROCESS AGO S 43601780 + TM AVMTAG00,AVMOPGO WAS AIF SUCCESSFUL ? S 43601800 + BNO MC1RTN0 NOT SUCCESSFUL SO RETURN S 43601820 +* AGO OR SUCCESSFUL AIF -- CHECK FOR ILLEGAL BACKWARD REFERENCES 43601840 +MC1AGO EQU * S 43601860 + LA RA,AVMSYMBL LOAD @ OF SEQ SYMBOL S 43601880 + SR RB,RB CLEAR RB FOR LENGTH-1 IF SYMBOL S 43601920 + IC RB,AVMSYMLN LOAD LENGTH-1 S 43601940 + STC RB,MC1CLC1+1 STORE LENGTH IN CLC INSTR S 43601960 + LA RB,1(RB) ADD 1 TO GET LENGTH S 43601980 + LR RZ,RB COPY LENGTH FOR LATER S 43602000 + $CALL SYFIND LOOK UP SEQ SYMBOL S 43602020 + B *+4(RB) BRANCH ON RETURNED INDEX S 43602040 + B MC1SEQDF BRANCH IF PREVIOUSLY DEFINED S 43602060 +* SEQ SYMBOL NOT PREVIOUSLY DEFINED --> S 43602080 +* READ CARDS UNTIL SEQ SYMBOL OR END-OF-FILE FOUND S 43602100 +MC1READ EQU * S 43602120 + $CALL INCARD READ NEXT SOURCE CARD S 43602140 + TM AVTAGS2,$INEND2 END-OF-FILE ? S 43602160 + BO MC1EOF BRANCH IF YES S 43602180 + CLI RSBLOPC,C'.' IS THIS A SEQ SYMBOL? S 43602220 + BNE MC1READ IF NOT, READ NEXT CARD S 43602240 + LA RA,RSBSOURC @ 1ST BYTE OF CARD S 43602260 + $SETRT (' ',4) STOP TRT ON BLANK S 43602280 + TRT 1(8,RA),AWTZTAB SCAN FOR BLANK S 43602300 + $SETRT (' ',0) REZERO TABLE S 43602320 + BZ MC1READ INVALID SEQ SYM -- IGNORE S 43602340 + LR RB,R1 @ OF BLANK S 43602360 + SR RB,RA GET LENGTH S 43602380 + CR RB,RZ IS IT = ONE WE WANT ? S 43602400 + BNE MC1AGOSY NO, BUT SHOW DEFINED S 43602420 +MC1CLC1 CLC AVMSYMBL($),0(RA) COMPARE SYMBOLS S 43602440 + BE MC1RTN4 SEQ SYM FOUND -- RETURN S 43602460 +MC1AGOSY $CALL SYENT1 ENTER SEQ SYM IN TABLE S 43602480 +* IF WANTED, COULD SEE IF PREVIOUSLY DEFINED - WE IGNORE IT S 43602500 + B MC1READ GO FOR NEXT CARD S 43602520 +* SEQUENCE SYMBOL PREVIOUSLY DEFINED --> S 43602540 +* (AS242 -- BACKWARDS AIF/AGO IN OPEN CODE) S 43602560 +MC1SEQDF EQU * S 43602580 + MVC AVRSBLOC(MC1MSEQU),MC1MSSG MOVE ERROR MSG INTO S#43602600 + RSBLOCK (AS242) S 43602620 + B MC1RTN4 RETURN A 43602640 +* END-OF-FILE ENCOUNTERED BEFORE SEQ SYMBOL FOUND --> S 43602660 +* (AS241 - SEQUENCE SYMBOL NOT FOUND) S 43602680 +MC1EOF EQU * S 43602700 + MVC AVRSBLOC(MC1MSEQ2),MC1MSSG2 MOVE ERROR MSG INTO RSB S 43602720 +* RETURN SHOWING NEXT SOURCE ALREADY IN RSBLOCK S 43602740 +MC1RTN4 EQU * S 43602760 + LA RB,4 SET RETURN CODE S 43602780 + B MACRO1FN RETURN S 43602800 +* RETURN SHOWING NEXT SOURCE NOT IN RSBLOCK S 43602880 +MC1RTN0 EQU * S 43602900 + SR RB,RB CLEAR FLAG REGISTER S 43602920 + B MACRO1FN BRANCH TO RETURN S 43602940 +* S 43602960 +* OVERFLOW EXIT -- HALT ASSEMBLY S 43602980 +* S 43603000 +MC1OVRFL EQU * S 43603020 + OI AVTAGS2,AJOASTOP STOP 2ND PASS PROCESSING S 43603040 + $CALL MOSTOP GO TO MOSTOP TO QUIT S 43603060 +* S 43603080 +* MACRO1 DC/DS/DUMMYS FOR OPEN CODE S 43603100 +MC1MOVZR MVC 0($,RB),AWZEROS DUMMY INSTR S 43603120 +MC1LOPTR DC F'0' WORD TO SAVE CURRENT AVADDLOW S 43603140 +MC1PTSAV DC F'0' WORD TO SAVE PTR TO MXPNTSAV S 43603160 +MC1MSSG DC AL1(MC1MSEQU,$RSBNPNN+$RSBMERR,1,0) A 43603180 + DC C'242 BACKWARDS AIF/AGO ILLEGAL' S 43603200 +MC1MSEQU EQU *-MC1MSSG S 43603220 +MC1MSSG2 DC AL1(MC1MSEQ2,$RSBNPNN+$RSBMERR,1,0) A 43603240 + DC C'241 SEQUENCE SYMBOL NOT FOUND' S 43603260 +MC1MSEQ2 EQU *-MC1MSSG2 S 43603280 +MC1OPNCD DC X'08',CL8'OPEN-CDE' S 43603300 + EJECT S 43603320 +* MACRO1 CONTROL TABLE FOR OPEN CODE CONDITIONAL ASSEMBLY S 43603340 +* S 43603360 +* THE FIRST BYTE CONTAINS FLAG BITS; S 43603380 +* BYTE 2 CONTAINS JUMP CODES S 43603400 + SPACE 2 S 43603420 +MC1CONTB EQU * S 43603440 + DC AL1($MC1RET,0) NON-MACRO STMT S 43603460 + DC AL1($MC1ERR,0) MACRO S 43603480 + DC AL1($MC1DCL,0) GBLA S 43603500 + DC AL1($MC1DCL,0) GBLB S 43603520 + DC AL1($MC1DCL,0) GBLC S 43603540 + DC AL1($MC1DCL,0) LCLA S 43603560 + DC AL1($MC1DCL,0) LCLB S 43603580 + DC AL1($MC1DCL,0) LCLC S 43603600 + DC AL1($MC1RET,0) ACTR S 43603620 + DC AL1($MC1RET,0) SETA S 43603640 + DC AL1($MC1RET,0) SETB S 43603660 + DC AL1($MC1RET,0) SETC S 43603680 + DC AL1(0,4) AIF S 43603700 + DC AL1($MC1SKIP,0) AGO S 43603720 + DC AL1($MC1SKIP+$MC1RET,0) ANOP S 43603740 + DC AL1($MC1RET,0) MNOTE S 43603760 + DC AL1($MC1ERR,0) MEXIT S 43603780 + DC AL1($MC1ERR,0) MEND S 43603800 + DS 0H ALIGN IF NECESSARY S 43603820 + EJECT S 43603840 +MC1NORM EQU * S 43603860 +.MAC1B ANOP S 43603880 + L RA,AVMFLD2 GET @ OF OPCODE S 43605000 +MACR1LAB LA RB,$ERSTMNA SET CODE / USE WHATEVER @ IN RA S 43610000 +MACR1TAG $CALL ERRTAG SET FLAG 43615000 + LA RB,8 SET PROPER RETURN CODE 43620000 + B MACRO1FN 43625000 +* ERROR ROUTINE CALLED WHEN POSITIONAL PARAM FOUND AFTER S 43680100 +* KEYWORD PARAM S 43680200 +*************** POSSIBLE CHANGES WITH ASM H OR VS *************** S 43680300 +* S 43680400 +MACR1R03 EQU * 43685000 + LA RB,$ERVSYNT SE T SYNTAX ERROR FLAG 43690000 + B MACR1TG1 FLAG STMT 43695000 +MCOVRPR L RE,AVMOVRFL GET @ OF OVERFLOW ROUTINE 43730000 + BR RE BRANCH THERE 43735000 + SPACE 4 43740000 +* GENERAL ROUTINE TO FLAG INCORRECT PARAM FIELDS S 43740100 +* S 43740200 +MACR1TG1 EQU * 43745000 + $CALL ERRTAG FLAG STMT 43750000 + SPACE 2 43755000 +* CHECK FOR END OF PROTOTYPE AND CALL ROUTINE TO PROCESS S 43755100 +* BODY OF MACRO (MCBODY) S 43755200 +* S 43755300 +MACRO1RT EQU * 43760000 + LA RB,$OUCOMM 43765000 + $CALL OUTPT2 43770000 + CLI AVMBYTE5,$ERCONTX MORE THAN THREE CARDS? 43775000 + BNE MACRO1RU PROCEED IF NOT 43780000 + BAL RET,MACRORD ELSE GET NEXT STMT 43785000 + OI RSBFLAG,$RSBNPNN SET NO ACTION FLAG 43790000 + B MACRO1RT AND PRINT LINES 43795000 +MACRO1RU EQU * 43800000 + LR RC,RX 43805000 + SR RB,RB 43810000 + TM AVTAGS2,$INEND2 END OF FILE? 43815000 + BO MACRO1FN RETURN IF YES 43820000 + $CALL MCBODY PROCESS BODY OF DEFINIETION 43825000 +MACRO1FN EQU * 43830000 + AIF (&$DEBUG).MACROFN SKIP OVER DEBUG CODE IF NOT NEEDED J 43833000 + L R1,AVMBSPIE 43835000 + $SPIE ,,ACTION=(RS,(1)) TURN OFF SPIE 43840000 + L R1,AVADDLOW GET @ OF START OF DYNAMIC AREA 43850000 + XSNAP LABEL='DYNAMIC AREA',STORAGE=(*0(RX),*0(R1),*AVADDLOW,*AX43855000 + VWXEND),IF=(AVMSNBY1,O,$MSNP02,TM) 43860000 +.MACROFN ANOP 43865000 + $RETURN RGS=(R14-R6) 43870000 + AIF (&$DEBUG).MACQQ01 SKIP IF NO DEBUG 43875000 + USING MCBSPIEP,R15 43880000 +MCBSPIEP EQU * 43885000 + L RC,AVMACLIB GET PONTR TO LOW ENDOF LOW CORE 43890000 + L RD,AVADDLOW GET HIGH END OFLOW CORE 43895000 + XSNAP LABEL='*** INTERRUPT IN MACRO DEFINITION PHASE ***', #43900000 + STORAGE=(*0(R1),*16(R1),*0(RC),*0(RD),*AVADDLOW,*AVWXEND#43905000 + ) 43910000 + DC H'1' FORCE INTERRUPT 43915000 + DROP R15 43920000 +.MACQQ01 ANOP 43925000 + DROP RAT,RW,RX,RY,R13 A 43930000 + LTORG 43935000 +MACSVAR# EQU 3 ACTUAL # SYSTEM VARIABLES J 43937000 +* SYSTEM VARIABLES - VALUES FOR MCPAR- NLN,NAM,TYP. J 43937050 +MACSVAR1 DC AL1(7),CL8'&&SYSECT ',C'S' J 43937100 +MACSVAR2 DC AL1(7),CL8'&&SYSNDX ',C'S' J 43937200 +MACSVAR3 DC AL1(8),CL8'&&SYSLIST',C'S' J 43937300 + TITLE '*** MACSCN - MACRO STATEMENT SCAN ***' 43940000 +**--> CSECT: MACSCN SCANS MACRO INSTRUCTION STATEMENT. IDENTIFIES * 43945000 +*. LABEL, OPCODE, OPERAND AND COMMENT (IF ANY) FIELDS. * 43950000 +*. LOCATION OF EACH FIELD STORED IN AVMFLD_. LENGTH OF EACH * 43955000 +*. FIELD STORED IN AVMFLDL_. TYPE OF EACH FIELD PLACED IN * 43960000 +*. AVMFLDT_. FIELDS ARE SET TO ZERO IF NOT PRESENT. * 43965000 +*. AVMFLDT1 CONTAINS '&' IF VARIABLE SYMBOL AND '.' IF SEQUENCE* 43970000 +*. SYMBOL ELSE ZERO. AVMFLDT2 CONTAINS 'I' IF OPCODE IS * 43975000 +*. SUSPECTED MACRO INSTRUCTION, 'M' IF MACRO OPCODE (AIF, * 43980000 +*. AGO, SETA, ETC), 'O' IF OPCODE IS REGULAR ASSEMBLER OR * 43985000 +*. MACHINE INSTRUCION AND X'00' IF ANYTHING ELSE. * 43990000 +*. SCANS NON STND CONTINUATION FILDS AND PLACES VALUES IN * 43995000 +*. AVMFLD5 THRU AVMFLD8 * 44000000 +*. * 44005000 +*. ENTRY CONDITIONS * 44010000 +*. RA = @ OF FIRST CAHARACTER OF STATEMENT * 44015000 +*. EXIT CONDITIONS * 44020000 +*. RA = SAME AS ENTRY CONDITIONS * 44025000 +*. RB = 4 IF COMMENT STATEMENT, 8 IF MACRO COMMENT, ELSE ZERO * 44030000 +*. RC = @ OF OPCODTB ENTRY IF OPCODE = M OR O * 44035000 +*. * 44040000 +*. USES MACROS: $CALL, $SAVE, $RETURN, $SETRT * 44045000 +*. USES DSECTS: AVWXTABL, OPCODTB * 44050000 +*. CALLS ERRTAG,MCATRM,OPFIND S 44055000 +*. NAMES: MAC----- OR MC------ S 44060000 +*. BASE REGS: R13,RAT,RX,RC S* 44060200 +*. WORK REGS: R1,R2,RA,RB,RW,RZ S* 44060300 +*.********************************************************************* 44065000 + SPACE 2 44070000 +* * * * * REGISTER USAGE IN MACSCN * * * * * * * * * * * * * * * * * S 44070100 +* R0 = SAVE REGISTER FOR RETURN @ IN MACSCSTR *2ND MINIMAL USED* J* 44070200 +* R1 = TRT USAGE; ADDRESS REGISTER (HI-ORDER BYTE = 0). J* 44070300 +* R2 = BYTE REGISTER (HI-ORDER 3 BYTES = 0); TRT USAGE. J* 44070400 +* RW = PARENTHESES LEVEL COUNT IN SECTION MACSCSTR J* 44070500 +* RX = @ RSBLOCK BEGIN SCANNED J* 44070600 +* RY = 1 FOR SCANNING USAGE (BXH, ETC) J* 44070700 +* RZ = SAVE REG FOR OPCODTB PTR * MINIMAL-USED REGISTER J* 44070800 +* RA = SCAN POINTER J* 44070900 +* RB = RETURN CODE USAGE J* 44071000 +* RC,RD,RE = PARAMETER REGISTERS FOR EXTERNAL ROUTINES. J* 44071100 +* R13 = SAVE AREA PTR; BASE REGISTER J* 44071200 +* R13= BASE REGISTER, SAVE AREA PTR. J* 44071300 +* RET,REP= USUAL LINKAGE, INCLUDING INTERNAL LINKAGE J* 44071400 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * S 44071500 + EJECT S 44071600 +MACSCN CSECT 44075000 + $SAVE RGS=(R14-R6),SA=*,BR=13 44080000 + USING AVWXTABL,RAT SET MAIN CONTROL TABLE USING 44085000 + XSNAP LABEL='***MACSCN ENTERED***',IF=(AVMSNBY1,O,$MSNP03,TM) 44090000 + MVC AVMFLD1($LAVMFLD),AWZEROS CLEAR FIELD POINTERS 44095000 + SR RB,RB 44100000 + LM R1,R2,AWZEROS CLEAR R1 AND R2 FOR TRT INST 44105000 + ST RA,AVMTSCNP SAVE SCAN POINTER TEMPORARILY 44110000 +* 44115000 + LA RY,1 SET UP USEFUL VALUE FOR SCANNING J 44118600 +* CHECK FOR PRESENCE OF COMMENT STATEMENT 44120000 +* 44125000 + CLI 0(RA),C'*' REGULAR COMMENT? 44130000 + BNE MCMNT01 IF NOT, JUMP 44135000 + LA RB,4 ELSE SET COMMENT STMNT FLAG 44140000 + B MCSCNRT AND RETURN 44145000 +MCMNT01 CLC 0(2,RA),=C'.*' MACRO COMMENT? 44150000 + BNE MACLABSC IF NOT, JUMP AND START SCAN 44155000 + LA RB,8 ELSE SET MACRO COMMENT FLAG 44160000 + B MCSCNRT AND RETURN 44165000 +* 44170000 +* SET UP TRT TABLE TO SCAN FOR DELIMITERS 44175000 +* 44180000 +MACLABSC $SETRT (' ',4,'(',8,')',12,'''',16) 44185000 + SPACE 2 44190000 +* START SCAN FOR LABEL -- DETERMINE TYPE (VAR,SEQ OR NORMAL) S 44195000 +* AND PROCESS ACCORDINGLY S 44195100 +* S 44195200 + CLI 0(RA),C' ' LABEL PRESENT? 44200000 + BE MACOPCSC IF BLANK, JUMP AND SCAN OPCODE 44205000 + ST RA,AVMFLD1 ELSE SAVE LABEL @ 44210000 + CLI 0(RA),C'&&' VAR SYMBOL? 44215000 + BE MACSCN02 IF YES, SCAN REST OF SYMBOL 44220000 + CLI 0(RA),C'.' SEQ SYMBOL? 44225000 + BE MACSCN02 IF YES, JUMP AND SCAN REST OF SYMBOL 44230000 + SPACE 2 44235000 +MACSCN01 BAL RET,MACSCSTR BRANCH AND SCAN STRING 44240000 + B MACSCN03 44245000 + SPACE 2 44250000 +* SCAN VAR OR SEQ SYMBOL -- SETS AVMFLDT1 TO PROPER TYPE S 44250100 +* S 44250200 +MACSCN02 CLI 1(RA),C'0' FIRST CHAR IS A LETTER? 44255000 + BNL MACSCN01 NOT ORD. SYMBOL IF NOT 44260000 + TRT 1(8,RA),AWTSYMT SCAN SYMBOL 44265000 + BZ MACSCN01 NOT SYMBOL, 9+ CHARS, RESUME SCAN 44270000 + CLI 0(R1),C' ' DELIM = BLANK? 44275000 + BNE MACSCN01 NO SYMBOL IF NOT 44280000 + MVC AVMFLDT1(1),0(RA) SAVE TYPE 44285000 + LR RA,R1 UPDATE SCAN POINTER 44290000 + SPACE 2 44295000 +* COMPUTE AND STORE CHARACTER LENGTH S 44295100 +* S 44295200 +MACSCN03 S RA,AVMFLD1 GET LENGTH OF FIELD 44300000 + STC RA,AVMFLDL1 SAVE LENGTH 44305000 + A RA,AVMFLD1 RESTORE SCAN POINTER 44310000 +* 44315000 +* SCAN FOR START OF OPCODE 44320000 +* 44325000 +MACOPCSC BAL RET,MACSCBLN SCAN FOR NON BLANK 44330000 + ST RA,AVMFLD2 SAVE @ OF OPCODE 44335000 + USING OPCODTB,RC ESTAB BASE FOR OPCODE ENTRY 44340000 + $CALL OPFIND LEGAL OPCODE? 44345000 + LTR RB,RB YES IF RB = 0 44350000 + BNZ MACSCN04 IF NOT TREAT AS STRING 44355000 + LR RZ,RC COPY OPCODTB @ TEMPORARILY 44360000 + IC R2,OPCTYPE GET TYPE J 44365000 + SRL R2,6 REMOVE ALL BUT 1ST 2 BITS J 44370000 + IC R2,MACSTAB1(R2) GET TYPE: 'O' OR 'M' OF OPCODE J 44375000 + STC R2,AVMFLDT2 SAVE THE TYPE VALUE FOR LATER USE J 44380000 + B MACSCN06 44385000 +MACSTAB1 DC AL1(C'O',C'O',C'M',C'O') OPCODE TYPE TABLES J 44386000 + ORG *+0*($IA+$IS+$IM+$IB) REFER TO TYPES FOR XREF J 44387000 + SPACE 2 44390000 +MACSCN04 CLI 0(RA),C'0' FIRST CHAR < 0? 44425000 + BNL MACSCN07 NO SYMBOL IF NOT 44430000 + TRT 0(9,RA),AWTSYMT SCAN SYMBOL 44435000 + BZ MACSCN07 9+ CHARS IF ZERO 44440000 + CLI 0(R1),C' ' DELIM = BLANK? 44445000 + BNE MACSCN07 NO SYMBOL IF NOT 44450000 + MVI AVMFLDT2,C'I' SET MACRO INSTRUCTION FLAG 44455000 + LR RA,R1 MOVE SCAN POINTER 44460000 + B MACSCN06 BRANCH TO GET LENGTH 44465000 + SPACE 2 44470000 +MACSCN07 BAL RET,MACSCSTR SCAN OPCODE STRING 44475000 +MACSCN06 S RA,AVMFLD2 GET LENGTH OF OPCODE 44480000 + STC RA,AVMFLDL2 SAVE LENGTH 44485000 + A RA,AVMFLD2 RESTORE SCAN POINTER 44490000 +* 44495000 +* NEXT SECTION FINDS AND SCANS OPERAND FIELD 44500000 +* 44505000 + L RX,AVRSBPT POINT TO RSBLOCK 44510000 + USING RSBLOCK,RX SET USING ON RSBLOCK 44515000 + BAL RET,MACSCOPR SCAN OPRND FIELD 44520000 + MVC AVMFLD3(5),MACSCNFD MOVE DATA TO FIELD PNTRS 44525000 + BAL RET,MACSCHEK CHECK FOR NON STND CONT CARD 44530000 + BAL RET,MACSCMMT SCAN COMMENT FIELD 44535000 + MVC AVMFLD4(5),MACSCNFD MOVE DATE TO FIELD PNTRS 44540000 + BAL RET,MACSCOPR SCAN NEXT OPRND(IF PRESENT) 44545000 + MVC AVMFLD5(5),MACSCNFD MOVE DATA TO FIELD PNTRS 44550000 + BAL RET,MACSCHEK CHECK FOR 1 MORE NON STND CARD 44555000 + BAL RET,MACSCMMT SCAN COMMENT 44560000 + MVC AVMFLD6(5),MACSCNFD MOVE DATA TO FIELD PNTRS 44565000 + BAL RET,MACSCOPR SCAN 3RD OPRND(IF ANY) 44570000 + MVC AVMFLD7(5),MACSCNFD MOVE DATA TO FIELD PNTRS 44575000 + L RB,AVSOLAST SET EOR @ FOR LAST COMMENT 44580000 + BCTR RB,0 DECR FOR TRUE LENGTH 44585000 + BAL RET,MACSCMMT SCAN COMMENT 44590000 + MVC AVMFLD8(5),MACSCNFD MOVE DATA TO FIELD PNTRS 44595000 + B MCSCNFT AND FINI 44600000 + SPACE 2 44605000 +**--> INSUB: MACSCOPR FIND AND SCAN OPERAND + + + + + + + + + ++S 44605100 +*+ THIS ROUTINE FINDS, SCANS, GETS ADDR AND LENGTH OF THE +S 44605150 +*+ OPERAND FIELD +S 44605200 +*+ +S 44605250 +*+ EXIT CONDS: ADDR & LENGTH ARE PLACED IN APPROPRIATE +S 44605350 +*+ PLACES IN TABLE. +S 44605400 +*+ +S 44605450 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 44605500 + SPACE 2 S 44610000 +MACSCOPR EQU * 44615000 + ST RET,MACSCSAV SAVE RETURN @ 44620000 + BAL RET,MACSCBLN SCAN FOR NONBLANK 44625000 + ST RA,MACSCNFD SAVE @ OF OPRND 44630000 + BAL RET,MACSCSTR SCAN OPRND 44635000 + S RA,MACSCNFD SUBTRACT START @ 44640000 + STC RA,MACSCNFL SAVE LENGTH 44645000 + A RA,MACSCNFD RESTORE POINTER 44650000 + L RET,MACSCSAV RESTORE RETURN @ 44655000 + BR RET AND RETURN 44660000 + SPACE 2 44665000 +**--> INSUB: MACSCMMT SCAN COMMENT FIELD + + + + + + + + + + + +S 44670000 +*+ THIS ROUTINE SCANS FOR NON-BLANK, CHECKS FOR CARD +S 44670100 +*+ OVERRUN. IF OK, SAVES @ AND LENGTH OF FIELD. +S 44670200 +*+ +S 44670300 +*+ EXIT CONDS: ADDR & LENGTH ARE PLACED IN APPROPRIATE +S 44670400 +*+ PLACES IN TABLE. +S 44670500 +*+ +S 44670600 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 44670700 + SPACE 2 S 44670800 +MACSCMMT EQU * 44675000 + ST RET,MACSCSAV SAVE RETURN @ 44680000 + MVC MACSCNFD(6),AWZEROS ZERO POINTER STORAGE 44685000 + BAL RET,MACSCBLN SCAN FOR NON BLANK 44690000 + CR RA,RB COMPARE WITH END OF RECORD 44695000 + BNL MACSCMRT RETURN IF IN NEXT CARD IMAGE 44700000 + ST RA,MACSCNFD ELSE SAVE @ 44705000 + SR RB,RA GET LENGTH 44710000 + STC RB,MACSCNFL SAVE LENGTH 44715000 + AR RA,RB BUMP SCN PNTR TO BLNK BEYOND CMMT 44720000 +MACSCMRT EQU * 44725000 + L RET,MACSCSAV GERT RETRUN @ 44730000 + BR RET AND RETURN 44735000 +MACSCSAV DS F STORAGE FOR RETURN @ 44740000 +MACSCNFD DS F TEMP STRORAE FOR LOCATION PNTR 44745000 +MACSCNFL DS C TEMP STROAGE FOR FIELD LENGTH 44750000 +MACSCNTY DS C TEMP STRGE FOR FIELD TYPE 44755000 + SPACE 2 44760000 +**--> INSUB: MACSCHEK CHECK FOR NON-STD COND CARD + + + + + + +S 44765000 +*+ CHECKS FOR MACRO PROTOTYPE CONTINUATION CARDS (UP TO 3) +S 44765100 +*+ +S 44765200 +*+ EXIT CONDS: RB = PTR SET TO: +S 44765300 +*+ 1. LAST CHAR ON ORIGINAL CARD (NOT CONTINUATION) +S 44765400 +*+ 2. 1ST BYTE ON 2ND OR 3RD CARD (NON-STD CONT) +S 44765500 +*+ +S 44765600 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 44765700 + SPACE 2 S 44765800 +MACSCHEK EQU * 44770000 + L RB,AVSOLAST GET EOR @ 44775000 + BCTR RB,0 DECR TO BLANK PAST LAST CHAR 44780000 + BCTR RA,0 DECR SCAN POINTER 44785000 + CLI 0(RA),C',' STOP ON ','? 44790000 + LA RA,1(RA) RESTORE SCAN POINTER 44795000 + BCR NE,RET NOT NON-STND IF NO COMMA 44800000 + CLI AVMFLDT2,C'I' POSSIBLE MACRO CALL? 44805000 + BCR NE,RET ALSO RETURN IF NOT 44810000 + LA RB,RSBLOCK+RSB$L+RSOL1 POINT TO 1ST BYTE, 2ND CARD 44815000 + CR RA,RB COMPARE WITH SCAN POINTER 44820000 + BCR NH,RET RETURN IF NOT HIGH 44825000 + LA RB,RSOLC(RB) ELSE BYMP RB TO 3RD CARD 44830000 + CR RA,RB COMPARE SCAN PONTR AGAIN 44835000 + BCR NH,RET RETURN IF NOT HIGH 44840000 + L RB,AVSOLAST ELSE LOAD EOR @ 44845000 + BCTR RB,RET DECREM TO 1ST BLANK, BRANCH ALWAYS J 44850000 + DROP RX 44860000 + SPACE 2 44865000 +**--> INSUB: MACSCBLN SCAN FOR NON-BLANK CHAR + + + + + + + + +S 44865100 +*+ SCANS FOR NON-BLANK CHAR WITHOUT CARD OVERRUN +S 44865200 +*+ +S 44865300 +*+ ENTRY COND: RA = @ WHERE SCAN TO BEGIN +S 44865400 +*+ EXIT COND: RA = @ OF 1ST NON-BLANK OR +S 44865500 +*+ @ OF END OF RECORD +S 44865600 +*+ +S 44865700 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 44865800 + SPACE 2 S 44865900 +MACSCBLN EQU * SCAN FOR NON-BLANK S 44870000 +MACBLN01 CLI 0(RA),C' ' BLANK? 44875000 + BNE MACBLN02 IF NOT, NON BLANK FOUND 44880000 + BXH RA,RY,MACBLN01 ELSE TRY AGAIN J 44885000 +MACBLN02 C RA,AVSOLAST END OF RECORD? 44890000 + BNL MCSCNFT IF YES, SCAN FINI, RETURN 44895000 + BR RET ELSE RESUME STMNT SCAN 44900000 + EJECT S 44905000 +**--> INSUB: MACSCSTR SCAN ARBITRARY STRING + + + + + + + + + +S 44910000 +*+ THIS SECTION IS A ROUTINE TO SCAN AN ARBITRARY +S 44915000 +*+ STRING AND RETURN THE LENGTH. SCAN PTR IS LEFT +S 44915100 +*+ AT BLANK FOLLOWING STRING. +S 44915200 +*+ +S 44915300 +*+ ENTRY COND: RA = @ OF BEGINNING OF STRING +S 44915400 +*+ +S 44915500 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 44915600 + SPACE 2 S 44920000 +MACSCSTR EQU * 44925000 + LR R0,RET COPYRETURN @ 44930000 + SR RW,RW CLEAR RW FOR PAREN COUNT 44935000 + NI AVMBYTE1,X'FF'-$MINQUOT CLEAR QUOTE FLAG 44945000 + SPACE 2 44950000 +MACSTRT EQU * 44955000 + TRT 0(200,RA),AWTZTAB SCAN STRING 44960000 + B *(R2) BRANCH INTO TABLE FOR ROUTINE 44965000 + B MCSCBLNK 44970000 + B MCSCLPAR 44975000 + B MCSCRPAR 44980000 + B MCSCQUOT 44985000 + SPACE 2 44990000 +MCSCBLNK TM AVMBYTE1,$MINQUOT INSIDE QUOTE? 44995000 + BO MCSCBLOK IF YES, PROCEED 45000000 + LTR RW,RW INSIDE PARENS? 45005000 + BP MCSCBLOK IF YES, PROCEED 45010000 + LR RA,R1 ELSE UPDATE SCAN POINTER 45015000 + LR RET,R0 RESTORE RETURN @ 45020000 + BR RET AND RETURN TO STMNT SCAN 45025000 + SPACE 2 45040000 +MCSCLPAR AR RW,RY = LA RW,1(RW) BUMP PAREN COUNTER J 45045000 + B MCSCBLOK GO TO BUMP SCAN PTR & CONTINUE S 45050000 + SPACE 2 45060000 +MCSCRPAR EQU * 45065000 + BCTR RW,0 45070000 +MCSCBLOK LA RA,1(,R1) BUMP SCAN PTR TO NEXT CHAR S 45075000 + B MACSTRT RESUME SCAN 45080000 + SPACE 2 45085000 +MCSCQUOT C R1,AVSOLAST END OF RECORD? 45090000 + BNL MCSCQU01 BRANCH AND PROCESS ERROR IF YES 45095000 + CLI 1(R1),C'''' TWO QUOTES? 45100000 + BE MCSCQTWO IF YES, JUMP AND PROCEED 45105000 + LR RA,R1 MOVE SCAN POINTER 45110000 + TM AVMBYTE1,$MINQUOT ARE WE IN SIDE QUOTED STRING? 45115000 + BO MCSCQTRT IF YES, DON'T LOOK FOR ATTRIBUTE 45120000 + BCTR RA,0 DEC POINTER FOR ATTERM 45125000 + TRT 0(1,RA),AWTSYMT IS PREV CHAR ALPHA? 45130000 + BNZ MCSCNOAT IF NOT CAN'T BE ATTRIBUTE 45135000 + $CALL MCATRM IS IT AN ATTRIBUTE? 45140000 + LTR RB,RB ATTRIBUTE IF RB=0 45145000 + BZ MACSTRT IF YES THEN RESUME SCAN 45150000 + BP MCSCQTWO IF ATTRIB NOT IMPLEMENTED RESUME SCA 45155000 +MCSCNOAT AR RA,RY = LA RA,1(RA) RESTORE POINTER J 45160000 + TM AVMBYTE1,$MINQUOT ARE WE INSIDE QUOTES? 45165000 + BO MCSCQTRT IF YES RESET TRT TABLE 45170000 + $SETRT ('(',0,')',0,' ',0) ELSE TURN OFF TRT FOR QUOTE STRNG 45175000 + B MCSCQUFT 45180000 +MCSCQTRT $SETRT (' ',4,'(',8,')',12) RESET TRT FOR END OF QUOTE STRNG 45185000 +MCSCQUFT XI AVMBYTE1,$MINQUOT FLIP QUOTE FLAG 45190000 + BXH RA,RY,MACSTRT BUMP SCAN PTR, BRANCH ALWAYS J 45195000 +MCSCQTWO LA RA,2(R1) BUMP SCAN POINTER PAST DOUBLE ' 45205000 + B MACSTRT RESUME SCAN 45210000 + SPACE 2 45215000 +MCSCQU01 EQU * 45220000 + NI AVMBYTE1,X'FF'-$MINQUOT TURN OFF QUOTE FLAG 45225000 + BCTR R1,0 DEC R1 45230000 + LR RA,R1 COPY R1 INTO SCAN POINTER 45235000 + LA RB,$ERNODLM SET NO DELIM FLAG 45240000 + $CALL ERRTAG FLAG STATEMENT 45245000 + LA RB,8 INDICATE MACRO COMMENT 45250000 + B MCSCNERR AND RETURN 45255000 + SPACE 4 45260000 +* RETURN SEQUENCE FOR MACSCN -- SETS RETURN CODES S 45260100 +* AND RESETS TABLES, ETC. S 45260200 +* S 45260300 +MCSCNFT EQU * 45265000 + SR RB,RB CLEAR RB FOR NORMAL RETURN 45270000 +MCSCNERR EQU * 45275000 + $SETRT (' ',0,'(',0,')',0,'''',0) CLEAR TRT TABLE 45280000 +MCSCNRT EQU * 45285000 + LR RC,RZ RESTORE OPCODTB @ TO RC FOR RETURN 45290000 + L RA,AVMTSCNP RESTORE SCAN POINTER 45295000 + XSNAP LABEL='***MACSCN EXITED***',IF=(AVMSNBY1,O,$MSNP03,TM), #45300000 + STORAGE=(*AVMFLD1,*AVMBYTE5) 45305000 + $RETURN RGS=(R14-R6) 45310000 + DROP RAT,RC,R13 45315000 + LTORG 45320000 + TITLE '*** MCSCOP - STANDARD VALUE SCANNER ***' 45325000 +**--> CSECT: MCSCOP THIS ROUTINE SCANS A MACRO INSTRUCTION * 45330000 +*. OPERAND. THE OPERAND MUST CONFORM TO A STANDARD VALUE AS * 45335000 +*. LAID DOWN IN SECTION 8 OF IBM GC28-2514 * 45340000 +*. * 45345000 +*. ENTRY CONDITIONS * 45350000 +*. AVMBYTE1: FLAG $MSBLIST EXPECTED SET IF ALREADY INSIDE SUBLISS 45355000 +*. * 45360000 +*. EXIT CONDITIONS * 45365000 +*. RA = DELIM PAST OPRND IF STND VALUE ELSE POINTS AT ERROR * 45370000 +*. RB = 0 IF STANDARD VALUE ELSE $ER MESSAGE * 45375000 +*. RC = LENGTH OF OPERAND IF OKAY * 45380000 +*. RD = TYPE OF OPERAND. IN THIS CASE TYPE WILL BE ONE OF * 45385000 +*. 'O' (NULL), 'N' (SELF-DEFINING TERM) OR 'U' (ALL OTHERS) * 45390000 +*. CAN BE 'S' AFTER SCANNING (1ST SUBPOPERAND S 45391000 +*. RE = VALUE OF SELF DEFINING TERM * 45395000 +*. AVMBYTE1: FLAG $MINQUOT HAS INDETERMINATE VALUE. S 45396000 +*. USES MACROS: $SAVE, $RETURN, $SETRT, $CALL * 45400000 +*. USES DSECTS: AVWXTABL * 45405000 +*. CALLS SDBCDX * 45410000 +*. * 45415000 +*.********************************************************************* 45420000 + SPACE 4 45425000 +* * * * * * * * * * REGISTER USAGE IN MCSCOP * * * * * * * * * * * * S 45427000 +* R0 = TEMPORARY SAVE REGISTER FOR SCAN POINTER. S 45427100 +* R1 = SCAN POINTER FROM TRT INSTRUCTIONS. S 45427200 +* R2 = BYTE REGISTER, TRT USAGE. S 45427300 +* RA = NORMAL SCAN POINTER. S 45428000 +* RB = RETURN CODE REGISTER. S 45428100 +* RC = RETURN LENGTH REGISTER. S 45428200 +* RD = FLAG REGISTER FOR TYPE: 'U', 'N', 'O', OR 'S' . S 45428300 +* RE = PARENTHESES NEST LEVEL COUNTER; SELF-DEF TERM VALUE RETURN. S 45428400 +* R13= BASE REGISTER. S 45428500 +* R14= INTERNAL LINK REGISTER. S 45428600 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * S 45428800 + SPACE 2 S 45428900 +MCSCOP CSECT 45430000 + $SAVE RGS=(R14-R2),SA=*,BR=13 45435000 + USING AVWXTABL,RAT 45440000 + XSNAP LABEL='***MCSCOP ENTERED***',IF=(AVMSNBY1,O,$MSNP04,TM) 45445000 + NI AVMBYTE1,X'FF'-$MINQUOT TURN OFF QUOTE FLAG 45450000 + LA RD,C'U' SET UNDEFINED FLAG FOR STARTS 45455000 + BAL R14,MCSET1 SET TRT TABLE FOR CORRECT SCANNING J 45460000 + SR RE,RE USE RE AS PAREN COUNTER 45465000 + SR R1,R1 A 45467000 + SR R2,R2 CLEAR R2 FOR TRT USE 45470000 + LR R0,RA COPY SCAN POINTER 45475000 + TRT 0(1,RA),AWTDECT POSSIBLE SDTERM? 45480000 + BZ MCOPSDTM DECIMAL TERM IF CC = 0 45485000 + C R2,AWF4 IS IT B, C OR X? 45490000 + BE MCOPSDTM POSSIBLE IF EQUAL TO 4 45495000 + B MCOPSTRT SKIP AROUND SCAN POINTER BUMP FIRSTJ 45496000 +MCOPSTRS LA RA,1(,R1) SET SCAN PTR 1 BEYOND LAST TRT END J 45498000 +MCOPSTRT EQU * 45500000 + TRT 0(200,RA),AWTZTAB START SCAN 45505000 + B *(R2) JUMP TO TABLE OF BRANCHES 45510000 + B MCOPQUOT 45515000 + B MCOPLPAR 45520000 + B MCOPRPAR 45525000 + B MCOPEQUL 45530000 + B MCOPAMPR 45535000 + B MCOPSCFT 45540000 + B MCOPBLNK 45545000 + SPACE 2 45550000 +MCOPQUOT EQU * COME HERE FOR ' A 45555000 + CLI 1(R1),C'''' TWO QUOTES IN ROW? 45565000 + BE MCOPQTWO IF YES, JUMP AN PROCESS 45570000 + TM AVMBYTE1,$MINQUOT 45575000 + BO MCOPINQU 45580000 + LA R2,2 A 45585000 + SR R1,R2 A 45590000 + CLI 1(R1),C'L' A 45595000 + BNE MCOPQU11 A 45600000 + TRT 0(1,R1),AWTSYMT CHACK CHARACTER 45605000 + BZ MCOPQU11 IF LETTER THEN IS NOT L' 45610000 + TRT 3(1,R1),AWTSYMT CHAR AFTER L' = ALPHA? 45615000 + BNZ MCOPQU11 IF NOT, JUMP OUT 45620000 + CLI 3(R1),C'Z' CHAR GREATER THAN Z? 45625000 + BH MCOPQU11 IF YES, CANT BE ALPAH 45630000 + CLI 0(R1),C'&&' IS IT AN AMPERSAND? 45635000 + BE MCOPQU11 IF YES, NOT L' 45640000 + LA RA,3(R1) BUMP SCAN POINTER 45645000 + B MCOPSTRT RESUME SCAN 45650000 + SPACE 2 45655000 +MCOPQTWO LA RA,2(R1) BUMP SCAN POINTER PAST '' 45660000 + B MCOPSTRT 45665000 + SPACE 2 45670000 +MCOPQU11 AR R1,R2 RESTORE SCAN PTR TO ' FOUND A 45675000 +* THE $SETRT MACRO IS USED TO CLEAR THE AWTZTAB TABLE FOR SCAN OF 45695000 +* A QUOTED STRING 45700000 + IC RB,AWTZTAB+C',' SAVE CURRENT COMMA STATUS ACRS ' J 45701000 + BAL R14,MCSET2A SET FOR INSIDE QUOTED STRING -ZERO J 45705000 + B MCOPQU02 45710000 +* WHEN END OF QUOTED STRING HAS BEEN REACHED, AWTZTAB IS RESTORED 45715000 +* SO THAT NORMAL SCAN CAN CONTINUE 45720000 +MCOPINQU BAL R14,MCSET1A RESET, NO LONGER INSIDE QUOTED STRNJ 45725000 + STC RB,AWTZTAB+C',' RESTORE ORIGINAL COMMA STATUS J 45729000 +MCOPQU02 XI AVMBYTE1,$MINQUOT FLIP QUOTE FLAG 45730000 + B MCOPSTRS GO BACK TO INCREMENT PTR AND SCAN J 45735000 + SPACE 2 45745000 +MCOPLPAR CR R1,R0 BEGINNING OF OPERAND? 45765000 + BNE MCOPLP01 IF NOT, PROCEED 45770000 + L RD,=C' S' ELSE SET SUBLIST FLAG 45775000 +MCOPLP01 LA RE,1(RE) BUMP PAREN COUNTER 45780000 + $SETRT (',',0) COMMAS OK INSIDE PARENS 45785000 + B MCOPSTRS GO AND BUMP SCAN PTR BY 1 A 45795000 + SPACE 2 45800000 +MCOPRPAR BCT RE,MCOPRP01 DECR PAREN COUNTER 45805000 + $SETRT (',',24) RESET TRT TABLE IF ZERO 45810000 + B MCOPRP02 45815000 +MCOPRP01 LTR RE,RE TEST PAREN COUNT 45820000 + BNM MCOPRPFT IF NOT MINUS, OKAY 45825000 + TM AVMBYTE1,$MSBLIST ARE WE IN SUBLIST 45830000 + BO MCOPSCFT IF YES, OKAY. END OF SUBLIST 45835000 +MCOPRER1 LA RB,$ERVSYNT SET SYNTAX ERROR 45840000 + LR RA,R1 SET SCAN POINTER 45845000 + B MCOPSCRT 45850000 +MCOPRPFT EQU MCOPSTRS SAME AS PREVIOUS LABEL: BUMP PTR J 45855000 + SPACE 2 45865000 +MCOPRP02 C RD,=C' S' ARE WE IN SUBLIST? 45870000 + BNE MCOPRPFT IF NOT, PROCEED 45875000 + CLI 1(R1),C',' END OF OPERAND? 45880000 + BE MCOPRPFT IF YES, PROCEED 45885000 + CLI 1(R1),C' ' END OF OPERAND? 45890000 + BE MCOPRPFT 45895000 + LA RD,C'U' INSERT UNDEFINED FLAG 45900000 + B MCOPRPFT CONTINUE SCAN 45905000 + SPACE 4 45910000 +MCOPEQUL CR R1,R0 AT START OF OPERAND? 45915000 + BE MCOPEQ01 IF YES, OKAY 45920000 + LTR RE,RE ELSE ARE WEIN PARENS? 45925000 + BZ MCOPRER1 ERROR IF NOT 45930000 +MCOPEQ01 EQU MCOPSTRS SAME AS PREVIOUS LABEL, SKIP THERE J 45935000 + B MCOPSTRS BRANCH THERE, IF FLLA THRU HERE J 45940000 + SPACE 4 45945000 +MCOPAMPR CLI 1(R1),C'&&' TWO AMPERSANDS? 45950000 + BE MCOPQTWO IF YES USE DOUBLE QUOTE CODE 45955000 + CR R0,R1 BEGINNING OF OPERAND? 45960000 + BE MCOPEQ01 IF YES USE = CODE 45965000 + B MCOPRER1 ELSE ERROR, USE RPAR CODE 45970000 + SPACE 2 45975000 +MCOPSDTM EQU * 45980000 + $CALL SDBCDX CALL SELF-DEFINING TERM ROUTINE 45985000 + LTR RB,RB WAS IT SD TERM 45990000 + BNZ MCOPSTRT JUMP IF NOT REALY SELF-DEF TERM JRM 45995000 + CLI 0(RA),C',' NORMAL DELIM AFTER SDTERM? 46000000 + BE MCOPSDT1 PROCEED IF YES 46005000 + CLI 0(RA),C' ' DELIM = ' '? 46010000 + BE MCOPSDT1 PROCEED IF YES 46015000 + CLI 0(RA),C')' DELIM IS A ')'? 46020000 + BNE MCOPSDT2 IF NOT, START SCAN OVER 46025000 + TM AVMBYTE1,$MSBLIST SCANNING SUBLIST? 46030000 + BO MCOPSDT1 RIGHT PAREN OKAY IF SO 46035000 +MCOPSDT2 EQU * 46040000 + LM RC,RD,AWZEROS CLEAR RC, RD AFTER SDDTERM 46045000 + LR RA,R0 RESTORE SCAN POINTER TO RESUME SCAN 46050000 + B MCOPSTRT 46055000 +MCOPSDT1 EQU * 46060000 + LR R1,RA MOVE SCAN POINTER INTO R1 46065000 + LA RD,C'N' SET SELF DEF TERM FLG 46070000 + LR RE,RC MOVE VALUE OF SDTERM INTO RE 46075000 + B MCOPSCFT 46080000 + SPACE 2 46085000 +MCOPBLNK EQU * 46090000 + LTR RE,RE ARE WE IN PARENS 46095000 + BZ MCOPSCFT IF NOT, FINI 46100000 + LA RB,$ERNODLM ELSE SET WRONG DELIM FLAG 46105000 + B MCOPSCRT AND RETURN 46110000 + SPACE 4 46115000 +MCOPSCFT LR RA,R1 MOVE SCAN POINTER 46120000 + LR RC,R1 COPPY POINTER 46125000 + SR RB,RB CLEAR RB FOR FLAG USE 46130000 + C RD,=C' S' SUBLIST? 46135000 + BNE MCOPSCF1 SKIP IF NOT 46140000 + TM AVMBYTE1,$MSBLIST IN SUBLIST FLAG ON? 46145000 + BNO MCOPSCF1 SKIP IF NOT 46150000 + LA RD,C'U' ELSE SET UNEFINED FLAG 46155000 +MCOPSCF1 EQU * 46160000 + SR RC,R0 GET LENGTH OF OPERAND 46165000 + BNZ MCOPSCRT JUMP AROUND IN NOT ZERO 46170000 + LA RD,C'O' ELSE SET NULL FLAG 46175000 +MCOPSCRT BAL R14,MCSET2 RESET ALL VALUES CHANGED IN TRT TB J 46180000 + XSNAP LABEL='***MCSCOP EXITED*** ',IF=(AVMSNBY1,O,$MSNP04,TM) 46185000 + $RETURN RGS=(R14-R2) 46190000 + SPACE 2 J 46191000 +**--> INSUB: MCSET# MODIFY TRT TABLE AWTZTAB + + + + + + + + + + S 46191100 +MCSET1 $SETRT ('''',4) SET TO CATCH ' , AND THEN OTHER CHARS J 46191300 +MCSET1A $SETRT ('(',8,')',12,'=',16,'&&',20,',',24,' ',28) OTHER CHRSJ 46191400 + BR R14 RETURN TO CALLER J 46191500 + SPACE 1 J 46192000 +MCSET2 $SETRT ('''',0) RESET ' TO 0, THEN OTHERS J 46192100 +MCSET2A $SETRT ('(',0,')',0,'=',0,'&&',0,',',0,' ',0) RESET OTHERS J 46192200 + BR R14 RETURN TO CALLER J 46192300 + DROP RAT,R13 46195000 + LTORG 46200000 + TITLE '*** MACFND - SEARCHES DICTIONARIES FOR VARIABLE ***' 46205000 +**--> CSECT: MACFND THIS ROUTINE IS GENERAL SEARCH PROCEDURE * 46210000 +*. WHICH CAN SCAN THE MACRO LIBRARY, GLOBAL AND LOCAL * 46215000 +*. DICTIONARIES AND THE SYMBOLIC PARAMETER LIST. THE CALLING * 46220000 +*. ROUTINE DETERMINES WHICH LIBRARY BY PLACING THE APPROPRIATE * 46225000 +*. POINTER IN RC. * 46230000 +*. * 46235000 +*. ENTRY CONDITIONS * 46240000 +*. RC = @ OF FIRST ENTRY OF LIST TO BE SEARCHED * 46245000 +*. * 46250000 +*. EXIT CONDITIONS * 46255000 +*. RB = 0 IF ENTRY IS FOUND * 46260000 +*. = $ERUNDEF IF ENTRY IS NOT FOUND * 46265000 +*. RC = @ OF ENTRY IF FOUND ELSE @ OF FINAL ENTRY IF NOT FOUND * 46270000 +*. USES MACROS: $SAVE, $RETURN * 46275000 +*. USES DSECTS: MACLIB, AVWXTABL * 46280000 +*. * 46285000 +*.REGISTER USAGE A 46285100 +*.RC-MACLIB BASE REGISTER, LIST TO BE SEARCHED A 46285200 +*.RAT- MAIN TABLE DSECT USING A 46285300 +*.RB-RETURN REGISTER A 46285400 +*. A 46285500 +*. NAMES=MACFN___ A 46285600 +*. A 46285700 +*. * 46290000 +*.********************************************************************* 46295000 + SPACE 2 46300000 +MACFND CSECT 46305000 + $SAVE SA=NO 46310000 + USING AVWXTABL,RAT 46315000 + XSNAP LABEL='***MACFND ENTERED***',T=NO,IF=(AVMSNBY1,O,$MSNP05X46320000 + ,TM) 46325000 + USING MACLIB,RC USE MACLIB AS REPRESENTATIVE DSECT 46330000 + LTR RC,RC CHECK FOR NULL (MAYBE OPEN CDE) J 46331000 + BZ MACFNDRU SKIP IF NULL LIST J 46332000 + SR RB,RB 46335000 + B MACFND02 JUMP TO COMPARE FIRST ENTRY 46340000 +MACFND01 L RC,MCLIBNXT GET @ OF NEST ENTRY 46345000 +MACFND02 CLC AVMSYMBL,MCLBNAM COMPARE NAME WITH GLOBAL SYMBOL 46350000 + XSNAP LABEL='IN MACFND LOOP RC # LIB',STORAGE=(*0(RC),*30(RC)) 46350100 + BE MACFNDRT IF EQUAL RETURN 46355000 + CL RB,MCLIBNXT FINAL ENTRY? 46360000 + BNE MACFND01 IF NOT, TRY AGAIN 46365000 +MACFNDRU LA RB,$ERUNDEF SHOW UNDEFINED SYMBOL J 46370000 +MACFNDRT EQU * 46375000 + XSNAP LABEL='***MACFND EXITED***',IF=(AVMSNBY1,O,$MSNP05,TM) 46380000 + $RETURN SA=NO 46385000 + DROP RAT,RC,REP 46390000 + LTORG 46395000 + TITLE '***MCVSCN - VARIABLE SYMBOL SCANNER ***' 46400000 +**--> CSECT: MCVSCN THIS ROUTINE SCANS A STRING AND CHECKS * 46405000 +*. FOR A LEGAL VARIABLE SYMBOL. IF OKAY, SYMBOL IS MOVED INTO * 46410000 +*. AVMSYMBL IN AVWXTABL WHERE IT WILL BE UTILIZED IN SEARCHES. * 46415000 +*. * 46420000 +*. ENTRY CONDITIONS * 46425000 +*. RA = @ OF FIRST CHARACTER OF STRING * 46430000 +*. * 46435000 +*. EXIT CONDITIONS * 46440000 +*. RA = @ OF DELIMITER PAST SYMBOL IF LEGAL * 46445000 +*. = SAME AS ENTRY IF NOT VARIABLE SYMBOL * 46450000 +*. RB = 0 IF OKAY, <0 IF NOT VARIABLE SYMBOL, * 46455000 +*. = $ER MESSAGE IF ILLEGAL SYMBOL * 46460000 +*. USES MACROS: $SAVE, $RETURN * 46465000 +*. USES DSECTS: AVWXTABL * 46470000 +*. * 46475000 +*.REGISTER USAGE A 46475100 +*.RAT- MAIN TABLE DSECT USING A 46475200 +*.R1,R2 USED IN TRT'S A 46475300 +*.RB- SET AS IN EXIT CONDITIONS ABOVE A 46475400 +*. A 46475500 +*.NAMES=MCVS____ A 46475600 +*. A 46475700 +*.********************************************************************* 46480000 + SPACE 2 46485000 +MCVSCN CSECT 46490000 + $SAVE RGS=(R0-R2),SA=NO 46495000 + USING AVWXTABL,RAT 46500000 + XSNAP LABEL='***MCVSCN ENTERED***',T=NO,STORAGE=(*AVMSYMBL,*AVX46505000 + MSYMBL+10),IF=(AVMSNBY1,O,$MSNP05,TM) 46510000 + LM R1,R2,AWZEROS ZERO R1, R2, FOR TRT USE 46515000 + LR R0,RA COPY SCAN POINTER 46520000 + CLI 0(RA),C'&&' STARTS WITH '&'? 46525000 + BNE MCVSCNOT IF NOT, NO VAR SYMBOL 46530000 + CLI 1(RA),C'0' 2ND CHAR = ALAPHA? 46535000 + BNL MCVSCNER IF NOT, ERROR 46540000 + TRT 1(8,RA),AWTSYMT SCAN RMNDER OF SYMBOL 46545000 + BZ MCVSCNER IF ZERO, 9+ CHARS LONG, ERROR 46550000 + SR R1,R0 GET LENGTH OF SYMBOL 46555000 + AR R0,R1 BUMP SCAN & 46560000 + STC R1,AVMSYMLN SAVE LENGTH IN GLOBAL AREA 46565000 + BCT R1,MCVSCN01 DECR FOR EX BUT FALL THROUGH IF ZER 46570000 + B MCVSCNER ERROR IF LENGTH = 1 46575000 +MCVSCN01 MVC AVMSYMBL,AWBLANK BLANK GLOBAL AREA 46580000 + EX R1,MCVSMOVE MOVE SYMBOL INTO GLOBAL AREA 46585000 + LR RA,R0 BUMP SCAN POINTER 46590000 + SR RB,RB 46595000 + B MCVSCNRT 46600000 +MCVSCNOT L RB,AWFM4 SET NO SYMBOL FLAG 46605000 + B MCVSCNRT 46610000 +MCVSCNER LA RB,$ERINVSY SET INVALID SYMBOL FLAG 46615000 +MCVSCNRT EQU * 46620000 + XSNAP LABEL='***MCVSCN EXITED***',IF=(AVMSNBY1,O,$MSNP05,TM) 46625000 + $RETURN RGS=(R0-R2),SA=NO 46630000 +MCVSMOVE MVC AVMSYMBL(0),0(RA) DUMMY TO MOVE SYMBOL IN EX INST 46635000 + DROP RAT,REP 46640000 + LTORG 46645000 + TITLE '***MCSYSR - DICTIONARY SEARCH ROUTINE***' 46650000 +**--> CSECT: MCSYSR SCANS SUSPECTED VARIABLE SYMBOL FOR LEGALITY. * 46655000 +*. IF VARIABLE SYMBOL THEN PLACES IN AVMSYMBL. THEN SEARCHES * 46660000 +*. GLOBAL, LOCAL AND SYMBOLIC PARAMETER DICTIONARIES FOR SYMBOL* 46665000 +*. * 46670000 +*. ENTRY CONDITIONS * 46675000 +*. RA = @ OF FIRST CHARACTER OF SYMBOL * 46680000 +*. * 46685000 +*. EXIT CONDITIONS * 46690000 +*. RA = @ OF DELIMITER PAST VARIABLE SYMBOL IF OKAY * 46695000 +*. = SAME AS ENTRY IF NOT VARIABLE SYMBOL OR IF NOT FOUND * 46700000 +*. RB = $ERUNDEF IF SYMBOL IS NOT FOUND * 46705000 +*. RB = 0 IF SYMBOL IS FOUND IN ONE OF THE DICTIONARIES * 46710000 +*. = SET TO -4 IF RA DOES NOT POINT AT VARIABLE SYMBOL * 46715000 +*. RC = POINTER TO SYMBOL ENTRY IF FOUND * 46720000 +*. RD = $GLOBAL IF SYMBOL PRESENT IN GLOBAL DICTIONARY * 46725000 +*. = $LOCAL IF SYMBOL FOUND IN LOCAL DICTIONARY * 46730000 +*. = $SYMPAR IF SYMBOL IS SYMBOLIC PARAMETER * 46735000 +*. = $SYSTEM IF SYMBOL IS SYTEM VARIABLE * 46740000 +*. * 46745000 +*. USES MACROS: $CALL, $SAVE, $RETURN * 46750000 +*. USES DSECTS: MCGLBDCT, MACLIB,AVWXTABL * 46755000 +*. CALLS MCVSCN, MACFND * 46760000 +*. A 46760100 +*.REGISTER USAGE *************** A 46760200 +*.R13 -BASE REGISTER AND SAVEAREA POINTER A 46760300 +*.RC- BASE REGISTER FOR GLOBAL DSECT A 46760400 +*.RX- BASE REGISER FOR MACRO DICTIONARY A 46760500 +*. A 46760600 +*.NAMES=MCSY____ A 46760700 +*. A 46760800 +*.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 46765000 + SPACE 2 46770000 +MCSYSR CSECT 46775000 + $SAVE RGS=(R14-R0),SA=*,BR=13 46780000 + USING AVWXTABL,RAT SET MAIN TABLE USING 46785000 + XSNAP LABEL='***MCSYSR ENTERED***',T=NO,IF=(AVMSNBY1,O,$MSNP06X46790000 + ,TM) 46795000 + USING MCGLBDCT,RC USE GLOBAL DSCT AS DUMMY FOR SEARCH 46800000 + USING MACLIB,RX RX POINTS TO CURRENT MACLIB ENTRY 46805000 + LR R0,RA COPY SCAN POINTER 46810000 + SR RD,RD CLEAR RD FOR RETURN CODE 46815000 + $CALL MCVSCN SCAN SYMBOL 46820000 + LTR RB,RB VAR SYMBOL? 46825000 + BZ MCSY01 PROCEED IF YES 46830000 + L RB,AWFM4 ELSE SET NO SYMBOL FLAG 46835000 + B MCSYFT AND RETURN 46840000 + SPACE 46845000 +*.VARIABLE SYMBOL FOUND SEARCH PARAM DICTIONAY A 46845100 +*. A 46845200 +MCSY01 EQU * 46850000 + L RC,MCPARPNT GET PNTR TO PARAM LIST 46855000 + $CALL MACFND SCAN PARAM DICT. 46860000 + LTR RB,RB SYMBOL F6UND? 46865000 + BNZ MCSY02 IF NOT PROCEED WITH GLOBAL SEARCH 46870000 + LA RD,$SYMPAR ELSE SET PARAMETER FLAG 46875000 + CLI MCGLBTYP,C'S' CHECK IF SYSTEM VARIABLE 46880000 + BNE MCSYFT RETURN IF NOT 46885000 + LA RD,$SYSVAR ELSE SET SYSTEM FLAG 46890000 + B MCSYFT AND RETURN 46895000 + SPACE 46900000 +*.NOT IN PARM DICTIONARY, SEARCH GLOBAL DICTIONARY A 46900100 +*. A 46900200 +MCSY02 EQU * 46905000 + L RC,AVMGDICT GET PNTR TO GLOBAL DICTIONARY 46910000 + $CALL MACFND SEARCH DICTIONARY 46915000 + LTR RB,RB SYMBOL FOUND? 46920000 + BNZ MCSY03 PROCEED WITH PARAM SEARCH IF NOT 46925000 + CLC MCGLBDEF,AVMMACID GLOBAL DECLARED THIS DEFINITION? 46930000 + BNE MCSY03 IF NOT, PROCEED AND SEARCH LOCAL DIC 46935000 + LA RD,$GLOBAL SET GLOBAL TYPE FLAG 46940000 + B MCSYFT AND RETURN 46945000 + SPACE 46950000 +*.NOW CHECK LOCAL DICTIONARY A 46950100 +*. A 46950200 +MCSY03 EQU * 46955000 + LA RD,$LOCAL SET LOCAL FLAG 46960000 + L RC,MCDDVPNT GET LOCAL DICT @ 46965000 + $CALL MACFND SEARCH LOCAL DICTIONARY 46970000 + LTR RB,RB SYMBOL FOUND? 46975000 + BZ MCSYFT IF YES, RETURN 46980000 + LR RA,R0 ELSE RESTORE SCAN POINTER FIRST 46985000 +MCSYFT EQU * 46990000 + XSNAP LABEL='***MCSYSR EXITED***',IF=(AVMSNBY1,O,$MSNP06,TM) 46995000 + $RETURN RGS=(R14-R0) 47000000 + DROP RAT,RC,RX,R13 47005000 + LTORG 47010000 + TITLE '***MCDTRM - CONVERTS DECIMAL TO BINARY***' 47015000 +**--> CSECT: MCDTRM DECIMAL CONSTANT CONVERSION. MCDTRM DECIDES * 47020000 +*. SCAN POINTER IS POINTING AT LEGAL DECIAMAL TERM AND IF SO, * 47025000 +*. CONVERTS TO BINARY FORM. HANDLES VALUES UP TO 2**31-1 * 47030000 +*. * 47035000 +*. ENTRY CONDITIONS * 47040000 +*. RA = @ OF FIRST CHAR OF TERM * 47045000 +*. * 47050000 +*. EXIT CONDITIONS * 47055000 +*. RA = @ OF DELIMITER BEYOND CONSTANT * 47060000 +*. = SAME AS ENTRY IF ERROR * 47065000 +*. RB = 0 IF CONSTANT WAS LEGAL * 47070000 +*. = $ER MSSGE IF ILLEGAL TERM * 47075000 +*. RC = VALUE OF CONSTANT, 0 TO 2**31-1 * 47080000 +*. * 47085000 +*. USES DSECTS: AVWXTABL * 47090000 +*. USES MACROS: $SAVE, $RETURN * 47095000 +*.REGISTER USAGE A 47095100 +*.R12 -BASE REG A 47095200 +*.RAT-MAIN TABLE DSECT USING A 47095300 +*.RD- SCAN POINTER A 47095400 +*. A 47095500 +*.NAMES=MCD_____ A 47095600 +*. A 47095700 +*** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 47100000 + SPACE 4 47105000 +MCDTRM CSECT 47110000 + $SAVE RGS=(R0-R2),SA=NO 47115000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 47120000 + XSNAP LABEL='***MCDTRM ENTERED***',T=NO,IF=(AVMSNBY1,O,$MSNP06X47125000 + ,TM) 47130000 + LR RD,RA COPY SCAN POINTER 47135000 + SR R1,R1 USE IN TRT INST 47140000 + TRT 0(11,RD),AWTDECT TRANSLATE WITH DEC TABLE 47145000 + BZ MCDTRMR1 ERROR IF MORE THAN 10 DIGITS 47150000 + BM MCDTRM01 < 10 DIGITS, PROCEED 47155000 + CLC 0(10,RA),=C'2147483647' 10 DIGIT NUMBER WITHIN RANGE? 47160000 + BH MCDTRMR1 ERROR IF GREATER 47165000 +MCDTRM01 EQU * 47170000 + LR RA,R1 UPDATE SCAN POINTER 47175000 + SR R1,RD GET LENGTH 47180000 + BZ MCDTRMR1 ILLEGAL IF ZERO LENGTH 47185000 + BCTR R1,0 GET LENGTH-1 FOR EX INST 47190000 + EX R1,MCDECPAK PACK CHARS 47195000 + CVB RC,AVDWORK1 CONVERT THE NIMBER 47200000 + SR RB,RB SHOW NO ERRORS 47205000 +MCDTRMRT EQU * 47210000 + XSNAP LABEL='***MCDTRM EXITED***',IF=(AVMSNBY1,O,$MSNP06,TM) 47215000 + $RETURN RGS=(R0-R2),SA=NO 47220000 +MCDTRMR1 LA RB,$ERSDINV SET ILLEGAL NUMBER FLAG 47225000 + B MCDTRMRT AND RETURN 47230000 +MCDECPAK PACK AVDWORK1(8),0(0,RD) PACK DEC CHARS 47235000 + LTORG 47240000 + DROP RAT 47245000 + TITLE '***MCGTST - CHARSTRING STORE ROUTINE***' 47250000 +**--> CSECT: MCGTST THIS ROUTINE TAKES A STRING AS DELINEATED BY * 47255000 +*. BEGINNING AND END POINTERS, OBTAINS STORAGE DYNAMICALLY AND * 47260000 +*. MOVES THE STING. IF INSIDE QUOTES DOUBLE QUOTES WILL BE * 47265000 +*. CRUNCHED TO ONE QUOTE * 47270000 +*. * 47275000 +*. ENTRY CONDITIONS * 47280000 +*. RA = @ OF FIRST CAHRACTER OF STRING * 47285000 +*. RB = @ OF DELIMITER PAST STRING * 47290000 +*. * 47295000 +*. EXIT CONDITIONS * 47300000 +*. RA = @ OF DELIMITER PAST STRING * 47305000 +*. RC = @ OF STRING IN NEW STORAGE * 47310000 +*. RD = LENGTH OF STRING * 47315000 +*. * 47320000 +*. USES MACROS: $SAVE, $RETURN, $ALLOCL * 47325000 +*. USES DSECTS: AVWXTABL * 47330000 +*. * 47335000 +*. REGISTER USAGE A 47335100 +*. RAT-MAIN TABLE USING A 47335200 +*. RA,RB,RC,RD-AS IN ENTR/EXIT CONDITIONS A 47335300 +*. RE,R1,R3-WORK REGISTERS A 47335600 +*** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 47340000 + SPACE 2 47345000 +MCGTST CSECT 47350000 + $SAVE RGS=(R0-R3),SA=NO 47355000 + USING AVWXTABL,RAT 47360000 + XSNAP LABEL='***MCGTST ENTERED***',IF=(AVMSNBY1,O,$MSNP06,TM) 47365000 + CR RA,RB NULL STRING? 47370000 + BE MCGTSTF SKIP OUT IF NULL STRING S 47375000 + LR RE,RB COPY END DELIM 47395000 + SR RE,RA GET LENGTH 47400000 + LR RD,RE COPY LENGTH 47405000 + LA RE,3(RE) GET NEXT FULL WORD PLUS A 47410000 + SRL RE,2 47415000 + SLL RE,2 TRUNCATE TO FULL WORD 47420000 + $ALLOCL RC,RE,MCGTOVR OBTAIN STORAGE FOR STRING 47425000 + LR RE,RD COPY ORIGINAL LENGTH 47430000 + BCTR RE,0 DECR FOR EX INST 47435000 + EX RE,MCGTMV MOVE STRING INTO STORAGE 47440000 + TM AVMBYTE1,$MINQUOT INSIDE QUOTES? 47445000 + BNO MCGTSTFT IF NOT, RETURN 47450000 + LR R1,RC GET @ OF STIRNG START 47455000 + LR R3,R1 47460000 + AR R3,RE GET @ OF END OF STRING 47465000 + BCTR R3,0 DECR TO SECOND LAST CHAR 47470000 + LA R2,1 USE R2 AS INDEX 47475000 +MCGTST02 EQU * 47480000 + CLI 0(R1),C'''' QUOTE? 47485000 + BCTR RE,0 REDUCE RMNDR COUNT 47490000 + BE MCGTST03 SQUEEZE QUOTE IF YES 47495000 + BXLE R1,R2,MCGTST02 ELSE BUMP INDEX AND RESUME SCAN 47500000 + B MCGTSTFT ELSE RETURN IF SCAN FINISHED 47505000 +MCGTST03 EQU * 47510000 + EX RE,MCGTMVC A 47515000 + MVI 1(R3),C' ' INSERT BLANK AT END OF SQUZD STRNG 47530000 + BCTR R3,0 DECR END OF STRING POINTER 47535000 + BCTR RE,0 DECR REMAINING LENGTH 47540000 + BCTR RD,0 REDUCE OVERALL LENGTH 47545000 + AR R1,R2 BUMP SCAN POINTER A 47550000 + B MCGTST02 RESUME SCAN 47555000 +MCGTMVC MVC 0($,R1),1(R1) SQUEEZE OUT QUOTE A 47555100 + SPACE 2 47560000 +MCGTSTF LM RC,RD,AWZEROS ZERO OUT- NULL STRING S 47564000 +MCGTSTFT EQU * 47565000 + LR RA,RB MOVE SCAN POINTER 47570000 + XSNAP LABEL='***MCGTST EXITED***',IF=(AVMSNBY1,O,$MSNP06,TM) 47575000 + $RETURN RGS=(R0-R3),SA=NO 47580000 + SPACE 47585000 +MCGTOVR L R15,AVMOVRFL GET @ OF OVERFLOW ROUTINE 47590000 + BR REP BRANCH THERE 47595000 +MCGTMV MVC 0($,RC),0(RA) MOVE STRING INTO STORAGE A 47600000 + DROP RAT 47605000 + LTORG 47610000 + TITLE '*** MCATRM - ATTRIBUTE PROCESSOR ***' 47615000 +**--> CSECT: MCATRM THIS ROUTINE SCANS A TERM AND DETERMINES * 47620000 +*. WHETHER IT IS A VALID ATTRIBUTE, IE I', K', L', N', S' OR T'* 47625000 +*. THE LENGTH (L'), SCALE (S') AND INTEGER (I') ATTRIBUTES ARE * 47630000 +*. NOT IMPLEMENTED AND ARE SO FLAGGED. * 47635000 +*. * 47640000 +*. ENTRY CONDITIONS * 47645000 +*. RA = @ OF FIRST CHAR OF TERM * 47650000 +*. * 47655000 +*. EXIT CONDITIONS * 47660000 +*. RA = @ OF DELIM PAST QUOTE IF VALID ATTRIBUTE ELSE SAME AS * 47665000 +*. ENTRY. * 47670000 +*. RB = 0 IF ATTRIBUTE * 47675000 +*. = -4 IF NOT ATTRIBUTE * 47680000 +*. = $ERMESSAGE IF NOT IMPLEMENTED * 47685000 +*. RC = TYPE OF ATTRIBUTE * 47690000 +*. * 47695000 +*. USES MACROS: $SAVE, $RETURN * 47700000 +*. USES DSECTS: AVWXTABL * 47705000 +*. * 47710000 +*.********************************************************************* 47715000 + SPACE 2 47720000 +MCATRM CSECT 47725000 + $SAVE RGS=(R14-R2),SA=NO 47730000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 47735000 + XSNAP LABEL='***MCATRM ENTERED***',T=NO,IF=(AVMSNBY1,O,$MSNP06X47740000 + ,TM) 47745000 + LM RB,RC,AWZEROS ZERO RB AND RC 47750000 +* A 47755000 + BCTR RA,0 DECR POINTER 47760000 + TRT 0(1,RA),AWTSYMT TEST PREV CHAR 47765000 + LA RA,1(RA) RESTORE POINTER 47770000 + BZ MCATRMR1 NOT ATTRIBUTE IF PREV CHAR = ALPHA 47775000 + LA RD,MCATTABL GET @ OF ATTRIBUTE TABLE 47780000 +MCATRMSC CLC 0(2,RA),0(RD) COMPARE NEXT ENTRY 47785000 + BL MCATRMR1 IF LOW, NOT FOUND, RETURN 47790000 + BE MCATRMYS IF EQUAL, FOUND 47795000 + LA RD,4(RD) ELSE BUMP TABLE POINTER 47800000 + B MCATRMSC TRY AGAIN 47805000 + SPACE 47810000 +MCATRMYS IC RB,3(RD) SET PRESENCE FLAG 47815000 + IC RC,2(RD) SET TYPE 47820000 + CLI 3(RD),$ERNOIMP IMPLEMENTED? 47825000 + BE MCATRMRT IF NOT, DON'T MOVE POINTER 47830000 + LA RA,2(RA) BUMP POINTER 47835000 + B MCATRMRT 47840000 +MCATRMR1 EQU * 47845000 + L RB,AWFM4 SET -4 FOR NO ATTIB 47850000 +MCATRMRT EQU * 47855000 + XSNAP LABEL='***MCATRM EXITED***',IF=(AVMSNBY1,O,$MSNP06,TM) 47860000 + $RETURN RGS=(R14-R2),SA=NO 47865000 + SPACE 2 47870000 +MCATTABL DC C'I''',AL1($BSATI,$ERNOIMP),C'K''',AL1($BSATK,X'00') 47875000 + DC C'L''',AL1($BSATL,$ERNOIMP),C'N''',AL1($BSATN,X'00') 47880000 + DC C'S''',AL1($BSATS,$ERNOIMP),C'T''',AL1($BSATT,X'00') 47885000 + DC X'FFFF' A 47890000 + LTORG 47895000 + DROP RAT,REP 47900000 + TITLE '***MCBODY - PROCESSES BODY OF MACRO DEFINITION***' 47905000 +**--> CSECT: MCBODY PROCESSES THE BODY OF MACRO DEFINITION. * 47910000 +*. CALLED FORM MACRO1 AFTRR PROTOTYPE STATEMENT PROCESSED. * 47915000 +*. INITIALIZES LOCAL DICTIONARY FOR CURRENT DEFINITION. * 47920000 +*. PROCESSES EACH STATEMENT TILL MEND STATEMENT ENCOUNTERED. * 47925000 +*. TERMINATES AND RETURNS AT THAT POINT * 47930000 +*. * 47935000 +*. IN OPEN-CODE MODE, ($MCOCFL1 ON IN MCLBFLG2), * 47935100 +*. MCBODY ONLY PROCESSES STMT IN RSBLOCK * 47935200 +*. IF AVPRSAVE IS SET IN AVPRINT1, IT CALL MXMVSR * 47935300 +*. TO SAVE STMT IN HIGH AREA, ELSE IT PRINTS IT IMMEDIATELY * 47935400 +*. ENTRY CONDITIONS * 47940000 +*. RC = @ OF MACLIB ENTRY OF CURRENT MACRO DEFINITION * 47945000 +*. * 47950000 +*. USES MACROS: $SAVE,$RETURN,$CALL,$ALLOCL,$ALLOCH,$SCOF, * 47955000 +*. $SETRT * 47960000 +*. USES DSECTS: AVWXTABL,MACLIB,MCLCLDPV,OPCODTB,RSBLOCK,MCBSU,* 47965000 +*. MCSEQ,MCGLBDCT,MCOPQUAD * 47970000 +*. CALLS INCARD,ERRTAG,MACSCN,ERRLAB,MCVSCN,MACFND,SDDTRM, * 47975000 +*. MCSYSR,MACLEX,MCGTST,OUTPT2,MCGNCD * 47980000 +*. * 47985000 +*. REGISTER USAGE ************************* A 47985100 +*.R13- BASE REGISTER AND SAVEAREA POINTER A 47985200 +*.RAT-MAIN TABLE DSECT USING A 47985300 +*.RX- MACLIB DSECT USING A 47985500 +*.RY- LOCAL DICTIONARY DSECT UING A 47985600 +*.RZ-OPCODE TABLE DSECT USING A 47985700 +*.RB,RE,RA- WORK REGISTERS A 47985800 +*.R1,R2 USED IN TRT'S A 47985900 +*.RET- RETURN REGISTER USED FOR INSUBS A 47985910 +*.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 47990000 + SPACE 2 47995000 +MCBODY CSECT 48000000 + $SAVE RGS=(R14-R6),SA=*,BR=13 48005000 + USING AVWXTABL,RAT 48010000 + XSNAP LABEL='***MCBODY ENTERED***',IF=(AVMSNBY1,O,$MSNP07,TM) 48015000 + USING MACLIB,RX SET USING FOR MACRO LIBRARY ENTRY 48020000 + LR RX,RC COPY @ OF MACLIB ENTRY 48025000 + USING MCLCLDPV,RY SET USING FOR LOCAL DV ENTRY 48030000 + USING OPCODTB,RZ SET USING FOR OPCODE TABLE ENTRY 48035000 + NI AVMBYTE1,$MINDEF CLEAR AVMBYTE1 48040000 + LM R1,R2,AWZEROS CLEAR R1 AND R2 48045000 + MVC AVMCRINS,AWZEROS ZERO PTR TO 1ST ONE-OP J 48045500 + AIF (NOT &$MACOPC).MCBODYA SKIP IF NOT OPEN CODE S 48046000 + TM MCLBFLG2,$MCOCFL1 IN OPEN CODE ? S 48046100 + BO MCBOD02 IF YES, SKIP DUMMY ENTRIES S 48046200 +.MCBODYA ANOP S 48046300 + LA RB,$LLCLDV GET LENGTH OF LOCAL DOPE VECTOR 48050000 + SPACE 48060000 +* THIS DUMMY ENTRY IN LOCAL DICT WILL BE USED FOR ACTR AND &SYSNDX 48065000 + $ALLOCL RY,RB,MCBODOVR GET AREA FOR ENTRY 48070000 + ST RY,MCDDVPNT SAVE @ IN MACLIB 48075000 + MVC 0($LLCLDV,RY),AWZEROS CLEAR ENTRY 48080000 + MVI MCLCLTYP,$ARITH SET TYPE EQUAL TO ARITH FOR LENGTH 48085000 + MVI MCLCLDIM+1,1 SET DIMENSION TO 1 48090000 + MVI MCLOCDLN+3,4 INIT LENGTH OF DICT TO 4 48095000 + SPACE 48100000 +* DUMMY ENTRY FOR SEQUENCE SYMBOL TABLE 48105000 + USING MCSEQ,RE SET USING FOR SEQ SYMBOL ENTRY 48110000 + LA RB,$LMCSEQ GET LENGTH OF ENTRY 48115000 + $ALLOCH RE,RB,MCBODOVR OBTAIN AREA FOR ENTRY 48120000 + ST RE,AVMSEQPT SAVE @ IN MAIN TABLE 48125000 + MVC 0($LMCSEQ,RE),AWZEROS ZERO ENTRY 48130000 + MVI MCSEQFLG,X'FF' SET DEFINED FLAG 48135000 + DROP RE CLEAR USING 48140000 + EJECT A 48145000 + USING RSBLOCK,RW SET USING FOR SOURCE STMNT 48150000 +MCBOD01 EQU * 48155000 + AIF (NOT &$MACOPC).MCBODYB SKIP IF NOT OPEN CODE S 48156000 + TM MCLBFLG2,$MCOCFL1 IN OPEN CODE ? S 48156100 + BO MACBODRT RETURN IF YES S 48156200 +.MCBODYB ANOP S 48156300 + L RW,AVRSBPT GET @ OF SOURCE STMNT 48160000 + $CALL INCARD READ NEXT STATEMNT 48165000 + LTR RB,RB ERROR ON INPUT 48170000 + BZ MCBOD02 JUMP ND PROCESS IF NOT 48175000 + $CALL ERRTAG ELSE FLAG STMNT 48180000 + TM AVTAGS2,$INEND2 END OF FILE? 48185000 + BO MACBODRT RETURN IF YES 48190000 +MCBOD02 EQU * 48195000 + LA RA,RSBSOURC SET SCAN POINTER 48200000 + ST RA,MCBDSRPT SAVE RSBSOURC @ FOR $SCOF USE 48205000 + MVI AVMBYTE2,X'00' ZERO FLAG BYTE 2 48210000 + MVI AVMBYTE4,X'00' CLEAR AVMBYTE4 48215000 + $CALL MACSCN SCAN STMT 48220000 + C RB,=F'8' MACRO COMMENT? 48225000 + BE MCBODPR1 JUMP AND PRINT IF YES 48230000 + LR RZ,RC COPY OPCODTB ENTRY @ INTO RZ 48235000 + DROP RW DROP USING ON SOURCE IMAGE 48240000 + USING MCBSU,RW SET UP USING ON BSU 48245000 + L RW,AVMCHSTR SET BASE FOR BSU WORKAREA 48250000 + MVC MCBSU(8),AWZEROS CLEAR FIRST BSU 48255000 + CLI AVMFLDT2,C'M' MACRO OPCODE? 48260000 + BE MCBODJMP IF YES, JUMP AND FIND WHICH OPCODE 48265000 + CLI AVMFLDT2,C'I' INNER MACRO INSTRUCTION? 48270000 + BNE MCBODSTR PROCESS MODEL STMT IF NOT S 48275000 + AIF (NOT &$MACOPC).MCBODYE SKIP IF NOT OPEN CODE S 48280000 + TM MCLBFLG2,$MCOCFL1 IN OPEN CODE ? S 48285000 + BO MCBODSTQ PROCESS MODEL STMT (NO INNER MACS) A 48286000 +.MCBODYE ANOP S 48287000 + B MCBDINMC PROCESS INNER MACRO S 48290000 +* THIS SECTION GETS THE TYPE OF OPERATION AND BRANCHES TO THE A 48290100 +* CODE TO PROCESS IT A 48290200 +MCBODBAS DS 0H 48295000 +MCBODJMP EQU * 48300000 + SR R2,R2 C3EAR R2 FOR INDEX ACTION 48305000 + IC R2,OPCHEX GET OPCODE INDEX 48310000 + LA R1,MCFLGTAB(R2) LOAD @ OF TABLE ENTRY S 48310500 + MVC *+7(1),1(R1) MOVE MASK INTO NEXT TM INSTR S 48311000 +* NOTE: THE NEXT INST IS MODIFIED BY THE PREVIOUS INST S 48311500 + TM MCLBFLG2,$ TEST IF CARD OUT OF ORDER S 48312000 + BO MACMACRO BRANCH IF CARD OUT OF ORDER S 48313000 + OC MCLBFLG2(1),0(R1) SET CURRENT OPCODE FLAG S 48314000 + LH R1,MACBINDX(R2) GET REL @ FROM TABLE 48315000 + B MCBODBAS(R1) JUMP TO ROUTINE 48320000 + SPACE 2 48325000 +MACBINDX $AL2 MCBODBAS,(MACMACRO,MACGBLA,MACGBLB,MACGBLC,MACLCLA,MACLCX48330000 + LB,MACLCLC,MACACTR,MACSETA,MACSETB,MACSETC,MACAIF,MACAGOX48335000 + ,MACANOP,MACMNOTE,MACMEXIT,MACMEND),-2 48340000 + EJECT S 48340100 +* THIS MACRO FLAG TABLE IS USED TO EITHER SET OR TEST A FLAG S 48340200 +* TO CHECK IF A MACRO OPCODE IS OUT OF ORDER. S 48340300 +* ......THE FIRST BYTE OF EACH TWO BYTE ENTRY CONTAINS THE S 48340400 +* FLAG TO BE SET INTO MCLBFLG2 WHEN THE OPCODE IS S 48340500 +* ENCOUNTERED. THE SECOND BYTE IS USED TO TEST AGAINST S 48340600 +* MCLBFLG2 TO SEE IF THE CURRENT OPCODE IS OUT OF ORDER. S 48340700 +* S 48340800 +* SET , TEST OPCODE S 48340900 +* --- ---- ------ S 48341000 +* S 48341050 +MCFLGTAB EQU *-2 ORIGIN OF HALF-WORD TABLE A 48341075 + DC AL1(0,$MGBLFLG) MACRO A 48341100 + DC AL1(0,$MGBLFLG) GBLA S 48341200 + DC AL1(0,$MGBLFLG) GBLB S 48341300 + DC AL1(0,$MGBLFLG) GBLC S 48341400 + DC AL1($MGBLFLG,$MLCLFLG) LCLA S 48341500 + DC AL1($MGBLFLG,$MLCLFLG) LCLB S 48341600 + DC AL1($MGBLFLG,$MLCLFLG) LCLC S 48341700 + DC AL1($MACTFLG,$MACTFLG) ACTR S 48341800 + DC AL1($MACTFLG,0) SETA S 48341900 + DC AL1($MACTFLG,0) SETB S 48342000 + DC AL1($MACTFLG,0) SETC S 48342100 + DC AL1($MACTFLG,0) AIF S 48342200 + DC AL1($MACTFLG,0) AGO S 48342300 + DC AL1($MACTFLG,0) ANOP S 48342400 + DC AL1($MACTFLG,0) MNOTE S 48342500 + DC AL1($MACTFLG,0) MEXIT S 48342600 + DC AL1($MACTFLG,0) MEND S 48342700 + DROP RY CLEAR TEMP USING OF RY 48345000 + SPACE 2 48350000 + TITLE '***MCBODY - GBLX ROUTINES***' 48355000 + USING MCGLBDCT,RY ESTAB USING FOR GLOBAL ENTRY 48360000 +MACGBLA EQU * 48365000 +MACGBLB EQU * 48370000 +MACGBLC EQU * 48375000 + BAL RET,MCB01 CHECK FOR LABEL & OPERAND J 48410000 +MCGB04 EQU * 48455000 + ST RA,AVMTSCNP COPY SCAN POINTER TEMPRORARILY 48460000 + $CALL MCVSCN SCAN SYMBOL 48465000 + LTR RB,RB VARIABLE SYMBOL? 48470000 + BZ MCGB05 PROCESS IF OKAY 48475000 +* AS 48480000 + LA RB,$ERINVSY SET ERROR FLAG IF RB^=0 A 48485000 + B MCBDPRER AND JUMP AN4 FLAG 48490000 +* AT THIS POINT LEGAL SET SYMBOL A 48490100 +MCGB05 EQU * 48495000 + L RC,MCPARPNT GET PARAM LIST START @ 48500000 + $CALL MACFND SCAN PARAM LIST 48505000 + LTR RB,RB SYMBOL PRESENT 48510000 + BZ MCGBMD ERROR IF YES-QUIT A 48515000 +* LEGAL GLOBAL DECLARATION A 48540100 + L RC,AVMGDICT GET GLOBAL DICT POINTER 48545000 + $CALL MACFND SCAN GLOBAL DICT 48550000 + LR RY,RC MOVE DICT ENTRY TO REGULAR BASE 48555000 + LTR RB,RB SYMBOL PRESENT? 48560000 + BNZ MCGB07 JUMP AND PROCESS IF NOT PRESENT 48565000 + CLC MCGLBDEF,AVMMACID ELSE IS IT PREV DEFINED THIS DEF? 48570000 + BE MCGBMD MULT DEF IF YES 48575000 + CLC MCGLBTYP,AVMBYTE3 DO TYPES MATCH? 48580000 + BNE MCGBMD IF NOT, THEN ERROR 48585000 + LA RC,1 SET DIMENSION=1 FOR NO DIMEN A 48587000 + CLI 0(RA),C'(' SYMBOL DIMENSIONED? 48590000 + BNE MCGB08 IF NOT, PROCEED 48595000 + BAL RET,MCB02 GET DIMENSION J 48600000 +MCGB08 EQU * COME HERE TO CHECK SIZES= A 48650000 + CH RC,MCGLBDIM DIMENSIONS M1TCH? 48655000 + BE MCGB10 PROCEED IF YES 48660000 + B MCGBMD AND JUMP AND FLAG MULT DEF ERROR 48670000 + SPACE 48695000 +MCGB07 EQU * 48700000 + LA RC,1 SET DIMENSION TO 1 48705000 + CLI 0(RA),C'(' DIMENSIONED? 48710000 + BNE MCGB11 PROCEED WITH SINGLE DIM IF NOT 48715000 + BAL RET,MCB02 GET DIMENSION J 48720000 + BAL RET,MCB03 CHECK SIZE J 48725000 +MCGB11 EQU * 48785000 + LA RB,$LGLBENT GET LENGTH OF GLOBAL ENTRY 48790000 + $ALLOCL RE,RB,MCBODOVR GET AREA FOR ENTRY 48795000 + ST RE,MCGLBNXT SAVE POINTER IN PREV ENTRY 48800000 + LR RY,RE MOVE BASE TO NEW ENTRY 48805000 + MVC MCGLBNXT($LGLBENT),AWZEROS CLEAR NEW ENTRY 48810000 + MVC MCGLBLEN(9),AVMSYMLN MOVE SYMABOL INTO ENTRY 48815000 + MVC MCGLBTYP,AVMBYTE3 SAVE TYPE IN ENTRY 48820000 + STH RC,MCGLBDIM SAVE DIMENSI6N IN ENTRY 48825000 + SR RE,RE CLEAR RE 48830000 + IC RE,AVMBYTE3 PLACE TYPE LENGTH IN RE 48835000 + CLI AVMBYTE3,$CHAR WAS IT CHARACTER? 48840000 + BE MCGB12 IF YES , PROCEED WITH LENGTH OF 12 48845000 + LA RE,4 ELSE USE LNG OF 4 FOR BOOL & ARITH A 48850000 +MCGB12 LH RD,MCGLBDIM GET DIMENSION OF ARRAY 48855000 + SR R0,R0 CL1R R0 FOR USE IN LOOP 48860000 +MCGB13 EQU * 48865000 + $ALLOCL RB,RE,MCBODOVR GET AREA FOR ELEMENT 48870000 + ST R0,0(RB) INITIALIZE TO ZERO 48875000 + BCT RD,MCGB13 LOOP BACK IF NOT FINISHED 48880000 + SPACE 2 48885000 +MCGB10 EQU * 48890000 + MVC MCGLBDEF,AVMMACID SAVE CURRENT DEF ID 48895000 + CLI 0(RA),C' ' END OF OPRND LIST? 48900000 + BE MCBODPR JUMP AND PRINT IF YES 48905000 + CLI 0(RA),C',' PROPER DELIMITER? 48910000 + BNE MCGBINVD INVALID DELIM-GO FLAG A 48915000 + LA RA,1(RA) BUMP SCAN POINTER PAST ',' 48920000 + B MCGB04 AND RESUME SCAN 48925000 + DROP RY CLEAR RY USING AFTER GLOBAL USE 48930000 + TITLE '***MCBODY - LCLX ROUTINES***' 48935000 + USING MCLCLDPV,RY USE RY AS BASE FOR LOCAL ENTRIES 48940000 +MACLCLA EQU * 48945000 +MACLCLB EQU * 48950000 +MACLCLC EQU * 48955000 + BAL RET,MCB01 CHECK FOR LABEL & OPERAND J 48990000 +MCLC04 EQU * 49035000 + ST RA,AVMTSCNP COPY SCAN POINTER 49040000 + $CALL MCVSCN SCAN FOR LEGAL VAR SYMBOL 49045000 + LTR RB,RB OKAY? 49050000 + BNZ MCBDPRER IF NOT, JUMP AND FLAG 49055000 + LR R0,RA COPY NEW SCAN POINTER VALUE TEMP 49060000 + L RA,AVMTSCNP GET ORIGINAL SCAN POINTER 49065000 + $CALL MCSYSR SEARCH ALL DICTS FOR SYMBOL 49070000 + LTR RB,RB PRESENT ALREADY? 49075000 + BZ MCGBMD GO FLAG MULTIPLE DEFINITION A 49080000 + LR RA,R0 RESTORE SCAN POINTER 49115000 + LR RY,RC MOVE BASE TO USING REG RY 49120000 + LA RB,$LLCLDV GET LENGTH OF LCAL DV 49125000 + $ALLOCL RE,RB,MCBODOVR GET AREA FOR ENTRY 49130000 + MVC 0($LLCLDV,RE),AWZEROS ZERO OUT ENTRY 49135000 + ST RE,MCLOCNXT SAVE POINTER IN PREV ENTRY 49140000 + LR RY,RE MOVE BASE TO NEW ENTRY 49180000 + MVC MCLCLLEN(9),AVMSYMLN MOVE NAME INTO NEW ENTRY 49190000 + MVC MCLCLTYP,AVMBYTE3 ESTABLISH TYPE OF SET SYMBOL ENTRY 49195000 + MVC MCLCLDIM,AWH1 SET DIM = 1 FOR PRESENT 49200000 + CLI 0(RA),C'(' DIMENSIONED? 49205000 + BNE MCLCFT IF NOT, PROCEED 49210000 + BAL RET,MCB02 GET DIMENSION J 49215000 + SPACE 49240000 +MCLC07 EQU * 49245000 + BAL RET,MCB03 CHECK DIMENSION SIZE J 49250000 +MCLC08 EQU * 49270000 + STH RC,MCLCLDIM SET DIMENSION IN ENTRY 49275000 +MCLCFT EQU * 49320000 + LA R1,4 ASSUME LENGTH = 4 49365000 + TM MCLCLTYP,$CHAR TEST FOR TYPE 49370000 + BNO MCLC11 SKIP IF NOT CHAR 49375000 +* ASSEMBLER G CAHRACTER DECL WILL CHANGE FOLLOWING. 49380000 + LA R1,12 ELSE USE CHAR LENGTH OF ENTRY 49385000 +MCLC11 EQU * 49390000 + MH R1,MCLCLDIM GET TOTAL SIZE OF ARRAY 49395000 + L RE,MCLOCDLN GET CURRENT OFFSET/LENGTH A 49398000 + ST RE,MCLCLPNT STORE AS OFFSET TO THIS VAR A 49400000 + AR R1,RE UPDATE TOTAL DICT LENGTH A 49402000 + ST R1,MCLOCDLN SAVE LENGTH OF LOCAL DICT IN MACLIB 49405000 + SPACE 1 A 49406000 + CLI 0(RA),C' ' WAS THIS LAST ONE? A 49407000 + BE MCBODPR YES QUIT AND PRINT A 49408000 + CLI 0(RA),C',' OK DLM A 49409000 + BNE MCGBINVD NO, ERROR KILL IT A 49410000 + LA RA,1(,RA) BUMP SCAN PTR TO NEXT OPRND A 49411000 + B MCLC04 RETURN FOR NEXT OPRND A 49412000 + DROP RY DROP TEMP USING OF RY FOR LOCALS 49415000 + EJECT A 49415100 +**--> INSUB: MCB01 CHECK LCLX,BLX FOR LABEL, OPCODE + + + + + + J 49415110 +*+ +A 49415120 +*+ THIS IS CALLED TO CHECK FOR AN ERROR IN THE GBLX OR A 49415130 +*+ GBLX INSTRUCTION. IF AN ERROR OCCURES WHEN A LABEL IS PRESENTA 49415140 +*+ AND/OR THERE IS NO OPERANDS. A 49415150 +*+ A 49415160 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A 49415170 + SPACE 2 A 49415180 +MCB01 EQU * J 49415190 + MVC AVMBYTE3,OPCMASK GET TYPE OF SET SYMBOL A 49415200 + CLI AVMFLDL1,0 CHECK IF LABEL PRESENT(L^=0) A 49415210 + BE MCB001 IF NOT PROCEED J 49415220 + ST RET,MCB##SAV SAVE THE RETURN @ J 49415225 + LA RB,$ERILLAB ELSE SET ERROR FLAG A 49415230 + $CALL ERRLAB AND FLAG STMT A 49415240 + L RET,MCB##SAV RESTORE RETURN @ J 49415245 +MCB001 EQU * J 49415250 + L RA,AVMFLD3 GET @ OPERAND; =0 IF NONE A 49415260 + LTR RA,RA DID ONE EXISTS A 49415270 + BCR NZ,RET YES-RET, NORMAL CASE A 49415280 + B MCBDOPER NO-ERROR-MISSING OPERAND A 49415290 + SPACE 5 A 49415300 +**--> INSUB: MCB02 OBTAIN DIMENSION OF GBLX OR LCLX STMT + + + + J 49415310 +*+ BUNPS POINTER GETS DIMENSION AND FLAGS ERROR IF NOT CONST QA 49415320 +*+ RA= @ '(' ON ENTRY; @ BEYOND '(' ON EXIT IF GOOD A 49415322 +*+ RC=VALUE OF SUBSCRIPT IF GOOD A 49415324 +*+ + + + + + + + + + ++ + + + + + + + + + + + + + + + + + + + + + + +A 49415330 + SPACE 5 A 49415340 +MCB02 ST RET,MCB##SAV SAVE RETURN @ J 49415345 + LA RA,1(RA) BUMP PTR PAST ) J 49415350 + $CALL SDDTRM AND GET DIMENSION A 49415360 + LTR RB,RB DIMENSION=CONSTANT? A 49415370 + BNZ MCBDPRER FLAG ERROR IF NOT A 49415380 + CLI 0(RA),C')' CURRENT ENDING DLM A 49415382 + BNE MCGBINVD NO ERROR A 49415383 + LA RA,1(,RA) YES BUMP BEYOND ) A 49415384 + L RET,MCB##SAV RESTORE RETURN @ J 49415385 + BR RET RETURN A 49415390 + SPACE 5 A 49415400 +**--> INSUB: MCB03: CHECK DIMENSION SIZE FOR GBLX,LCLX+ + + + + + + + J 49415410 +*+ CHECKS TO MAKE SURE DIMENSION OF + A 49415420 +*+ GBLX AND/OR LCLX IS WITHIN RANGE + A 49415430 +*+ FLAGS ERROR IF NOTS WITHIN RANGE + A 49415440 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + A 49415450 + SPACE 2 A 49415460 +MCB03 C RC,=F'2500' DIMENSION WITHIN RANGE? J 49415470 + BCR NH,RET RETURN IF NOT J 49415480 + LA RB,$EREXGTA ELSE SET ERROR FLAG A 49415490 + B MCBDPRER AND FLAG STMT A 49415500 + TITLE '***MCBODY - SET INSTRUCTION ROUTINES***' 49420000 +* A 49420100 +* SETX SYMBOLS FOUND, SET FLAG FOR TYPE & CONTINUE SCAN OF EXPRESSION A 49420200 +* A 49420300 +MACSETA EQU * 49425000 + MVI AVMBYTE3,$ARITH SET ARITH TYPE FLAG 49430000 + B MACSET 49435000 +MACSETB EQU * 49440000 + MVI AVMBYTE3,$BOOL SET BOOLEAN FLAG 49445000 + B MACSET 49450000 +MACSETC EQU * 49455000 + MVI AVMBYTE3,$CHAR SET CHARACTER TYPE FLAG 49460000 +* A 49460100 +* CKECK FOR LEGAL SETUP IE, NO OPERAND ERRORS, NO LABEL A 49460200 +* ON STATEMENT, ERROR IF LOOKS LEGAL, GO ON ELSE FLAG ERROR A 49460300 +* A 49460400 +MACSET EQU * 49465000 + BAL RET,MCB001 CHECK FOR OPERND,GET@ A 49475000 + L RA,AVRSBPT GET SOURCE BLOCK ADDRESS 49490000 + LA RA,4(RA) BUMP TO SOURCE STMNT 49495000 + CLI AVMFLDL1,X'00' LABEL PRESENT? 49500000 + BNE MCBDST03 PROCEED IF YES 49505000 + LA RB,$ERNONAM SET MISSING LA&EL FLAG 49510000 + B MCBDPRER JUMP AND FLAG ERROR 49515000 +* GET THE BSU ADDRESS SET TYPE & IF NEITHER OF THE SET TYPES-ERROR A 49515100 +* A 49515200 +MCBDST03 EQU * 49520000 + LR RC,RW SET POINTER TO BSU 49525000 + $CALL MACLEX SCAN LABEL FIELD 49530000 + LTR RB,RB ERROR? 49535000 + BNZ MCBDPRER JUMP OUT IF YES 49540000 + LR RW,RC RESTORE BSU POINTER 49545000 + L RE,AVMCHSTR GET @ OF BSU WORKAREA 49550000 + CLI AVMBYTE3,$BOOL IS SET A, B, OR C 49555000 + BH MCSETCHR CHR IF HIGHER 49560000 + BE MCSETBOL BOOLEAN IF EQUAL 49565000 + OI AVMBYTE2,$MINARIT ELSE IS ARITHMETIC 49570000 + MVI MCBSINDX,$BSETA SET BSU INDEX FOR SETA 49575000 + CLI 1(RE),$BSTSYAG IS IT GLOBAL ARITH SET SYSMB? 49580000 + BE MCBDST01 IF YES, OKAY 49585000 + CLI 1(RE),$BSTSYAL ELSE IS IT LOACAL ARITH SET SYMBOL? 49590000 + BE MCBDST01 IF YES, OKAY 49595000 + B MCLMXDER ELSE FLAG ERROR 49600000 +* A 49600100 +* CHECKS THE FORMAT OF SETB-MAKE SURE ITS 0 OR 1, PARENS LEGAL A 49600200 +* THEN CHECKS FOR GLOBAL OR LOCALS A 49600300 +* A 49600400 +MCSETBOL EQU * 49605000 + L RA,AVMFLD3 GET OPERAND @ 49610000 + CLI 0(RA),C'(' STARTS WITH LEFT PAREN? 49615000 + BE MCSETB01 OKAY IF YES 49620000 + CLI 0(RA),C'1' OPERAND = 1? 49625000 + BE MCSETB01 OKAY IF YES 49630000 + CLI 0(RA),C'0' OPERAND = 0? 49635000 + BE MCSETB01 OKAY IF YES 49640000 + LA RB,$ERINVF ELSE SET INVALID FIELD FLAG 49645000 + B MCBDPRER JUMP AND FLAG STMTN 49650000 +MCSETB01 EQU * 49655000 + OI AVMBYTE2,$MINBOOL SET BOOLEAN FLAG 49660000 + MVI MCBSINDX,$BSETB SET BSU INDEX 49665000 + CLI 1(RE),$BSTSYBG IS IT BOOLEAN GLOBAL SET? 49670000 + BE MCBDST01 OKAY IF YES 49675000 + CLI 1(RE),$BSTSYBL ELSE IS IT BOOLEAN LOCAL SET? 49680000 + BE MCBDST01 OKAY IF YEW 49685000 + B MCLMXDER ELSE FLAG EROR 49690000 +* A 49690100 +* CHECK FOR LEGAL SETC SYMBOL A 49690200 +* A 49690300 +MCSETCHR EQU * 49695000 + MVI MCBSINDX,$BSETC SET BSU INDEX 49700000 + OI AVMBYTE2,$MINCHAR SET CHAR FLAG 49705000 + CLI 1(RE),$BSTSYCG IS IT CHAR GLOBAL SET SYMBOL? 49710000 + BE MCBDST01 OKAY IF YES 49715000 + CLI 1(RE),$BSTSYCL ELSE IS IT CHAR LOCAL SET? 49720000 + BNE MCLMXDER ERROR IF NOT 49725000 +MCBDST01 EQU * 49730000 +* A 49730100 +* SETS HIERARCHY OF BSU, SETS FLAGA & MOVES ADRESS THEN SCANS A 49730200 +* THE OPERAND, IF IN ERROR, FLAGS IT A 49730300 +* A 49730400 + MVI MCBSHIER,$MSETHR SET HEERARCHY 49735000 + OI MCBSFLGS,$MOPRTR SET OPERATOR FLAG IN BSU 49740000 + L RA,AVMFLD2 GET @ OF OPCODE 49745000 + $SCOF RB,RA,MCBSOFST GET OPCODE @ INTO BSU 49750000 + BAL RE,MCBDBMP BUMP BSU POINTER 49755000 + LR RC,RW MOVE BSU POINTER TO RC 49760000 + L RA,AVMFLD3 GET ADDRESS OF OPERAND 49765000 + $CALL MACLEX SCAN OPERAND 49770000 + LTR RB,RB ERROR 49775000 + BNZ MCBDPRER FLAG STMNT IF YES 49780000 + B MCBODPR JUMP TO FOOT 49785000 + TITLE '***MCBODY - AGO,AIF, MNOTE ETC ROUTINES***' 49790000 +* WHEN AN ACTR STATEMENT FOUND, SETS FLAG FOR NO MORE GLOBALS OR A 49790100 +* LOCALS. SEES IF ACTR STMT OK, THEN CHECKS IF LABEL PRESENT(ERROR) A 49790200 +* CHECKS FOR OPERANDS(ERROR IF NOT THERE) SETS INDEX(COUNTER) & SETS A 49790300 +* UP THE BSU. A 49790400 +* A 49790500 +MACACTR EQU * 49795000 + BAL RET,MCB01 CHECK OPRND @ EXISTENCE A 49840000 + MVI MCBSFLGS,$MTERM+$BSAR SET BSU FLAGS 49880000 + MVI MCBSINDX,$BSTSYAL SET LOCAL ARITH SET INDEX 49885000 + MVC MCBSLOC,MCDDVPNT MOVE @ OF ACTR TO BSU 49890000 + BAL RE,MCBDBMP BUMP BSU 49895000 + L RD,MCBDSET CREATE BSU S 49900000 + BAL RE,MCBDBMP0 BUMP BSU POINTER S 49905000 + OI AVMBYTE2,$MINARIT SET ARITH EXPRESSION FLAG 49910000 + LR RC,RW GET BSU POINTER 49915000 + $CALL MACLEX SCAN EXPRESSION 49920000 + LTR RB,RB ERROR? 49925000 + BNZ MCBDPRER FLAG IF YES 49930000 + LR RW,RC RESTORE BSU POINTER 49935000 + B MCBODPR JUMP AND PRINT STMNT 49940000 + SPACE 2 49945000 +* AIF FOUND, CHECK FOR LEGAL SEQUENCE, NO LCLX OR GBLX, AND SYNTAX A 49945100 +* MUST START WITH ( AND HAVE SEQ SYMB FOLLOWING, THEN SETS UP THE A 49945200 +* BSU WITH THE ADDRESSES. A 49945300 +* A 49945400 +MACAIF EQU * 49950000 + BAL RET,MCBDCHLB CHECK FOR LEGAL LABEL 49960000 + BAL RET,MCB001 CHECK OPRND @ EXISTENCE A 49965000 + CLI 0(RA),C'(' FIRST CHAR = '('? 49980000 + BE MACAIF01 PROCEED IF YES 49985000 + LA RB,$ERVSYNT SET SYNTAX FLAG 49990000 + B MCBDPRER AND FLAG ERROR 49995000 +MACAIF01 EQU * 50000000 + OI AVMBYTE2,$MINPEXP+$MINBOOL SET FLGS FOR PAREN SCAN 50005000 + LR RC,RW GET BSU POINTER 50010000 + $CALL MACLEX SCAN OPERAND 50015000 + LR RW,RC RESTORE BSU POINTER 50020000 + LTR RB,RB ERROR? 50025000 + BNZ MCBDPRER FLAG IF YES 50030000 + CLI 0(RA),C'.' SEQ SYMBOL AFTER EXPRESSION? 50035000 + BNE MCBDISER ERROR IF NOT 50040000 + MVC MCBSFLGS(4),MCBDAIF A 50045000 + L R2,AVMFLD2 GET OFFSET OF OPCODE 50055000 + $SCOF R1,R2,MCBSOFST INSERT OFFSET IN BSU 50060000 + BAL RE,MCBDBMP BUMP BSU 50070000 + L RD,MCBDLABL GET FIRST HALF OF BSU A 50075000 +* A 50080000 + B MACAGO03 S 50085000 + SPACE 2 50100000 +* SAME THING WITH AGO, CKS SYNTAX, LEGAL SEQ, ETC AND SETS UP A 50100100 +* THE BSU A 50100200 +* A 50100300 +MACAGO EQU * 50105000 + BAL RET,MCBDCHLB CHECK FOR LEGAL CLABEL 50115000 + BAL RET,MCB001 CHECK OPRND GET @ A 50120000 + CLI 0(RA),C'.' POSSIBLE SEQ SYMBOL? 50135000 + BE MACAGO02 PROCEED IF YES 50140000 + LA RB,$ERINVSY ELSE SET BAD SYMBOL FLAG 50145000 + B MCBDPRER AND FLAG STATEMNT 50150000 +MACAGO02 EQU * 50155000 + L RD,MCBDAGO CREATE BSU S 50160000 +MACAGO03 ST RA,MCBSLOC SAVE @ OF LABEL S 50165000 + B MCBODPR0 PRINT STATEMENT S 50170000 + SPACE 2 50180000 +MACANOP EQU * 50185000 + MVI MCBSINDX,$BSANOP INSERT BSU ANOP INDEX 50190000 + B MACAMM 50195000 +MACMEXIT EQU * 50200000 + MVI MCBSINDX,$BSMEXIT SET MEXIT BSU 50205000 + B MACAMM 50210000 +MACMEND EQU * 50215000 + MVI MCBSINDX,$BSMEND SET MEND BSU INDEX 50220000 +MACAMM EQU * 50225000 + BAL RET,MCBDCHLB CHECK FOR LEGAL LABEL 50235000 + MVI MCBSFLGS,$MOPRTR SET OPRTR FLAG 50240000 + MVI MCBSHIER,$MPRNTHR SET PRINT HIERARCHY 50245000 + L RA,AVMFLD2 GET OPCODE @ 50250000 + $SCOF RB,RA,MCBSOFST PUT OFFSET IN BSU 50255000 + BAL RE,MCBDBMP BUMP BSU POINTER A 50255100 + B MCBODPR A 50260000 + SPACE 2 50270000 +* MNOTE STMT FOUND, CKS FOR VALID SYNTAX, CREATES BSU. SCANS STRING A 50270100 +* FOR MESSAGE, ALSO CHECKING SYNTAX(INVALID DELIM ETC) CONCATS IFL A 50270200 +* NECESSARY A 50270300 +* A 50270400 +MACMNOTE EQU * 50275000 + BAL RET,MCBDCHLB CHECK FOR LABEL 50285000 + CLI AVMFLDL3,X'00' OPRND PRESENT? 50290000 + BE MCBDOPER ERROR IF NOT 50295000 + BAL RET,MCBDPFLC CREATE PRINT BSU AND BUMP PTR F 50300000 + MVC MCBSU(8),MCBDSTG1 COPY WHOLE BSU FROM TABLE J 50315000 + BAL RE,MCBDBMP BUMP BSU POINTER 50320000 + L RA,AVMFLD3 GET OPRND @ 50325000 + BAL RET,MCBDPFLC CREATE PRINT BSU AND BUMP PTR F 50330000 + CLI 0(RA),C'''' QUOTED STRING? 50335000 + BNE MCMNOT01 50340000 + MVC MCBSU(8),MCBDSTG2 COPY WHOLE BSU= '1,' BSU J 50355000 + BAL RE,MCBDBMP 50360000 + NI AVMBYTE2,255-($MTERM+$MOPRTR) TURN OFF PREV IND FLAG 50365000 + OI AVMBYTE2,$MTERM SET TERM PREV FLAG 50370000 + B MCMNOT04 50375000 +MCMNOT01 EQU * 50380000 + $SETRT (',',4,'''',8) SET TABLE FOR SCAN 50385000 + SR RE,RE 50390000 + IC RE,AVRSBLOC GET LENGTH-1 50395000 + S RA,AVRSBPT GET OFFSET OF RA 50400000 + SR RE,RA SUBTRACT OVERALL LENGTH 50405000 + A RA,AVRSBPT RESTORE RA 50410000 + EX RE,MCMNOTSC 50415000 + $SETRT (',',0,'''',0) RESTORE TABLE 50420000 + BNZ MCMNOT02 PROCEED IF SCAN STOPPED ON CHAR 50425000 +MCMNOTER EQU * 50430000 + LA RB,$ERNODLM ELSE SET BAD DELIM FLAG 50435000 + B MCBDPRER AND FLAG STMT 50440000 +MCMNOT02 EQU * 50445000 + CLI 0(R1),C',' STOP ON COMMA? 50450000 + BNE MCMNOTER ERROR IF NO 50455000 + LA RB,1(R1) GET DELIM @ 50460000 + SR RB,RA GET LENGTH IN RB 50465000 + BAL RET,MCBDSCAN SCAN SEVERITY EXPRESSION 50470000 +MCMNOT04 EQU * 50475000 + CLI 0(RA),C'''' QUOTE? 50480000 + BNE MCMNOTER ERROR IF NOT 50485000 + BAL RET,MCBDCATI INSERT CAT OPRTR 50490000 + OI AVMBYTE2,$MINCHAR SET CHAR STRING FALG 50495000 + LR RC,RW GET BSU PNTR 50500000 + $CALL MACLEX SCAN STRING 50505000 + LR RW,RC BUMP BSU PNTR 50510000 + LTR RB,RB ERROR 50515000 + BNZ MCBDPRER FLAG IF YES 50520000 + MVI AVMFLDT2,X'00' ZERO TYPE BYTE 50525000 + L RD,MCBDPR2 CREATE BSU S 50535000 + L RA,AVMFLD3 GET OPRND @ 50540000 + CLI 0(RA),C'*' COMMNET? 50545000 + BE MCBODPR0 SKIP IF YES S 50550000 + L RD,MCBDPR3 MNOTE BSU A 50555000 + B MCBODPR0 PRINT STATEMENT S 50565000 +MCMNOTMS DC CL12'***MNOTE***' 50575000 +MCMNOT1C DC C'1,' DEFAULT MNOTE SEVERITY J 50576000 +MCMNOTSC TRT 0($,RA),AWTZTAB DUMMY FOR COMMA QUOTE SCAN 50580000 + SPACE 2 50585000 +MACMACRO EQU * 50590000 + L RA,AVMFLD2 GET OPCODE @ IN RA 50595000 + LA RB,$ERSTMNA SET STMNT NO GOOD FLAG 50600000 + B MCBDPRER JUMP AND FLAG ERROR 50605000 + TITLE '***MCBODY - STRING, INNER MACRO AND OPCODE ROUTINES***' 50610000 +* CHECKS COMMENT, SETS PRINT BSU IF STMT SHOULD BE PRINTED AND/OR A 50610100 +* DOESN'T PRINT SEQ SYMBOLS IN MACRO, OR MACRO COMMENTS. ALSO A 50610200 +* MOVES OPCODE DATA IN IF PRESENT A 50610300 +* A 50610400 +MCBODSTQ EQU * A 50610500 + MVI AVMFLDT2,0 OPEN CODE FAKE FOR MODEL STMT A 50610600 +MCBODSTR EQU * 50615000 + C RB,AWF4 COMMENT? 50620000 + BE MCBODCOM ORDINARY COMMENT IF EQUAL 50625000 + OI MCLBFLG2,$MACTFLG GLBL'S, ETC. NO LONGER OK S 50630000 +MCBDSTIN EQU * 50635000 + CLI AVMFLDT1,C'.' SEQ SYMBOL? 50640000 + BE MCBDOPCD PROCESS OPCODE IF YES 50645000 + L RA,AVMFLD1 ELSE GET PNTR TO LABEL FIELD 50650000 + LTR RA,RA LABEL PRESENT 50655000 + BZ MCBDOPCD PROCESS OPCODE IF NOT 50660000 + BAL RET,MCBDPFLC CREATE PRINT BSU, NON COMMENT TYPE A 50665000 + IC RB,AVMFLDL1 GET LENGTH OFLABEL FIELD 50670000 + SR RC,RC SET TERMINAL CHAR INDICATOR S 50675000 + BAL RET,MCBDSCAN SCAN LABEL FIELD 50680000 +MCBDOPCD EQU * 50685000 + CLI AVMFLDL2,X'00' OPCODE EXISTS? 50690000 + BE MCBDSFIN FINI IF NOT 50695000 + MVC MCBDFLDS(5),AVMFLD2 ELSE MOVE OPCODE FIELD DATA 50700000 + SR RC,RC INDICATE VAR SYMBOLS PRESENT 50705000 + BAL RET,MCBDSCFD SCAN OPCODE FIELD 50710000 +* A 50710100 +* SCANS OPERAND FIELD ALLOWING FOR NON-STANDARD CONTINUATIONS A 50710200 +* THAT IS RUNNINF ACROSS UP TO 3 CARDS, BALS TO MCBDSCFD TO TEST FOR A 50710300 +*THE DIFFERENT FIELDS. A 50710400 +* A 50710500 +MCBDOPRN EQU * 50715000 + MVC MCBDFLDS(5),AVMFLD3 GET DATA FOR OPRND FILED 50720000 + SR RC,RC CLEAR RC FOR VAR SYMBOLS 50725000 + BAL RET,MCBDSCFD SCAN OPRND FILED 50730000 + MVC MCBDFLDS(5),AVMFLD4 GET DATA FOR COMMENT FIELD 50735000 + LA RC,4 INDICATE NO VAR SYMBOLS 50740000 + BAL RET,MCBDSCFD SCAN COMMNET FIELD 50745000 + CLI AVMFLDL5,0 2ND NON STND CARD? 50750000 + BE MCBDSFIN FINI IF NOT 50755000 + MVC MCBDFLDS(5),AVMFLD5 GET DATA ON 2ND CARD OPRND 50760000 + SR RC,RC INCICATE VAR SYMBOLS 50765000 + BAL RET,MCBDSCFD SCAN OPNRD ON 2ND CARD 50770000 + MVC MCBDFLDS(5),AVMFLD6 GET DATA ON COMMNET FIELD( IF ANY) 50775000 + LA RC,4 INDICATE NO VAR SYMBOLS 50780000 + BAL RET,MCBDSCFD SCAN COMMNET FIELD 50785000 + CLI AVMFLDL7,0 3RD NON STND CARD? 50790000 + BE MCBDSFIN FINI IF NOT 50795000 + MVC MCBDFLDS(5),AVMFLD7 GET DATA ON OPRND 50800000 + SR RC,RC INDICATE VAR SYMBOLS 50805000 + BAL RET,MCBDSCFD SCAN OPRND 50810000 + LA RC,4 INDICATE NO VAR CYMBOLS 50815000 + BAL RET,MCBDSCFD SCAN 3RD CARD COMMENT(IF ANY) 50820000 +* A 50820100 +* END OF STATEMENT TEST FOR POSSIBLE INNER MACRO CALL, PROCESS A 50820200 +* ELSE, BUMP BSU POINTER, PRINT LINE, AND CONTINUE A 50820300 +* A 50820400 +MCBDSFIN EQU * 50825000 + L RD,MCBDPR2 CREATE BSU A 50830000 + CLI AVMFLDT2,C'I' INNER MACRO CALL 50835000 + BNE MCBODPR0 SKIP OUT IF NOT INNER MACRO CALL A 50840000 + L RD,MCBDINMA GET INNER MACRO BSU A 50860000 + B MCBODPR0 PRINT STATEMENT S 50870000 + SPACE 2 50880000 +**--> INSUB:MCBDFLD CREATES A PRINT BSU+ + + + + + + + + + + + + + +A 50880100 +*+ +A 50880200 +*+ CALLED TO CREATE A BSU SO STMT WILL BE PRINTED. IT ALSO +A 50880300 +*+ BUMPS THE BSU POINTER +A 50880400 +*+ +A 50880500 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A 50880600 + SPACE 2 A 50880700 +MCBDPFLC SR RC,RC ENTRY NON COMMENT TYPE PRINT BSU A 50884000 +MCBDPFLD EQU * 50885000 + LR RD,RA COMPUT OFFSET A 50890000 + S RD,MCBDSRPT A 50895000 + SLL RD,8 MOVE TO RIGHT BYTE A 50895050 + AL RD,MCBPRBSU(RC) GET PRINT BSU OR PRINT/COMMENT BSU A 50895100 + NI AVMBYTE2,255-($MTERM+$MOPRTR) TURN OFF PREV IND FLAG 50900000 + OI AVMBYTE2,$MOPRTR SET PREV INDICATOR TO OPRTR 50905000 + BAL RE,MCBDBMP0 BUMP BSU POINTER A 50910000 + BR RET 50915000 + SPACE 2 50920000 +**--> INSUB:MCBDSCFN LOOKS FOR FIELDS + + + + + + + + + + + + + +A 50920100 +*+ +A 50920200 +*+ SCAN FIELDS IN STMT, CREATES BSU'S, IF ONE EXISTS. RETURNS S 50920300 +*+ THE LENGTH AND ENDING ADDRESS. +A 50920400 +*+ +A 50920500 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A 50920600 + SPACE 2 A 50920700 +MCBDSCFD EQU * 50925000 + ST RET,MCBDSAVE SAVE RETURN @ 50930000 + L RA,MCBDFLD GET POINTER TO FIELD 50935000 + LTR RA,RA FIELD EXISTS? 50940000 + BZ MCBDSCFN FINI IF NOT 50945000 + SR RB,RB CLEAR RB TO CARRY LENGTH 50950000 + IC RB,MCBDFLDL GET LENGTH OF FIELD 50955000 + BAL RET,MCBDPFLD CREATE BSU 50960000 + BAL RET,MCBDSCAN SCAN FIELD 50965000 +MCBDSCFN EQU * 50970000 + L RET,MCBDSAVE RESTORE RETURN @ 50975000 + BR RET AND RETURN 50980000 +MCBDSAVE DS F CORE FOR RETURN @ 50985000 +MCBDFLDS DS 0F TEMP STORAGE FOR FIELD INFO 50990000 +MCBDFLD DS F POINTER TO FILED 50995000 +MCBDFLDL DS C LENGTH OF FIELD 51000000 +MCBDFLDT DS C TYPE OF FIELD 51005000 + SPACE 2 51010000 +* A 51010100 +* PROCESSES INNER MACRO CALLS MOVES OPCODE IN FIELD, SEARCHES A 51010200 +* FOR NAME IF LIBRARY, IF NOT THERE, MAKES NOTE OF REFERENCE FOR LATEA 51010300 +* SEARCH OR POSSIBLE ERROR A 51010500 +MCBDINMC EQU * 51015000 + OI MCLBFLG2,$MACTFLG GLBL'S, ETC. NO LONGER OK S 51020000 + SR R2,R2 CLEAR R2 FOR EX INST 51025000 + L R1,AVMFLD2 GET OPCODE @ 51030000 + IC R2,AVMFLDL2 GET LENGTH OF OPCODE 51035000 + BCTR R2,0 DECR BY ONE FOR EX INST 51040000 + MVC AVMSYMBL,AWBLANK CLEAR PREVIOUS NAME 51045000 + EX R2,MCBDINM1 MOVE OPCODE TO AVMBL A 51050000 + MVC AVMSYMLN,AVMFLDL2 MOEE LENGTH 51065000 + USING MACLIB,RC 51070000 + L RC,AVMACLIB GET @ OF MACLIB 51075000 + $CALL MACFND SEARCH MACRO LIBRARY 51080000 + LTR RB,RB SYMBOL FOUND? 51085000 + BZ MCBDSTIN PROCESS IF YES IN STRING CODE 51090000 + LA RE,$LMACLIB GET LENGTH OF MACLIB ENTRY 51095000 + $ALLOCL RD,RE,MCBODOVR GET SPACE FOR ENTRY 51100000 + ST RD,MCLIBNXT SAVE LINK IN PREV ENTRY 51105000 + LR RC,RD MOVE BASE TO RC 51110000 + MVC MACLIB($LMACLIB),AWZEROS ZERO NEW ENTRY 51115000 + MVC MCLBNMLN(9),AVMSYMLN MOVE NAME INTO LIB ENTRY 51120000 + B MCBDSTIN 51125000 +MCBDINM1 MVC AVMSYMBL($),0(R1) DUMMY FOR EXECUTE INSTRUCTION A 51125100 + DROP RC CLEAR USING 51130000 + SPACE 2 51135000 +MCBDSCAN EQU * 51140000 +**--> INSUB:MCBDSCAN SCANS STATEMENTS IN A MOCOR DEFINITION + + + + +A 51140100 +*+ +A 51140200 +*+ SETS DIFFERENT TRT TABLES UP DEPENDING ON WHERE CALLED FORM +A 51140300 +*+ IN ROUTINE +A 51140400 +*+ CHECKS BSU LIST AS TO WHICH VARIABLES NEED CONCATINATION +A 51140500 +*+ CREATES BSU & SETS FLAGS AS THE CONDITIONS WARRENT +A 51140600 +*+ SCANS STRINGS AND PROCESSES EXPRESSIONS WITH & VARIABLES +A 51140700 +*+ +A 51140800 +*+ NOTE: WE ASSUME THAT A PERIOD SHOWS CONCATENATION ONLY IF +J 51140820 +*& USED IMMEDIATELY AFTER A SET VAR/PARAMETER. +J 51140830 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A 51140900 + SPACE 2 A 51140950 + ST RET,MCBDSAV SAVE RETURN @ 51145000 + LA RY,0(RB,RA) GET DELIM @ 51150000 + LTR RC,RC LOOK FOR &'S? 51155000 + BNZ MCBDSC01 SKIP IF NO 51160000 +MCBDSC00 $SETRT ('&&',4) SET TO STOP ONLY ON & J 51165000 +MCBDSC01 EQU * 51170000 + LR R0,RA COPY SCAN POINTER 51175000 +MCBDSC0A EQU * 51180000 + XSNAP T=NO,STORAGE=(*AVRSBLOC,*AVRSBLOC+80,*0(RW),*8(RW)), S#51181000 + LABEL=' MCBDSC0A ',IF=(AVTAGSM,O,AJOMACRH,TM) S 51182000 + LR RB,RY GET FINAL @ IN RB 51185000 + SR RB,RA GET LENGTH IN RB 51190000 + LR R1,RY COPY DELIM @ IN R1 FOR TRT 51195000 + SR R2,R2 CLEAR R2 51200000 + IC R2,0(RA) GET 1ST CHAR 51205000 + LA RE,AWTZTAB(R2) USE AS PNTR TO TRT TABLE 51210000 + CLI 0(RE),X'04' '&', '.' OR BLANK? 51215000 + BE MCBDSCMP '&&' IF EQUAL 51225000 +MCBDSC02 EQU * FALL THRU MEANS NONTERMIANL 51230000 + TM AVMBYTE2,$MOPRTR PREV BSU = OPRTR? 51235000 + BO MCBDSC03 PROCEED IF YES 51240000 + BAL RET,MCBDCATI ELSE INSERT CAT OPRTR 51245000 +MCBDSC03 EQU * 51250000 + EX RB,MCBDTRSC SCAN STRING 51255000 + CLC 0(2,R1),=C'&&&&' STOP ON DOUBLE &? 51260000 + BNE MCBDSC04 51265000 + LA RA,2(R1) BUMP PAST &'S 51270000 + B MCBDSC0A AND RESUME SCAN 51275000 +MCBDSC04 EQU * 51280000 + LR RA,R0 ELSE GET START @ 51285000 + LR RB,R1 MOVE DELIM@ TO RB 51290000 + $CALL MCGTST MOVE STRING TO LOW CORE 51295000 + OI MCBSFLGS,$MTERM+$BSCHAR SET BSU FLAGS 51300000 + MVI MCBSINDX,$BSTRING SET BSU INDEX 51305000 + STC RD,MCBSTRLN STORE LEN IN BSU 51310000 + ST RC,MCBSLOC SAVE @ OF STING IN BSU 51315000 + NI AVMBYTE2,255-($MTERM+$MOPRTR) TURN OFF PREV IND FLAG 51320000 + OI AVMBYTE2,$MTERM SET PREV FLAG TO TERM 51325000 + BAL RE,MCBDBMP BUMP BSU OINTER 51330000 + CR RA,RY END OF STRING? 51335000 + BNL MCBDSCFT JUMP TO FOOT IF YES 51340000 + B MCBDSC01 ELSE RESUME SCAN 51345000 +MCBDSCMP EQU * 51350000 + CLI 1(RA),C'&&' TWO '&&'S? 51355000 + BNE MCBDSCM1 CONTINUE IF NOT 51360000 + LA RA,2(RA) BUMP SCN PNTR PAST &&'S 51365000 + B MCBDSC0A AND RESUME SCAN 51370000 +MCBDSCM1 EQU * 51375000 + TM AVMBYTE2,$MOPRTR PREV BSU = OPRTR? 51380000 + BO MCBDSCM2 PROCEED IF YES 51385000 + BAL RET,MCBDCATI ELSE INSERT CATEN OPRTR 51390000 +MCBDSCM2 EQU * 51395000 + OI AVMBYTE4,$MINSTRN SET IN STRING FLAG 51400000 + LR RC,RW MOVE BSU PNTR TO RC 51405000 + $SETRT ('&&',0) CLEAR TRT TABLE FOR MACLEX J 51410000 + XSNAP T=NO,STORAGE=(*0(RW),*8(RW)),LABEL='MCBDSCAN -- BSU #51411000 + BEFORE CALL TO MACLEX',IF=(AVTAGSM,O,AJOMACRH,TM) 51412000 + $CALL MACLEX 51415000 + LR RW,RC RESTORE BSU POINTER 51420000 + LTR RB,RB ERROR? 51425000 + BNZ MCBDPRER JUMP OUT IF YES 51430000 + CR RA,RY SCAN FINI? 51435000 + BNL MCBDSCFT JUMP OUT IF YES 51440000 +* CHECK FOR . AFTER &VARIABLE - ONLY CASE IN WHICH . J 51445000 +* IS NOT AN ORDINARY CHARACTER. J 51450000 + CLI 0(RA),C'.' . AFTER &VARIABLE ? J 51455000 + BNE MCBDSC00 NO, GO BACK FOR NEXT SCAN J 51460000 + LA RA,1(,RA) YES, BUMP OVER = CONCATENATION J 51465000 + B MCBDSC00 GO BACK FOR NEXT CHARACTER J 51470000 +MCBDSCFT EQU * 51485000 + $SETRT ('&&',0) MAKE SURE TRT TABLE CLEARED J 51490000 + XSNAP T=NO,STORAGE=(*0(RW),*8(RW)),LABEL='MCBDSCAN -- BSU #51493000 + BEFORE RETURN ',IF=(AVTAGSM,O,AJOMACRH,TM) 51494000 + L RET,MCBDSAV RESTORE RETURN @ 51495000 + BR RET AND RETURN 51500000 +MCBDSAV DS F CORE FOR RETURN @ 51505000 +MCBDTRSC TRT 0(0,RA),AWTZTAB DUMMY TO SCAN STRING 51510000 + SPACE 2 51515000 +* ORDINARY COMMENT, SET UP BSU AND CRETE CODE A 51515100 +* A 51515200 +MCBODCOM EQU * 51520000 + L RD,MCBPRBSU CREATE BSU A 51525000 + OI AVMBYTE2,$MOPRTR SET PREV FLAG TO OPERTR 51530000 + BAL RE,MCBDBMP0 BUMP BSU POINTER A 51535000 + SR RB,RB 51540000 + IC RB,AVRSBLOC GET LENGTH-1 OF STMT 51545000 + S RB,AWF3 DECR FOR STND PART 51550000 + L RA,MCBDSRPT GET PNTR TO SOURCE 51555000 + LA RC,4 INDICATE NO TERMINAL CHARS 51560000 + BAL RET,MCBDSCAN SCAN COMMENT STMT 51565000 + L RD,MCBDPR2 CREATE BSU A 51570000 + BAL RE,MCBDBMP0 BUMP BSU POINTER A 51580000 + B MCBODPRC JUMP AND GENRATE CODE 51585000 + TITLE '***MCBODY - MEND, PRINT, ERROR ETC. ROUTINES***' 51590000 +**--> INSUB:MCBDCATI CREATE CONCOT BSU+ + + + + + + + + + + + + + +A 51590100 +*+ +A 51590200 +*+ CONCATENATION OPERATION NEEDED. IN CASE OF VARIABLES THAT +A 51590300 +*+ HAVE TO BE COMBINED (IE IN SETC STMT) +A 51590400 +*+ +A 51590500 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A 51590600 + SPACE 2 A 51590700 +MCBDCATI EQU * ROUTINE TO INSERT CATEN OPRTR 51595000 + L RD,MCBDCAT CREATE BSU A 51600000 + NI AVMBYTE2,X'FF'-($MTERM+$MOPRTR) TURN OFF PREV BSU FLAG 51615000 + OI AVMBYTE2,$MOPRTR SET PREV BSU FLAG 51620000 + LR RE,R14 COPY RETURN @ TO MCBDBMP0 REG S 51625000 +* *** FALL THRU INTO MCBDBMP0 -- MUST IMMEDIATELY FOLLOW *** S 51630000 + SPACE 2 51635000 +**--> INSUB: MCBDBMP BUMPS BSU POINTER + + + + + + + + + + + + +A 51640000 +*+ +A 51645000 +*+ CALLED WHENEVER BSU ADDED & NEED POINTER MOVED +A 51645100 +*+ +A 51645200 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A 51645300 + SPACE 2 A 51645400 +MCBDBMP0 ST RD,MCBSU FILL IN BSU A 51645500 +MCBDBMP EQU * 51650000 + XSNAP T=NO,STORAGE=(*0(RW),*8(RW)),LABEL='BSU - MCBDBMP', #51651000 + IF=(AVTAGSM,O,AJOMACRH,TM) 51652000 + LA RW,8(RW) BUMP BSU POINTER 51655000 + C RW,AVMCHLIM WORK AREA EXCEEDED? 51660000 + BL MCBDBMP1 OK IF NOT 51665000 + LA RB,$ERVTMTR ELSE SET TOO MANY TERMS FLAG 51670000 + B MCBDPRER AND FLAG STATEMNT 51675000 +MCBDBMP1 EQU * 51680000 + MVC MCBSU(8),AWZEROS ZERO NEW BSU 51685000 + BR RE AND RETURN 51690000 + SPACE 2 51695000 +* OVERFLOW CALL EXIR ROUTINE A 51695100 +MCBODOVR EQU * 51700000 + L REP,AVMOVRFL GET @ OF OVERFLOW ROUTINE 51705000 + BR REP BRANCH THERE 51710000 + SPACE 2 51715000 +MCLMXDER EQU * 51720000 + L RA,AVRSBPT GET SOURCE BLOCK @ 51725000 + LA RA,RSB$L(RA) BUMP TO GET SOURCE STMT 51730000 + LA RB,$ERILCNV SET ILLEGAL CONVERSION ERROR FLAG 51735000 + B MCBDPRER 51740000 + EJECT S 51745000 +**--> INSUB:MCBDPR PRINT STATEMENTS + + + + + + + + + + + + + + +A 51745100 +*+ +A 51745200 +*+ CALLED EACH TIME STATEMENTS NEEDS TO BE PRINTED. TEST FOR SEQ +A 51745300 +*+ SYMBOL, IF PRESENT TEST FOR ALREADY DEFINED, IF NOT ENTER INTO +A 51745400 +*+ LIST OF SYMBOLS & THEN PRINT, CONTINUES ' READING' STMTS +A 51745500 +*+ AND STOPS WHEN MEND FLAG SET. +A 51745600 +*+ +A 51745700 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A 51745800 + SPACE 2 A 51745900 +MCBODPR0 BAL RE,MCBDBMP0 BUMP BSU POINTER A 51745950 +MCBODPR EQU * 51750000 + AIF (&$DEBUG).MCBODPR 51755000 + L R1,AVMCHSTR GET @ OF BSU WORKAREA 51760000 + XSNAP LABEL='***BSU''S***',STORAGE=(*0(R1),*170(R1)),IF=(AVMSNX51765000 + BY1,O,$MSNP08,TM) 51770000 +.MCBODPR ANOP 51775000 + USING MCSEQ,RC SET USING FOR SEQ SYMBOL ENTRY 51780000 + TM MCLBFLG2,$MLCLFLG DEFINITION TYPE STMT? S 51785000 + BC 12,MCBODPR1 IF YES, JUMP AND PRINT 51790000 +MCBODPRC EQU * 51795000 + LR RC,RX COPY MACLIB POINTER 51800000 + $CALL MCGNCD ELSE GENERATE CODE 51805000 + AIF (NOT &$MACOPC).MCBODYC SKIP IF NOT OPEN CODE S 51806000 + TM MCLBFLG2,$MCOCFL1 IN OPEN CODE ? S 51806100 + BO MCBODPR1 IF YES, SKIP PROCESSING S 51806200 +.MCBODYC ANOP S 51806300 + CLI AVMFLDT1,C'.' SEQ SYMBOL PRESENT? 51810000 + BNE MCBODPR1 JUMP AND PRINT IF NOT 51815000 + SR RE,RE 51820000 + IC RE,AVMFLDL1 GET LENGTH OF SYMBOL 51825000 + BCTR RE,0 REDUCE FOR EX INSTRUCTION 51830000 + L RA,AVMFLD1 GET @ OF SEQ LABEL 51835000 + MVC AVMSYMBL,AWBLANK BLANK OUT COMMON AREA 51840000 + EX RE,MCBDPR1 EX MOVE INSTRUCTION A 51845000 + L RC,AVMSEQPT GET POINTER TO SEQ SYM ENTRIES 51860000 + $CALL MACFND SEARCH SYMBOL DICT 51865000 + LTR RB,RB PRESENT? 51870000 + BZ MCBODPR2 JUMP IF YES 51875000 + LA RB,$LMCSEQ ELSE GET LENGTH OF ENTRY 51880000 + $ALLOCH R1,RB,MCBODOVR GET SPACE FOR ENTRY 51885000 + ST R1,MCSEQNXT STORE POINTER IN PREV ENTRY 51890000 + LR RC,R1 MOVE BASE TO NEW ENTRY 51895000 + MVC MCSEQNAM,AVMSYMBL MOVE NAME INTO ENTRY 51900000 + OI MCSEQFLG,X'FF' SET DEFINED FLAG 51905000 + MVC MCSEQNXT,AWZEROS ZERO LINK POINTER 51910000 + MVC MCSEQVAL,AVMCRINS MOVE INST @ INTO ENTRY 51915000 + B MCBODPR1 JUMP AND PRINT 51920000 +MCBODPR2 EQU * 51925000 + CLI MCSEQFLG,X'FF' ALREADY DEFINED? 51930000 + BNE MCBODPR3 JUMP AND PROCESS IF NOT 51935000 + LA RB,$ERMULDF ELSE SET MULT DEF FLAG 51940000 + $CALL ERRLAB AND FLAG STATEMENT 51945000 + B MCBODPR1 PRINT STMNT 51950000 +MCBODPR3 EQU * 51955000 + L RE,MCSEQVAL GET @ OF INST 51960000 + USING MCOPQUAD,RE SET USING FOR ONE OP ENTRY 51965000 +MCBODPR4 EQU * 51970000 + MVC MCARG2LC,AVMCRINS MOVE INST @ INTO ONE OP ENTRY 51975000 + L RE,MCRESULT GET NEXT POINTER 51980000 + LTR RE,RE POINTER PRESENT? 51985000 + BNZ MCBODPR4 IF YES, UPDATE NEXT ENTRY IN LIST 51990000 + MVI MCSEQFLG,X'FF' ELSE SET DEFINED FLAG IN ENTRY 51995000 + MVC MCSEQVAL,AVMCRINS SET VALUE IN ENTRY 52000000 + DROP RE 52005000 + SPACE 52010000 +MCBODPR1 EQU * 52015000 + AIF (NOT &$MACOPC).MCBODYD SKIP IF NOT OPEN CODE S 52016000 + TM AVPRINT1,AVPRSAVE LISTING CONTROL = SAVE ? S 52016100 + BNO MCBODP1A BRANCH IF NOT S 52016200 + SR RE,RE ZERO FOR BYTE REGS USE A 52016210 + IC RE,AVRSBLOC GET LENGTH-1 A 52016220 + SH RE,=AL2(RSB$L) DECREMENT LENGTH FOR MXMVSR A 52016230 + STC RE,AVRSBLOC RESTORE IT A 52016240 + $CALL MXMVSR SAVE STATEMENT A 52016300 + B MACBODRT RETURN S 52016400 +MCBODP1A EQU * S 52016500 +.MCBODYD ANOP S 52016600 + LA RB,$OUCOMM 52020000 + $CALL OUTPT2 PRINT STATEEMNT 52025000 + CLI OPCHEX,$MEND MEND STATEMENT? 52030000 + BE MACMEND1 CLEAN UP IF YES 52035000 + B MCBOD01 ELSE READ NEXT STMNT 52040000 + DROP RC 52045000 + SPACE 2 52050000 +MCBDCHLB EQU * 52055000 + ST RET,MCBDCHSV SAVE RETURN ADDRESS 52060000 + CLI AVMFLDT1,C'.' SEQ SYMBOL? 52065000 + BE MCBDCHFT OKAY IF YES 52070000 + CLI AVMFLDL1,X'00' NO LABEL? 52075000 + BE MCBDCHFT OKAY ALSO 52080000 + LA RB,$ERILLAB ELSE SET BAD LABEL FLAG 52085000 + $CALL ERRLAB AND FLAG STMT 52090000 +MCBDCHFT EQU * 52095000 + L RET,MCBDCHSV RESTORE RETURN @ 52100000 + BR RET AND RETURN 52105000 +MCBDCHSV DS F CORE FOR RETURN @ 52110000 +MCBDPR1 MVC AVMSYMBL($),0(RA) DUMMY MOVE FOR LABEL A 52110100 + SPACE 2 52115000 +MCGBINVD LA RB,$ERINVDM INVALID DLM A 52116000 + B MCBDPRER GO FLAG ERROR A 52116500 + SPACE 1 A 52117000 +MCGBMD L RA,AVMTSCNP GET @ OF 1ST CHAR OF VAR NAME A 52118000 + LA RB,$ERMULDF SHOW MULTIPLR DEFN A 52118100 + B MCBDPRER GO FLAG A 52118200 + SPACE 1 A 52118300 +MCBDOPER EQU * 52120000 + LA RA,AVRSBLOC+RSB$L+20 GUESS AT OPRND ADDRESS A 52125000 + LA RB,$ERNOOPR SET NO OPRND FLAG 52130000 + SPACE 2 52140000 +* S 52140100 +* PRINTS AN APPROPRIATE MESSAGE & SETS ERR INDX IN BSU A 52140200 +* A 52140300 +MCBDPRER EQU * 52145000 + L RW,AVMCHSTR SET BSU PNTR TO START OF WORK AREA 52150000 + LR RD,RA COMPUT OFFSET A 52155000 + S RD,AVRSBPT A 52170000 + SLL RD,8 MOVE TO RIGHT BYTE A 52170050 + AL RD,MCBDERR A 52170100 + BAL RE,MCBDBMP0 BUMP BSU POINTER A 52175000 + $CALL ERRTAG FLAG STMNT 52180000 + B MCBODPR JUMP AND PRINT STATEMENT 52185000 + SPACE 2 52190000 +MCBDISER EQU * 52195000 + LA RB,$ERINVSY SET INVALID SYMBOL FLAG 52200000 + B MCBDPRER AND FLAG STATEMENT 52205000 + SPACE 2 52210000 +* A 52215000 +* END OF ROUTINE, SET OP POINTERS TO ONE-OP ENTRIES PRINTS A 52220000 +* OUT ERROR MESSAGES & DEBUG ADDRESS FOUND & STORED A 52225000 +* A 52225100 +MACMEND1 EQU * 52230000 + USING MCOPQUAD,RE 52235000 + USING MCSEQ,RC 52240000 + L RC,AVMSEQPT GET @ OF SEQ SYM LIST 52245000 + USING RSBLOCK,RZ NOTE USING FOR OUTPPUT RECORD 52250000 + L RZ,AVRSBPT SET BASE FOR OUTPUT RECORD 52255000 + MVC RSBLOCK(RSB$L+L'MCMNERMS),MCMNERMF SET FLAGS S 52255100 +MACMEND2 EQU * 52260000 + CLI MCSEQFLG,X'FF' SYMBOL DEFINED? 52265000 + BNE MACMEND3 PROCESS IF NOT 52270000 +MACMENDN EQU * 52275000 + L RC,MCSEQNXT SET BASE TO NEXT ENTRY 52280000 + LTR RC,RC LAST ENTRY? 52285000 + BNZ MACMEND2 IF NOT, RESUME SEARCH 52290000 + B MACMEND5 ELSE JUMP TO FOOT 52295000 +MACMEND3 EQU * 52300000 + L RE,MCSEQVAL GET @ OF ONE OP ENTRY 52305000 +MACMEND4 EQU * 52310000 + MVC RSBSOURC+L'MCMNERMS(6),AWEP6 PUT EDIT MASK IN OUTPUT 52345000 + L R1,MCRESULT COPY LINK TO NXT SEQ ERROR TEMP 52350000 + L RE,MCARG2LC MOVE BASE TO 1ST ONE-OP 52355000 + ED RSBSOURC+L'MCMNERMS(6),MCQSTMNO EDIT STMT NBR TO FLD 52360000 + MVI MCQS1FLG,$BSERR01 SET ERROR MSG OPCODE A 52370000 + LA RB,$OUCOMM SET PRINT FLAG 52380000 + LR R0,RC COPY RC TEMPORARILY 52385000 + $CALL OUTPT2 PRINT ERROR MESSAGE 52390000 + LR RC,R0 RESTORE RC 52395000 + LTR RE,R1 SET BASE TO NEXT SEQ ERR ENTRY S 52400000 + BNZ MACMEND4 PRINT NEXT MESSAGE IF NOYT 52410000 + B MACMENDN RESUME SCAN OF SEQ SYMBOL DICT 52415000 +MACMEND5 EQU * 52420000 + LA RC,$LMCSEQ GET LENGTH OF SEQ ENTRY 52425000 + L R1,AVADDHIH GET PNTR FOR DEBUG STMNT 52430000 + A RC,AVMSEQPT ADD ORIGINAL POINTER 52435000 + ST RC,AVADDHIH RELEASE STORAGE IN HIGH END 52440000 + SPACE 2 52445000 +MACBODRT EQU * 52450000 + AIF (&$DEBUG).MACBODR 52455000 + L R2,AVMSEQPT GET @ OF SEQ SYM TABLE FOR DEBUG 52460000 + XSNAP LABEL='***MCBODY EXITED***',STORAGE=(*0(R1),*0(R2)),IF=(X52465000 + AVMSNBY1,O,$MSNP07,TM) 52470000 +.MACBODR ANOP 52475000 + SR RB,RB CLEAR RB FOR RETURN 52480000 + $RETURN RGS=(R14-R6) 52485000 +MCBDSRPT DS F WORD FOR RSBSOURC @ 52490000 +MCB##SAV DS F RETURN @ FROM MCB## ROUTINES J 52490100 +MCBPRBSU DC AL1($MOPRTR,$BSPRINT,0,$MPRNTHR) PRINT BSU 52495000 +MCBPRBSV DC AL1($MOPRTR+$MPRCOM,$BSPRINT,0,$MPRNTHR) COMMENT PRM A 52495001 +* ***** BSU TABLE - FIRST FULLWORDS OF MANY BSU'S. ***** J 52495050 +MCBDERR DC AL1($MOPRTR,$BSERR01,0,$MPRNTHR) A 52495100 +MCBDSET DC AL1($MOPRTR,$BSETA,0,$MSETHR) A 52495200 +MCBDAGO DC AL1($MOPRTR,$BSAGO,0,$MAGOHR) A 52495300 +MCBDSTG1 DC AL1($MTERM+$BSCHAR,$BSTRING,0,11),A(MCMNOTMS) WHOLE BS J 52495400 +MCBDSTG2 DC AL1($MTERM+$BSCHAR,$BSTRING,0,2),A(MCMNOT1C) WHOLE BSU J 52495500 +MCBDPR2 DC AL1($MOPRTR,$BSMVSTM,0,$MPRNTHR) A 52495600 +MCBDPR3 DC AL1($MOPRTR,$BSMVSTM+$BSMNTER,0,$MPRNTHR) A 52495650 +MCBDAIF DC AL1($MOPRTR,$BSAIF,0,$MAIFHR) A 52495660 +MCBDCAT DC AL1($MOPRTR,$BSCAT,0,$MCATHR) A 52495700 +MCBDINMA DC AL1($MOPRTR,$BSINMAC,0,$MPRNTHR) INNER MACRO BSU A 52495750 +MCBDLABL DC AL1($MTERM,$BSLABEL,0,0) A 52495760 +MCMNERMF DC AL1(L'MCMNERMS+RSB$L+6,$RSBNPNN+$RSBMERR,1,0) A 52495800 +MCMNERMS DC C'220 UNDEFINED SEQUENCE SYMBOL IN STATEMENT' 52500000 + LTORG 52505000 + DROP RAT,RW,RX,R13,RC,RZ,RE 52510000 + TITLE '***MACLEX - LEXICAL SCAN OF EXPRESSIONS***' 52515000 +**--> CSECT: MACLEX THIS PROCEDURE SCANS A MCRO STATEMENT AND * 52520000 +*. CONVERTS IT INTO BSU'S. ALSO CHECKS FOR SUCH ERRORS AS TWO * 52525000 +*. TERMS OR TWO OPERATORS IN A ROW. WHERE NECESSARY IT INSERTS* 52530000 +*. CATENATION OPERATORS WHERE CATENATION IS IMPLICIT * 52535000 +*. * 52540000 +*. ENTRY CONDITIONS * 52545000 +*. RA = @ OF FIRST CHARACTER OF EXPRESSION * 52550000 +*. RC = @ ON NEXT AVAILABLE BSU IN WORKSPACE * 52555000 +*. * 52560000 +*. EXIT CONDITIONS * 52565000 +*. RA = @ OF DELIM PAST EXPRESSION IF NO ERROR * 52570000 +*. = @ OF ERROR IF ERROR PRESENT * 52575000 +*. RB = 0 IF OKAY * 52580000 +*. = $ERMSSGE IF ERROR * 52585000 +*. RC = @ OF NEXT AVAILABLE SPACE FOR BSU * 52590000 +*. * 52595000 +*. CALLS MCGTST,MCDTRM,SDBCDX,MCSYSR,MCATRM,MCGTST * 52600000 +*. USES DSECTS: AVWXTABL,MCBSU,MCPARENT,MCGLBDCT,MCLCLDPV * 52605000 +*. USES MACROS: $SAVE,$RETURN,$ALLOCL,$SCOF,$SCPT,$CALL,$SETRT * 52610000 +*. * 52615000 +*. REGISTER USAGE A 52615100 +*. WORK REGS: R0,R1,R2,RY,RZ,RB,RC,RE A 52615150 +*. USED FOR TRT: R1,R2 A 52615200 +*. RW-BASE REG FOR BSU A 52615250 +*. R13 BASE REG FOR THIS CSECT A 52615300 +*. RAT- BASE REGISTER FOR MAIN TABLE A 52615350 +*. RX-UNUSED A 52615400 +*. RD-? A 52615450 +*. A 52615500 +*** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 52620000 + SPACE 2 52625000 +MACLEX CSECT 52630000 + $SAVE RGS=(R14-R6),SA=*,BR=13 52635000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 52640000 + XSNAP LABEL='***MACLEX ENTERED***',T=NO,IF=(AVMSNBY2,O,$MSNP09X52645000 + ,TM) 52650000 + USING MCBSU,RW SET USING FOR BSU ENTRY 52655000 + LR RY,RC COPY ADDR OF NEXT BSU A 52655100 + S RY,=F'8' GET ADDR OF PRECIOUS POINTER A 52655200 + MVC MCBSFLGP(4),0(RY) MOVE PREV BSU INTO WORK AREA A 52655300 + SR RY,RY USE RY FOR PAREN COUNT 52660000 + LR RW,RC GET @ OF SPACE FOR BSU 52665000 + MVI AVMDWRK4,X'00' CLEAR PAREN INFO BYTE 52670000 + MVC MCBSU(8),AWZEROS BLANK OUT ENTRY 52675000 + NI AVMBYTE1,X'FF'-$MINQUOT CLEAR QUOTE FLAG 52680000 + NI AVMBYTE2,X'FF'-$MTERM MAKE SURE TERM FLG IS OFF 52685000 + OI AVMBYTE2,$MOPRTR SET OPERATOR FLAG FOR START 52690000 + $SETRT ('''',26,'&&',28,'.',30) SET TRT TABLE FOR QUOTE SCAN 52695000 + MVI AWTDECT+C'+',18 52700000 + MVI AWTDECT+C'-',20 52705000 + MVI AWTDECT+C'/',22 MODIFY AWTDECT TABLE FOR TEMPORARY 52710000 + MVI AWTDECT+C')',24 USE IN LEXICAL SCAN. THIS SAVES 52715000 + MVI AWTDECT+C'''',26 CREATING A NEW TABLE. 52720000 + MVI AWTDECT+C'&&',28 52725000 + MVI AWTDECT+C'.',30 52730000 + B MCLXSTR0 JUMP TO LOOKUP CHAR ROUTINE A 52735000 +MCLEXBAS DS 0H 52740000 + SPACE 2 52745000 +MACLINDX $AL2 MCLEXBAS,(MCLDIGIT,MCLEXERR,MCLSDTRM,MCLALPHA,MCLMULT,MCX52750000 + LEQUAL,MCLXLPAR,MCLCOMMA,MCLBLANK,MCLPLUS,MCLMINUS,MCLDIX52755000 + VID,MCLXRPAR,MCLQUOTE,MCLAMPRS,MCLPEROD) 52760000 + SPACE 2 52765000 +* TRT TABLE SET-UP, LOOK UP CHARACTER OF EXPRESSIO AND GO TO THE A 52765100 +* ROUTINE TO PROCESS THE EXPRESSION. A 52765200 +MCLXSTRS EQU * S 52765300 + LA RA,1(R1) BUMP SCAN POINTER S 52765400 +MCLXSTRT EQU * 52770000 +MCLXSTR0 EQU * A 52770200 + LR R0,RA COPY SCAN POINTER 52775000 +MCLXSCAN EQU * 52780000 + SR R1,R1 ZERO R1 FOR TRT USE 52785000 + SR R2,R2 USE R2 IN TRT INST 52790000 + TM AVMBYTE1,$MINQUOT INSIDE QUOTES? 52795000 + BO MCLX01 USE LIMITEE TRT IF YES 52800000 +MCLX03 EQU * 52805000 + TRT 0(1,RA),AWTDECT LOOKUP NEXT CHAR 52810000 + B MCLX02 AND JUMP TO GET ROUTINE 52815000 +MCLX01 EQU * 52820000 + TM AVMBYTE2,$MINAPAR+$MDIMVAR PAREN EXPRESSSION EXPECTED? 52825000 + BC 5,MCLX03 IF YES, USE REGULAR TRT 52830000 + TRT 0(200,RA),AWTZTAB 52835000 +MCLX02 EQU * 52840000 + LH RE,MACLINDX(R2) GET HALFWORD OFFSET FROM TABLE 52845000 + B MCLEXBAS(RE) ADD TO BASE AND JUMP TO ROUTINE 52850000 + SPACE 2 52855000 +* DIGIT FOUND, CHECK TO SEE IF PROPER CONST, CONVERT IT, SET UP A 52855100 +* BSU WITH CONSTANT VALUE, DECREMENT # BSU COUNTER & PROCESS A 52855200 +MCLDIGIT EQU * 52860000 + TM AVMBYTE2,$MINARIT+$MINAPAR+$MINBOOL CONSTANT OKAY? 52865000 + BZ MCLXSYER IF NOT, JUMP AND FLAG 52870000 + $CALL MCDTRM CONVERT CONSTANT 52875000 + LTR RB,RB OK? 52880000 + BNZ MCLXERTN RETURN IF NOT 52885000 + MVI MCBSINDX,$BSIMMA SET IMMED ARITH INDEX 52890000 + OI MCBSFLGS,$BSAR INDICATE ARITH IN BSU 52895000 + ST RC,MCBSVALU STORE VALUE IN BSU 52900000 + S RC,AWF1 DECR BY 1 52905000 + BH MCLXTRMF IF > 1 THEN FINI 52910000 + OI MCBSFLGS,$BSBOOL ELSE FLAG AS BOOLEAN CONSTANT ALSO 52915000 + B MCLXTRMF JUMP TO TERM FOOT 52920000 + SPACE 2 52925000 +* POSSIBLE SELF DEFINING TERM, CHECK NEXT CHAR, IF QUOTE, ALPHA, A 52925100 +* ELSE CHECK FOR OK SDT.-SETS FLAGS ETC. A 52925200 +MCLSDTRM EQU * 52930000 + CLI 1(R1),C'''' NEXT CHAR = '? 52935000 + BNE MCLALPHA PROCESS ALPHA IF NOT 52940000 + $CALL SDBCDX CHECK FOR SELF DEFINING TERM 52945000 + LTR RB,RB OKAY? 52950000 + BM MCLALPHA MAY BE L', BRANCH A 52953000 + BP MCLXERTN BAD SDTERM IF RB > 0 A 52955000 + TM AVMBYTE2,$MINARIT+$MINAPAR+$MINBOOL IN OKAY EXPRESSION? 52960000 + BZ MCLXSYER ERROR IF NOT 52965000 + OI MCBSFLGS,$BSAR+$MTERM SET TYPE TO ARITH TERM 52970000 + MVI MCBSINDX,$BSIMMA SET TO ARITH IMMED TYPE INDEX 52975000 + ST RC,MCBSVALU STORE VALUE IN BSU 52980000 + B MCLXTRMF JUMP TO TERM FOOT 52985000 + SPACE 2 52990000 +* ALPHA CHAR FOUND, CK ARITH EXPRESSION, PROCESS IF IS, NEXT A 52990100 +* CK TYPE ATTR, ERROR IF NOT FIRST CHAR OF OPRND ALSO IF ( A 52990200 +* SETS SYSLIST FLAG SEARCHES ATTRIBUTES IN DICTIONARY A 52990300 +MCLALPHA EQU * 52995000 + TM AVMBYTE2,$MINARIT+$MINBOOL+$MINAPAR IN ARITH EXPRES? 53000000 + BM MCLALPH0 PROCEED IF YES 53005000 + C R1,AVMFLD3 BEGINNING OF OPRND? 53010000 + BNE MCLXSYER ERROR IF NOT 53015000 + CLC 0(2,R1),=C'T''' T' ATTIBUTE? 53020000 + BNE MCLXSYER ERROR IF NOT 53025000 +MCLALPH0 EQU * 53030000 + CLI 1(R1),C'''' NEXT CHAR = QUOTE? 53035000 + BNE MCLRELOP IF NOT TEST FOR RELOP 53040000 + $CALL MCATRM IS IT AN ATTRIBUTE? 53045000 + LTR RB,RB 53050000 + BM MCLXSYER IF NOT, SET SYNTAX EROR FLAG 53055000 + BP MCLXERTN NOT IMPLEMENTED 53060000 + STC RC,MCBSINDX STORE TYPE OF ATTRIB IN BSU 53065000 + $CALL MCSYSR SEARCH DICTIONARIES 53070000 + LTR RB,RB 53075000 + BM MCLXISER INVALID SYMBOL IF MINAS 53080000 + BP MCLXERTN NOT DEFINED IF RB > 0 53085000 + LA RB,$SYMPAR LOAD SYMBOLIC PARAM FLAG 53090000 + CR RD,RB IS IT SYM PAR? 53095000 + BE MCLA01 IF YES PROCEED 53100000 + USING MCPARENT,RC NOTE USING FOR ENTRY 53105000 + LA RB,$SYSVAR NEXT CHECK FOR SYSTEM VARIABLE 53110000 + CR RB,RD 53115000 + BNE MCLXISER IF NOT, FLAG ERROR 53120000 + CLI MCPARNLN,8 MUST BE &SYSLIST WITH LENGTH 8 53125000 + BNE MCLXISER ERROR IF NOT 53130000 + MVC MCBSVALU,AWFM1 INDICATE &SYSLIST WITH -1 53135000 +* N'&SYSLIST CAN STAND ALONE SO CHECK FOR LEFT PAREN 53140000 + CLI MCBSINDX,$BSATN ATTRIB = N'? 53145000 + BNE MCLALPH2 PROCEED IF NOT 53150000 + CLI 0(RA),C'(' NEXT CHAR = '('? 53155000 + BNE MCLXTRMF PROCESS IF NOT 53160000 +MCLALPH1 EQU * 53165000 + MVI AVMDWRK4,$MINSYSL SET &SYSLIST FLAG IF PAREN 53170000 + B MCLXTRMF 53175000 +MCLALPH2 EQU * 53180000 + CLI 0(RA),C'(' NEXT CHAR = LEFT PAREN? 53185000 + BE MCLALPH1 T' OR K' REQUIRE PAREN 53190000 + B MCL$ERI S 53195000 + SPACE 53205000 +* SYMBOLIC PARAMETER FOUND SET UP BSU, AND CHK LEGALITY A 53205100 +MCLA01 EQU * 53210000 + LH R2,MCPARNDX GET SYMBOLIC PARAM ID 53215000 + ST R2,MCBSVALU STORE IN BSU 53220000 + CLI 0(RA),C'(' NEXT CHAR IS '('? 53225000 + BNE MCLXTRMF JUMP TO FOOT IF NOT 53230000 + OI AVMBYTE2,$MDIMVAR ELSE SET DIM VAR FLAG 53235000 + CLI MCBSINDX,$BSATN N' ATTRIB? 53240000 + BNE MCLXTRMF OKAY IF NOT 53245000 +MCL$ERI LA RB,$ERILAT SET BAD ATTRIB FLAG S 53250000 + B MCLXERTN AND RETURN 53255000 + SPACE 2 A 53255100 +* RELATIONAL OPERATOR FOUND, IF ^BOOL ERROR, ELSE GET OPERAND LENGTHA 53255200 +* AND LOOK UP IN TABLE FOR OPERATION WHEN LEGAL OPERATOR FOUND, A 53255300 +* SET UP BSU A 53255400 +MCLRELOP EQU * 53260000 + TM AVMBYTE2,$MINBOOL IN BOOLEAN EXPRESSION? 53265000 + BNO MCLXSYER IF NOT, REL OPCODE NOT ALLOWED 53270000 + TRT 0(4,RA),AWTSYMT SCAN STRING FOR DELIM 53275000 + BZ MCLXSYER ERROR IF > 3 CHARS 53280000 + LR R2,R1 COPY DEIIM @ 53285000 + SR R2,RA GET LENGTH OF STRING 53290000 + BCT R2,MCLARL01 DECR FOR EX INST 53295000 + B MCLXSYER ERROR IF ONE CHAR 53300000 +MCLARL01 EQU * 53305000 + LA RE,MCRLOPTB GET @ OF CONSTANT TABEL 53310000 +MCLARL02 EQU * 53315000 + EX R2,MCLACMPR COMPARE WITH NEXT ENTRY 53320000 + BE MCLARL03 FOUND IF EQUAL 53325000 + BL MCLXSYER NOT PRESENT IF < 53330000 + LA RE,5(RE) BUMP TABLE POINTER 53335000 + B MCLARL02 RESUME SEARCH OF TABEL 53340000 + SPACE 53345000 +MCLARL03 EQU * 53350000 + MVC MCBSINDX,3(RE) SET INDEX 53355000 + MVC MCBSHIER,4(RE) SET HIERARCHY IN BSU 53360000 + LR RA,R1 BUMP SCAN POINTER 53365000 + B MCLXOPRF JUMP TO OPRTR FOOT 53370000 + SPACE 2 53375000 +MCLACMPR CLC 0(0,RA),0(RE) COMPARE STRING WITH TABLE ENTRY 53380000 +MCRLOPTB DC C'AND',AL1($BSAND,$MANDHR),C'EQ ',AL1($BSEQ,$MRELHR) 53385000 + DC C'GE ',AL1($BSGE,$MRELHR),C'GT ',AL1($BSGT,$MRELHR) 53390000 + DC C'LE ',AL1($BSLE,$MRELHR),C'LT ',AL1($BSLT,$MRELHR) 53395000 + DC C'NE ',AL1($BSNE,$MRELHR),C'NOT',AL1($BSNOT,$MNOTHR) 53400000 + DC C'OR ',AL1($BSOR,$MORHR),C'999' 53405000 + DROP RC 53410000 + SPACE 2 53415000 +* NEXT BLOCKS WHEN +,-,/,OR * FOUND, SETS HIERARCHY AND SETS UP A 53415100 +* THE BSU'S A 53415200 +MCLMULT EQU * 53420000 + MVI MCBSINDX,$BSMULT SET INDEX TYPE IN BSU 53425000 +MCLMHIER EQU * 53430000 + MVI MCBSHIER,$MMULTHR SET MULT/DIVID HIERARCHY 53435000 + B MCLXARFT JUMP TO ARITH OPRTR FOOT 53440000 + SPACE 2 53445000 +MCLDIVID EQU * 53450000 + MVI MCBSINDX,$BSDIV SET BSU INDEX FOR DIVIDE 53455000 + B MCLMHIER JUMP AND SET HIERARCHY 53460000 + SPACE 2 53465000 +MCLPLUS EQU * 53470000 + MVI MCBSINDX,$BSPLUS SET ADDITION INDIX IN BSU 53475000 +MCLPHIER EQU * 53480000 + MVI MCBSHIER,$MPLUSHR SET HIERARCHY OF OPRTR 53485000 + B MCLXARFT JUMP TO ARITH FOOT 53490000 + SPACE 2 53495000 +MCLMINUS EQU * 53500000 + MVI MCBSINDX,$BSMIN SET MINUS INDEX IN BSU 53505000 + B MCLPHIER JUMP AND SET SAME HIERARCHY AS PLUS 53510000 + SPACE 2 53515000 +* CK IF ARITH EXPRESSION, ERROR IF NOT A 53515100 +MCLXARFT EQU * 53520000 + TM AVMBYTE2,$MINARIT+$MINAPAR+$MINBOOL IN ARITH EXPRESSION 53525000 + BZ MCLXSYER ERROR IF NOT 53530000 + LA RA,1(R1) BUMP SCAN POINTER 53535000 + B MCLXOPRF JUMP TO OPERATOR FOOT 53540000 + SPACE 2 53545000 + SPACE 2 53555000 +* LEFT PAREN FOUND CHECK IF NESTING LEVEL OK, , CHKS & BRANCHES TO A 53555100 +* SEE IF 1)SUBSCRIPTED VAR,2)IN SUBSTRING,3)OR SYSLIST A 53555200 +MCLXLPAR EQU * 53560000 + LA RY,1(RY) BUMP PAREN COUNT 53565000 + C RY,=F'6' CHECK NEXTING LEVEL 53570000 + BL MCLXLP01 OKAY IF < 6 53575000 + LA RB,$ERVPARN ELSE SET TOO MANY PAREN FLAG 53580000 + B MCLXERTN AND RETURN 53585000 +MCLXLP01 EQU * 53590000 + LA RZ,AVMDWRK4(RY) USE RZ AS PNTR TO CURRENT PAREN 53595000 + TM AVMDWRK4,$MINSYSL IS &SYSLIST FLAG ON? 53600000 + BO MCLXSBSL IF YES MUST BE &SYSLIST PAREN 53605000 + TM AVMBYTE2,$MDIMVAR PREV BSU = DIMEN VARIABLE? 53610000 + BO MCLXSBSC IF YES, MUST BE SUBSCRIPT LP 53615000 + BCTR R1,0 DECR POINTER 53620000 + CLI 0(R1),C'''' PREV CHAR = QUOTE? 53625000 + LA R1,1(R1) RESTORE POINTER BEFORE TEST 53630000 + BE MCLXSBST IF YES MUST BE SUBSTRING LP 53635000 + TM AVMBYTE2,$MOPRTR PREV BSU = OPRTR? 53640000 + BNO MCLXSYER ERROR IF NOT 53645000 + MVI 0(RZ),X'00' CLEAR FIRST BYTE OF PAREN INFO 53650000 + MVI MCBSINDX,$BSLPAR ELSE MUST BE LEFT PAREN 53655000 + B MCLXPARF JUMP TO L PAREN FOOT 53660000 + SPACE 53665000 +* SUBSCRIPT CHECK A 53665100 +MCLXSBSC EQU * 53670000 + MVI 0(RZ),$MINSBSC IDENTIFY PAREN LEVEL 53675000 + MVI MCBSINDX,$BSBSCRP SET BSU INDEX 53680000 + OI AVMBYTE2,$MINAPAR INDICATE INSIDE ARITH PARENS 53685000 + B MCLXPARF JUMP TO PAREN FOOT 53690000 + SPACE 53695000 +* SYSLIST CHECK A 53695100 +MCLXSBSL EQU * 53700000 + MVI 0(RZ),$MINSYSL SET PAREN ID TO SYSLIST 53705000 + MVI MCBSINDX,$BSBSYL SET BSU INDEX ALSO 53710000 + OI AVMBYTE2,$MINAPAR INDICATE INSIDE ARITH PARENS 53715000 + CLI MCBSINDP,$BSATN IS IT THE N' A 53735000 + BNE MCLXPARF PROCEED IF NOT 53740000 + MVI 0(RZ),$MINSBSC ELSE SET FLAG TO STOP 2 SUBSCRIPTS 53745000 + B MCLXPARF JUMP TO L PAREN FOOT 53750000 + SPACE 53755000 +* SUBSTRING CHECK A 53755100 +MCLXSBST EQU * 53760000 + MVI 0(RZ),$MINSBST INDICATE PAREN IS SUBSTRING START 53765000 + MVI MCBSINDX,$BSBSTR SET BSU INDEX ALSO 53770000 + OI AVMBYTE2,$MINAPAR ALSO INDICATE INSIDE ARITH PARENS 53775000 + B MCLXPARF JUMP TO L PAREN FOOT 53780000 + SPACE 53785000 +* FOOT FOR LEFT PAREN A 53785100 +MCLXPARF EQU * 53790000 + LA RA,1(R1) BUMP SCAN POINTER PAST ( 53795000 + MVI MCBSHIER,$MPARHR SET PAREN HIERARCHY 53800000 + NI AVMBYTE2,X'FF'-$MDIMVAR TURN OFF DIMVAR FLAG 53805000 + MVI AVMDWRK4,X'00' TURN OFF SYSLIST FLAG 53810000 + B MCLXDLMF JUMP TO DELIM/OPRTR FOOT 53815000 + SPACE 4 53820000 +* RIGHT PAREN FOUND CHECKS FOR RIGHT NUMBER AF ARGUMENTS, SEES IF A 53820100 +* CORRECT NESTING MOVES SUBSCIPTS INTO BSU, ALWAYS PROCESSED INFO A 53820200 +* AND CHECKS FOR MATCHED PARENS(N'LPREN=N'RPAREN) A 53820300 +* A 53820400 +MCLXRPAR EQU * 53825000 + LA RZ,AVMDWRK4(RY) GET @ CURRENT PAREN INFORMATION J 53830000 + TM 0(RZ),$MINSBST IN SUBSTRING? 53840000 + BNO MCLXRP01 PROCEED IF NOT 53845000 + TM 0(RZ),$MINSBST+X'01' TWO ARGUMENTS? 53850000 + BNO MCLCOMR1 S 53855000 +MCLXRP01 EQU * 53870000 + TM AVMBYTE2,$MTERM PREV BSU = TERM? 53875000 + BO MCLXRP02 OKAY IF YES 53880000 + CLI MCBSINDP,$BSRPAR MUST BE RIGHT RAREN A 53895000 + BNE MCLXSYER ERROR IF NOT ) 53900000 +MCLXRP02 EQU * 53905000 + MVC MCBSLOC+3(1),0(RZ) MOVE NBR OF SUBSCRIPTS INTO BSU 53910000 + S RY,AWF1 DECR PAREN COUNT 53915000 + BP MCLXRP03 OKAY IF STILL POSITIVE 53920000 + BM MCLXSYER ERROR IF NEGATIVE 53925000 + NI AVMBYTE2,X'FF'-$MINAPAR TURN OFF ARITH EXPRESSION FLAG 53930000 + TM AVMBYTE2,$MINPEXP END OF EXPRESSI6N? 53935000 + BO MCLXRP04 IF YES RETURN 53940000 + B MCLXRP06 RETURN IF PAREN COUNT IS ZERO 53945000 +MCLXRP03 EQU * 53950000 + BCTR RZ,0 DECR POINTER TO PAREN INFO 53955000 + LR RE,RY COPY PAREN COUNT INTO RE 53960000 +MCLXRP05 EQU * 53965000 + TM 0(RZ),$MINSBST+$MINSBSC+$MINSYSL IN ARITH EXPRESSION? 53970000 + BM MCLXRP06 IF YES RETURN 53975000 + BCTR RZ,0 ELLE DECR POINTER AGAIN 53980000 + BCT RE,MCLXRP05 DECR PAREN COUNT 53985000 + NI AVMBYTE2,X'FF'-$MINAPAR TURN OFF ARITH FLAG IF ZERO 53990000 +MCLXRP06 EQU * 53995000 + MVI MCBSINDX,$BSRPAR SET RIGHT PAREN INDEX IN BSU 54000000 + LA RA,1(RA) BUMP POINTER PAST PAREN 54005000 + B MCLXDLMF 54010000 + SPACE 54015000 +MCLXRP04 EQU * 54020000 + MVI MCBSINDX,$BSRPAR SET INDEX IN BSU 54025000 + MVI MCBSHIER,$MPARHR SET HIERARCHY 54030000 + OI MCBSFLGS,$MOPRTR SET OPRTR FLAG IN BSU 54035000 + $SCOF RB,RA,MCBSOFST GET OFFSET IN BSU 54040000 + LA RA,1(R1) BUMP SCAN POINTER 54045000 + BAL RE,MCLXBMP BUMP BSU 54050000 + NI AVMBYTE2,X'FF'-$MINPEXP TURN OFF PAREN EXPR FLAG 54055000 + B MCLXFOOT RETURN 54060000 + SPACE 2 54065000 +* COMMA FOUND, CHECKS VALIDITY AND FLAGS ERRORS A 54065100 +* A 54065200 +MCLCOMMA EQU * 54070000 + LTR RY,RY ARE WE IN PARENS? 54075000 + BZ MCLXSYER ERROR IF NOT 54080000 + LA RZ,AVMDWRK4(RY) GET PTR TO PAREN INFO A 54085000 + TM 0(RZ),$MINSBST+$MINSYSL IN SUBSTR OR SYSLIST? 54095000 + BM MCLCOM01 OKAY IF YES 54100000 +MCLCOMR1 EQU * 54105000 + LA RB,$ERINSBV ELSE SET WRONG NBR ARGS FLAG 54110000 + B MCLXERTN AND RETURN 54115000 +MCLCOM01 EQU * 54120000 + TM 0(RZ),X'01' ONE ARG ALREADY PROCESSED? 54125000 + BO MCLCOMR1 ERROR IF YES 54130000 + OI 0(RZ),X'01' INDICATE ONE ARG PROCESSED 54135000 + MVI MCBSINDX,$BSCOMMA SET BSU INDEX 54140000 + MVI MCBSHIER,$MCOMMHR SET HIERARCHY 54145000 + LA RA,1(R1) BUMP SCAN POINTER 54150000 + B MCLXDLMF JUMP TO DILIM/OPRTR FOOT 54155000 + SPACE 4 54160000 +* AMPERSANDS FOUND, PROCESS IT. C HECKS FOR VARIABLES, FOR INSIDE A 54160100 +* QUOTES, ADDS CONCATINATION OPERATOR WHEN NEEDED, SYBOL PARMS, ETC A 54160200 +* ALSO SEARCHES DICTIONARIES AND PROCESS GLOBAL, LOCAL & SYMBOLIC A 54160300 +* VARIABLES A 54160400 +* A 54160500 +MCLAMPRS EQU * 54165000 + TM AVMBYTE2,$MINCHAR IN CHAR EXPRESSION? 54170000 + BNO MCLAMP00 PROCEED IF NOT 54175000 + TM AVMBYTE1,$MINQUOT SHOULD BE IN QUOTES 54180000 + BO MCLAMP00 OKAY IF YES 54185000 + TM AVMBYTE2,$MINAPAR IN SUBSCRIPT? 54190000 + BO MCLAMP00 THIS EXCUSSES ALL 54195000 + LA RB,$ERMISQU ELSE SETT MISSING QUOTES FLAG 54200000 + B MCLXERTN AND RETURN 54205000 +MCLAMP00 EQU * 54210000 + TM AVMBYTE1,$MINQUOT INSIDE QUOTES? 54215000 + BNO MCLAMPR1 IF NOT, PROCEED 54220000 + CLI 1(R1),C'&&' NEXT CAR = &? 54225000 + BNE MCLAMP01 PROCEED IF NOT 54230000 + LA RA,2(R1) ELSE BUMP SCAN POINTER PAST && 54235000 + B MCLXSCAN AND RESUME SCAN 54240000 +MCLAMP01 EQU * 54245000 + CR R0,R1 STRING PRECEEDING &? 54250000 + BE MCLAMPRT PROCESS VAR SYMB IF NOT 54255000 + TM AVMBYTE2,$MOPRTR PREV BSU = OPRTR? 54260000 + BO MCLAMP02 PROCEED IF YES 54265000 + BAL RET,MCLXCATI ELSE INSERT CAT OPRTR 54270000 +MCLAMP02 EQU * 54275000 + LR RB,R1 ELSSE COPY END OF STRING+1 54280000 + LR RA,R0 GET START OF STRING 54285000 + $CALL MCGTST GET STRING 54290000 + STC RD,MCBSTRLN SAVE STRING LENGTH IN BSU 54295000 + ST RC,MCBSLOC SAVE LOCATION IN BSU 54300000 + MVI MCBSINDX,$BSTRING IDENTIFY BSU 54305000 + OI MCBSFLGS,$MINQUOT+$MTERM+$MINCHAR SET FLAGS IN BSU 54310000 + $SCOF RB,R0,MCBSOFST PUT OFFSET IN BSU 54315000 + LR R0,RA BUMP START POINTER 54320000 + BAL RE,MCLXBMP BUMP BSU 54325000 + B MCLAMPR0 PROCEED A 54330000 +MCLAMPRT EQU * 54340000 + TM AVMBYTE2,$MOPRTR PREV BSU = OPRTR? 54345000 + BO MCLAMPR1 PROCEED IF YES 54350000 + SPACE 2 54365000 +MCLAMPR0 BAL RET,MCLXCATI INSERT CONCAT OPR A 54365100 +MCLAMPR1 EQU * 54370000 + TM AVMBYTE1,$MINQUOT INSIDE QUOTES? 54375000 + BNO MCLAMPR2 PROCEED IF NOT 54380000 + OI MCBSFLGS,$MINQUOT ELSE SET QUOTR FLAG IN BSU 54385000 +MCLAMPR2 EQU * 54390000 + $CALL MCSYSR FIND SYMBOL IN DICTIONARIES 54395000 + LTR RB,RB OKAY? 54400000 + BP MCLXERTN UNDEFINED IF RB > 0 54405000 + BM MCLXISER INVALID SYMBOL IF RB < 0 54410000 + B *(RD) JUMP TO ROUTINE 54415000 + B MCLAGLOB GLOBAL SYMBOL? 54420000 + B MCLALOCL LOCAL SYMBOL? 54425000 + B MCLASYPR SYMBOLIC PARAMETER? 54430000 + USING MCPARENT,RC SET USING FOR PARAMETER 54435000 +MCLASYSV EQU * SYTEM VARIABLE IF BRANCH HERE 54440000 + CLI MCPARNLN,X'08' COMPARE LENGTH 54445000 + BE MCLASYLS IF 8, MUST BE SYSLIST 54450000 + CLI MCPARNAM+6,C'X' IS IT &SYSNDX 54455000 + BE MCLASYDX PROCESS IF YES 54460000 + MVI MCBSINDX,$BSYSECT MUST BE &SYSSECT 54465000 + B MCLXTRMF 54470000 +MCLASYLS EQU * 54475000 + MVI MCBSINDX,$BSYSLST SET &SYSLST INDEX IN BSU 54480000 + OI AVMDWRK4,$MINSYSL SET SYSLIST FLAG IN PAREN BYTE 54490000 + B MCLAGSYL GO TO MAKE SURE ( THERE AND FLAG J 54495000 +MCLASYDX EQU * 54500000 + MVI MCBSINDX,$BSYSNDX SET &SYSNDX FLAG IN BSU 54505000 + B MCLXTRMF 54510000 +* SYMBOLIC PARAMETER FOUND A 54510100 +MCLASYPR EQU * 54515000 + MVI MCBSINDX,$BSYMPAR SET SYMBOLIC PARAM BSU INDEX 54520000 + LH R2,MCPARNDX GET SYM PAR POSITION 54525000 + ST R2,MCBSLOC STORE IN BSU 54530000 + CLI 0(RA),C'(' NEXT CHAR = '('? 54535000 + BNE MCLXTRMF PROCEED TO FOOT IF NOT 54540000 + OI AVMBYTE2,$MDIMVAR ELSE SET DIM VARIABLE FLAG 54545000 + B MCLXTRMF 54550000 + DROP RC 54555000 + SPACE 2 54560000 +* GLOBAL SYMBOL FOUND A 54560100 + USING MCGLBDCT,RC 54565000 +MCLAGLOB EQU * 54570000 + ST RC,MCBSLOC STORE ENTRY @ IN BSU 54575000 + CLI MCGLBTYP,X'08' WHAT TYPE OF GLOBAL SYMBOL? 54580000 + BH MCLASY01 54585000 + BL MCLASY02 ARITH IF LOW 54590000 + MVI MCBSINDX,$BSTSYBG MUST BE BOOL IF FALLS THROUGH 54595000 + OI MCBSFLGS,$BSBOOL SET BOOLEAN FLAG 54600000 + B MCLAGLFT 54605000 +MCLASY01 EQU * 54610000 + MVI MCBSINDX,$BSTSYCG SET CHAR BSU INDEX 54615000 + OI MCBSFLGS,$BSCHAR SET CHAR FLAG 54620000 + B MCLAGLFT 54625000 +MCLASY02 EQU * 54630000 + MVI MCBSINDX,$BSTSYAG SET ARITH BSU INDEX 54635000 + OI MCBSFLGS,$BSAR SET ARITH FLAG 54640000 + B MCLAGLFT 54645000 + DROP RC 54650000 + SPACE 2 54655000 +* LOCAL SYMBOL FOUND A 54655100 + USING MCLCLDPV,RC 54660000 +MCLALOCL EQU * ROUTINE FOR LOCAL SYMBOLS 54665000 + ST RC,MCBSLOC SAVE ENTRY @ IN BSU 54670000 + CLI MCLCLTYP,X'08' WHAT TYPE LOCAL SYMBOL? 54675000 + BH MCLASY03 CHAR IF HIGH 54680000 + BL MCLASY04 ARITH IF LOW 54685000 + MVI MCBSINDX,$BSTSYBL SET LOCAL INDEX IF FALLS THROUGH 54690000 + OI MCBSFLGS,$BSBOOL SET BOOLEAN TYPE FLAG 54695000 + B MCLAGLFT 54700000 +MCLASY03 EQU * 54705000 + MVI MCBSINDX,$BSTSYCL SET LOCAL CHAR SYMBOL INDEX 54710000 + OI MCBSFLGS,$BSCHAR SET CHAT TYPE FLAG 54715000 + B MCLAGLFT 54720000 +MCLASY04 EQU * 54725000 + MVI MCBSINDX,$BSTSYAL SET LOCAL ARTITH INDEX 54730000 + OI MCBSFLGS,$BSAR SET ARITH TYPE FLAG 54735000 +MCLAGLFT EQU * 54740000 + CLC MCLCLDIM,AWH1 SET SYMBOL DIMENSIONED? 54745000 + BE MCLASY06 IF NOT, JUMP 54750000 +MCLAGSYL OI AVMBYTE2,$MDIMVAR SHOW DIMENSIONED J 54755000 + CLI 0(RA),C'(' MUST BE LEFT PAREN 54760000 + BE MCLXTRMF OK IF YES 54765000 +MCLASY05 EQU * 54770000 + LA RB,$ERSSDIM ELSE SET SUBSCRIPT ERROR FLAG 54775000 + B MCLXERTN AND RETURN 54780000 +MCLASY06 EQU * 54785000 + CLI 0(RA),C'(' NEXT CHAR = (? 54790000 + BNE MCLXTRMF OKAY IF NOT 54795000 + TM AVMBYTE1,$MINQUOT INSIDE QUOTES? 54800000 + BO MCLXTRMF PAREN OKAY IF YES 54805000 + B MCLASY05 ELSE FLAG BAD PAREN 54810000 + DROP RC 54815000 + SPACE 2 54820000 +* PERIOD FOUND, LEGAL IF IN CHAR EXP & IF NOT, CONCATINATION OPERATOR A 54820100 +* NEEDED AND BSU INSERTED A 54820200 +MCLPEROD EQU * 54825000 + TM AVMBYTE2,$MINCHAR IN CHAR EXPRESSION? 54830000 + BNO MCLXSYER ERROR IF NOT 54835000 + TM AVMBYTE1,$MINQUOT ARE WE IN QUOTES? 54840000 + BNO MCLPER01 PROCEED IF NO 54845000 + CR R0,R1 POINTER MOVED? 54850000 + BE MCLPER02 PROCEED IF NOT 54855000 +MCLPER00 EQU * 54860000 + LA RA,1(R1) ELSE BUMP PNTR PAST '.' AND RESUME 54865000 + B MCLXSCAN SCAN 54870000 +MCLPER02 EQU * 54875000 + CLI 1(R1),C'&&' POSSIBLE VAR SYMBOL? 54880000 + BNE MCLPER0A PROCEED IF NOT 54885000 + CLI 2(R1),C'&&' DOUBLE '&&'? 54890000 + BNE MCLPER0B CAT OPRTR IF NOT 54895000 +MCLPER0A EQU * 54900000 + IC R2,1(R1) GET NEXT CHARACTER 54905000 + LA R2,AWTSYMT(R2) USE AS POINTER INTO TABLE 54910000 + CLI 0(R2),X'00' NEXT CHAR IS ALPHANUM? 54915000 + BNE MCLPER00 TREAT PERIOD AS CHAR IF NOT 54920000 +MCLPER0B EQU * 54925000 + CLI MCBSINDP,$BSCAT PREV SYM= COCAT? A 54940000 + BE MCLPER00 TREAT AS CHAR IF YES 54945000 +MCLPER01 EQU * 54950000 + $SCOF RB,R1,MCBSOFST GET OFFSET OF CAT OPRTR 54955000 + BAL RET,MCLXCATI ELSE INSERT CAT OPRTR 54960000 + B MCLXSTRS RESUME SCAN S 54970000 + SPACE 4 54975000 +* QUOTE FOUND, PROCESS FOR CHAR END, NULL STRING SYMBOL(DOUBLE QUOTES)A 54975100 +* ALSO ERROR CHECKING DONE A 54975200 +MCLQUOTE EQU * 54980000 + C R1,AVSOLAST END OF RECORD? 54985000 + BNL MCLQUER1 ERROR IF YES 54990000 + TM AVMBYTE1,$MINQUOT ARE WE IN QUOTES? 54995000 + BNO MCLQ02 IF NOT, SET FLAGS AND PROCEED 55000000 + CLI 1(R1),C'''' DOUBLE QUOTE? 55005000 + BNE MCLQTF IF NOT, GET STRING 55010000 + LA RA,2(R1) ELSE BUMP POINTER AND RESUME SCAN 55015000 + B MCLXSCAN 55020000 +MCLQ01 EQU * 55025000 + LR RB,R1 COPY END OF STRING + 1 55030000 + LR RA,R0 COPY START OF STING 55035000 + $CALL MCGTST GET STRING 55040000 + ST RC,MCBSLOC SAVE LOCATION IN BSU 55045000 + STC RD,MCBSTRLN SAVE STRING LENGTH IN BSU 55050000 + MVI MCBSINDX,$BSTRING IDENT BSU 55055000 + OI MCBSFLGS,$MINQUOT FLAG BSU AS IN QUOTE 55060000 + LA RA,1(R1) BUMP SCAN POINTER PAST QUOTE 55065000 + XI AVMBYTE1,$MINQUOT TURN QUOTE FLAG ON/OFF 55070000 + B MCLXTRMF 55075000 +MCLQ02 EQU * 55080000 + TM AVMBYTE2,$MINARIT IN ARITH EXPRESSION? 55085000 + BO MCLXISER ERROR IF YES 55090000 + XI AVMBYTE1,$MINQUOT TURN ON QUOTE FLAG 55095000 + B MCLXSTRS RESUME SCAN S 55105000 +MCLQTF EQU * 55110000 + CR R0,R1 STRING PRESENT? 55115000 + BNE MCLQTF01 IF YES, PROCEED 55120000 + BCTR R1,0 ELSE DECR POINTER 55125000 + CLI 0(R1),C'''' PREV CHAR = QUOTE? 55130000 + LA R1,1(R1) RESTORE POINTER BEFORE TEST 55135000 + BE MCLQ01 IF YES, PROCESS NULL STRING 55140000 + B MCLQ02 ELSE TURN OFF FLAG AND RESUME SCAN 55145000 +MCLQTF01 EQU * 55150000 + TM AVMBYTE2,$MTERM PREV BSU = TERM? 55155000 + BNO MCLQ01 PROCEED IF NOT 55160000 + BAL R14,MCLXCATI ELSE INSERT CATEN OPRTR 55165000 + B MCLQ01 AND THEN PROCEED 55170000 + SPACE 2 55175000 + SPACE 55180000 +MCLQUER1 EQU * 55185000 + LR RA,R1 GET @ OF RECORD ENDING QUOTE 55190000 + S RA,=F'2' DECR TO END OF OPERAND 55195000 + B MCL$ERV S 55200000 + SPACE 2 55210000 +MCLBLANK EQU * 55215000 + LTR RY,RY STILL IN PARENS? 55220000 + BZ MCLXFOOT RETURN IF NOT 55225000 + TM AVMBYTE2,$MINBOOL IN BOOLEAN EXPRESSION 55230000 + BO MCLXSTRS OK IF YES, RESUME SCAN S 55235000 +MCL$ERV LA RB,$ERVUNEX ELSE SET ERROR FLAG S 55240000 + B MCLXERTN AND RETURN 55245000 + SPACE 4 55260000 +MCLXOPRF EQU * 55265000 + TM AVMBYTE2,$MOPRTR PREV BSU = OPRTR? 55270000 + BNO MCLXDLMF OKAY IF NOT 55275000 + CLI MCBSINDX,$BSNOT IS CURRENT SYMBOL = NOT ? S 55280000 + BNE MCLXOPER ERROR IF NOT 55290000 + CLI MCBSINDP,$BSLPAR IS IT LEFT PAREN A 55295000 + BE MCLXOP01 OKAY IF YES 55300000 + CLI MCBSINDP,$BSAND IS IT AN AND? A 55305000 + BE MCLXOP01 OKAY IF YES 55310000 + CLI MCBSINDP,$BSOR IT IS OR? A 55315000 +MCLXOP01 EQU * 55320000 + BE MCLXDLMF RESUME SCAN IF ONE OF (, AND OR 55330000 + B MCLXSYER ELSE FLAG ERROR 55335000 +MCLXOPER EQU * 55340000 + CLI MCBSINDP,$BSRPAR PREV SYMBOL = RIGHT PAREN ? S 55345000 + BE MCLXOP01 OKAY IF YES 55350000 + B MCLXSYER ELSE FLAG ERROR 55355000 + SPACE 4 55360000 +MCLXTRMF EQU * 55365000 + TM AVMBYTE2,$MTERM PREV BSU = TERM? 55370000 + BO MCLXSYER ERROR IF YES 55375000 + OI MCBSFLGS,$MTERM SET FLAG IN BSU 55380000 + XI AVMBYTE2,$MOPRTR+$MTERM TURN ON TERM FLAG 55385000 + B MCLXF09 JUMP TO FOOT 55390000 + SPACE 4 55395000 +MCLXDLMF EQU * 55400000 + OI MCBSFLGS,$MOPRTR TURN ON OPRTR FLG IN BSU 55410000 + NI AVMBYTE2,X'FF'-$MDIMVAR-$MTERM TERM,DIMVAR FLAGS A 55415000 + OI AVMBYTE2,$MOPRTR TURN ON OPRTR FLAG 55420000 + B MCLXF09 55425000 + SPACE 4 55430000 +**--> INSUB: MCLXCATI ROUTINE TO INSERT CONCATINATION + + + + + + +A 55435000 +*+ A 55440000 +*+ CALLED WHEN CONCATINATION OPERATION NEEDED, INSERTR BSU A 55440100 +*+ A 55440200 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A 55440300 + SPACE 2 A 55440400 +MCLXCATI EQU * 55445000 + MVI MCBSINDX,$BSCAT SET CATEN INDEX 55450000 + MVI MCBSHIER,$MCATHR SET HEERARCHY 55455000 + TM AVMBYTE1,$MINQUOT INSIDE QUOTES? 55460000 + BNO MCLXCAT1 SKIP IF NOT 55465000 + OI MCBSFLGS,$MINQUOT SET IN QUOTE FLAG IN BSU 55470000 +MCLXCAT1 EQU * 55475000 + OI MCBSFLGS,$MOPRTR SET OPRTR FLAG IN BSU 55480000 + BAL RE,MCLXBMP BUMP BSU 55485000 + NI AVMBYTE2,X'FF'-($MOPRTR+$MTERM) TURN OFF FLAGS 55490000 + OI AVMBYTE2,$MOPRTR SET PREV SYMBOL = OPRTR FLAG 55495000 + BR R14 RETURN 55500000 + SPACE 4 55505000 +**--> INSUB: MCLXBMP BUMP POINTER + + + + + + + + + + + + + + +S 55505100 +*+ SAVE PREVIOUS BSU AND BUMP POINTER +S 55505200 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 55505300 + SPACE 2 S 55505400 +MCLXBMP EQU * 55510000 + MVC MCBSFLGP(4),0(RW) MOVE PREV BSU INTO WRK AREA A 55510100 + XSNAP T=NO,STORAGE=(*0(RW),*8(RW)),LABEL='BSU - MACLEXP', #55511000 + IF=(AVTAGSM,O,AJOMACRH,TM) 55512000 + LA RW,$LMCBSU(RW) BUMP BSI POINTER A 55515000 + C RW,AVMCHLIM WORK AREA EXCEEDED? 55520000 + BL MCLXBMP1 OK IF NOT 55525000 + LA RB,$ERVTMTR ELSE FLAG TOO MANY TERMS 55530000 + B MCLXERTN AND RETURN 55535000 +MCLXBMP1 EQU * 55540000 + MVC MCBSU(8),AWZEROS ZERO NEW BSU 55545000 + BR RE AND RETURN 55550000 +MCBSFLGP DS C PREVIOS A 55550100 +MCBSINDP DS C BSU A 55550200 +MCBSOFSP DS C WORK A 55550300 +MCBSHIEP DS C AREA A 55550400 + SPACE 2 55555000 +MCLXF09 EQU * 55560000 + $SCOF RB,R0,MCBSOFST GET OFFSET INTO BSU 55565000 + BAL RE,MCLXBMP BUMP BSU 55570000 + TM AVMBYTE4,$MINSTRN PROCESSING OUTSIDE VAR SYMBOL? 55575000 + BNO MCLXSTRT IF NOT, RESUME SCAN 55580000 + NI AVMBYTE4,X'FF'-$MINSTRN ELSE TURN OFF FLAG 55585000 + CLI 0(RA),C'(' PAREN FOLLOWING? 55590000 + BNE MCLXFOOT RETURN IF NOT 55595000 + OI AVMBYTE2,$MINPEXP ELSE SET PARENS ONLY FLAG 55600000 + B MCLXSTRT AND RESUME SCAN 55605000 + SPACE 2 55610000 +MCLXISER EQU * 55615000 + LR RA,R0 RESTORE SCAN POINTER 55620000 + LA RB,$ERINVSY SET INVALID SYMBOL FLAG 55625000 + B MCLXERTN AND RETURN 55630000 + SPACE 2 55635000 +MCLEXERR EQU * 55640000 +MCLXSYER EQU * 55645000 + LR RA,R0 RESTORE SCAN POINTER 55650000 + LA RB,$ERVSYNT SET SYNTAX ERROR FLAG 55655000 + B MCLXERTN AND RETURN 55660000 + SPACE 2 55665000 +MCLXFOOT EQU * 55670000 + SR RB,RB 55675000 + TM AVMBYTE2,$MOPRTR LAST BSU = OPRTR? 55680000 + BNO MCLXERTN RETURN NORMALLY IF NOT 55685000 + CLI MCBSINDP,$BSRPAR IT IS RIGHT PAREN? A 55695000 + BE MCLXERTN RETURN S 55710000 +MCLXFTER EQU * 55715000 + $SCPT RA,MCBSOFST GET POINTER TO ERROR 55720000 + LA RB,$ERVSYNT SET ERROR FLAG 55725000 +MCLXERTN EQU * 55730000 +MCLEQUAL EQU MCLXERTN ERROR IF '==' TURNS UP S 55730100 + $SETRT ('''',0,'&&',0,'.',0) RESTORE TRT TABLE 55735000 + MVI AWTDECT+C'+',2 55740000 + MVI AWTDECT+C'-',2 55745000 + MVI AWTDECT+C'/',2 RESTORE AWTDEDT TABLE TO ORIGINAL 55750000 + MVI AWTDECT+C')',2 CONDITIONS BEFORE RETURNING 55755000 + MVI AWTDECT+C'''',2 55760000 + MVI AWTDECT+C'&&',2 55765000 + MVI AWTDECT+C'.',2 55770000 + XSNAP LABEL='***MACLEX EXITED***',IF=(AVMSNBY2,O,$MSNP09,TM) 55775000 + LR RC,RW SET BSU POINTER 55780000 + $RETURN RGS=(R14-R6) 55785000 + LTORG 55790000 + DROP RAT,RW 55795000 + TITLE '*** MCGNCD - GENERATE INTERNAL CODE FOR MACRO S' 55800000 +**--> CSECT: MCGNCD CONVERTS STRING OF BSU'S TO INTERNAL CODE * 55805000 +*. IN ONE-OP FORM. ONE-OPS ARE QUADRUPLES WITH OPRTR, TWO * 55810000 +*. OPRNDS AND RESULT FIELD. ADDRESS OF CURRENT GENERATED INST* 55815000 +*. IS IN AVMCRINS. GEERATED CODE IS POINTED TO BY MCCODLNK * 55820000 +*. FIELD IN MACLIB. BSU STRING LOCATED IN AVMWRK1 * 55825000 +*. * 55830000 +*. ENTRY CONDITIONS * 55835000 +*. RC = @ OF CURRENT MACLIB ENTRY * 55840000 +*. * 55845000 +*. USES MACROS: $CALL,$SAVE,$RETURN,$SCOF,$SCPT,$ALLOCL,$ALLOCH* 55850000 +*. USES DSECTS: AVWXTABL,MCBSU,MCBSTRMS,MCBOPRST,MCOPQUAD, * 55855000 +*. MACLIB,MCSEQ * 55860000 +*. CALLS MACFND, ERRTAG, * 55865000 +*. * 55870000 +*. REGISTER USAGE: S 55870100 +*. WORK REGS: R0,R1,RA,RB,RC,RE S 55870150 +*. TRT BYTE REG: R2 S 55870200 +*. RW - BASE REG FOR BSU S 55870250 +*. RX - BASE REG FOR OPRND STACK S 55870300 +*. RY - BASE REG FOR OPRTR STACK S 55870350 +*. RZ - BASE REG FOR ONE-OP ENTRY S 55870400 +*. RAT - BASE REG FOR MAIN TABLE S 55870450 +*. R1 - BASE REG FOR MACLIB S 55870475 +*. RD - UNUSED S 55870500 +*. S 55870550 +*.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 55875000 + SPACE 2 55880000 +MCGNCD CSECT 55885000 + $SAVE RGS=(R14-R6),BR=13,SA=* 55890000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 55895000 + XSNAP LABEL='***MCGNCD ENTERED***',IF=(AVMSNBY2,O,$MSNP10,TM) 55900000 + USING MCBSU,RW NOTE USING FOR BSU INPUT STRING 55905000 + USING MCBSTRMS,RX USING FOR OPRND STACK 55910000 + USING MCBOPRST,RY USING FOR OPRTR STACK 55915000 + USING MCOPQUAD,RZ USING FOR ONE-OP ENTRY 55920000 + USING MACLIB,RC USING FOR MACLIB ENTRY 55925000 + NI AVMBYTE4,X'FF'-($MCOMST+$MRPARST) CLEAR COMMA, RP FLAG 55930000 + LA R0,$LMCBSU LENGTH OF BSU FOR BUMPING A 55935000 + SR R2,R2 CLEAR BYTE REGISTER A 55940000 + LA RB,$LMCOPL1 GET LENGTH OF PREFIX SECTION A 55940100 + $ALLOCL RE,RB,MCGNCDOV GET SPACE FOR IT A 55940150 + MVC 0($LMCOPL1,RE),AWZEROS CLEAR OUT ONE-OP PREFIX A 55940200 + L RZ,AVMCRINS GET PREV INST @ 55945000 + LTR RZ,RZ 1ST INSTRUCTION? 55950000 + BNZ MCGNCD00 IF NOT, PROCEED 55955000 + LA RZ,MCCODLNK FAKE POINTER AS 1ST ONE A 55960000 +MCGNCD00 EQU * 55970000 + ST RE,MCQUDNXT SAVE LINK IN PREV INSTRUCTION 55975000 +* CREATE STACK OF ONE OPS A 55975100 +MCGNCD01 EQU * 55980000 + LR RZ,RE SET BASE TO NEW ENTRY 55985000 + ST RZ,AVMCRINS SAVE CURRENT INST @ 55990000 + ZAP MCQSTMNO,AVOULNCN STORE CURRENT PACKED DEC STMT NBR 56000000 + L RW,AVMCHSTR GET @ OF BSU INPUT STRING 56005000 + XSNAP LABEL='BEGIN MCGENCD',STORAGE=(*0(RW),*100(RW)), X56005100 + IF=(AVTAGSM,O,AJOMACRH,TM) A 56005101 + LA RX,AVMWRK2 USE AVMWRK2 FOR OPRND STACK 56010000 + LA RY,AVMWRK1 USE QVMWRK1 FOR OPRTR STACK 56015000 + MVC MCBSTRMS($LMCBSU),AWZEROS CLEAR OPRND STACK 56020000 + MVC MCBOPRST($LMCBSU),AWZEROS CLEAR OPRTR STACK 56025000 + SR RX,R0 DECR APRND PTR FOR STMT A 56035000 +* POP BSU, SET PRIORITIES AND PUSH ON APPROPRIATE STACK A 56035200 +MCGNCDSC EQU * 56040000 + CLI MCBSINDX,X'00' END OF BSU'S? 56045000 + BE MCGENCD IF YES , POP INSTRUCTIONS 56050000 + TM AVMBYTE4,$MRPARST+$MCOMST PAREN OR COMMA FLAG ON? 56055000 + BM MCGENCD IF YES, POP INSTRUCTION 56060000 + TM MCBSFLGS,$MTERM TERM? 56065000 + BNO MCGNCD02 IF NOT, PROCESS OPRTR 56070000 + AR RX,R0 ELSE BUMP OPRND STACK PTR A 56075000 + MVC MCBSFLG2($LMCBSU),MCBSU ELSE PUSH TERM ON OPRND STACK 56080000 + B MCGNCD06 56085000 +MCGNCD02 EQU * 56090000 + CLI MCBSINDX,$BSCOMMA COMMA? 56095000 + BNE MCGNCD03 TEST FOR PAREN IF NOT 56100000 + OI AVMBYTE4,$MCOMST ELSE SET FLAG 56105000 + B MCGNCD06 AND JUMP TO FOOT 56110000 +MCGNCD03 EQU * 56115000 + CLI MCBSINDX,$BSRPAR REGHT PAREN? 56120000 + BNE MCGNCD04 PROCEED IF NOT 56125000 + OI AVMBYTE4,$MRPARST ELSE SET FLAG 56130000 + B MCGNCD06 AND JUMP TO FOOT 56135000 +MCGNCD04 EQU * 56140000 + CLI MCBSHIER,$MPARHR PAREN? 56145000 + BNE MCGNCD05 PROCEED IF NOT 56150000 + CLI MCBSINDX,$BSBSTR SUBSTRING? 56155000 + BNE MCGNPUSH IF NOT, PUSH ONTO OPRTR STACK 56160000 + CLI MCBSOPST,$BSCAT CAT OPRTR IN STACK? 56165000 + BNE MCGNPUSH PUSH OPRTR IF NOT 56170000 + TM MCBOPFL,$MINQUOT CAT OPRTR IN QUOTES? 56175000 + BO MCGENCD POP OPRTR IF YES 56180000 +MCGNPUSH EQU * 56185000 + AR RY,R0 BUMP STACK POINTER A 56190000 + MVC MCBOPRST($LMCBSU),MCBSU PUSH OPRTR ONTO STACK 56195000 + B MCGNCD06 JUMP TO FOOT 56200000 +MCGNCD05 EQU * 56205000 + CLI MCBSINDX,$BSCAT CAT OPRTR? 56210000 + BNE MCGNCD07 PROCESS NORMALLY IF NOT 56215000 + TM MCBSFLGS,$MINQUOT CAT OPRTR IN QOTES? 56220000 + BNO MCGNCD07 PROCESS NORMAL IF NOT 56225000 + CLC MCBSHIER,MCBOPHR COMPARE HIERARCHIES 56230000 + BNL MCGNPUSH H(OPRRTR) >=H(STACK) THEN PUSH 56235000 + B MCGENCD ELSE POP OPRTR 56240000 +MCGNCD07 EQU * 56245000 + CLC MCBSHIER,MCBOPHR COMPARE HIERARCHIES 56250000 + BH MCGNPUSH PUSH OPRTR ONLY IF HIGH 56255000 + B MCGENCD ELSE POP OPRTR 56260000 +MCGNCD06 EQU * 56265000 + AR RW,R0 POP INPUT BSU STACK A 56270000 + B MCGNCDSC AND RESUME SCAN OF INPUT 56275000 +MCOPRBAS DS 0H 56280000 + EJECT A 56280100 +MCGENCD EQU * 56285000 + NI AVMBYTE1,X'FF'-$MINQUOT TURN OFF QUOTE FLAG 56290000 + TM MCBSFLG1,$MINQUOT FIRST TERM IN QUOTES? 56295000 + BZ MCGENCD0 PROCEED IF NOT 56300000 + OI AVMBYTE1,$MINQUOT ELSE SET QUOTE FLAG 56305000 +MCGENCD0 EQU * 56310000 + CLI MCBOPHR,$MPARHR LEFT PAREN? 56315000 + BNE MCGENCD2 PROCEED IF NOT 56320000 + TM AVMBYTE4,$MCOMST WORKING ON COMMA? 56325000 + BNO MCGENCD1 PROCEED IF NOT 56330000 + XI AVMBYTE4,$MCOMST ELLE TURN OFF COMMA FLAG 56335000 + B MCGNCDSC AND RESUME SCAN 56340000 +MCGENCD1 EQU * 56345000 + NI AVMBYTE4,X'FF'-$MRPARST ELSE TURN OFF PAREN FLAG 56350000 + CLI MCBSOPST,$BSLPAR ORDINARY LEFT PAREN? 56355000 + BE MCGENRT IF YES POP OPRTR AND RESUME SCAN 56360000 +* A 56360050 +* ALLOCATE SPACE FOR ONE OP ENTRIES A 56360100 +* HIERARCHY AND JUMP ON INDEX TO PROCESS A 56360200 +* A 56360300 +MCGENCD2 EQU * 56365000 + CLI MCBSOPST,X'00' OPRTR STACK EMPTY? 56370000 + BE MCGNCDRT RETURN IF YES 56375000 + BAL RET,MCGNALLO ALLOCATE SP FOR 1 OP ENTRY S 56395000 + IC R2,MCBOPHR GET HIERARCHY 56400000 + LH R1,MCOPRNDX(R2) GET OFFSET 56405000 + B MCOPRBAS(R1) JUMP TO ROUTINE 56410000 + SPACE 56415000 +MCOPRNDX $AL2 MCOPRBAS,(MCPARGEN,MCHRTW,MCORGEN,MCANDGEN,MCRELGEN,MCCAX56420000 + TGEN,MCPLSGEN,MCMULGEN,MCNOTGEN) 56425000 + SPACE 56430000 +* PAREN BSU FOUND PUT ONE-OP ON STACK A 56430100 +* A 56430200 +MCPARGEN EQU * HIER = 0 ROUTINES 56435000 + BAL RE,MCMVTRMS MOVE ARGS TO ONE-OP 56440000 + CLI MCBOPRTR,$BSBSTR SUBSTRING PAFEN? 56445000 + BE MCPARG0Q PROCEED IF NOT S 56450000 +MCPARG02 EQU * 56465000 + CLI MCARG1DX,$BSATT 1ST ARG IS T'? 56470000 + BE MCPARG0Q TREAT AS QUOTED STRING IF YES 56475000 + TM AVMBYTE1,$MINQUOT FIRST TERM INSIDE QUOTES? 56480000 + BZ MCPARG03 PROCEED IF NOT 56485000 +MCPARG0Q EQU * 56490000 + OI MCBSFLG2,$MINQUOT SET QUOTE FLAG IN OPRND STACK 56495000 +MCPARG03 EQU * 56500000 + SR RW,R0 DECR PTR TO CHECK PREV ENTRY S 56510000 + TM MCBSLOC+3,X'01' TWO ARG'S IN PARENS? 56515000 + LA RW,$LMCBSU(RW) RESTORE POINTER 56520000 + BNO MCGENRT PROCEED IF NOT 56525000 + BAL RET,MCGNALLO ALLOCATE SP FOR 1 OP ENTRY S 56540000 + MVC MCARG1DX,MCBSNDX1 MOVE IDENT OF ARG INTO ONE-OP 56545000 + MVC MCARG1LC,MCBSLOC1 MOVE LOCATION OF OPRND INTO ONE-OP 56550000 + CLI MCARG1DX,$BSTRING STRING TERM? 56555000 + BNE MCPARG04 PROCEED IF NOT 56560000 + MVC MCARG1LC(1),MCBLN1 MOVE LENGTH OF STRING INTO ONE-OP 56565000 +MCPARG04 EQU * 56570000 + MVC MCBSFLG1($LMCBSU),MCBSFLG2 PUSH DOWN OPRND STACK 56575000 + B MCTWODEC DECR OPRND STACK 56580000 + SPACE 56585000 +* HEIR=2, PUT ONE-OP ON STACK A 56585100 +* A 56585200 +MCHRTW EQU * 56590000 + MVC MCBOPRTR,MCBSOPST MOVE OPRTR FROM STACK TO ONE-OP 56595000 + CLI MCBSOPST,$BSPRINT WHICH BSU OF HIER = 2? 56600000 + BL MCTWOSET IF LOW, MUST BE SETX 56605000 + BE MCTWOPRA IF EQUAL MUST BE PRINT A 56610000 + CLI MCBSOPST,$BSINMAC ELSE IS IT INNER MACRO CALL? 56615000 + BNL MCTWOPR INNER IF EQUAL, MVSTR IF HIGH 56620000 +* NOTE: THESE JUST USE ONE-OP PREFIX BY THEMSELVES A 56625000 + L RZ,AVMCRINS GET # PREFIX ONE-OP A 56630000 + MVC MCQS1FLG,MCBSOPST COPY OPERATOR OVER A 56631000 + B MCPREFIX GO TO PREFIX-ONLY EXIT A 56635000 +MCTWOSET EQU * 56640000 + BAL RE,MCMVTRMS MOVE OPRNDS INTO ONE-OP 56645000 + B MCTWODEC 56650000 +MCTWOPRA TM MCBOPFL,$MPRCOM WAS THIS SPECIAL PRINT COMMENT UP A 56654000 + BZ *+8 NO, SKIP A 56654100 + OI MCBOPRTR,$MPRCOM YES, MAKE PRINT OPRTR ODD, SO KNOW A 56654200 +MCTWOPR EQU * 56655000 + MVC MCARG2LC+3(1),MCBOPOF MOVE OFFSET INTO INTO ARG2LC 56660000 + MVC MCARG1DX,MCBSNDX2 MOVE TYPE INTO ARG1DX 56665000 + MVC MCARG1LC,MCBSLOC2 MOVE LOCATION OF STRING INTO ONE-OP 56670000 + CLI MCBSNDX2,$BSTRING INDEX BSU IS CHAR STRING? 56675000 + BNE MCTWODEC SKIP MOVE LEN IF NOT 56680000 + MVC MCARG1LC(1),MCBLN2 MOVE LENGTH INTO LOC FIELD 56685000 + B MCTWODEC DECR OPRND STACK 56690000 +* A 56690100 +* PLUS OR MULTIPLY BSU FOUND PUT ONE-OP ON STACK A 56690200 +* A 56690300 +MCPLSGEN EQU * 56695000 +MCMULGEN EQU * 56700000 + BAL RE,MCMVTRMS MOV& OPRNDS INTO ONE-OP 56705000 + MVI MCBSFLG2,$MTERM+$BSAR IDENT OPRND STACK TOP AS ARITH TR 56710000 + B MCGENRT JUMP TO FOOT 56715000 + SPACE 56720000 +* A 56720100 +* AND | OR BSU FOUND, PUT ONE OP ONTO STACK A 56720200 +* A 56720300 +MCORGEN EQU * 56725000 +MCANDGEN EQU * 56730000 + TM MCBSFLG1,$BSBOOL 1ST OPRND = BOOL? 56735000 + BNO MCMXDR1 ERROR IF NOT 56740000 + TM MCBSFLG2,$BSBOOL 2ND OPRND = BOOL? 56745000 + BNO MCMXDR1 ERROR IF NOT 56750000 + BAL RE,MCMVTRMS MOVE OPRNSD INTO ONE-OP 56755000 + MVI MCBSFLG2,$MTERM+$BSBOOL IDENTIFY AS BOOLEAN TERM 56760000 + B MCGENRT JUMP TO FOOT 56765000 + SPACE 56770000 +* RELATIONAL OPERATOR FOUND PUT ONE-OP ONTO STACK A 56770100 +* A 56770200 +MCRELGEN EQU * 56775000 + MVI AVMBYTE3,X'00' CLEAR AVMBYTE3 FOR FLAG USE 56780000 + TM MCBSFLG1,$MINQUOT 1ST TERM IN QUOTES? 56785000 + BO MCRELG02 56790000 + TM MCBSFLG2,$MINQUOT 2ND TERM IN QUOTES? 56795000 + BO MCRELG03 56800000 + B MCRELG01 ELSE PROCEED 56805000 +MCRELG02 EQU * 56810000 + OI AVMBYTE3,$BSRLCHR SET CHAR RELTN FLAG 56815000 + TM MCBSFLG2,$MINQUOT 2ND TERM IN QUOTES? 56820000 + BO MCRELG01 OKAY IF YES 56825000 + CLI MCBSNDX2,$BSATT ELSE IS IT T'? 56830000 + BE MCRELG01 OKAY IF YES 56835000 + B MCMXDR2 ELSE ERROR 56840000 +MCRELG03 EQU * 56845000 + OI AVMBYTE3,$BSRLCHR SET CHAR RELTN FLAG 56850000 + CLI MCBSNDX1,$BSATT 1ST TERM = T'? 56855000 + BNE MCMXDR2 ELSE ERROR S 56865000 +MCRELG01 EQU * 56870000 + BAL RE,MCMVTRMS MOVE TERMS INTO ONE-OP 56875000 + OC MCBOPRTR,AVMBYTE3 SET CHR OR ARIT FLAG IN OPRTR 56880000 + MVI MCBSFLG2,$MTERM+$BSBOOL IDENTIFY AS BOOLEAN TERM 56885000 + B MCGENRT JUMP TO FOOT 56890000 + SPACE 56895000 +* CATENATION BSU FOUND PUT ONE-OP ON STACK A 56895100 +* A 56895200 +MCCATGEN EQU * 56900000 + CLI AVMFLDT2,C'M' MACRO OPCODE? 56905000 + BNE MCCATG01 JUMP PAST QUOTE TEST IF NOT 56910000 + TM MCBSFLG1,$MTERM+$MINQUOT 1ST TERM IN QUOTES? 56915000 + BNO MCMXDR1 ERROR IF NOT 56920000 + TM MCBSFLG2,$MTERM+$MINQUOT 2ND TERM IN QUOTES? 56925000 + BNO MCMXDR1 ERROR IF NOT 56930000 +MCCATG01 EQU * 56935000 + BAL RE,MCMVTRMS MOVE OPRNDS INTO ONE-OP 56940000 + MVI MCBSFLG2,$MTERM+$BSCHAR+$MINQUOT IDENTIFY TEMP OPRND 56945000 + B MCGENRT JUMP TO FOOT 56950000 + SPACE 56955000 +* 'NOT' BSU FOUND PUT IN OP-OP STACK A 56955100 +* ALSO CHECK FOR AGO AND AIF, AND PROCESS IF FOUND A 56955200 +* A 56955300 +MCNOTGEN EQU * 56960000 + CLI MCBSOPST,$BSAGO AGO OPRTR? 56965000 + BH MCAIFGEN IF HIGH MUST BE AIF 56970000 + BE MCAGOGEN IF EQUAL MUST BE AGO 56975000 + TM MCBSFLG2,$MTERM+$BSBOOL BOOLEAN TERM? 56980000 + BNO MCMXDR2 ERROR IF NOT 56985000 + MVC MCARG1DX,MCBSNDX2 MOVE INDEX INTO ONE-OP 56990000 + MVC MCBOPRTR,MCBSOPST MOVE OPRTR INTO ONE-OP 56995000 + MVC MCARG1LC,MCBSLOC2 MOVE OPRND LOC INTO ONE-OP 57000000 + ST RZ,MCBSLOC2 PUT @ OF ONE-OP IN OPRND STACK 57005000 + MVI MCBSNDX2,$BSTEMP IDENTIFY STACK AS TEMP 57010000 + B MCGENRT JUMP TO FOOT 57015000 + SPACE 57020000 +* AGO OR AIF FOUND, PUT ON OP ON STACK A 57020100 +* A 57020200 +MCAGOGEN EQU * 57025000 + L RA,MCBOPVAL GET @ OF SEQ SYMBOL 57030000 + BAL RE,MCSEQSCN JUMP TO SCAN SEQ SYM DICT 57035000 + MVC MCBOPRTR,MCBSOPST MOVE OPRTR INTO ONE-OP 57040000 + B MCGENRT JUMP TO FOOT 57045000 + SPACE 57050000 +MCAIFGEN EQU * 57055000 + L RA,MCBSLOC2 GET ADDRESS OF SEQ SYMBOL 57060000 + TM MCBSFLG1,$BSBOOL BOOLEAN TERM? 57070000 + BNO MCMXDR1 ERROR IF NOT 57075000 + BAL RE,MCSEQSCN SEQRCH SEQ SYMBOL DICT A 57078000 + MVC MCARG1DX,MCBSNDX1 MOVE TERM ID TO ONE-OP 57080000 + MVC MCARG1LC,MCBSLOC1 MOVE LOCATION OF TERM TO ONE-OP 57085000 + MVC MCBOPRTR,MCBSOPST MOVE OPRTR INTO ONE-OP 57090000 + MVC MCARG2DX,MCBSNDX2 MOVE BSU TERM OF ARG INTO ONE-OP 57095000 + B MCTWODEC DECR OPRND STACK 57100000 + EJECT S 57105000 +**--> INSUB: MCSEQSCN ENTER SEQ SYMBOL IN DICT + + + + + + + + +S 57105100 +*+ SCAN FOR ERRORS & PUT SEQ SYMBOL IN DICT +S 57105200 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 57105300 + SPACE 2 S 57105400 +MCSEQSCN EQU * ROUTINE TO ENTER SEQ SYMBOL IN DICT 57110000 + DROP RC 57115000 + USING MCSEQ,RC SET USING FOR SEQ SYM ENTRY 57120000 + CLI 1(RA),C'0' FIRST CHAR IS LETTER? 57125000 + BNL MCSEQR1 ERROR IF DIGIT 57130000 + TRT 1(8,RA),AWTSYMT SCAN SYMBOL 57135000 + BZ MCSEQR1 SYMBOL 8+ CHARS, TOO LONG 57140000 + CLI 0(R1),C' ' DELIM = BLANK? 57145000 + BNE MCSEQR1 ERROR IF NOT 57150000 + SR R1,RA GET LENGTH 57155000 + BCT R1,MCSEQS01 DECR LENGTH FOR EX INST 57160000 + B MCSEQR1 BUT FALL THRU IF LENGHT = 1 57165000 +MCSEQS01 EQU * 57170000 + MVC AVMSYMBL,AWBLANK BLANK GLOBAL NAME AREA 57175000 + STC R1,AVMSYMLN STORE LENGTH 57180000 + EX R1,MCGMVC MOVE SYMBOL S 57185000 + AIF (NOT &$MACOPC).MCGNCDA SKIP IF NOT OPEN CODE S 57186000 + L R1,AVMACLIB LOAD @ OF MACLIB ENTRY S 57186020 + USING MACLIB,R1 NOTE USING ON MACLIB S 57186040 + TM MCLBFLG2,$MCOCFL1 IN OPEN CODE ? S 57186100 + BCR O,RE IF YES, SKIP SEQ SYM MANAGEMENT S 57186200 + DROP R1 S 57186250 +.MCGNCDA ANOP S 57186300 + L RC,AVMSEQPT GET SEQ SYM POINTER 57200000 + LA R1,0(RE) SAVE RETURN @ TEMP S 57205000 + $CALL MACFND SEARCH SEQ SYMBOL DICT 57210000 + LR RE,R1 RESTORE RETURN @ S 57215000 + LTR RB,RB SYMBOL PRESENT IN DECT? 57220000 + BZ MCSEQS02 PROCEED IF YES 57225000 + LA RB,$LMCSEQ ELSE GET LENGTH OF ENTRY 57230000 + $ALLOCH R1,RB,MCGNCDOV GET SPACE FOR NEW ENTRY 57235000 + ST R1,MCSEQNXT SAVE LINK IN PREV ENTRY 57240000 + LR RC,R1 MOVE BASE TO NEW ENTRY 57245000 + MVC MCSEQ($LMCSEQ),AWZEROS CLEAR NEW ENTRY 57250000 + MVC MCSEQNAM,AVMSYMBL MOVE NEW NAME INTO ENTRY 57255000 + MVC MCARG2LC,AVMCRINS STORE STMT @ IN ARG2 57260000 + ST RZ,MCSEQVAL SAVE LINK TO INST 57265000 + BR RE RETURN 57270000 +MCGMVC MVC AVMSYMBL($),0(RA) DUMMY INSTR S 57270100 +MCSEQS02 EQU * 57275000 + CLI MCSEQFLG,X'FF' SYMBOL DEFINED? 57280000 + BNE MCSEQS03 IF NOT, JUMP AND PROCESS 57285000 + MVC MCARG2LC,MCSEQVAL ELSE PUT VALUE IN ONE-OP 57290000 + BR RE AND RETURN 57295000 +MCSEQS03 EQU * 57300000 + LR R1,RZ COPY INST @ TEMPORARILY 57305000 + L RZ,MCSEQVAL GET POINTER FROM ENTRY 57310000 +MCSEQS04 EQU * 57315000 + CLC MCRESULT,AWZEROS END OF CHAIN? 57320000 + BE MCSEQS05 IF YES, ENTERLINK IN LAST ENTRY 57325000 + L RZ,MCRESULT ELSE GET POINTER TO NEXT LINK 57330000 + B MCSEQS04 AND TRY AGAIN 57335000 +MCSEQS05 EQU * 57340000 + ST R1,MCRESULT PUT CURRENT @ IN LAST LINK 57345000 + LR RZ,R1 RESTORE BSE OF ONE-OP 57350000 + MVC MCARG2LC,AVMCRINS STORE STMT @ IN ARG2 57355000 + BR RE AND RETURN 57360000 + DROP RC 57365000 + SPACE 57370000 +MCTWODEC EQU * 57375000 + SR RX,R0 POP OPRND STACK S 57380000 +MCGENRT EQU * 57390000 + SR RY,R0 POP OPERATOR STACK S 57395000 + B MCGNCDSC RESUME SCAN 57405000 + SPACE 5 S 57410000 +**--> INSUB: MCMVTRMS CREATE ONE BINARY ONE-OP + + + + + + + + +S 57410100 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 57410200 + SPACE 2 S 57410300 +MCMVTRMS EQU * ROUTINE TO CREATE ONE BINARY ONE OP 57415000 + MVC MCARG1DX,MCBSNDX1 MOVE 1ST TERM ID INTO ONE OP 57420000 + MVC MCARG2DX,MCBSNDX2 MOVE 2ND TERM ID INTO ONE OP 57425000 + MVC MCARG1LC,MCBSLOC1 MOVE 1ST TERM LOCATION INTO ONE-OP 57430000 + MVC MCARG2LC,MCBSLOC2 MOVE 2ND TERM LOCATION INTO ONE-OP 57435000 + CLI MCBSNDX1,$BSTRING BSU IS A STRING? 57440000 + BNE MCMVTRM1 JUMP IF NOT 57445000 + MVC MCARG1LC(1),MCBLN1 MOVE STRING LENGTH INTO ONE OP 57450000 +MCMVTRM1 EQU * 57455000 + CLI MCBSNDX2,$BSTRING 2ND TERM IS STRING? 57460000 + BNE MCMVTRM2 JUMP AROUND IF NOT 57465000 + MVC MCARG2LC(1),MCBLN2 ELSE MOVE STRING LENGTH INTO ONE-OP 57470000 +MCMVTRM2 EQU * 57475000 + SR RX,R0 POP OPRND STACK S 57480000 + MVI MCBSNDX2,$BSTEMP IDENTIFY OPRND STACK TOP AS TEMP 57490000 + MVC MCBOPRTR,MCBSOPST MOVE OPRTR FROM STACK TO ONE-OP 57495000 + ST RZ,MCBSLOC2 PUT TESULST LOCATION IN OPRND STACK 57500000 + BR RE RETURN 57505000 + SPACE 57510000 +* THE FOLLOWING SECTIONS ARE EXIT ROUTINES S 57510100 +* S 57510200 +MCMXDR1 EQU * 57515000 + LA RB,$ERVSYNT SETT ERROR TYPE 57520000 +MCMXDFLG EQU * 57525000 + $CALL ERRTAG FLAG STMNT 57535000 + L RZ,AVMCRINS MOVE BASE TO 1ST ONE-OP 57540000 + MVI MCQS1FLG,$BSERR01 SHOW ERRIR BSU A 57545000 +MCPREFIX EQU * ENTER FOR PREFIX/ONLY(NEND,MEXIT,ETA 57550000 + LA RZ,$LMCOPL1(,RZ) SHOW @ END OF PREFIX A 57555000 + ST RZ,AVADDLOW RESTORE LOW STORAGE 57560000 + B MCGNCDRT AND RETURN 57565000 + SPACE 57570000 +MCMXDR2 EQU * 57575000 + LA RB,$ERMXDMD SET MIXED MODE ERROR 57580000 + B MCMXDFLG JUMP AND FLAG STMNT 57585000 + SPACE 57590000 +MCSEQR1 EQU * 57595000 + LA RB,$ERINVSY SET BAD SYMBOL FLAG 57600000 + XSNAP LABEL='BAD SYBOL FLAGGED', X57601000 + IF=(AVTAGSM,O,AJOMACRH,TM) A 57601001 + B MCMXDFLG JUMP AND FLAG STMNT 57605000 + SPACE 57610000 +MCGNCDOV EQU * 57615000 + L REP,AVMOVRFL 57620000 + BR REP 57625000 + SPACE 57630000 +**--> INSUB: MCGNALLO ALLOCATE LOW CORE + + + + + + + + + + + +S 57630100 +*+ +S 57630200 +*+ ALLOCATES SPACE FOR OPERAND ENTRIES +S 57630300 +*+ +S 57630400 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 57630500 + SPACE 2 S 57630600 +MCGNALLO EQU * S 57630650 + LA RB,$LMCQUAD LOAD LENGTH OF AREA NEEDED S 57630700 + $ALLOCL RZ,RB,MCGNCDOV GET AREA FOR ONE OP S 57630750 + MVC 0($LMCQUAD,RZ),AWZEROS ZERO ENTRY S 57630800 + BR RET RETURN S 57630850 + SPACE 2 S 57630900 +MCGNCDRT EQU * 57635000 + XSNAP LABEL='MCGENCD EXITED', X57635100 + IF=(AVTAGSM,O,AJOMACRH,TM) A 57635101 + AIF (&$DEBUG).MCGNCDR 57640000 + L R1,AVMCRINS GET @ OF ONE-OPS 57645000 + XSNAP LABEL='***ONE-OP''S***',STORAGE=(*0(R1),*200(R1),*AVMWRK157650000 + 1,*AVMWRK1+64,*AVMWRK2,*AVMWRK2+64),IF=(AVMSNBY2,O,$MSNPX57655000 + 10,TM) 57660000 + XSNAP LABEL='***MCGNCD EXITED ***',IF=(AVMSNBY2,O,$MSNP10,TM) 57665000 +.MCGNCDR ANOP 57670000 + $RETURN RGS=(R14-R6) 57675000 + LTORG 57680000 + DROP RAT,RW,RX,RY,RZ 57685000 + TITLE 'MEXPND - MACRO EXPANSION' 57690000 +**--> CSECT: MEXPND EXPANDS MACRO DEFINITION. RECURSIVE. ACQUIRES * 57695000 +*. STORAGE FROM LOW DYNAMIC AREA FOR STANDARD SAVE AREA AND * 57700000 +*. LOCAL VARIABLES. RELEASES STORAGE ON EXIT. PUTS GENERATED * 57705000 +*. STATEMENTS IN HIGH STORAGE. AVGEN1CD POINTS TO FIRST BYTE * 57710000 +*. AFTER FIRST STATEMENT. AVGEN1CD POINTS TO 1ST BYTE OF LAST * 57715000 +*. STATEMENT GENERATED * 57720000 +*. * 57725000 +*. USES MACROS: $MALLOCL, $MALLOCH, $CALL, $SAVE, $RETURN, * 57730000 +*. $AL2 * 57735000 +*. USES DSECTS: MACLIB, MCGLBDCT, MCOPQUAD, MCPAROPR, MCPARSUB * 57740000 +*. AVWXTABL, MXPNTSAV, MCPARENT, RSBLOCK * 57745000 +*. CALLS ERRTAG, MCSCOP,MXMVSR,MACSCN,MACFND,MXMVSR,MXERRM, * 57750000 +*. ERRTAG,MEXPND,DECTRM * 57755000 +*. * 57760000 +*.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 57765000 + SPACE 57770000 +MEXPND CSECT 57775000 + $SAVE RGS=(R14-R6),BR=13,SA=* A 57780000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 57785000 + MVC MXADDLOW(4),AVADDLOW SAVE ADDR OF LOW STORAGE A 57790000 + MVC AVMACNST,AWZEROS NEST LEVEL = 0 A 57795000 + MVI AVMBYTE5,0 CLEAR CONT CARD INDICATOR 57845000 + L RC,AVRSBPT SET BASE FOR SOURCE BLOCK 57860000 + USING RSBLOCK,RC SET USING FOR SOURCE 57865000 + CLI RSBNUM,3 WERE THERE ACTUALLY 3 CARDS IN STMTJ 57870000 + BL MEXPND0A NO, SKIP CONTINUED-FURTHER TEST J 57875000 + L RB,AVRSCPT POINT TO CONT BLOCK 57880000 + USING RSCBLK,RB ESTAB USING ON CONT BLOCK 57885000 + CLI RSCONSQ+2*RSC$LEN,C' ' MORE THAN TWO CARDS? 57890000 + BE MEXPND0A PROCEED IF NOT 57895000 + NI RSBFLAG,255-$REBX TURN OFF ERROR FLAG 57900000 + MVI AVMBYTE5,$ERCONTX ELSE SET CONT CARD INDICATR 57905000 + DROP RB,RC 57910000 +MEXPND0A EQU * 57915000 + OI AVRSBLOC+1,$RSBNP## TURN ON OUTER FLAG 57920000 + L RB,AVADDHIH GET HIGH PNTR 57925000 + LR RC,RB COPY INTO RC 57930000 + STM RB,RC,AVGEN1CD MOVE INTO AVGEN1CD,AVGEN2CD 57935000 + ST RB,MEXGN2OV SAVE ORIG VALUE, IN CASE OVERFLW JRM 57940000 + LA RB,L'MXPOVRMS+RSB$L GET LENGTH OF MSSGE 57945000 + $MALLOCH R1,RB GET STORAGE FOR ERROR MSSGE 57950000 + ST R1,MEXGN2OV SAVE @, IN CASE OVERFLOW NPW JRM 57955000 + MVC 0(L'MXPOVRMS+RSB$L,R1),MXPOVRMS MOVE ERROR MSSGE 57960000 + LA RE,RSB$L GET LENGTH OF SNDRD PART OF RSBLOCK 57965000 + IC RB,AVRSBLOC GET LENGTH-1 OF RSBLOCK 57970000 + SR RB,RE DECR BY RSB$L 57975000 + STC RB,AVRSBLOC RESTORE 57980000 + MVC AVGEN1CD,AVGEN2CD DECR HIGH PNTR AWAY FROM MSSGE 57985000 + EJECT S 57985100 +MEXPND01 EQU * 57990000 +* EVERY NEST LEVEL A 57995000 + L RC,AVMACNST A 58000000 + LA RC,1(,RC) INCREASE BY ONE A 58005000 + C RC,AVMMNEST TEST FOR OVER A 58010000 + BH MEXPMNES OVER THE LIMIT A 58015000 +* FALLS THROUGH IF OK A 58020000 + ST RC,AVMACNST STORE NEW LEVEL S 58024000 + LR R1,RZ SAVE PREVIOUS @ MXPNTSAV S 58025000 + $MALLOCL RZ,RB,LENG=$LMXPTSV GET SPACE FOR NEXT ONE S 58035000 + USING MXPNTSAV,RZ A 58045000 + ST R1,MXPNLINK STORE PREVIOUS RZ S 58050000 + L RA,AVRSBPT LOAD SCAN POINTER S 58055000 + LA RA,RSB$L(RA) GET @ OF SOURCE IMAGE S 58060000 + SPACE 58065000 +* NEXT SECTION CHECKS NAME FOR VALIDITY 58070000 + SPACE 58075000 + $CALL MACSCN SCAN SOURCE FOR FIELDS 58090000 + L RA,AVMFLD2 GET OPCODE @ 58095000 + CLI AVMFLDT2,X'00' UNIDENTIFIED OPCODE? 58100000 + BE MEXPND03 ERROR IF YES 58105000 + MVC AVMSYMBL,AWBLANK ELSE CLEAR GLOBAL NAME AREA 58110000 + MVC AVMSYMLN,AVMFLDL2 MOVE LENGTH OF OPCODE 58115000 + SR R1,R1 CLEAR R1 FOR EX 58120000 + IC R1,AVMFLDL2 GET OPCODE LEN 58125000 + BCTR R1,0 DECR FOR EX INST 58130000 + EX R1,MXPNMVC MOVE OPCODE NAME TO GLOBAL DICT S 58135000 + L RC,AVMACLIB GET MACLIB @ 58150000 + $CALL MACFND SEARCH MACLIB 58155000 + LTR RB,RB FOUND? 58160000 + BZ MEXPND04 IF YES, PROCEED 58165000 +MEXPND03 EQU * 58170000 + LA RB,$ERIVOPC ELSE SET BAD OPCODE FLAG 58175000 + B MXPNDERT AND RETURN 58180000 +MEXPND04 EQU * 58185000 + USING MACLIB,RW NOTE USING ON MACLIB 58190000 + LR RW,RC SET MACLIB BASE 58195000 + TM MCLBTAGS,AVMCLBDF PREVIOUSLY DEFINED MACRO? 58200000 + BNO MEXPND03 ERROR IF NOT 58205000 + ST RW,MXPNMCLB SAVE MACLIB PNTR IN LOCAL AREA 58210000 + LH RA,MCPOPRNB GET NBR OF OPRNDS 58215000 + LA RA,1(RA) BUMP FOR LABEL FIELD 58220000 + LA RC,$LMPAROP GET LEN OF SYM PAR DICT ENTRY 58225000 + MR RB,RA GET LEN REQ'D 58230000 + $MALLOCL RY,RC GET CORE FOR SYM PAR DICTIONARY 58235000 + ST RY,MXPNLSPT COPPY PNTR TO SYM PAR DICT 58240000 + SPACE 58245000 +* NEXT SECTION ZEROS SYM PAR DICTIONARY AND INITIALIZES ENTRIESTO TYPE 58250000 +* 'O'. ALSO FINDS FIRST KEYWORD D.V. IF ANY. 58255000 + SPACE 58260000 + USING MCPARENT,RX SET USING FOR SYM PAR D.V. 58265000 + USING MCPAROPR,RY SET USING FOR SYM PAR DICT ENTRIES 58270000 + L RX,MCPARPNT SET BASE FOR D.V.'S 58275000 + MVC MXPNKYPT(8),AWZEROS CLEAR KEYWORD PNTRS 58280000 + NI AVMBYTE1,255-$MKEYOPR SHOW NO KEYWORDS YET S 58283000 +MEXPND05 EQU * 58285000 + CLI MCPARTYP,C'S' SYSTEM VAR? 58290000 + BNE MEXPND06 IF NOT, PROCEED 58295000 + L RX,MCPARNXT ELSE POINT TO NEXT ENTRY 58300000 + B MEXPND05 AND TRY AGIAN 58305000 +MEXPND06 EQU * 58310000 + ST RX,MXPLSYPT SET PNTR TO SYM PAR D.V.'S 58315000 +MEXPND07 EQU * 58320000 + MVC MCPAROPR($LMPAROP),AWZEROS CLEAR NEXT ENTRY 58325000 + MVI MCPAROTP,C'O' SET TYPE TO NULL 58330000 + CLI MCPARTYP,C'K' KEYWORD? 58335000 + BNE MEXPND08 JUMP TO FOOT IF NOT 58340000 + TM AVMBYTE1,$MKEYOPR 1ST KEYWRD DV FOUND? 58345000 + BO MEXPND08 JUMP TO FOOT IF YES 58350000 + ST RY,MXPNKLPT SAVE @ OF 1ST KEYWRD DICT ENTRY 58355000 + ST RX,MXPNKYPT SAVE @ OF 1ST KEYWRD D.V. 58360000 + OI AVMBYTE1,$MKEYOPR TURN ON KEYWRD FOUND FLAG 58365000 +MEXPND08 EQU * 58370000 + L RX,MCPARNXT GET NEXT ENTRY PNTR 58375000 + LTR RX,RX LAST ENTRY IN D.V.'S 58380000 + BZ MXPLAB01 PROCESS LABEL IF YES 58385000 + LA RY,$LMPAROP(RY) ELSE BUMP DICT POINTER 58390000 + B MEXPND07 AND INITIALIZE NEXT ENTRY 58395000 + SPACE 2 58400000 +* NEXT SECTION PROCESS LABEL FIELD OF MACRO CALL 58405000 +MXPLAB01 EQU * 58410000 + NI AVMBYTE1,X'FF'-$MKEYOPR TURN OFF KEYWORD FLAG 58415000 + L RX,MXPLSYPT SET BASE TO 1ST SYM PAR DV 58420000 + L RY,MXPNLSPT POINT TO SYM PAR DICTIONARY 58425000 + L RA,AVMFLD1 GET @ OF LABEL 58430000 + CLI AVMFLDL1,X'00' LABEL PRESENT? 58435000 + BE MXPOPR01 IF NOT, PROCESS OPRND FIELD 58440000 + CLI MCPARNLN,X'00' LABEL OPRND DEFINED? 58445000 + BNE MXPLAB03 PROCESS IF YES 58450000 + LA RB,$ERILLAB ELSE SET ILLEGAL LABEL FLAG 58455000 + $CALL ERRTAG FLAG STMNT 58460000 + B MXPOPR01 PROCESS OPRND 58465000 +MXPLAB03 EQU * 58470000 + SR R2,R2 CLEAR R2 58475000 + IC R2,AVMFLDL1 GET LABEL LENGTH 58480000 + LA R2,3(,R2) BUMP FOR ROUND/4 JRM 58485000 + SRL R2,2 DIVIDE BY 4 JRM 58490000 + SLL R2,2 MULT BY 4, ROUNDED UP JRM 58495000 + $MALLOCL RB,R2 GET STORAGE 58500000 + IC R2,AVMFLDL1 GET LENGTH 58505000 + STC R2,MCPAROLN SAVE LEN IN DICT ENTRY 58510000 + BCTR R2,0 DECR FOR EX INST 58515000 + EX R2,MXPNMVOP MOVE LABEL TO STORAGE 58520000 + MVI MCPAROFL,X'FF' SET DEFINED FLAG 58525000 + MVI MCPAROTP,C'U' SET TYPR TO UNDEFINED 58530000 + ST RB,MCPAROPT STORE OPRND LOC IN DICTIONARY 58535000 + SPACE 2 58540000 +* START PROCESSING OPRND FIELD. IS THERE AN OPRND? 58545000 +MXPOPR01 EQU * 58550000 + MVC MXPNBOPS,AWZEROS INIT OPRND COUNT TO ZERO 58555000 + CLC MCPARNXT,AWZEROS SYM PAR DV'S? 58560000 + BE MXPNOPFN IF NOT, MOVE STMT TOHIG CORE 58565000 + L RA,AVMFLD3 GET OPRND @ 58570000 + LTR RA,RA OPRND PRESENT? 58575000 + BNZ MXPOPR03 PROCESS IF YES 58580000 + IC RA,AVMFLDL2 ELSE GET LEN OF OPCODE 58585000 + A RA,AVMFLD2 ADD OPCODE @ TO SCAN POINTER 58590000 + DROP RW DROP MACLIB USING 58595000 +MXPOPR03 EQU * 58600000 + ST RA,AVMTSCNP SAVE PNTR TEMP 58605000 + TM AVMBYTE1,$MKEYOPR KEYWORD PROCESSED? 58610000 + BO MXPOPK01 JUMP IF YES 58615000 + LA RY,$LMPAROP(RY) ELSE BYMP DICT PNTR 58620000 + L RX,MCPARNXT AND GET NEXT DV ENTRY 58625000 + LTR RX,RX FINAL ENTRY? 58630000 + BNZ MXPOPR04 PROCESS IF NOT 58635000 + CLI 0(RA),C' ' OPRND PRESENT? 58640000 + BE MXPNOPFN FINISHED IF NOT 58645000 + LA RB,$ERILOPR ELSE SET NO OPRND ALLWD FLAG 58650000 + $CALL ERRTAG FLAG STMT 58655000 + B MXPNOPFN AND JUMP TO FOOT 58660000 +MXPNMVOP MVC 0($,RB),0(RA) DUMMY TO MOVE OPRND TO STORAGE 58665000 +MXPOPR04 EQU * 58670000 + CLI MCPARTYP,C'K' SYM PAR DV = KEYWORD? 58675000 + BE MXPOPK00 PROCESS KEYWORD S 58690000 +MXPOPR05 EQU * 58695000 + CLI 0(RA),C' ' OPRND PRESENT? 58700000 + BE MXPOPR07 CLEAN UP KEY WORDS IF NOT 58705000 + CLI 0(RA),C',' COMMA INIDICATES NULL 58710000 + BE MXPOPR0C BUMP OPRND COUNT IF YES 58715000 + BAL RET,MXPNOSY7 ORDINARY SYMBOL ? S 58725000 + LTR RB,RB RB TELLS ALL 58730000 + BNZ MXPOPR06 JUMP AND SCAN OPRND IF NOT 58735000 + CLI 0(RC),C'=' KEYWORD ? 58740000 + BNE MXPOPR06 PROCESS IF NOT 58745000 + OI AVMBYTE1,$MKEYOPR SET KEYWORD FLAG 58750000 + B MXPOPK02 PROCESS KEYWRD OPRND 58755000 +MXPOPR06 EQU * 58760000 + BAL RET,MXPOPSCN SCAN OPRND, SAVE IN DICT 58765000 +MXPOPR0C EQU * 58770000 + L R1,MXPNBOPS GET OPRND COUNT 58775000 + LA R1,1(R1) BUMP BY 1 58780000 + ST R1,MXPNBOPS RESTORE 58785000 + B MXPOPRFT JUMP TO FOOT 58790000 +MXPOPR07 EQU * 58795000 + BCTR RA,0 DECR SCN PNTR TO CHECK FOR ',' 58800000 + CLI 0(RA),C',' COMMA PRESENT 58805000 + LA RA,1(RA) RESTORE SCAN POINTER 58810000 + BNE MXPOPKFN IF NOT, JUMP AND CLEAN UP 58815000 + L R1,MXPNBOPS ELSE GET N' COUNT 58820000 + LA R1,1(R1) BUMP 58825000 + ST R1,MXPNBOPS RESTORE 58830000 + B MXPOPKFN AND JUMP TO CLEAN UP 58835000 + SPACE 2 58840000 +MXPOPK00 OI AVMBYTE1,$MKEYOPR SET KEYWORD FLAG S 58840100 +MXPOPK01 EQU * PROCESS KEYWORD OPRNDS 58845000 + CLI 0(RA),C' ' BLANK? 58850000 + BE MXPOPKFN IF YES, FINISH KEYWORD PROTOTYEP 58855000 + BAL RET,MXPNOSY7 ORDINARY SYMBOL ? S 58865000 + LTR RB,RB RB TELLS ALL 58870000 + BNZ MXPOPKFR ERROR IF NONZERO, JUMP OUT 58875000 + CLI 0(RC),C'=' KEYWORD ID? 58880000 + BNE MXPOPKFQ FLAG ERROR IF NOT '=' 58885000 +MXPOPK02 EQU * 58890000 + LA RC,1(RC) BUMP PAST '=' 58895000 + ST RC,AVMTSCNP SAVE ADDRESS OF DELIM 58900000 + MVC AVMSYMBL,AWBLANK CLEAR GLOBAL AREA 58905000 + STC R1,AVMSYMLN SAVE LENGHT 58910000 + BCTR R1,0 DECR FOR EX INST 58915000 + MVI AVMSYMBL,C'&&' SET AMPERSAND IN GLOBAL FILED 58920000 + EX R1,MXPNMVC2 A 58925000 + L RC,MXPNKYPT GET @ OF FIRST KEYWORD DV 58940000 + $CALL MACFND SEARCH SYM PAR LIST 58945000 + LTR RB,RB SYMBOL FOUND? 58950000 + BNZ MXPOPKFQ FLAG ERROR IF NOT FOUND 58955000 + LR RX,RC MOVE BASE TO NEW ENTRY 58960000 +MXPOPK03 EQU * 58965000 + LA RY,$LMPAROP GET LENGTH OF ENTRY 58970000 + MH RY,MCPARNDX MULT BY POSIT OF OPRND IN LIST 58975000 + A RY,MXPNLSPT ADD BASE @ OF SYM PAR DICT 58980000 + L RA,AVMTSCNP GET @ OF KEYWORD VALUE 58985000 + CLI MCPAROFL,X'FF' PREVIOUSLY DEFINED? 58990000 + BE MXPOPK06 SET ERROR FLAG IF SO 58995000 + CLI 0(RA),C' ' OPRND PRESENT? 59000000 + BE MXPOPK05 IF NOT, NULL OPRND 59005000 + CLI 0(RA),C',' COMMA? 59010000 + BE MXPOPK05 ALSO NULL IF YES 59015000 + B MXPOPK04 ELSE PROCEED 59020000 +MXPOPK06 EQU * 59025000 + IC R1,AVMSYMLN GET LEN OF KEYWORD NAME 59030000 + LA R1,1(R1) BUMP FOR '=' 59035000 + SR RA,R1 RESTORE SCAN POINTER 59040000 + B MXPOPKFQ JUMP AND FLAG ERROR 59045000 +MXPOPK04 EQU * 59050000 + BAL RET,MXPOPSCN SCAN OPRND AND SAVE IN TEMP STORGE 59055000 + B MXPOPRFT JUMP TO FOOT 59060000 +MXPOPK05 EQU * 59065000 + MVI MCPAROFL,X'FF' NULL OPRND, SET DEFINED FLAG 59070000 + B MXPOPRFT JUMP TO FOOT 59075000 + SPACE 59080000 +* NEXT ROUTINE CLEANS UP DEFAULTS FOR KEYWORD OPRNDS 59085000 +MXPOPKFQ EQU * 59090000 + LA RB,$ERUNDKW SET BAD KEYWORD FLAG 59095000 +MXPOPKFR EQU * 59100000 + $CALL ERRTAG FLAG STMT 59105000 +MXPOPKFN EQU * 59110000 + L RX,MXPNKYPT POINT AT 1ST SYM PARDV KEYWORD 59115000 + LTR RX,RX PRESENT? 59120000 + BZ MXPNOPFN FINISHED IF ZERO 59125000 + L RY,MXPNKLPT POINT TO 1ST KEYWORD DICT ENTRY 59130000 +MXPOPKF1 EQU * 59135000 + CLI MCPAROFL,X'FF' DEFINED? 59140000 + BE MXPOPKFB JUMP TO FOOT IF YES 59145000 + BAL RET,MXPOPKPR ELSE LOOK AT PROTOTYPE 59150000 +MXPOPKFB EQU * 59155000 + L RX,MCPARNXT GET NEXT KEYWORD OPRND 59160000 + LTR RX,RX FINAL OPRND? 59165000 + BZ MXPNOPFN FINI IF YES 59170000 + LA RY,$LMPAROP(RY) BUMP DICTIONARY POINTER 59175000 + B MXPOPKF1 AND RESUME SCAN 59180000 + EJECT S 59185000 +**--> INSUB: MXPOPKPR + + + + + + + + + + + + + + + + + + + + + + + +S 59190000 +*+ +S 59190500 +*+ SCAN PROTOTYPE OPRND AND SAVE IN LOCAL DICTIONARY +S 59191000 +*+ +S 59192000 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 59193000 + SPACE 2 S 59194000 +MXPOPKPR EQU * 59195000 + ST RET,MXPKPRSV SAVE RETURN @ 59200000 + MVC MCPAROTP,MCPRATYP COPY TYPE ATTRIB INTO DICTIONARY J 59202000 + CLI MCPRATYP,C'O' NULL OPRND? 59205000 + BE MXPPRKFT FINI IF YES 59210000 + L RA,MCPROPRN GET POINTER TO PROTOTYP OPRND 59215000 + MVI MCPARONB,1 ASSUME N' = 1 TEMPORARILY J 59220000 + MVC MCPAROLN,MCPROPLN COPY LENGTH 59225000 + MVC MCPAROPT,MCPROPRN COPY POINTER 59235000 + MVI MCPAROFL,X'FF' SET DEFINED FLAG 59240000 + CLI MCPAROTP,C'S' SUB LIST? 59245000 + BNE MXPPRKFT FIISHED IF NOT 59250000 + MVI MCPARONB,0 ZERO, SO WILL ACCUMULATE N' OK J 59252000 + BAL RET,MXPNSBSC SCAN OPRND SUB LIST 59255000 +MXPPRKFT EQU * 59260000 + L RET,MXPKPRSV RESTORE RETURN @ 59265000 + BR RET AND RETURN 59270000 +MXPKPRSV DS F STORAGE FOR RETURN @ 59275000 + EJECT S 59280000 +**--> INSUB: MXPOPSCN + + + + + + + + + + + + + + + + + + + + + + + +S 59285000 +*+ +S 59285500 +*+ SCAN STD OPRND AND STORE IN LOW STORAGE +S 59286000 +*+ +S 59287000 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 59288000 + SPACE 2 S 59289000 +MXPOPSCN EQU * 59290000 + ST RET,MXPPSCSV SAVE RETURN @ 59295000 + ST RA,AVMTSCNP SAVE SCAN POINTER 59300000 + NI AVMBYTE1,X'FF'-$MSBLIST TURN OFF SUBLIST FLAG 59305000 + $CALL MCSCOP SCAN OPRND 59310000 + LTR RB,RB OKAY? 59315000 + BNZ MXPOPKFR AND LEAVE OPRNDS 59320000 + STC RC,MCPAROLN PUT OPRND LEN IN DICT 59325000 + STC RD,MCPAROTP STORE TYPE 59330000 + MVI MCPAROFL,X'FF' SET OPRND FLAG 59335000 + LA RC,3+1(,RC) ROUND + 1 BYTE FOR DELIMITER AFTER J 59340000 + SRL RC,2 TRUNCATE 59345000 + SLL RC,2 BY SHIFITING 59350000 + $MALLOCL RB,RC GET STORAGE 59355000 + IC RC,MCPAROLN GET ORIGINAL LENGTH 59360000 +* USE LENGTH RATHER THAN L-1: COPY DELIMITER AFTER ARG, J 59365000 +* HELPS MEXPND SCAN RIGHT FOR &I SETA &ARG OPERATION. J 59365010 + LR R0,RA COPY SCAN POINTER 59370000 + L RA,AVMTSCNP GET ORIGINAL POINTER 59375000 + ST R0,AVMTSCNP SAVE SCAN POINTER 59380000 + EX RC,MXPNMVOP MOVE OPRND TO LOW STORAGE 59385000 + ST RB,MCPAROPT SAVE OPRND @ IN DICTIONARY 59390000 + CLI MCPAROTP,C'S' SUB LIST? 59395000 + BE MXPOPSBS PROCESS SUBLIST IF YES 59400000 + MVI MCPARONB,1 ELSE SET OPRND COUNT TO 1 59405000 + B MXPOPSCF 59410000 +MXPOPSBS EQU * 59415000 + LR RA,RB SCAN PNTR TO OPRND 59420000 + BAL RET,MXPNSBSC SCAN SUB OPRNDS 59425000 +MXPOPSCF EQU * 59430000 + L RA,AVMTSCNP RESTORE SCAN POINTER 59435000 + L RET,MXPPSCSV RESTORE RETURN @ 59440000 + BR RET AND RETURN 59445000 +MXPPSCSV DS F STORAGE FOR RETURN @ 59450000 + EJECT S 59455000 +**--> INSUB: MXPNSBSC + + + + + + + + + + + + + + + + + + + + + + + +S 59460000 +*+ +S 59461000 +*+ SCAN OPRND SUBLIST, CREATE ENTRY IN DICTIONARY +S 59461500 +*+ +S 59462000 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 59463000 + SPACE 2 S 59464000 +MXPNSBSC EQU * 59465000 + ST RET,MXPNSBSV SAVE RETURN @ 59470000 + USING MCPARSUB,RW NOTE USING ON SUBOPRND ENTRY 59475000 + LA RA,1(RA) BUMP PAAST '(' 59480000 + OI AVMBYTE1,$MSBLIST SET SUBLIST FLAG 59485000 +MXPNSB01 EQU * 59490000 + LA RB,$LMPARSB GET LENGTH OF SUB ENTRY 59495000 + $MALLOCL RW,RB GET STORAGE 59500000 + MVC 0($LMPARSB,RW),AWZEROS CLEAR ENTRY 59505000 + ST RA,MCPARSPT SAVE POINTER TO SUB ENTRY STRNG 59510000 + $CALL MCSCOP SCAN SUB OPRND 59515000 + LTR RB,RB ERROR? 59520000 + BZ MXPNSB02 PROCEED IF NOT 59525000 + S RA,MCPAROPT GET OFFSET OF POINTER 59530000 + LR RE,RA COPY TEMPORARILY 59535000 + IC RA,MCPAROLN GET LENGTHOF OPRND 59540000 + S RA,AVMTSCNP SUBTRACT CURRENT PNTR 59545000 + LPR RA,RA GET POS VALUE 59550000 + AR RA,RE ADD OFFSET OF ERROR 59555000 + B MXPOPKFR FORGET ABOUT REST OF OPRNDS 59560000 +MXPNSB02 EQU * 59565000 + CLI MCPARONB,X'00' 1ST SUB OPRND? 59570000 + BNE MXPNSB03 59575000 + STC RD,MCPAROTP MAIN OP TYPE = 1ST SUB TYPE 59580000 + ST RW,MCPRSBPT SAVE PNTR TO SUB ENTRIES 59585000 +MXPNSB03 EQU * 59590000 + STC RC,MCPARSLN SAVE LEN IN DV 59595000 + STC RD,MCPARSTP SAVE TYPE 59600000 + IC RD,MCPARONB GET SUB OPRND COUNT 59605000 + LA RD,1(RD) BUMP BY ONE 59610000 + STC RD,MCPARONB RESOTRE 59615000 + CLI 0(RA),C')' END OF LIST? 59620000 + LA RA,1(RA) BUMP PAST DELIM 59625000 + BNE MXPNSB01 RESUME SCAN IF NO ')' 59630000 + L RET,MXPNSBSV GET RETURN @ 59635000 + BR RET AND RETURN 59640000 +MXPNSBSV DS F SPACE FOR RETURN @ 59645000 + DROP RW 59650000 + EJECT S 59655000 +**--> INSUB: MXPNOSYM DETERMINS IF STRING IS ORDINARY + + + + +S 59660000 +*+ SYMBOL OF EITHER LENGTH 7 OR 8 (MAX) +S 59665000 +*+ MXPNOSY7: SETS RB = 7 +S 59665100 +*+ +S 59670000 +*+ ENTRY CONDITIONS: +S 59675000 +*+ RA = 1ST CHAR OF SYMBOL +S 59680000 +*+ RB = ALLOWABLE LENGTH (7 OR 8) +S 59685000 +*+ +S 59690000 +*+ EXIT CONDITIONS: +S 59695000 +*+ RA = SAME AS ENTRY +S 59700000 +*+ RB = ERROR INDICATION (0 --> OK) +S 59705000 +*+ RC = @ OF DELIM PAST SYMBOL +S 59710000 +*+ R1 = LENGTH OF SYMBOL +S 59711000 +*+ +S 59712000 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 59713000 + SPACE 2 S 59715000 +MXPNOSY7 LA RB,7 SET MAX LENGTH OF KEYWORD S 59715100 +MXPNOSYM EQU * 59720000 + CLI 0(RA),C'0' FIRST CHAR = DIGIT? 59725000 + BNL MXPSYMR1 ERROR IF YES 59730000 + EX RB,MXPNOSSC SCAN SYMBOL 59735000 + BZ MXPSYMR2 ZERO MEANS TOO LONG 59740000 + LR RC,R1 ELSE MOVE DELIM TO RC 59745000 + SR R1,RA GET LENGTH IN R1 59750000 + BZ MXPSYMR2 NO SYMBOL IF ZERO LENGTH 59755000 + SR RB,RB CLAR RB FOR RETURN 59760000 + BR RET 59765000 +MXPSYMR1 EQU * 59770000 +MXPSYMR2 EQU * 59785000 + LA RB,$ERINVSY SET BAD SYMBOL FALG 59790000 + BR RET AND RETURN 59795000 +MXPNOSSC TRT 0($,RA),AWTSYMT DUMMY FOR SCAN 59800000 + EJECT S 59805000 +MXPOPRFT EQU * 59810000 + CLI 0(RA),C' ' BLANK? 59815000 + BE MXPOPR03 RESUME SCAN IF YES 59820000 + LA RA,1(RA) ELSE BUMP PAST DELIM 59825000 + CLI 0(RA),C' ' BLANK AFTER ','? 59830000 + BNE MXPOPR03 RESUME SCAN IF NOT 59835000 + SPACE 1 59840000 + L RC,AVRSBPT SET BASE OF RSBLOCK 59845000 + USING RSBLOCK,RC NOTE USING ON RSBLOCK 59850000 +* POSSIBLE NON-STND CONT CARD 59855000 + CLI RSBNUM,1 ONLY 1 CARD? 59860000 + BE MXPOPR03 RESUME SCAN IF YES 59865000 + LA RB,RSBLOCK+RSB$L+RSOL1 POINT TO 1ST BYTE, 2ND CARD 59870000 + CR RA,RB POINTING AT WHICH CARD? 59875000 + BNH MXPOPC#2 PROCESS 2ND CARD IF LOW 59880000 + CLI RSBNUM,3 TWO CONT CARDS? 59885000 + BNE MXPOPR03 RESUME SCAN IF NOT 59890000 + LA RB,RSOLC(RB) POINT TO 1ST BYTE, 3RD CARD 59895000 + CR RA,RB WHERE IS SCAN POINTER? 59900000 + BH MXPOPC#3 CHECK FOR 4TH CARD 59905000 +MXPOPC#2 EQU * 59910000 + LR RA,RB MOVE SCAN POINTER TO CONT CARD 59915000 + CLI 0(RA),C' ' CONT CARD IS NON BLANK? 59920000 + BNE MXPOPR03 PROCEED IF YES 59925000 + LA RB,$ERVILCH SET BAD CONT CARD ERROR FLAG 59930000 + B MXPOPKFR AND JUMP TO FOOT 59935000 + SPACE 2 59940000 +MXPOPC#3 EQU * 59945000 + CLI AVMBYTE5,$ERCONTX MORE THAN TREE CARDS? 59950000 + BNE MXPOPR03 PROCEED WITH SCAN IF NOT 59955000 + $CALL MXMVSR ELSE MOVE CARDS TO HIGH CORE 59960000 + LTR RB,RB CORE EXCEEDED? 59965000 + BNZ MXPNDOVR JUMP OUT IF YES 59970000 + BAL RET,MXPNRDR ELSE READ CONT CARDS 59975000 + L RC,AVRSBPT ESTAB BASE ON RSBLOCK 59985000 + LA RA,RSBSOURC POINT TO STMT START 59990000 + CLC 0(15,RA),AWBLANK COLS 1-15 BLANK? 59995000 + BE MXPOPC#4 OKAY IF YES 60000000 + LA RB,$ERCONT ELSE SET ERROR FLAG 60005000 + $CALL ERRTAG AND FLAG STMT 60010000 +MXPOPC#4 EQU * 60015000 + LA RA,15(RA) POINT TO COL 16 60020000 + B MXPOPR03 AND RESUME SCAN 60025000 + EJECT S 60030000 +**--> INSUB: MXPNRDR + + + + + + + + + + + + + + + + + + + + + + + +S 60035000 +*+ +S 60035500 +*+ CARD READER FOR ROUTINE MEXPND +S 60036000 +*+ +S 60037000 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 60038000 + SPACE 2 S 60039000 +MXPNRDR EQU * S 60039500 + ST RET,MXPNRDSV SAVE RETURN @ 60040000 + MVC MXPGENCD,AVGEN1CD COPY AVGEN1CD 60045000 + MVC AVGEN1CD,AVGEN2CD MAKE PNTRS EQUAL FOR INCARD 60050000 + $CALL INCARD READ NEXT STMT 60055000 + OI AVRSBLOC+1,$RSBNPNN SET NO PROCESS FLAG S 60060000 + SR RE,RE CLEAR RE 60065000 + IC RE,AVRSBLOC GET LENG-1 OF STMT 60070000 + LA RD,RSB$L GET LENGTH OF STND PART 60075000 + SR RE,RD SUBTRACT FROM OVERALL LENGTH 60080000 + STC RE,AVRSBLOC RESTORE REDUCED LENGTH 60085000 + MVC AVGEN1CD,MXPGENCD RESTORE AVGEN1CD POINTER 60090000 + STC RB,AVMBYTE5 SAVE ERROR FLAG 60095000 + CLI AVMBYTE5,$ERCONTX MORE THAN THREE CARDS? 60100000 + BE MXPNRDRT PROCEED IF YES 60105000 + LTR RB,RB ELSE TEST FOR ERROR 60110000 + BZ MXPNRDRT PROCEED IF NONE 60115000 + $CALL ERRTAG ELSE FLAG STMT 60120000 + TM AVTAGS2,$INEND2 END OF FILE ERROR? 60125000 + BO MXPNDERT JUMP OUT IF YES 60130000 +MXPNRDRT EQU * 60135000 + L RET,MXPNRDSV RESTORE RETURN @ 60140000 + BR RET AND RETURN 60145000 +MXPNRDSV DS F SPACE FOR RETURN @ 60150000 +MXPGENCD DS F TEMP STORAGE FOR AVGEN1CD 60155000 + EJECT S 60160000 +* NORMAL EXIT CODE S 60160100 + SPACE 1 S 60160200 +MXPNOPFN EQU * 60165000 + $CALL MXMVSR MOVE SOURCE TO HIGH AREA 60170000 + CLI AVMBYTE5,$ERCONTX 4 CARDS? 60175000 + BNE MXPNOPFP PROCEED IF NOT 60180000 + BAL RET,MXPNRDR ELSE READ NEXT CARD 60185000 + L RC,AVRSBPT SET BASE FOR RSBSOURC 60190000 + OI RSBFLAG,$RSBNPNN SET NO ACTION FLAG 60195000 + B MXPNOPFN AND PTINT CARDS 60200000 + DROP RC 60205000 +MXPNOPFP EQU * 60210000 + CLC AVMACNST,AWF1 WAS THIS ACTUALLY OUTER MACRO CL JRM 60215000 + BNE *+10 NO, SO SKIP RESET OF PTR JRM 60220000 + MVC MEXGN2OV,AVGEN2CD THUS SAVE CURRENT PTR FOR OVRFL JRM 60225000 + LTR RB,RB OVERFLOW? 60230000 + BZ MXPNLOCD PROCEED IF NOT 60235000 + SPACE 3 S 60235100 +* OVERFLOW EXIT S 60235200 + SPACE 1 S 60235300 +MXPNDOVR EQU * 60240000 + MVC AVGEN1CD,AVADDHIH SET PNTR TO OVRFLW MESSAGE 60245000 + MVC AVGEN2CD,MEXGN2OV RESET OVERFLO PTR, SHOW @ EITHER OF #60250000 + AS218 MESSAGE OR OF OUTER MACRO CALL. JRM 60255000 + B MXNORML A 60260000 + SPACE 1 A 60265000 + SPACE 60270000 +MEXGN2OV DC F'0' @ LAST STMT, IF OVERFL**MOVE*** JRM 60275000 +MXPOVRMS DC C'218 STORAGE EXCEEDED BY FOLLOWING MACRO EXPANSION' 60280000 + DC AL1(L'MXPOVRMS-1,$RSBNPNN+$RSBMERR,$,$) 60285000 + SPACE 60290000 + DS 0H A 60290050 +MEXPMNES EQU * ERROR EXIT MNEST LIMIT A 60290100 + LA RB,$EREXMAC A 60290200 + L RA,AVRSBPT A 60290300 + LA RA,RSB$L+10(RA) POINT TO OPCODE A 60290400 +MXPNDERT DS 0H 60295000 + $CALL ERRTAG 60305000 + $CALL MXMVSR MOVE SOURCE TO HIGH AREA IF INNER 60310000 + LTR RB,RB OVERFLOW? 60315000 + BNZ MXPNDOVR JUMPP AND FLAG IF YES 60320000 +* S 60321000 +* NORMAL RETURN SEQUENCE FOR MEXPND S 60322000 +* -- ALSO SET PTR TO RELEASE LOW STORAGE AREA S 60323000 +* S 60324000 +MXNORML EQU * NORMAL RETURN A 60325000 + MVC AVADDLOW,MXADDLOW RESTOR PTR A 60325100 + SR RB,RB SHOW NORMAL RETURN ALWAYS J 60325150 + $RETURN RGS=(R14-R6) A 60325200 + SPACE 4 60330000 +* NEXT SECTION ALLOCATES AND INITIALIZES STORAGE FORLOCAL SET SYMBOL* 60335000 +* DICTIONARY 60340000 +MXPNLOCD EQU * 60345000 + SPACE 60350000 + AIF (&$DEBUG).MXPNLDB 60355000 + L RA,MXPNLSPT GET PNTR TO SYM PAR DICT 60360000 + L R1,AVGEN2CD GET PNTR TO HIGH AREA 60365000 + L R2,AVADDHIH GET PNTR TO BEGINNING OF HIGH AREA 60370000 + XSNAP LABEL='***SYM PAR DICT INITIALIZED***', X60375000 + IF=(AVMSNBY2,O,$MSNP11,TM), X60380000 + STORAGE=(*0(R1),*0(R2),*0(R13),*124(R13),*0(RA),*128(RA)X60385000 + ) 60390000 +.MXPNLDB ANOP 60395000 + SPACE 60400000 + AP AVMSYSDX,AWP1 BUMP SYSNDX COUNTER 60405000 + ZAP MXPSYSDX,AVMSYSDX COPY INTO LOCAL AREA 60410000 + L RW,MXPNMCLB GET POINTER TO MACLIB 60415000 + USING MACLIB,RW SET USING 60420000 + MVC MXPNCDPT,MCCODLNK SAVE PNTR TO CODE 60425000 + L R1,MCLOCDLN GET LEN OF LOCAL DICTIONARY 60430000 + $MALLOCL R2,R1 GET CORE FOR SET SYMBOL DICT 60435000 + ST R2,MXPNLDBS SAVE BASE IN LOCAL AREA 60440000 +* INITIALIZE DICTIONARY TO ZEROS 60445000 + LR R0,R1 SAVE COMPLETE LENGTH FOR LATER J 60448000 + BCTR R1,0 DECR COUNT 60450000 + EX R1,MXPNMVZR CLEAR LENGTH MOD 256 60455000 + SRA R1,8 SHIFT TO GET # 256 BYTE BLOCKS LEFT 60465000 + BNP MXPNLOC2 SKIP IF NO MORE TO DO 60470000 + N R0,AWFXFF GET LAST BYTE OF LENGTH J 60470100 + AR R2,R0 GET @ FIRST BYTE TO ZERO J 60470200 + SPACE 1 60475000 + MVC 0(256,R2),AWZEROS CLEAR 256 BYTES AT A TIME 60480000 + LA R2,256(,R2) INCREMENT TO NEXT 60485000 + BCT R1,*-10 LOOP, CLEARING UNTIL DONE 60490000 + SPACE 60495000 +MXPNLOC2 EQU * 60500000 + L R2,MXPNLDBS GET BASE OF SET SYMB LOCAL DICT 60505000 + MVC 0(4,R2),AVMMACTR SET ACTR LIMIT 60510000 + TM AVMBYTE4,$MGENSTP ARE MACROS KILLED ? S 60510100 + BO MXNORML IF YES, RETURN S 60510200 + MVC MXPNCRCD,MXPNCDPT SET PTR TO 1ST INSTR S 60515000 + SPACE 2 S 60530100 +* THIS NEXT SECTION OF CODE SETS CALLING S 60530110 +* ARGUMENTS AND CALLS MXINST TO S 60530120 +* INTERPRET DICTIONARY ONE-OPS AND S 60530130 +* CREATE GENERATED CODE ----- S 60530140 +* THEN USE RETURNED CODE TO BRANCH ON INDEX S 60530150 +* FOR FURTHER PROCESSING S 60530160 + SPACE 2 S 60530170 +MXPNCALL EQU * S 60530195 + LR RC,RZ SET CALLING CONVENTION S 60530200 + XCALL MXINST CALL ROUTINE A 60530210 + B *+4(RB) BRANCH ON RETURNED INDEX S 60530220 + B MXPNDX0 RB=0 MEND,MEXIT A 60530230 + B MEXPND01 RB=4 INNER MACRO CALL A 60530240 + B MXNORML RB=8 KILL THIS NEST S 60530250 + B MXKILMAC RB=12 KILL ALL MACROS S 60530260 + B MXPNDOVR RB=16 STORAGE OVERFLOW S 60530270 + SPACE 2 S 60530275 +* SET FLAG TO KILL ALL MACROS S 60530280 +* S 60530285 +MXKILMAC EQU * KILL ALL MACROS A 60530300 + OI AVMBYTE4,$MGENSTP LILL A 60530310 + B MXNORML A 60530320 +* S 60530330 +* BACK UP NEST DEPTH COUNTER AND CALL MXINST S 60530340 +* AGAIN IF NOT DONE WITH NEST S 60530350 +* S 60530360 +MXPNDX0 EQU * S 60530370 + ST RZ,AVADDLOW STORE CURRENT RZ S 60530380 + L R0,AVMACNST GET NEST LEVEL S 60530390 + BCTR R0,0 DECR BY 1 S 60530400 + ST R0,AVMACNST STORE NEW DEPTH LEVEL S 60530410 + LTR R0,R0 LEVEL = 0 ? S 60530420 + L RZ,MXPNLINK GET NEXT LINK S 60530430 + BZ MXNORML NO MORE, RETURN S 60530440 + L RE,MXPNCRCD GET @ OF LAST INSTR PROC (CALL) S 60530441 + USING MCOPQUAD,RE NOTE ONE-OP PTR S 60530442 + MVC MXPNCRCD,MCQUDNXT GET @ OF NEXT INSTR (AFTER CALL) S 60530443 + DROP RE REMOVE USING S 60530444 + B MXPNCALL CALL MXINST TO GENERATE CODE S 60530445 + SPACE 2 S 60530450 +* DEFINED CONSTANTS/STORAGE & DUMMY INSTRS S 60530460 +MXADDLOW DS F FULL WORD TO SAVE AVADDLOW S 60530470 +MXPNMVZR MVC 0($,R2),AWZEROS DUMMY INSTR S 60530480 +MXPNMVC2 MVC AVMSYMBL+1($),0(RA) DUMMY INSTR S 60530490 +MXPNMVC MVC AVMSYMBL($),0(RA) DUMMY INSTR S 60530500 + LTORG S 60530510 + DROP RW,RX,RY,RZ S 60530520 + TITLE 'MXINST -- INTERPRETATION PHASE' S 60535000 +**--> CSECT: MXINST EXECUTE INSTRUCTIONS IN MACRO DEF *S 60535100 +*. ENTRY CONDITIONS: *S 60535200 +*. RC = @ MXPNTSAV *S 60535300 +*. EXIT CONDITIONS: *S 60535400 +*. RB = 0 MEND OR MEXIT FOUND *S 60535500 +*. 4 INNER MACRO CALL *S 60535600 +*. 8 KILL THIS MACRO NEST *S 60535700 +*. 12 KILL ALL MACROS *S 60535800 +*. 16 STORAGE OVERFLOW *S 60535900 +*. *S 60540000 +*.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **S 60540100 + SPACE 2 S 60540200 +MXINST CSECT A 60545000 + $SAVE RGS=(R14-R6),BR=13,SA=* A 60550000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING S 60551000 + USING MCOPQUAD,RW NOTE USING ON ONE-OP 60555000 + MVC AVRSBLOC(RSB$L),AWZEROS ZERO STND PART OF RSBLOC 60560000 + MVC AVRSBLOC+4($LMSRCMX),AWBLANK BLANK REMAINDER 60565000 + LR RZ,RC A 60570000 + USING MXPNTSAV,RZ A 60575000 + L RW,MXPNCRCD A 60575050 + XSNAP LABEL='MXINST INIT',STORAGE=(*MXPNTSAV,*MXPNLSPT+4,*AVADX60575100 + DLOW,*AVWXEND),IF=(AVTAGSM,O,AJOMACRG,TM) S 60575200 + $SPIE MXPNINJE,((8,9)),ACTION=CR,CE=MXPNZDIV PRODUCTION TYPE 60660000 + ST R1,AVMXSPIE SAVE PREV INT BLOCK @ 60670000 + B MXPNIN01 SKIP, BEGIN AT 1ST ONE-OP 60675000 + SPACE 60680000 +MXPNEXBS DS 0H ESTAB BASE FOR INDEX TABLE 60685000 +MXPNINJE EQU * ENTER HERE TO FLAG ERROR AND GO ON 60690000 +* TO NEXT ONE OP. EXPECTS RB = ERROR CODE. 60695000 + BAL R1,MXINERRM GENERATE ERROR MESG A 60700000 + SPACE 1 60705000 +MXPNINJP EQU * COME HERE FOR EACH NON-BRANCH STMT 60710000 +* AFTER VERY FIRST ONE. 60715000 + L RW,MXPNCRCD RESTORE BASE TO 1ST ONE-OP 60720000 + L RW,MCQUDNXT GET @ NEXT SEQUENTIAL INSTRUCTION 60725000 + SPACE 1 60730000 +MXPNINJQ EQU * COME HERE FOR AGO/GOOD AIF. RW= @ 60735000 + AIF (NOT &$MACOPC).MXINSTA SKIP IF NOT OPEN CODE S 60746000 +* ALLOW ONLY ONE STATEMENT DONE IF IN OPEN CODE S 60746500 + L RX,MXPNMCLB LOAD @ OF MACLIB ENRTY A 60746600 + USING MACLIB,RX NOTE USING ON MACLIB S 60746700 + TM MCLBFLG2,$MCOCFL1 IN OPEN CODE ? S 60747000 + BO MXMEND RETURN IF YES S 60747500 + DROP RX S 60747600 +.MXINSTA ANOP S 60748000 + SPACE 60750000 + AIF (&$DEBUG).MXPNNDB 60755000 + L R1,MXPNCRCD GET @ OF CURRENT INST 60760000 + L R2,AVMCHSTR GET POINTER TO CHAR WORK AREA 60765000 + XSNAP LABEL='***INSTRUCTION EXECUTED***', X60770000 + IF=(AVMSNBY2,O,$MSNP11,TM), X60775000 + STORAGE=(*0(R1),*128(R1),*0(R2),*128(R2)) 60780000 +.MXPNNDB ANOP 60785000 + SPACE 60790000 + L R1,AVMMSTMG GET GLOBAL LIMIT ON ISNTRUCTIONS 60795000 + S R1,AWF1 DECR COUNT 60800000 + ST R1,AVMMSTMG RESTORE 60805000 + BNP MXMENDER GO TO FLAG ERROR AND STOP 60810000 + SPACE 60815000 +MXPNIN01 EQU * 60820000 + MVC MXPCHRBF,AVMCHSTR INIT BUFFER POINTER 60825000 + ST RW,MXPNCRCD UPDATE CURRENT INST POINTER 60830000 +* EACH STMT CONSISTS OF ONE-OP PREFIX(PTR,STMT#,STC), A 60831000 +* FOLLOWED BY 0-MORE REGULAR ONE-OPS(MXOPQUAD DSECT)L A 60832000 +* FOR ANOP,MEND,MEXIT,$BSERR01(ERROR), THE OPERATOR A 60833000 +* CODE IS IN PREFIX (MCQS1FLG). FOR OTHERS, IT =0 A 60834000 + CLI MCQS1FLG,0 WAS IT NORMAL PREFIX WITH ONE-OPS A 60835000 + BE MXPNIN03 YES SKIP SPECIAL CODE A 60836000 + IC R2,MCQS1FLG GET OPERATOR TYPE A 60837000 + B MXPNPREF GO TO PREFIX ONLY CODE A 60838000 +MXPNIN03 SH RW,=AL2($LMCQUAD-$LMCOPL1) BACK UP,SO WILL BUMP RIGHT A 60839000 +* FALL THRU, START DOING ONE-OPS A 60840000 + EJECT 60845000 +* NEXT SECTION PROCESSES A SINGLE ONE-OP 60850000 +MXPNONJP EQU * 60855000 + LA RW,$LMCQUAD(RW) BUMP PAST CURRENT ONE-OP 60860000 + SR RA,RA CLEAR FOR INSERTS****************JRM 60865000 + MVI AVMBYTE2,X'00' CLEAR FLAG BYTE FOR TYPE USE A 60870000 + IC RA,MCARG1DX GET INDEX OF 1ST ARG 60875000 + L RB,MCARG1LC GET LOC OF 1ST ARG 60880000 + IC R2,MCBOPRTR GET OPCODE 60885000 +MXPNPREF EQU * ENTER HERE FOR PREFIX ONLY ONES A 60887000 + N R2,=X'0000007E' MASK OUT CHAR REL BIT, SPECIAL PRINA 60890000 + LH R1,MXPNINDX(R2) GET OFFSET 60895000 + XSNAP LABEL='MXPNONJP',STORAGE=(*0(RW),*16(RW)), X60895100 + IF=(AVTAGSM,O,AJOMACRH,TM) 60895200 + B MXPNEXBS(R1) JUMP TO ROUTINE 60900000 + SPACE 60905000 +MXPNINDX $AL2 MXPNEXBS,(MXFIN,MXPLUS,MXMIN,MXMULT,MXDIV,MXOR,MXAND,MXN#60910000 + OT,MXNE,MXGE,MXLE,MXLT,MXEQ,MXGT,MXCAT,MXAGO,MXAIF,MXSET#60915000 + A,MXSETB,MXSETC,MXINV,MXINV,MXSBSCRP,MXSBST,MXSYSL,MXINV#60920000 + ,MXPRNT,MXMEXIT,MXMEND,MXANOP,MXERRMS,MXINMAC,MXMVSTMT) 60925000 + SPACE 60930000 +* ENTRY POINT FOR SPIE ACTION 60935000 +MXPNZDIV EQU * 60940000 + USING MXPNZDIV,REP 60945000 + LA RB,$ER#ZDIV SET ERROR FLAG 60950000 + BR RET RETURN NOW, RB SET 60955000 + AIF (&$DEBUG).MACQQ04 SKIP IF NO DEBUG 60960000 + ORG *-2 GET BACK OVER NON-DEBUG CODE 60965000 + CLI 3(R1),8 FIXED POINT OVERFLOW? 60970000 + BCR E,RET RETURN IF YES FOR MORE SPIE ACTION 60975000 + CLI 3(R1),9 ZERO DIVIDE? 60980000 + BCR E,RET RETURN IF YES FOR MORE SPIE ACTION 60985000 + L RA,AVGEN2CD ELSE POINT TO LOW END OF HIGH CORE 60990000 + L RB,AVADDHIH POINT TO HIGH END OF HIGH CORE 60995000 + L RC,AVMACLIB POINT TO START OF LOW CORE 61000000 + L RD,AVADDLOW POINT TO HIGH END OF LOW CORE 61005000 + XSNAP LABEL='*** INTERRUPT IN MACRO EXPANSION ***', X61010000 + STORAGE=(*0(R1),*20(R1),*0(RA),*0(RB),*0(RC),*0(RD),*AVA#61015000 + DDLOW,*AVWXEND,*0(R13),*130(R13)) 61020000 + DC X'00FF' FORCE INTERRUPT 61025000 +.MACQQ04 ANOP 61030000 + DROP REP 61035000 + SPACE 61040000 +* A 61040200 +MXPLUS EQU * 61045000 +MXMIN EQU * 61050000 +* ARITHMETIC OPERATIONS HERE A 61050100 +MXMULT EQU * 61055000 +MXDIV EQU * 61060000 + BAL RET,MXARITH CVRT 1ST ARG TO ARITH VLUE 61065000 + ST RC,MXARG1 SAVE TEMPORRAILY 61070000 + IC RA,MCARG2DX GET 2ND ARG TYPE 61075000 + L RB,MCARG2LC GET LOCATION OF 2ND ARG 61080000 + BAL RET,MXARITH GET ARITH VALUE 61085000 + LR RD,RC COPY INTO RD 61090000 + L RB,MXARG1 RELOAD 1ST ARGUMENT**************JRM 61095000 + SRDA RB,32 MOVE OVER TO RC, WITH SIGN RIGHT 61100000 + IC RA,MCBOPRTR GET OPCODE 61110000 + EX 0,MXARITOP-2(RA) EXECUTE CORRECT OPERATION 61115000 + ST RC,MCRESULT PUT RESULT IN ONE-OP 61120000 + MVI MCRSLTYP,$BSIMMA SET TYPE 61125000 + B MXPNONJP GET NEXT ONE-OP 61130000 + SPACE 1 61135000 +MXARITOP DS 0H TABLE OF INSTRS TO BE EXECUTED 61140000 + AR RC,RD ADD 61145000 + SR RC,RD SUBTRACT 61150000 + MR RB,RD MULTIPLY 61155000 + DR RB,RD DIVIDE 61160000 + EJECT A 61165000 +* LOGICAL OPERATORS A 61165100 +* A 61165200 +MXOR EQU * 61170000 +MXAND EQU * 61175000 + BAL RET,MXBOOL GET 1ST ARG VALUE 61180000 + ST RC,MXARG1 SAVE TEMPORARILY 61185000 + IC RA,MCARG2DX GET 2ND ARG TYPE 61190000 + L RB,MCARG2LC GET 2ND ARG LOC'N 61195000 + BAL RET,MXBOOL GET 2ND ARG VALUE 61200000 + L RD,MXARG1 RESTORE 1ST ARG VALUE 61205000 + CLI MCBOPRTR,$BSOR OR OPRND? 61210000 + BE MXOR01 JUMP TO OR IF YES 61215000 + NR RC,RD ELSE CARRY OUT AND OPERATION 61220000 + B MXOR02 JUMP TO FOOT 61225000 +MXOR01 EQU * 61230000 + OR RC,RD CARRY OUT OR OPERATION 61235000 +MXOR02 EQU * 61240000 + ST RC,MCRESULT STORE RESULT IN ONE-OP 61245000 + MVI MCRSLTYP,$BSIMMB SET TYPE 61250000 + B MXPNONJP GET NEXT ONE-OP 61255000 + SPACE 61260000 +MXNOT EQU * 61265000 + BAL RET,MXBOOL CONVERT TO BOOL VALUE 61270000 + X RC,AWF1 DO EXCLUSINVE OPERATION 61275000 + B MXOR02 SAVE RESULT IN ONE-OP 61280000 + EJECT 61285000 +MXNE EQU * 61290000 +MXGE EQU * 61295000 +MXLE EQU * 61300000 +MXLT EQU * 61305000 +MXEQ EQU * 61310000 +MXGT EQU * 61315000 + LA R1,$BSNE GET $BSNE VALUE IN R1 61320000 + SRL R2,1 DIVIDE OPCADE BU 2 A 61325000 + IC R2,MXRELOPS-($BSNE/2)(R2) A 61330000 + STC R2,MXRELCH2+1 SAVE IT A 61335000 + MVI MCRSLTYP,$BSIMMB SET RESULT TYPE 61345000 + MVC MCRESULT,AWZEROS ASSUME FALSE FOR START 61350000 + TM MCBOPRTR,$BSRLCHR CHAR RELATION? 61355000 + BO MXRELCHR PROCESS CHAR REL IF YES 61360000 +MXRELAR EQU * ELSE PROCESS ARITH RELATION 61365000 + BAL RET,MXARITH GET 1ST VALUE 61370000 + ST RC,MXARG1 STORE TEMP 61375000 + IC RA,MCARG2DX GET ARG2 INDEX 61380000 + L RB,MCARG2LC GET ARG2 LOCATION 61385000 + BAL RET,MXARITH GET ARITH VALUE 61390000 + L RB,MXARG1 GET 1ST ARG 61395000 + CR RB,RC COMPARE OPRNDS 61405000 + B MXRELCH2 FALL THROUGH MEANS FALSE A 61410000 +MXRLATRU EQU * TARGET FOR TRUE CONDITION 61420000 + MVI MCRESULT+3,X'01' SET RESULT TO TRUE 61425000 + B MXPNONJP GET NEXT ONE-OP 61430000 +MXRELCHR EQU * 61435000 + BAL RET,MXCHAR GET ARG1 CHAR VLAUE 61440000 + STM RB,RC,MXARG1LN SAVE LEN AND TYPE TEMP 61445000 + IC RA,MCARG2DX GET ARG2 TYPE 61450000 +* A 61454300 + L RB,MCARG2LC GET ARG2 LOC 61455000 + BAL RET,MXCHAR GET CHAR VALUE 61460000 + LR RD,RB MOVE 2ND ARG LEN TO RD 61465000 + LR RE,RC MOVE 2ND ARG LOC TO RE 61470000 + LM RB,RC,MXARG1LN RESTORE LEN AND TYPE 61475000 + CR RB,RD COMPARE LENGTHS 61485000 + BNE MXRELCH2 UNEQUAL ==> COMPARE LENGHTS INSTD 61490000 + LTR RB,RB ZERO LENGTH? 61495000 + BZ MXRELCH2 IF YES USE LEN COMPARE 61500000 +MXRELCH1 EQU * 61505000 + BCTR RB,0 DECR LEN FOR EX INST 61510000 + EX RB,MXCHCOMP COMPARE STRINGS 61515000 +MXRELCH2 BC $,MXRLATRU A 61520000 + B MXPNONJP FALL THRU MEANS FALSE 61525000 +MXCHCOMP CLC 0($,RC),0(RE) DUMMY FOR CHAR COMPARE 61535000 +MXRELOPS DC XL6'70B0D0408020' MASKS FOR DIFFERENT RELATIONS 61540000 + EJECT 61545000 +* A 61545100 +* CONCATENATION PROCESSED A 61545200 +MXCAT EQU * 61550000 + MVI MCRSLTYP,$BSTRING SET TYPE TO CHAR 61555000 + BAL RET,MXCHAR GET CHAR VALUE OF ARG1 61560000 + STM RB,RC,MXARG1LN SAVE LEN & LOC TEMP 61565000 + IC RA,MCARG2DX GET ARG2 INDEX 61570000 + SPACE 1 A 61570100 + L RB,MCARG2LC GET ARG2 LOC 61575000 + BAL RET,MXCHAR GET CHAR VALUE OF ARG2 61580000 + LM RD,RE,MXARG1LN GET ARGU VALUE 61585000 + LR RA,RB GET LEN OF ARG2 61590000 + AR RA,RD GET TOTAL LEN OF ARGS 61595000 + LA R1,AVMWRK1 GET @ OF WORK AREA 61600000 + S RD,AWF1 DECR LEN OF ARG1 FOR EX INST 61605000 + BM MXCAT02 IF ZERO LEN, JUMP 61610000 + EX RD,MXMVWRK1 MOVE ARGU TO WORKAREA 61615000 + LA RD,1(RD) RESTORE ARG1 LEN 61620000 + AR R1,RD BUMP WORKAREA POINTER 61625000 + C RA,AWFXFF COMPARE TO MAX LENGTH 61630000 + BNH MXCAT02 IF NOT HIGH, OKAY 61635000 + LR RB,RA ELSE MOVE TOTAL TO RB 61640000 + LA RA,255 GET MAXIMUM ALLOWED LENGTH 61645000 + SR RB,RA GET ALLOWABLE REMADR IN RB 61650000 +MXCAT02 EQU * 61655000 + S RB,AWF1 DECR BY 1 FOR EX INST 61660000 + BM MXCAT03 IF ZERO LEN ON ARG2, JUMP 61665000 + LR RE,RC MOE PNTR TO FOR EX 61670000 + EX RB,MXMVWRK1 ADD ARG2 TO STRING 61675000 +MXCAT03 EQU * 61680000 + LA RE,AVMWRK1 GET STRING @ IN RE 61685000 + S RA,AWF1 DECR FOR EX INST 61690000 + BM MXCAT04 IF ZERO JUMP 61695000 + L R1,MXPCHRBF GET CURRENT @ OF STRING BUFFER 61700000 + AR R1,RA GET FINAL @ 61705000 + C R1,AVMCHLIM EXCEED BUFFER? 61710000 + BH MXCAT05 IF HIGH, JUMP FOR ERROR 61715000 + SR R1,RA RESTORE POINTER 61720000 + EX RA,MXMVWRK1 MOVE TO BUFFER 61725000 + ST R1,MCRESULT SAVE @ IN ONE-OP 61730000 +MXCAT04 EQU * 61735000 + LA RA,1(,RA) BUMP TO RESTORE CAT STRING LEN 61740000 + STC RA,MCRESULT SAVE LEN IN ONE-OP 61745000 + AR R1,RA GET FINAL DELIM @ 61750000 + ST R1,MXPCHRBF STORE @ IN TABLE 61755000 + B MXPNONJP GET NEXT ONE-OP 61760000 + SPACE 61765000 +MXMVWRK1 MVC 0($,R1),0(RE) MOVE ARG TO WORK AREA BUFFERER 61770000 + SPACE 61775000 +MXCAT05 EQU * 61780000 + LA RB,$ER#EXBF SET EXCEEDED BUFFER FLAG 61785000 + B MXPNINJE GO FLAG ERROR AND CONTINUE 61790000 + EJECT 61795000 +* A 61795100 +* AGO AMD AIF CODE PROCESSED A 61795200 +* A 61795300 +MXAIF EQU * 61800000 + BAL RET,MXBOOL GET BOOL VALUE 61805000 + LTR RC,RC TRUE OR FLSE? 61810000 + BZ MXPNINJP NO JUMP, CONTINUE SEQUENTAILLY 61815000 + AIF (NOT &$MACOPC).MXINSTB SKIP IF NOT OPEN CODE S 61816000 + OI AVMTAG00,AVMOPGO SHOW AIF WAS SUCCESSFUL S 61817000 +.MXINSTB ANOP S 61818000 +* FALL THRU, PROCESS LIKE AGO. 61820000 + SPACE 61825000 +MXAGO EQU * 61830000 + L R1,MXPNLDBS GET SET SYMB DICT BASE(LOCAL) 61835000 + L R0,0(R1) GET ACTR ALUE 61840000 + BCT R0,MXAGO01 DECR COUNT 61845000 + LA RB,$ER#ACTR SET ACTR ERROR FLAG IF FALL THRU 61850000 + B MXINKIL1 GENERAL ERROR MSG & SET FLAG A 61855000 +MXAGO01 EQU * 61860000 + ST R0,0(R1) RESTORE DECREMENTED ACTR 61865000 + L RW,MCARG2LC GET @ OF BRANCH INTO RW, WHERE EXPCT 61870000 + B MXPNINJQ GO TO HAVE BRANCH DONE 61875000 + SPACE 61880000 +MXSETA EQU * 61885000 +MXSETB EQU * 61890000 +MXSETC EQU * 61895000 + BAL RET,MXADDR GET @ OF TARGET 61900000 + ST RC,MXARG1 SAVE TEMP 61905000 + IC RA,MCARG2DX GET ARG2 INDEX 61910000 + L RB,MCARG2LC GET 2ND RG LOC 61915000 + CLI MCBOPRTR,$BSETB ARITH, BOOL OR CHAR? 61920000 + BH MXSETC01 CHAR IF HIGH 61925000 + BE MXSETB01 BOOL IF EQUAL 61930000 + BAL RET,MXARITH ARITH IF FALL THRU 61935000 + B MXSETB02 USE BOOL CODE TO STORE 61940000 + SPACE 1 61945000 +MXSETB01 EQU * 61950000 + BAL RET,MXBOOL GET BOOL VALUE 61955000 +MXSETB02 EQU * 61960000 + L R1,MXARG1 GET TARGET @ 61965000 + ST RC,0(R1) STORE RESULT 61970000 + B MXPNINJP GET NEXT INST 61975000 + SPACE 1 61980000 +MXSETC01 EQU * 61985000 + BAL RET,MXCHAR GET CHAR VALUE 61990000 + L R1,MXARG1 GET TARGET @ 61995000 +*************** POSSIBLE CHANGE WITH ASM H OR VS *********************S 61995100 + C RB,=F'8' LEN > 8 62000000 + BNH MXSETC02 PROCEED IF NOT 62005000 + LA RB,8 ELSE SET LEN TO MAX 62010000 +MXSETC02 EQU * 62015000 + ST RB,0(R1) SAVE LENGTH 62020000 + S RB,AWF1 DECR FOR EX 62025000 + BM MXPNINJP IF ZERO, GET NEXT INST 62030000 + EX RB,MXPMVSET MOVE STRING TO SET SYMBOL 62035000 + B MXPNINJP GET NEXT INST 62040000 + SPACE 62045000 +MXPMVSET MVC 4($,R1),0(RC) DUMMY TO MOVE STRING 62050000 + EJECT 62055000 +* NEXT SECTION HANDLES SUBSCRIPTED SET SYMBOLS AND SYMBOLIC PRAMS 62060000 + SPACE 62065000 +MXSBSCRP EQU * 62070000 + CLI MCARG1DX,$BSYMPAR SYMPAR, K' OR T'? 62075000 + BNL MXSCRP01 JUMP AND PROCESS IF YES 62080000 + BAL RET,MXADDR ELSE GET @ OF SET SYMBOL 62085000 + LA R1,$BSATT GET $BSADDRA-2 62090000 + SRL RE,1 DIVIDE $ARITH, ETC TO GET 2, 4 OR 6 62095000 + AR R1,RE GET $BSADDRA, B ORC 62100000 + STC R1,MCRSLTYP SAVE TYPE IN ONE-OP 62105000 + ALR RE,RE RESTORE TYPE(4,8,12) 62110000 + STM RC,RE,MXARG1LN SAVE @, LEN AND TYPE TEMP 62115000 +MXSCRP01 EQU * 62120000 + IC RA,MCARG2DX GET ARG2 INDEX 62125000 + L RB,MCARG2LC GET ARG2 LOC 62130000 + BAL RET,MXARITH GET ARITH VALUE 62135000 + LTR RC,RC TEST VALUE OF INDEX 62140000 + BP MXSCRP02 PROCEED IF > 0 62145000 +MXSCRPDR EQU * 62150000 + LA RB,$ER#DMER ELSE SET DIMENON ERROR FLAG 62155000 + B MXPNINJE GO FLAG ERROR AND CONTINUE 62160000 +MXSCRP02 EQU * 62165000 + CLI MCARG1DX,$BSYMPAR SYM PAR, K' OR T'? 62170000 + BNL MXSBSCSP JUMP IF YES 62175000 + C RC,MXARG1 COMPARE WITH SET SYMB DIM 62180000 + BH MXSCRPDR ERROR IF HIGH 62185000 + BCTR RC,0 DECR TO GET OFFSET 62190000 + CLI MCRSLTYP,$BSADDRB BOOL TYPE? 62195000 + BNE MXSCRP03 SKIP IF NOT 62200000 + MVI MXARG2+3,4 ELSE SET LEN TO 4 62205000 +MXSCRP03 EQU * 62210000 + MH RC,MXARG2+2 MULT TO GET OFFSET 62215000 + A RC,MXARG1LN ADD BASE @ 62220000 + ST RC,MCRESULT PUT RESULT IN ONE-OP 62225000 + B MXPNONJP GET NEXT ONE-OP 62230000 + SPACE 62235000 +MXSBSCSP EQU * PROCESS SYMBOLIC PARAMETER SUBSCRIPT 62240000 + MVI MCRSLTYP,$BSTRING SET TO CHAR FOR OPERNERS 62245000 + MVC MCRESULT,AWZEROS INIT REULST TO ZERO 62250000 + LA R1,$LMPAROP GET LEN OF SYM PAR DICT ENTRY 62255000 + MH R1,MCARG1LC+2 MULST BY SYM PAR SUBSCRIPT 62260000 + A R1,MXPNLSPT ADD SYM PAR BASE @ OF DICT 62265000 + USING MCPAROPR,R1 SET USING FOR DICT ENTRY 62270000 + SR RB,RB CLEAR RB FOROPRND COUNT 62275000 + IC RB,MCPARONB GET NBR OF SUBOPRNDS 62280000 + CR RB,RC COMPARE WITH SUBSCRIPT 62285000 + BNL MXSCSP03 PROCEED IF WITHIN RANGE 62290000 +MXSCSP00 EQU * 62295000 + CLI MCARG1DX,$BSATK K' ATRIB? 62300000 + BE MXSCSP01 K' IF EQUAL 62305000 + BH MXSCSP02 T' IF HIGH 62310000 + C RC,AWF1 1ST SUBSCRIPT WANTED? 62315000 + BNE MXPNONJP FINI IF NOT 62320000 + MVC MCRESULT+1(3),MCPAROPT+1 ELSE IS SYMPAR, COPY RESUL 62325000 + MVC MCRESULT(1),MCPAROLN 62330000 + B MXPNONJP SYM PAR IF FALL THRU, DEFAULT VALUE 62335000 +MXSCSP01 EQU * PROCESS K' OUT OF RANGE 62340000 + MVI MCRSLTYP,$BSIMMA SET TYPE TO ARITH 62345000 + C RC,AWF1 1ST SUBSCRIPT WANTED? 62350000 + BNE MXPNONJP FINI IF NOT 62355000 + MVC MCRESULT+3(1),MCPAROLN MOVE K' OF MAIN OPRND TO RESULT 62360000 + B MXPNONJP AND GET NEXT ONE-OP 62365000 +MXSCSP02 EQU * PROCESS T' OUT OF RANGE 62370000 + C RC,AWF1 1ST SUBSCRIPT WANTED? 62375000 + BNE MXSCSP21 USE NULL TYPE IF NOT 62380000 + LA RA,MCPAROTP ELSE POINT AT OPRND TYPE 62385000 + B MXSCSP22 62390000 +MXSCSP21 EQU * 62395000 + LA RA,=C'O' POINT AT NULL TYPE 62400000 +MXSCSP22 EQU * 62405000 + ST RA,MCRESULT STORE IN ONE-OP 62410000 + MVI MCRESULT,1 ST LENGTH TO 1 62415000 + B MXPNONJP GET NEXT ONE-OP 62420000 +MXSCSP03 EQU * PRROCESS SUBSCRIPTS IN RANG 62425000 + L R2,MCPRSBPT GET POINTER TO SUBLIST ENTRIES 62430000 + LTR R2,R2 SUBLIST EXISTS? 62435000 + BZ MXSCSP00 PROCESS AS OUT OF RANGE IF NOT 62440000 + BCTR RC,0 DECR INDEX 62445000 + SLL RC,3 MULT BY 8 TO GET OFFSET 62450000 + AR R2,RC POINT TO SUBENTRY 62455000 + USING MCPARSUB,R2 SET USING ON SUB ENTRY 62460000 + CLI MCARG1DX,$BSATK K' ATTRIB? 62465000 + BE MXSCSP04 YES IF EQUAL 62470000 + BH MXSCSP05 T' IF HIGH 62475000 + MVC MCRESULT+1(3),MCPARSPT+1 ELSE IS SYMPAR, COPY POINT 62480000 + MVC MCRESULT(1),MCPARSLN GET LEN OF STRING 62485000 + B MXPNONJP AND GET NEXT ONE-OP 62490000 +MXSCSP04 EQU * PROCESS K' IN RANGE 62495000 + MVC MCRESULT+3(1),MCPARSLN MOVE K' TO RESULT 62500000 + MVI MCRSLTYP,$BSIMMA SET TYPE TO ARITH 62505000 + B MXPNONJP GET NEXT ONE-OP 62510000 +MXSCSP05 EQU * PROCESS T' IN RANGE 62515000 + LA RB,MCPARSTP GET @ OF TYPE 62520000 + ST RB,MCRESULT PLACE IN RESULT 62525000 + MVI MCRESULT,1 SET LEN TO 1 62530000 + B MXPNONJP GET NEXT ONE-OP 62535000 + DROP R1,R2 DROP USING ON MCPAROPR,MCPARSUB 62540000 + SPACE 62545000 + EJECT 62550000 +* NEXT SECTION PROCESSES SUBSTRING ACTION 62555000 + SPACE 62560000 +MXSBST EQU * 62565000 + MVI MCRSLTYP,$BSTRING INIT TYPE TO STRING 62570000 + MVC MCRESULT,AWZEROS INIT LEN TO ZERO 62575000 + BAL RET,MXARITH GET 1ST ARG VALUE 62580000 + LTR RC,RC WAS 1ST EXP <= 0 62585000 + BNP MXSBSTER ERROR IF INDEX <=0 62590000 + ST RC,MXARG1 SAVE VALUE TEMP 62595000 + IC RA,MCARG2DX GET ARG2 INDEX 62600000 + L RB,MCARG2LC GET ARG2 LOC 62605000 + BAL RET,MXARITH GET ARITH VALUE 62610000 + LTR RC,RC WAS VALUE <= 0 62615000 + BNP MXSBSTER ERROR IF SO 62620000 +* **NOTE** MAY CHANGE THIS FOR G-LEVEL COMPATIBLE CODE 62625000 + C RC,=F'8' LEN > 8? 62630000 + BH MXSBSTER ERROR IF YES 62635000 + ST RC,MXARG2 SAVE ARG2 TEMP 62640000 + IC RA,MCARG1DX+$LMCQUAD GET TYPE OF OPRND 62645000 + L RB,MCARG1LC+$LMCQUAD GET LOC OF OPERAND 62650000 + BAL RET,MXCHAR CONVERT TO CHAR 62655000 + C RB,MXARG1 LEN < STARTING CHAR? 62660000 + BNL MXSBST01 OKAY IF NO LOW 62665000 + L RC,MXARG1 ELSE PUT BAD VALUE IN RC 62670000 + B MXSBSTER AND JUMP TO FLAG ERROR 62675000 +MXSBST01 EQU * 62680000 + LM RD,RE,MXARG1 GET START NBR AND LEN 62685000 + AR RD,RC GET NEW START @ + 1 62690000 + BCTR RD,0 DECR @ 62695000 + ST RD,MCRESULT SAVE START @ OF SUBSTING 62700000 + AR RC,RB GET PNTR TO END OF STRING + 1 62705000 + AR RD,RE GET PNTR TO SUBSTR END PLUS 1 62710000 + CR RC,RD SUBSTRING OKAY? 62715000 + BNL MXSBST03 JUMP IF OKAY 62720000 + S RC,MCRESULT ELSE GET LEN OF RMNDR OF STRING 62725000 + STC RC,MCRESULT SAVE LEN OF SUBST 62730000 + B MXSBSTFT JUMP TO FOOT 62735000 +MXSBST03 EQU * 62740000 + S RD,MCRESULT GET LENGTH OF SUBSTR 62745000 + STC RD,MCRESULT SVE LEN OF SUBSTR IN ONE-OP 62750000 +MXSBSTFT EQU * 62755000 + LA RW,$LMCQUAD(RW) BUMP PNTR PAST DUMMY ONE-OP 62760000 + B MXPNONJP GET NEXT ONE-OP 62765000 + SPACE 1 62770000 +MXSBSTER EQU * 62775000 + LA RB,$ER#SBST SET SUBSTR ERROR FLAG 62780000 + B MXPNINJE GO FLAG ERROR AND CONTINUE 62785000 + EJECT 62790000 +* NEXT SECTION PROCESSES SYSLIST SUBSCRIPTED VARIABLE 62795000 + SPACE 62800000 +MXSYSL EQU * 62805000 + MVI MCRSLTYP,$BSTRING INIT TO CHAR TYPE 62810000 + MVC MCRESULT,AWZEROS INIST RESULT TO ZERO 62815000 + CLI MCBOPRTR+$LMCQUAD,X'00' DOUBLE SUBSCRIPT? 62820000 + BNE MXSYSL01 SINGLE ONE-OP IF NOT 62825000 + BAL RET,MXARITH ELSE GET VALUE OF 1ST SUBSCRIPT 62830000 + ST RC,MXARG1 STORE TEMP 62835000 +MXSYSL01 EQU * 62840000 + IC RA,MCARG2DX GET 2ND ARG 62845000 + L RB,MCARG2LC GET LOC 62850000 + BAL RET,MXARITH CONVERT TO ARITH 62855000 + ST RC,MXARG2 SAVE TEMP(1ST SUB OF SINGLE) 62860000 + CLI MCBOPRTR+$LMCQUAD,X'00' 2 OPRNDS 62865000 + BNE MXSYSL02 JUMP IF NOT 62870000 + L RC,MXARG1 ELSE RESTORE 1ST ARG VALUE A 62875000 +MXSYSL02 EQU * 62880000 + LTR RC,RC VALUE > 0 62885000 + BNL MXSYSL03 IF >= 0, OKAY 62890000 +MXSYSLR1 EQU * 62895000 + LA RB,$ER#SYSL SET SYSLIST DIM ERROR 62900000 + B MXPNINJE GO FLAG ERROR AND CONTINUE 62905000 +MXSYSL03 EQU * 62910000 + C RC,MXPNBOPS COMPARE WITH NBR OF POSIT OPRNDS 62915000 + BH MXSYSLHI JUMP IF HIGH 62920000 +* PROCESS &SYSLIST(A), N', K', T' WITHIN RANGE 62925000 + LA RB,$LMPAROP GET LEN OF SY PAR DICT ENTRY 62930000 + MR RB,RB MULT BY SUBSCRIPT TO GET OFFSET 62935000 + A RC,MXPNLSPT ADD BASE @ OF SYM PAR DICT 62940000 + USING MCPAROPR,RC SET USING FOR DICT ENTRY 62945000 + CLI MCBOPRTR+$LMCQUAD,X'00' DOUBLE SUBSCRIPT? 62950000 + BE MXSYLDBL PROCESS IF YES 62955000 + CLI MCARG1DX,$BSYSLST &SYSLIST? 62960000 + BNE MXSYSL04 IF NOT MUST BE ATTRIB 62965000 + MVC MCRESULT+1(3),MCPAROPT+1 MOVE OPRND PNTR TO ONE-OP 62970000 + MVC MCRESULT(1),MCPAROLN MOVE LENGTH OF OPNRD TO ONE-OP 62975000 + B MXPNONJP GET NEXT OPCODE 62980000 +MXSYSL04 EQU * 62985000 + SR R1,R1 62990000 + CLI MCARG1DX,$BSATN WHICH ATTRIB? 62995000 + BH MXSYSLTP T' IF HIGH 63000000 + BE MXSYSLNP N' IF EQUAL 63005000 + MVC MCRESULT+3(1),MCPAROLN K' IF FALL THRU 63010000 + MVI MCRSLTYP,$BSIMMA SET TYPE TO ARITH 63015000 + B MXPNONJP GET NEXT ONE-OP 63020000 +MXSYSLNP EQU * 63025000 + MVI MCRSLTYP,$BSIMMA SET TYPE TO ARITH 63030000 + MVC MCRESULT+3(1),MCPARONB GET NBR OF SUB OPRNDS 63035000 + CLI MCPARONB,X'00' ZERO SUBOPRNDS? 63040000 + BNE MXPNONJP IF > 0, GET NEXT ONE-OP 63045000 + CLI MCPAROTP,C'O' NULL OPRND? 63050000 + BE MXPNONJP IF YES, GET NEXT ONE-OP 63055000 + MVI MCRESULT+3,1 ELSE SET NBR TO 1 63060000 + B MXPNONJP AND GET NEXT ONE-OP 63065000 +MXSYSLTP EQU * PROCESS T' IN RANGE 63070000 + LA R1,MCPAROTP GET @ OF TYPE 63075000 + ST R1,MCRESULT STORE RESULT IN ONE-OP 63080000 + MVI MCRESULT,1 SET LEN=1 63085000 + B MXPNONJP GET NEXT ONE-OP 63090000 +MXSYLDBL EQU * PROCESS DOUBLE SUBSCRIPTE 63095000 + L R1,MXARG2 GET 2ND VALUE 63100000 + LTR R1,R1 POSITIVE? 63105000 + BH MXSYLDB1 OKAY IF YES 63110000 + LR RC,R1 ELSE MOVE BAD VALUE TO RC 63115000 + LA RW,$LMCQUAD(RW) BUMP ONE-OP PNTR PAST DUMMY 63120000 + B MXSYSLR1 JUMP TO FLAG ERROR 63125000 +MXSYLDB1 EQU * 63130000 + SR RE,RE 63135000 + IC RE,MCPARONB GET SUBOPRND COUNT 63140000 + CR R1,RE SUBS > NBR SUBOPRNDS? 63145000 + BNH MXSYLDB2 PROCEED IFLOW 63150000 + CLI MCARG1DX+$LMCQUAD,$BSYSLST $BSYSLIST? 63155000 + BE MXSYSDFT JUMP TO FOOT IF YES 63160000 + MVI MCRSLTYP,$BSIMMA SET TYPE = ARITH 63165000 + CLI MCARG1DX+$LMCQUAD,$BSATK K'&SYSLIST? 63170000 + BE MXSYSDFT FINI IF YES 63175000 + MVI MCRSLTYP,$BSTRING ELSE SET TYPE TO CHAR 63180000 + LA R1,=C'O' ELSE GET @ OF NULL TYPE 63185000 + B MXSYLDB5 SKIP TO SAVE @, SET LEN=1 63190000 +MXSYLDB2 EQU * PROCESS &SYSLIST(A,B) IN RANGE 63195000 + L RC,MCPRSBPT GET @ OF SUBOPRNDS 63200000 + USING MCPARSUB,RC SET USING FOR SUB E TRY 63205000 + BCTR R1,0 DECR INDEX FOR MULT 63210000 + SLL R1,3 MULT BY 8 FOR OFFSET 63215000 + AR RC,R1 MOVE BASE TO RIGHT ENTRY 63220000 + CLI MCARG1DX+$LMCQUAD,$BSYSLST &SYSLIST? 63225000 + BNE MXSYSDB3 IF NOT, PROCESS T' OR K' 63230000 + MVC MCRESULT,MCPARSPT ELSE MOVE @ OF SUBOPRND TO ONE-OP 63235000 + MVC MCRESULT(1),MCPARSLN MOVE LEN TO ONE-OP 63240000 + B MXSYSDFT JUMP TO FOOT 63245000 +MXSYSDB3 EQU * PROCESS K'&SYSLIST OR T'&SYSLIST 63250000 + CLI MCARG1DX+$LMCQUAD,$BSATT T'&SYSLIST? 63255000 + BE MXSYLDB4 JUMP IF YES 63260000 + MVC MCRESULT+3(1),MCPARSLN ELSE MUST BE K'&SYSLIST 63265000 + MVI MCRSLTYP,$BSIMMA SET TYPE TO ARITH 63270000 + B MXSYSDFT JUMP TO FOOT 63275000 +MXSYLDB4 EQU * 63280000 + LA R1,MCPARSTP GET @ OF TYPE 63285000 +MXSYLDB5 ST R1,MCRESULT STORE IN ONE-OP 63290000 + MVI MCRESULT,1 SET LEN TO 1 63295000 +* FALL THRU INTO MXSYSDFT 63300000 +MXSYSDFT EQU * 63305000 + LA RW,$LMCQUAD(RW) BUMP PNTR PAST DUMMT ONE-OP 63310000 + B MXPNONJP GET NEXT ONE-OP 63315000 + DROP RC 63320000 + SPACE 63325000 +* PROCESS &SYSLIST(A), T' OR K' WHERE A > NBR OPRNDS 63330000 + SPACE 63335000 +MXSYSLHI EQU * 63340000 + CLI MCBOPRTR+$LMCQUAD,X'00' DOUBLE SUBS? 63345000 + BE MXSYSLHD PROCESS IF YES 63350000 + CLI MCARG1DX,$BSYSLST $&SYSLIST? 63355000 + BE MXPNONJP GET NEXT ONE OP IF YES 63360000 + CLI MCARG1DX,$BSATN N'? 63365000 + BNH MXSYSLHK K' OR N' IF LOW OR EQUAL 63370000 + B MXSYSLHT T' IF HIGH 63375000 +MXSYSLHD EQU * PROCESS DUBLE SUBSCRIPT 63380000 + CLI MCARG1DX+$LMCQUAD,$BSYSLST &SYSLIST? 63385000 + BE MXSYSDFT FINI IF YES 63390000 + CLI MCARG1DX+$LMCQUAD,$BSATN N'? 63395000 + BH MXSYSLHT ELSE IS T'&SYSLIST 63400000 +* FALL THRU ==> K', IF LOW 63405000 +MXSYSLHK EQU * 63410000 + MVI MCRSLTYP,$BSIMMA SET TYPE TO ARITH 63415000 +MXSYSTSD EQU * 63420000 + CLI MCBOPRTR+$LMCQUAD,X'00' DOUBLE SUBS? 63425000 + BE MXSYSDFT FINI IF YES, JUMP TO DOUBLE FOOT 63430000 + B MXPNONJP ELSE GET NEXT ONE-OP 63435000 +MXSYSLHT EQU * 63440000 + LA R1,=C'O' GET @ OF NULL TYPE 63445000 + ST R1,MCRESULT STORE @ IN ONE-OP 63450000 + MVI MCRESULT,1 SET LEN TO 1 63455000 + B MXSYSTSD TEST FOR DOUBLE SUBS 63460000 + EJECT 63465000 +* SECTION TO ADD CHARS TO OUTPUT A 63465100 +* A 63465200 +MXPRNT EQU * 63470000 + USING RSBLOCK,RY NOTE USING ON SOURCE 63475000 + L RY,AVRSBPT SET BASE ON SOURCE 63480000 + BAL RET,MXCHAR CONVERT ARG TO STRING 63485000 + LA RA,RSBSOURC SET SCAN POINTER 63490000 + LA RE,$LMSRCMX(RA) SET UPPER LIMIT POINTER 63495000 + A RA,MCARG2LC ADD OFFSET 63500000 + CLI RSBLENG,X'00' 1ST MOVE? 63505000 + BE MXPRNT01 63510000 + SR R1,R1 63515000 + IC R1,RSBLENG GET PREV LEN-1 63520000 + LA R1,RSB$L+1(R1,RY) POINT TO AVAILABLE BYTE 63525000 + CR RA,R1 COMPARE WITH TARGET 63530000 +* FOLLOWING CHECKS SPECIAL CASE OF OPRND MEETING COMMENT A 63535000 + BH MXPRNT01 OKAY IF NEXT PTR > OLD END A 63540000 + BL MXPRNT00 IF LOW, MUST INCREM BEYOND ANYWAY A 63545000 + TM MCBOPRTR,$MPRCOM IF EQUAL, CHECK FOR SPECIAL COMPR A 63550000 + BZ MXPRNT01 NOT COMMENT,CONCAT IF COM,MOVE OVERA 63555000 +MXPRNT00 LA RA,1(,R1) SKIP BLANK B A 63560000 +MXPRNT01 EQU * 63565000 + S RB,AWF1 DECR RB 63570000 + BM MXPNONJP IF NULL, GET NEXT ONE-OP 63575000 + LA R2,0(RA,RB) POINT TO FINAL BYTE 63580000 + CR R2,RE EXCEED LIMIT? 63585000 + BNH MXPRNT02 PROCEED IF OKAY 63590000 + LA RB,$ERMEXST ELSE SET ERROR FLAG 63595000 + $CALL ERRTAG FLAG STMT 63600000 + B MXPNONJP GET NEXT ONE-OP 63605000 +MXPRNT02 EQU * 63610000 + EX RB,MXPMVSRC MOVE STRING TO SOURCE BLOCK 63615000 + LA RA,RSBSOURC GET START @ 63620000 + SR R2,RA GET LEN-1 IN R2 63625000 + STC R2,RSBLENG STORE LEN-1 63630000 + B MXPNONJP GET NEXT ONE-OP 63635000 +MXPMVSRC MVC 0($,RA),0(RC) DUMMY TO MOVE STRING 63640000 + DROP RY 63645000 + EJECT 63650000 + SPACE 2 63655000 +* INNER MACRO CALL A 63655100 +* A 63655200 +MXINMAC EQU * 63660000 + USING RSBLOCK,RY NOTE USING 63665000 + L RY,AVRSBPT SET BASE 63670000 + SR R1,R1 USE R1 FOR LENGTH 63675000 + IC R1,RSBLENG GET LENGTH IN R1 63680000 + LA R1,RSB$L+1(RY,R1) POINT TO NEXT AVAILABLE BYTE 63685000 + MVC 0(4,R1),=C' '' ' MOVE END OF RECORD INDICATROR 63690000 + LA R1,1(R1) BUMP R1 63695000 + ST R1,AVSOLAST SAVE END OF RECORD @ 63700000 + MVI RSBNUM,1 SET NBR CARDS TO 1 63705000 + LA RB,RSBLOCK+RSB$L+RSOL1 POINT TO 1ST BYTE, 2ND CARD 63710000 + CR R1,RB COMPARE WITH AVSOLAST 63715000 + BL MXINMAC1 AVSOLAST LOW, ONE CARD 63720000 + MVI RSBNUM,2 SET COUNT TO 2 CARDS 63725000 + LA RB,RSOLC(RB) BUMP RB TO 1ST BYTE, 3RD CARD 63730000 + CR R1,RB COMPARE WITH AVSOLAST 63735000 + BL MXINMAC1 IF LOW, 2 CARDS 63740000 + MVI RSBNUM,3 ELSE IS 3 CARDS 63745000 +MXINMAC1 EQU * 63750000 + OI RSBFLAG,$RSBGENR+$RSBNPNN SET GEN & NO ACTION FLAGS 63755000 + TM RSBFLAG,$REBX ERROR BLOCK EXISTS? 63760000 + BNO MXINCALL A 63765000 + SPACE 4 63795000 +MXMVSTMT EQU * 63800000 + USING RSBLOCK,RY 63805000 + L RY,AVRSBPT SET BASE 63810000 + OI RSBFLAG,$RSBGENR SET GEN FLAG 63815000 + TM MCBOPRTR,$BSMNTER MNOTE ERROR? 63820000 + BNO MXMVSTMU SKIP IF NOT 63825000 + OI RSBFLAG,$RSBMERR SET ERROR FLAG 63830000 +MXMVSTMU EQU * 63835000 + $CALL MXMVSR MOVE SOURCE TO HIGH 63840000 + LTR RB,RB OVERFLOW? 63845000 + BNZ MXEXECOV FLAG IF YES 63850000 + B MXPNINJP GET NEXT INST 63855000 +MXERRMS EQU * 63865000 + LA RB,$ER#PRVR SHOW PREVIOUS ERROR S 63870000 + DROP RY S 63871100 + BAL R1,MXINERRM CALL ERROR FLAG ROUTINE S 63875000 + B MXPNINJP ELSE GET NEXT INST 63925000 + SPACE 63935000 +MXANOP EQU MXPNINJP NO CODE NEEDED, GO FOR NEXT 63940000 +MXFIN EQU MXPNINJP NO CODE NEEDED, GO FOR NEXT 63945000 + EJECT S 63950000 +* *** ERROR EXITS: TERMINATE PROCESSING ***** 63955000 +MXINV EQU * 63960000 + LA RB,$ER#SYER SET SYSTEM ERR FLAG 63965000 + B MXMENDEC STOP PROCESSING AND RETURN 63970000 +MXMENDER LA RB,$ER#MXST SET EXCEED STMTS FLAG 63975000 +MXMENDEC EQU * CALL MXERRM AND QUIT-TYPE EXIT LABEL 63980000 + BAL R1,MXINERRM GENERATE ERROR MESSAGE A 63985000 +MXENDEF LA RB,12 RB SET TO KILL MACROS A 63990000 + B MXINRTN RETURN A 63990100 +* FALL THRU, HANDLE AS MEND OR MEXIT. 63995000 + SPACE 64000000 +MXMEND EQU * 64005000 +MXMEXIT EQU * 64010000 + SR RB,RB RB SET FOR MEND OR MEXIT S 64015000 +MXINRTN EQU * A 64015100 + L R1,AVMXSPIE RELOAD R1 FROM SPIE PTR A 64015110 + LM RC,RD,AVGEN1CD A 64015151 + XSNAP LABEL='AT MXINST RET',STORAGE=(*0(RD),*0(RC),*AVADDLOW,*X64015152 + AVWXEND),IF=(AVTAGSM,O,AJOMACRH,TM) 64015153 + $SPIE ,,,ACTION=(RS,(1)) A 64020000 + $RETURN RGS=(R14-R6) A 64125000 + SPACE 64140000 +MXARG1LN DS F TEMP STORAGE FOR ARG1 LENGTH 64145000 +MXARG1 DS F TEMP STORAGE FOR ARG1 64150000 +MXARG2 DS F TEMP STORAGE FOR ARG2 64155000 +* S 64170005 +* SET RB TO RETURN CONDITION S 64170010 +* S 64170020 +MXINKIL1 EQU * S 64170030 + BAL R1,MXINERRM CALL ERR MSG ROUTINE S 64170040 + LA RB,8 SET KILL MACRO NEST FLAG S 64170050 + B MXINRTN NORMAL RETURN S 64170060 +MXINCALL EQU * A 64170070 + LA RB,4 SET RETURN CODE A 64170080 + B MXINRTN RETURN A 64170090 + LTORG S 64170092 + DS 0H FORCE ALIGNMENT S 64170093 + EJECT A 64170095 +**--> INSUB: MXINERRM CALLS MXERRM TO HANDLE ERROR MESSAGES + +S 64170100 +*+ +S 64170200 +*+ ENTRY CONDITIONS: +S 64170300 +*+ RB = ERROR CODE +S 64170400 +*+ RC = VALUE IF ANY +S 64170500 +*+ RD = LENGTH +S 64170600 +*+ R1 = LINK REG +S 64170700 +*+ +S 64170800 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 64170900 + SPACE 2 S 64170950 +MXINERRM EQU * S 64171000 + LR RE,RZ COPY @ OF MXPNTSAV A 64171050 + $CALL MXERRM CALL ERROR ROUTINE S 64171100 + LTR RB,RB TEST RB FOR OVERFLOW S 64171200 + BCR Z,R1 RETURN ON NOT OVERFLOW S 64171300 +* SET RB TO OVERFLOW VALUE AND RETURN S 64171400 +MXEXECOV EQU * S 64171500 + LA RB,16 SET OVERFLOW FLAG S 64171600 + B MXINRTN NORMAL RETURN S 64171700 + SPACE 5 S 64171800 +**--> INSUB: MXARITH MXARITH PRODUCES ARITH ONE-OP A 64175000 +*+ MXBOOL PRODUCES BOOLEAN ONE-OP A 64175100 +*+ MXCHAR PRODUCES CHAR ONE-OP A 64175200 +* TYPE. * 64180000 +* * 64185000 +* ENTRY CONDITIONS * 64190000 +* RA = TYPE OF OPRND * 64195000 +* RB = @ OF OPRND (OR VALUE IF IMMEDIATE TYPE) * 64200000 +* * 64205000 +* EXIT CONDITIONS * 64210000 +*+ RA=BYTE REG A 64210100 +*+ R1=WIPED OUT A 64210200 +*+ RE=WIPED OUT A 64210300 +* RB = LENGTH OF CHAR STRING IF CHAR VALUE * 64215000 +* RC = VALUE IF ARITH OR BOOL, @ OF STRING IF CHAR * 64220000 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 64225000 + SPACE 64230000 +MXARITH DS 0F 64235000 + OI AVMBYTE2,$MINARIT SET ARITH FLAG 64240000 + B MXSCCV 64245000 +MXBOOL EQU * 64250000 + OI AVMBYTE2,$MINBOOL SET BOOL REQ'D FLAG 64255000 + B MXSCCV 64260000 +MXCHAR EQU * 64265000 + OI AVMBYTE2,$MINCHAR SET CHAR REQ'D FLAG 64270000 +MXCONVBS DS 0H BASE FOR JUMP TABLE 64280000 +MXSCCV EQU * 64285000 + ST RET,MXSCCVSV SAVE RETURN @ 64290000 + SPACE 64295000 +MXCONJMP EQU * 64300000 + N RA,AWFXFF MASK OUT ALL EXCEPT INDEX 64305000 + LH R1,MXCONNDX(RA) GET OFFSET OF ROUTINE 64310000 + XSNAP LABEL='***MXARITH ENTERED***', X64320000 + IF=(AVMSNBY2,O,$MSNP12,TM) 64325000 + B MXCONVBS(R1) JUMP TO ROUTINE 64330000 + SPACE 64335000 +MXCONNDX $AL2 MXCONVBS,(MXCNGLA,MXCNGLB,MXCNGLC,MXCNLCA,MXCNLCB,MXCNLC#64340000 + C,MXCNSYPR,MXCNIMMA,MXCNIMMB,MXCNIMMC,MXCNSYSX,MXCNUND,M#64345000 + XCNCSCT,MXCNUND,MXCNTEMP,MXCNUND,MXCNUND,MXCNATTK, #64350000 + MXCNUND,MXCNATTN,MXCNUND,MXCNATTT,MXCNADDA,MXCNADDB, #64355000 + MXCNADDC),-2 64360000 + SPACE 64365000 +* PROCESS GLOBALS A 64365100 +* A 64365200 + USING MCGLBDCT,RB NOTE USING FOR GLOBAL SET SYMB DV 64370000 +MXCNGLA EQU * 64375000 + L RC,MCGBAVAL GET ARITH VALUE 64385000 + B MXCONV0A 64390000 + SPACE 64395000 +MXCNGLB EQU * 64400000 + L RC,MCGBAVAL GET BOOL VALUE 64410000 + B MXCONV0B 64415000 +MXCNGLC EQU * 64420000 + LA RC,MCGBCVAL GET @ OF CHAR VALUE 64430000 + L RB,MCGBCLEN GET LENGTH OFSTRING 64435000 + B MXCONV0C 64440000 + EJECT 64445000 +MXCNLCA EQU * 64450000 +MXCNLCB EQU * 64455000 +MXCNLCC EQU * 64460000 + L RC,MGLCLPNT GET OFFSET 64470000 + A RC,MXPNLDBS ADD BASE @ OF LOCAL SET SYM DICT 64475000 + CLI MCGLBTYP,$BOOL WHAT TYPE A 64480000 + BH MXCNLCA1 CHAR IF HIGH 64485000 + L RC,0(RC) ELSE GET ARITH OR BOOL VALUE 64490000 + BL MXCONV0A ARITH IF LOW 64495000 + B MXCONV0B ELSE IS BOOL 64500000 +MXCNLCA1 EQU * 64505000 + L RB,0(RC) GET LEN OF CHAR 64510000 + LA RC,4(RC) BUMP POINTER TO STRING 64515000 + B MXCONV0C 64520000 + DROP RB DROP USING ON SET SYMB DV 64525000 + SPACE 64530000 +MXCNSYPR EQU * 64535000 + USING MCPAROPR,RE NOTE USING ON SYM PAR DICT ENTRY 64540000 + LA RE,$LMPAROP GET LEN OF ENTRY 64550000 + MR RD,RB CALCULATE OFFSET 64555000 + A RE,MXPNLSPT ADD SYM PAR DICT BASE 64560000 + L RC,MCPAROPT GET POINTER TO STRING 64565000 + IC RB,MCPAROLN GET LEN OF STRING 64570000 + TM AVMBYTE2,$MINCHAR+$MINBOOL A 64575000 + BNZ MXCONV0C S 64580000 + CLI MCPAROTP,C'N' FALL THRU MEANS ARITH REQ'D 64595000 + BE MXCNSYP1 IF SELF DEF TERM, OK 64600000 +MXCNSYER EQU * 64605000 + LR RD,RB ELSE MOVE LEN TO RD 64610000 + LA RB,$ER#CVCA SET CONVERSION ERROR 64615000 + B MXPNINJE GO FLAG ERROR AND CONTINUE 64620000 +MXCNSYP1 EQU * 64625000 + LR RA,RC MOVE POINTER TO RA 64630000 + $CALL SDBCDX CHECK FOR SELF DEF TERM 64635000 + LTR RB,RB OKAY? 64640000 + BZ MXCONRTN RETURN IF YES 64645000 + SR RB,RB ELSE CLEAR RB 64650000 + IC RB,MCPAROLN INSERT STRING LENGTH 64655000 + L RC,MCPAROPT POINT TO STRING 64660000 + B MXCNSYER AND FLAG ERROR 64665000 + SPACE 64670000 +MXCNIMMA EQU * 64675000 + LR RC,RB MOVE VALUE TO RC 64685000 + B MXCONV0A CONVERT IF NECESSARY 64690000 +MXCNIMMB EQU * 64695000 + LR RC,RB MOVE IMM VALUE TO RC 64705000 + B MXCONV0B CONVERT IF NECESSARY 64710000 +MXCNIMMC EQU * 64715000 + SRDL RB,24 MOVE @ TO RC, LEAVE LEN IN RB 64725000 + SRL RC,8 FINISH SHIFT IN RC 64730000 + B MXCONV0C CONVERT IF NECESSARY 64735000 +* A 64735100 +* PROCESS SYSNDX A 64735200 +MXCNSYSX EQU * GET SYSYNX VALUE 64740000 + TM AVMBYTE2,$MINCHAR CHAR REQ'D? 64745000 + BO MXCNSX01 PROCESS CHAR IF YES 64750000 + ZAP AVDWORK1,MXPSYSDX MOVE SYSNDX TO DOUBLE WORD 64755000 + CVB RC,AVDWORK1 CONVERT TO BINARY 64760000 + TM AVMBYTE2,$MINBOOL BOOL REQ'D? 64765000 + BNO MXCONRTN RETURN IF NOT 64770000 +MXCNSX03 EQU * 64775000 + LA RB,$ER#CVAB SET ARITH - BOOL ERROR 64780000 + B MXCONVAR A 64785000 + EJECT 64790000 +* A 64790100 +* CONVERT SYSNDX TO CHAR A 64790200 +* A 64790300 +MXCNSX01 EQU * 64795000 + L RE,MXPCHRBF GET POINTER TO WORK AREA 64800000 + LA RE,4(RE) BUMP TO TEST END 64805000 + C RE,AVMCHLIM TEST AGAINST LIMIT 64810000 + BNH MXCNSX02 PROCEED IF OKAY 64815000 + LA RB,$ER#EXBF SET ERROR FLAG 64820000 + B MXPNINJE GO FLAG ERROR AND CONTINUE 64825000 +MXCNSX02 EQU * 64830000 + LA RB,4 PUT USEFUL VALUE IN RB 64835000 + SR RE,RB RESTORE THE POINTER 64840000 + UNPK 0(4,RE),MXPSYSDX UNPACK &SYSNDX 64845000 + OI 3(RE),X'F0' CHANGE LAST ZONE TO F 64850000 + LR RC,RE POINT RC AT STRING 64855000 + AR RE,RB BUMP RE TO END OF BUFFER 64860000 + ST RE,MXPCHRBF RESOTRE BUFFER POINTER 64865000 + B MXCONRTN AND RETURN 64870000 + SPACE 64875000 +MXCNCSCT EQU * 64880000 + LA RC,AVSYSECT GET @ OF CSECT NAME 64885000 + TRT 0(9,RC),AWTSYMT SCAN NAME FOR LENGTH 64890000 + SR R1,RC GET LENGTH 64895000 + LR RB,R1 MOVE LENGTH TO RB 64900000 + TM AVMBYTE2,$MINCHAR CHAR REQ'D? 64905000 + BO MXCONRTN RETURN IF YES 64910000 + B MXCONCAR A 64915000 + SPACE 64930000 +MXCNTEMP EQU * 64935000 + USING MCOPQUAD,RB SET USING ON ONE-OP 64940000 + IC RA,MCRSLTYP GET INDEX 64945000 + L RB,MCRESULT GET LOCATION 64950000 + B MXCONJMP EVALUATE 64955000 + DROP RB 64960000 + EJECT 64965000 +MXCNATTK EQU * 64970000 +MXCNATTN EQU * 64975000 + LTR RB,RB &SYSLIST? 64985000 + BNL MXCNAT01 NO IF NOT LOW 64990000 + L RC,MXPNBOPS ELSE GET NBR OF OPRNDS 64995000 + B MXCONV0A AND CONVERT IF NECESSARY 65000000 +MXCNATTT EQU * 65005000 +MXCNAT01 EQU * 65015000 + TM AVMBYTE2,$MINBOOL BOOLEAN VALUE REQUIRED J 65020000 + BZ MXCNAT02 IF NOT OKAY 65025000 + LA RB,$ER#ATER ELSE SET ATTRIB USE ERR 65030000 + B MXPNINJE GO FLAG ERROR AND CONTINUE 65035000 +MXCNAT02 EQU * 65040000 + USING MCPAROPR,RE SET USING ON SYM PAR DICT ENTRY 65045000 + SR RC,RC 65050000 + LA RE,$LMPAROP GET LENGTH OF ENTRY 65055000 + MR RD,RB GET OFFSET 65060000 + A RE,MXPNLSPT ADD SYM PAR DICT BASE 65065000 + LA R1,$BSATN GET N' INDEX 65070000 + CR RA,R1 COMPARE WITH OPRND INDEX 65075000 + BH MXCNATTP T' IF HIGH 65080000 + BE MXCNATNP N' IF EQUAL 65085000 + IC RC,MCPAROLN K' IF FALL THRU 65090000 + B MXCONV0A RETRN 65095000 +MXCNATNP EQU * 65100000 + IC RC,MCPARONB GET N' 65105000 + B MXCONV0A JUMP TO CONVERT 65110000 +MXCNATTP EQU * 65115000 + LA RB,1 GET LENGTH OF TYPE 65120000 + LA RC,MCPAROTP GET POINTER TO TYPE 65125000 + B MXCONV0C CONVERT IF NECESSARY 65130000 + DROP RE 65135000 + SPACE 65140000 +MXCNADDA EQU * 65145000 + L RC,0(RB) GET ARITH VALUE 65155000 + B MXCONV0A CONVERT IF NECESSARY 65160000 +MXCNADDB EQU * 65165000 + L RC,0(RB) GET VALUE 65175000 + B MXCONV0B CONVERT IF NECESSARY 65180000 +MXCNADDC EQU * 65185000 + LA RC,4(RB) GET @ OF STRING 65195000 + L RB,0(RB) GET LENGTH OF STRING 65200000 + B MXCONV0C CONVERT IF NECESSARY 65205000 + SPACE 65210000 +MXCNUND EQU * 65215000 + LA RB,$ER#SYER SET SYSTEM ERROR FALG 65220000 + B MXPNINJE GO FLAG ERROR AND CONTINUE 65225000 + EJECT 65230000 +* A 65230100 +* CONVERT TO ARITH A 65230200 +* A 65230300 +MXCONV0A EQU * 65235000 + TM AVMBYTE2,$MINARIT ARITH REQ'D? 65240000 + BO MXCONRTN RETURN IF YES 65245000 + B MXCONVAR ELSE CONVERT 65250000 +* A 65250100 +* CONVERT TO BOOLEAN A 65250200 +* A 65250300 +MXCONV0B EQU * 65255000 + TM AVMBYTE2,$MINBOOL+$MINARIT ARITH OR BOOL REQ'D? 65260000 + BM MXCONRTN RETURN IF YES 65265000 + B MXCONVBL ELSE CONVERT 65270000 +* A 65270100 +* CONVERT TO CHAR A 65270200 +* A 65270300 +MXCONV0C EQU * 65275000 + TM AVMBYTE2,$MINCHAR CHAR REQ'D? 65280000 + BO MXCONRTN RETURN IF YES 65285000 + B MXCONVCH ELSE CONVERT 65290000 +MXCONVAR EQU * 65295000 + TM AVMBYTE2,$MINCHAR CHAR REQ'D? 65300000 + BO MXCONVAC CONVERT IF YES 65305000 + C RC,AWF1 BOOL VALUE? 65310000 + BE MXCONRTN RETURN IF YES 65315000 + LTR RC,RC ZERO VALUE? 65320000 + BE MXCONRTN OKAY IF YES 65325000 +MXCONVAB LA RB,$ER#CVAB ELSE SET ERROR FLAG A 65330000 + B MXPNINJE GO FLAG ERROR AND CONTINUE 65335000 +MXCONVAC EQU * 65340000 + LPR RC,RC GET POS VALUE 65345000 + CVD RC,AVDWORK1 CONVERT TO PACKED DEC 65350000 + LA RB,12 GET MAX LENGTH OF DEC NUMBER+1 65355000 + $MALLOCL RE,RB,OVRFL=MXEXECOV GET STORAGE FOR NBR 65360000 + MVC 0(12,RE),MXCEP12 MOVE EDIT MASK FOR MAX NBR 65365000 + LA R1,11(RE) POINT TO LAST CHAR 65370000 + LA RB,1(R1) GET @ OF DELIM IN RB 65375000 + EDMK 0(12,RE),AVDWORK1+2 EDIT DEC FIELD 65380000 + LR RC,R1 MOVE POINTER TO RC 65385000 + SR RB,R1 PUT LENGTHIN RB 65390000 + B MXCONRTN AND RETURN 65395000 + EJECT 65400000 +MXCONVBL EQU * 65405000 +* A 65405100 +* CONVERT BOOLEAN --> CHAR A 65405200 +* A 65405300 + LA RB,1 SET LEN TO 1 65410000 + LA RC,MXCONBLT(RC) GET @ OF '0' OR '1' AS APPROPRIATE 65415000 + B MXCONRTN AND RETURN 65420000 +MXCONBLT DC C'01' CONVERT BOOLEAN TO CHARACTER 65425000 + SPACE 65430000 +MXCONVCH EQU * 65435000 + TM AVMBYTE2,$MINBOOL BOOL REQ'D? 65440000 + BO MXCONVCB CONVERT IF YES 65445000 +* A 65445100 +* CONVERT CHAR --> ARITH A 65445200 +* A 65445300 +MXCONVCA EQU * CONVERT TO ARITH 65450000 + SR R2,R2 65455000 + SR R1,R1 65460000 + LTR RB,RB TEST LENGTH OF CHAR 65465000 + BNZ MXCONCA1 PROCEED IF NONZERO 65470000 +MXCONCAR EQU * PROCESS ZERO STRING 65475000 + LR RD,RB MOVE LENGTH TO RD 65480000 + LA RB,$ER#CVCA SET CONVERSION ERROR FLAG 65485000 + B MXPNINJE GO FLAG ERROR AND CONTINUE 65490000 +MXCONCA1 EQU * CONVERT TO ARITH 65495000 + TRT 0(1,RC),AWTDECT POSSIBLE SELF DEF TERM? 65500000 + BNZ MXCONCA4 CKECK FOR C,B OR X IF NOT 65505000 + C RB,AWF10 TEST LENGTH 65510000 + BH MXCONCAR ERROR IF > 10 65515000 + BL MXCONCA2 IF < 10, OKAY 65520000 + CLC 0(10,RC),=C'2147483647' ELSE COMPARE AGAINST LIMIT 65525000 + BH MXCONCAR ERROR IF HIGH 65530000 +MXCONCA2 EQU * 65535000 + BCTR RB,0 DECR LEN FOR TRT 65540000 + EX RB,MXPSCDEC SCAN FOR DEC NBRS 65545000 + BZ MXCONCA3 OKAY IF ALL DEC 65550000 + LA RB,1(RB) ELSE RESTORE RB 65555000 + B MXCONCAR AND FLAG ERROR 65560000 +MXCONCA3 EQU * 65565000 + EX RB,MXPMVDEC MOVE DEC STRING TO WORK AREA PACKED 65570000 + CVB RC,AVDWORK1 CONVERT TO BIN 65575000 + B MXCONRTN AND RETURN 65580000 +MXCONCA4 EQU * 65585000 + C R2,AWF4 B, C OR X? 65590000 + BNE MXCONCAR ERROR IF NOT 65595000 + LR R1,RB SAVE LENGTH 65600000 + LR RA,RC MOVE POINTER TO RA 65605000 + $CALL SDBCDX CHECK FOR SELF DEF AND CONVERT 65610000 + LTR RB,RB OKAY? 65615000 + BZ MXCONRTN RETURN IF OKAY 65620000 + LR RB,R1 RESTORE LENGTH TO RB 65625000 + LR RC,RA PUT POINTER IN RC 65630000 + B MXCONCAR AND FLAG ERROR 65635000 + SPACE 65640000 +MXPMVDEC PACK AVDWORK1,0($,RC) DUMMY TO PACK STRING 65645000 +MXPSCDEC TRT 0($,RC),AWTDECT DUMMY TO SCAN FOR DEC CHARS 65650000 + SPACE 10 S 65655000 +MXCONVCB EQU * CONVERT CHAR TO BOOL 65660000 + C RB,AWF1 LEN = 1? 65665000 + BE MXCONCB1 OKAY IF 1 65670000 +MXCONCBR EQU * ELSE IS ERROR 65675000 + LR RD,RB MOVE LEN TO RD 65680000 + LA RB,$ER#CVCB SET CHAR->BOOL ERROR 65685000 + B MXPNINJE GO FLAG ERROR AND CONTINUE 65690000 +MXCONCB1 EQU * 65695000 + CLI 0(RC),C'1' CHAR = 1? 65700000 + BNE MXCONCB2 PROCEED IF NOT 1 65705000 + LA RC,1 SET BOOL VALUE 65710000 + B MXCONRTN AND RETURN 65715000 +MXCONCB2 EQU * 65720000 + CLI 0(RC),C'0' DID CHAR = '0' (ZERO) J 65725000 + BNE MXCONCBR ERROR IF NOT 65730000 + SR RC,RC SET FALSE BOOL FALUE 65735000 +* A 65735300 +MXCONRTN EQU * 65740000 + XSNAP LABEL='***MXARITH EXITED***', X65745000 + IF=(AVMSNBY2,O,$MSNP12,TM) 65750000 + SR RA,RA ZERO RA FOR BYTE USE A 65750100 + L RET,MXSCCVSV RESTORE RETURN @ 65755000 + BR RET AND RETURN 65760000 +MXSCCVSV DS F SPACE FOR RETURN ADDRESS 65765000 +MXCEP12 DC X'402020202020202020202120' 12 BYTE DEC MASK 65770000 + LTORG 65775000 + TITLE ' MXINST-INTERNAL ROUTINES' A 65785000 +**--> INSUB: MXADDR THIS ROUTINE ACCEPTS A ONE-OP + + + + + + +S 65786000 +*+ OPRND AND RETURNS THE @ OF THE SYMBOL. OPRND MUST BE +S 65790000 +*+ A SET SYMBOL OR TEMP VALUE POINTING TO AN ADDRESS. +S 65795000 +*+ +S 65800000 +*+ ENTRY CONDITIONS: S 65805000 +*+ RA = INDEX OF OPRND +S 65810000 +*+ RB = @ OF OPRND +S 65815000 +*+ +S 65820000 +*+ EXIT CONDITIONS: +S 65825000 +*+ RC = @ OF VALUE +S 65830000 +*+ RD = DIMENSION OF SET SYMBOL +S 65835000 +*+ RE = TYPE OF SYMBOL (IE - $ARIT, $BOOL OR $CHAR) +S 65840000 +*+ +S 65845000 +*+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +S 65850000 + SPACE 65855000 +MXADDR DS 0F ENTRY PT FOR INTERNAL SUB 65860000 + XSNAP LABEL='***MXADDR ENTERED***', X65875000 + IF=(AVMSNBY2,O,$MSNP12,TM) 65880000 + USING MCGLBDCT,RB NOT USING ON SET SYMB DV 65885000 + SR RE,RE 65890000 + SR RD,RD 65895000 + LA R1,$BSYMPAR GET SYM PAR BSU VALUE 65900000 + CR RA,R1 COMPRE WITH OPNRD 65905000 + BNL MXADDR01 NOT SET SYM IF NOT LOW 65910000 + SRL R1,1 DIVIDE SYM PAR BSU BY 2 65915000 + CR RA,R1 COMPARE WITH OPRND 65920000 + BNL MXADDRLC SET SYM LOCAL IF NOT LOW 65925000 + LA RC,MCGBAVAL GET @ OF VALUE 65930000 + LH RD,MCGLBDIM GET DIMENSION 65935000 + IC RE,MCGLBTYP GET TYPE IN RE 65940000 + B MXADDRET JUMP TO FOOT 65945000 +MXADDRLC EQU * TREAT LOCAL SET SYMBOLS 65950000 + LH RD,MCGLBDIM GET DIMENSION 65955000 + IC RE,MCGLBTYP GET TYPE 65960000 + L RC,MGLCLPNT GET OFFSET 65965000 + A RC,MXPNLDBS ADD BASE @ OF SET SYM DICT 65970000 + B MXADDRET JUMP TO FOOT 65975000 +MXADDR01 EQU * 65980000 + USING MCOPQUAD,RB NOTE USING ON ONE-OP 65985000 + LA R1,$BSTEMP GET TEMP BSU 65990000 + CR R1,RA MUST BE $BSTEMP 65995000 + BNE MXADDRR1 ERROR IF NOT 66000000 + L RC,MCRESULT GET @ OF DESIRED VALUE 66005000 + CLI MCRSLTYP,$BSADDRA COMPARE WITH ARITH @ 66010000 + BL MXADDRR1 ERROR IF LOW 66015000 + BE MXADDR02 66020000 + CLI MCRSLTYP,$BSADDRC CHECKFOR CHAR @ 66025000 + BH MXADDRR1 ERROR IF HIGH 66030000 + BE MXADDR03 ARITH IF EQUAL 66035000 + LA RE,$BOOL FALL THRU MEANS BOOLEAN 66040000 + B MXADDRET JUMP TO FOOT 66045000 +MXADDR02 EQU * 66050000 + LA RE,$ARITH SET ARITH TYPE 66055000 + B MXADDRET JUMP TO FOOT 66060000 +MXADDR03 EQU * 66065000 + LA RE,$CHAR SET CHAR TYPE 66070000 + B MXADDRET JUMP TO FOOT 66075000 +MXADDRR1 EQU * 66080000 + LA RB,$ER#SYER SET SYSTEM ERROR 66085000 + B MXPNINJE GO FLAG ERROR AND CONTINUE 66090000 +MXADDRET EQU * 66095000 + XSNAP LABEL='*** MXADDR EXITED ***', #66100000 + IF=(AVMSNBY2,O,$MSNP12,TM) 66105000 + BR RET AND RETURN 66110000 + LTORG 66115000 + DROP RB,RZ,RAT S 66120000 + TITLE '***MXERRM GENERATES ERROR MSSGS IN MEXPND***' 66125000 +**--> CSECT: MXERRM CALLED DURING MACRO GENERATION TO GENERATE * 66130000 +*. ERROR MESSAGES NOT HANDLED BY ERRTAG * 66135000 +*. * 66140000 +*. ENTRY CONDITIONS * 66145000 +*. RA-SCAN PTR A 66145100 +*. RB = ERROR TYPE * 66150000 +*. RC = OPERAND VALUE OR LOCATION * 66155000 +*. RD = LENGTH OF STRING IF CHAR VALUE * 66160000 +*. RE-@ MXPNTSACV A 66160100 +*. * 66165000 +*. EXIT CONDITIONS A 66165100 +*. RB=0 ==> OK A 66165200 +*. RB=4 ==> STORAGE OVERFLOW CAUSED MESSAGE SELECTED IS PLACED A 66165300 +*. IN RSBLOCK, THEN MOVED OUT TO HIGH AREA BY MXMVSR A 66165400 +*. A 66165500 +*. USES MACROS: $CALL, $AL2, $SAVE, $RETURN * 66170000 +*. CALLS MXMVSR * 66175000 +*. USES DSECTS: RSBLOCK, MXPNTSAV, MCOPQUAD, AVWXTABL * 66180000 +*. * 66185000 +*.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 66190000 + SPACE 66195000 +MXERRM CSECT 66200000 + $SAVE RGS=(R14-R6),BR=R13,SA=* 66205000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 66210000 + XSNAP LABEL='***MXERRM ENTERED***',T=NO, X66215000 + IF=(AVMSNBY2,O,$MSNP13,TM) 66220000 + USING RSBLOCK,RW NOTE USING FOR SOURCE BLOCK 66225000 + L RW,AVRSBPT SET BASE FOR SOURCE 66230000 + USING MXPNTSAV,RE MACRO BLOCK A 66235000 + L RY,MXPNCRCD CURRENT INSTRUCTION A 66240000 + USING MCOPQUAD,RY NOTE USING S 66240100 + MVC RSBLOCK(RSB$L),=AL1(0,$RSBNPNN+$RSBMERR,1,0) S 66245000 + LA R1,MXMSSGS ADDRESS OF MESSAGES A 66250000 + AH R1,MXERRPTR(RB) @ SPECIFIC MSG A 66255000 + USING MSGBLOCK,R1 A 66260000 + SR R2,R2 CLEAR R2 A 66265000 + IC R2,MSGLENM1 GET LENGTH-1 OF MSG & NUMBER A 66270000 + EX R2,MXERRMVC MOVE IT IN A 66275000 +* 1ST PART (MSG) NOW DONE A 66280000 +* NOW FILL IN STM NUMBER, OTHER DATA A 66285000 +* R2 WILL BE ACCUMUALTION OF L-1 A 66290000 + LA RA,RSBSOURC+1(R2) @ NEXT BYTE A 66295000 + MVC 0(MXERRS$L,RA),MXERRSTN STMT NUMBER EDIT PATTERN A 66300000 + ED L'MXERRSTN(6,RA),MCQSTMNO A 66305000 + L RY,MXPNMCLB GET MACRO PTR A 66310000 + USING MACLIB,RY A 66315000 + MVC MXERRS$L(L'MCLBNAM,RA),MCLBNAM A 66320000 + LA RB,MXMSSGS(RB) ADD @ BEGINNING OF TABLE 66325000 + LA R2,MXERRS$L+L'MCLBNAM(R2) BUMP L-1 A 66330000 + DROP RE,RY A 66330050 + LA RA,RSBSOURC+1(R2) BUMP PTR FOR MSG OUTPUT A 66330100 +* MSGFLAG = 0 MSG # S 66330110 +* 4 NUMERICAL S 66330200 +* 8 CHAR VALUE S 66330300 +* S 66330400 + CLI MSGFLAG,X'04' COMPARE VALUE S 66335000 + BL MXERFOOT IF LOW, DONE. 66340000 + MVC 0(3,RA),=C'-->' MOVE POINTER TO RSBSOURC 66345000 + LA RA,3(RA) BUMP SCAN POINTER 66350000 + LA R2,3(R2) BUMP LEN-1 66355000 + BH MXERRM0C CHAR STRING IF HIGH 66360000 + SPACE 66365000 +MXERRM0A EQU * FALL THRU FOR ARITH TYPR 66370000 + LA R1,AVMWRK1+11 POINT TO END OF EDIT MASK 66375000 + LA RE,1(R1) POINT RE TO DELIMMPAST MASK 66380000 + CVD RC,AVDWORK1 CONVERT VALUE TO PACKED DEC 66385000 + MVC AVMWRK1(12),MXEEP12 MOVE EDIT MASK TO WORK AREA 66390000 + EDMK AVMWRK1(12),AVDWORK1+2 EDIT AND MARK VALUE 66395000 + SR RE,R1 GET LENGTH OF STRING 66400000 + BCTR R1,0 DECR POINTER TO SIGN POSIT 66405000 + EX RE,MXMVSTRN MOVE CHAR VALUE TO OUTPUT 66410000 + LTR RC,RC NEG VALUE? 66415000 + BNL MXERRMA1 SKIP IF NOT 66420000 + MVI 1(RA),C'-' ELSE INSERT MINUS SIGN 66425000 +MXERRMA1 EQU * 66430000 + LA R2,2(RE,R2) BUMP LENGTH 66435000 + B MXERFOOT JUMP TO FOOT 66440000 +MXERRM0C EQU * 66445000 + LR R1,RC MOVE @ OF STRING TO R1 66455000 + LA RE,RSOL1-2 A 66460000 + SR RE,R2 SUBTRACT CURRENT L-1 A 66465000 + CR RD,RE VALUE LEN OK? 66475000 + BNH MXERRMC1 PROCEED IF OKAY 66480000 + LR RD,RE ELSE SUB OKAY LENGTH 66485000 +MXERRMC1 EQU * 66490000 + LA R2,1(RD,R2) GET TOTAL L-1 A 66495000 + LTR RD,RD NULL STRING? 66500000 + BZ MXERFOOT FINI IF YES 66505000 + EX RD,MXMVSTRN MOVE STRING TO OUTPUP 66515000 +* FALL THRU INTO MXERFOOT. 66520000 +MXERFOOT EQU * 66525000 + STC R2,RSBLENG PUT LEN-1 IN OUTPUT 66530000 + $CALL MXMVSR MOVE STMT TO HIGH AREA 66535000 + SPACE 66565000 + XSNAP LABEL='***MXERRM EXITED***',T=NO, X66570000 + IF=(AVMSNBY2,O,$MSNP13,TM) 66575000 + SPACE 66580000 + $RETURN RGS=(R14-R6) 66585000 + SPACE 66590000 +MXERRMVC MVC RSBSOURC($),MSGNMBR A 66590100 +MXMVSTRN MVC 1($,RA),0(R1) DUMMY TO MOVE STRING 66595000 +MXEEP12 DC X'402020202020202020202120' 12 BYTE DEC MASK 66600000 +MXMSSGS EQU * 66605000 +MXACTRMS $MSG 221,' ACTR COUNTER EXCEEDED' A 66610000 +MXDMSNMS $MSG 222,' INVALID SYM PAR OR SET SYMBL SUBSCRIPT',FLAG=4 A 66615000 +MXSBSTMS $MSG 223,' SUBSTRING EXPRESSION OUT OF RANGE',FLAG=4 A 66620000 +MXCVCAMS $MSG 224,' INVALID CONVERSION, CHAR TO ARITH',FLAG=8 A 66625000 +MXCVABMS $MSG 225,' INVALID CONVERSION, ARITH TO BOOLEAN',FLAG=4 A 66630000 +MXCVCBMS $MSG 226,' INVALID CONVERSION, CHAR TO BOOLEAN',FLAG=8 A 66635000 +MXATTRMS $MSG 227,' ILLEGAL ATTRIBUTE LIST' A 66640000 +MXSYSLMS $MSG 228,' &&SYSLIST SUBSCRIPT OUT OF RANGE',FLAG=4 A 66645000 +MXSYERMS $MSG 229,' ASSIST CANNOT EXPAND--SIMPLIFY STMT OR USE .' CPP 66650000 +MXERBFM $MSG 230,' INTERNAL CHAR BUFFER EXCEEDED' A 66655000 +MXEXSTMS $MSG 231,' MSTMG LIMIT EXCEEDED' A 66660000 +MXZDIVMS $MSG 232,' ZERO DIVIDE OR FIXED POINT OVERFLOW' A 66665000 +MXPRVR $MSG 217,' STMT NOT PROCESSED: PREVIOUS ERROR' A 66665100 +MXERRSTN DC C': STMT/MACRO',X'402020202120',C'/' S 66670000 +MXERRS$L EQU *-MXERRSTN A 66670100 +MXERRPTR $AL2 MXMSSGS,(MXACTRMS,MXDMSNMS,MXSBSTMS,MXCVCAMS,MXCVABMS,MXX66670200 + CVCBMS,MXATTRMS,MXSYSLMS,MXSYERMS,MXERBFM,MXEXSTMS,MXZDIX66670400 + VMS,MXPRVR),-2 A 66670500 + LTORG 66675000 + DROP RAT,RW A 66680000 + TITLE '***MXMVSR - MOVES GENERATED STMT TO HIGH CORE***' 66685000 +**--> CSECT: MXMVSR MOVES GENERATED STMT FROM RSBLOCK TO HIGH FREE * 66690000 +*. AREA. AVGEN2CD POINTS TO BEGINNING OF STMT * 66695000 +*. * 66700000 +*. EXIT CONDITIONS * 66705000 +*. RB = ZERO IF OKAY ELSE 4 IF OVERFLOW * 66710000 +*. * 66715000 +*. USES MACROS: $SAVE, $RETURN, $MALLOCH * 66720000 +*. USES DSECTS RSBLOCK,REBLK,AVGEN1CD,AVGEN2CD A 66725000 +*. * 66730000 +*. REGISTER USAGES A 66730100 +*. RAT-MAIN TABLE USING A 66730200 +*. RW-SOURCE BLK USING A 66730300 +*. RX-ERROR BLK USING A 66730400 +*. R1,RB-BYTE REGISTERS A 66730500 +*. RA-WORK REGISTER A 66730600 +*. A 66730700 +*.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 66735000 + SPACE 66740000 +MXMVSR CSECT 66745000 + $SAVE RGS=(R14-R4),SA=NO A 66750000 + USING AVWXTABL,RAT NOTE MAIN TABLE USING 66755000 + XSNAP LABEL='***MXMVSR ENTERED***',T=NO, X66760000 + IF=(AVMSNBY2,O,$MSNP13,TM) 66765000 + USING RSBLOCK,RW NOTE SOURCE USING 66770000 + L RW,AVRSBPT SET BASE FOR RSBLOCK 66775000 + USING REBLK,RX SET USING FOR ERROR BLOCK 66780000 + LA RX,AVREBLK SET BASE FOR ERROR BLOCK 66785000 + SR R1,R1 66790000 + SR RB,RB 66795000 + TM RSBFLAG,$REBX EROOR BLOCK EXISTS? 66805000 + BZ MXMVSR01 JUMP AROUND IF NO 66810000 + IC RB,REBLN GET LEN-1 OF ERR BLOCK 66815000 + STC RB,RSBNUM PUT ERR BLOCK LEN IN RSB 66820000 +* REBLN IS ACTUAL LENGTH OF PART OF REBLK TO BE MOVED, 66825000 +* SINCE IT IS L-1 OF WHOLE THING (COUNTING REBLN) 66830000 +MXMVSR01 EQU * 66835000 + IC R1,RSBLENG GET LEN-1 OF STMT 66840000 + LA RB,RSB$L+1(RB,R1) GET TOTAL LENGTH FOR ENTIRE SECT 66845000 + $MALLOCH RA,RB,OVRFL=MXMVOVR GET STORAGE FOR STMT 66850000 + TM RSBFLAG,$REBX ERROR BLOCK? 66855000 + BZ MXMVSR02 SKIP IF NO 66860000 + IC RB,REBLN GET LEN-1 OF ERR BLOCK 66865000 + BCTR RB,0 GET LENGTH-1 OF PART TO BE MOVED 66870000 + LA RX,1(RX) BUMP REBLK PTR TO PART BEING MOVED 66875000 + EX RB,MXMVSRCE MOVE ERRBLOCK TO HIGH STORAGE 66880000 + LA RA,1(RA,RB) GET ACTUAL LENGTH MOVED 66885000 +MXMVSR02 EQU * 66890000 + LA RX,RSBSOURC PUT @ OF SOURCE IN RX FOR EX INST 66895000 + EX R1,MXMVSRCE MOVE STMT TO HIGH CORE 66900000 + AR RA,R1 BUMP PTR TO LAST CHAR A 66905000 + MVC 1(RSB$L,RA),RSBLOCK MOVE FLAG BYTE ETC A 66910000 + SR RB,RB CLEAR RB FOR RETURN 66915000 +MXMVRTN EQU * 66920000 + MVC RSBLOCK(RSB$L),AWZEROS ZERO STANDARD PART OF RSBLOCK 66925000 + MVC RSBSOURC($LMSRCMX),AWBLANK BLANK REMAINDER OF RECORD 66930000 + SPACE 66935000 + AIF (&$DEBUG).MACQQ09 SKIP IF NO DEBUG 66940000 + L R1,AVGEN2CD GET POINTER TO NEW STMT 66945000 + XSNAP LABEL='***MXMVSR EXITED***',STORAGE=(*0(R1),*128(R1)), X66950000 + IF=(AVMSNBY2,O,$MSNP13,TM) 66955000 +.MACQQ09 ANOP 66960000 + SPACE 66965000 + $RETURN RGS=(R14-R4),SA=NO A 66970000 + SPACE 66975000 +MXMVOVR EQU * 66980000 + LA RB,4 SET OVERFLOW FLAG 66985000 + B MXMVRTN RETURN 66990000 +MXMVSRCE MVC 0($,RA),0(RX) DUMMY TO MOVE STIRNG TO HIGH 66995000 + LTORG 67000000 + DROP RAT,RW,RX,REP 67005000 +.MAXXXX ANOP 67010000 + PRINT ON,NOGEN 80000010 + AIF (NOT &$EXINT).EINONE L 83002000 + TITLE '*** ECBRSTKD - DSECT FOR THE EXT'D INT BRANCH STACK' 83004000 +**--> DSECT: ECBRSTKD SINGLE ENTRY FOR THE BRANCH STACK . . . . . 83006000 +*. . 83008000 +*. THIS DSECT MIRRORS THE ECSTACKD DSECT BUT IS . 83010000 +*. USED BY THE EXTENDED INTERPRETER FOR THE . 83012000 +*. SUCCESSFUL-BRANCH STACK. . 83014000 +*. . 83016000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 83018000 + SPACE 2 83020000 +ECBRSTKD DSECT 83022000 +ECBSTENT DS 0CL16 BRANCH STACK ENTRY 83024000 +ECBSLINK DS F @ OF THE NEXT STACK ENTRY (LINK) 83026000 +ECBSIADD DS F BRANCH INSTRUCTION ADDRESS 83028000 +ECBSCCPM DS H CC AND PM 83030000 + SPACE 83032000 +ECBSINST DS 0CL6 UP TO 6 BYTES OF INSTRUCTION 83034000 +ECBSOP DS C OPCODE 83036000 +ECBSB2 DS C 2ND BYTE OF INSTRUCTION 83038000 +ECBSBD DS H 1ST OR ONLY BASE/DISPLACEMENT 83040000 +ECBSB2D2 DS H 2ND BASE/DISPLACEMENT 83042000 + TITLE '*** EXECUT- EXTENDED INTERPRETER SECTION' 83044000 +**--> CSECT: EXECUT EXTENDED INTERPRETER SECTION . . . . . . . . 83046000 +*. . 83048000 +*. EXTENDED INTERPRETER FOR ASSIST . 83050000 +*. . 83052000 +*.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 83054000 + SPACE 5 83056000 +****************** REGISTER USAGE IN EXECUT *********************** 83058000 +* * 83060000 +* REG # USAGE IN EXECUT * 83062000 +* ----- --------------- * 83064000 +* * 83066000 +* R0 GENERAL WORK REG * 83068000 +* R1 TEMPORARY BASE / GENERAL WORK REG * 83070000 +* R2 BYTE REG / TEMPORARY WORK REG * 83072000 +* R3 BASE REG FOR THE INSTRUCTION STACK * 83074000 +* R4 INSTRUCTION ADDRESS REGISTER & OPERAND * 83076000 +* ADDRESS REGISTER * 83078000 +* R5 CONDITION CODE REG * 83080000 +* R6 BASE REGISTER FOR DSECT -> ECONTROL * 83082000 +* R7-R9 DECODING AND GENERAL WORK REGS * 83084000 +* R10 DECODING REG & OPERAND ADDRESS REGISTER * 83086000 +* R11 CONTAINS RELOCATION VALUE (RARELY USED AS * 83088000 +* A WORK REG - BUT ALWAYS RESTORED) * 83090000 +* R12 & R13 BASE REGISTERS FOR EXECUT * 83092000 +* R14 WORK REG / INTERNAL LINKAGE REG * 83094000 +* R15 CONTAINS OPCODE OF CURRENT INSTRUCTION * 83096000 +* * 83098000 +*********************************************************************** 83100000 +EXECUT CSECT 83102000 +RWK0 EQU R0 83104000 +RWK1 EQU R1 83106000 +RSTK EQU R3 83108000 +RIA EQU R4 83110000 +RAD1 EQU RIA 83112000 +RAD2 EQU R10 83114000 +RCC EQU R5 83116000 +REC EQU R6 83118000 +RMEM EQU R11 83120000 +RLINK EQU R14 83122000 +RWK14 EQU R14 83124000 +ROP EQU R15 83126000 + TITLE '*** EXECUT - INITIALIZATION PHASE' 83128000 +*********************************************************************** 83130000 +* * 83132000 +* INITIALIZATION CODE FOR EXECUT * 83134000 +* * 83136000 +*********************************************************************** 83138000 + SPACE 5 83140000 + $SAVE RGS=(R14-R12),BR=(R13,R12),SA=EIECSAVE 83142000 + LR REC,R10 MOVE ECONTROL POINTER OVER 83144000 + USING ECONTROL,REC NOTE ECONTROL USAGE 83146000 + SPACE 2 83148000 +* INSTRUCTION STACK ZEROING AND CHAINING 83150000 + SR R1,R1 CLEAR FOR ZEROING 83152000 + SR R2,R2 DITTO 83154000 + SR R3,R3 DITTO 83156000 + LA R4,L'ECSTENT VAL OF SINGLE STACK ENTRY 83158000 + LA R5,ECINSTAC+L'ECINSTAC*(EC$STACK-1) GET ENDING LIMIT 83160000 + LA R7,ECINSTAC GET BEGINNING @ OF STACK AREA 83162000 + USING ECSTACKD,R7 SET UP TEMPORARY USING 83164000 + LA R0,ECINSTAC+L'ECINSTAC GET @ OF THE 2ND ELEMENT 83166000 +EINITIST EQU * 83168000 + STM R0,R3,ECSTENT ZERO ONE TABLE ENTRY 83170000 + LR R7,R0 UPDATE POINTER TO STACK ENTRY 83172000 + BXLE R0,R4,EINITIST CONTINUE LOOPING 83174000 + SPACE 83176000 + LA R0,ECINSTAC ADDRESS FOR WRAP-AROUND 83178000 + STM R0,R3,ECSTENT STORE IN LAST ENTRY 83180000 + ST R7,ECRSTK SAVE WHERE CAN BE PICKED UP 83182000 + DROP R7 DROP TEMP REG 83184000 + SPACE 2 83186000 +* BRANCH STACK ZEROING AND CHAINING 83188000 + LA R4,L'ECBSTENT VAL OF SINGLE BRANCH STACK ENTRY 83190000 + LA R5,ECBRSTAC+L'ECBRSTAC*(EC$BRSTC-1) GET ENDING LIMIT 83192000 + LA R7,ECBRSTAC GET BEGINNING @ OF STACK AREA 83194000 + USING ECBRSTKD,R7 SET UP TEMPORARY USING 83196000 + LA R0,ECBRSTAC+L'ECBSTENT GET @ OF 2ND ELEMENT 83198000 +EINITBST EQU * 83200000 + STM R0,R3,ECBSTENT ZERO ONE TABLE ENTRY 83202000 + LR R7,R0 UPDATE POINTER TO STACK ENTRY 83204000 + BXLE R0,R4,EINITBST CONTINUE LOOPING 83206000 + SPACE 83208000 + LA R0,ECBRSTAC ADDRESS FOR WRAP-AROUND 83210000 + STM R0,R3,ECBSTENT STORE IN LAST ENTRY 83212000 + ST R7,ECBSTK SAVE WHERE CAN BE PICKED UP 83214000 + ST R7,ECBCUR SAVE FOR EIFINB LIST MANIPULATION 83216000 + DROP R7 DROP TEMP REG 83218000 + SPACE 2 83220000 +* MORE INITIALIZATION 83222000 + MVC ECILCMSK(4),ECFENTER MAKE ENTRY POINT THE PSW 83224000 + MVC ECR14SAV,ECREG14 SAVE FOR ORIGINAL RETURN @ 83226000 + MVC ECILIMT,ECILIMP MOVE PERMENANT TO TEMPORARY L 83228000 + SPACE 2 83230000 +* ADDRESS CALCULATION SECTION 83232000 +* THE BELOW FAKE HIGH ADDRESS CALCULATION IS A DUPLICATION 83232100 +* OF THE ADDRESS CALCULATIONS DONE IN ASSIST MAIN CONTROL 83232200 +* REMOVING THIS CODE HOWEVER CAUSES THE HIGH ADDRESS TO 83232300 +* TO END UP VERY WRONG WHEN IT GETS TO THE INTERPRETER 83232400 +EICONTIN EQU * 83234000 + L R0,ECRADH GET REAL HIGH ADDRESS LIMIT 83236000 + S R0,ECRADL GET LENGTH OF USER PROGRAM 83238000 + A R0,ECFADL ADD TO FAKE LOW ADDRESS 83240000 + ST R0,ECFADH STORE IN FAKE HIGHEST ADDR 83242000 + SPACE 2 83244000 +* SET UP SPIE CODE 83252000 +EISPIEGO EQU * 83254000 + TM ECFLAG0,$ECSPIEA IS OUR SPIE ALREADY IN EFFECT 83256000 + BO EISPIEA YES, WE DON'T HAVE TO RE-SPIE 83258000 + $SPIE EISPIERT,((1,15)),CE=EISPIEXT,ACTION=CR CATCH ALL INTRP 83260000 + ST R1,ECPICA SAVE PREVIOUS PICA, IF ANY 83262000 + OI ECFLAG0,$ECSPIEA SHOW OUR SPIE IS IN CONTROL 83264000 + SPACE 2 83266000 +EISPIEA EQU * 83278000 +* INITIALIZE THE PRCB FOR THIS RUN 83280000 +* (ALL DEFAULT ADDRESSES, FLAGS, ETC SET) 83282000 + MVC ECPRFLG1(8),EIDFAULT MOVE DEFAULT VALS TO PRCB 83284000 + MVC ECPRWORK(4),ECFADL SET UP HIGH AND LOW DEFAULT M 83286000 + MVC ECPRWORK+4(4),ECFADH ADDRESSES IN WORK AREA M 83288000 + MVC ECPRTRAL(8),ECPRWORK SET TRACE LIMIT ADDRS M 83290000 + MVC ECPRMODL(8),ECPRWORK SET MOD CHK LIMIT ADDRS M 83292000 + MVC ECPRICL(8),ECPRWORK SET IECF LIMIT ADDRESSES M 83294000 + MVC ECPRCLOK(4),ECILIMP SET INSTR COUNTER (CLOCK) 83296000 + MVC ECPRCMPR(4),=F'-1' DISARM INTERRUPT CLOCK 83298000 + MVI EITSTMSK+1,ECEM370 ITIALIZE INVALID OP CODE TEST 83300000 + SPACE 2 83302000 +* SET UP USINGS, REGS, ETC. FOR THIS RUN 83304000 + L RSTK,ECRSTK GET PTR TO STACK FOR BASE 83306000 + USING ECSTACKD,RSTK SET UP PERMANENT USING 83308000 + L RMEM,ECRELOC GET RELOCATION VAL IN REG 83310000 + SR R2,R2 CLEAR BYTE REG 83312000 + STH R2,ECINTCOD SET THE INTERRUPT CODE TO 0 83314000 + SR ROP,ROP CLEAR OPCODE REG FOR CONSTANT IC'S 83316000 + L RIA,ECILCMSK LOAD INSTR @ REG FOR EIFINB 83318000 + LR RCC,RIA PLACE CC AND MASK OVER 83320000 + SPM RCC INIT REAL CC = FAKE CC 83322000 + AIF (NOT &$FLOTE).EINOFL1 SKIP IF NOT DOING FL 83324000 + LD F0,ECFPREGS GET FP REG 83326000 + LD F2,ECFPREGS+8 GET FP REG 83328000 + LD F4,ECFPREGS+16 GET FP REG 83330000 + LD F6,ECFPREGS+24 GET FP REG 83332000 +.EINOFL1 ANOP 83334000 + B EIFINB BEGIN MAIN LOOP INTERPRETATION 83336000 + SPACE 5 83338000 +* DEFAULT PRCB FLAGS 83340000 +EIDFAULT DC AL1(0) ECPRFLG1 DEFAULT 83342000 + DC AL1(ECEM370+ECALNCHK) ECPRFLG2 DEFAULT 83344000 + DC XL6'0' ECPRFLG3-ECPRFLG8 DEFAULT 83346000 + EJECT 83348000 +* * * * * * * * * * * OCX INTERRUPT EXITS * * * * * * * * * * * * * 83350000 +*********************************************************************** 83352000 + SPACE 2 83354000 +EIOC1 EQU * 83356000 + LA R0,1 SHOW OPERATION INTERRUPT 83358000 + B EIEXITI EXIT POINT FOR INTERRUPTS 83360000 +EIOC2 EQU * 83362000 + LA R0,2 SHOW PRIVILEGED OPERATION 83364000 + B EIEXITI EXIT POINT FOR INTERRUPTS 83366000 +EIOC3 EQU * 83368000 + LA R0,3 EXECUTE INTERRUPT 83370000 + B EIEXITI EXIT POINT FOR INTERRUPTS 83372000 +EIOC4 EQU * 83374000 + LA R0,4 PROTECTION INTERRUPT 83378000 + B EIEXITI EXIT POINT FOR INTERRUPTS 83380000 +*EIOC5 EQU * 83382000 +* LA R0,5 ADDRESSING INTERRUPT 83384000 +* B EIEXITI EXIT POINT FOR INTERRUPTS 83386000 +EIOC6A EQU * NO NEED FOR SEPARATE CASES CEH 83388000 +EIOC6 EQU * 83390000 + LA R0,6 SPECIFICATION INTERRUPT 83392000 + B EIEXITI EXIT POINT FOR INTERRUPTS 83394000 +*EIOC7 EQU * 83396000 +* LA R0,7 DATA EXCEPTION 83398000 +* B EIEXITI EXIT POINT FOR INTERRUPTS 83400000 +EIOCA EQU * 83402000 + LA R0,10 DECIMAL OVERFLOW 83404000 + B EIEXITI EXIT POINT FOR INTERRUPTS 83406000 + SPACE 5 83408000 +* ENTERED WHEN PROGRAM BRANCHES OUT OF RANGE 83410000 +EIIAOUT EQU * 83412000 + MVI ECFLAG1,$ECBRN14 HOPE FOR NORMAL RETURN 83414000 + L R14,ECR14SAV GET RETURN @, ORIGINAL 83416000 + LA R14,0(R14) REMOVE LEADING BYTE 83418000 + CR RIA,R14 WAS BRANCH TO THIS ADDR ? 83420000 + BE EIITAILC YES, PERFORM A NORMAL RETURN M 83422000 + MVI ECFLAG1,$ECBROUT WAS ACTUAL BRANCH OUT OF PROG 83424000 + LA R1,EICCBROU SHOW @ BRANCHED OUT 83426000 + NI ECPRFLG3,ECNOSPI MAKE SURE SPIE IS OFF FOR SAFETY 83427000 + B EIITIA GO, HAVE @ STORED, QUIT M 83428000 + EJECT 83430000 +*********************************************************************** 83432000 +* * 83434000 +* INTERRUPT HANDLER * 83436000 +* * 83438000 +*********************************************************************** 83440000 + SPACE 2 83442000 +EISPIEXT EQU * 83444000 + USING *,R15 83446000 + MVC ECINTCOD(2),2(R1) SAVE INTERRUPT CODE 83448000 + BR R14 RETURN TO OS CONTROL 83450000 + DROP R15 DROP TEMP REG 83452000 + SPACE 83454000 + SPACE 5 83456000 +*********************************************************************** 83458000 +* EXIT AND RETURN CODE * 83460000 +*********************************************************************** 83462000 + SPACE 2 83464000 +EIEXITI EQU * 83466000 + STH R0,ECINTCOD SAVE INTO INTERRUPT CODE 83468000 +EISPIERT EQU * 83470000 + MVI ECFLAG1,0 RESET, NEEDED BY REPLACE MONITOR 83472000 + LH R1,ECINTCOD NOTE:NEED THIS WHEN ENTERED AT EISPIERT L 83474000 + ALR R1,R1 DOUBLE FOR HALFWORD INDEX L 83476000 + LH R1,EICOFFS(R1) GET OFFSET TO MESSAGE BLOCK 83478000 + LA R1,EICC0(R1) GET @ OF MESSAGE 83480000 +EIITIA EQU * 83482000 + ST R1,ECERRAD STORE @ IN ECONTROL 83484000 + MVC ECBSTK(4),ECBCUR SAVE THE CURRENT BR STK PNTR 83485000 + ST RSTK,ECRSTK SAVE THE STACK POINTER 83486000 + N RCC,=XL4'3F000000' REMOVE @ & ILC (WHICH IS WRONG) 83488000 + L RIA,EIRIA RELOAD ADDR. OF NEXT INSTR. CEH 83489000 + ALR RCC,RIA PUT THE @ AND CC TOGETHER 83490000 + IC RIA,EICTB2 GET ILC FROM LAST INST L 83492000 + SLL RIA,29 SHIFT ILC TO EXTREME LEFT L 83494000 + OR RCC,RIA COMPLETE PSW IN RCC L 83496000 + ST RCC,ECILCMSK SAVE INTO THE PSW 83498000 + SPACE 5 83500000 +* THIS SECTION TESTS FOR AN XOPC SPIE BEING SET 83502000 +* IF AN INTERRUPT OCCURS AND AN XOPC SPIE HAS NOT BEEN 83504000 +* SET ABNORMAL USER TERMINATION IS PERFORMED. IF A SPIE 83506000 +* HAS BEEN SET AND THE INTERPRETER IS NOT ALREADY CATCH- 83508000 +* ING AN INTERRUPT, THE SPIE EXIT ADDRESS BECOMES THE 83510000 +* ADDRESS OF THE NEXT INSTRUCTION AND EXECUTION CONTINUES 83512000 +EITSTST EQU * 83516000 + TM ECPRFLG3,ECINHDST TEST IF ALREADY HANDLING AN INTERUPT 83518000 + BO EIITAILC IF SO, GO AHEAD AND TERMINATE 83520000 + TM ECPRFLG3,ECSPISET TEST IF CATCHING INTERRUPTS 83522000 + BNO EIITAILC IF NO SPIE SET, TERMINATE 83524000 + LH R1,ECINTCOD GET THE INTERRUPT CODE IN A REGISTER 83526000 + LA R1,16(R1) SHIFT 16 MORE THAN INTRPT CODE 83527000 + STC R1,EISPISFT+3 STORE INTERRUPT CODE IN SHIFT INSTR 83528000 + L R1,ECPRSCDE GET THE INT CODES TO BE CAUGHT 83530000 +EISPISFT SLL R1,$ SHIFT TO SEE IF THIS INT CAUGHT 83532000 + LTR R1,R1 COMPARE SHIFTED REGISTER TO ITSELF 83534000 + BNM EIITAILC IF RESULT NOT MINUS DO NOT CATCH 83536000 + MVC ECPRIRGS(8),ECREG0 SAVE USER REGS 0 AND 1 83538000 + MVC ECREG0(8),ECPSW SAVE PSW IN USER REGS 0 AND 1 83540000 + L RIA,ECPRSPIE PUT SPIE EXIT ADDR FOR BRANCH 83542000 + OI ECPRFLG3,B'01000000' NOW IN INTERRUPT HANDLING STATE 83544000 + B EIFINB TREAT AS HAVING EXECUTED BRANCH INST 83546000 +EIITAILC EQU * 83548000 + AIF (NOT &$FLOTE).EINOFL3 SKIP IF NO FLOATINGS 83550000 + STD F0,ECFPREGS STORE FP REGS 83552000 + STD F2,ECFPREGS+8 STORE FP REGS 83554000 + STD F4,ECFPREGS+16 STORE FP REGS 83556000 + STD F6,ECFPREGS+24 STORE FP REGS 83558000 +.EINOFL3 ANOP 83560000 + TM ECFLAG0,$ECSPIEB DO WE NEED TO UNDO SPIE 83562000 + BZ EIECRET NO, RETURN 83564000 + L R1,ECPICA GET PICA ADDR BACK 83566000 + $SPIE ACTION=(RS,(1)) RESTORE PREVIOUS XSPIEBLK 83568000 + NI ECFLAG0,255-$ECSPIEA WE WILL HAVE TO RESPIE 83570000 +EIECRET EQU * 83572000 + $RETURN RGS=(R14-R12) 83574000 + TITLE '*** EXECUT - MAIN INSTRUCTION FETCH AND DECODING LOOP' 83576000 +*********************************************************************** 83578000 +* * 83580000 +* MAIN INTERPRETER LOOP HEAD * 83582000 +* * 83584000 +* ALL SUCCESSFUL BRANCHES PASS THROUGH EIFINB, WHERE * 83586000 +* CHECKING FOR ILLEGAL BRANCHES IS DONE. CHECKING IS * 83588000 +* ALSO DONE FOR TIMER RUNOUT. * 83590000 +* * 83592000 +* OTHER INSTRUCTIONS (UNSUCCESSFUL BRANCHES INCLUDED) * 83594000 +* PASS THROUGH EIFIN OR EIFINRR AS APPROPRIATE. * 83596000 +* * 83598000 +*********************************************************************** 83600000 + SPACE 4 83602000 +EIFINB EQU * 83604000 +* MOVE INSTRUCTION TO BRANCH STACK 83606000 + L R1,ECBCUR GET POINTER TO PRES STK SLOT 83608000 + USING ECBRSTKD,R1 SET UP TEMPORARY USING 83610000 + L R1,ECBSLINK GET POINTER TO NEXT AVAILABLE SLOT 83611000 + MVC ECBSTENT+4(L'ECBSTENT-4),ECSTENT+4 MOVE ENTRY OVER 83612000 + ST R1,ECBCUR SAVE ADDRESS OF THIS SLOT FOR LATER 83614000 + DROP R1 DROP TEMP REG 83616000 + SPACE 83618000 +* CHECK IF BRANCH IS LEGAL 83620000 + LA RIA,0(RIA) REMOVE 1ST BYTE OF BRANCH @ 83622000 + ST RIA,EIRIA SAVE CURRENT INSTR. ADDR. CEH 83623000 + C RIA,ECFADL CMPR FOR BELOW LOWEST FAKE 83624000 + BL EIIAOUT BRANCH IF OUT OF RANGE - ERROR 83626000 + C RIA,ECFADH CMPR FOR OVER HIGHEST FAKE 83628000 + BNL EIIAOUT BRANCH IF OUT OF RANGE - ERROR 83630000 + AIF (NOT &$ALIGN).EIFT1 SKIP IF MACHINE REQUIRES ALIGNMENT 83632000 + ST RIA,ECTSAVE SAVE @: MUST DO CHECK SLOW WAY 83634000 + TM ECTSAVE+3,EIALHALF DO WE HAVE HALFWORD ALIGN ? 83636000 + BO EIOC6 NO - SPEC. ERROR 83638000 + AGO .EIFT2 SKIP OTHER ALIGN CODE 83640000 +.EIFT1 ANOP 83642000 + LH R0,0(RIA,RMEM) QUICK ALIGN CHECK 83644000 +.EIFT2 ANOP 83646000 + SPACE 83648000 +* IF TIMER RUNOUT OCCURS, ASSIST SETS ECFLAG1=$ECTIMEX. 83650000 +* EXECUT DISCOVERS THIS NEXT TIME BRANCH IS SUCCESSFUL. 83652000 + AIF (&$TIMER EQ 0).EINOTOA SKIP IF NO TIMER AT ALL 83654000 + CLI ECFLAG1,$ECTIMEX IS TIMER RUNOUT FLAG SET ? 83656000 + BNE EIFINRR NO - FETCH AND PROCESS INSTR AT NEW X83658000 + BRANCH ADDRESS 83660000 +* TIMER RUNOUT HAS OCCURRED - FLAG IT. ECFLAG1 83662000 +* ALREADY SET. 83664000 + LA R1,EICCTIMB SHOW @ OF OVER TIME MESSAGE 83666000 + B EIITIA JUMP TO EXIT SECTION M 83668000 + AGO .EINOTOB 83670000 +.EINOTOA ANOP 83672000 + B EIFINRR BRANCH TO FETCH AND PROCESS INSTR 83674000 +.EINOTOB ANOP 83676000 + SPACE 4 83678000 +*********************************************************************** 83680000 +* * 83682000 +* HERE BEGINS THE PRIMARY INSTR FETCH AND * 83684000 +* DECODING SECTION. * 83686000 +* * 83688000 +*********************************************************************** 83690000 + SPACE 3 83692000 +* CHECK FOR EXCEEDING TOTAL INSTRUCTION COUNT -- 83694000 +* 83696000 +* CONTROL IS PASSED TO EIFIN AFTER INTERPRETATION OF 83698000 +* ALL INSTRUCTIONS EXCEPT SUCCESSFUL BRANCHES AND RR 83700000 +* INSTRUCTIONS. CONTROL IS PASSED TO EIFINRR AFTER 83702000 +* RR'S, AND TO EIFINB AFTER SUCCESSFUL BRANCHES. 83704000 +EIFIN EQU * 83706000 + L RIA,EIRIA RESTORE INSTR @ REG 83708000 +EIFINRR EQU EIFIN RR NOW MERGES WITH OTHER CEH 83710000 + L R0,ECILIMT GET INSTRUCTION COUNTER 83712000 +* BCT R0,EIGO DECREMENT COUNTER 83714000 +* COUNTER LIMIT EXCEEDED -- BR TO INTERRUPT ROUTINE 83716000 +EICNTINT EQU * 83718000 + ST R0,ECILIMT RESTORE INSTR LIMIT FOR STATS 83720000 + MVI ECFLAG1,$ECTIMEX SHOW INSTR LIMIT EXCEEDED 83722000 + LA R1,EICCTIME GET @ OF TIME MESSAGE 83724000 + NI ECPRFLG3,ECNOSPI MAKE SURE SPIE IS OFF FOR SAFETY 83725000 + B EIITIA BR TO EXIT ROUTINE M 83726000 +EIGO EQU * 83728000 + C R0,ECPRCMPR CMPR CLOCK AGAINST USER LIMIT 83730000 + BNE EICLKOK CONTINUE ON IF NO COUNT LIMIT EXCEED 83732000 + TM ECPRFLG4,ECLKADR TEST TO SEE IF CLOCK EXIT ADDR GIVEN 83732100 + BNO EICNTINT IF NO ADDR GIVEN - DO TIMER EXIT 83732200 + L RIA,ECPRCLEA PREPARE BRANCH TO GIVEN EXIT ADDR 83732300 + MVC ECPRCMPR(4),=F'-1' DISARM THE CLOCK FROM FURTHER INTRPS 83732400 + B EIFINB TREAT AS BR INST SINCE CAUSE OF INTR 83732500 +EICLKOK EQU * NO CLOCK INTERRUPT HAS OCCURED 83732600 + ST R0,ECILIMT RESTORE COUNTER 83734000 + SPACE 2 83736000 +* PRIMARY INSTRUCTION FETCH 83738000 + LA RWK14,0(RIA,RMEM) OBTAIN PHYSICAL REAL ADDRESS 83740000 + L RSTK,ECSTLINK OBTAIN ADDRESS OF NEXT STACK SLOT 83742000 + STM RIA,RCC,ECSTIADD SAVE INSTRUCTION ADDRESS, CC, MASK 83744000 + MVC ECSTINST,0(RWK14) MOVE 6 BYTES INTO THE NEXT SLOT 83746000 + IC ROP,ECOP GET OPCODE INTO A REGISTER 83748000 + SPACE 2 83750000 +* FETCH MAIN TABLE ENTRY BY OPCODE INDEXING 83752000 +EIEXPEN EQU * 83754000 + SR R1,R1 R1 IS ZERO FOR IC 83756000 + IC R1,EIOPCDTB(ROP) FETCH POINTER TO MAIN TABLE 83758000 + SLL R1,3 MULTIPLY BY 8 FOR MAIN TAB INDEX 83760000 + LA R1,EICONTAB(R1) GET @ OF CONTROL TABLE ENTRY 83762000 + MVC EICTNTRY(EICTE$L),0(R1) MOVE TABLE ENTRY TO WORK AREA 83764000 + TM EICTB1,EIEXOPCD DOES OPCODE TELL ALL ? 83766000 + BZ EICHKF$A IF YES, BR TO CHK FACILITIES ON 83768000 + SPACE 2 83770000 +* OPCODE DOES NOT TELL ALL - - - GET TABLE ENTRY 83772000 +* FOR EXTENDED OPCODE INSTRUCTION 83774000 + L R1,EIEXTTAB GET ADDRESS OF TOP SEC TABLE 83776000 + MVC EISHFTIN+3(1),EI#SHIFT(R1) PUT SHIFT # INTO INST. L 83778000 + IC R2,ECOPEX GET OPCODE EXTENSION BYTE 83780000 +* THE FOLLOWING SHIFT INSTRUCTION WILL BE MODIFIED DURING 83782000 +* EXECUTION TO SHIFT THE CORRECT AMOUNT FOR EACH 83784000 +* DIFFERENT EXTENDED OPCODE. 83786000 +EISHFTIN SRL R2,$ SHIFT FOR INDEX INTO BYTE TABLE 83788000 + C R2,EIMAXIND(R1) CMPR SHFT VALUE TO MAX 83790000 + BH EIOC1 BR IF OPCODE IS BAD 83792000 + IC R2,EICTE$L(R2,R1) GET BYTE TABLE ENTRY 83794000 + LTR R2,R2 TEST FOR LEGAL EXTENDED OP CODE 83796000 + BZ EIOC1 BRANCH IF INVALID OPCODE 83798000 + LA R1,0(R2,R1) GET ADDRESS OF TABLE ENTRY 83800000 + MVC EICTNTRY(EICTE$L),0(R1) FETCH EXTENDED OPCD TAB ENTRY 83802000 + SPACE 2 83804000 +* CHECK FOR INSTRUCTION TRACE AND IECF 83806000 +EICHKF$A EQU * 83808000 + TM ECPRFLG1,ECPROPON CHECK IF ANY OPTIONS = ON 83810000 + BNZ EITRIC BRANCH IF TRACE OR IECF ON 83812000 + SPACE 2 83814000 +* INCREMENT INSTRUCTION ADDRESS REGISTER 83816000 +* 83818000 +* ** NOTE ** DO NOT CHANGE THE ORDER OF THE NEXT FEW 83820000 +* INSTRUCTIONS WITHOUT FIRST SEEING AND MODIFYING THE 83822000 +* EX INSTR CODE (EIEX) 83824000 +EIINCPSW EQU * 83826000 + SR R2,R2 ZERO FOR IC INST L 83828000 + IC R2,EICTB2 GET THE LENGTH OF THE INSTRUCTION 83830000 + AR RIA,R2 INCREMENT INSTRUCTION ADDRESS REG 83832000 + SPACE 2 83834000 +* CHECK IF OPCODE IS LEGAL ON THE MACHINE 83836000 +* PRESENTLY BEING EMULATED 83838000 +* NOTE: THE MASK FOR THE FOLLOWING TM INSTRUCTION WAS 83840000 +* INSERTED EARLIER, EITHER AT INITIALIZATION (AS 370) 83842000 +* OR WHEN EVER AN XOPC INSTRUCTION IS EXECUTED WHICH COULD 83844000 +* CHANGE THE MACHINE EMULATION FLAGS IN THE PRCB 83846000 +EITSTMSK TM EICTB1,$ TEST TAB ENTRY FOR VALID OP CODE 83848000 + ST RIA,EIRIA SAVE FOR RESTORING LATER CEH 83849000 + BZ EIOC1 BRANCH TO INTER ROUTINE IF INVALID 83850000 + SPACE 2 83852000 +* CHECK IF THIS IS A PRIVILEGED INSTRUCTION 83854000 +EIOPOK EQU * 83856000 + TM EICTB1,EIPRIVOP IS THIS A PRIV INSTR ? 83858000 + BO EICHKST IF YES, BRANCH TO CHECK STATE 83860000 + SPACE 2 83862000 +* THE FOLLOWING SECTION DECODES THE SECOND BYTE OF THE 83864000 +* INSTRUCTION AND PERFORMS A MULTI-WAY BRANCH TO GET 83866000 +* THE NEEDED INFORMATION IN THE PROPER PLACES 83868000 +* EXPECTED LATER IN THE SPECIAL ROUTINES. 83870000 +EI2BDECD EQU * 83872000 + CLI ECOP,X'E1' CHECK FOR ONLY REGISTER XDUMP 83874000 + BE EIXIOSR SKIP EXTRANEOUS DECODEING FOR XDUMPR 83876000 + SR R7,R7 CLEAR BYTE REGISTER 83878000 + IC R7,ECI2 GET 2ND BYTE OF INSTR 83880000 + TM EICTB3,EIB2IORL TEST TO DETERMINE DECODING NEEDED 83882000 + BZ EIRRX4 2 REGS - MULT BY 4 FOR INDEX 83884000 + BO EI2BMERG IF IMMED OR LENGTH, DONE 83886000 + SPACE 2 83888000 +* PROCESS 2ND BYTE AS LL X 1 83890000 + LR R9,R7 COPY 2ND BYTE OF INSTR 83892000 + SRL R7,4 R7 = L1 83894000 + N R9,=XL4'0F' R9 = L2 83896000 + B EI2BMERG BRANCH TO MERGE BACK 83898000 + SPACE 2 83900000 +* PROCESS 2ND BYTE AS RR X 4 83902000 +* (EVEN/ODD REGISTER CHECKING DONE ALSO) 83904000 +EIRRX4 EQU * 83906000 + SPACE 2 83908000 +* THIS SECTION TESTS FOR EVEN ODD REGISTERS WHEN 83910000 +* THEY ARE NEEDED IN AN INSTRUCTION. 83912000 + MVC *+7(1),EICTB5 MOVE TABLE BYTE 5 INTO TM INST 83914000 + TM ECR1R2,$ TEST EVEN/ODD REG ** MASK MOVED IN** 83916000 + BNZ EIOC6 IF RESULT NOT ZERO SOC 6 INT 83918000 +EIRRX4A EQU * 83920000 + LR R9,R7 COPY 2ND BYTE OF INSTR 83922000 + N R9,=F'15' REMOVE 1ST REG, LEAVING 2ND ONLY 83924000 + SLL R9,2 GET R2 FIELD*4 FOR INDEXING 83926000 + SRL R7,4 GET R1 FIELD*4 83928000 + SLL R7,2 FOR INDEXING 83930000 + L R8,ECREGS(R7) GET VALUE IN USER REG (R1) 83932000 + L R10,ECREGS(R9) GET VALUE IN USER REG (R2) 83934000 + SPACE 2 83936000 +*********************************************************************** 83938000 +* * 83940000 +* AT THIS POINT IN THE DECODING, THE FOLLOWING INFORMATION * 83942000 +* IS CONTAINED IN REGISTERS R7 - R10: * 83944000 +* * 83946000 +* --2 REGS SPECIFIED IN INSTR+1 * 83948000 +* * 83950000 +* R7 = # OF THE 1ST REG MULT BY 4 * 83952000 +* R8 = CONTENTS OF THE 1ST REG * 83954000 +* R9 = # OF THE 2ND REG MULT BY 4 * 83956000 +* R10 = CONTENTS OF THE 2ND REG * 83958000 +* * 83960000 +* --2 LENGTHS OR IMMED FIELDS SPEC IN INSTR+1 * 83962000 +* * 83964000 +* R7 = THE 1ST LENGTH OR IMMED FIELD * 83966000 +* R8 = UNUSED * 83968000 +* R9 = THE 2ND LENGTH OR IMMED FIELD * 83970000 +* R10 = UNUSED * 83972000 +* * 83974000 +* --1 LENGTH OR IMMED FIELD SPEC IN INSTR+1 * 83976000 +* * 83978000 +* R7 = THE LENGTH OR IMMED FIELD * 83980000 +* R8 = UNUSED * 83982000 +* R9 = UNUSED * 83984000 +* R10 = UNUSED * 83986000 +* * 83988000 +*********************************************************************** 83990000 + SPACE 2 83992000 +* MERGE BACK AFTER 2ND BYTE DECODING -- CHECK IF 83994000 +* THIS IS AN RR INSTR; IF SO, BRANCH TO PROCESS 83996000 +EI2BMERG EQU * 83998000 + TM EICTB1,EIRR IS THIS AN RR INSTR ? 84000000 + BNO EI2HDECD IF NOT, BR TO DECODE 2ND HALFWORD 84002000 + LH R1,EICTDISP GET DISP TO SPECIAL ROUTINE 84004000 + B EISPEJMP(R1) BRANCH TO SPECIAL ROUTINE 84006000 + SPACE 2 84008000 +* DECODE 2ND HALFWORD OF THE INSTRUCTION. INFORMATION 84010000 +* IS PUT WHERE EXPECTED LATER. ADDRESS IS CHECKED FOR 84012000 +* ALIGNMENT ERROR. 84014000 +EI2HDECD EQU * 84016000 + LH RWK0,ECBD LOAD 1ST B1D1 IN WORK REG FOR INSUB 84022000 + BAL RLINK,EIBASDSP HAVE INSUB EVALUATE B1D1 84024000 + LR RAD1,RWK0 COPY ADDR INTO 1ST ADDR REG 84026000 + TM EICTB3,EIH2NODX CHECK IF INDEX REG NEEDED 84028000 + BO EINODX BRANCH IF B/D ONLY 84030000 + LTR R9,R9 TEST IF INDEX REG = 0 84032000 + BZ EINODX BRANCH IF ZERO 84034000 + LA RAD1,0(RAD1,R10) ZERO OUT HIGH ORDER BYTE 84036000 + SPACE 2 84038000 +* THIS SECTION CHECKS FOR AND PERFORMS OPERAND ALIGNMENT 84040000 +* CHECKING IF NEEDED 84042000 +EINODX EQU * 84044000 + TM ECPRFLG2,ECALNCHK IS ALIGNMENT CHECKING = ON ? 84046000 + BNO EINOCHK BRANCH IF NOT 84048000 + MVC EITSMK+1(1),EICTB4 MOVE MASK INTO TM INSTR 84050000 + STC RAD1,EIWORK ST LOW ORDER BYTE OF @ IN WORK AREA 84052000 +EITSMK TM EIWORK,$ TEST FOR ALGN ERR **MASK MOVED IN** 84054000 + BNZ EIOC6A BRANCH & RESET RIA ON ALGN ERROR L 84056000 + SPACE 2 84058000 +* CHECK 1ST OPRND ADDR FOR PROPER RANGE AND 84060000 +* STORAGE MODIFICATION. 84062000 +EINOCHK EQU * 84064000 + MVC EIWORK(1),EICTB3 STORE CONTROL BYTE IN WORK CPP 84065000 + TM EICTB1,EINOCNOW DO WE CHECK MOD STOR RANGE NOW 84066000 + BNO EI2HEND BRANCH IF NOT 84068000 + IC R2,EICTB6 GET MOD STORE LENGTH BYTE 84072000 + LTR RWK0,R2 GET LENGTH IN RIGHT REG 84074000 + BNZ EIHAVLEN BRANCH IF RWK0 HAS LENGTH 84076000 + LA RWK0,1(R7) GET LENGTH FROM THE INSTR 84078000 +EIHAVLEN EQU * 84080000 + LR RWK1,RAD1 COPY ADDR TO BE CHECKED 84082000 + BAL RLINK,EIMSFCHK BR TO ADDR CHECKING ROUTINE 84084000 + SPACE 2 84086000 +*********************************************************************** 84088000 +* * 84090000 +* AT THIS POINT IN THE DECODING PROCESS, THE FOLLOWING * 84092000 +* INFORMATION IS CONTAINED IN THE SPECIFIED REGISTERS: * 84094000 +* * 84096000 +* (NOTE: NO RR-TYPE INSTRS IF HERE) * 84098000 +* * 84100000 +* R7 - SAME AS IN COMMENT BLOCK ABOVE * 84102000 +* R8 - SAME AS IN COMMENT BLOCK ABOVE * 84104000 +* R9 - SAME AS IN COMMENT BLOCK ABOVE * 84106000 +* R10 - SAME AS IN COMMENT BLOCK ABOVE * 84108000 +* RAD1 - CONTAINS THE CALCULATED RELATIVE ADDRESS FROM THE * 84110000 +* 2ND HALFWORD OF THE INSTR (B1-D1 OR I1-B1-D1) * 84112000 +* * 84114000 +* NOTE: RAD1 IS RELOCATED TO REAL IFF THIS IS NOT A BRANCH * 84116000 +* INSTRUCTION. --- * 84118000 +* * 84120000 +*********************************************************************** 84122000 + SPACE 2 84124000 +EI2HEND EQU * 84126000 + TM EICTB2,EILEN6 IS INSTR LENGTH = 6 ? 84128000 + BO EI3HDECD BRANCH IF YES 84130000 + TM EICTB3,EIBRINST IS THIS A BRANCH INSTRUCTION ? 84132000 + BO EI4JUMP YES - DON'T RELOCATE RAD1 84134000 + ALR RAD1,RMEM RELOCATE ADDRESS TO REAL 84136000 + AIF (&$S370 NE 2).EITRX SKIP IF ON A REAL 370 84138000 +* 84140000 +* IF FAKING ALIGNMENT IS NECESSARY, DO IT ! 84142000 +* 84144000 + TM ECPRFLG2,ECALNCHK IS ALIGNMENT CHECKING ON ? 84146000 + BZ EI4JUMP NO - SKIP FAKING CODE 84148000 + TM EICTB4,EIALDOBL DOES THIS INSTR NEED ALIGN ? 84150000 + BZ EI4JUMP NO - SKIP FAKING CODE 84152000 + CLI ECOP,X'90' IS THIS A STM? CPP 84152100 + BE EI4JUMP IF YES SKIP FAKING CODE CPP 84152200 + CLI ECOP,X'98' IS THIS AN LM? CPP 84152300 + BE EI4JUMP IF YES, SKIP FAKING CODE CPP 84152400 + CLI ECOP,X'44' IS THIS AN EX? CPP 84152500 + BE EI4JUMP IF YES, SKIP FAKING CODE CPP 84152600 + LTR RWK14,RAD1 SAVE FOR LATER, SET CC ^= 0 84154000 + MVC EIDUBLWD(8),0(RAD1) MOVE A MAX OF 8 BYTES OVER 84156000 + LA RAD1,EIDUBLWD LOAD @ OF ALIGNED FIELD 84158000 +.EITRX ANOP 84160000 +EI4JUMP EQU * 84162000 + LH RWK1,EICTDISP GET DISP FOR BR TO SPECIAL ROUTINE 84164000 + B EISPEJMP(RWK1) BRANCH TO SPECIAL ROUTINE 84166000 + AIF (&$S370 NE 2).EITRXA SKIP IF ON A REAL 370 84168000 +EIDUBLWD DC D'0' USED FOR FAKING 360 ALIGNMENT 84170000 +.EITRXA ANOP 84172000 + SPACE 2 84174000 +* THIS SECTION DECODES THE THIRD HALFWORD OF THE 6 BYTE 84176000 +* SS-TYPE INSTRUCTION, AND THEN BRANCHES TO A SPECIAL 84178000 +* ROUTINE TO COMPLETE PROCESSING. 84180000 +EI3HDECD EQU * 84182000 + LH RWK0,ECB2D2 GET 3RD HALFWORD OF THE INSTR 84184000 + BAL RLINK,EIBASDSP CALCULATE RELATIVE ADDR (B2D2) 84186000 + LR RAD2,RWK0 COPY ADDR INTO 2ND ADDR REG 84188000 + SPACE 2 84190000 +* CHECK 2ND OPRND ADDRESS FOR PROPER RANGE 84192000 + TM ECFLAG0,$ECPROT IS ABSOLUTE PROTECT FLAG ON ? 84194000 + BZ EI3HEND IF NOT, BRANCH AROUND INSUB CALL 84196000 + CLI ECOP,X'E0' IS THIS AN X-PSEUDO INSTR ? 84198000 + BE EI3HEND YES - DON'T CHECK THIS ADDRESS 84200000 + LR RWK1,RAD2 COPY ADDRESS FOR CHECKING 84202000 + LR RWK0,R7 ASSUME ONE LENGTH FOR OPERANDS 84204000 + TM EICTB3,EIB2IORL TEST TO FIND LENGTH TYPE 84206000 + BO *+6 IF ONE LENGTH BRANCH AROUND 84208000 + LR RWK0,R9 GET RIGHT LENGTH 84210000 + ALR RWK0,RWK1 GET @ OF HIGHEST BYTE ACCESSED 84212000 + BAL RLINK,EIFTHCHK CHECK ADDR FOR FETCH RANGE 84214000 +*********************************************************************** 84216000 +* * 84218000 +* REGISTER USAGE FOR SS-TYPE INSTRUCTIONS IS AS FOLLOWS: * 84220000 +* * 84222000 +* R7 - CONTAINS EITHER: * 84224000 +* A. THE LENGTH OR IMMED FIELD AS A FULL BYTE, OR * 84226000 +* B. THE 1ST OF 2 LENGTHS OR IMMED FIELDS * 84228000 +* R8 - IS UNUSED * 84230000 +* R9 - IS EITHER UNUSED OR CONTAINS THE 2ND OF 2 LENGTHS OR * 84232000 +* IMMEDIATE FIELDS * 84234000 +* RAD1 - CONTAINS THE 1ST RELATIVE ADDRESS (B1D1) * 84236000 +* RAD2 - CONTAINS THE 2ND RELATIVE ADDRESS (B2D2) * 84238000 +* * 84240000 +* NOTE: THE ADDRESSES IN RAD1 AND RAD2 ARE RELOCATED FOR * 84242000 +* ASSIST. --- * 84244000 +* * 84246000 +*********************************************************************** 84248000 + SPACE 2 84250000 +EI3HEND EQU * 84252000 + AR RAD1,RMEM RELOCATE 1ST FAKE @ TO REAL 84254000 + AR RAD2,RMEM RELOCATE 2ND FAKE @ TO REAL 84256000 + MVC EIQSS(2),ECOP MOVE OPCODE & LENGTH(S) INTO INSTR 84258000 + LH RWK1,EICTDISP GET DISP FOR BR TO SPECIAL ROUTINE 84260000 + B EISPEJMP(RWK1) BRANCH TO SPECIAL ROUTINE 84262000 + SPACE 1 84264000 +EIRIA DC F'0' SAVE AREA FOR INSTRUCTION ADDR 84266000 + SPACE 5 84268000 +EISPEJMP EQU * USED TO CALCULATED JUMP ADDRESS 84270000 +* 84272000 +*------------> THIS MARKS THE END OF THE PRIMARY FETCH/DECODE LOOP 84274000 + TITLE '*** EXECUT - CODE CALLED FROM MAIN FETCH/DECODE LOOP' 84276000 +* THE FOLLOWING CODE COMPRISES SOME OUT-OF-LINE 84278000 +* ROUTINES BRANCHED TO FROM THE ABOVE PRIMARY FETCH 84280000 +* AND DECODING LOOP: 84282000 + SPACE 2 84284000 +* CHECK STATE ---- PRIV OPCODE WAS ENCOUNTERED 84286000 +EICHKST EQU * 84288000 + TM ECPRFLG2,ECSUPRST ARE WE IN SUPERVISOR STATE ? 84290000 + BO EI2BDECD IF IN SUPER STATE BRANCH TO DECODE 84292000 + B EIOC2 IF NOT IN SUPER STATE SOC 2 FLAGGED 84294000 + SPACE 2 84296000 +* THIS SECTION PROCESSES INSTRUCTION TRACE AND 84298000 +* COUNTING FACILITIES 84300000 + SPACE 2 84302000 +* INCREMENT THE INSTRUCTION EXECUTION COUNT FACILITY 84304000 +* COUNTERS 84306000 +EITRIC EQU * 84306500 + TM ECPRFLG1,ECPRIECF IS THE IECF ACTIVE NOW? 84308000 + BNO EITRICB IF NOT ON GO SEE IF TRACE IS ON 84310000 + C RIA,ECPRICH CMPR INSTR @ WITH HIGH ADDR LIMIT 84312000 + BH EITRICB BRANCH IF OUT OF RANGE 84314000 + C RIA,ECPRICL CMPR INSTR @ WITH LOW ADDR LIMIT 84316000 + BL EITRICB BRANCH IF OUT OF RANGE 84318000 + LR RWK1,RIA MOVE INSTR @ REG TO WORKABLE REG 84320000 + S RWK1,ECFADL SUBTRACT FOR INSTRUCTION OFFSET 84322000 + L R7,ECPRICA GET BEGINNING ADDRESS OF COUNT AREA 84324000 + LH RWK14,0(RWK1,R7) LOAD THE PROPER HALFWORD COUNTER 84326000 + LA RWK14,1(RWK14) INCREMENT THE INSTRUCTION COUNTER 84328000 + STH RWK14,0(RWK1,R7) RESTORE THE INCREMENTED COUNTER 84330000 +* PROCESS ----> TRACE FACILITY 84348000 +EITRICB EQU * 84350000 + TM ECPRFLG1,ECPRTRCE IS THE TRACE FACILITY ON 84352000 + BNO EIINCPSW BRANCH IF FACILITY NOT ON 84354000 + C RIA,ECPRTRAH COMPARE INSTR @ WITH HIGH LIMIT 84356000 + BH EIINCPSW BRANCH IF OUT OF RANGE 84358000 + C RIA,ECPRTRAL CMPR INSTR @ WITH LOW LIMIT 84360000 + BL EIINCPSW BRANCH IF OUT OF RANGE 84362000 + MVC EITRMSIN+4(10),EIBLANKS BLANK OUT INSTR AREA 84364000 + XHEXO RIA,EITRMSAD CONVERT INSTR @ TO HEX 84366000 + MVC EITRMSAD(2),EIBLANKS BLANK OUT 1ST TWO BYTE OF @ 84368000 + LM R0,R1,ECSTCCPM FETCH INSTR FROM INSTR STACK 84370000 + SLDL R0,16 RR AND RX CODE IN REG 0 84372000 + XHEXO R0,EIWORK CONVERT INSTR TO HEX (4 BYTES) 84374000 + TM ECSTINST,EISSINST IS THIS AN SS INSTR ? 84376000 + BNO EINOTSS BRANCH IF NOT 84378000 + XHEXO R1,EIWORK+8 CONVERT INSTR TO HEX (LAST 2 BYTES) 84380000 +EINOTSS EQU * 84382000 + LA RWK1,EITRMSIN GET @ OF HEX INSTR 84384000 + BAL R2,EIMOVINS MOVE HEX INSTR INTO FORMAT 84386000 + $PRNT EITRMSG,EITRMSGL,EICNTEXC PRINT INSTR FOR TRACE AND BR X84388000 + OUT IF LINE COUNT EXCEEDED 84390000 + B EIINCPSW RETURN TO MAIN PROGRAM LOOP 84392000 +* WORK AREAS USED BY THE TRACE FACILITY 84394000 +EITRMSG DC C' TRACE--> INSTR ADDR:' TRACE MESSAGE 84396000 +EITRMSAD DC 8C' ' TRACE MESSAGE 84398000 + DC C' INSTR: ' TRACE MESSAGE 84400000 +EITRMSIN DC 14C' ' TRACE MESSAGE 84402000 +EITRMSGL EQU *-EITRMSG LENGTH OF THE TRACE MESSAGE 84404000 +EIWORK DC 16C' ' WORK AREA 84406000 +EIBLANKS DC 10C' ' BLANKS USED IN TRACE 84408000 + TITLE '*** EXECUT - RR PROCESSING ROUTINES' 84410000 +*********************************************************************** 84412000 +* * 84414000 +* RR INSTRUCTION PROCESSING ROUTINES * 84416000 +* * 84418000 +*********************************************************************** 84420000 + SPACE 5 84422000 +* ********** NORMAL RR INSTRUCTION PROCESSING ********** 84424000 +* 84426000 +* 2 ENTRIES TO SEQUENCE --> 84428000 +* LR SEPARATE SINCE CURRENT CC NOT CHANGED 84430000 +* NR,CLR,OR,XR,CR,AR,SR,ALR,SLR,LPR,LNR,LCR,LTR NORMAL 84432000 + SPACE 1 84434000 +EILR EQU * LOAD REGISTER INST 84436000 + ST R10,ECREGS(R7) LOAD R1 WITH VALUE FROM R2 84438000 + B EIFINRR RETURN FOR NEXT INSTR 84440000 + SPACE 1 84442000 +EINORMRR EQU * NORMAL RR INSTRS 84444000 + STC ROP,EIQRR PLACE ACTUAL OPCODE INTO INSTR 84446000 +EIQRR LR $+R8,R10 EXECUTE RIGHT INSTRUCTION X84448000 + ***** OPCODE MOVED IN ***** 84450000 + ST R8,ECREGS(R7) SAVE RESULT IN OPERAND LOCATION 84452000 + BAL RCC,EIFINRR GET CC, RETURN FOR NEXT INSTR 84454000 + SPACE 2 84456000 +* THIS SECTION PROCESSES THE BALR INSTRUCTION 84458000 +EIBALR EQU * 84460000 + LR RWK1,RIA COPY ADDR NEXT INSTR OVER 84462000 + N RCC,=XL4'3F000000' LEAVE ONLY CC-PM IN RCC 84464000 + AL RCC,=XL4'40000000' ADD ILC INTO PSW BEING BUILT 84466000 + ALR RWK1,RCC NOW HAVE ILC-CC-PM-IA FIELDS 84468000 + ST RWK1,ECREGS(R7) FAKE REGISTER GETS BUILT PSW 84470000 + LTR R9,R9 TEST FOR NO BRANCHING R2 = 0 84472000 + BZ EIFINRR NO BRANCH TREAT AS REG RR GET NEXT X84474000 + INSTRUCTION 84476000 + LR RIA,R10 PUT BRANCH ADDRESS IN PROPER REG 84478000 + B EIFINB PROCESS SUCCESSFUL BRANCH 84480000 + SPACE 2 84482000 +* BRANCH ON COUNT REGISTER (BCTR) 84484000 +EIBCTR EQU * 84486000 + BCTR R8,0 DECREMENT VALUE IN FAKE R1 84488000 + ST R8,ECREGS(R7) RESTORE VALUE TO FAKE REG 84490000 + LTR R9,R9 IS R2 = 0 ? 84492000 + BZ EIFINRR IF ZERO, NO BRANCH 84494000 + LTR R8,R8 IS DECREMENTED VALUE = 0 ? 84496000 + BZ EIFINRR IF ZERO, NO BRANCH 84498000 + LR RIA,R10 PUT BRANCH @ IN RIGHT REG 84500000 + B EIFINB PROCESS SUCCESSFUL BRANCH 84502000 + SPACE 2 84504000 +* BRANCH ON CONDITION REGISTER (BCR) 84506000 +EIBCR EQU * 84508000 + LTR R9,R9 IS R2 = 0 ? 84510000 + BZ EIFINRR IF ZERO, NO BRANCH 84512000 + SLL R7,2 GET MASK IN RIGHT SPOT 84514000 + STC R7,EIQBCR+1 STORE MASK INTO INSTR 84516000 + LR RWK1,RIA COPY @ OF NEXT SEQ INSTR 84518000 + LR RIA,R10 PUT BRANCH ADDR IN RIGHT REG 84520000 + SPM RCC SET REAL CC = FAKE CC 84522000 +EIQBCR BC $,EIFINB *** MASK STORED IN *** 84524000 + LR RIA,RWK1 RESTORE INSTR @ REG 84526000 + B EIFINRR BRANCH FAILED 84528000 + SPACE 1 84530000 +* CHECK FOR FLOATING-POINT INSTR OR EXT FLOATING POINT 84532000 + AIF (&$FLOTEX).EIXFPRR GO GENER CODE IF XFP IS OK 84534000 +EIXFPRR EQU EIOC1 NOTE XFP INVAL OP IF NOT ALLOWED 84536000 + AIF (&$FLOTE).EIFPRR GO GENERATE IF FLOAT PNT INST OK 84538000 +EIFPRR EQU EIOC1 NOTE NOT ALLOWING FLOATINGS 84540000 + AGO .EIFPRR2 84542000 +.EIXFPRR ANOP 84544000 +EIXFPRR EQU * CODE FOR XFP SAME AS FOR REGULAR FP 84546000 +.EIFPRR ANOP 84548000 + SPACE 2 84550000 +* RR FLOATING POINT INSTRUCTIONS EXECUTED 84552000 +EIFPRR EQU * FLOATING-PNT RR'S ENTER HERE 84554000 + SPM RCC SET OUR CC SAME AS USER'S 84556000 + EX R0,ECOP EXECUTE ACTUAL INSTR FROM THE STACK 84558000 + BAL RCC,EIFINRR GET CC AND RETURN FOR NEXT INSTR 84560000 +.EIFPRR2 ANOP 84562000 + SPACE 2 84564000 +* THE FOLLOWING CODE PROCESSES THE CLCL, MVCL 84566000 +* INSTRUCTIONS 84568000 +* 84570000 +* ADDRESS CHECKING CODE FOR CLCL AND MVCL 84572000 +EILONG EQU * 84574000 + L RWK0,ECREGS+4(R7) GET LENGTH VALUE OF REG 2 PAIR 1 84576000 + N R8,EILONGMK ZAP OUT UPPER BYTE OF ADDRESS 84578000 + N RWK0,EILONGMK ZAP OUT UPPER BYTE OF LENGTH 84580000 + BZ EILONG1 IF LENGTH = 0 DON'T CHECK ADDRESS 84582000 + MVC EIWORK(1),EICTB3 STORE CONTROL BYTE IN WORK AREA 84584000 + LR RWK1,R8 COPY ADDRESS TO BE CHECKED 84586000 + BAL RLINK,EIMSFCHK BRANCH TO ROUTINE CHECK FIRST @ 84588000 + SPACE 2 84590000 +* FIRST ADDRESS IS OKAY --- CHECK THE SECOND 84592000 +EILONG1 EQU * 84594000 + L RWK0,ECREGS+4(R9) GET VALUE (LENGTH) OF 2ND REG PAIR 2 84596000 + N R10,EILONGMK ZAP OUT UPPER BYTE OF SECOND ADDRESS 84598000 + N RWK0,EILONGMK ZAP OUT UPPER BYTE OF SECONG LENGTH 84600000 + BZ EILONG2 IF LENGTH 0 DON'T CHECK ADDRESS 84602000 + IC RWK1,EICTB3 GET CONTROL BYTE 84604000 + SLL RWK1,2 SHIFT BECAUSE WOKING ON SECOND OPRND 84606000 + STC RWK1,EIWORK PUT TAB ENTRY IN INSUB WORK AREA 84608000 + LR RWK1,R10 PUT ADDR WHERE INSUB EXPECTS IT 84610000 + BAL RLINK,EIMSFCHK BRANCH TO INSUB CHECK 2ND ADDRESS 84612000 + SPACE 2 84614000 +* BOTH ADDRESSES ARE OK --- RELOCATE THEM AND PERFORM 84616000 +* THE APPROPRIATE COMMAND 84618000 +EILONG2 EQU * 84620000 + ALR R8,RMEM RELOCATE 1ST ADDRESS TO REAL ADDRESS 84622000 + ALR R10,RMEM RELOCATE 2ND ADDRESS TO ACTUAL 84624000 + SPACE 2 84626000 + AIF (&$S370 NE 1).EILONG1 SKIP IF NOT ON REAL 370 84628000 + STC ROP,EIQLONG STORE OPCODE IN INSTRUCTION 84630000 + LR RWK1,R9 SAVE SECOND OPERAND REG NUMBER 84632000 + LR RWK0,RMEM SAVE RELOCATION REGISTER 84634000 + L R9,ECREGS+4(R7) GET LENGTH OF FIRST OPERAND 84636000 + L R11,ECREGS+4(RWK1) GET LENGTH OF SECOND OPERAND 84638000 +EIQLONG CLCL R8,R10 **** OPCODE MOVED IN DURING EXEC*** 84640000 + BALR RCC,0 PICK UP THE CONDITION CODE 84642000 + SLR R8,RWK0 DE-RELOCATE FINAL ADDRESSES 84644000 +* *** THE INSTRUCTIONS ON EITHER SIDE OF THIS COMMENT 84646000 +* *** BLOCK ARE USING RWK0 INSTEAD OF RMEM DUE TO 84648000 +* *** TEMPORARY REGISTER SHIFTING ***** 84650000 + SLR R10,RWK0 DE-RELOCATE FINAL ADDRESSES 84652000 + N R8,EILONGMK ZAP UPPER BYTE OF ADDRESS REG 84654000 + N R10,EILONGMK ZAP UPPER BYTE OF ADDRESS REGISTER 84656000 + ST R8,ECREGS(R7) PUT REGISTERS BACK INTO CORE 84658000 + ST R9,ECREGS+4(R7) PUT REGISTERS BACK INTO CORE 84660000 + ST R10,ECREGS(RWK1) PUT REGISTERS BACK INTO CORE 84662000 + ST R11,ECREGS+4(RWK1) PUT REGISTERS BACK INTO CORE 84664000 + LR RMEM,RWK0 RELOAD RELOCATION REGISTER 84666000 + B EIFINRR GET NEXT INSTR PSU. 84668000 + AGO .EILONG2 84670000 +.EILONG1 ANOP 84672000 + SPACE 2 84674000 +* CHECK WHICH INSTRUCTION TO SIMULATE (MVCL OR CLCL) 84676000 + LA RWK14,1 SET UP INCREMENT REGISTER 84678000 + IC RWK1,ECREGS+4(R9) GET PAD BYTE FROM INSTR 84680000 + STC RWK1,EIPAD STORE PAD BYTE IN WORK AREA 84682000 + L RWK1,ECREGS+4(R7) GET 1ST OPERAND LENGTH 84684000 + L R2,ECREGS+4(R9) GET SECOND OPERAND LENGTH 84686000 + N RWK1,EILONGMK ZAP OUT HIGH ORDER BYTE LENGTH 1 84688000 + N R2,EILONGMK ZAP OUT HIGH ORDER BYTE LENGTH 2 84690000 + CLI ECOP,X'0E' IS THIS AN MVCL COMMAND 84692000 + BE EIMVCL IF SO BRANCH TO ROUTINE 84694000 + SPACE 2 84696000 +* CODE FOR THE CLCL COMMAND 84698000 +EICLCL EQU * 84700000 + LTR R2,R2 TEST SECOND LENGTH = 0? 84702000 + BZ EICLCL6 BRANCH IF SECOND LENGTH 0 84704000 + LTR RWK1,RWK1 TEST 1ST LENGTH = 0 ? 84706000 + BZ EICLCL2 YES, BRANCH TO USE PAD AND OPRND 2 84708000 +EICLCL1 EQU * 84710000 + CLC 0(1,R8),0(R10) COMPARE A CHARACTER FROM EACH FIELD 84712000 + BNE EICLCL5 IF NOT EQUAL WE ARE DONE BRANCH 84714000 + AR R10,RWK14 INCREMENT POINTERS 84716000 + AR R8,RWK14 INCREMENT POINTERS 84718000 + BCT RWK1,EICLCL3 DECREMENT 1ST LENGTH - BRANCH ^= 0 84720000 + B EICLCL7 LENGTH = 0, BRANCH INTO PAD LOOP 84722000 +EICLCL2 EQU * 84724000 + CLC EIPAD(1),0(R10) COMPARE PAD TO OPERAND 2 84726000 + BNE EICLCL5 IF NOT EQUAL WE ARE DONE -- BRANCH 84728000 + AR R10,RWK14 INCREMENT OPERAND 2 POINTER 84730000 +EICLCL7 EQU * 84732000 + BCT R2,EICLCL2 DECREMENT 2ND COUNT BR IF ^= 0 84734000 + B EICLCL5 IF LENGTH = 0 OPRNDS = WE'RE DONE 84736000 +EICLCL3 EQU * 84738000 + BCT R2,EICLCL1 DECREMENT 2ND LENGTH BR IF ^=0 84740000 +EICLCL4 EQU * 84742000 + CLC 0(1,R8),EIPAD COMPARE FIRST OPERAND AND PAD CHAR 84744000 + BNE EICLCL5 IF NOT = WE ARE DONE BRANCH 84746000 + AR R8,RWK14 INCREMENT POINTER 84748000 + BCT RWK1,EICLCL4 DECREMENT LENGTH, BRANCH IF ^= 0 84750000 +EICLCL5 EQU * 84752000 + BAL RCC,EILONG5 CAPTURE CONDITION CODE AND RETURN 84754000 +EICLCL6 EQU * 84756000 + LTR RWK1,RWK1 FIRST LENGTH = 0? 84758000 + BNZ EICLCL4 NO, USE 1ST OPRND AND PAD 84760000 + BAL RCC,EILONG5 GET CC (=0) AND RETURN 84762000 + SPACE 2 84764000 +* CODE FOR THE MVCL COMMAND 84766000 +EIMVCL EQU * 84768000 + LR RWK0,RWK1 ASSUME FIRST LENGTH SMALLEST 84770000 + CR RWK1,R2 COMPARE THE LENGTHS 84772000 + BALR RCC,0 CAPTURE THE CC 84774000 + BL *+6 IF 1ST LENGTH LOWER, BRANCH 84776000 + LR RWK0,R2 2ND LENGTH MUST BE SMALLER 84778000 + LTR RWK0,RWK0 IS SMALLEST LENGTH = 0? 84780000 + BZ EIMVCL3 IF SMALLER = 0, BRANCH 84782000 + SPACE 2 84784000 +* FOLLOWING CODE CHECKS FOR DESTRUCTIVE OVERLAP 84786000 + CR R8,R10 IS FIRST FIELD AFTER 2ND 84788000 + BNH EIMVCL1 IF NO OVERLAP, BRANCH 84790000 + LR RWK14,R10 COPY OVER 2ND ADDRESS 84792000 + LA RWK14,0(R2,RMEM) COMPUTE HIGHEST @, RELOCATED + 1 84794000 + BCTR RWK14,0 COMPUTE HIGHEST ADDRESS 84796000 + CR R8,RWK14 IS 1ST FIELD AFTER END OF SECOND 84798000 + BNL EIMVCL1 YES -- NO OVERLAP, SO BRANCH 84800000 + TM *+1,1 SET CC = 3 84802000 + BAL RCC,EILONG5 GET CC AND RETURN 84804000 + SPACE 2 84806000 +EIMVCL1 EQU * 84808000 + SR RWK1,RWK0 DECREMENT LENGTH BY SMALLEST 84810000 + SR R2,RWK0 DECREMENT LENGTH BY SMALLEST 84812000 + LA RWK14,1 LOAD INCREMENT REGISTER 84814000 +EIMVCL2 EQU * 84816000 + MVC 0(1,R8),0(R10) MOVE 1 BYTE !!!!!! 84818000 + AR R8,RWK14 INCREMENT POINTER BY 1 84820000 + AR R10,RWK14 INCREMENT POINTER BY 1 84822000 + BCT RWK0,EIMVCL2 DECREMENT LENGTH, ^= 0 BRANCH 84824000 +EIMVCL3 EQU * 84826000 + LTR RWK1,RWK1 DO WE NEED PADDING 84828000 + BZ EILONG5 NO --- DONE, SO BRANCH 84830000 +EIMVCL4 MVI 0(R8),$ MOVE PAD TO FIRST OPERAND 84832000 + AR R8,RWK14 INCREMENT POINTER BY 1 84834000 + BCT RWK1,EIMVCL4 DECREMENT LENGTH, ^= 0 BRANCH 84836000 + SPACE 2 84838000 +EILONG5 EQU * 84840000 + LA RWK14,ECREGS(R7) GET ADDRESS OF 1ST REG PAIR 84842000 + XC 5(3,RWK14),5(RWK14) ZAP LOWER PART OF LENGTH IN CORE 84844000 + O RWK1,4(,RWK14) PUT UPPER BYTE BACK INTO USER REG 84846000 + LA RWK14,ECREGS(R9) GET ADDR OF SECOND REGISTER PAIR 84848000 + XC 5(3,RWK14),5(RWK14) ZAP LOWER PART OF LENGTH IN CORE 84850000 + O R2,4(,R2) PUT UPPER BYTE BACK INTO REGISTER 84852000 +* OPERATION COMPLETE ----- RESTORE REGISTERS AND RETURN 84854000 + SLR R8,RMEM DE-RELOCATE FINAL ADDRESSES 84856000 + SLR R10,RMEM DE-RELOCATE FINAL ADDRESSES 84858000 + N R8,EILONGMK ZAP UPPER BYTES OF ADDRESS REGS 84860000 + N R10,EILONGMK ZAP UPPER BYTES OF ADDRESS REGS 84862000 + ST R8,ECREGS(R7) PUT REGISTERS BACK INTO CORE 84864000 + ST RWK1,ECREGS+4(R7) PUT REGISTERS BACK INTO CORE 84866000 + ST R10,ECREGS(R9) PUT REGISTERS BACK INTO CORE 84868000 + ST R2,ECREGS+4(R9) PUT REGISTERS BACK INTO CORE 84870000 + SR R2,R2 RESTORE R2 AS A BYTE REGISTER 84872000 + B EIFINRR RETURN FOR NEXT INSTR. CEH 84874000 +EIPAD EQU EIMVCL4+1 MVCL/CLCL PAD BYTE IS MOVED HERE 84876000 +.EILONG2 ANOP 84878000 +EILONGMK DC 0F'0',XL4'00FFFFFF' USED TO CLEAR UPPER BYTE OF REGS 84880000 + SPACE 2 84882000 +* THE FOLLOWING CODE PROCESSES SET PROGRAM MASK 84884000 +EISPM EQU * 84886000 + L RCC,ECREGS(R7) PLACE SPECIFIED REG INTO CC REG 84888000 + SPM RCC SET REAL CC-PM TO FAKE CC-PM 84890000 + B EIFINRR RETURN FOR NEXT INSTRUCTION 84892000 + SPACE 1 84894000 +* THESE TWO PRIVILEGED INSTRUCTIONS ARE NOT IMPLEMENTED 84896000 +* AT THE PRESENT TIME. THE HOOKS ARE PROVIDED HOWEVER, 84898000 +* IF IT SHOULD BECOME POSSIBLE TO IMPLEMENT THEM IN THE 84900000 +* FUTURE 84902000 +EISSK EQU EIOC2 84904000 +EIISK EQU EIOC2 84906000 + SPACE 2 84908000 +* THE FOLLOWING CODE PROCESSES THE SVC INSTRUCTION 84910000 +* CONTROL IS PASSED HERE FROM THE MAIN DECODONG LOOP 84912000 +* WHEN AN SVC OPCODE IS ENCOUNTERED. AT THIS POINT 84914000 +* REGISTER 7 CONTAINS THE SECOND BYTE OF THE INSTRUCTION 84916000 +* AND REGISTER ROP CONTAINS THE INSTRUCTION OPCODE. THIS 84918000 +* INSTRUCTIONS IS PRESENTLY FLAGGED AS AN OC2 EXCEPTION. 84920000 +* IN THE FUTURE, CODE MAY BE PLACED HERE TO ACTUALLY 84922000 +* PERFORM OR SIMULATE THE SCV. IT SHOULD BE NOTED THAT 84924000 +* REGISTERS RWK0, RWK1, R8, R9, R10 AND R14 ARE AVAILABLE 84926000 +* FOR USE HERE. R2 CAN ALSO BE USED AS A BYTE REGISTER OR 84928000 +* RESTORED TO A BYTE REGISTER IF USED FOR ANOTHER PURPOSE. 84930000 +* NO OTHER REGISTERS SHOULD BE USED HERE. 84932000 +* FOLLOWING ANY FUTURE SVC PROCESSING, CONTROL MUST BE 84934000 +* PASSED TO LABEL EIFINRR TO FETCH AND PROCESS THE NEXT 84936000 +* INSTRUCTION. 84938000 + SPACE 2 84940000 +EISVC EQU EIOC2 84942000 + SPACE 2 84944000 +* THIS CODE IS USED TO PERFORM THE MR AND DR INSTRS 84946000 +EIMRDR EQU * 84948000 + STC ROP,EIQMRDR STORE PROPER OPCODE IN INSTRUCTION 84950000 + LA RWK1,ECREGS(R7) GET ADDRESS OF FAKE REGISTER PAIR 84952000 + L R9,ECREGS+4(R7) GET CONTENTS OF SECOND REG OF PAIR 84954000 +EIQMRDR MR $+R8,R10 ****OPCODE MOVED IN DURING EXEC**** 84956000 + STM R8,R9,0(RWK1) STORE CHANGED REGS INTO FAKE REGS 84958000 + B EIFINRR BRANCH AND RETURN FOR NEXT INSTR 84960000 + TITLE '*** EXECUT - RX PROCESSING ROUTINES' 84962000 +*********************************************************************** 84964000 +* * 84966000 +* RX TYPE INSTRUCTION INTERPRETING SECTION * 84968000 +* * 84970000 +* * 84972000 +*********************************************************************** 84974000 +* * 84976000 +* RX NORMAL PROCESSING * 84978000 +* (IC,CH,AH,SH,MH,N,CL,O,X,C,A,S,AL,SL,L,LH,CVB) * 84980000 +EINORMRX EQU * 84982000 + STC ROP,EINRMRX MOVE PROPER OP CODE TO INSTRUCTION 84984000 + SPM RCC SET OUR CONDITION CODE TO USERS 84986000 +EINRMRX IC $+R8,0(RAD1) ** PROPER OP CODE WILL BE MOVED IN** 84988000 + ST R8,ECREGS(R7) STORE RESULT IN PROPER USER REGISTER 84990000 + BAL RCC,EIFIN GET CC AND RETURN FOR NEXT INSTR 84992000 + SPACE 2 84994000 +* THIS SECTION PROCESSES THE BAL INSTRUCTION 84996000 +EIBAL EQU * 84998000 + L RWK1,EIRIA GET @ OF NEXT SEQUENTIAL INSTR 85000000 + N RCC,=XL4'3F000000' LEAVE ONLY CC-PM IN RCC 85002000 + AL RCC,=XL4'80000000' ADD ILC TO PSW BEING BUILT 85004000 + ALR RWK1,RCC NOW HAVE ILC-CC-PM-IA FIELDS 85006000 + ST RWK1,ECREGS(R7) FAKE REGISTER GETS BUILT PSW 85008000 +* ** NOTE ** RAD1 HAS BRANCH ADDRESS VALUE 85010000 + B EIFINB PROCESS SUCCESSFUL BRANCH INSTRS 85012000 + SPACE 2 85014000 +* BRANCH ON COUNT (BCT) 85016000 +EIBCT EQU * 85018000 + BCTR R8,0 DECREMENT VALUE IN REG 85020000 + ST R8,ECREGS(R7) STORE DECREMENTED VALUE IN FAKE REG 85022000 + LTR R8,R8 VALUE = 0 ? 85024000 + BNZ EIFINB IF NOT ZERO, SUCCESSFUL BRANCH 85026000 + B EIFIN BRANCH FAILED, GET NEXT INSTR 85028000 + SPACE 2 85030000 +* BRANCH ON CONDITION (BC) 85032000 +EIBC EQU * 85034000 + SLL R7,2 GET MASK IN RIGHT SPOT 85036000 + STC R7,EIQBC+1 STORE MASK INTO INSTR 85038000 + SPM RCC REAL CC = FAKE CC 85040000 +EIQBC BC $,EIFINB *** MASK STORED IN *** 85042000 + B EIFIN BRANCH FAILED 85044000 + SPACE 2 85046000 +* PROCESS THE LA INSTRUCTION (LOAD ADDRESS) 85048000 +EILA EQU * 85050000 + SLR RAD1,RMEM DE-RELOCATE ADDRESS FOR USER 85052000 + ST RAD1,ECREGS(R7) STORE RESULT IN FAKE REG 85054000 + B EIFIN BRANCH TO GET NEXT INSTR 85056000 + SPACE 2 85058000 +* INTERPRETATION OF THE EXECUTE INSTRUCTION (EX) 85060000 +EIEX EQU * 85062000 + CLI 0(RAD1),X'44' MAKE SURE NOT AN EXECUTE 85064000 + BE EIOC3 EXECUTE INTERRUPT 85066000 +* FETCH INSTRUCTION AND PUT IN STACK 85068000 + L RSTK,ECSTLINK GET @ OF NEXT STACK SLOT 85070000 + ST RCC,ECSTCCPM SAVE CC AND PROG MASK IN STACK 85072000 + MVC ECSTINST,0(RAD1) GET UP TO 6 BYTES OF INSTR 85074000 + IC ROP,ECOP GET OPCODE INTO REGISTER 85076000 + SR RAD1,RMEM DE-RELOCATE INSTR ADDR 85078000 + ST RAD1,ECSTIADD SAVE INSTR ADDR FOR DUMP 85080000 + MVC EIINCPSW+2(4),EIEXMBR ** CHANGE INSTR IN MAIN LOOP TO X85082000 + RETURN TO EXECUTE CODE ** 85084000 +* OR BYTE INTO INSTR AS NEEDED - THEN BRANCH TO PROCESS 85086000 + LTR R7,R7 CHECK IF BYTE SHOULD BE OR'ED IN 85088000 + BZ EIEXPEN BRANCH TO PROCESS IF NOT 85090000 + LA R9,ECREGS+3(R7) GET @ OF BYTE TO BE OR'ED IN 85092000 + OC ECR1R2(1),0(R9) OR BYTE INTO INSTRUCTION (IN STACK) 85094000 + B EIEXPEN BRANCH TO PROCESS INSTR 85096000 +* ***** RETURNED HERE TO FIX UP THE ADDRESS OF THE NEXT 85098000 +* ***** INSTRUCTION (AFTER THE THE INSTR EXECUTED BY THE 85100000 +* ***** EX INSTR) 85102000 +EIEXRET EQU * 85104000 + L RIA,EIRIA RELOAD CORRECT NEXT INSTR @ 85106000 + MVC EIINCPSW+2(4),EIEXRSTR RESTORE IC INSTR IN MAIN LOOP 85108000 + B EITSTMSK BRANCH TO CONTINUE PROCESSING 85110000 +* THE FOLLOWING INSTRUCTIONS ARE MOVED INTO THE MAIN LOOP 85112000 +* TO MODIFY OR RESTORE CODE AS NEEDED BY THE EX INSTR 85114000 +EIEXMBR B EIEXRET 85116000 +EIEXRSTR IC R2,EICTB2 85118000 + SPACE 2 85120000 +* THIS CODE IS USED TO PERFORM THE M AND D COMMANDS 85122000 +EIMD EQU * 85124000 + STC ROP,EIQMD STORE PROPER OPCODE IN INSTRUCTION 85126000 + LA RWK1,ECREGS(R7) GET ADDRESS OF FAKE REGISTER PAIR 85128000 + L R9,ECREGS+4(R7) GET CONTENTS OF SECOND REG OF PAIR 85130000 +EIQMD M $+R8,0(RAD1) ****OPCODE MOVED DURING EXEC **** 85132000 + STM R8,R9,0(RWK1) RESTORE CHANGED REGS INTO FAKE REGS 85134000 + B EIFIN BRANCH AND RETURN FOR NEXT INSTR 85136000 + SPACE 2 85138000 +* THIS SECTION PROCESSES RX STORE OPERATIONS 85140000 +* (NO CC SETTING) (STH,CVD,STC,ST) 85142000 +EISTORS EQU * 85144000 + STC ROP,EIQSTORS STORE OPCODE IN INSTRUCTION 85146000 +EIQSTORS ST $+R8,0(RAD1) **** OPCODE CHANGED DURING EXEC **** 85148000 + AIF (&$S370 NE 2).EISTORS SKIP IF ON S370 85150000 + BZ EIFIN IF NOT FAKING ALIGNMENT RETURN 85152000 + MVC 0(8,RWK14),EIDUBLWD PUT ALTERED CORE BACK IN PLACE 85154000 +.EISTORS ANOP 85156000 + B EIFIN BRANCH BACK FOR NEXT INSTRUCTION 85158000 + SPACE 2 85160000 +* THIS CODE PROCESSES FLOATING POINT RX INSTRUCTIONS 85162000 + AIF (&$FLOTEX).EIXFPRX SKIP IF WE HAVE EXTENDED FP 85164000 +EIXFPRX EQU EIOC1 NOTE XFP INSTRS NOT ALLOWED 85166000 + AIF (&$FLOTE).EIFPRX GO GEN IF FLOATINGS ARE ALLOWED 85168000 +EIFPRX EQU EIOC1 NOTE FLOATINGS NOT ALLOWED 85170000 +EIFPRXST EQU EIOC1 NOTE FLOATINGS NOT ALLOWED 85172000 + AGO .EIFPRX2 SKIP OVER GENERATION 85174000 +.EIXFPRX ANOP 85176000 +EIXFPRX EQU * 85178000 +.EIFPRX ANOP 85180000 + SPACE 1 85182000 +* THE FLOATING POINT RX INSTRUCTIONS 85184000 +EIFPRX EQU * 85186000 + STC ROP,EIQFPRX STORE OPCODE IN INSTRUCTION 85188000 + SLL R7,2 GET R1 FIELD BACK INTO PLACE 85190000 + STC R7,EIQFPRX+1 STORE R1 FIELD INTO INSTRUCTION ALSO 85192000 + SPM RCC SET THE CONDITION CODE 85194000 +EIQFPRX STD $,0(,RAD1) ** OPCODE AND R1 FIELDS STORED IN ** 85196000 + BAL RCC,EIFIN GET CC AND RETURN FOR NEXT INSTR 85198000 + SPACE 2 85200000 +* CODE FOR FLOATING POINT STORES 85202000 + AIF (&$S370 EQ 2).EIFPRX1 SKIP IF ON A 360 85204000 +EIFPRXST EQU EIFPRX CODE FOR STORES SAME AS OTHERS 85206000 + AGO .EIFPRX2 SKIP AROUND CODE GENERATION 85208000 +.EIFPRX1 ANOP 85210000 + SPACE 2 85212000 +* CODE FOR FLOATING POINT STORES WHEN FAKING ALIGNMENT 85214000 +EIFPRXST EQU * 85216000 + STC ROP,EIQFPRXS STORE OPCODE INTO INSTRUCTION 85218000 + SLL R7,2 GET R1 FIELD BACK 85220000 + STC R7,EIQFPRXS+1 STORE R1 FIELD INTO INSTRUCTION ALSO 85222000 +EIQFPRXS STD $,0(,RAD1) **OPCODE AND R1 FIELDS STORED IN *** 85224000 + BZ EIFIN IN NO ALIGNMENT CHECKING, RETURN 85226000 + MVC 0(8,RWK14),EIDUBLWD PUT ALTERED CORE BACK IN PLACE 85228000 + B EIFIN RETURN 85230000 +.EIFPRX2 ANOP 85232000 + SPACE 2 85234000 + AIF (NOT &$XIOS).EINOXD SKIP IF NO XMACROS 85236000 +* XDECO - EXTENDED DECIMAL OUTPUT INSTRUCTION * 85238000 +* SPECIAL RX INSTRUCTION CONVERTS REGISTER VALUE TO * 85240000 +* EDITED 12 - BYTE DECIMAL FIELD. (X'52' OPCODE) * 85242000 + SPACE 1 85244000 +EIXDECO EQU * 85246000 + XDECO R8,0(RAD1) CONVERT AND MOVE THE VALUE 85248000 + B EIFIN RETURN FOR THE NEXT INSTR 85250000 + SPACE 2 85252000 +* XDECI - EXTENDED DECIMAL INPUT INSTRUCTION * 85254000 +* SPECIAL INPUT CONVERTER, SCANS 1 - 9 DIGITS, SIGNED * 85256000 +* UNSIGNED DECIMAL NUMBERS WITH ANY # OF PRECEDING * 85258000 +* BLANKS. SETS CC TO 0,1,2 ACCORDING TO VALUE OF * 85260000 +* RESULT. CC = ; IF > 9 DIGITS OR 1ST CHARACTER * 85262000 +* NOT +, -, DIGIT, OR + OR - WITHOUT DIGIT FOLLOWING * 85264000 +* OPCODE IS X'53' WITH THE RX FORMAT * 85266000 + SPACE 1 85268000 +EIXDECI EQU * 85270000 + XDECI RWK0,0(RAD1) CONVERT AND SCAN THE VALUE 85272000 + BALR RCC,0 SAVE THE CONDITION CODE 85274000 + BO *+8 SKIP STORE IF VALUE WAS BAD 85276000 + ST RWK0,ECREGS(R7) SAVE THE CONVERTED VALUE IF OK 85278000 + SR RWK1,RMEM DE-RELOCATE THE SCAN PTR VALUE 85280000 + ST R1,ECREG1 PUT SCAN PTR IN USER REG 1 85282000 + B EIFIN RETURN FOR THE NEXT INSTR 85284000 +.EINOXD ANOP 85286000 + AIF (NOT &$XIOS).EICONT SKIP IF NO XMACROS 85288000 + AIF (NOT &$HEXI).EINOHXI SKIP IF NO XHEXI 85290000 + SPACE 2 85292000 +* XHEXI - EXTENDED HEXADECIMAL INPUT INSTRUCTION * 85294000 +* SPECIAL INPUT MACRO, SCANS 1-8 DIGITS . SKIPS LEADING * 85296000 +* BLANKS. SETS CONDITION CODE TO 3 IF ILLEGAL HEX * 85298000 +* CHARACTER IS FOUND. IF GREATER THAN 8 DIGITS FOUND R1 * 85300000 +* POINTS TO THE 9TH ELSE R1 POINTS TO FIRST NON-HEX * 85302000 +* IN STRING. * 85304000 +* OPCODE IS X'61' IN THE RX FORMAT. * 85306000 + SPACE 1 85308000 +EIXHEXI EQU * 85310000 + XHEXI RWK0,0(RAD1) CONVERT AND SCAN VALUE 85312000 + BALR RCC,0 SAVE THE CONDITION CODE 85314000 + BO *+8 SKIP STORE IF VALUE WAS BAD 85316000 + ST RWK0,ECREGS(R7) STORE CONVERTED VLUE IF OK 85318000 + SR RWK1,RMEM DE-RELOCATE SCAN POINTER VALUE 85320000 + ST RWK1,ECREG1 SAVE SCAN POINTER IN USER REG 1 85322000 + B EIFIN RETURN FOR THE NEXT INSTRUCTION 85324000 + AGO .EICKHXO CHECK IF XHEXO ALLOWED 85326000 +.EINOHXI ANOP 85328000 +EIXHEXI EQU EIOC1 NOTE XHEXI NOT ALLOWED -- INVALID OP 85330000 +.EICKHXO AIF (NOT &$HEXO).EINOHXO SKIP IF XHEXO NOT ALLOWED 85332000 + SPACE 2 85334000 +* XHEXO - EXTENDED HEXADECIMAL OUTPUT MACRO * 85336000 +* SPECIAL RX INSTRUCTION CONVERTS REGISTER VALUE TO * 85338000 +* OUTPUT 8 BYTE FORM. OPCODE IS X'62'. * 85340000 + SPACE 2 85342000 +EIXHEXO EQU * 85344000 + XHEXO R8,0(RAD1) CONVERT VALUE AND MOVE TO USER AREA 85346000 + B EIFIN RETURN FOR THE NEXT INSTRUCTION 85348000 + AGO .EICONT 85350000 +.EINOHXO ANOP 85352000 +EIXHEXO EQU EIOC1 NOTE XHEXO INVALID OPCODE 85354000 +.EICONT ANOP 85356000 + TITLE '*** EXECUT - SI PROCESSING ROUTINES' 85358000 +*********************************************************************** 85360000 +* * 85362000 +* SI TYPE INSTRUCTION INTERPRETING SECTION * 85364000 +* * 85366000 +*********************************************************************** 85368000 +* * 85370000 +* SI NORMAL PROCESSING * 85372000 +* (TM,MVI,NI,CLI,OI,XI - OP D(B),I2) * 85374000 + SPACE 2 85376000 +EINORMSI EQU * 85378000 + STC ROP,EIQSI MOVE OPCODE INTO INSTRUCTION 85380000 + STC R7,EIQSI+1 MOVE I2 FIELD INTO INSTRUCTION 85382000 + SPM RCC SET REAL COND-CODE = TO FAKE ONE 85384000 +EIQSI TM 0(RAD1),$ *** OPCODE AND I2 WILL BE MOVED IN** 85386000 + BAL RCC,EIFIN CAPTURE CC, RETURN FOR NEXT INSTR 85388000 + SPACE 1 85390000 +* DIAG - PSEUDO SI INSTRUCTION USED FOR DEBUGGING PURPOSE 85392000 +EIDIAG EQU * 85394000 + MVC ECFLAG2,ECI2 SUPPLY CONTROL FLAG TO BYTE 85396000 + B EIFIN RETURN FOR NEXT INSTRUCTION 85398000 + SPACE 2 85400000 +* THE FOLLOWING ARE THE GROUP OF S360 / S370 PRIVILEGED 85402000 +* OPERATIONS. CONTROL IS PASSED HERE FROM THE MAIN 85404000 +* DECODING LOOP WITH ROP CONTAINING THE OPCODE AND R7 85406000 +* CONTAINING THE FIRST REGISTER OR IMMEDIATE FIELD. AT 85408000 +* THE PRESENT TIME ALL OF THESE INSTRUCTIONS ARE FLAGGED 85410000 +* WITH OC2 EXCEPTIONS. THE HOOKS ARE ALL PROVIDED HOWEVER 85412000 +* FOR THEIR FUTURE IMPLEMENTATION. 85414000 + SPACE 2 85416000 +EILCTL EQU EIOC2 NO PRIVILEGED OPS ALLOWED AT PRESENT 85418000 +EISTCTL EQU EIOC2 NO PRIVILEGED OPS ALLOWED AT PRESENT 85420000 +EIP370 EQU EIOC2 NO PRIVILEGED OPS ALLOWED AT PRESENT 85422000 +EISIO EQU EIOC2 NO PRIVILEGED OPS ALLOWED AT PRESENT 85424000 +EITIO EQU EIOC2 NO PRIVILEGED OPS ALLOWED AT PRESENT 85426000 +EIHIO EQU EIOC2 NO PRIVILEGED OPS ALLOWED AT PRESENT 85428000 +EISSM EQU EIOC2 NO PRIVILEGED OPS ALLOWED AT PRESENT 85430000 +EITCH EQU EIOC2 NO PRIVILEGED OPS ALLOWED AT PRESENT 85432000 +EILPSW EQU EIOC2 NO PRIVILEGED OPS ALLOWED AT PRESENT 85434000 +EIWRD EQU EIOC2 NO PRIVILEGED OPS ALLOWED AT PRESENT 85436000 +EIRDD EQU EIOC2 NO PRIVILEGED OPS ALLOWED AT PRESENT 85438000 + SPACE 2 85440000 + AIF (&$REPL GT 0).EINREPO SKIP IF REPL OPTION ALLOWED 85442000 +EIXREPL EQU EIOC1 NO REPLACEMENT: MAKE ILLEGAL OP 85444000 +.EINREPO AIF (&$REPL EQ 0).EINREPL SKIP IF NO REPLACEMENT ALLOWED 85446000 + SPACE 2 85448000 +* CODE FOR THE XREPL COMMAND 85450000 +EIXREPL EQU * 85452000 + CLI ECI2,0 WAS IT A SET RFLAG TYPE XREPL 85454000 + BH EIXREPL1 NO, SKIP TO NEXT TYPE 85456000 + MVC ECRFLAG,0(RAD1) SET RFLAG FROM USER LOCATION 85458000 + B EIFIN RETURN FOR THE NEXT INSTRUCTION 85460000 + SPACE 1 85462000 +EIXREPL1 CLI ECI2,1 WAS IT A FETCH RFLAG TYPE 85464000 + BH EIXREPL2 O, SKIP TO NEXT TYPE 85466000 + MVC 0(L'ECRFLAG,RAD1),ECRFLAG FETCH THE FLAG TO USER AREA 85468000 + B EIFIN RETURN FOR THE NEXT INSTR 85470000 + SPACE 1 85472000 +EIXREPL2 CLI ECI2,2 WAS IT INSTRUCTION COUNT 85474000 + BH EIXREPL3 NO, GO ON TO NEXT 85476000 + MVC 0(4,RAD1),ECILIMT MOVE TEMP INSTR COUNT OVER 85478000 + B EIFIN RETURN FOR THE NEXT INSTRUCTION 85480000 +EIXREPL3 EQU EIFIN ILLEGAL I2 FIELD IGNORE AND RETURN 85482000 +.EINREPL ANOP 85484000 + TITLE '*** EXECUT - RS PROCESSING ROUTINES' 85486000 +*********************************************************************** 85488000 +* * 85490000 +* RS INSTRUCTION PROCESSING ROUTINES * 85492000 +* * 85494000 +*********************************************************************** 85496000 + SPACE 5 85498000 +* BRANCH ON INDEX (BXH,BXLE) 85500000 +EIRSBX EQU * 85502000 + STC ROP,EIQRSBX STORE OPCODE INTO INSTRUCTION 85504000 + L RWK1,ECREGS+4(R9) GET NEXT REGISTER BEYOND R3 85506000 + LR RWK0,R10 COPY R3 VALUE IN EXPECTED REGISTER 85508000 + TM ECR1R3,X'1' WAS REGISTER ODD 85510000 + BZ EIQRSBX IF EVEN REG,SET UP OK SKIP NEXT INST 85512000 + LR RWK1,RWK0 R3 WAS ODD SO USE SAME VALUE 85514000 +EIQRSBX BXH R8,RWK0,EIRSBX1 **CHANGED TO EITHER BXH-BXLE ******* 85516000 + ST R8,ECREGS(R7) BRANCH FAILED BUT STORE REG BACK 85518000 + B EIFIN RETURN FOR NEXT INSTR 85520000 +EIRSBX1 ST R8,ECREGS(R7) BRANCH SUCCESSFULL BUT RESTORE REG 85522000 + B EIFINB RETURN TO BR'D TO INSTR 85524000 + SPACE 2 85526000 +* LOAD & STORE MULTIPLE (LM,STM) *CODE MAY NOT BE OBVIOUS 85528000 +EILMSTM EQU * 85530000 + AIF (&$S370 NE 2).EILMSTM CHECK IF NOT ON A 370 85532000 + TM ECPRFLG2,ECALNCHK SHOULD ALIGNMENT BE CHECKED 85534000 + BZ *+8 NO ALIGNMENT CHECK BRANCH AROUND 85536000 + L R0,0(RAD1) QUICK CHECK FOR FULL WORD ALIGNMENT 85538000 +.EILMSTM ANOP 85540000 + SLR RAD1,RMEM DE-RELOCATE THE ADDRESS 85542000 + LA RWK0,4(R9) OBTAIN PART 1 OF LENGTH VALUE 85544000 + LR RWK1,RAD1 PUT ADDR TO BE CHECKED WHERE EXPECT 85546000 + CR R7,R9 IS R1 FIELD <= R3 FIELD 85548000 + BNH EILMSTM1 SKIP OVER IF EASY CASE (R1 MOVE TO DO NR 85740000 + BZ 6(,RWK14) IF 0, WE ARE ALL DONE RETURN 85742000 + EX 0,0(,RWK14) PERFORM SUPPLIED OPERATION 85744000 + LA RAD1,1(RAD1) INCERMENT CORE AREA POINTER 85746000 +EIMSKC EQU *+1 POSITION OF MASK CHANGED BY CLM 85748000 + BC $+15,EIMSK1 USUALLY BRANCH TO LOOP (BE FOR CLM) 85750000 + B 6(,RWK14) IF UNEQUAL COMPARE FOR CLM, RETURN 85752000 +.EIMASK3 ANOP 85754000 + TITLE '*** EXECUT - SS PROCESSING ROUTINES' 85756000 +*********************************************************************** 85758000 +* * 85760000 +* SS TYPE INTERPRETING SECTION * 85762000 +* * 85764000 +*********************************************************************** 85766000 + SPACE 5 85768000 +* MOVES,TR,PACK,LOGICALS & DECIMALS (DON'T CHANGE REGS) 85770000 +EIMOVES EQU * 85772000 +EILOGS EQU EIMOVES 85774000 +EIDECS EQU EIMOVES 85776000 + SPM RCC SET REAL CC = FAKE CC 85778000 +EIQSS MVN 0($,RAD1),0(RAD2) ** OPCODE & LENGTH(S) MOVED IN ** 85780000 + BAL RCC,EIFIN RETURN FOR NEXT INSTR 85782000 + SPACE 2 85784000 +* TRT AND EDMK - CHANGE CC & POSSIBLY REGS R1 & R2 85786000 +EITRT EQU * 85788000 +EIEDMK EQU EITRT 85790000 + LM R1,R2,ECREG1 GET FAKE R1 & R2 85792000 + LA R1,0(R1,RMEM) CLEAR UPPER BYTE & RELOCATE 85794000 + EX 0,EIQSS EXECUTE TNE INSTRUCTION 85796000 + BALR RCC,0 SCOOP UP THE CC 85798000 + SLR R1,RMEM CONVERT BACK TO FAKE ADDR 85800000 + AIF (&$S370 NE 1).EITRT1 SKIP IF NOT ON A REAL 370 85802000 + ICM R1,8,ECREG1 GET 1ST BYTE IF FAKE REG1 85804000 + AGO .EITRT2 85806000 +.EITRT1 ANOP 85808000 + XC ECREG1+1(3),ECREG1+1 CLEAR 3 BYTES OF FAKE REG1 85810000 + O R1,ECREG1 GET FAKE REG1 BACK TOGETHER 85812000 +.EITRT2 ANOP 85814000 + STM R1,R2,ECREG1 REPLACE FAKE REGS R1 & R2 85816000 + SR R2,R2 RECLEAR BYTE REG 85818000 + B EIFIN RETURN FOR NEXT INSTR 85820000 + SPACE 2 85822000 +* CODE FOR THE SRP COMMAND (SHIFT AND ROUND) 85824000 +EISRP EQU * 85826000 + SR RAD2,RMEM REMOVE RELOCATION DONE EARLIER 85828000 + IC R2,ECB2D2 GET B2 BASE REG 85830000 + SRA R2,4 REMOVE UNNEEDED BITS 85832000 + AIF (&$S370 NE 1).EISRP1 SKIP IF NOT ON A REAL 370 85834000 + BZ EIDECS BRANCH TO EXECUTE THE INSTRUCTION 85836000 + SLL R2,2 B2 * 4 FOR INDEX 85838000 + S RAD2,ECREGS(R2) DON'T WANT VALUE OF BASE REG 85840000 + B EIDECS BRANCH TO EXECUTE THE INSTRUCTION 85842000 + AGO .EISRP2 85844000 +.EISRP1 ANOP 85846000 + BZ EISRPA NO BASE REG ADDED IN, SKIP OVER 85848000 + SLL R2,2 B2 * 4 FOR INDEX 85850000 + S RAD2,ECREGS(R2) DON'T WANT VALUE OF BASE REG 85852000 +EISRPA EQU * 85854000 + LR R8,R7 COPY LENGTH FIELD OVER 85856000 + SLL R8,4 GET LENGTH * 16 85858000 + OR R8,R7 SET UP REG WITH 2 LENGTHS 85860000 + SPACE 85862000 + MVO EISRPRND(1),ECL1I3(1) MOVE IMMEDIATE OVER 85864000 + ZAP EISRPRND(1),ECL1I3(1) CHECK IMMEDIATE 85866000 + EX R7,EISRPZP1 CHECK USER NUMBER 85868000 + BZ EISRPLF5 IF NUMBER=0, WERE DONE 85870000 + SPACE 85872000 + SLL RAD2,26 EXTEND BIT 26 AS IF 85874000 + SRA RAD2,26 IT IS A SIGN BIT 85876000 + BZ EISRPLF3 IF SHIFT IS ZERO, WERE DONE 85878000 + BP EISRPLF IF SHIFT IS POS, ITS LEFT 85880000 + SPACE 85882000 +* RIGHT SHIFT CODE 85884000 +EISRPRT EQU * 85886000 + LPR RAD2,RAD2 RIGHT SHIFT, GET POS SHIFT 85888000 + B EISRPRT2 BRANCH INTO LOOP 85890000 +EISRPRT1 EQU * 85892000 + MVO EISRPSHF(16),EISRPSHF(15) SHIFT ALL BUT LAST NIBBLE 85894000 +EISRPRT2 EQU * 85896000 + BCT RAD2,EISRPRT1 CONTINUE LOOP (DECMT COUNT) 85898000 + SLL R7,4 SHIFT LENGTH TO L1 FIELD 85900000 + MVN EISRPSHF+15(1),EISRPRND MAKE SIGN POSITIVE 85902000 + AP EISRPSHF(16),EISRPRND(1) ADD IN ROUNDING FACTOR 85904000 + EX R7,EISRPMV1 MOVE TO USER, DOING LAST SHIFT 85906000 + B EISRPLF3 GO TO SET CC AND RETURN 85908000 + SPACE 85910000 +* LEFT SHIFT CODE 85912000 +EISRPLF EQU * 85914000 + STC R8,EISRPLF2+1 PUT LEN INTO MVO INSTR 85916000 + LA RWK1,0(R7,RAD1) GET @ OF LAST BYTE OF USER # 85918000 + OI *+1,0 SET CC = 0 85920000 +EISRPLF1 EQU * 85922000 + BNZ EISRPLF2 IF OVERFLOW HAS OCCURRED, BRANCH 85924000 + TM 0(RAD1),X'F0' CHECK 1ST NIBBLE FOR NON ZERO 85926000 +EISRPLF2 EQU * 85928000 + MVO 0($,RAD1),0($,RAD1) SHIFT LEFT ** LENGTHS STORED IN** 85930000 + MVZ 0(1,RWK1),EISRPPK0 MOVE ZERO TO PROPAGATED SIGN 85932000 + BCT RAD2,EISRPLF1 DECREMENT COUNT AND BRANCH 85934000 + BNZ EISRPLF4 OVERFLOW, BRANCH TO CHECK FOR OCA 85936000 +EISRPLF3 EQU * 85938000 + EX R8,EISRPZP2 SET CC FOR +, - OR 0 85940000 + BAL RCC,EIFIN CAPTURE CC AND RETURN FOR NEXT INSTR 85942000 +EISRPLF4 EQU * 85944000 + TM ECSTCCPM,X'04' CAPTURE MASK BIT 85946000 + BO EIOCA OVERFLOW HAS OCCURRED -- ERROR 85948000 + TM *+1,1 SET CC TO OVERFLOW 85950000 +EISRPLF5 EQU * 85952000 + BAL RCC,EIFIN CAPTURE CC AND RETURN FOR NEXT INSTR 85954000 + SPACE 1 85956000 +EISRPZP1 ZAP EISRPSHF(16),0($,RAD1) CHECK AND MOVE USER # 85958000 +EISRPZP2 ZAP 0($,RAD1),0($,RAD1) SET CC TO +, -, OR 0 85960000 +EISRPMV1 MVO 0($,RAD1),EISRPSHF(15) MOVE BACK TO USER AREA 85962000 + SPACE 1 85964000 +EISRPRND DC PL1'0' AREA FOR SRP ROUNDING FACTOR 85966000 +EISRPSHF DC PL16'0' AREA FOR SHIFTING USER # 85968000 +EISRPPK0 DC PL1'0' USED TO SET SIGN 85970000 +.EISRP2 ANOP 85972000 + SPACE 2 85974000 +* CHECK IF GENERATION OF XIO'S IS ON 85976000 + AIF (&$XIOS).EIXIOS SKIP TO GENERATE CODE IF EXISTS 85978000 +EIXIOS EQU EIOC1 THESE INSTRUCTIONS DO NOT EXIST 85980000 + AGO .EINOXIO 85982000 +.EIXIOS ANOP 85984000 + SPACE 2 85986000 +* PSEUDO RX - SS EXTENDED MNEMONICS - XREAD, XPRNT, XPNCH, IO'S* 85988000 +* PSEUDO DUMP ROUTINE - XDUMP * 85990000 +* ** NOTE ** BECAUSE OF NO-STANDARD ADDRESSING DONE BY THESE * 85992000 +* INSTRUCTIONS, THEY DO THEIR OWN ADDRESS CHECKING AND THUS * 85994000 +* HAVE A PROTECTION BYTE OF X'00' SO THE INITIAL SS SECTION * 85996000 +* DOESN'T STOP THEM. THEY THEN FAKE THE PROTECTION BYTES OF * 85998000 +* EITHER STM (X'C0'-XREAD),OR TM(X'80'-XPRNT,XDUMP,XPNCH). * 86000000 + SPACE 1 86002000 +EIXIOSR ST RIA,EIRIA XDUMPR SHORT CUT L 86004000 +EIXIOS EQU * SECTION FOR X-MACRO I/O INSTRS 86006000 + N RCC,=XL4'3F000000' REMOVE ALL BUT CC - PM BITS 86008000 + AL RCC,EIRIA PUT CC - PM PROG ADDR TOGETHER 86010000 + ST RCC,ECILCMSK STORE RESULTING PSW 86012000 + OI ECILCMSK,X'C0' SET ILC = 3, FOR LENGTH OF X-INST 86014000 + CLI ECOP,X'E1' SEE IF IT WAS A REGS TYPE XDUMP 86016000 + BE EIXDUMPR YES, GO DUMP REGS ONLY 86018000 + SR RAD2,RMEM REMOVE SPERIOUS RELOCATION 86020000 + BNZ EIXLOK LENGTH OK IF NOT ZERO 86022000 + L RAD2,ECREGS GET VALUE OF FAKE ZERO 86024000 +EIXLOK EQU * 86026000 + LR RWK1,RAD2 SAVE THE LENGTH TO BE DONE 86028000 + SRL R7,3 GET MASK VALUE IN PLACE FOR INDEX 86030000 + ALR R7,R7 SHIFT LEFT FOR MULTIPLE OF 2 86032000 + LH R9,EIXIOJ(R7) GET ADDRESS VALUE 86034000 + B EISPEJMP(R9) GO TO RIGHT SECTION OF CODE 86036000 + SPACE 2 86038000 +* XREAD PREUDO INSTRUCTION 86040000 +EIXREAD EQU * 86042000 + TM ECFLAG0,$ECEOF HAS THERE BEEN AN EOF ALREADY 86044000 + BO EIXREOF YES, USER TRYING TO GO PAST 86046000 + $READ 0(RAD1),(RWK1),EIXREOFA ACTUALLY READ A CARD 86048000 + BAL RCC,EIFIN CAPTURE CC AND RETURN FOR NEXT INSTR 86050000 + SPACE 1 86052000 +EIXREOFA OI ECFLAG0,$ECEOF FLAG END OF FILE 86054000 + BAL RCC,EIFIN GET COND CODE AND RETURN 86056000 + SPACE 1 86058000 +EIXREOF MVI ECFLAG1,$ECREADR SHOW READ BEYOND END OF FILE 86060000 + LA R1,EICCREAD SHOW EOF OCCURRED M 86062000 + NI ECPRFLG3,ECNOSPI MAKE SURE SPIE IS OFF FOR SAFETY M 86063000 + B EIITIA GO TO EXIT ROUTINE M 86064000 + SPACE 2 86066000 +* XPRNT PSEUDO INSTRUCTION - PRINT A LINE 86068000 +EIXPRNT EQU * 86070000 + $PRNT 0(RAD1),(RWK1),EIXRECEX PRINT THE LINE 86072000 + B EIFIN RETURN FOR THE NEXT INSTRUCTION 86074000 + SPACE 2 86076000 +* XPNCH PSEUDO INSTRUCTION - PUNCH A CARD 86078000 +EIXPNCH EQU * 86080000 + $PNCH 0(RAD1),(RWK1),EIXRECEX PUNCH THE CARD 86082000 + B EIFIN RETURN FOR NEXT INST 86084000 + SPACE 2 86086000 + AIF (&$XXIOS).EIXIOS1 SKIP IF NOT ALLOWED XGET , XP T 86088000 +* XGET PSEUDO INSTRUCTION INPUT 86090000 +EIXGET EQU * 86092000 + $GET 0(RAD1),(RAD2) DO GET INPUT CEH 86094000 + BAL RCC,EIFIN GET CC AND RETURN 86096000 + SPACE 2 86098000 +* XPUT PSEUDO INSTRUCTION DO OUTPUT 86100000 +EIXPUT EQU * 86102000 + $PUT 0(RAD1),(RAD2) DO PUT OUTPUT CEH 86104000 + BAL RCC,EIFIN GET CC AND RETURN FOR NEXT INSTR 86106000 + AGO .EIXIOS2 SKIP LABEL SAVING 86108000 +.EIXIOS1 ANOP 86110000 +EIXGET EQU EIOC1 MAKE XGET AN ERROR CPP 86112000 +EIXPUT EQU EIOC1 MAKE XPUT AN ERROR CPP 86114000 +.EIXIOS2 ANOP 86116000 + SPACE 2 86118000 +EIXRECHK CLI ECFLAG1,$ECRECEX DID XXXXSNAP SET FLAG? 86120000 + BNE EIFIN NO,SO DON'T BOMB USER OUT 86122000 +EIXRECEX MVI ECFLAG1,$ECRECEX SET RECORDS EXCEEDED FLAG 86124000 +EICNTEXC LA R1,EICCRECE SHOW RECORDS EXCEEDED MESSAGE 86126000 + NI ECPRFLG3,ECNOSPI MAKE SURE SPIE IS OFF FOR SAFETY M 86127000 + B EIITIA GO TO FINISH UP AND RETURN 86128000 + SPACE 2 86130000 +* XDUMP PSEUDO INSTRUCTION - DUMP STORAGE AND REGISTERS 86132000 +EIXDUMP EQU * ENTRY LABEL FOR STORAGE XDUMP 86134000 + LR R10,REC MOVE ECONTROL POINTER FOR XXXXSNAP 86136000 + XSNAP T=(NO,,1),LABEL='USER STORAGE',STORAGE=(*0(RAD1),*0(RWK1X86138000 + ,RAD1)) 86140000 + B EIXRECHK GO CHECK FOR RECORD OVERFLOW 86142000 + SPACE 2 86144000 +EIXDUMPR EQU * 86146000 + LR R10,REC MOVE ECONTROL POINTER FOR XXXXSNAP 86148000 + XSNAP T=(PR,,1),LABEL='USER REGISTERS' 86150000 + B EIXRECHK GO CHECK FOR RECORD OVERFLOW 86152000 + SPACE 2 86154000 +* XLIMD PSEUDO INSTRUCTION -- LIMIT DUMP AREA 86156000 +EIXLIMD EQU * 86158000 + LA RAD2,0(RWK1,RAD1) GET SECOND LIMIT REAL ADDRESS 86160000 + BCT RWK1,*+8 IF RWK1=1 (OMITTED) USE END OF PROG 86162000 + L RAD2,ECRADH LENGTH=1 USE HIGHEST @ INSTEAD 86164000 + ST RAD1,ECRDLIML ECRDLIML - ECRDLIMH - NEW LIMITS 86166000 + ST RAD2,ECRDLIML+4 STORE NEW LIMITS 86168000 + B EIFIN RETURN FOR NEXT INSTRUCTION 86170000 + EJECT 86172000 +* THE FOLLOWING CODE INTERPRETS THE XOPC PSEUDO INSTRS 86174000 + SPACE 5 86176000 +* CHECK IF LEGAL CODE # IS SPECIFIED IN THE IMMED FIELD 86178000 +* OF THE INSTR -- IF OK, BRANCH TO INDIVIDUAL XOPC 86180000 +* ROUTINES. 86182000 +EIXOPC EQU * 86184000 + C R7,=A(EC#XOPC) IS CODE # LEGAL ? 86186000 + BNH EIXOPCOK YES, BR AROUND ERROR CODE 86188000 + TM *+1,1 SET CC = 3 TO NOTE ERROR 86190000 + BAL RCC,EIFINRR GET CC, FETCH NEXT INSTR 86192000 +EIXOPCOK EQU * 86194000 + LR RWK1,R7 COPY CODE # FOR OFFSET INDEX 86196000 + ALR RWK1,RWK1 GET INDEX INTO OFFSET TABLE 86198000 + LH RWK1,EIOPCJMP(RWK1) GET BRANCH OFFSET TO ROUTINE 86200000 + B EIXOPC(RWK1) BRANCH TO ROUTINE 86202000 + SPACE 5 86204000 +* THE FOLLOWING CODE PROCESSES THE INDIVIDUAL XOPC 86206000 +* PSEUDO INSTRUCTIONS 86208000 + SPACE 2 86210000 +* XOPC 0 (SET UP PSEUDO SPIE) 86212000 +EIOPC0 EQU * 86214000 + L RWK1,ECREG1 GET USER SPECIFIED EXIT @ 86216000 + LA RWK0,1 ASSUME LENGTH-1 = 1 86218000 + BAL RLINK,EIXOPCHK CHECK GIVEN ADDRESS FOR CORRECTNESS 86220000 + ST RWK1,ECPRSPIE SET USER SPIE EXIT ADDR 86222000 + MVC ECPRSCDE(4),ECREG0 SET USER SPIE CODE MASK 86224000 + OI ECPRFLG3,B'10000000' TURN ON FLAG NOTE SPIE IS SET 86226000 + B EIXOPCC0 BRANCH TO COMMON XOPC EXIT CODE 86228000 + SPACE 2 86230000 +* INSTRUCTION TRACE XOPC INSTRUCTIONS 86232000 +* 86234000 +* CHECK AND SET LIMIT ADDRESSES FOR TRACE 86236000 +EIOPC1 EQU * 86238000 +EIOPC3 EQU EIOPC1 86240000 + LM RWK0,RWK1,ECREGS GET LOW AND HIGH ADDRS FOR TRACE 86242000 + CR RWK0,RWK1 ARE ADDRESSES RELATIVELY CORRECT ? 86244000 + BNL EIXOPCC1 BRANCH IF NOT 86246000 + BAL RLINK,EIXOPCHA CHECK ADDRESSES FOR LEGALITY 86248000 + STM RWK0,RWK1,ECPRTRAL SET TRACE ADDRESS LIMITS IN PRCB 86250000 + BCTR R7,0 XOPC CODE# = CODE#-1 86252000 + LTR R7,R7 IS CODE = 1 (R7 = 0) ? 86254000 + BZ EIXOPCC0 YES, DOING XOPC 1 - FINISHED 86256000 +* TURN ON INSTRUCTION TRACE FACILITY 86258000 +EIOPC2 EQU * 86260000 + OI ECPRFLG1,ECPRTRCE TURN ON TRACE FACILITY 86262000 + B EIXOPCC0 BRANCH TO COMMON XOPC EXIT CODE 86264000 +* TURN OFF INSTRUCTION TRACE FACILITY 86266000 +EIOPC4 EQU * 86268000 + NI ECPRFLG1,255-ECPRTRCE TURN OFF TRACE FACILITY 86270000 + B EIXOPCC0 BRANCH TO COMMON XOPC EXIT CODE 86272000 + SPACE 2 86274000 +* STORAGE MODIFICATION CHECK XOPC INSTRUCTIONS 86276000 +* 86278000 +* CHECK AND SET LIMIT ADDRESSES FOR MOD CHECK 86280000 +EIOPC5 EQU * 86282000 +EIOPC7 EQU EIOPC5 86284000 + LM RWK0,RWK1,ECREGS GET LOW AND HIGH ADDRS FOR MOD CHK 86286000 + CR RWK0,RWK1 ARE ADDRS RELATIVELY CORRECT ? 86288000 + BNL EIXOPCC1 BRANCH IF NOT 86290000 + BAL RLINK,EIXOPCHA CHECK IF ADDRESSES ARE LEGAL 86292000 + STM RWK0,RWK1,ECPRMODL SET MOD CHECK ADDRESSES 86294000 + LA RWK1,5 LOAD CODE # COMPARATOR 86296000 + CR R7,RWK1 IS THIS AN XOPC 5 INSTR ? 86298000 + BE EIXOPCC0 YES - FINISHED 86300000 +* TURN ON MODIFICATION CHECK FACILITY 86302000 +EIOPC6 EQU * 86304000 + OI ECPRFLG1,ECPRMODC TURN ON MOD CHECKING 86306000 + B EIXOPCC0 BRANCH TO COMMON XOPC EXIT CODE 86308000 +* TURN OFF MODIFICATION CHECKING FACILITY 86310000 +EIOPC8 EQU * 86312000 + NI ECPRFLG1,255-ECPRMODC TURN OFF MOD CHECKING 86314000 + B EIXOPCC0 BRANCH TO COMMON XOPC EXIT CODE 86316000 + SPACE 2 86318000 +* TURN ON ALIGNMENT CHECKING (360 STYLE) 86320000 +* (OC-6 ALIGNMENT INTERRUPTS ALLOWED) 86322000 +EIOPC9 EQU * 86324000 + OI ECPRFLG2,ECALNCHK TURN ON CHECKING 86326000 + B EIXOPCC0 BRANCH TO COMMON XOPC EXIT CODE 86328000 +* TURN OFF ALIGNMENT CHECKING (370 STYLE) 86330000 +* (OC-6 ALIGNMENT INTERRUPTS NOT ALLOWED) 86332000 +EIOPC10 EQU * 86334000 + NI ECPRFLG2,255-ECALNCHK TURN OFF CHECKING 86336000 + B EIXOPCC0 BRANCH TO COMMON XOPC EXIT CODE 86338000 + SPACE 2 86340000 +* XOPC 11 (FETCH INSTRUCTION COUNT) 86342000 +EIOPC11 EQU * 86344000 + MVC ECREG0(4),ECILIMT PUT COUNT IN USER REG 0 86346000 + B EIXOPCC0 BRANCH TO COMMON XOPC EXIT CODE 86348000 + SPACE 2 86350000 +* XOPC 12 - EMULATE SYSTEM 360 86352000 +EIOPC12 EQU * 86354000 + NI ECPRFLG2,B'11110011' SHUT OFF ALL EMULATION BITS 86355000 + OI ECPRFLG2,ECEM360 SHOW NOW EMULATING A 360 86355500 + MVI EITSTMSK+1,ECEM360 SET TM INSTR FOR NO 370 INSTRS 86356000 + B EIXOPCC0 BRANCH TO COMMON XOPC EXIT CODE 86358000 + SPACE 2 86360000 +* XOPC 13 - EMULATE SYSTEM 370 86362000 +EIOPC13 EQU * 86364000 + NI ECPRFLG2,B'11110011' SHUT OFF ALLL EMULATION BITS 86365000 + OI ECPRFLG2,ECEM370 SHOW NOW EMULATING A 370 86365500 + MVI EITSTMSK+1,ECEM370 SET TM INSTR FOR BOTH 370 AND 360 86366000 + B EIXOPCC0 BRANCH TO COMMON XOPC EXIT CODE 86368000 + SPACE 2 86520000 +* XOPC 14 - SET INTERRUPT COUNT 86522000 +EIOPC14 EQU * 86524000 + MVC ECPRCMPR(4),ECREG0 MOVE GIVEN VALUE TO PRCB 86526000 + B EIXOPCC0 BRANCH TO COMMON EXIT CODE 86528000 + SPACE 2 86530000 +* XOPC 15 - SET COUNT EXIT ADDRESS 86532000 +EIOPC15 EQU * 86534000 + MVC ECPRCLEA(4),ECREG0 MOVE GIVEN EXIT ADDRESS PRCB 86536000 + OI ECPRFLG4,ECLKADR TURN ON FLAG TO NOTE CLOCK EXIT ADDR 86537000 + B EIXOPCC0 BRANCH TO COMMON EXIT CODE 86538000 + SPACE 3 86538100 +* INSTRUCTION EXECUTION COUNT FACILITY INSTRUCTIONS 86538105 +* 86538110 +* XOPC 17 AND XOPC 18 86538112 +* CHECK AND SET LIMIT ADDRESSES FOR COUNT FACILITY 86538115 +EIOPC17 EQU * 86538120 +EIOPC18 EQU * 86538125 + LM RWK0,RWK1,ECREGS GET LOW AND HIGH ADDRS FOR COUNT 86538135 + CR RWK0,RWK1 ARE ADDRESSES RELATIVELY CORRECT ? 86538140 + BNL EIXOPCC1 BRANCH IF NOT SET CC = 1 86538145 + BAL RLINK,EIXOPCHA CHECK ADDRESSES FOR LEGALITY 86538150 + STM RWK0,RWK1,ECPRICL SET COUNT LIMIT ADDRESSES IN PRCB 86538155 + CLI R7,X'11' IS XOPC CODE 17 OR 18? 86538160 + BE EIXOPCC0 IS 17, SO FINISHED 86538165 + SPACE 3 86538167 +* TURN ON THE INSTRUCTION EXECUTION COUNT FACILITY 86538170 +EIOPC16 EQU * 86538180 + TM ECPRFLG1,ECPRNOSP TEST PRCB FOR NO COUNTING SPACE AVAL 86538190 + BO EIXOPCC1 NO SPACE AVAILABLE, QUIT 86538200 + TM ECPRFLG1,ECPRCTON HAS SPACE FOR COUNT ALREADY ALLOCED 86538210 + BO EINOALL SPACE ALREADY ALLOCATED 86538220 + L RWK0,ECFADH GET HIGH PROG ADDR IN REG 0 86538230 + S RWK0,ECFADL SUBTRACT TO FIND CORE LENGTH NEEDED 86538240 + LA R9,ECPRICA GET ADDR IECF AREAS IN ECONTROL 86538270 + GETMAIN EC,LV=(0),A=(R9),SP=1 TRY GET LENGTH USER PROG 86538280 + LTR R15,R15 TEST TO SEE IF WE GOT WHAT WE NEEDED 86538290 + BZ EISPCOK IF CC=0, WE GOT WHAT WE NEEDED 86538300 + OI ECPRFLG1,ECPRNOSP IF NOT, NOT ENOUGH SPACE - SET FLAG. 86538310 + B EIXOPCC1 AND QUIT. 86538320 +EISPCOK EQU * 86538330 + ST RWK0,ECPRICAL GOT AMOUNT NEEDED STORE LENGTH 86538335 + OI ECPRFLG1,ECPRCTON NOTE ALLOCATION OF COUNTER SPACE 86538340 +EINOALL EQU * 86538350 + OI ECPRFLG1,ECPRIECF NOTE THAT THE COUNT FACILITY IS ON 86538360 + B EIXOPCC0 BRANCH TO COMMON XOPC RETURN CODE 86538370 + SPACE 3 86538375 +* XOPC 19 86538377 +* TURN OFF THE INSTRUCTION EXECUTION COUNT FACILITY 86538380 +EIOPC19 EQU * 86538390 + NI ECPRFLG1,255-ECPRIECF TURN OFF THE COUNT FACILITY FLAG 86538400 + B EIXOPCC0 BRANCH TO COMMON XOPC RETURN CODE 86538410 + SPACE 3 86538415 +* XOPC 20 86538417 +* CLEAR INSTRUCTION EXECUTION COUNT FACILITY COUNT AREAS 86538420 +EIOPC20 EQU * 86538430 + TM ECPRFLG1,ECPRCTON TEST FOR COUNT SPACE ALLOCATION 86538440 + BNO EIXOPCC1 IF NOT ALLOCATED, CANNOT CLEAR IT 86538450 + L RWK1,ECPRICA GET ADDRESS OF CORE TO BE CLEARED 86538460 + L R9,ECPRICAL GET LENGTH OF CORE TO BE CLEARED 86538470 + BCTR R9,0 GET LENGTH IN WORKABLE FORM 86538480 + C R9,=XL4'000000FF' IS LENGTH > 256 BYTES 86538490 + BNH EIREMAIN IF NOT > 256 BYTES CLEAR USING EX 86538500 + XR R8,R8 ZERO OUT R8 FOR DIVIDE 86538505 + D R8,=XL4'00000100' DIVIDE LEN BY 256 GIVING REMAINDER 86538510 +EIOPCLP EQU * 86538520 + XC 0(256,RWK1),0(RWK1) ZERO OUT 256 BYTE AREA 86538530 + LA RWK1,256(RWK1) MOVE ADDRESS POINTER OVER 86538540 + BCT R9,EIOPCLP GO BACK AND GET NEXT 256 BYTE AREA 86538550 + LTR R9,R8 PUT REMNDR WHERE NEEDED BY EXECUTE 86538560 + BZ EIXOPCC0 IF REMAINDER IS 0 WE ARE DONE 86538570 +EIREMAIN EQU * 86538580 + EX R9,EIXOPCXC EXECUTE XC TO DO REMAINING BYTES 86538590 + B EIXOPCC0 BRANCH TO COMMON XOPC EXIT CODE 86538600 +EIXOPCXC XC 0(0,RWK1),0(RWK1) ZERO OUT REMAINING BYTES IN COUNT 86538610 + SPACE 3 86538615 +* XOPC 21 (RETURN FROM INTERRUPT HANDLING STATE) 86540000 +EIOPC21 EQU * 86542000 + TM ECPRFLG3,ECINHDST TEST SEE IF IN INTERRUPT HANDLING 86544000 + BO EIOPC21A IF WE ARE CONTINUE XOPC INSTR 86546000 + TM *,X'FF' SET CC=1 TO DENOTE ERROR 86548000 + BAL RCC,EIFINRR GET CC, FETCH NEXT INSTR 86550000 +EIOPC21A EQU * 86552000 + L RIA,ECREG1 GET RESUMING ADDR FROM USER REG 1 86554000 + MVC ECREG0(8),ECPRIRGS RELOAD USER REGISTERS 0 AND 1 86556000 + NI ECPRFLG3,B'10111111' TURN OFF INTERRUPT HANDLING FLAG 86558000 + SR RWK1,RWK1 SET CC = 0 TO NOTE OKAY EXEC 86560000 + BAL RCC,EIFINB GET NEXT INSTR TREAT XOPC 21 AS BR 86560050 + SPACE 5 86560060 +* XOPC 22 - DUMP INSTRUCTION EXECUTION COUNT STATISTICS 86560070 + SPACE 2 86560075 +* THIS SECTION PRINTS THE STATISTICAL REPORT FOR THE 86560080 +* INSTRUCTION EXECUTION COUNT FACILITY. DUE TO THE TABLE 86560081 +* DESIGN OF IECF, MANY POINTERS ARE USED AND REGISTER 86560082 +* USAGE DIFFERS A LITTLE FROM THAT IN THE REST OF THE 86560083 +* EXTENDED INTERPRETER. REGISTER USAGE IN THIS SECTION IS 86560084 +* AS FOLLOWS: RWK0 - GENERAL WORK REGISTER 86560085 +* RWK1 - OFFSET POINTER IN COUNT TABLE 86560086 +* R7 - GENERAL WORK REGISTER 86560087 +* R8 - THE CURRENT INSTRUCTION COUNT 86560088 +* R9 - BASE ADDRESS OF COUNTING AREA 86560089 +* R10 - BASE ADDRESS OF USER PROGRAM AREA 86560090 +* RWK14 - CURRENT PROGRAM RELATIVE ADDRESS 86560091 +* BEING INSPECTED 86560092 +* IT SHOULD BE NOTED THAT THIS SECTION IS VERY INSTRUCTION 86560093 +* LENGTH DEPENDENT. ANY NEW INSTRUCTION DIFFERING IN THE 86560094 +* TRADITIONAL LENGTH CODES WILL DRASTICALLY EFFECT THIS 86560095 +* SECTION. 86560096 + SPACE 3 86560097 +EIOPC22 EQU * 86560100 + TM ECPRFLG1,ECPRCTON TEST COUNT SPACE ALLOCATION 86560120 + BNO EIXOPCC1 IF NEVER ALLOCATED CANNOT DUMP IT 86560130 + L RWK1,ECFADL GET FAKE BEGIN INSTR ADDR 86560140 + LA R10,0(RMEM,RWK1) GET PHYSICAL REAL STARTING INSTR ADR 86560150 + L RWK1,ECPRICL GET BEGINNING COUNTABLE FAKE INSTR 86560155 + ST RWK1,EISAV22 SAVE FIST OFFSET AS BEG LOOP ADDR 86560160 + LR RWK14,RWK1 SAVE FIRST ADDR FOR LATER USE 86560165 + S RWK1,ECFADL SET OFFSET POINTER AT BEG 86560170 + SR R8,R8 ZERO OUT COUNT SAVING REGISTER 86560180 + L R9,ECPRICA GET STARTING ADDRESS OF COUNT SPACE 86560190 + SPACE 2 86560195 +EILOP22 EQU * 86560200 + CH R8,0(RWK1,R9) IS THE NEW COUNT THE SAME AS OLD? 86560210 + BE EIMVPNTR IF SAME, MOVE POINTER OVER 86560220 + SPACE 2 86560225 +* THIS SECTION ACTUALLY PRINTS THE STATISTICS LINE 86560230 + LTR R8,R8 WAS THE OLD COUNT ZERO? 86560240 + BZ EINEWCT IF OLD WAS ZERO, JUST SAVE & RETURN 86560250 + L RWK0,EIEND22 GET ENDING ADDR OF THIS LOOP 86560260 + XHEXO RWK0,EISTEND CONVERT ENDING ADDR TO HEX 86560270 + L RWK0,EISAV22 SET BEGINNING ADDR OF THIS LOOP 86560280 + XHEXO RWK0,EISTBEG CONVERT BEGINNING ADDR TO HEX 86560290 + XDECO R8,EISTCNT CONVERT INSTR COUNT TO DECIMAL 86560300 + MVC EISTBEG(2),EISTBLK BLANK OUT FIRST TWO BYTES OF ADDR 86560310 + MVC EISTEND(2),EISTBLK BLANK OUT FIRST TWO BYTES OF ADDR 86560320 + $PRNT EISTMSG,EISTMSGL,EICNTEXC PRINT STATISTICAL LINE 86560330 + SPACE 2 86560335 +EINEWCT EQU * 86560340 + ST RWK14,EISAV22 SAVE BEGINNING LOOP ADDRESS 86560350 + LH R8,0(RWK1,R9) REPLACE OLD COUNT WITH NEW 86560360 + SPACE 2 86560365 +EIMVPNTR EQU * 86560370 + ST RWK14,EIEND22 SAVE ENDING LOOP ADDRESS 86560380 + LTR R8,R8 TEST FOR ZERO COUNT 86560390 + BZ EIRR22 ASSUME 2 BYTE LENGTH INSTRS ON H-WRD 86560400 + LA R7,0(RWK1,R10) GET ADDRESS OPCODE OF PRES INSTR 86560410 + TM 0(R7),X'C0' TEST OPCODE FOR LENGTH 86560420 + BM EIRXSI22 BRANCH IF LENGTH EQUAL 4 86560430 + BO EISS22 BRANCH IF AN SS INSTR LENGTH = 6 86560440 + SPACE 2 86560445 +EIRR22 EQU * 86560450 + LA RWK1,2(RWK1) LENGTH = 2 INCERMENT AND CHECK DONE 86560460 + B EICHK22 BRANCH CHECK IF DONE 86560470 + SPACE 2 86560475 +EIRXSI22 EQU * RX OR SI THEN LENGTH =4 86560480 + LA RWK1,4(RWK1) LENGTH = 4 INCERMENT AND CHECK 86560490 + B EICHK22 CHECK FOR FINISHED 86560500 + SPACE 2 86560503 +EISS22 EQU * LENGTH = 6 86560505 + LA RWK1,6(RWK1) INCERMENT OFFSET AND CHECK 86560510 +EICHK22 EQU * 86560520 + LR RWK14,RWK1 MOVE OFFSET FOR ADDR CALCULATION 86560530 + A RWK14,ECFADL ADD TO GET NEW USER PROGRAM ADDR 86560540 + C RWK14,ECPRICH TEST TO SEE IF OUT OF COUNTING RANGE 86560550 + BL EILOP22 IF NOT OUT OF RANGE CONTINUE 86560560 + LTR R8,R8 IF FINISHED CHECK LAST COUNT 86560570 + BZ EIXOPCC0 IF ZERO, DONE, BRANCH COMMON CODE 86560580 + L RWK0,EIEND22 GET LAST ENDING ADDRESS 86560590 + SPACE 2 86560592 +* THIS SECTION PRINTS THE LAST STATISTICS LINE 86560595 + XHEXO RWK0,EISTEND CONVERT ENDING ADDRESS TO HEX 86560600 + L RWK0,EISAV22 SET BEGINNING ADDR OF THIS LOOP 86560610 + XHEXO RWK0,EISTBEG CONVERT BEGINNING ADDRESS TO HEX 86560620 + XDECO R8,EISTCNT CONVERT INSTR "OUNT TO DECIMAL 86560630 + MVC EISTBEG(2),EISTBLK BLANK OUT FORST TWO BYTES OF ADDR 86560640 + MVC EISTEND(2),EISTBLK BLANK OUT FIRST TWO BYTES OF ADDR 86560650 + $PRNT EISTMSG,EISTMSGL,EICNTEXC PRINT STATISTICAL LINE 86560660 + B EIXOPCC0 BRANCH TO COMMON XOPC EXIT CODE 86560670 + SPACE 2 86560675 +EISTMSG DC C' STATS--> BEGIN ADDR:' STATISTICS MESSAGE 86560680 +EISTBEG DC 8C' ' STATS MESSAGE 86560690 + DC C' END ADDR:' STATS MESSAGE 86560700 +EISTEND DC 8C' ' STATS MESSAGE 86560710 + DC C' INSTRUCTION COUNT:' STATS MESSAGE 86560720 +EISTCNT DC 12C' ' STATS MESSAGE 86560730 +EISTMSGL EQU *-EISTMSG LENGTH OF STATISTICAL MESSAGE 86560740 +EISTBLK DC 2C' ' BLANK AREA 86560750 +EIEND22 DS F ENDING LOOP ADDRESS 86560760 +EISAV22 DS F BEGINNING LOOP ADDRESS 86560770 + SPACE 2 86562000 +* THIS IS THE XOPC COMMON EXIT CODE 86564000 +EIXOPCC0 EQU * 86566000 + SR RWK1,RWK1 SET CC=0 NOTE OK EXECUTION 86568000 + BAL RCC,EIFINRR BRANCH BACK AND FETCH NEXT INSTR 86569000 + SPACE 2 86570000 +* THIS IS THE XOPC EXIT CODE FOR CC = 1 86571000 +EIXOPCC1 EQU * 86571050 + O RWK1,=XL4'11' SET CC=1 TO NOTE USER ERROR 86571100 + BAL RCC,EIFINRR GET CC AND BRANCH TO FETCH NXT INSTR 86571200 + SPACE 3 86571300 +**--> INSUB: EIBASDSP CALCULATE BASE/DISPLACEMENT + + + + + + + + 86572000 +*+ + 86574000 +*+ ENTRY CONDS: + 86576000 +*+ RWK0 - MUST CONTAIN THE APPROPRIATE HALFWORD OF THE + 86578000 +*+ INSTRUCTION + 86580000 +*+ EXIT CONDS: + 86582000 +*+ RWK0 - CONTAINS THE CALCULATED RELATIVE ADDRESS + 86584000 +*+ (NOT RELOCATED FOR ASSIST) + 86586000 +*+ RWK1 - CONTENTS ARE DESTROYED + 86588000 +*+ + 86590000 +*++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 86592000 + SPACE 2 86594000 +EIBASDSP EQU * 86596000 + LR RWK1,RWK0 COPY B/D OVER 86598000 + N RWK0,=XL4'FFF' REMOVE BASE, LEAVING DISP 86600000 + N RWK1,=XL4'F000' REMOVE DISP, LEAVING BASE 86602000 + BCR Z,RLINK IF NO BASE, RETURN 86604000 + SRL RWK1,10 MULT BASE REG BY 4 FOR INDEX 86606000 + AL RWK0,ECREGS(RWK1) ADD IN BASE REG'S VALUE 86608000 + N RWK0,EILONGMK ZERO OUT HIGH ORDER BYTE 86610000 + BR RLINK RETURN TO CALLER 86612000 + SPACE 5 86614000 +**--> INSUB: EIMSFCHK MODIFICATION & RANGE CHECKING ROUTINE + + + 86616000 +*+ + 86618000 +*+ THIS ROUTINE CHECKS THE ADDRESS IN RWK1 FOR BEING WITHIN + 86620000 +*+ THE ALLOWABLE RANGE. MODIFICATION CHECKING IS ALSO + 86622000 +*+ PERFORMED IF THE INSTRUCTION MODIFIES STORAGE. + 86624000 +*+ + 86626000 +*+ ENTRY CONDS: + 86628000 +*+ RWK1 - CONTAINS THE ADDRESS TO BE CHECKED + 86630000 +*+ RWK0 - CONTAINS THE LENGTH OF STORAGE AFFECTED + 86632000 +*+ RLINK - CONTAINS THE RETURN ADDRESS + 86634000 +*+ EIWORK - IS A STORAGE AREA THAT MUST CONTAIN THE CONTROL + 86636000 +*+ BYTE EICTB3 (SHIFTED LEFT 2 BITS IF 2ND OPRND) + 86638000 +*+ EXIT CONDS: + 86640000 +*+ RWK0 - IS DESTROYED + 86642000 +*+ RWK1 - IS DESTROYED + 86644000 +*+ + 86646000 +*++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 86648000 + SPACE 2 86650000 +EIMSFCHK EQU * 86652000 +* DETERMINE WHAT CHECKING TO PERFORM 86654000 + BCTR RWK0,0 RWK0 CONTAINS LENGTH-1 86656000 + ALR RWK0,RWK1 GET @ OF HIGHEST BYTE ACCESSED 86658000 + TM EIWORK,EI1STORE WHAT CHECKING IS TO BE DONE ? 86660000 + BCR Z,RLINK RETURN IF NO CHECKING 86662000 + BO EISTRCHK BRANCH TO DO STORE CHECKING 86664000 +* PERFORM FETCH CHECKING 86666000 + TM ECFLAG0,$ECPROT IS ABSOLUTE PROTECT MODE ON ? 86668000 + BCR Z,RLINK RETURN IF NOT 86670000 +EIFTHCHK EQU * 86672000 + C RWK1,ECFADL IS BEGINNING @ TOO LOW ? 86674000 + BL EIOC4 YES, SO ERROR 86676000 + C RWK0,ECFADH IS ENDING @ TOO HIGH ? 86678000 + BCR L,RLINK RETURN IF NOT (ADDR IS OK) 86680000 + B EIOC4 @ IS TOO HIGH, SO ERROR 86682000 +* PERFORM STORE CHECKING 86684000 +EISTRCHK EQU * 86686000 + C RWK1,ECFADL IS BEGINNING @ TOO LOW ? 86688000 + BL EIOC4 YES, SO ERROR 86690000 + C RWK0,ECFADH IS ENDING @ TOO HIGH ? 86692000 + BH EIOC4 YES, SO ERROR 86694000 +* PERFORM MODIFICATION CHECKING 86696000 + TM ECPRFLG1,ECPRMODC IS MOD CHECK OPTION ON ? 86698000 + BCR Z,RLINK NO, SO RETURN TO CALLER 86700000 + C RWK1,ECPRMODH IS BEGINNING @ HIGHER THAN CHK AREA? 86702000 + BCR H,RLINK RETURN IF YES 86704000 + C RWK0,ECPRMODL IS ENDING @ LOWER THAN CHECK AREA ? 86706000 + BCR L,RLINK RETURN IF YES 86708000 +* IF HERE, THE INSTRUCTION MODIFIES STORAGE WITHIN THE 86710000 +* CHECKING AREA. PERTINENT INFORMATION IS PRINTED FOR THE 86712000 +* USER PROGRAMMER. 86714000 + XHEXO RWK0,EICKHIGH CONVERT HIGH @ TO HEX FOR PRINTING 86716000 + MVC EICKHIGH(2),EIBLANKS BLANK OUT 1ST 2 DIGITS 86718000 + XHEXO RWK1,EICKLOW CONVERT LOW @ TO HEX FOR PRINTING 86720000 + MVC EICKLOW(2),EIBLANKS BLANK OUT 1ST 2 DIGITS 86722000 + L RWK1,ECSTIADD GET INSTRUCTION ADDR 86724000 + XHEXO RWK1,EICKINAD CONVERT INSTR ADDR TO HEX FOR PRNT 86726000 + MVC EICKINAD(2),EIBLANKS BLANK OUT 1ST 2 DIGITS 86728000 + MVC EICKINST+4(10),EIBLANKS BLANK OUT INSTR AREA 86730000 + LM RWK0,RWK1,ECSTCCPM FETCH INSTR FROM INSTR STACK 86732000 + SLDL R0,16 RR AND RX CODE IN REG 0 86734000 + XHEXO RWK0,EIWORK CONVERT 1ST 4 BYTES TO HEX 86736000 + TM ECSTINST,EISSINST IS THISAN SS INSTR ? 86738000 + BNO EINOTSSI BRANCH IF NOT 86740000 + XHEXO RWK1,EIWORK+8 CONVERT LAST 2 BYTES TO HEX 86742000 +EINOTSSI EQU * 86744000 + LA RWK1,EICKINST GET @ OF THE HEX INSTR 86746000 + BAL R2,EIMOVINS MOVE HEX INSTR TO PRINT FORMAT 86748000 + $PRNT EICHKMSG,EICHKMSL,EICNTEXC PRINT INSTR FOR MOD CHK, X86750000 + BR OUT IF COUNT EXCEEDED 86752000 + BR RLINK RETURN TO CALLER 86754000 +* THE FOLLOWING STORAGE IS USED AS A PRINT FORMAT AREA BY 86756000 +* THE MODIFICATION CHECK FACILITY 86758000 +EICHKMSG DC C' CHECK--> INSTR ADDR:' 86760000 +EICKINAD DC 8C' ' 86762000 + DC C' INSTR: ' 86764000 +EICKINST DC 14C' ' 86766000 + DC C' MODIFICATION LIMIT ADDRS--> LOW:' 86768000 +EICKLOW DC 8C' ' 86770000 + DC C' HIGH:' 86772000 +EICKHIGH DC 8C' ' 86774000 +EICHKMSL EQU *-EICHKMSG LENGTH OF PRINT MESSAGE 86776000 + SPACE 5 86778000 +**--> INSUB: EIMOVINS MOVE HEX INSTR TO PRINT FORMAT + + + + + + + 86780000 +*+ + 86782000 +*+ THIS INSUB MOVES A HEXIDECIMAL INSTRUCTION TO A + 86784000 +*+ SPECIFIED AREA WITH BLANKS INSERTED TO RESEMBLE + 86786000 +*+ SOURCE CODE LISTING FORMAT. + 86788000 +*+ + 86790000 +*+ ENTRY CONDS: + 86792000 +*+ RWK1 - CONTAINS THE TARGET ADDRESS FOR THE MOVE + 86794000 +*+ R2 - USED AS THE BAL LINK REG + 86796000 +*+ EIWORK- ASSUMED TO BE THE FETCH AREA FOR THE MOVE + 86798000 +*+ EXIT CONDS: + 86800000 +*+ R2 - IS RE-CLEARED AS A BYTE REG + 86802000 +*+ RWK0 & + 86804000 +*+ RWK1 - CONTENTS DESTROYED + 86806000 +*+ + 86808000 +*++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 86810000 + SPACE 2 86812000 +EIMOVINS DS 0H 86814000 + ST R2,EIMOVSAV SAVE RETURN ADDR 86816000 + SR RWK0,RWK0 CLEAR LOOP COUNTER REG 86818000 + IC RWK0,EICTB2 GET INSTR LEN FOR LOOP COUNT 86820000 + SRL RWK0,1 DIVIDE LENGTH BY 2 FOR LOOP CTR 86822000 + LA R2,EIWORK GET @ OF FETCH AREA 86824000 +EIMOVEIN EQU * 86826000 + MVC 0(4,RWK1),0(R2) MOVE 4 HEX BYTES 86828000 + LA RWK1,5(RWK1) INCREMENT TARGET ADDRESS 86830000 + LA R2,4(R2) INCREMENT FETCH ADDRESS 86832000 + BCT RWK0,EIMOVEIN IF CTR ^= 0, CONTINUE LOOP 86834000 + L RWK1,EIMOVSAV GET RETURN ADDRESS 86836000 + SR R2,R2 CLEAR BYTE REG 86838000 + BR RWK1 RETURN TO CALLER 86840000 +EIMOVSAV DC F'0' RET ADDR SAVED HERE 86842000 + SPACE 5 86844000 +**--> INSUB: EIXOPCHK CHECK ADDRESSES FOR XOPC INSTRUCTIONS + + + 86846000 +*+ + 86848000 +*+ ENTRY CONDITIONS: + 86850000 +*+ RWK1 - CONTAINS THE ADDRESS TO BE CHECKED (LOW @) + 86852000 +*+ RWK0 - CONTAINS LENGTH-1 OF STORAGE AFFECTED + 86854000 +*+ RLINK - INTERNAL LINK REGISTER + 86856000 +*+ EXIT CONDITIONS: + 86858000 +*+ RWK0 - CONTENTS (LENGTH) DESTROYED, UNLESS + 86860000 +*+ EIXOPCHA IS CALLED WITH RWK0 CONTAINING + 86862000 +*+ THE HIGH ADDRESS --> (LOW @ + LENGTH - 1) + 86864000 +*+ + 86866000 +*++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 86868000 + SPACE 2 86870000 +EIXOPCHK EQU * 86872000 + ALR RWK0,RWK1 COMPUTE HIGH ADDRESS 86874000 +EIXOPCHA EQU * 86876000 + C RWK1,ECFADL IS LOW ADDRESS IN RANGE ? 86878000 + BL EIXOPCC1 NO, BRANCH TO NOTE ERROR 86880000 + C RWK0,ECFADH IS HIGH ADDRESS IN RANGE ? 86882000 + BCR L,RLINK YES, SO RETURN 86884000 + B EIXOPCC1 NO, BRANCH TO NOTE ERROR 86886000 + LTORG 86890000 + SPACE 2 86892000 +* TABLE FOR THE XOPC INSTRUCTION DISPLACEMENTS 86894000 +EIOPCJMP $AL2 EIXOPC,(EIOPC0,EIOPC1,EIOPC2,EIOPC3,EIOPC4,EIOPC5,EIOPC6X86896000 + ,EIOPC7,EIOPC8,EIOPC9,EIOPC10,EIOPC11,EIOPC12,EIOPC13,EIX86898000 + OPC14,EIOPC15,EIOPC16,EIOPC17,EIOPC18,EIOPC19,EIOPC20,EIX86900000 + OPC21,EIOPC22) 86900100 + SPACE 2 86902000 +* TABLE FOR EXTENDED I/I INSTRUCTION DISPLACEME1T 86904000 +EIXIOJ $AL2 EISPEJMP,(EIXREAD,EIXPRNT,EIXPNCH,EIXDUMP,EIXLIMD,EIXGETX86906000 + ,EIXPUT,EIOC1) 86908000 +.EINOXIO ANOP 86910000 + SPACE 2 86912000 +* OFF SETS TO COMPLETION CODE MESSAGES 86914000 +EICOFFS $AL2 EICC0,(EICC1,EICC2,EICC3,EICC4,EICC5,EICC6,EICC7,EICC8,EX86916000 + ICC9,EICCA,EICCB),-2 STANDARD INTERRUPT POINTERS 86918000 + AIF (NOT &$FLOTE).EIFL6 SKI1IF NO FLOATING INTERRUPTS 86920000 + $AL2 EICC0,(EICCC,EICCD,EICCE,EICCF) FLOATING INTERS 86922000 +.EIFL6 ANOP 86924000 + SPACE 2 86926000 +* COMPLETION CODE MESSAGES 86928000 +EICC0 EQU * 86930000 +EICC1 $ERCGN 0C1,'OPERATION' 86932000 +EICC2 $ERCGN 0C2,'PRIVILEGED OP)RATION' 86934000 +EICC3 $ERCGN 0C3,'EXECUTE' 86936000 +EICC4 $ERCGN 0C4,'PROTECTION' 86938000 +EICC5 $ERCGN 0C5,'ADDRESSING' 86940000 +EICC6 $ERCGN 0C6,'SPECIFICATION' 86942000 +EICC7 $ERCGN 0C7,'DATA' 86944000 +EICC8 $ERCGN 0C8,'FIXED-POINT OVERFLOW' 86946000 +EICC9 $ERCGN 0C9,'FIXED-POINT DIVIDE' 86948000 +EICCA $ERCGN 0CA,'DECIMAL OVERFLOW' 86950000 +EICCB $ERCGN 0CB,'DECIMAL DIVIDE' 86952000 + AIF (NOT &$FLOTE).EIFL8 SKIP MESSAGES FOR FLOATING PNT 86954000 +EICCC $ERCGN 0CC,'EXPONENT OVERFLOW' 86956000 +EICCD $ERCGN 0CD,'EXPONENT UNDERFLOW' 86958000 +EICCE $ERCGN 0CE,'SIGNIFICANCE' 86960000 +EICCF $ERCGN 0CF,'FLOATING-POINT DIVIDE' 86962000 +.EIFL8 ANOP 86964000 + SPACE 1 86966000 +EICCREAD $ERCGN 220,'ATTEMPTED READ PAST END-FILE',TYPE=ASSIST 86968000 +EICCTIME $ERCGN 221,'INSTRUCTION LIMIT EXCEEDED',TYPE=ASSIST 86970000 +EICCRECE $ERCGN 222,'RECORD LIMIT EXCEEDED',TYPE=ASSIST 86972000 + AIF (&$TIMER EQ 0).EINOTOC SKIP IF NO TIMER AT ALL 86974000 +EICCTIMB $ERCGN 223,'TIME LIMIT EXCEEDED',TYPE=ASSIST 86976000 +.EINOTOC ANOP 86978000 +EICCBROU $ERCGN 224,'BRANCH OUT OF PROGRAM AREA',TYPE=ASSIST 86980000 + SPACE 2 86982000 +* THE FOLLOWING IS THE 256 SECONDARY CONTROL TABLE 86984000 +* WHICH CONTAINS INDICES INTO THE MAIN CONTROL TABLE 86986000 +EIOPCDTB EQU * 86988000 + EIXTAB 2,XOPC,2,2,SPM,BALR,BCTR,BCR M 86990000 + EIXTAB PRIVH,PRIVH,PRIVH,2,2,2,MVCL,CLCL M 86992000 + EIXTAB NMRR,NMRR,NMRR,NMRR,NMRR,NMRR,NMRR,NMRR 86994000 + EIXTAB LR,NMRR,NMRR,NMRR,MRDR,MRDR,NMRR,NMRR 86996000 + EIXTAB FPRR,FPRR,FPRR,FPRR,FPRR,FPRR,FPRR,FPRR 86998000 + EIXTAB FPRR,FPRR,FPRR,FPRR,FPRR,FPRR,FPRR,FPRR 87000000 + EIXTAB FPRR,FPRR,FPRR,FPRR,FPRR,FPRR,FPRR,FPRR 87002000 + EIXTAB FPRR,FPRR,FPRR,FPRR,FPRR,FPRR,FPRR,FPRR 87004000 + EIXTAB STH,LA,STC,IC,EX,BAL,BCT,BC 87006000 + EIXTAB NMRXH,NMRXH,NMRXH,NMRXH,NMRXH,4,CVD,CVB 87008000 + EIXTAB ST,4,DECO,DECI,NMRXF,NMRXF,NMRXF,NMRXF 87010000 + EIXTAB NMRXF,NMRXF,NMRXF,NMRXF,MD,MD,NMRXF,NMRXF 87012000 + EIXTAB FPRS,HEXI,HEXO,4,4,4,4,XFPRF 87014000 + EIXTAB FPRF,FPRF,FPRF,FPRF,FPRF,FPRF,FPRF,FPRF 87016000 + EIXTAB FPRS,4,4,4,4,4,4,4 87018000 + EIXTAB FPRF,FPRF,FPRF,FPRF,FPRF,FPRF,FPRF,FPRF 87020000 + EIXTAB PRIVF,4,PRIVF,DIAG,PRIVF,PRIVF,BXH,BXLE M 87022000 + EIXTAB SHFTS,SHFTS,SHFTS,SHFTS,SHFTD,SHFTD,SHFTD,SHFTD 87024000 + EIXTAB STM,NMSIF,NMSIS,NMSIS,NMSIS,NMSIF,NMSIS,NMSIS 87026000 + EIXTAB LM,4,4,4,PRIVF,PRIVF,PRIVF,PRIVF M 87028000 + EIXTAB 4,4,4,4,4,4,4,4 87030000 + EIXTAB 4,4,4,4,PRIVF,PRIVF,4,PRIVF M 87032000 + EIXTAB 4,PRIVF,PRIVF,4,4,4,PRIVF,PRIVF M 87034000 + EIXTAB 4,4,4,4,4,CLM,STCM,ICM 87036000 + EIXTAB 6,6,6,6,6,6,6,6 87038000 + EIXTAB 6,6,6,6,6,6,6,6 87040000 + EIXTAB 6,MOVES,MOVES,MOVES,LOGS,LOGFS,LOGS,LOGS 87042000 + EIXTAB 6,6,6,6,TR,TRT,MOVES,EDMK 87044000 + EIXTAB XTND,DUMPR,6,6,6,6,6,6 L 87046000 + EIXTAB 6,6,6,6,6,6,6,6 87048000 + EIXTAB SRP,MVO,PACK,UNPK,6,6,6,6 87050000 + EIXTAB DECS,CP,DECS,DECS,DECS,DECS,6,6 87052000 + TITLE '*** EXECUT - MAIN CONTROL TABLE' 87054000 +* THE FOLLOWING IS THE MAIN CONTROL TABLE FOR THE 87056000 +* EXTENDED INTERPRETER 87058000 +EICONTAB DS 0F L 87060000 +EIT2 DC X'00020000',4X'00' L 87062000 +EIT4 DC X'00040000',4X'00' L 87064000 +EIT6 DC X'00060000',4X'00' L 87066000 + EITAB NMRR,360,2,*,NO,NM,**,*,*,RR4,**,***,O,O,EINORMRR 87068000 + EITAB LR,360,2,*,NO,NM,**,*,*,RR4,**,***,O,O,EILR 87070000 + EITAB BALR,360,2,*,NO,NM,**,*,*,RR4,**,***,O,O,EIBALR 87072000 + EITAB BCTR,360,2,*,NO,NM,**,*,*,RR4,**,***,O,O,EIBCTR 87074000 + EITAB BCR,360,2,*,NO,NM,**,*,*,RR4,**,***,O,O,EIBCR 87076000 + EITAB FPRR,360,2,*,NO,NM,**,*,*,RR4,**,***,O,O,EIFPRR 87078000 + EITAB CLCL,370,2,*,NO,NM,NO,F,F,RR4,**,***,E,E,EILONG 87080000 + EITAB MVCL,370,2,*,NO,NM,NO,S,F,RR4,**,***,E,E,EILONG 87082000 + EITAB SPM,360,2,*,NO,NM,**,*,*,RR4,**,***,O,O,EISPM 87084000 + EITAB MRDR,360,2,*,NO,NM,**,*,*,RR4,**,***,E,O,EIMRDR 87086000 + EITAB PRIVH,360,2,*,PR,NM,**,*,*,IOL,**,***,O,O,EILCTL M 87087000 + EITAB NMRXF,360,4,4,NO,NM,CK,F,*,RR4,IX,FUL,O,O,EINORMRX 87088000 + EITAB IC,360,4,1,NO,NM,CK,F,*,RR4,IX,NON,O,O,EINORMRX 87090000 + EITAB NMRXH,360,4,2,NO,NM,CK,F,*,RR4,IX,HAF,O,O,EINORMRX 87092000 + EITAB CVB,360,4,8,NO,NM,CK,F,*,RR4,IX,DBL,O,O,EINORMRX 87094000 + EITAB BAL,360,4,*,NO,NM,NO,*,*,RR4,IX,NON,O,O,EIBAL 87096000 + EITAB BCT,360,4,*,NO,NM,NO,*,*,RR4,IX,NON,O,O,EIBCT 87098000 + EITAB BC,360,4,*,NO,NM,NO,*,*,RR4,IX,NON,O,O,EIBC 87100000 + EITAB LA,360,4,*,NO,NM,CK,*,*,RR4,IX,NON,O,O,EILA 87102000 + EITAB EX,360,4,*,NO,NM,CK,F,*,RR4,IX,HAF,O,O,EIEX 87104000 + EITAB MD,360,4,4,NO,NM,CK,F,*,RR4,IX,FUL,E,O,EIMD 87106000 + EITAB STH,360,4,2,NO,NM,CK,S,*,RR4,IX,HAF,O,O,EISTORS 87108000 + EITAB CVD,360,4,8,NO,NM,CK,S,*,RR4,IX,DBL,O,O,EISTORS 87110000 + EITAB STC,360,4,1,NO,NM,CK,S,*,RR4,IX,NON,O,O,EISTORS 87112000 + EITAB ST,360,4,4,NO,NM,CK,S,*,RR4,IX,FUL,O,O,EISTORS 87114000 + EITAB FPRF,360,4,4,NO,NM,CK,F,*,RR4,IX,FUL,E,O,EIFPRX 87116000 + EITAB FPRS,360,4,4,NO,NM,CK,S,*,RR4,IX,FUL,E,O,EIFPRXST CEH 87118000 + EITAB XFPRF,360,4,8,NO,NM,CK,F,*,RR4,IX,DBL,E,O,EIFPRX 87120000 + EITAB XFPRS,360,4,8,NO,NM,CK,S,*,RR4,IX,DBL,E,O,EIFPRXST CEH 87122000 + EITAB NMSIS,360,4,1,NO,NM,CK,S,*,IOL,BD,NON,*,*,EINORMSI 87124000 + EITAB NMSIF,360,4,1,NO,NM,CK,F,*,IOL,BD,NON,*,*,EINORMSI 87126000 + EITAB DIAG,360,4,1,NO,NM,NO,*,*,IOL,BD,NON,*,*,EIDIAG 87128000 + EITAB BXH,360,4,*,NO,NM,NO,N,*,RR4,BD,NON,O,O,EIRSBX 87130000 + EITAB BXLE,360,4,*,NO,NM,NO,N,*,RR4,BD,NON,O,O,EIRSBX 87132000 + EITAB LM,360,4,*,NO,NM,NO,F,*,RR4,BD,FUL,O,O,EILMSTM 87134000 + EITAB STM,360,4,*,NO,NM,NO,S,*,RR4,BD,FUL,O,O,EILMSTM 87136000 + EITAB SHFTS,360,4,*,NO,NM,NO,N,*,RR4,BD,NON,O,O,EISHIFT 87138000 + EITAB SHFTD,360,4,*,NO,NM,NO,N,*,RR4,BD,NON,E,O,EISHIFT 87140000 + EITAB ICM,370,4,4,NO,NM,CK,F,*,RR4,BD,NON,O,O,EIICM 87142000 + EITAB STCM,370,4,4,NO,NM,CK,S,*,RR4,BD,NON,O,O,EISTCM 87144000 + EITAB CLM,370,4,4,NO,NM,CK,F,*,RR4,BD,NON,O,O,EICLM 87146000 + EITAB PRIVF,360,4,*,PR,NM,**,*,*,IOL,**,***,O,O,EILCTL M 87147000 + EITAB MOVES,360,6,0,NO,NM,CK,S,F,IOL,BD,NON,*,*,EIMOVES 87148000 + EITAB MVO,360,6,0,NO,NM,CK,S,F,LL1,BD,NON,*,*,EIMOVES 87150000 + EITAB LOGS,360,6,0,NO,NM,CK,S,F,IOL,BD,NON,*,*,EILOGS 87152000 + EITAB LOGFS,360,6,0,NO,NM,CK,F,F,IOL,BD,NON,*,*,EILOGS 87153000 + EITAB TR,360,6,0,NO,NM,CK,S,F,IOL,BD,NON,*,*,EIMOVES 87154000 + EITAB PACK,360,6,0,NO,NM,CK,S,F,LL1,BD,NON,*,*,EIMOVES 87156000 + EITAB UNPK,360,6,0,NO,NM,CK,S,F,LL1,BD,NON,*,*,EIMOVES 87158000 + EITAB DECS,360,6,0,NO,NM,CK,S,F,LL1,BD,NON,*,*,EIDECS 87160000 + EITAB CP,360,6,0,NO,NM,CK,F,F,LL1,BD,NON,*,*,EIDECS 87162000 + EITAB TRT,360,6,0,NO,NM,CK,F,F,IOL,BD,NON,*,*,EITRT 87164000 + EITAB EDMK,360,6,0,NO,NM,CK,S,F,IOL,BD,NON,*,*,EIEDMK 87166000 + EITAB SRP,370,6,0,NO,NM,CK,S,N,LL1,BD,NON,*,*,EISRP 87168000 + EITAB XTND,*,*,*,*,EX,*,*,*,*,*,*,*,*,EI2EXTAB 87170000 +* ONLY LENGTH AND OPCODE REQ FOR REGISTER XDUMP L 87172000 + EITAB DUMPR,360,6,*,NO,NM,**,*,*,*,*,*,*,*,EIXDUMPR L 87174000 + EITAB HEXI,360,4,8,NO,NM,CK,F,*,RR4,IX,NON,O,O,EIXHEXI M 87176000 + EITAB HEXO,360,4,8,NO,NM,CK,S,*,RR4,IX,NON,O,O,EIXHEXO M 87178000 + EITAB DECI,360,4,8,NO,NM,CK,F,*,RR4,IX,NON,O,O,EIXDECI M 87180000 + EITAB DECO,360,4,12,NO,NM,CK,S,*,RR4,IX,NON,O,O,EIXDECO M 87182000 + EITAB XOPC,360,2,*,NO,NM,**,*,*,IOL,**,***,*,*,EIXOPC M 87184000 +*********************************************************************** 87186000 +* * 87188000 +* THE FOLLOWING BLOCK OF STMTS DESCRIBES A SINGLE ENTRY * 87190000 +* OF THE OPTIONAL INTERPRETER MAIN CONTROL TABLE * 87192000 +* * 87194000 +*********************************************************************** 87196000 +* * 87198000 +* NOTES ON THE DESIGN OF THE MAIN INTERPRETER TABLE * 87200000 +* ------------------------------------------------- * 87202000 +* (AND SUB-TABLES) * 87204000 +* * 87206000 +* => IMPORTANT: THIS SHOULD BE REQUIRED READING FOR ANYONE * 87208000 +* NEEDING TO UNDERSTAND AND/OR MODIFY THIS TABLE SCHEME. * 87210000 +* * 87212000 +* A 256 BYTE TABLE (1 BYTE PER POSSIBLE OPCODE) OF * 87214000 +* POINTERS ALLOW EASY ACCESS TO INSTRUCTION DECODING * 87216000 +* INFORMATION BY INDEXING INTO A LARGER MAIN TABLE * 87218000 +* DESCRIBED BELOW. * 87220000 +* THE OPTIONAL ASSIST INTERPRETER'S MAIN CONTROL TABLE * 87222000 +* (NAMED: EICONTAB) CONTAINS ONE ENTRY FOR EACH POSSIBLE * 87224000 +* TYPE OF INSTRUCTION DECODING. EACH 8 BYTE ENTRY CONTAINS * 87226000 +* APPROPRIATE FLAGS AND OTHER INFORMATION (AS DESCRIBED * 87228000 +* BELOW) TO CONTROL EACH STEP OF THE SPECIFIC INSTRUCTION * 87230000 +* DECODING PROCESS. * 87232000 +* THE FIRST THREE COMPLETE ENTRIES OF EICONTAB WILL * 87234000 +* BE ALL ZEROS EXCEPT THE INSTRUCTION LENGTH BITS. THE * 87236000 +* FIRST ENTRY'S INSTRUCTION LENGTH WILL BE EQUAL TO TWO, * 87238000 +* THE SECOND'S WILL EQUAL FOUR AND THE THIRD'S WILL EQUAL * 87240000 +* SIX. ALL ILLEGAL OPCODES (IN EIOPCDTB, THE 256 BYTE * 87242000 +* TABLE DESCRIBED ABOVE) WILL POINT TO THE ENTRY WHOSE * 87244000 +* INSTRUCTION LENGTH CORRESPONDS TO THE HIGH ORDER TWO BITS * 87246000 +* OF THE OPCODE ITSELF. * 87248000 +* FOR EXTENDED OPCODES (S-TYPE & PSEUDO-INSTRUCTIONS) * 87250000 +* THE ENTRY IN EICONTAB WILL BE MARKED 'OPCODE-DOES-NOT- * 87252000 +* TELL-ALL' AND WILL CONTAIN INFORMATION CONCERNING ACCESS * 87254000 +* TO A SUB-TABLE GIVING ALL NECESSARY INFORMATION ABOUT * 87256000 +* INSTRUCTION DECODING. SEE EQUATES BELOW. * 87258000 +* * 87260000 +*********************************************************************** 87262000 +* 87264000 +EICTNTRY DS 0D MOVE CONTROL TABLE ENTRY HERE 87266000 +* FLAG BYTES -- CONTAIN INSTR DECODING INFORMATION AS 87268000 +* DESCRIBED BY EQUATES BELOW 87270000 +EICTB1 DS B FLAG BYTE 1 87272000 +EICTB2 DS B FLAG BYTE 2 87274000 +EICTB3 DS B FLAG BYTE 3 87276000 +EICTB4 DS B FLAG BYTE 4 87278000 +EICTB5 DS B FLAG BYTE 5 87280000 +EICTB6 DS B FLAG BYTE 6 87282000 +EICTDISP DS H DISPLACEMENT FOR BRANCHING TO X87284000 + SPECIAL ROUTINE 87286000 +EICTE$L EQU *-EICTNTRY LENGTH OF A SINGLE TABLE ENTRY 87288000 +* MISCELLANEOUS EQUATES 87290000 +EIEXTTAB EQU EICTB5 ADDRESS OF EXTENDED OP CODE TABLE 87292000 +EI360PLS EQU B'00001100' (EICTB1)==> 360 & 370 INSTR 87294000 +EI370ONL EQU B'00001000' (EICTB1)==> 370 INSTR ONLY 87296000 +EIRR EQU B'00100000' (EICTB1)==> THIS IS AN RR INSTR 87298000 +EIPRIVOP EQU B'01000000' (EICTB1)==> THIS IS A PRIVILEGED X87300000 + INSTRUCTION 87302000 +EIEXOPCD EQU B'10000000' (EICTB1)==> OPCODE DOES NOT TELL X87304000 + ALL (EXTENDED OPCODE) 87306000 +EINOCNOW EQU B'00010000' (EICTB1)==> DO PERFORM MOD/ST/FTCH X87308000 + CHECKING AT EINOCHK 87310000 +* EQUATES FOR INSTRUCTION LENGTH CODE 87312000 +* **** NOTE **** NO OTHER FLAGS CAN BE ADDED TO EICTB2 87314000 +EILEN2 EQU B'00000010' (EICTB2)==> LENGTH=2 BYTES 87316000 +EILEN4 EQU B'00000100' (EICTB2)==> LENGTH=4 BYTES 87318000 +EILEN6 EQU B'00000110' (EICTB2)==> LENGTH=6 BYTES 87320000 +* EQUATES FOR MODIFICATION OR FETCH CHECKING 87322000 +* --- FOR FIRST OPERAND 87324000 +EI1NOCHK EQU B'00000000' (EICTB3)==> NO CHECKING 87326000 +EI1FETCH EQU B'01000000' (EICTB3)==> FETCH CHECKING 87328000 +EI1STORE EQU B'11000000' (EICTB3)==> STORE CHECKING 87330000 +* --- FOR SECOND OPERAND 87332000 +EI2NOCHK EQU B'00000000' (EICTB3)==> NO CHECKING 87334000 +EI2FETCH EQU B'00010000' (EICTB3)==> FETCH CHECKING 87336000 +EI2STORE EQU B'00110000' (EICTB3)==> STORE CHECKING 87338000 +* EQUATES FOR INSTR DECODING (2ND BYTE OF INSTR) 87340000 +EIB2RRX4 EQU B'00000000' (EICTB3)==> 2 REGS (MULT BY 4) 87342000 +EIB2LLX1 EQU B'00000001' (EICTB3)==> 2 LENGTHS (NO MULT) 87344000 +EIB2IORL EQU B'00000011' (EICTB3)==> 1 LENGTH OR IMMED FLD 87346000 +* EQUATES FOR INSTR DECODING (2ND HALFWORD OF INSTR) 87348000 +EIH2NODX EQU B'00000100' (EICTB3)==> BASE+DISP ONLY (OTHER- X87350000 + WISE INDEX+(BASE+DISP)) 87352000 +* NOTE IF THIS IS A BRANCH INSTRUCTION 87354000 +EIBRINST EQU B'00001000' (EICTB3)==> THIS IS A NON-RR BR INST 87356000 +* EQUATES FOR OPERAND ALIGNMENT 87358000 +* ***** NO OTHER FLAGS ALLOWED IN EICTB4 ***** 87360000 +EIALNONE EQU B'00000000' (EICTB4)==> NO ALIGNMENT NEEDED 87362000 +EIALHALF EQU B'00000001' (EICTB4)==> HALFWORD ALIGNMENT 87364000 +EIALFULL EQU B'00000011' (EICTB4)==> FULLWORD ALIGNMENT 87366000 +EIALDOBL EQU B'00000111' (EICTB4)==> DOUBLE-WORD ALIGNMENT 87368000 +* EQUATES FOR EVEN/ODD REGISTER CHECKING 87370000 +* (THIS BYTE CAN NOT CONTAIN ANY OTHER FLAGS) 87372000 +EINEREG1 EQU B'00000000' (EICTB5)==> REG1 CAN BE ODD 87374000 +EIEVREG1 EQU B'00010000' (EICTB5)==> REG1 MUST BE EVEN 87376000 +EINEREG2 EQU B'00000000' (EICTB5)==> REG2 CAN BE ODD 87378000 +EIEVREG2 EQU B'00000001' (EICTB5)==> REG 2 MUST BE EVEN 87380000 +* EQUATES FOR INSTR MOD/FETCH LENGTH 87382000 +* 87384000 +* NOTE ***** THE UPPER NIBBLE OF THIS BYTE SHOULD ONLY 87386000 +* BE USED WHEN ABSOLUTELY NECESSARY. IF IT IS USED, 87388000 +* THEN THE FOLLOWING INSTR MUST BE PLACED BETWEEN THE 87390000 +* IC AND LTR INSTRS FOLLOWING LABEL => EINOCHK: 87392000 +* N R2,=XL4'0F' 87394000 +* 87396000 +EIMFLENG EQU B'00001111' (EICTB6)==> LOWER NIBBLE HAS LENGTH 87398000 +* 87400000 +*********************************************************************** 87402000 +* * 87404000 +* THE FOLLOWING EQUATES ARE USED FOR EXTENDED OPCODE * 87406000 +* TABLE ENTRY FETCHING: * 87408000 +* * 87410000 +*********************************************************************** 87412000 +* * 87414000 +******** IMPORTANT NOTES FOR EXTENDED OPCODE INSTRUCTIONS ************* 87416000 +* * 87418000 +* THE MAIN TABLE (EICONTAB) ENTRY FOR AN EXTENDED OPCODE * 87420000 +* WILL CONTAIN THE ACTUAL 4 BYTE ADDRESS OF THE SECONDARY * 87422000 +* TABLE CONTAINING DECODING ENTRIES FOR THE EXTENDED OPCODE * 87424000 +* INSTRUCTION. * 87426000 +* * 87428000 +* THE FIRST 8 BYTE ENTRY OF THE SECONDARY TABLE WILL * 87430000 +* CONTAIN A BYTE HAVING THE # OF BITS TO SHIFT THE 2ND * 87432000 +* BYTE OF THE INSTRUCTION TO OBTAIN AN INDEX INTO THE * 87434000 +* BYTE TABLE FOLLOWING THE 1ST ENTRY. ALSO IN THE 1ST ENTRY * 87436000 +* WILL BE A FULLWORD COMPARATOR GIVING THE MAXIMUM INDEX * 87438000 +* VALUE THAT IS LEGAL. * 87440000 +* * 87442000 +* THE BYTE TABLE FOLLOWING THE 1ST ENTRY WILL CONTAIN AS * 87444000 +* MANY SINGLE BYTE ENTRIES AS NECESSARY. EACH ENTRY WILL BE * 87446000 +* A DISPLACEMENT FROM THE BEGINNING OF THE TABLE TO THE * 87448000 +* CORRECT TABLE ENTRY FOR THE PARTICULAR INSTRUCTION. IF * 87450000 +* THE BYTE IS ZERO THEN THE INSTRUCTION IS NOT IMPLEMENTED * 87452000 +* AND AN OC-1 INTERRUPT WILL BE FLAGGED. * 87454000 +* * 87456000 +*********************************************************************** 87458000 +* 87460000 +* SECONDARY EXTENDED OPCODE TABLE * 87462000 +* THIS TABLE IS AN EXTENSION OF THE MAIN DECODING TABLE AND IS * 87464000 +* STRICTLY RESERVED FOR THE EXTENDED OPCODE INSTRUCTIONS -- THOSE * 87466000 +* WITH AN OPCODE OF 'EO'. BY SHIFTING THE SECOND BYTE OF THE * 87468000 +* INSTRUCTIONS 5 BITS TO THE RIGHT, AN INBEX TO BYTE TABLE -- SECOND * 87470000 +* 8 BYTES OF THIS TABLE -- IS ESTABLISHED WHERE A DISPLACEMENT TO * 87472000 +* THE PROPER INSTRUCTION DECODING ENTRY IS LOCATED. THE FIRST 8 BYTES* 87474000 +* OF THE SECONDARY DECODING TABLE IS EXPLAINED ABOVE. * 87476000 + SPACE 2 87478000 +EI2EXTAB DS 0F SECONDARY EXTENDED DECODING TABLE 87480000 +* EXTENDED OPCODE TABLE EQUATES 87482000 +* --> 1ST 8 BYTE ENTRY 87484000 +EIMAXIND EQU 4 POSITION OF MAX INDEX VALUE ALLOWED X87486000 + (THIS IS A FULLWORD) 87488000 +EI#SHIFT EQU 3 POS OF SHIFT BYTE IN 1ST TAB ENTRY 87490000 + DC XL3'0',X'5' BYTE 3 = # BITS TO SHIFT MASK 87492000 + DC F'8' MAXIMUM INDEX LIMIT 87494000 + DC X'1018202830384000' DISPLACEMENTS FROM EI2EXTAB 87496000 + EITAB READ,360,6,0,NO,NM,CK,S,*,RR4,IX,NON,O,O,EIXIOS 87498000 + EITAB PRNT,360,6,0,NO,NM,CK,F,*,RR4,IX,NON,O,O,EIXIOS 87500000 + EITAB PNCH,360,6,0,NO,NM,CK,F,*,RR4,IX,NON,O,O,EIXIOS 87502000 + EITAB DUMP,360,6,0,NO,NM,CK,F,*,RR4,IX,NON,O,O,EIXIOS 87504000 + EITAB LIMD,360,6,0,NO,NM,CK,*,*,RR4,IX,NON,O,O,EIXIOS 87506000 + EITAB GET,360,6,0,NO,NM,CK,S,*,RR4,IX,NON,O,O,EIXIOS 87508000 + EITAB PUT,360,6,0,NO,NM,CK,F,*,RR4,IX,NON,O,O,EIXIOS 87510000 +.EINONE ANOP 89999999 +//* +//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +//* STEP 2 - APPLY CHANGES TO SOURCE IN TEMPORARY DATASETS. +//* (MAKE ANY DESIRED CHANGES TO THE STATEMENTS BELOW.) +//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +//* +//UPDATEA.SYSIN DD * +./ CHANGE +&$GENDAT SETC '&SYSDATE' CURRENT GENERATION DATE J 00007000 +&$IDF SETA 20000000 LARGE VAL - USE TIMER INSTEAD 00007200 +&$IMX SETA 20000000 LARGE VAL - USE TIMER INSTEAD 00007250 +&$SYSTEM SETC 'OS-MVS' SYSTEM IS OS OPTION MVS 00009200 +&$S370 SETA 1 S/370 INSTRUCTION SET 00009250 +&$VERSLV SETC '4.0/A2' CURRENT ASSIST VERSION J 00009700 +&$IOUNIT(2) SETC 'SYSIN2 ' SET OS SECONDARY INPUT 00011100 +&$IOUNIT(3) SETC 'SYSPRINT' SET OS PRINTER 00011150 +&$IOUNIT(4) SETC 'SYSPUNCH' SET OS PUNCH 00011200 +&$IOUNIT(5) SETC 'SYSUT1 ' SET OS DISK INTERMEDIATE 00011250 +//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +//* THE CHANGES BELOW WERE REQUIRED TO CORRECT SOME PROBLEMS IN THE +//* ORIGINAL SOURCE. YOU SHOULD NOT MAKE CHANGES HERE YOURSELF. +//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +//UPDATEB.SYSIN DD * +./ CHANGE +&XSAVE DC 18F'0' . SAVE AREA 00684000 + LH RA,CNDOCNT GET LENGTH-1 CURRENTLY READY 09764000 +.UTE1A1 ANOP 19711000 + TITLE '*** ECBRSTKD - DSECT FOR THE EXT''D INT BRANCH STACK' 83004000 + END 90000000 +//* +//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +//* STEP 3 - ASSEMBLE AND LINK-EDIT ASSIST. +//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +//* +//ASM EXEC ASMFCL,REGION.ASM=4096K, +// PARM.ASM='LOAD,NODECK,LIST,NOXREF', +// MAC1='SYS1.AMODGEN' +//ASM.SYSUT1 DD UNIT=SYSDA,SPACE=(1700,(1500,500)) +//ASM.SYSUT2 DD UNIT=SYSDA,SPACE=(1700,(1500,500)) +//ASM.SYSUT3 DD UNIT=SYSDA,SPACE=(1700,(1500,500)) +//ASM.SYSPRINT DD SYSOUT=* +//ASM.SYSGO DD UNIT=SYSDA,SPACE=(80,(1500,100)) +//ASM.SYSIN DD DSN=&&ASSRCM1,DISP=(OLD,DELETE) +// DD DSN=&&ASSRCM2,DISP=(OLD,DELETE) +//LKED.SYSLMOD DD DSN=SYS2.LINKLIB,DISP=SHR <== TARGET LIBRARY +//LKED.SYSUT1 DD SPACE=(1024,(250,20)) +//LKED.SYSPRINT DD SYSOUT=* +//LKED.SYSIN DD * + NAME ASSIST(R) +//* +//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +//* STEP 4 - ADD X??? MACROS TO SYS1.MACLIB. +//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +//* +//MACROS EXEC PGM=IEBUPDTE,PARM=NEW +//SYSPRINT DD SYSOUT=* +//SYSUT2 DD DISP=SHR,DSN=SYS1.MACLIB <== TARGET LIBRARY +//SYSIN DD * +./ ADD LEVEL=40,SOURCE=0,NAME=EQUREGS 00002000 + MACRO 00004000 +&LABEL EQUREGS &L=R,&DO=(0,15,1),&SYM= 00006000 +.*--> MACRO: EQUREGS GENERATE SYMBOLIC REGISTER EQUATES . . . . . . 00008000 +.* JOHN R. MASHEY/JULY'69/PSU 360/67 * 00010000 +.* MACRO FOR SETTING UP SETS OF REGISTER EQUATES. * 00012000 +.* *** ARGUMENTS *** * 00014000 +.* L= SYMBOL USED TO BEGIN EQUATES, SUCH AS R, REG,ETC. * 00016000 +.* DO= (INITIAL,LIMIT,INCREMENT) WILL SET UP REGISTERS * 00018000 +.* EQUATED TO THE VALUE AS CONTROLLED BY THE DO PARAMATER.* 00020000 +.* BEHAVES LIKE FORTRAN DO, INCLUDING ABILITY TO LEAVE OUT* 00022000 +.* INCREMENT. * 00024000 +.* SYM= LIST OF SYMBOLS TO BE CONCATENATED TO L PARM. * 00026000 +.* LIST WILL SET UP EQUATES INCLUDING SYM VALUES, FOR * 00028000 +.* FIRST SET OF EQUATES IN LIST, AND WILL THEN SET UP * 00030000 +.* NUMERIC EQUATES IF DO VALUES EXCEED NUMBER OF ELEMENTS * 00032000 +.* IN SYM OPERAND. MAY BE OMITTED ENTIRELY. * 00034000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00036000 + LCLA &I,&J,&K COUNTER,INCREMENT,SYM COUNTER 00038000 + AIF (N'&DO LT 2).XERROR NOT ENOUGH ARGUMENTS-ERR 00040000 +&K SETA 1 INIT 00042000 +&I SETA &DO(1) SET TO INITIAL VALUE 00044000 +&J SETA 1 SET TO DEFAULT VALUE 00046000 + AIF (N'&DO LT 3).XLOOP DEFAULT VALUE IS OK 00048000 +&J SETA &DO(3) USE VALUE PROVIDED 00050000 +.XLOOP AIF ('&SYM(&K)' EQ '').XLOOP1 USE NUMBER IF NO SYM VAL 00052000 +&L&SYM(&K) EQU &I 00054000 +&K SETA &K+1 INCREMENT TO GET NEXT SYM OPERAND 00056000 + AGO .XLOOP2 SKIP OVER NORMAL GENRATION 00058000 +.XLOOP1 ANOP 00060000 +&L&I EQU &I 00062000 +.XLOOP2 ANOP 00064000 +&I SETA &I+&J ADD INCREMENT TO COUNTER 00066000 + AIF (&I LE &DO(2)).XLOOP CONTINUE UNTIL DONE 00068000 + MEXIT 00070000 +.XERROR MNOTE 0,'** ERROR - EQUREGS REQUIRES AT LEAST 2 VALUES IN DO' 00072000 + MEND 00074000 +./ ADD LEVEL=40,SOURCE=0,NAME=XCHAR 00076000 + MACRO 00078000 + XCHAR &STRING,&NUM 00080000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00082000 +.*--> MACRO: XCHAR RETURN SAFE RIGHT-END SUBSTRING OF A STRING. * 00084000 +.* JOHN R. MASHEY-JULY 1969-360/67* 00086000 +.* THIS MACRO RETURNS IN &XXCHAR THE &NUM CHARACTERS TAKEN FROM * 00088000 +.* THE RIGHT END OF THE CHARACTER STRING &STRING, WITHOUT * 00090000 +.* BLOWING UP IF THERE ARE LESS THAN &NUM CHARS IN &STRING. * 00092000 +.* THIS MACRO IS USED BY XSAVE,XRETURN, AND XSRNR * 00094000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00096000 + GBLC &XXCHAR RETURN RESULT IN THIS 00098000 + AIF (&NUM GT K'&STRING).XGA SKIP IF HE WANTS MORE 00100000 +&XXCHAR SETC '&STRING'(K'&STRING+1-&NUM,&NUM) SCOOP RIGHT AMT 00102000 + MEXIT 00104000 +.XGA ANOP 00106000 +&XXCHAR SETC '&STRING' STRING SMALLER-USE WHOLE THING 00108000 + MEND 00110000 +./ ADD LEVEL=40,SOURCE=0,NAME=XDECI 00112000 + MACRO 00114000 +&LABEL XDECI ®,&ADDRESS 00116000 +.*--> MACRO: XDECI EXTENDED DECIMAL INPUT CONVERSION * * * * * * * 00118000 +.* EXTENDED DECIMAL INPUT MACRO - ENABLES PROGRAMS * 00120000 +.* WRITTEN FOR ASSIST TO BE RUN UNDER OS/360 DIRECTLY. * 00122000 +.* USES MODULE XXXXDECI TO SCAN DECIMAL STRING BEGINNING AT * 00124000 +.* &ADDRESS, CONVERT ITS VALUE INTO REGISTER ®, AND SET * 00126000 +.* REGISTER R1 AS A SCAN POINTER TO THE DELIMITER FOLLOWING THE * 00128000 +.* STRING OF DECIMAL DIGITS. THE CONDITION CODE IS SET BY THE * 00130000 +.* VALUE IN ®, UNLESS AN ERROR OCCURRS, IN WHICH CASE CC=3. * 00132000 +.* SEE ASSIST USER MANUAL FOR USAGE INSTRUCTIONS. * 00134000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00136000 + LCLC &XLABL FOR CREATION OF LABEL 00138000 +&XLABL SETC 'XX&SYSNDX.E' CREATE UNIQUE LABEL 00140000 + CNOP 2,4 . LINE UP ON BOUNDARY 00142000 +&LABEL STM 14,1,&XLABL . SAVE LINKAGE REGS 00144000 + LA 0,&ADDRESS . BEGINNING @ FOR SCANNING 00146000 + L 15,&XLABL-4 . GET ADCON FOR CONVERSION 00148000 + BALR 14,15 . CALL ROUTINE, PT WITH R14 00150000 + DC V(XXXXDECI) . ADCON FOR CONVERSION ROUTINE 00152000 +&XLABL DS 5F . REGS 14,15,0,1, VALUE FOR ® 00154000 + LM 14,1,4(14) . RELOAD REGS 00156000 + BO *+8 . BRANCH IF ® SHOULDN'T CHANGE 00158000 + L ®,&XLABL+16 . GET VALUE FOR ® 00160000 + AIF (T'® EQ 'N' AND '®' NE '1').XXEXIT SKIP IF SAFE 00162000 + L 1,&XLABL+12 . USER MAY HAVE REG=1, LOAD FOR SAFE 00164000 +.XXEXIT MEND 00166000 +./ ADD LEVEL=40,SOURCE=0,NAME=XDECO 00168000 + MACRO 00170000 +&LABEL XDECO ®,&ADDRESS 00172000 +.*--> MACRO: XDECO EXTENDED DECIMAL OUTPUT CONVERSION* * * * * * * 00174000 +.* USES MODULE XXXXDECO TO CONVERT VALUE IN REGISTER ® TO * 00176000 +.* AN EDITED 12-BYTE FIELD, WITH SIGN, AT LOCATION &ADDRESS. * 00178000 +.* EXTENDED DECIMAL OUTPUT MACRO - ENABLES PROGRAMS * 00180000 +.* WRITTEN FOR ASSIST TO BE RUN UNDER OS/360 DIRECTLY. * 00182000 +.* SEE ASSIST USER MANUAL FOR USAGE INSTRUCTIONS. * 00184000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00186000 + LCLC &XLABL FOR CREATION OF UNIQUE LABEL 00188000 +&XLABL SETC 'XX&SYSNDX.D' CREATE UNIQUE LABEL 00190000 + CNOP 2,4 . LINE UP ON RIGHT BOUNDARY 00192000 +&LABEL STM 14,0,&XLABL . STORE LINKAGE REGS 00194000 + ST ®,&XLABL+12 . SAVE VALUE TO BE CONVERTED 00196000 + LA 0,&ADDRESS . OBTAIN @ OPERAND FILED 00198000 + L 15,&XLABL-4 . GET ADCON FOR CONVERSION PROG 00200000 + BALR 14,15 . CALL XXXXDECO, PT R14 00202000 + DC V(XXXXDECO) . ADCON FOR CONVERSION PROG 00204000 +&XLABL DS 4F . REGS 14,15,0, REG TO BE CONVERTED 00206000 + LM 14,0,4(14) . RELOAD LINKAGE REGISTERS 00208000 + MEND 00210000 +./ ADD LEVEL=40,SOURCE=0,NAME=XDUMP 00212000 + MACRO 00214000 +&LABEL XDUMP &AREA,&LENGTH 00216000 +.*--> MACRO: XDUMP ASSIST COMPATIBILITY DUMP MACRO . . . . . . . . 00218000 +.* MACRO FOR STORAGE AND REGISTER DUMPING. ENABLES * 00220000 +.* PROGRAMS WRITTEN FOR ASSIST TO BE RUN DIRECTLY UNDER OS/360. * 00222000 +.* SEE ASSIST USER MANUAL FOR USAGE * 00224000 +.* *NOTE* USES XSNAP, SO REQUIRES XSNAPOUT DD SYOUT=A CARD. * 00226000 +.*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 00228000 + AIF (T'&AREA EQ 'O').XREGS SKIP TO REGS IF NO OPS 00230000 + AIF (T'&LENGTH EQ 'O').XSTDF DEFAULT LENGTH IF NONE 00232000 +.* DUMP STORAGE, USING SUPPLIED LENGTH &LENGTH. 00234000 +&LABEL XSNAP T=NO,LABEL='USER STORAGE', #00236000 + STORAGE=(*&AREA,*&LENGTH+&AREA) 00238000 + MEXIT 00240000 +.* DUMP STORAGE, USING DEFAULT LENGTH OF 4. 00242000 +.XSTDF ANOP 00244000 +&LABEL XSNAP T=NO,LABEL='USER STORAGE', #00246000 + STORAGE=(*&AREA,*4+&AREA) 00248000 + MEXIT 00250000 +.* &AREA,&LENGTH OMITTED --> DUMP REGISTERS. 00252000 +.XREGS ANOP 00254000 +&LABEL XSNAP LABEL='USER REGISTERS' 00256000 + MEND 00258000 +./ ADD LEVEL=40,SOURCE=0,NAME=XGET 00260000 + MACRO 00262000 +&XLABEL XGET &XAREA,&XNUM 00264000 +.*--> MACRO: XGET GET RECORD OFF OF &DDNAME FILE . . . . . . . . . * 00266000 +.* RICHARD FOWLER AUG, 1972 V.5.0 * 00268000 +.* MACRO FOR EASY READING OFF OF ANY DD FILE, READS &XNUM * 00270000 +.* CHARACTERS. CONDITION CODE SET TO 0 NORMALLY, OR TO 1 ON * 00272000 +.* END OF FILE. GENERATION CONTROLLED BY &XGETST. * 00274000 +.* EXECUTION ASSUMES REG 1 POINTS TO DD NAME * 00276000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ** 00278000 + GBLB &XGETST GENERATION STATUS- 0=YES, 1=NO 00280000 + AIF (&XGETST).XNOGEN IF SHOULDN'T GENERATE-SKIP CALL 00282000 +&XLABEL XIONR XXXXGET,&XNUM,&XAREA,80 00284000 + MEXIT 00286000 +.XNOGEN AIF (T'&XLABEL EQ 'O').XXEXIT GEN LABEL ONLY IF NEEDED 00288000 +&XLABEL DS 0H . LABEL FOR CANCELLED XGET 00290000 +.XXEXIT MEND 00292000 +./ ADD LEVEL=40,SOURCE=0,NAME=XGPGEN 00294000 + MACRO 00296000 +&LABEL XGPGEN &DIREC=G,&FETCH=NOT,&DDNUM=20 00298000 +.** --> MACRO: XGPGEN GENERATE GENERAL I/O MODULES . . . . . . . . . . 00300000 +.* RICHARD FOWLER NOV, 1972 V.5.0 . 00302000 +.* . 00304000 +.* ARGUMENTS: . 00306000 +.* &DIREC = P --> OUTPUT . 00308000 +.* ^= P --> INPUT . 00310000 +.* &FETCH =NOT --> NO FETCH PROTECTION . 00312000 +.* ^=NOT --> FETCH PROTECTION . 00314000 +.* &DDNUM = MAXIMUM NUMBER OF DD NAMES ALLOWED AT ONCE . 00316000 +.* (**EACH DD FILE REQUIRES 3F TABLE ENTRY PLUS DCB AND BUFFER**) . 00318000 +.*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 00320000 + TITLE ' &LABEL - MODULE CREATED BY XGPGEN' 00322000 + DCBD DSORG=QS 00324000 +* * * * * XIOBLOCK - CONTROL BLOCK SET UP BY XREAD/XPRNT/XPNCH * * * * 00326000 +XIOBLOCK DSECT 00328000 + DS V . @ I/O ROUTINE 00330000 + DS 3F AREA FOR REGS 15-0 TO BE SAVED 00332000 +XIOLENG DS AL2 . LENGTH OF RECORD, (CODES-FUTURE USEQ 00334000 +XIORETRN LM 14,0,4(14) RETURN CODE FOR RESTORING REGISTERS 00336000 +&LABEL CSECT 00338000 +*--> CSECT: EXTENDED I/O MODULE FOR GENERAL I/O . . . . . . . . . . . . 00340000 +* THIS MODULE IS CALLED TO DO GENERAL I/O WORK ON A FILE . 00342000 +* SIMILAR IN OPERATION TO THE XIO ROUTINES, BUT CAN HANDLE 00344000 +* MANY FILES AT ONCE. . 00346000 +* ENTRY CONDITIONS: . 00348000 +* R14 = @ OF CONTROL BLOCK . 00350000 +* R15 = ENTRY POINT ADDRESS . 00352000 +* R0 = ADDRESS OF AREA TO MOVE DATA INTO . 00354000 +* R1 = ADDRESS OF DD NAME TO BE USED . 00356000 +* CONTROL BLOCK: . 00358000 +* OFFSET LENGTH WHAT . 00360000 +* 0 1F ENTRY POINT ADDRESS . 00362000 +* 4 3F SAVE AREA . 00364000 +* 16 2 LENGTH OF AREA . 00366000 +* . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 00368000 + USING *,15 . NOTE TEMPORARY ADDRESSABILITY 00370000 + USING XIOBLOCK,R14 00372000 + STM R13,R7,X&DIREC.SAV1 SAVE REGISTERS TO BE USED A 00374000 + CNOP 0,4 . GET ON FULLWORD 00376000 + BAL R13,*+76 SET UP FAKE AREA PNTR - BASE 00378000 + USING *,R13 . NOTE NEW USING/SAVE AREA POINTER 00380000 + DS 18F . FAKE SAVE AREA 00382000 + DROP R15 . KILL OLD ADDRESSING 00384000 + SPACE 2 00386000 + USING IHADCB,R1 . SET UP ADDRESSIBILITY TO DCB S 00388000 + MVC X&DIREC.CURENT(8),0(R1) . GET CURRENT DD NAME 00390000 +* CHECK FOR CLOSE 00392000 + SR R1,R1 GET ZERO LENGTH INDICATOR 00394000 + CH R1,XIOLENG ARE THEY EQUAL? 00396000 + BE X&DIREC.EOF . YES-GO CLOSE AND FORGET FILE 00398000 + XXGPSRCH &DIREC 00400000 +* THE FOLLOWING CODE, IF EXECUTED, GENERATES A DCB AND TRIES AN OPEN 00402000 +* 00404000 +X&DIREC.MAKE C R1,=A(X&DIREC.FULL) CHECK FOR TABLE OVERFLOW 00406000 + BNL X&DIREC.CC3 NO SPACE, DON'T TRY OPEN-RETURN J 00408000 + ST R1,X&DIREC.ELEM . SAVE NEW ADDRESS, R1 ALREADY POINTIN 00414000 + MVC 0(8,R1),X&DIREC.CURENT SAVE DD NAME FOR FUTURE CALLS 00416000 + L 0,X&DIREC.LONG 00418000 + GETMAIN R,LV=(0) . LOAD R1 WITH ADDR OF NEW DCB 00420000 + L R2,X&DIREC.ELEM . GET ADDRESS OF POINTER 00422000 + ST R1,8(R2) . SAVE @ OF DCB 00424000 +* 00426000 + ST R1,X&DIREC.FULL KLUDGE TO GET AROUND ADDRESSIBILITY 00428000 + MVC X&DIREC.OPEN+1(3),X&DIREC.FULL+1 COPY OVER DCB @ INTO J 00430000 +* 00432000 + MVC 0(X&DIREC.ELEM-X&DIREC.DCB,R1),X&DIREC.DCB BUILD DCB 00434000 + MVC DCBDDNAM,X&DIREC.CURENT MOVE DD NAME INTO DCB 00436000 + OPEN MF=(E,X&DIREC.DCBPTR) DO REMOTE OPEN 00438000 + L R1,X&DIREC.FULL . FIX R1, DESTROYED IN OPEN 00440000 + TM DCBOFLGS,X'10' . DID OPEN GO? 00442000 + BO X&DIREC.CONT4 YES, DO I/O 00444000 +* OPEN DIDN'T GO - CLEAN UP SO DOESN'T BOMB LATER J 00445000 + L R0,X&DIREC.LONG GET LENGTH OF DCB FOR FREEMAIN J 00446000 + FREEMAIN R,LV=(0),A=(1) GIVE THE SPACE BACK TO OS J 00447000 + XC 0(12,R2),0(R2) CLEAR OUT SO WON'T THINK IT'S OPEN J 00448000 +X&DIREC.CC3 TM *+1,X'FF' SET CC=3 ==> OPEN IMPOSSIBLE J 00449000 + B X&DIREC.RET RETURN TO USER 00450000 + SPACE 2 00452000 +X&DIREC.CONT L R1,8(R1) . GET DCB ADDRESS 00454000 +X&DIREC.CONT4 LH R5,XIOLENG GET LENGTH OF AREA 00456000 + AIF ('&FETCH' EQ 'PROTECT').SKPFTCH 00458000 + L R2,X&DIREC.SAV1+12 GET @ I/O AREA 00460000 +* THE FOLLOWING CODE IS USED FOR ADDRESS ILLEGAL ****************** 00462000 +***** THIS CODE WILL NOT WORK IF MACHINE HAS FETCH PROTECT *********** 00464000 + SPACE 2 00466000 + L R4,16 . GET CVT PNTR FROM LOC 16 00468000 + LA R0,0(R2,R5) . GET ENDING ADDRESS OF I/O AREA 00470000 + C R0,164(R4) . COMPARE TO CVTMZ00 - HIGHEST ADDRESS 00472000 + BNL X&DIREC.ABD3 . GO ABEND IF HIGHER 00474000 +.SKPFTCH ANOP 00476000 + AIF ('&DIREC' EQ 'P').XOUT SKIP IF OUTPUT 00478000 + LH R7,DCBLRECL GET LRECL FROM DCB J 00479000 + GET IHADCB . GET # BUFFER 00480000 + CLR R5,R7 COMPARE REQUEST LENGTH TO LRECL J 00481000 + BNH *+6 SKIP AROUND IF OK J 00482000 + LR R5,R7 TOO BIG, USE LRECL INSTEAD J 00483000 + LR R4,R5 . SET UP FOR SHIFT 00484000 + SRDL R4,8 . PUT RIGHTMOST BYTE IN R5 00486000 + SRL R5,24 . RIGTH JUSTIFY FOR MOVE 00488000 + LTR R4,R4 . ANYTHING LEFT IN R4? 00490000 + BE *+22 . NO - DO NORMAL MOVE 00492000 + MVC 0(256,R2),0(R1) . GIVE USER 256 BYTES OF DATA 00494000 + LA R2,256(R2) . GO TO NEXT BLOCK 00496000 + LA R1,256(R1) . GO TO NEXT BLOCK 00498000 + BCT R4,*-14 . IF ANYTHING LEFT IN R4, DO ANOTHER 00500000 +* NORMAL MOVE FOLLOWS 00502000 + LTR R5,R5 . IS ANYTHING IN R5? 00504000 + BE *+10 . NO - DONT MOVE LEFTOVER BYTES 00506000 + BCTR R5,0 . DECREMENT LENGTH BY 1 00508000 + EX R5,X&DIREC.MOV . MOVE INTO RIGHT PLACE 00510000 +.XCLOSE ANOP 00512000 + SR R0,R0 . SET COND CODE TO 0, USER OK 00514000 + B X&DIREC.RET . GO TO RETURNX&DIREC.EOF CLOSE IHADCB 00516000 +X&DIREC.EOF EQU * 00518000 + XXGPSRCH &DIREC,2 00520000 +X&DIREC.MAKE2 B X&DIREC.RET . GO RETURN 00522000 +X&DIREC.CONT2 LR R4,R1 . SAVE THE ADDRESS 00524000 + MVC X&DIREC.PTR+1(3),9(R1) 00526000 + LA R1,X&DIREC.PTR 00528000 + CLOSE MF=(E,(1)) DO REMOTE CLOSE 00530000 + L R1,8(R4) . POINT TO DCB TO FREE 00532000 + FREEPOOL (1) FREE THE BUFFERS 00534000 + L R1,8(R4) RESET R1 IN CASE DESTROYED 00536000 + L R0,X&DIREC.LONG GET AMOUNT TO FREE 00538000 + FREEMAIN R,LV=(0),A=(1) 00540000 +* 00542000 +* DCB NO LONGER EXISTS, REMOVE CORRESPONDING ELEMENT FROM LIST 00544000 +* 00546000 + LA R3,X&DIREC.FULL . GET UPPER ADDRESS OF TABLE 00548000 + SR R3,R4 . FIND LENGTH OF REST OF TABLE 00550000 + EX R3,X&DIREC.WIPOUT WIPEOUT 12 BYTES OF MEMORY 00552000 +* 00554000 +* IF NO POINTERS REMAIN, SET POINTER TO LAST TO ZERO 00556000 +* 00558000 + LA R3,12 00560000 + L R2,X&DIREC.ELEM 00562000 + SR R2,R3 00564000 + LA R1,X&DIREC.PNTSRT 00566000 + CR R1,R2 00568000 + BNH *+8 00570000 + LA R2,0 . SET POINTER TO ZERO 00572000 + ST R2,X&DIREC.ELEM SAVE POINTER 00574000 + AIF ('&DIREC' EQ 'P').XRET 00576000 + OI *+1,1 . SET COND CODE FOR END OF FILE 00578000 +.* SHOULD REMOVE DCB FROM LIST NOW 00580000 + AGO .XRET . HAVE RETURN CODE GENERATED 00582000 +.* 00584000 +.XOUT ANOP 00586000 + LH R7,82(R1) . GET LRECL 00588000 + PUT IHADCB . PRINT THE STUFF 00590000 + CLR R5,R7 COMPARE REQUEST LENGTH TO LRECL J 00591000 + BNH *+6 SKIP AROUND IF OK LENGTH J 00592000 + LR R5,R7 TOO BIG- USE LRECL INSTEAD J 00593000 + LR R4,R5 . SET UP FOR SHIFT 00594000 + LR R6,R5 SAVE FOR LATER 00596000 + SRDL R4,8 . PUT RIGHTMOST BYTE IN R5 00598000 + SRL R5,24 . RIGTH JUSTIFY FOR MOVE 00600000 + LTR R4,R4 . ANYTHING LEFT IN R4? 00602000 + BE *+22 . NO - DO NORMAL MOVE 00604000 + MVC 0(256,R1),0(R2) . PUT STUFF INTO BUFFER 00606000 + LA R2,256(R2) . GO TO NEXT BLOCK 00608000 + LA R1,256(R1) . GO TO NEXT BLOCK 00610000 + BCT R4,*-14 . IF ANYTHING LEFT IN R4, DO ANOTHER 00612000 +* NORMAL MOVE FOLLOWS 00614000 + LTR R5,R5 . IS ANYTHING IN R5? 00616000 + BE *+12 00618000 + BCTR R5,0 . DECREMENT LENGTH BY 1 00620000 + EX R5,X&DIREC.MOV . MOVE INTO RIGHT PLACE 00622000 + AR R1,R5 GET BEGINNING @ TO BLANK 00624000 + SR R7,R6 GET DIFFERENCE BETWEEN USER AND DCB 00626000 + BZ *+12 NO DIFFERENCE, DO NOTHING A 00628000 + MVI 1(R1),C' ' 00630000 + EX R7,X&DIREC.MOV2 CLEAR REST 00632000 +* ****NOTE THAT THIS ONLY WORKS FOR DIFFERENCES < 256 00634000 + AGO .XCLOSE 00636000 +.* 00638000 +.XRET ANOP 00640000 + SPACE 2 00642000 +X&DIREC.RET LM R13,R7,X&DIREC.SAV1 RESTORE REGS A 00644000 + B XIORETRN RETURN 00646000 + DROP R14 00648000 +X&DIREC.ABD3 CLI *,0 SET CC=2, SHOW EXECUTE ERROR J 00650000 + B X&DIREC.RET GO RETURN, SHOWING ERROR J 00652000 +.* 00656000 + SPACE 2 00658000 +X&DIREC.PTR CLOSE (X&DIREC.CONT),MF=L GENERAL PURPOSE CLOSE 00660000 +X&DIREC.WIPOUT MVC 0(1,R4),12(R4) 00662000 +X&DIREC.CURENT DS CL8 . AREA TO HOLD CURRENT DD NAME 00664000 +X&DIREC.SAV1 DS 11F SAVE AREA FOR REGS USED A 00666000 +X&DIREC.PNTSRT DS (&DDNUM*3)F . AREA FOR DDNUM DD NAMES & POINTERS 00668000 +X&DIREC.FULL DS F 00670000 +X&DIREC.OPEN DS 0F EXTRA LABEL 00672000 + AIF ('&DIREC' EQ 'P').XDEFSR SKIP IF OUTPUT 00674000 +X&DIREC.DCBPTR OPEN (X&DIREC.CONT,(INPUT)),MF=L OPEN CONTROL WORD J 00676000 +X&DIREC.DCB DCB DSORG=PS,MACRF=GL,EODAD=X&DIREC.EOF 00678000 +X&DIREC.ELEM DC F'0' . INITIAL # OF ELEMENTS 00680000 +XX&DIREC.LONG EQU X&DIREC.ELEM-X&DIREC.DCB GET DCB LENGTH 00682000 +X&DIREC.LONG DC A(XX&DIREC.LONG) SAVE LENGTH OF DCB 00684000 +X&DIREC.MOV MVC 0(1,R2),0(R1) . GIVES USER THE DATA 00686000 + LTORG 00688000 + DROP R13 00690000 + MEXIT DONE 00692000 +.XDEFSR ANOP 00694000 +X&DIREC.DCBPTR OPEN (X&DIREC.CONT,(OUTPUT)),MF=L OPEN CONTROL WORD J 00696000 +X&DIREC.DCB DCB DSORG=PS,MACRF=PL 00698000 +X&DIREC.ELEM DC F'0' . INITIAL # OF ELEMENTS 00700000 +XX&DIREC.LONG EQU X&DIREC.ELEM-X&DIREC.DCB GET DCB LENGTH 00702000 +X&DIREC.LONG DC A(XX&DIREC.LONG) SAVE LENGTH OF DCB 00704000 +X&DIREC.MOV MVC 0(1,R1),0(R2) . MOVE INTO LINE 00706000 +X&DIREC.MOV2 MVC 2(1,R1),1(R1) CLEAR OUT REST OF BUFFER 00708000 + LTORG 00710000 + DROP R13 00712000 + MEND 00714000 +./ ADD LEVEL=41,SOURCE=0,NAME=XHEXI 00716000 + MACRO 00718000 +&NAME XHEXI ®,&ADDR 00720000 +.* * 00722000 +.*-->MACRO: XHEXI HEXADECIMAL INPUT CONVERSION MACRO. * 00724000 +.* WRITTEN BY ALAN ARTZ 4/17/72 * 00726000 +.* THIS MACRO TAKES THE VALUE STARTING AT THE ADDRESS GIVEN BY * 00728000 +.* &ADDR AND CONVERTS IT AND PUTS THE HEXADECIMAL VALUE IN ®. * 00730000 +.* IF THERE ARE MORE THAN 8 DIGITS, R1 POINTS TO THE 9TH AND THE * 00732000 +.* FIRST 8 ARE CONVERTED. IF THERE IS A NON-BLANK, NON-HEX DIGIT * 00734000 +.* FOUND, R1 POINTS TO THAT CHARACTER AND THE CC=3, OTHERWISE CC SET * 00736000 +.* BY VALUE IN REG. * 00738000 +.* * 00740000 +.* CALLS MODULE XXXXHEXI TO DO THE ACTUAL CONVERSIONS * 00742000 +.* * 00744000 +.********************************************************************** 00746000 + LCLC &LABEL 00748000 +&LABEL SETC 'XX&SYSNDX.H' UNIQUE LABEL 00750000 +&NAME STM 14,0,&LABEL . SAVE REGISTERS 00752000 + ST ®,&LABEL+12 . REGISTER STORE INCASE OF OVERFLOW CND 00754000 + LA 0,&ADDR . GET STRING TO BE CONVERTED 00756000 + CNOP 2,4 . GET PROPER ALIGNMENT 00758000 + L 15,&LABEL-4 . ADDRESS OF XXXXHEXI 00760000 + BALR 14,15 . GO TO APPROPRIATE PLACE 00762000 + DC V(XXXXHEXI) . VCON OF ROUTINE 00764000 +&LABEL DS 4F . STORAGE FOR REGISTERS 00766000 + LM 14,0,4(14) . RESTORE REGISTERS 00768000 + L ®,&LABEL+12 . GET CONVERTED NUMBER 00770000 + MEND 00772000 +./ ADD LEVEL=41,SOURCE=0,NAME=XHEXO 00774000 + MACRO 00776000 +&NAME XHEXO ®,&ADDR 00778000 + LCLC &LABEL 00780000 +.* * 00782000 +.*-->MARCO: XHEXO HEXADECIMAL OUTPUT CONVERSION MACRO * 00784000 +.* WRITTEN BY ALAN ARTZ 4/17/72 * 00786000 +.* THIS MACRO TAKES THE VALUE IN & REG AND CONVERTS IT TO * 00788000 +.* PRINTABLE FORM. * 00790000 +.* IT PUTS THE CONVERTED VALUE IN AN EIGHT BYTE AREA STARTING AT* 00792000 +.* THE ADDRESS GIVEN IN &ADDR. * 00794000 +.* THE CONDITION CODE IS NOT CHANGED AND NETHER ARE THE REGISTERS* 00796000 +.* * 00798000 +.* CALLS MODULE XXXXHEXO TO DO THE ACTUAL CONVERSIONS. * 00800000 +.* * 00802000 +.********************************************************************** 00804000 +&LABEL SETC 'XX&SYSNDX.H' UNIQUE LABEL 00806000 +&NAME DS 0H 00808000 + STM 14,0,&LABEL . SAVE REGIST5RS 00810000 + ST ®,&LABEL+12 . SAVE REGISTER 00812000 + LA 0,&ADDR . PASS REGISTER TO XXXXHEXO 00814000 + CNOP 2,4 . GDT PROPER ALIGNMENT 00816000 + L 15,&LABEL-4 . ADDRESS OF XXXXHEXO 00818000 + BALR 14,15 . CALL HEXO 00820000 + DC V(XXXXHEXO) 00822000 +&LABEL DS 4F . STORAGE FOR REGISTERS 00824000 + LM 14,0,&LABEL . RESTORE REGISTERS 00826000 + MEND 00828000 +./ ADD LEVEL=40,SOURCE=0,NAME=XIDENT 00830000 + MACRO 00832000 + XIDENT &ID,&LABEL,&XCSECT,&PRIVATE 00834000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00836000 +.*--> MACRO: XIDENT IDENTIFY ENTRY POINT FOR XSAVE,$SAVE. * 00838000 +.* MACRO USED BY XSAVE TO PRODUCE ID AT AN ENTRY POINT. WILL * 00840000 +.* USE THE FIRST NON-NULL OPERAND PASSED TO IT AS THE ID. * 00842000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00844000 + LCLA &I,&J LOCAL COUNTERS 00846000 +&I SETA 1 INITIALIZE 00848000 + AIF ('&ID' NE '*').XIDINC SKIP IF EXPLICIT ID FIELD 00850000 +.XILOOP ANOP 00852000 +&I SETA &I+1 INCREMENT TO NEXT ONE 00854000 + AIF ('&SYSLIST(&I)' EQ '').XILOOP SKIP BACK IF THIS IS NULL 00856000 +.XIDINC ANOP 00858000 +&J SETA 6+((K'&SYSLIST(&I)+1)/2)*2 GET BRANCH LENGTH 00860000 + B &J.(,15) . BRANCH AROUND ID 00862000 +&J SETA &J-5 GET ACTUAL LENGTH OF ID 00864000 + DC AL1(&J),CL&J'&SYSLIST(&I)' 00866000 + MEND 00868000 +./ ADD LEVEL=40,SOURCE=0,NAME=XIOGN 00870000 + MACRO 00872000 +&XLABEL XIOGN &LRECL=80,&BLKSIZE=80,&XOP=OUTPUT,&RECFM=,&DDNAME=, #00874000 + &BUFNO=1 00876000 +.*--> MACRO: XIOGN I/O SUPPORT MODULE GENERATION . . . . . . . . . 00878000 +.* JOHN R. MASHEY - FEB 1970 - V.5.0 * 00880000 +.* MACRO USED TO GENERATE THE I/O CSECTS USED BY THE XIOPAK * 00882000 +.* MACROS XREAD,XPRNT,XPNCH. THE CSECTS ARE CALLED EACH TIME * 00884000 +.* ONE OF THE MACROS IS CALLED, AND DOES REQUIRED OPN'S, GET'S, * 00886000 +.* PUT'S, ETC . * 00888000 +.* **ARGUMENTS** * 00890000 +.* BLKSIZE,BUFNO,LRECL,RECFM= ARGUMENTS FOR CREATED DCB. * 00892000 +.* DEFAULTS: BLKSIZE=80,BUFNO=1,LRECL=80. * 00894000 +.* IF MODULE DESIRED FOR USE WITH VARIABLE JCL VALUES, * 00896000 +.* CODE BLKSIZE=0,BUFNO=0,LRECL=0. * 00898000 +.* XOP= EITHER INPUT OR OUTPUT, DENOTING DIRECTION OF I/O. * 00900000 +.* DEFAULT: OUTPUT. * 00902000 +.* DDNAME= LIST OF DDNAMES WHICH MODULE CAN USE FOR I/O. * 00904000 +.* WILL ATTEMPT OPEN OF EACH ONE, IN ORDER GIVEN, UNTIL * 00906000 +.* ONE SUCCEEDS OR LIST IS EXHAUSTED. * 00908000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00910000 + GBLB &XIOGNST =0 ==> HAVEN'T GEND XIOBLOCK 00912000 + LCLA &XDD COUNTER FOR # DDNAMES 00914000 + LCLB &XIO OUTPUT=1,INPUT=0 00916000 + LCLC &X PREFIX OF ALL LABELS 00918000 +&XDD SETA N'&DDNAME GET # OF DDNAMES TO BE TRIED 00920000 +&XIO SETB ('&XOP' EQ 'OUTPUT') SET FOR INPUT OR OUTPUT 00922000 +&X SETC '&XLABEL'(3,4) GET LABEL START 00924000 + TITLE ' *** &XLABEL *** I/O ROUTINE' 00926000 +&XLABEL CSECT 00928000 + ENTRY &X.DCB 00930000 + USING XIOBLOCK,R14 . NOTE POINTER TO CONTROL BLOCK 00932000 + USING *,R15 . NOTE TEMPORARY ADDRESSIBILITY 00934000 + STM R13,R5,&X.SAV1 . SAVE REGS WHICH WILL BE USED 00936000 + CNOP 0,4 . MAKE SURE ALIGNED ON FULLWORD 00938000 + BAL R13,*+76 . SET UP FAKE SAVE AREA PTR,BASE 00940000 + USING *,R13 . NOTE NEW USING/SAVE AREA POINTER 00942000 + DS 18F . FAKE SAVE AREA,FOR GET/PUT ETC 00944000 + DROP R15 . KILL OLD ADDRESSING 00946000 + SPACE 2 00948000 +.XASA1 AIF (&XIO).XOUT SKIP IF OUTPUT 00950000 +&X.EOFT NOP &X.ABD2 . *** WILL BECOME A B AFTER EOF EXIT 00952000 +.XOUT ANOP 00954000 +&X.TES1 NOP &X.GO . *** WILL BE A BRANCH AFTER OPEN GOES 00956000 + LR R5,R14 SAVE R14 AROUND CALL TO XXXXOPEN 00958000 + LA 1,&X.OPBK . GET ADDRESS OF CONTROL TABLE 00960000 + L 15,&X.OPAD . GET BRANCH ADDRESS 00962000 + BALR 14,15 . CALL XXXXOPEN ROUTINE 00964000 + LR R14,R5 RESTORE R14 00966000 +&X.OPOK MVI &X.TES1+1,X'F0' . CHANGE NOP TO B-DONT OPEN AGAIN 00968000 +&X.GO LH R4,&X.DCB+82 . GET DCB LRECL FOR COMPARISON 00970000 + LH R5,XIOLENG . GET LENGTH FROM CONTROL BLOCK 00972000 + BCTR R5,0 . DECREMENT TO LENGTH-1 00974000 + CLR R4,R5 . COMPARE WITH LIMIT 00976000 + BH *+8 . SKIP IF WITHIN RANGE 00978000 + LR R5,R4 . MOVE DEFAULT VALUE OVER 00980000 + BCTR R5,0 . DECREMENT DEFAULT TO LENGTH-1 00982000 +.XASB SPACE 2 00984000 + L R2,&X.SAV1+12 . GET ADDRESS OF I/O AREA (FROM R0) 00986000 +.* 00988000 +* THE FOLLOWING CODE IS USED TO CHECK FOR ADDRESS ILLEGAL * 00990000 +* THIS CODE WILL NOT WORK IF MACHINE HAS FETCH PROTECT********** 00992000 + L R1,16 . GET CVT POINTER FROM LOC 16 00994000 + LA R0,1(R2,R5) . GET ENDING ADDRESS OF I/O AREA 00996000 + C R0,164(R1) . COMPARE TO CVTMZ00-HGIHEST ADDRESS 00998000 + BNL &X.ABD3 . GO ABEND IF HIGHER 01000000 +.* 01002000 + AIF (&XIO).XOUT1 SKIP IF OUTPUT MODE 01004000 + GET &X.DCB OBTAIN @ BUFFER 01006000 + EX R5,&X.MOV . MOVE REQUESTED NUMBER OF BYTES 01008000 + SR R0,R0 . SET CONDITION CODE=0, SHOW USER OK 01010000 + B &X.RET . GO TO RETURN TO CALLER 01012000 +&X.ABD2 WTO ' &XLABEL ABEND 300 - ATTEMPT TO READ PAST END-OF-FILE',X01014000 + ROUTCDE=11 01016000 + B &X.ABD1 . GO ABEND 01018000 +&X.EOF CLOSE &X.DCB 01020000 + LA 1,&X.DCB POINT 1 TO DCB TO FREE BUFFER 01022000 + FREEPOOL (1) FREE THE BUFFERS 01024000 + OI *+1,1 . SET CONDITON CODE TO 1 01026000 + MVI &X.EOFT+1,X'F0' . CHANGE NOP TO B-NO MORE READS 01028000 + AGO .XRET HAVE RETURN CODE GENRATED 01030000 +.* 01032000 +.XOUT1 EX R5,&X.MOV . MOVE NUMBER OF BYTES TO OUTPUT LINE 01034000 + PUT &X.DCB,&X.BUF 01036000 + EX R5,&X.MOV1 . REBLANK OUTPUT LINE 01038000 +.* 01040000 +.XRET ANOP 01042000 + SPACE 2 01044000 +&X.RET LM R13,R5,&X.SAV1 . RESTORE THE REGS WE CHANGED 01046000 + AIF (NOT &XIO).XOUT2 SKIP SPM IF THIS WAS AN INPUT 01048000 + SPM R14 . RESTORE THE CONDITION CODE 01050000 +.XOUT2 B XIORETRN . RETURN TO CALLING XIOBLOCK 01052000 +&X.ABD3 WTO ' &XLABEL ABEND 300-ILLEGAL ADDRESS-SEE REG 2', X01054000 + ROUTCDE=11 01056000 +&X.ABD1 ABEND 300,DUMP 01058000 +.* 01060000 + SPACE 2 01062000 +&X.SAV1 DS 9F . AREA TO PRESERVE REGS IN 01064000 +&X.OPAD DC V(XXXXOPEN) . ADDRESS OF SUPEROPEN ROUTINE 01066000 +&X.OPBK XOPENBLK &X.DCB,&XLABEL,&DDNAME,RECFM=&RECFM,LRECL=&LRECL, #01068000 + BLKSIZE=&BLKSIZE,BUFNO=&BUFNO,XOP=&XOP 01070000 +.XNODD AIF (&XIO).XOUT3 SKIP IF OUTPUT 01072000 +.* 01074000 +&X.MOV MVC 0(0,R2),0(R1) . R1==> BUFFER, EXECUTE SUPPLIES LENGT 01076000 +&X.DCB DCB DSORG=PS,MACRF=GL,EODAD=&X.EOF 01078000 + AGO .XEXIT 01080000 +.* 01082000 +.XOUT3 ANOP 01084000 +&X.BUF DC CL(&LRECL)' ' . OUTPUT I/O BUFFER AREA 01086000 +&X.BLNK DC CL(&LRECL)' ' . FOR REBLANKING OUTPUT BUFFER 01088000 +&X.MOV MVC &X.BUF(0),0(R2) . MOVE RIGHT NUMBER OF CHARS TO BUFFER 01090000 +&X.MOV1 MVC &X.BUF(0),&X.BLNK EXECUTED MOVE TO REBLANK BUFFER 01092000 +&X.DCB DCB DSORG=PS,MACRF=PM 01094000 +.XEXIT DROP R13,R14 . KILL LEFTOVER ADDRESSING 01096000 +.* 01098000 + AIF (&XIOGNST).XXEXIT SKIP IF ALREADY GEND XIOBLOCK 01100000 +&XIOGNST SETB (1) SHOW WE'VE GENERATE XIOBLOCK 01102000 + EJECT 01104000 +* * * * * XIOBLOCK - CONTROL BLOCK SET UP BY XREAD/XPRNT/XPNCH * * * * 01106000 +XIOBLOCK DSECT 01108000 + DS V . @ I/O ROUTINE 01110000 + DS 3F AREA FOR REGS 15-0 TO BE SAVED 01112000 +XIOLENG DS AL2 . LENGTH OF RECORD, (CODES-FUTURE USEQ 01114000 +XIORETRN LM 14,0,4(14) RETURN CODE FOR RESTORING REGISTERS 01116000 +.XXEXIT MEND 01118000 +./ ADD LEVEL=40,SOURCE=0,NAME=XIONR 01120000 + MACRO 01122000 +&XLABEL XIONR &XNAME,&XNUM,&XAREA,&XDEFT 01124000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01126000 +.*--> MACRO: XIONR INNER MACRO-$READ,$PNCH,$PRNT,$SORC * 01128000 +.* JOHN R. MASHEY - FEB 1970 - V.5.0 * 01130000 +.* XIONR IS USED BY XIOPAK MACROS XREAD,XPRNT,XPNCH TO SET UP * 01132000 +.* THE REQUIRED CODE FOR CALLING THEIR RESPECTIVE SUBROUTINES. * 01134000 +.* *** ARGUMENTS *** * 01136000 +.* XNAME THE NAME OF THE I/O ROUTINE TO BE CALLED. * 01138000 +.* XNUM THE LENGTH OF XAREA TO BE PRINTED,PUNCHED,ETC. * 01140000 +.* XAREA THE AREA ON WHICH I/O OPERATION TO BE PERFORMED. * 01142000 +.* MAY BE SPECIFIED BY (0) OR (R0). * 01144000 +.* XDEFT DEFAULT VALUE OF XNUM TO BE USED, IF IT IS OMITTED * 01146000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ** 01148000 +.* * 01150000 +.* AS OF AUG 1972, XGET AND XPUT ALSO USE THIS MACRO. * 01152000 +.* RICHARD FOWLER * 01154000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01156000 + AIF (T'&XAREA EQ 'O').XERR1 PRODUCE MNOTE 01158000 +&XLABEL STM 14,0,XX&SYSNDX.R+4 . SAVE REGS WHICH WILL BE CHANGED 01160000 + AIF (T'&XNUM EQ 'O').XN1 SKIP NEXT CHECK IF OMITTED 01162000 + AIF ('&XNUM'(1,1) NE '(' OR '&XNUM'(K'&XNUM,1) NE ')').XN1 01164000 + STH &XNUM,XX&SYSNDX.R+16 . STORE LENGTH 01166000 +.XN1 AIF ('&XAREA' EQ '(0)' OR '&XAREA' EQ '(R0)').XNOLA 01168000 +.XN2 LA 0,&XAREA 01170000 +.XNOLA L 15,XX&SYSNDX.R . GET BRANCH ADDRESS 01172000 + CNOP 2,4 . ADJUST FOR RIGHT ALIGNEMNT 01174000 + BALR 14,15 . CALL ROUTINE, R14==> CONTROL BLOCK 01176000 +XX&SYSNDX.R DC V(&XNAME) . ROUTINE ADDRESS 01178000 + DS 3F . SAVE SPACE FOR REGS 14-0 01180000 + AIF ('&XNUM' EQ '').XDFT SKIP IF DEFAULT SHOULD BE 01182000 + DC AL2(&XNUM) . LENGTH OF AREA 01184000 + AGO .XDS SKIP 01186000 +.XDFT DC AL2(&XDEFT) . DEFAULT LENGTH USED 01188000 +.XDS LM 14,0,4(14) . RESTORE REGS. CON CODE ALREADY DONE 01190000 + MEXIT 01192000 +.XERR1 MNOTE 0,'**XIONR- AREA ADDRESS OMITTED-GENERATION CANCELLED' 01194000 + MEND 01196000 +./ ADD LEVEL=40,SOURCE=0,NAME=XLIMD 01198000 + MACRO 01200000 +&XLABEL XLIMD &ADDR,&LENGTH 01202000 +.*--> MACRO: XLIMD LIMIT DUMP-ASSIST COMPATIBILITY MACRO . . . . . 01204000 +.*. MACRO PROVIDED ONLY FOR RUNNING ASSIST DECKS UNDER OS/360. . 01206000 +.*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 01208000 +&XLABEL DS 0H . XLIMD EXPANSION- NOTHING 01210000 + MEND 01212000 +./ ADD LEVEL=40,SOURCE=0,NAME=XLOOK 01214000 + MACRO 01216000 + XLOOK &ARG1,&ARGL 01218000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01220000 +.*--> MACRO: XLOOK FIND POSITION OF ELEMENT IN LIST. * 01222000 +.* JOHN R. MASHEY - FEB 1970 - V.4.0 * 01224000 +.* MACRO TO FIND AND RETURN POSTION OF ARGUMENT IN A SUBLIST. * 01226000 +.* &ARG1 ARGUMENT TO BE SEARCHED FOR * 01228000 +.* &ARGL LIST OF ARGUMENTS FOR &ARG1 TO BE CHECKED FOR IN * 01230000 +.* &XXLOOK THE FIRST POSITION IN &ARGL IN WHICH &ARG1 IS * 01232000 +.* FOUND, IF ANY. IF &ARG1 IS NOT IN &ARGL, &XXLOOK = 0. * 01234000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01236000 + GBLA &XXLOOK FOR RETURN OF INDEX VALUE 01238000 +&XXLOOK SETA 1 INITIALIZE THE COUNTER 01240000 +.XLA AIF (&XXLOOK GT N'&ARGL).XLB IF GT,QUIT,NOT FOUND 01242000 + AIF ('&ARG1' EQ '&ARGL(&XXLOOK)').XXEXIT IF FOUND,RETURN 01244000 +&XXLOOK SETA &XXLOOK+1 INCREMENT COUNTER 01246000 + AGO .XLA GO BACK FOR NEXT CHECK 01248000 +.XLB ANOP 01250000 +&XXLOOK SETA 0 NOT FOUND, SET TO 0 TO SHOW THIS 01252000 +.XXEXIT MEND 01254000 +./ ADD LEVEL=40,SOURCE=0,NAME=XMUSE 01256000 + MACRO 01258000 + XMUSE &BR,&AD 01260000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01262000 +.*--> MACRO: XMUSE BASE REGISTER SETUP MACRO FOR XSAVE * 01264000 +.* JOHN R. MASHEY - FEB 1970 - V.4.0 * 01266000 +.* THIS MACRO IS CALLED BY XSAVE TO HANDLE BR AND AD OPERANDS, * 01268000 +.* AND PRODUCE APPROPRIATE USINGS. &BR AND &AD ARE FROM XSAVE. * 01270000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01272000 + LCLA &I,&N LOCAL COUNTERS 01274000 + LCLC &B(4),&V BASE REGS, USING NAME 01276000 +&N SETA N'&BR GET NUMBER WHERE HANDY 01278000 +&V SETC '*' NORMAL USE 01280000 + AIF (&N LE 4).XNOKA MAKE SURE NOT TOO MANY BASES 01282000 +&N SETA 4 IDIOT USER HAD >4 BASES, IGNORE EXTR 01284000 + MNOTE 4,'**XMUSE- MORE THAN 4 BASE REGS-EXTRAS IGNORED' 01286000 +.XNOKA AIF ('&AD' EQ '').X1LOOP SKIP IF NORMAL SITUATION 01288000 +.* USED IF AD PARAMATER WAS SPECIFIED IN XSAVE MACRO. * 01290000 + CNOP 0,4 01292000 + B *+8 . SKIP AROUND ADDRESS CONSTANT 01294000 + DC A(&AD) . ADDRESS CONSTANT FOR AD=PARAMETER 01296000 + L &BR(1),*-4 . LOAD ADCON INTO RIGHT REGISTER 01298000 +&V SETC '&AD' CHANGE NAME FOR USING 1ST OPERND 01300000 +.* NORMAL SECTION OF CODE FOR GENERATING USING. * 01302000 +.X1LOOP ANOP 01304000 +&I SETA &I+1 INCREMENT COUNTER TO BASE REG 01306000 +&B(&I) SETC ',&BR(&I)' GET I'TH BASE REGISTER 01308000 + AIF (&I LT &N).X1LOOP CONTINUE UNTIL ALL BASWE REGS DONE 01310000 + DROP 15 . CLEAN UP USING SITUATION 01312000 + USING &V&B(1)&B(2)&B(3)&B(4) 01314000 + MEND 01316000 +./ ADD LEVEL=40,SOURCE=0,NAME=XOPENBLK 01318000 + MACRO 01320000 +&LABEL XOPENBLK &DCB,&XNAME,&DDNAME,&RECFM=F,&LRECL=,&BLKSIZE=, #01322000 + &BUFNO=1,&XOP=OUTPUT,&ABEND=YES,&WARN=NO 01324000 +.*--> MACRO: XOPENBLK GENERATES 1 CONTROL BLOCK FOR XXXXOPEN . . . . 01326000 +.* SEE THE XOPENBLK DSECT. . 01328000 +.* *** ARGUMENTS *** . 01330000 +.* &DCB NAME OF DCB TO BE OPENED . 01332000 +.* &XNAME NAME OF CALLING ROUTINE . 01334000 +.* &DDNAME LIST OF 1 OR MORE DDNAMES, IN ORDER. 01336000 +.* DESIRED TO BE TRIED. . 01338000 +.* NEXT 4 ARGS GIVE DEFAULT VALUES USED TO FILL DCB . 01340000 +.* IF NEEDED DURING DCB EXIT PROCESSING. . 01342000 +.* &RECFM=, &LRECL=, &BLKSIZE=, &BUFNO= SAME NAMES AS DCB . 01344000 +.* &XOP= DIRECTION TO OPEN: OUTPUT OR INPUT. 01346000 +.* &ABEND= ABEND IF CAN'T OPEN: YES OR NO . 01348000 +.* &WARN= WARNING IF CAN'T OPEN FIRST CHOICE . 01350000 +.* YES OR NO . 01352000 +.*. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 01354000 + LCLA &I COUNTER VARIABEL 01356000 + LCLB &B0,&B3,&B5 FOR RECFM BITS, XOPFLAG1 BITS 01358000 +&LABEL OPEN (&DCB,&XOP),MF=L . LIST TO GEN CONTROL ELEMENT 01360000 + DC AL2(&LRECL,&BLKSIZE,&BUFNO) LRECL,BLKSIZE,BUFNO 01362000 +.* 01364000 +&B0 SETB ('&RECFM'(1,1) EQ 'F') SHOULD BE SET 01366000 +&B3 SETB ('&RECFM.X'(2,1) EQ 'B') BLOCKED OR NOT 01368000 +&B5 SETB ('&RECFM'(K'&RECFM,1) EQ 'A') ASA CARRIAGE CONTROLS 01370000 + DC B'&B0.00&B3.0&B5.00' . RECFM BYTE 01372000 +.* 01374000 +&B0 SETB ('&ABEND' EQ 'YES') DOES HE WANT TO ABEND IF NO OPEN 01376000 +&B3 SETB ('&WARN' EQ 'YES') DOES HE WANT WARN IF NOT FIRST DDNA 01378000 + DC B'&B3&B0',CL8'&XNAME ' . XOP-FLAG1,XNAME 01380000 +.* 01382000 +&I SETA 8*(N'&DDNAME-1) 3 DDNAMES, CONVERT TO BXLE LMT 01384000 + DC H'&I' . BXLE OFFSET FOR DD SEARCH 01386000 +&I SETA 1 RE INIT FOR LOOP TO GEN 01388000 +.XOPA DC CL8'&DDNAME(&I)' 01390000 +&I SETA &I+1 INCREMENT TO NEXT ONE 01392000 + AIF (&I LE N'&DDNAME).XOPA LOOP UNTIL ALL DDNAMES GEND 01394000 + MEND 01396000 +./ ADD LEVEL=40,SOURCE=0,NAME=XPNCH 01398000 + MACRO 01400000 +&XLABEL XPNCH &XAREA,&XNUM 01402000 +.*--> MACRO: XPNCH PUNCH CARD MACRO . . . . . . . . . . . . . . . 01404000 +.* JOHN R. MASHEY - FEB 1970 - V.4.0 * 01406000 +.* MACRO FOR EASY PUNCHING OF UP TO 80 BYTES OF XAREA. MACRO * 01408000 +.* GENERATION IS CONTROLLED BY &XPNCHST. * 01410000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01412000 + GBLB &XPNCHST STATUS VARIABLE- 0=ON, 1=OFF 01414000 + AIF (&XPNCHST).XNOGEN SKIP GENRATION IF NOT WANTED 01416000 +&XLABEL XIONR XXXXPNCH,&XNUM,&XAREA,80 01418000 + MEXIT 01420000 +.XNOGEN AIF (T'&XLABEL EQ 'O').XXEXIT GEN LABEL ONLY IF NEEDED 01422000 +&XLABEL DS 0H . LABEL FOR A CANCELLED XPNCH 01424000 +.XXEXIT MEND 01426000 +./ ADD LEVEL=40,SOURCE=0,NAME=XPRNT 01428000 + MACRO 01430000 +&XLABEL XPRNT &XAREA,&XNUM 01432000 +.*--> MACRO: XPRNT PRINT LINE MACRO . . . . . . . . . . . . . . . 01434000 +.* JOHN R. MASHEY - FEB 1970 - V.4.0 * 01436000 +.* MACRO FOR EASY PRINTING OF UP TO 133 CHARACTERS OF XAREA, * 01438000 +.* AS SPECIFIED BY XNUM. FIRST CHARACTER IS USED AS CARRIAGE * 01440000 +.* CONTROL CHARACTER. GENERATION IS CONTROLLED BY &XPRNTST. * 01442000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01444000 + GBLB &XPRNTST GENERATION STATUS 0=YES, 1=NO 01446000 + AIF (&XPRNTST).XNOGEN SKIP GENERATION IF STATUS=OFF 01448000 +&XLABEL XIONR XXXXPRNT,&XNUM,&XAREA,133 01450000 + MEXIT 01452000 +.XNOGEN AIF (T'&XLABEL EQ 'O').XXEXIT GEN LABEL ONLY IF NEEDED 01454000 +&XLABEL DS 0H . LABEL FOR CANCELLED XPRNT 01456000 +.XXEXIT MEND 01458000 +./ ADD LEVEL=40,SOURCE=0,NAME=XPUT 01460000 + MACRO 01462000 +&XLABEL XPUT &XAREA,&XNUM 01464000 +.*--> MACRO: XPUT PUT A RECORD ONTO FILE &DDNAME . . . . . * 01466000 +.* RICHARD FOWLER AUG 1972 V.5.0 * 01468000 +.* MACRO FOR EASY PRINTING ONTO ANY DD FILE RECORD LENGTH=&XNUM * 01470000 +.* IF PRINT FILE, THE FIRST CHARACTER IS USED AS CARRIAGE CONTROL 01472000 +.* GENERATION CONTROLLED BY &XPUST * 01474000 +.* EXECUTION ASSUMES REG 1 POINTS TO DD NAME * 01476000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ** 01478000 + GBLB &XPUTST GENERATION STATUS- 0=YES, 1=NO 01480000 + AIF (&XPUTST).XNOGEN IF SHOULDN'T GENERATE, SKIP CALL 01482000 +&XLABEL XIONR XXXXPUT,&XNUM,&XAREA,133 01484000 + MEXIT 01486000 +.XNOGEN AIF (T'&XLABEL EQ 'O').XXEXIT GEN LABEL ONLY IF NEEDED 01488000 +&XLABEL DS 0H . LABEL FOR CANCELLED XPUT 01490000 +.XXEXIT MEND 01492000 +./ ADD LEVEL=40,SOURCE=0,NAME=XREAD 01494000 + MACRO 01496000 +&XLABEL XREAD &XAREA,&XNUM 01498000 +.*--> MACRO: XREAD READ CARD MACRO . . . . . . . . . . . . . . . . 01500000 +.* JOHN R. MASHEY - FEB 1970 - V.4.0 * 01502000 +.* MACRO FOR EASY CARD READING-READS UP TO 80 CHARACTERS INTO * 01504000 +.* XAREA OPERAND. CONDITION CODE SET TO 0 NORMALLY, OR TO 1 ON * 01506000 +.* END OF FILE. GENERATION CONTROLLED BY &XREADST. * 01508000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01510000 + GBLB &XREADST GENERATION STATUS- 0=YES, 1=NO 01512000 + AIF (&XREADST).XNOGEN IF SHOULDN'T GENRATE-SKIP CALL 01514000 +&XLABEL XIONR XXXXREAD,&XNUM,&XAREA,80 01516000 + MEXIT 01518000 +.XNOGEN AIF (T'&XLABEL EQ 'O').XXEXIT GEN LABEL ONLY IF NEEDED 01520000 +&XLABEL DS 0H . LABEL FOR CANCELLED XREAD 01522000 +.XXEXIT MEND 01524000 +./ ADD LEVEL=40,SOURCE=0,NAME=XRETURN 01526000 + MACRO 01528000 +&LABEL XRETURN &RGS=(14-12),&SA=,&RC=,&RP=,&T=,&TR=*,&REEN= 01530000 +.** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01532000 +.*--> MACRO: XRETURN GENERAL RETURN MACRO, OS LINKAGE * 01534000 +.* JOHN R. MASHEY - FEB 1970 - V.4.0 * 01536000 +.* EXTENDED RETURN MACRO - SEE PSU CC WRITEUP - XSAVE/XRETURN * 01538000 +.* FOR EXPLANATION AND USE OF OPERANDS. * 01540000 +.* USES MACROS: FREEMAIN,XCHAR,XSRNR * 01542000 +.** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01544000 + GBLB &XRETUST =0 TRACE GENERATION OK, =1 NO TRACE 01546000 + GBLC &XSAVE,&XXCHAR STD SAVE AREA NAME, XCHAR VARIABLE 01548000 + LCLA &I LOCAL COUNTER 01550000 + LCLB &RCA,&RCB FOR CONTROL OF RETURN CODE GENER 01552000 +.* * 01554000 +.* GENERATE LABEL IF THERE IS ONE, GENERATE TRACE CODE IF IT * 01556000 +.* IF DESIRED, AND SET UP LCLB VARIABLES TO DESCRIBE RETURN * 01558000 +.* CODE CONDITIONS. GENERATE LR IF NEEDED FOR RC OPTION. * 01560000 +.* * 01562000 + SPACE 1 01564000 + AIF (T'&LABEL EQ 'O').XNOLB SKIP IF NO LABEL USED 01566000 +&LABEL DS 0H . DEFINE LABEL 01568000 +.XNOLB AIF ('&TR' EQ 'NO' OR &XRETUST).XNORT SKIP IF NO TRACE 01570000 + XSRTR &TR,&LABEL,EXITED GET TRACE GENERATED 01572000 +.XNORT ANOP 01574000 +&RCA SETB (T'&RC EQ 'O') TRUE IF WHOLE THING OMITTED 01576000 +&RCB SETB (1) SET THIS WAY FOR NEXT TEST 01578000 + AIF (&RCA).XNRCB SKIP IMMEDIATELY IF OMITTED 01580000 +&RCB SETB ('&RC'(1,1) NE '(' OR '&RC'(K'&RC,1) NE ')') NOT RG TYP 01582000 + AIF (&RCB).XNRCB SKIP IF NOT REGISTER TYPE 01584000 + XCHAR &RC,3 GET LAST 3 CHARS 01586000 + AIF ('&XXCHAR' EQ '15)').XNRCB SKIP IF ALREADY IN 15 01588000 + LR 15,&RC . LOAD RETURN CODE FROM DESIRED REG 01590000 +.XNRCB AIF (T'&REEN EQ 'O').XNORM SKIP IF NOT REENTRANT 01592000 +.* * 01594000 +.* REENTRANT RETURN CODE GENERATION - OBTAIN ADDRESS AND LENGTH * 01596000 +.* OF AREA FROM WHERE XSAVE PUT THEM,DO FREEMAIN,FIXUP REGS. * 01598000 +.* * 01600000 + AIF ('&TR' EQ 'NO' OR &XRETUST).XGOK MAKE SURE REENT 01602000 + MNOTE 0,'**XRETURN- TR OPTION IMPLIES NON-REENTRANT CODE' 01604000 +.XGOK L 13,4(13) . GET OLD SA POINTER BACK 01606000 + STM 15,1,16(13) . SAVE REGS FROM FREEMAIN CRUNCHING 01608000 + L 1,8(13) . GET ADDRESS OF AREA BACK 01610000 +* FREEMAIN R,LV=8*((&REEN+79)/8),A=(1) FREE STORAGE 01612000 + FREEMAIN R,LV=8*((&REEN+79)/8),A=(1) FREE STORAGE 01614000 + LM 15,1,16(13) . RESTORE THE REGS 01616000 + AGO .XNORM1 GO TO PROCESS REGISTER RESTORATION 01618000 +.XNORM AIF ('&SA' EQ 'NO').XNORM1 SKIP RESTORATION IF UNUSED 01620000 +.* * 01622000 +.* REGISTER RESTORATION CODE - RESTORE REGS FROM CALLER'S * 01624000 +.* SAVE AREA,DEPENDING ON RETURN CODE AND FUNCTION OPTIONS. * 01626000 +.* * 01628000 + L 13,4(13) . RESTORE PREVIOUS SAVE AREA POINT 01630000 +.XNORM1 AIF ('&RGS' EQ 'NO').XNORM2A SKIP IF NO REGS NEEDED 01632000 + AIF ('&RGS' NE '(14-12)' OR NOT &RCB).XNORM2 01634000 + LM 14,12,12(13) . STANDARD REGISTER RESTORATION 01636000 + AGO .XNORM2A CONTINUE 01638000 +.XNORM2 ANOP 01640000 +&I SETA &I+1 INCREMENT COUNTER 01642000 + XSRNR L,&RGS(&I),&RCB HAVE RESTORE CODE GENRATED 01644000 + AIF (&I LT N'&RGS).XNORM2 LOOP UNTIL DONE 01646000 +.* * 01648000 +.* RETURN CODE(15) AND RETURN PAST(14) CODE GENERATION. * 01650000 +.* * 01652000 +.XNORM2A AIF (&RCA OR NOT &RCB).XNORM3 SKIP IF NOT LA TYPE RC= 01654000 + LA 15,&RC . PUT RETURN CODE IN 15 01656000 +.XNORM3 AIF ('&T' NE '*').XNORM4 SEE IF MVI WANTED 01658000 + MVI 12(13),X'FF' . SHOW WE HAVE RETURNED 01660000 +.XNORM4 AIF (T'&RP EQ 'O').XNORP SKIP IF RP NOT USED 01662000 + B &RP.(14) . RETURN GIVEN NUMBER PAST 14 01664000 + AGO .XNORM5 01666000 +.XNORP BR 14 . RETURN NORMALLY TO CALLER 01668000 +.* * 01670000 +.* SAVE AREA GENERATION - IF A SAVE AREA SHOULD BE CREATED, * 01672000 +.* USE EITHER ONE SPECIFIED BY MACRO,OR ELSE STANDARD ONE. * 01674000 +.* * 01676000 +.XNORM5 AIF (T'&SA EQ 'O' OR '&SA' EQ 'NO').XEXIT SKIP IF NO SAV5 01678000 + AIF ('&SA' EQ '*').XSASTD IF *,USE STANDARD SAVE 01680000 +&SA DC 18F'0' . SAVE AREA,NAMED BY MACRO 01682000 + AGO .XEXIT 01684000 +.XSASTD ANOP 01686000 +&XSAVE DC 18F'0' . SAVE AREA,USING GENERATED NAME 01688000 +.XEXIT SPACE 1 01690000 + MEND 01692000 +./ ADD LEVEL=40,SOURCE=0,NAME=XSAVE 01694000 + MACRO 01696000 +&LABEL XSAVE &RGS=(14-12),&BR=12,&SA=*,&ID=*,&TR=*,&REEN=,&OPT=,&AD= 01698000 +.** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01700000 +.*--> MACRO: XSAVE EXTENDED SAVE MACRO - OS LINKAGE. * 01702000 +.* JOHN R. MASHEY - FEB 1970 - V.4.0 * 01704000 +.* EXTENDED SAVE MACRO - SEE PSU CC WRITEUP - XSAVE/XRETURN * 01706000 +.* FOR DESCRIPTION OF ARGUMENTS FOR THIS MACRO * 01708000 +.* USES MACROS: GETMAIN,XCHAR,XIDENT,XLOOK,XMUSE,XSRNT,XSRTR * 01710000 +.** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01712000 + GBLA &XXLOOK RETURN VARIABLE FROM XLOOK MACRO 01714000 + GBLB &XSAVEST =0 TRACE GEN OK, =1 NO TRACE DONE 01716000 + GBLC &XSAVE,&XCSECT,&XXCHAR STD NAME,CSECT NAME,XCHAR VAR 01718000 + LCLA &I LOCAL COUNTER 01720000 + LCLB &XNSECT FLAG FOR NEW CSECT 01722000 + LCLC &B1,&BT 1ST BASE,LAST 2 CHARS OF 1ST BASE 01724000 +&B1 SETC '&BR(1)' GET FIRST OR ONLY BASE IN EASIER NAM 01726000 + XCHAR &B1,2 GET LAST 2 CHARS OF BASE REG 01728000 +&BT SETC '&XXCHAR' GET LAST 2 CHARACTERS 01730000 +&XNSECT SETB ('&SYSECT' NE '&XCSECT') NOTE IF NEW CSECT NEEDED 01732000 +&XCSECT SETC '&SYSECT' SET TO SYSECT, FOR NORMAL USE 01734000 +.* * 01736000 +.* CHECK OPT FIELD - GENERATE TITLE AND/OR ENTRY OR CSECT * 01738000 +.* STATEMENTS, DEPENDING ON CONTENTS OF OPT FIELD, IF USED. * 01740000 +.* * 01742000 + AIF (T'&OPT EQ 'O').XNOPS SKIP IF OPT UNUSED 01744000 + XLOOK TITLE,&OPT WAS TITLE OPTION USED 01746000 + AIF (&XXLOOK EQ 0).XNTITL SKIP IF TITLE NOT USED 01748000 + AIF (N'&OPT EQ 1).XNOPS SKIP IF TITLE ONLY 01750000 + TITLE '*** &LABEL ***' 01752000 +.XNTITL XLOOK ENTRY,&OPT WAS ENTRY USED 01754000 + AIF (&XXLOOK EQ 0).XTRCS SKIP IF NOT USED 01756000 + AIF ('&LABEL' EQ '').XENTE SKIP TO ERR IF NO LABEL 01758000 + ENTRY &LABEL . NOTE XSAVE ENTRY OPTION 01760000 + AGO .XNOPS 01762000 +.XENTE MNOTE 4,'**XSAVE- OPT=ENTRY USED WITHOUT LABEL-OPTION IGNORED' 01764000 + AGO .XNOPS 01766000 +.XTRCS XLOOK CSECT,&OPT CHECK FOR CSECT OPTION 01768000 + AIF (&XXLOOK EQ 0).XTRCS1 SKIP IF OPTION NOT THERE 01770000 +&LABEL CSECT 01772000 +&XCSECT SETC '&LABEL' SET THIS TO SHOW NEW CSECT 01774000 +&XNSECT SETB (1) NOTE THAT NEW CSECT IS NEEDED 01776000 + AGO .XENT1 SKIP OVER &LABEL DEFN 01778000 +.XTRCS1 MNOTE 0,'**XSAVE- UNKNOWN OPT=&OPT- IGNORED' 01780000 +.* * 01782000 +.* CREATE STATMENT LABEL IF ANY. IF IDENTIFIER REQUESTED,USE * 01784000 +.* SPECIFIED IDENTIFIER,STATEMENT LABEL,OR CSECT NAME IN XIDENT * 01786000 +.* TO GENERATE CORRECT IDENTIFIER WITH BRANCH AROUND IT. * 01788000 +.* * 01790000 +.XNOPS SPACE 2 01792000 +&LABEL DS 0H . DEFINE LABEL,MAKE SUREE ALIGNED 01794000 +.XENT1 USING *,15 . FOR TEMPORARY ADDRESSIBILITY 01796000 + AIF ('&SA' EQ '*' OR '&SA' EQ 'NO').XCHKS1 SKIP IF NO CHANGE 01798000 +&XSAVE SETC '&SA' EXPLICIT NEW SAVE AREA NAME 01800000 + AGO .XSAOK 01802000 +.XCHKS1 AIF ('&XSAVE' NE '').XCHKS2 SKIP IF NOT NULL 01804000 +&XSAVE SETC '$PR#&SYSNDX' SET UP DEFAULT SAVE AREA NAME 01806000 + AGO .XSAOK 01808000 +.XCHKS2 AIF (NOT &XNSECT).XSAOK SKIP IF NEW SAVE NOT NEEDED 01810000 +&XSAVE SETC '&XCSECT'(1,3).'#&SYSNDX' DEFAULT SAVE AREA NAME 01812000 +.* * 01814000 +.XSAOK AIF ('&ID' EQ 'NO').XID3 SKIP IF NO ID WANTED 01816000 + XIDENT &ID,&LABEL,&XCSECT,$PRIVATE CALL TO SET UP IDENT 01818000 +.* * 01820000 +.* IF TR OPTION IN EFFECT, CALL XSRTR TO GENERATE RIGHT CODE, * 01822000 +.* THEN HAVE XSRNR GENERATE CODE TO SAVE RANGES OF REGISTERS * 01824000 +.* * 01826000 +.XID3 AIF (&XSAVEST OR '&TR' EQ 'NO').XNOTR SKIP IF NO TRACE 01828000 + XSRTR &TR,&LABEL,ENTERED GET TRACE GENERATED 01830000 +.XNOTR AIF ('&RGS' NE '(14-12)').XSRCAL SKIP IF NOT STANDARD 01832000 + STM 14,12,12(13) . SAVE STANDARD REGISTER SET 01834000 + AGO .XCHK13 01836000 +.XSRCAL AIF ('&RGS' EQ 'NO').XCHK13 SKIP IF NO REGS SAVED 01838000 +&I SETA 1 INITIALIZE COUNTER 01840000 +.XSETUP XSRNR ST,&RGS(&I) CALL XSRNR WITH EACH REG SET 01842000 +&I SETA &I+1 INCREMENT TO NEXT REGS SET 01844000 + AIF (&I LE N'&RGS).XSETUP CONTINUE PROCESSING RGS 01846000 +.XCHK13 AIF ('&BT' NE '13').XNORM1 NOT REG 13,DO NORMALLY 01848000 +.* * 01850000 +.* REGISTER 13 DOUBLE USAGE - THIS SECTION GENERATES CODE TO * 01852000 +.* USE REGISTER 13 BOTH AS A BASE AND AS THE SAVE AREA POINTER. * 01854000 +.* * 01856000 + AIF (T'&AD EQ 'O').XU2 SKIP TO NORMAL IF &AD OMITTED 01858000 + LR 14,13 . SAVE @ OLD SAVE AREA BEFORE SETTING 01860000 + XMUSE &BR,&AD HAVE ADCON SET UP 01862000 + ST 13,8(14) . SAVE NEW POINTER INTO OLD SAVEAREA 01864000 + ST 14,4(13) . SAVE OLD POINTER INTO NEW AREA 01866000 + AGO .XEND1 GO FINISH UP 01868000 +.XU2 CNOP 0,4 01870000 + ST 13,&XSAVE+4 . SAVE OLD SA POINTER INTO NEW AREA 01872000 + BAL 13,&XSAVE+72 . SET UP 13, BRANCH AROUND SA 01874000 + XMUSE &BR SET UP WHATEVER USING REQUIRED 01876000 +&XSAVE DC 18F'0' . SAVE A›EA 01878000 +.XU3 L 15,&XSAVE+4 . GET OLD SA POINTER BACK TO SET LINKS 01880000 + ST 13,8(15) . STORE NEW POINTER IN OLD AREA 01882000 + AGO .XEND1 CHECK NUMBER OF BR'S,GET LA'S SET UP 01884000 +.* * 01886000 +.XNORM1 AIF (T'&REEN EQ 'O').XNORM2 SKIP OVER REENTRANT 01888000 +.* * 01890000 +.* REENTRANT ENTRY CODE GENERATION - THIS GENERATES CODE TO * 01892000 +.* ACQUIRE SPACE FOR SAVEAREA(72 BYTES) + AS MUCH MORE SPACE * 01894000 +.* AS IS SPECIFIED IN REEN PARAMATER, IF USED. * 01896000 +.* * 01898000 + AIF ('&TR' EQ 'NO' OR &XSAVEST).XGOK MAKE SURE REENT 01900000 + MNOTE 0,'**XSAVE- USE OF TR OPTION IMPLIES NON-REENTRANT CODE' 01902000 +.XGOK ANOP 01904000 +* GETMAIN R,LV=8*((&REEN+79)/8) GET SPACE ROUNDED TO D 01906000 + GETMAIN R,LV=8*((&REEN+79)/8) .GET CORE ROUNDED TO DBLWRD 01908000 + ST 13,4(1) . STORE OLD POINTER IN NEW AREA 01910000 + ST 1,8(13) . STORE (EW POINTER IN OLD AREA 01912000 + LR &B1,1 . SAVE VALUE OF NEW SAVE POINTER 01914000 + LM 0,1,20(13) . RESTORE PREVIOUS VALUES OF REGS 01916000 + LR 13,&B1 . POINT 13 TO NEW SAVE AREA 01918000 + AGO .XNEWBS GO GENERATE NEW BALR,USING 01920000 +.* * 01922000 +.* NORMAL,NON-REENTRANT ENTRY CODE SECTION. * 01924000 +.* * 01926000 +.XNORM2 AIF ('&SA' EQ 'NO').XNEWBS SKIP IF NO SAVE AREA 01928000 + ST 13,&XSAVE+4 . SAVE OLD POINTER IN NEW AREA 01930000 + AIF ('&BT' NE '15').XSN15 SKIP IF NOT 15 01932000 + LA 13,&XSAVE . GET ADDRESS OF NEW SAVE AREA 01934000 + L &B1,&XSAVE+4 . GET OLD SAVE POINTER BACK 01936000 + AGO .XSOLD GO SAVE NEW POINTER 01938000 +.XSN15 LR &B1,13 . MOVE OLD POINTER OVER 01940000 + LA 13,&XSAVE . ADDRES> OF NEW SAVE AREA 01942000 +.XSOLD ST 13,8(&B1) . SAVE NEW POINTER IN OLD AREA 01944000 +.* SET UP BALR, LA'S IF REQUIRED, AND USING STATEMENT. * 01946000 +.XNEWBS AIF ('&BT' NE '15' OR N'&BR GT 1).XSET2 SKIP IF 15 01948000 + AIF ('&REEN' EQ '' AND '&SA' EQ 'NO' AND '&AD' EQ '').XEND2 01950000 +.XSET2 AIF (T'&AD NE 'O').XSET3 SKIP BALR IF ADCON USED 01952000 + BALR &B1,0 . SET UP NEW BASE REGISTER 01954000 +.XSET3 XMUSE &BR,&AD SET UP USINGS, ADCON IF NEEDED 01956000 +.XEND1 AIF (N'&BR EQ 1).XEND2 IF ONLY 1 BASE,DON'T CALL XMUSE 01958000 +&I SETA 2 INITIALIZE 01960000 +.XA2A LA &BR(&I),4095 . LOAD IN ADDRESS 01962000 + LA &BR(&I),1(&BR(&I),&BR(&I-1)) . SET USING VALUES 01964000 +&I SETA &I+1 INCREMENT TO NEXT BASE 01966000 + AIF (&I LE N'&BR AND &I LE 4).XA2A LOOP FOR # BASES 01968000 +.XEND2 SPACE 1 01970000 + MEND 01972000 +./ ADD LEVEL=40,SOURCE=0,NAME=XSET 01974000 + MACRO 01976000 +&XLABEL XSET &XSNAP=,&XSTOP=,&XREAD=,&XPRNT=,&XPNCH=,&XTIME=, X01978000 + &XSAVE=,&XRETURN= 01980000 +.*--> MACRO: XSET CONTROL XMACRO GENERATION . . . . . . . . . . . 01982000 +.* JOHN R. MASHEY - FEB 1970 - V.4.0 * 01984000 +.* XSET IS USED TO CONTROL GENERATION OF X-MACROS OF THE NAMES * 01986000 +.* USED AS OPERANDS. NAME=OFF CANCELLS THE GIVEN MACRO UNTIL * 01988000 +.* NAME=ON IS CODED. ALL NAMES ARE ON UNLESS CANCELLED. ALL * 01990000 +.* CODE MAY BE ELIMINATED FOR ANY MACROS EXCEPT XSAVE/XRETURN, * 01992000 +.* WHOSE TRACE CODE ONLY IS ELIMINATED. * 01994000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01996000 + GBLB &XSNAPST,&XSTOPST,&XSAVEST,&XRETUST STATUS VARS 01998000 + GBLB &XREADST,&XPRNTST,&XPNCHST,&XTIMEST 02000000 + AIF (T'&XLABEL EQ 'O').XNOLB GEN LABEL ONLY IF NEEDED 02002000 +&XLABEL DS 0H . LABEL APPEARED ON AN XSET 02004000 +.XNOLB ANOP 02006000 +&XSNAPST SETB (('&XSNAP' EQ 'OFF') OR ((T'&XSNAP EQ 'O') AND &XSNAPST)) 02008000 +&XSTOPST SETB (('&XSTOP' EQ 'OFF') OR ((T'&XSTOP EQ 'O') AND &XSTOPST)) 02010000 +&XREADST SETB (('&XREAD' EQ 'OFF') OR ((T'&XREAD EQ 'O') AND &XREADST)) 02012000 +&XPRNTST SETB (('&XPRNT' EQ 'OFF') OR ((T'&XPRNT EQ 'O') AND &XPRNTST)) 02014000 +&XPNCHST SETB (('&XPNCH' EQ 'OFF') OR ((T'&XPNCH EQ 'O') AND &XPNCHST)) 02016000 +&XTIMEST SETB (('&XTIME' EQ 'OFF') OR ((T'&XTIME EQ 'O') AND &XTIMEST)) 02018000 +&XSAVEST SETB (('&XSAVE' EQ 'OFF') OR ((T'&XSAVE EQ 'O') AND &XSAVEST)) 02020000 +&XRETUST SETB (('&XRETURN' EQ 'OFF') OR ((T'&XRETURN EQ 'O') AND X02022000 + &XRETUST)) 02024000 + MEND 02026000 +./ ADD LEVEL=40,SOURCE=0,NAME=XSNAP 02028000 + MACRO 02030000 +&XLABEL XSNAP &T=PR,&LABEL=,&STORAGE=,&IF= 02032000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02034000 +.*--> MACRO: XSNAP EXTENDED SNAP MACRO-DEBUGGING-DUMPING. * 02036000 +.* JOHN R. MASHEY - FEB 1970 - V.4.0 * 02038000 +.* XSNAP IS USED FOR STORING,PRINTING OF REGISTERS AND ANY * 02040000 +.* OTHER ADDRESSIBLE AREAS. XSNAP HARMS NO REGISTERS,CAN BE USED* 02042000 +.* IN ANY NUMBER OF CSECTS IN 1 ASSEMBLY,AND PRINTS REGISTERS * 02044000 +.* EXACTLY AS THEY ARE WHEN THE XSNAP IS CALLED. XSNAP * 02046000 +.* ACTION MAY BE MADE CONDITIONAL EITHER AT ASSEMBLY TIME OR * 02048000 +.* DURING EXECUTE TIME. SEE WRITEUP FOR OPERAND DESCRIPTION. * 02050000 +.* USES MACROS: XLOOK * 02052000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02054000 + GBLA &XXLOOK XLOOK RETURN VALUE 02056000 + GBLB &XSNAPST GENERATION STATUS,ON=0,OFF=1 02058000 + LCLA &I,&K,&L,&N LOCAL COUNTERS 02060000 + LCLB &XP,&XF PRINT REGS AND PRINT FLOATING REGS 02062000 + LCLC &NAM,&INST,&A(5) 02064000 +.* * 02066000 +.* CHECK FOR XSNAPS BEING CANCELLED. CREATE LABEL IF NEEDED. * 02068000 +.* * 02070000 + AIF (NOT &XSNAPST).XGOGEN GENERATE IF STATUS=ON 02072000 + AIF (T'&XLABEL EQ 'O').XXEXIT SKIP IF NOTHING TO GEN 02074000 +&XLABEL DS 0H . LABEL USED ON NULLIFIED XSNAP 02076000 + MEXIT 02078000 +.XGOGEN SPACE 1 02080000 +&NAM SETC 'XX&SYSNDX' SET UP MOST OF NAME FOR LABELS 02082000 +&N SETA (N'&STORAGE/2)*2 GET ROUNDED NUMBER OF OPERANDS 02084000 +&XLABEL STM 0,15,&NAM.B . SAVE ALL REGISTERS 02086000 +.* * 02088000 +.* IF OPTION - IF IF OPTION IS USED AND HAS CORRECT ARGUMENTS, * 02090000 +.* GENERATE A CLI, C, OR CR INSTRUCTION TO PERFORM APPROPRIATE * 02092000 +.* TEST,DEPENDING ON THE KIND OF IF ARGUMENTS . NEGATE THE * 02094000 +.* CONDITION AND CREATE THE RIGHT EXTENDED MNEMONIC BRANCH * 02096000 +.* SO THAT THE XSNAP WILL BE SKIPPED IF THE STATED CONDTION IS * 02098000 +.* NOT MET. GENERATE USER'S OWN OPCODE IF HE SUPPLIED ONE. * 02100000 +.* * 02102000 + AIF (T'&IF EQ 'O').XNOIF SKIP IF IF NOT REQUESTED 02104000 + AIF (N'&IF GE 3).XOKIF SKIP IF ENOUGH ARGUMENTS 02106000 + MNOTE 0,'**XSNAP- IF=&IF:IGNORED, LACKS REQUIRED 3-4 OPERANDS' 02108000 + AGO .XNOIF CANCEL IF OPTION 02110000 +.XOKIF XLOOK &IF(2),(H,L,E,O,P,M,Z,NH,NL,NE,NO,NP,NM,NZ) 02112000 + AIF (&XXLOOK GT 0).XOKIF1 SKIP IF OK RELATION 02114000 + MNOTE 0,'**XSNAP- IF=&IF(2) UNKNOWN-CANCELLED' 02116000 + AGO .XNOIF SKIP GENERATION OF THIS OPTION 02118000 +.XOKIF1 ANOP 02120000 +&INST SETC '&IF(4)' GET INSTRUCTION 02122000 + AIF (N'&IF EQ 4).X IF OPCODE SUPPLIED,SKIP CHECKING 02124000 +&INST SETC 'CLI' MAKE TENTATIVE INSTRUCTION SETUP 02126000 + AIF ('&IF(1)'(1,1) NE '(' OR '&IF(1)'(K'&IF(1),1) NE ')').X 02128000 +&INST SETC 'C' PROBABLY WANTS RX TYPE 02130000 + AIF ('&IF(3)'(1,1) NE '(' OR '&IF(3)'(K'&IF(3),1) NE ')').X 02132000 +&INST SETC 'CR' 2 REGS-USER WANTS RR TYPE 02134000 +.X ANOP 02136000 + &INST &IF(1),&IF(3) . TEST 02138000 +&INST SETC 'BN&IF(2)' NEGATE COND, HOPE FOR 1 OF 1ST SET 02140000 + AIF (&XXLOOK LE 7).XOKIF2 SKIP IF NOW SET UP RIGHT 02142000 +&INST SETC 'B'.'&IF(2)'(2,2) REMOVE N FROM COND 02144000 +.XOKIF2 &INST &NAM.C 02146000 +.* * 02148000 +.* CREATE BRANCH AROUND THE SAVE AREA, FLAGS, ETC. * 02150000 +.* * 02152000 +.XNOIF XLOOK &T(1),(PR,PRINT,FL,FLOAT,NO,NOREGS,ST,STORE) 02154000 +&I SETA 72+4*&N LENGTH FOR T=PRINT,NOREGS 02156000 + AIF (&XXLOOK LE 6).XBRNCH SKIP IF ILLEGAL, OR PR,NO 02158000 +&I SETA 68 LENGTH FOR T=STORE 02160000 +.XBRNCH B &NAM.B+&I . BRANCH AROUND CONSTANTS 02162000 +.* * 02164000 +.* CREATE FRONT BRACKET CHARACTER STRING FOR REGISTER AREA * 02166000 +.* * 02168000 + DS 0F . ALIGN LABEL ON FULLWORD 02170000 +&L SETA 8 SET &L FOR NO LABEL= LENGTH 02172000 + AIF (T'&LABEL EQ 'O').XNOLAB IF NO LABEL,SKIP GENERATIO 02174000 +&L SETA ((K'&LABEL+1)/4)*4 ROUND LENGTH UP TO FULLWORD 02176000 + AIF (&L LE 92).XLAB1 SKIP IF LABEL SMALL ENOUGH 02178000 + MNOTE 0,'**XSNAP- LABEL= OPERAND TRUNCATED TO 92 CHARACTERS' 02180000 +&L SETA 92 TRUNCATE 02182000 +.XLAB1 DC CL&L&LABEL 02184000 + AGO .XCHK1 SKIP GENRATION OF 1ST DELIMETER 02186000 +.XNOLAB DC CL8'&NAM.B' . FRONT BRACKET FOR REGISTER AREA 02188000 +.* * 02190000 +.* CREATE REGISTER AREA, BRACKETS, FLAG VALUES, AS NEEDED * 02192000 +.XCHK1 AIF (&XXLOOK LT 7).XPRINT SKIP IF PRINTED OUTPUT 02194000 +&NAM.B DC 16F'-1',4C'X' . REGISTER SAVE AREA, BRACKET X'S 02196000 + AGO .XIFLB SKIP TO CHECK FOR IF LABEL 02198000 +.XPRINT AIF (&XXLOOK GT 0).XPRINT1 SKIP IF LEGAL T= 02200000 + MNOTE 0,'**XSNAP- UNKNOWN T=&T: T=PR ASSUMED' 02202000 +.XPRINT1 ANOP 02204000 +&XP SETB (&XXLOOK LT 5) SET TO 1 IF GP REGS NEEDED 02206000 +&XF SETB (&XXLOOK GT 2 AND &XP) SET TO 1 IF T=FL OR T=FLOAT 02208000 +&XF SETB (&XF OR '&T(2)' EQ 'FL' OR '&T(2)' EQ 'FLOAT') 02210000 +&NAM.B DC 16F'-1',B'&T(3)00&XF&XP',AL1(0,&L,&N/2),V(XXXXSNAP) 02212000 +.* * 02214000 +.* GENERATE ADDRESS LIST FOR STORAGE=, WITH EITHER WORDS FOR * 02216000 +.* STORING ADDRESSES OR A-TYPE ADDRESS CONSTANTS. * 02218000 +.* * 02220000 + AIF (T'&STORAGE EQ 'O').OKN SKIP IF STORAGE= NOT USED 02222000 +&I SETA 1 INITIALIZE AS COUNTER 02224000 + AIF (&N EQ N'&STORAGE).LOOP1 SKIP IF LEGAL 02226000 + MNOTE 0,'**XSNAP- ODD OPERAND IGNORED: STORAGE=&STORAGE(&N)' 02228000 + AIF (&N EQ 0).OKN 02230000 +.LOOP1 AIF ('&STORAGE(&I)'(1,1) NE '*').LOOP1E 02232000 +&K SETA 1 INITIALIZE COUNTER 02234000 +.* PROCESS ADDRESS REQUIRING LA - ST COMBINATION * 02236000 +.LOOP1A AIF (&I+&K GT &N).LOOP1C SKIP IF WE'RE AT END 02238000 + AIF ('&STORAGE(&I+&K)'(1,1) NE '*').LOOP1C SKIP IF NOT * 02240000 +&K SETA &K+1 INCREM # CONSECUTIVE *FORMS 02242000 + AGO .LOOP1A GO CHECK NEXT 02244000 +.LOOP1C DS &K.A . WORDS WHERE ADDRESSES WILL BE STORED 02246000 +&I SETA &I+&K INCREMENT 02248000 + AGO .LOOP1G GO FOR NEXT CHECK 02250000 +.* PROCESS ADDRESS CONSTANT TYPE OF OPERAND * 02252000 +.LOOP1E DC A(&STORAGE(&I)) 02254000 +&I SETA &I+1 INCREMENT # OPERANDS DONE 02256000 +.LOOP1G AIF (&I LE &N).LOOP1 CONTINUE IF ANY MORE 02258000 +.* * 02260000 +.* CREATE LOAD ADDRESS - STORE PAIRS FOR EXPRESSION ADDRESSES * 02262000 +.* * 02264000 +&I SETA 1 02266000 +.LOOP2 AIF ('&STORAGE(&I)'(1,1) NE '*').LOOP2E SKIP IF NOT * 02268000 +&L SETA K'&STORAGE(&I)-1 GET # CHARAS IN EXPRESSION 02270000 +&K SETA 1 INIT COUNTER 02272000 + AIF (&L LE 40).LOOP2A SKIP IF SMALL ENOUGH 02274000 + MNOTE 8,'**XSNAP- STORAGE(&I) LONGER THAN 40 CHARACTERS' 02276000 +&L SETA 40 TRUNCATE AND HOPE IT GOES 02278000 +.* BREAK EXPRESSION INTO 8 CHARACTER SECTIONS. * 02280000 +.LOOP2A ANOP 02282000 +&A(&K) SETC '&STORAGE(&I)'(8*&K-6,8) GET UP TO 8 NEXT CHARS 02284000 +&K SETA &K+1 INCRMENT COUNTER 02286000 + AIF (8*&K-8 LT &L).LOOP2A LOOP UNTIL HAVE WHOLE OPR 02288000 + LA 0,&A(1)&A(2)&A(3)&A(4)&A(5) 02290000 + ST 0,&NAM.B+4*&I+68 STORE ADDRESS IN LIST 02292000 +.LOOP2C ANOP 02294000 +&K SETA &K-1 DECRMENT SECTION TO NULL 02296000 +&A(&K) SETC '' NULL FOR NEXT USE 02298000 + AIF (&K GT 2).LOOP2C CONTINUE UNTIL ALL BUT &A(1) NULL 02300000 +.LOOP2E ANOP 02302000 +&I SETA &I+1 INCREMENT POSITION IN LIST 02304000 + AIF (&I LE &N).LOOP2 CONTINUE WITH LIST 02306000 +.* * 02308000 +.* CREATE CODE TO SET UP REGISTERS FOR XXXXSNAP,CALL IT,AND * 02310000 +.* RESTORE REGS ON RETURN. XXXXSNAP RESTORES THE CONDTION CODE.* 02312000 +.* * 02314000 +.OKN LA 10,&NAM.B . GET ADDRESS OF REGISTER BLOCK 02316000 + L 15,68(10) . GET V(XXXXSNAP) FOR BRANCH 02318000 + BALR 14,15 . CALL XXXXSNAP,POINT 14 AT NEXT INST 02320000 + LM 0,15,0(10) . RELOAD THE REGISTERS 02322000 +.* CREATE LABEL FOR IF OPTION, IF IT WAS USED. * 02324000 +.XIFLB AIF ('&INST' EQ '').XEXIT SKIP GEN OF IF LABEL 02326000 +&NAM.C EQU * . DEFINE LABEL FOR IF= BRANCH 02328000 +.XEXIT SPACE 2 02330000 +.XXEXIT MEND 02332000 +./ ADD LEVEL=40,SOURCE=0,NAME=XSRNR 02334000 + MACRO 02336000 + XSRNR &OP,&RG,&NO15 02338000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02340000 +.*--> MACRO: XSRNR SAVE/RESTORE REGISTERS FOR XSAVE/XRETURN * 02342000 +.* JOHN R. MASHEY- FEB 1970 - V.4.0 * 02344000 +.* THIS MACRO IS USED BY XSAVE AND XRETURN TO SET UP * 02346000 +.* REGISTER SAVING AND RESTORATION. * 02348000 +.* &OP IS THE OPCODE TO BE USED. I.E. EITHER L OR ST. * 02350000 +.* &RG IS 1 OPERAND FROM THE &RGS OPERAND USED BY XSAVE AND * 02352000 +.* XRETURN. IT IS EITHER 1 REGISTER, OR A PAIR OF REGS * 02354000 +.* SEPARATED BY A DASH. * 02356000 +.* &NO15 =0 STATES THAT A RETURN CODE IS CURRENTLY IN REG 15 * 02358000 +.* AND SHOULD NOT BE DISTURBED, REGARDLESS OF HOW THE REGS* 02360000 +.* ARE SPECIFIED. * 02362000 +.* USES MACROS: XCHAR * 02364000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02366000 + GBLC &XXCHAR FOR COMMUNICATION WITH XCHAR 02368000 + LCLA &I 02370000 + LCLC &R1,&R2 1ST REG, 2ND REG, TEMPORARY 02372000 + AIF ('&RG' EQ 'NO').XXEXIT DON'T GEN ANYTHING 02374000 +.* SCAN FOR DASH-MEANING 2 REGISTERS. * 02376000 +.XSL1 ANOP 02378000 +&I SETA &I+1 INCREMENT FOR NEXT CHARACTER 02380000 + AIF ('&RG'(&I,1) EQ '-').XDASH JUMP IF DASH FOUND 02382000 + AIF (&I LT K'&RG).XSL1 CONTINUE TO END OF OPERAND 02384000 +&R1 SETC '&RG' &RG IS 1 REGISTER BY ITSELF 02386000 + AGO .XSAA GO TO NEXT DECISION POINT 02388000 +.* FOUND DASH-NOW SEPARATE THE REGISTERS. * 02390000 +.XDASH ANOP 02392000 +&R1 SETC '&RG'(1,&I-1) GET FIRST REGISTER 02394000 + AIF (&I EQ K'&RG).XSAA DUMB USER - 1 REG FOLLOWED BY - 02396000 +&R2 SETC '&RG'(&I+1,K'&RG-&I) GET 2ND REGISTER 02398000 +.XSAA XCHAR &R1,2 GET UP TO LAST 2 CHARS OF 1ST REG 02400000 + AIF ('&XXCHAR' NE '14' AND '&XXCHAR' NE '15').XNO1415 02402000 +&I SETA 4*&XXCHAR-44 OFFSET FOR 14 OR 15 02404000 + AIF ('&R2' NE '').XS2RG SKIP IF 2 REGISTERS SPECIFIED 02406000 + AIF ('&XXCHAR' EQ '15' AND '&NO15' EQ '0').XXEXIT 02408000 + &OP &R1,&I.(13) . SAVE/RESTORE 1 REG 02410000 + MEXIT 02412000 +.XS2RG AIF ('&NO15' EQ '0').XSN15 SKIP IF 15 SHOULDN'T BE 02414000 + &OP.M &R1,&R2,&I.(13) . SAVE/RESTORE RANGE OF REGS 02416000 + MEXIT 02418000 +.XSN15 AIF ('&XXCHAR' EQ '15').XSN15A SKIP IF 15 SPECIFIED 02420000 + L &R1,12(13) . RELOAD REG 14 02422000 + XCHAR &R2,2 GET 2ND REG 02424000 + AIF ('&XXCHAR' EQ '15').XXEXIT SKIP IF 15 SPECIFIED 02426000 +.XSN15A LM 0,&R2,20(13) . RELOAD REST OF REGS 02428000 + MEXIT 02430000 +.* RESTORE 1 REG OR RANGE (NOT STARTING WITH 14 OR 15). * 02432000 +.XNO1415 AIF ('&R2' NE '').XLMSTM JUMP IF MULTIPLE REGS 02434000 + &OP &R1,&R1*4+20(13) 02436000 + MEXIT 02438000 +.XLMSTM &OP.M &R1,&R2,&R1*4+20(13) 02440000 +.XXEXIT MEND 02442000 +./ ADD LEVEL=40,SOURCE=0,NAME=XSRTR 02444000 + MACRO 02446000 + XSRTR &TR,&LABEL,&MSG 02448000 +.*--> MACRO: XSRTR GENERATE TRACE CODE FOR XSAVE/XRETURN . . . . . 02450000 +.* JOHN R. MASHEY- FEB 1970 - V.4.0 * 02452000 +.* THIS MACRO IS USED BY XSAVE AND XRETURN TO GENERATE THE * 02454000 +.* TRACE CODE CALLS TO XSNAP OR XPRNT, OR TIMING CALLS TO XTIME.* 02456000 +.* MACROS CALLED BY THIS MACRO - XLLOK, XPRNT,XSNAP,XTIME * 02458000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02460000 + GBLA &XXLOOK FOR COMMUNICATION 0WITH XLOOK 02462000 + GBLB &XSNAPST,&XPRNTST GLOBALS FOR OUTPUT MACROS 02464000 + LCLA &I FOR USE AS LENGTH SPECIIFICATION 02466000 + LCLB &XSTSAV FOR SAVING STAUS VARIABLES 02468000 + LCLC &NAME FOR EITHER LABEL OR CSECT 02470000 + XLOOK &TR(1),(*,SNAP,TIME) CHECK TYPE 02472000 + AIF (&XXLOOK LT 3).XPS SKIP IF NOT TIME 02474000 +* XTIME ,&TR(2) 02476000 + XTIME ,&TR(2) 02478000 + MEXIT 02480000 +.XPS AIF (&XXLOOK EQ 0 AND N'&TR GT 1 AND '&TR(2)' NE 'SNAP').XE 02482000 +&NAME SETC '&LABEL' ASSUME NAME IS LABEL 02484000 + AIF (T'&LABEL NE 'O').XNOK1 SKIP IF LABEL EXISTS 02486000 +&NAME SETC '&SYSECT' USE CSECT NAME INSTEAD 02488000 + AIF ('&SYSECT' NE '').XNOK1 SKIP IF CSECT NOT PC 02490000 +&NAME SETC '$PRIVATE' USE NAME FOR PRIVATE CODE (PC) 02492000 +.XNOK1 AIF (&XXLOOK EQ 2 OR '&TR(2)' EQ 'SNAP').XNSNAP 02494000 +&XSTSAV SETB (&XPRNTST) SAVE STATUS VARIABLE 02496000 +&XPRNTST SETB (0) MAKE SURE XPRNT WILL GENERATE 02498000 + AIF (&XXLOOK EQ 1).XDFTA SKIP- TR=* - DEFAULT 02500000 +&I SETA 2*((K'&TR)/2) GET RIGHT TOTAL LENGTH FOR DC 02502000 + B *+4+&I . BRANCH AROUND MESSAGE 02504000 +XX&SYSNDX.T DC C'0',CL(&I-1)&TR 02506000 + AGO .XPRB SKIP OVER ALTERNATE 02508000 +.XDFTA B *+28 . BRANCH AROUND MESSAGE 02510000 +XX&SYSNDX.T DC CL24'0*** &NAME &MSG ***' 02512000 +&I SETA 24 SET UP FOR XPRNT 02514000 +.XPRB ANOP 02516000 +* XPRNT XX&SYSNDX.T,&I PRINT MESSAGE WITH GIVEN LENGTH 02518000 + XPRNT XX&SYSNDX.T,&I 02520000 +&XPRNTST SETB (&XSTSAV) RESTORE PREVIOUS VALUE 02522000 + MEXIT 02524000 +.XE MNOTE 0,'**XSRTR- TR=&TR: UNKNOWN, IGNORED' 02526000 + MEXIT 02528000 +.XNSNAP ANOP 02530000 +&XSTSAV SETB (&XSNAPST) SAVE XSNAP STATUS, IN CASE OFF 02532000 +&XSNAPST SETB (0) MAKE SURE XSNAP WILL GENERATE 02534000 +* XSNAP LABEL=' MESSAGE ' 02536000 + AIF (&XXLOOK EQ 2).XDFTB SKIP IF TR=SNAP 02538000 + XSNAP LABEL=&TR(1) 02540000 + AGO .XSNB SKIP OVER ALTERNATE 02542000 +.XDFTB XSNAP LABEL='*** &NAME &MSG ***' 02544000 +.XSNB ANOP 02546000 +&XSNAPST SETB (&XSTSAV) RESTORE STATUS,IN CASE IT WAS OFF 02548000 + MEND 02550000 +./ ADD LEVEL=40,SOURCE=0,NAME=XSTOP 02552000 + MACRO 02554000 +&LABEL XSTOP &N=2,&ABEND=200,&GOTO= 02556000 +.*--> MACRO: XSTOP CONTROL PROGRAM LOOPS . . . . . . . . . . . . . 02558000 +.* JOHN R. MASHEY - FEB 1970 - V.4.0 * 02560000 +.* XSTOP IS USED TO STOP INFINITE LOOPS IN ASSEMBLER * 02562000 +.* N=NUMBER WILL CAUSE THE PROGRAM TO ABEND THE NUMBER'TH * 02564000 +.* TIME THROUGH THE XSTOP. DEFAULT IS N=2, * 02566000 +.* WHICH MEANS THE XSTOP CAN ONLY BE ENCOUNTERED ONCE * 02568000 +.* BEFORE IT ABENDS. * 02570000 +.* ABEND=K K WILL BE THE COMPLETION CODE ISSUED BY THE * 02572000 +.* EMBEDDED ABEND MACRO. DEFAULT IS 200. * 02574000 +.* GOTO=LABEL BRANCH TO LABEL INSTEAD OF ABENDING * 02576000 +.* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02578000 + GBLB &XSTOPST XSTOP GENERATION STATUS,ON=0,OFF=1 02580000 + LCLC &XNAM NAME FOR CONSTANTS 02582000 + AIF (&XSTOPST).XXNOG SKIP IF NOGEN 02584000 +&XNAM SETC 'XX&SYSNDX.V' GET UNIQUE LABEL 02586000 +&LABEL ST 0,&XNAM . SAVE WORK REGISTER 02588000 + L 0,&XNAM+4 . LOAD CURRENT COUNTER VALUE 02590000 + BCT 0,&XNAM+8 . BRANCH IF STILL OK,DECREMENT REG 02592000 + L 0,&XNAM . RESTORE WORK REGISTER 02594000 + AIF ('&GOTO' EQ '').XXAB SKIP IF NO GOTO USED 02596000 + B &GOTO . TAKE DESIRED BRANCH 02598000 + AGO .XXDC SKIP TO GENERATE DC'S 02600000 +.XXAB ABEND &ABEND,DUMP 02602000 +.XXDC ANOP 02604000 +&XNAM DC A(0,&N) . REGISTER SAVE AREA, COUNTER 02606000 + ST 0,&XNAM+4 . SAVE DECREMENTED COUNTER VALUE 02608000 + L 0,&XNAM . RESTORE WORK REGISTER 02610000 + SPACE 2 02612000 + MEXIT 02614000 +.XXNOG AIF (T'&LABEL EQ 'O').XXEXIT SKIP IF NO LABEL 02616000 +&LABEL DS 0H 02618000 +.XXEXIT MEND 02620000 +./ ADD LEVEL=40,SOURCE=0,NAME=XXGPSRCH 02622000 + MACRO 02624000 + XXGPSRCH &DIREC,&TIME 02626000 +.**-->MACRO: XXGPSRCH INNER MACRO FOR XGPGEN . . . . . . . . . . . . . 02628000 +.* ARGUMENTS: 02630000 +.* &DIREC= G--> INPUT 02632000 +.* P--> OUTPUT 02634000 +.* &TIME=1 --> FIRST CALL, SETS UP EXTRA CODE AND ACTS AS &SYSNDX 02636000 +.* 2--> SECOND CALL 02638000 +.*. . . . . . . . . . . . .. . . . . . . . . . . . . . . . . . . . . . 02640000 + L R3,X&DIREC.ELEM . GET # LAST POINTER TO OPEN FILES 02642000 + LA R1,X&DIREC.PNTSRT . GET @ OF FIRST POINTER 02644000 + LTR R3,R3 . ARE THERE ANY ELEMENTS? 02646000 + BE X&DIREC.MAKE&TIME NO - GO CREATE ONE 02648000 + LA R2,12 . SET UP INCREMENT SIZE 02650000 +X&DIREC.LOOP&TIME CLC 0(8,R1),X&DIREC.CURENT COMPARE DD NAMES 02652000 + BE X&DIREC.CONT&TIME IF EQUAL, GO TO I/O 02654000 + BXLE R1,R2,X&DIREC.LOOP&TIME ^EQUAL, SEARCH TILL END OF TABLE 02656000 + SPACE 2 02658000 + MEND 02660000 +//* +//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +//* STEP 5 - ADD ASSIST PROCEDURE TO SYS2.PROCLIB. +//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +//* +//PROC EXEC PGM=IEBUPDTE,PARM=NEW +//SYSPRINT DD SYSOUT=* +//SYSUT2 DD DISP=SHR,DSN=SYS2.PROCLIB <== TARGET LIBRARY +//SYSIN DD DATA +./ ADD NAME=ASSIST +//ASSIST PROC +//DATA EXEC PGM=ASSIST,REGION=4096K,PARM='BATCH,MACRO=H' +//SYSPRINT DD SYSOUT=* +//SYSIN2 DD DDNAME=SYSIN2 (ONLY NEEDED IF &$DATARD=1: 2 READERS) 00010110 +//SYSPRINT DD SYSOUT=*,DCB=(RECFM=FA,LRECL=133,BLKSIZE=133) PRINTER 00010120 +//SYSPUNCH DD SYSOUT=B,DCB=(RECFM=F,LRECL=80,BLKSIZE=80) PUNCH 00010130 +//SYSUT1 DD UNIT=SYSDA,DISP=(,DELETE),SPACE=(3520,(100,10)), 00010140 +// DCB=(RECFM=F,BLKSIZE=3520) DISK INTERMEDIATE 00010150 +//SYSLIB DD DSN=SYS1.MACLIB,DISP=SHR 00010160 +/* +//