DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦1ba15449b⟧ TextFile

    Length: 36864 (0x9000)
    Types: TextFile
    Names: »rmtxt       «

Derivation

└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
    └─⟦39138f30b⟧ 
        └─⟦this⟧ »rmtxt       « 

TextFile

\f

;  tas 1.0 14.05.87     receive message coroutine     rmtxt     ...1...


;********************************************************************
;*******************  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
;;
\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

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 tas)
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 tascat 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  , 0    w.  ; connect_terminal
                         ; 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;
;ks -700
      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;
;ks -701
      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, j20             ;
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                ; 

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     ;  tas 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=tasterm then
      jl.     i19.       ;    begin
      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       ;    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 <> tas 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 <> tas 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 <> tas 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 <> tas 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 <> tas 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 <> tas 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.     i20.       ;  begin
      se  w1  1<2        ;    if receiver <> tas 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;

; 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;
      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◀