ibm:vm370-lib:cms:dmsasm.assemble_src
Table of Contents
DMSASM Source
References
- Fixes Applied : 6
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [R14534DS]
Source Listing
- DMSASM.ASSEMBLE.txt
- ASM TITLE 'DMSASM (CMS) VM/370 - RELEASE 6' 00001000
- SPACE 2 00002000
- *. 00003000
- * 00004000
- * MODULE NAME: 00005000
- * 00006000
- * DMSASM (ASSEMBLE) 00007000
- * 00008000
- * FUNCTION: 00009000
- * 00010000
- * ASSEMBLE COMMAND. TO PROVIDE THE INTERFACE BETWEEN 00011000
- * THE USER AND THE SYSTEM ASSEMBLER. 00012000
- * 00013000
- * ATTRIBUTES: 00014000
- * 00015000
- * DISK RESIDENT 00016000
- * 00017000
- * ENTRY POINTS: 00018000
- * 00019000
- * DMSASM - SEE FUNCTION DESCRIPTION 00020000
- * ASMPROC - SYSUT1 PROCESSING ROUTINE (CALLED FROM DMSSOB) 00021000
- * 00022000
- * ENTRY CONDITIONS: 00023000
- * 00024000
- * ASSEMBLE - 00025000
- * GPR1 = A(PLIST) 00026000
- * GPR14 = RETURN ADDRESS 00027000
- * GPR15 = A(CALLED ROUTINE) 00028000
- * PLIST = FILENAME 00029000
- * 00030000
- * OPTIONAL AND IN ANY ORDER - 00031000
- * ( - START OF OPTIONS (DEFAULTS APPEAR FIRST) 00032000
- * 00033000
- * ALIGN | NOALIGN 00034000
- * ALOGIC | NOALOGIC 00035000
- * BUFSIZE (STD) | BUFSIZE (MIN) | BUFSIZE (MAX) 00036000
- * DISK,DI | PRINT,PR | NOPRINT,NOPR 00037000
- * ESD | NOESD 00038000
- * FLAG (0) | FLAG (N) 00039000
- * NOLIBMAC | LIBMAC 00040000
- * LINECNT (55) | LINECNT (NNN) 00041000
- * LIST | NOLIST 00042000
- * NODECK | DECK 00043000
- * NOMCALL | MCALL 00044000
- * NOMLOGIC | MLOGIC 00045000
- * NORENT | RENT 00046000
- * NOTEST | TEST 00047000
- * NUMBER,NUM | NONUMBER,NONUM 00048000
- * OBJECT,OBJ | NOOBJECT,NOOBJ 00049000
- * RLD | NORLD 00050000
- * STMT | NOSTMT 00051000
- * SYSPARM () | SYSPARM (STRING) 00052000
- * TERMINAL,TERM | NOTERMIN,NOTERM 00053000
- * WORKSIZE (2048) | WORKSIZE (N) |WORKSIZE (NK) 00053100
- * XREF (FULL) | XREF (SHORT) | NOXREF 00054000
- * YFLAG | NOYFLAG 00054500
- * 00055000
- * XL8'FF' - FENCE 00056000
- * 00057000
- EJECT 00058000
- * 00059000
- * EXIT CONDITONS: 00060000
- * 00061000
- * NORMAL - 00062000
- * GPR15 = 0 NO ERROR 00063000
- * 00064000
- * ERROR - 00065000
- * GPR15 = 24 INVALID OPTION, NO FILENAME SPECIFIED 00066000
- * GPR15 = 28 FILE NOT FOUND 00067000
- * GPR15 = 32 FILE NOT FIXED 80 CHARS 00068000
- * GPR15 = 36 NO READ/WRITE DISKS ACCESSED 00069000
- * GPR15 = 40 FILEID CONFLICT,DEVICE ILLEGAL FOR INPUT 00070000
- * 00071000
- * CALLS TO OTHER ROUTINES: 00072000
- * 00073000
- * DMSCRD - READ SYSPARM FROM CONSOLE 00074000
- * DMSCWR - TYPE SYSPARM MESSAGE TO CONSOLE 00075000
- * DMSFLD - FILEDEF ALL ASSEMBLER FILES 00076000
- * DMSFNS - CLOSE ALL ASSEMBLER FILES 00077000
- * DMSKEY - CONTROL NUCLEUS PROTECT KEY 00078000
- * DMSERR - TYPE ALL ERROR MESSAGES 00079000
- * DMSERS - ERASE OLD ASSEMBLER FILES 00080000
- * DMSSLN - LOAD THE ASSEMBLER PHASES 00081000
- * DMSSMN - CONTROL STORAGE POINTERS (GETMAIN/FREEMAIN) 00082000
- * DMSSTT - VERIFY DISK FILE EXISTENCE 00083000
- * DMSLADAD - SET/RESET THE FST CHAIN FOR AUXILIARY 00084000
- * DIRECTORY. 00085000
- * IFOX00 - ASSEMBLER (XF) ROOT SEGMENT 00086000
- * 00087000
- * EXTERNAL REFERENCES: 00088000
- * 00089000
- * ADT 00090000
- * CMSCB 00091000
- * DMSASD 00092000
- * FSTB 00093000
- * IO 00094000
- * NUCON 00095000
- * 00096000
- * 00097000
- * TABLES/WORKAREAS: 00098000
- * 00099000
- * DDNAME - NAMES OF CMS DDNAMES FOR ASSEMBLER 00100000
- * OPTDEF - NAMES AND ABBREVIATIONS OF ALL OPTIONS 00101000
- * PARMLST - PARAMETER LIST FOR ASSEMBLER 00102000
- * UTENTRY - INCORE SYSUT1 RECORD AREA 00103000
- * UTHEAD - HEADER AREA FOR INCORE RECORDS 00104000
- * 00105000
- EJECT 00106000
- * 00107000
- * REGISTER USAGE: 00108000
- * 00109000
- * GPR0 = NUCON ADDRESSABILITY 00110000
- * GPR1 = ADDRESS OF ALL PLISTS 00111000
- * GPR2 = WORK REGISTER 00112000
- * GPR3 = WORK REGISTER 00113000
- * GPR4 = GETMAIN/FREEMAIN AMOUNT 00114000
- * GPR5 = WORK REGISTER 00115000
- * GPR6 = GETMAIN/FREEMAIN ADDRESS 00116000
- * GPR7 = ASMPROC BASE REGISTER 00117000
- * GPR8 = WORK REGISTER 00118000
- * GPR9 = WORK REGISTER 00119000
- * GPR10 = LINKAGE REGISTER 00120000
- * GPR11 = FCB ADDRESS DURING ASMPROC 00121000
- * GPR12 = DMSASM BASE REGISTER 00122000
- * GPR13 = SAVE AREA ADDRESS 00123000
- * GPR14 = RETURN REGISTER FROM CALLS 00124000
- * GPR15 = ASSEMBLER ROOT ADDR. AND ERROR CODE ON RETURN. 00125000
- * 00126000
- * NOTES - 00127000
- * 00128000
- * NONE 00129000
- * 00130000
- * OPERATION: 00131000
- * 00132000
- * ASSEMBLE FIRST SETS A BIT (COMPSWT,X'80') IN OSSFLAGS 00133000
- * TO INDICATE THE ASSEMBLER IS RUNNING, AND THEN CALLS 00134000
- * DMSLADAD TO MODIFY THE FILE STATUS TABLE (FST) CHAIN 00135000
- * TO INCLUDE A NUCLEUS COPY OF THE AUXILIARY DIRECTORY 00136000
- * FOR THE DISK SPECIFIED AT AUXILIARY GENERATION TIME. 00137000
- * IF THAT DISK IS NOT ACCESSED, PROCESSING TERMINATES 00138000
- * WITH AN ERROR CODE OF 40. 00139000
- * 00140000
- * ASSEMBLE NEXT SCANS THE OPTIONS SPECIFIED AND USES 00141000
- * THE INFORMATION THEREBY OBTAINED TO SET UP THE OPTION 00142000
- * LIST FOR THE ASSEMBLER AND THE FILEDEF PLISTS FOR THE 00143000
- * CALLS TO FILEDEF. 00144000
- * 00145000
- * ASSEMBLE THEN 00146000
- * CALLS STATE TO VERIFY THE EXISTENCE OF THIS FILE. IF 00147000
- * IT DOES NOT EXIST, ASSEMBLE VERIFIES THAT THE FILE 00148000
- * HAS BEEN FILEDEF'D TO ANOTHER VALID INPUT DEVICE, IF 00149000
- * NOT,THE ASSEMBLER ISSUES AN ERROR MESSAGE AND RETURNS 00150000
- * TO THE CALLER. IF THE FILE DOES EXIST IN DISK, THEN 00151000
- * ASSEMBLE CHECKS THE ITEM LENGTH, ISSUES AN ERROR 00152000
- * MESSAGE IF ITEM LENGTH IS INCORRECT AND RETURNS TO 00153000
- * THE CALLER. 00154000
- * 00155000
- * IF THE LENGTH IS CORRECT, ASSEMBLE CALLS ERASE TO 00156000
- * DELETE ANY EXISTING TEXT, LISTING, AND UTILITY FILES 00157000
- * FOR THE CURRENT ASSEMBLE FILE, AND SETS UP STORAGE BY 00158000
- * CALLING GETMAIN. 00159000
- * 00160000
- EJECT 00161000
- * 00162000
- * IT THEN CALLS ADTLKW TO OBTAIN THE MODE OF THE 00163000
- * READ-WRITE DISK WITH MOST AVAILABLE SPACE AND USES IT 00164000
- * TO SET UP THE FILEDEF PLIST FOR THE SYSUT'S FILES AND 00165000
- * CHECKS IF THE DISK WITH THE MOST SPACE IS THE SOURCE 00166000
- * DISK. IF IT IS DIFFERENT, THE SYSUT FILES ARE ERASED 00167000
- * FROM IT (SYSUT FILES ALREADY ERASED FROM SOURCE). IF 00168000
- * NOT SPECIFIED BY THE USER, THE TEXT AND LISTING FILES 00169000
- * ARE WRITTEN ON THE 1) DISK FROM WHICH THE ASSEMBLE 00170000
- * SOURCE IS READ; 2) ON THE "PARENT" DISK, IF THE 00171000
- * FIRST DISK IS A READ-ONLY EXTENSION; OR 3) THE 00172000
- * PRIMARY A-DISK. IF NONE OF THESE CHOICES IS 00173000
- * AVAILABLE, THE COMMAND WILL BE TERMINATED. CMS 00174000
- * CONTROL BLOCKS (CMSCB'S), WHICH REFLECT THE SELECTED 00175000
- * OPTION, ARE SET UP FOR THE TEXT, LISTING, ASSEMBLE & 00176000
- * UTILITY FILES. AFTER EACH SUCCESSFUL RETURN FROM 00177000
- * FILEDEF, ASSEMBLE SETS A CLEAR SWITCH TO INDICATE 00178000
- * WHICH CMSCB'S ARE TO BE CLEARED AT THE END OF 00179000
- * THE ASSEMBLY. ASSEMBLE FINALLY BRANCHES TO IFOX00. 00180000
- * 00181000
- * ON RETURN FROM THE ASSEMBLER, ASSEMBLE ERASES ALL THE 00182000
- * UTILITY FILES AND CLEARS THE CMSCBS WHICH IT HAD SET. 00183000
- * ASSEMBLE THEN CALLS FINIS TO CLOSE ALL FILES XF USED, 00184000
- * TURNS ON THE RELEASE PAGE BIT, CALLS DMSLADAD TO RESET 00185000
- * THE FST CHAIN MODIFIED EARLIER, CLEAR OSSFLAGS, PLACES 00186000
- * THE ERROR CODE IN REGISTER 15 AND RETURNS TO THE USER. 00187000
- * 00188000
- * 00189000
- * SPECIAL OUTPUT PROCESSING ROUTINE: ASMHAND 00190000
- * 00191000
- * THE SYSTEM ROUTINE SOEOB INTERFACES WITH ASMPROC 00192000
- * WHENEVER ANY I/O ACTIVITY PERTAINS TO THE SYSUT1 FILE 00193000
- * DURING THE ASSEMBLY. 00194000
- * 00195000
- * SYSUT1 - IF THE FILE IS BEING READ IN BY THE ASSMBLER 00196000
- * THEN ASMPROC ACCESSES THE UTILITY CONTROL TABLE TO 00197000
- * ASCERTAIN THE LENGTH AND LOCATION OF THE RECORDS TO 00198000
- * BE MOVED AND MOVES IT TO THE SPECIFIED INPUT BUFFER. 00199000
- * 00200000
- * IF THE FILE IS BEING WRITTEN BY THE (XF), THE UTILITY 00201000
- * CONTROL TABLE IS FIRST SET UP BY A CALL TO GETMAIN 00202000
- * AND THEN UPDATED TO REFLECT THE NUMBERS OF RECORDS TO 00203000
- * BE WRITTEN, THEN THE RECORD IS MOVED TO THE GETMAIN'D 00204000
- * AREA. 00205000
- * 00206000
- * 00207000
- *. 00208000
- EJECT 00209000
- MACRO 00210000
- OPTDEF 00211000
- LCLA &I,&J,&K,&N,&TEMP1,&TEMP2,&Q1,&Q2,&Q3,&Q4 00212000
- LCLA &TABLE1(200),&TABLE2(200) 00213000
- LCLB &FLAG1,&FLAG2 00214000
- LCLC &S 00215000
- ACTR 6000 00216000
- &I SETA 1 00217000
- OPTNULL DC AL2(0),8X'FF' 00218000
- SPACE 00219000
- .ILOOP ANOP 00220000
- &S SETC 'O&I.$' 00221000
- &FLAG1 SETB 0 00222000
- &N SETA 1 00223000
- &J SETA 0 00224000
- .NLOOP ANOP 00225000
- &K SETA 0 00226000
- AIF (N'&SYSLIST(&N) NE 1).XLOOP 00227000
- AIF (K'&SYSLIST(&N) NE &I).NL1 00228000
- AGO .CWO2 00229000
- .XLOOP ANOP 00230000
- &K SETA &K+1 00231000
- AIF (K'&SYSLIST(&N,&K) NE &I).CWO1 00232000
- .CWO2 ANOP 00233000
- &FLAG1 SETB 1 00234000
- &J SETA &J+1 00235000
- &TABLE1(&J) SETA &N 00236000
- &TABLE2(&J) SETA &K 00237000
- .CWO1 AIF ((&K NE 0) AND (&K LT N'&SYSLIST(&N))).XLOOP 00238000
- .NL1 ANOP 00239000
- &N SETA &N+2 00240000
- AIF (&N LE N'&SYSLIST).NLOOP 00241000
- AIF (NOT &FLAG1).NL2 00242000
- AIF (&J EQ 1).SORTDNE 00243000
- &N SETA &J+1 00244000
- .SORT1 ANOP 00245000
- &FLAG2 SETB 0 00246000
- &K SETA 1 00247000
- &N SETA &N-1 00248000
- .SORT2 ANOP 00249000
- &Q1 SETA &TABLE1(&K) 00250000
- &Q2 SETA &TABLE1(&K+1) 00251000
- &Q3 SETA &TABLE2(&K) 00252000
- &Q4 SETA &TABLE2(&K+1) 00253000
- AIF ((&Q3 EQ 0) AND (&Q4 EQ 0)).SORT4 00254000
- AIF (&Q3 EQ 0).SORT5 00255000
- AIF (&Q4 EQ 0).SORT6 00256000
- AIF ('&SYSLIST(&Q1,&Q3)' LE '&SYSLIST(&Q2,&Q4)').NEXT 00257000
- AGO .SORT3 00258000
- .SORT5 AIF ('&SYSLIST(&Q1)' LE '&SYSLIST(&Q2,&Q4)').NEXT 00259000
- AGO .SORT3 00260000
- .SORT6 AIF ('&SYSLIST(&Q1,&Q3)' LE '&SYSLIST(&Q2)').NEXT 00261000
- AGO .SORT3 00262000
- .SORT4 AIF ('&SYSLIST(&Q1)' LE '&SYSLIST(&Q2)').NEXT 00263000
- .SORT3 ANOP 00264000
- &FLAG2 SETB 1 00265000
- &TEMP1 SETA &TABLE1(&K) 00266000
- &TEMP2 SETA &TABLE2(&K) 00267000
- &TABLE1(&K) SETA &TABLE1(&K+1) 00268000
- &TABLE2(&K) SETA &TABLE2(&K+1) 00269000
- &TABLE1(&K+1) SETA &TEMP1 00270000
- &TABLE2(&K+1) SETA &TEMP2 00271000
- .NEXT ANOP 00272000
- &K SETA &K+1 00273000
- AIF (&K LT &N).SORT2 00274000
- AIF (&FLAG2).SORT1 00275000
- .SORTDNE ANOP 00276000
- &K SETA 1 00277000
- .OLOOP ANOP 00278000
- &Q1 SETA &TABLE1(&K)+1 00279000
- &Q2 SETA &TABLE1(&K) 00280000
- &Q3 SETA &TABLE2(&K) 00281000
- AIF ('&SYSLIST(&Q1)' EQ '').NL4 00282000
- AIF (N'&SYSLIST(&Q1) EQ 1).NL5 00283000
- AIF (&Q3 NE 0).NL8 00284000
- AIF ('&SYSLIST(&Q1,1)' EQ '').NL10 00285000
- &S DC AL1(&SYSLIST(&Q1,1)),AL1(&SYSLIST(&Q1,2)),CL&I'&SYSLIST(*00286000
- &Q2)' 00287000
- AGO .NL6 00288000
- .NL10 ANOP 00289000
- &S DC AL1(0),AL1(&SYSLIST(&Q1,2)),CL&I'&SYSLIST(&Q2)' 00290000
- AGO .NL6 00291000
- .NL8 ANOP 00292000
- AIF ('&SYSLIST(&Q1,1)' EQ '').NL11 00293000
- &S DC AL1(&SYSLIST(&Q1,1)),AL1(&SYSLIST(&Q1,2)),CL&I'&SYSLIST(*00294000
- &Q2,&Q3)' 00295000
- AGO .NL6 00296000
- .NL11 ANOP 00297000
- &S DC AL1(0),AL1(&SYSLIST(&Q1,2)),CL&I'&SYSLIST(&Q2,&Q3)' 00298000
- AGO .NL6 00299000
- .NL5 ANOP 00300000
- AIF (&Q3 NE 0).NL9 00301000
- &S DC AL1(&SYSLIST(&Q1)),AL1(0),CL&I'&SYSLIST(&Q2)' 00302000
- AGO .NL6 00303000
- .NL9 ANOP 00304000
- &S DC AL1(&SYSLIST(&Q1)),AL1(0),CL&I'&SYSLIST(&Q2,&Q3)' 00305000
- AGO .NL6 00306000
- .NL4 ANOP 00307000
- AIF (&Q3 NE 0).NL7 00308000
- &S DC AL2(0),CL&I'&SYSLIST(&Q2)' 00309000
- AGO .NL6 00310000
- .NL7 ANOP 00311000
- &S DC AL2(0),CL&I'&SYSLIST(&Q2,&Q3)' 00312000
- .NL6 ANOP 00313000
- &S SETC '' 00314000
- &K SETA &K+1 00315000
- AIF (&K LE &J).OLOOP 00316000
- DC AL2(0),&I.X'FF' 00317000
- AGO .NL3 00318000
- .NL2 ANOP 00319000
- &S EQU OPTNULL 00320000
- .NL3 ANOP 00321000
- SPACE 3 00322000
- &I SETA &I+1 00323000
- AIF (&I LE 8).ILOOP 00324000
- MEND 00325000
- EJECT 00326000
- DMSASM CSECT @V201201 00327000
- USING NUCON,R0 NUCON ADDRESSABILITY @V201201 00328000
- USING DMSASM,R12,R11 ASMXF ADDRESSABILITY @V201201 00329000
- * 00330000
- LR R12,R15 USE REG 12 AS BASE REG @V201201 00331000
- LA R11,2048(,R12) USE REG 11 AS 2ND. BASE REG @V201201 00332000
- LA R11,2048(,R11) ... @V201201 00333000
- ST R14,SAVREG14 SAVE RETURN REGISTER @V201201 00334000
- * 00335000
- LA R1,8(,R1) POINT TO THE FNAME IN COMBUF @V201201 00336000
- CLI 0(R1),STAR VALID FILENAME ? @V201201 00337000
- BE ERR70 NO..ERROR @V201201 00338000
- ST R1,FILEPTR SAVE THIS ADDR IN FILEPTR @V201201 00339000
- * 00340000
- DMSKEY NUCLEUS DISABLE NUCLEUS PROTECT @V201201 00341000
- * 00342000
- OI OSSFLAGS,COMPSWT INDICATE ASSEMBLER RUNNING @V201201 00343000
- LA R1,SETAUX SET PLIST FOR AUX CALL @V201201 00344000
- SVC 202 ... @V201201 00345000
- DC AL4(ERR74E1) ERROR EXIT @V201201 00346000
- L R1,FILEPTR RESTORE FILENAME ADDR. @V201201 00347000
- MVC DOSF,DOSFLAGS SAVE DOSFLAGS TEMPORARILY @VM03272 00347100
- NI DOSFLAGS,255-DOSSVC DISABLE DOSSVC FOR A WHILE @VM03272 00347200
- * 00348000
- DMSKEY RESET ENABLE NUCLEUS PROTECT @V201201 00349000
- * 00350000
- EJECT 00351000
- * 00352000
- ********************************************************************** 00353000
- * 00354000
- * THE TYPED INPUT LINE, INVOKING THE ASSEM XF PROCESSOR IS DECODED, 00355000
- * CONTROLLED (ERROR MESSAGES ARE ISSUED), AND THE DIFFERENT CLASSES 00356000
- * OF PARAMETERS ARE STORED IN THE ADEQUATE STORAGE AREAS. 00357000
- * 00358000
- ********************************************************************** 00359000
- * 00360000
- OPTSCN EQU * @V201201 00361000
- CLI 0(R1),HXFF IS THIS END OF LINE @V201201 00362000
- BE ERR1 YES..NO FILENAME OR ANYTHING @V201201 00363000
- CLI 0(R1),LEFTPAR IS THIS A LEFT PARENS @V201201 00364000
- BE ERR1 YES..NO FILENAME SPECIFIED @V201201 00365000
- LA R1,8(,R1) INCREMENT PAST FILENAME @V201201 00366000
- CLI 0(R1),HXFF END OF SCANNED LINE ? @V201201 00367000
- BE OPTEND ... @V201201 00368000
- CLI 0(R1),LEFTPAR START OF OPTION LIST ? @V201201 00369000
- BNE ERR70 MUST BE INVALID PARAMETER @V201201 00370000
- LA R1,8(,R1) SKIP PAST LEFT PAREN @V201201 00371000
- NXTOPTN EQU * @V201201 00372000
- BAL R14,KEYSCN SCAN OFF KEYWORD @V201201 00373000
- B OPTEND END OF SCANNED LINE @V201201 00374000
- LR R3,R2 GET KEYWORD LENGTH @V201201 00375000
- SLL R3,2 GET 4*LENGTH @V201201 00376000
- L R3,OPTAB$-4(R3) GET TABLE @V201201 00377000
- BCTR R2,0 GET LENGTH-1 @V201201 00378000
- SEEKARG EQU * @V201201 00379000
- EX R2,KEYCOMP COMPARE FOR KEYWORD @V201201 00380000
- BE FOUND EQUAL..KEYWORD FOUND @V201201 00381000
- BH NOTFOUND KEYWORD HAS BEEN PASSED @V201201 00382000
- LA R3,3(R3,R2) SKIP TO NEXT ENTRY IN TABLE @V201201 00383000
- B SEEKARG LOOP THROUGH TABLE @V201201 00384000
- FOUND EQU * @V201201 00385000
- TM 0(R3),HXFF IS THERE AN OPTION BIT? @V201201 00386000
- BZ NOBITS NO @V201201 00387000
- IC R4,0(,R3) GET OPTION BIT @V201201 00388000
- EX R4,OROPT 'OR' IN OPTION BIT @V201201 00389000
- TM 1(R3),HXFF IS THERE A BYTE TO 'NI' @V201201 00390000
- BZ NOBITS NO @V201201 00391000
- IC R4,1(,R3) GET SECOND OPTION BYTE @V201201 00392000
- EX R4,NIOPT 'NI' SECOND OPTION BYTE @V201201 00393000
- B GETNEXT BRANCH..THIS IS A CMS OPT. @V201201 00394000
- EJECT 00395000
- * 00396000
- NOBITS EQU * @V201201 00397000
- CLC 0(5,R6),NOOBJ IS THIS OPTION NOOBJ(ECT)? @VA13257 00397500
- BNE NOBITSC NO, CONTINUE @VA13257 00397550
- OI ASMSWA,NOOBJECT YES @VA13257 00397600
- NOBITSC EQU * 00397650
- LH R4,OPTLIST GET CURRENT OPTION LIST LEN @V201201 00398000
- LA R5,OPTBYTES(R4) GET END OF OPTIONS @V201201 00399000
- MVI 0(R5),COMMA MOVE COMMA AFTER LAST OPTION @V201201 00400000
- LA R4,1(,R4) BUMP COUNT @V201201 00401000
- LA R5,1(,R5) AND POINTER @V201201 00402000
- BAL R10,MOVEKEY MOVE OPTION TO LIST @V201201 00403000
- TM ASMSW,PARENS MAY OPTION HAVE PARENS ? @V201201 00404000
- BZ RESTCNT NO @V201201 00405000
- CLI 8(R6),LEFTPAR THIS THE LEFT PAREN ? @V201201 00406000
- BE INSRTLFT YES @V201201 00407000
- NI ASMSW,255-PARENS-NUMERIC-SYSPARM-LINEC-XREF ... @V201201 00408000
- BAL R10,ERR3 INVALID OPTION ERROR @V201201 00409000
- B GETNEXT KEEP SCANNING.. @V201201 00410000
- * 00411000
- MOVEKEY EQU * @V201201 00412000
- LA R4,1(R4,R2) LIST LENGTH PLUS NEW COUNT @V201201 00413000
- CL R4,HX100 EXCEEDS MAX OF 100 CHARS ? @V201201 00414000
- BH ERR52 YES..ERROR @V201201 00415000
- EX R2,KEYMOVE MOVE KEYWORD TO OPTION LIST @V201201 00416000
- LA R5,1(R5,R2) BUMP OPTION LIST POINTER @V201201 00417000
- BR R10 RETURN TO CALLER @V201201 00418000
- EJECT 00419000
- * 00420000
- INSRTLFT EQU * @V201201 00421000
- TM ASMSW,LINEC LINECOUNT OPTION ? @V201201 00422000
- BZ MVELPAR NO..JUST MOVE LEFT PAR @V201201 00423000
- MVI 0(R5),C'T' MOVE T TO LINECOUN @V201201 00424000
- LA R4,1(,R4) BUMP COUNT @V201201 00425000
- LA R5,1(,R5) AND POINTER @V201201 00426000
- MVELPAR MVI 0(R5),LEFTPAR MOVE A LEFT PAR TO LIST @V201201 00427000
- LA R4,1(,R4) BUMP COUNT @V201201 00428000
- LA R5,1(,R5) AND POINTER @V201201 00429000
- LA R1,16(,R6) SKIP TO NEXT PART OF OPTION @V201201 00430000
- BAL R14,KEYSCN SCAN OFF KEYWORD @V201201 00431000
- BAL R10,ERR3B END OF OPTION NO LIST FOUND @V201201 00432000
- TM ASMSW,SYSPARM PROCESSING SYSPARM OPTION ? @V201201 00433000
- BO TSTKWRD YES..SEE IF CON INPUT REQ. @V201201 00434000
- MVEKWRD EQU * @V201201 00435000
- BCTR R2,0 GET LENGTH-1 @V201201 00436000
- BAL R10,MOVEKEY MOVE KEYWORD TO LIST @V201201 00437000
- TM ASMSW,NUMERIC IS SUBOPTION NUMERIC ? @V201201 00438000
- BO TESTNUM YES..TEST VALIDITY @V201201 00439000
- B TESTSUB TEST SUBOPTION VALIDITY @V201201 00440000
- TSTRPAR EQU * @V201201 00441000
- LA R6,8(,R6) POINT TO NEXT TOKEN @V201201 00442000
- CLI 0(R6),HXFF IS IT END OF INPUT LINE ? @V201201 00443000
- BE SUBCLEAN YES..CLEAN SUBOPTION @V201201 00444000
- CLI 0(R6),RIGHTPAR NEXT A RIGHT PARENS ? @V201201 00445000
- BNE NOTFOUND NO..INVALID OPTION @V201201 00446000
- SUBOPTEN EQU * @V201201 00447000
- MVI 0(R5),RIGHTPAR MOVE RIGHT PARENS TO LIST @V201201 00448000
- LA R4,1(,R4) BUMP COUNT @V201201 00449000
- LA R5,1(,R5) AND POINTER @V201201 00450000
- RESTCNT EQU * @V201201 00451000
- NI ASMSW,255-PARENS-NUMERIC-SYSPARM-LINEC-XREF ... @V201201 00452000
- STH R4,OPTLIST RESTORE COUNT IN OPTION LIST @V201201 00453000
- GETNEXT EQU * @V201201 00454000
- LA R1,8(,R6) SKIP TO NEXT OPTION @V201201 00455000
- B NXTOPTN ... @V201201 00456000
- NOTFOUND EQU * @V201201 00457000
- BAL R10,ERR3 GIVE INVALID OPTION MSG @V201201 00458000
- B GETNEXT CONTINUE OPTION SCAN @V201201 00459000
- EJECT 00460000
- * 00461000
- TESTNUM EQU * @V201201 00462000
- LA R2,1(,R2) GET REAL LENGTH OF SUBOPTION @V201201 00463000
- LR R7,R6 USE R7 INSTEAD OF R6 @V201201 00464000
- CH R2,H3 EXCEEDS MAX SUB LENGTH ? @V201201 00465000
- BH NOTNUM YES..GIVE ERROR @V201201 00466000
- TM ASMSW,LINEC LINECOUNT OPTION ? @V201201 00467000
- BZ NUMLOOP NO..BRANCH @V201201 00468000
- * CH R2,H2 MAX LINECOUNT LENGTH ? @VA08638 00469000
- * BH NOTNUM YES..GIVE ERROR @VA08638 00470000
- NUMLOOP EQU * @V201201 00471000
- TM 0(R7),X'F0' IS CHARACTER NUMERIC @V201201 00472000
- BNO NOTNUM NO..NO MORE..ERROR @V201201 00473000
- LA R7,1(,R7) GET NEXT CHARACTER @V201201 00474000
- BCT R2,NUMLOOP LOOP TO TEST NEXT CHARACTER @V201201 00475000
- B TSTRPAR THAT IS IT..GO BACK @V201201 00476000
- NOTNUM EQU * @V201201 00477000
- BAL R10,ERR3 GIVE INVALID OPTION MSG @V201201 00478000
- B TSTRPAR CONTINUE OPTION SCAN @V201201 00479000
- * 00480000
- TESTSUB TM ASMSW,SYSPARM SYSPARM OPTION ? @V201201 00481000
- BO TSTRPAR YES..DON'T SUB CHECK @V201201 00482000
- TM ASMSW,XREF XREF OPTION ? @V201201 00483000
- BO XREFSUB YES..CHECK XREF SUBOPT. @V201201 00484000
- CH R2,H2 CHECKING POSS LEN OF SUB @V201201 00485000
- BNE NOTNUM ERROR IF NOT EQUAL @V201201 00486000
- LA R7,MIN GET 1ST. SUBOPTION @V201201 00487000
- EX R2,SUBCOMP COMPARE WITH FOUND @V201201 00488000
- BE TSTRPAR MATCH..BRANCH @V201201 00489000
- LA R7,STD GET 2ND. SUBOPTION @V201201 00490000
- EX R2,SUBCOMP COMPARE WITH FOUND @V201201 00491000
- BE TSTRPAR MATCH..BRANCH @V201201 00492000
- LA R7,MAX GET THIRD SUBOPTION @VA07914 00492100
- EX R2,SUBCOMP COMPARE WITH GIVEN @VA07914 00492200
- BE TSTRPAR MATCH ... BRANCH @VA07914 00492300
- B NOTNUM IF NONE..ERROR @V201201 00493000
- XREFSUB LA R7,FULL GET 1ST. SUBOPTION @V201201 00494000
- CH R2,H3 CHECKING POSS LEN OF SUB @V201201 00495000
- BL NOTNUM ERROR IF LOW @V201201 00496000
- EX R2,SUBCOMP COMPARE WITH FOUND @V201201 00497000
- BE TSTRPAR MATCH..BRANCH @V201201 00498000
- LA R7,SHORT GET 2ND. SUBOPTION @V201201 00499000
- CH R2,H4 CHECKING POSS LEN OF SUB @V201201 00500000
- BL NOTNUM ERROR IF LOW @V201201 00501000
- EX R2,SUBCOMP COMPARE WITH FOUND @V201201 00502000
- BE TSTRPAR MATCH..BRANCH @V201201 00503000
- B NOTNUM IF NONE..ERROR @V201201 00504000
- EJECT 00505000
- * 00506000
- TSTKWRD EQU * @V201201 00507000
- CLC 0(2,R6),=C'? ' KEYWORD FROM CONSOLE ? @V201201 00508000
- BNE MVEKWRD NO..USE KEYWORD FOUND @V201201 00509000
- * 00510000
- LA R1,CONWR ASK FOR SYSPARM SUBOPTION @V201201 00511000
- SVC 202 ... @V201201 00512000
- DC AL4(MVEKWRD) BAD RETURN..USE FOUND KWRD @V201201 00513000
- * 00514000
- LA R1,CMNDLINE GET CONSOLE BUFFER ADDR. @V201201 00515000
- STCM R1,B'0111',CONBUF+1 STORE IN LIST @V201201 00516000
- LA R1,CONRD READY TO RECEIVE @V201201 00517000
- SVC 202 ... @V201201 00518000
- DC AL4(MVEKWRD) BAD RETURN..USE FOUND KWRD @V201201 00519000
- * 00520000
- LH R2,CONCNT+2 GET BYTES READ @V201201 00521000
- LTR R2,R2 ... @V201201 00522000
- BZ TSTRPAR IF ZERO..NULL PARM @V201201 00523000
- LR R1,R6 SAVE REG. 6 @V201201 00524000
- ICM R6,B'0111',CONBUF+1 GET BUFFER ADDRESS @V201201 00525000
- BCTR R2,0 GET LENGTH-1 @V201201 00526000
- CHKBLNK LA R10,0(R6,R2) GET END OF BUFFER ADDR @V201201 00527000
- CLI 0(R10),BLANK IS CHAR. BLANK ? @V201201 00528000
- BNE MOVESUB NO..MUST BE END @V201201 00529000
- LTR R2,R2 SEE IF ITS START OF INPUT @VA12246 00529300
- BZ RESTOSIX YES, ALL BLNK, TREAT AS NULL @VA12246 00529600
- BCT R2,CHKBLNK KEEP LOOKING FOR NON-BLANK @V201201 00530000
- MOVESUB BAL R10,MOVEKEY MOVE SUBLIST TO OPTION LIST @V201201 00531000
- RESTOSIX LR R6,R1 RESTORE REG. 6 @VA12246 00532000
- B TSTRPAR CONTINUE PROCESSING @V201201 00533000
- * 00534000
- * 00535000
- SUBCOMP CLC 0(0,R6),0(R7) EXECUTED COMPARE @V201201 00536000
- KEYCOMP CLC 2(0,R3),0(R6) EXECUTED COMPARE @V201201 00537000
- KEYMOVE MVC 0(0,R5),0(R6) EXECUTED MOVE @V201201 00538000
- OROPT OI ASMSW,0 EXECUTED OR @V201201 00539000
- NIOPT NI ASMSW,0 EXECUTED AND @V201201 00540000
- * 00541000
- * 00542000
- EJECT 00543000
- KEYSCN EQU * @V201201 00544000
- LR R6,R1 GET KEYWORD START @V201201 00545000
- LA R2,8(,R1) GET END OF MAX KEYWORD @V201201 00546000
- CLI 0(R1),RIGHTPAR RIGHT PAREN? @V201201 00547000
- BCR 8,R14 YES, RETURN @V201201 00548000
- CLI 0(R1),HXFF AT END OF PARAM. LIST? @V201201 00549000
- BE SUBCLEAN YES, GO CLEAN UP SUBOPTION @V201201 00550000
- EOPNSCN EQU * @V201201 00551000
- CLI 0(R1),BLANK BLANK? @V201201 00552000
- BE KEYEND YES @V201201 00553000
- CR R1,R2 END OF OPTION @V201201 00554000
- BE KEYEND YES @V201201 00555000
- LA R1,1(,R1) BUMP POINTER AND @V201201 00556000
- B EOPNSCN LOOP THROUGH OPTION @V201201 00557000
- KEYEND EQU * @V201201 00558000
- LR R2,R1 GET END OF OPTION @V201201 00559000
- SR R2,R6 GET LENGTH @V201201 00560000
- BC 2,4(,R14) RETURN IF > ZERO @V201201 00561000
- LA R2,1 SET TO LENGHT OF ONE @V201201 00562000
- B 4(,R14) AND RETURN @V201201 00563000
- SUBCLEAN EQU * @V201201 00564000
- TM ASMSW,PARENS ARE WE PROCESSING SUBS ? @V201201 00565000
- BCR 8,R14 NO, GO TO OPTEND @V201201 00566000
- NI ASMSW,255-PARENS-NUMERIC-SYSPARM-LINEC-XREF ... @V201201 00567000
- MVI 0(R5),RIGHTPAR MAKE SURE SUBS ARE ENCLOSED @V201201 00568000
- LA R4,1(,R4) INCREMENT LIST LENGHT @V201201 00569000
- STH R4,OPTLIST STORE IT @V201201 00570000
- OPTEND EQU * @V201201 00571000
- TM ASMSW2,OPTERR HAVE WE HAD ANY INVALID OPT @V201201 00572000
- BO END YES..RETURN TO CMS @V201201 00573000
- EJECT 00574000
- * 00575000
- ********************************************************************** 00576000
- * 00577000
- * ASSUME 'ALPHA' IS A FILE TO COMPILE.WE CHECK THAT 'ALPHA ASSEMBLE' 00578000
- * EXISTS AND GETS LOGICAL RECORDS OF 80 BYTES.IF THIS IS THE CASE, 00579000
- * LET US CALL 'M' THE MODE OF THIS FILE,WE ERASE THE TWO FILES,IF 00580000
- * THEY EXIST,'ALPHA LISTING M' AND 'ALPHA TEXT M'. 00581000
- * 00582000
- ********************************************************************** 00583000
- * 00584000
- VERIFY EQU * @V201201 00585000
- USING ADTSECT,R1 @V201201 00586000
- USING FCBSECT,R6 @V201201 00587000
- USING FSTSECT,R7 @V201201 00588000
- * 00589000
- L R3,FILEPTR GET FILENAME ADDRESS @V201201 00590000
- STATASM MVC STATNAME(8),0(R3) MOVE THE FNAME FOR STATE @V201201 00591000
- LH R7,FCBNUM GET NUMBER OF FCB'S. @VA14534 00591060
- LTR R7,R7 ARE THERE ANY? @VA14534 00591120
- BZ DOASTATE NO, GO DO THE STATE. @VA14534 00591180
- L R6,FCBFIRST GET THE FIRST ONE. @VA14534 00591240
- CHKNAME EQU * @VA14534 00591300
- CLC DDASSEM,FCBDD IS IT FOR ASSEMBLE DD? @VA14534 00591360
- BNE NOMATCH NO, SKIP CHECKING FN. @VA14534 00591420
- CLC STATNAME,FCBDSNAM SEE IF IT MATCHES THIS FILE. @VA14534 00591480
- BNE NOMATCH NO, SKIP SETTING FM. @VA14534 00591540
- MVC STATMODE,FCBDSMD YES, SET FM FOR STATE. @VA14534 00591600
- B DOASTATE GO AND DO THE STATE. @VA14534 00591660
- NOMATCH EQU * @VA14534 00591720
- L R6,0(,R6) GET POINTER TO NEXT FCB. @VA14534 00591780
- BCT R7,CHKNAME KEEP LOOKING UNTIL NO MORE. @VA14534 00591840
- DOASTATE EQU * @VA14534 00591900
- LA R1,STATELST GET THE ADDR OF STATE LIST @V201201 00592000
- SVC 202 ISSUE STATE @V201201 00593000
- DC AL4(NOFILE) FILE NOT FOUND EXIT @V201201 00594000
- L R7,STATCOPY GET THE ADDR OF THE FST COPY @V201201 00595000
- MVC ADTCOPY(4),FSTL(R7) SAVE THE ADDR OF ADT @V201201 00596000
- * 00597000
- MVC INPTMODE(2),FSTM GET THE DISK MODE @V201201 00598000
- CLC FSTIL(4),HX80 ARE THE RECS 80 CHAR. LONG ? @V201201 00599000
- BNE ERR7 NO...GIVE ERROR @V201201 00600000
- CLI FSTFV,C'F' ARE THE RECS OF FIXED FORM ? @V201201 00601000
- BNE ERR7 NO...GIVE ERROR @V201201 00602000
- B DOFDEF FILEDEF THE ASSEMBLE DDNAME @V201201 00603000
- * 00604000
- EJECT 00605000
- * 00606000
- NOFILE OI ASMSW2,NOTFND IF NOT FOUND, SET SWITCH @V201201 00607000
- CH R15,H20 INVALID FILEID FOUND ? @V201201 00608000
- BNE DOFDEF NO..BRANCH @V201201 00609000
- ST R15,CC SAVE ERROR CODE @V201201 00610000
- B END GET OUT..ERROR MSG TYPED @V201201 00611000
- DOFDEF LA R1,INPTDEF GET ASSEMBLE FILEDEF LIST @V201201 00612000
- MVC INPTNAME(8),0(R3) GET FILENAME FOR THE FILEDEF @V201201 00613000
- BAL R10,SVC202 ISSUE FILEDEF @V201201 00614000
- LTR R6,R0 TEST IF FILE OLD OR NEW @V201201 00615000
- BM NEWFILE BRANCH IF FILE IS NEW @V201201 00616000
- CLI FCBDEV,FCBDSK IS DEVICE DSK IN USER FCB? @V201201 00617000
- BNE NOTDSK BRANCH IF NOT DISK @V201201 00618000
- CLC FCBDSNAM(16),INPTNAME MATCHING FILEID'S ? @V201201 00619000
- BNE ERR38 NO..CONFLICTING ID ERROR @V201201 00620000
- B NEWFILE SEE IF FILE FOUND BY STATE @V201201 00621000
- * 00622000
- NOTDSK TM ASMSW2,NOTFND IS THERE DUP FILE ON DSK ? @V201201 00623000
- BZ ERR38 YES..CONFLICTING ID ERROR @V201201 00624000
- CLI FCBDEV,FCBRDR IS INPUT FILE ON READER ? @V201201 00625000
- BE CHKADSK YES...USE IT @V201201 00626000
- CLI FCBDEV,FCBTAP IS THE INPUT FILE ON TAPE? @V201201 00627000
- BE CHKADSK YES...USE IT @V201201 00628000
- * 00629000
- SR R2,R2 READY... @V201201 00630000
- IC R2,FCBDEV GET DEVICE CODE @V201201 00631000
- L R2,DEVTYPE(R2) GET DEVICE TYPE @V201201 00632000
- B ERR75 GIVE ERROR @V201201 00633000
- * 00634000
- DEVTYPE DC A(DUMMY) ... @V201201 00635000
- DC A(PRINTER) ... @V201201 00636000
- DC A(0) ... @V201201 00637000
- DC A(TERMINAL) ... @V201201 00638000
- DC A(0) ... @V201201 00639000
- DC A(0) ... @V201201 00640000
- DC A(PUNCH) ... @V201201 00641000
- DC A(CRT) ... @V201201 00642000
- * 00643000
- NEWFILE TM ASMSW2,NOTFND IS THE INPUT FILE ON DISK ? @V201201 00644000
- BO ERR2 NO...GIVE ERROR @V201201 00645000
- EJECT 00646000
- * 00647000
- ********************************************************************** 00648000
- * 00649000
- * FIND A R/W DISK FOR WRITING THE TEXT AND THE LISTING FILE ... 00650000
- * 00651000
- ********************************************************************** 00652000
- * 00653000
- FINDRW EQU * @V201201 00654000
- L R1,ADTCOPY GET A(ADT) FROM SAVED COPY @V201201 00655000
- * 00656000
- TM ADTFLG1,ADTFRW INPUT FILE ON R/W DISK ? @V201201 00657000
- BO USEIT YES...WRITE BACK TO IT @V201201 00658000
- CLI ADTMX,BLANK IS IT AN EXTENSION? @V201201 00659000
- BE CHKADSK NO...CHECK A-DISK FOR R/W @V201201 00660000
- MVC ADTPARM(1),ADTMX SAVE THE EXTENSION FILE MODE @V201201 00661000
- LA R1,ADTPARM-24 GET THE LIST FOR ADTLKW @V201201 00662000
- L R15,AADTLKW GET THE ADDRESS OF ADTLKW @V201201 00663000
- BALR R14,R15 CALL ADTLKW FOR PARENT DISK @V201201 00664000
- BC 2,CHKADSK IF NONE FOUND..CHECK A-DISK @V201201 00665000
- USEIT MVC WMODE(1),ADTM SAVE THE FOUND DISK MODE @V201201 00666000
- B ERASE GO ERASE OLD FILES.. @V201201 00667000
- * 00668000
- CHKADSK LA R1,WMODE-24 GET A-DISK LIST @V201201 00669000
- L R15,AADTLKW GET ADDRESS OF ADTLKW @V201201 00670000
- BALR R14,R15 GET ADT FOR A-DISK @V201201 00671000
- BC 2,ERR6 NO A-DISK..ERROR @V201201 00672000
- TM ADTFLG1,ADTFRW IS IT R/W DISK ? @V201201 00673000
- BZ ERR6 NO..THAT IS ALL THEN... @V201201 00674000
- * 00675000
- ERASE EQU * @V201201 00676000
- LA R10,FILEDEF AFTER ERASE GO TO FILEDEF @V201201 00677000
- MVC ERASNAME(8),0(R3) SET FILENAME IN ERASE LIST @V201201 00678000
- MVC ERASMODE(2),WMODE SET FILEMODE IN ERASE LIST @V201201 00679000
- LA R1,ERASELST GET ADDRESS OF ERASE LIST @V201201 00680000
- LA R8,8 GET TOKEN LENGTH FOR BXLE @V201201 00681000
- LA R9,DDTERM GET ENDING ADDRESS @V201201 00682000
- LA R7,DDLIST GET BEGINNING ADDRESS @V201201 00683000
- * 00684000
- ERASLUP MVC ERASTYPE(8),0(R7) MOVE FILETYPE TO BE ERASED @V201201 00685000
- SVC 202 ISSUE ERASE @V201201 00686000
- DC AL4(*+4) NO-OP IN CASE NO FILE EXISTS @V201201 00687000
- BXLE R7,R8,ERASLUP LOOP TILL ALL FILES ERASED @V201201 00688000
- BR R10 RETURN TO CALLER @V201201 00689000
- EJECT 00690000
- * 00691000
- ********************************************************************** 00692000
- * 00693000
- * FILEDEF(S) ARE ISSUED FOR EACH OUTPUT FILE THAT THE ASSEMBLR XF 00694000
- * PROCESSOR MAY USE. THE ROOT MODULE IFOX00 IS LOADED INTO CORE 00695000
- * AND THE PARAMTER LISTS ARE PASSED TO THE PROCESSOR. 00696000
- * 00697000
- ********************************************************************** 00698000
- * 00699000
- FILEDEF EQU * @V201201 00700000
- LH R4,WMODE GET FILEMODE FOR FILEDEFS @V201201 00701000
- MVC TEXTNAME(8),0(R3) SAVE FNAME IN TEXT FDEF @V201201 00702000
- STH R4,TEXTMODE SAVE FMODE IN TEXT FDEF @V201201 00703000
- MVC LISTNAME(8),0(R3) SAVE FNAME IN LISTING FDEF @V201201 00704000
- STH R4,LISTMODE SAVE FMODE IN LISTING FDEF @V201201 00705000
- * 00706000
- LA R1,TEXTDEF GET ADDR OF TEXT FDEF LIST @V201201 00707000
- BAL R10,SVC202 ISSUE FILEDEF @V201201 00708000
- * 00709000
- LA R1,PUNFDEF GET ADDR OF PUNCH FDEF LIST @V201201 00710000
- BAL R10,SVC202 ISSUE FILEDEF @V201201 00711000
- * 00712000
- LA R1,SYSTERM GET ADD OF SYSTERM FDEF LIST @V201201 00713000
- BAL R10,SVC202 ISSUE FILEDEF @V201201 00714000
- * 00715000
- LA R1,LISTDEF GET ADDR OF LSTING FDEF LIST @V201201 00716000
- TM ASMSW,NOPRINT WAS NOPRINT SPECIFIED? @V201201 00717000
- BZ LIST1 NO...GO TO TEST FOR PRINT @V201201 00718000
- MVC LISTDEV(8),DUMMY MOVE DUMMY AS LISTING DEV @V201201 00719000
- B LIST2 BRANCH TO ISSUE FILEDEF @V201201 00720000
- * 00721000
- LIST1 TM ASMSW,PRINT WAS PRINT SPECIFIED? @V201201 00722000
- BZ DOSVC NO...GO TO ISSUE FILEDEF @V201201 00723000
- MVC LISTDEV(8),PRINTER MOVE PRINTER AS LISTING DEV @V201201 00724000
- LIST2 MVC LISTNAME(24),OVER OVERLAY THE FILEID @V201201 00725000
- * 00726000
- DOSVC BAL R10,SVC202 ISSUE FILEDEF @V201201 00727000
- * 00728000
- L R15,AADTLKW SET UP CALL TO ADTLKW @V201201 00729000
- MVC ADTPARM,=C'??' TO FIND DISK WITH MOST AVAIL @V201201 00730000
- LA R1,ADTPARM-24 SPACE TO USE FOR THE UTILITY @V201201 00731000
- BALR R14,R15 FILES... @V201201 00732000
- * 00733000
- MVC UTSFMODE(1),ADTM MODE OF MOST AVAIL SPACE DSK @V201201 00734000
- EJECT 00735000
- * 00736000
- CLC UTSFMODE(1),WMODE IS DISK SAME AS INPUT DISK? @V201201 00737000
- BE NOERASE IF SO, SYSUTS ALREADY ERASED @V201201 00738000
- MVC ERASMODE(2),UTSFMODE MOVE FMODE TO ERASE PLIST @V201201 00739000
- BAL R10,ERASUTS ERASE SYSUT FILES @V201201 00740000
- NOERASE EQU * @V201201 00741000
- MVC UTSFNAME(8),0(R3) INITIALIZE SYSUT FILENAME @V201201 00742000
- OI ASMSW2,FRSTCALL SET FIRST CALL TO SYSUT1 @V201201 00743000
- * 00744000
- LA R1,UTSFDEF FILEDEF LIST FOR SYSUT'S @V201201 00745000
- BAL R10,SVC202 ISSUE FILEDEF @V201201 00746000
- * 00747000
- MVI UTSDDNME+5,C'1' CHANGE TO SYSUT1 DDNAME @V201201 00748000
- MVI UTSFTYPE+5,C'1' CHANGE TO SYSUT1 FILENAME @V201201 00749000
- BAL R10,SVC202 ISSUE FILEDEF @V201201 00750000
- LPR R6,R0 GET FCB ADDRESS @V201201 00751000
- OI FCBIOSW,FCBPROCC AUXPROC DURING CLOSE ALSO.. @V201201 00752000
- * 00753000
- MVI UTSDDNME+5,C'3' CHANGE TO SYSUT3 DDNAME @V201201 00754000
- MVI UTSFTYPE+5,C'3' CHANGE TO SYSUT3 FILENAME @V201201 00755000
- BAL R10,SVC202 ISSUE FILEDEF @V201201 00756000
- * 00757000
- LA R1,MACLDEF FILEDEF LIST FOR CMSLIB @V201201 00758000
- BAL R10,SVC202 ISSUE FILEDEF @V201201 00759000
- LPR R6,R0 GET FCB ADDRESS @V201201 00760000
- OI FCBINIT,FCBCATML SET CONCAT FLAG @V201201 00761000
- * 00762000
- LA R1,DUMFDEF DUMMY CLRPRINT & UNIDATA @V201201 00763000
- BAL R10,SVC202 ISSUE FILEDEF @V201201 00764000
- * 00765000
- MVC DUMNAME,UNIDATA FILENAME FOR UNIDATA @V201201 00766000
- BAL R10,SVC202 ISSUE FILEDEF @V201201 00767000
- EJECT 00768000
- * 00769000
- LOADASM EQU * @V201201 00770000
- LOAD EP=IFOX00 LOAD THE ASSEM XF ROOT @V201201 00771000
- ST R0,VASSEM SAVE ITS ADDRESS @V201201 00772000
- * 00773000
- L R0,GETNO GET AREA FOR XF LONGEST PATH @V201201 00774000
- GETMAIN R,LV=(0) @V201201 00775000
- * 00776000
- L R1,MAINHIGH GET USER AREA HIGH @V201201 00777000
- L R0,FREELOWE GET SYSTEM HIGHEST @V201201 00778000
- SR R0,R1 GET AMOUNT FREE STORAGE @V201201 00779000
- SRL R0,1 GET 50 % OF AREA @V201201 00780000
- C R0,COMPWORK ENOUGH FOR PROCESSOR ? @V201201 00781000
- BNL DWORDS YES..SPLIT 50 - 50 @V201201 00782000
- SRL R0,1 NO..SO GET 25 % FOR INCORES @V201201 00783000
- DWORDS GETMAIN R,LV=(0) SAVE BLOCK OF CORE @VM08910 00784000
- STM R0,R1,FAKENOS SAVE AMOUNT AND ADDRESS @V201201 00786000
- * 00787000
- LM R13,R1,LINK GET THE ASSEMBLER REGISTERS @V201201 00788000
- BR R15 GO AND ...GOOD LUCK... @V201201 00789000
- SPACE 2 00790000
- * 00791000
- *COMING BACK FROM THE ASSEMBLER (XF) PROCESSOR. 00792000
- * 00793000
- RETURN EQU * @V201201 00794000
- ST R15,CC SAVE THE RETURN CODE @V201201 00795000
- * 00796000
- BAL R10,ERASUTS ERASE SYSUT FILES @V201201 00797000
- * 00803000
- RETCMS EQU * @V201201 00804000
- LA R1,CLEARFIL CLEAR ALL NON-PERM FCB'S @V201201 00805000
- BAL R10,SVC202 ISSUE CLEAR @V201201 00806000
- EJECT 00807000
- * 00808000
- END EQU * @V201201 00809000
- SR R0,R0 ZERO REGISTER ZERO @V201201 00810000
- DMSKEY NUCLEUS @V201201 00811000
- NI OSSFLAGS,255-COMPSWT @V201201 00812000
- OI MISFLAGS,RELPAGES @V201201 00813000
- NI PROTFLAG,X'FF'-PRFUSYS RESET PROT FLAGS @VA08901 00813050
- MVC DOSFLAGS,DOSF RESET DOSFLAGS AS BEFORE @VM03272 00813100
- LA R1,SETAUX SET PLIST FOR AUX CLEAR CALL @V201201 00814000
- SVC 202 ... @V201201 00815000
- DC AL4(ERR74E2) ERROR EXIT @V201201 00816000
- ERR74RET EQU * @V201201 00817000
- DMSKEY RESET @V201201 00818000
- L R15,CC GET CONDITION CODE @V201201 00819000
- L R14,SAVREG14 GET CMS RETURN ADDRESS @V201201 00820000
- BR R14 RETURN TO CMS @V201201 00821000
- * 00822000
- SVC202 SVC 202 ISSUE CMS FILEDEF @V201201 00823000
- DC AL4(*+4) NO-OP ERROR EXIT @V201201 00824000
- BR R10 RETURN TO CALLER @V201201 00825000
- * 00826000
- ERASUTS ST R10,VASSEM+4 SAVE LINKAGE REGISTER @V201201 00827000
- LA R1,ERASELST GET ERASE PLIST ADDRESS @V201201 00828000
- LA R8,8 GET TOKEN LENGTH FOR BXLE @V201201 00829000
- LA R9,DDSYS3 GET ENDING ADDRESS @V201201 00830000
- LA R7,DDSYS1 GET BEGINNING ADDRESS @V201201 00831000
- BAL R10,ERASLUP GO AND ERASE SYSUTS @V201201 00832000
- L R10,VASSEM+4 RESTORE RETURN REGISTER @V201201 00833000
- BR R10 RETURN TO CALLER @V201201 00834000
- * 00835000
- EJECT 00836000
- ASMPROC DS 0H @V201201 00837000
- USING ASMPROC,R15 @V201201 00838000
- STM R1,R7,SAVEREGS SAVE REGISTERS @V201201 00839000
- LR R7,R15 GET ADDRESSABILITY @V201201 00840000
- DROP R15 @V201201 00841000
- USING UTENTRY,R2 @V201201 00842000
- USING UTHEAD,R5 @V201201 00843000
- USING OPSECT,R3 @V201201 00844000
- USING FCBSECT,R11 @V201201 00845000
- USING ASMPROC,R7 @V201201 00846000
- * 00847000
- CLC FCBDD(8),DDSYS1 PROCESSING SYSUT1 ? @V201201 00848000
- BE SYSUT1 YES..BRANCH @V201201 00849000
- * 00850000
- SYSUTX MVI FCBFORM,C'F' FORCE RECFM OF FIXED @V201201 00851000
- TM IOBIOFLG,IOBIN ARE WE DOING INPUT ? @V201201 00852000
- BO RETURN1 YES..RETURN @V201201 00853000
- MVC FCBBYTE+2(2),H8000 FORCE 8000 FOR FAST I/O @V201201 00854000
- B RETURN1 RETURN TO O/S SIMULATION @V201201 00855000
- * 00856000
- SYSUT1 TM ASMSW2,NOCORE ARE THERE CORE PROBLEMS ? @V201201 00857000
- BO SYSUTX YES..RETURN @V201201 00858000
- TM ASMSW2,FRSTCALL IS THIS FIRST CALL ? @V201201 00859000
- BO UTSETUP YES..GO AND SETUP CORE @V201201 00860000
- L R5,UTSAV GET ADDRESS OF ENTRIES TABLE @V201201 00861000
- LTR R5,R5 ANY CORE OBTAINED ? @V201201 00862000
- BZ SYSUTX NO..JUST RETURN @V201201 00863000
- TM FCBIOSW,FCBCLOSE ARE WE IN CLOSE EXIT ? @V201201 00864000
- BO UTFIN YES..CHECK NOT TCLOSE @V201201 00865000
- * 00866000
- UTCOMM LH R6,FCBITEM GET ITEM NUMBER @V201201 00867000
- N R6,HALFWORD MASK IT FOR NEXT COMPARE @V201201 00868000
- CH R6,UTCORENT IS IT HIGHER THAN OUR LAST ? @V201201 00869000
- BH UTEOF YES..IS EOF OR WE NEED CORE @V201201 00870000
- SLL R6,3 ADJUST ENTRY INDEX @V201201 00871000
- LA R2,0(R5,R6) GET PROPER RECORD ENTRY @V201201 00872000
- UTSET LH R6,FCBBYTE+2 GET NUMBER OF BYTES TO MOVE @V201201 00873000
- TM UTRECAD,ONDISK IS THIS RECORD IN CORE? @VA03924 00873100
- BO SYSUTX BRANCH IF NOT @VA03924 00873200
- TM IOBIOFLG,IOBIN ARE WE DOING INPUT ? @V201201 00874000
- BZ UTWRITE NO..THEN GO TO WRITE @V201201 00875000
- CH R6,UTRECLN IS NO OF BYTES > THAN OURS ? @V201201 00876000
- BH UTEOF2 YES..DEFINITELY EOF @V201201 00877000
- L R5,UTRECAD GET INCORE RECORD ADDRESS @V201201 00878000
- L R4,FCBBUFF GET USERS BUFFER ADDRESS @V201201 00879000
- B PREMOVE GO TO MOVE ROUTINE @V201201 00880000
- * 00881000
- UTWRITE CH R6,UTRECLN REC LEN SAME AS INCORE ? @V201201 00882000
- BNH UTWRITE2 YES..IT IS OK THEN @V201201 00883000
- LH R6,FCBITEM GET ITEM NO @VA08256 00883400
- N R6,HALFWORD MASK LEFT HALF @VA08256 00883600
- FREELOOP EQU * @VA08256 00883800
- LH R0,UTRECLN GET INCORE RECORD LENGTH @V201201 00884000
- L R1,UTRECAD GET INCORE RECORD ADDRESS @V201201 00885000
- FREEMAIN R,LV=(0),A=(1) @V201201 00886000
- LA R6,1(R6) TAKE NEXT @VA08256 00886100
- CH R6,UTCORENT DO WE HAVE IT @VA08256 00886200
- BH FREEDONE BR IF WE DON'T @VA08256 00886300
- LR R4,R6 DO NOT CHANGE R6 @VA08256 00886400
- SLL R4,3 ADJUST INDEX TO ENTRY TBL @VA08256 00886500
- LA R2,0(R5,R4) POINT TO PROPER ENTRY @VA08256 00886600
- B FREELOOP GO TO FREEMAIN @VA08256 00886700
- FREEDONE EQU * @VA08256 00886800
- LH R6,FCBITEM GET ITEM NUMBER @V201201 00887000
- N R6,HALFWORD MASK HIGH ORDER BYTES @V201201 00888000
- B UTGET2 GET CORE FOR THIS RECORD @V201201 00889000
- EJECT 00890000
- * 00891000
- UTWRITE2 STH R6,UTRECLN SAVE INCORE RECORD LENGHT @V201201 00892000
- L R5,FCBBUFF GET USERS BUFFER ADDRESS @V201201 00893000
- L R4,UTRECAD GET INCORE RECORD ADDRESS @V201201 00894000
- * 00895000
- PREMOVE ST R6,FCBREAD FCBREAD = NO. BYTES MOVED @V201201 00896000
- * 00897000
- UTMOVE SH R6,H256 IS LRECL GREATER THAN 256 ? @V201201 00898000
- BNP LT256 NO.. JUST ONE PASS @VA08256 00899000
- MVC 0(256,R4),0(R5) MOVE 256 BYTES @V201201 00900000
- BE RETURN2 IF NO MORE..RETURN @V201201 00901000
- LA R4,256(,R4) UP MOVE REGISTER BY 256 @V201201 00902000
- LA R5,256(,R5) UP MOVE REGISTER BY 256 @V201201 00903000
- B UTMOVE GO AND MOVE SOME MORE @V201201 00904000
- LT256 AH R6,H256 RESET LENGTH @V201201 00905000
- BCTR R6,0 LESS ONE FOR DOMINOE EFFECT @V201201 00906000
- EX R6,MOVEIT EXECUTE LAST MOVE @V201201 00907000
- B RETURN2 RETURN WITH COUNT IN R15 @V201201 00908000
- * 00909000
- MOVEIT MVC 0(*-*,R4),0(R5) MOVE RECORD FROM/TO CORE @V201201 00910000
- * 00911000
- UTSETUP LM R0,R1,FAKENOS GET FAKE AREA LENGTH & ADDR @V201201 00912000
- FREEMAIN R,LV=(0),A=(1) FREE SAVED CORE @VM08910 00913000
- * 00917000
- LA R4,800 100 ENTRIES (1 HEAD,99 RECS) @V201201 00918000
- LA R6,UTSAV ADDRESS OF GETMAINED AREA @V201201 00919000
- BAL R3,GETCORE GET CORE FOR ENTRIES @V201201 00920000
- BZ UTCOREOK IF ZERO..CORE OBTAINED.. @V201201 00921000
- OI ASMSW2,NOCORE SET NOCORE SWITCH @V201201 00922000
- B SYSUTX RETURN EMPTY HANDED @V201201 00923000
- * 00924000
- UTCOREOK LA R4,1 SET REG 4 TO ONE @V201201 00925000
- L R5,UTSAV GET ADDRESS OF ENTRIES @V201201 00926000
- ST R4,UTCORENT INIT UTCORENT & UTNXTENT @V201201 00927000
- XC UTTOTENT(2),UTTOTENT ZERO TOTAL ENTRIES @V201201 00928000
- NI ASMSW2,255-FRSTCALL TURN OFF FIRST CALL SWITCH @V201201 00929000
- B UTCOMM GO SATISFY I/O REQUEST @V201201 00930000
- EJECT 00931000
- * 00932000
- UTEOF TM IOBIOFLG,IOBIN ARE WE DOING INPUT ? @V201201 00933000
- BZ UTGETCOR NO..THEN GET CORE @V201201 00934000
- CH R6,UTTOTENT IS ITEM > THAN TOT ENTS ? @V201201 00935000
- BNH SYSUTX NO..SOME RECS POSS. ON DISK @V201201 00936000
- UTEOF2 LA R15,12 GET EOF CODE @V201201 00937000
- LNR R15,R15 NEGATIVE OF 12 @V201201 00938000
- B UTRETURN GIVE CODE TO I/O SIM @V201201 00939000
- * 00940000
- UTGETCOR TM ASMSW2,TODISK THIS RECORD TO DISK ? @V201201 00941000
- BO UTTODSK YES..DON'T BOTHER @V201201 00942000
- LH R2,UTCORENT GET LAST IN CORE REC NUM @V201201 00943000
- CH R2,H99 EQUAL OR GREATER THAN 99 ? @V201201 00944000
- BNL UTTODSK YES..BRANCH TO SPILL @V201201 00945000
- CH R6,UTNXTENT FCBITEM SAME AS NEXT ENTRY ? @V201201 00946000
- BNE UTTODSK NO..BRANCH TO SPILL @V201201 00947000
- UTGET2 STH R6,UTCORENT MAKE FCBITEM OUR LAST ENTRY @VA08256 00948000
- STH R6,UTTOTENT ALSO OUR TOTAL ENTRIES @V201201 00949000
- LA R2,1(,R6) UP FCBITEM BY ONE..AND @V201201 00950000
- STH R2,UTNXTENT THIS MUST BE OUR NEXT ENTRY @V201201 00951000
- SLL R6,3 ADJUST INDEX TO ENTRY TBL @VA08256 00952000
- LA R2,0(R5,R6) GET PROPER INCORE REC ENTRY @V201201 00953000
- LH R4,FCBBYTE+2 GET LENGTH OF RECORD @V201201 00954000
- STH R4,UTRECLN SAVE AS OUR INCORE REC LEN @V201201 00955000
- LA R6,UTRECAD GET RECORD ADDRESS @V201201 00956000
- BAL R3,GETCORE GET CORE FOR THIS RECORD @V201201 00957000
- BZ UTSET IF OBTAINED..GO TO MOVE REC @V201201 00958000
- LH R6,FCBITEM GET ITEM NUMBER @VA03924 00958100
- CH R6,UTCORENT WAS RECORD IN CORE? @VA03924 00958200
- BH UTGET3 BRANCH IF NOT @VA03924 00958300
- OI UTRECAD,ONDISK INDICATE ON DISK @VA03924 00958400
- NI ASMSW2,255-TODISK TURN OFF SWITCH @VA03924 00958500
- B SYSUTX @VA03924 00958600
- UTGET3 EQU * @VA03924 00958700
- LH R2,UTCORENT GET UPDATED LAST REC NO @V201201 00959000
- BCTR R2,0 LESS ONE @V201201 00960000
- STH R2,UTCORENT REAL LAST INCORE RECORD @V201201 00961000
- LH R2,UTNXTENT GET UPDATED NEXT REC NO @V201201 00962000
- BCTR R2,0 LESS ONE @V201201 00963000
- STH R2,UTNXTENT REAL NEXT INCORE RECORD @V201201 00964000
- OI ASMSW2,TODISK REMAINING RECS TO DISK.. @V201201 00966000
- * 00967000
- UTTODSK STH R6,UTTOTENT FCBITEM IS NUMBER TOTAL RECS @V201201 00968000
- B SYSUTX RETURN @V201201 00969000
- EJECT 00970000
- * 00971000
- UTFIN CLI OSIOTYPE,C'T' IS THIS A TCLOSE ? @V201201 00972000
- BE RETURN1 YES..IGNORE @V201201 00973000
- XC UTSAV(4),UTSAV CLEAR ENTRIES ADDRESS @V201201 00974000
- * 00975000
- RETURN1 SR R15,R15 RETURN NOTHING TO I/O SIM @V201201 00976000
- B UTRETURN FINAL RETURN @V201201 00977000
- * 00978000
- RETURN2 L R15,FCBREAD GET BYTES MOVED FOR I/O SIM @V201201 00979000
- SLL R15,16 SET RESIDUAL COUNT TO ZERO @V201201 00980000
- UTRETURN LM R1,R6,SAVEREGS RESTORE REGS USED @V201201 00981000
- BR R14 RETURN TO I/O SIMULATION @V201201 00982000
- * 00983000
- GETCORE EQU * @V201201 00984000
- GETMAIN EC,LV=(R4),A=(R6) @V201201 00985000
- ST R15,CC SAVE RETURN CODE @V201201 00986000
- LTR R15,R15 CORE OBTAINED ? @V201201 00987000
- BZ GETDONE YES, JUST RETURN @VM08910 00988000
- OI ASMSW2,TODISK REMAINING RECORDS TO DISK @VM08910 00989000
- GETDONE L R15,CC GET RETURN CODE @V201201 00997000
- LTR R15,R15 SET CONDITION CODE @V201201 00998000
- BR R3 RETURN TO CALLER.. @V201201 00999000
- DROP R7 @V201201 01000000
- EJECT 01001000
- * 01002000
- * 01003000
- TERMPROC DS 0H @V201201 01004000
- USING TERMPROC,R15 @V201201 01005000
- * 01006000
- TM ASMSW2,NOTERM SHOULD THIS LINE BE TYPED ? @V201201 01007000
- BO 0(,R14) NO..JUST RETURN @V201201 01008000
- * 01009000
- ST R1,SAVEREGS SAVE OUR WORK REG. @V201201 01010000
- L R1,FCBBUFF GET BUFFER TO BE TYPED @V201201 01011000
- CLC 0(8,R1),=C' HIGHEST' IS THIS THEEEE LINE ? @V201201 01012000
- L R1,SAVEREGS ... @V201201 01013000
- BE TERMEND YES..GO SET GOOD OL'SWITCH @V201201 01014000
- SR R15,R15 LET O/S SIMULATION TYPE LINE @V201201 01015000
- BR R14 RETURN @V201201 01016000
- * 01017000
- TERMEND OI ASMSW2,NOTERM NO MORE LINES TO BE TYPED @V201201 01018000
- BR R14 RETURN @V201201 01019000
- DROP R15 @V201201 01020000
- * 01021000
- EJECT 01022000
- ********************************************************************** 01023000
- * 01024000
- * DATA 01025000
- * 01026000
- ********************************************************************** 01027000
- * 01028000
- OPTAB$ DC A(O1$,O2$,O3$,O4$,O5$,O6$,O7$,O8$) @V201201 01029000
- SAVEREGS DC 7F'0' SAVEAREA FOR AUXPROCS REGS. @V201201 01030000
- ADTCOPY DC F'0' ADDRESS OF ADT FROM FSTCOPY @V201201 01031000
- CC DC F'0' RETURN CODE FROM PROCESSOR @V201201 01032000
- FILEPTR DC F'0' POINTS TO THE FILE NAME. @V201201 01033000
- HALFWORD DC F'65535' MASKS HI ORDER TWO BYTES OF REG. @V201201 01034000
- GETNO DC X'00007000' MUST EXCEED ASSEMBLER'S LONGEST @VA07768 01036000
- * OVERLAY - IFOX00 + IFOX02 + IFOX51 01036050
- COMPWORK DC X'00020000' MINIMUN AREA FOR ASSEM WORK @V201201 01037000
- FAKENOS DC 2F'0' AMNT & ADDR OF AREA RESERVED @V201201 01038000
- HX100 DC F'105' FULLWORD TO CONTROL OPTION AREA @V201201 01039000
- HX80 DC F'80' RECORD LENGTH FOR INPUT FILE. @V201201 01040000
- H8000 DC H'8000' SYSUTS BLOCK FOR FAST I/O @V201201 01041000
- H256 DC H'256' MAX LENGTH FOR MVC. @V201201 01042000
- H99 DC H'99' MAX NUMBER OF UT ENTRIES. @V201201 01043000
- H20 DC H'20' INVALID FILEID RET. CODE @V201201 01044000
- H4 DC H'4' ... @V201201 01045000
- H3 DC H'3' MAX SUBOPTION LEN FOR XREF @V201201 01046000
- H2 DC H'2' MAX SUBOPTION LEN FOR LINECNT @V201201 01047000
- H16 DC H'16' JUST A TOKEN LENGTH. @V201201 01048000
- RIGHTPAR EQU C')' RIGHT PARENTHESIS CODE. @V201201 01049000
- LEFTPAR EQU C'(' LEFT PARENTHESIS CODE. @V201201 01050000
- COMMA EQU C',' COMMA CODE. @V201201 01051000
- STAR EQU C'*' ASTERICK CODE. @V201201 01052000
- BLANK EQU X'40' BLANK CODE. @V201201 01053000
- HXFF EQU X'FF' FENCE CODE. @V201201 01054000
- WMODE DC CL2'A1' MODE IN CASE NONE FOUND @V201201 01055000
- PRINTER DC CL8'PRINTER' DEVICE USED IF PRINT SPECIFIED @V201201 01056000
- CRT DC CL6'CRT' CATHODE RAY TUBE DEVICE @V201201 01057000
- * 01058000
- ASMSW DC X'0' ASSEMBLER OPTIONS FLAG BITS @V201201 01059000
- PRINT EQU X'40' PRINT OPTION SPECIFIED @V201201 01060000
- NOPRINT EQU X'20' NOPRINT OPTION SPECIFIED @V201201 01061000
- SYSPARM EQU X'10' OPTION IS SYSPARM @V201201 01062000
- XREF EQU X'08' OPTION IS XREF @V201201 01063000
- NUMERIC EQU X'04' SUB-OPTION IS NUMERIC @V201201 01064000
- PARENS EQU X'02' OPTION HAS SUB-OPTION @V201201 01065000
- LINEC EQU X'01' OPTION IS LINECOUNT @V201201 01066000
- * 01067000
- ASMSW2 DC X'0' ASSEMBLER INTERNAL FLAG @V201201 01068000
- OPTERR EQU X'80' OPTION ERROR FOUND @V201201 01069000
- NOTFND EQU X'40' FILE NOT FOUND ON DISK @V201201 01070000
- FRSTCALL EQU X'20' FIRST CALL TO SYSUT1 @V201201 01071000
- NOCORE EQU X'10' NO CORE FOR SYSUT1 @V201201 01072000
- TODISK EQU X'08' FURTHER RECORDS TO DISK @V201201 01073000
- NOTERM EQU X'04' DON'T TYPE THIS LINE @V201201 01074000
- * 01075000
- ASMSWA DC X'0' @VA13257 01075500
- NOOBJECT EQU X'01' NOOBJ(ECT) OPTION SPECIFIED @VA13257 01075550
- * @VA13257 01075600
- EJECT 01076000
- * 01077000
- DOSF DS X'0' TEMP AREA FOR DOSFLAGS @VM03272 01077100
- SAVREG14 DC F'0' CMS RETURN ADDRESS @V201201 01078000
- SAVEAREA DC 18F'0' SAVE AREA FOR THE PROCESSOR @V201201 01079000
- LINK DC A(SAVEAREA) R13 @V201201 01080000
- DC A(RETURN) R14 @V201201 01081000
- VASSEM DC A(0) R15 @V201201 01082000
- DC F'0' R0 @V201201 01083000
- DC A(PARAMLST) R1 @V201201 01084000
- * 01085000
- * 01086000
- PARAMLST DC A(OPTLIST) PARAMETER LIST FOR ASSEM XF. @V201201 01087000
- DC X'80',AL3(DDNAME) @V201201 01088000
- * 01089000
- * 01090000
- DS 0F @V201201 01091000
- OPTLIST EQU * OPTION LIST @V201201 01092000
- DC AL2(OPTLEN-OPTLIST-2) @V201201 01093000
- OPTBYTES EQU * @V201201 01094000
- DC C'TERM' OVERRIDE ASSEMBLER DEFAULTS @VA07914 01095000
- OPTLEN DS XL104 @V201201 01096000
- * 01097000
- * 01098000
- DS 0H @V201201 01099000
- DDNAME DC AL2(DDLAST-*),24X'00' DDNAMES LIST @V201201 01100000
- DDCMSLIB DC CL8'CMSLIB' MACLIB CMS DDNAME @V201201 01101000
- DDASSEM DC CL8'ASSEMBLE' SYSIN CMS DDNAME @V201201 01102000
- DDLIST DC CL8'LISTING' SYSPRINT CMS DDNAME @V201201 01103000
- DDPUNCH DC CL8'PUNCH' SYSPUNCH CMS DDNAME @V201201 01104000
- DDSYS1 DC CL8'SYSUT1' SYSUT1 CMS DDNAME @V201201 01105000
- DDSYS2 DC CL8'SYSUT2' SYSUT2 CMS DDNAME @V201201 01106000
- DDSYS3 DC CL8'SYSUT3' SYSUT3 CMS DDNAME @V201201 01107000
- DDTEXT DC CL8'TEXT' SYSLIN CMS DDNAME @V201201 01108000
- DDTERM DC CL8'SYSTERM' SYSTERM CMS DDNAME @V201201 01109000
- DDLAST EQU * @V201201 01110000
- * 01111000
- * 01112000
- EJECT 01113000
- * 01114000
- DS 0F @V201201 01115000
- SETAUX DC CL8'DMSLADAD' AUXILIARY DIRECTORY LIST @V201201 01116000
- ASMDIRT DC V(DMSASD) @V201201 01117000
- DC F'0' @V201201 01118000
- * 01119000
- * 01120000
- DS 0D @V201201 01121000
- ERASELST DC CL8'ERASE' ERASE LIST @V201201 01122000
- ERASNAME DC CL8' ' @V201201 01123000
- ERASTYPE DC CL8' ' @V201201 01124000
- ERASMODE DC CL2' ' @V201201 01125000
- * 01126000
- * 01127000
- DS 0D @V201201 01128000
- STATELST DC CL8'STATE' STATE LIST @V201201 01129000
- STATNAME DC CL8' ' @V201201 01130000
- DC CL8'ASSEMBLE' @V201201 01131000
- STATMODE DC CL2'*' @V201201 01132000
- DC CL2' ' @V201201 01133000
- STATCOPY DC A(0) ADDRESS OF FST COPY @V201201 01134000
- * 01135000
- ADTPARM DC CL2' ' @V201201 01136000
- * 01137000
- * 01138000
- CLEARFIL DS 0D FILEDEF CALL TO CLEAR FCB'S @V201201 01139000
- DC CL8'FILEDEF' @V201201 01140000
- DC CL8'*' @V201201 01141000
- DC CL8'CLEAR' @V201201 01142000
- DC 8X'FF' @V201201 01143000
- * 01144000
- * 01145000
- DS 0D @V201201 01146000
- CONWR DC CL8'TYPLIN' CONSOLE WRITE LIST @V201201 01147000
- DC AL1(1),AL3(SYSMSG) @V201201 01148000
- DC CL1'B',AL3(L'SYSMSG) @V201201 01149000
- * 01150000
- * 01151000
- DS 0D @V201201 01152000
- CONRD DC CL8'CONREAD' CONSOLE READ LIST @V201201 01153000
- CONBUF DC AL1(1),AL3(0) @V201201 01154000
- CONCNT DC CL1'V',AL3(0) @V201201 01155000
- * 01156000
- * 01157000
- SYSMSG DC C' ENTER SYSPARM: ' @V201201 01158000
- * 01159000
- * 01160000
- SETTING DC C'SETTING ' @V201201 01161000
- RESETING DC C'RESETTING' @V201201 01162000
- * 01163000
- MIN DC CL4'MIN' BUFF SUBOPTION @V201201 01164000
- STD DC CL4'STD' BUFF SUBOPTION @V201201 01165000
- MAX DC CL4'MAX' BUFF SUBOPTION @VA07914 01165100
- FULL DC CL5'FULL' XREF SUBOPTION @V201201 01166000
- SHORT DC CL6'SHORT' XREF SUBOPTION @V201201 01167000
- EJECT 01168000
- * 01169000
- LISTDEF DS 0D FILEDEF LIST: LISTING DDNAME @V201201 01170000
- DC CL8'FILEDEF' @V201201 01171000
- DC CL8'LISTING' @V201201 01172000
- LISTDEV DC CL8'DISK' @V201201 01173000
- LISTNAME DC CL8' ' @V201201 01174000
- DC CL8'LISTING' @V201201 01175000
- LISTMODE DC CL8' ' @V201201 01176000
- DC CL8'(RECFM' @V201201 01177000
- DC CL8'FBA' @V201201 01178000
- DC CL8'BLOCK' @V201201 01179000
- DC CL8'1210' @V201201 01180000
- DC CL8'NOCHANGE' @V201201 01181000
- DC 8X'FF' @V201201 01182000
- * 01183000
- INPTDEF DS 0D FILEDEF LIST: ASSMBLE DDNAME @V201201 01184000
- DC CL8'FILEDEF' @V201201 01185000
- DC CL8'ASSEMBLE' @V201201 01186000
- DC CL8'DISK' @V201201 01187000
- INPTNAME DC CL8' ' @V201201 01188000
- DC CL8'ASSEMBLE' @V201201 01189000
- INPTMODE DC CL8'*' @V201201 01190000
- DC CL8'(RECFM' @V201201 01191000
- DC CL8'FB' @V201201 01192000
- DC CL8'LRECL' @V201201 01193000
- DC CL8'80' @V201201 01194000
- DC CL8'BLOCK' @V201201 01195000
- DC CL8'800' @V201201 01196000
- DC CL8'NOCHANGE' @V201201 01197000
- DC 8X'FF' @V201201 01198000
- * 01199000
- TEXTDEF DS 0D FILEDEF LIST: TEXT DDNAME @V201201 01200000
- DC CL8'FILEDEF' @V201201 01201000
- DC CL8'TEXT' @V201201 01202000
- DC CL8'DISK' @V201201 01203000
- TEXTNAME DC CL8' ' @V201201 01204000
- DC CL8'TEXT' @V201201 01205000
- TEXTMODE DC CL8' ' @V201201 01206000
- DC CL8'(' @V201201 01207000
- DC CL8'NOCHANGE' @V201201 01208000
- DC 8X'FF' @V201201 01209000
- * 01210000
- SYSTERM DS 0D FILEDEF LIST: SYSTERM DDNAME @V201201 01211000
- DC CL8'FILEDEF' @V201201 01212000
- DC CL8'SYSTERM' @V201201 01213000
- TERMINAL DC CL8'TERMINAL' @V201201 01214000
- DC CL8'(' @V201201 01215000
- DC CL8'AUXPROC' @V201201 01216000
- DC AL4(TERMPROC) @V201201 01217000
- DC AL4(0) @V201201 01218000
- DC CL8'NOCHANGE' @V201201 01219000
- DC 8X'FF' @V201201 01220000
- EJECT 01221000
- * 01222000
- PUNFDEF DS 0D FILEDEF LIST: PUNCH DDNAME @V201201 01223000
- DC CL8'FILEDEF' @V201201 01224000
- DC CL8'PUNCH' @V201201 01225000
- PUNCH DC CL8'PUNCH' @V201201 01226000
- OVER DC CL8'(' @V201201 01227000
- DC CL8'NOCHANGE' @V201201 01228000
- DC 8X'FF' @V201201 01229000
- * 01230000
- UTSFDEF DS 0D FILEDEF LIST: SYSUT DDNAME @V201201 01231000
- DC CL8'FILEDEF' @V201201 01232000
- UTSDDNME DC CL8'SYSUT2' @V201201 01233000
- DC CL8'DISK' @V201201 01234000
- UTSFNAME DC CL8' ' @V201201 01235000
- UTSFTYPE DC CL8'SYSUT2' @V201201 01236000
- UTSFMODE DC CL8' 4' @V201201 01237000
- DC CL8'(BLOCK' @V201201 01238000
- DC CL8'7294' @V201201 01239000
- DC CL8'AUXPROC' @V201201 01240000
- DC AL4(ASMPROC) @V201201 01241000
- DC AL4(0) @V201201 01242000
- DC CL8'NOCHANGE' @V201201 01243000
- DC 8X'FF' @V201201 01244000
- * 01245000
- MACLDEF DS 0D FILEDEF LIST: CMSLIB DDNAME @V201201 01246000
- DC CL8'FILEDEF' @V201201 01247000
- DC CL8'CMSLIB' @V201201 01248000
- DC CL8'DISK' @V201201 01249000
- DC CL8'CMSLIB' @V201201 01250000
- DC CL8'MACLIB' @V201201 01251000
- DC CL8'*' @V201201 01252000
- DC CL8'(RECFM' @V201201 01253000
- DC CL8'FB' @V201201 01254000
- DC CL8'LRECL' @V201201 01255000
- DC CL8'80' @V201201 01256000
- DC CL8'BLOCK' @V201201 01257000
- DC CL8'800' @V201201 01258000
- DC CL8'NOCHANGE' @V201201 01259000
- DC 8X'FF' @V201201 01260000
- * 01261000
- DUMFDEF DS 0D FILEDEF LIST: CLRPRNT DDNAME @V201201 01262000
- DC CL8'FILEDEF' @V201201 01263000
- DUMNAME DC CL8'CLRPRINT' @V201201 01264000
- DUMMY DC CL8'DUMMY' @V201201 01265000
- DC 8X'FF' @V201201 01266000
- * 01267000
- UNIDATA DC CL8'UNIDATA' FILENAME FOR UNIDATA DDNAME @V201201 01268000
- * @VA13257 01268500
- NOOBJ DC CL5'NOOBJ' NOOBJ(ECT) OPTION @VA13257 01268550
- * @VA13257 01268600
- EJECT 01269000
- * 01270000
- OPTIONS EQU * @V201201 01271000
- * 01272000
- * THE FOLLOWING MACRO CONTAINS THE NAMES AND ABBREVIATIONS OF 01273000
- * ALL THE ASSEMBLER (XF) AND CMS OPTIONS. THE FIRST POSITIONAL 01274000
- * PARAMETER IN EACH ENTRY CONTAINS THE NAME OF THE OPTION. IF 01275000
- * AN ABBREVIATION EXISTS, IT IS ADDED TO THE FIRST PARAMETER IN 01276000
- * SUBLIST NOTATION. THE SECOND POSITIONAL PARAMETER IS USED TO 01277000
- * CONTAIN TWO FLAGS DESCRIBING THE NATURE OF THE OPTION. 01278000
- * 01279000
- * THE FIRST FLAG IS 'ORED' TO A FLAG CALLED "ASMSW" SO THAT IT 01280000
- * CAN BE TESTED LATER. 01281000
- * 01282000
- * THE SECOND FLAG IS 'ANDED' TO "ASMSW" TO TURN OFF ANY PREVIOUS 01283000
- * CONFLICTING OPTIONS SPECIFIED. 01284000
- * 01285000
- * THE FLAG 'PARENS' MEANS THAT THE OPTION IS IN TWO PARTS AND THAT 01286000
- * PARENTHESIS ARE TO SURROUND THE SECOND PART. THE FLAG 'NUMERIC' 01287000
- * MEANS THAT THE SECOND PART OF THE OPTION MUST BE NUMERIC. 01288000
- * 01289000
- OPTDEF *01290000
- (ALIGN,ALGN),, @V201201*01291000
- ALOGIC,, @V201201*01292000
- BUFSIZE,PARENS, @V201201*01293000
- DECK,, @V201201*01294000
- (DISK,DI),(PRINT,255-PRINT-NOPRINT), @V201201*01295000
- ESD,, @V201201*01296000
- FLAG,(PARENS+NUMERIC), @V201201*01297000
- LIBMAC,, @V201201*01298000
- LINECOUN,(PARENS+NUMERIC+LINEC), @V201201*01299000
- LIST,, @V201201*01300000
- LOAD,, @V201201*01301000
- MCALL,, @V201201*01302000
- MLOGIC,, @V201201*01303000
- NOALOGIC,, @V201201*01304000
- (NOALIGN,NOALGN),, @V201201*01305000
- NODECK,, @V201201*01306000
- NOESD,, @V201201*01307000
- NOLIBMAC,, @V201201*01308000
- NOLIST,, @V201201*01309000
- NOLOAD,, @V201201*01310000
- NOMCALL,, @V201201*01311000
- NOMLOGIC,, @V201201*01312000
- (NONUMBER,NONUM),, @V201201*01313000
- (NOOBJECT,NOOBJ),, @V201201*01314000
- (NOPRINT,NOPR),(NOPRINT,255-PRINT), @V201201*01315000
- NORENT,, @V201201*01316000
- NORLD,, @V201201*01317000
- NOSTMT,, @V201201*01318000
- NOTEST,, @V201201*01319000
- NOTERM,, @V201201*01320000
- NOXREF,, @V201201*01321000
- NOYFLAG,, @VM03272*01321500
- (NUMBER,NUM),, @V201201*01322000
- (OBJECT,OBJ),, @V201201*01323000
- (PRINT,PR),(PRINT,255-NOPRINT), @V201201*01324000
- RENT,, @V201201*01325000
- RLD,, @V201201*01326000
- STMT,, @V201201*01327000
- SYSPARM,(PARENS+SYSPARM), @V201201*01328000
- (TERMINAL,TERM),, @V201201*01329000
- TEST,, @V201201*01330000
- WORKSIZE,(PARENS+SYSPARM), @VA07914*01330100
- XREF,(PARENS+XREF), @VM03272*01331000
- YFLAG, @VM03272 01331500
- DS 0H @V201201 01332000
- EJECT 01333000
- USING DMSASM,R12,R11 @V201201 01334000
- ERR1 EQU * @V201201 01335000
- DMSERR TEXT='NO FILENAME SPECIFIED',NUM=001,LET=E @V201201 01336000
- MVI CC+3,X'18' SET RETURN CODE @V201201 01337000
- B END EXIT @V201201 01338000
- ERR2 EQU * @V201201 01339000
- DMSERR TEXT='FILE ''........ ASSEMBLE'' NOT FOUND',NUM=002, *01340000
- LET=E,SUB=(CHARA,(R3)) @V201201 01341000
- MVI CC+3,X'1C' SET RETURN CODE @V201201 01342000
- B RETCMS EXIT @V201201 01343000
- ERR3 LR R2,R6 ... @V201201 01344000
- ERR3A ST R1,VASSEM+4 SAVE REGISTER 1 @V201201 01345000
- DMSERR TEXT='INVALID OPTION ''........''',NUM=003,LET=E, *01346000
- SUB=(CHARA,(R2)) @V201201 01347000
- OI ASMSW2,OPTERR SIGNAL OPTION ERROR @V201201 01348000
- MVI CC+3,X'18' SET RETURN CODE @V201201 01349000
- L R1,VASSEM+4 RESTORE REGISTER 1 @V201201 01350000
- BR R10 RETURN TO CALLER @V201201 01351000
- EJECT 01352000
- * 01353000
- ERR3B TM ASMSW,SYSPARM SYSPARM OPTION ? @V201201 01354000
- BO SUBOPTEN YES..HANDLE SPECIAL @V201201 01355000
- LR R2,R6 SAVE OPTION POINTER @V201201 01356000
- SH R2,H16 POINT TO OPTION @V201201 01357000
- LA R10,GETNEXT GET RETURN ADDRESS @V201201 01358000
- B ERR3A GIVE ERROR... @V201201 01359000
- ERR6 EQU * @V201201 01360000
- TM ASMSW,PRINT+NOPRINT NEED R/W DISK FOR LISTING? @VA13257 01360500
- BZ ERR6A YES, ISSUE ERROR MESSAGE. @VA13257 01360550
- TM ASMSWA,NOOBJECT NEED R/W DISK FOR TEXT? @VA13257 01360600
- BO ERASE NO, CONTINUE ASSEMBLY. @VA13257 01360650
- ERR6A EQU * YES, ISSUE ERROR MESSAGE. @VA13257 01360700
- DMSERR TEXT='NO READ/WRITE DISK ACCESSED',NUM=006,LET=E 01361000
- MVI CC+3,X'24' SET RETURN CODE @V201201 01362000
- B RETCMS EXIT @V201201 01363000
- ERR7 EQU * @V201201 01364000
- DMSERR TEXT='FILE ''........ ASSEMBLE'' IS NOT FIXED, 80 CHAR.*01365000
- RECORDS',NUM=007,LET=E,SUB=(CHARA,(R3)) @V201201 01366000
- MVI CC+3,X'20' SET RETURN CODE @V201201 01367000
- B RETCMS EXIT @V201201 01368000
- EJECT 01369000
- * 01370000
- ERR38 EQU * @V201201 01371000
- DMSERR TEXT='FILEID CONFLICT FOR DDNAME ''ASSEMBLE''', *01372000
- NUM=038,LET=E @V201201 01373000
- MVI CC+3,X'28' SET RETURN CODE @V201201 01374000
- B RETCMS EXIT @V201201 01375000
- ERR52 EQU * @V201201 01376000
- DMSERR TEXT='MORE THAN 100 CHARS. OF OPTIONS SPECIFIED', *01377000
- NUM=052,LET=E @V201201 01378000
- MVI CC+3,X'18' SET RETURN CODE @V201201 01379000
- B END EXIT @V201201 01380000
- ERR70 LR R2,R1 POINT TO PARAMETER @V201201 01381000
- DMSERR TEXT='INVALID PARAMETER ''........''',NUM=070,LET=E, *01382000
- SUB=(CHARA,(R2)) @V201201 01383000
- MVI CC+3,X'18' SET RETURN CODE @V201201 01384000
- B END EXIT @V201201 01385000
- EJECT 01386000
- * 01387000
- ERR74E1 LA R2,SETTING GET MSG FUNCTION @V201201 01388000
- B ERR74GO GO GIVE ERROR MSG @V201201 01389000
- ERR74E2 LA R2,RESETING GET MSG FUNCTION @V201201 01390000
- ERR74GO EQU * @V201201 01391000
- DMSERR NUM=074,TEXT='ERROR ......... AUXILIARY DIRECTORY', *01392000
- LET=E,SUB=(CHARA,(R2)) @V201201 01393000
- MVI CC+3,X'28' SET RETURN CODE @V201201 01394000
- B ERR74RET @V201201 01395000
- ERR75 EQU * @V201201 01396000
- DMSERR TEXT='DEVICE ''........'' ILLEGAL FOR INPUT', @V201201*01397000
- NUM=075,LET=E,SUB=(CHARA,(R2)) @V201201 01398000
- MVI CC+3,X'28' SET RETURN CODE @V201201 01399000
- B RETCMS EXIT @V201201 01400000
- EJECT 01401000
- NUCON @V201201 01402000
- ADT @V201201 01403000
- FSTB @V201201 01404000
- REGEQU @V201201 01405000
- CMSCB @V201201 01406000
- IO @V201201 01407000
- * 01408000
- * 01409000
- UTSAV EQU IOBCSW ADDRESS OF ENTRIES TABLE @V201201 01410000
- * 01411000
- * 01412000
- UTHEAD DSECT @V201201 01413000
- UTCORENT DS H LAST INCORE RECORD NUMBER @V201201 01414000
- UTNXTENT DS H NEXT INCORE RECORD NUMBER @V201201 01415000
- UTTOTENT DS H TOTAL NO. RECS (INCORE AND DISK) @V201201 01416000
- DS H @V201201 01417000
- * 01418000
- * 01419000
- UTENTRY DSECT @V201201 01420000
- DS H @V201201 01421000
- UTRECLN DS H INCORE RECORD LENGTH @V201201 01422000
- UTRECAD DS A INCORE RECORD ADDRESS @V201201 01423000
- ONDISK EQU X'80' RECORD ON DISK IND. @VA03924 01423100
- * 01424000
- * 01425000
- EJECT 01426000
- DMSASM CSECT @V201201 01427000
- LTORG @V201201 01428000
- ORG DMSASM+X'1D70' @V201201 01429000
- END 01430000
ibm/vm370-lib/cms/dmsasm.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator