/***********************************************************************
** (C) Copyright 1979 TRIPOS Research Group **
** University of Cambridge Computer Laboratory **
** **
** Modified for 8086 segmented version, **
** (C) Copyright 1981 Network Development Group **
** SRC Rutherford Laboratory **
************************************************************************
###### ######## #### ######## ## ## ######
######## ######## ###### ######## ## ## ########
## ## ## ## ## ## ## ##
####### ## ######## ## ## ## #######
## ## ## ## ## ## ## ##
## ## ## ## ## ## ## ##
######## ## ## ## ## ######## ########
###### ## ## ## ## ###### ######
************************************************************************
** Author: Brian Knight March 1978 **
** Modified: Graham Adams August 1981 **
***********************************************************************/
SECTION "STATUS"
GET "LIBHDR"
GET "CLIHDR"
//*<big
GLOBAL $( rstr:ug $)
/*big>*/
MANIFEST $( secword = 12345 $)
LET start() BE
$(
LET tasktab = rootnode ! rtn.tasktab
LET cliseg = (tcb ! tcb.seglist)!4
LET argv = VEC 40
LET tcbinfo, seginfo = ?, ?
LET CLIINFO = ?
LET lower, upper = 1, tasktab!0
//*<big
LET vrstr = VEC 9
rstr := vrstr
/*big>*/
IF rdargs("TASK,FULL/S,TCB/S,SEGS/S,CLI=ALL/S", argv, 40) = 0
THEN $( writes("Args no good*N"); RETURN $)
tcbinfo := (argv!1 \= 0) | (argv!2 \= 0)
seginfo := (argv!1 \= 0) | (argv!3 \= 0)
CLIINFO := SEGINFO LOGOR (ARGV!4 \= 0)
IF argv!0 \= 0
THEN
$( || Only give status of specified task
LET n = stringval(argv!0)
IF (n < lower) | (n > upper) | (tasktab!n = 0)
THEN $( writef("Task %N does not exist*N", n); RETURN $)
lower, upper := n, n
$)
FOR j = lower TO upper
DO
$(
LET taskcb = tasktab!j
LET state = taskcb ! tcb.state
LET flags = taskcb ! tcb.flags
LET dead = (state & state.dead) = state.dead
IF testflags(1) BREAK
UNLESS taskcb = 0
THEN
$(
writef("Task %N:", taskcb ! tcb.taskid)
IF tcbinfo
THEN
$(
writef(" pri %N,", taskcb ! tcb.pri)
UNLESS dead
THEN writef(" stk %N, gv %N,",
taskcb ! tcb.stsiz,
(taskcb ! tcb.gbase) ! 0)
$)
TEST dead
THEN writes(" dead")
ELSE
$(
IF (state & NOT state.pkt) = 0
THEN TEST j=taskid
THEN writes(" running") // Current task
ELSE writes(" suspended (in qpkt)")
IF (state & state.wait) \= 0 writes(" waiting")
IF (state & state.int) \= 0 writes(" interrupted")
$)
IF (state & state.hold) \= 0 writes(" held")
IF (flags & flag.break) \= 0 writes(" broken")
IF (state & state.pkt) \= 0 writes(" with packet(s)")
UNLESS CLIINFO & NOT SEGINFO
THEN NEWLINE()
IF SEGINFO \/ CLIINFO
$( LET segl = taskcb ! tcb.seglist
FOR j=1 TO segl!0
DO $( LET seg = segl!j
UNTIL seg=0
DO $(
IF testflags(1) THEN stop(10)
if SEGINFO
THEN WRITEF(" %s",sectname(seg))
TEST seg = cliseg
THEN // This is a CLI task
$( LET s = (taskcb ! tcb.gbase) !
cli.module.gn
TEST s = 0
THEN writes(" No command loaded")
ELSE
$( writes(" Loaded as command:")
UNLESS s=0
THEN
$( writef(" %S",sectname(s))
s := !s
IF s=0 THEN BREAK
newline()
$) REPEAT
$)
$)
ELSE IF SEGINFO THEN NEWLINE()
seg := !seg
$)
$)
newline()
$)
$)
$)
$)
AND stringval(s) = VALOF
$( || converts a string to a number
LET val = 0
FOR j = 1 TO s%0
DO
$(
UNLESS '0' <= s%j <= '9'
THEN $( writef("Invalid char *'%C*' in number*N", s%j)
stop(20)
$)
val := val*10 + s%j - '0'
$)
RESULTIS val
$)
/*<small
AND sectname(s) =
(s!2 = secword) & ((s+3)%0 = 17) -> s+3,
"??????? ??-???-??"
/*small>*/
//*<big
AND sectname(s) = VALOF
$( LET unds = "??????? ??-???-??"
LET s1 = s!1
s := s!2
RESULTIS (s=0 & s1=0)-> unds,
(fetchcode(s1+2,s)=secword)&(getcodebyte(s1+4,s,0)=17)->
copystr(s1+4,s),
unds
$)
AND copystr(off,seg) = VALOF
$( FOR i = 0 TO getcodebyte(off,seg, 0) DO rstr%i := getcodebyte(off,seg,i)
RESULTIS rstr
$)
/*big>*/