DataMuseum.dk

top - metrics - download

    Length: 2304 (0x900)
    Types: TextFileVerbose
    Names: »debugrouts«

└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
    └─⟦6b41451d2⟧ 
        └─⟦this⟧ »debugrouts« 

TextFileVerbose

prefix except;

procedure except;
label rep;

begin
with own do
begin
printnl;
printtext ('*** #       ');
printtext ('exception: #');
printhex (exception_mask);
printtext (' at: #      ');
printaddr (exic);
printnl;
end;
rep:goto rep;
end;


prefix printchar;
procedure printchar(ch:char);
begin
writeram(8,ord(ch));
end;


prefix printnl;

procedure printnl;
var i: integer;
begin
printchar (cr); printchar (nl);
for i := 1 to 10 do printchar(del);
end;


prefix printtext;


procedure printtext (text:alfa);
var i: integer;
begin
i := 1;
while text(i) <> '#' do
begin
printchar(text(i));
if i = alfalength then text(i) := '#' else i := i + 1;
end;
end;


prefix printnumber;


procedure printnumber(val,size: integer);
var  num: array (1..5) of integer;
     i: integer;
     neg: boolean;
begin
if val = -32768 then
begin
  for size:=size downto 7 do printchar(sp);
  printtext('-32768#     ');
end
else
begin
if val<0 then
begin
neg:=true;
size := size - 1;
val:=-val;
end
else neg := false;
i:=1;
repeat
num(i):=val mod 10 + ord('0');
val:=val div 10;
i:=i+1;
until val=0;
for size:=size downto i do
printchar(sp);
if neg then printchar('-');
for i:=i-1 downto 1 do writeram(8,num(i));
end;
end;


prefix printhex;

procedure printhex (val: integer);
type convarr = array (0..15) of char;
const hextab = convarr('0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f');
var ch1: integer;
begin
if val < 0 then
begin
ch1 := 8;
val := val - (-32768);
end
else
ch1 := 0;

printchar (hextab(ch1 + val div (16*16*16)));
printchar (hextab(val div (16*16) mod 16));
printchar (hextab(val div 16      mod 16));
printchar (hextab(val             mod 16));
end;

prefix printaddr;

procedure printaddr (a: addr);
begin
with a.base do
printhex((((-lockbit * 2 + nill) * 256 + moduletype) * 32 + mem_no) * 2 + nullbit);
printchar('.');
printhex (a.disp);
end;

prefix platoninit;

procedure platoninit;
begin
setexcept; except;
end;
.

«eof»