; UPD ID= 3513 on 5/5/81 at 8:59 AM by NIXON                            
TITLE	CON012 FOR LIBOL
SUBTTL	STARTUP CODE FOR NON-REENTRANT COBOL PROGRAMS.	/ACK/DMN



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976, 1981 BY DIGITAL EQUIPMENT CORPORATION


COMMENT	\

	THIS ROUTINE IS CALLED BY ALL NON-REENTRANT COBOL PROGRAMS
BEFORE THEY DO ANYTHING ELSE.  IT SELECTS THE APPROPRIATE OBJECT
TIME SYSTEM AND RETURNS.

	IT ALSO SAVE ACCUMULATORS FROM RUN UUO FOR OVERLAYS AND SEGMENTATION.

	THIS ROUTINE IS ALSO CALLED BY RERUN TO REPLACE RERUN WITH
THE APPROPRIATE LIBOL AND THEN TRANSFER CONTROL TO LIBOL.

\

;***** REVISION HISTORY *****
;
;  DATE		WHO	COMMENTS
;
; 9-NOV-78	DMN	[453] MOVE .JBHRL SETUP FROM CBLIO
;15-JAN-76	ACK	CREATION
;*****


ENTRY	CN.12
CN.12:			;ENTRY POINT TO LOAD NON-REENTRANT VERSION
INTERN	COBST.		;ENTRY POINT THAT LIBOL USES (MUST NOT BE ENTRY)

SALL
SEARCH	INTERM,COMUNI
IFN TOPS20,<SEARCH	MONSYM,MACSYM>
IFE TOPS20,<SEARCH	UUOSYM,MACTEN>



;ACCUMULATOR DEFINITIONS:

	; T1-T4 DEFINITIONS MUST BE FOR AC 1-4 FOR TOPS20 JSYS ARGS

	T1==1
	T2==2
	T3==3
	T4==4
	JAC==16
	PP==17

COBST.:	JRST	MPRTNS			;MAIN PROGRAM ENTRY ADDRESS
					; (VIA JSP JAC,COBST.)
	JRST	RRRTNS			;RERUN ENTRY ADDRESS (VIA
					; JRST COBST.+1)
IFN TOPS20,<
	POINT	7,SAVSTR		; COBST.+2
					; POINTER TO STRING FOR SAVE JFN
>

MPRTNS:
IFE TOPS20,<
	TLNE	.SGDEV,700000		;IF NOT GARBAGE IN 11
	MOVEM	.SGDEV,RN.DEV##		; SAVE RUN DEVICE
	MOVEM	.SGNAM,RN.NAM##		;SAVE RUN NAME
	SKIPE	.SGDEV			;IF THERE WAS A DEVICE
	MOVEM	.SGPPN,RN.PPN##		; SAVE THE PPN
>

	MOVEM	17,SAVACS+17		;SAVE THE AC'S.
	HRRZI	17,SAVACS
	BLT	17,SAVACS+16
IFN TOPS20,<
	MOVE	1,[.FHSLF,,400]		;PURE PAGE IN THIS FORK
	RPACS%				;READ ACCESSABILITY
	  ERJMP	MPRTNH
	JUMPN	2,MPRTNP		;OK
	HRR	1,1			;NO HIGH SEG TRY PAGE 1
	RPACS%
	  ERJMP	MPRTNH			;GIVE UP
MPRTNP:	TXNE	2,PA%PRV		;PRIVATE?
	JRST	MPRTNH			;TOO BAD
	RMAP%				;JFN FROM WHENCE WE CAME
	  ERJMP	MPRTNH
	HLRZ	2,1			;JFN
	MOVE	1,COBST.+2		;WHERE TO STORE IT
	MOVX	3,JS%DEV!JS%DIR!JS%NAM!JS%TYP!JS%GEN!JS%PAF
	JFNS%
	  ERJMP	MPRTNH
