|
|
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: 3840 (0xf00)
Types: TextFile
Names: »tspoolfull«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »tspoolfull«
; boolean procedure spoolfull(term); value term; integer term;
; The procedure sends a message to the terminal pool to find
; out if the spool area for the specified terminal is full.
; note: the name of the pool process must be <:tph:>!!!
b. e7,g1, w.
d.
p.<:fpnames:>
l.
k=0
s. g10,j30,a8, h.
g0=0
e6:
g4 : g5,g5
j4 : g0+4,0
j6 : g0+6,0
j13 : g0+13,0
j21 : g0+21,0
j30 : g0+30,0
g5=k-2-g4
w.
e7 : g0
0
s3
s4
e4: rl. w2 (j13.) ; boolean procedure spoolfull(term);
ds. w3 (j30.) ; value term; integer term;
dl w1 x2+8 ; begin
so w0 16 ; w01:=param(1); <* term *>
jl. w3 (j4.) ; if actual.expression then takeexpression;
ds. w3 (j30.) ;
dl w1 x1 ; w01:=actual;
rl w3 x2+6 ;
sz w3 1 ; if actual.real then w1:=round(w01);
cf w1 0 ; <* convert integer in w1 to string in w3 *>
al w0 0 ; w0:=0;
al w3 0 ; w3:=0;
wd. w1 a5. ; w0:=w1 mod 100; w1:=w1//100;
wa w3 2 ; w3:=w3+w1;
al w3 x3+48 ; w3:=w3+ord("0");
ls w3 8 ; w3:=w3 shift 8;
rl w1 0 ; w1:=w0;
al w0 0 ; w0:=0;
wd. w1 a6. ; w0:=w1 mod 10; w1:=w1//10;
wa w3 2 ; w3:=w3+w1;
al w3 x3+48 ; w3:=w3+ord("0");
ls w3 8 ; w3:=w3 shift 8;
wa w3 0 ; w3:=w3+w0;
al w3 x3+48 ; w3:=w3+ord("0");
rs. w3 a2. ; message(2):=w3; <* terminal id *>
al. w1 a1. ; w1:=address(message);
al. w3 a3. ; w3:=address(receiver); <* tph *>
jd 1<11+16 ; sendmessage;
al. w1 a4. ; w1:=address(answer);
jd 1<11+18 ; waitanswer;
sn w0 1 ; if result<>1 then
jl. a7. ; begin
rl w1 0 ; w1:=w0;
al. w0 a8. ; w0:=address(alarmtext);
jl. w3 (j21.) ; general_alarm;
a7: ; end;
rl w1 x1+12 ; w1:=answer(7);
sh w1 512 ; <* w1=halfwds. left in spool area *>
am 1 ; spoolfull:=w1<=512;
al w1 0 ;
jl. (j6.) ; end; <* spoolfull *>
; message
a1: 104<12+0
a2: 0,0,0,0,0,0,0
; name, name table address
a3: <:tph:>,0,0,0,0
; answer
a4: 0,0,0,0,0,0,0,0
a5: 100
a6: 10
a8: <:<10>wanswer :>
\f
g6 :
c. g6-g4-506
m. code too long
z.
c. 502-g6+g4, jl -1, r. 252-(:g6-g4:)>1 z.
; fill rest of segment with the illegal instruction jl -1
<:spoolfull <0>:> ; alarm text
e. ; end of slang segment;
g0:g1:
; spoolfull
1
0,0,0,0
1<23+e4-e6
2<18+13<12
0
4<12+e7-e6
1<12+0
d.
p.<:insertproc:>
▶EOF◀