mirror of
https://github.com/Pecusx/libretro-atari800.git
synced 2026-05-21 14:49:36 +02:00
initial commit
This commit is contained in:
R-type
@@ -0,0 +1,185 @@
|
||||
10 REM Atari BASIC program to test emulator's H: device.
|
||||
20 REM Usage: atari800 -hreadwrite -H1 /path/to/test/dir hdevtest.lst
|
||||
30 REM Be patient! It takes ca. 40 seconds to load this program.
|
||||
40 REM You can also boot SpartaDOS and select e.g. "D1:" to be tested.
|
||||
50 REM
|
||||
90 DIM DEV$(10),LOGFN$(200),FN$(200),T1$(20),T2$(20),T3$(20),D$(300),C$(5)
|
||||
100 ? "Device to be tested (Return=H1:) ";:INPUT DEV$
|
||||
110 IF DEV$="" THEN DEV$="H1:"
|
||||
120 IF LEN(DEV$)<>3 OR DEV$(3)<>":" THEN ? "Must be of form: Xn:":END
|
||||
130 ? "Output report to which file"
|
||||
140 ? "(Return=H6:hdevtest.log) ";:INPUT LOGFN$
|
||||
150 IF LOGFN$="" THEN LOGFN$="H6:hdevtest.log"
|
||||
160 TRAP 10100:OPEN #2,8,0,LOGFN$:? #2;"Testing: ";DEV$
|
||||
200 ? "Test: Write binary: ";:? #2;"Test: Write binary: ";
|
||||
210 TRAP 10200:FN$=DEV$:FN$(4)="DELETE.ME":OPEN #1,8,0,FN$:RESTORE 10250
|
||||
220 READ BYTE:IF BYTE<0 THEN 240
|
||||
230 PUT #1,BYTE:GOTO 220
|
||||
240 CLOSE #1:? "Passed":? #2;"Passed"
|
||||
300 ? "Test: Read binary: ";:? #2;"Test: Read binary: ";
|
||||
310 BYTE=0:TRAP 10300:OPEN #1,4,0,FN$:RESTORE 10250
|
||||
320 READ BYTE:GET #1,FROMFILE:IF FROMFILE=BYTE THEN 320
|
||||
330 ? "FAILED: Wrong data":? #2;"FAILED: Wrong data":CLOSE #1:GOTO 400
|
||||
340 CLOSE #1:? "Passed":? #2;"Passed"
|
||||
400 ? "Test: Append binary: ";:? #2;"Test: Append binary: ";
|
||||
410 TRAP 10400:OPEN #1,9,0,FN$:RESTORE 10450
|
||||
420 READ BYTE:IF BYTE<0 THEN 440
|
||||
430 PUT #1,BYTE:GOTO 420
|
||||
440 CLOSE #1:? "Passed":? #2;"Passed"
|
||||
500 ? "Test: Read binary: ";:? #2;"Test: Read binary: ";
|
||||
510 BYTE=0:TRAP 10500:OPEN #1,4,0,FN$:RESTORE 10250
|
||||
520 READ BYTE:IF BYTE=-1 THEN READ BYTE
|
||||
530 GET #1,FROMFILE:IF FROMFILE=BYTE THEN 520
|
||||
540 ? "FAILED: Wrong data":? #2;"FAILED: Wrong data":CLOSE #1:GOTO 600
|
||||
550 CLOSE #1:? "Passed":? #2;"Passed"
|
||||
600 ? "Test: Update+Note+Point: ";:? #2;"Test: Update binary + Note + Point: ";
|
||||
610 TRAP 10600:OPEN #1,12,0,FN$:RESTORE 10250
|
||||
620 READ BYTE:IF BYTE<0 THEN 650
|
||||
630 GET #1,FROMFILE:IF FROMFILE=BYTE THEN 620
|
||||
640 ? "FAILED: Wrong data":? #2;"FAILED: Wrong data":CLOSE #1:GOTO 700
|
||||
650 NOTE #1,OFS1,OFS2:GET #1,FROMFILE:PUT #1,16:PUT #1,17:POINT #1,OFS1,OFS2
|
||||
660 GET #1,B1:GET #1,B2:GET #1,B3:GET #1,B4:IF B1=5 AND B2=16 AND B3=17 AND B4=8 THEN 690
|
||||
670 ? "FAILED: Wrong data: ";B1;",";B2;",";B3;",";B4
|
||||
680 ? #2;"FAILED: Wrong data: ";B1;",";B2;",";B3;",";B4:CLOSE #1:GOTO 700
|
||||
690 CLOSE #1:? "Passed":? #2;"Passed"
|
||||
700 IF DEV$(1,1)<>"H" THEN 1000
|
||||
710 ? "Test: Write text: ";:? #2;"Test: Write text: ";
|
||||
720 TRAP 10700:FN$(2,2)=CHR$(ASC(FN$(2,2))+5):OPEN #1,8,0,FN$
|
||||
730 REM Don't write CRLF, because it may get translated to CRCRLF
|
||||
740 ? #1;"Native EOL":? #1;"CR";CHR$(13);"LF";CHR$(10);
|
||||
750 CLOSE #1:? "Passed":? #2;"Passed"
|
||||
800 ? "Test: Read text: ";:? #2;"Test: Read text: ";
|
||||
810 TRAP 10800:OPEN #1,4,0,FN$:INPUT #1,T1$,T2$,T3$:CLOSE #1
|
||||
820 IF T1$<>"Native EOL" OR T2$<>"CR" OR T3$<>"LF" THEN ? "FAILED: Wrong data":? #2;"FAILED: Wrong data":GOTO 1000
|
||||
830 ? "Passed":? #2;"Passed"
|
||||
1000 ? "Test: Make directory: ";:? #2;"Test: Make directory: ";
|
||||
1010 TRAP 11000:FN$=DEV$:FN$(4)="TEMP.DIR":XIO 42,#1,0,0,FN$
|
||||
1020 ? "Passed":? #2;"Passed"
|
||||
1100 ? "Test: Directory handling: ";:? #2;"Test: Directory handling: ";
|
||||
1110 TRAP 11100:FN$(4)="TEMP.DIR>REMOVE.ME":OPEN #1,8,0,FN$:PUT #1,5:CLOSE #1
|
||||
1120 FN$(4)="TEMP.DIR>REMOVE.ME":GOSUB 1200:FN$(4)="TEMP.DIR\REMOVE.ME":GOSUB 1200
|
||||
1130 IF DEV$(1,1)="H" THEN FN$(4)="TEMP.DIR/REMOVE.ME":GOSUB 1200:FN$(4)="TEMP.DIR:REMOVE.ME":GOSUB 1200
|
||||
1140 FN$(4)="TEMP.DIR":XIO 44,#1,0,0,FN$:REM Change directory
|
||||
1150 FN$(4)="REMOVE.ME":GOSUB 1200:FN$(4)="<TEMP.DIR>REMOVE.ME":GOSUB 1200
|
||||
1160 FN$(4)="..\TEMP.DIR\REMOVE.ME":GOSUB 1200:IF DEV$(1,1)="H" THEN FN$(4)="../TEMP.DIR/REMOVE.ME":GOSUB 1200
|
||||
1170 FN$(4)="..":XIO 44,#1,0,0,FN$:REM Change directory
|
||||
1180 ? "Passed":? #2;"Passed":GOTO 1300
|
||||
1200 OPEN #1,4,0,FN$:GET #1,FROMFILE:CLOSE #1
|
||||
1210 IF FROMFILE<>5 THEN ? "FAILED: Wrong data":? #2;"FAILED: Wrong data":POP:GOTO 1300
|
||||
1220 RETURN
|
||||
1300 ? "Test: Read directory:":? #2;"Test: Read directory:"
|
||||
1310 AUX2=0:FN$(4)="*.*":GOSUB 1400:FN$(4)="*.M?":GOSUB 1400:FN$(4)=">?EL??E.M*":GOSUB 1400
|
||||
1320 FN$(4)="NOMATCH.*":GOSUB 1400:FN$(4)="TEMP.DIR>*.*":GOSUB 1400:FN$(4)="TEMP.DIR\NOMATCH.*":GOSUB 1400
|
||||
1330 AUX2=128:FN$(4)="*.*":GOSUB 1400:FN$(4)="*.M?":GOSUB 1400:FN$(4)=">?EL??E.M*":GOSUB 1400
|
||||
1340 FN$(4)="TEMP.DIR>*.*":GOSUB 1400:FN$(4)="TEMP.DIR>*.*":GOSUB 1400:FN$(4)="TEMP.DIR\NOMATCH.*":GOSUB 1400
|
||||
1350 ? "Finished":? #2;"Finished":GOTO 1500
|
||||
1400 IF AUX2>=128 THEN ? "Extended directory of ";FN$:? #2;"Extended directory of ";FN$:GOTO 1420
|
||||
1410 ? "Directory of ";FN$:? #2;"Directory of ";FN$
|
||||
1420 TRAP 11400:OPEN #1,6,AUX2,FN$
|
||||
1430 INPUT #1,D$:? D$:? #2;D$:GOTO 1430
|
||||
1500 IF DEV$(1,1)<>"H" THEN 1600
|
||||
1510 ? "Test: Access outside: ";:? #2;"Test: Access outside: ";
|
||||
1520 TRAP 1530:FN$(4)="..\*.*":OPEN #1,6,0,FN$:CLOSE #1:? "FAILED: Possible":? #2;"FAILED: Possible":GOTO 1600
|
||||
1530 TRAP 1550:FN$(4)=">..>*.*":CLOSE #1:OPEN #1,6,0,FN$:CLOSE #1
|
||||
1540 ? "FAILED: Possible":? #2;"FAILED: Possible":GOTO 1600
|
||||
1550 CLOSE #1:? "Passed (not allowed)":? #2;"Passed (not allowed)"
|
||||
1600 ? "Test: File length: ";:? #2;"Test: File length: ";
|
||||
1610 TRAP 11600:FN$(4)="RENAME.ME":OPEN #1,8,0,FN$:PUT #1,1:PUT #1,2:PUT #1,3:CLOSE #1
|
||||
1620 OPEN #1,4,0,FN$:XIO 39,#1,0,0,FN$:LEN=PEEK(860)+256*PEEK(861)+65536*PEEK(862):CLOSE #1
|
||||
1630 IF LEN<>3 THEN ? "FAILED: Returned ";LEN:? #2;"FAILED: Returned ";LEN:GOTO 1700
|
||||
1640 ? "Passed":? #2;"Passed"
|
||||
1700 ? "Test: Rename: ";:? #2;"Test: Rename: ";
|
||||
1710 TRAP 11700:FN$(4)="RENAME.ME,R?????D":XIO 32,#1,0,0,FN$
|
||||
1720 TRAP 1730:FN$(4)="RENAME.ME":OPEN #1,4,0,FN$:CLOSE #1:? "FAILED":? #2;"FAILED":GOTO 1800
|
||||
1730 TRAP 11700:FN$(4)="RENAMED":CLOSE #1:OPEN #1,4,0,FN$:CLOSE #1
|
||||
1740 ? "Passed":? #2;"Passed"
|
||||
1800 ? "Test: Lock: ";:? #2;"Test: Lock: ";
|
||||
1810 TRAP 11800:FN$(4)="LOCK.ME":OPEN #1,8,0,FN$:CLOSE #1:XIO 35,#1,0,0,FN$
|
||||
1820 TRAP 1830:OPEN #1,8,0,FN$:CLOSE #1:? "FAILED: Overwritten":? #2;"FAILED: Overwritten":GOTO 2000
|
||||
1830 CLOSE #1:TRAP 1840:XIO 33,#1,0,0,FN$:? "FAILED: Deleted":? #2;"FAILED: Deleted":GOTO 2000
|
||||
1840 TRAP 1850:FN$(4)="LOCK.ME,OHNO":XIO 32,#1,0,0,FN$:? "FAILED: Renamed":? #2;"FAILED: Renamed":GOTO 2000
|
||||
1850 ? :? #2:FN$(4)="*.*":? "Directory of ";FN$:? #2;"Directory of ";FN$:TRAP 11810:OPEN #1,6,0,FN$
|
||||
1860 INPUT #1,D$:? D$:? #2;D$:GOTO 1860
|
||||
1870 CLOSE #1:? "Finished":? #2;"Finished"
|
||||
2000 ? "Test: Disk info: ";:? #2;"Test: Disk info: ";
|
||||
2010 TRAP 12000:FN$(4)="ANYTHING":CMD=47:L=16:GOSUB 2090:GOTO 2200
|
||||
2080 ? CHR$(34);FN$;CHR$(34);"=";:? #2;CHR$(34);FN$;CHR$(34);"=";:L=0
|
||||
2090 POKE 850,CMD:FN$(LEN(FN$)+1)=CHR$(155):INBUF=ADR(FN$):POKE 852,ASC(CHR$(INBUF)):POKE 853,INT(INBUF/256):I=0
|
||||
2100 D$="xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx":OUTBUF=ADR(D$):POKE 856,ASC(CHR$(OUTBUF)):POKE 857,INT(OUTBUF/256)
|
||||
2110 POKE 960,104:POKE 961,162:POKE 962,16:POKE 963,76:POKE 964,86:POKE 965,228:I=USR(960)
|
||||
2120 IF PEEK(851)>=128 THEN POP:POKE 195,PEEK(851):GOTO PEEK(188)+256*PEEK(189):REM Goto TRAP handler
|
||||
2130 IF L>0 THEN 2150
|
||||
2140 IF L<30 AND ASC(D$(L+1,L+1))<>0 THEN L=L+1:GOTO 2140
|
||||
2150 ? CHR$(34);:? #2;CHR$(34);:IF L=0 THEN 2190
|
||||
2160 FOR I=1 TO L:C$=D$(I,I):C=ASC(C$)
|
||||
2170 IF C<32 OR C>122 THEN C$="\x":C$(3)=CHR$(48+INT(C/16)+7*(C>159)):C=C-16*INT(C/16):C$(4)=CHR$(48+C+7*(C>9))
|
||||
2180 ? C$;:? #2;C$;:NEXT I
|
||||
2190 ? CHR$(34):? #2;CHR$(34):RETURN
|
||||
2200 ? "Test: To absolute path:":? #2;"Test: To absolute path:"
|
||||
2210 TRAP 12200:CMD=48:FN$(4)="":GOSUB 2080:FN$(4)=">":GOSUB 2080
|
||||
2220 FN$(4)="TEMP.DIR":GOSUB 2080:FN$(4)="TEMP.DIR>":GOSUB 2080
|
||||
2230 FN$(4)="TEMP.DIR":? "Changing directory to ";FN$:? #2;"Changing directory to ";FN$:XIO 44,#1,0,0,FN$
|
||||
2240 FN$(4)="":GOSUB 2080:FN$(4)="\":GOSUB 2080:FN$(4)="..":GOSUB 2080
|
||||
2250 FN$(4)="<":GOSUB 2080:FN$(4)="<TEMP.DIR":GOSUB 2080
|
||||
2260 FN$(4)="..\TEMP.DIR\":GOSUB 2080:IF DEV$(1,1)="H" THEN FN$(4)="../TEMP.DIR":GOSUB 2080
|
||||
2270 FN$(4)=">":XIO 44,#1,0,0,FN$:REM Change directory
|
||||
2280 ? "Finished":? #2;"Finished"
|
||||
2300 ? "Test: Delete file: ";:? #2;"Test: Delete file: ";
|
||||
2310 TRAP 12300:FN$(4)="DELETE.ME":XIO 33,#1,0,0,FN$:FN$(4)="RENAMED":XIO 33,#1,0,0,FN$
|
||||
2320 TRAP 2330:OPEN #1,4,0,FN$:CLOSE #1:? "FAILED: File exists":? #2;"FAILED: File exists":GOTO 2400
|
||||
2330 TRAP 12300:FN$(4)="TEMP.DIR>REMO*.*":XIO 33,#1,0,0,FN$:FN$(4)="TEMP.DIR>REMOVE.ME"
|
||||
2340 TRAP 2350:OPEN #1,4,0,FN$:CLOSE #1:? "FAILED: File exists":? #2;"FAILED: File exists":GOTO 2400
|
||||
2350 CLOSE #1:TRAP 2370:FN$(4)="LOCK.ME":XIO 33,#1,0,0,FN$
|
||||
2360 ? "FAILED: Deleted locked file":? #2;"FAILED: Deleted locked file":GOTO 2400
|
||||
2370 TRAP 12300:XIO 36,#1,0,0,FN$:XIO 33,#1,0,0,FN$
|
||||
2380 ? "Passed":? #2;"Passed"
|
||||
2400 ? "Test: Remove directory: ";:? #2;"Test: Remove directory: ";
|
||||
2410 TRAP 12400:FN$(4)="TEMP.DIR":XIO 43,#1,0,0,FN$
|
||||
2420 TRAP 2430:XIO 44,#1,0,0,FN$:? "FAILED: Can CD":? #2;"FAILED: Can CD":FN$(4)=">":XIO 44,#1,0,0,FN$:GOTO 2500
|
||||
2430 ? "Passed":? #2;"Passed"
|
||||
2500 ? "Test: Load executable (Sparta): ";:? #2;"Test: Load executable (Sparta): ";
|
||||
2510 TRAP 12500:FN$(4)="TEMP.XEX":OPEN #1,8,0,FN$:PUT #1,255:PUT #1,255
|
||||
2520 PUT #1,192:PUT #1,3:PUT #1,192:PUT #1,3:PUT #1,15:CLOSE #1:XIO 40,#1,0,128,FN$
|
||||
2530 IF PEEK(960)<>15 THEN ? "FAILED: Not loaded":? #2;"FAILED: Not loaded":GOTO 2600
|
||||
2540 IF DEV$(1,1)<>"H" THEN 2590
|
||||
2550 FN$(4)=">DOS":XIO 42,#1,0,0,FN$:FN$(4)=">DOS>ONPATH.XEX":OPEN #1,8,0,FN$:PUT #1,255:PUT #1,255
|
||||
2560 PUT #1,192:PUT #1,3:PUT #1,192:PUT #1,3:PUT #1,25:CLOSE #1:FN$(4)="ONPATH.XEX":XIO 40,#1,0,128,FN$
|
||||
2570 FN$(4)=">DOS>ONPATH.XEX":XIO 33,#1,0,0,FN$:FN$(4)=">DOS":XIO 43,#1,0,0,FN$:REM Delete file and directory
|
||||
2580 IF PEEK(960)<>25 THEN ? "FAILED: Not found on PATH":? #2;"FAILED: Not found on PATH":GOTO 2600
|
||||
2590 ? "Passed":? #2;"Passed"
|
||||
2600 IF DEV$(1,1)<>"H" THEN FN$(4)="TEMP.XEX":XIO 33,#1,0,0,FN$:GOTO 2700
|
||||
2610 ? "Test: Load executable (MyDOS): ";:? #2;"Test: Load executable (MyDOS): ";
|
||||
2620 TRAP 12600:POKE 960,0:FN$(4)="TEMP.XEX":XIO 39,#1,7,0,FN$:XIO 33,#1,0,0,FN$:REM Load and delete
|
||||
2630 IF PEEK(960)<>15 THEN ? "FAILED: Not loaded":? #2;"FAILED: Not loaded":GOTO 2700
|
||||
2640 ? "Passed":? #2;"Passed"
|
||||
2700 REM
|
||||
9000 ? "End of tests":? #2;"End of tests":CLOSE #2:END
|
||||
10100 ? "Error ";PEEK(195);" opening ";LOGFN$
|
||||
10110 IF LOGFN$(1,1)="H" AND PEEK(195)=163 THEN ? "You should enable write to H: devices"
|
||||
10120 END
|
||||
10200 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 300
|
||||
10250 DATA 0,1,2,3,4,13,10,26,65,96,155,255,-1
|
||||
10300 IF PEEK(195)=136 AND BYTE<0 THEN 340
|
||||
10310 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 400
|
||||
10400 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 500
|
||||
10450 DATA 5,6,7,8,9,13,10,26,66,98,155,255,-2
|
||||
10500 IF PEEK(195)=136 AND BYTE<0 THEN 550
|
||||
10510 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 600
|
||||
10600 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 700
|
||||
10700 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 800
|
||||
10800 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 1000
|
||||
11000 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 1100
|
||||
11100 ? "FAILED: Error ";PEEK(195);" for ";FN$:? #2;"FAILED: Error ";PEEK(195);" for ";FN$:CLOSE #1:GOTO 1300
|
||||
11400 IF PEEK(195)=136 THEN CLOSE #1:RETURN
|
||||
11410 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 1500
|
||||
11600 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 1700
|
||||
11700 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 1800
|
||||
11800 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 2000
|
||||
11810 IF PEEK(195)=136 THEN 1870
|
||||
11820 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 2000
|
||||
12000 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 2200
|
||||
12200 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 2300
|
||||
12300 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 2400
|
||||
12400 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 2500
|
||||
12500 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 2600
|
||||
12600 ? "FAILED: Error ";PEEK(195):? #2;"FAILED: Error ";PEEK(195):CLOSE #1:GOTO 2700
|
||||
Reference in New Issue
Block a user