.TITLE	VFE VMS File Editor

	.IDENT	/MCCCD VFE V2.0/

	.SBTTL	Introduction
;
; VMS File Editor, Version 2.0
;
;     Written at MCCCD by Ward Condit, spring 1984
;     (Enhanced, fall 1985)
;
;     Inspired by fond remembrances of Sperry 1100 "FILEDIT",
;     written at the U of Maryland by B. K. Reid and K. E. Sibbald
;
;     Helpful hints and suggestions provided by:
;                           Jason Pociask
;                           Chris Zagar
;                           David Mitchell
;
; VFE is a utility which allows a user to perform display,
; change, locate, and compare operations on any VMS file, disk
; device, or tape that the user has privilege to access.
; VFE is block-oriented and independent of file type.
;
; Version 2.0 has limited source documentation.  VFE will soon
; be submitted to the DECUS program library with full source docs.
;
; This software is provided free of charge in the PUBLIC DOMAIN
; by the Maricopa Community Colleges.  By accepting this software
; the user agrees not to hold the supplier liable for damages of
; any kind, resulting either from software errors or improper
; operation.
;
; It is STRONGLY SUGGESTED that VFE be operated ONLY in read-only
; mode when examining system files.  Read-only mode should also be
; used when editing other critical files for which there is no
; current backup.


LOCSIZ=50	; Buffer size (blocks) for the LOCATE command
		; This also represents the maximum SET BUFF size.

MAXBCT==30000	; Max block size (bytes) for tape read
		;  (must be >= LOCSIZ*512)

	.ENABLE	SUPPRESSION

	.LIBRARY  'VFELIB'

	$HLPDEF

LF=^X0A
	.PAGE
	.SBTTL	Main program
;
; This is the initialization and main control loop code.
;
	.PSECT	CODE,EXE,NOWRT

	.ENTRY	START,0

	BSBW	TINIT			; set up user interface I/O
	BLBS	R0,100$			; better have good status here
	$EXIT_S	CODE=R0			;  or stop right now.
100$:
	MOVL	TERMWD,INITWID		; save initial terminal width
	$ASCTIM_S  TIMBUF=SGNTIM	; get system time for signon msg
	OUTMSG	#SGNL,SIGNON		; display signon message
	PUSHAW	DESC
	PUSHAL	FNQ
	PUSHAL	DESC
	CALLS	#3,G^LIB$GET_FOREIGN	; get user-supplied params
	BLBS	R0,200$
	BRB	800$			; exit if error returned
200$:
	BSBW	GETFILE			; open first file for edit
;
; This is the main control loop.
;
300$:
	BSBW	GETCMD			; input and parse command line
	CLRB	STOP			; clear control_c flag
	MOVL	JMPADR,R1
	JSB	(R1)			; branch to desired routine
	BRB	300$			; get next command when done
;
; error returned from LIB$GET_FOREIGN
;
800$:
	CMPL	R0,#RMS$_EOF		; end-of file?
	BNEQ	900$
	BRW	EXIT			; if so, exit quietly
900$:
	BRW	ERREXT			; otherwise, display error and exit
	.PAGE
	.SBTTL	CHANGE - Change one or more sequential bytes
CHANGE::
	TSTL	PARA1			; test byte address to change
	BLSS	100$			; error if negative
	MOVZWL	QDESC,R1		; get length of change-string
	ADDL2	PARA1,R1		; add byte address
	CMPL	R1,CURBCT
	BLEQ	200$			; OK if fits within current buffer
	TSTL	CURBCT			;  nope - test buffer size
	BGTR	100$			; if nonzero, "invalid parameter(s)"
	OUTMSGC	CBEMPTY			; otherwise, "current buffer empty"
	BRW	600$
100$:
	BSBW	INVPARA			; output error message and exit
	BRW	600$
;
; At this point the parameters have been validated.
;
200$:
	MOVAL	BUFF,R6
	ADDL2	PARA1,R6		; R6 = address of first byte to change
	MOVC3	QDESC,@QDESC+4,CSTR	; move to change-string save area
	MOVZWL	QDESC,CSTRL		; save length
	MOVB	QTYPE,CSTRT		;  and type (0=char, 1,2=dec, 3=hex)
	BNEQ	300$			; skip if non-character
	TSTB	EBCFLG			; if char string, is charset=ebcdic?
	BNEQ	400$			; yes - go translate
300$:
	MOVC3	CSTRL,CSTR,(R6)		; move change-string to buffer
	BRB	500$
400$:
	MOVW	CSTRL,DESC
	MOVL	R6,DESC+4		; set up DESC to point to buffer
	PUSHAL	DESC
	PUSHAL	QDESC
	CALLS	#2,G^LIB$TRA_ASC_EBC	; trans to EBCDIC straight into buff
	BLBS	R0,500$
	BSBW	ERROUT			; indicate error if necessary
500$:
	CLRL	LPTR			; zero LOCATE pointer after change
	MOVL	CURBLK,CHGBLK
	MOVL	PARA1,CHGBYT		; save block, byte, and
	MOVC3	CURNAM,CURNAM,CHGNAM	;   file name for SHOW CHANGE
600$:
	RSB
	.PAGE
	.SBTTL	CUT - Transfer current buff to paste buff
;
; Processing for the CUT command.
;
CUT::
	BSBW	CPINIT			; call cut/paste init
	BLBS	R0,100$
	BRB	200$			; don't cut if error
100$:
	MOVC3	PARA2,(R4),PBUFF	; move selected data to paste buffer
	MOVL	PARA1,PBOFF		; save offset (beginning byte) addr
	MOVL	PARA2,PBBCT		; save byte count
	MOVL	CURBLK,PSTBLK
	MOVC3	CURNAM,CURNAM,PSTNAM	; save block, file for SHOW PASTE
200$:
	RSB


	.SBTTL	PASTE - Transfer paste buff to current buff
;
; Processing for the PASTE command.
;
PASTE::
	BSBW	CPINIT			; call cut/paste init
	BLBS	R0,100$
	BRW	900$			; don't paste if error
100$:
	TSTL	PBBCT			; test paste buffer size
	BGTR	200$
	OUTMSGC	PBEMPTY			; output err msg and quit if empty
	BRW	900$
200$:
	SUBL3	PBBCT,PARA2,R1		; R1 = excess bytes in PASTE range
	BLEQ	300$
	MOVL	#80,OUTDSC		; if > zero, output "zero fill" msg
	$FAO_S	CTRSTR=PBSMALL,OUTLEN=OUTDSC,OUTBUF=OUTDSC,-
		P1=PBBCT,P2=R1
	OUTMSG	OUTDSC,OUT_BUFF
	BRB	400$
300$:
	BEQL	400$
	MOVL	#80,OUTDSC		; if < zero, output "truncated" msg
	$FAO_S	CTRSTR=PBLARGE,OUTLEN=OUTDSC,OUTBUF=OUTDSC,-
		P1=PBBCT,P2=PARA2
	OUTMSG	OUTDSC,OUT_BUFF
400$:
	MOVC5	PBBCT,PBUFF,#0,PARA2,(R4)  ; move selected data to curr buff
	CLRL	LPTR			; clear the LOCATE pointer
	MNEGL	#1,RECPTR		;  and the RECORD pointer
900$:
	RSB
	.PAGE
;
; This routine called by CUT and PASTE to validate user range
;
CPINIT:
	TSTL	CURBCT			; test size of current buffer
	BGTR	100$
	OUTMSGC	CBEMPTY			; output "empty" message if empty
	BRB	300$
100$:
	ADDL3	PARA1,PARA2,R1		; R1 = ending byte + 1
	CMPL	R1,CURBCT
	BGTR	200$			; error if exceeds current buff size
	TSTL	PARA2
	BLEQ	200$			; error if transfer count < 1
	ADDL3	#BUFF,PARA1,R4		; setup R4 = address to begin transfer
	MOVL	#1,R0			; indicate good return status
	BRB	400$
200$:
	BSBW	INVPARA			; output "invalid parameter" message
300$:
	CLRL	R0			; error status
400$:
	RSB
	.PAGE
	.SBTTL	LOCATE - Search for a specified target
LOCATE::
	TSTL	CURBCT			; check size of current buffer
	BGTR	50$			; skip if nonzero
	MOVL	#1,PARA1
	BSBW	NEXT			; read next block of file
	BLBS	R0,50$			; Check status
	BRW	980$			; Abort locate if error
50$:
	MOVL	QDESC+4,R7		; R7 = addr of parameter string
	CMPW	LSTRL,QDESC		; compare length with prev string
	BNEQ	100$			; skip compare if unequal
	CMPB	QTYPE,LSTRT		; same types? 0=char, 1,2=dec, 3=hex
	BNEQ	100$			; no, skip compare
	CMPC3	LSTRL,(R7),LSTR		; compare equal-length strings
	BNEQ	100$			; skip if not the same
	CMPL	LPTR,CURBCT		; does locate ptr exceed curr buff?
	BLEQ	200$			; nope - begin processing
	BRB	190$			; yes - zero pointer (same string)
100$:
	MOVC3	QDESC,(R7),LSTR		; move new parameter to save location
	MOVZWL	QDESC,LSTRL		; move new length
	MOVB	QTYPE,LSTRT		; move new parameter type
	CLRW	LOCNAM
190$:
	CLRL	LPTR			; begin search at top of buffer
200$:
	MOVC3	LSTRL,LSTR,LSTRX	; move locate string to LSTRX
	MOVB	LSTRT,LOCSFL		; move type - check for char string
	BEQL	220$
	BRW	300$			; not string - skip EBCDIC check
220$:
	TSTB	EBCFLG			; does charset=ebcdic?
	BEQL	240$			; nope
	MOVW	LSTRL,DESC		; yes - set up for translate
	MOVAL	LSTRX,DESC+4
	PUSHAL	DESC
	PUSHAL	QDESC
	CALLS	#2,G^LIB$TRA_ASC_EBC	; LSTRX now in EBCDIC
	BLBS	R0,240$
	BSBW	ERROUT			; display error msg and quit if error
	BRW	980$
240$:
	MOVB	CASFLG,LOCSFL		; LOCSFL=0 if char str and SET NOCASE
	BNEQ	300$			; skip translate if LOCSFL>0
	MOVW	LSTRL,DESC		;
	MOVAL	LSTRX,DESC+4		;
	MOVW	LSTRL,UDESC		; set up for translate
	MOVAL	LSTRX,UDESC+4		;
	BSBW	UPCASE			; translate LSTRX to uppercase
	BLBS	R0,300$			;
	BSBW	ERROUT			; error in translation -
	BRW	980$			;  so indicate and exit
	.PAGE
;
;	 Prepare to search the current buffer for the target.
;
300$:
	ADDL3	#BUFF,LPTR,R7		; R7 = byte address to begin search
	CLRL	FNDCNT			; zero match count
	CLRB	FLAG			; zero "replace buffer contents" flag
	CLRB	BSFLAG			; initialize backspace flag
	ADDL3	#1,CURBLK,LBLOCK	; initialize LBLOCK for match rtn
	CLRL	LBLKCT			; init block count (nothing read yet)
	SUBL3	LPTR,CURBCT,R8		; R8 = bytes remaining to search in BUFF
	CMPL	LSTRL,R8		; compare with target string length
	BGTR	400$			; skip if not enough to search
	SUBL3	#1,LSTRL,REMCT		; REMCT = carry-forward byte count
					;  for next search
	BSBW	MATCHIT			; call match routine to do the search
	BLBC	R0,380$			; internal error - exit
	BLBC	R1,420$			; skip if no match or global search
380$:
	BRW	970$			;  otherwise, exit
400$:
	MOVL	R8,REMCT		; init REMCT for short rem count
420$:
	TSTB	STOP			; test if control_c entered yet
	BEQL	430$
	BRW	970$			; yes - abort search
430$:
	TSTB	TAPFLG			; editing tape?
	BNEQ	500$			; yes - skip
	MOVC3	CURBCT,BUFF,SBUFF	; no - move curr buff to SBUFF
	MOVL	CURBCT,SAVBCT		;  and save buffer size
	SUBL3	#512,CURBCT,R1
	BEQL	500$			; skip if buff size is one block
	MOVC3	#512,BUFF(R1),BUFF	; otherwise move last block to top
	DIVL3	#512,CURBCT,R1
	ADDL3	R1,CURBLK,LBLOCK	; set up LBLOCK for next block
	MOVL	#512,CURBCT		; CURBCT must = 512 for disk locate
	.PAGE
;
;	This is the top of the locate loop.
;
500$:
	TSTB	TAPFLG			; is this a tape file?
	BEQL	510$			;  no, continue
	BRW	600$			;  yes - skip to tape code
510$:
	MOVL	#LOCSIZ,LBLKCT		; init length for normal-size read
	SUBL3	LBLOCK,HIBLK,R4		; R4 = blocks remaining minus 1
	BGEQ	520$			; if >= zero, continue
	MOVL	SAVBCT,CURBCT		; search complete - restore saved CURBCT
	TSTB	FLAG			; test "modified" flag
	BEQL	515$			; skip if 0
	MOVC3	CURBCT,SBUFF,BUFF	; otherwise, restore buffer contents
	CLRB	FLAG			; zero flag
515$:
	BRW	800$			; exit "no find"
520$:
	CMPL	R4,LBLKCT		; test for fewer than default blocks
	BGEQ	530$			;  remaining to be searched
	ADDL3	#1,R4,LBLKCT		; if so, move rem blk count to LBLKCT
530$:
	MULL3	#512,LBLKCT,R2		; R2 = bytes to read
	MOVL	LBLOCK,R1		; R1 = block address in file
	BSBW	READINT			; read into BUFF+512
	MOVL	#512,LSTBCT		; init LSTBCT for disk
	MOVL	R0,SVSTAT		; save return status
	BLBS	R0,650$			; skip if normal
	CMPL	NXTBCT,#512		; error status - check for at least
	BGEQ	650$			;  one full block read
	BRW	670$			;  if not, skip search
600$:
	MOVL	#1,LBLKCT		; init LBLKCT for tape
	MOVB	#1,BSFLAG		; set backspace flag
	BSBW	READINT			; read next block into BUFF+CURBCT
	BLBS	R0,620$			; skip if normal status
	CMPL	R0,#SS$_ENDOFFILE	; test for end of file
	BEQL	610$			; this is normal exit status
	BSBW	ERROUT			; abnormal status - show to user
	SUBL3	#1,LBLOCK,CURBLK	; compute current block number
	BRW	900$			; exit
610$:
	SUBL3	#1,LBLOCK,CURBLK	; compute current block number
	BRW	800$			; exit "no find" or end global search
620$:
	MOVL	#1,SVSTAT		; set good status
	MOVL	NXTBCT,LSTBCT		; init LSTBCT for tape
650$:
	ADDL3	#BUFF,CURBCT,R7		;
	SUBL2	REMCT,R7		; R7 = address to begin search
	ADDL3	NXTBCT,REMCT,R8		; R8 = byte count to search
	BSBW	MATCHIT			; call match routine
	BLBS	R0,660$			; check for internal error
	SUBL3	#1,LBLOCK,CURBLK	; if error, compute current block
	BRW	900$			;  data in BUFF, update CURBLK and exit
660$:
	BLBC	R1,670$			; skip if no match or global search
	BRW	700$			;  otherwise, exit
670$:
	MOVL	SVSTAT,R0		; restore status from read operation
	BLBS	R0,690$			; skip if normal
	BSBW	ERROUT			; otherwise, indicate error and...
	DIVL3	#512,NXTBCT,R4		;  compute R4 = full blocks read
	ADDL3	LBLOCK,R4,R5		;  R5 = address + 1 of last good block
	SUBL3	#1,R5,CURBLK		;  update CURBLK accordingly
	MULL2	#512,R4			;  R4 = byte offset from BUFF to move
	BEQL	680$			;  skip if zero
	MOVC3	#512,BUFF(R4),BUFF	;  move last good data to BUFF
	INCB	FLAG			;  set "buffer modified" flag
680$:
	BRW	900$			;  exit
690$:
	MULL3	CURBCT,LBLKCT,R6	; R6 = bytes last read
	MOVC3	LSTBCT,BUFF(R6),BUFF	; move last block data to BUFF
	MOVL	LSTBCT,CURBCT		; update CURBCT
	CLRB	BSFLAG			; zero backspace flag
	MOVB	#1,FLAG			; set "buffer modified" flag
	SUBL3	#1,LSTRL,REMCT		; remaining ct = string ct - 1
	ADDL2	LBLKCT,LBLOCK		; LBLOCK = next block to read
	TSTB	STOP			; did user enter control_c?
	BNEQ	695$			; yes - stop processing
	BRW	500$			; no - loop back for more
695$:
	SUBL3	#1,LBLOCK,CURBLK	; compute last block searched
	TSTB	TAPFLG			; tape file?
	BNEQ	698$			; yes - skip
	CMPL	BUFFCT,#1		; is buffer size set to one?
	BLEQ	698$			; yes - skip
	MOVL	CURBLK,PARA1		; no - set up and read in
	BSBW	READ			;  the required block count
	BRW	970$			; exit
698$:
	BRW	900$			; exit to 900$ for tape or buff ct=1
;
;	"find" condition or user interrupt from global search
;
700$:
	TSTB	TAPFLG			; tape device?
	BNEQ	740$			; yes - skip this
	ADDL2	#512,NXTBCT		; compute NXTBCT = remaining bytes
	SUBL2	R6,NXTBCT		;  in current buff, incl found block
	MULL3	#512,BUFFCT,LSTBCT	; LSTBCT = required bytes
	CMPL	NXTBCT,LSTBCT		; do we have enough?
	BGEQ	720$			; yes - skip
	BLBS	SVSTAT,710$		; continue if last read was good
	MOVL	NXTBCT,LSTBCT		; otherwise, use reduced size
	BRB	720$
710$:
	MOVL	R10,PARA1		; set up to read at found block
	PUSHL	LPTR			; save locate pointer
	BSBW	READ			; read required bytes from file
	MOVL	(SP)+,LPTR		; restore locate pointer and exit
	BRW	970$
720$:
	MOVL	LSTBCT,CURBCT		; set CURBCT for disk
740$:
	TSTL	R6			; R6 = buffer offset of block which
					;  contains byte 1 of matched string
	BEQL	750$			; skip if zero
	MOVC3	LSTBCT,BUFF(R6),BUFF	; move this block's data to BUFF
	MOVL	LSTBCT,CURBCT		; update CURBCT
	CLRB	BSFLAG			; zero backspace flag
	INCB	FLAG			; set modified flag
750$:
	MOVL	R10,CURBLK		; update CURBLK, R10 set by match rtn
	BRB	900$			; exit
800$:
	MOVL	CURBCT,LPTR		; set locate pointer to "no find"
	TSTL	FNDCNT			; did we find anything? (global only)
	BNEQ	820$			; yes - so indicate
	OUTMSG	#NFMSGL,NFMSG		; no - output "no find" message
	BRB	900$			;  and exit
820$:
	MOVL	#100,OUTDSC		; set up for FAO
	$FAO_S	CTRSTR=FNDCTM,OUTLEN=OUTDSC,OUTBUF=OUTDSC,-	;
		P1=FNDCNT		; edit "total matches" message
	OUTMSG	OUTDSC,OUT_BUFF		; output as message
900$:
	TSTB	BSFLAG			; test backspace flag
	BEQL	950$			; skip if zero
	BSBW	BACKSPACE		; otherwise move back one block/eof
950$:
	TSTB	FLAG			; test for original buffer contents
	BEQL	970$			; yes, skip
	MNEGL	#1,RECPTR		; no, initialize record pointer
970$:
	TSTL	FNDCNT			; did we find anything?
	BEQL	980$
	MOVC3	CURNAM,CURNAM,LOCNAM	; if so, update file for SHOW LOCATE
980$:
	RSB				; return for next command
	.PAGE
;
;	MATCHIT is called from LOCATE above to search BUFF as follows:
;
;		R7 = buffer address (absolute) at which to begin search
;		R8 = number of bytes to search
;		LSTRX = target string
;		LSTRL = length of target string
;
MATCHIT:
	MOVL	R7,R9			; init R9 = address to search
	MOVL	R8,R10			; init R10 = byte count
	TSTB	LOCSFL			; do we need to uppercase data?
	BNEQ	200$			; no - skip
	MOVAL	UCBUFF,R9		; yes - init R9 to search UCBUFF
	MOVW	R8,DESC			;
	MOVL	R7,DESC+4		;
	MOVW	R8,UDESC		; set up for uppercase translation
	MOVAL	UCBUFF,UDESC+4		;
	BSBW	UPCASE			; do the translation
	BLBS	R0,200$			; 
	BSBW	ERROUT			; error - so indicate to user
	CLRL	R0			; set to return internal error
	BRW	900$			;  and return to LOCATE
200$:
	MATCHC	LSTRL,LSTRX,R10,(R9)	; compare here
	TSTB	LOCSFL			; case-insensitive compare?
	BNEQ	300$			; no - skip
	SUBL2	#UCBUFF,R3		; yes - adjust R3 to make it appear that
	ADDL2	R7,R3			;  we were searching BUFF, not UCBUFF
300$:
	TSTL	R0			; did we find what we were looking for?
	BEQL	320$			; yes!
	BRW	700$			; nope - return "no find"
320$:
	INCL	FNDCNT			; increment find ct for global search
	SUBL2	LSTRL,R3		; R3 = address of first matched byte
	SUBL3	#BUFF,R3,R9		; R9 = address relative to BUFF
	TSTB	TAPFLG			; tape file?
	BNEQ	330$			;  yes, skip divide
	DIVL3	CURBCT,R9,R10		; R10 = block relative to BUFF block
	BRW	340$			;
330$:
	CLRL	R10			; zero block offset
	CMPL	R9,CURBCT		; find first byte in 1st or 2nd block?
	BLSS	340$			; skip if in first block
	INCL	R10			; otherwise, use offset of one
340$:
	MULL3	CURBCT,R10,R6		; R6 = byte offset from BUFF to data
	SUBL2	R6,R9			; R9 = byte offset within find block
	ADDL2	LBLOCK,R10		; adding LBLOCK - 1 to R10 makes
	DECL	R10			;  R10 = absolute block address
	MOVL	#100,OUTDSC		; set up for edit
	MOVAL	FNDMSG,DESC+4		; address of decimal control string
	TSTB	HEXFLG			; is RADIX=HEX?
	BEQL	345$
	MOVAL	FNDMSGX,DESC+4		; if so, use addr of hex ctl string
345$:
	$FAO_S	CTRSTR=@DESC+4,OUTLEN=OUTDSC,OUTBUF=OUTDSC,-	;
		P1=R10,P2=R9		; edit "find at block.. byte.." message
	MOVL	R10,LOCBLK
	MOVL	R9,LOCBYT		; save block and byte for SHOW LOCATE
	TSTB	LGFLAG			; is this a global search?
	BNEQ	350$			; yes - skip
	OUTMSG	OUTDSC,OUT_BUFF		; no - output as a message
	BRB	400$			;  and return "find"
350$:
	OUTPUT	OUTDSC,OUT_BUFF		; global - output as normal text
	TSTB	STOP			; user interrupt?
	BEQL	450$			; yes - continue, otherwise retn "find"
400$:
	ADDL3	#1,R9,LPTR		; update pointer for next locate
	MOVL	#1,R1			; set to return "find"
	BRW	800$			; return to LOCATE
450$:
	ADDL3	#1,R3,R9		; R9 = address of next byte to search
	SUBL3	R7,R9,R2		; R2 = byte count already searched
	SUBL3	R2,R8,R10		; R10 = remaining bytes to search
	CMPL	R10,LSTRL		; compare with target string length
	BLSS	700$			; not enough - return "no find"
	TSTB	LOCSFL			; case-insensitive compare?
	BNEQ	500$			; no
	ADDL3	#UCBUFF,R2,R9		; yes - set to search UCBUFF
500$:
	BRW	200$			; loop back to continue search
700$:
	CLRL	R1			; set to return "no find"
800$:
	MOVL	#1,R0			; set to return "normal status"
900$:
	RSB
;
;	UPCASE is called from LOCATE and MATCHIT to translate a character
;	string (DESC) to upper case (UDESC).
;
UPCASE:
	TSTB	EBCFLG			; is charset=ebcdic?
	BNEQ	100$			; yes - use internal table
	PUSHAL	DESC
	PUSHAL	UDESC
	CALLS	#2,G^STR$UPCASE		; no - translate ASCII
	BRB	200$
100$:
	MOVTC	DESC,@DESC+4,#0,EBUTBL,UDESC,@UDESC+4  ; trans EBCDIC
	MOVL	#1,R0			; good status
200$:
	RSB
	.PAGE
	.SBTTL	HELP - Call system help procedure
HELP::
	INCB	HLPON			; set help flag for TERMIO
	PUSHAL	HELPIN			; input routine address
	PUSHAL	HELPFLG			; HLP$M_PROMPT
	PUSHAL	HELPLIB			; SYS$HELP:
	PUSHAL	DESC			; initial input
	PUSHAL	HELPWID			; 80 characters
	PUSHAL	HELPOUT			; output routine address
	CALLS	#6,G^LBR$OUTPUT_HELP	; call system help routine
	BLBS	R0,900$
	BSBW	ERROUT
900$:
	RSB

HELPIN:
	.WORD	^M<R2>
	MOVL	4(AP),R2
	CVTWL	(R2),-(SP)		; input buffer length
	PUSHL	4(R2)			; input buffer address
	MOVL	8(AP),R2
	CVTWL	(R2),-(SP)		; prompt character count
	PUSHL	4(R2)			; prompt buffer address
	CALLS	#4,TERMIO		; call TERMIO to do the read
	CMPL	(AP),#3
	BLSS	200$
	MOVW	TSTATUS+2,@12(AP)	; returned input character count
200$:
	MOVL	#SS$_NORMAL,R0		; always return normal status
	RET

HELPOUT:
	.WORD	^M<R2>
	MOVL	4(AP),R2
	CVTWL	(R2),-(SP)		; output character count
	PUSHL	4(R2)			; output buffer address
	CALLS	#2,TERMIO		; call TERMIO to do the output
	MOVL	#SS$_NORMAL,R0		; return normal status
	RET
	.PAGE
	.SBTTL	SETCMD - Process various SET options
SETCMD::
	TSTL	R1			; R1=0 means call from GETFILE
	BEQL	100$			;  if zero, no SET POSITION here
	TSTB	POSFLG
	BEQL	100$
	BSBW	SETPOS			; SET POSITION if POSFLG set
100$:
	BITL	#^X1000,SETMASK
	BEQL	110$
	BSBW	LOGOFF			; SET NOLOG
110$:
	BITL	#^X1,SETMASK
	BEQL	120$
	BSBW	LOGON			; SET LOG
120$:
	BITL	#^X2,SETMASK
	BEQL	200$
	MOVB	#1,DSPFLG		; SET DISPLAY
200$:
	BITL	#^X2000,SETMASK
	BEQL	220$
	CLRB	DSPFLG			; SET NODISPLAY
220$:
	BITL	#^X4,SETMASK
	BEQL	300$
	MOVB	#1,SGNFLG		; SET SIGN
300$:
	BITL	#^X4000,SETMASK
	BEQL	320$
	CLRB	SGNFLG			; SET NOSIGN
320$:
	BITL	#^X8,SETMASK
	BEQL	400$
	MOVB	#1,HDRFLG		; SET HEADER
400$:
	BITL	#^X8000,SETMASK
	BEQL	420$
	CLRB	HDRFLG			; SET NOHEADER
420$:
	BITL	#^X10,SETMASK
	BEQL	500$
	MOVB	#1,CASFLG		; SET CASE
500$:
	BITL	#^X10000,SETMASK
	BEQL	520$
	CLRB	CASFLG			; SET NOCASE
	CLRL	LPTR			; zero LOCATE pointer for this also
520$:
	BITL	#^X20,SETMASK
	BEQL	540$
	MOVB	#1,HEXFLG		; SET RADIX=HEX
540$:
	BITL	#^X20000,SETMASK
	BEQL	560$
	CLRB	HEXFLG			; SET RADIX=DECIMAL
560$:
	BITL	#^X40,SETMASK
	BEQL	570$
	MOVB	#1,EBCFLG		; SET CHARSET=EBCDIC
570$:
	BITL	#^X40000,SETMASK
	BEQL	580$
	CLRB	EBCFLG			; SET CHARSET=ASCII
580$:
	BITL	#^X100,SETMASK
	BEQL	600$
	MOVB	#1,BUGFLG		; SET SKIP=FAST
	MOVL	#50,SKPINC
	BRB	640$
600$:
	BITL	#^X200,SETMASK
	BEQL	620$
	MOVB	#1,BUGFLG		; SET SKIP=SLOW
	MOVL	#1,SKPINC
	BRB	640$
620$:
	BITL	#^X400,SETMASK
	BEQL	640$
	CLRB	BUGFLG			; SET SKIP=NORMAL
	MOVL	#50,SKPINC
640$:
	BITL	#^X800,SETMASK
	BEQL	660$
	MOVL	#1,R1			; indicate call from SET
	BSBW	SETWID			; SET WIDTH
	BLBS	R0,660$
	BSBW	ERROUT			; display error if necessary
660$:
	BITL	#^X100000,SETMASK	; SET BUFF
	BEQL	680$
	TSTL	NBUFCT			; user-supplied buffer count
	BLEQ	670$			; error if < 1
	CMPL	NBUFCT,#LOCSIZ
	BGTR	670$			; error if > LOCSIZ
	MOVL	NBUFCT,BUFFCT		; move into BUFFCT (now set)
	TSTB	TAPFLG
	BNEQ	680$			; skip if editing tape
	MULL3	#512,BUFFCT,R1		; max new buffer size
	CMPL	R1,CURBCT		; is current buffer within this range?
	BGEQ	680$			;  yes, skip
	MOVL	R1,CURBCT		;  no, reduce to new max size
	BRB	680$
670$:
	OUTMSGC	INVBCT			; if error, indicate to user
680$:
	RSB
	.PAGE
	.SBTTL	SHOCMD - Process the SHOW command
SHOCMD::
	CLRB	CHAR1			; line feed char = null
	BITL	#^X10,SHOMASK
	BEQL	50$
	BSBW	SHOFILE			; SHOW FILE
	MOVB	#LF,CHAR1		; set for line feed now
50$:
	BITL	#^X1,SHOMASK		; test for SHOW MODES
	BNEQ	100$
	BRW	200$
100$:
	OUTMSGC	MODMSG			; "current mode settings:"
	MOVL	#20,OUTDSC
	$FAO_S	CTRSTR=BUFMOD,OUTLEN=OUTDSC,OUTBUF=OUTDSC,-
		P1=BUFFCT
	OUTMSG	OUTDSC,OUT_BUFF		; BUFF=count
	MOVB	CASFLG,R1
	MOVAL	CASMOD,R2
	BSBW	MODOUT1			; CASE setting
	MOVAL	CHRMOD,R2
	MOVAL	CHRASC,R7
	TSTB	EBCFLG
	BEQL	110$
	MOVAL	CHREBC,R7
110$:
	BSBW	MODOUT2			; CHARSET setting
	MOVB	DSPFLG,R1
	MOVAL	DSPMOD,R2
	BSBW	MODOUT1			; DISPLAY setting
	MOVB	HDRFLG,R1
	MOVAL	HDRMOD,R2
	BSBW	MODOUT1			; HEADER setting
	BSBW	SHOLOG			; LOG setting
	MOVAL	RADMOD,R2
	MOVAL	RADDEC,R7
	TSTB	HEXFLG
	BEQL	130$
	MOVAL	RADHEX,R7
130$:
	BSBW	MODOUT2			; RADIX setting
	MOVB	SGNFLG,R1
	MOVAL	SGNMOD,R2
	BSBW	MODOUT1			; SIGN setting
	MOVAL	SKPMOD,R2
	MOVAL	SKPNRM,R7
	TSTB	BUGFLG
	BEQL	150$
	MOVAL	SKPFST,R7
	CMPL	SKPINC,#1
	BGTR	150$
	MOVAL	SKPSLW,R7
150$:
	BSBW	MODOUT2			; SKIP setting
	MOVL	#20,OUTDSC
	$FAO_S	CTRSTR=WIDMOD,OUTLEN=OUTDSC,OUTBUF=OUTDSC,-
		P1=TERMWD
	OUTMSG	OUTDSC,OUT_BUFF		; WIDTH=count
	MOVB	#LF,CHAR1		; set to LF now
200$:
	BITL	#^X2,SHOMASK
	BEQL	300$
	MOVAL	CHGMOD,R7
	MOVAL	CHGPAR,R8
	BSBW	SHOSTR			; SHOW CHANGE
300$:
	BITL	#^X4,SHOMASK
	BEQL	400$
	MOVAL	LOCMOD,R7
	MOVAL	LOCPAR,R8
	BSBW	SHOSTR			; SHOW LOCATE
400$:
	BITL	#^X8,SHOMASK
	BEQL	500$
	MOVL	#50,OUTDSC
	$FAO_S	CTRSTR=PBMOD,OUTLEN=OUTDSC,OUTBUF=OUTDSC,-
		P1=PBBCT
	MOVB	CHAR1,OUT_BUFF
	OUTMSG	OUTDSC,OUT_BUFF		; SHOW PASTE first line
	TSTL	PBBCT
	BEQL	500$			; skip if paste buffer empty
	MOVAL	CUTMSG,R6
	MOVAL	PSTPAR,R8
	BSBW	SHOPOS			; SHOW PASTE second line
500$:
	RSB
;
;	MODOUT1 is called for on/off modes, such as CASE, DISPLAY.
;	   at entry, R2 is address of counted string literal for mode
;	             R1=0, add "NO" to display output
;
MODOUT1:
	MOVAL	OUT_BUFF+8,R6		; first 8 chars are blanks
	TSTB	R1
	BNEQ	100$
	MOVW	#^A/NO/,(R6)+		; move in "NO" if R1 = 0
100$:
	MOVZBL	(R2),R1			; string length
	MOVC3	R1,1(R2),(R6)		; move into buffer
	SUBL2	#OUT_BUFF,R3
	OUTMSG	R3,OUT_BUFF		; output message
	RSB
;
;	MODOUT2 is called for typed modes, such as CHARSET, RADIX.
;	   at entry, R2 is address of counted string literal for mode
;	             R7 is address of counted string literal for setting
MODOUT2:
	MOVZBL	(R2),R1			; mode string length
	MOVC3	R1,1(R2),OUT_BUFF+8	; move into buffer+8
	MOVZBL	(R7),R1			; setting type string length
	MOVC3	R1,1(R7),(R3)		; append into buffer
	SUBL2	#OUT_BUFF,R3
	OUTMSG	R3,OUT_BUFF		; output message
	RSB
;
;	SHOSTR is called for SHOW CHANGE and SHOW LOCATE.
;	   at entry, R7 is address of 6-char literal "CHANGE" or "LOCATE"
;	             R8 is address of parameter block for change or locate
;
SHOSTR:
	TSTL	(R8)			; test length of chg/loc string
	BGTR	100$			; skip if greater than zero
	MOVB	CHAR1,NOSTR+1		; null or LF
	MOVC3	#6,(R7),NOSTR+22	; move in "CHANGE" or "LOCATE"
	OUTMSGC	NOSTR			; "there is no xxxxxxx string"
	BRW	900$			; exit
100$:
	MOVC3	#STMLEN,STRMSG,OUT_BUFF	; move in "current xxxxxx string="
	MOVC3	#6,(R7),OUT_BUFF+9	; repl xxx with "CHANGE" or "LOCATE"
	MOVAL	OUT_BUFF+STMLEN,R6	; R6 is next address in output buffer
	TSTB	4(R8)			; test for character string (type 0)
	BNEQ	150$			; skip if not
;
;	insert character string into message
;
	MOVB	#^A/"/,(R6)+		; char string - insert leading quote
	MOVC3	(R8),@8(R8),(R6)	; move string into buffer
	ADDL2	(R8),R6			; update address
	MOVB	#^A/"/,(R6)+		; insert trailing quote
	MOVC3	#STCLEN,STRCHS,(R6)	; move in "(character string)"
	ADDL2	#STCLEN,R6		; update address
	BRW	300$			; go output message
150$:
	CMPB	4(R8),#2		; test type for decimal (1 or 2)
	BLEQ	160$
	BRW	250$			; skip if not
;
;	insert decimal number into message
;
160$:
	MOVAL	STRDECB,R5		; R5 is FAO control str descr address
	CVTBL	@8(R8),R9		; R9 is value
	CMPB	(R8),#1
	BLEQ	180$			; length 1 is a byte
	MOVAL	STRDECW,R5
	CVTWL	@8(R8),R9
	CMPB	(R8),#2
	BLEQ	180$			; length 2 is a word
	MOVAL	STRDECL,R5
	MOVL	@8(R8),R9		; otherwise, longword
180$:
	MOVL	4(R5),R2		; address of FAO control string
	MOVB	#^A/+/,(R2)		; indicate positive constant
	CMPB	4(R8),#1		; test for neg constant
	BLEQ	200$
	MOVB	#^A/-/,(R2)		; if neg, use minus sign
	MNEGL	R9,R9			;  and negate number for FAO
200$:
	MOVL	R5,SHOPTR		; save ctrl string address
	MOVW	#50,DESC
	MOVL	R6,DESC+4		; set up to append to existing msg
	$FAO_S	CTRSTR=@SHOPTR,OUTLEN=DESC,OUTBUF=DESC,-
		P1=R9
	CVTWL	DESC,R1
	ADDL2	R1,R6			; add FAO output len to R6
	BRW	300$			; go output message
;
;	insert hex string into message
;
250$:
	MOVL	8(R8),R4		; address of start of data
	MOVL	(R8),R5			; length of hex string
260$:
	EXTZV	#4,#4,(R4),R9
	MOVB	HEXD[R9],(R6)+		; append first hex char
	EXTZV	#0,#4,(R4)+,R9
	MOVB	HEXD[R9],(R6)+		; append second hex char
	SOBGTR	R5,260$			; loop back for remaining bytes
	MOVC3	#STHLEN,STRHEX,(R6)	; append "(hex string)"
	ADDL2	#STHLEN,R6
;
;	output message
;
300$:
	MOVB	CHAR1,OUT_BUFF		; move in null/LF
	SUBL2	#OUT_BUFF,R6		; compute char count
	OUTMSG	R6,OUT_BUFF		; output here
	TSTW	@20(R8)			; check if file spec present
	BEQL	900$			; skip if not
	MOVL	LSTMSG+4,R1		; address of "Last xxxxxxd at"...
	MOVC3	#6,(R7),5(R1)		; move in CHANGE/LOCATE
	MOVAL	LSTMSG,R6		; R6 = descriptor for above
	BSBW	SHOPOS			; go output second line
900$:
	MOVB	#LF,CHAR1		; set for LF between messages
	RSB
;
;	SHOPOS is called for SHOW CHANGE, LOCATE, PASTE, to format and
;	output the second line of the message when appropriate.
;	   at entry, R6 = descriptor for first part of second line message
;	             R8 = parameter block address
;
SHOPOS:
	MOVAL	FILMOD,SHOPTR		; control string with dec byte ind
	TSTB	HEXFLG
	BEQL	100$
	MOVAL	FILMODX,SHOPTR		; if RAD=HEX, use hex byte ind
100$:
	MOVL	20(R8),R2		; address of file name info
	SUBW3	#2,(R2),DESC		; byte count of file name
	ADDL3	#2,R2,DESC+4		; address of file name string
	MOVL	#150,OUTDSC
	$FAO_S	CTRSTR=@SHOPTR,OUTLEN=OUTDSC,OUTBUF=OUTDSC,-
		P1=R6,P2=12(R8),P3=16(R8),P4=#DESC
	OUTMSG	OUTDSC,OUT_BUFF		; output second line and exit
	RSB
;
;
;
	.SBTTL	ADD - Add 1 or more numbers & print
ADD::
	MOVAL	ADDMSG,R1		; signed output control string
	TSTB	SGNFLG
	BNEQ	100$
	MOVAL	ADDMSGU,R1		; use unsigned if SET NOSIGN
100$:
	MOVL	#30,OUTDSC
	$FAO_S	CTRSTR=(R1),OUTLEN=OUTDSC,OUTBUF=OUTDSC,-
		P1=ACCUM,P2=ACCUM
	OUTMSG	OUTDSC,OUT_BUFF		; output total line
	RSB
	.PAGE
	.SBTTL	Miscellaneous utility routines

ERROUT::
	MOVL	#80,OUTDSC
	$GETMSG_S  MSGID=R0,MSGLEN=OUTDSC,BUFADR=OUTDSC
	OUTMSG	OUTDSC,OUT_BUFF
	RSB

ZEROBLK::
	MOVL	#1,R0
	TSTL	CURBCT
	BGTR	200$
	MOVL	PARA1,P1SAVE
	MOVL	#1,PARA1
	BSBW	NEXT
	BLBC	R0,100$
	BSBW	BLOCK
100$:
	MOVL	P1SAVE,PARA1
200$:
	RSB

BLOCK::
	MOVL	#20,OUTDSC
	$FAO_S	CTRSTR=BLKMSG,OUTLEN=OUTDSC,OUTBUF=OUTDSC,-
		P1=CURBLK
	OUTPUT	OUTDSC,OUT_BUFF
	RSB

INVPARA::
	OUTMSG	#INVPL,INVP
	MOVL	#0,R0
	RSB

EXIT::
	BSBW	LOGOFF
	BSBW	RELFILE
	MOVL	#1,R0
ERREXT::
	MOVL	R0,SVSTAT
	MOVL	INITWID,NEWWID
	CLRL	R1
	BSBW	SETWID
	$EXIT_S	CODE=SVSTAT
	.PAGE
	.SBTTL	Data definitions

	.PSECT	DATA,WRT,NOEXE,LONG

DESC::	.WORD	80
	.WORD	^X010E
	.ADDRESS  FNAME

OUTDSC:: .LONG	200
	.ADDRESS  OUT_BUFF
OUT_BUFF:: .BLKB  200

SIGNON:	.ASCII	/MCCCD VFE V2.0 /
SIGN2:	.ASCII	/dd-mmm-yyyy hh:mm:ss.cc/
SGNL=.-SIGNON-6
SGNTIM:	.WORD	23
	.WORD	^X010E
	.ADDRESS SIGN2

