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 >> ( 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 >>>>>>> | 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 | 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 | 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 >>> | 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 | 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 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 > | 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