The VMS SharkOpenVMS Notes: VMS-BASIC

a.k.a. HP-BASIC for OpenVMS, Compaq BASIC for OpenVMS, DEC-BASIC, VAX-BASIC

  1. The information and software presented on this web site are intended for educational use only by OpenVMS application developers and OpenVMS system attendants.
  2. The information and software presented on this web site are provided free of charge.
  3. The information and software presented on this web site are presented to you as-is. I will not be held responsible in any way if the information and software presented on this web site damages your computer system, business or organization (sounds like the legal warning from a Microsoft shrink-wrap seal, eh?)
  4. Is this text too small? You have two options:
    1. hold down the CTRL key while rolling the mouse wheel (zoom-in, zoom-out)
    2. use your keyboard like so:
      • hit: CTRL with "-" key to zoom smaller
      • hit: CTRL with "+" key to zoom larger
      • hit: CTRL with zero key to reset zoom
 

Table of Contents

Introductory Notes:

External Links:

Five Examples/Stubs (on this page)

Certain aspects of VMS-BASIC remind me of FORTRAN (for example, the "PRINT USING", FORMAT$, and Matrix statements) while other portions offer a few COBOL-like features (multi-key ISAM file routines). That said, I am not going to document the language here since the Official BASIC Manuals are well written and complete. On top of that, I've have provided more than a few BASIC demo programs here but I will provide four examples here which may be of some interest to the casual reader.

Source Code For Demo 1A (trapping errors with ON ERROR GOTO)

Most BASIC implementations force programmers to trap run-time errors using a common handler like this:

1000    %title "vms-basic-demo_001.bas"
        !=============================================================
        ! title : vms-basic demo_001.bas
        ! author: NSR
        !=============================================================
        option type=explicit                                            !
        set no prompt                                                   !
        declare string constant k_program = "vms-basic-demo"
        declare string constant k_version = "001"
        declare string  junk$                   ,&
                long    i%
        on error goto trap                                              ! Old-school BASIC
        !=============================================================
        !       main
        !=============================================================
2000    main:                                                           !
        print k_program +"_"+ k_version                                 !
        print string$(len(k_program +"_"+ k_version), asc("="))         !
	!
2010    input "enter a number? "; i%                                    !
        print "you entered "; str$(i%)                                  !
        !
        !       more code would appear here
        !
        goto fini                                                       !
        !=============================================================
        !       common error trap
        !=============================================================
32000   trap:                                                           !
        select erl							!
            case 2010							!
		print "-e-non-numeric character encountered"		!
                resume 2010						! go back to line 2010
        end select							!
	!
        print "<<< common error trap >>>"
	print "please report this error to your system manager"
        print "error: "+ str$(err)
        print "line : "+ str$(erl)
        print "text : "+ ert$(err)
	input "hit <enter> to exit...";junk$
        resume fini                                                     ! fix the stack
        !
	!	That's All Folks...
	!
32700   fini:                                                           !
	print "bye..."							!
        end                                                             !
