DataMuseum.dk

top - metrics - download

    Length: 4608 (0x1200)
    Types: TextFileVerbose
    Names: »tlangtime«

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

TextFileVerbose

job polm 1 600 time 11 0 perm mini 100 1 size 90000
mode list.yes
claim
(
o langtimeout
head 1 cpu
pascal80 codesize.12000 spacing.12000 survey.8,
   codelist.yes,
   debugenvir
o c
langextime = set 1 mini
langextime = move langtimeout
if ok.yes
scope user langextime
convert langtimeout
finis)
process languagetimes(var semvector : system_vector);
(***************************************************
*                                                  *
*        language times process                    *
*                                                  *
***************************************************)

(***************************************************
*                                                  *
*  function: language constructions are compilated *
*            and the codelist could be used to in  *
*            calculations of language construction *
*            execution times.                      *
*                                                  *
***************************************************)

const
version=0;
revision=
1
;
write=2;
read=1;
firstindex=6+alfalength;
linelength=80;
lastindex=firstindex+(linelength-1);
opbufsize=80;
tablesize = 10;


type
opbuftype = record
first,
last,
next : integer;
name : alfa;
data : array(firstindex..lastindex) of char;
end;

outputtype = (ptp,mt,disc,tty);
entrytype = record
pred : integer;
succ : integer;
index : integer;
name : alfa;
end;

tabletype = array(0..tablesize) of entrytype;

var
opbufpool : pool 4 of opbuftype;
worksem,
wsem,
wrsem : semaphore;
opinref,
opoutref
: reference;

opsem,opsem1 : ^semaphore;

more,boo1,boo2 : boolean;
firstword,lastword,incharsleft : integer;
i,j,k : integer;

command : char;
workref : reference;
stackref : reference;

table : packed record
used,
free : 0..255;
namelist : tabletype;
end;

dar : array(0..tablesize,0..linelength) of integer;
ar : array(1..linelength) of integer;

procedure outchar(ch : char);
begin
lock opoutref as p : opbuftype do
with p do
begin
last := last + 1;
data(last) := ch;
end;
end; (* outchar *)

procedure outtext(text : alfa);
var
i : integer;
begin
for i := 1 to alfalength do
outchar(text(i));
end;  (*outtext*)

procedure writenl;
begin
if not nil(opoutref) then
begin
outchar(nl);
signal(opoutref,opsem^);
end;
wait(opoutref,wsem);
lock opoutref as p : opbuftype do
p.last := firstindex;
end; (* writenl *)

function readchar : char;
begin
lock opinref as p : opbuftype do
with p do
begin
readchar := data(next);
next := next+1;
end;
incharsleft := incharsleft-1;
end; (* readchar *)

procedure getinput;
begin
repeat
lock opinref as p : opbuftype do
p.next := firstindex;
signal(opinref,opsem^);
wait(opinref,wrsem);
until opinref^.u2 = 0;
lock opinref as p : opbuftype do
with p do
begin
incharsleft := next-first;
next := firstindex;
end;
end; (* getinput *)


(***************************************************
*                                                  *
*            main program                          *
*                                                  *
***************************************************)

begin
alloc(opoutref,opbufpool,wsem);

opoutref^.u1 := write;

lock opoutref as opbuf : opbuftype do 
with opbuf do
begin
first := firstindex;
name := "langtime    ";
data(firstindex) := "*";
end;


return(opoutref);
writenl;


alloc(opinref,opbufpool,wrsem);
opinref^.u1 := read;
lock opinref as opbuf : opbuftype do
begin
opbuf.first := firstindex;
opbuf.last := lastindex;
opbuf.name := "langtime    ";
end;

outtext("langtime    ");

repeat
getinput;

command := readchar;

case command of
"a": i := 1;
"b": i := j;
"c": i := i+1;
"d": i := i+j;
"e": i := ar(1);
"f": i := dar(1,2);
"g": i := ar(j);
"h": i := dar(j,i);
"i": i := table.used;
"j": i := table.namelist(j).succ;
"m": if i > j then i := j*17;
otherwise i := 0;
end;


while more = true do
begin
i := i div 10;
i := i div j;
i := i mod 3;
i := i mod j;
i := i+20;
i := i+j;
i := i-30;
i := i-j;
end;

more := boo1 and boo2;

more := boo1 or boo2;

more := not boo1;

if empty(workref) then more := false;

if more then
begin
alloc(workref,opbufpool,worksem);
alloc(stackref,opbufpool,worksem);
push(workref,stackref);
pop(workref,stackref);
end;

workref:=:stackref;

until true;
end
.

«eof»