program packack
        INCLUDE '($STSDEF)'
        INCLUDE '($SYIDEF)'
	integer*4 fgetfid
	external fgetfid
	integer*4 lgetfid
	external lgetfid
	integer*4 prvmsk(2)
	integer*4 ident(2),lnkid(2)
	integer*4 cmdlen,fcmsk
	character*80 fidasc,keystr,dlnwrk
	character*80 wrkfnm,dvcnam
	character*250 cmdlin,cmdini,wrest,aclac
	integer*4 iios(2),iucbk(2),itrunc
	integer*4 bufdum(128)
	logical*1 lucbk(8)
	character*16 fidavl
	character*4 hv(6)
	character*4 hd(9)
	logical istatus
	equivalence(iucbk(1),lucbk(1))
	integer*4 ifid(2),ifsz,ifcnmsk,kfid(2)
	character*8 cifid
	equivalence(ifid(1),cifid)
        integer*4 sys$assign,sys$dassgn
        external sys$assign,sys$dassgn
        character*256 msgbuf
        integer*4 sys$getmsg,msglen,msgid
        external sys$getmsg
	integer*2 ufid(4)
	equivalence(ufid(1),kfid(1))
	common/fffiii/lnkid,lnkfs
	common/ffiidd/ifid,ifsz
	integer*4 iwbuf(8)
	byte wbuf(32)
	character*32 cwbuf
	equivalence(wbuf(1),cwbuf,iwbuf)
        Integer*4 lib$sys_trnlog,lib$get_foreign,sys$qiow
        External lib$sys_trnlog,lib$get_foreign,sys$qiow
	include '($dvidef)'
	include '($jpidef)'
	include '($acldef)'
	include '($iodef)'
	character*256 dbnam
	integer*4 iosb(2),il3(3,3)
	integer*2 il32(6,3)
	equivalence(il3(1,1),il32(1,1))
	character*128 fulldevnam
	integer*4 ifnmsz,ialcls
	character*32 wk1,wk2,wk3
c Set up the $getdvi call to get device info
	il32(1,1)=128
	il32(2,1)=dvi$_fulldevnam
	il3(2,1)=%loc(fulldevnam)
	il3(3,1)=%loc(ifnmsz)
	il32(1,2)=4
	il32(2,2)=dvi$_alloclass
	il3(2,2)=%loc(ialcls)
	il3(3,2)=0
	il3(1,3)=0
	il3(2,3)=0
	il3(3,3)=0
c ifcnmsk is functions we want done with this file.
	izip=0
	aclac=' '
	izoo=0
	icmpr=0
	ichn=0
	iucmpr=0
	ilink=0
	ifcnmsk=0
	itrunc=0
	imov=0
	iovwt=0
c Pass in the desired ACE as hex
	ii=lib$get_foreign(cmdlin,'Disk:',cmdlen,)
	cmdlin=cmdlin(1:cmdlen)
c test termination. Q or ctrlZ will just exit...
	if(ichar(cmdlin(1:1)).le.32)goto 9999
	if(cmdlin(1:1).eq.'q'.or.cmdlin(1:1).eq.'Q')goto 9999
c pass any space after a "spa/flush " part of the string.
	ispc=index(cmdlin,' ')
	if(ispc.gt.0.and.ispc.lt.cmdlen)cmdlin=cmdlin(ispc+1:)
c have to get file open to get its' file ID...
c Only open for read...we don't want to mess up any info in it.
	icolon=index(cmdlin,':')
	dvcnam=cmdlin(:icolon)
	if(icolon.le.0)then
	lcml=ivlen(cmdlin,250)
	cmdlin(lcml+1:lcml+1)=':'
	icolon=index(cmdlin,':')
	dvcnam=cmdlin(:icolon)
	end if
	if(icolon.le.0)write(6,8001)
8001	format(' Cannot find device name. Exiting.')
	if(icolon.le.0)call exit
c get a channel to the device
	ichn=0
	kkk=sys$assign(dvcnam(:icolon),ichn,,,,)
	if(ichn.le.0)then
	iiii=sys$getmsg(%val(kkk),msglen,msgbuf,,)
	write(6,8002)msgbuf(:msglen)
	end if
8002	format(' %Spa-F-assign failed. Msg=',A)
	if(ichn.le.0)goto 9999
c issue io$_packack on device
	iosb(1)=2
	kkk=sys$qiow(%val(10),%val(ichn),%val(io$_packack),
     1  iosb,,,,,,,,)
	kii=kkk.and.1
	if(kii.eq.0)then
	iiii=sys$getmsg(%val(kkk),msglen,msgbuf,,)
	write(6,8204)msgbuf(:msglen)
	end if
8204	format(A)
	kqk=iosb(1)
	kqq=kqk.and.1
	if(kqq.eq.0.and.kqk.ne.2.and.kqk.ne.0)then
	iiii=sys$getmsg(%val(kqk),msglen,msgbuf,,)
	write(6,8204)msgbuf(:msglen)
	end if
	kkk=sys$dassgn(%val(ichn))
9999	call exit
	end
	integer*4 function ivlen(arg,len)
	integer*4 len
	character*(*) arg
c return length of printable string
	do 1 n=1,len
	k=len+1-n
c go back in loop looking for a printing char.
	if(ichar(arg(k:k)).gt.32)goto 2
1	continue
	ivlen=0
	return
2	continue
	ivlen=k
	return
	end