>
IFE TOPS20,<
	JUMPE	.SGDEV,MPRTNH		;USER DID A LOAD ONLY
	HRROI	T1,.GTRDV
	GETTAB	T1,			;GET DEVICE
	  JRST	MPRTNH			;PRE 6.03
	JUMPE	T1,MPRTNH		;NOT IMPLEMENTED
	MOVEM	T1,RN.DEV		;SAVE ACTUAL DEVICE
	HRROI	T1,.GTRDI
	GETTAB	T1,			;GET DIRECTORY
	  JRST	MPRTNH
	MOVEM	T1,RN.PPN		;SAVE ACTUAL PPN
	HRROI	T1,.GTRS0
	GETTAB	T1,			;GET SFD #1
	  JRST	MPRTNH			;PRE 7.01
	JUMPE	T1,MPRTNH		;NO SFD
	MOVEM	T1,RN.PTH+.PTSFD	;SAVE SFD
	MOVEI	T1,RN.PTH		;GET POINTER
	EXCH	T1,RN.PPN		;SWAP WITH PPN
	MOVEM	T1,RN.PTH+.PTPPN	;SAVE PPN
	HRROI	T1,.GTRS1
	GETTAB	T1,			;NEXT SFD
	  JRST	MPRTNH
	MOVEM	T1,RN.PTH+.PTSFD+1
	JUMPE	T1,MPRTNH		;ALL DONE
	HRROI	T1,.GTRS2
	GETTAB	T1,			;NEXT SFD
	  JRST	MPRTNH
	MOVEM	T1,RN.PTH+.PTSFD+2
	JUMPE	T1,MPRTNH		;ALL DONE
	HRROI	T1,.GTRS3
	GETTAB	T1,			;NEXT SFD
	  JRST	MPRTNH
	MOVEM	T1,RN.PTH+.PTSFD+3
	JUMPE	T1,MPRTNH		;ALL DONE
	HRROI	T1,.GTRS4
	GETTAB	T1,			;NEXT SFD
	  JRST	MPRTNH
	MOVEM	T1,RN.PTH+.PTSFD+4
	SETZM	RN.PTH+.PTMAX-1		;TERMINATE WITH ZERO
>

MPRTNH:
IFE TOPS20,<
	HRLZI	T1,1			;THROW AWAY THE HIGH SEGMENT.
	CORE	T1,
	  JFCL				;DON'T CARE IF IT FAILS.

	HRRZI	T1,OTSES		;GETSEG THE APPROPRIATE OTS.
	GETSEG	T1,
	  HALT	MPRTNL			;WE CARE IF THIS FAILS.

>;END OF IFE TOPS20.

IFN TOPS20,<
	MOVX	T1,RF%LNG!.FHSLF	;LONG FORM FOR THIS PROCESS
	MOVEI	T2,RFSBLK		;ARG BLOCK
	SETZM	RFSBLK+.RFSFL		;MAKE SURE ITS CLEAR INCASE REL 3
	RFSTS%				;GET STATUS
	  ERJMP	RFSER			;ASSUME NOT EXECUTE-ONLY
IFGE RF%EXO,<PRINTX ?ERROR - RF%EXO is not the sign bit>	;INCASE IT CHANGES
	SKIPGE	RFSBLK+.RFSFL		;RF%EXO IS SIGN BIT
	SKIPA	T1,[GJ%OLD!GJ%SHT!GJ%PHY]	;PHYSICAL ONLY IF EXECUTE-ONLY
RFSER:	MOVX	T1,GJ%OLD!GJ%SHT	;DO A SHORT GTJFN.
	HRROI	T2,OTSES
	GTJFN%
	  JRST	MPRTNL			;COMPLAIN IF WE CAN'T FIND THE OTS.

	HRLI	T1,.FHSLF		;THIS PROCESS
	TRO	T1,GT%ADR		;CHECK ADDRESS LIMITS
	MOVE	T2,[400,,677]		;ALL OF HIGH SEGMENT
	GET%				;GET THE OTS.
	MOVE	T1,[677777-HI.ORG,,677777]	;[543] GET FAKE LENGTH,,HIGHEST LOC
	SKIPN	.JBHRL##		;[543] NOT SETUP IF /U
	MOVEM	T1,.JBHRL		;[543] SO JUST FAKE IT FOR OVERLAYS

