|
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: 246528 (0x3c300)
Types: TextFile
Names: »thtxt «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦40b1eb8cd⟧
└─⟦this⟧ »thtxt «
\f
; tas 1.0 14.05.87 terminal handler thtxt ...1...
; @(#)thtxt 1.10 (RC International) 3/12/91
;
;********************************************************************
;************************* TERMINAL HANDLER *************************
;********************************************************************
;
; Terminal access system for rc8000 - A/S Regnecentralen
; Erik Poulsen
; Revisions historie
;
; 87.01.15 release til betatest
;
; 87.02.25 side 20 : ret at tas gik ned når link til ikke aktiv session
; blev fjernet
; side 24 : send logout text til mtty pool når session fjernes
; fra sm med -
; side 48 : ret fejl ved afsendelse af har error text på mtty
; side 81f: ret i get_text_addr så kun var sub i tekster
; side 113: fjern je -99 ved ukendt opcode i mclprog
; side 122: ret så ph link reserveres når login tekst sendes
; side 122: ret så ph link reserveres når logout tekst sendes
; side 125: ret så mcl 'read <> q' ikke læser sp for meget
; side 133: ret så ph link reserveres når mcl send sender til link
;
; 87.03.02 side 48 : ret så input hvor der ikke er er læst ikke returneres
; ved sessionsskift
; 87.03.04 side 125: ny tekst ved timout i read
; side 138: ny tekst ved timout i menu
; side 47 : ret fejl ved send_att i state
; 87.03.10 side 57 : set i cmcl så antal ord i teksten ikke bruges
; 87.03.11 side 57 : ret i answer_input så proceduren returnerer med
; parameter der siger om link er fjernet, også rettet
; alle steder answer_input kaldes fra siderne 49, 53,
; 59-60, 122, 123, 133
;
; 87.03.30 side 23f: test sidste ord i term spec ikke ændres ved sessionskift
; 87.04.06 side 65f: ret i term_send_wait så der ikke sendes att fra th uden m
; 87.04.06 size 47 : ignore svar på input hvis state.sim_input=1
; side 53 : slet state.sim_input når sim_input operation modtages
;
; side 48 : fjern ikke att bit i status i answer på input hvis
; th er uden mcl
; side 75 : indsæt ny procedure send_text
;
; side 24 : afsendelse af out text flyttet til d37
\f
;; tas 1.0 14.05.87 terminal handler thtxt ...1a...
; side 44 : i procedure direct test på hard error efter input og outpu
; side 50 : proceduren output_op ændret til at returnere status
; side 125: test hard errorefter in_text
; side 130: test hard error efter output_op
; side 131: test hard error efter output_op
; side 138: test hard error efter rd_char
; 87.04.10 side 65 : att fjernes ikke fra status i th uden mcl
; 87.05.11 side 32f: ny fejludskrift fra create_user ved att fra terminal
;
; 87.05.14 release 1.0
;
; 87.08.13 side 82 : get text addr rettet, ingen var.subst i variable
; (kunne give break 50)
; 87.08.14 release 1.1
;
; 88.01.08 side 68ff nu test på bypass før terminal type hentes
; og link_created slettes ved fejludhop
; side 68 nyt felt i terminal beskrivelse -mode-
; hvis <>0 sendes set attribute til terminal (canonical)
; side 117 nu kan der ikke sendes attention til own process
;
; 88.02.25 Ret alle steder hvor state.type hentes fra state, 15 -> p39
; 88.02.26 side 145 Sæt state.finis før fejludskrift skrives
; 88.03.16 side 47 input med status timeout returneres hvis der er læst
; 88.03.17 side 40 i terminate_th besvares evt. remove th letter
;
; 88.03.17 release 1.2
;
; 88.08.30 side 30 fejl i remove_th_link rettet, forkert test på at
; sidste i kæden blev fjernet. (q2 -> q3)
;
; 88.10.05 side 90 test indsat i c_outtext så first <= last i output
; message. (kan ske hvis cursor seq. i terminal type
; beskrivelse kun består af 0'er).
; Fejlen først opdaget på GI.
; 88.10.20 side 90 bøf i sidste rettelse fundet og rettet
;
; 88.10.27 side 25 ks -600 fjernet
;
; 89.02.22 side 69 test på bypass rettet, nu kun en bit
;
; 89.05.19 side 69 sæt nologin i th.state hvis terminal er nologin
;
; 89.08.24 side 47 Om igen! read returneres ikke før timeout er udlæbet
; uanset om der er læst tegn
;
; 89.08.24 side 47 timeout beregninger rettet.
;
; 89.10.05 side 46ff en input til en mtty hvor 1<6 er sat i mode
; og som afsluttes med buffer fuld
; og som ikke afsluttes med nl, får ikke sat en nl på
;
; 89.10.05 side 67 ny jump tabel indsat
;
; 89.10.06 side 64 term_send_wait ændret så 1 shift result sættes
; i tbuf.status, (fundet ved fejl hos pensam)
;
; 89.10.18 side 75ff ret fejl i send_text, 2 steder am. til am
; antal hw afh. af out som antal ch
; length parametren til put_op rettes til hw+14
;
; 89.10.31 side 64 tidligere rettelse i term_send_wait var ikke god
; vi prøver igen
;
; 89.10.31 ks 800 804 i input_op
; ks 301 i term_send_wait
;
; 89.11.09 rettelsen i term_send_wait var ikke god,
; rettet i input_op, f8000_input så s returneres,
; rettet i direct så test på hard error bruger s
;
; 89.11.09 rettelsen 10.05 kan ikke bruges (ikke bagud kompatibel)
; ny op.opcode (64+3) har samme virkning.
; output_op rettet så s returneres (ikke tbuf.status)
;
; 89.11.10 Test på hard error ændret, så 1<12 også er hard error
; side 44 : i direct() test på hard error efter input og outpu
; side 50 : proceduren output_op ændret til at returnere status
; side 125: test hard errorefter in_text
; side 130: test hard error efter output_op
; side 131: test hard error efter output_op
; side 138: test hard error efter rd_char
;
; 90.01.19 side 75b: fejl i send_text() rettet, kunne overskrive -1 der
; afslutter operation, kan give break 6. Set hos
; SPS og Kgl.B.
;
; 90.02.06 testoutput ændret
;
; 90.02.06 side 46: output_op ændret så hvis indlæsning er blevet fortsat
; (buffer ikke fuld og ikke afsluttet med nl, og der
; er bedt om det med message) compresses teksten så
; nultegn fjernes.
;
; 90.08.24 side 58: answer input operation udvides med 2
; ord der indeholder timestamp.
;
; 90.09.26 side 75: answer input med hard_error rettet så operation
; indeholder timestamp.
;
; 90.09.27 side 47: DET GAMLE SPØGELSE ER FANGET; output af buffer
; med et ord med nl, og efterfølgende input af
; tom buffer, fx ved Ctrl ø på terminal, bevirker
; at input besvares med et ord der indeholder
; localid. (dette vedrører kun mtty). Fejlen rettes
; ved at sætte 0 i første ord af tbuf.
;
; 90.10.02 release 2.3
;
; 90.10.09 side : Hvis input afbrydes af attention og 1<6 i mode,
; (dvs. efter 192 shift 12 message til pool),
; repeteres input, uden at sende status att i svar
; på input. Fejlen rettet.
;
; 90.08.10 ks -xxx fjernet
;
; temp testpunkter (800 - 899)
;;
\f
; tas 1.0 14.05.87 rcmenu thtxt ...2...
;
; TH coroutinen består af følgende routiner
;
; d1 get_abs
; d2 push
; d3 pop
; d4 create_mcl_variable
; d5 var_addr
; d6 alloc_var
; d7 delete_var
; d8 set_var
; d9 wait
; d10 wait_op
; d11 wait_term
; d12 tascat_mes
; d13 send_attention
; d14 remove_ph
; d15 remove_th_link
; d16 create_user
; d17 create_ph
; d18 mcl_exit
; d19 terminate_th
; d20 direct
; d21 input_op
; d22 output_op
; d23 sim_input
; d24 ctrl_op
; d25 cont_mcl
; d26 answer_input
; d27 f8000_input
; d28 send_f8000
; d29 f8000_read
; d30 term_send_wait
; d31 signon
; d32 write_to_from
; d33 get_mcl_var
;
; d35 unlock_mcl_var
; d36 gen_localid
; d37 send_text
;
; d40 init_td
; d41 c_read
; d42 c_write
; d43 get_text_addr
\f
;. tas 1.0 14.05.87 rcmenu thtxt ...3...
; d44 compare_text
; d45 move_text
; d46 outtext
; d47 c_outtext
; d48 write
; d49 erase
; d50 cursor
; d51 in_text
; d52 rd_char
; d53 read_password
; d54 strip_nl
; d55 strip_sp
;
; d60 run_mcl
; d61 u31 entry point
\f
; tas 1.0 14.05.87 terminal handler thtxt ...4...
b. d99, r250, t20, o13 ; begin terminal handler coroutine
w.
m.terminal handler thtxt 1.10
c.-1
l12:
z.
; routinerne i th coroutinen bruger lokale variable i coroutine
; beskrivelsen, variabel oprådet er delt i 12 niveauer
; relativ start adresse i coroutine beskrivelse for hvert niveau
; er givet ved o-navne
o1 = q36 ; start niveau 1
o2 = o1 + 8 ; start niveau 2
o3 = o2 + 8 ; start niveau 3
o4 = o3 + 30 ; start niveau 4
o5 = o4 + 10 ; start niveau 5
o6 = o5 + 6 ; start niveau 6
o7 = o6 + 6 ; start niveau 7
o8 = o7 + 14 ; start niveau 8
o9 = o8 + 14 ; start niveau 9
o10 = o9 + 4 ; start niveau 10
o11 = o10 + 4 ; start niveau 11
o12 = o11 + 44 ; top niveau 11
q192 = o12 - o1; stack size
\f
; tas 1.0 14.05.87 terminal handler thtxt ...5...
; procedure get_abs(addr,rel);
;
; addr (return) abs adresse
; rel (call) relativ adresse
;
; finder den absolutte adresse i en corebuffer som svarer til en relativ
; mcl adresse
;
; call return
; w0: undef
; w1: undef
; w2: rel addr eller -1
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o1 + 0 ; saved return
q41 = o1 + 2 ; rel extract 9
g101:
d1:
c.a88<3
rs. w3 6 ; *** test no 100 ****************
jl. w3 (r68.) ; w0 w2 rel
h. 100 , 1<9 w. ; w1 w3 return
0 ;
z.
rl. w1 (r0.) ;
rs w3 x1+q40 ; save return;
al w3 x1 ; w3:=curco;
al w1 x2 ;
la. w1 j1. ;
rs w1 x3+q41 ; save rel extract 9;
ls w2 -9 ; seg:=rel>9;
rl w1 x3+q23 ; w1:=mcl_cte;
zl w0 x1+f82 ; w0:=mcl_cte.type;
sn w0 (x3+q25) ; if mcl_cte.type<>mcl_index
se w2 (x1+f83) ; or mcl_cte.segment_no<>seg then
jl. +4 ; begin
jl. i1. ;
rl w1 x3+q22 ; get_mcl_segment(mcl_entry,
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...6...
jl. w3 (r20.) ; seg,mcl_buf,mcl_cte,r);
sn w0 0 ; if r<>0 then begin
jl. i0. ; addr:=-1;
al w2 -1 ; return;
jl (x3+q40) ; end;
i0: rs w1 x3+q23 ;
rs w2 x3+q24 ;
zl w0 x1+f82 ;
rs w0 x3+q25 ; mcl_index:=mcl_cte.type;
jl. i2. ; end;
i1: rl w2 x3+q24 ;
i2: wa w2 x3+q41 ; addr:=mcl_buf+rel extract 9;
jl (x3+q40) ; return;
j0: 0 ; saved return
j1: 511
e.
; procedure push(ic,m_entry,var_no,r);
;
; ic,m_entry,var_no (call) værdier der skal gemmes
; r (return) =0 ok, =-1 ikke plads på stak
;
; gemmer tre variable på en coroutines variabel stak
;
; call return
; w0: ic r
; w1: m_entry undef
; w2: var_no undef
; w3: return curco
b. i5,j5 w.
g102:
d2: rs. w3 j0. ; save return;
c.a88<3
rs. w3 6 ; *** test no 102 ****************
jl. w3 (r68.) ; w0 ic w2 var_no
h. 102 , 1<9 w. ; w1 m_entry w3 return
0 ;
z.
rl. w3 (r0.) ; w3:=curco;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...7...
rs. w2 j1. ;
rl w2 x3+q27 ;
al w2 x2+6 ; if mcl_top+6 < max_mcl_stach then
sl w2 (x3+q28) ; begin
jl. i1. ;
rs w2 x3+q27 ; mcl_top:=mcl_top+6;
al w2 x3+q26 ; x:=mcl_top+mcl_stack;
wa w2 x3+q27 ;
ds w1 x2-4 ; word(x-6):=ic;
rl. w1 j1. ; word(x-4):=m_entry;
rs w1 x2-2 ; word(x-2):=var_no;
am -1 ; r:=0;
i1: al w0 1 ; end else r:=1;
jl. (j0.) ; return
j0: 0 ; saved return;
j1: 0 ; saved w2
e.
; procedure pop(ic,m_entry,var_no);
;
; afstakker tre værdier fra en coroutines variabel stak
;
; call return
; w0: ic
; w1: m_entry
; w2: var_no
; w3: return curco
b. i5,j5 w.
g103:
d3: rs. w3 j0. ; save return;
rl. w3 (r0.) ; w3:=curco;
rl w2 x3+q27 ; w2:=mcl_top;
sh w2 5 ; if mcl_top>5 then
jl. (j0.) ; begin
al w2 x2-6 ; mcl_top:=mcl_top-6;
rs w2 x3+q27 ; x:=mcl_stack+mcl_top;
al w2 x3+q26 ; w0:=ic;
wa w2 x3+q27 ;
dl w1 x2+2 ; w1:=m_entry;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...8...
rl w2 x2+4 ; w2:=var_no;
c.a88<3
rs. w3 6 ; *** test no 103 ****************
jl. w3 (r68.) ; w0 ic w2 var_no
h. 103 , 1<9 w. ; w1 m_entry w3 curco
0 ;
z.
jl. (j0.) ; end;
; return;
j0: 0 ; saved return;
e.
; procedure create_mcl_variables(result);
;
; result (return) =0 ok, =1 ikke frit segment
;
; allokere et segment i tasspool til mcl variable segment 0.
; En corebuffer allokeres til segmentet og alle mcl variabel
; initialiseres til ubrugte
;
; call return
; w0: result (=0 ok, =1 -segmenter)
; w1: undef.
; w2: undef.
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o1 + 0 ; saved return
g104:
d4: rs. w3 j0. ; save return;
c.a88<3
rs. w3 6 ; *** test no 104 ****************
jl. w3 (r68.) ; w0 w2
h. 104 , 1<8 w. ; w1 w3 return
0 ;
z.
al w0 1 ; create_spool_area(1,var_segno,r);
jl. w3 (r21.) ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...9...
se w0 0 ; if r<>0 then return;
jl. (j0.) ;
rs w2 x3+q30 ;
al w0 1 ;
rs w0 x3+q32 ; mcl_var:=1;
rl. w0 j0. ;
rs w0 x3+q40 ; save return i cdescr
al w1 2 ; /* find corebuffer til variabler, sæt write bit */
jl. w3 (r16.) ; get_spool_segment
rs w2 x3+q31 ; (var_segno,var_seg_addr,2);
al w1 25 ;
rl. w0 j1. ;
i1: am x2 ; for i:=25 to 0 do
hs w0 x1 ; hw(var_seg_addr+i):=1<11;
al w1 x1-1 ;
sl w1 0 ;
jl. i1. ;
al w0 184 ; word(var_seg_addr+26):=184;
rs w0 x2+26 ;
al w0 0 ;
rs w0 x2+30 ; word(var_seg_addr+30):=0;
rs w0 x2+34 ; word(var_seg_addr+34):=0;
rs w0 x2+38 ; word(var_seg_addr+38):=0;
al w0 -1 ;
rs w0 x2+28 ; word(var_seg_addr+28):=-1;
rs w0 x2+32 ; word(var_seg_addr+32):=-1;
rs w0 x2+36 ; word(var_seg_addr+36):=-1;
rl. w0 j2. ;
rs w0 x2+40 ; word(var_seg_addr+40):=2 shift 12; /* tom text */
al w0 0 ; result:=0;
jl (x3+q40) ; return;
j0: 0 ; saved return
j1: 1<11 ;
j2: 2<12 ; tom tekst
e.
; procedure var_addr(var_no,addr);
;
; var_no (call) den variables nummer
; addr (return) abs addr på variabel
;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...10...
; finder abs adresse på en mcl variabel der er givet ved dens nummer
;
; call return
; w0: undef.
; w1: var_no undef.
; w2: addr
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o2 + 0 ; saved return
q41 = o2 + 2 ; e extract 9
g105:
d5: rs. w3 j0. ; save return;
c.a88<3
rs. w3 6 ; *** test no 105 ****************
jl. w3 (r68.) ; w0 w2
h. 105 , 1<9 w. ; w1 var_no w3 return
0 ;
sl w1 26
je -50
z.
jl. w3 (r72.) ; get_mcl_var;
rl w2 x3+q31 ; w2:=var_seg_addr;
am x2 ; e:=hw(var_seg_addr+var_no);
el w1 x1 ; if e<0 then begin
sl w1 0 ; /* var ubrugt */
jl. i1. ; addr:=addr <::>;
al w2 x2+40 ; return;
jl. (j0.) ; end;
i1: al w0 x1 ;
ls w0 -9 ; w0:=e shift -9; /* var seg no */
se w0 0 ; if w0=0 then begin
jl. i2. ; addr:=var_seg_addr+e;
wa w2 2 ; return;
jl. (j0.) ; end;
i2: ls w0 2 ; w:=word(w0 shift 2 +
wa w2 0 ; var_seg_addr + 24);
rl w2 x2+24 ;
rl. w0 j0. ;
rs w0 x3+q40 ; save return, e extract 9 i cdescr;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...11...
la. w1 j1. ;
rs w1 x3+q41 ;
al w1 3 ; get_spool_segment(w,buf,3);
jl. w3 (r16.) ;
wa w2 x3+q41 ; addr:=buf + e extract 9;
jl (x3+q40) ; return;
j0: 0 ; saved return
j1: 511
e.
; procedure alloc_var(var_no,addr,n_ch)
;
; var_no (call) variablens nummer
; addr (return) abs adresse på variablen, eller 0
; n_ch (call) antal tegn variablen skal fylde
;
; proceduren finder plads til ny variabel på et givet antal tegn,
; og returnere den adresse (ind i corebuffer) eller 0 hvis der
; ikke er plads
;
; call return
; w0: undef.
; w1: var_no undef.
; w2: n_ch addr eller 0
; w3: return curco
b. i7,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o3 + 0 ; saved return
q41 = o3 + 2 ; var_no
q42 = o3 + 4 ; n_ch
q43 = o3 + 6 ; n_hw
q44 = o3 + 8 ; f
q45 = o3 + 10 ; s
g106:
d6: rs. w3 j0. ;
c.a88<3
rs. w3 6 ; ** test no 106 ******************
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...12...
jl. w3 (r68.) ; w0 w2 n_ch
h. 106 , 1<9 w. ; w1 var_no w3 return
0 ;
sl w1 26
je -50
z.
rl. w3 (r0.) ; w3:=curco;
ds w2 x3+q42 ;
rl. w0 j0. ;
rs w0 x3+q40 ; save n_ch,var_no,return i cdescr;
al w1 0 ;
al w2 x2+2 ;
wd. w2 j3. ;
ls w2 1 ;
al w2 x2+2 ;
rs w2 x3+q43 ; n_hw:=(n_ch+2)/3*2+2;
jl. w3 (r72.) ; get_mcl_var;
rl w1 x3+q41 ; w1:=var_no;
am (x3+q31) ;
el w0 x1 ; e:=hw(var_seg_addr+var_no);
sh w0 -1 ; if e>=0 then begin
jl. i7. ; delete_var(var_no);
jl. w3 d7. ; get_mcl_var;
jl. w3 (r72.) ; end;
i7: al w2 0 ; i:=0;
i1: al w1 x2 ;
ls w1 2 ; repeate
al w1 x1+24 ;
wa w1 x3+q31 ; as:=var_seg_addr+i*4 + 24;
al w0 512 ;
ws w0 x1+2 ; q:=512 - word(as+2);
sl w0 (x3+q43) ; if q>=n_hw then goto F;
jl. i3. ;
al w2 x2+1 ; i:=i+1;
se w2 4 ; until i=4;
jl. i1. ;
i2: al w1 0 ; error_exit: addr:=0; /* ikke plads */
jl (x3+q40) ; return;
i3: ; F:
rl w0 x3+q30 ; s:=var_segno;
ds. w2 j2. ;
sh w2 0 ; if i>0 then
jl. i4. ; begin
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...13...
rl w0 x1 ;
sl w0 0 ; if word(as)<0 then
jl. i4. ; begin /* segment ikke brugt før */
rl w2 x3+q30 ; w2:=var_segno;
al w1 1 ; extend_spool_area
jl. w3 (r24.) ; (var_segno,1,r);
se w0 0 ; if r<>0 then goto error_exit;
jl. i2. ;
rl w2 x3+q30 ;
am. (r1.) ;
am (0) ;
zl w0 x2 ; s:=areatable(var_segno);
rl. w1 j1. ; word(as):=s;
rs w0 x1 ; end;
i4: rs w0 x3+q45 ; end;
rl w0 x1+2 ;
rs w0 x3+q44 ; f:=word(as+2);
wa w0 x3+q43 ; w0:=f+n_hw;
rs w0 x1+2 ; word(as+2):=w0;
rl. w0 j2. ;
ls w0 9 ;
wa w0 x3+q44 ; w0:=i shift 9 + f;
rl w1 x3+q41 ;
am (x3+q31) ;
hs w0 x1 ; hw(var_seg_addr+var_no):=w0;
rl w2 x3+q45 ;
sn w2 (x3+q30) ; if s<>var_segno then
jl. i5. ; get_spool_segment(s,buf,3);
al w1 3 ;
jl. w3 (r16.) ;
jl. i6. ;
i5: rl w2 x3+q31 ; else buf:=var_seg_addr;
i6: wa w2 x3+q44 ; addr:=f+buf;
dl w1 x3+q43 ;
hs w1 x2 ; hw(addr):=n_hw;
hs w0 x2+1 ; hw(addr+1):=n_ch;
jl (x3+q40) ; return
j0: 0 ; saved return;
j1: 0 ; as
j2: 0 ; i
j3: 3
e.
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...14...
; procedure delete_var(var_no);
;
; var_no (call) den variables nummer
;
; initialisere en mcl variabel, givet ved et nummer, til ubrugt
;
; call return
; w0: undef.
; w1: var_no undef.
; w2: undef
; w3: return curco
b. i5,j10 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o2 + 0 ; saved return
q41 = o2 + 2 ; var_no
q42 = o2 + 4 ; v_seg
q43 = o2 + 6 ; v_rel
g107:
d7: rs. w3 j0. ;
c.a88<3
rs. w3 6 ; *** test no 107 ****************
jl. w3 (r68.) ; w0 w2
h. 107 , 1<9 w. ; w1 var_no w3 return
0 ;
sl w1 26
je -50
z.
rl. w3 (r0.) ; w3:=curco;
rl. w0 j0. ;
ds w1 x3+q41 ; save return,var_no i cdescr;
jl. w3 (r72.) ; get_mcl_var;
rl w2 x3+q31 ; w2:=var_seg_addr;
am x2 ;
el w1 x1 ; e:=hw(w2+var_no);
sh w1 0 ;
jl. (j0.) ; if e<0 then return;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...15...
al w0 x1 ;
ls w0 -9 ; v_seg:=e shift -9
la. w1 j8. ; v_rel:=e extract 9;
ds w1 x3+q43 ;
rl w1 0 ;
sn w1 0 ; if v_seg<>0 then begin
jl. i1. ; w2:=seg:=
ls w1 2 ; word(var_seg_addr + v_seg*4 + 24);
wa w1 4 ;
rl w2 x1+24 ; get_spool_segment(seg,v_addr,3);
al w1 3 ;
jl. w3 (r16.) ; end;
i1: rs. w2 j1. ; w2:=v_addr; /*peger til første hw
rl w1 x3+q42 ; hw på segment med variabel */
ls w1 2 ; f:=word(var_seg_addr+v_seg*4+26);
wa w1 x3+q31 ;
rs. w1 j2. ; /* w1 rel på seg til første frie */
rl w1 x1+26 ;
rs. w1 j7. ;
wa w2 x3+q43 ; w2:=v_rel*v_addr;
zl w0 x2 ; v_size:=hw(w2);
rs. w0 j3. ; w:=v_size+v_rel;
wa w0 x3+q43 ; /* w0 rel til første efter var */
ws w1 0 ; s:=f-w0; /* antal hw
sh w1 0 ; efter den der skal bruges */
jl. i4. ; if s>0 then begin
rx w1 0 ; move(v_addr+w0,
wa. w1 j1. ; v_rel+v_addr,s);
jl. w3 (r26.) ;
rl. w3 (r0.) ; w3:=curco;
al w2 25 ; i:=25;
i2: al w1 x2 ; repeat
wa w1 x3+q31 ; va:=var_seg_addr+i;
rs. w1 j4. ; e:=hw(va);
zl w1 x1 ;
rs. w1 j5. ;
ls w1 -9 ; s:=e shift -9;
se w1 (x3+q42) ; rel:=e extract 9;
jl. i3. ;
ls w1 9 ; if s=v_rel and (rel>v_rel) then
rs. w1 j6. ; begin
al w1 511 ;
la. w1 j5. ; rel:=rel-v_size;
sh w1 (x3+q43) ; e:=rel + s shift 9;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...16...
jl. i3. ; hw(v_addr):=e;
ws. w1 j3. ; end;
wa. w1 j6. ; i:=i-1;
hs. w1 (j4.) ; until i<1;
i3: al w2 x2-1 ;
sl w2 0 ;
jl. i2. ; end; /* flyt */
i4: rl. w1 j7. ;
ws. w1 j3. ;
rl. w2 j2. ;
rs w1 x2+26 ; word(var_seg_addr+v_seg*4+26):=f-v_size;
rl w1 x3+q41 ;
wa w1 x3+q31 ;
al w0 -1 ;
hs w0 x1 ; hw(var_seg_addr+var_no):=-1;
jl (x3+q40) ; return
j0: 0 ; saved return
j1: 0 ; v_addr
j2: 0 ; var_seg_addr + v_seg*4
j3: 0 ; v_size
j4: 0 ; va
j5: 0 ; e
j6: 0 ; e shift -9 shift 9;
j7: 0 ; f
j8: 511
e.
; procedure set_var(var_no,txt_addr,t_addr);
;
; var_no (call) mcl variabel nummer
; txt_addr (call) text adresse på tekst der skal sættes
; i den mcl variabel der er givet ved var_no
; t_addr (return) adresse hvor teksten ender
;
; sætter en tekst (i mcl tekst format) i en mcl variabel
;
; call return
; w0: txt_addr undef.
; w1: var_no undef
; w2: t_addr
; w3: return curco
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...17...
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o4 + 0 ; saved return
q41 = o4 + 2 ; txt_addr
q42 = o4 + 4 ; var_no
g108:
d8: rl. w2 (r0.) ; w2:=curco;
c.a88<3
rs. w3 6 ; *** test no 108 ****************
jl. w3 (r68.) ; w0 text_addr w2 curco
h. 108 , 1<9 w. ; w1 var_no w3 return
0 ;
z.
rs w3 x2+q40 ; save return
ds w1 x2+q42 ; save txt_addr,var_no;
am (0) ;
zl w2 1 ; w2:=hw(txt_addr+1); /* n_ch */
jl. w3 d6. ; alloc_var(var_no,addr,w2);
rl w1 x3+q41 ; w1:=txt_addr;
se w2 0 ; if addr <> 0 then
jl. w3 (r6.) ; move_text(txt_addr,addr);
jl (x3+q40) ; return;
e.
; procedure wait(type,result,answer_addr,a_result)
;
; type (call) angiver hvad der skal ventes på
; type = 2 answer
; > 2 semaphor, type er dens adresse
; result (return) hvis det der ventes på er sket er result=0
; ellers er result=-2 (afb. med break i sm)
; result=-1 (link til ph nedlagt)
;
; answer_addr (return) addresse på answer, kun relevant hvis
; type = 2
;
; a_result (return) result fra wait answer, kun relevant hvis
; type er 2
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...18...
;
; kaldes når der skal ventes på en semaphor eller et answer. Parametren
; angiver hvad der skal ventes på. Ud over det der er angivet i kaldet
; ventes på letter med typen 1<12. Hvis et sådan letter modtages,
; behandles det og evt. svar sendes, derefter ventes igen på det der
; er angivet i parametren. Hvis state.cont sættes i sm returneres med
; result = -2. Hvis link til ph er nedlagt returneres med result=-1.
; Hvis type = 2 i kaldet henter rutinen svaret hjem og
; returnere answer addr og result fra wait_answer
;
; call return
; w0: type a_result (kun hvis kaldt med type = 2 )
; w1: answer_addr (kun hvis kaldt med type = 2 )
; w2: result (0 eller -2)
; w3: return curco
b. i15,j10 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o4 + 0 ; saved return
q41 = o4 + 2 ; type/sem
q42 = o4 + 4 ; event_mask
q43 = o4 + 6 ; letter
q44 = o4 + 8 ; att, =1 efter att letter med io ude
g109:
d9: rs. w3 j0. ;
c.a88<3
rs. w3 6 ; *** test no 109 ****************
jl. w3 (r68.) ; w0 type w2
h. 109 , 1<9 w. ; w1 w3 return
0 ;
z.
rl. w3 (r0.) ;
rs w0 x3+q41 ; save type i cdescr;
rl. w2 j0. ;
rs w2 x3+q40 ; save return i cdescr;
sh w0 1 ;
je -51 ; if type < 2 then fault;
al w2 1 ; event_mask:=1;
sn w0 2 ; if type=2 then
al w2 1<1 ; event_mask:= 1 shift 1;
wa. w2 j1. ; event_mask:=event_mask + 1 shift 12;
rs w2 x3+q42 ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...19...
al w2 0 ;
rs w2 x3+q44 ; att := 0;
i1: al w2 x3+f22 ; W:
rl w1 x3+q42 ; wait_sem_letter(main_mbx,
rl w0 x3+q41 ; sem,event_mask,letter,event_type);
jl. w3 (r30.) ;
ls w0 -12 ; if event_type shift -12 = 0 then
se w0 0 ; begin
jl. i2. ;
rl w0 x3+q41 ; if type=2 then
se w0 2 ; begin
jl. i9. ;
rl w2 x1+6 ;
al w1 x3+q8 ;
jd 1<11+18 ; wait answer(letter.buf,ans,a_result);
rl w2 x3+q44 ;
sn w2 0 ; if att = 1 then
jl. i9. ; answer.status:=answer.status + att;
rl w2 x1 ;
lo. w2 j6. ; end;
rs w2 x1 ;
i9: rl w2 x3+f21 ;
so. w2 (j2.) ; if stat.finis=1 then
jl. i10. ; begin
al w1 30 ; terminate_th(error_no=30)
jl. w2 d19. ; end;
i10: al w2 0 ; result:=0;
jl (x3+q40) ; return
; end;
i2: rs w1 x3+q43 ;
rl w0 x1+8 ;
se w0 0 ; if letter.opcode = 0 then
jl. i6. ; begin
al w0 p39 ; /* th attention letter */
la w0 x3+f21 ;
se w0 p31 ; if state.type = th uden mcl then
jl. i4. ; begin
rl w1 x3+q41 ;
rl w2 x3+f21 ;
sl w1 3 ; if sem>2 and
sz w2 p4 ; stty=1 then
jl. i3. ; send_attention;
jl. w3 d13. ;
i3: al w2 -1 ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...20...
am (x3+q62) ;
rs w2 f116 ; tbuf.tdescr.cth:=-1; /* sys menu på vej */
rl w2 x3+q43 ;
rl w2 x2+6 ; signal(letter.answer_sem);
jl. w3 (r31.) ;
al w0 a25 ; pass( th prio );
jl. w3 (r29.) ; goto W;
jl. i1. ; end;
i4: rl w2 x3+q43 ;
rl w2 x2+6 ; signal(letter.answer_sem);
jl. w3 (r31.) ;
rl w1 x3+q41 ;
sl w1 3 ; if sem<3 then
jl. i11. ; begin /* venter på io, husk att */
al w2 1 ; att := 1;
rs w2 x3+q44 ; goto W;
jl. i1. ; end;
i11: jl. w3 d11. ; wait_term;
rl w1 x3+f21 ;
so. w1 (j5.) ; if state.cont = 1 then begin
jl. i5. ; result:=-2;
al w2 -2 ; return;
jl (x3+q40) ; end;
i5: sz. w1 (j3.) ; if state.att then
jl. w3 d13. ; send_attention;
rl. w1 j4. ;
la w1 x3+f21 ; state.att:=0;
rs w1 x3+f21 ; state.stop:=0;
rl w1 x3+q41 ;
sh w1 3 ; if sem<3 then
jl. i1. ; goto W; /* venter på answer */
rl w0 x1 ;
se w0 0 ; if sem.first<>0 then
jl. i1. ; goto W; /* sem ikke nulstillet */
al w2 -1 ; result:=-1; /* link nedlagt */
jl (x3+q40) ; return;
; end;
i6: se w0 2 ; if letter.opcode<>2 then
jl. i7. ; begin
rl w1 x3+f21 ; /* remove th letter */
lo. w1 j2. ;
rs w1 x3+f21 ; state.finis=1;
rl w1 x3+q5 ; w1:=ph;
al w0 p39 ; w0:=ph.state.type;
la w0 x1+f21 ;
jl. w3 d15. ; remove_th_link; /* w0, w1 uændret */
sn w1 0 ;
\f
;; tas 1.0 14.05.87 terminal handler thtxt ...20a...
jl. i8. ; /* hvis en ph, og oprettet fra th, remove */
sn w0 p34 ; if ph<>0 and ph.state.type = oprettet fra th then
jl. w3 d14. ; remove_ph(ph);
i8: rl w2 x3+q43 ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...21...
rl w2 x2+6 ;
jl. w3 (r31.) ; signal(letter.answer_sem);
al w1 30 ;
rl w0 x3+q41 ;
se w0 2 ; if type<>2 then
jl. w2 d19. ; terminate_th(30);
jl. i1. ; goto W;
; end;
i7: je -52 ; fault
j0: 0 ; saved return
j1: 1<12 ;
j2: p14 ; state.finis
j3: p15 ; state.att
j4: -(:p14+p15+p11:)-1 ; -(finis+att+skip)
j5: p12 ; state.cont
j6: 1<16 ; status.att
e.
; procedure wait_op(op);
;
; op (return) peger til første hw i operation, hvis
; op = -2 er wait afbrudt af sm med break
; ellers hvis <0 er link nedlagt
;
; venter på operation på link der hører til th coroutinen
;
; call return
; w0: undef.
; w1: undef.
; w2: op
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o5 + 0 ; saved return
g110:
d10: rl. w2 (r0.) ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...22...
rs w3 x2+q40 ; save return i cdescr;
al w3 x2 ;
al w1 x3+q7 ;
rl w0 x1+f78 ;
c.a88<3
rs. w3 6 ; *** test no 110 ***********
jl. w3 (r68.) ; w0 segs w1 link
h. 110 , 1<8 w. ; w2 w3 curco
0 ;
z.
sh w0 0 ; if link.segments>0 then begin
jl. i1. ; /* link findes */
rl w0 x1+f74 ;
se w0 0 ; if link.cur_op=0 then
jl. i0. ; begin
al w0 x1+f71 ; w0:=addr link.operation;
jl. w3 d9. ; wait(w0,r);
sn w2 -2 ; if r=-2 then return;
jl (x3+q40) ; end;
i0: al w1 x3+q7 ; end;
rl w0 x1+f78 ;
sh w0 0 ; if link.segments > 0 then begin
jl. i1. ; /* link findes endnu */
al w0 1 ;
rs w0 x1+f74 ; link.cur_op:=1;
jl. w3 (r14.) ; check_op(link,length,op);
jl. i2. ; end
i1: al w2 -1 ; else op:=-1;
i2: jl (x3+q40) ; return;
e.
; procedure wait_term;
;
; starter en th coroutine med system menu og venter på st signal
; til stop_sem
;
; call return
; w0: undef.
; w1: undef.
; w2: undef.
; w3: return curco
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...23...
b. i11,j12 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o3 + 0 ; saved return
q41 = o3 + 2 ; cda
q42 = o3 + 4 ; letter
q43 = o3 + 6 ; linespec
g111:
d11: rl. w2 (r0.) ;
rs w3 x2+q40 ; save return i cdescr;
al w3 x2 ;
rl w0 x3+f21 ; if state.no_sys_menu then
c.a88<3
rs. w3 6 ; *** test no 111 ****************
jl. w3 (r68.) ; w0 state w2 curco
h. 111 , 1<8 w. ; w1 w3 curco
0 ;
z.
sz. w0 (j6.) ; return;
jl (x3+q40) ;
i1: ; create_menu:
jl. w3 (r32.) ; create_coroutine(cda,lock_count);
sh w1 0 ; if cda=0 then
jl (x3+q40) ; return;
rs w1 x3+q41 ;
al w2 x3+q65 ; /* gem term spec i tbuf */
al. w1 j0. ; csendmessage(mes,
jl. w3 (r34.) ; tbuf.name,buf);
sh w2 1 ; if buf<2 then
je -12 ; fault;
al w0 0 ;
al w1 x3+q78 ; cwaitanswer(buf,
jl. w3 (r33.) ; 0,tbuf.termspec,r);
se w0 1 ; if r<>1 then
jl. i3. ; goto T; /* stop th */
rl w1 x3+q78+14 ; gem linespec til senere test
rs w1 x3+q43 ;
al w2 x3+q65 ;
am (x3+q62) ; /* sæt term spec til std. med tabel 2 */
al w1 +f111 ;
jl. w3 (r34.) ; tbuf.name,buf);
sh w2 1 ; if buf<2 then
je -12 ; fault;
al w0 0 ;
\f
;; tas 1.0 14.05.87 terminal handler thtxt ...23a...
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...24...
al w1 x3+q8 ; cwaitanswer(buf,
jl. w3 (r33.) ; 0,ans,r);
se w0 1 ; if r<>1 then
jl. i3. ; goto T; /* stop th */
am (x3+q62) ;
rs w3 f116 ; tbuf.tdescr.cth:=th; /* denne */
rl w2 x3+q41 ;
rl. w0 j2. ; /* init variable i sysm cdescr */
rs w0 x2+f21 ; cda.state:=th med sysm;
rl w0 x3+q64 ;
rs w0 x2+q64 ; cda.tbuf.size:=tbuf.size;
dl w1 x3+q65+2 ;
ds w1 x2+q65+2 ;
dl w1 x3+q65+6 ; cda.tbuf.name:=tbuf.name;
ds w1 x2+q65+6 ;
rl w1 x3+q79 ;
rs w1 x2+q79 ; cda.tbuf.nte:=tbuf.nte;
rl w1 x3+q62 ;
jl. w3 (r35.) ; put_in_session(tdescr,cda);
al w0 a30 ; start_coroutine(prio,
rl. w1 r37. ; ic,cda);
jl. w3 (r36.) ;
am (x3+q62) ;
rs w2 +f103 ; tbuf.tdescr.cur_th:=cda;
; /* vent på terminal */
i5: rl. w3 (r0.) ; W:
al w0 x3+f26 ; w0:=stop_sem;
rl. w1 j5. ; w1:=mask; (1<12 + 1);
al w2 x3+f22 ; w2:=main_mbx;
jl. w3 (r30.) ; wait_sem_letter(main_mbx,
ls w0 -12 ; sem,event_mask,letter,event_type);
se w0 0 ;
jl. i6. ; if event_type shift -12 = 0 then
rl w0 x3+f21 ; begin /* stop sem åbnet af sm */
so. w0 (j11.) ; if state.term_remove = 1 then
jl. i4. ; begin
la. w0 j12. ; state.term_remove:=0;
rs w0 x3+f21 ; goto w;
jl. i5. ; end;
i4: so. w0 (j3.) ; if state.finis=0 then
jl. i8. ; goto Retur_from_sm;
al w1 0 ; send_text_and_stop_th(out);
jl. (r76.) ; end;
i6: rs w1 x3+q42 ;
rl w0 x1+8 ;
se w0 0 ; if letter.opcode = 0 then
jl. i7. ; begin /* th attention letter */
rl w2 x1+6 ; signal(letter.answer_sem);
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...25...
jl. w3 (r31.) ;
jl. i5. ; goto W;
; end;
i7: se w0 2 ; if letter.opcode=2 then
jl. i10. ; begin;
rl w1 x3+f21 ; /* remove th letter */
lo. w1 j3. ;
rs w1 x3+f21 ; state.finis=1;
rl w1 x3+q5 ; w1:=ph;
al w0 p39 ; w0:=ph.state.type;
la w0 x1+f21 ;
jl. w3 d15. ; remove_th_link; /* w0, w1 uændret */
sn w1 0 ;
jl. i9. ; /* hvis der er en ph, og oprettet fra th, remove */
sn w0 p34 ; if ph<>0 and ph.state.type = oprettet fra th then
jl. w3 d14. ; remove_ph(ph);
i9: rl w2 x3+q42 ;
rl w2 x2+6 ;
jl. w3 (r31.) ; signal(letter.answer_sem);
al w1 0 ;
jl. w2 d19. ; terminate_th(0);
; end;
i10: se w0 4 ; if letter.opcode <> 4 /* start th lettter */ then
je -52 ; fault;
rl w2 x1+6 ; signal(letter.answer_sem);
jl. w3 (r31.) ;
i8: ; Return_from_sm:
am (x3+q62) ; /* tpda<0 hvis terminal fjernet med !disconnect */
rl w0 f107 ; if tbuf.tdescr.tpda<0 then
sh w0 0 ;
jl. i5. ; goto w; /* ikke link til terminal */
rl w0 x3+q43 ;
al w1 x3+q78 ; mes:=tbuf.termspec;
se w0 (x1+14) ; /* test sidste ord i term spec ikke ændret
je -57 ; ellers stop med fejl */
rl. w0 j4. ; /* sæt term spec tilbage til gemte værdier */
rs w0 x1 ; mes(0):=a6<12+0; /* set */
al w2 x3+q65 ; csendmessage(
jl. w3 (r34.) ; mes,tbuf.name,buf);
sh w2 1 ; if buf<2 then fault;
je -12 ;
al w0 0 ;
al w1 x3+q8 ; cwaitanswer(buf,
jl. w3 (r33.) ; 0,ans,r);
se w0 1 ; if r<>1 then
jl. i3. ; goto T; /* stop th */
am (x3+q62) ;
rl w1 +f113 ;
se w1 -1 ; if tbuf.tdescr.s = -1 then
jl. i2. ; begin
al w0 2 ; tbuf.tdescr.s:=2; /* ok */
am (x3+q62) ; goto create_menu;
rs w0 f113 ; end;
jl. i1. ;
i2: rl w0 x3+f21 ;
so. w0 (j3.) ; if state.finis = 1 or
\f
;; tas 1.0 14.05.87 terminal handler thtxt ...25a...
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...26...
se w1 2 ; tbuf.tdescr.s<>2 then
i3: jl. 4 ;T: terminate_th(30);
jl (x3+q40) ; return;
al w1 30 ;
jl. w2 d19. ;
j0: a5<12+0 ; set term spec opcode
j2: p33 ; state for sysm co.
j3: p14 ; state.finis
j4: a6<12+0 ; get term spec opcode
j5: 1<12 + 1 ; event_mask
j6: p18 ; state.no_sys_menu
j7: p5 ; state.mtty
j8: 0 ; localid
<:<2><2> out <10>:>
j9: 3<12 + 0 ;
j10: 1<15
j11: p3 ; state.term_removed
j12: -p3-1 ; -zstate.term_removed
e.
; procedure tascat_mes(mode,hw,result);
;
; mode (call) mode i message
; hw (call) antal hw der skal sendes
; result (return) result fra svar
;
; sender en message, ter står i terminal buffer (tbuf), til tascat
; og venter på svar
;
; call return
; w0: mode result
; w1: hw undef.
; w2: undef.
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o1 + 0 ; saved return
g112:
d12: rl. w2 (r0.) ;
c.a88<3
rs. w3 6 ; *** test no 112 ****************
jl. w3 (r68.) ; w0 mode w2
h. 112 , 1<9 w. ; w1 hw w3 return
0 ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...27...
z.
rs w3 x2+q40 ; save return i cdescr;
wa. w0 j0. ; tbuf.op:=9,tbuf.mode:=mode;
rs w0 x2+q66 ;
rl w0 x2+q63 ;
wa w1 0 ; tbuf.first:=tbuf.taddr;
al w1 x1-2 ; tbuf.last:=tbuf.first+hw-2;
ds w1 x2+q69 ;
al w1 x2+q66 ; csendmessage(
rl. w2 r38. ; tbuf.op,<:tascat:>,buf);
jl. w3 (r34.) ;
sh w2 1 ; if buf<2 then
je -12 ; fault;
al w1 x3+q8 ;
al w0 0 ; cwaitanswer(buf,
jl. w3 (r33.) ; 0,ans,r);
se w0 1 ; if r<>1 then fault;
je -18 ;
rl w0 x3+q8 ; result:=ans.result;
jl (x3+q40) ; return;
j0: 9<12 + 0 ;
e.
; procedure send_attention;
;
; sender et ph_attention letter til en ph coroutine
;
; call return
; w0: undef.
; w1: undef.
; w2: undef.
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o1 + 0 ; saved return
g113:
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...28...
d13: rl. w2 (r0.) ;
c.a88<3
rs. w3 6 ; *** test no 113 ****************
jl. w3 (r68.) ; w0 w2 curco
h. 113 , 1<9 w. ; w1 w3 return
0 ;
z.
rs w3 x2+q40 ; save return;
al w0 1<6 ;
rs w0 x2+q10 ; let.type:=10;
al w1 x2+q14 ;
ds w1 x2+q11 ; let.sem:=addr a_sem;
al w0 0 ;
rs w0 x2+q12 ; let.opcode:=0;
al w1 x2+q9 ;
rl w2 x2+q5 ;
al w2 x2+f22 ;
jl. w3 (r39.) ; send_letter(ph.main_mbx,letter);
al w2 x3+q14 ;
jl. w3 (r40.) ; wait_semaphor(a_sem);
rl w1 x3+f21 ;
lo. w1 j0. ;
rl w0 x3+q13 ;
se w0 0 ; if let.result<>0 then
rs w1 x3+f21 ; state.send_att:=1;
jl (x3+q40) ; return;
j0: p16 ; state.send_att
e.
; procedure remove_ph(ph);
;
; sender et remove_ph letter til en ph coroutine
;
; call return
; w0: undef.
; w1: ph undef.
; w2: undef.
; w3: return curco
b. i5,j5 w.
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...29...
; proceduren bruger følgende lokale variable i cdescr
q40 = o1 + 0 ; saved return
g114:
d14: rl. w2 (r0.) ;
c.a88<3
rs. w3 6 ; *** test no 114 ****************
jl. w3 (r68.) ; w0 w2 curco
h. 114 , 1<9 w. ; w1 ph w3 return
0 ;
z.
rs w3 x2+q40 ; save return i cdescr;
al w2 x1+f22 ;
al. w1 j0. ; send_letter(ph.main_mbx,
jl. w3 (r39.) ; letter);
jl (x3+q40) ; return;
j0: 0 ; letter:
0 ;
1<6 ; type
0 ; answer (no answer)
1 ; opcode
e.
; procedure remove_th_link;
;
; nedlægger et link der hører til en th coroutine
;
; call return
; w0: unch.
; w1: unch.
; w2: undef.
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o1 + 0 ; saved return
q41 = o1 + 2 ; saved w0
q42 = o1 + 4 ; saved w1
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...30...
g115:
d15: rl. w2 (r0.) ;
c.a88<3
rs. w3 6 ; *** test no 115 ****************
jl. w3 (r68.) ; w0 w2 curco
h. 115 , 1<9 w. ; w1 w3 return
0 ;
z.
rs w3 x2+q40 ; save retur i cdescr;
ds w1 x2+q42 ; save w0,w1 i cdescr;
al w3 x2 ;
rl w2 x3+q7+f78 ; if link.segments<-0 then
sh w2 0 ; return;
jl (x3+q40) ;
rl w2 x3+q5 ;
al w1 x3 ;
sn w2 0 ; if ph>0 then
jl. i1. ; begin
jl. w3 (r41.) ; unlink_th(ph,th);
rl w0 x2+q3 ; if ph.pool_head=0 then
se w0 0 ; begin /* sidste i kæden fjernet */
jl. i1. ; /* fjern stt,mtty eller f8000 bit
rl. w0 j3. ; fra ph.state */
la w0 x3+f21 ; mask:=not (th.state extract mtty,stty,f8000);
lx. w0 j2. ; ph.state:=ph.state and mask;
la w0 x2+f21 ;
rs w0 x2+f21 ; end;
i1: al w2 x3+q7+f73 ; end;
rl w0 x2+4 ;
sh w0 -1 ; if link.free_seg.value<0 then
jl. w3 (r31.) ; signal(link.free_seg);
al w2 x3+q7 ;
rl w2 x3+q7+f75 ;
al w2 x2+f22 ; ph:=link.ident;
al. w1 j0. ; mbx:=ph.main_mbx;
se w2 f22 ; if link.ident<>0 then
jl. w3 (r39.) ; send_letter(mbx,letter);
al w1 x3+q7 ;
jl. w3 (r11.) ; remove_link(link);
rl w1 x3+f21 ; state.stty:=0;
la. w1 j1. ; state.mtty:=0;
rs w1 x3+f21 ; state.f8000:=0;
dl w1 x3+q42 ; restore w0,w1;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...31...
jl (x3+q40) ; return;
j0: 0 ; letter:
0 ;
1<5 ; type
0 ; answer (no answer)
0 ; opcode
4 ; result
j1: -(:p4+p5+p6:)-1 ; -(stty+mtty+f8000)
j2: -1
j3: p4+p5+p6 ; stty+mtty+f8000
e.
; procedure create_user(s);
;
; s (return) status
;
; tilmelder en ny user til tascat. Userid læses fra terminalen.
; ved retur står userdata i terminal bufferen
;
; call return
; w0: s
; w1: undef.
; w2: undef.
; w3: return curco
b. i7,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o9 + 0 ; saved return
g116:
d16: rl. w2 (r0.) ;
c.a88<3
rs. w3 6 ; *** test no 116 ****************
jl. w3 (r68.) ; w0 w2 curco
h. 116 , 1<8 w. ; w1 w3 return
0 ;
z.
rs w3 x2+q40 ; save return i cdescr;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...32...
rl. w1 r60. ;
jl. w3 (r7.) ; outtext(<:user id :>,s);
se w0 2 ; if s<>2 then
jl. i6. ; err;
rl w1 x3+q63 ;
al w1 x1+50 ; td.first:=
rs w1 x3+q15+2 ; tbuf.taddr + 50;
al w1 x3+q15 ;
al w0 11 ;
rl. w2 j2. ;
jl. w3 (r8.) ; in_text(td,11,0,10,s);
sz. w0 (j3.) ; if timeout i s then
jl. i7. ; goto err1;
se w0 2 ; if s<>2 then
jl. i6. ; goto err;
rl w2 x3+q63 ; w2:=tbuf.taddr;
am (x3+q62) ; /* dan include user message i terminal buffer */
rl w0 +f107 ;
rs w0 x2 ; word(w2):=tbuf.tdescr.tpda;
rs w3 x2+2 ; word(w2+2):=th;
al w0 0 ;
al w1 x2+4 ; w1:=w2+4;
i1: rs w0 x1 ; repeat
al w1 x1+2 ; word(w1):=0;
se w1 x2+16 ; w1:=w1+2;
jl. i1. ; until w1=w2+16;
al w0 12 ;
al. w1 j0. ;
al w2 x2+2 ; init_td(tdw,
jl. w3 (r63.) ; tbuf.taddr+2,12);
i2: al w1 x3+q15 ; repeat /* flyt userid til message */
i3: jl. w3 (r64.) ; repeat c_read(td,c)
sn w0 0 ; until c<>0;
jl. i3. ;
sh w0 31 ; if c<32 then c:=0;
al w0 0 ;
rs. w0 j1. ;
al. w1 j0. ; c_write(tdw,c);
jl. w3 (r65.) ;
rl. w0 j1. ;
se w0 0 ; until c=0;
jl. i2. ;
rl w2 x3+q62 ; /* flyt usedid og password til terminal beskr */
al w2 x2+f104 ; w2:=addr tbuf.tdescr.userid;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...33...
rl w1 x3+q63 ;
al w1 x1+4 ; w1:=tbuf.taddr+4;
dl w0 x1+2 ;
ds w0 x2+2 ;
dl w0 x1+6 ;
ds w0 x2+6 ;
dl w0 x1+10 ;
ds w0 x2+10 ; /* send include user and start session message */
c.a88<3
dl w1 x2+2
dl w3 x2+6 ; *** test no 101 ****************
jl. w3 (r68.) ; w0 ch1 ch2 ch3 w2 ch7 ch8 ch9
h. 101 , 1<8 w. ; w1 ch4 ch5 ch6 w3 ch10 ch11 ch12
0 ;
z.
al w0 3 ; mode:=3;
al w1 80 ; hw:=80;
jl. w3 d12. ; tascat_mes(mode,hw,r);
sn w0 0 ; if r=wrong password then
jl. i4. ; begin
rl. w1 r43. ;
jl. w3 (r7.) ; outtext(,<:password :>,s);
se w0 2 ; if s<>2 then
jl. i6. ; goto err;
jl. w3 (r9.) ; read_password(pw,s);
se w0 2 ; if s<>2 then
jl. i6. ; goto err;
am (x3+q62) ;
ds w2 +f105 ; tbuf.tdescr.cpw:=pw;
am (x3+q63) ;
ds w2 14 ; tbuf.taddr.cpw:=pw;
al w0 3 ; mode:=3; hw:=80;
al w1 80 ; tascat_mes(mode,hw,r);
jl. w3 d12. ; end;
i4: se w0 0 ; if r<>ok then
jl (x3+q40) ; return;
i5: rl w1 (x3+q63) ;
am (x3+q62) ;
rs w1 +f106 ; tbuf.tdescr.uid:=tbuf.taddr.uid;
jl (x3+q40) ; return;
i7: am -8 ; err1: status:=13;
i6: al w0 21 ; err: status:=21;
jl (x3+q40) ; return;
j0: 0,r.3 ; tdw
j1: 0 ; c
j2: a4<12 ; timeout_count < 12
j3: 1<21 ; status.timeout
e.
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...34...
; procedure create_ph(ph,owner);
;
; ph (return) cda for pool handler, eller =0 hvis ikke oprettet
; owner (call) pda for ejer af pool handler
;
; opretter en pool handler og starter den. Link oprettes mellem th og ph
;
; call return
; w0: undef.
; w1: ph eller 0
; w2: owner undef.
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o1 + 0 ; owner
q41 = o1 + 2 ; saved return
q42 = o1 + 4 ; ph
g117:
d17: rl. w1 (r0.) ;
c.a88<3
rs. w3 6 ; *** test no 117 ***************
jl. w3 (r68.) ; w0 w2 pda owner
h. 117 , 1<8 w. ; w1 curco w3 return
0 ;
z.
ds w3 x1+q41 ; save return i cdescr;
jl. w3 (r32.) ; create_coroutine(ph);
sn w1 0 ; if ph=0 then
jl (x3+q41) ; return;
rs w1 x3+q42 ; /* init ph coroutine beskrivelse */
rl w2 x3+q40 ;
rs w2 x1+q1 ; ph.owner:=owner;
dl w0 x2+4 ;
ds w0 x1+q20+2 ; ph.owner_name:=
dl w0 x2+8 ; process_name(owner);
ds w0 x1+q20+6 ;
rl. w0 j0. ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...35...
rs w0 x1+q79 ; ph.mdescr.proc:=1 shift 12 + 3;
al w0 0 ; ph.mdescr.open1:=0;
rs w0 x1+q66 ; ph.mdescr.open2:=0;
al w0 x1+f22 ;
rs w0 x1+q68 ; ph.mdescr.mbx:=ph.main_mbx;
al w0 1 ;
al w1 x1+q7 ; seg:=1; /* opret link med 1 spool segment */
jl. w3 (r10.) ; create_link(ph.link,seg,r);
sn w0 0 ; if r<>0 then
jl. i2. ; begin
i1: rl. w2 (r2.) ; R: /* link ikke oprettet */
rl w1 x3+q42 ; release_bufer(cdescr_pool,ph);
jl. w3 (r49.) ; ph:=0;
al w1 0 ; return;
jl (x3+q41) ; end;
i2: dl. w1 (r61.) ; /* sæt processens catalog baser til
al. w3 j2. ; bredt interval */
jd 1<11+72 ; set_catalog_base(<::>,name base for term ps proc);
se w0 0 ;
je -17 ; if result<>ok then fault;
rl. w3 (r0.) ; w1:=ph;
rl w1 x3+q87 ;
al w1 x1+96 ; sessions bogstav :=
ls w1 16 ;
rs. w1 j3. ; (sessions nummer + a); /* a,b,c .. */
rl w1 x3+q42 ;
al w2 x1+q60 ; w2 er ph.pool_name adresse
rl w3 x3+q62 ;
al w3 x3+f108 ; w3 er tbuf.tdescr.name adresse
dl w1 x3+6 ;
ds w1 x2+6 ; flyt terminal navn til pool_navn
dl w1 x3+2 ;
ds w1 x2+2 ;
ls w0 -16 ;
se w0 48 ; if første tegn i navnet er <:0:> then
jl. i4. ; erstat det med sessions bogstav
rl. w1 j4. ; dvs. tegnene a,b,c ...
la w1 x2 ;
lo. w1 j3. ;
rs w1 x2 ;
jl. i5. ; else
i4: dl w1 x2+6 ;
ld w1 -8 ;
rs w1 x2+6 ; sæt sessions bogstavet foran navnet
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...36...
dl w1 x2+4 ;
ld w1 -8 ;
rs w1 x2+4 ;
dl w1 x2+2 ;
ld w1 -8 ;
wa. w0 j3. ;
ds w1 x2+2 ;
i5: rl. w3 (r0.) ;
rl w1 x3+q42 ;
al w3 x2 ;
al w2 x1+q79 ; create_pseudo_process(ph.pool_name,
jd 1<11+80 ; ph.mdescr,r);
sn w0 0 ; if r<>0 then begin
jl. i3. ; remove_link(ph.link);
al w1 x1+q7 ;
jl. w3 (r11.) ; goto R;
jl. i1. ; end;
i3: al w3 x1+q60 ;
jd 1<11+4 ; pda:=process_description(ph.pool_name);
sn w0 0 ; if pda=0 then
je -53 ; fault;
rs w0 x1+q0 ; ph.pool:=pda;
jl. w3 (r50.) ; link_ph(ph);
rl w2 x3+q42 ;
rl. w0 j1. ;
rs w0 x2+f21 ; ph.state:=ph oprettet fra th
al w0 a35 ;
rl. w1 r51. ;
jl. w3 (r36.) ; start_coroutine(prio,
rl w1 x3+q42 ; start addr ph, ph);
jl (x3+q41) ; return;
j0: 1<12 + 3 ;
j1: p34 ; ph.state = ph opretet fra th
j2: 0 ; <::>
j3: 0 ; sessions bogstav
j4: (:-1:) > 8 ; 16 bit maske
e.
; procedure mcl_exit(txt_addr);
;
; txt_addr (call) adresse på mcl tekst der skal sættes som
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...37...
; return tekst for exit
;
; udfører en exit fra et mcl program
;
; call return
; w0: undef.
; w1: undef.
; w2: txt_addr undef.
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o10 + 0 ; saved txt_addr
q41 = o10 + 2 ; saved return
g118:
d18: rl. w1 (r0.) ;
c.a88<3
rs. w3 6 ; *** test no 118 ***************
jl. w3 (r68.) ; w0 w2 text_addr
h. 118 , 1<8 w. ; w1 curco w3 return
0 ;
z.
ds w3 x1+q41 ; save txt_addr,return i cdescr;
rl w0 x1+q27 ;
sh w0 0 ; if mcl_top>0 then
jl. i1. ; begin
rl w1 x1+q22 ;
jl. w3 (r19.) ; remove_mcl_name(mcl_entry);
jl. w3 d3. ; pop(ic,mcl_entry,var_no);
rs w0 x3+q20 ;
rs w1 x3+q22 ;
al w1 x2 ;
rl w0 x3+q40 ; set_var(txt_addr,var_no);
jl. w3 d8. ;
rl w1 x3+q22 ; /* hent mcl program segment */
rl w2 x3+q20 ; seg:=ic shift -9;
ls w2 -9 ; get_mcl_segment(mcl_entry,seg,
jl. w3 (r73.) ; mcl_buf,mcl_cte,r);
ds w2 x3+q24 ; mcl_index:=
zl w0 x1+1 ; mcl_cte.type;
rs w0 x3+q25 ; end
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...38...
jl. i2. ; else
i1: al w3 x1 ; begin
dl w1 x3+q61+2 ; flyt s_name til lokal variabel
ds. w1 j1. ;
al. w0 j0. ;
jl. w3 (r5.) ; write(s_name);
rl w1 x3+q40 ; outtext(txt);
jl. w3 (r7.) ;
rl. w1 r69. ;
jl. w3 (r7.) ; outtext(<:<10>:>);
al w1 0 ;
jl. w2 d19. ; terminate_th(0);
i2: rl. w3 (r0.) ; end;
jl (x3+q41) ; return;
j0: 6 < 12 + 6 ; hw, ch til sessions navn (s_name)
0
j1: 0 ; s_name
e.
; extern variable, indeholder adresser på variable og routiner
u12: ; ref til
r68: h. m176 , 1 w. ; e1 testout registers
r0: h. m24 , 1 w. ; c0 curco, current coroutine
r1: h. m57 , 1 w. ; c40 areatable base
r2: h. m68 , 1 w. ; c5 cdescr_pool
r3: h. m67 , 1 w. ; c48 free_term
r4: h. m162 , 1 w. ; c54 std seg i link spool area
r5: h. m109 , 1 w. ; g148 write
r6: h. m106 , 1 w. ; g145 move_text
r7: h. m107 , 1 w. ; g146 outtext
r8: h. m112 , 1 w. ; g151 in_text
r9: h. m114 , 1 w. ; g153 read_password
r10: h. m69 , 1 w. ; g0 create_link
r11: h. m70 , 1 w. ; g1 remove_link
;12: h. m71 , 1 w. ; g2 adjust_link
r13: h. m72 , 1 w. ; g3 put_op
r14: h. m73 , 1 w. ; g4 check_op
r15: h. m74 , 1 w. ; g5 release_op
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...39...
r16: h. m75 , 1 w. ; g6 get_spool_segment
r19: h. m82 , 1 w. ; g13 remove_mcl_name
r20: h. m83 , 1 w. ; g14 get_mcl_segment
r21: h. m84 , 1 w. ; g17 create_spool_area
r22: h. m85 , 1 w. ; g18 remove_spool_area
;23: h. m86 , 1 w. ; g19 segments_in_spool_area
r24: h. m87 , 1 w. ; g20 extend_spool_area
r25: h. m14 , 1 w. ; e32 wait_letter
r26: h. m89 , 1 w. ; g22 move
r27: h. m123 , 1 w. ; c26 tascat
r28: h. m95 , 1 w. ; g30 get term data
r29: h. m5 , 1 w. ; e12 pass
r30: h. m117 , 1 w. ; e34 wait_sem_letter
;r31 se efter r76
r32: h. m118 , 1 w. ; e14 create_coroutine
r33: h. m8 , 1 w. ; e18 cwaitanswer
r34: h. m7 , 1 w. ; 16 csendmessage
r35: h. m92 , 1 w. ; g27 put_in_session
r36: h. m2 , 1 w. ; e51 start_coroutine
r37: h. m128 , 1 w. ; u32 start addr system menu coroutine
r38: h. m123 , 1 w. ; c26 addr <:tascat:>
r39: h. m12 , 1 w. ; e30 send_letter
r40: h. m11 , 1 w. ; e22 wait_semaphor
r41: h. m97 , 1 w. ; g32 unlink_th
r43: h. m180 , 1 w. ; t0 <:password :>
r49: h. m22 , 1 w. ; e57 release_buffer
r50: h. m98 , 1 w. ; g33 link_ph
r51: h. m129 , 1 w. ; u33 start addr ph
r52: h. m93 , 1 w. ; g28 get_from_session
r53: h. m119 , 1 w. ; e15 remove_coroutine
r54: h. m15 , 1 w. ; e33 sendmessage
r55: h. m181 , 1 w. ; t1 <:removed:>
r56: h. m182 , 1 w. ; t2 <:system:>
r57: h. m136 , 1 w. ; g106 alloc_var
r58: h. m139 , 1 w. ; g109 wait
r59: h. m140 , 1 w. ; g110 wait_op
r60: h. m209 , 1 w. ; t29 <:usedid:>
r61: h. m167 , 1 w. ; e56 name base for term ps proc.
r62: h. m141 , 1 w. ; g111 wait_term
r63: h. m101 , 1 w. ; g140 init_td
r64: h. m102 , 1 w. ; g141 c_read
r65: h. m103 , 1 w. ; g142 c_write
r66: h. m173 , 1 w. ; g23 write_error
r67: h. m232 , 1 w. ; c66 antal th efter create link message
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...40...
;r68 se før r0
r69: h. m189 , 1 w. ; t9 <:<10>:>
r70: h. m239 , 1 w. ; g132 send_to_from
r71: h. m143 , 1 w. ; g113 send_attention
r72: h. m248 , 1 w. ; g133 get_mcl_var
r73: h. m83 , 1 w. ; g14 get_mcl_segment
r74: h. m100 , 1 w. ; c55 addr signon text buffer
r75: h. m133 , 1 w. ; g103 pop
r76: h. m258 , 1 w. ; g137 send_text_and_stop_th
r31: h. m10 , r230. w. ; e20 signal
; init liste fortsætter ved r230
; procedure terminate_th;
;
; nedlægger en terminal handler
;
; w1 error_no på fejltekst der skrives inden th fjernes
; w2 return
b. i12,j5 w.
g119:
d19: rl. w3 (r0.) ;
rs w1 x3+f27 ;
rl w0 x3+f21 ;
c.a88<3
rs. w3 6 ; *** test no 119 ***************
jl. w3 (r68.) ; w0 state w2 return
h. 119 , 1<8 w. ; w1 create_res. w3 curco
0 ;
z.
lo. w0 j0. ; state.finis:=1;
rs w0 x3+f21 ;
al w2 x3+f22+4 ;
dl w1 x2+2 ;
sn w1 x2 ;
se w0 x2 ;
jl. 4 ; if letter i kø til main_mbx then
jl. i12. ; begin
al w0 0 ; ingen timout
rl. w1 j3. ; w1:=mask; (1<12);
al w2 x3+f22 ; w2:=main_mbx;
jl. w3 (r25.) ; wait_letter(main_mbx,event_mask,letter,event_type);
rl w0 x1+8 ;
se w0 2 ; if letter.opcode = 2 then
jl. i12. ; begin /* th remove letter */
rl w2 x1+6 ; signal(letter.answer_sem);
jl. w3 (r31.) ; end
i12: al w1 p39 ; end;
la w1 x3+f21 ;
se w1 p31 ;
jl. i9. ; if state.type = th oprettet efter create link then
rl. w1 (r67.) ;
al w1 x1-1 ; en mindre th efter create link message
rs. w1 (r67.) ;
i9: rl w1 x3+q5 ; w1:=ph;
al w0 p39 ; w0:=ph.state.type;
la w0 x1+f21 ;
jl. w3 d15. ; remove_th_link; /* w0, w1 uændret */
sn w1 0 ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...41...
jl. i7. ; /* hvis der er en ph, og oprettet fra th, remove */
sn w0 p34 ; if ph<>0 and ph.state.type = oprettet fra th then
jl. w3 d14. ; remove_ph(ph);
i7: rl w1 x3+q22 ;
se w1 0 ; if mcl_entry<>0 then
jl. w3 (r19.) ; remove_mcl_name(mcl_entry);
; /* tøm mcl prog stack */
i1: rl w0 x3+q27 ;
sh w0 0 ; while mcl_top>0 do
jl. i2. ; begin
jl. w3 (r75.) ; pop(x,mcl_entry,y);
jl. w3 (r19.) ; remove_mcl_name(mcl_entry);
jl. i1. ; end;
; /* send end session til tascat */
i2: rl w0 x3+q16 ;
sn w0 0 ; if uid<>0 then
jl. i3. ; begin
rs w0 x3+q70 ; mes.uid:=uid;
rl. w0 j1. ; mes.opmode:=9 shift 12 + 5;
rs w0 x3+q66 ; mes.tpda:=tbuf.tdescr.tpda;
am (x3+q62) ; mes.th:=th;
rl w0 +f107 ;
sh w0 0 ; if mes.tpda<0 then mes.tpda:=-mes.tpda;
ac w0 (0) ;
rs w0 x3+q68 ;
rs w3 x3+q69 ;
al w1 x3+q66 ;
rl. w2 r38. ; csendmessage(mes,
jl. w3 (r34.) ; <:tascat:>,buf);
sh w2 1 ; if buf < 2 then
je -12 ; fault;
al w1 x3+q8 ;
al w0 0 ; cwaitanswer(buf,
jl. w3 (r33.) ; 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 ; end;
; /* remove mcl variable */
i3: rl w0 x3+q32 ; if mcl_var>0 then
sh w0 0 ; remove_spool_area(var_segno);
jl. i4. ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...42...
rl w1 x3+q30 ;
jl. w3 (r22.) ;
i4: rl w1 x3+f27 ; if create result <> 0
al w2 p39 ; and
la w2 x3+f21 ; state.type = th med mcl then
sn w2 p32 ;
sn w1 0 ; begin
jl. i8. ; tpda:=tbuf.tdescr.tpda;
rl w2 x3+q62 ;
rl w0 x2+f107 ; write_error(tpda,result);
jl. w3 (r66.) ; end;
i8: rl. w2 (r3.) ; /* frigiv terminal buffer */
rl w1 x3+q63 ;
jl. w3 (r49.) ; release_buffer(free_term,tbuf.taddr);
al w1 x3 ; /* ud af sessions kæden */
jl. w3 (r52.) ; get_from_session(th,cda,old_cur);
rs. w0 j2. ; gem gammel værdi af cur_th
rl w0 x3+f27 ;
sh w0 29 ; if create result > 0
sn w0 0 ; and create result < 30 then
jl. i6. ; signal(stop_sem)
al w2 x3+f26 ; else
jl. w3 (r31.) ;
jl. i5. ; begin
i6: al w0 1 ;
am (x3+q62) ;
rs w0 f115 ; tbuf.tdescr.th_stopped:=1;
sn w2 0 ; if cda<>0 and
jl. i5. ; old_cur_th=th /* denne */ then begin
se. w3 (j2.) ; /* næste skal starte menu, hvis der ikke har
jl. i5. ; været fejl, eller startes næste th */
rl w1 x3+q62 ; if tbuf.tdescr.s = 2 then
rl w0 x1+f113 ; tbuf.tdescr.s:=-1
se w0 2 ; else
jl. i10. ;
al w0 -1 ; cda.state.finis:=1;
rs w0 x1+f113 ;
jl. i11. ;
i10: rl w0 x2+f21 ;
lo. w0 j0. ;
rs w0 x2+f21 ;
i11: al w2 x2+f26 ; signal(cda.stop_sem);
jl. w3 (r31.) ;
al w2 -1 ; tbuf.tdescr.s:=-1;
\f
;; tas 1.0 14.05.87 terminal handler thtxt ...42a...
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...43...
rl w1 x3+q62 ; end;
rs w2 x1+f113 ; end;
i5: al w2 -1 ;
rl w1 x3+q62 ; if tbuf.tdescr.cth=th /* denne */ then
sn w3 (x1+f116) ; tbuf.tdescr.cth:=-1;
rs w2 x1+f116 ;
al w2 x3+f22 ; /* test main_mbx er tom */
dl w1 x2+2 ;
sn w1 x2 ;
se w0 x2 ;
je -54 ;
al w2 x3+f22+4 ;
dl w1 x2+2 ;
sn w1 x2 ;
se w0 x2 ;
je -54 ;
al w2 x3 ;
jl. (r53.) ; remove_coroutine(th);
j0: p14 ; state.finis
j1: 9<12+5 ;
j2: 0 ; old cur_th
j3: 1<12 ;
e.
; procedure direct(var_no);
;
; var_no (call) nummer på variabel der skal sættes med
; resultat teksten ved return
;
; I denne procedure ventes på operation på linket der forbinder en
; pool handler med en terminal handler, data fra operationer sendes
; til terminalen, og svaret i operationer via linket tilbage til
; pool handler
;
; call return
; w0: undef.
; w1: var_no undef.
; w2: undef.
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...44...
; w3: return curco
b. i10,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o9 + 0 ; saved return
q41 = o9 + 2 ; var_no
g120:
d20: rl. w2 (r0.) ;
c.a88<3
rs. w3 6 ; *** test no 120 **************
jl. w3 (r68.) ; w0 w2 curco
h. 120 , 1<8 w. ; w1 varno w3 return
0 ;
z.
rs w3 x2+q40 ; save return i cdescr;
rs w1 x2+q41 ; save var_no i cdescr;
i1: jl. w3 d10. ; NXT_OP: wait_op(op,r);
sn w2 -2 ; if r=-2 then goto C;
jl. i8. ;
sl w2 0 ; if op<0 then begin
jl. i2. ; /* link er fjernet */
al w0 p39 ;
la w0 x3+f21 ; if state.type<>th med mcl then
se w0 p32 ; return;
jl (x3+q40) ;
rl. w0 r55. ; w0:= addr <:removed:>;
rl w1 x3+q41 ;
jl. w3 d8. ; set_var(var_no,<:removed:>);
jl (x3+q40) ; return;
; end;
i2: zl w0 x2 ; w0:=op.opcode;
la. w0 j2. ; extract 6
se w0 1 ; if w0=1 then
jl. i3. ; /* soft remove */
al w1 0 ;
jl. w2 d19. ; terminate_th(0);
; else
i3: se w0 3 ; if w0=3 then begin
jl. i4. ; /* input */
jl. w3 d21. ; input_op(op,s);
;rl w1 x3+q76
;ks -800
al w1 0 ; if hard error i s then
sz. w0 (j3.) ; terminate_th(0);
\f
;; tas 1.0 14.05.87 terminal handler thtxt ...44a...
jl. w2 d19. ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...45...
jl. i8. ; end
; else
i4: se w0 5 ; if w0=5 then begin
jl. i5. ; /* output */
jl. w3 d22. ; output_op(op,s);
;rl w1 x3+q76
;ks -801
al w1 1 ;
sz. w0 (j3.) ; if hard error i s then
jl. (r76.) ; send_text_and_stop_th(hard_error)
jl. i8. ; end
; else
i5: se w0 9 ; if w0=9 then begin
jl. i6. ; /* sim input */
jl. w3 d23. ; sim_input(op);
jl. i8. ; end
; else
i6: se w0 20 ; if w0=20 then begin
jl. i7. ; /* control in/out */
jl. w3 d24. ; ctrl_op(op);
jl. i8. ; end
; else
i7: se w0 21 ; if w0=21 then begin
je -52 ; /* continue mcl */
rl w1 x3+q41 ;
jl. w3 d25. ; cont_mcl(op,var_no);
jl (x3+q40) ; return;
; end
; else fault;
i8: rl w0 x3+f21 ;C:
so. w0 (j0.) ; if state.cont=0 then
jl. i1. ; goto NXT_OP;
la. w0 j1. ;
rs w0 x3+f21 ; state.cont:=0;
rl. w0 r56. ; w0:=addr <:system:>;
rl w1 x3+q41 ;
jl. w3 d8. ; set_var(var_no,<:system:>);
jl (x3+q40) ; return;
j0: p12 ; state.cont
j1: -p12-1 ; -state.cont
j2: 2.111111 ;
j3: 2.1000000111100
e.
; procedure input_op(op,s);
;
; op (call) peger til operationen
; s (return) status for input operationen
;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...46...
; behandler input operation fra linket. Læser fra terminalen og
; sender læst data til tilhørende pool handler link.
;
; call return
; w0: s
; w1: undef.
; w2: op undef.
; w3: return curco
b. i50,j30 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o8 + 0 ; saved return
q41 = o8 + 2 ; n_hw
q42 = o8 + 4 ; timecount (temp 1<6 fra mode)
q43 = o8 + 6 ; sender (1<6 fra mode)
q44 = o8 + 8 ; rest characters (antal tegn i sidste ord i sidste indlæsning)
q45 = o8 +10 ; last first (start addr i sidste indlæsning)
q46 = o8 +12 ; first_buffer
g121:
d21: rl. w1 (r0.) ;
rs w3 x1+q40 ; save return i cdescr;
al w3 x1 ;
rl w0 x2 ; tbuf.op:=op.opcode;
so. w0 (j14.) ;
am -1 ; hvis 1<6 i opcode gemmes 1 i timeout
al w1 1 ; ellers gemmes 0
rs w1 x3+q42 ; fjern 1<6 fra opcode
c.a88<3
rl w1 x2+2 ;
rs. w3 6 ; *** test no 121 ***************
jl. w3 (r68.) ; w0 opcode,mode w2 op
h. 121 , 1<8 w. ; w1 op.hw w3 curco
0 ;
z.
la. w0 j13. ;
rs w0 x3+q66 ; tbuf.mode:=op.mode;
rl w1 x3+q63 ;
rs w1 x3+q68 ; tbuf.first:=tbuf.taddr;
wa w1 x2+2 ; tbuf.last:=tbuf.first + op.hw -2;
al w1 x1-2 ;
rs w1 x3+q69 ;
rl w1 x2+2 ;
rs w1 x3+q70 ; tbuf.n_hw:=op.hw;
rl w1 x2+4 ;
rs w1 x3+q43 ; sender:=op.sender;
al w1 x3+q7 ;
jl. w3 (r15.) ; release_op(link);
rl w0 x3+f21 ;
so. w0 (j0.) ; if state.f8000 then begin
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...47...
jl. i1. ; f8000_input;
jl. w3 d27. ; return;
jl (x3+q40) ; end;
i1: so. w0 (j1.) ; /* tty input */
jl. i2. ; if state.send_att=1 then begin
la. w0 j2. ; state.send_att:=0;
rs w0 x3+f21 ;
al w0 1 ; tbuf.result:=1;
rl. w1 j3. ; tbuf.status:= 1 shift 16; /* att */
ds w1 x3+q76 ;
al w0 0 ; tbuf.ch:=0;
rs w0 x3+q77 ; n_hw:=0;
rs w0 x3+q41 ; end
jl. i12. ; else
i2: al w0 3 ; begin
rl w1 x3+q62 ;
rl w2 x3+q43 ; if tbuf.tdescr.sender<>sender then
se w2 (x1+f114) ; write_to_from(sender,to);
jl. w3 (r70.) ;
rl w0 x3+q33 ;
sn w0 0 ; if ndisplay<>0 then
jl. i3. ; tbuf.mode:=8;
al w0 8 ;
hs w0 x3+q67 ;
i3: rl w0 x3+f21 ; if state.mtty=1 then
so. w0 (j4.) ; begin
jl. i4. ; /* plads til localid og nl */
dl w2 x3+q69 ; tbuf.first må ikke indeholde nl, kan give fejl
al w0 0 ; word(tbuf.first):=0;
rs w0 x1 ; tbuf.first:=tbuf.first+2;
al w1 x1+2 ; tbuf.last:=tbuf.last-2;
al w2 x2-2 ; end;
ds w2 x3+q69 ;
i4: al w0 0 ;
rs w0 x3+q77 ; tbuf.ch:=0;
rs w0 x3+q44 ; rest_char:=0;
rs w0 x3+q45 ; first_buffer:=tbuf.first;
rl w0 x3+q68 ; last_first:=0;
rs w0 x3+q46 ;
;ks -850
al w0 1 ;
rx w0 x3+q42 ; timercount:=1;
rs w0 x3+q43 ; sender sættes til gamle værdi af timercount
i5:
;ks -804
jl. w3 d30. ; R: term_send_wait(s);
rs. w0 j9. ;
rl w1 x3+f21 ;
so. w1 (j12.) ; if state.sim_input=1 then
jl. i14. ; begin
rl w1 x3+q0 ; used_buf:=used_buf-1;
al w1 x1-1 ; return;
rs w1 x3+q0 ; end;
jl (x3+q40) ;
i14: sn w0 2 ; if s<>2 then begin
jl. i7. ; /* ikke normal answer */
so. w0 (j5.) ;
\f
;; tas 1.0 14.05.87 terminal handler thtxt ...47a...
jl. i6. ; if timeout i s
rl w1 x3+q68 ; and
rl w2 x3+q42 ; tbuf.first<=tbuf.last
al w2 x2+1 ;
sh w1 (x3+q69) ; and
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...48...
sl w2 (x3+q4) ; timercount+1<maxtimer then
jl. i6. ; begin
;ks -805 ; timercount:=timercount+1;
rs w2 x3+q42 ; goto R;
jl. i5. ; end;
i6: al w1 0 ;
rs w1 x3+q43 ; clear 1<6 in mode.
al w1 p39 ; if th er med mcl then
la w1 x3+f21 ; begin
se w1 p32 ;
jl. i7. ;
sz w0 1<6 ; if send_att ikke i s then
jl. i7. ; begin
rl w2 x3+f21 ;
so. w2 (j4.) ;
jl. i13. ; if state.mtty=1 then
rl w2 x3+q77 ; if att i status and tbuf.ch=0 then
sz. w0 (j3.) ; goto R;
se w2 0 ; /* fjern att i status */
jl. 4 ;
jl. i5. ; tbuf.status:=tbuf.status - att;
i13: rl w1 x3+q76 ; end;
la. w1 j6. ; end;
rs w1 x3+q76 ; end;
i7: rl w0 x3+q44 ; if last_char <> 0 then
se w0 0 ; compress(last_char);
jl. w2 i30. ;
rl w2 x3+q68 ;
rs w2 x3+q45 ; last_first:=tbuf.first;
al w0 0 ;
rl w1 x3+q77 ;
wd. w1 j8. ; rest_chars := tbuf.ch mod 3;
;ks -852
rs w0 x3+q44 ;
rl w0 x3+f21 ;
so. w0 (j4.) ; if state.mtty = 1 then
jl. i10. ; begin
rl. w0 j9. ;
la. w0 j11. ;
sn w0 0 ;
jl. i11. ; if s<>(timeout,att,normal) then begin
al w0 1 ; tbuf.result:=1;
al w1 0 ; tbuf.status:=0;
ds w1 x3+q76 ;
al w0 17 ; tbuf.ch:=17;
rs w0 x3+q77 ;
rl w0 x3+q2 ;
rs. w0 j10. ; /* sæt tekst der skal sendes til pool som
al w0 12 ; <:<localid><2><2> hard error<10>*>
rs w0 x3+q41 ; n_hw:=12;
al. w1 j10. ;
rl w2 x3+q63 ; move(addr txt,tbuf.taddr,12);
jl. w3 (r26.) ; goto L;
jl. i12. ; end;
i11: am (x3+q68) ; w2:=word(tbuf.first-2);
rl w2 -2 ;
i8: sn w2 0 ; while w2<>0 do begin
jl. i9. ; w1w2:=w2 shift 8;
al w1 0 ; if w1=nl then goto F;
ld w2 8 ; end;
se w1 10 ;
jl. i8. ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...49...
jl. i16. ;
i9: dl w2 x3+q69 ; w1:=tbuf.first; w2:=tbuf.last;
rl w0 x3+q43 ;
ks -806
se w0 1 ; hvis 1<6 i mode og buffer
jl. i15. ; ikke fuld goto R
sh w1 x2 ;
jl. i5. ; /* ikke fundet nl, sæt ord med nl */
i15: rl. w0 j7. ; word(tbuf.first):=nl shift 16;
rs w0 x1 ;
al w1 x1+2 ; tbuf.first:=tbuf.first+2;
rs w1 x3+q68 ;
rl w2 x3+q77 ;
al w2 x2+3 ; tbuf.ch:=tbuf.ch+3;
rs w2 x3+q77 ;
i16: rl w0 x3+q2 ; F:
am (x3+q63) ;
rs w0 0 ; word(tbuf.taddr):=localid;
rl w2 x3+q77 ;
al w2 x2+3 ; tbuf.ch:=tbuf.ch+3;
rs w2 x3+q77 ; end;
i10: rl w2 x3+q68 ;
ws w2 x3+q63 ; n_hw:_tbuf.first-tbuf.taddr;
rs w2 x3+q41 ; end;
i12: rl. w0 j9. ; L:
rs w0 x3+q43 ; gem s
am (x3+q5) ; /* lås ph link */
al w2 q7+f72 ;
sn w2 q7+f72 ; if link nedlagt then
jl (x3+q40) ; return;
jl. w3 (r40.) ; wait_semaphor(ph.link.reserve);
rl w0 x3+f14 ;
am (x3+q5) ;
rs w0 +q7+f75 ; ph.link.ident:=ident;
rl w1 x3+q41 ;
al w0 0 ;
jl. w3 d26. ; answer_input(n_hw,0,removed);
al w0 0 ; s := 0;
sn w2 0 ; if removed=0 then
jl (x3+q40) ; return;
am (x3+q5) ;
al w2 q7 ; /*åbn ph link */
al w0 0 ;
rs w0 x2+f75 ; ph.link.ident:=0;
al w2 x2+f72 ;
jl. w3 (r31.) ; signal(ph.link.reserve);
rl w0 x3+q43 ; w0 := s;
jl (x3+q40) ; return;
; local procedure compress(rest_char);
; at call: w0 rest_char; w2 return; w3 curco
; at retrun: w0,w1,w2 undef. ; w3 curco;
i30: rs. w2 j20. ; save return;
rl w1 x3+q68 ;
al w1 x1-2 ;
rs. w1 j21. ; last := tbuf.first - 2;
rl w3 x3+q45 ; w3 := last_first
sl w1 x3 ; if last < last_first then
jl. i35. ; begin
rl. w3 (r0.) ; w3 = curco; return;
jl x2 ; end;
i35: rl w2 x3-2 ;
;ks -860
se w0 1 ; if rest_chars = 1 then
jl. i32. ; begin /* 2 nuller efter sidste input */
ls w2 -16 ;
i31: al w0 x2 ; skub alle tegn i bufferen to tilbage
rl w1 x3 ;
al w2 x1 ;
ld w1 16 ;
rs w0 x3-2 ;
al w3 x3+2 ;
sh. w3 (j21.) ;
jl. i31. ;
jl. i34. ; end
i32: ls w2 -8 ; else
i33: al w0 x2 ; begin /* 1 nul efter sidste input */
rl w1 x3 ;
al w2 x1 ; skub alle tegn i bufferen et tilbage
ld w1 8 ;
rs w0 x3-2 ;
al w3 x3+2 ;
sh. w3 (j21.) ;
jl. i33. ;
i34: rs w1 x3-2 ; end;
rl. w3 (r0.) ; w3 = curco;
al w0 0 ;
rl w1 x3+q77 ;
al w1 x1+2 ; bytes:=(tbuf.ch+2)/3*2;
wd. w1 j8. ;
ls w1 1 ;
wa w1 x3+q46 ; tbuf.first:=first_buf + bytes;
rs w1 x3+q68 ;
jl. (j20.) ; return;
j0: p6 ; state.f8000
j1: p16 ; state.send_att
j2: -p16-1 ; -state.send_att
j3: 1<16 ; status.att
j4: p5 ; state.mtty
j5: 1<21 ; status.timeout
j6: -(:1<16:)-1 ; -status.att
j7: 10<16 ; <:<nl><0><0>:>
j8: 3 ;
j9: 0 ; s
j10: 0 ; <loclaid>
<:<2><2> hard error<10>:>
j11: -(:1<21+1<16+1<1:)-1 ; -(timeout,att,normat)
j12: p22 ; state.sim_input
j13: -(:1<18:)-1
j14: 1<18
j20: 0 ; return addr compress
j21: 0 ; last
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...50...
e.
; procedure output_op(op,s);
;
; op (call) peger til operation
; s (return) status for output operationen
;
; behandler output operation modtaget fra link, Skriver data fra
; operationen ud på terminalen. Inden de skrives flyttes de til
; terminal buffer, dette kan ske af flere gange
;
; call return
; w0: s
; w1: undef.
; w2: op undef.
; w3: return curco
b. i10,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o7 + 0 ; saved return
q41 = o7 + 2 ; used_op
q42 = o7 + 4 ; n_hw
q43 = o7 + 6 ; rest
q44 = o7 + 8 ; sender
g122:
d22: rl. w1 (r0.) ;
rs w3 x1+q40 ; save return i cdescr;
al w3 x1 ;
rl w0 x2 ; tbuf.op:=op.opcode;
rs w0 x3+q66 ; tbuf.mode:=op.mode;
c.a88<3
rl w1 x2+2 ;
rs. w3 6 ; *** test no 122 ***************
jl. w3 (r68.) ; w0 opcode,mode w2 op
h. 122 , 1<8 w. ; w1 op.hw w3 curco
0 ;
z.
so w0 1<3 ; if op.mode shift -3 = 1 then
jl. i1. ; begin
rs w0 x3+q33 ; ndisplay:=op.mode;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...51...
la. w0 j1. ; tbuf.mode:=tbuf.mode-8;
rs w0 x3+q66 ; end
jl. i2. ; else
i1: al w0 0 ; ndisplay:=0;
rs w0 x3+q33 ;
i2: al w0 0 ;
rs w0 x3+q41 ; used_op:=0;
rl w1 x3+q62 ;
rl w1 x1+f114 ;
rs w1 x3+q44 ; sender:=tbuf.tdescr.sender;
sn w1 (x2+4) ; if op.sender<>sender then
jl. i3. ; begin
al w0 5 ;
rl w2 x2+4 ; write_to_from(sender,from);
jl. w3 (r70.) ;
al w1 x3+q7 ; check_op(link,l,op);
jl. w3 (r14.) ; end;
i3: rl w1 x2+2 ; repeat
ws w1 x3+q41 ; n_hw:=op.hw-used_op;
al w0 x1 ;
ws w1 x3+q64 ; rest:=n_hw - tbuf.size;
sh w1 0 ; if rest>0 then
jl. i4. ; n_hw:=tbuf.size
rl w0 x3+q64 ; else
jl. i5. ;
i4: al w1 0 ; rest:=0;
i5: ds w1 x3+q43 ;
al w1 x2+6 ; from:=op + 6 + used_op;
wa w1 x3+q41 ;
rl w2 x3+q63 ; to:=tbuf.taddr;
jl. w3 (r26.) ; move(from,to,n_hw);
rl w1 x3+q63 ;
al w2 x1 ;
wa w2 x3+q42 ; tbuf.first:=tbuf.taddr;
al w2 x2-2 ; tbuf.last:=tbuf.first + n_hw - 2;
ds w2 x3+q69 ;
rl w0 x3+q41 ;
wa w0 x3+q42 ; used_op:=used_op + n_hw;
rs w0 x3+q41 ;
jl. w3 d30. ; term_send_wait(s);
sz. w0 (j2.) ; if hard error i s then
jl. i8. ; goto R;
sz w0 1<7 ; if ikke skip i s then
jl. i8. ; begin
rl w1 x3+q69 ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...52...
sl w1 (x3+q68) ; if tbuf.first<=tbuf.last then
jl. +4 ; begin
jl. i7. ; /* ikke alt output skrevet, fx efter att */
ws w1 x3+q68 ; rest:=
al w1 x1+2 ; tbuf.last-tbuf.first+2;
rs w1 x3+q43 ;
rl w2 x3+q41 ; used_op:=used_op-rest;
ws w2 2 ;
rs w2 x3+q41 ; end;
i7: rl w1 x3+q43 ;
sn w1 0 ; if rest<>0 then
jl. i8. ;
al w0 5 ; if sender<>tbuf.tdescr.sender then
rl w1 x3+q62 ; write_to_from(sender,from);
rl w2 x3+q44 ;
se w2 (x1+f114) ;
jl. w3 (r70.) ; check_op(link,l,op);
al w1 x3+q7 ; end;
jl. w3 (r14.) ; end else rest:=0;
jl. i3. ; until rest=0;
i8: al w1 x3+q7 ;R: if ikke skip i s then
so w0 1<7 ; release_op(link);
jl. w3 (r15.) ; /* aldrig att i status */
rl w1 x3+q76 ; tbuf.status :=
la. w1 j0. ; tbuf.status - att;
rs w1 x3+q76 ;
jl (x3+q40) ; return;
j0: -(:1<16:)-1 ; -status.att
j1: -(:1<3:)-1 ; -bit 1<3
j2: 2.1000000111100
e.
; procedure sim_input(op);
;
; op (call) peger til operation
;
; behandler simulate input operation fra link. Data fra operationen
; sendes til pool handler link i en anden operation
;
; call return
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...53...
; w0: undef.
; w1: undef.
; w2: op undef.
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o6 + 0 ; saved return
q41 = o6 + 2 ; n_hw
g123:
d23: rl. w1 (r0.) ;
rs w3 x1+q40 ; save return i cdescr;
rl w0 x2+2 ;
rs w0 x1+q41 ; n_hw:=op.hw;
al w3 x1 ;
rl w1 x3+f21 ;
c.a88<3
rs. w3 6 ; *** test no 123 ***************
jl. w3 (r68.) ; w0 n_hw w2 op
h. 123 , 1<8 w. ; w1 state w3 curco
0 ;
z.
la. w1 j1. ; state.sim_input:=0;
rs w1 x3+f21 ;
al w1 x2+4 ; from:=op+4;
rl w2 x3+q63 ; to:=tbuf.taddr;
jl. w3 (r26.) ; move(from,to,n_hw);
al w1 x3+q7 ;
jl. w3 (r15.) ; release_op(link);
al w0 1 ;
al w1 0 ; tbuf.result:=1;
ds w1 x3+q76 ; tbuf.status:=0;
rl w2 x3+q41 ;
ls w2 -1 ;
wm. w2 j0. ;
rs w2 x3+q77 ; tbuf.ch:=n_hw/2*3;
am (x3+q5) ; /* lås ph link */
al w2 +q7+f72 ;
sn w2 q7+f72 ; if link nedlagt then
jl (x3+q40) ; return;
jl. w3 (r40.) ; wait_semaphor(ph.link.reserve);
rl w0 x3+f14 ;
am (x3+q5) ;
rs w0 +q7+f75 ; ph.link.ident:=ident;
\f
;; tas 1.0 14.05.87 terminal handler thtxt ...53a...
rl w1 x3+q41 ;
al w0 0 ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...54...
jl. w3 d26. ; answer_input(n_hw,0,removed);
sn w2 0 ; if removed=0 then
jl (x3+q49) ; return;
am (x3+q5) ;
al w2 +q7 ; /* åbn ph link */
al w0 0 ;
rs w0 x2+f75 ; ph.link.ident:=0;
al w2 x2+f72 ;
jl. w3 (r31.) ; signal(ph.link.reserve);
jl (x3+q40) ; return;
j0: 3
j1: -p22-1 ; -state.sim_input
e.
; procedure ctrl_op(op);
;
; op (call) peger til operationen
;
; behandler control oeration fra linket. Data sendes til
; terminalen i message buffer. Svaret sendes til pool handler
; i et letter.
;
; call return
; w0: undef.
; w1: undef.
; w2: op undef.
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o5 + 0 ; saved return
g124:
d24: rl. w1 (r0.) ;
rs w3 x1+q40 ; save return i cdescr;
al w3 x1 ;
\f
;; tas 1.0 14.05.87 terminal handler thtxt ...54a...
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...55...
rl w0 x2+2 ;
al w1 x2+2 ; from:=op+2;
rl w2 x3+q63 ; to:=tbuf.taddr+10;
al w2 x2+10 ;
al w0 16 ; /* flyt mes til term buffer */
jl. w3 (r26.) ; move(from,to,16);
zl w0 x2 ;
sn w0 132 ;
al w0 a6 ;
sn w0 134 ;
al w0 a5 ;
hs w0 x2 ;
al w1 x3+q7 ;
jl. w3 (r15.) ; release_op(link);
rl w2 x3+q63 ;
dl w1 x3+q65+2 ;
ds w1 x2+2 ; /* flyt navn fra tbuf til term buf */
dl w1 x3+q65+6 ;
ds w1 x2+6 ;
rl w1 x3+q65+8 ;
rs w1 x2+8 ;
c.a88<3
rl w0 x3+f13 ; *** test no 124 *********
so w0 1<8 ;
jl. i2. ;
rs. w2 j2. ;
rl. w0 j1. ; type = 124, length = 26
al w1 x2 ; tail = name, message
al w2 x3 ; fourth = curco
jl. w3 (r235.) ; testout
rl. w3 (r0.) ;
rl. w2 j2. ;
i2:
z.
al w0 x3+f22 ;
al w1 x2 ;
al w2 x3+q71 ; sendmessage(main_mbx,
jl. w3 (r54.) ; tbuf.taddr, tbuf.eda, r);
sn w2 0 ; if r=0 then
je -12 ; fault;
al w0 2 ;
jl. w3 (r58.) ; wait(2,answer_addr,result);
rs w0 x3+q13 ; let.result:=result;
rl w2 x3+q7+f75 ; ph:=link.ident; /* cda for ph */
sn w2 0 ; if ph <> 0 then
jl. i1. ; begin
al w0 16 ; /* flyt svar til ph cd hvis den findes */
al w2 x2+q8 ; move(answer_addr,ph.ans,16);
jl. w3 (r26.) ;
al w0 1<5 ;
rs w0 x3+q10 ; let.type:=1<5;
al w1 x3+q9 ;
al w2 x2+f22-q8 ;
jl. w3 (r39.) ; send_letter(ph.main_mbx,letter);
i1: al w0 0 ; end;
rs w0 x3+q7+f75 ; link.ident:=0;
jl (x3+q40) ; return;
j1: 26<12 +124
j2: 0
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...56...
e.
; procedure cont_mcl(op,var_no);
;
; op (call) peger til operation
; var_no (call) nummer på vartiabel tekst skal kopieres til
;
; behandler en continue_mcl operation fra link. Kopiere data fra
; operation til variabel.
;
; call return
; w0: undef.
; w1: var_no undef.
; w2: op undef.
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o4 + 0 ; saved return
q41 = o4 + 2 ; var_no
q42 = o4 + 4 ; op
g125:
d25: rs. w3 j0. ;
c.a88<3
rs. w3 6 ; *** test no 125 ***************
jl. w3 (r68.) ; w0 w2 op
h. 125 , 1<8 w. ; w1 var_no w3 return
0 ;
z.
rl. w3 (r0.) ;
ds w2 x3+q42 ; save var_no,op i cdescr;
rl. w0 j0. ;
rs w0 x3+q40 ; save return i cdescr;
al w1 x2+2 ; from:=op+2;
rl w2 x3+q63 ; to:=tbuf.taddr;
al w0 12 ;
jl. w3 (r26.) ; move(from,to,12);
al w1 x3+q7 ;
jl. w3 (r15.) ; release_op(link);
rl w0 x3+f21 ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...57...
al w1 p39 ;
la w1 0 ;
sn w1 p32 ; if state.type = th med mcl
so. w0 (j1.) ; and state.direct=1 then
jl (x3+q40) ; begin
rl w1 x3+q41 ;
am (x3+q63) ;
zl w2 1 ; n:= antal tegn i tekst i cmcl message
jl. w3 (r57.) ; alloc_var(var_no,va,n);
rl w1 x3+q63 ; from:=tbuf.taddr;
rl w0 x2 ;
rs w0 x1 ; sæt hw,ch i tbuf
zl w0 x2 ;
sl w2 1 ; if va>0 then
jl. w3 (r26.) ; move(from,va,va.hw);
jl (x3+q40) ; return;
j0: 0 ;
j1: p7 ; state.direct
j2: p12 ; state.cont
e.
; procedure answer_input(n_hw,continue,removed);
;
; n_hw (call) antal hw i svaret
; continue (call) sættes i operationen
; removed (return) =0 hvis link er fjernet, ellers 1
;
; sender en answer_input operation til pool handler link
;
; call return
; w0: continue undef.
; w1: n_hw undef.
; w2: removed
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o5 + 0 ; saved return
q41 = o5 + 2 ; continue
q42 = o5 + 4 ; n_hw
\f
;; tas 1.0 14.05.87 terminal handler thtxt ...57a...
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...58...
g126:
d26: rl. w2 (r0.) ;
c.a88<3
rs. w3 6 ; *** test no 126 ***************
jl. w3 (r68.) ; w0 continue w2 curco
h. 126 , 1<8 w. ; w1 n_hw w3 return
0 ;
z.
ds w1 x2+q42 ; save continue,n_hw i cdescr;
rs w3 x2+q40 ; save return i cdescr;
al w0 x1+18 ;
am (x2+q5) ;
al w1 q7 ;
rl. w2 r58. ; put_op(ph.link, n_hw+18,
jl. w3 (r13.) ; op, wait);
sn w2 0 ; if op=0 then return; /* link nedlagt */
jl (x3+q40) ;
rl. w0 j0. ;
wa w0 x3+q41 ;
rs w0 x2+0 ; op.opcode:=3,mode:=continue;
dl w1 x3+q76 ; op.result:=tbuf.result;
ds w1 x2+4 ; op.status:=tbuf.status;
rs w3 x2+6 ; op.sender:=th; /* denne coroutine */
rl w0 x3+f14 ;
rs w0 x2+8 ; op.senderid:=ident;
dl w1 110 ;
ds w1 x2+16 ; op.timestamp:=time;
rl w0 x3+q42 ;
rl w1 x3+q77 ; op.hw:=n_hw;
ds w1 x2+12 ; op.ch:=tbuf.ch;
sh w0 0 ; if n_hw>0 then
jl. i1. ; begin
rl w1 x3+q63 ; from:=tbuf.taddr;
al w2 x2+18 ; to:=op+18;
jl. w3 (r26.) ; move(from,to,n_hw);
; end;
i1: am (x3+q5) ;
al w2 q7+f71 ;
jl. w3 (r31.) ; signal(ph.link.operation);
al w2 1 ;
jl (x3+q40) ; return;
j0: 3<12 ;
e.
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...59...
; procedure f8000_input(s)
;
; s (return) status fra input operationen
;
; læser en f8000 input transaktion fra en extern process, og sender den
; i en eller flere operationer til pool handler link
;
; call return
; w0: s
; w1: undef.
; w2: undef.
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o7 + 0 ; saved return
q41 = o7 + 2 ; e
q42 = o7 + 4 ; n_hw
q43 = o7 + 6 ; s
g127:
d27: rl. w2 (r0.) ;
c.a88<3
rs. w3 6 ; *** test no 127 ***************
jl. w3 (r68.) ; w0 w2 curco
h. 127 , 1<8 w. ; w1 w3 return
0 ;
z.
rs w3 x2+q40 ; save return i cdescr;
jl. w3 d29. ; f8000_read(n_hw,s,e);
rs w0 x3+q43 ;
rs w1 x3+q42 ;
rs w2 x3+q41 ;
am (x3+q5) ;
al w2 q7+f72 ;
sn w2 q7+f72 ; if link nedlagt then
jl (x3+q40) ; return;
jl. w3 (r40.) ; wait_semaphor(ph.link.reserve);
rl w0 x3+f14 ;
am (x3+q5) ;
rs w0 q7+f75 ; ph.link.ident:=ident;
rl w0 x3+q43 ;
sn w0 2 ; if s<>2 then
jl. i1. ; /* ikke normal answer, send dumme answer */
ld w1 -65 ; answer_input(0,0,removed);
jl. w3 d26. ; else
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...60...
jl. i3. ; begin
i1: rl w1 (x3+q68) ; /* modif cu,dev */
rl w0 x3+q3 ;
ls w0 16 ;
lo w1 0 ; word(tbuf.first):=
rs w1 (x3+q68) ; word(tbuf.first) or (cuext shift 16);
dl w1 x3+q42 ; answer_input(n_hw,e,remove);
jl. w3 d26. ;
i2: rl w0 x3+q43 ;
rl w1 x3+q41 ; w1:=e; w0:=s;
se w1 0 ;
se w0 2 ; while e=1 and s=2 do
jl. i3. ; begin
jl. w3 d29. ; f8000_read(n_hw,s,e);
rs w0 x3+q43 ;
al w0 x2 ;
ds w1 x3+q42 ; answer_input(n_hw,e,removed);
jl. w3 d26. ; end;
jl. i2. ; end;
i3: sn w2 0 ; if remove=0 then
jl (x3+q40) ; remove;
al w0 0 ;
rl w2 x3+q5 ; ph.link.ident:=0;
rs w0 x2+q7+f75 ;
al w2 x2+q7+f72 ;
jl. w3 (r31.) ; signal(ph.link.reserve);
rl w0 x3+q43 ; w0:=s;
jl (x3+q40) ; return;
e.
; procedure send_f8000(s,n_hw);
;
; s (return) = ans.status + 1 shift result
; n_hw (return) antal hw læst
;
; sender en f8000 input/output message til gin/gout, og venter på
; svaret
;
; call return
; w0: s
; w1: n_hw
; w2: undef.
; w3: return curco
b. i5,j5 w.
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...61...
; proceduren bruger følgende lokale variable i cdescr
q40 = o5 + 0 ; saved return
g128:
d28: rl. w2 (r0.) ;
c.a88<3
rs. w3 6 ; *** test no 128 ***************
jl. w3 (r68.) ; w0 w2 curco
h. 128 , 1<9 w. ; w1 w3 return
0 ;
z.
rs w3 x2+q40 ; save return i cdescr;
rl w1 x2+q63 ;
al w0 x1 ; tbuf.first:=tbuf.taddr;
wa w1 x2+q64 ; tbuf.last:=
al w1 x1-2 ; tbuf.first+tbuf.size-2;
ds w1 x2+q69 ;
al w0 x2+f22 ;
al w1 x2+q65 ;
al w2 x2+q71 ; sendmessage(main_mbx,
jl. w3 (r54.) ; tbuf.name,tbuf.eda,r);
sh w2 0 ; if r=0 then
je -12 ; fault;
al w0 2 ;
jl. w3 (r58.) ; wait(2,answer_addr,r);
sn w0 1 ; if r<>1 then begin
jl. i1. ; ans.status:=0;
ld w2 -65 ; ans.hw:=0;
ds w2 x3+q8+2 ; end;
i1: rl w2 x3+q8+2 ; n_hw:=ans.n_hw;
ls w2 -1 ;
wm. w2 j0. ;
rs w2 x3+q77 ; tbuf.ch:=n_hw/2*3;
rl w1 x3+q8 ; tbuf.result:=r;
ds w1 x3+q76 ; tbuf.status:=ans.status;
al w0 1 ;
ls w0 (x3+q75) ; s:= 1 shift r + tbuf.status;
wa w0 2 ;
rl w1 x3+q8+2 ;
jl (x3+q40) ; return;
j0: 3 ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...62...
e.
; procedure f8000_read(n_hw,s,e);
;
; s (return) = ans.status + 1 shift result
; e (return) =0 hvis etx i sidste ord, eller 1
; n_hw (return) antal hw læst
;
; læser data fra en f8000 extern process, sætter data i tbuf
;
; i tbuf ændres tbuf.result = result fra waitanswer
; tbuf.status = status fra answer
; tbuf.ch = antal tegn læst (=n_ch/2*3)
;
; call return
; w0: s
; w1: n_hw
; w2: e
; w3: return curco
b. i9,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o6 + 0 ; saved return
q41 = o6 + 2 ; timeout
q42 = o6 + 4 ; x
g129:
d29: rl. w2 (r0.) ;
c.a88<3
rs. w3 6 ; *** test no 129 ***************
jl. w3 (r68.) ; w0 w2 curco
h. 129 , 1<9 w. ; w1 w3 return
0 ;
z.
rs w3 x2+q40 ; save return i cdescr;
; repeat /* læs til data, eller for magen timeout */
i1: jl. w3 d28. ; send_f8000(s,n_hw);
sn w0 2 ; if s=2
se w1 0 ; and n_hw=0 then
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...63...
jl. i4. ; begin
al w0 0 ; /* ingen data, vent med sense ready */
rs w0 x3+q41 ;
rl w0 x3+q66 ; timeout:=0;
rs w0 x3+q42 ; x:=tbuf.opmode;
al w0 2 ; tbuf.opmode:=2; /* sense ready */
rs w0 x3+q66 ;
i2: rl w0 x3+q41 ; while
sl w0 (x3+q4) ; timeout<maxtimer do
jl. i7. ; begin
jl. w3 d28. ; send_f8000(s,n_hw);
se. w0 (j2.) ; if s<>timeout then goto f;
jl. i3. ; timeout:=timeout+1;
rl w1 x3+q41 ; end;
al w1 x1+1 ;
rs w1 x3+q41 ;
jl. i2. ;
i7: rl. w0 j2. ; s:=timeout;
i3: rl w1 x3+q42 ; f: tbuf.opmode:=x;
rs w1 x3+q66 ; n_hw:=0;
al w1 0 ; end;
i4: sn w0 2 ; until n_hw>0 or s<>2;
se w1 0 ;
jl. +4 ;
jl. i1. ;
rs. w3 6 ;
jl. w3 (r68.) ; testout_registers
h. 702 , 1<8 w. ; test_no 702, mask = 1<8
0 ;
rs. w1 j1. ;
al w2 0 ; e:=0;
sh w1 0 ; if n_hw>0 then
jl. i8. ; begin e:=1;
wa w1 x3+q68 ; w2:=
rl w2 x1-2 ; word(tbuf.first+n_hw-2);
i5: sn w2 0 ; while w<>0 do begin
jl. i6. ; w1w2:=w2 shift 8;
al w1 0 ; if w1=etx then begin
ld w2 8 ; e:=0; goto F;
se. w1 (j0.) ; end;
jl. i5. ; end;
am -1 ; end;
i6: al w2 1 ; F:
i8: rl. w1 j1. ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...64...
jl (x3+q40) ; return;
j0: 3 ; etx
j1: 0 ; n_hw
j2: 1<21 + 1<1 ; timeout status
e.
; procedure term_send_wait(s);
;
; s (return) sættes til ans.status + 1 shift result
; + 1 shift 6 /* hvis state.att fra sysm */
; + 1 shift 7 /* hvis state.kill fra sysm */
;
; sender en io message i tbuf til terminalen og venter på svaret
;
; call return
; w0: s
; w1: undef.
; w2: undef.
; w3: return curco
b. i20,j10 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o6 + 0 ; saved return
q41 = o6 + 2 ; s
g130:
d30: rl. w2 (r0.) ;
rs w3 x2+q40 ; save return i cdescr;
al w3 x2 ;
i1: ; REP:
c.a88<3
rl w0 x3+f13 ; *** test no 130 *********
so w0 1<8 ;
jl. i16. ;
rl. w0 j7. ; type = 130, length = 16
al w1 x3+q65 ; tail = name, message
al w2 x3 ; fourth = curco
jl. w3 (r235.) ; testout
rl. w3 (r0.) ;
i16:
z.
al w0 x3+f22 ;
al w1 x3+q65 ;
al w2 x3+q71 ; sendmessage(main_mbx,
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...65...
jl. w3 (r54.) ; tbuf.name,tbuf.eda,r);
sn w2 0 ; if r=0 then
je -12 ; fault;
al w0 2 ;
jl. w3 (r58.) ; wait(2,ans,r);
rs w0 x3+q75 ; tbuf.result:=r;
sn w0 1 ; if r<>1 then
jl. i2. ; begin
al w0 0 ; ans.status:=0;
rs w0 x1 ; ans.hw:=0;
rs w0 x1+2 ; ans.ch:=0;
rs w0 x1+4 ; end;
i2: rl w0 x3+q68 ;
wa w0 x1+2 ;
rs w0 x3+q68 ; tbuf.first:=tbuf.first+ans.hw;
rl w0 x3+q77 ;
wa w0 x1+4 ;
rs w0 x3+q77 ; tbuf.ch:=tbuf.ch+ans.ch;
al w0 0 ;
rs w0 x3+q41 ; s:=0;
rl w0 x1+0 ;
rs w0 x3+q76 ; tbuf.status:=ans.status;
;ks -807
so. w0 (j0.) ; if att i ans.status then
jl. i9. ; begin
al w0 p39 ;
la w0 x3+f21 ;
se w0 p31 ; if state.type=th uden mcl then
jl. i4. ; begin
zl w0 x3+q66 ;
se w0 5 ; if tbuf.op=output then
jl. i10. ; begin
rl w0 x3+q68 ; if tbuf.first<=tbuf.last then
sh w0 (x3+q69) ; goto REP;
jl. i1. ; end;
; end
; else
i4: se w0 p32 ; if state.type=th med mcl then
jl. i8. ; begin
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...66...
jl. w3 (r62.) ; wait_term;
rl w0 x3+f21 ;
so. w0 (j2.) ; if state.att=1 then
jl. i6. ; begin
la. w0 j3. ; state.att:=0;
rs w0 x3+f21 ;
zl w0 x3+q66 ; if tbuf.op = output then
se w0 5 ; begin
jl. i5. ;
jl. w3 (r71.) ; send_attention;
rl w0 x3+q68 ; if tbuf.first<=tbuf.last then
sh w0 (x3+q69) ; goto REP;
jl. i1. ;
rl w0 x3+q76 ; tbuf.status:=tbuf.status - att;
la. w0 j1. ; end;
rs w0 x3+q76 ;
i5: al w0 1<6 ; s:=1 shift 6;
rs w0 x3+q41 ; end;
rl w0 x3+f21 ;
i6: so. w0 (j4.) ; if state.skip=1 then
jl. i10. ; begin
la. w0 j5. ;
rs w0 x3+f21 ; state.skip:=0;
rl w1 x3+q41 ;
al w1 x1+1<7 ; s:=s+ 1 shift 7;
rs w1 x3+q41 ;
zl w0 x3+q66 ; if tbuf.op=output then
se w0 5 ; begin
jl. i10. ;
al w1 x3+q7 ;
rl w0 x1+f74 ;
se w0 0 ; if link.cur_op<>0 then
jl. w3 (r15.) ; release_op(link);
i7: am (x3+q7) ;
rl w0 +f71+4 ; while link.operations>0 do
sh w0 0 ; begin
jl. i11. ;
jl. w3 (r59.) ; wait_op(op);
sh w2 0 ; if op>0 then
jl. i12. ; begin
zl w0 x2 ; if op.opcode<>output then
se w0 5 ; goto S;
jl. i12. ; release_op(link);
rl w1 x3+q7 ; end else goto S;
jl. w3 (r15.) ;
jl. i7. ; end;
i11: rl w1 x3+q5 ;
\f
;; tas 1.0 14.05.87 terminal handler thtxt ...66a...
rl w0 x1+f21 ;
lo. w0 j6. ; ph.state.outatt:=1;
rs w0 x1+f21 ;
i12: al w0 1 ; S: tbuf.result:=1;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...67...
al w1 0 ; tbuf.status:=0;
ds w1 x3+q76 ; end; /* output */
jl. i10. ; end; /* skip */
; end /* th med mcl */
; else
i8: zl w0 x3+q66 ; begin /* sys menu */
se w3 5 ; if tbuf.op=output then
jl. i10. ; begin
rl w0 x3+q68 ; if tbuf.first<=tbuf.last then
sh w0 (x3+q69) ; goto REP;
jl. i1. ;
rl w0 x3+q76 ; tbuf.status:=
la. w0 j1. ; tbuf.status - att;
rs w0 x3+q76 ; end;
jl. i10. ; end;
; end
; else
i9: al w1 1 ; begin
ls w1 (x3+q75) ; q:=tbuf.status +
wa w1 x3+q76 ; 1 shift tbuf.result;
zl w0 x3+q66 ;
se w0 3 ; if tbuf.op=output
se w1 2 ; and q=2 then
jl. i10. ; if tbuf.first<=tbuf.last then
rl w0 x3+q68 ; goto REP;
sh w0 (x3+q69) ;
jl. i1. ; end;
i10: al w0 1 ; w0:= 1 shift tbuf.result
ls w0 (x3+q75) ; + tbuf.status;
wa w0 x3+q76 ;
wa w0 x3+q41 ; s:= s + w0;
c.a88<3
rl w1 x3+q75 ;
rl w2 x3+q8+2 ;
rs. w3 6 ; *** test no 171 ********
jl. w3 (r237.) ; w0 s w2 ans.hw
h. 171 , 1<8 w. ; w1 tbuf.result w3 curco
0 ;
z.
jl (x3+q40) ; return;
j0: 1<16 ;status.att
j1: -(:1<16:)-1 ; -status.att
j2: p15 ; state.att
j3: -p15-1 ; -state.att
j4: p11 ; state.skip
j5: -p11-1 ; -state.skip
j6: p13 ; state.outatt
j7: 16<12 + 130
e.
; extern variable, indeholder adresser på variable og rutiner
r230: h. m10 , r231. w. ; e20 signal
r231: h. m8 , r232. w. ; e18 cwaitanswer
r232: h. m7 , r233. w. ; e16 csendmessage
r233: h. m100 , r234. w. ; c55 addr signon text buffer
r234: h. m95 , r235. w. ; g30 get term data
r235: h. m0 , r236. w. ; e0 testout
r236: h. m24 , r237. w. ; c0 curco
r237: h. m176 , r238. w. ; e1 testout registers
r238: h. m123 , r239. w. ; c26 tascat
r239: h. m11 , 0 w. ; e22 wait semaphore
; end init liste
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...68...
; procedure signon(result);
;
; result (return) =0 ok, <>0 fejl
;
; sender en signon message til tascat, finder en terminal type
; beskrivelse, og skriver signon teksten på terminalen.
;
; call return
; w0: result
; w1: undef.
; w2: undef.
; w3: return curco
b. i10,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o9 + 0 ; saved return
q41 = o9 + 2 ; result
g131:
d31: rl. w2 (r236.) ;
c.a88<3
rs. w3 6 ; *** test no 131 ***************
jl. w3 (r237.) ; w0 w2 curco
h. 131 , 1<8 w. ; w1 w3 return
0 ;
z.
rs w3 x2+q40 ; save return i cdescr;
rl. w2 (r233.) ;
jl. w3 (r239.) ; wait_semaphor(signon): /* lås signon buffer */
rl. w2 (r233.) ;
rl w1 x3+q62 ;
rl w0 x1+f107 ; signon.tpda:=tbuf.tdescr.tpda;
rs w0 x2+12 ;
al w1 x2+6 ; csendmessage(
rl. w2 r238. ; signon.mes,<:tascat:>,buf);
jl. w3 (r232.) ;
sh w2 1 ; if buf<2 then
je -12 ; fault;
al w0 0 ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...69...
al. w1 j0. ; cwaitanswer(
jl. w3 (r231.) ; buf.0.ans,r);
se w0 1 ; if r<>1 then
je -18 ; fault;
rl. w0 j0. ;
se w0 12 ; if ans.result = main console then
jl. i6. ; begin
rl w0 x3+f21 ;
lo. w0 j1. ; state.link_created:=1;
rs w0 x3+f21 ; result:=31; /* bypassed */
al w0 31 ; goto end_signon;
jl. i4. ; end;
i6: se w0 0 ; if ans.result<>0 then
jl. i8. ; goto clear_and_end_signon;
rl. w2 (r233.) ;
zl w0 x2+14 ;
rl w1 x3+f21 ;
sz w0 1 ; if bypass<>0 and
so. w1 (j1.) ; state.link_created=1 then
jl. i5. ; result:=31; <:bypassed:>
al w0 31 ; goto end_get;
jl. i4. ; end;
i5: so w0 2 ; if nologin<>0 then
jl. i10. ; th.state.nologin:=1;
lo. w1 j5. ;
rs w1 x3+f21 ;
i10: zl w0 x2+15 ;
jl. w3 (r234.) ; get_term_data(ttda,signon.type);
se w1 0 ; if ttda=0 then begin
jl. i2. ; result:=20; <* - type beskrivelser :>
al w0 20 ; goto clear_and_end_signon;
jl. i8. ; end;
i2: rl w2 x3+q62 ; tdescr:=tbuf.tdescr;
rs w1 x2+f110 ; tdescr.ttda:=ttda;
zl w0 x1+1 ;
rs w0 x2+f109 ; tdescr.type:=ttda.type;
bz w0 x1+f134 ;
sn w0 0 ; if ttda.mode <> 0 then
jl. i7. ; begin /* sæt mode i term attribute */
rl w1 x2+f111+2 ;
rs. w1 j4. ; gem mode fra tdescr.termspec
ls w1 -10 ;
ls w1 10 ; tdescr.termspec.mode := mode;
wa w1 0 ;
rs w1 x2+f111+2 ;
al w1 x2+f111 ; csendmessage(tdescr.name,
al w2 x2+f108 ; tdescr.termspec,buf);
jl. w3 (r232.) ;
sh w2 2 ; if buf > 2 then
jl. i9. ;
al. w1 j0. ; cwaitanswer(buf,0,ans,r);
al w0 0 ;
jl. w3 (r231.) ;
i9: rl w2 x3+q62 ;
rl. w0 j4. ; restore mode i tdescr.termspec
rs w0 x2+f111+2 ; end;
i7: al w1 0 ; rep:
al w2 0 ;
jl. w3 d50. ; cursor(0,0,s);
se w0 2 ; if s<>2 then
jl. i3. ; goto err;
jl. w3 d49. ; erase(s);
se w0 2 ; if s<>2 then
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...70...
jl. i3. ; goto err;
rl. w1 (r233.) ;
al w1 x1+16 ; outtext(signon+16,s);
jl. w3 d46. ;
sz. w0 (j3.) ; if att i s then
jl. i7. ; goto rep;
i3: se w0 2 ; err:
am 12 ; if s=2 then
al w0 0 ; result:=0 else result:=12; /*terminal io error*/
i8: rl w2 x3+f21 ; clear_and_end_signon:
la. w2 j2. ; state.link_created:=0;
rs w2 x3+f21 ;
i4: rs w0 x3+q41 ; end_signon:
rl. w2 (r233.) ;
jl. w3 (r230.) ; signal(signon); /* åbn for signon buffer */
rl w0 x3+q41 ;
jl (x3+q40) ; return;
j0: 0,r.8 ; answer area
j1: p20 ; state.link_created
j2: -p20-1 ; -state.link_created
j3: 1<16 ; attention
j4: 0 ; saved mode
j5: p23 ; state.nologin
e.
; procedure write_to_from(pda,to_from);
;
; pda (call) ext pda på process hvis navn skal skrives
; to_from (call) =5 skrives from eller to
;
; skriver teksten <10>to <process navn><10> eller <10>from <process navn><10>
; på terminal knyttet til terminal handleren, process navn er givet ved tpda
;
; call return
; w0: to_from undef.
; w1: undef.
; w2: pda undef.
; w3: return curco
b. i5,j15 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o1 + 0 ; saved return
<:<10>to :>
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...71...
j2=k-2
<:<10>from :>
j3=k-2
j5: 0 ; tekst buffer
j6: 0 ;
0 ; <process navn>
j7: 0 ;
0 ;
j8: 0 ;
<:<10>:> ;
j9=k-2
j10: 5<12 + 0 ; output message
0 ;
j11: 0 ;
j12: 0,r.8 ; answer area
g132:
d32: al w1 x3 ;
rl. w3 (r80.) ; w3 = curco
c.a88<3
rs. w3 6 ; *** test no 132 ***************
jl. w3 (r106.) ; w0 to_from w2 pda
h. 132 , 1<8 w. ; w1 return w3 curco
0 ;
z.
rs w1 x3+q40 ; save return i cdescr;
se w0 5 ; if output then write <:from:>
am j2-j3 ; else write <:to:>
dl. w1 j3. ;
ds. w1 j6. ;
sh w2 8 ;
jl (x3+q40) ; if tpda < 8 or
rl. w1 (r107.) ; tpda > own cpa then
rl w1 x1+96 ; return;
sl w2 x1 ;
jl (x3+q40) ;
rl w1 x3+q62 ; tbuf.tdescr.sender:=pda;
rs w2 x1+f114 ;
dl w1 x2+4 ; sæt process navn i tekst buffer
sh w0 0 ;
jl. i1. ; if første ord = 0 then
ds. w1 j7. ; process navn = <::>
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...72...
dl w1 x2+8 ; else
ds. w1 j8. ; process navn = navn i tpda
jl. i2. ;
i1: al w1 0 ;
ds. w1 j7. ;
ds. w1 j8. ;
i2: al. w1 j5. ; mes.first := første ord i tekst
al. w2 j9. ;
ds. w2 j11. ; mes.last := sidste ord i tekst
al. w1 j10. ;
al w2 x3+q65 ; name := navn i tdescr
jl. w3 (r95.) ; csendmessage(mes,name,buf);
sh w2 1 ;
jl (x3+q40) ; if buf<2 then return; /* ikke sendt */
al w0 0 ; ikke timeout
al. w1 j12. ;
jl. w3 (r85.) ; cwaitanswer(buf,0,ans,r);
jl (x3+q40) ; return;
e.
; procedure get_mcl_var;
;
;
; proceduren sikre at mcl variable er i en corebuffer
;
; call return
; w0: unch.
; w1: unch.
; w2: unch.
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o1 + 0 ; saved w0
q41 = o1 + 2 ; saved w1
q42 = o1 + 4 ; saved w2
q43 = o1 + 6 ; saved return
g133:
d33: rs. w3 j0. ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...73...
rl. w3 (r80.) ;
ds w1 x3+q41 ; save w0,w1,w2,return i cdescr;
rs w2 x3+q42 ;
rl. w0 j0. ; /* find corebuffer, læs hvis ikke i lager
rs w0 x3+q43 ; sæt write bit i coretable indgang */
rl w2 x3+q30 ; get_spool_segment(var_segno,var_seg_addr,3);
al w1 3 ;
jl. w3 (r94.) ;
rs w2 x3+q31 ;
dl w1 x3+q41 ; restore w0,w1,w2;
rl w2 x3+q42 ;
jl (x3+q43) ; return;
j0: 0 ; saved return
e.
; procedure unlock_mcl_var;
;
;
; fjerner reservationen af corebuffer til mcl variable
;
; call return
; w0: unch.
; w1: unch.
; w2: unch.
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o1 + 0 ; saved w0
q41 = o1 + 2 ; saved w1
q42 = o1 + 4 ; saved w2
q43 = o1 + 6 ; saved return
g135:
d35: rs. w3 j0. ;
rl. w3 (r80.) ;
ds w1 x3+q41 ; save w0,w1,w2,return i cdescr;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...74...
rs w2 x3+q42 ;
rl. w0 j0. ;
rs w0 x3+q43 ;
rl w1 x3+q30 ;
am. (r92.) ;
am (0) ;
zl w1 x1 ; cte:=segmenttable(var_segno)*8 + coretable_base;
ls w1 3 ;
wa. w1 (r93.) ;
rl w0 x1 ;
la. w0 j1. ; cte.prio.L:=0;
rs w0 x1 ;
jl. w3 (r110.) ; corebuf_open;
rl w2 x3+q30 ; /* find corebuffer, læs hvis ikke i lager
al w1 3 ; sæt write bit i coretable indgang */
jl. w3 (r94.) ; get_spool_segment(var_segno,var_seg_addr,3);
rs w2 x3+q31 ;
dl w1 x3+q41 ; restore w0,w1,w2;
rl w2 x3+q42 ;
jl (x3+q43) ; return;
j0: 0 ; saved return
j1: -(:1<22:)-1 ;
e.
; procedure gen_localid(ph,localid);
;
; ph (call) cda for pool handler coroutine
; localid (return) entydig localid
;
; generere en localid der er entydig i pool
; localid består af et ord med 3 tegn med formen xxy,
; hvor xx er fra 00 til 99, og y er fra a til z
;
; call return
; w0: localid
; w1: undef.
; w2: ph unch.
; w3: return curco
b. i5,j5 w.
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...75...
g136:
d36: rs. w3 j0. ; save return
al w0 0 ;
rl w1 x2+q25 ; n:=ph.localid_no;
wd. w1 j2. ; b:=n / 100; rst:=n mod 100;
al w3 x1+97 ; ch3:= b + 97; /* a,b,c osv */
rl w1 0 ;
al w0 0 ; ch1 := rst / 100; (w1)
wd. w1 j3. ; ch2 := rst mod 100; (w0)
al w1 x1+48 ;
ls w1 16 ; ch1 := (ch1 + 48) shift 16;
wa. w0 j4. ; ch2 := (ch2 + 48) shift 8;
ls w0 8 ;
wa w0 2 ;
wa w0 6 ; localid:=ch1 + ch2 + ch3;
rl w1 x2+q25 ; w1:=ph.localid_no;
c.a88<3
rs. w3 6 ; *** test no 136 ***************
jl. w3 (r106.) ; w0 localid w2 ph
h. 136 , 1<8 w. ; w1 localidno w3
0 ;
z.
al w1 x1+1 ; w1:=w1+1;
sn. w1 (j5.) ; if w1=2600 then w1:=0; /* max er 2600 */
al w1 0 ;
rs w1 x2+q25 ; ph.localidi_no:=w1;
rl. w3 (r80.) ; w3:=curco;
jl. (j0.) ; return;
j0: 0 ; saved return
j2: 100
j3: 10
j4: 48
j5: 2600 ; 100*26 /* antal forskellige localid */
e.
; procedure send_text(w1);
;
; sender en tekst til den pool handler der hører til th'en
; hvorefter th nedlægges
;
; w1 er nummer på den tekst der skal sendes
; =0 <:<localid><1><1> out <10>:>
; =1 <:<localid><2><2> hard error<10>:>
\f
;; tas 1.0 14.05.87 terminal handler thtxt ...75a...
;
b. i5,j6 w.
j3: 0 ; <localid> i out text
<:<2><2> out <10>:>
j4: 0 ; <localid> i hard error tekst
<:<2><2> hard error<10>:>
j5: 3<12 + 0 ; opcode
j6: p5 ; state.mtty
g137:
d37: rl. w3 (r80.) ;
rs w1 x3+f27 ;
rl w0 x3+f21 ; if state.mtty = 1 then
so. w0 (j6.) ; begin
jl. i2. ;
am (x3+q5) ; /* lås ph link */
al w2 q7+f72 ;
jl. w3 (r83.) ; wait_semaphor(ph.link.reserve);
rl w0 x3+f14 ;
am (x3+q5) ;
rs w0 q7+f75 ; ph.link.ident:=ident;
al w0 34 ;
am (x3+q5) ;
al w1 q7 ;
rl. w2 r83. ; put_op(ph.link, 34,
jl. w3 (r103.) ; op, wait_semaphore);
sn w2 0 ; if op=0 then
jl. i1. ; goto F;
rl. w0 j5. ;
rs w0 x2+0 ; op.opcode:=3,mode:=0;
al w0 1 ; op.result:=1;
al w1 0 ; op.status:=0;
ds w1 x2+4 ;
rs w3 x2+6 ; op.sender:=th; /* denne coroutine */
rl w0 x3+f14 ;
rs w0 x2+8 ; op.senderid:=ident;
rl w1 x3+f27 ; if tekst = out then
se w1 0 ; begin
am 2 ; op.hw:=10; op.ch:=13;
al w0 10 ; end else begin
se w1 0 ; op.hw:=12;
am 4 ; op.ch:=17;
al w1 13 ; end;
ds w1 x2+12 ;
\f
;; tas 1.0 14.05.87 terminal handler thtxt ...75b...
dl w1 110 ;
ds w1 x2+16 ; op.timestamp:=time;
al w2 x2+18 ; to:=op+18;
rl w0 x3+q2 ;
rl w1 x3+f27 ; if tekst = out then
se w1 0 ; text:=out
am j4-j3 ; else
al. w1 j3. ; text:=hard error;
rs w0 x1 ; /* sæt tekst der skal sendes til pool som */
rl w0 x2-8 ;
jl. w3 (r89.) ; move(from,to,l);
am (x3+q5) ;
al w2 q7+f71 ;
jl. w3 (r101.) ; signal(ph.link.operation);
rl w1 x3+q0 ; /* tæl buf_used 1 op, fordi den tælles en ned
al w1 x1+1 ; af ph uden ph har sendt input til th */
rs w1 x3+q0 ; used_buf:=used_buf+1
i1: am (x3+q5) ; F: /* frigiv ph link */
al w2 q7 ;
al w0 0 ;
rs w0 x2+f75 ; ph.link.ident:=0;
al w2 x2+f72 ;
jl. w3 (r101.) ; signal(ph.link.reserve);
al w1 0 ; end;
i2: jl. w2 (r149.) ; terminate_th(0);
e.
; procedure init_td(td,var_addr,n);
;
; td (call) text descriptor adresse
; var_addr (call) peger til tekst
; n (call) antal tegn i teksten
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...76...
;
; initialisere en text descriptor
;
; call return
; w0: n undef
; w1: td td
; w2: var_addr undef
; w3: return curco
b. i5,j5 w.
g140:
d40: rs. w3 j0. ; save return
c.a88<3
rs. w3 6 ; *** test no 140 ***************
jl. w3 (r106.) ; w0 n w2 var_addr
h. 140 , 1<9 w. ; w1 td w3 return
0 ;
z.
rs w2 x1 ; td.cur:=var_addr;
al w2 x2+2 ; td.first:=var_addr+2;
rs w2 x1+2 ;
al w2 -1 ; td.n_ch:=n;
hs w0 4 ; td.chshift:=-1;
rs w2 x1+4 ;
rl. w3 (r80.) ; w3:=curco;
jl. (j0.) ; return
j0: 0 ; saved return;
e.
; procedure c_read(td,c)
;
; td (call) text descriptor adresse
; c (return) læste tegn
;
; proceduren læser et tegn fra en tekst beskrivet ved td
;
; call return
; w0: c
; w1: td unch.
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...77...
; w2: undef
; w3: return curco
b. i5,j5 w.
g141:
d41: rs. w3 j0. ; save return
zl w0 x1+4 ; n:=td.n_ch;
se w0 0 ; if n=0 then begin /* tekstes er tom */
jl. i2. ; c:=-1;
al w0 -1 ; goto r;
jl. i3. ; end;
i2: bs. w0 1 ; td.n_ch:=td.n_ch-1;
hs w0 x1+4 ;
el w3 x1+5 ;
rl w2 x1 ;
sl w3 0 ; if td.chshift<0 then begin
jl. i1. ; td.chshift:=16;
al w3 16 ; td.cur:=td.cur+2;
al w2 x2+2 ; end;
rs w2 x1 ;
i1: rl w0 x2 ; c:=word(td.cur) shift -td.chshift extract 8;
ac w2 x3 ;
ls w0 x2 ;
la. w0 j1. ;
al w3 x3-8 ;
hs w3 x1+5 ; ts.chshift:=td.chshift-8;
i3: rl. w3 (r80.) ; r: w3:=curco;
c.a88<3
rs. w3 6 ; *** test no 141 ***************
jl. w3 (r106.) ; w0 tegn w2
h. 141 , 1<9 w. ; w1 td w3 curco
0 ;
z.
jl. (j0.) ; return
j0: 0 ; saved return;
j1: 255
e.
; procedure c_write(td,c);
;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...78...
; td (call) text descriptor adresse
; c (call) tegn der skal skrives
;
; udvider en tekst med et tegn, teksten er givet ved en td
;
; call return
; w0: c undef.
; w1: td undef.
; w2: undef.
; w3: return curco
b. i5,j5 w.
g142:
d42: rs. w3 j0. ; save return;
zl w3 x1+4 ; n:=td.n_ch;
c.a88<3
rs. w3 6 ; *** test no 142 ***************
jl. w3 (r106.) ; w0 tegn w2
h. 142 , 1<9 w. ; w1 td w3 curco
0 ;
z.
sh w3 0 ; if n=0 then return;
jl. i2. ;
al w3 x3-1 ; n:=n-1;
hs w3 x1+4 ; td.n_ch:=n;
el w3 x1+5 ; w3:=td.chshift;
rl w2 x1 ; w2:=td.cur;
sl w3 0 ; if w3<0 then
jl. i1. ; begin
al w3 8 ; td.chshift:=8;
hs w3 x1+5 ;
al w2 x2+2 ; td.cur:=td.cur+2;
rs w2 x1 ;
ls w0 16 ; word(td.cur):=c shift 16;
rs w0 x2 ; return;
jl. i2. ; end;
i1: ls w0 (6) ; word(td.cur):=
wa w0 x2 ; word(td.cur) + c shift td.chshift;
rs w0 x2 ;
al w3 x3-8 ; td.chshift:=w3-8;
hs w3 x1+5 ;
i2: rl. w3 (r80.) ; w3:=curco;
jl. (j0.) ; return;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...79...
j0: 0 ; saved return
e.
; procedure get_text_addr(mcl_addr,txt_addr,move);
;
; mcl_addr (call) mcl adressen på teksten
; txt_addr (return) abs adresse på teksten
; move (call) =0 teksten flyttes til wrk1
; på mcl variabel segment 0
; <>0 teksten flyttes til wrk2
; på mcl variabel segment 0
;
; proceduren finder den absolutte adresse på en tekst i et mcl program
; og flytter teksten til wrk1 eller wrk2 på mcl variable segment 0
; variabel substitution og interval extraktion foretages
;
; call return
; w0: move
; w1:
; w2: mcl_addr txt_addr
; w3: return curco
b. i20,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o3 + 0 ; saved return
q41 = o3 + 2 ; saved move
q42 = o3 + 4 ; string/txt_addr
q43 = o3 + 6 ; from peger til første ord med næste tegn
q44 = o3 + 8 ; from_sh init -24, antal bit ord skal skiftes for at
; tegnet står i bit 17-23
q45 = o3 + 10 ; from_ch antal tegn i from teksten
q46 = o3 + 12 ; to peger til hvor næste tegn skal sættes
q47 = o3 + 14 ; to_sh init -1, antal bit næste tegn skal skiftes
; for at komme 'på plads'
q48 = o3 + 16 ; to_ch antal tegn i to teksten
q49 = o3 + 18 ; skip antal tegn der skal skippes fra from teksten
; før tegn sættes i to teksten
q50 = o3 + 20 ; chars antal tegn i from teksten
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...80...
q51 = o3 + 22 ; n_char init 0, antal tegn der sættes i to teksten
q52 = o3 + 24 ; s_from init 0, hvis<>0 betyder igang med var subst
; og indeholder så gemt værdi af from
q53 = o3 + 26 ; s_from_sh gemt værdi af from_sh
q54 = o3 + 28 ; s_from_ch gemt værdi af from_ch
g143:
d43: rs. w3 j0. ; save return
c.a88<3
rs. w3 6 ; *** test no 143 ***************
jl. w3 (r106.) ; w0 move w2 mcl_addr
h. 143 , 1<9 w. ; w1 w3 return
0 ;
z.
rl. w3 (r80.) ; w3:=curco
rs w0 x3+q41 ; save return i cdescr;
rl. w0 j0. ;
rs w0 x3+q40 ; save move i cdescr;
rs w2 x3+q42 ;
al w0 2 ; /* reserver plads til mcl var og mcl program seg.*/
jl. w3 (r109.) ; corebuf_lock(2);
rl w2 x3+q30 ; /*find corebuffer til var seg., ikke i lager så læs
al w1 7 ; sæt write og lock bit i coretable indgang */
jl. w3 (r94.) ; get_spool_segment(var_segno,var_seg_addr,7);
rs w2 x3+q31 ;
rl w2 x3+q42 ;
jl. w3 (r131.) ; get_abs(mcl_addr,string);
sh w2 0 ; if string<0 then tom tekst; /* fejl */
jl. i0. ;
zl w0 x2 ; type:=string.type;
se w0 0 ; if type=0 then /* tom tekst */
jl. i1. ; txt_addr:=var_seg_addr+40
i0: rl w1 x3+q31 ;
al w2 x1+40 ; else
jl. i3. ;
i1: se w0 1 ; if type = 1 then
jl. i2. ; /* variabel */
zl w1 x2+1 ;
jl. w3 (r135.) ; var_addr(string.var_no,txt_addr)
jl. i3. ; else
i2: se w0 5 ; if type = 5 then /* konstant tekst */
jl. i4. ; txt_addr:=string+2
al w2 x2+2 ; else goto MOV;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...81...
; teksten flyttes til wrk1, wrk2 hvis move>1
i3: rl w0 x3+q41 ;
rs w2 x3+q42 ;
al w1 x2 ; taddr:=txt_addr
rl w2 x3+q31 ; txt_addr:=
al w2 x2+a8 ; var_seg_addr + a8; /* flyt til wrk1 */
se w0 0 ; if move<>0 then
al w2 x2+a9-a8 ; txt_addr:=txt_addr+a9-a8; /* flyt til wrk2 */
rs w2 x3+q42 ;
zl w0 x1 ; /* a9 rel til wrk2 på var seg */
jl. w3 (r89.) ; move(taddr,txt_addr,hw(taddr));
jl. i20. ; goto ret;
; teksten er variabel med interval, tekst med interval eller tekst med
; subst og interval
i4: se w0 2 ; MOV:
jl. i5. ;
zl w1 x2+2 ; if type=2 then /* variabel med interval */
al w1 x1-1 ; begin
rs w1 x3+q49 ; skip:=string.f - 1;
zl w1 x2+3 ;
rs w1 x3+q48 ; to_ch:=string.ch;
zl w1 x2+1 ;
jl. w3 (r135.) ; var_addr(string.var_no,va);
al w2 x2+2 ; from:=va+2;
rs w2 x3+q43 ;
zl w1 x2-1 ;
rs w1 x3+q45 ; from_ch:=hw(va+1);
rl w0 x3+q49 ;
wa w0 x3+q48 ; w0:=skip+to_ch;
sh w0 (x3+q45) ; if w0<=from_ch then
rs w0 x3+q45 ; from_ch:=w0;
al w0 -1 ; s_from:=-1;
rs w0 x3+q52 ;
jl. i7. ; end
i5: se w0 3 ; else
jl. i6. ; if type=3 then /* tekst med interval */
al w0 0 ; begin
rs w0 x3+q49 ; skip:=0;
al w0 100 ;
rs w0 x3+q48 ; to_ch:=100;
al w2 x2+4 ;
rs w2 x3+q43 ; from:=string+4;
zl w0 x2-1 ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...82...
rs w0 x3+q45 ; from_ch:=hw(string+3);
al w0 0 ;
rs w0 x3+q52 ; s_from:=0;
jl. i7. ; end
i6: se w0 4 ; else /* illegal tekst returnere tom tekst */
jl. i0. ; if type <> 4 then returner med tom tekst
zl w1 x2+2 ; /* tekst med var subst og interval */
al w1 x1-1 ; skip:=string.f - 1;
rs w1 x3+q49 ;
zl w1 x2+3 ;
rs w1 x3+q48 ; to_ch:=string.ch;
al w2 x2+6 ;
rs w2 x3+q43 ; from:=string+6;
zl w1 x2-1 ; from_ch:=hw(string+5);
rs w1 x3+q45 ;
al w0 0 ; s_from:=0;
rs w0 x3+q52 ;
i7: al w0 0 ;
rs w0 x3+q51 ; n_char:=0;
; rs w0 x3+q52 ; s_from:=0;
al w0 -24 ;
rs w0 x3+q44 ; from_sh:=-24;
al w0 -1 ;
rs w0 x3+q47 ; to_sh:=-1;
rl w0 x3+q45 ;
rs w0 x3+q50 ; chars:=from_ch;
rl w0 x3+q48 ;
sl w0 100 ; if to_ch>100 then
al w0 100 ; to_ch:=100;
rs w0 x3+q48 ;
rl w1 x3+q31 ;
al w1 x1+a8 ; txt_addr:=
rl w0 x3+q41 ; var_seg_addr + a8;
se w0 0 ; if move <> 0 then
al w1 x1+a9-a8 ; txt_addr:=txt_addr+a9-a8;
rs w1 x3+q42 ;
rs w1 x3+q46 ; to:=txt_addr;
; hent tegn fra tekst givet ved
;
; from peger til første ord med næste tegn
; from_sh init -24, antal bit ord skal skiftes for at
; tegnet står i bit 17-23 ( sidste 8 bit )
; from_ch antal tegn i from teksten
; chars antal tegn i from teksten
i8: rl w1 x3+q45 ; rep:
\f
;; tas 1.0 14.05.87 terminal handler thtxt ...82a...
sh w1 0 ; if from_ch > 0 then
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...83...
jl. i10. ; begin
al w1 x1-1 ;
rs w1 x3+q45 ; from_ch:=from_ch-1;
rl w1 x3+q44 ;
rl w2 x3+q43 ; w2:=from
sh w1 -1 ; if from_sh>=0 then
jl. i9. ; begin
al w1 -24 ; from_sh:=-24;
al w2 x2+2 ; from:=from+2;
rs w2 x3+q43 ; end;
i9: al w1 x1+8 ; from_sh:=from_sh+8;
rs w1 x3+q44 ;
rl w0 x2 ; c:=word(from) shift from_sh extract 8;
ls w0 x1 ;
la. w0 j1. ; end
jl. i12. ; else
i10: dl w1 x3+q53 ; begin
sh w0 0 ; if s_from>0 then begin
jl. i16. ; from:=s_from;
ds w1 x3+q44 ; from_sh:=s_from_sh;
rl w1 x3+q54 ; from_ch:=s_from_ch;
rs w1 x3+q45 ; s_from:=0;
al w1 0 ; goto rep;
rs w1 x3+q52 ; end;
jl. i8. ; goto count;
; end;
; undersøg om variabel substitution, hvis så gem from tekst beskrivelse
; og sæt ny beskr af from teksten
i12: rl w1 x3+q52 ; w1:=s_from;
sn w1 0 ; if c>127 and
sh w0 127 ; s_from=0 then
jl. i13. ; begin
dl w2 x3+q44 ; s_from:=from;
ds w2 x3+q53 ; s_from_sh:=from_sh;
rl w2 x3+q45 ; s_from_ch:=from_ch;
rs w2 x3+q54 ;
am (0) ;
al w1 -128 ;
jl. w3 (r135.) ; var_addr(c-128,va);
al w2 x2+2 ;
rs w2 x3+q43 ; from:=va+2;
al w0 -24 ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...84...
rs w0 x3+q44 ; from_sh:=-24;
zl w0 x2-1 ;
rs w0 x3+q45 ; from_ch:=hw(va+1);
wa w0 x3+q50 ; chars:=chars+from_ch;
rs w0 x3+q50 ; goto rep;
jl. i8. ; end
i13:
; skriv tegn i teksten beskrevet ved
; to peger til or hvor næste tegn skal sættes
; to_sh init 16, antal bit næste tegn skal skiftes
; for at komme 'på plads'
; to_ch antal tegn i to teksten
; skip antal tegn der skal skippes fra from teksten
; før tegn sættes i to teksten
; chars antal tegn i from teksten
rl w1 x3+q49 ; if skip>0 then
sh w1 0 ; begin
jl. i14. ;
al w1 x1-1 ; skip:=skip-1;
rs w1 x3+q49 ; goto count;
jl. i16. ; end;
i14: rl w1 x3+q48 ;
sh w1 0 ; if to_ch>0 then
jl. i18. ; begin
al w1 x1-1 ; to_ch:=to_ch-1;
rs w1 x3+q48 ;
rl w1 x3+q51 ;
al w1 x1+1 ; n_char:=n_char+1;
rs w1 x3+q51 ;
rl w1 x3+q47 ;
sl w1 0 ; if to_sh<0 then
jl. i15. ; begin
al w1 8 ; to_sh:=8;
rs w1 x3+q47 ;
rl w1 x3+q46 ; to:=to+2;
al w1 x1+2 ;
rs w1 x3+q46 ; word(to):=
ls w0 16 ; c shift 16;
rs w0 x1 ; goto count;
jl. i16. ; end;
i15: rl w1 x3+q46 ;
rl w2 x3+q47 ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...85...
ls w0 x2 ; word(to):=word(to) + c shift to_sh;
wa w0 x1 ;
rs w0 x1 ;
al w2 x2-8 ; to_sh:=to_sh-8;
rs w2 x3+q47 ; end
jl. i16.
i18: al w1 0 ; else chars:=0;
jl. i17. ;
i16: rl w1 x3+q50 ; count:
i17: al w1 x1-1 ; chars:=chars-1;
rs w1 x3+q50 ;
sl w1 1 ; if chars>0 then goto rep;
jl. i8. ;
rl w2 x3+q42 ; w2:=txt_addr;
rl w0 x3+q51 ;
hs w0 x2+1 ; hw(txt_addr+1):=n_char;
rl w1 x3+q46 ;
ws w1 4 ; hw(txt_addr):=to - txt_addr + 2;
al w1 x1+2 ;
hs w1 x2 ;
i20: ws w2 x3+q31 ; ret: gem txt_addr rel. på varseg;
rs w2 x3+q42 ;
jl. w3 (r111.) ; unlock_mcl_var;
rl w2 x3+q42 ;
wa w2 x3+q31 ; restore txt_addr;
jl (x3+q40) ; return
j0: 0 ; saved return;
j1: 255
e.
; procedure compare_text(a_txt,b_txt, result);
;
; a_txt (call) abs adresse på den ene tekst
; b_txt (call) abs adresse på den anden tekst
; result (return) =0 teksterne er forskellige
; =1 teksterne er ens
;
; proceduren sammenligner to tekster
;
; call return
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...86...
; w0: result
; w1: a_txt unch.
; w2: b_txt unch.
; w3: return curco
b. i10, j10 w.
g144:
d44: rs. w3 j0. ; save return;
ds. w2 j2. ; save a_txt, b_txt;
zl w1 x1+1 ; x:=a_txt.ch;
zl w2 x2+1 ; y:=b_txt.ch;
c.a88<3
rs. w3 6 ; *** test no 144 ***************
jl. w3 (r106.) ; w0 w2 y
h. 144 , 1<9 w. ; w1 x w3 return
0 ;
z.
ds. w2 j4. ;
se w1 0 ; if x=0 or y=0 then
sn w2 0 ; begin
jl. +4 ; if x<>y then
jl. i1. ; result:=0;
sn w1 x2 ; else
am +1 ; result:=1;
al w0 0 ; goto exit;
jl. i6. ; end;
i1: rl. w3 j3. ; n:=x;
sl. w3 (j4.) ; if n>y then n:=y;
rl. w3 j4. ; /* min(n,y) */
rs. w3 j5. ;
al w2 0 ; chars:= n mod 3;
wd. w3 j6. ; words:=n//3;
rs. w2 j5. ; t1:=a_txt;
dl. w2 j2. ; t2:=b_txt;
jl. i7. ;
i2: sh w3 0 ;
jl. i3. ; while words>0 do begin
al w3 x3-1 ; words:=wqords-1;
rl w0 x1 ; if word(t1)<>word(t2) then
se w0 (x2) ; goto not_eq;
jl. i5. ; t1:=t1+2;
i7: al w1 x1+2 ; t2:=t2+2;
al w2 x2+2 ; end;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...87...
jl. i2. ;
i3: al w3 3 ;
ws. w3 j5. ; w:=(3-chars)*8;
ls w3 3 ;
sn w3 24 ; if w<>24 then
jl. i4. ; begin
al w0 -1 ; mask:= -1 shift w;
ls w0 x3 ; s:=word(t1) xor word(t2) and mask;
rl w3 x1 ;
lx w3 x2 ;
la w3 0 ;
sn w3 0 ; if s<>0 then result:=0
am +1 ; else result:=1;
al w0 0 ; goto exit;
jl. i6. ; end;
i4: am +1 ; eq: result:=1;
i5: al w0 0 ; not_eq: result:=0;
i6: dl. w2 j2. ; exit: restore w1,w2;
rl. w3 (r80.) ; w3:=curco;
jl. (j0.) ; return
j0: 0 ; saved return;
j1: 0 ; a_txt
j2: 0 ; b_txt
j3: 0 ; x
j4: 0 ; y
j5: 0 ; chars
j6: 3
e.
; procedure move_text(f_addr,t_addr);
;
; f_addr (call) abs adresse på tekst der skal flyttes fra
; t_addr (call) abs adresse på tekst der skal flyttes til
;
; call return
; w0: unch.
; w1: f_addr unch.
; w2: t_addr unch.
; w3: return curco
b. i5,j5 w.
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...88...
g145:
d45: ds. w1 j1. ; save w0,w1,w2,return;
c.a88<3
rs. w3 6 ; *** test no 145 ***************
jl. w3 (r106.) ; w0 w2 t_addr
h. 145 , 1<9 w. ; w1 f_addr w3 return
0 ;
z.
ds. w3 j3. ;
zl w0 x1 ;
jl. w3 (r89.) ; move(f_addr,t_addr,hw(f_addr));
dl. w1 j1. ;
dl. w2 j2. ; restore w0,w1,w2;
jl. (j3.) ; return;
j0: 0 ; saved w0
j1: 0 ; saved w1
j2: 0 ; saved w2
j3: 0 ; saved return
e.
; procedure outtext(txt,s)
;
; txt (call) tekstens adresse
; s (return) status
;
; skriver en tekst på terminalen der hører til coroutinen
;
; call return
; w0: s
; w1: txt undef.
; w2: undef.
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o7 + 0 ; saved return
g146:
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...89...
d46: rs. w3 j0. ;
c.a88<3
rs. w3 6 ; *** test no 146 ***************
jl. w3 (r106.) ; w0 w2
h. 146 , 1<9 w. ; w1 txt addr w3 return
0 ;
z.
rl. w3 (r80.) ;
rl. w0 j0. ;
rs w0 x3+q40 ; save return;
rl. w0 j1. ;
rs w0 x3+q66 ; tbuf.op:=5,tbuf.mode:=0;
al w1 x1+2 ; tbuf.first:=txt+2;
al w2 x1 ; tbuf.last:=tbuf.first +
ea w2 x2-2 ; hw(txt) - 4;
al w2 x2-4 ;
ds w2 x3+q69 ;
jl. w3 d30. ; term_send_wait(s);
jl (x3+q40) ; return;
j0: 0 ; saved return;
j1: 5<12+0 ; op,mode
e.
; procedure c_outtext(td,s);
;
; td (call) text descriptor adresse
; s (return) status
;
; Afslutter en tekst med nul tegn og skriver den på den terminal
; der hører til coroutinen, teksetn er givet ved en tekst descriptor
; adresse
;
; call return
; w0: s
; w1: td undef.
; w2: undef.
; w3: return curco
b. i5,j5 w.
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...90...
; proceduren bruger følgende lokale variable i cdescr
q40 = o7 + 0 ; saved return
g147:
d47: rs. w3 j0. ;
c.a88<3
rs. w3 6 ; *** test no 147 ***************
jl. w3 (r106.) ; w0 w2
h. 147 , 1<9 w. ; w1 td w3 return
0 ;
z.
rl. w3 (r80.) ;
rl. w0 j0. ;
rs w0 x3+q40 ; save return i cdescr;
rl. w0 j1. ; tbuf.op:=5,tbuf.mode:=0;
rs w0 x3+q66 ;
rl w0 x1+2 ; tbuf.first:=td.first;
rs w0 x3+q68 ; tbuf.last:=td.cur;
rl w2 x1 ;
rs w2 x3+q69 ;
sh w0 x2 ; if tbuf.first>tbuf.last then begin
jl. i0. ; s:=2;
al w0 2 ; return;
jl (x3+q40) ; end;
i0: el w1 x1+5 ; if td.chshift>0 then
sh w1 -1 ; begin
jl. i1. ;
al w1 x1+8 ; w:=-1 shift (td.chshift + 8);
al w0 -1 ;
ls w0 x1 ; word(td.cur):=
la w0 x2 ; word(td.cur) and w;
rs w0 x2 ; end;
i1: jl. w3 d30. ; term_send_wait(s);
jl (x3+q40) ; return;
j0: 0 ; saved return;
j1: 5<12+0 ;
e.
; procedure write(txt_addr,s);
;
; txt_addr (call) text adresse
; s (return) status
;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...91...
; skriver en tekst, i mcl format, på sidste linie på en terminal
;
; call return
; w0: txt_addr s
; w1: undef.
; w2: undef.
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o9 + 0 ; txt_addr
q41 = o9 + 2 ; saved return
g148:
d48: rl. w2 (r80.) ;
c.a88<3
rs. w3 6 ; *** test no 148 ***************
jl. w3 (r106.) ; w0 text_addr w2 curco
h. 148 , 1<9 w. ; w1 w3 return
0 ;
z.
rs w3 x2+q41 ;
rs w0 x2+q40 ; save return,txt_addr i cdescr;
al w1 0 ;
rl w2 x2+q83 ;
al w2 x2-1 ; lin:=max_lin - 1;
jl. w3 d50. ; cursor(0,lin,s);
se w0 2 ; if s<>2 then
jl (x3+q41) ; return
jl. w3 d49. ; erase(s);
se w0 2 ; if s<>2 then
jl (x3+q41) ; return
rl w1 x3+q40 ;
rl w3 x3+q41 ;
jl. d46. ; outtext(txt_addr,s);
e.
; procedure erase(s);
;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...92...
; s (return) status
;
; skriver en erase_to_end_of_display sekvenspå en terminal
;
; call return
; w0: s
; w1: undef.
; w2: undef.
; w3: return curco
b. i5,j5 w.
g149:
d49: rs. w3 j0. ; save return;
c.a88<3
rs. w3 6 ; *** test no 149 ***************
jl. w3 (r106.) ; w0 w2
h. 149 , 1<9 w. ; w1 w3 return
0 ;
z.
rl. w3 (r80.) ;
rl. w0 j1. ; tbuf.op,mode:=5 shift 12 + 0;
rs w0 x3+q66 ;
rl w1 x3+q62 ; tbuf.first:=tbuf.tdescr.ttda+erase seq.
rl w1 x1+f110 ;
al w1 x1+f130 ;
al w2 x1+2 ; tbuf.last:=tbuf.first+2;
ds w2 x3+q69 ;
rl. w3 j0. ;
jl. d30. ; term_send_wait(s);
j0: 0 ; saved return;
j1: 5<12+0
e.
; procedure cursor(ch_pos,line,s);
;
; ch_pos (call) tegn nummer på linien
; line (call) linie nummer
; s (return) status
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...93...
;
; call return
; w0: s
; w1: ch_pos undef.
; w2: line undef.
; w3: return curco
b. i5,j10 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o8 + 0 ; saved return
g150:
d50: rs. w3 j0. ;
c.a88<3
rs. w3 6 ; *** test no 150 ***************
jl. w3 (r106.) ; w0 w2 line
h. 150 , 1<9 w. ; w1 ch_pos w3 return
0 ;
z.
rl. w3 (r80.) ;
rl. w0 j0. ;
rs w0 x3+q40 ; save return i cdescr;
ds. w2 j2. ; save ch_pos,line;
al. w1 j3. ;
rl w2 x3+q62 ;
rl w2 x2+f110 ; w2:=tbuf.tdescr.ttda;
al w2 x2+f131-2 ; w2:=w2+f131-2; /* addr på cursor seq. */
al w0 9 ;
jl. w3 d40. ; init_td(tdr,w2,9);
al. w1 j4. ;
rl w2 x3+q63 ;
al w2 x2-2 ; init_td(tdw,
al w0 20 ; tbuf.taddr-2,20);
jl. w3 d40. ;
al w2 9 ;
rs. w2 j5. ; i:=9;
i0: sh w2 0 ; while i>0 do
jl. i4. ; begin
al w2 x2-1 ; i:=i-1;
rs. w2 j5. ;
al. w1 j3. ;
jl. w3 d41. ; c_read(tdr,c);
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...94...
sn w0 0 ; if c=0 then
jl. i4. ; goto E;
sl w0 192 ; if c<192 then
jl. i2. ;
i1: al. w1 j4. ; W: c_write(tdw,c)
jl. w3 d42. ; else
jl. i3. ; begin
i2: so w0 1<5 ; if 1<5 i c then
am j9 ; p:=ch_pos else p:=line;
rl. w2 j1. ;
sz w0 1<4 ;
al w2 x2+1 ; if 1<4 i c then p:=p+1;
sz w0 1<3 ;
al w2 x2+32 ; if 1<3 i c then p:=p+32;
sz w0 1<2 ;
lx. w2 j6. ; if 1<2 then p:=p exor 8.140;
so w0 1<1 ; if 1<1 i c then begin
jl. i5. ; c:=p;
al w0 x2 ; goto W;
jl. i1. ; end;
i5: al w1 0 ; w1:=p mod 10;
wd. w2 j7. ; w2:=p // 10;
al w1 x1+48 ; w1:=w1+'0';
rs. w1 j8. ;
al w0 x2+48 ; w0:=w2+'0';
al. w1 j4. ;
jl. w3 d42. ; c_write(tdw,p//10+'0');
rl. w0 j8. ;
jl. w3 d42. ; c_write(tdw,p mode 10+'0');
i3: rl. w2 j5. ; end;
jl. i0. ; end; /*while*/
i4: al. w1 j4. ; E:
jl. w3 d47. ; c_outtext(tdw,s);
jl (x3+q40) ; return;
j0: 0 ; saved return;
j1: 0 ; ch_pos;
j2: 0 ; line
j9=j2-j1
j3: 0,r.3 ; tdr
j4: 0,r.3 ; tdw
j5: 0 ; i
j6: 8.140 ;
j7: 10 ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...95...
j8: 0 ; p
e.
; procedure in_text(td,n,mode,timeout,s);
;
; td (call) text descriptro adresse
; n (call) antal tegn der max skal læses
; mode (call) =8 læs i non display mode, ellers
; læses i display mode
; timeout (call) antal timeout på terminal før der returneres
; med timeout status
; s (return) status
;
; læser en tekst fra en terminal, buffer udpeges ved tekst descriptor
;
; call return
; w0: n s
; w1: td unch.
; w2: timeout<12 + mode undef.
; w3: return curco
b. i20, j20 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o7 + 0 ; saved return
q41 = o7 + 2 ; n
q42 = o7 + 4 ; td
q43 = o7 + 6 ; mode
q44 = o7 + 8 ; zp peger til ord med nultegn efter timeout
q45 = o7 + 10 ; sh read shift count
q46 = o7 + 12 ; timeout_count
g151:
d51: rs. w3 j0. ;
c.a88<3
rs. w3 6 ; *** test no 151 ***************
jl. w3 (r106.) ; w0 n w2 timeout<12+mode
h. 151 , 1<9 w. ; w1 td w3 return
0 ;
z.
rl. w3 (r80.) ; w3:=curco;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...96...
ds w1 x3+q42 ;
zl w1 4 ;
rs w1 x3+q46 ;
zl w2 5 ; save n,td,mode,return i cdescr;
rs w2 x3+q43 ; save timeout_count i cdescr;
rl. w0 j0. ;
rs w0 x3+q40 ;
rl w1 x3+q42 ;
rl w0 x1+2 ;
rs w0 x3+q68 ; tbuf.first:_td.first;
al w0 0 ;
hs w0 x1+4 ; td.nch:=0;
rs w0 x3+q44 ; zp:=0;
al w0 3 ;
hs w0 x3+q66 ; tbuf.op:=3; /*read*/
i1: rl w2 x3+q41 ; rep: q:=n;
al w2 x2+2 ;
al w1 0 ;
wd. w2 j2. ; p:=(q+2)/3;
rs. w2 j1. ;
ls w2 1 ;
wa. w2 j1. ;
ws w2 x3+q41 ;
ls w2 4 ;
wa w2 x3+q43 ; td.mode:= mode +
hs w2 x3+q67 ; (p*3 - n) shift 4;
rl. w2 j1. ; tbuf.last:=
ls w2 1 ; tbuf.first + p*2 - 2;
wa w2 x3+q68 ;
al w2 x2-2 ;
rs w2 x3+q69 ;
al w0 0 ;
rs w0 x3+q77 ; ch:=0;
am -1000
jl. w3 d30.+1000 ; term_send_wait(s);
rl w2 x3+q44 ;
sn w2 0 ; if zp<>0 then
jl. i6. ; begin/* nul tegn efterladt fra tidligere timeout */
rs. w0 j6. ; save status;
rs. w2 j7. ; tdw.cur:=zp;
rs. w2 j11. ; tdr.cur:=zp;
rl w2 x3+q45 ; tdr.sh:=sh;
rs. w2 j10. ;
al w2 -1 ; tdw.sh:=-1;
rs. w2 j14. ;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...97...
rl w0 x3+q77 ; /* flyt sidst læste tegn over nul tegnene */
hs. w0 j9. ; tdw.n_ch:=tbuf.ch;
hs. w0 j13. ; tdr.n_ch:=tbuf.ch;
i4: al. w1 j11. ; x:
jl. w3 d41. ; c_read(tdr.c);
sh w0 -1 ; if c<0 then goto y;
jl. i5. ; c_write(tdw,c);
al. w1 j7. ; goto x;
jl. w3 d42. ;
jl. i4. ;
i5: rl. w1 j7. ; y:
al w1 x1+2 ;
rs w1 x3+q68 ; tbuf.first:=tdw.cur+2;
rl. w0 j6. ; end;
i6: so. w0 (j3.) ; if timeout i s then
jl. i3. ; begin
rl w2 x3+q41 ; n:=n - tbuf.ch;
ws w2 x3+q77 ;
sh w2 0 ;
jl. i3. ; if n>0 then
rs w2 x3+q41 ; begin
rl w2 x3+q77 ;
rl w1 x3+q42 ;
ea w2 x1+4 ;
hs w2 x1+4 ; td.nch:=td.nch + tbuf.ch;
al w1 0 ;
wd. w2 j2. ; r:=tbuf.ch mod 3;
sn w1 0 ; if r<>0 then
jl. i7. ; begin /* nul tegn i sidste ord */
se w1 2 ; if r=2 then
am 8 ; sh:=0
al w0 0 ; else sh:=8;
rs w0 x3+q45 ;
rl w1 x3+q68 ; zp:=tbuf.first-2;
al w1 x1-2 ;
i7: rs w1 x3+q44 ; end;
rl w2 x3+q46 ; timeout_count := timeoutcount-1;
al w2 x2-1 ;
rs w2 x3+q46 ; if timeout_count>=0 then
sl w2 0 ; goto rep;
jl. i1. ; end;
i3: rl w1 x3+q42 ; end;
zl w2 x1+4 ;
wa w2 x3+q77 ; td.nch:=td.nch+tbuf.ch;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...98...
sz. w0 (j5.) ; if att i s then
al w2 0 ; td.nch:=0;
hs w2 x1+4 ;
rl w2 x1+2 ;
al w2 x2-2 ;
rs w2 x1+0 ; td.cur:=td.first-2;
al w2 -1 ;
hs w2 x1+5 ; td.chshift:=-1;
jl (x3+q40) ; return;
j0: 0 ;
j1: 0 ; (q+2)/3
j2: 3 ;
j3: 1<21 ; timeout
j5: 1<16 ; att
j6: 0 ; saved status
; tdw
j7: 0,r.3 ; .cur
j8=j7+2 ; .first
j9=j7+4 ; .n_ch
j10=j7+5 ; .sh
; tdr
j11: 0,r.3 ; .cur
j12=j11+2 ; .first
j13=j11+4 ; .n_ch
j14=j11+5 ; .sh
e.
; procedure rd_char(c,timeout,s);
;
; c (return) tegn
; timeout (call) antal timeout på terminal før der returneres
; med timeout status
; s (return) status
;
; læser et tegn fra en terminal
;
; call return
; w0: timeout s
; w1: c
; w2: undef.
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...99...
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o7 + 0 ; saved return
q41 = o7 + 2 ; timeout_count;
g152:
d52: al w2 x3 ;
c.a88<3
rs. w3 6 ; *** test no 152 ***************
jl. w3 (r106.) ; w0 timeout w2 return
h. 152 , 1<9 w. ; w1 w3 return
0 ;
z.
rl. w3 (r80.) ;
rs w2 x3+q40 ; save return i cdescr;
rs w0 x3+q41 ; save timeout_count;
i1: rl. w0 j0. ; rep: tbuf.op:=3;
rs w0 x3+q66 ; tbuf.mode:=2 shift 4;
rl w1 x3+q63 ;
al w2 x1 ; tbuf.first:=tbuf.last:=tbuf.taddr;
ds w2 x3+q69 ;
jl. w3 (r160.) ; term_send_wait(s);
so. w0 (j1.) ; if timeout i s then
jl. i2. ; begin
rl w1 x3+q41 ; timeout_count:=timeout_count-1;
al w1 x1-1 ;
rs w1 x3+q41 ;
sl w1 0 ; if timeout_count>=0 then
jl. i1. ; goto rep;
i2: rl w1 (x3+q63) ; end;
ls w1 -16 ; c:=word(tbuf.taddr) shift -16;
jl (x3+q40) ; return;
j0: 3<12 + 2<4 ; op,mode
j1: 1<21 ; timeout
e.
; procedure read_password(dw,s);
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...100...
;
; dw (return) dobbeltord med kodet password
; s (return) status
;
; læser password fra terminal og omsætter det til et kodet password
;
; call return
; w0: s
; w1: cpw
; w2: cpw
; w3: return curco
b. i5,j5 w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o8 + 0 ; saved return
g153:
d53: rl. w2 (r80.) ;
rs w3 x2+q40 ; save return i cdescr;
rl w2 x2+q63 ; wa:=tbuf.taddr+20;
al w2 x2+20 ;
c.a88<3
rs. w3 6 ; *** test no 153 ***************
jl. w3 (r106.) ; w0 w2 wa
h. 153 , 1<9 w. ; w1 w3 return
0 ;
z.
al w1 0 ;
al w0 0 ; i:=0;
i1: am x2 ; repeat
rs w0 x1 ; word(wa+i):=0;
al w1 x1+2 ; i:=i+2;
se w1 32 ; until i=32;
jl. i1. ;
al. w1 j0. ;
rs w2 x1+2 ; td.first:=wa;
al w0 48 ;
rl. w2 j3. ; in_text(td,48,8,10,s);
jl. w3 d51. ;
la. w0 j4. ; s:=s - timeout;
se w0 2 ; if s<>2 then
jl (x3+q40) ; return;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...101...
zl w2 x1+4 ;
rl w1 x1+2 ;
jl. w3 d54. ; strip_nl(td.first,td.nch);
rl w2 x3+q63 ; wa:=tbuf.taddr+20;
al w2 x2+20 ;
al w1 0 ; i:=0;
i2: am x2 ; repeat
zl w0 x1 ; w:=hw(wa+i);
rs. w0 j1. ;
rs. w1 j2. ;
al w1 x1+1 ; j:=i+1;
i3: am x2 ; repeat
zl w0 x1 ; hw(wa+j):=
wa. w0 j1. ; hw(addr+j) + w;
am x2 ; j:=j+1;
hs w0 x1 ; until j=32;
al w1 x1+1 ;
se w1 32 ;
jl. i3. ;
rl. w1 j2. ;
al w1 x1+1 ; i:=i+1;
se w1 31 ; until i=31;
jl. i2. ;
al w0 0 ; s2:=0;
al w1 0 ; s1:=0;
al w3 0 ; i:=0;
i4: am x2 ; repeat
wa w1 x3 ; s1:=s1+word(wa+i);
wa w0 2 ; s2:=s2+s1;
al w3 x3+2 ; i:=i+2;
se w3 32 ; until i=32;
jl. i4. ;
rl w2 0 ; w2:=s2;
rl. w3 (r80.) ; w3:=curco;
al w0 2 ; s:=ok;
jl (x3+q40) ; return;
j0: 0,r.3 ; td
j1: 0 ; w
j2: 0 ; i
j3: a4<12+8 ; timeout<12+mode
j4: -(:1<21:)-1 ; -timeout
e.
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...102...
; procedure strip_nl(txt_addr,n);
;
; txt_addr (call) peger til første ord i teksten
; n (call) antal tegn i teksten
;
; hvis sidste tegn i en tekst er nl, erstattes det af et nul tegn
;
; call return
; w0: undef.
; w1: txt_addr undef.
; w2: n undef.
; w3: return curco
b. i5,j5 w.
g154:
d54: rs. w3 j0. ;
c.a88<3
rs. w3 6 ; *** test no 154 ***************
jl. w3 (r106.) ; w0 w2 n
h. 154 , 1<9 w. ; w1 txt_addr w3 return
0 ;
z.
rs. w1 j1. ; save txt_addr,return;
al w1 0 ;
al w2 x2+2 ;
wd. w2 j2. ;
ls w2 1 ;
al w2 x2-2 ; w:=(n+2)/3*2-2;
wa. w2 j1. ; wa:=txt_addr+w;
rs. w2 j3. ;
rl w2 x2 ; w:=word(wa);
al w0 -1 ; m:=-1;
al w1 1 ; i:=0;
i1: ls w0 8 ; repeat
al w3 x2 ; m:=m shift 8;
la. w3 j4. ;
sn w3 0 ; t:=w extract 8;
jl. i4. ; if t<>0 and t < 32 then
sh w3 31 ; goto F;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...103...
jl. i3. ;
i4: ls w2 -8 ; w:=w shift -8;
al w1 x1+1 ; i:=i+1;
se w1 4 ; until i=4;
jl. i1. ;
i2: rl. w3 (r80.) ; ret: w3:=curco;
jl. (j0.) ; return;
i3: rl. w1 j3. ; F:
la w0 x1 ; word(wa):=word(wa) and m;
rs w0 x1 ;
jl. i2. ; goto ret;
j0: 0 ; saved return;
j1: 0 ; txt_addr
j2: 3 ;
j3: 0 ; wa
j4: 255 ;
e.
; procedure strip_sp(txt_addr);
;
; txt_addr (call) adresse på tekst
;
; erstatter tegnet sp med tegnel nul i ten tekst, hvis teksten
; er længere end 4 ord, sættes 4 ord til 1, det gør teksten til
; et ulovligt rc8000 navn
;
; call return
; w0: unch.
; w1: unch.
; w2: txt_addr unch.
; w3: return curco
b. i10,j5 w.
g155:
d55: ds. w1 j1. ; save registers;
c.a88<3
rs. w3 6 ; *** test no 155 ***************
jl. w3 (r106.) ; w0 w2 txt_addr
h. 155 , 1<9 w. ; w1 w3 return
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...104...
0 ;
z.
ds. w3 j3. ;
al w1 x2 ;
ea w1 x1 ;
rs. w1 j4. ; top:=txt_addr+hw(txt_addr);
al w2 x2+2 ; t:=txt_addr+2;
i1: sl. w2 (j4.) ;
jl. i5. ; while t<top do
rl w0 x2 ; begin
al w1 0 ; w:=word(t);
i2: al w3 255 ; for i:=1 to 3 do
la w3 0 ; begin
sl w3 33 ;
jl. i3. ; if w.ch(i)<=32 then
ls w0 -8 ; w.ch(i):=0;
ls w1 -8 ;
jl. i4. ; end;
i3: ld w1 -8 ;
i4: lo. w0 j5. ;
so w0 1<7 ;
jl. i2. ;
rs w1 x2 ; t:=t+2;
al w2 x2+2 ; end;
jl. i1. ;
i5: rl. w1 j2. ; top:=txt_addr + 10;
al w1 x1+10 ;
rs. w1 j4. ;
al w0 0 ;
i6: sl. w2 (j4.) ; while t<top do
jl. i7. ; word(t):=0;
rs w0 x2 ;
al w2 x2+2 ;
jl. i6. ;
; /* max tegn i navn er 11 */
i7: rl. w2 j2. ; if hw(txt_addr+1)>11 then
zl w1 x2+1 ; word(txt_addr+8):=1;
al w0 1 ; /* tekster længre en 12 tegn gøres ulovlige */
sl w1 12 ;
rs w0 x2+8 ;
dl. w1 j1. ;
rl. w2 j2. ; restore w0,w1,w2;
rl. w3 (r80.) ; w3:=curco;
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...105...
jl. (j3.) ; return;
j0: 0 ; saved w0
j1: 0 ; saved w1
j2: 0 ; saved w2
j3: 0 ; saved return
j4: 0 ; top
j5: 1<23 ; 1<23
e.
; extern variabel
u13:
r80: h. m24 , 1 w. ; c0 curco
r81: h. m69 , 1 w. ; g0 create_link
r82: h. m70 , 1 w. ; g1 remove_link
r83: h. m11 , 1 w. ; e22 wait_semaphore
r84: h. m166 , 1 w. ; e17 csendspeudomessage
r85: h. m8 , 1 w. ; e18 cwaitanswer
r86: h. m9 , 1 w. ; e19 cregretmessage
r87: h. m122 , 1 w. ; c49 first_ph
r88: h. m96 , 1 w. ; g31 link_ph
r89: h. m89 , 1 w. ; g22 move
r90: h. m74 , 1 w. ; g5 release_op
r91: h. m81 , 1 w. ; g12 insert_mcl_name
r92: h. m56 , 1 w. ; c39 segmenttable
r93: h. m49 , 1 w. ; c32 coretable_base
r94: h. m75 , 1 w. ; g6 get_spool_segment
r95: h. m7 , 1 w. ; e16 csendmessage
r96: h. m100 , 1 w. ; c55 addr sign text buffer
r97: h. m81 , 1 w. ; g12 insert_mcl_name
r98: h. m83 , 1 w. ; g14 get_mcl_segment
r99: h. m11 , 1 w. ; e22 wait_semaphore
r101:h. m10 , 1 w. ; e20 signal
r102:h. m172 , 1 w. ; c60 antal timeout perioder
r103:h. m72 , 1 w. ; g3 put_op
r106:h. m176 , 1 w. ; e1 register testout
r107:h. m31 , 1 w. ; c15 own pda
r108:h. m238 , 1 w. ; g131 signon procedure
r109:h. m246 , 1 w. ; g15 corebuf_lock
r110:h. m247 , 1 w. ; g16 corebuf_open
r111:h. m250 , 1 w. ; g135 unlock_mcl_var
t0: h. m183 , 1 w. ; t3 <:linkexist:>
\f
;; tas 1.0 14.05.87 terminal handler thtxt ...105a...
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...106...
t1: h. m184 , 1 w. ; t4 <:ok:>
t2: h. m185 , 1 w. ; t5 <:unknown:>
t3: h. m186 , 1 w. ; t6 <:resources:>
t4: h. m187 , 1 w. ; t7 <:timeout:>
t5: h. m188 , 1 w. ; t8 <:removed:>
t6: h. m189 , 1 w. ; t9 <:<10>:>
t7: h. m210 , 1 w. ; t30 <:no link:>
t8: h. m240 , 1 w. ; t51 <:exit - illegalt mcl program:>
t9: h. m251 , 1 w. ; t54 <:local id:>
t10: h. m182 , 1 w. ; t2 <:system:>
r131:h. m131 , 1 w. ; g101 get_abs
r132:h. m132 , 1 w. ; g102 push
r133:h. m133 , 1 w. ; g103 pop
r134: h.m134 , 1 w. ; g104 create_mcl_variable
r135: h.m135 , 1 w. ; g105 var_addr
r136: h.m136 , 1 w. ; g106 alloc_var
r138: h.m138 , 1 w. ; g108 set_var
r139: h.m139 , 1 w. ; g109 wait
r140: h.m140 , 1 w. ; g110 wait_op
r142: h.m142 , 1 w. ; g112 tascat_mes
r144: h.m144 , 1 w. ; g114 remove_ph
r145: h.m145 , 1 w. ; g115 remove_th_link
r146: h.m146 , 1 w. ; g116 create_user
r147: h.m147 , 1 w. ; g117 create_ph
r148: h.m148 , 1 w. ; g118 mcl_exit
r149: h.m149 , 1 w. ; g149 term_send_wait
r150: h.m150 , 1 w. ; g120 direct
r152: h.m152 , 1 w. ; g122 output_op
r154: h.m154 , 1 w. ; g124 ctrl_op
r156: h.m156 , 1 w. ; g126 answer_input
r160: h.m160 , 1 w. ; g130 term_send_wait
r161: h.m101 , 1 w. ; g140 init_td
r162: h.m102 , 1 w. ; g141 c_read
r163: h.m103 , 1 w. ; g142 c_write
r164: h.m104 , 1 w. ; g143 get_text_addr
r165: h.m105 , 1 w. ; g144 compare_text
r167: h.m107 , 1 w. ; g146 outtext
r168: h.m108 , 1 w. ; g147 c_outtext
r171: h.m111 , 1 w. ; g150 cursor
r172: h.m112 , 1 w. ; g151 in_text
r174: h.m163 , 1 w. ; g160 error_return 1
r175: h.m31 , 1 w. ; c15 own pda
r176: h.m165 , 1 w. ; g162 error_return 3
r177: h.m162 , 1 w. ; c54 std seg i link spool area
r178: h. m5 , 1 w. ; e12 pass
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...107...
r179: h. m13 , 0 w. ; e31 inspect_mailbox
; end init list
\f
; tas 1.0 14.05.87 terminal handler, run mcl thtxt ...108...
; procedure run_mcl;
;
; proceduren fortolker et mcl program
;
; call return
; w0: undef.
; w1: undef.
; w2: undef.
; w3: return curco
b. e60, i150, j60 ;
w.
; proceduren bruger følgende lokale variable i cdescr
q40 = o11 + 0 ; saved return
; lokale variable
j0: p8 ; state.blk
j1: p4 ; state.stty
j2: p8+p4 ; state.blk + state.stty
j3: 0 ; wrk
j4: 3 ; konstant
j5: 0,r.3 ; tdw (text descriptor)
j6: 7 ; konstant maske
j7: 0,r.3 ; att message
j8: -p8-1 ; -state.blk
j9: p9 ; state.output
j10: p10 ; state.echo
j11: 5<12+0 ; konstant
;j12-16 se senere
; følgende 9 ord indeholder tekst der sendes efter include fra th til ph
j17: 0 ; localid
<:<1><1><32>att<32><32><32>:>
j18: 0,r.4 ; process navn
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...109...
<:<10><0><0>:>
; j20 - j27 defineres sener, bruges i menu aktionen
j28: p13 ;
j29: 0,r.3 ; tdw
j30: 0,r.3 ; tdr
j31: 0 ; i
j33: p5 + p8 ; state.blk + state.mtty
j34: p5 ; state.mtty
j35: 1<21 ; timeout status
j36: 0 ; <localid>
<:<2><2> out <10>:>
j38: -p18-1 ; -state.no_sys_menu
j39: 1<12 ; maske
; j40 - j50 defineres senere
j50: p19 ; state.get_send
j51: -p19-1 ; -state.get_send
j52: 2.1000000111100 ;
g164:
d60: rl. w2 (r80.) ;
rs w3 x2+q40 ; save return;
al w3 x2 ;
rl w0 x3+f21 ;
c.a88<3
rs. w3 6 ; *** test no 160 ***************
jl. w3 (r106.) ; w0 state w2 curco
h. 160 , 1<8 w. ; w1 w3 curco
0 ;
z.
so. w0 (j28.) ; if state.signon then
jl. i70. ; begin
jl. w3 (r108.) ; signon(r);
se w0 0 ; if r<>0 then
jl. (r176.) ; error_return_3;
jl. w3 (r146.) ; create_user(s);
se w0 0 ; if s<>0 then
jl. (r176.) ; error_return_3;
jl. i71. ; end
; else
i70: rl w2 x3+q62 ; begin
rl w0 x2+f107 ;
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...110...
rl w1 x3+q63 ; word(tbuf.taddr):=
rs w0 x1 ; tbuf.tdescr.tpda;
rs w3 x1+2 ; word(tbuf.taddr+2):=
rl w0 x2+f106 ; th;
rs w0 x1+4 ; word(tbuf.taddr+4):=
al w0 4 ; tbuf.tdescr.uid;
al w1 80 ; mode:=4; hw:=80;/* send start session message */
jl. w3 (r142.) ; tascat_mes(mode,hw,r);
se w0 0 ; if r<>0 then error_return_3;
jl. (r176.) ; end;
i71: rl w2 x3+q62 ;
rl w2 x2+f106 ; uid:=tbuf.tdescr.uid;
rs w2 x3+q16 ;
rl w2 x3+q63 ; /* åbn mcl program */
dl w1 x2+12 ; gem mcl prog. baser
ds w1 x3+q86 ;
rl w1 x2+14 ; gem sessions nummer
rs w1 x3+q87 ;
al w2 x2+2 ; insert_mcl_prog(
jl. w3 (r97.) ; tbuf.taddr+2, mcl_entry,r);
se w0 0 ; if r<>0 then error_return_1;
jl. (r174.) ;
rs w1 x3+q22 ;
jl. w3 (r134.) ; create_mcl_variable(r);
se w0 0 ; if r<>0 then
jl. (r174.) ; error_return_1;
rl w0 x3+f21 ;
la. w0 j38. ; state.no_sys_menu:=0;
rs w0 x3+f21 ;
rl w1 x3+q63 ; /* sæt user index */
al w0 x1+16 ; var_no:=8; /* I */
al w1 8 ; set_var(var_no,
jl. w3 (r138.) ; tbuf.taddr+10);
rl w1 x3+q63 ; /* sæt default text */
al w0 x1+24 ; var_no:=19; /* T */
al w1 19 ; set_var(var_no,
jl. w3 (r138.) ; tbuf.taddr+24);
al w1 20 ; /* sæt usedid */
al w2 12 ; var_no:=20; /* U */
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...111...
jl. w3 (r136.) ; alloc_var(var_no,va,12);
al w0 12 ;
al. w1 j29. ;
jl. w3 (r161.) ; init_td(tdw,va,12);
al w0 12 ;
al. w1 j30. ;
rl w2 x3+q62 ; va:= addr tbuf.tdescr.userid;
al w2 x2+f103 ;
jl. w3 (r161.) ; init_td(tdr,va,12);
al w1 0 ;
rs. w1 j31. ; i:=0;
i72: al. w1 j30. ; repeat
i73: jl. w3 (r162.) ; x: c_read(tdr,c);
sn w0 0 ; if c=0 then goto x;
jl. i73. ;
sh w0 31 ; if c<32 then
al w0 32 ; c:=32;
al. w1 j29. ;
jl. w3 (r163.) ; c_write(tdw,c);
rl. w1 j31. ;
al w1 x1+1 ; i:=i+1;
rs. w1 j31. ;
sh w1 11 ; until i>11;
jl. i72. ;
al w1 18 ; /* sæt s_name og mcl var s */
al w2 5 ; var_no:=18; /* S */
jl. w3 (r136.) ; alloc_var(var_no,va,5);
al w0 5 ; init_td(tdw,va,5);
al. w1 j29. ;
jl. w3 (r161.) ;
rl w0 x3+q61 ;
se w0 0 ; if tbuf.s_name=0 then begin
jl. i74. ; /* fra answer fra tascat */
am (x3+q63) ;
zl w0 21 ; nch:=word(taddr+21);
al. w1 j30. ; init_td(tdr,taddr+20,nch);
am (x3+q63) ; end
al w2 20 ; else
jl. w3 (r161.) ; init_td(tdr,s_name-2,5);
jl. i76. ;
i74: al w0 5 ;
al. w1 j30. ;
al w2 x3+q61-2 ;
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...112...
jl. w3 (r161.) ;
i76: al w1 0 ;
rs. w1 j31. ; i:=0;
i75: al. w1 j30. ; repeat
jl. w3 (r162.) ; y: c_read(tdr,c);
sh w0 31 ; if c<32 then c:=32;
al w0 32 ;
al. w1 j29. ;
jl. w3 (r163.) ; c_write(tdw,c);
rl. w1 j31. ;
al w1 x1+1 ; i:=i+1;
rs. w1 j31. ;
se w1 5 ; until i=5;
jl. i75. ;
am. (j29.+2) ; /* sæt s_name i tbuf.s_name */
dl w1 2 ;
ds w1 x3+q61+2 ;
rl w1 x3+q62 ;
rl w1 x1+f110 ;
zl w0 x1+f126 ;
rs w0 x3+q80 ; up_arrow:=ttda.up_arrow;
zl w0 x1+f127 ;
rs w0 x3+q81 ; down_arrow:=ttda.down_arrow;
zl w0 x1+f124 ; max_col:=tbuf.tdescr.ttda.max_col;
rs w0 x3+q82 ;
zl w0 x1+f125 ; max_lin:=tbuf.tdescr.ttda.max_lin;
rs w0 x3+q83 ;
zl w0 x1+f133 ; bs:=tbuf.tdescr.ttda.left_char;
rs w0 x3+q88 ;
rl w1 x3+q22 ; /* hent mcl program segment 0 */
al w2 0 ; get_mcl_segment(mcl_entry,0,
jl. w3 (r98.) ; mcl_buf,mcl_cte,r);
ds w2 x3+q24 ;
zl w0 x1+1 ; mcl_index:=
rs w0 x3+q25 ; mcl_cte.type;
; start mcl fortolkning
al w0 0 ;
rs w0 x3+q20 ; ic:=0;
g170:
e50: rl. w3 (r80.) ; next_op:
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...113...
rl w2 x3+q20 ;
jl. w3 (r131.) ; get_abs(aic,ic);
sh w2 0 ; if aic<1 then
jl. i98. ; goto E;
zl w1 x2 ; opcode:=hw(aic);
c.a88<3
rs. w3 6 ; *** test no 170 ***************
jl. w3 (r106.) ; w0 w2 aic
h. 170 , 1<9 w. ; w1 opcode w3 curco
0 ;
z.
sh w1 25 ; if opcode>24 then
jl. i99. ; begin
i98: rl. w2 t8. ;
jl. w3 (r148.) ; mcl_exit((<:exit - illegalt mcl program:>);
jl. e50. ; goto next_op;
; end;
i99: ls w1 1 ;
am. (x1+4) ;
jl. x1+2 ; goto action(opcode);
e0. ; 0: next_segment
e1. ; 1: jump
e2. ; 2: bool_expr
e3. ; 3: reduced_bool_expr
e4. ; 4: attention
e5. ; 5: endatt
e6. ; 6: include
e7. ; 7: endinclude
e8. ; 8: att
e9. ; 9: write
e10. ; 10: nl
e11. ; 11: read
e12. ; 12: get
e13. ; 13: let
e14. ; 14: send
e15. ; 15: execute
e16. ; 16: direct
e17. ; 17: exit
e18. ; 18: output_on
e19. ; 19: output_off
e20. ; 20: echo_on
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...114...
e21. ; 21: echo_off
e22. ; 22: menu
e23. ; 23: erase
e24. ; 24: convert
; next segment
e0: rl w1 x3+q20 ;
ls w1 -9 ;
al w1 x1+1 ; ic:=
ls w1 9 ; (ic/512 + 1 ) * 512;
rs w1 x3+q20 ;
jl. e50. ; goto next_op;
; jump
e1: rl w1 x2+2 ;
rs w1 x3+q20 ; ic:=word(aic+2);
rl w0 x3+f1 ; /* lad andre der kan køre */
jl. w3 (r178.) ; pass(prio);
rl. w1 j39. ; maske := 1<12; /* undersøg om letter på main_mbx */
al w2 x3+f22 ; inspect_mailbox(main_mbx,
jl. w3 (r179.) ; mask,letter,r);
sn w1 0 ; if letter=0 then
jl. e50. ; goto Next_op;
al w2 x3+q14 ; /* behandl letter på main_mbx */
jl. w3 (r101.) ; signal(a_sem);
al w0 x3+q14 ;
jl. w3 (r139.) ; wait(a_sem);
jl. e50. ; goto next_op;
; bool expr
; aktionen bruger følgende lokale variable i cdescr
q40 = o11 + 0 ; eqic
q41 = o11 + 2 ; neqic
q42 = o11 + 4 ; r_st
e2: dl w1 x2+4 ; eqic:=word(aic+2);
ds w1 x3+q41 ; neqic:=word(aic+4);
rl w1 x2+6 ; r_st:=word(aic+6);
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...115...
rs w1 x3+q42 ;
al w0 0 ;
rl w2 x3+q20 ; /* hent tekst til wrk1 */
al w2 x2+8 ; get_text_addr(ic+8,st_1,0);
jl. w3 (r164.) ;
al w0 1 ;
rl w2 x3+q42 ; /* hent tekst til wrk2 */
jl. w3 (r164.) ; get_text_addr(r_st,st_2,1);
rl w1 x3+q31 ;
al w1 x1+a8 ; st_1:=var_seg_addr + a8; /* addr på wrk1 */
jl. w3 d44. ; compare_rtext(st_1,st_2,r);
rl w1 x3+q40 ; w:=eqic;
se w0 1 ; if w0<>0 then
rl w1 x3+q41 ; w:=neqic;
rs w1 x3+q20 ; ic:=w;
jl. e50. ; goto next_op;
; reduced bool expr
; aktionen bruger følgende lokale variable i cdescr
q40 = o11 + 0 ; eqic
q41 = o11 + 2 ; neqic
q42 = o11 + 4 ; var
q43 = o11 + 6 ; n_ch (aic+7)
q44 = o11 + 8 ; chs (aic+8)
e3: dl w1 x2+4 ; eqic:=word(aic+2);
ds w1 x3+q41 ; neqic:=word(aic+4);
zl w0 x2+7 ; n_ch:=hw(aic+7);
rl w1 x2+8 ; chs:=word(aic+8);
ds w1 x3+q44 ;
zl w1 x2+6 ;
jl. w3 (r135.) ; var_addr(hw(aic+6),var);
rs w2 x3+q42 ;
zl w0 x2+1 ; w0:=hw(var+1);
rl w1 x3+q43 ; w1:=n_ch;
se w0 0 ;
sn w1 0 ; if w0=0 or w1=0 then
jl. +4 ; begin
jl. i1. ; /* to tomme ens, kun en tom forskellige */
se w0 x1 ; if w0=w1 then
jl. i2. ; goto EQ;
jl. i3. ; goto NEQ;
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...116...
; end;
i1: sl w0 x1 ;
al w0 x1 ; n:=min(w0,w1);
al w1 3 ;
ws w1 0 ;
ls w1 3 ; sh:=(3-n)*8;
al w2 -1 ;
ls w2 x1 ; m:= -1 shift sh;
rl w1 x3+q44 ;
am (x3+q42) ; s:=chs xor
lx w1 2 ; word(var+2);
la w1 4 ; s:=s and m;
se w1 0 ; if s=0 then
i2: am q41 - q40 ; EQ: ic:=eqic else
i3: rl w2 x3+q40 ; NEQ: ic:=neqic;
rs w2 x3+q20 ;
jl. e50. ; goto next_op;
; attention
; aktionen bruger følgende lokale variable i cdescr
q40 = o11 + 0 ; ph
q41 = o11 + 2 ; buf
q42 = o11 + 4 ; oldic
q43 = o11 + 6 ; name addr
e4: rl w0 x3+f21 ;
so. w0 (j0.) ; if state.blk = 1 then
jl. i4. ; begin
rl. w2 t0. ; /* allerede i att,inc block */
jl. w3 (r148.) ; mcl_exit(<:linkexist:>);
jl. e50. ; goto next_op;
; end;
i4: zl w0 x2+6 ; end_blk_var:=hw(aic+6);
rl w1 x2+4 ; end_blk_ic:=word(aic+4);
ds w1 x3+q101 ; oldic:=ic;
rl w0 x2+2 ; ic:=word(aic+2);
rx w0 x3+q20 ;
rs w0 x3+q42 ;
rl w0 x3+q27 ;
rs w0 x3+q84 ; blk_niv:=mcl_top;
al w0 0 ;
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...117...
rs w0 x3+q0 ; used_buf:=0;
rs w0 x3+q4 ; maxtimer:=0;
al w0 1 ; max_buf:=1;
rs w0 x3+q1 ;
rl. w0 (r177.) ; seg:=std seg;
al w1 x3+q7 ;
jl. w3 (r81.) ; create_link(link,seg,r);
se w0 0 ; if r<>0 then
jl. i7. ; goto ER1;
; opret ph coroutine
al w0 0 ;
rl w2 x3+q42 ; /* hent tekst til wrk1 */
al w2 x2+8 ; get_text_addr( oldic+8,
jl. w3 (r164.) ; name, 0);
jl. w3 d55. ; strip_sp(name);
al w2 x2+2 ;
rs w2 x3+q43 ; save name addr
al w3 x2 ;
jd 1<11+4 ; process_description(pda,name);
rl. w3 (r80.) ;
sn w0 0 ; if pda=0 then
jl. i6. ; goto ER0;
rl. w2 (r175.) ; if pda = own_pda then
sn w0 x2 ; goto ER0;
jl. i6. ;
rl w2 0 ;
rl w0 x2 ; if sender ikke internal process then
se w0 0 ; goto ER0;
jl. i6. ;
jl. w3 (r147.) ; create_ph(ph,pda);
rs w1 x3+q40 ;
sn w1 0 ; if ph=0 then
jl. i7. ; goto ER1;
al w2 x1 ; w2 := ph cdescr addr
al w1 x3 ; w1 := curco ( th cdescr addr )
jl. w3 (r88.) ; link_th(ph,th);
rl w2 x3+q40 ; w2:=ph;
rl w3 x3+q62 ;
rl w0 x2+q1 ;
rs w0 x3+f114 ; tbuf.tdescr.sender:=owner;
rl w0 x2+q0 ; w0:=ph.pool;
al. w1 j7. ;
al w2 x2+q20 ; csendpseudomessage(ph.pool,
jl. w3 (r84.) ; att_mess, ph.owner, buf);
sh w2 1 ; if buf<2 then
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...118...
je -12 ; fault;
rs w2 x3+q41 ;
al w0 10 ;
al w1 x3+q8 ; cwaitanswer( buf,
jl. w3 (r85.) ; 10,ans,r);
se w0 0 ; if r=0 then begin
jl. i5. ; /* timeout */
rl w2 x3+q41 ; cregretmessage(buf);
jl. w3 (r86.) ; goto ER2;
jl. i8. ; end;
i5: se w0 1 ; if r<>1 then
jl. i6. ; goto ER0;
rl. w0 j2. ; state.stty:=1;
lo w0 x3+f21 ; state.blk:=1;
rs w0 x3+f21 ;
rl. w0 j1. ;
rl w1 x3+q40 ;
lo w0 x1+f21 ; ph.state.stty:=1;
rs w0 x1+f21 ;
rl w1 x3+q100 ;
rl. w0 t1. ;
jl. w3 (r138.) ; set_var(end=blk_var,<:ok:>);
jl. e50. ; goto next_op;
i6: am t2-t3 ; ER0: text:=<:unknown:>
i7: am t3-t4 ; ER1: or text:=<:resources:>
i8: rl. w0 t4. ; ER2: or text:=<:timeout:>;
rl w1 x3+q100 ;
jl. w3 (r138.) ; set_var(end_blk_var,text);
rl w1 x3+q5 ; w1:=ph;
jl. w3 (r145.) ; remove_th_link; /* w1 unch */
se w1 0 ; if ph<>0 then
jl. w3 (r144.) ; remove_ph(ph);
rl w1 x3+q101 ;
rs w1 x3+q20 ; ic:=end_blk_ic;
jl. e50. ; goto next_op;
; end attention
e5: rl w1 x3+q5 ; w1:=ph;
jl. w3 (r145.) ; remove_th_link; /* w1 unch. */
se w1 0 ; if ph<>0 then
jl. w3 (r144.) ; remove_ph;
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...119...
rl w0 x3+f21 ;
la. w0 j8. ; state.blk:=0;
rs w0 x3+f21 ;
rl w1 x3+q20 ;
al w1 x1+2 ; ic:=ic+2;
rs w1 x3+q20 ;
jl. e50. ; goto next_op;
; include
; aktionen bruger følgende lokale variable i cdescr
q40 = o11 + 0 ; addr p_name (pool name)
q41 = o11 + 2 ; addr o_name (owner name)
q42 = o11 + 4 ; pool
q43 = o11 + 6 ; owner
q44 = o11 + 8 ; old_ic
q45 = o11 + 10 ; localid_varno, eller -1
q46 = o11 + 12 ; localid
e6: rl w0 x3+f21 ;
so. w0 (j0.) ; if state.blk=1 then
jl. i9. ; begin
rl. w2 t0. ; /* allerede i att,inc blok */
jl. w3 (r148.) ; mcl_exit(<:linkexist:>);
jl. e50. ; goto next_op;
; end;
i9: zl w0 x2+6 ;
rl w1 x2+4 ; end_blk_var:=hw(aic+6);
ds w1 x3+q101 ; end_blk_ic:_word(aic+4);
rl w0 x2+2 ;
rx w0 x3+q20 ; old_ic:=ic;
rs w0 x3+q44 ; ic:=word(aic+2);
zl w0 x2+9 ;
rs w0 x3+q4 ; maxtimer:=hw(aic+9);
rl w0 x3+q27 ;
rs w0 x3+q84 ; blk_niv:=mcl_top;
zl w0 x2+8 ;
rs w0 x3+q1 ; max_buf:=hw(aic+8);
al w0 0 ;
rs w0 x3+q0 ; used_buf:=0;
dl w1 x2+12 ; addr p_name:=word(aic+10); /* pool name */
ds w1 x3+q41 ; addr o_name:= word(aic+12);/* owner name */
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...120...
al w0 -1 ;
zl w1 x2+14 ; /* hvis localid i include er variabel gem varno */
sn w1 1 ; if localid string type then
zl w0 x2+15 ; localid_varno:=localid string var
rs w0 x3+q45 ; else localid_varno:=-1;
al w0 0 ;
rl w2 x3+q44 ;
al w2 x2+14 ; /* hent tekst til wrk1 */
jl. w3 (r164.) ; get_text_addr(old_ic+14,lid,0);
al w1 -1 ;
zl w0 x2 ; /* hvis længden af tekst <> tom, glem localid var*/
se w0 2 ; if lid.hw<>2 then
rs w1 x3+q45 ; localid_varno:=-1;
se w0 2 ; if lid.hw<>2 then
rl w1 x2+2 ; localid:=word(lid+2);
rs w1 x3+q46 ;
rl. w0 (r177.) ;
al w1 x3+q7 ;
jl. w3 (r81.) ; create_link(link,seg,r);
se w0 0 ; if r<>0 then
jl. i11. ; goto ER1;
al w0 0 ; /* hent tekst til wrk1 */
rl w2 x3+q40 ; get_text_addr(addr p_name, na, 0);
jl. w3 (r164.) ;
jl. w3 d55. ; strip_sp(na);
al w3 x2+2 ;
jd 1<11+4 ; process_description(pool,na);
rl. w3 (r180.) ;
sn w0 0 ; if pool=0 then
jl. i10. ; goto ER0;
rs w0 x3+q42 ;
al w0 1 ; /* hent tekst til wrk2 */
rl w2 x3+q41 ; get_text_addr(addr o_name,
jl. w3 (r164.) ; na, 1);
jl. w3 d55. ; strip_sp(na);
al w3 x2+2 ;
jd 1<11+4 ; process_description(owner,na);
rl. w3 (r180.) ;
sn w0 0 ; if owner=0 then
jl. i10. ; goto ER0;
rs w0 x3+q43 ;
rl w1 x3+q42 ; /* find ph i kæde */
rl. w2 (r87.) ; ph:=first_ph;
jl. 4 ;
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...121...
i46: rl w2 x2+q2 ; while ph<>0 do
sn w2 0 ; begin
jl. i47. ; if ph.owner=owner and
sn w0 (x2+q1) ; ph.pool=pool then goto f;
se w1 (x2+q0) ; ph:=ph.next_ph;
jl. i46. ; end;
i47: ; f:
sn w2 0 ; if ph=0 then
jl. i10. ; goto ER0;
rl w0 x3+q46 ; w0 := localid;
sn w0 -1 ; if localid = -1 then
jl. w3 (r217.) ; gen_localid(ph,localid);
rs w0 x3+q2 ;
rl w1 x2+q3 ; cda:=ph.pool_head; /* kontrol af localid entydig */
i43: sn w1 0 ; while cda<>0 do
jl. i44. ; begin
sn w0 (x1+q2) ; if cda.localid=localid then
jl. i16. ; goto err2;
rl w1 x1+q6 ; cda:=cda.next_th;
jl. i43. ; end;
i44: al w1 x3 ;
jl. w3 (r88.) ; link_th(ph,th);
rl w1 x3+q62 ;
rl w0 x2+q1 ;
rs w0 x1+f114 ; tbuf.tdescr.sender:=ph.owner;
rl w0 x2+f21 ;
lo. w0 j34. ; ph.state.mtty:=1;
rs w0 x2+f21 ;
rl w0 x3+f21 ;
lo. w0 j33. ; state.blk:=1; state.mtty:=1;
rs w0 x3+f21 ;
al w0 1 ; tbuf.result:=1;
al w1 0 ; tbuf.status:=0;
ds w1 x3+q76 ;
al w0 27 ; tbuf.ch:=27;
rs w0 x3+q77 ;
rl w0 x3+q2 ;
rs. w0 j17. ; /* sæt tekst der skal sendes til pool som
dl w1 x3+q65+2 ; <:<localid:><1><1><32>att<32><32><32>
ds. w1 j18.+2 ; <ext process name><10><0><0>:>
dl w1 x3+q65+6 ;
ds. w1 j18.+6 ;
al w0 18 ;
al. w1 j17. ;
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...122...
rl w2 x3+q63 ; move(addr txt,tbuf.taddr,18);
jl. w3 (r89.) ; /* tæl buf used 1 op, fordi den tælles ned af ph
rl w1 x3+q0 ; uden ph har sendt input til th */
al w1 x1+1 ; used_buf:=used_buf+1
rs w1 x3+q0 ;
am (x3++q5) ; /* lås ph link */
al w2 q7+f72 ;
sn w2 q7+f72 ; if link fjernet then
jl. i10. ; goto ER0;
jl. w3 (r99.) ; wait_semaphor(ph.link.reserve);
rl w0 x3+f14 ;
am (x3+q5) ;
rs w0 q7+f75 ; ph.link.ident:=ident;
al w0 0 ;
al w1 18 ;
jl. w3 (r156.) ; answer_input(18,0,removed);
sn w2 0 ; if removed=0 then
jl. i10. ; goto ER0;
am (x3+q5) ; /* frigiv ph link */
al w2 q7 ;
al w0 0 ;
rs w0 x2+f75 ; ph.link.ident:=0;
al w2 x2+f72 ;
jl. w3 (r101.) ; signal(ph.link.reserve);
rl w1 x3+q45 ; /* hvis localid genereret sæt i variabel fra kald*/
sh w1 -1 ;
jl. i105. ; if localid_varno>-1 then
rl w0 x3+q2 ;
rs. w0 j42. ; set_var(localid_varno,localid);
al. w0 j41. ;
jl. w3 (r138.) ;
i105: rl w1 x3+q100 ;
rl. w0 t1. ;
jl. w3 (r138.) ; set_var(end_blk_var,<:ok:>);
jl. e50. ; goto next_op;
i16: rl w1 x3+q46 ; ER2:
sn w1 -1 ; if localid=-1 then
jl. i47. ; goto F:
am t9-t2 ; txt:=<:local id:> or
i10: am t2-t3 ; ER0: txt:=<:unknown:>
i11: rl. w0 t3. ; ER1: or txt:=<:resorces:>;
rl w1 x3+q100 ; set_var(end_blk_var,txt);
jl. w3 (r138.) ;
al w1 x3+q7 ;
rl w0 x1+f78 ;
\f
;; tas 1.0 14.05.87 terminal handler, run mcl thtxt ...122a...
se w0 0 ; if link.segments>0 then
jl. w3 (r82.) ; remove_link(link);
rl w1 x3+q101 ;
rs w1 x3+q20 ; ic:=end_blk_ic;
jl. e50. ; goto next_op;
; endinclude
e7: rl w0 x3+f21 ;
so. w0 (j34.) ; if state.mtty=1 then
jl. i92. ; begin
al w0 1 ; tbuf.result:=1;
al w1 0 ; tbuf.status:=0;
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...123...
ds w1 x3+q76 ;
al w0 13 ; tbuf.ch:=13;
rs w0 x3+q77 ;
rl w0 x3+q2 ;
rs. w0 j36. ; /* sæt tekst der skal sendes til pool som
al w0 10 ; <:<localid><2><2> out <10>:>
al. w1 j36. ;
rl w2 x3+q63 ; move(addr txt,tbuf.taddr,18);
jl. w3 (r89.) ; /* tæl buf used 1 op, fordi den tælles ned af ph
rl w1 x3+q0 ; uden ph har sendt input til th */
al w1 x1+1 ; used_buf:=used_buf+1
rs w1 x3+q0 ;
am (x3+q5) ; /* lås ph link */
al w2 q7+f72 ;
sn w2 q7+f72 ; if link fjernet then
jl. i92. ; goto NE;
jl. w3 (r99.) ; wait_semaphor(ph.link.reserve);
rl w0 x3+f14 ;
am (x3+q5) ;
rs w0 q7+f75 ; ph.link.ident:=ident;
al w0 0 ;
al w1 10 ; answer_input(10,0,removed);
sn w2 0 ; if removed=0 then
jl. i92. ; goto NE;
jl. w3 (r156.) ;
am (x3+q5) ; /* frigiv ph link */
al w2 q7 ;
al w0 0 ;
rs w0 x2+f75 ; ph.link.ident:=0;
al w2 x2+f72 ;
jl. w3 (r101.) ; signal(ph.link.reserve);
; end;
i92: jl. w3 (r145.) ; NE: remove_th_link;
rl w0 x3+f21 ;
la. w0 j8. ; state.blk:=0;
rs w0 x3+f21 ;
rl w1 x3+q20 ;
al w1 x1+2 ; ic:=ic+2;
rs w1 x3+q20 ;
jl. e50. ; goto next_op;
; at
e8: zl w1 x2+2 ;
rs w1 x3+q102 ; col:=hw(aic+2);
el w2 x2+3 ; x:=hw(aic+3);
sl w2 0 ; if x>=0 then
\f
;; tas 1.0 14.05.87 terminal handler, run mcl thtxt ...123a...
rs w2 x3+q103 ; lin:=x;
rl w2 x3+q103 ;
jl. w3 (r171.) ; cursor(col,lin);
rl w1 x3+q20 ;
al w1 x1+4 ; ic:=ic+4;
rs w1 x3+q20 ;
jl. e50. ; goto next_op;
; write
e9: rl w1 x2+2 ; x:=ic+4;
rx w1 x3+q20 ; ic:=word(aic+2);
al w0 0 ;
al w2 x1+4 ; /* hent tekst til wrk1 */
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...124...
jl. w3 (r164.) ; get_text_addr(x,st,0);
al w1 x2 ;
rl w2 x3+q63 ; /* flyt til buffer der bliver i core */
jl. w3 (r213.) ; move_text(st,tbuf.taddr);
al w1 x2 ;
jl. w3 (r167.) ; outtext(tbuf.taddr,s);
jl. e50. ; goto next_op;
; nl
e10: rl. w1 t6. ;
jl. w3 (r167.) ; outtext(<:<10>:>);
rl w1 x3+q20 ;
al w1 x1+2 ; ic:=ic+2;
rs w1 x3+q20 ;
jl. e50. ; goto next_op;
; read
; aktionen bruger følgende lokale variable i cdescr
q40 = o11 + 0 ; var_no
q41 = o11 + 2 ; n
q42 = o11 + 4 ; va
q43 = o11 + 6 ; vn
e11: zl w0 x2+3 ;
rs w0 x3+q40 ; var_no:=hw(aic+3);
el w0 x2+2 ; n:=hw(aic+2);
rs w0 x3+q43 ; vn:=n;
sh w0 0 ; if n>0 then
jl. i14. ; begin
sl w0 80 ; if n>80 then
al w0 80 ; n:=80;
rs w0 x3+q41 ;
ls w0 1 ;
rl w2 x3+q63 ;
al w2 x2-2 ;
al w1 x3+q15 ; init_td(td,tbuf.taddr-2,2*n);
jl. w3 (r161.) ;
rl w1 x3+q41 ;
i12: rs. w1 j3. ; for i:=1 to n do
al w0 46 ; c_write(td,'.');
al w1 x3+q15 ;
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...125...
jl. w3 (r163.) ;
rl. w1 j3. ;
al w1 x1-1 ;
sl w1 1 ;
jl. i12. ;
rl w1 x3+q41 ;
i13: rs. w1 j3. ; for i:=1 to n do
rl w0 x3+q88 ; c_write(td,'BS');
al w1 x3+q15 ;
jl. w3 (r163.) ;
rl. w1 j3. ;
al w1 x1-1 ;
sl w1 1 ;
jl. i13. ;
al w1 x3+q15 ; outtext(td);
jl. w3 (r168.) ; end
jl. i15. ; else
i14: al w1 81 ; n:=81;
rs w1 x3+q41 ;
i15: rl w1 x3+q63 ;
al w1 x1+4 ;
rs w1 x3+q15+2 ; td.first:=tbuf.taddr+4;
rl w0 x3+q41 ;
al w1 x3+q15 ;
rl. w2 (r102.) ;
jl. w3 (r172.) ; in_text(td,n,0,timeout,s);
sz. w0 (j52.) ; if hard error i s then
jl. i89. ; goto E;
so. w0 (j35.) ; if timeout i s then begin
jl. i90. ;
am 32 ;
i89: al w1 0 ; E: terminate_th(32);
jl. w2 (r183.) ; end;
i90: so. w0 (j23.) ; if att i s then
jl. i95. ; begin
al w0 0 ; n:=0;
rs w0 x3+q41 ; goto set_txt;
jl. i93. ; end;
i95: rl w0 x3+q43 ;
al w2 -1 ;
sh w0 0 ; if vn > 0 then
jl. i86. ; vn:=n - td.nch
rl w2 x3+q43 ; else vn:=-1;
bs w2 x1+4 ;
i86: rs w2 x3+q43 ;
zl w2 x1+4 ; n:=td.nch;
\f
;; tas 1.0 14.05.87 terminal handler, run mcl thtxt ...125a...
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...126...
rs w2 x3+q41 ;
i87: jl. w3 (r162.) ; repeat
se w0 10 ; c_read(td,c);
sh w0 -1 ; until c=10 or c=-1;
jl. 4 ;
jl. i87. ;
rl w2 x3+q43 ;
hs w2 x1+4 ; td.nch:=vn;
se w0 10 ; if c = 10 then
jl. i88. ; begin
el w2 x1+4 ;
al w2 x2+1 ; td.nch:=td.nch + 1;
hs w2 x1+4 ;
rl w2 x3+q41 ;
al w2 x2-1 ; n:=n-1;
rs w2 x3+q41 ;
el w2 x1+5 ;
al w2 x2+8 ; td.chshift:=td.chshift+8;
hs w2 x1+5 ;
se w2 16 ; if td.chshift = 16 then
jl. i88. ; begin
al w2 -8 ; td.chshift:=-8;
hs w2 x1+5 ;
rl w2 x1 ;
al w2 x2-2 ; td.cur:=td.cur - 2;
rs w2 x1 ; end;
i88: el w2 x1+5 ; end;
al w2 x2+8 ;
al w0 -1 ; maske := -1 shift (td.chshift+8);
ls w0 x2 ;
la w0 (x1) ; word(td.cur):=word(td.cur) and maske;
rs w0 (x1) ;
rl w2 x3+q41 ;
ea w2 x1+4 ; n:=n + td.nch;
rs w2 x3+q41 ;
i94: el w0 x1+4 ; while th.nch >0 do
sh w0 0 ; c_write(td,32);
jl. i93. ;
al w0 32 ;
jl. w3 (r163.) ;
jl. i94. ;
i93: rl w2 x3+q15+2 ; set_txt: txt:=td.first-2;
al w2 x2-2 ;
rl w1 x3+q41 ;
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...127...
hs w1 x2+1 ; txt.ch:=n;
al w1 x1+2 ;
al w0 0 ;
wd. w1 j4. ; txt.hw:=(n+2)/3*2 + 2;
ls w1 1 ;
al w1 x1+2 ;
hs w1 x2 ;
al w0 x2 ;
rl w1 x3+q40 ; set_var(var_no,txt,t_addr);
jl. w3 (r138.) ;
rl w1 x3+q20 ;
al w1 x1+4 ; ic:=ic+4;
rs w1 x3+q20 ;
jl. e50. ; goto next_op;
; get
; aktionen bruger følgende lokale variable i cdescr
q40 = o11 + 0 ; var_no
q41 = o11 + 2 ; n_ch
q42 = o11 + 4 ; op
q43 = o11 + 6 ; va
q44 = o11 + 8 ; txt
e12: rl w0 x3+f21 ;
sz. w0 (j12.) ; if state.stty=0 and state.mtty=0 then
jl. i83. ; begin /* ingen link */
sz. w0 (j0.) ; if state.blk=1 then
jl. i80. ; goto link_removed;
rl. w2 t7. ; exit_mcl(<:no link:>);
jl. w3 (r148.) ; goto next_op;
jl. e50. ; end
i83: zl w0 x2+3 ;
zl w1 x2+2 ; var_no:=hw(aic+3);
ds w1 x3+q41 ; n_ch:=hw(aic+2);
rl w0 x3+f21 ;
lo. w0 j50. ; state.get_send:=1;
rs w0 x3+f21 ;
; w_op:
i79: jl. w3 (r140.) ; wait_op(op,r);
se w2 -2 ; if r=-2 then begin
jl. i101. ; txt:=<:system:>
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...128...
rl. w0 t10. ; goto skip_blk;
jl. i84. ; end;
i101: sl w2 0 ; if op<0 then
jl. i20. ; begin /* link nedlagt */
i80: rl. w0 t5. ; link_removed: txt:=<:removed:>
i84: rl w1 x3+q100 ; skip_blk: set_var(end_blk_var,txt);
rs w0 x3+q44 ;
jl. w3 (r138.) ;
i81: rl w0 x3+q27 ;
sn w0 (x3+q84) ; while mcl_top<>blk_niv do
jl. i82. ; mcl_exit(txt);
rl w2 x3+q44 ;
jl. w3 (r148.) ;
jl. i81. ; ic:=end_blk_ic;
i82: rl w0 x3+f21 ;
la. w0 j51. ; state.send_get:=0;
rs w0 x3+f21 ;
rl w0 x3+q101 ; goto next_op;
rs w0 x3+q20 ; end;
jl. e50. ;
i20: rs w2 x3+q42 ;
zl w0 x2 ;
sn w0 9 ; if op.opcode=9 then
je -55 ; fault
se w0 20 ; else
jl. i110. ; if op.opcode=20 then begin
jl. w3 (r154.) ; ctrl_op(op);
jl. i79. ; goto w_op;
i110: se w0 21 ; end else
jl. i111. ; if op.opcode=21 then begin
rl. w0 r222. ; txt:=<:cmcl:>; goto skip_blk;
jl. i84. ; end
i111: sn w0 5 ; if op.opcode<>output then
jl. i21. ; /* sæt variabel til tom */
rl w1 x3+q40 ; alloc_var(var_no,va,0);
al w2 0 ;
jl. w3 (r136.) ; else
jl. i29. ; begin
i21: rl w1 x3+q40 ;
rl w2 x3+q41 ;
jl. w3 (r136.) ; alloc_var(var_no,va,n_ch);
sn w2 0 ; if va=0 then goto z;
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...129...
jl. i27. ;
rs w2 x3+q43 ;
al. w1 j5. ; /* init skrive td */
rl w0 x3+q41 ; init_td(tdw,va,n_ch);
jl. w3 (r161.) ;
rl w2 x3+q42 ;
al w2 x2+4 ;
al w1 x3+q15 ;
rl w0 x2-2 ;
ls w0 -1 ; /* init læse td */
wm. w0 j4. ; init_td(td,op+4,
jl. w3 (r161.) ; word(op+2)/2*3 );
al w0 0 ;
rs. w0 j3. ; n:=0;
al w1 x3+q15 ;
i22: jl. w3 (r162.) ; x: c_read(td,c);
sn w0 0 ; if c_0 then goto x;
jl. i22. ;
i23: rl. w1 j3. ;
sl w0 0 ; while c>0 and
sl w1 (x3+q41) ; n<n_ch do
jl. i25. ; begin
al w1 x1+1 ; n:=n+1;
rs. w1 j3. ;
al. w1 j5. ; c_write(tdw,c);
jl. w3 (r163.) ; y: c_read(td,c);
al w1 x3+q15 ; if c=0 then goto y;
i24: jl. w3 (r162.) ; end;
sn w0 0 ;
jl. i24. ;
jl. i23. ;
i25: al w0 32 ;
sl w1 (x3+q41) ; while n<n_ch do
jl. i27. ; c_write(tdw,32);
al w1 x1+1 ;
rs. w1 j3. ;
al. w1 j5. ;
jl. w3 (r163.) ;
rl. w1 j3. ;
jl. i25. ;
i27: rl w0 x3+f21 ; z: if state.output=1 then
so. w0 (j9.) ; output_op(op,s);
jl. i28. ;
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...130...
rl w2 x3+q42 ; if hard error i s then
jl. w3 (r152.) ; goto E;
sz. w0 (j52.) ; end
jl. i89. ; else
jl. i29. ; release_op(link);
i28: al w1 x3+q7 ; end;
jl. w3 (r90.) ;
i29: rl w1 x3+q20 ;
al w1 x1+4 ; ic:=ic+4;
rs w1 x3+q20 ;
rl w0 x3+f21 ;
la. w0 j51. ; state.send_get:=0;
rs w0 x3+f21 ;
jl. e50. ; goto next_op;
; let
; aktionen bruger følgende lokale variable i cdescr
q40 = o11 + 2 ; var_no
q41 = o11 + 4 ; st
e13: rl w1 x2+2 ; oldic:=ic;
rx w1 x3+q20 ; ic:=word(aic+2);
zl w0 x2+4 ;
rs w0 x3+q40 ; var_no:=hw(aic+4);
al w2 x1+6 ;
al w0 0 ; /* hent tekst til wrk1 */
jl. w3 (r164.) ; get_text_addr(oldic+6,st,0);
al w1 x2 ;
rl w2 x3+q63 ; /* flyt til buffer der bliver i core */
jl. w3 (r213.) ; move_text(st,tbuf.taddr);
al w0 x2 ;
rl w1 x3+q40 ;
jl. w3 (r214.) ; set_var(var_no,tbuf_taddr,t_addr);
jl. e50. ; goto next_op;
; send
; aktionen bruger følgende lokale variable i cdescr
q40 = o11 + 0 ; n_ch/n
q41 = o11 + 2 ; old_ic
q42 = o11 + 4 ; (n+2)/3*2
q43 = o11 + 6 ; sender
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...131...
e14: rl w0 x3+f21 ;
sz. w0 (j12.) ; if state.stty=0 and state.mtty=0 then
jl. i30. ; begin /* ingen link */
sz. w0 (j0.) ; if state.blk=1 then
jl. i80. ; goto link_removed;
rl. w2 t7. ; exit_mcl(<:no link:>);
jl. w3 (r148.) ; goto next_op;
jl. e50. ; end
i30: rl w1 x2+2 ; old_ic:=ic;
rx w1 x3+q20 ; ic:=word(aic+2);
rs w1 x3+q41 ;
rl w0 x3+f21 ;
lo. w0 j50. ; state.send_get:=1;
rs w0 x3+f21 ;
i31: jl. w3 (r140.) ; w_next: wait_op(op);
se w2 -2 ; if r=-2 then begin
jl. i100. ; txt:=<:system:>
rl. w0 t10. ; goto skip_blk;
jl. i84. ; end;
i100: sh w2 -1 ;
jl. i80. ; if op<0 then goto link_removed;
zl w0 x2 ;
se w0 5 ; if op.opcode = 5 then begin
jl. i34. ; /* output */
rl w0 x3+f21 ;
so. w0 (j9.) ; if state.output then begin
jl. i33. ; output_op(op,s);
jl. w3 (r152.) ; if hard error i s then goto E;
sz. w0 (j52.) ; end
jl. i89. ; else
jl. i31. ; release_op(op);
i33: al w1 x3+q7 ; goto w_next;
jl. w3 (r90.) ; end
jl. i31. ; else
i34: sn w0 9 ; if op.opcode=9 then
je -55 ; fault
se w0 20 ; else
jl. i35. ; if op.opcode=20 then begin
jl. w3 (r154.) ; ctrl_op(op);
jl. i31. ; goto w_next;
i35: se w0 21 ; end else
jl. i102. ; if op.opcode=21 then begin
rl. w0 r222. ; txt:=<:cmcl:>; goto skip_blk;
jl. i84. ; end
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...132...
i102: se w0 3 ; else if op.opcode<>3 then
je -55 ; fault;
rl w1 x2+2 ;
ls w1 -1 ;
wm. w1 j4. ;
zl w0 x2+1 ; n_ch:=op.hw/2*3
ls w0 -4 ; - (op.mode shift -4) extract 3;
la. w0 j6. ;
ws w1 0 ;
rs w1 x3+q40 ;
rl w1 x2+4 ;
rs w1 x3+q43 ; sender:=op.sender;
al w1 x3+q7 ;
jl. w3 (r90.) ; release_op(link);
rl w0 x3+q40 ;
sh w0 0 ; if n_ch>0 then
jl. i36. ; begin
al w0 0 ;
rl w2 x3+q41 ; /* hent tekst til wrk1 */
al w2 x2+4 ; get_text_addr(old_ic+4,va,0);
jl. w3 (r164.) ;
zl w1 x2+1 ; n:=hw(va+1);
sl w1 (x3+q40) ; if n>=n_ch then
rl w1 x3+q40 ; n:=n_ch;
rs w1 x3+q40 ;
al w1 x1+2 ;
al w0 0 ;
wd. w1 j4. ; n_move:=(n+2)/3*2;
ls w1 1 ;
al w0 x1 ;
rs w0 x3+q42 ; move( va+2,
al w1 x2+2 ; tbuf.tddr, n_move);
rl w2 x3+q63 ;
jl. w3 (r199.) ;
jl. i37. ; end
i36: al w0 0 ; else
rs w0 x3+q40 ; n:=0;
rs w0 x3+q42 ;
i37: rl w0 x3+f21 ;
so. w0 (j10.) ; if state.echo=1 then
jl. i38. ; begin
al w0 5 ;
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...133...
rl w1 x3+q62 ;
rl w2 x3+q43 ;
se w2 (x1+f114) ; if sender<>tbuf.tdescr.sender then
jl. w3 (r210.) ; write_to_from(sender,to);
rl. w0 j11. ; tbuf.op:=5, tbuf.mode:=0;
rs w0 x3+q66 ; tbuf.first:=tbuf.taddr;
rl w1 x3+q63 ; tbuf.last:=tbuf.first +
al w2 x1-2 ; (n+2)/3*2 -2;
wa w2 x3+q42 ; term_send_wait(s);
ds w2 x3+q69 ;
jl. w3 (r160.) ; end;
i38: al w0 1 ; tbuf.result:=1;
al w1 0 ; tbuf.status:=0;
ds w1 x3+q76 ;
rl w0 x3+q40 ;
rs w0 x3+q77 ; tbuf.ch:=n;
am (x3+q5) ; /* lås ph link */
al w2 q7+f72 ;
sn w2 q7+f72 ; if link fjernet then
jl. i41. ; goto FJ;
jl. w3 (r204.) ; wait_semaphor(ph.link.reserve);
rl w0 x3+f14 ;
am (x3+q5) ;
rs w0 q7+f75 ; ph.link.ident:=ident;
al w0 0 ;
rl w1 x3+q42 ;
jl. w3 (r156.) ; answer_input( (n+2)/3*2, 0,removed);
sn w2 0 ; if removed=0 then
jl. i41. ; goto FJ;
am (x3+q5) ; /* frigiv ph link */
al w2 q7 ;
al w0 0 ;
rs w0 x2+f75 ; ph.link.ident:=0;
al w2 x2+f72 ;
jl. w3 (r211.) ; signal(ph.link.reserve);
i41: rl w0 x3+f21 ; FJ:
la. w0 j51. ; state.send_get:=0;
rs w0 x3+f21 ;
jl. e50. ; goto next_op;
; execute
; aktionen bruger følgende lokale variable i cdescr
q40 = o11 + 0 ; var_no
q41 = o11 + 2 ; old_ic
\f
;; tas 1.0 14.05.87 terminal handler, run mcl thtxt ...133a...
e15: rl w0 x3+q20 ; old_ic:=ic;
rs w0 x3+q41 ;
rl w0 x2+2 ;
rs w0 x3+q20 ; ic:=word(aic+2);
zl w2 x2+4 ;
rs w2 x3+q40 ; var_no:=hw(aic+4);
rl w1 x3+q22 ;
jl. w3 (r224.) ; push(ic,mcl_wntry,var_no,r);
sn w0 0 ; if r<>0 then
jl. i39. ; begin /* ikke plads */
rl. w0 r225. ;
rl w1 x3+q40 ; set_var(var_no,<:ressources:>);
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...134...
jl. w3 (r226.) ; goto next_op;
jl. e50. ; end;
i39: al w0 0 ;
rl w2 x3+q41 ;
al w2 x2+6 ; /* hent tekst til wrk1 */
jl. w3 (r208.) ; get_text_addr(oldic+6,name,0);
jl. w3 (r212.) ; strip_sp(name);
al w2 x2+2 ; w2 = start af navn
dl w1 x3+q86 ; sæt mcl user baser
ds w1 x2+10 ;
jl. w3 (r218.) ; insert_mcl_name(name,mcl_entry,r);
sn w0 0 ; if r<>0 then
jl. i40. ; begin /* navn ikke fundet */
rl w1 x3+q40 ;
rl. w0 r223. ; set_var(var_no,<:unknown:>);
jl. w3 (r226.) ; pop(x,y,z);
jl. w3 (r227.) ; goto next_op;
jl. e50. ; end;
i40: rs w1 x3+q22 ; /* hent mcl program segment 0 */
al w2 0 ; get_mcl_segment(mcl_entry,0,
jl. w3 (r219.) ; mcl_buf,mcl_cte,r);
ds w2 x3+q24 ;
zl w0 x1+1 ; mcl_index:=
rs w0 x3+q25 ; mcl_cte.type;
al w0 0 ;
rs w0 x3+q20 ; ic:=0;
jl. e50. ; goto next_op;
; direct
e16: rl w1 x3+q20 ;
al w1 x1+4 ;
rs w1 x3+q20 ; ic:=ic+4;
rl w0 x3+f21 ;
sz. w0 (j12.) ; if state.stty=0 and state.mtty=0 then
jl. i42. ; begin /* ingen link */
sz. w0 (j47.) ; if state.blk=1 then
jl. i80. ; goto link_removed;
rl. w2 r220. ; exit_mcl(<:no link:>);
jl. w3 (r201.) ; goto next_op;
jl. e50. ; end
i42: rl w0 x3+f21 ; else
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...135...
lo. w0 j13. ; begin
rs w0 x3+f21 ; state.direct:=1;
zl w1 x2+2 ; var_no:=hw(aic+2);
jl. w3 (r184.) ; direct(var_no);
rl w0 x3+f21 ;
la. w0 j14. ; state.direct:=0;
rs w0 x3+f21 ;
jl. e50. ; end;
; exit
e17: rl w2 x3+q20 ;
al w2 x2+2 ;
al w0 0 ; /* hent tekst til wrk1 */
jl. w3 (r208.) ; get_text_addr(ic+2,va,0);
al w1 x2 ;
rl w2 x3+q63 ; /* flyt til buffer der bliver i core */
al w2 x2+14 ; /* plads til cursor pos kommando */
jl. w3 (r213.) ; move_text(st,tbuf.taddr);
jl. w3 (r201.) ; mcl_exit(va);
jl. e50. ; goto next_op;
; output on, echo on
j48: p9 ; state.output
j49: p10 ; state.echo
e18: am j48-j49 ; output on: bit:=output
e20: rl. w0 j49. ; echo on: or bit:=echo;
lo w0 x3+f21 ; state.bit:=1;
jl. i85. ; goto inc_ic;
; output off, echo off
j15: -p9-1 ; -state.output
j16: -p10-1 ; -state.echo
e19: am j15-j16 ; output off: bit:=output
e21: rl. w0 j16. ; echo off: or bit:=echo;
la w0 x3+f21 ; state.bit:=0;
i85: rs w0 x3+f21 ; inc_ic;
rl w1 x3+q20 ;
al w1 x1+2 ; ic:=ic+2;
rs w1 x3+q20 ;
jl. e50. ; goto next_op;
\f
;; tas 1.0 14.05.87 terminal handler, run mcl thtxt ...135a...
; menu
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...136...
; aktionen bruger følgende lokale variable i cdescr
q40 = o11 + 0 ; point_table
q41 = o11 + 2 ; last_rel
q42 = o11 + 4 ; txt
q43 = o11 + 6 ; 0,r.8 saved_tspec
q44 = o11 + 22 ; 0,r.8 tspec
q45 = o11 + 38 ; rel_point
q46 = o11 + 40 ; saved return from local procedure
q47 = o11 + 42 ; saved w2 in local procedure
e22: rl w0 x2+4 ; Menu_start:
rs w0 x3+q40 ; point_table:=word(aic+4);
rl w0 x2+6 ;
rs w0 x3+q42 ; txt:=word(aic+6);
zl w1 x2+3 ; n:=hw(aic+3);
al w1 x1-1 ; last_rel:=
wm. w1 j21. ; (n-1)*point_entry_length;
rs w1 x3+q41 ;
al w1 0 ;
zl w2 x2+2 ; cursor(0,hw(aic+2),s);
jl. w3 (r198.) ;
jl. w3 (r195.) ; erase(s); /* blank resten af skærmen */
i51: al w0 1 ; repeat /* reserver plads til låst segment */
jl. w3 (r215.) ; corebuf_lock(1);
rl w2 x3+q42 ;
jl. w3 (r197.) ; get_abs(ta,txt);
sh w2 0 ; if ta<0 then
jl -1 ; goto error;
rl w1 x3+q23 ;
rl w0 x1 ;
lo. w0 j22. ; /* lås segment med teksten */
rs w0 x1 ; mcl_cte.prio.L:=1;
rl w0 x2 ;
rs w0 x3+q42 ; txt:=word(ta);
al w1 x2+2 ;
jl. w3 (r207.) ; outtext(ta+2,s);
jl. w3 (r216.) ; corebuf_open; /* frigiv corebuffer */
rl w1 x3+q23 ;
rl w2 x1 ; /* frigiv segment */
la. w2 j20. ; mcl_cte.prio.L:=0;
rs w2 x1 ;
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...137...
so. w0 (j23.) ; if att i s then
jl. i52. ; begin
rl w2 x3+q20 ;
jl. w3 (r197.) ; get_abs(aic,ic);
sh w2 0 ; if aic<0 then fault;
je -56 ; goto Menu_start;
jl. e22. ; end;
i52: rl w2 x3+q42 ; until txt=0;
se w2 0 ;
jl. i51. ;
al. w1 j25. ; /* gem term spec */
al w2 x3+q43 ; mes:=a5<12+0, ans:=saved_tsepc;
jl. w3 i64. ; send_wait(mes,ans);
rl. w0 j24. ; /* sæt opcode til senere */
rs w0 x3+q43 ;
al w0 16 ;
rl w1 x3+q62 ;
al w1 x1+f111 ;
al w2 x3+q44 ; move(tbuf.tdescr.term_spec,
jl. w3 (r199.) ; tspec,16);
rl w1 x3+q44+2 ; /* sæt echo:=0
la. w1 j26. ; promt:=0
al w1 x1+2 ; type=2 */
rs w1 x3+q44+2 ;
al w1 0 ;
rs w1 x3+q44+4 ;
rl. w0 j24. ;
rs w0 x3+q44 ;
al w1 x3+q44 ;
al w2 x3+q8 ; mes:=tspec;
jl. w3 i64. ; send_wait(mes,ans);
; hent tabel og sæt cursor under første linie
rl w2 x3+q40 ;
jl. w3 (r197.) ; get_abs(start_point,point_table);
sl w2 10 ; if start_point < 10 then /* fejl i mcl prg */
jl. i103. ; begin
al w1 x3+q43 ; /*sæt term spec tilbage */
al w2 x3+q8 ; mes:=saved_tsepc;
jl. w3 i64. ; send_wait(mes,ans);
jl. i98. ; goto error exit mcl prg;
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...138...
; end;
i103: rs. w2 j27. ; point:=point_table;
i53: rl w0 x2 ; while point.type.ctrl_char=1 do
so w0 1<3 ; point:=point + point_entry_length;
jl. i54. ;
al w2 x2+a42 ;
jl. i53. ;
i54: ws. w2 j27. ; Next_char:
rs w2 x3+q45 ; rel_point:=point - start_point;
wa. w2 j27. ;
zl w1 x2+2 ;
zl w2 x2+3 ; cursor(point.col, point.lin);
jl. w3 (r198.) ;
i55: rl. w0 (r209.) ; Rd:
ls w0 -12 ;
jl. w3 (r200.) ; rd_char(c,timeout,s);
sz. w0 (j43.) ; if hard error i s then
jl. i96. ; goto HD;
so. w0 (j40.) ; if timeout i s then begin
jl. i91. ; begin
i96: al w1 x3+q43 ; HD: /*sæt term spec tilbage */
al w2 x3+q8 ; mes:=saved_tsepc;
jl. w3 i64. ; send_wait(mes,ans);
al w1 32 ; terminate_th(32);
jl. w2 (r183.) ;
; end;
i91: so. w0 (j23.) ; if att i s then
jl. i56. ; begin
al w1 x3+q43 ; /*sæt term spec tilbage */
al w2 x3+q8 ; mes:=saved_tsepc;
jl. w3 i64. ; send_wait(mes,ans);
rl w2 x3+q20 ; get_abs(aic,ic);
jl. w3 (r197.) ;
sh w2 0 ; if aic<1 then fault;
je -56 ; goto Menu_start;
jl. e22. ; end;
i56: rs w1 x3+q47 ;
rl w2 x3+q40 ;
jl. w3 (r197.) ; get_abs(start_point,point_tabel);
sh w2 0 ; if point_start<0 then fault;
je -56 ;
rs. w2 j27. ; point:=start_point+rel_point;
wa w2 x3+q45 ;
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...139...
rl w1 x3+q47 ; w1:=læst tegn
sh w1 125 ;
sh w1 96 ; if c>96 and c<126 then
am 32 ; c:=c-32;
al w0 x1-32 ;
sn w0 13 ; if c=cr then
jl. i63. ; goto found
se w0 (x3+q80) ; if c=up_arrow then
jl. i59. ; begin
rl w0 x2 ; repeat
i57: al w2 x2-a42 ; w0:=point.type;
so w0 1<0 ; point:=point - point_entry_length;
jl. i58. ; if w0.first=1 then
rl. w2 j27. ; point:=start_point + last_rel;
wa w2 x3+q41 ;
i58: rl w0 x2 ; until point.type.ctrl_char=0;
sz w0 1<3 ;
jl. i57. ; goto Next_char;
jl. i54. ; end;
i59: se w0 (x3+q81) ; if c=down_arrow then
jl. i61. ; begin
rl w0 x2 ; repeat w0:=point.type;
i60: al w2 x2+a42 ; point:=point+point_entry_length;
sz w0 1<1 ; if w0.last=1 then
rl. w2 j27. ; point:=start_point;
rl w0 x2 ; until point.type.ctrl_char=0;
sz w0 1<3 ; goto Next_char;
jl. i60. ; end;
jl. i54. ;
i61: rl. w2 j27. ; point:=start_point;
i62: zl w1 x2 ; repeat
sn w0 x1 ; if point.ch=c then
jl. i63. ; goto found;
rl w1 x2 ; point:=point+point_entry_length;
al w2 x2+a42 ; until point.type.last=1;
so w1 1<1 ;
jl. i62. ; /* ikke fundet */
jl. i55. ; goto Rd;
i63: rl w0 x2+4 ; found:
rs w0 x3+q20 ; ic:=point.ic;
zl w1 x2+2 ;
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...140...
zl w2 x2+3 ;
rs w2 x3+q103 ; lin:=point.lin;
jl. w3 (r198.) ; cursor(point.col,point.lin);
al w1 x3+q43 ; /* sæt term spec tilbage */
al w2 x3+q8 ; mes:=tspec;
jl. w3 i64. ; send_wait(mes,ans);
jl. (r221.) ; goto next_op;
; lokal procedure der sætter og henter term spec
; w1 message area, w2 answer area, w3 return
; send_wait
i64: rs. w3 j46. ;
rl. w3 (r180.) ;
rl. w0 j46. ;
rs w0 x3+q46 ;
rs w2 x3+q47 ; save return, w2 i cdescr;
al w2 x3+q65 ;
jl. w3 (r191.) ; csend_message(mes,tbuf.name,buf);
sh w2 1 ; if buf<2 then
je -12 ; fault;
rl w1 x3+q47 ;
al w0 0 ;
jl. w3 (r189.) ; cwait_answer(buf,0,ans,r);
jl (x3+q46) ; return;
; erase
e23: jl. w3 (r195.) ; erase(s);
rl w1 x3+q20 ;
al w1 x1+2 ; ic:=ic+2;
rs w1 x3+q20 ;
jl. (r221.) ; goto next_op;
; convert
e24: zl w1 x2+2 ; var_no:=hw(aic+2);
jl. w3 (r192.) ; var_addr(var_no,v);
al w1 x2 ;
ea w1 x2 ; top:=v + hw(v);
rs. w1 j46. ;
al w2 x2+2 ; v:=v+2;
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...141...
i66: rl w1 x2 ; repeat
al w3 0 ; w1:=word(v);
i67: al w0 0 ; i:=0;
ld w1 8 ; repeat
sh w0 93 ; w0w1:=w1 shift 8;
sh w0 64 ; if w0>64 and w0<94 then
jl. +4 ; w1:=w1+32;
al w1 x1+1<5 ;
al w3 x3+1 ;
sh w3 2 ; until i>2;
jl. i67. ;
sn w1 0 ; if w1<>0 then
jl. i68. ; word(v):=word(v) or w1;
lo w1 x2 ;
rs w1 x2 ;
i68: al w2 x2+2 ; v:=v+2;
se. w2 (j46.) ; until v=top;
jl. i66. ;
rl. w3 (r180.) ;
rl w1 x3+q20 ;
al w1 x1+4 ; ic:=ic+4;
rs w1 x3+q20 ;
jl. (r221.) ; goto next_op;
j12: p4+p5 ; state.stty + state.mtty
j13: p7 ; state.direct
j14: -p7-1 ; -state.direct
j20: -(:1<22:)-1 ;
j21: a42 ; point_entry_length
j22: 1<22 ; timeout
j23: 1<16 ; att
j24: a6<12+0 ;
j25: a5<12+0 ;
j26: -(:3<11+63:)-1 ;
j27: 0 ; start_point
j40: 1<21 ; timeout status
j41: 4<12+3 ; mcl tekst med
j42: 0 ; localid
j43: 2.1000000111100
j46: 0 ; wrk
j47: p8 ; state.blk
e.
\f
;; tas 1.0 14.05.87 terminal handler, run mcl thtxt ...141a...
u14:
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...142...
r180: h. m24 , 1 w. ; c0 curco
r181: h. m120 , 1 w. ; e55 get_buffer
r182: h. m67 , 1 w. ; c48 free_term
r183: h. m149 , 1 w. ; g119 terminate_th
r184: h. m150 , 1 w. ; g120 direct
r185: h. m10 , 1 w. ; e20 signal
r186: h. m161 , 1 w. ; c53 max_tbuf_size
r187: h. m18 , 1 w. ; e52 init_semaphor
r188: h. m173 , 1 w. ; g23 write_error
r189: h. m8 , 1 w. ; e18 cwait_answer
r190: h. m150 , 1 w. ; g120 direct
r191: h. m7 , 1 w. ; e16 csendmessage
r192: h. m135 , 1 w. ; g105 var_addr
r193: h. m75 , 1 w. ; g6 get_spool_segment
r194: h. m169 , 1 w. ; g164 run_mcl
r195: h. m110 , 1 w. ; g149 erase
r196: h. m187 , 1 w. ; t7 <:timeout:>
r197: h. m131 , 1 w. ; g101 getabs
r198: h. m111 , 1 w. ; g150 cursor
r199: h. m89 , 1 w. ; g22 move
r200: h. m113 , 1 w. ; g152 rd_char
r201: h. m148 , 1 w. ; g118 mcl_exit
r202: h. m176 , 1 w. ; e1 testout registers
r203: h. m126 , 1 w. ; c52 lock_sem
r204: h. m11 , 1 w. ; e22 wait_semaphor
r205: h. m56 , 1 w. ; c39 segmenttable
r206: h. m55 , 1 w. ; c38 coretable base
r207: h. m107 , 1 w. ; g146 outtext
r208: h. m104 , 1 w. ; g143 get_text_addr
r209: h. m172 , 1 w. ; c60 timeout perioder i mcl
r210: h. m239 , 1 w. ; g132 write_to_from
r211: h. m10 , 1 w. ; e20 signal
r212: h. m116 , 1 w. ; g155 strip_sp
r213: h. m106 , 1 w. ; g145 move_text
r214: h. m138 , 1 w. ; g108 set_var
r215: h. m246 , 1 w. ; g15 corebuf_lock
r216: h. m247 , 1 w. ; g16 corebuf_open
r217: h. m252 , 1 w. ; g136 gen_localid
r218: h. m81 , 1 w. ; g12 insert_mcl_name
r219: h. m83 , 1 w. ; g14 get_mcl_name
r220: h. m210 , 1 w. ; t30 <:no link:>
r221: h. m253 , 1 w. ; g170 Next_op
r222: h. m256 , 1 w. ; t56 <:cmcl:>
r223: h. m185 , 1 w. ; t5 <:unknown:>
r224: h. m132 , 1 w. ; g102 push
r225: h. m186 , 1 w. ; t6 <:resources:>
r226: h. m138 , 1 w. ; g108 set_var
\f
;; tas 1.0 14.05.87 terminal handler, run mcl thtxt ...142a...
r227: h. m133 , 0 w. ; g103 pop
\f
;. tas 1.0 14.05.87 terminal handler, run mcl thtxt ...143...
; end init liste
\f
; tas 1.0 14.05.87 terminal handler thtxt ...144...
; terminal handler coroutine code
b. i10, j5 ;
w.
d61:
u31: rl. w2 (r182.) ;
jl. w3 (r181.) ; get_buffer(free_term,t);
sn w1 0 ; if t=0 then
jl. i2. ; goto end_th;
rs w1 x3+q63 ; tbuf.taddr:=t;
rl. w0 (r186.) ;
rs w0 x3+q64 ; tbuf.size:=max_tbuf_size;
rl w2 x3+q62 ;
dl w1 x2+f108+2 ; tbuf.name:=tbuf.tdescr.name;
ds w1 x3+q65+2 ;
dl w1 x2+f108+6 ;
ds w1 x3+q65+6 ;
rl w0 x2+f108+8 ;
rs w0 x3+q79 ;
al w2 0 ;
rs w2 x3+f27 ; result:=0;
al w2 x3+f26 ;
jl. w3 (r185.) ; signal(stop_sem); /* signal til creator */
al w0 a40+1 ;
rs w0 x3+q28 ; sæt max mcl stack size
al w0 0 ;
al w2 x3+q14 ;
jl. w3 (r187.) ; init_semaphor(a_sem,0);
rl. w3 (r180.) ;
al w0 p39 ;
la w0 x3+f21 ;
se w0 p31 ; if state.type=th uden mcl then
jl. i1. ;
al w1 0 ; direct(0);
jl. w3 (r190.) ;
al w1 0 ;
jl. i3. ; else
i1: jl. w3 (r194.) ; run_mcl;
i2: al w1 17 ; end_th: result:=17;
c.a88<3
rs. w3 6 ; *** test no 161 **********************
\f
;. tas 1.0 14.05.87 terminal handler thtxt ...145...
jl. w3 (r202.) ; w0 w2
h. 161 , 1<8 w. ; w1 result w3
0 ;
z.
jl. i3. ; goto x;
g160: rl w1 0 ; error_return_1: result:=w0+13;
al w1 x1+13 ; goto write_err;
c.a88<3
rs. w3 6 ; *** test no 162 ***************
jl. w3 (r202.) ; w0 w2
h. 162 , 1<8 w. ; w1 result w3
0 ;
z.
jl. i4. ;
g162: rl w1 0 ; error_return_3; result:=w0;
c.a88<3
rs. w3 6 ; *** test no 164 ***************
jl. w3 (r202.) ; w0 w2
h. 164 , 1<8 w. ; w1 result w3
0 ;
z.
i4: rl. w3 (r180.) ;
rl w0 x3+f21 ;
lo. w0 j1. ; state.finies:=1;
rs w0 x3+f21 ;
rl w2 x3+q62 ;
rl w0 x2+f107 ; tpda:=tbuf.tdescr.tpda;
jl. w3 (r188.) ; write_error(result,tpda);
al w1 0 ;
i3: jl. w2 (r183.) ; x: terminate_th(w1);
j1: p14 ; state.finis
e.
c.-1
l13:
z.
e. ; end th coroutine
▶EOF◀