.MCALL	.MODULE
.MODULE	LIBR,VERSION=12,COMMENT=<CREATE LIBR PASS 2> IDENT=NO,MODNAME=LIBR3,GLOBAL=.LIBR3

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  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 except for  use  on  such
; system and to one who agrees to these license  terms.  Title
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
.SBTTL	OBJECT LIBRARY CREATION PASS 2
.ENABL	GBL

; CER,MAS,DBB

.IIF NDF EIS$	EIS$=0	;SAY EIS NOT AVAILABLE

; EDIT HISTORY:

; FIX BLOCK BOUNDARY PROBLEM ON EPT					;MAS05
; ADD /X SWITCH (DUP. GBL. SYMBOLS IN EPT)				;MAS06
; ADD .ENTER AND .CLOSE PROTECTION ERROR MESSAGES			;MAS07
; FIX /A SWITCH WITH 0 VALUE ABS GLOBAL SYMBOLS				;MAS12
; ABSOLUTE GLOBALS AND MODULE NAMES CONFUSION ERROR			;DBB01
; FIX CHECKSUM ERROR ON EXTRACTED MODULES				;DBB02
; 11	15-May-91	WFG	Update version numbers of all LIBR files
; 12    13-Jan-98       TDS     Update all version numbers to 12 for 5.7
;
.SBTTL	-	SYMBOLIC DEFINITIONS

GSD=	1		;CODE FOR A GSD RECORD
MODEND=	6		;CODE FOR A END OF MODULE RECORD

.SBTTL	-	MACRO DEFINITIONS

.MCALL	.CLOSE,.WRITW,.REOPEN,.READW,.SETTOP

.MACRO	ERROR$	ERNB,SEV,ETYP,REG
	.IF NB REG
	.IIF DIF <REG>,<R0>	MOV REG,R0
	.IFF
	.IIF IDN <ETYP>,<E$FIL>	CLR	R0
	.ENDC
	JSR	R5,ERROOT
	.BYTE	ERNB,	SEV*200!ETYP
.ENDM

.IF Z EIS$
.MACRO	SOB	A,B
	DEC	A
	BNE	B
.ENDM
.ENDC


	.WORD	4	;ERROR HANDLING INDEX WORD(IN A DATA SECTION)
			;MUST BE 1ST PHYSICAL LOCATION OF EACH OVERLAY

.SBTTL	-	END OF LIBRARY FORMATTED BINARY RECORD

.PSECT	DPUR3,D

LBREND:	.WORD	F.BRHC		;FORMATTED BINARY RECORD HDR CODE
	.WORD	8.		;LENGTH OF LIBR END BLK
	.WORD	10		;LIBR. END CODE
	.WORD	0
	.BYTE	357		;LIBEND CHECKSUM
	.EVEN

.PSECT
.SBTTL	PASS2:: OUTPUT THE OBJ'S TO LIBRARY

PASS2::	BIT	#SW.E,SWITCH	;ARE WE EXTRACTION MODULES ?
	BEQ	10$		;NO
	JMP	EXTRAC		;YES, GO DO IT

10$:	TSTB	PASS		;START OR FINISH OF PASS 2 ?
	BNE	100$		;FINISH

.SBTTL	-	END OF PASS1 (CLEANUP & START PASS 2)

	MOV	DMNLA,R1	;MODULE NAMES TO DELETE ?
	BEQ	20$		;THERE WERE NONE
	JSR	R5,CHKDL1	;CHECK DELETE LIST
20$:	MOV	DEPLA,R1	;ANY ENTRY POINTS TO DELETE ?
	BEQ	30$		;NO
	JSR	R5,CHKDL1	;CHECK EPT DELETE LIST
30$:	MOV	EPTST,R4	;R4 -> START OF EPT
	MOV	R4,R5		;COPY FOR LATER
	MOV	EPTPTR,R0	;END OF EPT ADR
	BIT	SWITCH,#SW.N	;INCLUDE MODULE NAMES ?
	BNE	70$		;YES