>;END OF IFN TOPS20.

	HRLZI	17,SAVACS		;RESTORE THE AC'S.
	BLT	17,17
	JRST	(JAC)			;RETURN.
MPRTNL:
IFE TOPS20,<
 IFN ANS68,<
	OUTSTR	[ASCIZ	/
?GETSEG of SYS:LIBO12.EXE failed.
/]
 >
 IFN ANS74,<
	OUTSTR	[ASCIZ	/
?GETSEG of SYS:C74O12.EXE failed.
/]
 >
	HALT	MPRTNH
>;END OF IFE TOPS20.

IFN TOPS20,<
	HRROI	T1,[ASCIZ	/
?/]
	PSOUT%
	HRROI	T1,[ASCIZ	/Execute-only /]
	SKIPGE	RFSBLK+.RFSFL		;EXECUTE-ONLY?
	PSOUT%				;YES
	HRROI	T1,[ASCIZ	/GTJFN failed for /]
	PSOUT%
	HRROI	T1,OTSES
	PSOUT%
	HRROI	T1,[ASCIZ	/.
/]
	PSOUT%
	HALTF%
	JRST	MPRTNH			;IN CASE HE TRIES TO RESUME.
>	;END OF IFN TOPS20.
RRRTNS:	JSP	JAC,	MPRTNS		;GO GET LIBOL.

; RESTORE THE AC'S THAT LIBOL HAD SAVED WHEN IT MADE THE CHECKPOINT FILE.

	..I==0
REPEAT	17,<
	POP	PP,	..I
	..I==..I+1>

	POPJ	PP,			;ANSWER LIBOL'S PUSHJ PP,RRDMP.
SUBTTL	DATA.

SAVACS:	BLOCK	20		;PLACE TO SAVE THE AC'S.

IFN TOPS20,<
SAVSTR:	BLOCK	20		;PLACE TO SAVE DEV:<DIR>NAME OF SAVE FILE
RFSBLK:	EXP	.RFSFL+1	;ARG BLOCK FOR LONG FORM RFSTS% JSYS
	BLOCK	.RFSFL		;SPACE FOR RETURNED ARGS
>
IFE TOPS20,<
RN.PTH:	BLOCK	.PTMAX		;FULL PATH SPECIFICATION OF SAVE FILE
>

OTSES:				;THE OTSES.
IFE TOPS20,<
	SIXBIT	/SYS/
 IFN ANS68,<
	SIXBIT	/LIBO12/
 >
 IFN ANS74,<
	SIXBIT	/C74O12/
 >
	Z
	Z
	Z
	Z
>;END OF IFE TOPS20.

IFN TOPS20,<
 IFN ANS68,<
	ASCIZ	/SYS:LIBO12.EXE/
 >
 IFN ANS74,<
	ASCIZ	/SYS:C74O12.EXE/
 >

>;END OF IFN TOPS20.

	PRGEND
TITLE	COR012
SUBTTL	STARTUP CODE FOR REENTRANT COBOL PROGRAMS.	/ACK/DMN

;COPYRIGHT 1976, 1981	DIGITAL EQUIPMENT CORP., MAYNARD MA.


COMMENT	\

	THIS ROUTINE IS CALLED BY ALL REENTRANT COBOL PROGRAMS
BEFORE THEY DO ANYTHING ELSE.  CURRENTLY IT DOESN'T DO ANYTHING
BUT IT IS CONSISTANT WITH NON-REENTRANT PROGRAMS AND DOESN'T COST
ENOUGH TO WORRY ABOUT.

	IT SAVE ACCUMULATORS FROM RUN UUO FOR OVERLAYS AND SEGMENTATION.

	THE MAIN PURPOSE OF THIS ROUTINE IS TO REPLACE RERUN BY
