*=- INFO -=****************************************************************************
* System Subroutines. (File access, Communication, etc)				      *
* Unless otherwise stated, all routines are by Leo 'Nudel' Davidson		      *
*=- Notes -===========================================================================*
* o Error should always be called using the Beq_ErrorX macros in Constants.i	      *
*=- To Do -===========================================================================*
* o DeleteNudelPort Should ensure that all msgs have been replied before deletion.    *
*   (Currently, all programs using *NudelPort should never get non-reply messages).   *
* o Error should put up an alert when any of its sub-routines fail.		      *
*=- History -=========================================================================*
* o Version 2.00								      *
*   Ancient history deleted.							      *
***************************************************************************************


***************************************************************************************
* System Subroutines								      *
***************************************************************************************
;;; "Error" is not optional.
;SYS_READARG	; ReadArgs() routine.
;SYS_FREEARG	; FreeArgs() routine.
;SYS_CLIRITE	; Write text using CLI_Hdl(a5) as output handle.
;SYS_CHKCRTC	; Check for ^C-Break and abort program if sent.
;SYS_PORTS	; CreateMsgPort(), DeleteMsgPort() routines.

;Include Asm:Source/Routines/System.s

;-------------------------------------------------------------------------------------;
;- STD_F_1 ---------------------------------------------------------- Standard Flags -;
;-------------------------------------------------------------------------------------;
SF1_ReadArgs	Equ	0	RDArgs Structure requires FreeArgs()
SF1_OpnLibErr	Equ	1	If set, one or more libs couldn't be openned.
SF1_ErrorReq	Equ	2	If set, next error routine output w/ a req.
;				(Reset to default after every error call).
;				NOTE: This _may_ be used by other functions.
	IFD	DOpus5_Error	Make SURE it causes an error if used wrongly.
SF1_ErrorDop	Equ	3	If set, next error will output via "dopus request"
	ENDC
SF1_OpenIFF	Equ	4	If set, NudelIFFHandle(a5) requires CLOSE.
SF1_NewListers	Equ	5	Get(Source|Dest)Handle allowed to create new listers?
	IFD	SYS_PORTS
*= Create NudelMsgPort (NORMAL) =**************************************= 11-Aug-1995 =*
*  Inputs: None.								      *
* Outputs: NudelPort(a5) - Ptr to our MsgPort					      *
***************************************************************************************
CreateNudelPort
	N_CallExec	CreateMsgPort			-.
	Move.l	d0,NudelPort(a5)			 |- Create our msgport.
	Beq_ErrorE	ErrAct_CreateMsgPort(pc),#0	-'
	RTS

ErrAct_CreateMsgPort
	Dc.b	"Could not create MsgPort",0
	Even

*= Delete NudelMsgPort (NORMAL) =**************************************= 11-Aug-1995 =*
*  Inputs: NudelPort(a5) - Ptr to our MsgPort					      *
* Outputs: NudelPort(a5) - Null.						      *
*=====================================================================================*
*   Notes: Ensures that all msgs have been GetMsg()'d before DeleteMsgPort.           *
***************************************************************************************
DeleteNudelPort
	Tst.l	NudelPort(a5)		-._ If no MsgPort to free,
	Beq.s	DMsgSkp			-'  skip this routine.
	N_CallExec	Forbid		Forbid Multitasking so no new messages sent.

DNP_WP_Loop
	Move.l	NudelPort(a5),a0	-._ Get first waiting
	N_CallExec	GetMsg		-'  message sent to us.
	Tst.l	d0			-._ If there are none left,
	Beq.s	DNP_WP_Skip		-'  It's safe to close down.
	Bsr_ErrorW	ErrAct_PendingMessages(pc),#0
	Bra.s	DNP_WP_Loop
DNP_WP_Skip

	Move.l	NudelPort(a5),a0	-._ Delete
	N_CallExec	DeleteMsgPort	-'  the port.
	Move.l	#0,NudelPort(a5)	Null Pointer to stop re-free.
	N_CallExec	Permit		Permit Multitasking again.
DMsgSkp
	RTS

