LD.C

#define LD_MODULE "X-20"
#define LD_VERSION "V9.8"
#ifdef SYSINIT_OPCCRASH
#pragma module LD_SYSINIT_OPCCRASH LD_MODULE
#else
#pragma module LD LD_MODULE
#endif
//**********************************************************************//
//                                                                      //
// These sources for LDdriver  are based on the sources provided in the //
// LD  V9.7  kit  as  provided by  Jur  van den  Burg  on  digiater.nl. //
// VMS Software, Inc (VSI) has put its changes to  these sources in the //
// public domain.                                                       //
//                                                                      //
// The original license statement for LD 9.7 reads as follows:          //
//                                                                      //
// LDdriver is freeware.  It may be  freely  downloaded and  used.  The //
// sources are available in the kit, and support is limited. In case of //
// problems report them and they may get fixed.  We are not responsible //
// for any malfunction or data loss caused by this software.            //
//                                                                      //
//**********************************************************************//
//
//  Facility:
//
//	VAX/VMS Logical Disk Utility
//
//  Abstract:
//
//	This utility enables the user to create, setup and display
//	information of the Logical Disks available in  the system,
//	via the LDDRIVER.
//
//  Author:
//
//	Jur van der Burg 	13-OCT-1992	Version 2.0
//	(lddriver@digiater.nl)
//
//	Rewritten from original MACRO version (by A. Sweep) for easier
//	maintenance.
//
//  Revision:
//
//	X-20	CMOS	Christian Moser		20-Jun-2022
//	Remove setting NOLOCK bit in the FIB when accessing a tape container.
//
//	X-19	RAB	Richard A. Bishop	23-Aug-2021
//	Tweaks to the changes in X-18.
//	- Allow for DEVICEINUSE in addition to FILEINUSE and
//	  DUPUNIT when retrying the SYSINIT connection.
//	- The attempt limit of 100 is dumb. Change it to 5,
//	  which is still likely to be way more than enough.
//
//	X-18	RAB	Richard A. Bishop	12-Jul-2021
//	Add support for unique memory disk unit numbers.
//	There's a lot of repositioning of conditionals so the
//	correct code is available for the SYSINIT/OPCCRASH/
//	regular utility cases, plus:
//	- We need the unit seed code in the SYSINIT version
//	- The handler around the SYSINIT code needs to be in
//	  a called routine so that the unwind ends up at the
//	  correct place to try again (up to 100 times). The
//	  actual unit number used is passed back to SYSINIT.
//	- Use the same handler jacket for the disconnect
//	  (OPCCRASH) case.
//	- The created device must be shared if we're in a
//	  cluster and must have the same allocation class as
//	  the system disk.
//	- We must try to use the given unit number (from
//	  SYS$MD.FID) and only try a new number if that
//	  clashes.
//	- The data block passed by SYSINIT is now a copy of
//	  the SYSMD structure in pool, including the SYSMD.FID
//	  constants and other data.
//
//	X-17	RAB	Richard A. Bishop	30-Sep-2020
//	Tweak the code that splits the memory disk device/DID/FID string
//	into sections. There's now another segment (the logical name to
//	be given to the memory disk container). It's not used here, but
//	the code in connect_one() has to allow for its presence.
//
//	X-16	RAB	Richard A. Bishop	20-Apr-2020
//	We can't use anything we want from DECC$SHR in the SYSINIT/OPCCRASH
//	build variant. malloc, sscanf, etc. have to be avoided so that
//	KERNEL.OLB can be used. Adjust the conditionals so that nothing
//	that's not needed in the SYSINIT/OPCCRASH variant gets pulled in.
//
//	X-15	RCL	Rick Lord
//	LD$UTILITY checks to see if the command by which it was invoked was LM
//	or LD by checking argv[0], but on X86 argv[0] currently references a
//	NULL string. Modify main() to conditionally check argv[0], and if it's
//	NULL or if it references a NULL string then assume that we were invoked
//	to access logical disk, not a logical tape.
//
//	X-14	RAB	Richard A. Bishop	10-Jan-2018
//	Widen scope of SYSINIT-callable variant to be used by OPCCRASH too.
//	This mostly involves changingroutine names and comments to reflect
//	the additional usage, and shuffling some declarations around to group
//	globals and externals used by the variant together. There's a new
//	entry point for OPCCRASH and some additional routines are included
//	in the variant.
//	(For simplicity, there's only a single variant, used by both SYSINIT
//	and OPCCRASH).
//	Also: remove all references to V82_UP and V83_UP. For VSI, post-V8.4
//	is the only scenario of interest.
//
//	X-13	RAB	Richard A. Bishop	15-Aug-2016
//
//	Correctly cast the $PUTMSG action routine argument to match the
//	definition. C needs to think it returns void not int, requiring
//	this cast: (void (*)())
//
//	X-12	RAB	Richard A. Bishop	01-Aug-2016
//
//	Inserted page breaks between routines.
//	Conditional code added to allow connection to the memory disk
//	container file during SYSINIT. All code not needed by SYSINIT
//	gets skipped, some new code is added (including the routine 
//	SYSINIT_LD, called by SYSINIT, and "replacing" MAIN). The
//	routine OPEN_FILE will accept a DID/FID combination for SYSINIT's
//	benefit.
//
//	(Fixed ident & audit trail to match CMS/VDE generation)
//
//	X-14	RAB	Richard A. Bishop	07-Jun-2016
//
//	Use contiguous-best-try on CREATE if /CONTIGUOUS not requested.
//
//	X-13	RAB	Richard A. Bishop	23-Oct-2015
//
//	Allow for systems with SCSNODE="" (e.g. booted from a kit disk).
//
//	X-12	JvdB	Jur van der Burg 	 7-Aug-2012
//
//	Change device search wildcard from *LD* to *$LD* as the devicename
//	may contain LD in the nodename, which will give the wrong device
//	in return. This affects SHOW/ALL and DISCONNECt/ALL.
//
//	X-11	JvdB	Jur van der Burg 	 31-Dec-2010
//
//	On disconnect modify the file attributes to no_caching if not set
//	correctly. Not doing that may leave data in the cache from previous
//	operations like copy, unzip, etc. Flushing the XFC cache by an
//	open/read/write/close sequence may not always get rid of the data.
//	The best would be a new call to XFC to remove a file from the cache,
//	but that's not currently there so we change the file characteristics
//	which ensures that a subsequent open will bypass the cache.
//	Correct bug in display of delta trace time (microseconds part). That
//	field contained garbage.
//
//	X-10	JvdB	Jur van der Burg 	 22-Jan-2009
//
//	Add CONNECT/EXTEND/LIMIT to allow dynamic extension of containerfiles
//	for tape. This implies opening the container file for write.
//	Change method for connecting a containerfile by using the channel
//	instead of the SBK. Keep the old method around so we don't break
//	compatibility with other applications. The same holds true for
//	file-based watchpoiints.
//	Add DISCONNECT/TRUNCATE.
//	Allow creation of a 1 block container file.
//	Change default create size to 512 for disk and 5000 for tape.
//	Don't write tape metadata when extending a file.
//	Don't erase tape metadata when erasing a file.
//	Add check for data beyond metadata size in analyze.
//
//	X-9	JvdB	Jur van der Burg 	 10-Sep-2006
//
//	Use Ansi C. Obsolete vax.
//	Change display to use accurate timestamps (V8.3 and up)
//	Add keywords for /TIMESTAMP=START and END
//	Add CREATE/ERASE.
//	Add warning when creating big files while highwater
//	marking is on (V8.2 and up).
//	Add /LOGICAL=(NAME=logical-name[,TABLE=table][,MODE=mode])
//	for CONNECT.
//	Add ANALYZE command.
//	Add SWITCH, LOAD and UNLOAD commands.
//	Add CONNECT/INIT.
//
//	X-8     JvdB    Jur van der Burg         22-Mar-2006
//	Adapt time calculations to new trace structure definitions
//
//	X-7	JvdB	Jur van der Burg 	 24-Feb-2006
//	Show usage of MON driver in version command, and add
//	VMS version and hardware info.
//	Correct definitions for channel variables from int
//	to short.
//	Make some structures static in open_file.
//	Correct create/extend logic to properly position eof.
//
//	X-6	JvdB	Jur van der Burg 	 25-Oct-2005
//	Use info from command table to see if privileges are
//	needed or not.
//	Allow creation of containerfile on NFS mounted filesystem.
//
//	X-5	JvdB	Jur van der Burg 	 12-Oct-2005
//
//	Add itemlist to sys$device_scan to look for disk devices only.
//	Failure occurs when the name of the system includes LD....
//	Remove privilege handling for VAX as VAX does not support
//	PRV$K_PRVMASK_IMAGE. Some privs needed for some functions
//	(CMKRNL, WORLD) would always be disabled and prevent correct
//	functioning.
//	Add check for loaded driver and correctly installed image.
//	Allow only a controller letter as a hint to for device
//	connection to allow other controllers than 'A'.
//	Add LD VERSION
//	Add LD CONNECT/[NO]FORCED_ERROR
//	Add LD CREATE/EXTEND
//
//	X-4	JvdB	Jur van der Burg 	24-Sep-2005
//
//	Rework container file creation. The old way could result in a
//	SS$_HEADERFULL error when setting the container file metadata.
//	If there is a default ACL applied to the file's parent directory
//	we will inherit that during file creation, which inhibits the
//	reserved area to be written.
//	Add support for LD CONNECT/LOCK to prevent container file
//	deletion. Not that it could be deleted, but it could be
//	marked for delete.
//	Add logical name as a parameter for connect.
//	Disable privileges at the start, and only enable them
//	when needed.
//
//	X-3	JvdB	Jur van der Burg 	6-Dec-2004
//
//	Add support for disk lbn mapping:
//	  LD CONNECT /BLOCK=(START=xxx,END=xxx,COUNT=xxx)
//	  [/OVERRIDE]
//	Add IO$M_BYPASS_VALID_CHK modifier check
//	Protect unit assignment with locks from other users.
//	Properly check sys$enq status.
//	Update ident to match VDE.
//
//	Jur van der Burg 	14-Jan-2004	Version 7.0
//
//	Reworked edit history
//	Add /CLONE
//	Add PROTECT /PERMANENT
//	Add saving of geometry in fileheader
//	Disable caching of containerfile on create and open
//	Flush eventual XFC cache contents of container file
//	Add LD HELP
//
//	Jur van der Burg 	5-JUL-2000	Version 6.3
//
//	Add optional FDT logging
//	Add accurate timing logging (only used on Alpha)
//	Modify status display
//	Modify disconnect logging info
//	Drop requirement for inputfilespec on disconnect. This allows deleted
//	containerfiles to be disconnected without /ABORT.
//
//	Jur van der Burg 	19-AUG-1998	Version 6.2
//
//	Added a way to use more controller letters to bypass the limit of
//	9999 cloned devices. Do this by specifying another device on connect:
//	LD CONNECT FILE.DSK LDC44. The driver can already handle this.
//
//	Jur van der Burg 	15-NOV-1996	Version 6.0
//
//	Lifted restriction for contiguous container file
//	Corrected problem setting virtual watchpoint on a file
//	Make sure filename is terminated in open_file to prevent errors
//	during LD DISCONNECT/ALL/LOG with lots of devices
//	Add /FUNCTION=ALL to watchpoint to allow trapping of all I/O's
//
//	Jur van der Burg 	28-OCT-1994	Version 5.1
//
//	Add /SYMBOL qualifier for CONNECT
//	Add /SHARE qualifier to allow sharing of containerfiles clusterwide
//	Add /TRACKS, /SECTORS, /CYLINDERS and /MAXBLOCKS switches to
//	CONNECT to specify geometry, removed /ALLOCATED (superceeded by
//	/MAXBLOCKS). Also added /ALLOCLASS to set allocation class which
//	may be different from the system parameter ALLOCLASS.
//
//	Jur van der Burg 	14-OCT-1993	Version 5.0
//
//	Add WATCH commands
//	Adapted for new interface with LDdriver
//
//	Jur van der Burg 	8-JUL-1993	Version 4.1
//
//	Corrected bytecount display and iosb display to use longword
//	instead of word field for data.
//	Bumped datafile versionnumber because of change in trace data
//	layout.
//
//	Jur van der Burg 	14-APR-1993	Version 4.0
//
//	Modified command interface to use DCLTABLES
//	Added cloned device support
//	Reworked error handling and display.
//	Add remote trace stop
//
//	Jur van der Burg 	23-FEB-1993	Version 3.1
//
//	Expand given devicespec in 'replace' mode to full spec instead
//	of spec from the commandline.
//	Add more trace functionality
//
//	Jur van der Burg 	17-FEB-1993	Version 3.0
//
//	Added trace commands
//	Minor bugfixes
//
//
//  Commands:
//
//       - LD CREATE [/LOG] [/SIZE=xxx] [/BACKUP] [/CONTIGUOUS] [/LBN=xxx]
//               [/TRACKS=xxx] [/SECTORS=xxx] [/CYLINDERS=xxx] [/ERASE]
//               [/MAXBLOCKS=xxx] [/CLONE=device] [/EXTEND] Filespec
//       - LD CONNECT [/LOG] [/SYMBOL] [/REPLACE] [/SHARE] [/CLONE=device]
//               [/TRACKS=xxx] [/SECTORS=xxx] [/CYLINDERS=xxx] [/FULL]
//               [/MAXBLOCKS=xxx] [/ALLOCLASS=xxx] [/AUTOGEOMETRY]
//               [/SAVE] [/LBN=(START=xxx,END=xxx,COUNT=xxx)] [/OVERRIDE]
//		 [/LOGICAL=(NAME=logical-name[,TABLE=table][,MODE=mode])]
//	         [/LOCK] [/FORCED_ERROR] [/INIT] [/[NO]LOAD] [/EXTEND[=n]]
//		 [/LIMIT[=n]] Filespec [LDan:] [Logicalname]
//       - LD LOAD Filespec LDan: (Qualifiers like CONNECT)
//       - LD SWITCH Filespec LDan: (Qualifiers like CONNECT)
//       - LD DISCONNECT [/ALL] [/LOG] [/ABORT] [/TRUNCATE] LDan:
//       - LD UNLOAD [/LOG] [/TRUNCATE] LDan:
//       - LD TRACE [/ACCURATE] [/FDT] [/SIZE=xxx] [/RESET] [/ALL] LDan:
//       - LD TRACE/STOP [/ALL] [LDan:]
//       - LD NOTRACE LDan:
//       - LD WATCH LDan: lbn [,lbn...] [/FUNCTION=READ,WRITE,ALL,CODE=xxx]
//               [/ACTION=SUSPEND,CRASH,OPCOM,ERROR[=xxx]]
//               [/FILE=filespec]
//       - LD NOWATCH LDan: [lbn [,lbn...]] [/INDEX=n]
//       - LD WATCH/RESUME LDan: [lbn [,lbn...]] [/INDEX=n]
//       - LD PROTECT [/PERMANENT] LDan:
//       - LD NOPROTECT [/PERMANENT] LDan:
//       - LD SHOW [/ALL] [/FULL] [LDan:]
//       - LD SHOW/WATCH LDan: [lbn [,lbn...]]
//       - LD SHOW/TRACE [/STATUS] [/RESET] [/OUTPUT=Filespec] [/INPUT=filespec]
//               [/BINARY] [/ENTRIES=[(XXX,YYY)]] [/HEADER] [/CONTINUOUS]
//               [/VERSION_LIMIT=xxx] [/BLOCKS=xxx] [/WARNINGS]
//               [/NUMBER] [/PID] [/LBN] [/BYTECOUNT]
//               [/IOSB[=COMBINATION,TEXT,HEX,LONGHEX]]
//               [/TIMESTAMP[=ABSOLUTE,ELAPSED,COMBINATION,DELTA,START,END]]
//               [/FUNCTION[=TEXT,HEX]] [/ACCURATE] [/FDT] [/SYMBOL] LDan:
//       - LD ANALYZE [/RECORDS[=HEX,DECIMAL]] [/DATA] [/DIRECTORY[=HEX,DECIMAL]]
//               [/CONTINUE] [/OUTPUT=Filespec] Filespec
//       - LD HELP [topic]
//       - LD VERSION
//
//

#include "ld.h"

#pragma message disable funcredecl

//
// Internal routine declarations
//

int	getqual(struct dsc$descriptor_s *arg);
int	getqualvalue(struct dsc$descriptor_s *arg);
int	getmulqualvalue(struct dsc$descriptor_s *arg, int *more);
char	*getqualstring(struct dsc$descriptor_s *arg);
void	connect_one(int exist);
void	disconnect_one(char *dev, int abortflag, int truncate, int single, int keep);
void	open_file(char *name, int sharing, int *maxblk, int mode);
char	*nodename();
char	*build_lock(char *dev);
int	convert_error(int oldstatus, int *newstatus);
void	setup_fab();
char	*fulldevspec(char *name);
void	signal_error(int st1, int st2, int reason);
void	getdevnam(unsigned short chan, char *s_device);
int	get_unit(char *str, int exist);
void	set_exclusive();
void	clear_exclusive();
void	cvt_timestamps();
void	enable_privs(int64 which);
void	disable_privs();
void	check_requirements();
void	create_filename(char *device, FIDDEF *fid, char *outbuf);
void	setfilechar(int how);
void	set_seed(int num, char *device);

extern	int exe$kprintf();

#ifdef SYSINIT_OPCCRASH

int	sysinit_opccrash_handler(struct chf$signal_array *sigarr, struct chf$mech_array *mecharr);
int	sysinit_opccrash_action(struct dsc$descriptor_s *message, int actprm);
void	init_rms_structures ();
void	connect_one_jacket ();
void	disconnect_one_jacket (char *dev);

#else // SYSINIT_OPCCRASH

void	setfilemetadata(LD_METADATA *mdat);
int	getfilemetadata(LD_METADATA *mdat);
int	getclonedata(int *tracks, int *sectors, int *cylinders, int *maxblock);
void	close_file(char *filename);
void	flush_xfc(char *name, int sharing);
void	show();
int	show_one(char *which, int single);
void	addarg(char **strbuf, char *inpstr, int width, unsigned int *arglist, int *argidx);
void	connect_unit();
void	load_unit();
void	unload_unit();
void	switch_unit();
int	get_term_width();
void	setlogical(char *device);
void	findshareddevice(char *filename, int *ctrlr, int *unit, int *alloclass);
void	trace();
void	notrace();
void	protect();
void	noprotect();
void	protect_common(int how);
void	watch();
void	show_watch();
void	display_watch(WATCHPT *wpt, int wptcnt, int *blkpnt, int blkcnt, SUSPEND_LIST *slist, int slistcnt);
void	nowatch();
int	*getlist(struct dsc$descriptor_s *sw, int *cnt);
void	stop_trace();
void	stop_one(char *which, int single);
void	process_trace(char *buf, int size, LD_OVRRUN *ovrbuf, int overrun, char *nname, char *when, int inited);
void	show_trace_data(TRACE_ENT *p, int numpack, int from, FILE *outfile, char *node,
                     char *device, char *when, int inited, LD_OVRRUN *ovrbuf, int overrun);
void	show_trace();
char	*ssdef(int code);
void	process_input();
char	*decode_func(int what);
void	chk_mod(int *modifier, int mask, char *modifstr, char *outstr);
char	*cvttime(uint64 *time, int how, int full);
void	disconnect_unit();
void	analyze();
int	analyze_handler(struct chf$signal_array *sigarr, struct chf$mech_array *mecharr);
void	show_tape_metadata(LDTPMD *md);
void	init_tape_metadata(LDTPMD *md, int size);
void	init_tape_eod(void *rec);
int	calc_checksum(void * buffer, int size);
void	dumpbuf(char *vp, int len);
void	dumpdir(char *vp, int len, LDTPMD *md, int records, int directory_hex);
void	create();
void	erasefile(int start, int end);
char	*fullfilespec(char *name, char *defname);
void	set_outband();
void	purge_file(int limit, char *name);
void	ld_exit(int param);
void	help();
void	version();

//
//  HELP routines
//

$DESCRIPTOR(LBRSHR_DESC, "LBRSHR");
$DESCRIPTOR(LBR$OUTPUT_HELP_DESC, "LBR$OUTPUT_HELP");
int (*output_help_addr)();
int lbr$output_help();

#endif // SYSINIT_OPCCRASH

//
// General defines
//

#define MAX_OPTS		100				// Maximum number of option arguments for SHOW
#define HIGHWATER_WARNING	100000				// Warning threshold for highwater marking
#define OVERFLOW_AREA_SIZE	(65536 + sizeof(LDTPHD) + sizeof(LDTPTR))
#define DATA_BUFFER_SIZE	(512*1024)
#define RECBUF_SIZE		(OVERFLOW_AREA_SIZE + DATA_BUFFER_SIZE)

//
// Logical nametable strings
//

#define SYSTEM_STR	"SYSTEM"
#define SYSTEM_TBL	"LNM$SYSTEM_TABLE"

#define GROUP_STR	"GROUP"
#define GROUP_TBL	"LNM$GROUP"

#define JOB_STR		"JOB"
#define JOB_TBL		"LNM$JOB"

#define PROCESS_STR	"PROCESS"
#define PROCESS_TBL	"LNM$PROCESS_TABLE"

#define EXECUTIVE_STR	"EXECUTIVE"
#define SUPERVISOR_STR	"SUPERVISOR"
#define USER_STR	"USER"

#ifndef SYSINIT_OPCCRASH

//
// Internal routines dispatch table
//

typedef struct _ld_cmndtbl {
            char *ldcmd$l_what;
            void (*ldcmd$a_where)();
            int ldcmd$l_needprivs;
           } LD_CMNDTBL;

//
// Dispatch table to internal commands
// The parameter indicates if extra privileges are needed
//

LD_CMNDTBL cmnds[] = {
         "CREA", &create,          0,
         "CONN", &connect_unit,    1,
         "DISC", &disconnect_unit, 1,
         "SHOW", &show,            1,
         "TRAC", &trace,           1,
         "NOTR", &notrace,         1,
         "WATC", &watch,           1,
         "NOWA", &nowatch,         1,
         "PROT", &protect,         1,
         "NOPR", &noprotect,       1,
         "SWIT", &switch_unit,     1,
         "LOAD", &load_unit,       1,
         "UNLO", &unload_unit,     1,
         "ANAL", &analyze,         0,
         "HELP", &help,            0,
         "VERS", &version,         1,
         0,      0,                0
    };

#endif // SYSINIT_OPCCRASH

#define LD_PREFIX		"LD"
#define LM_PREFIX		"LM"
#define LD_WILDNAME		"*$LD*"
#define LM_WILDNAME		"*$LM*"
#define LD_WILDNAME_NONODE	"_LD*"
#define LM_WILDNAME_NONODE	"_LM*"
#define LD_UNIT0		"LDA0:"
#define LM_UNIT0		"LMA0:"
#define LD_TRACE_ASCII_NAME	"LD_TRACE.LOG"
#define LM_TRACE_ASCII_NAME	"LM_TRACE.LOG"
#define LD_TRACE_BINARY_NAME	"LD_TRACE.DAT"
#define LM_TRACE_BINARY_NAME	"LM_TRACE.DAT"
#define LD_ANALYZE_NAME		"LD_ANALYZE.LOG"
#define LM_ANALYZE_NAME		"LM_ANALYZE.LOG"
#define LD_UNIT_SYMBOL		"LD_UNIT"
#define LM_UNIT_SYMBOL		"LM_UNIT"
#define LD_CONTAINER_SYMBOL	"LD_CONTAINER"
#define LM_CONTAINER_SYMBOL	"LM_CONTAINER"

char	lx_prefix[sizeof(LD_PREFIX)+1];
char	lx_wildname[sizeof(LD_WILDNAME)+1];
char	lx_wildname_nonode[sizeof(LD_WILDNAME_NONODE)+1];
char	lx_unit0[sizeof(LD_UNIT0)+1];
char	lx_trace_ascii_name[sizeof(LD_TRACE_ASCII_NAME)+1];
char	lx_trace_binary_name[sizeof(LD_TRACE_BINARY_NAME)+1];
char	lx_analyze_name[sizeof(LD_ANALYZE_NAME)+1];
char	lx_unit_symbol[sizeof(LD_UNIT_SYMBOL)+1];
char	lx_container_symbol[sizeof(LD_CONTAINER_SYMBOL)+1];

#ifdef SYSINIT_OPCCRASH

char	sysdevice_string[14] = "SYS$SYSDEVICE";
$DESCRIPTOR(sysdevice,sysdevice_string);
char	sysinit_device [256] = "";
char	fulldevspec_string [256] = "";

#endif // SYSINIT_OPCCRASH

int	sharing = 0;
int	alloclass = 0;
int	tape;
char	cmdbuf[1024];
$DESCRIPTOR(commandline, cmdbuf);

#define LDTPHD_TAG		"LmHd"
#define LDTPHD_TAG		"LmHd"
#define LDTPHD_TAG_HEX		0x64486D4C
#define LDTPTR_TAG		"LmTr"
#define LDTPTR_TAG_HEX		0x72546D4C
#define LDTPMD_TAG		"LmMt"
#define LDTPMD_TAG_HEX		0x744D6D4C
#define LDTPDIR_TAG		"LmDr"
#define LDTPDIR_TAG_HEX		0x72446D4C

static const char *hex = "0123456789ABCDEF";

static const char printable[257] = {
	"................"	/* 0x */
	"................"	/* 1x */
	" !\"#$%&'()*+,-./"	/* 2x */
	"0123456789:;<=>?"	/* 3x */
	"@ABCDEFGHIJKLMNO"	/* 4x */
	"PQRSTUVWXYZ[\\]^_"	/* 5x */
	"`abcdefghijklmno"	/* 6x */
	"pqrstuvwxyz{|}~."	/* 7x */
	"................"	/* 8x */
	"................"	/* 9x */
	"................"	/* ax */
	"................"	/* bx */
	"................"	/* cx */
	"................"	/* dx */
	"................"	/* ex */
	"................"	/* fx */
};

// File characteristics to set

#define FC_NOMOVE		0x01
#define FC_NOBACKUP		0x02
#define FC_NOCACHING		0x04


#ifndef SYSINIT_OPCCRASH

//
// Main processing
//

main(int argc, char *argv[])
{
    int stat;
    int length;
    short rlen;
    char *p;
    LD_CMNDTBL *q;

    ld_fab = cc$rms_fab;
    ld_rab = cc$rms_rab;
    ld_rab64 = cc$rms_rab64;
    ld_nam = cc$rms_nam;
    ld_xabfhc = cc$rms_xabfhc;
    ld_xaball = cc$rms_xaball;
    ld_xabpro = cc$rms_xabpro;

    tape = -1;

    /* X-15 */
    #if __x86_64
    {
        if ((argv[0] == NULL) || (argv[0][0] == '\0'))
	{
            tape = 0;
	}
    }
    #endif

    /* Step past any directory specification */
    if ((p = strrchr(argv[0],']')) || (p = strrchr(argv[0],'>'))) {
        p++;
        if (tolower(*p++) == 'l') {
            if (tolower(*p) == 'd')
                tape = 0; 					// Disk function
            else if (tolower(*p) == 'm')
                tape = 1;					// Tape function
        }
    }
    if (tape < 0)						// Not named as LD or LM utility, quit
        exit(SS$_ABORT);
    if (!tape) {
	//
	// Init parameters like a disk
	//
	strcpy(lx_prefix, LD_PREFIX);
	strcpy(lx_wildname, LD_WILDNAME);
	strcpy(lx_wildname_nonode, LD_WILDNAME_NONODE);
	strcpy(lx_unit0, LD_UNIT0);
	strcpy(lx_trace_ascii_name, LD_TRACE_ASCII_NAME);
	strcpy(lx_trace_binary_name, LD_TRACE_BINARY_NAME);
	strcpy(lx_analyze_name, LD_ANALYZE_NAME);
	strcpy(lx_unit_symbol, LD_UNIT_SYMBOL);
	strcpy(lx_container_symbol, LD_CONTAINER_SYMBOL);
    } else {
	//
	// Init parameters like a tape
	//
	strcpy(lx_prefix, LM_PREFIX);
	strcpy(lx_wildname, LM_WILDNAME);
	strcpy(lx_wildname_nonode, LM_WILDNAME_NONODE);
	strcpy(lx_unit0, LM_UNIT0);
	strcpy(lx_trace_ascii_name, LM_TRACE_ASCII_NAME);
	strcpy(lx_trace_binary_name, LM_TRACE_BINARY_NAME);
	strcpy(lx_analyze_name, LM_ANALYZE_NAME);
	strcpy(lx_unit_symbol, LM_UNIT_SYMBOL);
	strcpy(lx_container_symbol, LM_CONTAINER_SYMBOL);
    }
    //
    // Get the rest of the commandline
    //
    stat = lib$get_foreign(&commandline, 0, &rlen, 0);
    signal_error(stat, 0, 0);
    commandline.dsc$w_length = rlen;
    p = getqualstring(&command);
    length = strlen(p) >= 4 ? 4 : strlen(p);
    q = cmnds;
    while (q->ldcmd$l_what) {
	if (strncmp(p, (char *) q->ldcmd$l_what, length) == 0) {
	    if (q->ldcmd$l_needprivs)
		check_requirements();				// Check for loaded driver and installed image
	    disable_privs();					// Initially no privileges needed
	    (*(q->ldcmd$a_where))();				// Call command
	    exit(1);
	}
	q++;
    }
    signal_error(CLI$_NOCOMD, 0, 0);				// Command not found
}

#else // SYSINIT_OPCCRASH

//
// Main entry point when called from SYSINIT
//
// If the connect fails because the unit number is already in use, we have to bump the
// unit number. It can't be just one or two higher because that interferes with the seeding
// of the next free number so we're using 13 as the increment. Why? because it's a prime
// number, it's an obtuse choice, and I'm not superstitious.
//

int sysinit_ld(int original_unit, SYSMD* connect_args, char** device_name)
{
    int attempts = 5;

    //
    // Init parameters like a disk
    //
    strcpy(lx_prefix, LD_PREFIX);
    strcpy(lx_wildname, LD_WILDNAME);
    strcpy(lx_wildname_nonode, LD_WILDNAME_NONODE);
    strcpy(lx_unit0, LD_UNIT0);
    strcpy(lx_trace_ascii_name, LD_TRACE_ASCII_NAME);
    strcpy(lx_trace_binary_name, LD_TRACE_BINARY_NAME);
    strcpy(lx_analyze_name, LD_ANALYZE_NAME);
    strcpy(lx_unit_symbol, LD_UNIT_SYMBOL);
    strcpy(lx_container_symbol, LD_CONTAINER_SYMBOL);

    init_rms_structures ();
    outfile = stdout;

    tape = 0;
    alloclass = connect_args->sysmd$w_alloclass;
    if (clu$gl_club != NULL)
	sharing = 1;
    desired_unit = original_unit;
    sysinit_status = (unsigned int)&ld_fileinuse;
    while (((sysinit_status == (unsigned int)&ld_fileinuse)
			|| (sysinit_status == (unsigned int)&ld_deviceinuse)
			|| (sysinit_status == (unsigned int)&ld_dupunit))
				&& (attempts > 0))
    {
	sysinit_status = SS$_NORMAL;
	strncpy(cmdbuf, &connect_args->sysmd$t_info [0], sizeof(cmdbuf));
	connect_one_jacket ();
	desired_unit += 13;
	if (desired_unit > 9999)
	    desired_unit -= 9000;
	attempts--;
    }
    connect_args->sysmd$w_used_unitnum = actual_unit;
    *device_name = sysinit_device;
    return sysinit_status;
}

void connect_one_jacket()
{
    lib$establish(&sysinit_opccrash_handler);			// Establish handler (any errors will come from here)
    connect_one(0);
    return;
}


//
// Main entry point when called from OPCCRASH
//

int opccrash_ld(char* device_name)
{
    lib$establish(&sysinit_opccrash_handler);			// Establish handler (any errors will come from here)
    //
    // Init parameters like a disk
    //
    strcpy(lx_prefix, LD_PREFIX);
    strcpy(lx_wildname, LD_WILDNAME);
    strcpy(lx_wildname_nonode, LD_WILDNAME_NONODE);
    strcpy(lx_unit0, LD_UNIT0);
    strcpy(lx_trace_ascii_name, LD_TRACE_ASCII_NAME);
    strcpy(lx_trace_binary_name, LD_TRACE_BINARY_NAME);
    strcpy(lx_analyze_name, LD_ANALYZE_NAME);
    strcpy(lx_unit_symbol, LD_UNIT_SYMBOL);
    strcpy(lx_container_symbol, LD_CONTAINER_SYMBOL);

    init_rms_structures ();
    outfile = stdout;

    tape = 0;

    disconnect_one_jacket(device_name);
    return SS$_NORMAL;
}

void disconnect_one_jacket(char *dev)
{
    lib$establish(&sysinit_opccrash_handler);			// Establish handler (any errors will come from here)
    disconnect_one(dev, 0, 0, 1, 0);
    return;
}

//
//  Condition handler for SYSINIT/OPCCRASH-specific code
//

int sysinit_opccrash_handler(struct chf$signal_array *sigarr,
		     struct chf$mech_array *mecharr)
{
    if (sigarr->chf$l_sig_name == SS$_UNWIND)
	return SS$_RESIGNAL;
    if (sigarr->chf$l_sig_name & 1)
	return SS$_CONTINUE;
    sysinit_status = sigarr->chf$l_sig_name;
    sigarr->chf$l_sig_args -= 2;	// remove PC,PSL
    sys$putmsg(sigarr,(void (*)())sysinit_opccrash_action,0,0);
    sys$unwind(NULL,NULL);
    return SS$_RESIGNAL;
}

//
//  Action routine for SYSINIT/OPCCRASH condition handler
//

int sysinit_opccrash_action(struct dsc$descriptor_s *message, int actprm)
{
    exe$kprintf("\n%*.*s\r", message->dsc$w_length, message->dsc$w_length, message->dsc$a_pointer);
    return 0;
}

//
//  Initialize RMS structures "manually" for the SYSINIT/OPCCRASH case.
//

void init_rms_structures ()
{
    memset (&ld_fab, 0, sizeof (ld_fab));
    ld_fab.fab$b_bid = FAB$C_BID;
    ld_fab.fab$b_bln = sizeof (FABDEF);
    memset (&ld_rab, 0, sizeof (ld_rab));
    ld_rab.rab$b_bid = RAB$C_BID;
    ld_rab.rab$b_bln = sizeof (RABDEF);
    memset (&ld_rab64, 0, sizeof (ld_rab64));
    ld_rab64.rab64$b_bid = RAB64$C_BID;
    ld_rab64.rab64$b_bln = sizeof (RAB64DEF);
    memset (&ld_nam, 0, sizeof (ld_nam));
    ld_nam.nam$b_bid = NAM$C_BID;
    ld_nam.nam$b_bln = sizeof (NAMDEF);
    memset (&ld_xabfhc, 0, sizeof (ld_xabfhc));
    ld_xabfhc.xab$b_cod = XAB$C_FHC;
    ld_xabfhc.xab$b_bln = sizeof (XABFHCDEF);
    memset (&ld_xaball, 0, sizeof (ld_xaball));
    ld_xaball.xab$b_cod = XAB$C_ALL;
    ld_xaball.xab$b_bln = sizeof (XABALLDEF);
    memset (&ld_xabpro, 0, sizeof (ld_xabpro));
    ld_xabpro.xab$b_cod = XAB$C_PRO;
    ld_xabpro.xab$b_bln = sizeof (XABPRODEF);

    return;
}

#endif // SYSINIT_OPCCRASH

//
// Get a single qualifier
//
// Return value:	1 - qualifier present
//			0 - absent
//		       -1 - negated
//

int getqual(struct dsc$descriptor_s *arg)
{

#ifndef SYSINIT_OPCCRASH

    int stat;

    stat = cli$present(arg);					// Get qualifier presence
    if (stat == CLI$_PRESENT ||
	stat == CLI$_LOCPRES ||
	stat == CLI$_DEFAULTED)
	return (1);						// It's there
    else if (stat == CLI$_NEGATED || stat == CLI$_LOCNEG)
	return (-1);						// Negated
    else if (stat == CLI$_ABSENT)
	return (0);						// Not there
    signal_error(stat, 0, 0);

#else // SYSINIT_OPCCRASH

    return 0;

#endif // SYSINIT_OPCCRASH

}

//
// Get a qualifier integer value
//
// Return value:	0 or the qualifier's value
//

int getqualvalue(struct dsc$descriptor_s *arg)
{

#ifndef SYSINIT_OPCCRASH

    char value[256];
    $DESCRIPTOR(out, value);
    int val;
    short rlen;

    *value = 0;
    if ((cli$present(arg) & 1) &&				// If present...
	(cli$get_value(arg, &out, &rlen) & 1)) {		// Get it's value
	*(value + (rlen & 0377)) = 0;
	return ((sscanf(value, "%d", &val)) ? val : 0);
    } else
	return (0);						// Default

#else // SYSINIT_OPCCRASH

    return 0;

#endif // SYSINIT_OPCCRASH

}

//
// Get multiple qualifier integer values
//
// Return value:	0 or the qualifier's value
//			the second argument indicates if there's more to fetch
//

int getmulqualvalue(struct dsc$descriptor_s *arg, int *more)
{

#ifndef SYSINIT_OPCCRASH

    int stat;
    char value[256];
    $DESCRIPTOR(out, value);
    int val;
    short rlen;

    *value = 0;
    if (*more < 0)
	if (!(cli$present(arg) & 1))				// If not present...
	    return (0);
    stat = cli$get_value(arg, &out, &rlen);			// Get it's value
    *more = 0;
    if (!(stat & 1))
	return (0);
    if (stat == CLI$_COMMA)
	*more = 1;						// Got comma, more to fetch
    *(value + (rlen & 0377)) = 0;
    return ((sscanf(value, "%d", &val)) ? val : 0);

#else // SYSINIT_OPCCRASH

    return 0;

#endif // SYSINIT_OPCCRASH

}

//
// Get a qualifier string value
//
// Return value:	0 or the qualifier's string
//

char *getqualstring(struct dsc$descriptor_s *arg)
{

#ifndef SYSINIT_OPCCRASH

    char *string, *p;
    LD_DSC out;
    short rlen;

    p = string = malloc(256);					// Get some memory
    if (!p)
	signal_error(SS$_INSFMEM, 0, 0);
    out.dsc$a_dpointer = string;				// Setup pointer
    out.dsc$l_length = 256;					// and size
    if ((cli$present(arg) & 1) &&				// If present...
	(cli$get_value(arg, &out, &rlen) & 1)) {		// Get it's value
	p += rlen;						// Point to end of string
	*p = '\0';						// Place terminator
	return (string);
    } else
	return (0);						// Default

#else // SYSINIT_OPCCRASH

    return 0;

#endif // SYSINIT_OPCCRASH

}


#ifndef SYSINIT_OPCCRASH

//
//  Show connection between LD device and corresponding file
//

void show()
{
    int stat;
    int loop = 0;
    int nonode = 0;
    char matchname[256];
    $DESCRIPTOR(matchdev, matchname);
    LD_DSC wildname;
    unsigned short rlen;
    int devclass;
    LD_ITEMLIST item[] = {sizeof(devclass), DVS$_DEVCLASS, (char *) &devclass, 0, 0, 0, 0, 0};
    GENERIC_64 context = { 0 };

    wildname.dsc$a_dpointer = lx_wildname;
    wildname.dsc$l_length = strlen(lx_wildname);
    if (tape)
	devclass = DC$_TAPE;
    else
	devclass = DC$_DISK;

    enable_privs(PRV$M_PHY_IO | PRV$M_SYSLCK | PRV$M_SHARE);
    if (getqual(&sw_trace) > 0)
	show_trace();						// Special processing for trace
    else if (getqual(&sw_watch) > 0)
	show_watch();						// Special processing for watch
    else {
	s_device = getqualstring(&sw_device);			// Get devicename

	if (getqual(&sw_all) > 0) {				// /ALL ?
	    stat = 1;
	    while (stat & 1) {					// Loop until we're done
		stat = sys$device_scan(&matchdev, &rlen, &wildname, &item, &context);
		if (stat == SS$_NOMOREDEV) {
		    if (nonode) {
			if (loop == 0)
			    lib$signal((unsigned int) &ld_nounitsfound, 1, matchname);
			else
			    return;					// No more, quit
		    } else {
			nonode = 1;
			stat = 1;
			wildname.dsc$a_dpointer = lx_wildname_nonode;
			wildname.dsc$l_length = strlen(lx_wildname_nonode);
			continue;
		    }
		}
		signal_error(stat, 0, 0);
		matchname[rlen] = '\0';				// Place terminator
		if (nonode && strchr(matchname,'$'))
		    continue;
		if (get_unit(matchname,1) != 0) {
		    loop++;
		    stat = show_one(matchname, 0);		// Show this device
		    if (stat == SS$_DEVINACT) {			// If not connected...
		        lib$signal((unsigned int) &ld_notconnected, 1, matchname);	// Flag it
		        stat = 1;				// and continue
		    }
		}
	    }
	} else {						// Only one specified device
	    stat = show_one(fulldevspec(s_device), 1);		// Show it
	    if (stat == SS$_DEVINACT) {				// If not connected...
		lib$signal((unsigned int) &ld_notconnected, 1, fulldevspec(s_device));	// Flag it
		stat = (unsigned int) &ld_notconnected;		// Convert to better message
		stat |= STS$M_INHIB_MSG;			// Don't show it again
	    }
	}
    }
}

//
//  Show one specific device
//

int show_one(char *which, int single)
{
    int stat;
    int start, end;
    int width;
    int mdvalid;
    unsigned int extsize, extlimit;
    unsigned short chan;
    IOSB iosb;
    char ldfile[512];
    char mdata[512];
    char lddev[64];
    char tmpstr[128];
    char *p;
    FIDDEF fid;
    LD_FLAGS ioflgs;
    LD_DSC sfilename, sdev;
    unsigned int arglist[MAX_OPTS];
    int argidx = 0;
    LD_DSC symbol;
    LDTPMD *md;

    mdvalid = 0;
    sfilename.dsc$a_dpointer = which;
    sfilename.dsc$l_length = strlen(which);
    if (get_unit(which, 1) == 0) {				// Don't use unit 0
	if (single)
	    lib$signal((unsigned int) &ld_badunit, 1, which);	// Show it to the world
	else
	    return (1);
    }
    stat = sys$assign(&sfilename, &chan, 0, 0, 0);		// Assign chan to LD device
    if (stat == SS$_DEVALLOC) {					// Allocated on remote node ?
	lib$signal((unsigned int) &ld_remotealloc, 1, which);
    } else {
	signal_error(stat, 0, 0);

	LD_ITEMLIST item[] =
	    {sizeof(lddev),    LDITM$K_DEVICENAME,  (void *) &lddev,    0,
	     sizeof(fid),      LDITM$K_FILEID,      (void *) &fid,      0,
	     sizeof(start),    LDITM$K_STARTLBN,    (void *) &start,    0,
	     sizeof(end),      LDITM$K_ENDLBN,      (void *) &end,      0,
	     sizeof(extsize),  LDITM$K_EXTENDSIZE,  (void *) &extsize,  0,
	     sizeof(extlimit), LDITM$K_EXTENDLIMIT, (void *) &extlimit, 0,
	     sizeof(ioflgs),   LDITM$K_FLAGS,       (void *) &ioflgs,   0,
	     0, 0, 0, 0};

	stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,	// Inquire state
			&item, 0, 0, 0, 0, LDIO$K_GET_CONNECTION | LDIO$M_ITEMLIST);
	if (iosb.iosb$w_status != SS$_DEVINACT)			// Filter DEVINACT
	    signal_error(stat, iosb.iosb$w_status, 0);
	if (ioflgs.ldflg$v_connected) {				// Check 'connected' flag from driver
	    lddev[item[0].lditmlst$l_rlength] = '\0';		// Terminate device spec
	    if ((ioflgs.ldflg$v_replaced) || (ioflgs.ldflg$v_lbn))
		strcpy(ldfile,lddev);				// Use devicename for lbn or replace
	    else
		create_filename(lddev,&fid,ldfile);		// Use filename for container file
	    arglist[++argidx] = (unsigned int) &ld_connected;	// Format normal connection message
	} else {
	    arglist[++argidx] = (unsigned int) &ld_notconnected;// Format normal connection message
	}
	arglist[++argidx] = 2;
	arglist[++argidx] = (unsigned int) which;
	arglist[++argidx] = (unsigned int) ldfile;
	if (getqual(&sw_full) > 0) {				// /FULL ?
	    //
	    // Check if the output device is a terminal, and get the width
	    //
	    if ((width = get_term_width()) == 0)
		width == 80;					// Not a terminal, default to 80
	    p = 0;
	    //
	    // Break down all flags and create separate messages for them,
	    // while taking care of the line width
	    //
	    if (ioflgs.ldflg$v_replaced)
		addarg(&p, "Replaced", width, arglist, &argidx);
	    if (ioflgs.ldflg$v_lbn) {
		sprintf(tmpstr,"LBN Mapping: Start=%d End=%d)", start, end);
		addarg(&p, tmpstr, width, arglist, &argidx);
	    }
	    if (ioflgs.ldflg$v_share)
		addarg(&p, "Shared", width, arglist, &argidx);
	    if (ioflgs.ldflg$v_trace)
		addarg(&p, "Trace active", width, arglist, &argidx);
	    if (ioflgs.ldflg$v_accurate)
		addarg(&p, "Accurate tracing", width, arglist, &argidx);
	    if (ioflgs.ldflg$v_fdttrace)
		addarg(&p, "FDT tracing", width, arglist, &argidx);
	    if (ioflgs.ldflg$v_trace_all && tape)
		addarg(&p, "All tape I/O traced", width, arglist, &argidx);
	    if (ioflgs.ldflg$v_decram)
		addarg(&p, "On ramdisk", width, arglist, &argidx);
	    if (ioflgs.ldflg$v_onvolset)
		addarg(&p, "On volumeset", width, arglist, &argidx);
	    if (ioflgs.ldflg$v_nodse)
		addarg(&p, "No DSE support", width, arglist, &argidx);
	    if (ioflgs.ldflg$v_virtual)
		addarg(&p, "On virtual device", width, arglist, &argidx);
	    if (!ioflgs.ldflg$v_fe_capable)
		addarg(&p, "Not Forced Error capable", width, arglist, &argidx);
	    if (ioflgs.ldflg$v_fe_disabled)
		addarg(&p, "Forced Error disabled", width, arglist, &argidx);
	    if (ioflgs.ldflg$v_conlock)
		addarg(&p, "Container file locked", width, arglist, &argidx);
	    if (ioflgs.ldflg$v_tape)
		addarg(&p, "Tape unit", width, arglist, &argidx);
	    if (ioflgs.ldflg$v_loaded && tape)
		addarg(&p, "Tape loaded", width, arglist, &argidx);
	    else if (tape)
		addarg(&p, "Tape unloaded", width, arglist, &argidx);
	    if (ioflgs.ldflg$v_extend) {
		if (extlimit == 0)
		    sprintf(tmpstr,"Extend file on demand (size=%u, No limits)", extsize);
		else
		    sprintf(tmpstr,"Extend file on demand (size=%u, limit=%u)", extsize, extlimit);
		addarg(&p, tmpstr, width, arglist, &argidx);
	    }
	    if (ioflgs.ldflg$v_override)
		addarg(&p, "Override", width, arglist, &argidx);
	    if (ioflgs.ldflg$v_protect)
		addarg(&p, "Write protect", width, arglist, &argidx);
	    if (ioflgs.ldflg$v_lckv0)
		addarg(&p, "Old driver connected on other node", width, arglist, &argidx);
	    //
	    // Check if there's metadata available and display it if true
	    //
	    stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,// Get metadata
			    mdata, sizeof(mdata), 0, 0, 0, LDIO$K_GET_METADATA);
	    if ((stat & 1) && (iosb.iosb$w_status & 1)) {
		md = (LDTPMD *) mdata;				// Point to start of data
		if ((strncmp((char *) &md->ldtpmd$l_tag, LDTPMD_TAG, strlen(LDTPMD_TAG)) == 0) && // Valid tag
		    (calc_checksum((void *) md, sizeof(mdata)))) { // and checksum?
		    mdvalid = 1;
		} else {
		    // Invalid metadata.....
		}
	    } else {
	    	if (iosb.iosb$w_status != SS$_NODATA)
		    signal_error(stat, iosb.iosb$w_status, 0);
	    }
	}
	if (getqual(&sw_symbol)) {				// /SYMBOL?
	    sprintf(tmpstr,"%d",get_unit(which, 1)); 		// Get unit number
	    sdev.dsc$a_dpointer = tmpstr;
	    sdev.dsc$l_length = strlen(tmpstr);
	    symbol.dsc$a_dpointer = lx_unit_symbol;
	    symbol.dsc$l_length = strlen(lx_unit_symbol);
	    stat = lib$set_symbol(&symbol, &sdev, 0);		// Create local symbol
	    signal_error(stat, 0, 0);
	    sdev.dsc$a_dpointer = ldfile;
	    sdev.dsc$l_length = strlen(ldfile);
	    symbol.dsc$a_dpointer = lx_container_symbol;
	    symbol.dsc$l_length = strlen(lx_container_symbol);
	    stat = lib$set_symbol(&symbol, &sdev, 0);		// Create local symbol
	    signal_error(stat, 0, 0);
	}
	stat = sys$dassgn(chan);				// Deassign channel
	signal_error(stat, 0, 0);
    }
    arglist[0] = argidx;					// Finalize number of arguments
    extern int lib$signal();					// Redefine to avoid compiler complaints
    lib$callg(arglist, &lib$signal);				// Signal message with all arguments
    if (mdvalid)						// Valid metadata?
	show_tape_metadata(md);
    return (1);
}

//
// Add argument to message array
//

void addarg(char **strbuf, char *inpstr, int width, unsigned int *arglist, int *argidx)
{
    char *p = *strbuf;

    //
    // Take care of the length of the prefix "-LD-I-OPTIONS, " (15 chars)
    //
    if (!p || ((strlen(p) + strlen(inpstr) + 15 + 1) >= width)) {
	//
	// Output buffer is empty or too small, create another argument
	//
	// If there's a buffer already then append a comma
	//
	if (p)
	    strcat(p, ",");
	p = malloc(width+1);
	if (!p)
	    signal_error(SS$_INSFMEM, 0, 0);
	*p = '\0';
	//
	// Sanity check for array overflow
	//
	if (*argidx >= ((MAX_OPTS / sizeof(unsigned int)) - 3))
	    lib$signal((unsigned int) &ld_detectederr, 0,
		       (unsigned int) &ld_options ,1, "Too many options");
	arglist[++(*argidx)] = (int) &ld_options;
	arglist[++(*argidx)] = 1;
	arglist[++(*argidx)] = (int) p;
    } else {
	//
	// There's room for more on this line, append comma
	//
	strcat(p, ", ");
    }
    strcat(p, inpstr);
    *strbuf = p;
}

//
//  Get terminal width
//

int get_term_width()
{
    int stat;
    int type;
    int width;
    IOSB iosb;
    $DESCRIPTOR(outdev, "SYS$COMMAND");
    LD_ITEMLIST dvi_item[] =
      {4, DVI$_TRM, (char *) &type, 0,
       4, DVI$_DEVBUFSIZ, (char *) &width, 0,
       0, 0, 0, 0};

    //
    // Check if the output device is a terminal, and get the width
    //
    stat = sys$getdviw(0, 0, &outdev, &dvi_item, &iosb, 0, 0, 0);
    signal_error(stat, iosb.iosb$w_status, 0);
    if (!type)
	return 0;						// Not a terminal, return 0
    return width;
}

//
//  Connect LD device and file together
//

void connect_unit()
{
    enable_privs(PRV$M_PHY_IO | PRV$M_SYSLCK);

    connect_one(0);						// Connect to non-existant unit
}

//
//  Load LD device with specified file
//

void load_unit()
{
    LD_DSC sdev;
    IOSB iosb;
    unsigned short chan;
    int stat;
    int version;
    int linktime[2];

    if (!tape)
	lib$signal((unsigned int) &ld_incmpdevtype, 0);

    enable_privs(PRV$M_PHY_IO | PRV$M_SYSLCK);

    if (!s_file)
	s_file = getqualstring(&sw_file);			// Get filename
    if (!s_device)
	s_device = getqualstring(&sw_device);			// Get devicename
    if (!s_device) {
	//
	// No devicename specified. Check if it's an LM device without
	// a filespec. In that case it's a 'load only' request with an
	// already connected file, like LM LOAD LMA1:
	//
	sdev.dsc$a_dpointer = s_file;
	sdev.dsc$l_length = strlen(s_file);
	stat = sys$assign(&sdev, &chan, 0, 0, 0);		// Assign channel
	signal_error(stat, 0, 0);
	//
	// Check if we're talking to an LD device
	//
	stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,	// Get driver's info
			&version, (int64) &linktime, 0, 0, 0, LDIO$K_GET_VERSION);
	if (stat == SS$_ILLIOFUNC)
	    stat = (unsigned int) &ld_incmpdevtype;
	signal_error(stat, iosb.iosb$w_status, 0);
	stat = sys$dassgn(chan);				// Deassign channel
	signal_error(stat, 0, 0);
	s_device = s_file;
	s_file = 0;
	connect_one(2);						// Connect to existing unit, use the same file
    } else {
	//
	// Open the new file before we disconnect the old one to check if
	// it's valid. If not we stop in time to prevent a disconnect
	//
	open_file(s_file, 0, 0, 1);				// Attempt open for read
	close_file(s_file);
	connect_one(1);						// Connect to existing unit
    }
}

//
//  Unload LD device
//

void unload_unit()
{
    int q_truncate;
    LD_DSC sdev;

    if (!tape)
	lib$signal((unsigned int) &ld_incmpdevtype, 0);

    enable_privs(PRV$M_PHY_IO | PRV$M_SYSLCK);			// Enable privs we need

    if (!s_device)
	s_device = getqualstring(&sw_device);			// Get LM device name
    if (!s_device)
	lib$signal((unsigned int) &ld_needdevice);
    sdev.dsc$a_dpointer = s_device;
    sdev.dsc$l_length = strlen(s_device);
    q_truncate = getqual(&sw_truncate) > 0;			// Get 'truncate' qualifier
    disconnect_one(s_device, 0, q_truncate, 1, 1);		// Disconnect and keep unit
}

//
// Switch to new container file (tape only)
//

void switch_unit()
{
    if (!tape)
	lib$signal((unsigned int) &ld_incmpdevtype, 0);

    s_file = getqualstring(&sw_file);				// Get filename
    s_device = getqualstring(&sw_device);			// Get LM device name
    if (!s_device)
	lib$signal((unsigned int) &ld_needdevice);
    //
    // Open the new file before we disconnect the old one to check if
    // it's valid.
    //
    open_file(s_file, 0, 0, 1);					// Attempt open for read
    close_file(s_file);
    unload_unit();
    load_unit();
}

#endif // SYSINIT_OPCCRASH

//
//  Connect LD device and file together, worker routine
//