INVP:	.ASCII	/Invalid parameter(s)/
INVPL=.-INVP

CBEMPTY:: .ASCIC /The current buffer is empty./

PBEMPTY:: .ASCIC /The paste buffer is empty./

PBSMALL: .ASCID	/Paste buffer contains !UL bytes - remaining !UL bytes zeroed./

PBLARGE: .ASCID	/Paste buffer contains !UL bytes - only !UL bytes transferred./

NFMSG:	.ASCII	/Not found./
NFMSGL=.-NFMSG

BLKMSG:	.ASCID	/Block !SL/

FNDMSG:	.ASCID	/Find at block !SL, byte !UL/
FNDMSGX: .ASCID	/Find at block !SL, byte !4XL/

FNDCTM:	.ASCID	/Total matches: !UL/

INVBCT:	.ASCIC	/Invalid buffer count/

MODMSG:	.ASCIC	/ Current mode settings:/
CHAR1=MODMSG+1
BUFMOD:	.ASCID	/        BUFF=!UL/
CASMOD:	.ASCIC	/CASE/
CHRMOD:	.ASCIC	/CHARSET=/
CHRASC:	.ASCIC	/ASCII/
CHREBC:	.ASCIC	/EBCDIC/
DSPMOD:	.ASCIC	/DISPLAY/
HDRMOD:	.ASCIC	/HEADER/
RADMOD:	.ASCIC	/RADIX=/
RADDEC:	.ASCIC	/DECIMAL/
RADHEX:	.ASCIC	/HEX/
SGNMOD:	.ASCIC	/SIGN/
SKPMOD:	.ASCIC	/SKIP=/
SKPNRM:	.ASCIC	/NORMAL/
SKPFST:	.ASCIC	/FAST/
SKPSLW:	.ASCIC	/SLOW/
WIDMOD:	.ASCID	/        WIDTH=!UL/
CHGMOD:	.ASCII	/change/
LOCMOD:	.ASCII	/locate/
PBMOD:	.ASCID	/ The paste buffer contains !UL bytes./
NOSTR:	.ASCIC	/ There is no current xxxxxx string./
STRMSG:	.ASCII	/ Current xxxxxx string = /
STMLEN=.-STRMSG
STRCHS: .ASCII	/ (character string)/
STCLEN=.-STRCHS
STRDECB: .ASCID	/x!3ZB (decimal byte)/
STRDECW: .ASCID	/x!5ZW (decimal word)/
STRDECL: .ASCID	/x!10ZL (decimal longword)/
STRHEX:	.ASCII	/ (hex string)/
STHLEN=.-STRHEX
LSTMSG:	.ASCID	/Last xxxxxxd at/
CUTMSG:	.ASCID	/Cut from/
FILMOD:	.ASCID	/!AS block !SL byte !UL of !AS/
FILMODX: .ASCID	/!AS block !SL byte !4XL of !AS/

ADDMSG:	.ASCID	/!SL(10)  !XL(16)/
ADDMSGU: .ASCID	/!UL(10)  !XL(16)/

HELPLIB: .ASCID	/SYS$HELP:VFE.HLB/
HELPFLG: .LONG	HLP$M_PROMPT
HELPWID: .LONG	80
HLPON::	.BYTE	0

EBUTBL:
	.BYTE	  0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15
	.BYTE	 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31
	.BYTE	 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47
	.BYTE	 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63
	.BYTE	 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79
	.BYTE	 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95
	.BYTE	 96, 97, 98, 99,100,101,102,103,104,105,106,107,108,109,110,111
	.BYTE	112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127
	.BYTE	128,193,194,195,196,197,198,199,200,201,138,139,140,141,142,143
	.BYTE	144,209,210,211,212,213,214,215,216,217,154,155,156,157,158,159
	.BYTE	160,161,226,227,228,229,230,231,232,233,170,171,172,173,174,175
	.BYTE	176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191
	.BYTE	192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207
	.BYTE	208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223
	.BYTE	224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239
	.BYTE	240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255

INITWID: .LONG	0

TERMON::
DSPFLG:	.BYTE	1
NOLOG::	.BYTE	1

SGNFLG:: .BYTE	1

HDRFLG:: .BYTE	1

CASFLG:: .BYTE	1

HEXFLG:: .BYTE	0

EBCFLG:: .BYTE	0

STOP::	.BYTE	0

ACCUM::	.LONG	0

P1SAVE:	.LONG	0
SVSTAT:	.LONG	0
FLAG:	.BYTE	0
BSFLAG:	.BYTE	0
LSTBCT:	.LONG	0
FNDCNT:	.LONG	0
LGFLAG:: .BYTE	0
LOCSFL:	.BYTE	0
LBLOCK:	.LONG	0
LBLKCT:	.LONG	0
REMCT:	.LONG	0
SHOPTR:	.LONG	0

PSTPAR:
PBBCT:: .LONG	0
	.LONG	0
	.ADDRESS  PBUFF
PSTBLK:	.LONG	0
PBOFF::	.LONG	0
	.ADDRESS  PSTNAM
PSTNAM:	.WORD	0
	.BLKB	200

CHGPAR:
CSTRL::	.LONG	0
CSTRT::	.LONG	0
	.ADDRESS  CSTR
CHGBLK:	.LONG	0
CHGBYT:	.LONG	0
	.ADDRESS  CHGNAM
CSTR::	.BLKB	100
CHGNAM:	.WORD	0
	.BLKB	200

LOCPAR:
LSTRL::	.LONG	0
LSTRT::	.LONG	0
	.ADDRESS  LSTR
LOCBLK:	.LONG	0
LOCBYT:	.LONG	0
	.ADDRESS  LOCNAM
LPTR::	.LONG	0
LSTR::	.BLKB	100
LSTRX:	.BLKB	100
LOCNAM:	.WORD	0
	.BLKB	200

UDESC:	.QUAD	0
SAVBCT:	.LONG	0
SBUFF:	.BLKB	LOCSIZ*512

	.ALIGN	LONG
BUFF::	.BLKB	MAXBCT*2
PBUFF::	.BLKB	MAXBCT
UCBUFF:	.BLKB	MAXBCT+200

	.END	START