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