!	 SDOS 1.1 Diagnostic
!	 Tests SDOS for proper operation
!
!	Line Numbers are used within tests only for branch pts
!	or for parts of the code that actually perform the desired test
!	Setup code is presumed to work perfectly; if it fails,
!	some other part of the diagnostic will fail!
!	All channels opened by a test are closed upon successful completion of test

	Dim MaxTestNumber/99/
	Dim OnDiskFile$/" on a Disk File"/,OnDiskDevice$/" on a Disk Device"/
	Dim Null$(0)
	Dim OneByte$(1),A5$/:a5/,TempFileName$/"Test.Tmp"/,Disk$/"Disk:",:d/
	Rem Temp$ and Temp1$ must be the same length!
	Rem Temp$ is 128 long so syscalls of max length can be constructed in it
	Dim Temp$(128),Temp1$(128)
	Dim ScratchDisk$(20)/""/
	Dim ToConsole$/" to CONSOLE:"/


	Dim AttnCheck$/:19,2/
	Dim Rename$/3,14,0,0/
	Dim CCIllegal$/:e,:4,0,:ff/,SCIllegal$/:f,14,0,:FF/

	Dim SCGetPos$/:f,14,0,0/
	Dim SCGetCol$/:f,14,0,1/
	Dim SCGetEof$/:f,14,0,2/
	Dim SCGetFileSize$/:f,14,0,3/
	Dim SCGetType$/:f,14,0,4/
	Dim SCGetParams$/:f,14,0,5/

	Dim CCPosition$/:e,8,0,1/
	Dim CCDumpBuffers$/:e,4,0,2/

	Dim CCEcho$/:e,4,0,:10/
	Dim CCNoEcho$/:e,4,0,:11/
	Dim CCIdles$/:e,:8,0,:12/
	Dim CCTabs$/:e,:8,0,:13/


	Dim Interlock$/:1b,14,0,0/
	Dim Delay0$/:1c,4,0,0/,Delay600$/:1c,4,2,88/
	Dim Readlun$/:1d,14,0,0/

Def Value(Valuearg$)
	Rem Function that returns value of bytes in Valuearg$
	Let ValueResult=0
	For i=1 to len(Valuearg$)
		Let Valueresult=Valueresult*256+Valuearg$[i]
	Next i
	Return Valueresult
End

Def MSB(MSBarg)=Int(MSBarg/256)

Def LSB(LSBarg)=LSBarg-MSB(LSBarg)

! ******* Diagnostic Main program starts here

	Print "SDOS 1.1 Diagnostic V1.1 Part 1: VT driver tests and non-disk (file) Syscalls"
AskTest: ! Ask for test to run next
	Input "Test number (default is 'all', '?' list test names): " Temp$
	! Assume we'll run a bunch of tests
	AutoPilot=True
	DontExecute=False
	If Temp$=""
	Then
		For TestNumber=1 to MaxTestNumber
			Gosub BranchonTestNumber
		Next TestNumber
		Print "Diagnostic test completed."
		Goto AskTest
	Elseif Temp$="?"
	Then
		! Display all the options
		Dontexecute=true
		For TestNumber=1 to MaxTestNumber
			Gosub BranchOnTestNumber
		Next TestNumber
		Goto AskTest
	Fi
	If Error When TestNumber=Val(Temp$)
	Then
		If Temp$[1,1]=">"
		Then
			For TestNumber=Val(Right$(Temp$,2))+1 to MaxTestNumber
				Gosub BranchOnTestNumber
			Next TestNumber
			Print "Partial Test completed."
		Else Print "Idiot..."
		Goto AskTest
	Else
		Autopilot=false
		If TestNumber=0 then Exit
		If TestNumber<1 or TestNumber>MaxTestNumber
		Then Print "Illegal Test Number"
		Else Gosub BranchOnTestNumber
		Goto AskTest
	Fi

BranchOnTestNumber:
	Print "Test #";TestNumber;
	On TestNumber Goto 100,200,300,400,500,600,700,800,900,...