This looks simple enough but consider the difficulties encountered when the program is 10,000 lines long with the I/O statements in all over the place with the exception handlers (and 

Sample Run for Demo 1A

Legend: <sr> = system response
        <ur> = user response
<sr>	$								! this is my DCL prompt
<ur>	run  vms-basic-demo_001
	vms-basic-demo_001
	==================
	enter a number? abc
	-e-non-numeric character encountered
	enter a number? 123
	you entered 123
	bye...
<sr>	$

Source Code For Demo 1B (trapping errors with WHEN ERROR IN)

3G languages like Pascal, Modula, C, and C++ allowed you to place your exception handling statements physically closer to the offending statement. This capability made it into VMS-BASIC but you are not forced to use it if you prefer ON ERROR.
1000    %title "vms-basic-demo_002.bas"
        !=============================================================
        ! title : vms-basic demo_002.bas
        ! author: NSR
        !=============================================================
        option type=explicit                                            !
        set no prompt                                                   !
        declare string constant k_program = "vms-basic-demo"
        declare string constant k_version = "002"
        declare string  junk$                   ,&
                long    i%
        !=============================================================
        !       main
        !=============================================================
2000    main:                                                           !
        print k_program +"_"+ k_version                                 !
        print string$(len(k_program +"_"+ k_version), asc("="))         !
2010    when error in                                                   ! like Pascal, Modula, C++, etc.
            input "enter a number? "; i%                                !
        use                                                             !
            print ert$(err)                                             !
            retry                                                       !
        end when
        print "you entered "; str$(i%)                                  !
        !
        !       more code would appear here
        !
        goto fini                                                       !
        !
        !       that's all folks
        !
32700   fini:                                                           !
	print "bye..."							!
        end                                                             !

Sample Run for Demo 1B

<sr>	$
<ur>	run  VMS-BASIC-DEMO_002
<sr>	vms-basic-demo_002
	==================
	enter a number? ABC
	%Data format error
	enter a number? 123
	you entered 123
	bye...
<sr>	$ 

Source Code For Demo 1C (combining both methods)

Many programmers will combine both techniques so that ON ERROR GOTO can be used to write untrapped errors to a diagnostic log file.

1000    %title "vms-basic-demo_003.bas"
        !=============================================================
        ! title : vms-basic demo_003.bas
        ! author: NSR
        !=============================================================
        option type=explicit                                            !
        set no prompt                                                   !
        declare string constant k_program = "vms-basic-demo"
        declare string constant k_version = "003"
        declare string  junk$                   ,&
                long    i%
        on error goto trap                                              ! Old-school BASIC
        !=============================================================
        !       main
        !=============================================================
2000    main:                                                           !
        print k_program +"_"+ k_version                                 !
        print string$(len(k_program +"_"+ k_version), asc("="))         !
2010    when error in                                                   ! new-school BASIC
            input "enter a number? "; i%                                !
        use                                                             !
            print ert$(err)                                             !
            retry                                                       !
        end when
        print "you entered "; str$(i%)                                  !
        !
        !       more code would appear here
        !
        goto fini                                                       !
        !=============================================================
        !       common error trap
        !=============================================================
32000   trap:                                                           !
        print "<<<common error trap >>>"
        print "error: "+ str$(err)
        print "line : "+ str$(erl)
        print "text : "+ ert$(err)
        ! insert code to write to a diagnostic log
        resume fini                                                     ! fix the stack
        !
        !       that's all folks
        !
32700   fini:                                                           !
        print "bye..."                                                  !
        end                                                             !

Source Code For Demo 2 (ISAM Files)

1000   %title "OpenVMS-BASIC-RMS-indexed-demo_xxx.bas"
       %sbttl "RMS (Record Management Services) Demo"
       %ident "version 101.1"
       !==============================================================================================================
       ! title  : OpenVMS-BASIC-RMS-indexed-demo_xxx.bas
       ! author : Neil Rieck (http://www3.sympatico.ca/n.rieck/links/cool_openvms.html)
       ! purpose: demos the use of RMS-based indexed file access for novice OpenVMS programmers
       ! scope  : this educational program comes free of charge with no strings attached
       ! notes  : 1. OpenVMS-BASIC has 'built in' support for RMS (Record Management Services)
       !        : 2. edit environment: VT-220, 132 column, 8 column tab stops at 1,9,17,25,....
       !        : 3. all remarks begin in column 81
       ! history:
       ! ver who when   what
       ! --- --- ------ ----------------------------------------------------------------------------------------------
       ! 100 NSR 020829 1. original program
       ! 101 NSR 050123 1. cleanup for public view
       !==============================================================================================================
       option type=explicit                                                    ! cuz tricks are for kids
       set no prompt                                                           ! no ? with INPUT
       !
       !       <<< declare constants >>>
       !
       declare string constant k_program = "OpenVMS-BASIC-RMS-Indexed-Demo"
       declare string constant k_idx_fs$ = "OpenVMS-BASIC-RMS-Indexed-Demo.dat"
       !
       !       <<< mapped variables to 'lay out' a disk record >>>
       !
       !       note: when the same map names is used, the second map overlays the first
       !
       map (indexed_demo) string       d21_first_name  = 20            ,       ! 20                                    &
                                       d21_last_name   = 20            ,       ! 40                                    &
                                       d21_telephone   = 10            ,       ! 50                                    &
                                       d21_address     = 20            ,       ! 70                                    &
                                       d21_city        = 20            ,       ! 90                                    &
                                       d21_postal_code = 10            ,       !100                                    &
                                       fill$           = 50            ,       !150    room to grow                    &
                                       d21_align       = 0                     !       to enforce map alignment
       map (indexed_demo) string       d21_whole_chunk = 150           ,       !150                                    &
                                       d21_align       = 0                     !       to enforce map alignment
       !
       !       <<< declare variables >>>
       !
       declare long    handler_error%                                  ,       &
                       rec_count%                                      ,       &
               string  junk$                                           ,       &
               rfa     rfa21                                                   ! record file address (a 48 bit variable)
       !
       !===============================================================================================================
       !       <<< main >>>
       !===============================================================================================================
2000   print k_program                                                         ! display program name
       print string$( len(k_program), ascii("=") )                             ! now underline it
       on error goto trap                                                      !
       margin #0, 132                                                          ! this will not change the screen size
       !
       !====================================================================================================
       !
       !       <<< delete all OpenVMS versions of our test file >>>
       !
       input "OK to delete 'demo data files'? (y/N) ";junk$
       junk$ = left$( edit$(junk$,32+2), 1)                                    ! upcase, no white space
       goto sortie if junk$ <> "Y"
       when error in
           while 1=1                                                           ! make sure we get all versions
               kill k_idx_fs$
           next
       use                                                                     !
       end when
       !
       !       <<< open the file >>>
       !
       !       "BASIC Open" notes:
       !       1. open k_idx_fs$  for input  as file #21       - the file must already exist
       !       2. open k_idx_fs$  for output as file #21       - a new file version is always created
       !       3. open k_idx_fs$             as file #21       - the file is created if it doesn't exit
       !
       input "OK to create/open 'demo data file'? (y/N) ";junk$
       junk$ = left$( edit$(junk$,32+2), 1)                                    ! upcase, no white space
       goto sortie if junk$ <> "Y"
3000   when error in
           print "-i- opening file: "; k_idx_fs$
           open k_idx_fs$  as file #21                                         ! create the file if it doesn't exist           &
               ,access         modify                                          ! we want to read + write                       &
               ,allow          modify                                          ! allow others to read + write while we do it   &
               ,map            indexed_demo                                    !                                               &
               ,organization   indexed                                         !                                               &
               ,primary        (d21_last_name, d21_first_name, d21_city)       ! key #0                                        &
               ,alternate      d21_last_name   duplicates changes              ! key #1                                        &
               ,alternate      d21_telephone   duplicates changes              ! key #2                                        &
               ,alternate      d21_telephone   duplicates changes descending   ! key #3
           !
           ! note: the connected channel is opened last but must be closed first
           !
           print "-i- opening file: "; k_idx_fs$; " (connect)"
           open k_idx_fs$      as file #22                                     !                                               &
               ,access         modify                                          ! we want to read + write                       &
               ,allow          modify                                          ! allow others to read + write while we do it   &
               ,map            indexed_demo                                    !                                               &
               ,organization   indexed                                         !                                               &
               ,connect 21                                                     !
           handler_error% = 0                                                  ! show that all is well
       use
           handler_error% = err
           print "-e- error: "+str$( handler_error% )+" in phase #1"
           print "-i- text : "+ert$( handler_error% )
       end when
       goto sortie if handler_error% <> 0                                      ! exit on ant errors
       !
       !       <<< write some records >>>
       !
4000   rec_count%      = 0
       input "OK to write 3 demo data records? (y/N) ";junk$
       junk$ = left$( edit$(junk$,32+2), 1)                                    ! upcase, no white space
       goto sortie if junk$ <> "Y"
       when error in
           print "-i- writing file: "; k_idx_fs$
           d21_whole_chunk             = ""                                    ! start with a clean buffer
           !
           d21_first_name              = "Ken"
           d21_last_name               = "Olsen"
           d21_telephone               = "4165553333"
           d21_address                 = "129 Parker Street"
           d21_city                    = "Toronto"                             ! this gets corrected below
           d21_postal_code             = "01754"
           print "-i- writing record: "; str$(rec_count% + 1)                  !
           put #21                                                             ! write to file
           rec_count% = rec_count% + 1                                         !
           !
           d21_first_name              = "Dave"
           d21_last_name               = "Cutler"
           d21_telephone               = "4165552222"
           d21_address                 = "220 Simcoe Street"
           d21_city                    = "Toronto"
           d21_postal_code             = "M5T1T4"
           print "-i- writing record: "; str$(rec_count% + 1)
           put #21                                                             ! write to file
           rec_count% = rec_count% + 1
           !
           d21_first_name              = "Gordon"
           d21_last_name               = "Bell"
           d21_telephone               = "4165551111"
           d21_address                 = "483 Bay Street"
           d21_city                    = "Toronto"
           d21_postal_code             = "M5G2C9"
           print "-i- writing record: "; str$(rec_count% + 1)
           put #21                                                             ! write to file
           rec_count% = rec_count% + 1
           !
           print "-i- will rewrite previous record to force a duplicate key error (134)"
           print "-i- writing record: "; str$(rec_count% + 1)                  !
           put #21                                                             ! write to file
           rec_count% = rec_count% + 1                                         !
           !
           handler_error% = 0
       use
           handler_error% = err
           print "-e- error: "+ str$( handler_error% )+" in phase #2"
           print "-i- text : "+ ert$( handler_error% )
           print "-i- recs : "+ str$( rec_count% )
       end when
       gosub read_sequentially                                                 ! display all records
       !
       !       <<< read the file sequentially by index-key #1 >>>
       !
5000   input "OK to display data records in reverse telephone order? (y/N) ";junk$
       junk$ = left$( edit$(junk$,32+2), 1)                                    ! upcase, no white space
       goto sortie if junk$ <> "Y"
       when error in
           print "-i- reading file: "; k_idx_fs$; " by index-key-3"
           reset #21, key#3
       !   find #21, key#3 gt " ", regardless                                  x same as previous line
           handler_error% = 0
           while 1=1                                                           ! loop forever (until we trap out)
               get #21, regardless                                             ! read without applying a record lock
               print   "first name  : ";       d21_first_name
               print   "last_name   : ";       d21_last_name
               print   "telephone   : ";       d21_telephone
               print   "address     : ";       d21_address
               print   "city        : ";       d21_city
               print   "postal code : ";       d21_postal_code
               print   "=============================="
               sleep 1
           next
       use
           handler_error% = err
           print "-e- error: "+str$( handler_error% )+" in phase #4"
           print "-i- text : "+ert$( handler_error% )
       end when
       !
       !       <<< find/delete record "Cutler" >>>
       !
6000   input "OK to delete record for 'Dave Cutler'? (y/N) ";junk$
       junk$ = left$( edit$(junk$,32+2), 1)                                    ! upcase, no white space
       goto sortie if junk$ <> "Y"
       when error in
           find #21, key#1 nxeq "C "                                           ! find (with lock)
           while 1=1                                                           ! loop forever (until we trap out)
               get #21                                                         ! read (with lock)
               if  d21_last_name = "Cutler" and                                &
                   d21_first_name = "Dave"
               then                                                            ! if Dave Cutler
                   delete #21                                                  !
                   print "-i- record deleted, looking for more people named 'Dave Cutler'"
               else                                                            !
                   cause error 11 if left$( d21_last_name,1) <> "C"            ! exit if we've gone too far
                   iterate                                                     !
               end if
           next
       use
           handler_error% = err
           print "-e- error: "+str$( handler_error% )+" in phase #5"
           print "-i- text : "+ert$( handler_error% )
       end when
       !
       gosub read_sequentially                                                 ! display all records
       !
       !       <<< delete record #2 >>>
       !
7000   input "OK to delete 'Gordon Bell' using the RFA method? (y/N) ";junk$
       junk$ = left$( edit$(junk$,32+2), 1)                                    ! upcase, no white space
       goto sortie if junk$ <> "Y"
       when error in
           find #21, key#1 ge "Bell", regardless                               ! Find (without lock) (ge = nxeq)
           while 1=1                                                           !
               get #21, regardless                                             ! read (without lock)
               cause error 11 if pos(d21_last_name,"Bell",1)=0                 ! exit if we've gone too far
               if  d21_last_name = "Bell" and                                  &
                   d21_first_name = "Gordon"
               then                                                            ! if Gordon Bell
                   rfa21 = getrfa(21)                                          ! get the record file address
                   get #22, rfa rfa21                                          ! position connected channel with LOCK
                   delete #22                                                  ! now delete
                   print "-i- record deleted, looking for more people named 'Gordon Bell'"
               else
                   iterate                                                     ! do another GET on orginal channel
               end if
           next
       use
           handler_error% = err
           print "-e- error: "+str$( handler_error% )+" in phase #6"
           print "-i- text : "+ert$( handler_error% )
       end when
       gosub read_sequentially                                                 ! display all records
       !
       !       <<< find/update record "Olsen" >>>
       !
8000   input "OK to change Ken Olsen's City? (y/N) ";junk$
       junk$ = left$( edit$(junk$,32+2), 1)                                    ! upcase, no white space
       goto sortie if junk$ <> "Y"
       find_update_reentry_point:
       when error in
           find #21, key#1 ge "Olsen", regardless                              ! set key
           while 1=1
               get #21, regardless                                             ! read without lock
               cause error 11 if pos(d21_last_name,"Olsen",1)=0                ! exit if we've gone too far
               if  d21_first_name      = "Ken"         and             &
                   d21_last_name       = "Olsen"       and             &
                   d21_city            = "Toronto"
               then
                   rfa21 = getrfa(21)
                   get #22, rfa rfa21
                   d21_city            = "Maynard"
                   d21_postal_code     = ""
                   update #22
                   print "-i- record update, looking for more people named 'Ken Olsen'"
               end if
           next
       use
           handler_error% = err
           print "-e- error: "+str$( handler_error% )+" in phase #7a"
           print "-i- text : "+ert$( handler_error% )
       end when
       !
       select handler_error%
           case    130                                                         ! key not changeable (for primary keys only)
               when error in
                   print "-i- attempting FIND-RFA"
                   find #22, rfa rfa21                                         ! position with LOCK (but don't change data)
                   print "-i- attempting DELETE"
                   delete #22                                                  ! delete
                   print "-i- attempting PUT"
                   put #22                                                     ! write buffered data
                   handler_error% = 0
               use
                   handler_error% = err
                   print "-e- error: "+str$( handler_error% )+" in phase #7b"
                   print "-i- text : "+ert$( handler_error% )
               end when
               goto find_update_reentry_point if handler_error% = 0            ! look for more if successful
           case 11                                                             ! end-of-file
           case 155                                                            ! record-not-found
           case 131                                                            ! no current key (no lock)
       end select
       !
       gosub read_sequentially                                                 ! display all records
       !
       print string$( 60, ascii("-") )                                         ! draw a line
       print "That's all for now"
       sleep 1
       goto sortie
       !====================================================================================================
       !       Subroutines
       !====================================================================================================
       !
       !       <<< read the file sequentially >>>
       !
20000  read_sequentially:
       input "OK to display data records sequentially? (y/N) ";junk$
       junk$ = left$( edit$(junk$,32+2), 1)                                    ! upcase, no white space
       goto read_sequentially_exit     if junk$ <> "Y"
       when error in
           print "-i- reading file: "; k_idx_fs$; " sequentially"
           handler_error% = 0
           reset #21                                                           ! rewind to BOF
       !   reset #21, key#0                                                    x same as "reset #21"
           while 1=1
               get #21, regardless                                             ! read without applying a record lock
               print   "first name  : ";       d21_first_name
               print   "last_name   : ";       d21_last_name
               print   "telephone   : ";       d21_telephone
               print   "address     : ";       d21_address
               print   "city        : ";       d21_city
               print   "postal code : ";       d21_postal_code
               print   "=============================="
               sleep 1
           next
       use
           handler_error% = err
           print "-e- error: "+str$( handler_error% )+" in phase #3"
           print "-i- text : "+ert$( handler_error% )
       end when
       read_sequentially_exit:
       return
       !===============================================================================================================
       !       <<< Final Error Trap >>>
       !
       !       If we've done a good job coding, we should never see this code >>>
       !===============================================================================================================
31000  trap:
       print
       print "Common Error Trap"
       print "Line: "+ str$(erl)
       print "Err : "+ str$(err)
       print "Msg : "+ ert$(err)
       resume sortie								! fix the stack
       !===============================================================================================================
       !
       !       <<< that's all folks >>>
       !
32000  sortie:
       close 22									! always close the connected channel first
       close 21									!
       print "Adios..."								!
       end

Exiting VMS-BASIC to a DCL Script

The last line of a VMS-Basic program determines what the calling environment will see in shell variable: $STATUS

	end				! will always return "1" (VMS-Success) by default

	end program x			! will always return the integer value of x

	end program x + reason * 32768	! alternative exit to send more info back to DCL
VMS Error Codes (Odd is good, Even is bad)
0 = VMS-w- warning (Caveat: in the UNIX/C world, 0=good)
1 = VMS-s- success --------+-- odd is good
2 = VMS-e- error	   |
3 = VMS-i- informational --+
4 = VMS-f- fatal
5 = VMS-?- undefined
6 = VMS-?- undefined
7 = VMS-?- undefined
This DCL stub shows how to pass two pieces of information into the BASIC program (via process-level logical names) then call the VMS-BASIC program which passes back two values in $STATUS 
$ define/proc YADA$DEMO_MODE      whatever 	! start basic application in desired mode
$ define/proc YADA$DEMO_UNIV_FILE 'txt_fs' 	! PROCESS THIS FILE
$ run         SOME_BASIC_PROGRAM.EXE       	!
$ my_status = f$integer($status)           	! save a copy of $STATUS
$ flag      = my_status .and. 7            	! will be in the range of 0-7
$ reason    = my_status / 32768            	! determine user-defined reason
$ if (flag .ne. 1)				! not-equal-to
$ then
$    write sys$output "Oops, error ",flag," occurred due to reason: ",reason
$    goto error_handler
$ endif

Links:


Back to OpenVMS
Back to Home
Neil Rieck
Kitchener - Waterloo - Cambridge, Ontario, Canada.