|
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: 13824 (0x3600)
Types: TextFile
Names: »initzone3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »initzone3tx «
; jz 1977.06.09 init zones page 0
;
;
;
; code procedure init_zones
;
;
; the procedure changes the buffersize and number of shares of each zone in
; a zone array
;
; call: init_zones(za,bufsize,shares)
;
; za (call value, zone array). the buffersize and number of
; shares are changed for all zones: za(1), za(2), ... ,
; za(no of zones). the zone states must be 4 (after
; declaration) for all za(i).
;
; bufsize (call value, integer array). bufsize(i) specifies the
; number of elements of 4 bytes each in the bufferarea
; to be allocated to the zone za(i).
;
; shares (call value, integer array). shares(i) specifies the
; number of shares to be assigned to za(i).
;
; note: the sum of all bufsize(i), 1 <= i <= no of zones, must not exceed
; the original total buffer claim for the zone array za, as de-
; termined by the declaration. obviously bufsize(i) and shares(i)
; must be positive integers.
;
;
; error messages:
;
; z.state <i> : the zone state of za(i) is not 4.
;
; bufsize <i> : the original total buffer claim for za is exceeded by
; : allocating space for za(i), or buffersize(i) <= 0, or
; : shares(i) <= 0
;
; index <i> : the arrays bufsize or shares cannot be referenced with
; : 1 <= i <= no of zones.
;
\f
; jz.fgs 1983.11.28 init zones page 1
; b. h100 ; fpnames dummy block
b. g1, e6 ; begin block for insertproc etc
d. ;
p. <:fpnames:> ;
l. ;
w. ;
k = 10000
s. g6,j99,b15,c2,a5; start of slang segment
h.
g0 = 0 ; g0 = number of externals
e5:
g1: g2 , g2 ; rel of last point, rel of last absword
j4: g0+ 4, 0 ; rs entry 4 , take expression
j6: g0+ 6, 0 ; rs entry 6 , end register expression
j13:g0+13, 0 ; rs entry 13 , last used
j29:g0+29, 0 ; rs entry 29 , param alarm
j30:g0+30, 0 ; rs entry 30 , saved stack ref , saved w3
j8: g0+ 8, 0 ; rs entry 8 , end address expression
j17:g0+17, 0 ; rs entry 17 , index alarm
j21:g0+21, 0 ; rs entry 21 , general alarm
j69:g0+69, 0 ; rs entry 69 , alarmcause
j91:g0+91, 0 ; rs entry 91 , trapchain
j92:g0+92, 0 ; rs entry 92 , alarm record(1:11)
g2 = k - 2 - g1 ; end of abs words = end of points
w.
e0: g0 , 0 ; start of external list
s3 , s4 ; date and time
; array descriptor for bufsize:
0 ; b0-2: bufsize(zone no)
b0: 0 ; base word
0 ; b0+2: upper index
0 ; b0+4: lower index
; array descriptor for shares:
0 ; b1-2: shares(zone no)
b1: 0 ; base word
0 ; b1+2: upper index
0 ; b1+4: lower index
; working variables:
b2: 0 ; zone no
b3: 0 ; no of zones
b4: 0 ; top of zone array buffer
b5: 0 ; zone claim
b6: 0 ; zone address
b7: 0 ; next buffer
b8: <:<10>bufsize :>
b9: <:<10>z.state :>
b10:<:<10>param :>
b11:<:<10>level :>
\f
; jz.fgs 1986.10.02 init zones page 2
c0: rl. w1 b2. ; load array: (w2=array descriptor)
ls w1 1 ; index := zone no * 2;
sh w1 (x2+2) ; if index > upper
sh w1 (x2+4) ; or index <= lower
jl. w3 (j17.) ; then index alarm
wa w1 x2 ;
rl w1 x1 ; array element :=
rs w1 x2-2 ; array(index);
sl w1 1 ; if array element >= 1
jl x3 ; then return;
c1: am b8-b9 ; bufalarm: text := <:bufsize:> else
c2: al. w0 b9. ; statealarm: text := <:z.state:>;
rl. w1 b2. ; w1 := zone no;
jl. w3 (j21.) ; general alarm(text,zone no);
e1: rl. w2 (j13.) ; entry init zones:
ds. w3 (j30.) ; saved stackref := w2 := last used;
; take zone array description:
dl w1 x2+8 ; (w0,w1) := (formal1.1,formal1.2); (za)
bz w0 0 ;
rs. w0 b3. ; no of zones := w0 shift (-12);
rs. w1 b6. ; zone address := w1;
al w3 1 ;
rs. w3 b2. ; zone no := 1;
rl w0 x1+h5+h4+2; if rel entry block proc even then
sz w0 1 ; begin
jl. a5. ; char conv table claim :=
al w0 0 ; 0;
hs. w0 b15. ; end;
a5: ;
rl w3 x1+h0+h5 ;
al w3 x3+1 ; nextbuffer :=
rs. w3 b7. ; base buffer (za(1)) + 1;
al w3 x1+h0+h5 ; top of zone array buffer :=
rs. w3 b4. ; first of zonedescriptor(za(1));
dl w1 x2+12 ; take array description(bufsize):
rl w3 x1 ;
rs. w3 b0. ; take base word,
ba w1 0 ; lower and upper index,
dl w0 x1 ; and move to array descriptor;
ds. w0 b0.+4 ;
dl w1 x2+16 ; take array description(shares):
rl w3 x1 ;
rs. w3 b1. ; take baseword,
ba w1 0 ; lower and upper index,
dl w0 x1 ; and move to array descriptor;
ds. w0 b1.+4 ;
\f
; jz.fgs 1986.10.02 init zones page 3
a0: al. w2 b0. ; next zone:
jl. w3 c0. ;
al. w2 b1. ; load array(bufsize);
jl. w3 c0. ; load array(shares);
al w1 h6 ; share claim :=
wm. w1 b1.-2 ; share descr length * shares(zone no) * 4;
ld w1 2 ;
se w0 0 ; if overflow then
jl. c1. ; bufalarm;
rl. w0 b0.-2 ;
ls w0 4 ; zone claim :=
ld w1 -2 ; bufsize(zone no)*4
wa w1 0 ; + share claim//4;
rs. w1 b5. ;
wa. w1 b7. ; firstbuf := next buffer + zone claim
b15=k+1 ; char conv table claim:
al w1 x1+h53 ; + char conv table claim;
rx. w1 b7. ; swap(firstbuf,next buffer);
rl. w2 b6. ; w2 := zone address;
al w2 x2+h5 ; w2 := address of next zone;
rs. w2 b6. ; zone address := w2;
rl w0 x2+h2+6 ;
se w0 4 ; if zone.state <> 4
jl. c2. ; then state alarm;
al w3 x1-1 ; w3 := base buffer := firstbuf - 1;
rl. w0 b0.-2 ;
ls w0 2 ; record length := 4* bufsize(zone no);
rs w0 x2+h3+4 ;
wa w0 6 ; base buffer := record base := w3;
ds w0 x2+h0+2 ;
ds w0 x2+h3+2 ; w0:= last buffer := last byte := base buffer
wa. w3 b5. ; + buffer length;
sl. w3 (b4.) ; if basebuffer+zoneclaim>=top of zone array buffer
jl. c1. ; then bufalarm;
al w3 x3-h6+1 ; w3 := last share := base buffer + zone claim
rs w3 x2+h0+8 ; - share descr length + 1;
ba. w0 1 ;
rs w0 x2+h0+6 ; w0 := first share :=
rs w0 x2+h0+4 ; used share := last buffer + 1;
\f
; fgs 1983.12.22 init zones page 4
al w0 0 ;
rs w0 x2+h3+6 ; record lower := 0;
rs w0 x2+h2+2 ; free param := 0;
a1: rl w0 x2+h0+2 ; init shares: last shared := last buffer;
rs w0 x3+4 ; (w1=base buffer+1, w2=zone, w3=share);
al w0 0 ; share state := 0;
ds w1 x3+2 ; first shared := base buffer + 1;
rs w0 x3+6 ; (operation,mode) :=0;
rs w1 x3+22 ; top transferred := first shared;
al w3 x3-h6 ; share := share - share descr length;
sl w3 (x2+h0+6) ; if share >= first share then
jl. a1. ; goto init shares;
rl. w1 b2. ;
al w1 x1+1 ; zone no := zone no + 1;
rs. w1 b2. ;
sh. w1 (b3.) ; if zone no <= no of zones
jl. a0. ; then goto next zone;
jl. (j8.) ; goto end addr expression;
\f
; jz 1979.08.03 trap, init zones page 5
; algol 8 version
e2: rl. w2 (j13.) ; entry trap:
ds. w3 (j30.) ; saved sref,w3 := w2w3;
al w0 7 ; check type of first parameter:
bl w1 x2+7 ;
la w0 x2+6 ;
se w1 23 ;
se w0 7 ; if type <> label
sn w0 2 ; and type <> integer
jl. a2. ; then
al. w0 b10. ;
al w1 0 ;
jl. w3 (j21.) ; general alarm(<:trap:>);
a2: dl w1 x2+8 ; take first parameter:
so w0 16 ; if expression then
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; saved sref,w3 := w2w3;
rl w3 x2 ; get address of traplabel:
wa w3 x3-4 ; w3 := callsref + blockno(callsref);
rs w3 x2+8 ; save traplabel address;
dl w1 x1 ; (w0,w1) := value(param);
rl w3 x2+6 ;
sz w3 5 ; if kind(param) = label
jl. a3. ; then goto check sref;
am (x2+8) ; integer:
rl w0 -2 ; chain := block(call sref).chainpart;
sn w1 0 ; if value(param) = 0 then
jl. a4. ; goto store value;
rs w1 x2+6 ; simulate trap at call point:
dl w0 x2+4 ; w0 := rel of return;
rl w3 x3 ; w3 := seg table address of return;
rl w1 x3 ; load word 0 of return segment;
hs. w0 b12. ; may transfer segment;
b12=k+1; rel of return
al w3 x3 ; w3 := abs address of return;
bl w1 x2+4 ; unstack call:
am x2 ; last used :=
al w1 x1+6 ; last used +
rs. w1 (j13.) ; appetite + 6;
rl w1 x2+6 ; w1 := value(param);
rl w2 x2 ; w2 := stackref of return point;
al w0 -13 ; alarmcause := -13;
jl. (j21.) ; goto trap alarm;
a3: sn w0 (x2) ; check sref: (w0=call sref=chain)
jl. a4. ; if sref(label)=callsref then goto store value;
al. w0 b11. ; general alarm(<:level:>,0);
al w1 0 ;
jl. w3 (j21.) ;
a4: rs w1 (x2+8) ; store value:
rs. w0 (j91.) ; trapchain := chain;
jl. (j8.) ; goto end addr expr;
\f
; jz 1979.11.13 getalarm page 6
; algol 8 version
b13: <:<10>index :>
e6: rl. w2 (j13.) ; getalarm:
ds. w2 (j30.) ; (saved w2,w3):=(last used,call w3);
al w1 2.11111 ; check param kind:
la w1 x2+6 ; w1 := first word of param extract 5;
sl w1 17 ; if type < 17 <* boolean array *>
sl w1 21 ; or type > 20 <* long array *>
jl. w3 (j29.) ; then paramalarm;
rl w3 x2+8 ; check array:
ba w3 x2+6 ; w3 := addr of baseword+dope rel (=dope address);
rl w1 x3 ; index := lower index;
al. w0 b13. ; w0 := text(<:index:>);
sl w1 1 ; if index >= 1 then
jl. w3 (j21.) ; then general alarm(<:index:>,index);
rl w1 x3-2 ; index := upper index;
sh w1 15 ; if index <= 15 then
jl. w3 (j21.) ; general alarm(<:index:>,index);
rl w3 (x2+8) ; move alarm text and device inf:
rl. w2 j92. ; w2 := address(alarmrecord);
dl w1 x2+6 ; w3 := address(array(0));
ds w1 x3+4 ;
dl w1 x2+10 ; array(1:4) :=
ds w1 x3+8 ; alarm record(3:6); <* alarm text *>
dl w1 x2+16 ;
ds w1 x3+12 ; array(5:8) :=
dl w1 x2+20 ; alarm record(8:11);
ds w1 x3+16 ;
dl w1 x2+2 ; alarmcause := alarm record(1:2);
ds. w1 (j69.) ;
rl w1 x2+12 ; getalarm := alarm record(7);
jl. (j6.) ; goto end register expression;
\f
; jz 1979.10.09 trap, init zones page 7
; algol 8 version
g3:
c. g3-g1-506
m.code too long
z.
c. 502-g3+g1,jl-1,r.252-(:g3-g1:) > 1 z.
<:zones/trap <0>:>
i. ; id list
e. ; end slang segment
; tail for insertproc:
g0: 1, 0, 0, 0, 0 ; first tail: init zones
1<23 + e1-e5 ; entry point
1<18+25<12+25<6 +30 ,0; no type proc(zone array, int arr, int arr)
4<12 + e0-e5 ; algol external, start ext list
1<12 + 0 ; 1 code segment, 0 owns
1<23 + 4, 0,r.4 ; getalarm:
1<23 + e6 - e5 ; entry point
3<18 + 41<12, 0 ; integer procedure(undef)
4<12 + e0 - e5 ;
1<12 + 0 ;
g1: 1<23 + 4 ; last tail: trap
0,0,0,0 ;
1<23 + e2 - e5 ; entry point
1<18+41<12,0 ; no type proc(undef,integer addr);
4<12 + e0 - e5 ; algol external, start ext list
1<12 + 0 ; 1 code segment, 0 owns
m. fgs 1986.10.02 initzones, trap, getalarm
m. algol 8 version
d. ;
p. <:insertproc:>;
w. ;
▶EOF◀