GLB TITLE 'DMSGLB (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * 00004000 * 00005000 * 00006000 * MODULE NAME 00007000 * 00008000 * DMSGLB 00009000 * 00010000 * FUNCTION 00011000 * 00012000 * TO DEFINE THE MACRO LIBRARIES THAT ARE TO BE 00013000 * SEARCHED DURING ASSEMBLER PROCESSING. 00014000 * TO DEFINE TEXT LIBRARIES TO BE SEARCHED 00015000 * BY THE LOADER FOR ANY UNRESOLVED EXTERNAL 00016000 * REFERENCES 00017000 * TO DEFINE THE DOS LIBRARIES THAT ARE TO BE 00017100 * SEARCHED BY THE DOS FETCH FOR A REQUESTED 00017200 * PHASE LOAD. 00017300 * 00018000 * ATTRIBUTES 00019000 * 00020000 * DISK-RESIDENT AND EXECUTES IN THE TRANSIENT AREA 00021000 * NOTE: GLOBAL MUST BE GENMOD'D WITH THE SYSTEM OPTION 00021100 * 00022000 * ENTRY POINTS 00023000 * 00024000 * DMSGLB - COMMON ENTRY POINT FOR MACLIB, 00025100 * DOSLIB AND TXTLIB DEFINITION 00025200 * 00027000 * ENTRY CONDITIONS 00028000 * 00029000 * R1- ADDRESS OF LIBRARY PARAMETER LIST 00030100 * 00031000 * PLIST- 00032000 * 00033000 * CL8'LIBRARY' 00034100 * CL8'MACLIB, TXTLIB OR DOSLIB' 00034200 * CL8'LIBNAME1' 00036000 * ... 00037000 * CL8'LIBNAMEN' 00038000 * 00039000 * R13- ADDRESS OF SVC SAVE AREA 00040000 * R14- RETURN ADDRESS 00041000 * R15-ADDRESSIBILITY 00042000 * 00043000 * EXIT CONDITIONS 00044000 * 00045000 * NORMAL- RETURN TO DMSITS, R15=0 00046000 * 00047000 * ERROR- RETURN TO DMSITS, R15=ERROR CODE 00048000 * 00049000 * ERROR CODES 00050000 * | 28 FILE NOT FOUND 00051000 * | 24 INVALID FUNCTION 00052000 * | 24 NO FUNCTION SPECIFIED 00053000 * | 88 MORE THAN 8 LIBRARIES SPECIFIED 00054000 * 00055000 * EXTERNAL REFERENCES 00056000 * 00057000 * NUCON 00058000 * 00059000 * CALLS TO OTHER ROUTINES 00060000 * 00061000 * DMSFRE,DMSERR,DMSSTT,DMSBRD 00062000 * 00063000 * TABLES/WORKAREAS 00064000 * 00065000 * SVC SAVE AREA USED FOR STATE PARAMETER LIST 00066000 * WORK AREA FOR TYPING CURRENT LISTS (TYPE OR PRINT OPTION) 00067000 * 00068000 * REGISTER USAGE 00069000 * 00070000 * R1,3,4,5- WORK 00071000 * R12- BASE 00072000 * R13- WORK AREA 00073000 * R14- RETURN 00074000 * R15- RETURN CODE 00075000 * 00076000 * 00077000 * OPERATION 00078000 * 00079000 * SET UP STATE PARAMETER LIST CONSTANTS. CHECK FOR 00080100 * MACLIB, TXTLIB OR DOSLIB LIBRARY. SET RESPECTIVE 00080200 * FILETYPES (MACLIB, TXTLIB OR DOSLIB) INTO STATE 00080300 * PARAMETER LIST. SET THE ADDR. OF THE RESPECTIVE 00080400 * NUCON LIBRARY AREA INTO REG. 3 (MACLIBL, TXTLIBS 00080500 * OR DOSLIBL). IF TXTLIB FUNCTION, FREE POSSIBLE 00080600 * IN-CORE TXTLIB DIRECTORY BLOCKS. 00080700 * CLEAR CURRENT NAMES FROM APPROPRIATE NUCON LIST. 00080800 * CHECK NO. OF LIBNAMES SPECIFIED; IF ZERO, EXIT; 00080900 * IF MORE THAN EIGHT GIVE ERROR NO 108S. CHECK FOR 00081000 * EXISTENCE OF EACH LIBRARY SPECIFIED (VIA STATE). 00081100 * FOR EACH LIBRARY FOUND, MOVE ITS FILENAME TO THE 00081200 * TO THE NUCON LIBRARY LIST. FOR EACH LIBRARY THAT 00081300 * DOES NOT EXIST, GIVE ERROR NO 002E. 00081400 * WHEN ALL PROCESSING COMPLETED, RETURN TO DMSITS. 00081500 * 00082000 * ALSO, GLOBAL WILL ADD THE NUMBER OF BYTES IN 00083000 * EACH LIBRARY GLOBALED AND STORE IN NUCON FOR 00084000 * LATER USE BY THE FILE MANAGEMENT ROUTINES. 00085000 EJECT 00095000 DMSGLB START 00096000 USING NUCON,R0 00097000 USING DMSGLB,R12 00098000 LR R12,R15 00099000 ST R14,SAVE14 SAVE R14 FOR EVERYBODY @V305066 00099100 LA R1,0(0,R1) IN CASE CALLED FROM EXEC 00100000 CLI 8(R1),X'FF' WAS A FUNCTION SPECIFIED 00101000 BE ERR047E NO, ERROR 00102000 SR R8,R8 GET A ZERO @VA04102 00102100 MVI SWT,X'00' RESET SWT @VA05523 00102200 MVC 0(32,R13),SHELL MOVE IN STATE PLIST 00103000 CLC 8(8,R1),=CL8'TXTLIB' GLOBAL TXTLIBS ? 00104000 BE GTXT YES, SET R3 00105000 CLC 8(8,R1),=CL8'MACLIB' GLOBAL MACLIBS ? 00106000 BE GMAC YES, SET R3 00107000 CLC 8(8,R1),=CL8'DOSLIB' GLOBAL DOSLIBS ? @V305001 00107100 BE GDOS YES, SET R3 @V305001 00107200 B ERR014E ILLEGAL FUNCTION 00108000 GTXT LR R3,R1 PROTECT PLIST ADR 00109000 OI SWT,TXTLIB INDICATE TEXTLIB ENTRY @VA04102 00109700 L R1,TXTDIRC TXTLIB FREE STOR CHAIN 00111000 ST R8,TXTDIRC CLEAR ANCHOR WORD 00112000 ST R8,TXLIBSV ZERO TXTLIB BYTE COUNT AREA @VA04102 00112100 LOOP LTR R1,R1 END OF CHAIN 00113000 BC 8,GTXT1 YES 00114000 L R0,8(R1) NO. DBL WDS TO FREE 00115000 L R7,12(R1) NEXT BLOCK 00116000 DMSFRET DWORDS=(0),LOC=(1) FREE THIS BLK 00117000 LR R1,R7 DO NEXT 00118000 B LOOP 00119000 GTXT1 LR R1,R3 RESTORE R1 00120000 LA R3,TXTLIBS TXTLIB LIST IN NUCON 00121000 MVC 16(8,R13),=CL8'TXTLIB' SET STATE PLIST 00122000 B COMMON GO TO COMMON CODE 00123000 GDOS LA R3,DOSLIBL DOSLIB LIST IN NUCON @V305001 00123100 MVC 16(8,R13),=CL8'DOSLIB' SET STATE PLIST @V305001 00123200 ST R8,DOSLBSV ZERO DOSLIB BYTE COUNT AREA @VA04102 00123230 OI SWT,DOSLIB INDICATE DOSLIB ENTRY @VA04102 00123260 B COMMON GO TO COMMON CODE @V305001 00123300 GMAC LA R3,MACLIBL MACLIB LIST IN NUCON 00124000 OI SWT,MACLIB INDICATE MACLIB ENTRY @VA04102 00124300 ST R8,MACLBSV ZERO MACLIB BYTE COUNT AREA @VA04102 00124600 MVC 16(8,R13),=CL8'MACLIB' SET STATE PLIST 00125000 COMMON LR R0,R1 SAVE REG 1 TEMPORARILY 00126000 MVI 0(R3),X'FF' FENCE THE LIST AREA @V305066 00127000 MVC 1(71,R3),0(R3) PROPAGATE THE FENCE @V305066 00128000 LR R1,R0 RESTORE R1 00129000 LA R4,16(0,R1) POINT TO LIBNAMES 00130000 SR R15,R15 CLEAR R15 00131000 TRT 0(65,R4),TABLE FIND END OF LIBNAMES 00132000 BZ ERR108S MORE THAN EIGHT LIBNAMES 00133000 SR R1,R4 LENGTH OF LIBNAMES 00134000 BZ RETURN RETURN IF NO LIBNAMES SPECIFIED @VA04102 00135000 LR R5,R1 SAVE LENGTH 00136000 LR R1,R13 PLIST ADDRESS TO R1 00137000 SR R7,R7 ZERO ERROR REG 00138000 MMVC MVC 8(8,R13),0(R4) MOVE FIRST (NEXT) NAME TO STATE PLIST 00139000 LR R1,R13 RESTORE PLIST ADDR. @V1D1905 00139100 L R15,ASTATE CHECK FOR FILE @V305066 00140000 BALR R14,R15 ... @V305066 00140100 BNZ GLBSTER ... @V305066 00140200 L R1,28(R1) GET FST ADDRESS @VA04102 00140300 MVC RDLIST+8(16),0(R1) SET PLIST FOR RDBUF @VA04102 00140400 MVC RDLIST+24(2),24(R1) GET MODE @VA04102 00140500 MVC FLIST+24(2),RDLIST+24 SAVE MODE FOR FINIS @VA04102 00140600 LA R1,RDLIST GET PLIST @VA04102 00140700 L R15,ARDBUF GET RDBUF ADDRESS @VA04102 00140800 BALR R14,15 AND GO THERE @VA04102 00140900 BZ RECORDOK NO ERROR, SKIP TESTING RC. @VA13906 00140910 CH R15,=H'01' IS IT FILE NOT FOUND? @VA13906 00140920 BNE CHKRC08 NO, SEE IF IT RC=08. @VA13906 00140930 OI SWT,DOSOS YES, THEN IT MUST BE DOS/OS DISK.@VA13906 00140940 B RECORDOK SKIP TEST FOR RC=08. @VA13906 00140950 CHKRC08 EQU * @VA13906 00140960 CH R15,=H'08' IS THE RECORD TOO BIG FOR BUFFER?@VA13906 00140970 BNE ERR104S NO, MUST BE A VALID ERROR. @VA13906 00140980 RECORDOK EQU * @VA13906 00140990 MVC FLIST+8(16),8(R13) SAVE FILE INFO FOR FINI @VA04102 00141000 L R15,AFINIS GET ADDRESS OF FINIS @VA04102 00141100 LA R1,FLIST @VA04102 00141200 BALR R14,R15 GO FINIS @VA04102 00141300 TM SWT,DOSOS IS THIS A DOS/OS DISK? @VA13906 00141310 BO CHKCALL YES, DON'T CHECK FOR 'LIB'. @VA13906 00141320 CLC BUFFER(3),=CL3'LIB' CHECK FOR VALID CMS LIBRARY.@VA13906 00141330 BE CHKCALL OK, SEE WHO IS CALLING. @VA13906 00141340 CLC BUFFER+3(3),=CL3'LIB' CHECK FOR VALID CMS LIB. @VA13906 00141350 BNE ERR056E GIVE INVALID FORMAT MESSAGE. @VA13906 00141360 CHKCALL EQU * @VA13906 00141370 TM SWT,MACLIB MACLIB CALLING? @VA04102 00141400 BO MLIB YES, GO THERE @VA04102 00141500 TM SWT,DOSLIB DOSLIB CALLING? @VA04102 00141600 BO DLIB BRANCH IF YES @VA04102 00141700 L R11,TXLIBSV GET TXTLIB TOTAL BYTE COUNT @VA04102 00141800 AH R11,BUFFER+10 ADD BYTES THIS LIBE @VA04102 00141900 ST R11,TXLIBSV AND SAVE @VA04102 00142000 B STAWAY @VA04102 00142100 MLIB L R11,MACLBSV GET MACLIB TOTAL BYTE COUNT @VA04102 00142200 AH R11,BUFFER+10 ADD BYTES THIS LIBE @VA04102 00142300 ST R11,MACLBSV AND SAVE @VA04102 00142400 B STAWAY @VA04102 00142500 DLIB EQU * @VA04102 00142600 L R11,DOSLBSV GET DOSLIB TOTAL BYTE COUNT @VA04102 00142700 AH R11,BUFFER+10 ADD BYTES THIS LIB @VA04102 00142800 ST R11,DOSLBSV AND SAVE @VA04102 00142900 STAWAY EQU * @VA04102 00143000 MVC 0(8,R3),0(R4) FILE EXISTS, MOVE IN NAME @VA04102 00143100 LA R3,8(0,R3) NEXT NAME POSITION 00144000 MMVC1 LA R4,8(0,R4) NEXT NAME IN USER LIST 00145000 SH R5,=H'8' DECREMENT LENGTH 00146000 BNZ MMVC LOOP UNTIL LENGTH GOES TO ZERO 00147000 LR R15,R7 SET ERROR IF ANY 00148000 B RETURN RETURN @VA04102 00149000 GLBSTER CH R15,=H'28' FILE NOT FOUND 00150000 BE ERR002E YES 00151000 RETURN L R11,MACLBSV GET MACLIB TOTAL @VA04102 00152000 A R11,TXLIBSV ADD TXTLIB TOTAL @VA04102 00152100 A R11,DOSLBSV ADD DOSLIB TOTAL @VA04102 00152200 ST R11,TOTLIBS AND SAVE IT @VA04102 00152300 L R14,SAVE14 GET RETURN ADDRESS @VA04102 00152400 BR R14 @VA04102 00152500 EJECT 00153000 *********************************************************************** 00154000 * 00155000 * ERROR MESSAGES 00156000 * 00157000 *********************************************************************** 00158000 SPACE 00159000 ERR002E LA R2,8(,R13) POINT TO FILENAME @V1D1905 00160100 DMSERR TEXT='FILE ''................'' NOT FOUND', X00161000 NUM=2,LET=W,SUB=(CHAR8A,(R2)) @V1D1905 00162100 LA R7,28 REMEMBER ERROR @V1D1905 00162200 B MMVC1 NEXT NAME @V1D1905 00162300 SPACE 00165000 ERR014E LA R2,8(0,R1) POINT TO INVALID FUNCTION 00166000 DMSERR TEXT='INVALID FUNCTION ''........''',NUM=014, X00167000 LET=E,SUB=(CHARA,(R2)) 00168000 LA R15,24 ERROR CODE 00169000 B RETURN @VA04102 00170000 ERR056E EQU * @VA13906 00170100 LA R2,8(,R13) POINT TO FILENAME. @VA13906 00170200 DMSERR TEXT=('FILE ''....................'' ', @VA13906X00170300 'CONTAINS INVALID RECORD FORMATS'),NUM=56, @VA13906X00170400 LET=E,SUB=(CHAR8A,(R2)) @VA13906 00170500 LA R7,32 SET ERROR CODE FOR CMS. @VA13906 00170600 B MMVC1 PROCESS NEXT NAME. @VA13906 00170700 SPACE 00171000 ERR047E DMSERR TEXT='NO FUNCTION SPECIFIED',NUM=47,LET=E 00172000 LA R15,24 ERROR CODE 00173000 B RETURN @VA04102 00174000 ERR104S EQU * @VA13906 00174100 LA R2,8(,R13) POINT TO FILENAME. @VA13906 00174200 LR R7,R15 GET ERROR CODE FOR MESSAGE. @VA13906 00174300 DMSERR TEXT=('ERROR ''..'' READING FILE ', @VA13906X00174400 '''................'' FROM DISK'),MF=(E,MSG), @VA13906X00174500 NUM=104,LET=S,SUB=(DEC,(R7),CHAR8A,(R2)) @VA13906 00174600 LA R7,100 SET ERROR CODE FOR CMS. @VA13906 00174700 B MMVC1 PROCESS NEXT NAME. @VA13906 00174800 SPACE 00175000 ERR108S DMSERR TEXT='MORE THAN 8 LIBRARIES SPECIFIED',NUM=108,LET=S 00176000 LA R15,88 00177000 B RETURN @VA04102 00178000 SPACE 00179000 MSG EQU * @VA13906 00179300 DMSERR MF=L,MAXSUBS=2 MSG AREA FOR RDBUF ERRORS. @VA13906 00179600 SHELL DC CL8'STATE' COMMAND NAME 00180000 DC CL8'LIBNAM' LIBRARY NAME 00181000 DC CL8'LIBTYPE' LIBRARY TYPE 00182000 DC CL2' ' ANY MODE 00183000 DC 2X'00' 00184000 DC F'0' 00185000 TABLE DC 255X'00' TRANSLATE TABLE 00186000 DC X'FF' 00187000 SAVE14 DS F R14 SAVEAREA @V305066 00187100 RDLIST DS 0D @VA04102 00187200 DC CL8'RDBUF' @VA04102 00187275 RDNAME DC CL8' ' @VA04102 00187350 RDTYPE DC CL8' ' TYPE FOR RDBUF @VA04102 00187425 RDMODE DC CL2' ' MODE @VA04102 00187500 RDITEM DC H'1' ITEM NO. @VA04102 00187575 RDADD DC A(BUFFER) BUFFER ADDRESS @VA04102 00187650 RDBUFSZ DC F'80' @VA04102 00187725 RDFLAG DC CL1'F' FIXED FORMAT @VA04102 00187800 DC CL1' ' NULL BLOCK FIELD @VA04102 00187875 RDNUM DC H'1' ITEMS TO BE READ @VA04102 00187950 DC A(*-*) BYTES READ @VA04102 00188025 BUFFER DS 0D @VA04102 00188100 DC CL80' ' @VA04102 00188175 FLIST DS 0D @VA04102 00188250 DC CL8'FINIS' @VA04102 00188325 DC CL8' ' PLIST FOR FINIS @VA04102 00188400 DC CL8' ' @VA04102 00188475 DC CL2' ' @VA04102 00188550 SWT DC X'00' SWITHC INDICATOR @VA04102 00188625 TXTLIB EQU X'80' TXTLIB INDICATOR @VA04102 00188700 MACLIB EQU X'40' MACLIB INDICATOR @VA04102 00188775 DOSLIB EQU X'20' DOSLIB INDICATOR @VA04102 00188850 DOSOS EQU X'01' DOS/OS DISK INDICATOR. @VA13906 00188885 NUCON 00189000 REGEQU 00190000 END 00191000