Running old QBasic code in FB

[SARG]

Change the position of the line 'ON ERROR GOTO ErrorHandler3'

Code: Select all

#lang "QB"

DECLARE SUB Initialization ()
'DECLARE SUB ErrorHandler3'()

OPTION BASE 1

DIM SHARED Col(10), Row(10), v$(10), D$(10), I$(10), R$(10, 1)
DIM SHARED DR$

DR$="InptFile"

ON ERROR GOTO ErrorHandler3  '<<<--------------------------
CALL Initialization

ErrorHandler3:
      'print "Debug line - Were here ErrorHandler3":Sleep:STOP
   IF ERR = 53 THEN 'ERR = 53 File Not Found
      BEEP
      R$(1, 1) = DR$ + ".ZIP"
      A1 = INSTR(1, R$(1, 1), ".")
      OPEN MID$(R$(1, 1), 1, A1 - 2) + ".DAT" FOR INPUT LOCK WRITE AS #1
      RESUME NEXT
   ELSE
      'some other error, so print message and abort
      PRINT "Unrecoverable error--"; ERR
      'ON ERROR GOTO 0
      STOP: RESUME
   END IF


SUB Initialization
'  Calculate number of records of file to extract
'  ----------------------------------------------
RecNum = 0

OPEN MID$(R$(1, 1), 1, A1% - 2) + ".DAT" FOR INPUT LOCK WRITE AS #1
DO
  C$ = "": LINE INPUT #1, C$
  IF MID$(C$, 23, 3) <> "," + CHR$(34) + "S" THEN RecNum = RecNum + 1
LOOP UNTIL EOF(1) = -1
CLOSE #1
END SUB

[fxm]

There always are strange behaviors of 'ON ERROR GOTO label', and additionally dependent on the backend code used ('gas' or 'gcc' for example).
You above code works with 'gas' but not with 'gcc'.
For safer behavior, I recommend that the 'ON ERROR GOTO label' statement and the 'label' body be in the same scope:

Code: Select all

#lang "QB"

DECLARE SUB Initialization ()
'DECLARE SUB ErrorHandler3'()

OPTION BASE 1

DIM SHARED Col(10), Row(10), v$(10), D$(10), I$(10), R$(10, 1)
DIM SHARED DR$

DR$="InptFile"

ON ERROR GOTO ErrorHandler3
CALL Initialization
ON ERROR GOTO 0
END

ErrorHandler3:
      'print "Debug line - Were here ErrorHandler3":Sleep:STOP
   IF ERR = 53 THEN 'ERR = 53 File Not Found
      BEEP
      R$(1, 1) = DR$ + ".ZIP"
      A1 = INSTR(1, R$(1, 1), ".")
      OPEN MID$(R$(1, 1), 1, A1 - 2) + ".DAT" FOR INPUT LOCK WRITE AS #1
      RESUME NEXT
   ELSE
      'some other error, so print message and abort
      PRINT "Unrecoverable error--"; ERR
      'ON ERROR GOTO 0
      STOP: RESUME
   END IF


SUB Initialization
'  Calculate number of records of file to extract
'  ----------------------------------------------
RecNum = 0
OPEN MID$(R$(1, 1), 1, A1% - 2) + ".DAT" FOR INPUT LOCK WRITE AS #1
DO
  C$ = "": LINE INPUT #1, C$
  IF MID$(C$, 23, 3) <> "," + CHR$(34) + "S" THEN RecNum = RecNum + 1
LOOP UNTIL EOF(1) = -1
CLOSE #1
END SUB

[Triopstor]

Change the position of the line 'ON ERROR GOTO ErrorHandler3'

Code: Select all

#lang "QB"

DECLARE SUB Initialization ()
'DECLARE SUB ErrorHandler3'()

OPTION BASE 1

DIM SHARED Col(10), Row(10), v$(10), D$(10), I$(10), R$(10, 1)
DIM SHARED DR$

DR$="InptFile"

ON ERROR GOTO ErrorHandler3  '<<<--------------------------
CALL Initialization

