.TITLE GTCMCI - FORTRAN "GET COMMAND FOR COMMAND INTERPRETER" .IDENT /010285/ .ENABL GBL .ENABL LC .NLIST BEX ; ;+ ;***** ; ; GTCMCI - Provides the FORTRAN entry point to a psuedo ; "GET-COMMAND-FOR-COMMAND-INTERPRETER" directive to 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 GTCMCI (icbf,icbfl,[iibuf],[iibfl],[iaddr],[incp][,ids]) ; ; where: ; icbf = Name of byte array to receive command ; icbfl = Integer containing the size of icbf array in bytes ; iibuf = Name of an integer array to receive the optional ; information buffer ; iibfl = Integer containing the length of the optional ; information buffer. If you specify a length ; shorter than the information buffer, as much ; information as will fit in the length specified ; is returned ; iaddr = Integer that contains the address in pool of the ; command desired. This address was obtained by ; a previous call to GTCMCI with GC.CND specified. ; incp = Integer containing a bit mask indicating the ; action to take if there is no command queued: ; ; Bit Octal Definition ; GC.CCS 000 Return with carry set (default) ; GC.CEX 001 Force CLI to exit instead of returning ; GC.CST 002 Force CLI to stop instead of returning ; GC.CND 200 Copy command into "icbf" but don't ; dequeue it from list ; ; 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/3/84 -- PRS; Original edit ; Update 1/2/85 -- PRS; Reflect change in GCCI$ macro, use "DIR$G" ; to call routine ; ;***** ;- NULL = -1 ; FORTRAN'S NULL ARGUMENT ADDRESS NARG = 7. ; TOTAL # ARGS MARG = NARG-1 ; MIN # ARGS ; .MCALL GCCI$,DIR$G ; .PSECT $IDATA,RW,D,LCL,CON,REL GCCIPB: GCCI$ ; RESERVE GCCI$ PARAMETER BUFFER ; ALSO DEFINES LOCAL OFFSETS INTO PARAMETER BUFFER .PSECT $PCODE,RO,I,LCL,CON,REL GTCMCI:: ; 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 45$ ; AND RETURN TO CALLER 5$: MOV #GCCIPB,R5 ; GET PARAMETER LIST TO SEND TO $GCCI$ CLR G.CCIL(R5) ; DEFINE SOME DEFAULTS CLR G.CCAD(R5) MOV #GC.CCS,G.CCNC(R5) INC R4 ; POINT TO START OF ARGUMENTS MOV (R4)+,R1 ; PICKUP COMMAND BUFFER ADDRESS CMP R1,#NULL ; NULL ARGUMENT ?? BEQ 17$ ; BRANCH IF YES, ERROR MOV R1,G.CCBA(R5) ; ELSE, SAVE IT MOV (R4)+,R1 ; PICKUP COMMAND BUFFER LENGTH ADDRESS CMP R1,#NULL ; NULL ARGUMENT ?? BNE 19$ ; BRANCH IF NO, VALID 17$: TRAP 81.+128. ; TRAP BAD ARG'S USING F4P OTS BR 45$ 19$: MOV (R1),G.CCBL(R5) ; SAVE BUFFER LENGTH ; ; REMAINING ARGUMENTS MAY BE NULL ; MOV (R4)+,R1 ; PICKUP INFO BUFFER ADDRESS CMP R1,#NULL ; NULL ARGUMENT ?? BNE 24$ ; BRANCH IF NO CLR R1 ; RESET ADDRESS TO 0 24$: MOV R1,G.CCIA(R5) ; SAVE INFO BUFFER ADDRESS MOV (R4)+,R1 ; PICKUP INFO BUFFER LENGTH ADDRESS CMP R1,#NULL ; NULL ARGUMENT ?? BEQ 29$ ; BRANCH IF YES MOV (R1),G.CCIL(R5) ; SAVE INFO BUFFER LENGTH 29$: MOV (R4)+,R1 ; PICKUP ADDRESS OF COMMAND'S POOL ADDRESS CMP R1,#NULL ; NULL ARGUMENT ?? BEQ 33$ ; BRANCH IF YES MOV (R1),G.CCAD(R5) ; SAVE COMMAND'S POOL ADDRESS 33$: MOV (R4)+,R1 ; PICKUP FLAGS ADDRESS CMP R1,#NULL ; NULL ARGUMENT ?? BEQ 37$ ; BRANCH IF YES MOV (R1),G.CCNC(R5) ; SAVE FLAGS WORD 37$: DIR$G R5 ; EXECUTE "DIRECTIVE" USING PARAMETER BLOCK @R5 SUB #MARG,R3 ; "IDS" LEFT OUT OF CALL LIST ?? BLE 45$ ; BRANCH IF YES, DONE CMP (R4),#NULL ; NULL ARGUMENT ?? BEQ 45$ ; BRANCH IF YES, DONE MOV @#$DSW,@(R4) ; RETURN DSW IN IDS 45$: ; COMMON EXIT POINT RETURN ; RETURN TO CALLER .END ;GTCMCI