10 'GR8NET OPL4 implementation diagnostic program
20 'Designed by Eugeny Brychkov 20200212
21 keyoff:width40:goto 30
22 PRINT:PRINT:out&hc6,5:out&hc7,3:out&h7e,255:se=inp(&h7f):out&h7e,254:fl=inp(&h7f)
30 PRINT"GR8NET OPL4 implementation":PRINT"diagnostic program"
31 'out&h7e,2:if(inp(&h7f)and&he0)<>32thenprint"OPL4 not detected":stop
32 PRINT"1. Get config properties":PRINT"2. Read sample ROM"
33 PRINT"3. Sample ROM burn-in test":PRINT"4. Read sample RAM"
41 PRINT"5. Sample RAM burn-in R/W test":PRINT"6. Read data cache registers - ROM"
42 PRINT"7. Read data cache registers - RAM":PRINT"8. Display PCM channel register set"
50 INPUT"Choice";A:PRINT:ONAGOTO70,110,180,210,230,310,340,350
60 STOP
70 'Get config properties
80 out&h7e,255:a=inp(&h7f):out&h7e,254:b=inp(&h7f)
90 PRINT"Sample ROM sector ";:gosub1000:PRINT:PRINT"Flags ";:a=b:gosub1000
100 GOTO22
110 'Read sample ROM
120 INPUT"Address (0..2097151):";A:out&h7e,2:out&h7f,1:m=2097151
130 x=fix(a/65536):out&h7e,3:out&h7f,fix(a/65536):b=a-x*65536
140 x=fix(b/256):out&h7e,4:out&h7f,fix(b/256):b=b-x*256:out&h7e,5:out&h7f,b:out&h7e,6
150 forj=0to16:fork=0to11:ifa+j*16+k>mthen22
160 a=inp(&h7f):gosub1000:PRINT" ";:nextk:PRINT:nextj
161 PRINT"Space=continue...":a$=input$(1):ifa$<>" "then22
170 goto150
180 'Sample ROM burn-in test, uses asm
190 restore200:defusr=&h9000:defusr1=&h9009:print"Press any key to stop..."
191 gosub1020:poke&h903a,se:a=usr(0):fori=0to255:a=peek(&h9100+i):gosub1000:print" ";:nexti:print:i=0
193 PRINTi\32;chr$(13);:a=usr1(0):a=peek(&h8fff):ifa<>0thenprint"Mismatch":stop
194 i=(i+1)and127:ifinkey$=""then193else22
200 'ROM burn-in test asm routines
201 data "F3210091CD2D90FBC9"
202 data "AF32FF8FF3210092CD2D9021009111009206001ABE2313200410F8FBC93E0132FF8FFBC9"
203 data "3E02D37E3E01D37F3E03D37E3E08D37F3E04D37EAFD37F3E05D37EAFD37F3E06D37E017F00EDB2C9"
204 data "XX"
210 'Read sample RAM
220 INPUT"Address (0..1048575):";A:out&h7e,2:out&h7f,3:m=3145727:a=a+2097152:goto130
230 'Sample RAM burn-in r/w test
240 restore300:defusr=&h9000:print"Press any key to stop..."
250 gosub1020:i=0
260 PRINTi;"   ";chr$(13);:poke&h9024,i:a=usr(0):a=peek(&h8fff):ifa<>0thenprint"Mismatch":stop
270 i=(i+1)and255:ifinkey$=""then260else22
300 data "F33E02D37E3E03D37F3E03D37E3E20D37F3E04D37EAFD37F3E05D37EAFD37F3E06D37E"
301 data "3E00F51100100600D37FC63710FA3C671B7AB37C20F2"
302 data "3E03D37E3E20D37F3E04D37EAFD37F3E05D37EAFD37F3E06D37E"
303 data "AF32FF8FF1110010017F00ED68BD200EC63710F73C671B7AB37C20ECFBC93E0132FF8FFBC9"
304 data "XX"
310 'Read data cache registers - ROM
320 out&h7e,2:out&h7f,1:out&h7e,3:out&h7f,0:out&h7e,4:out&h7f,0:out&h7e,5:out&h7f,0
330 fori=0to15:Printstring$(i*2," ");:out&h7e,&hfd:a=inp(&h7f):gosub1000:out&h7e,&hfc:a=inp(&h7f):gosub1000
331 out&h7e,&hfb:a=inp(&h7f):gosub1000:out&h7e,&hfa:a=inp(&h7f):gosub1000:print:out&h7e,6:a=inp(&h7f):nexti
332 PRINT"Space=continue...":a$=input$(1):ifa$<>" "then22
333 goto330
340 'Read data cache registers - RAM
341 out&h7e,2:out&h7f,3:out&h7e,3:out&h7f,&h20:out&h7e,4:out&h7f,0:out&h7e,5:out&h7f,0:goto330
350 'Display PCM channel register set
360 fori=0to23:PRINT"CH";:a=i:gosub1050:PRINT": ";:forj=0to9:out&h7e,8+j*24+i:a=inp(&h7f):gosub1000:PRINT" ";:nextj
361 ifi=23thenprint"..";:a$=input$(1):PRINT:goto22elsePRINT:nexti:goto22
999 '----------------------
1000 a$=hex$(a):iflen(a$)=1thenprint"0";
1010 printa$;:return
1011 gosub1000:print" ";:return
1020 p=&h9000
1025 reada$:a=len(a$):ifa=0or(aand1)=1thenprint"Error in hex":stop
1030 a=a/2-1:fori=0toa:b$=mid$(a$,i*2+1,2):ifb$="XX"thenreturn
1040 pokep,val("&H"+b$):p=p+1:nexti:goto1025
1050 a$=str$(a):l=len(a$):ifl=2thenprint" ";
1060 printright$(a$,l-1);:return