.MCALL	.MODULE
.MODULE	LIBR,VERSION=12,COMMENT=<Librarian Root Code> AUDIT=YES,MODNAME=LIBR0,GLOBAL=.LIBR0

; 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.
.AUDIT	.LIBR0,.LIBR1,.LIBR2,.LIBR3,.LIBR4,.LIBR5,.LIBR6,.LBREM
.SBTTL	ROOT CODE
.ENABL	GBL

; CER,MAS,DBB,LB,JFW

.IIF NDF FORM$	FORM$=1	;INCLUDE FORM LIBRARY FUNCTIONALITY		;MAS01

; EDIT HISTORY:

; ADDITION OF FORM LIBRARY FUNCTIONALITY				;MAS01
; FIX LOSS OF DEFAULT EXT. WHEN VERSION PRINTED				;MAS03
; ADD .ENTER AND .CLOSE PROTECTION ERROR MESSAGES			;MAS07
; PUT ADDED SAFETY CHECKS IN NEWBLK					;DBB01
; ADD MACNUM AND ENDMNM FOR /M PROCESSING				;LB
; ADD JSX setup, bracket error messages in ;+/;ERROR/.../;-		;JFW
;	15-May-91	WFG	Update version numbers in all LIBR files
; 12	13-Jan-98	TDS	Update all version numbers to 12 for 5.7
;
.SBTTL	-	MACRO DEFINITIONS

.MCALL	.PRINT,.RCTRLO,.REOPEN,.SRESET,.CLOSE,.READW,.WRITW

.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,ERROVR		;ENTRY WHEN CALLED FROM ROOT
	.BYTE	ERNB,	SEV*200!ETYP
.ENDM

.LIBRARY "SRC:SYSTEM"
.MCALL	.JSWDF	.JSXDF	.SYCDF
	.JSWDF
	.JSXDF
	.SYCDF	e=<==:>

.ASECT

.=$JSX
	.WORD	VBGEX$

.=$JSW
	.WORD	RSTRT$	;REENTERABLE BIT IN JSW
.SBTTL	-	LIBRARIAN STORAGE AREAS AND VARIABLES

.PSECT	IMPURE,D,GBL

IMPURE::	; START OF AREA TO CLEAR AT START

;+
; THE FOLLOWING AREA IS USED BY THE CSI AS READ-IN AREA.
; ALSO USED AS TEMPORARY STORAGE AREA ONCE CSI USE IS DONE.
;-

ODBLK::	.BLKW	10.	;OUTPUT & LIST DISCRIPTOR BLOCK (SAVE THROUGHOUT)	;MAS10
TEMP::	.BLKW	5	;3RD OUTPUT FILE (IGNORED)
	.BLKW	4*6	;INPUT DISCRIPTOR BLK
	.BLKW	5	;KEEP TEMP BUFFER AREA THE SAME SIZE		;MAS10
CBUF::	.BLKB	78. 	;ENOUGH ROOM FOR A CSIGEN LINE BUFR		;MAS03
		;NEXT TWO WORDS ALSO REQUIRED AS PART OF CBUF		;MAS03
NAME::	.BLKW	2	;USED BY FORM OVERLY AS TEMP			;MAS03

SWITCH::.BLKW		;LIBRARY SWITCH INDICATORS(SEE LIBR1 FOR BIT ASSIGNMENTS)
SWIT6::	.BLKB		;WHEN PROCESSING LIBRARY FILE	(LIBR2)
			;NEG WHEN PROCESSING A SECTION	(LIBR3)
SWIT7::	.BLKB		;IF REPLACING A MODULE	
NUMCOL::.BLKB		;NUMBER OF COLUMNS WIDE FOR LISTING
PASS::	.BLKB		;PASS1 = 0; PASS2 = 1
	.EVEN

MODCNT::.BLKW		;COUNT OF OBJ MOD PROCESSED
COBDEF::.BLKW		;CURRENT OBJ. MOD EPT ADR	(LIBR2)
			;OBJ MOD BLOCK DISP		(LIBR3)
			;END OF MACRO DEF FLG		(LIBR5)
REPLPT::.BLKW		;REPLACE FILE ASSOCIATION AREA
UPDPTR::.BLKW		;UPDATE FILE ASSOC AREA ADR(0 IF NO /U GIVEN)
DMNLA::	.BLKW		;USER REQUESTED DELETE MODULE NAME LIST ADR
DEPLA::	.BLKW		;USER REQUESTED DELETE ENTRY POINTS LIST ADR
EPTST::	.BLKW		;STARTING ADR OF RESIDENT ENTRY POINT TBL
EPTPTR::.BLKW		;CURRENT EPT BUFR PTR (-> END OF TBL)
BYTDIS::.BLKW		;OBJ MOD BYTE DISP INTO LIBR
DEFMNT::.BLKW		;SIZE OF MACRO MODULE NAME TABLE
MACNUM::.BLKW		;# OF TIMES KEYWORDS .MACRO, .IRPC, & .IRP HAVE BEEN FOUND
ENDMNM::.BLKW		;# OF TIMES KEYWORDS .ENDM AND .ENDR HAVE BEEN FOUND

IMPSIZ== .-IMPURE	;SIZE OF AREA TO CLEAR
PRAREA::.BLKW	5.	;AREA FOR PROGRAMMED REQUESTS
.SBTTL	START::	ERROR::	REENTR::

.PSECT	MAIN

; THIS ROUTINE ALLOWS THE USER TO REENTER THE LIBRARIAN AFTER A CTRL C.

ERROR::	.PRINT			;PRINT MESSAGE & RESTART
REENTR::.RCTRLO			;OVERRIDE CNTRL O
	.SRESET			;RESET SYSTEM AREAS
	BR	START	

	BR	REENTR
START::	JMP	START1

.SBTTL	ERROOT:: ROOT ERROR TRANSFER ROUTINE

;+
; THIS ROUTINE IS IN THE ROOT SEGMENT TO TRANSFER CONTROL TO THE
; ERROR MESSAGE OVERLAY. THE RETURN PATH IS SAVE SINCE THE
; ERROR OVERLAY IS IN THE SAME REGION AS THE ORGINAL CALLING ROUTINE.
; THIS ROUTINE IS CALLED BY THE ERROR$ MACRO DEFINED IN EACH OVERLAY
; ROUTINE. A DUMMY ENTRY POINT IS CALLED TO ASSURE THE CALLING OVERLAY
; IS MADE RESIDENT AGAIN.
; OV1DUM MUST BE A "RTS	R5"
;
; CALLING SEQUENCE:
;	JSR	R5,ERROOT
;	.WORD	ERROR CODE WORD
;-

ERROOT::MOV	(R5)+,(PC)+	;SAVE THE ERROR CODE WORD
ERCODE:: .BLKW
	MOV	ERRIDX,-(SP)	;GET THE OVERLAY INDEX #
			;***THIS MUST BE THE 1ST LOCATION IN EACH OVERLAY***
	ADD	#DUMTBL,@SP	;ADD IN START OF VECTOR TABLE
	MOV	@(SP)+,-(SP)	;THE RETURNS WILL CALL IT SINCE THE ADR IS ON STACK
	JMP	ERROVL		;PROCESS THE ERROR VIA THE ERROR OVERLAY

.PSECT	DPURE,D

DUMTBL:	.WORD	OV1DUM		;OVERLAY DUMMY ENTRY POINT VECTOR TABLE
	.WORD	OV2DUM		; ONE FOR EACH OVERLAY THAT HAS NON-FATAL ERRORS
	.WORD	OV3DUM
	.WORD	OV4DUM
	.WORD	OV5DUM

.IF NE FORM$								;MAS01
	.WORD	OV6DUM							;MAS01
.ENDC									;MAS01

.PSECT	MAIN
.SBTTL	EPTSER:: ENTRY POINT SEARCH ROUTINE

