|
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: 39936 (0x9c00)
Types: TextFile
Names: »hcmt«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦this⟧ »hcmt«
b. a200,b100,c3,d41,h31 w.;
;.****************************************************************************
; MASTER
;*****************************************************************************
c0=-1 ; c0>0 for test and c0<0 for normal use of master
c1=-c0 ; c1>0 for normal use
c2=c1 ; c2>0 for rhmaster normal use
c3=-c2*c1 ; c3>0 for hcmaster normal use
;. format of message buffer
a40=-10 ; buffer state
a38= -8 ; receiver<12+sender (computer numbers)
a36= -6 ; process description addr for receiver other computer
a34= -4 ; - - - - sender - -
a32= -2 ; w2
a0 = 0 ; next buffer
a2 = 2 ; prev buffer
a4 = 4 ; receiver
a6 = 6 ; sender
; i-o (normal) i-o (other com) mon call
a8 = 8 ; message op<12 +mode 3<12 1<22+m_p_n
a10= 10 ; - first address first addr w0
a12= 12 ; - last address last addr w1
a14= 14 ; - 1. segment first addr(oc) w2
a16= 16 ; - comp no w3
a18= 18 ; - mbuf-id
a20= 20 ; answer: ip addr
a22= 22 ; - result
a49=a22-a40+2 ; buffer length
;
;. buffer state 0 normal message buffer
;; -1 copy buffer
; -2 mon call buffer
; -3 mirror buffer received from rhdriver
; -4 - - - - a proc at this computer
; (useal an answer)
; -5 address request(mbuf)
; -6 mbuf copy request
; -7 mbuf copy completed
; -8 mon call completed answer in receiver field
; -9 answer (buffer not transmitted)
; -10 a buffer containing a mbuf address
; -11 a child copy buffer
; -12 an answer mirror buf
; -13 a stop i. p. buff
;
a196=-16 ; real parent while master is parent
a194=-14 ; proc addr other computer
a192=-12 ; proc type
a190=-10 ; pda of master
a188=-8 ; computer number.reciever < 12 + computer number.sender
a134= 50 ; pda parent
;
;
;
\f
;. all information among mon call is contained in mbufs:
a56=-4 ; buffer address (to other computer)
a57=-2 ; mbuf state
a58=0 ; next mbuf
a59=2 ; prev mbuf
a60=4 ; buffer addr (this computer)
a61=6 ; 1<22 + mon call number
a62=8 ; saved w0
a63=10 ; w1
a64=12 ; w2
a65=14 ; w3
a66=16 ; name
a67=18 ;
a68=20 ;
a69=22 ;
a70=24 ; answer other computer
a71=26 ; proc addr
a72=28 ; parent name if no mirror parent exist
a73=36 ; proc addr of mirror parent (if exist)
a74=38 ; pda of mirror parent
a80=40 ; other information about the call
a99= 70 ; last mbuf
a100=a99-a56 +2 ; mbuf length
a101=a99-a61 ; copy length for mbuf
;
;. mbuf state = 0 free mbuf
;; 1 mon call not send to driver
; 2 mon call send to driver, no answer arrived
; 3 moncal send and an answer is arrived
; state>15 is moncall other computer
; 17 mbuf not received
; 18 mbuf received but not served
; 19 mbuf received and served but no answer is send
;
;
; contents of w1 area at create internal proc
; normal mirror
; 0 first addr first addr
; 2 last addr last addr
; 4 buf,area buf,area
; 6 internals internals
; 8 0 -8 (proc type)
; 10 max: upper max: upper
; 12 lower lower
; 14 std: upper std: upper
; 16 lower lower
;
m. hcmaster start
rl w3 66
\f
rs. w3 h0. ; own proc desr addr
dl w2 x3+24 ;
rs. w1 h11. ; start of proc
wa. w1 h22. ; start addr + program
ds. w2 h23. ;
bz w0 x3+28 ; w0:=int. claim
ls w0 4 ; make room for
wa w1 0 ; core table
rs. w1 h24. ; first of free core
ws w2 2 ; w2:=length of free core
rl. w1 h22. ; w1:=first of core table
rs w2 x1+2 ; save core length
rl. w0 h24. ;
rs w0 x1 ; first free
ld w0 -100 ;
al w1 x1+4 ;
ds w0 x1+2 ; clear core table
sh. w1 ( h24.) ;
jl. -6 ;
rl. w3 h14. ; al. w3 d41.
wa. w3 h11. ;
jd 1<11+0 ; set interrupt addr
al. w1 h30. ;
al. w2 h30. ;
ds w2 x2+2 ; mbuf head:=mbuf head
al. w1 h31. ;
al. w2 h31. ;
ds w2 x2+2 ; free mbuf head:=free mbufhead
jl. w3 d40. ; goto chain free mbuf
al w0 2 ;
jd 1<11+32; set own process descr addr in monitor
jd 1<11+28; set monitor mode
al w0 6 ;
rl. w3 h0. ; own pda
hs w0 x3+104 ; set interrupt level = 6<12+29
al. w3 h2. ;
jd 1<11+4 ; w0:=process descr addr(driver)
rs. w0 h1. ;
al. w3 h5. ;
jd 1<11+4 ; mirror
rl w1 0 ; address to w1
c. c0 ;
al w0 5 ;
rl. w3 h0. ;
ds w0 x1+a192 ; set pda o.c. and mirror type
z. ;
c. c1 ;
rs. w1 h6. ;
c. c3
al w3 5 ; w3:=mirror type
rl. w0 h0. ; w0:=pda master
ds w0 x1+a190 ;
al w2 0 ;
jd 1<11+126; get buf
rl. w3 h1. ; w3:=pda driver
ds w0 x2+a10 ; save pda mirror, pda master
rs w1 x2+a12 ; and pda mirror master in buf and
al w1 x2 ; save buffer address
al. w3 h2. ;
jd 1<11+34; move buf to driver
jd 1<11+24; wait event (answer)
se w2 x1 ; if not answer from master o.c. then
jl. -4 ; wait
rl. w1 h6. ; else
rl w0 x2+a16 ; set pda
rs w0 x1+a194 ; of master oc in mirror master proc
jd 1<11+26;
jd 1<11+126; release and remove buff
z.
z. ;
c. c2 ;
al w2 0 ;
jd 1<11+24; wait event (buffer from master o. c.)
rl w0 x2+a10 ; w0:=pda hcmaster
rs w0 x1+a194 ; save addr in rhmaster mirror
rl. w0 h0. ; pda master
rl. w3 h1. ; pda driver
ds w0 x2+a16 ; to buf
rs w1 x2+a18 ; pda master mirror this comp. to buf
al w0 -4 ;
rs w0 x2+a40 ; set buffer state to served mirrorbuf
al. w3 h2. ; and
jd 1<11+34; move buf to master
z.
\f
b0: al w2 0 ;
je. 2 ;
jd 1<11+24; wait event
jd. 2 ;
se w0 0 ; if answer then
jl. b20. ; goto b20
rl w0 x2+a40
sn w2 (x2) ; if buf is not removed
se w2 (x2+2) ; then
jd 1<11+26; get event (remove buff)
rs w0 x2+a40 ; !!! rl w0 x2+a40 ; w0:=buffer state
sn w0 0 ; if a normal buffer then
jl. b10. ; goto b10
sn w0 -2 ; if mon call this computer then
jl. b30. ; goto test mon-call
se w0 -1 ; if copy buffer or
sn w0 -4 ; served mirror buffer then
jl. b12. ; goto b12
sn w0 -3 ; if mirror buffer (from driver) then
jl. b35. ; goto b35 (move buffer to proc this computer)
sn w0 -5 ; if mbuf address request from other computer then
jl. b50. ; goto b50 else
sn w0 -7 ; if mbuf from other computer then
jl. b60. ; goto b60
sn w0 -8 ; if moncal completed (other computer) then
jl. b70. ; goto b70
sn w0 -9 ; if refused buffer (with error) then
jl. b20. ; goto b20
sn w0 -10 ; if mbuf address then
jl. b40. ;
sn w0 -11 ; if a child copy buf then
jl. b21. ; goto b21
; else (not possible)
; else message:
; move buf to driver
\f
b10: rl w1 x2+a4 ; w1:=receiver this computer (mirror proc)
sh w1 0 ;
ac w1 x1 ;
sh w1 10 ;
jl. b20. ; goto answer
rl w3 x1+a194 ; w3:=receiver other computer (real proc)
rs w3 x2+a36 ; to buf
bz w3 x1+a188 ; w3:=computer number other computer
hs w3 x2+a38 ; to buf
rl w3 x2+a6 ; w3:=sender this computer
rl w3 x3+a194 ; mirror.sender
rs w3 x2+a34 ; to buf
b12: al. w3 h2. ; w3:=driver
jd 1<11+34; move buf to driver
jl. b0. ; goto wait event
b20: rl w3 x2+a40 ; w3:=buffer type
se w3 -13 ; if stop ip buf then
jl. b22. ; goto b22
jl. w3 d6. ; search mbuf (in x1+a64)
jl. b89. ; not found goto b89 (remove buff)
rl w0 x1+a57 ; w0:=mbuf state
sl w0 8 ; if mon call other comp then
jl. b76. ; goto send answer other computer
am (x1+a60) ;
rs w2 +a14 ; set buff addr in saved w2.moncall buff
jl. b78. ;
b22: rl w1 x2+a6 ; w3:=sender
sn. w1 ( h0.) ; if sender=master then
jl. b85. ; goto remove buf and send answer
al w0 x1+2 ; w0:=name addr
jl. w3 d13. ; goto move name
jd 1<11+34; move buf to sender
jl. b0. ; and goto wait event
b21: al w0 -1 ; change buffer state
rs w0 x2+a40 ; to a normal copy buffer
jl. b12. ; and return it to driver
\f
b30: ; monitor call(this computer)
rl. w1 h31. ; w1:=first mbuf
sn. w1 h31. ; if no more mbufs then
jl. w3 b100. ; goto b100
rs. w1 h7. ; set current mbuf
rs w2 x1+a60 ; save buffer addr
jl. w3 d5. ; remove mbuf
al. w2 h30. ;
jl. w3 d4. ; insert mbuf
rl w2 x1+a60 ; w2:=buf
al w0 1 ;
rs w0 x1+a57 ; set mbuf state
rl w0 x2+a8 ;
al. w3 h20. ;
ws w3 2 ;
wd. w3 h19. ; compute mbuf-id
ba w3 0 ;
hs w3 0 ; and save it in mbuf
rs w0 x1+a61 ; 1<22+mon call number
dl w0 x2+a12 ;
ds w0 x1+a63 ; move saved w0,w1
dl w0 x2+a16 ;
ds w0 x1+a65 ; move saved w2,w3
rl w3 x2+a16 ; w3:=saved w3
rl w0 x3+0 ;
rs w0 x1+a66 ; move name
rl w0 x3+2 ;
rs w0 x1+a67 ;
rl w0 x3+4 ;
rs w0 x1+a68 ;
rl w0 x3+6 ;
rs w0 x1+a69 ;
rl w3 x2+a6 ; w3:=sender
sh w3 0 ;
ac w3 x3 ; w3:=sender = parent
rs w3 x1+a74 ; save pda of calling proc
rl w0 x3+a194 ; w0:=parent mirror pda if it exist
rs w0 x1+a73 ;
se w0 0 ; if parent.mirror already exist then
jl. b33. ; goto b33
rl w0 x3+2 ; else move parent name to mbuf
rs w0 x1+a72+0 ;
rl w0 x3+4 ;
rs w0 x1+a72+2 ;
rl w0 x3+6 ;
rs w0 x1+a72+4 ;
rl w0 x3+8 ;
rs w0 x1+a72+6 ;
b33: ;
bz w0 x2+a8+1 ; w0:=mon call number
se w0 62 ; if modify or
sn w0 56 ; create internal proc then
jl. b31. ; goto move param
jl. b32. ; else goto move mbuf
\f
b31: rl w3 x2+a12 ; w3:=saved w1
rl w0 x3+0 ; move w1 area to mbuf
rs w0 x1+a80+0 ;
rl w0 x3+2 ;
rs w0 x1+a80+2 ;
rl w0 x3+4 ;
rs w0 x1+a80+4 ;
rl w0 x3+6 ;
rs w0 x1+a80+6 ;
rl w0 x3+8 ;
rs w0 x1+a80+8 ;
rl w0 x3+10 ;
rs w0 x1+a80+10 ;
rl w0 x3+12 ;
rs w0 x1+a80+12 ;
rl w0 x3+14 ;
rs w0 x1+a80+14 ;
rl w0 x3+16 ;
rs w0 x1+a80+16 ;
bz w0 x2+a8+1 ; w0:=mon call number
se w0 56 ; if not create internal proc then
jl. b32. ; goto b32
al w0 -8 ; else create internal mirror proc
rs w0 x1+a80+8 ;
al w3 x1+a66 ; w3:=name addr
al w1 x1+a80 ; w1:=param addr
jd 1<11+56; create
se w0 0 ; if not created then
jl. b77. ; send answer
jd 1<11+4 ; else mirror proc addr
rl. w1 h7. ; w1:=current mbuf
rs w0 x1+a71 ; save mirror proc addr
rl w2 0 ; w2:=pda of mirror proc
al w3 5 ; w3:=type.mirror
rl. w0 h0. ; w0:=master pda
ds w0 x2+a190 ; proc.type:=mirror
b32: al w2 0 ;
jd 1<11+126; get an empty buffer
rs w2 x1+a56 ; save buffer addr
al w3 x1+a61 ; w3:=first of mbuf contents
al w0 x3+a101 ; w0:=last of mbuf
ds w0 x2+a12 ;
al w0 5 ;
ls w0 12 ;
rs w0 x2+a8 ; save output mess
al w0 -5 ;
rs w0 x2+a40 ;
rl w0 x1+a61 ; mbuf-if to
rs w0 x2+a18 ; buffer
al. w3 h2. ; name
jd 1<11+34; move message to rhmaster(address request)
jl. b0. ; and goto wait event
\f
b35: ; move mirror buffer to proc at this computer
al w0 -4 ; change buffer state to moved mirror buf
rs w0 x2+a40 ;
rl w1 x2+a4 ; w0:=receiver
sh w1 0 ;
ac w1 x1 ;
sn. w1 ( h0.) ; if rec. = master then
jl. b49. ;
b36: al w0 x1+2 ;
jl. w3 d13. ; goto move name
jd 1<11+34; move buffer
se w0 0 ; if not receiver error then
jl. b0. ; goto next event
al w0 5 ;
rs w0 x2+a4 ; send answer
jl. b12. ;to sender other computer
b40: ; answer to this proc:
jl. w3 d8. ; search matching mbuf
jl. b0. ; not found: goto b0 (impossible ?)
rl w0 x1+a57 ; w0:=mbuf state
se w0 1 ; if not waiting for mbuf address other computer then
jl. b48. ; goto b48
al w0 2 ;
rs w0 x1+a57 ; mbuf state:=2
al w0 -6 ;
rs w0 x2+a40 ; buffer state:=
al. w3 h2. ; move message to
jd 1<11+34; to rhdriver
jl. b0. ; and goto next event
b48: se w0 19 ; if not served mbuf then
jl. w3 b81. ; goto return buf
rl w2 x1+a60 ; w2:=buf
jl. b68. ; and goto complete the mon call stop ip
b49: ;
rl w1 x2+a6 ; w1:=sender
rl w0 x1+a192 ; w0:=proc type
se w0 5 ; if not mirror proc then
jl. b36. ; goto b36
al w0 x2+a16 ; w0:=name addr
jl. w3 d12. ; get pda
sn w3 0 ; if no proc then
jl. b36. ; goto b36
rl w0 x3 ; w0:=kind
sn w0 0 ; if not ip then
se w1 (x3+a134) ; if proc is not a child of sender then
jl. b36. ; goto b36
al w0 -11 ; else set buf as child copy buf
rs w0 x2+a40 ;
rl w0 x3+22 ; w0:=first addr. child
wa w0 x2+a14 ;
rs w0 x2+a14 ; set first addr this comp.
jl. b12. ; goto move buf
\f
b50: ; mbuf address request
rl. w1 h31. ;
sn. w1 h31. ; if all mbufs is occupied then
jl. w3 b100. ; goto b100
rs w2 x1+a60 ; save buffer address
al w0 x1+a61 ;
rs w0 x2+a14 ;
al w0 -10 ; set buffer state
rs w0 x2+a40 ; to mbuf address
jl. w3 d5. ; remove mbuf
al. w2 h30. ;
jl. w3 d4. ; insert mbuf
rs. w1 h7. ; set current mbuf
al w0 17 ;
rs w0 x1+a57 ; mbuf-state:=17
rl w2 x1+a60 ; w2:=buf
al. w3 h2. ;
jd 1<11+34; send buffer to driver
jl. b0. ; and goto get event
\f
b60: ; mbuf is received from o.c.
jl. w3 d7. ; search matching mbuf
jl. b0. ; not found: goto b0 (not possible ?)
rs. w1 h7. ; save current mbuf
rs w2 x1+a60 ; set buffer addr
al w0 18 ;
rs w0 x1+a57 ; set mbuf state
al w0 x1+a66 ; w0:=name addr
jl. w3 d12. ; get proc addr
rs w3 x1+a71 ; save proc addr
c. c0 ;
rl w0 x1+a66 ;
rs w0 x1+a67 ;
rl w0 x1+a72 ;
rs w0 x1+a72+2 ;
z. ;
bz w0 x1+a61+1 ; w0:=moncall number
am ( 0) ; case moncall of
jl. -54 ;
jl. b61. ; create internal proc
jl. b62. ; start internal proc
jl. b63. ; stop internal proc
jl. b64. ; modify internal proc
jl. b65. ; remove internal proc
b61: ; create internal proc
rl w0 x1+a73 ; w0:=pda parent.mirror
sn w0 0 ; if parent.mirror not exist then
jl. w3 d9. ; create one
rl w3 x1+a73 ;
sh w3 0 ; if not createt then
jl. b67. ; then goto set result
al w0 0 ; create internal proc
rs w0 x1+a80+8 ; set create type
rl w3 x1+a80+2 ; w3:=last o. c.
ws w3 x1+a80+0 ; w3:=size-2
al w0 x3+2 ; w0:=wanted size
jl. w3 d10. ; search core
jl. b66. ; not found: goto answer 1
ds w0 x1+a80+2 ; found: save first and last
al w3 x1+a66 ;name addr
al w1 x1+a80 ; w1 area
jd 1<11+56; create internal proc
se w0 0 ; if result<>0 then
jl. b67. ; goto set result
al w2 ( 0) ; w2:=result
jd 1<11+4 ; w0:=proc addr
rl. w1 h7. ; w1:=curent mbuf
rx w0 x1+a71 ; save proc addr, w0:=proc addr o. c.
rl w3 x1+a71 ; w3:=proc addr this computer
rs w0 x3+a194 ; set proc addr
rl w0 x1+a73 ; w0:=parent.mirror
rs w0 x3+a134 ; set parent
al w0 x2 ;
jl. b67. ; goto set result
\f
b62: ; start internal proc
c. c0 ;
al w2 0 ;
rx w2 x3-14 ;
rs w2 x1+a80+18 ;
z. ;
jl. w2 d14. ; insert master as parent
jd 1<11+58; start internal proc
jl. w2 d15. ; insert old parent
c. c0 ;
rl w2 x1+a80+18 ;
rx w2 x3-14 ;
z. ;
jl. b67. ; goto set result
b63: ; stop internal proc
c. c0 ;
al w2 0 ;
rx w2 x3-14 ;
rs w2 x1+a80+18 ;
z. ;
jl. w2 d14. ; insert master as parent
jd 1<11+60; stop internal proc
se w0 0 ; if result<>0 then
jl. b67. ;
rs w2 x1+a64 ; save wait buffer addr
al w0 -13 ;
rs w0 x2+a40 ; set stp ip buffer type
jl. w2 d15. ; insert old parent
c. c0 ;
rl w2 x1+a80+18 ;
rx w2 x3-14 ;
z. ;
jl. b0. ; goto wait result
b64: ; modify internal proc
al w0 0 ; prepare answer in case of mirror proc
rl w2 x3+a192 ; w2:=proc type
sz w2 2.1 ; if not real proc then
jl. b67. ; skip modify internal
c. c0 ;
al w2 0 ;
rx w2 x3-14 ;
rs w2 x1+a80+18 ;
z. ;
jl. w2 d14. ; insert master as parent
al w1 x1+a80 ; w1:=w1 area
jd 1<11+62; modify internal proc
jl. w2 d15. ; insert old parent
c. c0 ;
rl w2 x1+a80+18 ;
rx w2 x3-14 ;
z. ;
jl. b67. ; goto set result
b65: ; remove internal proc
c. c0 ;
al w2 0 ;
am ( 0) ;
rs w2 -14 ;
am ( 0) ;
rs w2 -12 ;
z. ;
jl. w2 d14. ; insert master as parent
rl w1 x1+a71 ;
dl w2 x1+24 ; first, last addr
jd 1<11+64; remove internal proc
jl. w3 d11. ; release core
jl. b67. ;
\f
b66: al w0 1 ; result 1
b67: rl. w1 h7. ; w1:=mbuf
b69: rl w2 x1+a60 ; w2:=buffer
rs w0 x1+a70 ; save result
rs w0 x2+a22 ;
rl w0 x1+a71 ; move proc addr
rs w0 x2+a20 ; to buf
rl w0 x1+a73 ; pda of mirror parent
rs w0 x2+a16 ;
al w0 -8 ;
rs w0 x2+a40 ;
al w0 19 ;
rs w0 x1+a57 ; set mbuf state
b68: al. w3 h2. ; else send answer
jd 1<11+34; driver
jl. w3 d5. ;
al. w2 h31. ;
jl. w3 d4. ; insert mbuf in free chain
jl. b0. ; and goto wait event
b76:
jd 1<11+126; remove buf and
al w0 0 ; answer:=0
jl. b69. ; and goto send answer to other computer
\f
b70: ; mon call this computer
jl. w3 d8. ; search matching mbuf
jl. b0. ; not found: goto b0 (not possible ?)
al w0 x1+a66 ; w0:=name addr
jl. w3 d12. ; get pda
rs w3 x1+a71 ; save pda
bz w0 x1+a61+1 ; w0:=moncall number
am ( 0) ; case moncall of
jl. -54 ;
jl. b71. ; create internal proc
jl. b72. ; start internal proc
jl. b73. ; stop internal proc
jl. b74. ; modify internal proc
jl. b75. ; remove internal proc
b71: ; create internal mirror proc
rl w0 x2+a22 ; w0:=result o.c.
se w0 0 ; if result o.c. is not ok then
jl. b75. ; goto remove proc this comp.
rl w3 x2+a20 ; w3:=pda o.c.
rl w0 x2+a16 ; w0:=pda of parent mirror o.c.
rl w2 x1+a71 ; w2:=pda this comp. (mirror)
rs w3 x2+a194 ; chain procs
rl w3 x1+a74 ; w3:=pda of parent this comp.
rs w0 x3+a194 ; chain parents
rs w3 x2+a134 ; set parent in mirror proc
rl w2 x1+a56 ; restore w2
jl. b78. ; goto set result
b72: ; start internal proc
jl. w2 d14. ; insert master as parent
jd 1<11+58; start internal proc
jl. w2 d15. ; insert old parent
jl. b77. ; goto set result
b73: ; stop internal proc
jl. w2 d14. ; insert master as parent
jd 1<11+60; stop internal proc
se w0 0 ; if result<>0 then
jl. b77. ; goto set result
al w0 -13 ; else
rs w0 x2+a40 ; set buffer type as stop ip buf
rs w2 x1+a64 ; save stop ip buff
jl. w2 d15. ; insert old parent
jl. b0. ; goto wait for stop completed
b74: ; modify internal proc
rl w2 x3+a192 ; w2:= proc type
sz w2 2.1 ; if mirror proc then
jl. b78. ; skip modify internal
jl. w2 d14. ; insert master as parent
al w1 x1+a80 ; w1:=w1 area
jd 1<11+62; modify internal proc
jl. w2 d15. ; insert old parent
jl. b77. ; goto set result
b75: ; remove internal proc
jl. w2 d14. ; insert master as parent
jd 1<11+64; remove internal proc
\f
b77: rl. w1 h7. ; w1:=mbuf
rl w2 x1+a56 ;
jl. b79. ;
b78: al w0 0 ;
rl w2 x1+a56 ; w2:=buf
b79: rl w3 x2+a22 ;
ds. w0 h13. ;
sh. w0 ( h12.) ;
rl. w0 h12. ; w0:= highest result
rl w2 x1+a60 ; w2:=buffer
al. w1 h12. ;
jd 1<11+22; send answer
rl. w1 h7. ; w1:=current mbuf
rl w2 x1+a56 ;
jd 1<11+126; remove buff
jl. w3 d5. ;
al. w2 h31. ;
jl. w3 d4. ; insert mbuf in free chain
jl. b0. ; and goto wait event
b85: jl. w3 d8. ; search matching mbuf
jl. b86. ; not found: goto search mbuf-id
jl. b87. ; found: goto send answer
b86: jl. w3 d7. ; search matching mbuf-id
jl. b89. ; not found: goto remove buf
b87: rl w0 x2+a4 ; w0:=answer
jl. b79. ; goto remove mbuf
b89: jd 1<11+126; remove buf
jl. b0. ; goto wait event
b80: am 1 ;send answer in case of no free mbuf other computer
b81: am 19 ;
b100:jd -100 ;no free mbuf this computer
jl. 0 ;
jl. b0. ;
\f
m. var area ;
h0: 0 ; own proc
h1: 0 ; hc-hcdriver proc addr
h2: <:rhdriver:>,0,0,0;
h3: <:rhmaster:>,0,0,0;
h4: 0,r.5 ; name area for receiver
h5: <:rhmastermi:>,0 ;
m. ma mi add
h6: 0 ; pda mirror master o c.
0 ; first mbuf addr
h8: 0 ; mbuf length
h9: 0 ;
h10: 0,r.5 ;
h7: 0 ; current mbuf
h11: 0 ; start of proc
h12: 0 ; answer buf
h13: 0 ;
h14: d41 ;
h15: 0,r.5 ;
h18: <:hcmaster:>,0,0 ;
h19: a49 ; mbuf length
h22: a200 ; first of core table
h23: 0 ; last of proc
h24: 0 ; first free
h30: 0,0 ; used mbuf head
h31: 0,0 ; free mbuf head
\f
b. g5w. ;
;; insert a mbuf
; w1=element, w2=head
; return: w1,w2 unchanged, w3 prev element
d4: ;
rs. w3 g3. ;
rl w3 x2+2 ; w2:=prev mbuf
rs w1 x2+2 ; prev mbuf:=curr mbuf
rs w1 x3+0 ;
rs w2 x1+0 ;
rs w3 x1+2 ;
jl. ( g3.) ; return
g3: 0 ;
e. ;
b. g5w. ;
;; remove a mbuf
; w1=element
; return: w1,w2 unchanged, w3=next element
d5: ;
rs. w3 g3. ;
rl w3 x1+0 ;
rx w1 x1+2 ;
rs w3 x1+0 ;
rx w1 x3+2 ;
rs w1 x1+0 ;
jl. ( g3.) ;
g3: 0 ;
e. ;
;
;; call: w2=buf, w3=link
; return 0: w0,w2 unchanged w1=mbuf pool end
; 2: - - w1=mbuf
;. search mbuf with buffer address =w2
b. f5,g5 w. ;
d6: ;
al. w1 h30. ; mbuf pool head
jl. f1. ; goto test mbuf pool end
f0: sn w2 (x1+a64) ; if mbuf.buf=buf.w2
jl x3+2 ; then return 2
f1: rl w1 x1 ; else test mobuf pool end
se. w1 h30. ;
jl. f0. ;
jl x3 ;
e. ;
;
;; search mbuf in state>16 with mbuf-id = mbuf-id.buffer
; call: w2=buf, w3=return
; return0 w0 mbuf-if.buffer, w2,w3 unchanged, w1=mbuf chain head
; return2:w0 mbuf-if.buffer, w2,w3 - , w1=mbuf
b. f5,g5 w. ;
d7: al. w1 h30. ;
rl w0 x2+a18 ;
jl. f1. ;
f0: sn w0 (x1+a61) ; if mbuf-id.buffer = mbuf-id.w1 then return2 else
jl x3+2 ; return2 else
f1: rl w1 x1 ; next mbuf
se. w1 h30. ;
jl. f0. ;
jl x3 ;
e. ;
;
;; call: w2=buf, w3=link
; return 0: w0,w2 unchanged w1=mbuf pool end
; 2: - - w1=mbuf
;. search mbuf with buffer address =w2
b. f5,g5 w. ;
d8: ;
al. w1 h30. ; mbuf pool head
jl. f1. ; goto test mbuf pool end
f0: sn w2 (x1+a56) ; if mbuf.buf=buf.w2
jl x3+2 ; then return 2
f1: rl w1 x1 ; else test mobuf pool end
se. w1 h30. ;
jl. f0. ;
jl x3 ;
e. ;
\f
;; create mirror proc
b. g5,f5 w. ;
d9: ds. w2 g2. ;
rs. w3 g3. ;
al w3 x1+a72 ; name
al. w1 g4. ; param addr
c. c0 ;
al w0 0 ;
rs w0 x1+8 ;
z. ;
rl w0 x1+0 ;
se w0 0 ; if param is init. then
jl. f0. ; goto create
al w0 x1-2 ; else
ds w1 x1+2 ; else set first and last addr
rl. w2 h0. ; w2:=own proc addr
rl w0 x2+76 ; w0:=lower std base
rs w0 x1+10 ;
rs w0 x1+12 ;
rs w0 x1+14 ;
rs w0 x1+16 ;
f0: jd 1<11+56; create proc
rs. w0 g0. ; save result
jd 1<11+4 ; w0:= proc addr
rl. w1 g1. ; w1:=mbuf
rs w0 x1+a73 ; save proc addr
rl w2 0 ; w2:=pda
rl w0 x1+a74 ;
rs w0 x2+a194 ;
rl. w0 h0. ; w0:=pda.master
al w3 5 ;
ds w0 x2+a190 ; proc.type:=mirror
dl. w3 g3. ;
jl x3 ;
g0: 0 ;
g1: 0 ;
g2: 0 ;
g3: 0 ;
g4: ;
0 ; first addr
0 ; last
0 ; buf,area
0 ; ip,func
-8 ; pr,pk (create mirror)
0 ; lower max base
0 ; upper - -
0 ; lower std -
0 ; upper - -
e. ;
\f
;; get free core
; call: w0=core length w3=return
; return0: no free core or too short core left w1,w2 unchanged
; return2: w3=first of core,w0=last of core, w1,w2 unchanged
; the free core is chained in a table as follews:
; 1. word 2. word
; next core length of free core
b. f10,g9 w. ;
d10: ds. w1 g1. ;
ds. w3 g3. ;
rl. w3 h22. ; w3:=first of core table
f0: dl w2 x3+2 ; w1:=first addr, w2:=length
sn w2 0 ; if no more left then
jl. f10. ; goto return0
sl. w2 ( g0.) ; if core size>=wanted core size then
jl. f1. ; goto f1
al w3 x3+4 ; else goto to next in table
jl. f0. ;
f1: al w0 x1 ; w0:=first addr
se. w2 ( g0.) ; if current core size>wanted core size then
jl. f4. ; goto f4 (cut of)
f2: dl w2 x3+6 ;
ds w2 x3+2 ; compress core table
al w3 x3+4 ;
se w2 0 ; if not end of table then
jl. f2. ; goto move next
jl. f9. ; goto return2
f4: ws. w2 g0. ; w2:=core left
wa. w1 g0. ; w1:=new first addr
ds w2 x3+2 ;
f9: dl. w2 g2. ;
rl. w3 g3. ;
al w3 x3+2 ;
rs. w3 g3. ;
rl. w3 g0. ;
wa w3 0 ;
al w3 x3-2 ;
rx w0 6 ;
jl. ( g3.) ;
f10: dl. w2 g2. ;
jl. ( g3.) ; return0
g0: 0 ;
g1: 0 ;
g2: 0 ;
g3: 0 ;
e. ;
\f
;; return free core
; call: w1=first addr, w2=last addr, w3=return addr
; return: all reg unchanged
b. f5,g5 w. ;
d11: ds. w1 g1. ;
ds. w3 g3. ;
ws w2 2 ;
al w0 x2+2 ; w0:=size
rl. w3 h22. ; w3:=first of core table
f0: dl w2 x3+2 ; w1:=first addr, w2:=length
se w2 0 ; if end of table or
sl. w1 ( g1.) ; first addr.curr core >=first addr.call then
jl. f1. ; goto f1
al w3 x3+4 ; else
jl. f0. ; goto next
f1: ws w1 0 ;
se. w1 ( g1.) ;
jl. f2. ;
wa w2 0 ;
ds w2 x3+2 ; set new first addr and size
jl. f4. ; goto return
f2: ds. w2 g5. ; save curr core
rl. w1 g1. ; new first addr
rl w2 0 ; new size
ds w2 x3+2 ;
f3: al w3 x3+2 ;
dl w2 x3+2 ; move table
rx. w1 g4. ;
rx. w2 g5. ;
ds w2 x3+2 ;
se w2 0 ; if more to move then
jl. f3. ; goto f3
f4: dl. w1 g1. ;
dl. w3 g3. ;
jl x3 ;
g0: 0 ;
g1: 0 ;
g2: 0 ;
g3: 0 ;
g4: 0 ;
g5: 0 ;
e. ;
\f
;; get pda
; call: w0= name addr, w3=return addr
; return: w0,w1,w2 unchanged, w3=pda if any
b. f5,g5 w. ;
d12: ds. w1 g1. ;
ds. w3 g3. ;
rl w3 0 ; w3:=name addr
sl. w3 ( h11.) ; if name addr
sl. w3 ( h23.) ; outside proc then
jl. w3 d13. ; move name to this proc (h4)
jd 1<11+4 ; get pda
dl. w2 g2. ;
rx w3 0 ;
jl. ( g3.) ;
g0: 0 ;
g1: 0 ;
g2: 0 ;
g3: 0 ;
e. ;
;; move name from (w0) to h4
; call: w0=name addr, w3=return addr
; return: w0,w1,w2 unchanged, w3=name addr
b. g5,f5 w. ;
d13: ds. w1 g1. ;
ds. w3 g3. ;
al. w3 h4. ;
rl w2 0 ; w2:=name addr
dl w1 x2+2 ; move name
ds w1 x3+2 ;
dl w1 x2+6 ;
ds w1 x3+6 ;
dl. w2 g2. ;
rl. w0 g0. ;
jl. ( g3.) ;
g0: 0 ;
g1: 0 ;
g2: 0 ;
g3: 0 ;
e. ;
;
;; set master as parent
; call: return
; w0 unchanged
; w1 cur mbuf unchanged
; w2 return undef
; w3 proc addr name addr
b. f5,g5 w.
d14: rs. w2 g2. ;
rl. w2 h0. ; pda.master
rx w2 x3+a134 ; insert parent and
rs w2 x3+a196 ; save old parent
al w3 x1+a66 ; w3:=name addr
jl. (g2.) ; return
g2:0
e.
;; insert old parent
; call: return:
; w0 unchanged
; w1 cur mbuf
; w2 return addr undef
; w3 proc addr
;
b. f5,g5 w.
d15: rs. w2 g2. ; save return
rl. w1 h7. ; w1:=current mbuf
rl w3 x1+a71 ; w3:=proc addr
rl w2 x3+a196 ; w2:=old parent
rx w2 x3+a134 ; save old parent in proc
rs w2 x3+a196 ; save master
jl. (g2.) ;
g2:0
e.
\f
b. f5,g5 w. ;
d40: ;
;; set up chain with free mbufs
rs. w3 g3. ;
al w0 0 ;
al. w2 h31. ; w2:=head
al. w1 h20. ; w1:=first
f0: jl. w3 d4. ; chain mbuf
rs w0 x1+a57 ; set mbuf-state
al w1 x1+a100 ; w1:=next mbuf
sh. w1 h21. ;
jl. f0. ;
jl. ( g3.) ;
g3: 0 ;
e. ;
0,r.2 ;
m. mbuf start ;
h. ;
h20: 0,r.(:a100*8:) ;
h21: 0,r.a100 ;
w. ;
\f
b. g11,f10 w. ; program interrupt
g0=8 ; number of reg.
g1=9 ; number of digits per reg
m. reg dump start
d41: 0,r.g0 ; register values
m. reg dump end
gg 66,r.4
je. 0
al w1 32 ;
al. w2 g8. ; first of buff
f1: rs w1 x2 ;
al w2 x2+2 ;
se. w2 g9. ;
jl. f1. ;
al. w1 d41. ; w1:= addr of first reg val
al. w2 g8. ;
al w2 x2-2 ;
rs. w2 g7. ;
f2: rl. w2 g7. ; w2 :=
al w2 x2+(:g1<1:); next in buff
rs. w2 g7. ;
al w3 32 ;
rl w0 x1 ;
sn. w1 d41.+10; if ic then
ws. w0 h11. ; w0:=relative ic
sl w0 0 ; if val >= 0 then
jl. f3. ; goto f3
al w3 x3+13 ;
ac w0 ( 0) ;
f3: rs. w3 g6. ;
f4: al w3 0 ;
wd. w0 g3. ; w3:= next digit
al w3 x3+48 ;
rs w3 x2 ;
al w2 x2-2 ;
se w0 0 ; if more digits then
jl. f4. ; goto f4
rl. w3 g6. ; else
rs w3 x2 ; set sign
al w1 x1+2 ; w1:=next reg addr
sh. w1 d41.+(:(:g0-1:)<1:); if all reg val is coverted then
jl. f2. ; goto f2
al. w3 g8. ;
al. w2 g9. ; output buffer
f6: rl w1 x3 ;
ls w1 8 ;
lo w1 x3+2 ;
ls w1 8 ;
lo w1 x3+4 ; w1:= next 3 digits
rs w1 x2 ;
al w2 x2+2 ;
al w3 x3+6 ;
se. w3 g9. ;
jl. f6. ;
al. w1 g4. ; w1:= mess area
al. w2 g9. ; first of buff
al. w3 g10. ; last of buff
ds w3 x1+4 ;
al. w3 g5. ;
jd 1<11+16;
al. w1 g11. ;
jd 1<11+18;
dl. w1 d41.+2 ;
dl. w3 d41.+6 ;
jl. ( d41.+10); return to program
g3: 10 ;
g4: 5<12+0 ; mess
0,r.7 ;
g5: <:terminal28:>,0,0;
g6: 32 ; sign
g7: 0 ; buffer position
g8: 0,r.(:g0*g1:) ;
g9: 0,r.(:g0*g1/3:) ;
g10: 10<16 ;
g11: 0,r.8 ;
e. ;
a200=k
m. end of hcmaster
e.
▶EOF◀