|
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: 16896 (0x4200)
Types: TextFile
Names: »tsendmes «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─⟦this⟧ »tsendmes «
(
message sendmessage
sendmessage=set 1 disc1
sendmessage=slang
_ sendmessage messageid waitanswer waitmessage receiver sender sendanswer,
_ getevent procdesc ownproc bufclaim areaclaim flushout address startintern,
_ regret
scope user.disc1,
_ sendmessage messageid waitanswer waitmessage receiver sender sendanswer,
_ getevent procdesc ownproc bufclaim areaclaim flushout address startintern,
_ regret
)
; *** sendmessage ***
b. g1, e20 ; insertproc
d.
p. <:fpnames:> ; fpnames
l.
k= 10000
s. j60, g3, a10 ; code procedure
h.
g0= 0 ; number of externals
e20: ; start segment
g1: g3, g2 ; head word
j1: 0 , 1 ; 1st own
j2: 0 , 3 ; 2nd own
j3: 0 , 7 ; 4th own
j4: g0 + 4, 0 ; rs entry 4: take expression
j6: g0 + 6, 0 ; - 6: end reg expression
j8: g0 + 8, 0 ; - 8: end addr expression
j13: g0 + 13, 0 ; - 13: last used
j27: g0 + 27, 0 ; - 27: out
j29: g0 + 29, 0 ; - 29: param alarm
j30: g0 + 30, 0 ; - 30: saved stack ref, w3
j54: g0 + 54, 0 ; - 54: field alarm
g2= -g1.-2 ; end of abs words
g3= -g1.-2 ; end of points
w.
e0: g0 ; external list, no ext
0 ; no of hw's to init
91 10 04 ; date of version
10 11 12 ; time of version
\f
; procedure test_array_kind;
; call return
; w0 1st form. kind
; w1 - unchanged
; w2 - unchanged
; w3 link
a0: 31 ;
a1: la. w0 a0. ; kind:= 1st_formal and 31;
sh w0 23 ; if not array
sh w0 16 ; and not zone
jl. w3 ( j29. ; then param alarm;
jl x3 ; return;
; sendmessage
e1: rl. w2 ( j13.) ; entry sendmessage
ds. w3 ( j30.) ;
rl w0 x2+6 ;
jl. w3 a1. ; test_array_kind( name );
rl w3 x2+8 ;
ea w3 x2+6 ;
al w1 10 ; if hw10 > last of name
am (x3-2) ;
sl w1 1
jl. w3 ( j54.) ; then field alarm;
al w1 1 ; if hw1 <= base of name
sh w1 (x3) ;
jl. w3 ( j54.) ; then field alarm;
wa w1 (x2+8) ;
rl w0 x2+10 ; test_array_kind( message );
jl. w3 a1. ;
al w0 x1 ;
rl w3 x2+12 ;
ea w3 x2+10 ;
al w1 16 ; if hw16 > last of message
am (x3-2) ;
sl w1 1 ;
jl. w3 ( j54.) ; then field alarm;
al w1 1 ; if hw1 <= base of message
sh w1 (x3) ;
jl. w3 ( j54.) ; then field alarm;
wa w1 (x2+12) ; w1:= message addr.
rl w3 0 ; w3:= name addr.
rl. w2 ( j1.) ; w2:= messageid;
jd 1<11+16 ; send message;
al w1 x2 ; w1:= result;
jl. ( j6.) ; return( result );
; waitanswer
e2: rl. w2 ( j13.) ; entry waitanswer
dl w1 x2+8 ; take buffer addr
so w0 16 ; if expression then
jl. w3 ( j4.) ; take expression
ds. w3 ( j30.) ;
rl w0 x2+10 ; test_array_kind( answer );
jl. w3 a1. ;
rl w0 x1 ;
rl w3 x2+12 ;
ea w3 x2+10 ;
al w1 16 ; if hw16 > last of answer
am (x3-2) ;
sl w1 1 ;
jl. w3 ( j54.) ; then field alarm;
al w1 1 ; if hw1 <= base of answer
sh w1 (x3) ;
jl. w3 ( j54.) ; then field alarm;
wa w1 (x2+12) ;
rl w2 0 ; w2:= buffer addr
rl w3 x2-2 ; messageid:=
rs. w3 ( j1.) ; word( w2 - 2 );
jd 1<11+18 ; wait answer;
rl w1 0 ;
jl. ( j6.) ; return( result )
; waitmessage
e3: rl. w2 ( j13.) ; entry waitmessage
dl w1 x2+16 ; take buffer addr
so w0 16 ; if expression then
jl. w3 ( j4.) ; take expression
ds. w3 ( j30.) ;
rs w1 x2+16 ;
rl w0 x2+6 ; test_array_kind( name );
jl. w3 a1. ;
rl w3 x2+8 ;
ea w3 x2+6 ;
al w1 8 ; if hw8 > last of name
am (x3-2) ;
sl w1 1
jl. w3 ( j54.) ; then field alarm;
al w1 1 ; if hw1 <= base of name
sh w1 (x3) ;
jl. w3 ( j54.) ; then field alarm;
wa w1 (x2+8) ;
rl w0 x2+10 ; test_array_kind( message );
jl. w3 a1. ;
al w0 x1 ;
rl w3 x2+12 ;
ea w3 x2+10 ;
al w1 16 ; if hw16 > last of message
am (x3-2) ;
sl w1 1 ;
jl. w3 ( j54.) ; then field alarm;
al w1 1 ; if hw1 <= base of message
sh w1 (x3) ;
jl. w3 ( j54.) ; then field alarm;
wa w1 (x2+12) ; w1:= message addr.
rl w3 0 ; w3:= name addr.
jd 1<11+20 ; wait message;
rl w1 0 ; w1:= result;
dl w0 x2 6 ; w3w0:= buf.receiver,buf.sender;
sh w0 0 ;
ac w0 ( 0 ;
sh w3 0 ;
ac w3 x3 ;
ds. w0 ( j3. ; receiver,sender := w3w0;
rl. w3 ( j13.) ;
rs w2 (x3+16) ;
jl. ( j6.) ; return( result );
; sendanswer
e4: rl. w2 ( j13.) ; entry sendanswer
dl w1 x2+8 ; take result
so w0 16 ; if expression then
jl. w3 ( j4.) ; take expression;
ds. w3 ( j30.) ;
rs w1 x2+8 ;
dl w1 x2+16 ; take buffer addr
so w0 16 ; if expression then
jl. w3 ( j4.) ; take expression;
ds. w3 ( j30.) ;
rs w1 x2+16 ;
rl w0 x2+10 ; test_array_kind( message )
jl. w3 a1. ;
rl w3 x2+12 ;
ea w3 x2+10 ;
al w1 16 ; if hw16 > last of message
am (x3-2) ;
sl w1 1 ;
jl. w3 ( j54.) ; then field alarm;
al w1 1 ; if hw1 <= base of message
sh w1 (x3) ;
jl. w3 ( j54.) ; then field alarm;
wa w1 (x2+12) ; w1:= message addr.
rl w0 (x2+8) ; w0:= result;
rl w2 (x2+16) ; w2:= buffer addr.
jd 1<11+22 ; send answer;
jl. ( j8.) ; return;
; getevent
e5: rl. w2 ( j13.) ; entry getevent
dl w1 x2+8 ; take buffer addr
so w0 16 ; if expression then
jl. w3 ( j4.) ; take expression;
ds. w3 ( j30.) ;
rl w2 x1 ; w2:= buffer addr.
dl w0 x2 6 ; w3w0:= buf.receiver,buf.sender;
sh w0 0 ;
ac w0 ( 0 ;
sh w3 0 ;
ac w3 x3 ;
ds. w0 ( j3. ; receiver,sender := w3w0;
jd 1<11+26 ; get event;
jl. ( j8.) ; return;
; procdesc
e6: rl. w2 ( j13.) ; entry procdesc
ds. w3 ( j30.) ;
rl w0 x2+6 ; test_array_kind( name );
jl. w3 a1. ;
rl w3 x2+8 ;
ea w3 x2+6 ;
al w1 8 ; if hw8 > last of name
am (x3-2) ;
sl w1 1
jl. w3 ( j54.) ; then field alarm;
al w1 1 ; if hw1 <= base of name
sh w1 (x3) ;
jl. w3 ( j54.) ; then field alarm;
al w3 x1 ; w3:= name addr.
wa w3 (x2+8) ;
jd 1<11+4 ; process description;
rl w1 0 ; w1:= result;
jl. ( j6.) ; return( result );
; ownproc
e7: rl. w1 ( j2.) ; entry ownproc
se w1 0 ; if saveown = 0
jl. ( j6.) ;
jd 1<11+5 ; then saveown:= own process;
rs. w1 ( j2.) ;
jl. ( j6.) ; return( saveown );
; bufclaim
e8: rl. w1 ( j2.) ; entry bufclaim
se w1 0 ; if saveown = 0
jl. a3. ;
jd 1<11+5 ; then saveown:= own process;
rs. w1 ( j2.) ;
a3: el w1 x1+26 ;
jl. ( j6.) ; return( buf claim( saveown ));
; areaclaim
e12: rl. w1 ( j2.) ; entry bufclaim
se w1 0 ; if saveown = 0
jl. a4. ;
jd 1<11+5 ; then saveown:= own process;
rs. w1 ( j2.) ;
a4: el w1 x1+27 ;
jl. ( j6.) ; return( area claim( saveown ));
; flushout
e9: rl. w2 ( j13. ; entry address
dl w1 x2+8 ; get param;
so w0 16 ; if expression
jl. w3 ( j4. ; then take expression;
ds. w3 ( j30. ; save stackref, w3;
rl w2 x1 ; w2:= char;
rl. w1 j27. ; w1:= zoneaddr;
jl w3 x1 h33-h21 ; outend;
jl. ( j8. ; return;
; address
e10: rl. w2 ( j13. ; entry address
dl w1 x2 8 ; get param;
so w0 16 ; if expression
jl. w3 ( j4. ; then take expression;
ds. w3 ( j30. ;
al w0 31 ; test param
la w0 x2 6 ;
sh w0 22 ; if variable or zone array
sh w0 16 ;
jl. ( j6. ; then return( 2. formal )
rl w1 x1 ;
jl. ( j6. ; else return((2. formal));
; startintern
e11: rl. w2 ( j13. ; entry address
ds. w3 ( j30. ;
rl w2 x2+8 ; w1:= zone descr.
rl w0 (x2 h0+4 ; w0:= share state(used share)
se w0 0 ;
sn w0 1 ;
jl. a5. ;
jl. w3 ( j29. ;
a5: al w3 x2 h1+2 ; w3:= name address
jd 1<11+58 ; start internal
rl w1 0 ; w1:= result
se w1 0 ; if result = 0 then
jl. ( j6. ; begin
jd 1<11+4 ; w0:= process desrciption
ac w0 ( 0 ; share state(used share):= -w0
rs w0 (x2 h0+4 ; end;
jl. ( j6. ; return(result)
; regret
e13: rl. w2 ( j13. ; entry address
dl w1 x2+8 ; take buffer addr
so w0 16 ; if expression then
jl. w3 ( j4.) ; take expression;
ds. w3 ( j30.) ;
rl w2 x1 ; w2:= buffer addr.
jd 1<11+82 ; regret message;
jl. ( j8.) ; return;
e19:
c. e19-e20-506
m. code too long
z.
c. 502-e19+e20
0
r.252-(:e19-e20:)>1; fill
z.
<:monprocs:>, 0 ; alarm text
e.
\f
w.
; sendmessage
g0: 1 ; first tail, 1 segm
0, r.4 ; discname
1<23+e1-e20 ; entry point
3<18+41<12+41<6 ; integer procedure( undef array name,
0 ; _ undef array message )
4<12+e0-e20 ; code proc, start ext. list
1<12+8 ; 1 segm, 8 bytes
; messageid
1<23+4 ; bs
0, r.4 ; discname
1 ; hw address in own core
9<18 ; own integer
0 ;
4<12+e0-e20 ; code proc, start ext. list
1<12+8 ; 1 segm, 8 bytes
; waitanswer
1<23+4 ; bs
0, r.4 ; discname
1<23+e2-e20 ; entry point
3<18+41<12+19<6 ; integer procedure( addr int buffer,
0 ; _ undef array answer )
4<12+e0-e20 ; code proc, start ext. list
1<12+8 ; 1 segm, 8 bytes
; waitmessage
1<23+4 ; bs
0, r.4 ; discname
1<23+e3-e20 ; entry point
3<18+19<12+41<6+41 ; integer procedure( undef array name,
0 ; _ undef array message, addr int buf )
4<12+e0-e20 ; code proc, start ext. list
1<12+8 ; 1 segm, 8 bytes
; receiver
1<23+4 ; bs
0, r.4 ; discname
5 ; hw address in own core
9<18 ; own integer
0 ;
4<12+e0-e20 ; code proc, start ext. list
1<12+8 ; 1 segm, 8 bytes
; sender
1<23+4 ; bs
0, r.4 ; discname
7 ; hw address in own core
9<18 ; own integer
0 ;
4<12+e0-e20 ; code proc, start ext. list
1<12+8 ; 1 segm, 8 bytes
; sendanswer
1<23+4 ; bs
0, r.4 ; discname
1<23+e4-e20 ; entry point
1<18+19<12+41<6+19 ; procedure( addr int result,
0 ; _ undef array answer, addr int buf )
4<12+e0-e20 ; code proc, start ext. list
1<12+8 ; 1 segm, 8 bytes
; getevent
1<23+4 ; bs
0, r.4 ; discname
1<23+e5-e20 ; entry point
1<18+19<12 ; procedure( addr int buffer )
0 ;
4<12+e0-e20 ; code proc, start ext. list
1<12+8 ; 1 segm, 8 bytes
; procdesc
1<23+4 ; bs
0, r.4 ; discname
1<23+e6-e20 ; entry point
3<18+41<12 ; integer procedure( undef array name )
0 ;
4<12+e0-e20 ; code proc, start ext. list
1<12+8 ; 1 segm, 8 bytes
; ownproc
1<23+4 ; bs
0, r.4 ; discname
1<23+e7-e20 ; entry point
3<18 ; integer procedure
0 ;
4<12+e0-e20 ; code proc, start ext. list
1<12+8 ; 1 segm, 8 bytes
; bufclaim
1<23+4 ; bs
0, r.4 ; discname
1<23+e8-e20 ; entry point
3<18 ; integer procedure
0 ;
4<12+e0-e20 ; code proc, start ext. list
1<12+8 ; 1 segm, 8 bytes
; areaclaim
1<23+4 ; bs
0, r.4 ; discname
1<23+e12-e20 ; entry point
3<18 ; integer procedure
0 ;
4<12+e0-e20 ; code proc, start ext. list
1<12+8 ; 1 segm, 8 bytes
; flushout
1<23+4 ; bs
0, r.4 ; discname
1<23+e9-e20 ; entry point
1<18+19<12 ; procedure( address integer )
0 ;
4<12+e0-e20 ; code proc, start ext. list
1<12+8 ; 1 segm, 8 bytes
; address
1<23+4 ; bs
0, r.4 ; discname
1<23+e10-e20 ; entry point
3<18+41<12 ; integer procedure( undef )
0 ;
4<12+e0-e20 ; code proc, start ext. list
1<12+8 ; 1 segm, 8 bytes
; startintern
1<23+4 ; bs
0, r.4 ; discname
1<23+e11-e20 ; entry point
3<18+8<12 ; integer procedure( zone )
0 ;
4<12+e0-e20 ; code proc, start ext. list
1<12+8 ; 1 segm, 8 bytes
; regret
g1: 1<23+4 ; last tail, bs
0, r.4 ; discname
1<23+e13-e20 ; entry point
1<18+19<12 ; procedure( addr int buffer )
0 ;
4<12+e0-e20 ; code proc, start ext. list
1<12+8 ; 1 segm, 8 bytes
d.
p. <:insertproc:> ;
▶EOF◀