GETFDS TITLE ' GETFDS -- GET FORT#00000010 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** RAN DATA SET NAME, GIVEN THE UNIT NUMBER.' 00000020 *TITLEGETFDS -- GET FORTRAN DATA SET NAME, GIVEN THE UNIT NUMBER. 00000030 *A AUTHOR FRANCIS COLLINS 00000040 *A DESIGNER FRANCIS COLLINS 00000050 *A LANGUAGE S/370 ASSEMBLER F 00000060 *A WRITTEN 2-18-76 00000070 * REVISED 00000080 *A 00000090 *A 00000100 *A CALL GETFDS (UNIT, DSN) 00000110 *A 00000120 *A CALL GETFDS (UNIT, DSN, LENGTH) 00000130 *A 00000140 *A INPUT UNIT = FORTRAN UNIT NO. (DATA SET REF. NO.) I4 00000150 *A = XX IN DDNAME FTXXF001. 00000160 *A 00000170 *A OUTPUT DSN = DATA SET NAME FROM DD-CARD FTXXF001. 11A4 00000180 *A 00000190 *A OUTPUT LENGTH = NUMBER OF CHARACTERS IN DATA SET NAME. I4 00000200 *A IF LENGTH IS NEGATIVE, THE DSN ARRAY 00000210 *A CONTAINS AN ERROR MESSAGE. 00000220 *A THIS PARAMETER IS OPTIONAL. 00000230 *A 00000240 *A OUTPUT REG 15 = RETURN CODE = 4 IF DD-CARD NOT FOUND. 00000250 * 00000260 * 00000270 GETFDS CSECT 00000280 R0 EQU 0 00000290 R1 EQU 1 ADDRESS OF PARAMETER LIST. 00000300 R2 EQU 2 ADDRESS OF UNIT, THEN VALUE OF UNIT. 00000310 R3 EQU 3 ADDRESS OF DSN. 00000320 R4 EQU 4 ADDRESS OF LENGTH. 00000330 R5 EQU 5 ) USED IN LOOP TO COUNT NON-BLANK CHARACTERS IN 00000340 R6 EQU 6 ) DSN. R5 RUNS FROM R3+1 TO R3+43. R5 IS INCRE- 00000350 R7 EQU 7 ) MENTED BY R6 (=1) AND COMPARED TO R7 (=R3+43). 00000360 R10 EQU 10 ADDRESS OF JOB FILE CONTROL BLOCK AREA. 00000370 R11 EQU 11 ADDRESS OF DATA CONTROL BLOCK. 00000380 R12 EQU 12 BASE REGISTER = ADDRESS OF GETFDS. 00000390 R13 EQU 13 00000400 R14 EQU 14 00000410 R15 EQU 15 00000420 * 00000430 USING *,R15 00000440 B START 00000450 DC X'06',C'GETFDS ' 00000460 START STM R14,R12,12(R13) 00000470 ST R13,SAVE+4 00000480 LA R12,SAVE 00000490 ST R12,8(,R13) 00000500 LR R13,R12 00000510 SPACE 00000520 LR R12,R15 BASE REGISTER. 00000530 LA R11,DCB ADDRESS OF DATA CONTROL BLOCK. 00000540 LA R10,JFCBAREA ADDRESS OF JOB FILE CONTROL BLOCK. 00000550 EJECT 00000560 DROP R15 00000570 USING GETFDS,R12 00000580 USING IHADCB,R11 IHADCB = NAME OF DCBD DSECT (DCB MAP). 00000590 USING JFCB,R10 JFCB = NAME OF JFCB DSECT (JFCB MAP). 00000600 SPACE 00000610 LM R2,R4,0(R1) LOAD PARAMETER ADDRESSES. 00000620 L R2,0(R2) LOAD VALUE OF UNIT. 00000630 CVD R2,PACKUNIT CONVERT UNIT TO ZONED DECIMAL. WILL BE 00000640 UNPK 0(10,R3),PACKUNIT LEFT IN DSN ARRAY IF OUT OF RANGE. 00000650 OI 9(R3),X'F0' KILL SIGN. WILL BE ADJUSTED LATER. 00000660 LTR R2,R2 TEST UNIT FOR RANGE 1 TO 99. 00000670 BNP UNITLO LESS THAN ONE. 00000680 C R2,=F'100' 00000690 BNL UNITHI GREATER THAN 99. 00000700 MVC DCBDDNAM+2(2),8(R3) RANGE OK. MOVE UNIT TO DDNAME. 00000710 SPACE 00000720 RDJFCB ((R11),OUTPUT) READ JOB FILE CONTROL BLOCK FTXXF001. 00000730 SPACE 00000740 LTR R15,R15 TEST RETURN CODE FROM RDJFB MACRO. 00000750 BNZ NODDCARD IF NOT ZERO, NO FTXXF001 DD-CARD. 00000760 MVC 0(44,R3),JFCBDSNM MOVE DATA SET NAME TO DSN ARRAY. 00000770 LENCHECK LTR R3,R3 IF THIRD PARAMETER IS NOT PRESENT, 00000780 BM RETURN EXECUTION IS COMPLETE. 00000790 LA R5,1(,R3) SET UP LOOP FOR COUNTING NON-BLANK 00000800 LA R6,1 CHARACTERS IN DSN. 00000810 LA R7,43(,R3) R5 STARTS AT R3 + 1. 00000820 LENCOUNT CLI 0(R5),C' ' R6 = 1 = INCREMENT FOR R5. 00000830 BE LENCOMP R7 = R3 + 43 UPPER LIMIT FOR R5. 00000840 BXLE R5,R6,LENCOUNT R5 + R6 IS COMPARED TO R7. 00000850 LENCOMP SR R5,R3 LENGTH = R5 - R3. 00000860 LENSTORE ST R5,0(,R4) 00000870 SPACE 00000880 RETURN L R13,SAVE+4 00000890 LM R0,R12,20(R13) LEAVE RETURN CODE FROM RDJFCB IN R15. 00000900 L R14,12(,R13) 00000910 BR R14 00000920 SPACE 00000930 UNITLO BZ UNITHI UNIT IS .LE. ZERO. 00000940 MVI 0(R3),C'-' IF NEGATIVE, INSERT MINUS SIGN. 00000950 UNITHI MVC 10(34,R3),UNITMESS UNIT IS ZERO OR .GT. 99. 00000960 B LENM44 00000970 SPACE 00000980 NODDCARD MVC 0(8,R3),DCBDDNAM DD-CARD NOT FOUND. MOVE DDNAME 00000990 MVC 8(36,R3),NODDMESS AND MESSAGE TO DSN ARRAY. 00001000 SPACE 00001010 LENM44 LTR R3,R3 DSN CONTAINS ERROR MESSAGE. IF 00001020 BM RETURN THIRD PARAMETER IS PRESENT, SET 00001030 L R5,=F'-44' LENGTH EQUAL TO -44. 00001040 B LENSTORE 00001050 EJECT 00001060 PACKUNIT DC D'0' DOUBLE-WORD FOR PACKED UNIT NUMBER. 00001070 SPACE 00001080 JFCBPNTR DC X'87',AL3(JFCBAREA) DCB EXIT LIST. 00001090 JFCBAREA DC 176X'0' RDJFCB MACRO READS JFCB INTO THIS ARRAY. 00001100 SPACE 00001110 UNITMESS DC CL34' UNIT NUMBER OUT OF RANGE.' 00001120 NODDMESS DC CL36' DD-CARD NOT FOUND.' 00001130 SPACE 00001140 SAVE DC 18F'0' 00001150 PRINT NOGEN 00001160 DCB DCB DDNAME=FTXXF001, -00001170 DSORG=PS, -00001180 EXLST=JFCBPNTR, -00001190 MACRF=(WC) BSAM. 00001200 SPACE 00001210 JFCB DSECT 00001220 JFCBDSNM DS CL44 00001230 SPACE 00001240 PRINT NOGEN 00001250 DCBD DSORG=PS,DEVD=DA 00001260 SPACE 00001270 END 00001280