.TITLE	VFE VMS File Editor

	.IDENT	/MCCCD VFE V3.0/

	.SBTTL	Introduction
;
; VMS File Editor, Version 3.0
;
;     Written at MCCCD by Ward Condit, spring 1984
;     (Enhanced, fall 1985, spring 1987)
;
;     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 can be operated in either block mode or record mode.
; Block-mode operation is independent of file type.
;
; 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==65535	; Max block size (bytes) for tape read
		;  (must be >= LOCSIZ*512)

LF=^X0A

	.ENABLE	SUPPRESSION

;	.LIBRARY  'VFELIB'
	.MACRO	INPUT	ARG1,ARG2,ARG3,ARG4
	CVTWL	ARG3,-(SP)
	PUSHAL	ARG4
	CVTWL	ARG1,-(SP)
	PUSHAL	ARG2
	CALLS	#4,TERMIO
	.ENDM

	.MACRO	OUTPUT	ARG1,ARG2
	CVTWL	ARG1,-(SP)
	PUSHAL	ARG2
	CALLS	#2,TERMIO
	.ENDM

	.MACRO	OUTMSG	ARG1,ARG2
	PUSHL	#1
	CVTWL	ARG1,-(SP)
	PUSHAL	ARG2
	CALLS	#3,TERMIO
	.ENDM

	.MACRO	OUTMSGC	ARG1
	PUSHL	#1
	MOVZBL	ARG1,-(SP)
	PUSHAL	ARG1+1
	CALLS	#3,TERMIO
	.ENDM

	$HLPDEF
	.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:: .jsb_entry
	BSBW	MODCHK			; test if change permitted
	BLBC	R0,80$			; error if not
	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	120$			; 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"
80$:
	BRW	600$
100$:
	BSBW	INVPARA			; output error message and exit
	BRW	600$
120$:
	BSBW	TRANCHK
	BLBS	R0,200$
	BRW	600$
;
; At this point the parameters have been validated.
;
200$:
	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)
	MOVAL	BUFF,R7
	ADDL2	PARA1,R7		; R7 = address of first byte to change
	MOVC3	CSTRL,(R6),(R7)		; move change-string to buffer
	MOVL	CURBLK,CHGBLK
	MOVL	PARA1,CHGBYT		; save block, byte, and
	MOVC3	CURNAM,CURNAM,CHGNAM	;   file name for SHOW CHANGE
	MOVL	BUFTYP,CHGBTP		; save buffer type (block/rec)
	MOVB	#1,RECCHG		; set buffer changed flag
	TSTB	NRFLAG			; test for new record
	BEQL	600$
	CLRL	CHGBLK			; if so, block number is meaningless
600$:
	RSB
	.PAGE
	.SBTTL	SUBSTITUTE - Replace one string with another
SUBSTITUTE:: .jsb_entry
	BSBW	MODCHK			; test if modification permitted
	BLBS	R0,80$
	BRW	900$			; stop here if not
80$:
	TSTL	CURBCT			; anything in the current buffer?
	BGTR	90$
	OUTMSGC	CBEMPTY			; if not, prt error and exit
	BRW	900$
90$:
	MOVZWL	DESC,R3			; setup R3 = character count
	MOVL	DESC+4,R4		; R4 = address of parameter string
100$:
	MOVB	(R4)+,R5		; first char into R5
	SOBGTR	R3,110$			; decrement char count
	BRW	190$			; error if already done
110$:
	CMPB	R5,#^A/ /		; test for leading spaces
	BEQL	100$			; if so, go back for non-blank char
	MOVL	R4,SUBS1		; save address of target string
	MNEGL	#1,SUBS1L		; init string length
120$:
	INCL	SUBS1L			; incr target string length
	CMPB	(R4)+,R5		; test next char for delimiter
	BEQL	130$			; if so, target string complete
	SOBGTR	R3,120$			; if not, loop back for more
	BRB	190$			; error if out of chars here
130$:
	TSTL	SUBS1L			; test target string length
	BLEQ	190$			; error if less than one char
	MOVL	R4,SUBS2		; save address of replacement string
	MNEGL	#1,SUBS2L		; init string length
150$:
	INCL	SUBS2L			; incr replacement str length
	CMPB	(R4)+,R5		; test next char for delimiter
	BEQL	160$			; if so, replacement str complete
	SOBGTR	R3,150$			; if not, loop back
	BRB	190$			; error if out of chars here
160$:
	TSTL	SUBS2L			; test replacement str length
	BLEQ	190$			; error if less than one char
	CMPL	R3,#2			; test for 2 (2 delims uncounted)
	BEQL	200$			; if so, all checks correct
190$:
	BSBW	INVPARA			; print invalid param msg
	BRW	900$			;  and exit
200$:
	MOVC3	DESC,@DESC+4,SUBSTR	; move sub string to save area
	MOVZWL	DESC,SBSTRL		;  and save length
	CLRW	SUBNAM			; zero file name for now
	CLRB	LGFLAG			; clear LGLOBAL flag
	MOVB	#1,SBFLAG		; set substitute flag
	MOVW	SUBS1L,QDESC		; store target length
	MOVL	SUBS1,QDESC+4		;  and address
	CLRB	QTYPE			; indicate string type
	MNEGL	#1,SUBPTR		; init locate/sub pointer
	PUSHL	LPTR			; push orig value of LPTR
	BSBW	LOCATE			; call LOCATE to do the dirty work
	MOVL	(SP)+,LPTR		; restore LPTR
	MOVL	SUBPTR,PARA1		; store address of found string
	BGEQ	220$
	BRW	900$			; skip if neg (no find)
220$:
	ADDL3	SUBPTR,SUBS2L,R1	; R1 = last byte to alter
	CMPL	R1,CURBCT		; compare with curr buff length
	BLEQ	240$
	BSBW	INVPARA			; error if won't fit within buffer
	BRW	900$
240$:
	MOVW	SUBS2L,QDESC		; store replacement length
	MOVL	SUBS2,QDESC+4		;  and address
	BSBW	TRANCHK			; trans to EBCDIC (if req), ck key(s)
	BLBS	R0,300$
	BRW	900$			; error if return bad status
;
; Everything is OK - move data into current buff and save relevant info
;
300$:
	MOVAL	BUFF,R7
	ADDL2	SUBPTR,R7		; R7 = addr of first byte to modify
	MOVC3	SUBS2L,(R6),(R7)	; move replacement string to buffer
	MOVL	CURBLK,SUBBLK		; save block number
	MOVC3	CURNAM,CURNAM,SUBNAM	; save file name
	MOVL	BUFTYP,SUBBTP		;  and buffer type (block/rec)
	MOVL	#1,RECCHG		; set record changed flag
	TSTB	NRFLAG			; test for new record
	BEQL	400$
	CLRL	SUBBLK			; if so, block number is meaningless
400$:
	MOVL	#80,OUTDSC		; setup for status msg
	$FAO_S	CTRSTR=SUBMSG,OUTLEN=OUTDSC,OUTBUF=OUTDSC,-
		P1=SUBS2L,P2=SUBPTR
	OUTMSG	OUTDSC,OUT_BUFF		; print substitute status message
900$:
	RSB
	.PAGE
; This routine is called by CHANGE and SUBSTITUTE to translate
; the replacement string to EBCDIC (if required) and check for
; key modifications.
;
TRANCHK: .jsb_entry
	MOVL	QDESC+4,R6		; R6 = addr of replacement string
	TSTB	QTYPE			; test for char string type
	BNEQ	200$			;  skip if numeric
	TSTB	EBCFLG			; if char string, check EBCDIC flag
	BEQL	200$			; skip if ASCII
	MOVW	QDESC,DESC
	MOVAL	SBUFF,DESC+4		; setup for translate
	PUSHAL	DESC
	PUSHAL	QDESC
	CALLS	#2,G^LIB$TRA_ASC_EBC	; trans to EBCDIC into SBUFF
	BLBS	R0,100$
	BSBW	ERROUT			; indicate error if necessary
	CLRL	R0
	BRB	300$
100$:
	MOVAL	SBUFF,R6		; move SBUFF addr to R6
200$:
	MOVZWL	QDESC,PARA2		; save length of repl string
	BSBW	KEYCHK			; check for invalid key changes
300$:
	RSB
	.PAGE
	.SBTTL	CUT - Transfer current buff to paste buff