ErrorHandler3:
      'print "Debug line - Were here ErrorHandler3":Sleep:STOP
   IF ERR = 53 THEN 'ERR = 53 File Not Found
      BEEP
      R$(1, 1) = DR$ + ".ZIP"
      A1 = INSTR(1, R$(1, 1), ".")
      OPEN MID$(R$(1, 1), 1, A1 - 2) + ".DAT" FOR INPUT LOCK WRITE AS #1
      RESUME NEXT
   ELSE
      'some other error, so print message and abort
      PRINT "Unrecoverable error--"; ERR
      'ON ERROR GOTO 0
      STOP: RESUME
   END IF


SUB Initialization
'  Calculate number of records of file to extract
'  ----------------------------------------------
RecNum = 0

OPEN MID$(R$(1, 1), 1, A1% - 2) + ".DAT" FOR INPUT TLOCK WRITE AS #1
DO
  C$ = "": LINE INPUT #1, C$
  IF MID$(C$, 23, 3) <> "," + CHR$(34) + "S" THEN RecNum = RecNum + 1
LOOP UNTIL EOF(1) = -1
CLOSE #1
END SUB

Thank You SARG! I understand the logic now and how the code flows. Unfortunately I have 3 Error Handling labels referenced from 3 different SUBs because there different files that might be missing in the program.

Code: Select all

'  ********************
'  ** Error Handlers **
'  ********************
ErrorHandler:
   IF ERR = 53 THEN 'ERR = 53 File Not Found
      'Create LinkDat file
      SHELL "S_MASTERY3.EXE" 'Create Link.Dat file. This will be done in qb45 directory
      RESUME
   ELSE
      'some other error, so print message and abort
      PRINT "Unrecoverable error--"; ERR
      'ON ERROR GOTO 0
      STOP: RESUME
   END IF

ErrorHandler3:
   IF ERR = 53 THEN 'ERR = 53 File Not Found
      BEEP
      R$(1, 1) = DR$ + ".ZIP"
      A1 = INSTR(1, R$(1, 1), ".")
      OPEN MID$(R$(1, 1), 1, A1 - 2) + ".DAT" FOR INPUT LOCK WRITE AS #1
      RESUME NEXT
   ELSE
      'some other error, so print message and abort
      PRINT "Unrecoverable error--"; ERR
      'ON ERROR GOTO 0
      STOP: RESUME
   END IF

ErrorHandler4:
   IF ERR = 53 THEN 'ERR = 53 File Not Found
      v = 0
      RESUME NEXT
   ELSE
      'some other error, so print message and abort
      PRINT "Unrecoverable error--"; ERR
      'ON ERROR GOTO 0
      STOP: RESUME
   END IF

1 solution is to combine all the Error Handling labels(ErrorHandler, ErrorHandler3, ErrorHandler4) into one new Error Handler label. To do this I could create a string variable InSub$(as a flag) to know which SUB is causing an error. By having a SELECT CASE InSub$ in the new Error Handler this can branch to an individual create file. Is there a better way?

[fxm]

You can also put the 'ON ERROR GOTO labelx' statement and the 'labelx' code body inside the same procedure:

Code: Select all

#lang "QB"

DECLARE SUB Initialization ()
'DECLARE SUB ErrorHandler3'()

OPTION BASE 1

DIM SHARED Col(10), Row(10), v$(10), D$(10), I$(10), R$(10, 1)
DIM SHARED DR$

DR$="InptFile"

CALL Initialization

SUB Initialization
    '  Calculate number of records of file to extract
    '  ----------------------------------------------
    RecNum = 0
    ON ERROR GOTO ErrorHandler3
    OPEN MID$(R$(1, 1), 1, A1% - 2) + ".DAT" FOR INPUT LOCK WRITE AS #1
    DO
        C$ = "": LINE INPUT #1, C$
        IF MID$(C$, 23, 3) <> "," + CHR$(34) + "S" THEN RecNum = RecNum + 1
    LOOP UNTIL EOF(1) = -1
    CLOSE #1
    EXIT SUB
