home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / MEMORIA / QUADRAM.ZIP / MEMTEST.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1983-09-19  |  8.7 KB  |  224 lines
  1. 100  '************* MEMTEST.BAS ****************
  2. 200  '*           REVISION 8/22/83              *
  3. 300  '*         QUADRAM CORPORATION            *
  4. 400  '*           4357 PARK DRIVE              *
  5. 500  '*         NORCROSS, GA  30093            *
  6. 600  '*   Machine code memory check routine,   *
  7. 700  '*   subprogram of QUADTEST program for   *
  8. 750  '* Quadboard and expansion memory boards. *
  9. 900  '******************************************
  10. 1000  '
  11. 1100  '********* INITIALIZE **************
  12. 1106  SCREEN 0:WIDTH 80:KEY OFF
  13. 1200  IF CH$="" THEN CLEAR ,18000
  14. 1205  KEY (10) ON:ON KEY (10) GOSUB 47000        'escape to main program
  15. 1210  FALSE=0:TRUE=NOT FALSE
  16. 1215  PC.XT=TRUE
  17. 1220  DATA &H55,&HAA,&H10,&HEB,&H1E
  18. 1230  DEF SEG=&HC800:FOR I=0 TO 4:READ A:IF PEEK(I)<>A THEN PC.XT=FALSE
  19. 1240  NEXT I
  20. 1250  DEF SEG
  21. 1300  IF FRE(0)>4800 THEN DOS.2.0=FALSE ELSE DOS.2.0=TRUE
  22. 1500  DIM MEMCODE%(164),MEM.ERR%(15)
  23. 1510  DEF FNF$(X)=STRING$(4-LEN(HEX$(X))," ")+HEX$(X)+" "
  24. 1520  POKE 106,0         'Clear BASICA input buffer
  25. 1600  GOSUB 40000        'Variable Passer
  26. 1610  CLS
  27. 1620  LOCATE 25,5:COLOR 23:PRINT "F10 <ENTER>":LOCATE 25,16:COLOR 7:PRINT " to return to QUADTEST diagnostics main menu."
  28. 1700  IF MEM.SIZE=64 OR NOT DOS.2.0 OR PC.XT THEN 1800
  29. 1710  PRINT TAB(5)"System switches should be set to 64K for 2.0 DOS"
  30. 1720  PRINT TAB(5)"or memory allocation error may occur when exiting BASIC."
  31. 1800  PM%=0:EM%=0      'Pass number and total errors variables
  32. 6200  GOTO 9600
  33. 6400  GOSUB 11700        'mem check
  34. 6500  PRINT
  35. 6700  GOTO 6400
  36. 7600  '******* ALL FUNCTIONS CHECK *********
  37. 7700  GOSUB 11700        'mem check
  38. 7800  GOTO 48000
  39. 9600  '*********** MEMORY CHECK ****************
  40. 9620  GOSUB 41000        'Print menu
  41. 10300  BEEP:PRINT:PRINT TAB(5)"How much expansion memory is installed? ";:CHO$=INPUT$(1):PRINT CHO$:IF CHO$="H" OR CHO$="h" THEN GOSUB 41600
  42. 10500  XM%=VAL("&H"+CHO$)     'XM%=Segment # of last segment to check (1 to E)
  43. 10505  XM%=XM%+S.B.-1:IF XM%>10 THEN XM%=XM%+1
  44. 10510  IF XM%<S.B. OR XM%>14 THEN 9620
  45. 10530  LOCATE 25,9:PRINT "       ";:LOCATE 14,1
  46. 10600  R.B.N.=1:PRINT "         ";:FOR I=S.B. TO XM%:IF I<>11 THEN PRINT STR$(R.B.N.*64);"K";:R.B.N.=R.B.N.+1
  47. 10620  NEXT I:PRINT
  48. 10700  'First set up USR memory check subroutine
  49. 10710  DEF SEG
  50. 10800  READ MCSZ:FOR I=0 TO (MCSZ/2-1):READ C,D:ICODE!=C+256*D:IF ICODE!>=32768 THEN MEMCODE%(I)=ICODE!-65536 ELSE MEMCODE%(I)=ICODE!
  51. 10810  NEXT I
  52. 11600  IF CH$="1" OR CH$="" THEN 6400
  53. 11650  IF CH$="A" OR CH$="S" THEN 7600
  54. 11660  END
  55. 11700  '********** MEMORY CHECK SUBROUTINE **************
  56. 11800  'Calls USR subroutine to do memory check for one complete pass
  57. 11900  PM%=PM%+1
  58. 12000  PRINT STRING$(70," ");:LOCATE CSRLIN,1:PRINT"PASS";PM%;TAB(10);
  59. 12210  ME=0        'Initialize memory error code variable
  60. 12220              'so MEMCODE%() won't get moved.
  61. 12300  FOR IME%=S.B. TO XM%
  62. 12305  IF IME%=11 THEN 12700
  63. 12306  OUT &HA0,0         'DISABLE NMI
  64. 12307  OUT &H61,(INP(&H61) AND &HDF)       'enable i/o channel check
  65. 12310  DEF USR0=VARPTR(MEMCODE%(0))
  66. 12500  ME = USR0(IME%):GOSUB 47200:IF ME=0 THEN PRINT".... ";:GOTO 12700   'gosub to normalize NMI
  67. 12510  SOUND 60,5
  68. 12520  MEM.ERR%(IME%-S.B.+1)=ME:IF CH$<>"A" AND CH$<>"S" THEN Y=CSRLIN:X=POS(0):LOCATE 25,5:PRINT STRING$(60," ");:LOCATE 25,5:COLOR 31:PRINT "Memory Error detected. F10 for visual location.";:COLOR 7:LOCATE Y,X
  69. 12600  PRINT FNF$(ME);:EM%=EM%+1
  70. 12700  NEXT
  71. 12800  PRINT" TOT ERRS=";EM%;
  72. 12900  RETURN
  73. 40000  '****** VARIABLE RECEIVER *********
  74. 40010  'Chaining won't work.
  75. 40020  DEF SEG=0
  76. 40030  POKE 1050,PEEK(1052)      'Clear keyboard buffer
  77. 40040  MEM.SIZE=PEEK(1043)+256*PEEK(1044)
  78. 40050  IO.MEM.SIZE=PEEK(1045)+256*PEEK(1046)
  79. 40060  IF PEEK(65521)=206 AND PEEK(65522)=216 THEN XM%=PEEK(65524):PM%=PEEK(65525)+256*PEEK(65526):EM%=PEEK(65527)+256*PEEK(65528):S.B.=PEEK(65529):RETURN 10700
  80. 40070  DEF SEG
  81. 40080  RETURN
  82. 41000  '******* PRINT MEMORY TEST MENU ********
  83. 41005  LOCATE 1,10:PRINT "Expansion Memory Test"
  84. 41020  '* Determine Start Block and Column Length of menu
  85. 41022  IF S.B.<>0 THEN 41040
  86. 41025  C.L.=7
  87. 41031  PRINT
  88. 41032  PRINT "How much memory is installed on the PC system board (1-4)?"
  89. 41033  PRINT
  90. 41034  PRINT "1.  64K":PRINT "2. 128K":PRINT "3. 192K":PRINT "4. 256K"
  91. 41035  PRINT
  92. 41036  Q1$=INPUT$(1):S.B.=VAL(Q1$)
  93. 41038  IF S.B.<1 OR S.B.>4 THEN 41032
  94. 41039  LOCATE 24,1:FOR I=1 TO 24:PRINT:NEXT I
  95. 41040  COL=5
  96. 41050  LN=3
  97. 41055  R.B.N.=1   'relative block number
  98. 41060  FOR I=S.B. TO 14
  99. 41070  IF I=11 THEN GOTO 41120
  100. 41080  LOCATE LN,COL
  101. 41090  PRINT HEX$(R.B.N.);" - ";STR$(R.B.N.*64);"K RAM"
  102. 41100  R.B.N.=R.B.N.+1
  103. 41110  IF LN=C.L.+2 THEN LN=3:COL=20 ELSE LN=LN+1
  104. 41120  NEXT I
  105. 41130  LOCATE 3+C.L.,20:PRINT "H -  HELP"
  106. 41140  RETURN
  107. 41600  '*********** MEMORY TEST HELP SUBROUTINE *********
  108. 41700  CTR=1
  109. 41800  CLS:OPEN "I",#1,"HELPFILE.TXT"
  110. 41900  WHILE NOT EOF(1)
  111. 42000  LINE INPUT #1,L$:PRINT L$:CTR=CTR+1
  112. 42100  IF (CTR MOD 23)=0 THEN LOCATE 25,1:LINE INPUT "PRESS ENTER FOR NEXT PAGE ";G$:CLS
  113. 42200  WEND
  114. 42300  CLOSE #1
  115. 42400  LOCATE 25,1:LINE INPUT "PRESS ENTER TO RETURN TO MEMORY TEST MENU ";G$
  116. 42500  GOTO 1610
  117. 42600  '*************** DATA FOR MEMORY CHECK USR ROUTINE **********
  118. 42700  DATA &h148
  119. 42800  DATA 235, 73, 144, 13, 10, 77, 69, 77, 66, 65
  120. 42900  DATA 83, 13, 10, 66, 121, 32, 87, 105, 108, 108
  121. 43000  DATA 105, 97, 109, 32, 66, 46, 32, 77, 99, 67
  122. 43100  DATA 111, 114, 109, 105, 99, 107, 13, 10, 40, 67
  123. 43200  DATA 41, 49, 57, 56, 50, 44, 32, 81, 117, 97
  124. 43300  DATA 100, 114, 97, 109, 32, 67, 111, 114, 112, 46
  125. 43400  DATA 13, 10, 26, 0, 0, 31, 7, 51, 219, 154
  126. 43500  DATA 7, 0, 0, 246, 203, 154, 3, 0, 0, 246
  127. 43600  DATA 6, 30, 138, 195, 10, 192, 116, 233, 60, 14
  128. 43700  DATA 119, 229, 50, 228, 187, 0, 16, 247, 227, 142
  129. 43800  DATA 216, 142, 192, 51, 210, 190, 0, 0, 191, 0
  130. 43900  DATA 0, 252, 185, 0, 128, 139, 194, 171, 173, 51
  131. 44000  DATA 194, 117, 62, 226, 246, 185, 0, 128, 173, 51
  132. 44100  DATA 194, 117, 52, 226, 249, 11, 210, 116, 24, 66
  133. 44200  DATA 116, 14, 74, 129, 250, 85, 170, 116, 21, 186
  134. 44300  DATA 85, 170, 139, 194, 235, 205, 186, 170, 85, 139
  135. 44400  DATA 194, 235, 198, 184, 255, 255, 139, 208, 235, 191
  136. 44500  DATA 185, 0, 128, 184, 254, 90, 242, 171, 185, 0
  137. 44600  DATA 128, 243, 175, 116, 27, 31, 7, 34, 228, 116
  138. 44700  DATA 2, 138, 196, 50, 228, 139, 216, 228, 98, 36
  139. 44800  DATA 192, 116, 3, 128, 207, 1, 154, 7, 0, 0
  140. 44900  DATA 246, 203, 180, 44, 205, 33, 3, 202, 129, 241
  141. 45000  DATA 90, 165, 139, 209, 185, 0, 128,139, 234, 144
  142. 45100  DATA 144,144,139, 194, 171, 173, 51, 194, 117, 201
  143. 45200  DATA 232, 38, 0, 226, 243, 139, 213, 144, 144, 144
  144. 45300  DATA 185, 0, 128, 173, 51, 194, 117, 183, 232, 20
  145. 45400  DATA 0, 226, 246, 31, 7, 51, 219, 228, 98, 36
  146. 45500  DATA 192, 116, 2, 254, 199, 154, 7, 0, 0, 246
  147. 45600  DATA 203, 81, 50, 194, 138, 248, 177, 4, 210, 200
  148. 45700  DATA 36, 15, 50, 199, 138, 216, 254, 201, 210, 200
  149. 45800  DATA 138, 248, 36, 31, 50, 198, 138, 208, 138, 199
  150. 45900  DATA 36, 224, 50, 195, 138, 240, 138, 199, 208, 200
  151. 46000  DATA 36, 240, 50, 194, 138, 208, 89, 195
  152. 47000  '******** FUNCTION KEY 10 INTERRUPT *********
  153. 47005  GOSUB 47200       'normalize NMI
  154. 47010  IF CH$="A" OR CH$="S" THEN DEF SEG=0:POKE 65521,0:POKE 65522,0:DEF SEG:GOTO 47050   'Re-initialize control variables for restart
  155. 47015  IF NO.QUAD.ERR THEN 47050
  156. 47020  IF EM%<>0 THEN 60000
  157. 47050  CLEAR ,32000
  158. 47100  RUN "QUADTEST"
  159. 47200  '******** NMI NORMALIZE ********
  160. 47210  OUT &H61,(INP(&H61) OR &H20):OUT &H61,(INP(&H61) AND &HDF):OUT &HA0,80
  161. 47220  RETURN
  162. 48000  '******** ALL FUNCTIONS CHECK VARIABLE PASSER *******
  163. 48010  DEF SEG=0:POKE 65521,206:POKE 65522,216:POKE 65523,ASC(CH$):POKE 65524,XM%:POKE 65525,PM% MOD 256:POKE 65526,INT(PM%/256):POKE 65527,EM% MOD 256:POKE 65528,INT(EM%/256):POKE 65529,S.B.:DEF SEG
  164. 48050  CLEAR ,32000
  165. 48100  RUN "QUADTEST"
  166. 60000  '****** MEMORY ERROR VISUAL LOCATER *******
  167. 60010  FOR I=1 TO 4:IF MEM.ERR%(I)<>0 THEN QUAD.ERR=TRUE
  168. 60020  NEXT I:IF QUAD.ERR<>TRUE THEN GOSUB 65200:RETURN
  169. 60035  CLS':PRINT TAB(5);"Quadboard should be started at address";S.B.*64;"K for this routine.":PRINT TAB(5);:LINE INPUT "Press <enter> to continue ";Q1$:CLS
  170. 60040  SCREEN 2:CLS
  171. 60050  DEF SEG=0:IF (PEEK(&H410) AND &H30)<>&H30 THEN 60300
  172. 60100  LOCATE 8,1: PRINT"     This routine of the Quadtest program will only function if the IBM color/  graphics adapter or equivalent is installed in the system.": LOCATE 12,1: LINE INPUT "Press <ENTER> ";A$:RETURN
  173. 60300  CLS:PRINT TAB(5);"Quadboard should be started at address";S.B.*64;"K for this routine.":PRINT TAB(5);:LINE INPUT "Press <enter> to continue ";Q1$:CLS
  174. 60310  SCREEN 2:EM%=0:ER$(0)="PAR":FOR I=1 TO 8:ER$(I)=" D"+RIGHT$(STR$(I-1),1):NEXT I
  175. 60400  NA$="n/a"
  176. 60600  GOSUB 60800
  177. 60610  GOSUB 61800
  178. 60700  GOTO 64000
  179. 60800  '****** GET PARAMETERS *******
  180. 60820  MEMORY=XM%
  181. 61100  BOARD=1
  182. 61600  RETURN
  183. 61700  REM *** display Quadboard screen ***
  184. 61800  A=200:B=36:SZ=16:FOR X=A TO A+54*3 STEP 54:FOR Y=B TO B+9*SZ-1 STEP SZ:LINE (X,Y)-(X+50,Y+SZ),,B:NEXT:NEXT
  185. 61900  LOCATE 1,20:PRINT "Quadboard memory chips diagram"
  186. 62000  LOCATE 4,27: IF MEMORY>3 THEN PRINT"256k" ELSE PRINT " "NA$
  187. 62100  LOCATE 4,34: IF MEMORY>2 THEN PRINT"192k" ELSE PRINT " "NA$
  188. 62200  LOCATE 4,41: IF MEMORY>1 THEN PRINT"128k" ELSE PRINT " "NA$
  189. 62300  LOCATE 4,48: PRINT"64k"
  190. 62400  FOR I=0 TO 8: LOCATE I*2+6,21: PRINT ER$(8-I): LOCATE I*2+6,54:NEXT
  191. 62500  RETURN
  192. 64000  '***** PAINT BAD CHIPS **********
  193. 64050  IF MEMORY>4 THEN LAST.COLUMN=4 ELSE LAST.COLUMN=MEMORY
  194. 64100  FOR J=1 TO LAST.COLUMN
  195. 64200  IF INT(MEM.ERR%(J)/256)>1 THEN LOCATE 3,25+7*(J-1):PRINT "* ";HEX$(MEM.ERR%(J));:LOCATE 25,62:PRINT "* NON-MEM ERR CODE";:GOTO 64820
  196. 64250  IF MEM.ERR%(J)=0 THEN 64820
  197. 64300  EC%=MEM.ERR%(J) MOD 256
  198. 64310  BCF=FALSE         'Bad Chip Found?
  199. 64400  FOR K=0 TO 7
  200. 64600  BIT=EC% AND 2^K
  201. 64700  IF BIT<>0 THEN GOSUB 65000         'PAINT A CHIP
  202. 64800  NEXT K
  203. 64810  IF NOT BCF THEN GOSUB 65000       'PAINT A CHIP
  204. 64820  NEXT J
  205. 64830  BEEP:LOCATE 24,20:PRINT "Bad chip(s) painted in foreground color.";
  206. 64840  KEY (10) ON:ON KEY (10) GOSUB 47000:LOCATE 25,14:PRINT "F10 to return to QUADTEST diagnostics main menu.";
  207. 64850  GOTO 64850
  208. 65000  '******** PAINT A CHIP **********
  209. 65010  GOSUB 65100       ;GET.XY
  210. 65020  IF TOGGLE=0 THEN PAINT (X,Y),1,1
  211. 65030  BCF=TRUE
  212. 65040  RETURN
  213. 65100  '********* GET.XY **********
  214. 65110  K1=(K+1) MOD 9
  215. 65120  X=228+(4-J)*56
  216. 65130  Y=48+(8-K1)*16
  217. 65140  RETURN
  218. 65200  '***** Mem error not on Quadboard *****
  219. 65205  NO.QUAD.ERR=TRUE
  220. 65210  LN=CSRLIN:COL=POS(0)
  221. 65250  SOUND 40,8:PRINT:PRINT:PRINT "Quadboard should be started at address";S.B.*64;"K for this routine.":PRINT "No memory error has been detected in that range.":LINE INPUT "Press <ENTER> to continue ";Q1$
  222. 65260  LOCATE LN+1,1:FOR K1=1 TO 4:PRINT STRING$(80," ");:NEXT K1:LOCATE LN,COL
  223. 65270  RETURN
  224.