|
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: 10752 (0x2a00)
Types: TextFile
Names: »retmont4tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »retmont4tx «
mode list.yes
montest5tx=edit montest4tx
; split dump i monitor release 80.0 og frem
; max internals og max chains i monitor release 81.0 og frem
; forbedrede feltnavne i internals
;
l./integer sep,/,
l./bit, all/, r/bit/bit, bit12/
l./main;/, r/main;/main, no_of_segs_in_dump,
internals, max_internals, chains, max_chains;/
l1, r/quit;/quit, first_time_this_dump, testout;/
l./procedure dump;/, l./integer array iadummy/, r/;/, proc (1:14);/
l./if i > 0 then/, d1, i/
if i = 0 then
begin <*area process created*>
first_time_this_dump := true;
system (5) move core :(
monitor (4) proc descr addr :(zdump, 0, iadummy), proc);
no_of_segs_in_dump := proc (10);
end else
begin
/, p-8
l./dump_area := false/, r/d/ d/, l1, r/e/ e/, p-1
l./procedure commands;/, l./write (out/, l1, r/<:/<:<10>/
l./<:core/, r/core /mem /
l./procedure info;/, l./write(out/, r/(out,<:/ (out,
<:<10>/, p-1
l./dump <dumparea>/, l./core/, r/core/mem /
l1, d3, i/
<:
core
' further commands will refer to the resident core
system, cf. the command dump ':>,
/
l./lines <first line> (.<last line>)/, l./string infor/, d, i/
<:
mem
' further commands will refer to the resident
memory system, cf. the command dump ':>,
/
l./procedure init_pointers;/,
l./if contents(11) <*start of interrupt stack/, d9,i/
monitor_release := contents(13);
oldmon := false ;
move (90, contents);
/, p-5
l./if old_mon/, d2
l./28;/, d, i/
if monitor_release < 80 shift 12 + 0 then
28
else
contents (1);
/, p-4
l./userid:=/, i$
internals := (name_table_end - first_internal) // 2;
chains := (last_bs - first_drum ) // 2;
if monitor_release <= 80 shift 12 + 0 then
begin
max_internals := internals;
max_chains := chains ;
end else
begin
move (1232, contents);
max_internals := contents (1);
max_chains := contents (2);
end;
$, p-12
l./id_array_size:=/, r$(name_table_end-first_internal)//2$max_internals$
l./end init_pointers;/, i/
if dump_area then
write (out, "nl", 1, true, 12, area)
else
write (out, "nl", 1, <:memory :>);
write (out, <:monitor release : :> , <<dd>,
monitor_release shift (-12), <:.:>, <<zd>,
monitor_release extract 12 , <:<10>:>);
outend (out);
/, l1, p-8
l./procedure veri;/, l./else <:core:>/, r/core/memory/
l./procedure type_usernames (/, l./internals,/, r/internals,//
l./internals:=/, d
l./procedure type_names (/, l./internals,/, r/internals,//
l./internals:=/, d
l./integer procedure identification_mask(/, l./internals,/, r/internals,//
l./internals:=/, d
l./procedure external;/, l./<:core:>/, r/core/memory/
l./procedure area_process;/, l./<:core:>/, r/core/memory/
l./procedure chain;/, l./<:core:>/, r/core/memory/
l./<:first slice of chaintable area/,
r/first slice of chaintable area/number of keys /, p-2
l./chains, /, r/chains, //
l./chains:=/, d
l./procedure buf;/, l./<:core:>/, r/core/memory/
l./procedure internal;/, l./<:core:>/, r/core/memory/
l./<:ident/, r/ident /relative, id /, p-1
l./<* stop count/, l./write_formatted/, r/ + bit//
l./for j:= 1 step 1 until 10 do/, r/10/12/
l1, r/72/72,11,200/
l./<:running/, l1, i/
<:running:>,
<:waiting for cpu:>,
/, p-2
l./<* identification/, l1, d, i$
begin
write_formatted ((contents (9) shift (-12) shift 12)//4096, int);
write_formatted ( contents (9) extract 12 , bit12);
end;
$, p-4
l./<* parent description/, l1, d, i$
begin
writeformatted (contents (28), int);
if contents (28) > 0 then
begin
real array pname (1:2);
getdescr_or_name (pname, contents (28), false);
write (out, <: (:>, pname, <:):>);
end;
end;
$, p-8
l./<* quantum /, l1, d, i$
write (out, <<-ddddddd.dddd>,
contents (29)/10000, <: secs:>);
$, p-3
l./<* run time/, l1, d1, i$
write (out, <<-ddddddd.dddd>,
((extend 0 + contents (30)) shift 24 add contents (31))/10000,
<: secs:>);
$, p-3
l./<* start run/, l1, d1, i/
write_clock (contents (32), contents (33));
/, p-1
l./<* start wait/, l1, d1, i/
write_clock (contents (34), contents (35));
/, p-1
l./integer i, j, type/, r/internals, //
l./internals:=/, d
l./procedure write_formatted (/,
l./for i:= 0 step 1 until 7 do/, r/7/8/
l./end case;/, i$
begin <*12 bits*>
for j := 12 step 1 until 23 do
write (out, if word shift j < 0 then <:1:> else <:.:>);
write (out, sp, 2);
end;
$, p-5
l./procedure type_text(/, l6, i$
procedure write_clock (int1, int2);
value int1, int2 ;
integer int1, int2 ;
begin
long l;
real r;
l := (extend 0 + int1) shift 24 add int2;
r := l / 10000;
write (out, << zd dd dd>, systime (4, r, r), r, sp, 2);
end;
$, p-9
l./procedure move (first_addr/, l./integer present_segment/, l1, r/;/, monrel,
addr_last_w_of_dumptable,
first_addr_in_dump, no_of_words_in_dump, segm_offset;/,p-4
l./first_index :=/, i/
own
integer first_addr__low_part, top_addr__low_part, no_of_segs_low__part,
first_addr_high_part, top_addr_high_part, no_of_segs_high_part;
real array ra (1:1);
/, p-4
l./segment := first_addr shift (-9);/, d1, i#
if testout then
write (out,
"nl", 1, <:first time this dump = :>,
if first_time_this_dump then <:true:> else <:false:>);
if first_time_this_dump then
begin <*this dumpfile just connected*>
first_time_this_dump := false;
ifld := 2;
segment := 0;
relative := 64;
setposition (zdump, 0, segment);
inrec6 (zdump, relative );
inrec6 (zdump, 2 );
monrel := zdump.ifld;
if testout then
write (out,
"nl", 1, <:monrel = :>, monrel shift (-12), <:.:>, monrel extract 12);
if monrel < 80 shift 12 then
begin <*contigous dump area*>
first_addr_low_part := 0;
no_of_segs_low_part := no_of_segs_in_dump;
top___addr_low_part := no_of_segs_in_dump * 512;
end else
begin <*split dump*>
relative := 12;
setposition (zdump, 0, segment);
inrec6 (zdump, relative );
inrec6 (zdump, 2 );
addr_last_w_of_dumptable := zdump.ifld;
relative := addr_last_w_of_dumptable - 8;
if testout then
write (out,
"nl", 1, <:addr l w of dumptable = :>, relative);
setposition (zdump, 0, segment);
inrec6 (zdump, relative );
inrec6 (zdump, 2 );
first_addr_low_part := zdump.ifld;
inrec6 (zdump, 2 );
no_of_segs_low_part := zdump.ifld;
top_addr_low_part :=
first_addr_low_part + 512 * no_of_segs_low_part;
inrec6 (zdump, 2 );
first_addr_high_part := zdump.ifld;
inrec6 (zdump, 2 );
no_of_segs_high_part := zdump.ifld;
top_addr_high_part :=
first_addr_high_part + 512 * no_of_segs_high_part;
if testout then
write (out,
"nl", 1, <:f. addr low part = :>, first_addr_low_part,
"nl", 1, <:t. addr low part = :>, top___addr_low_part,
"nl", 1, <:n. segs low part = :>, no_of_segs_low_part,
"nl", 1, <:addr. l. w d.tabl = :>, addr_last_w_of_dumptable,
"nl", 1, <:f. addr high part = :>, first_addr_high_part,
"nl", 1, <:t. addr high part = :>, top___addr_high_part,
"nl", 1, <:n. segs high part = :>, no_of_segs_high_part);
end <*split dump*>;
end <*dump file just connected*>;
if first_addr >= first_addr_low_part and
first_addr < top___addr_low_part then
begin <*low part*>
first_addr__in_dump := first_addr_low_part;
no_of_words_in_dump := (top_addr_low_part - first_addr) / 2;
segm_offset := 0;
if testout then
write (out,
"nl", 1, <:low part ::>,
"nl", 1, <:first addr in dump = :>, first_addr_in_dump,
"nl", 1, <:no of wrds in dump = :>, no_of_words_in_dump,
"nl", 1, <:segment offset = :>, segm_offset);
end else
if first_addr >= first_addr_high_part and
first_addr < top___addr_high_part then
begin <*high part*>
first_addr__in_dump := first_addr_high_part;
no_of_words_in_dump := (top_addr_high_part - first_addr) / 2;
segm_offset := no_of_segs_low_part;
if testout then
write (out,
"nl", 1, <:high part ::>,
"nl", 1, <:first addr in dump = :>, first_addr_in_dump,
"nl", 1, <:no of wrds in dump = :>, no_of_words_in_dump,
"nl", 1, <:segment offset = :>, segm_offset);
end else
begin <*outside dump*>
ra (1) := first_addr;
type_error (s_number, <:addr outside dump area, addr = :>, ra);
first_addr :=
first_addr__in_dump := first_addr_low_part;
no_of_words_in_dump := (top_addr_low_part - first_addr) / 2;
segm_offset := 0;
end;
segment := segm_offset + (first_addr - first_addr_in_dump) shift (-9);
relative := (first_addr - first_addr_in_dump) extract 9 ;
if testout then
write (out,
"nl", 1, <:segment = :>, segment,
"nl", 1, <:relative = :>, relative);
#, p1
l./for word := 1, /, r/ while/
while/, r/ do/ and
word <= no_of_words_in_dump do/, p-1
l./procedure convert_to_number(/, l./real <::>/,
r/real <::> /real <:mem:>/
l1, r/<::> /<:test:>/
l1, r/<::> /<:notes:> add 't'/
l./<* m a i n p r o g r a m *>/,
l./code:= 1 shift 7/, l1, i/
bit12:= 1 shift 8;
/, p-7
l./quit := false;/, l1, i/
first_time_this_dump := false;
testout := false;
/, p-1
l./init_pointers;/, l./;;;/, d, i/
core;
testout := true;
testout := false;
/, p-3
f
end
▶EOF◀