|
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: 7680 (0x1e00)
Types: TextFile
Names: »tasdemotxt «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦40b1eb8cd⟧
└─⟦this⟧ »tasdemotxt «
tasdemo = algol
; *** tasdemotxt ***
;
;
; et eksempel på et program der skal kommunikere med et antal terminaler
; via en terminal pool i TAS
;
; programmet er opbygget på følgende måde
;
; opret terminal pool
; loop:
; læs en linie fra poolen
; hvis input fra en ny terminal så tæl antal aktive terminal op
; skriv terminal id
; skriv linecount
; skriv teksten læst fra terminalen
; hvis afmelding fra terminal så tæl antal aktive terminaler ned
; hvis flere aktive terminal goto loop
begin
zone poolin,poolout(26,1,stderror);
real time,r;
integer i,activeterminals,maxterminals,currterminal;
long array lokalid(1:1), temname(1:2);
integer procedure createpool(z);
<* i denne procedure oprettes en terminal pool i TAS, poolens navn står i z*>
zone z;
begin
integer i;
integer array zia(1:20),sia(1:12);
zone ztem(1,1,stderror);
open(ztem,0,temname,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;
integer procedure removepool(z);
<* i denne procedure nedlægges en pool i TAS *>
zone z;
begin
integer i;
integer array zia(1:20),sia(1:12);
zone ztem(1,1,stderror);
open(ztem,0,temname,0);
getzone6(z,zia);
getshare6(ztem,sia,1);
sia(4):=92 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);
removepool:=if monitor(18,ztem,1,sia) <> 1 then -1 else sia(1);
close(ztem,true);
end removepool;
integer procedure send_cmcl(z, id, text);
zone z; long array id, text;
<*
Zone z skal være åbnet til primær output f.eks. med:
system(7)primout:(kind, name) hvor kind skal være 64 for tas-session
open(z, 0, name, 0)
eller zonen skal beskrive en terminalpulje der er oprettet af TAS.
Hvis zonen beskriver en terminalpulje skal Long array ID's tre første
tegn indeholde lokalid benyttet ved inkludering af terminal fra TAS
ellers 0.
Long array TEXT kan indeholde op til femten tegn der vil blive sendt
til TAS-mclprogram.
Result status: bit 16 session findes ikke
bit 15 pool findes ikke
*>
begin
integer pos, char;
integer array sd, gemsd(1:12);
long array field laf;
laf:=0;
getshare6(z, sd, 1);
getshare6(z, gemsd, 1);
sd(4):= 128 shift 12 + 0;
sd(5):= id(1) shift (-24) extract 24;
pos:= 1;
repeat getchar(text, pos, char);
until char = 0 or pos = 16;
pos:= pos-2;
sd(6):= pos;
sd(7):= sd(8):= sd(9):= sd(10):= sd(11):= 0;
puttext(sd.laf, 19, text, pos);
setshare6(z, sd, 1);
monitor(16)send_message:(z, 1, sd);
monitor(18)wait_answer:(z, 1, sd);
send_cmcl:= sd(4);
setshare6(z, gemsd, 1);
end;
maxterminals:=99;
activeterminals:=0;
begin
boolean luk, homeup, eraseeol, eraseeos, sosproc;
integer i,j,l;
integer array field iaf;
integer array class(1:200),linecount(0:maxterminals),alfa(0:127);
long array field laf, type;
long array linebuf(1:200), parent_name,poolname(1:2), status(1:3);
<* init diverse variable *>
iaf:=0; laf:=0; type:= 12;
luk:= false;
homeup:= false add 157;
eraseeol:= false add 158;
eraseeos:= false add 159;
temname(1):=long <:tem:>; temname(2):=0;
<* hent parent name *>
system(8)parent_descr:(i,parent_name);
sosproc:=parent_name(1) = long <:sos:>;
<* hvis input/output gennem sos skal poolnavn være tem, eller kan
det vælges frit *>
if sosproc then
poolname(1):=long <:tem:>
else
poolname(1):=long <:demo:>;
poolname(2):=long <::>;
isotable(alfa);
for i:=32 step 1 until 127 do alfa(i):= 6 shift 12 + i;
intable(alfa);
for i:=1 step 1 until maxterminals do linecount(i):=0;
<* åbn zoner til pool, 1 shift 18 i output betyder at localid fra
sidste input sættes i output message, virker både når programmet
kører gennem sos eller direkte mod tas *>
open(poolin,8,poolname,0);
open(poolout, 1 shift 18 + 8 ,poolname,0);
<* opret terminal pool *>
i:=createpool(poolin);
if i<>0 then system(9)run_time_alarm:(i,<: create pool<10>:>);
write(out,"nl",1,"sp",10,<:*** T A S D E M O S T A R T E D ***:>,"nl",2);
setposition(out, 0, 0);
loop:
<* læs en linie fra en terminal *>
l:=readall(poolin,linebuf,class,1);
setposition(poolin,0,0); <* skip resten af linien *>
<* hent localid som er de første tre tegn i input *>
lokalid(1):= linebuf(1) shift (-24) extract 24;
lokalid(1):= lokalid(1) shift 24;
write(out, <:Inddata fra :>, lokalid, <:: :>, linebuf, <:<10>:>);
<*
for i:=1 step 1 until l do begin
if class(i)=6 then
begin
integer a,b,c,d; long l;
l:=linebuf(i);
for a:=5 step -1 until 0 do
write(out,<< d>, l shift (-a*8) extract 8);
end
else write(out,<< d>,linebuf(i));
end;
*>
setposition(out,0,0);
<* localid skal have formen 00a, 01a, 02a o.s.v *>
<* beregn terminal nummer ud fra localid *>
i:=lokalid(1) shift (-40);
i:=if i>48 then i-48 else 0;
j:=(lokalid(1) shift (-32) extract 8)-48;
currterminal:=i*10 + j;
<* tæl antal linier fra terminalen *>
linecount(currterminal):=linecount(currterminal)+1;
if linebuf(2) = 1 then
begin <* login fra en terminal, linien består af
<localid><1><1> att <terminal navn><10>*>
linecount(currterminal):=0;
write(poolout, homeup, 4, eraseeos, 4,
<:tas demoprogram ready<10>:>);
setposition(poolout,0,0);
activeterminals:=activeterminals+1;
systime(1,0,time);
systime(4,time,r);
write(out,<<dd dd dd>,r);
write(out,<:: login: :>,<<dd>,currterminal,<:,:>,linebuf.type,"nl",1);
setposition(out,0,0);
end else
if linebuf(2) = 2 then
begin <* logout fra terminal, linien består af
<localid><2><2> out<10>
eller
<localid><2><2> hard error<10> *>
activeterminals:=activeterminals-1;
systime(1,0,time);
systime(4,time,r);
write(out,<<dd dd dd>,r);
write(out,<:: logout: :>,<<dd>,currterminal,<:,:>,linebuf.type,"nl",1);
setposition(out,0,0);
end else
begin
<* linien er en tekst linie
en * først på linien opfattes som slut kommando
en + først på linien opfattes som program afslutnings kommando *>
if linebuf(1) shift 24 = long <:*:> <* Slut *> or
linebuf(1) shift 24 = long <:+:> <* Nedluk *> then
begin
if linebuf(1) shift 24 = long <:+:> <* Nedluk efter sidste logout *>
then luk:= true;
write(poolout, <:Farvel<10>:>);
setposition(poolout,0,0);
status(1):= if linebuf(1) shift 24 = long <:+:> then
long <:luk:> else long <:slut:>;
status(2):=status(3):=0;
send_cmcl(poolout, lokalid, status);
end
else
begin
write(poolout, <: term = :>,<<dd>,currterminal,
<: line = :>,<<ddd>,linecount(currterminal),<:: :>,
linebuf, "nl",1);
setposition(poolout,0,0);
end;
end;
if activeterminals = 0 and luk then <* Ingenting *>
else goto loop;
end;
removepool(poolin);
close(poolin,true); close(poolout,true);
end
▶EOF◀