;+
; SEARCH THE ENTRY POINT TABLE FOR A MATCH OF THE INDICATED SYMBOL.
;
; INPUT:
;	R1 -> SYMBOL TO BE SEARCHED FOR
;
; OUTPUT:
;	R3 -> THE FOUND SYMBOL IN THE ENTRY POINT TABLE.
;	C = 0 - SYMBOL FOUND
;	C = 1 - SYMBOL NOT FOUND
;-

.ENABL	LSB

EPTSER::MOV	EPTST,R3	;R3 -> START OF LIBRARY HEADER
	ADD	#L$HEPT-8.,R3	;GO BEYOND HEADER TO 1ST ENTRY
EPTSR1::ADD	#8.,R3		;4 WORDS FOR EACH ENTRY PT
	TST	@R3		;1ST WORD OF SYMBOL
	BEQ	30$		;IF 0 THEN AT END OF TBL
	CMP	@R1,@R3		;1ST WD MATCH?
	BNE	EPTSR1		;NO, TRY NEXT ENTRY
	CMP	2(R1),2(R3)	;YES, 2ND WD MATCH?
	BNE	EPTSR1
	RETURN			;C=0 FROM CMP, R3 -> FOUND SYMBOL
.SBTTL	DELENT:: LOOK FOR MATCH IN A DELETE LIST

;+
; THIS ROUTINE INDICATES IF THE SYMBOL POINTED TO BY
; R1, MATCHES THE LIST POINTED TO BY R0:
;
; INPUT:
;	R1 ->  2WD SYMBOL TO FIND A MATCH
;	R0 -> START OF DELETE LIST (3 WDS PER ENTRY)
;	FLAG WORD = (-)	SYMBOL ALREADY DELETED
;
; OUTPUT:
;	R1 = SAME AS INPUT
;	C = 0	NO MATCH
;	C = 1	MATCH
;	SET FLAG WD (-) FOR FOUND SYMBOL
; CLOBBERS R0
;-

10$:	TST	(R0)+
20$:	TST	(R0)+		;ADD 2
DELENT::TST	@R0		;END OF DELETE LIST ?
	BEQ	40$		;YES
	CMP	@R1,(R0)+	;1ST WD OF SYMBOL MATCH ?
	BNE	10$		;NO, ADD 4 -> NEXT SYMBOL
	CMP	2(R1),(R0)+	;2ND WD OF SYMBOL MATCH ?
	BNE	20$		;NO
	TST	(R0)+		;SYMBOL ALREADY DELETED ?
	BMI	DELENT		;YES
	DEC	-(R0)		;IND SYMBOL DELETED
30$:	SEC			;IND A SYMBOL MATCH
40$:	RETURN

.DSABL	LSB
.SBTTL	BYTE::	 GET NEXT INPUT BYTE INTO R0

;+
;INPUT:
;	R4 -> CURRENT BUFFER POSITION
;	ENDBUF -> THE BYTE AFTER THE LAST BYTE OF THE CURRENT INPUT BUFFER
;-

.ENABL	LSB

10$:	CALL	NEWBUF		;GET ANOTHER BUFFER
BYTE::	CMP	(PC)+,R4	;END OF INPUT BUFFER?
ENDBUF:: .BLKW
	BLOS	10$		;YES
	CLR	R0		;BECAUSE OF SIGN EXTEND
	BISB	(R4)+,R0	;GET BYTE IN R0
	RETURN

.DSABL	LSB

.SBTTL	NEWBLK:: GET NEXT FORMATTED BINARY BLOCK FOR INPUT

;-
; INPUT:
;	R4 -> CURRENT BUFFER POSITION
;
; OUTPUT:
;	R4 -> 1ST DATA WORD OF NEW BLOCK
;	R5 = NUMBER OF DATA BYTES IN THE BLOCK.
;	R0 = TYPE CODE OF THE BLOCK
; DATA STRUCTURE IS: .BYTE 1,0	.WORD	<LENGTH>	.BYTE	<TYPE>,0
;-

