Idnt     _Error
       Section  _Err,COde
       Xref     Dosbase
       Xref     Output_Handle
       Xref     FileTab
       Xdef     Error
       Xdef     RoutNr
       Xdef     RoutAdr

; Stack : Rts.l      ; = Adresse an der Fehler auftrat +/- 6
;         D0 = ErrorCode
;    
; Stand : 09-Jun-93
;           Erstellt für Mini-Comp
;
;         Errorroutine, springt geregelt aus dem System aus
;         sollte später auch offene Dateien schließen
;
; Stand : 30-Jul-93
;         FileTabelle schließen


Error: Lea     ErrNr,a0  	       	; Hier ErrorNr
       Bsr     Hundert         		; Max 3 Stellen
       Lea     ErrR,a0
       Moveq   #0,d0
       Move.w  RoutNr,d0         	; Nummer der Proc (0=Hauptprg)
       Bsr     Hundert
       Move.l  (sp)+,D0         	; RTS-Adresse
       Subq.l  #6,D0            	; JSR-Offset abziehen
       Sub.l   RoutAdr,d0      		; Basisadresse der Routine
       Lea     ErrA,a0
       Bsr     ZehnTaus
       Move.l  Output_Handle,D1
       Move.l  #ErrorTxt,D2
       Moveq   #56,d3
       Move.l  Dosbase,a6      
       Jsr     -48(a6)         		; Ausgeben

   ; -------------------------------
   ; - Offene Dateien schließen
   ;

   	Lea   	FileTab,a4   		; Basisadresse FileTabelle
   	Moveq   #0,d4      		; Index f. FileTabelle
Tstlo   Tst.l   (a4,d4)      		; Filehandle eingetragen ?
   	beq.s   nein      		; Nein
   	Move.l  (a4,d4),d1   		; Filehandle
   	jsr   	-36(a6)     		; Close (AmigaDos)
nein   	addq.l	#4,d4
   	cmp.w   #128,d4      		; Tabellenende erreicht ?
   	beq.s   Ende
   	bra.s   Tstlo

Ende    Move.l  (a5),a7         	; SP herstellen
       	addq.l  #4,a7            	; FP löschen
       	Rts


ZehnTaus:
       	Move.l	#10000,d1
ZTLo    Sub.l   d1,d0
       	Bpl.s	ok3
       	Bra.s  	Tausend
ok3     Addq.b	#1,(a0)
       	Bra.s   ZTLo
Tausend Add.l   d1,d0
       	addq.l	#1,a0         ; Nächstes Zeichen
       	Move.l	#1000,d1      ; Nächste Potenz
TaLo    Sub.l	d1,d0
       	Bpl.s   ok4
        addq.l	#1,a0
       	add.l	d1,d0
       	Bra.s   Hundert
ok4     Addq.b  #1,(a0)
       bra.s    TaLo
Hundert Moveq    #100,d1
HunLoo  sub.l    d1,d0
       Bpl.s    ok
        Bra.s    Zehn
ok      Addq.b   #1,(a0)
        bra.s    HunLoo
Zehn    Add.l    d1,d0
       moveq    #10,d1
       addq.l   #1,a0
ZeLoo   Sub.l    d1,d0
       Bpl.s    ok1
       Bra.s    Eins
ok1       Addq.b   #1,(a0)
       Bra.s    ZeLoo
Eins    Add.l    d1,d0
       Addq.l   #1,a0
ELoo    Subq.l   #1,d0
       Bpl.s     ok2
       Bra.s     ExStr
ok2       Addq.b   #1,(a0)
       bra.s    ELoo
ExStr   Rts

ErrorTxt: Dc.b 'Laufzeitfehler '
ErrNr     dc.b '000 in Routine '
ErrR      dc.b '000 an Adresse '
ErrA     dc.b '00000    ',10,13,0
   ds.w 1          ; Align
RoutNr    dc.w  1      ; Default : 1 = Hauptprg
RoutAdr   dc.l  0
       End

; Fehlernummern der Laufzeit
;   Nr  | Grund
;  -----+-------------------------------
;    1  | Strings>255 Bytes
;    2  | chr(x) wobei nicht in 0..255
;    3  | Copy : Falsche Länge / Offset
;    4  | Open : FileTabelle ist voll
;    5  | Case : Else-Fall, aber kein Else definiert
;    6  | Arrayzugriff außerhalb der Grenzen 
;    7  | Prg-Abbruch vom Debugger 
;    8  | Division durch 0
;    9  | Sin,Cos,Tan Überlauf, oder LN <0
;   10  | File not Open
;  >200 | AmigaDos Fehler