|
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: 15360 (0x3c00)
Types: TextFile
Names: »pascalpass3«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »pascalpass3«
└─⟦this⟧ »pascalpass3«
program pass(input,output,objectcode,tempfile);
label 10; (* halt: *)
const
cal1lib = 3631117;
calllib = 3635213;
alfalength = 12;
maxhalfword = 4096;
numberoflibproc = 45;
segmsize = 256;
zero = 0;
type
(**********************************************)
(* *)
(* Definition of libraryprocedures *)
(* *)
(**********************************************)
libraryprocedure=(
b_runtime_error ,
b_ln ,
b_exp ,
b_sinh ,
b_system ,
b_clock ,
b_arcsin ,
b_sqrt ,
b_date ,
b_time ,
b_arctan ,
b_cos ,
b_sin ,
b_monitor ,
b_fileinit ,
b_reset ,
b_rewrite ,
b_close ,
b_remove ,
b_replace ,
b_write_real ,
b_writeln_real ,
b_write_integer ,
b_writeln_integer,
b_write_boolean ,
b_writeln_boolean,
b_write_char ,
b_writeln_char ,
b_write_string ,
b_writeln_string,
b_put ,
b_writeln ,
b_read_ISO ,
b_readln_ISO ,
b_get ,
b_read_char ,
b_readln_char ,
b_read_integer ,
b_readln_integer,
b_read_real ,
b_readln_real ,
b_readln ,
b_read ,
b_write ,
b_pack ,
b_unpack );
\f
var
objectcode,tempfile : file of integer;
test : boolean;
tail : array Æ1..10Å of integer;
codefilename,tempfilename : alfa;
counter,numberlib,inp,counter2,programsize,
code,libtablesize,currentsegmno : integer;
libnumberofcall : array Æb_runtime_error..b_unpackÅ of integer;
libsegmno : array Æb_runtime_error..b_unpackÅ of integer;
libentryno : array Æb_runtime_error..b_unpackÅ of integer;
librarycounter: libraryprocedure;
librarycontents: array Æb_runtime_error..b_unpackÅ of integer;
\f
value
librarycontents=
(0, (* runtime_error *)
4096,(* ln *)
4098,(* exp *)
4100,(* sinh *)
4102,(* system *)
4104,(* clock *)
8192,(* arcsin *)
8194,(* sqrt *)
8196,(* date *)
8198,(* time *)
12288,(* arctan *)
12392,(* cos *)
12394,(* sin *)
12396,(* monitor *)
16384,(* fileinit *)
16386,(* reset *)
16388,(* rewrite *)
16390,(* close *)
16392,(* remove *)
16294,(* replace *)
20480,(* write_real *)
20481,(* writeln_real *)
20482,(* write_integer *)
20483,(* writeln_integer *)
20484,(* write_boolean *)
20485,(* writeln_boolean *)
20486,(* write_char *)
20487,(* writeln_char *)
20488,(* write_string *)
20489,(* writeln_string *)
20490,(* put *)
20492,(* writeln *)
24576,(* read_ISO *)
24577,(* readln_ISO *)
24578,(* get *)
24580,(* read_char *)
24581,(* readln_char *)
24582,(* read_integer *)
24583,(* readln_integer *)
24584,(* read_real *)
24585,(* readln_real *)
24587,(* readln *)
28672,(* read *)
28673,(* write *)
28674,(*pack *)
28678(* unpack *)
);
\f
procedure libraryproc( cod:integer);
(********************************************)
(* *)
(* This procedure counts the number of *)
(* call of each libraryprocedure. *)
(* *)
(********************************************)
begin
librarycounter:=b_runtime_error;
while ( librarycontentsÆlibrarycounterÅ <> cod ) and
( ord(librarycounter ) <> numberoflibproc ) do
librarycounter:= succ(librarycounter);
libnumberofcallÆlibrarycounterÅ:=
libnumberofcallÆlibrarycounterÅ+1;
libsegmnoÆlibrarycounterÅ:=
librarycontentsÆlibrarycounterÅ div maxhalfword;
libentrynoÆlibrarycounterÅ:=
librarycontentsÆlibrarycounterÅ mod maxhalfword;
end;
procedure createlibtabel;
(********************************************)
(* *)
(* This procedure creates the librarytabel *)
(* on the objectkodefile. *)
(* *)
(********************************************)
begin
libtablesize:=0;
currentsegmno:=-1;
librarycounter:=b_runtime_error;
while ord(librarycounter) <> numberoflibproc do
begin
if libsegmnoÆlibrarycounterÅ <> currentsegmno
then
begin
write(tempfile,libsegmnoÆlibrarycounterÅ);
write(tempfile,libentrynoÆlibrarycounterÅ);
currentsegmno:=libsegmnoÆlibrarycounterÅ;
end
else
begin
write(tempfile,zero);
write(tempfile,zero);
end;
libtablesize:=libtablesize+2;
librarycounter:=succ(librarycounter);
end;
while libtablesize < segmsize do
begin
write(tempfile,zero);
libtablesize:=libtablesize+1;
end;
end;
procedure error(errorno:integer);
(****************************************)
(* *)
(* This procedure is used to print out *)
(* error in pass3. *)
(* *)
(****************************************)
begin
case errorno of
1: writeln('***Temporary file does exist');
2: writeln('***Not possible to create temporary file');
3: writeln('***Input file does not exist');
4: writeln('***Not possible to change input file');
5: writeln('***Not possible to rename temporary file');
end;
goto 10; (* goto halt *)
end;
\f
procedure listlibcall;
(***********************************************)
(* *)
(* This procedure is only in the program for *)
(* testpurpose. It will print out the number *)
(* of call of each libraryprocedure. *)
(* *)
(***********************************************)
begin
librarycounter:=b_runtime_error;
while ord(librarycounter) <> numberoflibproc do
begin
case librarycounter of
b_runtime_error:
write('runtime_error no. call= ':30);
b_ln:
write('ln no. call= ':30);
b_exp:
write('exp no. call= ':30);
b_sinh:
write('sinh no. call= ':30);
b_system:
write('system no. call= ':30);
b_clock:
write('clock no. call= ':30);
b_arcsin:
write('arcsin no. call= ':30);
b_sqrt:
write('sqrt no. call= ':30);
b_date:
write('date no. call= ':30);
b_time:
write('time no. call= ':30);
b_arctan:
write('arctan no. call= ':30);
b_cos:
write('cos no. call= ':30);
b_sin:
write('sin no. call= ':30);
b_monitor:
write('monitor no. call= ':30);
b_fileinit:
write('fileinit no. call= ':30);
b_reset:
write('reset no. call= ':30);
b_rewrite:
write('rewrite no. call= ':30);
b_close:
write('close no. call= ':30);
b_remove:
write('remove no. call= ':30);
b_replace:
write('replace no. call= ':30);
b_write_real:
write('write_real no. call= ':30);
b_writeln_real:
write('writeln_real no. call= ':30);
b_write_integer:
write('write_integer no. call= ':30);
b_writeln_integer:
write('writeln_integer no. call= ':30);
b_write_boolean:
write('write boolean no. call= ':30);
b_writeln_boolean:
write('writeln_boolean no. call= ':30);
b_write_char:
write('write_char no. call= ':30);
b_writeln_char:
write('writeln_char no. call= ':30);
b_write_string:
write('write_string no. call= ':30);
b_writeln_string:
write('writeln_string no. call= ':30);
b_put:
write('put no. call= ':30);
b_writeln:
write('writeln no. call= ':30);
b_read_ISO:
write('read_ISO no. call= ':30);
b_readln_ISO:
write('readln_ISO no. call= ':30);
b_get:
write('get no. call= ':30);
b_read_char:
write('read_char no. call= ':30);
b_readln_char:
write('readln_char no. call= ':30);
b_read_integer:
write('read_integer no. call= ':30);
b_readln_integer:
write('readln_integer no. call= ':30);
b_read_real:
write('read_real no. call= ':30);
b_readln_real:
write('readln_real no. call= ':30);
b_readln:
write('readln no. call= ':30);
b_read:
write('read no. call= ':30);
b_write:
write('write no. call= ':30);
b_pack:
write('pack no. call= ':30);
b_unpack:
write('unpack no. call= ':30);
end;
write(libnumberofcallÆlibrarycounterÅ:4);
write(' segmno = ',libsegmnoÆlibrarycounterÅ:5);
write(' entryno = ',libentrynoÆlibrarycounterÅ:3);
writeln;
librarycounter:=succ(librarycounter);
end;
end;
\f
procedure readalfa(var alf: alfa);
var
i : integer;
a : array Æ1..alfalengthÅ of char;
begin
i:=1;
repeat
read(aÆiÅ);
i:=i+1;
until input^ = ' ';
for i:=i to alfalength do aÆiÅ := ' ';
pack(a,1,alf);
end;
\f
(**********************************)
(* *)
(* H O V E D P R O G R A M *)
(* *)
(**********************************)
begin
get(input);
readalfa(codefilename);
if test then
writeln(' inputname = ',codefilename);
tempfilename:= 'tempvk';
if monitor(42(*lookup entry*),tempfilename,tail) =0
then error(1);
if monitor(42 (*lookup entry*),codefilename,tail) = 0
then programsize:=tailÆ1Å else error(3);
tailÆ10Å:=programsize*4096;
inp:=monitor(44 (*change entry*),codefilename,tail);
if inp <> 0 then error(4);
if test then
begin
writeln(' entrysize = ',programsize);
writeln;writeln;
end;
tailÆ1Å:=programsize+1;
tailÆ2Å:= 1;
(* means that the file are created on disc *)
if monitor(40(*create entry*),tempfilename,tail) <> 0
then error(2);
open(tempfile,tempfilename);
reset(tempfile);
numberlib:=0;
(**************************************************)
(* *)
(* I N I T I A L I S E R I N G *)
(* *)
(**************************************************)
test:=true;
librarycounter:=b_runtime_error;
while ord(librarycounter) <> numberoflibproc do
begin
libnumberofcallÆlibrarycounterÅ:=0;
libsegmnoÆlibrarycounterÅ:=0;
libentrynoÆlibrarycounterÅ:=0;
librarycounter:=succ(librarycounter);
end;
open(objectcode,codefilename);
reset(objectcode);
for counter := 1 to 256 do
begin
read(objectcode,inp);
write(tempfile,inp);
end;
for counter := 1 to programsize do
begin
for counter2 := 1 to 256 do
begin
read(objectcode,code);
write(tempfile,code);
if ( code = calllib ) or ( code = cal1lib ) then
begin
numberlib:=numberlib + 1;
read(objectcode,code);
write(tempfile,code);
libraryproc(code);
read(objectcode,code);
write(tempfile,code);
end;
end;
end;
if test then
listlibcall;
if monitor(46(*rename entry*),tempfilename,codefilename) <> 0
then error(5);
if test then
writeln('number of libraryprocedures = ',numberlib);
(* halt: *)
10:
end.
▶EOF◀