NEWBLK::CALL	BYTE		;GET NEXT INPUT BYTE
;	TSTB	R0		;IS BYTE A 0 ?				;DBB01
	BEQ	NEWBLK		;YES, SKIP ALL NULL BYTES
	DECB	R0		;NEW BLK ST WITH A 1
	BNE	NEWBLK		;MODE ERROR, NOT FB BLOCK
	CALL	BYTE		;SKIP HIGH BYTE OF F.B.
	BNE	NEWBLK		;BRANCH IF NOT A F.B. BLOCK		;DBB01
	CALL	BYTE		;ASSEMBLE THE LENGTH WORD
	MOV	R0,R5
	SWAB	R5
	CALL	BYTE		;GET HIGH BYTE OF LENGTH
	BISB	R0,R5
	SWAB	R5
	SUB	#6,R5		;CALC CORRECTED LEN
	CALL	BYTE		;GET TYPE BYTE
	MOV	R0,-(SP)	;SAVE IT
	CALL	BYTE		;SKIP NULL BYTE(HIGH BYTE OF TYPE WD IS 0)
	MOV	(SP)+,R0	;RETURN TYPE CODE
	RETURN
.SBTTL	INIO::	 INIT 1ST INPUT FILE

;+
; INPUT:
;	R0 = START OF SAVESTATUS AREA
;-

INIO::	MOV	(PC)+,R0	;R0 -> 1ST INPUT SAVESTATUS AREA
FILPT1:: .BLKW
	CALL	NXTFIL		;SETUP 1ST FILE INFORMATION
	CALL	NEWBUF		;START READ OF 1ST BUFR
	MOV	#3,FILCNT	;INPUT FILE POSITION #
	RETURN

.SBTTL	NXTFIL:: REOPEN NEXT FILE & INIT VARIABLES

;+
; INPUT:
;	R0 = START OF SAVESTATUS AREA
; OUTPUT:
;	R0 DESTROYED
;-

NXTFIL:	MOV	R0,(PC)+	;UPDATE FILE PTR
FILPT::	 .BLKW			;PTR TO CURRENT INPUT FILE BLK
	.REOPEN	#PRAREA,#3,FILPT ;REOPEN CHAN 3
	BCS	HARDER		;CAN'T HAPPEN ****************
	CLR	CURBLK		;RESET RELATIVE BLK COUNTER
	INC	(PC)+		;USED FOR FILE POSITION SWITCH PROCESSING
FILCNT:: .WORD	3

.ENABL	LSB

10$:	RETURN

.SBTTL	SKPBLK:: SKIP FB BLOCK ON INPUT

;+
; INPUT:
;	R4 = CURRENT BUFR POSITION
;	ENDBUF = END OF CURRENT INPUT BUFFER
;	R5 = LENGTH OF BLOCK
;
; OUTPUT:
;	R4 & ENDBUF UPDATED IF REQUIRED
;     DESTROYS R0!!!
;-

SKPBLK::INC	R5		;INCLUDE CHECKSUM BYTE
20$:	ADD	R5,R4		;LENGTH TO CURRENT POSITION
	CMP	ENDBUF,R4	;GONE PAST END OF BUFR?
	BHI	10$		;NO, JUST RETURN
	MOV	R4,R5		;YES, HOW MUCH INTO NEXT BUFR
	SUB	ENDBUF,R5	;# TO PASS OVER IN NEXT BUFR
	CALL	NEWBUF		;GET MORE
	BR	20$		;TRY AGAIN

.DSABL	LSB
.SBTTL	HARDER	 READ ERROR FOR INPUT FILE

;+
;ERROR
HARDER:	ERROR$	ERR5,E$F,E$FIL	;READ ERROR IN <FILENAME>
;-

.SBTTL	CLOSE	 READ/WRITE ERROR RECOVERY

CLOSE:	BIT	SWITCH,#SW.E	;ARE WE DOING EXTRACT ?
	BEQ	10$		;NO IF 0
;+
;ERROR
	ERROR$	ERR26,E$F,E$PRT	;END-OF-FILE DURING EXTRACTION
;-

