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 / PORTMNIO.PAS < prev    next >
Pascal/Delphi Source File  |  2000-06-30  |  12KB  |  410 lines
  1.  
  2. PROGRAM PortMonitor;
  3.  
  4. {
  5.    General purpose I/O Port monitor
  6.    Written by Jesse Bob Overholt, Carrollton, Texas
  7.    Copyright (c) 1985, but you can have a copy if you want one!
  8.  
  9.    DDT and its various relatives does't provide much for examining and
  10.    changing I/O ports under CP/M. When I found myself in need of that
  11.    capability I turned (naturally) to Turbo Pascal and cranked out
  12.    this little program. It should work without pain on most CP/M
  13.    systems, and with a little effort maybe even on 16 bitters.
  14.  
  15.    You'll want to change the constants to set the control codes used for
  16.    cursor movement. These are for Montezuma Micro CP/M 2.2 on a TRS-80
  17.    Model 4/4P.
  18.  
  19.    Operation is simple. Select the port by moving the cursor to it. Then
  20.    specify changes by entering the first letter of the item to change.
  21.    For example, type 'P' to set the port number, then enter the number
  22.    in hex. Port numbers are always entered in hex, but data entry
  23.    follows the Type set for the port.
  24.  
  25.    Commands:
  26.       P = Set Port address (in hex)
  27.       M = Set port Mode (I for Input, O for Output)
  28.       D = Set port Data (value entered according to type)
  29.       T = Set port Type (D for Decimal, H for Hex, B for Binary)
  30.       ENTER or RETURN = Do the actual I/O and display data if input
  31.       S = Scan port to perform continous I/O until 'space' entered
  32.       BREAK or ^C = Exit back to CP/M
  33.  
  34.    The real problem with quick and dirty software tools is that they
  35.    are always under-documented. This program is no exception, and I'll
  36.    leave it for you to decide how self-documenting Pascal really is.
  37.  
  38.    Having spent many years in software support for pay the author is not
  39.    all that excited about phone calls with gripes, enhancements, etc. If
  40.    you really need to contact me you can try CompuServe 70130,101 or send
  41.    a SASE to 3139 Oak Hill Road, Carrollton, TX  75007.
  42.  
  43. Modifications:
  44.  14 July 85 by Gail Graham W5MLY
  45.   Continous scan until keypressed added.
  46.  
  47. }
  48.  
  49. CONST
  50.    Up = ^K;       {Kimtron KT-7 and/or (Televideo 925)}
  51.    Down = ^J;
  52.    Left = ^H;
  53.    Right = ^L;
  54.    Break = ^Q;
  55.    Enter = ^M;
  56.    Beep = ^G;
  57.  
  58. TYPE
  59.    PortSet = SET OF 0..15;
  60.    Modes = (Input, Output);
  61.    DisplayTypes = (Binary, Hex, Decimal);
  62.    KeyList = SET OF CHAR;
  63.    InputLine = STRING[8];
  64.    DispLine = STRING[8];
  65.  
  66. VAR
  67.    CurPort, CurVal, CurX, CurY: BYTE;
  68.    DefinedPorts: PortSet;
  69.    PortAddress, PortData: ARRAY [0..15] OF BYTE;
  70.    PortMode: ARRAY [0..15] OF Modes;
  71.    PortType: ARRAY [0..15] OF DisplayTypes;
  72.    KeyBuf: CHAR;
  73.    BreakRequested: BOOLEAN;
  74.  
  75. {-------------------------------------------------------------------------}
  76.  (* Following Keypressed function replaces the KeyPressed Function in
  77.     Turbo Pascal, and is for use only with the NEC-APC. The Turbo Pascal
  78.     keypressed function does not work on the NEC-APC. If your keypressed
  79.     function does not work and you do not have a NEC, then you will have to
  80.     write a similar replacement function to match your machine. If your
  81.     keypressed function does work then this entire function may be deleted.
  82.     The function is included as a remark so it will not compile normally. *)
  83.  
  84.  
  85.  (*
  86. Function  KEYPRESSED:BOOLEAN;
  87. VAR
  88.  KEYSTAT:byte;
  89. BEGIN
  90.  KeyStat  := Port[$4C] and $10;
  91.  If KeyStat <> 0 then keypressed  := true else keypressed  := false;
  92. end;
  93.   *)
  94.  
  95. {-------------------------------------------------------------------------}
  96.  
  97. PROCEDURE SetXY (DescNum: BYTE);
  98.  
  99. BEGIN
  100.    CurY := (CurPort DIV 4) * 5 + 5;
  101.    CurX := (CurPort MOD 4) * 20 + 1;
  102. END;
  103.  
  104. {-------------------------------------------------------------------------}
  105.  
  106. FUNCTION GetKey (LegalKeys: KeyList): CHAR;
  107.  
  108. VAR
  109.    InKey: CHAR;
  110.  
  111. CONST
  112.    Printable: SET OF CHAR = [#$20..#$7E];
  113.  
  114. BEGIN
  115.    REPEAT
  116.       Read(Kbd,InKey);
  117.       InKey := UpCase(InKey);
  118.    UNTIL InKey IN LegalKeys;
  119.    IF InKey IN Printable THEN Write(InKey);
  120.    GetKey := InKey;
  121. END;
  122.  
  123. {-------------------------------------------------------------------------}
  124.  
  125. FUNCTION GetLine (Length: BYTE; ValidKeys: KeyList): InputLine;
  126.  
  127. VAR
  128.    Buffer: InputLine;
  129.    CurLen: BYTE;
  130.    InKey: CHAR;
  131.  
  132. { Local } PROCEDURE BackSpace;
  133.           BEGIN
  134.              Write(^H,'_',^H);
  135.              Delete (Buffer, CurLen, 1);
  136.              CurLen := CurLen - 1;
  137.           END;
  138.  
  139. BEGIN
  140.    CurLen := 0;
  141.    WHILE CurLen < Length DO
  142.    BEGIN
  143.       Write('*');
  144.       CurLen := CurLen + 1;
  145.    END;
  146.    WHILE CurLen > 0 DO BackSpace;
  147.    Buffer := '';
  148.    REPEAT
  149.       InKey := GetKey (ValidKeys + [^H, ^X]);
  150.       CASE InKey OF
  151.          ^H: IF CurLen > 0 THEN BackSpace;
  152.          ^X: WHILE CurLen > 0 DO BackSpace;
  153.       ELSE
  154.          BEGIN
  155.             Buffer := Buffer + InKey;
  156.             CurLen := CurLen + 1;
  157.          END;
  158.       END;
  159.    UNTIL CurLen = Length;
  160.    GetLine := Buffer;
  161. END;
  162.  
  163. {-------------------------------------------------------------------------}
  164.  
  165. FUNCTION GetHex: BYTE;
  166.  
  167. VAR
  168.    InBuf: InputLine;
  169.  
  170. { Local } FUNCTION HexVal (Digit: CHAR): BYTE;
  171.           VAR
  172.              DigitVal: BYTE;
  173.           BEGIN
  174.              DigitVal := Ord(Digit) - Ord('0');
  175.              IF DigitVal > 15 THEN DigitVal := DigitVal - 7;
  176.              HexVal := DigitVal;
  177.           END;
  178.  
  179. BEGIN
  180.    InBuf := GetLine (2, ['0'..'9']+['A'..'F']);
  181.    GetHex := HexVal(InBuf[1]) SHL 4 + HexVal(InBuf[2]);
  182. END;
  183.  
  184. {-------------------------------------------------------------------------}
  185.  
  186. FUNCTION GetDec: BYTE;
  187.  
  188. VAR
  189.    InBuf: InputLine;
  190.    I, Value: INTEGER;
  191.  
  192. BEGIN
  193.    REPEAT
  194.       InBuf := GetLine (3, ['0'..'9']);
  195.       Val(InBuf, Value, I);
  196.       IF Value > 255 THEN I := 1;
  197.       IF I > 0 THEN Write(^H,^H,^H,Beep);
  198.    UNTIL I = 0;
  199.    GetDec := Value;
  200. END;
  201.  
  202. {-------------------------------------------------------------------------}
  203.  
  204. FUNCTION GetBin: BYTE;
  205.  
  206. VAR
  207.    Value: BYTE;
  208.    InBuf: InputLine;
  209.  
  210. BEGIN
  211.    Value := 0;
  212.    InBuf := GetLine (8, ['0'..'1']);
  213.    WHILE Length(InBuf) > 0 DO
  214.    BEGIN
  215.       Value := Value SHL 1;
  216.       IF InBuf[1] = '1' THEN Value := Value + 1;
  217.       Delete (InBuf, 1, 1);
  218.    END;
  219.    GetBin := Value;
  220. END;
  221.  
  222. {-------------------------------------------------------------------------}
  223.  
  224. FUNCTION CvtBin: DispLine;
  225.  
  226. VAR
  227.    Buffer: DispLine;
  228.    Value: BYTE;
  229.  
  230. BEGIN
  231.    Buffer := '';
  232.    Value := PortData[CurPort];
  233.    REPEAT
  234.       IF Odd(Value) THEN Buffer := '1' + Buffer
  235.       ELSE Buffer := '0' + Buffer;
  236.       Value := Value SHR 1;
  237.    UNTIL Length(Buffer) = 8;
  238.    CvtBin := Buffer;
  239. END;
  240.  
  241. {-------------------------------------------------------------------------}
  242.  
  243. FUNCTION CvtHex: DispLine;
  244.  
  245. VAR
  246.    Buffer: DispLine;
  247.  
  248. { Local } FUNCTION HexDig (Value: BYTE): CHAR;
  249.           BEGIN
  250.              Value := Value + Ord('0');
  251.              IF Value > Ord('9') THEN Value := Value + 7;
  252.              HexDig := Chr(Value);
  253.           END;
  254.  
  255. BEGIN
  256.    CvtHex := HexDig(PortData[CurPort] SHR 4)
  257.            + HexDig(PortData[CurPort] AND $0F);
  258. END;
  259.  
  260. {-------------------------------------------------------------------------}
  261.  
  262. PROCEDURE DisplayData;
  263.  
  264. BEGIN
  265.    GotoXY(CurX+10,CurY+2); Write('        ',^H^H^H^H^H^H^H^H);
  266.    CASE PortType[CurPort] OF
  267.       Binary: Write(CvtBin);
  268.       Hex: Write(CvtHex);
  269.       Decimal: Write(PortData[CurPort]:3);
  270.    END;
  271. END;
  272.  
  273. {-------------------------------------------------------------------------}
  274.  
  275. BEGIN
  276.  
  277. { Set up opening banner }
  278.    ClrScr;
  279.    LowVideo;
  280.    ClrEol; GotoXY(10,1); Writeln('CCP/M Port Monitor Version 0.02');
  281.    Writeln('     (c) (p) 1985  by Jessie Overholt and modified by others');
  282.  
  283.    NormVideo;
  284.    Write('    Arrows to select, <P,M,D,T> to set up, ');
  285.    Writeln('<RETURN> for I/O, <BREAK> to quit');
  286.    Writeln('<S> to scan assigned ports, <any key> to stop scan');
  287. { Build Port desciptors }
  288.    FOR CurPort := 0 TO 15 DO
  289.    BEGIN
  290.       SetXY (CurPort);
  291.       GotoXY(CurX, CurY); Write('[ ] ');
  292.       LowVideo; Write('Port:');
  293.       GotoXY(CurX+4,CurY+1); Write('Mode:');
  294.       GotoXY(CurX+4,CurY+2); Write('Data:');
  295.       GotoXY(CurX+4,CurY+3); Write('Type:');
  296.       NormVideo;
  297.       GotoXY(CurX+10,CurY); Write('??');
  298.       GotoXY(CurX+10,CurY+1); Write('Input');
  299.       GotoXY(CurX+10,CurY+2); Write('00');
  300.       GotoXY(CurX+10,CurY+3); Write('Hex');
  301.       PortAddress[CurPort] := $00;
  302.       PortMode[CurPort] := Input;
  303.       PortData[CurPort] := $00;
  304.       PortType[CurPort] := Hex;
  305.    END;
  306.    DefinedPorts := [];
  307.    CurPort := 0;
  308.    BreakRequested := FALSE;
  309.  
  310. { Begin main command loop }
  311.    REPEAT
  312.       SetXY (CurPort); GotoXY(CurX+1, CurY);
  313.       Read (Kbd,KeyBuf);
  314.       CASE UpCase(KeyBuf) OF
  315.          Up: CurPort := (CurPort - 4) AND $0F;
  316.          Down: CurPort := (CurPort + 4) AND $0F;
  317.          Left: CurPort := (CurPort - 1) AND $0F;
  318.          Right: CurPort := (CurPort + 1) AND $0F;
  319.          Break: BreakRequested := TRUE;
  320.          'P': BEGIN
  321.                  GotoXY(CurX+10,CurY);
  322.                  PortAddress[CurPort] := GetHex;
  323.                  DefinedPorts := DefinedPorts + [CurPort];
  324.               END;
  325.          'M': BEGIN
  326.                  GotoXY(CurX+10,CurY+1); Write('? I/O ',^H^H^H^H^H^H);
  327.                  IF GetKey(['I','O']) = 'I' THEN
  328.                  BEGIN
  329.                     Write('nput ');
  330.                     PortMode[CurPort] := Input;
  331.                  END
  332.                  ELSE
  333.                  BEGIN
  334.                     Write('utput');
  335.                     PortMode[CurPort] := Output;
  336.                  END;
  337.               END;
  338.          'D': BEGIN
  339.                  GotoXY(CurX+10,CurY+2);
  340.                  Write('        ',^H^H^H^H^H^H^H^H);
  341.                  CASE PortType[CurPort] OF
  342.                     Binary: PortData[CurPort] := GetBin;
  343.                     Hex: PortData[CurPort] := GetHex;
  344.                     Decimal: PortData[CurPort] := GetDec;
  345.                  END;
  346.               END;
  347.          'T': BEGIN
  348.                  GotoXY(CurX+10,CurY+3); Write('? B/H/D',^H^H^H^H^H^H^H);
  349.                  CASE GetKey(['B','H','D']) OF
  350.                     'B': BEGIN
  351.                             Write('inary  ');
  352.                             PortType[CurPort] := Binary;
  353.                          END;
  354.                     'H': BEGIN
  355.                             Write('ex     ');
  356.                             PortType[CurPort] := Hex;
  357.                          END;
  358.                     'D': BEGIN
  359.                             Write('ecimal ');
  360.                             PortType[CurPort] := Decimal;
  361.                          END;
  362.                  END;
  363.                  DisplayData;
  364.               END;
  365.  
  366.            'S':BEGIN
  367.                 Delay(300); (* allow keypressed time to clear *)
  368.                 WHILE not keypressed  DO
  369.                  BEGIN
  370.                   DELAY(500);
  371.                   FOR CurPort  := 0 to 15 do
  372.                    BEGIN
  373.                     IF CurPort IN DefinedPorts THEN
  374.                      BEGIN
  375.                        SetXY(CurPort);
  376.                        GotoXY(CurX,CurY);
  377.                        CASE PortMode[CurPort] OF
  378.                          Input: BEGIN
  379.                                    PortData[CurPort] :=
  380.                                       Port[PortAddress[CurPort]];
  381.                                    DisplayData;
  382.                                 END;
  383.                          Output: Port[PortAddress[CurPort]] :=
  384.                                     PortData[CurPort];
  385.                       END;
  386.                      END;
  387.                     END;
  388.                  END;
  389.                 END;
  390.          Enter: BEGIN
  391.                    IF CurPort IN DefinedPorts THEN
  392.                    BEGIN
  393.                       CASE PortMode[CurPort] OF
  394.                          Input: BEGIN
  395.                                    PortData[CurPort] :=
  396.                                       Port[PortAddress[CurPort]];
  397.                                    DisplayData;
  398.                                 END;
  399.                          Output: Port[PortAddress[CurPort]] :=
  400.                                     PortData[CurPort];
  401.                       END;
  402.                    END
  403.                  ELSE Write(Beep);
  404.                 END;
  405.       END;
  406.    UNTIL BreakRequested;
  407.    ClrScr;
  408.  
  409. END.
  410.