|
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: 97536 (0x17d00)
Types: TextFile
Names: »gltxt «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦40b1eb8cd⟧
└─⟦this⟧ »gltxt «
\f
; tas 1.0 14.05.87 Globale routiner gltxt ...1...
; @(#)gltxt 1.5 (RC International) 11/6/91
;
;*********************************************************************
;************************ globale routiner ***************************
;*********************** terminal routiner ***************************
;*********************************************************************
;
; Terminal access system for rc8000 - A/S Regnecentralen
; Erik Poulsen
; Revisions historie
;
; 87.01.15 release til betatest
;
; 87.03.03 side 44 : ny tekst (no 32) i write_error
;
; 87.03.06 side 12 : ret i release_op så release op på link der er nedlagt
; ikke giver break 34
; 87.04.06 side 48 : ret new terminal så termtype kan være 2
;
; 87.04.08 side 9 : ret put_op så den returnerer værdien fra wait_proc
;
; 87.05.11 side 44 : nyt error_no (21) i write_error
;
; 87.05.14 release 1.0
;
; 88.03.17 to nye procedure, g35: disconnect terminal
; g36: connect terminal
;
; 88.03.17 release 1.2
;
; 89.05.19 side 54 : terminal afreserveres ikke hvis nologin
;
; 89.10.30 side 9 : hvis wait_proc er wait_semaphore giver det break 0
;
; 89.10.30 side 15 : fejl i get_spool_segment kan give break 52
; test på index, låsning af coretable er ændret
;
; 89.10.31 ks 500 i put_op
; ks 400,401 i get_spool_segment
;
; 89.11.07 side 15 : rettelsen på side 15 89.10.30 havde en fejl der
; også gav break 52 hos SPS, w1 blev ødelagt efter signal
;
; 90.02.06 side 8 : nyt testpunkt i put_op, no 95
; test punkt no 53, og 57 ændres til test på 1<3
;
; 90.05.15 side 36 : segments_in_spool_area(first,last,seg) rettet
;
; 90.05.15 side 36 : testpunkt 69 flyttet
;
; 90.06.29 side 50 : testpunkt 76 (search_th) flyttet
;
; 91.11.06 side 60 : unlink_th() rettet, sæt ph.f8000_ident = 0,
; kunne give break 0.
;
; temp testpunkter (500 - 599)
; brugte
;
;;
\f
; tas 1.0 14.05.87 rcmenu gltxt ...2...
;
; Modulet indeholder følgende globale rutiner
;
; d0 create_link
; d1 remove_link
; d2 adjust_link
; d3 put_op
; d4 check_op
; d5 release_op
; d6 get_spool_segment
; d7 get_free_corebuffer
; d8 adjust_prio
; d9 release_cte
; d10 segment_io
; d11 look_name
; d12 insert_mcl_name
; d13 remove_mcl_name
; d14 get_mcl_segment
; d16 next
; d17 create_spool_area
; d18 remove_spool_area
; d19 segments_in_spool_area
; d20 extend_spool_area
; d21 cut_spool_area
; d22 move
; d23 write_error
; d15 corebuf_lock
; d24 corebuf_open
; d25 new_terminal
; d26 search_th
; d27 put_in_session
; d28 get_from_session
; d29 unlink_from_session
; d30 get_term_data
; d31 link_ph
; d32 unlink_th
; d33 link_ph
; d34 unlink_ph
\f
; tas 1.0 14.05.87 Globale routiner gltxt ...3...
b. d40, r50, o10, t30 ; begin globale routiner
w.
m.globale routiner gltxt 1.5
c.-1
l10:
z.
; globale routinerne bruger lokale variable i coroutine
; beskrivelsen, variabel oprådet er delt i 4 niveauer
; relativ start adresse i coroutine beskrivelse for hvert niveau
; er givet ved o-navne
o1 = q35 ; start niveau 1
o2 = o1 + 10 ; start niveau 2
o3 = o2 + 4 ; start niveau 3
o4 = o3 + 12 ; start niveau 4
o5 = o4 + 10 ; top niveau 4
q191 = o5 - o1 ; stack size
; procedure create_link(link,nseg,result);
;
; link (call) peger til linkbeskrivelse
; nseg (call) antal segmenter der skal bruges til spool
; result ( return) =0 link oprettet
; =1 ikke frie segmenter nok
;
; opretter et link ved at initialisere link beskrivelsen og reservere
; segmenter på tasspool
;
; call return
; w0: nseg result
; w1: link unch.
; w2: unch.
; w3: return curco
b. i5,j5 w.
w.
d0:
g0: ds. w1 j1. ; save nsed,link;
ds. w3 j3. ; save w2,return;
c.a88<2
rs. w3 6 ; *** test no 50 **********
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...4...
jl. w3 (r37.) ; w0 nseg w2
h. 50 , 1<2 w. ; w1 link w3 return
0 ;
z.
al w0 0 ;
al w2 x1+f71 ; init_semaphor(link.operation,0);
jl. w3 (r1.) ;
rl. w0 j0. ;
bs. w0 1 ;
al w2 x1+f73 ; init_semaphor(link.free_seg,nseg-1);
jl. w3 (r1.) ;
al w0 1 ;
al w2 x1+f72 ; init_semaphor(link.reserve,1);
jl. w3 (r1.) ;
rl. w0 j0. ;
jl. w3 d17. ; create_spool_area(nseg,fseg,r);
se w0 0 ; if r=0 then
jl. i1. ; begin
ls w2 12 ;
rs w2 x1+f76 ; link.first_used:=fseg shift 12 + 0;
rs w2 x1+f77 ; link.first_free:=fseg shift 12 + 0;
rl. w0 j0. ;
rs w0 x1+f78 ; link.segments:=nseg;
al w0 0 ;
rs w0 x1+f74 ; link.ident:=0;
rs w0 x1+f75 ; link.cur_op:=0;
; end;
i1: dl. w2 j2. ; restore w1,w2;
rl. w3 (r0.) ; w3:=curco;
jl. (j3.) ; return;
j0: 0 ; nseg
j1: 0 ; link
j2: 0 ; saved w2
j3: 0 ; saved return
e.
; procedure remove_link(link);
;
; link (call) peger til linkbeskrivelsen
;
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...5...
; nedlægger et link og frigiver segmenter i tasspool
;
; call return
; w0: unch.
; w1: link unch.
; w2: unch.
; w3: return curco
b. i5,j5 w.
d1:
g1: ds. w1 j1. ; save w0,link;
ds. w3 j3. ; save w2,return;
c.a88<2
rs. w3 6 ; *** test no 51 **********
jl. w3 (r37.) ; w0 w2
h. 51 , 1<2 w. ; w1 link w3 return
0 ;
z.
zl w2 x1+f77 ; w2:=link.first_free.seg;
al w0 0 ;
al w3 x1+f70-2 ;
i1: rs w0 x3 ; for alle ord i link beskrivelse do
al w3 x3-2 ; ord:=0;
sl w3 x1 ;
jl. i1. ;
al w1 x2 ; remove_spool_area(w2);
jl. w3 d18. ;
dl. w1 j1. ;
rl. w2 j2. ; restore w0,w1,w2;
rl. w3 (r0.) ; w3:=curco;
jl. (j3.) ; return
j0: 0 ; saved w0
j1: 0 ; link
j2: 0 ; saved w2
j3: 0 ; saved return
e.
; procedure adjust_link(link,nseg,result);
;
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...6...
; link (call) peger til linkbeskrivelsen
; nseg (call) antal segmenter der skal høre til linket
; result (result) =0 ok
; =1 ikke frie segmenter nok til at udvide
; =2 ikke ubrugte segmente til at skære væk
;
; ændre antal segmenter der hører til et link
;
; call return
; w0: nseg result
; w1: link unch.
; w2: unch.
; w3: return curco
b. i5,j6 w.
d2:
g2: ds. w1 j1. ; save nseg,link;
ds. w3 j3. ; save w2,return;
c.a88<2
rs. w3 6 ; *** test no 52 **********
jl. w3 (r37.) ; w0 nseg w2
h. 52 , 1<2 w. ; w1 link w3 return
0 ;
z.
ws w0 x1+f78 ; d:=nseg - link.segments;
sn w0 0 ; if d=0 then goto exit;
jl. i3. ;
sh w0 0 ; if d > 0 then
jl. i2. ; begin
rs. w0 j6. ;
zl w2 x1+f77 ; w2:=link.first_free.seg;
rl w1 0 ; extend_spool_area(w2,d,r);
jl. w3 d20. ;
se w0 0 ; if r<>0 then goto fin;
jl. i5. ;
rl. w1 j1. ;
rl w0 x1+f78 ;
wa. w0 j6. ; link.segments:=link.segments + d;
rs w0 x1+f78 ;
i1: rl. w1 j6. ; rep:
sh w1 0 ; if d>0 then
jl. i3. ; begin
al w1 x1-1 ; d:=d-1;
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...7...
rs. w1 j6. ; signal(link.free_seg);
rl. w1 j1. ; goto rep;
al w2 x1+f73 ; end;
jl. w3 (r2.) ; goto exit;
jl. i1. ; end;
i2: ac w0 (0) ; /* d<0 */
rs. w0 j6. ;
zl w2 x1+f76 ; d:=-d:
rs. w2 j4. ; fseg:=link.first_free.seg;
zl w1 x1+f77 ; lseg:=linl.first_used.seg;
jl. w3 d19. ; segments_in_spool(fseg,lseg,n);
rl. w1 j6. ;
sh w1 (0) ; if d>n then goto err;
jl. +4 ;
jl. i4. ;
rl. w2 j4. ; cur_spool_area(fseg,d);
jl. w3 d21. ;
rl. w1 j1. ;
rl w0 x1+f73+4 ; w0:=link.free_seg.value;
ws. w0 j6. ; w0:=w0-d;
sh w0 -1 ; if w0<0 then fault
je -30 ;
rs w0 x1+f73+4 ; link.free_seg.value:=w0;
rl w0 x1+f78 ;
ws. w0 j6. ; link.segments:=link.segments-d;
rs w0 x1+f78 ;
i3: am -2 ; exit: result:=0;
i4: al w0 2 ; err: result:=2;
i5: dl. w2 j2. ; fin: restore w1,w2;
rl. w3 (r0.) ; w3:=curco;
jl. (j3.) ; return;
j0: 0 ; nseg
j1: 0 ; link
j2: 0 ; saved w2
j3: 0 ; saved return
j4: 0 ; fseg
j6: 0 ; d
e.
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...8...
; procedure put_op(link,length,op,wait_proc);
;
; link (call) peger til link beskrivelse
; length (call) antal hw i operationen
; (return) antal hw der er reserveret til op.
; wait_proc (call) adresse på procedure der skal bruges
; til at vente på semaphor;
; op (return) peger til første reserverede hw.
; Er =0 hvis link er nedlagt
; Er <0 hvis wait_proc returnerer w2<0
;
; reservere et antal hw til en operation til et link
;
; call return
; w0: length length
; w1: link unch.
; w2: wait_proc op
; w3: return curco
b. i5,j9 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o4 + 0 ; saved return
q41 = o4 + 2 ; op_length
q42 = o4 + 4 ; link
g3:
d3: ds. w3 j1. ; save return, wait_proc;
c.a88<2
rs. w3 6 ; *** test no 53 **********
jl. w3 (r37.) ; w0 length w2 wait_proc
h. 53 , 1<3 w. ; w1 link w3 return
0 ;
z.
rl. w3 (r0.) ; w3:=curco;
rl. w2 j1. ;
rs w2 x3+q40 ; save return i cdescr
ba. w0 +1 ; op_length:=length+2;
ba. w0 +1 ;
ds w1 x3+q42 ; save link, op_length i cdescr;
al w0 510 ; /* plads til -1 */
es w0 x1+f77+1 ; rest:=510-link.first_free.rel;
rs. w0 j2. ;
sl w0 (x3+q41) ; if rest < op_length then
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...9...
jl. i4. ; begin
sh w0 100 ;
jl. i1. ; if rest < 100
rl w0 x3+q41 ; or
sl w0 508 ; op_length<508 then
jl. i3. ; begin
i1: zl w2 x1+f77 ;
am. (r20.) ; link.first_free.seg:=
am (0) ;
zl w2 x2 ; areatable(link.first_free.seg);
ls w2 12 ;
rs w2 x1+f77 ; link.first_free.rel:=0;
rl w2 x3+q41 ;
al w0 506 ;
sl w2 506 ; if op_length > 506 then
rs w0 x3+q41 ; op_length:=506;
al w0 x1+f73 ;
al w2 x1+f73 ; /* wait_proc kan være wait_semaphore */
;rl. w3 j0.
;ks -500
jl. w3 (j0.) ; wait_proc(link.free_seg);
rl w1 x3+q42 ;
sh w2 -1 ; if wait_proc returnerer w2 < 0 then
jl (x3+q40) ; return;
rl w0 x1+f78 ; if link.segments=0 then
se w0 0 ; begin
jl. i4. ;
al w2 0 ; op:=0;
al w0 0 ; length:=0;
jl (x3+q40) ; return;
; end;
jl. i4. ; end;
; else
i3: rl. w2 j2. ; begin
al w2 x2-2 ; op_length:=rest-2;
rs w2 x3+q41 ; end;
; end;
i4: rl w2 x1+f77 ;
sz. w2 (j4.) ; if link.first_free.rel=0 then
am +1 ; bits:=2 else bits:=3;
al w1 1<1 ;
ls w2 -12 ; get_spool_segment(
jl. w3 d6. ; link.first_free.seg,b_addr,bits);
rl w1 x3+q42 ;
ea w2 x1+f77+1 ; op:=b_addr+link.first_free.rel;
rs. w2 j3. ; op1:=op;
rl w0 x3+q41 ;
rs w0 x2 ; word(op1):=op_length;
ea w0 x1+f77+1 ; link.first_free.rel :=
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...10...
hs w0 x1+f77+1 ; link.first_free.rel + op_length
wa w2 x2 ;
al w0 -1 ; op1:=op1+word(op1); /* op_length */
rs w0 x2 ; word(op1):=-1;
rl. w2 j3. ;
al w2 x2+2 ; op:=op+2;
al w0 -2 ;
wa w0 x3+q41 ; length:=op=length-2;
c.a88<2
ds. w1 j6. ; *** test no 89 **********
rl w0 x3+f13 ;
so w0 1<3 ;
jl. i5. ;
rl. w0 j7. ; type:=89, length:=8;
al w1 x1+f74 ; tail cur_op ident first_used first free
jl. w3 (r41.) ; testout
i5: dl. w1 j6. ;
rl. w3 (r0.) ;
rs. w3 6 ; *** test no 95 **********
jl. w3 (r37.) ; w0 length w2 op
h. 95 , 1<2 w. ; w1 link w3 curco
0 ;
z.
jl (x3+q40) ; return;
j0: 0 ; wait_proc
j1: 0 ; saved return
j2: 0 ; rest
j3: 0 ; op
j4: 511
j5: 0 ; saved w0
j6: 0 ; saved w1
j7: 8<12+89 ;
e.
; procedure check_op(link,length,op);
;
; link (call) peger til link linkbeskrivelse
; length (return) antal hw i operationen
; op (return) peger til første hw i operationen
;
; sikre at linkbuffer med første operation i kø er i core
;
; call return
; w0: length
; w1: link unch.
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...11...
; w2: op
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o4 + 0 ; saved return
q41 = o4 + 2 ; link
g4:
d4: rl. w2 (r0.) ;
rs w3 x2+q40 ; save return,link i cdescr;
al w3 x2 ;
rs w1 x3+q41 ;
zl w2 x1+f76 ;
al w1 1 ; get_spool_segment(
jl. w3 d6. ; link.first_used.seg,buf_addr,1);
rl w1 x3+q41 ;
ea w2 x1+f76+1 ; op:=buf_addr + link.first_used.rel;
al w0 -2 ;
wa w0 x2 ; length:=word(op)-2;
al w2 x2+2 ; op:=op+2;
c.a88<2
rs. w3 6 ; *** test no 54 **********
jl. w3 (r37.) ; w0 length w2 op
h. 54 , 1<2 w. ; w1 link w3 curco
0 ;
z.
jl (x3+q40) ; return
e.
; procedure release_op(link);
;
; link (call) peger til linkbeskrivelsen
;
; tager første operation i linkkøen ud
;
; call return
; w0: unch.
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...12...
; w1: link unch.
; w2: unch.
; w3: return curco
b. i5,j9 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o4 + 0 ; saved return
q41 = o4 + 2 ; saved w0
q42 = o4 + 4 ; link
q43 = o4 + 6 ; saved w2
q44 = o4 + 8 ; s
g5:
d5: rs. w3 j0. ;
rl. w3 (r0.) ; w3:=curco;
ds w1 x3+q42 ;
rs w2 x3+q43 ; save w0,link,w2 i cdescr;
rl. w0 j0. ;
rs w0 x3+q40 ; save return i cdescr;
rl w0 x1+f78 ;
se w0 0 ; if link.segments=0 then
jl. i0. ; return;
rl w0 x3+q41 ;
jl (x3+q40) ;
i0: zl w2 x1+f76 ;
al w1 1 ; get_spool_segment(
jl. w3 d6. ; link.first_used.seg,buf_addr,1);
rl w1 x3+q42 ;
ea w2 x1+f76+1 ; op:=buf_addr + link.first_used.rel;
rs. w2 j1. ;
al w0 0 ;
rx w0 x1+f74 ; x:=link.cur_op;
sn w0 0 ; link.cur_op:=0;
je -34 ; if x=0 then fault;
rl w0 x2 ; link.first_used.rel:=
c.a88<2
rs. w3 6 ; *** test no 55 **********
jl. w3 (r37.) ; w0 op length w2 op
h. 55 , 1<2 w. ; w1 link w3 return
0 ;
z.
ea w0 x1+f76+1 ; link.first_used.rel + word(op);
hs w0 x1+f76+1 ;
rl w2 x1+f76 ;
sn w2 (x1+f77) ; if link.first_used <> link.first_free then
\f
;; tas 1.0 14.05.87 Globale routiner gltxt ...12a...
jl. i1. ; begin
rl. w2 j1. ; op:=
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...13...
wa w2 x2 ; op + word(op);
rl w0 x2 ;
sl w0 0 ; if word(op)=-1 then
jl. i3. ; begin
zl w2 x1+f76 ; s:=link.first_used.seg;
am. (r20.) ;
am (0) ;
zl w0 x2 ; w2:=areatable(s);
ls w0 12 ; link.first_used:=
rs w0 x1+f76 ; w2 shift 12 + 0;
rs w2 x3+q44 ;
al w2 x1+f73 ; signal(link.free_seg);
jl. w3 (r2.) ; w1:=link; w2:=op;
rl w1 x3+q42 ; goto L;
rl w2 x3+q44 ; end;
jl. i2. ; end else
i1: al w0 0 ; begin
hs w0 x1+f76+1 ; link.first_used.rel:=0;
hs w0 x1+f77+1 ; link.first_used.rel:=0;
zl w2 x1+f76 ; s:=link.first_used.seg;
i2: am. (r19.) ; L: cte:=
am (0) ;
zl w2 x2 ; segmenttable(s)*8 +
ls w2 3 ; coretabel_base;
wa. w2 (r12.) ;
zl w0 x2+f81 ; cte.prio.w:=0;
la. w0 j2. ;
hs w0 x2+f81 ; end;
i3:
c.a88<2
rs. w1 j6. ; *** test no 88 **********
rl w0 x3+f13 ;
so w0 1<3 ;
jl. i5. ;
rl. w0 j7. ; type:=88, length:=8
al w1 x1+f74 ; tail cur_op, ident, first_free, first_used
jl. w3 (r41.) ; testout
i5: rl. w1 j6. ;
rl. w3 (r0.) ;
z.
rl w0 x3+q41 ;
rl w2 x3+q43 ; restore w0,w2;
jl (x3+q40) ; return;
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...14...
j0: 0 ; saved return;
j1: 0 ; op
j2: -(:1<9:)-1 ;
j6: 0 ; saved w1
j7: 8<12+88 ;
e.
; procedure get_spool_segment(seg,buf_addr,bits);
;
; seg (call) segment nummer
; buf_addr (return) peger til første hw i corebuffer
; bits (call) bitmaske med 3 bit
; bit 23 = 1 læs segment hvis det ikke er der
; bit 22 = 1 sæt write bit i coretable entry
; bit 21 = 1 sæt lock bit i coretabel entry
;
; finder adressen på corebuffer med givet segment fra tasspool
;
; call return
; w0: undef
; w1: bits undef
; w2: seg buf_addr
; w3: return curco
b. i10,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o3 + 0 ; saved return
q41 = o3 + 2 ; bits
q42 = o3 + 4 ; seg
q43 = o3 + 6 ; index
q44 = o3 + 8 ; cte
q45 = o3 + 10 ; buf_addr
g6:
d6: al w0 x3 ;
rl. w3 (r0.) ; w3:=curco
ds w1 x3+q41 ; save return,bits,seg i cdescr;
al w0 x1 ; w0 = bits af.h.til test
rs w2 x3+q42 ;
am. (r19.) ;
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...15...
am (0) ;
el w1 x2 ; index:=segmenttable(seg);
c.a88<2
rs. w3 6 ; *** test no 56 **********
jl. w3 (r37.) ; w0 bits w2 seg
h. 56 , 1<3 w. ; w1 index w3 curco
0 ;
z.
sl w1 0 ; if index < 0 then
jl. i2. ; begin
rl. w2 r42. ; /******* start kritisk region **************/
jl. w3 (r5.) ; wait_semaphore(coretable_lock);
rl w2 x3+q42 ;
am. (r19.) ;
am (0) ; if index >= 0 then
el w1 x2 ; begin
sh w1 -1 ; /* en anden har læst segment ind */
jl. i6. ; signal(coretable_lock);
rl. w2 r42. ;
jl. w3 (r2.) ;
rl w2 x3+q42 ;
am. (r19.) ; w1:=index:=segmenttable(seg);
am (0) ; goto L;
el w1 x2 ; end;
;ks -501
jl. i2. ;
i6: jl. w3 d7. ; get_free_corebuffer(
ds w1 x3+q44 ; cte,buf_addr,index);
rs w2 x3+q45 ;
rl w2 x3+q42 ;
rs w2 x1+f83 ; cte.segment:=seg;
rl w0 x3+q41 ;
so w0 1 ; if bits and 1 = 1 then
jl. i1. ; segment_io(read,cte,<:tasspool:>);
al w0 3 ;
rl. w2 r27. ;
jl. w3 d10. ;
i1: rl w0 x3+q43 ;
rl w2 x3+q42 ;
am. (r19.) ;
am (0) ;
hs w0 x2 ; segmenttable(seg):=index;
rl. w2 r42. ; signal(coretable_lock);
jl. w3 (r2.) ; /******* end kritisk region ****************/
dl w2 x3+q45 ; w1:=cte; w2:=buf_addr;
jl. i3. ; end
; else
i2: al w2 x1 ; begin
ls w1 3 ; L:
wa. w1 (r12.) ; cte:=index*8 + coretable_base;
ls w2 9 ;
wa. w2 (r15.) ; buf_addr:=index*512 + corebuffer_base;
; end;
i3: zl w0 x1+f82 ;
se w0 0 ; if cte.type <>0 then
je -35 ; fault;
rl w0 x3+q41 ;
zl w3 x1+f81 ;
sz w0 1<1 ; if bits and 2 = 2 then
lo. w3 j1. ; cte.prio.w:=1;
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...16...
sz w0 1<2 ; if bits and 4 = 4 then
lo. w3 j2. ; cte.prio.L:=1;
hs w3 x1+f81 ;
jl. w3 d8. ; adjust_prio(cte);
rl. w3 (r0.) ; w3:=curco;
jl (x3+q40) ; return;
j1: 1<9 ; prio.w write bit i prio
j2: 1<10 ; prio.l lock bit i prio
e.
; procedure get_free_corebuffer(cte,buf_addr,index);
;
; cte (return) peger til coretable entry
; buf_addr (return) peger til første hw af corebuffer
; index (return) coreindex
;
; finder fri corebuffer, hvis ingen er fri findes den med lavest
; prioritet
;
; call return
; w0: index
; w1: cte
; w2: buf_addr
; w3: return curco
b. i10,j10 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o2 + 0 ; saved return
q41 = o2 + 2 ; cte
g7:
d7: rl. w2 (r0.) ;
rs w3 x2+q40 ; save return i cdescr
rl. w1 (r17.) ;
c.a88<2
rs. w3 6 ; *** test no 90 **********
jl. w3 (r37.) ; w0 w2 curco
h. 90 , 1<3 w. ; w1 free w3 return
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...17...
0 ;
z.
al w3 x2 ; w3:=curco;
sn w1 0 ; if free_head<>0 then
jl. i1. ; begin
rl w2 x1 ; cte:=free_head;
la. w2 j2. ; free_head:=
rs. w2 (r17.) ; word(cte) extract 23;
rl. w2 (r38.) ;
al w2 x2-1 ; en mindre frie corebuffer
rs. w2 (r38.) ;
jl. i8. ; end else
i1: rl. w1 (r14.) ; begin
ls w1 -2 ; n:=coretable_size // 4;
sh w1 4 ; if n<=4 then
rl. w1 (r14.) ; n:=coretable_size;
rs. w1 j1. ;
rl. w2 (r18.) ; w2:=c_entry;
i2: al w0 1024 ; S:
rs. w0 j0. ; p:=1024;
i3: sh w1 0 ; while i>0 do
jl. i5. ; begin
al w1 x1-1 ; i:=i-1;
zl w0 x2+f81 ; if c_entry.prio<p then
sl. w0 (j0.) ; begin
jl. i4. ;
rs w2 x3+q41 ; victim:=c_entry;
rs. w0 j0. ; p:=c_entry.prio;
i4: al w2 x2+8 ; end;
am. (r13.) ;
sn w2 (0) ; c_entry:=c_entry+8;
rl. w2 (r12.) ; if c_entry=coretable_top then
rs. w2 (r18.) ; c_entry:=coretable_base;
jl. i3. ; end;
i5: rl. w0 j0. ;
se w0 1024 ; if p=1024 then
jl. i6. ; begin
rl. w1 (r14.) ; if n=coretable_size then
sn. w1 (j1.) ; fault;
je -31 ; n:=coretable_size;
rs. w1 j1. ; goto S;
jl. i2. ; end;
i6: rl w1 x3+q41 ;
rl w2 0 ;
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...18...
zl w0 x1+f82 ;
c.a88<2
rs. w3 6 ; *** test no 91 **********
jl. w3 (r37.) ; w0 type w2 prio
h. 91 , 1<3 w. ; w1 cte w3 curcon
0 ;
z.
sh w0 0 ;
jl. i9. ; if cte.type>0 then begin
al w2 x1+f84 ; /* mcl program segment */
jl. w3 (r8.) ; remove(cte.mcl_kæde);
rl. w3 (r0.) ;
al w1 x2-f84 ;
al w0 0 ; cte.type,prio:=0;
rs w0 x1+f81 ; end
jl. i7. ; else /* segment fra spool */
i9: rl w2 x1+f83 ; begin
al w0 -1 ;
am. (r19.) ; segmenttable(cte.seg):=-1;
am (0) ;
hs w0 x2 ; end;
i7: zl w0 x1+f81 ;
so w0 1<9 ; if cte.prio.w=1 then
jl. i8. ; segment_io(write,cte,<:tasspool:>);
al w0 5 ;
rl. w2 r27. ;
jl. w3 d10. ; w1:=cte;
rl w1 x3+q41 ; end;
i8: al w0 0 ;
rs w0 x1+f81 ; cte.prio:=0,cte.type:=0;
rs w0 x1+f84 ;
rs w0 x1+f84+2 ; cte.mcl_chain:=0;
al w0 -1 ;
rs w0 x1+f83 ; cte.segment_no:=-1;
al w0 x1 ;
ws. w0 (r12.) ; index:=
ls w0 -3 ; (cte-coretable_base)//8;
rl w2 0 ;
ls w2 9 ; buf_addr:=
wa. w2 (r15.) ; index*512+corebuffer_base;
c.a88<2
rs. w3 6 ; *** test no 57 **********
jl. w3 (r37.) ; w0 index w2 buf_addr
h. 57 , 1<3 w. ; w1 cte w3 curco
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...19...
0 ;
z.
jl (x3+q40) ; return
j0: 0 ; p
j1: 0 ; n
j2: (:-1:)>1
e.
; procedure adjust_prio(cte);
;
; cte (call) peger til coretable entry hvis prio skal sættes
;
; sætter current prio i indgang i coretable indgang og tæller current
; prio en op. Hvis current prio bliver for stor justeres prio i alle
; indgange i tabellen
;
; call return
; w0: unch.
; w1: cte unch.
; w2: unch.
; w3: return unch.
b. i5,j5 w.
g8:
d8: ds. w1 j1. ;
ds. w3 j3. ; save registers;
zl w0 x1+f81 ;
la. w0 j4. ;
rl. w3 (r16.) ;
c.a88<2
rs. w3 6 ; *** test no 58 **********
jl. w3 (r37.) ; w0 bit w2
h. 58 , 1<3 w. ; w1 cte w3 cur prio
0 ;
z.
wa w0 6 ; cte.prio:=current_prio;
hs w0 x1+f81 ;
al w3 x3+1 ; current_prio:=current_prio+1;
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...20...
rs. w3 (r16.) ;
sh w3 511 ; if current_prio>511 then
jl. i3. ; begin
al w0 30 ;
rs. w0 (r16.) ; current_prio:=30;
rl. w1 (r12.) ; cte:=coretable_base;
i1: am. (r13.) ;
sn w1 (0) ; while cte<>coretable_top do
jl. i3. ; begin
el w2 x1+f81 ;
sh w2 0 ; if cte.prio>0 then
jl. i2. ; begin
al w3 x2 ; /* indgang i brug */
la. w3 j4. ; w3:=cte.prio.LW;
la. w2 j5. ;
al w2 x2-480 ; w2:=cte.prio - 480;
sh w2 -1 ; if w2<0 then
al w2 0 ; w2:=0;
wa w2 6 ; cte.prio:= w2 + w3;
hs w2 x1+f81 ; end;
i2: al w1 x1+8 ; cte:=cte+8;
jl. i1. ; end;
i3: dl. w1 j1. ; end;
dl. w3 j3. ; restore registers;
jl x3 ; return;
j0: 0 ; saved w0
j1: 0 ; saved w1
j2: 0 ; saved w2
j3: 0 ; saved w3
j4: 3<9 ; LW i prio
j5: 511
e.
; procedure release_cte(cte);
;
; cte (call) coretable entry adresse
;
; frigiver en indgang i coretable
;
; call return
; w0: undef.
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...21...
; w1: cte unch.
; w2: unch.
; w3: return curco
b. i5,j5 w.
g9:
d9: rl. w0 (r17.) ;
c.a88<2
rs. w3 6 ; *** test no 59 **********
jl. w3 (r37.) ; w0 free w2
h. 59 , 1<3 w. ; w1 cte w3 return
0 ;
z.
wa. w0 j0. ; word(cte):=free_head + 1 shift 23;
rs w0 x1 ;
rs. w1 (r17.) ; free_head:=cte;
rs. w3 j1. ;
rl. w3 (r38.) ;
al w3 x3+1 ; en mere frie corebuffer
rs. w3 (r38.) ;
rl. w3 (r0.) ; w3:=curco;
jl. (j1.) ; return;
j0: 1<23 ;
j1: 0 ; saved return
e.
; procedure segment_io(mode,cte,name_addr);
;
; mode (call) =3 segment læses til corebuffer
; =5 corebuffer skrives på segment
; cte (call) coretable entry adresse
; name_addr (call) peger til navn på bs område
;
; læser eller skriver en corebuffer fra/til et segment i et bs område,
; corebuffer og segment nummer er givet ved en indgang i coretable,
; den låses under io
;
; call return
; w0: mode undef.
; w1: cte unch.
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...22...
; w2: name_addr unch.
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o1 + 0 ; saved return
q41 = o1 + 2 ; cte
q42 = o1 + 4 ; name_adde
g10:
d10: hs. w0 j0. ; mes.mode:=mode;
c.a88<2
rs. w3 6 ; *** test no 60 **********
jl. w3 (r37.) ; w0 mode w2 name addr
h. 60 , 1<3 w. ; w1 cte w3 return
0 ;
z.
rs. w3 j3. ;
rl. w3 (r0.) ;
ds w2 x3+q42 ; save cte,w2 i cdescr;
rl. w0 j3. ;
rs w0 x3+q40 ; save return i cdescr;
rl w2 x1+f83 ; seg:=cte.segment_no;
rs. w2 j2. ; mes.segment:=seg;
ws. w1 (r12.) ;
ls w1 -3 ; index:=(cte-coretable_base)//8;
ls w1 9 ; mes.first:= index*512+corebuffer_base;
wa. w1 (r15.) ;
al w2 x1+510 ; mes.last:=mes.first+510;
ds. w2 j1. ;
al. w1 j0. ;
rl w2 x3+q42 ; csendmessage(mes,
jl. w3 (r6.) ; name_addr,buf);
sh w2 2 ; if buf<2 then fault;
je -12 ;
al w0 0 ;
al. w1 j0. ; cwaitanswer(buf,0,ans,r);
jl. w3 (r7.) ;
se w0 1 ; if r<>1 then fault;
je -32 ;
rl. w0 j0. ;
se w0 0 ; if ans(0)<>0 then fault;
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...23...
je -32 ;
rl. w3 (r0.) ; w3:=curco;
dl w2 x3+q42 ; restore w2,w1;
jl (x3+q40) ; return
j0: 0,r.8 ; mes og answer area
j1=j0+4 ; mes.first,mes.last
j2=j0+6 ; mes.segment
j3: 0 ; return
j4: -(:1<10:)-1 ;
e.
; procedure look_name(name,pda,seg);
;
; name (call) peget til 5 ord med navn og nte
; pda (return) pda for area processen, hvis =0 findes
; område ikke
; seg (return) max segment nummer på området
;
; finder pda der høret til område på bs
;
; call return
; w0: pda eller 0
; w1: seg
; w2: name undef.
; w3: return curco
b. i5,j5 w.
g11:
d11: ds. w3 j1. ; save name,return;
al. w1 j2. ;
al w3 x2 ;
jd 1<11+42 ; lookup_entry,name,tail,r);
c.a88<2
rs. w3 6 ; *** test no 61 **********
jl. w3 (r37.) ; w0 result w2 name addr
h. 61 , 1<3 w. ; w1 tail addr w3 name addr
0 ;
z.
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...24...
se w0 0 ; if r<>0 then
jl. i1. ; begin
rl. w0 j2. ; if tail.size>0 and
sh w0 0 ; tial.content=29 then
jl. i1. ; begin
zl. w0 j3. ;
se w0 29 ;
jl. i1. ; create_entry_lock_process(
jd 1<11+92 ; name,r);
se w0 0 ; if r=0 then
jl. i1. ; begin
jd 1<11+8 ; reserve_process(name,r);
se w0 0 ; if r=0 then
jl. i1. ; begin
jd 1<11+4 ; process_description(name,pda);
rl. w1 j2. ; seg:=tail.size-1; /* max seg no */
al w1 x1-1 ; w3:=curco;
rl. w3 (r0.) ; return
jl. (j1.) ; end;
; end;
; end;
; end
i1: al w0 0 ; pda:=0;
rl. w3 (r0.) ; w3:=curco;
jl. (j1.) ; return;
j0: 0 ; name addr
j1: 0 ; saved return
j2: 0,r.10 ; tail
j3=j2+16 ; tail.content
e.
; procedure insert_mcl_name(p_name,mcl_netry,result);
;
; p_name (call) peger til mcl program navn og bruger baser
; mcl_entry (call) peger til mcl tabel indgang
; result (return) =0 ok
; =2 ingen frie indgange
; =3 navn på prog findes ikke
;
; undersøgen om et givet mcl program fil står i mcl program tabel, hvis ikke
; indsættes den
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...25...
;
; call return
; w0: result
; w1: mcl_entry
; w2: p_name unch.
; w3: return curco
;
; p_name er adressen på 6 ord med mcl program navn og navne baser der
; bruges hvis navnet ikke findes på tas default mcl program baser
b. i10,j10 w.
g12:
d12: ds. w3 j1. ; save return,p_name;
c.a88<2
rs. w3 6 ; *** test no 62 **********
jl. w3 (r37.) ; w0 w2 name addr
h. 62 , 1<2 w. ; w1 w3 return addr
0 ;
z.
dl w1 x2+2 ; /* flyt navn til lokale variable */
ds. w1 j3. ;
dl w1 x2+6 ;
ds. w1 j4. ;
dl w1 x2+10 ;
ds. w1 j6. ; base:=p_name.base;
dl. w1 (r26.) ; /* søg efter mcl program på std name baser
ds. w1 j10. ; for mcl programmer */
al. w3 j9. ; n_base:=std mcl name base;
jd 1<11+72 ; set_catalog_base(<::>,std mcl name base);
se w0 0 ;
je -17 ; if result<>ok then fault
al. w2 j2. ;
jl. w3 d11. ;
ds. w1 j8. ; look_name(name, pda, seg);
se w0 0 ;
jl. i1. ; if pda= 0 then
dl. w1 j6. ; begin
ds. w1 j10. ; n_base:=base;
al. w3 j9. ; set_catalog_base(<::>,n_base);
jd 1<11+72 ;
se w0 0 ;
je -17 ; if result<>ok then fault
jl. w3 d11. ; look_name(name,pda,seg);
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...26...
ds. w1 j8. ;
sn w0 0 ; if pda=0 then goto unknown;
jl. i7. ; end;
i1: rl. w1 (r24.) ; mcl_entry:=mcltable_base;
i2: am. (r25.) ;
sl w1 (0) ; while mcl_entry<>top_mcltable do
jl. i3. ; begin
sn w0 (x1+f91) ; if mcl_entry.pda=pda then
jl. i6. ; goto found;
al w1 x1+f90 ; mcl_entry:=mcl_entry+mcl_entry_length;
jl. i2. ; end;
; /* ikke fundet, find en ledig */
i3: rl. w1 (r24.) ; mcl_entry:=mcltable_base;
i4: am. (r25.) ;
sl w1 (0) ; while mcl_entry<>top_mcltable do
jl. i8. ; begin
rl w0 x1+f91 ; if mcl_entry.pda=0 then
sn w0 0 ; goto empty_found;
jl. i5. ; mcl_entry:=mcl_entry + mcl_netry_length;
al w1 x1+f90 ; end;
jl. i4. ; goto table_full;
i5: rl. w0 j7. ; empty_found: mcl_entry.pda:=pda;
rs w0 x1+f91 ;
dl. w3 j3. ; mcl_entry.name:=name;
ds w3 x1+f92+2 ;
dl. w3 j4. ;
ds w3 x1+f92+6 ;
rl. w3 j5. ;
rs w3 x1+f92+8 ; mcl_entry.nte:=nte;
dl. w3 j10. ;
ds w3 x1+f96 ; mcl_entry.base:=n_base;
al w0 0 ;
rs w0 x1+f94 ; mcl_entry.users:=0;
rl. w0 j8. ;
rs w0 x1+f94 ; mcl_entry.max_segment_no:=seg;
al w3 x1+f95 ; mcl_entry.next:=
rs w3 x1+f95 ; mcl_entry.prev:=
rs w3 x1+f95+2 ; addr mcl_entry.next;
rl. w3 (r39.) ;
al w3 x3-1 ; en mindre fri mcltable indgang
rs. w3 (r39.) ;
i6: rl w3 x1+f93 ; found:
al w3 x3+1 ; mcl_entry.users:= mcl_entry.users+1;
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...27...
rs w3 x1+f93 ;
am -3 ; result:=0;
i7: am +1 ; unknown: result:=3;
i8: al w0 2 ; table_full: result:=2;
rl. w2 j0. ; restore w2;
rl. w3 (r0.) ; w3:=curco;
jl. (j1.) ; return;
j0: 0 ; p_name
j1: 0 ; saved return
j2: 0,r.5 ; name+nte
j3=j2+2
j4=j2+6
j5=j2+8
0
j6: 0 ; base
j7: 0 ; pda
j8: 0 ; seg
j9: 0 ; <::>
0
j10: 0 ; n_base
e.
; procedure remove_mcl_name(mcl_entry);
;
; mcl_entry (call) peger til indgang i mcl program table
;
; tæller antal brugere af et mec program en end, hvis antal brugere
; bliver 0 frigives tabel indgangen og alle corebuffere kædet til
; indgangen frigives.
;
; call return
; w0: unch.
; w1: mcl_entry unch.
; w2: unch.
; w3: return curco
b. i7,j5 w.
g13:
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...28...
d13: ds. w1 j1. ;
ds. w3 j3. ; save registers;
c.a88<2
rs. w3 6 ; *** test no 63 **********
jl. w3 (r37.) ; w0 w2
h. 63 , 1<2 w. ; w1 mcl entry w3 return
0 ;
z.
rl w3 x1+f93 ;
al w3 x3-1 ; mcl_entry.users:=mcl_entry.users-1;
rs w3 x1+f93 ;
rl w2 x1+f95 ;
rs. w2 j4. ; cte:=mcl_entry.next;
se w3 0 ; if mcl_entry.users=0 then
jl. i3. ; begin
jl. +4 ; while
i1: rl w2 x2 ; cte<>addr mcl_entry.next do
sn w2 x1+f95 ; begin
jl. i2. ; release_cte(cte);
al w1 x2-f84 ; cte:=cte.next;
jl. w3 d9. ; end;
rl. w1 j1. ;
jl. i1. ;
i2: dl w1 x1+f96 ;
al. w3 j5. ; /* sæt name base til gemte baser for mcl prog */
jd 1<11+72 ; set_catalog_base(<::>,mcl_entry.name_base);
se w0 0 ;
je -17 ; if result<>ok then fault
rl. w1 j1. ;
al w3 x1+f92 ;
jd 1<11+64 ; remove_process(mcl_entry.name,r);
se w0 0 ; if r<>0 then fault
je -33 ;
rl. w1 j1. ;
al w0 0 ;
rs w0 x1+f91 ; mcl_entry.pda::=0;
rl. w1 (r39.) ;
al w1 x1+1 ; en frie mcltable indgang mere
rs. w1 (r39.) ;
jl. i6. ; end
; else
i3: al w3 0 ; begin
jl. +4 ; n:=0;
i4: rl w2 x2 ; while cte<>addr mcl_entry.next do
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...29...
sn w2 x1+f95 ; begin
jl. i5. ; n:=n+1;
al w3 x3+1 ; cte:=cte.next;
jl. i4. ; end;
i5: sh w3 (x1+f93) ; if n>mcl_entry.users then
jl. i6. ; begin
rl w2 x1+f95 ; cte:=mcl_entry.next;
jl. w3 (r8.) ; remove(cte);
al w1 x2-f84 ; release_cte(cte);
jl. w3 d9. ; end;
i6: dl. w1 j1. ; end;
rl. w2 j2. ; restore w0,w1,w2;
rl. w3 (r0.) ; w3:=curco;
jl. (j3.) ; return;
j0: 0 ; saved w0
j1: 0 ; mcl_entry
j2: 0 ; saved w2
j3: 0 ; saved return
j4: 0 ; cte
j5: 0 ; <::>
e.
; procedure get_mcl_segment(mcl_entry,seg,buf_addr,cte,result);
;
; mcl_entry (call) peger til indgang i mcl program tabellen
; seg (call) segment nummer der skal læses
; buf_addr (return) peger til første hw i corebuffer med
; program side
; cte (return) peger til core tabel indgang
; result (return) =0 ok
; =1 segment nummer for stort
;
; undersøger om et givet mcl program segment er i en corebuffer, hvis ikke
; læses til en fri corebuffer
;
; call return
; w0: result
; w1: mcl_entry cte
; w2: seg buf_addr
; w3: return curco
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...30...
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o3 + 0 ; saved return
q41 = o3 + 2 ; mcl_entry
q42 = o3 + 4 ; seg
q43 = o3 + 6 ; cte
q44 = o3 + 8 ; buf_addr
g14:
d14: rs. w3 j0. ;
rl. w3 (r0.) ; w3:=curco;
ds w2 x3+q42 ; save mcl_entry,seg i cdescr;
c.a88<2
rs. w3 6 ; *** test no 64 **********
jl. w3 (r37.) ; w0 w2 seg
h. 64 , 1<2 w. ; w1 mcl entry w3 curco
0 ;
z.
rl. w0 j0. ;
rs w0 x3+q40 ; save return i cdescr;
sh w2 (x1+f94) ; if seg>mcl_entry.max_segment_no then
jl. i1. ; begin
al w0 1 ; result:=1;
jl. (j0.) ; return;
; end;
i1: rl. w2 r42. ; /******* start kritisk region **************/
jl. w3 (r5.) ; wait_semaphore(coretable_lock);
rl w0 x3+q42 ; w0:=seg;
rl w1 x3+q41 ;
al w1 x1+f95 ; w1:=cte:=addr mcl_entry.next;
rs. w1 j1. ;
al w2 0 ; w2:=n:=0;
i2: rl w1 x1 ; rep: cte:=cte.next;
sn. w1 (j1.) ; if cte= addr mcl_entry.next then
jl. i3. ; goto not_found;
al w2 x2+1 ; n:=n+1;
se w0 (x1-f84+f83); if seg<>cte.segment_no then
jl. i2. ; goto rep;
al w2 x1-f84 ; w2:=cte;
al w1 x2 ; w1:=cte;
ws. w2 (r12.) ; index:=(cte-coretable_base)//8;
ls w2 -3 ;
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...31...
ls w2 9 ; w2:=buf_addr:=
wa. w2 (r15.) ; index*512+corebuffer_base;
ds w2 x3+q44 ;
jl. i5. ; goto found;
i3: rl w1 x3+q41 ; not_found:
sh w2 (x1+f93) ; if n>mcl_entry.users then
jl. i4. ; begin
rl w2 x1+f95 ; cte:=mcl_entry.next;
jl. w3 (r8.) ; remove(cte);
al w1 x2-f84 ;
jl. w3 d9. ; rlease_cte(cte);
; end;
i4: jl. w3 d7. ; get_free_corebuffer(cte,buf_addr,index);
ds w2 x3+q44 ;
rl w1 x3+q43 ;
rl w0 x3+q42 ; cte.segment_no:=seg;
rs w0 x1+f83 ;
al w2 x1+f84 ;
rl w1 x3+q41 ; link(mcl_entry,cte);
al w1 x1+f95 ;
jl. w3 (r9.) ;
al w1 x1-f95 ;
al w2 x2-f84 ;
rx w1 4 ; w1:=cte; w2:=mcl_entry;
al w2 x2+f92 ; segment_io(3,cte,
al w0 3 ; mcl_entry.name);
jl. w3 d10. ;
al w1 0 ;
rl w2 x3+q41 ; w2:= ((mcl_entry-mcltable)
ws. w2 (r24.) ; // mcl_table_length)*2+1;
wd. w2 j2. ;
ls w2 1 ;
al w2 x2+1 ;
rl w1 x3+q43 ;
hs w2 x1+f82 ; cte.type:=w2;
i5: rl. w2 r42. ;found: signal(coretable_lock);
jl. w3 (r2.) ; /******* end kritisk region ****************/
dl w2 x3+q44 ;
jl. w3 d8. ; adjust_prio(cte);
rl. w3 (r0.) ; w3:=curco;
al w0 0 ; result:=0;
jl (x3+q40) ; return;
j0: 0 ; return
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...32...
j1: 0 ; addr mcl_entry.next
j2: f90 ; mcl_entry_length
e.
; procedure next(i);
;
; i (return) index til næste frie indgang
;
; finder næste frie indgang i areatable
;
; call return
; w0: undef.
; w1: i
; w2: undef.
; w3: return unch.
b. i5,j5 w.
g16:
d16: rl. w1 (r22.) ; w1:=ss;
i0: am. (r20.) ; while
am (0) ;
el w0 x1 ; (w0:=areatable(ss))<>2048 do
sh w0 -1 ; begin
jl. i1. ;
al w1 x1+1 ; ss:=ss+1;
sn. w1 (r21.) ; if ss=top_areatable then ss:=0;
al w1 0 ; end;
jl. i0. ;
i1: al w2 x1+1 ; ss:=i+1;
sn. w2 (r21.) ; if ss=top_areatable then ss:=0;
al w2 0 ;
rs. w2 (r22.) ;
c.a88<2
rs. w3 6 ; *** test no 66 **********
jl. w3 (r37.) ; w0 w2
h. 66 , 1<3 w. ; w1 i w3
0 ;
z.
jl x3 ; return
e.
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...33...
; procedure create_spool_area(n,first,result);
;
; n (call) antal segmenter
; first (return) nummer på første segment
; result (return) =0 ok
; =1 ikke frie segmenter nok
;
; opretter et område med n segmenter i tasspool
;
; call return
; w0: n result
; w1: unch.
; w2: first
; w3: return curco
b. i5,j5 w.
g17:
d17: ds. w1 j2. ;
rs. w3 j0. ; save n,w1,return;
rl. w1 (r23.) ;
c.a88<2
rs. w3 6 ; *** test no 67 **********
jl. w3 (r37.) ; w0 n w2
h. 67 , 1<3 w. ; w1 free head w3 return
0 ;
z.
ws w1 0 ; w1:=free-n;
sh w1 -1 ; if w1>=0 then
jl. i3. ; begin
rs. w1 (r23.) ; free:=w1;
al w0 0 ;
rs. w0 (r22.) ; ss:=0;
jl. w3 d16. ; next(first);
rs. w1 j3. ;
rs. w1 j4. ; c:=first;
i1: rl. w2 j1. ; w2:=n;
al w2 x2-1 ; while n-1 > 0 do
sh w2 0 ; begin
jl. i2. ; n:=n-1;
rs. w2 j1. ;
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...34...
jl. w3 d16. ; next(j);
rl. w2 j4. ;
am. (r20.) ; areatable(c):=j;
am (0) ;
hs w1 x2 ; c:=j;
rs. w1 j4. ;
jl. i1. ; end;
i2: rl. w2 j3. ; w2:=first;
rl. w1 j4. ;
am. (r20.) ; areatable(c):=first;
am (0) ;
hs w2 x1 ; result:=0;
am -1 ; end
i3: al w0 1 ; else result:=-1;
rl. w1 j2. ; restore w1;
rl. w3 (r0.) ; w3:=curco;
jl. (j0.) ; return;
j0: 0 ; return
j1: 0 ; n
j2: 0 ; saved w1
j3: 0 ; first
j4: 0 ; c
e.
; procedure remove_spool_area(seg);
;
; seg (call) nummer på segment i området
;
; fjerner et område af segmenter i tasspool
;
; call return
; w0: unch.
; w1: seg unch.
; w2: unch.
; w3: return curco
b. i5,j5 w.
g18:
d18: ds. w1 j1. ;
ds. w3 j3. ; save registers;
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...35...
c.a88<2
rs. w3 6 ; *** test no 68 **********
jl. w3 (r37.) ; w0 w2
h. 68 , 1<3 w. ; w1 seg w3 return
0 ;
z.
i1: am. (r20.) ; s:=seg;
am (0) ;
al w3 x1 ; repeat
el w2 x3 ; next:=areatable(s);
rs. w2 j4. ;
rl. w0 j5. ;
hs w0 x3 ; areatable(s):= 2048;
am. (r19.) ;
am (0) ;
al w3 x1 ;
el w1 x3 ; st:=segmenttable(s);
sh w1 -1 ; if st>=0 then
jl. i2. ; begin
rl. w0 j5. ;
hs w0 x3 ; segmenttable(s):=2048;
ls w1 3 ; cte:=st*8+coretable_base;
wa. w1 (r12.) ; release_cte(cte);
jl. w3 d9. ; end;
i2: rl. w1 (r23.) ;
al w1 x1+1 ; free:=free+1;
rs. w1 (r23.) ; s:=next
rl. w1 j4. ;
se. w1 (j1.) ; until s=seg;
jl. i1. ;
dl. w1 j1. ; restore w0,w1,w2;
rl. w2 j2. ; w3:=curco;
rl. w3 (r0.) ;
jl. (j3.) ; return;
j0: 0 ; saved w0
j1: 0 ; seg
j2: 0 ; saved w2
j3: 0 ; saved return
j4: 0 ; next
j5: 2048 ;
e.
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...36...
; procedure segments_in_spool_area(first,last,seg);
;
; first (call) det ene segment nummer
; last (call) det andet segment nummer
; seg (return) antal segmenter
;
; finder antal segmenter mellem first og last i område på tasspool
;
; call return
; w0: seg
; w1: first unch.
; w2: last unch.
; w3: return curco
b. i5,j5 w.
g19:
d19: rs. w1 j1. ;
ds. w3 j3. ; save registers;
al w0 0 ; seg:=0; w1:=first;
i1: am. (r20.) ; while
am (0) ;
el w2 x1 ; areatable(w1)<>first
se. w2 (j1.) ; and
sn. w2 (j2.) ; areatable(w1)<>last do
jl. i2. ; begin
ba. w0 1 ; seg:=seg+1;
al w1 x2 ; w1:=areatable(w1);
jl. i1. ; end;
i2: dl. w2 j2. ; restore w1,w2;
c.a88<2
rs. w3 6 ; *** test no 69 **********
jl. w3 (r37.) ; w0 seg w2 last
h. 69 , 1<3 w. ; w1 first w3 return
0 ;
z.
rl. w3 (r0.) ; w3:=curco;
jl. (j3.) ; return;
j1: 0 ; first
j2: 0 ; last
j3: 0 ; saved return;
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...37...
e.
; procedure extend_spool_area(after,n,result);
;
; after (call) området udvides efter segment nr. after
; n (call) antal det skal udvides med
; result (return) =0 ok
; =1 ikke frie segmenter nok
;
; call return
; w0: result
; w1: n undef
; w2: after undef
; w3: return curco
b. i5,j5 w.
g20:
d20: rs. w3 j0. ;
ds. w2 j2. ; save registers;
c.a88<2
rs. w3 6 ; *** test no 50 **********
jl. w3 (r37.) ; w0 w2 after
h. 70 , 1<3 w. ; w1 n w3 return
0 ;
z.
rl. w3 (r23.) ;
ws w3 2 ; w3:=free-n;
sh w3 -1 ; if w3>=0 then
jl. i3. ; begin
rs. w3 (r23.) ; free:=w3;
al w3 0 ;
rs. w3 (r22.) ; ss:=0;
am. (r20.) ;
am (0) ;
el w0 x2 ; s:=areatable(after);
rs. w0 j3. ;
i1: sh w1 0 ; while n>0 do
jl. i2. ; begin
al w1 x1-1 ; n:=n-1;
rs. w1 j1. ;
jl. w3 d16. ; next(w1);
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...38...
rl. w2 j2. ;
am. (r20.) ; areatable(after):=w1;
am (0) ;
hs w1 x2 ;
rs. w1 j2. ; after:=w1;
rl. w1 j1. ; end;
jl. i1. ;
i2: dl. w2 j3. ;
am. (r20.) ; areatable(s):=after;
am (0) ;
hs w2 x1 ; result:=0;
am -1 ; end
i3: al w0 1 ; else result:=1;
rl. w3 (r0.) ; w3:=curco;
jl. (j0.) ; return;
j0: 0 ; saved return;
j1: 0 ; n
j2: 0 ; after
j3: 0 ; s
e.
\f
; tas 1.0 14.05.87 Globale routiner gltxt ...39...
; externe variabel, indeholder adresser på varable og routiner
u10:
r37: h. m176 , r0. w. ; e1 registers testout
r0: h. m24 , r1. w. ; c0 curco, current coroutine
r1: h. m18 , r2. w. ; e52 init semaphor
r2: h. m10 , r5. w. ; e20 signal
r5: h. m11 , r6. w. ; e22 wait_semaphor
r6: h. m7 , r7. w. ; e16 csend_message
r7: h. m8 , r8. w. ; e18 cwait_answer
r8: h. m45 , r9. w. ; e3 remove (ud af kæde)
r9: h. m46 , r10. w. ; e4 link (ind i kæde)
r10: h. m21 , r11. w. ; e55 get_buffer
r11: h. m22 , r12. w. ; e57 release_buffer
r12: h. m49 , r13. w. ; c32 coretable_base
r13: h. m50 , r14. w. ; c33 coretable_top
r14: h. m51 , r15. w. ; c34 coretable_size
r15: h. m55 , r16. w. ; c38 corebuffer_base
r16: h. m53 , r17. w. ; c36 current_prio
r17: h. m54 , r18. w. ; c37 free_head
r18: h. m52 , r19. w. ; c35 c_entry (adresse på indgang i coretable)
r19: h. m56 , r20. w. ; c39 segmenttable_base
r20: h. m57 , r21. w. ; c40 areatable_base
r21: h. m58 , r22. w. ; c41 top_areatable
r22: h. m59 , r23. w. ; c42 ss (addr på indgang i areatable)
r23: h. m60 , r24. w. ; c43 free (ubrugte segmenter i tasspool)
r24: h. m61 , r25. w. ; c44 mcltable_base
r25: h. m62 , r26. w. ; c45 top_mcltable
r26: h. m121 , r27. w. ; c57 tas_base (lower,upper)
r27: h. m124 , r28. w. ; c27 ref spoolname (peger til navn på spoolarea)
r28: h. m123 , r32. w. ; c26 <:tascat:>
r32: h. m65 , r33. w. ; c50 tdescr_pool
r33: h. m66 , r34. w. ; c51 used_tdescr
r34: h. m63 , r35. w. ; c46 first_ttda
r35: h. m64 , r36. w. ; c47 top_ttda
r36: h. m122 , r38. w. ; c49 first_ph
r38: h. m234 , r39. w. ; c68 frie corebuffere
r39: h. m235 , r40. w. ; c69 frie mcltable indgange
r40: h. m236 , r41. w. ; c70 frie term type beskrivelser
r41: h. m0 , r42. w. ; e0 testout
r42: h. m243 , r43. w. ; c28 coretable_lock (semaphor)
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...40...
r43: h. m126 , r44. w. ; c52 lock_sem
r44: h. m244 , r45. w. ; e24 g_lock
r45: h. m245 , r46. w. ; e23 g_open
r46: h. m5 , 1 w. ; e12 pass
; extern variable, indeholder adresser på tekster
t1: h. m211 , 1 w. ; t31 <:inlogning stopped:>
t2: h. m212 , 1 w. ; t32 <:max terminals inloged:>
t3: h. m213 , 1 w. ; t33 <:unknown user id:>
t4: h. m214 , 1 w. ; t34 <:wrong password:>
t5: h. m215 , 1 w. ; t35 <:terminal limit:>
t6: h. m216 , 1 w. ; t36 <:used blocked:>
t7: h. m217 , 1 w. ; t37 <:terminal blocked:>
t8: h. m218 , 1 w. ; t38 <:max session exceeded:>
t9: h. m219 , 1 w. ; t39 <:login time exceeded:>
t10: h. m220 , 1 w. ; t40 <:no resources:>
t11: h. m221 , 1 w. ; t41 <:unknown terminal:>
t12: h. m222 , 1 w. ; t42 <:terminal io error:>
t13: h. m223 , 1 w. ; t43 <:terminal timeout:>
t14: h. m224 , 1 w. ; t44 <:- segmenter til spool:>
t15: h. m225 , 1 w. ; t45 <:- mcl program indgange :>
t16: h. m226 , 1 w. ; t46 <:mcl program findes ikke:>
t17: h. m227 , 1 w. ; t47 <:- terminal buffere:>
t18: h. m228 , 1 w. ; t48 <:- cdescr:>
t19: h. m229 , 1 w. ; t49 <:- tdescr:>
t20: h. m230 , 1 w. ; t50 <:session nedlagt:>
t21: h. m242 , 1 w. ; t53 <:-term type beskr:>
t22: h. m254 , 1 w. ; t55 <:bypassed:>
t23: h. m257 , 1 w. ; t57 <:session nedlagt efter timout:>
t24: h. m189 , 0 w. ; t9 <:<10>:>
; end initlist
; procedure cut_spool_area(after,n);
;
; after (call) segmenter skal fjernes efter dette
; n (call) antal segmenter der skal fjernes
;
; fjerner et antal segmenter fra et område på tasspool
;
; call return
; w0: undef
; w1: n undef
; w2: after undef
; w3: return curco
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...41...
b. i5,j5 w.
g21:
d21: rs. w3 j0. ;
ds. w2 j2. ; save registers;
c.a88<2
rs. w3 6 ; *** test no 71 **********
jl. w3 (r37.) ; w0 w2 after
h. 71 , 1<3 w. ; w1 n w3 return
0 ;
z.
am. (r20.) ;
am (0) ;
el w2 x2 ; l:=areatable(first);
al w3 x1 ;
wa. w3 (r23.) ;
rs. w3 (r23.) ; free:=free+n;
rl. w0 j3. ;
i1: sh w1 0 ; while n>0 do
jl. i2. ; begin
al w1 x1-1 ; n:=n-1;
am. (r20.) ;
am (0) ;
al w3 x2 ; j:=areatable(l);
el w2 x3 ; areatable(l):=2048;
hs w0 x3 ; l:=j;
jl. i1. ; end;
i2: rl. w1 j2. ;
am. (r20.) ; areatable(first):=l;
am (0) ;
hs w2 x1 ;
rl. w3 (r0.) ; w3:=curco;
jl. (j0.) ; return;
j0: 0 ; saved return;
j1: 0 ; n
j2: 0 ; after
j3: 2048 ;
e.
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...42...
; procedure move(from,to,n);
;
; from (call) peger til første hw der skal flyttes fra
; to (call) peger til første hw der skal flyttes til
; m (call) antal hw der skal flyttes
;
; kopiere et antal hw fra et sted til et andet
;
;
; call return
; w0: n unch.
; w1: from unch.
; w2: to unch.
; w3: return curco
b. i5,j5 w.
g22:
d22: ds. w1 j1. ; save registers;
ds. w3 j3. ; f:=from; t:=to;
c.a88<2
rs. w3 6 ; *** test no 72 **********
jl. w3 (r37.) ; w0 n w2 to
h. 72 , 1<3 w. ; w1 from w3 return
0 ;
z.
al w3 (0) ; nn:=n;
i1: sh w3 3 ; while nn>=4 do begin
jl. i2. ; word(t):=word(f);
rs. w3 j4. ; word(t+2):=word(f+2);
dl w0 x1+2 ; nn:=nn-4;
ds w0 x2+2 ; t:=t+4;
rl. w3 j4. ; f:=f+4;
al w3 x3-4 ; end;
al w1 x1+4 ;
al w2 x2+4 ;
jl. i1. ;
i2: sh w3 1 ; if nn>=2 then begin
jl. i3. ; word(t):=word(f);
rl w0 x1 ; nn:=nn-2;
rs w0 x2 ; t:=t+2;
al w1 x1+2 ; f:=f+2;
al w2 x2+2 ; end;
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...43...
al w3 x3-2 ;
i3: sn w3 0 ; if nn<>0 then begin
jl. i4. ; hw(t):=hw(f);
zl w0 x1 ; end;
hs w0 x2 ;
i4: dl. w1 j1. ;
rl. w2 j2. ; restore w0,w1,w2;
rl. w3 (r0.) ; w3:=curco;
jl. (j3.) ; return;
j0: 0 ; n
j1: 0 ; from
j2: 0 ; to
j3: 0 ; saved return
j4: 0 ; nn
e.
; procedure write_error(tpda,error_no);
;
; tpda (call) ext process descriptor adresse for terminal
; error_no (call) fejl tekst nummer
;
; Skriver en fejl tekst på en given terminal
;
; call return
; w0: tpda undef.
; w1: error_no undef.
; w2: undef.
; w3: return curco
b. i5,j10 w.
q40 = o1 + 0 ; saved return
g23:
d23: rl. w2 (r0.) ;
rs w3 x2+q40 ;
rs. w0 j1. ; save return,tpda;
c.a88<2
rs. w3 6 ; *** test no 73 **********
jl. w3 (r37.) ; w0 tpda w2 curco
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...44...
h. 73 , 1<2 w. ; w1 error no w3 return
0 ;
z.
ls w1 1 ; txt:=case error_no of (
jl. x1 ;
am t1-t2 ; 1: <:inlogning stopped:>
am t2-t3 ; 2: <:max terminals inloged:>
am t3-t4 ; 3: <:unknown user id:>
am t4-t5 ; 4: <:wrong password:>
am t5-t6 ; 5: <:terminal limit:>
am t6-t7 ; 6: <:used blocked:>
am t7-t8 ; 7: <:terminal blocked:>
am t8-t9 ; 8: <:max session exceeded:>
am t9-t10 ; 9: <:login time exceeded:>
am t10-t11 ; 10: <:no resources:>
am t11-t12 ; 11: <:unknown terminal:>
am t12-t13 ; 12: <:terminal io error:>
am t13-t14 ; 13: <:terminal timeout:>
am t14-t15 ; 14: <:- segmenter til spool:>
am t15-t16 ; 15: <:- mcl program indgange :>
am t16-t17 ; 16: <:mcl program findes ikke:>
am t17-t18 ; 17: <:- terminal buffere:>
am t18-t19 ; 18: <:- cdescr:>
am t19-t21 ; 19: <:- tdescr:>
am t21-t24 ; 20: <:- term type beskr:>
am t24-t20 ; 21: <:<10>:>
am 0 ; 22:
am 0 ; 23:
am 0 ; 24:
am 0 ; 25:
am 0 ; 26:
am 0 ; 27:
am 0 ; 28:
am 0 ; 29:
am t20-t22 ; 30: <:session nedlagt:>
am t22-t23 ; 31: <:bypassed:>
rl. w1 t23. ; 32: <:session nedlagt efter timeout:>);
al w2 x1 ; mes.first:=txt addr + 2;
ba w2 x2 ; mes.last:=txt addr + txt length - 2;
al w1 x1+2 ;
al w2 x2-2 ;
ds. w2 j7. ;
rl. w2 j1. ;
dl w1 x2+4 ; flyt navn på ext proc.
ds. w1 j3. ;
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...45...
dl w1 x2+8 ;
ds. w1 j4. ;
al w0 0 ;
rs. w0 j5. ; clear name table entry
al. w1 j6. ;
al. w2 j2. ;
jl. w3 (r6.) ; csend_message(mes,name,buf);
sh w2 2 ; if buf<2 then fault;
je -12 ;
al w0 0 ;
al. w1 j8. ;
jl. w3 (r7.) ; cwait_answer(buf,0,ans,r);
jl (x3+q40) ; return;
j1: 0 ; saved tpda
j2: 0,r.4 ; terminal navn
j3=j2+2
j4=j2+6
j5: 0 ; name table entry
j6: 5<12+0 ; message
0 ; first
j7: 0 ; last
j8: 0,r.8 ; answer
e.
; procedure corebuf_lock(n);
;
; n (call) antal indgange i coretable der skal reserveres
;
; Proceduren venter på at kunne reservere et antal indgange i coretable
;
; call return
; w0: n undef.
; w1: undef.
; w2: undef.
; w3: return curco
b. i3,j3 w.
q40 = o1 + 0 ; n
q41 = o1 + 2 ; saved return
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...46...
g15:
d15: al w1 x3 ;
rl. w3 (r0.) ;
ds w1 x3+q41 ; save n,return i cdescr;
rl w2 x3+f1 ;
al w2 x2-1 ; prio:=prio-1; /* sæt højere prio */
rs w2 x3+f1 ;
rl. w2 r43. ;
jl. w3 (r44.) ; g_lock(lock_sem,n);
jl (x3+q41) ; return;
e.
; procedure corebuf_open;
;
;
; Proceduren frigiver det antal indgange i coretable, en coroutine har
; reserveret
;
; call return
; w0: unch.
; w1: unch.
; w2: unch.
; w3: return curco
b. i3,j3 w.
q40 = o1 + 0 ; saved w0
q41 = o1 + 2 ; saved w1
q42 = o1 + 4 ; saved w2
q43 = o1 + 6 ; saved return
g24:
d24: rs. w3 j0. ;
rl. w3 (r0.) ;
ds w1 x3+q41 ; save w0,w1,w2,return i cdescr;
rs w2 x3+q42 ;
rl. w0 j0. ;
rs w0 x3+q43 ;
rl w0 x3+f25 ;
rl. w2 r43. ;
jl. w3 (r45.) ; g_open(lock_sem.lock_count);
rl w0 x3+f1 ;
\f
;. tas 1.0 14.05.87 Globale routiner gltxt ...47...
ba. w0 1 ;
jl. w3 (r46.) ; pass(prio+1); /* sæt prio tilbage */
dl w1 x3+q41 ;
rl w2 x3+q42 ; restore w0,w1,w2;
jl (x3+q43) ; return;
j0: 0 ; saved return;
e.
\f
; tas 1.0 14.05.87 terminal routiner gltxt ...48...
;*********************************************************************
;************************ terminal routiner **************************
;*********************************************************************
; procedure new_terminal(tpda,tdescr,term_type);
;
; tpda (call) ext proc addr for terminal
; tdescr (return) terminal beskrivelses adresse
; term_type (call) terminal type
; =0 f8000 ext process
; =1 tty terminal der skal reserveres
; =2 tty terminal der ikke skal reserveres
;
;
; finder ledig terminal beskrivelse og initialisere den.
;
; call return
; w0: term_type undef.
; w1: tdescr, eller 0
; w2: tpda undef.
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o1 + 0 ; tpda
q41 = o1 + 2 ; saved return
q42 = o1 + 4 ; term_type
q43 = o1 + 6 ; tdescr
g25:
d25: rl. w1 (r0.) ;
c.a88<2
rs. w3 6 ; *** test no 75 **********
jl. w3 (r37.) ; w0 term type w2 tpda
h. 75 , 1<2 w. ; w1 curco w3 return
0 ;
z.
ds w3 x1+q41 ;
rs w0 x1+q42 ; save return,term_type,tdpa i cdescr;
rl. w2 (r32.) ;
jl. w3 (r10.) ; get_buffer(tdescr_pool,tdescr);
sn w1 0 ; if tdescr=0 then
jl (x3+q41) ; return;
rs w1 x3+q43 ; /* sæt i user kæden */
\f
;. tas 1.0 14.05.87 terminal routiner gltxt ...49...
rl. w3 r33. ;
rl w0 x3 ; tdescr.next:=used_tdescr;
rs w0 x1+f101 ;
rs w1 x3 ; used_tdescr:=tdescr;
rl. w3 (r0.) ;
al w0 0 ;
rs w0 x1+f102 ; tdescr.head_session:=0;
rs w0 x1+f103 ; tdescr.cur_th:=0;
rs w0 x1+f109 ; tdescr.type:=0;
rs w0 x1+f110 ; tdescr.ttda:=0;
rs w0 x1+f104 ; tdescr.user_id:=0;
rs w0 x1+f114 ; tdescr.sender:=0;
rs w0 x1+f115 ; tdescr.th_stopped:=0;
rs w0 x1+f116 ; tdescr.cth:=0;
rs w0 x1+f104+2 ;
rs w0 x1+f104+4 ;
rs w0 x1+f104+6 ;
rs w0 x1+f105 ; tdescr.cpw:=0;
rs w0 x1+f105+2 ;
al w0 2 ;
rs w0 x1+f113 ; tdescr.s:=2; /* ok */
rl w2 x3+q40 ;
rs w2 x1+f107 ; tdescr.tpda:=tpda;
dl w0 x2+4 ;
ds w0 x1+f108+2 ; tdescr.name:=
dl w0 x2+8 ; process name;
ds w0 x1+f108+6 ;
al w0 0 ;
rs w0 x1+f108+8 ; tdescr.nte:=0;
rl. w3 (r0.) ;
rl w0 x3+q42 ;
al w3 x1+f108 ;
se w0 2 ; if term_type <> 2 then
jd 1<11+8 ; reserve_process(tdescr.name);
rl. w3 (r0.) ;
rl w0 x3+q42 ; if term_type<>0 then
sn w0 0 ; return
jl (x3+q41) ;
al w2 x1+f108 ; /* gem default term spec i tdescr */
al. w1 j0. ; csendmessage(
jl. w3 (r6.) ; tdescr.name, mes, buf);
sh w2 1 ; if buf<2 then
je -12 ; fault
al w0 0 ;
rl w1 x3+q43 ;
al w1 x1+f111 ; cwaitanswer(
jl. w3 (r7.) ; buf,0,tdescr.termspec,r);
\f
;; tas 1.0 14.05.87 terminal routiner gltxt ...49a...
\f
;. tas 1.0 14.05.87 terminal routiner gltxt ...50...
rl w1 x3+q43 ;
sn w0 1 ; if r<>1 then
jl. i1. ; begin /* frigiv terminal beskrivelse */
rl w0 x1+f101 ; used_tdescr:=tdescr.next;
rs. w0 (r33.) ; pool:=tdescr_pool;
rl. w2 (r32.) ; release_buffer(tdescr_pool,tdescr);
jl. w3 (r11.) ; tdescr:=0;
al w1 0 ; end
jl. i2. ; else
i1: rl w2 x1+f111+2 ; begin
rs w2 x1+f112 ; tdescr.saved_type:=descr.term spec type;
ls w2 -10 ; tdescr.term spec type:=2;
ls w2 10 ; end;
al w2 x2+2 ;
rs w2 x1+f111+2 ;
rl. w2 j1. ;
rs w2 x1+f111 ; tdescr.termspec.opcode:=opcode for set term spec;
i2: jl (x3+q41) ; return;
j0: a5<12+0 ; get term spec
j1: a6<12+0 ; set term spec
e.
; procedure search_th(tpda,th);
;
; tpda (call) terminalens ext proc addr
; th (return) th's cda eller 0
;
; søger efter en th der er tilknyttet en terminal
;
; call return
; w0: unch.
; w1: th eller 0
; w2: tpda unch.
; w3: return curco
b. i5,j5 w.
g26:
d26: rs. w3 j0. ; save return;
rs. w0 j5. ; save w0;
dl w1 x2+4 ; hent navn fra ext process
\f
;. tas 1.0 14.05.87 terminal routiner gltxt ...51...
ds. w1 j2. ;
dl w1 x2+8 ;
ds. w1 j4. ;
rl. w1 (r33.) ; w1:=used_descr;
jl. 4 ;
i1: rl w1 x1 ; rep: w1:=next(w1);
sn w1 0 ; if w1=0 then goto exit;
jl. i2. ; if extern process navn
dl w0 x1+f108+2 ; <> w1.name then
sn. w3 (j1.) ; goto rep;
se. w0 (j2.) ;
jl. i1. ;
dl w0 x1+f108+6 ;
sn. w3 (j3.) ;
se. w0 (j4.) ;
jl. i1. ;
rl w1 x1+f103 ;
i2:
c.a88<2
rs. w3 6 ; *** test no 76 **********
jl. w3 (r37.) ; w0 w2 tpda
h. 76 , 1<2 w. ; w1 th eller 0 w3 return
0 ;
z.
rl. w3 (r0.) ; exit:
rl. w0 j5. ; restore w0;
jl. (j0.) ; return;
j0: 0 ; saved return
j1: 0 ; navn på extern processen
j2: 0 ; -
j3: 0 ; -
j4: 0 ; -
j5: 0 ; saved w0
e.
; procedure put_in_session(tdescr,th);
;
; tdescr (call) terminal beskrivelses adresse
; th (call) cda for th
;
; indsætter en terminal handler coroutine beskrivelse i en terminal
; beskrivelses sessions kæde.
\f
;. tas 1.0 14.05.87 terminal routiner gltxt ...52...
;
; call return
; w0: undef.
; w1: tdescr unch.
; w2: th unch.
; w3: return curco
b. i5,j5 w.
g27: rs. w3 j0. ; save return;
rl w0 x1+f102 ; th.tbuf.next_session:=
c.a88<2
rs. w3 6 ; *** test no 77 **********
jl. w3 (r37.) ; w0 next w2 th
h. 77 , 1<3 w. ; w1 tdescr w3 return
0 ;
z.
rs w0 x2+q60 ; tdescr.head_session;
rs w2 x1+f102 ; tdescr.head_session:=th;
rs w1 x2+q62 ; th.tbuf.tdescr:=tdescr;
rl. w3 (r0.) ;
jl. (j0.) ; return;
j0: 0 ; saved return
e.
; procedure get_from_session(th,nxt,old_cur);
;
; th (call) cda for th
; nxt (return) cda for næste i sessions kæden, eller 0
; old_cur (return) værdi af tdescr.cur_th ved indhop
;
; hægter en th ud af en sessions kæde. Når sidste hægtes ud
; nedlægges terminal beskrivelsen.
;
; call return
; w0: old tdescr.cur_th
; w1: th unch.
; w2: nxt eller 0
; w3: return curco
\f
;. tas 1.0 14.05.87 terminal routiner gltxt ...53...
b. i8,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o1 + 0 ; saved return
q41 = o1 + 2 ; th
q42 = o1 + 4 ; nxt
q43 = o1 + 6 ; tdescr
q44 = o1 + 8 ; old_cur
g28:
d28: al w0 x3 ;
rl. w3 (r0.) ;
rs w0 x3+q40 ; save return;
rs w1 x3+q41 ; save th;
rl w2 x1+q62 ; tdescr:=th.tbuf.tdescr;
c.a88<2
rs. w3 6 ; *** test no 78 **********
jl. w3 (r37.) ; w0 w2 tdescr
h. 78 , 1<3 w. ; w1 th w3 curco
0 ;
z.
al w2 x2+f102 ; unlink_from_session(
jl. w3 d29. ; tdescr.head_session,th);
al w2 x2-f102 ;
rl w0 x2+f103 ; w0:=tdescr.cur_th;
rl. w3 (r0.) ;
rs w0 x3+q44 ; gem tdescr.cur_th;
rl w3 x2+f102 ; w3:=tdescr.head_session;
se w0 x1 ; if tdescr.cur_th=th then
jl. i1. ; tdescr.cur_th:=tdescr.head_session;
rs w3 x2+f103 ;
al w0 x3 ;
i1: rl. w1 (r0.) ;
rs w0 x1+q42 ; nxt:=tdescr.cur_th;
se w3 0 ; if tdescr.head_session=0 then
jl. i5. ; begin
rl. w3 (r0.) ;
rl w1 x3+q41 ;
rl w0 x1+f21 ; if th.state.f8000_type=0 then
sz. w0 (j0.) ; begin
jl. i6. ;
rs w2 x3+q43 ;
rl w0 x2+f112 ; /* sæt term_spec i tdescr tilbage */
\f
;. tas 1.0 14.05.87 terminal routiner gltxt ...54...
rs w0 x2+f111+2 ;
al w1 x2+f111 ;
al w2 x2+f108 ; csendmessage(tbuf.tdescr.termspec,
jl. w3 (r6.) ; tbuf.tdescr.name,buf);
sh w2 2 ; if buf<2 then
je -12 ; fault;
al w1 x3+q8 ;
al w0 0 ;
jl. w3 (r7.) ; cwaitanswer(buf,0,ans,r);
rl w2 x3+q43 ; end;
i6: al w0 0 ; /* frigiv terminal type */
rs w0 x2+f107 ; tdescr.tpda:=0;
rl w3 x2+f110 ;
sn w3 0 ; ttda:=tdescr.ttda;
jl. i2. ; if ttda<>0 then begin
rl w1 x3+f122 ; ttda.users:=ttda.users-1;
al w1 x1-1 ; if ttda.users=0 then
rs w1 x3+f122 ; en fri indgang mere
rl. w3 (r40.) ; end;
al w3 x3+1 ;
sn w1 0 ;
rs. w3 (r40.) ; /* frigiv terminal beskrivelse */
i2: al w1 x2 ; w1:=tdescr;
al w3 x2+f108 ;
rl. w2 (r0.) ;
rl w2 x2+f21 ;
sz. w2 (j2.) ; if ikke nologin terminal then
jl. i7. ; begin
jd 1<11+10 ; release_process(tdescr.name);
so. w2 (j1.) ; if th.state.link_created=0 then
jd 1<11+64 ; remove process(tdescr.name);
; end;
i7: rl. w2 (r33.) ; next:=used_tdescr;
al w3 0 ; prev:=0;
i3: sn w2 x1 ; while next<>tdescr do
jl. i4. ; begin
al w3 x2 ; prev:=next;
rl w2 x2+f101 ; next:=next.next;
jl. i3. ; end;
i4: rl w0 x1+f101 ; w0:=tdescr.next;
se w3 0 ; if prev<>0 then
rs w0 x3+f101 ; prev.next:=tdescr.next;
sn w3 0 ; if prev=0 then
rs. w0 (r33.) ; used_tdescr:=tdescr.next;
rl. w2 (r32.) ;
jl. w3 (r11.) ; release_buffer(tdescr_pool,tdescr);
i5: rl. w3 (r0.) ; end;
\f
;. tas 1.0 14.05.87 terminal routiner gltxt ...55...
rl w0 x3+q44 ; w0 old_cur;
dl w2 x3+q42 ; w3:=curco;
jl (x3+q40) ; return;
j0: p21 ; state.f8000_type
j1: p20 ; state.link_created
j2: p23 ; state.nologin
e.
; procedure unlink_from_session(head,t);
;
; head (call) peger til første i kæden
; t (call) peger til element der skal ud
;
; hægter et element ud af en sessions kæde
;
; call return
; w0: undef.
; w1: t unch.
; w2: head unch.
; w3: return curco
b. i9,j5 w.
g29:
d29: rs. w3 j0. ; save return;
rs. w2 j1. ; save head;
al w3 0 ; prev:=0;
rl w2 x2 ; next:=word(head);
i1: sn w2 x1 ; while t<>next do
jl. i2. ; begin
al w3 x2 ; prev:=next;
rl w2 x2+q60 ; next:=next.next_session;
jl. i1. ; end;
i2: rl w0 x2+q60 ; q:=next.next_session;
rl. w2 j1. ;
se w3 0 ; if prev<>0 then
rs w0 x3+q60 ; prev.next_session:=q;
sn w3 0 ; if prev<>0 then
rs w0 x2 ; head:=q;
c.a88<2
rs. w3 6 ; *** test no 79 **********
jl. w3 (r37.) ; w0 prev.next_session w2
\f
;. tas 1.0 14.05.87 terminal routiner gltxt ...56...
h. 79 , 1<3 w. ; w1 w3 prev
0 ;
z.
rl. w3 (r0.) ; w3:=curco;
jl. (j0.) ; return;
j0: 0 ; saved return
j1: 0 ; head
e.
; procedure get_term_data(type,ttda);
;
; type (call) typen der søges efter
; ttda (return) peger til terminal type beskrivelse, eller 0
;
; søger efter en terminal type beskrivelse med given type, hvis den
; ikke findes allokeres en fri og data hentes fra tascat
;
; call return
; w0: type undef.
; w1: ttda eller 0
; w2: undef.
; w3: return curco
b. i10,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o1 + 0 ; saved return
q41 = o1 + 2 ; ttda
q42 = o1 + 4 ; type
g30:
d30: rl. w2 (r0.) ;
c.a88<2
rs. w3 6 ; *** test no 80 **********
jl. w3 (r37.) ; w0 type w2 curco
h. 80 , 1<3 w. ; w1 w3 return
0 ;
z.
rs w3 x2+q40 ; save return i cdescr;
\f
;. tas 1.0 14.05.87 terminal routiner gltxt ...57...
rs. w0 j3. ; mes.type:=type;
rs w0 x2+q42 ; save type i cdescr;
rl. w1 (r34.) ; ttda:=first_ttda;
i0: am. (r35.) ;
sl w1 (0) ; while ttda<top_ttda do
jl. i2. ; begin
se w0 (x1+f121) ; if ttda.type=type then
jl. i1. ; begin
rl w2 x1+f122 ; ttda.users:=ttda.users+1;
al w2 x2+1 ;
rs w2 x1+f122 ;
rl. w0 (r40.) ; if ttda.users=1 then
bs. w0 1 ; en mindre fri indgang
sn w2 1 ;
rs. w0 (r40.) ; goto end_get;
jl. i7. ; end;
i1: al w1 x1+f120 ; ttda:=ttda+ttda_length;
jl. i0. ; end;
; /* ikke fundet, find fri */
i2: rl. w1 (r34.) ; ttda:=first_ttda;
i3: am. (r35.) ;
sl w1 (0) ; while ttda<top_ttda do
jl. i4. ; begin
rl w0 x1+f122 ; if ttda.users=0 then
sn w0 0 ; goto free_found;
jl. i5. ; ttda:=ttda+ttda_length;
al w1 x1+f120 ; end;
jl. i3. ; /* ingen fri */
i4: al w1 0 ; ttda:=0;
jl. i7. ; goto end_get;
i5: rl. w3 (r0.) ; free_found: /* hent terminal data fra tascat */
rs w1 x3+q41 ; save ttda i cdescr;
al w1 x1+f123 ; mes.first:=ttda+4;
al w2 x1+f120-f123 ;mes.last:=ttda+ttda_length-4;
ds. w2 j2. ;
al. w1 j0. ;
rl. w2 r28. ; csendmessage(mes,
jl. w3 (r6.) ; <:tascat:>,buf);
sh w2 1 ; if buf<2 then fault;
je -12 ;
al w0 0 ;
al. w1 j4. ; cwaitanswer(buf,0,ans,r);
\f
;. tas 1.0 14.05.87 terminal routiner gltxt ...58...
jl. w3 (r7.) ;
se w0 1 ; if r<>1 then fault;
je -15 ;
rl. w0 j4. ; if ans.result<>0 then
sn w0 0 ; begin
jl. i6. ; ttda:=0;
al w1 0 ; goto end_get;
jl. i7. ; end;
i6: rl w0 x3+q42 ;
rl w1 x3+q41 ;
rs w0 x1+f121 ; ttda.type:=type;
al w0 1 ;
rs w0 x1+f122 ; ttda.users:=1;
rl. w0 (r40.) ;
bs. w0 1 ; en mindre fri indgang
rs. w0 (r40.) ;
i7: rl. w3 (r0.) ; end_get:
jl (x3+q40) ; return
j0: 9<12+7 ; mes: opcode i get terminal data
j1: 0 ; first
j2: 0 ; last
j3: 0 ; type
j4: 0,r.8 ; answer area
e.
; procedure link_th(ph,th);
;
; ph (call) pool handler cda
; th (call) terminal nadler cda
;
; indsætter en th i en pool kæde
;
; call return
; w0: undef.
; w1: th unch.
; w2: ph unch.
; w3: return curco
b. i5,j5 w.
\f
;. tas 1.0 14.05.87 terminal routiner gltxt ...59...
g31:
d31: rs. w3 j0. ; save return;
c.a88<2
rs. w3 6 ; *** test no 81 **********
jl. w3 (r37.) ; w0 w2 ph
h. 81 , 1<2 w. ; w1 th w3 return
0 ;
z.
rl w0 x2+q3 ; th.next_th:=
rs w0 x1+q6 ; ph.pool_head;
rs w1 x2+q3 ; ph.pool_head:=th;
rs w2 x1+q5 ; th.ph:=ph;
rl. w3 (r0.) ;
jl. (j0.) ; return;
j0: 0 ; saved return;
e.
; procedure unlink_th(ph,t);
;
; ph (call) pool handler cda
; t (call) terminal handler cda
;
; hægter en terminal handler corouitne beskrivelse ud af en pool kæde
;
; call return
; w0: undef.
; w1: t unch.
; w2: ph unch.
; w3: return curco
b. i5,j5 w.
g32:
d32: rs. w3 j0. ; save return;
rs. w2 j1. ; save ph;
c.a88<2
rs. w3 6 ; *** test no 82 **********
jl. w3 (r37.) ; w0 w2 ph
h. 82 , 1<2 w. ; w1 t w3 return
0 ;
z.
\f
;. tas 1.0 14.05.87 terminal routiner gltxt ...60...
al w3 0 ; prev:=0;
rl w2 x2+q3 ; next:=ph.pool_head;
i1: sn w2 x1 ; while t<>next do
jl. i2. ; begin
al w3 x2 ; prev:=next;
rl w2 x2+q6 ; next:=next.next_th;
jl. i1. ; end;
i2: rl w0 x2+q6 ; q:=next.next_th;
rl. w2 j1. ;
se w3 0 ; if prev<>0 then
rs w0 x3+q6 ; prev.next_th:=q;
sn w3 0 ; if prev<>0 then
rs w0 x2+q3 ; ph.pool_head:=q;
al w0 0 ;
rl w3 x1+q101 ; if t.ident = ph.f8000_ident then
sn w3 (x2+f14) ; ph.f8000_ident := 0;
rs w0 x1+q101 ;
rs w0 x1+q6 ; t.next_th:=0;
rs w0 x1+q5 ; t.ph:=0;
rl. w3 (r0.) ; w3:=curco;
jl. (j0.) ; return;
j0: 0 ; saved return
j1: 0 ; head
e.
; procedure link_ph(ph);
;
; ph (call) pool handler cda
;
; indsætter en ph i kæden af pool handlere
;
; call return
; w0: undef.
; w1: ph unch.
; w2: unch.
; w3: return curco
b. i5,j5 w.
g33:
d33: rs. w3 j0. ; save return;
rl. w0 (r36.) ; ph.next_ph:=first_ph;
c.a88<2
rs. w3 6 ; *** test no 83 **********
\f
;. tas 1.0 14.05.87 terminal routiner gltxt ...61...
jl. w3 (r37.) ; w0 first_ph w2
h. 83 , 1<2 w. ; w1 ph w3 return
0 ;
z.
rs w0 x1+q2 ;
rs. w1 (r36.) ; first_ph:=ph;
rl. w3 (r0.) ;
jl. (j0.) ; return;
j0: 0 ; saved return;
e.
; procedure unlink_ph(t);
;
; t (call) pool handler cda
;
; hægter en pool handler ud af poll handler kæden
;
; call return
; w0: undef.
; w1: t unch.
; w2: unch.
; w3: return curco
b. i5,j5 w.
g34:
d34: rs. w3 j0. ; save return;
al w3 0 ; prev:=0;
rl. w2 (r36.) ; next:=word(first_ph);
c.a88<2
rs. w3 6 ; *** test no 84 **********
jl. w3 (r37.) ; w0 w2 first_ph
h. 84 , 1<2 w. ; w1 t w3 return
0 ;
z.
i1: sn w2 x1 ; while t<>next do
jl. i2. ; begin
al w3 x2 ; prev:=next;
rl w2 x2+q2 ; next:=next.next_ph;
jl. i1. ; end;
i2: rl w0 x2+q2 ; q:=next.next_ph;
\f
;. tas 1.0 14.05.87 terminal routiner gltxt ...62...
se w3 0 ; if prev<>0 then
rs w0 x3+q2 ; prev.next_ph:=q;
sn w3 0 ; if prev<>0 then
rs. w0 (r36.) ; first_ph:=q;
rl. w3 (r0.) ; w3:=curco;
jl. (j0.) ; return;
j0: 0 ; saved return
e.
; procedure disconnect_terminal(th);
;
; th (call) cda for th der ejer terminalen
;
; Nedlægger en terminal extern proces der hører til en th, og
; sender en disconnect terminal message til TAS
;
; call return
; w0: undef
; w1: th unch.
; w2: undef
; w3: return curco
b. i8,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o1 + 0 ; saved return
q41 = o1 + 2 ; th
q42 = o1 + 4 ; tdescr
g35:
d35: al w0 x3 ;
rl. w3 (r0.) ;
rs w0 x3+q40 ; save return;
rs w1 x3+q41 ; save th;
rl w2 x1+q62 ; tdescr:=th.tbuf.tdescr;
c.a88<2
rs. w3 6 ; *** test no 92 **********
jl. w3 (r37.) ; w0 w2 tdescr
h. 92 , 1<2 w. ; w1 th w3 curco
0 ;
z.
rl w0 x1+f21 ; th.state.term_removed:=1;
lo. w0 j0. ;
rs w0 x1+f21 ;
rs w2 x3+q42 ;
rl w0 x2+f112 ; /* byt indhold af f112 og f111+2 */
rx w0 x2+f111+2 ;
rs w0 x2+f112 ;
al w1 x2+f111 ;
al w2 x2+f108 ; csendmessage(tbuf.tdescr.termspec,
jl. w3 (r6.) ; tbuf.tdescr.name,buf);
sh w2 2 ; if buf<2 then
je -12 ; fault;
al w1 x3+q8 ;
al w0 0 ;
jl. w3 (r7.) ; cwaitanswer(buf,0,ans,r);
rl w2 x3+q42 ; w2 -> th.tbuf.tdescr;
rl w0 x2+f111+2 ; /* byt tilbage igen */
rx w0 x2+f112 ;
rs w0 x2+f111+2 ;
al w3 x2+f108 ;
jd 1<11+10 ; release_process(tdescr.name);
jd 1<11+64 ; remove process(tdescr.name);
rl. w3 (r0.) ;
al w1 x3+q66 ; w1 -> mes
rl. w0 j1. ; mes.opmode:=9 shift 12 + 8;
rs w0 x1 ;
rl w0 x2+f107 ;
rs w0 x1+2 ; mes.tpda:=th.tbuf.tdescr.tpda;
ac w0 (0) ; /* marker disconnected med -tpda i tdescr */
rs w0 x2+f107 ; tdescr.tpda:=-tdescr.tpda;
rl w0 x2+f106 ;
rs w0 x1+6 ; mes.uid:=th.tbuf.tdescr.uid;
rl w0 x3+q41 ; mes.th := th;
rs w0 x1+4 ;
rl. w2 r28. ; csendmessage(mes,
jl. w3 (r6.) ; <:tascat:>,buf);
sh w2 1 ; if buf < 2 then
je -12 ; fault;
al w1 x3+q8 ;
al w0 0 ; cwaitanswer(buf,
jl. w3 (r7.) ; 0,ans,r);
se w0 1 ; if r<>1 then
je -18 ; fault;
rl w0 x3+q8 ; if ans.result>2 then
sl w0 3 ; fault;
je -18 ;
rl. w3 (r0.) ;
rl w1 x3+q41 ; w3:=curco; w1:=th;
jl (x3+q40) ; return;
j0: p3 ; state.term_removed
j1: 9<12 + 8
e.
; procedure connect_terminal(th,tpda);
;
; th (call) cda for th der ejer terminalen
; tpda (call) ny tpda for terminal
;
; Forbinder en terminal extern proces til en th
; og sender en terminal restart message til TAS
;
; call return
; w0: undef
; w1: th unch.
; w2: tpda undef
; w3: return curco
b. i8,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o1 + 0 ; saved return
q41 = o1 + 2 ; th
q42 = o1 + 4 ; tdescr
q43 = o1 + 6 ; tpda
g36:
d36: al w0 x3 ;
rl. w3 (r0.) ;
rs w0 x3+q40 ; save return;
rs w2 x3+q43 ; save tpda
rs w1 x3+q41 ; save th;
rl w2 x1+q62 ; tdescr:=th.tbuf.tdescr;
c.a88<2
rs. w3 6 ; *** test no 93 **********
jl. w3 (r37.) ; w0 w2 tdescr
h. 93 , 1<2 w. ; w1 th w3 curco
0 ;
z.
al w1 x3+q66 ; w1 -> mes
rl. w0 j1. ; mes.opmode:=9 shift 12 + 9;
rs w0 x1 ;
rl w0 x3+q43 ;
rs w0 x1+4 ; mes.new_tpda := tpda;
rx w0 x2+f107 ; t:=-th.tbuf.tdescr.tpda;
ac w0 (0) ; th.tbuf.tdescr.tpda:=tpda;
rs w0 x1+2 ; mes.old_tpda:=t; /* den gamle */
rl w0 x2+f106 ;
rs w0 x1+6 ; mes.uid:=th.tbuf.tdescr.uid;
rl w0 x3+q43 ; mes.new_tpda := tpda;
rs w0 x1+4 ;
rl. w2 r28. ; csendmessage(mes,
jl. w3 (r6.) ; <:tascat:>,buf);
sh w2 1 ; if buf < 2 then
je -12 ; fault;
al w1 x3+q8 ;
al w0 0 ; cwaitanswer(buf,
jl. w3 (r7.) ; 0,ans,r);
se w0 1 ; if r<>1 then
je -18 ; fault;
rl w0 x3+q8 ; if ans.result>2 then
sl w0 3 ; fault;
je -18 ;
rl. w3 (r0.) ;
rl w1 x3+q41 ; w3:=curco; w1:=th;
jl (x3+q40) ; return;
j1: 9<12 + 9
e.
c.-1
l11:
z.
e. ; end block med extern r-navne
▶EOF◀