.TITLE FEMST -- FORTRAN "EMIT STATUS" FOR RSX-11M .IDENT /010285/ .ENABL GBL .ENABL LC .NLIST BEX ; ;+ ;***** ; ; FEMST - Provides the FORTRAN entry point to a psuedo "EMIT STATUS" ; directive to use under RSX-11M V3.2 (Mplus executive supports ; EMIT STATUS). Primarily provided for support of alternate ; command line interpreters (CLIs) which must maintain ; parent-offspring relationships when processing command lines. ; NOTE: There is no support for "global" emit status to all ; parent tasks; target task name MUST be defined. ; The format for the FORTRAN call is identical to that ; defined for MV4.1: ; ; CALL EMST (tname,status[,ids]) ; ; where: ; tname = Name of task connected to issuing task to ; send "status" to ; status = Integer status value to return to parent task ; 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 ; ;***** ; ; Paul Sorenson ; AEP/Operations Control Systems ; Columbus, OH 43215 ; ;***** ; ; Update 1/3/85 -- PRS; Original edit ; ;***** ;- NULL = -1 ; FORTRAN'S NULL ARGUMENT ADDRESS NARG = 3 ; TOTAL # ARGUMENTS ALLOWED MARG = NARG-1 ; MIN # ARGUMENTS ALLOWED ; .MCALL EMST$,DIR$G ; .PSECT $IDATA,RW,D,LCL,CON,REL EMSTPB: EMST$ ; RESERVE EMST$ PARAMETER BLOCK .PSECT $PCODE,RO,I,LCL,CON,REL EMST:: ; 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 25$ ; AND RETURN TO CALLER 5$: INC R4 ; POINT TO START OF ARGUMENTS MOV (R4)+,R1 ; PICKUP ADDRESS OF PARENT/TARGET TASK NAME CMP R1,#NULL ; NULL ARGUMENT ?? BEQ 17$ ; BRANCH IF YES, ERROR MOV (R1)+,EMSTPB+E.MSTN ; ELSE, SAVE IT MOV (R1),EMSTPB+E.MSTN+2 MOV (R4)+,R1 ; PICKUP ADDRESS OF STATUS CMP R1,#NULL ; NULL ARGUMENT ?? BNE 19$ ; BRANCH IF NO, VALID 17$: TRAP 81.+128. ; TRAP BAD ARG'S USING F4P OTS BR 25$ 19$: MOV (R1),EMSTPB+E.MSST ; SAVE STATUS WORD ; DIR$G #EMSTPB ; EXECUTE "DIRECTIVE" SUB #MARG,R3 ; "IDS" LEFT OUT OF CALL LIST ?? BLE 25$ ; BRANCH IF YES, DONE CMP (R4),#NULL ; NULL ARGUMENT ?? BEQ 25$ ; BRANCH IF YES, DONE MOV @#$DSW,@(R4) ; RETURN DSW IN IDS 25$: ; COMMON EXIT POINT RETURN ; RETURN TO CALLER .END ;EMST