! ************************** AMUS Program Label ******************************
! Filename: TSTDSK.BAS                                        Date: 09/01/89
! Category: Test suspect disk  Hash Code: 762-221-365-506   Version: 1.0(100)
! Initials: AODP/AM       Name: GARY D. CHESSER
! Company: EmergiTech                              Telephone #: 61488666712
!
! Related Files: AMOS.SBR,REWRIT.LIT,REDALL.LIT,BLOCKS.SBR
! Min. Op. Sys.: 1.3                           Expertise Level: INT
! Special: EMULAT A PRINTER TERMINAL AND RUN THIS PROGRAM ON SUSPECTED BAD
! LOGICAL DISK ON YOUR SYSTEM.
! Description: Print out the total number of free block then 
! this program will test every block on a suspect logical disk.
! 
!
	PROGRAM TSTDSK, 1.0(100)
!
!REQUIREMENTS:
!
!	BAS:NOTIFY.SBR	;ON AMUS NETWORK BY STOINER & WILSON
!	BAS:WHOBAS.SBR	;ON AMUS NETWORK BY EMERGITECH
!	BAS:DAYTIM.SBR	;ON AMUS NETWORK BY DAVE PALLMANN
!	BAS:JOBPRG.SBR	;ON AMUS NETWORK BY EMERGITECH
!	BAS:AMOS.SBR	;ON AMUS NETWORK BY DAVE PALLMANN
!	BAS:BLOCKS.SBR	;ON AMUS NETWORK BY DALE EICHBAUER
!
!	SYS:REWRIT.LIT	;STANDARD AMOS PROGRAM
!	SYS:REDALL.LIT	;STANDARD AMOS PROGRAM
!	
!	BAS:ERROR.LOG	;SEQUENTIAL FILE THAT HOLDS SOFT AND HARD ERRORS

!THIS IS THE MAP1 STATEMENTS FOR JOB AND PROGRAM NAME USED IN JOBPRG
 	MAP1 names(40),S,12		! 40 is not mandatory. Must be > #JOBS

	MAP1	ERR'VARS
		MAP2 ERR'0,B,1		! Error number
		MAP2 ERR'1,F		! Error Line Number
		MAP2 ERR'2,F            ! Error File Channel
 
	MAP1 WHOREC
		MAP2 WHOLOG,S,28
		MAP2 LOGINNAME,S,10
 
	MAP1 D$,S,8
	MAP1 T$,S,8
	MAP1	PROGRAM'NAME,S,10
	MAP1	CMDLIN,S,80
	MAP1	ERRTYPE,S,50
	MAP1	RESULT,F,6
 
!THESE ARE ALL NEEDED IN TSTDSK
	MAP1	FSPEC,S,5
	MAP1	CONTIG,F,6
	MAP1	FREE,F,6
	MAP1	COMMAND'LINE,S,12
	MAP1	TRMNAM,S,6
	MAP1	MSP,S,80


 !ERROR ROUTINE TO MUST BE CALLED ON AN ERROR
 ON ERROR GOTO LOG'ERR
 
 !CMDLIN IS THE LINE THAT IS SENT TO JOB1
	PROGRAM'NAME = "TSTDSK.RUN"
	CMDLIN = "ERROR IN PROGRAM " + PROGRAM'NAME
	CMDLIN = CMDLIN + " VUE ERROR.LOG DSK0:7,6"


	? TAB(-1,0)
	INPUT "WHAT DISK DO YOU WISH TO TEST >"FSPEC

!              WHERE FSPEC IS A VALID PARTIAL FILESPEC (E.G. "DSK0:"),
!              AND CONTIG & FREE ARE FLOATING POINT VARIABLES ON
!              WORD BOUNDARIES.

		XCALL BLOCKS,FSPEC,CONTIG,FREE

	PRINT FSPEC;" HAS ";CONTIG;"BLOCKS OF CONTIGUOUS SPACE AND" 
	PRINT "          ";FREE;"BLOCKS OF TOTAL FREE SPACE"

