OpenVMS Notes: VMS-BASIC
- The information presented here is intended for educational use by qualified OpenVMS technologists.
- The information presented here is provided free of charge, as-is, with no warranty of any kind.
Introductory Notes:
-
Ancient 16-bit History:
- DEC offered various 16-bit compilers (BASIC, BASIC2, BASIC2+) targeted to various 16-bit operating systems (RT-11, RSTS, RSX-11M)
- Optional ISAM (indexed sequential access method) technology was enabled by purchasing an RMS license
- The Early Days of 32-bit compilers at DEC
- DEC built RMS in to VMS (their 32-bit OS) for several reasons:
- to speed up VMS logins (SYSUAF is now indexed)
- so DEC's COBOL language could support new industry standard features such as multi-key indexed file access
- DEC built RMS in to VMS (their 32-bit OS) for several reasons:
- VMS BASIC has suffered an identity crisis due to numerous name changes over the years.
- Originally introduced in 1980 as BASIC Multikey ISAM for VMS 2.0
- Later was rebranded VAX BASIC to avoid confusion with earlier 16-bit products
- Was split into two code bases with the introduction of 64-bit Alpha
- DEC BASIC for OpenVMS VAX
- DEC BASIC for OpenVMS Alpha (still generates 32-bit applications on 64-bit Alpha)
- due to the nature of RISC technology, the standalone BASIC interpreter was dropped
- on the flip side, this compiler is based upon the GEM code generator so includes a very efficient code optimizer
- The product names changed again when Compaq purchased DEC in 1998
- Compaq BASIC for OpenVMS VAX
- Compaq BASIC for OpenVMS Alpha (still generates 32-bit applications on 64-bit Alpha)
- The product names changed again when HP purchased (err, merged with) Compaq in 2002
- HP BASIC for OpenVMS VAX
- HP BASIC for OpenVMS Alpha
- The introduction of Itanium in 2003 brought a third product:
- HP BASIC for OpenVMS Itanium
comment: this current name is really bad. Why? Google searches will always include HP BASIC which was used on numerous HP products including their popular and ubiquitous HP 3000 minicomputer - To the best of my knowledge, this product only produces 32-bit applications on 64-bit Itanium.
- question: What does this really mean?
- answer: The main restriction would be that an app requiring more than 2 GB of DSR (pool) would not be be able to do so.
- HP BASIC for OpenVMS Itanium
- This web page uses the generic name VMS BASIC (I don't think VMS products will ever move to another company but you should never-say-never)
External Links:
- HP BASIC for OpenVMS @ wikipedia
- Manuals: HP BASIC for OpenVMS
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 (https://neilrieck.net/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:
- HP BASIC for OpenVMS @ wikipedia
- HP Manuals: HP BASIC for OpenVMS
- OpenVMS Resources
- OpenVMS Demos (lots of BASIC demos)
- VAX to Alpha Porting Diaries (lots of BASIC stubs)
Back to HomeNeil Rieck
Waterloo, Ontario, Canada.