home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / TP-UTIL.ARK / ITERM.PAS < prev    next >
Pascal/Delphi Source File  |  1986-01-06  |  11KB  |  283 lines
  1.  
  2.  
  3. {--------------------------------------------------------------}
  4. {                            ITERM                             }
  5. {                      by Jeff Duntemann                       }
  6. {                                                              }
  7. {           Interrupt-driven terminal program testbed          }
  8. {                                                              }
  9. {                                 V2.01 CP/M Turbo Pascal V2.0 }
  10. {                                 Last Update 12/6/84          }
  11. {                                                              }
  12. {--------------------------------------------------------------}
  13.  
  14. PROGRAM ITERM;
  15.  
  16.  
  17. CONST  BAUD_PORT = $00;       { SIO Baud rate control port on 820-II }
  18.        CTRL_PORT = $06;       { SIO control port on 820-II }
  19.        DATA_PORT = $04;       { SIO data port on 820-II }
  20.        INT_LOC  = $F800;      { Address of SIO interrupt routine  }
  21.        INT_BASE = $FF00;      { Base of mode 2 interrupt vector table }
  22.  
  23.             { RING BUFFER INTERRUPT SERVICE ROUTINE }
  24. { This routine is an interrupt routine for incoming serial port data.    }
  25. { This routine executes each time the SIO chip fills up with a complete  }
  26. { data character from the RS232 line.  The character is put in a ring    }
  27. { buffer and a buffer pointer incremented.  The buffer and pointer are   }
  28. { absolute variables that were previously defined at a particular place  }
  29. { in high memory. }
  30.  
  31.        ROUTINE : ARRAY[0..29] OF BYTE =
  32.         ($F5,             { PUSH AF           Save accumulator   }
  33.          $E5,             { PUSH HL           Save HL register   }
  34.          $F3,             { DI                Disable interrupts }
  35.          $2A,$19,$F8,     { LD  HL,(LAST_SAVED)   Get current count  }
  36.          $DB,$04,         { IN  A,(04H)       Get the incoming character }
  37.          $77,             { LD  HL,A          Store it in the buffer     }
  38.          $23,             { INC HL            Bump insertion pointer     }
  39.          $CB,$64,         { BIT 4,H           Make ring                  }
  40.          $28,$03,         { JR  Z,SIOINTL     Relative jump 3 forward    }
  41.          $21,$00,$C3,     { LD  HL,$C300      over reload of buffer head }
  42.          $22,$19,$F8,     { LD  (LAST_SAVED),HL   SIOINTL: Save counter  }
  43.          $E1,             { POP HL            Restore HL register        }
  44.          $F1,             { POP AL            Restore accumulator        }
  45.          $FB,             { EI                Re-enable interrupts       }
  46.          $ED,$4D,         { RETI              Return from routine        }
  47.          $00,$C3,         { DW $C300          LAST_SAVED                 }
  48.          $00,$C3,         { DW $C300          LAST_READ                  }
  49.          $00);
  50.  
  51. TYPE
  52.  
  53.    STRING80 = STRING[80];
  54.    CODE_BLOCK = ARRAY[0..63] OF BYTE;
  55.    VECT_ARRAY = ARRAY[0..7] OF INTEGER;
  56.  
  57. VAR I,J,K    : INTEGER;
  58.     CH       : CHAR;
  59.     NOSHOW   : SET OF BYTE;
  60.     PARITY   : INTEGER;  { 0=no parity; 1=odd parity; 2=even parity }
  61.     PARITAG  : ARRAY[0..2] OF STRING[8];       { Holds parity tags  }
  62.     OK       : BOOLEAN;
  63.     HIBAUD   : BOOLEAN;    { TRUE = using 1200 baud, else 300 baud    }
  64.     QUIT     : BOOLEAN;    { Flag for exiting the terminal loop     }
  65.     DUMMY    : STRING80;
  66.  
  67.     { The following variables all support the interrupt-driven ring buffer: }
  68.  
  69.     INT_CODE : CODE_BLOCK ABSOLUTE INT_LOC; { Holds ring buffer serv. routine }
  70.     INT_VECT    : INTEGER ABSOLUTE $FF02;
  71.     LAST_READ   : INTEGER ABSOLUTE $F81B;   { Offset of last char. read   }
  72.     LAST_SAVED  : INTEGER ABSOLUTE $F819;   { Offset of last char. saved  }
  73.     RINGPTR     : ^CHAR   ABSOLUTE $F81B;   { ON TOP OF LAST_READ! }
  74.     VECT_TBL    : VECT_ARRAY ABSOLUTE $FF00;   { SIO interrupt jump tbl   }
  75.  
  76.  
  77. {<<<INCHAR>>>}
  78. { This function is called AFTER function INSTAT has determined that a char   }
  79. { is ready to be read from the ring buffer.  The char at LAST_READ/RINGPTR   }
  80. { (the two are the same) is assigned to INCHAR's function value.  Then the   }
  81. { value of LAST_READ is bumped by one via SUCC.  If the value of LAST_READ   }
  82. { is found to have gone over the high ring buffer boundary of $CFFF to $D000 }
  83. { then LAST_READ is "rolled over" to become $C300 (the low boundary of the   }
  84. { buffer) again.  When LAST_READ "catches up to" LAST_SAVED (by being =) the }
  85. { ring buffer is considered empty. }
  86.  
  87. FUNCTION INCHAR : CHAR;
  88.  
  89. BEGIN
  90.   INCHAR := RINGPTR^;                 { Grab a character from the ring buffer }
  91.   LAST_READ := SUCC(LAST_READ);       { Increment the pointer; check bounds:  }
  92.   IF LAST_READ >= $D000 THEN LAST_READ := $C300  { Correct if it hits $D000   }
  93. END;
  94.  
  95.  
  96. {<<<INSTAT>>>}
  97. { This function determines if there is a new character to be read from the   }
  98. { ring buffer.  There are two pointers into the ring buffer:  LAST_SAVED,    }
  99. { and LAST_READ.  LAST_SAVED is the address of the last character placed     }
  100. { into the buffer by the SIO interrupt service routine.  LAST_READ is the    }
  101. { address of the last character read from the ring buffer.  When the two are }
  102. { equal, the last character read was the last character saved, so we know we }
  103. { have read all the characters that have been placed into the buffer.  Only  }
  104. { when LAST_SAVED gets "ahead" of LAST_READ must we read characters from the }
  105. { ring buffer again.  These two pointers chase each other around and around  }
  106. { the ring.  As the ring buffer is just a hair over 3300 bytes long,         }
  107. { LAST_SAVED can get WAAAAY ahead of LAST_READ before there's trouble in     }
  108. { River City.  On the other hand, if this ever happens, there will be no     }
  109. { warning.  Just trouble.                                                    }
  110.  
  111. FUNCTION INSTAT : BOOLEAN;
  112.  
  113. BEGIN
  114.   IF LAST_SAVED <> LAST_READ THEN INSTAT := TRUE
  115.     ELSE INSTAT := FALSE
  116. END;
  117.  
  118.  
  119. PROCEDURE OUTCHR(CH : CHAR);
  120.  
  121. BEGIN                              { Loop until TBMT goes high }
  122.   REPEAT I := PORT[CTRL_PORT] UNTIL (I AND $04) <> 0;
  123.   PORT[DATA_PORT]:=ORD(CH)         { Then send char out the port }
  124. END;
  125.  
  126.  
  127. PROCEDURE SET_7_BITS;
  128.  
  129. BEGIN
  130.   PORT[CTRL_PORT]:=$13;                  { Select write register 3 }
  131.   PORT[CTRL_PORT]:=$41;                  { 7 bits per RX char, enable RX}
  132.   PORT[CTRL_PORT]:=$15;                  { Select write register 5 }
  133.   PORT[CTRL_PORT]:=$AA                   { 7 bits per TX char, enable TX}
  134. END;
  135.  
  136.  
  137. PROCEDURE SET_8_BITS;
  138.  
  139. BEGIN
  140.   PORT[CTRL_PORT]:=$13;                  { Select write register 3 }
  141.   PORT[CTRL_PORT]:=$C1;                  { 8 bits per RX char, enable RX}
  142.   PORT[CTRL_PORT]:=$15;                  { Select write register 5 }
  143.   PORT[CTRL_PORT]:=$EA                   { 8 bits per TX char, enable TX}
  144. END;
  145.  
  146.  
  147.  
  148. PROCEDURE SET_PARITY(PARITY : INTEGER);
  149.  
  150. BEGIN
  151.   PORT[CTRL_PORT]:=$14;                  { Select SIO Register 4 }
  152.   CASE PARITY OF                         { All 3: 16X clock, 1 stop }
  153.     0 : PORT[CTRL_PORT]:=$44;            { 0=No parity }
  154.     1 : PORT[CTRL_PORT]:=$45;            { 1=Odd parity }
  155.     2 : PORT[CTRL_PORT]:=$47;            { 2=Even parity }
  156.    ELSE PORT[CTRL_PORT]:=$47;            { Defaults to even parity }
  157.   END; { CASE }
  158. END;
  159.  
  160.  
  161. PROCEDURE INT_ENABLE;
  162.  
  163. BEGIN
  164.   PORT[CTRL_PORT] := $11;                { Select write register 1 }
  165.   PORT[CTRL_PORT] := $18                 { and turn interrupts on  }
  166. END;
  167.  
  168.  
  169. PROCEDURE INT_DISABLE;
  170.  
  171. BEGIN
  172.   PORT[CTRL_PORT] := $01;                { Select write register 1 }
  173.   PORT[CTRL_PORT] := $00                 { and disable interrupts  }
  174. END;
  175.  
  176.  
  177. {<<<INT_SETUP>>>}
  178.  
  179. PROCEDURE INT_SETUP;
  180.  
  181. BEGIN
  182.   FILLCHAR(INT_CODE,SIZEOF(INT_CODE),CHR(0));  { Zero array to hold routine  }
  183.   FOR I := 0 TO 29 DO                          { Move the routine out of the }
  184.     INT_CODE[I] := ROUTINE[I];                 { constant into the array.    }
  185.   FOR I := 0 TO 7 DO VECT_TBL[I] := ADDR(INT_CODE);
  186.   INT_ENABLE;                             { Finally, enable SIO interrupts.  }
  187. END;
  188.  
  189.  
  190. {>>>>INITSIO<<<<<}
  191.  
  192. PROCEDURE INITSIO(HIBAUD : BOOLEAN; PARITY : INTEGER);
  193.  
  194. BEGIN
  195.   SET_PARITY(PARITY);            { Set parity }
  196.   SET_7_BITS;                    { Set SIO to 7 bits RX/TX }
  197.   IF HIBAUD THEN                 { Set baud rate: }
  198.     PORT[BAUD_PORT]:=$07         { 1200 baud code to baud port  }
  199.   ELSE PORT[BAUD_PORT]:=$05;     { 300 baud code to baud port   }
  200.   WRITE('<Changing to ');
  201.   IF HIBAUD THEN WRITELN('1200 baud>') ELSE WRITELN('300 baud>')
  202. END;  { INITSIO }
  203.  
  204.  
  205. FUNCTION GET_KEY : CHAR;
  206.  
  207. BEGIN
  208.   GET_KEY := CHR(BDOS(6,255))
  209. END;
  210.  
  211.  
  212. {>>>>CLEAR_BIT<<<<<<}
  213.  
  214. PROCEDURE CLEAR_BIT(VAR CH : CHAR; BIT : INTEGER);
  215.  
  216. VAR I,J : INTEGER;
  217.  
  218. BEGIN
  219.   I := NOT(1 SHL BIT);             { Create a bit mask }
  220.   J := ORD(CH) AND I;
  221.   CH := CHR(J)
  222. END;
  223.  
  224.  
  225.  
  226. {>>>>INIT_ITERM<<<<}
  227.  
  228. PROCEDURE INIT_ITERM;
  229.  
  230. BEGIN
  231.   NOSHOW:=[0,127];                  { Don't display these! }
  232.   PARITY:=2;                        { Defaults to even parity }
  233.   PARITAG[0]:='No'; PARITAG[1]:='Odd'; PARITAG[2]:='Even';
  234.   HIBAUD := TRUE;                   { Defaults to 1200 baud }
  235.   INITSIO(HIBAUD,PARITY);           { Do init on serial port A }
  236.   INT_SETUP                         { Init interrupt system }
  237. END;  { INIT_TERM }
  238.  
  239.  
  240.  
  241. BEGIN                 {**** ITERM MAIN ****}
  242.   LOWVIDEO;
  243.   INIT_ITERM;         { Do inits on variables & hardware }
  244.   CLRSCR;             { Clear screen }
  245.  
  246.   QUIT:=FALSE;        { Init flag for terminal exit  }
  247.  
  248.   REPEAT              { Can only be exited by CTRL/E }
  249.  
  250.     IF INSTAT THEN                        { If a char has come }
  251.       BEGIN                               { from the serial port }
  252.         CH := INCHAR;                     { Go get it from the port; }
  253.         CLEAR_BIT(CH,7);                  { Scuttle the parity bit; }
  254.         IF NOT (ORD(CH) IN NOSHOW) THEN WRITE(CH);  { Write CH to the CRT   }
  255.       END;     { Incoming character handling }
  256.  
  257.     CH:=GET_KEY;                { See if a char was typed }
  258.     IF ORD(CH)<>0 THEN          { If non-zero, char was typed  }
  259.  
  260.       CASE ORD(CH) OF           { Parse the typed character    }
  261.  
  262.         5 : QUIT:=TRUE;         { CTRL-E: Raise flag to exit }
  263.  
  264.        17 : BEGIN               { CTRL-Q: Step through parity  }
  265.               IF PARITY=2 THEN PARITY:=0 ELSE PARITY:=PARITY+1;
  266.               INITSIO(HIBAUD,PARITY);
  267.               WRITELN('<NOW USING ',PARITAG[PARITY],' PARITY>')
  268.             END;
  269.  
  270.        18 : BEGIN              { CTRL-R: Toggle baud rate     }
  271.               HIBAUD:=NOT HIBAUD;
  272.               INITSIO(HIBAUD,PARITY)
  273.             END;
  274.  
  275.        26 : CLRSCR;            { CTRL-Z: Clear CRT }
  276.  
  277.        ELSE OUTCHR(CH);        { Send all others to modem,    }
  278.       END   { CASE }
  279.  
  280.   UNTIL QUIT;
  281.   INT_DISABLE;                 { Turn off SIO interrupts...    }
  282. END.  { ITERM }                { ...and blow this crazyhouse...}
  283.