10$:	.CLOSE	#3		;CLOSE INPUT CHANNEL
	BCC	20$		;C=0 -> NO ERRORS ON CLOSE		;MAS07+
	CMPB	#PROTCT,@#$ERRBY ;IS IT A PROTECTION VIOLATION?
	BNE	20$		;NE -> NO
;+
;ERROR
	ERROR$	ERR33,E$W,E$FIL ;PROTECTION ERROR ON CLOSE
;-
20$:	MOV	FILPT,R0	;PTR TO LAST OPEN FILE			;MAS07-
	TST	-(R0)		;IS THIS THE LAST INPUT FILE ?
	BMI	ENDPAS		;YES
	SUB	#S.VSIZ-2,R0	;R0 -> NEXT FILE BLK
	CALL	NXTFIL		;INIT NEXT FILE & VARIABLES
;	BR	NEWBUF		;AND GO READ FROM NEW FILE
.SBTTL	NEWBUF:: READ NEXT INPUT BUFFER

;+
; INPUT:
;	CURBLK = RELATIVE INPUT BLK #
; WHILE PROCESSING R4 -> NEXT AVAILABLE BYTE
;	ENDBUF = END OF CURRENT BUFR(IF R4.GE.ENDBUF, BUFR IS EXHAUSTED
;
; OUTPUT:
;	R4 -> START OF INPUT BUFR
;	ENDBUF = END OF INPUT BUFR
;	CURBLK = CURBLK + IBKINC
; DESTROYS R0!!!
;-

NEWBUF::MOV	IBUF,R4		;ADDR OF BUFFER
	.READW	#IRAREA,#3	;CHAN 3
	BCC	10$		;NO ERROR
	TSTB	@#$ERRBY	;0=EOF, 1=HARDWARE, 2=CHAN NOT OPEN
	BNE	HARDER		;NOT EOF SO GIVE ERROR
10$:	ASL	R0		;WORDS READ TO BYTES READ
	BEQ	CLOSE		;IF=0 THEN EOF SO CLOSE & CONT
	ADD	R4,R0		;NOW THE END OF BUFR
	MOV	R0,ENDBUF	;UPDATE ENDBUF
	INC	CURBLK		;UPDATE REL BLK #
	RETURN

.SBTTL	-	INPUT BUFFER INFORMATION

.PSECT	IMPURE,D,GBL

; NEXT 5 WORDS MUST BE IN THIS ORDER

IRAREA:	.BLKW		;INPUT CHANNEL NUMBER AND READ CODE
CURBLK::.BLKW		;RELATIVE INPUT BLOCK NUMBER
IBUF::	.BLKW		;INPUT BUFR ADR(ALSO END OF OUTPUT BUFR)
	.WORD	256.	;WORD COUNT
	.WORD	0	;.READW INDICATOR MUST BE ZERO

.PSECT	MAIN

.SBTTL	-	END OF CURRENT INPUT PASS

ENDPAS:	TST	(SP)+		;GET RID OF RETURN ADR
	BIT	SWITCH,#SW.M	;BUILDING A MACRO LIBRARY?
	BEQ	10$		;NO
	JMP	MACEXT		;END OF MACRO INPUT, FINISH IT
10$:

.IF NE FORM$								;MAS01+
	BIT	SWITCH,#SW.F	;BUILDING A FORM LIBRARY?
	BEQ	20$		;NO
	JMP	FPASS2		;END OF PASS 1- GO TO PASS 2
.ENDC									;MAS01-
20$:	JMP	PASS2		;GO TO PASS 2 FOR OBJ LIBRARY
.SBTTL	R50ASC:: RAD50 TO ASCII CONVERSION

;+
; INPUT:
;	R1 -> ASCII CHAR OUTPUT AREA
;	R3 -> SYMBOL TO OUTPUT
;
; USAGE:
;	R2 & R0 = TEMPORARY
;	R4 -> DIVISION TABLE
;	@SP = # OF CHARACTERS TO BE OUTPUT
;
; OUTPUT:
;	R3 -> WORD AFTER 2 2D SYMBOL
;	R1 -> NEXT FREE OUTPUT BYTE
; R0 IS CLOBBERED
;-

R50ASC::MOV	R4,-(SP)	;SAVE R4 & R2
	MOV	R2,-(SP)
	MOV	#6,-(SP)	;# OF CHARS TO OUTPUT
10$:	MOV	#DIVTAB,R4	;R4 -> DIVISION TABLE
	MOV	(R3)+,R2	;R2 = CURRENT INPUT WORD
20$:	TST	-(R4)		;NEW WORD REQUIRED YET?
	BEQ	10$		;YES
	CLR	R0		;INITIALIZE QUOTIENT REG
30$:	INC	R0		;DIVIDE BY APPROPRIATE POWER OF 50(8)
	SUB	@R4,R2
	BCC	30$
	DEC	R0
	ADD	@R4,R2		;RESTORE DIVIDEND
	TST	R0		;CHARACTER IS A BLANK?
	BEQ	40$		;YES
	CMP	#33,R0		;DOLLAR SIGN, PERIOD, OR DIGIT?
	BLO	50$		;PERIOD OR DIGIT
	BEQ	60$		;DOLLAR SIGN
	ADD	#40,R0		;ELSE ALPHA (A-Z) OR QUESTION MARK
40$:	ADD	#16,R0
50$:	ADD	#11,R0
60$:	ADD	#11,R0
70$:	MOVB	R0,(R1)+	;STORE CONVERTED CHARACTER IN OUTPUT
	DEC	@SP		;LOOP FOR MORE CHARS
	BNE	20$		;YES
	TST	(SP)+		;POP CTR
	MOV	(SP)+,R2
	MOV	(SP)+,R4
	RETURN

.PSECT	DPURE,D

	.WORD	0		;END-OF-TABLE FLAG
	.WORD	1
	.WORD	50
	.WORD	3100
DIVTAB=.

.PSECT	MAIN
.SBTTL	PUTBYT:: OUTPUT A BYTE TO THE OUTPUT FILE

;+
; INPUT:
;	R1 =  THE BYTE TO OUTPUT
;
; OUTPUT:
;	R1 = SAME AS INPUT
;	R0 DESTROYED
;	A BUFFER IS WRITTEN AS REQUIRED
;-

.ENABL	LSB

PUTBYT::MOV	#OBPTR,R0	;R0 -> OUTPUT BUFR PTR
	TST	@R0		;IF 0 THEN NO OUTPUT REQUESTED
	BEQ	20$
	MOVB	R1,@(R0)+	;PUT CHAR INTO BUFR
	INC	-(R0)		;BUMP POINTER
	CMP	IBUF,@R0	;AT THE END OF BUFR?
	BHI	20$		;NO
	MOV	(PC)+,@R0	;YES, SET START OF BUFR
OBUF::	 .BLKW
	INC	-(R0)		;BUMP REL BLOCK #
	.WRITW	#OCHAN
	BCC	20$		;NO ERRORS
	TSTB	@#$ERRBY	;0=EOF, 1=HARDWARE ERROR, 2=CHANNEL NOT OPEN
	BEQ	10$
;+
;ERROR
	ERROR$	ERR23,E$F,E$PRT	;OUTPUT WRITE ERROR

10$:	ERROR$	ERR24,E$F,E$PRT	;OUTPUT FILE FULL
;-

20$:	RETURN

.DSABL	LSB

.PSECT	IMPURE,D,GBL

.SBTTL	-	PUTBYT OUTPUT .WRITW REQUEST AREA

OCHAN::	.BYTE	0	;OUTPUT CHANNEL #
	.BYTE	11	;WRITE EMT CODE
OBLK::	.BLKW		;OUTPUT BLK # (INIT TO -1 FOR BUMP BEFORE WRITE)
OBPTR::	.BLKW		;OUTPUT BUFR POINTER (0 MEANS NO OUTPUT)
	.WORD	256.	;WORD COUNT
	.WORD	0	;INDICATE WAIT FOR COMPLETION

.PSECT	MAIN

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

.END	START