SEARCH FORPRM
	TV	FORHAK	TURN PSECTED FOROTS INTO SHARABLE HISEG, 6(2031)

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


COMMENT \

***** Begin Revision History *****

1471	CKS	21-May-81	Q10-5010
	Add defensive checks to FORHAK

1526	BL	9-Jul-81
	Fix literal delimiters, make F.CODE & F.DATA   'EXTERN'.

1530	JLC	10-Jul-81
	FOROTS becomes FOROT6.

2017	JLC	21-Oct-81
	Refer to F.EES instead of F.DATA (or, incorrectly, Z.ERR) as
	the end of the error PSECT. This change for the 1022 folks.

***** End Revision History *****

\

	FSRCH
	EXTERN	F.CODE,F.DATA,F.EES

FORHAK:!
IF10,<
	MOVEI	T1,F.CODE	;F.CODE AND F.DATA MUST START ON PAGE BOUNDARY
	TRNE	T1,777		;CHECK IT
	  JRST	HAKER1
	MOVEI	T1,F.DATA
	TRNE	T1,777
	  JRST	HAKER1
> ;IF10

;FILL IN HIGH SEG JOBDAT, LINK DOESN'T FOR PSECTS

IF20,<
	MOVE	T1,[.FHSLF,,<F.CODE/1000>] ;WRITE-ENABLE THE PAGE
	RPACS%
	MOVEM	T2,PACS
	TLO	T2,(PA%CPY)
	SPACS%
>
	HRRZ	T1,.JBFF	;HIGH SEG BREAK, RELATIVE TO ORIGIN
	SUBI	T1,F.HSO##
	HRLZM	T1,F.HRN##
IF10,<	HRLZM	T1,.JBHRL##  >	;MONITOR COPIES .JBHRN FROM .JBHRL

	MOVE	T1,.JBSYM	;HIGH SEG SYMBOLS
	MOVEM	T1,F.HSM##
IF20,<
	MOVE	T1,[.FHSLF,,<F.CODE/1000>] ;PUT OLD PAGE ACCESS BACK
	MOVE	T2,PACS
	SPACS%

	MOVEI	T1,.FHSLF	;SET ENTRY VECTOR
	MOVE	T2,[3,,%EVEC##]
	SEVEC%

	MOVX	T1,GJ%SHT+GJ%FOU
	HRROI	T2,[ASCIZ /DSK:FOROT6.EXE/]
	GTJFN%
	  HALT
	MOVEM	T1,HAKJFN	;SAVE JFN

	HRROI	T1,HAKBUF	;MESSAGE BUFFER
	MOVE	T2,HAKJFN	;JFN TO TYPE
	MOVE	T3,[BYTE (3)2,2,1,1,1(21)1]
	JFNS%
	HRROI	T2,[ASCIZ / written
/]
	SOUT%

	MOVSI	T1,.FHSLF	;WRITE .EXE FILE WITH JUST FOROTS
	HRR	T1,HAKJFN

PAGE==F.CODE/1000
LEN==<F.EES-F.CODE##>/1000

	MOVE	T2,[-LEN,,PAGE+SS%UCA+SS%CPY+SS%RD+SS%WR+SS%EXE]
	SETZ	T3,
	SSAVE%

	HRROI	T1,HAKBUF	;TYPE MESSAGE
	PSOUT%

	HALTF%
	JRST	.-1

HAKJFN:! BLOCK	1
HAKBUF:! BLOCK	20
PACS:!	 BLOCK	1
>
IF10,<
;THIS CODE DEPENDS ON PSECTS BEING LOADED IN ORDER:
;F.CODE, THEN F.ERR (WITH SYMBOL TABLE), THEN F.DATA
;THE HIGH SEGMENT PART OF THAT IS F.CODE THROUGH F.DATA-1

	MOVE	T1,[.PAGCH,,[3	;CREATE HIGH SEG
			EXP <F.EES-F.HSO>/1000    ;LENGTH, PAGES
			EXP F.HSO/1000		     ;START PAGE
			EXP F.HSO/1000]]	     ;DEST PAGE
	PAGE.	T1,		;MAKE F.CODE THRU Z.ERR INTO HIGH SEG
	  JRST	HAKERR		;CAN'T

	HLLZS	.JBSA		;CLEAR START ADDRESS

	OUTSTR	[ASCIZ /Ready to ssave
/]
	EXIT	1,		;QUIT
	JRST	.-1


HAKERR:!
	OUTSTR	[ASCIZ /?Can't create high segment
[Type .E 1 for PAGE. error code]
/]
	EXIT	1,
	JRST	.-1

HAKER1:!
	OUTSTR	[ASCIZ \?PSECTS F.CODE and F.DATA must start on page boundary
 Fix /SET switches in LINK command file and relink.
\]
	EXIT	1,
	JRST	.-1

> ;IF10

	END	FORHAK