void connect_one(int exist)
{
    LD_DSC sdev, lnam, symbol;
    int stat;
    unsigned short chan;
    int func;
    int replacefl = 0;
    int lbnfl = 0;
    int loadfl = 0;
    int shflag = 0;
    int extendfl = 0;
    int limitfl = 0;
    int unit = 0;
    int ctrlr = 0;
    int q_log = 0;
    int geospecified = 0;
    int tracks = 0;
    int sectors = 0;
    int cylinders = 0;   
    int lbn_start = 0;
    int lbn_end = 0;
    int lbn_count = 0;
    int maxblocks = 0;
    int extendval = 0;
    unsigned int limitval = 0;
    int tmp;
    IOSB iosb;
    char tmpstr[10];
    char *tmpptr;
    FIBDEF1 cntrlfib;
    LD_DSC cntrlfibdsc;

#ifdef SYSINIT_OPCCRASH

    int s;
    char *begin_ptr = cmdbuf;
    char *end_ptr;
    char faoform [] = "$!SL$!3AZ!SL:";
    $DESCRIPTOR(faodsc, faoform);
    unsigned short faolen;
    $DESCRIPTOR(outdsc, sysinit_device);

    end_ptr = strchr (begin_ptr, ' ');
    if (end_ptr == NULL)
      return;
    *end_ptr = '\0';
    strncpy (s_device, begin_ptr, sizeof (s_device));
    begin_ptr = end_ptr + 1;

    end_ptr = strchr (begin_ptr, ' ');
    if (end_ptr == NULL)
      return;
    *end_ptr = '\0';
    strncpy (s_did, begin_ptr, sizeof (s_did));
    begin_ptr = end_ptr + 1;

    end_ptr = strchr (begin_ptr, ' ');
    if (end_ptr == NULL)
      return;
    *end_ptr = '\0';
    strncpy (s_fid, begin_ptr, sizeof (s_fid));
    begin_ptr = end_ptr + 1;

    if (!s_device[0] || !s_did[0] || !s_fid[0])
	return;								// Bad thing...

#else // SYSINIT_OPCCRASH

    int cloneavail;
    LD_METADATA mdat;

    if (!s_file)
	s_file = getqualstring(&sw_file);			// Get filename if not already there
    if (!s_device)
	s_device = getqualstring(&sw_device);			// Get LD device name if not already there
    loadfl = getqual(&sw_load);					// /LOAD

    if (loadfl < 0) {						// /NOLOAD.....
	if (!tape)
	    lib$signal((unsigned int) &ld_incmpdevtype, 0);	// Tape only qualifier
	if (s_device)
	    lib$stop(SS$_UNSUPPORTED);				// Bad thing...
	else {
	    //
	    // No devicename specified. This had better be a non-existant LM device
	    // without a filespec. In that case it's a 'connect only' request without
	    // a container file, to create an unloaded tapeunit.
	    //
	    sdev.dsc$a_dpointer = s_file;
	    sdev.dsc$l_length = strlen(s_file);
	    stat = lib$getdvi(&DVI$_UNIT, 0, &sdev, &tmp, 0, 0);
	    if ($VMS_STATUS_SUCCESS(stat))
		lib$signal((unsigned int) &ld_dupunit);		// Duplicate unit
	    s_device = s_file;
	    s_file = 0;
	}
    }
    q_log = getqual(&sw_log);					// /LOG
    sharing = getqual(&sw_share);				// /SHARE
    replacefl = getqual(&sw_replace);				// /REPLACE
    lbnfl = getqual(&sw_lbn);					// /LBN
    extendfl = getqual(&sw_extend);				// /EXTEND
    if (extendfl) {
	extendval = getqualvalue(&sw_extend);			// Extend value
	if (extendval == 0)
	    extendval = 65536;					// Supply a default
    }
    limitfl = getqual(&sw_limit);				// /LIMIT
    if (limitfl)
	limitval = getqualvalue(&sw_limit);			// Limit value
    if (!tape && (extendfl || limitfl))
	lib$signal((unsigned int) &ld_incmpdevtype, 0);		// Tape only qualifiers
    if (tape && (sharing > 0))
	lib$stop(SS$_UNSUPPORTED);				// Not for tape right now
    if (!exist) {
	if ((alloclass = getqualvalue(&sw_alloclass)) > 0) {	// /ALLOCLASS ?
	    if (alloclass > 255)
		lib$signal((unsigned int) &ld_badalloclass);	// Bad allocation class
	}
    }
    if (lbnfl) {						// /LBN specified
	lbn_start = getqualvalue(&sw_lbn_start);
	lbn_end = getqualvalue(&sw_lbn_end);
	lbn_count = getqualvalue(&sw_lbn_count);
    }

#endif // SYSINIT_OPCCRASH

    if (!replacefl && !lbnfl) {
	if ((exist != 2) && (loadfl >= 0)) {			// Just a normal connect or load

#ifdef SYSINIT_OPCCRASH

	    strncpy(s_file,s_did,256);
	    if (s_file[255] != 0)
		return;
	    s = strlen(s_file);
	    s_file[s] = ' ';
	    s++;
	    s_file[s] = '\0';
	    strncat(s_file,s_fid,256-s);
	    if (strnlen(s_file, 256) > 255)
		return;
	    open_file(s_file, sharing, &maxblocks, 2);		// Attempt 'containerfile' open

#else // SYSINIT_OPCCRASH

	    flush_xfc(s_file, sharing);				// Flush eventual XFC contents for this file
	    open_file(s_file, sharing, &maxblocks, 2);		// Attempt 'containerfile' open
 	    cloneavail = getclonedata(&tracks, &sectors, &cylinders, &maxblocks);
 	    geospecified = getfilemetadata(&mdat);
 	    if (!cloneavail) {
		if ((getqual(&sw_autogeometry)) > 0 && geospecified) {
		    tracks = mdat.ldmtd$l_tracks;		// Recover geometry from metadata
		    sectors = mdat.ldmtd$l_sectors;
		    cylinders = mdat.ldmtd$l_cylinders;
		    maxblocks = mdat.ldmtd$l_maxblock;
		}
		if ((tmp = getqualvalue(&sw_tracks)) > 0)
		    tracks = tmp;
		if ((tmp = getqualvalue(&sw_sectors)) > 0)
	 	    sectors = tmp;
		if ((tmp = getqualvalue(&sw_cylinders)) > 0)
		    cylinders = tmp;
		if ((tmp = getqualvalue(&sw_maxblocks)) > 0)
		    maxblocks = tmp;				// Set new value if specified
 		if ((maxblocks == 0) && !geospecified) {
		    //
		    // No maxblocks specified, check if geometry specified. If true set maxblocks
		    // according to that
		    //
		    if ((tracks != 0) || (sectors != 0) || (cylinders != 0))
			maxblocks = ((tracks == 0) ? 1 : tracks) *
				    ((sectors == 0) ? 1 : sectors) *
				    ((cylinders == 0) ? 1 : cylinders);
		}
	    }

#endif // SYSINIT_OPCCRASH

	}
    } else {
	realdev_dsc.dsc$a_dpointer = fulldevspec(s_file);	// Set real devicename
	realdev_dsc.dsc$l_length = strlen(realdev_dsc.dsc$a_dpointer);
    }
    sdev.dsc$a_dpointer = lx_unit0;
    sdev.dsc$l_length = strlen(lx_unit0);

#ifdef SYSINIT_OPCCRASH

    {
	unit = desired_unit;

#else // SYSINIT_OPCCRASH

    if ((sharing > 0) && !s_device) { 				// /SHARE and no device ?
        findshareddevice(s_file, &ctrlr, &unit, &alloclass);
	if (unit != 0) {					// We're not the first one to connect
	    s_device = malloc(256);
	    if (!s_device)
		signal_error(SS$_INSFMEM, 0, 0);
	    sprintf(s_device, "%s%c%d:", lx_prefix, ctrlr, unit);
	}
    }
    if (!s_device) {						// No device specified
	if (exist)						// If we ask for an existent device we
	    lib$signal((unsigned int) &ld_needdevice, 0);	// must specify a name....
	s_device = malloc(256);
	if (!s_device)
	    signal_error(SS$_INSFMEM, 0, 0);
	stat = sys$assign(&sdev, &chan, 0, 0, 0);		// Assign channel
	signal_error(stat, 0, 0);
        if (alloclass > 0) {					// Init LD device
	    stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
		    (void *) alloclass, 0, 0, 0, 0, LDIO$K_SET_ALLOCLASS);
	    signal_error(stat, iosb.iosb$w_status, 0);
        }
	getdevnam(chan, s_device);
	shflag++;
    } else {
	unit = get_unit(s_device, 0);

#endif // SYSINIT_OPCCRASH

	if (exist) {						// Device should be there
	    if ((unit == 0) || (unit > 9999))			// Check range
		lib$signal((unsigned int) &ld_badunit, 1, s_device);
	    sdev.dsc$a_dpointer = s_device;
	    sdev.dsc$l_length = strlen(s_device);
	    stat = sys$assign(&sdev, &chan, 0, 0, 0);		// Assign channel
	    signal_error(stat, 0, 0);
	} else {
	    if (unit < 0) {
		//
		// Special case: We can do LD CONNECT LDB to get auto unit assignment
		// for another controller than the A one.
		//
 		sprintf(tmpstr,"%s%c0:", lx_prefix, (char) s_device[strlen(s_device)-1]);
		sdev.dsc$a_dpointer = tmpstr;
		stat = sys$assign(&sdev, &chan, 0, 0, 0);	// Assign channel
		signal_error(stat, 0, 0);
		shflag++;
	    } 
	    else {
		if ((unit == 0) || (unit > 9999))		// Check range
		    lib$signal((unsigned int) &ld_badunit, 1, s_device);
		strcpy(tmpstr,lx_unit0);
		tmpptr = s_device+2;
		tmpstr[2] = *tmpptr;
		sdev.dsc$a_dpointer = tmpstr;
		set_exclusive();				// Block others from our seed
		set_seed(unit,s_device);
		stat = sys$assign(&sdev, &chan, 0, 0, 0);	// Assign channel
		signal_error(stat, 0, 0);
		clear_exclusive();				// Allow others
	    }

	}
        if (alloclass > 0 && !exist) {				// Init LD device if not already there
	    stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
		    (void *) alloclass, 0, 0, 0, 0, LDIO$K_SET_ALLOCLASS);
	    signal_error(stat, iosb.iosb$w_status, 0);
        }
	getdevnam(chan, s_device);
	if (!shflag && (get_unit(s_device, 1) != unit))
	    lib$signal((unsigned int) &ld_dupunit); 		// Duplicate unit
    }

    if (exist == 0) {						// Existing device?
	func = LDIO$K_CONNECT;					// Normal function
	if (!s_file)
	    func |= LDIO$M_NOLOAD;				// No file to connect to
    } else {
	func = LDIO$K_LOAD;					// Load volume
    }
    if (exist == 2)
	func |= LDIO$M_LOADONLY;				// Just do a load

    // Build itemlist for connect. The old method for connecting a container file
    // to an LD device is by supplying an SBK (which contains an FCB pointer) to
    // the driver. The disadvantage of that is that we need an extra open of the
    // container file via an IO$_ACCESS qio which may not be compatible with an
    // open via RMS. The only thing the driver needs in the end is an FCB pointer
    // from which it can derive other structures like the WCB etc. The driver
    // however can also very easily derive the WCB and from there the FCB from
    // a supplied channel (which we already got from RMS), so we use that. By using
    // an itemlist we can also easily extend to parameters we pass to the driver.

    func |= LDIO$M_ITEMLIST;					// Use ITEMLIST method for connect

    LD_ITEMLIST item[] =
      {sizeof(fchan),     LDITM$K_CHANNEL,     (void *) &fchan,     0,
       sizeof(extendval), LDITM$K_EXTENDSIZE,  (void *) &extendval, 0,
       sizeof(limitval),  LDITM$K_EXTENDLIMIT, (void *) &limitval,  0,
       sizeof(maxblocks), LDITM$K_MAXBLOCKS,   (void *) &maxblocks, 0,
       sizeof(tracks),    LDITM$K_TRACKS,      (void *) &tracks,    0,
       sizeof(sectors),   LDITM$K_SECTORS,     (void *) &sectors,   0,
       sizeof(cylinders), LDITM$K_CYLINDERS,   (void *) &cylinders, 0,
       0, 0, 0, 0};

    if (sharing > 0)						// /SHARE ?
	func |= LDIO$M_SHARE;
    if (getqual(&sw_override) > 0)				// /OVERRIDE ?
	func |= LDIO$M_OVERRIDE;
    if (getqual(&sw_forced_error) < 0)				// /NOFORCED_ERROR?
	func |= LDIO$M_NOFE;
    if (getqual(&sw_lock) > 0)					// /LOCK ?
	func |= LDIO$M_LOCK;
    if (getqual(&sw_init) > 0)					// /INIT ?
	func |= LDIO$M_INIT;
    if (extendfl > 0)						// /EXTEND ?
	func |= LDIO$M_EXTEND;
    if (replacefl) {						// Replacing a drive
	stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,	// Init LD device
		    &realdev_dsc, 0, 0, 0, 0, func | LDIO$M_REPLACE);
    } else if (lbnfl) {						// Map lbn's to virtual device
	stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
		    &realdev_dsc,lbn_start, lbn_end, lbn_count,
		    0, func | LDIO$M_LBN);
    } else {							// Normal containerfile connect

	if (tape && (exist <= 1) && (loadfl >= 0)) {
	    bzero((void *) &cntrlfib, sizeof(cntrlfib));
	    cntrlfibdsc.dsc$a_dpointer = (char *) &cntrlfib;
	    cntrlfibdsc.dsc$l_length = sizeof(cntrlfib);

	    // Make sure that all retrieval pointers to the file are mapped.
	    // Opening the file without locks will invalidate the mapping
	    // so make them valid before connecting, otherwise the driver
	    // will reject the request.

	    cntrlfib.fib$w_cntrlfunc = FIB$C_REMAP;
	    stat = sys$qiow(0, fchan, IO$_ACPCONTROL, &iosb, 0, 0,
			    &cntrlfibdsc, 0, 0, 0, 0, 0);
	    signal_error(stat, iosb.iosb$w_status, 0);
	}
	stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
		    &item, 0, 0, 0, 0, func);
    }

    if ((iosb.iosb$w_status == SS$_FILALRACC) || (iosb.iosb$w_status == SS$_DEVALLOC)) {
	//
	// There's more information for this error in the second longword of the iosb
	//
        switch(iosb.iosb$l_dev_depend) {
	case LDRSN$K_NOTSHARED:
	    iosb.iosb$l_dev_depend = (unsigned int) &ld_notshared;
	    break;
	case LDRSN$K_NOSHARE:
	    iosb.iosb$l_dev_depend = (unsigned int) &ld_noshare;
	    break;
	case LDRSN$K_ALLOCLASS:
	    iosb.iosb$l_dev_depend = (unsigned int) &ld_alloclass;
	    break;
	case LDRSN$K_UNITNUMBER:
	    iosb.iosb$l_dev_depend = (unsigned int) &ld_unitnumber;
	    break;
	case LDRSN$K_TRACKS:
	    iosb.iosb$l_dev_depend = (unsigned int) &ld_tracks;
	    break;
	case LDRSN$K_SECTORS:
	    iosb.iosb$l_dev_depend = (unsigned int) &ld_sectors;
	    break;
	case LDRSN$K_CYLINDERS:
	    iosb.iosb$l_dev_depend = (unsigned int) &ld_cylinders;
	    break;
	case LDRSN$K_MAXBLOCK:
	    iosb.iosb$l_dev_depend = (unsigned int) &ld_maxblock;
	    break;
	case LDRSN$K_NOLBNMAP:
	    iosb.iosb$l_dev_depend = (unsigned int) &ld_nolbnmap;
	    break;
	case LDRSN$K_STARTLBN:
	    iosb.iosb$l_dev_depend = (unsigned int) &ld_startlbn;
	    break;
	case LDRSN$K_DEVICENAME:
	    iosb.iosb$l_dev_depend = (unsigned int) &ld_devicename;
	    break;
	case LDRSN$K_NOTREPLACED:
	    iosb.iosb$l_dev_depend = (unsigned int) &ld_notreplaced;
	    break;
	case LDRSN$K_RANGEINUSE:
	    iosb.iosb$l_dev_depend = (unsigned int) &ld_rangeinuse;
	    break;
	case LDRSN$K_FILEIDINUSE:
	    iosb.iosb$l_dev_depend = (unsigned int) &ld_fileidinuse;
	    break;
	case LDRSN$K_INCMPPROT:
	    iosb.iosb$l_dev_depend = (unsigned int) &ld_incmpprot;
	    break;
	case LDRSN$K_INCMPDEVTYPE:
	    iosb.iosb$l_dev_depend = (unsigned int) &ld_incmpdevtype;
	    break;
	default:
	    iosb.iosb$l_dev_depend = 0;
	    break;
	}
    }
    signal_error(stat, iosb.iosb$w_status, iosb.iosb$l_dev_depend);

#ifdef SYSINIT_OPCCRASH

    stat = sys$dassgn(chan);					// Deassign channel
    signal_error(stat, 0, 0);

    actual_unit = unit;

    if (alloclass) {
	outdsc.dsc$w_length--;
	outdsc.dsc$a_pointer++;
	if (!(sys$fao(&faodsc, &faolen, &outdsc, alloclass, cmdbuf, unit) & 1))
	    return;
	sysinit_device[0] = faolen;
    }
    else
    {
	sysinit_device[0] = strlen(fulldevspec(s_device));
	strcpy (&sysinit_device[1], fulldevspec(s_device));
    }
}

#else // SYSINIT_OPCCRASH

    if (!replacefl && !lbnfl && (loadfl >= 0)) {		// Only if not replacing drive
	if (!exist){						// Only if new connected device
	    if (getqual(&sw_save) > 0) {			// Update metadata
		mdat.ldmtd$l_tracks = tracks;
		mdat.ldmtd$l_sectors = sectors;
		mdat.ldmtd$l_cylinders = cylinders;
		mdat.ldmtd$l_maxblock = maxblocks;
        	setfilemetadata(&mdat);
	    }
	    if (mdat.ldmtd$v_protected) {			// Check for write protect 'button'
		stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
			        0, 0, 0, 0, 0, LDIO$K_ENABLE_PROTECT);
        	signal_error(stat, iosb.iosb$w_status, 0);
	    }
	}
    }

    stat = sys$dassgn(chan);					// Deassign channel
    signal_error(stat, 0, 0);

    if (loadfl >= 0) {						// Not a connect without a file
	if (getqual(&sw_symbol)) {				// /SYMBOL?
	    sprintf(tmpstr,"%d",get_unit(s_device, 1)); 	// Get unit number
	    sdev.dsc$a_dpointer = tmpstr;
	    sdev.dsc$l_length = strlen(tmpstr);
	    symbol.dsc$a_dpointer = lx_unit_symbol;
	    symbol.dsc$l_length = strlen(lx_unit_symbol);
	    stat = lib$set_symbol(&symbol, &sdev, 0);		// Create local symbol
	    signal_error(stat, 0, 0);
	}
	if ((tmpptr = getqualstring(&lognam))) {
	    sprintf(tmpstr,"%s",fulldevspec(s_device));		// Get unit number
	    sdev.dsc$a_dpointer = tmpstr;
	    sdev.dsc$l_length = strlen(tmpstr);
	    lnam.dsc$a_dpointer = tmpptr;
	    lnam.dsc$l_length = strlen(tmpptr);
	    stat = lib$set_logical(&lnam, &sdev);		// Create logical name
	    signal_error(stat, 0, 0);
	}

	if (getqual(&sw_logical))				// /LOGICAL?
	    setlogical(fulldevspec(s_device));			// Add extended logical name
    }
    if (q_log > 0) {						// /LOG ?
	stat = show_one(fulldevspec(s_device), 1);		// Show this one's now connected
	signal_error(stat, 0, 0);
    } else {
        if (shflag)
	    lib$signal((unsigned int) &ld_unit, 1, fulldevspec(s_device));	// Show it to the world
    }
}

//
// Setup a logical name for the connected device
//

void setlogical(char *device)
{
    char *logname, *logtable, *mode;
    unsigned char modeval;
    int status;
    LD_DSC lnamdsc, ltbldsc;
    LD_ITEMLIST itmlst[] = {strlen(device), LNM$_STRING, device, 0, 0, 0, 0, 0};
    PRVDEF privs;

    logname = getqualstring(&sw_logical_name);			// Get logical name string
    if (!logname)
        lib$stop(CLI$_ABSENT, 0);				// Need at least a name
    logtable = getqualstring(&sw_logical_table);		// Get logical table name string
    mode = getqualstring(&sw_logical_mode);			// Get logical name mode

    ltbldsc.dsc$a_dpointer = PROCESS_TBL;			// Default = process table
    if (logtable) {
	if (strcmp(logtable,PROCESS_STR) == 0)
	    ltbldsc.dsc$a_dpointer = PROCESS_TBL;		// Process table
	else if (strcmp(logtable,SYSTEM_STR) == 0)
	    ltbldsc.dsc$a_dpointer = SYSTEM_TBL;		// System table
	else if (strcmp(logtable,GROUP_STR) == 0)
	    ltbldsc.dsc$a_dpointer = GROUP_TBL;			// Group table
	else if (strcmp(logtable,JOB_STR) == 0)
	    ltbldsc.dsc$a_dpointer = JOB_TBL;			// Job table
	else
	    ltbldsc.dsc$a_dpointer = logtable;			// User specified table
    }
    ltbldsc.dsc$l_length = strlen(ltbldsc.dsc$a_dpointer);	// Setup table length

    lnamdsc.dsc$a_dpointer = logname;				// Descriptor for logical name
    lnamdsc.dsc$l_length = strlen(lnamdsc.dsc$a_dpointer);
    modeval = PSL$C_SUPER;					// Default = supervisor mode
    if (mode) {
	if (strcmp(mode,EXECUTIVE_STR) <= 0)
	    modeval = PSL$C_EXEC;
	else if (strcmp(mode,SUPERVISOR_STR) <= 0)
	    modeval = PSL$C_SUPER;
	else if (strcmp(mode,USER_STR) <= 0)
	    modeval = PSL$C_USER;
    }
    //
    // Watch out for this: if the issueing process lacks SYSNAM privilege then
    // the call to sys$crelnm will silently create a usermode logical name
    // that will be deleted as soon as this image exits. So if we just want a
    // normal supervisor mode logical name to be created we need to use
    // lib$set_logical.
    //
    // One could wonder why we should ever want to create a usermode logical name,
    // but that's still possible provided that it's not in the PROCESS table.
    //
    if (modeval == PSL$C_SUPER)
	status = lib$set_logical(&lnamdsc, 0, &ltbldsc, 0, &itmlst);
    else {
	//
	// Check for EXEC logical name and lack of SYSNAM privilege.
	// If true the logical will be usermode since we call sys$crelnm
	// from usermode, which is probably not what the user wants. Issue
	// a warning in that case.
	//
	if (modeval == PSL$C_EXEC) {
	    status = sys$setprv(0, 0, 0, (GENERIC_64 *) &privs);// Get user's privs
	    signal_error(status, 0, 0);
	    if (!privs.prv$v_sysnam)				// Sysnam enabled?
		lib$signal((unsigned int) &ld_nosysnam);	// No.....
	}
	status = sys$crelnm(0, &ltbldsc, &lnamdsc, &modeval, &itmlst);	// Do the dirty work
    }
    if (!(status & 1)) {
	lib$signal((unsigned int) &ld_logicalnameerr, 0, status, 0);	// Show the reason for the failure
    }
}

//
//  Find a shared device. We can connect if only a file is specified but
//  no unit number, in that case we get the information from locks created
//  by the driver. Because these are kernel mode locks, we need CMKRNL
//  privilege to examine them.
//

void findshareddevice(char *filename, int *ctrlr, int *unit, int *alloclass)
{
    char resnam[31];
    unsigned int arglist[12];
    int tmp1, tmp2;
    int i, j;
    int stat;
    int retlen;
    int count;
    IOSB iosb;
    LKIDEF locks[256];
    LKIDEF *p;
    LD_VALBLK *vb;
    LD_ITEMLIST item[] = {sizeof(locks), LKI$_LOCKS, (char *) &locks, (int) &retlen, 0, 0, 0, 0};
    LD_DSC dev;
    LD_DSC lknam;
    LD_ITEMLIST dvi_item[] = {13, DVI$_DEVLOCKNAM, &resnam[9], 0, 0, 0, 0, 0};

    lknam.dsc$a_dpointer = resnam;
    lknam.dsc$l_length = sizeof(resnam);
    dev.dsc$a_dpointer = ld_nam.nam$l_dev;			// Get real devicename
    dev.dsc$l_length = ld_nam.nam$b_dev;

    strcpy(resnam,"$LOGDISK_");					// Build the lock
    stat = sys$getdviw(0, 0, &dev, &dvi_item, &iosb, 0, 0, 0);
    signal_error(stat, iosb.iosb$w_status, 0);

    resnam[22] = resnam[23] = resnam[24] = 0;

    resnam[25] = ld_nam.nam$w_fid[0];				// Get file-id
    resnam[26] = ld_nam.nam$w_fid[0] >> 8;
    resnam[27] = ld_nam.nam$w_fid[1];
    resnam[28] = ld_nam.nam$w_fid[1] >> 8;
    resnam[29] = ld_nam.nam$w_fid[2];
    resnam[30] = ld_nam.nam$w_fid[2] >> 8;

    arglist[0] = 11;
    arglist[1] = 0;
    arglist[2] = LCK$K_NLMODE;
    arglist[3] = (unsigned int) &ld_lksb;
    arglist[4] = LCK$M_SYSTEM | LCK$M_VALBLK;
    arglist[5] = (unsigned int) &lknam;
    arglist[6] = 0;
    arglist[7] = 0;
    arglist[8] = 0;
    arglist[9] = 0;
    arglist[10] = 0;
    arglist[11] = 0;

    stat = sys$cmkrnl(sys$enqw, arglist);			// Enqueue null lock
    if (stat == SS$_NOPRIV)					// Not allowed.....
	stat = SS$_NOCMKRNL;					// Convert to a meaningfull error
    signal_error(stat, 0, 0);
    arglist[0] = 7;
    arglist[1] = 0;
    arglist[2] = (unsigned int) &ld_lksb.lksb$l_lkid;
    arglist[3] = (unsigned int) &item;
    arglist[4] = (unsigned int) &iosb;
    arglist[5] = 0;
    arglist[6] = 0;
    arglist[7] = 0;

    stat = sys$cmkrnl(sys$getlkiw, arglist);			// Get info of other locks on this resource
    signal_error(stat, iosb.iosb$w_status, 0);

    count = (retlen & 0xffff) / ((retlen >> 16) & 0x7fff);	// Get lock count
    p = locks;
    for (i = 0; i < count; i++, p++) {
	if (p->lki$l_lkid == ld_lksb.lksb$l_lkid)		// Disregard our own lock
	    continue;
	//
	//  We found someone using the same lock. Get the unitnumber,
	//  controller letter and allocation class from the valueblock
	//
	vb = (LD_VALBLK *) &ld_lksb.lksb$b_valblk;
	*ctrlr = vb->ldval$b_ctrlr;
	*unit = vb->ldval$w_unit;
	*alloclass = vb->ldval$l_allocls;
        break;
    }

    arglist[0] = 4;
    arglist[1] = (unsigned int) ld_lksb.lksb$l_lkid;
    arglist[2] = 0;
    arglist[3] = 0;
    arglist[4] = 0;

    stat = sys$cmkrnl(sys$deq, arglist);			// Get rid of our lock
    signal_error(stat, 0, 0);
    return;
}

#endif // SYSINIT_OPCCRASH

//
// Get the devicename from the channel number
//

void getdevnam(unsigned short chan, char *s_device)
{
    int stat;
    short rlen;
    LD_DSC dev;

    dev.dsc$l_length = 256;
    dev.dsc$a_dpointer = s_device;

    stat = lib$getdvi(&DVI$_ALLDEVNAM, &chan, 0, 0, &dev, &rlen);
    signal_error(stat, 0, 0);
    s_device[rlen] = '\0';					// Insert terminator
}

//
// Get unitnumber from a unit which may not exist
//

int get_unit(char *str, int exist)
{
    char *p, prev;
    int num, stat;
    short rlen;
    LD_DSC dev;

    dev.dsc$a_dpointer = str;
    dev.dsc$l_length = strlen(str);
    if (exist) {						// If it's there use getdvi
	stat = lib$getdvi(&DVI$_UNIT, 0, &dev, &num, 0, 0);
	signal_error(stat, 0, 0);
	return (num);
    } else {							// If it's not there find it ourselves
	p = str;
	prev = '\0';
	while (*p) {
	    if (isdigit(*p)) {					// Look for digit
		if (prev == '$') {				// Skip allocation class
		    while (isdigit(*p))
			p++;
		} else
		    return (atoi(p));				// Return unitnumber
	    }
	    prev = *p++;
	}
	//
	// If we get this far then there's no digit specified. If the last
	// character is an alpha character return -1 so we may interpret
	// it as a controller letter
	//
	if (isalpha(prev))
	    return -1;
	lib$signal((unsigned int) &ld_baddevsyntax, 1, str);	// Bad syntax
    }
}

//
// Set the unit seed to get a user specified device number
//

void set_seed(int num, char *device)
{
    LD_DSC sdev;
    int stat;
    unsigned short chan;
    IOSB iosb;
    char tmpstr[6];
    char *tmpptr;

    if (strncmp(device,lx_prefix,strlen(lx_prefix)) ||
        ((device[2] < 'A') || (device[2] > 'Z')))
        lib$signal((unsigned int) &ld_baddevsyntax, 1, device);	// Bad syntax
    strcpy(tmpstr,lx_unit0);
    tmpptr = device+2;
    tmpstr[2] = *tmpptr;					// Insert controller letter
    sdev.dsc$a_dpointer = tmpstr;
    sdev.dsc$l_length = strlen(tmpstr);
    stat = sys$assign(&sdev, &chan, 0, 0, 0);			// Assign channel
    signal_error(stat, 0, 0);
    stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,	// Init LD device
		   (void *)  (num - 1), 0, 0, 0, 0, LDIO$K_SET_SEED);	// minus one so next one will be correct
    signal_error(stat, iosb.iosb$w_status, 0);
    stat = sys$dassgn(chan);					// Deassign channel
    signal_error(stat, 0, 0);
}

#ifndef SYSINIT_OPCCRASH
//
//  Enable trace on a given device
//

void trace()
{
    LD_DSC sdev;
    int stat;
    unsigned short chan;
    int numbuf;
    int func;
    IOSB iosb;

    enable_privs(PRV$M_PHY_IO | PRV$M_SYSLCK);
    if (getqual(&sw_stop) > 0)					// /STOP?
	stop_trace();						// Stop active trace
    else {
	s_device = getqualstring(&sw_device);			// Get LD device name
	if (get_unit(s_device, 1) == 0)				// Don't use unit 0 
	    lib$signal((unsigned int) &ld_badunit, 1, fulldevspec(s_device));	// Show it to the world
	sdev.dsc$a_dpointer = s_device;
	sdev.dsc$l_length = strlen(s_device);
	if ((numbuf = getqualvalue(&sw_size)) == 0)		// Get number of tracebuffers
	    numbuf = 512;					// Default
	func = LDIO$K_ENABLE_TRACE;				// Normal function
	if (getqual(&sw_reset) > 0)				// /RESET ?
	    func = LDIO$K_RESET_TRACE;
	if (getqual(&sw_fdt) > 0)				// /FDT ?
	    func |= LDIO$M_FDTTRACE;
	if (getqual(&sw_accurate) > 0)				// /ACCURATE ?
	    func |= LDIO$M_ACCURATE;
	if (getqual(&sw_all) > 0)				// /ALL ?
	    func |= LDIO$M_TRACE_ALL;
	stat = sys$assign(&sdev, &chan, 0, 0, 0);		// Assign channel
	signal_error(stat, 0, 0);
	stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
			(void *) numbuf, 0, 0, 0, 0, func);	// Enable trace
	signal_error(stat, iosb.iosb$w_status, 0);
	stat = sys$dassgn(chan);				// Deassign channel
	signal_error(stat, 0, 0);
    }
}

//
//  Disable trace on a given device
//

void notrace()
{
    LD_DSC sdev;
    int stat;
    unsigned short chan;
    IOSB iosb;

    enable_privs(PRV$M_PHY_IO);
    s_device = getqualstring(&sw_device);			// Get LD device name
    if (get_unit(s_device, 1) == 0)				// Don't use unit 0
	lib$signal((unsigned int) &ld_badunit, 1, fulldevspec(s_device));	// Show it to the world
    sdev.dsc$a_dpointer = s_device;
    sdev.dsc$l_length = strlen(s_device);
    stat = sys$assign(&sdev, &chan, 0, 0, 0);			// Assign channel
    signal_error(stat, 0, 0);
    stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
		    0, 0, 0, 0, 0, LDIO$K_DISABLE_TRACE);	// Disable trace
    signal_error(stat, iosb.iosb$w_status, 0);
    stat = sys$dassgn(chan);					// Deassign channel
    signal_error(stat, 0, 0);
}

//
//  Enable write protect
//

void protect()
{
    protect_common(1);
}

//
//  Disable write protect
//

void noprotect()
{
    protect_common(0);
}

//
// Common routine to enable/disable protection
//

void protect_common(int how)
{
    LD_DSC sdev;
    int stat;
    int func;
    unsigned short chan;
    IOSB iosb;
    LD_METADATA mdat;
    char ldfile[256];
    char lddev[64];
    FIDDEF fid;
    LD_FLAGS *ioflgs;

    enable_privs(PRV$M_PHY_IO);
    if (how)							// Select correct function
        func = LDIO$K_ENABLE_PROTECT;
    else
        func = LDIO$K_DISABLE_PROTECT;
    s_device = getqualstring(&sw_device);			// Get LD device name
    if (get_unit(s_device, 1) == 0)				// Don't use unit 0
	lib$signal((unsigned int) &ld_badunit, 1, fulldevspec(s_device));	// Show it to the world
    sdev.dsc$a_dpointer = s_device;
    sdev.dsc$l_length = strlen(s_device);
    stat = sys$assign(&sdev, &chan, 0, 0, 0);			// Assign channel
    signal_error(stat, 0, 0);
    stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
		    0, 0, 0, 0, 0, func);
    signal_error(stat, iosb.iosb$w_status, 0);
    if (getqual(&sw_permanent) > 0) {
        stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,   // Inquire state
                    lddev, sizeof(lddev), (int64) &fid, 0, 0, LDIO$K_GET_CONNECTION);
        signal_error(stat, 0, 0);
	ioflgs = (LD_FLAGS *) &iosb.iosb$l_dev_depend;
        if (ioflgs->ldflg$v_connected && !ioflgs->ldflg$v_replaced && !ioflgs->ldflg$v_lbn) { 	// Check if connected to file
            lddev[iosb.iosb$w_bcnt] = '\0';        		// Terminate device spec
            create_filename(lddev,&fid,ldfile);
	    open_file(ldfile, 0, 0, 0);
            getfilemetadata(&mdat);				// Read the metadata
	    mdat.ldmtd$v_protected = how;			// Set protection flag
            setfilemetadata(&mdat);				// and write it back
	    close_file(ldfile);
        }
    }
    stat = sys$dassgn(chan);					// Deassign channel
    signal_error(stat, 0, 0);
}

//
//  Enable one or more watchpoints
//

void watch()
{
    LD_DSC sdev;
    int stat;
    unsigned short chan;
    int func;
    int cnt, i, size;
    IOSB iosb;
    WATCHPT *wpt, *wpt1, wptindex;
    int *blkpnt, wptcnt;
    int function_read, function_write, function_code, function_all,
     action_suspend, action_crash, action_error, action_opcom;
    int function_code_val, action_error_val;
    int resume, index, index_val, file;
    char *filename;

    enable_privs(PRV$M_PHY_IO);

    resume = getqual(&sw_resume);
    index = getqual(&sw_index);
    function_read = getqual(&sw_function_read);
    function_write = getqual(&sw_function_write);
    function_code = getqual(&sw_function_code);
    function_all = getqual(&sw_function_all);
    action_suspend = getqual(&sw_action_suspend);
    action_crash = getqual(&sw_action_crash);
    action_opcom = getqual(&sw_action_opcom);
    action_error = getqual(&sw_action_error);
    file = getqual(&sw_file);

    action_error_val = SS$_BUGCHECK;				// Default return status
    if (action_error) {
	action_error_val = getqualvalue(&sw_action_error);
	if (action_error_val == 0)
	    action_error_val = SS$_BUGCHECK;
    }
    if (function_code)
	function_code_val = getqualvalue(&sw_function_code);

    s_device = getqualstring(&sw_device);			// Get LD device name
    if (get_unit(s_device, 1) == 0)				// Don't use unit 0
	lib$signal((unsigned int) &ld_badunit, 1, fulldevspec(s_device));	// Show it to the world
    sdev.dsc$a_dpointer = s_device;
    sdev.dsc$l_length = strlen(s_device);
    stat = sys$assign(&sdev, &chan, 0, 0, 0);			// Assign channel
    signal_error(stat, 0, 0);

    if (file) {
	filename = getqualstring(&sw_file);			// Watchpoint on a file
	open_file(filename, 0, 0, 0);				// Open file
    }

    if (index) {						// /INDEX? (for WATCH/RESUME)
	index_val = getqualvalue(&sw_index);
	stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
			0, 0, 0, 0, 0, LDIO$K_GET_WATCH | LDIO$M_INQUIRE);	// Get watch size
	signal_error(stat, iosb.iosb$w_status, 0);
	wptcnt = iosb.iosb$l_dev_depend;			// Number of watchpoints
	if ((index_val < 1) || (index_val > wptcnt))
	    lib$signal((unsigned int) &ld_wptnotfound);		// Watchpoint not found
	if (wptcnt) {
	    size = wptcnt * LDWTC$C_LENGTH;
	    if (!(wpt = malloc(size)))
		signal_error(SS$_INSFMEM, 0, 0);
	    stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
			    wpt, size, 0, 0, 0, LDIO$K_GET_WATCH);	// Get watch data
	    signal_error(stat, iosb.iosb$w_status, 0);
	    wpt += index_val - 1;				// Point to correct data
	    wptindex.ldwtc$l_lbn = wpt->ldwtc$l_lbn;		// Copy block
	    wptindex.ldwtc$w_action = wpt->ldwtc$w_action;
	    wptindex.ldwtc$w_func = wpt->ldwtc$w_func;
	    wptindex.ldwtc$w_retcode = wpt->ldwtc$w_retcode;
	    wptindex.ldwtc$w_flags = wpt->ldwtc$w_flags;
	    wpt = &wptindex;
	    cnt = 1;						// One entry
	}
    } else {
	blkpnt = getlist(&sw_lblock, &cnt);			// Get LBN's to handle
	if (cnt) {
	    if (!(wpt = malloc(cnt * LDWTC$C_LENGTH)))
		 signal_error(SS$_INSFMEM, 0, 0);
	    for (i = 0, wpt1 = wpt; i < cnt; i++, wpt1++) {
		wpt1->ldwtc$l_lbn = *blkpnt++;			// Fill lbn
		if (function_all)
		    wpt1->ldwtc$w_func = 0xffff;
		else if (function_read)
		    wpt1->ldwtc$w_func = IO$_READPBLK;
		else if (function_write)
		    wpt1->ldwtc$w_func = IO$_WRITEPBLK;
		else if (function_code) {			// User specified function
		    wpt1->ldwtc$w_func = function_code_val;
		    switch (function_code_val & IO$M_FCODE) {	// Function without modifiers
		    case IO$_READPBLK:
		    case IO$_WRITEPBLK:
		    case IO$_WRITECHECK:
		    case IO$_DSE:
			wpt1->ldwtc$w_flags = 0;		// Function with transfer
			break;
		    default:
			if (file)
				lib$signal((unsigned int) &ld_noreadwrite, 0);
			wpt1->ldwtc$v_nolbn = 1;		// Special case
			wpt1->ldwtc$l_lbn = 0;			// Zap lbn
			break;					// For functions without a lbn
		    }
		}
		if (file) {
			wpt1->ldwtc$v_file_chan = 1;		// Signal 'file' Function with channel
			wpt1->ldwtc$w_chan = fchan;		// Point to channel
			if (wpt1->ldwtc$l_lbn == 0)		// VBN starts at 1
				lib$signal((unsigned int) &ld_vbnerror, 0);
		}
		if (action_suspend)				// Set action
		    wpt1->ldwtc$w_action = LDWTC$C_SUSPEND;
		else if (action_crash)
		    wpt1->ldwtc$w_action = LDWTC$C_CRASH;
		else if (action_opcom)
		    wpt1->ldwtc$w_action = LDWTC$C_OPCOM;
		else if (action_error) {
		    wpt1->ldwtc$w_action = LDWTC$C_ERROR;
		    wpt1->ldwtc$w_retcode = action_error_val;	// Error to return
		} else
		    wpt1->ldwtc$w_retcode = 0;
	    }
	}
    }
    if (resume)
	func = LDIO$K_RESUME_WATCH;				// Resume suspended thread
    else
	func = LDIO$K_ENABLE_WATCH;				// Enable watchpoint
    stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
		    wpt, cnt, 0, 0, 0, func);
    signal_error(stat, iosb.iosb$w_status, 0);
    stat = sys$dassgn(chan);					// Deassign channel
    signal_error(stat, 0, 0);
    if (file)
	close_file(filename);					// Close watchpoint file
}

//
//  Disable watch
//

void nowatch()
{
    LD_DSC sdev;
    int stat;
    unsigned short chan;
    WATCHPT *wpt, *wpt1, wptindex;
    IOSB iosb;
    int cnt;
    int i, size;
    int *blkpnt, wptcnt;
    int index, index_val;

    enable_privs(PRV$M_PHY_IO);
    s_device = getqualstring(&sw_device);			// Get LD device name
    if (get_unit(s_device, 1) == 0)				// Don't use unit 0
	lib$signal((unsigned int) &ld_badunit, 1, fulldevspec(s_device));	// Show it to the world
    sdev.dsc$a_dpointer = s_device;
    sdev.dsc$l_length = strlen(s_device);
    stat = sys$assign(&sdev, &chan, 0, 0, 0);			// Assign channel
    signal_error(stat, 0, 0);
    index = getqual(&sw_index);
    if (index) {						// /INDEX?
	index_val = getqualvalue(&sw_index);
	stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
			0, 0, 0, 0, 0, LDIO$K_GET_WATCH | LDIO$M_INQUIRE);	// Get watch size
	signal_error(stat, iosb.iosb$w_status, 0);
	wptcnt = iosb.iosb$l_dev_depend;
	if ((index_val < 1) || (index_val > wptcnt))
	    lib$signal((unsigned int) &ld_wptnotfound);		// Watchpoint not found
	if (wptcnt) {
	    size = wptcnt * LDWTC$C_LENGTH;
	    if (!(wpt = malloc(size)))
		signal_error(SS$_INSFMEM, 0, 0);
	    stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
			    wpt, size, 0, 0, 0, LDIO$K_GET_WATCH);	// Get watch data
	    signal_error(stat, iosb.iosb$w_status, 0);
	    wpt += index_val - 1;				// Point to correct data
	    wptindex.ldwtc$l_lbn = wpt->ldwtc$l_lbn;		// Copy block
	    wptindex.ldwtc$w_action = wpt->ldwtc$w_action;
	    wptindex.ldwtc$w_func = wpt->ldwtc$w_func;
	    wptindex.ldwtc$w_retcode = wpt->ldwtc$w_retcode;
	    wptindex.ldwtc$w_flags = wpt->ldwtc$w_flags;
	    wpt = &wptindex;
	    cnt = 1;						// One entry
	}
    } else {
	blkpnt = getlist(&sw_lblock, &cnt);			// Get lbn list
	if (cnt) {
	    if (!(wpt = malloc(cnt * LDWTC$C_LENGTH)))
		 signal_error(SS$_INSFMEM, 0, 0);
	    for (i = 0, wpt1 = wpt; i < cnt; i++, wpt1++) {
		wpt1->ldwtc$v_remove_all = 1;			// Flag all of this lbn
		wpt1->ldwtc$l_lbn = *blkpnt++;			// Fill lbn to kill
	    }
	}
    }
    stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
		    wpt, cnt, 0, 0, 0, LDIO$K_DISABLE_WATCH);	// Disable watch
    signal_error(stat, iosb.iosb$w_status, 0);
    stat = sys$dassgn(chan);					// Deassign channel
    signal_error(stat, 0, 0);
}

//
//  Show watch info
//

void show_watch()
{
    LD_DSC sdev;
    int stat;
    unsigned short chan;
    WATCHPT *wpt;
    SUSPEND_LIST *slist;
    IOSB iosb;
    int wptcnt, blkcnt, slistcnt, size;
    int *blkpnt;

    s_device = getqualstring(&sw_device);			// Get LD device name
    if (get_unit(s_device, 1) == 0)				// Don't use unit 0
	lib$signal((unsigned int) &ld_badunit, 1, fulldevspec(s_device));	// Show it to the world
    sdev.dsc$a_dpointer = s_device;
    sdev.dsc$l_length = strlen(s_device);
    blkpnt = getlist(&sw_lblock, &blkcnt);
    stat = sys$assign(&sdev, &chan, 0, 0, 0);			// Assign channel
    signal_error(stat, 0, 0);
    stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
		    0, 0, 0, 0, 0, LDIO$K_GET_WATCH | LDIO$M_INQUIRE);	// Get watch size
    signal_error(stat, iosb.iosb$w_status, 0);
    if (wptcnt = iosb.iosb$l_dev_depend) {			// Something to do ?
	size = wptcnt * LDWTC$C_LENGTH;
	if (!(wpt = malloc(size)))
	    signal_error(SS$_INSFMEM, 0, 0);
	stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
			wpt, size, 0, 0, 0, LDIO$K_GET_WATCH);	// Get watch data
	signal_error(stat, iosb.iosb$w_status, 0);
    }
    stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
		  0, 0, 0, 0, 0, LDIO$K_GET_SUSPEND_LIST | LDIO$M_INQUIRE);	// Get suspend list size
    signal_error(stat, iosb.iosb$w_status, 0);
    if (slistcnt = iosb.iosb$l_dev_depend) {			// Something suspended ?
	size = slistcnt * LDSUSP$C_LENGTH;
	if (!(slist = malloc(size)))
	    signal_error(SS$_INSFMEM, 0, 0);
	stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
			slist, size, 0, 0, 0, LDIO$K_GET_SUSPEND_LIST);	// Get suspend list
	signal_error(stat, iosb.iosb$w_status, 0);
    }
    stat = sys$dassgn(chan);					// Deassign channel
    signal_error(stat, 0, 0);
    display_watch(wpt, wptcnt, blkpnt, blkcnt, slist, slistcnt);// Show it
}

//
// Display one watchpoint entry
//

void display_watch(WATCHPT *wpt, int wptcnt, int *blkpnt, int blkcnt, SUSPEND_LIST *slist, int slistcnt)
{
    int i, j;
    int index, index_val;
    int *bpt;
    int found, printed;
    SUSPEND_LIST *spt;
    char albn[9];
    char filename[256];

    if (index = getqual(&sw_index))				// /INDEX?
	index_val = getqualvalue(&sw_index);			// Get value
    if (wptcnt) {						// Something to do ?
	printed = 0;
	for (i = 0; i < wptcnt; i++, wpt++) {			// For all watchpoints
	    found = 0;
	    if (blkcnt) {					// Check if in list the user specified
		for (j = 0, bpt = blkpnt; j < blkcnt; j++, bpt++)
		    if (*bpt == wpt->ldwtc$l_lbn) {
			found++;
			break;
		    }
	    } else {
		if (index) {					// Or check by index
		    if (index_val == i + 1)
			found++;
		} else
		    found++;
	    }
	    if (found) {
		if (!printed) {					// Print header only once
		    printf("Index LBN     Action     Function         Error return code\n");
		    printf("--------------------------------------------------------------------\n");
		    printed = 1;
		}
		if (wpt->ldwtc$v_file_chan) {
			create_filename(s_device,(FIDDEF *) &wpt->ldwtc$w_fid,filename);
			printf("             %s\n",filename);
		}
		if (wpt->ldwtc$v_nolbn)
		    sprintf(albn, "%8s", "");			// Blank for watchpoint without lbn
		else
		    sprintf(albn, "%8d", wpt->ldwtc$l_lbn);
		switch (wpt->ldwtc$w_action) {
		case LDWTC$C_SUSPEND:
		    printf("%2d %s  Suspend   %-18s\n", i + 1, albn,
			   decode_func(wpt->ldwtc$w_func));
		    for (j = 0, spt = slist; j < slistcnt; j++, spt++)
			if ((spt->ldsusp$l_lbn == wpt->ldwtc$l_lbn) &&
			    (spt->ldsusp$w_func == wpt->ldwtc$w_func))
			    printf("             Suspended process: %08.8X\n", spt->ldsusp$l_pid);
		    break;
		case LDWTC$C_ERROR:
		    printf("%2d %s  Error     %-18s   %04.4X (%s)\n",
			   i + 1, albn, decode_func(wpt->ldwtc$w_func),
			   wpt->ldwtc$w_retcode, ssdef(wpt->ldwtc$w_retcode));
		    break;
		case LDWTC$C_CRASH:
		    printf("%2d %s  Crash     %-18s\n", i + 1, albn,
			   decode_func(wpt->ldwtc$w_func));
		    break;
		case LDWTC$C_OPCOM:
		    printf("%2d %s  Opcom     %-18s\n", i + 1, albn,
			   decode_func(wpt->ldwtc$w_func));
		    break;
		default:
		    break;
		}
	    }
	}
	if (!printed)
	    lib$signal((unsigned int) &ld_wptnotfound);		// Watchpoint not found
    } else
	lib$signal((unsigned int) &ld_nowatchdata);		// No watch data available
}

//
// Get a list of lbn's from the commandline
//

int *getlist(struct dsc$descriptor_s *sw, int *cnt)
{
    int more;
    int *blklist, *blkpnt;

    if (!(blklist = malloc(sizeof(int))))			// get mem for 1 entry
	 signal_error(SS$_INSFMEM, 0, 0);			// not enough memory
    *cnt = 0;
    more = -1;
    blkpnt = blklist;
    for (;;) {
	*blkpnt = getmulqualvalue(sw, &more);			// Get entry
	if (more < 0)						// Not specified ?
	    return (blklist);
	*cnt += 1;
	if (more) {						// More coming up?
	    //
	    // Get new block to accomodate size
	    //
	    if (!(blklist = realloc(blklist, (*cnt + 1) * sizeof(int))))
		 signal_error(SS$_INSFMEM, 0, 0);		// Not enough memory
	    blkpnt = blklist + *cnt;
	} else
	    break;
    }
    return blklist;
}

//
//  Stop running trace
//

void stop_trace()
{
    int stat;
    int loop = 0;
    int nonode = 0;
    char matchname[256];
    $DESCRIPTOR(matchdev, matchname);
    LD_DSC wildname;
    unsigned short rlen;
    int devclass;
    LD_ITEMLIST item[] = {sizeof(devclass), DVS$_DEVCLASS, (char *) &devclass, 0, 0, 0, 0, 0};
    GENERIC_64 context = { 0 };

    wildname.dsc$a_dpointer = lx_wildname;
    wildname.dsc$l_length = strlen(lx_wildname);
    if (tape)
	devclass = DC$_TAPE;
    else
	devclass = DC$_DISK;

    s_device = getqualstring(&sw_device);			// Get devicename

    if (getqual(&sw_all) > 0) {					// /ALL ?
	stat = 1;
	while (stat & 1) {					// Loop until we're done
	    stat = sys$device_scan(&matchdev, &rlen, &wildname, &item, &context);
	    if (stat == SS$_NOMOREDEV) {
		if (nonode) {
		    if (loop == 0)
			lib$signal((unsigned int) &ld_nounitsfound, 1, matchname);
		    else
			return;					// No more, quit
		} else {
		    nonode = 1;
		    stat = 1;
		    wildname.dsc$a_dpointer = lx_wildname_nonode;
		    wildname.dsc$l_length = strlen(lx_wildname_nonode);
		    continue;
		}
	    }
	    signal_error(stat, 0, 0);
	    matchname[rlen] = '\0';				// Place terminator
	    if (nonode && strchr(matchname,'$'))
		continue;
	    if (get_unit(matchname,1) != 0) {
		loop++;
		stop_one(matchname, 0);				// Stop trace for this device
	    }
	}
    } else							// Only one specified device
	stop_one(fulldevspec(s_device), 1);			// Stop it
}

//
//  Stop trace for one specific device
//

void stop_one(char *which, int single)
{
    LD_DSC lknam;
    int stat;
    char *qname;
    IOSB iosb;
    int lockid;
    int retlen;
    int count;
    int i;
    int found;
    int grp, mem;
    int pid;
    PRVDEF oldpriv;
    LD_DSC sfilename;
    LD_VALBLK *vb;
    LKIDEF locks[256];
    LKIDEF *p;
    LD_ITEMLIST item[] = {sizeof(locks), LKI$_LOCKS, (char *) &locks, (int) &retlen, 0, 0, 0, 0};
    LD_ITEMLIST jpi_item[] =
      {8, JPI$_CURPRIV, (char *) &oldpriv, 0,
       4, JPI$_GRP, (char *) &grp, 0,
       4, JPI$_MEM, (char *) &mem, 0,
       4, JPI$_PID, (char *) &pid, 0,
       0, 0, 0, 0};

    sfilename.dsc$a_dpointer = which;
    sfilename.dsc$l_length = strlen(which);
    if (get_unit(which, 1) == 0) {				// Don't use unit 0
	if (single)
	    lib$signal((unsigned int) &ld_badunit, 1, which);	// Show it to the world
	else
	    return;
    }
    lknam.dsc$a_dpointer = build_lock(which);			// Build resource name
    lknam.dsc$l_length = strlen(lknam.dsc$a_dpointer);
    stat = sys$enqw(0, LCK$K_NLMODE, &ld_lksb, LCK$M_SYSTEM | LCK$M_VALBLK,
		    &lknam, 0, 0, 0, 0, 0, 0);			// Enqueue null lock
    signal_error(stat, ld_lksb.lksb$w_status, 0);
    stat = sys$getlkiw(0, &ld_lksb.lksb$l_lkid, &item, &iosb, 0, 0, 0);	// Get info of other locks on this resource
    signal_error(stat, iosb.iosb$w_status, 0);
    count = (retlen & 0xffff) / ((retlen >> 16) & 0x7fff);	// Lock count
    p = locks;
    found = 0;
    for (i = 0; i < count; i++, p++) {
	if (p->lki$l_lkid == ld_lksb.lksb$l_lkid)		// Disregard our own lock
	    continue;
	found = 1;
	stat = sys$getjpiw(0, 0, 0, &jpi_item, &iosb, 0, 0);	// Get privs+ group + member
	signal_error(stat, iosb.iosb$w_status, 0);
	vb = (LD_VALBLK *) &ld_lksb.lksb$b_valblk;
	if (!((grp == vb->ldval$l_grp) &&			// Group the same
	      (mem == vb->ldval$l_mem))) {			// as well as the member ?
	    if ((grp != vb->ldval$l_grp) &&			// Group the same ?
		(mem != vb->ldval$l_mem)) {			// Member the same ?
		if (!oldpriv.prv$v_world)			// We need WORLD
		    lib$signal((unsigned int) &ld_noworldpriv, 1, which);
	    } else if (grp == vb->ldval$l_grp) {		// Group the same ?
		if (!oldpriv.prv$v_group)			// We need GROUP
		    lib$signal((unsigned int) &ld_nogrouppriv, 1, which);
	    }
	}
	stat = sys$enqw(0, LCK$K_EXMODE, &ld_lksb,		// Convert to fire blocking ast
			LCK$M_SYSTEM | LCK$M_CONVERT | LCK$M_VALBLK,
			0, 0, 0, 0, 0, 0, 0);
	signal_error(stat, ld_lksb.lksb$w_status, 0);
	vb = (LD_VALBLK *) &ld_lksb.lksb$b_valblk;
	vb->ldval$l_pid = pid;
	stat = sys$deq(ld_lksb.lksb$l_lkid, &ld_lksb.lksb$b_valblk, 0, 0);	// Get rid of our lock, write lvb
	signal_error(stat, 0, 0);
	break;
    }
    if (!found)
	lib$signal((unsigned int) &ld_conttracenotact, 1, fulldevspec(which));
}

//
//  Show trace info
//

void show_trace()
{
    LD_DSC sdev;
    LD_DSC lknam;
    int fdt_active;
    int accurate;
    int stat;
    unsigned short chan;
    int trcsize;
    int trcnum;
    int contin;
    int qstat;
    int func;
    int inited;
    int overrun;
    IOSB iosb;
    LD_FLAGS *ioflgs;
    char *trcbuf, *tmpbuf;
    LD_ITEMLIST item[] =
      {4, JPI$_GRP, &ld_lksb.lksb$b_valblk[0], 0,
       4, JPI$_MEM, &ld_lksb.lksb$b_valblk[4], 0,
       0, 0, 0, 0};

    if (getqual(&sw_input) > 0)
	process_input();					// Process input file
    else {
	s_device = getqualstring(&sw_device);			// Get devicename
	if (!s_device)
	    lib$signal((unsigned int) &ld_confqual);		// Conflicting qualifiers
	s_device = fulldevspec(s_device);			// Get full devicespec
	if (get_unit(s_device, 1) == 0)				// Don't use unit 0
	    lib$signal((unsigned int) &ld_badunit, 1, s_device);// Show it to the world
	sdev.dsc$a_dpointer = s_device;
	sdev.dsc$l_length = strlen(s_device);
	qstat = getqual(&sw_status);
	stat = sys$assign(&sdev, &chan, 0, 0, 0);		// Assign channel
	signal_error(stat, 0, 0);
	//
	// Get number of tracebuffers
	//
	stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
			0, 0, 0, 0, 0, LDIO$K_GET_TRACE | LDIO$M_INQUIRE);
	signal_error(stat, iosb.iosb$w_status, 0);
	fdt_active = (iosb.iosb$w_status == SS$_WASSET);
	trcnum = iosb.iosb$l_dev_depend;			// Size of tracebuffer (in entries)
	trcsize = trcnum * LDTRC$C_LENGTH;
	trcbuf = malloc(trcsize);				// Get memory for trace buffer
	if (trcbuf == 0)
	    signal_error(SS$_INSFMEM, 0, 0);			// Not enough memory
	func = LDIO$K_GET_TRACE | LDIO$M_NOWAIT;		// Normal function
	if (getqual(&sw_reset) > 0)				// /RESET ?
	    func |= LDIO$M_RESET;
	if (contin = (getqual(&sw_continuous) > 0)) {		// /CONTINUOUS ?
	    func = LDIO$K_GET_TRACE | LDIO$M_RESET;
	    set_outband();					// Set out-of-band escape
	    lknam.dsc$a_dpointer = build_lock(s_device);	// Build lock resource name
	    lknam.dsc$l_length = strlen(lknam.dsc$a_dpointer);
	    stat = sys$getjpiw(0, 0, 0, &item, &iosb, 0, 0);	// Get group + member
	    signal_error(stat, iosb.iosb$w_status, 0);
	    stat = sys$enqw(0, LCK$K_PWMODE, &ld_lksb,
			    LCK$M_SYSTEM | LCK$M_NOQUEUE,
			    &lknam, 0, 0, 0, 0, 0, 0);
	    if (stat == SS$_NOTQUEUED)
		lib$signal((unsigned int) &ld_conttraceact, 1, fulldevspec(s_device));
	    signal_error(stat, ld_lksb.lksb$w_status, 0);
	    stat = sys$enqw(0, LCK$K_PRMODE, &ld_lksb,		// Write lock value block
			    LCK$M_SYSTEM | LCK$M_CONVERT | LCK$M_VALBLK,
			    0, 0, 0, 0, 0, 0, 0);
	    signal_error(stat, ld_lksb.lksb$w_status, 0);
	    stat = sys$enqw(0, LCK$K_PWMODE, &ld_lksb,		// Convert up again
			    LCK$M_SYSTEM | LCK$M_CONVERT | LCK$M_VALBLK,
			    0, 0, 0, 0, &ld_exit, 0, 0);
	    signal_error(stat, ld_lksb.lksb$w_status, 0);
	}
	inited = (contin > 0) ? 0 : -1;
	do {
	    stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
			    trcbuf, trcsize, 0, 0, 0, func);	// Get trace info
	    signal_error(stat, 0, 0);
	    stat = iosb.iosb$w_status;
	    if (stat == SS$_DATAOVERUN) {
		overrun = iosb.iosb$l_dev_depend;		// Save number of overruns
		iosb.iosb$l_dev_depend = trcnum;
	    } else {
		overrun = 0;
		signal_error(stat, 0, 0); 			// Test for other error than DATAOVERRUN
	    }
	    if (qstat) {
		lib$signal((unsigned int) &ld_status, 3, fulldevspec(s_device),
			   trcnum, iosb.iosb$l_dev_depend);	// Show it to the world
		if (fdt_active)
		    lib$signal((unsigned int) &ld_fdtactive);	// FDT tracing active
		stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
				0, 0, 0, 0, 0, LDIO$K_GET_CONNECTION);
		signal_error(stat, iosb.iosb$w_status, 0);
		ioflgs = (LD_FLAGS *) &iosb.iosb$l_dev_depend;
		if (ioflgs->ldflg$v_accurate)
		    lib$signal((unsigned int) &ld_accurate);	// Accurate timing active
		break;
	    } else {
		if (iosb.iosb$l_dev_depend)			// Anything there ?
		    process_trace(trcbuf, iosb.iosb$l_dev_depend, 0, overrun,	// Process the contents
				  nodename(), cvttime(0, 0, 0), inited);
	    }
	    inited = 1;
	}
	while (contin);
	stat = sys$dassgn(chan);				// Deassign channel
	signal_error(stat, 0, 0);
	free(trcbuf);						// Get rid of buffer
    }
}

//
//  Process the trace buffer
//

void process_trace(char *buf, int size, LD_OVRRUN *ovrbuf, int overrun, char *nname, char *when, int inited)
{
    static int q_bin, q_entries;
    static int q_blocks, q_version_limit, q_vsw;
    static int v_end1, v_end2;
    static int re_open = 0;
    static int written = 0;
    TRACE_ENT *p; 
    static int outflg;
    int i;
    int version, recnum;
    int end1, end2;
    int entr, numpack;

    if ((inited <= 0) || (re_open <= 0)) {
	if (re_open == 0) {
	    q_entries = getqual(&sw_entries);			// /ENTRIES ?
	    if (q_entries > 0) {
		v_end1 = getqualvalue(&sw_entries);		// Get #of entries to show
		v_end2 = getqualvalue(&sw_entries);		// Get second part (if any)
	    }
	    q_bin = getqual(&sw_binary);			// /BINARY ?
	    q_blocks = getqual(&sw_blocks);			// /BLOCKS ?
	    if (q_blocks)
		q_blocks = getqualvalue(&sw_blocks);		// Get value
	    q_vsw = getqual(&sw_version_limit);			// /VERSION_LIMIT ?
	    if (q_vsw) {
		q_version_limit = getqualvalue(&sw_version_limit);	// Get value
		if (q_version_limit >= 32767)
		    q_version_limit = 32767;
		if (q_version_limit <= 0)
		    q_version_limit = 1;
		q_version_limit--;
	    }
	    outflg = getqual(&sw_output);			// /OUTPUT ?
	    if (outflg > 0)
		outfilename = getqualstring(&sw_output);	// Get filename
	}
	if (outflg > 0) {
	    if (q_bin)
		outfilename = fullfilespec(outfilename, lx_trace_binary_name);	// Provide default
	    else
		outfilename = fullfilespec(outfilename, lx_trace_ascii_name);	// Provide default
	    if (re_open < 0) {					// New open, close old file
		if ((int) outfile >= 0) {			// Closing outfile closes outfilei as well
		    if (fclose(outfile) < 0)
			lib$signal((unsigned int) &ld_closerr, 1, outfilename, vaxc$errno, 0);
		}
		if (q_vsw)
		    purge_file(q_version_limit, outfilename);
	    }
	    //
	    //   We want to create a normal file with some nice RMS attributes. Since
	    //   this can't be done with fopen() we will create the file first, and use
	    //   fdopen to setup the correct file pointers. This takes also care of the
	    //   substitution of the defaults filename parts.
	    //
	    if (q_bin)
		outfilei = creat(outfilename, 0, "rfm=var", "ctx=bin");
	    else
		outfilei = creat(outfilename, 0, "rfm=var", "rat=cr");
	    if ((outfilei < 0) ||
		((outfile = fdopen(outfilei, "a+")) == NULL))
		lib$signal((unsigned int) &ld_outfilerr, 1, outfilename, vaxc$errno, 0);	// Can't open output file
	    re_open = 1;
	} else if (outflg < 0)					// /NOOUTPUT ?
	    return;
	else
	    outfile = stdout;					// Default output
    }
    end2 = 0;
    if (q_entries > 0) {					// /ENTRIES ?
	end1 = v_end1;						// Get #of entries to show
	end2 = v_end2;						// Get second part (if any)
	if (end2 != 0) {					// There's a second part
	    if ((end1 <= 0) ||
		(end2 <= 0) ||
		(end2 < end1))
		lib$signal((unsigned int) &ld_badentparam);	// Bad /ENTRIES parameter
	}
	if (end1 == 0)
	    return;						// Nothing to show
	if (end1 > 0) {
	    p = (TRACE_ENT *) buf;				// Start of buffer
	    recnum = 1;						// First one to display
	    if (end2 > 0) {
		p += (end1 - 1);				// New start, first parameter
		recnum = end1;					// Adjust recordnumber
	    }
	} else {
	    end1 = -end1;					// Make absolute
	    i = ((size - end1) < 0) ? 0 : (size - end1);
	    p = (TRACE_ENT *) buf + i;
	    recnum = i + 1;					// First one to display
	}
    } else {
	p = (TRACE_ENT *) buf;					// Start of buffer
	end1 = size;						// Default = all
	recnum = 1;						// First one to display
    }
    if (end1 > size) {						// More than we've got?
	if (end2 > 0)
	    lib$signal((unsigned int) &ld_pastdata);		// Past end of data
	end1 = end2 = size;					// Enforce limit
    }
    if (end2 > size)
	end2 = size;						// And another limit
    if (end2 > 0)
	numpack = end2 - end1 + 1;				// Total number of packets to show
    else
	numpack = end1;
    if (q_bin) {						// Binary mode
	version = DATA_FILE_VERSION << 24;
	if ((inited <= 0) || ((written == 0) && q_blocks)) {
	    if ((fwrite(&version, sizeof(int), 1, outfile) != 1) ||	// Data file version
		 (fwrite(fulldevspec(s_device), 32, 1, outfile) != 1) ||// Devicename
		 (fwrite(nname, 32, 1, outfile) != 1) ||	// Nodename
		 (fwrite(when, 24, 1, outfile) != 1))		// Timestamp
		 lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
	    if (q_blocks)
		written += sizeof(int) + 32 + 32 + 24 + (4 * 2);// Header size
	}
	if ((fwrite(&numpack, sizeof(int), 1, outfile) != 1) ||	// Number of entries
	     (fwrite(&overrun, sizeof(int), 1, outfile) != 1) ||// Number of overruns
	     (fwrite(p, LDTRC$C_LENGTH, numpack, outfile) != numpack))	// Data
	     lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
	if (q_blocks) {
	    written += (2 * (sizeof(int) + 2)) +
	     ((LDTRC$C_LENGTH + 2) * numpack);
	    if (written >= ((q_blocks - 1) * 512)) {
		re_open = -1;					// Set flag for new file
		written = 0;
	    }
	}
    } else
	show_trace_data(p, numpack, recnum, outfile, nname,
			s_device, when, inited, ovrbuf, overrun);
    if ((outfile != stdout) && (inited < 0)) {			// Close output file
	if (fclose(outfile) < 0)
	    lib$signal((unsigned int) &ld_closerr, 1, outfilename, vaxc$errno, 0);
    }
}

//
//  Format all tracedata
//

void show_trace_data(TRACE_ENT *p, int numpack, int from, FILE *outfile, char *node,
		     char *device, char *when, int inited, LD_OVRRUN *ovrbuf, int overrun)
{
    LD_OVRRUN *op;
    char record[256];
    char tmp[256];
    int i, j, stat, func, ovrcnt;
    static int pid, lbn, bytecount, fdt, accurate;
    static int iosb, function, timestamp;
    static int time_elapsed, time_absolute, time_combination, time_delta;
    static int time_start, time_end;
    static int function_hex, function_text;
    static int iosb_hex, iosb_longhex;
    static int iosb_text, iosb_combination;
    static int number, header, linenum;
    static int warnings, lbn_hex, bytecount_hex;
    uint64 time, usec;
    static uint64 prev_tim, prev_usec;
    uint64 restim;

//
//  Parse various qualifiers
//
    if (inited <= 0) {
	pid = getqual(&sw_pid);
	lbn = getqual(&sw_lbn);
	lbn_hex = getqual(&sw_lbn_hex);
	fdt = getqual(&sw_fdt);
	accurate = getqual(&sw_accurate);
	bytecount = getqual(&sw_bytecount);
	bytecount_hex = getqual(&sw_bytecount_hex);
	timestamp = getqual(&sw_timestamp);
	time_elapsed = getqual(&sw_time_elapsed);
	time_absolute = getqual(&sw_time_absolute);
	time_combination = getqual(&sw_time_combination);
	time_delta = getqual(&sw_time_delta);
	time_start = getqual(&sw_time_start);
	time_end = getqual(&sw_time_end);
	function = getqual(&sw_function);
	function_hex = getqual(&sw_function_hex);
	function_text = getqual(&sw_function_text);
	iosb = getqual(&sw_iosb);
	iosb_hex = getqual(&sw_iosb_hex);
	iosb_longhex = getqual(&sw_iosb_longhex);
	iosb_text = getqual(&sw_iosb_text);
	iosb_combination = getqual(&sw_iosb_combination);
	number = getqual(&sw_number);
	header = getqual(&sw_header);
	warnings = getqual(&sw_warnings);
	linenum = from;
	prev_tim = 0;
	prev_usec = 0;
    }
    if ((header > 0) && (inited <= 0)) {			// /HEADER ?
	if (fprintf(outfile, "         I/O trace for device %s\n    %s",
		    device, when) <= 0)
	    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
	if (node)						// Nodename available ?
	    stat = fprintf(outfile, " on node %s\n\n", node);
	else
	    stat = fprintf(outfile, "\n\n");
	if (stat <= 0)
	    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
	*record = '\0';						// Initially nothing
	if (number > 0)
	    strcpy(record, "Entry ");
	if (timestamp > 0) {
	    if (time_elapsed)
		strcat(record, "Elaps    ");
	    else if (time_absolute)
		strcat(record, "Start Time       End Time       ");
	    else if (time_combination)
		strcat(record, "End Time           Elaps ");
	    else if (time_delta)
		strcat(record, "Delta Time          Elaps ");
	    else if (time_start)
		strcat(record, "Start Time      ");
	    else if (time_end)
		strcat(record, "End Time        ");
	}
	if (pid > 0)
	    strcat(record, "   Pid   ");
	if (lbn > 0)
	    strcat(record, "    Lbn    ");
	if (bytecount > 0)
	    strcat(record, " Bytes ");
	if (iosb > 0) {
	    if (iosb_hex)
		strcat(record, " Iosb[0] ");
	    else if (iosb_longhex)
		strcat(record, " Iosb[0]  Iosb[1] ");
	    else if (iosb_text)
		strcat(record, " Iosb   ");
	    else if (iosb_combination)
		strcat(record, " Iosb    Count ");
	}
	if (function > 0)
	    strcat(record, " Function ");
	if (!(*record))
	    return;						// Nothing to display, quit
	j = strlen(record);
	record[j - 1] = '\n';					// Zap trailing space
	record[j] = '\0';
	for (i = 0; i < j - 1; i++)				// Form string of dashes
	    tmp[i] = '-';
	tmp[i++] = '\n';					// Trailing newline
	tmp[i] = '\0';
	if ((fprintf(outfile, "%s", record) <= 0) ||
	    (fprintf(outfile, "%s", tmp) <= 0))
	    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
    }
    for (i = 0; i < numpack; i++) {				// For all records to show
	if ((overrun != 0) && (warnings > 0)) {			// Signal lost data
	    if (ovrbuf == 0) {					// Called with number of overruns
		ovrcnt = overrun;
		overrun = 0;					// Prevent display for every record
	    } else {
		op = ovrbuf;					// Called after reading input file
		ovrcnt = 0;					// Check overrun records
		for (j = 0; j < overrun; j++, op++)		// For all overrunrecords
		    if (op->ldovr$l_recnum == linenum - 1) {
			ovrcnt = op->ldovr$l_overrun;		// Found match
			break;
		    }
	    }
	    if (ovrcnt > 0)
		if (fprintf(outfile, "[%d trace record%slost]\n",
			    ovrcnt, ovrcnt == 1 ? " " : "s ") <= 0)
		    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
	}
	if ((p->ldtrc$l_iosb[0] != SS$_FDT_COMPL) || ((p->ldtrc$l_iosb[0] == SS$_FDT_COMPL) && fdt > 0)) {
	    *record = '\0';
	    func = p->ldtrc$w_func & IO$M_FCODE;		// Strip function modifiers
	    if ((func == IO$_SETMODE) ||			// These functions don't have a lbn
	        (func == IO$_PACKACK) ||
	        (func == IO$_AVAILABLE) ||
	        (func == IO$_UNLOAD))
	        p->ldtrc$l_lbn = 0;				// Clear for better readout
	    if (number > 0)					// Line numbers
	        sprintf(record, "%5d ", linenum);
	    linenum++;						// One more line
	    if (timestamp > 0) {				// Time display
	        if (time_elapsed) {
		    stat = lib$sub_times(&p->ldtrc$q_end_time, &p->ldtrc$q_start_time, &restim);
		    signal_error(stat, 0, 0);
		    j = p->ldtrc$q_end_usec - p->ldtrc$q_start_usec;
		    if (j < 0)					// # of seconds increased?
			j += 1000000;				// Add one second worth of microseconds
		    sprintf(tmp, "%02.2s.%06.6Ld", cvttime(&restim, 1, 1), j);
		    strcat(record, tmp);
	        } else if (time_absolute) {
		    sprintf(tmp, "%8.8s.%06.6Ld ",cvttime(&p->ldtrc$q_start_time, 0, 1), p->ldtrc$q_start_usec);
		    strcat(record, tmp);
		    sprintf(tmp, "%8.8s.%06.6Ld ",cvttime(&p->ldtrc$q_end_time, 0, 1),p->ldtrc$q_end_usec);
		    strcat(record, tmp);
	        } else if (time_combination) {
		    sprintf(tmp, "%8.8s.%06.6Ld ",cvttime(&p->ldtrc$q_end_time, 0, 1), p->ldtrc$q_end_usec);
		    strcat(record, tmp);
		    stat = lib$sub_times(&p->ldtrc$q_end_time, &p->ldtrc$q_start_time, &restim);
		    signal_error(stat, 0, 0);
		    j = p->ldtrc$q_end_usec - p->ldtrc$q_start_usec;
		    if (j < 0)					// # of seconds increased?
			j += 1000000;				// Add one second worth of microseconds
		    sprintf(tmp, "%02.2s.%06.6Ld", cvttime(&restim, 1, 1), j);
		    strcat(record, tmp);
	        } else if (time_delta) {
		    if (prev_tim == 0) {
		        strcat(record, " 00:00:00.000000 ");
		    } else {
		        stat = lib$sub_times(&p->ldtrc$q_end_time, &prev_tim, &restim);
		        if (!(stat & 1)) {
			    if (stat == LIB$_NEGTIM) {
			        stat = lib$sub_times(&prev_tim, &p->ldtrc$q_end_time, &restim);
			        signal_error(stat, 0, 0);
			        strcat(record, "-");
			    } else {
			        signal_error(stat, 0, 0);
			    }
		        } else {
			    strcat(record, " ");
			}
			j = p->ldtrc$q_end_usec - prev_usec;
			if (j < 0)			// # of seconds increased?
			    j += 1000000;		// Add one second worth of microseconds
			sprintf(tmp, "%8.8s.%06.6Ld ", cvttime(&restim, 0, 1), j);
			strcat(record, tmp);
		    }
		    stat = lib$sub_times(&p->ldtrc$q_end_time, &p->ldtrc$q_start_time, &restim);
		    signal_error(stat, 0, 0);
		    j = p->ldtrc$q_end_usec - p->ldtrc$q_start_usec;
		    if (j < 0)				// # of seconds increased?
			j += 1000000;			// Add one second worth of microseconds
		    sprintf(tmp, "%02.2s.%06.6Ld", cvttime(&restim, 1, 1), j);
		    strcat(record, tmp);
		    prev_tim = p->ldtrc$q_end_time;
		    prev_usec = p->ldtrc$q_end_usec;
	        } else if (time_start) {
		    sprintf(tmp, "%8.8s.%06.6Ld ",cvttime(&p->ldtrc$q_start_time, 0, 1), p->ldtrc$q_start_usec);
		    strcat(record, tmp);
	        } else if (time_end) {
		    sprintf(tmp, "%8.8s.%06.6Ld ",cvttime(&p->ldtrc$q_end_time, 0, 1),p->ldtrc$q_end_usec);
		    strcat(record, tmp);
	        }
	        strcat(record, " ");
	    }
	    if (pid > 0) {					// Pid
	        sprintf(tmp, "%08X ", p->ldtrc$l_pid);
	        strcat(record, tmp);
	    }
	    if (lbn > 0) {					// Logical block number
		if (lbn_hex > 0)
		    sprintf(tmp, "  %08X ", p->ldtrc$l_lbn);
		else
		    sprintf(tmp, "%10d ", p->ldtrc$l_lbn);
	        strcat(record, tmp);
	    }
	    if (bytecount > 0) {				// Bytecount
		if (bytecount_hex > 0)
		    sprintf(tmp, " %05X ", p->ldtrc$l_bcnt);
		else
		    sprintf(tmp, "%6d ", p->ldtrc$l_bcnt);
	        strcat(record, tmp);
	    }
	    if (iosb > 0) {					// I/O status block
	        if (iosb_hex)
		    sprintf(tmp, "%08.8X ", p->ldtrc$l_iosb[0]);
	        else if (iosb_longhex)
		    sprintf(tmp, "%08.8X %08.8X ", p->ldtrc$l_iosb[0], p->ldtrc$l_iosb[1]);
	        else if (iosb_text) {
	            if ((p->ldtrc$l_iosb[0] == SS$_FDT_COMPL) && (p->ldtrc$l_iosb[1] == 0) && (p->ldtrc$l_lbn == 0) && (p->ldtrc$l_bcnt == 0))
		        sprintf(tmp,"%-8s","FDT");
		    else
		        sprintf(tmp, "%-7s ", ssdef((p->ldtrc$l_iosb[0]) & 0xffff));
	        } else if (iosb_combination) {
		    if (func == IO$_SENSEMODE)
		        j = 0;
		    else
		        j = ((p->ldtrc$l_iosb[0] >> 16) & 0xffff) +
		    	    ((p->ldtrc$l_iosb[1] & 0xffff) << 16);
	            if ((p->ldtrc$l_iosb[0] ==  SS$_FDT_COMPL) && (p->ldtrc$l_iosb[1] == 0) && (p->ldtrc$l_lbn == 0) && (p->ldtrc$l_bcnt == 0))
		        sprintf(tmp,"%-15s","FDT");
		    else
		        sprintf(tmp, "%-7s %6d ", ssdef((p->ldtrc$l_iosb[0]) & 0xffff), j);
	        }
	        strcat(record, tmp);
	    }
	    if (function > 0) {					// I/O function code
	        if (function_hex)
		    sprintf(tmp, "%04.4X ", p->ldtrc$w_func);
	        else if (function_text)
		    sprintf(tmp, "%s ", decode_func(p->ldtrc$w_func));
	        strcat(record, tmp);
	    }
	    if (!(*record))
	        break;						// Nothing to display, quit
	    j = strlen(record);
	    record[j - 1] = '\n';				// Zap trailing space
	    record[j] = '\0';
	    if ((stat = fprintf(outfile, "%s", record)) <= 0)
	        lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
	}
	p++;							// Next record
    }
}

//
//  Convert status to readable code
//

char *ssdef(int code)
{
    static char msgbuf[64];
    $DESCRIPTOR(msgdsc, msgbuf);
    int stat;
    unsigned short rlen;

    stat = sys$getmsg(code, &rlen, &msgdsc, 2, 0);
    signal_error(stat, 0, 0);
    msgbuf[rlen] = '\0';					// Trailing zero
    return &msgbuf[1];						// Remove leading %
}

//
//  Process input file
//

void process_input()
{
    char *buf, *savbuf;
    LD_OVRRUN *ovrbuf, *savovrbuf;
    char *infilename;
    int infilei;
    FILE *infile;
    char namebuf[32];
    char nodebuf[32];
    char timestmp[24];
    char dna[64];
    int i;
    int size;
    int recnum;
    int overruncnt;
    int version;
    int overrun;

    sprintf(dna,"dna=%s",lx_trace_binary_name);
    if ((infilename = getqualstring(&sw_input)) == 0)		// Get input filename
	infilename = fullfilespec("", lx_trace_binary_name);	// Provide default
    else
	infilename = fullfilespec(infilename, lx_trace_binary_name);	// Provide default
    if (((infilei = open(infilename, O_RDONLY, 0, dna, "ctx=bin")) < 0) ||
	((infile = fdopen(infilei, "rb")) == NULL))
	lib$signal((unsigned int) &ld_infilerr, 1, infilename, vaxc$errno, 0);	// Can't open input file
    if (fread(&version, sizeof(int), 1, infile) != 1)		// Get datafile version
	 lib$signal((unsigned int) &ld_filreaderr, 1, infilename, vaxc$errno, 0);	// Can't read input file
    version = (version >> 24) & 0xff;
    if ((version == 0) ||					// Old version ?
	(version != DATA_FILE_VERSION))				// Incompatible version ?
	lib$signal((unsigned int) &ld_cantreadoldfmt, 1, version);	// Can't read old input file
    if ((fread(namebuf, 32, 1, infile) != 1) ||			// Get devicename
	(fread(nodebuf, 32, 1, infile) != 1) ||			// Get nodename
	(fread(timestmp, 24, 1, infile) != 1))			// Get timestamp
	lib$signal((unsigned int) &ld_filreaderr, 1, infilename, vaxc$errno, 0);	// Can't read input file
    s_device = namebuf;						// Point to devicename
    recnum = 0;
    overruncnt = 0;
    buf = savbuf = 0;
    ovrbuf = savovrbuf = 0;
    while (1) {
	if ((fread(&size, sizeof(int), 1, infile) != 1) ||	// Get number of records
	     (fread(&overrun, sizeof(int), 1, infile) != 1))	// Get number of overruns
	     lib$signal((unsigned int) &ld_filreaderr, 1, infilename, vaxc$errno, 0);	// Can't read input file
	//
	//  We will call realloc to increase the size of our databuffer. The data
	//  remains valid up till the address where we've written it before.
	//
	if ((savbuf = realloc(buf, (size + recnum) * LDTRC$C_LENGTH)) == 0)
	     signal_error(SS$_INSFMEM, 0, 0);			// Not enough memory
	buf = savbuf;						// Save new address
	savbuf += (recnum * LDTRC$C_LENGTH);			// Start writing from here
	if (overrun != 0) {
	    if ((savovrbuf = realloc(ovrbuf, (overruncnt + 1)
				     * sizeof(LD_OVRRUN))) == 0)
		 signal_error(SS$_INSFMEM, 0, 0);		// Not enough memory
	    ovrbuf = savovrbuf;					// Save new address
	    savovrbuf += overruncnt;				// Count total number of overruns
	    savovrbuf->ldovr$l_recnum = recnum;			// Save recordnumber with overflow
	    savovrbuf->ldovr$l_overrun = overrun;		// Save count of overruns for this record
	    overruncnt++;					// One more
	}
	recnum += size;						// Total number of data records
	if (fread(savbuf, LDTRC$C_LENGTH, size, infile) != size)	// Get data
	     lib$signal((unsigned int) &ld_filreaderr, 1, infilename, vaxc$errno, 0);	// Can't read input file
	//
	//  fread returns a 0 on EOF as well as when an error occurred. Since we want
	//  to distinguish these two we try to read one more byte to find the difference
	//
	if ((i = fgetc(infile)) == EOF)
	    break;						// Ready for processing
	else
	    ungetc(i, infile);					// Return character and try again
    }
    process_trace(buf, recnum, ovrbuf, overruncnt, nodebuf, timestmp, 0);
    free(buf);							// Return buffer
    if (ovrbuf != 0)
	free(ovrbuf);						// Return buffer
    if (fclose(infile) < 0)					// Close input file
	lib$signal((unsigned int) &ld_closerr, 1, infilename, vaxc$errno, 0);
}

//
// Decode the I/O function to readable text
//

char *decode_func(int what)
{
    static char funcstr[80];
    char str[80];
    int modifier;
    int function;

    if (what == 0xffff)
        return ("All");
    modifier = what & ~IO$M_FCODE;				// Get modifier bits
    function = what & IO$M_FCODE;				// Get functioncode bits
    if (!modifier)						// No modifiers present
	return cvttbl[function];				// Return pointer to function
    else {
	*str = '\0';;
	switch (function) {
	case IO$_PACKACK:
	    chk_mod(&modifier, IO$M_INHERLOG, "INHERLOG", str);
	    chk_mod(&modifier, IO$M_MSCP_FORMAT, "MSCP_FORMAT", str);
	    chk_mod(&modifier, IO$M_BYPASS_VALID_CHK, "BYPASS_VALID_CHK", str);
	    chk_mod(&modifier, IO$M_CLSEREXCP, "CLSEREXCP", str);
	    break;
	case IO$_AVAILABLE:
	    chk_mod(&modifier, IO$M_INHERLOG, "INHERLOG", str);
	    chk_mod(&modifier, IO$M_ALLHOSTS, "ALLHOSTS", str);
	    chk_mod(&modifier, IO$M_DISSOLVE, "DISSOLVE", str);
	    chk_mod(&modifier, IO$M_NOCLEANUP, "NOCLEANUP", str);
	    chk_mod(&modifier, IO$M_CLSEREXCP, "CLSEREXCP", str);
	    break;
	case IO$_REMSHAD:
	    chk_mod(&modifier, IO$M_SPINDOWN, "SPINDOWN", str);
	    break;
	case IO$_SENSECHAR:
	case IO$_SENSEMODE:
	    chk_mod(&modifier, IO$M_SHADOW, "SHADOW", str);
	    chk_mod(&modifier, IO$M_MT3_DENSITY, "MT3_DENSITY", str);
	    chk_mod(&modifier, IO$M_CLSEREXCP, "CLSEREXCP", str);
	    break;
	case IO$_SETMODE:
	case IO$_SETCHAR:
	    chk_mod(&modifier, IO$M_ABORT, "ABORT", str);
	    chk_mod(&modifier, IO$M_MT3_DENSITY, "MT3_DENSITY", str);
	    chk_mod(&modifier, IO$M_CLSEREXCP, "CLSEREXCP", str);
	    break;
	case IO$_UNLOAD:
	    chk_mod(&modifier, IO$M_CLSEREXCP, "CLSEREXCP", str);
	    chk_mod(&modifier, IO$M_NOWAIT, "NOWAIT", str);
	    chk_mod(&modifier, IO$M_INHRETRY, "INHRETRY", str);
	    break;
	case IO$_DSE:
	    chk_mod(&modifier, IO$M_DATACHECK, "DATACHECK", str);
	    chk_mod(&modifier, IO$M_ERASE, "ERASE", str);
	    break;
	case IO$_WRITEOF:
	case IO$_WRITEVBLK:
	case IO$_WRITELBLK:
	case IO$_WRITEPBLK:
	    chk_mod(&modifier, IO$M_TRUSTED, "TRUSTED", str);
	    chk_mod(&modifier, IO$M_EXFUNC, "EXFUNC", str);
	    chk_mod(&modifier, IO$M_INHERLOG, "INHERLOG", str);
	    chk_mod(&modifier, IO$M_DATACHECK, "DATACHECK", str);
	    chk_mod(&modifier, IO$M_CLSEREXCP, "CLSEREXCP", str);
	    chk_mod(&modifier, IO$M_INHRETRY, "INHRETRY", str);
	    chk_mod(&modifier, IO$M_ERASE, "ERASE", str);
	    chk_mod(&modifier, IO$M_MSCPMODIFS, "MSCPMODIFS", str);
	    chk_mod(&modifier, IO$M_REVERSE, "REVERSE", str);
	    break;
	case IO$_READVBLK:
	case IO$_READLBLK:
	case IO$_READPBLK:
	    chk_mod(&modifier, IO$M_NOVCACHE, "NOVCACHE", str);
	    chk_mod(&modifier, IO$M_TRUSTED, "TRUSTED", str);
	    chk_mod(&modifier, IO$M_EXFUNC, "EXFUNC", str);
	    chk_mod(&modifier, IO$M_INHERLOG, "INHERLOG", str);
	    chk_mod(&modifier, IO$M_DATACHECK, "DATACHECK", str);
	    chk_mod(&modifier, IO$M_CLSEREXCP, "CLSEREXCP", str);
	    chk_mod(&modifier, IO$M_INHRETRY, "INHRETRY", str);
	    chk_mod(&modifier, IO$M_REVERSE, "REVERSE", str);
	    break;
	case IO$_ACCESS:
	case IO$_DEACCESS:
	case IO$_MODIFY:
	case IO$_CREATE:
	case IO$_DELETE:
	case IO$_ACPCONTROL:
	    chk_mod(&modifier, IO$M_ACCESS, "ACCESS", str);
	    chk_mod(&modifier, IO$M_CREATE, "CREATE", str);
	    chk_mod(&modifier, IO$M_DELETE, "DELETE", str);
	    chk_mod(&modifier, IO$M_DMOUNT, "DMOUNT", str);
	    chk_mod(&modifier, IO$M_EXFUNC, "EXFUNC", str);
	    break;
	case IO$_SKIPFILE:
	case IO$_SKIPRECORD:
	    chk_mod(&modifier, IO$M_ALLOWFAST, "ALLOWFAST", str);
	    chk_mod(&modifier, IO$M_ALLOWFAST_NEVER, "ALLOWFAST_NEVER", str);
	    chk_mod(&modifier, IO$M_ALLOWFAST_PER_IO, "ALLOWFAST_PER_IO", str);
	    chk_mod(&modifier, IO$M_ALLOWFAST_ALWAYS, "ALLOWFAST_ALWAYS", str);
	    chk_mod(&modifier, IO$M_NOWAIT, "NOWAIT", str);
	    chk_mod(&modifier, IO$M_INHRETRY, "INHRETRY", str);
	    break;
	case IO$_REWIND:
	case IO$_REWINDOFF:
	    chk_mod(&modifier, IO$M_CLSEREXCP, "CLSEREXCP", str);
	    chk_mod(&modifier, IO$M_NOWAIT, "NOWAIT", str);
	    chk_mod(&modifier, IO$M_INHRETRY, "INHRETRY", str);
	    chk_mod(&modifier, IO$M_RETENSION, "RETENSION", str);
	    break;
	default:
	    break;
	}
	sprintf(funcstr, "%s%s", cvttbl[function], str);	// Form function string
	if (modifier & ~IO$M_FCODE)				// Any modifiers left ?
	    sprintf(funcstr, "%s (%08.8X)", funcstr, modifier);	// Show excess modifiers
	return (funcstr);					// Return pointer to string
    }
}

//
// Check if bit set in modifier function, and copy function to
// output string if true.
//

void chk_mod(int *modifier, int mask, char *modifstr, char *outstr)
{
    if (*modifier & mask) {					// Check if mask bit set
	strcat(outstr, "|");					// Concatenate bar
	strcat(outstr, modifstr);				// Concatenate inpout string
	*modifier &= ~mask;					// Flags this bit as processed
    }
}

//
//  Convert binary time to ascii,
//  return only the time and not the date
//

char *cvttime(uint64 *time, int how, int full)
{
    unsigned short rlen;
    int stat;
    LD_DSC timdsc;
    static char timstr[256];

    timdsc.dsc$l_length = 256;
    timdsc.dsc$a_dpointer = timstr;
    stat = sys$asctim(&rlen, &timdsc, (GENERIC_64 *) time, full);	// Convert binary time to ascii
    signal_error(stat, 0, 0);
    timstr[rlen] = '\0';					// Add trailing zero
    if (how)							// Display only seconds
	return (&timstr[6]);
    return timstr;
}

#endif // SYSINIT_OPCCRASH

//
//  Open specified file
//  For the SYSINIT path, the filename will actually be a directory ID + file ID
//  in the form: "(dm,dn,dp) (fm,fn,fp)". In this case, SYS$SYSDEVICE is assumed.
//

void open_file(char *name, int sharing, int *maxblk, int mode)
{

    // mode = 0: open for write
    // mode = 1: open for read (analyze)
    // mode = 2: open container file

    int stat;
    int i;
    int didfid[6];
    IOSB iosb;
    ATRDEF atr[2];
    char devnam[256];

    static XAB_CACHING_OPTIONS_FLAGS cacheopts;
    static LD_ITEMLIST items[2];

    ld_fab.fab$l_dna = ".DSK";					// Default extension
    ld_fab.fab$b_dns = 4;					// and length
    ld_fab.fab$l_fop = FAB$M_NAM;				// Use NAM block
    ld_fab.fab$l_nam = &ld_nam;					// Pointer to NAM block

#ifdef SYSINIT_OPCCRASH

    char *begin_ptr = name + 1;		// skip '('
    char *end_ptr;
    unsigned short chan;
    stat = sys$assign(&sysdevice, &chan, 0, 0, 0);		// Assign channel
    getdevnam(chan, devnam);
    i = (strlen(devnam) < 255) ? strlen(devnam) : 255;
    strncpy(realspec, devnam, i);
    realspec[i] = '\0';						// Make sure it's terminated
    strncat(realspec, s_fid, 255 - strlen(realspec));
    realspec_dsc.dsc$a_dpointer = realspec;			// Get real filespec
    realspec_dsc.dsc$l_length = strlen(realspec);
    ldfilename_dsc.dsc$a_dpointer = s_fid; 			// Get filename without device
    ldfilename_dsc.dsc$l_length = strlen(s_fid);
    devnam[strlen(devnam)-1] = '\0';			// strip trailing ':'
    realdev_dsc.dsc$a_dpointer = devnam;			// Get devicename
    realdev_dsc.dsc$l_length = strlen(devnam);
    strncpy(&ld_nam.nam$t_dvi[1], devnam, sizeof(ld_nam.nam$t_dvi) - 1);
    ld_nam.nam$t_dvi[0] = (strlen(devnam) < 15 ? strlen(devnam) : 15);

    didfid[0] = strtol (begin_ptr, &end_ptr, 10);
    begin_ptr = end_ptr + 1;		// skip ','
    didfid[1] = strtol (begin_ptr, &end_ptr, 10);
    begin_ptr = end_ptr + 1;		// skip ','
    didfid[2] = strtol (begin_ptr, &end_ptr, 10);
    begin_ptr = end_ptr + 3;		// skip ') ('
    didfid[3] = strtol (begin_ptr, &end_ptr, 10);
    begin_ptr = end_ptr + 1;		// skip ','
    didfid[4] = strtol (begin_ptr, &end_ptr, 10);
    begin_ptr = end_ptr + 1;		// skip ','
    didfid[5] = strtol (begin_ptr, &end_ptr, 10);

    ld_nam.nam$w_did_num = (unsigned short int)(didfid[0] & 0xFFFF);
    ld_nam.nam$b_did_nmx = (unsigned short int)(didfid[0] >> 16);
    ld_nam.nam$w_did_seq = (unsigned short int)didfid[1];
    ld_nam.nam$b_did_rvn = (unsigned short int)didfid[2];
    ld_nam.nam$w_fid_num = (unsigned short int)(didfid[3] & 0xFFFF);
    ld_nam.nam$b_fid_nmx = (unsigned short int)(didfid[3] >> 16);
    ld_nam.nam$w_fid_seq = (unsigned short int)didfid[4];
    ld_nam.nam$b_fid_rvn = (unsigned short int)didfid[5];

#else // SYSINIT_OPCCRASH

    ld_fab.fab$l_fna = name;					// File name address
    ld_fab.fab$b_fns = strlen(name);				// and length

#endif // SYSINIT_OPCCRASH

    ld_fab.fab$l_xab = &ld_xabfhc;				// Point to FHC XAB
    ld_fab.fab$b_rtv = 255;					// Open with cathedral windows
    ld_nam.nam$b_rss = NAM$C_MAXRSS;				// Max. resultant size
    ld_nam.nam$l_rsa = resspec;					// Resultant address
    ld_nam.nam$b_ess = NAM$C_MAXRSS;				// Max. expanded size
    ld_nam.nam$l_esa = expspec;					// Expanded address
    ld_nam.nam$b_nop = NAM$M_NOCONCEAL;				// Don't hide concealed devices

    if (sharing)
	ld_fab.fab$b_shr = FAB$M_SHRGET | FAB$M_SHRPUT;
    if (mode == 0)
	ld_fab.fab$b_fac = FAB$M_GET;				// For checking
    else if (mode == 1)
	ld_fab.fab$b_fac = FAB$M_BIO | FAB$M_GET;		// For analyze
    else if (mode == 2) {
	if (tape)						// Real container file open
	    ld_fab.fab$b_fac = FAB$M_PUT | FAB$M_GET;
	else
	    ld_fab.fab$b_fac = FAB$M_GET;
    }

    if (mode == 2) {
	ld_xabfhc.xab$l_nxt = &ld_xabitm;			// Link next xab
	cacheopts.xab$v_file_attributes = 0;
	cacheopts.xab$v_file_contents = XAB$K_NOCACHING;	// Disable caching of data
	cacheopts.xab$v_flush_on_close= XAB$K_FLUSH;		// Flush on close
	cacheopts.xab$v_cachectl_mbz = 0;
	items[0].lditmlst$w_buflen = sizeof(cacheopts);		// Descriptor for cache options
	items[0].lditmlst$w_item = XAB$_CACHING_OPTIONS;
	items[0].lditmlst$ps_addr = (char *) &cacheopts;	// Point to options
	items[0].lditmlst$l_rlength = 0;
	items[1].lditmlst$w_buflen = 0;				// Terminate list
	items[1].lditmlst$w_item = 0;
	ld_xabitm.xab$b_cod = XAB$C_ITM;			// Init xabitm
	ld_xabitm.xab$b_bln = XAB$C_ITMLEN;
	ld_xabitm.xab$l_itemlist = &items;			// Point to itemlist
	ld_xabitm.xab$b_mode = XAB$K_SETMODE;
	ld_xabitm.xab$l_nxt = 0;
    }

#ifndef SYSINIT_OPCCRASH

    stat = sys$parse(&ld_fab);					// Parse this one
    if (!(stat & 1))
	lib$signal((unsigned int) &ld_openerr, 1, name, ld_fab.fab$l_sts, ld_fab.fab$l_stv);
    //
    // Copy devicename + directoryname. This is done to include possible
    // rooted devicenames which we will lose after the open
    //
    i = ld_nam.nam$b_dev + ld_nam.nam$b_dir;
    strncpy(realspec, ld_nam.nam$l_dev, i);
    realspec[i] = '\0';						// Make sure it's terminated

#endif // SYSINIT_OPCCRASH

    stat = sys$open(&ld_fab);					// And open it
    if (!(stat & 1))
	lib$signal((unsigned int) &ld_openerr, 1, name, ld_fab.fab$l_sts, ld_fab.fab$l_stv);

#ifndef SYSINIT_OPCCRASH

    strncat(&realspec[i], ld_nam.nam$l_name, ld_nam.nam$b_name +// Append rest
	    ld_nam.nam$b_type + ld_nam.nam$b_ver);
    realspec_dsc.dsc$a_dpointer = realspec;			// Get real filespec
    realspec_dsc.dsc$l_length = strlen(realspec);
    ldfilename_dsc.dsc$a_dpointer = &realspec[ld_nam.nam$b_dev];// Get filename without device
    ldfilename_dsc.dsc$l_length = strlen(realspec) - ld_nam.nam$b_dev;
    realdev_dsc.dsc$a_dpointer = ld_nam.nam$l_dev;		// Get real devicename
    realdev_dsc.dsc$l_length = ld_nam.nam$b_dev;

#endif // SYSINIT_OPCCRASH

    if (maxblk) {
        *maxblk = ld_xabfhc.xab$l_ebk;				// Get current eof pointer
        if (ld_xabfhc.xab$w_ffb == 0)				// Adjust if necessary
	    (*maxblk)--;
    }

    if (mode == 2) {

	// The open was successfull. For a containerfile we will close it and
	// re-open it by file-id so that we can open it without interlocks.

	stat = sys$close(&ld_fab);				// Close RMS file
	if (!(stat & 1))
	    lib$signal((unsigned int) &ld_closerr, 1, name, ld_fab.fab$l_sts, ld_fab.fab$l_stv);

	stat = sys$assign(&realdev_dsc, &fchan, 0, 0, 0);	// Assign channel to device
	signal_error(stat, 0, 0);				// where file resides

	bzero((void *) &fib, sizeof(fib));
	fib.fib$w_fid[0] = ld_nam.nam$w_fid[0];			// Get file-id
	fib.fib$w_fid[1] = ld_nam.nam$w_fid[1];
	fib.fib$w_fid[2] = ld_nam.nam$w_fid[2];
	if (tape) fib.fib$v_write = 1;				// We want to be able to write it
	fib.fib$b_wsize = -1;					// Open with cathedral windows
	fib.fib$v_flush_on_close = FIB$C_FLUSH;			// Make sure that all caching is disabled
	fib.fib$v_file_contents = FIB$C_NOCACHING;
	fib.fib$v_file_attributes = 0;
	fib_dsc.dsc$a_dpointer = (char *) &fib;			// Point to FIB
	fib_dsc.dsc$l_length = FIB$K_LENGTH;
	stat = sys$qiow(0, fchan, IO$_ACCESS | IO$M_ACCESS, &iosb, 0, 0,
			(void *) &fib_dsc, 0, 0, 0, 0, 0);	// Access the file
	signal_error(stat, iosb.iosb$w_status, 0);
    }
}

#ifndef SYSINIT_OPCCRASH

//
// Flush the XFC for the specified file
//

void flush_xfc(char *name, int sharing)
{
    struct xfcfib {
	union {
	    FIBDEF f;
	    FIBDEF1 f1;
        } u;
    } lfib;
    int stat;
    char recbuf[512];
    IOSB iosb;
    unsigned short fchan;
    LD_DSC devdsc;
    LD_DSC fibdsc;

    open_file(name, sharing, 0, 0);				// Open file to get file-id
    bzero((void *) &lfib, sizeof(lfib));

    devdsc.dsc$a_dpointer = ld_nam.nam$l_dev;			// Get real devicename
    devdsc.dsc$l_length = ld_nam.nam$b_dev;

    lfib.u.f.fib$w_fid[0] = ld_nam.nam$w_fid[0];		// Get file-id
    lfib.u.f.fib$w_fid[1] = ld_nam.nam$w_fid[1];
    lfib.u.f.fib$w_fid[2] = ld_nam.nam$w_fid[2];
    lfib.u.f.fib$v_norecord = 1;				// Don't record update
    lfib.u.f.fib$v_write = 1;					// Allow writes
    close_file(name);
    stat = sys$assign(&devdsc, &fchan, 0, 0, 0);		// Assign channel to device
    signal_error(stat, 0, 0);					// where file resides
    fibdsc.dsc$a_dpointer = (char *) &lfib;			// Point to FIB
    fibdsc.dsc$l_length = sizeof(lfib);
    stat = sys$qiow(0, fchan, IO$_ACCESS | IO$M_ACCESS, &iosb, 0, 0,
		    (void *) &fibdsc, 0, 0, 0, 0, 0);		// Access the file
    //
    // Continue on success, quit on writelock or access conflict error
    //
    if ((stat & 1) && (iosb.iosb$w_status != SS$_WRITLCK) && (iosb.iosb$w_status != SS$_ACCONFLICT)) {
	signal_error(stat, iosb.iosb$w_status, 0);
	//
	// Disable caching for this file
	//
	lfib.u.f.fib$v_file_attributes = 0;
	lfib.u.f.fib$v_file_contents = ATR$C_NOCACHING;
	lfib.u.f.fib$v_flush_on_close = ATR$C_FLUSH;
	lfib.u.f.fib$v_caching_options_mbz = 0;
	lfib.u.f1.fib$l_cntrlval = lfib.u.f.fib$l_caching_options;
	lfib.u.f1.fib$w_cntrlfunc = FIB$C_CACHING_OPTIONS;
	//
	// Tell the xqp to disable caching. The xqp will tell the xfc
	//
	stat = sys$qiow(0, fchan, IO$_ACPCONTROL, &iosb, 0, 0,
			&fibdsc, 0, 0, 0, 0, 0);		// Set access to 'no cache'
	signal_error(stat, iosb.iosb$w_status, 0);
	//
	// Read first block
	//
	stat = sys$qiow(0, fchan, IO$_READVBLK, &iosb, 0, 0,
			&recbuf, sizeof(recbuf), 1, 0, 0, 0);
	//
	// Check for end of file. It is now allowed to have a 0 block container file
	// to start with, and if thats true it makes no sense to flush the cache anyway.
	//
	if (iosb.iosb$w_status != SS$_ENDOFFILE) {
	    signal_error(stat, iosb.iosb$w_status, 0);
	    //
	    // Rewrite block - This will force the XFC to flush the cache for this file
	    //
	    stat = sys$qiow(0, fchan, IO$_WRITEVBLK, &iosb, 0, 0,
			    &recbuf, sizeof(recbuf), 1, 0, 0, 0);
	    signal_error(stat, iosb.iosb$w_status, 0);
	}
	stat = sys$qiow(0, fchan, IO$_DEACCESS, &iosb, 0, 0,
			&fibdsc, 0, 0, 0, 0, 0);		// Deaccess the file
	signal_error(stat, iosb.iosb$w_status, 0);
    }
    stat = sys$dassgn(fchan);					// And get rid of channel
    signal_error(stat, 0, 0);
}

//
//  Close file opened with 'open_file'
//

void close_file(char *filename)
{
    int stat;

    stat = sys$close(&ld_fab);					// Close RMS file
    if (!(stat & 1))
	lib$signal((unsigned int) &ld_closerr, 1, filename, ld_fab.fab$l_sts, ld_fab.fab$l_stv);
    signal_error(stat, 0, 0);
}

//
//  Disconnect file from LD device
//

void disconnect_unit()
{
    int stat;
    int q_abort;
    int q_truncate;
    int loop = 0;
    int nonode = 0;
    char matchname[256];
    $DESCRIPTOR(matchdev, matchname);
    LD_DSC wildname;
    unsigned short rlen;
    int devclass;
    LD_ITEMLIST item[] = {sizeof(devclass), DVS$_DEVCLASS, (char *) &devclass, 0, 0, 0, 0, 0};
    GENERIC_64 context = { 0 };

    wildname.dsc$a_dpointer = lx_wildname;
    wildname.dsc$l_length = strlen(lx_wildname);
    if (tape)
	devclass = DC$_TAPE;
    else
	devclass = DC$_DISK;

    enable_privs(PRV$M_PHY_IO);
    s_device = getqualstring(&sw_device);			// Get device name
    q_abort = getqual(&sw_abort) > 0;				// Get 'abort' qualifier
    q_truncate = getqual(&sw_truncate) > 0;			// Get 'truncate' qualifier
    if (getqual(&sw_all) > 0) {					// /ALL ?
	stat = 1;
	while (stat & 1) {					// Loop until we're done
	    stat = sys$device_scan(&matchdev, &rlen, &wildname, &item, &context);
	    if (stat == SS$_NOMOREDEV) {
		if (nonode) {
		    if (loop == 0)
			lib$signal((unsigned int) &ld_nounitsfound, 1, matchname);
		    else
			return;					// No more, quit
		} else {
		    nonode = 1;
		    stat = 1;
		    wildname.dsc$a_dpointer = lx_wildname_nonode;
		    wildname.dsc$l_length = strlen(lx_wildname_nonode);
		    continue;
		}
	    }
	    signal_error(stat, 0, 0);
	    matchname[rlen] = '\0';				// Place terminator
	    if (nonode && strchr(matchname,'$'))
		continue;
	    if (get_unit(matchname,1) != 0) {
		loop++;
		disconnect_one(matchname, q_abort, q_truncate, 0, 0);	// Disconnect this device
	    }
	}
    } else {
	disconnect_one(s_device, q_abort, q_truncate, 1, 0);
    }
}

#endif // SYSINIT_OPCCRASH

//
// Disconnect a single device
//

void disconnect_one(char *dev, int abortflag, int truncate, int single, int keep)
{
    char ldfile[256];
    char lddev[64];
    LD_DSC sdev;
    char *devstr;
    int stat;
    unsigned short chan;
    int func;
    int replacefl;
    IOSB iosb;
    LD_FLAGS *ioflgs;
    FIDDEF fid;

    devstr = fulldevspec(dev);					// Save devicename while it's still there
    if (get_unit(devstr, 1) == 0) {				// Don't use unit 0 
	if (single)
	    lib$signal((unsigned int) &ld_badunit, 1, devstr);	// Show it to the world
	else
	    return;
    }
    sdev.dsc$a_dpointer = dev;
    sdev.dsc$l_length = strlen(dev);
    stat = sys$assign(&sdev, &chan, 0, 0, 0);			// Assign channel
    if (stat == SS$_DEVALLOC) {					// Allocated on remote node ?
	lib$signal((unsigned int) &ld_remotealloc, 1, devstr);
    } else {
	signal_error(stat, 0, 0);
	if (keep)
	    func = LDIO$K_UNLOAD;				// Unload only, disconnect file but keep device around
	else
	    func = LDIO$K_DISCONNECT;				// Normal function

	if (!abortflag) {					// No /ABORT ?
	    stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,
		   lddev, sizeof(lddev), (int64) &fid, 0, 0, LDIO$K_GET_CONNECTION);	// Get current status
	    if (iosb.iosb$w_status != SS$_DEVINACT)		// Filter DEVINACT (not connected)
		signal_error(stat, iosb.iosb$w_status, 0);
	    ioflgs = (LD_FLAGS *) &iosb.iosb$l_dev_depend;
	    if ((!tape && ioflgs->ldflg$v_tape) ||		// Check for right device type
		(tape && !ioflgs->ldflg$v_tape)) {
		lib$signal((unsigned int) &ld_incmpdevtype, 0);
		return;
	    }
	    if (ioflgs->ldflg$v_connected) {			// Check 'connected' flag from driver
		lddev[iosb.iosb$w_bcnt] = '\0';			// Terminate string
		if (ioflgs->ldflg$v_replaced || ioflgs->ldflg$v_lbn)// Check special flags from driver
		    {
		    strcpy(ldfile, lddev);
		    }
		else
		    {
		    create_filename(lddev,&fid,ldfile);
		    }
	    } else {
		strcpy(ldfile, "(nothing)");
	    }
	} else {
	    func |= LDIO$M_ABORT;				// Some more for abort
	    strcpy(ldfile,"(not available)");
        }
	if (tape && truncate && ioflgs->ldflg$v_extend)		// Only if extend was enabled
	    func |= LDIO$M_TRUNCATE;				// Signal truncate desired
	stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,	// Issue disconnect
		    0, 0, 0, 0, 0, func);

#ifndef SYSINIT_OPCCRASH

	signal_error(stat, iosb.iosb$w_status, 0);

#endif // SYSINIT_OPCCRASH

	stat = sys$dassgn(chan);				// Get rid of channel

#ifndef SYSINIT_OPCCRASH

	signal_error(stat, 0, 0);
	open_file(ldfile, 0, 0, 0);				// Open again
	setfilechar(FC_NOCACHING);				// Set file to no_caching
	close_file(ldfile);
	if (getqual(&sw_log) > 0)				// /LOG ?
	    lib$signal((unsigned int) &ld_disconnected, 2, devstr, ldfile);	// Show what we did

#endif // SYSINIT_OPCCRASH

    }
}


#ifndef SYSINIT_OPCCRASH

//
// Analyze container file (tape only)
//

void analyze()
{
    int i;
    int j;
    int stat;
    int recsize;
    int records;
    int records_hex;
    int data;
    int directory;
    int directory_hex;
    int cont;
    int stop = 0;
    int eov = 0;
    int eofrecord = 0;
    int errdetected = 0;
    int prvrecnumdata = 0;
    int prvrecnumdir = 0;
    uint64 lbn = 0;
    uint64 offset = 0;
    int padding;
    int size;
    int donefirstdata = 0;
    int donefirstdir = 0;
    int dirvalid = 0;
    int datastart;
    int outflg;
    uint64 bytes_read = 0;
    uint64 totalbytes_read = 0;
    uint64 databytes_read = 0;
    uint64 eof_count = 0;
    uint64 rec_count = 0;
    uint64 dir_offset = 0;
    uint64 prv_dir_offset = 0;
    uint64 entry_content = 0;
    uint64 *r;
    char *p;
    char *destadr;
    char *bufstart;
    char *bufend;
    char *overflow_area;
    char *yellow_zone;
    char *lastadr;
    LDTPHD *hdr;
    LDTPTR *trl;
    LDTPMD *md;
    LDTPDIR *dir;
    char flgstr[80];
    char tmpstr[256];
    char mdbuf[LDTPMD$K_LENGTH];
    char recbuf[RECBUF_SIZE];

    if (!tape)
	lib$signal((unsigned int) &ld_incmpdevtype, 0);

    // Use a data buffer with some reserved space in front of it.
    // As soon as we hit a so called 'yellow zone' near the end during buffer
    // processing we will move the remainder of the data at the end of the buffer
    // to the area in the front, refill the buffer at the original start so
    // that we are able to continue to process records that cross a block
    // boundary.

    overflow_area = &recbuf[0];
    bufstart = &recbuf[OVERFLOW_AREA_SIZE];
    yellow_zone = &recbuf[RECBUF_SIZE - OVERFLOW_AREA_SIZE];
    bufend = &recbuf[RECBUF_SIZE];
    destadr = 0;

    s_file = getqualstring(&sw_file);				// Get filespec
    records = getqual(&sw_records);				// /RECORDS ?
    records_hex = getqual(&sw_records_hex);			// /RECORDS=HEX?
    data = getqual(&sw_data);					// /DATA ?
    if (data > 0)
	records = 1;						// Force records with data
    directory = getqual(&sw_directory);				// /DIRECTORY ?
    directory_hex = getqual(&sw_directory_hex);			// /DIRECTORY=HEX?
    cont = getqual(&sw_cont);					// /CONT ?

    outflg = getqual(&sw_output);				// /OUTPUT ?
    if (outflg > 0) {
	outfilename = getqualstring(&sw_output);		// Get filename
	outfilename = fullfilespec(outfilename, lx_analyze_name); // Provide default
	outfilei = creat(outfilename, 0, "rfm=var", "rat=cr");
	if ((outfilei < 0) || ((outfile = fdopen(outfilei, "a+")) == NULL))
	    lib$signal((unsigned int) &ld_outfilerr, 1, outfilename, vaxc$errno, 0);	// Can't open output file
    } else if (outflg < 0)					// /NOOUTPUT ?
	return;
    else
	outfile = stdout;					// Default output

    lib$establish(&analyze_handler);				// Establish a condition handler

    open_file(s_file, 0, 0, 1);					// Attempt normal open

    ld_rab64.rab64$l_fab = &ld_fab;				// Point to FAB
    ld_rab64.rab64$l_bkt = 0;					// Read next bucket
    ld_rab64.rab64$l_rop = RAB$M_BIO;				// Block I/O
    ld_rab64.rab64$pq_ubf = bufstart;				// Record buffer
    ld_rab64.rab64$l_ubf = (char *) -1;

    stat = sys$connect((RABDEF *) &ld_rab64);			// Hook up RAB
    if (!(stat & 1))
	lib$signal((unsigned int) &ld_openerr, 1, s_file, ld_rab64.rab64$l_sts, ld_rab64.rab64$l_stv);
    //
    // Start with reading the metadata
    //
    ld_rab64.rab64$q_usz = METADATA_SIZE;			// Record size
    stat = sys$read((RABDEF *) &ld_rab64);			// Get record
    if (stat & 1) {
	bcopy(bufstart, mdbuf, sizeof(mdbuf));			// Save metadata
	md = (LDTPMD *) mdbuf;					// Point to start of data
	if ((strncmp((char *) &md->ldtpmd$l_tag, LDTPMD_TAG, strlen(LDTPMD_TAG)) == 0) && // Valid tag
	    (calc_checksum((void *) md, METADATA_SIZE))) {	// and checksum?
	    dirvalid = md->ldtpmd$v_dirvalid;			// Save directory valid bit
	    if (dirvalid)
		dir_offset = md->ldtpmd$q_dirstart;		// Remember start of directory
	    datastart = md->ldtpmd$l_datastart;			// Save start of data position
	    show_tape_metadata(md);
	} else {
	    md = 0;						// Metadata invalid
	    datastart = 1;					// Default is 1 with invalid metadata
	    lib$signal((unsigned int) &ld_nometadata, 0);
	}
    }
    if (!(stat & 1))
	lib$stop((unsigned int) &ld_filreaderr, 1, s_file, ld_rab64.rab64$l_sts, ld_rab64.rab64$l_stv);
    ld_rab64.rab64$q_usz = DATA_BUFFER_SIZE;			// Record size
    p = bufstart;						// Point to start of data
    lastadr = 0;
    stat = 1;
    for (;;) {
	if (stop)						// Stop requested
	    break;
	if (!(stat & 1) && (stat != RMS$_EOF))			// Some error, not being EOF
	    break;
	//
	// stat indicates success. If it is RMS$_EOF we have read the last
	// part of the file, but still have to check the rest of the buffer
	//
	if (stat != RMS$_EOF) {
	    stat = sys$read((RABDEF *) &ld_rab64);		// Get next record
	    if (!(stat & 1) && (stat != RMS$_EOF))
		break;						// Some error, not being EOF
	    recsize = (int) ld_rab64.rab$q_rsz;			// Get record size
	    if (stat == RMS$_EOF)
		lastadr = bufstart + recsize;
	}
	for (;;) {
	    lbn = (((int) p - (int) bufstart) >> 9) + (bytes_read >> 9) + 1; // Calculate expected lbn
	    offset = ((int) p - (int) bufstart) + bytes_read;	// Calculate expected offset
	    hdr = (LDTPHD *) p;					// Point to header in record

	    if (md) {						// Metadata available?

		// Check for freshly inited zero blocks tape

		if (md->ldtpmd$q_datasize == 0) {
		    stop = 1;
		    break;
		}

		// Check if we have data beyond what metadata says

		if ((md->ldtpmd$q_datasize < lbn) && !errdetected) {
		    if (fprintf(outfile, "Error: there is data beyond the metadata limit, expected %0LX, actual %0LX\n",
				md->ldtpmd$q_datasize, lbn) <= 0)
			lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
		    errdetected = lbn;
		}
	    }

	    if (strncmp((char *) &hdr->ldtphd$l_tag, LDTPHD_TAG, strlen(LDTPHD_TAG)) != 0) {
	    	if (!donefirstdata) {
		    //
		    // This is the first time we're here, and we don't have a valid tag.
		    // This is just a blank tape.
		    //
		    lib$signal((unsigned int) &ld_blanktape, 0);
		} else {
		    //
		    // The tag of the header record is bad
		    //
		    if (fprintf(outfile, "Error: invalid header, expected %08.8X, actual %08.8X\n",
				LDTPHD_TAG_HEX, hdr->ldtphd$l_tag) <= 0)
			lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
		    errdetected = lbn;
		}
		stop = 1;
		break;
	    } else {
		//
		// Calculate padding in data record. When writing all records are padded
		// to a longword length to avoid alignment faults, so we must take care
		// of that when reading them.
		//
		padding = 3 - ((hdr->ldtphd$l_bcnt + 3) & 3);
		if (records > 0) {
		    //
		    // Show record details
		    //
		    if (records_hex > 0) {
			if (fprintf(outfile, "Record: %8X Offset: %14LX Lbn: %10LX Length: %8X",hdr->ldtphd$l_recnum,
				hdr->ldtphd$q_offset, (uint64) ((hdr->ldtphd$q_offset / 512) + datastart),
				hdr->ldtphd$l_bcnt) <= 0)
			    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
		    } else {
			if (fprintf(outfile, "Record: %8d Offset: %14Ld Lbn: %10Ld Length: %8d",hdr->ldtphd$l_recnum,
				hdr->ldtphd$q_offset, (uint64) ((hdr->ldtphd$q_offset / 512) + datastart),
				hdr->ldtphd$l_bcnt) <= 0)
			    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
		    }
		    flgstr[0] = '\0';
		    if (hdr->ldtphd$v_eof)
			strcat(flgstr,"EOF ");
		    if (hdr->ldtphd$v_eov)
			strcat(flgstr,"EOV ");
		    if (hdr->ldtphd$v_eot)
			strcat(flgstr,"EOT ");
		    if (hdr->ldtphd$v_eod)
			strcat(flgstr,"EOD ");
		    if (hdr->ldtphd$v_dir)
			strcat(flgstr,"DIR ");
		    if (hdr->ldtphd$v_pe)
			strcat(flgstr,"PE ");
		    if (hdr->ldtphd$v_ecc)
			strcat(flgstr,"ECC ");
		    if (*flgstr) {
			if (fprintf(outfile, " Flags: %s",flgstr) <= 0)
			    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
		    }
		    if (fprintf(outfile, "\n") <= 0)
			lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
		}
		if (!hdr->ldtphd$v_eod) {			// Only check if not end of data
		    if (eov && !hdr->ldtphd$v_dir) {
			//
			// We hit end of volume, but got no end of data record
			// following it...
			//

// Disable double eof check for now. It appears that INIT may write records that way.

//			if (fprintf(outfile, "Error: two consecutive filemarks detected, but there's more data following that\n") <= 0)
//			    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
			eov = 0;
//			errdetected = lbn;
//			if (!cont) {
//			    stop = 1;
//			    break;
//		        }
		    }
		    if (hdr->ldtphd$l_bcnt > 65535){ 
			//
			// The bytecount is bigger than the maximum tape record length
			//
			if (fprintf(outfile, "Error: record bytecount (%d) > 65535\n", hdr->ldtphd$l_bcnt) <= 0)
			    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
			errdetected = lbn;
			if (!cont) {
			    stop = 1;
			    break;
		        }
		    }
		    //
		    // Point to trailer in record
		    //
		    trl = (LDTPTR *) ((int) hdr + hdr->ldtphd$l_bcnt + LDTPHD$K_LENGTH + padding);
		    if (strncmp((char *) &trl->ldtptr$l_tag, LDTPTR_TAG, strlen(LDTPTR_TAG)) != 0) {
			//
			// The tag of the trailer record is bad
			//
			if (fprintf(outfile, "Error: invalid trailer, expected %08.8X, actual %08.8X\n",
				LDTPTR_TAG_HEX, trl->ldtptr$l_tag) <= 0)
			    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
			errdetected = lbn;
			if (!cont) {
			    stop = 1;
			    break;
			}
		    }
		    if (hdr->ldtphd$l_bcnt != trl->ldtptr$l_bcnt) {
			//
			// The bytecount in the header and the trailer should be the same
			//
			if (fprintf(outfile, "Error: header bytecount (%d) != trailer bytecount (%d)\n",
				hdr->ldtphd$l_bcnt, trl->ldtptr$l_bcnt) <= 0)
			    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
			errdetected = lbn;
			if (!cont) {
			    stop = 1;
			    break;
			}
		    }
		    if (hdr->ldtphd$v_eof) {					// EOF record
			//
			// Check if we get two EOF's in a row. It had better be at the
			// end of the file.
			//
			if (eofrecord == 0)
			    eofrecord = hdr->ldtphd$l_recnum;			// Save EOF position
			else {
			    if ((eofrecord + 1) == hdr->ldtphd$l_recnum)	// Two EOF's in a row
				eov = 1;					// Signal EOV
			}
		    } else {
			eofrecord = 0;						// No eof, clear position
		    }
		    if (!donefirstdata && !hdr->ldtphd$v_dir) {
			donefirstdata = 1;
			if (hdr->ldtphd$l_recnum != 0) {
			    //
			    // The first record should be zero
			    //
			    if (fprintf(outfile, "Error: the first data record number should be zero, it is %d\n",
				    hdr->ldtphd$l_recnum) <= 0)
				lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
			    errdetected = lbn;
			    if (!cont) {
				stop = 1;
				break;
			    }
			}
		    }
		    if (!donefirstdir && hdr->ldtphd$v_dir) {
			donefirstdir = 1;
			if (hdr->ldtphd$l_recnum != 0) {
			    //
			    // The first record should be zero
			    //
			    if (fprintf(outfile, "Error: the first directory record number should be zero, it is %d\n",
				    hdr->ldtphd$l_recnum) <= 0)
				lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
			    errdetected = lbn;
			    if (!cont) {
				stop = 1;
				break;
			    }
			}
		    }
		    if (!hdr->ldtphd$v_dir) {
			if ((prvrecnumdata != 0) && (hdr->ldtphd$l_recnum != (prvrecnumdata + 1))) {
			    //
			    // The data records should be numbered in sequence
			    //
			    if (fprintf(outfile, "Error: data header record number (%d) != previous record number + 1 (%d)\n",
				    hdr->ldtphd$l_recnum, prvrecnumdata + 1) <= 0)
				lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
			    errdetected = lbn;
			    if (!cont) {
			 	stop = 1;
				break;
			    }
			}
		    } else {
			if (!dirvalid) {
			    //
			    // The directory valid bit is clear , and we now have a directory record
			    //
			    if (fprintf(outfile, "Error: directory not valid, but we got a directory record.") <= 0)
				lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
			    errdetected = lbn;
			    if (!cont) {
			 	stop = 1;
				break;
			    }
			}
			dir = (LDTPDIR *) (p + LDTPHD$K_LENGTH);	// Point to start of directory
			if (strncmp((char *) &dir->ldtpdir$l_tag, LDTPDIR_TAG, strlen(LDTPDIR_TAG)) != 0) { // Valid tag?
			    //
			    // The tag of the directory header is bad
			    //
			    if (fprintf(outfile, "Error: invalid directory header, expected %08.8X, actual %08.8X\n",
				    LDTPDIR_TAG_HEX, dir->ldtpdir$l_tag) <= 0)
				lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
			    errdetected = lbn;
			    if (!cont) {
			 	stop = 1;
				break;
			    }
			}
			if ((prvrecnumdir != 0) && (hdr->ldtphd$l_recnum != (prvrecnumdir + 1))) {
			    //
			    // The directory records should be numbered in sequence
			    //
			    if (fprintf(outfile, "Error: directory header record number (%d) != previous record number + 1 (%d)\n",
				    hdr->ldtphd$l_recnum, prvrecnumdir + 1) <= 0)
				lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
			    errdetected = lbn;
			    if (!cont) {
			 	stop = 1;
				break;
			    }
			}
			if (hdr->ldtphd$q_offset != dir->ldtpdir$q_offset) {
			    //
			    // The directory has a bad current offset
			    //
			    if (fprintf(outfile, "Error: directory header offset (%Ld) != record header offset (%Ld)\n",
				    dir->ldtpdir$q_offset, hdr->ldtphd$q_offset) <= 0)
				lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
			    errdetected = lbn;
			    if (!cont) {
			 	stop = 1;
				break;
			    }
			}
			if (dir->ldtpdir$q_prevoffset != prv_dir_offset) {
			    //
			    // The previous pointer to the directory is wrong
			    //
			    if (fprintf(outfile, "Error: the previous directory offset (%Ld) != previous directory header offset (%Ld)\n",
				    prv_dir_offset, dir->ldtpdir$q_prevoffset) <= 0)
				lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
			    errdetected = lbn;
			    if (!cont) {
			 	stop = 1;
				break;
			    }
			}
			if (dir->ldtpdir$q_offset != dir_offset) {
			    //
			    // The pointer to the directory is wrong
			    //
			    if (fprintf(outfile, "Error: the pointer to the directory (%Ld) != directory header offset (%Ld)\n",
				    dir_offset, dir->ldtpdir$q_offset) <= 0)
				lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
			    errdetected = lbn;
			    if (!cont) {
			 	stop = 1;
				break;
			    }
			}
			dir_offset = dir->ldtpdir$q_nextoffset;
			prv_dir_offset = dir->ldtpdir$q_offset;			// Remember this place
			//
			// Validate directory contents. Every entry should be bigger than the previous one.
			//
			r = (uint64 *) &dir->ldtpdir$a_index;			// Point to index (past header)
			for (i = 0; i < dir->ldtpdir$l_count; i++) {
			    j = *r++ & ~1;					// Get first offset. Remove eof bit.
			    if ((j <= entry_content) && (i > 0)) {
				//
				// The contents of the directory are not in ascending order
				//
				if (fprintf(outfile, "Error: directory contents are not in ascending oder (%Ld - %Ld) at index %d\n",
					j, entry_content, i) <= 0)
				    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
				errdetected = lbn;
				if (!cont) {
				    stop = 1;
				    break;
				}
			    }
			    entry_content = j;
			}
			if (stop)
			    break;
		    }
		    if (hdr->ldtphd$q_offset != offset) {
			//
			// The offset in the record is not what we expect
			//
			if (fprintf(outfile, "Error: record offset (%Ld) != expected offset (%Ld)\n",
				hdr->ldtphd$q_offset, offset) <= 0)
			    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
			errdetected = lbn;
			if (!cont) {
			    stop = 1;
			    break;
			}
		    }
		    if (data > 0 && !hdr->ldtphd$v_dir)
			dumpbuf(p + LDTPHD$K_LENGTH, hdr->ldtphd$l_bcnt);	// Dump the data in hex and ascii
		    if (directory > 0 && hdr->ldtphd$v_dir)
			dumpdir(p + LDTPHD$K_LENGTH, hdr->ldtphd$l_bcnt, (LDTPMD *) md, records, directory_hex);// Dump the directory
		    if (hdr->ldtphd$v_dir)
			prvrecnumdir = hdr->ldtphd$l_recnum;	// Save previous record number
		    else
			prvrecnumdata = hdr->ldtphd$l_recnum;	// Save previous record number
		}
	    }
	    rec_count++;					// Count this record
	    databytes_read += hdr->ldtphd$l_bcnt;		// Total number of bytes
	    if (hdr->ldtphd$v_eof)				// Update eof counter
	    	eof_count++;
	    if (hdr->ldtphd$v_eod) {				// Stop on end of data
		stop = 2;
		destadr = 0;
		break;
	    }
	    p += (hdr->ldtphd$l_bcnt + LDTPHD$K_LENGTH + LDTPTR$K_LENGTH + padding);	// Pointer to next record
	    if (lastadr != 0) {
		//
		// We have hit end of file. Check for data past the end
		//
		if (p >= lastadr) {
		    //
		    // The file has no end of tape marker
		    //
		    if (fprintf(outfile, "Error: no end of tape marker found\n") <= 0)
			lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
		    stop = 1;
		    errdetected = lbn;
		    break;
		}
	    } else {
		if ((int) p >= (int) yellow_zone) {
		    //
		    // The current record crosses the yellow zone. Move the remaining data
		    // to a place in front of the real data buffer so that we can process it
		    // after reading the next part
		    //
		    size = (int) bufend - (int) p;
		    destadr = (char *) ((int) bufstart - size);
		    bcopy(p, destadr, size);
		    p = destadr;
		    break;
		}
	    }
	}
	totalbytes_read += ld_rab64.rab$q_rsz;
	if (!stop)
	    bytes_read += ld_rab64.rab$q_rsz;			// Keep track of total bytes read
    }
    if (!(stat & 1) && (stat != RMS$_EOF))
	lib$signal((unsigned int) &ld_filreaderr, 1, s_file, ld_rab64.rab64$l_sts, ld_rab64.rab64$l_stv);
    if (dir_offset != 0) {
	//
	// A directory entry points to a non-existent directory record
	//
	if (fprintf(outfile, "Error: directory entry points to a non-existent directory record (%Ld)\n",
		dir_offset) <= 0)
	    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
	errdetected = lbn;
    }
    if (errdetected == 0) {
	lib$signal((unsigned int) &ld_analyzeok, 0);
	if ((fprintf(outfile, "Bytes read:\t%12Ld\n", totalbytes_read) <= 0) ||
	    (fprintf(outfile, "Records read:\t%12Ld\n", rec_count) <= 0) ||
	    (fprintf(outfile, "Databytes read:\t%12Ld\n", databytes_read) <= 0) ||
	    (fprintf(outfile, "Eof count:\t%12Ld\n", eof_count) <= 0))
	    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
    } else {
	//
	// Stop on an error. Show where it occurred
	//
	lib$signal((unsigned int) &ld_analyzeerr, errdetected);
    }
    close_file(s_file);
    if ((outfile != stdout)) {					// Close output file
	if (fclose(outfile) < 0)
	    lib$signal((unsigned int) &ld_closerr, 1, outfilename, vaxc$errno, 0);
    }
}

//
//  Show tape container file metadata
//

void show_tape_metadata(LDTPMD *md)
{
    char flgstr[80];

    lib$signal((unsigned int) &ld_metadata, 0);

    if ((fprintf(outfile, "\nVersion:\t\t %d\n", md->ldtpmd$l_version) <= 0) ||
	(fprintf(outfile, "Creator:\t\t %-12.12s\n", (char *) &md->ldtpmd$t_username) <= 0) ||
	(fprintf(outfile, "Process name:\t\t %-15.15s\n", (char *) &md->ldtpmd$t_procname) <= 0) ||
	(fprintf(outfile, "Account:\t\t %-8.8s\n", (char *) &md->ldtpmd$t_account) <= 0) ||
	(fprintf(outfile, "UIC:\t\t\t [%o,%o]\n", (md->ldtpmd$l_uic >> 16), (md->ldtpmd$l_uic & 0xffff)) <= 0) ||
	(fprintf(outfile, "Created on system:\t %8.8s\n", (char *) &md->ldtpmd$t_create_node) <= 0) ||
	(fprintf(outfile, "VMS version:\t\t %8.8s\n", (char *) &md->ldtpmd$t_vms_version) <= 0) ||
	(fprintf(outfile, "Time at creation:\t %s\n", cvttime(&md->ldtpmd$q_create_time, 0, 0)) <= 0) ||
	(fprintf(outfile, "Time at last connect:\t %s\n", cvttime(&md->ldtpmd$q_connect_time, 0, 0)) <= 0) ||
	(fprintf(outfile, "Time at last disconnect: %s\n", cvttime(&md->ldtpmd$q_disconnect_time, 0, 0)) <= 0) ||
	(fprintf(outfile, "Data start:\t\t %Ld\n", md->ldtpmd$q_datastart) <= 0) ||
	(fprintf(outfile, "Data size:\t\t %Ld\n", md->ldtpmd$q_datasize) <= 0))
	lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
    if (md->ldtpmd$v_dirvalid) {
	if (fprintf(outfile, "Directory start:\t %Ld (Lbn %Ld)\n", md->ldtpmd$q_dirstart,
		(int) ((md->ldtpmd$q_dirstart / 512) + md->ldtpmd$q_datastart)) <= 0)
	    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
    }
    flgstr[0] = '\0';
    if (md->ldtpmd$v_tagsinuse)
	strcat(flgstr,"tagsinuse ");
    if (md->ldtpmd$v_dirvalid)
	strcat(flgstr,"dirvalid");
    if (*flgstr) {
	if (fprintf(outfile, "Flags:\t\t\t %s\n", flgstr) <= 0)
	    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
    }
    if (fprintf(outfile, "Checksum:\t\t %X\n\n", md->ldtpmd$l_checksum) <= 0)
	lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
}

//
//  Condition handler for analyze.
//

int analyze_handler(struct chf$signal_array *sigarr,
		     struct chf$mech_array *mecharr)
{
    int status;
    unsigned short rlenout;
    unsigned short rlenfao;
    char outbuf[1024];
    $DESCRIPTOR(outdsc, outbuf);
    char faobuf[1024];
    $DESCRIPTOR(faodsc, faobuf);
    int *argptr;

    if (sigarr->chf$is_sig_name == (int) &ld_filwrterr)				// Resignal on output file write error
	return SS$_RESIGNAL;

    status = lib$sys_getmsg((unsigned int *) &sigarr->chf$is_sig_name, &rlenout, &outdsc);	// Get original message
    if ($VMS_STATUS_SUCCESS(status)) {
	outbuf[rlenout] = '\0';							// Terminate
	if (sigarr->chf$l_sig_args >= 1) {					// If there's at least one argument
            argptr = (int *) &sigarr->chf$l_sig_arg1;				// Point to first argument
	    outdsc.dsc$w_length = rlenout;
	    status = sys$fao(&outdsc, &rlenfao, &faodsc,			// Format it
			     argptr[0],
			     argptr[1],
			     argptr[2],
			     argptr[3],
			     argptr[4],
			     argptr[5]);
	    if ($VMS_STATUS_SUCCESS(status)) {
		faobuf[rlenfao] = '\0';						// Terminate
		fprintf(outfile, "%s\n", faobuf);				// Write to output
	    } else {
		return status;
	    }
	} else {
	    outbuf[rlenout] = '\0';						// Terminate
	    fprintf(outfile, "%s\n", outbuf);					// Write to output
	}
    }
    return SS$_CONTINUE;
}

//
//  Initialize tape container file metadata
//

void init_tape_metadata(LDTPMD *md, int size)
{
    int stat;
    IOSB iosb;
    char nodename[9];
    LD_ITEMLIST jpi_item[] =
      {8, JPI$_ACCOUNT, (char *) &md->ldtpmd$t_account, 0,
       12, JPI$_USERNAME, (char *) &md->ldtpmd$t_username, 0,
       16, JPI$_PRCNAM, (char *) &md->ldtpmd$t_procname, 0,
       sizeof(int), JPI$_UIC, &md->ldtpmd$l_uic, 0,
       0, 0, 0, 0};
    LD_ITEMLIST item[] =
      {8, SYI$_NODENAME, (char *) &md->ldtpmd$t_create_node, 0,
       8, SYI$_VERSION, (char *) &md->ldtpmd$t_vms_version, 0,
       0, 0, 0, 0};

    bzero((void *) md, METADATA_SIZE);
    md->ldtpmd$l_tag = LDTPMD_TAG_HEX;
    md->ldtpmd$l_version = METADATA_VERSION;

    stat = sys$getjpiw(0, 0, 0, &jpi_item, &iosb, 0, 0);		// Get job info
    signal_error(stat, iosb.iosb$w_status, 0);
    stat = sys$getsyiw(0, 0, 0, &item, &iosb, 0, 0);			// Get system info
    signal_error(stat, iosb.iosb$w_status, 0);
    stat = sys$gettim((struct _generic_64 *) &md->ldtpmd$q_create_time);// Get timestamp
    signal_error(stat, 0, 0);
    //
    // The nodename from getsyi is padded with 0. The internal nodename
    // from the driver is padded with blanks. Make them the same.
    //
    sprintf(nodename, "%-8.8s", (char *) &md->ldtpmd$t_create_node);
    bcopy(nodename, (char *) md->ldtpmd$t_create_node, sizeof(md->ldtpmd$t_create_node));
    md->ldtpmd$q_connect_time = md->ldtpmd$q_create_time;
    md->ldtpmd$q_disconnect_time = md->ldtpmd$q_create_time;
    md->ldtpmd$q_datastart = (METADATA_SIZE / 512);
    md->ldtpmd$q_datasize = (__int64) size - md->ldtpmd$q_datastart;
    md->ldtpmd$v_tagsinuse = 1;
    calc_checksum((void *) md, METADATA_SIZE);				// Update cehcksum
}

//
//  Initialize tape container file end of tape record
//

void init_tape_eod(void *rec)
{
    LDTPHD *hdr = (LDTPHD *) rec;
    LDTPTR *trl = (LDTPTR *) ((char *) rec + LDTPHD$C_LENGTH);

    hdr->ldtphd$l_tag = LDTPHD_TAG_HEX;
    hdr->ldtphd$q_recnum = 0;
    hdr->ldtphd$q_offset = 0;
    hdr->ldtphd$l_bcnt = 0;
    hdr->ldtphd$l_flags = LDTPHD$M_EOD;
    trl->ldtptr$l_tag = LDTPTR_TAG_HEX;
    trl->ldtptr$l_bcnt = 0;
}

//
//  Calculate checksum over metadata buffer
//

int calc_checksum(void * buffer, int size)
{
    int checksum;
    int stat;
    int *p;
    int count;

    checksum = 0;
    p = (int *) buffer;
    count = (size - sizeof(int)) / sizeof(int);
    //
    // Calculate the checksum over longwords, where the last
    // longword of the buffer contains the checksum
    //
    while (count--)
	checksum += *(p++);
    stat = (checksum == *p) ? 1 : 0;
    //
    // Save checksum in last longword
    //
    *p = checksum;
    return stat;
}

//
//  Dump tape directory
//

void dumpdir(char *vp, int len, LDTPMD *md, int records, int directory_hex)
{
    LDTPDIR *dir;
    uint64 *r;
    int i, j;
    int datastart;
    char *p;

    dir = (LDTPDIR *) vp;
    r = (uint64 *) &dir->ldtpdir$a_index;			// Point to index (past header)
    if (md)							// Only use datastart if metadata is valid
	datastart = md->ldtpmd$l_datastart;
    else
	datastart = 1;

    if ((fprintf(outfile, "\nDirectory:\n") <= 0) ||
        (fprintf(outfile, "Number of entries:\t%6d\n", dir->ldtpdir$l_count) <= 0))
	lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
    if (directory_hex > 0) {
	if ((fprintf(outfile, "Directory record:\t%6X\n", dir->ldtpdir$l_recnum) <= 0) ||
	    (fprintf(outfile, "Offset:\t\t%14LX Lbn: %8LX\n", dir->ldtpdir$q_offset,
		(int) ((dir->ldtpdir$q_offset / 512) + datastart)) <= 0) ||
	    (fprintf(outfile, "Previous offset:%14LX Lbn: %8LX\n", dir->ldtpdir$q_prevoffset,
		(int) ((dir->ldtpdir$q_prevoffset / 512) + datastart)) <= 0) ||
	    (fprintf(outfile, "Next offset:\t%14LX Lbn: %8LX\n", dir->ldtpdir$q_nextoffset,
		(int) ((dir->ldtpdir$q_nextoffset / 512) + datastart)) <= 0))
	    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);
    } else {
	if ((fprintf(outfile, "Directory record:\t%6d\n", dir->ldtpdir$l_recnum) <= 0) ||
	    (fprintf(outfile, "Offset:\t\t%14Ld Lbn: %8Ld\n", dir->ldtpdir$q_offset,
		(int) ((dir->ldtpdir$q_offset / 512) + datastart)) <= 0) ||
	    (fprintf(outfile, "Previous offset:%14Ld Lbn: %8Ld\n", dir->ldtpdir$q_prevoffset,
		(int) ((dir->ldtpdir$q_prevoffset / 512) + datastart)) <= 0) ||
	    (fprintf(outfile, "Next offset:\t%14Ld Lbn: %8Ld\n", dir->ldtpdir$q_nextoffset,
		(int) ((dir->ldtpdir$q_nextoffset / 512) + datastart)) <= 0))
	    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);
    }
    if (records > 0) {						// Dump directory records
	for (i = 0; i < dir->ldtpdir$l_count; i++) {
	    j = *r & ~1;
	    p = "";
	    if (*r++ & 1)
		p = " Flags: EOF";
	    if (directory_hex > 0) {
		if (fprintf(outfile, "Entry:  %8X Offset: %14LX Lbn: %10LX%s\n", i, j,
			(j / 512) + datastart, p) <= 0)
		    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);
	    } else {
		if (fprintf(outfile, "Entry:  %8d Offset: %14Ld Lbn: %10Ld%s\n", i, j,
			(j / 512) + datastart, p) <= 0)
		    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);
	    }
	}
    }
    if (fprintf(outfile, "\n") <= 0)
	lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);
}

//
//  Dump buffer in Hex and Ascii
//

void dumpbuf(char *vp, int len)
{
    const unsigned char *cp = (const unsigned char *)vp;
    unsigned char ch;
    char buf[256];
    char *bp;
    char *ap;
    int width;
    int cnt;
    int end;

    if ((width = get_term_width()) > 0) {
	memset(buf, ' ', sizeof buf);
	cnt = 0;
	bp = buf;
	if (width < 132)
	    end = 38;
	else
	    end = 74;
	ap = buf + end;
	while (--len >= 0) {
	    ch = *cp++;
	    *bp++ = hex[(ch >> 4) & 0xf];
	    *bp++ = hex[ch & 0xf];
	    if (!(++cnt % 4))
		*bp++ = ' ';
	    *ap++ = printable[ch];
	    if (((width < 132) && ((bp - buf) >= 36)) ||
		((bp - buf) >= 72)) {
		*ap = 0;
		if (fprintf(outfile, "   %s\n", buf) <= 0)
		    lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
		memset(buf, ' ', sizeof buf);
		cnt = 0;
		bp = buf;
		ap = buf + end;
	    }
	}
	if (bp > buf) {
	    *ap = 0;
	    if (fprintf(outfile, "   %s\n", buf) <= 0)
		lib$signal((unsigned int) &ld_filwrterr, 1, outfilename, vaxc$errno, 0);	// Can't write output file
	}
    }
}

//
//  Create a container file
//

void create()
{
    int stat;
    int cloneavail;
    int q_size;
    int tracks;
    int sectors;
    int cylinders;
    int maxblock;
    int lbn;
    int contiguous;
    int extend;
    int extend_error = 0;
    int org_alq;
    int network_disk;
    int nohwm;
    int zero = 0;
    int mode;
    char dummy[512];
    LDTPMD tape_meta;
    char tape_eod[512];
    LD_METADATA mdat;
    LD_DSC dskdev;

    tracks = sectors = cylinders = maxblock = 0;
    lbn = getqualvalue(&sw_lbn);
    s_file = getqualstring(&sw_file);				// Get filespec
    s_file = fullfilespec(s_file, ".DSK");
    if ((cli$present(&sw_size) & 1)) {
        if ((q_size = getqualvalue(&sw_size)) == 0)		// /SIZE specified, get filesize
	    q_size = 1;						// Make it minimal 1
    } else {
	if (tape)
	    q_size = 5000;					// Default for tape
	else
	    q_size = 512;					// Default for disk
    }
    cloneavail = getclonedata(&tracks, &sectors, &cylinders, &maxblock);
    if (cloneavail) {
	if (q_size < maxblock)					// Allow a bigger size if specified
	    q_size = maxblock;
    } else {
        tracks = getqualvalue(&sw_tracks);			// Get number of tracks
        sectors = getqualvalue(&sw_sectors);			// Get number of sectors
        cylinders = getqualvalue(&sw_cylinders);		// Get number of cylinders
        maxblock = getqualvalue(&sw_maxblocks);			// Get number of maxblocks
    }        
    //
    //  First create a file of 0 blocks. That way we can be sure to write our user
    //  attributes in the fileheader, even for a very fragmented file. We'll extend
    //  the file to the real size after we wrote the attributes.
    //
    contiguous = getqual(&sw_contiguous) > 0; 			// /CONTIGUOUS ?
    ld_fab.fab$l_dna = ".DSK";					// Default extension
    ld_fab.fab$b_dns = 4;					// and length
    ld_fab.fab$l_fop = FAB$M_NAM | FAB$M_OFP; 			// NAM
    if ((extend = getqual(&sw_extend)) > 0)
        ld_fab.fab$l_fop |= FAB$M_CIF;
    else
        ld_fab.fab$l_fop |= FAB$M_TMP;
    ld_fab.fab$l_alq = 0;
    if (getqual(&sw_lbn) > 0) {					// /LBN=xxx ?
        ld_fab.fab$l_xab = &ld_xaball;
        ld_xaball.xab$l_nxt = &ld_xabpro;
        ld_xaball.xab$b_aln = XAB$C_LBN;
        ld_xaball.xab$b_aop = XAB$M_HRD;
        ld_xaball.xab$l_loc = lbn;
        if (contiguous)
            ld_xaball.xab$b_aop |= XAB$M_CTG;
	else
            ld_xaball.xab$b_aop |= XAB$M_CBT;
    } else {
        ld_fab.fab$l_xab = &ld_xabpro;
        if (contiguous)
            ld_fab.fab$l_fop |= FAB$M_CTG;
	else
            ld_fab.fab$l_fop |= FAB$M_CBT;
    }
    ld_fab.fab$b_org = FAB$C_SEQ;				// Sequential
    ld_fab.fab$b_rfm = FAB$C_FIX;				// Fixed
    ld_fab.fab$w_mrs = 512;					// 512 byte records
    ld_fab.fab$l_nam = &ld_nam;					// NAM block
    ld_fab.fab$l_fna = s_file;					// Filename
    ld_fab.fab$b_fns = strlen(s_file);				// and length

    ld_nam.nam$b_rss = NAM$C_MAXRSS;				// Max. resultant size
    ld_nam.nam$l_rsa = resspec;					// Resultant address
    ld_nam.nam$b_ess = NAM$C_MAXRSS;				// Max. expanded size
    ld_nam.nam$l_esa = expspec;					// Expanded address

    ld_xabpro.xab$b_prot_opt = XAB$M_PROPAGATE;			// Propagate security and file attributes

    stat = sys$parse(&ld_fab);					// Parse filename
    if (!(stat & 1))
	lib$signal((unsigned int) &ld_createrr, 1, s_file, ld_fab.fab$l_sts, ld_fab.fab$l_stv);
    if (ld_nam.nam$v_node)					// May not contain node spec
	lib$signal((unsigned int) &ld_createrr, 1, s_file, RMS$_SUPPORT);
    if (ld_nam.nam$v_wildcard)					// or wildcard
	lib$signal((unsigned int) &ld_createrr, 1, s_file, RMS$_WLD);
    //
    // Check if this device is a network accessible disk and set
    // network_disk to TRUE if that's the case. Some operations are
    // impossible on these type of devices.
    //
    dskdev.dsc$a_dpointer = ld_nam.nam$l_dev;
    dskdev.dsc$l_length = ld_nam.nam$b_dev;

    stat = lib$getdvi(&DVI$_DEVCHAR2, 0, &dskdev, &network_disk, 0, 0);
    signal_error(stat, 0, 0);
    network_disk &= DEV$M_DFS;
    if (network_disk)
	//
	// No TMP file support on NFS disks, so make it a normal file
	//
        ld_fab.fab$l_fop &= ~FAB$M_TMP;

    //
    // Check if highwater marking is on. If true issue a warning that the
    // operation may take a long time to complete if the size of the file
    // to be created exceeds HIGHWATER_WARNING blocks in size. Check only
    // on V8.2 or higher as we can do it with a single getdvi call, on
    // older versions we would need to go to exec mode to retrieve the info.
    //

    stat = lib$getdvi(&DVI$_NOHIGHWATER, 0, &dskdev, &nohwm, 0, 0);
    signal_error(stat, 0, 0);
    if (!nohwm && (q_size >= HIGHWATER_WARNING))
	//
	// Highwater marking is enabled and it's a big file, issue a warning.
	//
	lib$signal((unsigned int) &ld_highwater, 0);

    //
    // Create the file as a TMP file so that it does not get a
    // directory entry. This is done to avoid picking up default
    // acl's from the parent directory, which inhibits writing
    // data in the reserved area of the file header.
    //
    stat = sys$create(&ld_fab);					// Create the file
    if (!(stat & 1))
	lib$signal((unsigned int) &ld_createrr, 1, s_file, ld_fab.fab$l_sts, ld_fab.fab$l_stv);
    if (!extend || (stat == RMS$_CREATED)) {
        memset(&mdat, 0, sizeof(mdat));				// Start with zero
        mdat.ldmtd$l_sectors = sectors;
        mdat.ldmtd$l_tracks = tracks;
        mdat.ldmtd$l_cylinders = cylinders;
        mdat.ldmtd$l_maxblock = maxblock;
        setfilemetadata(&mdat);					// Set container metadata
        ld_fab.fab$l_alq = ld_xaball.xab$l_alq = q_size;	// Filesize
	org_alq = 0;
    } else {
	//
	// For extending an existing file the alq field is added to the file,
	// so subtract the current count to get to the new filesize.
	//
	if (ld_fab.fab$l_alq >= q_size) {
	    //
	    // Someone is trying to fool us by giving a filesize smaller
	    // then the current filesize.
	    //
	    extend_error = 1;
	} else {
	    org_alq = ld_fab.fab$l_alq;
	    ld_fab.fab$l_alq = ld_xaball.xab$l_alq = q_size - ld_fab.fab$l_alq;
	}
    }
    if (!extend_error) {
	stat = sys$extend(&ld_fab);				// Go for the real size now
	if (!(stat & 1))
	    lib$signal((unsigned int) &ld_createrr, 1, s_file, ld_fab.fab$l_sts, ld_fab.fab$l_stv);
    }
    memset(&dummy, 0, sizeof(dummy));				// Start with zero for dummy block
    memset(&tape_eod, 0, sizeof(tape_eod));			// Start with zero for eod
    ld_rab.rab$l_fab = &ld_fab;					// Point to FAB
    ld_rab.rab$b_rac = RAB$C_SEQ;				// Sequential access
    stat = sys$connect(&ld_rab);				// Hook up RAB
    if (!(stat & 1))
	lib$signal((unsigned int) &ld_createrr, 1, s_file, ld_rab.rab$l_sts, ld_rab.rab$l_stv);
    if (tape && !extend) {
	init_tape_metadata(&tape_meta, q_size);			// Setup metadata for tape
	ld_rab.rab$l_rbf = (char *) &tape_meta;			// Metadata buffer
	ld_rab.rab$w_rsz = sizeof(tape_meta);			// Record size
	stat = sys$put(&ld_rab);				// Write metadata
	if (!(stat & 1))
	    lib$signal((unsigned int) &ld_filwrterr, 1, s_file, ld_rab.rab$l_sts, ld_rab.rab$l_stv);
	init_tape_eod(tape_eod);				// Setup eod (End Of Data) record for tape
	ld_rab.rab$l_rbf = tape_eod;				// Metadata buffer
	ld_rab.rab$w_rsz = sizeof(tape_eod);			// Record size
	stat = sys$put(&ld_rab);				// Write eod record
	if (!(stat & 1))
	    lib$signal((unsigned int) &ld_filwrterr, 1, s_file, ld_rab.rab$l_sts, ld_rab.rab$l_stv);
    }
    ld_rab.rab$b_rac = RAB$C_KEY;				// Keyed access
    ld_rab.rab$w_rsz = sizeof(dummy);				// Record size
    ld_rab.rab$l_rbf = dummy;					// Dummy buffer
    ld_rab.rab$l_kbf = (char *) &q_size;			// Pointer to record (last in file)
    stat = sys$put(&ld_rab);					// Put dummy block at end of file
			        				// to get EOF pointer at right place
    if (!(stat & 1))
	//
	// We get RMS$_NEF in return if someone 'extended' a file before the current
	// eof pointer. We could prevent the put but that's a lot more work (using
	// xabfhc) than catching the error which is harmless.
	//
	if (ld_rab.rab$l_sts != RMS$_NEF)			// Ignore NEF (not on EOF)
	    lib$signal((unsigned int) &ld_filwrterr, 1, s_file, ld_rab.rab$l_sts, ld_rab.rab$l_stv);

    stat = sys$close(&ld_fab);					// Close file
    if (!(stat & 1))
	lib$signal((unsigned int) &ld_closerr, 1, s_file, ld_fab.fab$l_sts, ld_fab.fab$l_stv);
    //
    // Now enter the file in the directory, this will propagate security
    // attributes and acl's to the file header
    //
    if (!extend && !network_disk) {
        stat = sys$enter(&ld_fab);
        if (!(stat & 1))
	    lib$signal((unsigned int) &ld_filwrterr, 1, s_file, ld_fab.fab$l_sts, ld_fab.fab$l_stv);
    }
    //
    // Now set the NOMOVE, NOBACKUP and Caching characteristics. We can't
    // do this before because sys$enter will propagate the caching attributes
    // from the parent directory.
    //
    mode = FC_NOMOVE | FC_NOCACHING;
    if (getqual(&sw_backup) < 0)
	mode |= FC_NOBACKUP;
    setfilechar(mode);
    //
    // Erase the file if requested and we did not have an error extending it
    //
    if ((getqual(&sw_erase) > 0) && !extend_error) {
	if (nohwm) {						// Only if highwater marking is disabled
	    //
	    // Erase the file. If we extended then only erase the part that
	    // got extended.
	    //
	    if (extend)
		erasefile(org_alq, org_alq + ld_fab.fab$l_alq);	// Erase added blocks
	    else {
		lbn = (tape ? 1 : 0);				// Start at lbn 1 for tape
								// so we don't overwrite the metadata
		erasefile(lbn, ld_fab.fab$l_alq);		// Erase the file
	    }
	}
    }
    if (getqual(&sw_log) > 0) {					// /LOG ?
	open_file(s_file, 0, 0, 0);				// Open again
	if (extend)
	    lib$signal((unsigned int) &ld_extended, 2, realspec, q_size);	// Show it
	else
	    lib$signal((unsigned int) &ld_created, 1, realspec);// Show it
	close_file(s_file);
    }
}

#endif // SYSINIT_OPCCRASH

//
// Set file characteristics
//

void setfilechar(int how)
{
    int stat;
    unsigned short chan;
    IOSB iosb;
    int attrib;
    ATRDEF atr[3];
    ATR_CACHING_OPTIONS_FLAGS filechar;
    //
    //   Use QIO to modify the attributes since RMS won't support NOMOVE
    //   until VMS V6.0
    //
    fib.fib$w_fid[0] = ld_nam.nam$w_fid[0];			// Get file-id
    fib.fib$w_fid[1] = ld_nam.nam$w_fid[1];
    fib.fib$w_fid[2] = ld_nam.nam$w_fid[2];
    realdev_dsc.dsc$a_dpointer = ld_nam.nam$l_dev;		// Get real devicename
    realdev_dsc.dsc$l_length = ld_nam.nam$b_dev;
    stat = sys$assign(&realdev_dsc, &chan, 0, 0, 0);		// Assign channel to device
    signal_error(stat, 0, 0);					// where file resides
    atr[0].atr$w_size = ATR$S_UCHAR;
    atr[0].atr$w_type = ATR$C_UCHAR;				// Get user file characteristics
    atr[0].atr$l_addr = &attrib;
    atr[1].atr$w_size = ATR$S_CACHING_OPTIONS;
    atr[1].atr$w_type = ATR$C_CACHING_OPTIONS;			// Get file caching options
    atr[1].atr$l_addr = &filechar;
    atr[2].atr$w_size = 0;					// Terminator
    atr[2].atr$w_type = 0;
    fib_dsc.dsc$a_dpointer = (char *) &fib;			// Point to FIB
    fib_dsc.dsc$l_length = FIB$K_LENGTH;
    stat = sys$qiow(0, chan, IO$_ACCESS, &iosb, 0, 0,
		    (void *) &fib_dsc, 0, 0, 0, (int64) &atr, 0);	// Access the file
    signal_error(stat, iosb.iosb$w_status, 0);
    if ((how != FC_NOCACHING) || (filechar.atr$v_file_contents != ATR$C_NOCACHING)) {
	if (how & FC_NOMOVE)
	    attrib |= FCH$M_NOMOVE;				// Mark no move
	if (how & FC_NOBACKUP)
	    attrib |= FCH$M_NOBACKUP;				// Mark no backup
	filechar.atr$v_caching_options_mbz = 0;
	filechar.atr$v_flush_on_close = ATR$C_FLUSH;
	if (how & FC_NOCACHING) {
	    filechar.atr$v_file_attributes = ATR$C_NOCACHING;	// Disable caching
	    filechar.atr$v_file_contents = ATR$C_NOCACHING;
	} else {
	    filechar.atr$v_file_attributes = ATR$C_DEFAULT;
	    filechar.atr$v_file_contents = ATR$C_DEFAULT;
	}
	stat = sys$qiow(0, chan, IO$_MODIFY, &iosb, 0, 0,
			(void *) &fib_dsc, 0, 0, 0, (int64) &atr, 0);	// Access the file
	if (!((how == FC_NOCACHING) && (iosb.iosb$w_status == SS$_WRITLCK)))
	    signal_error(stat, iosb.iosb$w_status, 0);		// Don't care if writelocked if only changing caching
    }
    stat = sys$dassgn(chan);					// Get rid of channel
    signal_error(stat, 0, 0);
}

#ifndef SYSINIT_OPCCRASH

//
// Erase file
//

void erasefile(int start, int end)
{
    int stat;
    int erase_stat;
    unsigned short chan;
    IOSB iosb;
    int ecount;
    unsigned int pattern;
    unsigned int blkcount;
    unsigned int lcount;
    unsigned int vbn;
    LD_DSC fibdsc;
    FIBDEF efib;

    memset(&efib, 0, sizeof(efib));				// Start with zero
    efib.fib$w_fid[0] = ld_nam.nam$w_fid[0];			// Get file-id
    efib.fib$w_fid[1] = ld_nam.nam$w_fid[1];
    efib.fib$w_fid[2] = ld_nam.nam$w_fid[2];
    efib.fib$v_write = 1;
    realdev_dsc.dsc$a_dpointer = ld_nam.nam$l_dev;		// Get real devicename
    realdev_dsc.dsc$l_length = ld_nam.nam$b_dev;
    stat = sys$assign(&realdev_dsc, &chan, 0, 0, 0);		// Assign channel to device
    signal_error(stat, 0, 0);					// where file resides
    fibdsc.dsc$a_dpointer = (char *) &efib;			// Point to FIB
    fibdsc.dsc$l_length = FIB$K_LENGTH;
    stat = sys$qiow(0, chan, IO$_ACCESS | IO$M_ACCESS, &iosb, 0, 0,
		    (void *) &fibdsc, 0, 0, 0, 0, 0);		// Access the file
    signal_error(stat, iosb.iosb$w_status, 0);
    ecount = 1;
    do {
        erase_stat = sys$erapat(ERA$K_DISK, ecount, &pattern);	// Get erase pattern
	if ((erase_stat != SS$_NOTRAN) && (erase_stat & 1)) {
	    blkcount = end - start;				// Number of blocks to erase
            vbn = start + 1;					// VBN's start at 1
	    while (blkcount > 0) {
		lcount = blkcount;
		if (lcount >= 0x3fffff)
		    //
		    // Blockcount > 0x3fffff gives a bytecount > 2Gb (negative),
		    // so limit the amount we erase at a time
		    //
		    lcount = 0x3fffff;
		stat = sys$qiow(0, chan, IO$_WRITEVBLK | IO$M_ERASE, &iosb, 0, 0,
			(void *) &pattern, lcount * 512, vbn, 0, 0, 0);	// Erase the file
		if (stat & 1) {
		    blkcount -= (iosb.iosb$l_bcnt / 512);	// Account for #of blocks erased
		    vbn += (iosb.iosb$l_bcnt / 512);		// Next block in line
		    if (!(iosb.iosb$w_status & 1) && (erase_stat & 1)) {
			erase_stat = iosb.iosb$w_status;
			blkcount = 0;				// Terminate loop on error
		    }
		} else {
		    erase_stat = stat;
		    blkcount = 0;				// Terminate loop on error
		}
	    }
	}
	ecount++;						// Next erase pattern
    } while ((erase_stat & 1) && (erase_stat != SS$_NOTRAN));
    signal_error(erase_stat, 0, 0);
    stat = sys$qiow(0, chan, IO$_DEACCESS, &iosb, 0, 0,
		    (void *) &fibdsc, 0, 0, 0, 0, 0);		// Deaccess the file
    signal_error(stat, iosb.iosb$w_status, 0);
    stat = sys$dassgn(chan);					// Get rid of channel
    signal_error(stat, 0, 0);
}

//
// Get data from existing device to create a clone
//

int getclonedata(int *tracks, int *sectors, int *cylinders, int *maxblock)
{
    int stat;
    int devchar;
    int devclass;
    int tracks1;
    int sectors1;
    int cylinders1;
    int maxblock1;
    int clone;
    char *device;
    LD_DSC namdsc;
    IOSB iosb;
    LD_ITEMLIST dvi_item[] =
      {4, DVI$_DEVCHAR, (char *) &devchar, 0,
       4, DVI$_DEVCLASS, (char *) &devclass, 0,
       4, DVI$_TRACKS, (char *) tracks, 0,
       4, DVI$_SECTORS, (char *) sectors, 0,
       4, DVI$_CYLINDERS, (char *) cylinders, 0,
       4, DVI$_MAXBLOCK, (char *) maxblock, 0,
       0, 0, 0, 0};

    clone = getqual(&sw_clone);
    if (clone) {
        device = getqualstring(&sw_clone); 			// Get devicename for clone
        namdsc.dsc$a_dpointer = device;
        namdsc.dsc$l_length = strlen(device);
        stat = sys$getdviw(0, 0, &namdsc, &dvi_item, &iosb, 0, 0, 0);	// Get device status
        signal_error(stat, iosb.iosb$w_status, 0);
        if (devclass != DC$_DISK)
	    lib$signal((unsigned int) &ld_notadisk, 0);		// Clone must be a disk
        if (!(devchar & DEV$M_MNT))
	    lib$signal((unsigned int) &ld_clonenotmounted, 0);	// Clone must be mounted
        tracks1 = getqualvalue(&sw_tracks);
        sectors1 = getqualvalue(&sw_sectors);
        cylinders1 = getqualvalue(&sw_cylinders);
        maxblock1 = getqualvalue(&sw_maxblocks);
	//
	// Override Cloned device values
	//
        if (tracks1 != 0)
            *tracks = tracks1;
        if (sectors1 != 0)
            *sectors = sectors1;
        if (cylinders1 != 0)
            *cylinders = cylinders1;
        if (maxblock1 != 0)
            *maxblock = maxblock1;
    }
    return clone;
}

//
// Set metadata in fileheader of container file
//

void setfilemetadata(LD_METADATA *mdat)
{
    int stat;
    int devchar;
    unsigned short chan;
    LD_DSC namdsc;
    IOSB iosb;
    ATRDEF atr[2];

    fib.fib$w_fid[0] = ld_nam.nam$w_fid[0];			// Get file-id
    fib.fib$w_fid[1] = ld_nam.nam$w_fid[1];
    fib.fib$w_fid[2] = ld_nam.nam$w_fid[2];
    realdev_dsc.dsc$a_dpointer = ld_nam.nam$l_dev;		// Get real devicename
    realdev_dsc.dsc$l_length = ld_nam.nam$b_dev;
    stat = sys$assign(&realdev_dsc, &chan, 0, 0, 0);		// Assign channel to device
    signal_error(stat, 0, 0);					// where file resides
    mdat->ldmtd$w_version = METADATA_VERSION;
    mdat->ldmtd$w_rsvdlen = sizeof(LD_METADATA);
    atr[0].atr$w_size = sizeof(LD_METADATA);
    atr[0].atr$w_type = ATR$C_RESERVED;				// Set reserved area
    atr[0].atr$l_addr = mdat;
    atr[1].atr$w_size = 0;					// Terminator
    atr[1].atr$w_type = 0;
    fib_dsc.dsc$a_dpointer = (char *) &fib;			// Point to FIB
    fib_dsc.dsc$l_length = FIB$K_LENGTH;
    stat = sys$qiow(0, chan, IO$_ACCESS, &iosb, 0, 0,
		    (void *) &fib_dsc, 0, 0, 0, 0, 0);		// Access the file
    signal_error(stat, iosb.iosb$w_status, 0);
    stat = sys$qiow(0, chan, IO$_MODIFY, &iosb, 0, 0,
  		    (void *) &fib_dsc, 0, 0, 0, (int64) &atr, 0);	// Modify the file
    //
    // This call may return SS$_HEADERFULL if the container file does not have a
    // reserved area. This can happen if it's a file created with an old LD
    // version. Issue a warning that we can't save the data.
    //
    if (iosb.iosb$w_status == SS$_HEADERFULL)
        lib$signal((unsigned int) &ld_notsaved);
    else
        signal_error(stat, iosb.iosb$w_status, 0);
    stat = sys$dassgn(chan);					// Get rid of channel
    signal_error(stat, 0, 0);
}

//
// Get metadata from fileheader of container file
//

int getfilemetadata(LD_METADATA *mdat)
{
    int stat;
    int devchar;
    unsigned short chan;
    LD_DSC namdsc;
    IOSB iosb;
    ATRDEF atr[2];

    fib.fib$w_fid[0] = ld_nam.nam$w_fid[0];			// Get file-id
    fib.fib$w_fid[1] = ld_nam.nam$w_fid[1];
    fib.fib$w_fid[2] = ld_nam.nam$w_fid[2];

    realdev_dsc.dsc$a_dpointer = ld_nam.nam$l_dev;		// Get real devicename
    realdev_dsc.dsc$l_length = ld_nam.nam$b_dev;

    stat = sys$assign(&realdev_dsc, &chan, 0, 0, 0);		// Assign channel to device
    signal_error(stat, 0, 0);					// where file resides
    atr[0].atr$w_size = sizeof(LD_METADATA);
    atr[0].atr$w_type = ATR$C_RESERVED;				// Set reserved area
    atr[0].atr$l_addr = mdat;
    atr[1].atr$w_size = 0;					// Terminator
    atr[1].atr$w_type = 0;
    fib_dsc.dsc$a_dpointer = (char *) &fib;			// Point to FIB
    fib_dsc.dsc$l_length = FIB$K_LENGTH;
    stat = sys$qiow(0, chan, IO$_ACCESS, &iosb, 0, 0,
		    (void *) &fib_dsc, 0, 0, 0, (int64) &atr, 0);	// Access the file
    signal_error(stat, iosb.iosb$w_status, 0);
    stat = sys$dassgn(chan);					// Get rid of channel
    signal_error(stat, 0, 0);
    if (mdat->ldmtd$w_version == METADATA_VERSION)
	return mdat->ldmtd$w_rsvdlen;
    else
	return 0;
}

//
//  Get full filename from specified one
//

char *fullfilespec(char *name, char *defname)
{
    static char tmpnam[NAM$C_MAXRSS];
    int stat;
    int len;

    if (name)
	len = strlen(name);
    else
	len = 0;

    ld_nam.nam$b_nop = NAM$M_NOCONCEAL;				// Name options
    ld_nam.nam$b_ess = NAM$C_MAXRSS;				// Max. expanded size
    ld_nam.nam$l_esa = tmpnam;					// Expanded address

    ld_fab.fab$l_nam = &ld_nam;					// NAM block
    ld_fab.fab$l_dna = defname;					// Default name address
    ld_fab.fab$b_dns = strlen(defname);				// Default name size
    ld_fab.fab$b_fns = len;					// Filename length
    ld_fab.fab$l_fna = name;					// Filename address

    stat = sys$parse(&ld_fab);					// Parse this name
    if (!(stat & 1))
	lib$signal((unsigned int) &ld_detectederr, 0, ld_fab.fab$l_sts, ld_fab.fab$l_stv);
    tmpnam[ld_nam.nam$b_esl] = '\0';				// Add terminator
    return (tmpnam);
}

#endif // SYSINIT_OPCCRASH

//
//  Get full device name from specified one
//

char *fulldevspec(char *name)
{
    char *tmpnam;
    LD_DSC resdsc;
    LD_DSC namdsc;
    short rlen;
    int stat;

    namdsc.dsc$a_dpointer = name;
    namdsc.dsc$l_length = strlen(name);

#ifdef SYSINIT_OPCCRASH

    tmpnam = fulldevspec_string;

#else // SYSINIT_OPCCRASH

    tmpnam = malloc(64);					// Get memory for devicename
    if (tmpnam == 0)
	signal_error(SS$_INSFMEM, 0, 0); 			// Not enough memory

#endif // SYSINIT_OPCCRASH

    resdsc.dsc$a_dpointer = tmpnam;
    resdsc.dsc$l_length = 64;
    stat = lib$getdvi(&DVI$_FULLDEVNAM, 0, &namdsc, 0, &resdsc, &rlen);	// Get full name
    signal_error(stat, 0, 0);
    tmpnam[rlen] = '\0';					// Terminator
    return (tmpnam + 1);					// Skip leading '_'
}

//
//  Get full filespec from file-id
//

void create_filename(char *device, FIDDEF *fid, char *outbuf)
{
    LD_DSC outdsc;
    LD_DSC devdsc;
    int stat;
    short rlen;
    char tmpbuf[256];
    char *p;

    devdsc.dsc$l_length = strlen(device);			// Input devicename
    devdsc.dsc$a_dpointer = device;
    outdsc.dsc$l_length = sizeof(tmpbuf);			// Output buffer length
    outdsc.dsc$a_dpointer = tmpbuf;
    stat = lib$fid_to_name(&devdsc, &fid->fid$w_num, &outdsc, &rlen, 0, 0);
    signal_error(stat, 0, 0);
    tmpbuf[rlen]='\0';
    //
    // Modify the devicename (as returned from lib$fid_to_name) from
    //   DISK$LABEL: to _SYSTEM$BLA0:
    //
    strcpy(outbuf,fulldevspec(device));				// Get real devicename
    p = strchr(tmpbuf,':') + 1;
    strcat(outbuf,p);
}

//
//  Get nodename
//

char *nodename()
{
    static char tmpnam[256];
    static $DESCRIPTOR(resdsc, tmpnam);
    $DESCRIPTOR(tbl, "LNM$FILE_DEV");
    $DESCRIPTOR(lognam, "SYS$NODE");
    short rlen;
    LD_ITEMLIST item[2];
    int stat;

    tmpnam[0] = '\0';
    stat = lib$getsyi(&SYI$_NODENAME, 0, &resdsc, &rlen, 0, 0);	// Get nodename
    if (stat & 1) {						// Nodename found
	tmpnam[rlen] = '\0';					// Terminator
    } else {							// No nodename, try the logical SYS$NODE
	item[0].lditmlst$w_item = LNM$_STRING;
	item[0].lditmlst$w_buflen = 256;
	item[0].lditmlst$ps_addr = tmpnam;
	item[0].lditmlst$l_rlength = (int) &rlen;
	item[1].lditmlst$w_buflen = 0;
	item[1].lditmlst$w_item = 0;				// End of itemlist
	stat = sys$trnlnm(0, &tbl, &lognam, 0, &item);
	signal_error(stat, 0, 0);
	tmpnam[rlen - 2] = '\0';				// Terminator (zap trailing ::)
    }
    return (tmpnam);
}

//
//  Build lock for trace
//

char *build_lock(char *dev)
{
    static char locknam[256];

    strcpy(locknam, "$LOGDISK_");				// First part of lockname
    strcat(locknam, nodename());				// Attach nodename
    if (dev)
	strcat(locknam, fulldevspec(dev));			// Attach devicename
    //
    // Set metadata in fileheader of container file
    //
    else
	strcat(locknam, "_CONNECT");
    return locknam;
}

#ifndef SYSINIT_OPCCRASH

//
// Set catch for outband character to terminate trace
//

void set_outband()
{
    int stat;
    int type;
    int mask[2];
    IOSB iosb;
    $DESCRIPTOR(outbdev, "SYS$COMMAND");

    stat = lib$getdvi(&DVI$_TRM, 0, &outbdev, &type, 0, 0);
    signal_error(stat, 0, 0);
    if (!type)							// Not a terminal, don't bother
	return;
    stat = sys$assign(&outbdev, &outband_chan, 0, 0, 0);	// Assign channel
    signal_error(stat, 0, 0);
    mask[0] = 0;
    mask[1] = (1 << ('C' - 64)) | (1 << ('Z' - 64));
    stat = sys$qiow(0, outband_chan, IO$_SETMODE | IO$M_OUTBAND, &iosb, 0, 0,
		    &ld_exit, (int64) &mask, 0, 0, 0, 0);	// Get current status
    signal_error(stat, iosb.iosb$w_status, 0);
}

//
// Purge trace files
//

void purge_file(int limit, char *name)
{
    int stat;
    char *pos;
    char tmpnam[256];
    LD_DSC fildsc;
    $DESCRIPTOR(deflt, ".DAT");

    pos = strrchr(name, ';');					// Find trailing ;
    if (pos != 0) {
	if (name[strlen(name) - 1] != ';')
	    return;						// Exact filespec speficied
	else
	    *pos = '\0';					// Zap trailing ;
    }
    if (limit == 0)
	sprintf(tmpnam, "%s;%d", name, limit);			// Delete latest version
    else
	sprintf(tmpnam, "%s;-%d", name, limit);			// Delete old version
    fildsc.dsc$a_dpointer = tmpnam;
    fildsc.dsc$l_length = strlen(tmpnam);

    stat = 1;
    while (stat == 1)						// Until out of files
	stat = lib$delete_file(&fildsc, &deflt, 0, 0, 0, 0, 0, 0, 0);
    if (stat != RMS$_FNF)					// No such file is no error
	signal_error(stat, 0, 0);
}

#endif // SYSINIT_OPCCRASH

//
//  Set exclusive access for LD by taking out a lock of the
//  name $LOGDISK_CONNECT.
//

void set_exclusive()
{
    LD_DSC lknam;
    int stat;

    lknam.dsc$a_dpointer = build_lock(0);			// Build resource name
    lknam.dsc$l_length = strlen(lknam.dsc$a_dpointer);
    stat = sys$enqw(0, LCK$K_EXMODE, &ld_lksb, LCK$M_SYSTEM ,
		    &lknam, 0, 0, 0, 0, 0, 0);			// Enqueue EX lock
    signal_error(stat, ld_lksb.lksb$w_status, 0);
}

//
// Clear exclusive lock for connect
//

void clear_exclusive()
{
    int stat;

    stat = sys$deq(ld_lksb.lksb$l_lkid, 0, 0, 0);		// Dequeue lock
    signal_error(stat, 0, 0);
}

#ifndef SYSINIT_OPCCRASH

//
// Exit routine for cleanup
//

void ld_exit(int param)
{
    int stat;
    int pid;
    short prcnaml;
    char prcnam[16];
    $DESCRIPTOR(prcnamdsc, prcnam);
    LD_VALBLK *vb;

    if ((outfile != 0) && (outfile != stdout)) {		// Close output file
	if (fclose(outfile) < 0)
	    lib$signal((unsigned int) &ld_closerr, 1, outfilename, vaxc$errno, 0);
    }
    if (outband_chan != 0) {
	stat = sys$dassgn(outband_chan);			// Get rid of channel
	signal_error(stat, 0, 0);
    }
    if (param == 0) {						// We're called by blocking ast routine
	stat = sys$enqw(0, LCK$K_NLMODE, &ld_lksb,		// Convert to NL
	        LCK$M_SYSTEM | LCK$M_CONVERT | LCK$M_VALBLK,
	        0, 0, 0, 0, 0, 0, 0);
	signal_error(stat, ld_lksb.lksb$w_status, 0);
	stat = sys$enqw(0, LCK$K_EXMODE, &ld_lksb,		// Convert to EX, get lockvalueblock
	        LCK$M_SYSTEM | LCK$M_CONVERT | LCK$M_VALBLK | LCK$M_QUECVT,
	        0, 0, 0, 0, 0, 0, 0);
	vb = (LD_VALBLK *) &ld_lksb.lksb$b_valblk;
	pid = vb->ldval$l_pid;					// This pid stopped us
    }
    stat = sys$deq(ld_lksb.lksb$l_lkid, 0, 0, 0);
    signal_error(stat, 0, 0);
    if (param == 0) {						// We're called by blocking ast routine
        stat = lib$getjpi(&JPI$_PRCNAM, &pid, 0, 0, &prcnamdsc, &prcnaml);
        signal_error(stat, 0, 0);
        prcnam[prcnaml] = '\0';         			// Insert terminator
        lib$signal((unsigned int) &ld_tracestopped, 2, pid, prcnam);
	exit((int) &ld_tracestopped);
    } else
	exit(1);
}

#endif // SYSINIT_OPCCRASH

//
// Signal any error
//

void signal_error(int st1, int st2, int reason)
{
    int stat1, stat2;
    int modified1, modified2;

    modified1 = convert_error(st1, &stat1);			// Return reasonable error
    modified2 = convert_error(st2, &stat2);
    if ((!(stat1 & 1)) || (st2 && (!(stat2 & 1)))) {
	if (modified1 || modified2) {
	    if (stat1 == 1) {
                if (reason == 0)
		    lib$signal(stat2, 0, 0);
                else
		    lib$signal(stat2, 0, reason);
            } else
		lib$signal(stat1, 0, stat2, 0, 0);
	} else {
	    if (stat1 == 1)
		lib$signal((unsigned int) &ld_detectederr, 0, stat2, 0, 0);
	    else
		lib$signal((unsigned int) &ld_detectederr, 0, stat1, 0, stat2, 0, 0);
	}
    }
}

//
//  Return a reasonable error for some returned by the driver
//

int convert_error(int oldstatus, int *newstatus)
{
    int code = 0;

    if (oldstatus == SS$_DEVASSIGN)
	code = (int) &ld_devassign;				// 'Device has channels assigned'
    else if (oldstatus == SS$_DEVACTIVE)
	code = (int) &ld_alrdyconn;				// 'Already connected'
    else if (oldstatus == SS$_DEVINACT)
	code = (int) &ld_notconn;				// 'Not connected'
    else if (oldstatus == SS$_NODATA)
	code = (int) &ld_trcdisabl;				// 'Tracing already disabled'
    else if (oldstatus == SS$_TOOMUCHDATA)
	code = (int) &ld_trcenabl;				// 'Tracing already enabled'
    else if (oldstatus == SS$_DATALOST)
	code = (int) &ld_nowatchdata;				// 'No watchpoint data available'
    else if (oldstatus == SS$_DATACHECK)
	code = (int) &ld_wptnotfound;				// 'Watchpoint not found'
    else if (oldstatus == SS$_NOTVOLSET)
	code = (int) &ld_fileonvolset;				// 'File watchpoint on volumeset not allowed'
    else if (oldstatus == SS$_FILALRACC)
	code = (int) &ld_fileinuse;				// 'File already in use'
    else if (oldstatus == SS$_DEVALLOC)
	code = (int) &ld_deviceinuse;				// 'Device already in use'
    else if (oldstatus == SS$_DEVREQERR)
	code = (int) &ld_fileonother;				// 'File not allowed to be on other device'
    else if (oldstatus == SS$_ILLBLKNUM)
	code = (int) &ld_vbnerror;				// 'Illegal virtual block number specified'
    else if (oldstatus == SS$_NOSUCHNODE)
	code = (int) &ld_nocluster;				// 'No cluster code loaded'
    else if (oldstatus == SS$_ACCONFLICT)
	code = (int) &ld_notvisible;				// 'Device is not visible on other nodes'
    else if (oldstatus == SS$_BADPARAM)
	code = (int) &ld_invgeometry;				// 'Invalid geometry specified'
    else if (oldstatus == SS$_IVPARAM)
	code = (int) &ld_blkoutofrange;				// 'Blocks out of range'
    else if (oldstatus == SS$_UNSAFE)
	code = (int) &ld_devconnected;				// 'Cannot set allocation class with active LD devices'
    else if (oldstatus == SS$_WRONGACP)
	code = (int) &ld_unsupportedfs;				// 'Unsupported filesystem'
    else if (oldstatus == SS$_BADFILESIZE)
	code = (int) &ld_conttoosmall;				// 'Container file too small (5000 blocks minimum)'
    else {
	*newstatus = oldstatus;					// Return original status
	return 0;						// Not modified
    }
    *newstatus = code;						// Return new status
    return 1;							// Modified
}

#ifndef SYSINIT_OPCCRASH

//
// Provide interactive help
//

void help()
{
    char buf[256];
    char *p;
    int status;
    int flag;
    $DESCRIPTOR(LD_HELPLIB,"LD$HELP");				// Help library
    $DESCRIPTOR(input, buf);
    typedef int (*funcArg)(void);

    strcpy(buf,"LD ");						// Start with LD topic
    p = getqualstring(&sw_help);
    if (p)
        strcat(buf, p);						// Append rest of command
    input.dsc$w_length = strlen(buf);				// Insert size
    //
    // Activate help library
    //
    status = lib$find_image_symbol(&LBRSHR_DESC, &LBR$OUTPUT_HELP_DESC, (int *) &output_help_addr);
    if (!$VMS_STATUS_SUCCESS(status))
	exit(status);

    flag = HLP$M_PROMPT|HLP$M_PROCESS|HLP$M_GROUP|HLP$M_SYSTEM|HLP$M_HELP;
    //
    // Call the help routines */
    //
    exit(lbr$output_help((funcArg) lib$put_output,0,&input,&LD_HELPLIB,&flag,lib$get_input));
}

//
// 'Helper' routine for help
//

int lbr$output_help ( int (*output_routine) (void),
                          int *output_width,
                          struct dsc$descriptor_s *line_desc,
                          struct dsc$descriptor_s *library_name,
                          int *flags,
                          void *input_routine )
{
    return (*output_help_addr) (output_routine, output_width, line_desc, library_name, flags, input_routine);
}

//
// Show LD version information
//

void version()
{
    LD_DSC dev;
    LD_DSC ident;
    int stat;
    unsigned short chan;
    IOSB iosb;
    int ident_len;
    int version;
    int memsize;
    int pagesize;
    int linktime[2];
    int boottime[2];
    char tmpbuf[128];
    char timbuf[128];
    char membuf[128];
    char hw_name[64];
    char vmsversion[32];
    char identbuf[32];
    LD_ITEMLIST item[] =
      {64, SYI$_HW_NAME,   (char *) &hw_name,    0,
       32, SYI$_VERSION,   (char *) &vmsversion, 0,
        8, SYI$_BOOTTIME,  (char *) &boottime,   0,
        4, SYI$_MEMSIZE,   (char *) &memsize,    0,
        4, SYI$_PAGE_SIZE, (char *) &pagesize,   0,
        0, 0,              0,                    0};

    dev.dsc$a_dpointer = lx_unit0;
    dev.dsc$l_length = strlen(lx_unit0);
    stat = sys$assign(&dev, &chan, 0, 0, 0);			// Assign channel to device
    if (stat == SS$_NOSUCHDEV) {
        lib$signal((unsigned int) &ld_driverversion, 1, "driver is not loaded");
    } else {
	signal_error(stat, 0, 0);
	enable_privs(PRV$M_PHY_IO);
	ident.dsc$a_dpointer = identbuf;
	ident.dsc$l_length = sizeof(identbuf);
	stat = sys$qiow(0, chan, IO$_LD_CONTROL, &iosb, 0, 0,	// Get driver's info
			&version, (int64) &linktime, (int64) &ident, (int64) &ident_len, 0, LDIO$K_GET_VERSION);
	signal_error(stat, iosb.iosb$w_status, 0);
	if (version != DRIVER_VERSION_FORMAT)
            lib$signal((unsigned int) &ld_invversionfmt);	// Unknown version format
	identbuf[ident_len] = '\0';
        sprintf(tmpbuf, "%s %s", identbuf, cvttime((uint64 *) &linktime, 0, 0));
        if (iosb.iosb$w_status == SS$_SYNCH)			// MON version returns alternate success status
            strcat(tmpbuf, " (MON version)");
        stat = sys$getsyiw(0, 0, 0, &item, &iosb, 0, 0);	// Get system info
	signal_error(stat, iosb.iosb$w_status, 0);
        sprintf(timbuf, "%s", cvttime((uint64 *) &boottime, 0, 0));
        sprintf(membuf, "%Ld", (int64) ((int64) ((int64) memsize * (int64) pagesize)) / (1024 * 1024));
        lib$signal((unsigned int) &ld_version, 4, LD_VERSION, LD_MODULE, __DATE__, __TIME__,
                   (unsigned int) &ld_driverversion, 1, tmpbuf,
                   (unsigned int) &ld_sysinfo1, 3, nodename(), hw_name, vmsversion,
                   (unsigned int) &ld_sysinfo2, 2, membuf, timbuf);
	stat = sys$dassgn(chan);
	signal_error(stat, 0, 0);
    }
}

//
// Enable needed privileges
//

void enable_privs(int64 which)
{
#ifndef DEBUG
    int status;
    PRVDEF privs, prv_priv;
    //
    // Notice that this will only work for privilege definitions
    // less than 32 bits. No issue here.
    //
    privs.prv$l_l1_bits = which;
    privs.prv$l_l2_bits = 0;

    status = sys$setprv(1, (GENERIC_64 *) &privs, PRV$K_PRVMASK_IMAGE, (GENERIC_64 *) &prv_priv);
    if (status == SS$_NOTALLPRIV) {
	//
	// Change severity from -S- to -F-
	//
        status &= ~STS$M_SEVERITY;
        status |= STS$K_SEVERE;
    }
    signal_error(status, 0, 0);
#endif  // DEBUG
}

//
// Disable all privileges
//

void disable_privs()
{
#ifndef DEBUG
    int status;
    PRVDEF privs;

    privs.prv$l_l1_bits = -1;
    privs.prv$l_l2_bits = -1;

    status = sys$setprv(0 , (GENERIC_64 *) &privs, PRV$K_PRVMASK_IMAGE, 0);
    signal_error(status, 0, 0);
#endif // DEBUG
}

//
// Check requirements like installed image and loaded driver
//

void check_requirements()
{
#ifndef DEBUG
    int stat;
    PRVDEF privs, prv_priv;
    char matchname[256];
    $DESCRIPTOR(matchdev, matchname);
    LD_DSC wildname;
    unsigned short rlen;
    int devclass;
    LD_ITEMLIST item[] = {sizeof(devclass), DVS$_DEVCLASS, (char *) &devclass, 0, 0, 0, 0, 0};

    wildname.dsc$a_dpointer = lx_wildname;
    wildname.dsc$l_length = strlen(lx_wildname);
    if (tape)
	devclass = DC$_TAPE;
    else
	devclass = DC$_DISK;

    stat = sys$device_scan(&matchdev, &rlen, &wildname, &item, 0);
    if (stat == SS$_NOMOREDEV) {
	//
	// No node$Lxcn or $nn$Lxcn. See if _LDcn/_LMcn can be found.
	//
	wildname.dsc$a_dpointer = &lx_wildname_nonode;
	wildname.dsc$l_length = strlen(lx_wildname_nonode);
	stat = sys$device_scan(&matchdev, &rlen, &wildname, &item, 0);
	if ((stat == SS$_NOMOREDEV) || strchr(matchname,'$'))
	    //
	    // No LD/LM device found at all.
	    //		-or-
	    // LD/LM found as start of a nodename.
	    //
	    // Either way, it does not make sense to continue....
	    //
	    lib$signal((unsigned int) &ld_invokestartup, 0);
    }
    signal_error(stat, 0, 0);

    privs.prv$l_l1_bits = 0;
    privs.prv$l_l2_bits = 0;
    //
    // Don't enable any additional privileges, just get the current
    // image privs
    //
    stat = sys$setprv(1, (GENERIC_64 *) &privs, PRV$K_PRVMASK_IMAGE, (GENERIC_64 *) &prv_priv);
    signal_error(stat, 0, 0);
    if ((!(prv_priv.prv$v_phy_io)) ||				// Check for the privs we need
        (!(prv_priv.prv$v_syslck)) ||
        (!(prv_priv.prv$v_share)))
	lib$signal((unsigned int) &ld_invokestartup, 0);
#endif // DEBUG
}

#endif // SYSINIT_OPCCRASH