THE COBOL PROGRAM'S HIGH SEGMENT WHEN RESTARTING FROM A RERUN
DUMP.

\


;***** REVISION HISTORY *****
;
;  DATE		WHO	COMMENTS
;
;15-JAN-76	ACK	CREATION
;*****


ENTRY	CR.12
CR.12:			;ENTRY POINT TO LOAD EENTRANT VERSION
INTERN	COBST.		;ENTRY POINT THAT LIBOL USES (MUST NOT BE ENTRY)
INTERN	LIDSP.		;** INCASE RMS OR SOMEONE ELSE HAS MADE
			; AN EXTERNAL REFERENCE TO THIS..
LIDSP.==0		;DEFINE IT

SALL
SEARCH	INTERM
IFN TOPS20,<SEARCH	MONSYM,MACSYM>
IFE TOPS20,<SEARCH	UUOSYM,MACTEN>


;ACCUMULATOR DEFINITIONS:

	; T1-T4 DEFINITIONS MUST BE FOR AC 1-4 FOR TOPS20 JSYS ARGS

	T1==1
	T2==2
	T3==3
	T4==4

	JAC==16
	PP==17

COBST.:	JRST	MPRTNS			;MAIN PROGRAM ENTRY ADDRESS
					; (VIA JSP JAC,COBST.)
	JRST	RRRTNS			;RERUN ENTRY ADDRESS (VIA
					; JRST COBST.+1)
IFN TOPS20,<
	POINT	7,SAVSTR		; COBST.+2
					; POINTER TO STRING FOR SAVE JFN
>

;HERE TO SAVE INITIAL ACCS FOR OVERLAYS AND SEGMENTATION

MPRTNS:	SETOM	OVFLO.##		;[12B] IN V13, THIS WILL BE "SLRSW."
IFE TOPS20,<
	TLNE	.SGDEV,700000		;IF NOT GARBAGE IN 11
	MOVEM	.SGDEV,RN.DEV##		; SAVE RUN DEVICE
	MOVEM	.SGNAM,RN.NAM##		;SAVE RUN NAME
	JUMPE	.SGDEV,(JAC)		;USER DID A LOAD ONLY
	MOVEM	.SGPPN,RN.PPN##		;IF THERE WAS A DEVICE SAVE THE PPN
>

	MOVEM	17,SAVACS+17		;SAVE THE AC'S.
	HRRZI	17,SAVACS
	BLT	17,SAVACS+16
IFN TOPS20,<
	MOVE	1,[.FHSLF,,1]		;PURE PAGE IN THIS FORK
	RPACS%				;READ ACCESSABILITY
	  ERJMP	MPRTNH			;GIVE UP
	TXNE	2,PA%PRV		;PRIVATE?
	JRST	MPRTNH			;TOO BAD
	RMAP%				;JFN FROM WHENCE WE CAME
	  ERJMP	MPRTNH
	HLRZ	2,1			;JFN
	MOVE	1,COBST.+2		;WHERE TO STORE IT
	MOVX	3,JS%DEV!JS%DIR!JS%NAM!JS%TYP!JS%GEN!JS%PAF
	JFNS%
	  ERJMP	MPRTNH
