DataMuseum.dk

Presents historical artifacts from the history of:

CP/M

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about CP/M

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦904e4f16f⟧ TextFile

    Length: 2560 (0xa00)
    Types: TextFile
    Names: »GETMESS.PAS«

Derivation

└─⟦d814f614c⟧ Bits:30008872 EDB Trænings- og Erhvervs Center / Almen Nyttig Data Service
    └─⟦this⟧ »GETMESS.PAS« 

TextFile


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»