ErrorHandler3:
    'print "Debug line - Were here ErrorHandler3":Sleep:STOP
    IF ERR = 53 THEN 'ERR = 53 File Not Found
        BEEP
        R$(1, 1) = DR$ + ".ZIP"
        A1 = INSTR(1, R$(1, 1), ".")
        OPEN MID$(R$(1, 1), 1, A1 - 2) + ".DAT" FOR INPUT LOCK WRITE AS #1
        RESUME NEXT
    ELSE
        'some other error, so print message and abort
        PRINT "Unrecoverable error--"; ERR
        'ON ERROR GOTO 0
        STOP: RESUME
   END IF
END SUB

[Triopstor]

There always are strange behaviors of 'ON ERROR GOTO label', and additionally dependent on the backend code used ('gas' or 'gcc' for example).
You above code works with 'gas' but not with 'gcc'.
For safer behavior, I recommend that the 'ON ERROR GOTO label' statement and the 'label' body be in the same scope:

Code: Select all

#lang "QB"

DECLARE SUB Initialization ()
'DECLARE SUB ErrorHandler3'()

OPTION BASE 1

DIM SHARED Col(10), Row(10), v$(10), D$(10), I$(10), R$(10, 1)
DIM SHARED DR$

DR$="InptFile"

ON ERROR GOTO ErrorHandler3
CALL Initialization
ON ERROR GOTO 0
END

ErrorHandler3:
      'print "Debug line - Were here ErrorHandler3":Sleep:STOP
   IF ERR = 53 THEN 'ERR = 53 File Not Found
      BEEP
      R$(1, 1) = DR$ + ".ZIP"
      A1 = INSTR(1, R$(1, 1), ".")
      OPEN MID$(R$(1, 1), 1, A1 - 2) + ".DAT" FOR INPUT LOCK WRITE AS #1
      RESUME NEXT
   ELSE
      'some other error, so print message and abort
      PRINT "Unrecoverable error--"; ERR
      'ON ERROR GOTO 0
      STOP: RESUME
   END IF


SUB Initialization
'  Calculate number of records of file to extract
'  ----------------------------------------------
RecNum = 0
OPEN MID$(R$(1, 1), 1, A1% - 2) + ".DAT" FOR INPUT LOCK WRITE AS #1
DO
  C$ = "": LINE INPUT #1, C$
  IF MID$(C$, 23, 3) <> "," + CHR$(34) + "S" THEN RecNum = RecNum + 1
LOOP UNTIL EOF(1) = -1
CLOSE #1
END SUB

Thanks for your help fxm! ON ERROR GOTO 0 re-sets the error. I guess I will use an If statement and a SUB for missing files. IF ERR = 53 THEN SUB CREATE_FILE_1 and so forth for missing file 2 and missing file 3.

[Triopstor]

You can also put the 'ON ERROR GOTO labelx' statement and the 'labelx' code body inside the same procedure:

Code: Select all

#lang "QB"

DECLARE SUB Initialization ()
'DECLARE SUB ErrorHandler3'()

OPTION BASE 1

DIM SHARED Col(10), Row(10), v$(10), D$(10), I$(10), R$(10, 1)
DIM SHARED DR$

DR$="InptFile"

CALL Initialization

SUB Initialization
    '  Calculate number of records of file to extract
    '  ----------------------------------------------
    RecNum = 0
    ON ERROR GOTO ErrorHandler3
    OPEN MID$(R$(1, 1), 1, A1% - 2) + ".DAT" FOR INPUT LOCK WRITE AS #1
    DO
        C$ = "": LINE INPUT #1, C$
        IF MID$(C$, 23, 3) <> "," + CHR$(34) + "S" THEN RecNum = RecNum + 1
    LOOP UNTIL EOF(1) = -1
    CLOSE #1
    EXIT SUB