>
IFE TOPS20,<
	HRROI	T1,.GTRDV
	GETTAB	T1,			;GET DEVICE
	  JRST	MPRTNH			;PRE 6.03
	JUMPE	T1,MPRTNH		;NOT IMPLEMENTED
	MOVEM	T1,RN.DEV		;SAVE ACTUAL DEVICE
	HRROI	T1,.GTRDI
	GETTAB	T1,			;GET DIRECTORY
	  JRST	MPRTNH
	MOVEM	T1,RN.PPN		;SAVE ACTUAL PPN
	HRROI	T1,.GTRS0
	GETTAB	T1,			;GET SFD #1
	  JRST	MPRTNH			;PRE 7.01
	JUMPE	T1,MPRTNH		;NO SFD
	MOVEM	T1,RN.PTH+.PTSFD	;SAVE SFD
	MOVEI	T1,RN.PTH		;GET POINTER
	EXCH	T1,RN.PPN		;SWAP WITH PPN
	MOVEM	T1,RN.PTH+.PTPPN	;SAVE PPN
	HRROI	T1,.GTRS1
	GETTAB	T1,			;NEXT SFD
	  JRST	MPRTNH
	MOVEM	T1,RN.PTH+.PTSFD+1
	JUMPE	T1,MPRTNH		;ALL DONE
	HRROI	T1,.GTRS2
	GETTAB	T1,			;NEXT SFD
	  JRST	MPRTNH
	MOVEM	T1,RN.PTH+.PTSFD+2
	JUMPE	T1,MPRTNH		;ALL DONE
	HRROI	T1,.GTRS3
	GETTAB	T1,			;NEXT SFD
	  JRST	MPRTNH
	MOVEM	T1,RN.PTH+.PTSFD+3
	JUMPE	T1,MPRTNH		;ALL DONE
	HRROI	T1,.GTRS4
	GETTAB	T1,			;NEXT SFD
	  JRST	MPRTNH
	MOVEM	T1,RN.PTH+.PTSFD+4
	SETZM	RN.PTH+.PTMAX-1		;TERMINATE WITH ZERO
>

MPRTNH:
	HRLZI	17,SAVACS		;RESTORE THE AC'S.
	BLT	17,17
	JRST	(JAC)			;RETURN.
;COME HERE WITH EITHER THE ADDRESS OF A GETSEG ARG BLOCK IN T1 (TOPS10)
; OR A BYT PTR TO THE JFN STRING IN T4 (TOPS20)

RRRTNS:	MOVEM	PP,SAVACS		;SAVE THE PUSH DOWN POINTER.
RRRTNH:
IFE TOPS20,<
	GETSEG	T1,			;GETSEG THE HIGH SEGMENT.
	  HALT	RRRTNL			;COULDN'T, GO COMPLAIN.
>;END OF IFE TOPS20.

IFN TOPS20,<
	MOVE	T2,T4			; GET BYT PTR OF HIGH SEG JFN STRING
	HRLZI	T1,(GJ%OLD+GJ%SHT)	; INDICATE SHORT GTJFN OF OLD FILE
	GTJFN%				; GET THE HIGH SEG JFN
	 ERJMP	RRRTNL			; ERROR CAN'T GET THE JFN 

	HRLI	T1,.FHSLF		;THIS PROCESS
	TXO	T1,GT%ADR		;CHECK ADDRESS LIMITS
	MOVE	T2,[600,,677]		;REST OF HIGH SEGMENT
	GET%				;GET THE HIGH SEGMENT

>;END OF IFE TOPS20.
	MOVE	PP,SAVACS		;RESTORE THE PUSH DOWN POINTER.

;RESTORE THE AC'S THAT LIBOL HAD SAVED WHEN IT MADE THE CHECKPOINT FILE.

	..I==0
REPEAT 17,<
	POP	PP,..I
	..I==..I+1>

	POPJ	PP,			;ANSWER LIBOL'S PUSHJ PP,RRDUMP.

RRRTNL:
IFN TOPS20,<
	HRROI	T1,[ASCIZ	/
?Can't GET the high segment.
/]
	PSOUT%			; PRINT MESSAGE
	HALTF%
	JRST	RRRTNH		; RESTART
>; END IFN TOPS20
IFE TOPS20,<
	OUTSTR	[ASCIZ	/
?Can't GETSEG the high segment.
/]
	HALT	RRRTNH
>;END OF IFE TOPS20.

SAVACS:	BLOCK	20		;PLACE TO SAVE THE AC'S.
IFN TOPS20,<
SAVSTR:	BLOCK	20		;PLACE TO SAVE DEV:<DIR>NAME OF SAVE FILE
>
IFE TOPS20,<
RN.PTH:	BLOCK	.PTMAX		;FULL PATH SPECIFICATION OF SAVE FILE
>

	END