|
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: 22272 (0x5700)
Types: TextFile
Names: »outvar3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »outvar3tx «
; fgs 1987.07.09 algol 6 record procedures for variable length page 1
;
; 2 segments
; first segment contains changevar, outvar and checkvar
; second segment contains invar
b. g1, i6 ; g0, g1 are used by insertproc
; as address of first and last tail.
; i-names (may be changed to anything
; but g0, g1 and h-names)
; are used to define entries
; and externals for tail part
s. d2, j35, a22, b4, c3 ; segment start
w. k=10000, h. ; d-names are used to define numbers
; of abs words and points
; j-names are used to define rs entry numbers
; a-names are used to define addresses on this segment
; b-names are used to define constants
; c-names are used to define working locations
i0: d2 , d1 ; rel of last point, rel of last abs word
; for mnemotecnic reasons j-names
; corresponds to rs entry numbers
j3: 3 , 0 ; rs entry reserve
j4: 4 , 0 ; rs entry take expression
j5: 5 , 0 ; rs entry goto point
j7: 7 , 0 ; rs entry end uv expression
j12: 12 , 0 ; rs variable uv
j13: 13 , 0 ; rs variable last used
j18: 18 , 0 ; rs entry zone alarm
j21: 21 , 0 ; rs entry general alarm
j29: 29 , 0 ; rs entry param alarm
j30: 30 , 0 ; rs variable saved stack ref, saved w3
d1=k-2-i0 ; abs word
j35: 35 , 0 ; rs variable outblock
d2=k-2-i0 ; abs words and points
w.
i1: 0 ; number of externals
0 ; number of owns
s3 ; date
s4 ; time
;
;after evaluation of the parameters, the stack is utilized as follows:
; x2+ 6: block change<12+call type
; x2+ 8: zone address (unchanged)
; x2+10: record length as in a.firstword
; x2+12: address of a(0)
\f
; fgs 1982.10.05 algol6 record procedures for variable length page 2
i2: am 1 ; entry changevar: calltype:=2
i3: al w1 1 ; entry outvar: calltype:=1
rl. w2 (j13.) ; w2:=lastused
ds. w3 (j30.) ; saved lastused:=last used
rl w3 x2+8 ;
rl w0 x3+h3+4 ; if oldlength=0
wa w0 2 ; and calltype=2
sn w0 2 ; then
al w1 1 ; calltype:=1;
sn w3 (x2+12) ; if first param=second param then
al w1 x1+2 ; calltype:=calltype+2
bl w0 x3+h1+1 ;
rs w1 x2+6 ; save block change, call type;
se w0 4 ; if (kind = area process
sn w0 6 ; or kind = disc process) and
se w1 4 ; call type = 4 then
jl. a1. ; begin
rl w0 x3+h3+2 ; rem:=lastbyte
ws w0 x3+h3 ; -recbase
am (x3+h3) ; -z.firstword
ws w0 2 ;
sl w0 0 ; if rem<0 then
jl. a1. ; begin
ac w1 (x3+h3+4) ;
jl. w3 (j3.) ; reserve reclength for stack
rl w3 x2+8 ;
al w1 x1-1 ;
rs w1 x2+12 ; recbase:=workplacebase:=newstacktop-1
rs. w1 c2. ; c2:=workplacebase
al w2 x1 ; w2:=workplacelast
wa w2 x3+h3+4 ;
rl w1 x3+h3 ;
wa w1 x3+h3+4 ; w3:=recordlast
al w3 x1 ;
a0: rl w1 x3 ;
rs w1 x2 ; workplace:=record
al w2 x2-2 ;
al w3 x3-2 ;
sl. w2 (c2.) ;
jl. a0. ;
dl. w3 (j30.) ; reset stackpointer
; end
rl w3 x2+8 ;
al w0 0 ;
rs w0 x3+h3+4 ; z.reclength:=0;
rl w3 x2+12 ; w3:=recbase;
jl. a22. ; goto compute reclength;
a1: al w0 0 ;
so w1 1 ; if calltype=2 or calltype=4 then
rs w0 x3+h3+4 ; z.reclength:=0;
\f
; fgs 1987.07.09 algol 6 record procedures for variable length page 3
al w1 2.11111 ; kind :=
la w1 x2+10 ; kind of sec. param;
sh w1 23 ; if kind > 23 <*zone *>
sh w1 18 ; or kind <= 18 <*integer array*> then
jl. w3 (j29.) ; goto param alarm;
sn w1 23 ; if kind = 23 <*zone record*> then
jl. a2. ; skip index check;
al w3 (x2+12) ; w3=array descr
ba w3 x2+10 ; w3=dope addr
al w1 1 ; index=1
sh w1 (x3) ; if lower limit>=1 then
jl. w3 (j18.) ; indexalarm(1);
a2: rl w3 (x2+12) ;
rs w3 x2+12 ; save recbase;
a22: rl w1 x3+2 ; compute reclength: w1:=a.firstword
sl w1 4 ; if w1<4
jl. a3. ;
se w1 0 ; and w1<>0 then
jl. w3 a17. ; goto reclength alarm
a3: sz w1 1 ; if reclength is odd then
al w1 x1+1 ; reclength:=reclength+1
rs w1 x2+10 ;
rl w3 x2+8 ; w3:=zone addr.
al w1 6 ; zonestate:=6
rx w1 x3+h2+6 ; w1:=oldzonestate
se w1 (x3+h2+6) ; if zonestate<>oldzonestate then
jl. a7. ; goto just after open
al w0 0 ;
hs w0 x2+6 ; blockchange:=false
rl w0 x3+h3+4 ;
wa w0 x3+h3+0 ;
rs w0 x3+h3+0 ; recordbase:=recordbase+recordlength
ws w0 x3+h3+2 ; w0:=recordbase-lastbyte
sl w0 0 ; if w0>=0 then
jl. a6. ; goto change block
a4: rl w1 x3+h3+2 ; get record:
ws w1 x3+h3+0 ; w1:=lastbyte-recordbase
sn w1 0 ; if w1=0 then
jl. a6. ; goto change block
ws w1 x2+10 ; w1:=w1-length
sh w1 -1 ; if w1<0 then
jl. a5. ; goto test blockchange
rl w0 x2+10 ; recordlenght:=reclength
rs w0 x3+h3+4 ;
rs. w1 (j12.) ; result:=w1
jl. a12. ; goto continue
a5: bl w0 x2+6 ; test blockchange: w0:=blockchange
se w0 0 ; if blockchange then
jl. a16. ; goto block alarm
a6: al w0 -1 ; change block: blockchange:=true
hs w0 x2+6 ;
jl. a8. ; goto outblock
a7: ; just after open:
se w1 0 ; if oldstate<>after open then
jl. a18. ; goto zonestate alarm
al w1 -1 ;
hs w0 x2+6 ; blockchange:=true;
jl. a4. ; goto get record
\f
; fgs 1982.10.05 algol 6 record procedures for variable length page 4
a8: bz w0 x3+h1+1 ; outblock:
sl w0 4 ;
sl w0 8 ;
jl. a11. ; if kind=bs then
al w0 0 ; begin
rl w1 x3+h3+0 ; zerofill block tail
al w1 x1+1 ;
jl. a10. ;
a9: rs w0 x1 ;
al w1 x1+2 ;
a10: sh w1 (x3+h3+2) ;
jl. a9. ; end;
a11: rl w1 x3+h0+4 ; w1:=used share
bz w0 x3+h1+1 ; last addr of transfer(used share):=
se w0 4 ; (if kind = area process
sn w0 6 ; or kind = disc process then lastbyte else
am 2 ; recordbase) - 1
rl w0 x3+h3+0 ;
bs. w0 1 ;
rs w0 x1+10 ;
al w0 x3 ; w0:=zone addr<4
ls w0 4 ;
rl. w1 j35. ;
jl. w3 (j4.) ; call rs outblock
ds. w3 (j30.) ; saved last used:=last used
rl w3 x2+8 ; w3:=zone addr
jl. a4. ; goto get record
a12: al w3 (x2+8) ; continue:
al w1 (x3+h2+2) ;
bl w0 x2+7 ;
sz w0 1 ; skipnext if changevar
al w1 x1+1 ; ia(11):=ia(11)+1
rl w0 x2+10 ; w0:=reclength
sn w0 0 ; skipnext if recordlength<>0
al w1 x1-1 ; ia(11):=ia(11)-1
rs w1 x3+h2+2 ;
sn w0 0 ; skipnext if recordlength<>0
jl. w3 (j7.) ; end uv expr
rl w3 (x2+8) ;
rs. w3 c3. ; c3:=addr z(0)
rl w0 x2+12 ;
rl w1 x2+10 ;
ds. w1 c2. ; c1:=addr a(0)
\f
; rc 1973.07.06 algol 6 record procedures for variable length page 5
al. w2 (c2.) ; w2:=reclength
am. (c3.) ;
rs w2 2 ; w2:=z.firstword:=reclength
al w3 x2+3 ; chechsum:=reclength+3
a13: sh w2 6 ;
jl. a14. ; if w2<=6 then goto last
am. (c1.) ; loop:
dl w1 x2 ; w0.w1:=a.w2
am. (c3.) ;
ds w1 x2 ; z.w2:=a.w2
am (0) ;
al w3 x3 ; checksum:=checksum+w0
am (2) ;
al w3 x3 ; checksum:=checksum+w1
al w2 x2-4 ; w2:=w2-4
jl. a13. ;
a14: se w2 6 ; if reclength mod 4<>0 then
jl. a15. ; begin
am. (c1.) ;
rl w1 6 ;
am. (c3.) ;
rs w1 6 ; z.word3:=a.word3
am (2) ;
al w3 x3 ; checksum:=checksum+word3
; end;
a15: lx. w3 b4. ; beware of overflow
al w3 x3+1 ; checksum:=-checksum
am. (c3.) ;
rs w3 4 ; z.secword:=checksum
dl. w3 (j30.) ;
rs. w2 (j13.) ;
jl. w3 (j7.) ; end uv expr
b0: <:<10>block :> ;
b1: <:<10>rec len:> ;
b2: <:<10>z.state:> ;
b3: <:<10>checklen:> ;
b4: -1 ; constant -1
a16: wa w1 x2+10 ; alarm(<:block:>,blocklength)
am b0-b1 ;
a17: am b1-b2 ; alarm(<:rec len:>,reclength)
a18: am b2-b3 ; alarm(<:z.state:>,oldstate)
a19: al. w0 b3. ; alarm(<:checklen:>,reclength)
jl. w3 (j21.) ;
\f
; rc 1976.06.23 algol 6 record procedures for variable length, page ...6...
i4: ; entry checkvar:
rl. w2 (j13.) ; w2:=lastused
ds. w3 (j30.) ; saved last used:=last used
al w3 (x2+8) ;
am (x3+h3) ;
rl w1 2 ; w1:=z.firstword
sl w1 4 ; if reclength<4 or
se w1 (x3+h3+4) ; z.firstword<>reclength then
jl. w3 a19. ; generalalarm(<:checklen:>,z.firstword);
am (x3+h3) ;
rl w0 4 ;
rs. w0 (j12.) ; uv:=old checksum
al w3 (x2+8) ;
al w1 (x3+h3) ;
al w1 x1+4 ;
rs. w1 c1. ; c1:=addr z.secword
al w1 (x3+h3) ;
wa w1 x3+h3+4 ; w1:=addr z.reclength
al w3 (x3+h3+4) ; w3:=reclength
a20: sn. w1 (c1.) ; for w1:=reclength step -2 until 4 do
jl. a21. ; begin
am (x1) ;
al w3 x3 ; w3:=w3+z.w1
al w1 x1-2 ; w1:=w1-2
jl. a20. ; end
a21: lx. w3 b4. ; w3:=-(checksum+3)
al w3 x3-2
rs. w3 (c1.) ; z.secword:=checksum
jl. w3 (j7.) ;
c1: 0 ; move from base
c2: 0 ; reclength
c3: 0 ; addr z(0)
; empty room for 13 instructions
h. r.i0.+505 ; fill rest of segment with zeros
w. <:ch/outvar :> ; alarm text
i.e. ; end of segment
m. rc 1987.07.09 changevar, outvar, checkvar text
\f
; rc 06.07.73 algol 6 record procedure for variable length page 7
; segment 2
; this segment contains invar
s. d2, j34, b4, a13 ; segment start
w. k=10000, h. ; d-names are used to define numbers
; of abs words and points
; j-names are used to define rs entry numbers
; a-names are used to define addresses on this segment
; b-names are used to define constants
i5: d2 , d1 ; rel of last point, rel of last abs word
; for mnemotecnic reasons j-names
; corresponds to rs entry numbers
j3: 3 , 0 ; rs entry reserve
j4: 4 , 0 ; rs entry take expression
j5: 5 , 0 ; rs entry goto point
j7: 7 , 0 ; rs entry end uv expression
j12: 12 , 0 ; rs variable uv
j13: 13 , 0 ; rs variable last used
j21: 21 , 0 ; rs entry general alarm
j30: 30 , 0 ; rs variable saved stack ref, saved w3
d1=k-2-i5 ; abs word
j34: 34 , 0 ; rs variable inblock
d2=k-2-i5 ; abs words and points
b0: 16 , b1 ; appetite blockproc, rel return to invar
w.
b4: -1 ; constant -1
\f
; rc 76.06.23 algol 6 record procedure for variable length, page ...8...
w.
i6: ; entry invar:
rl. w2 (j13.) ; w2:=last used
ds. w3 (j30.) ; saved last used:=last used
b1=k-i5
a0: rl w3 x2+8 ; w3:=zone addr
al w1 5 ; zonestate:=5;
rx w1 x3+h2+6 ; w1:=oldstate
se w1 (x3+h2+6) ; if oldstate<>newstate then
jl. a5. ; goto just after open
rl w0 x3+h3+0 ;
wa w0 x3+h3+4 ;
rs w0 x3+h3+0 ; recordbase:=recordbase+recordlength
a1: rl w1 x3+h3+2 ; get record:
ws w1 x3+h3+0 ; w1:=lastbyte-recordbase
sl w1 1 ; if w1>0 then
jl. a8. ; goto continue
a2: al w0 x3 ; inblock:
ls w0 4 ; w0:=zone addr<4
rl. w1 j34. ;
jl. w3 (j4.) ; call rs inblock
ds. w3 (j30.) ; saved last used:=last used
rl w3 x2+8 ; w3:=zone addr
jl. a1. ; goto get record
a5: ; just after open:
se w1 0 ; if oldzonestate<>after open then
jl. a6. ; goto zonestate alarm
jl. a2. ; goto inblock
b2: <:<10>z.state:> ;
a6: al. w0 b2. ; alarm(<:z.state:>,oldstate)
jl. w3 (j21.) ;
a8: ; continue:
rs w1 x3+h3+4 ; reclength:=remaining
am (x3+h3) ;
rl w0 2 ; w0:=z.firstword
sn w0 0 ; if z.firstword=0
jl. a0. ; goto repeat
\f
; rc 1974.08.23 algol 6 procedure for variable length page 9
a9: rl w1 x3+h3+4 ; w1:=remaining;
ba. w0 1 ; if w0 is odd
ls w0 -1 ; then
ls w0 1 ; w0:=w0+1;
sl w0 4 ; if w0<4
sl w0 x1 ; or w0>remaining
al w0 x1 ; then b:=w0:=remaining;
rs w0 x3+h3+4 ; reclength:=b;
ws w1 x3+h3+4 ; remaining:=remaining-b;
rs. w1 (j12.) ; uv:=remaining;
am (x3+h3) ;
rl w1 2 ; if z.firstword
se w0 x1 ; <>b then
jl. a12. ; goto call blockproc
rl w1 x3+h2+2 ;
sl w1 0 ; if -,checksum then
jl. a13. ; goto finis
am (x3+h3) ;
rl w0 4 ;
rs w0 x2+6 ; stack(6):=old checksum
al w3 (x2+8) ;
al w1 (x3+h3) ;
al w1 x1+4 ;
rs. w1 b3. ; b3:=addr z.secword
al w1 (x3+h3) ;
wa w1 x3+h3+4 ; w1:=addr z.reclength
al w3 (x3+h3+4) ; w3:=reclength
a10: sn. w1 (b3.) ; for w1:=reclength step -2 until 4 do
jl. a11. ; begin
am (x1) ;
al w3 x3 ; w3:=w3+z.w1
al w1 x1-2 ; w1:=w1-2
jl. a10. ; end
a11: lx. w3 b4. ; beware of overflow
al w0 x3-2 ; w0:=-(checksum+3)
sn w0 (x2+6) ;
jl. a13. ; if checksum ok then goto finis
a12: al w1 -22 ; call blockproc:
jl. w3 (j3.) ; reserve 22 bytes for stack
rs w2 x1 ; newstack0:=w2 of call
al. w3 (i5.) ; w3:=seg table addr this segment
al. w0 (b0.) ; w0:=appetite, rel return
ds w0 x1+4 ; store return information
dl w0 x2+8 ;
ds w0 x1+8 ; move formals of z
al w3 26 ; kind of s and b = integer
al w0 x1+18 ; addr of s
ds w0 x1+12 ; store formals of s
rs w3 x1+14 ; store 1. formal of b
rl w3 x2+8 ; w3:=zone descriptor
al w0 x1+20 ;
rs w0 x1+16 ; 2. formal b
rl w0 x3+h3+4 ;
rs w0 x1+20 ; b:=reclength;
al w0 1 ;
ls w0 11 ;
rs w0 x1+18 ; s=1<11
dl w1 x3+h4+2 ; w0.w1:=description blockproc
ls w0 4 ; w0:=stackref<4
jl. w3 (j5.) ; goto point
jl. a0. ; end call of blockproc
\f
; rc 09.05.72 algol 6 record procedure for variable length page 10
a13: rl w3 x2+8 ; finis:
al w1 (x3+h2+2) ;
al w1 x1+1 ;
rs w1 x3+h2+2 ; ia(11):=ia(11)+1
jl. w3 (j7.) ; end uv expression
b3: 0 ; working loc
; empty room for 141 instructions
h. r.i5.+505 ; fill rest of segment with zeros
w. <:invar <0><0><0>:> ; alarm text
i.e. ; end of segment
m. rc 1976.06.23 invar text
\f
; tails
h.
g0: ; first tail
0 , 2 ; area entry with 2 segments
0 , r.8 ; fill
2048 , i2-i0 ; entry point changevar
w. 3<18+41<12+8<6 ; integer type proc, sec. param undefined,
0 ; first param zone
h. 4 , i1-i0 ; code proc, start external list
2 , 0 ; 2 segments, no bytes in permanent store
2048 , 4 ; modekind=backing store
0 , r.8 ; fill
2048 , i3-i0 ; entry point outvar
w. 3<18+41<12+8<6 ; integer type proc, sec param undefined
0 ; first param zone
h. 4 , i1-i0 ; code proc, start external list
2 , 0 ; 2 segments, no bytes in permanent store
2048, 4 ; modekind = backing store
0 , r.8 ; fill
1<11+1 , i6-i5 ; entry point invar on segment 2
w. 3<18+8<12 ; integer type proc, param zone
0 ;
h. 4 , i1-i0 ; code proc, start external list
2 , 0 ; 2 segments, no bytes in permanent store
g1: ; last tail
2048 , 4 ; modekind=backing store
0 , r.8 ; fill
2048 , i4-i0 ; entry point checkvar
w. 3<18+8<12 ; integer type proc, param zone
0 ;
h. 4 , i1-i0 ; code proc, start external list
2 , 0 ; 2 segments, no bytes in permanent store
m. rc 1987.07.09 varprocs
i. ; id list
\f
▶EOF◀