|
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: 14592 (0x3900)
Types: TextFile
Names: »gzone3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »gzone3tx «
; rc 1.12.69.
\f
; algol 6 procedures getzone, getshare, setzone and setshare page 1
b. e20,g1
s. b10,c20,d10,g10,f4
k=0
h.
g1: g2 , g2 ; headword, g1 is 1thlabel in program
g3: 13 , 0 ; rs entry last used
g4: 30 , 0 ; rs entry saved sref
g5: 21 , 0 ; rs entry general alarm
g7: 4 , 0 ; rs entry take expression
g8: 8 , 0 ; rs entry end address expr
g2=k-2-g1 ; length of abs word list
w.
;external list
e0: 0,0, s3, s4
; constant list
c1: 0 ; address of 1th element of ia
c2: 0 ; zone desc addr, z
h.
c3: 32 , h1 ; no of bytes in desc part1-part3,relative part1
w.
c4: 0 ; return address from various b-routines
c5: 0 ; share descriptor address
c6: h6 ; length of share descriptor
c7: 0 ; temporary used
c8: 0 ; -
c9: 1<23 ; mask to remove or set bit 0 in mode-byte
; alarm routine, called when illegal parameters or values
; alarm text
e10: <:<10>index :> ; illegal size of ia
e11: <:<10>share :> ; illegal share number
e12: <:<10>value :> ; illegal value in ia
; alarm entry
e15: am 6 ; entry if value alarm
e16: am 6 ; entry if share alarm
e17: al. w0 e10. ; entry if index alarm
jl. w3 (g5.) ; goto general alarm
e18: ; field alarm:
sh w3 (x1-2) ; if size <= upper index value then
al w3 2 ; field := 2; <*else field = size*>
rl w1 6 ;
ls w1 -1 ; index := field/2;
jl. e17. ; goto index alarm;
\f
; algol 6 procedures getzone, getshare, setzone and setshare page 2
; set addresses for moving zone descriptor
; entry b1. move part1,part2 and part3 from descriptor to ia
; entry b8. move ia to part1,part2 and part3 of descriptor
; w3 contains address of part descriptor
b1: am 1 ; entry from getzone
b8: al w0 1 ; entry from setzone
rs. w1 c4. ; save return address
bz w1 x3 ; w1 := number of bytes in part desc
bl w2 x3+1 ; w2 := relative part of zone desc
wa. w2 c2. ; + base of zone
rl. w3 c1. ; w3 := 1st element of ia
se w0 2 ; if called from getzone then skip
rx w3 5 ; else exchange w2 and w3
al w0 x1 ; w0 := number of bytes to move
jl. w1 b7. ; jump to move
jl. (c4.) ; return
; move share descriptor to integer array ia
b4: rs. w1 c4. ; store return address
rl. w0 c6. ; number of bytes
rl. w2 c5. ; share base
rl. w3 c1. ; 1th ia element address
jl. w1 b7. ; move
jl. (c4.) ; exit
; innermost move loop
; move w0 bytes from w2 to w3 and following
b7: rs. w1 c8. ; store return address
rl w1 0 ;
d2: al w1 x1- 2 ; w1 := no of bytes -2
am x1+ 0 ;
rl w0 x2+ 0 ; move one word
am x1+ 0 ; starting with last word
rs w0 x3+ 0 ;
se w1 0 ; if last byte then skip
jl. d2. ; else move next
jl. (c8.) ; exit
; set addresses for moving ia to share descriptor
; starting with ia(2) and descriptor(2)
b9: rs. w1 c4. ; save return address
rl. w1 c6. ; w1 := length of share descriptor
al w0 x1-2 ; w0 := length-2
rl. w2 c1. ; w2 := address of ia(2)
al w2 x2+2 ;
rl. w3 c5. ; w3 := address of descriptor(2)
al w3 x3+2 ;
jl. w1 b7. ; jump to move
jl. (c4.) ; return
\f
; algol 6 procedures getzone, getshare, setzone and setshare page 3
; unpack zone descriptor, ia, share no
; called with w0 := minimumlength of ia
; w1 := return address
; return with c1 := address of first element of ia
; c2 := address of zone descriptor
; c5 := address of share descriptor
; unpack share number
b2: rl. w2 (g3.) ; w2 := last used
ds. w3 (g4.) ; saved sref
sl w0 34 ; if w0 < 34 then unpack share
jl. b3. ; else skip to z and ia
rx w0 x2+14 ; w0 := first formal of share
rx w1 x2+16 ; w1 := second formal of share
so w0 16 ; if kind = 16 then
jl. w3 (g7.) ; take expression
ds. w3 (g4.) ; save sref
rl w1 x1 ; w1 := share number
sh w1 0 ; if zero then
jl. e16. ; goto alarm
rs. w1 c5. ; else save share no
dl w1 x2+16 ; restore entry values
; unpack zone descriptor and ia
b3: ds. w1 c8. ; save entry values
dl w1 x2+12 ; w0,w1 := formals of ia
ba w1 0 ; w1 := addr of dope
al w0 2 ;
rl. w3 c7. ;
sh w3 (x1-2) ; if size > upper index value
sh w0 (x1) ; or 2 >= lower index value - 2 then
jl. e18. ; goto field alarm;
wa w0 (x2+12) ; addr := 2 +
rs. w0 c1. ; addr element (0, 0, 0, ...);
rl w1 x2+8 ; else w1 := addr of zone desc
rs. w1 c2. ; save address
sl w3 34 ; if not share (w3 > 34)
jl. (c8.) ; then return
rl. w3 c5. ; else w3:= share number
jl. w2 b10. ; unpack share
rs. w0 c5. ; if ok then save addr of sharedesc
jl. (c8.) ; and return
rl. w1 c5. ; else goto alarm
jl. e16. ; alarm
\f
; algol 6 procedures getzone getshare setzone setshare page 4
; compare address in w0 to be within zone buffer limits
; normal return jump if inside limits, else goto alarm
b6: rs. w3 c4. ; save return address
am. (c2.) ;
rl w3 h0 ; w3 := first of buffer
am. (c2.) ;
sh w0 (h0+2) ; if addr > last
sh w0 x3-2 ; or addr < first-2
jl. e15. ; then goto alarm
jl. (c4.) ; else return
; unpack and check share number
; if illegal then return to linkaddress + 4
; called with w1 := address of zone desc
; w2 := link address
; w3 := share number
; return with w0 := address of share desc
b10: al w0 x3-1 ; w0 := address of actual share desc
wm. w0 c6. ;
wa w0 x1+h0+6 ;
sh w0 (x1+h0+8) ; if addr of share =< last share
jl x2 ; then return to link addr
jl x2+4 ; else return to link+4
\f
; algol 6 procedure getzone, getshare, setzone and setshare page 5
; getzone(z,ia);
; move zone descriptor for z to integer array ia
f1:
e1: al w0 40 ; w0 := min.length of ia -1
jl. w1 b2. ; unpack z and ia
al. w3 c3. ; w3 := part desc (h1)
jl. w1 b1. ; move part to ia
dl. w3 c2. ; w2 := addr of ia,w3 := addr of zone desc
rl w1 x2 ; remove bit 0 in mode-byte
lx. w1 c9. ;
rs w1 x2 ;
rl w1 x3+h0+4 ; w1 := addr of used share
ws w1 x3+h0+6 ; w1 := number of used share
al w0 0 ;
wd. w1 c6. ;
al w1 x1+1 ;
rl w0 x2+30 ; divide record length by 4
ls w0 -2 ;
ds w1 x2+32 ; store in ia
rl w1 x3+h0+8 ; w1 := addr of last share
ws w1 x3+h0+6 ; w1 := number of shares
al w0 0 ;
wd. w1 c6. ;
al w1 x1+1 ;
rs w1 x2+34 ; store in ia
rl w0 x3+h0+0 ; w0 := base of buffer
rl w1 x3+h0+2 ; w1 := buffer length
ws w1 x3+h0+0 ;
ls w1 -2 ; divide by 4
ds w1 x2+38 ; store in ia
jl. (g8.) ; exit getzone
; getshare(z,ia,sh);
; move share descriptor for share sh in zone z to integer array ia
f2:
e2: al w0 24 ; w0 := min.length of ia -1
jl. w1 b2. ; unpack z, ia and share
jl. w1 b4. ; move entire share desc to ia
rl. w3 c1. ; w3 := addr element ia (1);
am. (c2.) ;
al w0 h0 ; w0 := addr elemt zdescr (1); <*cont. base buffer*>
dl w2 x3+4 ; (w1, w2) :=
ws w1 (0) ; (1. sh'd , last sh'd ) -
ws w2 (0) ; (base buffer area, base buffer area) +
al w1 x1+3 ; (3 , 3 ) //
al w2 x2+3 ; (4 , 4 ) ;
ls w1 -2 ;
ls w2 -2 ;
ds w2 x3+4 ; (1. sh'd, last sh'd) := (w1, w2);
jl. (g8.) ; exit getshare
\f
; algol 6 procedure getzone, getshare, setzone and setshare page 6
; setzone(z,ia);
; move content of integer array ia to zone descriptor z
f3:
e3: al w0 34 ; w0 := min.length of ia -1
jl. w1 b2. ; unpack z and ia
al. w3 c3. ;
jl. w1 b8. ; move part1 - part3
rl. w2 c2. ; w2:= addr of zone desc
rl w1 x2+h1 ; w1 := mode-byte
lo. w1 c9. ; set bit 0 in mode-byte
rs w1 x2+h1 ;
bz w3 x2+h1+1 ; w3 := kind
al w1 1 ; w1 := ia index in case of alarm
sl w3 0 ; if kind=> 0 and < 19
sl w3 19 ; then ok else
jl. e15. ; goto alarm
sz w3 1 ; else if kind is odd then
jl. e15. ; goto alarm
al w1 14 ; update ia index
rl w0 x2+h3 ; w0 := addr of record base
so w0 1 ; if even address
jl. e15. ; then goto alarm
jl. w3 b6. ; else check within buffer limit
al w1 15 ; update ia index
rl w0 x2+h3+2 ; w0 := addr of last byte
jl. w3 b6. ; check
al w1 16 ; update ia index
rl w0 x2+h3+4 ; w0 := record length
ls w0 +2 ; multiply by 4
rs w0 x2+h3+4 ;
wa w0 x2+h0+0 ; add base of buffer
jl. w3 b6. ; check
am. (c1.) ; check used share
rl w3 +32 ;
sh w3 0 ; if < 0
jl. d4. ; then goto alarm
rl. w1 c2. ; w1 := addr of zone desc
al w2 x2+h0+4 ; set addr of used share
rs. w2 c5. ; to later use
jl. w2 b10. ; check used share no
rs. w0 (c5.) ; if ok then store addr
jl. (g8.) ; and exit setzone
d4: al w1 17 ; else w1 := ia index
jl. e15. ; goto alarm
\f
; algol 6 procedure getzone, getshare, setzone and setshare page 7
; setshare(z,ia,sh);
; move content of integer array ia to share descriptor for sh
f4:
e4: al w0 24 ; w0 := min.length of ia -1
jl. w1 b2. ; unpack z, ia and sh
jl. w1 b9. ; move ia to descriptor
rl. w2 c5. ; w2 := address of share desc
rl w1 x2+3 ; w1 := abs addr of first shared
ls w1 +2 ; multiply index by 4
am. (c2.) ;
wa w1 h0+0 ;
al w0 x1-3 ; w0 := abs address of first byte
rs w0 x2+3 ; store addr in share desc
al w1 2 ; w1 := ia index in case of alarm
jl. w3 b6. ; check addr within buffer limit
rl w1 x2+5 ; w1 := abs addr of last shared
ls w1 +2 ; multiply index by 4
am. (c2.) ;
wa w1 h0+0 ;
al w0 x1-1 ; w0 := abs address of first byte
rs w0 x2+5 ; store addr in share desc
al w1 3 ; update ia index
jl. w3 b6. ; check within limit
bz w0 x2+6 ; w0 := operation
so w0 1 ; if even operation
jl. d3. ; then skip
rl w0 x2+9 ; else check
al w1 5 ; first and last
jl. w3 b6. ; address of block
rl w0 x2+11 ; within
al w1 6 ; zone buffer limit
jl. w3 b6. ;
d3: rl w1 x2+23 ; w0 := top transferred -1
al w0 x1-1 ;
al w1 12 ; update ia index
jl. w3 b6. ; check
al w1 1 ; w1 := ia index
rl w0 x2 ; w0 := old share state
rl. w3 (c1.) ; w3 := new share state
sh w0 1 ; if old state > 1
sh w0 -1 ; or < 0
jl. (g8.) ; then exit
sh w3 1 ; else if new state > 1
sh w3 -1 ; or < 0
jl. e15. ; then goto alarm
rs w3 x2 ; else store new state
jl. (g8.) ; exit setshare
\f
; algol procedure getzone, getshare, setzone and setshare tail part
d10: c. d10-506-g1 m. code too long
z. ; more than one segment
c. g1+502-d10, 0, r. g1+252-d10>1
z. ; fill rest of segment with zeros
<:zone,share:> ; alarm text
i.
e.
m. rc 1987.07.07 getzone getshare setzone setshare
; tails
w.
g0: 1, 0, r.4 ; 1th tail, getzone: 1 segment
1<23+e1 ; entry for getzone
1<18+25<12+8<6 ; no type, integer array, zone
0 ;
4<12+e0 ; external list
1<12 ; 1 segment
1<23+4, 0, r.4 ; getshare: 1 segment
1<23+e2 ; entry for getshare
1<18+3<12+25<6+8 ; no type, integer, integer array, zone
0 ;
4<12+e0 ; external list
1<12 ; 1 segment
1<23+4, 0, r.4 ; setzone: 1 segment
1<23+e3 ; entry for setzone
1<18+25<12+8<6 ; no type, integer array, zone
0 ;
4<12+e0 ; external list
1<12 ; 1 segment
g1: 1<23+4, 0, r.4 ; setshare: 1 segment
1<23+e4 ; entry for setshare
1<18+3<12+25<6+8 ; no type, integer, integer array, zone
0 ;
4<12+e0 ; external list
1<12 ; 1 segment
\f
▶EOF◀