.title sends - PL/I callable send request .ident -010000- ; ; Copyright 1981. Duke University. ; ;+ ; Abstract: SENDS ; ; This module will send a string to a receiving process ; under VAX/VMS. It is intended to mimic the IAS send ; directives. ; ; Calling sequence: ; ; = sends (tsknam, ti, data, [pri], [efn]); ; ; Returns: Fixed binary (15,0) ; ; Directive status from send. ; ; Arguments: ; ; tsknam character (6) [varying] ; The name of the task to send the data to. Under ; VAX/VMS, this is interpreted as a process name. ; ; ti fixed binary (15,0) ; The TI identifier for the target process. Under ; VAX/VMS, this is ignored. ; ; data character (*) [varying] ; The data to be sent. ; ; pri fixed binary (15,0) ; The priority of the request. Under VAX/VMS, this is ; ignored. ; ; efn fixed binary (15,0) ; The event flag to set on receipt of the data block. ; Under VAX/VMS, this is ignored. ; ; Subroutines: ; ; ilnar$ - Report illegal number of arguments. ; savrg$ - Save registers ; ; Nonstandard features: ; ; 1. Written in Macro-11 ; 2. Uses the undocumented VMS "elephant" directive. ; ; Written: 07-Apr-1981, -1.0.0-, Bruce C. Wright ; Modified: ; Verified: ;- ; ; Macro calls ; .mcall dir$ ; .psect $sends,rw,d ; ; Static Read/write section ; exfc: .byte 145.,8. ; Directive code for elephant directive .word 4 ; Subfunction code - call native image .word secnam ; Section name to call .word seclen ; Length of section name ; ; Arguments to send. ; func: .word 0 ; Function code buffer: .word 0 ; Address of buffer buflen: .word 0 ; Length of buffer mbxbuf: .word 0 ; Address of mailbox name mbxlen: .word 0 ; Length of mailbox name iost: .word 0,0,0,0 ; VMS I/O status block ; ; Global section name ; .psect $merli,ro,d,ovr secnam: .ascii /_DBA0:[PLIUTL]NATVMODE.EXE/ seclen = .-secnam ; ; Parameter definitions ; nargs = 16 ; Number of arguments tsknam = nargs+2 ; Task name (input) ti = tsknam+2 ; TI address (ignored) data = ti+2 ; Send data (input) pri = data+2 ; Priority (ignored) efn = pri+2 ; Event flag (ignored) rtn = efn+2 ; Return code (output) ; ; Executable code ; .psect merlin,rw,i sends:: jsr r0,savrg$ ; Save registers 0 - 3 mov #3,r3 ; Show ordinary send. ; ; Send data code ; cmp nargs(sp),#6 ; Right number of arguments? bhi 5$ ; J if too many. cmp nargs(sp),#4 ; Too few? bhis 10$ ; J if ok. 5$: jsr r5,ilnar$ ; Report illegal number of arguments. 10$: mov data(sp),r0 ; Pick up string dope vector. mov 4(r0),r1 ; Pick up address of string. mov (r0),r2 ; Pick up length of string. bpl 20$ ; J if fixed-length string. mov (r1)+,r2 ; Pick up actual string length. 20$: bic #140000,r2 ; Remove garbage bits from length. mov r3,func ; Set send function code. mov r2,buflen ; Set buffer length. mov r1,buffer ; Point to buffer from directive. mov tsknam(sp),r0 ; Get task name descriptor. mov 4(r0),r1 ; Pick up address of string. mov (r0),r2 ; Get length of name. bpl 30$ ; J if fixed-length string. mov (r1)+,r2 ; Pick up length from string. 30$: bic #140000,r2 ; Clean garbage bits from r2. mov r1,mbxbuf ; Set mailbox buffer descriptor. mov r2,mbxlen ; ... dir$ #exfc ; Execute extended function. mov nargs(sp),r0 ; Pick up number of arguments. asl r0 ; Get word offset. add sp,r0 ; Absolutise ... mov iost,@nargs(r0) ; ... And return the return code. rts pc ; And return to the caller. .end