|
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: 126720 (0x1ef00)
Types: TextFile
Names: »tgetreci «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »tgetreci «
\f
; rc 07.11.78 algol7, file-i procedures, ib, comments page ...0...
; 01.02.81 eah
; 82.09.01 fb
; 85.09.01 fb/fgs
m. isq release 14.0 1985.09.01
; standard procedures for handling an indexed-sequential file
; slangnames:
; a : local in each procedure or subroutine block
; b : communication to tail part, other than entries
; c : global entry points in subroutines
; d : global labels in procedures and subroutines
; e : global entry points in the code procedure
; f : global defined constant values
; g : local segment head administration
; h : file processor names
; i : global addresses in the zonebuffer, relative to w2 = zonebufref
; note that the definitions of i-names here and
; in head_file_i must agree.
; j : abs words, local to each segment but same name = same meaning
; entry points and labels, non local:
; c, d and e-names are often defined in pairs, the even
; name as the absolute address and the following odd name as
; the segment relative name (odd e-names also used in tails);
; (the following survey is possibly not fully updated);
;
; name(s): point: segm,page: called from:
; c0 , c1: prepare 1 5 e0,e2,e4,e6,e8,e10,e16,e20
; c4 : inouthere 1 7 e0,e2
; c6 c7: inout 1 7 e4,e6,e20
; c12,c13: putnew 1 8 e4,e6,e8,e20
; c18,c19: movedbwords 5 e8
; c28,c29: initblocktable 5 44 d30,e8
; c30,c31: calltestproc 2 22 e8
; d0 , d1: searchrec 1 9 e16
; d2 , d3: accessnext 1 11 e0,e4,e6
; d4 , d5: termaccess 1 11 e0
; d6 , d7: testresult 1 12 e10
; d8 , d9: startfile 1 13 e14
; d10,d11: getreciint. 1 9
; d12 : exitvianext 2 21 e10
; d14 : exit3, segm2 2 21 e8
; d16 : exit4, segm2 2 21 e8
; d18 : exit2, segm2 2 21 e8
; d20,d21: continsert 4 31 e0
; e0 , e1: getreci 1 9 algol
; e2 , e3: nextreci 1 11 -
; e4 , e5: setupdatei 8 60 -
; e6 , e7: setreadi 8 60 -
; e8 , e9: initreci 2 17 -
; e10,e11: deletereci 2 20 -
; e12,e13: initfilei 3 24 -
; e14,e15: startfilei 3 24 -
; e16,e17: insertreci 4 33 -
; e18,e19: systemi 9 68 -
; e20,e21: setputi 8 60 -
; e22,e23: putreci 2 16 -
; e24,e25: getparamsi 7 53 -
; e26,e27: setparamsi 7 53 -
; e28,e29: settesti 7 53 -
\f
; rc 07.11.78 algol7, file-i procedures, ib, comments page ...1...
b. b5,e29,g1 ;
w. ;
s. c31,d31,f30,i10 ;
w.
; Definition of addresses in the zonebuffer.
; Variables and codepieces in the zonebuffer are referenced relative
; to x2 = zonebufref = basebuffer + word(basebuffer+1) with the
; following relative addresses and meanings, only relevant
; after init_file_i or start_file_i has converted relative
; addresses to absolute ones;
; Note: ...size means always in bytes, ...length in reals.
i0 = 0; entrypoints to code pieces:
; a code piece is called by: jl w2 (x2+rel) and
; returns again with w2 = zonebuffer;
; rel: name: function:
; i0+0 compare1 savekey verses a record key, result in w0
; i0+2 compare2 savekey verses a keypart (in a table)
; i0+4 savethekey moves a record key to savekey
; i0+6 restorehead moves savekey and savelength to a record
; i0+8 copykey moves savekey to a keypart (in a table)
; i0+10 getsize yields bytesize of a record and moves, if needed,
; the length field to savelength, result in w1
; i0+12 compare3 after initfilei: dummy otherwise as compare1
i1 = i0+14; insert parameters
; i1+0 empty block price
; i1+1 priceperbuck
; i1+2 empty buck price (used both as half- and fullword)
; i1+3 - - - - - - - - -
; i1+4 compressprice
; i1+5 priceperblock
; i1+6 shortbuf (0 = false, else true)
; i1+7 strategy (used as word if shortbuf = false)
; i1+8 computed price
; i1+10 pricelimit
; i1+12 transports
; i1+14 teststackref
; i1+16 testproc
; i1+18 max insertprice (not implemented)
\f
; rc 07.11.78 algol6, file-i procedures, ib, comments page ...1a...
i2 = i1+20; unclassified variables:
; i2+0 abs addr of recordbase in the zone descriptor (isq-sum in head)
; i2+2 - - - zonestate - - - - (in head: segs_per_buck)
; i2+4 - - - recordsize - - - - (in head: segs_in_head*seg_size-17)
; i2+6 errorbits, user spec. of action on resulti
; i2+8 actno: procnoi<7+newrec<6+errorbits
; i2+10 newrec , the base of a record when given as call param.
; i2+12 topfirstblocks, abstop for the first block table
; i2+14 bucktable size
; i2+16 maxrecsize
; i2+18 minrecsize-1
; i2+20 blocksperbuck1, no of blocks in first buck
; i2+21 blocksperbuck , - - - - other bucks
; i2+22 bytesperblock , ensured capacity of a block
; i2+24 isq-release no
i10 = 18 ; descrsize, see descriptions below
i3 = i2+26 ; descr = bucks , see descriptions below
i4 = i3+i10 ; descr = blocks, - - -
i5 = i4+i10 ; descr = recs , - - -
i6 = i5+i10+2; return information used during input output, and work.
; i6+0 return jump = jl X3 +
; i6+1 return rel
; i6+2 return segm
; i6+4 work0
; i6+6 work1
; i6+8 - 2
; i6+10 - 3
; i6+12 - 4
; i6+14 - 5
; i6+16 - 6
; i6+18 - 7
; i6+20 - 8
; i6+22 - 9
; i6+24 testbits == tail(9) extract 12
; i6+26 (unused)
; i6+28 value of bufdif used from switchbuf and setbuf p.45
\f
; rc 22.01.79 algol 6, file_i procedures, jj/ib page ...2...
i7 = i6 + 30 ; startbuckhead, first word of buchshare
; description of the total file:
; i7+0 maxused bucks, no of relevant bytes in bucktable
; i7+4 noofrecs , number of records in the file (dw)
; i7+6 ub (file) , table entry describing the whole file
; i7+8 sn (file) , in analogy with the bucktable and
; the blocktable
; i7+12 recbytes , number of bytes used for records in the file (dw)
; i7+14 updmarks , 1<0 = update, 1<1 = gossip, 1<2 = initialize
; i7+16 updcount , (not implemented)
i8 = i7+30 ; first word of the bucktable.
; table entries: the bucktable and the blocktable consists
; of entries referenced via an absolute entryaddr
; entryaddr-
; entryheadsize+1: first word of entry, at present entryheadsize = 4
; entryaddr-3 : ub (entry) , bytes used
; entryaddr-1 : sn (entry) , first segment
; entryaddr+1 : <keypart> (entry)
; entryaddr -
; entryheadsize +
; entrysize : lastword of <keypart>
; descriptions.
; the bucket table,
; the current bucket = the block table and
; the current block = the records are described by 3
; descriptions: bucks, blocks and recs (i3, i4, and i5)
; each description holds at the indicated relative address:
;
; 0 these
; 2 first
; 4 entrysize
; 6 last
; 8 leap
; 10 shareopaddr
; 12 top
; 14 fill
; 16 segsinshare
; 17 segsper
; i10 curr abs addr of current entry in this table
; identical with these in the next description
\f
; rc 07.11.78 algol7, file-i procedures, ib, comments page ...3...
f0 = 10 ; lowest zonestate, altogether five consecutive
; values: set by:
; f0+0 = readonly startfilei, setreadi, getreci
; +1 = readnext nextreci
; +2 = put setputi
; +3 = update setupdatei
; +4 = initialize initfilei
; identification of file i procs:
;testshifts + no of results (maxvalue = 1<6-1 == 63)
; procno:(max=31) entry: page:
f8 = 2 ; 1 initfilei e12 24
f5 = f8 + 4 ; 2 initreci e8 17
f9 = f5 + 2 ; 3 startfilei e14 24
f4 = f9 + 2 ; 4 setreadi e6 60
f17 = f4 + 2 ; 5 setputi e20 60
f3 = f17 + 2 ; 6 setupdatei e4 60
f1 = f3 + 3 ; 7 getreci e0 9
f2 = f1 + 2 ; 8 nextreci e2 11
f6 = f2 + 3 ; 9 deletereci e10 20
f7 = f6 + 6 ; 10 insertreci e16 33
f18 = f7 + 1 ; 11 putreci e22 16
; 12 getparamsi e24 53
; 13 setparamsi e26 53
; 14 settesti e28 53
f19 = f18 + 1 ; 15 putblocki -
f20 = f19 + 4 ; 16 putdirecti -
f11 = 4 ; entryheadsize(bucks)
f12 = 4 ; entryheadsize(blocks)
f13 = 3 ; readoperation
f14 = 5 ; writeoperation
f15 = 26 ; integer kind as formal
f16 = 37 ; min legal zonerefrel
\f
; rc 15.06.79 file_i procedures, segment 1, jj/ib page ...4...
; prepare, inout, getreci, nextreci
b. j20,g2 ; block for segment 1
k=10000 ;
h. ;
g0=0 ; no of externals + no of globals
j0: g1, g2 ; rel of last point, rel of last absword
j2: 1<11+1, 0; address of segment 2
j4: 1<11+3, 0; - - - 4
j5: 0, 1; result_i, permanent core byte 0-1
j6: g0+13 , 0; rs entry 13 last used
j7: g0+30 , 0; - - 30 saved stackref and w3
j8: g0+21 , 0; - - 21 general alarm
j9: g0+8 , 0; - - 8 end address expression
j11: g0+4 , 0; - - 4 take expression
j14: g0+85 , 0; - - 85 current activity no. (algol8)
g2=k-2-j0 ; rel of last absword
j10: g0+33 , 0; rs entry point 33 check
g1=k-2-j0 ; rel of last point
b0=9 ; total number of segments
b1=k-j0 ; external list
0,0 ; no of globals, no of externals
0,0 ; core to copy
w. s3,s4 ; date
b2 = 4 ; total number of own core halfwords
\f
; rc 09.03.79 algol7, file-i procedures, ib, segment 1 page ...5...
; subroutine prepare (statebits, actno);
; the routine is called at the start of each record handling procedure.
; it checks the zonestate against statebits when
; bit (23-f0-4+n) of: (statebits) = 1 if zonestate = n is allowed
; it saves actno and computes and saves zonebufrel from
; first formal and, if bit(17) of: (actno) = 1, computes and
; saves newrec from second formal. it sets result_i := 1;
; call return
; w0: statebits zonestate
; w1: actno undefined
; w2: irrelevant zonebufref
; w3: return address newrec or undefined
b. a5 ; beginblock prepare
w. ;
al w0 2.11110 ; prepare(states(readonly,readnext,
; put,update);only entered from this segment!!
c0: c1=k-j0 ; prepare:
rl. w2 (j6.) ; begin
ds. w3 (j7.) ; w2:= stackref:= lastused;
rl w3 x2+8 ; save stackref and return;
am (x3+h2+6) ; w3:= zoneaddr;
ls w0 -f0-4 ; if bit(stack(zoneaddr) - empty state + 23)
so w0 1 ; of (statebits) = 0 then goto prgerr;
jl. a2. ;
rl w3 x3+h0 ; formal 1.1 =
wa w3 x3+1 ; zonebufref:= w2:= basebuffer(zoneaddr) +
hs w1 x3+i2+9 ; relative zonebufref;
rs w3 x2+6 ; actno:= w1; w3:= stackref;
rx w2 6 ;
so w1 1<6 ; if bit(17) of :(actno) = 1 then
jl. a1. ;
rl w3 (x3+12) ; w3:= newrec:=
rs w3 x2+i2+10 ; array base addr (formal2);
a1: al w0 1 ;
rs. w0 (j5.) ; result_i:= 1;
rl w0 (x2+i2+2) ; w0:= zonestate;
rl. w1 (j7.) ;
jl x1 ; return;
a2: ls w1 -7 ; prgerr:
hs. w1 a3. ;
al w1 100 ;
wm w1 x3+h2+6 ;
a3=k+1 ;
al w1 x1;+procno; general alarm (
al. w0 a4. ; state (zoneaddr) * 100 + procno;
jl. w3 (j8.) ; <:state i:>);
a4: <:<10>state i :> ; end prepare;
m.prepare
i. ;
e. ; endblock prepare
\f
; rc 26.06.70 algol 5, file_i procedures, jj, segment 1 page ...6...
; Input-output subroutines.
; Performs transports to and from the backing storage.
; One transport is performed by an explicit send message and
; is immediately waited for and checked by a call of rs-check.
; The basic subroutine is inout which in principle is used
; by all the other input-output.
; It writes, reads, or writes and read from/to one share according
; to the following algorithm:
; subroutine inout(descr, getbit);
; descr: abs address of the description specifying the transport.
; i.e. bucks, blocks, or recs;
; getbit: boolean, true==1, true if reading is wanted after write.
; begin
; if shareop(descr) = readop then
; read:
; begin
; sharesn(descr):= sn(these(descr));
; last(descr):= first(descr) + ub(these(descr))
; end;
; perform one transport including wait and check;
; if shareop(descr) = writeop then
; begin
; shareop(descr):= readop;
; if getbit then goto read
; end;
;
; registers: entry: exit
; w0 : returnsegm undefined
; w1 : descr+getbit descr+getbit
; w2 : zonebufref zonebufref
; w3 : abs return undefined
; entry points: c6, c7
; The two other subroutines are described in terms of inout
; only w0 and w1 at entry may differ from the above
; Subroutine inouthere (descr, getbit); inout(descr, getbit);
;
; registers: entry:
; w0 : irrelevant
; entrypoint: c4. Note only call from this segment, otherwise as inout;
; Subroutine putnew(descr, getbit);
; begin
; shareop(descr):= writeop;
; ub(these(descr)):= curr(descr) - first(descr);
; sharesn(descr):= sn(these(descr));
; inout(descr, getbit)
; end;
;
; entrypoints c12, c13
\f
; rc 20.09.79 algol8, file-i procedures, ib, segment 1 page ...7...
b.a10 ; beginblock input-output;
w. ;
c4: rl. w0 j0. ; inouthere: w0:= thissegm;
c6: c7=k-j0 ; inout:
ws w3 (0) ; return segm:= w0;
ds w1 x2+i6+4 ; work0:= descr+getbit;
hs w3 x2+i6+1 ; relreturn:= w3 - segmtable(return segm);
bl w0 (x1+10) ; if shareop(descr) = readop then
se w0 f13 ; read:
jl. a3. ; begin
a1: dl w0 (x1+0) ; w0:= sn(these(descr));
wa w3 x1+2 ; last(descr):=
rs w3 x1+6 ; first(descr) + ub(these(descr));
a2: am (x1+10) ; setsn: sharesn(descr):= w0;
rs w0 6 ; end;
;
a3: rl w1 x1+10 ; perform transport:
rl w3 x2+i2+0 ;
al w3 x3-h3+h1+2 ;
rl. w0 (j5.) ; zonestate := result_i shift 12 + zonestate;
hs w0 (x2+i2+2) ; <* save result_i while pasivated *>
rl. w2 (j14.) ; w2:= currrent activity no.
jd 1<11+16 ; w2:= sendmessage(docname, actno, shareopaddr(descr));
sn w2 0 ; if w2 = 0 then
jd 1<11+18 ; nobuffer: provoke interrupt;
al w1 x1-6 ;
rs w2 x1 ; sharestate(descr):= w2;
rs w1 x3-h1-2+h0+4; usedshare(zone):= share(descr);
al w0 x3-h1-2+h3 ;
ls w0 4 ;
dl. w3 (j7.) ;
rl. w1 j10. ; call rs check;
jl. w3 (j11.) ;
ds. w3 (j7.) ;
rl w2 x2+6 ; w2:= zonebufref; comment from first formal.
zl w3 (x2+i2+2) ; result_i:= zonestate shift (-12) extract 12;
rs. w3 (j5.) ; <* unsave result_i - and.. *>
al w3 0 ; zonestate := zonestate extract 12;
hs w3 (x2+i2+2) ; <* reestablish zonestate *>
rl w3 (x2+i6+2) ; w3:= segmtable(returnsegm);
rl w1 x2+i1+12 ;
al w1 x1+1 ; transportcount:= transportcount + 1;
rs w1 x2+i1+12 ;
rl w1 x2+i6+4 ; w1:= descr + getbit;
bl w0 (x1+10) ;
se w0 f14 ; if shareop(descr) <> readop then
jl x2+i6+0 ; begin
al w0 f13 ; shareop(descr):= readop;
hs w0 (x1+10) ; if getbit then
sz w1 1 ; goto read
jl. a1. ; end;
jl x2+i6+0 ; goto return jump;
\f
; rc 17.01.79 algol7, file-i procedures, ib, segment 1 page ...8...
c12: c13=k-j0 ; putnew:
ws w3 (0) ; returnsegm:= w0;
ds w1 x2+i6+4 ; work0:= descr + getbit
hs w3 x2+i6+1 ; relreturn: w3 - segmtable(returnsegm);
rl w0 x1+i10 ;
ws w0 x1+2 ; ub(these(descr)):=
am (x1+0) ; curr(descr) - first(descr);
rs w0 -2 ;
al w0 f14 ; shareop(descr):= writeop;
hs w0 (x1+10) ;
sh w1 x2+i4+1 ; if descr = recs then
jl. a6. ;
al w3 0 ; begin
am (x2+i5+10) ; w0w1:= firstshared, lastshared
dl w1 4 ;
am (x2+i5+0) ; w0:= firstshared +ub(these(recs))
wa w0 -2 ;
a4: sl w0 x1+2 ; while w0 < w1 +2 do
jl. a5. ; word(w1):= 0;
rs w3 x1 ;
al w1 x1-2 ;
jl. a4. ; end;
a5: rl w1 x2+i6+4 ; reset w1
a6: rl w0 (x1+0) ; w0:= sn(these(descr));
jl. a2. ; goto setsn;
m.inout
i. ;
e. ; endblock input - output
\f
; rc 29.12.75 file_i procedures, segment 1, jj/ib page ...9...
; procedure getreci(z, rec); zone z; array rec;
; searches for a record with the same key as rec;
; resulti:
; 1 record found
; 2 record not found, next higher available
; 3 record not found, end of file, first record available
b. a21 ; beginblock getreci
w. ;
e0: e1=k-j0 ; getreci:
; al w0 2.11110 ; prepare (states(readonly,readnext,
al w1 7<7+1<6+f1 ; put,update), getact+getarray);
jl. w3 c0.-2 ; w0 is set to: 2.11110 at : c0-2 ;
sn w0 f0+1 ; if state = readnext then ensure reading
jl. a14. ; else
d10: d11=k-j0 ; lookup: comment entered from insertreci;
rl w3 x2+i5+i10 ; restorehead(curr(recs));
jl w2 (x2+i0+6) ;
d0: d1= k-j0 ; searchrec: comment from insertreci;
a1: rl w3 x2+i2+10 ; savethe key(newrec);
jl w2 (x2+i0+4) ;
; w1:= descr:= bucks;
al w1 x2+i3 ; while descr <> recs do
a2: dl w0 x1+8 ; begin
ds. w0 a9. ; leapsearch:
ac w0 (x1+4) ; wlast:= last(descr);
hs. w0 a7. ; wleap:= leap(descr);
rl w3 x1+2 ; wsize:= entrysize(descr);
jl w2 (x2+i0+2) ; w3:= first(descr);
sh w0 0 ; w0:= compare2(w3);
jl. a10. ;
; if w0 > 0 then <*wanted_key > key_in_descr *>
a3: wa. w3 a9. ; begin
sl. w3 (a8.) ; for w3:= w3+wleap while w3 < wlast do
jl. a4. ; begin
jl w2 (x2+i0+2) ; w0:= compare2(w3);
sh w0 0 ; if w0 <= 0 then
jl. a6. ; goto backup
jl. a3. ; end;
a4: rl. w3 a8. ; w3:= wlast; w0:= compare2(w3);
a5: jl w2 (x2+i0+2) ; backup:
a6: sl w0 0 ; while w0 < 0 do
jl. a10. ; begin
a7=k +1 ; w3:= w3 - wsize;
al w3 x3; -wsize ; w0:= compare2(w3)
jl. a5. ; end;
; end;
a8: 0 ; wlast.double ;
a9: 0 ; wleap. - ;
\f
; rc 07.11.78 algol7, file-i procedures, ib, segment 1 page ...10...
a10: sl w3 (x2+i4+2) ; comment now w3 points at the searched entry;
am i10 ; w1:= descr:= 1 + if w3 < first(blocks) then
al w1 x2+i4+1 ; blocks else recs; comment getbit:= true;
rs w3 x1+0 ; these(descr):= w3;
am (x1+10) ;
rl w0 6 ; if sharesn(descr) <> sn(curr(descr)) then
sn w0 (x3) ; begin
jl. a21. ; comment if the current description is
; blocks, then it is known that both
; blocktable and block must be changed
; to optimize disc head movings, an up-
; dated block is written back before the
; new blocktable is fetched;
se w1 x2+i4+1 ; if descr=blocks then
jl. a20. ; begin
bl w0 (x2+i5+10) ; w0:= shareop(recs);
se w0 f14 ; if shareop(recs)=writeop then
jl. a20. ; begin <*current block updated*>
al w1 x2+i5 ; descr:= recs;
jl. w3 c4. ; inouthere(recs, false);
al w1 x2+i4+1 ; descr:= blocks; getbit:= true;
; end recs updated;
; end change;
a20: ; getblock:
jl. w3 c4. ; inouthere(descr, true);
a21: ; blockincore:
al w1 x1-1 ; descr:- descr -; comment getbit:= false;
se w1 x2+i5 ; if descr <> recs then goto do;
jl. a2. ; end while descr <> recs;
rl w3 x2+i5+2 ; simple search in the block:
; w3:= first(recs);
a11: jl w2 (x2+i0+0) ; for w0:= compare1(w3) while w0 > 0 do
sh w0 0 ; begin
jl. a12. ;
jl w2 (x2+i0+10) ; w3:= w3 + getsize(w3);
wa w3 2 ; if w3 >= last(recs) then
sl w3 (x2+i5+6) ; goto notfound
jl. a13. ; end;
jl. a11. ;
a12: sn w0 0 ; if w0 = 0 then goto termaccess;
jl. d4. ;
; not found: comment w3 holds recbase for the
a13: al w0 3 ; next higher record or w3 = last (recs),
ws. w0 (j5.) ; value of result i is used to distinguish
rs. w0 (j5.) ; between getrec i and ensertreci;
sn w0 2 ; resulti:= 3 - resulti;
jl. d2. ; comment was 1 or 2 now 2 or 1;
rs w3 x2+i5+i10 ; if resulti = 2 then goto access next
rl. w3 (j4.) ; curr(recs):= w3;
jl x3+d21 ; goto continue insert;
a14: al w0 0 ; ensurereading:
am (x2+i5+10) ; beginthen
rs w0 6 ; sharesn(recs):= 0;
al w0 f0 ; comment will ensure that the block
rs w0 (x2+i2+2) ; is read again;
jl. a1. ; zonestate:= readonly;
; endthen ensure reading;
m.getreci
i. ;
e. ; endblock getreci;
\f
; rc 10.12.70 algol 5, file_i procedures, jj, segment 1 page ...11...
; procedure nextreci(z); zone z
; makes the cyclically next record available
; resulti:
; 1 next record found
; 2 next record found, is first in file
b. a10 ; beginblock nextreci
w. ;
e2: e3=k-j0 ; nextreci:
; al w0 2.11110 ; prepare (states(readonly,readnext,
al w1 8<7+f2 ; put,update), nextact);
jl. w3 c0.-2 ; w0 is set to: 2.11110 at : c0-2 ;
sn w0 f0+0 ;
al w0 f0+1 ; if state = readonly then
rs w0 (x2+i2+2) ; zonestate:= readnext;
rl w3 x2+i5+i10 ;
se w0 f0+1 ; if state <> readnext then
jl w2 (x2+i0+6) ; restorehead(curr(recs));
wa w3 x2+i5+4 ; w3:= recbase:= (curr(recs)) + entrysize(recs);
d2: d3=k-j0 ; access next: comment yields, when
; entered here with w3 = recbase the,
sl w3 (x2+i5+6) ; cyclically, first record starting at
jl. a3. ; recbase or later
; increments resulti by one if wrap around;
; if recbase >= last(recs) then
; blockexhausted;
a1: rl w0 (x2+i2+2) ;
se w0 f0+1 ; if zonestate <> readnext then
jl w2 (x2+i0+4) ; savethekey(recbase);
d4: d5=k-j0 ; termaccess: sets, when entered here
rs w3 x2+i5+i10 ; with w3 = recbase, recordbase and recordsize
rs w3 (x2+i2+0) ; in the zone. sets, if needed, writeop in
jl w2 (x2+i0+10) ; shareop(recs);
rs w1 x2+i5+4 ; recordbase:= curr(recs):= recbase
rs w1 (x2+i2+4) ; recordsize:= entrysize(recs):=
al w1 f14 ; getsize(recbase);
rl w0 (x2+i2+2) ; if zonestate = update then
sn w0 f0+3 ; shareop(recs):= writeop;
hs w1 (x2+i5+10) ;
dl w1 x2+i2+8 ; testresult:
sl w0 0 ; if testbits >= 0 then
jl. (j9.) ; return;
al w3 2.111111 ;
la w3 2 ; if bit (actno extract 6 - resulti + 1)
ws. w3 (j5.) ; of:(testbits) = 0 then
ld w1 x3-16 ; return;
so w0 1<6 ;
jl. (j9.) ;
rl. w3 (j2.) ;goto calltestproc; comment segment 2;
jl x3+c31 ;
\f
; rc 07.11.78 algol7, file-i procedures, ib, segment 1 page ...13...
a3: rl w3 x2+i4+i10 ; blockexhausted:
wa w3 x2+i4+4 ; beginthen current:= w3:=
sh w3 (x2+i4+6) ; curr(blocks) + entrysize(blocks);
jl. a5. ; if current > last(blocks) then
; bucketexhausted:
rl w3 x2+i3+i10 ; begin current:= w3:=
wa w3 x2+i3+4 ; curr(bucks) + entrysize(bucks);
sh w3 (x2+i3+6) ; if current > last(bucks) then
jl. a4. ; fileexhausted:
al w0 1 ; begin
wa. w0 (j5.) ; if resulti < 3 then
sh w0 3 ; resulti:= resulti + 1;
rs. w0 (j5.) ; fromstart: current:= first(bucks);
d8: d9=k-j0 ; startfile:
rl w3 x2+i3+2 ; end;
a4: rs w3 x2+i3+i10 ; curr(bucks):= current;
al w1 x2+i4+1 ; inouthere(blocks, true);
jl. w3 c4. ; current:= first(blocks);
rl w3 x2+i4+2 ; end bucketexhausted;
a5: rs w3 x2+i4+i10 ; curr(blocks):= current;
al w1 x2+i5+1 ; inouthere(recs, true);
jl. w3 c4. ; w3:= recbase:= first(recs);
rl w3 x2+i5+2 ; endthen blockexhausted;
jl. a1. ;
m.nextreci
i. ;
e. ; endblock nextreci;
j20=k-j0
c.j20-506
m.code on segment 1 too long
z.
c.502-j20,0,r.252-j20>1 z.; fill with zeroes
<:file_i pr.<0>:> ; alarm text
m.segment 1
i. ;
e. ; end segment 1
\f
; rc 23.06.78 algol6, file-i procedures, ib, segment 2 page ...14...
; 01.02.81 eah
; putreci initreci deletereci
b. j20,g2 ; block for segment 2
k = 10000
h. ;
g0=0 ; no of externals + number of globals
j0: g1,g2 ; rel of last point, rel of last abs word
j1: -1, 0 ; address of segment 1
j5: 0, 1 ; result_i, permanent core byte 0, 1
j9: g0+8, 0 ; rs-entry 8, end address expression
j6: g0+13, 0 ; - - 13 lastused
j12: g0+3 , 0 ; - - 3 reserve
j13: g0+5 , 0 ; - - 5 goto point
j8: g0+21, 0 ; - - 21 general alarm
j16: 1<11+3, 0 ; address of segment 5
g2=k-2-j0 ; rel of last absword
g1=k-2-j0 ; rel of last point
w.
\f
; rc 10.12.70 algol 5, file_i procedures, jj, segment 2 page 15
\f
; rc 23.06.78 algol6, file-i procedures, ib, segment 2 page ...16...
;procedure putreci(z);
; ensures that the block containing the current available record
; will be written before a new block is read;
e22: e23=k-j0 ;
al w0 2.00110 ; putreci:
al w1 11<7+f18 ;
rl. w3 (j1.) ; prepare (states(put,update),
jl w3 x3+c1 ; putact);
al w0 f14 ; shareoprecs:= writeop;
hs w0 (x2+i5+10) ;
jl. d6. ; goto testresultseg2;
\f
; rc 29.01.76 file_i procedures, segment 2, jj/ib page ...17...
; procedure init_rec_i (z, record); zone z; array record;
; initializes the file by adding the specified record as
; the next record.
; an average of fill(recs) bytes are filled in each block
; and an average of fill(blocks) bytes are filled in each
; block table.
; fill(recs) and fill(blocks) are computed by initfilei.
; result_i:
; 1 record accepted and added
; 2 record not added, file is full
; 3 - - - , improper length
; 4 - - - , not ascending key
b. a15 ; beginblock initreci
w. ;
e8: e9=k-j0 ; initreci:
al w0 2.1 ; prepare (states(initialize),
al w1 2<7+1<6+f5 ; initrecact+getarray);
rl. w3 (j1.) ; w0:= compare 3(newrec);
jl w3 x3+c1 ; comment compare3 will yield w0>=0 if
jl w2 (x2+i0+12) ; first call after initfilei or file
sl w0 0 ; is full or key not ascending;
jl. a10. ; if w0 >= 0 then goto testinitcase;
jl w2 (x2+i0+10) ;
sh w1 (x2+i2+16) ; w1:= getsize(newrec);
sh w1 (x2+i2+18) ; if w1 > maxrecsize or w1 < minrecsize
jl. d14. ; or w1 mod 4 <> 0 then
sz w1 3 ; goto exit 3, comment improper length;
jl. d14. ;
rs w1 x2+i5+4 ; recordaccepted if we have room for it:
jl w2 (x2+i0+4) ; entrysize(recs):= w1;
rl w1 x2+i5+i10 ; savethekey(newrec);
al w0 x1 ; w1:= curr(recs);
wa w0 x2+i5+4 ; w0:= curr(recs) + entrysize(recs);
sh w0 (x2+i5+12) ; if curr(recs) + entrysize(recs) > top(recs) or
sl w1 (x2+i5+6) ; curr(recs) >= last(recs) then
jl. a3. ; blockfull;
a1: rs w0 x2+i5+i10 ; comment now w1 holds the base of the
rl w2 x2+i2+10 ; next free record with the necessary block-
rl. w3 (j16.) ; and bucket-changes performed.
jl w3 x3+c19 ; w0 holds w1 + entrysize(recs);
; curr(recs):= w0;
; movedbwords(newrec,w1,w0);
al w0 0 ; noofrecs:= noofrecs +1;
al w1 1 ;
aa w1 x2+i7+4 ;
ds w1 x2+i7+4 ;
al w0 0 ; recbytes:= recbytes +entrysize(recs);
rl w1 x2+i5+4 ;
aa w1 x2+i7+12 ;
ds w1 x2+i7+12 ;
a2: al w0 0 ; end_init:
rs w0 (x2+i2+4) ; rec_size:= 0;
\f
; rc 07.11.78 algol7, file-i procedures, ib, segment 2 page ...18...
d6: dl w1 x2+i2+8 ; testresultseg2:
sl w0 0 ; if testbits >= 0 then
jl. (j9.) ; return;
al w3 2.111111 ;
la w3 2 ; if bit(actno extract 6 - resulti + 1)
ws. w3 (j5.) ; of:(testbits) = 0 then return;
ld w1 x3-16 ;
so w0 1<6 ;
jl. (j9.) ;
jl. c30. ;
a3: al w0 0 ; blockfull:
bl w1 x2+i5+17 ; w1:= lastshared:= segsper*512+first(recs)-curr(recs);
ls w1 9 ;
wa w1 x2+i5+2 ;
a11: sh w1 (x2+i5+i10) ; while w1 > curr(recs) do
jl. a12. ; word(w1):= 0;
rs w0 x1 ;
al w1 x1-2 ;
jl. a11. ;
a12: al w1 x2+i5 ; descr:= recs;
a4: rl. w0 j0. ; buckfull:
rl. w3 (j1.) ;
jl w3 x3+c13 ; putnew(descr, false);
rl w3 x1 ;
rl w0 x1+6 ;
ws w0 x3-2 ;
wa w0 x1+14 ; last (descr):= last(descr)
rs w0 x1+6 ; - ub(these(descr)) + fill(descr);
al w1 x1-i10 ; descr:= descr - descrsize;
wa w3 x1+4 ; w3:= curr(descr) + entrysize(descr);
sn w1 x2+i3 ; if descr = bucks then
jl. a6. ; test bucks;
rl w0 x2+i3+i10 ; else
sn w0 (x2+i3+2) ; testblocks:
am i2+12-i4-12 ; if w3 > (if curr(bucks) = first(bucks)
sh w3 (x2+i4+12) ; then topfirstblocks else top(blocks))
sl w3 (x2+i4+6) ; or w3 >= last(blocks) then
jl. a4. ; goto buckfull;
;
a5: rs w3 x2+i4+i10 ; newblock:
jl w2 (x2+i0+8) ; curr(blocks):= w3; copykey(w3);
rl w1 x2+i5+2 ; w1:= first(recs);
al w0 x1 ; w0:= first(recs) + entrysize(recs);
wa w0 x2+i5+4 ;
jl. a1. ; endthen blockfull;
a6: sl w3 (x2+i3+12) ; testbucks:
jl. a8. ; beginthen
; if w3 >= top(bucks) then goto fullfile;
a7: rs w3 x2+i3+i10 ; newbuck:
jl w2 (x2+i0+8) ; comment entered also from testfirst
rl. w0 j0. ;
rl. w3 (j16.) ; with w3 = first(bucks);
jl w3 x3+c29 ; curr(bucks):= w3; copykey(w3);
rl w3 x2+i4+2 ; initblocktable; w3:= first(blocks);
jl. a5. ; endthen testbucks;
a8: al w0 x2-1 ; fullfile:
rs w0 x2+i0+12 ; entrypoint(compare3):= zonebufref - 1;
jl. d18. ; goto exit2;
\f
; rc 14.10.76 file_i procedures, segment 2, jj/ib page ...19...
; testinitcase: entrypoint(compare3) will hold one of 3 values:
; zonebufref - 1: file is full
; zonebufref - 2: first call after initfilei
; entrypoint(compare0): key not greater than previous
a10: rl w0 x2+i0+12 ;
sn w0 x2-1 ; if entrypoint(compare3) = zonebufref-1
jl. d18. ; then goto exit2;
se w0 x2-2 ; if entrypoint(compare3) <> zonebufref-2
jl. d16. ; then goto exit4;
jl w2 (x2+i0+10) ;
sh w1 (x2+i2+16) ; w1:= getsize(newrec);
sh w1 (x2+i2+18) ; if w1 > maxrecsize or w1 < minrecsize
jl. d14. ; or w1 mod 4 <> 0 then
sz w1 3 ; goto exit3; comment improper length;
jl. d14. ;
rs w1 x2+i5+4 ; entrysize(recs):= w1;
jl w2 (x2+i0+4) ; savethekey(newrec);
rl w0 x2+i0+0 ; entrypoint(compare3):= entrypoint(compare1);
rs w0 x2+i0+12 ;
rl w0 x2+i7+9 ;
ba w0 x2+i3+17 ; sn(first(bucks)):=
rs w0 (x2+i3+2) ; snfile + segsinshare(bucks);
rl w3 x2+i3+2 ; w3:= first(bucks);
jl. a7. ; goto newbuck;
d14: am -1 ; exit3: resulti:= 3 else
d16: am 2 ; exit4: resulti:= 4 else
d18: al w0 2 ; exit2: resulti:= 2;
rs. w0 (j5.) ;
jl. a2. ; goto end_init
m.initreci
i. ;
e. ; endblock initrec
\f
; rc 07.11.78 file_i procedures, segment 2, jj/ib page ...20...
; procedure deletereci(z); zone z;
; deletes the current record from z;
; result_i:
; 1 record deleted, next available
; 2 record deleted, end of file, firstavailable
; 3 not deleted, last in file
b. a10 ; beginblock deletereci
w. ;
e10: e11=k-j0; ; deletereci:
al w0 2.00110 ; prepare (states(put,update),
al w1 9<7+f6 ; deleteact);
rl. w3 (j1.) ;
jl w3 x3+c1 ;
dl w1 x2+i7+4 ;
se w1 1 ; if noofrecs = 1 then
jl. a5. ;
sn w0 0 ;
jl. a4. ; goto del_res_3;
a5: ss. w1 a1. ; noofrecs:= noofrecs -1;
ds w1 x2+i7+4 ;
al w0 0 ; recbytes:= recbytes -entrysize(rec);
rl w1 x2+i5+4 ;
ds w1 x2+i6+6 ;
dl w1 x2+i7+12 ;
ss w1 x2+i6+6 ;
ds w1 x2+i7+12 ;
al w0 f14 ;
hs w0 (x2+i3+10) ; shareop(bucks):=
hs w0 (x2+i4+10) ; shareop(blocks):=
hs w0 (x2+i5+10) ; shareop(recs):= writeop;
rl w0 x2+i5+6 ;
ws w0 x2+i5+4 ; last(recs):= last(recs) - entrysize(recs);
rs w0 x2+i5+6 ;
ws w0 x2+i5+2 ; ub(these(recs)):=
am (x2+i5+0) ; last(recs) - first(recs);
rs w0 -2 ;
sh w0 0 ; if ub(these(recs)) > 0 then
jl. a6. ; squeeze record out:
; begin
rl w1 x2+i5+i10 ; movedbwrds
rl w0 x2+i5+6 ; (curr(recs)+entrysize(recs),
rl w2 x2+i5+4 ; curr(recs),
wa w2 2 ; last(recs));
rl. w3 (j16.) ;
jl w3 x3+c19 ; end squeeze record out;
\f
; rc 07.11.78 algol7, file-i procedures, ib, segment 2 page ...21...
a6: al w0 0 ; clear old rec:
rl w1 x2+i5+6 ; w1:= last(recs) +entrysize(recs)
wa w1 x2+i5+4 ;
a7: rs w0 x1 ; while w1 > last(recs) do
al w1 x1-2 ; word(w1):= 0
se w1 (x2+i5+6) ;
jl. a7. ;
am (x2+i5+0) ;
rl w0 -2 ; if ub(these(recs)) = 0 then
sh w0 0 ; goto blockisempty;
jl. a2. ;
d12: rl. w3 (j1.) ; exitvianext:
rl w1 (x3) ; get segment 1;
rl w3 x2+i5+i10 ; w3:= recbase:= curr(recs);
jl x1+d3 ; goto accessnext
a2: al w1 x2+i5 ; blockisempty: descr:= recs
rl. w0 j0. ; <*write the empty block before squeezing*>
rl. w3 (j1.) ; inout(recs, false);
jl w3 x3+c7 ;
a3: al w1 x1-i10 ; repeat squeece:
rl w0 x1+6 ; descr:= descr-sizedescr;
rs w0 x1+14 ; insert(descr):= last(descr);
rl. w3 (j16.) ; move entries(descr);
jl w3 x3+c21 ; last(descr):= insert(descr);
rl w0 x1+i10 ;
ws w0 x1+4 ; curr(descr):= curr(descr)-
rs w0 x1+i10 ; entrysize(descr);
rl w3 x1+14 ;
rs w3 x1+6 ;
ws w3 x1+2 ; ub(these(descr)):=
am (x1+0) ; last(descr) - first(descr);
rs w3 -2 ;
sl w3 0 ; if ub(these(descr) >= 0 then
jl. d12. ; goto exitvianext;
jl. a3. ; goto repeatsqueeze;
a4: al w0 3 ; del_res_3: result_i:= 3;
rs. w0 (j5.) ;
jl. d6. ; goto testresultseg2;
a0: 0 ; constant (dw) 1
a1: 1 ;
m.deletereci
i. ;
e. ; endblock deletereci;
\f
; rc 10.12.70 algol 5, file_i procedures, jj, segment 2 page ...22...
; calltestproc:
; redirects the original call so that it looks like:
; testproc (z) if array param in original call then: (array) else:(z)
; added parameter:(procnoi);
b. a1 ; begin block calltestproc
w. ;
c30: c31=k-j0 ; call testproc:
rl. w3 (j6.) ; w3:= last used;
bz w0 x2+i2+9 ; returnsegm:= procnoi(actno);
so w0 1<6 ; comment used as working location to hold
am 4 ; the value of the actual parameter;
ac w1 4 ; work0:= w1:=
ls w0 -7 ; if getarray(actno) then -4 else -8;
ds w1 x2+i6+4 ; comment how far to move the parameters in
bl w0 x3+4 ; the stack;
ws w0 2 ; appetite(stackref):=
hs w0 x3+4 ; appetite(stackref) - w1;
rl. w0 a1. ; firstformal1:= zonekind;
rs w0 x3+6 ;
al w0 x3 ; save old last used;
jl. w3 (j12.) ; reserve(w1);
rl w3 0 ; restore old last used
zl w0 x3+5 ; w0 := rel of return;
so w0 1 ; if no unstack bit is set
jl. a0. ; <* called from fortran generated code *> then
am (x3) ; stack.last used :=
rs w1 -2 ; last used ;
a0: rl w0 x1+4 ; move stack one position:
rs w0 x1 ;
dl w0 x1+8 ; for i:= 0 step 1 until 7 do
ds w0 x1+4 ; stack(w1+i):= stack(w1+i+4);
dl w0 x1+12 ;
ds w0 x1+8 ; comment w0 will now contain some
dl w0 x1+16 ; stackref i.e. <> -8;
ds w0 x1+12 ;
rx w0 x2+i6+4 ; exchange(w0,work0);
sn w0 -8 ; if w0 = -8 then
jl. a0. ; goto move stack one position;
al w0 x2+i6+2 ; thirdformal:=
al w3 f15 ; simplevariable(returnsegment);
ds w0 x1+16 ;
dl w1 x2+i1+16 ;
ls w0 4 ; goto point(teststackref,testproc);
jl. (j13.) ;
a1: 6<12+23; zonekind ;
i. ;
e. ; end block calltestproc
; end of segment
j20=k-j0
c.j20-506
m.code on segment 2 too long
z.
c.502-j20,0,r.252-j20>1 z. ; fill with zeroes
<:fileipr. s2<0>:>
m. segment 2
i. ;
e. ; endsegment 2
\f
; rc 08.11.78 algol7, file-i procedures, ib, segment 3 page ...23...
; 01.02.81 eah
; init_file_i and start_file_i
b. j20,g7 ; block for segment 3
k = 10000
h. ;
g0=0 ; no of externals + no of globals
j0: g2 ,g1 ; rel of last point, rel of last absword
j1: -2, 0 ; address of segment 1
j2: 1<11+5, 0 ; address of segment 8
j5: 0, 1 ; result_i , permanent core, byte 0-1
j6: g0+13, 0 ; rs entry 13 last used
j7: g0+30, 0 ; - - 30 saved stackrefandw3
j8: g0+21, 0 ; - - 21 general alarm
j9: g0+8, 0 ; - - 8 end address expression
j11: g0+4, 0 ; - - 4 take expression
g1=k-2-j0 ; rel of last abs word
j14: g0+34, 0 ; rs entry point 34 inblock
g2=k-2-j0 ; rel of last point
w.
; procedure init_file_i(z, buckfactor, blockfactor);
; value buckfactor, blockfactor;
; zone z; real buckfactor, blockfactor;
;
; initializes the zone buffer with the head of the file and
; prepares it for init_rec_i;
; zonestate must be 0 (after open) at call, a successful call will
; set zonestate to initialize.
; resulti:
; 1 ok
; 2 ok, but buffer too small for insert_rec_i;
; procedure start_file_i (z);
; zone z;
;
; initializes the zonebuffer with the head of the file and
; prepares it for record handling.
; zonestate must be 0 at call, a successful call will
; set zonestate to readonly and yields the first record in
; the file as the zone record;
;
; result i:
; 1 ok, first record available
; 2 ok, - - - buffer too small for insert_rec_i;
; 3 as 1, but update mark found
; 4 as 2, - - - -
\f
; rc 10.12.70 algol 5, file_i procedures, jj, segment 3 page ...24...
b. a30 ; beginblock initfilei, startfilei
w. ;
e12: e13=k-j0 ; initfilei:
rl. w2 (j6.) ; w2: savedstackref:= lastused;
ds. w3 (j7.) ;
al w3 x2+6 ;
a1: al w3 x3+4 ;
rs w3 x2+6 ; initbit:= bit(23,firstf1):= true:=0;
dl w1 x3+2 ;
so w0 16 ; take real value of second and
jl. w3 (j11.) ; third parameter;
ds. w3 (j7.) ;
rl w3 (x2+6) ;
dl w1 x1 ;
so w3 1 ;
ci w1 0 ;
rl w3 x2+6 ;
ds w1 x3+2 ;
sh w3 x2+10 ;
jl. a1. ;
jl. a4. ; goto read file head;
e14: e15=k-j0 ; startfilei:
rl. w2 (j6.) ; w2:= savedstackref:= lastused;
ds. w3 (j7.) ; comment initbit=bit(23,firstf1)=false=1;
\f
; rc 08.11.78 algol7, file-i procedures, ib, segment 3 page ...25...
a4: rl w3 x2+8 ; read the file head:
rl w1 x3-h3+h0+6 ; comment checks that we have three
al w0 x1+h6+h6 ; shares available in z and reads as
se w0 (x3-h3+h0+8) ; many segments as the buffer will
jl. a21. ; hold, starting with segment 0.
rl w0 x3-h3+h2+6 ; inblock is cheated so that only
se w0 0 ; the first share is used;
jl. a20. ; if not three shares in z then goto shareerr; (a21.)
rs w1 x3-h3+h0+4 ; if zonestate <> 0 then goto zonestateerr; (a20.)
rs w1 x3-h3+h0+8 ; lastshare:= usedshare:= firstshare;
rs w0 x3-h3+h1+16 ; segmentcount:= 0;
rs w0 x1 ; sharestate(firstshare):= 0;
rl w0 x3-h3+h0+2 ; lastshared(firstshare):=
rs w0 x1+4 ; lastaddress(firstshare):=
rs w0 x1+10 ; lastofbuffer;
al w0 x3 ;
ls w0 4 ;
rl. w1 j14. ; inblock(z);
jl. w3 (j11.) ;
rl w3 x2+8 ; w3:= savew3:= zonedescr;
ds. w3 (j7.) ;
rl w3 x3-h3+h0 ; compute and test zonebufref:
rl w2 x3+1 ; w3:= basebuffer(zonedescr);
sh w2 2047 ; w2:= zonebufrefrel(w3);
sh w2 f16-1 ; if w2 > 2047 or w2 < minrefrel then
jl. a22. ; goto nothead;
wa w2 6 ; w2:= zonebufref:= w2+w3;
al w1 0 ; compute and test checksum: w1:= 0;
a5: al w3 x3+2 ; for w3:= basebuffer step 2
am (x3) ; until last of head do
al w1 x1 ; w1:= w1+word(w3);
se w3 x2+i7-1 ; comment address arithmetic
jl. a5. ; gives no overflow;
se. w1 (a15.) ; if w1 <> <:isq:> then
jl. a22. ; goto not head;
; now the file head has been accepted;
rl. w3 (j7.) ; compute and test top(bucks):
rs w3 x2+i2-0 ; w3:= zonerecordaddr:= zonedescr;
al w3 x3-h3+h1+2 ; w3:= nameaddress;
al w1 x2+i6+4 ; w1:= work(0:9)
jd 1<11+42 ; lookup(nameaddress, work);
bz w0 x2+i6+20 ; if contents <> 22 then
se w0 22 ;
jl. a18. ; goto contentserr;
bz w0 x2+i6+21 ;
rs w0 x2+i6+24 ; testbits:= tail(9) extract 12;
; processdescription
jd 1<11+4 ; (nameaddress(w3), result);
rl w1 0 ;
rl w0 x1 ; kind:= w0:= area process(0);
rl w1 x1+18 ; w1:=segsinfile:=area process(18);
sn w0 0 ; if kind=internal then
rl w1 x3-h1-2+h2+2; then segsinfile := free zone parameter;
al w0 0 ;
wd w1 x2+i2+2 ;
rs w1 x2+i6+4 ; noofbucks:= segsinfile//segsperbuck;
wm w1 x2+i3+4 ; top(bucks):= noofbucks*
al w1 x1+i8-i7 ; entrysize(bucks) + buckheadsize;
rs w1 x2+i3+12 ;
sh w1 (x2+i2+14) ; if top(bucks) > bucktablesize or
sh w1 i8-i7 ; top(bucks) <= buckheadsize then
jl. a25. ; goto areaerror;
al w0 x1+511 ;
ls w0 -9 ; sharesize(bucks):= (top(bucks) +
ls w0 9 ; segsize-1)//
rs w0 x2+i3+0 ; segsize*segsize;
\f
; rc 22.01.79 file_i procedures, segment 3, jj/ib page ...26...
al w3 x2+i7 ; move buck table:
wa w1 6 ; w1:=
a6: am (x2+i2+4) ; top(bucks)+startbuckhead;
rl w0 x3 ; for w3:= start buckhead step 2
rs w0 x3 ; until w1 do
al w3 x3+2 ; word(w3):=
se w3 x1 ; word(w3+bucktablemove);
jl. a6. ;
rl. w3 (j6.) ; w3:= stackref;
rl w0 x3+6 ; if initbit then
sz w0 1 ;
jl. a7. ; begin
rl w1 x2+i4+12 ; compute fillsizes:
ci w1 0 ;
fm w1 x3+12 ; fillblocks:
cf w1 0 ;
sh w1 (x2+i4+4) ; w1:= top(blocks)*buckfactor;
rl w1 x2+i4+4 ; if w1 < entrysize(blocks) then
sl w1 (x2+i4+12) ; w1:= entrysize(blocks);
rl w1 x2+i4+12 ; if w1 > top(blocks) then
al w0 x1 ; w1:= top(blocks);
ws w0 x2+i4+4 ; fill(blocks):= w1-entrysize(blocks);
rs w0 x2+i4+14 ;
wm w1 x2+i2+12 ; last(blocks):=
wd w1 x2+i4+12 ; w1*topfirstblocks//top(blocks);
rs w1 x2+i4+6 ;
rl w1 x2+i5+12 ; fillrecs:
ci w1 0 ;
fm w1 x3+16 ; w1:= top(recs)*blockfactor;
cf w1 0 ; if w1 < minrecsize then
sh w1 (x2+i2+18) ; w1:= minrecsize - 1;
rl w1 x2+i2+18 ; if w1 > top(recs) then
sl w1 (x2+i5+12) ; w1:= top(recs);
rl w1 x2+i5+12 ;
rs w1 x2+i5+14 ; fill(recs):= last(recs):= w1;
rs w1 x2+i5+6 ;
al w0 i8-i7 ; init buckhead:
rs w0 x2+i7+0 ; maxusedbucks:= buckheadsize;
al w0 0 ;
al w1 0 ;
ds w1 x2+i7+12 ; noofrecs:=
ds w1 x2+i7+4 ; recbytes:= 0;
al w0 1<2 ; updmarks:= initialize;
rs w0 x2+i7+14 ;
al w0 1<7+f8 ; w0:= initact;
jl. a8. ; end
\f
; rc 08.11.78 algol7, file-i procedures, ib, segment 3 page ...27...
a7: rl w1 x2+i7+6 ; else
rl w0 x2+i7+0 ; begin
sh w0 (x2+i3+12) ; checkbuckhead:
sh w0 i8-i7 ; if maxusedbucks>top(bucks) or maxusedbucks
jl. a24. ; <=buckheadsize then
rs w1 x2+i3+6 ; goto buckheaderr;
rl w0 x2+i7+14 ; if updmarks = initialize then
sz w0 1<2 ; alarm(9);
jl. a17. ;
so w0 1 ; if updmarks = update then
jl. a9. ; updmarks:= updmarks or gossip;
lo. w0 a14. ;
rs w0 x2+i7+14 ;
a9: rl w0 x2+i7+4 ; last(bucks):= ubfile;
lo w0 x2+i7+2 ;
sn w0 0 ; if noofrecs <= 0 then goto emptyfile;
jl. a19. ; w0:= startact
al w0 3<7+f9 ; end;
a8: hs w0 x2+i2+9 ; actno := w0;
rs w2 x3+6 ; firstformal.1 := zonebufref;
rl. w3 (j2.) ;
jl x3+d27 ; continue other segment
a14: 1<1 ; gossipbit
a15: <:isq:>; checksum ;
a16: <:<10>prep i<32><32>:> ;
;
a17: am 1 ; updmarks: w1:= 9 else
a18: am 1 ; contentserr: w1:= 8 else
a19: am 1 ; emptyfile: w1:= 7 else
a20: am 1 ; zonestateerr: w1:= 6 else
a21: am 1 ; shareerr: w1:= 5 else
a22: am 1 ; nothead: w1:= 4 else
am 1 ; w1:= 3 else
a24: am 1 ; bucktablehead:w1:= 2 else
a25: al w1 1 ; areasizeerr: w1:= 1;
al. w0 a16. ; general alarm
jl. w3 (j8.) ; (w1, <file_i>);
m.initfilei, startfilei
i. ;
e. ; endblock initfilei, startfilei
\f
; rc 26.06.70 algol 5, file_i procedures, jj, segment 3 page ...30...
j20=k-j0
c.j20-506
m.code on segment 3 too long
z.
c.502-j20,0,r.252-j20>1 z. ; fillwith zeroes
<:file_i pr. <0>:> ; alarmtext
m.segment3
i. ;
e. ; end segment 3
\f
; rc 27.08.70 algol 5, file_i procedures, jj, segment 4 page ...31...
; 01.02.81 eah
; insert rec i
b. b12,j20,g10; block for segment 4
k = 10000
h. ;
g0=0 ; no of externals + number of globals
j0: g1, g2; rel of last point, rel of last absword
j1: -3, 0 ; address of segment 1
j5: 0, 1 ; result_i, permanent core byte 0,1
j6: g0+13, 0 ; rs entry 13 lastused
j9: g0+8 , 0 ; - - 8 endaddressexpression
j15: g0+6 , 0 ; - - 6 endregexpression
j16:1<11+1, 0 ; address of segment 5
j17:1<11+2, 0 ; - - - 6
g2=k-2-j0 ; rel of last absword
g1=k-2-j0 ; - - - point
w. ;
; variables
; used in evaluate compress: evaluate empty block:
b0: 0 ; dbw step ubmax
b1: 0 ; - topi ubfirstdiff
b3: 0 ; dbw testsz
b2: 0 ; - blocksz otheri
b5: 0 ; dbw besti
b6: 0 ; - bestsz
b7: 0 ; dbw stackbottom
b10:0 ; - savestacktop, savereturn
b11: 1<22; constant: big
\f
; rc 08.11.78 algol7, file-i procedures, ib, segment 4 page ...33...
; insertreci
; preparation:
e16: e17=k-j0 ;
al w0 2.110 ; insertreci:
al w1 10<7+1<6+f7 ;
rl. w3 (j1.) ; prepare(states(put,update),
jl w3 x3+c1 ; insertact + getarray);
al w0 2 ;
rs. w0 (j5.) ; resulti:= 2;
rl. w3 (j1.) ;
jl x3+d11 ; goto lookup; comment on segment 1, a
d20: d21=k-j0 ; successful lookup will come back here:;
; (a successful lookup means record does not exist)
rl w3 x2+i2+10 ; continue insert: <*curr(recs) == base of next rec*>
jl w2 (x2+i0+10) ;
sh w1 (x2+i2+16) ; w1:= getsize(newrec);
sh w1 (x2+i2+18) ;
jl. g7. ; if w1 < minrecsize or
sz w1 3 ; w1 > maxrecsize or
jl. g7. ; w1 mod 4 <> 0 then
rs w1 x2+i5+4 ; goto lengtherror;
rl w0 x2+i3+i10 ; entrysize(recs):= w1; <*size of the new rec*>
rs w0 x2+i3+14 ; insert(bucks):= curr(bucks);
rl w0 x2+i4+i10 ; insert(blocks):= curr(blocks);
rs w0 x2+i4+14 ;
rl w0 x2+i5+6 ; tailsize:= insert(recs):= last(recs) -
ws w0 x2+i5+i10 ; curr(recs);
rs w0 x2+i5+14 ;
; strategy evaluation:
; evaluate simple insert:
al w0 0 ;
hs w0 x2+i1+7 ; w0:= strategy:= 0;
rl w3 x2+i5+6 ;
wa w3 x2+i5+4 ; if last(recs) + entrysize(recs) <
sh w3 (x2+i5+12) ; top(recs) then goto perform insert;
jl. g3. ; comment simple insert is possible;
se w0 (x2+i1+6) ; prepare other evaluation:
jl. g8. ; if shortbuf then
al w0 4 ; goto no buffer;
rl. w1 b11. ; price:= big;
ds w1 x2+i1+8 ; strategy:= 4;
\f
; rc 08.11.78 algol7, file-i procedures, ib, segment 4 page ...34...
b. a5 ; evaluate empty block:
w. ; begin
rl w1 x2+i4+12 ; find nearest buck with empty block:
al w0 x1 ; ubmax:= top(blocks) - first(blocks) -
ws w0 x2+i4+2 ; entrysize(blocks);
ws w0 x2+i4+4 ; comment ubmax is odd, this is used to
ws w1 x2+i2+12 ; set the boolean firsti, see below;
ds. w1 b1. ; ubfirstdiff:= top(blocks)-topfirstblocks;
; comment start with current bucket;
rl w3 x2+i3+i10 ; w3:= i:= otheri:= curr(bucks);
rs. w3 b2. ; w0:= snfirstblocks:=
rl w0 x2+i7+9 ; sn(file) + segsinshare(bucks);
ba w0 x2+i3+17 ;
a1: rl. w1 b0. ; loop: firsti:= true;
sn w0 (x3) ; comment firsti == odd(w1);
ws. w1 b1. ; if (if sn(i) = snfirstblocks then
sl w1 (x3-2) ; ubmax-ubfirstdiff else ubmax) >
jl. a4. ; ub(i) then goto found;
sh. w3 (b2.) ; if i < otheri then
ws w3 x2+i3+4 ; i:= i - entrysize(bucks);
a2: rx. w3 b2. ; changei: swop(i, otheri);
sl w3 (x2+i3+2) ; if i >= first(bucks) and
sn w3 (x2+i3+6) ; i <> last(bucks) then
jl. a3. ; begin if i >= otheri then
sl. w3 (b2.) ; i:= i + entrysize(bucks);
wa w3 x2+i3+4 ; goto loop
jl. a1. ; end;
a3: sz w1 1 ; if firsti then
jl. w1 a2. ; begin firsti:= false; goto changei end;
jl. a5. ; goto endemptyblock;
; comment no empty block available;
a4: rs w3 x2+i3+14 ; found: evaluate result:
ws w3 x2+i3+i10 ; insert(bucks):= i;
sh w3 -1 ;
ac w3 x3 ; w1:= abs(i-curr(bucks))*
bl w1 x2+i1+1 ; priceperbuck//entrysize(bucks) +
wm w1 6 ; emptyblockprice;
wd w1 x2+i3+4 ; if w1 < price then
ba w1 x2+i1+0 ; begin
al w0 2 ; strategy:= 2; price:= w1
sh w1 (x2+i1+8) ; end;
ds w1 x2+i1+8 ;
a5: ; endemptyblock:
i. ;
e. ; end evaluate empty block
\f
; rc 10.12.70 algol 5, file_i procedures, jj, segment 4 page ...35...
b. a2 ; evaluate empty buck:
w. ; begin
bl w1 x2+i1+3 ;
rl w3 x2+i3+6 ;
wa w3 x2+i3+4 ; w3:= last(bucks)+entrysize(bucks);
sh w3 (x2+i3+12) ; if w3 <= top(bucks) and
sl w1 (x2+i1+8) ; priceemptybuck < price then
jl. a1. ; begin
rs w3 x2+i3+14 ; insert(bucks):= w3; strategy:= 3;
al w0 3 ; price:= priceemptybuck
ds w1 x2+i1+8 ; end
a1: ; end evaluate empty buck;
i. ;
e. ;
b. a15; evaluate compress:
w. ; begin
bl w1 x2+i1+4 ;
sl w1 (x2+i1+8) ; if compressprice >= price then
jl. a15. ; goto endcompress;
dl w0 x2+i4+4 ; initialize local variables:
rl w1 x2+i4+6 ; w3:= first(blocks); topi:= last(blocks);
ds. w1 b1. ; step:= entrysize(blocks);
rl w1 x2+i2+22 ;
al w0 x1-1 ; blocksz:= bytesperblock;
ds. w1 b2. ; testsz:= bytesperblock-1;
rl w1 x2+i4+i10 ;
rl w0 x2+i5+6 ;
wa w0 x2+i5+4 ;
ba. w0 1 ;
rl w2 x2+i5+12 ; w2:= stacktop:= top(recs);
ws w0 4 ; ub(curr(blocks)):= last(recs) +
rs w0 x1-2 ; entrysize(recs) + 1 - top(recs);
rl. w1 b11. ; comment the overflow from the block;
ac w0 x1 ;
rs w0 x2 ; stackedsum(stacktop):= -big;
al w0 0 ; besti:= 0;
ds. w1 b6. ; bestsz:= big;
al w2 x2+4 ; w0:= sum:= 0;
al w3 x3-2 ; w2:= stackbottom:= stacktop + 1;
rs. w2 b7. ; w3:= i:= first(blocks)-2;
ds w0 x2 ; stackedsum(stacktop):= 0;
; stackedi(stacktop):= i;
jl. a3. ; goto fromstart;
\f
; rc 27.08.70 algol 5, file_i procedures, jj, segment 4 page ...36...
; evaluate compress, continued
a1: wa. w3 b0. ; include next: i:= i+step;
sl. w3 (b1.) ; if i > topi then
jl. a10. ; goto done;
rl. w1 b2. ; sumdiff:= blocksz -
ws w1 x3 ; ub(i);
sl w1 1 ; if sumdiff > 0 then
jl. a6. ; goto positivediff;
wa. w0 b3. ; sum:= sum+testsz;
a2: wa w0 2 ; negativediff: sum:= sum+sumdiff;
wa. w3 b0. ; i:= i+step;
sl. w3 (b1.) ; if i > topi then
jl. a10. ; goto done;
a3: rl. w1 b2. ; fromstart:
ws w1 x3 ; sumdiff:= blocksz-ub(i);
sh w1 0 ; if sumdiff <= 0 then
jl. a2. ; goto negativediff;
a4: al w2 x2-4 ; put sum in stack: comment sum is now a local minimum,
sh w0 (x2+4) ; we unstack any larger sum and stack this;
jl. a4. ; while stackedsum(stacktop) >= sum do
al w2 x2+8 ; stacktop:= stacktop-1;
ds w0 x2 ; stacktop:= stacktop+1; stackedsum(stacktop):= sum;
sh. w2 (b7.) ; stackedi(stacktop):= i;
rs. w2 b7. ; if stcktop < stackbottom then
; stackbottom:= stacktop;
ws. w0 b3. ; sum:= sum - testsz;
a6: wa w0 2 ; positive diff: sum:= sum+sumdiff;
rl. w1 b7. ; if sum <= stackedsum(stackbottom) then
sh w0 (x1) ; goto include next; comment not yet big enough;
jl. a1. ;
rs w0 x2+4 ; stackedsum(stacktop+1):= sum;
sz w0 0 ; comment to stop the loop below;
a7: al w1 x1+4 ;
am (x1+4) ; while sum > stackedsum(stackbottom+1) do
sl w0 1 ; stackbottom:= stackbottom+1;
jl. a7. ; savedstacktop:= stacktop;
ds. w2 b10. ; loweri:= w1:= stackedi(stackbottom);
dl w2 x1 ; lowersum:= w2:= stackedsum(stackbottom);
\f
; rc 27.08.70 algol 5, file_i procedures, jj, segment 4 page ...37...
; evaluate compress, continued
; try one less: comment i and sum corresponds to
a8: wa. w2 b2. ; the highest included entry, lower i and
ws w2 x1 ; lowersum to the lowest, we now try to move
wa. w1 b0. ; loweri one entry up at a time;
sl w0 x2+1 ; lowersum:= lowersum+blocksz-ub(loweri);
jl. a8. ; loweri:= loweri+step;
; if sum > lowersum then goto try one less;
ds. w2 (b7.) ; stackedi(stackbottom):= loweri;
ws. w1 b0. ; stackedsum(stackbottom):= lowersum;
am. (b6.) ; loweri:= loweri - step;
sl w3 x1 ; if i-loweri < bestsz then
jl. a9. ; begin
ac w2 x1 ; bestsz:= i - loweri;
wa w2 6 ; besti:= loweri;
ds. w2 b6. ; end;
a9: rl. w2 b10. ; solution found try to improve:
jl. a1. ; stacktop:= savestacktop; goto include next;
a10: rl. w2 (j6.) ; done:
rl w2 x2+6 ; w2:= zonebufref;
rl w0 x2+i5+6 ;
ws w0 x2+i5+2 ; ub(curr(blocks)):=
am (x2+i5+0) ; last(recs) - first(recs);
rs w0 -2 ;
\f
; rc 08.11.78 algol7, file-i procedures, ib segment 4 page ...38...
; evaluate compress, continued
; perform insertion
bl w1 x2+i1+5 ; evaluate result:
wm. w1 b6. ; w1:= priceperblock *
wd w1 x2+i4+4 ; bestsz // entrysize(blocks) +
ba w1 x2+i1+4 ; compress price;
rl. w3 b5. ;
sh w1 (x2+i1+8) ;
sn w3 0 ; if besti <> 0 and w1 < price then
jl. a15. ; begin
al w3 x3+2 ; insert(blocks):= besti+2;
rs w3 x2+i4+14 ; strategy:= 1;
al w0 1 ; price:= w1
ds w1 x2+i1+8 ; end;
a15: ; after compress:
i. ;
e. ; end evaluate compress
; test the price:
dl w1 x2+i1+8 ;
sn w0 4 ; if strategy = 4 then
jl. g6. ; goto file is full;
sl w1 (x2+i1+10) ; if price >= pricelimit then
jl. g5. ; goto too expensive;
; perform insertion:
; comment all possible strategies passes this label;
g3: al w3 f14 ;
hs w3 (x2+i3+10) ; shareop(bucks):=
hs w3 (x2+i4+10) ; shareop(blocks):= writeop;
rl. w3 (j17.) ; if strategy < 2 then
sh w0 1 ; goto compress bucket
jl x3+d25 ; else goto insert and move blocks;
jl x3+d29 ; comment on segment 6;
; errorexits:
g5: am -1 ; too expensive: resulti:= 3 else
g6: am -1 ; file is full : resulti:= 4 else
g7: am -1 ; length error : resulti:= 5 else
g8: al w0 6 ; no buffer : resulti:= 6 ;
rs. w0 (j5.) ;
rl. w3 (j1.) ; goto access next;
rl w1 (x3) ;
rl w3 x2+i5+i10 ;
jl x1+d3 ;
; end of segment
j20=k-j0 ;
c.j20-506 ;
m. code on segment 4 too long
z.
c.502-j20,0,r.252-j20>1 z.; fill with zeroes
<:fileipr. s4<0>:>
m. segment 4
i.
e.
\f
; rc 08.11.78 algol7, file-i procedures, ib, segment 5 page ...40...
; 01.02.81 eah
; move subroutines must not refer to other segments
b. j20, g2 ; block for segment 5
k = 10000
h. ;
g0=0 ; no of externals + no of globals
j0: g1, g2; rel of last point, rel of last absword
j1: -4, 0; address of segment 1, only used from initbucktable
j6: g0+13, 0 ; rs entry 13 last used
j15: g0+6 , 0 ; - - 6 endregexpression
g2=k-2-j0 ; rel of last absword
g1=k-2-j0 ; - - - point
w.
; subroutine movewrds (source, destination, size);
; moves a number of consecutive words from one place in
; core to another in either increaseing or decreasing
; address order depending on the sign of size:
; increasing address order:
; size = number of bytes to move, size must be even.
; source+1 = address of first byte to move from, source odd.
; destination+1 = - - - - - - to, destination odd.
; destination+
; size = - - last byte to move to.
; decreasing address order:
; -size = number of bytes to move, size must be even.
; source = address of first byte to move from, i.e.
; last byte of source area, source odd.
; destination = address of first byte to move to, i.e.
; last byte of destination area, destination odd.
; destination+
; size+1 = address of last byte to move to, i.e.
; first byte of destination area, destination odd.
; entry: exit:
; w0 size undefined
; w1 destination destination+size
; w2 source zonebufref (from first formal.1)
; w3 return undefined
b. a10; begin block movewrds
w. ;
a0: 0 ; saved return
a1: 0 ; saved limit = destination+size, a0a1 doubleword
c16: c17=k-j0 ;
sz w0 2 ; if odd number of words then
jl. a6. ; goto moveodd;
wa w0 2 ; w0:= limit:= destination+size;
; subroutine movedbwrds (source, destination, limit);
; as movewrds except that:
; w0 = limit = destination+size on entry and
; that only an even number of words can be moved.
c18: c19=k-j0 ; comment continuation from c16;
ds. w0 a1. ; save return and limit;
sh w0 x1 ; if limit <= destination then
jl. a8. ; goto movebackw;
\f
; rc 27.08.70 algol 5, file_i procedures, jj, segment 5 page ...41...
; move-subroutines, continued
a2: al w1 x1+128 ; moveforw:
sh. w1 (a1.) ; destination:= destination+128;
jl. a3. ; if destination > limit then
al w3 x1-128 ; begin
rl. w1 a1. ; w3:= destination-128-limit;
ws w3 2 ; comment -number of bytes still to move;
ws w2 6 ; destination:= limit; source:= source-w3;
jl. x3+a4. ; goto move -w3 bytes
; end;
a3: al w2 x2+128 ; move128forw: source:= source+128;
dl w0 x2-124, ds w0 x1-124, dl w0 x2-120, ds w0 x1-120;
dl w0 x2-116, ds w0 x1-116, dl w0 x2-112, ds w0 x1-112;
dl w0 x2-108, ds w0 x1-108, dl w0 x2-104, ds w0 x1-104;
dl w0 x2-100, ds w0 x1-100, dl w0 x2-96 , ds w0 x1-96 ;
dl w0 x2-92 , ds w0 x1-92 , dl w0 x2-88 , ds w0 x1-88 ;
dl w0 x2-84 , ds w0 x1-84 , dl w0 x2-80 , ds w0 x1-80 ;
dl w0 x2-76 , ds w0 x1-76 , dl w0 x2-72 , ds w0 x1-72 ;
dl w0 x2-68 , ds w0 x1-68 , dl w0 x2-64 , ds w0 x1-64 ;
dl w0 x2-60 , ds w0 x1-60 , dl w0 x2-56 , ds w0 x1-56 ;
dl w0 x2-52 , ds w0 x1-52 , dl w0 x2-48 , ds w0 x1-48 ;
dl w0 x2-44 , ds w0 x1-44 , dl w0 x2-40 , ds w0 x1-40 ;
dl w0 x2-36 , ds w0 x1-36 , dl w0 x2-32 , ds w0 x1-32 ;
dl w0 x2-28 , ds w0 x1-28 , dl w0 x2-24 , ds w0 x1-24 ;
dl w0 x2-20 , ds w0 x1-20 , dl w0 x2-16 , ds w0 x1-16 ;
dl w0 x2-12 , ds w0 x1-12 , dl w0 x2-8 , ds w0 x1-8 ;
dl w0 x2-4 , ds w0 x1-4 , dl w0 x2 , ds w0 x1 ;
a4: se. w1 (a1.) ; if destination <> limit then
jl. a2. ; goto moveforw;
a5: rl. w2 (j6.) ; exit:
rl w2 x2+6 ; w2:= first formal.1;
jl. (a0.) ; return;
a6: wa w0 2 ; moveodd:
ds. w0 a1. ; w0:= limit:= destination + size;
sh w0 x1 ; save limit and return;
jl. a7. ; if limit <= destination then
al w1 x1+2 ; goto oddbackw;
al w2 x2+2 ; oddforw: source:= source+2;
rl w0 x2 ; destination:= destination+2;
rs w0 x1 ; word(destination):= word(source);
jl. a2. ; goto moveforw;
a7: rl w0 x2 ; oddbackw:
rs w0 x1 ; word(destination):= word(source);
al w1 x1-2 ; destination:= destination-2;
al w2 x2-2 ; source:= source-2;
a8: al w1 x1-128 ; movebackw:
sl. w1 (a1.) ; destination:= destination-128;
jl. a9. ; if destination < limit then
ac w3 x1+128 ; begin
rl. w1 a1. ; w3:= limit - (destination+128);
wa w3 2 ; comment - number of bytes stil to move;
wa w2 6 ; destination:= limit; source:= source+w3;
jl. x3+a10. ; goto move -w3 bytes;
; end;
\f
; rc 27.08.70 algol 5, file_i procedures, jj, segment 5 page ...42...
; move-subroutines, continued
a9: al w2 x2-128 ; move128backw: source:= source-128;
dl w0 x2+128, ds w0 x1+128, dl w0 x2+124, ds w0 x1+124;
dl w0 x2+120, ds w0 x1+120, dl w0 x2+116, ds w0 x1+116;
dl w0 x2+112, ds w0 x1+112, dl w0 x2+108, ds w0 x1+108;
dl w0 x2+104, ds w0 x1+104, dl w0 x2+100, ds w0 x1+100;
dl w0 x2+96 , ds w0 x1+96 , dl w0 x2+92 , ds w0 x1+92 ;
dl w0 x2+88 , ds w0 x1+88 , dl w0 x2+84 , ds w0 x1+84 ;
dl w0 x2+80 , ds w0 x1+80 , dl w0 x2+76 , ds w0 x1+76 ;
dl w0 x2+72 , ds w0 x1+72 , dl w0 x2+68 , ds w0 x1+68 ;
dl w0 x2+64 , ds w0 x1+64 , dl w0 x2+60 , ds w0 x1+60 ;
dl w0 x2+56 , ds w0 x1+56 , dl w0 x2+52 , ds w0 x1+52 ;
dl w0 x2+48 , ds w0 x1+48 , dl w0 x2+44 , ds w0 x1+44 ;
dl w0 x2+40 , ds w0 x1+40 , dl w0 x2+36 , ds w0 x1+36 ;
dl w0 x2+32 , ds w0 x1+32 , dl w0 x2+28 , ds w0 x1+28 ;
dl w0 x2+24 , ds w0 x1+24 , dl w0 x2+20 , ds w0 x1+20 ;
dl w0 x2+16 , ds w0 x1+16 , dl w0 x2+12 , ds w0 x1+12 ;
dl w0 x2+8 , ds w0 x1+8 , dl w0 x2+4 , ds w0 x1+4 ;
a10: se. w1 (a1.) ; if destination <> limit then
jl. a8. ; goto movebackw;
jl. a5. ; goto exit;
i. ;
e. ; end block movewrds
\f
; rc 27.08.70 algol 5, file_i procedures, jj, segment 5 page ...43...
; move-subroutines, continued
; subroutine moveentries (descr,newempty,sn(newempty));
; moves the entries in the table given by descr so that a,
; presumeably empty, entry at curr(descr) will be shifted
; so that it follows immediately after the entry at
; insert(descr).
; if the entry at insert(descr) is moved then insert(descr)
; is changed accordingly.
; sn(curr(descr)) is also moved to the new empty entry.
; entry: exit:
; w0 irrelevant sn(newempty)
; w1 descr unchanged
; w2 zonebufref zonebufref (from first formal.1)
; w3 return newempty
; uses: work0 and returnsegm for working locations
; calls: movewrds ( on this segment )
b. a1; begin block moveentries
w. ;
a0: 0 ; return
a1: 0 ; newempty, a0a1 doubleword
c20: c21=k-j0 ;
rl w0 (x1+i10) ; begin
ds w1 x2+i6+4 ; work0:= saveddescr:= w1;
rl w0 x1+14 ; returnsegm:= savedsn:=
rl w2 x1+i10 ; sn(curr(descr));
sl w0 x2 ; if insert(descr) >= curr(descr) then
ws w0 x1+4 ; insert(descr):=
rs w0 x1+14 ; insert(descr)-entrysize(descr);
wa w0 x1+4 ; newempty:=
ds. w0 a1. ; insert(descr)+entrysize(descr);
ws w0 4 ; return:= w3;
bs w2 x1+16 ; w0:= size:= newempty-curr(descr);
rl w1 x1+4 ; w2:= curr(descr)-headsz(descr);
wa w1 4 ; w1:= w2+entrysize(descr);
sl w0 0 ; if size < 0 then
rx w1 4 ; movewrds (w2, w1, size)
jl. w3 c16. ; else
dl w1 x2+i6+4 ; movewrds (w1, w2, size);
al w3 0 ; ub(newempty):= 0;
ds. w0 (a1.) ; w0:= sn(newempty):= savedsn;
rl. w3 a1. ; w3:= newempty;
jl. (a0.) ; w1:= saveddescr
; end;
i. ;
e. ; end block move entries
\f
; rc 08.11.78 algol7, file-i procedures, ib, segment 5 page ...44...
; subroutine initblocktable;
; initializes the blocktable for curr(bucks), writes cleared blocks and the bucktable.
; sets ubfile, maxusedbucks, last(bucks), ub(last(bucks)).
; work1-2 is used for return inf.
; work3 - - to save curr(recs) before call of putnew.
; entry: exit:
; w0 return segm undefined
; w1 irrelevant undefined
; w2 zonebufref unchanged
; w3 return undefined
b. a1; begin block init block table
w. ;
c28: c29=k-j0 ; begin
ws w3 (0) ; save return in:
hs w3 x2+i6+1 ; work1: jl x3+rel
rl w3 x2+i6+0 ; work2: return segm
ds w0 x2+i6+8 ;
rl w1 x2+i5+2 ;
rx w1 x2+i5+i10 ; save curr(recs)
rs w1 x2+i6+10 ; curr(recs):= first(recs)
rl w1 x2+i3+i10 ;
rs w1 x2+i3+6 ; last(bucks):= curr(bucks);
al w0 0 ;
rs w0 x1-2 ; ub(last(bucks)):= 0;
rl w0 x1 ; w0:= sn(last(bucks));
ws w1 x2+i3+2 ;
rs w1 x2+i7+6 ; ubfile:= last(bucks) - first(bucks);
wa w1 x2+i3+4 ;
al w1 x1+i8-i7 ; w1:= ubfile+entrysize(bucks)+
sl w1 (x2+i7+0) ; buckheadsize;
rs w1 x2+i7+0 ; if w1 > maxused bucks then
ba w0 x2+i4+17 ; maxusedbucks:= w1;
rl w1 x2+i4+2 ; w0:= w0 + segsinshare(blocks);
; init the blocktable and put cleared blocks:
; <*w1 = first(blocks)*>
; repeat
a1: rs w1 x2+i5+0 ; these(recs):= entryaddr;
rs w0 x1 ; sn(these(recs)):= w0:= segmno;
;
al w1 x2+i5 ;
rl. w0 j0. ; putnew(recs, false);
rl. w3 (j1.) ;
jl w3 x3+c13 ;
;
rl w1 x1 ;
rl w0 x1 ; w0:= sn(these(recs)) +segsper(recs);
ba w0 x2+i5+17 ; w1:= these(recs) +entrysize(blocks);
wa w1 x2+i4+4 ;
bz w3 x2+i5+16 ; until
sh w0 x3 ; w1 > (if w0 > segsperbuck then
am i2+12-i4-12 ; topfirstblocks else top(blocks));
sh w1 (x2+i4+12) ;
jl. a1. ;
;
al w0 f14 ; put the bucktable:
al w1 x2+i3 ;
hs w0 (x1+10) ;
rl. w0 j0. ;
rl. w3 (j1.) ;
jl w3 x3+c7 ;
rl w0 x2+i6+10 ; reset curr(recs)
rs w0 x2+i5+i10 ;
rl w3 (x2+i6+8) ; return
jl x2+i6+6 ;
;
i. ;
e. ; end block init block table
; end of segment
j20=k-j0 ;
c.j20-506 ;
m. code on segment 5 too long
z.
c.502-j20,0,r.252-j20>1 z.; fill with zeroes
<:fileipr. s5<0>:>
m. segment 5
i.
e.
\f
; rc 08.11.78 algol7, file-i procedures, ib, segment 6 page ...45...
; 01.02.81 eah
; the code which performs insertions
; entered in d24 or d29 from the end of e16 (on segment 4)
b. j20, g2 ; block for segment 6
k = 10000
h. ;
g0=0 ; no of externals + no of globals
j0: g1, g2; rel of last point, rel of last absword
j1: -5, 0 ; address of segment 1
j9: 1<11+3, 0 ; address of segment 9
j16: -1, 0 ; - - - 5
g2=k-2-j0 ; rel of last absword
g1=k-2-j0 ; - - - point
w. ;
; subroutine switchbuf; setbuf(-bufdiff);
c22: c23=k-j0 ;
ac w1 (x2+i6+28) ;
; subroutine setbuf (diff);
; sets bufdiff, messaddresses(recs) and
; first(recs) on the basis of diff;
; entry: exit:
; w0 irrelevant new first(recs)
; w1 diff new lastmessaddr(recs)
; w2 zonebufref unchanged
; w3 return unchanged
c24: c25=k-j0 ; begin
rs w1 x2+i6+28 ;
sh w1 0 ; bufdiff:= w1:= diff;
al w1 0 ; if diff <= 0 then w1:= 0;
al w0 x1 ; w0:= w1;
am (x2+i5+10) ; firstmessaddr(recs):=
aa w1 -2 ; firstshared(recs)+w0;
am (x2+i5+10) ; lastmessaddr(recs):=
ds w1 4 ; lastshared(recs)+w1;
bs. w0 1 ; first(recs):=
rs w0 x2+i5+2 ; firstmessaddr(recs)-1;
jl x3 ; end;
; subroutine setkeyparts;
; sets the keypart of curr(blocks) and, if needed, of curr(bucks);
; entry: exit:
; w0 irrelevant undefined
; w1 irrelevant undefined
; w2 zonebufref unchanged
; w3 return undefined
; uses: work0 for save return
c26: c27=k-j0 ; begin
rs w3 x2+i6+4 ;
rl w3 x2+i5+2 ; savethekey(first(recs));
jl w2 (x2+i0+4) ;
rl w3 x2+i4+i10 ; copykey(curr(blocks));
jl w2 (x2+i0+8) ;
se w3 (x2+i4+2) ; if curr(blocks) = first(blocks) then
jl (x2+i6+4) ;
rl w3 x2+i3+i10 ; copykey(curr(bucks));
jl w2 (x2+i0+8) ;
jl (x2+i6+4) ; end;
\f
; rc 08.11.78 algol7, file-i procedures, ib, segment 6 page ...46...
; the code which performs insertions, continued
b. a25; begin block compress bucket
w. ;
d24: d25=k-j0 ; compress bucket:
rl w3 x2+i4+i10 ;
sn w3 (x2+i4+14) ; if curr(blocks) = insert(blocks) then
jl. a14. ; goto insert and compress;
rx w3 x2+i4+14 ; swop
rs w3 x2+i4+i10 ; (curr(blocks),insert(blocks));
al w1 x2+i5+1 ; inout(recs, true);
rl. w0 j0. ; comment read the first block;
rl. w3 (j1.) ;
jl w3 x3+c7 ;
rl w3 x2+i4+4 ; w3:= entrysize(blocks);
a1: rs w3 x2+i5+8 ; readloop: comment w3 = situation;
wa w3 x2+i4+i10 ; situation:= w3;
rs w3 x2+i4+i10 ; curr(blocks):= curr(blocks) + w3;
rl w1 x2+i5+6 ;
rs w1 x2+i5+i10 ; curr(recs):= last(recs);
ws w1 x2+i5+2 ;
jl. w3 c24. ; setbuf(last(recs)-first(recs));
al w1 x2+i5 ;
rl. w0 j0. ;
rl. w3 (j1.) ; inout(recs, false);
jl w3 x3+c7 ;
jl. w3 c22. ; switchbuf;
rl w3 x2+i4+i10 ;
ws w3 x2+i5+8 ; curr(blocks):= curr(blocks)-situation;
rx w3 x2+i4+i10 ; if curr(blocks)+situation = insert(blocks)
sn w3 (x2+i4+14) ; then goto insert block has been read;
jl. a10. ;
a3: rl w3 x2+i5+i10 ; extendrecs: comment find how much to
; output as one block;
a4: sl w3 (x2+i5+6) ; w3:=curr(recs);
jl. a5. ; while w3 < last(recs) do
jl w2 (x2+i0+10) ; begin
wa w3 2 ; w1:= getsize(w3);
sh w3 (x2+i5+12) ; if w1+w3 > top(recs) then goto a5;
jl. a4. ; w3:= w3+w1;
ws w3 2 ; end;
a5: rs w3 x2+i5+i10 ; a5: curr(recs):= w3;
\f
; rc 08.11.78 algol7, file-i procedures, ib, segment 6 page ...47...
a6: bz w0 x2+i1+7 ; writeblock:
; <*with zero in unused words*>
sn w0 0 ; if strategy = simple insert then
jl. a24. ; goto simple;
;
rl w3 4 ;
bz w2 x3+i5+17 ;
ls w2 9 ;
wa w2 x3+i5+2 ; w2:= last share byte:= segsper*512 +first(recs)
rl w0 x3+i5+i10 ;
ws w0 4 ; w0:= -bytes to move:= curr(recs) -lastsharebyte
sn w0 0 ; if no unused bytes in this block then
jl. a25. ; goto put_no_move;
am (x3+i2+0) ;
rl w1 -h3+h0+2 ; w1:= last of zbuf
ds w1 x3+i6+8 ; work1work2work3:= -bytes_to_move, last_of_zbuf,
rs w2 x3+i6+10 ; lastsharebyte;
rl. w3 (j16.) ; movewrds(fromw2(lastsharebyte),
jl w3 x3+c17 ; tow1(last_of_zbuf*>, sizew0<*-bytes_to_move*>);
;
al w1 x2+i5 ;
rl. w0 j0. ;
rl. w3 (j1.) ; putnew(recs, false);
jl w3 x3+c13 ;
;
rl w0 x2+i6+6 ;
rl w1 x2+i6+10 ; movewrds(fromw2<*lastofzbuf*>,
rl w2 x2+i6+8 ; tow1<*lastsharebyte*>,
rl. w3 (j16.) ; sizew0<*-bytestomove*>);
jl w3 x3+c17 ;
;
a22: ;
rl w3 x2+i4+i10 ; w3:=
wa w3 x2+i4+4 ; curr(blocks)+entrysize(blocks);
\f
; rc 09.11.78 algol7, file-i procedures, ib segment 6 page ...48...
; compress bucket, continued
rl w0 x2+i5+6 ; test for overflow from the block written:
ws w0 x2+i5+i10 ;
wa w0 x2+i5+2 ; w0:= first(recs)+last(recs)-curr(recs);
sh w0 (x2+i5+2) ; if w0 > first(recs) then
jl. a8. ;
a7: ; overflow:
rl w1 x2+i5+2 ; begin move to front:
rs w0 x2+i5+6 ; last(recs):= w0;
rs w3 x2+i4+i10 ; curr(blocks):= w3;
rl w2 x2+i5+i10 ; movedbwrds ( curr(recs),
rl. w3 (j16.) ; first(recs),
jl w3 x3+c19 ; last(recs) );
rs w1 x2+i5+i10 ; curr(recs):= last(recs);
rl w3 x2+i5+8 ; decide action on overflow:
sn w3 -3 ; if situation = -3 then
jl. a16. ; goto moveblocks;
jl. w3 c26. ; setkeyparts;
rl w3 x2+i5+8 ;
sl w3 0 ; goto
jl. a1. ; if situation >= 0 then readloop
sn w3 -1 ; else if situation = -1 then writeblock
jl. a6. ; else insert and compress
jl. a14. ; end overflow;
a8: rl w1 x2+i5+8 ; no overflow:
sn w1 -2 ; if situation = -2 then goto overflow;
jl. a7. ; comment because record not inserted yet;
sh w1 0 ;
jl. a9. ; if situation > 0 then
al w1 x2+i4 ; empty block:
rs w0 x2+i5+6 ; begin
rs w3 x2+i4+i10 ; last(recs):= w0;
rl. w3 (j16.) ; curr(blocks):= w3;
jl w3 x3+c21 ; move entries (blocks);
rl w3 x2+i4+14 ; curr(blocks):= insert(blocks);
rs w3 x2+i4+i10 ; w3:= new situation:= 0;
al w3 0 ; goto readloop
jl. a1. ; end empty block;
a24: rl w0 x2+i5+i10 ; simple: comment writing can wait till needed;
ws w0 x2+i5+2 ; ub(these(recs)):= curr(recs) -first(recs);
am (x2+i5+0) ;
rs w0 -2 ;
al w0 f14 ; shareop(recs):= write;
hs w0 (x2+i5+10) ;
a9: rl. w3 (j1.) ; record inserted: comment but maybe not
jl x3+d1 ; in curr(blocks); goto searchrec;
; end insertreci
\f
; rc 10.11.78 algol7, file-i procedures, ib, segment 6 page ...49...
; compress bucket, continued
; insert block has been read:
a10: sn w3 (x2+i4+i10) ; if curr(blocks) = insert(blocks) then
; insert now no compress:
a11: am 1 ; situation:= -1 else
; insert now or in next:
a12: am 1 ; situation:= -2 else
d28: d29=k-j0 ; insert and move blocks:
a13: am -3 ; situation:= -3 else
a14: al w1 0 ; insert and compress:
rs w1 x2+i5+8 ; situation:= 0;
rl w0 x2+i5+6 ;
ws w0 x2+i5+14 ;
sl w0 (x2+i5+12) ; if last(recs) - tailsize > top(recs)
jl. a3. ; then goto extend recs;
rs w0 x2+i5+i10 ; curr(recs):= last(recs) - tailsize;
wa w0 x2+i5+4 ;
se w1 -2 ; if situation = -2 then
jl. a15. ; begin
sl w0 (x2+i5+12) ; if curr(recs) + entrysize(recs) > top(recs)
jl. a6. ; then goto writeblock;
al w1 -1 ; situation:= -1
rs w1 x2+i5+8 ; end;
a15: dl w2 x2+i5+6 ; insert the record:
wa w1 4 ; movedbwrds ( last(recs),
rl. w3 (j16.) ; last(recs)+entrysize(recs),
jl w3 x3+c19 ; curr(recs)+entrysize(recs) );
al w0 x1 ; last(recs):= curr(recs)+
wa w1 x2+i5+14 ; entrysize(recs) + tailsize;
rs w1 x2+i5+6 ;
rl w1 x2+i5+i10 ; movedbwrds ( newrec,
rl w2 x2+i2+10 ; curr(recs),
rl. w3 (j16.) ; curr(recs)+entrysize(recs) );
jl w3 x3+c19 ;
al w0 0 ;
al w1 1 ;
aa w1 x2+i7+4 ; noofrecs:= noofrecs +1;
ds w1 x2+i7+4 ;
al w0 0 ;
rl w1 x2+i5+4 ;
aa w1 x2+i7+12 ;
ds w1 x2+i7+12 ; recbytes:= recbytes+entrysize(recs);
rl w3 x2+i5+2 ;
sn w3 (x2+i5+i10) ; if first(recs) = curr(recs) then
jl. w3 c26. ; setkeyparts;
jl. a3. ; goto extend recs;
;
a25: rl w2 6 ; putnomove:
al w1 x2+i5 ;
rl. w0 j0. ;
rl. w3 (j1.) ; putnew(recs, false);
jl w3 x3+c13 ;
jl. a22. ;
;
a16: rl. w3 (j9.) ; move blocks:
jl x3+d31 ; <*continue other segment*>
i. ;
e. ; end block compress bucket
\f
; rc 10.12.70 algol 5, file_i procedures, jj, segment 6 page ...51...
; end segment
; end of segment
j20=k-j0 ;
c.j20-506 ;
m. code on segment 6 too long
z.
c.502-j20,0,r.252-j20>1 z.; fill with zeroes
<:fileipr. s6<0>:>
m. segment 6
i.
e.
\f
; rc 10.12.70 algol 5, file_i procedures, jj, segment 7 page ...52...
; 01.02.81 eah
; getparamsi, setparamsi, settesti
b. b4,g7,j20 ; block for segment 7
k = 10000
h. ;
g0=0 ; no of externals + number of globals
j0: g1, g2; rel of last point, rel of last absword
j1: -6, 0 ; address of segment 1
j5: 0, 1 ; resulti, permanent core bytes 0,1
j6: g0+13, 0 ; rs entry 13 last used
j7: g0+30, 0 ; - - 30 saved stackref and w3
j11: g0+4 , 0 ; - - 4 take expression
j15: g0+6 , 0 ; - - 6 endregexpression
g2=k-2-j0 ; rel of last absword
g1=k-2-j0 ; rel of last point
w. ;
; variables and constants
; name in: getparams setparams settest
b0: 0 ; dbw paramno paramno procno
b1: 0 ; - valaddr val results
b2: 0 ; - bufaddr bufaddr setbits
b3: 0 ; longparam longparam i
b4: 10;
\f
; rc 10.12.70 algol 5, file_i procedures, jj segment 7 page ...53...
; 01.02.81 eah
; integer procedure getparamsi (z) one or more pairs:(paramno, val);
; integer procedure setparamsi (z) one or more pairs:(paramno, val);
; integer procedure settesti (z) optional parameter:(testproc)
; one or more pairs:(procno, results);
b. a12 ; beginblock commonpart: entryadministration, getparampair
w. ;
e24: e25=k-j0 ; getparamsi:
am -13<7+12<7 ; w1:= getparamact else
e26: e27=k-j0 ; setparamsi:
am -14<7+13<7 ; w1:= setparamact else
e28: e29=k-j0 ; settesti:
al w1 14<7 ; w1:= settestact;
al w0 2.11111 ;
rl. w3 (j5.) ; work0:= resulti;
rs. w3 b0. ;
rl. w3 (j1.) ; prepare (all i states, w1);
jl w3 x3+c1 ;
rl. w3 b0. ; resulti:= work0;
rs. w3 (j5.) ;
al w1 x2 ; w1:= zonebufref;
rl. w2 (j6.) ; w2:= stackref;
al w3 x2+7 ;
ba w3 x2+4 ; formallimit:= firstformal2:=
rs w3 x2+8 ; stackref + appetite(stackref) + 7;
sh w3 x2+13 ; if formallimit <= addr(second formal) then
jl. a9. ; goto exitminus; comment too few parameters;
bl w0 x1+i2+9 ;
se w0 14<7 ; if actno = settestact then
jl. a2. ; begin
dl w0 x2+12 ; w3w0:= secondformal;
sz w3 2.11111 ; if kind(w3) = procedure then
jl. a1. ; begin
ls w3 -4 ; if stackref(w3) < zonebufref then
sh w3 x1 ; goto exitminus; comment scope error;
jl. a9. ; teststackref:= w3; testproc:= w0;
ds w0 x1+i1+16; w3:= address(thirdformal) + 1;
al w3 x2+18 ; goto firstpair
jl. a4. ; end;
a1: rl w0 x1+i1+16; if testproc = 0 then
sn w0 0 ; goto exitminus; comment no testproc;
jl. a9. ; end;
a2: al w3 x2+14 ; w3:= address(secondformal) + 1;
jl. a4. ; goto firstpair;
\f
; rc 10.12.70 algol 5, file_i procedures, jj, segment 7 page ...54...
; 01.02.81 eah
; getparampair:
; checks the next pair of parameters and switches to the proper action
; defined by actno or exits when through or error.
g3: ; getparampair:
rl. w2 (j6.) ; w2:= stackref
rl w3 x2+10 ; w3:= paramaddr
am 2 ; + 2;
a3: ; next_of_pair:
al w3 x3+3 ; w3:= w3 + 3;
a4: ; first_of_pair:
sl w3 (x2+8) ; if w3 >= formal_limit then
jl. a8. ; goto testfinis;
dl w1 x3-1 ; w0w1:= formalpair;
rs w3 x2+10 ; save paramaddr in formal1.2
al w3 2.11111 ;
la w3 0 ; w3:= paramkind;
se w3 10 ; if kind <> int.expr and
sn w3 12 ; kind <> long.expr then
jl. a5. ; begin
se w3 26 ; if kind <> int.var and
sn w3 28 ; kind <> long.var
jl. a11. ; then
jl. g4. ; goto exitn;
a11: sh w1 (x2+8) ; if paramaddr(w1) < formal_limit then
rs w1 x2+8 ; formal_limit:= param_addr;
jl. a6. ; end
; else
a5: ; begin
jl. w3 (j11.) ; take_expression;
ds. w3 (j7.) ; save stackref
a6: ; end;
rl w3 x2+10 ; w3:= paramaddr;
al w0 2.1111 ; w0:= kind:=
la w0 x3-3 ; formal1(paramaddr) extract 4;
sn w0 12 ; if kind = long
al w0 0 ; then longparam:= 0
rs. w0 b3. ; else longparam:= <>0;
rl w0 x1 ; w0:=
rs w0 x3-1 ; formal2(paramaddr):= value(address);
so w3 1 ; if even (w3) then
jl. a3. ; goto nextofpair;
rl w2 x2+6 ; w2:= zonebufref;
rl w3 x3-5 ; b0:= w3:= value(firstparam);
ds. w0 b1. ; b1:= w0:= value(secondparam);
bz w3 x2+i2+9 ; w1:= address(secondparam);
sn w3 12<7 ;
jl. g5. ; switch to action (actno)
sn w3 13<7 ; of:(getparam, set param, settest);
jl. g6. ;
jl. g7. ;
g4: rl. w2 (j6.) ; exitn: w2:= stackref;
rl w3 x2+10 ; w3:= paramaddr;
a7: ws w3 4 ; oddpair:
al w1 x3-6 ; w1:= pairno:=
ls w1 -3 ; (w3-stackref-6)//8;
jl. (j15.) ; goto endregexpression;
a8: sz w3 1 ; testfinis:
jl. a7. ; if odd(w3) then goto oddpair;
am 1 ; exit0: w1:= 0 else
a9: al w1 -1 ; exitminus: w1:= -1;
jl. (j15.) ; goto endregexpression;
i. ;
e. ; endblock commonpart
\f
; rc 14.01.71 algol 5, file_i procedures, jj, segment 7 page ...55...
; 01.02.81 eah
b. a12,c3,d2 ; beginblock getparam and setparam
w. ;
g5: ; getparam:
rs. w1 b1. ; valaddr:= w1; <*addr of return param*>
rl. w3 b3. ; w3:= longparam;
sn w3 0 ; if longparam then
rs w3 x1-2 ; first_word_of_param:= 0;
al. w3 a5. ; w3:= base extraget;
jl. a12. ; goto get_or_set_param;
g6: ; setparam:
rl. w3 b3. ; w3:= longparam;
se w3 0 ; if longparam then
jl. a11. ; begin
dl w1 x1 ; w0w1:= val; <*value of call param*>
se w0 0 ; if first_word_of_param <> 0
jl. g4. ; then goto exitn;
a11: ; end;
al. w3 a6. ; w3:= base extraset;
a12: ; get_or_set_param:
rl. w0 b0. ; w0:= paramno;
sh w0 a7 ; if paramno > maxparamno or
sh w0 0 ; paramno < 1 then
jl. g4. ; goto exitn;
am (0) ;
zl. w1 a4. ; w1:= acts:= acts_table(paramno);
al w0 x1 ; w0:= acts;
ls w1 -4 ; w1:= bufaddr:= acts shift (-4)
wa w1 4 ; + zonebufref;
rs. w1 b2. ;
sz w0 2.11 ; if acts extract 2 <> 0 then
al w3 x3-6 ; w3:= normal base;
la w0 x3-2 ; w0:= action:=
el w1 x3-2 ; acts and mask(w3)
ls w0 x1 ; shift shifts(w3);
wa w3 0 ; w3:= base + action;
dl. w1 b2. ; w0:= val; <*or valaddr*>
zl w3 x3 ; w1:= bufaddr;
a1: jl. x3 ; goto action(w3);
c1: ; getbyte:
el w0 x1 ;
a2: rs. w0 (b1.) ; returnparam:= byte(bufaddr);
jl. g3. ; goto getparampair;
c2: ; getword:
rl w0 x1 ; returnparam:= word(bufaddr);
jl. a2. ; goto getparampair;
c3: rl. w3 b3. ; getlong:
se w3 0 ; if -,longparam then
jl. c2. ; goto getword;
dl w0 x1 ; returnparam:= long(bufaddr);
ds. w0 (b1.) ;
jl. g3. ; goto getparampair;
d1: sh w0 2047 ; setbyte:
sh w0 -1 ; if w0 < 0 or w0 > 2047 then
d0: jl. g4. ; forbidden: goto exitn;
hs w0 x1 ; byte(w1):= w0;
jl. g3. ; goto getparampair;
d2: sh w0 -1 ; setword:
jl. g4. ; if w0 < 0 then goto exitn;
rs w0 x1 ; word(w1):= w0;
jl. g3. ; goto getparampair;
\f
; rc 06.07.78 algol7, file-i procedures, ib, segment 7 page ...56...
; 01.02.81 eah
; acts:
; a table holding one byte for each allowed paramno value, each byte
; defines a setaction and a getaction and possibly an address in the
; zonebuffer. there are two possible formats:
; basic acts, characterized by bits(10,11) <> 0:
; bits 0-7: addr. of parameter in zonebuffer, relative to zonebufref
; - 8-9: basic setaction
; - 10-11: basic getaction
; extra acts, characterized by bits(10,11) = 0;
; bits 0-4: extra setaction
; - 5-9: extra getaction
a4=k-1 ;
h. ; paramno name setact: getact:
i7<4+ 4<4+0<2+3 ; 1 recsinfile forbidden getlong
i7<4+12<4+0<2+3 ; 2 recbytes forbidden getlong
i1<4+12<4+0<2+2 ; 3 transports forbidden getword
i1<4+10<4+2<2+2 ; 4 pricelimit setword getword
i1<4+ 2<4+2<2+2 ; 5 emptybuckpr. setword getword
i1<4+ 0<4+1<2+1 ; 6 emptyblockpr. setbyte getbyte
i1<4+ 4<4+1<2+1 ; 7 compresspr. setbyte getbyte
i1<4+ 5<4+1<2+1 ; 8 priceperblock setbyte getbyte
i1<4+ 1<4+1<2+1 ; 9 priceperbuck setbyte getbyte
i1<4+ 8<4+0<2+2 ; 10 computedcost forbidden getword
a7=k-a4-1 ; maxparamno
w.h. ; get actions:
0,2.11 ; shifts and mask for basic get
; basic get:
0 ;
c1-a1 ; 1 getbyte
c2-a1 ; 2 getword
c3-a1 ; 3 getlong
-2,2.11111<2; shifts and mask for extra get
a5: ; extra get: pt empty
w.h. ; set actions:
-2,2.11<2 ; shifts and mask for basic set
; basic set:
d0-a1 ; 0 forbidden
d1-a1 ; 1 setbyte
d2-a1 ; 2 setword
0 ; 3 unused
-7,2.11111<7; shifts and mask for extra set
a6: a8=a5-a6; extra set: pt empty
w. ;
i. ;
e. ; endblock getparam and setparam
\f
; rc 10.11.78 algol7, file-i procedures, ib, segment 7 page ...57...
b. a6 ; beginblock settest
w. ;
g7: sh w0 -1 ; settest: comment w0 = results;
jl. g4. ; if w0 < 0 then goto exitn;
al w1 0 ; setbits:= 0;
a0: rs. w1 b2. ;
sn w0 0 ; while w0 <> 0 do
jl. a1. ; begin
al w3 0 ; setbits:= setbits or
wd. w0 b4. ; 1 shift (5 + w0 mod 10);
al w1 1<5 ; w0:= w0//10;
ls w1 x3 ; end;
lo. w1 b2. ;
jl. a0. ;
a1: rl. w3 b0. ; test procno:
sh w3 a6 ;
sh w3 -1 ; if procno < 0 or procno > maxprocno or proctable(procno) = 0 then
jl. g4. ; goto exitn;
bz. w1 x3+a5. ;
sn w1 0 ;
jl. g4. ;
sn w3 0 ; i:= if procno = 0 then maxprocno else
al w3 a6 ; procno; comment =0 == all procs;
a2: rs. w3 b3. ; loop set:
bz. w3 x3+a5. ; w0w1:= proctable(i) shift(-6) shift 6;
al w1 -1<6 ; comment mask for bits relevant for procno;
la w1 6 ; w3:= proctable(i) extract 6;
ws w3 2 ; comment number of shifts;
al w0 0 ;
se. w0 (b1.) ;
jl. a3. ; if results = 0 then
ld w1 x3 ; remove bits:
la w0 x2+i2+6 ; testbits:= testbits and
la w1 x2+i2+8 ; -,(w0w1 shift w3)
lx w0 x2+i2+6 ;
lx w1 x2+i2+8 ;
jl. a4. ;
a3: la. w1 b2. ; else
ld w1 x3 ; testbits:=
lo w0 x2+i2+6 ; testbits or
lo w1 x2+i2+8 ; ((w0w1 and setbits) shift w3);
a4: bz w1 2 ;
hs w1 x2+i2+8 ; bit(0,testbits):=
ls w0 1 ; if bits(1,35) of:(testbits) = 0
sn w0 0 ; then 0 else 1;
se w1 0 ;
am 1 ;
al w3 0 ;
ld w0 -1 ;
rs w0 x2+i2+6 ;
rl. w3 b3. ; i:= i-1;
al w3 x3-1 ;
sh. w3 (b0.) ; if i <= procno then
jl. g3. ; goto getparampair;
jl. a2. ; goto loop set;
\f
; rc 10.11.78 algol7, file-i procedures, ib, segment 7 page ...58...
; proctable:
; one byte per procno value, 0 == no test:
; (1<noofresults - 1) < 6 + 41 - testshifts = 1<(noofresults+6)-
; testshifts-23;
h. ;
a5=k-1; table base
1<8 -f8 -23, 1<10-f5 -23, 1<8 -f9 -23, 1<8 -f4 -23, 1<8 -f17-23
1<8 -f3 -23, 1<9 -f1 -23, 1<8 -f2 -23, 1<9 -f6 -23, 1<12-f7 -23
1<7 -f18-23, 0, 0, 1<7-f19-23, 1<10-f20-23;
a6=k-a5-1 ; maxprocno
w. ;
i. ;
e. ; endblock settest
;end of segment
j20=k-j0 ;
c.j20-506 ;
m.code on segment 7 too long
z.
c.502-j20,0,r.252-j20>1 z.; fill with zeroes
<:fileipr. s7<0>:>
m.segment 7
i.
e.
\f
; rc 07.06.78 algol6, file i procedures, ib, segment 8 page ...59...
; 01.02.81 eah
; setreadi, setputi, setupdatei
b. j20,g2 ; block for segment 8
k = 10000
h. ;
g0=0 ; no of externals +no of globals
j0: g1, g2; rel of last point, rel of last absword
j1: -7, 0 ; address of segment 1
j5: 0, 1 ; resulti, permanent core byte 0, 1
j6: g0+13, 0 ; rs-entry 13, last used
j8: g0+21, 0 ; - - 21, general alarm
j9: g0+8 , 0 ; - - 8 , end address expression
j12: g0+3 , 0 ; - - 3 , reserve
j13: g0+5 , 0 ; - - 5 , goto point
g2=k-2-j0 ; rel of last absword
g1=k-2-j0 ; rel of last point
w.
\f
; rc 22.01.79 algol6, file-i procedures, ib, segment 8 page ...60...
; procedure setreadi (z);
; procedure setputi (z);
; procedure setupdatei (z);
; these procedures prepares the file for updating or reading by
; effectuating the necessary transports to equalize the buffer areas
; in the core and on the backing storage.
; zonestate is set to readonly, put, or update respectively.
; the available record will be the same as before the call or, if
; zonestate was initialize, the first record of the file.
; result_i:
; 1 record available
; 2 first record available, initialization terminated
b. a20; beginblock set readonly, put, or update;
w. ;
e6: e7=k-j0 ;
am -5<7-f17+4<7+f4 ; setreadi:
e20: e21=k-j0 ; w1:= setreadact else
am -6<7-f3 +5<7+f17; setputi:
e4: e5=k-j0 ; w1:= setputact else
al w1 6<7+f3 ; setupdatei:
al w0 2.11111 ; w1:= setupdateact;
rl. w3 (j1.) ;
jl w3 x3+c1 ; prepare (all i states, w1);
bl w1 x2+i2+9 ; w1:= actno
se w0 f0+4 ;
jl. a4. ; if state = initialize then
; terminate initialization:
se w1 4<7+f4 ; updmarks:= if readact then
am 1 ; 0 else 1;
al w3 0 ;
rs w3 x2+i7+14 ;
rl w0 x2+i7+4 ; begin
lo w0 x2+i7+2 ;
se w0 0 ; if noofrecs = 0 then
jl. a2. ; begin
am -2 ;
a10: al w1 9 ; general alarm (
al. w0 a1. ; 7 or 9, <:prep i :>);
jl. w3 (j8.) ; end;
a1: <:<10>prep i :> ;
a2: al w1 x2+i5 ;
a3: rl. w0 j0. ; for descr:= recs, blocks, bucks do
rl. w3 (j1.) ; begin
jl w3 x3+c13 ; putnew(descr, false);
rl w0 x1+i10 ; last(descr):= curr(descr);
rs w0 x1+6 ; end;
al w1 x1-i10 ;
sl w1 x2+i3 ;
jl. a3. ; resulti:= 0;
jl. a7. ; end terminate initialization;
\f
; rc 22.01.79 algol6, file-i procedures, ib, segment 8 page ...61...
a4: se w1 4<7+f4 ; else <*terminate update or read*>
jl. a11. ; begin
sh w0 f0+1 ; if readact and zonestate = update then
jl. a13. ; updmarks:= 0
jl. a12. ;
a11: sl w0 f0+2 ; else if updateact and zonestate = read then
jl. a13. ; if gossip then alarm(9)
rl w3 x2+i7+14 ; else updmarks:= 1;
sz w3 1<1 ;
jl. a10. ;
am 1 ;
a12: al w3 0 ; if new updmarks then
rs w3 x2+i7+14 ; shareop(bucks):= writeop;
al w3 f14 ;
hs w3 (x2+i3+10) ;
a13: rl w3 x2+i5+i10 ;
sl w0 f0+2 ;
jl w2 (x2+i0+6) ;
al w1 x2+i5 ; if state >= put then
a5: rl. w0 j0. ; restorehead(curr(recs);
rl. w3 (j1.) ;
jl w3 x3+c7 ; inout(recs, false);
a6: sn w1 x2+i3 ;
jl. a7. ; if shareop(blocks) = writeop then
al w1 x1-i10 ; inout(blocks, false);
bl w0 (x1+10) ;
se w0 f14 ; if shareop(bucks) = writeop then
jl. a6. ; inout(bucks, false);
jl. a5. ; end terminate update or read;
a7: bl w1 x2+i2+9 ; set newstate and exit via next:
al w0 f0 ;
sn w1 5<7+f17 ; zonestate:=
al w0 f0+2 ; if actno = readact then readonly
sn w1 6<7+f3 ; else if actno = putact then put
al w0 f0+3 ; else update;
rs w0 (x2+i2+2) ;
d22: rl. w3 (j1.) ; exitvianext:
rl w1 (x3) ; get segment 1;
rl w3 x2+i5+i10 ; w3:= recbase:= curr(recs);
jl x1+d3 ; goto accessnext
i. ;
e. ; endblock set read, put, or update
\f
; rc 02.01.79 algol7, file-i procedures, ib, segment 8 page ...63...
b. a30 ; begin block continue init-start-file
w.
d26: d27=k-j0 ; continue init-start from other segment
rl w3 x2+i2+0 ; set zonereferences:
al w0 x3-h3+h2+6 ;
rs w0 x2+i2+2 ; set record state addr;
al w0 x3+4 ;
rs w0 x2+i2+4 ; set record size addr;
rl w1 x3-h3+h0+6 ;
al w0 x1+h6+h6 ; set zonedescriptor and firstshared:
rs w0 x3-h3+h0+8 ;
al w3 x2+i7 ; lastshare := firstshare +
rs w3 x1+2 ; 2*sharedescrsize;
; firstshared(1) := startbuckhead;
wa w3 x2+i3+12 ; firstshared(2) :=
rs w3 x1+h6+2 ; firstshared(1) + top(bucks);
wa w3 x2+i4+0 ; firstshared(3) :=
rs w3 x1+h6+h6+2 ; firstshared(2) + sharesize(blocks);
rl w0 x2+i7+8 ; sharesn(bucks):=
rs w0 x1+12 ; sn(file);
\f
; rc 02.01.79 algol7, file-i procedures, ib, segment 8 page ...64...
al w3 x1+6 ; set absolute addresses in descriptions:
al w1 x2+i3 ; complete sharedescriptors:
a9: rs w3 x1+10 ; w3:= firstshare+6;
al w0 f13 ; for w1:= descr:= bucks, blocks, recs do
hs w0 x3 ; begin
ac w0 2 ; shareopaddr(descr):= w3;
wa w0 x3-4 ; shareop(descr):= readop;
wa w0 x1+0 ; lastshared(w3):= lastaddress(w3):=
rs w0 x3-2 ; firstshared(w3) +
rs w0 x3+4 ; sharesize(descr)-2;
rl w0 x3-4 ; firstaddress(w3):=
rs w0 x3+2 ; firstshared(w3);
wa w0 x1+2 ; first(descr):=
rs w0 x1+2 ; first(descr) + firstshared(w3);
wa w0 x1+6 ; last(descr):=
rs w0 x1+6 ; first(descr) + last(descr);
rl w0 x3-4 ;
wa w0 x1+12 ; top(descr):= top(descr) +
rs w0 x1+12 ; firstshared(w3);
al w3 x3+h6 ; w3:= w3 + sharedescrsize;
al w1 x1+i10 ;
sh w1 x2+i5 ; end;
jl. a9. ;
rl w0 x3-h6-2 ; testbuffer size:
rl w1 x2+i2+0 ;
sl w0 (x1-h3+h0+2) ; if lastshared(3) >= lastofbuffer then
jl. a23. ; goto buffersmall;
wa w0 x2+i5+0 ;
sl w0 (x1-h3+h0+2) ; resulti:= if lastshared(3) +
am 1 ; sharesize(recs) >= lastofbuffer then
al w0 1 ; 2 else 1;
sl w0 2 ; if resulti > 1 then
hs w0 x2+i1+6 ; shortbuf:= true;
rl w1 x2+i7+14 ; if gossip then
sz w1 1<1 ; resulti:= resulti +2;
ba. w0 -1 ;
rs. w0 (j5.) ;
rl w1 x2+i2+0 ;
rl w3 x3-h6-h6-4 ; topfirstblocks:=
wa w3 x2+i2+12 ; topfirstblocks + firstshared(2);
rs w3 x2+i2+12 ;
al w0 x2+i7+9 ; these(bucks):=
rs w0 x2+i3 ; addr(snfile);
rl w3 x1-h3+h0+0 ;
al w1 x2+i0 ;
a10: al w0 x3+1 ; for i:= 0 step 2 until bucks-2 do
wa w0 x1 ; entrypoint(i):=
rs w0 x1 ; entrypoint(i) + basebuffer +1;
al w1 x1+2 ;
se w1 x2+i1 ;
jl. a10. ;
\f
; rc 14.11.78 algol7, file-i procedures, ib, segment 8 page ...65...
al w1 0 ;
a11: al w1 x1+1 ;
al w0 x1 ; leap(bucks):=
wm w0 2 ; intsqrt(noofbucks)*
sh w0 (x2+i6+4) ; entrysize(bucks);
jl. a11. ;
al w1 x1-1 ;
wm w1 x2+i3+4 ;
rs w1 x2+i3+8 ;
rl w3 x2+i3+2 ; init bucktable:
al w1 x2+i7 ;
wa w1 x2+i7+0 ; w0 := segsperbucks;
al w0 0 ;
a12: ba w0 x2+i5+16 ; for w3:= first(bucks) + entrysize(bucks)
wa w3 x2+i3+4 ; step entrysize(bucks)
sl w3 (x2+i3+12) ; until top(bucks) do
jl. a13. ; begin
sl w3 x1 ; if w3 > startbuckhead + maxusedbucks
rs w0 x3 ; then sn(w3):= w0;
jl. a12. ; w0:= w0 + segsperbucks;
; end;
a13: al w0 0 ;finish:
rs w0 (x2+i2+4) ; record_size:= 0; comment for initfilei;
al w0 f0+4 ;
rs w0 (x2+i2+2) ; if actno = initact then
bl w0 x2+i2+9 ; begin
se w0 3<7+f9 ; zonestate:= initialize;
jl. (j9.) ; goto endaddressexpression
al w0 f0+0 ; end;
rs w0 (x2+i2+2) ; zonestate:= readonly;
rl. w3 (j1.) ; goto fromstart; comment in nextreci;
jl x3+d9 ;
a15: <:isq:>; checksum ;
a16: <:<10>prep i<32><32>:> ;
;
a17: am 1 ; updatemarks: w1:= 9 else
a18: am 1 ; contentserr: w1:= 8 else
a19: am 1 ; emptyfile: w1:= 7 else
a20: am 1 ; zonestateerr: w1:= 6 else
a21: am 1 ; shareerr: w1:= 5 else
a22: am 1 ; nothead: w1:= 4 else
a23: am 1 ; buffersmall: w1:= 3 else
a24: am 1 ; bucktablehead:w1:= 2 else
a25: al w1 1 ; areasizeerr: w1:= 1;
al. w0 a16. ; general alarm
jl. w3 (j8.) ; (w1, <file_i>);
m.initfilei, startfilei
i. ;
e. ; endblock continued initfilei, startfilei
; end of segment
j20=k-j0 ;
c.j20-506 ;
m.code on segment 8 too long
z.
c.502-j20,0,r.252-j20>1 z.; fill with zeroes
<:fileipr. s8<0>:> ; alarmtext
m.segment 8
i.
e.
\f
; rc 10.11.78 algol7, file-i procedures, ib, segment 9 page ...67...
; 01.02.81 eah
;
; insertreci (continued), systemi
;
b. g2, j20 ; block for segment 9
k = 10000
h. ;
g0=0 ; no of externals +no of globals
;
j0: g1, g2 ; rel of last point, rel of last absword
j1: -8, 0 ; address of segment 1
j6: g0+13, 0 ; rs entry 13 last used
j7: g0+30, 0 ; rs entry 30 saved stackref and w3
j9: g0+8 , 0 ; rs entry 8 end address expression
j16: -4, 0 ; address of segment 5
j17: -3, 0 ; - - - 6
;
g2=k-2-j0 ; rel of last absword
g1=k-2-j0 ; - - - point
w. ;
\f
; rc 02.01.79 algol7, file-i procedures, ib, segment 9 page ...68...
; procedure systemi(z, fnc, w0, w1, w3);
;
; entrance to codepieces in the filehead.
; fnc is the piece identification: i0+fnc.
; w0-3 is used for call and return values of the pieces.
; only for internal use. no parameter checking.
; obs. abs. addresses must be arranged from elsewhere.
;
b. a0
w.
e18: e19=k-j0 ; systemi:
;
rl. w2 (j6.) ; w2:= stackref:= lastused;
ds. w3 (j7.) ; save stackref and return
rl w3 x2+8 ; w3:= zoneaddr;
rl w3 x3+h0 ; zonebufref:= w2:= basebuffer(zoneaddr) +
wa w3 x3+1 ; zonebufrefrel;
rx w2 6 ; w3:= stackref;
rl w0 (x3+12) ; work:= word(formal 2.2);
rs. w0 a0. ;
rl w0 (x3+16) ; w0:= word(formal3.2);
rl w1 (x3+20) ; w1:= word(formal4.2);
rl w3 (x3+24) ; w3:= word(formal5.2);
wa. w2 a0. ;
jl w2 (x2+i0) ; goto codepiece(fnc);
rl. w2 (j6.) ;
rs w0 (x2+16) ; set return values;
rs w1 (x2+20) ;
rs w3 (x2+24) ;
jl. (j9.) ; return
;
;
a0: 0 ; working location for fnc
;
m.systemi
i. ;
e. ; end block systemi
\f
; rc 02.01.79 algol7, file-i procedures, ib, segment 9 page ...69...
; the code which performs insertions, continued
b. a10; begin block move blocks
w. ;
d30: d31=k-j0 ; move blocks:
bl w1 x2+i5+17 ;
ls w1 9 ; setbuf(segsper(recs)*segsize);
rl. w3 (j17.) ;
jl w3 x3+c25 ;
rl w0 x2+i4+14 ;
rl w3 x2+i3+14 ; w3:= insert(bucks);
sn w0 (x2+i4+6) ; if insert(blocks) <> last(blocks) or
sh w3 (x2+i3+i10) ; insert(bucks) <= curr(bucks) then
jl. a4. ; goto get a block;
a1: am (x2+i3+6) ; loop: comment w3 = insert(bucks);
sl w3 1 ; if insert(bucks) > last(bucks) then
jl. a9. ; goto use empty buck;
rl w1 x2+i3+4 ;
sh w3 (x2+i3+i10) ; w1:= curr(bucks) +
ac w1 x1 ; (if insert(bucks) > curr(bucks) then
wa w1 x2+i3+i10 ; entrysize(bucks) else -entrysize(bucks));
ac w0 (x2+i4+4) ;
sh w3 (x2+i3+i10) ; insert(blocks):= first(blocks) +
rl w0 x1-2 ; (if insert(bucks) > curr(bucks) then
wa w0 x2+i4+2 ; -entrysize(blocks) else ub(w1));
rs w0 x2+i4+14 ;
rs w1 x2+i3+i10 ; curr(bucks):= w1;
a3: al w1 x2+i4+1 ;
rl. w3 (j1.) ;
rl. w0 j0. ; inout(blocks, true);
jl w3 x3+c7 ;
rl w3 x2+i3+14 ; w3:= insert(bucks);
a4: rl w0 x2+i4+6 ; get a block: comment w3=insert(bucks);
se w3 (x2+i3+i10) ; if insert(bucks) = curr(bucks) then
jl. a5. ; begin
wa w0 x2+i4+4 ; curr(blocks):= last(blocks):=
rs w0 x2+i4+6 ; last(blocks) + entrysize(blocks);
rs w0 x2+i4+i10 ; ub(curr(bucks)):=
ws w0 x2+i4+2 ; last(blocks) - first(blocks)
rs w0 x3-2 ; end
jl. a6. ; else
a5: sh w3 (x2+i3+i10) ; begin
rl w0 x2+i4+2 ; curr(blocks):=
rs w0 x2+i4+i10 ; if insert(bucks) > curr(bucks) then
al w1 x2+i5 ; last(blocks)
rl. w0 j0. ; else first(blocks);
rl. w3 (j1.) ; inout(recs, false)
jl w3 x3+c7 ; end;
\f
; rc 02.01.79 algol7, file-i procedures, ib, segment 9 page ...70...
; move blocks, continued
a6: al w1 x2+i4 ; move the now empty block:
rl. w3 (j16.) ;
jl w3 x3+c21 ; move entries(blocks);
rl w0 x2+i4+i10 ;
se w0 (x2+i4+2) ; if curr(blocks) = first(blocks) then
jl. a7. ;
rl w0 x2+i3+4 ; movewrds
rl w1 x2+i3+i10 ; (curr(blocks),
bs w0 x2+i3+16 ; curr(bucks),
rl w2 x2+i4+i10 ; entrysize(bucks)-entryheadsz(bucks);
rl. w3 (j16.) ; comment updating the keypart of
jl w3 x3+c17 ; curr(bucks);
a7: rl w0 x2+i4+14 ;
wa w0 x2+i4+4 ; curr(blocks):=
rs w0 x2+i4+i10 ; insert(blocks)+entrysize(blocks);
a8: rl. w3 (j17.) ; write to the now empty block:
jl w3 x3+c23 ;
al w1 x2+i5 ; switchbuf;
rl. w0 j0. ; putnew(recs,false);
rl. w3 (j1.) ;
jl w3 x3+c13 ;
al w0 f14 ; shareop(blocks):= writeop;
hs w0 (x2+i4+10) ;
rl. w3 (j17.) ;
jl w3 x3+c27 ; setkeyparts;
rl w0 x2+i5+6 ;
rs w0 x2+i5+i10 ; curr(recs):= last(recs);
rl w3 x2+i3+14 ; if insert(bucks) <> curr(bucks) then
se w3 (x2+i3+i10) ;
jl. a1. ; goto loop;
al w1 0 ; move completed:
am (x2+i5+10) ; sn(share(recs)):= 0; comment forces
rs w1 6 ; a new reading of the block if it
rl. w3 (j17.) ;
jl w3 x3+c25 ; happens to contain the new record;
; setbuf(0);
rl. w3 (j1.) ; goto searchrec;
jl x3+d1 ;
; end insertreci
a9: rx w3 x2+i3+i10 ; use empty buck:
rs w3 x2+i3+14 ; swop(insert(bucks), curr(bucks));
al w1 x2+i4 ;
rl. w0 j0. ; inout(blocks,false);
rl. w3 (j1.) ; comment writes old curr(blocks);
jl w3 x3+c7 ;
rl. w0 j0. ;
rl. w3 (j16.) ; initblocktable;
jl w3 x3+c29 ;
al w1 x2+i3 ;
rl. w3 (j16.) ;
jl w3 x3+c21 ; moveentries(bucks,newempty,sn(newempty));
rs w3 x2+i3+i10 ; curr(bucks):=
rs w3 x2+i3+14 ; insert(bucks):= newempty;
al w1 f14 ; shareop(bucks):= writeop;
hs w1 (x2+i3+10) ;
am (x2+i4+10) ; sn(share(blocks)):=
rs w0 6 ; sn(newempty);
rl w3 x2+i4+2 ;
rs w3 x2+i4+6 ; last(blocks):= curr(blocks):=
rs w3 x2+i4+i10 ; first(blocks);
jl. a8. ; goto write a block to the now empty;
i. ;
e. ; end block move blocks
\f
; rc 02.01.79 algol7, file-i procedures, ib, segment 9 page ...71...
; end segment
; end of segment
j20=k-j0 ;
c.j20-506 ;
m. code on segment 9 too long
z.
c.502-j20,0,r.252-j20>1 z.; fill with zeroes
<:fileipr. s9<0>:>
m. segment 9
i.
e.
\f
; rc 02.01.79 algol7, file-i procedures, ib page ...last...
m. global file_i segment
i.
e. ; end global slang segment
\f
; rc 03.11.78 algol7, file-i procedures, ib page ...tails 1...
; tails to be inserted in catalog
g0: ; first entry:
; getreci ; getreci is the area name
b0 ; no of segments
0,r.4 ;
1<23+e1 ; entry: segment 1, e1
1<18+26<12+8<6,0 ; procedure (zone, array)
4<12+b1 ; algol external list
b0<12+b2 ; codesegments, b2 bytes permanent
; nextreci ;
1<23+4 ;
<:getreci:>, 0 ;
1<23+e3 ; entry: segment 1, e3
1<18+8<12, 0 ; procedure(zone)
4<12 ;
b0<12+b2 ;
; setupdatei ;
1<23+4 ;
<:getreci:>,0 ;
1<23+7<12+e5 ; entry: segment 8, e5
1<18+8<12, 0 ; procedure(zone)
4<12 ;
b0<12+b2 ;
; setreadi ;
1<23+4 ;
<:getreci:>, 0 ;
1<23+7<12+e7 ; entry: segment 8, e7
1<18+8<12, 0 ; procedure (zone).
4<12 ;
b0<12+b2 ;
; initreci ;
1<23+4 ;
<:getreci:>, 0 ;
1<23+1<12+e9 ; entry: segment 2, e9
1<18+26<12+8<6,0 ; procedure(zone, array)
4<12 ;
b0<12+b2 ;
; deletereci ;
1<23+4 ;
<:getreci:>, 0 ;
1<23+1<12+e11 ; entry: segment 2, e11
1<18+8<12, 0 ; procedure(zone)
4<12 ;
b0<12+b2 ;
\f
; rc 03.11.78 algol7, file-i procedures, ib page ...tails 2...
; setputi ;
1<23+4 ;
<:getreci:>, 0 ;
1<23+7<12+e21 ; entry: segment 8, e21
1<18+8<12,0 ; procedure (zone)
4<12 ;
b0<12+b2 ;
; putreci ;
1<23+4 ;
<:getreci:>, 0 ;
1<23+1<12+e23 ; entry: segment 2, e23
1<18+8<12,0 ; procedure (zone)
4<12 ;
b0<12+b2 ;
; getparamsi ;
1<23+4 ;
<:getreci:>, 0 ;
1<23+6<12+e25 ; entry: segment 7, e25
3<18+39<12+8<6,0; integer procedure (zone, general)
4<12 ;
b0<12+b2 ;
; setparamsi ;
1<23+4 ;
<:getreci:>, 0 ;
1<23+6<12+e27 ; entry: segment 7, e27
3<18+39<12+8<6,0; integer procedure (zone, general)
4<12 ;
b0<12+b2 ;
; settesti ;
1<23+4 ;
<:getreci:>, 0 ;
1<23+6<12+e29 ; entry: segment 7, e29
3<18+39<12+8<6,0; integer procedure (zone, general)
4<12 ;
b0<12+b2 ;
\f
; rc 14.11.78 algol7, file-i procedures, ib page ...tails 3...
; 10.02.81 eah
; initfilei ;
1<23+4 ;
<:getreci:>, 0 ;
1<23+2<12+e13 ; entry: segment 3, e13
1<18+14<12+14<6+8,0 ; procedure (zone, realval, realval)
4<12 ;
b0<12+b2 ;
; startfilei ;
1<23+4 ;
<:getreci:>, 0 ;
1<23+2<12+e15 ; entry: segment 3, e15
1<18+8<12,0 ; procedure (zone)
4<12 ;
b0<12+b2 ;
; insertreci ;
1<23+4 ;
<:getreci:>, 0 ;
1<23+3<12+e17 ; entry: segment 4, e17
1<18+26<12+8<6, 0 ; procedure(zone, array)
4<12 ;
b0<12+b2 ;
; systemi ;
1<23+4 ;
<:systemi:>, 0 ;
1<23+8<12+e19 ; entry: segm 9, e19
1<18+3<12+3<6+3 ; procedure(zone, integer, integer, integer,
3<18+8<12 ; integer)
4<12 ;
b0<12+b2 ;
g1: ; last tail:
; resulti ;
1<23+4 ;
<:getreci:>, 0 ;
1 ; address: byte 1, permanent core
9<18, 0 ; integer variable
4<12 ;
b0<12+b2 ;
▶EOF◀