|
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: 23808 (0x5d00)
Types: TextFile
Names: »copyareatx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »copyareatx «
mode list.yes listing.no
(
if listing.yes
(listcopy=set 50
if ok.no
finis
o listcopy
(copyarea=slang xref.yes
copyarea)
if ok.no
c=message ok.no
o c
convert listcopy std)
if listing.no
(copyarea=slang
copyarea)
)
copyarea)
\f
;
; fgs 1984.01.19 algol 8, copy area page ... 1...
;
;
;integer
;procedure copyarea (zmaster, zarea, ztape, blocksize);
;value blocksize ;
;zone zmaster, zarea, ztape ;
;integer blocksize ;
;
;call : copyarea (zmaster, zarea, ztape, blocksize);
;
;function :
;
;The procedure sends a copy message to the process determined
;by the zone zmaster concerning the backing storage area deter-
;mined by the zone zarea and the magnetic tape determined by
;the zone ztape.
;The message is sent in used share and a possible pending next
;share is waited for and checked by the runtime system procedu-
;re check.
;
; copyarea
; return value, integer. The number of segments speci-
; fied in the message sent.
;
; zmaster call and return value, zone. Determines the document,
; the buffering (no of shares) and the position of the
; document (used share).
; The zonestate must be after open, the mode 0 or 1
; meaning without or with tapemark after completion
; and the kind must be 0 (internal process) to ensure
; proper standard actions on stopped (repeat transfer).
; At call the position of the tape must be recorded in
; file and block count of the zone, at return the new
; position is recorded, i.e. just remember to set the
; position in file and block count once before the first
; call.
; At call the length of used share must be at least 20 hwds
; (room to contain twice name and name table address)
; At return (and in the block procedure) the zone record of
; 20 hwds contains the names and name table addresses of the
; documents concerned in the copy operation described in the
; next share, which is now used share.
;
; zarea call value, zone. Determines the document and the
; position of the document (backing storage area).
; The zone kind must be 4 (backing storage area).
; The zone state must be after open and the position
; determines the first segment to be transferred,
; while the no of segments to be transferred is de-
; termined by the first segment and the size of the
; area.
;
; ztape call value, zone. Determines the document , the
; buffering and the position of the document (mag
; tape).
; The zone kind must be 18 (magnetic tape).
; At call the zone state must be after open and po-
; sition.
; The zone mode determines the tape mode to be used.
;
; blocksize
; call value, integer. The blocksize in segments per
; block to be used.
;\f
;
; fgs 1984.03.08 algol 8, copy area page ... 2...
;
;
;Details :
;
; The message sent in used share of zmaster will be :
;
; zmaster.used share.message : 14<12 + mode
; + 2 : (reserved)
; + 4 : addr of area process
; + 6 : first segment
; + 8 : number of segments
; +10 : addr of tape process
; +12 : tape mode
; +14 : blocksize
;
; where :
;
; mode is taken from zmaster.modekind and means :
; 0 : no file mark is written
; 1 : a file mark is written on the tape after the area
;
; reserved is reserved for the procedure copyarea (= first shared)
;
; addr area process is the address of the area process whose document is
; to be transferred to tape. It is taken from zarea.name
; table address The name is taken from ztape.document
; name and stored together with name table address in
; zmaster.used share.first shared + 0:8
;
; first segment is the first segment of the area to be transferred and
; is taken from zarea.segment count
;
; no of segments is the number of segments to be transferred to tape and
; is computed as area size - zarea.segment count
;
; addr tape process is the address of the magnetic tape process where to
; to transfer the backing storage area segments It is
; taken from ztape.name table address while the name is
; taken from ztape.docname and stored together with name
; table address in zmaster.used share.first shared + 10.
;
;\f
;
; fgs 1984.02.09 algol 8, copy area page ... 3...
;
;
;
; tape mode is the tape mode to be used in the operation and is ta-
; ken from ztape.modekind :
;
; mode =
; block gap length < 9 + speed < 7 + density < 2 + parity
;
; block gap length being
;
; 0 : standard gap length
; 1 : long gap length
;
; speed being
;
; 0 : automatic velocity control
; 1 : high speed (100/75 ips) when strapped for avc
;
; 0 : start/stop (25 ips)
; 1 : streaming (100/75 ips) when strapped for fixed
;
; density being
;
; 0 : high density (mto/mte or gcr)
; 1 : low density (nrz/nrze)
;
; parity being
;
; 0 : odd parity
; 1 : even parity
;
; blocksize is the blocksize in segments/block to be used on
; the tape
;
; The message is sent with current activity number in w2, the used share
; is incremented modulo no of shares in zmaster and used share is waited
; for and checked by means of rs entry check, possibly implicitly passi-
; vated before the wait, governed by the give up mask in zmaster
;
;\f
;
; fgs 1984.02.09 algol 8, copy area page ... 4...
;
;
;
; The answer is supposed to be :
;
; answer : status
; + 2 : no of segments transferred
; + 4 : (unused)
; + 6 : file count
; + 8 : block count
;
; where :
;
; status means :
;
; 1 shift 0 : give up
; 1 shift 1 : normal answer
;
; 1 shift 2 :
; 1 shift 3 :
; 1 shift 4 : dummy answer from monitor concerning the master
; 1 shift 5 : process, no other status error
;
; 1 shift 6 :
; 1 shift 7 : are not generated by the check routine
;
; 1 shift 8 : stopped is generated by the master process
;
; 1 shift 12: are the device status bits
; to
; 1 shift 23: coming from the device
;
; no of segments transferred is the number of segments transferred with-
; out status error
;
; file count is the position of the next block on the tape after the
; block count operation, being :
;
; next file, block no zero if tape mark was requested
; curr file, next block if tape mark was not requested
;
; In case of status error, the position is after the last
; block transferred without error
; If no of segments transferred = 0, file and block count
; are undefined
;
;\f
;
; fgs 1985.02.09 algol 8, copy area page ... 5...
;
;
;
; The answer is received by the runtime system procedure check in the
; resident runtime system entry "latest answer", entry no 101, and the
; check according to kind = zero implies that :
;
; - the block procedure of the zone zmaster is called in case of user bits
; found in the status word or in case of hard error bits among the re-
; maining bits (i.e. all except special, write enable and normal answ-
; er), but first after
;
; - standard error actions are performed on special bits among the remai-
; ning bits (stopped, end of document) being :
;
; stopped : repeat all the shares and recheck used share
; e. o. d.: call users block procedure with hard error bit set
;
; The stopped action, though, will be prevented by user specified :
; parity error, timer, data overrun, blocklength, end of document,
; tape mark/attention, read error (disc error after recovery), word
; defect, all dummy answers
;
; - the block procedure of the zone zmaster should take over all op-
; erations returned with normal answer in order to keep file count
; and block count of the zone updated
;
; - the block procedure of the zone zmaster may take over operations
; returned with status error, having at its disposal :
;
; +the original message in used share with the addr of the processes
; +the names and name table addresses in used share part of the
; zone buffer
; +the complete answer in rs entry "latest answer"
; +the position after the last checked operation in file and block
; count of zmaster
; +the zone zarea, which maybe has to be closed and reopened (in case
; of multishare operation in zmaster) before it is positioned
; +the zone ztape, which just has to be positioned
;
;\f
;
; fgs 1984.02.09 algol 8, copy area page ... 6...
;
;
;
; If the document in the zone zmaster is an ida process, the dummy an-
; swers from the monitor will be :
;
; result 2 : rejected
; sender not reserver of ida process
; sender not reserver of tape process
; sender not user of area process
;
; result 3 : unintelligible
; illegal mode/tape mode/blocksize
; area/tape process does not exist
; area/tape process not mastered by the same ida process
;
; result 4 : malfunction
;
; result 5 : receiver does not exist
;
; Then, a giveup mask of 1<5 + 1<4 + 1<3 + 1<2 + 1<1 in zmaster will
; cause :
;
; - normal answers to lead to call of block procedure without hard er-
; ror bit set in the status word
;
; - dummy answers to lead to call of block procedure without hard er-
; ror bit set in the status word
;
; - any device status error to lead to call of block procedure with
; hard error bit set in the status word
;
; - the stopped bit (1<8) in status to lead to repeat action (all pend-
; ing shares repeated and used share rechecked) before a possible call
; of block procedure
;
; The block procedure of zmaster should keep file and block count of
; the zone zmaster updated for all normal answers
;
; The block procedure of zmaster may just reposition the zones zarea and
; ztape after a possible reopen of zarea and take over the transfer of
; the area by means of standard i/o (in/out/inoutrec) in the zones, lea-
; ving the proper handling of the device status to the i/o system accord-
; ing to the proper kind and the proper block procedures in the two zo-
; nes
; The share length in ztape, then, should equal blocksize * 512 halfs
; during the transfer
;
;\f
;
; fgs 1984.02.09 algol 8, copy area page ... 7...
;
;
; Note :
;
; The field "first address" of the message built up in the shares of
; zmaster are used internally to equal "first shared" of the actual share
; in order to be able to benefit from the repeat action in check.
; Since it it always initialized by open and assigned by "start transfer"
; in the i/o system, no special care needs to be taken by reuse of the
; zone
;
;
;\f
; fgs 1984.02.09 algol 8, copy area page ... 8...
b. ; block fpnames
d.
p. <:fpnames:>
l.
b. g1, i6 ; block for insertproc
w.
i4 = 0 ; segment count := 0;
i5 = 0 ; own byte count := 0;
s. g4 ; slang segment
w.
b. c3, j94 ; block for segment
w.
g0 = 0 ; no of externals := 0;
k = 1000 ; k assignment to catch missing relatives
h.
c1 : c2 , c3 ; rel last point, tel last abs word
j4 : g0 + 4, 0 ; rs entry 4, take expression
j5 : g0 + 5, 0 ; rs entry 5, goto point
j6 : g0 + 6, 0 ; rs entry 6, end register expression
j13: g0 + 13, 0 ; rs entry 13, last used
j21: g0 + 21, 0 ; rs entry 21, general alarm
j30: g0 + 30, 0 ; rs entry 30, saved sref, w3
j85: g0 + 85, 0 ; rs entry 80, current activity no
j94: g0 + 94, 0 ; rs entry 94, take value integer
c3 = k-2-c1 ; rel last abs word
j33: g0 + 33, 0 ; rs entry 33, check
c2 = k-2-c1 ; rel last point
w.
i2 = k-c1 ; start external list
0 ; no of globals, no of externals
0 ; no of bytes to copy to own core
s3 ; date
s4 ; time
\f
; fgs 1984.02.27 algol 8, copy area page ... 9...
b. a20, b20, d20 ; block for local names in copyarea
w.
i0 = k-c1 ; entry copy area:
rl. w2 (j13.) ; get sref;
ds. w3 (j30.) ; save sref, w3;
jl. a1. ; goto start transfer;
a0: jl. w3 a3. ; wait: wait transfer;
ds. w3 (j30.) ; save sref, w3;
a1: jl. w3 a2. ; start: start transfer;
jl. a0. ; if not startet then goto wait;
jl. w3 a3. ; wait transfer;
; <*w0 = top xferred = recbase + segs xferred*>
ds. w3 (j30.) ; save sref, w3;
rl w1 x2+6 ; w1 := 1.formal (1); <*no of segments in message*>
jl. (j6.) ; goto end register expression;
\f
; fgs 1984.03.08 alol 8, copy area page ...10...
; procedure start transfer;
;
; call: return started: return not started:
;
; w0 : - undefined undefined
; w1 : - next share used share
; w2 : sref sref sref
; w3 : link undefined master zone
;
a2: rs. w3 b2. ; entry: save return;
rl w3 x2+8 ; zone := master zone;
rl w1 x3+h2+6 ; if zone.state except
la. w1 d0. ; buflength error bit <>
se w1 0 ; after open and position then
jl. a10. ; goto state alarm;
rl w1 x3+h0+8 ; no of shares :=
ws w1 x3+h0+6 ; (zone.last share -
al w0 0 ; zone.first share ) //
wd. w1 d1. ; share descr length +
al w1 x1+1 ; 1 ;
rs. w1 b1. ;
rl w1 x3+h0+2 ; buflength :=
ws w1 x3+h0+0 ; (zone.last of buffer -
al w0 0 ; zone.base buffer) //
wd. w1 b1. ; no of shares;
sh w1 19 ; if buflength < 20 then
jl. a9. ; goto buflength alarm;
zl w1 x3+h1+1 ;
se w1 0 ; if zone.kind <> 0 then
jl. a12. ; goto kind alarm;
zl w1 x3+h1+0 ;
sz w1 8.3776 ; if zone.mode logical and 0..01111111110 <> 0 then
jl. a11. ; goto mode alarm;
\f
; fgs 1984.02.29 algol 8, copy area page ...11...
rl w1 x3+h0+4 ; share := zone.used share;
rl w0 x1 ; w0 := master zone.used share.state;
se w0 0 ; if w0 <> 0 then
jl. (b2.) ; goto link;
al w1 x1+6 ; message addr :=
rs. w1 b0. ; zone.used share + 6;
dl w1 x2+20 ; w0w1 := formals (blocksize);
so w0 16 ; if expression then
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; save sref, w3;
al w0 3 ;
la w0 x2+18 ; w0 := type (formal);
jl. w3 (j94.) ; w1 := take value integer (w1);
am. (b0.) ; message.blocksize :=
rs w1 +14 ; w1;
\f
; fgs 1984.10.31 algol 8, copy area page ...12...
rl w3 x2+16 ; zone := tape zone;
zl w1 x3+h1+1 ;
se w1 18 ; if zone.kind <> 18 then
jl. a12. ; goto kind alarm;
rl w1 x3+h2+6 ; if zone.state
la. w1 d0. ; except buflength error bit <>
se w1 0 ; after open and position then
jl. a10. ; goto state alarm;
sn w1 (x3+h1+10) ; if zone.name table addr = 0 then
jl. a8. ; goto connect alarm;
rl w0 (x3+h1+10) ; message.tape process addr :=
; cont (name table addr);
el w1 x3+h1+0 ; message.tapemode :=
la. w1 d2. ; zone.mode
am. (b0.) ; extract 11;
ds w1 +12 ;
rl w3 x2+12 ; zone := area zone;
zl w1 x3+h1+1 ;
se w1 4 ; if zone.kind <> 4 then
jl. a12. ; goto kind alarm;
rl w1 x3+h2+6 ; if zone.state
la. w1 d0. ; except buflengtheror bit <>
se w1 0 ; after open and positioned then
jl. a10. ; goto state alarm;
sn w1 (x3+h1+10) ; if zone.name table addr = 0 then
jl. a8. ; goto connect alarm;
rl w1 (x3+h1+10) ;
am. (b0.) ; message.area process addr :=
rs w1 +4 ; cont (name table addr);
rl w1 x1+18 ; segs := area proc.no of segments;
; message.no of segments :=
rl w0 x3+h1+16 ; segs -
ws w1 0 ; zone.segment count;
am. (b0.) ; message.first segment :=
ds w1 +8 ; zone.segment count;
rs w1 x2+6 ; 1.formal (1) := message.no of segments;
\f
; fgs 1984.03.08 algol 8, copy area page ...13...
rl w3 x2+8 ; zone := master zone;
rl w1 x3+h0+4 ; share := zone.used share;
rl w1 x1+2 ; w1 := share.first shared;
rl w3 x2+12 ; zone := area zone;
al w3 x3+h1+2 ; w3 := zone.document name addr;
al w2 x1 ; w2 := w1;
dl w1 x3+2 ; move
ds w1 x2+2 ; name at w3
dl w1 x3+6 ; to
ds w1 x2+6 ; name space at w2;
rl w1 x3+8 ;
rs w1 x2+8 ; move name table address;
rl. w3 (j13.) ;
rl w3 x3+16 ; zone := tape zone;
al w3 x3+h1+2 ; w3 := zone.document name addr;
dl w1 x3+2 ; move
ds w1 x2+12 ; name at w3
dl w1 x3+6 ; to
ds w1 x2+16 ; name space at w2 + 8;
rl w1 x3+8 ;
rs w1 x2+18 ; move name table address;
rl. w2 (j13.) ; restore sref;
\f
; fgs 1984.02.29 algol 8, copy area page ...14...
rl w3 x2+8 ; zone := master zone;
zl w1 x3+h1+0 ;
al w0 14 ; w0 :=
ls w1 +13 ; 14 shift 12 +
ls w1 -1 ; zone.mode extract
ld w1 +12 ; 11;
rl w1 x3+h0+4 ; w1 :=
rl w1 x1+2 ; zone.used share.first shared;
am. (b0.) ; message.opmode := w0;
ds w1 +2 ; message.reserved := w1;
; <*used in repeat transfer in check to *>
; <*handle stopped *>
rl. w1 b0. ; w1 := message addr;
rl. w2 (j85.) ; w2 := current activity no;
al w3 x3+h1+2 ; w3 := addr (zone.docname);
jd 1<11+16 ; send message (w1, w2, w3);
sn w2 0 ; if buffer claim exceeded then
jd 1<11+18 ; provoke break 6;
al w1 x1-6+h6 ; w1 := used share + share descr length;
rs w2 x1- h6 ; used share.state := message buffer addr;
al w2 x3-h1-2 ; zone := w2 := master zone;
sh w1 (x2+h0+8) ; if w1 > zone.last share then
jl. a4. ; w1 := zone.first share;
rl w1 x2+h0+6 ;
a4: rs w1 x2+h0+4 ; used share := w1;
al w3 20 ;
rl w0 x1+2 ; rec base :=
es. w0 1 ; zone.used share.first shared - 1;
rl w1 0 ; last byte :=
wa w1 6 ; rec base + 20;
ds w1 x2+h3+2 ;
rs w3 x2+h3+4 ; rec length := 20;
rl. w2 (j13.) ; w2 := sref;
am. (b2.) ;
jl +2 ; return to link + 2;
\f
; fgs 1984.02.29 algol 8, copy area page ...15...
; procedure wait transfer
;
; call : return :
;
; w0 : - top transferred (area name address)
; w1 : used share undefined
; w2 : sref sref
; w3 : link undefined
;
a3: rl w0 x2+8 ; entry:
ls w0 4 ; w0 := master zone shift 4;
rl. w1 j33. ; w1 := point (rs check);
jl. (j4.) ; goto take expression (point);
; return to link;
; procedure connect/length/state/mode/kind alarm;
;
; call : return :
;
; w0 : - -
; w1 : param -
; w2 : - -
; w3 : - -
;
d8 : <:<10>z.connect :>
d9 : <:<10>z.length :>
d10: <:<10>z.state :>
d11: <:<10>z.mode :>
d12: <:<10>z.kind :>
a8 : am d8 -d9 ; connect alarm:
a9 : am d9 -d10 ; length alarm:
a10: am d10-d11 ; state alarm:
a11: am d11-d12 ; mode alarm:
a12: al. w0 d12. ; kind alarm: w0 := alarm text;
jl. w3 (j21.) ; general alarm (text, param);
; constants :
d0: -1-64 ; mask for removal of buflength error bit
d1: h6 ; share descr length
d2: 8.3777 ; mask for extract 11
; variables :
b0: 0 ; address of message area (share + 6);
b1: 0, r.10 ; tail area
b2: 0 ; saved return
\f
; fgs 1984.02.09 algol 8, copy area page ...16...
i.
e. ; end block for local names in copy area
c0 = k-c1
c. c0 - 506
m. code on segment 1 too long
z.
c. 502 - c0
0, r. (:504 - c0:) > 1 ; fill segment with zeroes
z.
<:copy area<0>:> ; alarm text
m. segment 1
i.
e. ; end block segment 1
i4 = i4 + 1 ; increase segment count
i.
e. ; end block for segment
\f
; fgs 1984.02.09 algol 8, copy area page ...18...
; tails for insertproc
h.
g0:g1: ; first and last tail
0 , i4 ; size
0 , r.8 ; name
1<11+0 , i0 ; entry point
w. 3<18+13<12+8<6+8 ; integer proc (zone, zone, zone,
8<18 ; value integer)
h. 4 , i2 ; kind<12 + start external list
i4 , i5 ; code segments<12 + own bytes
m. fgs 1984.10.31 copy area
d.
p. <:insertproc:>
l.
i.
e. ; end slang segment
finis
▶EOF◀