!PERFORM REDALL ON SUSPECT LOGICAL

	PRINT
	PRINT "Now Reading all of ";FSPEC
		COMMAND'LINE = "REDALL " + FSPEC	
			XCALL AMOS,COMMAND'LINE

!PERFORM REWRIT ON SUSPECT LOGICAL

	PRINT
	PRINT "Now Writing all of ";FSPEC
		CMDLIN = "REWRIT " + FSPEC	
			XCALL AMOS,CMDLIN

!Notify job1 we are done
	XCALL NOTIFY,TRMNAM,MSG

 !THIS IS THE END OF THIS PROGRAM
 FINISHED:
 END
 
 !THIS IS THE ERROR SBRBTHAT IS CALLED ON BY AN ERROR
 LOG'ERR:

 !FIND PROPER VALUES OF ERROR
		ERR'0 = ERR(0)	
		ERR'1 = ERR(1)
		ERR'2 = ERR(2)
 
 !IS THIS A CONTROL C
		IF ERR'0 = 1 THEN END

 !TELL JOB1 THAT WE HAVE AN ERROR IN THIS PROGRAM
 !CHANGE "TRM1' TO YOUR SYSTEM OPERATORS TRMDEF NAME
	XCALL NOTIFY,"TRM1",CMDLIN
 
 !GET INFO ON THE THIS USERS : JOB NAME,TERMINAL NAME,ALPHA BASE LOGIN
 
	XCALL WHOBAS,WHOREC
 
 !GET TIME OF DAY & DATE
	XCALL DAYTIM,D$,T$
 !LOG THE ERROR INFORMATION IN ERROR.LOG
 
 !GET JOBS AND PROGRAM NAME THEY ARE RUNNING
 	XCALL JOBPRG,names(1)		! note names(1) !!!

 !HAS ERROR.LOG BEEN CREATED YET?
 LOOKUP "DSK0:ERROR.LOG[7,6]",RESULT

 !NOPE THEN CREATE
	IF RESULT = 0 THEN &
		OPEN #98,"DSK0:ERROR.LOG[7,6]",OUTPUT : &
		CLOSE #98
 
 !ELSE APPEND TO ERROR.LOG
 	OPEN #99,"DSK0:ERROR.LOG[7,6]",APPEND
	PRINT #99,"ERROR IN PROGRAM " + PROGRAM'NAME;
	PRINT #99,"   TIME: ";T$;
	PRINT #99,"   DATE: ";D$