&	1000,1100,1200,1300,1400,1500,1600,1700,1800,1900,...
&	2000,2100,2200,2300,2400,2500,2600,2700,2800,2900,...
&	3000,3100,3200,3300,3400,3500,3600,3700,3800,3900,...
&	4000,4100,4200,4300,4400,4500,4600,4700,4800,4900,...
&	5000,5100,5200,5300,5400,5500,5600,5700,5800,5900,...
&	6000,6100,6200,6300,6400,6500,6600,6700,6800,6900,...
&	7000,7100,7200,7300,7400,7500,7600,7700,7800,7900,...
&	8000,8100,8200,8300,8400,8500,8600,8700,8800,8900,...
&	9000,9100,9200,9300,9400,9500,9600,9700,9800,9900
	Print "MaxTestNumber is wrong..."
	Return

NonexistentTest: Print "Nonexistent test"
	Return

IncompleteTest:
	Print "This test is not yet complete!"
	Return

Fail:	! Test failed
	Print "Failed to pass"
	If not Autopilot
	then
		If Error When Close #1
		Then if Err<>1032 Then Error fi
		Gosub Pop 0\ Goto AskTest
	Fi
	Return

100	Print "Print Text on CONSOLE:"
	! Test all characters that they do as expected
	! Test single byte writes and very large buffer writes
	Goto IncompleteTest
	Return

200	Print "Input Text from CONSOLE:"
	If Dontexecute or Autopilot then Return
	Input "Please enter some text: " Temp$
	Print "The text you entered was: >";Temp$;"<"
	! Test all editing charaters
	Goto IncompleteTest
	Return

300	Print "Open/Print/Close CONSOLE:"
	If Dontexecute then Return
	Open #1,"CONSOLE:"
	Print #1,"This text is from Open/Print/Close CONSOLE: Test"
	Close #1
	Goto IncompleteTest
	Return

400	Print "Create/Print/Close CONSOLE:"
	If Dontexecute then Return
	Create #1,"CONSOLE:"
	Print #1,"This text is from Create/Print/Close CONSOLE: Test"
	Close #1
	Goto IncompleteTest
	Return

500	Print "Write binary";ToConsole$
	If Dontexecute then Return
	For i=0 to :ff do write #0,chr$(i)
	Goto IncompleteTest
	Return

600	Print "Read binary from CONSOLE:"
	If Dontexecute or Autopilot then Return
	Let Len(Temp$)=5
	Read #0,Temp$[1,5]
	For i=1 to 5 do print Hex$(Temp$[i]);" ";
	Print
	Goto IncompleteTest
	Return

700	Print "Syscall:Attncheck on CONSOLE:"
	If Dontexecute or Autopilot then Return
	Print "Please put Escape after 10 seconds"
	For i=0 to 65535
		If Error When Syscall AttnCheck$
		Then If Err=1 Then 710 Else Fail fi
	Next i
	Print "No attention seen!"
	Goto Fail
710	If i=0 then fail
	If Error When Input "Please hit Escape again: " Temp$
	Then If Err<>1 Then Fail fi
	Else Fail
	Print
	Return

800	Print "Syscall:IsConsole on CONSOLE:"
	If Dontexecute then return
	Goto IncompleteTest
	Return
	rem also need to check isconsole on other devices

900	Print "Verify that Syscall:Rename is illegal";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

1000	Print "Verify that Syscall:Delete is illegal";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

1100	Print "Sc:Getpos";ToConsole$
	If DontExecute then return
	Goto IncompleteTest
	Return

1200	Print "SC:GETCOL";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

1300	Print "SC:GETEOF";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

1400	Print "SC:GETFILESIZE";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

1500	Print "SC:GETTYPE";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

1600	Print "SC:GETPARAMS";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

1700	Print "SC:GETPROFILE";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

1800	Print "SC:GETACTCOL";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

1900	Print "SC:ATTENTIONCK";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

2000	Print "SC:GETLINEFLAGS";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