; DETERMINE # OF MODULE NAMES IN EPT TO LATER BE REMOVED

	CLR	R2		;MODULE NAME COUNT * 8 FOR SPACE USED
	ADD	#L$HEPT+E$PBLK,R4 ;R4 -> 1ST ENTRY MODULE NAME INDICATOR
40$:	CMP	R4,R0		;END OF TABLE ?
	BHIS	60$		;YES
	TST	@R4		;MODULE NAME ENTRY ?
	BPL	50$		;NO
	ADD	#8.,R2		;YES, COUNT IT
50$:	ADD	#8.,R4		;BUMP PTR TO NEXT ENTRY
	BR	40$		;LOOP FOR NEXT

60$:	SUB	R2,R0		;REDUCE SIZE OF TABLE TO EXCLUDE MOD NAMES
70$:	SUB	R5,R0		;CALC.EPT ENTRIES ALLOC INCLUDING HEADER
	CMP	#L$HEPT,R0	;IF ALLOCATION IS ONLY THE HEADER THEN
	BHIS	110$		; A NULL LIBRARY WAS MADE
	MOV	R0,L$HEAB(R5)	;AND IND IN EPT
	ADD	#511.,R0	;ROUND UP TO NEXT BLOCK BOUNDRY
	BIT	#777,R0		;IS THIS EVEN BLOCK BOUNDARY		;MAS05+
	BNE	80$		;NO
	ADD	#1000,R0	;YES,RESET FOR PROPER BLOCK
80$:	BIC	#777,R0							;MAS05-
	ROR	R0		;KEEP CARRY IF ADD OVERFLOWED
	SWAB	R0		;BLK # IN RIGTH POSITION
	DEC	R0		;LESS 1 FOR BUMP BEFORE WRITE
	MOV	R0,OBLK		;OUTPUT (BLK # -1) OF OBJ MODULES
	INCB	PASS		;IND PASS 2
	CALL	INIO		;INIT FOR READING INPUT FILES

90$:	CALL	NEWBLK		;GET FB BLK
	ASL	R0		;MAKE WORD INDEX
	CMP	#DSPTBE-DSPTBL,R0 ;LEGAL BLOCK TYPE ?
	BLOS	ILFMT		;YES
	CALL	@DSPTBL(R0)	;CALL BLOCK DEPENDENT ROUTINE
	BR	90$		;GO AGAIN

100$:	JMP	PA2EXT		;FINISH UP PASS 2

110$:	ERROR$	ERR14,E$F,E$PRT	;NULL LIBRARY

.SBTTL	-	FORMATTED BINARY RECORD TYPE DISPATCH TABLE

.PSECT	DPUR3,D

DSPTBL:	.WORD	ILFMT		; 0 - ILLEGAL BLOCK TYPE
	.WORD	GSDREC		; 1 - START OF GSD RECORD
	.WORD	WRTBLK		; 2 - END OF GSD
	.WORD	WRTBLK		; 3 - TXT
	.WORD	WRTBLK		; 4 - RLD
	.WORD	WRTBLK		; 5 - ISD (INTERNAL SYMBOL DEF)
	.WORD	ENDMOD		; 6 - MODULE END
	.WORD	LMERGE		; 7 - LIBRARY HEADER RECORD
	.WORD	IGNORE		;10 - END OF LIBRARY FILE
DSPTBE:				;END OF TABLE

.PSECT

ILFMT:	ERROR$	ERR6,E$F,E$FIL	;ILLEGAL RECORD TYPE IN <FILENAME>

.SBTTL	LMERGE	INPUT FILE IS A LIBRARY

;+
; THE INPUT FILE IS A LIBRARY SO WE ARE MERGING IT WITH THE OTHER INPUT
; FILES. THE EPT OF THIS INPUT FILE WILL BE SKIPPED OVER AND THE OBJ
; MODULES OF THE INPUT LIBR FILE PROCESSED JUST LIKE OTHER INPUT OBJ'S.
;-

LMERGE:	ADD	#L$HEAB-6,R4	;R4 -> SIZE OF EPT IN BYTES
	MOV	@R4,R0		;GET EPT ENTRIES ALLOC.
	DEC	R0		;FIX IT IF EVEN BLOCK BOUNDARY		;MAS05
	BIC	#777,R0		;DETERMINE STARTING BLK # OF OBJ'S
	SWAB	R0		; C =0
	ROR	R0
	INC	R0		;OBJ START ON BLK BOUNDARY
	MOV	R0,CURBLK	;UPDATE CURRENT INPUT REL BLK #
	JMP	NEWBUF		;READ MODULES IN LIBR(NEWBUF WILL RETURN)

.SBTTL	ENDMOD	END OF MODULE

ENDMOD:	BIC	#FG.MOD,SWITCH	;CLEAR MODULE NAME ITEM FOUND BIT
	JMP	WRTBLK		;IT WILL RETURN
.SBTTL	GSDREC	PROCESS GSD RECORD

; ALL GSD RECORDS WILL BE TRANSFERRED TO A TEMP BUFR BEFORE PROCESSING.

GSDREC:	MOV	#TEMP,R3	;R3 -> TEMPORARY BUFR
	MOV	R5,R1		;LENGTH OF GSD RECORD
	MOV	R5,-(SP)	;SAVE CURRENT F.B. LENGTH
	INC	R1		;INCLUDE THE CHECKSUM BYTE
10$:	CALL	BYTE		;GET AN INPUT BYTE IN R0
	MOVB	R0,(R3)+	;MOVE GSD TO TEMP AREA
	DEC	R1		;HAVE MOVED RECORD ?
	BGT	10$		;NO
	MOV	#TEMP,R1	;R1 -> TEMP BUFR DURING GSD PROCESSING
20$:	MOVB	S$YCOD(R1),R0	;GET GSD INDICATOR CODE
	ASL	R0		;SET UP INDICATOR FOR TABLE
	CMP	#GSDTBE-GSDTBL,R0 ;LEGAL GSD CODE ?
	BLOS	BADGSD
	CALL	@GSDTBL(R0)	;CALL APPROPRIATE SUBROUTINE
	ADD	#8.,R1		;R1 -> NEXT GSD ITEM
	SUB	#8.,R5		;DEC GSD LENGTH
	TST	R5		;ANY BYTES REMANING IN F.B. BLK ?
	BGT	20$		;YES, PROCESS NEXT GSD ITEM
	MOV	(SP)+,R5	;ORIG FB LENGTH
	MOV	#GSD*2,R0	;GSD RECORD TYPE*2
	MOV	R4,-(SP)	;SAVE CURRENT INPUT BUFR PTR
	MOV	#TEMP,R4	;R4 -> WHERE INPUT IS COMING FROM
	CALL	WRTBLK		;WRITE THIS GSD BLOCK
	MOV	(SP)+,R4	;RESTORE INPUT BUFR PTR
IGNORE:	RETURN			;RETURN TO GET NEW DATA BLK

BADGSD:	ERROR$	ERR10,E$F,E$FIL	;BAD GSD IN <FILENAME>

.SBTTL	-	GSD RECORD TYPE DISPATCH TABLE

.PSECT	DPUR3,D

GSDTBL:	.WORD	MODNAM		; 0 - MODULE NAME
	.WORD	SECNAM		; 1 - SECTION NAME
	.WORD	IGNORE		; 2 - INTERNAL SYMBOL DISCRIPTOR
	.WORD	IGNORE		; 3 - TRANSFER ADDRESS
	.WORD	GBLSYM		; 4 - GLOBAL SYMBOL
	.WORD	SECNAM		; 5 - PROGRAM SECTION
	.WORD	IGNORE		; 6 - PROGRAM IDENT
	.WORD	SECNAM		; 7 - VIRTUAL SECTION
GSDTBE:				;END OF TABLE
.PSECT

; INPUT:	R1 -> INPUT GSD RECORD

.SBTTL	MODNAM	BUILD EPT FOR MODULE NAME

; MODULE NAME ALWAYS MUST BE 1ST GSD ITEM!

MODNAM:	MOV	DMNLA,R0	;ANY MODULES TO DELETE ?
	BEQ	10$		;NO
	CALL	DELENT		;YES, CHECK FOR MATCH
	BCS	SKPMOD		;C=1 TO SKIP THIS MODULE
10$:	MOV	OBLK,COBDEF	;CURRENT OUTPUT REL BLK #
	INC	COBDEF		;OBLK IS 1 LESS THAN BLK CURRENTLY FILLING
	MOV	OBPTR,R0	;CURRENT OUTPUT BUFR PTR
	SUB	OBUF,R0		; & CALC BYTE DISPLACEMENT
	MOV	R0,BYTDIS	;SAVE IT
	BIS	#FG.MOD,SWITCH	;INDICATE MODULE NAME ITEM FOUND
	BR	PA2MNM

.SBTTL	SECNAM	SECTION NAME SUBROUTINE

; BLANK, . ABS., & ZERO LENGTH SECTIONS ARE IGNORED

.ENABL	LSB

SECNAM:	BIT	SWITCH,#SW.P	;SWOULD PROGRAM SECTIONS BE INCLUDED ?
	BEQ	20$		;SET IF YES
	TST	S$YVAL(R1)	;ZERO LENGTH SECTION ?
	BEQ	20$		;YES, IGNORE ENTRY
	CMP	(PC)+,@R1	;IS SYMBOL ASECT ?
	.RAD50	/. A/
	BNE	10$		;NO
	CMP	#^RBS.,2(R1)
	BEQ	20$		;YES, IGNORE IT
10$:	TST	@R1		;IS SECTION BLANK ?
	BNE	PA2MNM		;NO
20$:	RETURN
.SBTTL	GBLSYM	GLOBAL SYMBOL SUBROUTINE

GBLSYM:	MOVB	S$YFLG(R1),-(SP) ;GET COPY OF FLAGS BYTE		;DBB02
	BICB	#^C<SY$DEF+SY$REL+SY$WK>,@SP ;CLEAR UNUSED BITS		;DBB02
	CMPB	(SP)+,#<SY$DEF+SY$REL> ;STRONG REL DEF?			;DBB02
	BEQ	30$		;YES IF EQ
	TST	SWITCH		;WAS ABSOLUTE SWITCH USED?		;DBB01
	BPL	20$		;PL-> NO SWITCH, SKIP ALL ABSOLUTES	;DBB01
	CMPB	-2(SP),#SY$DEF	;IS IT A STRONG ABS DEF?		;DBB02
	BNE	20$		;NE -> NO, DON'T INCLUDE IN EPT		;DBB01
;	TST	S$YVAL(R1)	;ZERO LENGTH ENTRY PT			;DBB01
;	BEQ	20$		;YES, IGNORE IT				;DBB01
30$:	MOV	DEPLA,R0	;R0 -> GLOBAL DELETE LIST
	BEQ	PA2MNM		;EMPTY IF 0
	CALL	DELENT		;CHECK LIST
	BCS	20$		;C=1 IF MATCH IN LIST, SKIP GLOBAL
;	BR	PA2MNM

.DSABL	LSB

;+
; MODULE NAMES MAY BE DUPLICATED IN EPT, BUT GLOBALS NEVER
;	(MAY HAVE MODULE NAME & GLOBAL THE SAME THOUGH)
;-

PA2MNM:	CALL	EPTSER		;FIND NAME IN EPT ?
	BCS	10$		;NOT FOUND SO DELETE IT
	TST	E$PBYT(R3)	;REPLACE THIS SYMBOL ?
	BPL	20$		;NO IF +
	CLR	E$PBYT(R3)	;TURN OFF REPLACE SWITCH
10$:	TSTB	S$YCOD(R1)	;PROCESSING A MODULE NAME ?
	BEQ	SKPMOD		;YES IF 0
	RETURN			;GLOBAL SYM SO JUST RETURN TO SKIP IT

20$:	TST	E$PBLK(R3)	;TBL ENTRY A MODULE NAME ?
	BPL	50$		;NO IF +
30$:	BIT	#^CMD.NAM,E$PBLK(R3) ;MOD NAME BLK ADR PREV INDICATED ?
	BEQ	60$		;NO
40$:	CALL	EPTSR1		;SEARCH FOR CORRECT NAME
	BCS	10$		;C=0 IF SYMBOL FOUND
	BIT	#^CMD.NAM,E$PBLK(R3) ;ENT PT/ MOD NAME ALREADY SEEN ?
	BNE	40$		;YES
50$:	TSTB	S$YCOD(R1)	;MODULE NAME ?
	BEQ	30$		;YES IF 0
	BIT	SWITCH,#SW.X	;KEEPING DUP. GBL. SYMBOLS?		;MAS06
	BNE	30$		;YES-> CONTINUE				;MAS06
60$:	BIT	#^CMD.NAM,E$PBLK(R3) ;IF WE GET HERE WITH BLOCK ALREADY GIVEN
				; THEN THE SYMBOL WAS A GLOBAL
	BNE	70$		; THEY CAN APPEAR ONLY ONCE, SO SKIP IT
	BIT	#FG.MOD,SWITCH	;WAS A MODULE NAME ITEM GIVEN 1ST ?
	BEQ	BADGSD		;NO IF EQ, SO GIVE ERROR
	BIS	COBDEF,E$PBLK(R3) ;GET BLK DISP TO OBJ MOD
	MOV	BYTDIS,E$PBYT(R3) ;IND BYTE OFFSET
70$:	RETURN
.SBTTL	-	DELETE OBJ MOD FROM LIBRARY BUILD

; ALREADY READ IN A GSD RECORD, SO SKIP ALL OTHERS

.ENABL	LSB

10$:	CALL	SKPBLK		;SKIP OVER FB BLK
SKPMOD:	CALL	NEWBLK
	CMP	#MODEND,R0	;END OF MODULE ?
	BNE	10$		;NO
	CMP	(SP)+,(SP)+	;DO NOT RETURN TO GSD PROCESSING LOOP
				; BUT TO PROCESS NEW OBJ RECORD.
				; & POP SAVED FB LENGTH
	JMP	SKPBLK		;SKIP LAST FB BLK(SKPBLK WILL RETURN)

.DSABL	LSB

.SBTTL	WRTBLK	FORMATTED BINARY BLOCK OUTPUT ROUTINE

;+
; INPUT:
;	R0 = 2*TYPE CODE
;	R5 =  NUMBER OF DATA BYTES IN THE BLOCK(LENGTH)
;	R4 -> DATA TO BE WRITTEN(CURRENT INPUT BUFR POSITION)
; THIS REPRODUCES THE INITIAL 3 WORDS OF THE F.B. BLK SINCE THEY MAY NOT
; BE IN THE CURRENT INPUT BUFR.
;-

WRTBLK:	ASR	R0		;TYPE CODE BACK TO PROPER FORM
WRTBK:	MOV	R0,-(SP)	;SAVE IT FOR LATER
	MOV	#F.BRHC,R1
	CALL	PUTWD
	MOV	R5,R1		;GET CURRENT LENGTH
	ADD	#6,R1		;ADD BACK 6 BYTES FOR F.B. HEADER
	CALL	PUTWD
	MOV	(SP)+,R1	;TYPE OF BLOCK
	CALL	PUTWD
	INC	R5		;INCLUDE THE CHECKSUM BYTE IN LENGTH
10$:	CALL	BYTE		;GET AN INPUT BYTE IN R0
	MOV	R0,R1
	CALL	PUTBYT		;WRITE A BYTE
	SOB	R5,10$		;LOOP UNTIL END OF FB BLK
	RETURN

.SBTTL	PUTWD	PUT A WORD INTO OUTPUT FILE (R1 = WORD)

; CLOBBERS R0, R1 IS BYTE SWAPPED

PUTWD:	CALL	PUTBYT		;LOW ORDER BYTE IS OUTPUT
	SWAB	R1		;PREPARE FOR HIGH BYTE
	JMP	PUTBYT		;PUTBYT WILL RETURN
.SBTTL	CHKDL1	CHECK DELETE LIST FOR THINGS NOT DELETED

;+
; CHECK THE DELETE LIST AND INDICATE AN ILLEGAL DELETE
; IF EITHER AN ENTRY POINT OR A MODULE NAME HAVE NOT BEEN DELETED
;-

.ENABL	LSB

10$:	CLR	(R1)+		;ZERO FLAG FOR THIS PASS CHECKING
CHKDL1:	TST	(R1)+		;END OF LIST ?
	BEQ	20$		;YES
	TST	(R1)+		;R1 -> FLAG WORD
	TST	@R1		;SYMBOL DELETED ?
	BMI	10$		;YES, CHECK NEXT SYMBOL
	MOV	R1,R0		;NO, COPY PTR
	CMP	-(R0),-(R0)	;R0 -> SYMBOL TO PRINT
	ERROR$	ERR16,E$W,E$SYM	;ILLEGAL DELETE OF <SYMBOL>
	BR	10$		;DO ENTIRE LIST

.SBTTL	OV3DUM:: DUMMY ENTRY POINT TO MAKE IT RESIDENT

20$:
OV3DUM::RTS	R5

.DSABL	LSB
.SBTTL	PA2EXT	END OF PASS 2 EXIT(CLEANUP & CALL LIST)

;+
; THE CURRENT OUTPUT BLOCK # AND BUFFER POINTER MUST BE SAVED BEFORE THE
; LIBRARY END RECORD IS WRITTEN SO THAT INSERTS CAN OCCUR BERORE THE END RECORD.
;-

PA2EXT:	MOV	OBPTR,-(SP)	;SAVE CURRENT TO CALC NEXT INSERT BLK
	MOV	OBLK,-(SP)	;SAME FOR OUTPUT REL BLK #
	MOV	#LBREND,R3	;R3 -> LIBRARY END RECORD
	MOV	(R3)+,R1	;F.B. CODE
	CALL	PUTWD
	MOV	(R3)+,R1	;LENGTH
	CALL	PUTWD
	MOV	(R3)+,R1	;LIBRARY END CODE
	CALL	PUTWD
	MOV	(R3)+,R1	;NULL WORD
	CALL	PUTWD
	MOVB	@R3,R1		;CHECKSUM BYTE
	CALL	PUTBYT
	CLR	R1		;FILL THE REMAINDER OF THE BLOCK
	MOV	#511.,R3	; WITH 0'S TO FORCE OUT BUFR
10$:	CALL	PUTBYT
	SOB	R3,10$
	MOV	EPTST,R1	;R1 -> START OF RESIDENT EPT
	INC	@SP		;REL BLK # IS 1 LESS THAN CURRENTLY FILLING
	MOV	(SP)+,L$HNIB(R1) ;NEXT INSERT REL BLK # IN HEADER
	SUB	OBUF,@SP	;START OF OUTPUT BUFR FROM PTR TO GET
	MOV	(SP)+,L$HNBB(R1) ; NEXT INSERT BYTE WITHIN BLOCK
	MOV	L$HEAB(R1),R2	;SIZE OF EPT IN BYTES
	ROR	R2		;C=0 FORM SUB, NOW WORD COUNT
	BIT	SWITCH,#SW.N	;INCLUDE MODULE NAMES ?
	BNE	50$		;YES

;+
; ALL THE MODULE NAME ENTRIES WILL BE REMOVED FROM THE EPT
; BY SQUEEZING THE EPT TABLE DOWN BY SKIPPING MODULE NAMES
;-

	MOV	R1,R0		;COPY START OF EPT
	ADD	#L$HEPT,R0	;R0 -> 1ST ENTRY
	MOV	R0,R3		;R3 USED AS FORWARD CHECK PTR
	BR	30$		;INTO LOOP

20$:	ADD	#8.,R3		;ADVANCE TO NEXT ENTRY
30$:	TST	@R3		;END OF TABLE ?
	BEQ	40$		;YES
	TST	E$PBLK(R3)	;ENTRY A MODULE NAME ?
	BMI	20$		;YES, DON'T MOVE IT DOWN
	MOV	(R3)+,(R0)+	;SQUEEZE AN ENTRY DOWN
	MOV	(R3)+,(R0)+
	MOV	(R3)+,(R0)+
	MOV	(R3)+,(R0)+
	BR	30$		;CONTINUE LOOPING

40$:	CLR	@R0		;MARK END OF TABLE
50$:	TST	OBPTR		;IF 0 THEN NO OUTPUT REQUESTED
	BEQ	60$
	.WRITW	#TEMP,#0,R1,R2,#0 ;WRITE LIBR HEADER & EPT AT BLK 0
	BCS	80$
60$:	BIT	SWITCH,#FG.LST	;WAS A LISTING REQUESTED ?
	BNE	70$		;YES
	JMP	DONE		;CLOSE & RESTART

70$:	JMP	LIST

80$:	ERROR$	ERR23,E$F,E$PRT	;OUTPUT WRITE ERROR
.SBTTL	EXTRAC	EXTRACT OBJECT MODULES FROM LIBRARY

;+
; MAKE THE LIBRARY DIRECTORY RESIDENT
; INPUT:
;	OCHAN=0, OBLK=-1, OBPTR IS SETUP
;	DEPLA -> LIST OF GLOBAL ROUTINES TO EXTRACT
;-

.ENABL	LSB

EXTRAC:	MOV	EPTST,R4	;BUFFER ADR FOR THE EPT
	MOV	FILPT1,R3	;R3 -> LIBRARY TO EXTRACT FROM
	.REOPEN	#TEMP,#3,R3	;OPEN THE LIBRARY FILE
	BCS	30$		;	*** SHOULD NOT HAPPEN ***
	.READW	#TEMP,#3,R4,#256.,#0 ;READ LIBRARY DIRECTORY
	BCS	30$
	CMP	L$HC(R4),#L.BR	;CHECK TO SEE IT THIS IS A LIBRARY?
	BEQ	10$		;YES IF EQ
	ERROR$	ERR22,E$F,E$PRT	;BAD LIBRARY TO LIST OR EXTRACT

10$:	MOV	L$HEAB(R4),R1	;SIZE OF EPT IN BYTES (INCLUDES HEADER)
	MOV	R1,R5		;COPY OF # OF BYTES TO READ
	ADD	R4,R5		;R5 -> END OF EPT
	CMP	@#HIGH,R5	;ENOUGH ROOM TO FIT EPT IN MEMORY ?
	BHI	20$		;YES
	ERROR$	ERR3,E$F,E$PRT	;INSUFFICIENT MEMORY

20$:	SUB	#512.,R1	;REDUCE SIZE BY 1 BLK WE JUST READ
	BLE	40$		;NO MORE TO READ (ONLY 1 BLK EPT)
	MOV	R4,R2		;COPY START ADR OB BUFR
	ADD	#512.,R2	;NEXT INPUT BUFR ADR
	ASR	R1		;NOW WORD COUNT
	.READW	#TEMP,#3,R2,R1,#1 ;READ IN REMAINDER OF EPT
	BCC	40$
30$:	ERROR$	ERR5,E$F,E$FIL	;READ ERROR IN <FILENAME>

40$:	CLR	@R5		;MARK END OF EPT

;+
; LIBRARY DIRECTORY IS RESIDENT, FIND A MATCH OF GLOBALS
; TO EXTRACT IN EPT.
;-

50$:	MOV	DEPLA,R1	;R1 -> LIST OF GLOBALS TO EXTRACT
	BEQ	150$		;IF 0 THEN NOTHING TO EXTRACT
	BR	80$		;BRANCH INTO LOOP

60$:	DEC	4(R1)		;MARK IT AS EXTRACTED(PREVENT A LOOP)
	ERROR$	ERR25,E$W,E$SYM,R1 ;ILLEGAL EXTRACT OF <SYMBOL>

70$:	ADD	#6,R1		;R1 -> NEXT SYMBOL IN LIST
80$:	TST	@R1		;END OF LIST ?
	BEQ	130$		;YES IF 0 SO ALL DONE
	TST	4(R1)		;GLOBAL ALREADY EXTRACTED ?
	BMI	70$		;YES IF MI SO GOTO NEXT
	CALL	EPTSER		;R1 -> SYMBOL TO FIND IN EPT
	BCS	60$		;C=1 IF NOT FOUND
	CMP	(R3)+,(R3)+	;R3 -> REL BLK # OF FOUND SYMBOL
	MOV	(R3)+,R4	;R4 = REL BLK #
	BIC	#MD.NAM,R4	;GET RID OF MODULE NAME BIT IF ANY
	MOV	(R3)+,R5	;BYTE OFFSET INTO BLK

;+
; SCAN EPT FOR MATCHING REL BLK # & BYTE OFFSET(ROUTINES CONTAINED
; IN SAME MODULE) WHEN HAVE MATCH CHECK EXTRACT LIST FOR SAME SYMBOL
; & IF MATCH WHERE MARK IT EXTRACTED.
;-

 	MOV	EPTST,R1	;R1 -> START OF EPT
	ADD	#L$HEPT-8.,R1	;SKIP OVER HEADER
