Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Path: utzoo!mnetor!uunet!seismo!husc6!uwvax!rutgers!sri-spam!ames!sdcsvax!ucbvax!ENGVAX.SCG.HAC.COM!PORTIA From: PORTIA@ENGVAX.SCG.HAC.COM (Portia 616-2635) Newsgroups: comp.os.vms Subject: virtual file editor (VFE) source (4 of 5) (73 blocks) Message-ID: <8707252048.AA14973@ucbvax.Berkeley.EDU> Date: Sat, 25-Jul-87 13:15:00 EDT Article-I.D.: ucbvax.8707252048.AA14973 Posted: Sat Jul 25 13:15:00 1987 Date-Received: Sun, 26-Jul-87 02:44:04 EDT Sender: daemon@ucbvax.BERKELEY.EDU Distribution: world Organization: The ARPA Internet Lines: 1195 $ show default $ check_sum = 824401541 $ write sys$output "Creating VFE.MAR" $ create VFE.MAR $ DECK/DOLLARS="$*$*EOD*$*$" .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 ^MMOVL 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 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 $*$*EOD*$*$ $ checksum VFE.MAR $ if checksum$checksum .ne. check_sum then - $ write sys$output "Checksum failed, file probably corrupted" $ exit