|
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: 4608 (0x1200)
Types: TextFile
Names: »allocbuf3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »allocbuf3tx «
; sj 780307 alloc_buf page...1...
;
b.
w.
d.
p.<:fpnames:>
l.
;procedure alloc_buf(z_orig,z_data,base,length);
;value base,length;
;integer base,length;
;zone z_orig,z_data;
;
;the procedure allocates a databuffer for the zone
;z_orig in the zone z_data starting from base and
;with length bytes length
;
;demands: base > 0
; length > 0
; base + length <= bufferlength
;* zonestate(z_orig) = 4 (after declaration)
;
;the allocation is performed in the following way:
;
; z_orig.base_buffer :=
; z_orig.record_base := z_data.base_buffer + base
; z_orig.last_of_buffer:=
; z_orig.last_byte := z_data.base_buffer + base + length
; z_orig.rec_length := length
;
b. g3, i2
s. a3, c2, j30, e2, f4
w. k=1000
h.
i0 : e1,e2 ;rel of abswords, rel of points
j4 : 4, 0 ;take expression
j8 : 8, 0 ;end addres expression
j13: 13, 0 ;last used
j21: 21, 0 ;general alarm
j30: 30, 0 ;saved stackref, return point
e1 = k - 2 - i0
e2 = k - 2 - i0
w.
i1 : 0, 0 ;no externals
s3 ;date
s4 ;clock
c1 : 0
c2 : 0
f1 : <:<10>length <0>:>
f2 : <:<10>base <0>:>
f3 : <:<10>upper <0>:>
\f
; sj 780307 alloc_buf page...2...
;
i2: rl. w2 (j13.) ; get lastused
ds. w2 (j30.) ; save stackref, return point
dl w1 x2+ 20 ; take length:
so w0 16 ; if expression then
jl. w3 (j4.) ; takeexpression
ds. w3 (j30.) ;
rl w1 x1 ; take integer value
sl w1 0 ; if length < 0 then
jl. a1. ; begin
al. w0 f1. ; general alarm(<:length:>)
jl. w3 (j21.) ; end;
a1: rs. w1 c1. ; save length
dl w1 x2+ 16 ; take base
so w0 16 ; if expression then
jl. w3 (j4.) ; takeexpression
ds. w3 (j30.) ;
rl w1 x1 ; take integer value
sl w1 0 ; if base < 0 then
jl. a2. ; begin
al. w0 f2. ; general alarm(<:base:>)
jl. w3 (j21.) ; end
a2: rs. w1 c2. ; save base
wa. w1 c1. ; x1:= base + length
rl w3 x2+ 12 ; x3:= z_data
rl w0 x3+ h0+2 ;
ws w0 x3+ h0+0 ;
sl w0 x1 ; if base + length > buffer_length then
jl. a3. ; begin
rl. w1 c1.
wa. w1 c2.
al. w0 f3. ; general alarm (<:upper:>)
jl. w3 (j21.) ; end
a3: rl w3 x3+ h0 ; x3:= z_data.base_buffer
rl w1 x2+ 8 ; x1:= z_orig
wa. w3 c2. ; z_data.base_buffer + base
rs w3 x1+h0+0 ; -> z_orig.base_buffer
rs w3 x1+h3+0 ; -> z_orig.record_base
wa. w3 c1. ; z_data.base_buffer + base + length
rs w3 x1+h3+2 ; -> z_orig.last_byte
rs w3 x1+h0+2 ; -> z_orig.last_of_buffer
dl. w3 (j30.) ; set stackref, return point
jl. ( j8.) ; end address expression
\f
; sj 780307 alloc_buf page...3...
;
m.rc alloc_buf 780307
f0 = i0 + 504 - k
c.-f0-1, m.***alloc_buf segment overflow
z.
c.f0-1,jl-1,r.f0>1,z. ; fill segment
<:alloc buf<0>:> ; alarm address
e.
h.
g0:
g1: 0, 1 ; 1 segment
0, r.8 ; fill
1<11, i2 - i0 ; 1<11 + segmno, rel addr of entry
1<6 + 13 ; no type procedure
; integer value length
13<6 + 8 ; integer value base
; zone z_data
8< 6, 0 ; zone z_orig
4, i1 - i0 ; 4<12 + rel addr of external list
1, 0 ; segments, bytes of own core
d.
p.<:insertproc:>
l.
e.
▶EOF◀