.TITLE SRDTRP .IDENT -6.4- ; NOV-83 .ENABL LC ;+ ; SRDTRP - Error handler routine ; ; Broken out as subroutine by ??? on ??? ; ; Modifications: ; ; V6.2 Bob Denny 13-Jul-82 Lower case error messages, minor ; ;RBD001 message changes. ; Exit with status on '11M ; ; V6.3 Carl Friedberg 1-June-83 PSECTS ;CEF001 ; ; ; VERSION 6.4 - 07-Nov-83 (;BT003) ; ; Bob Turkelson ; SRD Working Group ; ; Add sort by date capability. Merged from Henry Tumblin's ; version of SRD (which does not appear on the SIG tapes). ; Allow specification of major and minor sort keys in any order ; in the /SR:x:x:x switch, also allowing the sort to be either ; ascending or descending for any key (file name, type, version ; date). Ascending and descending capability adopted from ; changes by Dave Sides (Sachs/Freeman Assoc., Inc., c/o ; JHU/Applied Physics Laboratory)(;DJS001). Ideas for ; specifying sort keys came from the version of SRD in the ; U. S. Forest Service collection of programs appearing on the ; Spring 1982 SIG tape. The implementation here is quite ; different. ; Added the command file generation switch /CM, taken from the ; version of SRD submitted to the Spring 1982 SIG tape in the ; U. S. Forest Service collection of programs. ; For files with multiple headers, calculate the number of ; allocated blocks from the retrieval pointers (as has been ; done for any file when the header attributes show zero blocks ; allocated). Read each extension header into a buffer which ; starts at the beginning of the retrieval pointer area of the ; buffer for the first header. Only 51. additional words are ; needed for the buffer since the overlap is 205. words. ; When the date stored in the file header is corrupt, issue a ; non-fatal diagnostic message. (Previously the same fatal ; message was issued for this situation as was given for when ; an invalid date was specified in the command line.) ; Use three letters of the task name in the program prompt and in ; error messages. ; Eliminate the extra zero byte appearing at the end of a ; diagnostic message. ; In diagnostic messages which refer to specific files include ; the UIC and file name in the message. ; Form a UIC string when the directory is opened in SRDOPR for ; use in UIC headings and diagnostic messages. ;- .MCALL QIO$S,WTSE$S,CALLR,CLOSE$,PUT$S .MACRO MESG$ STRING .ASCIZ \STRING\ .ENDM .EVEN ;**-5 .PSECT SRDCOD,I,RO,LCL,CON,REL ;CEF001 TRAP0:: MOV R0,R0SAV MOV R1,R1SAV MOV R2,R2SAV .IF DF R$$11M ;RBD001 MOV #EX$ERR,X$STAT ; ASSUME "ERROR" STATUS ;RBD001 .ENDC ;RBD001 MOV #ERSERV,R1 ; Point at severity indicator ;BT003 MOV #"DI,(R1)+ ;ASSUME DIAGNOSTIC ;**-1 MOV #"AG,(R1) ; ASRB 1(SP) ;IS THIS FATAL OR DIAGNOSTIC? BCS 10$ ;BR IF DIAGNOSTIC .IF DF R$$11M ;RBD001 MOV #EX$SEV,X$STAT ; ERROR IS SEVERE, FATAL ;RBD001 .ENDC ;RBD001 MOV #"TL,(R1) ;SET FATAL HEADER MOV #"FA,-(R1) ; MOV #LSTNX$,2(SP) ;FIX UP RETURN 10$: ADD #ERRTAB,(SP) ;COMPUTE MESSAGE ADDRESS MOV @(SP)+,R1 ;GET DESCRIPTOR MOV #ERMES1,R2 ; Start of variable message area ;BT003 20$: MOVB (R1)+,(R2)+ ;FILL OUT MESSAGE ;**-1 BNE 20$ ;THE WHOLE THING DEC R2 ; Back up to zero byte ;BT003 DEC R2 ; And then back to last byte in message ;BT003 CMPB #'%,(R2)+ ; Is last byte in message special symbol? ;BT003 BNE 18$ ; NE - no ;BT003 DEC R2 ; Point back to special symbol to be replaced ;BT003 MOV #UICHD,R1 ; Point to UIC string ;BT003 14$: MOVB (R1)+,(R2)+ ; Fill in UIC string ;BT003 BNE 14$ ; NE - more of UIC to copy ;BT003 DEC R2 ; Back up to zero byte ;BT003 MOV LENNTV,R0 ; Get length of name-type-version ;BT003 BEQ 18$ ; NE - name not present ;BT003 MOV LSTFDB+F.NRBD+2,R1 ; Point to start of name ;BT003 16$: MOVB (R1)+,(R2) ; Fill in file name ;BT003 CMPB #40,(R2)+ ; Was character a blank? ;BT003 BNE 17$ ; NE - no ;BT003 DEC R2 ; Remove the blank ;BT003 17$: SOB R0,16$ ; Fill in entire name ;BT003 18$: MOV #ERMESG,R1 ; Start of message ;BT003 SUB R1,R2 ; Calculate length of message ;BT003 40$: QIO$S #IO.WVB,#TTYLUN,#17,,,, ;**-2 BCC 50$ ;BR IF A-OK CALL ALERR ;DIAGNOSE ERR BR 40$ ;RETURN IF NO POOL-TRY AGAIN 50$: WTSE$S #17 ;WAIT FOR I-O TO STOP BIS #FLFL,FLAGS$ ;MARK SOMETHING GONE OUT ; ; PUT IT ALSO ON THE LISTING FILE BIT #OUTFSW,FLAGS$ ; ONLY IF ONE WAS SPECIFIED BEQ 70$ MOV #LSTFDB,R0 TST F.BDB(R0) ; LISTING FILE OPEN ? BEQ 70$ ; BR IF NO PUT$S ,R1,R2 MOV #LINBUF,F.NRBD+2(R0) 70$: MOV R0SAV,R0 MOV R1SAV,R1 MOV R2SAV,R2 RTT ;RETURN CONTROL ; .PSECT SRDATA,D,RW,LCL,CON,REL ;CEF001 R0SAV: +0 R1SAV: +0 R2SAV: +0 ; ; .PSECT MSGTBL,D,RO,LCL,CON,REL ;CEF001 ERRTAB::.WORD 999$ .WORD 1$, 2$, 3$, 4$, 5$, 6$, 7$ .WORD 10$,11$,12$,13$,14$,15$,16$,17$ .WORD 20$,21$,22$,23$,24$,25$,26$,27$ ;BT003 .WORD 30$,31$,32$,33$,34$,35$,36$ ;BT003 .IF DF D$$CAL ;BT003 999$: MESG$ ;BT003 .IFF ;BT003 999$: MESG$ ;BT003 .ENDC ;BT003 1$: MESG$ ;**-2 2$: MESG$ ;RBD001 3$: MESG$ ;RBD001 4$: MESG$ ;RBD001 5$: MESG$ ;RBD001 6$: MESG$ ;RBD001 7$: MESG$ ;RBD001 10$: MESG$ ;RBD001 11$: MESG$ ;RBD001 12$: MESG$ ;RBD001 13$: MESG$ ;RBD001 14$: MESG$ ;RBD001 15$: MESG$ ;RBD001 16$: MESG$ ;BT003 17$: MESG$ ;BT003 20$: MESG$ ;**-2 21$: MESG$ ;RBD001 22$: MESG$ ;RBD001 23$: MESG$ ;RBD001 24$: MESG$ ;RBD001 25$: MESG$ ;BT003 26$: MESG$ ;BT003 27$: MESG$ ;BT003 30$: MESG$ ;BT003 31$: MESG$ ;BT003 32$: MESG$ ;BT003 33$: MESG$ ;BT003 34$: MESG$ ;BT003 35$: MESG$ ;BT003 36$: MESG$ ;BT003 .EVEN ;*** MAKE SURE ITS AN EVEN NUMBER *** ;**-4 .END