ibm:vm370-lib:cms:dmslst.assemble_src
Table of Contents
DMSLST Source
References
- Fixes Applied : 7
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC321DS]
Source Listing
- DMSLST.ASSEMBLE.txt
- LST TITLE 'DMSLST (CMS) VM/370 - RELEASE 6' 00001000
- SPACE 2 00002000
- *. 00007000
- * 00008000
- * MODULE NAME: 00009000
- * 00010000
- * DMSLST (LISTFILE) 00011000
- * 00012000
- * FUNCTION: 00013000
- * 00014000
- * LISTFILE COMMAND. INFORMATION ABOUT THE SPECIFIED 00015000
- * FILE(S) IS OUTPUT FOR THE USER. 00016000
- * 00017000
- * ATTRIBUTES: 00018000
- * 00019000
- * DISK RESIDENT, TRANSIENT 00020000
- * NOTE: LISTFILE MUST BE GENMOD'D WITH THE SYSTEM OPTION 00020100
- * 00021000
- * ENTRY POINTS: 00022000
- * 00023000
- * DMSLSTA (LISTFILE) - INPUT LINE FROM THE TERMINAL. 00024000
- * 00025000
- * ENTRY CONDITIONS: 00026000
- * 00027000
- * LIST - 00028000
- * GPR1 = A(PLIST) 00029000
- * GPR14 = A(CALLED ROUTINE) 00030000
- * PLIST = CL8 - CALLED ROUTINE 00031000
- * CL8 - FILENAME|* 00032000
- * CL8 - FILETYPE|* 00033000
- * CL8 - FILEMODE|*|BLANK 00034000
- * 00035000
- * OPTIONAL AND IN ANY ORDER: 00036000
- * CL8'(' 00037000
- * CL8'FMODE'|'FTYPE'|'FNAME' 00038000
- * CL8'DATE' 00039000
- * CL8'FORMAT' 00040000
- * CL8'FULLDATE|SHORTDATE|ISODATE' HRC005DS 00040500
- * CL8'ALLOC' 00041000
- * CL8'EXEC|APPEND' 00042000
- * CL8'HEADER'|'NOHEADER' 00043000
- * CL8'LABEL' 00044000
- * CL8'STACK' HRC321DS 00044100
- * CL8'FIFO ' 'LIFO' HRC321DS 00044200
- * 00045000
- * XL8 - FENCE 00046000
- * 00047000
- * EXIT CONDITIONS: 00048000
- * 00049000
- * NORMAL - 00050000
- * GPR15 = 0 : LIST IS OUTPUT CORRECTLY 00051000
- * 00052000
- * ERROR - 00053000
- * GPR15 = XXX : ERRORS OCCURRED 00054000
- * 24 INVALID PARAMETER/OPTION, CONFLICTING OPTIONS 00055000
- * 28 FILE NOT FOUND, INVALID FILEMODE 00056000
- * 36 DISK NOT ACCESSED, DISK NOT READ-WRITE 00057000
- * 00058000
- * CALLS TO OTHER ROUTINES: 00059000
- * 00060000
- * DMSLAD - FIND THE ACTIVE DISK TABLE BLOCK MATCHING 00061000
- * THE MODE SPECIFIED 00062000
- * 00063000
- * DMSLADN - FIND THE NEXT ADT BLOCK IN THE ACTIVE DISK 00064000
- * TABLE 00065000
- * 00066000
- * DMSCWR - TYPE A LINE OF FILE INFORMATION AT THE USER'S 00067000
- * TERMINAL 00068000
- * 00069000
- * DMSERS - DELETE THE SPECIFIED FILE 00070000
- * 00071000
- * DMSFNSA - CLOSE THE SPECIFIED FILE 00072000
- * 00073000
- * DMSBWR - WRITE THE SPECIFIED FILE OUT ON DISK 00074000
- * 00075000
- * DMSERR - TYPE AN ERROR MESSAGE AT THE USER CONSOLE 00076000
- * 00077000
- * EXTERNAL REFERENCES: 00078000
- * 00079000
- * ADT - ACTIVE DISK TABLE 00080000
- * 00081000
- * TABLES/WORKAREAS: 00082000
- * 00083000
- * NONE 00084000
- * 00085000
- * REGISTER USAGE: 00086000
- * 00087000
- * GPR1 = A(PLIST) 00088000
- * GPR12 = BASE REGISTER 00089000
- * 00090000
- * NOTES: 00091000
- * 00092000
- * LISTFILE is treated as a "command" or a "function" HRC309DS 00093000
- * according to the high-order byte of R1 at input, viz: HRC309DS 00093050
- * If = x'0B', it was issued as a command from DMSINT. HRC309DS 00093100
- * If = X'0D', it was issued from an EXEC FILE (DMSEXT), HRC309DS 00093150
- * with "&CONTROL" set to either "CMS" or "ALL". HRC309DS 00093200
- * If = x'01', it was issued from an EXEC file (DMSEXT), HRC309DS 00093250
- * with "&CONTROL OFF" in effect. HRC309DS 00093300
- * Otherwise, it is assumed to be a function. HRC309DS 00093350
- * HRC309DS 00093400
- * If DMSLST is called as a function, all error messages HRC309DS 00093450
- * are ommitted. Also, if LISTFILE is called from EXEC HRC309DS 00093500
- * with "&CONTROL OFF" in effect, the "file not found" HRC309DS 00093550
- * error message is omitted. HRC309DS 00093600
- * 00094000
- * OPERATION: 00095000
- * 00096000
- * THE DISK(S) SEARCHED FOR THE GIVEN FILE(S) ARE 00097000
- * DETERMINED BY DMSLSTA AS FOLLOWS: 00098000
- * 00099000
- * 1. IF FILEMODE IS GIVEN, DMSLAD IS CALLED TO 00100000
- * REFERENCE THE GIVEN DISK; IF FOUND, DMSLSTA 00101000
- * SEARCHES THE DIRECTORY TO FIND THE GIVEN 00102000
- * FILE(S). IF NOT FOUND BY DMSLAD, I.E., THE DISK 00103000
- * IS NOT LOGGED IN, AN ERROR IS RETURNED. 00104000
- * 00105000
- * 2. IF THE FILEMODE IS OMITTED, DMSLADN IS CALLED 00106000
- * (REPEATEDLY IF NECESSARY), AND DMSLSTA SEARCHES 00107000
- * THE PRIMARY DISK AND ALL ITS EXTENSIONS, 00108000
- * TO FIND THE GIVEN FILE(S). 00109000
- * 00110000
- * 3. IF THE FILEMODE WAS GIVEN AS ASTERISK (*), THEN 00111000
- * DMSLADN IS 00112000
- * CALLED AS ABOVE, AND ALL DISKS, READ-WRITE AND 00113000
- * READ-ONLY, 00114000
- * ARE SEARCHED BY DMSLSTA FOR THE GIVEN FILE(S). 00115000
- * 00116000
- * WHEN DMSLSTA, IN SCANNING A PARTICULAR FST TABLE AS 00117000
- * OBTAINED FROM DMSLAD OR DMSLADN, FINDS AN FST ENTRY 00118000
- * WHOSE FILENAME AND FILETYPE SATISFY THE 00119000
- * PARAMETER LIST, IT MOVES THE FILENAME, FILETYPE, 00120000
- * FILEMODE, AND ANY OTHER REQUESTED INFORMATION FROM 00121000
- * THAT FILE STATUS TABLE TO THE BUFFER. IF THE EXEC 00122000
- * OPTION IS NOT REQUESTED, IT THEN CALLS 00123000
- * DMSCWR TO TYPE THE CONTENTS OF THE BUFFER AT THE 00124000
- * TERMINAL. (THE OUTPUT LINES MAY BE PRECEDED BY AN 00125000
- * APPROPRIATE HEADING.) 00126000
- * DMSLSTA REPEATS THIS PROCEDURE FOR EACH FILE STATUS 00127000
- * TABLE SATISFYING THE FILENAME AND FILETYPE LISTING 00128000
- * REQUIREMENTS. 00129000
- * WHEN SCAN OF ALL PARTICIPATING FILE STATUS TABLES IS 00130000
- * COMPLETED, DMSLSTA RETURNS TO THE CALLER. 00131000
- * 00132000
- * If the STACK option is specified, the output is HRC321DS 00132025
- * placed in the stack in FIFO order. The STACK option HRC321DS 00132050
- * implies the NOHEADER option. HRC321DS 00132075
- * HRC321DS 00132100
- * If the FIFO option is specified, the output is placed HRC321DS 00132125
- * in the stack in FIFO order. The FIFO option implies HRC321DS 00132150
- * the NOHEADER option. HRC321DS 00132175
- * HRC321DS 00132200
- * If the LIFO option is specified, the output is placed HRC321DS 00132225
- * in the stack in LIFO order. The LIFO option implies HRC321DS 00132250
- * the NOHEADER option. HRC321DS 00132275
- * HRC321DS 00132300
- * IF THE EXEC OPTION IS REQUESTED, THE CONTENTS OF THE 00133000
- * BUFFER ARE NOT WRITTEN TO THE TERMINAL. INSTEAD, A 00134000
- * CMS EXEC FILE, CONTAINING THE DUMMY ARGUMENTS "&1 &2" 00135000
- * FOLLOWED BY THE BUFFER CONTENTS IS CREATED. THIS 00136000
- * FILE MAY LATER BE ACCESSED BY THE EXEC PROGRAM, WHICH 00137000
- * WILL REPLACE THE DUMMY ARGUMENTS. 00138000
- * 00139000
- * THE APPEND OPTION IS PRINCIPALLY THE SAME AS THE 00140000
- * EXEC OPTION IN ITS MANNER OF EXECUTION, BUT WHEREAS 00141000
- * THE EXEC OPTION WILL ERASE AN EXTANT CMS EXEC FILE, 00142000
- * APPEND CAUSES NEW INFORMATION TO BE PLACED INTO SUCH 00143000
- * A FILE. IF A 'CMS EXEC FILE DOES NOT EXIST WHEN THE 00144000
- * APPEND OPTION IS SPECIFIED, ONE WILL BE CREATED -- IN 00145000
- * A MANNER IDENTICAL TO HAVING SPECIFIED THE EXEC OPTION. 00146000
- * 00147000
- * THERE IS A VARIED AMOUNT OF INFORMATION THAT THE USER 00148000
- * MAY REQUEST BE TYPED OR PLACED INTO CMS EXEC FILE. 00149000
- * THE INFORMATION IS SERIALLY PRODUCED; I.E., IF THE 00150000
- * DATA FROM THE RIGHTMOST COLUMNS ARE WANTED, THE DATA 00151000
- * UP TO THOSE COLUMNS WILL BE PROVIDED. 00152000
- * 00153000
- * THE DEFAULT AMOUNT OF INFORMATION IS FILENAME, 00154000
- * FILETYPE, FILEMODE, WITH NOHEADER. IF MORE 00155000
- * INFORMATION IS REQUESTED, BY SPECIFYING FORMAT, 00156000
- * ALLOC, DATE, OR LABEL, HEADER BECOMES THE DEFAULT 00157000
- * OPTION. 00158000
- * 00159000
- * IF FORMAT IS ENTERED, THE RECORD FORMAT OF THE FILE, 00160000
- * FIXED OR VARIABLE, AND THE LOGICAL RECORD LENGTH WILL 00161000
- * BE PROVIDED. 00162000
- * 00163000
- * IF ALLOC IS ENTERED, THE AMOUNT OF DISK SPACE THAT 00164000
- * CMS HAS ALLOCATED TO THE FILE IN TERMS OF BOTH THE 00165000
- * NUMBER OF PHYSICAL BLOCKS USED, AND THE NUMBER OF 00166000
- * LOGICAL RECORDS WITHIN THE FILE WILL BE PROVIDED. 00167000
- * 00168000
- * IF DATE IS ENTERED, THE CREATION DATE (MM/DD/YY) AND 00169000
- * TIME (HH.MM) OF THE FILE WILL BE PROVIDED. 00170000
- * 00171000
- * IF LABEL IS ENTERED, THE VOLSER OF THE DISK UPON 00172000
- * WHICH THE FILE RESIDES WILL BE INCLUDED AS THE FINAL 00173000
- * ITEM. 00174000
- * 00175000
- * ALL OF THE ABOVE INFORMATION, EXCEPT DISK LABEL, 00176000
- * COMES FROM THE FILE STATUS TABLE (FST) FOR THE 00177000
- * RESPECTIVE FILE. THE DISK LABEL IS OBTAINED FROM THE 00178000
- * ACTIVE DEVICE TABLE (ADT) FOR THAT DISK. 00179000
- * 00180000
- *. 00181000
- EJECT 00182000
- MACRO 00183000
- &LOC OPTION &NAME,&MIN,&ADDR 00184000
- LCLA &M,&L 00185000
- LCLC &A 00186000
- &M SETA 1 00187000
- AIF (N'&MIN EQ 0).SEQ1 00188000
- &M SETA &MIN 00189000
- .SEQ1 ANOP 00190000
- &L SETA K'&NAME 00191000
- &A SETC '&NAME' 00192000
- AIF (N'&ADDR EQ 0).SEQ2 00193000
- &A SETC '&ADDR' 00194000
- .SEQ2 ANOP 00195000
- &LOC DC AL1(&M,&L),CL8'&NAME',AL2(&A-LISTFILE) 00196000
- MEND 00197000
- SPACE 3 00198000
- DMSLST START 0 00199000
- LISTFILE EQU * 00200000
- USING NUCON,R0 00201000
- LR R12,15 SET UP A BASE REGISTER 00202000
- USING LISTFILE,R12 00203000
- SSM OK81 00204000
- ST R14,RETREG AND SAVE THE RETURN REGISTER 00205000
- ST R1,SAVEDR1 AND SAVE R1 VALUE AT INPUT @VM01710 00205100
- SR R15,R15 NOW BUILD A DEFAULT SIGNAL 00206000
- MVC DESMODE(2),DMODE INITIALIAZE THE MODE FIELD 00207000
- MVC ERRADDR(4),=A(ERRADDR+4) ASSUME NOT EXEC OPTION. P3017 00208000
- MVI FLAG,HEADINIT INITIALIZE FLAG V0028 00209150
- MVI FLAG2,X'00' HRC005DS 00209550
- MVI COMNAME+1,X'07' ASSUME AN 8-BYTE FILENAME 00210000
- MVI COMTYPE+1,X'07' AND 8-BYTE FILETYPE 00211000
- LA R2,NAMESTAR BUT ALLOW THAT NEITHER IS SPECIFIED 00212000
- LA R3,PARMCKN THOUGH THERE MAY BE A FILENAME 00213000
- SCAN LA R1,8(,R1) LET'S PEEK AHEAD A BIT 00214000
- CLI 0(R1),C'(' OPTIONS START YET? 00215000
- BE OPTSCAN SORT THEM OUT, IF YES. 00216000
- CLI 0(R1),X'FF' ARE WE DONE YET? 00217000
- BCR 8,R2 YES. THEN GO WHEREVER 00218000
- BR R3 NO. THEN ELSEWHERE 00219000
- EJECT 00220000
- *********************************************************************** 00221000
- * 00222000
- * SCAN FILENAMES, FILETYPES, AND FILEMODES 00223000
- * 00224000
- *********************************************************************** 00225000
- PARMCKN LA R4,COMNAME+1 POINT TO COMPARISON FOR FILENAME 00226000
- LA R2,TYPESTAR RESET THE DEFAULT VECTOR 00227000
- LA R3,PARMCKT RESET THE NEXT SCAN POINTER 00228000
- LA R8,NAME1 POINT TO A HOLDING FIELD 00229000
- LA R9,1 SET UP A FLAG (FOR LATER) 00230000
- B PC0 NOW, JOIN THE COMMON ROUTINE 00231000
- PARMCKT LA R4,COMTYPE+1 POINT TO COMPARISON FOR FILETYPE 00232000
- LA R2,JOIN RESET THE DEFAULT VECTOR 00233000
- LA R3,PARMCKM RESET THE NEXT SCAN POINTER 00234000
- LA R8,NAME2 POINT TO A HOLDING FIELD 00235000
- PC0 LR R5,R1 SAVE THE POINTER 00236000
- LA R6,7 SET UP MAXIMUM LENGTH INDICATOR 00237000
- SR R7,R7 EMPTY OUT A WORK REGISTER 00238000
- CLI 0(R5),C'*' IS IT "ANY"? 00239000
- BNE PC1 NO. THEN LET'S SEE WHAT 00240000
- CLI 1(R5),C' ' IS IT LEGAL? 00241000
- BNE ERR2 NO! BUT THAT MEANS WE CAN'T FIND IT. SO.. 00242000
- B NOCONCAT JUST AN ASTERISK 00243000
- PC1 CLI 1(R5),C'*' LOOKING FOR A CONCATENATED FORM? 00244000
- BNE UPCOUNT NOT YET. 00245000
- CR R9,R6 YES. BUT HOW LONG 00246000
- BE CONCAT ALMOST MAXIMUM 00247000
- CLI 2(R5),C' ' IS IT IMBEDDED? 00248000
- BE CONCAT OTHERWISE, WE CAN'T FIND IT ANYWAY 00249000
- UPCOUNT CLI 1(R5),C' ' IS IT THE END YET? 00250000
- BE NOCONCAT YES. 00251000
- LA R5,1(,R5) TRY THE NEXT CHARACTER POSITION 00252000
- LA R7,1(,R7) UP THE COUNT SCANNED ALREADY 00253000
- BCT R6,PC1 DECREMENT THE COUNT ALLOWABLE 00254000
- B NOCONCAT ? GUESS WE'RE DONE. 00255000
- CONCAT STC R7,0(,R4) PUT THIS NUMBER WHERE NEEDED 00256000
- NOCONCAT EX R7,MOVEM PUT COMPUTED FORM IN THE HOLDING FIELD 00257000
- B SCAN NOW, BACK FOR MORE 00258000
- PARMCKM CLI 2(R1),C' ' DID WE GET MORE THAN 2 CHARACTERS V0205 00259100
- BNE ERR6 YES. DEFINITELY AN ERROR 00260000
- OI FLAG,USERMODE SIGNAL NOT DEFAULT MODE V0042 00260100
- MVC DESMODE(2),0(R1) SAVE WHATEVER IT IS 00261000
- LA R3,ERR1 SET UP THE NEXT SCAN EXIT-POINTER 00263000
- B SCAN AND OFF WE GO AGAIN 00264000
- SPACE 00265000
- MOVEM MVC 0(8,R8),0(R1) (EXECUTED MOVE FOR FN & FT) 00266000
- EJECT 00267000
- *********************************************************************** 00268000
- * 00269000
- * OPTION SCANNING ROUTINE 00270000
- * 00271000
- *********************************************************************** 00272000
- SPACE 2 00273000
- OPTSCAN LA R4,8(,R1) GET FIRST ARGUMENT. 00274000
- LR R11,R2 SAVE EXIT-ADDRESS. 00275000
- LA R8,4 LOAD BXLE INCREMENT REGISTER. 00276000
- LA R10,8 LOAD USEFUL '8' 00277000
- USING TABIMAGE,R9 00278000
- LA R9,LASTENT POINT TO END OF OPTION TABLE. 00279000
- LA R9,BRAD BUT, BACKUP A BIT! 00280000
- DROP R9 00281000
- USING TABIMAGE,R2 00282000
- SCANON LA R2,FIRSTENT POINT TO START OF OPTION TABLE 00283000
- SR R6,R6 MAKE SURE THIS REGISTER IS EMPTY. 00284000
- IC R6,TRUNCLEN GET LENGTH OF SHORTEST FORM OF OPTION 00285000
- LA R2,OPT NOW POINT TO FULL FORM. 00286000
- DROP R2 00287000
- TRYNEXT CLI 0(R4),X'FF' IS/WAS THIS THE LAST PARAMETER? 00288000
- BCR 8,R11 YES, THEN ON TO THE MAIN ROUTINE. 00289000
- CLI 0(R4),C')' IS THIS GUY A PARENTHESIS NUT? 00290000
- BNE NOTEND NO. 00291000
- CLI 8(R4),X'FF' YES...DID HE SLIP IN AN EXTRA FIELD? 00292000
- BCR 8,R11 NO. THEN, WE'RE DONE. 00293000
- LA R1,8(,R4) WELL, THAT'S NOT TOO GOOD. 00294000
- B ERR1 GIVE HIM A SLAP ON THE WRIST. 00295000
- NOTEND LR R3,R10 GET MAXIMUM SCAN LENGTH. 00296000
- LR R5,R3 ...FOR BOTH. 00297000
- CLCL R2,R4 SCAN AWAY. 00298000
- BE MATCH IF EQUAL, GO HANDLE. 00299000
- CLI 0(R4),C' ' ALMOST EQUAL? 00300000
- BE MAYBEOK YES. GO SEE IF IT IS ENOUGH. 00301000
- WASNT AR R4,R5 POINT TO THE END OF THE SCANNED OPTION. 00302000
- SR R4,R10 NOW BACKUP SO THAT WE CAN TRY AGAIN. 00303000
- AR R2,R3 POINT TO END OF THE OPTION IN THE TABLE 00304000
- IC R6,2(,R2) GET MINIMUM LENGTH OF NEXT TABLE ENTRY. 00305000
- BXLE R2,R8,TRYNEXT WHIP THROUGH THE TABLE. 00306000
- B ERR4 NOW GO SHOW HIM WHAT HE ENTERED. 00309000
- MAYBEOK AR R6,R5 ADD SCANNED LENGTH TO MINIMUM REQUIRED. 00310000
- CR R10,R6 COMPARE TO MAXIMUM TOKEN LENGTH. 00311000
- BL WASNT IF IT IS LOW, THERE IS NO MATCH. 00312000
- MATCH AR R4,R5 POINT TO THE NEXT OFFERING. 00313000
- AR R2,R3 POINT TO OFFSET FOR SPECIFIC HANDLER. 00314000
- SR R3,R3 SET UP A SIGNAL REGISTER. 00315000
- LH R2,0(,R2) NOW LOAD IT 00316000
- AR R2,R12 AND TURN IT INTO SOMETHING USEFUL. 00317000
- BALR R2,R2 GO THERE. 00318000
- LTR R3,R3 ANYTHING REALLY HAPPEN OUT THERE? 00319000
- BZ SCANON ONLY A FLAG WAS SET ON THIS PASS. 00320000
- CR R15,R3 ANYTHING NEW OR BIGGER? 00321000
- BNL SCANON NOPE. THEN WE'LL KEEP THE OLD SETTINGS. 00322000
- LR R15,R3 OH, THEN WE BETTER SAVE THE NEW LENGTH. 00323000
- LR R14,R6 ...AND THE NEW ENTRY ADDRESS. 00324000
- B SCANON NOW WE CAN GO BACK FOR MORE. 00325000
- EJECT 00326000
- *********************************************************************** 00327000
- * 00328000
- * OPTION HANDLING ROUTINES 00329000
- * 00330000
- *********************************************************************** 00331000
- SPACE 2 00332000
- ALLOC LA R3,44 don't truncate "BLOCKS" HRC320DS 00333000
- LA R6,PREC 00334000
- BR R2 00335000
- SPACE 00336000
- APPEND TM FLAG,CMSEXEC 00337000
- BO ERR7 00338000
- OI FLAG,APPND 00339000
- BR R2 00340000
- SPACE 00341000
- DT LA R3,61 HRC005DS 00342490
- LA R6,PTIM 00343000
- BR R2 00344000
- SPACE 00345000
- SHORTDAT EQU * HRC005DS 00345040
- TM FLAG2,FLG2ISO HRC005DS 00345080
- BO ERR8A HRC005DS 00345120
- TM FLAG2,FLG2FULL HRC005DS 00345160
- BO ERR8B HRC005DS 00345200
- OI FLAG2,FLG2SHRT HRC005DS 00345240
- B DT HRC005DS 00345280
- FULLDATE EQU * HRC005DS 00345320
- TM FLAG2,FLG2ISO HRC005DS 00345360
- BO ERR8C HRC005DS 00345400
- TM FLAG2,FLG2SHRT HRC005DS 00345440
- BO ERR8B HRC005DS 00345480
- OI FLAG2,FLG2FULL HRC005DS 00345520
- B DT HRC005DS 00345560
- ISODATE EQU * HRC005DS 00345600
- TM FLAG2,FLG2FULL HRC005DS 00345640
- BO ERR8C HRC005DS 00345680
- TM FLAG2,FLG2SHRT HRC005DS 00345720
- BO ERR8A HRC005DS 00345760
- OI FLAG2,FLG2ISO HRC005DS 00345800
- B DT HRC005DS 00345840
- EXEC TM FLAG,APPND 00346000
- BO ERR7 00347000
- OI FLAG,CMSEXEC 00348000
- BR R2 00349000
- SPACE 00350000
- FIFO EQU * HRC321DS 00350050
- OI FLAG2,FLG2STCK we are stacking output HRC321DS 00350100
- TM FLAG,HEAD header specified already? HRC321DS 00350150
- BO ERR8E yes, and this is a conflict HRC321DS 00350200
- OI FLAG,NOHEAD no header by default HRC321DS 00350250
- TM FLAG2,FLG2LIFI already processed LIFO/FIFO? HRC321DS 00350300
- BNO FIFO1 no, so FIFO is valid HRC321DS 00350350
- TM FLAG2,FLG2LIFO was the LIFO option specified? HRC321DS 00350400
- BO ERR8D yes, complain about it HRC321DS 00350450
- FIFO1 EQU * HRC321DS 00350500
- OI FLAG2,FLG2FIFO remember FIFO HRC321DS 00350550
- OI FLAG2,FLG2LIFI remember we did this HRC321DS 00350600
- BR R2 return HRC321DS 00350650
- SPACE 1 HRC321DS 00350700
- FM LA R3,22 00351000
- LA R6,PMOD 00352000
- BR R2 00353000
- SPACE 00354000
- FN LA R3,8 00355000
- LA R6,PNAM 00356000
- BR R2 00357000
- SPACE 00358000
- FMT LA R3,30 00359000
- LA R6,PFORM 00360000
- BR R2 00361000
- SPACE 00362000
- FT LA R3,17 00363000
- LA R6,PTYP 00364000
- BR R2 00365000
- SPACE 00366000
- HDR TM FLAG,NOHEAD 00367000
- BO ERR8 00368000
- TM FLAG2,FLG2STCK are we stacking output? HRC321DS 00368100
- BNO HDR2 no, proceed HRC321DS 00368200
- TM FLAG2,FLG2FIFO was the FIFO option specified? HRC321DS 00368300
- BO ERR8E yes, complain about it HRC321DS 00368400
- TM FLAG2,FLG2LIFO was the LIFO option specified? HRC321DS 00368500
- BO ERR8F yes, complain about it HRC321DS 00368600
- HDR2 EQU * HRC321DS 00368700
- OI FLAG,HEAD 00369000
- NI FLAG,255-HEADINIT V0027 00369100
- BR R2 00370000
- SPACE 00371000
- LABEL LA R3,69 better formatted header HRC320DS 00372490
- LA R6,PLAB 00373000
- BR R2 00374000
- SPACE 00375000
- LIFO EQU * HRC321DS 00375050
- OI FLAG2,FLG2STCK we are stacking output HRC321DS 00375100
- TM FLAG,HEAD header specified already? HRC321DS 00375150
- BO ERR8F yes, and this is a conflict HRC321DS 00375200
- OI FLAG,NOHEAD no header by default HRC321DS 00375250
- TM FLAG2,FLG2LIFI already processed LIFO/FIFO? HRC321DS 00375300
- BNO LIFO1 no, so LIFO is valid HRC321DS 00375350
- TM FLAG2,FLG2FIFO was the FIFO option specified? HRC321DS 00375400
- BO ERR8D yes, complain about it HRC321DS 00375450
- LIFO1 EQU * HRC321DS 00375500
- NI FLAG2,255-FLG2FIFO replace STACK default (FIFO) HRC321DS 00375550
- OI FLAG2,FLG2LIFO remember LIFO HRC321DS 00375600
- OI FLAG2,FLG2LIFI remember we did this HRC321DS 00375650
- BR R2 return HRC321DS 00375700
- SPACE 1 HRC321DS 00375750
- NOHDR TM FLAG,HEAD 00376000
- BO ERR8 00377000
- OI FLAG,NOHEAD 00378000
- NI FLAG,255-HEADINIT V0027 00378100
- BR R2 00379000
- SPACE 1 HRC321DS 00379050
- STACK EQU * HRC321DS 00379100
- TM FLAG2,FLG2STCK FIFO or LIFO already handled? HRC321DS 00379150
- BO R2 no further work required HRC321DS 00379200
- TM FLAG,HEAD header specified already? HRC321DS 00379250
- BO ERR8G yes, and this is a conflict HRC321DS 00379300
- OI FLAG,NOHEAD no header by default HRC321DS 00379350
- OI FLAG2,FLG2STCK we are stacking output HRC321DS 00379400
- OI FLAG2,FLG2FIFO stack FIFO by default HRC321DS 00379450
- BR R2 return HRC321DS 00379500
- EJECT 00380000
- *********************************************************************** 00381000
- * 00382000
- * OPTION TABLE 00383000
- * 00384000
- *********************************************************************** 00385000
- SPACE 00386000
- FIRSTENT OPTION EXEC 00387000
- SPACE 00388000
- OPTION APPEND,2 00389000
- SPACE 00390000
- OPTION NOHEADER,3,NOHDR 00391000
- SPACE 00392000
- OPTION FNAME,2,FN 00393000
- SPACE 00394000
- OPTION FTYPE,2,FT P0132 00395000
- SPACE 00396000
- OPTION FORMAT,2,FMT P0132 00397000
- SPACE 00398000
- OPTION DATE,,DT 00399000
- SPACE 00400000
- OPTION SHORTDAT,3 HRC005DS 00400100
- SPACE , HRC005DS 00400200
- OPTION ISODATE,3 HRC005DS 00400300
- SPACE , HRC005DS 00400400
- OPTION FULLDATE,3 HRC005DS 00400500
- SPACE , HRC005DS 00400600
- OPTION ALLOC,2 00401000
- SPACE 00402000
- OPTION LABEL 00403000
- SPACE 00404000
- OPTION FIFO HRC321DS 00404050
- SPACE 1 HRC321DS 00404100
- OPTION LIFO HRC321DS 00404150
- SPACE 1 HRC321DS 00404200
- OPTION STACK HRC321DS 00404250
- SPACE 1 HRC321DS 00404300
- OPTION FMODE,2,FM P0132 00405000
- SPACE 00406000
- LASTENT OPTION HEADER,,HDR 00407000
- EJECT 00408000
- NAMESTAR MVC NAME1(8),=CL8'*' MOVE IN THE DEFAULT FILENAME. 00409000
- TYPESTAR MVC NAME2(8),=CL8'*' MOVE IN THE DEFAULT FILETYPE. 00410000
- JOIN LTR R15,R15 WERE ANY FORMATTING OPTIONS SPECIFIED? 00411000
- BNZ JOIN0 IF YES, SKIP THE DEFAULTS. 00412000
- IC R15,DFLTLEN GET THE DEFAULT PRINT LENGTH. 00413000
- L R14,DFLTENT GET THE DEFAULT PRINT ENTRY ADDRESS. 00414000
- JOIN0 STC R15,PRINTLEN SAVE THE PRINT LENGTH. 00415000
- STC R15,DTYPELEN ALSO, PUT IT IN THE PLIST. 00416000
- LR R11,R14 SAVE THE PRINT ROUTINE ENTRY. 00417000
- MVI TYPLOC,C' ' ... 00418000
- MVC TYPLOC+1(72),TYPLOC CLEAR THE BUFFER P3091 00419000
- SR R9,R9 EMPTY A REGISTER. 00420000
- TM FLAG,USERMODE DEFAULT MODE? V0042 00420100
- BNO POINTA YES. V0042 00420150
- CLI DESMODE+1,C' ' WAS MODE-NUMBER BLANK? 00421000
- BE JOIN1 IF SO, SKIP THE CHECKING. 00422000
- CLI DESMODE+1,C'0' IS IT LESS THAN ZERO? 00423000
- BL ERR6A ERROR, IF IT IS. 00424000
- CLI DESMODE+1,C'5' HIGHEST ALLOWABLE P0724 00425000
- BH ERR6A WRONG, IF HIGHER. 00426000
- OI FLAG,MODENUM SIGNAL THAT MODE MUST MATCH. 00427000
- JOIN1 CLI DESMODE,C'*' WAS AN ASTERISK SPECIFIED? P0724 00428000
- BNE CKLET NO. THEN KEEP CHECKING. P0724 00429000
- TM FLAG,MODENUM WAS A MODE-NUMBER SPECIFIED? 00430000
- BO ERR6A THAT'S NOT ALLOWED. 00431000
- POINTA LA R1,DMODE-24 POINT TO A MODE-LETTER OF 'A'. V0042 00432100
- B SEARCH GO GET A(ADT) 00433000
- CKLET CLI DESMODE,C'A' COMPARE AGAINST MODE OF A. P0724 00434000
- BL ERR6A ERROR IF LOW. P0724 00435000
- CLI DESMODE,C'I' COMPARE AGAINST MODE OF I. HRC002DS 00436690
- BNH FINDIT ERROR IF HIGH. HRC002DS 00437380
- CLI DESMODE,C'J' COMPARE AGAINST MODE OF J. HRC002DS 00438070
- BL ERR6A ERROR IF LOW. HRC002DS 00438760
- CLI DESMODE,C'R' COMPARE AGAINST MODE OF R. HRC002DS 00439450
- BNH FINDIT OK IT IF HIGH. HRC002DS 00440140
- CLI DESMODE,C'S' COMPARE AGAINST MODE OF S. HRC002DS 00440830
- BL ERR6A ERROR IF LOW. HRC002DS 00441520
- CLI DESMODE,C'Z' COMPARE AGAINST MODE OF Z. HRC002DS 00442210
- BH ERR6A ERROR IF HIGH. HRC002DS 00442900
- FINDIT LA R1,DESMODE-24 POINT TO SUPPLIED MODE-LETTER. 00444000
- SEARCH L R15,VCADTLKP GET ADDRESS OF DMSLAD. @VM03093 00445100
- BALR R14,R15 GO THERE. 00446000
- BNZ ERR6A ERROR, IF NOT FOUND. 00447000
- LR R9,R1 SAVE ADDRESS OF THE ADT. 00448000
- CLI DESMODE,C'*' WAS MODE AN ASTERISK? 00449000
- BE TESTAPP WE'RE OK THEN. 00450000
- USING ADTSECT,R9 00451000
- TM ADTFLG1,ADTFRO+ADTFRW IS THE DISK ACCESSED? 00452000
- BNZ TESTAPP YES, BRANCH @VA04384 00453100
- TM ADTFLG2,ADTFROS CMS DISK ? @VA04384 00453200
- BO ERR6A NO, INVALID MODE MESSAGE @VA04384 00453300
- B ERR3 DISK ISN'T ACCESSED @VA04384 00453400
- DROP R9 00454000
- TESTAPP TM FLAG,APPND WAS APPEND SPECIFIED? 00455000
- BO SETAPP DON'T ERASE 'CMS EXEC', IF IT WAS. 00456000
- TM FLAG,CMSEXEC WAS EXEC SPECIFIED? 00457000
- BNO JOIN2 SKIP THE FOLLOWING, IF NOT. 00458000
- LA R1,ERASEP POINT TO THE ERASE PLIST. 00459000
- L R15,AERASE GO ERASE 'CMS EXEC A1' @V305066 00460000
- SSM OK00 ALLOW INTERRUPTS @VA06227 00460050
- BALR R14,R15 (IF ANY) @V305066 00460100
- SSM OK81 DON'T ALLOW INTERRUPTS @VA06227 00461000
- SETAPP MVC TYPECMS(LWRB),DWRBUF SET UP THE WRBUF PLIST. 00462000
- MVC ERRADDR(4),=A(ERR9) BE PREPARED FOR WRBUF ERROR. P3017 00463000
- LA R1,DMODE-24 POINT TO MODE-LETTER 'A'. 00464000
- L R15,VCADTLKP GET ADDRESS OF DMSLAD. @VM03093 00465100
- BALR R14,R15 GO THERE. 00466000
- USING ADTSECT,R1 00467000
- TM ADTFLG1,ADTFRO+ADTFRW IS THE A DISK ACCESSED @VA14113 00467500
- BNZ ADISK YES. @VA14113 00467520
- MVC DESMODE(2),DMODE SET UP A MODE IN MSG. @VA14113 00467540
- B ERR3 A DISK ISN'T ACCESSED. @VA14113 00467560
- ADISK EQU * @VA14113 00467580
- TM ADTFLG1,ADTFRW IS THE A-DISK READ-WRITE? 00468000
- BNO ERR5 MUST BE...SO, ERROR, IF NOT. 00469000
- B JOIN3A GET COMMON, NOW. V0028 00470100
- DROP R1 00471000
- JOIN2 MVC TYPECMS(16),DTYPECMS SET UP TYPLIN PLIST. 00472000
- JOIN3A CLI DESMODE,C'*' WAS MODE AN ASTERISK? 00477000
- USING ADTSECT,R9 00478000
- BNE JOIN6 NO? THEN GO SEE WHAT IS THERE. 00479000
- LA R13,ADTFRO+ADTFRW SIGNAL THAT WE'LL TAKE ANYTHING. 00480000
- B CKSTAT CHECK IT OUT. 00481000
- JOIN4 LR R1,R9 GET THE LAST ADDRESS. 00482000
- JOIN5 L R15,VCADTNXT SET UP TO FIND NEXT. @VM03093 00483100
- BALR R14,R15 NOW, GO FIND IT. 00484000
- BNZ FINI ALL DONE IF COND. CODE IS NON-ZERO. 00485000
- LR R9,R1 SAVE THAT ADDRESS. 00486000
- CKSTAT EX R13,DTM IS IT THE KIND WE'RE LOOKING FOR? 00487000
- BZ JOIN5 IF NOT, KEEP TRYING. 00488000
- JOIN6 L R6,ADTFDA START WITH THE FIRST HYPERBLOCK. 00489000
- SR R3,R3 EMPTY OUT A REGISTER. 00490000
- SR R7,R7 AND ANOTHER. 00491000
- L R4,0(,R6) SET INDICES FOR BXLE-LOOP. 00492000
- L R5,4(,R6) ... 00493000
- SR R5,R4 ... 00494000
- LA R6,8(,R6) SET POINTER TO START OF TABLE. 00495000
- LOOP CL R7,0(R6,R3) IS THERE AN ENTRY? 00496000
- BE BUMP NO. GO TRY ANOTHER ONE. 00497000
- LA R8,0(R6,R3) GET ACTUAL ADDRESS. 00498000
- TM FLAG,MODENUM CARE ABOUT MODE-NUMBERS? 00499000
- BNO CLINAM NO. HOW 'BOUT FILENAMES? 00500000
- CLC 25(1,R8),DESMODE+1 DOES THE NUMBER MATCH? 00501000
- BNE BUMP NO...TRY ANOTHER. 00502000
- CLINAM CLI NAME1,C'*' ANY FILENAME DO? 00503000
- BE WHATYPE YES. HOW 'BOUT FILETYPE? 00504000
- COMNAME CLC NAME1(8),0(R8) IS WHAT WE'VE GOT, WHAT HE WANTS? 00505000
- BNE BUMP NOPE. TRY AGAIN. 00506000
- WHATYPE CLI NAME2,C'*' ANYONE CARE WHAT THE FILETYPE IS? 00507000
- BE PRINT NO? LET'S SHOW THIS ONE,THEN. 00508000
- COMTYPE CLC NAME2(8),8(R8) DOES THE TYPE MATCH? 00509000
- BE PRINT YES. SHOW IT. 00510000
- BUMP BXLE R3,R4,LOOP KEEP LOOKING. 00511000
- L R6,0(R6,R3) IS THERE AN EXTENSION? 00512000
- SR R3,R3 INITIALIZE (JUST IN CASE) 00513000
- LTR R6,R6 WELL? 00514000
- BNZ LOOP SEARCH THROUGH EXTENSION. 00515000
- CLI DESMODE,C'*' ANY MODE DO? 00516000
- BE JOIN4 YES. LET'S FIND ANOTHER. 00517000
- TM FLAG,FOUNDIT DID WE EVER FIND ANYTHING? 00520000
- BO DONE YES. LET'S FINISH UP THEN. 00521000
- B ERR2 TSK. TSK. 00522000
- SPACE 00523000
- DTM TM ADTFLG1,*-* EXECUTED MODE CHECKER 00524000
- EJECT 00525000
- PRINT TM FLAG,NOHEAD+FOUNDIT HAVE WE COME THIS WAY BEFORE? 00526000
- BC 5,HEADN SKIP THIS STUFF IF WE HAVE. 00527000
- CLI TYPECMS,C'W' ARE WE WRBUF'ING? 00528000
- BE HEADN YES, NO HEADING REQUIRED. 00529000
- TM FLAG,HEADINIT ANY USER HEADING REQUEST. V0027 00530100
- BNO PHEAD IF SO, HONOR IT. V0027 00530150
- CLI PRINTLEN,X'16' DO WE EXCEED STANDARD V0027 00530200
- BNH HEADN OK THEN. V0027 00530250
- PHEAD SR R1,R1 SIGNAL V0027 00530300
- IC R1,PRINTLEN GET HEADING LENGTH. 00531000
- EX R1,HDMVC PUT HEADING INTO BUFFER. 00532000
- LA R1,TYPECMS LOAD ADDRESS OF PLIST. 00533000
- SPACE 1 HRC321DS 00533050
- TM FLAG2,FLG2FIFO should we stack header instead? HRC321DS 00533100
- BO PRNFIFO yes, FIFO HRC321DS 00533150
- TM FLAG2,FLG2LIFO should we stack header LIFO? HRC321DS 00533200
- BNO PRINTIT no, just type it HRC321DS 00533250
- MVC FIFOLIFO(4),=C'LIFO' HRC321DS 00533300
- B PRSTACK HRC321DS 00533350
- PRNFIFO EQU * HRC321DS 00533400
- MVC FIFOLIFO(4),=C'FIFO' HRC321DS 00533450
- PRSTACK EQU * set up the parameter list HRC321DS 00533500
- MVC STACKLEN(1),CHARB+3 HRC321DS 00533550
- MVC STACKADR(3),BUFLOC HRC321DS 00533600
- LA R1,STACK HRC321DS 00533650
- SPACE 1 HRC321DS 00533700
- PRINTIT EQU * HRC321DS 00533750
- SVC X'CA' TYPE! 00534000
- MVI MODE-1,C' ' NOW CLEAN UP... 00535000
- MVC MODE(57),MODE-1 ... THE BUFFER. 00536000
- HEADN CLC CMSX(16),0(R8) WAS IT 'CMS EXEC'? 00537000
- BNE OTHER NO? NO SWET. 00538000
- CLI ADTM,C'A' ON THE 'A' DISK? @VA03537 00538100
- BNE OTHER NOPE, ALL RIGHT @VA03537 00538200
- CLI TYPECMS,C'W' ARE WE WRITING AN EXEC FILE? 00539000
- BE BUMP O FIND SOMETHING ELSE. 00540000
- OTHER MVC DATE(15),DATE-1 CLEAR OUT END OF BUFFER. 00541000
- OI FLAG,FOUNDIT BRAG ABOUT FINDING SOMETHING. 00542000
- BR R11 GO TO THE WRITE PLACE. 00543000
- * 00544000
- PLAB EQU * HRC005DS 00545290
- MVC VOLID(6),ADTID MOVE IN THE VOLUME LABEL. HRC005DS 00545580
- PTIM EQU * TIME 00546000
- LA R10,TIME SET REC BUFFER HRC005DS 00546500
- LA R1,18(,R8) SET TIME LOCATION 00547000
- LA R14,TPATRN SET PATTERN BUFFER 00549000
- CLI 0(R1),X'24' VALID TIME? 00552000
- BNH NOTIME1 VALID. 00553000
- NOTIME SR R1,R1 SIGNAL INVALID TIME. BLANK OUT. 00554000
- NOTIME1 BAL R15,VERIFY GO VERIFY LEGIT TIME 00555000
- PDATE EQU * 00556000
- LA R1,16(,R8) 00562000
- LA R10,CHARDATE HRC005DS 00563490
- LA R14,DPATRN 00564000
- CLI 0(R1),1 CHECK VALID DATE. 00565000
- BL NODATE BAD MONTH 00566000
- CLI 0(R1),X'12' GREATER THAN YULETIDE? NEVER! 00567000
- BNH NODATE1 VALID MONTH 00568000
- NODATE MVC CHARDATE(9),=C' 00000000' INVALID DATE HRC005DS 00569290
- B PDATE1 HRC005DS 00569580
- NODATE1 BAL R15,VERIFY 00570000
- MVC CHARDATE+5(2),=C'19' ASSUME 20TH CENTURY HRC005DS 00570040
- MVC CHARDATE+7(2),38(R8) HRC005DS 00570080
- CLI 38(R8),C'5' DATES BEFORE 1960 ARE 21ST CENTURHRC005DS 00570120
- BH PDATE1 GOT CENTURY HRC005DS 00570160
- MVC CHARDATE+5(2),=C'20' MAKE IT 21ST CENTURY HRC005DS 00570200
- PDATE1 EQU * HRC005DS 00570240
- MVI DATE+2,C'/' HRC005DS 00570280
- MVI DATE+5,C'/' HRC005DS 00570320
- MVC DATE(2),CHARDATE+1 MM HRC005DS 00570360
- MVC DATE+3(2),CHARDATE+3 DD HRC005DS 00570400
- TM FLAG2,FLG2FULL+FLG2ISO IS THIS A LONG DATE HRC005DS 00570440
- BNZ PDATEFUL CHECK FULLDATE HRC005DS 00570480
- MVC DATE+6(2),CHARDATE+7 YY HRC005DS 00570520
- B PREC HRC005DS 00570560
- PDATEFUL TM FLAG2,FLG2FULL HRC005DS 00570600
- BNO PDATEISO HRC005DS 00570640
- MVC DATE+6(4),CHARDATE+5 CCYY HRC005DS 00570680
- B PREC HRC005DS 00570720
- PDATEISO MVI DATE+4,C'-' CCYY-MM-DD HRC005DS 00570760
- MVI DATE+7,C'-' HRC005DS 00570800
- MVC DATE+0(4),CHARDATE+5 CCYY HRC005DS 00570840
- MVC DATE+5(2),CHARDATE+1 MM HRC005DS 00570880
- MVC DATE+8(2),CHARDATE+3 DD HRC005DS 00570920
- PREC EQU * NO. OF RECORDS 00571000
- LH R1,36(,R8) GET THE NUMBER OF DATA BLOCKS 00572000
- N R1,=X'0000FFFF' NO PROPAGATED BITS FROM 'LH' 00573000
- CVD R1,DEC CONVERT IT TO DECIMAL 00574000
- MVC NOREC(6),RPATRN CORRECT PATTERN FOR NO. REC. 00575000
- ED NOREC(6),DEC+5 EDIT UP TO 5 DIGITS (WORST CASE) 00576000
- PITEM EQU * 00577000
- LH R1,26(,R8) GET THE NO OF ITEMS 00578000
- N R1,=X'0000FFFF' NO SIGN 00579000
- CVD R1,DEC CONVERT 00580000
- MVC ITM(6),RPATRN MOVE PATTERN 00581000
- ED ITM(6),DEC+5 AND EDIT 00582000
- PFORM EQU * 00583000
- LH R1,34(,R8) AND GET WIDTH 00584000
- N R1,=X'0000FFFF' THROW OUT JUNK 00585000
- CVD R1,DEC AND CONVERT 00586000
- MVC FORM+1(6),RPATRN MOVE PATTERN 00587000
- ED FORM+1(6),DEC+5 AND EDIT 00588000
- MVC FORM(1),30(R8) SET THE FORMAT 00589000
- PMOD MVC MODE(2),24(R8) MOVE IN THE MODE 00590000
- MVC MODE(1),ADTM REPLACE MODE-LETTER BY DISK-TABLE MODE 00591000
- PTYP MVC TYPE(8),8(R8) MOVE IN THE TYPE 00592000
- PNAM MVC NAME(8),0(R8) MOVE IN THE NAME 00593000
- LA 1,TYPECMS SET PARAMETER LIST 00594000
- SPACE 1 HRC321DS 00594050
- TM FLAG2,FLG2FIFO should we stack line instead? HRC321DS 00594100
- BO STKFIFO yes, FIFO HRC321DS 00594150
- TM FLAG2,FLG2LIFO should we stack line LIFO? HRC321DS 00594200
- BNO TYPEIT no, just type it HRC321DS 00594250
- MVC FIFOLIFO(4),=C'LIFO' HRC321DS 00594300
- B STACKLN HRC321DS 00594350
- STKFIFO EQU * HRC321DS 00594400
- MVC FIFOLIFO(4),=C'FIFO' HRC321DS 00594450
- STACKLN EQU * HRC321DS 00594500
- MVC STACKLEN(1),CHARB+3 HRC321DS 00594550
- MVC STACKADR(3),BUFLOC HRC321DS 00594600
- LA R1,STACKPL HRC321DS 00594650
- SPACE 1 HRC321DS 00594700
- TYPEIT EQU * HRC321DS 00594750
- CNOP 2,4 P3017 00595000
- SVC X'CA' 00596000
- ERRADDR DC AL4(*+4) P3017 00597000
- B BUMP CONTINUE SEARCH 00598000
- * 00599000
- VERIFY EQU * VERIFY LEGITIMATE TIME AND DATE CODES 00600000
- LTR R1,R1 VALID CODES. 00601000
- BCR 8,R15 IF NOT (R1=0), EXIT (LEAVE BLANKS THERE) 00602000
- VER1 MVC 0(6,R10),0(R14) MOVE IN CORRECT PATTERN 00603000
- ED 0(6,R10),0(R1) EDIT TIME OR DATE 00604000
- BR R15 00605000
- SPACE 00606000
- HDMVC MVC TYPLOC(1),HEADMS 00607000
- SPACE 00608000
- FINI TM FLAG,FOUNDIT WAS FILE FOUND? 00609000
- BNO ERR2 00610000
- DONE SR R11,R11 CLEAR ERROR INDICATOR IN R11, 00611000
- CLI TYPECMS,C'W' DID WE 'WRBUF' CMS EXEC ? 00612000
- BNE GETOUT IF NOT, FORGET IT. 00613000
- MVC TYPECMS(8),=CL8'FINIS' IF YES, CLOSE CMS EXEC FILE. 00614000
- LA 1,TYPECMS ... 00615000
- SVC X'CA' ... 00616000
- DC AL4(*+4) ... 00617000
- * 00618000
- GETOUT L R14,RETREG RESTORE R14 = RETURN-REGISTER 00619000
- LR R15,R11 ERROR INDICATOR INTO R15, 00620000
- BR R14 AND 'PUNT', ALL FINISHED. 00621000
- * 00622000
- EJECT 00623000
- *********************************************************************** 00624000
- * 00625000
- * ERROR PROCESSING ROUTINES AND MESSAGES 00626000
- * 00627000
- ********************************************************************** 00628000
- SPACE 00629000
- ERR1 LR R4,R1 00630000
- LA R13,70 00631000
- LA R6,BADPARM 00632000
- LA R11,24 RET CODE OF 24 @VA09741 00633000
- B TELLALL 00634000
- SPACE 00635000
- ERR2 LA R13,2 00636000
- LA R6,NTFND 00637000
- LA R11,28 00638000
- CLI SAVEDR1,X'0B' LISTFILE called from cmd line? HRC309DS 00639100
- BE TELL yes, issue error message HRC309DS 00639200
- CLI SAVEDR1,X'0D' from EXEC with '&CONTROL MSG'? HRC309DS 00639300
- BE TELL yes, issue error message HRC309DS 00639400
- B GETOUT NO MSG IF CALLED AS A FUNCTION, @VM01710 00639500
- * OR FROM EXEC WITH '&CONTROL NOMSG' ON. 00639600
- SPACE 00640000
- ERR3 LA R13,69 00641000
- LA R11,36 00642000
- MVC ACCMSG+6(1),DESMODE 00643000
- LA R6,NOTACC 00644000
- B TELL 00645000
- SPACE 00646000
- ERR4 LA R13,3 00647000
- LA R11,24 00648000
- LA R6,BADOPT 00649000
- B TELLALL 00650000
- SPACE 00651000
- ERR5 LA R13,37 00652000
- LA R11,36 00653000
- LA R6,NOTWR 00654000
- B TELL 00655000
- SPACE 00656000
- ERR6A LA R1,DESMODE 00657000
- ERR6 LR R4,R1 00658000
- LA R11,24 00659000
- LA R13,48 00660000
- LA R6,BADMODE 00661000
- B TELLALL 00662000
- SPACE 00663000
- ERR7 LA R6,CONFLCT1 00664000
- B ERRCNFLC HRC005DS 00665990
- SPACE 00668000
- ERR8 LA R6,CONFLCT2 00669000
- B ERRCNFLC HRC005DS 00670090
- SPACE , HRC005DS 00670180
- ERR8A LA R6,CONFLCT3 HRC005DS 00670270
- B ERRCNFLC HRC005DS 00670360
- SPACE , HRC005DS 00670450
- ERR8B LA R6,CONFLCT4 HRC005DS 00670540
- B ERRCNFLC HRC005DS 00670630
- SPACE , HRC005DS 00670720
- ERR8C LA R6,CONFLCT5 HRC005DS 00670810
- B ERRCNFLC HRC321DS 00670820
- ERR8D LA R6,CONFLCT6 FIFO and LIFO conflict HRC321DS 00670830
- B ERRCNFLC HRC321DS 00670840
- ERR8E LA R6,CONFLCT7 FIFO and HEADER conflict HRC321DS 00670850
- B ERRCNFLC HRC321DS 00670860
- ERR8F LA R6,CONFLCT8 LIFO and HEADER conflict HRC321DS 00670870
- B ERRCNFLC HRC321DS 00670880
- ERR8G LA R6,CONFLCT9 STACK and HEADER conflict HRC321DS 00670890
- ERRCNFLC LA R11,24 HRC005DS 00670900
- LA R13,66 HRC005DS 00670990
- SPACE 2 00672000
- TELL DMSERR MF=(E,ERRLIST1),TEXTA=(6),LET=E,NUM=(13) 00673000
- SPACE 00674000
- B GETOUT 00675000
- SPACE 2 00676000
- TELLALL DMSERR MF=(E,ERRLIST1),TEXTA=(6),LET=E,NUM=(13), X00677000
- SUB=(CHARA,(4)) 00678000
- B GETOUT 00679000
- SPACE 00680000
- ERR9 DMSERR NUM=105,LET=S,SUB=(DEC,(15)), X00681000
- TEXT='Error ''..'' writing file ''CMS EXEC A1'' on disk' 00682000
- LA R11,100 P3017 00683000
- B GETOUT P3017 00684000
- SPACE 00685000
- * ERROR MESSAGES AND LENGTHS 00686000
- SPACE 00687000
- NOTWR DC AL1(L'WRMSG) 00688000
- WRMSG DC C'Disk ''A'' is read-only' HRC321DS 00689000
- * 00690000
- NTFND DC AL1(L'NTFNDMSG) 00691000
- NTFNDMSG DC C'File not found' HRC321DS 00692000
- * 00693000
- NOTACC DC AL1(L'ACCMSG) 00694000
- ACCMSG DC C'Disk ''Z'' not accessed' HRC321DS 00695000
- * 00696000
- BADPARM DC AL1(L'PARMSG) 00697000
- PARMSG DC C'Invalid parameter ''........''' HRC321DS 00698000
- * 00699000
- BADOPT DC AL1(L'OPTMSG) 00700000
- OPTMSG DC C'Invalid option ''........''' HRC321DS 00701000
- * 00702000
- BADMODE DC AL1(L'MODEMSG) 00703000
- MODEMSG DC C'Invalid filemode ''........''' HRC321DS 00704000
- * 00705000
- CONFLCT1 DC AL1(L'CONFMSG1) 00706000
- CONFMSG1 DC C'''APPEND'' and ''EXEC'' are conflicting options' 00707000
- * 00708000
- CONFLCT2 DC AL1(L'CONFMSG2) 00709000
- CONFMSG2 DC C'''HEADER'' and ''NOHEADER'' are conflicting options' 00710000
- * HRC005DS 00710090
- CONFLCT3 DC AL1(L'CONFMSG3) HRC005DS 00710180
- CONFMSG3 DC C'''SHORTDATE'' and ''ISODATE'' are conflicting options'*00710270
- , HRC005DS 00710360
- CONFLCT4 DC AL1(L'CONFMSG4) HRC005DS 00710450
- CONFMSG4 DC C'''SHORTDATE'' and ''FULLDATE'' are conflicting options*00710540
- ' , HRC005DS 00710630
- CONFLCT5 DC AL1(L'CONFMSG5) HRC005DS 00710720
- CONFMSG5 DC C'''FULLDATE'' and ''ISODATE'' are conflicting options' *00710810
- , HRC005DS 00710900
- CONFLCT6 DC AL1(L'CONFMSG6) HRC321DS 00710905
- CONFMSG6 DC C'''FIFO'' and ''LIFO'' are conflicting options' 00710910
- * HRC321DS 00710915
- CONFLCT7 DC AL1(L'CONFMSG7) HRC321DS 00710920
- CONFMSG7 DC C'''FIFO'' and ''HEADER'' are conflicting options' 00710925
- * HRC321DS 00710930
- CONFLCT8 DC AL1(L'CONFMSG8) HRC321DS 00710935
- CONFMSG8 DC C'''LIFO'' and ''HEADER'' are conflicting options' 00710940
- * HRC321DS 00710945
- CONFLCT9 DC AL1(L'CONFMSG9) HRC321DS 00710950
- CONFMSG9 DC C'''STACK'' and ''HEADER'' are conflicting options' 00710955
- SPACE 2 00711000
- ERRLIST1 DMSERR MF=L 00712000
- SPACE 2 00713000
- EJECT 00714000
- *********************************************************************** 00715000
- * 00716000
- * STORAGE AREA AND DEFINITIONS 00717000
- * 00718000
- ********************************************************************** 00719000
- SPACE 00720000
- SPACE 00721000
- HEADMS DC C'Filename Filetype Fm Format Recs Blocks ' V0027 00722100
- HEADATE2 DC C' Date Time Label ' HRC320DS 00723040
- DS 0F 00724000
- DTYPECMS DC CL8'TYPLIN' 00725000
- DC AL1(1) 00726000
- DC AL3(TYPLOC) 00727000
- DC C'B' 00728000
- DC AL3(72) 00729000
- DTYPELEN EQU *-1 00730000
- * 00731000
- DS 0F PARAMETER-LIST TO ERASE OLD "CMS EXEC" .. 00732000
- ERASEP DC CL8'ERASE' ... 00733000
- CMSX DC CL8'CMS' ... 00734000
- DC CL8'EXEC' ... 00735000
- DMODE DC CL2'A ' ... 00736000
- * 00737000
- DS 0F PARAMETER-LIST TO 'WRBUF' NEW "CMS EXEC" 00738000
- DWRBUF DC CL8'WRBUF' ... 00739000
- DC CL8'CMS' 00740000
- DC CL8'EXEC' 00741000
- DC CL2'A1' 00742000
- DC H'0' 00743000
- DC A(TYPLOC-7) 00744000
- DC F'80' 00745000
- DC CL2'F' 00746000
- DC H'1' 00747000
- DC CL7' &&1 &&2 ' 00748000
- LWRB EQU *-DWRBUF (NO. OF BYTES FOR MOVING) 00749000
- * 00750000
- RPATRN DC X'402020202120' (FOR NUMBER OF ITEMS OR RECORDS) 00751000
- DPATRN DC X'F021202020' (FOR DATE .... HRC005DS 00752490
- TPATRN DC X'4021207A2020' ... AND TIME) HRC005DS 00752980
- CHARDATE DC C' MMDDCCYY' HRC005DS 00753470
- * 00754000
- SAVEDR1 DS 1F R1 AT INPUT SAVED HERE @VM01710 00754100
- RETREG DS 1F RETURN-LOCATION 00755000
- DEC DS 1D FOR DECIMAL NUMBER CONVERSION 00756000
- NAME1 DS 2F 00757000
- NAME2 DS 2F 00758000
- PRINTENT DS 1F 00759000
- PRINTLEN DS 1C 00760000
- SPACE 00761000
- * 'LIVE' TYPLIN OR WRBUF PARAMETER-LIST... 00762000
- DS 0F 00763000
- TYPECMS DC CL9' ' 00764000
- BUFLOC DC AL3(*-*) 00765000
- CHARB DC A(0) 00766000
- DC CL31' ' 00767000
- TYPLOC DC CL27' ' 00768000
- DC CL47' ' better formatted header HRC320DS 00769000
- PAD DC 4F'0' 00770000
- SPACE 1 HRC321DS 00770050
- * ATTN parameter list to stack the output HRC321DS 00770100
- DS 0F HRC321DS 00770150
- STACKPL DC CL8'ATTN' HRC321DS 00770200
- FIFOLIFO DS CL4 HRC321DS 00770250
- STACKLEN DS AL1 HRC321DS 00770300
- STACKADR DS AL3 HRC321DS 00770350
- * 00771000
- DESMODE DC CL8'A' V0205 00772100
- FLAGS DC F'0' HRC005DS 00773590
- FLAG EQU FLAGS,1 HRC005DS 00774180
- FLAG2 EQU FLAGS+1,1 HRC005DS 00774770
- FLAG3 EQU FLAGS+2,1 HRC005DS 00775360
- FLAG4 EQU FLAGS+3,1 HRC005DS 00775950
- * 00777000
- DFLTENT DC A(PMOD) 00778000
- DFLTLEN DC X'16' 00779000
- * 00780000
- OK81 DC X'81' 00781000
- OK00 DC X'00' @VA06227 00781500
- * 00782000
- NAME EQU TYPLOC HRC005DS 00783490
- TYPE EQU TYPLOC+9 00784000
- MODE EQU TYPLOC+18 better formatted header HRC320DS 00785000
- FORM EQU TYPLOC+22 better formatted header HRC320DS 00786990
- ITM EQU TYPLOC+30 don't truncate number of blocks HRC320DS 00787980
- NOREC EQU TYPLOC+37 don't truncate number of blocks HRC320DS 00788970
- DATE EQU TYPLOC+45 HRC005DS 00789960
- TIME EQU TYPLOC+55 HRC005DS 00790950
- VOLID EQU TYPLOC+63 better formatted header HRC320DS 00791940
- * 00793000
- * FLAG SETTINGS 00794000
- MODENUM EQU X'80' EXPLICIT MODENUMBER REFERENCE REQUIRED 00795000
- USERMODE EQU X'40' USER SPECIFIED MODE V0042 00796100
- HEAD EQU X'20' HEADING IS REQUIRED 00797000
- NOHEAD EQU X'10' HEADING IS TO BE SUPPRESSED 00798000
- APPND EQU X'08' APPEND TO EXISTING CMS EXEC FILE 00799000
- CMSEXEC EQU X'04' CMS EXEC FILE REQUESTED 00800000
- HEADINIT EQU X'02' HEADER INITIALIZATION FLAG. V0027 00801100
- FOUNDIT EQU X'01' NO FILE FOUND IF OFF 00802000
- * 00803000
- * FLAG2 SETTINGS HRC005DS 00803100
- FLG2ISO EQU X'80' ISO DATE WANTED YYYY-MM-DD HRC005DS 00803200
- FLG2SHRT EQU X'40' SHORT DATE WANTED MM/DD/YY HRC005DS 00803300
- FLG2FULL EQU X'20' FULL DATE WANTED MM/DD/YYYY HRC005DS 00803400
- FLG2STCK EQU X'10' stack results HRC321DS 00803420
- FLG2FIFO EQU X'08' stack results FIFO HRC321DS 00803440
- FLG2LIFO EQU X'04' stack results LIFO HRC321DS 00803460
- FLG2LIFI EQU X'02' LIFO or FIFO option handled HRC321DS 00803480
- * HRC005DS 00803500
- LTORG 00804000
- * 00805000
- TABIMAGE DSECT 00806000
- TRUNCLEN DS AL1 00807000
- OPTLEN DS AL1 00808000
- OPT DS CL8 00809000
- BRAD DS AL2 00810000
- EJECT 00811000
- NUCON 00812000
- ADT 00813000
- REGEQU 00814000
- END 00815000
ibm/vm370-lib/cms/dmslst.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator