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