home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / MEMORIA / QUADRAM.ZIP / QUADTEST.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1983-08-23  |  9.8 KB  |  302 lines
  1. 100  '******************* QUADTEST *********************
  2. 200  '*               REVISION 8/22/83                 *
  3. 210  '*                 VERSION 1.31                   *
  4. 300  '*             QUADRAM CORPORATION                *
  5. 400  '*               4357 PARK DRIVE                  *
  6. 500  '*              NORCROSS, GA  30093               *
  7. 600  '*   Testing and diagnostics program for          *
  8. 700  '*   Quadram Corporation Quadboard, Quadboard II, *
  9. 800  '*   Quad 512+ and memory expansion boards.       *
  10. 900  '**************************************************
  11. 1000  '
  12. 1100  '********* INITIALIZE **************
  13. 1200  CLEAR ,18000       'Keep BASIC out of expansion memory but leave room
  14. 1300                     'for the machine language memory test USR subroutine.
  15. 1310  DEF SEG
  16. 1340  ON ERROR GOTO 14900
  17. 1350  GOSUB 50000        'Disable function keys, except F10
  18. 1400  SCREEN 0,0: WIDTH 80
  19. 1500  DEFINT A-Z
  20. 1600  DIM Q(12)
  21. 1650  COMMON CH$
  22. 1655  FALSE=0:TRUE=NOT FALSE
  23. 1660  PLUG1=TRUE:PLUG2=TRUE
  24. 1700  GOSUB 49000        'Initialize COM and LPT port address variables
  25. 1900  GOSUB 17500        'Initialize Clock
  26. 2000  GOSUB 22200        'Read HCLK and set strings
  27. 2005  DEF SEG:POKE 106,0
  28. 2010  DEF SEG=0:POKE 1050,PEEK(1052):CC1=PEEK(65521):CC2=PEEK(65522):CC3=PEEK(65523):IF CC1=206 THEN IF CC2=216 THEN CH$=CHR$(CC3)   'Values passed from MEMTEST
  29. 2020  DEF SEG
  30. 2025  IF CH$<>"" THEN 7900
  31. 2100  CLS:KEY OFF
  32. 2200  PRINT TAB(30);"QUADRAM CORPORATION":PRINT TAB(33);"QUADTEST 1.31":PRINT TAB(28);"TESTING AND DIAGNOSTICS":PRINT TAB(17);"FOR MULTIFUNCTION AND EXPANSION MEMORY BOARDS"
  33. 2300  LOCATE 6,50
  34. 2400  IF INSTR(D$,"?")=0 THEN PRINT " DATE ";D$;" TIME ";T$ ELSE PRINT:GOTO 2900
  35. 2500  '*********** PRINTER PORT CHECK **************
  36. 2600  OUT LPTPORT2,0:IF INP(LPTPORT2)<>0 THEN PRINT "Printer port ERROR" ELSE OUT LPTPORT2,255:IF INP(LPTPORT2)<>255 THEN PRINT "Printer port ERROR" ELSE IF PT=1 THEN PRINT "Printer port checks ";:COLOR 31:PRINT "OK";:COLOR 7:PRINT "."
  37. 2800  IF PT=1 THEN 2800     'F10 to return to menu
  38. 2900  '***************** MAIN LINE **************
  39. 3000  TIME$="0"
  40. 3100  OUT B,97:IF INP(B)<>97 THEN 3400
  41. 3200  IF NOT INSTR(D$,"?") THEN DATE$=D$
  42. 3300  IF NOT INSTR(T$,"?") THEN TIME$=T$
  43. 3400  PRINT:PRINT "              1  -  MEMORY TEST"
  44. 3500  PRINT "              2  -  ASYNC SERIAL TEST"
  45. 3600  PRINT "              3  -  PARALLEL PRINTER PORT TEST"
  46. 3800  PRINT "              4  -  DISPLAY CLOCK TIME AND DATE"
  47. 3900  PRINT "              5  -  SET CLOCK"
  48. 4000  PRINT "              6  -  SET CLOCK FREQUENCY"
  49. 4100  PRINT "              7  -  DUAL PORT ASYNC TEST"
  50. 4300  PRINT "              A  -  TEST ALL FOUR QUADBOARD FUNCTIONS"
  51. 4600  PRINT "              R  -  TEST QUAD 512+ BOARD FUNCTIONS"
  52. 4610  PRINT "              S  -  TEST ALL FOUR QUADBOARD II FUNCTIONS"
  53. 4700  PRINT "              X  -  EXIT PROGRAM"
  54. 4800  PRINT
  55. 5000  BEEP:PRINT TAB(35)"INPUT TEST FUNCTION ";:CH$=INPUT$(1):PRINT CH$
  56. 5100  IF ASC(CH$)>=97 AND ASC(CH$)<=122 THEN CH$=CHR$(ASC(CH$)-32)
  57. 5110  IF CH$="X" THEN CLS:END ELSE GOSUB 47200
  58. 5500  IF CH$="A" OR CH$="S" THEN 9600
  59. 6010  IF CH$="R" THEN RUN "Q512TEST"
  60. 6100  IF VAL(CH$)<1 THEN GOTO 2100
  61. 6200  ON VAL(CH$) GOTO 9600,6900,16400,8700,9400,29500,7100
  62. 6300  GOTO 2100
  63. 6900  GOSUB 14810         'See if loop back plug is installed
  64. 6910  PRINT:GOSUB 13000
  65. 7000  GOTO 6910
  66. 7100  GOSUB 14810:GOSUB 14850    'See if both loop back plugs are installed
  67. 7110  PRINT:GOSUB 13000
  68. 7300  GOSUB 14200
  69. 7500  GOTO 7110
  70. 7600  '************* ALL FUNCTIONS CHECK **********
  71. 7700  CHAIN "memtest"
  72. 7900  GOSUB 17500
  73. 8000  GOSUB 22200
  74. 8100  PRINT "      DATE "+D$+", TIME "+T$
  75. 8200  GOSUB 13000
  76. 8300  IF CH$="S" THEN GOSUB 40800
  77. 8400  LPRINT "TOTAL MEMORY ERRORS =";EM%; "    DATE "+D$+", TIME "+T$:LPRINT A$
  78. 8600  PRINT:GOTO 7600
  79. 8700  '*********** DISPLAY CLOCK TIME AND DATE *********
  80. 8800  GOSUB 17500        'INITIALIZE CLOCK
  81. 8900  GOSUB 22200        'READ HCLK & SET STRINGS
  82. 9000  PRINT
  83. 9100  PRINT "DATE "+D$+", TIME "+T$
  84. 9300  GOTO 8900
  85. 9400  GOSUB 17500
  86. 9500  GOTO 19800
  87. 9600  '*********** MEMORY CHECK ****************
  88. 9610  IF CH$="A" THEN PRINT "Asynchronous port on Quadboard should be setup as COM1:":FOR J=1 TO 900:NEXT J
  89. 9700  CHAIN "MEMTEST"
  90. 13000  '*************** SERIAL PORT TEST *****************
  91. 13200  CLOSE
  92. 13400  ON ERROR GOTO 14900
  93. 13500  IF PLUG1 THEN OPEN "COM1:9600,N,8" AS #1 ELSE OPEN "COM1:9600,N,8,,CS,DS" AS #1:OUT (COMPORT1+4),(INP(COMPORT1+4) OR 16)       'if no plug then use 8250 test mode
  94. 13600  OPEN "SCRN:" FOR OUTPUT AS 2
  95. 13700  PAUSE = FALSE
  96. 13800  B$="RS232 TEST FIRST PORT--THE QUICK BROWN FOX JUMPED OVER THE FENCE 0123456789  ":PRINT #1,B$
  97. 13900  A$=INPUT$(LOC(1),#1)
  98. 14000  PRINT #2,A$;
  99. 14100  RETURN
  100. 14200  CLOSE
  101. 14300  IF PLUG2 THEN OPEN "COM2:9600,N,8" AS #1 ELSE OPEN "COM2:9600,N,8,,CS,DS" AS #1:OUT (COMPORT2+4),(INP(COMPORT2+4) OR 16)      'if no plug then use 8250 test mode
  102. 14400  OPEN "SCRN:" FOR OUTPUT AS 2
  103. 14500  B$="RS232 TEST SECOND PORT--THE QUICK BROWN FOX JUMPED OVER THE FENCE 0123456789  ":PRINT #1,B$
  104. 14600  A$=INPUT$(LOC(1),#1)
  105. 14700  PRINT #2,A$;
  106. 14800  RETURN
  107. 14810  '********* FIND OUT IF LOOPBACK PLUG IS INSTALLED *********
  108. 14812  PRINT TAB(30);"ASYNCHRONOUS PORT TEST":PRINT
  109. 14815  PLUG1=TRUE
  110. 14820  PRINT "IS LOOPBACK PLUG INSTALLED ON COM1: PORT CONNECTOR? ";:AN$=INPUT$(1):PRINT AN$
  111. 14830  IF AN$="N" OR AN$="n" THEN PLUG1=FALSE
  112. 14840  RETURN
  113. 14850  PLUG2=TRUE
  114. 14855  PRINT
  115. 14860  PRINT "IS LOOPBACK PLUG INSTALLED ON COM2: PORT CONNECTOR? ";:AN$=INPUT$(1):PRINT AN$
  116. 14870  IF AN$="N" OR AN$="n" THEN PLUG2=FALSE
  117. 14880  RETURN
  118. 14900  '**************** ERROR HANDLING ROUTINE **************
  119. 14910  IF ERR=24 THEN IF ERL=8400 THEN PRINT "ERROR: Printer timeout":RESUME 8600 ELSE IF ERL=16700 THEN CLS:LOCATE 23,5:COLOR 23:PRINT "ERROR: Printer timeout":COLOR 7:LOCATE 1,1:RESUME 2200
  120. 15100  IF (ERR<>24 OR (ERL<>13500 AND ERL<>14300)) THEN 15900
  121. 15105  EC=EC+1:IF EC<2 THEN RESUME        'TRY 3 TIMES
  122. 15110  EC=0
  123. 15200  IF (ERL<>13500 AND ERL<>14300) THEN 15600
  124. 15300  SOUND 60,10:PRINT:PRINT "COMMUNICATIONS PORT ERROR."
  125. 15400  PRINT "CTS and/or DSR signal missing.  Loopback plug may not be installed correctly.":PRINT "Are Quadboard switches and jumpers properly set?"
  126. 15500  RESUME
  127. 15600  IF ERL<>13900 AND ERL<>14600 THEN 16300
  128. 15700  PRINT "COMMUNICATIONS PORT MALFUNCTION.  BE SURE THAT LOOP BACK PLUG IS WIRED CORRECTLY"
  129. 15800  RESUME
  130. 15900  IF ERR=57 THEN IF ERL=13500 THEN PRINT "COM1 I/O error":RESUME ELSE IF ERL=14300 THEN PRINT "COM2 I/O error":RESUME
  131. 15910  IF ERR=57 THEN IF ERL=13500 THEN PRINT "COM1 I/O error":RESUME ELSE IF ERL=14300 THEN PRINT "COM2 I/O error":RESUME
  132. 16000  IF ERR=68 AND ERL=14300 THEN PRINT "COM2: PORT UNAVAILABLE":PRINT:RESUME
  133. 16100  IF ERR=68 AND ERL=16700 THEN SOUND 80,10:PRINT "NO PRINTER PORT INSTALLED":PRINT:GOSUB 41500:RESUME
  134. 16200  IF ERR=68 AND (ERL=8400 OR ERL=8500) THEN RESUME NEXT
  135. 16210  IF ERR=5 AND ERL=3200 OR ERL=3300 THEN RESUME 3400
  136. 16300  ON ERROR GOTO 0
  137. 16350  STOP
  138. 16400  '************ PARALLEL PRINTER PORT TEST ************
  139. 16500  FOR I=0 TO 31
  140. 16700  LPRINT "1234567890ABCDEFGWXYZjklmno!@%"
  141. 16800  NEXT
  142. 16900  CT=CT+1
  143. 17000  PRINT CT;
  144. 17100  GOTO 16400
  145. 17500  '************ INITIALIZE CLOCK **********
  146. 17600  'Initialize variables, then see if there is a clock in system.
  147. 17650  OUT &H313,&H90
  148. 17700  OUT &H311,97:IF INP(&H311)=97 THEN A=&H310 ELSE A=&H210
  149. 17710  B=A+1:C=A+2:Z=A+3
  150. 17800  NOCLOCK=FALSE
  151. 17900  OM=&H80:IM=&H90
  152. 18000  H=&H90:R=&HB0:W=&HD0
  153. 18100  REM
  154. 18200  OUT Z,IM          'ENABLE CLOCK
  155. 18400  REM ENSURE 24 HOUR FORMAT
  156. 18500  OUT B,5:OUT C,R:X=INP(A):OUT Z,OM
  157. 18600  OUT B,5:OUT C,H:OUT A,X AND 3 OR 8
  158. 18700  OUT C,W:OUT Z,IM
  159. 18800  REM ENSURE LEAP BIT SET CORRECTLY
  160. 18900  OUT C,R
  161. 19000  FOR I=9 TO 12:OUT B,I:Q(I)=INP(A)
  162. 19100  NEXT:OUT Z,IM
  163. 19200  L=10*Q(10)+Q(9)>2 AND 1
  164. 19300  L=4 AND (L+10*Q(12)+Q(11) AND 3)=0
  165. 19400  OUT B,8:OUT C,R:X=INP(A):OUT Z,OM
  166. 19500  OUT B,8:OUT C,H:OUT A,X AND 3 OR L
  167. 19600  OUT C,W:OUT Z,IM
  168. 19700  RETURN
  169. 19800  '************* SET CLOCK **************
  170. 19900  GOSUB 22200 'READ HCLK & SET STRINGS
  171. 20000  PRINT
  172. 20100  PRINT "DATE "+D$+", TIME "+T$
  173. 20200  INPUT"CHANGE DATE (Y/N)";A$
  174. 20300  A$=LEFT$(A$,1):DF=(A$="Y")OR(A$="y")
  175. 20400  IF NOT DF THEN 20600
  176. 20500  GOSUB 23900:IF EF THEN PRINT"INVALID DATE":GOTO 20500
  177. 20600  INPUT"CHANGE TIME (Y/N)";A$
  178. 20700  A$=LEFT$(A$,1):TF=(A$="Y")OR(A$="y")
  179. 20800  IF NOT TF THEN 21000
  180. 20900  GOSUB 26500:IF EF THEN PRINT"INVALID TIME":GOTO 20900
  181. 21000  JB=7 AND NOT TF
  182. 21100  JE=12-(7 AND NOT DF)
  183. 21200  IF JE<JB THEN 21700
  184. 21300  INPUT"PRESS ENTER TO SET DATE/TIME:",A$
  185. 21400  OUT Z,OM:OUT C,H
  186. 21500  FOR J=JB TO JE:OUT B,J:OUT A,Q(J)
  187. 21600  OUT C,W:OUT C,H:NEXT:OUT Z,IM
  188. 21700  GOSUB 22200
  189. 21800  TIME$="0":DATE$=D$:TIME$=T$
  190. 21900  PRINT
  191. 22000  PRINT"DATE "+DATE$+", TIME "+TIME$
  192. 22100  RUN
  193. 22200  '********* READ HCLK AND SET D$ AND T$ **********
  194. 22300  OUT C,R:FOR I=0 TO 12:OUT B,I
  195. 22400  Q(I)=INP(A) AND 15:NEXT:OUT Z,IM
  196. 22500  Q(5)=Q(5) AND 3:Q(8)=Q(8) AND 3
  197. 22600  T$="HH:MM:SS"
  198. 22700  FOR I=0 TO 2:FOR J=0 TO 1
  199. 22800  MID$(T$,1+J+3*I)=CHR$(Q(5-J-2*I)+48)
  200. 22900  NEXT J,I
  201. 23000  X$="MM-DD-YY"
  202. 23100  Q(6)=Q(12):Q(5)=Q(11)
  203. 23200  FOR I=0 TO 2:FOR J=0 TO 1
  204. 23300  MID$(X$,1+J+3*I)=CHR$(Q(10-J-2*I)+48)
  205. 23400  NEXT J,I
  206. 23500  Y$="19"
  207. 23600  IF VAL(MID$(X$,7,2))<80 THEN Y$="20"
  208. 23700  D$=LEFT$(X$,6)+Y$+RIGHT$(X$,2)
  209. 23800  RETURN
  210. 23900  '************ SUBROUTINE RESET CLOCK DATE ***********
  211. 24000  EF=-1
  212. 24100  INPUT"ENTER NEW DATE (MM-DD-YY): ",X$
  213. 24200  GOSUB 28000
  214. 24300  IF Z$<>"-"AND Z$<>"/"THEN RETURN
  215. 24400  IF Y$<>"" OR J<>3 THEN RETURN
  216. 24500  IF P(2)<0 OR P(2)>2079 THEN RETURN
  217. 24600  IF P(2)<100 THEN 25000
  218. 24700  IF P(2)<1980 THEN RETURN
  219. 24800  P(2)=P(2)-1900
  220. 24900  IF P(2)>100 THEN P(2)=P(2)-100
  221. 25000  IF P(0)<1 OR P(0)>12 THEN RETURN
  222. 25100  IF P(1)<1 THEN RETURN
  223. 25200  IF P(0)=2 THEN M=28+(1 AND(P(2)AND 3)=0):GOTO 25400
  224. 25300  M=30+(1 AND(ABS(2*P(0)-15)+1)/2)
  225. 25400  IF P(1)>M THEN RETURN
  226. 25500  Q(12)=INT(P(2)/10)
  227. 25600  Q(11)=P(2)-10*Q(12)
  228. 25700  Q(10)=INT(P(0)/10)
  229. 25800  Q(9)=P(0)-10*Q(10)
  230. 25900  Q(8)=INT(P(1)/10)
  231. 26000  Q(7)=P(1)-10*Q(8)
  232. 26100  L=P(0)>2 AND 1
  233. 26200  L=4 AND (L+P(2) AND 3)=0
  234. 26300  Q(8)=Q(8) OR L
  235. 26400  EF=0:RETURN
  236. 26500  '************* SUBROUTINE RESET CLOCK TIME **********
  237. 26600  EF=-1
  238. 26700  INPUT"ENTER NEW TIME (HH:MM): ",X$
  239. 26800  GOSUB 28000
  240. 26900  IF Z$<>":" THEN RETURN
  241. 27000  IF Y$<>"" OR J<>2 THEN RETURN
  242. 27100  IF P(0)<0 OR P(0)>23 THEN RETURN
  243. 27200  IF P(1)<0 OR P(1)>59 THEN RETURN
  244. 27300  Q(0)=0:Q(1)=0
  245. 27400  Q(5)=INT(P(0)/10)
  246. 27500  Q(4)=P(0)-10*Q(5)
  247. 27600  Q(5)=Q(5) OR 8
  248. 27700  Q(3)=INT(P(1)/10)
  249. 27800  Q(2)=P(1)-10*Q(3)
  250. 27900  EF=0:RETURN
  251. 28000  J=0:K=1:Z$=""
  252. 28100  Y$=MID$(X$,K,1)
  253. 28200  IF Y$=" "THEN K=K+1:GOTO 28100
  254. 28300  IF Y$<"0" OR Y$>"9" THEN RETURN
  255. 28400  P(J)=ASC(Y$)-48:K=K+1
  256. 28500  Y$=MID$(X$,K,1)
  257. 28600  IF Y$<"0" OR Y$>"9" THEN 28800
  258. 28700  P(J)=10*P(J)+ASC(Y$)-48:K=K+1:GOTO 28500
  259. 28800  IF Y$<>" " THEN 29000
  260. 28900  K=K+1:Y$=MID$(X$,K,1):GOTO 28800
  261. 29000  J=J+1 : IF J=3 THEN RETURN
  262. 29100  IF Y$="" THEN RETURN
  263. 29200  IF Z$="" THEN Z$=Y$
  264. 29300  IF Z$=Y$ THEN K=K+1:GOTO 28100
  265. 29400  RETURN
  266. 29500  '********* SET CLOCK FREQUENCY *************
  267. 29600  REM  PIN 9 - 1024 HZ   PIN 10 - 1 HZ
  268. 29700  OUT 531,144:OUT 529,15:OUT 530,160
  269. 29750  OUT 787,144:OUT 785,15:OUT 786,160
  270. 29800  PRINT:PRINT "FREQUENCY PERIOD = 976.5625 KHZ   PROBE PIN 9 OF CLOCK CHIP"
  271. 29900  PRINT:PRINT:INPUT "PRESS <ENTER> TO RESTART";A
  272. 30000  RUN
  273. 40800  '************* DUAL SERIAL SECOND PORT TEST ************
  274. 40900  GOSUB 14200
  275. 41000  GOTO 7600
  276. 41500  FOR J=1 TO 600:NEXT J
  277. 41510  RETURN
  278. 47000  '**** FUNCTION KEY 10 INTERRUPT ****
  279. 47010  DEF SEG=0:POKE 65521,0:POKE 65522,0:DEF SEG
  280. 47100  RUN
  281. 47200  '***** PRINT F10 INTERRUPT MESSAGE ******
  282. 47210  CLS
  283. 47220  LOCATE 25,5:COLOR 23:PRINT "F10":COLOR 7:LOCATE 25,17:PRINT "to return to QUADTEST diagnostics main menu.":LOCATE 1,1
  284. 47300  RETURN
  285. 49000  '*********** Initialize COM and LPT port address variables ************
  286. 49010  DEF SEG=&H40
  287. 49020  COMPORT1=PEEK(0)+256*PEEK(1)
  288. 49030  COMPORT2=PEEK(2)+256*PEEK(3)
  289. 49032  LPTPORT1=PEEK(8)+256*PEEK(9)
  290. 49034  LPTPORT2=PEEK(10)+256*PEEK(11)
  291. 49036  IF LPTPORT2=0 THEN LPTPORT2=LPTPORT1
  292. 49040  DEF SEG
  293. 49050  RETURN
  294. 50000  '*********** DISABLE FUNCTION KEYS ************
  295. 50005  FOR I=1 TO 14:KEY (I) ON
  296. 50006  IF I=10 THEN ON KEY (I) GOSUB 47000 ELSE ON KEY(I) GOSUB 50100
  297. 50007  NEXT I:KEY OFF
  298. 50010  RETURN
  299. 50100  RETURN
  300. 51000  '****** SAVE HIMEM SYSTEM STATE ******
  301. 51010  DEF SEG=0
  302.