.TITLE FRPOI - FORTRAN "REQUEST AND PASS OFFSPRING INFORMATION" .IDENT /010285/ .ENABL GBL .ENABL LC .NLIST BEX ; ;+ ;***** ; ; RPOI - Provides the FORTRAN entry point to a psuedo "REQUEST- ; AND-PASS-OFFSPRING-INFORMATION" directive for use ; with RSX-11M V3.2/ RSX-11Mplus V1.0 alternate CLI support. ; The format for the FORTRAN call is identical to that ; defined for MV4.1/M+V2.1: ; ; CALL RPOI (tname,[iugc],[iumc],[iparen],[ibuf],[ibfl], ; [isc],[idnam],[iunit],[itask],[ocbad][,ids]) ; ; where: ; tname = Array/variable containing the RAD50 name of the ; task to be requested ; iugc = Integer(byte) group code number for UIC of the ; requested target chain task ; iumc = Integer(byte) member code number for the UIC of the ; requested target chain task ; iparen = Array/variable containing the RAD50 name of ; the parent task (typically defined in the "information" ; buffer returned by GTCMCI subroutine) ; ibuf = Array containing the optional command line to ; queue for the chained task ; ibfl = Integer(byte) containing the length of the optional ; command line in "ibuf". ; isc = Integer(byte) containing a bit mask indicating the ; action to take in chaining to the target task: ; ; Bit Octal Definition ; RP.OEX 200 Force this task to exit on successful ; execution of the RPOI directive ; RP.OAL 001 Pass all of this task's OCB's to the ; requested task (default = 0, pass ; one OCB) ; RP.ONX 002 Pass 1st OCB in this task's OCB queue ; idnam = Integer containing the ASCII device name for ; chained task to use as "TI:" ; iunit = Integer(byte) containing the physical unit # for the ; chained task to use as "TI:" ; itask = Array/variable containing the RAD50 name the ; requested task is to run under ; ocbad = Integer containing the "pool" address of the ; parent OCB (only for CLI's, OCB address is defined ; in the "information" buffer returned by GCTMCI/GCCI$ ; directive) ; ids = Integer to receive the Directive Status Word ; ; NOTE: This routine was defined for use under F4P OTS, and uses ; the TRAP instruction to trap 2 FORTRAN errors: ; #80. = Wrong # of arguments ; #81. = Invalid argument ;***** ; ; Update 3/12/84 -- PRS; Original edit ; Update 1/2/85 -- PRS; Reflect changes in RPOI$ macro, use DIR$G ; to call routine ; ;***** ;- NULL = -1 ; FORTRAN'S NULL ARGUMENT ADDRESS NARG = 12. ; TOTAL # ARGS MARG = NARG-1 ; MIN # ARGS ; .MCALL RPOI$,DIR$G ; .PSECT $IDATA,RW,D,LCL,CON,REL .LIST ME RPOIPB: RPOI$ ; RESERVE RPOI$ PARAMETER BUFFER ; ALSO DEFINES LOCAL OFFSETS INTO PARAMETER BUFFER L.RPOI=.-RPOIPB .PSECT $PCODE,RO,I,LCL,CON,REL RPOI:: ; GLOBAL ENTRY POINT MOV R5,R4 ; COPY FORTRAN ARGUMENT LIST POINTER MOVB (R4)+,R3 ; PICKUP # ARGUMENTS IN CALL LIST CMP R3,#MARG ; HAVE ENOUGH ?? BGE 5$ ; BRANCH IF YES TRAP 80.+128. ; TRAP USING F4P OTS BR 70$ ; AND RETURN TO CALLER 5$: MOV #RPOIPB,R5 ; GET PARAMETER LIST TO SEND TO $RPOI$ INC R4 ; POINT TO START OF ARGUMENTS MOV (R4)+,R0 ; PICKUP NAME OF TASK TO CHAIN TO CMP R0,#NULL ; NULL ARGUMENT ?? BNE 10$ ; BRANCH IF NO, OK TRAP 81.+128. ; TRAP BAD ARG'S USING F4P OTS BR 70$ ; AND RETURN TO CALLER 10$: MOV R5,R1 ; COPY BUFFER POINTER ADD #R.POSD+2,R1 ; STEP TO START OF SPAWN ARGUMENTS MOV #/2,R2 ; SET # WORDS IN PARAMETER BLOCK 12$: CLR (R1)+ ; CLEAR OUT BLOCK SOB R2,12$ ; LOOP TO END MOV (R0)+,R.POTK(R5) ; NOW, SAVE TASK TO REQUEST MOV (R0),R.POTK+2(R5) MOV (R4)+,R0 ; PICKUP ADDRESS OF GROUP UIC CMP R0,#NULL ; NULL ARGUMENT ?? BEQ 20$ ; BRANCH IF YES MOVB (R0),R.POUG(R5) ; ELSE, SAVE IT 20$: MOV (R4)+,R0 ; PICKUP ADDRESS OF MEMBER UIC CMP R0,#NULL ; NULL ARGUMENT ?? BEQ 25$ ; BRANCH IF YES MOVB (R0),R.POUM(R5) ; ELSE, SAVE IT 25$: MOV (R4)+,R0 ; PICKUP ADDRESS OF PARENT TASK NAME CMP R0,#NULL ; NULL ARGUMENT ?? BEQ 30$ ; BRANCH IF YES MOV (R0)+,R.POPT(R5) ; ELSE, SAVE IT MOV (R0),R.POPT+2(R5) 30$: MOV (R4)+,R0 ; PICKUP COMMAND BUFFER ADDRESS CMP R0,#NULL ; NULL ARGUMENT ?? BEQ 35$ ; BRANCH IF YES, IGNORE IT MOV R0,R.POBF(R5) ; ELSE, SAVE IT 35$: MOV (R4)+,R0 ; PICKUP ADDRESS OF BUFFER LENGTH CMP R0,#NULL ; NULL ARGUMENT ?? BEQ 40$ ; BRANCH IF YES MOVB (R0),R.POBL(R5) ; ELSE, SAVE IT 40$: MOV (R4)+,R0 ; PICKUP ADDRESS OF FLAGS BYTE CMP R0,#NULL ; NULL ARGUMENT ?? BEQ 45$ ; BRANCH IF YES MOVB (R0),R.POSC(R5) ; ELSE, SAVE IT 45$: MOV (R4)+,R0 ; PICKUP ADDRESS OF DEVICE NAME CMP R0,#NULL ; NULL ARGUMENT ?? BEQ 50$ ; BRANCH IF YES MOV (R0),R.PODV(R5) ; ELSE, SAVE IT 50$: MOV (R4)+,R0 ; PICKUP ADDRESS OF DEVICE UNIT # CMP R0,#NULL ; NULL ARGUMENT ?? BEQ 55$ ; BRANCH IF YES MOVB (R0),R.POUN(R5) ; ELSE, SAVE IT 55$: MOV (R4)+,R0 ; PICKUP ADDRESS OF RUN-TIME NAME CMP R0,#NULL ; NULL ARGUMENT ?? BEQ 60$ ; BRANCH IF YES MOV (R0),R.POTN(R5) ; ELSE, SAVE IT 60$: MOV (R4)+,R0 ; PICKUP ADDRESS OF OCB ADDRESS CMP R0,#NULL ; NULL ARGUMENT ?? BEQ 65$ ; BRANCH IF YES MOV (R0),R.POOA(R5) ; ELSE, SAVE IT ; 65$: DIR$G R5 ; ISSUE "DIRECTIVE" USING PARAMETER BLOCK @R5 SUB #MARG,R3 ; "IDS" LEFT OUT OF CALL LIST ?? BLE 70$ ; BRANCH IF YES, DONE CMP (R4),#NULL ; NULL ARGUMENT ?? BEQ 70$ ; BRANCH IF YES, DONE MOV @#$DSW,@(R4) ; RETURN DSW IN IDS 70$: ; COMMON EXIT POINT RETURN ; RETURN TO CALLER .END ;RPOI