|
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: 52224 (0xcc00)
Types: TextFile
Names: »retalglibv4 «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »retalglibv4 «
job fgs 1 274001 stat 2 temp disc 300 60 time 15 0
mode list.yes
;
; editering af algol library
;
; magtapes :
;
; 543297 : release 13.00
; 543329 : release 14.00
; 543057 : release 1.00
; 543277 : release 2.00
; 543279 : release 3.00
;
;
; magtape :
;
; 543022 : release 2.00
;
; slettes og indeholder kopi af
;
; 543279 : release 3.00
message ret algol library
head
n=set nrz mt543279
g=set mto mt543277
lookup n g
opmess write enable mt543279
opmess no ring mt543277
\f
message ident, date and file survey file 1
nextfile n g
date=head
date=edit date
r/f/date and time of tape creation : fgs/
f
id=copy ø.1
package number : sw8500/2
package name : algol
release : 3.0, 1987.10.01
content : algol library source code files
file : contents
0 : label
1 : date of tape creation and table of tape-file contents
2 : compilation of algol library - system 2 version
3 : compilation of algol library - system 3 version
4 : read readchar repeatchar intable readstring readall tableindex
5 : arctan arg cos sin atan
6 : arcsin sqrt
7 : ln exp sinh sign sgn random alog
8 : write writeint outchar outtext,
outinteger replacechar outindex outtable isotable
9 : tofrom
10 : changerec inrec outrec swoprec
11 : changerec6 inrec6 outrec6 swoprec6
12 : open termzone stopzone close,
setposition getposition setstate getstate
13 : monitor
14 : systime logand logor exor
15 : system increase check blockproc stderror
16 : getzone getshare setzone setshare
17 : getzone6 getshare6 setzone6 setshare6
18 : changevar outvar invar checkvar
19 : newsort deadsort lifesort outsort initsort,
initkey sortcomp startsort6 changekey6
20 : outdate movestring
21 : initzones getalarm trap
22 : openvirtual virtual resume
23 : lock locked
24 : setfpmode fpmode
25 : activity newactivity passivate activate wactivity
26 : closetrans writefield opentrans transerror waittrans
readfield getf8000tab f8000table
27 : fpproc
28 : buflengthio
29 : openinout closeinout resetzones expellinout
30 : changerecio inoutrec
31 : updextlists
ø
n=copy list.yes message.no date id
\f
message translate algol library sys2 file 2
nextfile n g
n=edit g
f
\f
message translate algol library sys3 file 3
nextfile n g
n=copy list.yes message.no ø.1
; compilation of algol library procedures
; the file descriptor :
;
; libsource = set <modekind> <name of this tape>
;
; must be present
c=message compile algol library system 3 version
c=message the catalog entry libsource is used
lookup libsource
if ok.no
(message the entry libsource not present
finis)
sorry=algol
begin
trapmode := 1 shift 10;
endaction := 1;
write (out,
"nl", 1, <:********************************************:>,
"nl", 1, <:*:>,
"nl", 1, <:*:>,
"nl", 1, <:*:>, "sp", 10, <:sorry:>,
"nl", 1, <:*:>,
"nl", 1, <:*:>,
"nl", 1, <:********************************************:>);
end;
in =set 0 0 0 896.26 0 4.0 0
out =set 0 0 0 896.27 0 4.0 0
overflows =set 0 0 0 576.37 0 4.0 0
underflows=set 0 0 0 576.22 0 4.0 0
blocksread=set 0 0 0 576.24 0 4.0 0
rc8000 =set 0 0 0 512.57 0 4.0 0
errorbits =set 0 0 0 576.58 0 4.0 0
progsize =set 0 0 0 576.62 0 4.0 0
alarmcause=set 0 0 0 704.69 0 4.0 0
trapmode =set 0 0 0 576.70 0 4.0 0
progmode =set 0 0 0 576.71 0 4.0 0
blocksout =set 0 0 0 576.72 0 4.0 0
endaction =set 0 0 0 576.93 0 4.0 0
(read=slang libsource.4
read readchar repeatchar intable readstring readall tableindex)
if ok.no
sorry
(arctan=slang fpnames libsource.5 insertproc
arctan arg cos sin atan)
if ok.no
sorry
(arcsin=slang fpnames libsource.6 insertproc
arcsin sqrt )
if ok.no
sorry
(ln=slang fpnames libsource.7 insertproc
ln exp sinh sign sgn random alog)
if ok.no
sorry
(write=slang libsource.8
write writeint outchar outtext,
outinteger replacechar outindex outtable isotable)
if ok.no
sorry
(tofrom=slang libsource.9
tofrom)
if ok.no
sorry
(changerec=slang fpnames libsource.10 insertproc
changerec inrec outrec swoprec)
if ok.no
sorry
(changerec6=slang fpnames libsource.11 insertproc
changerec6 inrec6 outrec6 swoprec6)
if ok.no
sorry
(open=slang fpnames libsource.12 insertproc
open termzone stopzone close,
setposition getposition setstate getstate)
if ok.no
sorry
(monitor=slang fpnames libsource.13 insertproc
monitor)
if ok.no
sorry
(systime=slang fpnames libsource.14 insertproc
systime logand logor exor)
if ok.no
sorry
(system=slang fpnames libsource.15 insertproc
system increase check blockproc stderror)
if ok.no
sorry
(getzone=slang fpnames libsource.16 insertproc
getzone getshare setzone setshare)
if ok.no
sorry
(getzone6=slang fpnames libsource.17 insertproc
getzone6 getshare6 setzone6 setshare6)
if ok.no
sorry
(changevar=slang fpnames libsource.18 insertproc
changevar outvar invar checkvar)
if ok.no
sorry
(newsort=slang fpnames libsource.19 insertproc
newsort deadsort lifesort outsort initsort,
initkey sortcomp startsort6 changekey6)
if ok.no
sorry
(outdate=slang fpnames libsource.20 insertproc
outdate movestring)
if ok.no
sorry
(initzones=slang libsource.21
initzones getalarm trap)
if ok.no
sorry
(openvirtual=slang libsource.22
openvirtual virtual resume)
if ok.no
sorry
(lock=slang libsource.23
lock locked)
if ok.no
sorry
(setfpmode=slang libsource.24
setfpmode fpmode)
if ok.no
sorry
(activity=slang libsource.25
activity newactivity passivate activate wactivity)
if ok.no
sorry
(closetrans=slang libsource.26
closetrans writefield opentrans transerror waittrans,
readfield getf8000tab f8000table)
if ok.no
sorry
(fpproc=slang libsource.27
fpproc)
if ok.no
sorry
(buflengthio=slang libsource.28
buflengthio)
if ok.no
sorry
(openinout=slang libsource.29
openinout closeinout resetzones expellinout)
if ok.no
sorry
(changerecio=slang libsource.30
changerecio inoutrec )
if ok.no
sorry
updextlists=algol libsource.31 connect.no survey.yes ix.no
if ok.no
sorry
alglibnames=edit
i/
activate activity alarmcause alog arcsin,
arctan arg atan blocksout blockproc blocksread buflengthio,
changekey6 changerec changerecio changerec6 changevar check,
checkvar close closeinout closetrans cos deadsort endaction errorbits ,
exor exp expellinout fpmode fpproc f8000table getalarm getf8000tab getposition,
getshare getshare6 getstate getzone getzone6 in increase,
initkey initsort initzones inoutrec inrec inrec6 intable invar isotable ,
lifesort lock locked ln logand logor monitor movestring ,
newactivity newsort open openinout opentrans openvirtual out outdate,
outchar outindex outinteger outrec outrec6 outsort outtable outtext,
outvar overflows passivate progmode progsize random rc8000 read readall,
readchar readfield readstring repeatchar replacechar resetzones resume,
setfpmode setposition setshare setshare6 setstate setzone setzone6 sgn sign ,
sin sinh sortcomp sqrt startsort6 stderror stopzone swoprec swoprec6 ,
system systime tableindex termzone tofrom transerror trap trapmode ,
underflows wactivity waittrans virtual write writeint writefield
/,f
scopealglib=edit alglibnames
i/
scope user algollib,
/, l b, i/
scope user updextlists
/,f
lookalglib=edit alglibnames
i/
lookup algollib,
/, l b, i/
lookup updextlists
/,f
binalglib=edit alglibnames
i/
sys4=binout algollib,
/, l b, i/
sys5=binout updextlists
/,f
text=edit alglibnames
i/
external procedure algollib;
write(out,<:
/,
l b,i/
:>);
end
/,f
clearalglib=edit alglibnames
i/
clear user algollib,
/, l b, i/
clear user updextlists
/, f
algollib=algol text
clear temp text
algollib=compresslib read arctan arcsin ln write,
tofrom changerec changerec6 open monitor,
systime system getzone getzone6 changevar,
newsort outdate initzones openvirtual lock,
setfpmode activity closetrans fpproc,
buflengthio openinout changerecio
i scopealglib
i lookalglib
release alglib
char ff
ø
\f
message read readchar repeatchar intable,
readstring readall tableindex file 4
nextfile n g
n=edit readtext; g
l./page ..0/, r/..0/...0/, r/82.12.17/87.08.21/
l./page 40/, r/40/42/
l./page ...9/, r/82.12.17/87.07.17/
l./e12:/, l./sh w0 20/, g/20/22/, r/long/complex/
l./page ...22/, r/rc 80.08.23/fgs 87.09.10/
l./j15:/, d1, i/
j15: 1<11 o. (:-1:),0 ; addr of segment 1
j17: 1<11 o. 2 ,0 ; - - - 4
/, p-2
l./page ...24/, r/rc 80.08.23/fgs 87.09.10/
l./e5:/, r/segm 3;/segm 4;/
l./page ...33/, r/82.12.15/87.08.21/
l./j16:/, r/j16/j17/, r/-1/+1/, r/segm 2/segm 4/
l./page ...34/, r/82.12.15/87.08.21/
l./a1:/, r/a1:/ /
l./page ...35/, r/82.11.23/87.08.21/
l./a2:/, l./rl w3 x2+i0/, d./jl. w3 (j18.)/, i/
rl w3 x2+i0 ; upper limit :=
se w0 23 ; if type = 23 <*zone*>
sn w3 d2 ; or readstring then
am 2 ; 23 <*zone variable*> else
al w3 22 ; 21 <*long array *> ;
sl w0 18 ; if type < 18 <*integer array*>
sl w0 x3 ; or type > upper limit then
jl. w3 (j18.) ; goto param alarm;
/, p-8
l./page ...36/, r/82.11.23/87.08.21/
l./al w3 2/, l1, i/
se w0 21 ; if type = 21 <*double real*>
sn w0 22 ; or type = 22 <*complex *> then
al w3 8 ; incr := 8;
/, p1
l./page ...37/, r/82.12.02/87.08.20/
l./d2=/, l1, d2, i/
al w1 x1+2 ; readstring:
ws w1 x2+i19 ; first address := current addr :=
rs w1 x2+b2 ; w1 + 2 - incr;
ds w1 x2+b1 ; last address := w0;
/, p-4
l./page ...38/, r/82.12.02/87.08.21/
l./a0:/, i/
/, p1
l./page ...39/, r/rc 4.11.70 /jz.fgs 1987.08.20/
l./a3:/, l./sz w1 2.11/, d1, i/
rl w3 x2+i19 ;
se w3 2 ; if incr <> 2 and
sz w1 2.11 ; dist mod 4 = 0 then
jl. a4. ; begin
/, p-4
l./a4:/, d1, i$
a4: rs w0 6 ; saved w0 := w0;
al w0 0 ;
wd w1 x2+i19 ; no of elem := dist // incr;
rl w0 6 ; w0 := saved w0;
e10: al w1 x1+1 ; exit: no of elem := no of elem + 1;
$, p-4
l./; end readstring;/, l1, i/
d3=k-d2-d1 ; entry readall:
rl. w3 (j17.) ; goto readall
jl x3+e21 ; on segment 4;
/, p-3
l./page ...40/, i/
\f
; jz.fgs 1987.08.21 algol 5, char input, segment 3 page ...40...
j20:
c.j20-506
m.code on segment 3 too long
z.
c.502-j20,0,r.252-j20>1 z.; fill rest of segment 3 with zeroes
<:char input<0>:> ; alarm text segment 3
m.segment 3
i.
e. ; end segment 3
\f
; jz.fgs 1987.08.21 algol 8, char input, segment 4 page ...41...
; readall, readstring
b. j20 ; block for segment 4
k=0
h.
g8: g9 , g9 ; rel of last point, rel of last abs word
j5: g10+17 , 0 ; - - 17 index alarm
j15: 1<11 o. (:-3:), 0 ; addr of segm 1
j16: 1<11 o. (:-2:), 0 ; addr of segm 2
j17: 1<11 o. (:-1:), 0 ; addr of segm 3
g9 = k - 2 - g8 ; rel of last abs word = rel of last point
w.
/
l./page ...40/, r/...40/...42/, r/82.11.12/87.08.21/, r/ent 3/ent 4/
l./d3=/, r/d3=k-d2-d1/e21: /
l./page ...41/, r/82.11.23/87.08.21/, r/ent 3/ent 4/, r/...41/...43/
l./page ...42/, r/82.12.02/87.08.21/, r/ent 3/ent 4/, r/...42/...44/
l./page ...43/, r/82.11.23/87.08.21/, r/ent 3/ent 4/, r/...43/...45/
l./a11:/, l./se. w0 a16./, i/
rl. w3 (j17.) ;
/, p1
l./jl. e10./,
r/jl. e10./jl x3+e10/
l1, r/jl. e16./jl x3+e16/
l./page ...44/, r/rc 6.5.69/jz.fgs 87.08.21/, r/ent 3/ent 4/, r/...44/...46/
l3, g7/ent 3/ent 4/
l./m.rc/, r/83.01.04/87.09.10/
l./page ...45/, r/83.01.04/87.08.21/, r/...45/...47/
l./g0:/, l2, g/4/5/
l5, r/4/5/
l7, r/4/5/
l7, r/4/5/
l7, r/4/5/
l5, r/ +41 /+41,0/
l1, d
l1, r/4/5/
l./page ...46/, r/82.12.15/87.08.21/, r/...46/...48/
l9, r/4/5/
l8, r/4/5/
f
\f
message arctan arg cos sin atan file 5
nextfile n g
n=edit g
f
\f
message arcsin sqrt file 6
nextfile n g
n=edit g
f
\f
message ln exp sinh sign sgn random alog file 7
nextfile n g
n=edit g
f
\f
message write writeint outchar outtext outinteger replacechar file 8
nextfile n g
n=edit writetext1 ;g
f
\f
message tofrom file 9
nextfile n g
n=edit g
; new mh instruction
;
l./page 1/, r/rc 26.11.71 /fgs 1987.06.24/
l./k=/, i/
d.
p.<:fpnames:>
l.
s. l0 ; begin global slang segment
/
l./s. g5/, r/s./b./, r/slang segment/block segment 1/
l./j4:/, i/
j1: 1<11o.1, 0 ; own segment, next one
/, p1
l./page 2/, r/rc 26.11.71 /fgs 1987.06.24/
l./b. a20/, r/ block tofrom/ block tofrom segment 1/
l./page 3/, r/rc 26.11.71 /fgs 1987.06.24/
l./; prepare move/, l-1, i/
æ12æ
; fgs 1987.06.24 rc8000 code procedure, tofrom page 4
/, p2
l./a0:/, i/
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 ;
/
l1, d./page 6/, d./end case remaining/,
r/rc 26.11.71 /fgs 1987.06.24/, r/4000/8000/, r/page 7/page 5/
l./c1:/, i/
c0: 0 ; remaining, saved to_base
/
l./c3:/, l1, i/
0 ; saved wpreg
c4: 0 ; saved w_reg
/
l./e./, r/end tofrom/end block tofrom segment 1/
l1,
s 1, d./page 3/, d./; prepare move/, d4, i/
æ12æ
; 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
æ12æ
; 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;
/, l1, p-5
l./page 4/, r/rc 26.11.71 /fgs 1987.06.24/, r/page 4/page 8/
l./i1=/, r/288/424/
l./page 5/, r/rc 26.11.71 /fgs 1987.06.24/, r/page 5/page 9/
l./a3:/, l-4, i/
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
/
l./page 6/, r/rc 26.11.71 /fgs 1987.06.24/, r/page 6/page 11/
l./c0:/, l-1, d2, i/
c0: 0 ; saved to_base, remaining
0 ; saved wpreg
c4: 0 ; saved w_reg
/, p-4
l./page 7/, d./c3:/,
l./e. ; end/, r/end to/end block to/, r/from/from segment 2/
l./page 8/, r/rc 26.11.71 /fgs 1987.06.24/, r/page 8/page 12/
l./code on segment/, r/ment 1/ment 2/
l./<:tofrom/, r/from/from2/, r/0, 0/0 /, p2
l./end slang-segment/, r/g-s/g s/, r/ment/ment 2/, r/ slang/ block/
l1, i/
m. tofrom segment 2
i.
e. ; end global slang segment
/
l./g0:/, l1, g/1/2/
l6, r/1/2/
l./m.rc/, r/1971.11.26/1987.06.25/
l1, i/
d.
p.<:insertproc:>
/
f
\f
message changerec inrec outrec swoprec file 10
nextfile n g
n=edit g
f
\f
message changerec6 inrec6 outrec6 swoprec6 file 11
nextfile n g
n=edit g
f
\f
message open termzone stopzone close,
setposition getposition setstate getstate file 12
nextfile n g
n=edit g
l./page ...1.../, r/81.06.02/84.03.05/
l./,i11/, r/i11/i12/
l./,e9/, r/e9/e12/
l./j10:/, d
l./b.a20/, i/
j18=64 ; slang constant, buflength error in zonestate
/
l1, r/d4 /d4/
l./b8:/, d
l./i2=b3+2/, d
l-1, r/;/ ;/
l./page ...2a.../, r/2a/3/
l./page 3/, r/82.10.05/83.12.07/, r/page 3/page ...4.../
l./508/, r/508/510/, r/4/2/
l1, r/4/2/
l./b9=k+1/, l./sn w0 0/, d1, i/
rl w1 x2+8 ; w1 := zone address;
rl w3 x1+h2+6 ; w3 := state add
al w3 x3+j18 ; buflength errror;
sn w0 0 ; if sharelength = 0 then
rs w3 x1+h2+6 ; zone.state := w3;
/
l1, i/
æ12æ
; fgs 1983.12.07 algol 8, open and close page ...5...
/
l./rl w1 x2+8/, d
l./page ...4.../, r/81.06.02/83.12.07/, r/...4/...6/
l./a11:/, r/j10/j12/
l2, i/
rl. w3 b3.+2 ;
/
l./a13:/, r/(j10.) / (j12.)/
l2, i/
rl. w3 b3.+2 ;
/
l./page ...5.../, r/81.06.02/83.12.07/, r/...5/...7/
l./d1:/, d1, i/
d1: al. w0 b6. ; zone state alarm:
rl w1 x1+h2+6 ;
/
l./d3:/, d5
l./page ...6.../, r/81.06.02/84.08.31/, r/...6/...8/
l./j20/, r/j20 /j20, d4/
l./j14:/, r/;/ ;/
l./j9:/, d, i/
j13:101 , 0 ; rs latest answer
/
l./j10:/, r/stop/term/
l./w. 0, 1/, d, i/
w.
/
l./j13:/, d, i/
j15: -1-64 ; mask for removal of buflength error from zonestate
j16: -1-32 ; - - - - inout - -
j17=32 ; slang constant, inout bit in zonestate
/
l./a15/, r/, d1/ /, r/stop/term/
l./c0:/, d, i/
i5: ; external entry term zone:
c0: rl. w1 j10. ; internal entry term zone:
/
l./j19:/, r/j19:/ /, l1, r/d1: /j19:/
l./rl w3 x1+h2+6;w3:=zone state;/, d, i/
rl w3 x1+h2+6 ; state := zone.state except
la. w3 j15. ; buflength error bit;
se w3 j17+9 ; if state = after inoutrec then
jl. a11. ; state := if zone = inputzone
se w1 (x1+h2+2) ; or zone = expelled outzone then
sn w1 (x1+h2+4) ; after inrec
am -1 ; else
al w3 6 ; after outrec;
a11: se w3 j17 ; if state = after openinout
sn w3 j17+8 ; or state = after openinout on magtape then
al w3 x3-j17 ; state := state - inout bit;
/
l./z.state>8 or <0 then/, r/z.//, r/</state</
l./a2:/, l./al. w1 j13./, d, i/
al. w1 (j13.) ; prepares for call of outblock, which
/
l./page 7/, r/82.10.05/84.02.21/, r/7/...10.../
l./a3:/, l2, d1
l./page ...8/, r/81.06.02/84.04.27/, r/...8/...11/
l./a7:/, l1, d, i/
al. w1 (j13.) ;
/
l./a9:/, l./jl. (j3.)/, d, i/
jl. a12. ; goto exit;
zl w0 x1+h1+0 ; w0 := zone.mode;
sz w0 1 ; if w0 odd then
jl. a12. ; goto exit;
/
l./jl. (j3.)/, d, i/
se w2 j17+9 ; if state <> after inoutrec then
jl. a12. ; goto exit;
se w1 (x1+h2+2) ; if zone = input zone
sn w1 (x1+h2+4) ; or zone = expelled zone then
jl. a12. ; goto exit;
/
l./jl. (j3.)/, d, i/
rl w1 x2+8 ; w1 := zone;
a12: al w0 1 ; partial word :=
rs w0 x1+h2+4 ; empty;
jl. (j3.) ; goto end address expression;
/
l./a4:/, d, i/
d4: ;
a4: rl w1 x1+h2+6 ; state alarm: w1 := zone.state;
/
l./m.stop zone/, r/stop zone/term zone/
l./stop zone/, r/stop/term/
l./page ...9.../, r/81.06.02/83.12.07/, r/..9/...12/
l./rl w1 x1+h2+6/, d4, i/
rl w3 x1+h2+6 ; state := zone.state except
la. w3 j15. ; buflength error bit;
sn w3 j17 ; if state = after openinout
jl. d4. ; or state = after openinout on mt
se w3 j17+8 ; or state = after inoutrec then
sn w3 j17+9 ; goto state alarm;
jl. d4. ;
la. w3 j16. ; state := state except inout bit;
sh w3 8 ; if state <= 8 and
sh w3 -1 ; state >= 0 and
jl. a3. ; state <> 4 then
se w3 4 ; goto term zone;
jl. w3 c0. ;
/
l1, r/ /a3: /
l./a0:/, i/
æ12æ
; fgs 1983.12.07 algol 8, open and close page ...13...
/
l./page ...10.../, d
l./e9:/, l-2, d./b1:/, d, i/
æ12æ
; fgs 1983.12.07 algol 8, open and close page ...14...
/
l./<:close/, r/pos<0>/term/
l./page ...11.../, r/81.06.02/84.03.05/, r/...11/...15/
l./j15/, r/j15/j19/
l./j9:/, d, r/0 ;/0;/, r/stop/term/
l./b.a20/, i/
w.
j15: -1-64 ; mask for removal of buflength error from zonestate
j17=32 ; slang constant, inout bit in zonestate
j18=64 ; - - , buflength error - -
æ12æ
; fgs 1984.03.05 algol 8, setposition page ...16...
/
l./stop zone/, r/stop/term/
l./a0:/, r/a0:/ /
l./rs w0 x1+h2+4;partial word:=empty;/, l-1, d1
l./page 12/, r/rc 08.03.72 / fgs 1984.03.05 /, r/page 12/page ...17.../
l1, i/
/
l./a14:/, r/a14:/ /
l./j15/, r/j15/j19/
l./page 12a/, r/12a/...18.../
l./page ...13.../, r/82.05.24/83.12.07/, r/13/19/
l./a1:/, l2, d1, i/
al w2 0 ; state := 0;
rl w0 x3+h2+6 ;
sz w0 j18 ; if zonestate contains buflength error bit then
al w2 x2+j18 ; state := state add buflength error bit;
sz w0 j17 ; if zonestate contains inout bit then
al w2 x2+j17 ; state := state add inout bit;
rs w2 x3+h2+6 ; zone.state := state;
al w0 0 ;
/
l./page 14/, r/83.08.23/84.02.15/, r/14/...20.../
l./a9,/, r/a9, /a10,/
l./rl w1 x3+h2+6/, d, i/
rl w1 x3+h2+6 ; state := zone.state except
la. w1 j15. ; buflength error bit;
se w1 j17+9 ; if state = after inoutrec then
jl. a10. ; state := if zone <> input zone then
se w3 (x3+h2+2) ; after outrec
am 1 ; else
al w1 5 ; after inrec;
a10: se w1 j17 ; if state = after openinout
sn w1 j17+8 ; or state = after openinout on magtape then
al w1 x1-j17 ; state := state - inout bit;
/
l./a2:/, i/
æ12æ
; fgs 1983.12.07 algol 8, get position page ...21...
/
l./a7:/, l./w0:=first shared/, r/last/first/, r/first/last/
l2, r/last/first/, r/fst/last/, r/+2/+ 2/
l./page ...15.../, d
l./page ...14a/, r/14a/22/
l./page ...16.../, r/16/23/
l./page ...17.../, r/17/24/, r/81.06.02/87.08.27/
l./j13:/, d, i/
j4 : 4, 0 ; rs entry 4 : take expression
j5 : 6, 0 ; rs entry 6 : end register expression
j13 : 13, 0 ; rs entry 13 : last used
/
l./j1:/, l1, i/
j2 : 1<11o.(:-2:), 0 ; ref to sec. segment
/
l./c12 =/, g 1/j1/j2/, l1, i/
j17 = 32 ; slang constant, inout bit in zonestate
j18 = 64 ; - , buflength error bit in zonestate
j15 = -1-64 ; - , mask for removal of buflength err bit
æ12æ
; fgs 1987.08.27 algol 8, stop zone page ...25...
b. a2 ; block for local names in stop zone
w.
i12:
e12: rl. w2 (j13.) ; entry stop zone: sref := lastused;
ds. w3 (j30.) ; save sref, w3;
dl w1 x2+12 ; w0w1 := formal (mark);
so w0 16 ; if expression then
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; save sref, w3;
zl w1 x1 ; w1 := value (mark);
ac w1 x1+1 ;
ls w1 23 ; w1.most significant bit = -,mark;
rl w3 x2+8 ; get zone;
zl w0 x3+h1+0 ; zone.mode :=
ls w0 -1 ; zone.mode
ld w1 +1 ; add
hs w0 x3+h1+0 ; -,mark;
rl. w3 (j2.) ; w3 := absword (stop zone);
jl w3 x3+c0 ; goto term zone;
rl w3 x2+8 ; get zone;
zl w0 x3+h1+0 ; zone.mode :=
ls w0 -1 ; zone.mode shift (-1)
ls w0 1 ; shift 1;
hs w0 x3+h1+0 ;
al w0 -1 ;
am (x3+h0+6) ; zone.record base :=
wa w0 +2 ; zone.first share.first shared -
rs w0 x3+h3+0 ; 1;
al w0 0 ; zone.rec length :=
rs w0 x3+h3+4 ; 0;
rl w1 x3+h0+6 ; share := zone.first share;
rl w0 x1+4 ; zone.last byte :=
so w0 1 ; share.last shared +
ea. w0 1 ; if even then
rs w0 x3+h3+2 ; 1 else 0;
a0: rl w0 x1+4 ; repeat
rs w0 x1+10 ; share.operation.last address :=
al w1 x1+h6 ; share.last shared;
sh w1 (x3+h0+8) ; share := share + share descr length;
jl. a0. ; until share > zone.last share;
al w0 0 ; newstate := 0;
zl w1 x3+h1+1 ;
se w1 18 ; if zone.kind = magtape then
jl. a2. ; begin
rl w1 x3+h2+6 ; state := zone.state except
la. w1 j15. ; buflength error bit;
se w1 j17+9 ; if state = after inoutrec then
jl. a1. ; state := if zone = inputzone then
sn w3 (x3+h2+2) ; after inrec
am -1 ; else
al w1 6 ; after outrec;
a1: se w1 j17 ; if state = after openinout
sn w1 j17+8 ; or state = after openinout on magtape then
al w1 x1-j17 ; state := state - inout bit;
sl w1 1 ; if state = 1 <*after read char*>
sl w1 3 ; or state = 2 <*after repeatchar*>
sn w1 5 ; or state = 5 <*after inrec *> then
al w0 8 ; newstate := 8; <*open and not pos on mt*>
a2: rl w1 x3+h2+6 ; end;
rx w1 0 ; swop (w0, w1);
sz w0 j18 ; if zone.state contains buflength err bit then
al w1 x1+j18 ; newstate := newstate add buflength err bit;
sz w0 j17 ; if zone.state contains inout bit then
al w1 x1+j17 ; newstate := newstate add inout bit;
rs w1 x3+h2+6 ; zone.state := newstate;
al w0 0 ; result :=
sz w1 1<3 ; if newstate = unpositioned mt then
am 1 ; false
al w1 -1 ; else
; true;
jl. (j5.) ; goto end reg expression;
m.stop zone
i.
e. ; end block for local names in stop zone
/
l./b. a6/, i/
æ12æ
; fgs 1984.03.05 algol 8, open (docname is array) page ...26...
/
l./page ...17a.../, s 1, d./page ...10.../, d./;end of block for close/
i/
æ12æ
; fgs 1984.03.05 algol 8, open (wait a second) page ...27...
/
l./b.b1/, r/b1/b2/
l./e9:/, i/
b0: 0 ; saved return
b1: <:clock:>, 0, 0, 0 ; name of clock, name table address
0, 1 ; message to clock
b2: 0, r.8 ; answer area
/
l./j13/, r/j13.-4/b2.-4 /
l./(j9.)/, d1
r/j13./b2. /
l./b0:/, d1, i/
/
l./e./, l1, s 1, d./page ...17.../, d./end block for docname is array/,
r/17a/28/, r/81.06.02/84.03.05/
l.!<:open!, r!<:open <0><0><0>:>!<:open/stop<0>:>!
l./page ...18.../, r/81.06.02/84.03.05/, r/18/29/
l./tail close:other tail/, i/
2048 , 4 ; tail termzone:other tail
0 , r.8 ; name
2049 , i5 ; entry
w. 15<18 ; spec1 : illegal type proc
0 ; spec2
h. 4 , 0 ; kind
4 , 0 ; code segments
2048 , 4 ; tail stopzone:other tail
0 , r.8 ; name
2051 , i12 ; entry
w. 2<18+18<12+8<6 ; spec1 boolean proc (zone, boolean addr)
0 ; spec2
h. 4 , 0 ; kind
4 , 0 ; code segments, owns
/
l./m. rc 1983/, d, i/
m.rc 1987.08.27 open termzone stopzone close,
m. setposition getposition setstate getstate
/
f
\f
message monitor file 13
nextfile n g
n=edit g
; parameter array from byte index 1, i.e. fielding works
l./page ...2a/, r/82.08.30/87.07.08/
l./; 124/, r/1 ;/2 ;/, p-1
l./page ...3/, r/rc 22.7.71/ fgs 1987.07.08/
l./a0:/, l./al w1 2.11111/, d./rs w1 x2+20/, i/
al w1 1 ; index := 1;
a14: ls w1 1 ; check index: index := index < 1;
sh w1 (x3-2) ; if index > upper index value
sh w1 (x3) ; or index <= lower index value - k then
jl. w3 (j3.) ; goto index alarm;
se w1 2 ; if index = 2 (1<1) then
jl. a15. ; begin <*find addr of ia (1)*>
wa w1 (x2+20) ; addr (ia (1)) :=
rs w1 x2+20 ; index + baseword;
al w1 2.11111; index := min last index :=
la w1 x2+6 ; fnc byte.min array length;
jl. a14. ; goto check index;
a15: ; end;
/, l1, p-3
l./page ...17/, l./m.jz/, r/84.04.04/87.07.08/
f
\f
message systime logand logor exor file 14
nextfile n g
n=edit g
f
\f
message system increase check blockproc stderror file 15
nextfile n g
n=edit g
; parameter array starts in byte index 1, i.e. fielding works
l./page ...2/, r/86.04.04/87.07.08/
l./c16,/, r/c16/c30/
l./j17:/, d
l./j74:/, i/
j54: g0+54 , 0 ; rs entry 54: field alarm
/, p-1
l./page ...4/, r/82.09.07/87.11.06/
l./; compute first address:/, d./d1:/, i#
am (x2+6) ; maybe check array:
el. w0 f1. ;
so w0 1 ; if check array then
jl. a0. ; begin <*compute first address*>
rl w0 x3 ; w0 := lower index value - k;
al w1 2 ; w1 := field := 2; <*word field index 1*>
sh w1 (x3-2) ; if field > upper index value
sl w0 x1-1 ; or field < lower index value - k then
jl. w3 (j54.) ; goto field alarm;
wa w1 (x2+16) ; formal (14) := addr first word index 1 :=
rs w1 x2+14 ; field + baseword;
rl w1 (x2+16) ; <*compute last address*>
wa w1 x3-2 ; formal (16) := last array :=
rs w1 x2+16 ; base word + upper index;
al w1 5 ;
sn w1 (x2+6) ; if fnc <> 5 then
jl. a0. ; begin
al w1 8 ; w1 := field := 8; <*word field index 7*>
am (x3-2) ;
sl w1 1 ; if field >= upper index value + 1 then
jl. w3 (j54.) ; goto field alarm;
; end;
; end;
a0: am (x2+6) ; call action:
el. w3 f1. ; action := action table (fnc);
d1: jl. x3 ; goto action;
#
l./; exit conditions:/, d./dl w1 x2+12/, i/
; exit conditions :
;
; w0 : return value of i
; w1 : - - - system
; w2 : sref
; w3 : addr of first word of text to be moved to array
; from (x3, x3+2), ... to ((x2+14), (x2+14)+2), ...
;
c21: ds w1 x2+12 ; exit 0: (from system (4, ...) save w0, w1;
rl w1 x2+16 ; array length :=
ws w1 x2+14 ; first array - last array +
al w0 x1+2 ; 2;
zl w1 x2+13 ; halfs to move :=
al w1 x1-2 ; seplength extract 12 - 2; <*multiple of 8*>
sh w0 x1 ; if halfs to move >= array length then
rl w1 0 ; halfs to move := array length;
jl. a4. ; goto continue system (4, ...;
c11: ds w1 x2+12 ; exit 1: (from system (2, ... and (6, ...) save w0, w1;
al w1 8 ; halfs to move := 8;
a4: am (x2+14) ; to__index :=
al w2 2 ; addr first double word of array;
al w3 x3+2 ; fromindex := addr first double word of text;
wa w1 6 ; from__top :=
rs. w1 b1. ; fromindex + halfs to move;
a3: dl w1 x3 ; repeat
ds w1 x2 ; move 4 halfs from fromindex to to__index;
al w2 x2+4 ; increment to__index;
al w3 x3+4 ; increment fromindex;
se. w3 (b1.) ; until
jl. a3. ; fromindexx = from__top;
dl. w3 (j30.) ; restore w2, w3;
dl w1 x2+12 ; restore w0, w1;
/, l1, r/ i :=/ i :=/, p-2
l1, r/exit3/exit 3/
l./page ...5/, r/82.09.02/87.11.06/
l./c3:/, d5, i/
c3: rl. w3 (j42.) ; goto system entry 3
jl x3+i0 ; on next segment;
/, p-2
l./b1:/, r/no/no, from_top in c11, c21, exit 0 and exit 1/
l./page ...6/, r/82.09.02/87.07.08/
l./sn w0 10/, d, i/
se w0 4 ; if length (param) <> 4 then
/, p-1
l./al w3 0/, d, i/
rl. w3 b3. ; w3 :=
sl w0 0 ; sign extension of w0;
al w3 0 ; if type third param = long array then
/, l1, p-3
l./jl. c11./, r/c11./c21./
l./b2:/, l1, i/
b3: -1 ; sign extension of neg values;
/, p-1
l./page ...9/, r/84.01.27/87.11.06/
l./f0 = k - 1/ , l./2 free core/,
r/ 1/ 1<4+1/
l2, r/ 1/ 1<4+1/
l2, r/ 1/ 1<4+1/
l1, r/ 1/ 1<4+1/
l1, r/ 1/ 1<4+1/
l./5 move core area/, r/d1 /d1+1/
l./10 parent/, r/d1 /d1+1/
l./11 intervals/, r/d1 /d1+1/
l./page ...10/, r/85.03.08/87.11.06/
l./;procedure take string/, i#
; entry 3, array bounds
w.
c4: dl w1 (x2+12) ; array bounds:
ac w3 (x2+10) ; k := -type;
as w0 x3+1 ; i := upper//k;
as w1 x3+1 ; system := (lower//k) + 1;
al w1 x1+1 ;
rs w0 (x2+8) ; <*i := w0; system := w1;*>
rs. w2 (j13.) ; release reservation;
jl. (j6.) ; goto end register expression;
\f
; jz.fgs 1987.11.06 algol 8, system, page ...10a...
#, p-3
l./...16/, r/82.09.02/87.11.06/
l./i1=/, r/i1/i0= c4 - d0 ; define rel entry for system 3 code
i1/, l1, p-2
l./page ...21/, l./m.fgs/, r/86.04.04/87.11.06/
f
\f
message getzone getshare setzone setshare file 16
nextfile n g
n=edit g
; integer array from element with byte index 1 instead of lower bound
l./page 1/, l./e17:/, l2, i#
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;
#, p-7
l./page 3/, l./b2:/, l./33/, g/33/34/
l./b3:/, l./rl w0 x1-2/, d./jl. e17./, i/
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, ...);
/, p-7
l./33/, r/w3/w2/, g/33/34/, r/w2/w3/
l./page 5/,
l./e1:/, r/39/40/
l./e2:/, r/23/24/
l./al w3 2/, d./jl. d5./, i#
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);
#, p-11
l./page 6/,
l./e3:/, r/33/34/
l./page 7/,
l./e4/, r/23/24/
l./m.rc/, r/69.10.10/87.07.07/
f
\f
message getzone6 getshare6 setzone6 setshare6 file 17
nextfile n g
n=edit g
; integer array from element with byte index 1 instead of lower bound
l./page 1/, l./e17:/, l2, i#
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;
#, p-7
l./page 3/, l./b2:/, l./33/, g/33/34/
l./b3:/, l./rl w0 x1-2/, d./jl. e17./, i/
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, ...);
/, p-7
l./33/, r/w3/w2/, g/33/34/, r/w2/w3/
l./page 5/,
l./e1:/, r/39/40/
l./e2:/, r/23/24/
l./page 6/,
l./e3:/, r/33/34/
l./page 7/,
l./e4/, r/23/24/
l./m.rc/, r/71.03.16/87.07.07/
f
\f
message changevar outvar invar checkvar file 18
nextfile n g
n=edit g
; sec. param real array => long, real, double, complex, zone (out-changevar)
l./page 1/, r/rc 06.07.73/fgs 1987.07.09/
l./j30:/, i/
j29: 29 , 0 ; rs entry param alarm
/, p-1
l./page 3/, r/rc 1973.04.12/fgs 1987.07.09/
l./hl w1 x2+11/, d./jl. a2./, i/
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;
/, l1, p-8
l./page ...6/, l./m./, r/82.10.05/87.07.09/
l./page 10/, l./g0:/, l./w. 3<18/, r/26/41/, r/array/undefined/
l1, l./w. 3<18/, r/26/41/, r/array/undefined/
l./m./, r/74.08.23/87.07.09/
f
\f
message newsort deadsort lifesort outsort initsort,
initkey sortcomp startsort6 changekey6 file 19
nextfile n g
n=edit g
f
\f
message outdate movestring file 20
nextfile n g
n=edit g
; real array udvides til accept af integer, long, real, double, complex og zone rec
; check af string point mod last of segm table i stedet for first program
l./page 1/, r/ 01.12.71 / fgs 1987.07.02 /
l./,j40/, r/j40/j60/
l./j15:/, d
l./j30:/, i/
j29: g0+29 , 0 ; 29, param alarm
/
l1, i/
j60: g0+60 , 0 ; 60, last in segm table
/
l./page 5/, r/ 01.12.71 / fgs 1987.08.25 /
l./b0, a3/, r/b0, a3/b1, a5/
l./take array param:/, d2, i/
; take array parameter:
al w0 2.11111; check array param:
la w0 x2+6 ;
sh w0 23 ; if kind (param 1) > zone
sh w0 17 ; or kind (param 1) < integer array then
jl. w3 (j29.) ; goto param alarm;
se w0 18 ; typeshift :=
am 1 ; if kind = integer array then 1
al w3 1 ; else 2;
se w0 21 ; if kind = double array
sn w0 22 ; or kind = complex array then
al w3 3 ; typeshift := 3;
hs. w3 b1. ;
al w0 1 ; length :=
ls w0 x3 ; 1 shift typeshift;
rs w0 x2+12 ;
rl w3 x2+8 ; dope addr :=
ea w3 x2+6 ; dope rel + baseword addr;
b1 = k + 1 ; typeshift:
ls w1 0 ; index := index shift typeshift;
/, p1
l./rs w1 x2+10/, i/
al w1 x1+4 ; 4 -
ws w1 x2+12 ; length +
/, p1
l./page 6/, r/rc 19.1.72 / fgs 1987.08.25 /
l./j15./, r/j15/j60/
l./>= first of program/, r/first of program/last in segm table/
l./c0:/, l./jl. d3./, r/d3./a4./, r/exit/try exit/
l./d2:/, l1, r/w0/w3/
l2, r/4/length/
l./ls w1 -2/, d, i/
al w0 0 ;
wd w1 x2+12 ;
/, p-2
l1, r/w0/w3/
l./e./, i/
; try exit filled:
a4: am (x2+6) ;
sl w3 2 ; if next addr < last addr + 2 then
jl. d3. ; begin
rs w0 x3-2 ; ra (next addr - 2) := item (1);
al w3 x3+2 ; next addr :=
rs w3 x2+8 ; next addr + 2;
jl. d3. ; goto exit filled;
/, p1
l./page 7/, r/rc 19.1.72 / fgs 1987.07.02 /
l./m.rc 1972/, r/1972.01.19/1987.08.25/
l./g1:/, l./+26/, r/26/41/, r/real array/undefined/
f
\f
message initzones getalarm trap file 21
nextfile n g
n=edit g
f
\f
message openvirtual virtual resume file 22
nextfile n g
n=edit g
f
\f
message lock locked file 23
nextfile n g
n=edit g
f
\f
message setfpmode fpmode file 24
nextfile n g
n=edit g
f
\f
message activity newactivity passivate activate wactivity file 25
nextfile n g
n=edit g
f
\f
message closetrans writefield opentrans transerror waittrans,
readfield getf8000tab f8000table file 26
nextfile n g
n=edit g
f
\f
message fpproc file 27
nextfile n g
n=edit g
f
message buflengthio file 28
nextfile n g
n=edit bufiotx ;g
f
message openinout closeinout resetzones expellinout file 29
nextfile n g
openiotx1=edit openiotx
; closeinout retablerer zonerne som de var efter open
l./page ...1/, r/84.10.02/86.10.03/
l./g1, i7/, r/i7/i9/
l./for setzones and resetzones/, r/setzones/openinout/
l./block for first segment/, i/
b. c7, ; block for local names first segment
w.
k=10000 ; k assignment to catch missing relative
h.
c1 : c2 , c3 ; rel last point, rel last absword
c3 = k-2-c1 ; rel last absword
c2 = k-2-c1 ; rel last point
w.
g0 = 3 ; no of externals;
i2 = k - c1 ; start external list:
g0 ; no of externals;
0 ; no of halfs to copy to own core;
<:initzones<0>:> ; external no 1 : name
1<18+25<12+25<6+30 ; spec : no type proc (zone arr, int arr, int arr)
0 ; spec :
<:termzone<0>:>, 0 ; external no 2 : name
15<18 ; spec : illegal type proc
0 ; spec :
<:open<0>:> , 0, 0 ; external no 3 : name
1<18+19<12+41<6+19 ; spec : no type proc (zone, int addr, undef,
8<18 ; spec : int addr );
s3 ; date
s4 ; time
c0 = k - c1 ;
c. c0 - 506
m. code on segment 0 too long
z.
c. 502 - c0
0, r.(:504-c0:) > 1 ; fill with zeroes
z.
<:openinout 0<0>:> ; alarm text
m. segment 0
i.
e. ; end block for local names first segment
i4 = i4 + 1 ; increase segment count
æ12æ
; fgs 1986.10.03 algol 8, openinout, closeinout, resetzones page ... 2...
/, l2, p-5
l./g0 = 2/, d
l./i2 = k - c1/, d./s4/
l./page ...2/, r/84.02.01/86.10.03/, r/2/3/
l1, l./page...3/, r/83.11.18/86.10.03/, r/3/4/
l1, r/i0/i8 = i4 ; entry openinout, segment part:
i0/, p-1
l./la w0 x2+9/, r/9 /11/
l./page ...4/, r/83.12.07/86.10.03/, r/4/5/
l./page ...10/, r/83.11.18/86.10.03/, r/10/11/
l./<:openinout/, r/out 0/out 1/
l./page ...11/, r/84.02.15/86.10.03/, r/11/12/
l./p0, o4/, r/p0/p1/
l./j0:/, d
l./p0:/, d, i/
p0 : 1, 0 ; point 1. external (initzones);
p1 : 3, 0 ; point 3. external (open)
/, p-1
l./page ...12/, r/84.02.15/86.10.10/, r/12/13/
l./, c0/, r/, c0/ /
l./c0:/, d
l./b11:/, d, i/
b11: 4<12 + 18 ; constant, first formal integer array
b12: 6<12 + 23 ; - , - - zone
b13: 4<12 + 20 ; - , - long array
/, p-2
l./page ...15/, r/83.11.18/86.10.10/, r/15/16/
l./al w1 x1+28/, g/28/34/
l./; stack return inf/, d./rl. w1 (j13.)/, d1
l./rl. w3 c0./, r/c0. /b11./
l./page ...16/, r/83.11.18/86.10.06/, r/16/17/
l./c4 = /, l-1, d./rs. w2 (j13.)/, i/
rl. w1 (j13.) ; the six halfs are
al w1 x1+6 ; stacked by
rs. w1 (j13.) ; by take expression;
al w0 x2 ;
ls w0 4 ; w0 := sref<4 + 0;
rl. w1 p0. ; w3 := point (initzones);
jl. w3 (j4.) ; take expression (point);
ds. w3 (j30.) ; save sref, w3;
rs. w2 (j13.) ; unstack reserved core;
/, p1
l./el w0 x2+7/, i/
æ12æ
; fgs 1986.10.10 algol 8, openinout, closeinout, resetzones page ...18...
/
l./jl. a9./, r/state of all zones := 0/reopen all zones/
l1, d./jl. a8./, i/
a8: al w1 -32 ; repeat
jl. w3 (j3.) ; reserve (32 hwds);
ds. w3 (j30.) ; saved sref, w3 := w2, w3;
rl. w1 (o1.) ; zone := saved zone;
rl. w0 b12. ;
ds w1 x2-29 ; 1. param := zone;
al w3 26 ;
rl w0 x1+h1+0 ; modekind :=
ls w0 1 ; zone.modekind extract
ls w0 -1 ; 23;
rs w0 x2-15 ; literal (modekind) :=
al w0 x2-15 ; modekind;
ds w0 x2-25 ; 2. param := literal (modekind);
rl. w3 b13. ;
al w0 x2-13 ;
ds w0 x2-21 ; 3. param := long array (zone.name);
dl w0 x1+h1+4 ; move name from
ds w0 x2-5 ; zone.docname
dl w0 x1+h1+8 ; to
ds w0 x2-1 ; literal locations;
al w0 x2-9 ; baseword :=
rs w0 x2-13 ; addr literal locations;
al w3 16 ; <*upper *>
al w0 0 ; <*lower - k*>
ds w0 x2-9 ; dope vector := ( upper, lower - k);
al w3 26 ;
al w0 x1+h2+1 ;
ds w0 x2-17 ; 4. param := give up mask;
al w0 x2 ;
ls w0 4 ; w0 := sref < 4 + 0;
rl. w1 p1. ; w1 := point (open);
jl. w3 (j4.) ; take expression (point);
ds. w3 (j30.) ; save sref, w3;
rs. w2 (j13.) ; unstack reserved core;
rl. w1 (o1.) ; zone := saved zone;
al w1 x1+h5 ; zone := zone + zone descr length;
rs. w1 (o1.) ; saved zone := zone;
rl. w0 (o2.) ;
sh w1 (0) ; until
jl. a8. ; zone > last zone;
/
l1, r/state of all zones := 0/reopen all zones/, l1, p-2
r/end reg expr/end addr expr/
l./page ...17/, r/17/19/, r/84.02.15/86.10.03/
l./la w0 x2+9/, r/9 /11/
l1,
l./page ...18/, r/18/20/, r/84.02.22/86.10.03/
l1, l./page ...19/, r/19/21/, r/83.11.18/86.10.03/
l./<:openinout/, r/out 1/out 2/
l./page ...20/, r/20/22/, r/84.02.22/86.10.03/
l./1<11+ 0, i0/, r/1<11+ 0/1<11+i8/
l./m.rc/, r/84.10.02/86.10.10/
f
n=edit openiotx1 ;g
f
message changerecio inoutrec file 30
nextfile n g
n=edit inoutrectx ;g
f
message updextlists file 31
nextfile n g
n=edit updexttext ;g
; continue point i external list er kun rel i højre half
; no of bytes to copy to own core := 0 for fortran externals
; set clock i end external list
; give notice on changes made
l./page ...01/, r/86.10.08/87.09.08/
l./oldcount, ne;/, r/ne;/changecount, ne, ng, nb, nc, nzc;/
l./iff;/, r/iff;/iff, kindspec1;/
l./ia(1:20)/, r/;/, time (1:2);/
l./lf, lf1;/, l1, i/
real r;
boolean changes, fortran;
/, p-1
l./page ...02/, r/dh 86.10.08/dh 87.09.08/
l./procedure nextinlist/, l./psn:= extlist.if2/, r/if2/if2 extract 12/
l./contry :=/, l1, i/
kindspec1 := 28;
time (1) := systime (5, 0, r);
time (2) := r ; <*prepare time (1:2)*>
/, p-1
l./page ...06/, r/86.10.08/87.08.08/
l./<10>on base/, r/);/,
"nl", 1);/, p-1
l./page ...07/, r/86.10.08/87.09.07/
l./if content = 4 then/, i/
fortran := catind.kindspec1 < 0;
/, p-1
l./ne :=/, l1, i/
ng := extlist.if2 shift (-12);
nb := nextinlist (i);
/, p-4
l./for j := extlist.if2/, r/extlist.if2 shift(-11)/2 * ng/,
r/nextinlist(i)/(if fortran then 0 else nb)/
l./page ...08/, r/86.10.08/87.09.08/
l./for ne := ne/, i/
changecount := 0;
/, p1
l./fundet:/, l1, d2, i/
nextinlist (i);
changes :=
extlist.if2 <> externals.iaf (1);
extlist.if2 := externals.iaf (1);
nextinlist (i);
changes := changes or
extlist.if2 <> externals.iaf (2);
extlist.if2 := externals.iaf (2);
/, p-8
l./end;/, i/
changecount := changecount + 1;
if changecount = 1 then
write (out, "," , 1, "sp", 1)
else
write (out, "nl", 1, "sp", 27);
write (out, true, 12, name,
if changes then <: changes:> else <:no changes:>);
/, l1, p-2
l./end any externals at all/, i/
if fortran then
begin <*skip commons and zone commons*>
nc := nb shift (-12);
nzc := nb extract 12 ;
for nc := nc step -1 until 1 do
for j := 1 step 1 until 6 do
nextinlist (i);
for nzc := nzc step -1 until 1 do
for j := 1 step 1 until 9 do
nextinlist (i);
end <*skip commons and zone commons*>;
if change_count > 0 then
<*print time (1:2) in time field of external list*>
for j := 1, 2 do
begin
nextinlist (i); extlist.if2 := time (j);
end;
/, l1, p-4
f
message ret algol library slut
end
finis
▶EOF◀