!WHAT TYPE OF ERROR DO WE HAVE?
	GOSUB ERROR'NUMBER	
	PRINT #99,"ERROR IS " + ERRTYPE
	PRINT #99,"ERROR IN LINE NUMBER " + ERR'1
 	PRINT #99,"ERROR IN FILE CHANNEL " + ERR'2
	PRINT #99,"JOB = ";WHOLOG[1;6];" ";"TRM = ";WHOLOG[7;6];"LOGINNAME = ";LOGINNAME
	PRINT #99,"----------------------------------------------------------------------------"
	PRINT #99,"JOB   PROGRAM"
	PRINT #99,"*************"
 
 	FOR I = 1 TO 40
 		IF names(I) = "" THEN I = 40 &
 				 ELSE PRINT #99,names(I)
 	NEXT I
	PRINT #99,"----------------------------------------------------------------------------"
	CLOSE #99

 !THE ABOVE COULD ALSO CONTAIN INFO ON ERF(X)
 !FOR ISAM ERRORS WHERE X = FILE CHANNEL NUMBER IN ISAM STATEMENT

 GOTO FINISHED

 !THIS SBR WILL FIND THE TYPE OF HARD ERROR WE HAVE
 ERROR'NUMBER:

 IF ERR'0 = 1 THEN &
 ERRTYPE ="Control-C interrupt"

 IF ERR'0 = 2 THEN &
 ERRTYPE ="System Error"

 IF ERR'0 = 3 THEN &
 ERRTYPE ="Out of Memory"

 IF ERR'0 = 4 THEN &
 ERRTYPE ="Out of Data"

 IF ERR'0 = 5 THEN &
 ERRTYPE	="Next without FOR"

 IF ERR'0 = 6 THEN &
 ERRTYPE	="RETURN without GOSUB"

 IF ERR'0 = 7 THEN &
 ERRTYPE	="RESUME without ERROR"

 IF ERR'0 = 8 THEN &
 ERRTYPE	="Subscript out of range"

 IF ERR'0 = 9 THEN &
 ERRTYPE	="Floating Point overflow"
 
 IF ERR'0 = 10 THEN &
 ERRTYPE	="Divide by zero"

 IF ERR'0 = 11 THEN &
 ERRTYPE	="Illegal function value"
 
 IF ERR'0 = 12 THEN &
 ERRTYPE	="XCALL subroutine not found"
 
 IF ERR'0 = 13 THEN &
 ERRTYPE	="File already open"

 IF ERR'0 = 14 THEN &
 ERRTYPE	="IO to unopened file"

 IF ERR'0 = 15 THEN &
 ERRTYPE	="Record size overflow"
 
 IF ERR'0 = 16 THEN &
 ERRTYPE	="File specification error"
 
 IF ERR'0 = 17 THEN &
 ERRTYPE	="File not found"
 
 IF ERR'0 = 18 THEN &
 ERRTYPE	="Device not ready"
 
 IF ERR'0 = 19 THEN &
 ERRTYPE	="Device full"
 
 IF ERR'0 = 20 THEN &
 ERRTYPE	="Device error"
 
 IF ERR'0 = 21 THEN &
 ERRTYPE	="Device in use"
 
 IF ERR'0 = 22 THEN &
 ERRTYPE	="Illegal user code"
 
 IF ERR'0 = 23 THEN &
 ERRTYPE	="Protection Violation"
 
 IF ERR'0 = 24 THEN &
 ERRTYPE	="Write protected"
 
 IF ERR'0 = 25 THEN &
 ERRTYPE	="File type mismatch"
 
 IF ERR'0 = 26 THEN &
 ERRTYPE	="Device does not exist"
 
 IF ERR'0 = 27 THEN &
 ERRTYPE	="Bitmap kaput"
 
 IF ERR'0 = 28 THEN &
 ERRTYPE	="Disk not mounted"
 
 IF ERR'0 = 29 THEN &
 ERRTYPE	="File already exists"
 
 IF ERR'0 = 30 THEN &
 ERRTYPE	="Redimentioned array"
 
 IF ERR'0 = 31 THEN &
 ERRTYPE	="Illegal record number"
 
 IF ERR'0 = 32 THEN &
 ERRTYPE	="Invalid filename"

 IF ERR'0 = 33 THEN &
 ERRTYPE	="Stack overflow"
 
 IF ERR'0 = 34 THEN &
 ERRTYPE	="Invalid syntax code"
 
 IF ERR'0 = 35 THEN &
 ERRTYPE	="Unsupported function"
 
 IF ERR'0 = 36 THEN &
 ERRTYPE	="Invalid subroutine version"
 
 IF ERR'0 = 37 THEN &
 ERRTYPE	="File in use"
 
 IF ERR'0 = 38 THEN &
 ERRTYPE	="Record in use"
 
 IF ERR'0 = 39 THEN &
 ERRTYPE	="Deadly embrace"

 IF ERR'0 = 40 THEN &
 ERRTYPE	="File cannot be deleted"

 IF ERR'0 = 41 THEN &
 ERRTYPE	="File cannot be renamed"

 IF ERR'0 = 42 THEN &
 ERRTYPE	="Record not locked"

 IF ERR'0 = 43 THEN &
 ERRTYPE	="Multiple link translation"

 IF ERR'0 = 44 THEN &
 ERRTYPE	="LOKSER queue is full"

 IF ERR'0 = 45 THEN &
 ERRTYPE	="Device not file structured"

 IF ERR'0 = 46 THEN &
 ERRTYPE	="Illegal ISAM sequence"

 RETURN