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

⟦0c9db5203⟧ TextFile

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »tspoolfull«

Derivation

└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
    └─⟦4334b4c0b⟧ 
        └─⟦this⟧ »tspoolfull« 

TextFile

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