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 - download

⟦4ebeed25a⟧ Rc489k_TapeFile, TextFile

    Length: 3072 (0xc00)
    Types: Rc489k_TapeFile, TextFile

Derivation

└─⟦aa55fa693⟧ Bits:30007479 SW8110/1 TAS/SOS/PRIMO Rel 2.3
    └─⟦this⟧ 

TextFile

;             *** tsostest ***
;
;
; a simple testprogram for testing the sos system
;
; the program acts like this
;
;        create terminal pool
; loop:
;        read an input line from a connected terminal
;             (this input line starts with a terminal number)
;        increase linecount(terminal number)
;        write terminal number
;        write linecount
;        write content of input line
;        goto loop


begin
  zone poolin,poolout(26,1,stderror);
  real time,r;
  integer i,activeterminals,maxterminals,currterminal;



  integer procedure createpool(z);
  zone z;
  begin
    integer i;
    integer array zia(1:20),sia(1:12);
    zone ztem(1,1,stderror);
    open(ztem,0,<:tem:>,0);
    getzone6(z,zia);
    getshare6(ztem,sia,1);
    sia(4):=90 shift 12;
    for i:=0 step 1 until 3 do sia(8+i):=zia(2+i);
    setshare6(ztem,sia,1);
    monitor(16,ztem,1,sia);
    createpool:=if monitor(18,ztem,1,sia) <> 1 then -1 else sia(1);
    close(ztem,true);
  end createpool;
  
  maxterminals:=10;
  activeterminals:=0;

  begin
    integer i,j;
    integer array linebuf(1:200),linecount(1:maxterminals);
    for i:=1 step 1 until maxterminals do linecount(i):=0;
    open(poolin,8,<:tem:>,0);
    open(poolout,1 shift 18 + 8,<:tem:>,0);
    createpool(poolin);

  <*   read a line and display it on corresponding terminal   *>

loop:
    read(poolin,currterminal);
    i:=1;
    for i:=i while readchar(poolin,linebuf(i)) <> 8 do i:=i+1;
    setposition(poolin,0,0);
    linecount(currterminal):=linecount(currterminal)+1;
    if linebuf(1) = 1 then
    begin  comment login;
      linecount(currterminal):=0;
      write(poolout,<:sos testprogram ready<10>:>);
      activeterminals:=activeterminals+1;
      systime(1,0,time);
      systime(4,time,r);
      write(out,<<dd dd dd>,r);
      write(out,<::   login:  :>,<<dd>,currterminal,<:,:>);
      for j:=1 step 1 until i do outchar(out,linebuf(j));
      setposition(out,0,0);
    end else
    if linebuf(1) = 2 then
    begin  comment logout;
      activeterminals:=activeterminals-1;
      systime(1,0,time);
      systime(4,time,r);
      write(out,<<dd dd dd>,r);
      write(out,<::                                   logout:  :>,
                <<dd>,currterminal,<:,:>);
      for j:=1 step 1 until i do outchar(out,linebuf(j));
      setposition(out,0,0);
    end else
    begin
      write(poolout,<: term = :>,<<dd>,currterminal,
                <: line = :>,<<ddd>,linecount(currterminal),<:: :>);
      for j:=1 step 1 until i do outchar(poolout,linebuf(j));
    end;
    setposition(poolout,0,0);
    if activeterminals > 0 then goto loop;
  end;

end


▶EOF◀