.title Message Facility for Clients .sbttl cldrvr.mac ; DECUS C Calling Format ; ; jsr r5,csv$ ;save r2,r3, and r4 ; ;r5 is parameter base ; ;c$pmtr(r5) is first argument ; ;c$pmtr+2(r5) is second argument ; ;... ; ;return args in r0 ; ... ; user code ; ... ; ; jmp cret$ ;restore r2-r5 and return ; rts pc ;does the same (cret$ follows csv$) ; ; csv$ and cret$ need be used only if arguments are used ; .include "os.mac" .mcall .abtio, .close .if ne ts$sys ;tsx-plus specific ; These message passing routines uses the TSX+ named ; message channel facility. ; ; The message channel name is derived from the ; current job number and is thus always unique. ; ; The xmit channel is always to the TCPIP channel. ; ; The maximum message length supported by these ; routines is 16 bytes. .page .sbttl cldrvr initialization ; ; VOID cl_init(); ; ; Initialize the cldrvr and get the job number ; .psect c$code cl.init:: mov #gval,r0 ;.gval for jobnum emt 375 mov r0,tljobn ;save real number mov #"00,userid+4 ;preset id 1$: cmpb #10.,r0 ;build number bhi 2$ add #246.,r0 ;low byte is lsd br 1$ ;high byte is msd 2$: swab r0 add r0,userid+4 jsr pc,cl.recv ;activate message handler and ;discard all pending messages 3$: mov #tmwait,r0 ;.twait emt 375 jsr pc,cl.recv ;get message bne 3$ ;loop until no messages rts pc .psect c$data gval: .byte 0,34 ;.gval .word -2 ;job number .page .sbttl cldrvr finalization ; ; VOID cl_finl() ; ; terminates the message handler ; .psect c$code cl.finl:: clr active ;inactive rts pc .page .sbttl Receive Message Routine ; ; (MSGPKT *) cl_recv() ; ; Returns a pointer to a received message ; .psect c$code cl.recv:: clr -(sp) ;default to no message tst quecnt ;data ? beq 1$ ;no - skip mov outpos,r1 ;message index ash #4,r1 ;offset into data queue add #datque,r1 ;buffer address mov #rcvmsg,r0 ;received message mov r0,(sp) mov (r1)+,(r0)+ ;copy message mov (r1)+,(r0)+ mov (r1)+,(r0)+ mov (r1)+,(r0)+ mov (r1)+,(r0)+ mov (r1)+,(r0)+ mov (r1)+,(r0)+ mov (r1)+,(r0)+ mov outpos,r1 ;next message buffer inc r1 bic #^C17,r1 ;ring buffer mov r1,outpos dec quecnt ;one more message has been read 1$: tst active ;message facility active ? bne 2$ ;yes - exit jsr pc,actcmp ;activate 2$: mov (sp)+,r0 ;return a NULL / POINTER rts pc .page .sbttl Completion Processing ; ; Message received completion routine ; ; This proceedure verifies that the incoming ; message is unique. Non unique messages are ; discarded here to improve overall efficiency ; of the messaging services for the client. .psect c$code cmpltn: tst active ;if active process message beq 1$ ;else discard message clr active ;temporarilly inactive jsr pc,unique ;check for unique entry jsr pc,resume ;resume any suspension actcmp=. cmp quecnt,#12. ;space for another message ? bhis 1$ ;no - exit inc active ;activated mov #msgact,r0 ;msgact argument block mov inppos,r1 ash #4,r1 ;offset into data queue add #datque,r1 ;buffer address mov r1,4(r0) ;load argument block emt 375 bcc 1$ ;error ? clr active ;then not activated 1$: rts pc unique: mov inppos,r0 ;any messages in buffer ? mov outpos,r1 cmp r0,r1 beq 4$ ;no - then add this one jsr pc,6$ ;else - prepare to check uniqueness mov r0,r5 ;compute newest elements address ash #4,r5 add #datque,r5 1$: mov r5,r2 ;newest elements address mov r1,r3 ;compute old element address ash #4,r3 add #datque,r3 mov #8.,r4 ;16-bytes 2 at a time 2$: cmp (r2)+,(r3)+ ;compare for unique entry bne 3$ sob r4,2$ br 5$ ;not a unique entry 3$: inc r1 ;next queued element bic #^C17,r1 cmp r1,r0 ;check all queued messages bne 1$ 4$: inc r0 ;next message buffer bic #^C17,r0 ;ring buffer mov r0,inppos inc quecnt ;one more unique message has arrived 5$: rts pc 6$: mov r2,-(sp) ; save registers r2-r5 mov r3,-(sp) mov r4,-(sp) mov r5,-(sp) mov 10(sp),-(sp) ; stack return jsr pc,@(sp)+ ; call return as a coroutine mov (sp)+,r5 ; on return restore r2-r5 mov (sp)+,r4 mov (sp)+,r3 mov (sp)+,r2 tst (sp)+ ; pop used return rts pc ; and exit .psect c$data msgact: .byte 1,106 ;message input with completion .word userid .word datque .word 16. ;maximum message size .word cmpltn ;completion routine active: .word 0 ;message handler active flag inppos: .word 0 ;position for arriving message outpos: .word 0 ;position for next readout quecnt: .word 0 ;number of messages in datque datque: .blkb 256. ;16 - 16-byte message buffers rcvmsg: .blkb 16. ;message read from buffer userid: .ascii /USER00/ ;my message channel .word 0 ;two null characters tljobn::.word 0 ;my job number class: .word 0 ;message class event: .word 0 ;message event data: .word 0 ;message data .page .sbttl Transmit Message Routine ; ; int cl_xmit(class,event,data) ; ; sends a message to TCPIP ; ; ; A potential deadlock may occur if the internal ; message buffer becomes full and the system ; message buffers are all in use. An attempt to ; prevent this is done by limiting the cl_recv ; completion routine to 12. entries before going ; inactive. The cl_xmit routine may then attempt ; to get a message for cl_recv and then immediately ; send its own message. This proceedure will allow ; the sending of a message if a message was pending ; for cl_recv. If this proceedure fails then ; cl_xmit enters a wait loop to try retransmission ; after a suitable delay. ; ; Note: ; TSX-Plus V6.4 message buffer handling malfunctions ; when the maximum system message buffers have been ; used. When the message buffers are emptied the ; xmit message EMT may still report error 2: Maximum ; allowed number of messages already in message queue. ; The only way to recover is to exit all programs ; that have attempted to write to the 'FULL' ; message buffers. ; The workaround is to make sure that MAXMC ; and MAXMRB are larger than the total of all programs ; that may simultaneously use a message channel and ; set MAXMSG to twice MAXMC. .psect c$code cl.xmit:: jsr r5,csv$ ; move data into position mov c$pmtr+0(r5),class ;message class mov c$pmtr+2(r5),event ;message event mov c$pmtr+4(r5),data ;message data 1$: mov #msgxmt,r0 ;send message emt 375 bcc 3$ ;ok - skip tst active ;completion active ? bne 2$ ;yes - just wait cmp quecnt,#16. ;any room for another message ? bhis 2$ ;no - just wait mov #msgrcv,r0 ;msgrcv argument block mov inppos,r1 ash #4,r1 ;offset into data queue add #datque,r1 ;buffer address mov r1,4(r0) ;load argument block emt 375 bcs 2$ ;no message - just wait jsr pc,unique ;check for unique message br 1$ ;and try to send our message again 2$: mov #tmwait,r0 ;.twait emt 375 br 1$ ;retry sending message 3$: clr r0 ;sent rts pc .psect c$data msgxmt: .byte 0,104 ;message output .word dstid ;destination .word userid ;message .word 16. ;message length msgrcv: .byte 0,105 ;message input with continuation .word userid .word datque .word 16. tmwait: .byte 0,24 ;.twait .word 1$ 1$: .word 0,3 ;3-tick wait dstid: .ascii /TCPIP / ;destination message channel .endc .if ne rt$sys ;rt-11 specific ; These message passing routines use the MQ ; message channel facility. ; ; The xmit message channel name is TCPIP. ; ; The receive channel is the logical name ; of the program this is a part of. ; ; The maximum message length supported by these ; routines is 16 bytes. .page .sbttl cldrvr initialization ; ; VOID cl_init(); ; ; Initialize the cldrvr and get the job number ; .psect c$code cl.init:: ; .lookup #lkptcp,#16,#1$ mov #lkptcp,r0 ;message channel emt 375 ; .gtjb #gtjb,#jobarg,#-1 mov #gtjb,r0 ;.gtjb for jobnum and name emt 375 mov jobarg,r0 ;real number inc r0 ;offset job number mov r0,tljobn ;save and return rts pc .psect c$data lkptcp: .byte 16,1 ;.lookup .word 1$ 1$: .rad50 /MQ/ .byte 0,0,0,0,0,0 gtjb: .byte 1,20 ;.gtjb .word jobarg .word -1 .page .sbttl cldrvr finalization ; ; VOID cl_finl() ; ; terminates the message handler ; .psect c$code cl.finl:: clr active ;inactive ;.gval #gval,#276 mov #gval,r0 emt 375 cmp r0,(pc)+ ;check the RT version .byte 5,3 ;The MQ device driver for blos 1$ ;RT V5.3 and below did not ;act exactly like a real device. ;The monitor automatically ;closed the channel upon exit. ;The MQ device driver for ;RT V5.4 and above ;programs like a real device. .abtio #16 ;abort any i/o .close #16 ;close the channel 1$: rts pc .psect c$data gval: .byte 0,34 ;.gval .word 276 ;RT version number .page .sbttl Receive Message Routine ; ; (MSGPKT *) cl_recv() ; ; Returns a pointer to a received message ; .psect c$code cl.recv:: clr -(sp) ;default to no message tst quecnt ;data ? beq 1$ ;no - skip mov outpos,r1 ;message index ash #4,r1 ;offset into data queue add #datque,r1 ;buffer address mov #msg,r0 ;received message mov r0,(sp) mov (r1)+,(r0)+ ;copy message mov (r1)+,(r0)+ mov (r1)+,(r0)+ mov (r1)+,(r0)+ mov (r1)+,(r0)+ mov (r1)+,(r0)+ mov (r1)+,(r0)+ mov (r1)+,(r0)+ mov outpos,r1 ;next message buffer inc r1 bic #^C17,r1 ;ring buffer mov r1,outpos dec quecnt ;one more message has been read 1$: tst active ;message facility active ? bne 2$ ;yes - exit jsr pc,actcmp ;activate completion routine 2$: mov (sp)+,r0 ;return a NULL / POINTER rts pc .page .sbttl Completion Processing ; ; Message received completion routine ; ; This proceedure verifies that the incoming ; message is unique. Non unique messages are ; discarded here to improve overall efficiency ; of the messaging services for the server. .psect c$code cmpltn: tst active ;if active process message beq 7$ ;else discard message clr active ;temporarilly inactive mov r2,-(sp) ;save registers r2-r4 mov r3,-(sp) mov r4,-(sp) mov inppos,r0 ;any messages in buffer ? mov outpos,r1 cmp r0,r1 beq 4$ ;no - then add this one 1$: mov #rcvmsg,r2 ;newest elements address mov r1,r3 ;compute old element address ash #4,r3 add #datque,r3 mov #8.,r4 ;16-bytes 2 at a time 2$: cmp (r2)+,(r3)+ ;compare for unique entry bne 3$ sob r4,2$ br 6$ ;not a unique entry 3$: inc r1 ;next queued element bic #^C17,r1 cmp r1,r0 ;check all queued messages bne 1$ 4$: mov #rcvmsg,r2 ;newest elements address mov r0,r3 ;compute buffer address ash #4,r3 add #datque,r3 mov #8.,r4 5$: mov (r2)+,(r3)+ ;copy message sob r4,5$ inc r0 ;next message buffer bic #^C17,r0 ;ring buffer mov r0,inppos inc quecnt ;one more unique message has arrived 6$: mov (sp)+,r4 ;restore r2-r4 mov (sp)+,r3 mov (sp)+,r2 jsr pc,resume ;resume any suspension actcmp=. cmp quecnt,#16. ;space for another message ? bhis 7$ ;no - exit inc active ;activated ; .readc #msgact,#16,#rcvmsg,#8.,#cmpltn,#0 mov #msgact,r0 ;msgact argument block emt 375 bcc 7$ ;error ? clr active ;then not active 7$: rts pc .psect c$data msgact: .byte 16,10 ;message input with completion .word 0 .word rcvmsg-2 .word 8. .word cmpltn .word 0 ;.read_ word count rcvmsg: .blkb 16. ;input message buffer active: .word 0 ;message handler active flag inppos: .word 0 ;position for arriving message outpos: .word 0 ;position for next readout quecnt: .word 0 ;number of messages in datque datque: .blkb 256. ;16 - 16-byte message buffers msg: .blkb 16. ;message read from buffer jobarg: .blkw 9. ;.gtjb argument block ;includes tcpid: tcpid: .byte 0,0,0,0,0,0 ;my message channel name .word 0 ;two null characters tljobn::.word 0 ;my job number class: .word 0 ;message class event: .word 0 ;message event data: .word 0 ;message data .page .sbttl Transmit Message Routine ; ; int cl_xmit(class,event,data) ; ; sends a message to the 'TCPIP Server' job ; .psect c$code cl.xmit:: jsr r5,csv$ mov #-1,-(sp) ;default to error ; .lookup #lkpsrv,#15,#1$ mov #lkpsrv,r0 ;message channel emt 375 bcs 1$ ;no such job ;move data into position mov c$pmtr+0(r5),class ;message class mov c$pmtr+2(r5),event ;message event mov c$pmtr+4(r5),data ;message data ; .writw #msgxmt,#15 mov #msgxmt,r0 ;send message emt 375 bcs 1$ ;error - skip clr (sp) ;sent 1$: .close #15 ;close channel mov (sp)+,r0 ;status rts pc .psect c$data lkpsrv: .byte 15,1 ;.lookup .word 1$ 1$: .rad50 /MQ/ usrnam: .byte 'T,'C,'P,'I,'P,0 msgxmt: .byte 15,11 ;.writw .word 0 .word tcpid ;outgoing message .word 8. ;16-byte message .word 0 ;.____w .endc .page .sbttl Initializer and Finalizer Code ; The initializer calls cl_init to initialize the ; message handler and get the job number .psect $init .psect $init$ .word cl.init ;initializer routine .psect $init. ; The finalizer calls cl_finl to close the ; message handler. .psect $finl .psect $finl$ .word cl.finl ;finalizer routine .psect $finl. .end