.TITLE	FLOGHOOK - Restore saved DCL context

;  This program is the second part of the DCL PUSH mod.  It is run via
;  a merge image activation into P0 space while DCL is initializing if
;  DCL is being started in a subprocess.  This image is used to restore
;  the saved user environment into the subprocess context.  This includes
;  such things as enabling ^Y, restoring the previous default directory,
;  restoring process logical names, and restoring CLI symbols.
;  This information is stored in the file FORK.ENV in the default
;  directory in which the subprocess is started.
;
;  This program must be PIC.  It assumes it is run in the context of DCL
;  initialization, i.e. supervisor mode, registers pointing to DCL internal
;  structures, and no image I/O section.
;
;  Written by:
;	Gary L. Grebus
;	Battelle Memorial Institute
;	Columbus, Ohio
;
;  V1.00 - 7-Sep-1981
;	Initial version.


;  System symbol definitions
	$JPIDEF

;  Local symbol definitions

PRC_W_FLAGS = ^X54			; Offset to CLI status flags
PRC_M_NOCTLY = ^X4000			; Mask for "no control-Y" bit
PRC_Q_GLOBAL = ^X28			; Offset to global symbols listhead
PRC_Q_LOCAL = ^X38			; Offset to local symbols listhead
PRC_L_INDFAB = ^X1C			; Offset to indirect FAB
RECORD_BUF_SZ = 512			; Size of buffer for env records
DCL$ALLOCSYMABR = ^X1F5E		; Offset to symbol defining routine

	.PSECT	RWDATA RD,WRT,NOEXE,SHR,LONG

ENV_FAB_ADR:
	.BLKL	1			; Address of FAB for environment file

ENV_RAB:
	$RAB				; RAB for environment file

FILE_NAME:
	.ASCIC	/FORK.ENV/		; File spec for environment file

JPI_LIST:				; Parameter list for $GETJPI
	.WORD	4			; Length of return buffer
	.WORD	JPI$_OWNER		; Code for process owner
JPI_ADR:
	.LONG	0			; Space for return buffer addr
	.LONG	0,0			; end of list

OWNER_PID:
	.BLKL	1			; Buffer for process owner PID

RECORD_BUF:
	.BLKB	RECORD_BUF_SZ		; Buffer for records from env file

	.PSECT	_AAAA RD,NOWRT,EXE,SHR,LONG,PIC,GBL
	.ENTRY	FLOGHOOK,^M<>

;  Register usage:
;	R0-R1 - Scratch
;	R11 - Assumed to point to CLI data area

;  Determine if we are being run from a subprocess
	MOVAL	OWNER_PID,JPI_ADR	; Fill in address in JPI list
	$GETJPI_S	ITMLST=JPI_LIST	; Get our owner's PID
	TSTL	OWNER_PID		; Is it zero?
	BNEQ	5$			; If so, we are a subprocess
	RET				; Else nothing to do

;  Try to open the environment file
5$:	MOVL	PRC_L_INDFAB(R11),R0	; Get address of indirect FAB
	MOVL	R0,ENV_FAB_ADR		; Stash address for later
	CLRW	FAB$W_IFI(R0)		; Clear the FAB
	$FAB_STORE -
		FAC=GET,-
		ALQ=#0,-
		DEQ=#0,-
		FOP=PPF,-
		DNA=#0,-
		DNS=#0,-
		FNA=FILE_NAME+1,-
		FNS=FILE_NAME		; Initialize FAB

	$RAB_STORE -
		RAB=ENV_RAB,-
		FAB=@ENV_FAB_ADR,-
		UBF=RECORD_BUF,-
		USZ=#RECORD_BUF_SZ	; Initialize RAB

	$OPEN	FAB=@ENV_FAB_ADR	; Open the environment file
	BLBS	R0,10$			; Branch if success
	RET

10$:	$CONNECT RAB=ENV_RAB		; Connect record stream
	BLBS	R0,20$			; Branch if success
	BRW	DONE

; Read default directory from environment file and reset it
20$:	$GET	RAB=ENV_RAB		; Get the default directory record
	BLBS	R0,30$			; Branch if success
	BRW	DONE

