|
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: 6144 (0x1800) Types: TextFile Names: »tclosesq «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code └─⟦75ff9bef3⟧ └─⟦this⟧ »tclosesq «
( head 1 if 0.yes closesq = algol spill.yes blocks.yes list.yes survey.yes xref.yes bossline.yes if 0.no closesq = algol spill.yes survey.yes ) sq-system, closesq release 13.0, eah, 01.02,81 cor: (01519) update mark when nothing written in file. external integer procedure closesq(z, release, cut); value release, cut; zone z; boolean release, cut; comment terminates the use of an sq-file. call: closesq(z, release, cut) closesq (return value, integer) if close after reading, then the number of records accessed since opening, else the number of records in the file. z (call and return value, zone) as for the algol procedure close. release (call value, boolean) as for the algol procedure close. cut (call value, boolean) if cut=true and zonestate=6 (writing), the file will be cut to an integral number of blocks, else this parameter is ignored. functions: if zonestate is 5 (after reading), the closing is performed as for the algol procedure close. if zonestate is 6 (after writing), the last block (possibly a whole block) is filled with all bits set on, the block is transferred to the file, may be the file is cut, the filehead and the catalog entry tail are updated and finally normal closing is performed. requirements: zonestate must be 0, 5 or 6. the file must be a sq-file. results: resultsq = 1 ok = 2 updatemark was sensed after reading. zonestate = 4, after declaration. ; begin boolean extension; integer i, zstate, monres, segmno, segsperblock, lastblock, lastbyte, noofrecs, shortclock; real fullclock; integer array zonedescr(1:20), tail(1:20), sharedescr(1:12); integer array field headpart1, headpart2, headpart3; long array name(1:2); long array field docname; integer procedure clock(fncno, fullclock); value fncno; integer fncno; real fullclock; comment the parameter fncno selects an operation on shortclock; begin own integer shortclock; integer i; real time; i:= fncno; if shortclock = 0 then fncno:= 1; comment select a function; again: case fncno of begin begin comment fncno = 1, take shortclock; shortclock:= systime(7, 0, time); if i <> fncno then begin fncno:= i; goto again; end; end; comment fncno = 2, print shortclock; write(out, <:d.:>, <<zddddd.dddd>, systime(6, shortclock, time) +time/1000000); end case; clock:= shortclock; end proc clock; procedure errorsq(fncno, number, text); value fncno, number; integer fncno, number; string text; begin case fncno of begin begin comment alarm, processing stops; write(out, <:<10>***closesq at :>, name); system(9, number, text); end end case; end proc errorsq; procedure outhead(text); string text; begin write(out, <:<10>:>, text, <:<10>:>); for i:= 1 step 1 until z.headpart1(1)//2 do write(out, z.headpart1(i), <:<10>:>); end outhead; extension:= false; docname:= 2; resultsq:= 1; getzone6(z, zonedescr); name(1):= zonedescr.docname(1); name(2):= zonedescr.docname(2); zstate:= zonedescr(13); if zstate <> 0 and zstate <> 5 and zstate <> 6 then errorsq(1, zstate, <:<10>z.state :>); monres:= monitor(42<*lookup*>, z, 0, tail); if monres <> 0 then errorsq(1, monres, <:<10>lookup :>); if tail(9) shift (-12) <> 21 then errorsq(1, tail(9) shift (-12), <:<10>contents:>); getshare6(z, sharedescr, zonedescr(17<*used share*>)); segsperblock:= tail(9) extract 12; if zstate = 6 <*write*> then begin comment fill the last block; integer field ifield; ifield:= outrec6(z, 0); if ifield = 0 then ifield:= segsperblock*512; outrec6(z, ifield); for ifield:= ifield step -2 until 2 do z.ifield:= -8388608; end; segmno:= if zstate = 5 then sharedescr(7 <*segmno*>) else zonedescr(9); lastbyte:= zonedescr(14<*recbase*>) -zonedescr(19<*basebuf*>) +zonedescr(16<*reclength*>) -(sharedescr(2<*first shared*>) -1); comment get the filehead; setposition(z, 0, 0); invar(z); headpart1:= 0; headpart2:= z.headpart1(3<*next part*>); headpart3:= z.headpart2(1<*next part*>); comment* outhead(<:cl read:>); if segsperblock <> z.headpart2(10) extract 12 then errorsq(1, segsperblock, <:<10>ht-confl:>); noofrecs:= zonedescr(11) extract 22; if zonedescr(11) shift (-22) extract 1 = 1 <*fix length bit*> then noofrecs := ((segmno - z.headpart1(6)<*length of head*>) // segsperblock) * (segsperblock * 512 // noofrecs) + lastbyte // noofrecs; comment make the filehead ready for updating; i:=z.headpart1(1); setposition (z, 0, 0); swoprec6 (z, i); if zstate = 5 then resultsq:= resultsq +z.headpart3(6<*update*>) else if zstate = 6 then <*write*> begin comment get tail again, possibly extended; monres:= monitor(42<*lookup*>, z, 0, tail); shortclock:= clock(1, fullclock); if noofrecs > z.headpart3(3) then begin extension:= true; for i:= 2 step 1 until 7 do z.headpart3(i):= case i of (0, <*dummy*> z.headpart3(2) +1, <*extensionno*> noofrecs, segmno, lastbyte, 0, <*updatemark*> shortclock ); checkvar(z); comment* outhead(<:cl mod:>); tail(10):= noofrecs; end extension else begin z.headpart3(6):= 0; checkvar(z); end; if cut then tail(1):= segmno +segsperblock; if cut or extension then begin tail(6):= shortclock; monres:= monitor(44 <*change*>, z, 0, tail); if monres <> 0 then errorsq(1, monres, <:<10>cut :>); end; end write else if zstate = 0 and z.headpart3(6) = 1 then begin <*after open for write*> z.headpart3(6) := 0; checkvar(z); end; close(z, release); closesq:= noofrecs; end closesq; end ▶EOF◀