From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 11-NOV-1989 21:47
To:	MRGATE::"ARISIA::EVERHART"
Subj:	SCRSMB part .17 of 20

Message-Id:  <8911120032.AA08156@crdgw1.ge.com>
Received: From RELAY.CS.NET by GIZMO.SRI.COM with TCP; Sat, 11 NOV 89 00:10:13 PDT
Received: from relay2.cs.net by RELAY.CS.NET id aa07742; 10 Nov 89 23:02 EST
Received: from a.cs.okstate.edu by RELAY.CS.NET id al00506; 10 Nov 89 23:58 EST
Received: from nemo.math.okstate.edu by a.cs.okstate.edu id ae29700;
          10 Nov 89 20:41 CST
Date: Fri, 10 Nov 89 20:39 CDT
From: Gregg Wonderly <GREGG%nemo.math.okstate.edu@RELAY.CS.NET>
Subject: SCRSMB part .17 of 20
To: info-vax@KL.SRI.COM
X-Vms-To: in%"info-vax@kl.sri.com"

-+-+-+-+-+-+-+-+ START OF PART 17 -+-+-+-+-+-+-+-+
X            logical found, strcmp
X
X            integer*2 chan, flen
X
X            character*(BUFSIZ) line, method, device
X
X            external strcmp, skip_space, get_params, call_func
X            external abort_queue, get_method
X            integer call_func, get_method
X
X  1         continue
X
X            found = .false.
X            do while (.not. found)
X
X                read (jobs(idx).devs_unit, 5, err = 500, end = 300,
X     .                                                  iostat = iostat) lin
Ve
X  5             format (A80)
X
X                len = blength(jobs(idx).queue) + 1
X                if (strcmp (line (1:len), jobs(idx).queue (1:len)//' ')) the
Vn
X
X                    i=len+1
X
X*                   Skip to device field
X
X                    call skip_space (line, i)
X
X                    select_dev = 0
X
X                    len = blength(line(i:))
X                    device = line (i:len+i)
X                    jobs(idx).device = device(1:len)
X
X*                   Skip to method field
X
X                    i = i + len
X                    call skip_space (line, i)
X
X                    mlen = blength(line(i:))
X                    method = line (i:mlen+i-1)
X
X*                   Get the method image.
X
X                    status = get_method (method(1:mlen), jobs(idx).method)
X
X                    if (.not. status) then
X                        call abort_queue (idx,
X     .                          'Can''t locate executable for method, ''' //
X     .                          method(1:mlen) // '''', %val(status))
X                        select_dev = GD$_ERRALLOC
X                        return
X                    endif
X
X                    i = i + mlen + 1
X
X*                   Skip to script file position
X
X                    call skip_space (line, i)
X
X*                   Zero the parameter block
X
X                    do j=0,MAX_PARAMS-1
X                        jobs(idx).params(j).len = 0
X                        jobs(idx).params(j).str = ' '
X                    end do
X
X*                   Check for the end of the line, and adjust accordingly.
X
X                    if (i .lt. BUFSIZ) then
X
X*                       Get the correct script file name.
X
X                        if (line(i:i) .eq. '-') then
X                            devlen = blength (jobs(idx).device)
X                            qlen = blength (jobs(idx).queue)
X
X                            jobs(idx).scriptfn = '`091' //
X     .                         jobs(idx).queue (1:qlen) // '`093' //
X     .                         jobs(idx).device (1:devlen) // '.'
X                        else
X                            devlen = blength(line(i:))
X                            jobs(idx).scriptfn = line (i:devlen + i)
X                            i = i + devlen
X                        endif
X
X*                       Get any parameters.
X
X                        i = i + 1
X                        call get_params (idx, i, line)
X                    else
X
X*                       Create a script file name based on queue and device.
X
X                        devlen = blength (jobs(idx).device)
X                        qlen = blength (jobs(idx).queue)
X
X                        jobs(idx).scriptfn = '`091' //
X     .                       jobs(idx).queue (1:qlen) // '`093' //
X     .                       jobs(idx).device (1:devlen) // '.'
X                    endif
X
X*                   Ok, everything is in place, so allocate the device.
X
X                    stat = call_func (methods(jobs(idx).method).alloc,
X     .                                jobs(idx),
X     .                                %descr (device (1:len)),
X     .                                %descr (method (1:mlen)))
X
X*                   SS$_NORMAL is the only acceptable completion code.
X
X                    if (stat .eq. SS$_NORMAL) then
X                        stat = call_func (methods(jobs(idx).method).connect,
X     .                                  jobs(idx),
X     .                                  %descr(device(1:len)),
X     .                                  chan, jobs(idx).form_width, exproces
Vs)
X
X                        if (stat .eq. PSM$_PENDING) then
X                            jobs(idx).chan = chan
X                            select_dev = GD$_PENDING
X                            found = .true.
X                        else if ((stat. and. 1) .eq. 1) then
X                            jobs(idx).chan = chan
X                            select_dev = GD$_GOTONE
X                            found = .true.
X                        else
X                            stat2 = call_func (
X     .                              methods(jobs(idx).method).dealloc,
X     .                              jobs(idx),
X     .                              device(1:len),method(1:mlen))
X
X                            call log_str (%val (stat),
X     .                          'Can''t assign channel to device: ''' //
X     .                          device(1:len) // '''', idx)
X
X                            jobs(idx).dev_cnt = jobs(idx).dev_cnt + 1
X                        endif
X
X                    else if ((stat .eq. SS$_DEVALLOC) .or.
X     .                       (stat .eq. SS$_DEVOFFLINE) .or.
X     .                       (stat .eq. SS$_DEVALRALLOC) .or.
X     .                       (stat .eq. SS$_NODEVAVL)) then
X
X*                       The device exists, but is not available,
X*                       increment the counter, and try the rest
X
X                        jobs(idx).dev_cnt = jobs(idx).dev_cnt + 1
X                    else`032
X                        call log_sys (%val (stat),
X     .                      'Can''t allocate device: ''' // device(1:len)
X     .                      // '''', idx)
X                        found = .true.
X                        select_dev = GD$_ERRALLOC
X                    endif
X                endif
X            end do
X            goto 700
X
X*           Come to here at end of file
X
X 300        continue
X
X*           If reached end once, then rewind list, and try again
X
X            if (jobs(idx).state .eq. ST$_RETRYDEVS) then
X                rewind (unit = jobs(idx).devs_unit, iostat = iostat)
X                jobs(idx).dev_cnt = 0
X                select_dev = GD$_NOALLOC
X                return
X            endif
X
X            select_dev = GD$_NODEVS
X            if (jobs(idx).dev_cnt .ne. 0) then
X                select_dev = GD$_NOALLOC
X            endif
X            goto 700
X
X*           Come to here on a file I/O error
X
X  500       continue
X
X            select_dev = GD$_FILEERR
X            call signal (sys$fao ('File read error: !UL on !AS',
X     .              %ref (flen), %descr(line),`032
X     .              %val(iostat),
X     .              %descr (DEVSLIST)))
X            call log_sys (%val (SS$_ABORT), line(1:flen), idx)
X
X  700       continue
X        end
$ CALL UNPACK [.SRC]SELECTDEV.FOR;82 376155463
$ create/nolog 'f'
X        integer function send_abort (buf)
X            implicit none
X            include 'alldefs.inc'
X            include '($jbcmsgdef)'
X
X            integer idx, stat, buffer, descr (1:2)
X            character buf (1:BUFSIZ)
X            integer*2 blen
X
X            buffer = %loc (buf)
X            descr(1) = BUFSIZ-6
X            descr(2) = buffer + 2
X
X            call signal (sys$getmsg (
X     .          %val (JBC$_JOBABORT),
X     .          %ref(blen),
X     .          %ref(descr),,))
X
X            buf (1) = chr (13)
X            buf (2) = chr (12)
X
X            buf (blen+3) = chr(13)
X            buf (blen+4) = chr(12)
X            buf (blen+5) = chr(12)
X            send_abort = blen + 5
X        end
$ CALL UNPACK [.SRC]SENDABORT.FOR;12 1159809681
$ create/nolog 'f'
X****************************************************************************
V**
X*
X*       Function:   JOB_SETUP
X*       Usage:      Called from PSM$ during PSM$K_JOB_SETUP phase
X*       Purpose:    This routine is a dummy fill in that will not put a
X*                   formfeed at the beginning of each job.
X*       Output:     None.
X*
X****************************************************************************
V**
X
X        integer function job_setup (req_id, work_area,
X     .                              func, funcdesc, funcarg)
X            implicit none
X            include 'alldefs.inc'
X            include 'funcdef.inc'
X
X            integer req_id, func, funcdesc, funcarg, first_file, last_file
X            integer work_area
X            integer retval, avail, idx, i
X            external process, first_file, last_file
X            external handler
X
X            call lib$establish (handler)
X
X            if (func .eq. PSM$K_READ) then
X                retval = PSM$_EOF
X            else if (func .eq. PSM$K_OPEN) then
X                retval = SS$_NORMAL
X            else if (func .eq. PSM$K_CLOSE) then
X                retval = SS$_NORMAL
X            else
X                retval = PSM$_FUNNOTSUP
X            endif
X            job_setup = retval
X        end
$ CALL UNPACK [.SRC]SETUP.FOR;42 924670745
$ create/nolog 'f'
X****************************************************************************
V**
X*
X*       Function:   SIGNAL
X*       Usage:      call signal (vms_status)
X*       Purpose:    This routine is used everywhere that a non-normal VMS
X*                   status code is an error.  It checks to see if the passed
X*                   status is normal.  If so, then nothing is done.  Otherwi
Vse
X*                   the condition is signaled.
X*       Output:     An exception is signaled for a non normal status.
X*
X****************************************************************************
V**
X
X        subroutine signal (stat)
X            implicit none
X
X            integer stat
X            external lib$signal
X
X            if ((stat .and. 1) .ne. 1) then
X                call lib$signal (%val (stat))
X            endif
X        end
$ CALL UNPACK [.SRC]SIGNAL.FOR;2 236790562
$ create/nolog 'f'
X****************************************************************************
V**
X*
X*       Function:   SKIP_SPACE
X*       Usage:      call skip_space (line, line_idx)
X*       Purpose:    This routine examines the characters at 'line_idx', in
X*                   'line', and increments 'line_idx' until it indexes a non
X*                   blank character
X*       Output:     I is changed, if necessary, to move it passed all blank
X*                   characters.
X*
X****************************************************************************
V**
X
X        subroutine skip_space (line, i)
X            implicit none
X            include 'params.inc'
X
X            character*(*) line
X            integer i
X
X            do while ((i .le. BUFSIZ) .and. (line(i:i) .le. ' '))
X                i = i + 1
X            end do
X        end
$ CALL UNPACK [.SRC]SKIPSPACE.FOR;3 2053702603
$ create/nolog 'f'
X        .title  sleep
X        $ssdef
X        .psect  data,rd,wrt,noexe
Xef:
X        .word   0
Xtimebuf:
X        .quad   0
Xsecond=-10000000
X
X        .psect  code,exe,rd,nowrt,pic
X        .entry  sleep,`094m<>
X
X        emul    @4(ap),#second,-
X                #0,timebuf                  ;Use the Whoopy instruction
X
X        pushaw  ef                          ;Get an unused eventflag
X        calls   #1,g`094lib$get_ef
X
X        blbc    r0,20$                      ;Branch if failed
X
X        $setimr_s -
X                efn=ef,-
X                daytim=timebuf              ;Set a timer
X
X        blbc    r0,10$                      ;Branch if failed
X;
X        $waitfr_s -
X                efn=ef                      ;Wait for the event flag to be s
Vet
X        blbc    r0,10$
X
X        pushaw  ef                          ;Return the event flag
X        calls   #1,g`094lib$free_ef
X        blbs    r0,20$
X10$:
X        pushl   r0
X        calls   #1,g`094lib$signal
X20$:
X        ret
X        .end
$ CALL UNPACK [.SRC]SLEEP.MAR;7 1912605518
$ create/nolog 'f'
X****************************************************************************
V**
X*
X*       Function:   SMB$MAIN
X*       Usage:      Main routine for symbiont
X*       Purpose:    This routine sets up the PSM$ interface, and then starts
X*                   the symbiont with PSM$PRINT.
X*       Output:     Running symbiont.
X*
X****************************************************************************
V**
X
X        implicit none
X
X        include 'alldefs.inc'
X
X        external job_setup, job_completion, job_output, init_chr, handler
X        integer job_setup, job_completion, job_output, i, work_size
X
X        call init_chr (%ref(chr))
X
X*       Start a new error log
X
X        open (unit=ERRUNIT, file=ERRFILE, STATUS='NEW', recl=30000)
X        close (unit=ERRUNIT, disp='KEEP')
X*
X*       Pre-initialize the jobs data structures
X*
X        do i=1, MAX_JOBS
X            jobs(i).used = .false.
X            jobs(i).connected = .false.
X            jobs(i).completion = .false.
X            jobs(i).completed = .false.
X            jobs(i).pending = .false.
X            jobs(i).cancel = .false.
X            jobs(i).req_id = -1
X            jobs(i).save_queue(1) = 0
X            jobs(i).save_queue(2) = 0
X            jobs(i).state = ST$_BEGIN
X            jobs(i).script_unit = -1
X            jobs(i).devs_unit = -1
X            jobs(i).trans_unit = -1
X            jobs(i).req_id = -1
X        end do
X
X        units = MAX_UNITS - BASEFILENO
X        do i=BASEFILENO,MAX_UNITS
X            free_units(i) = .true.
X        end do
X
X        do i=1,MAX_METHODS
X            methods(i).used = .false.
X        end do
X
X*       Replace the routines we will be handling.
X
X        call signal (psm$replace (PSM$K_OUTPUT, job_output))
X        call signal (psm$replace (PSM$K_JOB_SETUP, job_setup))
X        call signal (psm$replace (PSM$K_JOB_COMPLETION, job_completion))
X
X*       Now start the symbiont.
X
X        call sys$exit (%val (psm$print (MAX_QUEUES, BUFSIZ, )))
X
X        end
$ CALL UNPACK [.SRC]SMB.FOR;52 553674899
$ create/nolog 'f'
X****************************************************************************
V**
X*
X*   SMB$ definitions taken from starlet.mlb
X*
+-+-+-+-+-+-+-+-  END  OF PART 17 +-+-+-+-+-+-+-+-