90$:	ADD	#8.,R1		;R1 -> NEXT ENTRY
	TST	@R1		;END OF EPT ?
	BEQ	100$		;YES IF 0
	CMP	E$PBLK(R1),R4	;CHECK REL BLK #
	BNE	90$		;NO MATCH IF NE
	CMP	E$PBYT(R1),R5	; & BYTE OFFSET
	BNE	90$
	MOV	DEPLA,R0	;R0 -> EXTRACT LIST & R1 -> SYMBOL TO FIND
	JSR	PC,DELENT	;IF MATCH FLAG WORD SET - (INDICATES EXTRACTED)
	BR	90$		;CONTINUE THRU EPT

; COPY THIS CURRENT MODULE CONTAINING THE EXTRACTED GLOBAL ROUTINE

100$:	MOV	R4,CURBLK	;SETUP CURRENT INPUT BLK #
	JSR	PC,NEWBUF	;GET 1ST BUFR FULL
	ADD	R5,R4		;R4 -> PROPER BYTE IN BLOCK
	BR	120$		;INTO COPY THIS MODULE LOOP

110$:	JSR	PC,WRTBK	;WRITE OUT THIS RECORD
120$:	JSR	PC,NEWBLK	;GET F.B. RECORD
	CMP	#MODEND,R0	;IS THIS END-OF-MODULE RECORD ?
	BNE	110$		;NO IF NE
	JSR	PC,WRTBK	;WRITE END-OF-MODULE RECORD
	BR	50$		; & CONTINUE

; NOTHING MORE TO EXTRACT FINISH UP & CLOSE OUTPUT FILE

130$:	CLR	R1		;FILL THE REMAINDER OF THE BLOCK
	MOV	#511.,R3	; WITH 0'S TO FORCE OUT BUFR
140$:	JSR	PC,PUTBYT
	SOB	R3,140$
DONE:	.SETTOP	FILPT1		;JUST ABOVE HANDLERS FOR LESS SWAPPING
	.CLOSE	#0		;CLOSE EXTRACED MODULE'S FILE
	BCC	150$		;C=0 -> NO ERROR ON COLSE		;MAS07+
	CMPB	#PROTCT,@#ERRBYT ;IS THIS A PROTECTION VIOLATION?
	BNE	150$		;NE -> NO
	MOV	#ODBLK,R0	;POINT AT FILE NAME
	ERROR$	ERR33,E$W,E$FIL,R0 ;PROTECTION VIOLATION ERROR		;MAS07-
150$:	JMP	REENTR		;ALL DONE SO RESTART

.DSABL	LSB

.SBTTL	PATCH PSECT

.PSECT	PATCH			;THIS IS A PATCH PSECT TO BE
				;USED FOR BUG FIXES
	.BLKW	64.

.END