OpenVMS Source-Code Demos

RMS_TEST_FSP.BAS

1000	%title "RMS_TEST_FSP_xxx"
	%ident                              "version 1.02"			! <<<---+---
	declare string constant k_version = "version 1.02"		,	! <<<---+	&
				k_program = "RMS_TEST_FSP"			!
	!====================================================================================================
	! Title  : RMS_TEST_FSP_xxx.BAS
	! Author : Neil Rieck
	! Created: 000809
	! Notes  : 1. original program from examples in the DEC BASIC for OpenVMS "User's Manual"
	!		and "Reference Manual"
	!	   2. additional info from $FABDEF and $RABDEF found in SYS$LIBRARY:BASIC$STARLET.TLB
	! ver who when     what
	! --- --- -------- ----------------------------------------------------------------------------------
	! 100 NSR 20000809 1. original program
	! 101 NSR 20100529 1. renamed a few variables
	! 102 NSR 20100531 1. added code to to test-open GIFs and JPGs (this is just hacking)
	!     NSR 20110825 2. a few tweaks
	!====================================================================================================
	option type=explicit							!
	set no prompt								!
	!
	map(rms_stuff)	string	rms_stuff	= 16	,			!				&
			string	rms_align	= 0				!
	map(rms_stuff)	byte	rs_org		,				! 1=  1				&
			byte	rs_rat		,				!+1=  2				&
			word	rs_mrs		,				!+2=  4				&
			long	rs_alq		,				!+4=  8				&
			word	rs_bks_bls	,				!+2= 10				&
			word	rs_num_keys	,				!+2= 12				&
			long	rs_mrn		,				!+4= 16				&
			string	rms_align	= 0				!
	!
	declare string my_file$, temp$						!
	!========================================================================================================================
	!	main
	!========================================================================================================================
	main:
	print k_program +"_"+ k_version						!
	print string$(len(k_program +"_"+ k_version), asc("="))			!
	!
	print "test-open gif files ? (y/N) ";					!
	input temp$								!
	goto test_gif_files	if edit$(temp$, 32%+2%) = "Y"
	!
	print "create test files ? (y/N)   ";					!
	input temp$								!
	gosub create_some_test_files	if edit$(temp$, 32%+2%) = "Y"
	!
	!-------------------------------------------------------
	!	test these data files
	!-------------------------------------------------------
	test_data_files:
	!
	my_file$ = "aaa_demo_basic_rms_seq_fix.dat"
	gosub test_file
	!
	my_file$ = "aaa_demo_basic_rms_seq_var.dat"
	gosub test_file
	!
	my_file$ = "aaa_demo_basic_rms_rel_fix.dat"
	gosub test_file
	!
	my_file$ = "aaa_demo_basic_rms_rel_var.dat"
	gosub test_file
	!
	my_file$ = "aaa_demo_basic_rms_inx_fix.dat"
	gosub test_file
	!
	my_file$ = "aaa_demo_basic_rms_inx_var.dat"
	gosub test_file
	!
	goto fini						!
	!-------------------------------------------------------
	!	test these data files
	!-------------------------------------------------------
	test_gif_files:
	!
	my_file$ = "[._BASIC_DEMO]Crookes_radiometer_moving.gif"
	gosub test_file
	!
	my_file$ = "[._BASIC_DEMO]skynet-prototype-cpu.jpg"
	gosub test_file
	!
	my_file$ = "[._BASIC_DEMO]TM-CM2-0109-SUPERCOMP_x600.jpg"
	gosub test_file
	!
	goto fini						!
	!-------------------------------------------------------
	!	<<< test the desired file >>>
	!-------------------------------------------------------
	test_file:
	open my_file$ for input as #100		&
		,access read			&
		,recordtype any			&
		,organization undefined
	rms_stuff = fsp$(100)					!
	!
	print	"========================================"
	print	"file        "; my_file$
	print	"org         "; rs_org;
	select rs_org						!
	    case >= 48
		print " (hashed)"
	    case >= 32
		print " (indexed)"
	    case >= 16
		print " (relative)"
	    case else
		print " (sequential)"
	end select
	print	"rec attr    "; rs_rat				!
	print	"max rec siz "; rs_mrs				!
	print	"alloc qty   "; rs_alq				!
	print	"bucket size "; rs_bks_bls; " (always zero)"	! see "User Manual" about bytes 9-12
	print	"num of keys "; rs_num_keys; " (always zero)"	! see "User Manual" about bytes 9-12
	print	"max rec num "; rs_mrn				! not always zero (see relative tests)
	close #100						!
	return							!
	!-------------------------------------------------------
	!	<<< create some test files >>>
	!-------------------------------------------------------
	create_some_test_files:
	rms_stuff	= ""
	!
	!	sequential
	!
	open "aaa_demo_basic_rms_seq_fix.dat" for output as #100	&
		,organization	sequential	fixed			&
		,map		rms_stuff
	put #100
	put #100
	put #100
	!
	open "aaa_demo_basic_rms_seq_var.dat" for output as #100	&
		,organization	sequential	variable		&
		,map		rms_stuff
	put #100
	put #100
	put #100
	!
	!	relative
	!
	open "aaa_demo_basic_rms_rel_fix.dat" for output as #100	&
		,organization	relative	fixed			&
		,map		rms_stuff
	put #100, record 1
	put #100, record 2
	put #100, record 3
	!
	open "aaa_demo_basic_rms_rel_var.dat" for output as #100	&
		,organization	relative	variable		&
		,map		rms_stuff
	put #100, record 1
	put #100, record 2
	put #100, record 3
	!
	!	indexed
	!
	open "aaa_demo_basic_rms_inx_fix.dat" for output as #100	&
		,organization	indexed		fixed			&
		,map		rms_stuff				&
		,primary key	rs_mrs		duplicates		&
		,alternate key	rs_alq		duplicates
	put #100
	put #100
	put #100
	!
	open "aaa_demo_basic_rms_inx_var.dat" for output as #100	&
		,organization	indexed		variable		&
		,map		rms_stuff				&
		,primary key	rs_mrs		duplicates		&
		,alternate key	rs_alq		duplicates		&
		,alternate key	rs_mrn		duplicates
	put #100
	put #100
	put #100
	!
	close #100
	return								!
	!
	!----------------------------------------------------------------------
	!
	fini:
	end