|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 31560 (0x7b48)
Types: TextFile
Notes: flxfile
Names: »s28101:1.testout main «, »testout main «
└─⟦2c579b2cd⟧ Bits:30004129/s28101.imd SW8101/2 BOSS v.2 rel. 2.0
└─⟦4fb120d20⟧
└─⟦this⟧ »s28101:1.testout main «
; btj 30.08.74 bossout and last boss2, testout ...1...
(bossout=set 15 1
bossout=algol
scope user bossout
)
external procedure bossout(fkind, ftime, fcoruno, fthird, frecord, fmove, fprint);
<*<----assigned by bossout----> <-jensen device->*>
integer fkind, ftime, fcoruno, fthird;
integer array frecord; comment must be declared integer array frecord(0:256);
<* in order to use frecord, you can:
code a boolean procedure, working on frecord, and name it as
parameter fprint to bossout (result value may be false)
*>
boolean fmove, fprint;
message bossout version id: 84 07 18, 29;
begin
<* most of the procedure is re-coded. jan 1982, chd.
in every testoutput segment, the first 2 words contains the monitor clock,
corresponding to the first record on the segment, or =0 if segment is not used.
ps: the term 'type' is used instead of the term 'kind' in bossout,
(first word = tail length <6 + type).
*>
zone z(128*2,2,eof);
<* the blockproc eof is only relevant for magtape *>
procedure eof(z,s,b); zone z; integer s,b;
begin own boolean eot; integer array zonedescr(1:20);
if s extract 1 = 1 and s shift (-14) extract 1 = 0 then stderror(z,s,b) else
if file >= 0 then
begin if s shift(-18) extract 1 = 1 then eot:= true;
if s shift (-14) extract 1=1 then
begin comment mode error;
getposition(z, 0, b); comment destroy b;
getzone6(z, zonedescr);
if zonedescr(1) = 4 shift 12 + 18 or b > 1 then
stderror(z, s, 0); comment called recursive, or not at start;
zonedescr(1) := 4 shift 12 + 18; comment nrz-mode;
setzone6(z, zonedescr);
for b := zonedescr(18) step -1 until 1 do
begin comment change mode in shares;
getshare6(z, zonedescr, b);
zonedescr(4) := 4;
setshare6(z, zonedescr, b);
end;
setposition(z, 0, 0); setposition(z, 0, 0); comment set mode;
setposition(z, file, 0); comment restart same file in nrz mode;
s := b := 0; comment repeat block, and skip rest of status;
end else
if eot and s shift(-16) extract 1 = 1 and b > 0 then
begin setposition(z, -1, -1); setposition(z, 0, 0);
write(out,<:<10><10>*change tape:>);
file:= 0; b:= 0; eot:= false;
end else
if s shift (-16) extract 1=1 and b>0 then
begin
write(out,<:<10><10>*end of tape file:>);
goto stop;
end;
end;
end procedure eof;
\f
comment btj 30.08.74 bossout boss2, testout ...2...
;
procedure bosshead;
<*****************>
begin
integer i, j,k, l;
real r;
real array ra, prog (1:2);
j:= l:= 0; write(out,<:<12><10>:>);
for i:= system(4,j,ra) while i<>0 do
begin
if l>90 then l:= write(out, <:,:>, nl,1, sp,6);
l:= l + write(out, if j = 0 then <::>
else if i shift(-12) = 8 then <:.:> else <: :>);
k:= ra(1);
if i extract 12 =4 then l:= l+ write(out, <<d>, k)
else l:= l+ write(out, ra.rtol);
j:= j+1;
end;
system(4,0,prog);
if system(4,2,ra) extract 12 =4 then
begin <*file no, mt*>
file:= ra(1); kind:= 18;
end
else
begin <*name, bs assumed*>
kind:= 4;
end;
system(4,1,ra);
open(z, kind, ra, if kind=4 then 0
else (1 shift 14 + 1 shift 16 + 1 shift 18) );
setposition(z,file,0);
end procedure bosshead;
procedure bsclaims(boss);
<***********************>
boolean boss;
if hws <> 6+26 then print(z,0,0,0) else
begin
real array field raf;
hws:= 6;
print(z,0,0,0);
hws:= 6+26;
for w:= 8 step 4 until 20 do
begin
wa:= w + 2;
write(out, << -dddddd>, z.w, <<-dddd>, z.wa);
end;
write(out, sp,2);
raf:= 22;
outtext(out, 12, z.raf, 1);
wa:= 32;
if boss then write(out, << dddddd>, z.wa)
else write(out, << dd>, z.wa shift (-12), z.wa extract 12);
end;
\f
comment chd 82.01.20 bossout boss2, testout ...3...
;
procedure secclock(wno); value wno;
<*********************>
integer wno;
begin
<* write word no wno as seconds in same notation as head-time, supposing the word
contains a boss-shortclock in the form: montime shift(-13) extract 24.
*>
integer field wx; integer t;
wx:= wno shift 1;
if wx <= hws then
begin
t:= z.w2 - swtime;
if t<0 then t:= t+ 5 368 709;
<* t= time from segm start to 'now', units of 0.01 secs*>
write(out, << ddddddd>,
z.w2 / 100 <*head-time*>
+ ((extend 0 add z.wx) shift 13) / 10 000 <*time in wno in seconds*>
- (stime shift 11 shift(-11)) / 10 000 <* - segm start time *>
- t /100 );
t:= (((( stime shift (-(48-11)) <* most significant 11 bits *>
shift 24) add z.wx) <* next 24 bits *>
shift 13) // 10000) mod (24*60*60); <* time of day *>
write(out, << zd dd dd>,
(t // 3600) * 10000
+ ((t mod 3600) // 60) * 100
+ (t mod 60));
end;
end procedure secclock;
procedure sec(wno); value wno;
<*****************>
integer wno;
begin
<* write word no wno of zone z as seconds, converting from units of 0.8 seconds *>
integer field wx;
wx:= wno shift 1;
if wx<= hws then write(out,<< -ddddddd>, z.wx*0.8192);
end procedure sec;
procedure dump;
<*************>
if hws < 8 then print(z,0,0,0) else
begin
integer oldvalue;
oldvalue:= hws;
hws:= 6;
print(z,0,0,0);
hws:= oldvalue;
writeall(z, 8, hws, z.w3);
end;
\f
comment chd 82.01.20 bossout boss2, testout ...3a...
;
procedure writeall(z, first, top, ic);
<****************>
value first, top, ic;
integer first, top, ic;
zone z;
begin
integer i, word, char, lefthalf, righthalf,
function, wreg, xreg, pos;
boolean relative, indirect;
integer field ifield;
write(out, sp, 2,
<:address text characters abshalf halfwords integer code:>);
for ifield:= first step 2 until top do
begin
word:= z.ifield;
<* address *>
write(out, nl, 1, sp, 21,
<< -ddddddd>, ic);
<* text *>
write(out, sp, 3);
for i:= -16, -8, 0 do
begin
char:= word shift i extract 8;
if char<32 or char>126 then char:= 32;
write(out, false add char, 1);
end;
<* characters (8-bit values) *>
write(out, sp, 1);
for i:= -16, -8, 0 do
write(out, << ddd>, word shift i extract 8);
<* abshalf (unsigned halfwords) *>
lefthalf:= word shift (-12);
righthalf:= word extract 12;
write(out, sp, 1, << dddd>, lefthalf, righthalf);
<* halfwords (with sign) *>
if lefthalf > 2047 then lefthalf:= lefthalf - 4096;
if righthalf > 2047 then righthalf:= righthalf - 4096;
write(out, sp, 1, << -dddd>, lefthalf, righthalf);
<* integer (with sign) *>
write(out, << -ddddddd>, word);
<* code *>
function:= word shift (-18); <* bits 0-5 *>
wreg:= word shift (-16) extract 2; <* bits 6-7 *>
relative:= (word shift (-15) extract 1) = 1; <* bit 8 *>
indirect:= (word shift (-14) extract 1) = 1; <* bit 9 *>
xreg:= word shift (-12) extract 2; <* bits 10-11 *>
write(out, sp, 2, case function+1 of
(<:aw:>,<:do:>,<:el:>,<:hl:>,<:la:>,<:lo:>,<:lx:>,<:wa:>,<:ws:>,<:am:>,
<:wm:>,<:al:>,<:ri:>,<:jl:>,<:jd:>,<:je:>,<:xl:>,<:es:>,<:ea:>,<:zl:>,
<:rl:>,<:sp:>,<:re:>,<:rs:>,<:wd:>,<:rx:>,<:hs:>,<:xs:>,<:gg:>,<:di:>,
<:ms:>,<:is:>,<:ci:>,<:ac:>,<:ns:>,<:nd:>,<:as:>,<:ad:>,<:ls:>,<:ld:>,
<:sh:>,<:sl:>,<:se:>,<:sn:>,<:so:>,<:sz:>,<:sx:>,<:gp:>,<:fa:>,<:fs:>,
<:fm:>,<:ks:>,<:fd:>,<:cf:>,<:dl:>,<:ds:>,<:aa:>,<:ss:>,<:58:>,<:59:>,
<:60:>,<:61:>,<:62:>,<:63:>));
write(out, if relative then <:. :> else <: :>);
write(out, if wreg > 0 then (case wreg of (<:w1:>, <:w2:>, <:w3:>))
else case function+1 of
(<: :>,<:w0:>,<:w0:>,<:w0:>,<:w0:>,<:w0:>,<:w0:>,<:w0:>,<:w0:>,<: :>,
<:w0:>,<:w0:>,<: :>,<: :>,<: :>,<: :>,<: :>,<:w0:>,<:w0:>,<:w0:>,
<:w0:>,<: :>,<: :>,<:w0:>,<:w0:>,<:w0:>,<:w0:>,<: :>,<:w0:>,<:w0:>,
<: :>,<: :>,<:w0:>,<:w0:>,<:w0:>,<:w0:>,<:w0:>,<:w0:>,<:w0:>,<:w0:>,
<:w0:>,<:w0:>,<:w0:>,<:w0:>,<:w0:>,<:w0:>,<: :>,<:w0:>,<:w0:>,<:w0:>,
<:w0:>,<: :>,<:w0:>,<:w0:>,<:w0:>,<:w0:>,<:w0:>,<:w0:>,<: :>,<: :>,
<: :>,<: :>,<: :>,<: :>));
write(out, if indirect then <: (:> else <: :>);
write(out, case xreg+1 of (<: :>, <:x1:>, <:x2:>, <:x3:>));
write(out, sp, 8-
write(out, if relative or xreg>0 then <<+d> else <<-d>, righthalf,
if indirect then <:) :> else <: :>) );
if relative then write(out, <<-d>, ic + righthalf);
<* prepare next *>
ic:= ic + 2;
end;
end;
\f
comment chd 82.01.20 bossout boss2, testout ...3b...
;
procedure print (z, textstart, hwform, nameform);
<**************>
value textstart, hwform, nameform;
integer textstart, hwform, nameform;
zone z;
begin
<* this procedure can print most of the record types used in testoutput
zone z contains the record, including head <- note <-
global variables that must be set before call:
hws : length of whole record.
type : type from head, or =0 (troubles)
changed: coruno changed, extra nl output.
call parameters:
textstart: word no. from here and on, the rest of record is text.
hwform : a bit for each word in record (1<5 means word 5),
if a bit =1, the word is printed as 2 positive hws.
nameform : bit mask as above, if a bit =1, this word and the next 3
contains a name (in rc8000 name format).
*>
integer pos, firstf, f, i, k, l, npos, ch;
integer field int, name;
if textstart=0 then textstart:= hws; <* no text*>
pos:= 1; <* next pos for a field (a word). max 10 fields in one print line*>
firstf:= if type=0<*troubles*> then 2 else 8;
write(out, nl, if changed then 2 else 1);
if type > 42 then write(out,<<dddd>, type)
else
write(out, case (type+1) of ( <:trou:>,
<* 1*> <:send:>,<:lock:>,<:opch:>,<:open:>,<:exit:>,
<* 6*> <:mess:>,<:answ:>,<:jd-1:>,<:stop:>,<:op :>,
<*11*> <: 11:>,<: 12:>,<:load:>,<:ext :>,<:line:>,
<*16*> <: 16:>,<: 17:>,<: 18:>,<: 19:>,<: 20:>,
<*21*> <: 21:>,<:code:>,<:requ:>,<: 24:>,<:psj1:>,
<*26*> <:psj2:>,<:psj3:>,<:psj4:>,<: 29:>,<: 30:>,
<*31*> <: 31:>,<: 32:>,<: 33:>,<: 34:>,<: 35:>,
<*36*> <: 36:>,<:cl :>,<:p0 :>,<:p1 :>,<:p2 :>,
<*41*> <:p3 :>,<:p4 :>,
<:xxxx:>));
if type>0 then write(out,<<-ddddd.dd>, z.w2/100 <*time*>, <<-ddddddd>, z.w3);
\f
comment chd 82.01.20 bossout boss2, testout ...4...
;
<* special format for exit record *>
if type=5 then write(out, sp, 36);
for int:= firstf step 2 until hws do
begin
f:= int shift(-1); <* word no *>
if pos>10 then
begin
pos:= 1;
write(out,nl,1, sp,21);
end;
if hwform shift(-f) extract 1 =1 then
begin <* print word as 2 positive hws *>
write(out,<<dddd>, z.int shift (-12), << dddd>, z.int extract 12);
pos:= pos + 1;
end
else
\f
<* chd 82.01.20 bossout boss2, testout ...5...
*>
if nameform shift(-f) extract 1 =1 then
begin <*print name (=4 words)*>
npos:= write(out, sp, 1);
l:= int+6;
if l>hws then l:= hws;
for name:= int step 2 until l do
for i:= -16, -8, 0 do
begin
ch:= z.name shift i extract 8;
if ch=0 then npos:= npos + write(out,sp,1)
else
if (ch>47 and ch<58) or (ch>96 and ch<126) <*legal char*>
then npos:= npos + write(out, false add ch, 1)
else
npos:= npos + write(out,<:<60>:>, <<d>, ch, <:<62>:>);
end two loops;
write(out, sp, 18-npos);
pos:= pos+2;
int:= int+6; <*note*>
end
else
if f >= textstart then
begin <*rest of record is text. null-chars are skipped *>
if f=textstart then write(out, sp, 1);
for i:= -16, -8, 0 do
begin
ch:= z.int shift i extract 8;
if ch=0 or ch=127 then <*nothing*>
else
if ch<32 or ch>125 then write(out, <:<60>:>, <<d>, ch, <:<62>:>)
else
outchar(out, ch);
end;
end
else
begin <*print word as integer*>
write(out, << -ddddddd>, z.int);
pos:= pos+1;
end;
end for-do;
end procedure print;
\f
comment fb 1984.07.18 bossout boss2, testout ...5b...
;
procedure writecore (z, first, top, address, wordsline);
value first, top, address, wordsline ;
integer first, top, address, wordsline ;
zone z ;
begin
integer start_address;
integer field contents;
start_address:= first;
write (out, <:<10> (core):>);
for contents:= first step 2 until top do
begin
if (contents-first) mod (wordsline*2) = 0 then
write (out, <:<10> :>, << -ddddddd>, contents-first+address, <:.:>);
write (out, << -ddddddd>, z.contents);
end;
end;
procedure dumpchain;
begin
integer shw;
shw:= hws;
hws:= 6;
print (z, 0, 0, 0);
hws:= shw;
writecore (z, 8, hws, z.w3, 4);
end;
procedure dumpcore;
begin
integer shw;
shw:= hws;
hws:=6;
print (z, 0, 0, 0);
hws:= shw;
writecore (z, 8, hws, z.w3, 10);
end;
\f
comment chd 82.01.20 bossout boss2, testout ...6...
;
<* declaration of variables for bossout *>
integer b1,b2,b3,b4,b5,b6,b7,b8,b9,b10,b11,b12,b13,b14,b15,b16,
b17,b18,b19,b20,b21,b22,b23; <*bit-vars, for call of print*>
integer field w1,w2,w3,w4,w5,w6,w7,w8,w9,w10,w11,w12, w,wa; <*fielding words of record*>
integer array field iaf;
integer x13,x19,x23; <*work, for specific record types*>
integer i,j,k,l,d,t; <*work*>
integer file, kind, filesize, cyclestart, <*file control*>
sno, segmcount, lasts, old, usedsegs;
integer type, coruno, hws, rest; <*record control*>
boolean changed;
long oldtime, stime;
integer swtime;
integer array ia(1:20); <*work*>
real array ra(1:2);
long field montime;
long array field laf, rtol;
real r;
boolean nl, sp; <*for write*>
zone c(10, 1, stderror); <*work, for write*>
<* initialize variables *>
begin
integer procedure p; <*help procedure*>
begin
p:= 1 shift i;
i:= i+1;
end;
i:= 1;
b1:=p; b2:=p; b3:=p; b4:=p; b5:=p; b6:=p; b7:=p; b8:=p; b9:=p;b10:=p;
b11:=p;b12:=p;b13:=p;b14:=p;b15:=p;b16:=p;b17:=p;b18:=p;b19:=p;b20:=p;
b21:=p;b22:=p;b23:=p;
end;
w1:= 2; w2:= 4; w3:= 6; w4:= 8; w5:= 10; w6:=12; w7:=14; w8:=16; w9:=18; w10:=20; w11:= 22;
w12:= 24; montime:= 4;
nl:= false add 10;
sp:= false add 32;
iaf:= 0;
rtol:= 0;
open(c,0,<::>,0);
\f
comment chd 82.01.20 bossout boss2, testout ...6a...
;
<* start up *>
bosshead;
if kind=4 then
begin
monitor(42<*lookupentry*>, z,0,ia);
filesize:= usedsegs:= ia(1);
write(out, <:<10>size of testoutput file =:>, filesize, <: segments.:>);
end
else filesize:= usedsegs:= (-1) shift(-1); <*biggest pos integer*>
i:= system(4,3,ra);
lasts:= if i=(8 shift 12 +4) and kind=4 then round(ra(1))
else filesize;
<*only print out the last 'lasts' segments out of 'usedsegs' in cycle part*>
<*-usedsegs reduced after fixed part, so that empty segments do not count*>
cyclestart:= 0; <*=not def. yet*>
coruno:= -1;
sno:= -1; <*segm no of current segm. count from 0 to (filesize-1)*>
x13:= x19:= 0;
\f
comment chd 82.01.20 bossout boss2, testout ...7...
;
<* read file *>
for segmcount:= 1 step 1 until filesize do
begin
<* this loop is executed once for each segment of the file *>
sno:= sno+1;
if sno=filesize then
begin
setposition(z,0,cyclestart);
sno:= cyclestart;
end;
inrec6(z,512); <*new segment*>
if z.montime=extend 0 then goto nextsegm;
stime:= z.montime;
swtime:= z.w4; <*time value in head of first record on segm*>
if cyclestart>0 <*after type24 record*>
and segmcount <= usedsegs-lasts then goto nextsegm;
r:= z.montime // 10000; d:= systime(4,r,r); t:= r;
write(out,<:<10><10>segm:>, <<dddd>, sno,
if sno = 0 then <: start-up time::> else <::>,
<: 19:>, <<zd>, d // 10000, <:.:>, (d mod 10000) // 100,
<:.:>, d mod 100, <: :>, t//10000, <:.:>,
(t//100) mod 100, <:.:>, t mod 100);
rest:= changerec6(z,4);
while rest>0 do
begin <*take the records of a segment*>
rest:= inrec6(z,2);
if z.w1=0 then goto nextsegm;
l:= z.w1 shift(-6); <*tail length*>
type:= z.w1 extract 6;
rest:= changerec6(z,0);
if l+6 > rest or rest<6 then
begin <*troubles*>
inrec6(z,rest);
hws:= if rest < 20 then rest else 20;
type:= 0;
changed:= false;
print(z,0,0,0);
goto nextsegm;
end;
hws:= l+6;
rest:= inrec6(z,hws);
if type>4 and type<61 and type<>47 then
begin
changed:= coruno <> z.w3;
coruno:= if z.w3<0 or z.w3>511 then 0 else z.w3;
end
else changed:= false;
if changed then x19:= 0;
\f
comment chd 82.01.20 bossout boss2, testout ...8...
;
<*set params for jensen-device*>
fkind := type;
ftime := z.w2;
fthird := z.w3;
fcoruno:= coruno;
frecord(0):= hws;
if fmove then
for w:= 2 step 2 until hws do frecord.w:= z.w;
if fprint or type=9 or type=13 or type=24 then
begin <*print the record*>
if type > 60 then dumpcore
else if type > 57 then dump
else if type > 47 then print (z, 0, 0, 0)
else
case type of
begin
<* 1*>print(z,0,b4,0);
<* 2*>print(z,0,0,0);
<* 3*>print(z,0,b5,0);
<* 4*>print(z,0,0,0);
<* 5*>print(z,0, b9,0);
<* 6*>begin
print(z,0, b6, 0);
if z.w6 shift(-12) extract 1=0 and z.w6 shift(-12) >1 then
begin <* it looks like a parent message *>
integer npos;
write(out, nl, 1, sp, 24, <:parent message: :>);
i:= z.w6 shift(-5) extract 7; <* format bits *>
npos:= write(out, <<d>, z.w6 shift(-12), <:.:>,
i, <:.:>, z.w6 extract 5, sp, 1);
write(out, sp, 8-npos);
i:= z.w6 shift 12; <* first bit of i is now sign-bit*>
for wa:= 14 step 2 until 26 do
begin
j:= z.wa;
npos:= 0;
if i < 0 <* integer *>
then npos:= npos + write(out, << -ddddddd>, j)
else if j = 0 <* empty text portion *>
then npos:= npos + write(out, sp, 9)
else
for j:= -16, -8, 0 do
begin <*text portion*>
k:= z.wa shift j extract 8;
npos:= npos
+ (if k<33 or k>125
then write(out, <:<60>:>, <<d>, k, <:<62>:>)
else write(out, false add k, 1));
end;
write(out, sp, 9-npos);
i:= i shift 1;
end;
end;
end;
\f
comment chd 82.01.20 bossout boss2, testout ...8a...
;
<* 7*>print(z,0,0,0);
<* 8*>print(z,0,0,0);
<* 9 stop-record *>
begin
print(z,0,b15,0);
if hws >= 16 then
begin
write(out, nl, 1, sp, 21);
writeall(z, 8, 14, 0);
end;
end;
<*10*>print(z,0, b5, 0);
<*11*>begin
print(z,0,0,0);
if hws=10 then write(out,<: in core a::>,
if z.w4=0 then 0 else (z.w4//62 +198),
<: b::>, if z.w5=0 then 0 else (z.w5//62 +198));
end;
<*12*>print(z,0,0,0);
<*13*>if x13=0 then
begin
laf:= 6;
write(out, nl, 2, sp, 9, <:installation name: :>, z.laf, nl,1);
x13:= 1;
end
else if hws = 6+56 then
begin <* start-up record, bos *>
hws:= 6+22;
print(z,0,0,b4);
hws:= 6+56;
iaf:= 0;
write(out, <<-ddddddd>,
nl,2,sp,9,<:first logical address of boss-process: :>,
z.iaf(15),
nl,1,sp,9,<:top logical address of boss-process: :>,
z.iaf(16),
nl,1,sp,9,<: size of boss-process (hw): :>,
z.iaf(16) - z.iaf(15),
nl,1,sp,9,<:first logical address actually used: :>,
z.iaf(17),
nl,1,sp,9,<:last logical address actually used: :>,
z.iaf(18),
nl,1,sp,9,<: size of process actually used (hw): :>,
(z.iaf(18) + 2) - z.iaf(17),
nl,1,sp,9,<:cpa (read-only limit): :>,
z.iaf(19),
nl,1,sp,9,<:base (address displacement): :>,
z.iaf(20),
nl,1,sp,9,<:total size of primary storage (hw): :>,
z.iaf(21),
nl,1,sp,9,<:monitor release: :>,
<< dd>, z.iaf(22) shift(-12) extract 12,
<:.:>, <<zd>, z.iaf(22) extract 12, <: (actual):>,
nl,2,sp,9,<:option values::>,
nl,1,sp,9,<:e78 boss release: :>,
<< dd>, z.iaf(23) shift(-12) extract 12,
<:.:>, <<zd>, z.iaf(23) extract 12,
nl,1,sp,9,<:e79 monitor release: :>,
<<-ddddddd>, z.iaf(24), <: (compare with actual, above):>,
nl,1,sp,9,<:e80 jobhost computer: :>,
if z.iaf(25) < 0 then <: rc4000:> else <: rc8000:>,
nl,1,sp,9,<:i4 number of terminals: :>,
z.iaf(26),
nl,1,sp,9,<:i29 number of drum and disc bs-devices: :>,
z.iaf(27),
nl,1,sp,9,<:e23 number of private bs-devices: :>,
z.iaf(28),
nl,1,sp,9,<:i71 number of standard printers: :>,
z.iaf(29),
nl,1,sp,9,<:i190 number of remote printers: :>,
z.iaf(30),
nl,1,sp,9,<:i45 number of psjob coroutines: :>,
z.iaf(31),
nl,1);
end
else print(z,0,b22+b23, b4);
\f
comment chd 82.01.20 bossout boss2, testout ...9...
;
<*14*>print(z,0,0,0);
<*15*>print(z,4,0,0);
<* 16 bsclaims, only before release 19.00 *>
if hws = 10+6 then print(z, 0, b4+b5+b6+b7+b8, 0)
else
if hws = 18+6 then print(z, 0, b4+b5+b6+b7, b8)
else
print(z,0,0,0);
<* 17 catalog entries (hws=6+34), and chaintable heads (hws=6+36) *>
if hws <> 6+34 and hws <> 6+36 then print(z,0,0,0)
else
begin
integer i;
i:= hws; hws:= 6; print(z,0,0,0); hws:= i;
wa:= 8;
if hws = 6+34 then write(out, <: entry::>) else
begin
write(out,<: chain::>, z.wa);
wa:= wa + 2;
end;
write(out, sp,2, z.wa shift (-12),
<:.:>, <<d>, z.wa shift (-3) extract 9,
<:.:>, z.wa extract 3);
wa:= wa + 2; w:= wa + 2;
write(out, z.wa, z.w);
wa:= wa + 4; laf:= wa - 2;
if z.wa = 0 then write(out, z.wa)
else write(out, sp,1, z.laf);
wa:= wa + 8;
if z.wa > 0 then write(out, z.wa)
else write(out, z.wa shift (-12),
<:.:>, <<d>, z.wa extract 12);
wa:= wa + 2; laf:= wa - 2;
if z.wa = 0 or z.wa = 1 then write(out, z.wa)
else write(out, sp,1, z.laf);
for wa:= wa + 8 step 2 until hws do
write(out, z.wa shift (-12),
<:.:>, <<d>, z.wa extract 12);
end;
<*18*>print(z,0, b4+b5+b8, 0);
<*19*>begin
i:= 0; <*skip empty entries in tape table*>
for w:= 8 step 2 until hws do if z.w<>0 then i:= 1;
x19:= x19+1; <*x19:= 0 when changed = true*>
if i=1 then
begin
print(z, 0, b4+b7, b8);
write(out,<: no=:>, <<d>, x19);
end;
end;
<*20*>print(z, 0, 0, b9);
<*21*>print(z, 0, 0, b7+b16);
<* 22 dumped code *>
dump;
<* 23 request lines *>
if hws<10 then print(z,0,0,0)
else
begin
if z.w4=1 then
begin
print(z,0,0,0);
write(out,<: (remove request):>);
end
else
begin
k:= z.w5; <*text length in hws*>
if k<0 then k:= 0;
if hws>k+10 and z.w4=6 then
begin <*remote req.line*>
x23:= hws;
hws:= k+10; <*print until text end*>
print(z, 6, 0, 0);
hws:= x23;
w:= hws-2;
wa:= hws;
write(out,<: (remote) :>, z.w, z.wa);
end
else
print(z, 6, 0, 0); <*other req.lines*>
end;
end;
\f
comment chd 82.01.20 bossout boss2, testout ...10...
;
<*24*>begin
print(z,0,0,0);
write(out,<:<10><10>*end of fixed part<10><12>:>);
<*now, scan the rest of the file, find oldest segm and start there*>
if kind=4 and cyclestart=0 then
begin
old:= cyclestart:= sno+1;
oldtime:= (extend(-1)) shift(-1); <*biggest positive long*>
for i:= cyclestart step 1 until filesize-1 do
begin
inrec6(z,512);
if z.montime<> extend 0 and z.montime<oldtime then
begin
oldtime:= z.montime;
old:= i;
end;
if z.montime = extend 0 then usedsegs:= usedsegs -1;
end;
setposition(z,0,old);
sno:= old-1;
goto nextsegm;
end scan;
end;
<*25*>begin
print(z, 0, b9, b4);
write(out, nl, 1, sp, 21+9*3, <: seconds::>);
sec(10); sec(11); secclock(12);
end;
<*26*>begin
print(z, 0, b5, 0);
write(out, nl, 1, sp, 21+9*1, <: seconds::>);
sec(6); sec(7); secclock(8); sec(9);
end;
<*27*>print(z, 0, b4+b5+b6+b7+b8+b9+b10+b11, 0);
<*28*>print(z, 0, -1<*all*>, 0);
\f
comment chd 82.01.20 bossout boss2, testout ...10a...
;
<* 29 call parameters, lookup host *>
print(z,0,0,0);
<* 30 return parameters, lookup host *>
print(z,0,0,0);
<* 31 call parameters, lookup device and link-up remote *>
if hws < 10 then print(z,0,0,0) else
if z.w5 > 96 shift 16 <* w5 and on contains a name *>
then print(z,0,b11,b5)
else print(z,0,b11,0); <* telex or remote by default-printer *>
<* 32 host message, lookup device and link-up remote *>
print(z,0,b4+b7+b9,0);
<* 33 host output data, lookup device and link-up remote *>
if hws < 14 then print(z,0,0,0) else
if z.w7 > 96 shift 16 <* w7 and on contains a name *>
then print(z,0,b4+b5+b13,b7)
else print(z,0,b4+b5+b13,0); <* probably telex *>
<* 34 host answer, all host operations *>
print(z,0,b4+b7+b9,0);
<* 35 host input data, all host operations (if answer result = 1) *>
if hws < 14 then print(z,0,0,0) else
if z.w7 > 96 shift 16 <* w7 and on contains a name *>
then print(z,0,b4+b5+b13,b7)
else print(z,0,b4+b5+b13,0); <* probably telex *>
<* 36 return parameters, lookup device and link-up remote *>
if hws < 10 then print(z,0,0,0) else
if z.w5 > 96 shift 15 <* w5 and on contains a name *>
then print(z,0,b11,b5)
else print(z,0,b11,0); <* telex or remote by default-printer *>
<* 37 central variables *>
dump;
<* 38 current page0 *>
dump;
<* 39 current page1 *>
dump;
<* 40 current page2 *>
dump;
<* 41 current page3 *>
dump;
<* 42 current page4 *>
dump;
<* 43 backing storage claims, boss, from monitor table *>
bsclaims( <* boss = *> true);
<* 44 bsclaims, boss, difference between new and old *>
bsclaims(true);
<* 45 bsclaims, user, before adjust key3 *>
bsclaims(false);
<* 46 bsclaims, user, after adjust key3 *>
bsclaims(false);
<* 47 core picture dump *>
dumpchain;
end case type;
end printing;
end take records of a segment;
nextsegm:
end take all segment of file;
stop:
end; end;
\f
; btj 30.08.74 last boss2, testout ...11...
; call of last:
; last docname.file_or_bs.blocks_at_end first_coruno.last_coruno <any legal parameters>
; **optional*** **optional** **optional*
(last=set 30 1
last=algol
scope user last
)
begin integer k,c,f,j,i,l; array ra(1:2);
integer array record(0:0);
f:=0; l:=1000; i:= if system(4, 3, ra) shift(-12) = 8 then 4 else 3;
comment if the next two parameters are integers, separated by a point,
then use them as lower and upper limit of corutine numbers;
c := system(4,i+2,ra); comment separator after limits;
j := system(4,i ,ra); comment separator before limits;
k := system(4,i+1,ra); comment separator between limits;
comment evt ra(1) =last_coronu;
if j shift (-12) = 8 then write(out, <:***last param<10>:>)
else begin
if j extract 12 = 4 and k extract 12 = 4
and k shift (-12) = 8
and (c = 0 or c shift (-12) = 4 ) then
begin l:=ra(1); system(4,i,ra); f:=ra(1) end;
bossout(k,0,c,0,record,false,(f<=c and c<=l) or k=14
or k=22 or (37<=k and k<=42) );
comment jensens device:
the parameters k and c are set by the procedure and the last
parameter evaluated with these values;
end
end
\f
▶EOF◀