From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX"  2-JUL-1990 10:43:27.52
To:	MRGATE::"ARISIA::EVERHART"
CC:	
Subj:	Re: Making $ALLOC "stick"

Received:  by crdgw1.ge.com (5.57/GE 1.70)
	 id AA11259; Fri, 29 Jun 90 08:31:48 EDT
Received: From CORNELLC.CIT.CORNELL.EDU by CRVAX.SRI.COM with TCP; Thu, 28 JUN 90 15:20:20 PDT
Received: from UALR.BITNET by CORNELLC.cit.cornell.edu (IBM VM SMTP R1.2.1MX) with BSMTP id 5225; Thu, 28 Jun 90 18:18:32 EDT
Date: Thu, 28 Jun 90 16:53 CST
From: Dale Miller <DOMILLER%UALR.BITNET@CORNELLC.cit.cornell.edu>
Subject: Re: Making $ALLOC "stick"
To: INFO-VAX@SRI.COM
Message-Id: <71E05589571F803085@UALR.BITNET>
X-Envelope-To: INFO-VAX@SRI.COM
X-Vms-To: IN%"INFO-VAX@SRI.COM"

 James Kirkpatrick <jimkirk@CORRAL.UWYO.EDU> WRITES:

>I'm trying to use $ALLOC in a program to allocate a tape drive, but as soon
>as the image exits, the drive is deallocated.  I'd like it to stick around
>for other programs, like the ALLOCATE command.  Here's the call I am using:
>
>      PROGRAM X
>      IMPLICIT NONE
>      INTEGER STATUS,SYS$ALLOC,NAMEL
>      CHARACTER*100 NAME
>      INCLUDE '($SSDEF)'
>
>      STATUS=SYS$ALLOC ('TA79',NAMEL,NAME,,%VAL(1))
>      PRINT *,STATUS,NAME,NAMEL
>      IF (STATUS.NE.SS$_NORMAL) CALL LIB$STOP (%VAL(STATUS))
>      END
>
>This should be equivalent to ALLOCATE/GENERIC TA79, and it does in fact
>allocate a drive and display it's name when I run it.  But if I run it
>several times it displays the same drive.  Also, after running, a
>SHOW DEV lists the device as unallocated.
>
>RTFM tends to confirm the behavior: "The Allocate Device service allocates
>a device for exclusive use by a process ... until the image that called
>$ALLOC exits..."
>
>So, how do I make ALLOC stick?  Must I SPAWN a DCL ALLOCATE command?
>How does DCL do it?

When I tried to do that, I discovered that exact problem.  The solution is
not overly complex, but does require the user (or the image) to have CMEXEC
privilege.  Following the signature block is the code for ALOCWAIT, a routine
to request 1 or more devices and return to the user when all are allocated,
waiting if the device is allocated to another user.
        Dale
--------------------------------------------------------------------------
| Dale O. Miller                        | #   #  ###  #     ####         |
| University of Arkansas at Little Rock | #   # #   # #     #   #        |
| 2801 S. University                    | #   # ##### #     ####         |
| Little Rock, AR  72204-1099  USA      | #   # #   # #     #  #         |
| (501)569-8714                         |  ###  #   # ##### #   #        |
| DOMILLER@UALR.BITNET                  | Disclaimer: This does not      |
| 92-20-28 W,34-43-30 N.ICBMNET         | say what I say it doesn't say. |
--------------------------------------------------------------------------
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c       ALOCWAIT.FOR
c       This program mimics the VMS ALLOCATE command with the addition
c       of a qualifier for number of devices and the requirement that
c       it waits until the devices are available for allocation
c       Dale Miller - UALR
c
c       Rev. 1.0  26-Jan-1988
c       Rev. 1.1  04-May-1989
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        implicit none
        include       '($ssdef)'
        include       '($clidef)'
        include       '($psldef)'
        include       '($dscdef)'
        parameter     cli$_absent = '000381f0'x
        parameter     maxdev = 10