;
; Processing for the CUT command.
;
CUT:: .jsb_entry
	BSBW	CPINIT			; call cut/paste init
	BLBS	R0,100$
	BRB	200$			; don't cut if error
100$:
	MOVC3	PARA2,(R7),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
	MOVL	BUFTYP,PASBTP		; save buffer type (block/rec)
	TSTB	NRFLAG
	BEQL	200$
	CLRL	PSTBLK			; clear block # if new record
200$:
	RSB

	.SBTTL	PASTE - Transfer paste buff to current buff
;
; Processing for the PASTE command.
;
PASTE:: .jsb_entry
	BSBW	MODCHK			; test if change permitted
	BLBC	R0,80$			; error if not
	BSBW	CPINIT			; call cut/paste init
	BLBS	R0,100$
80$:
	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,R5
	BLEQ	220$
	ADDL3	PBBCT,#PBUFF,R6
	MOVC5	#0,PBUFF,#0,R5,(R6)
220$:
	MOVAL	PBUFF,R6
	BSBW	KEYCHK
	BLBS	R0,260$
	BRW	900$
260$:
	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$:
	MOVC3	PARA2,PBUFF,(R7)	; move selected data to curr buff
	MNEGL	#1,RECPTR		; clear the RECORD pointer
	MOVB	#1,RECCHG		; set buffer changed flag
900$:
	RSB
;
; This routine is called by change and paste to test if change is OK
;
MODCHK: .jsb_entry
	MOVB	#1,R0			; set initial "good" status
	TSTB	WRTFLG			; is file/dev opened /WRITE?
	BNEQ	100$			;  yes, continue check
	OUTMSGC	ROMNC			;  no, display err and exit
	BRB	120$
100$:
	TSTB	RMSFLG			; is file accessed thru RMS?
	BEQL	200$			;  no - change is OK
	TSTB	RECLCK			;  yes - record must be locked
	BNEQ	200$			; rec locked, change is OK
	OUTMSGC	MUSTLCK			; not locked, err and exit
120$:
	CLRL	R0			; set error status
200$:
	RSB
;
; This routine called by CUT and PASTE to validate user range
;
CPINIT: .jsb_entry
	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,R7		; setup R7 = 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:: .jsb_entry
	TSTL	CURBCT			; check size of current buffer
	BGTR	50$			; skip if nonzero
	TSTB	RMSFLG
	BNEQ	50$			; skip also if RMS access
	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
	TSTB	SBFLAG
	BNEQ	190$
	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	QDESC,(R7),LSTRX	; move locate string to LSTRX
	MOVZWL	QDESC,LSTRXL
	MOVB	QTYPE,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	LSTRXL,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	LSTRXL,DESC		;
	MOVAL	LSTRX,DESC+4		;
	MOVW	LSTRXL,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
;
;	 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	LSTRXL,R8		; compare with target string length
	BGTR	400$			; skip if not enough to search
	SUBL3	#1,LSTRXL,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	SBFLAG
	BEQL	435$
	BRW	800$
435$:
	TSTB	TAPFLG			; editing tape?
	BNEQ	440$			; yes - skip
	TSTB	RMSFLG			; RMS file access?
	BNEQ	450$			; yes, handle differently
	MOVC3	CURBCT,BUFF,SBUFF	; no - move curr buff to SBUFF
	MOVL	CURBCT,SAVBCT		;  and save buffer size
	SUBL3	#512,CURBCT,R1
	BEQL	440$			; 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
440$:
	BRW	500$			; process block-oriented stuff.
	.PAGE
;
;	This handles the locate for files accessed thru RMS.
;	Strings which traverse record boundaries are ignored here.
;
450$:
	TSTB	NRFLAG			; test if new record
	BEQL	455$			;  nope, continue
	BRW	800$			;  yes, stop locate before read
455$:
	MOVL	CURBLK,SAVCBK		; save current block number
460$:
	BSBW	NEXTRMS			; get the next record
	BLBS	R0,470$			; skip if normal return
	CMPL	R0,#RMS$_EOF		; test for EOF status
	BEQL	490$			; if so, "no find"
	BRB	480$			; if not, stop here
470$:
	CMPL	CURBCT,LSTRXL		; is this record long enough?
	BLSS	475$			; skip if not
	MOVAL	BUFF,R7			; setup first byte to search
	MOVL	CURBCT,R8		; length of buffer to search
	ADDL3	#1,CURBLK,LBLOCK	; setup so MATCHIT ind correct rec
	BSBW	MATCHIT			; go look for the string
	BLBC	R0,480$			; stop if internal error
	BLBS	R1,480$			;  or if non-global find is made
475$:
	TSTB	STOP			; check for user interrupt
	BEQL	460$			; get next record if none
480$:
	BRW	970$			; error or find goes here
490$:
	MOVL	SAVCBK,PARA1		; no find
	BSBW	READ			;  restore original buffer
	BRW	800$			;  and print appropriate message
	.PAGE
;
;	This is the top of the locate loop for block access files/devs
;
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,LSTRXL,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$:
	TSTB	SBFLAG
	BNEQ	980$
	TSTL	FNDCNT			; did we find anything?
	BEQL	980$
	MOVC3	CURNAM,CURNAM,LOCNAM	; if so, update file for SHOW LOCATE
	MOVL	BUFTYP,LOCBTP		; save buffer type (block/rec)
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
;		LSTRXL = length of target string
;
MATCHIT: .jsb_entry
	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	LSTRXL,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	LSTRXL,R3		; R3 = address of first matched byte
	SUBL3	#BUFF,R3,R9		; R9 = address relative to BUFF
	TSTB	SBFLAG
	BEQL	325$
	MOVL	R9,SUBPTR
	MOVL	#1,R1
	BRW	800$
325$:
	TSTB	TAPFLG			; tape file?
	BNEQ	330$			;  yes, skip divide
	DIVL3	CURBCT,R9,R10		; R10 = block relative to BUFF block
	BRB	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
	TSTB	NRFLAG
	BEQL	342$
	CLRL	R10			; zero block no if find in new record
342$:
	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=BUFTYP,P2=R10,P3=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,LSTRXL		; 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: .jsb_entry
	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:: .jsb_entry
	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
	.entry helpin,^m<r2>
;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
	.entry helpout,^m<r2>
;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:: .jsb_entry
	MOVL	R1,SETTYP		; R1=0 means call from GETFILE
	BEQL	100$			;  if zero, no SET POS or KEY here
	TSTB	POSFLG
	BEQL	50$
	BSBW	SETPOS			; SET POSITION if POSFLG set
50$:
	BITL	#^X80,SETMASK		; check for SET KEY
	BEQL	100$
	TSTB	NRFLAG
	BEQL	60$
	OUTMSGC	NOSETK
	MOVZBL	CURKRF,NEWKRF
	BRB	100$
60$:
	MOVB	CURKRF,R10		; save curr key of ref
	BSBW	SETKEY			; setup new key of reference
	CMPB	R10,CURKRF		; same key?
	BEQL	100$			;  yes, skip
	MOVB	#1,KEYFLG		;  no, flag to force table init
	BSBW	TOP			;  and position to top of file
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
	BRB	420$
400$:
	BITL	#^X8000,SETMASK
	BEQL	450$
	TSTB	NRFLAG			; new RMS record in buffer?
	BEQL	410$
	OUTMSGC	MBSNR			; yes, can't SET NOHEADER, exit
	BRB	450$
410$:
	CLRB	HDRFLG			; SET NOHEADER
420$:
	BSBW	RRDRMS			; reread RMS, this affects rec size
450$:
	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)
	ADDB3	TAPFLG,RMSFLG,R1
	BEQL	665$			; test for editing tape or RMS file
	TSTL	SETTYP
	BEQL	680$
	OUTMSGC	BDONLY
	BRB	680$
665$:
	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:: .jsb_entry
	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
	MOVL	#20,OUTDSC
	$FAO_S	CTRSTR=KEYMOD,OUTLEN=OUTDSC,OUTBUF=OUTDSC,-
		P1=CURKRF
	OUTMSG	OUTDSC,OUT_BUFF		; KEY=key of reference
	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: .jsb_entry
	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: .jsb_entry
	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: .jsb_entry
	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: .jsb_entry
	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=24(R8),P3=12(R8),P4=16(R8),P5=#DESC
	OUTMSG	OUTDSC,OUT_BUFF		; output second line and exit
	RSB
;
;
;
	.SBTTL	ADD - Add 1 or more numbers & print
ADD:: .jsb_entry
	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:: .jsb_entry
	MOVL	#80,OUTDSC
	$GETMSG_S  MSGID=R0,MSGLEN=OUTDSC,BUFADR=OUTDSC
	OUTMSG	OUTDSC,OUT_BUFF
	RSB
ZEROBLK:: .jsb_entry
	MOVL	#1,R0
	TSTL	CURBCT
	BGTR	200$
	TSTB	RMSFLG
	BEQL	50$
	OUTMSGC	ZLREC
	CLRL	R0
	BRB	200$
50$:
	MOVL	PARA1,P1SAVE
	MOVL	#1,PARA1
	BSBW	NEXT
	BLBC	R0,100$
	BSBW	BLOCK
100$:
	MOVL	P1SAVE,PARA1
200$:
	RSB
BLOCK:: .jsb_entry
	MOVL	#20,OUTDSC
	TSTB	RMSFLG
	BNEQ	100$
	$FAO_S	CTRSTR=BLKMSG,OUTLEN=OUTDSC,OUTBUF=OUTDSC,-
		P1=CURBLK
	BRB	200$
100$:
	$FAO_S	CTRSTR=RECMSG,OUTLEN=OUTDSC,OUTBUF=OUTDSC,-
		P1=CURBLK
200$:
	OUTPUT	OUTDSC,OUT_BUFF
	RSB
INVPARA:: .jsb_entry
	OUTMSG	#INVPL,INVP
	MOVL	#0,R0
	RSB
EXIT:: .jsb_entry
	BSBW	LOGOFF
	BSBW	RELFILE
	MOVL	#1,R0
	MOVL	R0,SVSTAT
	MOVL	INITWID,NEWWID
	CLRL	R1
	BSBW	SETWID
	$EXIT_S	CODE=SVSTAT
ERREXT:: .jsb_entry
	MOVL	R0,SVSTAT
	MOVL	INITWID,NEWWID
	CLRL	R1
	BSBW	SETWID
	$EXIT_S	CODE=SVSTAT
	.PAGE
	.SBTTL	Data definitions

	.PSECT	DATA,WRT,NOEXE,quad

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

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

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

ZLREC::	.ASCIC	/Zero-length record/

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

ROMNC:	.ASCIC	/Read-only mode; no changes permitted./

MUSTLCK:: .ASCIC	/Record must be locked before change./

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

SUBMSG:	.ASCID	/!UL characters replaced beginning byte !UL/

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/

RECMSG:	.ASCID	/Record !SL/

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

FNDCTM:	.ASCID	/Total matches: !UL/

NOSETK:	.ASCIC	/Cannot change key of reference until new record is written/

MBSNR:	.ASCIC	/HEADER mode must remain set until new record is written/

BDONLY:	.ASCIC	/Buffer count only affects block-mode disk/

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/
KEYMOD:	.ASCID	/        KEY=!UB/
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 !AS !SL byte !UL of !AS/
FILMODX: .ASCID	/!AS !AS !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
	.align quad
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
SAVCBK:	.LONG	0
LSTBCT:	.LONG	0
FNDCNT:	.LONG	0
LGFLAG:: .BYTE	0
SBFLAG:: .BYTE	0
LOCSFL:	.BYTE	0
LBLOCK:	.LONG	0
LBLKCT:	.LONG	0
REMCT:	.LONG	0
SETTYP:	.LONG	0
SHOPTR:	.LONG	0

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

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

SUBPAR:
SBSTRL:: .LONG	0
	.LONG	0	; (SBSTRT always 0)
	.ADDRESS  SUBSTR
SUBBLK:	.LONG	0
SUBPTR:	.LONG	0
	.ADDRESS  SUBNAM
SUBBTP:	.LONG	0
SUBSTR:: .BLKB	132
SUBS1:	.LONG	0
SUBS1L:	.LONG	0
SUBS2:	.LONG	0
SUBS2L:	.LONG	0
SUBNAM:	.WORD	0
	.BLKB	200

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

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

	.ALIGN	LONG
BUFF::	.BLKB	<MAXBCT+256>*2
BUFFX=<BUFF+MAXBCT+256>

PBUFF::	.BLKB	MAXBCT

UCBUFF:	.BLKB	MAXBCT+200

	.END	START