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