|
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: 43776 (0xab00)
Types: TextFile
Names: »accosumtxt«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦baac87bee⟧ »gi«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦baac87bee⟧ »gi«
└─⟦this⟧
; account sum * page 1 2 04 80, 10.49;
(
accosum = set 1
accosum = algol
if ok.no
mode warning.yes
if warning.yes
(mode 0.yes
message accosum not ok
lookup accosum)
if 0.no
scope project accosum
copy message.no 33.1
acc = set 1
acc = copy message.no 33.1
if ok.no
(mode 0.yes
message accountjob not ok
lookup accountjob)
acc = indate
lookup acc
end
)
\f
; account sum * page 2 2 04 80, 10.49;
; a c c o u n t - s u m .
; ***********************
begin comment
Acco sum.
_________
A program for summation of account records
from the operating system boss 2.
Updated jan 1977, Willy Weng.
Syntax of call:
_______________
_ *
_ ( <file> )
<out> = acco_sum < >
_ ( <param> )
<out> ::= <bs name>
_ ( <mt name> <file nos> )
<file> ::= < >
_ ( <bs name> )
<bs name> ::= <text>
<mt name> ::= <text>
_ 2
_ ( )
<file nos> ::= < .<file no> >
_ ( )
_ 0
<file no> ::= <integer>
_ ( <bool param> )
<param> ::= < <user selection> >
_ ( <int param> )
_ ( test ) ( yes )
<bool param> ::= < print > . < >
_ ( kbon ) ( no )
_ ( clear )
_ ( page )
_ ( paper )
_ ( users )
<int param> ::= < pris > . <integer>
_ ( first )
_ ( segm )
_ ( proj )
_ 1
_ ( )
<user selection>::= user . <user name> < . <project> >
_ ( )
_ 0
<user name> ::= <text>
<project> ::= <integer>
The value proj.all of <int param> is also allowed.
;
\f
comment account sum * page 3 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
comment
Semantic of Call:
_________________
The three parameters <file>, <out> and <param> specify the
input, output and the mode of the program.
*
<file>
The format of the input files are given in Søren Lauesen:
BOSS 2, Instatallation and Mantenance, RCSL31-D313, ISBN
87 7557 015 7, chapter six.
Only backing storage or magnetic tape files can be used in
the same call. In the magtape case first and last file on
each tape can be specified (default value 1, infinity). It
is assumed that each tape file is written by save (RCSL31-
D335) and that it consist of one entry with the name ac-
count ffile (This requirement is met by the magnetic tapes
made by the routine account job. The operator can tell you
which tapes and which files to use if you want some old pe-
riod).
*
<out>
The output file must be a backing storage area. If it
don't exist it will be created with scope temp. (Caution:
If you use print.yes a temporary file will disappeear af-
ter convert.)
*
<param>
The function of the program can be modified in various
ways, especialy selection of the users, projects and day
interval to contribute to the summation.
The faur boolean parameters has defoult value no. The func-
tion of value yes are:
test : test output
print: convert output file
kbon : output of each account record
clear: clear of input file
The default value and the meaning of the integer parame-
page : 1, no of first page in output
paper: 0, paper format for convert
users: 120, size of internal table of user statistics
pris : 112, price index, jan 1973 = 112
first: 0, first date to be used in summation
last : 999999, last date to be used in summation
segm : 9, segments per block in magtape save
proj : <empty>, the projects to contribute to the sum,
_ value all is alloved, equivalent to
_ proj.51 proj.52 proj.53 proj.3002,
_ proj.6001 proj.6002 proj.7001 proj.8001
;
\f
comment account sum * page 4 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
comment
The parameter user can be used to specify which users to
be used in the summation. If no project no i present the
user name is used in all projects.
If no user selection (parameter user or proj) are used all
account records in the day interval are used.
Wage Regulation Index.
______________________
The acco_sum program use the 'wage regulation index'
(reguleringspristal) with base january 1971 = 100
to compute a 'price'. By means of the fp-parameter
pris the actual value of the index can be assigned.
However, the base of the official wage regulation
index has been changed to january 1975 = 100. The
relation between a 1971-index and a 1975-index come
from the january 1975 value of the 1971-index. This
value is 147, so
index(base 1971) := index(base 1975) * 1.47.
To assist you in selecting the correct index a
table of the value of the wage regulation index for
january is given:
Year Base 71 Base 75
1971 100 ...
1972 106 ...
1973 114 ...
1974 129 ...
1975 147 100
1976 160 109
1977 173 118
*
As the job file of the routine accountjob is unac-
cessible when boss is running, it is in this case
unattractiv to use the fp-parameter pris to vary
the regulation index. So another way to assign it
exist. The program acco_sum looks after an entry na-
med 'accoprice' and if it exist the value of tail(8)
(the one just after date and time) is used as index
(with base 1975, i.e. the value of tail(8) is multi-
plied by 1.47 before used in price computations).
This can also be used by ordinary users. Use fp-com-
mands like
acco_price = set ip 0 0 0 <index, base 1975>
<output> = acco_sum <param>
;
\f
comment account sum * page 5 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
integer procedure iso_date(date);
_________________________________
value date;
integer date;
comment convert a date in form ddmmyy to form yymmdd;
iso_date:= (date mod 100) * 100 00 +
_ (date mod 100 00) // 100 * 100 +
_ date // 100 00;
\f
comment account sum * page 6 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
integer procedure write_date(zout, date);
_________________________________________
value date;
integer date;
zone zout;
begin
comment Datoen i date (på formen dag*10000+måned*100+
år mod 100) udskrives på formen
<ugedag> den <dag>.<måned> 19<år>
på zonen zout, der skal være åben og klar til
karakter output.
willy weng, gi, 25 03 74;
integer år, måned, dag, uge_dag;
år := date mod 100;
måned := (date//100) mod 100;
dag := date//10000;
uge_dag := (år*365 +
(år - (if (år>3 and måned<3) then 1 else 0))//4 +
(case måned of(
0, 31, 59, 90, 120, 151,
181, 212, 243, 273, 304, 334)) +
dag) mod 7;
comment størelsen der tages mod 7 er antallet
af dage siden 0.januar 1900, der var en søndag;
write_date:= write(zout, case (ugedag + 1) of (
<:søndag:>, <:mandag:>, <:tirsdag:>,
<:onsdag:>, <:torsdag:>, <:fredag:>,
<:lørdag:>), <: den:>, << d>, dag,
<:.:>, case måned of (
<:januar:>, <:februar:>, <:marts:>,
<:april:>, <:maj:>, <:juni:>,
<:juli:>, <:august:>, <:september:>,
<:oktober:>, <:november:>, <:december:>),
<< dddd>, 1900+år);
end write_date;
\f
comment account sum * page 7 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
integer procedure conv(file, paper);
____________________________________
value paper;
zone file;
integer paper;
begin
comment
Convert the file given in the description of the zone
file using paper-type given by the parametre paper.
conv (integer, return value). The answer from boss
_ on the convert message:
_ 0 - convert ok
_ 1 - cbufs exceeded
_ 2 - file not visible
_ 3 - file has login scope
_ 4 - temporary resources insufficient
_ 5 - file in use
file (zone, call value). Gives the name of
_ the file to be converted to printer.
paper (integer, call value). The paper format used.
_ Value zero gives standard.
In case of error-answer from boss (conv<>0) the
coresponding text will be written on current output.
;
\f
comment account sum * page 8 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
integer procedure parent_message(mes);
______________________________________
integer array mes;
begin
comment send the message in mes to
the parent, ie. the operating-system
executing the program;
integer i,
_ parent_addr,
_ mode_kind;
real array parent_name(1:2);
integer array sh_des(1:12);
zone parent(1, 1, stderror);
parent_addr:= system(8, mode_kind, parent_name);
i := 1;
open(parent, mode_kind, string(parent_name(increase(i))), 0);
get_share(parent, sh_des, 1);
for i:= 4 step 1 until 11 do
sh_des(i):= mes(i-4);
set_share(parent, sh_des, 1);
i:= monitor(16)send_message_to:(parent, 1, sh_des);
if i=0 then system(9, 0, <:<10>bufclaim:>);
if mes(0) extract 5 = 0 then
i:= monitor(18)wait_answer_from:(parent, 1, mes);
parent_message:= i;
end parent_message;
\f
comment account sum * page 9 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
comment variabel declaration of procedure conv;
integer p;
integer array zone_des(1:20),
_ mes_buf (0:7);
comment bild the message;
mes_buf(0):= 30 shift 12 add (1 shift 9);
mes_buf(1):= real <:conv:> shift (-24) extract 24;
mes_buf(2):= real <:conv:> extract 24;
mes_buf(3):= paper;
get_zone(file, zone_des);
for p:= 4 step 1 until 7 do
mes_buf(p):= zone_des(p-2);
comment send the message;
p:= parent_message(mes_buf);
if p <> 1 then system(9)run_time_alarm:(p, <:<10>print :>);
if mes_buf(0) <> 0 then
write(out, <:<10>convert error : :>,
case (mes_buf(0)) of (
<:cbufs exceeded:>,
<:file not visible:>,
<:file has login scope:>,
<:temoprary resources insufficient:>,
<:file in use:>)) ;
conv:= mes_buf(0);
end conv;
\f
comment account sum * page 10 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
integer procedure new_acc(z, i);
________________________________
zone z;
integer i;
begin
comment
Inrec of a new account record of 32 bytes from zone z.
The parameter i is the rest in current block.
The first two double words of
save's segment records are skiped.
In the normal case the length of the rest of
current block is returned.
In case of error the value -1 is returned as the
value of the procedure.
The global variable mt is used to select bs or mt.
In case of mag-tape the global variable segm is
used in a check of the block-length.
;
integer field type, length;
comment TEST: :
write(out, nl, 1, <:call af new-acc with blockrest =:>,
<< d>, i);
type := 2;
length:= 4;
if mt then
begin
if i = 0 then
begin
i:= in_rec_6(z, 0);
comment TEST: :
write(out, <:<10>inrec-zero, blockrest =:>,
<< d>, i);
if i >= 8 then
begin
i:= in_rec_6(z, 8);
if z.type <> 2
or z.length > 8 + 4*128*segm then
begin
i := -1;
if z.type <> 2 then
write(out, nl, 1, <:forkert record type_:>, z.type)
else
write(out, nl, 1, <:brug segm.:>, (z.length - 8)//512);
end;
end if i>=8;
end i=0;
new_acc:= if i < 32 then -1 else in_rec_6(z, 32);
end mt
else new_acc:= in_rec_6(z, 8*4);
end new_acc;
\f
comment account sum * page 11 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
comment declaration of global variabels;
_ ________________________________
integer array dummy(1:1),
_ ffile, lfile(1:10),
_ selected_project(1:10);
long array selected_user(1:20, 1:3);
real array file_name(1:10, 1:2),
_ sel_stat, sel_par1, sel_par2(1:4);
integer i, date, clock,
_ paper, page, users,
_ jobs, logins, tab,
_ j, to_day, pristal,
_ first_day, last_day, days,
_ last_in_day, first_in_day, priv_day,
_ extrnl_regulation_index, price_base,
_ no_rec, file_group, file_groups,
_ segm, max_sel_user, max_sel_proj,
_ file_no, last_file, first_file,
_ block_rest, intern_no, max_no,
_ h1, h2;
real plotfaktor, punchfaktor, cardfaktor,
_ printerfaktor, readerfaktor, sizefaktor,
_ tempdiscfaktor, stationsfaktor,
_ jobpoint, pointgrænse1, pointgrænse2,
_ loadpris, mountpris, loginpris,
_ pointpris,
_ pointrabat1, pointrabat2,
_ operationspris,
_ sidepris, liniepris,
_ standardpapir, specialpapir,
_ faktor, point, jobpris,
_ selcpu, selpris;
real first, last, t, k, now,
_ total, hours;
long prvers;
boolean test, kbon, print, clear, left,
_ sp, nl, ff, mt, bs, set_first_in_day,
_ read_file_names, selection,
_ selected, not_found, version;
zone zout (128*2, 2, stderror);
boolean field mounts, loads, tempdrum, tempdisc, stations, size;
integer field kind, project, param1, param2, cputime, papertype,
_ deviceword1, param3, int_f;
long field time, user1, user2;
array field user;
\f
comment account sum * page 12 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
comment init of cost-variabels;
_ _______________________
comment modif of special faktor;
plotfaktor := 0;
punchfaktor := 0.2;
cardfaktor := 0;
readerfaktor := 0.5;
printerfaktor:= 0.5;
sizefaktor := 0.01;
tempdiscfaktor:= 0.0002;
stationsfaktor:= 0.05;
comment point;
jobpoint := 3;
pointgrænse1 := 250;
pointgrænse2 := 1000;
comment price-list;
loadpris := 5;
mountpris := 10;
loginpris := 75;
pointpris := 0.2;
pointrabat1 := 0.05;
pointrabat2 := 0.05;
operationspris:= 0.05;
sidepris := 0.10;
liniepris := 0.015;
standardpapir:= 5;
specialpapir := 15;
begin
zone price (1, 1, std_error);
integer array tail(1:10);
integer i;
open(price, 0, <:accoprice:>, 0);
if monitor(42)look_up_entry:(price, i, tail) = 0 then
begin
comment the entry <:acco_price:> exist and is
assumed to hold the 'wage regulation index' to
be used. Base jan 1975 = 100 is assumed;
price_base:= 2;
extrnl_regulation_index:= tail(8);
comment adjust to base jan 1971 = 100;
pris_tal:= extrnl_regulation_index * 1.47;
end
else
begin
price_base:= 1 <* jan 1971 = 100 *>;
extrnl_regulation_index:= pris_tal:= 112 <* jan73 *>;
end;
end;
\f
comment account sum * page 13 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
comment init of field variabels;
project := 2;
user := 2;
user1 := 6;
user2 := user1+4;
kind := 12;
time := 16;
param1 := 18;
param2 := 20;
param3 := 22;
mounts := 19;
loads := 20;
cputime := 22;
papertype := 22;
tempdrum := 23;
tempdisc := 24;
stations := 25;
size := 26;
deviceword1:= 28;
comment get date and time;
systime(1, 0, now);
to_day:= systime(2, now, now);
now := now/10000;
prvers:= 2 04 80 10 49;
comment init of fp-param;
page := 1;
paper := 0;
test := false;
kbon := false;
print := false;
clear := false;
users := 120;
first_day:= 0;
last_day := 999999;
comment init of file name reading;
file_group:= file_groups:= 1;
file_name(file_group, 1):= real <:accou:> add 110 <* n *>;
file_name(file_group, 2):= real <:tfile:>;
ffile(file_group):= lfile(file_group):= 0;
mt:= bs:= false;
read_file_names:= true;
segm:= 9;
\f
comment account sum * page 14 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
comment init of selection;
max_sel_user:= 0;
max_sel_proj:= 0;
selection := false;
comment init of char variabels;
sp := false add 32;
nl := false add 10;
ff := false add 12;
first := 1.6'616;
last := -1.6'616;
comment other init;
tab := 26;
jobs := 0;
logins:= 0;
no_rec:= 0;
days := 0;
hours := 0;
max_no:= 0;
priv_day:= 0;
first_in_day := 0;
last_in_day := 0;
set_first_in_day := true;
\f
comment account sum * page 15 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
begin
comment reading of fp-param;
_ ____________________
integer param_no, i, s, sepa,
_ length, s_save, name_no,
_ bools, int, total;
boolean b;
real array name, param(1:2);
procedure alarm(text);
string text;
begin
comment write the alarm-text on current
output;
i:= 1;
sepa:= s shift (-12);
length:= s extract 12;
write(out, <:<10>***:>,
string(name(increase(i))),
<: :>, text);
if s<> 0 then
begin
write(out,
<: (:>, <<d>, param_no,
<:, :>, case ((sepa+6)//2) of (
<:'end of command list':>,
<:'end parenthesis':>,
<:'begin parenthesis':>,
<:'nl':>,
<:<60>s<62>:>,
<:=:>,
<:.:>));
i:= 1;
if length = 10 then
write(out, string(param(increase(i))))
else if length = 4 then
write(out, <<d>, param(1));
write(out, <:):>);
param_no:= param_no + 1;
end if s <> 0;
end alarm;
\f
comment account sum * page 16 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
bools:= 4;
int := bools + 8;
total:= int + 2;
system(2, i)program_name:(name);
param(1):= param(2):= real <::>;
s_save:= s:= system(4)read_fp_param:(1, param);
if s shift (-12) = 6 then
begin
comment left side in call;
integer array tail(1:12);
left:= true;
param_no:= 3;
s_save:= system(4, 2, param);
i:= 1;
s_save:= system(4, 2, param);
system(4, 0, param);
open(zout, 4, string(param(increase(i))), 0);
s:= monitor(42)lookup_entry:(zout, i, tail);
tail(1):= 36;
for i:= 2 step 1 until 12 do tail(i):= 0;
if s<> 0 then
s:= monitor(40)create_entry:(zout, i, tail);
if s<> 0 then
system(9)run_time_alarm:(s, <:<10>create :>);
end if s shift (-12) = 6
else
begin
comment no output;
left:= false;
s:= 0;
alarm(<:no output:>);
system(9)run_time_alarm:(0, <:<10>sorry :>);
end if no left side;
s:= system(4, param_no, param);
sepa:= s shift (-12);
if s_save = 0 or (s<>0 and sepa<>4) then
begin
comment no input file;
param_no:= param_no-1;
s:= system(4, param_no, param);
sepa:= s shift (-12);
end if s_save or;
\f
comment account sum * page 17 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
for length:= s extract 12 while sepa >= 4 do
begin
comment read the next pair
of fp-param;
if sepa = 8 then alarm(<:point:>)
else if sepa <> 4 then
system(9, param_no, <:<10>fperror1:>)
else if length = 4 then alarm(<:integer:>)
else if length <> 10 then
system(9, param_no, <:<10>fperror2:>)
else
begin
comment name param with
preceding sp read;
name_no:= 0;
if param(2) = real <::> then
for i:= 1 step 1 until total do
if param(1) = real(case i of (
<* boolean *>
<:test:>, <:print:>, <:kbon:>,
<:clear:>,
<* integer *>
<:page:>, <:paper:>, <:users:>,
<:pris:>, <:first:>, <:last:>,
<:segm:>, <:proj:>,
<* text *>
<:user:>, <:proj:>,
<::>)) then
begin
name_no:= i;
i:= total
end if param(1) = real(case;
\f
comment account sum * page 18 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
if name_no > 0 then
begin
comment name recognized;
param_no:= param_no + 1;
s := system(4, param_no, param);
sepa := s shift (-12);
length := s extract 12;
if name_no = 12 <*proj*>
and length = 10 <*<text>*>
and param(1) = real <:all:>
then name_no := 14 <*proj.all*>;
if sepa <> 8
or (if name_no <= bools
_ then (length <> 10
_ or (param(1) <> real <:yes:> and
_ param(1) <> real <:no:>))
_ else if name_no <= int
_ then length <> 4
_ else if name_no <= total
_ then length <> 10
_ else false add system(9, param_no, <:fperror3:>))
then alarm(<:value:>) else
begin
comment value type ok;
i:= param(1);
b:= param(1) = real <:yes:>;
case name_no of
begin
test := b;
print := b;
kbon := b;
clear := b;
page := i;
paper := i;
users := i;
begin
extrnl_regulation_index:=
pristal:= i;
price_base:= 1 <* jan 71 = 100 *>;
end;
first_day:=iso_date(i);
last_day :=iso_date(i);
segm := i;
begin
comment selection of project;
max_sel_proj:= max_sel_proj + 1;
selection:= true;
selected_project(max_sel_proj):= i;
end fp-param proj;
\f
comment account sum * page 19 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
begin
comment selection of user;
max_sel_user:= max_sel_user + 1;
selection:= true;
for i:= 1, 2 do
selected_user(max_sel_user, i):= long param(i);
s:= system(4, param_no + 1, param);
if s shift (-12) extract 12 = 8 <* point *>
and s extract 12 = 4 <* integer *>
then
begin
param_no:= param_no + 1;
selected_user(max_sel_user, 3):= param(1);
end
else
selected_user(max_sel_user, 3):= 0;
end fp-param user;
if param(1) = real <:all:>
then
begin
selection:= true;
max_sel_proj:= 9;
for i:= 1 step 1 until max_sel_proj do
selected_project(i):= case i of (
_ 51, 52, 53, 3002, 6001,
_ 6002, 6003, 7001, 8001);
end param(1) = <:all:>
else
param_no := param_no -1 <* provoke error message *>;
end case name_no of;
param_no:= param_no + 1;
end if value type ok
end if name_no > 0
\f
<* account sum * page 20 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 *>
else
begin
comment unknown parametre name;
if read_file_names then
begin
comment read input file names;
for i:= 1, 2 do
file_name(file_group, i):= param(i);
if param(1) shift (-32) extract 16
= <:mt:> shift (-32) extract 16
then
begin
mt:= true;
ffile(file_group):= 1;
lfile(file_group):= 8 388 607;
i:= 1;
for s:= system(4, param_no + 1, param)
while s shift (-12) extract 12 = 8 <* point *>
and s extract 12 = 4 <* integer *>
and i <= 2 do
begin
case i of
begin
ffile(file_group):= param(1);
lfile(file_group):= param(1);
end case i of;
i:= i + 1;
param_no:= param_no + 1;
end for s;
if bs then alarm(<:mt after bs:>);
end mt
else
begin
bs:= true;
ffile(file_group):= lfile(file_group):= 0;
comment include lookup on input file;
if mt then alarm(<:bs after mt:>);
end bs;
i:= 1;
comment TEST: :
write(out, nl, 1, if mt then <:mt :> else <:bs :>,
<< dd>, file_group, ffile(file_group), lfile(file_group),
string file_name(file_group, increase(i)));
file_groups:= file_group:= file_group + 1;
for param_no:= param_no + 1
while system(4, param_no, param) shift (-12)
_ extract 12 = 8 <* point *>
do alarm(<:suffix on file name:>);
end read_file_names
else
begin
comment unknown param is not file name;
alarm(<:param:>);
for param_no:= param_no + 1 while
(system(4, param_no, param) shift (-12)
extract 12) = 8 do;
end unknown not file;
end if unknown;
end name param read;
\f
comment account sum * page 21 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
s:= system(4, param_no, param);
sepa:= s shift (-12);
end for length:= s extract 12 ;
end reading of fp-param;
if mt and bs then
system(9)run_time_alarm:(0, <:<10>in-files:>);
if file_groups > 1 then file_groups:= file_groups - 1;
comment write date, time and version;
write(z_out, <:<10>Account sum.<10>:>, false add 42, 12,
<:<10><10>Version:>,
<< dd dd dd>, prvers/10000, <:, :>,
<<dd.dd>, (prvers mod 10000) / 100,
<:, <10>kørt :>);
write_date(z_out, to_day);
write(z_out, <: kl.:>, << dd.dd>, now, <:.<10>:>);
if selection then
begin
if fp_mode(11) then
write(z_out, nl, 2,
<:Kontering for udvalgte brugere/projekter:>);
if max_sel_user > 0 then
write(z_out, <:<10><10>Bruger::>);
for i:= 1 step 1 until max_sel_user do
begin
j:= 1;
j:= write(z_out, nl, 1,
string selected_user(i, increase(j)));
if selected_user(i, 3) = 0
then write(z_out, sp, 6 - j, <:alle projekter:>)
else write(z_out, sp, 12 - j,
_ << dd dddd>, selected_user(i, 3));
end for i;
if max_sel_proj > 0 then
write(z_out, <:<10><10>Projekt::>);
for i:= 1 step 1 until max_sel_proj do
write(z_out, nl, 1, <<dd dddd>, selected_project(i));
write(z_out, nl, 2);
end selection;
\f
comment account sum * page 22 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
if users>0 then
begin
comment array decl block;
integer array project_cat,
_ mount, load(1:users);
integer array stat,
_ par1, par2 (1:users, 1:4),
_ device (1:users, 18:22);
real array user_cat (1:users, 1:2),
_ cpu, pris (1:users);
long array name(1:2);
long array field name_f;
zone z(2 * (if mt then (2 + 128*segm) else 128),
_ 2, std_error);
\f
comment account sum * page 23 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
for file_group:= 1 step 1 until file_groups do
begin
mt:= file_name(file_group, 1) shift (-32) extract 16
= <:mt:> shift (-32) extract 16;
first_file:= ffile(file_group);
last_file := lfile(file_group);
i:= 1;
comment TEST: :
write(out, nl, 1, <:open :>,
if mt then <:mt:> else <:bs:>,
<< dd>, file_group, ffile(file_group), lfile(file_group),
string file_name(file_group, increase(i)));
i:= 1;
open(z, if mt then 18 else 4,
_ string file_name(file_group, increase(i)), 0);
for file_no := first_file, file_no + 1
while file_no <= last_file
and version
do
begin
set_position(z, file_no, 0);
version:= true;
if mt then
begin
block_rest:= in_rec_6(z, 13*4);
if block_rest <> 48 then
system(9, block_rest, <:<10>mtdumpl1:>);
name_f:=0;
if fp_mode(10) then
write(out, nl, 1, z.name_f);
for int_f:= 6 step 2 until 12 do
for j:= -16 step 8 until 0 do
if z.int_f shift j extract 8 = 32 <* sp *>
then z.int_f:= z.int_f shift (j-8) shift (-j+8)
add (z.int_f extract (-j));
i:= 1;
comment TEST: :
write(out,
string pump(z), nl, 1,
string file_name(file_group, increase(i)), nl, 1);
version:= z(5) = real <:vers.:> add 32
and z(2) = file_name(file_group, 1)
and z(3) = file_name(file_group, 2);
comment TEST: :
write(out, <:Dump label :>,
if version then <:version:> else <:empty:>);
end mt;
\f
comment account sum * page 24 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
if version then
begin
if mt then
begin
block_rest:= in_rec_6(z, block_rest)
<* skip rest of dump-lable *>;
if block_rest <> 0 then
system(9, block_rest, <:<10>mtdumpl2:>);
if in_rec_6(z, 4*25) <* entry record *> <> 0
or z(1) shift (-24) extract 24 <> 1
or z(3) <> real <:accou:> add 110
or z(4) <> real <:tfile:>
then block_rest:= -1 <* skip file *>;
comment TEST: :
write(out, nl, 1, <:file name :>,
if block_rest <> -1 then <:accountfile:> else <:error:>);
if -, version then block_rest:= -1;
end mt;
for block_rest:= new_acc(z, block_rest)
while (if block_rest < 0 then false else z.kind <> 99) do
begin
k:= z.time //10000;
date:= systime(2)convert_time:(k, t);
clock:= t;
date:= iso_date(date);
selected:= first_day <= date and date <= last_day;
if selected and selection then
begin
selected:= false;
for i:= 1 step 1 until max_sel_user do
if z.user(1) = real selected_user(i, 1)
and z.user(2) = real selected_user(i, 2)
and (selected_user(i, 3) = 0 or
_ selected_user(i, 3) = z.project)
then
begin
selected:= true;
i:= max_sel_user;
end for i;
if -, selected then
begin
for i:= 1 step 1 until max_sel_proj do
if z.project = selected_project(i) then
begin
selected:= true;
i:= max_sel_proj;
end for i;
end -, selected;
end selected and selection;
\f
comment account sum * page 25 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
if selected then
begin
comment account record in day-interval
and selected;
no_rec:= no_rec + 1;
if priv_day <> date then
begin
comment new day;
priv_day:= date;
days:= days+1;
hours:= hours + (last_in_day - first_in_day)/60;
set_first_in_day:= true;
end new day;
last_in_day:= clock//10000*60 + clock mod 10000 // 100;
if set_first_in_day then
begin
first_in_day := last_in_day;
set_first_in_day := false;
end;
if k < first then first:= k;
if k > last then last := k;
if kbon then
begin
comment write account file log;
write(z_out, nl, 2);
date:=systime(2, k, t); clock:=t;
i:= 1;
if z.kind>3 then
write(z_out, sp, 9-write(z_out, <<d>, z.kind))
else
write(z_out, case z.kind of (<:job :>,
<:logout :>, <:print :>));
write(z_out, sp,
16-write(z_out, string z.user(increase(i))),
<<dddddd>, z.project, <: :>,
<<dddddd>, z.project, <:___:>,
<<_dd_dd_dd>, date, clock,
<<_-dddddd>, z.param1);
if z.kind=1 then
begin
write(z_out, << -ddddddd>, entier(z.cputime*0.8192),
(z.size extract 12)*512, <:<10>:>,
sp, 7, (z.tempdrum extract 12)*4,
(z.tempdisc extract 12)*8, z.loads extract 12,
z.stations extract 12, z.mounts extract 12, <: :>);
if z.deviceword1 shift (-22) extract 1 = 1 then
write(z_out, <: read:>);
if z.deviceword1 shift (-21) extract 1 = 1 then
write(z_out, <: print:>);
if z.deviceword1 shift (-20) extract 1 = 1 then
write(z_out, <: card:>);
if z.deviceword1 shift (-19) extract 1 = 1 then
write(z_out, <: punch:>);
if z.deviceword1 shift (-18) extract 1 = 1 then
write(z_out, <: plot:>);
end else
begin
write(z_out, << -ddddddd>, z.param2);
if z.kind=3 then
write(z_out, << -ddddddd>, z.papertype);
end;
end if kbon;
\f
comment account sum * page 26 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
comment make sums;
not_found:= true;
intern_no:= 0;
for intern_no:= intern_no+1 while intern_no<=max_no and not_found do
not_found:= (project_cat(intern_no) <> z.project)
or (user_cat (intern_no, 1) <> z.user(1))
or (user_cat (intern_no, 2) <> z.user(2));
if z.kind>3 then z.kind:= 4;
if not_found then
begin
if test then write(z_out, <:<10>New:>, << ddd>, intern_no);
max_no:= intern_no;
if max_no>users then
system(9)run_time_alarm:(max_no, <:<10>users :>);
for i:= 1 step 1 until 4 do
begin
stat(intern_no, i):= 0;
par1(intern_no, i):= 0;
par2(intern_no, i):= 0;
end for i:= 1;
for i:= 18 step 1 until 22 do
device(intern_no, i):= 0;
mount (intern_no):= 0;
load (intern_no):= 0;
cpu (intern_no):= 0;
pris (intern_no):= 0;
project_cat(intern_no):= z.project;
for i:= 1, 2 do
user_cat(intern_no, i):= z.user(i);
end if not_found
else
begin
intern_no:= intern_no-1;
if test then
write(z_out, <:<10>Intern:>, << ddd>, intern_no);
end if found;
if test then
begin
i:= 1;
write(z_out, << ddd ddd>,
<:<10>:>, string(user_cat(intern_no, increase(i))),
project_cat(intern_no),
<:<10>:>, stat(intern_no, z.kind),
<:<10>:>, par1(intern_no, z.kind), z.param1,
<:<10>:>, par2(intern_no, z.kind), z.param2,
<:<10>:>, << ddd.ddd>, pris(intern_no));
end if test;
\f
comment account sum * page 27 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
stat(intern_no, z.kind):= stat(intern_no, z.kind) + 1;
case z.kind of
begin
begin
comment kind 1, finis;
jobpris:= (z.loads extract 12) * loadpris +
_ (z.mounts extract 12) * mountpris;
faktor := 1;
cpu (intern_no):= cpu (intern_no) + z.cputime*0.8192;
load (intern_no):= load (intern_no) + z.loads extract 12;
mount(intern_no):= mount(intern_no) + z.mounts extract 12;
jobs := jobs + 1;
if (z.size extract 12) > 30 then
faktor:= faktor + ((z.size extract 12) - 30)*sizefaktor;
if (z.tempdisc extract 12)/36 > 1000 then
faktor:= faktor + ((z.tempdisc extract 12)/36-1000)*
_ tempdiscfaktor;
faktor:= faktor + (z.stations extract 12)*stationsfaktor;
for i:= 18 step 1 until 22 do
if z.deviceword1 shift (-i) extract 1 = 1 then
begin
device(intern_no, i):= device(intern_no, i) + 1;
faktor:= faktor + (case (i-17) of
(plotfaktor, punchfaktor, cardfaktor,
printerfaktor, readerfaktor));
end if z.dewiceword1;
point := (jobpoint+z.cputime*0.8192*2)*faktor;
jobpris:= jobpris + point*pointpris;
if test then
write(z_out, nl, 1, <<dddd.dd>,
<:faktor :>, faktor, <:, point :>, point,
<:, jobpris :>, jobpris);
if point > pointgrænse1 then
jobpris:= jobpris - (point-pointgrænse1)*pointrabat1;
if point > pointgrænse2 then
jobpris:= jobpris - (point-pointgrænse2)*pointrabat2;
if test then
write(z_out, << dddd.dd>, jobpris);
pris(intern_no):= pris(intern_no)+jobpris;
end case 1;
\f
comment account sum * page 28 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
begin
comment kind 2, login;
logins:= logins+1;
pris(intern_no):= pris(intern_no) +
_ z.param1/60 * loginpris +
_ z.param2 * operationspris;
end case 2, login;
begin
comment kind 3, print;
if z.param1//60 > z.param2 then
z.param2:= z.param1//60;
pris(intern_no):= pris(intern_no) +
_ (if z.param3 = 0
_ then standardpapir
_ else specialpapir) +
_ z.param1 * liniepris +
_ z.param2 * sidepris;
end case 3, print;
; comment case 4, other: empty;
end case z.kind of;
if z.kind>1 then
begin
par1(intern_no, z.kind):= par1(intern_no, z.kind) + z.param1;
par2(intern_no, z.kind):= par2(intern_no, z.kind) + z.param2;
if test then write(z_out, nl, 1, <:ny pris:>, pris(intern_no));
end if kind > 1;
end account-record in day interval
and selected;
end for block_rest:= new_acc;
end if version;
end for file no;
close(z, true);
if clear then
begin
comment remove file;
i := monitor(48)remove_entry:(z, 1, dummy);
if i <> 0 then
write(out, <:<10>remove entry:>, i);
end if clear;
end for file_group;
\f
comment account sum * page 29 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
comment open-time from the day not completed;
hours:= hours + (last_in_day - first_in_day)/60;
comment write front page;
write(z_out, <:<10>Fra :>);
write_date(z_out, systime(2, first, first));
write(z_out, <: kl.:>, << dd.dd>, first/10000);
write(z_out, <:<10>til :>);
write_date(z_out, systime(2, last, last));
write(z_out, <: kl.:>, << dd.dd>, last/10000, <:.<10>:>);
for i:= 0 step 1 until max_sel_proj do
begin
for j:= 1 step 1 until 4 do
sel_stat(j):= sel_par1(j):= sel_par2(j):= 0;
sel_cpu:= sel_pris:= 0;
for intern_no:= 1 step 1 until max_no do
if (if i = 0 then true
_ else selected_project(i) = project_cat(intern_no) )
then
begin
for j:= 1 step 1 until 4 do
begin
sel_stat(j):= sel_stat(j) + stat(intern_no, j);
sel_par1(j):= sel_par1(j) + par1(intern_no, j);
sel_par2(j):= sel_par2(j) + par2(intern_no, j);
end for j;
if i = 0 <* all *> then
pris(intern_no):= pris(intern_no)/112*pristal;
sel_cpu := sel_cpu + cpu (intern_no);
sel_pris:= sel_pris + pris(intern_no);
end for intern_no;
if i = 0 then
begin
write(z_out, <:<10>:>, <<dddddd>,
<:<10>:>, no_rec, <: records, :>,
<:<10>:>, days, <: dag:>,
if days = 1 then <:, :> else <:e, :>,
<:<10>:>, hours, <: time:>,
if hours = 1 then <:, :> else <:r, :>,
<:<10>:>, jobs, <: jobs, :>);
\f
comment account sum * page 30 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
if entier ( sel_cpu/(60*60) ) > 10 then
write(z_out,
<<dddddd>, sel_cpu/(60*60), <: cpu timer, :>)
else
write(z_out,
<<ddd.dd>, sel_cpu/60, <: cpu minutter,:>);
write(z_out, sp, 2,
<<ddd.dd>, sel_cpu/(60*60)/hours*100, <: <37>:>,
<<dddddd>,
<:<10>:>, logins, <: logins, :>,
_ sel_par1(2)/60, <: login timer, :>, sp, 2,
<<ddd.dd>, sel_par1(2)/60/hours*100, <: <37>:>,
<<dddddd>,
<:<10>:>, max_no, <: users.:>);
j:= write(z_out, nl, 3, <:Total maskin-pnt.:>,
<< d>, entier(sel_pris));
write(z_out, nl, 1, sp, 12,
false add 61, j-15);
if fp_mode(11) then
write(z_out, <:<10>Pristal:>,
extrnl_regulation_index,
case price_base of
(<: (jan 1971 = 100) :>, <: (jan 1975 = 100) :>));
end i = 0
else
begin
comment write project table;
if i = 1 then
write(z_out, nl, 2,
sp, 16, <:jobs:>,
sp, 19, <:logins:>,
nl, 1, <:project:>,
sp, 4, <:antal cpu tid:>,
sp, 4, <:antal tid opera-:>,
sp, 4, <:maskin-pnt.<10>:>,
sp, 20, <:t m:>,
sp, 15, <:t m tioner<10>:>);
h1:= entier(sel_cpu/(60*60));
h2:= entier(sel_par1(2)/60);
if sel_stat(1) > 0 or sel_stat(2) > 0 then
write(z_out,
nl, 1, <<dd dddd>, selected_project(i),
sp, 4, <<ddddd>, sel_stat(1),
sp, 2, <<ddd>, h1,
sp, 1, <<zd.dd>, sel_cpu/60 - h1*60,
sp, 3, <<ddddd>, sel_stat(2),
sp, 2, <<dddd>, h2,
sp, 1, <<zd>, sel_par1(2) - h2*60,
sp, 2, <<ddddddd>, sel_par2(2),
sp, 4, <<dd ddd ddd>, sel_pris);
end proj tab;
end for i;
\f
comment account sum * page 31 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
comment write user stat;
_ _________________
for intern_no:= 1 step 1 until max_no do
begin
comment write next user;
i:= 1;
if (intern_no mod 8) = 1 then
begin
write(z_out, <:<12>account sum:>,
sp, 20,
<:-:>, <<d>, page, <:-:>,
sp, 14, <<dd dd dd>, to_day,
<:, :>, <<dd.dd>, now, nl, 3,
<:User:>, sp, tab-14,
<:Project:>, sp, 3,
<:Type<10>:>);
page:= page+1;
end if (intern_no mod;
write(z_out, sp,
15-write(z_out,
<:<10>:>, string (user_cat(intern_no, increase(i)))),
<< dd dddd>, project_cat(intern_no), sp, 3);
for i:= 1 step 1 until 4 do
if stat(intern_no, i) <> 0 then
begin
write(z_out, case i of
(<:job :>, <:logout :>, <:print :>, <:other :>),
<< ddd ddd>, stat(intern_no, i));
if i=1 then
write(z_out, <<ddd ddd ddd>, cpu(intern_no))
else
write(z_out,
<<ddd ddd ddd>, par1(intern_no, i),
par2(intern_no, i));
write(z_out, <:<10>:>, sp, tab);
end for i;
if load(intern_no) <> 0 then
write(z_out, <:load :>,
<< ddd ddd>, load(intern_no),
nl, 1, sp, tab);
if mount(intern_no) <> 0 then
write(z_out, <:mount :>,
<< ddd ddd>, mount(intern_no),
nl, 1, sp, tab);
for j:= 18 step 1 until 22 do
if device(intern_no, j) <> 0 then
write(z_out, case (j-17) of
(<:plot :>, <:punch :>, <:card :>,
<:printer:>, <:reader :>),
<< ddd ddd>, device(intern_no, j),
nl, 1, sp, tab);
write(z_out, <:m-pt:>, << dd ddd ddd>, pris(intern_no),
nl, 1, sp, tab);
end for intern_no;
\f
comment account sum * page 32 2 04 80, 10.49
0 1 2 3 4 5 6 7 8 9 ;
if clear then
begin
comment remove accountfile;
i:= monitor(48)remove_entry:(z, 1, dummy);
if i <> 0 then
write(out, <:<10>remove entry:>, i);
end if clear;
end array block;
comment close and print;
write(z_out, <:<10><10>end account sum <10><25><25>:>);
close(z_out, true);
if print then conv(z_out, paper);
end;
\f
; account sum * page 33 2 04 80, 10.49;
; startmark for copy !
; accountjob
; **********
job account 51 stations 1 mounts 3 time 10 00 output 200000
o txtxtxtx
lookup accountdump
if ok.no
(accountdump=set 1 disc
scope project accountdump)
lookup accountlog
if ok.no
(accountlog=set 1 disc
scope project accountlog)
o c
o accountdump
head
lookup accounttape
mount accounttape
ring accounttape
save accounttape.last.label.account segm.4 accountfile
if ok.yes
mode 0.yes
load accounttape.last survey.yes
o c
head
mode list.yes
head
accountlog=accosum clear.no kbon.no print.yes paper.2
if 0.yes
clear user accountfile
if 0.no
(scope project accountfile
opcomm accountfile ej saved)
convert accountdump 2
end
finis
; startmark for copy !
▶EOF◀