|
|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 2560 (0xa00)
Types: TextFile
Names: »GETMESS.PAS«
└─⟦d814f614c⟧ Bits:30008872 EDB Trænings- og Erhvervs Center / Almen Nyttig Data Service
└─⟦this⟧ »GETMESS.PAS«
PROCEDURE forsink;
VAR ix,jx:INTEGER;
BEGIN
ix:=1;
WHILE ix <= porteÆ1Å.spildtid DO
BEGIN
ix:=ix+1;
WHILE jx <= porteÆ1Å.ctcdiv DO jx:=jx+1;
END;
END;
PROCEDURE lesuntilbell;
CONST timout=20000;
VAR tegn:CHAR;
max,delay,delay2:INTEGER;
BEGIN
max:=noct; noct:=0;
tegn:=chr(0);
delay2:=6;
WHILE tegn<>chr(7) DO
BEGIN
delay:=0;
WHILE NOT statp(cport,1) DO
IF delay<timout THEN
BEGIN
delay:=succ(delay);
IF (dip=chr(27)) THEN exit;
END ELSE
IF delay2=0 THEN
BEGIN
noct:=0; exit
END ELSE
BEGIN
delay2:=pred(delay2); delay:=0;
END;
tegn:=chr(inport(dport));
IF (tegn=chr(7)) OR (tegn=chr(29)) OR (tegn=chr(30)) OR (tegn=chr(31)) OR
((tegn>chr(31)) AND (tegn<chr(127))) THEN
BEGIN
noct:=succ(noct);
IF noct<=max THEN pbuf^ÆnoctÅ:=tegn;
END;
END;
END;
PROCEDURE getmess;
CONST timout=20000;
LABEL 999;
VAR
tegn,status,jx,
retrans,wtid,delay:INTEGER;
notslut:BOOLEAN;
PROCEDURE spildlidt;
VAR iz:INTEGER;
BEGIN
iz:=1;
WHILE iz<=wtid DO
BEGIN
iz:=succ(iz);
IF dip=chr(27) THEN BEGIN noct:=0; GOTO 999; END;
END;
delay:=succ(delay);
END;
BEGIN
dport:=porteÆ1Å.portnr;
cport:=dport+2;
retrans:=0;
wtid:=porteÆ1Å.spildtid;
REPEAT
jx:=1;
WHILE (jx<=length(comlin)) DO
BEGIN
delay:=0;
tegn:=ord(comlinÆjxÅ);
WHILE NOT tstbit(inpÆ(cport)Å,2) DO
IF delay<timout THEN
BEGIN
spildlidt;
END ELSE exit;
IF porteÆ1Å.spildtid > 0 THEN forsink;
outÆ(dport)Å:=tegn;
jx:=jx+1;
END;
wtid:=0; tegn:=0;
notslut:=TRUE;
IF NOT tstbit(modebit,3) THEN
(*tøm inputbuffer for ekko*)
WHILE (tegn<>10) AND notslut DO
BEGIN
delay:=0;
WHILE (NOT tstbit(inpÆ(cport)Å,0)) AND notslut DO
IF delay<timout THEN
BEGIN
spildlidt;
END ELSE
BEGIN
retrans:=succ(retrans);
comlin:=concat(chr(26),chr(cr));
notslut:=FALSE;
END;
IF notslut THEN
BEGIN
tegn:=inpÆ(dport)Å;
clrbit(tegn,7);
END;
END;
UNTIL notslut OR (retrans=6);
IF retrans>0 THEN exit;
lesuntilbell; (*hent post*)
999:
END;
«eof»