home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol027 / contests.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-02-10  |  29.5 KB  |  928 lines
  1. PROGRAM ATS_MONITOR;
  2. {$I+}
  3.      {This program will act as the user interface to the 
  4.      ATS confidence test programs.  A menu is first displayed
  5.      after which the user is prompt for the tests to be run and
  6.      the repetitions.
  7.  
  8.      written 9-12-80     d.a. steele
  9.      last update = 20 Feb 81 
  10.      }
  11.  
  12. CONST
  13.      HEAD_1         =    'ATS Confidence Test   Ver 1.0';
  14.      TMSG_1         =    ' 1. MCP CPU           ';
  15.      TMSG_2         =    ' 2. MCP RAM           ';
  16.      TMSG_3         =    ' 3. Disk Drive System ';
  17.      TMSG_4         =    ' 4. Serial Ports      ';
  18.      TMSG_5         =    ' 5. MCP APU           ';
  19.      TMSG_6         =    ' 6. MCP Data Link     ';
  20.      TMSG_7         =    ' 7. GCP Data Down-load';
  21.      TMSG_8         =    ' 8. Plasma Panel      ';
  22.      TMSG_9         =    ' 9. Touch Panel       ';
  23.      TMSG_10        =    '10. Keyboard          ';
  24.      TMSG_11        =    '11. GCP CPU           ';
  25.      TMSG_12        =    '12. GCP RAM           ';
  26.      TMSG_13        =    '13. GCP EPROM         ';
  27.      TMSG_14        =    '14. GCP APU           ';
  28.      GTEST_MSG      =    'Enter numbers seperated by spaces "0" for all..';
  29.      SPACES         =    '         ';
  30.      NO_OF_TESTS    =    14;
  31.      FAIL_MSG       =    'Failures';
  32.      REP_MSG        =    ' Repetitions';
  33.      SEL_TESTS      =    'Selected tests';
  34.      OKAY           =    'OKAY ?';
  35.      PASS           =    ' Passed';
  36.      FAIL           =    ' Failed';
  37. type
  38.      DEVICE_SET     =    set of char;
  39. VAR
  40.      X,Y            : integer;{used for indexing}
  41.      REPS           : integer;{The number of repatitions to be done}
  42.      REPS_DONE      : integer;{The number of reps that have been completed}
  43.      TEST_ERRORS    : integer;{The error flags returned from test routines}
  44.      TEST_NUM       : integer;
  45.      TEST_FLAGS     : array [1..NO_OF_TESTS] of boolean; {Indicates which 
  46.                                              tests are actually being done}
  47.      FAILURES       : array [1..NO_OF_TESTS] of integer; {A record of the 
  48.                                              number of failures in this 
  49.                                              series of tests}
  50.      ERROR_BITS     : array [1..NO_OF_TESTS] of integer; {The bit corrospondin
  51.                                              to the test failures will be set}
  52.      OUTBIT         : char;{This is the space 1 or 0 to corrospond w/ failures}
  53.      DRIVE          : char;{The selected drive for the disk test to be done on}
  54.      CH             : char;
  55.      CLEAR_SCREEN   : char;{The clear screen command}è     DEV            : char;{Passes the device for which the bit string is to
  56.                            be written.}
  57.      PRINTER        : text;
  58.      DFILE          : text;
  59.      OUT_FILE       : string 15;
  60.      OUT_DEVICE     : DEVICE_SET;{A set containing all selected output devices}
  61.      SET_OUT_DEVICES: DEVICE_SET;{Set of all possible output devices}
  62.  
  63. FUNCTION GETCAR :char; external;
  64. FUNCTION CPUTST :integer; external;
  65. FUNCTION DTEST(DRIVE : CHAR) :integer; external;
  66. FUNCTION SERT   :integer; external;
  67. FUNCTION APUT   :integer; external;
  68. FUNCTION LOGIOR(OPER1,OPER2:INTEGER):integer;external;
  69. FUNCTION LOGIAND(OPER1,OPER2:INTEGER):integer;external;
  70. FUNCTION ANDEM  (OPER1,ORER2:INTEGER):boolean;external;
  71. FUNCTION MEMTST :integer; external;
  72. FUNCTION LGCP   :integer; external;
  73. FUNCTION GCPCPU :integer; external;
  74. FUNCTION GCPAPU :integer; external;
  75. FUNCTION GCPMEM :integer; external;
  76. FUNCTION MCPROM: integer;external;
  77. FUNCTION MCPLNK: integer;external;
  78. FUNCTION GCPDWN: integer;external;
  79. FUNCTION PLASMA: integer;external;
  80. FUNCTION TOUCHP: integer;external;
  81. FUNCTION KEYBRD: integer;external;
  82. FUNCTION GCPROM: integer;external;
  83.  
  84.  
  85. procedure INITIALIZE;
  86.  
  87.      {This procedure will initialize the necessary program 
  88.      variables
  89.      }
  90.  
  91.      begin
  92.      X := LGCP;                    {Load the GCP code}
  93.      if X <> 0 then 
  94.      begin
  95.           writeln('Disk Close Error');
  96.           repeat
  97.           until false
  98.      end;
  99.  
  100.      CLEAR_SCREEN := chr(12);
  101.           for X := 1 to NO_OF_TESTS do
  102.           begin
  103.                TEST_FLAGS[X] := FALSE;
  104.                FAILURES[X]   := 0;
  105.                ERROR_BITS[x] := 0 
  106.          end;
  107.          
  108.      end; {INITIALIZE}
  109. èprocedure OPEN_OUT;
  110.      begin
  111.           if 'F' in OUT_DEVICE then     {If they want the desk test then ask  }
  112.           begin                         {for the file name and open that file }
  113.                CH := chr(13);
  114.                writeln(CLEAR_SCREEN);
  115.                writeln('Enter output file');
  116.                readln(OUT_FILE);
  117.                append(OUT_FILE,CH);     {add a carriage return for CP/m}
  118.                rewrite(OUT_FILE,DFILE)
  119.           end;
  120.  
  121.           if 'P' in OUT_DEVICE then     {If the printer is requested then open}
  122.                rewrite('LST:',PRINTER)  {it as an output device               }
  123.  
  124.      end {OPEN_OUT};
  125.  
  126. procedure WRITE_MENU;
  127.  
  128.      {Writes the test menu onto the display }
  129.  
  130.      begin
  131.           write(CLEAR_SCREEN);
  132.           writeln(SPACES,SPACES,HEAD_1);
  133.           writeln;
  134.           writeln(SPACES,TMSG_1);
  135.           writeln(SPACES,TMSG_2);
  136.           writeln(SPACES,TMSG_3);
  137.           writeln(SPACES,TMSG_4);
  138.           writeln(SPACES,TMSG_5);
  139.           writeln(SPACES,TMSG_6);
  140.           writeln(SPACES,TMSG_7);
  141.           writeln(SPACES,TMSG_8);
  142.           writeln(SPACES,TMSG_9);
  143.           writeln(SPACES,TMSG_10);
  144.           writeln(SPACES,TMSG_11);
  145.           writeln(SPACES,TMSG_12);
  146.           writeln(SPACES,TMSG_13);
  147.           writeln(SPACES,TMSG_14)
  148.      end; {WRITE_MENU}
  149.  
  150.  
  151. procedure SET_FLAG;
  152.      {This will set the flag corrosponding to the test that has been
  153.      requested
  154.      }
  155.  
  156.      begin
  157.  
  158.           TEST_FLAGS [TEST_NUM] := TRUE
  159.      
  160.      end; {SET_FLAG}
  161.  
  162.  
  163. procedure GET_TEST;è     {This procedure will prompt the user for the test(s) to be run}
  164.  
  165.      function VALID :boolean;
  166.  
  167.           {If the entered number is a valid test number then TRUE is
  168.           returned else FALSE is returned}
  169.  
  170.           begin
  171.                if (TEST_NUM <= NO_OF_TESTS) and (TEST_NUM >= 1)
  172.                then
  173.                     VALID := TRUE
  174.                else
  175.                     VALID := FALSE;
  176.           end; {VALID}
  177.  
  178.      procedure ERROR;
  179.           
  180.           {Writes the appropriate error message depending on the input}
  181.           const
  182.                MSG1      =    'The number ';
  183.                MSG2      =    ' is invalid';
  184.  
  185.           begin
  186.                writeln(MSG1,TEST_NUM:1,MSG2)
  187.           end; {ERROR}
  188.  
  189.  
  190.      begin     {main GET TEST procedure}
  191.  
  192.           write(GTEST_MSG);
  193.           repeat
  194.                read(TEST_NUM);
  195.                if TEST_NUM = 0
  196.                then
  197.                     for X := 1 to NO_OF_TESTS do
  198.                          TEST_FLAGS[X] := TRUE
  199.  
  200.                else
  201.                     if VALID 
  202.                     then
  203.                          SET_FLAG
  204.                     else
  205.                          ERROR;
  206.           until eoln(0)
  207.  
  208.      end;{GET TEST}
  209.  
  210.  
  211. procedure GET_REPS;
  212.      {Will prompt the user for the number of repetions of the
  213.      tests are to be made.  If '999' is entered then the selected
  214.      tests will continue until the system is reset}
  215.      
  216.      const
  217.           MSG1 = 'Enter Repetitions..';è
  218.      begin
  219.           write(MSG1);
  220.           readln(REPS)
  221.      end; {GET_REPS}
  222.  
  223.  
  224. function  VERIFY :boolean;
  225.      {Will prompt the user to varify the test selection that he
  226.      has made}
  227.  
  228.      begin
  229.           writeln(CLEAR_SCREEN);
  230.           writeln(SPACES,HEAD_1);
  231.           writeln;
  232.           writeln(SEL_TESTS);
  233.           for X := 1 to NO_OF_TESTS do
  234.                if TEST_FLAGS[X] then
  235.                     case X of
  236.                          1: writeln(TMSG_1);
  237.                          2: writeln(TMSG_2);
  238.                          3: writeln(TMSG_3);
  239.                          4: writeln(TMSG_4);
  240.                          5: writeln(TMSG_5);
  241.                          6: writeln(TMSG_6);
  242.                          7: writeln(TMSG_7);
  243.                          8: writeln(TMSG_8);
  244.                          9: writeln(TMSG_9);
  245.                          10: writeln(TMSG_10);
  246.                          11: writeln(TMSG_11);
  247.                          12: writeln(TMSG_12);
  248.                          13: writeln(TMSG_13);
  249.                          14: writeln(TMSG_14)
  250.                     end;
  251.           writeln;
  252.           writeln(REP_MSG,REPS);
  253.  
  254.           writeln; writeln;
  255.  
  256.           write('Output to ');
  257.                if 'P' in OUT_DEVICE then
  258.                     write('Printer - ');
  259.  
  260.                if 'C' in OUT_DEVICE then
  261.                     write('Console - ');
  262.  
  263.                if 'F' in OUT_DEVICE then
  264.                     write('Disk file ',OUT_FILE);
  265.  
  266.                writeln;
  267.  
  268.           if TEST_FLAGS[3] then
  269.                writeln('Testing drive ',DRIVE);
  270.  
  271.           writeln;è          writeln(OKAY);
  272.  
  273.           CH := GETCAR;
  274.  
  275.           if (CH = 'y') or( CH = 'Y')
  276.           then
  277.                VERIFY := TRUE
  278.           else
  279.                VERIFY := FALSE
  280.  
  281.  
  282.      end; {VERIFY}
  283.  
  284. procedure GET_DEVICE;
  285.      {This procedure will prompt the user for the output devices
  286.      to be used. P-printer C-console F-disk file
  287.      }
  288.  
  289. begin
  290.      SET_OUT_DEVICE := ['f','F','c','C','P','p'];
  291.      OUT_DEVICE := [];
  292.      write('Enter P(rinter C(onsole F(ile..');
  293.      repeat
  294.           CH := GETCAR;
  295.           if CH in SET_OUT_DEVICE then
  296.           begin
  297.                if ord(CH) > 91 then     {if it is lower case }
  298.                begin                    {change to upper     }
  299.                     X := ord(CH);
  300.                     CH := chr(X-32)
  301.                end;
  302.  
  303.                OUT_DEVICE := OUT_DEVICE + [CH]
  304.           end;
  305.      until CH = chr(13);
  306.      if OUT_DEVICE = [] then
  307.           OUT_DEVICE := ['C'];     {defult to console}
  308.      writeln
  309. end;
  310. procedure GET_DRIVE;
  311.  
  312.      type     DRV_SET    =    set of char;
  313.      
  314.      var      VALID_DRIVES : DRV_SET;
  315.  
  316.      begin
  317.           VALID_DRIVES := ['a','A','B','b'];
  318.  
  319.           if TEST_FLAGS[3] then    {if he wants the desk test then}
  320.           begin                    {get the drive name}
  321.                write('Enter Drive To Test..'); 
  322.                repeat
  323.                     DRIVE := GETCAR;
  324.                until DRIVE in VALID_DRIVES
  325.           endè     end;
  326.  
  327.  
  328. procedure BITTER (ERROR_BITS :integer) ;
  329.           {This procedure will print out ones or zeros corrosponding
  330.           with the bits which are set in the ERROR_BITS.  These bits
  331.           should then corrospond to the tests which failed with '1'
  332.           indicating a failed test                                  }
  333.  
  334.      var
  335.           MASK      : integer;
  336.  
  337.      begin
  338.           MASK := LOGIAND(-32767,-2);   {Set the high bit of the mask}
  339.           OUTBIT := ' ';
  340.  
  341.           repeat
  342.                if ANDEM(ERROR_BIT,MASK) then {If the error bit is set then    }
  343.                     OUTBIT := '1';           {set the char. to be output to   }
  344.                                              {a 1.                            }
  345.                if DEV = 'P' then             {Now output to all devices       }
  346.                     write (PRINTER, OUTBIT); {for which output has been       }
  347.                                              {requested.                      }
  348.                if DEV = 'C' then
  349.                     write (OUTBIT);
  350.  
  351.                if DEV = 'F' then
  352.                     write(DFILE,OUTBIT);
  353.  
  354.                if OUTBIT = '1' then          {Reset the output char so we     }
  355.                     OUTBIT := '0';           {don't show the next test failed }
  356.                                              {also.                           }
  357.                if MASK = LOGIAND(-32767,-2) then{Sence this is 2'sC arithmetic}
  358.                     MASK := 16384            {it won't work to just devide    }
  359.                else                          {to shift the high bit.          }
  360.                     MASK := MASK div 2;      {Shift right the mask            }
  361.  
  362.           until MASK = 0                     {If it's zero then we are done   }
  363.      end;
  364.  
  365.  
  366. procedure CON_WRITE;
  367.      
  368. begin
  369.           DEV := 'C';
  370.  
  371.           if x = 1 then
  372.                writeln(REPS_DONE:1,REP_MSG,SPACES,SPACES,FAIL_MSG);
  373.                          
  374.           if TEST_FLAGS[X] then
  375.                case X of
  376.                     1: begin
  377.                        write(TMSG_1,FAILURES[X],SPACES);
  378.                        BITTER(ERROR_BITS[X]);
  379.                        writelnè                      end;
  380.  
  381.                     2: begin
  382.                        write(TMSG_2,FAILURES[X],SPACES);
  383.                        BITTER(ERROR_BITS[X]);
  384.                        writeln
  385.                       end;
  386.  
  387.                     3: begin
  388.                        write(TMSG_3,FAILURES[X],SPACES);
  389.                        BITTER(ERROR_BITS[X]);
  390.                        writeln
  391.                       end;
  392.  
  393.                     4: begin
  394.                        write(TMSG_4,FAILURES[X],SPACES);
  395.                        BITTER(ERROR_BITS[X]);
  396.                        writeln
  397.                       end;
  398.  
  399.                     5: begin
  400.                        write(TMSG_5,FAILURES[X],SPACES);
  401.                        BITTER(ERROR_BITS[X]);
  402.                        writeln
  403.                       end;
  404.  
  405.                     6: begin
  406.                        write(TMSG_6,FAILURES[X],SPACES);
  407.                        BITTER(ERROR_BITS[X]);
  408.                        writeln
  409.                       end;
  410.  
  411.                     7: begin
  412.                        write(TMSG_7,FAILURES[X],SPACES);
  413.                        BITTER(ERROR_BITS[X]);
  414.                        writeln
  415.                       end;
  416.  
  417.                     8: begin
  418.                        write(TMSG_8,FAILURES[X],SPACES);
  419.                        BITTER(ERROR_BITS[X]);
  420.                        writeln
  421.                       end;
  422.  
  423.                     9: begin
  424.                        write(TMSG_9,FAILURES[X],SPACES);
  425.                        BITTER(ERROR_BITS[X]);
  426.                        writeln
  427.                       end;
  428.  
  429.                     10: begin
  430.                        write(TMSG_10,FAILURES[X],SPACES);
  431.                        BITTER(ERROR_BITS[X]);
  432.                        writeln
  433.                       end;è
  434.                     11: begin
  435.                        write(TMSG_11,FAILURES[X],SPACES);
  436.                        BITTER(ERROR_BITS[X]);
  437.                        writeln
  438.                       end;
  439.                     12: begin
  440.                        write(TMSG_12,FAILURES[X],SPACES);
  441.                        BITTER(ERROR_BITS[X]);
  442.                        writeln
  443.                       end;
  444.                     13: begin
  445.                        write(TMSG_13,FAILURES[X],SPACES);
  446.                        BITTER(ERROR_BITS[X]);
  447.                        writeln
  448.                       end;
  449.                     14: begin
  450.                        write(TMSG_14,FAILURES[X],SPACES);
  451.                        BITTER(ERROR_BITS[X]);
  452.                        writeln
  453.                       end
  454.                end
  455. end;
  456.  
  457.  
  458. procedure DSK_WRITE;
  459.  
  460. begin
  461.           DEV := 'F';
  462.  
  463.           if x = 1 then
  464.            writeln(DFILE,REPS_DONE:1,REP_MSG,SPACES,SPACES,FAIL_MSG);
  465.  
  466.           if TEST_FLAGS[X] then
  467.                case X of
  468.                     1: begin
  469.                        write(DFILE,TMSG_1,FAILURES[X],SPACES);
  470.                        BITTER(ERROR_BITS[X]);
  471.                        writeln(DFILE)
  472.                       end;
  473.  
  474.                     2: begin
  475.                        write(DFILE,TMSG_2,FAILURES[X],SPACES);
  476.                        BITTER(ERROR_BITS[X]);
  477.                        writeln(DFILE)
  478.                       end;
  479.  
  480.                     3: begin
  481.                        write(DFILE,TMSG_3,FAILURES[X],SPACES);
  482.                        BITTER(ERROR_BITS[X]);
  483.                        writeln(DFILE)
  484.                       end;
  485.  
  486.                     4: begin
  487.                        write(DFILE,TMSG_4,FAILURES[X],SPACES);è                       BITTER(ERROR_BITS[X]);
  488.                        writeln(DFILE)
  489.                       end;
  490.  
  491.                     5: begin
  492.                        write(DFILE,TMSG_5,FAILURES[X],SPACES);
  493.                        BITTER(ERROR_BITS[X]);
  494.                        writeln(DFILE)
  495.                       end;
  496.  
  497.                     6: begin
  498.                        write(DFILE,TMSG_6,FAILURES[X],SPACES);
  499.                        BITTER(ERROR_BITS[X]);
  500.                        writeln(DFILE)
  501.                       end;
  502.  
  503.                     7: begin
  504.                        write(DFILE,TMSG_7,FAILURES[X],SPACES);
  505.                        BITTER(ERROR_BITS[X]);
  506.                        writeln(DFILE)
  507.                       end;
  508.  
  509.                     8: begin
  510.                        write(DFILE,TMSG_8,FAILURES[X],SPACES);
  511.                        BITTER(ERROR_BITS[X]);
  512.                        writeln(DFILE)
  513.                       end;
  514.  
  515.                     9: begin
  516.                        write(DFILE,TMSG_9,FAILURES[X],SPACES);
  517.                        BITTER(ERROR_BITS[X]);
  518.                        writeln(DFILE)
  519.                       end;
  520.  
  521.                     10: begin
  522.                        write(DFILE,TMSG_10,FAILURES[X],SPACES);
  523.                        BITTER(ERROR_BITS[X]);
  524.                        writeln(DFILE)
  525.                       end;
  526.  
  527.                     11: begin
  528.                        write(DFILE,TMSG_11,FAILURES[X],SPACES);
  529.                        BITTER(ERROR_BITS[X]);
  530.                        writeln(DFILE)
  531.                       end;
  532.                     12: begin
  533.                        write(DFILE,TMSG_12,FAILURES[X],SPACES);
  534.                        BITTER(ERROR_BITS[X]);
  535.                        writeln(DFILE)
  536.                       end;
  537.                     13: begin
  538.                        write(DFILE,TMSG_13,FAILURES[X],SPACES);
  539.                        BITTER(ERROR_BITS[X]);
  540.                        writeln(DFILE)
  541.                       end;è                    14: begin
  542.                        write(DFILE,TMSG_14,FAILURES[X],SPACES);
  543.                        BITTER(ERROR_BITS[X]);
  544.                        writeln(DFILE)
  545.                       end
  546.  
  547.                end
  548. end;
  549.  
  550.  
  551. procedure LST_WRITE;
  552.  
  553. begin
  554.           DEV := 'P';
  555.           if x = 1 then
  556.             writeln(PRINTER,REPS_DONE:1,REP_MSG,SPACES,SPACES,FAIL_MSG);
  557.      
  558.           if TEST_FLAGS[X] then
  559.                case X of
  560.                     1: begin
  561.                        write(PRINTER,TMSG_1,FAILURES[X],SPACES);
  562.                        BITTER(ERROR_BITS[X]);
  563.                        writeln(PRINTER)
  564.                       end;
  565.  
  566.                     2: begin
  567.                        write(PRINTER,TMSG_2,FAILURES[X],SPACES);
  568.                        BITTER(ERROR_BITS[X]);
  569.                        writeln(PRINTER)
  570.                       end;
  571.  
  572.                     3: begin
  573.                        write(PRINTER,TMSG_3,FAILURES[X],SPACES);
  574.                        BITTER(ERROR_BITS[X]);
  575.                        writeln(PRINTER)
  576.                       end;
  577.  
  578.                     4: begin
  579.                        write(PRINTER,TMSG_4,FAILURES[X],SPACES);
  580.                        BITTER(ERROR_BITS[X]);
  581.                        writeln(PRINTER)
  582.                       end;
  583.  
  584.                     5: begin
  585.                        write(PRINTER,TMSG_5,FAILURES[X],SPACES);
  586.                        BITTER(ERROR_BITS[X]);
  587.                        writeln(PRINTER)
  588.                       end;
  589.  
  590.                     6: begin
  591.                        write(PRINTER,TMSG_6,FAILURES[X],SPACES);
  592.                        BITTER(ERROR_BITS[X]);
  593.                        writeln(PRINTER)
  594.                       end;
  595. è                    7: begin
  596.                        write(PRINTER,TMSG_7,FAILURES[X],SPACES);
  597.                        BITTER(ERROR_BITS[X]);
  598.                        writeln(PRINTER)
  599.                       end;
  600.  
  601.                     8: begin
  602.                        write(PRINTER,TMSG_8,FAILURES[X],SPACES);
  603.                        BITTER(ERROR_BITS[X]);
  604.                        writeln(PRINTER)
  605.                       end;
  606.  
  607.                     9: begin
  608.                        write(PRINTER,TMSG_9,FAILURES[X],SPACES);
  609.                        BITTER(ERROR_BITS[X]);
  610.                        writeln(PRINTER)
  611.                       end;
  612.  
  613.                     10: begin
  614.                        write(PRINTER,TMSG_10,FAILURES[X],SPACES);
  615.                        BITTER(ERROR_BITS[X]);
  616.                        writeln(PRINTER)
  617.                       end;
  618.  
  619.                     11: begin
  620.                        write(PRINTER,TMSG_11,FAILURES[X],SPACES);
  621.                        BITTER(ERROR_BITS[X]);
  622.                        writeln(PRINTER)
  623.                       end;
  624.                     12: begin
  625.                        write(PRINTER,TMSG_12,FAILURES[X],SPACES);
  626.                        BITTER(ERROR_BITS[X]);
  627.                        writeln(PRINTER)
  628.                       end;
  629.                     13: begin
  630.                        write(PRINTER,TMSG_13,FAILURES[X],SPACES);
  631.                        BITTER(ERROR_BITS[X]);
  632.                        writeln(PRINTER)
  633.                       end;
  634.                     14: begin
  635.                        write(PRINTER,TMSG_14,FAILURES[X],SPACES);
  636.                        BITTER(ERROR_BITS[X]);
  637.                        writeln(PRINTER)
  638.                       end
  639.  
  640.                end
  641. end;
  642.  
  643.  
  644. procedure PRINT_FAILURES;
  645.      {At the end of eavh series of tests this procedure will be
  646.      called to print a summary of all failures that have occured
  647.      since this test cycle was started}
  648.  
  649.      beginè          writeln(CLEAR_SCREEN);
  650.  
  651.           writeln(HEAD_1);
  652.  
  653.  
  654.           for X := 1 to NO_OF_TESTS do
  655.           begin
  656.                if 'P' in OUT_DEVICE then
  657.                     LST_WRITE;
  658.                if 'C' in OUT_DEVICE then
  659.                     CON_WRITE;
  660.                if 'F' in OUT_DEVICE then
  661.                     DSK_WRITE
  662.           end
  663.  
  664.      end;{PRINT FAILURES}
  665.  
  666.  
  667. procedure DOHEAD;
  668.      begin
  669.           writeln(CLEAR_SCREEN);
  670.           writeln(HEAD_1);
  671.           writeln
  672.      end;
  673.  
  674. procedure TEST_1;
  675.      begin
  676.           write('test 1 ');
  677.           if CPUTST <> 0 then
  678.                FAILURES[1] := FAILURES[1] + 1;
  679.           writeln
  680.      end;
  681.  
  682. procedure TEST_2;
  683.      begin
  684.           write('test 2');
  685.           TEST_ERRORS := MEMTST;
  686.           if TEST_ERRORS <> 0 then
  687.           begin
  688.                FAILURES[2] := FAILURES[2] +1;
  689.                ERROR_BITS[2] := LOGIOR(ERROR_BITS[2], TEST_ERRORS)
  690.           end;
  691.           writeln
  692.      end;
  693.  
  694. procedure TEST_3;
  695.  
  696.      const
  697.           TMSG_3    =    'test 3';
  698.           
  699.      begin
  700.           writeln(TMSG_3);
  701.           TEST_ERRORS := DTEST(DRIVE);
  702.  
  703.           if TEST_ERRORS <> 0 thenè          begin
  704.                FAILURES[3] := FAILURES[3]+1;
  705.           end
  706.      end;
  707.  
  708. procedure TEST_4;
  709.  
  710.      const
  711.           T1_MSG    =    'Uart 0 test';
  712.           T2_MSG    =    'Uart 1 test';
  713.           TMSG_4    =    'test 4';
  714.  
  715.      begin
  716.           writeln(TMSG_4);
  717.           TEST_ERRORS := SERT;
  718.  
  719.           if TEST_ERRORS <> 0 then
  720.                begin
  721.                     FAILURES[4] := FAILURES[4] + 1;
  722.                     ERROR_BITS[4] := LOGIOR(ERROR_BITS[4] ,TEST_ERRORS);
  723.  
  724.                     if ANDEM(TEST_ERRORS,1) then
  725.                          writeln(SPACES,T1_MSG,FAIL);
  726.                     if ANDEM(TEST_ERRORS,1) then
  727.                          writeln(SPACES,T2_MSG,FAIL);
  728.  
  729.                     for x := 0 to 10000 do {delay}
  730.                end
  731.      end;
  732.  
  733. procedure TEST_5;
  734.  
  735.      const
  736.           T1_MSG    =    'APU BUS Error Test';
  737.           T2_MSG    =    'APU Stack Test';
  738.           T3_MSG    =    'DADD Test';
  739.           T4_MSG    =    'DSUB Test';
  740.           T5_MSG    =    'DMUL and DDIV Test';
  741.           T6_MSG    =    'Skip busy bit test';
  742.           T7_MSG    =    '16 bit Arithmatic Test';
  743.           T8_MSG    =    'Misc. Function Test';
  744.           T9_MSG    =    'No busy bit !! TEST ABORTED !!';
  745.  
  746.  
  747.      begin
  748.           write('test 5');
  749.           TEST_ERRORS := APUT;
  750.  
  751.           if TEST_ERRORS <> 0 then
  752.                begin
  753.                     FAILURES[5] := FAILURES[5] +1;
  754.                     ERROR_BITS[5] := LOGIOR(ERROR_BITS[5], TEST_ERRORS);
  755.  
  756.                     if ANDEM(TEST_ERRORS , 1) then
  757.                          writeln(SPACES,T1_MSG,FAIL);è                    if ANDEM(TEST_ERRORS , 2) then
  758.                          writeln(SPACES,T2_MSG,FAIL);
  759.                     if ANDEM(TEST_ERRORS , 3) then
  760.                          writeln(SPACES,T3_MSG,FAIL);
  761.                     if ANDEM(TEST_ERRORS , 8) then
  762.                          writeln(SPACES,T4_MSG,FAIL);
  763.                     if ANDEM(TEST_ERRORS , 16) then
  764.                          writeln(SPACES,T5_MSG,FAIL);
  765.                     if ANDEM(TEST_ERRORS , 32) then
  766.                          writeln(SPACES,T6_MSG,FAIL);
  767.                     if ANDEM(TEST_ERRORS , 64) then
  768.                          writeln(SPACES,T7_MSG,FAIL);
  769.                     if ANDEM(TEST_ERRORS , 128) then
  770.                          writeln(SPACES,T8_MSG,FAIL);
  771.                     if ANDEM(TEST_ERRORS , 256) then
  772.                          writeln(SPACES,T9_MSG,FAIL);
  773.  
  774.                     for X := 0 to 10000 do {DELAY}
  775.                end;
  776.                writeln
  777.        end;
  778.  
  779.  
  780. procedure TEST_6;   {mcplnk}
  781.      begin
  782.           write('test 6');
  783.           TEST_ERRORS := MCPLNK;
  784.           if TEST_ERRORS <> 0 then
  785.           begin
  786.                FAILURES[6] := FAILURES[6] + 1;
  787.                ERROR_BITS[6] := LOGIOR(ERROR_BITS[6],TEST_ERRORS)
  788.           end;
  789.           writeln
  790.      end;
  791.  
  792. procedure TEST_7;   {gcpdwn}
  793.      begin
  794.           write('test 7');
  795.           TEST_ERRORS := GCPDWN;
  796.           if TEST_ERRORS <> 0 then
  797.           begin
  798.                FAILURES[7] := FAILURES[7] + 1;
  799.                ERROR_BITS[7] := LOGIOR(ERROR_BITS[7],TEST_ERRORS)
  800.           end;
  801.           writeln
  802.      end;
  803.  
  804. procedure TEST_8;   {plasma}
  805.      begin
  806.           write('test 8');
  807.           TEST_ERRORS := PLASMA;
  808.           if TEST_ERRORS <> 0 then
  809.           begin
  810.                FAILURES[8] := FAILURES[8] + 1;
  811.                ERROR_BITS[8] := LOGIOR(ERROR_BITS[8],TEST_ERRORS)è          end;
  812.           writeln
  813.      end;
  814.  
  815. procedure TEST_9;  {touchp}
  816.      begin
  817.           write('test 9');
  818.           TEST_ERRORS := TOUCHP;
  819.           if TEST_ERRORS <> 0 then
  820.           begin
  821.                FAILURES[9] := FAILURES[9] + 1;
  822.                ERROR_BITS[9] := LOGIOR(ERROR_BITS[9],TEST_ERRORS)
  823.           end;
  824.           writeln
  825.      end;
  826.  
  827. procedure TEST_10;  {keyboard}
  828.      begin
  829.           write('test 10');
  830.           TEST_ERRORS := KEYBRD;
  831.           if TEST_ERRORS <> 0 then
  832.           begin
  833.                FAILURES[10] := FAILURES[10] + 1;
  834.                ERROR_BITS[10] := LOGIOR(ERROR_BITS[10],TEST_ERRORS)
  835.           end;
  836.           writeln
  837.      end;
  838.  
  839. procedure TEST_11;
  840.      begin
  841.           write('test 11');
  842.           TEST_ERRORS := GCPCPU;
  843.           if TEST_ERRORS <> 0 then
  844.           begin
  845.                FAILURES[11] := FAILURES[11] + 1;
  846.                ERROR_BITS[11] := LOGIOR(ERROR_BITS[11],TEST_ERRORS)
  847.           end;
  848.           writeln
  849.      end;
  850.  
  851. procedure TEST_12;
  852.      begin
  853.           write('test 12');
  854.           TEST_ERRORS := GCPMEM;
  855.           if TEST_ERRORS <> 0 then
  856.           begin
  857.                FAILURES[12] := FAILURES[12] + 1;
  858.                ERROR_BITS[12] := LOGIOR(ERROR_BITS[12],TEST_ERRORS)
  859.           end;
  860.           writeln
  861.      end;
  862.  
  863. procedure TEST_13;
  864.      begin
  865.           write('test 13');è          TEST_ERRORS := GCPROM;
  866.           if TEST_ERRORS <> 0 then
  867.           begin
  868.                FAILURES[13] := FAILURES[13] + 1;
  869.                ERROR_BITS[13] := LOGIOR(ERROR_BITS[13],TEST_ERRORS)
  870.           end;
  871.           writeln
  872.      end;
  873.  
  874. procedure TEST_14;
  875.      begin
  876.           write('test 14');
  877.           TEST_ERRORS := GCPAPU;
  878.           if TEST_ERRORS <> 0 then
  879.           begin
  880.                FAILURES[14] := FAILURES[14] + 1;
  881.                ERROR_BITS[14] := LOGIOR(ERROR_BITS[14],TEST_ERRORS)
  882.           end;
  883.           writeln
  884.      end;
  885. {---------------------------------------------------------------}
  886. {    begin main program ATS MONITOR                             }
  887.      begin
  888.           repeat
  889.                INITIALIZE;
  890.                WRITE_MENU;
  891.                GET_TEST;
  892.                GET_REPS;
  893.                GET_DEVICE;
  894.                OPEN_OUT;
  895.                GET_DRIVE;
  896.           until VERIFY;
  897.      
  898.           REPS_DONE := 0;
  899.  
  900.           repeat
  901.                DOHEAD;
  902.                for X := 1 to NO_OF_TESTS do
  903.                     if TEST_FLAGS[X] then
  904.                          case X of
  905.                               1: TEST_1;
  906.                               2: TEST_2;
  907.                               3: TEST_3;
  908.                               4: TEST_4;
  909.                               5: TEST_5;
  910.                               6: TEST_6;
  911.                               7: TEST_7;
  912.                               8: TEST_8;
  913.                               9: TEST_9;
  914.                               10: TEST_10;
  915.                               11: TEST_11;
  916.                               12: TEST_12;
  917.                               13: TEST_13;
  918.                               14: TEST_14
  919.                          end;{case}è
  920.                     REPS_DONE := REPS_DONE+1;
  921.                PRINT_FAILURES;
  922.                for X := 1 to 10000 do
  923.                     Y := X;
  924.  
  925.           until (REPS_DONE = REPS) and (REPS <> 999)
  926.      end.
  927.  
  928.