From:	CSBVAX::CSBVAX::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 20-JAN-1989 02:57
To:	MRGATE::"ARISIA::EVERHART"
Subj:	long term scheduler - part 2 of 5


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Thu, 19 JAN 89 20:25:46 PDT
Received: from RELAY.CS.NET by KL.SRI.COM with TCP; Thu, 19 Jan 89 20:21:33 PST
Received: from relay2.cs.net by RELAY.CS.NET id bt21839; 19 Jan 89 20:41 EST
Received: from a.cs.okstate.edu by RELAY.CS.NET id ab18099; 19 Jan 89 19:18 EST
Received: from nemo.math.okstate.edu by a.cs.okstate.edu id ab10439;
          19 Jan 89 9:44 CST
Date: Thu, 19 Jan 89 09:38 CDT
From: Gregg Wonderly <GREGG%nemo.math.okstate.edu@RELAY.CS.NET>
Subject: long term scheduler - part 2 of 5
To: info-vax@KL.SRI.COM
X-VMS-To: in%"info-vax@kl.sri.com"

$Part2:
$ File_is="SCHCMD.FOR"
$ Check_Sum_is=491804135
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
V******************************************************************************
X*
X*
X*                       S C H C M D . F O R
X*
X*   Author:     Gregg Wonderly
X*   Place:      Oklahoma State University
X*   Date:       March 1987
X*
X*       This program is used to interact with the scheduler.  It communicates
X*   with the scheduler via the SCHED$GDATA shared memory area, and the
X*   SCHED$MBX mailbox created by the scheduler.  
X*
V******************************************************************************
X*
X
X        implicit none
X
X        parameter SNP$CHANGE_PRIORITY=1
X        parameter SNP$CHANGE_UP_PRIORITY=2
X        parameter SNP$CHANGE_DOWN_PRIORITY=3
X        parameter SNP$QUEUE_WATCH=4
X        parameter SNP$QUEUE_RELEASE=5
X        parameter SNP$SET_STRATEGY=6
X
X        include 'gdata.inc'
X        include '($jpidef)'
X        include '($prvdef)'
X        include '($ssdef)'
X        include '($armdef)'
X        include '($acldef)'
X        include '($psldef)'
X        include '($chpdef)'
X
X        structure /item_lst/
X            integer*2 length
X            integer*2 code
X            integer*4 bufaddr
X            integer*4 retlen
X        end structure
X
X        character outbuf(1:50), outputbuf(1:200), f_buf(1:6), lenstr(1:4)
X        character inbuf(1:12)
X
X        logical some, done, update, refresh, oper, nobias
X
X        record /item_lst/ ilist(1:6)
X        character*64 username, terminal
X        integer*4 iprivs(1:2), aprivs(1:2), cprivs(1:2), ulen, access, flags
X        integer*4 dprivs(1:2)
X        integer*4 mode, privsused
X
X        integer len, message, length, val, f_len, cli$present, cli$get_value
X        integer stat, i, rows, cols, vid1, vid2, pbid, smg_start, put_queue
X        integer xtoi
X        external xtoi
X        integer init_display, reset_display, put_data, end_display, atoi
V        integer end_smg, currow, vid3, vid4, begin_data, cnt, smg$repaint_scre
Xen
X        integer bias, pid, aoct_toi, oqueuecnt
X        integer sys$getjpiw, sys$check_access, sys$setprv
X        integer smg$paste_virtual_display
X
X        integer*2 io_blk(1:5)
X
X        real atof, averages(1:6)
X
X        external smg$paste_virtual_display
X        external sys$getjpiw, sys$check_access
X        external cli$present, cli$get_value, lib$stop, sys$exit, atoi
X        external CLI$_PRESENT, SCHED__NOOPTION, create_process
X        external SCHED__NOTRUNNING, CLI$_COMMA, SCHED__BADAVERAGES, atof
X        external smg_start, init_display, reset_display, put_data
X        external end_display, end_smg, sys$cancel, put_queue, begin_data
X        external SCHED__NOTACTIVE, SCHED__ACTIVE, smg$repaint_screen
X        external SCHED__NOID, aoct_toi, sys$setprv, SCHED__NOBIAS
X
X*   The asyncronous $QIO used to read the terminal to know when to stop the
X*   display sets this value to true when the read completes
X
X        common /ldata/ done, refresh
X
X*   Set up the communications buffer so that it is slightly easier to store
X*   the values for writting to the mailbox.
X
X        equivalence (len, lenstr), (message, outputbuf)
X        equivalence (outputbuf(5), averages)
X        equivalence (inbuf, averages)
X
X        ilist(1).length = 8
X        ilist(1).code = JPI$_CURPRIV
X        ilist(1).bufaddr = %loc (cprivs)
X        ilist(1).retlen = 0
X
X        ilist(2).length = 8
X        ilist(2).code = JPI$_AUTHPRIV
X        ilist(2).bufaddr = %loc (aprivs)
X        ilist(2).retlen = 0
X
X        ilist(3).length = 8
X        ilist(3).code = JPI$_IMAGPRIV
X        ilist(3).bufaddr = %loc (iprivs)
X        ilist(3).retlen = 0
X
X        ilist(4).length = 64
X        ilist(4).code = JPI$_USERNAME
X        ilist(4).bufaddr = %loc(username)
X        ilist(4).retlen = %loc(ulen)
X
X        ilist(5).length = 0
X        ilist(5).code = 0
X
X        stat = sys$getjpiw (,,,ilist,,,)
X        if (.not. stat) call sys$exit (%val(stat))
X        username = username (1:ulen)
X
X        oper = ((cprivs(1) .and. PRV$M_OPER).NE.0)
X        oper = (oper .OR. ((iprivs(1) .and. PRV$M_OPER).NE.0))
X
X*       Disable bypass priv so that we will be affected by SCHED.
X
X`009`009dprivs(1) = PRV$M_BYPASS
X        dprivs(2) = 0
X`009`009stat = sys$setprv (, dprivs, , )
X`009`009if (.not. stat) call sys$exit(%val (stat))
X
X        len = 0
X
X*       Say no options chosen yet.
X
X        some = .false.
X
X*       Check for /STOP qualifier
X
X        stat = cli$present ('STOP')
X        if (stat .eq. %loc(CLI$_PRESENT)) then
X
X            if (.not.oper) call sys$exit (%val (SS$_NOPRIV))
X
X            if (.not.sch_running) then
X                call lib$signal (%val (%loc (SCHED__NOTACTIVE)))
X            endif
X
X            some = .true.
X            stopnow = .true.
X        endif
X
X*       Check for /SUBMIT qualifier
X
X        stat = cli$present ('SUBMIT')
X        if (stat .eq. %loc(CLI$_PRESENT)) then
X*
X            if (.not.oper) call sys$exit (%val (SS$_NOPRIV))
X
X*           Need to wait for /STOP to finish.
X
X            if (some) then
X                call sleep (3)
X            endif
X
X            some = .true.
X
X*           Check to make sure that the scheduler is really running by
X*           doing $GETJPI's on the process.  If the $GETJPI's fail, then
X*           the scheduler is not running.
X
X            if (sch_running) then
X
X*               Try the PID first.
X
X                stat = sys$getjpiw (,my_pid,'Scheduler',ilist,,,)
X
X*               Try just the process name if that fails.
X
X                if (.not. stat) stat = sys$getjpiw (,,'Scheduler',ilist,,,)
X
X                sch_running = ((stat.and.1).eq.1)
X
X*               Signal a WARNING if it is running.
X
X                if (sch_running) call lib$signal (%val (%loc (SCHED__ACTIVE)))
X            endif
X
X*           Always try to create the process.
X
X            call create_process (0)
X            i = 0
X
X*           Wait for the process to start before continuing.
X
X            do while ((.not.sch_running).and. i .lt. 10)
X                call sleep (1+i)
X                i = i + 1
X            end do
X        endif
X
X*       Quit if still no process
X
X        if ((.not.sch_running).and.(.not.some)) then
X            call sys$exit (%val (%loc (SCHED__NOTRUNNING)))
X        endif
X
X*       Check for /SYSGRP qualifier.
X
X        stat = cli$present ('SYSGRP')
X        if (stat .eq. %loc(CLI$_PRESENT)) then
X            if (.not.oper) call sys$exit (%val (SS$_NOPRIV))
X
X            some = .true.
X
X*           Get the time as a string
X
X            stat = cli$get_value ('SYSGRP', %descr(outbuf), len)
X            if (stat .ne. SS$_NORMAL) then
X                call sys$exit (%val(stat))
X            endif
X
X*           Convert the string to a decimal number
X
X            sysgrp = aoct_toi (outbuf, len)
X        endif
X
X*       Check for /MAX_ACTIVE qualifier.
X
X        stat = cli$present ('MAX_ACTIVE')
X        if (stat .eq. %loc(CLI$_PRESENT)) then
X            if (.not.oper) call sys$exit (%val (SS$_NOPRIV))
X
X            some = .true.
X
X*           Get the time as a string
X
X            stat = cli$get_value ('MAX_ACTIVE', %descr(outbuf), len)
X            if (stat .ne. SS$_NORMAL) then
X                call sys$exit (%val(stat))
X            endif
X
X*           Convert the string to a decimal number
X
X            max_active = aoct_toi (outbuf, len)
X        endif
X
X*       Check for /INTERVAL qualifier to change time interval.
X
X        stat = cli$present ('INTERVAL')
X        if (stat .eq. %loc(CLI$_PRESENT)) then
X            if (.not.oper) call sys$exit (%val (SS$_NOPRIV))
X
X            some = .true.
X
X*           Get the time as a string
X
X            stat = cli$get_value ('INTERVAL', %descr(outbuf), len)
X            if (stat .ne. SS$_NORMAL) then
X                call sys$exit (%val(stat))
X            endif
X
X*           Convert the string to a decimal number
X
X            interval = atoi (outbuf, len)
X        endif
X
X*       Check for /IDLE_COUNT qualifier to change time interval.
X
X        stat = cli$present ('IDLE_COUNT')
X        if (stat .eq. %loc(CLI$_PRESENT)) then
X            if (.not.oper) call sys$exit (%val (SS$_NOPRIV))
X
X            some = .true.
X
X*           Get the time as a string
X
X            stat = cli$get_value ('IDLE_COUNT', %descr(outbuf), len)
X            if (stat .ne. SS$_NORMAL) then
X                call sys$exit (%val(stat))
X            endif
X
X*           Convert the string to a decimal number
X
X            idle_cnt = atoi (outbuf, len)
X        endif
X
X*       Check for /HOG_COUNT qualifier to change time interval.
X
X        stat = cli$present ('HOG_COUNT')
X        if (stat .eq. %loc(CLI$_PRESENT)) then
X            if (.not.oper) call sys$exit (%val (SS$_NOPRIV))
X
X            some = .true.
X
X*           Get the time as a string
X
X            stat = cli$get_value ('HOG_COUNT', %descr(outbuf), len)
X            if (stat .ne. SS$_NORMAL) then
X                call sys$exit (%val(stat))
X            endif
X
X*           Convert the string to a decimal number
X
X            hog_count = atoi (outbuf, len)
X        endif
X
X*       Check for /HOG_PRIORITY qualifier to change time interval.
X
X        stat = cli$present ('HOG_PRIORITY')
X        if (stat .eq. %loc(CLI$_PRESENT)) then
X            if (.not.oper) call sys$exit (%val (SS$_NOPRIV))
X
X            some = .true.
X
X*           Get the time as a string
X
X            stat = cli$get_value ('HOG_PRIORITY', %descr(outbuf), len)
X            if (stat .ne. SS$_NORMAL) then
X                call sys$exit (%val(stat))
X            endif
X
X*           Convert the string to a decimal number
X
X            hog_prio = atoi (outbuf, len)
X        endif
X
X*       Check for /STRATEGY and /IDENTIFICATION qualifier.
X
X        stat = cli$present ('STRATEGY')
X        if (stat .eq. %loc(CLI$_PRESENT)) then
X            if (.not.oper) call sys$exit (%val (SS$_NOPRIV))
X
X            some = .true.
X
X            stat = cli$present ('IDENTIFICATION')
X            if (stat .eq. %loc(CLI$_PRESENT)) then
X                stat = cli$get_value ('IDENTIFICATION', %descr(outbuf), len)
X            else
X                call sys$exit (%val (%loc (SCHED__NOID)))
X            endif
X
X            pid = xtoi (outbuf, len)
X
X            nobias = .false.
X            stat = cli$present ('BIAS')
X            if (stat .eq. %loc(CLI$_PRESENT)) then
X                stat = cli$get_value ('BIAS', %descr(outbuf), len)
X                bias = atoi (outbuf, len)
X            else
X                nobias = .true.
X                bias = 0
X            endif
X
X            stat = cli$get_value ('STRATEGY', %descr(outbuf), len)
X            if (stat .ne. SS$_NORMAL) then
X                call sys$exit (%val(stat))
X            endif
X
X            if (outbuf (1) .eq. 'I') then
X
X*               IGNORE the process strategy
X
X                len = SCH$IGNORE
X
X*               bias must be none zero 
X
X                bias = 1
X            else if (outbuf (1) .eq. 'N') then
X
V*               NONE strategy, process will be restored to UP_PRIO and monitor
Xed
X
X                if (outbuf(2) .eq. 'E') then
X                    len = SCH$NEWIMAGE
X                    if (nobias) then
X                        call sys$exit (%val (%loc (SCHED__NOBIAS)))
X                    endif
X                else
X                    len = SCH$RESTART
X                endif
X            else if (outbuf (1) .eq. 'S') then
X
V*               SMASH the process to a specific priority and ignore it strateg
Xy
X
X                len = SCH$SMASH
X                if (nobias) then
X                    call sys$exit (%val (%loc (SCHED__NOBIAS)))
X                endif
X            endif
X
X            do i=1, 4
X                outputbuf(i+8) = lenstr(i)
X            end do
X
X            len = pid
X            do i=1, 4
X                outputbuf(i+4) = lenstr(i)
X            end do
X
X            len = bias
X            do i=1, 4
X                outputbuf(i+12) = lenstr(i)
X            end do
X
X            message = SNP$SET_STRATEGY
X            call output (outputbuf, 16)
X        endif
X
X*       Check for /MAX_PERCENT qualifier to change max percentage of CPU.
X
X        stat = cli$present ('MAX_PERCENT')
X        if (stat .eq. %loc(CLI$_PRESENT)) then
X            if (.not.oper) call sys$exit (%val (SS$_NOPRIV))
X
X            some = .true.
X
X*           Get the time as a string
X
X            stat = cli$get_value ('MAX_PERCENT', %descr(outbuf), len)
X            if (stat .ne. SS$_NORMAL) then
X                call sys$exit (%val(stat))
X            endif
X
X*           Convert the string to a decimal number
X
X            max_percent = atoi (outbuf, len)
X        endif
X
X*       Check for /MIN_PERCENT qualifier to change minimum percent of CPU
X
X        stat = cli$present ('MIN_PERCENT')
X        if (stat .eq. %loc(CLI$_PRESENT)) then
X            if (.not.oper) call sys$exit (%val (SS$_NOPRIV))
X
X            some = .true.
X
X*           Get the time as a string
X
X            stat = cli$get_value ('MIN_PERCENT', %descr(outbuf), len)
X            if (stat .ne. SS$_NORMAL) then
X                call sys$exit (%val(stat))
X            endif
X
X*           Convert the string to a decimal number
X
X            min_percent = atoi (outbuf, len)
X        endif
X
X*       Check for /MIN_TIME qualifier to change minimum percent of CPU
X
X        stat = cli$present ('MIN_TIME')
X        if (stat .eq. %loc(CLI$_PRESENT)) then
X            if (.not.oper) call sys$exit (%val (SS$_NOPRIV))
X
X            some = .true.
X
X*           Get the time as a string
X
X            stat = cli$get_value ('MIN_TIME', %descr(outbuf), len)
X            if (stat .ne. SS$_NORMAL) then
X                call sys$exit (%val(stat))
X            endif
X
X*           Convert the string to a decimal number
X
X            min_time = ifix (atof (outbuf, len) * 100.0)
X        endif
X
X*       Check for /DOWN_COUNT qualifier to change minimum percent of CPU
X
X        stat = cli$present ('DOWN_COUNT')
X        if (stat .eq. %loc(CLI$_PRESENT)) then
X            if (.not.oper) call sys$exit (%val (SS$_NOPRIV))
X
X            some = .true.
X
X*           Get the time as a string
X
X            stat = cli$get_value ('DOWN_COUNT', %descr(outbuf), len)
X            if (stat .ne. SS$_NORMAL) then
X                call sys$exit (%val(stat))
X            endif
X
X*           Convert the string to a decimal number
X
X            down_count = atoi (outbuf, len)
X        endif
X
X*       Check for /PRIORITY qualifier to change processes priority
X
X        stat = cli$present ('PRIORITY')
X        if (stat .eq. %loc(CLI$_PRESENT)) then
X            if (.not.oper) call sys$exit (%val (SS$_NOPRIV))
X
X            some = .true.
X            message = SNP$CHANGE_PRIORITY
X
X*           Get the time as a string
X
X            stat = cli$get_value ('PRIORITY', %descr(outbuf), len)
X            if (stat .ne. SS$_NORMAL) then
X                call sys$exit (%val(stat))
X            endif
X
X*           Convert the string to a decimal number
X
X            len = atoi (outbuf, len)
X
X*           Since we don't have the process id of the scheduler, we will
X*           send it the command, and let it do the changes.
X*           Put the number into the buffer as an integer*4
X
X            do i=1, 4
X                outputbuf(i+4) = lenstr(i)
X            end do
X
X*           Send the command to the scheduler
X
X            call output (outputbuf, 8)
X        endif
X
X*       Check for /UP_PRIORITY qualifier to change upgraded priority
X
X        stat = cli$present ('UP_PRIORITY')
X        if (stat .eq. %loc(CLI$_PRESENT)) then
X            if (.not.oper) call sys$exit (%val (SS$_NOPRIV))
X
X            some = .true.
X            message = SNP$CHANGE_UP_PRIORITY
X
X*           Get the time as a string
X
X            stat = cli$get_value ('UP_PRIORITY', %descr(outbuf), len)
X            if (stat .ne. SS$_NORMAL) then
X                call sys$exit (%val(stat))
X            endif
X
X*           Convert the string to a decimal number
X
X            len = atoi (outbuf, len)
X
X*           Put the number into the buffer as an integer*4
X
X            do i=1, 4
X                outputbuf(i+4) = lenstr(i)
X            end do
X
X*           Send the command to the scheduler
X
X            call output (outputbuf, 8)
X        endif
X
X*       Check for /DOWN_PRIORITY qualifier to change downgraded priority
X
X        stat = cli$present ('DOWN_PRIORITY')
X        if (stat .eq. %loc(CLI$_PRESENT)) then
X            if (.not.oper) call sys$exit (%val (SS$_NOPRIV))
X
X            some = .true.
X            message = SNP$CHANGE_DOWN_PRIORITY
X
X*           Get the time as a string
X
X            stat = cli$get_value ('DOWN_PRIORITY', %descr(outbuf), len)
X            if (stat .ne. SS$_NORMAL) then
X                call sys$exit (%val(stat))
X            endif
X
X*           Convert the string to a decimal number
X
X            len = atoi (outbuf, len)
X
X*           Put the number into the buffer as an integer*4
X
X            do i=1, 4
X                outputbuf(i+4) = lenstr(i)
X            end do
X
X*           Send the command to the scheduler
X
X            call output (outputbuf, 8)
X        endif
X
X*       Check for /IO_DIFFERENCE to change io bound priority difference
X
X        stat = cli$present ('IO_DIFFERENCE')
X        if (stat .eq. %loc(CLI$_PRESENT)) then
X            if (.not.oper) call sys$exit (%val (SS$_NOPRIV))
X
X            some = .true.
X
X*           Get the time as a string
X
X            stat = cli$get_value ('IO_DIFFERENCE', %descr(outbuf), len)
X            if (stat .ne. SS$_NORMAL) then
X                call sys$exit (%val(stat))
X            endif
X
X*           Convert the string to a decimal number
X
X            io_diff = atoi (outbuf, len)
X        endif
X
X*       Check for /QUEUE qualifier to specify queue to be monitored
X
X        stat = cli$present ('QUEUE')
X        if (stat .eq. %loc(CLI$_PRESENT)) then
X            if (.not.oper) call sys$exit (%val (SS$_NOPRIV))
X
X            some = .true.
X
X*           Get the queue name as a string
X
X            stat = cli$get_value ('QUEUE', %descr(outbuf), len)
X            if (stat .ne. SS$_NORMAL) then
X                call sys$exit (%val(stat))
X            endif
X
X            stat = cli$present ('RELEASE')
X            if (stat .eq. %loc(CLI$_PRESENT)) then
X                message = SNP$QUEUE_RELEASE
X                outputbuf(5) = lenstr(1)
X                do i=1, len
X                    outputbuf (i+5) = outbuf(i)
X                end do
X                len = len + 5
X            else
X                message = SNP$QUEUE_WATCH
X                stat = cli$get_value ('AVERAGES', %descr(f_buf), f_len)
X                if (stat .ne. %loc (CLI$_COMMA)) then
X                    call lib$signal(%val(stat))
X                    call sys$exit(%val(%loc(SCHED__BADAVERAGES)))
X                endif
X
X                averages(1) = atof(f_buf, f_len)
X
X                stat = cli$get_value ('AVERAGES', %descr(f_buf), f_len)
X                if (stat .ne. %loc (CLI$_COMMA)) then
X                    call lib$signal(%val(stat))
X                    call sys$exit(%val(%loc(SCHED__BADAVERAGES)))
X                endif
X
X                averages(2) = atof(f_buf, f_len)
X
X                stat = cli$get_value ('AVERAGES', %descr(f_buf), f_len)
X                if (stat .ne. %loc (CLI$_COMMA)) then
X                    call lib$signal(%val(stat))
X                    call sys$exit(%val(%loc(SCHED__BADAVERAGES)))
X                endif
X
X                averages(3) = atof(f_buf, f_len)
X
X                stat = cli$get_value ('AVERAGES', %descr(f_buf), f_len)
X                if (stat .ne. %loc (CLI$_COMMA)) then
X                    call lib$signal(%val(stat))
X                    call sys$exit(%val(%loc(SCHED__BADAVERAGES)))
X                endif
X
X                averages(4) = atof(f_buf, f_len)
X
X                stat = cli$get_value ('AVERAGES', %descr(f_buf), f_len)
X                if (stat .ne. %loc (CLI$_COMMA)) then
X                    call lib$signal(%val(stat))
X                    call sys$exit(%val(%loc(SCHED__BADAVERAGES)))
X                endif
X
X                averages(5) = atof(f_buf, f_len)
X
X                stat = cli$get_value ('AVERAGES', %descr(f_buf), f_len)
X                if (stat .ne. SS$_NORMAL) then
X                    call lib$signal(%val(stat))
X                    call sys$exit(%val(%loc(SCHED__BADAVERAGES)))
X                endif
X
X                averages(6) = atof(f_buf, f_len)
X
X                outputbuf(29) = (lenstr(1))
X                do i=1, len
X                    outputbuf (i+29) = outbuf(i)
X                end do
X                len = len + 4 + 12 + 12 + 1
X            endif
X
X*           Send the command to the scheduler
X
X            call output (outputbuf, len)
X        endif
X
X*       If no options were specified than do output to current terminal
X
X        if ((.not. some) .or.
V     .                  (cli$present ('DISPLAY') .eq. %loc(CLI$_PRESENT))) the
Xn
X            outbuf(1) = ' '
X            len = 0
X
X            stat = cli$get_value ('DISPLAY', %descr(terminal), len)
X
X            if (len .eq. 0) then
X                terminal = 'TT:'
X                len = 3
X            else if (terminal(len:len) .ne. ':') then
X                len = len + 1
X                terminal(len:len) = ':'
X            endif
X
X            ilist(1).length = 4
X            ilist(1).code = CHP$_ACCESS
X            ilist(1).bufaddr = %loc (access)
X            ilist(1).retlen = 0
X            access = ARM$M_EXECUTE + ARM$M_DELETE
X
X            ilist(2).code = 0
X            ilist(2).length = 0
X
X            stat = sys$check_access (ACL$C_DEVICE, terminal(1:len),
X     .                                              username(1:ulen), ilist)
X
X            if (.not. stat)
X     .              call sys$exit (%val(stat))
X
X            stat = smg_start (terminal(1:len), rows, cols, pbid, vid1, vid2, 
X     .                        vid3, vid4)
X            oqueuecnt = queuecnt
X            stat = init_display (vid1, vid2, vid3, vid4, pbid)
X            done = .false.
X            call start_io (io_blk)
X            open (unit=7, file='LAV0:', STATUS='OLD', err=20)
X20          continue
X
X            refresh = .false.
X            averages(1) = 0.0
X            averages(2) = 0.0
X            averages(3) = 0.0
X            averages(4) = 0.0
X            averages(5) = 0.0
X            averages(6) = 0.0
X
X            do while ((.not. done) .and. sch_running)
X                read (7, 30, err=40) inbuf
X30              format (12(A1))
X
X40              continue
X
X                if (queuecnt .ne. oqueuecnt) then
X                    oqueuecnt = queuecnt
V                    stat = smg$paste_virtual_display (vid4, pbid, 4+queuecnt, 
X1)
X                    if ((stat .and. 1).eq.0) then
X                        call lib$signal (%val(stat))
X                    endif
X
V                    stat = smg$paste_virtual_display (vid1, pbid, 7+queuecnt, 
X1)
X                    if ((stat .and. 1).eq.0) then
X                        call lib$signal (%val(stat))
X                    endif
X                endif
X
X                stat = reset_display (pbid, vid1, vid2, vid3, vid4, averages)
X
X                do i = 0, queuecnt
X                    if (queues(i).used) then
X                        stat = put_queue (i, vid2)
X                    endif
X                end do
X
X                cnt = 0
X                do i = 0, curcnt - 1
X                    if (prev(i).used) cnt = cnt + 1
X                end do
X
X                stat = begin_data (vid1, vid2, vid3, vid4,
X     .                             pbid, rows, cols, cnt, update)
X
X                do i = 0, curcnt - 1
X                    if (prev(i).used) then
X                        stat = put_data (i, vid1, (i .lt. curcnt-2))
X                    endif
X                end do
X
X                stat = end_display (vid1, vid2, vid3, vid4, pbid, update)
X                call sleep (interval)
X                if (refresh) then
X                    refresh = .false.
X                    stat = smg$repaint_screen (pbid)
X                    if ((stat.and.1).ne.1) then
X                        call lib$signal (%val (stat))
X                    endif
X                endif
X            end do
X
X            if (.not. sch_running) then
X                call sys$cancel (%val(io_blk(1)))
X                stat = end_smg (vid1, pbid)
X                call sys$exit (%val (%loc (SCHED__NOTRUNNING)))
X            endif
X
X            stat = end_smg (vid1, pbid)
X        endif
X
X*       Exit with SS$_NORMAL
X
X        call sys$exit(%val(SS$_NORMAL))
X        end
X
V******************************************************************************
X*
X*
X*   Convert a string of decimal digits to a binary integer of the proper value
X*
V******************************************************************************
X*
X
X        integer function atoi (str, len)
X            parameter STR_LEN=50
X            character str(1:STR_LEN)
X            character w(1:4)
X            integer fake
X            integer i, res, sign
X            logical done
X            equivalence (w, fake)
X
X            res = 0
X            i=1
X            sign = 1
X            done = .false.
X
X            if (str(i) .eq. '-') then
X                sign = -1
X                i = i + 1
X            endif
X
X            do while ((i .le. len) .and. (.not. done))
X                if ((str(i) .lt. '0') .or. (str(i) .gt. '9')) then
X                    done = .true.
X                else
X                    fake = 0
X                    w(1) = str(i)
X                    fake = fake - 48
X                    res = (res * 10) + fake
X                    i = i + 1
X                endif
X            end do
X            atoi = res * sign
X        end
X
V******************************************************************************
X*
X*
X*   Convert a string of hexidecimal digits to a binary integer
X*
V******************************************************************************
X*
X
X        integer function xtoi (str, len)
X            parameter STR_LEN=50
X            character str(1:STR_LEN)
X            character w(1:4)
X            integer fake
X            integer i, res, sign
X            logical done
X            equivalence (w, fake)
X
X            res = 0
X            i=1
X            sign = 1
X            done = .false.
X
X            if (str(i) .eq. '-') then
X                sign = -1
X                i = i + 1
X            endif
X
X            do while ((i .le. len) .and. (.not. done))
X                if (((str(i) .ge. '0') .and. (str(i) .le. '9')) .or.
X     .             ((str(i) .ge. 'A') .and. (str(i) .le. 'F')) .or.
X     .             ((str(i) .ge. 'a') .and. (str(i) .le. 'f'))) then
X
X                    fake = 0
X                    w(1) = str(i)
X                    fake = fake - 48
X`009`009`009`009`009if (fake .gt. 9) fake = fake - 7
X`009`009`009`009`009if (fake .gt. 15) fake = fake - 32
X                    res = (res * 16) + fake
X                    i = i + 1
X                else
X                    done = .true.
X                endif
X            end do
X            xtoi = res * sign
X        end
X
V******************************************************************************
X*
X*
X*   Convert a string of octal digits to a binary integer of the proper value
X*
V******************************************************************************
X*
X
X        integer function aoct_toi (str, len)
X            parameter STR_LEN=50
X            character str(1:STR_LEN)
X            character w(1:4)
X            integer fake
X            integer i, res, sign
X            logical done
X            equivalence (w, fake)
X
X            res = 0
X            i=1
X            sign = 1
X            done = .false.
X
X            if (str(i) .eq. '-') then
X                sign = -1
X                i = i + 1
X            endif
X
X            do while ((i .le. len) .and. (.not. done))
X                if ((str(i) .lt. '0') .or. (str(i) .gt. '7')) then
X                    done = .true.
X                else
X                    fake = 0
X                    w(1) = str(i)
X                    fake = fake - 48
X                    res = (res * 8) + fake
X                    i = i + 1
X                endif
X            end do
X            aoct_toi = res * sign
X        end
X
V******************************************************************************
X*
X*
X*   Convert a string of decimal digits to a binary real of the proper value
X*
V******************************************************************************
X*
X
X        real function atof (str, len)
X            parameter STR_LEN=6
X            character str(1:STR_LEN), w(1:4)
X            integer fake, len, i
X            real res, val
X            logical done, after_decimal
X            equivalence (w, fake)
X
X            res = 0
X            i=1
X            done = .false.
X            after_decimal = .false.
X
X            do while ((i .le. len) .and. (.not. done))
X                if ((str(i) .lt. '0') .or. (str(i) .gt. '9')) then
X                    if (str(i) .ne. '.') then
X                        done = .true.
X                    else
X                        after_decimal = .true.
X                        val=10.0
X                    endif
X                else
X                    fake = 0
X                    w(1) = str(i)
X                    fake = fake - 48
X                    if (.not. after_decimal) then
X                        res = (res * 10.0) + float(fake)
X                    else
X                        res = res + (float(fake) / val)
X                        val = val * 10.0
X                    endif
X                endif
X                i = i + 1
X            end do
X            atof = res
X        end
X
V******************************************************************************
X*
X*
X*   Output the string, 'str', of length, 'len', to the SCHED$MBX device.
X*
V******************************************************************************
X*
X
X        subroutine output (str, len)
X            implicit none
X
X            include '($iodef)'
X
X            character str(1:100)
X            integer*2 chan
X            integer*2 iosb(1:4)
X            integer len, stat, sys$qiow, sys$assign, sys$dassgn, cnt
X            external sys$qiow, sys$assign, sys$dassgn, sleep
X
X            cnt = 10
X            stat = 0
X            do while ((cnt .ne. 0) .and. ((stat .and. 1) .ne. 1))
X                if (cnt .lt. 10) then
X                    call sleep (1)
X                endif
X                stat = sys$assign (%descr('SCHED$MBX'), %ref(chan), , )
X                cnt = cnt - 1
X            end do
X
X            if ((stat .and. 1) .ne. 1) then
X                call lib$signal (%val(stat))
X                return
X            endif
X
X            stat = sys$qiow (, %val(chan), %val(IO$_WRITEPBLK), %ref(iosb),
X     .                       , , %ref(str), %val(len), , , ,)
X
X            if ((stat .and. 1) .ne. 1) then
X                call lib$signal (%val(stat))
X            endif
X
X            stat = sys$dassgn (%val(chan))
X
X            if ((stat .and. 1) .ne. 1) then
X                call lib$signal (%val(stat))
X            endif
X        end
X
V******************************************************************************
X*
X*
X*       Create a detached process to run the scheduler in.
X*
V******************************************************************************
X*
X
X        subroutine create_process (dummy)
X            include '($prcdef)'
X            include 'gdata.inc'
X
X            integer pid, privs(1:2), stat, sys$creprc, dummy, quotas(1:2)
X            external sys$creprc, lib$signal, SCHED__CREATED
X
X            privs(1) = -1
X            privs(2) = -1
X            quotas(1) = 0
X            quotas(2) = 0
X
X            stat = sys$creprc (pid,
X     .                          'SCHED$ROOT:[EXE]SCHED.EXE',
X     .                          'NLA0:',
X     .                          'SCHED$ROOT:[000000]SCHED.LOG',
X     .                          'SCHED$ROOT:[000000]SCHED.LOG',
X     .                          privs,         ! All privs
X     .                          quotas,        ! default quotas 
X     .                          'Scheduler',
X     .                          %val(5),       ! Base priority of 5
X     .                          %val(65536+4), ! system UIC [1,4]
X     .                          ,
X     .                          %val(PRC$M_DETACH)) ! Detached process
X
X            my_pid = pid
X            if ((stat .and. 1) .ne. 1) then
X                call lib$signal (%val(stat))
X            else
X                call lib$signal (%val (%loc (SCHED__CREATED)), %val (1),
V     .                                                              %val (pid)
X)
X            endif
X        end
X
V******************************************************************************
X*
X*
X*       Queue a read to the terminal with asyncronous completion to detect
X*       when the user wishes to stop the display
X*
V******************************************************************************
X*
X
X        subroutine start_io (io_blk)
X            implicit none
X            integer*2 io_blk(1:5)
X            integer stat, sys$qio, sys$assign, mask(1:2)
X
X            external sys$qio, sys$assign, io_complete, lib$stop
X            external IO$_READLBLK
X
X            io_blk(4) = 0
X            stat = sys$assign (%descr('tt:'), io_blk(1), ,)
X            mask(1) = 0
X            mask(2) = -1
X            if ((stat .and. 1) .eq. 1) then
X                stat = sys$qio (,%val(io_blk(1)), %val(%loc(IO$_READLBLK)),
X     .                          io_blk(2), io_complete, io_blk,
X     .                          %ref(io_blk(4)), %val(1),,%ref (mask),,)
X                if ((stat.and.1).ne.1) then
X                    call lib$stop (%val(stat))
X                endif
X            endif
X        end
X
V******************************************************************************
X*
X*
X*       This routine is executed at AST level when the read to the terminal
X*       completes.  It sets "done" to .true. to end the loop.
X*
V******************************************************************************
X*
X
X        subroutine io_complete (io_blk)
X            implicit none
X            integer*2 io_blk(1:5)
X            integer stat, sys$dassgn
X            logical done, refresh
X            common /ldata/ done, refresh
X            external sys$wake, sys$dassgn, sys$exit, SS$_ABORT, SS$_CANCEL
X            external sys$canwak, smg$repaint_screen
X
X*           Cancel any previous $schdwk
X
X            call sys$canwak(,)
X
X*           Deassign the I/O channel.
X
X            stat = sys$dassgn (%val(io_blk(1)))
X
X            if ((io_blk(2).and.1).eq.0) then
X                if ((io_blk(2) .ne. %loc (SS$_ABORT)) .and.
X     .                          (io_blk(2) .ne. %loc (SS$_CANCEL))) then
X                    print *,'* I/O operation failure while reading terminal'
X                    call sys$exit (%val(io_blk(2)))
X                endif
X            endif
X
X            if (io_blk(3) .eq. 0) then
X                if (io_blk (4) .eq. 12) then
X                    refresh = .true.
X                    call start_io (io_blk)
X                else
X                    done = .true.
X                endif
X            else
X                done = .true.
X            endif
X
X*           Wake up the sleeping process.
X
X            call sys$wake (,)
X        end
$ GoSub Convert_File
$ Goto Part3