30$:	PUSHAL	RECORD_BUF		; Build descriptor to def dir string
	MOVZWL	ENV_RAB+RAB$W_RSZ,-
		-(SP)
	MOVL	SP,R1			; Address of descriptor
	CLRQ	-(SP)			; Two dummy parameters
	PUSHL	R1			; And address of new dir string desc
	CALLS	#3,G^SYS$SETDDIR	; Reset dir

;  Set the default file protection value
	$GET	RAB=ENV_RAB		; Get the record
	BLBS	R0,35$			; Branch if success
	BRW	DONE

35$:	PUSHL	#0			; Dummy parameter-no return value
	PUSHAL	RECORD_BUF		; Param 1 - new protection value
	CALLS	#2,G^SYS$SETDFPROT	; Set the protection

;  Read in global symbols and define them
	PUSHAQ	PRC_Q_GLOBAL(R11)	; Param is address of symbol table 
					; listhead
	CALLS	#1,DEF_SYMS

;  Read in local symbols and define them
	PUSHAQ	PRC_Q_LOCAL(R11)	; Param is address of local symbol
					; table listhead
	CALLS	#1,DEF_SYMS

;  Read in logical names to define and define them
40$:	$GET	RAB=ENV_RAB		; Read a record
	BLBS	R0,50$			; Branch if success
	BRW	DONE

50$:	TSTW	ENV_RAB+RAB$W_RSZ	; Did we read zero length record
	BEQL	60$			; Branch if so....end of logicals
	MOVZBL	RECORD_BUF+1,R0		; Get length of logical name
	PUSHAB	RECORD_BUF+2		; Descr for logical name
	PUSHL	R0
	MOVL	SP,R1			; Address of descriptor
	MOVZBL	RECORD_BUF+2[R0],R2	; Get length of equiv name
	PUSHAB	RECORD_BUF+3[R0]	; Descriptor of equiv name
	PUSHL	R2
	MOVL	SP,R2			; Address of descriptor
	$CRELOG_S -
		TBLFLG=#2,-
		LOGNAM=(R1),-
		EQLNAM=(R2),-
		ACMODE=RECORD_BUF	; Create the name
	ADDL2	#16,SP			; Clear descriptors off stack
	BRW	40$			; Loop thru all records

60$:

DONE:
	BICW	#PRC_M_NOCTLY,-
		PRC_W_FLAGS(R11)	; Enable ^Y 
	$CLOSE	FAB=@ENV_FAB_ADR	; Close the file
	RET

	.PAGE
	.SBTTL	DEF_SYMS - Define CLI symbols

;  Routine to read CLI symbol records from the environment file and
;  define the symbols.  Parameter is the address of the listhead of
;  the table in which the symbols are to be defined.  List of symbols
;  is terminated by a zero length record.  The symbol records consist
;  of two counted strings, the symbol name and the value.

	.PSECT	_AAAA RD,NOWRT,EXE,SHR,LONG,GBL,PIC
	.ENTRY	DEF_SYMS,^M<R2,R3,R4,R5,R6>

;  Register usage:
;	R0 - Scratch
;	R1 - R5 are parameters to the DCL routine to define symbols
;	R1 - length of value
;	R2 - Addr of value
;	R3 - Length of name
;	R4 - Address of name
;	R5 - Address of listhead

	ADDL3	G^CTL$AG_CLIMAGE,-
		#DCL$ALLOCSYMABR,-
		R6			; Get address of DCL symbol definer

10$:	$GET	RAB=ENV_RAB		; Read a record
	BLBS	R0,30$			; Branch if success
	RET

30$:	TSTW	ENV_RAB+RAB$W_RSZ	; Did we read zero length record
	BNEQ	40$			; Branch if not
	RET				; All done

40$:	MOVL	@4(AP),R5		; Set listhead parameter (it gets
					; trashed by DCL routine)
	MOVZBL	RECORD_BUF,R3		; Get length of name
	MOVAB	RECORD_BUF+1,R4		; Get address of name
	MOVZBL	RECORD_BUF+1[R3],R1	; Get length of value
	MOVAB	RECORD_BUF+2[R3],R2	; Get address of value

	JSB	(R6)			; Define the symbol
	BRW	10$			; Loop thru all symbols

	.END	FLOGHOOK