HDI TITLE 'DMSHDI (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * MODULE NAME - 00004000 * 00005000 * DMSHDI 00006000 * 00007000 * FUNCTION - 00008000 * 00009000 * TO SET THE CMS INTERRUPT HANDLING FUNCTIONS TO TRANSFER CON- 00010000 * TROL TO A GIVEN LOCATION FOR AN I/O DEVICE OTHER THAN THOSE 00011000 * NORMALLY HANDLED BY CMS, OR TO CLEAR PREVIOUSLY 00012000 * INITIALIZED I/O INTERRUPT HANDLING. 00013000 * 00014000 * ATTRIBUTES - 00015000 * 00016000 * REENTRANT, DISK RESIDENT, AND EXECUTES IN THE TRANSIENT AREA 00017000 * NOTE: HNDINT MUST BE GENMOD'D WITH THE SYSTEM OPTION 00017100 * 00018000 * ENTRY POINTS - 00019000 * 00020000 * 1. DMSHDI, HNDINT 00021000 * 00022000 * ENTRY CONDITIONS - 00023000 * 00024000 * LA R1,PLIST 00025000 * SVC 202 00026000 * 00027000 * PLIST = CL8'HNDINT' 00028000 * CL4'SET'|'CLR' 00029000 * TRAP: SEE TRAP MACRO 00030000 * . 00031000 * . 00032000 * XL8 - FENCE 00033000 * 00034000 * EXIT CONDITIONS - 00035000 * 00036000 * NORMAL - 00037000 * GPR15 = 0: SUCCESSFUL COMPLETION 00038000 * 00039000 * ERROR - 00040000 * GPR15 = XXX: INCORRECT PARAMETER LIST 00041000 * YYY: TRAP ITEM REPLACES ANOTHER OF THE SAME DEV. NAME 00042000 * ZZZ: CLEARING NON-EXISTING INTERRUPT 00043000 * 00044000 * CALLS TO OTHER ROUTINES - 00045000 * 00046000 * TYPLIN - TYPE A MESSAGE ON THE TERMINAL 00047000 * FREE - GET FREE STORAGE 00048000 * FRET - RETURN FREE STORAGE 00049000 * 00050000 * EXTERNAL REFERENCES - 00051000 * 00052000 * IOSECT - USER INTERRUPT INFORMATION 00053000 * NUCON - NUCLEUS AREA CONSTANTS 00054000 * 00055000 * TABLES / WORKAREAS - 00056000 * 00057000 * TEMP - TEMPORARY STORAGE SUPPLIED BY SVCINT 00058000 * 00059000 * REGISTER USAGE - 00060000 * 00061000 * GPR1, GPR2 = A(PLIST) 00062000 * GPR3, GPR4, GPR5, GPR6, GPR7, GPR8, GPR9 = WORK REGS. 00063000 * GPR10 = A(IOSECT) 00064000 * GPR11 = UNUSED 00065000 * GPR12 = BASE REGISTER 00066000 * GPR13 = A(TEMP) 00067000 * GPR14 = LINK REGISTER 00068000 * GPR15 = BRANCH REGISTER 00069000 * 00070000 * NOTES - 00071000 * 00072000 * WHEN INTERRUPT IS RECEIVED AND PROCESSED BY CMS 'IOINT' 00073000 * IT PASSES CONTROL TO INTERRUPT HANDLER AS FOLLOWS: 00074000 * 00075000 * GPR0 - GPR1 = IO OLD PSW 00076000 * GPR2 - GPR3 = CSW 00077000 * GPR4 = DEVICE NUMBER (RIGHT JUSTIFIED BINARY NUMBER) 00078000 * GPR14 = RETURN ADDRESS IN IOINT 00079000 * GPR15 = A(INTERRUPT HANDLER BEING INVOKED) 00080000 * 00081000 * WHEN THRU PROCESSING INTERRUPT, THE INTERRUPT HANDLER MUST 00082000 * RETURN TO IOINT VIA R14, WITH R15 AS FOLLOWS: 00083000 * 00084000 * GPR15 = 0: SUCCESSFUL AND NORMAL COMPLETION 00085000 * GPR15 NE 0: ANOTHER INTERRUPT EXPECTED (E.G. CHANNEL END, 00086000 * DEVICE END COMING SHORTLY) 00087000 * 00088000 * OPERATION - 00089000 * 00090000 * 1. PROGRAM INITIALIZES HANDLING TO BE DONE VIA 'HNDINT SET' 00091000 * 00092000 * 2. WHEN I/O TO APPROPRIATE DEVICE IS TO BE DONE, 00093000 * SYSTEM-MASK IS SET 'OFF' (BY 'SSM' INSTRUCTION) 00094000 * AND APPRORPATE 'SIO' GIVEN. 00095000 * 00096000 * 3. WHEN 'SIO' PERFORMED SATISFACTORILY, SYSTEM-MASK CAN BE 00097000 * SET TO ALLOW ALL INTERRUPTS. 00098000 * 00099000 * 4A. IF 'ASAP' WAS SPECIFIED, INTERRUPT-HANDLER IS INVOKED AS 00100000 * SOON AS THE INTERRUPT IS 'FIELDED' BY CMS 'IOINT' 00101000 * INTERRUPT-HANDLER RETURNS TO 'IOINT' WHICH RETURNS TO PROG 00102000 * 00103000 * 4B. IF 'ASAP' WASN'T SPECIFIED, 'IOINT' RETAINS NEEDED 00104000 * INFORMATION UNTIL CMS 'WAIT' FUNCTION IS CALLED. 00105000 * 00106000 * 5. WHEN PROGRAM 'NEEDS' THE INTERRUPT TO HAVE BEEN RECEIVED, 00107000 * CMS 'WAIT' FUNCTION IS CALLED. IF INTERRUPT HAS NOT 00108000 * YET BEEN RECEIVED, CMS GOES IN 'WAIT' STATE UNTIL 'IOINT' 00109000 * FIELDS AND PROCESSES THE INTERRUPT IN NORMAL WAY. 00110000 * 00111000 * IF INTERRUPT HAS BEEN RECEIVED & PROCESSED (E.G. ON 'ASAP' 00112000 * RETURNS TO CALLER WITH NECESSARY INTERNAL FLAGS CLEARED. 00113000 * 00114000 * IF INTERRUPT HAS BEEN RECEIVED BUT NOT YET PROCESSED 00115000 * (AS UNDER 'WAIT' OPTION INSTEAD OF 'ASAP'), CMS 'WAIT' 00116000 * NOW CALLS IOINT TO INVOKE DESIRED INTERRUPT-HANDLER, 00117000 * THEN CLEARS NEEDED FLAGS AND RETURNS TO CALLER. 00118000 * 00119000 * 6. WHEN THRU, USING PROGRAM SHOULD NORMALLY CLEAR 00120000 * THE INTERRUPT-HANDLING SCHEME THRU 'HNDINT CLR' CALL 00121000 * (UNLESS 'KEEP' OPTION IS USED & INTERRUPT-HANDLER 00122000 * REMAINS INTACT IN CORE) 00123000 *. 00124000 EJECT 00125000 HNDINT START X'E000' 00126000 DMSHDI EQU HNDINT 00127000 ENTRY DMSHDI P3031 00128000 USING NUCON,R0 ACCESS NUCLEUS AREA CONSTANTS 00129000 BALR R12,0 ADDRESSABILITY 00130000 USING *,R12 ... 00131000 L R10,AIOSECT R10 = A(USER INT. TABLE) 00132000 USING TEMP,R13 USE FREE STORAGE PROVIDED BY SVCINT. 00133000 ST R14,JS14 SAVE R14, 00134000 ST R1,JS01 SAVE PLIST POINTER @VA09008 00135000 CLC =CL4'SET',8(R1) IS IT 'SET' ? 00136000 BE HSET BE IF YES, HANDLE 'SET'. 00137000 CLC =CL4'CLR',8(R1) IS IT 'CLR' ? 00138000 BE HSET BE IF YES, HANDLE 'CLR'. 00139000 CLC =CL4'PURGE',8(R1) IF NOT, IS IT 'PURGE' ? 00140000 BE JPURGE BE IF YES, GO HANDLE IT. 00141000 B ERR01 ERROR IF NO LEGAL CALL. 00142000 * 00143000 HSET DS 0H HANDLE EITHER FORM ... 00144000 L R7,ANUCEND R7 = A(END OF NUCLEUS AREA) 00145000 L R8,VMSIZE R8 = END VIRTUAL MACHINE 00146000 LA R2,12(,R1) NOW LET R2 BE START OF IODEV ENTRIES ETC. 00147000 LR R3,R2 R3 WILL BE LAST IODEV ENTRY 00148000 LA R4,12 SET R4 = 12 00149000 LA R0,28 R0 = INITIAL VALUE OF 28 BYTES (1 ENTRY) 00150000 CLC 0(4,R3),FENCE MAKE SURE 'FENCE' ISN'T FIRST 00151000 BNE LM1415 OK IF NOT, START CHECKING P-LIST. 00152000 ERR01 DS 0H ERROR 1 ... 00153000 LA R15,1 (ERROR 1) 00154000 B RETURN GO EXIT. 00155000 * 00156000 LAR3 AR R3,R4 INCREMENT R3 AND KEEP LOOKING ... 00157000 A R0,=F'28' INCREMENT R0 FOR ANOTHER ENTRY, 00158000 LM1415 LM R14,R15,0(R3) GET SYMBOLIC-NAME & INT. RTN. ADD. 00159000 LTR R14,R14 ERROR IF NAME = 0 00160000 BZ ERR01 (MUST BE SOMETHING) 00161000 N R15,=A(X'FFFFFF') ISOLATE ADDRESS-BITS ONLY 00162000 BZ CLC4 ADDRESS OF ZERO IS OK, OTHERWISE CHECK... 00163000 CR R15,R7 COMPARE WITH LOWEST REASONABLE VALUE 00164000 BL ERR01 ERROR IF LESS THAN THAT. 00165000 CR R15,R8 COMPARE WITH HIGHEST REASONABLE VALUE 00166000 BL NR15 BRANCH IF LOW @VA04960 00166100 IC R7,DOSFLAGS SAVE DOS FLAG @VA04960 00166200 NI DOSFLAGS,255-DOSSVC CLEAR DOSSVC (IF DOS ) @VA04960 00166300 SPIE PROGCHK,(5) SET FOR ADDRESSING EXCEPT. @VA04960 00166400 SR R5,R5 CLEAR FOR IDENTIFICATION @VA04960 00166500 CLI 0(R15),B0 CHECK FOR DCSS ADDRESS @VA04960 00166600 SPIE ,MF=(E,(1)) RESTORE PREVIOUS SPIE @VA04960 00166700 STC R7,DOSFLAGS RESTORE DOS FLAG @VA04960 00166800 LTR R5,R5 WAS THERE AN ITERRUPTION? @VA04960 00166900 BNZ ERR01 BRANCH IF YES, NO GOOD @VA04960 00167000 NR15 EQU * @VA04960 00167200 N R15,ONE CHECK LOWEST BIT 00168000 BNZ ERR01 ERROR IF IT WAS AN ODD-NUMBERED ADDRESS. 00169000 * PARAMATER-LIST SEEMS REASONABLE (SO FAR) ... 00170000 CLC4 CLC 12(4,R3),FENCE LOOK FOR FENCE AFTER PARAMETER-LIST 00171000 BNE LAR3 BNE IF NOT FOUND, KEEP LOOKING... 00172000 L R1,JS01 RESET PLIST POINTER @VA09008 00172500 * R3 NOW POINTS TO THE 'LAST' IODEV ENTRY (BEFORE THE 'FENCE') 00173000 LR R8,R4 SET R8 = 12 FOR USE LATER, 00174000 LR R9,R3 LOCATION OF 'LAST' IODEV INTO R9, 00175000 CR R2,R3 IS THERE ONLY ONE ENTRY ? 00176000 BE PLISTOK BE IF YES, P-LIST IS OK. 00177000 * IF MORE THAN ONE, MAKE SURE THERE ISN'T MORE THAN ONE 00178000 * WITH THE SAME NAME ... 00179000 LA R7,12(,R2) SET UP R7, R8, & R9 FOR OUTER LOOP 00180000 * (NOTE - R8 AND R9 HAVE ALREADY BEEN SET UP) 00181000 * (NOTE - R4 ALREADY = 12) 00182000 LA R6,ERR01 (FOR 'BCR' BELOW) 00183000 LR32 LR R3,R2 SET UP STARTING-ADDRESS 00184000 LR R5,R7 AND ENDING-ADDRESS OF 00185000 SR R5,R4 THE 'PREVIOUS' ONES 00186000 CLC37 CLC 0(4,R3),0(R7) CHECK THE SYMBOLIC-NAMES, 00187000 BCR 8,R6 'BE' IF THEY'RE EQUAL (AN ERROR) 00188000 BXLE R3,R4,CLC37 ITERATE ALL PRECEDING ONES 00189000 BXLE R7,R8,LR32 GET NEXT ONE AND CHECK AGAIN. 00190000 PLISTOK EQU * USER'S P-LIST IS OK ... 00191000 USING IOSECT,R10 00192000 LA R4,28 LET R4 = 28 NOW (R8 STILL = 12) 00193000 SR R15,R15 CLEAR 15, 00194000 ST R15,ERRCODE (CLEAR ERROR-CODE) 00195000 CLI 8(R1),C'C' IS THIS A 'CLR' CALL ? 00196000 BE HCLR BE IF YES, GO HANDLE IT. 00197000 SR R5,R5 CLEAR R5 IN CASE NO OLD TABLE, 00198000 C R15,AUSRITBL IS THERE AN OLD TABLE AT ALL ? 00199000 BE SRA03 BE IF THERE IS NONE TO WORRY ABOUT. 00200000 * COMES HERE IF THE OLD TABLE IS REALLY THERE ... 00201000 L R5,AUSRILST GET ADDRESS OF OLD LAST ADCON, 00202000 L R3,AUSRITBL AND THAT OF OLD FIRST ADCON, 00203000 SR R5,R3 LAST - FIRST 00204000 AR R5,R4 PLUS 28 GIVES NO. OF BYTES IN OLD TABLE 00205000 AR R0,R5 R0 = COMBINED SIZE BOTH TABLES (BYTES) 00206000 SRA03 A R0,=F'7' ROUND AS MAY BE NEEDED AND 00207000 SRA R0,3 DIVIDE BY 8 FOR DOUBLE-WORDS, 00208000 DMSFREE DWORDS=(0),TYPCALL=BALR GET SOME FREE STORAGE @VM03083 00209100 * FOR OLD + NEW TABLES 00209200 STM R0,R1,NEWNUMB STORE 'NEWNUMB' & 'NEWFIRST'. 00211000 LTR R6,R5 SAVE BYTE-COUNT OF OLD TABLE FOR LATER 00212000 BZ AR6 BZ IF OLD TABLE DOESN'T EXIST AT ALL 00213000 C R5,F256 IS BYTE-COUNT OF OLD TABLE 256 OR LESS? 00214000 BNH EXMVC BNH IF YES, ONE EX-MVC WILL DO IT. 00215000 MVC256 MVC 0(256,R1),0(R3) IF > 256, MOVE 256 BYTES, 00216000 LA R1,256(,R1) ADJUST FOR NEXT MVC, 00217000 LA R3,256(,R3) ... 00218000 S R5,F256 ... 00219000 C R5,F256 IS IT STILL MORE THAN 256 ? 00220000 BH MVC256 BE IF YES, GO MOVE ANOTHER BIG CHUNK. 00221000 EXMVC BCTR R5,0 IF 256 OR LESS, ADJUST R5 AND 00222000 EX R5,DMVC MOVE THE CORRECT NUMBER OF BYTES. 00223000 L R3,NEWFIRST LET R3 POINT TO OLD 1ST ONE IN FREE STRG. 00224000 LA R5,0(R3,R6) LET R5 POINT TO OLD LAST ONE 00225000 SR R5,R4 IN FREE STORAGE, 00226000 AR6 A R6,NEWFIRST LET R6 POINT TO WHERE NEW ONES SHOULD GO, 00227000 LR R7,R2 R7 POINTS TO NEW FIRST ONE, 00228000 LA R14,STNEW SET UP R14 IN CASE NO OLD TABLE, 00229000 LTR R5,R5 WAS THERE AN OLD TABLE? 00230000 BCR 8,R14 'BZ' IF NOT, START STORING NEW TABLE. 00231000 LA R0,2 '2' INTO R0, 00232000 LA R1,REPLACE (FOR BCR BELOW) 00233000 LA R14,LR3N FOR 0(R14) IN BXLE A BIT LATER... 00234000 LR3N L R3,NEWFIRST LET R3 POINT TO OLD 1ST ONE IN FREE STRG. 00235000 CLC37A CLC 4(4,R3),0(R7) COMPARE NEW ONE WITH AN OLD ONE 00236000 BCR 8,R1 'BE' IF IT MATCHES, GO REPLACE IT. 00237000 BXLE R3,R4,CLC37A ITERATE FOR ALL OLD ONES 00238000 STNEW LR R15,R6 SET R15 FOR A 'NEW' ONE, 00239000 AR R6,R4 ADJUST R6 FOR NEXT TIME. 00240000 STNEW1 MVC 0(28,R15),=7F'0' ZERO-FILL 28-BYTE ENTRY, 00241000 MVC 0(2,R15),8(R7) DEVICE-NUMBER INTO TABLE, 00242000 MVC 4(8,R15),0(R7) DEVICE-NAME & INT.-RTN.ADD. TO TABLE, 00243000 CLI 10(R7),C'A' IS IT 'A' FOR 'ASAP' ? 00244000 BNE ASAPOK BNE IF NOT (PRESUMABLY 'WAIT') 00245000 OI 2(R15),ASAP SET 'ASAP' BIT IF CALLER WANTS THAT. 00246000 ASAPOK CLI 11(R7),C'K' IS IT 'K' FOR 'KEEP' ? 00247000 BNE BXLE78 BNE IF NOT (USUALLY WON'T BE) 00248000 OI 2(R15),KEEP SET 'KEEP' BIT IF CALLER WANTS THAT. 00249000 BXLE78 BXLE R7,R8,0(R14) GO CHECK ANOTHER NEW-ONE. 00250000 SR R6,R4 LET R6 POINT TO LAST ONE IN NEW TABLE 00251000 LM R0,R1,IONTABL CHECK THE OLD TABLE (STILL THERE) 00252000 LTR R0,R0 IF R0 = 0, WASN'T IN FREE STORAGE 00253000 BZ MOVNEW BZ IF SUCH THE CASE, DON'T FRET. 00254000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR FRET OLD TBL @VM03083 00255100 MOVNEW MVC IONTABL(8),NEWNUMB MOVE NEW TABLE INTO POSITION @V305066 00257000 ST R6,AUSRILST (INCLUDING ADDRESS OF LAST ADCON) 00259000 LR15E L R15,ERRCODE ERROR CODE INTO R15 AND 00261000 RETURN L R14,JS14 RESTORE R14, AND 00262000 BR R14 RETURN TO CALLER. 00263000 * 00264000 REPLACE LR R15,R3 IF NEW-ONE HAS SAME NAME, SET R15 TO REPLACE 00265000 ST R0,ERRCODE MAKE SURE ERROR-CODE WILL BE 2, 00266000 B STNEW1 GO REPLACE OLD 28-BYTE ENTRY WITH NEW. 00267000 EJECT 00268000 * HANDLE 'CLR' CALL ... 00269000 HCLR C R15,AUSRITBL IS THERE AN OLD TABLE AT ALL ? 00270000 BNE YES2 BNE IF YES (NORMALLY WOULD BE) 00271000 ERR03 LA R15,3 ERROR 3 IF OLD TABLE UTTERLY NONEXISTENT. 00272000 B RETURN ... 00273000 * 00274000 YES2 L R5,AUSRILST GET ADDRESS OF OLD LAST ADCON, 00275000 L R3,AUSRITBL AND THAT OF OLD FIRST ADCON, 00276000 SR R5,R3 LAST - FIRST 00277000 AR R5,R4 PLUS 28 GIVES NO. OF BYTES IN OLD TABLE 00278000 LA R6,NOTPERF SET R6 FOR 'NOT A PERFECT MATCH' 00279000 CR R5,R0 DOES COUNT MATCH WHAT NEW TABLE WOULD BE? 00280000 BCR 7,R6 'BNE' IF NOT A PERFECT MATCH. 00281000 LR R7,R2 R7 POINTS TO FIRST ONE IN CALLER'S TABLE, 00282000 CLC37B CLC 4(4,R3),0(R7) DOES THE IODEV ENTRY MATCH THE TABLE ? 00283000 BCR 7,R6 'BNE' IF NOT A PERFECT MATCH. 00284000 AR R3,R4 ADD 28 TO R3, AND 00285000 BXLE R7,R8,CLC37B ITERATE FOR WHOLE TABLE. 00286000 LM R0,R1,IONTABL IF PERFECT MATCH, GET OLD IONTABL & JFI 00287000 LR15D EQU * 00288000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR CALL "FRET" @VM03083 00289100 SR R0,R0 CLEAR R0, 00291000 ST R0,IONTABL CLEAR 'IONTABL' 00293000 ST R0,AUSRITBL AND 'AUSITBL' 00294000 ST R0,AUSRILST (ALSO 'AUSILST' (TO BE NEAT) 00295000 B LR15E GO LOAD ERROR-CODE AND EXIT. 00297000 * 00298000 NOTPERF MVC NEWNUMB(8),IONTABL MOVE THE TABLE, 00299000 L R5,AUSRILST SET UP R5 (R3 SET UP SHORTLY BELOW) 00300000 LR R7,R2 ALSO SET UP R7, 00301000 LA R0,3 3 INTO R0 FOR POSSIBLE ERROR-CODE, 00302000 LA R1,ZREPLACE LET R1 POINT TO ZERO-REPLACE, 00303000 LR3NE L R3,NEWFIRST START WITH BEGINNING OF OLD TABLE, 00304000 CLC37C CLC 4(4,R3),0(R7) DO WE HAVE A MATCH ? 00305000 BCR 8,R1 'BE' IF YES, REPLACE BY ZERO. 00306000 BXLE R3,R4,CLC37C ITERATE ... 00307000 ST R0,ERRCODE 'SET' ERROR-CODE 3 IF DROPS THRU BXLE 00308000 BXLE R7,R8,LR3NE ITERATE FOR ALL OF CALLER'S LIST. 00309000 B FINTST GO TO FINAL TEST IF DROP THRU BXLE HERE. 00310000 * 00311000 ZREPLACE MVC 0(28,R3),=7F'0' CLEAR 28 BYTES THERE, 00312000 BXLE R7,R8,LR3NE ITERATE FOR ALL OF CALLER'S P-LIST. 00313000 FINTST L R3,NEWFIRST FINAL TEST - 'COMPACT' EMPTY SPACES --- 00314000 LR R6,R3 R3 AND R6 POINT TO THE BEGINNING ... 00315000 LA R1,BXLE3 FOR 'BCR' BELOW ... 00316000 LR73 L R7,0(,R3) PICK UP A WORD FROM TABLE 00317000 LTR R7,R7 IS IT ZERO ? 00318000 BCR 8,R1 'BZ' IF YES, GO GET NEXT ONE. 00319000 MVC 0(28,R6),0(R3) MOVE 28-BYTE-ITEM TO FRONT OF TABLE 00320000 AR R6,R4 INCREMENT R6 FOR NEXT TIME, 00321000 BXLE3 BXLE R3,R4,LR73 ITERATE THRU TABLE LOOKING FOR ZEROES 00322000 LM R0,R1,NEWNUMB TENTATIVELY SET UP R0 AND R1, 00323000 CR R6,R1 IF R6 STILL = NEWFIRST ? 00324000 BE LR15D BE IF YES, TABLE EMPTY, GIVE IT BACK. 00325000 STM R0,R1,IONTABL IF TABLE NOT EMPTY, SET IT UP AGAIN 00327000 SR R6,R4 INCLUDING THE POINTER 00328000 ST R6,AUSRILST TO THE LAST ONE. 00329000 B LR15E GO LOAD ERROR-CODE AND EXIT. 00331000 EJECT 00332000 * COMES HERE IF CALLING SEQUENCE = 'HNDINT PURGE' 00333000 * MEANS 'PURGE' IONTABL OF ALL ITEMS NOT HAVING 'KEEP' FLAG SET. 00334000 JPURGE LM R2,R5,IONTABL GET OLD TABLE IN REGISTERS, 00335000 LTR R6,R3 A(FIRST-ONE) ALSO INTO R6 & CHECK IT 00336000 BZ ERR03 ERROR 3 IF NOTHING THERE AT ALL 00337000 STM R2,R3,NEWNUMB STORE NEWNUMB & NEWFIRST FOR USE LATER, 00338000 SR R15,R15 SHOW NO ERRORS 00339000 ST R15,ERRCODE ... 00340000 CHECK TM 2(R3),KEEP IS 'KEEP' FLAG SET ? 00341000 BO BXLE4 BO IF YES, LEAVE WELL ENOUGH ALONE 00342000 MVC 0(28,R3),=7F'0' BUT CLEAR 28-BYTE ITEM IF NOT SET 00343000 SR R6,R6 INDICATE WE CLEARED SOMETHING... 00344000 BXLE4 BXLE R3,R4,CHECK ITERATE THRU IONTABL ... 00345000 LTR R6,R6 DID WE CLEAR ANYTHING AT ALL ? 00346000 BZ FINTST BZ IF R6=0, LET FINTST FINISH UP FOR US. 00347000 B RETURN OTHERWISE, GO EXIT, NOTHING MORE TO DO. 00348000 SPACE 1 @VA04960 00348200 PROGCHK EQU * @VA04960 00348400 LR R5,R14 MAKE REGISTER 5 NON-ZERO @VA04960 00348600 BR R14 AND RETURN @VA04960 00348800 SPACE 3 00349000 * CONSTANTS ... 00350000 DMVC MVC 0(*-*,R1),0(R3) MOVES 1 TO 256 BYTES TO FREE STORAGE. 00351000 ONE DC F'1' 00352000 F256 DC F'256' LIMIT OF IBM360 MVC INSTRUCTION 00353000 FENCE DC X'FFFFFFFF' 00354000 B0 EQU 0 CHARACT FIELD FOR IMMED INST.@VA04960 00354500 SPACE 2 00355000 LTORG 00356000 SPACE 2 00357000 TEMP DSECT TEMPORARY STORAGE (VIA R13) ... 00358000 * 00359000 JS01 DS 1F R1 (POINTS TO PARAMETER-LIST) SAVED HERE 00360000 JS14 DS 1F R14 (RETURN-REGISTER) SAVED HERE 00361000 * 00362000 ERRCODE DC F'0' ERROR-CODE FOR R15 AT EXIT. 00363000 SPACE 2 00364000 * TABLE OF 'NEW' INFORMATION (SEE 'IONTABLE' BELOW) 00365000 * 00366000 NEWNUMB DC F'0' NO. OF DBL-WORDS OF FREE STORAGE 00367000 NEWFIRST DC A(*-*) ADDRESS OF FIRST ITEM IN TABLE 00368000 DC F'28' (FOR BXLE) 00369000 NEWLAST DC A(*-*) ADDRESS OF LAST ITEM IN TABLE 00370000 SPACE 2 00371000 ASAP EQU X'40' 'ASAP' FLAG-BIT 00372000 KEEP EQU X'08' 'KEEP' FLAG-BIT 00373000 * 00374000 EJECT 00375000 NUCON 00376000 IOSECT 00377000 REGEQU 00378000 * 00379000 END 00380000