mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-25 09:24:19 +00:00
1305 lines
44 KiB
Plaintext
1305 lines
44 KiB
Plaintext
|
|
|
|
|
|
|
|
|
|
|
|
/* Common Include Module for RSP and Transient CCPMSTAT */
|
|
|
|
|
|
$include(:f2:newcom.lit)
|
|
dcl buff (128) byte external;
|
|
|
|
|
|
mon1:
|
|
procedure (func,info) external;
|
|
dcl func byte;
|
|
dcl info address;
|
|
end mon1;
|
|
|
|
mon2:
|
|
procedure (func,info) byte external;
|
|
dcl func byte;
|
|
dcl info address;
|
|
end mon2;
|
|
|
|
mon3:
|
|
procedure (func,info) address external;
|
|
dcl func byte;
|
|
dcl info address;
|
|
end mon3;
|
|
|
|
mon4:
|
|
procedure (func,info) pointer external;
|
|
dcl func byte;
|
|
dcl info address;
|
|
end mon4;
|
|
|
|
|
|
patch: procedure; /* dummy area for patching code segments */
|
|
declare i address;
|
|
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5;
|
|
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5;
|
|
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5;
|
|
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5;
|
|
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5;
|
|
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5;
|
|
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5;
|
|
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5;
|
|
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5;
|
|
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5;
|
|
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5;
|
|
end patch;
|
|
|
|
|
|
dcl maxpd byte initial (63); /* Maximum # process descript's*/
|
|
dcl maxmd byte initial (80); /* Maximum # memory descriptors*/
|
|
dcl maxqflags byte initial (40h); /* Max Value for a queue flag */
|
|
dcl freename (*)byte initial ('* FREE *'); /* For free memory partitions */
|
|
dcl maxqueues byte initial (64); /* Maximum # of system queues */
|
|
dcl lbracket byte initial ('[');
|
|
dcl rbracket byte initial (']');
|
|
dcl repeat byte; /* Controls continuous display */
|
|
dcl intrval word; /* Controls update timing */
|
|
dcl specified byte; /* Command Line argument flag */
|
|
dcl flaglen byte initial (3);
|
|
|
|
/***************************************************************************/
|
|
/* */
|
|
/* Terminal-dependent Control Characters */
|
|
/* */
|
|
/***************************************************************************/
|
|
|
|
dcl clearseq (6) byte initial (2,01bh,'E',0,0,0); /* ESC E = clear screen*/
|
|
dcl homeseq (6) byte initial (2,01bh,'H',0,0,0); /* ESC H = home cursor */
|
|
dcl CR lit '13'; /* CR = carriage return*/
|
|
dcl LF lit '10'; /* LF = line feed */
|
|
|
|
|
|
$include (:f2:mdsat.lit)
|
|
$include (:f2:proces.lit)
|
|
$include (:f2:sd.lit)
|
|
$include (:f2:qd.lit)
|
|
$include (:f2:flag.lit)
|
|
$include (:f2:uda.lit)
|
|
$include (:f2:vccb.lit)
|
|
/*$include (:f2:ccb.lit)*/
|
|
|
|
dcl pd$pointer pointer; /* double word bases for MP/M-86 data structures */
|
|
dcl pd$ptr structure(
|
|
offset word,
|
|
segment word) at (@pd$pointer);
|
|
dcl pd based pd$pointer pd$structure;
|
|
|
|
dcl qd$pointer pointer;
|
|
dcl qd$ptr structure(
|
|
offset word,
|
|
segment word) at (@qd$pointer);
|
|
dcl qd based qd$pointer qd$structure;
|
|
|
|
dcl md$pointer pointer;
|
|
dcl md$ptr structure(
|
|
offset word,
|
|
segment word) at (@md$pointer);
|
|
dcl md based md$pointer md$structure;
|
|
|
|
dcl ms$pointer pointer;
|
|
dcl ms$ptr structure(
|
|
offset word,
|
|
segment word) at (@ms$pointer);
|
|
dcl ms based ms$pointer ms$structure;
|
|
|
|
dcl sat$pointer pointer;
|
|
dcl sat$ptr structure(
|
|
offset word,
|
|
segment word) at (@sat$pointer);
|
|
dcl sat based sat$pointer sat$structure;
|
|
|
|
dcl flag$pointer pointer;
|
|
dcl flag$ptr structure(
|
|
offset word,
|
|
segment word) at (@flag$pointer);
|
|
dcl flag based flag$pointer flag$structure;
|
|
|
|
dcl vccb$pointer pointer;
|
|
dcl vccb$ptr structure (
|
|
offset word,
|
|
segment word) at (@vccb$pointer);
|
|
dcl vccb based vccb$pointer ccb$structure;
|
|
|
|
dcl uda$pointer pointer;
|
|
dcl uda$ptr structure (
|
|
offset word,
|
|
segment word) at (@uda$pointer);
|
|
dcl uda based uda$pointer uda$structure;
|
|
|
|
|
|
/* BDOS Calls */
|
|
|
|
reboot:
|
|
procedure;
|
|
call mon1(0,0);
|
|
end reboot;
|
|
|
|
conin:
|
|
procedure byte;
|
|
return(mon2(1,0));
|
|
end conin;
|
|
|
|
co:
|
|
procedure (char);
|
|
dcl char byte;
|
|
call mon1 (2,char);
|
|
end co;
|
|
|
|
rawconin:
|
|
procedure byte;
|
|
return mon2(6,0fdh);
|
|
end rawconin;
|
|
|
|
constat:
|
|
procedure byte;
|
|
return(mon2(11,0));
|
|
end constat;
|
|
|
|
rawco:
|
|
procedure (char);
|
|
dcl char byte;
|
|
call mon1(6,char);
|
|
end rawco;
|
|
|
|
delay:
|
|
procedure (num);
|
|
dcl num address;
|
|
call mon1(141,num);
|
|
end delay;
|
|
|
|
print$buffer:
|
|
procedure (bufferadr);
|
|
dcl bufferadr address;
|
|
call mon1 (9,bufferadr);
|
|
end print$buffer;
|
|
|
|
get$version:
|
|
procedure word;
|
|
return mon3(12,0);
|
|
end get$version;
|
|
|
|
terminate:
|
|
procedure;
|
|
call mon1(143,0);
|
|
end terminate;
|
|
|
|
get$sysdat:
|
|
procedure pointer;
|
|
return mon4(154,0);
|
|
end get$sysdat;
|
|
|
|
get$currpd:
|
|
procedure pointer;
|
|
return mon4(156,0);
|
|
end get$currpd;
|
|
|
|
|
|
/* utility functions */
|
|
|
|
crlf:
|
|
procedure;
|
|
call co (CR);
|
|
call co (LF);
|
|
end crlf;
|
|
|
|
print$infield: /* Prints 'len' # of bytes in a */
|
|
/* left- or right-justified field*/
|
|
/* of 'width' dimension. */
|
|
procedure (width,justify,len,dataddr);
|
|
|
|
dcl dataddr pointer;
|
|
dcl (width,len) byte,
|
|
(i,justify) byte;
|
|
dcl char based dataddr byte;
|
|
dcl dat$ptr structure(
|
|
offset word,
|
|
segment word) at (@dataddr);
|
|
|
|
if len <= width then do; /* Error Check */
|
|
if justify = 'r' then /* Right Justify */
|
|
do i=1 to (width-len) ; /* Pad on the left */
|
|
call co(' ');
|
|
end;
|
|
do i=1 to len ;
|
|
call co (char and 7fh); /* Print the data */
|
|
dat$ptr.offset = dat$ptr.offset + 1;
|
|
end;
|
|
if justify = 'l' then /* Left-justified*/
|
|
do i = 1 to (width-len); /* Pad on the right*/
|
|
call co(' ');
|
|
end;
|
|
end;
|
|
|
|
end print$infield;
|
|
|
|
|
|
|
|
dcl hex$digit (*) byte data ('0123456789ABCDEF');
|
|
|
|
display$hex$byte:
|
|
procedure (value);
|
|
dcl value byte;
|
|
call co (hex$digit(shr(value,4)));
|
|
call co (hex$digit(value mod 16));
|
|
end display$hex$byte;
|
|
|
|
display$hex$word:
|
|
procedure (value);
|
|
dcl value word;
|
|
call display$hex$byte (high(value));
|
|
call display$hex$byte (low (value));
|
|
end display$hex$word;
|
|
|
|
|
|
print$hex$byte: /* Prints hex byte in a right- or */
|
|
/* left-justified field of 'width'*/
|
|
/* dimension. */
|
|
procedure (width,justify,val);
|
|
dcl (val,width) byte,
|
|
(i,justify) byte;
|
|
|
|
if width < 2 then return; /* Must be at least 2 for hex byte */
|
|
else do;
|
|
if justify = 'r' then /* Right Justify */
|
|
do i=1 to (width - 2) ;
|
|
call co(' '); /* Pad on the left */
|
|
end;
|
|
call display$hex$byte(val); /* Print the digits */
|
|
if justify = 'l' then
|
|
do i=1 to (width-2) ;
|
|
call co(' '); /* Pad on the right */
|
|
end;
|
|
end;
|
|
end print$hex$byte;
|
|
|
|
|
|
print$hex$word: /* Prints hex word in a right- */
|
|
/* or left-justified field of */
|
|
/* 'width' dimension. */
|
|
procedure(width,justify,val);
|
|
dcl val word,
|
|
(justify,width) byte;
|
|
dcl i byte;
|
|
|
|
if width < 4 then return; /* Error check */
|
|
else do;
|
|
if justify = 'r' then /* Field is right-justified */
|
|
do i=1 to (width-4) ;
|
|
call co(' '); /* Pad on the left */
|
|
end;
|
|
call display$hex$word(val); /* Print the digits */
|
|
if justify = 'l' then
|
|
do i=1 to (width-4) ;
|
|
call co(' '); /* Pad on the right */
|
|
end;
|
|
end;
|
|
|
|
end print$hex$word;
|
|
|
|
clear: procedure;
|
|
dcl i byte;
|
|
|
|
do i = 1 to clearseq(0); /* 1st element = counter */
|
|
call rawco(clearseq(i)); /* Direct clear_screen sequence */
|
|
end; /* to terminal. */
|
|
end clear;
|
|
|
|
home: procedure;
|
|
dcl i byte;
|
|
|
|
do i = 1 to homeseq(0); /* 1st element = counter */
|
|
call rawco(homeseq(i)); /* direct home cursor sequence */
|
|
end; /* to terminal. */
|
|
|
|
end home;
|
|
|
|
skip$lines: procedure(numlines);
|
|
dcl (numlines,i) byte;
|
|
|
|
do i = 1 to numlines;
|
|
call co(LF);
|
|
end;
|
|
end skip$lines;
|
|
|
|
cons$wait: procedure;
|
|
dcl chr byte;
|
|
|
|
call print$buffer(.(CR,LF,
|
|
' Type any key to leave and return to main menu.$'));
|
|
chr = conin;
|
|
|
|
end cons$wait;
|
|
|
|
aschex: /* Convert ascii to hex*/
|
|
procedure(num) byte;
|
|
dcl num byte;
|
|
|
|
if (num > 47) and (num < 58) then do; /* 0 - 9 range */
|
|
num = num - '0';
|
|
end;
|
|
else do;
|
|
if (num > 64) and (num < 71) then do; /* A - F range */
|
|
num = num - 55;
|
|
end;
|
|
else do;
|
|
if (num > 96) and (num < 103) then do; /* a - f range */
|
|
num = num - 87;
|
|
end;
|
|
else
|
|
num = 015h; /* Error -> Default */
|
|
end;
|
|
end;
|
|
return (num);
|
|
|
|
end aschex;
|
|
|
|
get$intrval: procedure word;
|
|
dcl (chr,chr1) byte,
|
|
ticdelay word;
|
|
|
|
chr = conin;
|
|
if (chr <> LF) and (chr <> CR) then do; /* It's not a default */
|
|
chr = aschex(chr); /* Get true hex version */
|
|
chr1 = conin; /* wait for CR or LF */
|
|
if (chr1 <> LF) and (chr1 <> CR) then do; /* 2nd hex digit */
|
|
chr = shl(chr,4) + aschex(chr1);
|
|
chr1 = conin; /* Get this CR LF */
|
|
end;
|
|
end;
|
|
else
|
|
chr = 01h; /* Default value */
|
|
ticdelay = chr * (sd.tickspersec); /* Convert to system ticks */
|
|
return (ticdelay);
|
|
|
|
end get$intrval;
|
|
|
|
|
|
disp$mainhdr: procedure; /* Main Menu Display */
|
|
|
|
call home; call clear;
|
|
call crlf; call crlf;
|
|
call print$infield(34,'r',14,@('Which Option ?'));
|
|
call crlf; call crlf;
|
|
call print$infield(33,'r',7,@('H (elp)'));
|
|
call crlf;
|
|
call print$infield(35,'r',9,@('M (emory)'));
|
|
call crlf; call print$infield(37,'r',11,@('O (verview)'));
|
|
call crlf; call print$infield(44,'r',18,@('P (rocesses - all)'));
|
|
call crlf; call print$infield(35,'r',9,@('Q (ueues)'));
|
|
call crlf; call print$infield(43,'r',17,@('U (ser processes)'));
|
|
call crlf; call print$infield(33,'r',7,@('E (xit)'));
|
|
call crlf; call crlf; call print$infield(26,'r',2,@('->'));
|
|
|
|
end disp$mainhdr;
|
|
|
|
print$opt$err: procedure;
|
|
call print$buffer(.(CR,LF,' Illegal command tail.$'));
|
|
call crlf;
|
|
call terminate;
|
|
end print$opt$err;
|
|
|
|
display$help: procedure;
|
|
|
|
call home; call clear;
|
|
call crlf; call crlf;
|
|
call crlf; call print$infield(42,'r',23,@('VALID SYSTAT COMMANDS :'));
|
|
call crlf; call crlf; call print$infield(25,'r',6,@('SYSTAT'));
|
|
call crlf; call print$infield(34,'r',15,@('SYSTAT [OPTION]'));
|
|
call crlf; call print$infield(36,'r',17,@('SYSTAT [OPTION C]'));
|
|
call crlf; call print$infield(39,'r',20,@('SYSTAT [OPTION C ##]'));
|
|
call crlf; call crlf; call print$infield(28,'r',9,@('- where -'));
|
|
call crlf; call crlf;
|
|
call print$infield(44,'r',25,@('-> C = continuous display'));
|
|
call crlf; call print$infield(47,'r',28,@('-> ## = 1-2 digit hex timer.'));
|
|
call crlf; call crlf; call print$infield(30,'r',11,@('-> OPTION ='));
|
|
call crlf; call print$infield(56,'r',33,@('M(emory) P(rocesses) O(verview)'));
|
|
call crlf; call print$infield(56,'r',33,@('U(ser Processes) Q(ueues) H(elp)'));
|
|
call crlf;
|
|
|
|
if not(specified) then
|
|
call cons$wait;
|
|
else
|
|
call terminate;
|
|
|
|
end display$help;
|
|
|
|
|
|
|
|
prntheader: procedure; /* Used in Process Data Display */
|
|
|
|
call home; call clear;
|
|
call print$infield(20,'r',18,@('Virtual Process'));
|
|
call crlf;
|
|
call print$infield(20,'r',18,@('Console Name '));
|
|
call print$infield(37,'r',35,@('Flag Prior Status Resource'));
|
|
call crlf;
|
|
call print$infield(20,'r',18,@('------- -------'));
|
|
call print$infield(37,'r',35,@('---- ----- ------ --------'));
|
|
|
|
end prntheader;
|
|
|
|
|
|
|
|
disp$status: procedure(stat); /* Prints formatted status field */
|
|
dcl stat byte; /* of Process display. */
|
|
|
|
if (stat >=0) and (stat < 11) then do;
|
|
do case stat;
|
|
call print$infield(13,'l',5,@('READY'));
|
|
call print$infield(13,'l',4,@('POLL'));
|
|
call print$infield(13,'l',5,@('DELAY'));
|
|
call print$infield(13,'l',4,@('SWAP'));
|
|
call print$infield(13,'l',9,@('TERMINATE'));
|
|
call print$infield(13,'l',5,@('SLEEP'));
|
|
call print$infield(13,'l',7,@('READING'));
|
|
call print$infield(13,'l',7,@('WRITING'));
|
|
call print$infield(13,'l',9,@('FLAG WAIT'));
|
|
call print$infield(13,'l',8,@('CIO WAIT'));
|
|
call print$infield(13,'l',8,@('SYNCHING'));
|
|
end;
|
|
end;
|
|
else
|
|
call print$infield(13,'l',5,@('ERROR'));
|
|
|
|
end disp$status;
|
|
|
|
|
|
|
|
disp$resource: procedure(stats,rsrce);/* Prints formatted resource field */
|
|
dcl stats byte; /* of Process display. */
|
|
dcl (rsrce,offs) word;
|
|
dcl (count,notfound) byte; /* For flag table traversal */
|
|
|
|
if (stats >=0) and (stats < 11) then do;
|
|
do case stats;
|
|
call print$infield(13,'l',3,@('CPU ')); /* Case 0 */
|
|
do; /* Case 1 */
|
|
call print$infield(8,'l',8,@('DEVICE #'));
|
|
call print$hex$byte(4,'l',low(rsrce));
|
|
end;
|
|
do; /* Case 2 */
|
|
call print$infield(8,'l',8,@('TICKS = '));
|
|
call print$hex$word(4,'l',rsrce);
|
|
end;
|
|
call print$infield(13,'l',7,@('SWAPERR ')); /* Case 3 */
|
|
call print$infield(13,'l',3,@('CPU ')); /* Case 4 */
|
|
do;
|
|
if rsrce = sd.rlr then /* Case 5 */
|
|
call print$infield(13,'l',10,@('READY LIST'));
|
|
else if rsrce = sd.dlr then
|
|
call print$infield(13,'l',10,@('DELAY LIST'));
|
|
else if rsrce = sd.drl then
|
|
call print$infield(13,'l',10,@('DISPATCHER'));
|
|
else if rsrce = sd.plr then
|
|
call print$infield(13,'l',9,@('POLL LIST'));
|
|
else
|
|
call print$infield(13,'l',5,@('OTHER'));
|
|
end;
|
|
do; /* Case 6 */
|
|
qd$ptr.offset = rsrce;
|
|
call print$in$field(12,'l',pnamsiz,@qd.name);
|
|
end;
|
|
do; /* Case 7 */
|
|
qd$ptr.offset = rsrce;
|
|
call print$infield(12,'l',pnamsiz,@qd.name);
|
|
end;
|
|
do; /* Case 8 */
|
|
call co(023h); /* A '#' sign */
|
|
if rsrce <> 0ffffh then
|
|
call print$hex$byte(12,'l',low(rsrce));
|
|
else
|
|
call print$in$field(12,'l',1,@('?'));
|
|
end;
|
|
do; /* Case 9 */
|
|
call print$infield(10,'l',9,@('CONSOLE #'));
|
|
call display$hex$byte(low(rsrce));
|
|
end;
|
|
call print$infield(13,'l',13,@(' ')); /* Case 10*/
|
|
end; /* case */
|
|
end;
|
|
else /* Invalid Status Value */
|
|
call print$infield(12,'l',5,@('ERROR'));
|
|
end disp$resource;
|
|
|
|
dcl pd$list (64) structure ( /* Stores fields of successive pd's.*/
|
|
cns byte,
|
|
name (8) byte,
|
|
flag word,
|
|
prior byte,
|
|
stat byte ,
|
|
resource word);
|
|
|
|
dcl link$list (64) word;
|
|
|
|
display$proc: procedure(lnkfield);
|
|
dcl lnkfield byte; /* True = user proc's only,False = all proc's*/
|
|
dcl (char,temp) byte; /* Temp controls continuous printout */
|
|
dcl (k,n) byte,
|
|
(notfound,i) byte;
|
|
|
|
if not(specified) then do;
|
|
call crlf;
|
|
call print$buffer(.(CR,LF,' Continuous Display?$'));
|
|
char = conin;
|
|
if (char = 'y') or ( char = 'Y') then do;
|
|
repeat = true;
|
|
call print$buffer(.(CR,LF,'Time Interval (in hex) :$'));
|
|
intrval = get$intrval;
|
|
|
|
end;
|
|
end;
|
|
|
|
temp = true;
|
|
call prntheader;
|
|
|
|
do while (temp or repeat); /* Display until user hits any key */
|
|
disable; /* critical section required to obtain list*/
|
|
temp = false;
|
|
n = -1;
|
|
pd$ptr.offset = sd.thrdrt; /* Start at Thread List root. */
|
|
getpds: /* Put all pd's on the list */
|
|
do while (pd$ptr.offset <> 0) and (n <> maxpd);
|
|
n = n + 1;
|
|
if not(lnkfield) or (pd.mem <> 0) then /* Is it user processes only ? */
|
|
do; /* Either display all processes anyway or */
|
|
/* or this is a valid user process. */
|
|
pd$list(n).cns = pd.cns;
|
|
do i= 0 to pnamsiz-1;
|
|
pd$list(n).name(i) = pd.name(i);
|
|
end;
|
|
pd$list(n).flag = pd.flag;
|
|
pd$list(n).prior = pd.prior;
|
|
pd$list(n).stat = pd.stat;
|
|
/* Use sysdat info to determine what each*/
|
|
/* process is waiting for or using. Get */
|
|
/* Queue names,flag #'s,system ticks,list*/
|
|
/* names and device or console #'s. Must */
|
|
/* be done in critical region. */
|
|
i = pd.stat; /* Save this to determine resource . */
|
|
if (i = 1) or (i = 2 )then
|
|
pd$list(n).resource = pd.wait; /* Device # or # of ticks delayed */
|
|
else
|
|
if i = 5 then /* Process is sleeping - find out which list*/
|
|
do;
|
|
uda$ptr.segment = pd.uda;
|
|
uda$ptr.offset = 0;
|
|
pd$list(n).resource = uda.dparam;
|
|
end;
|
|
else
|
|
if (i = 6) or (i = 7) then /* Process is reading from or writing to */
|
|
do; /* a queue. Get address of queue name. */
|
|
uda$ptr.segment = pd.uda;
|
|
uda$ptr.offset = 0;
|
|
if i = 6 then
|
|
pd$list(n).resource = (uda.dparam) - 12h;
|
|
else
|
|
pd$list(n).resource = (uda.dparam) - 14h;
|
|
end;
|
|
else
|
|
if i = 8 then /* Process is waiting on a flag, get the #*/
|
|
do;
|
|
pd$list(n).resource = 0ffffh; /* Remains if no flag found .*/
|
|
flag$ptr.offset = sd.flags;
|
|
notfound = true;
|
|
k = 0; /* Flag counter */
|
|
do while notfound;
|
|
if (flag.pd <> pd$ptr.offset) then do;
|
|
k = k+ 1;
|
|
flag$ptr.offset = flag$ptr.offset + flaglen;
|
|
if k > sd.nflags then /* End of table */
|
|
notfound = false;
|
|
end;
|
|
else /* This is the flag*/
|
|
do;
|
|
pd$list(n).resource = k;
|
|
notfound = false;
|
|
end;
|
|
end;
|
|
end;
|
|
else
|
|
if i = 9 then do;
|
|
pd$list(n).resource = pd.cns;
|
|
end;
|
|
end; /* Valid processes*/
|
|
else
|
|
n = n-1; /* Ignore system processes */
|
|
pd$ptr.offset = pd.thread; /* Get the next process*/
|
|
end getpds;
|
|
|
|
if n = -1 then return; /* stop here if no pds */
|
|
|
|
enable;
|
|
call home; call skip$lines(3); /* enables interrupts */
|
|
printpds:
|
|
do k = 0 to n;
|
|
if k <> 0 then call crlf;
|
|
call print$hex$byte(7,'r',pd$list(k).cns);/* print virtual console #*/
|
|
call print$buffer(.(' $'));
|
|
call print$infield(9,'l',pnamsiz,@pd$list(k).name); /* print name */
|
|
call print$hex$word(8,'l',pd$list(k).flag);
|
|
call print$hex$byte(7,'l',pd$list(k).prior); /* print its priority */
|
|
call disp$status(pd$list(k).stat); /* print process status */
|
|
call disp$resource(pd$list(k).stat,pd$list(k).resource);
|
|
/* print resource */
|
|
|
|
end printpds;
|
|
|
|
if n < 21 then do;
|
|
do k = n to 18;
|
|
call print$buffer(.(CR,LF,
|
|
' $'));
|
|
end;
|
|
end;
|
|
|
|
|
|
if constat then do; /* Check for User Interrupt*/
|
|
repeat = false;
|
|
char = conin; /* Swallow stop char */
|
|
end;
|
|
if repeat then do; /* If still going,delay it */
|
|
call delay(intrval); /* and go back to loop top */
|
|
if (n >= 20) then
|
|
call prntheader;
|
|
end;
|
|
else do;
|
|
if not(specified) then /* If not comline args then */
|
|
call cons$wait; /* let them get to main menu*/
|
|
else
|
|
call terminate;
|
|
end;
|
|
|
|
end;/*while loop*/
|
|
|
|
end display$proc;
|
|
|
|
|
|
dcl sortrecd structure ( name (8) byte, /* Stores data when sorting*/
|
|
start word,
|
|
pd word,
|
|
len word,
|
|
cns byte );
|
|
|
|
dcl sortarray (80) structure ( /* For sorting and printing*/
|
|
name (8) byte,
|
|
start word,
|
|
pd word,
|
|
len word,
|
|
cns byte );
|
|
|
|
dcl sharearray (80) structure ( /* For Shared Code List */
|
|
name (8) byte,
|
|
start word,
|
|
disk byte,
|
|
user byte,
|
|
len word,
|
|
cns byte );
|
|
|
|
disp$memhdr : procedure;
|
|
|
|
call home; call clear;
|
|
call print$buffer(.('Process Virtual | $'));
|
|
call print$buffer(.('Process Virtual $'));
|
|
call print$buffer(.(CR,LF,' Name Console PD# Start Len | $'));
|
|
call print$buffer(.(' Name Console PD# Start Len $'));
|
|
call print$buffer(.(CR,LF,'________ _______ ____ _____ ____ | $'));
|
|
call print$buffer(.(' _______ _______ ____ _____ ____ $'));
|
|
|
|
|
|
end disp$memhdr;
|
|
|
|
print$sorted: /* Prints two columns of memory data */
|
|
procedure(cnt,scnt); /* Uses sorted array of structures. */
|
|
dcl (cnt,scnt) byte, /* cnt: regular mem,scnt: shared mem */
|
|
(m,q,k) byte;
|
|
|
|
|
|
call home;
|
|
call skip$lines(3);
|
|
|
|
if (cnt > 1) then do; /* Must have two per line here */
|
|
do m = 0 to ((cnt/2)-1) ; /* If odd #, hold last one */
|
|
call crlf; /* Print 2 columns,ascending values*/
|
|
k = m;
|
|
do q = 1 to 2 ;
|
|
call print$infield(12,'l',pnamsiz,@sortarray(k).name);
|
|
if sortarray(k).cns = 030h then
|
|
call print$buffer(.(' $'));
|
|
else call print$hex$byte(7,'l',sortarray(k).cns);
|
|
call print$hex$word(6,'l',sortarray(k).pd);
|
|
call print$hex$word(7,'l',sortarray(k).start);
|
|
call print$hex$word(5,'l',sortarray(k).len);
|
|
if (q mod 2) <> 0 then
|
|
call print$buffer(.('| $'));
|
|
k = k + (cnt/2); /* Go to other half of the array */
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if (cnt mod 2) <> 0 then do; /* Only put one on last line */
|
|
/* Print blanks on left */
|
|
call print$buffer(.(CR,LF,
|
|
' | $'));
|
|
call print$infield(12,'l',pnamsiz,@sortarray(cnt-1).name);
|
|
if sortarray(cnt-1).cns = 030h then
|
|
call print$buffer(.(' $'));
|
|
else
|
|
call print$hex$byte(7,'l',sortarray(cnt-1).cns);
|
|
call print$hex$word(6,'l',sortarray(cnt-1).pd);
|
|
call print$hex$word(7,'l',sortarray(cnt-1).start);
|
|
call print$hex$word(5,'l',sortarray(cnt-1).len);
|
|
end;
|
|
/* Print Shared Code,if any */
|
|
if (scnt > 0) then do;
|
|
call print$buffer(.(CR,LF,
|
|
' Shared Code List $'));
|
|
call print$buffer(.(' $'));
|
|
end;
|
|
|
|
if (scnt > 1) then do;
|
|
do m = 0 to ((scnt/2) - 1);
|
|
call crlf;
|
|
k = m;
|
|
do q = 1 to 2;
|
|
call print$infield(12,'l',pnamsiz,@sharearray(k).name);
|
|
call print$hex$byte(7,'l',sharearray(k).cns);
|
|
call print$hex$byte(2,'l',sharearray(k).disk);
|
|
call print$hex$byte(4,'l',sharearray(k).user);
|
|
call print$hex$word(7,'l',sharearray(k).start);
|
|
call print$hex$word(5,'l',sharearray(k).len);
|
|
if (q mod 2) <> 0 then
|
|
call print$buffer(.('| $'));
|
|
k = k + (scnt/2);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if (scnt > 0) then do;
|
|
|
|
if (scnt mod 2) <> 0 then do; /* Odd # of md's. */
|
|
/* Put just 1 on last line*/
|
|
call print$buffer(.(CR,LF,
|
|
' | $'));
|
|
call print$infield(12,'l',pnamsiz,@sharearray(scnt-1).name);
|
|
call print$hex$byte(7,'l',sharearray(scnt-1).cns);
|
|
call print$hex$byte(2,'l',sharearray(scnt-1).disk);
|
|
call print$hex$byte(4,'l',sharearray(scnt-1).user);
|
|
call print$hex$word(7,'l',sharearray(scnt-1).start);
|
|
call print$hex$word(5,'l',sharearray(scnt-1).len);
|
|
end;
|
|
|
|
scnt = scnt + 1; /* Count its heading */
|
|
end;
|
|
|
|
if ((cnt+scnt)/2) < 21 then do; /* Clear rest of screen */
|
|
do k = ((cnt+scnt)/2) to 18;
|
|
call print$buffer(.(CR,LF,
|
|
' $'));
|
|
call print$buffer(.(' $'));
|
|
end;
|
|
end;
|
|
|
|
|
|
end print$sorted;
|
|
|
|
|
|
display$mem:
|
|
procedure;
|
|
dcl (i,mdcnt,pdcnt) byte; /* Mdcnt = memory descriptor count*/
|
|
dcl (x,y) byte, /* Pdcnt = process descr. count */
|
|
(cont,scdcnt) byte, /* cont = Boolean 'continue' */
|
|
n integer,
|
|
(temp,chr) byte,
|
|
savmau word;
|
|
|
|
if not(specified) then do;
|
|
/* Does User want continuous display?*/
|
|
call print$buffer(.(CR,LF,' Continuous Display? $'));
|
|
chr = conin;
|
|
if (chr = 'y') or ( chr = 'Y') then do;
|
|
repeat = true;
|
|
call print$buffer(.(CR,LF,' Time Interval (in hex): $'));
|
|
intrval = get$intrval; /* Get hex value from terminal */
|
|
end;
|
|
end;
|
|
temp = true;
|
|
|
|
call home; call clear;
|
|
call disp$memhdr;
|
|
do while (temp or repeat); /* Display at least once */
|
|
temp = false;
|
|
do pdcnt = 0 to maxpd;
|
|
link$list(pdcnt) = 0;
|
|
end;
|
|
n = -1;
|
|
pdcnt = 0;
|
|
|
|
|
|
disable; /* Critical section required to obtain list */
|
|
|
|
getmemowners:
|
|
pd$ptr.offset = sd.thrdrt; /* Start at Thread Root */
|
|
do while (pd$ptr.offset <> 0) and (pdcnt <> maxpd);
|
|
if pd.mem <> 0 then do; /* If it owns memory, */
|
|
link$list(n:=n+1) = pd$ptr.offset; /* put it on the list. */
|
|
pdcnt = pdcnt + 1;
|
|
end;
|
|
pd$ptr.offset = pd.thread; /* Go to next process */
|
|
end;
|
|
if pdcnt = 0 then return;
|
|
|
|
getmds:
|
|
mdcnt = 0;
|
|
do i = 0 to (pdcnt-1);
|
|
pd$ptr.offset = link$list(i); /* Reset Proc Descriptor */
|
|
ms$ptr.offset = pd.mem;
|
|
cont = true;
|
|
do while (cont and (mdcnt <= maxmd));
|
|
sortarray(mdcnt).pd = pd$ptr.offset; /* Get proc descriptor */
|
|
cont = false;
|
|
md$ptr.offset = ms.mau; /* Md is on MAL */
|
|
sortarray(mdcnt).start = md.start;
|
|
sortarray(mdcnt).len = md.length;
|
|
sortarray(mdcnt).cns = pd.cns;
|
|
do x = 0 to 7; /* Get owner's name */
|
|
sortarray(mdcnt).name(x) = pd.name(x); /* A byte at a time */
|
|
end;
|
|
if ms.link <> 0 then do; /* More md's for this */
|
|
/* process ? */
|
|
savmau = ms.mau;
|
|
ms$ptr.offset = ms.link;
|
|
do while (ms.mau = savmau) and (ms.link <> 0);
|
|
savmau = ms.mau; /* Look for a different */
|
|
ms$ptr.offset = ms.link; /* partition,same pd. */
|
|
end;
|
|
if (savmau <> ms.mau) then /* Check if same mau */
|
|
cont = true; /* If not, go get another md*/
|
|
end;
|
|
mdcnt = mdcnt + 1;
|
|
|
|
end; /* while cont : a single pd's memory*/
|
|
|
|
end; /* All pd's memory*/
|
|
|
|
/* That's all the used memory. Now go */
|
|
/* to the Memory Free List. */
|
|
md$ptr.offset = sd.mfl;
|
|
do while md$ptr.offset <> 0 and (mdcnt < maxmd);
|
|
do x = 0 to 7;
|
|
sortarray(mdcnt).name(x) = freename(x); /*Use 'FREE' as name*/
|
|
end;
|
|
sortarray(mdcnt).start = md.start;
|
|
sortarray(mdcnt).pd = 0;
|
|
sortarray(mdcnt).len = md.length;
|
|
sortarray(mdcnt).cns = 030h;
|
|
mdcnt = mdcnt+1;
|
|
md$ptr.offset = md.link;
|
|
end;
|
|
/* Get shared code */
|
|
getshared: /* Free and used */
|
|
n = -1;
|
|
pdcnt = 0;
|
|
scdcnt = 0;
|
|
pd$ptr.offset = sd.slr; /* Top of shared list*/
|
|
do while (pd$ptr.offset <> 0) and (pdcnt < maxpd);
|
|
link$list(n:=n + 1) = pd$ptr.offset;
|
|
pdcnt = pdcnt + 1;
|
|
pd$ptr.offset = pd.thread;
|
|
end;
|
|
if (pdcnt > 0) then do;
|
|
do i = 0 to (pdcnt-1);
|
|
pd$ptr.offset = link$list(i);
|
|
ms$ptr.offset = pd.mem;
|
|
cont = true;
|
|
do while (cont and (scdcnt < maxmd));
|
|
cont = false;
|
|
sharearray(scdcnt).cns = pd.cns;
|
|
sharearray(scdcnt).disk = pd.ldsk;
|
|
sharearray(scdcnt).user = pd.luser;
|
|
md$ptr.offset = ms.mau;
|
|
sharearray(scdcnt).start = md.start;
|
|
sharearray(scdcnt).len = md.length;
|
|
do x = 0 to (pnamsiz - 1);
|
|
sharearray(scdcnt).name(x) = pd.name(x);
|
|
end;
|
|
if (ms.link <> 0) then do;
|
|
savmau = ms.mau;
|
|
ms$ptr.offset = ms.link;
|
|
do while (ms.mau = savmau) and (ms.link <> 0);
|
|
savmau = ms.mau;
|
|
ms$ptr.offset = ms.link;
|
|
end;
|
|
if (ms.mau <> savmau) then
|
|
cont = true;
|
|
end;
|
|
scdcnt = scdcnt + 1;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
enable; /* End critical section */
|
|
|
|
/* Now sort the list of partitions */
|
|
sortmds :
|
|
do x = 0 to (mdcnt-1);
|
|
sortrecd.start = sortarray(x).start;
|
|
do i = 0 to 7;
|
|
sortrecd.name(i) = sortarray(x).name(i);
|
|
end;
|
|
sortrecd.len = sortarray(x).len;
|
|
sortrecd.pd = sortarray(x).pd;
|
|
sortrecd.cns = sortarray(x).cns;
|
|
y = x;
|
|
find : do while (y > 0) and ( sortarray(y-1).start > sortrecd.start);
|
|
sortarray(y).start = sortarray(y-1).start;
|
|
do i = 0 to 7;
|
|
sortarray(y).name(i) = sortarray(y-1).name(i);
|
|
end;
|
|
sortarray(y).len = sortarray(y-1).len;
|
|
sortarray(y).pd = sortarray(y-1).pd;
|
|
sortarray(y).cns = sortarray(y-1).cns;
|
|
y = y-1;
|
|
end find;
|
|
|
|
sortarray(y).start = sortrecd.start;
|
|
do i = 0 to 7;
|
|
sortarray(y).name(i) = sortrecd.name(i);
|
|
end;
|
|
sortarray(y).len = sortrecd.len;
|
|
sortarray(y).pd = sortrecd.pd;
|
|
sortarray(y).cns = sortrecd.cns;
|
|
end sortmds;
|
|
|
|
|
|
|
|
call print$sorted(mdcnt,scdcnt); /* Print the sorted list */
|
|
if constat then do; /* Want to loop again ? */
|
|
repeat = false;
|
|
chr = conin; /* Swallow stop char */
|
|
end;
|
|
if repeat then do; /* Keep looping,delay first */
|
|
if ((mdcnt / 2) >= 20) then
|
|
call disp$memhdr;
|
|
call delay(intrval);
|
|
end;
|
|
else do;
|
|
if not(specified) then /* Get back to main menu*/
|
|
call cons$wait;
|
|
else /* Skip menu, -> system */
|
|
call terminate;
|
|
end;
|
|
end;/*while*/
|
|
|
|
end display$mem;
|
|
|
|
|
|
dcl qlist (64) structure (
|
|
name (8) byte,
|
|
nmsgs word,
|
|
msglen word,
|
|
msgcnt word,
|
|
nq word,
|
|
dq word,
|
|
owner (8) byte,
|
|
flags byte);
|
|
|
|
print$qhdr: procedure; /* Print Queue Heading */
|
|
|
|
call home; call clear;
|
|
call print$buffer(.(' NAME NMSGS MSGLEN MSGCNT $'));
|
|
call print$buffer(.('READER WRITER MX-OWNER FLAGS $'));
|
|
call crlf;
|
|
call print$buffer(.(' ________ ______ ______ ______ $'));
|
|
call print$buffer(.('______ ______ ________ _____ $'));
|
|
call crlf;
|
|
|
|
end print$qhdr;
|
|
|
|
|
|
display$flag$status: /* Print Queue Flag Status*/
|
|
procedure(flag);
|
|
dcl prev boolean;
|
|
dcl (i,flag,cnt) byte;
|
|
|
|
prev = false;
|
|
i = 1;
|
|
cnt = 0;
|
|
|
|
do while (i <= maxqflags) ;
|
|
if (flag and i) <> 0 then do;
|
|
if prev then do; /* Take care of formatting */
|
|
call co(',');
|
|
cnt = cnt + 1; /* Count all chars */
|
|
end;
|
|
call display$hex$byte(i);
|
|
cnt = cnt + 2;
|
|
prev = true;
|
|
end;
|
|
i = i*2; /* Flags are 1 bit each */
|
|
end;
|
|
do i = cnt to 14; /* Clear previous line's flags */
|
|
call co(' ');
|
|
end;
|
|
|
|
end display$flag$status;
|
|
|
|
|
|
display$queue:
|
|
procedure;
|
|
dcl temp byte,
|
|
n integer,
|
|
(qdcnt,cont) byte,
|
|
(chr,i) byte;
|
|
|
|
if not(specified) then do;
|
|
call crlf;
|
|
call print$buffer(.(CR,LF,' Continuous Display? $'));
|
|
chr = conin;
|
|
if (chr = 'y') or (chr = 'Y') then do;
|
|
repeat = true;
|
|
call print$buffer(.(CR,LF,'Time Interval (in hex) : $'));
|
|
intrval = get$intrval;
|
|
end;
|
|
end;
|
|
|
|
temp = true;
|
|
call print$qhdr;
|
|
|
|
do while ( temp or repeat);
|
|
temp = false;
|
|
qdcnt = 0;
|
|
call home; call skip$lines(2);
|
|
|
|
getqueues:
|
|
disable; /* Begin Critical Section */
|
|
qd$ptr.offset = sd.qlr;
|
|
do while ((qdcnt < maxqueues) and (qd$ptr.offset <> 0)) ;
|
|
do i = 0 to pnamsiz-1;
|
|
qlist(qdcnt).name(i)= qd.name(i);
|
|
end;
|
|
qlist(qdcnt).nmsgs = qd.nmsgs;
|
|
qlist(qdcnt).msglen = qd.msglen;
|
|
qlist(qdcnt).msgcnt = qd.msgcnt;
|
|
qlist(qdcnt).nq = qd.nq;
|
|
qlist(qdcnt).dq = qd.dq;
|
|
if ((qd.flags mod 2) <> 0) then do; /* It's an MX queue */
|
|
pd$ptr.offset = qd.buffer;
|
|
if pd$ptr.offset <> 0 then /* It has an owner */
|
|
do i = 0 to pnamsiz -1;
|
|
qlist(qdcnt).owner(i) = pd.name(i);
|
|
end;
|
|
else /* No one owns it now */
|
|
do i = 0 to pnamsiz-1; /* Print blanks */
|
|
qlist(qdcnt).owner(i) = ' ';
|
|
end;
|
|
end;
|
|
else /* It's not an MX queue*/
|
|
do i = 0 to pnamsiz-1;
|
|
qlist(qdcnt).owner(i) = ' ';
|
|
end;
|
|
qlist(qdcnt).flags = qd.flags;
|
|
qdcnt = qdcnt + 1;
|
|
qd$ptr.offset = qd.link;
|
|
end;
|
|
enable; /* End critical section */
|
|
|
|
print$qds: /* Print the Queue info */
|
|
do i = 0 to qdcnt-1;
|
|
call print$buffer(.(' $'));
|
|
call print$infield(11,'l',pnamsiz,@qlist(i).name);/* Queue Name */
|
|
call print$hex$word(8,'l',qlist(i).nmsgs); /* Number of Msgs*/
|
|
call print$hex$word(8,'l',qlist(i).msglen); /* Message Length*/
|
|
call print$hex$word(7,'l',qlist(i).msgcnt); /* Message Count */
|
|
pd$ptr.offset = qlist(i).dq;
|
|
if pd$ptr.offset <> 0 then
|
|
call print$infield(9,'l',pnamsiz,@pd.name);
|
|
else
|
|
call print$buffer(.(' $'));
|
|
pd$ptr.offset = qlist(i).nq;
|
|
if pd$ptr.offset <> 0 then
|
|
call print$infield(9,'l',pnamsiz,@pd.name);
|
|
else
|
|
call print$buffer(.(' $'));
|
|
call print$infield(10,'l',pnamsiz,@qlist(i).owner); /* Print it */
|
|
call display$flag$status(qlist(i).flags); /* Print Flag Value*/
|
|
call crlf;
|
|
end;
|
|
|
|
/* Print the Flag Key */
|
|
call print$buffer(.(' Flag Values : 1 = MX, 2 = NO DELETE, $'));
|
|
call print$buffer(.('4 = NOT USER WRITEABLE, $'));
|
|
call crlf;
|
|
call print$buffer(.(' 8 = RSP, 10 = FROM QD TABLE, 20 = RPL QUEUE, $'));
|
|
call print$buffer(.('40 = DEVICE QUEUE.$'));
|
|
qdcnt = qdcnt - 1; /* To normalize */
|
|
|
|
if (qdcnt < 22) then do;
|
|
do i = qdcnt to 17;
|
|
call print$buffer(.(CR,LF,
|
|
' $'));
|
|
end;
|
|
end;
|
|
|
|
if constat then do; /* Check for continue */
|
|
repeat = false;
|
|
chr = conin;
|
|
end;
|
|
if repeat then do; /* Keep going,delay first */
|
|
call delay(intrval);
|
|
if (qdcnt >= 19) then do;
|
|
call print$qhdr;
|
|
end;
|
|
end;
|
|
else do; /* Stop display */
|
|
if not(specified) then /* Go to main menu */
|
|
call cons$wait;
|
|
else /* Go back to system */
|
|
call terminate;
|
|
end;
|
|
end; /* while loop */
|
|
|
|
end display$queue;
|
|
|
|
|
|
|
|
dcl driv$letter (*) byte data ('ABCDEFGHIJKLMNOP');
|
|
|
|
display$gen: procedure(vers); /* Overview Display Routine*/
|
|
dcl vers byte;
|
|
dcl (count,qsize) word;
|
|
dcl mode word;
|
|
|
|
|
|
call home; call clear;
|
|
pd$pointer = get$currpd; /* Get PD for Current Process*/
|
|
vccb$ptr.offset = sd.ccb + (pd.cns * size(vccb));
|
|
|
|
call crlf; call print$infield(42,'r',17,@('Default Disk = '));
|
|
call co(driv$letter(pd.dsk));
|
|
call co(':');
|
|
|
|
call crlf; call print$infield(42,'r',24,@('Default User Number = '));
|
|
call display$hex$byte(pd.user);
|
|
|
|
call crlf; call print$infield(42,'r',20,@('Default Printer = '));
|
|
if (vers) then /* It's MPM-86 */
|
|
call display$hex$byte(pd.lst - sd.ncondev);
|
|
else /* It's Concurrent */
|
|
call display$hex$byte(pd.lst);
|
|
|
|
call crlf; call print$infield(42,'r',28,@('Current Virtual Console = '));
|
|
call display$hex$byte(pd.cns);
|
|
|
|
if (not vers) then do;
|
|
call crlf;call print$infield(42,'r',20,@('Background Mode = '));
|
|
mode = (vccb.state);
|
|
if (mode >= 0) and (mode <= 0200h ) then do;
|
|
if (mode mod 2) = 0 then
|
|
call print$buffer(.('DYNAMIC $'));
|
|
else
|
|
call print$buffer(.('BUFFERED$'));
|
|
end;
|
|
else call print$buffer(.('OTHER $'));
|
|
end;
|
|
|
|
if (not vers) then do;
|
|
call crlf; call print$infield(42,'r',17,@('Buffer Space = '));
|
|
call display$hex$word(vccb.maxbufsiz);
|
|
call co('K');
|
|
end;
|
|
|
|
call crlf;
|
|
call print$infield(42,'r',31,@('Maximum Memory Per Process = '));
|
|
call display$hex$word(sd.mmp);
|
|
call print$buffer(.(' PARA$'));
|
|
|
|
call crlf; call print$infield(42,'r',31,@('Number of Virtual Consoles = '));
|
|
call display$hex$byte(sd.ncns);
|
|
|
|
call crlf; call print$infield(42,'r',23,@('Number of Printers = '));
|
|
call display$hex$byte(sd.nlst);
|
|
|
|
call crlf; call print$infield(42,'r',20,@('Temporary Drive = '));
|
|
call co(driv$letter(sd.tempdisk));
|
|
call co(':');
|
|
|
|
call crlf; call print$infield(42,'r',17,@('System Drive = '));
|
|
call co(driv$letter(sd.srchdisk));
|
|
call co(':');
|
|
|
|
call crlf; call print$infield(42,'r',21,@('Ticks Per Second = '));
|
|
call display$hex$byte(sd.tickspersec);
|
|
|
|
call crlf; call print$infield(42,'r',20,@('Day File Option = '));
|
|
if sd.dayfile = 0 then
|
|
call print$buffer(.('NO $'));
|
|
else
|
|
call print$buffer(.('YES$'));
|
|
|
|
|
|
call crlf; call print$infield(42,'r',23,@('BDOS Compatability = '));
|
|
if sd.cmod <> 0 then
|
|
call print$buffer(.('YES$'));
|
|
else
|
|
call print$buffer(.('NO $'));
|
|
|
|
call crlf; call print$infield(42,'r',20,@('Number of Flags = '));
|
|
call display$hex$byte(sd.nflags);
|
|
|
|
call crlf; call print$infield(42,'r',27,@('Free Queue Descriptors = '));
|
|
pd$ptr.offset = sd.qul;
|
|
count = 0;
|
|
do while pd$ptr.offset <> 0;
|
|
count = count + 1;
|
|
pd$ptr.offset = pd.link;
|
|
end;
|
|
call display$hex$byte(count);
|
|
|
|
call crlf; call print$infield(42,'r',22,@('Free Queue Buffer = '));
|
|
md$ptr.offset = .sd.qmau(0);
|
|
sat$ptr.segment = md.start; /* start of qbuffer SAT */
|
|
sat$ptr.offset = size(sat); /* skip 1st 5 bytes bookeeping*/
|
|
qsize = 0;
|
|
do while sat.start <> 0; /* byte offset for queue buffer*/
|
|
if sat.num$allocs = 0 then /* dooes anyone own this piece?*/
|
|
qsize = qsize + sat.len;
|
|
sat$ptr.offset = size(sat) + sat$ptr.offset; /* Get next entry */
|
|
end;
|
|
call display$hex$word(qsize);
|
|
call print$buffer(.(' BYTES$'));
|
|
|
|
call crlf; call print$infield(42,'r',29,@('Free Process Descriptors = '));
|
|
pd$ptr.offset = sd.pul;
|
|
count = 0;
|
|
do while pd$ptr.offset <> 0;
|
|
count = count + 1;
|
|
pd$ptr.offset = pd.link;
|
|
end;
|
|
call display$hex$byte(count);
|
|
|
|
call crlf; call print$infield(42,'r',28,@('Free Memory Descriptors = '));
|
|
pd$ptr.offset = sd.mdul;
|
|
count = 0;
|
|
do while pd$ptr.offset <> 0;
|
|
count = count + 1;
|
|
pd$ptr.offset = pd.link;
|
|
end;
|
|
call display$hex$byte(count);
|
|
|
|
call crlf;
|
|
if not(specified) then
|
|
call cons$wait;
|
|
else
|
|
call terminate;
|
|
|
|
end displaygen;
|
|
|
|
|
|
|