c NONGEN        <Must use /GENERIC to allocate multiple devices>
c TOOMANY       <Maximum of 5 devices may be allocated>
c EXTRALOG      <The logical name !AS was unused>/FAO_COUNT=1
c ALLOCATED     <Device !AS was assigned to !AS>/FAO_COUNT=2
c ALOCNOLOG     <Device !AS was allocated>/FAO_COUNT=1

        external      alocwait_nongen, alocwait_alocnolog
        external      alocwait_extralog, alocwait_allocated
        external      alocwait_toomany

        character*32  devnam,phybuf(maxdev),logname(maxdev),num_string
        integer*4     phylen(maxdev),namlen(maxdev)
        integer*4     istat,flags,devlen,i,j,acmode
        integer*4     num_names,numdev,numdev_len
        integer*4     tdummy(2), extra
        integer*4     sys$cmexec
        external      sys$alloc, sys$dalloc
        integer*4     cli$get_value,cli$present
        integer*4     allo_arglist(6),dallo_arglist(3)
        real*8        time1

        record/dscdef1/ devdes
        record/dscdef1/ phybufdes

 1001   format(i<numdev_len>)

        acmode = psl$c_super
        istat = cli$get_value('ALOCWAIT',devnam,devlen)
        if (cli$present('GENERIC')) then
            flags=1
        else
            flags=0
        endif

        if (cli$present('NUMBER')) then
            istat = cli$get_value('NUMBER',num_string,numdev_len)
            read(num_string,1001)numdev
            if(numdev.gt.maxdev) call sys$exit(alocwait_toomany)
        else
            numdev=1
        endif

        istat = 0
        num_names = 0
        do while (istat.ne.cli$_absent)
            num_names=num_names + 1
            istat = cli$get_value('LOGNAME', logname(num_names),
        1       namlen(num_names))
            end do
        num_names = num_names - 1
        if((num_names.gt.1.or.numdev.gt.1).and.flags.eq.0) then
            call sys$exit(alocwait_nongen)
            end if
        if(num_names.gt.maxdev) call sys$exit(alocwait_toomany)

        if(num_names.gt.numdev) numdev=num_names

c       Set up everything for the allocate (and possible deallocate)
        devdes.dsc$w_maxstrlen     = devlen
        devdes.dsc$b_dtype         = dsc$k_dtype_t
        devdes.dsc$b_class         = dsc$k_class_s
        devdes.dsc$a_pointer       = %loc(devnam)

        phybufdes.dsc$w_maxstrlen  = 32
        phybufdes.dsc$b_dtype      = dsc$k_dtype_t
        phybufdes.dsc$b_class      = dsc$k_class_s

        allo_arglist(1) = 5
        allo_arglist(2) = %loc(devdes)
        allo_arglist(4) = %loc(phybufdes)
        allo_arglist(5) = acmode
        allo_arglist(6) = flags

        dallo_arglist(1) = 2
        dallo_arglist(2) = %loc(phybufdes)
        dallo_arglist(3) = acmode

c       Schedule the wakeup (if necessary)
        callsys$bintim('0000 00:01:00.00',time1)
        call sys$schdwk(,,time1,time1)

 0100   continue
c       If the device is a tape, try to randomize allocation
        if (devnam.eq.'TA78' .or. devnam.eq.'MU') then
            call sys$gettim(tdummy)
            extra = ran(tdummy(1))*5
            do i=1,extra
                allo_arglist(3) = %loc(phylen(maxdev+1-i))
                phybufdes.dsc$a_pointer = %loc(phybuf(maxdev+1-i))
                istat=sys$cmexec(sys$alloc,allo_arglist)
                end do
        else
            extra = 0
        end if

c       Actually do the allocation

        do i=1,numdev
            allo_arglist(3) = %loc(phylen(i))
            phybufdes.dsc$a_pointer = %loc(phybuf(i))

            istat=sys$cmexec(sys$alloc,allo_arglist)

            if(istat.eq.ss$_devalloc.or.istat.eq.ss$_nodevavl) then
                do j=1,i-1
                    phybufdes.dsc$a_pointer = %loc(phybuf(maxdev+1-j))
                    istat=sys$cmexec(sys$dalloc,dallo_arglist)
                    end do
                do j=1,extra
                    phybufdes.dsc$a_pointer = %loc(phybuf(maxdev+1-j))
                    istat=sys$cmexec(sys$dalloc,dallo_arglist)
                    end do
                if (extra.ne.0) then
                    go to 100
                else
                    call sys$hiber()
                    go to 100
                end if
            else if (istat.ne.ss$_normal) then
                do j=1,extra
                    phybufdes.dsc$a_pointer = %loc(phybuf(maxdev+1-j))
                    istat=sys$cmexec(sys$dalloc,dallo_arglist)
                    end do
                call sys$exit(%val(istat))
            end if
            end do
        do i=1,numdev
            if(num_names.ge.i) then
                call lib$signal(alocwait_allocated,%val(2),
        1           phybuf(i)(1:phylen(i)),logname(i)(1:namlen(i)))
                call lib$set_logical(logname(i)(1:namlen(i)),
        1           phybuf(i)(1:phylen(i)))
            else
                call lib$signal(alocwait_alocnolog,%val(1),
        1           phybuf(i)(1:phylen(i)))
            endif
            end do
        do j=1,extra
            phybufdes.dsc$a_pointer = %loc(phybuf(maxdev+1-j))
            istat=sys$cmexec(sys$dalloc,dallo_arglist)
            end do

        call sys$exit
        end

