ibm:vm370-lib:cms:dmshdi.assemble_src
Table of Contents
DMSHDI Source
References
- Fixes Applied : 1
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [R09008DS]
Source Listing
- DMSHDI.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmshdi.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator