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