ErrorHandler3:
    'print "Debug line - Were here ErrorHandler3":Sleep:STOP
    IF ERR = 53 THEN 'ERR = 53 File Not Found
        BEEP
        R$(1, 1) = DR$ + ".ZIP"
        A1 = INSTR(1, R$(1, 1), ".")
        OPEN MID$(R$(1, 1), 1, A1 - 2) + ".DAT" FOR INPUT LOCK WRITE AS #1
        RESUME NEXT
    ELSE
        'some other error, so print message and abort
        PRINT "Unrecoverable error--"; ERR
        'ON ERROR GOTO 0
        STOP: RESUME
   END IF
END SUB

That's a good example of code. Wouldn't need the key word LOCAL as in ON LOCAL ERROR GOTO ErrorHandler3?

[fxm]

In theory yes, but check out this bug report:
#602 'On Local Error Goto ...' does not work as specified (+GCC)

[Triopstor]

In theory yes, but check out this bug report:
#602 'On Local Error Goto ...' does not work as specified (+GCC)

That's good fmx! You even found a matter that was written by yourself 9 years ago. And this year as well.

I'm trying to create non-existent file ERR with your code fxm.

Code: Select all

Declare Sub test
test
End

Sub test
  On Error Goto label ' instead of 'On Local Error Goto label' which obviously works also
  OPEN "NonExistentFile.DAT" FOR INPUT LOCK WRITE AS #1
  Exit Sub
label:
  Print "Local procedure error handler "; ERR
  Sleep
  End
End Sub

[fxm]

Extract of the ERR page documentation:

Note: Care should be taken when calling an internal function (such as Print) after an error occurred, because it will reset the error value with its own error status. To preserve the Err value, it is a good idea to store it in a variable as soon as the error handler is entered.

Your code updated:

Code: Select all

Declare Sub test
test
End

Sub test
  On Error Goto label ' instead of 'On Local Error Goto label' which obviously works also
  OPEN "NonExistentFile.DAT" FOR INPUT LOCK WRITE AS #1
  CLOSE #1
  Exit Sub
label:
  Dim As Integer _ERR
  _ERR = ERR
  Print "Local procedure error handler "; _ERR
  Sleep
  End
End Sub

Variant using directly the function version which returns directly the error code without using 'ON ERROR GOTO' (see ERR, 'Remark' paragraph):

Code: Select all

Declare Sub test
test
End

