DIR TITLE 'DMKDIR (CP) VM/370 - RELEASE 6' 00001000
*. 00002000
* MODULE NAME 00003000
* 00004000
* DMKDIR DIRECTORY CREATION MODULE 00005000
* 00006000
* FUNCTION 00007000
* 00008000
* TO BUILD A USER DIRECTORY ON A SYSTEM ONWED VOLUME 00009000
* USING PREALLOCATED CYLINDERS. A NEW DIRECTORY 00010000
* MAY BE BUILT SO AS NOT TO OVERLAY AN EXISTING 00011000
* DIRECTORY. THE USER MUST ALLOW SPACE FOR TWO 00012000
* DIRECTORIES OR ALLOCATE A NEW DIRECTORY EACH 00013000
* TIME THE DIRECTORY IS CREATED. THIS PROGRAM 00014000
* WILL RUN STAND-ALONE, WITH A CARD DECK AS INPUT. 00015000
* OR UNDER CMS USING A CMS FILE. 00016000
* 00017000
* THE INPUT WILL BE OF THE FOLLOWING FORMAT, WITH ONE 00018000
* OR MORE BLANKS AS DELIMITERS. ALL ENTRIES ARE 00019000
* POSITIONAL FROM LEFT TO RIGHT. IF ANY ENTRIES ARE 00020000
* DEFAULTED ALL REMAINING ENTRIES ON THAT INPUT LINE 00021000
* MUST BE DEFAULTED, WITH THE EXCEPTION OF THE 00022000
* OPTION STATEMENT, ITS ENTRIES ARE SELF DEFINING 00023000
* AND NOT POSITIONAL. 00024000
* 00025000
* IF ANY INPUT STATEMENT IS FOUND TO BE IN ERROR THE 00026000
* PROGRAM WILL CONTINUE TO BUILD THE DIRECTORY CHECKING 00027000
* ALL INPUT STATEMENTS FOR VALIDITY BEFORE TERMINATION. 00028000
* AFTER AN ABNORMOL TERMINATION OR AN EDIT RUN, 00029000
* THE OLD DIRECTORY WILL NOT BE ALTERED, AND THE NEW 00030000
* DIRECTORY WILL NOT BE IN EVIDENCE. 00031000
* 00032000
* IF RUNNING UNDER VM/370 A NORMAL COMPLETION WILL 00033000
* RESULT IN THE NEWLEY CREATED DIRECTORY BEING 00034000
* DYNAMICALLY SWAPPED, AND PLACED IN USE BY VM/370. 00035000
* PROVIDING THE USER'S CLASS IS A,B OR C AND THE 00036000
* DIRECTORY VOLUME IS PRESENT IN THE SYSTEM OWNED 00037000
* LIST. IN ETHER CASE THE DIRECTORY WILL HAVE BEEN 00038000
* UPDATED ON THE DIRECTORY VOLUME. 00039000
* 00040000
* ONLY COLUMN 1 TO 71 WILL BE INSPECTED BY THE 00041000
* PROGRAM. ALL DATA AFTER THE LAST POSSIBLE PARAMETER 00042000
* ON ANY STATEMENT, WILL BE IGNORED. ALSO BLANK STATEMENT 00043000
* AND STATEMENTS WITH THE FIRST PARAMETER AN * WILL ALSO 00044000
* BE IGNORED. 00045000
* 00046000
EJECT 00047000
* COMMAND LINE UNDER CMS 00048000
* 00049000
* +------------------------------------------------------+ 00050000
* | DIRECT <FILENAME <FILETYPE <FILEMODE>>> ( EDIT | 00051000
* +------------------------------------------------------+ 00052000
* 00053000
* THE DIRECT COMMAND WILL DEFAULT TO A CMS FILE 00054000
* IDENTIFICATION OF ' USER DIRECT * '. ANY OR ALL 00055000
* OF THE DEFAULT CAN BE OVERRIDEN BY THE COMMAND LINE. 00056000
* THE EDIT OPTION WILL ALLOW THE USER TO RUN THE 00057000
* PROGRAM WITHOUT UPDATING THE DIRECTORY ON DISK. 00058000
* 00059000
* +-----------------------------------+ 00060000
* | DIRECTORY CCU DEVTYPE VOLSER | 00061000
* | DIR | 00062000
* +-----------------------------------+ 00063000
* 00064000
* DIRECTORY STATEMENT DEFINES THE DEVICE ON WHICH THE DIRECTORY 00065000
* IS ALLOCATED. IT MUST BE THE FIRST STATEMENT. 00066000
* 00067000
* CCU THE DEVICE ADDRESS ON WHICH THE DIRECTORY 00068000
* WILL RESIDE. 00069000
* 00070000
* DEVTYPE 00071000
* 2314 00072000
* 2319 00073000
* 3340 00074000
* 3330 00075000
* 3350 00076000
* 3375 HRC106DK 00076100
* 3380 HRC106DK 00076200
* 2305 00077000
* 00078000
* VOLSER THE VOLUME SERIAL NUMBER OF THE DIRECTORY 00079000
* DEVICE. 00080000
* 00081000
* +-----------------------------------------------------------------+ 00082000
* | USER USERID PASS <STOR <MSTOR <CL <PRI <LE <LD <CD <ES >>>>>>>> | 00083000
* | U ON ON ON ON | 00084000
* | OFF OFF OFF OFF | 00085000
* +-----------------------------------------------------------------+ 00086000
* 00087000
* USER STATEMENT INITIATES A USER MACHINE BLOCK AND CREATES 00088000
* A USER DIRECTORY BLOCK. IT DELIMITS THE USER DIRECTORY 00089000
* ENTRIES FOR ONE USER. 00090000
* 00091000
* USERID ONE TO EIGHT CHARACTER USER ID 00092000
* 00093000
* PASS ONE TO EIGHT CHARACTER USER PASSWORD 00094000
* 00095000
* STOR ONE TO EIGHT DECIMAL DIGITS THAT IS THE 00096000
* VIRTUAL USER'S STORAGE SIZE. IT IS A 00097000
* MULTIPLE OF 4K. THE LAST DIGIT MUST BE 00098000
* K OR M. THE DEFAULT IS 128K. THE MINIMUM 00099000
* SIZE IS 8K. ALL ENTRIES NOT ON A 4K BOUNDARY 00100000
* WILL BE ROUNDED UP TO THE NEXT 4K BOUNDARY. 00101000
* THE MAXIMUM SIZE IS 16M. 00102000
* 00103000
EJECT 00104000
* MSTOR ONE TO EIGHT DECIMAL DIGITS THAT IS THE 00105000
* MAXIMUM STORAGE SIZE THIS USER CAN DEFINE 00106000
* HIS STORAGE AS AFTER LOGGING ON THE SYSTEM. 00107000
* IT IS A MULTIPLE OF 4K. THE LAST DIGIT 00108000
* MUST BE K OR M. THE DEFAULT SIZE IS 1M. 00109000
* ALL ENTRIES NOT ON A 4K BOUNDARY WILL 00110000
* BE ROUNDED UP TO THE NEXT 4K BOUNDARY AND THE 00111000
* MAXIMUM SIZE IS 16M. THE MINIMUM SIZE IS 8K. 00112000
* 00113000
* CL ONE TO EIGHT LETTERS FROM A TO H DENOTING 00114000
* THE OPERATING CLASS GIVEN TO THIS USER. THE 00115000
* DEFAULT IS G. 00116000
* 00117000
* PRI A NUMBER FROM ONE TO NINETY-NINE. USED BY 00118000
* THE DISPATCHING SCHEME. ONE IS THE HIGHEST 00119000
* PRIORITY AND FIFTY IS THE DEFAULT. 00120000
* 00121000
* LE A ONE CHARACTER TERMINAL LINE END SYMBOL OR A 00122000
* TWO CHARACTER HEX REPRESENTATION OF THE SYMBOL. 00123000
* ON WILL GIVE THE SYSTEM DEFAULT #. OFF WILL 00124000
* TURN THE FEATURE OFF. 00125000
* 00126000
* LD A ONE CHARACTER TERMINAL LINE DELETE SYMBOL 00127000
* OR A TWO CHARACTER HEX REPRESENTATION OF THE 00128000
* SYMBOL. ON WILL GIVE THE SYSTEM DEFAULT ยข . 00129000
* OFF WILL TURN THE FEATURE OFF. 00130000
* 00131000
* CD A ONE CHARACTER TERMINAL CHARACTER DELETE SYMBOL 00132000
* OR A TWO CHARACTER HEX REPRESENTATION OF THE 00133000
* SYMBOL. ON WILL GIVE THE SYSTEM DEFAULT @ . OFF 00134000
* WILL TURN THE FEATURE OFF. 00135000
* 00136000
* ES A ONE CHARACTER EDIT EXCAPE CHARACTER OR A TWO 00137000
* CHARACTER HEX REPRESENTATION OF THE SYMBOL. 00138000
* ON WILL GIVE THE SYSTEM DEFAULT " . OFF WILL 00139000
* TURN THE FEATURE OFF. 00140000
* 00141000
* 00142000
* +-----------------------------------+ 00143000
* | ACCOUNT NUMBER <DISTRIBUTION> | 00144000
* | A | 00145000
* +-----------------------------------+ 00146000
* 00147000
* ACCOUNT STATEMENT DEFINES AN EIGHT CHARACTER ACCOUNT NUMBER, 00148000
* AND A ONE TO EIGHT CHARACTER DISTRIBUTION IDENTIFICATION. 00149000
* THIS STATEMENT MUST FOLLOW THE USER STATEMENT AND PRECEDE THE FIRST 00150000
* DEVICE STATEMENT. THE ACCOUNT STATEMENT IS OPTIONAL. 00151000
* 00152000
EJECT 00153000
* +-------------------------------------------------------------------+ 00154000
* |OPTION REALTIMER ECMODE ISAM VIRT=REAL ACCT SVCOFF BMX CPUID BBBBBB| 00155000
* |O R E I V A S B C | 00156000
* +-------------------------------------------------------------------+ 00157000
* 00158000
* +-------------------------------------------------------------------+ 00159000
* |OPTION AFFINITY AA LNKNOPAS STFIRST HRC068DK 00160590
* |O AF L ST HRC068DK 00161180
* +-------------------------------------------------------------------+ 00162000
* 00163000
* OPTION STATEMENT SELECTS SPECIFIC OPTIONS AVAILABLE TO 00164000
* THE USER. THIS STATEMENT MUST FOLLOW THE USER STATEMENT AND 00165000
* PRECEDE THE FIRST DEVICE STATEMENT, THE OPTION STATEMENT 00166000
* IS OPTIONAL. MULTIPLE OPTION STATEMENTS ARE PERMITTED. 00167000
* 00168000
* +---------------+ 00169000
* | IPL IPLSYS | 00170000
* | I | 00171000
* +---------------+ 00172000
* 00173000
* IPL STATEMENT WILL CONTAIN A ONE TO EIGHT CHARACTER NAME OF 00174000
* THE SYSTEM OR DEVICE TO BE IPL'D ,FOR THE USER, 00175000
* AT LOGON TIME. THIS STATEMENT MUST BE AFTER THE USER STATEMENT 00176000
* AND BEFORE THE FIRST DEVICE STATEMENT, THE IPL STATEMENT 00177000
* IS OPTIONAL. 00178000
* 00179000
* +----------------------------------+ 00180000
* | CONSOLE CCU DEVTYPE <CLASS> | 00181000
* | C | 00182000
* +----------------------------------+ 00183000
* 00184000
* CONSOLE STATEMENT SPECIFIES THE CONSOLE DEVICE. 00185000
* 00186000
* CCU THE VIRTUAL DEVICE ADDERSS. 00187000
* 00188000
* DEVTYPE 00189000
* 1052 00190000
* 3210 00191000
* 3215 00192000
* 3278 00193000
* 00194000
* CLASS IS A ONE CHARACTER OUTPUT CLASS, THE DEFAULT IS CLASS T. 00195000
* 00196000
* +------------------------------------------------------------------+ 00197000
* | MDISK CCU TYPE CYLR CYLS VOLSER <MODE <PR <PW <PM>>>> | 00198000
* | M T-DISK | 00199000
* | T | 00200000
* +------------------------------------------------------------------+ 00201000
* 00202000
* MDISK STATEMENT DESCRIBES A PHYICAL EXTENT ON A DASD DEVICE TO BE 00203000
* OWNED BY THAT USER. 00204000
* 00205000
* CCU VIRTUAL DEVICE ADDRESS. 00206000
* 00207000
* TYPE 00208000
* 2305 00209000
* 2311 TOP (TOP HALF OF A 2314-2319) 00210000
* T 00211000
* BOTTOM (BOTTOM HALF OF A 2314-2319) 00212000
* B 00213000
* 2314 00214000
* 2319 00215000
* 3340 00216000
* 3330 00217000
* 3350 00218000
* 3375 HRC106DK 00218100
* 3380 HRC011DK 00218500
* 00219000
* CYLR A THREE DIGIT DECIMAL CYLINDER RELOCATION 00220000
* FACTOR. OR IF T-DISK, DISK SPACE IS OBTAINED 00221000
* AT LOGON TIME. 00222000
* 00223000
* CYLS A THREE DIGIT DECIMAL NUMBER SPECIFYING THE 00224000
* NUMBER OF CYLINDERS. 00225000
* 00226000
* VOLSER THE VOLUME SERIAL NUMBER OF THE DASD UNIT 00227000
* 00228000
* MODE SPECIFIES THE PRIMARY ACCESS REQUESTED (READ/ONLY, 00229000
* WRITE, OR MULTIPLE), AND THE ALTERNATE ACCESS 00230000
* (READ/ONLY OR WRITE) DESIRED (IF ANY), AND OPTIONALLY 00231000
* A CHARACTER 'V' WHICH IF SPECIFIED INDICATES THAT 00232000
* VIRTUAL RESERVE/RELEASE PROCESSING SHOULD BE DONE. 00233000
* 00234000
* R SPECIFIES THAT READ/ONLY (R/O) ACCESS IS REQUESTED. 00235000
* THE LINK WILL NOT BE GIVEN IF ANY OTHER USER HAS THE 00236000
* DISK IN WRITE STATUS. 00237000
* 00238000
* RR SPECIFIES THAT READ/ONLY ACCESS IS REQUESTED, EVEN IF 00239000
* ANOTHER USER HAS THE DISK IN WRITE STATUS. 00240000
* 00241000
* W SPECIFIES THAT WRITE ACCESS IS REQUESTED. THE DISK WILL 00242000
* NOT BE DEFINED IF ANY OTHER USER HAS THE DISK IN READ OR 00243000
* WRITE STATUS. 00244000
* 00245000
* WR SPECIFIES THAT WRITE ACCESS IS REQUESTED IF NO OTHER 00246000
* USER HAS THE DISK IN READ OR WRITE STATUS, BUT THAT AN 00247000
* ALTERNATE ACCESS OF READ/ONLY IS ACCEPTABLE IF OTHER(S) 00248000
* DO HAVE A LINK TO THE DISK; IN THIS EVENT, A READ/ONLY 00249000
* MODE IS TO BE GIVEN. 00250000
* 00251000
* M SPECIFIES THAT "MULTIPLE" ACCESS IS REQUESTED. THIS 00252000
* MEANS THAT A WRITE LINK IS TO BE GIVEN TO THE DISK 00253000
* UNLESS ANOTHER USER ALREADY HAS WRITE ACCESS TO IT, 00254000
* IN WHICH EVENT NO LINK IS TO BE GIVEN. 00255000
* 00256000
* MR SPECIFIES THAT A WRITE LINK IS TO BE GIVEN TO THE DISK 00257000
* UNLESS ANOTHER USER ALREADY HAS WRITE ACCESS TO IT; 00258000
* IN THIS EVENT, A READ-LINK IS TO BE GIVEN, WITH AN 00259000
* ERROR 1 OR 2, AND THE 'DEV XXX FORCED R/O' MESSAGE. 00260000
* 00261000
* MW SPECIFIES THAT A WRITE LINK IS TO BE GIVEN TO THE DISK 00262000
* IN ANY EVENT. 00263000
* 00264000
* IF THE MODE IS OMITTED FROM THE STATEMENT, THE 00265000
* DEFAULT IS TO "W". 00266000
* 00267000
EJECT 00268000
* PR ONE TO EIGHT CHARACTER PASSWORD THAT ALLOWS LINKING 00269000
* IN READ MODE. 00270000
* 00271000
* PR ONE TO EIGHT CHARACTER PASSWORD THAT ALLOWS LINKING 00272000
* IN WRITE MODE. 00273000
* 00274000
* PM ONE TO EIGHE CHARACTER PASSWORD THAT ALLOWS LINKING 00275000
* IN MULT-WRITE. 00276000
* 00277000
* +--------------------------------+ 00278000
* | SPOOL CCU DEVTYPE <CLASS> | 00279000
* | S | 00280000
* +--------------------------------+ 00281000
* 00282000
* SPOOL STATEMENT SPECIFIES THE OUTPUT UNIT RECORD DEVICE TO SPOOL. 00283000
* 00284000
* CCU THE VIRTUAL DEVICE ADD. 00285000
* 00286000
* DEVTYPE 00287000
* 1403 00288000
* 1443 00289000
* 3211 00290000
* 3203 00291000
* 2540 PUNCH 00292000
* P 00293000
* READER 00294000
* R 00295000
* 3525 00296000
* 2501 00297000
* 3505 00298000
* 00299000
* CLASS IS A ONE CHARACTER OUTPUT CLASS, THE DEFAULT IS CLASS A. 00300000
* 00301000
* +---------------------------------+ 00302000
* | DEDICATE CCU RDEV <3330V> | 00303000
* | D <VOLID> VOLSER | 00304000
* +------------------------------------------+ 00305000
* 00306000
* DEDICATE STATEMENT SPECIFICES THAT A DEVICE IS TO BE 00307000
* DEDICATED TO THIS USER. 00308000
* 00309000
* CCU THE VIRTUAL DEVICE ADD FOR THIS USER. 00310000
* 00311000
* RDEV THE REAL DEVICE ADD OF THE DEVICE TO BE DEDICATED. 00312000
* 00313000
* VOLID OPTIONAL KEYWORD USED IF THE VOLSER IS LESS THAN 00314000
* 4 CHARACTERS. 00315000
* 00316000
* VOLSER THE VOLUME SERIAL NUMBER OF THE DISK PACK, 00317000
* ON A REAL DEVICE, TO BE DEDICATED. 00318000
* 00319000
* 3330V AN OPTIONAL KEYWORD. IF SPECIFIED, INDICATES THAT 00320000
* THE VIRTUAL DEVICE ADDRESS IS TO BE TREATED AS AN 00321000
* MSS VUA. 00322000
* 00323000
EJECT 00324000
* +-------------------------------------+ 00325000
* | LINK USERID LDEV <CCU <MODE>> | 00326000
* | L | 00327000
* +-------------------------------------+ 00328000
* 00329000
* LINK STATEMENT SPECIFIES THAT THIS USER IS TO BE LINKED 00330000
* AT LOGON TIME. 00331000
* 00332000
* USERID THE USER ID OF THE USER TO LINK TO. 00333000
* 00334000
* LDEV THE DEVICE ADDRESS OF THE DEVICE TO LINK TO. 00335000
* 00336000
* CCU THE VIRTUAL DEVICE ADDRESS OF THE USERS 00337000
* DEVICE. IT WILL DEFAULT TO THE SAME ADD AS 00338000
* LINK TO DEVICE. 00339000
* 00340000
* MODE SPECIFIES THE PRIMARY ACCESS REQUESTED (READ/ONLY, 00341000
* WRITE, OR MULTIPLE), AND THE ALTERNATE ACCESS 00342000
* (READ/ONLY OR WRITE) DESIRED (IF ANY), AS FOLLOWS: 00343000
* 00344000
* R SPECIFIES THAT READ/ONLY (R/O) ACCESS IS REQUESTED. 00345000
* THE LINK WILL NOT BE GIVEN IF ANY OTHER USER HAS THE 00346000
* DISK IN WRITE STATUS. 00347000
* 00348000
* RR SPECIFIES THAT READ/ONLY ACCESS IS REQUESTED, EVEN IF 00349000
* ANOTHER USER HAS THE DISK IN WRITE STATUS. 00350000
* 00351000
* W SPECIFIES THAT WRITE ACCESS IS REQUESTED. THE LINK WILL 00352000
* NOT BE GIVEN IF ANY OTHER USER HAS THE DISK IN READ OR 00353000
* WRITE STATUS. 00354000
* 00355000
* WR SPECIFIES THAT WRITE ACCESS IS REQUESTED IF NO OTHER 00356000
* USER HAS THE DISK IN READ OR WRITE STATUS, BUT THAT AN 00357000
* ALTERNATE ACCESS OF READ/ONLY IS ACCEPTABLE IF OTHER(S) 00358000
* DO HAVE A LINK TO THE DISK; IN THIS EVENT, A READ/ONLY 00359000
* LINK IS TO BE GIVEN. 00360000
* 00361000
* M SPECIFIES THAT "MULTIPLE" ACCESS IS REQUESTED. THIS 00362000
* MEANS THAT A WRITE LINK IS TO BE GIVEN TO THE DISK 00363000
* UNLESS ANOTHER USER ALREADY HAS WRITE ACCESS TO IT, 00364000
* IN WHICH EVENT NO LINK IS TO BE GIVEN. 00365000
* 00366000
* MR SPECIFIES THAT A WRITE LINK IS TO BE GIVEN TO THE DISK 00367000
* UNLESS ANOTHER USER ALREADY HAS WRITE ACCESS TO IT; 00368000
* IN THIS EVENT, A READ-LINK IS TO BE GIVEN, WITH AN 00369000
* ERROR 1 OR 2, AND THE 'DEV XXX FORCED R/O' MESSAGE. 00370000
* 00371000
* MW SPECIFIES THAT A WRITE LINK IS TO BE GIVEN TO THE DISK 00372000
* IN ANY EVENT. 00373000
* 00374000
* IF THE MODE IS OMITTED FROM THE STATEMENT, THE 00375000
* DEFAULT IS TO "R". 00376000
* 00377000
EJECT 00378000
* +-------------------------+ 00379000
* | SPECIAL CCU DEVTYPE | 00380000
* | SPE | 00381000
* +-------------------------+ 00382000
* 00383000
* SPECIAL STATEMENT SPECIFIES THE I/O UNITS AVAILABLE TO THE USER 00384000
* THAT NEED NOT HAVE A REAL I/O UNIT AVAILABLE. SPECIAL DEVICES 00385000
* ARE PROGRAM SIMULATED DEVICES THAT MAY OR MAY NOT BE CONNECTED 00386000
* TO REAL OR VIRTUAL DEVICES AFTER THE USER HAS COMPLETED 'LOGON'. 00387000
* 00388000
* CCU THE VIRTUAL DEVICE ADDRESS. 00389000
* 00390000
* DEVTYPE 00391000
* 2701 IBM (VIRTUAL 270X ONLY) 00392000
* I 00393000
* TELE 00394000
* T 00395000
* 2702-2703 (SAME AS 2701) 00396000
* CTCA (CHANNEL TO CHANNEL ADAPTER) 00397000
* TIMER (PSEUDO-TIMER DEVICE) 00398000
* 00399000
* 3270 - VIRTUAL 3270 DEVICE 00400000
* 3138 VIRTUAL CONSOLE 00401000
* 3148 VITRUAL CONSOLE 00402000
* 3158 VIRTUAL CONSOLE 00403000
EJECT 00404000
* ATTRIBUTES 00405000
* 00406000
* NOT SERIALLY REUSABLE, 00407000
* 00408000
* ENTRY POINTS 00409000
* 00410000
* DMKDIRCT DIRECTORY ENTRY POINT 00411000
* 00412000
* DMKDIRED END OF THE LOAD MODULE FOR CMS 00413000
* 00414000
* ENTRY CONDITIONS 00415000
* 00416000
* NONE IF ON THE BARE MACHINE 00417000
* 00418000
* UNDER CMS REG 1 WILL POINT TO A PARAMITER LIST 00419000
* CONTAINING THE FILE NAME, TYPE AND MODE OF A 00420000
* CMS FILE CONTAINING THE CONTROL STATEMENTS. 00421000
* THE DEFAULT NAME WILL BE "USER DIRECT *" 00422000
* 00423000
* EXIT CONDITIONS 00424000
* 00425000
* NONE IF ON THE BARE MACHINE 00426000
* 00427000
* UNDER CMS REG 15 WILL CONTAIN A RETURN CODE: 00428000
* 00429000
* 1 = INVALID FILE NAME OR FILE NOT FOUND 00430000
* 2 = ERROR LOADING THE DIRECTORY 00431000
* 3 = INVALID OPTION FROM CMS 00432000
* 4 = DIRECTORY NOT SWAPED, USER NOT CLASS A,B OR C. 00433000
* 5 = DIRECTORY NOT SWAPED, OLD DIRECTORY LOCKED. 00434000
* 6 = DIRECTORY NOT SWAPED, DIRECTORY IN USE BY THE 00435000
* SYSTEM IS NOT THE DIRECTORY UPDATED. 00436000
* 1XX = ERROR IN THE CMS RDBUF ROUTINE 00437000
* 2XX = ERROR IN THE CMS TYPLIN ROUTINE 00438000
* XX = THE CMS ROUTINE RETURN CODE 00439000
* 00440000
* EXTERNAL REFERENCES 00441000
* 00442000
* NONE 00443000
* 00444000
* TABLES / WORK AREAS 00445000
* 00446000
* NAMETABLE LIST OF VALID KEYWORDS FROM INPUT 00447000
* 00448000
* 00449000
* 00450000
EJECT 00451000
* REGISTER USAGE 00452000
* 00453000
* 00454000
* R0 = WORK 00455000
* R1 = POINTER TO INPUT FIELD 00456000
* POINTER TO IOB 00457000
* POINTER TO OUTPUT BUFFER 00458000
* WORK 00459000
* R2 = INPUT COUNT FROM SCANSTATEMENT 00460000
* DASD ADDRESS 00461000
* WORK 00462000
* R3 = WORK 00463000
* R4 = WORK 00464000
* R5 = BRANCH AND LINK RETURN ADDRESS 00465000
* POINTER TO THE NEXT UDEVBLOK 00466000
* WORK 00467000
* R6 = RDIRBUF = POINTER TO THE UDIRBLOK BUFFER 00468000
* R7 = RMACBUF = POINTER TO THE UMACBLOK BUFFER 00469000
* R8 = RDEVBUF = POINTER TO THE UMDEVBLOK BUFFER 00470000
* R9 = RDIR = POINTER TO UDIRBLOK 00471000
* R10 = RMAC = POINTER TO UMACBLOK 00472000
* R11 = RDEV = POINTER TO UDEVBLOK 00473000
* R12 = BASE 1 00474000
* R13 = BASE 2 00475000
* R14 = RETURN ADDRESS 00476000
* R15 = ENTRY ADDRESS 00477000
* 00478000
EJECT 00479000
* MESSAGES 00480000
* 00481000
* DMKDIR751E INVALID OPERAND - XXXXXX 00482000
* XXXXXX = THE PARAMETER IN ERROR FROM THE 00483000
* LAST INPUT LINE. 00484000
* 00485000
* DMKDIR752E CONTROL STATMENT SEQUENCE ERROR 00486000
* 00487000
* DMKDDR753E OPERAND MISSING 00488000
* 00489000
* DMKDIR754E DEV CCU NOT OPERATIONAL 00490000
* CCU = THE ADDRESS OF THE UNIT 00491000
* 00492000
* DMKDIR755E IO ERROR CCU CSW XXXXXXXXXXXXXXXX SENSE XXXXXXXXXXX 00493000
* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 00494000
* CCU = THE UNIT ADIRESS OF THE DEVICE 00495000
* SENSE XX = UP TO 32 SENSE BYTES HRC011DK 00496490
* CSW XX = THE CSW FROM THE ERROR 00497000
* 00498000
* DMKDIR756E PROGRAM CHECK PSW = XXXXXXXXXXXXXXXX 00499000
* XXXX = THE PROGRAM CKECK OLD PSW 00500000
* 00501000
* DMKDIR757E MACHINE CHECK RUN SEREP AND SAVE OUTPUT FOR CE 00502000
* 00503000
* DMKDIR758E DUPLICATE UNIT DEFINITION 00504000
* 00505000
* DMKDIR760E NOT ENOUGH SPACE ALLOCATED FOR DIRECTORY 00506000
* 00507000
* DMKDIR761E VOLID READ IS VOLID1 NOT VOLID2 00508000
* VOLID1 = THE VOLUME SERIAL NUMBER FROM 00509000
* THE DASD DEVICE. 00510000
* VOLID2 = THE VOLUME SERIAL NUMBER FROM 00511000
* DIRECTORY STATMENT. 00512000
* 00513000
* DMKDIR762E DIRECTORY STATEMENT MISSING 00514000
* 00515000
* DMKDIR763E INVALID FILENAME OR FILE NOT FOUND 00516000
* 00517000
* DMKDIR764E ERROR IN XXXXXXXX 00518000
* XXXXXXX = THE NAME OF THE CMS ROUTINE 00519000
* IN ERROR. 00520000
* 00521000
* EOJ DIRECTORY NOT UPDATED 00522000
* 00523000
* EOJ DIRECTORY UPDATED 00524000
* 00525000
* EOJ DIRECTORY UPDATED AND ON LINE 00526000
* 00527000
* VM/370 USER DIRECTORY CREATION PROGRAM RELEASE 6 00528000
* 00529000
* ENTER CARD READER ADDRESS AND OPTIONS 00530000
* 00531000
* OPERATION SEE ROUTINES 00532000
* 00533000
*. 00534000
EJECT 00535000
MACRO 00536000
&SYMBOL TABLE &NAME,&MIN,&CLASS,&TYPE,&FET,&LAST 00537000
LCLC &C 00538000
&C SETC '&NAME'(1,4) 00539000
AIF (T'&TYPE EQ 'O').POINT 00540000
AIF ('&LAST' EQ 'LAST').LASTCON 00541000
&SYMBOL DC XL.4'4',AL.4(&MIN-1) FLAG = CONSTANT+LENGTH 00542000
AGO .CON 00543000
.LASTCON ANOP 00544000
&SYMBOL DC XL.4'C',AL.4(&MIN-1) FLAG = LAST CONSTANT+LENGTH 00545000
.CON DC AL1(&CLASS) CLASS OF DEVICE 00546000
DC AL1(&TYPE) TYPE OF DEVICE 00547000
AIF (T'&FET EQ 'O').FET 00548000
DC AL1(&FET) FEATURE CODE 00549000
AGO .NAME 00550000
.FET DC AL1(0) NO FEATURE CODE 00551000
AGO .NAME 00552000
.POINT AIF ('&CLASS' EQ 'LAST').LASTPT 00553000
DC XL.4'0',AL.4(&MIN-1) FLAG = POINTER TO ROUTINE + LENGTH 00554000
AGO .PT 00555000
.LASTPT ANOP 00556000
&SYMBOL DC XL.4'8',AL.4(&MIN-1) FLAG = LAST POINTER+LENGTH 00557000
.PT DC AL3(SCAN&C) ADDRESS OF THE ROUTINE 00558000
.NAME ANOP 00559000
CON&C DC CL8'&NAME' NAME 00560000
SPACE 00561000
MEND 00562000
SPACE 00563000
MACRO 00564000
&SYMBOL COMP &NAME 00565000
&SYMBOL LA R3,&NAME 00566000
BAL R14,COMPARE . GO COMPARE THE KEYWORD RETURN WITH CC SET 00567000
MEND 00568000
SPACE 00569000
MACRO 00570000
&SYMBOL MOVE &NAME 00571000
&SYMBOL BCT R2,*+10 00572000
MVC &NAME(1)(1),0(R1) 00573000
EX R2,*-6 00574000
MEND 00575000
SPACE 00576000
MACRO 00577000
&SYMBOL MSG &MESSAGE,&RETURN 00578000
AIF ( T'&RETURN EQ 'O').YES 00579000
&SYMBOL LA R5,&RETURN 00580000
BAL R2,MSGWRITE 00581000
AGO .CONT 00582000
.YES ANOP 00583000
&SYMBOL BAL R2,MSGWRITE 00584000
.CONT DC AL2(L&SYSNDX) 00585000
M&SYSNDX DC C&MESSAGE 00586000
L&SYSNDX EQU *-M&SYSNDX 00587000
SPACE 00588000
MEND 00589000
EJECT 00590000
SPACE 3 00591000
DMKDIR START 0 00592000
USING *,R0 00593000
USING IOB,R1 00594000
USING NAMETABL,R4 00595000
USING UMACBLOK,R10 00596000
USING UDEVBLOK,R11 00597000
USING DMKDIRCT+2,R12 00598000
USING DMKDIRCT+4096,R13 00599000
USING DMKDIRCT+8190,R9 @V200731 00600000
SPACE 3 00601000
RDIRBUF EQU 6 REGISTER POINTING TO DIRECTORY PAGE BUF 00602000
RMACBUF EQU 7 REGISTER POINTING TO MACHINE PAGE BUFFER 00603000
RDEVBUF EQU 8 REGISTER POINTING TO DEVICE PAGE BUFFER 00604000
RDIR EQU 15 REGISTER POINTING TO UDIRBLOK @V200731 00605000
RMAC EQU 10 REGISTER POINTING TO UMACBLOK 00606000
RDEV EQU 11 REGISTER POINTING TO UDEVBLOK 00607000
SPACE 3 00608000
IPLUSE DS 3D 00609000
EXTOLD DC D'0' 00610000
SUPOLD DC D'0' 00611000
PROOLD DC D'0' 00612000
MCOLD DC D'0' 00613000
IOOLD DC D'0' 00614000
CSW DS 1D 00615000
CAW DS 1F 00616000
DC F'0' 00617000
TIMER DC X'7FFFFFFF' 00618000
DC F'0' 00619000
EXTNEW DC X'0104000000' 00620000
DC AL3(EXTINT) 00621000
SVCNEW DC X'0106000000000000' 00622000
PRONEW DC X'0104000000' 00623000
DC AL3(ERROR56) 00624000
MCNEW DC X'0000000000' 00625000
DC AL3(ERROR57) 00626000
IONEW DC X'0104000000' 00627000
DC AL3(IOINT) 00628000
EJECT 00629000
****************************************************************** 00630000
*. 00631000
* DMKDIRCT HOUSEKEEPING ROUTINE 00632000
* 00633000
* 1. IF UNDER CMS GO TO STEP 6. 00634000
* 00635000
* 2. PRINT HEADER AND READ FROM CONSOLE. 00636000
* 00637000
* 3. IF NULL LINE USE IPL DEV ADD, ELSE 00638000
* SET UP ADD FROM CONSOLE. 00639000
* 00640000
* 4. IF THE EDIT OPTION WAS ENTERED SET THE 00641000
* EDIT BIT ON. 00642000
* 00643000
* 5. GO TO READ THE FIRST CARD. 00644000
* 00645000
* 6. SET UP THE PARM LIST AND STATE THE FILE. 00646000
* 00647000
* 7. IF NOT FOUND GO TO EXIT. ELSE GO TO READ. 00648000
* 00649000
*. 00650000
****************************************************************** 00651000
ENTRY DMKDIRCT 00652000
DMKDIRCT BALR R12,0 SET UP BASE 1 00653000
LA R12,0(,R12) CLEAR HIGH ORDER BYTE FOR BARE MAC COMP 00654000
LA R13,4094(,R12) SET UP BASE 2 00655000
LA R9,4094(,R13) SET UP BASE 3 @V200731 00656000
L RDIR,POINTERS GET BUFFER ADDRESS FOR UDIRBLOK @V200731 00657000
ST RDIR,DIRPTR SAVE BUFFER ADDRESS @V200731 00658000
L RMAC,POINTERS+4 GET BUFFER ADDRESS FOR UMACBLOK @V200731 00659000
LR RDEV,RMAC POINT TO FIRST UDEVBLOK 00660000
LM RDIRBUF,RDEVBUF,POINTERS LOAD POINTERS TO BUFFERS 00661000
STIDP CPUID STORE CPU ID 00662000
CL R12,BAREMAC IS THIS A BARE MACHINE 00663000
BNE CMS1 NO- GO TO CMS ROUTINE 00664000
SSM =X'01' ENABLED TO ACCEPT EXT INTERRUPT 00665000
B NEWADD 00666000
EXTINT DS 0H 00667000
MVI TIMER,X'7F' SET HI TIMER FOR ANY EXT INTERRUPT 00668000
TM EXTOLD+3,X'40' WAS EXT INT KEY PUSHED 00669000
BO NEWADD BRANCH IF SO 00670000
LPSW EXTOLD IGNORE EXT INT IF NOT 00671000
NEWADD LA R15,CONIOB POINT TO IOB 00672000
BAL R5,MSG02 GO PRINT MSG 00673000
MSGRET EQU * @V200731 00674000
LA R2,CONERROR SET UP ADDRESS FOR ERROR ROUTINE @V200731 00675000
ST R2,IOBERROR AND PUT ADDRESS IN IOB @V200731 00676000
LA R2,CONCCWR POINT TO THE CONSOLE READ CCW @V200731 00677000
BAL R5,GRAPHID GO READ CONSOLE @V200731 00678000
LA R1,READBUF1 * GET IO ADD OF CARD READER 00679000
ST R1,CURPOINT * AND STORE IT IN THE IOB 00680000
LA R4,72 * 00681000
STH R4,CURCOUNT * 00682000
BAL R14,SCANCARD * 00683000
BC 4,DEFAUL13 * 00684000
BAL R14,HEXCONV * 00685000
STOREADD STH R2,READADD * 00686000
BAL R14,SCANCARD GO FIND THE EDIT PARM 00687000
BNE READ IF NO INPUT THAN GO READ THE CARD 00688000
CLC =C'EDIT ',0(R1) IS THIS EDIT 00689000
BNE ERROR51 NO- ERROR 00690000
OI DIRFLAG,EDITMODE TURN ON THE EDIT SWITCH 00691000
B READ GO GET THE FIRST CARD 00692000
DEFAUL13 LH R2,IPLUSE+2 USE IPL UNIT ADD 00693000
B STOREADD 00694000
SETUPERR TM IOBSTAT,IOBNOPER WAS THE UNIT NOT OPER 00695000
BO CONPARM YES, GO TEST FOR CORRECT DEVICE @V200731 00696000
TM IOBCSW+4,UC IS UNIT CHECK INDICATED ? @V200731 00697000
BZ CONERROR NO, GO TO ERROR HANDLER @V200731 00698000
CONPARM EQU * @V200731 00699000
TM PARM,PARM321 IS THIS A 3215/3210/1052 @V200731 00700000
BO DDRLPSW YES, GO WAIT FOR I/O INTERRUPT @V200731 00701000
TM PARM,PARM01F IS THIS ADDRESS 01F ? @V200731 00702000
BO TESTGRAP YES, GO CHECK FOR GRAPHIC @V200731 00703000
* DEVICE ? 00704000
OI PARM,PARM01F SET INDICATOR FOR 01F @V200731 00705000
MVI CONIOB+((IOBUADD+1)-IOB),X'1F' SET DEVICE ADDR @V200731 00706000
* TO 1F 00707000
B NEWADD GO TRY THIS ADDRESS - 01F @V200731 00708000
TESTGRAP EQU * @V200731 00709000
TM PARM,PARMGRP IS THIS A GRAPHIC DEVICE ? @V200731 00710000
BO TES3270T YES, GO TEST FOR 3270 DEVICE @V200731 00711000
OI PARM,PARMGRP+PARMCLE SET GRAPHIC & ERASE @V200731 00712000
* INDICATORS 00713000
DDRLPSW EQU * @V200731 00714000
LPSW CONWAIT WAIT FOR I/O INTERRUPT @V200731 00715000
TES3270T EQU * @V200731 00716000
TM PARM,PARMGRP+PARM327 IS THIS A 3270 DEVICE ? @V200731 00717000
BO TEST3278 YES, GO TEST FOR 3278 @V60A6B6 00718000
OI PARM,PARM327 SET THE 3270 INDICATOR @V60A6B6 00719000
********************************************************************** 00720000
* THE FOLLOWING WILL ENSURE THE LINE/COL LOCATION FOR THE DATA STREAM* 00721000
* FOR THE 3277. THIS IS A 24 LINE OPERATOR CONSOLE SCREEN. * 00722000
********************************************************************** 00723000
MVC LAB3270A+2(2),ADDR1 @V60A6B6 00724000
MVC LAB3270A+8(2),ADDR2 @V60A6B6 00725000
MVC LAB3270B+2(2),ADDR1 @V60A6B6 00726000
MVC LAB3270B+8(2),ADDR2 @V60A6B6 00727000
MVC LAB3270C+2(2),ADDR2 @V60A6B6 00728000
MVC LAB3270D+2(2),ADDR1 @V60A6B6 00729000
MVC LAB3270E+5(2),ADDR1 @V60A6B6 00730000
MVC LAB3270E+12(2),ADDR2 @V60A6B6 00731000
MVC ADDR5,ADDR6 ADDR TO CHECK FOR CURSOR MOVE @V60A6B6 00732000
MVC MAXLEN,LEN3270 @V60A6B6 00733000
B NEWADD GO TRY THIS WITH GRAPHIC SUP. @V60A6B6 00734000
TEST3278 EQU * @V60A6B6 00735000
CLC LAB3270A+2(2),ADDR3 HAVE WE TRIED IT AS 3278 @V60A6B6 00736000
BE TEST3215 MUST BE 3210-3215 @V60A6B6 00737000
********************************************************************** 00738000
* THE FOLLOWING WILL ENSURE THE LINE/COL LOCATION FOR THE DATA STREAMS 00739000
* FOR THE 3278 MOD2A. THIS IS A 20 LINE OPERATOR CONSOLE SCREEN. * 00740000
********************************************************************** 00741000
MVC LAB3270A+2(2),ADDR3 @V60A6B6 00742000
MVC LAB3270A+8(2),ADDR4 @V60A6B6 00743000
MVC LAB3270B+2(2),ADDR3 @V60A6B6 00744000
MVC LAB3270B+8(2),ADDR4 @V60A6B6 00745000
MVC LAB3270C+2(2),ADDR4 @V60A6B6 00746000
MVC LAB3270D+2(2),ADDR3 @V60A6B6 00747000
MVC LAB3270E+5(2),ADDR3 @V60A6B6 00748000
MVC LAB3270E+12(2),ADDR4 @V60A6B6 00749000
MVC ADDR5,ADDR7 EST. ADDR FOR CURSOR CHECK @V60A6B6 00750000
MVC MAXLEN,LEN3278 @V60A6B6 00751000
B NEWADD GO TRY THIS ADDRESS WITH @V200731 00752000
* GRAPHIC SUPPORT 00753000
TEST3215 EQU * @V200731 00754000
MVI PARM,PARM321 SET THE 3210-3215-1052 FLAG @V200731 00755000
B NEWADD GO TRY THIS ADDRESS WITH 3215 @V200731 00756000
* SUPPORT 00757000
CONRET EQU * @V200731 00758000
MVC IOBUADD,IOOLD+2 GET DEVICE ADDRESS FROM PSW @V200731 00759000
B NEWADD GO AND TRY THIS ADDRESS @V200731 00760000
CMS1 ST R14,CMSSAVE SAVE RETURN ADD 00761000
BAL R5,TSTPLIST * SET UP P LIST FROM THE 00762000
MVC INFCB+8(8),0(R1) * INPUT P LIST 00763000
BAL R5,TSTPLIST * 00764000
MVC INFCB+16(8),0(R1) * 00765000
BAL R5,TSTPLIST * 00766000
MVC INFCB+24(2),0(R1) * 00767000
BAL R5,TSTPLIST * 00768000
EDITTEST CLC =C'EDIT ',0(R1) IS THIS EDIT 00769000
BE EDITON YES- BRANCH 00770000
MVC ERRORRET,=F'3' SET UP CMS RETURM CODE OF 3 00771000
OI DIRFLAG,ERROR TURN ON THE ERROR BIT 00772000
B EXIT 00773000
EDITON OI DIRFLAG,EDITMODE TURN ON THE EDIT FLAG 00774000
STATE LA R1,INFCB POINT TO THE INPUT FCB 00775000
SVC 202 STATE THE FILE 00776000
DC AL4(ERROR63) ERROR RETURN 00777000
MVC INFCB(8),=CL8'RDBUF' SET UP FOR FIRST READ 00778000
B READ GO READ THE CMS FILE 00779000
TSTPLIST LA R1,8(,R1) ADD 8 00780000
CLI 0(R1),X'FF' IS THIS THE END OF THE P LIST 00781000
BE STATE YES- GO 00782000
CLI 0(R1),C'(' IS IT ( 00783000
BCR 7,R5 NO- RETURN TO THE CALLING ROUTINE 00784000
LA R1,8(,R1) POINT TO THE NEXT PARM 00785000
B EDITTEST GO TEST FOR EDIT 00786000
EJECT 00787000
*************************************************************** 00788000
*. 00789000
* SUBROUTINE TO SCAN NAME TABLE 00790000
* 00791000
* 1. SCAN TABLE POINTED TO BY R4, IS NOT EQ GO TO ERROR51 00792000
* 00793000
* 2. IF NAME IS A CONSTANT MOVE IT INTO THE UDEVBLOK 00794000
* AND RETURN TO THE CALLER. 00795000
* 00796000
* 3. IF NAME IS AN ADDRESS GO TO THAT ADDRESS. 00797000
* 00798000
*. 00799000
* 00800000
*************************************************************** 00801000
SCANNAME STM R3,R5,SAVEREGS SAVE REG 00802000
BCTR R2,0 -1 00803000
RESCAN L R3,NAMEFLAG GET THE FLAG AND POINTER TO THE ROUTINE 00804000
EX R2,COMPNAME COMPARE THE NAME TO THE CON 00805000
BE GOODNAME GET OUT IF EQ 00806000
ADDSIZE LA R4,NAMESIZE(,R4) POINT TO NEXT NAME TABLE ENTRY 00807000
LTR R3,R3 IS THIS THE LAST NAME 00808000
BNM RESCAN LOOP 00809000
LA R2,1(,R2) +1 00810000
B ERROR51 ERROR IF NOT FOUND 00811000
GOODNAME SLL R3,4 DROP THE FLAGS 00812000
SRL R3,28 SET UP THE COUNT 00813000
CR R2,R3 COMPARE THE MIN COUNT 00814000
BL ADDSIZE IF COUNT IS LOW CONT SCAN 00815000
TM NAMEFLAG,X'40' IS THIS AN ADDRESS 00816000
BO MOVECODE NO MOVE IN DEVICE CODE 00817000
ST R14,SAVERET SAVE RETURN REGISTER 00818000
L R15,NAMEFLAG SET UP TO GO TO SUBROUTINE 00819000
LM R3,R5,SAVEREGS RETURN REG 00820000
BR R15 GO TO SUBROUTINE 00821000
MOVECODE MVC UDEVTYPC(3),NAMETYPC MOVE IN DEV TYPE CLASS AND FEAT 00822000
CLC NAME-NAMETABL(8,R4),NAM3138 IS IT A 3138 ?? @V3M4036 00823000
BE IND3158 INDICATE A 3158 @V386298 00824000
CLC NAME-NAMETABL(8,R4),NAM3148 IS IT A 3148 ?? @V3M4036 00825000
BE IND3158 INDICATE A 3158 @V386298 00826000
CLC NAME-NAMETABL(8,R4),=CL8'3158' IS THIS A 3158? @VA02100 00827000
BNE *+8 NO, SKIP IT @VA02100 00828000
IND3158 EQU * @V386298 00829000
OI UDEVSTAT,UDEV3158 FLAG AS 3158 @VA02100 00830000
TM NAMEFLAG,X'40' RESTORE COND. CODE AS ABOVE. @VA02100 00831000
LM R3,R5,SAVEREGS RETURN REG 00832000
BR R14 RETURN TO CALLER 00833000
COMPNAME CLC NAME-NAMETABL(0,R4),0(R1) COMP NAME TO INPUT 00834000
SPACE 00835000
DS 0F 00836000
SPACE 3 00837000
TABLE1 EQU * 00838000
TABLE USER,1 00839000
TABLE ACCOUNT,1 00840000
TABLE OPTION,1 00841000
TABLE MDISK,1 00842000
TABLE SPOOL,1 00843000
TABLE DEDICATE,1 00844000
TABLE LINK,1 00845000
TABLE IPL,1 00846000
TABLE SPECIAL,3 00847000
TABLE CONSOLE,1 00848000
TABLE DIRECTORY,3,LAST 00849000
DC CL4'Y ' LAST LETTER IN DIRECTORY 00850000
TABLE2 EQU * 00851000
TABLE CTCA,4 00852000
TABLE TIMER,5,CLASURI,TYPTIMER 00853000
TABLE 3270,4,CLASGRAF,TYP3277 @V200730 00854000
TABLE 3158,4,CLASGRAF,TYP3158 @VA02100 00855000
TABLE 3138,4,CLASGRAF,TYP3138 @VA06315 00856000
TABLE 3148,4,CLASGRAF,TYP3148 @VA06315 00857000
TABLE 2701,4 00858000
TABLE 2702,4 00859000
TABLE 2703,4,LAST 00860000
TABLE3 EQU * 00861000
TABLE 1052,4,CLASTERM,TYP1052 00862000
TABLE 3210,4,CLASTERM,TYP3210 00863000
TABLE 3215,4,CLASTERM,TYP3215,,LAST 00864000
TABLE4 EQU * 00865000
TABLE 2305,4,CLASDASD,TYP2305 00866000
TABLE 2311,4 00867000
TABLE 2314,4,CLASDASD,TYP2314 00868000
TABLE 2319,4,CLASDASD,TYP2314 00869000
TABLE 3340,4,CLASDASD,TYP3340 @V2A2029 00870000
TABLE 3350,4,CLASDASD,TYP3350 @V304498 00871000
TABLE 3375,4,CLASDASD,TYP3375 HRC106DK 00871100
TABLE 3380,4,CLASDASD,TYP3380 HRC011DK 00871500
TABLE 3330,4,CLASDASD,TYP3330,,LAST 00872000
TABLE5 EQU * 00873000
TABLE 2540,4 00874000
TABLE 2501,4,CLASURI,TYP2501 00875000
TABLE 1403,4,CLASURO,TYP1403 00876000
TABLE 1443,4,CLASURO,TYP1443 00877000
TABLE 3211,4,CLASURO,TYP3211 00878000
TABLE 3203,4,CLASURO,TYP3203 @V386298 00879000
TABLE 3505,4,CLASURI,TYP3505 00880000
TABLE 3525,4,CLASURO,TYP3525,,LAST 00881000
SPACE 3 00882000
****************************************************************** 00883000
*. 00884000
* DIRECTORY CARD SCAN ROUTINE 00885000
* 00886000
* 1. IF NOT FIRST CARD GO TO ERROR52. 00887000
* 00888000
* 2. FILL IN THE IOB FROM THE INPUT CARD. 00889000
* 00890000
* 3. READ THE VOL1 AND ALLOCATION RECORD FROM THE 00891000
* DIRECTORY VOLUME. 00892000
* 00893000
* 4. GET A DASD PAGE ADDRESS FOT THE UDIR AND UMAC 00894000
* BUFFERS, SET UP POINTERS AND GOTO READ. 00895000
*. 00896000
****************************************************************** 00897000
SCANDIRE CLI LASTCARD,X'00' IS THIS THE FIRST CARD 00898000
BNE ERROR52 NO- ERROR 00899000
BAL R14,SCANCARD GET DEVICE ADD 00900000
BC 4,ERROR53 ERROR IF NO INPUT 00901000
CL R2,=F'4' IS IT OVER 4 00902000
BH ERROR51 YES- ERROR 00903000
BAL R14,HEXCONV 00904000
STH R2,DASDADD STORE OUTPUT ADDRESS 00905000
BAL R14,SCANCARD GET DEVICE TYPE 00906000
BC 4,ERROR53 ERROR IF NO INPUT 00907000
CL R2,=F'4' IS IT UNDER 4 00908000
BL ERROR51 YES- ERROR 00909000
COMP CON2319 IS IT 2319 00910000
BE SET2314 YES- BRANCH 00911000
COMP CON2314 IS IT A 2314 00912000
BNE TEST3330 NO- BRANCH 00913000
SET2314 OI DIRFLAG,OUT2314 INDICATE THE OUTPUT IS A 2314 - 2319 00914000
LA R4,32 SET UP THE MAX RECORD COUNT 00915000
B SAVEMAX 00916000
TEST3330 COMP CON3330 IS IT A 3330 00917000
LA R4,57 SET UP THE MAX RECORD COUNT 00918000
BE FLAG GO TURN ON THE 3330 FLAG 00919000
COMP CON3350 IS IT A 3350 ? @V304498 00920000
LA R4,120 SET UP THE MAX RECORD COUNT @V304498 00921000
BE FLAG3350 YES, SET 3350 FLAG @V304498 00922000
COMP CON3375 Is it a 3375 ? HRC106DK 00922100
LA R4,96 Set up the max record count HRC106DK 00922200
BE FLAG3375 Yes, set 3375 flag HRC106DK 00922300
COMP CON3380 Is it a 3380 ? HRC106DK 00922400
LA R4,150 Set up the max record count HRC106DK 00922500
BE FLAG3380 Yes, set 3380 flag HRC106DK 00922600
COMP CON3340 IS IT A 3340 ? @V2A2029 00923000
LA R4,24 SET UP THE MAX RECORD COUNT @V2A2029 00924000
BNE TEST2305 BRANCH IF NOT 3340 @V2A2029 00925000
OI DIRFLAG1,OUT3340 INDICATE 3340 @V2A2029 00926000
B SAVEMAX .. @V2A2029 00927000
FLAG3350 OI DIRFLAG1,OUT3350 INDICATE 3350 @V304498 00928000
B SAVEMAX .. @V304498 00929000
FLAG3375 OI DIRFLAG1,OUT3375 Indicate 3375 HRC106DK 00929100
B SAVEMAX .. HRC106DK 00929200
FLAG3380 OI DIRFLAG1,OUT3380 Indicate 3380 HRC106DK 00929300
B SAVEMAX .. HRC106DK 00929400
TEST2305 COMP CON2305 IS IT A 2305 @V2A2029 00930000
LA R4,24 SET UP THE MAX RECORD COUNT 00931000
BNE ERROR51 NO- ERROR 00932000
FLAG OI DIRFLAG,OUT3330 FLAG OUTPUT AS A 3330 OR 2305 00933000
SAVEMAX STH R4,MAXREC SAVE THE MAX RECORD COUNT 00934000
GETVS BAL R14,SCANCARD GET VOL SER NO 00935000
BC 4,ERROR53 ERROR IF NO INPUT 00936000
CL R2,=F'6' IS IT EQ 6 00937000
BH ERROR51 NO- ERROR 00938000
MVC DASDVSER,0(R1) MOVE IN VOL SER NO 00939000
READDASD LA R1,DASDIOB POINT TO IOB 00940000
TM DIRFLAG,EDITMODE EDIT RUN 00942000
BO EDITON1 YES- BRANCH (DO NOT READ THE DISK) 00943000
TM DIRFLAG1,OUT3380 Is this a 3380? HRC106DK 00943010
BZ SKIP3380 Some other device HRC106DK 00943020
L R3,IOB Get device address HRC106DK 00943030
LA R2,SNSE4CCW Point to sense CCW HRC106DK 00943040
CLI CPUID,X'FF' Is this a virtual machine? HRC106DK 00943050
BNE SKIPDIAG Running standalone - use SIO HRC106DK 00943060
SSM *+1 Lock out CMS HRC106DK 00943070
DC X'83320020' Diagnose call to to VM/370 HRC106DK 00943080
BNE SKIP3380 Error - give up on sense HRC106DK 00943090
B SKIPSIO Skip over SIO/TIO HRC106DK 00943100
SKIPDIAG EQU * HRC106DK 00943110
ST R2,CAW Store in CAW HRC106DK 00943120
XC SENSE,SENSE Zero out sense HRC106DK 00943130
SIO 0(R3) Do sense HRC106DK 00943140
TIO3380 TIO 0(R3) Clear any interrupt HRC106DK 00943150
BC 2,TIO3380 Loop if channel is busy HRC106DK 00943160
SKIPSIO EQU * HRC106DK 00943170
CLC CSW+6(2),=H'0' Got all sense bytes wanted? HRC106DK 00943180
BNE SKIP3380 No, something wrong here HRC106DK 00943190
CLC SENSE+4(2),=X'3380' Is this really a 3380? HRC106DK 00943200
BNE SKIP3380 No, continue HRC106DK 00943210
TM SENSE+6,RDEVMD82 Is it a 3380E or 3380K? HRC106DK 00943220
BZ SKIP3380 No - 1024 byte allocation map HRC106DK 00943230
MVC RCCW7+6,=H'2048' 3380E - 2048 byte alloc map HRC106DK 00943240
TM SENSE+6,RDEVMD83 Is it a 3380K? HRC106DK 00943250
BNO SKIP3380 No, leave it at 2048 bytes HRC106DK 00943260
MVC RCCW7+6,=H'4096' 3380K - 4096 byte alloc map HRC106DK 00943270
SKIP3380 EQU * HRC106DK 00943280
LA R2,RCCW1 Address of CCW string HRC106DK 00943290
BAL R5,STARTIO GO READ THE RECORDS 00944000
CLC DASDVSER(6),VOLLABLE+4 IS THIS THE PROPER DISK 00945000
BNE ERROR61 NO- ERROR 00946000
EDITON1 BAL R14,GETPAGE * GET A DASD ADDRESS AND 00947000
ST R2,UDIRPAGE * SAVE POINTER TO FIRST 00948000
ST R2,VOLLABLE+52 * PAGE OF THE DIRECTORY 00949000
BAL R14,GETPAGE 00950000
ST R2,UMACPAGE POINT TO DASD ADD OF FIRST MAC PAGE 00951000
B READ 00952000
EJECT 00953000
***************************************************************** 00954000
*. 00955000
* USER CARD SCAN ROUTINE 00956000
* 00957000
* 1. IF THE LAST CARD WAS USER, ACCO, OPT OR IPL GO 00958000
* TO ERROR52. 00959000
* 00960000
* 2. MASK OFF THE LAST UDIR AND UMAC BLOCKS. 00961000
* 00962000
* 3 IF THE UDEV BUFFER WAS USED WRITE IT OUT. 00963000
* AND ZERO THE DASD ADDRESS POINTER. 00964000
* 00965000
* 4. SET UP POINTERS TO THE NEXT UMAC UDEV AND 00966000
* UDIR BLOCKS. 00967000
* 00968000
* 5. IF THE UDIR BUFFER IS FULL WRITE IT OUT 00969000
* AND GET A NEW DASD PAGE ADDRESS FOR THE BUFFER. 00970000
* 00971000
* 6. FILL IN THE UDIRBLOK AND SET UP POINTER TO 00972000
* THE UMACBLOK. 00973000
* 00974000
* 7. IF THE UMAC BUFFER IS FULL WRITE IT OUT AND 00975000
* GET AN NEW DASD ADDRESS FOR THE BUFFER. 00976000
* 00977000
* 8. POINT TO THE UDIRBLOK IN THE UMAC BUFFER. IF 00978000
* THE UMAC BUFFER IS FULL, GET A DASD ADDRESS 00979000
* FOR THE UDEV BUFFER AND USE IT. 00980000
* 00981000
* 9. FILL IN THE UMACBLOK AND GO TO READ, TO READ THE 00982000
* NEXT CARD. 00983000
*. 00984000
************************************************************** 00985000
SCANUSER EQU * @VM08715 00986000
TM DIRFLAG,SPECID WAS LAST USER A 'SPECIAL'? @VM08715 00987000
BZ CHKPREQ NO - CHECK NORM. PREREQS @VM08715 00988000
NI DIRFLAG,255-SPECID YES - TURN OFF FLAG @VM08715 00989000
B MSKLST AND CONTINUE @VM08715 00990000
CHKPREQ EQU * @VM08715 00991000
CLI LASTCARD,C'U' WAS LAST CARD A USER CARD? @VM08715 00992000
BE ERROR52 YES- ERROR 00993000
CLI LASTCARD,C'A' WAS THE LAST CARD AN ACCOUNT CARD 00994000
BE ERROR52 YES- ERROR 00995000
CLI LASTCARD,C'O' WAS THE LAST CARD AN OPTION CARD 00996000
BE ERROR52 YES- ERROR 00997000
CLI LASTCARD,C'I' WAS THE LAST CARD AN IPL CARD 00998000
BE ERROR52 YES- ERROR 00999000
USING UDIRBLOK,R15 SETUP ADDRESSABILITY FOR UDIRBLOK@V200731 01000000
MSKLST EQU * @VM08715 01001000
TM DIRFLAG,FLUSH SYNTAX CHECKING AFTER EOF? @VA01066 01002000
BO EXIT YES, GO FINISH UP @VA01066 01003000
L RDIR,DIRPTR GET BUFFER ADDRESS FOR UDIRBLOK @V200731 01004000
XC UDIRUSER,MASK * MASK OFF THE UDIR AND 01005000
XC UDIRPASS,MASK * UMAC BLOCK'S 01006000
XC UMACBLOK+8(8),MASK * 01007000
XC UMACBLOK+16(8),MASK * 01008000
XC UMACBLOK+24(8),MASK * 01009000
XC UMACBLOK+32(8),MASK * 01010000
XC UMACBLOK+40(8),MASK * 01011000
SR R0,R0 ZERO OUT REG 01012000
CL R0,UDEVPAGE WAS UDEV BUFFER USED 01013000
BE NOTUSED NO BRANCH OVER CODE 01014000
*** IF DEVICE BUFFER WAS USED THAN THE MACHINE BUFFER IS FULL ! 01015000
LR R1,RMACBUF SET UP POINTER TO UMAC BUFFER 01016000
L R2,UMACPAGE SET UP DASD ADD OF BUFFER PAGE 01017000
BAL R14,WRITE WRITE OUT BUFFER 01018000
MVC UMACPAGE,UDEVPAGE SET DASD ADD EQ 01019000
ST R0,UDEVPAGE ZERO OUT DASD ADD (PAGE NOT IN BUFFER) 01020000
XR RMACBUF,RDEVBUF * 01021000
XR RDEVBUF,RMACBUF * REVERSE POINTERS 01022000
XR RMACBUF,RDEVBUF * 01023000
NOTUSED LR RMAC,RDEV POINT TO NEXT MACHINE BLOCK 01024000
L RDIR,DIRPTR GET BUFFER ADDRESS FOR UDIRBLOK @V200731 01025000
LA RDEV,UMACSIZE*8(,RDEV) POINT TO NEXT UDEVBLOK 01026000
LA RDIR,UDIRSIZE*8(,RDIR) POINT TO NEXT UDEVBLOK 01027000
ST RDIR,DIRPTR SAVE THE BUFFER ADDRESS FOR @V200731 01028000
* UDIRBLOK 01029000
LA R1,4096-UDIRSIZE*8(,RDIRBUF) POINT TO END OF BUFFER 01030000
CLR RDIR,R1 IS THE BUFFER FULL 01031000
BNH BILDUDIR NO- GO TO BUILD ENTRY 01032000
USERBFUL BAL R14,GETPAGE GET NEW DASD ADD OF A PAGE 01033000
L RDIR,DIRPTR GET BUFFER ADDRESS FOR UDIRBLOK @V200731 01034000
LR R1,RDIR SAVE POINTER TO UDIRBLOK 01035000
LR RDIR,RDIRBUF POINT TO FIRST UDIRBLOK 01036000
ST RDIR,DIRPTR SAVE THE BUFFER ADDRESS FOR @V200731 01037000
* UDIRBLOK 01038000
SR R1,RDIR CONVERT TO DISPLACEMENT 01039000
SL R1,DIRSIZE AJUST TO POINT TO LAST BLOCK 01040000
STH R1,UDIRDISP POINT TO LAST DIR BLOCK IN PAGE 01041000
LR R1,RDIRBUF POINT TO BUFFER 01042000
ST R2,UDIRDASD POINT TO NEXT DIRECTORY PAGE 01043000
L R3,UDIRPAGE PICK UP OLD PAGE DASD ADD 01044000
ST R2,UDIRPAGE STORE NEW PAGE DASD ADD 01045000
LTR R2,R3 LOAD OLD ADD TO WRITE IT OUT 01046000
BZ *+8 THEN SKIP THE WRITE @VA02180 01047000
BAL R14,WRITE 01048000
L RDIR,DIRPTR GET BUFFER ADDRESS FOR UDIRBLOK @V200731 01049000
BAL R5,CLEARBUF GO CLEAR THE BUFFER TO ZEROES @VA02180 01050000
LA RDIR,UDIRSIZE*8(,RDIR) POINT TO NEXT BLOCK 01051000
ST RDIR,DIRPTR SAVE CURRENT BUFFER ADDR @VA01711 01052000
BILDUDIR MVI UDIRBLOK,X'40' CLEAR FIRST 01053000
MVC UDIRBLOK+1(UDIRSIZE*8-1),UDIRBLOK CLEAR IT OUT 01054000
BAL R14,SCANCARD GET USER ID 01055000
BC 4,ERROR53 ERROR IF NO USER ID 01056000
LA R0,8 SET UP TO TEST LENGTH 01057000
CLR R2,R0 IS IT OVER 8 01058000
BH ERROR51 YES- GET OUT 01059000
MOVE UDIRUSER 01060000
BAL R14,SCANCARD GET PASSWORD 01061000
BC 4,ERROR52 ERROR IF NO PASSWORD 01062000
L RDIR,DIRPTR GET THE BUFFER ADDRESS FOR @V200731 01063000
* UDIRBLOK 01064000
CLR R2,R0 IS LENGTH OVER 8 01065000
BH ERROR51 YES- GET OUT 01066000
CLC 0(6,R1),=C'NOLOG ' IS IT 'NOLOG'?? @VM08715 01067000
BNE *+8 NOPE @VM08715 01068000
OI DIRFLAG,SPECID YES - THIS IS A SPECIAL ID. @VM08715 01069000
MOVE UDIRPASS 01070000
MOVEDISP LR R1,RMAC * LOAD DISPLACEMENT OF UMACBLOK 01071000
L RDIR,DIRPTR GET THE BUFFER ADDRESS FOR @V200731 01072000
* UDIRBLOK 01073000
SLR R1,RMACBUF * INTO UDIRBLOK 01074000
STH R1,UDIRDISP * 01075000
L R2,UMACPAGE * MOVE IN DASD ADD ALSO 01076000
ST R2,UDIRDASD * 01077000
LA R2,4096-UMACSIZE*8 SET UP TO SEE IF MACHINE BUF FULL 01078000
CLR R1,R2 IS RMACBUF FULL 01079000
BNH TESTUDEV NO- GO AND BUILD BLOCK 01080000
LR R1,RMACBUF POINT AT PAGE BUFFER 01081000
L R2,UMACPAGE GET DASD ADD OF PAGE 01082000
BAL R14,WRITE WRITE OUT PAGE 01083000
BAL R14,GETPAGE 01084000
ST R2,UMACPAGE POINT TO NEW PAGE 01085000
LR RMAC,RMACBUF POINT TO RMACBUF 01086000
LA RDEV,UMACSIZE*8(,RMAC) POINT TO FIRST UDEVBLOK 01087000
B MOVEDISP SET UP POINTER AGAIN 01088000
TESTUDEV LR R1,RDEV SAVE POINTER TO RDEV 01089000
SR R1,RMACBUF GET DISPLACEMENT OF BLOCK 01090000
L R2,UMACPAGE GET DASD ADD 01091000
LA R3,4096-UDEVSIZE*8 POINT TO LAST BLOCK 01092000
CLR R1,R3 IS BUFFER FULL 01093000
BNH BILDUMAC NO- BRANCH 01094000
BAL R14,GETPAGE GET NEW PAGE 01095000
ST R2,UDEVPAGE SAVE DASD ADD 01096000
LR RDEV,RDEVBUF POINT TO BUFFER 01097000
SR R1,R1 SET TO PROPER DISPLACEMENT 01098000
BILDUMAC MVI UMACBLOK,X'00' SET UP TO CLEAR BLOCK 01099000
MVC UMACBLOK+1(UMACSIZE*8-1),UMACBLOK CLEAR IT @V407466 01100000
MVI UMACACCT,C' ' SET UP TO BLANK 01101000
MVC UMACACCT+1(23),UMACACCT BLANK BLOCK 01102000
MVC UMACACCT(8),UDIRUSER MOVE INTO ACCOUNT NUMDER @VA08113 01103000
MVC UMACDIST(8),UDIRUSER MOVE INTO DIST. CODE @VA08113 01104000
DROP R15 DROP BASE REGISTER FOR UDIRBLOK @VA08113 01105000
STH R1,UMACDISP SET UP DISP 01106000
ST R2,UMACDASD SET UP DASD ADD 01107000
L R3,=F'262144' SET UP DEFAULT CORE SIZE = 256K 01108000
BAL R5,GETCORE LINK TO SUBROUTINE 01109000
ST R3,UMACCORE SAVE CORE SIZE 01110000
L R3,=F'1048576' SET UP DEFAULT MAX CORE SIZE = 1M 01111000
BAL R5,GETCORE LINK TO SUBROUTINE 01112000
ST R3,UMACMCOR SAVE CORE SIZE 01113000
B SETCMLV 01114000
GETCORE BAL R14,SCANCARD GET CORE SIZE 01115000
BCR 4,R5 IS THERE ANY INPUT -NO- RETURN 01116000
CL R2,=F'2' IS IT LESS THAN 2 01117000
BL ERROR51 01118000
CL R2,=F'8' IS IT OVER 8 01119000
BH ERROR51 YES- ERROR 01120000
BCTR R2,0 -1 01121000
LA R3,0(R2,R1) POINT TO THE LAST BYTE 01122000
BAL R14,BINCONV CONVERT TO BINARY 01123000
SLL R2,10 MULTIPLY BY 1K 01124000
CLI 0(R3),C'K' IS THE LAST DIGIT 'K' 01125000
BE MOVECORE YES- GET OUT 01126000
SLL R2,10 SET UP FOR 'M' 01127000
CLI 0(R3),C'M' IS IT A 'M' 01128000
BNE ERROR51 IF NOT 'K' OR 'M' GO TO ERROR 01129000
MOVECORE LA R3,4095 * ADD 4K-1 01130000
ALR R3,R2 * 01131000
N R3,=X'FFFFF000' SET TO 4K 01132000
CL R3,=F'16777216' IS IT OVER THE MAX SIZE 01133000
BH ERROR51 YES- GO TO THE ERROR ROUTINE 01134000
CL R3,=F'8192' IS IT OVER 8K 01135000
BCR 11,R5 YES- RETURN TO CALLER 01136000
L R3,=F'8192' NO- SET TO 8K 01137000
BR R5 RETURN TO CALLER 01138000
SETCMLV BAL R14,SCANCARD GET COMMAND LEVEL 01139000
BC 4,DEFAULT2 DEFAULT IF NO INPUT 01140000
CL R2,=F'8' IS IT OVER 8 01141000
BH ERROR51 YES- ERROR 01142000
MVI UMACCLEV,X'00' CLEAR OUT COMMAND LEVEL 01143000
LOOP1 LA R3,8 SET UP TO LOOP CMD TABLE FROM A-H 01144000
LOOP2 LA R4,CMDTABLE-1(R3) POINT AT LETTER IN TABLE 01145000
LA R5,0(R2,R1) POINT AT LETTER IN INPUT + 1 01146000
BCTR R5,0 POINT TO LETTER 01147000
CLC 0(1,R4),0(R5) IS IT EQ 01148000
BE TURNON YES- TURN ON BIT 01149000
BCT R3,LOOP2 DO IT 8 TIMES 01150000
B ERROR51 LETTER IS NOT IN TABLE 01151000
TURNON OC UMACCLEV(0),8(R4) TURN ON BIT 01152000
BCT R2,LOOP1 DO IT FOR EACH INPUT LETTER 01153000
B SETPRI 01154000
DEFAULT2 MVI UMACCLEV,X'02' DEFAULT IS 'G' 01155000
SETPRI BAL R14,SCANCARD GET PRIORITY 01156000
BC 4,DEFAULT3 DEFAULT IF NO INPUT 01157000
CL R2,=F'2' IS IT OVER 2 01158000
BH ERROR51 YES GET OUT 01159000
BAL R14,BINCONV CONVERT TO BINARY 01160000
STC R2,UMACPRIR STORE PRIORITY 01161000
B SETCODES GO TO NEXT ROUTINE 01162000
DEFAULT3 MVI UMACPRIR,X'32' SET UP DEFAULT 01163000
SETCODES LA R3,UMACLEND POINT TO LINE END BYTE 01164000
BAL R4,LOOP3 SET UP LINE END 01165000
LA R3,UMACLDEL POINT TO LINE DELETE BYTE 01166000
BAL R4,LOOP3 SET UP LINE DELETE 01167000
LA R3,UMACCDEL POINT TO CHARACTER DELETE BYTE 01168000
BAL R4,LOOP3 SET UP CHARACTER DELETE 01169000
LA R3,UMACES POINT TO THE EDIT SYMBOL 01170000
BAL R4,LOOP3 SET UP EDIT SYMBOL 01171000
BAL R14,READ GET THE NEXT CARD 01172000
LOOP3 BAL R14,SCANCARD GET THE CODE 01173000
BC 4,DEFAULT4 DEFAULT IF NO INPUT 01174000
CL R2,=F'2' IS IT 2 01175000
BH TESTOFF NO- GO TO TEST FOR OFF 01176000
BE TESTON YES- GO TO ON 01177000
MVC 0(1,R3),0(R1) IT IS ONLY 1 BYTE SO MOVE IT IN 01178000
BR R4 GO BACK TO CALLER 01179000
TESTON CLC 0(3,R1),=C'ON ' IS IT ON 01180000
BNE HEX NO- IT MUST BE HEX INPUT 01181000
DEFAULT4 MVI 0(R3),X'FF' YES- INDICATE THAT THE DEF IS TO BE USED 01182000
BR R4 RETURN TO CALLER 01183000
TESTOFF CLC 0(4,R1),=C'OFF ' IS IT OFF 01184000
BNE ERROR51 NO- ERROR GET OUT 01185000
MVI 0(R3),X'00' YES- INDICATE THAT THE FEATURE IS OFF 01186000
BR R4 RETURN TO CALLER 01187000
HEX BAL R14,HEXCONV CONVERT FROM HEX 01188000
STC R2,0(R3) MOVE IN BYTE 01189000
BR R4 RETURN TO CALLER 01190000
CLEARBUF EQU * @VA02180 01191000
STM R2,R5,REGSAVE SAVE THE REGS @VA02180 01192000
LR R2,R15 PUT BUFF. START ADDRESS IN R2 @VA02180 01193000
L R3,F4096 LOAD LENGTH OF BUFFER @VA02180 01194000
SLR R4,R4 DUMMY ADDRESS FOR MVCL @VA02180 01195000
SLR R5,R5 LENGTH AND PADDING @VA02180 01196000
MVCL R2,R4 CLEAR THE BUFFER @VA02180 01197000
LM R2,R5,REGSAVE RESTORE THE REGS @VA02180 01198000
BR R5 RETURN @VA02180 01199000
EJECT 01200000
****************************************************************** 01201000
*. 01202000
* ACCOUNT CARD SCAN ROUTINE 01203000
* 01204000
* 1. IF THE LAST CARD WAS NOT A USER, OPTION OR 01205000
* IPL CARD GO TO ERROR52. 01206000
* 01207000
* 2. FILL IN THE ACCOUNT NUMBER AND DISTRIBUTION CODE. 01208000
* 01209000
* 3. GO TO READ AND GET THE NEXT CARD. 01210000
*. 01211000
****************************************************************** 01212000
SCANACCO CLI LASTCARD,C'U' WAS THE LAST CARD A USER CARD 01213000
BE GETACCO 01214000
CLI LASTCARD,C'O' WAS THE LAST CARD AN OPTION CARD 01215000
BE GETACCO 01216000
CLI LASTCARD,C'I' WAS IT AN IPL CARD 01217000
BNE ERROR52 NO- ERROR 01218000
GETACCO BAL R14,SCANCARD GET ACCOUNT NUMBER 01219000
BC 4,READ ERROR IF NO INPUT 01220000
CL R2,=F'8' IS IT OVER 8 01221000
BH ERROR51 YES- ERROR 01222000
MVI UMACACCT,C' ' BLANK OUT FIELD BEFORE @VA08113 01223000
MVC UMACACCT+1(7),UMACACCT MOVE @VA08113 01224000
MOVE UMACACCT 01225000
BAL R14,SCANCARD GET DISTRIBUTION CODE 01226000
BC 4,READ NO INPUT GET OUT 01227000
CL R2,=F'8' IS IT OVER 8 01228000
BH ERROR51 YES- ERROR 01229000
MVI UMACDIST,C' ' BLANK OUT FIELD BEFORE @VA08113 01230000
MVC UMACDIST+1(7),UMACDIST MOVE @VA08113 01231000
MOVE UMACDIST 01232000
B READ GO GET THE NEXT CARD 01233000
EJECT 01234000
****************************************************************** 01235000
*. 01236000
* OPTION CARD SCAN ROUTINE 01237000
* 01238000
* 1. IF THE LAST CARD WAS NOT A USER, ACCOUNT OR 01239000
* IPL CARD GO TO ERROR52. 01240000
* 01241000
* 2. FILL IN THE OPTIONS IN THE UMACBLOK. 01242000
* 01243000
* 3. GO TO READ TO READ IN THE NEXT CARD. 01244000
*. 01245000
****************************************************************** 01246000
SCANOPTI CLI LASTCARD,C'U' WAS THE LAST CARD A USER CARD 01247000
BE OPT1 YES- GO 01248000
CLI LASTCARD,C'A' WAS THE LAST CARD AN ACCOUNT CARD 01249000
BE OPT1 01250000
CLI LASTCARD,C'I' WAS THE LAST CARD A IPL CARD 01251000
BE OPT1 YES, KEEP GOING @V407466 01252000
CLI LASTCARD,C'O' ANOTHER 'OPTION' CARD @V407466 01253000
BNE ERROR52 NO, ERROR @V407466 01254000
OPT1 BAL R14,SCANCARD GET OPTION 01255000
BC 4,READ NO INPUT GO TO READ NEXT CARD 01256000
COMP =C'REALTIMER ' * SET ON OPTION BIT 01257000
BNE OPT2 * SET OPTION BIT IF INPUT 01258000
OI UMACOPT,UMACRT * IS EQ TO KEYWORD. 01259000
B OPT1 * ERROR IF NOT EQ. 01260000
OPT2 COMP =C'ECMODE ' * 01261000
BNE OPT3 * 01262000
OI UMACOPT,UMACECOP * 01263000
B OPT1 * 01264000
OPT3 COMP =C'ISAM ' * 01265000
BNE OPT4 * 01266000
OI UMACOPT,UMACISAM * 01267000
B OPT1 * 01268000
OPT4 COMP =C'VIRT=REAL ' * 01269000
BNE OPT5 01270000
OI UMACOPT,UMACVROP * 01271000
B OPT1 * 01272000
OPT5 COMP =C'ACCT ' 01273000
BNE OPT6 @V201537 01274000
OI UMACOPT,UMACACC SET THE ACCOUNTING OPTION 01275000
B OPT1 01276000
OPT6 COMP =C'SVCOFF ' * @V407466 01277000
BNE OPT7 @VA01771 01278000
OI UMACOPT,UMACNSVC SET THE SVCOFF BIT @V201537 01279000
B OPT1 @V201537 01280000
OPT7 COMP =C'BMX ' BMX OPTION ? @V407466 01281000
BNE OPT8 NO BRANCH @V407466 01282000
OI UMACOPT,UMACBMX SET BLOCK MULTIPLEXER OPTION @VA01771 01283000
B OPT1 @VA01771 01284000
OPT8 COMP =C'CPUID' CPUID OPTION? @V407466 01285000
BNE OPT9 @V407546 01286000
BAL R14,SCANCARD GET CPUID SERIAL @V407466 01287000
BC 4,ERROR53 MISSING 'BBBBBB' FIELD @V407466 01288000
CL R2,=F'6' GREATER THAN 6 - ERROR @V407466 01289000
BH ERROR51 ERROR @V407466 01290000
BAL R14,HEXCONV CVT 'BBBBBB' FROM HEX TO BIN @V407466 01291000
STCM R2,B'0111',UMACPUID STORE CONVERTED CPUID @V407466 01292000
OI UMACOPT2,UMACCPU TURN BIT ON IN UMACBLOK @V407466 01293000
B OPT1 GET NEXT INPUT CARD @V407466 01294000
OPT9 COMP =C'AFFINITY' @V407546 01295000
BNE OPT10 NO HRC011DK 01296490
BAL R14,SCANCARD GET AFFINITY CPU ADDRESS @V407546 01297000
BC 4,ERROR53 MISSING AFFINITY 'AA' @V407546 01298000
CL R2,=F'2' GREATER THAN 2 --ERROR @V407546 01299000
BH ERROR51 @V407546 01300000
BAL R14,BINCONV CVT 'AA' TO BINARY @V407546 01301000
CL R2,=F'63' GREATER THAN 63 --ERROR @V407546 01302000
BNH OPT9OK @V407546 01303000
LM R1,R2,SAVEREGS RESTORE POINTER AND LENGTH @V407546 01304000
B ERROR51 HANDLE ERROR @V407546 01305000
OPT9OK STC R2,UMACAFF STORE CPU ADDR IN UMACBLOK @V407546 01306000
OI UMACAFF,UMACFFON SET AFFINITY FLAG @V407546 01307000
B OPT1 GET NEXT OPTION @V407546 01308000
OPT10 COMP =C'LNKNOPAS ' HRC011DK 01308200
BNE OPT11 NO HRC068DK 01308410
OI UMACOPT2,UMADLNKN TURN BIT ON IN UMACBLOK HRC011DK 01308600
B OPT1 GET NEXT INPUT CARD HRC011DK 01308800
OPT11 COMP =C'STFIRST ' HRC068DK 01308900
BNE ERROR51 NO,INVALID KEYWORD HRC068DK 01308910
OI UMACOPT2,UMAST1ST TURN BIT ON IN UMACBLOK HRC068DK 01308920
B OPT1 GET NEXT INPUT CARD HRC068DK 01308930
EJECT 01309000
****************************************************************** 01310000
*. 01311000
* IPL CARD SCAN ROUTINE 01312000
* 01313000
* 1. IF THE LAST WAS NOT A USER, ACCOUNT OR 01314000
* OPTION CARD GO TO ERROR52. 01315000
* 01316000
* 2. FILL IN THE UMACIPL FIELD IN THE UMACBLOK. 01317000
* 01318000
* 3. GO TO READ TO READ IN THE NEXT CARD. 01319000
*. 01320000
****************************************************************** 01321000
SCANIPL CLI LASTCARD,C'U' WAS THE LAST CARD A USER CARD 01322000
BE GETNAME YES- BRANCH 01323000
CLI LASTCARD,C'A' WAS IT AN ACCO CARD 01324000
BE GETNAME YES- BRANCH 01325000
CLI LASTCARD,C'O' WAS IT AN OPTI CARD 01326000
BNE ERROR52 NO- ERROR 01327000
GETNAME BAL R14,SCANCARD GET IPL SYSTEM 01328000
BC 4,READ GET OUT IF NO INPUT 01329000
CL R2,=F'8' IS IT OVER 8 01330000
BH ERROR51 YES- ERROR 01331000
MOVE UMACIPL 01332000
B READ 01333000
SPACE 3 01334000
****************************************************************** 01335000
*. 01336000
* CONSOLE CARD SCAN ROUTINE 01337000
* 01338000
* 1. SET UP VIRTUAL DEVICE ADDRESS. 01339000
* 01340000
* 2. FILL IN THE DEVICE CLASS FROM TABLE3. 01341000
* 01342000
* 3. SET UP THE SPOOL CLASS. 01343000
* 01344000
* 4. GO TO CHAINDEV IN SCANMDIS TO CHAIN IN THE UDEVBLOK. 01345000
*. 01346000
****************************************************************** 01347000
SCANCONS MVI UDEVBLOK,X'0' * ZERO OUT BLOCK 01348000
MVC UDEVBLOK+1(UDEVSIZE*8-25),UDEVBLOK * 01349000
BAL R14,SCANCARD GET DEVICE ADD 01350000
BC 4,ERROR53 ERROR IF NO INPUT 01351000
CL R2,=F'4' IS SIZE OVER 4 01352000
BH ERROR51 YES- ERROR 01353000
BAL R14,HEXCONV GET DEVICE ADD AND CONVERT IT TO DEC 01354000
STH R2,UDEVADD STORE DEVICE ADD 01355000
BAL R14,SCANCARD GET DEVICE TYPE 01356000
BC 4,ERROR53 ERROR IF NO INPUT 01357000
LA R4,TABLE3 POINT TO THE TABLE 01358000
BAL R14,SCANNAME SUBROUTINE WILL MOVE DEVICE TYPE X01359000
AND CLASS INTO UDEVTYPE AND UDEVTYPC 01360000
BC 4,CONCLASS BRANCH IF INPUT WAS PRESCANED @V200930 01361000
BAL R14,SCANCARD GET OUTPUT CLASS @V200930 01362000
BC 4,DEFAULT9 DEFAULT TO T IF NO INPUT @V200930 01363000
CONCLASS CL R2,=F'1' IS COUNT EQ 1 @V200930 01364000
BNE ERROR51 NO - ERROR @V200930 01365000
MVC UDEVCLAS(1),0(R1) MOVE IN SPOOL CLASS @V200930 01366000
B CHAINDEV @V200930 01367000
DEFAULT9 MVI UDEVCLAS,C'T' DEFAULT TO CLASS T @V200930 01368000
B CHAINDEV 01369000
SPACE 3 01370000
****************************************************************** 01371000
*. 01372000
* MDISK CARD SCAN ROUTINE 01373000
* 01374000
* 1. SET UP THE VIRTUAL DEVICE ADDRESS. 01375000
* 01376000
* 2. FILL IN THE DEVICE CLASS FROM TABLE4. 01377000
* 01378000
* 3. IF THIS IS A T-DISK TURN ON THE T-DISK FLAG, 01379000
* ELSE TURN ON THE LONG BLOCK FLAG AND FILL IN THE 01380000
* CYLINDER RELOCATION. 01381000
* 01382000
* 5. FILL IN THE CYLINDER SIZE, IF T-DISK GO TO 01383000
* CHAINDEV IN STEP 7. 01384000
* 01385000
* 6. FILL IN VOL SER NO, MODE AND PASSWORDS. 01386000
* 01387000
* CHAINDEV & CHAINCU - COMMON SUBROUTINE 01388000
* 01389000
* 7. IF DEVICE(S) IS(ARE) DEFINED TWICE GO TO ERROR58. 01390000
* 01391000
* 8. MASK OFF THE UDEVBLOK. 01392000
* 01393000
* 9. IF THE BUFFER IS FULL AND THE UDEV BUFFER IS NOT 01394000
* USED, GO TO STEP 10. ELSE WRITE OUT THE UDEV BUFFER. 01395000
* 01396000
* 10. GET A DASD ADDRESS FOR THE UDEV BUFFER. 01397000
* 01398000
* 11. UPDATE POINTERS TO THE NEXT UDEVBLOK AND GOTO READ. 01399000
*. 01400000
***************************************************************** 01401000
SCANMDIS MVI UDEVBLOK,X'0' * ZERO OUT BLOCK 01402000
MVC UDEVBLOK+1(UDEVSIZE*8-1),UDEVBLOK * 01403000
MVI UDEVVSER,C' ' * BLANK IT 01404000
MVC UDEVVSER+1(29),UDEVVSER * 01405000
SR R0,R0 01406000
BAL R14,SCANCARD GET DEVICE ADD 01407000
BC 4,ERROR53 ERROR IF NO INPUT 01408000
CL R2,=F'4' IS SIZE OVER 4 01409000
BH ERROR51 YES- ERROR 01410000
BAL R14,HEXCONV GET DEVICE ADD AND CONVERT IT TO DEC 01411000
STH R2,UDEVADD STORE DEVICE ADD 01412000
BAL R14,SCANCARD GET DEVICE TYPE 01413000
BC 4,ERROR53 ERROR IF NO INPUT 01414000
LA R4,TABLE4 POINT TO THE TABLE 01415000
BAL R14,SCANNAME SUBROUTINE WILL MOVE DEVICE TYPE X01416000
AND CLASS INTO UDEVTYPE AND UDEVTYPC 01417000
BC 4,TESTCYLR BRANCH IF INPUT CARD WAS PRESCANED 01418000
BAL R14,SCANCARD 01419000
BC 4,ERROR53 BUILD SHORT UDIRBLOK IF LAST INPUT LINE 01420000
TESTCYLR COMP =C'T-DISK' IS IT THE KEYWORD T-DISK 01421000
BNE LONG NO- BRANCH 01422000
MVI UDEVSTAT,UDEVTDSK INDICATE THIS IS A T-DISK 01423000
B GETCYLNO 01424000
LONG MVI UDEVSTAT,UDEVLONG INDICATE THIS IS A LONG BLOCK 01425000
CL R2,=F'4' IS IT OVER 4 DIGITS? HRC011DK 01426270
BH ERROR51 YES- ERROR 01427000
SAVESTRT DS 0H HRC011DK 01427500
BAL R14,BINCONV CONVERT TO BINARY 01428000
STH R2,UDEVRELN SET IN CYL RELOCATION 01429000
GETCYLNO BAL R14,SCANCARD GET SIZE OF DISK 01430000
BC 4,ERROR53 ERROR IF NO INPUT 01431000
CL R2,=F'4' IS IT OVER 4 DIGITS? HRC011DK 01432270
BH ERROR51 YES- ERROR 01433000
SAVESIZE DS 0H HRC011DK 01433500
BAL R14,BINCONV * CONVERT TO BINARY 01434000
STH R2,UDEVNCYL * 01435000
LTR R2,R2 IS IT 0 CYLINDERS? @VA12689 01435030
BNZ NOTZERO NO-CONTINUE @VA12689 01435060
L R2,SAVEREGS+4 RESTORE LENGTH @VA12689 01435090
B ERROR51 AND PRINT ERROR MESSAGE @VA12689 01435120
NOTZERO EQU * @VA12689 01435150
TM UDEVSTAT,UDEVTDSK IS THIS A T-DISK 01436000
BO CHAINDEV YES- EXIT 01437000
BAL R14,SCANCARD 01438000
BC 4,ERROR53 ERROR IF NO INPUT 01439000
CL R2,=F'6' 01440000
BH ERROR51 NO- ERROR 01441000
MOVE UDEVVSER SET UP VOL SER NO 01442000
BAL R14,SCANCARD GET FILE MODE 01443000
BC 4,DEFAULT5 DEFAULT IF NO MODE 01444000
BAL R5,MODESCAN GO FILL IN THE MODE 01445000
B GETPASS 01446000
DEFAULT5 OI UDEVMODE,UDEVW INDICATE DISK IS TO BE IN WRITE MODE 01447000
GETPASS LA R4,SCANPASS * LINK TO PASSWORD SUBROUTINE 01448000
BALR R3,R4 * AND MOVE IT TO THE UDEVBLOK 01449000
MOVE UDEVPASR * 01450000
OI UDEVMODE,UDEVLR * 01451000
BALR R3,R4 * 01452000
MOVE UDEVPASW * 01453000
OI UDEVMODE,UDEVLW * 01454000
BALR R3,R4 * 01455000
MOVE UDEVPASM * 01456000
OI UDEVMODE,UDEVLM * 01457000
B BLANKALL GO MASK THE PASSWORDS 01458000
SCANPASS BAL R14,SCANCARD 01459000
BC 4,BLANKALL EXIT IF NO INPUT 01460000
CL R2,=F'8' IS IT OVER 8 01461000
BH ERROR51 YES- ERROR 01462000
BR R3 RETURN TO CALLER 01463000
BLANKALL XC UDEVPASR,MASK * MASK THE PASSWORD 01464000
XC UDEVPASW,MASK * 01465000
XC UDEVPASM,MASK * 01466000
CHAINDEV SR R0,R0 * SET UP THE DEVICE 01467000
BCTR R0,0 * COMPARE MASK. 01468000
CHAINCU DS 0H THE CONTROL UNIT MASK WILL BE SET UP BY *01469000
THE CALLING ROUTINE. 01470000
LH R1,UDEVADD * CHECK TO SEE IF THIS 01471000
LH R2,UMACDISP * UNIT WAS DEFINED. IF 01472000
LR R3,RMACBUF * DEFINED THEN GO TO 01473000
SCAN LTR R2,R2 * THE ERROR ROUTINE. 01474000
BNZ COMPUADD * 01475000
CR R3,RDEVBUF * 01476000
BE SKIPLOOP * 01477000
LR R3,RDEVBUF * NOTE: IF THE NUMBER 01478000
COMPUADD AR R2,R3 * OF UDEVBLOK'S EXCEEDS 01479000
LH R4,UDEVADD-UDEVBLOK(R2) * THE CAPACITY OF THE 01480000
NR R4,R0 * RDEVBUF, CHECKING 01481000
CLR R1,R4 * WILL BE TERMINATED. 01482000
BE TESTSAME * BUFFERS WRITTEN OUT 01483000
LH R2,UDEVDISP-UDEVBLOK(R2) * ONTO THE DISK WILL 01484000
B SCAN * NOT BE CHECKED. 01485000
TESTSAME CLR R2,RDEV * (OVER 90 UDEVBLOK'S) 01486000
BNE ERROR58 * 01487000
SKIPLOOP SR R0,R0 ZERO REG 0 TO USE LATER 01488000
LA R5,UDEVSIZE*8-24(,RDEV) * POINT TO NEXT UDEVBLOK 01489000
TM UDEVSTAT,UDEVLONG * 01490000
BZ SETPOINT 01491000
LA R5,UDEVSIZE*8(,RDEV) * 01492000
SETPOINT XC UDEVBLOK+8(8),MASK * MASK THE BLOCK 01493000
XC UDEVBLOK+16(8),MASK * 01494000
LR R4,RDEVBUF * SET POINTERS TO THE BUFFER THE 01495000
L R2,UDEVPAGE * UDEVBLOK IS IN. POINT TO RDEVBUF 01496000
LTR R2,R2 * IF THE BUFFER WAS USED OR RMACBUF 01497000
BNZ SETDISP * IF RDEVBUF WAS NOT USED. 01498000
LR R4,RMACBUF * 01499000
L R2,UMACPAGE *** 01500000
SETDISP LR R3,R5 * GET DISPLACEMANT OF NEXT UDEVBLOK 01501000
SR R3,R4 * 01502000
CLI NEXTCARD,C'U' IS THE NEXT CARD A USER CARD 01503000
BE LASTDEV YES- BRANCH 01504000
STH R3,UDEVDISP SET UP DASP OF NEXT BLOCK 01505000
ST R2,UDEVDASD SET UP DASD ADD OF PAGE 01506000
B UPDATECT 01507000
LASTDEV STH R0,UDEVDISP ZERO OUT DISP 01508000
ST R0,UDEVDASD ZERO OUT DASD ADD 01509000
UPDATECT LH R1,UMACDVCT * UPDATE DEVICE COUNT IN UMACBLOK 01510000
LA R1,1(,R1) * 01511000
STH R1,UMACDVCT * 01512000
LA R1,4096-(UDEVSIZE*8)+24 * POINT TO END OF BUFFER 01513000
CLI NEXTCARD,C'M' * 01514000
BNE TESTBUF * 01515000
LA R1,4096-UDEVSIZE*8 * 01516000
TESTBUF CLR R3,R1 IS THE BUFFER FULL 01517000
BNH UPDATE NO- BRANCH 01518000
BAL R14,GETPAGE 01519000
CLI NEXTCARD,C'U' IS THE NEXT CARD A USER CARD 01520000
BE TESTBUFF YES- BRANCH 01521000
STH R0,UDEVDISP SET UP NEW DISP 01522000
ST R2,UDEVDASD SET UP NEW DASD ADD OF BUFFER 01523000
TESTBUFF L R1,UDEVPAGE * REVERSE POINTERS AND TEST TO SEE 01524000
ST R2,UDEVPAGE * IF UDEVBUF WAS USED. IF NOT USED 01525000
LTR R2,R1 * DO NOT WRITE BUFFER OUT. 01526000
BZ POINTDEV * 01527000
LR R1,RDEVBUF POINT AT BUFFER TO WRITE OUT 01528000
BAL R14,WRITE WRITE OUT FULL RDEVBUF 01529000
POINTDEV LR R5,RDEVBUF UPDATE POINTER TO NEXT UDEVBLOK 01530000
UPDATE LR RDEV,R5 POINT TO NEXT UDEVBLOK 01531000
B READ 01532000
SPACE 3 01533000
******************************************************************* 01534000
*. 01535000
* SPOOL CARD SCAN ROUTINE 01536000
* 01537000
* 1. SET UP THE VIRTUAL DEVICE ADDRESS. 01538000
* 01539000
* 2. SCAN TABLE5 TO FILL IN THE DEVICE CLASS. 01540000
* 01541000
* 3. SET UP THE SPOOL CLASS. 01542000
* 01543000
* 4. GO TO CHAINDEV IN SCANMDIS TO CHAIN IN THE UDEVBLOK. 01544000
*. 01545000
****************************************************************** 01546000
SCANSPOO MVI UDEVBLOK,X'00' SET UP TO ZERO BLOCK 01547000
MVC UDEVBLOK+1(UDEVSIZE*8-25),UDEVBLOK ZERO IT 01548000
MVI UDEVSTAT,UDEVSPOO TURN ON SPOOL BIT 01549000
BAL R14,SCANCARD GET DEVICE ADDRESS 01550000
BC 4,ERROR53 ERROR IF NO INPUT 01551000
CL R2,=F'3' IS SIZE OVER 3 01552000
BH ERROR51 YES- ERROR 01553000
BAL R14,HEXCONV 01554000
STH R2,UDEVADD STORE DEVICE ADD 01555000
BAL R14,SCANCARD GET DEVICE TYPE 01556000
BC 4,ERROR53 ERROR IF NO INPUT 01557000
LA R4,TABLE5 POINT TO THE TABLE 01558000
BAL R14,SCANNAME GET OUTPUT CLASS AND TYPE 01559000
BC 4,TESTCLAS BRANCH IF INPUT WAS PRESCANED 01560000
BAL R14,SCANCARD GET OUTPUT CLASS 01561000
BC 4,DEFAULT8 DEFAULT TO A IF NO INPUT 01562000
TESTCLAS CL R2,=F'1' IS COUNT EQ 1 01563000
BNE ERROR51 NO- ERROR 01564000
MVC UDEVCLAS(1),0(R1) MOVE IN SPOOL CLASS 01565000
B CHAINDEV 01566000
DEFAULT8 DS 0H @VA09980 01567000
CLI UDEVTYPC,CLASURI TEST FOR INPUT @VA09980 01567100
BE DEFAUL14 GO TO INPUT DEFAULT @VA09980 01567200
MVI UDEVCLAS,C'A' DEFAULT TO CLASS A @VA09980 01567300
B CHAINDEV @VA09980 01567400
DEFAUL14 DS 0H @VA09980 01567500
MVI UDEVCLAS,C'*' DEFAULT TO CLASS * @VA09980 01567600
B CHAINDEV 01568000
EJECT 01569000
****************************************************************** 01570000
*. 01571000
* DEDICATE CARD SCAN ROUTINE 01572000
* 01573000
* 1. TURN ON THE DEDICATE BIT AND SET UP THE VIRTUAL 01574000
* DEVICE ADDRESS. 01575000
* 01576000
* 2. SET UP THE VIRTUAL DEVICE ADDRESS OR MOVE IN THE 01577000
* DASD VOL SER NO. 01578000
* 01579000
* 3. GO TO CHAINDEV IN SCANMDIS TO CHAIN IN THE UDEVBLOK. 01580000
*. 01581000
******************************************************************* 01582000
SCANDEDI MVI UDEVBLOK,X'00' SET UP TO ZERO UDEVBLOK 01583000
MVC UDEVBLOK+1(UDEVSIZE*8-25),UDEVBLOK DO IT 01584000
MVI UDEVVSER,C' ' * BLANK OUT BLOCK 01585000
MVC UDEVVSER+1(5),UDEVVSER * 01586000
MVI UDEVSTAT,UDEVDED TURN ON DEDICATE BIT 01587000
MVI UDEVLINK,UDEVNORA INITIALIZE TO 8000 @VA11411 01587010
BAL R14,SCANCARD GET DEVICE ADD 01588000
BC 4,ERROR53 ERROR IF NO INPUT 01589000
CL R2,=F'3' IS SIZE OVER 3 01590000
BH ERROR51 YES- ERROR 01591000
BAL R14,HEXCONV CONVERT FROM HEX 01592000
STH R2,UDEVADD STORE DEVICE ADD 01593000
BAL R14,SCANCARD GET REAL DEVICE ADD OR VOL SER NO 01594000
BC 4,ERROR53 ERROR IF NO INPUT 01595000
CL R2,=F'3' IS IT A VOLUME SERIAL NUMBER 01596000
BNH TESTRDEV NO- BRANCH 01597000
CLC VOLID,0(R1) 'VOLID' SPECIFIED @VA11371 01598010
BNE SKIPVS1 NO SKIP GOING TO NEXT PARM @VA11371 01598020
BAL R14,SCANCARD YES- GO GET THE VOLID 01600000
SKIPVS1 DS 0H @VA11371 01600010
CL R2,=F'6' TOO BIG 01601000
BH ERROR51 YES- ERROR 01602000
MOVE UDEVVSER 01603000
B TEST333V CHECK FOR STATUS DESIRED @V60B6B8 01604000
TESTRDEV BAL R14,HEXCONV GET DEVICE ADD AND ALINE IT IN R2 01605000
STH R2,UDEVLINK STORE LINK DEVICE ADDRESS 01606000
B TESTVOL1 GO TEST FOR VOLSER @V60B6B8 01607000
TESTREAD BAL R14,SCANCARD LOOK FOR ANOTHER PARM @VA02483 01608000
CL R2,=F'1' IS THERE ONE? @VA02483 01609000
BL WRTSTAT NO, DEFAULT IS WRITE STATUS @VA02483 01610000
TESTRO EQU * TEST FOR 'R/O' PARAMETER @V60B6B8 01611000
CLC RONLY,0(R1) WAS 'R/O' SPECIFIED @VA11371 01612010
BE CHAINDEV YES, DON'T SET WRITE STATUS @VA02483 01613000
B ERROR51 ALL OTHERS ARE INVALID @VA02483 01614000
TESTVOL1 EQU * TEST FOR THE VOLSER PARAMETER @V60B6B8 01615000
* 01616000
* HAVE FOUND 'VADDR' AND 'RADDR' SO FAR. TEST 01617000
* TO SEE IF THERE IS ALSO A 'VOLSER'. 01618000
* 01619000
BAL R14,SCANCARD SCAN FOR THE NEXT PARAMETER @V60B6B8 01620000
CL R2,FONE IS THERE ANOTHER? @V60B6B8 01621000
BL WRTSTAT NO, SET DEFAULT ACCESS TYPE @V60B6B8 01622000
CLC VIRTC,0(R1) WAS '3330V' SPECIFIED @VA11371 01623010
BE SETFTR YES, SET FEATURE=VIRTUAL @V60B6B8 01624000
CLC RONLY,0(R1) WAS R/O SPECIFIED @VA11371 01625010
BE CHAINDEV YES, DO NOT SET WRITE STATUS @V60B6B8 01626000
* 01627000
* THIS PARAMETER MUST BE A VOLUME SERIAL 01628000
* 01629000
CLC VOLID,0(R1) WAS 'VOLID' SPECIFIED @VA11371 01630010
BNE SKIPVS2 NO SKIP SKIPPING TO NEXT PARM @VA11371 01630020
BAL R14,SCANCARD YES,GO GET THE VOLID @V60B6B8 01632000
SKIPVS2 DS 0H @VA11371 01632010
CL R2,FONE WAS THERE A PARAMETER? @V60B6B8 01633000
BL ERROR51 NO, ERROR @V60B6B8 01634000
CL R2,=F'6' TOO BIG? @V60B6B8 01635000
BH ERROR51 YES,ERROR @V60B6B8 01636000
MOVE UDEVVSER MOVE IN VOLID @V60B6B8 01637000
TEST333V EQU * SEE IF THE NEXT PARAMETER IS @V60B6B8 01638000
* '3330V' 01639000
BAL R14,SCANCARD GET NEXT PARAMETER @V60B6B8 01640000
CL R2,FONE WAS THERE ONE @V60B6B8 01641000
BL WRTSTAT NO, SET DEFAULT ACCESS TYPE @V60B6B8 01642000
CLC VIRTC,0(R1) WAS 3330V SPECIFIED @VA11371 01643010
BNE TESTRO NO, TEST FOR 'R/O' @V60B6B8 01644000
SETFTR EQU * SET FEATURE = FTRVIRT @V60B6B8 01645000
MVI UDEVFTR,VIRTUAL SET FEATURE CODE IN UDEVBLOK @V60B6B8 01646000
BAL R14,SCANCARD GET NEXT PARAMETER @V60B6B8 01647000
CL R2,FONE WAS THERE ONE? @V60B6B8 01648000
BL WRTSTAT NO, SET DEFAULT ACCESS TYPE @V60B6B8 01649000
B TESTRO NOW TEST FOR 'R/O' @V60B6B8 01650000
WRTSTAT OI UDEVMODE,UDEVW SET WRITE STATUS @VA02483 01651000
B CHAINDEV 01652000
EJECT 01653000
****************************************************************** 01654000
*. 01655000
* LINK CARD SCAN ROUTINE 01656000
* 01657000
* 1. SET UP THE USERID, LINK DEVICE ADDRESS AND 01658000
* TURN ON THE LINK BIT. 01659000
* 01660000
* 2. SET UP THE VIRTUAL DEVICE ADDERSS AND MODE. 01661000
* 01662000
* 3. GO TO CHAINDEV IN SCANMDIS TO CHAIN IN THE UDEVBLOK. 01663000
*. 01664000
****************************************************************** 01665000
SCANLINK MVI UDEVBLOK,X'00' SET UP TO ZERO BLOCK 01666000
MVC UDEVBLOK+1(UDEVSIZE*8-25),UDEVBLOK DO IT 01667000
MVI UDEVLKID,C' ' * BLANK BLOCK 01668000
MVC UDEVLKID+1(7),UDEVLKID * 01669000
MVI UDEVSTAT,UDEVLKDV TURN ON LINK DEVICE BIT 01670000
BAL R14,SCANCARD GET USER ID 01671000
BC 4,ERROR53 ERROR IF NO INPUT 01672000
CL R2,=F'8' IS IT OVER 8 01673000
BH ERROR51 YES- ERROR 01674000
MVI UDEVLKID,X'40' SET UP TO BLANK USER ID 01675000
MVC UDEVLKID+1(7),UDEVLKID BLANK OUT BLOCK 01676000
MOVE UDEVLKID 01677000
BAL R14,SCANCARD GET LINK DEVICE ADD 01678000
BC 4,ERROR53 ERROR IF NO INPUT 01679000
CL R2,=F'3' IS IT OVER 3 01680000
BH ERROR51 YES- ERROR 01681000
BAL R14,HEXCONV GET DEVICE ADD AND ALINE IT IN R2 01682000
STH R2,UDEVLINK STORE LINK DEVICE ADDRESS 01683000
BAL R14,SCANCARD GET DEVICE ADDRESS 01684000
BC 4,DEFAULT6 DEFAULT TO LINK DEVICE IF NO INPUT 01685000
CL R2,=F'3' IS IT OVER 3 01686000
BH ERROR51 YES- ERROR 01687000
BAL R14,HEXCONV CONVERT FROM HEX 01688000
STH R2,UDEVADD STORE DEVICE ADDRESS 01689000
BAL R14,SCANCARD GET FILE MODE 01690000
BC 4,DEFAULT7 DEFAVLT TO R IF NO INPUT 01691000
LA R5,CHAINDEV SET RETURN ADDRESS FOR MODESCAN 01692000
SPACE 2 01693000
MODESCAN BCTR R2,0 -1 01694000
LA R3,MODETABL POINT TO THE TABLE 01695000
LA R4,14 14 ENTRIES IN MODETABLE @V407466 01696000
LOOP12 EX R2,EXECOMP COMPARE THE TABLE ENTRY TO THE INPUT 01697000
BE MODEOK BRANCH IF IT IS EQ 01698000
LA R3,4(,R3) POINT TO NEXT ENTRY IN TABLE @V407466 01699000
BCT R4,LOOP12 DO IT UP TO 7 TIMES 01700000
LA R2,1(,R2) ADD ONE FOR THE ERROR MSG 01701000
B ERROR51 GO TYPE THE MSG 01702000
MODEOK OC UDEVMODE(1),3(R3) OR IN MODE @V407466 01703000
CH R4,=H'7' IF R4 < OR = 7 - VIRT. RES/REL. @V407466 01704000
BCR 2,R5 HIGH - NO VIRTUAL RES/REL @V407466 01705000
OI UDEVSTAT,UDEVVRR VIRTUAL RES/REL REQUESTED @V407466 01706000
BR R5 RETURN TO THE CALLER 01707000
DEFAULT6 MVC UDEVADD,UDEVLINK 01708000
DEFAULT7 OI UDEVMODE,UDEVR TURN ON READ BIT 01709000
B CHAINDEV 01710000
SPACE 3 01711000
****************************************************************** 01712000
*. 01713000
* SPECIAL CARD SCAN ROUTINE 01714000
* 01715000
* 1. SET UP THE VIRTUAL DEVICE ADDRESS. 01716000
* 01717000
* 2. SCAN TABLE3 TO GET THE DEVICE CLASS. 01718000
* 01719000
* 3. GO TO CHAINDEV IN SCANMDIS TO CHAIN IN THE UDEVBLOK. 01720000
*. 01721000
****************************************************************** 01722000
SCANSPEC MVI UDEVBLOK,X'0' * ZERO OUT BLOCK 01723000
MVC UDEVBLOK+1(UDEVSIZE*8-25),UDEVBLOK * 01724000
BAL R14,SCANCARD GET DEVICE ADD 01725000
BC 4,ERROR53 ERROR IF NO INPUT 01726000
CL R2,=F'3' IS SIZE OVER 3 01727000
BH ERROR51 YES- ERROR 01728000
STM R1,R2,CTCASAVE SAVE THE POINTER'S TO DEV ADD FOR CTCA 01729000
BAL R14,HEXCONV GET DEVICE ADD AND CONVERT IT TO DEC 01730000
STH R2,UDEVADD STORE DEVICE ADD 01731000
BAL R14,SCANCARD GET DEVICE TYPE 01732000
BC 4,ERROR53 ERROR IF NO INPUT 01733000
LA R4,TABLE2 POINT TO THE TABLE 01734000
BAL R14,SCANNAME SUBROUTINE WILL MOVE DEVICE TYPE X01735000
AND CLASS INTO UDEVTYPE AND UDEVTYPC 01736000
B CHAINDEV 01737000
SPACE 3 01738000
********************************************************************** 01739000
*. 01740000
* CTCA DEVICE TYPE SCAN SUBROUTINE 01741000
* 01742000
* 1. FILL IN THE CLASS. 01743000
* 01744000
* 01745000
* 2. GOTO CHAINCU IN SCANMDIS TO CHAIN IN THE UDEVBLOK 01746000
*. 01747000
********************************************************************** 01748000
SCANCTCA MVI UDEVTYPC,CLASSPEC SET UP THE DEVICE CLASS 01749000
MVI UDEVTYPE,TYPCTCA AND THE TYPE 01750000
LH R0,=X'FFF0' SET UP THE CONTROL UNIT MASK 01751000
B CHAINCU GO CHAIN IN THE CU; @VA03128 01752000
EJECT 01753000
****************************************************************** 01754000
*. 01755000
* 2311 DEVICE TYPE SCAN SUBROUTINE 01756000
* 01757000
* 1. FILL IN THE CLASS. 01758000
* 01759000
* 2. RETURN CC = 1 IF NOT TOP OR BOTTOM. ELSE 01760000
* RETURN CC = 0. 01761000
*. 01762000
****************************************************************** 01763000
SCAN2311 MVI UDEVTYPC,CLASDASD SET UP DASD CLASS 01764000
MVI UDEVTYPE,TYP2311 SET UP TYPE 01765000
BAL R14,SCANCARD 01766000
BC 4,ERROR53 ERROR IF NO INPUT 01767000
COMP =C'TOP ' IS IT TOP 01768000
BNE TESTBOT NO- BRANCH 01769000
MVI UDEVFTR,FTR2311T SET IN FEATURE 01770000
B RETURNC0 RETURN TO CALLER CC = 0 01771000
TESTBOT COMP =C'BOTTOM ' IS IT BOTTOM 01772000
BNE RETURNC1 NO- BRANCH 01773000
MVI UDEVFTR,FTR2311B SET IN FEATURE 01774000
RETURNC0 TM *,X'00' SET CC = 0, CARD IS NOT PRESCANER 01775000
L R14,SAVERET SET UP RETURN ADDRESS 01776000
BR R14 RETURN TO CALLER 01777000
RETURNC1 TM *,X'FF' SET CC = 1, CARD IS PRESCANED 01778000
L R14,SAVERET SET UP RETURN ADDRESS 01779000
BR R14 RETURN TO CALLER 01780000
EJECT 01781000
***************************************************************** 01782000
*. 01783000
* 2540 DEVICE TYPE SCAN SUBROUTINE 01784000
* 01785000
* 1. SET UP DEVICE CLASS AND RETURN CC = 0. 01786000
*. 01787000
***************************************************************** 01788000
SCAN2540 BAL R14,SCANCARD 01789000
BC 4,ERROR53 ERROR IF NO INPUT 01790000
COMP =C'READER ' IS IT READER 01791000
BNE TESTPUN NO- BRANCH 01792000
MVI UDEVTYPC,CLASURI SET UP CLASS 01793000
MVI UDEVTYPE,TYP2540R SET TO READER 01794000
B RETURNC0 RETURN TO CALLER 01795000
TESTPUN COMP =C'PUNCH ' IS IT PUNCH 01796000
BNE ERROR51 ERROR IF NOT READER OR PUNCH 01797000
MVI UDEVTYPC,CLASURO SET UP CLASS 01798000
MVI UDEVTYPE,TYP2540P SET IT TO PUNCH 01799000
B RETURNC0 RETURN TO CALLER 01800000
SPACE 3 01801000
****************************************************************** 01802000
*. 01803000
* 2701 2702 2703 DEVICE TYPE SCAN SUBROUTINE 01804000
* 01805000
* 1. FILL IN THE DEVICE CLASS AND RETURN CC = 0. 01806000
*. 01807000
****************************************************************** 01808000
SCAN2701 EQU * 01809000
SCAN2702 EQU * 01810000
SCAN2703 MVI UDEVTYPC,CLASTERM SET IN CLASS 01811000
BAL R14,SCANCARD 01812000
BC 4,ERROR53 ERROR IF NO INPUT 01813000
COMP =C'IBM ' IS IT IBM 01814000
BNE TESTTELE 01815000
MVI UDEVTYPE,TYPIBM1 SET TO IBM 01816000
B RETURNC0 RETURN TO CALLER 01817000
TESTTELE COMP =C'TELE ' IS IT TELE 01818000
BNE ERROR51 NO- ERROR 01819000
MVI UDEVTYPE,TYPTELE2 01820000
B RETURNC0 RETURN TO CALLER 01821000
EJECT 01822000
****************************************************************** 01823000
*. 01824000
* START IO ROUTINE 01825000
* 01826000
* 1. IF RUNNING UNDER VM/370 GO TO STEP 10. 01827000
* 01828000
* 2. IF AN ERROR IS STACKED, UNSTACK IT AND GO TO 01829000
* STEP 5. 01830000
* 01831000
* 3. START THE DEVICE. 01832000
* 01833000
* 4. IF CHANNEL STATUS IS ZERO AND IF NO UC, UE OR 01834000
* ATTN IS IN THE UNIT STATUS GO TO STEP 7. 01835000
* 01836000
* 5. IF THIS IS THE DEVICE I STARTED GO TO DO A SENSE, 01837000
* ELSE STACK THE ERROR IN THE IOB. 01838000
* 01839000
* 6. GO TO THE ERROR ROUTINE IF PROVIDED, ELSE CHECK 01840000
* THE OPTION SWITCHES TO STOP, REPEAT OR RETURN. 01841000
* 01842000
* 7. IF THIS IS THE DEVICE I STARTED CONTINUE, ELSE WAIT 01843000
* FOR THE NEXT IO INTERRUPT. (RENTER AT STEP 4) 01844000
* 01845000
* 8. IF PROPER ENDING STATUS, CE AND/OR DE, RETURN TO 01846000
* CALLER. ELSE RETURN TO CALLER. 01847000
* 01848000
* 9. IF THIS IS A DASD DEVICE CONTINUE, ELSE GO TO 01849000
* STEP 2. 01850000
* 01851000
* 10. DO A DIAGNOSE CALL TO VM/370 AND LET CP DO THE 01852000
* 01853000
* 11. IF ERROR GO TO THE ERROR ROUTINE, ELSE RETURN 01854000
* TO THE CALLER. 01855000
*. 01856000
****************************************************************** 01857000
STARTIO ST R2,IOBCCW SAVE POINTER TO THE CCWS @V56BDA8 01858000
RETRYIO L R3,IOB GET FIRST WORD OF IOB @V56BDA8 01859000
RESTART CLI CPUID,X'FF' IS THIS A VIRTUAL MACHINE ? 01860000
BE DIAGNOSE YES, LET CP DO THE WORK 01861000
RETSIO TM IOBSTAT,IOBSTACK IS AN IO ERROR STACKED FOR THIS UNIT 01862000
BO UNSTACK YES- BRANCH TO UNSTACK IT 01863000
ST R2,CAW SET UP CAW 01864000
XC CSW,CSW ZERO THE CSW 01865000
SIO 0(R3) 01866000
BC 4,CSWSTORE GO AND TEST STATUS 01867000
BC 2,IOWAIT GO AND WAIT FOR AN IO INTERRUPT 01868000
BC 1,NOTOPER GO TO THE NOT OPER ERROR ROUTINE 01869000
LA R3,0(,R3) INDICATE IO STARTED 01870000
IOWAIT LPSW IOWPSW INABLE IO INTERRUPTIONS 01871000
IOINT MVI IOOLD,X'01' TURN OFF ALL BUT EXTERNAL INTERRUPT 01872000
NI IOOLD+1,X'FD' TURN OFF WAIT BIT 01873000
LPSW IOOLD LOAD IO OLD PSW 01874000
CSWSTORE EQU * 01875000
TM CSW+4,BUSY IS THE UNIT BUSY 01876000
BZ LOOKATCE NO- GO LOOK AT CE 01877000
TM CSW+4,DE+ATTN+CUE+CE IS THIS ENDING STATUS 01878000
BNZ STUADD YES- BRANCH 01879000
LPSW IOWPSW WAIT FOR ENDING STATUS 01880000
LOOKATCE TM CSW+4,CE IS THIS CHANNEL END 01881000
BZ STUADD NO- BRANCH 01882000
LA R3,0(,R3) INDICATE IO STARTED 01883000
LA R4,8(,R2) POINT TO THE FIRST CCW + 8 01884000
ST R4,CSW AND SAVE IT IN THE CSW 01885000
STUADD STH R3,IOOLD+2 POINT TO THE INTERRUPTING DEVICE 01886000
TESTSTAT TM CSW+5,X'FF' TEST ALL CHANNEL STATUS. IS IT ZERO? 01887000
BNZ IOERROR NO- ERROR 01888000
TM CSW+4,UC+UE+ATTN TEST UNIT STATUS, IS IT BAD? 01889000
BNZ IOERROR YES- ERROR 01890000
TESTDEV LR R4,R3 GET THE ADDRESS OF THE DEVICE WAITING FOR 01891000
TM CSW+4,X'20' IS THIS A CU END INT 01892000
BZ TESTADD NO- GO TEST THE ADD 01893000
LTR R3,R3 WAS THE UNIT STARTED @VA01134 01894000
BM RESTART NO-RESTART @VA01134 01895000
B IOWAIT GO WAIT FOR NEXT INTERRUPT @VA01134 01896000
TESTADD CLM R4,3,IOOLD+2 IS THIS THE DEVICE WAITING FOR 01897000
BNE IOWAIT NO- GO WAIT FOR THE NEXT INT 01898000
LTR R3,R3 WAS THE UNIT STARTED 01899000
BM RESTART NO- RESTART THE UNIT 01900000
TM IOBOPT,IOBDEW MUST I WAIT FOR DEVICE END 01901000
BZ TESTCE NO- BRANCH 01902000
TM CSW+4,DE IS IT DEVICE END 01903000
BCR 1,R5 YES- RETURN TO CALLER 01904000
LPSW IOWPSW WAIT FOR THE NEXT IO INTERRUPT 01905000
TESTCE TM CSW+4,CE+DE IS IT CHANEL END OR DEVICE END 01906000
BCR 7,R5 YES- RETURN 01907000
LPSW IOWPSW WAIT 01908000
IOERROR CLC IOBUADD,IOOLD+2 IS THIS THE DEVICE I AM WORKING WITH 01909000
BNE STACK NO- BRANCH TO STACK THE IO ERROR 01910000
MVC IOBCSW(8),CSW MOVE IN CSW 01911000
UNSTACK NI IOBSTAT,255-IOBSTACK TURN IOBSTACK BIT OFF 01912000
LA R4,SENSECCW POINT TO SENSE CCW 01913000
ST R4,CAW SET UP CAW 01914000
XC SENSE,SENSE ZERO OUT SENSE 01915000
SIO 0(R3) DO A SENSE 01916000
TIO TIO 0(R3) CLEAR ANY INTERRUPT 01917000
BC 2,TIO LOOP IF CHANNEL IS BUSY 01918000
LA R4,32 CAL THE NUMBER OF SENSE BYTES HRC011DK 01919490
SH R4,CSW+6 .. @V2B3729 01920000
STC R4,SNSCNT .. @V2B3729 01921000
L R4,IOBERROR GET THE ADDRESS OF THE ERROR ROUTINE 01922000
LTR R4,R4 DO I HAVE AN IO ERROR ROUTINE 01923000
BCR 7,R4 YES- GO TO IT 01924000
IORETURN TM IOBOPT,IOBEEXIT DO I REPEAT THE CCW STRING 01925000
BNO TESTSTOP NO- BRANCH 01926000
L R3,IOB SET UP TO REPEAT CCW STRING 01927000
TESTSTOP TM IOBOPT,IOBERST DO I STOP ON ERROR 01928000
BNO TESTST NO- BRANCH 01929000
LPSW IOWPSW 01930000
TESTST LTR R3,R3 IS DEVICE STARTED 01931000
BM RESTART NO- BRANCH TO START DEVICE 01932000
BR R5 RETURN TO CALLER 01933000
USING IOB,R4 01934000
STACK LA R4,READIOB 01935000
SCANIOBS CLC IOBUADD,IOOLD+2 IS THIS THE ERROR IOB 01936000
BNE UPDATE2 NO- BRANCH 01937000
MVC IOBCSW(8),CSW MOVE ERROR CSW INTO IOB 01938000
OI IOBSTAT,IOBSTACK TURN ON ERROR STACKED BIT 01939000
LPSW IOWPSW NOW WAIT FOR MY INTERRUP 01940000
UPDATE2 TM IOBSTAT,IOBLAST IS THIS THE LAST IOB 01941000
LA R4,IOBSIZE(,R4) POINT TO THE NEXT IOB. @V56BDA8 01942000
BNO SCANIOBS NO- BRANCH IF THIS IS NOT THE LAST IOB 01943000
LPSW IOWPSW INTERRUP WAS NOT FROM A UNIT I X01944000
STARTED SO IGNORE IT AND WAIT FOR MINE 01945000
DROP R4 01946000
USING IOB,R1 01947000
NOTOPER OI IOBSTAT,IOBNOPER TURN ON THE NOT OPER BIT 01948000
L R4,IOBERROR GET THE ADDRESS OF THE IO ERROR ROUTINE 01949000
LTR R4,R4 IS THERE AN ERROR ROUTINE 01950000
BCR 2,R4 YES- GO TO IT 01951000
B ERROR54 01952000
DIAGNOSE CL R1,=A(DASDIOB) IS THIS A START IO TO A DASD DEV 01953000
BNE RETSIO NO- RETURN TO SIO 01954000
SSM *+1 LOCK OUT CMS 01955000
DC X'83320020' DIAGNOSE CALL TO VM/370 01956000
BCR 8,R5 IF CC = 0 ALL OK (RETURN TO CALLER) 01957000
LA R3,0(,R3) INDICATE IO STARTED 01958000
CL R15,=F'1' IS THE RETURN CODE 1 01959000
BE NOTOPER YES- THE UNIT IS NOT OPERATIONAL 01960000
XC SENSE,SENSE CLEAN UP THE SENSE 01961000
MVC IOBCSW(8),CSW MOVE IN THE CSW 01962000
CL R15,=F'13' IS THE RETURN CODE 13 01963000
BNE RET NO- BRANCH 01964000
STH R2,SENSE SAVE THE SENSE 01965000
MVI SNSCNT,2 INDICATE 2 SENSE BYTES @V2B3729 01966000
L R2,IOBCCW REPOINT TO CCWS JUST IN CASE @V56BDA8 01967000
RET L R4,IOBERROR POINT TO THE ERROR ROUTINE 01968000
LTR R4,R4 DO I HAVE AN ERROR ROUTINE 01969000
BCR 2,R4 YES- GO TO IT 01970000
B IORETURN NO- RETURN TO IO RETURN 01971000
EJECT 01972000
******************************************************************** 01973000
GRAPHID EQU * @V200731 01974000
TM PARM,PARMGRP IS THE GRAPHIC INDICATOR ACTIVE ?@V200731 01975000
BZ STARTIO NO, GO START THE I/O REQUEST @V200731 01976000
STM R14,R5,GRAPHSAV SAVE THE REGISTERS @V200731 01977000
LR R4,R2 GET THE ADDRESS OF THE CCW STRING@V200731 01978000
GETCCW EQU * @V200731 01979000
LH R3,6(R4) GET THE DATA COUNT FROM THE CCW @V200731 01980000
STM R3,R4,SAVEAREA SAVE THE DATA REGISTERS @V200731 01981000
NI PARM,X'FF'-(PARMREA+PARMNDA) CLEAR THE READ @V200731 01982000
* REQUEST 01983000
* AND NO DATA INDICATOR 01984000
LA R2,5 SET THE LOOP COUNT @V200731 01985000
LA R14,TABLGRAP GET THE ADDRESS OF THE COMMAND @V200731 01986000
* OP TABLE 01987000
ICM R5,1,0(R4) GET THE OP CODE @V200731 01988000
CCWEXEC EQU * @V200731 01989000
EX R5,CLIP TEST THE COMMAND OP CODE WITH @V200731 01990000
* TABLE CODE 01991000
BE GRAPHADD YES, FOUND THE COMMAND OP CODE @V200731 01992000
LA R14,4(R14) UPDATE THE ADDRESS IN THE TABLE @V200731 01993000
BCT R2,CCWEXEC GO TEST THE NEXT OP CODE @V200731 01994000
OI DIRFLAG,ERROR SET ERROR MESSAGE FLAG @V200731 01995000
B EXIT INVALID OP CODE - GO EXIT @V200731 01996000
CLIP CLI 0(R14),X'00' TEST THE OP CODE IN THE TABLE @V200731 01997000
GRAPHADD EQU * @V200731 01998000
ICM R2,7,1(R14) GET THE ADDRESS OF THE OP CODE @V200731 01999000
* ROUTINE 02000000
BR R2 GO TO THE ROUTINE @V200731 02001000
SPACE 2 02002000
READ66 EQU * @V200731 02003000
OI PARM,PARMREA+PARMATT INDICATE READ AND ATTENTION@V200731 02004000
* REQUESTS 02005000
LA R5,GRAPHIC0 RETURN ADDRESS FROM I/O HANDLER @V200731 02006000
XC BLNKLINE(140),BLNKLINE CLEAR THE READ AREA @VM08604 02007000
MVI IOBCSW+4,X'00' CLEAR THE CSW STATUS @V200731 02008000
XC RDMIDATA(6),RDMIDATA CLEAR THE READ DATA FIELD @V200731 02009000
MVC CPXYSTAT(20),REALABEL @V200731 02010000
LA R2,REQREAD GET THE ADDRESS OF THE CHANNEL @V200731 02011000
* PROGRAM 02012000
TM PARM,PARM327 IS THIS A 3270 GRAPHIC ? @V200731 02013000
BZ STARTIO NO, GO ISSUE SIO @V200731 02014000
LA R2,REQREAD1 GET THE ADDRESS OF THE CHANNEL @V200731 02015000
* PROGRAM 02016000
B STARTIO GO TO THE I/O HANDLER @V200731 02017000
SPACE 2 02018000
WRT66 EQU * @V200731 02019000
MVC CPXYSTAT(20),RUNLABEL @V200731 02020000
TM PARM,PARM327 IS THIS A 3270 GRAPHIC ? @V200731 02021000
BO YES3270 YES, GO TO 3270 SUPPORT @V200731 02022000
MVC WRT3066+1(3),1(R4) GET THE MESSAGE ADDRESS @V200731 02023000
STH R3,WRT3066+6 SAVE THE DATA COUNT IN THE CCW @V200731 02024000
LA R2,WRTCRTXY GET THE ADDRESS OF THE CHANNEL @V200731 02025000
* PROGRAM 02026000
TM PARM,PARMCLE IS THE ERASE INDICATOR ON ? @V200731 02027000
BZ GRAPWRT NO, GO TO SIO SECTION @V200731 02028000
LA R2,ERSE3066 GET THE ADDRESS OF THE CHANNEL @V200731 02029000
* PROGRAM 02030000
MVI SBADDR,X'00' CLEAR LINE POINTER @V200731 02031000
GRAPWRT EQU * @V200731 02032000
LA R5,GRAPHIC1 RETURN ADDRESS FROM I/O HANDLER @V200731 02033000
B STARTIO GO TO THE I/O HANDLER @V200731 02034000
YES3270 EQU * @V200731 02035000
SR R5,R5 CLEAR REGISTER 5 @V200731 02036000
LA R2,WRTCRT70 GET THE ADDRESS OF THE CHANNEL @V200731 02037000
* PROGRAM 02038000
TM PARM,PARMCLE IS THE ERASE INDICATOR ON ? @V200731 02039000
BZ NOCL3270 NO, DON'T CLEAR SCREEN @V200731 02040000
MVI SBADDR,X'00' CLEAR LINE POINTER @V200731 02041000
LA R2,ERSE3270 GET THE ADDRESS OF THE CHANNEL @V200731 02042000
* PROGRAM 02043000
NOCL3270 EQU * @V200731 02044000
IC R5,SBADDR GET THE CURRENT LINE POINTER @V200731 02045000
SLL R5,1 SETUP THE INDEX INTO THE TABLE @V200731 02046000
LH R5,TABLE70(R5) GET THE LINE ADDRESS @V200731 02047000
STCM R5,3,LAB3270+2 SAVE THE CURRENT LINE POINTER @V200731 02048000
MVC WRTCR70+1(3),1(R4) GET THE MESSAGE ADDRESS @V200731 02049000
STH R3,WRTCR70+6 SAVE THE BYTE COUNT IN THE CCW @V200731 02050000
B GRAPWRT GO GET THE RETURN ADDRESS @V200731 02051000
SPACE 2 02052000
GRAPHIC1 EQU * @V200731 02053000
LM R3,R4,SAVEAREA GET THE DATA REGISTERS @V200731 02054000
NI PARM,X'FF'-PARMCLE CLEAR THE ERASE INDICATOR @V200731 02055000
SR R2,R2 CLEAR REGISTER 2 @V200731 02056000
IC R2,SBADDR GET THE Y COORDINATE @V200731 02057000
LA R2,1(R2) UPDATE THE Y COORDINATE @V200731 02058000
CH R3,=H'80' IS THE DATA COUNT LONGER THAN 1 @V200731 02059000
* LINE 02060000
BNH *+8 NO, GO SAVE Y COORDINATE @V200731 02061000
LA R2,1(R2) UPDATE THE Y COORDINATE AGAIN @V200731 02062000
STC R2,SBADDR SAVE THE Y COORDINATE @V200731 02063000
MH R2,=H'80' GET THE BYTE LENGTH @V200731 02064000
L R14,=F'2640' GET THE MAX. LENGTH @V200731 02065000
TM PARM,PARM327 IS THIS A 3270 GRAPHIC ? @V200731 02066000
BZ TEST3066 NO, GO TEST FOR END OF CRT @V200731 02067000
L R14,MAXLEN GET THE MAX. LEN. FOR 3270/3278 @V60A6B6 02068000
TEST3066 EQU * @V200731 02069000
CR R2,R14 IS THE Y COORDINATE AT THE END @V200731 02070000
* OF THE 02071000
* CRT 02072000
BL RETWORD NO, CHECK FOR CMD CHAINING @VA08599 02073000
OI PARM,PARMATT SET THE ATTENTION REQUEST @V200731 02074000
MVI IOBCSW+4,X'00' CLEAR THE CSW STATUS @V200731 02075000
MVC CPXYSTAT(20),MORLABEL @V200731 02076000
LA R5,GRAPHIC3 RETURN ADDRESS FROM I/O HANDLER @V200731 02077000
LA R2,CRTWORD GET THE ADDRESS OF THE CHANNEL @V200731 02078000
* PROGRAM 02079000
TM PARM,PARM327 IS THIS A 3270 GRAPHIC ? @V200731 02080000
BZ STARTIO NO, GO ISSUE SIO @V200731 02081000
LA R2,MORECCW1 GET THE ADDRESS OF THE CHANNEL @V200731 02082000
* PROGRAM 02083000
B STARTIO GO ISSUE SIO @V200731 02084000
GRAPHIC3 EQU * @V200731 02085000
TM IOBCSW+4,ATTN IS THE ATTENTION FLAG ACTIVE ? @V200731 02086000
BZ GRAPPSW NO, GO WAIT FOR AN ATTENTION @V200731 02087000
* INTERRUPT 02088000
NI PARM,X'FF'-PARMATT CLEAR THE ATTENTION INDICATOR@V200731 02089000
CANCEL1 EQU * @V200731 02090000
LM R3,R4,SAVEAREA GET THE DATA REGISTERS @V200731 02091000
MVI SBADDR,X'00' SET THE Y COORDINATE TO ZERO @V200731 02092000
MVC CPXYSTAT(20),RUNLABEL CRT DISPLAY RUN STATUS @V200731 02093000
LA R2,CNCL3066 GET THE ADDRESS OF THE CHANNEL @V200731 02094000
* PROGRAM 02095000
TM PARM,PARM327 IS THIS A 3270 GRAPHIC ? @V200731 02096000
BZ RETURNCN NO, GO GET RETURN ADDRESS @V200731 02097000
LA R2,CNCL3270 GET THE ADDRESS OF THE CHANNEL @V200731 02098000
* PROGRAM 02099000
RETURNCN EQU * @V200731 02100000
LA R5,READ66 GET THE ADDRESS OF THE READ @V200731 02101000
* SECTION 02102000
TM PARM,PARMREA IS THIS A READ REQUEST ? @V200731 02103000
BO STARTIO YES, GO TO THE I/O HANDLER @V200731 02104000
LA R5,RETWORD RETURN ADDRESS FROM I/O HANDLER @V200731 02105000
B STARTIO GO TO THE I/O HANDLER @V200731 02106000
SPACE 1 02107000
GRAPHIC0 EQU * @V200731 02108000
TM IOBCSW+4,ATTN IS THE ATTENTION FLAG ACTIVE ? @V200731 02109000
BO GRAPATTN YES, GO SETUP CCW FOR READ @V200731 02110000
* MANUAL INPUT 02111000
GRAPPSW EQU * @V200731 02112000
LPSW IOWPSW GO WAIT FOR INTERRUPT @V200731 02113000
SPACE 1 02114000
GRAPATTN EQU * @V200731 02115000
LM R3,R4,SAVEAREA GET THE DATA REGISTERS @V200731 02116000
NI PARM,X'FF'-PARMATT CLEAR ATTENTION REQUEST @V200731 02117000
TM PARM,PARM327 IS THIS A 3270 GRAPHIC ? @V200731 02118000
BO YES3270A YES, GO TO 3270 SUPPORT @V200731 02119000
STH R3,RD3066DA+6 STORE THE COUNT IN THE CCW @V200731 02120000
MVC RD3066DA+1(3),1(R4) MOVE THE ADDRESS OF THE READ@V200731 02121000
* BUFFER INTO THE CCW 02122000
LA R2,RDMI3066 GET THE ADDRESS OF THE CHANNEL @V200731 02123000
* PROGRAM 02124000
RETURNAD EQU * @V200731 02125000
LA R5,RET66MI RETURN ADDRESS FROM I/O HANDLER @V200731 02126000
B STARTIO GO TO THE I/O HANDLER @V200731 02127000
YES3270A EQU * @V200731 02128000
LA R14,6(R3) ADD 6 T0 THE TOTAL COUNT @V200731 02129000
STH R14,RD3270DA+6 STORE THE COUNT IN THE CCW @V200731 02130000
LA R14,BLNKLINE GET THE ADDRESS OF THE BUFFER @V200731 02131000
STCM R14,7,RD3270DA+1 MOVE THE ADDRESS OF THE READ @V200731 02132000
* BUFFER INTO THE CCW 02133000
LA R2,RDMI3270 GET THE ADDRESS OF THE CHANNEL @V200731 02134000
* PROGRAM 02135000
B RETURNAD GO GET THE RETURN ADDRESS @V200731 02136000
SPACE 2 02137000
RET66MI EQU * @V200731 02138000
LM R3,R4,SAVEAREA GET THE DATA REGISTERS @V200731 02139000
MVC CPXYSTAT(20),RUNLABEL CRT DISPLAY RUN STATUS @V200731 02140000
LA R2,CRTWORD GET THE ADDRESS OF THE CHANNEL @V200731 02141000
* PROGRAM 02142000
LA R5,RETINPUT RETURN ADDRESS FROM I/O HANDLER @V200731 02143000
TM PARM,PARM327 IS THIS A 3270 GRAPHIC ? @V200731 02144000
BO YES3270B YES, GO CHECK 3270 SUPPORT @V200731 02145000
TM RDMIDATA+2,X'40' DID THE OPERATOR HIT THE @V200731 02146000
* CANCEL KEY 02147000
BO CANCEL1 YES, GO CLEAR SCREEN @V200731 02148000
CLC RDMIDATA(2),SBAREAD DID THE CURSOR MOVE ? @V200731 02149000
BNE STARTIO YES, GO WRITE STATUS @V200731 02150000
OI PARM,PARMNDA SET INDICATOR FOR NO DATA @V200731 02151000
B STARTIO GO WRITE OUT STATUS @V200731 02152000
YES3270B EQU * @V200731 02153000
CLI BLNKLINE,X'6E' DID THE OPERATOR HIT THE CANCEL @V200731 02154000
* KEY 02155000
BE CANCEL1 YES, GO CLEAR SCREEN @V200731 02156000
CLI BLNKLINE,X'6D' DID THE OPERATOR HIT THE CLEAR @V200731 02157000
* KEY 02158000
BE CANCEL1 YES, GO CLEAR SCREEN @V200731 02159000
CLI BLNKLINE,X'6C' DID OPERATOR HIT PA1 KEY @V200731 02160000
BE CANCEL1 YES, GO CLEAR SCREEN @V200731 02161000
OI PARM,PARMNDA SET INDICATOR FOR NO DATA @V200731 02162000
CLI BLNKLINE,X'01' DID OPERATOR HIT TEST REQ. KEY @VM08604 02163000
BE ENT3270 YES, GO WRITE STATUS @VM08604 02164000
CLI BLNKLINE,X'E6' IS THIS THE CARD READER @VM08604 02165000
BE ENT3270 YES, GO WRITE STATUS @VM08604 02166000
CLC BLNKLINE+6,X'00' DATA IN INPUT AREA ? @VM08604 02167000
BNE DATA3270 YES, GO DISPLAY DATA @VM08604 02168000
CLC BLNKLINE+1(2),ADDR5 DID CURSOR MOVE @V60A6B6 02169000
BE ENT3270 NO, GO WRITE STATUS @V200731 02170000
DATA3270 EQU * @VM08604 02171000
NI PARM,X'FF'-PARMNDA SET INDICATOR FOR NO DATA @V200731 02172000
ICM R14,7,1(R4) GET ADDRESS OF USER'S BUFFER @V200731 02173000
BCTR R3,R0 SUBTRACT ONE FROM COUNT (EX @V200731 02174000
* INSTR.) 02175000
EX R3,MOV3270 MOVE DATA INTO USER'S BUFFER @V200731 02176000
LA R3,1(,R3) UPDATE THE DATA COUNT @VM08921 02177000
MOVEBLNK EQU * @VM08921 02178000
OI 0(R14),X'40' SET UP FOR UPPERCASE LETTER @VM08921 02179000
LA R14,1(,R14) UPDATE THE BUFFER ADDRESS BY ONE @VM08921 02180000
BCT R3,MOVEBLNK GO SET CHARACTERS TO UPPERCASE @VM08921 02181000
ENT3270 EQU * @V200731 02182000
LA R2,CRTWORD1 GET THE ADDRESS OF THE CHANNEL @V200731 02183000
* PROGRAM 02184000
B STARTIO GO ISSUE SIO @V200731 02185000
SPACE 2 02186000
********************************************************************* 02187000
MOV3270 MVC 0(0,R14),BLNKLINE+6 MOVE THE DATA INTO THE @V200731 02188000
* USER'S BUFFER 02189000
********************************************************************* 02190000
SPACE 2 02191000
RETINPUT EQU * @V200731 02192000
LM R3,R4,SAVEAREA GET THE DATA REGISTERS @V200731 02193000
TM PARM,PARMNDA IS NO DATA INDICATED ? @V200731 02194000
BZ WRT66 NO, GO DISPLAY INPUT ON CRT @V200731 02195000
RETWORD EQU * @V200731 02196000
TM 4(R4),CC IS COMMAND CHAINING ON ? @V200731 02197000
LA R4,8(R4) UPDATE THE CCW ADDRESS TO NEXT @V200731 02198000
* CCW 02199000
BO GETCCW YES, GET DATA COUNT FROM CCW @V200731 02200000
LM R14,R5,GRAPHSAV GET CALLER'S REGISTERS @V200731 02201000
BR R5 RETURN TO CALLER @V200731 02202000
EJECT 02203000
****************************************************************** 02204000
*. 02205000
* INPUT CARD READ ROUTINE 02206000
* 02207000
* 1. SET UP THE NEXT AND LAST CARD POINTERS. 02208000
* 02209000
* 2. IF UNDER CMS USE SVC 202 TO GET THE NEXT CARD, 02210000
* ELSE USE STARTIO TO READ IT IN. 02211000
* 02212000
* 3. IF AN * OR A BLANK CARD GO TO STEP 2. 02213000
* 02214000
* 4. IF NOT FIRST CARD, SET UP CURRENT CARD POINTER 02215000
* AND EXIT TO SCANNAME POINTING AT TABLE1. 02216000
* 02217000
* 5. IF FIRST CARD IS NOT A DIRECTORY CARD GO TO 02218000
* ERROR62. ELSE GO TO STEP 1 TO READ THE NEXT 02219000
* CARD. 02220000
*. 02221000
****************************************************************** 02222000
READ LA R1,READIOB POINT TO THE INPUT IOB 02223000
MVC LASTCARD,CURRCARD SET UP LAST CARD POINTER @VA01066 02224000
MVC CURRCARD,NEXTCARD SET UP NEXT CARD POINTER 02225000
LM R2,R3,CURBUF * REVERSE POINTERS TO INPUT BUFFERS 02226000
XR R2,R3 * 02227000
XR R3,R2 * 02228000
XR R2,R3 * 02229000
STM R2,R3,CURBUF * 02230000
REREAD ST R3,CURPOINT POINT TO CURRANT CARD BUFFER 02231000
LA R4,71 SET UP INPUT COUNT 02232000
STH R4,CURCOUNT STORE COUNT 02233000
STCM R3,7,READCCW+1 POINT TO THE BUFFER 02234000
LA R2,READCCW POINT TO THE CCW 02235000
TM DIRFLAG,READEOF HIT EOF YET? @VA01066 02236000
BO BUFLUSH YES, GO SYNTAX LAST USER @VA01066 02237000
CL R12,BAREMAC IS THIS A BARE MACHINE? @VA01066 02238000
BNE CMS3 NO- GO 02239000
BAL R5,STARTIO READ IN CARD 02240000
RET1 BAL R14,SCANCARD * SET UP NEXT CARD INDICATOR 02241000
BNE SKIP1 * IF IT IS A BLANK CARD OR AN * 02242000
MVC NEXTCARD,0(R1) * SKIP THE CARD 02243000
CLI NEXTCARD,C'*' * 02244000
BNE MOVECPT * 02245000
SKIP1 L R3,NEXTBUF * 02246000
LA R1,READIOB * 02247000
B REREAD * 02248000
MOVECPT MVC CURPOINT,CURBUF * 02249000
LA R4,71 * SET UP COUNT 02250000
STH R4,CURCOUNT * 02251000
CLI CURRCARD,X'00' WAS THAT THE FIRST CARD 02252000
BNE SCAN1 NO- BRANCH 02253000
CLC NEXTCARD(3),CONDIRE IS THE FIRST CARD A DIRECTORY CARD 02254000
BE READ YES- BRANCH TO READ THE NEXT CARD 02255000
OI DIRFLAG,ERROR TURN ON THE ERROR FLAG 02256000
B ERROR62 PRINT OUT ERROR 02257000
SCAN1 BAL R14,SCANCARD POINT TO THE FIRST FIELD 02258000
LA R4,TABLE1 02259000
BAL R14,SCANNAME GO TO PROPER ROUTINE 02260000
B ERROR51 ERROR IF RETURN FROM SCANNAME 02261000
EJECT 02262000
READERR TM IOBCSW+4,UE IS ERROR UNIT EXCEPTION 02263000
BO EOF YES- BRANCH 02264000
STM R1,R5,SAVEERR SAVE RETURN REGS 02265000
TM IOBSTAT,IOBNOPER IS THE NOT OPER BIT ON 02266000
BO ERROR54 YES- BRANCH 02267000
BAL R5,ERROR55 GO AND PRINT THE ERROR 02268000
RESTORE LM R1,R5,SAVEERR RETURN ERROR REGS 02269000
B IORETURN GO BACK TO IO ROUTINE 02270000
SPACE 1 02271010
* THIS UPDATE BUFFERS DIRECTORY READ OPERATIONS TO IMPROVE 02271020
* I/O PERFORMANCE. 02271030
CMS3 STM R2,R4,FIORSAV SAVE SOME REGISTERS @VA09965 02271040
LA R4,FIOFCB SET UP ADDRESSABILITY TO FCB @VA09965 02271050
USING FSCBD,R4 @VA09965 02271060
TM FIOFLAGS,FIOINIT SHOULD INITIALIZATION BE DONE @VA09965 02271070
BO FIONOM BR IF NOT @VA09965 02271080
* INITIALIZE FOR FAST I/O PROCESSING 02271090
OI FIOFLAGS,FIOINIT SET INIT. DONE @VA09965 02271100
LA R1,INFCB REFERENCE OLD FCB @VA09965 02271110
MVC FSCBFN(18),8(R1) MOVE FILEID TO NEW FCB @VA09965 02271120
* GET BUFFER FOR FAST I/O. USER VARIABLE REQUEST WITH MAX. 02271130
* OF 12,000 BYTES AND MINIMUM OF 800 BYTES. 02271140
GETMAIN VU,LA=FIOMNMX,A=FIOGMANS @VA09965 02271150
MVC FSCBBUFF(8),FIOGMANS BUFF ADDR & SIZE IN FCB @VA09965 02271160
* CALCULATE THE NUMBER OF BYTES TO READ AND PUT IN FCB 02271170
* (= BUFF. SIZE DIVIDED BY LOGICAL RECORD SIZE OF 80 BYTES) 02271180
SR R0,R0 ZERO FOR DIVIDE @VA09965 02271190
L R1,FIOGMSZ GET BUFF. SIZE @VA09965 02271200
D R0,=F'80' CALC. NO. OF RECORDS TO READ @VA09965 02271210
* IGNORE ANY REMAINDER...JUST DON'T USE IT 02271220
STH R1,FSCBNOIT STORE IN FCB @VA09965 02271230
SPACE 1 02271240
* PERFORM PHYSICAL READ VIA CMS RDBUF 02271250
FIOREAD FSREAD FSCB=FIOFCB,ERROR=FIOEREND @VA09965 02271260
LR R1,R0 GET CT. OF BYTES READ FROM FCB @VA09965 02271270
SR R0,R0 ZERO HIGH DIVIDEND @VA09965 02271280
D R0,=F'80' CALC. NO. OF 80 BYTE RECS. READ @VA09965 02271290
LTR R0,R0 ANY REMAINDER? @VA09965 02271300
BZ FIOOK BR IF NO REMAINDER @VA09965 02271310
* ERROR, THERE SHOULD BE NO REMAINDER 02271320
LA R15,8 SET UP WRONG LENGTH ERROR @VA09965 02271330
LA R1,FIOFCB RESTORE PLIST FOR USE BY ERR MSG @VA09965 02271340
B FIOEREND @VA09965 02271350
SPACE 1 02271360
FIOOK L R2,FIOGMAD GET ADDRESS OF FIO INPUT BUFFER @VA09965 02271370
LA R3,1 SET UP VALUE OF 1 @VA09965 02271380
STM R1,R3,FIORECCT STORE NEW REC CT, PTR, + CUR CT @VA09965 02271390
B FIOMOVE GO TO MOVE RECORD @VA09965 02271400
SPACE 1 02271410
* EXCEPTION ENDING 02271420
FIOEREND DS 0H @VA09965 02271430
LM R2,R4,FIORSAV RESTORE REGISTERS @VA09965 02271440
B TESTEOF GO CHECK OUT ERROR @VA09965 02271450
SPACE 1 02271460
* PROCESSING WHEN PHYSICAL READ NOT REQUIRED 02271470
* R1= FIORECCT, R2= FIOCURPT, R3= FIOCURCT 02271480
FIONOM LM R1,R3,FIORECCT SET UP REGISTERS @VA09965 02271490
LA R3,1(,R3) COUNT ONE MORE RECORD @VA09965 02271500
CR R3,R1 COMPARE NEW COUNT TO MAX. @VA09965 02271510
BH FIOREAD BR IF BUFF USED UP, NEED READ @VA09965 02271520
LA R2,80(,R2) POINT TO NEXT RECORD @VA09965 02271530
STM R1,R3,FIORECCT SAVE NEW VALUES IN CTL. BLOCK @VA09965 02271540
FIOMOVE LM R3,R4,FIORSAV+4 RESTORE R3 AND R4 @VA09965 02271550
MVC 0(80,R3),0(R2) MOVE DATA TO EXPECTED BUFFER @VA09965 02271560
L R2,FIORSAV RESTORE REGISTER @VA09965 02271570
SPACE 1 02271580
DROP R4 @VA09965 02271590
SPACE 1 02271600
B RET1 RETURN 02275000
TESTEOF CL R15,=F'12' IS IT EOF 02276000
BE EOF YES, NOT AN ERROR @VA07951 02277000
OI DIRFLAG,ERROR SHOW WE HAD AN ERROR @VA07951 02278000
B ERROR1 @VA07951 02279000
EOF OI DIRFLAG,READEOF TURN ON END OF FILE BIT 02280000
L R2,NEXTBUF POINT TO INPUT BUFFER 02281000
MVC 0(4,R2),CONUSER FAKE A USER CARD 02282000
B RET1 RETURN TO READ 02283000
BUFLUSH OI DIRFLAG,FLUSH INDICATE LAST BUFFER FLUSHED @VA01066 02284000
B SCANUSER GO CHECK OUT THE LAST RECORD @VA01066 02285000
EJECT 02286000
***************************************************************** 02287000
*. 02288000
* DASD WRITE ROUTINE 02289000
* 02290000
* 1. IF ERROR OR EDIT BIT ON RETURN TO CALLER. 02291000
* 02292000
* 2. BUILG THE CCW STRING AND CALL STARTIO TO WRITE 02293000
* THE BUFFER OUT. 02294000
* 02295000
* 3. RETURN TO THE CALLER. 02296000
*. 02297000
***************************************************************** 02298000
WRITE TM DIRFLAG,ERROR+EDITMODE IS THE ERROR OR EDIT BIT ON 02299000
BCR 7,R14 YES- RETURN TO THE CALLER (DO NOT WRITE) 02300000
STM R1,R3,SAVEWREG SAVE REG 02301000
ST R1,WCCW4 POINT TO BUFFER 02302000
MVI WCCW4,5 SET UP WRITE CCW 02303000
ST R2,SKSERCC SET IN CYLINDER LOCATION 02304000
STH R2,SKSERR SET IN RECORD NO 02305000
LA R1,512 SET UP TO DIVIDE BY 2.0 (3340) @V2A2029 02306000
TM DIRFLAG1,OUT3340 IS THIS A 3340 @V2A2029 02307000
BO DEVIDE YES - BRANCH @V2A2029 02308000
LA R1,1024 SET UP TO DIVIDE BY 4.0 (3350) @V304498 02309000
TM DIRFLAG1,OUT3350 IS THIS A 3350 @V304498 02310000
BO DEVIDE YES - BRANCH @V304498 02311000
LA R1,8*256 Set up to divide by 8.0 (3375) HRC106DK 02311100
TM DIRFLAG1,OUT3375 Is this a 3375 HRC106DK 02311200
BO DEVIDE Yes - branch HRC106DK 02311300
LA R1,10*256 Set up to divide by 10.0 (3380) HRC106DK 02311400
TM DIRFLAG1,OUT3380 Is this a 3380 HRC106DK 02311500
BO DEVIDE Yes - branch HRC106DK 02311600
LA R1,409 SET UP TO DEVIDE BY 1.6 (2314-2319) 02312000
TM DIRFLAG,OUT3330 IS THIS A 3330 02313000
BZ DEVIDE NO- BRANCH 02314000
LA R1,768 SET UP TO DEVIDE BY 3.0 (3330) 02315000
DEVIDE N R2,=X'0000FF00' ZERO OUT ALL BUT RECORD NO. 02316000
SL R2,=F'256' SUBTRACT BY ONE 02317000
SRDA R2,32 SLIDE RECORD NO INTO R3 02318000
DR R2,R1 DEVIDE THE RECORD NUMBER BY THE NUMBER X02319000
OF RECORDS PER TRACK. 02320000
STH R3,SKSERHH STORE THE TRACK NO 02321000
LA R1,DASDIOB POINT TO THE IOB 02322000
LA R2,WCCW1 GET ADD OF CCW STRING 02323000
BAL R5,STARTIO GO TO START IO ROUTINE 02324000
LM R1,R3,SAVEWREG RETURN REG 02325000
BR R14 02326000
SPACE 3 02327000
* THE STARTIO ROUTINE COMES HERE IN THE EVENT OF AN IO ERROR 02328000
* ON THE DASDIOB. 02329000
DASDERR TM IOBSTAT,IOBNOPER IS THE DEVICE NOT OPERATIONAL 02330000
BO ERROR54 YES- ERROR 02331000
CLI CPUID,X'FF' IS THIS A VIRTUAL MACHINE ? 02332000
BE BADERR YES, GET OUT 02333000
TM SENSE,X'2C' TEST FOR BUSOUT, DATA OR OVERRUN 02334000
BNZ SUB1 BRANCH IF ON 02335000
TM SENSE,X'01' SEEK CHECK ? 02336000
BZ MAYBTRKC NO, MAYBE TRACK CONDITION CHECK @V56BDA8 02337000
CL R2,=A(DASDERR1) IS THIS THE RECALIBRATE CCW 02338000
BE SUB1 YES- BRANCH 02339000
MVC DASDERR2+1(3),IOBCCW+1 CHAIN THE RECALIBRATE TO MY CCW 02340000
LA R2,DASDERR1 SET UP TO POINT TO THE ERROR CCW STRING 02341000
SUB1 L R4,DASDERCT PICK UP ERROR COUNT 02342000
BCT R4,RETURNER IS IT ZERO 02343000
BADERR OI DIRFLAG,ERROR YES- TURN ON THE ERROR BIT 02344000
BAL R5,ERROR55 PRINT OUT IO ERROR 02345000
B READ GO GET THE NEXT CARD 02346000
RETURNER ST R4,DASDERCT STORE ERROR COUNT 02347000
B RETRYIO RETRY THE SIO @V56BDA8 02348000
SPACE 1 02349000
MAYBTRKC TM SENSE,X'02' TRACK CONDITION CHECK? @V56BDA8 02350000
BZ BADERR NO, GET OUT @V56BDA8 02351000
TM DIRFLAG1,OUT3340 IS IT A 3340? @V56BDA8 02352000
BZ BADERR NO. @V56BDA8 02353000
SPACE 02354000
ST R5,ALTRECUR SAVE CALLER'S RETURN ADDRESS. @V56BDA8 02355000
IC R5,SENSE+6 COMPUTE CCHH OF DEFECTIVE TRACK @V56BDA8 02356000
* FROM SENSE DATA. NEED IT FOR SEEK IN 02357000
* RESTART CCWS. 02358000
SRL R5,5 ISOLATE 512 + 256. @V56BDA8 02359000
STC R5,ALTSKADD+2 STORE HIGH C AND SOME GARBAGE. @V56BDA8 02360000
NI ALTSKADD+2,X'03' GET RID OF THE GARBAGE. @V56BDA8 02361000
MVC ALTSKADD+3(1),SENSE+5 STORE LOW C. @V56BDA8 02362000
MVN ALTSKADD+5(1),SENSE+6 STORE LOW ORDER HEAD. @V56BDA8 02363000
L R2,IOBCSW FAILING CCW + 8. @V56BDA8 02364000
S R2,=F'8' GET ADDR OF FAILING CCW. @V56BDA8 02365000
STCM R2,7,ALTTIC+1 STORE IN TIC. @V56BDA8 02366000
LA R2,READHAR0 CCWS TO READ R0 (PTR TO ALT TRK).@V56BDA8 02367000
BAL R5,RETRYIO READ R0, THEN RETURN HERE. @V56BDA8 02368000
L R5,ALTRECUR RTN ADDR OF ORIG STARTIO CALLER. @V56BDA8 02369000
LA R2,ALTSEEK CCWS (SEEK TO ALTERNATE AND @V56BDA8 02370000
* SEARCH FOR BACKWARD POINTING R0) 02371000
* APPENDED IN FRONT OF FAILING CCW. 02372000
B STARTIO FIRST PART OF USERS CHAN PROG @V56BDA8 02373000
* RAN OKAY. RESTART 2ND PART AS IF IT WAS 02374000
* A NEW, SEPARATE, REQUEST. USERS RETURN 02375000
* ADDR IS IN R5. 02376000
EJECT 02377000
***************************************************************** 02378000
*. 02379000
* ROUTINE TO ASSIGN A DASD PAGE ADDRESS 02380000
* 02381000
* 1. IF THE LAST DASD ADDRESS IN THIS CYL IS NOT USED 02382000
* GO TO STEP 3. 02383000
* 02384000
* 2. GET THE NEXT AVAILABLE CYLINDER, IF CYL ZERO SET DASD 02385000
* ADDRESS TO 3, ELSE SET TO ZERO. 02386000
* 02387000
* 3. ADD 1 TO DASD ADDRESS AND RETURN TO CALLER. 02388000
*. 02389000
****************************************************************** 02390000
GETPAGE STM R3,R4,SAVEREGS SAVE REG 02391000
RET2 LH R3,MAXREC GET THE MAX RECORD COUNT 02392000
TESTFULL SR R4,R4 02393000
IC R4,PAGENUM PICK UP POINTER TO LAST PAGE USED 02394000
CLR R4,R3 WAS THE LAST PAGE USED 02395000
BL ADDONE NO- BRANCH 02396000
L R3,ALLOCATE POINT TO THE ALLOCATION TABLE 02397000
TM DIRFLAG,EDITMODE+ERROR ERROR OR EDIT FLAG ON @VA03013 02398000
BNZ EDITON2 YES- BRANCH 02399000
LH R4,RCCW7+6 Set up max size of the table HRC106DK 02400100
LOOP8 CLI 0(R3),X'04' IS THIS CYLINDER AVAILABUL 02401000
BE SETON YES- GO GET IT 02402000
CLI 0(R3),X'FF' IS THIS THE END OF THE LIST 02403000
LA R3,1(,R3) POINT TO THE NEXT BYTE 02404000
BE NOSPACE YES- BRANCH (END OF THE TABLE) 02405000
BCT R4,LOOP8 Loop up to 4096 times HRC106DK 02406100
NOSPACE BAL R5,ERROR60 GO PRINT THE ERROR 02407000
EDITON2 MVC DASDCYL(4),=X'3FFF0000' SET UP DUMMEY DASD ADD 02408000
B RET2 GO SET UP 02409000
SETON OI 0(R3),X'F0' ALLOCATE THIS CYL 02410000
SL R3,ALLOCATE CONVERT TO CYL NO 02411000
STH R3,DASDCYL POINT TO CYL NO 02412000
LA R4,3 SET R4 TO 3 (FIRST RECORD ON CYL 0) 02413000
TM DIRFLAG1,OUT3350+OUT3375+OUT3380 3350/75/80? HRC106DK 02414100
BZ SETON5 No, bypass 3350/3375/3380 init. HRC106DK 02414200
LA R4,4 INITIALIZE 1ST 3350 PAGE CYL 0 @V304498 02416000
SETON5 EQU * CONTINUE CYL 0 INITIALIZATION @V304498 02417000
LTR R3,R3 IS THIS CYL 0 02418000
BZ ADDONE YES- BRANCH 02419000
SR R4,R4 NO- SET TO 0 02420000
ADDONE LA R4,1(,R4) ADD ONE TO PAGE NUMBER 02421000
STC R4,PAGENUM POINT TO PAGE NUMBER 02422000
L R2,DASDCYL POINT TO PAGE 02423000
LM R3,R4,SAVEREGS RETURN REG 02424000
BR R14 02425000
EJECT 02426000
***************************************************************** 02427000
*. 02428000
* ROUTINE TO SCAN CURRANT INPUT BUFFER FOR NEXT FIELD 02429000
* 02430000
* 1. IF END OF CARD, COL NUMBER 71, RETURN CC = 1. 02431000
* 02432000
* 2. FIND NEXT COLLUM NOT A COMMA OR BLANK, 02433000
* IF NONE RETURN CC = 1. 02434000
* 02435000
* 3. COUNT THE NUMBER OF CHARACTERS UNTIL THE NEXT 02436000
* BLANK. 02437000
* 02438000
* 4. RETURN CC = 0. 02439000
*. 02440000
****************************************************************** 02441000
SCANCARD STM R3,R4,SAVEREGS SAVE REG 02442000
L R1,CURPOINT 02443000
SR R2,R2 SET COUNT TO ZERO 02444000
LH R3,CURCOUNT GET COUNT OF BYTES LEFT IN BUFFER 02445000
LTR R3,R3 IS IT ZERO 02446000
BZ SETCC1 YES END OF INPUT 02447000
LOOP5 CLI 0(R1),C' ' IS INPUT EQ BLANK 02448000
BNE UPDATE4 NO- BRANCH 02449000
UPDATE3 LA R1,1(,R1) UPDATE POINTER TO INPUT 02450000
BCT R3,LOOP5 BRANCH IF END OF CARD 02451000
B SETCC1 DO IT AGAIN 02452000
UPDATE4 TR 0(1,R1),UPCASE ALPHA TRANS - LOWER CASE => UPPER@VA12884 02453100
LA R2,1(,R1) POINT TO INPUT 02454000
BCT R3,LOOP6 DECREMENT CURCOUNT AND LOOP @VA03397 02455000
B SETCC0 SET CC=0 IF CURRENT COUNT ZERO @VA03397 02456000
LOOP6 CLI 0(R2),C' ' IS INPUT A BLANK 02457000
BE SETCC0 YES- BRANCH 02458000
TR 0(1,R2),UPCASE ALPHA TRANS - LOWER CASE => UPPER@VA12884 02459100
LA R2,1(,R2) POINT TO NEXT INPUT BYTE 02460000
BCT R3,LOOP6 DO IT AGAIN 02461000
SETCC0 ST R2,CURPOINT SET UP CURRANT POINTER 02462000
MVI 0(R2),C' ' SET DILIMITER TO BLANK 02463000
SR R2,R1 SET UP COUNT 02464000
TM *,X'00' SET CC = 0 02465000
RETURN STH R3,CURCOUNT SET UP REMAINING COUNT 02466000
LM R3,R4,SAVEREGS RETURN REG 02467000
BR R14 RETURN TO CALLER 02468000
SETCC1 TM *,X'FF' SET CC = 1 (NO INPUT) 02469000
ST R1,CURPOINT SET UP CURRANT POINTER 02470000
B RETURN 02471000
EJECT 02472000
***************************************************************** 02473000
* 02474000
* SUBROUTINE TO CONVERT HEXADECIMAL DIGITS TO DECIMAL 02475000
* 02476000
***************************************************************** 02477000
HEXCONV STM R3,R7,SAVEREGS SAVE REG @V407466 02478000
LR R6,R1 POINT TO BEGINNING OF OPERAND @V407466 02479000
LR R7,R2 LENGTH @V407466 02480000
SR R3,R3 02481000
LA R5,15 SET UP FOR AND 02482000
CONVERT TM 0(R1),X'F0' IS IT NUMERIC 02483000
BO NUMERIC YES- BRANCH 02484000
BZ ERROR51B NO, ERROR IF ALL BITS OFF @V407466 02485000
TM 0(R1),X'38' IS IT ALPHA 02486000
BNZ ERROR51B NO, ERROR IF BITS ON @V407466 02487000
TM 0(R1),X'07' IS IT G 02488000
BO ERROR51B YES, ERROR IF BITS ON @V407466 02489000
IC R4,0(R1) PICK UP ALPHA INPUT BYTE 02490000
LA R4,9(,R4) ADD 9 TO CONVERT FROM ALPHA INPUT 02491000
B SAVEIT 02492000
NUMERIC IC R4,0(,R1) PICK UP NUMERIC INPUT 02493000
SAVEIT NR R4,R5 ZERO OUT ZONE 02494000
SLL R3,4 SHIFT TO MAKE ROOM FOR INPUT 02495000
OR R3,R4 MOVE IN NUMERICS 02496000
LA R1,1(,R1) POINT AT THE NEXT INPUT BYTE 02497000
BCT R2,CONVERT DO IT TO EVERY INPUT BYTE 02498000
LR R2,R3 PLACE CONVERTED DATA INTO R2 02499000
LM R3,R7,SAVEREGS RETURN REGISTERS @V407466 02500000
BR R14 RETURN TO CALLER 02501000
SPACE 3 02502000
**************************************************************** 02503000
* 02504000
* SUBROUTINE TO CONVERT DECIMAL DIGITS TO BINARY 02505000
* 02506000
**************************************************************** 02507000
BINCONV STM R1,R3,SAVEREGS SAVE REGS 02508000
STM R6,R7,SAVEOPER SAVE CONTENTS OF R6 & R7 @V407466 02509000
LR R6,R1 SAVE POINT TO BEGIN OF OPERAND @V407466 02510000
LR R7,R2 FULL LENGTH OF OPERAND @V407466 02511000
LOOP9 TM 0(R1),X'F0' IS IT NUM 02512000
BNO ERROR51B NO - ERROR @V407466 02513000
LA R1,1(,R1) POINT TO THE NEXT BYTE 02514000
BCT R2,LOOP9 DO IT TO ALL INPUT 02515000
LM R1,R3,SAVEREGS RETURN REGS 02516000
BCTR R2,0 SUB 1 FROM COUNT 02517000
EX R2,PACK PACK DATA INTO WORK1 02518000
CVB R2,WORK1 SET UP DATA IN R2 02519000
LM R6,R7,SAVEOPER RESTORE ORIGINAL REGISTERS @V407466 02520000
BR R14 02521000
PACK PACK WORK1,0(1,R1) 02522000
EJECT 02523000
***************************************************************** 02524000
* 02525000
* SUBROUTINE TO CONVERT DECIMAL DIGITS TO HEXADECIMAL 02526000
* 02527000
***************************************************************** 02528000
DECCONV STM R3,R5,SAVEREGS SAVE REGS 02529000
BCTR R1,0 SET UP INPUT AND OUTPUT ADD 02530000
LA R3,0(R2,R2) DOBBLE THE COUNT 02531000
LA R3,0(R3,R1) ADD COUNT TO INPUT ADDRESS (ALSO OUTPUT) 02532000
SR R4,R4 02533000
LOOP4 IC R4,0(R2,R1) GET BYTE (INPUT + COUNT) 02534000
N R4,=F'15' ZERO OUT ALL BUT LAST 4 BITS 02535000
LA R5,DECTABLE(R4) POINT TO BYTE TO BE MOVED 02536000
MVC 0(1,R3),0(R5) MOVE IN BYTE 02537000
BCTR R3,0 POINT TO NEXT OUTPUT BYTE 02538000
IC R4,0(R2,R1) GET BYTE (INPUT + COUNT) 02539000
SRL R4,4 SET UP ZONE 02540000
LA R5,DECTABLE(R4) POINT AT BYTE TO BE MOVED 02541000
MVC 0(1,R3),0(R5) MOVE IN BYTE 02542000
BCTR R3,0 POINT TO NEXT OUTPUT BYTE 02543000
BCT R2,LOOP4 DO IT FOR ALL INPUT BYTES 02544000
LM R3,R5,SAVEREGS RETURN REG 02545000
BR R14 RETURN TO CALLER 02546000
SPACE 3 02547000
***************************************************************** 02548000
* 02549000
* SUBROUTINE TO COMPARE KEYWORDS 02550000
* 02551000
***************************************************************** 02552000
COMPARE BCTR R2,0 -1 02553000
EX R2,EXECOMP DO THE COMPARE 02554000
LA R2,1(,R2) +1 02555000
BR R14 RETURN WITH THE CC SET 02556000
EXECOMP CLC 0(0,R3),0(R1) COMPARE R1 TO R3 USING R2 02557000
EJECT 02558000
****************************************************************** 02559000
*. 02560000
* MESSAGE WRITER SUBROUTINE 02561000
* 02562000
* 1. IF UNDER CMS USE SVC 202 ELSE SET 02563000
* UP THE CCW AND CALL STARTIO. 02564000
* 02565000
* 2. RETURN USING R5. 02566000
*. 02567000
****************************************************************** 02568000
MSGWRITE CL R12,BAREMAC IS THIS A BARE MACHINE 02569000
BNE CMS5 02570000
LA R1,CONIOB POINT TO IOB 02571000
LH R3,0(,R2) MSG LENGTH INTO R3 @VA01388 02572000
LA R2,2(,R2) MSG TEXT ADDR INTO R2 @VA01388 02573000
CLI CPUID,X'FF' IS THIS A VIRTUAL MACHINE? @VA01388 02574000
BNE NODIAG NO, DON'T EDIT THE MSG @VA01388 02575000
CLC 0(3,R2),=C'DMK' IS THIS AN ERROR MSG? @VA01388 02576000
BNE NODIAG NO, DON'T EDIT THE MSG @VA01388 02577000
DC X'83',X'23',XL2'005C' YES, DO DIAGNOSE TO EDIT @VA01388 02578000
* MSG ACCORDING TO USER'S EMSG SETTING 02579000
LTR R3,R3 LENGTH OF 0 (I.E., EMSG OFF)? @VA01388 02580000
BCR 8,R5 YES, NO MSG TO SEND. JUST RETURN @VA01388 02581000
NODIAG ST R3,CONCCW+4 BUILD CCWS: LENGTH @VA01388 02582000
MVI CONCCW+4,X'60' CC + SILI @VA01388 02583000
ICM R2,8,=X'09' WRITE OP CODE @VA01388 02584000
ST R2,CONCCW * 02585000
MVC CONCCW1,SPACECCW * 02586000
LA R2,CONCCW * 02587000
B GRAPHID GO TO START I/O ROUTINE (RETURN @V200731 02588000
* ON R5) 02589000
CMS5 CLC 2(3,R2),=C'DMK' IS THIS AN ERROR MSG 02590000
BE CMSERMSG YES- GO TO ERROR MSG ROUTINE 02591000
LA R1,2(,R2) POINT TO THE MSG 02592000
LH R2,0(R2) GET THE LENGTH 02593000
CMS6 STCM R1,7,CONFCB+9 SET UP THE POINTER TO THE MSG IN THE FCB 02594000
STH R2,CONFCB+14 SET UP THE LENGTH ALSO 02595000
LA R1,CONFCB POINT TO THE FCB 02596000
SVC 202 GO TO CMS 02597000
DC AL4(ERROR2) ERROR RETURN 02598000
BR R5 RETURN TO THE CALLER 02599000
CMSERMSG LA R2,1(,R2) POINT TO A ONE BYTE COUNT AND TEXT 02600000
LINEDIT DISP=ERRMSG,TEXTA=(R2),RENT=NO,DOT=NO 02601000
BR R5 RETURN TO THE CALLER 02602000
PRINTBUF OI DIRFLAG,ERROR TURN ON ERROR BIT 02603000
L R1,CURBUF POINT TO THE CURRENT CARD BUFFER 02604000
LR R2,R1 * BUILD THE CONCOLE CCW 02605000
LA R2,79(,R2) * DO NOT PRINT TRAILING 02606000
LOOP7 CLI 0(R2),C' ' * BLANKS. IF BUFFER IS 02607000
BNE SETCOUNT * ALL BLANKS RETURN TO 02608000
BCT R2,LOOP7 * CALLER. (USING R5) 02609000
SETCOUNT SR R2,R1 * 02610000
LA R2,1(,R2) * 02611000
LTR R2,R2 * 02612000
BCR 12,R5 * 02613000
CL R12,BAREMAC * 02614000
BNE CMS6 * 02615000
ST R2,CONCCW+4 * 02616000
MVI CONCCW+4,SILI * 02617000
MVC CONCCW+1(3),CURBUF+1 * 02618000
MVI CONCCW,X'09' * 02619000
LA R1,CONIOB * 02620000
LA R2,CONCCW * 02621000
B GRAPHID GO TO START I/O ROUTINE (RETURN @V200731 02622000
* ON R14) 02623000
CONERROR EQU * @V200731 02624000
TM IOBCSW+4,ATTN IS THIS AN ATTENTION INTERRUPT ? @V200731 02625000
BNO CONUNITE NO, GO CHECK FOR UNIT EXECPTION @V200731 02626000
TM PARM,PARMGRP IS THE GRAPHIC SUPPORT ACTIVE ? @V200731 02627000
BZ CONUNITE NO, GO CLEAR CARD FLAG @V200731 02628000
TM PARM,PARMATT IS THIS A ATTENTION REQUEST ? @V200731 02629000
BCR 1,R5 YES, GO CHECK FOR ATTENTION @V200731 02630000
* INTERRUPT 02631000
CONUNITE EQU * @V200731 02632000
TM IOBCSW+4,UE IS THIS A UNIT EXECPTION ? @V200731 02633000
BO STARTIO YES- REPEAT 02634000
TM SENSE,X'80' COMMAND REJECT 02635000
BO EXIT YES - BAD BAD BAD @VA01388 02636000
ERRORCT L R4,CONERCT GET THE ERROR COUNT 02637000
BCT R4,RETCON IS IT ZERO 02638000
LA R5,EXIT YES- POINT TO EXIT ROUTINE 02639000
OI DIRFLAG,ERROR TURN ON ERROR FLAG 02640000
B ERROR55 PRINT OUT ERROR 02641000
RETCON ST R4,CONERCT SAVE COUNT 02642000
B IORETURN RETURN TO START IO ROUTINE 02643000
SPACE 3 02644000
***** MESSAGE TABLE 02645000
SPACE 2 02646000
ERROR51B LR R1,R6 POINT TO BEGIN OF OPERAND @V407466 02647000
LR R2,R7 LENGTH INTO R2 @V407466 02648000
LM R6,R7,SAVEOPER RESTORE ORIG. R6 VALUE @V407466 02649000
ERROR51 MVI ERROR51A+39,C' ' * BLANK IT OUT 02650000
MVC ERROR51A+40(11),ERROR51A+39 * 02651000
CL R2,=F'12' IS IT OVER 12 02652000
BNH MOVE NO- BRANCH 02653000
LA R2,12 SET COUNT TO 12 02654000
MOVE MOVE ERROR51A+39 MOVE IN ERROR WORD 02655000
BAL R5,PRINTBUF PRINT OUT CARD 02656000
ERROR51A MSG 'DMKDIR751E INVALID OPERAND - XXXXXXXXXXXX',READ 02657000
USING UDIRBLOK,R15 @VA01066 02658000
ERROR52 L R15,DIRPTR ADDRESS LAST USER @VA01066 02659000
MVC ERROR52A+61(8),UDIRUSER MOVE IN LAST ID @VA01066 02660000
ERROR52A MSG 'DMKDIR752E STATEMENT SEQUENCE ERROR FOLLOWING USER XXXX*02661000
XXXX',ERROR52B @VA01066 02662000
ERROR52B TM DIRFLAG,FLUSH EOF PROCESSING? @VA01066 02663000
BZ ERROR52C NOPE, BUFFERS ARE OK AS IS @VA01066 02664000
L R5,CURBUF+4 SET BACK TO BAD RECORD @VA01066 02665000
ST R5,CURBUF FOR PRINTING @VA01066 02666000
ERROR52C BAL R5,PRINTBUF WRITE OUT BAD RECORD @VA01066 02667000
TM DIRFLAG,READEOF DID IT HAPPEN AT EOF? @VA01066 02668000
BO EXIT YES, FINISH UP @VA01066 02669000
B READ NO, CONTINUE WITH OUR BUSINESS @VA01066 02670000
DROP R15 @VA01066 02671000
ERROR53 BAL R5,PRINTBUF PRINT OUT ERROR CARD 02672000
MSG 'DMKDIR753E OPERAND MISSING',READ 02673000
ERROR54 OI DIRFLAG,ERROR TURN ON ERROR FLAG 02674000
STH R3,ERROR54A+26 SET UP FIELD TO BE CONVERTED 02675000
LA R1,ERROR54A+26 SET UP POINTER TO FIELD 02676000
LA R2,2 SET UP COUNT 02677000
BAL R14,DECCONV 02678000
ERROR54A MSG 'DMKDIR754E DEV XXXX NOT OPERATIONAL',EXIT 02679000
ERROR55 MVC ERROR55A+35(8),IOBCSW * SET UP THE CSW 02680000
LA R1,ERROR55A+35 * 02681000
LA R2,8 * 02682000
BAL R14,DECCONV * 02683000
STH R3,ERROR55A+26 * MOVE IN CONVERTED IO ADDRESS 02684000
LA R1,ERROR55A+26 * 02685000
LA R2,2 * 02686000
BAL R14,DECCONV * 02687000
LA R1,SNSWORK SET UP SENSE DATA @V2B3729 02688000
LA R2,32 NUMBER OF SENSE BYTES HRC011DK 02689590
MVC SNSWORK(32),SENSE MOVE IN SENSE DATA HRC011DK 02690180
BAL R14,DECCONV CONVERT SENSE DATA @V2B3729 02691000
MVC ERROR55A+58(12),SNSWORK SENSE TO MSG @V2B3729 02692000
MVC ERROR55B+6(52),SNSWORK+12 .. HRC011DK 02693490
CLI SNSCNT,2 ONLY 2 SENSE BYTES PRESENT ? @V2B3729 02694000
BNE WRMSG55 NO- @V2B3729 02695000
MVC ERROR55A+62(8),=C' ' BLANK LAST 4 BYTES @V2B3729 02696000
WRMSG55 ST R5,MSGRET SAVE RETURN ADDRESS @V2B3729 02697000
LA R5,MSG55B SET NEW RETURN ADDRESS @V2B3729 02698000
ERROR55A MSG 'DMKDIR755E IO ERROR XXXX CSW XXXXXXXXXXXXXXXX SENSE XXX*02699000
XXXXXXXXX' 02700000
MSG55B L R5,MSGRET RESTORE ORIGINAL RETURN ADDRESS @V2B3729 02701000
CLI SNSCNT,6 BYTE COUNT GREATER THAN 6 @V2B3729 02702000
BNHR R5 NO, RETURN TO CALLER @V2B3729 02703000
ERROR55B MSG 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX' ,*02704290
ROOM FOR 32 SENSE BYTES HRC011DK 02704580
ERROR56 OI DIRFLAG,ERROR 02705000
MVC ERROR56A+41(8),PROOLD MOVE IN OLD PSW AND CONVERT 02706000
LA R1,ERROR56A+41 * IT TO DEC 02707000
LA R2,8 * 02708000
BAL R14,DECCONV * 02709000
ERROR56A MSG 'DMKDIR756E PROGRAM CHECK PSW = XXXXXXXXXXXXXXXX',EXIT 02710000
ERROR57 OI DIRFLAG,ERROR SET ON ERROR BIT 02711000
MSG 'DMKDIR757E MACHINE CHECK RUN SEREP AND SAVE OUTPUT FOR X02712000
CE',EXIT 02713000
ERROR58 BAL R5,PRINTBUF PRINT OUT THE CARD 02714000
MSG 'DMKDIR758E DUPLICATE UNIT DEFINITION',READ 02715000
ERROR60 OI DIRFLAG,ERROR TURN ON THE ERROR FLAG 02716000
MSG 'DMKDIR760E NOT ENOUGH SPACE ALLOCATED FOR DIRECTORY' 02717000
ERROR61 MVC ERROR61A+35(6),VOLLABLE+4 MOVE IN LABLE 02718000
MVC ERROR61A+46(6),DASDVSER THIS ONE TO 02719000
BAL R5,PRINTBUF PRINT INPUT BUFFER 02720000
ERROR61A MSG 'DMKDIR761E VOLID READ IS XXXXXX NOT XXXXXX',READ 02721000
ERROR62 MSG 'DMKDIR762E DIRECTORY STATEMENT MISSING',READ 02722000
ERROR63 MVC ERRORRET,=F'1' SET THE RETURN CODE TO 1 02723000
MSG 'DMKDIR763E INVALID FILENAME OR FILE NOT FOUND',MSG04 02724000
ERROR2 AL R15,=F'100' ADD 100 TO THE ERROR RETURN CODE 02725000
ERROR1 AL R15,=F'100' ADD 100 TO THE ERROR RETURN CODE 02726000
ST R15,ERRORRET 02727000
MVC ERROR64+30(8),0(R1) MOVE IN THE CMS ROUTINE NAME 02728000
ERROR64 MSG 'DMKDIR764E ERROR IN XXXXXXXX',EXIT 02729000
MSG01 MSG 'EOJ DIRECTORY UPDATED' 02730000
MSG02 MSG 'VM/370 USER DIRECTORY CREATION PROGRAM RELEASE 6',MSG02A 02731000
MSG02A MSG 'ENTER CARD READER DEVICE ADDRESS AND OPTIONS',MSGRET 02732000
MSG03 MSG 'EOJ DIRECTORY UPDATED AND ON LINE',TERM 02733000
MSG04 MSG 'EOJ DIRECTORY NOT UPDATED',TERM 02734000
EJECT 02735000
****************************************************************** 02736000
*. 02737000
* EXIT HOUSEKEEPING ROUTINE 02738000
* 02739000
* 1. IF THE ERROR OR EDIT FLAG IS ON GO TO MSG04 . 02740000
* 02741000
* 2. MASK OFF THE LAST UDIR AND UMAC BLOCKS. 02742000
* 02743000
* 3. WRITE OUT ALL USED BUFFERS. 02744000
* 02745000
* 4. REWRITE THE VOL1 AND ALLOCATION RECORDS. 02746000
* 02747000
* 5. IF UNDER VM/370 USE DIAG 3C TO SWAP DIRECTORIES. 02748000
* 02749000
* 6. PRINT OUT THE PROPRE EOJ MSG. 02750000
* 02751000
* 7. IF NOT UNDER CMS LOAD A DISABLED PSW, ELSE 02752000
* SET UP CMS RETURN CODE AND RETURN TO CMS. 02753000
*. 02754000
****************************************************************** 02755000
* FREE THE FAST I/O BUFFER IN ALL CASES IF UNDER CMS 02756050
EXIT DS 0H @VA09965 02756100
CL R12,BAREMAC UNDER REAL OR VIRT. BARE MACH.? @VA09965 02756150
BE FIOBF BR IF YES, DON'T FREE BUFFER @VA09965 02756200
FREEMAIN V,A=FIOGMANS @VA09965 02756250
SPACE 1 02756300
FIOBF TM DIRFLAG,ERROR+EDITMODE ERROR OR EDIT FLAG ON @VA09965 02756350
BNZ MSG04 YES- PRINT OUT ERROR MSG AND EXIT 02757000
USING UDIRBLOK,RDIR SETUP ADDRESSABILITY FOR UDIRBLOK@V200731 02758000
L RDIR,DIRPTR GET THE BUFFER ADDRESS FOR @V200731 02759000
* UDIRBLOK 02760000
XC UDIRUSER,MASK * MASK OFF THE UDIR AND 02761000
XC UDIRPASS,MASK * UMAC BLOCK'S 02762000
XC UMACBLOK+8(8),MASK * 02763000
XC UMACBLOK+16(8),MASK * 02764000
XC UMACBLOK+24(8),MASK * 02765000
XC UMACBLOK+32(8),MASK * 02766000
XC UMACBLOK+40(8),MASK * 02767000
SR RDIR,RDIRBUF SET UP POINTER TO LAST UDIRBLOK 02768000
STH RDIR,2(,RDIRBUF) STORE IT IN FIRST UDIRBLOK 02769000
ST RDIR,DIRPTR SAVE THE ADDRESS OF THE UDIRBLOK @V200731 02770000
DROP R15 DROP BASE REGISTER FOR UDIRBLOK @V200731 02771000
SR R1,R1 * ZERO OUT THE POINTER TO THE NEXT 02772000
ST R1,4(,RDIRBUF) * UDIR BUFFER 02773000
L R2,UDIRPAGE GET DASD ADD 02774000
LR R1,RDIRBUF GET BUFFER ADD 02775000
BAL R14,WRITE 02776000
L R2,UMACPAGE GET DASD ADD 02777000
LR R1,RMACBUF GET BUFFER ADD 02778000
BAL R14,WRITE 02779000
L R2,UDEVPAGE GET DASD ADD 02780000
LTR R2,R2 WAS IT USED 02781000
BZ SCANALLO YES- BRANCH 02782000
LR R1,RDEVBUF GET BUFFER ADD 02783000
BAL R14,WRITE 02784000
SCANALLO L R3,ALLOCATE 02785000
LOOP10 CLI 0(R3),X'0C' IS THIS CYLINDER ALLOCATED 02786000
BNE TESTF4 NO- BRANCH 02787000
MVI 0(R3),X'04' MARK THIS CYLINDER NOT ALLOCATED 02788000
TESTF4 CLI 0(R3),X'F4' IS THIS CYLINDER TEMPERALY ALLOCATED 02789000
BNE TESTFF NO- BRANCH 02790000
MVI 0(R3),X'0C' MARK THIS CYLINDER ALLOCATED 02791000
TESTFF CLI 0(R3),X'FF' IS THIS THE END OF THE TABLE 02792000
LA R3,1(,R3) POINT TO THE NEXT BYTE 02793000
BNE LOOP10 NO- LOOP 02794000
LA R1,DASDIOB POINT TO IOB 02795000
LA R2,RCCW1 POINT TO CCW STRING 02796000
MVI RCCW4,05 SET UP TO WRITE OUT VOL1 RECORD 02797000
MVI RCCW7,05 SET UP TO WRITE OUT ALLOCATION RECORD 02798000
BAL R5,STARTIO WRITE THEM OUT 02799000
CLI CPUID,X'FF' IS THIS A VIRTUAL MACHINE ? 02800000
BNE BARE NO, DON'T SWAP DIRECTORIES 02801000
LA R3,100 SET UP ERROR COUNT 02802000
LPSW CMSPSW SET PROTECTION KEY AND SYSTEM MASK *02803000
TO ZERO SO THAT CMS WILL NOT GET SICK *02804000
AND RETURN TO THE NEXT INSTRUCTION 02805000
MOVEPSW MVC SAVEPNEW(8),PRONEW SAVE THE PROGRAM CHECK NEW PSW *02806000
THE DIAG IO WILL PROGRAM CHECK IF THE *02807000
USER IS NOT CLASS A,B OR C 02808000
MVC PRONEW(8),RETPSW SET UP THE RETURN PSW 02809000
LM R1,R2,DASDVSER POINT TO THE VOLUME SERIAL NUMBER 02810000
LOOP11 DC X'8312003C' DIAG CALL TO VM/370 (USER DIRECTORY *02811000
DYNAMIC SWAP 'DMKUDRDS' ) 02812000
MVC PRONEW(8),SAVEPNEW RETURN THE PROGRAN NEW PSW 02813000
BC 3,RET6 VOLUNE NOT IN THE OWNDLIST OR IO ERROR *02814000
UNDER CP 02815000
BZ MSG03 PRINT MSG IF CC = 0 02816000
BCT R3,LOOP11 TRY 100 TIMES IF THE DIRECTORY IS LOCKED 02817000
LA R3,5 SET THE CMS RETURN CODE TO 5 02818000
B RETERROR 02819000
UNOTABC MVC PRONEW(8),SAVEPNEW RETURN THE PROGRAM NEW PSW THE USER *02820000
IS NOT CLASS A,B OR C 02821000
LA R3,4 SET THE CMS RETURM CODE TO 4 02822000
B RETERROR 02823000
RET6 LA R3,6 SET THE CMS RETURN CODE TO 6 02824000
RETERROR ST R3,ERRORRET SAVE THE CMS RETURN CODE 02825000
BARE BAL R5,MSG01 02826000
TERM CL R12,BAREMAC IS THIS UNDER CMS 02827000
BNE CMS8 YES- BRANCH 02828000
LPSW SVCNEW STOP!!! 02829000
CMS8 EQU * 02830000
LA R1,INFCB POINT TO THE FCB 02831000
MVC 0(8,R1),=CL8'FINIS' CLOSE THE INPUT FILE 02832000
SVC 202 02833000
DC AL4(*+4) NO ERROR RETURN 02834000
LM R14,R15,CMSSAVE GET THE RETURN ADDRESS AND CODE 02835000
LTR R15,R15 DID I HAVE AN ERROR 02836000
BCR 7,R14 YES- RETURN WITH IT 02837000
TM DIRFLAG,ERROR DID I HAVE AN ERROR IN THE CMS X02838000
INPUT FILE 02839000
BCR 14,R14 NO- RETURN TO CMS 02840000
LA R15,2 SET RETURN CODE TO 2 02841000
BR R14 RETURN TO CMS 02842000
EJECT 02843000
LTORG 02844000
EJECT 02845000
DECTABLE DC C'0123456789ABCDEF' 02846000
DS 0H @V60A6B6 02847000
ADDR1 DC X'5B5F' LINE 22 COL 80 @V60A6B6 02848000
ADDR2 DC X'5D6B' LINE 24 COL 60 @V60A6B6 02849000
ADDR3 DC X'D65F' LINE 18 COL 80 @V60A6B6 02850000
ADDR4 DC X'D86B' LINE 20 COL 60 @V60A6B6 02851000
ADDR5 DC X'4040' INITIAL AREA FOR CURSOR CHECK @V60A6B6 02852000
ADDR6 DC X'5B60' LINE 23 COL 01 @V60A6B6 02853000
ADDR7 DC X'D660' LINE 19 COL 01 @V60A6B6 02854000
MAXLEN DC F'0000' @V60A6B6 02855000
LEN3270 DC F'1760' SCREEN SIZE FOR 24 LINE CONSOLE @V60A6B6 02856000
LEN3278 DC F'1440' SCREEN SIZE FOR 20 LINE CONSOLE @V60A6B6 02857000
BLANK DC C' ' 02858000
DIRFLAG DC X'00' 02859000
ATTNINT EQU X'80' AN ATTENTION INTERRUPT WAS RECEVED 02860000
ERROR EQU X'40' ERROR BIT 02861000
EDITMODE EQU X'20' EDIT MODE 02862000
OUT2314 EQU X'10' OUTPUT UNIT IS A 2314 OR A 2319 02863000
OUT3330 EQU X'08' OUTPUT UNIT IS A 3330 OR 2305 02864000
READEOF EQU X'04' END IF FILE ON CARD READER 02865000
SPECID EQU X'02' SPECIAL USERID FOUND @VM08715 02866000
FLUSH EQU X'01' LAST BUFFER HAS BEEN FLUSHED @VA01066 02867000
SPACE 02868000
DIRFLAG1 DC X'00' DIRECT FLAG BYTE TWO @V2A2029 02869000
OUT3340 EQU X'80' OUTPUT UNIT IS A 3340 @V2A2029 02870000
OUT3350 EQU X'40' OUTPUT UNIT IS A 3350 @V304498 02871000
OUT3375 EQU X'20' Output unit is a 3375 HRC106DK 02871100
OUT3380 EQU X'10' Output unit is a 3380 HRC106DK 02871200
SPACE 02872000
SPACE 02873000
MODETABL DC C'R ',AL1(UDEVR) MODE TABLE @V407466 02874000
DC C'W ',AL1(UDEVW) @V407466 02875000
DC C'M ',AL1(UDEVM) @V407466 02876000
DC C'RR ',AL1(UDEVRR) @V407466 02877000
DC C'WR ',AL1(UDEVWR) @V407466 02878000
DC C'MR ',AL1(UDEVMR) @V407466 02879000
DC C'MW ',AL1(UDEVMW) @V407466 02880000
DC C'RV ',AL1(UDEVR) @V407466 02881000
DC C'WV ',AL1(UDEVW) @V407466 02882000
DC C'MV ',AL1(UDEVM) @V407466 02883000
DC C'RRV',AL1(UDEVRR) @V407466 02884000
DC C'WRV',AL1(UDEVWR) @V407466 02885000
DC C'MRV',AL1(UDEVMR) @V407466 02886000
DC C'MWV',AL1(UDEVMW) @V407466 02887000
VOLID DC CL6'VOLID ' @VA11371 02888010
RONLY DC CL4'R/O ' @VA11371 02888020
VIRTC DC CL6'3330V ' @VA11371 02888030
FONE DC F'1' @V60B6B8 02890000
SPACE 02891000
MAXREC DC H'57' MAX RECORD COUNT(DEFAULT - 3330) @VA03013 02892000
CNOP 2,4 02893000
SKSERID DC X'0000' 02894000
SKSERCC DC X'0000' 02895000
SKSERHH DC X'0000' 02896000
SKSERR DC X'0000' 02897000
VOLSKSR DC X'00000000000003' 02898000
ALLSKSR DC X'00000000000004' 02899000
DASDERCT DC F'50' 02900000
CONERCT DC F'5' 02901000
BAREMAC DC A(DMKDIRCT+2-DMKDIR) 02902000
CMSSAVE DC A(0) 02903000
ERRORRET DC A(0) 02904000
DASDVSER DC CL6' ' OUTPUT VOL SER NO 02905000
SENSE DC XL32'0' SENSE AREA HRC011DK 02906590
SNSWORK DC XL67'0' SENSE WORK AREA HRC011DK 02907180
SNSCNT DC X'00' NUMBER OF SENSE BYTES PRESENT @V2B3729 02908000
SENRET DC F'0' RETURN ADDRESS OF CALLER @V2B3729 02909000
WORK1 DS 1D 02910000
DIRPTR DC A(0) SAVE ADDRESS OF UDIRBLOK @V200731 02911000
SAVEREGS EQU * 02912000
POINTERS DC A(BUFFER1) 02913000
DC A(BUFFER2) 02914000
DC A(BUFFER3) 02915000
SAVEOPER DC 1F'0' POINTER TO OPERAND BEGIN @V407466 02916000
SAVELEN DC 1F'0' POINTER TO OPERAND LENGTH @V407466 02917000
SAVENAME DC 1F'0' 02918000
SAVERET DC 1F'0' 02919000
SAVEERR DC 5F'0' 02920000
SAVEWREG DC 3F'0' 02921000
CTCASAVE DC 2F'0' 02922000
REGSAVE DS 4F @VA02180 02923000
F4096 DC F'4096' @VA02180 02924000
ALTRECUR DS F ALTERNATE TRACK R5 SAVEAREA 02925000
ALTSKAD2 DC XL6'0' 00CCHH ADDR OF ALTERNATE TRACK.@V56BDA8 02926000
ALTSKADD DC XL7'0' 00CCHH0 ADDR OF DEFECTIVE TRACK.@V56BDA8 02927000
DS 0D 02928000
EJECT 02929000
********************************************************************** 02930000
* GRAPHIC SUPPORT CCWS 02931000
********************************************************************** 02932000
CRTWORD CCW X'27',SBACP,SILI+CC,2 SET BAR TO (STATUS WORD) @V200731 02933000
CCW X'01',CPXYSTAT,SILI+CC,20 WRITE 'RUNNING' ON @V200731 02934000
* SCREEN 02935000
CCW X'27',SBAREAD,SILI+CC,2 SET BUFFER ADDR FOR @V200731 02936000
* WRITE 02937000
CCW X'01',BLNKZERO,SILI+CC,140 CLEAR INPUT AREA @VM08604 02938000
CURS3066 CCW X'0F',SBAREAD,SILI+CC,2 REPOSITION CURSOR @V200731 02939000
CCW X'03',*-*,SILI,3 END OF READ CCW STRING @V200731 02940000
SPACE 2 02941000
CRTWORD1 CCW X'01',LAB3270A,SILI+CC,LEN THE CONTROL DATA @VM08630 02942000
CCW X'03',*-*,SILI,2 @V200731 02943000
SPACE 2 02944000
REQREAD CCW X'27',SBACP,SILI+CC,2 SET BUFFER ADDR TO CP X-Y @V200731 02945000
CCW X'01',CPXYSTAT,SILI+CC,20 WRITE SCREEN STATUS @V200731 02946000
CCW X'08',CURS3066,SILI,1 RESET CURSOR POSITION @V200731 02947000
SPACE 2 02948000
REQREAD1 CCW X'01',LAB3270B,SILI+CC,LEN1 THE CONTROL DATA @VM08630 02949000
CCW X'03',*-*,SILI,2 @V200731 02950000
SPACE 2 02951000
ERSE3066 CCW X'07',*-*,SILI+CC,1 ERASE ENTIRE SCREEN @V200731 02952000
WRTCRTXY CCW X'27',SBADDR,SILI+CC,2 SET CORRECT LINE IN @V200731 02953000
* BUFFER 02954000
WRT3066 CCW X'01',*-*,SILI+CC,140 WRITE OUT USER DATA @V200731 02955000
CCW X'08',CRTWORD,SILI,1 NOW DISPLAY STATUS @V200731 02956000
SPACE 2 02957000
ERSE3270 CCW X'05',LAB3270E,SILI+CD,LEN3 ERASE THE SCREEN @V200731 02958000
CCW X'00',CPXYSTAT,SILI+CC,20 WRITE SCREEN STATUS @V200731 02959000
WRTCRT70 CCW X'01',LAB3270,SILI+CD,4 THE CONTROL DATA @V200731 02960000
WRTCR70 CCW X'00',*-*,SILI+CD,0 THE WRITE CCW @V200731 02961000
CCW X'00',LAB3270A+1,SILI+CC,LEN-1 WRITE SCREEN @V200731 02962000
* STATUS 02963000
CCW X'03',*-*,SILI,2 @V200731 02964000
SPACE 2 02965000
RDMI3066 CCW X'0E',RDMIDATA,SILI+CC,3 READ CCW FOR MI COMMAND@V200731 02966000
RD3066 CCW X'27',SBAREAD,SILI+CC,2 SET BUFFER ADDR FOR READ@V200731 02967000
RD3066DA CCW X'06',*-*,SILI+CC,140 READ INPUT DATA @V200731 02968000
CCW X'08',CURS3066,SILI,1 REPOSITION CURSOR @V200731 02969000
SPACE 2 02970000
RDMI3270 CCW X'01',LAB3270D,SILI+CC,4 @V200731 02971000
RD3270DA CCW X'06',*-*,SILI+CC,0 THE CCW FOR READ @V200731 02972000
CCW X'03',*-*,SILI,2 @V200731 02973000
SPACE 2 02974000
CNCL3270 CCW X'01',LAB3270E,SILI+CD,LEN3 THE CONTROL DATA @V200731 02975000
CCW X'00',CPXYSTAT,SILI+CC,20 WRITE SCREEN STATUS @V200731 02976000
CCW X'03',*-*,SILI,2 @V200731 02977000
SPACE 2 02978000
CNCL3066 CCW X'07',*-*,SILI+CC,1 ERASE SCREEN @V200731 02979000
CCW X'08',CRTWORD,SILI,1 NOW DISPLAY STATUS @V200731 02980000
SPACE 2 02981000
MORECCW1 CCW X'01',LAB3270C,SILI+CC,LEN2 THE CONTROL DATA @V200731 02982000
CCW X'03',*-*,SILI,2 @V200731 02983000
SPACE 2 02984000
********************************************************************** 02985000
* FIRST DC ARE ADDRESSES FOR LINES 1 -6 02986000
* SECOND DC ARE ADDRESSES FOR LINES 17 - 12 02987000
* THIRD DC ARE ADDRESSES FOR LINES 13 - 18 02988000
* FOURTH DC ARE ADDRESSES FOR LINES 19 - 24 02989000
********************************************************************* 02990000
SPACE 2 02991000
TABLE70 DS 0D @V200731 02992000
DC X'4040C150C260C3F0C540C650' @V200731 02993000
DC X'C760C8F04A404B504C604DF0' @V200731 02994000
DC X'4F405050D160D2F0D440D550' @V200731 02995000
DC X'D660D7F0D9405A505B605CF0' @V200731 02996000
SPACE 2 02997000
TABLGRAP EQU * @V200731 02998000
DC X'0A',AL3(READ66) ADDRESS OF THE READ SECTION @V200731 02999000
DC X'01',AL3(WRT66) ADDRESS OF THE WRITE SECTION @V200731 03000000
DC X'09',AL3(WRT66) ADDRESS OF THE WRITE SECTION @V200731 03001000
DC X'05',AL3(WRT66) ADDRESS OF THE WRITE SECTION @V200731 03002000
DC X'03',AL3(RETWORD) ADDRESS OF THE RETURN SECTION@V200731 03003000
SPACE 2 03004000
* X'5B60' - LINE 23, COL. 1 03005000
* X'5D6A' - LINE 24, COL. 59 03006000
SPACE 2 03007000
********************************************************************** 03008000
WC6 EQU X'C2' WRITE CONTROL BIT 6 @V200731 03009000
AT7 EQU X'C1' ATTRIBUTE BIT 7 @V200731 03010000
AT2 EQU X'E0' ATTRIBUTE BIT 2 @V200731 03011000
LAC EQU X'C0' @V200731 03012000
SF EQU X'1D' START OF FIELD CONTROL @V200731 03013000
SBA EQU X'11' SET BUFFER ADDRESS @V200731 03014000
IC EQU X'13' INSERT CURSOR @V200731 03015000
EUA EQU X'12' ERASE UNPROTECTED @V200731 03016000
RA EQU X'3C' REPEAT TO ADDRESS @V200731 03017000
V EQU C'V' VIRTUAL RESERVE/RELEASE @V407466 03018000
SPACE 2 03019000
LAB3270A DC AL1(WC6),AL1(SBA),X'5B60',AL1(SF),AL1(AT7) @V200731 03020000
DC AL1(IC),AL1(EUA),X'5D6B',AL1(SF),AL1(AT2) @V200731 03021000
RUNLABEL DC CL20'RUNNING' @V200731 03022000
LEN EQU *-LAB3270A @V200731 03023000
LAB3270B DC AL1(WC6),AL1(SBA),X'5B60',AL1(SF),AL1(AT7) @V200731 03024000
DC AL1(IC),AL1(SBA),X'5D6B',AL1(SF),AL1(AT2) @V200731 03025000
REALABEL DC CL20'CP READ' @V200731 03026000
LEN1 EQU *-LAB3270B @V200731 03027000
LAB3270C DC AL1(WC6),AL1(SBA),X'5D6B',AL1(SF),AL1(AT2) @V200731 03028000
MORLABEL DC CL20'HOLDING' @V200731 03029000
LEN2 EQU *-LAB3270C @V200731 03030000
LAB3270D DC AL1(LAC),AL1(SBA),X'5B60' @V200731 03031000
LAB3270 DC AL1(WC6),AL1(SBA),X'0000' @V200731 03032000
LAB3270E DC AL1(WC6),AL1(SBA),X'4040',AL1(RA),X'5B60',X'00' @V200731 03033000
DC AL1(SF),AL1(AT7),AL1(IC),AL1(SBA) @V200731 03034000
DC X'5D6B',AL1(SF),AL1(AT2) @V200731 03035000
LEN3 EQU *-LAB3270E @V200731 03036000
SPACE 2 03037000
********************************************************************* 03038000
PARM DC X'00' THE GRAPHIC FLAG BYTE @V200731 03039000
PARMATT EQU X'80' ATTENTION REQUEST @V200731 03040000
PARMGRP EQU X'40' GRAPHIC SUPPORT @V200731 03041000
PARMREA EQU X'20' READ REQUEST @V200731 03042000
PARMCLE EQU X'10' CLEAR/ERASE REQUEST @V200731 03043000
PARM327 EQU X'08' 3270 GRAPHIC @V200731 03044000
PARMNDA EQU X'04' NO DATA INDICATED @V200731 03045000
PARM01F EQU X'02' 01F REQUESTED @V200731 03046000
PARM321 EQU X'01' 3215/3210/1052 @V200731 03047000
********************************************************************** 03048000
SPACE 2 03049000
********************************************************************* 03050000
SBADDR DC AL1(00,00) CURRENT OUTPUT LINE COORDINATES @V200731 03051000
* FOR THE 03052000
* 3066 03053000
SBACP DC AL1(34,60) COORDINATES FOR SCREEN 'STATUS' @V200731 03054000
* WORD 03055000
SBAREAD DC AL1(33,00) COORDINATES FOR CURSOR POSITION @V200731 03056000
RDMIDATA DC XL6'00' READ DATA FROM 'MI' COMMAND @V200731 03057000
CPXYSTAT DC CL20' ' SCREEN 'STATUS' WORD @V200731 03058000
BLNKLINE DC XL140'00' CLEAR INPUT AREA FOR DATA @VM08604 03059000
BLNKZERO DC CL140' ' BLANKS FOR READ AREA @VM08604 03060000
GRAPHSAV DC 8F'00' SAVE AREA FOR GRAPHIC SUPPORT @V200731 03061000
SAVEAREA DC 2F'00' SAVE AREA FOR GRAPHIC DATA @V200731 03062000
* REGISTERS 03063000
********************************************************************* 03064000
SAVEPNEW DC D'0' SAVE AREA FOR THE PROGRAN NEW PSW 03065000
RETPSW DC X'00040000',A(UNOTABC) PROGRAM CHECK RETURN PSW 03066000
MASK DC XL8'AAAAAAAAAAAAAAAA' 03067000
CONWAIT DC X'FF06000000' 03068000
DC AL3(CONRET) 03069000
IOWPSW DC X'FF06000000' 03070000
DC AL3(TESTSTAT) 03071000
CMSPSW DC X'00040000' 03072000
DC A(MOVEPSW) 03073000
READCCW CCW 2,READBUF1,X'20',80 03074000
CONCCW CCW X'09',MSG02+6,X'60',44 03075000
CONCCW1 CCW X'0A',READBUF1,X'20',72 03076000
SNSE4CCW CCW X'E4',SENSE,SILI,7 HRC106DK 03076100
SENSECCW CCW 04,SENSE,SILI,32 HRC011DK 03077490
SPACECCW CCW X'09',BLANK,X'20',1 03078000
CONCCWR CCW X'0A',READBUF1,X'20',72 03079000
WCCW1 CCW 7,SKSERID,CC,6 03080000
WCCW2 CCW 49,SKSERID+2,CC,5 03081000
WCCW3 CCW 8,WCCW2,CC,1 03082000
WCCW4 CCW 5,BUFFER1,0,4096 03083000
RCCW1 CCW 7,VOLSKSR,CC,6 03084000
RCCW2 CCW 49,VOLSKSR+2,CC,5 03085000
RCCW3 CCW 8,RCCW2,CC,1 03086000
RCCW4 CCW 6,VOLLABLE,CC,80 03087000
RCCW5 CCW 49,ALLSKSR+2,CC,5 03088000
RCCW6 CCW 8,RCCW5,CC,1 03089000
RCCW7 CCW 6,ALLOCBUF,0,1024 03090000
DASDERR1 CCW 19,0,CC+SILI,1 03091000
DASDERR2 CCW 08,*-*,0,0 03092000
READHAR0 CCW 07,ALTSKADD,CC,6 SEEK @V56BDA8 03093000
CCW 26,0,CC+SILI+SKIP,5 READ HA @V56BDA8 03094000
CCW 22,ALTSKAD2+2,SILI,4 READ R0 @V56BDA8 03095000
ALTSEEK CCW 07,ALTSKAD2,CC+SILI,6 SEEK (TO ALTERNATE) @V56BDA8 03096000
CCW 49,ALTSKADD+2,CC+SILI,5 SEARCH ID EQ (VERIFY @V56BDA8 03097000
* BACKWARD POINTING R0) 03098000
CCW 08,*-8,0,0 TIC *-8 @V56BDA8 03099000
ALTTIC CCW 08,*-*,0,0 TIC @V56BDA8 03100000
CONFCB DC CL8'TYPLIN' 03101000
DC AL1(1) 03102000
DC AL3(0) 03103000
DC CL1'B' 03104000
DC X'00' 03105000
DC AL2(0) 03106000
CPUID DC 1F'0' 03107000
CPUMODEL DC 1F'0' 03108000
INFCB DC CL8'STATE' 03109000
DC CL8'USER' 03110000
DC CL8'DIRECT' 03111000
DC CL2'* ' 03112000
DC H'0' 03113000
INFCBUF DC F'0' 03114000
DC F'80' 03115000
DC CL2'F' 03116000
DC H'1' 03117000
DC F'0' 03118000
READIOB DC X'8060' STOP ON ERROR AND REPEAT CCW 03119000
READADD DC X'000C' 03120000
DC A(READCCW) 03121000
DC A(READERR) 03122000
DC 2F'00' 03123000
DASDIOB DC X'8060' WAIT FOR DEVICE END 03124000
DASDADD DC X'0000' 03125000
DC A(0) 03126000
DC A(DASDERR) 03127000
DC 2F'0' 03128000
CONIOB DC X'A000' LAST IOB 03129000
CONADD DC X'0009' 03130000
DC A(CONCCW) 03131000
DC A(SETUPERR) 03132000
DC 2F'0' 03133000
CMDTABLE DC CL8'ABCDEFGH' 03134000
DC XL8'8040201008040201' 03135000
LASTCARD DC XL4'00' 03136000
CURRCARD DC XL4'00' 03137000
NEXTCARD DC XL4'00' 03138000
CURPOINT DC A(0) POINTER TO CURRANT SCAN LINE 03139000
CURCOUNT DC AL2(0) COUNT OF BYTES NOT SCANED IN CURRANT BUFF 03140000
CURBUF DC A(READBUF1) POINTER TO THE CURRANT INPUT BUFFER 03141000
NEXTBUF DC A(READBUF2) POINTER TO THE NEXT INPUT BUFFER 03142000
DIRSIZE DC AL4(UDIRSIZE*8) 03143000
UDIRPAGE DC A(0) THE DASD ADDRESS OF THE BUFFER PAGE 03144000
UMACPAGE DC A(0) THE DASD ADDRESS OF THE BUFFER PAGE 03145000
UDEVPAGE DC A(0) THE DASD ADDRESS OF THE BUFFER PAGE 03146000
READBUF1 DC CL80' ' CARD INPUT BUFFER 03147000
READBUF2 DC CL80' ' CARD INPUT BUFFER 03148000
VOLLABLE DC CL80' ' 03149000
ALLOCATE DC A(ALLOCBUF) 03150000
DASDCYL DC X'0000' 03151000
PAGENUM DC X'FF' 03152000
DEVCODE DC X'00' 03153000
SPACE 03153005
* DEVICE NAMES 03153010
NAM3138 DC CL8'3138' GRAPHIC DISPLAY ==> 3138 @VA11551 03153015
NAM3148 DC CL8'3148' GRAPHIC DISPLAY ==> 3148 @VA11551 03153020
SPACE 2 03153040
* CONTROL DATA FOR FAST I/O 03153080
SPACE 1 03153120
FIOMNMX DC F'800' MINIMUM BUFFER SIZE (BYTES) @VA09965 03153160
DC F'12000' MAXIMUM BUFFER SIZE (BYTES) @VA09965 03153200
FIOGMANS DS 0F @VA09965 03153240
FIOGMAD DC F'0' BUFFER ADDR RETURNED BY GETMAIN @VA09965 03153280
FIOGMSZ DC F'0' BUFFER SIZE ALLOCATED (BYTES) @VA09965 03153320
SPACE 1 03153360
FIORSAV DC 3F'0' SAVE AREA FOR R2 TO R4 @VA09965 03153400
FIORECCT DC F'0' RECORD COUNT (NO. RECORDS READ) @VA09965 03153440
FIOCURPT DC F'0' CURRENT RECORD POINTER @VA09965 03153480
FIOCURCT DC F'0' CURRENT RECORD COUNT @VA09965 03153520
SPACE 1 03153560
FIOFLAGS DC X'00' FAST I/O FLAGS @VA09965 03153600
FIOEOF EQU X'80' FAST I/O EOF @VA09965 03153640
FIOINIT EQU X'40' FAST I/O INIT. (DONE IF ON) @VA09965 03153680
SPACE 1 03153720
* FAST I/O FCB 03153760
FIOFCB FSCB 'USER DIRECT *' @VA09965 03153800
SPACE 3 03154000
SPACE 2 03154040
*********************************************************************** 03154080
* TRANSLATE LOWER CASE ALPHABET CHARACTERS TO UPPER CASE * 03154120
*********************************************************************** 03154160
UPCASE DC X'000102030405060708090A0B0C0D0E0F' X'00'-X'0F' @VA12884 03154200
DC X'101112131415161718191A1B1C1D1E1F' X'10'-X'1F' @VA12884 03154240
DC X'202122232425262728292A2B2C2D2E2F' X'20'-X'2F' @VA12884 03154280
DC X'303132333435363738393A3B3C3D3E3F' X'30'-X'3F' @VA12884 03154320
DC X'404142434445464748494A4B4C4D4E4F' X'40'-X'4F' @VA12884 03154360
DC X'505152535455565758595A5B5C5D5E5F' X'50'-X'5F' @VA12884 03154400
DC X'606162636465666768696A6B6C6D6E6F' X'60'-X'6F' @VA12884 03154440
DC X'707172737475767778797A7B7C7D7E7F' X'70'-X'7F' @VA12884 03154480
DC X'80C1C2C3C4C5C6C7C8C98A8B8C8D8E8F' X'80'-X'8F' @VA12884 03154520
DC X'90D1D2D3D4D5D6D7D8D99A9B9C9D9E9F' X'90'-X'9F' @VA12884 03154560
DC X'A0A1E2E3E4E5E6E7E8E9AAABACADAEAF' X'A0'-X'AF' @VA12884 03154600
DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' X'B0'-X'BF' @VA12884 03154640
DC X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF' X'C0'-X'CF' @VA12884 03154680
DC X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF' X'D0'-X'DF' @VA12884 03154720
DC X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF' X'E0'-X'EF' @VA12884 03154760
DC X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF' X'F0'-X'FF' @VA12884 03154800
DS 0D 03155000
ENTRY DMKDIRED 03156000
SPACE 03157000
DMKDIRED EQU * END OF THE LOAD MODULE FOR CMS 03158000
SPACE 2 03159000
ORG DMKDIR+12288 BUFFERS USED TO BUILD DIRECTORY @V200731 03160000
SPACE 03161000
BUFFER1 DS XL4096 03162000
BUFFER2 DS XL4096 03163000
BUFFER3 DS XL4096 03164000
SPACE 1 03165000
ALLOCBUF DS XL4096 HRC106DK 03166100
SPACE 3 03167000
BUFFSIZE EQU (*-DMKDIRED)/8 SIZE OF BUFFER WORK AREA 03168000
EJECT 03169000
IOB DSECT 03170000
IOBSTAT DS X'80' STATUS OF IOB 03171000
IOBOPT DS 1X IOB FLAGS 03172000
IOBUADD DS 1H UNIT ADDRESS OF DEVICE 03173000
IOBCCW DS 1F POINTER TO CCW 03174000
IOBERROR DS A ADDRESS OF IO ERROR ROUTINE 03175000
IOBCSW DS 2F CSW OF IO ERROR STACKED 03176000
IOBSIZE EQU *-IOB LENGTH OF IOB. @V56BDA8 03177000
SPACE 03178000
* BITS USED IN IOBOPT 03179000
IOBDEW EQU X'80' WAIT FOR DEVICE END INTERRUPT 03180000
IOBERST EQU X'40' STOP ON IOERROR AND WAIT FOR NEXT INT 03181000
IOBEEXIT EQU X'20' REPEAT CCW ON ERROR 03182000
SPACE 03183000
* BITS USED IN IOBSTAT 03184000
IOBST EQU X'80' IO UNIT IS TO BE STARTED 03185000
IOBSTACK EQU X'40' IOERROR HAS BEEN STACKED 03186000
IOBLAST EQU X'20' LAST IOB 03187000
IOBNOPER EQU X'10' DEVICE IS NOT OPERATIONAL 03188000
SPACE 2 03189000
NAMETABL DSECT 03190000
NAMEFLAG DS X'00' FLAGS 03191000
NAMETYPC DS X'00' DEVICE CODE 03192000
NAMETYPE DS X'00' DEVICE TYPE 03193000
NAMEFTR DS X'00' DEVICE FEATURE CODE 03194000
NAME DS CL8 NAME OF DEVICE OR ROUTINE 03195000
NAMESIZE EQU *-NAMETABL 03196000
ORG NAMETYPC 03197000
NAMEROUT DS AL3 ADDRESS OF ROUTINE 03198000
SPACE 03199000
* BITS USED IN NAMEFLAG 03200000
NAMELAST EQU X'80' LAST ENTRY IN TABLE 03201000
NAMECON EQU X'40' ENTRY IS A CONSTANT 03202000
SPACE 03203000
SPACE 1 03206100
FSCBD @VA09965 03206200
EJECT 03207000
COPY UDIRECT 03208000
COPY EQU 03209000
COPY DEVTYPES 03210000
COPY RBLOKS HRC106DK 03210100
END DMKDIRCT 03211000