Subj:	RE: DFP, the DCL to Fortran Precompiler.


Thanks for the response.  I do know what you sent (but thanks, anyway).
These structures do not answer *all* of my pointer problems.  I probably
should have sent some code too.  I don't really care if what I get from you
is *supported*, I just want it to work.

Here are 2 programs "PUT_FOREIGN" and a UWSS to perform the P1 write.  Any
propriatary stuff has been removed and names changed.

I am not happy as I have used hard-coded addresses because I do not have all
of the symbol names (yet).  It works (Version 6.1) but there is one problem.
As I mentioned before, this is used prior to activating an image from a
program.  If the initial program is activated with a qualifier (e.g. $ RUN
PROGRAM /NODEBUG), something gets messed up, and the "foreign" data is not
returned properly.  An internal pointer is pointing to the "/NODEBUG",
except that I overwrite that area.  /DEBUG and /NODEBUG are the only
qualifiers allowed when running a program interactively.

Frank

****************************************************************************
PUT_FOREIGN.MAR
*****************************************************************************
	.TITLE	PUT_FOREIGN
;
;	.link		"sys$library:uwss_share.exe" /shareable
	.library	"sys$share:lib.mlb"
;
	.PSECT	$DATA,LONG	PIC,WRT,NOEXE
;
endaddr:	.long	0
zero:		.long	0
cmdlen:		.long	0
forlen:		.long	0
foroff:		.long	0
type:		.long	^xff
;
; =====================================================================
;
	.PSECT	$CODE,LONG	NOWRT,EXE,PIC,SHR
	.entry	put_foreign, ^m<r2,r3,r4,r5,r6,r7,r8>
;
;	r2 = address of ascic string
;	r3 = address of work buffer area
;	r4 = address of verb type byte
;	r4 = address of address of end of foreign data (+ 1)
;	r5 = address of command buffer
;	r6 = address of offset for foreign area
;	r7 = length of new foreign data
;	r8 = address of foreign area in P1 space
;
;
; get foreign data
;
	movl	4(ap),r2	; address of string descriptor
;
; set up pointer to prc base
;
	moval	g^ctl$ag_clidata,r3	; start of cli data area
      					;    r3 = 7FFBE260
	movl	ppd$l_prc(r3),r3	; offset to prc base
      					;    r3 = 7FFBE3E0
;
; set up pointer to work buffer area
;
	movl	prc_l_basewrk(r3),r3	; address of work buffer area
      					;    r3 = 7FF9D198
;
; set "command type"
;
	moval	wrk_b_verbtyp(r3),r4	; address of verb type byte
      					;    r4 = 7FF9D15C
	pushl	#1			; length of area in P1 space
	pushal	type			; value for area in P1 space
	pushl	r4			; address in P1 space
	calls	#3,g^uwss_shr		; put to P1 space
	blbc	r0,end			; if didn't work, quit
;
; establish pointers
;
	moval	wrk_l_expandptr(r3),r4	; address of address of end +1 in r4
      					;    r4 = 7FF9C410
;
; find start of first parameter or qualifier after command
;
	moval	wrk_g_buffer(r3),r5	; address of command buffer
					;    r5 = 7FF9C420
	movl	#^x7FF9C951,r6		; address of offset for foreign area
	movzbl	(r6),foroff		; offset for foreign area
	addl3	foroff,r5,r8		; address of foreign area
;
; address of start of foreign data is in r8
;
	movzwl	(r2),r7			; length of new foreign data in r7
	addl	#4,r2			; address of ascic foreign data in r2
	cmpb	#^A" ",@(r2)		; is first byte a space?
	bneq	20$			; no, skip increment
	addl	#1,(r2)			; point to next byte of foreign stuff
	decl	r7			; subtract 1 from length
;
; move foreign data to P1 area
;
20$:	pushl	r7			; length of area in P1 space
	pushl	(r2)			; value for area in P1 space
	pushl	r8			; address in P1 space 
	calls	#3,g^uwss_shr		; put to P1 space
	blbc	r0,end			; if didn't work, quit
;
; put "end of foreign data" address in p1 area
;
	addl3	r8,r7,endaddr		; starting address plus length
	pushl	#4			; length of area in P1 space
	pushal	endaddr			; value for area in P1 space
	pushl	r4			; address in P1 space
	calls	#3,g^uwss_shr		; put to P1 space
	blbc	r0,end			; if didn't work, quit
