Programming samples by Robert Elton Maas Assembly language (IBM 360/370) These are excerpts from the file NPSLREST.ASSEMBLE (98k bytes total): TITLE 'NPSLREST -- code to restore WArrays from savefile' * * Nov 15, 1988: Massive edit to clean up undocumented register * * usage, undocumented interface conventions, etc. and to install * * new code to de-allocate all allocated storage in case of abort * * during startup (not enough memory, no such savefile, savefile * * not correct format, etc.). This includes use of nonzero return * * code from NPSLREST to TEST2 to signal abort in progress and * * cause TEST2 to deallocate its memory too before exiting. * * These edits coordinate with edits in TEST2 ASSEMBLE. * *********************************************************************** * LOCAL variables in this next section. This is a template which * at runtime corresponds to a block of memory at base register BAS12 * All local variables used by this program reside here. *********************************************************************** LOCAL DSECT LOC0 DS 0H * ABORTWD DS F If nonzero, means we are aborting * CCCPARMS DS A Ptr at start of parameter list from PSLSTART * Individual parms copied to here for easier access... LOCFSCB DS F Pointer at memory allocated for FSCB, typically * used below as base register for picking out * fields within the FSCB. LOCBUFF DS F Pointer at memory allocated for I/O buffer * WADESTAB DS F Pointer to allocated space for table of WArray des SIZWADS DS F Number of doublewords allocated WATABPTR DS F Pointer in that table to next free location WANAMES DS F Pointer to WArray name table, next after that WANAMPTR DS F Pointer in that table to next free location *********************************************************************** * RESTWA Subroutine called by PSLSTART/TEST2 * *---------------------------------------------------------------------* * * * PSLSTART has already processed the CMS parms, allocated a DSECT * * and initialized it (which we later merge with the DSECT from the * * savefile), computed the size of adjustable WArrays, allocated the * * big block of memory that will contain WArrays, sub-allocated each * * individual WArray within that block and set the WArrays in the * * DSECT to point to them, including reserving pages around the stack.* * PSLSTART has also opened the savefile and read the first record, * * to set up defaults for allocation parameters and to verify space * * needed vs. allocated. * * Here we will compute ptrs to the end of each WArray, read in active * * areas from the savefile to the WArray, adjust any pointer from * * WArray that points into another WArray using absolute VM address * * because the target WArray has moved, set up a few more DSECT * * pointers to ends and active boundaries of WArrays, and return to * * PSLSTART which will then protect the pages around stack and do * * other final initialization stuff and jump to PSLMAIN. * * * *********************************************************************** * * This program is invoked by subroutine call with IBM-style parm list. * When this program is started, execution begins here, with registers * containing the following: * regs: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 * xxx JCL NUC xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx SAV RET CSC * 1 = address of start of parameter list, /e/ need more info * 13 = ptr to caller's save area, where we should save regs * 14 = return address to caller * 15 = address used to call this sub-program, i.e. ptr to RESTWA * Other registers contain random junk from caller's environment * that is of no interest to us here. * The first thing we have to do is save all registers (except 13) * in the caller's save area, then juggle the registers around * to conform to the conventions we'll be using in this program: * CSC11 = base register pointing at our RESTWA CSECT (copied from 15) * LOC12 = base register pointing at our LOCAL DSECT (set up later) * R9 = pointer at JCL (temporary, ditto) * CSECT RESTWA00 DS 0F DC AL1(246) Tag for code or data block (F6) DC AL1(128) Extra bits to specify code block (80) DC AL2(SIZRESTW/4) Length, which must fit in halfword DC AL2(SIZRESTW-20),AL2(SIZRESTW-20) HW Offsets A,B DC AL2(SIZRESTW-20),AL2(SIZRESTW-20) HW Offsets C,D DC F'4' DC F'0' ENTRY RESTWA Main entry point for this file RESTWA DS 0F (See above&below for what's in registers now) * regs: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 * ccc PRM ccc ccc ccc ccc ccc ccc ccc ccc ccc ccc ccc SAV RET CSC * * (1) Save all caller's registers (except 13), freeing them for * our use. * Copy reg 15 to where we really want it (CSC11) * Copy reg 1 to where it won't be stepped on by * DMSFREE in (2) below. * HIDEPTRS DS 0H STM SYS14,SYS12,12(SYS13) Save caller's registers * (At this point, regs 13,14,15,1 have stuff that's useful to us) * Caller's saveptr will be in SYS13 throughout. * Use r9 to hold JCL ptr, while juggling regs, * Use r3 to hold nucx-flag and r4 to hold anchor-ptr LR CSC11,SYS15 CSC11 := csect base address here USING RESTWA,CSC11 Claim CSECT addressibility here LR R9,SYS1 R9 := ptr at parameter list * (At this point, CSC11 is ready, regs R7,R9 temporarily in use) * regs: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 * xxx xxx xxx xxx xxx xxx xxx xxx xxx PRM xxx CSC xxx SAV xxx xxx * * (2) Get memory for LOCAL DSECT, establish LOC12 as base reg * Get memory for FSCB and buffer, store ptrs for use later * LA R0,LOCNDW R0 := Size of local-var dsect DMSFREE DWORDS=(0),ERR=NOLOCAL Alloc mem PSLREST loc vars MVI 0(R1),X'FF' Bugfix 85.3.15, erase the block!! MVC 1(255,R1),0(R1) or at least the first part of it * /E/ Need to do MVCL here to erase whole block not just 255 bytes LR LOC12,R1 LOC12 := base for local variables USING LOCAL,LOC12 ST R0,SIZLOCAL #dwords, used later by DMSFRET * Lines with *A are debug messages for storage (de)allocation *A LINEDIT TEXT='Allocated PSLREST local vars' SR R1,R1 ST R1,ABORTWD This needs to be 0...0 not F...F * (At this point, LOC12,CSC11 ready, R9 still temporarily used) * regs: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 * xxx xxx xxx xxx xxx xxx xxx xxx xxx JCL xxx CSC LOC SAV xxx xxx * * (5) Permanently store the ptrs juggled by (1) into LOCAL DSECT. * SAVEPTRS DS 0H ST R9,CCCPARMS Store ptr at parameter list * Also, copy individual parms from parameter list to LOCAL DSECT... USING CALPARMS,R9 L R1,PFSCBPTR ST R1,LOCFSCB L R1,PBUFFPTR ST R1,LOCBUFF L R1,PDMSDSCT ST R1,RUNDSECT DROP R9 * (At this point R7,R9 now free, only LOC12 and CSC11 permanent below) * regs: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 * xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx CSC LOC SAV xxx xxx * 11 = base register pointing at our RESTWA CSECT * 12 = base register pointing at our LOCAL vars DSECT * 13 = ptr to caller's save area, be sure not to clobber this!! * This is the configuration for the main part of this restore code, * until just before we juggle regs to return to caller. * * Preface, find place in kernel where date&time compiled is sitting * as a PSL tagged string object. This will be compared with the * corresponding string from the savefile. They will agree if the * savefile was written by this version of kernel. Otherwise, we * can't expect successful restore&restart. LR1INSTR L R1,COMPWHEA Entry address for COMPWHEA * Pass by SH, STM, LR (10 bytes) LH R2,10(R1) Fetch first half of "L R1,strptr" CH R2,LR1INSTR See if really the correct opcode® BNE BADCOMPW LH R2,12(R1) Fetch second half, with 12-bit disp N R2,DISPMASK Extract just the dispacement L R2,0(R2,R1) Should be tagged string-ptr word BAL RET9,STRCHKFT String check&fetch, R2=adr0, R3=cnt ST R2,CWADR0 ST R3,CWCNT * LINEDIT TEXT='Kernel CompWhen string at ...... for ... chars'X ,SUB=(HEXA,CWADR0,HEXA,CWCNT),RENT=NO * * (6:15) All the interesting stuff here, via subroutine calls * L SYS15,=V(FINDFILE) BALR SYS14,SYS15 File already open, and 1st rec read, * but read 2nd rec w/ 9999 and #WA * * Now allocate memory for WArray descriptors (This was formerly done * inside RDDSCRS, but moved here because deallocation was already * done at the top level, and they should match in this way.) L R1,WACOUNT LA R1,1(R1) Add 1 since rd loop below overshoots MH R1,=AL2(WVBLKSIZ+16) R1 := number of warrays * * (blksiz + av len of name of warray) * Note, this is rather crufty, guessing how much room will be needed. * At the least there should be a trap & error msg in case of overflow? LR R0,R1 R0 := space for warray blocks DMSFREE DWORDS=(0),ERR=WADNOMEM Alloc WArray descrs ST R1,WADESTAB ST R0,SIZWADS #dwords, used later by DMSFRET *A LINEDIT TEXT='Allocated WArrryDescriptor table' * LINEDIT TEXT='WArrayDescr table at ......',SUB=(HEXA,WADESTAB) * L SYS15,=V(RDDSCRS) BALR SYS14,SYS15 Read WArray descriptors from savefile * and save a few sizes&pointers. * Also, computes minimum values for * various new sizes as total active * sizes of old WArray BAL R14,RDDSECT Allocate space and read old RESDSECT * then copy most of it to main DMSDSECT * then de-allocate this temporary space * (Note, above includes filling out right side of WADESCR table to * show where WArrays have been allocated in new core image.) L R1,ABORTWD If we are aborting, LTR R1,R1 BNE RELWADES then skip rest, go to release mem BAL R14,RDSOME Read data of selected WArrays * Below, individual reading of PNAMEs, obsolete, because ptrs to * PNAMEs are now read en masse above in RDSOME. * L SYS15,=V(RDIDS) * BALR SYS14,SYS15 Read each PNAME (put ptrs in SYMNAM) BAL R14,RDREST Read data of remaining WArrays L SYS15,=V(FIXPTRS) BALR SYS14,SYS15 Relocate all data pointers according * to where target has moved due to * WArray re-location during * SAVE/RESTORE cycle. L R1,ABORTWD If we are aborting, LTR R1,R1 BNE RELWADES then skip rest, go to release mem BAL R14,CHKWC Be sure CompWhen: Kernel=Savefile BAL R14,FIXDSECT Patch in ptrs to and sizes of WArrays * Register usage is still like this: * regs: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 * xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx CSC LOC SAV xxx xxx B LASTPART * *********************************************************************** * LASTPART -- Jump down here for dangerous juggling of registers, * deallocating temporary memory, and returning to caller *********************************************************************** LASTPART DS 0H * regs: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 * xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx CSC LOC SAV xxx xxx * L R1,NRQIDS * C R1,ONIDS * BE FOOIDS1 * LINEDIT TEXT='*** Warning, #ids changed, kernel may break' *OOIDS1 DS 0H * Finally, set up registers and return code before returning to caller * As we fall into this, LOC12 and CSC11 are still in use for * base of LOCAL dsect and RESTWA csect. ENTRY STOPHERE STOPHERE DS 0H Put breakpoint here to see all before reclaiming * memory or juggling regs!! * RELWADES DS 0H * Deallocate all temporary storage now except local-variables. I.e. * deallocate WA-descr table, keep local vars for a * little while (see below), keep big WA block and PSLDSECT for LISP. * LINEDIT TEXT='*DEALLOCATING WADESTAB* ...' L 1,WADESTAB L 0,SIZWADS DMSFRET DWORDS=(0),LOC=(1) Release WA-descr table *A LINEDIT TEXT='Released WADescr table' * regs: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 * xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx xxx CSC LOC SAV xxx xxx * Juggle registers a little before deallocating&returning ... DROP LOC12 LR LOC6,LOC12 USING LOCAL,LOC6 reg 6 is now base for local variables DROP CSC11 LR CSC5,CSC11 USING RESTWA,CSC5 reg 5 is now base for this program L WVAR12,RESDSECT * regs: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 * xxx xxx xxx xxx xxx CSC LOC xxx xxx xxx xxx xxx wva SAV xxx xxx * LINEDIT TEXT='*DEALLOCATING ALL LOCAL VARIABLES* ...' LR 1,LOC6 L 0,SIZLOCAL DROP LOC6 About to deallocate, have to discard base!! DMSFRET DWORDS=(0),LOC=(1) Release PSLREST local vars *A LINEDIT TEXT='Released PSLREST local vars' LTR ABO9,ABO9 BE FINALOK *A LINEDIT TEXT='ABO9 was set, aborting NPSLREST via return code' LA R15,2 If aborting, return code = 2 B RETURNPT Jump to common return point FINALOK DS 0H * regs: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 * xxx xxx xxx xxx xxx CSC xxx xxx xxx xxx xxx xxx xxx SAV xxx xxx * LINEDIT TEXT='Returning to caller now, do HX if it dies...' WAITT * One last register to load now that all clobbering macros are done... L NIL0,=X'FE000080' ID#80 = NIL DMSKEY NUCLEUS Get write access to nucleus ST NIL0,128 16#80 in low memory, lazy-CAR of NIL => NIL ST NIL0,132 16#84 in low memory, lazy-CDR of NIL => NIL DMSKEY RESET Restore PSW protect key to normal user state * regs: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 * xxx xxx xxx xxx xxx CSC xxx xxx xxx xxx xxx xxx xxx SAV xxx xxx *A LINEDIT TEXT='Returning to PslStart' SR R15,R15 Set up zero (success) return code B RETURNPT Jump to common return point This is the complete file FORT370A.ASSEMBLE: * FORT370A ASSEMBLE, formerly F4AT ASSEMBLE * * Created: 86/07/18 00:40:26 GMT * * Written by Robert Maas * IMSSS-Ventura Hall * Stanford University * Stanford CA 94305 * * Copyright c. 1986 Leland Stanford Junior University * Research supported by National Science Foundation * * EditStamps: * * Enhancment to Fortran/77 to support pointer variables * * DATA can be any type except string (character array) * INTEGER PDATA * CALL F4ADR(DATA,PDATA) modifies PDATA to point at DATA ENTRY F4ADR Via BALR 14,15 (14=retadr, 15=base) F4ADR CSECT STM 14,12,12(13) * LR 11,15 * USING F4ADR,11 * R1 points to 2-element parameter list L 2,0(1) 2 contains adr of DATA L 3,4(1) 3 contains adr of PDATA ST 2,0(3) Modify PDATA to contain adr of DATA LM 14,12,12(13) SR 15,15 BR 14 * DROP 11 * * STRING (i.e. character array) SDATA * INTEGER PDATA,LDATA * CALL F4ADRL(SDATA,PDATA,LDATA) modifies PDATA to point at DATA * and LDATA to contain length of DATA ENTRY F4ADRL Via BALR 14,15 (14=retadr, 15=base) F4ADRL CSECT STM 14,12,12(13) * LR 11,15 * USING F4ADR,11 * R1 points to 3-element parameter list followed by 3-elem length list L 2,0(1) 2 contains adr of SDATA L 3,4(1) 3 contains adr of PDATA ST 2,0(3) Modify PDATA to contain adr of SDATA L 2,12(1) 2 contains adr of length-word for SDATA L 4,0(2) 4 contains length word itself L 3,8(1) 3 contains adr of LDATA ST 4,0(3) Modify LDATA to contain length of SDATA LM 14,12,12(13) SR 15,15 BR 14 * DROP 11 * END