DYNA TITLE 'DYNAMIC FILE ALLOCATION ROUTINE' 00000010 *********************************************************************** 00000020 * DYNALC - J.F. Chandler - 1986 October * 00000030 * TSO FORTRAN-callable routine based on version from KERMSRV * 00000040 * e.g., CALL DYNALC(DSN,DDN,UNIT,VOL,DISP,SPACE,RC) * 00000050 * or CALL DYNALC(DSN,DDN,UNIT,VOL,DISP,SPACE,RC,BUFF) * 00000055 * with DSN 60-char string of DSN + MEMBER + PASSW (blank if none) * 00000060 * DDN 8-char string of DDNAME or FORTRAN unit number * 00000070 * UNIT 8-char string of device type * 00000080 * VOL 6-char string of volume name * 00000090 * DISP 1-byte code giving dataset disposition: * 00000100 * 80: SHR 08: KEEP One bit must be set * 00000110 * 40: NEW + 04: DELETE in each HEX digit. * 00000120 * 20: MOD 02: CATLG * 00000130 * 10: OLD 01: UNCATLG * 00000140 * SPACE fullword track allocation increment * 00000150 * RC fullword returned completion (0 if ok, 1 if not) * 00000160 * BUFF (optional) 512-byte buffer for returned error message. * 00000163 * If not given, in case of error, display the message. * 00000166 *********************************************************************** 00000170 DYNALC CSECT 00000180 PRINT NOGEN 00000190 SAVE (14,12),,* 00000200 USING DYNALC,15 00000210 CNOP 0,4 00000220 BAL 12,*+76 00000230 USING *,13 00000240 DS 18F 00000250 ST 12,8(13) 00000260 ST 13,4(12) 00000270 LR 13,12 00000280 LM 4,11,0(1) Get arguments @SC88119 00000290 TM 0(4),X'F0' 00000300 BNM EXITBAD Must be old 00000310 LR 1,4 Dsname ptr 00000320 LA 0,44 00000330 LA 3,TUDSN+2 00000340 BAL 14,GETTU 00000350 LA 1,44(4) Possible member name 00000360 LA 0,8 Max length 00000370 LA 3,TUMEM+2 00000380 BAL 14,GETTU 00000390 LA 1,52(4) Possible password 00000392 LA 0,8 Max length 00000394 LA 3,TUPASS+2 00000396 BAL 14,GETTU 00000398 LR 1,5 Ddname ptr 00000400 TM 0(1),X'F0' 00000410 BNZ DDCHAR Must be char string 00000420 L 0,0(1) Numeric, get value 00000430 CVD 0,DBLWORD 00000440 OI DBLWORD+7,15 00000450 LA 1,FTXXF001 00000460 UNPK 2(2,1),DBLWORD Convert to zoned 00000470 DDCHAR LA 0,8 Max length 00000480 LA 3,TUDDN+2 00000490 BAL 14,GETTU 00000500 SR 0,0 00000510 IC 0,0(8) Get stat,disp 00000520 SRDL 0,4 Separate nybbles 00000530 SRL 1,28 00000540 STC 0,TUSTAT Save values 00000550 STC 1,TUDISP 00000560 LR 1,6 Unit ptr 00000570 LA 0,8 Max length 00000580 LA 3,TUUNT+2 00000590 BAL 14,GETTU 00000600 LR 1,7 Volume ptr 00000610 LA 0,6 Max length 00000620 LA 3,TUVOL+2 00000630 BAL 14,GETTU 00000640 L 2,0(9) Space value 00000650 STCM 2,7,TUPRIME Use for both 00000660 STCM 2,7,TUSECOND 00000670 LA 1,TEXTOLD 00000680 MVC 0(16,1),=A(TUUNT,TUVOL,TUPASS,TUMEM) 00000690 LA 3,4 00000700 TSTSLP L 2,0(1) 00000710 CLI 5(2),0 Is is specified? 00000720 BNE *+10 Yes, keep it 00000730 XC 0(4,1),0(1) No, exclude it from list 00000740 LA 1,4(1) On to next 00000750 BCT 3,TSTSLP 00000760 LA 1,TEXTOLD Determine which units to use 00000770 TM TUSTAT,X'04' 00000780 BZ DYNALLOC 00000790 LA 1,TEXTNEW 00000800 CLI TUMEM+5,0 Any member given? 00000810 BE DYNALLOC No, that's fine 00000820 LA 1,TEXTNEWM Yes, must allocate directory 00000830 DYNALLOC ST 1,DYNTXTPP 00000840 LA 1,DYNRBPTR 00000850 DYNALLOC , 00000860 LTR 15,15 00000870 BZ EXITRC 00000880 NI DFSWTCHS,X'9F' @SC88119 00000881 LTR 10,10 Is there a message buffer? @SC88119 00000882 BM *+8 No @SC88119 00000883 OI DFSWTCHS,X'40' Yes, set flag for filling it @SC88119 00000884 STCM 11,7,DFBUFP+1 Pass pointer @SC88119 00000885 DYNFAIL ST 15,S99RC 00000890 LA 1,DFPARMS 00000900 LINK EP=IKJEFF18 00000910 EXITBAD LA 15,1 00000920 EXITRC ST 15,0(10) Save RC 00000930 L 13,4(13) 00000940 RETURN (14,12) 00000950 * 00000960 * Copy string+length into text unit. R1->string, R3->length field 00000970 GETTU LR 2,1 Save start of string 00000980 GLLP CLI 0(2),C' ' Find end 00000990 BE GOTLEN 00001000 LA 2,1(2) 00001010 BCT 0,GLLP 00001020 GOTLEN SR 2,1 Length of token 00001030 STCM 2,3,2(3) Save in text unit 00001040 BZR 14 Empty string 00001050 BCTR 2,0 Fix for execute 00001060 EX 2,COPYTU 00001070 BR 14 00001080 COPYTU MVC 4(,3),0(1) Move string to text unit 00001090 EJECT 00001100 DS 0F 00001110 DYNRBPTR DC X'80',AL3(DYNRB) 00001120 DYNRB DC AL1(20,S99VRBAL) 00001130 DC AL2(0,0,0) 00001140 DYNTXTPP DC AL4(*-*) 00001150 DC AL4(0,0) 00001160 S99RC DC F'0' 00001170 TEXTNEWM DC A(TUDIR) 00001180 TEXTNEW DC A(TUTRK,TUPRI,TUSEC,TUREL) 00001190 TEXTOLD DC A(TUUNT,TUVOL,TUPASS,TUMEM) 00001200 DC A(TUDDN,TUDSN,TUSTA,TUDIS),X'80',AL3(TUFRE) 00001210 * 00001220 TUDDN DC AL2(DALDDNAM,1) DDNAME 00001230 DS AL2,CL8 00001240 TUDSN DC AL2(DALDSNAM,1) DSNAME 00001250 DS AL2,CL44 00001260 TUMEM DC AL2(DALMEMBR,1) Member 00001270 DS AL2,CL8 00001280 TUPASS DC AL2(DALPASSW,1) Password 00001283 DS AL2,CL8 00001286 TUDIR DC AL2(DALDIR,1) Dir blks 00001290 DC AL2(3),AL3(5) 00001300 TUDIS DC AL2(DALNDISP,1,1) Disp 00001310 TUDISP DC X'00' 00001320 TUSTA DC AL2(DALSTATS,1,1) Status 00001330 TUSTAT DC X'00' 00001340 TUUNT DC AL2(DALUNIT,1) Unit 00001350 DS AL2,CL8 00001360 TUVOL DC AL2(DALVLSER,1) Volume 00001370 DS AL2,CL6 00001380 TUTRK DC AL2(DALTRK,0) Tracks 00001390 TUPRI DC AL2(DALPRIME,1,3) Primary 00001400 TUPRIME DC AL3(*-*) 00001410 TUSEC DC AL2(DALSECND,1,3) Secondary 00001420 TUSECOND DC AL3(*-*) 00001430 TUREL DC AL2(DALRLSE,0) Release 00001440 TUFRE DC AL2(DALCLOSE,0) FREE=CLOSE 00001450 DFPARMS DS 0D DAIR fail plist 00001460 DFS99RBP DC A(DYNRB) Adr of SVC 99 req blk 00001470 DFRCP DC A(S99RC) Adr of SVC 99 ret code 00001480 DFJEFF02 DC A(DFZEROES) Adr of unknown writer 00001490 DFIDP DC A(DFSWTCHS) Adr of DAIRFAIL options 00001500 DFCPPLP DC A(0) Unknown CPPL address 00001510 DFBUFP DC A(0) Do not return message 00001520 DFZEROES DC A(0) 00001530 DFSWTCHS DC X'80',X'33' WTP for DYNALLOC, please 00001540 DBLWORD DC D'0' 00001550 FTXXF001 DC C'FTXXF001' Place to build FORTRAN ddname 00001560 IEFZB4D0 00001570 IEFZB4D2 00001580 END 00001590