|
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: 41472 (0xa200)
Types: TextFile
Names: »rmtxt «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦40b1eb8cd⟧
└─⟦this⟧ »rmtxt «
\f
; tas 1.0 14.05.87 receive message coroutine rmtxt ...1...
; @(#)rmtxt 1.4 (RC International) 8/13/90
;
;********************************************************************
;******************* RECEIVE MESSAGE COROUTINE ********************
;********************************************************************
;
; Terminal access system for rc8000 - A/S Regnecentralen
; Erik Poulsen
; Revisions historie
;
; 87.01.15 release til betatest
;
; 87.02.25 side 20 : regret remove message (opcode=-2) hørende til pool
; før der sendes svar på remove pool message
;
; 87.04.06 side 8 : ret så attention ikke kommer til th uden mcl
;
; 87.05.14 release 1.0
;
; 88.01.08 side 4 letter til th sendes ikke hvis th.state.finis = 1
;
; 88.01.14 side 4 brug ikke w0, fy
;
; 88.02.11 side 6 hvis attention message fra fpmain når terminal link
; fjernes, så sendes remove letter til th
; 88.02.25 side 8 ret til nyt format af state.type (f21)
; side 8 hvis att message med create=1 til th sendes letter til th
; med opcode=2 (remove_th) hvis th.state.term_removed=0
; og med opcode=0 (attention) hvis th.state.term_removed=0
; 88.03.17 release 1.2
;
; 88.05.20 side 4 send ikke letter til th hvis th kører system menu
;
; 88.05.24 side 6 indsæt test på terminal er fjernet med ! ved link remove
; attention message
;
; 88.05.24 nyt forsøg på release 1.2
;
; 88.05.27 side 18 test for negativ tpda i write text buffer message
;
; 88.05.27 release 1.2
;
; 88.08.02 side 6 Session blev ikke fjernet efter CtrlØ fra terminal,
; pga forkert test på tpda, nu bliver den det.
;
; 89.02.27 side 10-12 ph.state.tem sættes til 1 hvis tem er pseudo proces
; for poolen
;
; 90.08.09 side 19 Ny message til stop og flush testoutput, samt dump af
; processen i <:menudump:>.
; message: +0: 20<12 + 0
; +2: 0
; +4: 101043
;
; 90.08.10 side 21 Indsat test af tpda i lookup_terminal, giver break 0
; hvis tpda = 0
;
; temp testpunkter (600 - 601)
; brugt
;
;;
\f
; tas 1.0 14.05.87 rcmenu rmtxt ...2...
;
; Coroutinen består af følgende procedure
;
; side
; d1 letter_to_th 3
; d2 search_ph 3
; d3 att_message 4
; d4 create_ph 6
; u30 coroutine code 10
\f
; tas 1.0 14.05.87 receive message coroutine rmtxt ...3...
b. d40,r50,c10 ; begin receive message coroutine
w.
m.receive message rmtxt 1.4
c.-1
l18:
z.
; extern variable, indeholder adresser på variable og routiner
u11:
r0: h. m24 , r1. w. ; ref curco, current coroutine
r1: h. m14 , r2. w. ; wait_letter
r2: h. m12 , r3. w. ; send_letter
r3: h. m91 , r4. w. ; search_th
r4: h. m122 , r5. w. ; first_ph
r5: h. m90 , r6. w. ; new_terminal
r6: h. m118 , r7. w. ; create_coroutine
r7: h. m92 , r8. w. ; put_in_session
r8: h. m2 , r9. w. ; start_coroutine
r9: h. m66 , r10. w. ; used_tdescr
r10: h. m65 , r11. w. ; tdescr_pool
r11: h. m22 , r12. w. ; release_buffer
r12: h. m11 , r13. w. ; wait_semaphor
r13: h. m68 , r14. w. ; cdescr_pool
r14: h. m46 , r15. w. ; link
r15: h. m69 , r16. w. ; create_link
r16: h. m70 , r17. w. ; remove_link
r17: h. m98 , r18. w. ; link_ph
r18: h. m129 , r19. w. ; start ph coroutine code
r19: h. m127 , r20. w. ; start th coroutine code
r20: h. m28 , r21. w. ; message event descr addr (mes til menu)
r21: h. m19 , r22. w. ; init mailbox
r22: h. m11 , r23. w. ; wait_semaphor
r23: h. m162 , r24. w. ; std seg i link spool area
r24: h. m18 , r25. w. ; init semaphor
r25: h. m167 , r26. w. ; name base for ps processer
r26: h. m170 , r27. w. ; <:tem:>
r27: h. m171 , r28. w. ; pda for tas processen
r28: h. m173 , r29. w. ; write_error
r29: h. m176 , r30. w. ; testout register
r30: h. m174 , r31. w. ; systxt pool addr
r31: h. m120 , r32. w. ; get buffer
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...4...
r32: h. m175 , r33. w. ; hw i text delen af systxt buffer
r33: h. m177 , r34. w. ; pda for ps processen tem
r34: h. m178 , 1 w. ; get_mess_ext
r35: h. m231 , 1 w. ; max pools efter c.p. message
r36: h. m255 , 1 w. ; send message til remoter
r37: h. m261 , 1 w. ; connect_terminal
r38: h. m0 , 1 w. ; testout
r39: h. m1 , 1 w. ; outblock
r40: h. m44 , 1 w. ; testoutput inactive
r41: h. m34 , 1 w. ; testoutput doc. name
r42: h. m168 , 1 w. ; name base for spool/test area
r43: h. m167 , 1 w. ; max name base
r44: h. m37 , 1 w. ; first of process
r45: h. m43 , 1 w. ; testbuffer descriptor 2
r46: h. m31 , 0 w. ; c15 own pda
; end initlist
; globale variabel
c0: 0,r.5 ; <:tem:>
; procedure letter_to_th(th,opcode);
;
; th (call) cda for th
; opcode (call) opcode i letter
;
; sender et letter med en given opcode til en terminal handler
;
; call return
; w0: opcode undef.
; w1: th undef.
; w2: undef.
; w3: return curco
b. i5,j5 w.
d1: rs. w3 j0. ; save return;
c.a88<5
rs. w3 6 ;
jl. w3 (r29.) ; testout_registers
h. 181 , 1<5 w. ; test_no 181, mask = 1<5
0 ;
z.
rl w2 x1+f21 ; if th.state.finis = 1 then
sz. w2 (j2.) ; return;
jl x3 ;
sz. w2 (j3.) ; if th.state.no_sys_menu=1 then
jl x3 ; return;
am (x1+q62) ; if th.tbuf.tdescr.cth <> 0 then
rl w2 f116 ; /* en sys menu i gang */
se w2 0 ; return;
jl x3 ;
rl. w3 (r0.) ;
rs w0 x3+q12 ; let.opcode:=opcode;
al w0 x3+q14 ;
rs w0 x3+q11 ; let.sem:=a_sem;
rl. w0 j1. ;
rs w0 x3+q10 ; let.type:= 1 shift 12;
al w2 x1+f22 ;
al w1 x3+q9 ;
jl. w3 (r2.) ; send_letter(th.main_mbx,letter);
al w2 x3+q14 ;
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...5...
jl. w3 (r12.) ; wait_semaphor(a_sem);
jl. (j0.) ; return;
j0: 0 ; saved return
j1: 1<12 ;
j2: p14 ; th.state.finis
j3: p18 ; th.state.no_sys_menu
e.
; procedure search_ph(owner,pool_name,ph);
;
; owner (call) pda for ejer af pool
; pool_name (call) peger til pool navn
; ph (return) cda for pool handler, eller 0
;
; søger efter en pool handler med en given ejer og et givet navn
;
; call return
; w0: undef.
; w1: owner unch.
; w2: pool_name ph
; w3: return curco
b. i5,j5 w.
d2: rs. w3 j0. ; save return;
rs. w1 j1. ; save owner;
al w3 x2 ;
jd 1<11+4 ; process_description(pda,pool_name);
rs. w0 j2. ;
rl. w3 (r0.) ;
rl w2 0 ;
sn w2 0 ; if pda=0 then
jl. i2. ; goto ret;
rl. w2 (r4.) ; ph:=first_ph;
jl. 4 ;
i1: rl w2 x2+q2 ;
sn w2 0 ; while ph<>0 do
jl. i2. ; begin
rl w0 x2+q0 ; if ph.owner=owner
rl w1 x2+q1 ; and ph.pool=pda then
sn. w0 (j2.) ; goto fin;
se. w1 (j1.) ; ph:=ph.next_ph;
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...6...
jl. i1. ; end;
i2: rl. w1 j1. ; fin: restore w1;
c.a88<5
rs. w3 6 ;
jl. w3 (r29.) ; testout_registers
h. 182 , 1<5 w. ; test_no 182, mask = 1<5
0 ;
z.
jl. (j0.) ; return;
j0: 0 ; saved return
j1: 0 ; owner
j2: 0 ; pda
e.
; procedure att_message(mes_buf);
;
; mes_buf (call) attention message buffer addr
;
; i denn procedure behandles att message til processen
;
; call return
; w0: undef.
; w1: undef.
; w2: mes_buf undef.
; w3: return undef.
b. i11,j11 w.
d3: ds. w3 j1. ; save return,mes_buf;
rl w0 x2+10 ; create:=mes_buf.create;
rs. w0 j2. ; io_return:=mes_buf.io_return;
se w0 2 ; if terminal link removed then
jl. i8. ; begin
al w2 x2+12 ; tpda := buf addr + 12; navn i buffer som i pd
jl. w3 (r3.) ; search_th(tpda,th);
sn w1 0 ; if th = 0 then return;
jl. (j1.) ;
am (x1+q62) ; if th.tbuf.tdescr.tpda < 1 then begin
rl w0 f107 ; /* terminal har været fjernet med !disconnect*/
sh w0 0 ; return;
jl. (j1.) ; /* send remove lettter til th */
al w0 2 ; letter_to_th(th,2);
jl. w3 d1. ; return;
jl. (j1.) ; end;
i8: rl w2 x2+6 ;
sh w2 0 ; if sender<0 then return;
jl x3 ; /* message regretted */
rs. w2 j3. ; tpda:=mes_buf.sender;
rl w0 x2 ;
se w0 0 ; if sender er internal process then
jl. i4. ; begin
rl. w3 (r0.) ; w3:=curco;
al w0 3 ; result:=3;
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...7...
rs w0 x3+q103 ; return;
jl. (j1.) ; end;
i4: jl. w3 (r3.) ; search_th(tpda,th);
se w1 0 ; if th=0 then
jl. i2. ; begin /* ingen ejer af terminal */
al w0 1 ;
jl. w3 (r5.) ; new_terminal(tpda,tdescr,1);
sn w1 0 ; if tdescr=0 then
jl. i5. ; goto err;
rs. w1 j4. ;
jl. w3 (r6.) ; create_coroutine(th);
sn w1 0 ; if th<>0 then
jl. i1. ; begin
rs. w1 j5. ;
rl. w0 j7. ; th.state:=signon + th_med_mcl + no_sys_menu;
rl. w2 j2. ; if create=1 then
sz w2 2.01 ; th.state:=th.state + link created;
lo. w0 j10. ;
rs w0 x1+f21 ;
rl. w1 j4. ;
rl. w2 j5. ;
jl. w3 (r7.) ; put_in_session(tdescr,th);
rs w2 x1+f103 ; tdescr.cur_th:=th;
al w0 a25 ; start_coroutine(prio,ic,th);
rl. w1 r19. ;
jl. w3 (r8.) ;
al w2 x2+f26 ;
jl. w3 (r22.) ; wait_semaphor(th.stop_sem);
jl. (j1.) ; return;
; end;
i1: rl. w1 j4. ; /* frigiv tdescr */
rl w1 x1+f101 ;
rs. w1 (r9.) ; used_tdescr:=tdescr.next;
rl. w2 (r10.) ;
rl. w1 j4. ;
jl. w3 (r11.) ; release_buffer(tdescr_pool,tdescr);
am -1 ; error_no:=18;
i5: al w1 19 ; err: error_no:=19;
i6: rl. w0 j3. ; err1: w0:=tpda;
jl. w3 (r28.) ; write_error(tpda,error_no);
rl. w2 j3. ;
al. w3 j8. ;
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...8...
dl w1 x2+4 ; flyt navn på terminal til lokal var.
ds w1 x3+2 ;
dl w1 x2+8 ;
ds w1 x3+6 ;
jd 1<11+64 ; remove process(name);
rl. w3 (r0.) ;
jl. (j1.) ; return;
; end;
i2: al w0 p39 ; if th.state.type = th oprettet fra ph then
la w0 x1+f21 ; return;
sn w0 p31 ;
jl. (j1.) ;
rl w0 x1+f21 ;
sz. w0 (j9.) ; if th.state.no_sys_menu=1 then
jl. (j1.) ; return;
am (x1+q62) ; if th.tbuf.tdescr.cth <> 0 then
rl w0 f116 ; /* en sys menu i gang */
se w0 0 ; return;
jl. (j1.) ;
i7: rl. w0 j2. ;
so w0 2.01 ; if create=1 then begin
jl. i3. ; /* nyt 8000 link oprettet */
am (x1+q62) ;
rl w0 f107 ; if th.tbuf.tdescr.tpda < 1 then begin
sl w0 1 ; /* terminal har været fjernet med !disconnect*/
jl. i9. ; connect_terminal(th, tpda);
rl. w2 j3. ; opcode:=4; /* start th */
jl. w3 (r37.) ; end
am 2 ; else opcode=2 /* remove */
i9: al w0 2 ; letter_to_th(th,opcode);
jl. w3 d1. ; return;
jl. (j1.) ; end;
i3: am (x1+q62) ;
al w3 f108 ;
jd 1<11+8 ; reserve_process(th.tbuf.tdescr.name);
am (x1+q62) ;
rl w0 f107 ; if th.tbuf.tdescr.tpda < 1 then begin
sl w0 1 ; /* terminal har været fjernet med !disconnect*/
jl. i10. ; connect_terminal(th, tpda);
rs. w1 j5. ;
rl. w2 j3. ;
jl. w3 (r37.) ;
al w0 4 ; letter_to_th(th,4);
jl. w3 d1. ; return;
rl. w1 j5. ; end;
jl. (j1.) ;
i10: rl. w0 j2. ;
sz w0 2.100 ; if io_return = 0 then
jl. (j1.) ; begin
rl w0 x1+f21 ;
sz. w0 (j6.) ; if th.state.finis = 0 then
jl. (j1.) ; begin
al w2 x1+f22 ;
rl. w3 (r0.) ;
al w1 x3+q31 ; send_letter(th.main_mbx,th_att);
jl. w3 (r2.) ; wait_semaphor(a_sem);
al w2 x3+q14 ; end;
jl. w3 (r12.) ; end;
jl. (j1.) ; return;
j0: 0 ; mes_buf
j1: 0 ; return
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...9...
j2: 0 ; create,io_return
j3: 0 ; tpda
j4: 0 ; tdescr
j5: 0 ; th
j6: p14 ;
j7: p32+p13+p18 ; startup værdi af th.state
j8: 0,r.4 ; name
j9: p18 ; state.no_sys_menu
j10: p20 ; state.link created
j11: p3 ; state.term_removed
e.
; procedure create_ph(owner,pool_name);
;
; owner (call) pda for ejer af pool
; pool_name (call) peger til navn på poolens pseudo process
;
; operetter en pool handler coroutine
;
; call return
; w0: undef.
; w1: owner undef.
; w2: pool_name undef.
; w3: return curco
b. i15,j15 w.
d4: rs. w3 j0. ; save return
ds. w2 j2. ; save owner,pool name;
dl w1 x2+2 ;
sn. w0 (c0.) ;
se. w1 (c0.+2) ; if pool_name=<:tem:> then
am -(:p7:) ; tem_ps:=p7
al w0 p7 ; else tem_ps:=0;
rs. w0 j3. ;
jl. w3 (r6.) ; create_coroutine(ph);
se w1 0 ; if ph=0 then
jl. i1. ; begin
rl. w0 j9. ; ans.status:=ikke resourcer
al w1 18 ; ans.error:=-cdescr
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...10...
ds w1 x3+q8+2 ; return;
jl. (j0.) ; end;
i1: rs. w1 j6. ; /* init ph coroutine beskrivelse*/
rl. w2 j1. ;
rs w2 x1+q1 ; ph.owner:=owner;
dl w0 x2+4 ; ph.owner_name:=
ds w0 x1+q20+2 ; owner_name;
dl w0 x2+8 ;
ds w0 x1+q20+6 ;
rl. w0 j3. ;
se w0 p7 ; if tem_ps=p7 then begin
jl. i4. ; /* tem ps for pool */
rl. w0 j1. ;
rl. w3 (r0.) ;
al w2 x3+q2-4 ; p:=addr temdescr.next;
rs. w2 j7. ; stp:=p;
i2: rl w2 x2 ; rep: p:=p.next;
sn. w2 (j7.) ; if p<>stp then
jl. i3. ; goto e;
se w0 (x2+4) ; if p.sender<>owner then
jl. i2. ; goto rep;
rl. w1 j6. ; /* findes allerede, fejl */
rl. w2 (r13.) ;
jl. w3 (r11.) ; release_buffer(cdescr_pool,ph);
rl. w0 j12. ; ans.status:=localid ikke entydig
rs w0 x3+q8 ;
jl. (j0.) ; return;
i3: al w1 x3+q2-4 ; e: /* sæt ph i kæden til termdescr */
rl. w2 j6. ; link(tdescr.next,ph.mdescr);
al w2 x2+q79-4 ;
jl. w3 (r14.) ;
rl. w1 j6. ;
rl. w0 j1. ; ph.mdescr.sender:=owner;
rs w0 x1+q79 ;
jl. i5. ; end
i4: rl. w1 j6. ; else
rl. w0 j8. ; ph.mdescr.proc:=1 shift 12 + 3;
rs w0 x1+q79 ;
i5: al w0 0 ; ph.mdescr.open1:=0;
rs w0 x1+q66 ; ph.mdescr.open2:=0;
al w0 x1+f22 ;
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...11...
rs w0 x1+q68 ; ph.mdescr.mbx:=ph.main_mbx;
; opret ph's modtager link
rl. w0 (r23.) ;
al w1 x1+q7 ;
jl. w3 (r15.) ; create_link(ph.link,std_seg,r);
sn w0 0 ; if r<>0 then
jl. i7. ; begin
i6: rl. w2 (r13.) ; R: /* link ikke oprettet */
rl. w1 j6. ; release_buffer(cdescr_pool,ph);
jl. w3 (r11.) ; ans.status:=mangler resourcer
al w1 14 ; ans.error:=mangler segmenter
rl. w0 j9. ; return;
ds w1 x3+q8+2 ; end;
jl. (j0.) ;
; sæt navn for pool
i7: rl. w1 j6. ;
rl. w2 j2. ;
dl w0 x2+2 ; ph.pool_name:=pool_name;
ds w0 x1+q60+2 ;
dl w0 x2+6 ;
ds w0 x1+q60+6 ;
rl. w0 j3. ; /* opret ps hvis den ikke er tem */
se w0 0 ;
jl. i9. ; if tem_ps=0 then begin
dl. w1 (r25.) ; /* ps navn ikke tem */
al. w3 j10. ; set_catalog_base(<::>,name base for ps);
jd 1<11+72 ;
se w0 0 ;
je -17 ; if result<>ok then fault;
rl. w1 j6. ;
al w2 x1+q79 ;
al w3 x1+q60 ; create_pseudo_process(
jd 1<11+80 ; ph.pool_name,ph.mdescr,r);
sn w0 0 ; if r<>0 then begin
jl. i8. ; remove_link(ph.link);
al w1 x1+q7 ;
jl. w3 (r16.) ; /* ps ikke oprettet */
rl. w2 (r13.) ; release_buffer(cdescr_pool,ph);
rl. w1 j6. ; ans.status:=ps kan ikke oprettes;
jl. w3 (r11.) ; return;
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...12...
rl. w0 j11. ; end;
ds w1 x3+q8+2 ; end;
jl. (j0.) ;
jl. i6. ;
i8: al w3 x1+q60 ; process_description(
jd 1<11+4 ; ph.pool,ph.pool_name);
sn w0 0 ; if ph.pool=0 then fault;
je -40 ; end
jl. i10. ; else
i9: rl. w3 (r0.) ; ph.pool:=pda_tem;
rl w0 x3+q100 ;
i10: rs w0 x1+q0 ;
jl. w3 (r17.) ; link_ph(ph);
rl. w2 j6. ;
al w0 p35 ; ph.state:=ph oprettet efter create pool message
wa. w0 j3. ; ph.state.tem:=tem_ps;
rs w0 x2+f21 ;
rl. w1 (r35.) ;
al w1 x1-1 ; en mere pool efter create pool
rs. w1 (r35.) ;
al w0 a35 ;
rl. w1 r18. ;
jl. w3 (r8.) ; start_coroutine(prio, ic, ph);
jl. (j0.) ; return;
j0: 0 ; return
j1: 0 ; owner
j2: 0 ; pool_name addr
j3: 0 ; tem_ps
j6: 0 ; ph
j7: 0 ; stp
j8: 1<12+3 ;
j9: p45 ;
j10: 0 ; <::>
j11: p50 ;
j12: p49 ;
e.
; receive message coroutine code
b. i30, j30 ;
w.
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...13...
j1: 2<12 ; message til remoter
j2: <:remoter:>,0,0 ; navn på remoter
j3: 0,0,1<6,0,1 ; remove letter
j4: 0,r.4 ; pool_name
j5: p17 ; state.reserve_term
j6: p4+p5 ; state.stty + state.mtty
j7: p7 ; state.direct
j8: p48
j9: p47
j10: 0 ; <::>
j11: p50 ;
j12: 0 ; n
j13: 5<12 ;
j14: 1<12+8 ;
j15: 0,r.3 ; buf table
j16: 0 ; txt buf addr
j17: 0 ; mes buf addr
j18: p45 ;
j20: 0<12 + 1023
j21: 0,r.8 ; answer area
j22: 0 ; <::>
j23: 101043 ; magic i stop test message
j24: 0 ; antal segmenter til dump
j25: <:menudump:>,0,0 ; navn på dump område
j26: 5<12 ; dump message
0 ; first
j27: 0 ; last
0 ; segment no
j28: 0,r.10 ; tail
d5:
u30: rl. w1 r26. ; start rm coroutine:
dl w0 x1+2 ;
ds. w0 c0.+2 ; flyt navnet på tem til lokal variabel
dl w0 x1+6 ;
ds. w0 c0.+6 ;
dl. w1 (r25.) ; set_catalog_base(<::>,name base for ps);
al. w3 j10. ;
jd 1<11+72 ;
se w0 0 ; if result<>ok then fault;
je -17 ;
al. w3 c0. ;
rl. w1 (r0.) ;
al w2 x1+q2 ; create_pseudo_message(
jd 1<11+80 ; <:tem:>,tdescr,r);
se w0 0 ; if r<>0 then fault;
je -16 ;
jd 1<11+4 ; process_description(pda,<:tem:>);
rs w0 x1+q100 ; pda_tem:=pda
rs. w0 (r33.) ; gem pda i CL
al w0 x1+q22 ; menu mes eda := edescr;
rs. w0 (r20.) ;
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...14...
; init variable i cdescr
al w2 x1+q14 ;
al w0 0 ; init_semaphor(0,a_sem);
jl. w3 (r24.) ;
al w2 x1+f22 ;
jl. w3 (r21.) ; init_mailbox(main_mbx);
al w3 x1 ;
al w0 x3+q0 ;
rs w0 x3+q0 ; temdescr.prev:=
rs w0 x3+q1 ; temdescr.next:=addr temdescr.next;
al w0 x3+f22 ;
rs w0 x3+q2+4 ; temdescr.mbx:=main_mbx;
rs w0 x3+q22+4 ; edescr.mbx:=main_mbx;
al w0 x3+q14 ;
rs w0 x3+q31+6 ; th_att.sem:=a_sem;
al. w3 j2. ;
al. w1 j1. ;
c. a89<2 ; if send mess til remoter
m.send message to remoter
rl. w0 (r36.) ; if send message til remoter then
se w0 0 ;
jd 1<11+16 ; send_message(<:remoter:>,m,buf);
; /* svar kommer aldrig */
z.
; init de tre systxt buffere, hver har følgende format
;
; + 0: func - param til general copy
; + 2: first do.
; + 4: last do.
; + 6: rel do.
; + 8: 5<12 + 0 - output message
; + 10: first do.
; + 12: last do.
; + 14: text - tekst der skal skrives
; + 16: -
; + 18: -
al w2 0 ; n:=0;
i0: rs. w2 j12. ; rep:
rl. w2 (r30.) ;
jl. w3 (r31.) ; get_buffer(systxt pool,b);
am. (j12.) ;
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...15...
rs. w1 j15. ;
al w0 4 ; /* init param til g copy */
rs w0 x1 ; buf.param.func:=4;
al w2 x1+14 ;
al w3 x2 ; buf.param.first:=buf+14;
wa. w3 (r32.) ;
al w3 x3-2 ; buf.param.last:=buf+14+hw-2;
ds w3 x1+4 ;
al w0 0 ;
rs w0 x1+6 ; buf.param.rel:=0;
ds w3 x1+12 ; /* init output message */
rl. w0 j13. ;
rs w0 x1+8 ;
rl. w2 j12. ;
al w2 x2+2 ; n:=n+2;
se w2 6 ; if n<>6 then
jl. i0. ; goto rep;
i1: rl. w3 (r0.) ; Next_mess:
al w0 1 ;
rs w0 x3+q2+2 ; temdescr.open:=1;
rs w0 x3+q22+2 ; edescr.open:=1;
al w0 0 ;
al w1 1<2+1<3 ;
al w2 x3+f22 ; wait_letter( main_mbx,
jl. w3 (r1.) ; 1<2+1<3, 0, letter);
rl w2 x1+6 ;
rs w2 x3+q101 ; buf:=letter.buf;
al w0 1 ;
rs w0 x3+q103 ; result:=1;
al w0 0 ;
rs w0 x3+q8 ; ans.status:=0;
zl w0 x2+9 ;
sn w0 0 ; if buf.mode<>0 then
jl. i2. ; begin
al w0 3 ; result:=3;
rs w0 x3+q103 ; goto Send_Ans;
jl. i16. ; end;
i2: rl w1 x1+4 ; receiver:=letter.type;
zl w0 x2+8 ; op=buf.opcode;
sn w0 0 ; if op<>0 then begin
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...16...
jl. i19. ;
se w1 1<2 ; if receiver=menu then
jl. i19. ; begin
zl w0 x2+8 ; if buf.opcode=20 /* stop test */ then
sn w0 20 ; goto S;
jl. i19. ;
rl w0 x2+6 ;
am. (r27.) ;
sn w0 (0) ; if sender<>tas then begin
jl. i19. ; result:=3;
al w0 3 ; goto Send_Ans;
rs w0 x3+q103 ; end;
jl. i16. ; end;
i19: zl w0 x2+8 ; S: op:=buf.opcode;
; end;
c.a88<5
rs. w3 6 ;
jl. w3 (r29.) ; registers testout
h. 183 , 1<4 w. ; test_no 183, mask = 1<4
0 ;
z.
; attention message
se w0 0 ; if op=0 then
jl. i3. ; begin
se w1 1<2 ; if receiver <> menu then
jl. i15. ; goto R3; /* send answer med result 3 */
jl. w3 d3. ; at_mess(buf);
rl. w3 (r0.) ;
jl. i16. ; goto Send_Ans;
; end;
; remove terminal handler
i3: se w0 10 ; if op=10 then
jl. i4. ; begin
se w1 1<2 ; if receiver <> menu then
jl. i15. ; goto R3; /* send answer med result 3 */
al w0 2 ;
rl w1 x2+10 ; letter_to_th(buf.cda,2);
jl. w3 d1. ; goto Send_Ans;
jl. i16. ; end;
; sæt text buffer
i4: se w0 11 ; if op=11 then
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...17...
jl. i17. ; begin
se w1 1<2 ; if receiver <> menu then
jl. i15. ; goto R3; /* send answer med result 3 */
rl w1 x2+14 ; buf_no:=buf.buf_no
sh w1 3 ; if buf_no>3
sh w1 0 ; or buf_no<1 then
jl. i15. ; goto R3;
al w1 x1-1 ;
ls w1 1 ;
am. j15. ;
rl w1 x1 ; txt_buf:=buf_table(buf_no);
rs. w1 j16. ;
jd 1<11+84 ; general copy(buf,txt_buf, r);
se w0 0 ; if r<>ok then goto R3;
jl. i15. ;
ds w1 x3+q8+2 ; sæt answer
rl. w2 j16. ; w2 := txt buf addr
wa w1 x2+10 ; txt_buf.last :=
al w1 x1-2 ;
rs w1 x2+12 ; txt_buf.first+hw moved-2/* sær io message */
jl. i16. ; end;
; read th status
i17: se w0 12 ; if op=12 then
jl. i8. ; begin
se w1 1<2 ; if receiver <> menu then
jl. i15. ; goto R3; /* send answer med result 3 */
rl w2 x2+10 ; th:=buf.cda;
rl w0 x2+f21 ;
sz. w0 (j6.) ; if th.state.stty=1 or
jl. i6. ; th.state.mtty=1 then
al w0 0 ; begin
al w1 0 ; ans(2):=th.ph.pool;
jl. i7. ; ans(4):=th.ph.owner;
i6: rl w1 x2+q5 ; end
rl w0 x1+q0 ; else
rl w1 x1+q1 ; ans(2):=ans(4):=0;
i7: ds w1 x3+q8+4 ;
al w1 0 ; w:=0;
rl w0 x2+f26+4 ; if th.stop_sem.value>=0 then
sh w0 -1 ; w:=2;
al w1 2 ;
rl w0 x2+f21 ; if th.state.direct=1 then
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...18...
sz. w0 (j7.) ; w:=w+1;
al w1 x1+1 ;
rs w1 x3+q8+6 ; ans(6):=w;
dl w1 x2+q61+2 ; ans(8,10):=th.s_name;
ds w1 x3+q8+10 ; goto Send_Ans;
jl. i16. ; end;
; STOP SYSTEM MESSAGE
i8: se w0 14 ; if op=14 then
jl. i21. ; begin
se w1 1<2 ; if receiver <> menu then
jl. i15. ; goto R3; /* send answer med result 3 */
je -100 ; stop
; write text buffer
i21: se w0 16 ; if op=16 then
jl. i23. ; begin
se w1 1<2 ; if receiver <> menu then
jl. i15. ; goto R3; /* send answer med result 3 */
rl w1 x2+10 ;
sh w1 3 ; buf_no:=buf.buf_no;
sh w1 0 ; if buf_no>3 or buf_no<1 then
jl. i15. ; goto R3;
al w1 x1-1 ;
ls w1 1 ;
am. j15. ; txt_buf:_buf table(buf_no);
rl w1 x1 ;
rs. w1 j16. ;
rs. w2 j17. ;
rl w2 x2+12 ;
sh w2 0 ; if tpda<0 then
jl. i22. ; goto dummy_answer; /* terminal disconnected */
jl. w3 (r3.) ; search_th(tpda,th);
sn w1 0 ; if ikke fundet then
jl. i15. ; goto R3;
rl w0 x1+f21 ;
sz. w0 (j5.) ; if th.state.reserve_term=0 then
jl. i22. ; begin
jl. w3 (r34.) ; get mess ext(ext);
sn w2 0 ; if ingen ext then
jl. i15. ; goto R3;
rl. w0 j14. ;
rs w0 x2 ; eda.open:=1, type:=8 /* answer tas */
rl. w0 j17. ; eda.buf:=buf;
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...19...
rs w0 x2+2 ;
rl w1 x1+q62 ;
al w3 x1+f108 ; name:=th.tdescr.name;
rl. w1 j16. ;
al w1 x1+8 ; mes:=txt_buf.message;
jd 1<11+16 ; send_message(name,eda,mess,buf);
sn w2 0 ; if buf=0 then fault;
je -12 ; goto next_mess;
jl. i1. ; end;
i22: al w0 1 ;dummy_answer: ans.statue:=1;
rs w0 x3+q8 ; goto Send_Ans;
jl. i16. ; end;
; get stat message
i23: se w0 18 ; if op=18 then
jl. i25. ; begin
se w1 1<2 ; if receiver <> menu then
jl. i15. ; goto R3; /* send answer med result 3 */
al w0 1 ; result:=1;
rl. w1 r35. ; answer er variable i CL
jd 1<11+22 ; send answer(result, answer, buf);
jl. i1. ; goto Next_mess;
; end;
; dump testoutput buffer
i25: se w0 20 ; if op=20 then
jl. i20. ; begin
se w1 1<2 ; if receiver <> menu then
jl. i15. ; goto R3; /* send answer med result 3 */
dl w1 x2+12 ; test magic in message;
sn w0 0 ;
se. w1 (j23.) ;
jl. i15. ; not ok goto R3;
dl. w1 (r42.) ; /* set process catalog baser */
al. w3 j22. ; name = <::>
jd 1<11+72 ; set catalog base til maxbaser
; /* dump processen */
rl. w0 r44. ; w0:=first;
rl. w1 r45. ; w1:=testdescr testbuffer 2;
rl w1 x1+6 ; w1:=first test bufffer 2;
ds. w1 j27. ; gem first,last i message;
ws w1 0 ;
al w1 x1+510 ;
ls w1 -9 ; w1:=antal segmenter der skal være i dump;
rs. w1 j24. ;
al. w3 j25. ;
al. w1 j28. ; lookup entry(menudump,
jd 1<11+42 ; tail,result);
se w0 0 ; if unknown then
jl. i26. ; goto err; status = 4;
rl. w0 j28. ;
sh. w0 (j24.) ; if tail.size < segmenter i dump then
jl. i27. ; goto err: status = 3;
jd 1<11+92 ; create entry lock process(menudump);
jd 1<11+8 ; reserve process(menudump);
se w0 0 ; if result <> normal then
jl. i28. ; goto err; status = 2;
al. w1 j26. ;
jd 1<11+16 ; send message(output, menudump);
sn w2 0 ;
jl. i29. ; mangler message buffer, goto err; status = 1;
jd 1<11+18 ; wait answer;
jd 1<11+64 ; remove_process(menudump);
sn w0 0 ;
am -5 ;
am 1 ;
i26: am 1 ;
i27: am 1 ;
i28: am 1 ;
i29: al w0 1 ;
rl. w3 (r0.) ;
rs w0 x3+q8 ; ans(1):= status;
; /* stop testoutput */
rl. w0 j20. ; length:=0, type:=1023;
al. w1 j20. ; tail:=<empty>;
jl. w3 (r38.) ; testout;
jl. w3 (r39.) ; outblock;
al. w1 j21. ;
se w2 0 ; if buf > 0 then
jd 1<11+18 ; wait answer(buf,answer,result);
al w0 1 ; result:=1;
rs. w0 (r40.) ; testoutput inactive.
rl. w3 r41. ;
jd 1<11+64 ; remove_process(testoutput doc. name);
dl. w1 (r43.) ; /* set process catalog baser */
al. w3 j22. ; name = <::>
jd 1<11+72 ; set catalog base
jl. i16. ; goto Send_Ans;
; end;
; create pool
i20: se w0 90 ; if op=90 then
jl. i9. ; begin
se w1 1<3 ; if receiver <> tem then
jl. i15. ; goto R3; /* send answer med result 3 */
rl. w1 (r35.) ;
se w1 0 ; if create pools messages = 0 then
jl. i24. ; ans.status:=ressource mangel;
rl. w0 j18. ; ans.error:=0
al w1 21 ;
ds w1 x3+q8+2 ; goto Send_ans;
jl. i16. ; end;
i24: dl w1 x2+18 ; pool_name:=
ds. w1 j4.+2 ; buf.pool_name;
dl w1 x2+22 ;
ds. w1 j4.+6 ;
rl w1 x2+6 ;
al. w2 j4. ; search_ph(buf.sender,
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...20...
jl. w3 d2. ; pool_name,ph);
sn w2 0 ; if ph<>0 then
jl. i18. ; begin
rl. w0 j11. ; ans.status:= pool finde allerede
rs w0 x3+q8 ; goto Send_Ans;
jl. i16. ; end;
i18: al. w2 j4. ; create_ph(buf.sender,
jl. w3 d4. ; pool_name);
jl. i16. ; goto Send_Ans;
; end;
; remove pool
i9: se w0 92 ; if op=92 then
jl. i11. ; begin
se w1 1<3 ; if receiver <> tem then
jl. i15. ; goto R3; /* send answer med result 3 */
dl w1 x2+18 ; pool_name:=
ds. w1 j4.+2 ; buf.pool_name;
dl w1 x2+22 ;
ds. w1 j4.+6 ;
rl w1 x2+6 ;
al. w2 j4. ; search_ph(buf.sender,
jl. w3 d2. ; pool_name,ph);
sn w2 0 ; if ph<>0 then
jl. i10. ; begin
al w1 x2 ;
al w2 0 ; if ph.rem_buf<>0 then
rx w2 x1+q28 ; regret_message(ph.rem_buf);
se w2 0 ; ph.rem_buf:=0;
jd 1<11+82 ;
al w2 x1 ;
al. w1 j3. ; send_letter(ph.main_mbx,
al w2 x2+f22 ; remove_letter);
jl. w3 (r2.) ; end
jl. i16. ; else
i10: rl. w0 j8. ; ans.status:=findes ikke
rs w0 x3+q8 ; goto Send_Ans;
jl. i16. ; end;
; lookup pool
i11: se w0 94 ; if op=94 then
jl. i13. ; begin
se w1 1<3 ; if receiver <> tem then
jl. i15. ; goto R3; /* send answer med result 3 */
\f
;; tas 1.0 14.05.87 receive message coroutine rmtxt ...20a...
dl w1 x2+18 ; pool_name:=
ds. w1 j4.+2 ; buf.pool_name;
dl w1 x2+22 ;
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...21...
ds. w1 j4.+6 ;
rl w1 x2+6 ;
al. w2 j4. ; search_ph(buf.sender,
jl. w3 d2. ; pool_name,ph);
sn w2 0 ;
jl. i12. ; if ph<>0 then
al w2 x2+q7 ; begin
rl w0 x2+f78 ;
ws w0 x2+f73+4 ; ans(10):=ph.link.segments
rs w0 x3+q8+10 ; - ph.link.free_seg.value;
rl w0 x2+f73+4 ;
ls w0 9 ; ans(12):=
rs w0 x3+q8+12 ; ph.link.free_seg.value*512;
jl. i16. ; end
i12: rl. w0 j8. ; else ans.status:=findes ikke;
rs w0 x3+q8 ; goto Send_Ans;
jl. i16. ; end;
; lookup terminal
i13: se w0 106 ; if op=106 then
jl. i15. ; begin
se w1 1<3 ; if receiver <> tem then
jl. i15. ; goto R3; /* send answer med result 3 */
rl w2 x2+12 ; tpda:=buf.tpda;
sh w2 8 ; if tpda<8 then
jl. i15. ; goto R3;
rl. w1 (r46.) ;
rl w1 x1+96 ;
sl w2 x1 ; if tpda>current cpa then
jl. i15. ; goto R3;
rs w2 x3+q8+4 ; ans(4):=tpda;
jl. w3 (r3.) ; search_th(tpda,th);
sn w1 0 ; if th<>0 then
jl. i14. ; begin
rl w0 x1+q2 ;
rs w0 x3+q8+2 ; ans(2):=th.localid;
rl w0 x1+q1 ;
ls w0 12 ;
ea w0 x1+q4 ; ans(6):=th.max_buf shift 12 + th.max_timer;
rs w0 x3+q8+6 ;
rl w2 x1+q5 ;
rl w0 x2+q0 ;
rs w0 x3+q8+8 ; ans(8):=th.ph.pool;
al w1 x1+q7 ;
rl w0 x1+f78 ;
ws w0 x1+f73+4 ; ans(10):=th.link.segments
rs w0 x3+q8+10 ; - th.link.free_seg.value;
rl w0 x1+f73+4 ;
ls w0 9 ; ans(12):=
\f
;. tas 1.0 14.05.87 receive message coroutine rmtxt ...22...
rs w0 x3+q8+12 ; th.link.free_seg.value*512;
jl. i16. ; end
i14: rl. w0 j9. ; else ans.status:=findes ikke
rs w0 x3+q8 ; goto Send_Ans;
jl. i16. ; end;
i15: al w0 3 ; R3: /* ukendt opcode */
rl. w3 (r0.) ;
rs w0 x3+q103 ; result:=3;
i16: rl. w3 (r0.) ; Send_Ans:
rl w0 x3+q103 ;
al w1 x3+q8 ;
rl w2 x3+q101 ; send_answer(result,
jd 1<11+22 ; ans,buf);
jl. i1. ; goto Next_mess;
e.
c.-1
l19:
z.
e. ; end coroutine receive message
▶EOF◀