|
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: 48384 (0xbd00)
Types: TextFile
Names: »open3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »open3tx «
\f
; jz.fgs 1984.03.05 algol 6, open and close page ...1...
;b. h100 block with fp-names
b. g1, i12 ; block for tail parts
w.
s. c12, e12 ; slang segment
w.
b. j20 ; block for first segment open
w.
k=0
h.
c1: c2 , c3 ; rel last point , rel last abs word
j1: 13 , 0 ; rs last used
j2: 30 , 0 ; rs saved stackref
j3: 4 , 0 ; rs take expr
j4: 16 , 0 ; rs base of segment table
j5: 36 , j15 ; rs parent message
j6: 8 , 0 ; end addr ex
j7: 21 , 0 ; general alarm
j9: 60 , 0 ; rs last of segment table
j13: 85 , 0 ; rs current activity no
j12: 1<11+3, 0 ; ref to fourth segment (array for docname)
c2=k-2-c1
c3=k-2-c1
w.
e4:i4: 0,0, s3, s4 ; external list
j18=64 ; slang constant, buflength error in zonestate
b. a20, b19, d4 ; block for local names in open
w.
b1: h6 ; share descriptor length
b2: 0 ; saved return
b3: 0, 0 ; save zone, name addr
b4: 1<18 ; test end of paper
b6: <:<10>z.state :> ; zone state error
b7: <:<10>kind:> ; kind error
b12: 7<13+0, <:mount :>,0 ; parent message, no wait
b13: 8<13+0, <:wait for :>; parent message, no wait
b14: 12<13+0, <:load :> ; parent message, no wait
b15: 2.11111 ; mask for kind
b16: <:<10>segment:> ; text for segment alarm
\f
; jz.fgs 1981.06.02 algol 6, open and close page ...2...
i0:
e0: rl. w2 (j1.) ; entry open: get last used;
ds. w3 (j2.) ; save stackref;
rl w1 x2+8 ; zoneaddr:=first formal.2;
rl w0 x1+h2+6 ; zonestate:=stat(zone);
se w0 4 ; if zonestate<>after decl then
jl. d1. ; goto zonestate error;
ld w0 -100 ;
ds w0 x1+h1+10 ; name table addr := 0
ds w0 x1+h1+6 ; second part(process name):=empty;
rs w0 x2+6 ; first:=0;
dl w1 x2+16 ; start checking:
la. w0 b15. ; isolate kind
se w0 24 ; if string variable
sn w0 28 ; or long variable
jl. a6. ; then goto string
se w0 4 ; if long procedure
sn w0 12 ; or expression
jl. a0. ; then goto take
rl. w3 (j12.) ; ref to fourth segm
se w0 8 ; if not string expression
jl w3x3+e5 ; then goto third segm, array in doc
a0: dl w1 x2+16 ; take:
so w0 16 ; pointer:=take formal(name);
jl. w3 (j3.) ; save stackref;
ds. w3 (j2.) ;
al w3 a4;=a0-a7
hs. w3 b11. ; continue:=take
a6: dl w0 x1 ; string:
sl w0 0 ; text:=double(pointer);
jl. a1. ; if text=point then
hs. w3 b10. ; begin
bz w3 6 ;
ls w3 1 ; w3:=segm*2 + segm table base;
wa. w3 (j4.) ;
rl. w0 (j9.) ; if segment tab addr
sh w0 x3-2 ; >= last of segtable
jl. d4. ; then goto segment alarm
rl w3 x3 ;
rl w0 x3 ; load first word on text segment;
b10=k+1 ;
al w1 x3+0 ; w1:=text addr;
al w3 a9;=a6-a7
hs. w3 b11. ; continue:=string;
dl w0 x1 ; w3-0:=string portion;
am -8 ; text addr:=text addr-8
; comment texts on drum are stored backwards
; end;
\f
; rc 1977.10.20 algol6, open and close page ...3...
a1: al w1 x1+4 ; text addr:= text addr+4 ; comment
; text protions in longs are stored forward
rx w1 x2+6 ; swop text addr, first;
am (x2+8) ;
ds w0 x1+h1+4 ; process name(first):=string portion;
sz w0 127 ;
se w1 0 ; if last char<>empty and first=0 then
jl. a8. ; begin
al w1 4 ; first:=4; w1:=text addr;
rx w1 x2+6 ;
b11=k+1 ; goto take or string (continue)
a7: jl. a6. ; comment the address here is changed
; by take and string = point; end
a8: al w3 a6-a7 ;
hs. w3 b11. ; continue:=string;
e1: ; return from segm 3 after array param
a2: dl w1 x2+12 ;
so w0 16 ;
jl. w3 (j3.) ; get modekind addr;
ds. w3 (j2.) ; save stackref;
bz w3 x1-1 ;
bz w0 x1 ; w3:=mode:=byte(modekind addr-1);
ds w0 x2+12 ; w0:=kind:=byte(modekind addr);
so w0 1 ; if kind odd or
sl w0 19 ; greater than 18 then
jl. d2. ; goto kind error;
\f
; fgs 1983.12.07 algol 6, open and close page ...4...
rl w1 x2+8 ; w1:=zone addr;
rl w3 x2+12 ; w3:=kind;
al w0 -1<11 ;
wa w0 x2+10 ; mode(zone):=1<11+mode;
hs w0 x1+h1+0 ; kind(zone):=kind;
hs w3 x1+h1+1 ;
sn w3 18 ;
am 8 ;
al w0 0 ; state(zone):=if kind=mt then not positioned
rs w0 x1+h2+6 ; else after open;
dl w1 x2+20 ;
so w0 16 ;
jl. w3 (j3.) ; get giveupmask;
ds. w3 (j2.) ; save stackref;
rl w0 x1 ; w0:=give up mask;
rl w1 x2+8 ; w1:=zone addr;
rs w0 x1+h2+0 ; giveupmask(zone):=giveupmask;
rl w0 x1+h0+8 ;
ws w0 x1+h0+6 ;
al w3 0 ; no of shares:=w0:=
wd. w0 b1. ; (last share-first share)//
ba. w0 1 ; share descr length + 1;
rl w3 x2+12 ; w3:=kind;
se w3 4 ; share unit :=
sn w3 6 ; w1 :=
am 510 ; if kind=bs then 512 else 2;
al w3 2 ;
rx w3 2 ; w3:=zone addr;
rs w1 x2+6 ;
wm w1 0 ; w0-1:=no.of shares*share unit;
rl w0 x3+h0+2 ; sharelength:=w0:=
ws w0 x3+h0+0 ; (last buf-base buf)//
al w3 0 ;
b9=k+1 ; constant 2 ;
wd w0 2 ; (no of shares*shareunit)*
wm w0 x2+6 ; shareunit;
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;
\f
; fgs 1983.12.07 algol 8, open and close page ...5...
bs. w0 b9. ; sharelength:=sharelength-2;
rs w0 x2+6 ;
rl w3 x1+h0+6 ; w3:=share:=first share;
rl w0 x1+h0+0 ; w0:=addr:=base buf-1;
bs. w0 1 ;
a3: ba. w0 b9. ; next share:
rs w0 x3+2 ; first shared(share):=w0:=
rs w0 x3+8 ; first addr mess(share):=addr:=addr+2;
wa w0 x2+6 ;
rs w0 x3+4 ; last shared(share):=w0:=
rs w0 x3+10 ; last addr message(share):=addr:=addr+sharel.;
rx w0 x2+10 ; swop addr, mode;
rs w0 x3+7 ; mode of message(share):=mode; op:=0;
rx w0 x2+10 ; swop mode, addr;
al w3 x3+h6 ; share:=w3:=share+shdescr length;
sh w3 (x1+h0+8) ; if share<=last share then goto next share;
jl. a3. ;
\f
; jz.fgs 1983.12.07 algol 6, open and close page ...6...
al w0 1 ;
rs w0 x1+h2+4 ; partial word:=1;
rl w3 x1+h0+6 ; w3:=first share;
wa w0 x3+4 ;
rs w0 x1+h3+2 ; last byte:=last shared(first share)+1;
ld w0 -100 ;
ds w0 x1+h1+14 ; filecount:=blockcount:=
rs w0 x1+h1+16 ; segmentcount:=
rs w0 x1+h3+4 ; recordlength:=0;
rl w2 x2+12 ; w2:=kind; w1=zone.
al w3 x1+h1+2 ; w3:=name addr;
jd 1<11+6 ; initialise process;
se w2 10 ;
sn w2 16 ; if kind=tr or cr then
jl. a10. ; goto wait reader;
sn w2 18 ; if kind<>mt
se w0 3 ; or process exists then
jl. (j6.) ; goto end addr expr;
al w2 x1 ; w2:=zone;
al. w1 b12. ;
rl. w3 (j5.) ; parent message(<:mount:>);
j15=k+1 ;
jl w3 x3+j16 ;
jl. (j6.) ; goto end addr expr;
a10: al w2 x1 ; wait reader: w2:=zone;
ds. w3 b3.+2 ; save zone, name addr;
sn w0 0 ; if initialised then
jl. a5. ; goto clean reader;
se w0 1 ; if not reserved by another then
jl. (j6.) ; goto end addr expr;
al. w1 b13. ;
rl. w3 (j5.) ; parent message(<:wait for:>);
j16=k+1 ;
jl w3 x3+j17 ;
a11: rl. w3 (j12.) ; rep:
jl w3 x3+e9 ; wait a second; w3:=name addr;
rl. w3 b3.+2 ;
jd 1<11+6 ; initialise process;
sn w0 1 ; if reserved by another then
jl. a11. ; goto rep;
a5: jl. w2 a12. ; clean reader: read a block;
jd 1<11+26 ; get event;
so. w0 (b4.) ; if not end of paper then
jl. a5. ; goto clean reader;
jd 1<11+6 ; initialise process (lowercase)
al. w1 b14. ;
rl. w2 b3. ; w2:=zone;
rl. w3 (j5.) ; parent message(<:load:>);
j17=k+1 ;
jl w3 x3+0 ;
a13: rl. w3 (j12.) ; rep:
jl w3 x3+e9 ; wait a second; w3:=name addr;
rl. w3 b3.+2 ;
jl. w2 a12. ; read a block;
rl w1 x2+10 ; w1:=bytes transferred;
se w1 0 ; if something read then
jl. (j6.) ; goto end addr expr;
jd 1<11+26 ; get event;
jl. a13. ; goto rep;
\f
; jz.fgs 1983.12.07 algol 6 open and close page ...7...
a12: rs. w2 b2. ; read a block: save return, w3=name addr;
rl w1 x3-h1+h0+4; w1:=first share;
al w0 3 ; operation:=read;
hs w0 x1+6 ; first addr initialised in open.
al w1 x1+6 ; w1:=mess addr;
rl. w2 (j13.) ; w2 := current activity no;
jd 1<11+16 ; send message;
rs w2 x1-6 ; share state:=buf addr;
al w2 0 ; w2:=start event queue;
a14: rl w0 x2+8 ; rep: w0:=expected status word;
sn w2 (x1-6) ; if event=share state then
jl. a15. ; goto check answer;
jd 1<11+24 ; wait event;
jl. a14. ; goto rep;
a15: rl w1 x2+4 ; check answer:
se w1 1 ; if -, normal answer then
jl. (j6.) ; goto end addr expression;
jl. (b2.) ; return;
d1: al. w0 b6. ; zone state alarm:
rl w1 x1+h2+6 ;
jl. w3 (j7.) ; general alarm(<:z.state:>,state);
d2: bz w1 x2+13 ; kind error:
al. w0 b7. ; general alarm(<:kind:>,kind);
jl. w3 (j7.) ;
d4: al. w0 b16. ; segment alarm:
al w1 x3 ; goto general alarm
jl. w3 (j7.) ; (<:segment:>, attempted no);
a4=a0-a7
a9=a6-a7 ;
m.open
i.
e.;end block for open
j20: c. j20-506
m. code on segment 1 too long
z.
c. 502-j20
0,r.(:504-j20:)>1 ; fill with zeroes
z.
<:open <0><0><0>:> ; alarm text segment 1
m.segment 1
i.
e.;end block for segment 1
\f
; jz.fgs 1984.08.31 algol 6, open and close page ...8...
b. j20, d4 ; block for segment 2
w.
k=0
h.
c4: c5 , c6 ; rel last point, rel last absword
j1: 30 , 0 ; rs saved stackref
j2: 4 , 0 ; rs take expr
j3: 8 , 0 ; rs end addr ex
j4: 13 , 0 ; rs last used
j6: 36 , j8 ; parent message
j7: 21 , 0 ; general alarm
j14: 85 , 0 ; rs current activity no
j13:101 , 0 ; rs latest answer
c6=k-2-c4
j10: 1<11, j19 ; point in term zone
j11: 33 , 0 ; point in rs check
j12: 35 , 0 ; point in outblock
c5=k-2-c4
w.
j15: -1-64 ; mask for removal of buflength error from zonestate
j16: -1-32 ; - - - - inout - -
j17=32 ; slang constant, inout bit in zonestate
b. a15, b5 ; block for internal procedure term zone
w.
i5: ; external entry term zone:
c0: rl. w1 j10. ; internal entry term zone:
jl. (j2.) ; stack return point;
; i.e. take expression continue next
j19: dl. w3 (j1.) ; w2:=saved sref;
rl w1 x2+8 ; w1:=zone addr;
al w0 0 ;
rs w0 x2+6 ; share start:=0;
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;
sh w3 8 ;
sh w3 -1 ;
jl. a4. ; if state>8 or state<0 then alarm;
bz. w3 x3+b0. ;
a0: jl. x3 ; switch to action(zone state);
a1: rl w3 x1+h2+4 ; terminate partial word: after write
sn w3 1 ; if partial word=empty then
jl. a2. ; goto terminate block;
ns w3 0 ; normalise partial word and
ls w3 2 ; remove 2 first bits;
al w0 2 ;
wa w0 x1+h3+0 ;
rs w0 x1+h3+0 ; recordbase:=recordbase+2;
rs w3 (0) ; word(record base):=characters(partial word);
al w3 0 ;
rs w3 x1+h3+4 ; record length:=0;
a2: rl w3 x1+h0+4 ; terminate block: after outrec, swoprec
al w3 x3+h6 ; w3:=share:=used share+descr length;
sh w3 (x1+h0+8) ; if share>last share then
jl. 4 ;
rl w3 x1+h0+6 ; w3:=share:=first share;
rl w2 x3 ; w2:=share state;
bz w0 x3+6 ; w0:=operation;
sn w0 3 ; if share pending and
sh w2 1 ; opr(share)=input then
jl. a3. ; begin comment only after swoprec.
al. w1 (j13.) ; prepares for call of outblock, which
jd 1<11+18; must not check the input operation;
al w0 0 ; wait answer(share);
rs w0 x3 ; state(share)=free end;
\f
; fgs 1984.02.21 algol 6 open and close page ...10...
a3: dl. w3 (j1.) ; restore stackref;
rl w1 x2+8 ; w1:=zoneaddr;
rl w0 x1+h3+0 ;
wa w0 x1+h3+4 ; w0:=last:=recordbase+recordlength-1;
bs. w0 1 ;
rl w3 x1+h0+4 ; w3:=used share;
sl w0 (x3+2) ; if last<first shared(used share) then
jl. 4 ;
jl. a5. ; goto count share; block is empty.
bz w2 x1+h1+1 ; w0=last. w2:=kind;
sl w2 4 ; if kind = area process
sl w2 8 ; or kind = disc process then
jl. a8. ; begin
ws w0 x3+2 ; w0:=last-first shared+512;
ba. w0 b2. ;
ls w0 -9 ; w0:=last:=w0//512*512 + first shared - 2;
ls w0 9 ;
bs. w0 b3. ;
wa w0 x3+2 ; end;
a8: rs w0 x3+10 ; last addr message:=last;
ld w1 28 ; w0:=zone addr shift 4;
dl. w3 (j1.) ; w2:=saved sref;
rl. w1 j12. ;
jl. w3 (j2.) ; outblock(used share);
ds. w3 (j1.) ; restore saved stackref;
rl w1 x2+8 ; restore zone addr;
a5: rl w3 x1+h0+4 ; count share:
al w3 x3+h6 ; used share:=w3:=used share+share descr length;
sh w3 (x1+h0+8) ;
jl. 4 ; if used share>last share then
rl w3 x1+h0+6 ; used share:=first share;
rs w3 x1+h0+4 ;
a6: rl w3 x1+h0+4 ; terminate zone: after all legal states
rl w0 x2+6 ; w0:=share start;
se w0 0 ; if share start=0 then
jl. 6 ;
rs w3 x2+6 ; share start:=used share
jl. 6 ; else
sn w0 x3 ; if share start=used share then
jl. a9. ; goto zone stopped;
bz w0 x3+6 ; w0:=operation;
sn w0 3 ; if operation<>input then
jl. a7. ; begin positioning checked to allow empty
al w0 x1 ; output file on magtape;
ls w0 4 ; w0:=zone addr shift 4;
rl. w1 j11. ;
jl. w3 (j2.) ; check(used share);
ds. w3 (j1.) ; restore saved stackref, zone addr;
rl w1 x2+8 ; goto count share;
jl. a5. ; end;
\f
;jz.fgs 1984.04.27 algol 6 open and close page ...11...
a7: rl w2 x3 ; w2:=share state;
al. w1 (j13.) ;
sl w2 2 ; if share pending then
jd 1<11+18 ; w0:=wait answer(used share);
dl. w3 (j1.) ; restore stackref;
rl w1 x2+8 ; restore zone addr;
al w0 0 ;
rs w0 (x1+h0+4) ; state(used share):=0;
jl. a5. ; goto count share;
a9: rl w3 x1+h0+6 ; zone stopped:
rs w3 x1+h0+4 ; w3:=used share:=first share;
bz w0 x1+h1+1 ; w0:=kind;
se w0 18 ; if kind<>mag tape then
jl. a12. ; goto exit;
zl w0 x1+h1+0 ; w0 := zone.mode;
sz w0 1 ; if w0 odd then
jl. a12. ; goto exit;
rl w2 x1+h2+6 ; w2:=zone state;
se w2 3 ; if zone state = after write
sn w2 6 ; or after outrec then
jl. a10. ; goto out mark;
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;
a10: al w0 10 ; out mark: w3=used share.
hs w0 x3+6 ; operation:=output mark;
rx w3 2 ; w3:=zone; w1:=share;
al w3 x3+h1+2 ; w3:=name addr;
al w1 x1+6 ; w1:=message addr;
rl. w2 (j14.) ; w2 := current activity no;
jd 1<11+16 ; w2:=send message(w1,w3);
sn w2 0 ; if buffer claim exceeded then
jd 1<11+18 ; provoke interrupt cause 6;
rs w2 x1-6 ; share state:=buf addr;
dl. w3 (j1.) ; w2:=saved sref;
rl w0 x2+8 ;
ls w0 4 ; w0:=zone shift 4;
rl. w1 j11. ;
jl. w3 (j2.) ; check used share;
rl w1 x2+8 ; w1 := zone;
a12: al w0 1 ; partial word :=
rs w0 x1+h2+4 ; empty;
jl. (j3.) ; goto end address expression;
d4: ;
a4: rl w1 x1+h2+6 ; state alarm: w1 := zone.state;
al. w0 b1. ;
jl. w3 (j7.) ; general alarm(<:z.state:>,state);
b1: <:<10>z.state :> ;
b3 = k+1 ;
b2: 512<12+2 ;
h.
b0: a6-a0,a6-a0,a6-a0,a1-a0,a4-a0,a6-a0,a2-a0,a2-a0,a6-a0;actions
; setpos read repch write decl inrec outrec swop openmt
m.term zone
i.
e.;end of block for term zone
\f
; jz.fgs 1983.12.07 algol 6 open and close page ....12...
b. a3, b5 ; block for close
w.
i6:
e6: rl. w2 (j4.) ; entry close: stackref:=last used;
ds. w3 (j1.) ; save stackref;
rl w1 x2+8 ;
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. ;
a3: dl w1 x2+12 ;
so w0 16 ;
jl. w3 (j2.) ; get release;
ds. w3 (j1.) ; save stackref;
bz w0 x1 ; w0:=release code;
rl w1 x2+8 ; w1:=zone addr;
so w0 1 ; if release then
jl. a0. ; begin
rs w0 x2+12 ; save release code;
bz w0 x1+h1+1 ; w0:=process kind;
al w3 x1+h1+2 ; w3:=name addr;
jd 1<11+10 ; release process;
sn w0 4 ; if kind=bs then
jd 1<11+64 ; w0:=remove process; w0<6.
se w0 18 ; if kind=mt then
jl. a0. ; begin
rl w0 x2+12 ; w0:=release code;
al. w1 b2. ; w1:=suspend tape;
sn w0 1 ; if release code = false add 1 then
al. w1 b3. ; w1:=release tape;
rl w2 x2+8 ; w2:=zone addr;
rl. w3 (j6.) ;
j8=k+1 ; call parent message(w1,w2);
jl w3 x3+0 ; end end;
al w1 x2 ; w1:=zone addr;
dl. w3 (j1.) ; w2:=saved sref;
\f
; fgs 1983.12.07 algol 8, open and close page ...13...
a0: al w0 4 ;
rs w0 x1+h2+6 ; zone state:=after declare;
rl w0 x1+h0+0 ;
rs w0 x1+h3+0 ; recordbase:=base buf;
rl w3 x1+h0+2 ;
rs w3 x1+h3+2 ; last byte:=last buf;
ws w3 0 ;
rs w3 x1+h3+4 ; record length:=last buf-base buf;
ba. w0 1 ; w0:=fs:=base buf+1;
rl w3 x1+h0+8 ;
rs w3 x2+6 ; work 6 := last share;
rl w3 x1+h0+2 ;
al w3 x3-1 ; w3:=ls:=last buf-1;
a1: rl w1 x1+h0+4 ; rep: w1:=used share;
rs w0 x1+2 ; first shared:=fs;
rs w3 x1+4 ; last shared:=ls;
rs w0 x1+22 ; top transferred:=fs;
sl w1 (x2+6) ; if w1<last share then
jl. a2. ; begin
al w1 x1+h6 ; w1:=w1+share descr length;
rx w3 x2+8 ; w3:=zone addr;
rs w1 x3+h0+4 ; used share:=w1;
al w1 x3 ; w1:=zone addr;
rx w3 x2+8 ; w3:=ls;
jl. a1. ; goto rep;
; end;
a2: rl w1 x2+8 ;
rl w0 x1+h0+6 ; w1:=zone addr;
rs w0 x1+h0+4 ; used share:=first share;
jl. (j3.) ; end addr expr;
b2: 10<13, <:suspend :> ; parent function: suspend tape
b3: 11<13, <:release :> ; parent function: release tape
m.close
i.
e.;end of block for close
\f
; fgs 1983.12.07 algol 8, open and close page ...14...
w.
j20: c.j20-506
m. code on segment 2 too long
z.
c. 502-j20
0,r.252-j20>1 ; fill with zeroes
z.
<:close/term<0><0>:> ; alarm text segment 2
m.segment 2
i.
e.;end of block for segment2
\f
; jz.fgs 1984.03.05 algol 8, setposition page ...15...
b. j20 ; block for segment 3
w.
k=0
h.
c7: c8 , c9 ; rel last point , rel last absword
j1: 30 , 0 ; rs saved stackref
j2: 4 , 0 ; rs take expr
j3: 8 , 0 ; rs end addr ex
j4: 13 , 0 ; rs last used
j5: 6 , 0 ; rs end reg ex
j6: 36 , j19 ; rs parent message
j8: 29 , 0 ; rs param alarm
j13: 85 , 0 ; rs current activity no
j7: 1<11o. (:-1:), 0; abs entry term zone
c9=j7-c7 ,c8=j7-c7
w.
j15: -1-64 ; mask for removal of buflength error from zonestate
j17=32 ; slang constant, inout bit in zonestate
j18=64 ; - - , buflength error - -
\f
; fgs 1984.03.05 algol 8, setposition page ...16...
b. a20 , b6 ; block for local names in setposition
w.
i7:
e7: rl. w2 (j4.) ; entry setposition: stackref:=last used;
ds. w3 (j1.) ; save stackref;
rl. w3 (j7.) ;
jl w3 x3+c0 ; term zone;
dl w1 x2+12 ;
so w0 16 ;
jl. w3 (j2.) ; get file;
ds. w3 (j1.) ; save stackref;
rl w0 x1 ; w0:=file;
rl w1 x2+8 ; w1:=zone addr;
rs w0 x1+h1+12 ; filecount:=file;
dl w1 x2+16 ;
so w0 16 ;
jl. w3 (j2.) ; get block;
ds. w3 (j1.) ; save stackref;
rl w0 x1 ; w0:=block;
rl w1 x2+8 ; w1:=zone addr;
rs w0 x1+h1+14 ; blockcount:=
rs w0 x1+h1+16 ; segmentcount:=block;
al w0 -1 ;
am (x1+h0+6); w0:=record base:= -1+
wa w0 2 ; first shared(first share);
rs w0 x1+h3+0 ;
al w0 0 ;
rs w0 x1+h3+4 ; recordlength:=0;
rl w3 x1+h0+6 ; w3:=first share;
rl w0 x3+4 ;
ba. w0 1 ;
rs w0 x1+h3+2 ; w0:=last byte:=last shared(first share)+1;
a2: rl w0 x3+4 ; for share:=first share step share decr length
rs w0 x3+10 ; until last share do
al w3 x3+h6 ; w0:=last addr.message:=last shared;
sh w3 (x1+h0+8) ;
jl. a2. ;
bz w0 x1+h1+1 ;
se w0 18 ; w0:=kind;
jl. a1. ; if kind.zone<>mt then goto out;
\f
; fgs 1984.03.05 algol 6, setposition page ...17...
a3: al w3 x1+h1+2 ; initialise: w3:=name addr;
jd 1<11+6 ; initialise process;
sh w0 1 ; if ok or reserved by another then
jl. a4. ; goto start position;
al w2 x1 ; mount tape: w2:=zone;
al. w1 b0. ; w1:=mess addr;
rl. w3 (j6.) ;
j19=k+1 ; parent message(w1,w2,mount and wait);
jl w3 x3+0 ;
rl w0 x2+h1+2 ; w0:=first word of doc name;
se w0 0 ; if name empty then
jl. a15. ; begin
dl w1 x3+2 ;
ds w1 x2+h1+4 ; copy name from end of answer to
dl w1 x3+6 ; doc name in zone
ds w1 x2+h1+8 ; end;
a15: al w1 x2 ; w1:=zone addr;
jl. a3. ; goto initialise;
a4: ; start position:
c. h57<3 ; if monitor 3 then
al w0 14 ; set mode: w0 := set mode;
z. ; else
c. h57<2
al w0 0 ; sense: w0:=sense;
z.
jl. w3 a10. ; send message and wait;
dl. w3 (j1.) ; w2:=saved sref;
dl w0 x1+h1+14 ; w3:=file count; w0:=block count;
sh w3 -1 ; if filecount<0 then
jl. a6. ; goto unwind;
sh w0 -1 ; if blockcount<0 then
jl. w3 (j8.) ; param alarm;
c. h57<3 ; if monitor 3 then
ds. w0 b2. ; store file and block in message;
am 1 ; moveop := position; skip next;
a6: al w0 5 ; unwind: moveop := unwind;
rs. w0 b6. ; store operation in message
al w0 8 ; operation:=move
hs. w0 b1. ;
am (x1+h0+4) ;
hs w0 6 ; operation in share:=move;
al w3 x1+h1+2 ; w3:=address(name_in_zone);
al. w1 b1. ;
jl. a16. ; goto send message;
z. ; end monitor 3 else
\f
; rc 07.03.72 algol6, setposition page ...18...
c. h57<2
rl. w3 b2. ; w3:=file in answer;
sn w3 (x1+h1+12); if file in answer=filecount then
jl. a7. ; goto blockpositioning;
sh w3 -1 ; if file in answer undefined then
jl. a13. ; goto rewind;
sh w3 (x1+h1+12) ; if file in answer< filecount then
jl. a5. ; goto upfile;
a12: ls w3 -1 ; spool back:
sl w3 (x1+h1+12) ; if file in answer//2>=filecount then
a13: am 2 ; rewind;
am 2 ; else backfile;
a5: am -5 ; upfile;
a6: al w0 5 ; unwind;comment the move oper is now ok;
jl. a9. ; goto send move;
a7: rl. w0 b3. ; blockpositioning: w0:=block in answer;
sn w0 (x1+h1+14) ; if block in answer=blockcount then
jl. a1. ; goto set result;
sh w0 -1 ; if block in answer undefined then
jl. a12. ; goto spool back;
sh w0 (x1+h1+14) ; if block in answer<blockcount then
jl. a8. ; goto upblock;
ls w0 -1 ;
sl w0 (x1+h1+14) ; if block in answer//2>=blockcount then
jl. a12. ; goto spool back;
am 2 ; backblock;
a8: al w0 1 ; upblock;comment the move oper is now ok;
a9: rl w3 x1+h0+4 ; send move:
rs w0 x3+8 ; store moveop in message;
al w0 8 ; op:=move;
z. ; end monitor 2;
\f
;jz.fgs 1983.12.07 algol 8, setposition page ...19...
a10: rs. w3 b4. ; send message: save return;
rl w3 x1+h0+4 ;
hs w0 x3+6 ; store op in message(used share);
al w3 x3+6 ;
al w1 x1+h1+2 ;
rx w3 2 ;
a16: rl. w2 (j13.) ; w2 := current activity no;
jd 1<11+16; send message(message(used share),mt name );
sn w2 0 ; if no buffers then
jd 1<11+18; provoke interrupt cause 6;
sn w0 8 ; if operation=move then
jl. a11. ; goto after move;
al. w1 b1. ; sense operation only:
jd 1<11+18; wait answer(result,answer addr);
dl. w3 (j1.) ; restore stackref;
rl w1 x2+8 ; restore zone addr;
jl. (b4.) ; return;
c. h57<2 ; if monitor 2 then
a11: rs w2 x1-6 ; after move: state(used share):=pending;
dl. w3 (j1.) ; restore stackref;
am -1 ; result:=message pending; skip;
z. ; else
c.h57<3 ; if monitor 3 then
; after move:
a11: rs w2 (x3+h0+4-h1-2); share state:=buf address;
dl. w3 (j1.) ; restore stackref;
am -1 ; result:=message pending
z.
a1: al w1 0 ; set result: reg:=message not pending;
rl w3 x2+8 ;
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 ;
jl. w3 (j5.) ; end reg ex;
b0: 7<13+1,<:mount :> ; parent message: mount and wait (4 words)
0 ;
b1: 0 ; answer address: message address : (move operation)
b6: 0 , 0 ;
b2: 0 ; file in answer
b3: 0 ; block in answer
0 , 0 , 0;
b4: 0 ; saved return
m.setposition
i.
e.;end of block for setposition
\f
; fgs 1984.02.15 algol 6, get position page ...20...
b. a10, b2 ; block for local mames in get position
w.
i8:
e8: rl. w2 (j4.) ; entry get position: stackref:=last used;
ds. w3 (j1.) ; save stackref;
dl w1 x2+12 ;
so w0 16 ;
jl. w3 (j2.) ; take file; w1:=file addr;
ds. w3 (j1.) ; save stackref;
rl w3 x2+8 ; w3:=zone addr;
rl w0 x3+h1+12 ;
rs w0 x1 ; file:=w0:=filecount;
al w0 0 ;
rs w0 x2+10 ; p:=0;
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;
sl w1 0 ; if unautorisised zonestate
sl w1 9 ; then
jl. a1. ; goto set block;
bz w0 x3+h1+1 ;
sn w0 18 ; if zonekind=mt then
jl. a8. ; goto magtape;
sl w0 4 ; if kind <> area process and
sl w0 8 ; kind <> disc process then
jl. a1. ; goto set block;
am b2 ;
a8: bl. w1 x1+b0. ; magtape:
a9: jl. x1 ; switch to action(kind,state);
\f
; fgs 1983.12.07 algol 8, get position page ...21...
a2: al w0 -1 ; after mag tape input:
rs w0 x2+10 ; p:=-1;
jl. a1. ; goto set block;
a3: ; after mag tape output:
am (x3+h0+6) ;
bl w1 6 ; if operation(first share)
se w1 5 ; <> output
jl. a1. ; then goto set block;
a4: rx w0 x2+10 ; after bs input:
rl w1 x3+h0+6 ; swop p, kind; w1:=first share;
a7: rx w3 x1 ; rep: swop zone addr, share state;
sl w3 2 ;
ba. w0 1 ; if share pending then p:=p+1;
rx w3 x1 ; swop share state, zone addr;
al w1 x1+h6 ; w1:=next share;
sh w1 (x3+h0+8) ; if w1<=last share then
jl. a7. ; goto rep;
rx w0 x2+10 ; swop kind, p;
sl w0 4 ; if kind = mt then
sl w0 8 ; goto set block;
jl. a1. ;
rl w1 x3+h0+6 ; w1:=first share;
al w0 2 ;
wa w0 x1+4 ; w0:=last shared - first shared + 2;
ws w0 x1+2 ;
ls w0 -9 ; segm:=(last shared - first shared + 2 )//512;
rl w1 x2+10 ; comment this refers to first share;
ac w1 x1+1 ;
wm w1 0 ;
rs w1 x2+10 ; p:=-(p+1)*segm;
a5:
a6: am 2 ; bs other: w0:=p:=p+segment count; skip;
a1: rl w0 x3+h1+14 ; set block: w0:=p:=p+block count;
wa w0 x2+10 ;
rs w0 x2+10 ;
dl w1 x2+16 ;
so w0 16 ; take block;
jl. w3 (j2.) ; save stackref;
ds. w3 (j1.) ;
rl w0 x2+10 ;
rs w0 x1 ; block:=p;
jl. (j3.) ; end addr ex;
h.
b0: a1-a9,a2-a9,a2-a9,a3-a9,a1-a9,a2-a9,a3-a9,a1-a9,a1-a9; magtape
b1: a5-a9,a4-a9,a4-a9,a5-a9,a5-a9,a4-a9,a5-a9,a6-a9,a5-a9; drisc
w.; setpos read repch write decl inrec outrec swop openmt
b2=b1-b0
m.getposition
i.
e.;end of block for getposition
\f
; jz.fgs 1981.06.02 algol 8, setstate, getstate page ...22...
b. a0 ; begin block for setstate, getstate
w.
i10: rl. w2 (j4.) ; entry setstate: sref := last used;
ds. w3 (j1.) ; save sref, w3;
dl w1 x2+12 ;
so w0 16 ;
jl. w3 (j2.) ; take addr (param2);
ds. w3 (j1.) ;
rl w3 x1 ;
am (x2+8) ;
rs w3 h2+6 ; zonestate := param2;
jl. (j5.) ; return;
i11: rl. w2 (j4.) ; entry getstate: sref := last used;
ds. w3 (j1.) ; save sref, w3;
dl w1 x2+12 ;
so w0 16 ;
jl. w3 (j2.) ; take address (param2);
ds. w3 (j1.) ;
am (x2+8) ;
rl w3 h2+6 ;
rs w3 x1 ; param2 := zonestate;
jl. (j5.) ; return;
m.setstate, getstate
i.
e. ; end block for setstate, getstate
\f
; jz.fgs 1981.06.02 open docname is array page ...23...
;
; moved to a new segment four
;
w.
j20: c.j20-506
m. code on segment 3 too long
z.
c. 502-j20
0,r.252-j20>1 ; fill with zeroes
z.
<:pos/state<0><0><0>:> ; alarmtext segment 3
m.segment 3
i.
e.;end of block for segment 3
\f
; jz.fgs 1987.08.27 algol 8, open (docname is array) page ...24...
b. j100 ; begin block for segment 4
w.
k=0
h.
c10 : c11, c12 ; rel last point, rel last absword
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
j29 : 29, 0 ; rs entry 29 : param alarm
j30 : 30, 0 ; rs entry 30 : saved sref, w3
j54 : 54, 0 ; rs entry 54 : field alarm
j1 : 1<11o.(:-3:), 0 ; ref to first segment
j2 : 1<11o.(:-2:), 0 ; ref to sec. segment
c12 = j2 - c10 ; rel of last absword
c11 = j2 - c10 ; rel of last point
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
\f
; 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
\f
; fgs 1984.03.05 algol 8, open (docname is array) page ...26...
b. a6 ; begin block for docname is array
w.
e5: rl. w2 (j13.) ; entry docname is array: sref := last used;
ds. w3 (j30.) ; save sref, w3;
al w1 2.11111 ; if kind(param)>zone
la w1 x2+14 ; or
sh w1 23 ; kind(param)<boolean array
sh w1 16 ; then
jl. w3 (j29.) ; goto rs29, param alarm;
rl w3 x2+16 ;
rl w1 x3 ;
rs. w1 a3. ; save array base;
ba w3 x2+14 ; w3:=dope;
al w1 1 ; if 1<=lower index-k then
sh w1 (x3) ; goto
jl. a5. ; lower field alarm;
rl w1 x3-2 ;
wa. w1 a3. ;
rs. w1 a4. ; save base+upper index
rl w1 x2+8 ; w1:=zone descr addr;
rl. w3 a3. ; w3:=array base;
rs. w2 a3. ; save stack pointer;
al w2 2 ; count:=2;
a1: rl w0 x3+2 ; loop:
am x2 ; move array
rs w0 x1+h1 ; to
sz w0 255 ; zonedescriptor
jl. 4 ; until
jl. a2. ; word ends with zero
al w3 x3+2 ; or
sl. w3 (a4.) ; upper index
jl. a6. ; passed;
al w2 x2+2 ; count:=count+2;
sh w2 8 ; max 4 words are moved;
jl. a1. ; goto loop;
a2: rl. w2 a3. ; exit: restore stack pointer;
rl. w3 (j1.) ; ref to first segm.
jl w3 x3+e1 ; goto first segm, after doc param
a3: 0 ; array base, stack pointer
a4: 0 ; base array+ upper index
a6: am x2 ; upper field alarm: field := count + 2;
a5: al w1 2 ; lower field alarm: field := 2;
jl. w3 (j54.) ; goto field alarm;
m.open docname is array
i.
e. ; end block for docname is array
\f
; fgs 1984.03.05 algol 8, open (wait a second) page ...27...
b. b2 ; begin block wait a second
w.
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
e9: rs. w3 b0. ; wait a second: save return
al. w1 b2.-4 ;
al. w3 b1. ;
jd 1<11 +16 ; send message(<:clock:>)
al. w1 b2. ;
jd 1<11 +18 ; wait answer
jl. (b0.) ; return
e. ; end block wait a second
\f
; jz.fgs 1984.03.05 algol 8, open, segm 4 page ...28...
w.
j100: c.j100-506
m.code on segment 4 too long
z.
c.502-j100
0, r.252-j100>1 ; fill segment with zeroes
z.
<:open/stop<0>:> ; alarm text segment 4
m.segment 4
i.
e. ; end block for segment 4
m.slang segment
i.
e.;end of block for slang segment
\f
; jz.fgs 1984.03.05 algol 8, open close set-get position-state page ...29...
;tail parts
h.
g0: 0 , 4 ; tail open:size
0 , r.8 ; name
2048 , i0 ; entry
w. 1<18+19<12+41<6+19 ; spec1
8<18 ; spec2
h. 4 , i4 ; kind, ext list
4 , 0 ; code segments
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
2048 , 4 ; tail close:other tail
0 , r.8 ; name
2049 , i6 ; entry
w. 1<18+18<12+8<6 ; spec1
0 ; spec2
h. 4 , 0 ; kind
4 , 0 ; code segments
2048 , 4 ; tail setposition:other tail
0 , r.8 ; name
2050 , i7 ; entry
w. 2<18+19<12+19<6+8 ; spec1
0 ; spec2
h. 4 , 0 ; kind
4 , 0 ; code segments
2048 , 4 ; tail getposition:other tail
0 , r.8 ; name
2050 , i8 ; entry
w. 1<18+19<12+19<6+8 ; spec1
0 ; spec2
h. 4 , 0 ; kind
4 , 0 ; code segments
2048 , 4 ; tail setstate:other tail
0 , r.8 ; name
2050 , i10 ; entry
w. 1<18+19<12+8<6 ; spec1
0 ; spec2
h. 4 , 0 ; kind
4 , 0 ; code segments, owns
g1: ; last tail:
2048 , 4 ; tail getstate:other tail
0 , r.8 ; name
2050 , i11 ; entry
w. 1<18+19<12+8<6 ; spec1
0 ; spec2
h. 4 , 0 ; kind
4 , 0 ; code segments, owns
m.rc 1987.08.27 open termzone stopzone close,
m. setposition getposition setstate getstate
i.
\f
▶EOF◀