2100
2200
2300
2400
2500
2600
2700
2800
2900
	Goto NonExistentTest

3000	Print "CC:POSITION";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

3100	Print "CC:DUMPBUFFERS";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

3200	Print "CC:NOECHO,CC:ECHO";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

3300	Print "CC:IDLES";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

3400	Print "CC:TABS";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

3500	Print "CC:WRAP";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

3600	Print "CC:NOWRAP";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

3700	Print "CC:SETACTBLOCK";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

3800	Print "CC:CLRINPUT";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

3900	Print "CC:CLROUTPUT";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

4000	Print "CC:SETREADTIMEOUT";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

4100	Print "CC:SETPROFILE";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

4200	Print "CC:ALTERPROFILE";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

4300	Print "CC:WRITEEDITLINE";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

4400	Print "CC:SETFIELDSIZE";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

4500	Print "CC:SETPARAMS";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

4600	Print "CC:ACTIVATIONCK";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

4700	Print "CC:COLORING";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

4800	Print "CC:BACKGROUND";ToConsole$
	If Dontexecute then return
	Goto IncompleteTest
	Return

4900
5000
5100
5200
5300
5400
5500
5600
5700
5800
5900
	Goto NonexistentTest

6000	Print "SYSCALL:OPEN"
	If Dontexecute then return
	Goto IncompleteTest
	Return

6100	Print "SYSCALL:CREATE"
	If Dontexecute then return
	Goto IncompleteTest
	Return

6200	Print "SYSCALL:CLOSE"
	If Dontexecute then return
	Rem check delete extra disk space at close time
	Goto IncompleteTest
	Return

6300	Print "SYSCALL:RENAME"
	If Dontexecute then return
	Goto IncompleteTest
	Return

6400	Print "SYSCALL:DELETE"
	If Dontexecute then return
	Goto IncompleteTest
	Return

6500	Print "SYSCALL:LOAD"
	If Dontexecute then return
	Rem Check Decrypting loader, regular loader, keydestruction,
	Rem check set RunningEncrypted, unequal keys zeros user space
	Rem check load with diff key --> error
	Goto IncompleteTest
	Return

6600	Print "SYSCALL:CHAIN"
	If Dontexecute then return
	Rem check gives error on zero start address
	Rem see load
	Rem returns control if no load records proccessed befor e error
	Rem sets SP to top of user space
	Rem check ERR:NOSUCHPROGRAM
	Goto IncompleteTest
	Return

6700	Print "SYSCALL:CREATELOG"
	If Dontexecute then return
	Goto IncompleteTest
	Return

6800	Print "SYSCALL:CLOSELOG"
	If Dontexecute then return
	Goto IncompleteTest
	Return

6900	Print "SYSCALL:DISKDEFAULT"
	If Dontexecute then return
	Rem check allows errormsgs.sys to move around with DEFAULTDISK
	Goto IncompleteTest
	Return

7000	Print "SYSCALL:READA"
	If Dontexecute then return
	Goto IncompleteTest
	Return

7100	Print "SYSCALL:READB"
	If Dontexecute then return
	Goto IncompleteTest
	Return

7200	Print "SYSCALL:WRITEA"
	If Dontexecute then return
	Goto IncompleteTest
	Return

7300	Print "SYSCALL:WRITEB"
	If Dontexecute then return
	Goto IncompleteTest
	Return

7400	Print "SYSCALL:CONTROL"
	If Dontexecute then return
	Goto IncompleteTest
	Return

7500	Print "SYSCALL:STATUS"
	If Dontexecute then return
	Goto IncompleteTest
	Return

7600	Print "SYSCALL:WAITDONE"
	If Dontexecute then return
	Goto IncompleteTest
	Return

7700	Print "SYSCALL:EXIT"
	If Dontexecute then return
	Rem check all files closed
	Rem chekc does exit
	Rem check that EXIT detects CHecksum error
	Rem check that No Defaultprogram causes defaultdisk to be dismounted
	Goto IncompleteTest
	Return

