home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
deleteme.tar.gz
/
deleteme.tar
/
iktdyn.asm
< prev
next >
Wrap
Assembly Source File
|
1992-09-30
|
14KB
|
174 lines
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