.TITLE GREP -- GET REPRESENTATION .IDENT -010102- .ENABL LC ;+ ; Abstract: GREP ; ; This program will print out all files which have a specific ; string contained in them, and print the lines in the files ; which contain the string. ; ; Operating procedures: ; ; PDS> grep [ =] [/switches] ; or ; PDS> grep /switches ; ;+001 may be any legal filename to which the output will ;+001 be written. if not specified, output will be written ;+003 to the user's terminal (TI:). If output is to other ;+001 than a terminal (i.e., a file or LP:) the output will ;+001 preceded by the command line. Multiple commands to ;+001 the same output file (or LP:) will be delimited by a ;+001 line of astericks. ;+001 ; may be any legal RSX-11 filespec, and may have ; complete wild card file names. File names can be ; selected in the same way as GREP search strings ; (with *, ?, <, >, and - characters). File names ; do not allow the ^ and $ characters because they ; do not make sense in the context of a file name. ; Upper and lower case letters ar identical for ; file names. If any wild card type characters are ; used, the version will default to * automatically. ; For example, *.mac, test.*, ab*de.dat, etc. ; ; may be any string with the restriction that if a ; string begins with a blank or a / (option designator), ; the character must be escaped with a ' or a \. If a ' ; character is to be the first character of the string, ; it too must be escaped with another ' or a \ character. ; The following meta-characters are accepted by the ; GREP parser: ; ; * - matches 0 or more characters ; ? - matches exactly one character ; $ - matches the end of the line. ; ^ - matches the beginning of the line. ; <...> - matches the current character ; position with any character in the ; list enclosed in angle brackets. ; Currently, the only metacharacters ; which have meaning within such a list ; are the $, ^, \, and - characters. ; - - within an angle bracket list, will ; match any character in the range ; between the lefthand and righthand ; characters. For example, a numeric ; character can be specified as ; <0-9>, alphabetic as , and an ; alphanumeric as . ; \ - escapes the next character from its ; normal lexical meaning. This allows ; searches on *, ?, <, >, -, $, ^, and \. ; Note that it doesn't help the case of ; characters (as noted above) reserved by ; the CSI. ; ; ; Switches may be specified either before or after the ; file name, and may be abbreviated to as short as one ; character. The legal switches are: ; ; /EXCEPT - Print all lines in file EXCEPT the lines which ; match the search pattern. ; /COUNT - Suppress the output of the lines in the file ; which (matched/did not match) and print the ; number of lines which would have been printed. ; /FILES - Just print the names of the files which had lines ; which (matched/did not match). ; /OUTPUT:filename - Send the printout to the specified file. ; If this switch is used, the "outfile=" syntax is ; ignored. The switch may be specified as either ; /OUTPUT:filename (IAS-like) or /OUTPUT=filename ; (VAX/VMS-like). ; /UPPER - Treat all alphabetic characters as upper case, ; both in the search pattern and in the file. ; ; Written: 3-Aug-78, -0.0.0-, Bruce C. Wright ; Modified: ; Verified: ; ; +001 May 1979 Ray French changed output qio's to record i/o ; and added output filespec. Minor ; modifications to output to improve ; readability. ; +002 May 1979 Ray French added line numbers to output. ; +003 12-Apr-80 Bruce C. Wright Added general arguments, allow ; lower case arguments. Change ; default output to TI: ; Fixed bug in listing of directory. ; Version = 1.0.0 ; +004 12-Feb-1981 Bruce C. Wright Changed to general purpose file ; parsing and wild card support, ; from the old CSI wild cards. ; Version = 1.1.0 ; +005 12-Mar-1981 Bruce C. Wright Fixed bug in parsing of some ; command lines with ';*' in ; the file name. ; Version = 1.1.1 ; +006 04-Apr-1981 Bruce C. Wright Fixed bug in +002 for some ; RSX-11M systems. ; Version = 1.1.2 ;- ; .MCALL QIOW$,EXIT$S .MCALL GCMLB$,GCML$ .IF DF R$$CSI .MCALL CSI$,CSI$1,CSI$2,CSI$SW,CSI$SV,CSI$ND .ENDC ; R$$CSI .MCALL FDBDF$,FSRSZ$,NMBLK$ .MCALL FINIT$,OFID$R,OPEN$W,CLOSE$ .MCALL GET$,PUT$ .MCALL FDOP$A,FDAT$A .MCALL FDOP$R,FDBF$R,FDRC$R .MCALL FHDOF$,FDOF$L,NBOFF$ ; ; multi-buffer count ; MBCT = 2. ; .MACRO TYPE BUF,LEN,CCL MOV BUF,-(SP) MOV LEN,-(SP) .IF NB CCL MOV CCL,-(SP) .IFF MOV #40,-(SP) .ENDC JSR PC,$TYPE .ENDM .MACRO ERRMSG MSG .NCHR $$$, JSR R0,$ERROR .WORD $$$ .ASCII "MSG" .EVEN .ENDM FHDOF$ DEF$L ; Define file header offsets NBOFF$ DEF$L ; Define name block offsets locally ; .PSECT IDATA,RW,D ; ; Command line macros and data blocks ; GCLBLK: GCMLB$ 1,GRE,HEADER,2 .IF DF R$$CSI ; If using CSI ... CSI$ .EVEN CSIBLK: .BLKB C.SIZE ; Csi block .EVEN SWTABL: CSI$SW SE,SW.SE,SWORD,SET,,SVTABL CSI$SW EX,SW.EXC,SWORD,SET,NEG CSI$SW CO,SW.CNT,SWORD,SET,NEG CSI$SW UP,SW.UPC,SWORD,SET,NEG CSI$SW FI,SW.FIL,SWORD,SET,NEG CSI$ND SVTABL: CSI$SV ASCII,STRBUF,STRLEN CSI$ND .ENDC ; R$$CSI SWORD:: .WORD 0 SW.SE == 000001 ;SE - Select string SW.WLD == 000002 ; Wild cards used SW.OUT == 000004 ; Output file specified. SW.EXC == 000010 ; /EX switch specified SW.CNT == 000020 ; /CN switch specified SW.UPC == 000040 ; /UP switch specified SW.FIL == 000100 ; /FI switch specified ; ; DSPT for input file ; INPFIL::.BLKW 6. .IF NDF R$$CSI ;+004 If doing our own parsing ... INPALL: .BLKW 4 ;+004 ... .WORD 5. ;+004 Length of string .WORD 10$ ;+004 Address of string 10$: .ASCII /*.*;*/ .EVEN TMPBUF: .BLKB 20. ;+004 Temporary for file name. .ENDC ;R$$CSI ;+004 ; ; DSPT for output file ; OUTFIL::.BLKW 6. ; HEADER: .BLKB 82. .BLKB 50. ;+002 STAT: .WORD 0 ; Buffer for statistics block .WORD 0 .WORD 0 .EVEN DEV: .ASCII /SY:/ .EVEN ; I/O macros and data blocks FDOF$L FSRSZ$ 2,MBCT* ; Set up for one lun. .PSECT IDATA,RW,D FDB: FDBDF$ ; Start of fdb FDOP$A 1,INPFIL OUTBUF: .BLKB 8. ; 8. bytes for output buffer header. BUFFER: .BLKB 1000 ; Input buffer, output listing buffer. BUFLEN = .-BUFFER ; Input buffer length. LINFLG: .WORD 0 ; > 0 means file header line printed. SPSAVE: .WORD 0 ; Area for initial stack pointer. MATCH: .WORD 0 ; Number of matches found this file. STARBF: .BYTE '* ; A rather inelegant way of locating ; a string with an unanchored search. ; The search argument pointer is moved ; to here for unanchored searches. STRBUF::.BLKB 80. ; Search argument string STRLEN = .-STRBUF ; Maximum size of string. .EVEN STRSIZ::.WORD 0 ; Actual size of string. STRPTR: .WORD 0 ; Pointer to string. ; FDB1: FDBDF$ ;+001 - FDB for output file FDAT$A R.VAR,FD.CR,132. ;+001 FDOP$A 3 ;+001 LSTFNB: NMBLK$ GREP,LST,,SY,0 ASTER: .BYTE 12 ;+001 - Line of astericks for output .REPT 10 ;+001 .ASCII /**********/ ;+001 .ENDR ;+001 .EVEN COMMD: .WORD 0 ;+001 - Pointer for start of command COUNT: .BLKW 1 ;+002 - Line counter DFDSPT: .WORD 3,DEFDEV ;+001 - Dataset descriptor for 'CL' .WORD 0,0,0,0 ;+001 DEFDEV: .ASCII /TI:/ .EVEN ; ; Read and decode the command line ; ; A rather sneaky quirk pops up in using csi$1 and csi$2. ; If the input command line omits the dev: and the [uic], ; nothing is placed in the csi file descriptor block (pointed to by ; c.devd etc.). Now all is ok if one just wishes to decode the ; command line and then open the file. Open assumes that if the dev ; and uic are missing it should open the file using the current terminal ; uic and the disk from which the task is initially installed. ; One never notices a problem if the utility is run using the run $ ; convention. However, if the utlity is installed off of dk0:(asn ; sy:=sy:/login) then a user whose system device is different ; (asn dkn:=sy:/login) that it is mandatory to put in a dev: ; in the file spec, because if it is omitted the utility can ; not find the file on his system device. ; ; The matter is further complicated if .parse and .find are to be ; used. They will not parse and find a file correctly if the command ; assumes the device will default to sy:. The solution to this is ; to tst the command line to see if a dev: is specified. If not ; insert a sy: ; ; One nice feature of this quirk, and (using hindsight) a much used ; feature of the command string interpreters, is that once a dev: or ; [uic] is specified in a command line, all subsequent file specifiers ; can omit them. ; ; .PSECT GREP,RO,I GREP: FINIT$ ; Initialize fsr MOV SP,SPSAVE ; Save initial stack pointer. START: MOV SPSAVE,SP ; Reset initial stack pointer. BISB #GE.LC,GCLBLK+G.MODE ; Allow for lower case. GCML$ #GCLBLK ; Get command line BCS 10$ ; Error? MOV #HEADER,R1 ;+001 - Point to command line MOV GCLBLK+G.CMLD,R2 ;+001 - Size in r2 BEQ START ;+004 Loop if nothing there. 1$: CMPB #' ,(R1)+ ;+004 A tab? BEQ 2$ ;+004 J if so - ignore it. CMPB #' ,-1(R1) ;+001 - Search for a blank BNE 5$ ;+001 2$: SOB R2,1$ ;+001 BR START ;+004 Nothing in command line. 5$: DEC R1 ;+004 Point back to the non-blank. MOV R1,COMMD ;+001 - Save the pointer JMP CONTIN ; No error, so skip around 10$: CMPB #GE.IOR,GCLBLK+G.ERR ; I/O error? BNE 20$ ; No ERRMSG EXIT$S ; This is fatal 20$: CMPB #GE.OPR,GCLBLK+G.ERR ; Open error? BNE 30$ ; No ERRMSG JMP START ; Re-do cmd line 30$: CMPB #GE.MDE,GCLBLK+G.ERR ; Max @ depth? BNE 40$ ; No ERRMSG JMP START 40$: CMPB #GE.BIF,GCLBLK+G.ERR ; Syntax error? BNE 50$ ; No ERRMSG JMP START ; Re-start pgm 50$: CMPB #GE.EOF,GCLBLK+G.ERR ; End-of-file? BEQ EXIT ; Yes ERRMSG EXIT: CLOSE$ #FDB1 EXIT$S ; No input so exit SERR: ERRMSG JMP START ; CONTIN: TST ; Is anything typed BNE 1$ ; Yes -- interpret it JMP START ; 1$: CLRB STRBUF ; Nul pad the string buffer. .IF DF R$$CSI ; If using the CSI ... CLR SWORD ; Clear switches. CSI$1 #CSIBLK,GCLBLK+G.CMLD+2,GCLBLK+G.CMLD ; Check syntax BCS SERR ; Error in syntax found TST ; Just in case a bunch of spaces followed ; by a ^z were typed, check to be sure >0 ; parsed character is in the csiblk BNE 2$ ; Only one character exit JMP EXIT ;+001 2$: MOV #CSIBLK+C.STAT,R0 ; Point to status area. BITB #CS.EQU,(R0) ; Was an = sign present? BEQ 20$ ; J if not. BIS #SW.OUT,SWORD ; Set the output present switch if so. BITB #CS.WLD,(R0) ; Wild cards specified? BEQ 3$ ; J if not. ERRMSG JMP START 3$: CSI$2 #CSIBLK,OUTPUT,#SWTABL ;+001 - Decode the output file BCS SERR ;+001 - Check for error 10$: MOV #CSIBLK+C.DSDS,R0 ; Get source DSPT MOV #OUTFIL,R1 ; Get target DSPT MOV #6,R2 ; Get number of words in DSPT 11$: MOV (R0)+,(R1)+ ; Move the DSPT SOB R2,11$ ; ... CSI$2 #CSIBLK,INPUT,#SWTABL ;+001 - Decode the input file BCC 30$ JMP SERR 20$: CSI$2 #CSIBLK,OUTPUT,#SWTABL ; Decode the input file name BCC 30$ ; Any errors? JMP SERR ; If so, syntax error 30$: BITB #CS.WLD,CSIBLK+C.STAT ; Wild cards specified? BEQ 32$ ; J if not. BIS #SW.WLD,SWORD ; If so, set the bit in switch word. 32$: MOV #CSIBLK+C.DSDS,R0 ; Get source DSPT MOV #INPFIL,R1 ; Get target DSPT MOV #6,R2 ; Get number of words in DSPT 35$: MOV (R0)+,(R1)+ ; Move in the DSPT SOB R2,35$ ; And loop. .IFF ; If not using the CSI ... MOV #401,R1 ; Set R1 for call to TPARS: ; Blanks are syntax elements ; Keywords may be abbreviated to 1 character. MOV #KEYTBL,R2 ; Point to keyword table. MOV GCLBLK+G.CMLD,R3 ; Get length of string to parse. MOV GCLBLK+G.CMLD+2,R4 ; Get address of string to parse. MOV #BEGSTA,R5 ; Point to the beginning of the state table. CALL .TPARS ; Parse the command line. BCS SERR ; Error? .ENDC ; R$$CSI .SBTTL Decode the command line and open output file ; ; Decode the command line and open output file ; CONT: BIT #SW.OUT,SWORD ; Was an output file specified? BEQ 2$ ; J if not. CLOSE$ #FDB1 ; Close output file if so. FDOP$R #FDB1,,#OUTFIL,#LSTFNB ; Set I/O info. OPEN$W #FDB1 ; Open the output file. BCC 3$ ; J if opened OK. 1$: ERRMSG CALL FERR ; Print error message. JMP START ; And begin again. 2$: TST FDB1+F.FNB+N.FID ; File already open? BNE 3$ ; J if so, don't open again. OPEN$W #FDB1,,#DFDSPT ; Open the output file. BCS 1$ ; Skip if error. 3$: BITB #FD.TTY,FDB1+F.RCTL ;+001 - Writing to tty ? BNE 10$ ;+001 - If so, skip astericks and command TST FDB1+F.NRBD ;+001 - Was file just opened ? BEQ 5$ ;+001 - Then forget astericks PUT$ #FDB1,#ASTER,#81. ;+001 - Write line of astericks 5$: PUT$ #FDB1,GCLBLK+G.CMLD+2,GCLBLK+G.CMLD ;+001 - And print command ;+001 ; Do we need to insert a sy:? ; 10$: TST INPFIL ; Was a device specifier found in the ; current command BNE 15$ ; If ne yes, so don't fill in sy: ; No so, first initialize the device ; string in the csiblk to be 'sy0:' MOV #2,INPFIL ;+004 Set byte count of device string. MOV #DEV,INPFIL+2 ;+004 Set address of SY string 15$: MOV #FDB,R0 ; FDB adress in r0 MOV #FDB+F.FNB,R1 ; FNB address in r1 .IF NDF R$$CSI ;+004 If using TPARS instead of CSI ... BIT #SW.WLD,SWORD ;+004 Wild cards? BEQ 17$ ;+004 J if not - just use file string. MOV #INPALL,R2 ;+004 Dataset pointer in R2 MOV INPFIL,(R2) ;+004 Move device spec MOV INPFIL+2,2(R2) ;+004 ... MOV INPFIL+4,4(R2) ;+004 Move UIC MOV INPFIL+6,6(R2) ;+004 ... BR 18$ ;+004 And take new file spec. .ENDC ;R$$CSI ;+004 17$: MOV #INPFIL,R2 ; Dataset pointer in R2 18$: CLR R3 CALL .PARSE ; Parse the FDB BCC 20$ ; All ok so skip error message CALL FERR ; Error (fcs) found JMP START ; And re-start. 20$: BIT #SW.WLD,SWORD ; Wild card operation? BEQ 30$ ; If eq no BIS #NB.SVR, ; Yes, so arbitrarily we will ; set the flag bit ; to insure any version will be opened 30$: MOV #STRBUF,R3 ; Get string buffer 40$: TSTB (R3)+ ; End of string? BEQ 45$ ; J if end of buffer. BIT #SW.UPC,SWORD ; Translate to upper case? BEQ 40$ ; J if not. CMPB -1(R3),#140 ; Is it lower case? BLO 40$ ; J if not. BICB #40,-1(R3) ; Raise it to upper case. BR 40$ ; and loop. 45$: SUB #STRBUF+1,R3 ; Compute length of buffer. MOV R3,STRSIZ ; Save in string length. MOV #STRBUF,STRPTR ; Set up pointer. CMPB STRBUF,#'^ ; Looking for beginning of string? BEQ 50$ ; Yes -- don't bother with * MOV #STRBUF-1,STRPTR ; No, make the initial character * INC STRSIZ ; And increment the string size. 50$: .SBTTL Open the next file in the sequence ; ; This is the beginning of the loop which opens the input files. ; NXTFIL: MOV SPSAVE,SP ; Restore default Stack Pointer. CALL OPNFIL ; Open the next file if possible. BCS 10$ ; J if error opening file. CALL EXAFIL ; Examine the file 10$: BIT #SW.WLD,SWORD ; Is this a wildcard open? BEQ 20$ ; J if not. MOV , ; Reset for .find MOV , ; BR NXTFIL ; And loop some more. 20$: JMP START ; And re-start the task. .SBTTL EXAFIL - Examine contents of file ; ; This subroutine examines the contents of an open file. ; EXAFIL: CLR COUNT ;+002 - Clear line counter CLR MATCH ; Clear count of matching lines. CLR LINFLG ; Clear file name printed flag. LOOK: INC COUNT ;+002 - Increment line counter GET$ #FDB,#BUFFER,#BUFLEN BCS FILERR ; ERROR? MOV FDB+F.NRBD+2,R1 ; Get start of the buffer in r1 MOV FDB+F.NRBD,R2 ; Get length of buffer in r2 MOV STRPTR,R3 ; Point to match string. MOV STRSIZ,R4 ; Get match length into r5 CALL GRELOC ; Locate the string if any. BCC 5$ ; Skip if search string found. BIT #SW.EXC,SWORD ; Print lines not having string? BEQ LOOK ; J if not -- no match. BR 10$ ; J to print routine. 5$: BIT #SW.EXC,SWORD ; Print lines having string? BNE LOOK ; J if so -- match not printed. 10$: BIT #SW.CNT,SWORD ; Only print count? BEQ 12$ ; J if not -- normal. INC MATCH ; Increment count. BR LOOK ; And look for next match. 12$: TST LINFLG ; Printed file name? BNE 16$ ; Yes BIT #SW.FIL,SWORD ; /FILES specified? BNE 14$ ; J if so - no extra blank line. PUT$ #FDB1,#DEVMSG,#0,FERR ; Print an extra blank line. 14$: CALL PRTFIL ; No -- print it. INC LINFLG ; Signal line printed. BIT #SW.FIL,SWORD ; Only print file names? BNE ENDFIL ; J if so -- leave immediately. 16$: MOV #OUTBUF,R0 ;+002 - Buffer address in r0 MOV COUNT,R1 ;+002 - Line number in r1 MOV #3,R2 ;+002 - 3 byte to clear (also nzs flag) JSR PC,$CBDMG ;+002 - Convert count and put in buffer MOV #3,R2 ;+006 - Set size to move ($CBOMG ; may clobber R2) 30$: MOVB #' ,(R0)+ ;+002 - Blank 3 bytes SOB R2,30$ ;+002 MOV FDB+F.NRBD+2,R1 ;+002 - get buffer address MOV FDB+F.NRBD,R2 ;+002 - Get byte count ADD #10,R2 ;+002 - Increase by 10 MOV R2,-(SP) ;+002 - Save it 40$: MOVB (R1)+,(R0)+ ;+002 - Add record to buffer SOB R2,40$ ;+002 PUT$ #FDB1,#OUTBUF,(SP)+,FERR ;+001 - Print it BR LOOK ; And leave. FILERR: CMPB F.ERR(R0),#IE.EOF ; Is it eof? BEQ ENDFIL ; No -- error CALL FERR ; Signal error ENDFIL: BIT #SW.CNT,SWORD ; Print a count of matches? BEQ 5$ ; J if not. MOV #DEVMSG,R0 ; Point to buffer. MOV #FDB,R5 ; get FDB address. CALL DECFIL ; Decode file name. MOVB #' ,(R0)+ ; Output a tab. MOV MATCH,R1 ; Get number of matches. BEQ 5$ ; Skip if none. CLR R2 ; Show zero suppression. CALL $CBDMG ; Convert to decimal magnitude. SUB #DEVMSG,R0 ; Compute length of message. MOV R0,R1 ; Get length into R1 PUT$ #FDB1,#DEVMSG,R1,FERR ; Print the message. 5$: CLOSE$ #FDB ; Close the file. BCC 10$ ; File could be opend and closed CALL FERR ; File could either not be opend ; or closed JMP START ; And re-start 10$: RETURN ; And return to the caller. .SBTTL OPNFIL - Find and open an input file. ; ; This subroutine finds and opens the next input file. ; ; Calling sequence: ; ; CALL OPNFIL ; ; No arguments are required. ; ; No registers are modified. ; ; Returns: ; ; If CC-C is set, no files could be opened. ; IF CC-C is clear, a file has been opened. ; OPNFIL: MOV R0,-(SP) ; Save R0 MOV R1,-(SP) ; Save R1 5$: MOV #FDB,R0 ; Point to input FDB MOV #FDB+F.FNB,R1 ; Point to filename block. 10$: CALL .FIND ; Find the file BCC 40$ ; Open the file if everythine OK BIT #SW.WLD,SWORD ; Is it a wild card operation? BEQ 20$ ; J if not, everything is error. CMPB #IE.NSF,FDB+F.ERR ; Is it no such file? BEQ 30$ ; Yes 20$: CALL FERR ; No, it must be an fcs error 30$: CLR ; Reset index pointer JMP START ; And re-start. ; ; Open the file and look at it. ; 40$: BIT #SW.WLD,SWORD ; Is this a wild card grep? BEQ 50$ ; If eq no, so go directly to open file CMP , ; Do we have a new file? BEQ 10$ ; No, try again MOV , ; Save index pointer MOV , ; Save status .IF NDF R$$CSI ;+004 If not using CSI ... MOV #TMPBUF,R0 ;+004 Create temporary buffer. MOV FDB+F.FNB+N.FNAM,R1 ; +004 Get first part of file name. CALL $C5TA ;+004 Convert it. MOV FDB+F.FNB+N.FNAM+2,R1 ;+004 Get second part of file name CALL $C5TA ;+004 Convert it. MOV FDB+F.FNB+N.FNAM+4,R1 ;+004 Get last part of file name CALL $C5TA ;+004 Convert it. 43$: CMPB #' ,-(R0) ;+004 Truncate to the last non-blank. BEQ 43$ ;+004 Loop until found. INC R0 ;+004 Increment past last non-blank. MOVB #'.,(R0)+ ;+004 Insert the . MOV FDB+F.FNB+N.FTYP,R1 ;+004 Get file extension. CALL $C5TA ;+004 Convert it. 46$: CMPB #' ,-(R0) ;+004 Truncate to the last non-blank. BEQ 46$ ;+004 Loop until found. INC R0 ;+004 Point past last non-blank. MOVB #';,(R0)+ ;+005 Output a ; MOV FDB+F.FNB+N.FVER,R1 ;+005 Get the file version CLR R2 ;+005 Signal zero suppression. CALL $CBOMG ;+005 Convert to octal magnitude. ; MOV #TMPBUF,R1 ;+004 Get the name of the examined string MOV R0,R2 ;+004 Get the ending address of the string. SUB R1,R2 ;+004 Compute length of string. MOV INPFIL+12,R3 ;+004 Get the input file spec. MOV INPFIL+10,R4 ;+004 ... CALL GRELOC ;+004 Try to match the file spec. BCC 50$ ;+004 Skip if a match found. JMP 5$ ;+004 J if no match. .ENDC ;R$$CSI ;+004 50$: FDRC$R #FDB,#FD.PLC .IF NDF R$$11M FDBF$R #FDB,,,#MBCT,#FD.RAH .ENDC ; R$$11M OFID$R #FDB ; Open the file by id BCC 80$ ; File opened without errors CALL FERR ; Print file error MOV #ERRTBL,R1 ; Point to error table. 60$: CMPB (R1)+,FDB+F.ERR ; Is it the same error? BEQ 70$ ; J if so. TSTB (R1) ; More entries in table? BNE 60$ ; J if so. JMP START ; Not a recoverable error. 70$: SEC ; Show error. 80$: MOV (SP)+,R1 ; Recover registers. MOV (SP)+,R0 ; ... RETURN ; And return to the caller. ; ; TABLE OF NON-FATAL ERRORS ; ERRTBL: .BYTE IE.PRI ; Privilege violation .BYTE IE.VER ; Parity error on device .BYTE IE.BBE ; Bad block on device .BYTE IE.FHE ; Fatal hardware error .BYTE IE.BCC ; Block or CRC error .BYTE IE.LCK ; Locked from write access .BYTE IE.WAC ; Accessed for write access .BYTE IE.CKS ; Header checksum failure .BYTE IE.RER ; Device read error .BYTE IE.SNC ; File ID, file number check .BYTE IE.SQC ; File ID, Sequence number check .BYTE IE.CLO ; Not properly closed .BYTE IE.BHD ; Bad file header .BYTE IE.EXP ; Expiration date expired .BYTE 0 ; End of list .EVEN ; And get to an even boundary. .SBTTL FERR - Print FCS error on the user's terminal ; ; This subroutine will print the FCS error code on the user's ; terminal. The FCS error code is taken from the current FDB ; address, and the file name for the error is also printed. ; ; Calling sequence: ; ; CALL FERR ; ; Arguments: ; ; R0 - The FDB of the file for which the error occurred. ; ; All registers are preserved. ; FERR: MOV R0,-(SP) ; Save R0 MOV R1,-(SP) ; Save R1 MOV R2,-(SP) ; Save R2 MOV R5,-(SP) ; Save R5 MOV #M.FCS,R1 ; Get FCS message MOV #L.FCS,R2 ; And length CALL .PRFCS ; Print out the FCS message. MOV R0,R5 ; Get the FDB address into R5 MOV #DEVMSG,R0 ; Point to the message buffer. CALL DECFIL ; Decode the file name. SUB #DEVMSG,R0 ; Compute length of message. TYPE #DEVMSG,R0 ; Type the message on the user's terminal. MOV (SP)+,R5 ; Recover R5 MOV (SP)+,R2 ; Recover R2 MOV (SP)+,R1 ; Recover R1 MOV (SP)+,R0 ; Recover R0 RETURN ; And return to the caller. .SBTTL PRTFIL - Print file name on terminal ; ; This subroutine will print the file name on the output device. ; ; Calling sequence: ; ; CALL PRTFIL ; ; All registers are preserved. ; PRTFIL: MOV R0,-(SP) MOV R1,-(SP) MOV R5,-(SP) MOV #DEVMSG,R0 ; Point to device msg MOV #FDB,R5 ; Point to FDB of file name. CALL DECFIL ; Decode the file name. SUB #DEVMSG,R0 ; Compute length of file name. MOV R0,R1 ; Into R1 PUT$ #FDB1,#DEVMSG,R1,FERR ; Print it. MOV (SP)+,R5 ; Recover registers. MOV (SP)+,R1 ; ... MOV (SP)+,R0 ; ... RETURN ; And return to the caller. .SBTTL DECFIL - Decode file name ; ; This subroutine will decode the current file name. ; ; Calling sequence: ; ; CALL DECFIL ; ; Arguments: ; ; R0 - The address of an output buffer for the file name. ; R5 - The address of the FDB for the file. ; ; On output, ; ; R0 will be the address of the next available character ; in the output buffer ; All other registers will be preserved. ; DECFIL: MOV R1,-(SP) ; Save R1 MOV R2,-(SP) ; Save R2 MOV R3,-(SP) ; Save R3 MOVB F.FNB+N.DVNM(R5),(R0)+ ; Output the device name ... MOVB F.FNB+N.DVNM+1(R5),(R0)+ ; ... MOV F.FNB+N.UNIT(R5),R1 ; Get the device unit no. CLR R2 ; Show zero suppression. CALL $CBOMG ; Convert to octal magnitude. MOVB #':,(R0)+ ; Copy in a : ;;; 12$: MOV INPFIL+4,R2 ; Get UIC spec len BLE 22$ ; None? MOV INPFIL+6,R3 ; Get UIC spec addr 20$: MOVB (R3)+,(R0)+ ; Move in uic spec SOB R2,20$ ; Move in all of uic ;;; 22$: MOV F.FNB+N.FNAM(R5),R1 ; Convert FNAM to Rad50 CALL $C5TA ; MOV F.FNB+N.FNAM+2(R5),R1 CALL $C5TA MOV F.FNB+N.FNAM+4(R5),R1 CALL $C5TA 30$: CMPB #' ,-(R0) ;Is it a blank? BEQ 30$ ;Yes INC R0 ; MOVB #'.,(R0)+ ; Output the . MOV F.FNB+N.FTYP(R5),R1 CALL $C5TA ;Type field to ascii 40$: CMPB #' ,-(R0) ;Is it a blank? BEQ 40$ ;Yes INC R0 ; 45$: MOV F.FNB+N.FVER(R5),R1 ;Get file version BEQ 50$ ;None? MOVB #';,(R0)+ ;move in a ';' CLR R2 ; Suppress 0's CALL $CBOMG ; Convert version # 50$: MOV (SP)+,R3 ; Recover r3 MOV (SP)+,R2 ; ... MOV (SP)+,R1 ; ... RETURN ; And return to the caller. .SBTTL $ERROR - Print error messages on the user's terminal ; ; This subroutine will print error messages on the user's terminal. ; It is intended to be used by the ERRMSG macro ONLY. ; ; Calling sequence: ; ; JSR R0,$ERROR ; ; .WORD STRING_LENGTH ; .ASCII "STRING" ; .EVEN ; ... ; ; All registers are preserved by $ERROR. ; $ERROR: MOV R1,-(SP) ; Save R1 MOV (R0)+,R1 ; Get the string length. TYPE R0,R1 ; Type the string on the user's terminal. ADD R1,R0 ; Add in the length of the string. INC R0 ; Round up to a word boundary BIC #1,R0 ; Make sure it's a word boundary. MOV (SP)+,R1 ; Recover R1 RTS R0 ; And return to the caller. .SBTTL $TYPE - Print messages on the user's terminal. ; ; This subroutine will print a message on the user's terminal. ; ; Calling sequence: ; ; MOV #BUFFER,-(SP) ; MOV #BUFLEN,-(SP) ; MOV #CARRIAGECONTROL,-(SP) ; CALL $TYPE ; ; All registers are saved and restored by $type. ; All arguments are popped off the stack by $type. ; $TYPE: MOV 2(SP),QIOW+Q.IOPL+4 ; Move in qio carriage control. MOV 4(SP),QIOW+Q.IOPL+2 ; Move in qio length MOV 6(SP),QIOW+Q.IOPL+0 ; Move in buffer address. MOV (SP),6(SP) ; Pop parameter off stack. ADD #6,SP ; Pop stack. MOV #QIOW,-(SP) ; DPB to stack. CALL .DIRDL ; Do the I/O RETURN ; And return to the caller. .PSECT IDATA,RW,D ; Terminal qio QIOW: QIOW$ IO.WVB,5,1,,,,<0,0,40> M.FCS: .ASCII /GRE/ L.FCS = .-M.FCS .EVEN ; Error messages DEVMSG: .BLKB 40. .EVEN TEMP: .BLKB 40. .END GREP