;
; put binary zero after end of data
;
	pushl	#1			; length of area in P1 space
	pushal	zero			; value for area in P1 space
	pushl	endaddr			; address in P1 space
	calls	#3,g^uwss_shr		; put to P1 space
	blbc	r0,end			; if didn't work, quit
;
; put length in "foreign data length byte"
;
	movl	r7,forlen		; r7 = length of foreign data
	pushl	#1			; length of area in P1 space
	pushal	forlen			; value for area in P1 space
	pushl	#^x7FF9C950		; address in P1 space
	calls	#3,g^uwss_shr		; put to P1 space
	blbc	r0,end			; if didn't work, quit
;
; put length in "whole command length byte"
;
	addl3	foroff,r7,cmdlen	; foreign offset + foreign len = cmd len
	pushl	#1			; length of area in P1 space
	pushal	cmdlen			; value for area in P1 space
	pushl	#^x7FF9C961		; address in P1 space
	calls	#3,g^uwss_shr		; put to P1 space
;
end:
	ret
	.end

*****************************************************************************
UWSS_SHARE.COM
*****************************************************************************
$ SET NOON
$ ON CONTROL_Y THEN GOTO END
$ SET PROC/PRIV=ALL
$ SET VER
$ GOTO XX_'P1
$XX_:
$ MAC/LIST UWSS_SHARE/OBJ=UWSS_SHARE.OBJ
$ IF .NOT. $STATUS THEN GOTO END
$XX_LINK:
$ LINK/NATIVE_ONLY/NODEBUG/SHARE/NOSYSSHR/SYSEXE/NOTRACE -
      /EXE=UWSS_SHARE SYS$INPUT/OPT
UWSS_SHARE
SYS$LOADABLE_IMAGES:RMSDEF.STB
GSMATCH=LEQUAL,1,1
SYMBOL_VECTOR=(UWSS_SHRK=PROCEDURE,-
               UWSS_SHRK1=PROCEDURE,-
               UWSS_SHRK2=PROCEDURE,-
               UWSS_SHR=PROCEDURE,-
               UWSS_SHR1=PROCEDURE,-
               UWSS_SHR2=PROCEDURE)
$ IF .NOT. $STATUS THEN GOTO END
$XX_COPY:
$ INSTALL REMOVE SYS$LIBRARY:UWSS_SHARE
$ DELETE SYS$LIBRARY:UWSS_SHARE.EXE;*
$ PURGE UWSS_SHARE.*
$ RENAME UWSS_SHARE.* UWSS_SHARE.*;1
$ COPY UWSS_SHARE.EXE SYS$SYSROOT:[SYSCOMMON.SYSLIB]
$XX_INSTALL:
$ INSTALL ADD SYS$LIBRARY:UWSS_SHARE /SHARE/PROT/OPEN/HEAD
$ GOTO END
$XX_AGAIN:
$ INSTALL REMOVE SYS$LIBRARY:UWSS_SHARE
$ INSTALL ADD SYS$LIBRARY:UWSS_SHARE /SHARE/PROT/OPEN/HEAD
$ GOTO END
$XX_REMOVE:
$ INSTALL REMOVE SYS$LIBRARY:UWSS_SHARE
$END:
$ SET NOVER
$ SET PROC/PRIV=(NOALL,TMPM,NETM)
$ EXIT

****************************************************************************
UWSS_SHARE.MAR
****************************************************************************
	.TITLE	UWSS_SHARE
;
;
	.LIBRARY "SYS$LIBRARY:LIB.MLB"	; Macro library for system structure
					;  definitions
;
;	Equated Symbols
;

	$PHDDEF				; Define process header offsets
	$P
	$SSDEF				; Define system status codes
;
	.SBTTL	Privileged Library Vector (PLV)
