|
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: 16896 (0x4200)
Types: TextFile
Names: »tofrom3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »tofrom3tx «
\f
; fgs 1987.06.24 rc4000 code procedure, tofrom page 1
;
; this code procedure is intended as a replacement of the for loops
; commonly used to move data in core.
; it is particularly usefull in connection with arrays holding a
; number of bytes not divideable by 4.
;
b. e1, f2, g1 ; begin block for insertproc
w.
d.
p.<:fpnames:>
l.
s. l0 ; begin global slang segment
k=10000
b. g5, j50 ; begin block segment 1
h.
f1=0 ; number of externals := 0
j0: g1, g2 ; head-word: last-point, last-absword
j1: 1<11o.1, 0 ; own segment, next one
j4: f1 + 4, 0 ; rs-take-expression
j8: f1 + 8, 0 ; rs-end-register-expression
j13: f1 + 13, 0 ; rs-last-used
j21: f1 + 21, 0 ; rs-general-alarm
j29: f1 + 29, 0 ; rs-param-alarm
j30: f1 + 30, 0 ; rs-saved-stackref, saved-w3
g2=k-2-j0 ; rel of last absword
g1=k-2-j0 ; rel of last point
w.
f2=k-j0 ; rel start of external list
f1 ; no. of externals
0 ; no. of bytes to init in perm. core
;
s3 , s4 ; date and time of this version
;
;
;
; procedure tofrom(to_arr, from_arr, move_size)
;
; any type array or zone to_arr, from_arr
; integer move_size
;
;
; the procedure moves a number of bytes to to_arr from from_arr.
; the number of bytes is given by the parameter movesize, which
; must be positive or zero.
; the moved area starts at index 1, byte 1 of the array, in both
; arrays.
; the procedure moves strictly in increasing address order, i.e.
; overlapping core areas can be moved in the direction of lower
; index.
;
; the procedure is equivalent to this for loop:
;
; boolean field bfld;
; for bfld:= 1 step 1 until movesize do toarr.bfld:= fromarr.bfld;
;
; with the exception that byte one in both arrays must correspond to
; the left byte of a computer-word. i.e. boolean arrays having an even
; lower bound, and other arrays fielded with field array variables
; having odd values are not allowed.
\f
; fgs 1987.06.24 rc4000 code procedure, tofrom page 2
;
;
; the procedure is less timeconsuming than a simple for loop
; of more than approximately 5 steps.
;
; alarms:
;
; if to_arr or from_arr are not arrays or zones, the alarm param
; is given.
;
; if move_size is less than zero, the alarm movesize is given
; with an integer telling the value of move_size.
;
; if byte one of one of the arrays is not the left byte of a com-
; puter-word, the alarm oddfield is given, together with the number
; of the parameter, 1 or 2.
;
; if byte 1 or byte move_size exceeds the limits of one of
; the arrays, the alarm movefld is given, together with the
; relevant byte number.
;
;
b. a20, c10, i5 ; begin block tofrom segment 1
w.
e0=0 ; entry segment
e1=k-j0 ; rel entry
rl. w2 (j13.) ; w2:= rs-last-used
ds. w3 (j30.) ; save rs-stackref, and save-w3
;
; check that the two first parameters really contain some type of
; array or zone.
;
al w1 2.11111 ;
la w1 x2+6 ;
sh w1 23 ; if kind(param-1) > zone or
sh w1 16 ; kind(param-1) < boolean array then
jl. w3 (j29.) ; goto rs-param-alarm
;
al w1 2.11111 ;
la w1 x2+10 ;
sh w1 23 ; if kind(param-2) > zone or
sh w1 16 ; kind(param-2) < boolean array then
jl. w3 (j29.) ; goto rs-param-alarm
;
; take parameter move_size.
;
dl w1 x2+16 ;
so w0 16 ; if expression then
jl. w3 (j4.) ; goto rs-take-expression
ds. w3 (j30.) ;
rl w0 x1 ; w0:= move_size
;
sh w0 -1 ; if move_size < 0 then
jl. a9. ; goto alarm(movesize)
\f
; fgs 1987.06.24 rc4000 code procedure, tofrom page 3
;
;
; find base addresses for the two core areas involved in the move,
; and check that byte 1 and byte move_size are within bounds.
;
rl w3 x2+8 ; w3:= base-word-addr-toarr
rl w1 x3 ; w1:= to-base:= array-base
rs. w1 c0. ; save-to-base
;
so w1 1 ; if to-base is even then
jl. a11. ; goto alarm(oddfield, 1)
;
ba w3 x2+6 ; w3:= dope:= base-word-addr + dope-rel
;
al w1 1 ;
sh w0 (x3-2) ; if move_size > upper-index or
sh w1 (x3) ; 1 <= lower-index - k then
jl. a10. ; goto alarm(movefld)
;
rl w3 x2+12 ; w3:= base-word-addr-fromarr
rl w1 x3 ; w1:= from-base:= array-base
;
so w1 1 ; if from-base is even then
jl. a12. ; goto alarm(oddfield, 2)
;
ba w3 x2+10 ; w3:= dope:= base-word-addr + dope-rel
;
al w2 1 ;
sh w0 (x3-2) ; if move_size > upper-index or
sh w2 (x3) ; 1 <= lower-index - k then
jl. a10. ; goto alarm(movefld)
\f
; fgs 1987.06.24 rc8000 code procedure, tofrom page 4
;
; prepare move
;
rl. w2 c0. ; w2:= save-to-base
rs. w0 c0. ; remaining:= move_size
;
;
gg w3 34 ;
sh w3 59 ; if cpu reg < 60 then
jl. a3. ; goto repeatmove, next segment;
am. (c0.) ;
sh w2 x1-1 ; if from_base +move_size <= to_base
sh w2 x1 ; or from_base >= to_base then
jl. a1. ; goto setup mh_instruction else
jl. a3. ; goto repeatmove, next segment;
;
a1: ; setup mh_instruction:
al w1 x1+1 ; fromfirst := frombase + 1;
al w2 x2+1 ; to__first := to__base + 1;
rx w2 2 ; swop (wpreg, wreg);
ds. w2 c4. ; save (wpreg, wreg);
mh w2 (0) ; move halfs (wpreg, wreg, 0);
al w3 (:-1:)<1 ;
la w0 6 ; halfs moved := move_size extract (:-1:)<1; <*even*>
dl. w2 c4. ; restore (wpreg, wreg);
wa w1 0 ; wpreg := wpreg + halfs_moved;
wa w2 0 ; w_reg := w_reg + halfs_moved;
rx w2 2 ; swop (wpreg, wreg);
ws. w0 c0. ; remaining := halfs_moved - move_size;
sn w0 0 ; if remaining <> 0 then
jl. a2. ; <*1 half remaining*>
zl w0 x1 ; move 1 half;
hs w0 x2 ;
a2: jl. (j8.) ; goto end register expr.;
a3: rl. w3 (j1.) ; goto repeat move on next segment;
jl x3+l0 ;
\f
; fgs 1987.06.24 rc8000 code procedure, tofrom page 5
;
;
;
a9: ; alarm(movesize):
rl w1 0 ; alarm-cause:= move_size
al. w0 c1. ; w0:= addr of alarm-text
jl. w3 (j21.) ; goto rs-general-alarm
;
;
a10: ; alarm(movefld):
;
; w0 = move_size, x3 = dope-address.
; determine whether upper or lower bound was exceeded.
;
sh w0 (x3-2) ; if move_size <= upper-index then
al w0 1 ; move-field:= 1 else move_size
rl w1 0 ; alarm-cause:= move-field
al. w0 c2. ; w0:= addr of alarm-text
jl. w3 (j21.) ; goto rs-general-alarm
;
;
a11: am 1-2 ; alarm(oddfield, 1):
a12: al w1 2 ; alarm(oddfield, 2):
al. w0 c3. ; w0:= addr of alarm-text
jl. w3 (j21.) ; goto rs-general-alarm
;
;
c0: 0 ; remaining, saved to_base
c1: <:<10>movesize:> ; alarm-text
c2: <:<10>movefld :> ; alarm-text
c3: <:<10>oddfield:> ; alarm-text
0 ; saved wpreg
c4: 0 ; saved w_reg
i.
e. ; end block tofrom segment 1
\f
; fgs 1987.06.24 rc8000 code procedure, tofrom page 6
g3=k-j0
c. g3-506
m. code on segment 1 too long
z.
c. 502-g3
0, r. 252-g3>1
z.
;
<:tofrom1:>, 0 ; alarm address
i.
e. ; end block segment 1
m. tofrom segment 1
\f
; fgs 1987.06.24 rc8000 code procedure, tofrom page 7
b. g5, j50 ; begin block segment 2
h.
j0: g1, g2 ; head-word: last-point, last-absword
j8: f1 + 8, 0 ; rs-end-register-expression
j30: f1 + 30, 0 ; rs-saved-stackref, saved-w3
g2=k-2-j0 ; rel of last absword
g1=k-2-j0 ; rel of last point
w.
b. a20, c10, i5 ; begin block tofrom segment 2
w.
;
;
; prepare move
;
;
l0 = k - j0 ; rel entry repeatmove:
ds. w3 (j30.) ; save sref, w3;
rs. w0 c0. ; remaining := move_size;
a0: ; repeatmove:
;
; registers
; w0 remaining (bytes to move)
; w1 from-base
; w2 to-base
; w3 undefined
;
al w3 i0 ; w3:= portion:= - maxbytes in one round
sl w0 i1 ; if remaining >= maxbytes then
jl. a1. ; goto move
\f
; fgs 1987.06.24 rc4000 code procedure, tofrom page 8
;
;
; less than the portion, which can be moved by the movelist below,
; is left.
;
al w3 (:-1:)<2 ; portion:= - (remaining
la w3 0 ; - remaining extract 2);
ac w3 x3 ;
;
;
a1: ; move:
wa w0 6 ; remaining:= remaining + portion
rs. w0 c0. ; obs. obs. portion is negative
;
ws w1 6 ; last-from:= from-base - portion
ws w2 6 ; last-to:= to-base - portion
;
jl. x3+a3. ; goto movelist(portion + toplist)
;
a2: ; startmovelist:
;
; registers in movelist
; w0 work
; w1 last-from
; w2 last-to
; w3 work
;
; definition of slang-names used for list-administration.
;
i1= 424 ; maxbytes moved in one round
i0= -i1 ; maxportion:= - maxbytes
;
i2= -i1-k+4 ; constant for load address
i3= i2-2 ; constant for store address
;
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
;
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
;
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
\f
; fgs 1987.06.24 rc4000 code procedure, tofrom page 9
;
;
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
;
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
;
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
;
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
;
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
;
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
;
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
\f
; fgs 1987.06.24 rc8000 code procedure, tofrom page 10
;
;
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
dl w0 x1+k+i2 , ds w0 x2+k+i3 , dl w0 x1+k+i2 , ds w0 x2+k+i3
;
;
; test that the list really can move i1 bytes
;
a3: ; toplist:
;
g4= i1 - (:a3-a2:) ; g4 should be zero
c. g4-1 ; if g4 > 0 then
m. movelist too short ;
z. ;
c. -g4-1 ; if g4 < 0 then
m. movelist too long ;
z.
;
;
rl. w0 c0. ; w0:= remaining
sl w0 4 ; if remaining >= 4 then
jl. a0. ; goto repeatmove
\f
; fgs 1987.06.24 rc4000 code procedure, tofrom page 11
;
;
; now w0 may be either 0, 1, 2, or 3, indicating the number of
; bytes which have still not been moved.
; a case construction is used to speed up the treatment.
;
ls w0 3 ; case remaining of
am (w0) ;
jl. a4. ;
a4: ; begin comment 8 bytes per case
;
jl. (j8.) ; 0, goto rs-end-register-expression
c0: 0 ; saved to_base, remaining
0 ; saved wpreg
c4: 0 ; saved w_reg
;
bz w0 x1+1 ; 1, one byte left
hs w0 x2+1 ;
jl. (j8.) ;
0 ;
;
rl w0 x1+2 ; 2, one word left
rs w0 x2+2 ;
jl. (j8.) ;
0 ;
;
rl w0 x1+2 ; 3, one word and one byte left
rs w0 x2+2 ;
bz w0 x1+3 ;
hs w0 x2+3 ;
jl. (j8.) ; end case remaining
i.
e. ; end block tofrom segment 2
\f
; fgs 1987.06.24 rc4000 code procedure, tofrom page 12
;
;
g3=k-j0
c. g3-506
m. code on segment 2 too long
z.
c. 502-g3
0, r. 252-g3>1
z.
;
<:tofrom2:>, 0 ; alarm address
i.
e. ; end block segment 2
m. tofrom segment 2
i.
e. ; end global slang segment
;
; tail to be inserted in catalog by means of insertproc
;
g0: g1: ; first-tail: last-tail:
2 ; no. of segments:= 2
0, r.4 ; <:tofrom:>
1<23+e0<12+e1 ; code, entry segment, rel entry
1<18+19<12+41<6+41 ; no_type_proc(undef, undef, intaddr)
0 ;
4<12+f2 ; content, rel start external list
2<12+0 ; code segments, bytes in permant core
;
m. rc 1987.06.25 tofrom
d.
p.<:insertproc:>
▶EOF◀