;
;       ERROR.M68
;
;       This subroutine gets an argument list of errors and reports
;       them to the terminal, And optionally logs it to a file.
;
;       FORMAT :  XCALL ERROR,ERR'0,ERR'1,ERR'2,LOG'ERR
;
;       07/25/87        flm(bb)
;
;       Author : Fred L. McMaster (A.K.A.'BIBI')  Computer Resources,Inc.
;                                                 101 39th Street North
;                                                 Birmingham , AL 35222
;                                                 (205) 591-8810
;
;       7/30/87         dfp
;       "Streamlined" by Dave Pallmann, UltraSoft Corp.

       SEARCH SYS
       SEARCH SYSSYM
       SEARCH TRM
       SEARCH MACLIB

       EXTERN $GTARG,$ODTIM

       VMAJOR = 1
       VMINOR = 0
       VEDIT  = 1
       VWHO   = 1

       OBJNAM  .SBR

       PHDR    -1,0,PH$REE!PH$REU

OFINI
OFDEF   F.DDB,D.DDB
OFDEF   F.BUF,512.
OFDEF   J.DEV,2
OFDEF   J.DRV,2
OFDEF   J.PPN,2
OFDEF   J.JOB,2
OFDEF   J.TRM,2
OFDEF   J.PRG,2
OFSIZ IMPSIZ

IMP=A4

; XCALL OFFSETS

XC.ARG=0                        ;number of arguments
XC.TY1=2                        ;err'0 type
XC.AD1=4                        ;err'0 address
XC.SZ1=10                       ;err'0 size
XC.TY2=14                       ;err'1 type
XC.AD2=16                       ;err'1 address
XC.SZ2=22                       ;err'1 size
XC.TY3=26                       ;err'2 type
XC.AD3=30                       ;err'2 address
XC.SZ3=34                       ;err'2 size
XC.TY4=40                       ;err'L type
XC.AD4=42                       ;err'L address
XC.SZ4=46                       ;err'L size

ERROR:  CMMW    XC.ARG(A3),#3           ; test number of arguments
       JLT     ARGERR                  ; if not report it
       CMMW    XC.TY1(A3),#6           ; compare type with binary
       JNE     TYPERR                  ; if not report it
       CMMW    XC.TY2(A3),#4           ; compare with floating point var
       JNE     TYPERR                  ; if not report it
       CMMW    XC.TY3(A3),#4           ; compare with floating point var
       JNE     TYPERR                  ; if not report it
       MOV     XC.AD1(A3),A2           ; move err'0 into A2
       MOVB    (A2)+,D1                ; move byte into D1
       CMPB    D1,#0                   ; compare error with 0
       JLOS    RNGERR                  ; jump lower or same to range error
       CMPB    D1,#47.                 ; compare error with current max err's
       JHIS    RNGERR                  ; jump higher or same to range error
       CRT     #24.,#1                 ; position Cursor @ 24,1
       OUTS    OT$TRM,<Program Error(> ; print header
       MOVB    #7,D1                   ; move bell character into d1
       TTY                             ; and sound it.
       MOV     XC.AD1(A3),A2           ; move error code into register
       CLR     D1                      ; clear data register
       MOVB    (A2)+,D1                ; move byte into d1
       DCVT    0,OT$TRM                ; Print error number
       SUB     #1,D1                   ; subtract one from error
                                       ; this puts displacement of table to 0
                                       ; i.e. put error table on even boundaries
                                       ; 0,2,4 etc..
       MUL     D1,#30.                 ; multiply to find msg offset   [DP]
       LEA     A5,ERR1                 ; point to err msg table        [DP]
       ADD     D1,A5                   ; A5 now points to right msg    [DP]

RPTER2: TYPESP  )                       ; type parenthesis.             [DP]
       TTYL    @A5                     ; output error desc. to screen  [DP]
       CRT     #9.                     ; clear to eol
       CLR     D1                      ; clear register
       MOV     #14,D1                  ; move offset from A3 into D1
       CALL    $GTARG                  ; call macro
       CMP     D1,#0                   ; see if there is an error line #
       JEQ     RPTER3                  ; if not exit this routine
       OUTS    OT$TRM,< -On Line(>     ; display header
       DCVT    0,OT$TRM                ; convert and print string
       MOVB    #'),D1                  ; close up error number
       TTY                             ; output to screen

RPTER3: CRT     #9.                     ; clear to eol
       CLR     D1                      ; clear register
       MOV     #26,D1                  ; move offset from A3 into D1
       CALL    $GTARG                  ; call macro
       CMP     D1,#0                   ; see if there is an error line #
       JEQ     RETURN                  ; if not exit this routine
       OUTS    OT$TRM,< -Channel(>     ; output header
       DCVT    0,OT$TRM                ; convert and print string
       MOVB    #'),D1                  ; wrap error
       TTY                             ; and print it

WRTERR: CMMW    XC.ARG(A3),#4           ; test for a fourth argument
       JNE     RETURN                  ; if not exit routine.
       LEA     A2,FILNAM               ; move address into a2 for next call
       FSPEC   F.DDB(IMP)              ; process filespec
       ORB     #D$INI,F.DDB+D.FLG(IMP) ; set inited flag
       LEA     A6,F.BUF(IMP)           ; get address of impure buffer
       MOV     A6,F.DDB+D.BUF(IMP)     ; move address into ddb
       MOV     #512.,F.DDB+D.SIZ(IMP)  ; move buffer size to ddb
       LOOKUP  F.DDB(IMP)              ; see if she's there
       JNE     MAKEIT                  ; if one is not there create it.
       OPENA   F.DDB(IMP)              ; open file for append mode

PUTDSH: MOV     #'|,D1                  ; move vertical bar
       CALL    PUTBYT                  ; output it
       MOV     #78.,D0                 ; move decimal 78 into D0 for count
       MOVB    #'-,D1                  ; put dash into D1
5$:     CALL    PUTBYT                  ; output byte
       SOB     D0,5$                   ; subtract one and branch
       CALL    SETFIL                  ; index a2 with DDB
       OUTCR   OT$DDB,<|>              ; close error seperator with vert. bar

PUTERR: OUTS    OT$DDB,<| Program Error(>
       MOV     XC.AD1(A3),A6           ; move error code into register
       CLR     D1                      ; clear data register
       MOVB    (A6)+,D1                ; move byte into d1
       DCVT    0,OT$DDB                ; Print error number

LOGMSG: OUTS    OT$DDB,<) >             ; [DP]  output the message we are
       MOV     A5,A1                   ;  |    pointing to with A5.
       MOV     #26.,D0                 ;  v    Replace nulls with spaces.
10$:    MOVB    (A1)+,D1
       BNE     20$
       MOVB    #40,D1                  ;  ^
20$:    FILOTB  @A2                     ;  |
       SOB     D0,10$                  ; [DP]

PUTER1: CALL    SETFIL                  ; setup A2 to reference F.DDB
       OUTS    OT$DDB,< >              ; output a space
       GDATES  D3                      ; setup reg with current date
       GTIMES  D4                      ; setup reg with current time
       MOV     #140366,D5              ; set flags for full date display
       CALL    $ODTIM                  ; call it
       OUTCR   OT$DDB,< >              ; output a space with a cr

PRTJOB: OUTS    OT$DDB,<| Job Name : >  ; ouput a header
       JOBIDX  A6                      ; index our jobidx
       LEA     A1,JOBNAM(A6)           ; load A1 with job name word
       MOV     J.JOB(IMP),A2           ; move destination var into A2
       UNPACK                          ; unpack first word
       UNPACK                          ;   "    second word
       MOV     J.JOB(IMP),A1           ; move destination into a1 for display
       CALL    SETFIL                  ; setup A2 to reference F.DDB
       OUTL    @A1,OT$DDB              ; output string indexed  to DDB
       OUTS    OT$DDB,<  >             ; output spaces to DDB

PRTTRM: OUTS    OT$DDB,<  Terminal : >  ; output header
       JOBIDX  A6                      ; index our job
       MOV     JOBTRM(A6),A1           ; move terminal name into source pos
       SUB     #4,A1                   ; subtract 4 to get to terminal name
       MOV     J.TRM(IMP),A2           ; move destination into A2
       UNPACK                          ; unpack first word
       UNPACK                          ; unpack second word
       MOV     J.TRM(IMP),A1           ; move unpacked string to destination
       CALL    SETFIL                  ; lea a2,f.ddb(imp)
       OUTL    @A1,OT$DDB              ; output indexed string to DDB
       OUTS    OT$DDB,<  >             ; output some spaces

PRTPRG: OUTS    OT$DDB,<   Program : >  ; another header
       JOBIDX  A6                      ; index our job
       LEA     A1,JOBPRG(A6)           ; load program name
       MOV     J.PRG(IMP),A2           ; move address of program buffer
       UNPACK                          ; unpack first word
       UNPACK                          ;    "   second word
       MOV     J.PRG(IMP),A1           ; move ascii string to destination
       CALL    SETFIL                  ; load a2 with DDB address
       OUTL    @A1,OT$DDB              ; output string
       OUTCR   OT$DDB,< >              ; output a cr

PRTLIN: CLR     D1                      ; clear register
       MOV     #14,D1                  ; move offset from A3 into D1
       CALL    $GTARG                  ; call macro
       CMP     D1,#0                   ; see if there is an error line #
       JEQ     PRTFIL                  ; if not exit this routine
       OUTS    OT$DDB,<|  On Line : >  ; another header
       DCVT    5,OT$DDB                ; convert and print string

PRTFIL: CLR     D1                      ; clear register
       MOV     #26,D1                  ; move offset from A3 into D1
       CALL    $GTARG                  ; call macro
       CMP     D1,#0                   ; see if there is an error line #
       JEQ     PRTPRG                  ; if not exit this routine
       OUTS    OT$DDB,<      Channel : > ; and yet another header
       DCVT    5,OT$DDB                ; convert and print string

PRTLOG: OUTS    OT$DDB,<      logged  : > ; whew !!
       JOBIDX  A6                      ; get our jobidx
       MOV     J.DEV(IMP),A2           ; move address of work var
       LEA     A1,JOBDEV(A6)           ; get address of current device (dsk,phx,win,etc...)
       UNPACK                          ; unpack this word
       MOV     J.DEV(IMP),A1           ; move device into a1
       CLRB    3(A1)                   ; I had to do this here, if i didn't
       CLRB    4(A1)                   ; i get an 'OR ' when i display this
       CALL    SETFIL                  ; field.
       OUTL    @A1,OT$DDB              ; output indexed string
       CLR     D1                      ; clear work register

PRTDRV: JOBIDX  A6                      ; index our job
       MOVW    JOBDRV(A6),D1           ;
       DCVT    0,OT$DDB                ;
       CLR     D1                      ;
       CALL    SETFIL                  ;
       MOVB    #':,D1                  ;
       CALL    PUTBYT                  ;
       MOVB    #'[,D1                  ;
       CALL    PUTBYT                  ;

PRTPPN: JOBIDX  A6                      ;
       MOVW    JOBUSR(A6),J.PPN(IMP)   ;
       CLR     D1                      ;
       MOVB    J.PPN+1(IMP),D1         ;
       OCVT    0,OT$DDB                ;
       MOVB    #<',>,D1                ;
       CALL    PUTBYT                  ;
       CLR     D1                      ;
       MOVB    J.PPN(IMP),D1           ;
       OCVT    0,OT$DDB                ;
       CLR     D1                      ;
       MOVB    #'],D1                  ;
       CALL    PUTBYT                  ;
       CALL    SETFIL                  ;
       OUTCR   OT$DDB,<  >             ;
       CLOSE   F.DDB(IMP)              ;

RETURN: KBD                             ;  input a byte
       RTN                             ;  return to basic

MAKEIT: OPENO   F.DDB(IMP)              ; create new file
       JMP     PUTDSH                  ; jump to first line of error logging

SETFIL: LEA     A2,F.DDB(IMP)           ; index ddb
       RTN                             ; return from call

PUTBYT: FILOTB  F.DDB(IMP)              ; output a byte
       RTN                             ; return from call

TTYERR:                                 ; display to terminal

DEFINE  MSG     TEXT
1$$:    ASCIZ   /TEXT/
       BLKB    30.-<.-1$$>
       ENDM

ERR1:   MSG     Control-C interrupt
ERR2:   MSG     System Error
ERR3:   MSG     Out of Memory
ERR4:   MSG     Out of Data
ERR5:   MSG     Next without FOR
ERR6:   MSG     RETURN without GOSUB
ERR7:   MSG     RESUME without ERROR
ERR8:   MSG     Subscript out of range
ERR9:   MSG     Floating Point overflow
ERR10:  MSG     Divide by zero
ERR11:  MSG     Illegal function value
ERR12:  MSG     XCALL subroutine not found
ERR13:  MSG     File already open
ERR14:  MSG     IO to unopened file
ERR15:  MSG     Record size overflow
ERR16:  MSG     File specification error
ERR17:  MSG     File not found
ERR18:  MSG     Device not ready
ERR19:  MSG     Device full
ERR20:  MSG     Device error
ERR21:  MSG     Device in use
ERR22:  MSG     Illegal user code
ERR23:  MSG     Protection Violation
ERR24:  MSG     Write protected
ERR25:  MSG     File type mismatch
ERR26:  MSG     Device does not exist
ERR27:  MSG     Bitmap kaput
ERR28:  MSG     Disk not mounted
ERR29:  MSG     File already exists
ERR30:  MSG     Redimentioned array
ERR31:  MSG     Illegal record number
ERR32:  MSG     Invalid filename
ERR33:  MSG     Stack overflow
ERR34:  MSG     Invalid syntax code
ERR35:  MSG     Unsupported function
ERR36:  MSG     Invalid subroutine version
ERR37:  MSG     File in use
ERR38:  MSG     Record in use
ERR39:  MSG     Deadly embrace
ERR40:  MSG     File cannot be deleted
ERR41:  MSG     File cannot be renamed
ERR42:  MSG     Record not locked
ERR43:  MSG     Multiple link translation
ERR44:  MSG     LOKSER queue is full
ERR45:  MSG     Device not file structured
ERR46:  MSG     Illegal ISAM sequence

DEFINE  ERROR   TEXT
       TYPE    <? 'TEXT'>
       JMP     ABORT
       ENDM

ARGERR: ERROR   improper number of arguments
TYPERR: ERROR   argument type error
SIZERR: ERROR   argument size error
MISERR: ERROR   missing numeric parameter
FILERR: ERROR   Invalid variable type passed as filespec
RNGERR: ERROR   error out of range

ABORT:  TYPECR  < in ERROR.SBR>
       RTN

ERRHDR: ASCII   /Program Error(/
       BYTE    0
       EVEN

LINENO: ASCII   / -On Line(/
       BYTE    0
       EVEN

FILCHN: ASCII   / -Channel(/
       BYTE    0
       EVEN

FILNAM: ASCII   /ERROR.LOG/
       BYTE    0
       EVEN

       END

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.