ibm:vm370-lib:cms:dmsglb.assemble_src
Table of Contents
DMSGLB Source
References
- Fixes Applied : 1
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [R13906DS]
Source Listing
- DMSGLB.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmsglb.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator