;*
;*    RDERXSUPP.ASM
;*      Reusable routines to provide an asynchronous, recursively callabe
;*      ARexx ( (C) Bill Hawes) Host.
;*
;*      (C) Copyright 1989 by Vidyanath Rao
;*              All rights reserved.
;*
;* These routines may be used in freely redistributable software for
;* the Amiga (TM of Commodore-Amiga) computer, provided that credit
;* is given and this notice appears in the software or the documentation.
;*


        NOLIST
        INCLUDE "rderexx.i"
        LIST

        SECTION RxSuppData,DATA

_RHUsrPassWd:
        dc.l 0
_RHMcrPassWd:
        dc.l 0
_RHOutCount:
        dc.w 0
_RMSeqNo:
        dc.w 1

rmes3:  dc.b  'Unknown error code: '
rmes4:  dc.b  '        .',0
        CNOP 0,2

        XREF     _RexxSysBase,_SysBase,_ArpBase
        XREF    _RHPort,_RHFlags,_ChkPorts,_CmdErr
        XDEF     _RHUsrPassWd,_RHMcrPassWd,_RHOutCount,_RMSeqNo

;_RHPort:       Port used to communicate with ARexx
;_RHFlags: (UWORD) flags:
;               bit 0 --> external command being executed
;                   1 --> execution of this host halted.
;                   4 --> locked by the user
;                   5 --> locked by a macro
;_ChkPorts: (UWORD) flags to indicate invalid signals for msg ports.
;_CmdErr:       error flags set by the application
;_RH???PassWd:  Pointer to the pass word set by usr/external macro
;_RHOutCount:   No of outstanding messages
;_RMSeqNo:      The serial no of the last msg to Rexx. (modulo 2^16)


        SECTION RxSuppCode,CODE

        far code
        far data

;This is the list of names and function addresses
rhcmds: dc.l    rcn04,_rh_string,rcn05,_rh_msg2usr
        dc.l    rcn06,_rh_lock,rcn07,_rh_unlock
        dc.l    0,0

        near code
        near data

;do_command() is the application command dispatcher.
;drm_end() is called by disprxmsg() to take care of the id
        XREF    _malloc,_do_command,_drm_end,_free
        XDEF    _disprxmsg,_sendrxmsg,_rxerrmsg
        XREF    _rh_string,_rh_msg2usr,_rh_lock,_rh_unlock


;This is the list of severity levels and error codes for the flags of
;_CmdErr.
CErc:   dc.w 20,20,20,20,15,15,15,15
        dc.w 10,10,10,10,10,10,10,10
        dc.w  5,5,5,5,5,5,5,5
        dc.w  5,5,5,5,5,5,5,5

msgnm:  dc.b 'RDE RX MESSAGE',0

rcn04:  dc.b ((rcn05-rcn04)-2),'STRING',0
rcn05:  dc.b $80|((rcn06-rcn05)-2),'MSGTOUSR',0
rcn06:  dc.b $80|((rcn07-rcn06)-2),'LOCK',0
rcn07:  dc.b $80|((rcn08-rcn07)-2),'UNLOCK',0
rcn08:

hastr:  dc.b 'RDE',0
extstr: dc.b 'rde',0
rxnm:   dc.b 'AREXX',0
okstr:  dc.b 'OK',0

        CNOP    0,4

;Call the routine as void disprxmsg(struct RexxMsg *);
;if non-Rexx message, does nothing
;if our Rexx message, recylces the memory. If a result was returned
;       it is stored in malloc()'ed storage.
;At the end a call of the form
;       drm_end(r2, r1, id)
;               union {int err; char *result} r2;
;               long    r1;
;               void    *id;
; is made. This lets you decide what to do. The arguments are as follows:
;       case (r1 = 0, r2 = 0) : No errors, no result string.
;       case (r1 = 0, r2 != 0): No errors; r2.result points at a copy
;                                       of the result string. This
;                                       store must be free()'ed by you.
;       case (r1>0)           : There was an error. r1 = severity and
;                                       r2 = error code.
;       case (r1 = -1)        : The macro went ok, but couldn't malloc()
;                                       memory for the result string.
; In all cases, id is the value originally passed to sendrxmsg(),
;   when the message was sent. [see below].
;
;if external Rexx message, and is one of the four listed commands,
;       the appropriate routine is called.
;       The calling sequence is rv = <...>(arg, rs, rl);
;               char *arg = rest of the command string.
;               long rl, char *rs to be filled in by callee:
;           The result is:
;               rv != 0, rl any, rs == NULL :
;                   There was an error with severity rv and code rl.
;               rv == 0, rl == 0, rs == NULL :
;                   No errors and no result string.
;               rv == 0, rl != 0, rs != NULL :
;                   No errors, rs points to result string and
;                       rl = strlen(rs). The storage for rs MUST be
;                       made with malloc(), as free(rs) call will be made.
;           NO OTHER COMIBNATIONS ARE ALLOWED. Failure follow this will
;       cuase memory corruption and a crash.

_disprxmsg:
        INITRT  drm,a2/a3/a5,16
        move.l  ARGSTART(sp),a2
        move.l  _RexxSysBase,a6
        move.l  a2,a0
        jsr     _LVOIsRexxMsg(a6); is it a rexx msg?
        tst.l   d0
        beq     drmown ; no check if it is ours

        cmp.b   #NT_MESSAGE,LN_TYPE(a2) ; is it external
        beq     drmdoerx ; overkill???
        cmp.b   #NT_REPLYMSG,LN_TYPE(a2) ; is it a reply?
        bne     drmout0 ; funny
        bra     drml05

;The hard part. This is a Rexx message originated by someone else.
;First check for locks and passwords.
drmdoerx:
        WORDBITS btst,RHB_HALTED,_RHFlags
        beq     drml21
        move.l  #15,d0 ;Host halted
        bra     drmout6

drml21: move.l  rm_Args(a2),a3 ; get the command string.
        WORDBITS btst,RHB_USRLOCK,_RHFlags ; check for user lock
        beq     drml22
        move.l  _RHUsrPassWd,a0; check the password
        bra     drml26
drml22: WORDBITS btst,RHB_MCRLOCK,_RHFlags ; and for lock by a macro
        beq     drml32 ; no locks
        move.l  _RHMcrPassWd,a0
        bra     drml26
drml25: cmp.b   (a3)+,d0 ; compare pass words
        bne     drml27 ; permission denied.
drml26: move.b  (a0)+,d0
        bne     drml25
        bra     drml32

drml27: move.l  #5,d0 ; locked out by somebody.
        bra     drmout6

;strip initial spaces, and then look for the command.
drml31: addq.l  #1,a3
drml32: cmp.b   #' ',(a3)
        beq     drml31
        move.l  _ArpBase,a6 ;get set
        lea     rhcmds,a5
        bra     drml36
drml35: move.l  #0,d0; length of the command into d0
        move.b  (a0)+,d2 ; now a0 points are the command name
        move.b  d2,d0
        bclr    #7,d0
        move.l  a3,a1 ; and a1 at the (rest of the) command
        jsr     _LVOStrncmp(a6) ; compare, ignoring case
        tst.l   d0
        beq     drml50 ; command found
        addq.l  #4,a5 ;  not this. try next
drml36: move.l  (a5)+,a0
        cmp     #0,a0 ; all done?
        bne     drml35
        move.l  a3,-(sp) ; Yes. So command is not Rexx Host specific.
        WORDBITS bset,RHB_ACTIVE,_RHFlags ; set the active flag
        jsr     _do_command ; call the general dispatcher
        addq.l  #4,sp
        WORDBITS bclr,RHB_ACTIVE,_RHFlags
        move.l  _CmdErr,d0 ; check for errors
        beq     drml40 ; none. go ahead

        move.w  #64,d1 ; get the highest bit
drml37: subq.l  #2,d1
        lsr.l   #1,d0 ; shift out a bit
        bne     drml37
        lea     CErc,a1 ; now d1 = error no * 4
        move.w  0(a1,d1.w),d0 ;severity
        ext.l   d0
        bra     drmout6

drml40: LONGBITS btst,RXFB_RESULT,rm_Action(a2); is a result string needed
        bne     drml45
        move.l  #0,a0; no just enter 0
        bra     drmout5

drml45: lea     okstr,a0;Create and send the default result:
        move.l  #2,d0
drml46: move.l  _RexxSysBase,a6
        jsr     _LVOCreateArgstring(a6)
        tst.l   d0
        bne     drml60 ; result argstring in a0

drml47: move.l  #15,d0 ; no memory for argstring
        bra     drmout6


;The Rexx Host specific command has been found. The address to call
;is in 4(a5). a3 points at the command line, past the password.
drml50: btst    #7,d2
        bne     drml51; The called command need not return a result.
        LONGBITS btst,RXFB_RESULT,rm_Action(a2)
        bne     drml51 ; A result is requested
        move.l  #5,d0 ; The called command MUST return a result
        bra     drmout6

drml51: bclr    #7,d2
        ext.w   d2
        add.w   d2,a3 ; past the command name
        bra     drml53

drml52: addq.l  #1,a3 ; skip past spaces
drml53: cmp.b   #' ',(a3)
        beq     drml52
        move.l  #0,-(sp); push rint,
        move.l  #0,-(sp); rstr and
        move.l  a3,-(sp); arg
        move.l  (a5),a0
        jsr     (a0) ; call the function
        tst.l   d0 ; check for error
        bne     drml55 ; if one, exit

        addq.l  #4,sp ; throw away the arg
        move.l  (sp)+,a0 ; keep rs and rl
        move.l  (sp)+,d0; is there a specific result?
        beq     drml40 ; if not, send the default string if one is needed
        move.l  a0,-(sp) ; save the string pointer
        move.l  _RexxSysBase,a6
        jsr     _LVOCreateArgstring(a6)
        move.l  a0,a3 ; save the arg string
        jsr     _free ; free the string
        addq.l  #4,sp ; correct the stack pointer
        cmp     #0,a3 ; check for errors
        beq     drml47 ; no memory for argstring (sphagatti)
        move.l  a3,a0

drml60: move.l  #0,d0
        bra     drmout5

drml55: lea     12(sp),sp ; throw away the arg and rs
drmout6:
        move.w  #0,a0
;Enter the result, send the mesage back, clean up and exit.
drmout5:
        move.l  d0,rm_Result1(a2)
        move.l  a0,rm_Result2(a2)
        move.l  _SysBase,a6
        move.l  a2,a1
        jsr     _LVOReplyMsg(a6)
        ENDRT   drm


drmown: lea     msgnm,a1 ; is it ours? (they are marked with a special
        cmp.l   LN_NAME(a2),a1 ; static string.
        bne     drmnonrx

;This part of the routine handles the case of our message being replied.
drml05: sub.w   #1,_RHOutCount ;correct the count of outstanding messages.
        move.l  rm_Result2(a2),a3;
        move.l  rm_Result1(a2),d0; is there an error indication.
        bne     drmout1 ;there is nothing more to do
        cmp     #0,a3 ; is there a result string?
        beq     drmout1 ; if not, we are done.
        move.l  a3,a0 ; if so store it
        jsr     _LVOLengthArgstring(a6) ; get the length
        move.w  d0,-(sp) ; save the length
        addq.l  #1,d0
        move.l  d0,-(sp) ;allocate memory
        jsr     _malloc
        addq.l  #4,sp
        move.w  (sp)+,d1
        tst.l   d0
        bne     drml15

        move.l  #-1,d2 ; if memory failed, set the codes
        bra     drml13 ; and exit

drml15: move.l  d0,a0 ; otherwise copy the string
        move.l  a3,a1
drml12: move.b  (a1)+,(a0)+
        dbf     d1,drml12
        move.l  #0,d2

drml13: move.l  a3,a0 ; delete the result string
        move.l  d0,a3 ; pointer to copy in a3.
        move.l  _RexxSysBase,a6
        jsr     _LVODeleteArgstring(a6)
        move.l  d2,d0

drmout1:
        move.l  60+rm_Args(a2),-(sp) ; push id
        move.l  d0,-(sp) ; and the return code
        move.l  a3,-(sp) ; and the result

        move.w  2+rm_Action(a2),d0 ;clear out the arg strings
        and.w   #$0f,d0
        ext.l   d0
        addq.l  #1,d0
        move.l  a2,a0
        jsr     _LVOClearRexxMsg(a6)
        move.l  a2,a0
        jsr     _LVODeleteRexxMsg(a6) ; recycle the memory

        jsr     _drm_end ; call the user routine
        lea     12(sp),sp
drmout0:
        ENDRT   drm


;The easy (for now) part. Not a Rexx msg. Just throw it back if it was
;original. Tell the user that something that should not ocur happened.
drmnonrx:
        cmp.b   #NT_MESSAGE,LN_TYPE(a2) ; is it external
        bne     drml90
        move.l  _SysBase,a6
        move.l  a2,a1
        jsr     _LVOReplyMsg(a6) ; if so reply
drml90: ENDRT   drm


;This routine handles the chore of creating and sending Rexx messages
;It is called as
;       sendrxmsg(act, flgs, args, id)
;               long act, flgs, id
;               char *args[];
;-->Actually, args[i] may either be a string pointer or a long.
;-->Similarly, id may be a long or void pointer.
;
;The roles of these variables are:
;       act : entered as is into rm_Action field.
;               act&0x0f will be used as the no of args to be converted.
;                       must be less than 15, but NOT equal
;       flgs: this is a bit field with bits 0:14 being the flags for
;               conversion: bit i is 0 => args[i] is a string
;                           bit i is 1 => args[i] is a long.
;               if SRMB_ASYNCH is set, the message is sent asynchornously:
;                   sendrxmsg will not wait for the message to come back.
;               if SRMB_HOSTNM is set, the initial Host will ARexx itself.
;                   usually it is ourselves.
;       args: This is an array 0..14 of union{long ; char *}. Used to
;               fill the rexx msg.
;       id  : This is the message id. Will be entered as is into
;               rm_Args[15] field of the rexx message.
;               Is passed as an argument to drm_end.
;Return value:  0 --> all ok
;               1 --> too many outstanding messages.
;               2 --> Unable to create the message/argstrings
;               3 --> No public REXX port

_sendrxmsg:
        INITRT  srm,a2/a3,12

        cmp.w   #RDEMAXOUT,_RHOutCount ; if the outstanding count
        bcs     srml01 ; exceeds the max,

        move.l  #1,d0 ; error exit
        bra     srmout9

srml01: move.l  _RexxSysBase,a6
        move.l  4+ARGSTART(sp),d2 ; flags into d2
        btst    #SRMB_HOSTNM,d2 ; what is the host name
        bne     srml02
        lea     hastr,a0 ; ours
        bra     srml03
srml02: lea     rxnm+1,a0 ;
srml03: move.l  a0,d0
        lea     extstr,a1
        move.l  _RHPort,a0 ; set the reply port
        jsr     _LVOCreateRexxMsg(a6)
        tst.l   d0 ; success?
        bne     srml05

srmerr1:
        move.l  #2,d0 ; no, set error code
        bra     srmout9 ;and exit

srml05: move.l  a0,a2 ; save the mesage pointer
        move.l  ARGSTART(sp),d0
        WORDBITS btst,RHB_NOIO,_RHFlags ; i/o allowed?
        beq     srml07
        bset    #RXFB_NOIO,d0
srml07: move.l  d0,rm_Action(a2) ; set the Action field.
        move.l  12+ARGSTART(sp),60+rm_Args(a2) ; and the id
        lea     msgnm,a1 ;mark the name field
        move.l  a1,LN_NAME(a2)
        and.w   #$0f,d0 ; find the no of args
        move.w  d0,d1
        add.w   #1,d0
        lea     rm_Args(a2),a1
        move.l  8+ARGSTART(sp),a0 ; arg array passed
srml06: move.l  (a0)+,(a1)+ ; copy the arg array
        dbf     d1,srml06
        ext.l   d0 ; convert the array
        move.l  #0,d1 ; the lower half of the flags into d1
        move.w  d2,d1 ; into d1
        move.l  a2,a0 ; and msg ptr into a0
        jsr     _LVOFillRexxMsg(a6)
        tst.l   d0
        beq     srmerr2

srml10: move.l  _SysBase,a6 ; now find the rexx port
        jsr     _LVOForbid(a6) ; disable task switching while we put
        lea     rxnm+1,a1 ; the msg
        btst    #SRMB_TONAME,d2
        beq     srml11
        subq.l  #1,a1
srml11: jsr     _LVOFindPort(a6)
        tst.l   d0
        beq     srmerr3
        move.l  d0,a0 ; send the message
        move.l  a2,a1
        jsr     _LVOPutMsg(a6)
        jsr     _LVOPermit(a6)
        add.w   #1,_RHOutCount ; bump the out count
        add.w   #1,_RMSeqNo ; and the sequence
        btst    #SRMB_ASYNCH,d2 ; is this asynch
        bne     srml35

        subq.l  #4,sp ; create an empty slot on the stack
srml20: move.l  _RHPort,a0
        jsr     _LVOWaitPort(a6) ; wait for a msg
        bra     srml26
srml25: move.l  d0,(sp) ; take care of the message
        move.l  d0,a3
        jsr     _disprxmsg
        cmp.l   a2,a3 ; is the msg we just sent?
        beq     srml30 ; yes quit
        move.l  _SysBase,a6
srml26: move.l  _RHPort,a0
        jsr     _LVOGetMsg(a6) ; get the next message
        tst.l   d0
        bne     srml25 ; and loop
        beq     srml20 ; we are not done till we got the msg we sent

srml30: addq.l  #4,sp ; correct the stack
        WORDBITS bset,CPB_RHPORT,_ChkPorts

srml35: move.l  #0,d0
srmout9:
        ENDRT   srm

srmerr3:        ; no REXX port. clear and delete the rexx msg
        jsr     _LVOPermit(a6)
        move.l  _RexxSysBase,a6
        move.w  2+ARGSTART(sp),d0 ; find the no of args
        and.w   #$0f,d0
        add.w   #1,d0
        ext.l   d0
        move.l  a2,a0
        jsr     _LVOClearRexxMsg(a6)
        move.l  #3,d2
        bra     srml50

srmerr2:
        move.l  #2,d2
srml50: move.l  a2,a0
        jsr     _LVODeleteRexxMsg(a6)
        move.l  d2,d0
        ENDRT   srm


;
;This routine is called as rxerrmsg(ec)
;       where long ec is the error code, the result2 from ARexx

_rxerrmsg:
        move.l  4(sp),d0; get the error code
        move.l  _RexxSysBase,a6
        jsr     _LVOErrorMsg(a6) ; convert to message
        tst.l   d0 ; known error code?
        beq     reml05
        addq.l  #8,a0 ; add the NexxStr offset
        bra     reml10

reml05: lea     4+rmes4,a0 ; unknown error code
        move.l  #$20202020,d0 ; blank out the space for
        move.l  d0,(a0) ; the error code
        move.l  d0,-(a0)
        move.l  4(sp),d0 ; convert error code to ascii
        move.l  #8,d1 ; and put into the string.
        jsr     _LVOCVi2a(a6)
        lea     rmes3,a0

reml10: move.l  a0,d0 ; pointer to the error string
        rts


END