ErrAct_PendingMessages
	Dc.b	"Messages pending at port closure - please report to Leo",0
	Even
	ENDC


	IFD	SYS_READARG
*= READ ARGS (NORMAL) =**************************************= 24-Jul-1995 =*
* RDA_Template(pc) = Template         * RDA_Array(a5) = Array of LongWords  *
* RDA_Rtn(a5) = (Pointer to returned RDArgs structure)                      *
*===========================================================================*
* RDA_Array(a5) should be initialized to default values before calling.     *
*****************************************************************************
RArgNor	BTst	#SF1_ReadArgs,STD_F_1(a5)	-._ Generate an Error if
	Bne	Internal			-'  previous Read & no Free.
	Lea	RDA_Template(pc),a0	Template for ReadArgs()
	Move.l	a0,d1
	Lea	RDA_Array(a5),a0	Array space for ReadArgs()
	Move.l	a0,d2
	Moveq	#0,d3			Use default options for ReadArgs()
	N_CallDOS	ReadArgs
	Move.l	d0,RDA_Rtn(a5)		Store returned pointer to structure.
	Beq_ErrorE	ErrAct_ReadArgs(pc),#0	Fatal Error, No Filename.
	BSet	#SF1_ReadArgs,STD_F_1(a5)	ReadArgs done, need freeing.
FArgNDn	RTS
ErrAct_ReadArgs
	Dc.b	"Could not parse command-line",0
	Even
	ENDC

	IFD	SYS_FREEARG
*= FREE ARGS (NORMAL) =**************************************= 24-Jul-1995 =*
* RDA_Rtn(a5) = Pointer to RDArgs structure returned by ReadArgs()          *
*****************************************************************************
FArgNor	BClr	#SF1_ReadArgs,STD_F_1(a5)
	Beq.s	FArgNDn			If no FreeArgs() needed, skip.
	Move.l	RDA_Rtn(a5),d1
	N_JumpDOS	FreeArgs
;;;;;;;	RTS for us.
	ENDC


	IFD	SYS_CLIRITE
*= CLI WRITE =***************************************************************
* a0 = Start of text to be written    * d3 = #Chars to be Written           *
* CLI_Hdl(a5) - Handle of CLI         *                                     *
*****************************************************************************
CLIRite	Move.l	a0,d2
CLIRit2	Move.l	CLI_Hdl(a5),d1
	Lea	CLIRite_NIB_FileName(pc),a0	-._ Set pseudo-filename
	Move.l	a0,NIB_NameAdrs+FakeNIB(a5)	-'  in FakeNIB.
	N_CallDOS	Write			RTS for us.
	Cmpi.l	#-1,d0
	Beq_ErrorE	ErrAct_Write(pc),FakeNIB_Adrs(a5)	Fatal error.
	RTS

CLIRite_NIB_FileName
	Dc.b	"standard output"
	EVEN
	ENDC


	IFD	SYS_CHKCRTC
*= CHECK CTRL-C =******************************************************= 16-Aug-1995 =*
* Checks for if ^C has been pressed, and if so prints "***Break" and Exits	      *
* All registers preserved. (But not CCR)					      *
***************************************************************************************
CkCtrlC	Movem.l	d0-d7/a0-a6,-(SP)	Preserve everything.
	Moveq	#0,d0			No new signals.
	Move.l	#SIGBREAKF_CTRL_C,d1	Clear ^C Signal
	N_CallExec	SetSignal	Do it & OldSignals -> d0
	BTst	#SIGBREAKB_CTRL_C,d0	Was ^C Set?
	Bne.s	YoBreak			YES=Exit
	Movem.l	(SP)+,d0-d7/a0-a6	Restore everything.
	RTS
YoBreak	Lea	BreakMs(pc),a0		-.
	Move.l	#BreakML,d3		 |- Write "***Break"
	Bsr.s	CLIRite			-'
	Bra	Finish			and then Exit the Proggy.
BreakMs	Dc.b	10,155,"0m***Break: "
	PROGNAM
	Dc.b	10
BreakML	Equ	*-BreakMs
	Even
	ENDC


*= ERROR =*************************************************************= 16-Aug-1995 =*
* ErrorE for FATAL errors, and ErrorW for non-fatal (will return to caller).          *
* This routine should ALWAYS be called using the Beq_ErrorX macros in Constants.i     *
*=====================================================================================*
*  Inputs: Buffer1(a5) - Buffer to write message into (#Buffer1Len bytes long)	      *
*          Active_NIB(a5)/NIB_NameAdrs - Pointer to name of file (etc.)		      *
*          CAction(a5) - Pointer to null-term "Could not lock file" type message.     *
* Outputs: DosRtnC(a5) - #ERROR, #WARN, or left-alone (NOTICE).			      *
*=====================================================================================*
* If Active_NIB(a5) or NIB_NameAdrs are Null, filename is not output.		      *
* If CAction(a5) is null, no action is output (will look stupid)		      *
* If IoErr() returns zero, no reason output.					      *
***************************************************************************************
ErrorE_Internal
	Moveq	#0,d1			SetIoErr(#0)
	N_CallDOS	SetIoErr	No Error.
ErrorE	Cmpi.l	#RETURN_ERROR,DosRtnC(a5)	-.
	Bge.s	ErrorESkp			 |- "ERROR" return code, unless a worse
	Move.l	#RETURN_ERROR,DosRtnC(a5)	-'  one has already been set.
ErrorESkp
	Lea	ErrHead_Error(pc),a0	Fatal-Error message.
	Bsr.s	Error_Main_Subroutine	As Error-Warn.
	Bra	Finish			Finish the program.
;-------------------------------------------------------------------------------------;
ErrorN	Moveq	#0,d1			SetIoErr(#0)
	N_CallDOS	SetIoErr	No Error.
	Lea	ErrHead_Notice(pc),a0	"Note" message.
	Bra.s	Error_Main_Subroutine
;;;;;;;	RTS for us.
;-------------------------------------------------------------------------------------;
ErrorW	Cmpi.l	#RETURN_WARN,DosRtnC(a5)	-.
	Bge.s	ErrorWSkp			 |- "WARN" return code, unless a worse
	Move.l	#RETURN_WARN,DosRtnC(a5)	-'  one has already been set.
ErrorWSkp
	Lea	ErrHead_Warn(pc),a0	Warning-Error message.
;;;;;;;	Bra.s	Error_Main_Subroutine
;;;;;;;	RTS for us.
;-------------------------------------------------------------------------------------;
Error_Main_Subroutine
	Move.l	a0,RDF_1_Long(a5)	"Error"/"Warn"/"Notice" header is first %s
	Move.l	CAction(a5),RDF_2_Long(a5)	Action is the second %s
	Tst.l	Active_NIB(a5)		-.
	Bne.s	EW_GotNIB_Skp		 |- If no active NIB, no filename.
	Move.l	#0,RDF_3_Long(a5)	-'
	Bra.s	EW_NoNIB_Skp
EW_GotNIB_Skp
	Move.l	Active_NIB(a5),a0		-._ Adrs of filename from NIB.
	Move.l	NIB_NameAdrs(a0),RDF_3_Long(a5)	-'  If null, no string output.
EW_NoNIB_Skp
	Move.l	#0,Active_NIB(a5)	No active NIB.

	Moveq	#0,d1			SetIoErr(#0) so no error in the future.
	N_CallDOS	SetIoErr	Get number representing the error.
	Move.l	d0,d1			Error code to d1 for Fault()

	Lea	ErrReason_Header(pc),a0	-._ Header to d2
	Move.l	a0,d2			-'  for Failt()
	Lea	Buffer1(a5),a0		-._ Buffer to build message in.
	Move.l	a0,d3			-'  To d3 for Fault()
	SF	(a0)			Ensure it's null-terminated to start with.
;;;;;;;			So that it can be used even if Fault() doesn't write into it.
	Move.l	#Buffer1Len,d4		Size of the buffer to d4 for Fault()
	N_CallDOS	Fault		Put error message into the buffer.
;;;;;;;	Tst.l	d0			Ignore result, Buffer1 can be used anyway.

	Lea	Buffer1(a5),a0		-._ Adrs of reason is the
	Move.l	a0,RDF_4_Long(a5)	-'  fourth %s for RawDoFmt()
;-------------------------------------------------------------------------------------;
	Lea	RDF_Error_Input(pc),a0		Input string.
	Lea	RDF_Array(a5),a1		DataArray
	Lea	Buffer2(a5),a3			-._ Output
	Move.l	a3,RDF_Adrs(a5)			-'  Buffer
	Move.l	#Buffer2Len,RDF_Size(a5)	Size of output buffer.
	Bsr	NudelRawDoFmt			Create the full error message.
;-------------------------------------------------------------------------------------;
; Error string is built, not output it in whatever way...			      ;
;-------------------------------------------------------------------------------------;
	IFD	DOpus5_Error		If DOpus5 error messages are allowed, check.
	BClr	#SF1_ErrorDop,STD_F_1(a5)
	Bne.s	ErrDopus5
	ENDC

	IFND	No_Requesters		If No_Requesters, go straight to Shell.
;;;;;;;					(Excludes the ErrReq routine as well)
	IFD	Reqs_S
	Tst.l	Reqs_S(a5)		The Reqs/S command defaults to shell.
	Beq.s	ErrShell
	ENDC

	IFD	NoReq_S			The NoReq/S command defauls to requester.
	Tst.l	NoReq_S(a5)
	Bne.s	ErrShell
	ENDC

	IFND	NoReq_S
	IFND	Reqs_S
	SetReqDefault			If Reqs / NoReqS not part of RDA_Template.
	Beq.s	ErrShell
	ENDC
	ENDC
;-------------------------------------------------------------------------------------;
; Requester error output.							      ;
;-------------------------------------------------------------------------------------;
ErrReq
	Move.l	#N_EasyStruct_Len,N_ES_Length(a5)	Size of structure.
	Move.l	#0,N_ES_Flags(a5)			No flags.
	Lea	ErrReq_Title(pc),a0		-.
	Move.l	a0,N_ES_Title(a5)		 |
	Lea	Buffer2(a5),a0			 |_ Texts for
	Move.l	a0,N_ES_Body(a5)		 |  requester.
	Lea	ErrReq_Gads(pc),a0		 |
	Move.l	a0,N_ES_Gadgets(a5)		-'


	Lea	N_EasyStruct(a5),a1	Point to EasyRequest structure.
	Sub.l	a0,a0			Specify default public screen.
	Move.l	a0,a2			No IDCMP flags.
	Move.l	a0,a3			No arguments.
	N_JumpInt	EasyRequestArgs	Put up the req. NO ERROR CHECKING, on purpose.
;;;;;;;	RTS for us.

	ENDC
;-------------------------------------------------------------------------------------;
; Shell error output.								      ;
;-------------------------------------------------------------------------------------;
ErrShell
	Lea	ErrReq_Title(pc),a0	-.
	Move.l	a0,d2			 |_ Write "ProgName: "
	Move.l	#ErrReq_Title_Len,d3	 |  for start of msg.
	Bsr.s	ErrShell_Write		-'

; Must work out the length of the returned Error text.

	Lea	Buffer2(a5),a0
	Move.l	a0,d2
	Bsr	NullLen
	Move.l	d0,d3

; A return must be added. As the string is null-terminated, and we don't need
; the null, the return can be written over the null without any buffer length
; checking.

	Move.l	d2,a0			-.
	Add.l	d3,a0			 |- Point to null and replace with return.
	Move.b	#10,(a0)		-'
	Addq.l	#1,d3			Update length of text to output.
;;;;;;;	Bra.s	ErrShell_Write
;;;;;;;	Bra.s for us.
;;;;;;;	RTS for us.

ErrShell_Write
	Move.l	CLI_Hdl(a5),d1
	N_CallDOS	Write		NO ERROR CHECKING, on purpose.
	RTS
;-------------------------------------------------------------------------------------;
; Directory Opus 5 error output.						      ;
;-------------------------------------------------------------------------------------;
	IFD	DOpus5_Error
ErrDopus5
	Move.l	NudelRexxMsg(a5),a0		-._ Point to DOpus
	Lea	rm_Result1(a0),a0		-'  return code.
	Cmp.l	#2,(a0)				-._ If RC < 2, no DOpus
	Blt.s	ErrDOpus5_NODOER		-'  error to report.

	Move.l	(a0),RDF_1_Long(a5)		RC is number for RDF string.

	Lea	Err_DOpus_Error_Command(pc),a0	Input string.
	Lea	RDF_Array(a5),a1		DataArray
	Lea	Buffer1(a5),a3			-._ Output
	Move.l	a3,RDF_Adrs(a5)			-'  Buffer
	Move.l	#Buffer1Len,RDF_Size(a5)	Size of output buffer.
	Bsr	NudelRawDoFmt			Generate "error xxx" command.

	Lea	Buffer1(a5),a1			-._ Get the error message
	Bsr	FillAndSendNudelRexxMsg		-'  into rm_Message2.

	Move.l	NudelRexxMsg(a5),a0		-.  Error message
	Lea	rm_Result2(a0),a0		 |- from DOpus is
	Move.l	(a0),RDF_3_Long(a5)		-'  last string.

	Lea	Err_DOpus_Reason(pc),a1		-._ "DOpus Reason:"
	Move.l	a1,RDF_2_Long(a5)		-'  string.
	Bra.s	ErrDOpus5_YESDOER

ErrDOpus5_NODOER
	Move.l	#0,RDF_2_Long(a5)		-._ Disable the DOpus
	Move.l	#0,RDF_3_Long(a5)		-'  Reason message.

ErrDOpus5_YESDOER
	Lea	Buffer2(a5),a0			-._ Error message is the
	Move.l	a0,RDF_1_Long(a5)		-'  first %s

	Lea	Err_Dopus_Request_Command(pc),a0	Input string.
	Lea	RDF_Array(a5),a1		DataArray
	Lea	Buffer1(a5),a3			-._ Output
	Move.l	a3,RDF_Adrs(a5)			-'  Buffer
	Move.l	#Buffer1Len,RDF_Size(a5)	Size of output buffer.
	Bsr	NudelRawDoFmt			Create the full error message.

	Lea	Dopus_Front_Command(pc),a1	-._ Bring the DOpus
	Bsr	FillAndSendNudelRexxMsg		-'  screen to the front.

	Lea	Buffer1(a5),a1			-._ Put up the
	Bra	FillAndSendNudelRexxMsg		-'  requester.
;;;;;;;	RTS for us.

Dopus_Front_Command
	Dc.b	"dopus front",0
Err_Dopus_Request_Command
	Dc.b	'dopus request "'
	PROGNAM
	Dc.b	': %s%s%s" _OK',0
Err_DOpus_Reason
	Dc.b	10,"DOpus Reason: ",0
Err_DOpus_Error_Command
	Dc.b	"dopus error %ld",0
;;;;;;;	Even
	ENDC
;-------------------------------------------------------------------------------------;
; Strings.									      ;
;-------------------------------------------------------------------------------------;
ErrReq_Title
	PROGNAM
	Dc.b	": "
ErrReq_Title_Len Equ *-ErrReq_Title

	IFND	No_Requesters
	Dc.b	0			;Null-term for ErrReq_Title

ErrReq_Gads
	Dc.b	"OK",0
	ENDC

RDF_Error_Input
	Dc.b	"%s - %s%s%s",0

ErrHead_Error
	Dc.b	"Error",0
ErrHead_Warn
	Dc.b	"Warning",0
ErrHead_Notice
	Dc.b	"Note",0

ErrReason_Header
	Dc.b	10,"Reason",0

ErrAct_Write
	Dc.b	"Could not write to ",0
ErrAct_AllocMem
	Dc.b	"Could not allocate memory for ",0
	EVEN
***************************************************************************************
Internal
	Bra_ErrorE_Int	ErrAct_Internal(pc),#0
Buffer_Overflow
	Bra_ErrorE_Int	ErrAct_BufferOverflow(pc),#0

ErrAct_Internal
	Dc.b	"Internal error!",0
ErrAct_BufferOverflow
	Dc.b	"buffer overflow",0
	Even