Sub test
  Dim As Integer _ERR
  _ERR = OPEN("NonExistentFile.DAT", FOR INPUT LOCK WRITE, AS #1)
  If _ERR = 0 Then
    '.....
    Close #1
  Else  
    Print "Local procedure error handler "; _ERR
    Sleep
    End
  End If
End Sub

[Triopstor]

I can't get the first one - that is my code updated to work. I've tried variations of this but none work. I even checked to see if the file is there somehow.

But the second one works like a gem! That's the code I will use to update my computer program. I have saved the code as a tutorial for future reference as file T_ErrorHandler1.bas

A missing file is Err = 2 now instead of number 53 in QBasic.

[fxm]

I can't get the first one - that is my code updated to work. I've tried variations of this but none work. I even checked to see if the file is there somehow.

The first code works for me, provided you compile with the '-e' or '-ex' or '-exx' option.

[dodicat]

You can use two macros (#lang qb thru fb)
It should catch errors, as long as you put errload a the beginning of the sub and errhandle at the end of a sub.
and use -e or -ex, or -exx switches.
You can also do the same in the main module.
It looks cumbersome, but it will save much messing around.
Of course the no brainer way is to keep your console open with option -exx.
Then all errors are reported and seen, and no error checking code is required.
This option is available in most of the ides.
e.g
fbide
in the runcommand box
cmd /c "<$file>" <$param> & pause

winFBE
file
preferences
environment options
run compiled programs using command window box
Back to the macros:
for lang"qb" in the macro errhaddle you can put resume next before end or instead of end (done it here)
here are the macros

Code: Select all

#lang "qb"
'==========================================================
#macro errload
Dim errnum as long
#define ehandler lbl2
On Error Goto ehandler
#endmacro


#macro errhandle
#define skipover lbl
Goto skipover
	ehandler:
    Errnum = Err()
    Print "ERROR ";Errnum;"  ";
    Select Case as const Errnum
    case 0: Print " ... "
    Case 1 :Print  "Illegal function call" 
    Case 2 :Print  "File not found signal" 
    Case 3 :Print  "File I/O error" 
    Case 4 :Print  "Out of memory" 
    Case 5 :Print  "Illegal resume" 
    Case 6 :Print "Out of bounds array access" 
    Case 7 :Print  "Null Pointer Access" 
    Case 8 :Print  "No privileges" 
    Case 9 :Print  "interrupted signal" 
    Case 10 :Print  "illegal instruction signal" 
    Case 11 :Print  "floating point error signal" 
    Case 12 :Print  "segmentation violation signal" 
    Case 13 :Print  "Termination request signal" 
    Case 14 :Print  "abnormal termination signal" 
    Case 15 :Print  "quit request signal" 
    Case 16 :Print  "return without gosub" 
    Case 17 :Print  "end of file" 
    End Select
    Print "Function: " &__function__
    #ifdef __FB_LANG__
    #if __FB_LANG__ = "qb"
    Print "Module: " & *__Ermn
    #else
     Print "Module: " & *Ermn
    #endif
    #endif
    Print "Line: " & Erl
    Print "Press a key"
    Sleep
    resume next 'qb option
    end
    
skipover:
#undef lbl
#undef lbl2
#endmacro
'==============================================



Declare Sub test
declare sub OK
'main module
errload

open "nonesuch" for input as #1
OK
test

errhandle
End

Sub test
  errload
  
  OPEN "NonExistentFile.DAT" FOR INPUT LOCK WRITE AS #1
  Exit Sub

  errhandle
End Sub

sub OK
    errload
    print
    print "I'm all right "+ __function__
    print
    errhandle
    end sub
 

[Triopstor]

I can't get the first one - that is my code updated to work. I've tried variations of this but none work. I even checked to see if the file is there somehow.

The first code works for me, provided you compile with the '-e' or '-ex' or '-exx' option.

One compiles with those options using the CMD prompt? Okay thank you fxm.

[Triopstor]

You can use two macros (#lang qb thru fb)
It should catch errors, as long as you put errload a the beginning of the sub and errhandle at the end of a sub.
and use -e or -ex, or -exx switches.
You can also do the same in the main module.
It looks cumbersome, but it will save much messing around.
Of course the no brainer way is to keep your console open with option -exx.
Then all errors are reported and seen, and no error checking code is required.
This option is available in most of the ides.
e.g
fbide
in the runcommand box
cmd /c "<$file>" <$param> & pause

winFBE
file
preferences
environment options
run compiled programs using command window box
Back to the macros:
for lang"qb" in the macro errhaddle you can put resume next before end or instead of end (done it here)
here are the macros

Code: Select all

#lang "qb"
'==========================================================
#macro errload
Dim errnum as long
#define ehandler lbl2
On Error Goto ehandler
#endmacro


#macro errhandle
#define skipover lbl
Goto skipover
	ehandler:
    Errnum = Err()
    Print "ERROR ";Errnum;"  ";
    Select Case as const Errnum
    case 0: Print " ... "
    Case 1 :Print  "Illegal function call" 
    Case 2 :Print  "File not found signal" 
    Case 3 :Print  "File I/O error" 
    Case 4 :Print  "Out of memory" 
    Case 5 :Print  "Illegal resume" 
    Case 6 :Print "Out of bounds array access" 
    Case 7 :Print  "Null Pointer Access" 
    Case 8 :Print  "No privileges" 
    Case 9 :Print  "interrupted signal" 
    Case 10 :Print  "illegal instruction signal" 
    Case 11 :Print  "floating point error signal" 
    Case 12 :Print  "segmentation violation signal" 
    Case 13 :Print  "Termination request signal" 
    Case 14 :Print  "abnormal termination signal" 
    Case 15 :Print  "quit request signal" 
    Case 16 :Print  "return without gosub" 
    Case 17 :Print  "end of file" 
    End Select
    Print "Function: " &__function__
    #ifdef __FB_LANG__
    #if __FB_LANG__ = "qb"
    Print "Module: " & *__Ermn
    #else
     Print "Module: " & *Ermn
    #endif
    #endif
    Print "Line: " & Erl
    Print "Press a key"
    Sleep
    resume next 'qb option
    end
    
skipover:
#undef lbl
#undef lbl2
#endmacro
'==============================================



Declare Sub test
declare sub OK
'main module
errload

open "nonesuch" for input as #1
OK
test

errhandle
End

Sub test
  errload
  
  OPEN "NonExistentFile.DAT" FOR INPUT LOCK WRITE AS #1
  Exit Sub

  errhandle
End Sub

sub OK
    errload
    print
    print "I'm all right "+ __function__
    print
    errhandle
    end sub
 

Thank You dodicat for such a complete solution! I prefer to program without switches but I will save your answer as a tutorial. Saved as "T_ErrorHandler3" on my machine. I'm not quite that proficient in programming yet. I especially like the list of all 17 possible errors and 1 good one via the Errnum constant. Thank You!

[Triopstor]

I have a new problem that got solved.

The following does not work:

Code: Select all

' ** STORE COMMANDS **

#lang "QB"

'Screen
Color 2

'  Returns the number of times that a substring is found within a string.
'  ----------------------------------------------------------------------
FUNCTION fnstrn (Search$, LookFor$)

    Count% = 0

    IF Search$ = "" OR LookFor$ = "" THEN
       fnstrn = Count%
       EXIT FUNCTION
    END IF

    x% = INSTR(Search$, LookFor$)

    DO WHILE x% > 0
       Count% = Count% + 1
       last% = x%
       x% = INSTR((last% + 1), Search$, LookFor$)
    LOOP

    fnstrn = Count%

END FUNCTION

CA1$ = "A,B,C,D,F,G,H,L,M,Q,U,W"

'  Count how many commands elements exist
NC1 = fnstrn(CA1$, ",") + 1

'Redim CA()
REDIM CA(NC1) AS STRING

'  Store commands in array
BB = 0: EB = 0
FOR NC1 = 1 TO NC1 - 1  ' **** The bug is on this line.  Does not like "NC1 - 1"  To fix use the variable say X7 = NC1 - 1
    EB = EB + 1: BB = EB
    EB = INSTR(BB, CA1$, ",")
    CA(NC1) = MID$(CA1$, BB, EB - BB)
    Print NC1;"= ";CA(NC1)
NEXT NC1
CA(NC1) = MID$(CA1$, EB + 1)
Print NC1;"= ";CA(NC1)
sleep

By using a new variable X7, it does WORK:

Code: Select all

' ** STORE COMMANDS **

#lang "QB"

'Screen
Color 2

'  Returns the number of times that a substring is found within a string.
'  ----------------------------------------------------------------------
FUNCTION fnstrn (Search$, LookFor$)

    Count% = 0

    IF Search$ = "" OR LookFor$ = "" THEN
       fnstrn = Count%
       EXIT FUNCTION
    END IF

    x% = INSTR(Search$, LookFor$)

    DO WHILE x% > 0
       Count% = Count% + 1
       last% = x%
       x% = INSTR((last% + 1), Search$, LookFor$)
    LOOP

    fnstrn = Count%

END FUNCTION

CA1$ = "A,B,C,D,F,G,H,L,M,Q,U,W"

'  Count how many commands elements exist
NC1 = fnstrn(CA1$, ",") + 1

'Redim CA()
REDIM CA(NC1) AS STRING

'  Store commands in array
BB = 0: EB = 0
X7=NC1 - 1
FOR NC1 = 1 TO X7
    EB = EB + 1: BB = EB
    EB = INSTR(BB, CA1$, ",")
    CA(NC1) = MID$(CA1$, BB, EB - BB)
    Print NC1;"= ";CA(NC1)
NEXT NC1
CA(NC1) = MID$(CA1$, EB + 1)
Print NC1;"= ";CA(NC1)
sleep

Why?