|
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: 9240 (0x2418)
Types: TextFile
Notes: flxfile
Names: »s28101:1.tuserout main «, »tuserout main «
└─⟦2c579b2cd⟧ Bits:30004129/s28101.imd SW8101/2 BOSS v.2 rel. 2.0
└─⟦4fb120d20⟧
└─⟦this⟧ »s28101:1.tuserout main «
userout = set 50 disc
scope user userout
(userout = algol
end)
begin message versionid : 76 10 28, 3 ;
comment edit1 :
1) all new types in the catalog have been added (58-68)
2) the layout for output has been slightly modified
3) a few comments have been added in relevant places
;
integer i, j, no, bindex, windex, segment, max,
restlines, page, length, type, maxtype,
indexsegm;
integer array dummy (1:10);
zone usercat (128, 1, stderror);
real date, time;
boolean nl, sp;
integer array field wordrec;
boolean array field byterec;
real array field textrec;
comment
length - the length of the current record in bytes.
windex - tells how far we have come in the current record
counted in words.
bindex - as above in bytes. ;
procedure outcr(no);
value no;
integer no;
begin
restlines := restlines - no;
if restlines < 1 then outpage
else write(out, nl,no);
end outcr;
procedure outpage;
begin
page := page + 1;
restlines := 58;
write(out, false add 12,1, sp,40, <:usercat:>,
sp,33, << dd dd dd>, date, << dd dd>, time,
<: page:>, << ddd>, page, nl,2);
if page>1 then write(out,<:segm byte type:>,nl,1);
end outpage;
procedure nextsegment;
begin
segment := segment + 1;
inrec(usercat, 128);
bindex := windex := 0;
end nextsegment;
procedure nextrec;
begin comment the procedure makes the next record
available for printing, and prints a
record head;
integer word;
bindex := bindex + length;
windex := windex + length/2;
if bindex > 510 then nextsegment;
for word := usercat.wordrec(windex) while word = 0 do
nextsegment;
type := usercat.byterec(bindex) extract 12;
length := usercat.byterec(bindex+1) extract 12;
if type < 4 then
begin
if restlines <> 58 then outcr(if type < 2 then 5 else 2);
if restlines < (if type < 2 then 10 else 5) then outpage;
end;
outcr(1);
write(out, <<ddd>, <:(:>, segment, <:,:>, bindex, <:):>,
sp,3, type);
if type extract 1 = 1 then write(out, sp,3, <:max:>);
end nextrec;
\f
procedure int(rel, text);
value rel;
integer rel;
string text;
write(out, sp,3, text, <: = :>, <<d>,
usercat.wordrec(windex + rel/2));
procedure int2(txt);
string txt;
write(out, sp, 3, txt, sp , 2, if usercat.wordrec(windex+1)=0 then
<:no:> else <:yes:>);
procedure double(rel, text);
value rel;
integer rel;
string text;
write(out, sp,3, text, <: = :>, <<d>,
usercat.wordrec(windex + rel/2), <:/:>,
usercat.wordrec(windex + rel/2 + 1));
procedure bytes(rel, text);
value rel;
integer rel;
string text;
write(out, sp,3, text, <: = :>, <<d>,
usercat.byterec(bindex + rel) extract 12, <:/:>,
usercat.byterec(bindex + rel + 1) extract 12);
procedure bitmask(text);
string text;
begin integer word;
write(out,sp,3,text,<: : :>);
word:= usercat.wordrec(windex+1);
for i:=1 step 1 until 24 do
begin
if word<0 then write(out,<:1:>)
else write(out,<:0:>);
word:=word shift 1;
end;
end proc bitmask;
procedure text(rel, txt);
value rel;
integer rel;
string txt;
begin
integer i;
textrec := bindex + rel - 1;
i := 1;
write(out, sp,3, txt, string usercat.textrec(increase(i)));
end text;
procedure bits(rel, text, words);
value rel, words;
integer rel, words;
string text;
begin
integer i, j, word;
write(out, sp,3, text, <: : :>);
for i := 0 step 1 until words-1 do
begin
word := usercat.wordrec(windex + rel/2 + i);
for j := 0 step 1 until 23 do
begin
if (type extract 1 = 0) and (word<0) then <*standard*>
write(out,<< d>,24*i+j);
if (type extract 1 = 1) and (word>0) then <*max*>
write(out,<< d>,24*i+j);
<* the devicemask has the following content
max : 1 - device not allowed
0 - device allowed
std : 1 - device allowed
0 - device not allowed
*>
word := word shift 1;
end
end
end bits;
\f
byterec := 1;
wordrec := 2;
segment := -1;
page := 0;
length := 0;
max := (-1) extract 23;
maxtype := 70;
nl := false add 10;
sp := false add 32;
systime(1, 0, date);
date := systime(2, date, time);
time := time/100;
open(usercat, 4, <:usercat:>, 0);
monitor(52, usercat, i, dummy);
if monitor(8, usercat, i, dummy) <> 0 then
begin
write(out, nl,2, <:*** usercat not available:>);
goto finis;
end;
outpage;
write(out, sp,41, <:indextable:>);
outcr(2);
nextsegment;
indexsegm:= j := 0;
for j := j + 1 while usercat.wordrec(j) < 0 do;
comment the segment number and the projectnumber ending this segment
is written out (i.e. the indextable);
no := 0;
for i := 0, i+1 while no <> max do
begin
no := usercat.wordrec(i - 256*(segment - indexsegm));
write(out, sp,22, <<ddd>, i, << -dddddddd>, no);
if i extract 1 = 1 then outcr(1)
else write(out, sp,10);
if i extract 8 = 255 then nextsegment;
end;
for j := j while j <> segment do nextsegment;
outpage;
\f
next:
nextrec;
if type > (maxtype+1) then goto unknown;
case type//2 + 1 of
begin
begin comment type 0;
int(2, <:project:>);
comment the catalog is finished by a project with the projectnumber 2**23-1
;
if usercat.wordrec(windex+1) = max then goto finis;
double(4, <:max interval:>);
restlines := restlines - 1;
write(out, nl,1, sp,15);
bytes(8, <:rest entries, slices on disc:>);
bytes(10,<:total entries, slices on disc:>);
end;
begin comment type 2;
text(2, <:name : :>);
int(10, <:std interval start:>);
restlines := restlines - 1;
write(out, nl,1, sp,15);
int(12, <:interval length:>);
int(14, <:no of intervals:>);
end;
begin comment type 4;
int(2, <:priority:>);
int(4, <:minimal value of late:>);
end;
begin comment type 6;
text(2, <:device : :>);
bytes(10, <:key 3,rest entries, slices:>);
bytes(12, <:key3,total entries, slices:>);
end;
comment type 8;
bits(2, <:special devices:>, length//2 - 1);
comment type 10;
int(2, <:accounts:>);
comment type 12;
int(2, <:area claim:>);
comment type 14;
int(2, <:buffer claim:>);
comment type 16;
int(2, <:convert buffers:>);
comment type 18;
int(2, <:internal claim:>);
comment type 20;
int(2, <:keys:>);
comment type 22;
int(2, <:mounts:>);
comment type 24;
int(2, <:output:>);
\f
comment type 26;
int(2, <:size:>);
comment type 28;
int(2, <:stations:>);
comment type 30;
int(2, <:tapes:>);
comment type 32;
int(2, <:time:>);
comment type 34;
begin
double(2, <:user max interval:>);
write(out,nl,1,sp,18);
restlines :=restlines-1;
bytes(6, <:key 3, rest user claim:>);
bytes(8, <:key 3, total user claim:>);
end;
comment type 36;
bytes(2, <:drum, key 1, entries, slices:>);
comment type 38;
bytes(2, <:disc, key1, entries, slices:>);
comment type 40;
bytes(2, <:disc, key 3, user entries, slices:>);
comment type 42;
text(2, <:user identification ::>);
comment type 44;
begin
bytes(2, <:drum, key 3, rest entries, slices:>);
bytes(4, <:drum, key 3, total entries, slices:>);
end;
comment type 46;
bytes(2, <:drum, key 3, user entries, slices:>);
begin comment type 48;
text(2, <:device : :>);
bytes(10, <:key3, user entries, slices:>);
end;
comment type 50;
int(2, <:latest finishing time:>);
comment type 52;
text(2, <:project id:>);
comment type 54;
text(2, <:program name:>);
comment type 56;
int(2, <:suspendings:>);
comment type 58 online;
int2(<:online:>);
comment type 60 corelock;
int(2,<:corelock:>);
comment type 62;
int2(<:minimal:>);
comment type 64 start priority;
int(2,<:priority:>);
comment type 66;
int(2,<:max swopout time:>);
comment type 68;
int2(<:preserve:>);
comment type 70 user right bits ;
bitmask(<:userbits :>);
end case-list;
goto next;
\f
unknown:
write(out, sp,3, <:unknown type - contents::>);
outcr(1);
for i := 0 step 2 until length-2 do
begin
write(out, sp,18, <:(:>, <<dd>, i, <:):>, << dddd>,
usercat.byterec (bindex + i ) extract 12,
usercat.byterec (bindex + i + 1) extract 12);
outcr(1);
end;
goto next;
finis:
close(usercat, true);
write(out, <:<12>:>);
end program;
\f
▶EOF◀