! ************************** 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

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.