7800	Print "SYSCALL:ERROREXIT"
	If Dontexecute then return
	Goto IncompleteTest
	Return

7900	Print "SYSCALL:SETERROR"
	If Dontexecute then return
	Goto IncompleteTest
	Return

8000	Print "SYSCALL:GETERROR"
	If Dontexecute then return
	Goto IncompleteTest
	Return

8100	Print "SYSCALL:DISPERROR"
	If Dontexecute then return
	Rem check display text string versus number
	Rem check close log device if output error
	Goto IncompleteTest
	Return

8200	Print "SYSCALL:KILLPROOF"
	If Dontexecute then return
	Goto IncompleteTest
	Return

8300	Print "SYSCALL:KILLENABLE"
	If Dontexecute then return
	Goto IncompleteTest
	Return

8400	Print "SYSCALL:DEBUG"
	If Dontexecute then return
	Goto IncompleteTest
	Return

8500	Print "SYSCALL:ATTNCHECK"
	If Dontexecute then return
	Goto IncompleteTest
	Return

8600	Print "SYSCALL:ISCONSOLE"
	If Dontexecute then return
	Goto IncompleteTest
	Return

8700	Print "SYSCALL:INTERLOCK"
	If Dontexecute then return
	! Check that create interlock requires 16 byte rdbuf
	Let Len(Temp$)=16
	Let len(Temp1$)=maxlen(Temp1$)
	For i=0 to 15
8710		If error When Syscall Interlock$,Temp$,Temp1$[1,i]
		Then if err<>1054 then Fail fi
		Else Fail
	Next i
	For i=16 to 127
8715		Syscall Interlock$,Temp$,Temp1$[1,i]
	Next i
	! Check that all interlock opcodes are legal, require 16 byte WRBUF
	Let Temp$=Interlock$
	For i=0 to 5
		Print "Interlock opcode";i
		Let Temp$[4]=i
		! Ensure that wrbuf too short causes error!
		Let len(Temp1$)=Maxlen(Temp1$)
		For j=0 to 15
8720			If Error When Syscall Temp$,Temp1$[1,j]
			Then if err<>1055 then Fail fi
			else Fail
		Next j
		! Test that wrbuf >= 16 is ok
		For j=16 to 127
			Let len(Temp1$)=127
8730			Syscall Temp$,Temp1$[1,j],Temp1$
8735			If i=0 then if len(Temp1$)<>16 then fail fi
			else if len(Temp1$)<>0 then fail
		Next j
	Next i
	Goto IncompleteTest
	Return

8800
8900
9000
9100
9200
9300
9400
9500
9600
9700
	Goto NonexistentTest

9800	Print "SYSCALL:DELAY"
	If Dontexecute then return
	Print Time$;" Delay 0 Ticks ";
	Syscall Delay0$
	Print Time$
	Print Time$;" Delay 600 Ticks ";
	Syscall Delay600$
	Print Time$
	! Check Delay must have at least 4 bytes
	Let Temp$=Delay0$
	For i=2 to 3
		Let Len(Temp$)=i
		Let Temp$[2]=i
9810		If Error When Syscall Temp$
		Then If Err<>1053 Then Fail fi
		Else Fail
	Next i
	! Check delay can be 4 to 127 bytes
	For i=4 to 127
		Let len(Temp$)=i
		Let temp$[2]=i
		Syscall Temp$
	Next i
	Return

9900	Print "SYSCALL:READLUN??"
	If Dontexecute then return
	! Read thru logical unit numbers fetching names and print them
	i=0
	Let Temp$=Readlun$
	repeat
		Let Temp$[3]=Msb(i)
		Let Temp$[4]=Lsb(i)
9910		If Error When Syscall Temp$,Null$,Temp1$
		Then if Err<>:426 then Fail Else Return fi
		Print "Lun";i;'"';Temp1$;'"'
		i=i+1
	end

!***** End of Part 1 of SDOS Diagnostic *****
	END
