ARN TITLE 'DMSARN (CMS) VM/370 - RELEASE 6' 00001000
SPACE 2 00002000
*. 00003000
* MODULE NAME: 00004000
* 00005000
* DMSARN (ASM3705) 00006000
* 00007000
* FUNCTION: 00008000
* 00009000
* ASM3705 COMMAND. TO PROVIDE THE INTERFACE BETWEEN 00010000
* THE USER AND THE 370X ASSEMBLER. 00011000
* 00012000
* ATTRIBUTES: 00013000
* 00014000
* DISK RESIDENT 00015000
* 00016000
* ENTRY POINTS: 00017000
* 00018000
* DMSARN - SEE FUNCTION DESCRIPTION 00019000
* ASMHAND - SYSUT2 PROCESSING ROUTINE (CALLED FROM DMSSOB) 00020000
* 00021000
* ENTRY CONDITIONS: 00022000
* 00023000
* ASM3705 - 00024000
* GPR1 = A(PLIST) 00025000
* GPR14 = RETURN ADDRESS 00026000
* GPR15 = A(CALLED ROUTINE) 00027000
* PLIST = CL8 - FILENAME 00028000
* 00029000
* OPTIONAL AND IN ANY ORDER - 00030000
* CL8'(' - START OF OPTIONS 00031000
* CL8'XREF'|'NOXREF' *** DEFAULTS APPEAR FIRST *** 00032000
* CL8'NORENT'|'RENT' 00033000
* CL8'NODECK'|'DECK' 00034000
* CL8'LOAD'|'NOLOAD' 00035000
* CL8'LIST'|NOLIST' 00036000
* CL8'DISK'|'PRINTER'|'NOPRINT' 00037000
* CL'8'LINECNT', CL8'55'|'NN' 00038000
* 00039000
* XL8 - FENCE 00040000
* 00041000
* EXIT CONDITONS: 00042000
* 00043000
* NORMAL - 00044000
* GPR15 = 0 NO ERROR 00045000
* 00046000
* ERROR - 00047000
* GPR15 = 28 FILE NOT FOUND. 00048000
* GPR15 = 24 INVALID OPTION, NO FILENAME 00049000
* GPR15 = 32 ILLEGAL RECORD LENGTH FOR ASM3705 FILE. 00050000
* GPR15 = 36 NO READ/WRITE DISKS ACCESSED. 00051000
* GPR15 = 4 MINOR ERRORS DETECTED DURING ASSEMBLE, 00052000
* SUCCESSFUL PROGRAM EXECUTION IS PROBABLE. 00053000
* GPR15 = 8 ERRORS DETECTED DURING ASSEMBLE, 00054000
* UNSUCCESSFUL PROGRAM EXECUTION IS 00055000
* POSSIBLE. 00056000
* GPR15 = 12 SERIOUS ERRORS DETECTED DURING ASSEMBLE, 00057000
* UNSUCCESSFUL EXECUTION IS PROBABLE. 00058000
* GPR15 = 16 CRITICAL ERRORS DETECTED DURING ASSEMBLE, 00059000
* UNSUCCESSFUL EXECUTION IS PROBABLE. 00060000
* GPR15 = 20 CATASTROPHIC ERRORS DETECTED DURING 00061000
* ASSEMBLE (PARTIAL OR COMPLETE ASSEMBLY 00062000
* CANCELLED). 00063000
* 00064000
* CALLS TO OTHER ROUTINES: 00065000
* 00066000
* DMSERSA - ERASE OLD FILES 00067000
* DMSSMNE - INITIALIZE STORAGE POINTERS 00068000
* DMSSTTA - LOCATE THE FILE 00069000
* IFKASM - 370X ASSEMBLER ROOT SEGMENT 00070000
* 00071000
* EXTERNAL REFERENCES: 00072000
* 00073000
* FREEMAIN 00074000
* GETMAIN 00075000
* NUCON 00076000
* TYPE 00077000
* 00078000
* 00079000
* TABLES/WORKAREAS: 00080000
* 00081000
* DEFAULTS, OPTEST - LISTS OF VALID OPTIONS AND DEFAULTS 00082000
* 00083000
* REGISTER USAGE: 00084000
* 00085000
* GPR0 = WORKING REGISTER 00086000
* GPR1 = WORKING REGISTER 00087000
* GPR3 = BASE REGISTER 00088000
* GPR4 = WORKING REGISTER 00089000
* GPR5 = WORKING REGISTER 00090000
* GPR6 = RETURN ADDRESS TO CALLER 00091000
* GPR7 = WORKING REGISTER 00092000
* GPR8 = WORKING REGISTER 00093000
* GPR9 = WORKING REGISTER 00094000
* GPR10 = CONSTANT '8' 00095000
* GPR12 = WORKING REGISTER 00096000
* GPR13 = WORKING REGISTER 00097000
* GPR14 = RESERVED TO BALR 14, 15 00098000
* GPR15 = ERROR CODE ON RETURN. 00099000
* 00100000
* NOTES - 00101000
* 00102000
* NONE 00103000
* 00104000
* OPERATION: 00105000
* 00106000
* ASM3705 FIRST SETS A BIT (COMPSWT,X'80') IN 00107000
* OSSFLAGS TO INDICATE THE 370X ASSEMBLER IS RUNNING. 00108000
* 00109000
* ASM3705 NEXT SCANS THE OPTIONS SPECIFIED AND USES 00110000
* THE INFORMATION THEREBY OBTAINED TO SET UP THE OPTION 00111000
* LIST FOR THE 370X ASSEMBLER AND THE FILEDEF PLISTS FOR THE 00112000
* CALLS TO FILEDEF. IF A PARTICULAR OPTION IS NOT 00113000
* SELECTED, THE CORRESPONDING DEFAULT VALUE APPEARS IN 00114000
* THE LIST, WHICH IS COMPACTED TO ELIMINATE BLANKS 00115000
* BEFORE PASSING IT TO THE ASSEMBLER. 00116000
* 00117000
* IF RUNNING UNDER THE BATCH MONITOR, 00118000
* ASM3705 TYPES A MESSAGE AT THE TERMINAL GIVING THE 00119000
* NAME OF THE FILE ABOUT TO BE ASSEMBLED. IT THEN 00120000
* CALLS STATE TO VERIFY THE EXISTENCE OF THIS FILE. IF 00121000
* IT DOES NOT EXIST, ASSEMBLE ISSUES AN ERROR MESSAGE 00122000
* AND RETURNS TO THE CALLER. IF IT DOES EXIST, 00123000
* ASM3705 CHECKS THE ITEM LENGTH, ISSUES AN ERROR 00124000
* MESSAGE IF ITEM LENGTH IS INCORRECT AND RETURNS TO 00125000
* THE CALLER. 00126000
* 00127000
* IF THE LENGTH IS CORRECT, ASM3705 CALLS ERASE TO 00128000
* DELETE ANY EXISTING TEXT, LISTING, AND UTILITY FILES 00129000
* FOR THE CURRENT ASM3705 FILE, AND SETS UP STORAGE BY 00130000
* CALLS TO STRINIT AND GETMAIN. 00131000
* 00132000
* IT THEN CALLS ADTLKW TO OBTAIN THE MODE OF THE 00133000
* READ-WRITE DISK WITH MOST AVAILABLE SPACE AND USES IT 00134000
* TO SET UP THE FILEDEF PLIST FOR THE SYSUT FILES AND 00135000
* CHECKS TO SEE IF THE DISK WITH THE MOST SPACE IS THE SOURCE 00136000
* DISK. IF IT IS DIFFERENT, THE SYSUT FILES ARE ERASED 00137000
* FROM IT (SYSUT FILES ALREADY ERASED FROM SOURCE). IF 00138000
* NOT SPECIFIED BY THE USER, THE TEXT AND LISTING FILES 00139000
* ARE WRITTEN ON THE 1) DISK FROM WHICH THE ASM3705 00140000
* SOURCE IS READ; 2) ON THE "PARENT" DISK, IF THE 00141000
* FIRST DISK IS A READ-ONLY EXTENSION; OR 3) THE 00142000
* PRIMARY A-DISK. IF NONE OF THESE CHOICES IS 00143000
* AVAILABLE, THE COMMAND WILL BE TERMINATED. CMS 00144000
* CONTROL BLOCKS (CMSCB'S), WHICH REFLECT THE SELECTED 00145000
* OPTION, ARE SET UP FOR THE TEXT, LISTING, ASM3705 AND 00146000
* UTILITY FILES. AFTER EACH SUCCESSFUL RETURN FROM 00147000
* FILEDEF, ASM3705 SETS A CLEAR SWITCH TO INDICATE 00148000
* WHICH CMSCB'S ARE TO BE CLEARED AT THE END OF 00149000
* THE ASSEMBLY. ASM3705 FINALLY BRANCHES TO THE 370X ASSEMBLER. 00150000
* 00151000
* ON RETURN FROM THE 370X ASSEMBLER, ASM3705 ERASES THE 00152000
* UTILITY FILES AND CLEARS THE CMSCBS WHICH IT HAD SET UP. 00153000
* AFTER ANY NECESSARY ERROR MESSAGES, ASM3705 FINALLY 00154000
* SETS THE RELEASE PAGE BIT, CLEARS THE SSTATEXT 00155000
* EXTENSION, CLEAR OSSFLAGS, PLACES THE ERROR CODE IN 00156000
* REGISTER 15 AND RETURNS TO THE USER. 00157000
* 00158000
* 00159000
* SPECIAL OUTPUT HANDLING ROUTINE: ASMHAND 00160000
* 00161000
* THE SYSTEM ROUTINE SOEOB INTERFACES WITH ASMHAND 00162000
* WHENEVER ANY I/O ACTIVITY PERTAINS TO THE 00163000
* SYSUT2 FILE DURING THE ASSEMBLY. 00164000
* 00165000
* SYSUT2 - IF THE FILE IS BEING READ IN ASSEMBLER PHASE 00166000
* 1, ASMHAND ACCESSES THE UTILITY CONTROL TABLE TO 00167000
* ASCERTAIN THE LENGTH AND LOCATION OF THE RECORDS TO 00168000
* BE MOVED AND MOVES IT TO THE SPECIFIED INPUT BUFFER. 00169000
* IF THE FILE IS BEING READ, BUT NOT IN PHASE 1, FIXED 00170000
* LENGTH IS FORCED AND ASMHAND RETURNS TO SOEOB. 00171000
* 00172000
* IF THE FILE IS BEING WRITTEN IN PHASE 1, THE UTILITY 00173000
* CONTROL TABLE IS FIRST SET UP BY A CALL TO GETMAIN 00174000
* AND THEN UPDATED TO REFLECT THE NUMBERS OF RECORDS TO 00175000
* BE WRITTEN. IF THE FILE IS BEING WRITTEN BUT IS NOT 00176000
* IN PHASE 1, ASMHAND FORCES A WRITE OF 4000 BYTES AND 00177000
* RETURNS TO THE CALLER. 00178000
* 00179000
* 00180000
*. 00181000
EJECT 00182000
DMSARN START X'00000' @V200820 00183000
USING DMSARN,R3 @V200820 00184000
LR R3,R15 @V200820 00185000
LR R2,R1 SAVE PARAMETER LIST ADDRESS. @V200820 00186000
ST R14,SVREG14 SAVE RETURN TO CMS @V200820 00187000
* SET UP SOME QUANTITIES 00188000
DMSKEY NUCLEUS DISABLE NUCLEUS PROTECT. @V200820 00189000
USING NUCON,R0 @V200820 00190000
OI OSSFLAGS,COMPSWT INDICATE ASSEMBLER RUNNING.. @V200820 00191000
LA R10,8 SET CONSTANT @V200820 00192000
MVI FDEFSWT,0 INITIALIZE FILEDEF SWITCH @V200820 00193000
EJECT 00194000
*********************************************************************** 00195000
* 00196000
* PROCESS ASSEMBLER OPTIONS. 00197000
* 00198000
*********************************************************************** 00199000
SPACE 00200000
CLI 8(R2),X'FF' FILENAME SPECIFIED? @V200820 00201000
BE ERR1E NO, ERROR @V200820 00202000
CLI 8(R2),C'(' DITTO @V200820 00203000
BE ERR1E @V200820 00204000
LA R2,8(,R2) POINT TO FILENAME @V200820 00205000
LA R8,8(,R2) POINT TO OPTIONS @V200820 00206000
SUIT03 CLI 0(R8),X'FF' @V200820 00207000
BE SQUEEZE NO OPTIONS @V200820 00208000
CLI 0(R8),C'(' @V200820 00209000
BE SUIT02 @V200820 00210000
B ERR3E MUST HAVE '(' BEFORE OPTNS @V200820 00211000
* OPTIONS HANDLING... 00212000
SUIT02 CLI 1(R8),BLANK ASSEMBLE CALLED AS COMMAND? @V200820 00213000
BNE SUIT05 @V200820 00214000
LA R8,8(,R8) PTR TO FIRST OPTION. @V200820 00215000
B SUIT14 @V200820 00216000
SUIT05 MVC 0(7,R8),1(R8) REARRANGE OPTION TO ... @V200820 00217000
MVI 7(R8),BLANK DESTROY THE LEADING BLANK @V200820 00218000
* BEGIN THE UNIQUE OPTION SCANNING. 00219000
SUIT14 CLI 0(R8),C')' END OF OPTIONS? @V200820 00220000
BE SQUEEZE YES. @V200820 00221000
CLI 0(R8),X'FF' ASK AGAIN, HE'S BUSY! @V200820 00222000
BE SQUEEZE YES. @V200820 00223000
* COMMENCE OPTION SCANNER... 00224000
CLC 0(8,R8),PRT CMS 'PRINT' OPTION? @V200820 00225000
BE PDEV @V200820 00226000
CLC 0(3,R8),=CL3'PR' @V200820 00227000
BNE TNOPRNT @V200820 00228000
PDEV MVC LISTDEV(8),=CL8'PRINTER' LISTING TO PRINTER @V200820 00229000
B SUIT08 @V200820 00230000
TNOPRNT CLC 0(8,R8),NOPRINT @V200820 00231000
BE NOPSW @V200820 00232000
CLC 0(5,R8),=CL5'NOPR' @V200820 00233000
BNE LISTDSK @V200820 00234000
NOPSW OI FDEFSWT,NOPRNT SET 'NOPRINT' SW @V200820 00235000
B SUIT08 @V200820 00236000
LISTDSK CLC 0(8,R8),DISK LISTING TO DISK? @V200820 00237000
BE SUIT08 YES, DEFAULT @V200820 00238000
LA R5,OPTEST POINT TO START OF NON-DEFAULTS @V200820 00239000
LA R6,8 INCREMENT @V200820 00240000
LA R7,RENT END OF TABLE @V200820 00241000
AGAIN LA R4,OPTSTART-9 POINT TO WORK AREA @V200820 00242000
NEXTOPT LA R4,9(,R4) BUMP TO NEXT WORK SPACE @V200820 00243000
CLC 0(8,R8),0(R5) USER OPTION = TABLE OPTION? @V200820 00244000
BNE BXLE IF NOT, TRY AGAIN @V200820 00245000
MVC 0(8,R4),0(R5) IF SO, PASS HIM TO ASM3705 (LATER@V200820 00246000
B SUIT08 AND GET NEXT USER OPTION... @V200820 00247000
BXLE BXLE R5,R6,NEXTOPT @V200820 00248000
XI *+5,X'F0' FIRST TIME SWITCH @V200820 00249000
RESET BC 15,SUIT080 EXECUTE FOLLOWING FIRST TIME THR @V200820 00250000
LA R5,DEFAULTS NOW CHECK DEFAULTS, JUST IN CASE @V200820 00251000
LA R7,DEFAULTD END OF DEFAULTS TABLE @V200820 00252000
B AGAIN USE SAME BXLE AGAIN @V200820 00253000
SUIT080 CLC 0(7,R8),LINECNT+1 ONLY ONE OPTION LEFT... @V200820 00254000
BNE ERR3E INVALID OPTION - QUIT @V200820 00255000
AR R8,R10 YES - BUMP R8 TO LINE COUNT @V200820 00256000
LA R7,ERR3E LOAD ERROR RETURN @V200820 00257000
CLI 0(R8),BLANK ANY VALUE GIVEN? @V200820 00258000
BCR 8,R7 NO...ERROR @V200820 00259000
TM 0(R8),X'F0' 1ST DIGIT NUMERIC? @V200820 00260000
BCR 14,R7 NO...ERROR @V200820 00261000
CLI 1(R8),BLANK 2ND DIGIT ? @V200820 00262000
BE MOVER NO @V200820 00263000
TM 1(R8),X'F0' YES...IS IT NUMERIC? @V200820 00264000
BCR 14,R7 NO...ERROR @V200820 00265000
CLI 2(R8),BLANK 3RD DIGIT? @V200820 00266000
BCR 7,R7 NO...ERROR @V200820 00267000
B USECNT VALID ENTRY @V200820 00268000
MOVER MVC 1(1,R8),0(R8) MOVE OVER SINGLE DIGIT AND.. @V200820 00269000
MVI 0(R8),C'0' GIVE IT A TENS DIGIT OF '0' @V200820 00270000
USECNT MVC LINECNT+9(2),0(R8) AND PUT IT IN OPTION LIST @V200820 00271000
SUIT08 AR R8,R10 INC SCAN POINTER THRU ENTRIES @V200820 00272000
MVI RESET+1,X'F0' RESET SCANNING SWITCH @V200820 00273000
B SUIT14 @V200820 00274000
EJECT 00275000
*********************************************************************** 00276000
* 00277000
* FOR ANY FILE TO ASSEMBLE, CHECK ITS EXISTENCE, RECORD LENGTH 00278000
* AND ERASE UNECESSARY FILES 00279000
* 00280000
*********************************************************************** 00281000
* REVISE EXEC PARAMETER LIST BEFORE INVOKING ASSEMBLER 00282000
* 00283000
SQUEEZE LA R12,OPTSTART SET START ADDRESS @V200820 00284000
LA R15,OPTEND-1 SET END ADDRESS @V200820 00285000
LA R14,1 SET INCREMENT @V200820 00286000
LA R6,EXECPARM+2 SET ADDRES FOR BLANKLESS LINE @V200820 00287000
LR R1,R6 SAVE BEGIN LOCATION @V200820 00288000
TEST CLI 0(R12),BLANK IS THE FIRST CHARACTER A BLAN @V200820 00289000
BE MOVALONG YES. IGNORE IT @V200820 00290000
MVC 0(1,R6),0(R12) MOVE NON BLANK OPTION CHARAC @V200820 00291000
LA R6,1(,R6) INCREMENT "TO" POINTER @V200820 00292000
MOVALONG BXLE R12,R14,TEST YES, GO GET NEXT CHARACTER @V200820 00293000
SR R6,R1 GET LENGTH OF WRUNG OUT LINE @V200820 00294000
STH R6,EXECPARM SAVE LENGTH OF PLIST @V200820 00295000
* 00296000
SUIT15 EQU * @V200820 00297000
TM BATFLAGS,BATRUN IF BATCH RUNNING, TELL HIM.. @V200820 00298000
BZ SUIT25 WHERE HE IS. @V200820 00299000
MVC MSG1NAM(8),0(R2) @V200820 00300000
LA R1,CONSOL @V200820 00301000
SVC X'CA' @V200820 00302000
DC AL4(*+4) @V200820 00303000
B CONTINUE @V200820 00304000
* VERIFY FILE EXISTENCE 00305000
SUIT25 MVC STATE+8(8),0(R2) SET FILE NAME @V200820 00306000
XC ODE(2),ODE CLEAR ODE SPECIFICATION. @V200820 00307000
MVC STATE+16(8),INPUT SET INPUT TYPE NAME. @V200820 00308000
LA R1,STATE @V200820 00309000
SVC X'CA' @V200820 00310000
DC AL4(SUIT25A) @V200820 00311000
B SUIT16 @V200820 00312000
SUIT25A MVI ERRCODE,X'01' @V200820 00313000
MVC ERASE+24(2),A1 DUMMY-OUT MODE @V200820 00314000
B SUIT18A @V200820 00315000
* 00316000
SUIT16 L R8,AFSTCOPY @V200820 00317000
USING FSTSECT,R8 @V200820 00318000
MVC SYSNMOD(2),FSTM PROVIDE ASSEM SOURCE MODE @V200820 00319000
DROP R8 @V200820 00320000
CLI 35(R8),X'50' LRECL = 80 BYTES? @V200820 00321000
BE SUIT17 @V200820 00322000
MVC SYSNAM(8),0(R2) SET FILEID FOR ERRMSG @V200820 00323000
LA R9,SYSNAM POINT TO FILEID @V200820 00324000
B ERR007E @V200820 00325000
EJECT 00326000
* 00327000
* FIND A R/W DISK FOR WRITING TEXT &LISTING FILES... 00328000
* 00329000
SUIT17 L R1,FSTL(R8) GET A(ADT) FROM FSTCOPY (STA @V200820 00330000
USING ADTSECT,R1 @V200820 00331000
TM ADTFLG1,ADTFRW IS ORIGIN OF FILE A R/W DISK @V200820 00332000
BO USEIT YES - WRITE BACK TO IT... @V200820 00333000
CLI ADTMX,BLANK NO - IS IT AN EXTENSION? @V200820 00334000
BE CONTINUE NO- DEFAULT TO PRIMARY DISK @V200820 00335000
MVC ADTPARM(1),ADTMX YES - @V200820 00336000
LA R1,ADTLIST CALL ADTLKW FOR PARENT DISK. @V200820 00337000
L R15,VCADTLKW GET ADTLKW ADDRESS @VM03093 00338100
BALR R14,R15 @V200820 00339000
BC 2,CONTINUE IF PARENT DISK R/O, DEFAULT. @V200820 00340000
* 00341000
USEIT MVC WMODE(1),ADTM IF R/W, USE FOR WRITING NEW @V200820 00342000
* FILES 00343000
* PREPARE TO ERASE OLD FILES... 00344000
DROP R1 @V200820 00345000
CONTINUE MVC ERASE+24(2),WMODE SET MODE @V200820 00346000
SUIT18A MVC ERASE+8(8),0(R2) SET NAME @V200820 00347000
LA R9,DDFIN-8 @V200820 00348000
LA R13,INPUT+8 @V200820 00349000
LA R8,8 @V200820 00350000
LA R1,ERASE @V200820 00351000
SUIT18 MVC ERASE+16(8),0(R13) @V200820 00352000
SVC X'CA' ERASE LISTING,TEXT, UTILITY FILES@V200820 00353000
DC AL4(JBXLE) ERROR-RETURN IF IT DIDN'T EXIST @V200820 00354000
JBXLE BXLE R13,R8,SUIT18 ITERATE ... @V200820 00355000
EJECT 00356000
*********************************************************************** 00357000
* 00358000
* INITIALIZATION IN CMS NUCLEUS. 00359000
* 00360000
*********************************************************************** 00361000
L R15,ASTRINIT INITIALIZE FREE STORAGE @V200820 00362000
BALR R14,R15 @V200820 00363000
* RESERVE A LARGE ENOUGH AREA TO LOAD THE LONGEST ASSEMBLE PATH 00364000
L R0,MAXLENGT @V200820 00365000
GETMAIN R,LV=(R0) @V200820 00366000
L R9,FAKELEN @V200820 00367000
LA R8,FAKEAD @V200820 00368000
GETMAIN EC,LV=(R9),A=(R8) @V200820 00369000
SPACE 3 00370000
* MOVE FILE NAME AND MODE IN OSSVC PACKAGE. 00371000
L R8,AOPSECT @V200820 00372000
MVC 8(8,R8),0(R2) MOVE FILE NAME @V200820 00373000
MVC 24(2,R8),ERASE+24 AND MODE @V200820 00374000
L R15,VCADTLKW SET UP CALL TO ADTLKW @VM03093 00375100
MVC ADTPARM,=C'??' FIND DISK WITH MOST SPACE @V200820 00376000
LA R1,ADTLIST @V200820 00377000
BALR R14,R15 @V200820 00378000
BC 2,ERR006E NO READ/WRITE DISKS @V200820 00379000
USING ADTSECT,R1 @V200820 00380000
MVC SYSUTMOD(1),ADTM @V200820 00381000
MVC ERASE+24(2),SYSUTMOD SET UP UTILITY ERASE @V200820 00382000
DROP R1 @V200820 00383000
CLC SYSUTMOD(1),WMODE SOURCE = MOST AVAIL. SPACE? @V200820 00384000
BE NOERASE IF SO, ALREADY ERASED SYSUTS @V200820 00385000
BAL R7,SUIT19 ERASE SYSUTS FROM WRITE DISK @V200820 00386000
NOERASE EQU * @V200820 00387000
USING FCBSECT,R11 @V200820 00388000
MVC SUTNAM(8),0(R2) INITIALIZE SYSUT FILENAME @V200820 00389000
MVI DDSYSUT+5,C'1' SET UP FILEDEF SYSUT1 @V200820 00390000
MVI DD2SYSUT+5,C'1' @V200820 00391000
LA R1,UTFDEF FILEDEF SYSUT1 @V200820 00392000
SVC 202 @V200820 00393000
DC AL4(*+4) @V200820 00394000
LTR R15,R15 ANY ERRORS? @V200820 00395000
BP CLOSE YES, GO AWAY @V200820 00396000
LTR R11,R0 CHEK FOR USER FCB @V200820 00397000
BM FDEFUT2 REQUEST SUCCESSFUL, GO ON @V200820 00398000
MVC FCBPROC(4),AASMHAND USER FCB - TELL HIM WHERE TO@V200820 00399000
FDEFUT2 OI FDEFSWT,X'02' SET FIRST RECORD UTILITY SWCH @V200820 00400000
MVI DDSYSUT+5,C'2' SET UP FILEDEF SYSUT2 @V200820 00401000
MVI DD2SYSUT+5,C'2' @V200820 00402000
LA R1,UTFDEF @V200820 00403000
SVC 202 @V200820 00404000
DC AL4(*+4) @V200820 00405000
LTR R15,R15 ANY ERRORS? @V200820 00406000
BP CLOSE YES, GO AWAY @V200820 00407000
LTR R11,R0 @V200820 00408000
BM UT3 REQUEST SUCCESSFUL, GO ON @V200820 00409000
MVC FCBPROC(4),AASMHAND USER FCB - TELL HIM WHERE TO@V200820 00410000
UT3 LPR R11,R11 @V200820 00411000
OI FCBIOSW,FCBPROCC+FCBPROCO AUXPROC FOR SYSUT2 @V200820 00412000
MVI DDSYSUT+5,C'3' SET UP FILEDEF SYSUT3 @V200820 00413000
MVI DD2SYSUT+5,C'3' @V200820 00414000
LA R1,UTFDEF @V200820 00415000
SVC 202 @V200820 00416000
DC AL4(*+4) @V200820 00417000
LTR R15,R15 ANY ERRORS? @V200820 00418000
BP CLOSE YES, GO AWAY @V200820 00419000
LTR R11,R0 @V200820 00420000
BM FILEDEF REQUEST SUCCESSFUL - GO ON @V200820 00421000
MVC FCBPROC(4),AASMHAND USER FCB - TELL HIM WHERE TO@V200820 00422000
FILEDEF EQU * @V200820 00423000
XR R12,R12 CLEAR R12 @V200820 00424000
LH R12,WMODE LOAD MODE FOR DISK WRITING @V200820 00425000
MVC SYSNAM(8),0(2) STORE FILENAME IN SYSIN PLIST @V200820 00426000
STH R12,TEXTMOD PROVIDE DISK MODE FOR TEXT @V200820 00427000
MVC TEXTNAM(8),0(2) STORE FILENAME IN TEXT PLIST @V200820 00428000
CLC LISTDEV(3),DISK IS PRINTER DEVICE DSK? @V200820 00429000
BE DISKLIST YES, DROP @V200820 00430000
MVC LISTNAM(56),OVER MUST BE PRINTER... @V200820 00431000
B SETFDEF @V200820 00432000
DISKLIST STH R12,LISTMOD PROVIDE DISK O|P MODE @V200820 00433000
MVC LISTNAM(8),0(2) STORE FNAME IN LISTING PLIST @V200820 00434000
SETFDEF LA R1,SYSFDEF SET UP SYSIN FILEDEF @V200820 00435000
SVC 202 @V200820 00436000
DC AL4(*+4) @V200820 00437000
LTR R15,R15 @V200820 00438000
BP CLOSE ANY ERROR? @V200820 00439000
TM ERRCODE,X'01' ? SYSIN FILE ON DISK ? @V200820 00440000
BZ SETEXT YES - GO ON @V200820 00441000
LTR R11,R0 ? USER FCB ? @V200820 00442000
BP DEVTEST YES, GO CHECK HIS DEVICE @V200820 00443000
NI ERRCODE,X'00' NO, ERROR EXIT @V200820 00444000
B ERR002E @V200820 00445000
DEVTEST EQU * @V200820 00446000
CLI FCBDEV,X'14' ? IS DEVICE DISK ? @V200820 00447000
BNE SETEXT NO - SOMETHING ELSE, SO OK @V200820 00448000
NI ERRCODE,X'00' YES, ERROR EXIT @V200820 00449000
B ERR002E @V200820 00450000
SETEXT LA R1,TXTFDEF SET UP TEXT FILEDEF @V200820 00451000
SVC 202 @V200820 00452000
DC AL4(*+4) @V200820 00453000
LTR R15,R15 ANY ERROR? @V200820 00454000
BP CLOSE YES @V200820 00455000
CLC NODECK+1(8),DECK CHEK FOR 'DECK' OPTION @V200820 00456000
BNE LISTR NO - CHEK FOR LISTING @V200820 00457000
LA R1,PUNFDEF YES - SET UP SYSPUNCH FILEDE @V200820 00458000
SVC 202 @V200820 00459000
DC AL4(*+4) @V200820 00460000
LTR R15,R15 ANY ERROR? @V200820 00461000
BP CLOSE @V200820 00462000
LISTR TM FDEFSWT,NOPRNT WAS 'NOPRINT' SPEC'D ? @V200820 00463000
BZ FDEFLIST IF NOT, ISSUE SYSPRINT FDEF @V200820 00464000
MVC LISTDEV(16),DUMMY IF SO, ISSUE DUMMY FDEF...(N @V200820 00465000
FDEFLIST LA R1,LSTFDEF SET UP LISTING FILEDEF @V200820 00466000
SVC 202 @V200820 00467000
DC AL4(*+4) @V200820 00468000
LTR R15,R15 @V200820 00469000
BP CLOSE ANY ERROR? @V200820 00470000
LIST2 LA R1,LIBFDEF SET UP CMSLIB FILEDEF @V200820 00471000
SVC 202 @V200820 00472000
DC AL4(*+4) @V200820 00473000
LTR R15,R15 ANY ERROR? @V200820 00474000
BP CLEARFCB YES. (PROBABLY NO MACLIB FOUND) @V200820 00475000
LPR R11,R0 LOAD (+) FCB ADDR INTO R11 ( @V200820 00476000
OI FCBINIT,FCBCATML MACLIB CONCAT FLAG ON @V200820 00477000
EJECT 00478000
*********************************************************************** 00479000
* 00480000
* CALL THE ASSEMBLER 00481000
* 00482000
*********************************************************************** 00483000
DMSKEY RESET RESET NUCLEUS PROTECT. @V200820 00484000
LA R0,*+8 HELLO ASSEMBLER, THIS IS CMS! @V200820 00485000
B *+12 @V200820 00486000
DC CL8'IFKASM' HELLO CMS, THIS IS ASSEMBLER! @V200820 00487000
SR R1,R1 @V200820 00488000
SVC 8 LOAD THE ASSEMBLER @V200820 00489000
ST R0,VIFKASM @V200820 00490000
LM 13,1,LINK @V200820 00491000
BR R15 @V200820 00492000
* 00493000
* ON RETURN FROM THE ASSEMBLER. 00494000
* 00495000
RETURN EQU * @V200820 00496000
OI FDEFSWT,ASMFIN SIGNAL BACK FROM ASSEMBLER @V200820 00497000
LA R9,3 CHECK FOR MULTIPLE OF 4 @V200820 00498000
NR R9,R15 @V200820 00499000
LTR R9,R9 @V200820 00500000
BNZ SAVRET STRANGE RETURN FROM ASM3705 @V200820 00501000
CH R15,=H'16' ALSO IF > 16 @V200820 00502000
BH SAVRET @V200820 00503000
B *+4(R15) JUMP TAB FOR NORMAL RETURNS @V200820 00504000
B SUIT19 RETURN = 0 @V200820 00505000
B ERR004W 4 @V200820 00506000
B ERR008W 8 @V200820 00507000
B ERR012W 12 @V200820 00508000
B ERR016W 16 @V200820 00509000
* 00510000
SAVRET EQU * @V200820 00511000
STH R15,ERRCODE RETURN CODE FORM THE ASSEMBLER @V200820 00512000
* 00513000
* ERASE UTILITIES 00514000
SUIT19 EQU * @V200820 00515000
LA R9,DDFIN-16 @V200820 00516000
LA R13,INPUT+24 ERASE UTILITIES, USING DDLIST @V200820 00517000
LA R8,8 @V200820 00518000
LA R1,ERASE @V200820 00519000
SUIT20 MVC ERASE+16(8),0(R13) @V200820 00520000
SVC X'CA' @V200820 00521000
DC AL4(*+4) @V200820 00522000
BXLE R13,R8,SUIT20 @V200820 00523000
TM FDEFSWT,ASMFIN BEFORE OR AFTER ASSEMBLY? @V200820 00524000
BCR 8,R7 BEFORE, RETURN TO INITIALIZA @V200820 00525000
CLOSE LA R1,FINIS FINIS * * * (TO BE SAFE) @V200820 00526000
SVC X'CA' @V200820 00527000
DC AL4(*+4) @V200820 00528000
* 00529000
CLEARFCB MVC CLEARNAM(8),CLEARALL CLEAR ALL FCB'S... @V200820 00530000
LA R1,CLEARFIL @V200820 00531000
SVC 202 @V200820 00532000
DC AL4(*+4) @V200820 00533000
EJECT 00534000
* ALL FILES ARE NOW ASSEMBLED. 00535000
END SR R0,R0 @V200820 00536000
TM FDEFSWT,ASMFIN COMMAND ERRORS? @V200820 00537000
BZ CMDERR YES... @V200820 00538000
DMSKEY NUCLEUS DISABLE NUCLEUS PROTECT. @V200820 00539000
CMDERR EQU * COME HERE IF COMMAND ERROR @V200820 00540000
NI OSSFLAGS,255-COMPSWT ASSEMBLER NO LONGER RUN @V200820 00541000
OI MISFLAGS,RELPAGES SET RELEASE PAGE BIT @V200820 00542000
DMSKEY RESET RESET NUCLEUS PROTECT. @V200820 00543000
L R14,SVREG14 @V200820 00544000
LH R15,ERRCODE @V200820 00545000
BR R14 RETURN TO SVCINT @V200820 00546000
SPACE 2 00547000
PRINT NOGEN 00548000
ERR1E DMSERR NUM=1,LET=E,TEXT='NO FILENAME SPECIFIED' @V200820 00549000
MVI ERRCODE+1,X'18' RETURN CODE = 24 @V200820 00550000
B END @V200820 00551000
SPACE 00552000
ERR002E EQU * @V200820 00553000
DMSERR NUM=002,LET=E,SUB=(CHARA,(R2)), @V200820*00554000
TEXT='FILE ''........ ASM3705'' NOT FOUND' @V200820 00555000
MVI ERRCODE+1,X'1C' @V200820 00556000
B CLOSE @V200820 00557000
* 00558000
ERR007E EQU * @V200820 00559000
DMSERR NUM=007,LET=E,SUB=(CHAR8A,(R9)), @V200820*00560000
TEXT='FILE ''....................'' IS NOT FIXED, 80 CHA*00561100
R. RECORDS' @VA04895 00562100
MVI ERRCODE+1,X'20' @V200820 00563000
B CLOSE @V200820 00564000
* 00565000
ERR006E EQU * @V200820 00566000
DMSERR NUM=6,LET=E,TEXT='NO READ/WRITE DISK ACCESSED' @V200820 00567000
MVI ERRCODE+1,X'24' @V200820 00568000
B END GET OUT. @V200820 00569000
* 00570000
ERR3E EQU * @V200820 00571000
DMSERR NUM=3,LET=E,SUB=(CHARA,(R8)), @V200820*00572000
TEXT='INVALID OPTION ''........''' @V200820 00573000
MVI ERRCODE+1,X'18' @V200820 00574000
B END @V200820 00575000
EJECT 00576000
ERR004W DMSERR NUM=4,LET=W,TEXT='WARNING MESSAGES ISSUED' @V200820 00577000
MVI ERRCODE+1,X'04' @V200820 00578000
B SUIT19 @V200820 00579000
* 00580000
ERR008W DMSERR NUM=8,LET=W,TEXT='ERROR MESSAGES ISSUED' @V200820 00581000
MVI ERRCODE+1,X'08' @V200820 00582000
B SUIT19 @V200820 00583000
* 00584000
ERR012W DMSERR NUM=12,LET=W,TEXT='SEVERE ERROR MESSAGES ISSUED' 00585000
MVI ERRCODE+1,X'0C' @V200820 00586000
B SUIT19 @V200820 00587000
* 00588000
ERR016W DMSERR NUM=16,LET=W,TEXT='TERMINAL ERROR MESSAGES ISSUED' 00589000
MVI ERRCODE+1,X'10' @V200820 00590000
B SUIT19 @V200820 00591000
* 00592000
EJECT 00593000
*********************************************************************** 00594000
* 00595000
* PARAMETER LIST FOR THE ASSEMBLER 00596000
* 00597000
*********************************************************************** 00598000
SPACE 00599000
LINK DC A(SAVEAREA) R13 @V200820 00600000
DC A(RETURN) R14 @V200820 00601000
VIFKASM DC A(0) R15: V(IFKASM) @V200820 00602000
DC F'0' @V200820 00603000
DC A(PARAMLST) R1 @V200820 00604000
* 00605000
PARAMLST DC A(EXECPARM) @V200820 00606000
DC X'80',AL3(DDNAMES) @V200820 00607000
* ASSEMBLER DEFAULT OPTIONS ARE SHOWN. 00608000
DS 0H @V200820 00609000
EXECPARM DC H'00' L'REVISED EXEC PARAM FIELD @V200820 00610000
DC 100C' ' @V200820 00611000
OPTSTART EQU * ASSEMBLER OPTION WORK AREA @V200820 00612000
LIST DC CL8'LIST' @V200820 00613000
XREF DC CL9',XREF' @V200820 00614000
LOAD DC CL9',LOAD' @V200820 00615000
NODECK DC CL9',NODECK' @V200820 00616000
NORENT DC CL9',NORENT' @V200820 00617000
LINECNT DC C',LINECNT=55' @V200820 00618000
OPTEND EQU * END OF DEFAULT OPTIONS + 1 @V200820 00619000
DS 0H @V200820 00620000
* ALTERNATE DD NAMES AND ERASURE LIST 00621000
DDNAMES DC AL2(DDFIN-*),24X'00' @V200820 00622000
DC CL8'CMSLIB' @V200820 00623000
INPUT DC CL8'ASM3705' @V200820 00624000
DC CL8'LISTING' @V200820 00625000
DC CL8'PUNCH' @V200820 00626000
DC CL8'SYSUT1' @V200820 00627000
DC CL8'SYSUT2' @V200820 00628000
DC CL8'SYSUT3' @V200820 00629000
DC CL8'TEXT' @V200820 00630000
DDFIN EQU * @V200820 00631000
* LIST OF OPTION KEYWORDS TO COMPARE WITH PARAMETER ENTRIES 00632000
OPTEST DS 0H @V200820 00633000
NOLIST DC CL8'NOLIST' @V200820 00634000
NOXREF DC CL8'NOXREF' @V200820 00635000
NOLOAD DC CL8'NOLOAD' @V200820 00636000
DECK DC CL8'DECK' @V200820 00637000
RENT DC CL8'RENT' @V200820 00638000
* DEFAULTS - SCAN IN CASE OF CONFLICTING ENTRIES, ETC. 00639000
DEFAULTS DS 0H @V200820 00640000
DC CL8'LIST' @V200820 00641000
DC CL8'XREF' @V200820 00642000
DC CL8'LOAD' @V200820 00643000
DC CL8'NODECK' @V200820 00644000
DEFAULTD DC CL8'NORENT' @V200820 00645000
* 00646000
PRT DC CL8'PRINT' @V200820 00647000
NOPRINT DC CL8'NOPRINT' @V200820 00648000
DS 0H @V200820 00649000
WMODE DC CL2'A1' MODE FOR DISK OUTPUT @V200820 00650000
BLANK EQU X'40' @V200820 00651000
EJECT 00652000
* 00653000
* MANDATORY FILE SETUPS 00654000
* 00655000
SYSFDEF DS 0D @V200820 00656000
DC CL8'FILEDEF' @V200820 00657000
DC CL8'ASM3705' @V200820 00658000
DC CL8'DISK' @V200820 00659000
SYSNAM DC CL8' ' @V200820 00660000
DC CL8'ASM3705' @V200820 00661000
SYSNMOD DC CL8'A1' @V200820 00662000
DC CL8'(RECFM' @V200820 00663000
DC CL8'FB' @V200820 00664000
DC CL8'LRECL' @V200820 00665000
DC CL8'80' @V200820 00666000
DC CL8'BLOCK' @V200820 00667000
DC CL8'800' @V200820 00668000
DC CL8'NOCHANGE' @V200820 00669000
DC 8X'FF' @V200820 00670000
TXTFDEF DS 0D @V200820 00671000
DC CL8'FILEDEF' @V200820 00672000
DC CL8'TEXT' @V200820 00673000
TEXTDEV DC CL8'DISK' @V200820 00674000
TEXTNAM DC CL8' ' @V200820 00675000
DC CL8'TEXT' @V200820 00676000
TEXTMOD DC CL8' ' @V200820 00677000
DC CL8'(' @V200820 00678000
DC CL8'NOCHANGE' @V200820 00679000
DC 8X'FF' @V200820 00680000
PUNFDEF DS 0D @V200820 00681000
DC CL8'FILEDEF' @V200820 00682000
DC CL8'PUNCH' @V200820 00683000
DC CL8'PUNCH' @V200820 00684000
DC CL8'(' @V200820 00685000
DC CL8'RECFM' @V200820 00686000
DC CL8'F' @V200820 00687000
DC CL8'LRECL' @V200820 00688000
DC CL8'80' @V200820 00689000
DC CL8'BLOCK' @V200820 00690000
DC CL8'80' @V200820 00691000
DC CL8'NOCHANGE' @V200820 00692000
DC 8X'FF' @V200820 00693000
LSTFDEF DS 0D @V200820 00694000
DC CL8'FILEDEF' @V200820 00695000
DC CL8'LISTING' @V200820 00696000
LISTDEV DC CL8'DISK' @V200820 00697000
LISTNAM DC CL8' ' @V200820 00698000
DC CL8'LISTING' @V200820 00699000
LISTMOD DC CL8' ' @V200820 00700000
OVER DC CL8'(' @V200820 00701000
DC CL8'RECFM' @V200820 00702000
DC CL8'FB' @V200820 00703000
DC CL8'BLOCK' @V200820 00704000
DC CL8'605' @V200820 00705000
DC CL8'NOCHANGE' @V200820 00706000
DC 8X'FF' @V200820 00707000
UTFDEF DS 0D @V200820 00708000
DC CL8'FILEDEF' @V200820 00709000
DDSYSUT DC CL8'SYSUT1' FIRST SYSUT FILEDEF @V200820 00710000
DISK DC CL8'DISK' @V200820 00711000
SUTNAM DC CL8' ' @V200820 00712000
DD2SYSUT DC CL8'SYSUT1' @V200820 00713000
SYSUTMOD DC CL8' 4' @V200820 00714000
DC CL8'(' @V200820 00715000
DC CL8'NOCHANGE' @V200820 00716000
DC CL8'BLOCK' @V200820 00717000
DC CL8'1739' @V200820 00718000
DC CL8'AUXPROC' @V200820 00719000
DC AL4(ASMHAND) @V200820 00720000
DC AL4(0) @V200820 00721000
FENCE DC 8X'FF' @V200820 00722000
LIBFDEF DS 0D @V200820 00723000
DC CL8'FILEDEF' @V200820 00724000
DC CL8'CMSLIB' @V200820 00725000
DC CL8'DISK' @V200820 00726000
DC CL8'CMSLIB' @V200820 00727000
DC CL8'MACLIB' @V200820 00728000
DC CL8'*' @V200820 00729000
DC CL8'(LRECL' @V200820 00730000
DC CL8'80' @V200820 00731000
DC CL8'RECFM' @V200820 00732000
DC CL8'FB' @V200820 00733000
DC CL8'BLOCK' @V200820 00734000
DC CL8'800' @V200820 00735000
DC CL8'NOCHANGE' @V200820 00736000
DC 8X'FF' @V200820 00737000
CLEARFIL DS 0D @V200820 00738000
DC CL8'FILEDEF' @V200820 00739000
CLEARNAM DC CL8'*' @V200820 00740000
DC CL8'CLEAR' @V200820 00741000
DC 8X'FF' @V200820 00742000
ADTLIST DS 0D @V200820 00743000
DC CL24' ' IMMATERIAL @V200820 00744000
ADTPARM DC CL2' ' CODE FOR ADTLKW CALLS @V200820 00745000
SYSUT1 DC CL8'SYSUT1' @V200820 00746000
SYSUT2 DC CL8'SYSUT2' @V200820 00747000
SYSUT3 DC CL8'SYSUT3' @V200820 00748000
CLEARALL DC CL8'*' @V200820 00749000
DUMMY DC CL8'DUMMY' @V200820 00750000
DC 8X'FF' @V200820 00751000
EJECT 00752000
*********************************************************************** 00753000
* 00754000
* CALLING SEQUENCES 00755000
* 00756000
*********************************************************************** 00757000
DS 0F @V200820 00758000
STATE DC CL8'STATE' @V200820 00759000
DC CL8' ' FILE NAME @V200820 00760000
DC CL8' ' TYPE @V200820 00761000
ODE DC CL2'0' MODE @V200820 00762000
DC CL2'0' UNUSED @V200820 00763000
AFSTCOPY DC A(0) ADDRESS OF FST COPY LOCATION @V200820 00764000
* 00765000
DS 0F @V200820 00766000
ERASE DC CL8'ERASE' @V200820 00767000
DC CL8' ' FILE NAME @V200820 00768000
DC CL8' ' TYPE @V200820 00769000
DC CL2' ' MODE @V200820 00770000
* 00771000
DS 0F @V200820 00772000
FINIS DC CL8'FINIS' @V200820 00773000
DC CL8'*' @V200820 00774000
DC CL8'*' @V200820 00775000
DC CL8'*' @V200820 00776000
* 00777000
DS 0F @V200820 00778000
CONSOL DC CL8'TYPLIN' @V200820 00779000
DC AL1(1) @V200820 00780000
DC AL3(MSG1) MESSAGE ADDRESS @V200820 00781000
DC C'R' @V200820 00782000
DC AL3(EMSG1-MSG1) MESSAGE LENGTH @V200820 00783000
EJECT 00784000
*********************************************************************** 00785000
* 00786000
* DATA 00787000
* 00788000
*********************************************************************** 00789000
SPACE 00790000
ERRCODE DC H'0' @V200820 00791000
MSG1 DC C' ASSEMBLING: ' @V200820 00792000
MSG1NAM DC CL8' ' FILE NAME @V200820 00793000
EMSG1 EQU * @V200820 00794000
A1 DC CL2'A1' @V200820 00795000
* 00796000
AASMHAND DC A(ASMHAND) AUXILLARY I/O HANDLER @V200820 00797000
* 00798000
* 00799000
SVREG14 DC F'0' @V200820 00800000
MAXLENGT DC X'00007000' LONGEST ASSEMBLER PATH @V200820 00801000
HALFZERO EQU MAXLENGT H'0' @V200820 00802000
* 00803000
SAVEAREA DC 18F'0' @V200820 00804000
* 00805000
DROP R3 @V200820 00806000
EJECT 00807000
* 00808000
* SPECIAL HANDLING ROUTINE. ENTERED FROM "EOBROUTN". 00809000
* UPON ENTRY: 00810000
* R1=A(DECB) R2=A(DCB) R8=A(OPSECT) 00811000
* R11=A(FCBSECT) R14=A(RETURN) R15=A(ASMHAND) 00812000
* 00813000
* UPON RETURN: 00814000
* ALL REGS ARE RESTORED, EXCEPT R15; 00815000
* EQ 0-EXECUTE I/O REQUEST GT 0-RESIDUAL COUNT LT 0-ERROR CODE 00816000
ASMHAND DS 0D @V200820 00817000
USING ASMHAND,R15 @V200820 00818000
USING NUCON,R0 @V200820 00819000
USING FCBSECT,R11 @V200820 00820000
STM R0,R15,SAVEREGS @V200820 00821000
LR R3,R15 @V200820 00822000
DROP R15 @V200820 00823000
USING ASMHAND,R3 @V200820 00824000
* DETERMINE WHICH DATA SET NEEDS SPECIAL HANDLING 00825000
CLC FCBDD(5),=CL8'SYSUT' @V200820 00826000
BNE HRETURN NOT AN UTITLITY FILE @V200820 00827000
CLI FCBDD+5,C'2' @V200820 00828000
BE SYSUTY HANDLE SYSUT2 @V200820 00829000
* ANY SYSTEM UTILITY DATA SET 00830000
SYSUTX EQU * FUDGE SYSTEM UTILITY @V200820 00831000
MVI FCBFORM,C'F' FORCE "FIXED" RECORDS @V200820 00832000
TM IOBIOFLG,IOBIN INPUT? @V200820 00833000
BO HRETURN YES. @V200820 00834000
MVC FCBBYTE+2(2),HALF4000 FORCE WRITE OF 4000 BYT @V200820 00835000
B HRETURN @V200820 00836000
* ASSEMBLER SYSUT2 00837000
SYSUTY EQU * KEEP SYSUT2 IN CORE DURING @V200820 00838000
* PHASE 1 00839000
USING UTENTRY,R2 @V200820 00840000
USING UTHEAD,R5 @V200820 00841000
L R5,UTSAV GET TABLE ENTRY @V200820 00842000
TM FCBIOSW,FCBCLOSE IN CLOSE? @V200820 00843000
BO CLUT2 YES. @V200820 00844000
TM IOBIOFLG,IOBIN INPUT? @V200820 00845000
BNO WRUT2 NOPE. @V200820 00846000
RDUT2 LTR R5,R5 READING. IN PHASE 1? @V200820 00847000
BZ SYSUTX NO. DO NORMAL SYSUT I/O @V200820 00848000
LH R4,FCBITEM @V200820 00849000
N R4,HALFWORD @V200820 00850000
CH R4,UTNOENT DOES READ POINTER GT N'ENTRIES? @V200820 00851000
BH EOFUT2 YES, SIMULATE EOF @V200820 00852000
SLL R4,3 GET INDEX TO TABLE ENTRY @V200820 00853000
LA R2,0(R5,R4) A(ENTRY FOR THIS RECORD) @V200820 00854000
LH R4,FCBBYTE+2 @V200820 00855000
CH R4,UTLNG VERIFY BYTES REQUESTED LE LRECL @V200820 00856000
BNH *+6 @V200820 00857000
HALF4000 DC H'4000' @V200820 00858000
STH R4,FCBREAD SET COUNT OF BYTES READ @V200820 00859000
L R5,UTRECAD GET A("FROM") @V200820 00860000
L R7,FCBBUFF @V200820 00861000
LR R6,R4 GET L'RECORD @V200820 00862000
BAL R14,MOVEMODE MOVE THE RECORD @V200820 00863000
B UTRETURN @V200820 00864000
WRUT2 LTR R5,R5 WRITING. IN PHASE 1? @V200820 00865000
BNZ UTSET YES. @V200820 00866000
TM FDEFSWT,X'02' FIRST TIME? @V200820 00867000
BNO SYSUTX NO @V200820 00868000
NI FDEFSWT,X'FD' TURN OFF FIRST TIME SWITCH @V200820 00869000
B UTSETUP GO SET THINGS UP @V200820 00870000
UTSET LH R4,FCBITEM @V200820 00871000
N R4,HALFWORD @V200820 00872000
CH R4,UTNOENT DOES WRT PTR GT N'RECORDS? @V200820 00873000
BH UTGETCOR YES. GET MORE CORE @V200820 00874000
SLL R4,3 @V200820 00875000
LA R2,0(R5,R4) GET INDEX INTO TABLE @V200820 00876000
UTSET1 EQU * @V200820 00877000
LH R4,FCBBYTE+2 @V200820 00878000
STH R4,FCBREAD SET N'BYTES @V200820 00879000
L R5,FCBBUFF GET A("FROM") @V200820 00880000
L R7,UTRECAD GET A("TO") @V200820 00881000
LR R6,R4 GET L'RECORD @V200820 00882000
BAL R14,MOVEMODE @V200820 00883000
B UTRETURN @V200820 00884000
UTSETUP EQU * SET UP WORD TABLE @V200820 00885000
L R0,FAKELEN @V200820 00886000
L R1,FAKEAD @V200820 00887000
FREEMAIN R,LV=(R0),A=(R1) @V200820 00888000
LA R0,800 GET 100 DOUBLE WORDS @V200820 00889000
LA R10,UTSAV @V200820 00890000
GETMAIN EC,LV=(R0),A=(R10) @V200820 00891000
LTR R15,R15 STORAGE AVAILABLE? @V200820 00892000
BNZ ERR109S NO, ERROR @V200820 00893000
L R1,0(,R10) LOAD ADDR OF FREE STORAGE @V200820 00894000
ST R1,UTSAV @V200820 00895000
LR R5,R1 @V200820 00896000
LA R0,1 @V200820 00897000
STH R0,FCBITEM SET R/W POINTERS @V200820 00898000
ST R0,UTNOENT @V200820 00899000
B UTSET @V200820 00900000
UTGETCOR EQU * GET A NEW BUFFER @V200820 00901000
LH R2,UTNOENT @V200820 00902000
CH R2,HALF99 IS TABLE FULL? @V200820 00903000
BL *+10 @V200820 00904000
B ERR109S @V200820 00905000
HALF99 DC H'99' @V200820 00906000
CH R4,UTNXT SAME AS NEXT ENTRY? @V200820 00907000
BE *+10 @V200820 00908000
B ERR109S @V200820 00909000
DC H'23' @V200820 00910000
STH R4,UTNOENT UPDATE N'ENTRIES @V200820 00911000
LA R2,1(,R4) @V200820 00912000
STH R2,UTNXT UPDATE NEXT AVAILABLE @V200820 00913000
SLL R4,3 @V200820 00914000
LA R2,0(R5,R4) GET INDEX TO TABLE @V200820 00915000
LH R9,FCBBYTE+2 GET L'RECORD @V200820 00916000
STH R9,UTLNG @V200820 00917000
LA R10,UTRECAD @V200820 00918000
GETMAIN EC,LV=(R9),A=(R10) @V200820 00919000
LTR R15,R15 @V200820 00920000
BNZ ERR109S @V200820 00921000
B UTSET1 @V200820 00922000
CLUT2 EQU * CLOSE OUT SYSUT2 @V200820 00923000
LTR R5,R5 ANY BLOCKS USED? @V200820 00924000
BZ HRETURN NOPE. @V200820 00925000
LH R4,UTNOENT GET N'ENTRIES TO RELEASE @V200820 00926000
LR R2,R5 @V200820 00927000
UTNXTFR LA R2,8(,R2) GET NEXT BLOCK TO FREE @V200820 00928000
LH R0,UTLNG @V200820 00929000
L R1,UTRECAD @V200820 00930000
FREEMAIN R,LV=(R0),A=(R1) @V200820 00931000
BCT R4,UTNXTFR @V200820 00932000
LA R0,800 FREE CONTROL BLOCK @V200820 00933000
L R1,UTSAV @V200820 00934000
FREEMAIN R,LV=(R0),A=(R1) @V200820 00935000
SR R15,R15 @V200820 00936000
ST R15,UTSAV SET UTSAV INDEX POINTER CLEAR @V200820 00937000
B HRETURN @V200820 00938000
EJECT 00939000
* 00940000
* MOVE THE RECORD 00941000
* 00942000
SPACE 00943000
* R6=L'RECORD R7=A("TO") R5=A("FROM") R14=A(RETURN) 00944000
MOVEMODE DS 0H MOVE A RECORD @V200820 00945000
MV1 SH R6,HALF256+2 N'BYTES GT 256? @V200820 00946000
BM LT256 NO. @V200820 00947000
MVC 0(256,R7),0(R5) MOVE 256 BYTES OF THE RECORD @V200820 00948000
BCR 8,R14 L'RECORD=256; FINISHED @V200820 00949000
HALF256 LA R7,256(R7,R0) INCREMENT "TO" LOCATION @V200820 00950000
LA R5,256(,R5) INCREMENT "FROM" LOCATION @V200820 00951000
B MV1 MOVE ANOTHER CHUNCK OF RECORD @V200820 00952000
LT256 AH R6,HALF256+2 RESTORE TRUE COUNT @V200820 00953000
BCTR R6,0 PLAY GAMES @V200820 00954000
EX R6,MOVEREC MOVE ALONG @V200820 00955000
BR R14 RETURN @V200820 00956000
MOVEREC MVC 0(*-*,R7),0(R5) MOVE THE RECORD @V200820 00957000
SPACE 3 00958000
EOFUT2 LA R15,12 INDEICATE EOF ON DATA SET @V200820 00959000
LNR R15,R15 NEGATIZE VALUE @V200820 00960000
B RET @V200820 00961000
ERR109S DMSERR NUM=109,LET=S,TEXT='VIRTUAL STORAGE CAPACITY EXCEEDED' 00962000
LA R15,104 RETURN CODE = 104 @V200820 00963000
LH R4,UTNOENT @V200820 00964000
BCTR R4,0 @V200820 00965000
STH R4,UTNOENT @V200820 00966000
B CLUT2 @V200820 00967000
HRETURN SR R15,R15 RETURN TO EOBROUTN @V200820 00968000
B RET @V200820 00969000
UTRETURN L R15,FCBREAD SEND BACK BYTES READ @V200820 00970000
RET LM R0,R14,SAVEREGS @V200820 00971000
BR R14 @V200820 00972000
* 00973000
DS 0F @V200820 00974000
FAKELEN DC X'00005000' @V200820 00975000
FAKEAD DC F'0' @V200820 00976000
HALFWORD DC F'65535' @V200820 00977000
SAVEREGS DC 16F'0' @V200820 00978000
FDEFSWT DC X'00' FILEDEF REMEMBERER: @V200820 00979000
NOPRNT EQU X'80' 'NOPRINT' OPTION @V200820 00980000
ASMFIN EQU X'40' ON IF ASSEMBLER CALLED @V200820 00981000
EJECT 00982000
UTHEAD DSECT @V200820 00983000
UTDUM DS H @V200820 00984000
UTRDPTR DS 0H @V200820 00985000
UTWRPTR DS H READ/WRITE POINTER @V200820 00986000
UTNOENT DS H N'ENTRIES IN TABLE @V200820 00987000
UTNXT DS H NEXT AVAILABLE ENTRY @V200820 00988000
UTENTRY DSECT @V200820 00989000
UTENTNO DS H RECORD ALIGNMENT @V200820 00990000
UTLNG DS H L'BUFFER @V200820 00991000
UTRECAD DS A A(BUFFER) @V200820 00992000
EJECT 00993000
PRINT GEN 00994000
REGEQU @V200820 00995000
SPACE 00996000
CMSCB @V200820 00997000
ADT @V200820 00998000
SPACE 00999000
FSTB @V200820 01000000
NUCON @V200820 01001000
UTSAV EQU IOBCSW HANDLING SYSUT2 @V200820 01002000
SPACE 3 01003000
DMSARN CSECT @V200820 01004000
LTORG @V200820 01005000
SPACE 01006000
ORG DMSARN+X'1000' @V200820 01007000
END DMSARN 01008000