;
; This vector is used by the image activator to create dispatch routines.
;
;		PLV Format		
;
;   +------------------------------------------+
;   !             Vector Type Code             !   PLV$L_TYPE
;   !             (PLV$C_TYP_CMOD)             !
;   +------------------------------------------+
;   !                Reserved                  !
;   !                                          !
;   +------------------------------------------+
;   !      Count of Kernel Mode Services       !   PLV$L_KERNEL_ROUTINE_COUNT
;   !                                          !
;   +------------------------------------------+
;   !      Count of Kernel Mode Services       !   PLV$L_EXEC_ROUTINE_COUNT
;   !                                          !
;   +------------------------------------------+
;   !	   Address of a list of Entry points   !
;   !         for Kernel Mode Services         !   PLV$PS_KERNEL_ROUTINE_LIST
;   !                                          !
;   +------------------------------------------+
;   !	   Address of a list of Entry points   !
;   !         for Exec Mode Services           !   PLV$PS_EXEC_ROUTINE_LIST
;   !                                          !
;   +------------------------------------------+
;   !      Address of Kernel Mode Rundown      !
;   !         routine                          !   PLV$PS_KERNEL_RUNDOWN_HANDLER
;   !                                          !
;   +------------------------------------------+
;   !      Reserved                            !
;   !                                          !
;   +------------------------------------------+
;   !      Address of Alternative RMS          !
;   !         dispatching Routine              !   PLV$PS_RMS_DISPATCHER
;   !                                          !
;   +------------------------------------------+
;   !      Kernel Routine Flags vector         !   PLV$PS_KERNEL_ROUTINE_FLAGS
;   !                                          !
;   +------------------------------------------+
;   !      Exec Routine Flags vector           !   PLV$PS_EXEC_ROUTINE_FLAGS
;   !                                          !
;   +------------------------------------------+
;
;
;
        .PSECT USER_SERVICES, PAGE, VEC, NOWRT, EXE, PIC, SHR
;
	.LONG	plv$c_typ_cmod		; Set type of vector
	.LONG	0			; Reserved
	.LONG	3                       ; Number of Kernel mode services
	.LONG	3                       ; Number of Exec mode services
	.ADDRESS kernel_vector          ; Kernel routine list
	.ADDRESS exec_vector            ; Exec routine list
	.LONG	0			; Kernel rundown handler
	.LONG	0			; Exec rundown handler
	.LONG	0			; No RMS dispatcher
	.LONG	0			; Kernel routine flags
	.LONG	0			; Exec routine flags
;
;  Transfer Vector and Service Definitions
;
kernel_vector:
	.address	uwss_shrk
	.address	uwss_shrk1
	.address	uwss_shrk2
;
exec_vector:
	.address	uwss_shr
	.address	uwss_shr1
	.address	uwss_shr2
;
; ======================================================================
;
        .PSECT  USER_CODE,QUAD      NOWRT,EXE,PIC
;
	.SBTTL	Unused place holder
uwss_shrk::	.call_entry
	RET
;
	.SBTTL	Unused place holder
uwss_shrk1::	.call_entry
	RET
;
	.SBTTL	Unused place holder
uwss_shrk2::	.call_entry
	RET
;
	.SBTTL	Modify P1 space
;
; Functional Description:
;	This routine modifies P1 space according to passed parameters
;
; Input Parameters:
;	12(AP) - length of P1 space
;	08(AP) - address of new data
;	04(AP) - P1 space starting address (where it goes)
;
;	R4 - PCB address of current process
;
; Output Parameters:
;
;	R0 - Completion Status code
;
uwss_shr::	.call_entry preserve=<R2,R3,R4,R5,R6,R7,R8,R9>
;
	CMPL	#3,(AP)				; 3 parameters passed?
	BNEQ	90$				; no, access violation
;
;
; modify user P1 space
;
10$:	MOVL	12(AP),R5			; length
	MOVL	8(AP),R6			; save address
	MOVL	4(AP),R7			; P1 space starting address
	cmpl	#0,r7				; was a P1 space address passed?
	beql	60$				; no, don't modify P1 space
	movc3	r5,(r6),(r7)			; modify P1 space
;
60$:	MOVL	#SS$_NORMAL,R0		; Set normal completion status
	RET
;
90$:	MOVL	#SS$_ACCVIO,R0		; Indicate access violation
	RET				;
;
	.SBTTL	Unused place holder
uwss_shr1::	.call_entry
	RET
;
	.SBTTL	Unused place holder
uwss_shr2::	.call_entry
	RET
;
	.END
;

