|
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: 6912 (0x1b00)
Types: TextFile
Names: »gentabtx «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─⟦this⟧ »gentabtx «
begin message gentab side 1 - 811211/jg;
<* gentab initialiserer cldp's tabelfil udfra kataloget dbkatt
kald: <tabelfil>=gentab <dbkatt>
tabelfil: binær fil indeholdende tabellerne samt oversat dbkatt.
hvis filen ikke findes oprettes en temporær fil.
i tail sættes tail(1)=antal segmenter
tail(6)=shortclock for initialisering
tail(10)=antal tabeller
dbkatt: textfil indeholdende katalog på formen
tabelnr postantal postlængde segmentantal filnavn
hvortil kommer kommentarer på formen ;kommentar<nl>
tabelnr:skal være fortløbende fra 1025 til max 2047.
postantal:skal være >=0 og <= segres*(256//postlængde).
postlængde:angives i antal ord, dvs. >0 og <=256.
segmentantal:skal være >=0,hvis =0 tages resulterende
antal segmenter segres fra evt. filnavns tail(1).
filnavn: navn på fil hvis første segres segmenter kopieres
ind i tabellen, hvis filen mangler eller hvis filnavn= -
initialiseres med binære 0'er.
hvis tabelnr er ledigt skal indgangen have flg. udseende
tabelnr 0 0 0 - ; ledig
dbkatt afsluttes med <em> og læses fra current input.
current output: rapport over indhold af tabelfil af flg. udseende
tabelfil dato
tabelnr blok seg filnavn dato
...
antal tabeller = tantal antal segmenter = santal
iøvrigt gælder at tantal < 1024 og santal < 2**18-1.
hvis anført fil mangler skrives *** istedet for dato.
det oversatte dbkatt lægges i de første 8 segmenter af
tabelfil
de indkopierede procedurer ligger på csupproce.
ref. cpb udv cldp sd. 12.1
*>
\f
message gentab side 2 - 811211/jg;
<*erklæringer*>
boolean fri,fil,mangler,nl,sp,ff;
integer i,mk,nr,pa,pl,seg,s,blok,tant,shclock,tshclock,side,c;
integer array tail(1:10),alfa(0:511),dbkatt(1:1024,1:2);
long array tdato(1:2);
real array field raf;
integer array field iaf;
zone oz,iz(128,1,stderror);
real array navn(1:2); real r;
procedure sf(i);
value i; integer i;
begin
write(out,nl,1,case i of
(<:*** uddatafil mangler:>,
<:*** fejl i næste indgang:>,
<:*** fejl i næste indgangs filnavn.seg:>));
system(9,nr,<:<10>gentab:>);
end;
<*initialiser*>
iaf:= 0;
if fp_output(mk,navn.iaf)<0 or mk<>4 then sf(1);
tail(1):= 8; for i:= 2 step 1 until 10 do tail(i):= 0;
tail(6):= systime(7,0.0,0.0);
open(oz,4,navn,0);
if monitor(42,oz,0,tail)<>0 or monitor(52,oz,0,tail)<>0 or
monitor(8,oz,0,tail)<>0
then
monitorcall(40,oz,0,tail,1);
blok:=8;
setposition(oz,0,blok);
tant:= side:= 0;
raf:= 4;
tshclock:= systime(7,0.0,r);
iaf:= 0;
skriv_short(tdato.iaf,tshclock);
nl:= false add 10;
ff:= false add 12;
sp:= false add 32;
alfabet(alfa);
alfa(59):=1 shift 12 +256;
iaf:= 512;
for i:= 0 step 1 until 255 do alfa.iaf(i):= 0;
for i:= 10,12,25 do alfa.iaf(i):= 1 shift 12;
intable(alfa);
tableindex:= 0;
\f
message gentab side 3 - 780928/jg;
for s:= read(in,nr,pa,pl,seg) while s=4 do
begin
<*check parametre*>
tant:= tant +1;
if nr <> 1024 +tant or tant > 1023 then sf(2);
fri:= pa = 0 and pl = 0 and seg = 0;
if fri then goto rapport;
if pl < 1 or pl > 256 then sf(2);
if pa < 0 or seg > 0 and pa > 256//pl*seg then sf(2);
if seg < 0 or seg > 2**18-1 then sf(2);
<*kildedata fil*>
if readstring(in,navn,1) < 1 then sf(2);
fil:= navn(1) <> real<:-:>;
if fil then
begin
i:= 1;
open(iz,4,navn,0);
mangler:= monitor_call(42,iz,i,tail,9) = 3;
if mangler then goto init;
if seg = 0 then
begin
seg:= tail(1);
if seg > 2**18-1 then sf(3);
end
else if seg > tail(1) then sf(3);
shclock:= tail(6);
monitor_call(52,iz,i,tail,1);
end;
<*init tabel*>
init:
for i:= 1 step 1 until seg do
begin
outrec6(oz,512);
if fil and -,mangler then
begin
inrec6(iz,512);
tofrom(oz,iz,512);
end
else
begin
oz(1):= real<::>;
tofrom(oz.raf,oz,508);
end;
end i;
\f
message gentab side 4 - 811211/jg;
<*rapport*>
rapport:
if tant mod 50 = 1 then
begin side:= side +1;
write(out,ff,1,nl,2,<:tabelfil :>,
tdato,sp,4,<:side:>,side,nl,3,
<:tabelnr blok seg filnavn dato:>,nl,1);
end;
write(out,nl,1,<<dddd>,sp,1,nr,sp,4,blok,sp,2,seg,sp,5);
if fri then outchar(out,42) else
begin
outtext(out,13,navn,1);
if fil then
begin
if mangler then write(out,false add 42,11) else
begin integer array ia(1:4);
real array field raf;
skriv_short(ia,shclock);
raf:= 0;
outtext(out,11,ia.raf,1);
end;
end;
end;
<*dbkatt*>
blok:=blok+seg;
dbkatt(tant,1):=pa shift 9 add pl;
dbkatt(tant,2):=blok;
<*luk*>
if fil then close(iz,-,mangler);
repeatchar(in);
repeat until readchar(in,c) = 8;
if c = 25 then repeatchar(in);
end s;
<*slut*>
if s <> 0 then sf(2);
monitor_call(42,oz,i,tail,1);
tail(1):= blok;
tail(6):= tshclock;
tail(10):= tant;
monitor_call(44,oz,i,tail,1);
setposition(oz,0,0);
dbkatt(tant+1,1):=dbkatt(tant+1,2):=8388607; <*eof*>
for i:=tant+2 step 1 until 1024 do
dbkatt(i,1):=dbkatt(i,2):=0;
for i:=1 step 1 until 8 do
begin
outrec6(oz,512);
iaf:=(i-1)*512+4;
tofrom(oz,dbkatt.iaf,512);
end;
close(oz,true);
write(out,nl,2,<:antal tabeller =:>,tant,sp,5,
<:antal segmenter =:>,blok,nl,2);
trapmode:= 1 shift 10;
end;
▶EOF◀