.MCALL	.MODULE
.MODULE	LIBR,VERSION=12,COMMENT=<LIST DIRECTORY> IDENT=NO,MODNAME=LIBR4,GLOBAL=.LIBR4

; 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 DIRECTORY LISTING
.ENABL	GBL

; CER,MAS,JVK

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

; EDIT HISTORY:

; FIX CLEARING OF LOC 0 IF JUST LIST AND EPT=1 BLK			;MAS02
; ADD .ENTER AND .CLOSE PROTECTION VIOLATION ERROR MESSAGES		;MAS07
; FIX POINTER MAINTENACE ERROR						;JVK01
; 11	15-May-91	WFG	Update version numbers of all LIBR files
; 12	10-Oct-1996	Tim Shoppa	Fix for 4-digit years
;
.SBTTL	-	SYMBOLIC DEFINITIONS

BITPAT=	1767								;MAS10
SPACE=	40
TAB=	11
LF=	12
CR=	15

L.OLDV=	305	;OLDEST VERSION NUMBER ACCEPTABLE TO LIBRARY
RMON=	54
CONFIG=	300
BASEYR=	72.
CLK50=	40
BYTBLK=	1000	;SIZE OF 1 BLK IN BYTES


.SBTTL	-	MACRO DEFINITIONS

.MCALL	.CLOSE,.DATE,.REOPEN,.READW,.GTIM,.SETTOP

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

.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

.MACRO	LSTOUT	MSG
.IF NB MSG
  .IIF DIF <MSG>,<R2>	MOV	MSG,R2
.ENDC
	CALL	PUTMSG
.ENDM


	.WORD	6	;ERROR HANDLING INDEX WORD(IN A DATA SECTION)
			;MUST BE 1ST PHYSICAL LOCATION OF EACH OVERLAY
.PSECT	CHAR4,D

.NLIST	BEX

.SBTTL	*	VERSION IDENTIFICATION IN LISTING HEADER	*

LINE1:	.ASCII	/RT-11 LIBRARIAN /	;27. BYTES		;012
	.NLCSI	TYPE=I,PART=RLSVER	; FOR DATE
	.ASCIZ	<TAB>			;  & TIME
	.BLKB	4			;+ ANOTHER FOR NULL	;012
LINE4:	.ASCIZ	<LF>/MODULE/<TAB>
TITL4:	.ASCIZ	<TAB>/GLOBALS /

;+
; WARNING - THE FOLLOWING DAY NAMES MUST IMMEDIATELY PRECEDE
; THE MONTH NAMES. DO NOT MOVE!!!
;-

	.ASCII	/SAT SUN MON TUE WED THU FRI /
MONTHS:	.ASCII	/-JAN-FEB-MAR-APR-MAY-JUN-JUL-AUG-SEP-OCT-NOV-DEC-/

.EVEN

MONLEN:	.WORD	0-1		;JANUARY
	.WORD	31.-1		;FEBRUARY
	.WORD	59.-1		;MARCH
	.WORD	90.-1		;APRIL
	.WORD	120.-1		;MAY
	.WORD	151.-1		;JUNE
	.WORD	181.-1		;JULY
	.WORD	212.-1		;AUGUST
	.WORD	243.-1		;SEPTEMBER
	.WORD	273.-1		;OCTOBER
	.WORD	304.-1		;NOVEMBER
	.WORD	334.-1		;DECEMBER

GTIM:	.WORD	21*400
	.WORD	TIME
TIME:	.BLKW	2		;HIGH ORDER THEN LOW ORDER

.PSECT
.SBTTL	LIST::	LIBRARIAN LIST OVERLAY

; THIS OVERLAY OUTPUTS A LISTING FILE OF THE LIBRARIAN'S DIRECTORY

LIST::	MOVB	#1,OCHAN	;LIST FILE OUTPUT CHANNEL
	MOV	#-1,OBLK	;OUTPUT REL BLK # (-1 FOR BUMP BEFORE WRITE)
	MOV	OBUF,OBPTR	;OUTPUT BUFR PTR
	MOV	#LINE1,-(SP)	;ASCII TEMP BUFR USED OFTEN SO PUT "@SP"
	LSTOUT	@SP		;1ST PART OF LINE 1
	MOV	#GTIM,R0	;GET TIME BEFORE DATE TO ROLL IT OVER
	.GTIM
	.DATE			;GET DATE IN R0
	CALL	DATTIM		;OUTPUT THE CURRENT DATE & TIME OF SYSTEM
	MOV	EPTST,R4	;BUFFER ADR FOR THE EPT
	MOV	#ODBLK,R3	;R3 -> 1ST OUTPUT FILE DBLK
	TST	@R3		;WAS A LIBRARY CREATED?			;JVK01
	BNE	40$		;YES

; MAKE THE LIBRARY DIRECTORY RESIDENT IF NO LIBR OUTPUT REQUESTED

	MOV	FILPT1,R3	;R3 -> LIBRARY TO LIST WHEN NO OUTPUT LIBR
	.REOPEN	#TEMP,#3,R3	;OPEN THE LIBRARY FILE
	BCS	20$		;	*** SHOULD NOT HAPPEN ***
	.READW	#TEMP,#3,R4,#256.,#0 ;READ LIBRARY DIRECTORY
	BCS	20$
	CMP	L$HC(R4),#L.BR	;CHECK TO SEE IT THIS IS A LIBRARY?
	BNE	50$		;NO
	CMP	L$HVER(R4),#L.OLDV ;IS THIS VERSION 305 OR LATER
	BLO	50$		;NO IF LO, SO GIVE ERROR
	MOV	L$HEAB(R4),R1	;SIZE OF EPT IN BYTES (INCLUDES HEADER)
	MOV	R1,R5		;COPY OF # OF BYTES TO READ		;MAS02+
	ADD	R4,R5		;END OF EPT
	MOV	R4,R2		;COPY START ADR OB BUFR
	ADD	#BYTBLK,R2	;NEXT INPUT BUFR ADR
	SUB	#BYTBLK,R1	;REDUCE SIZE BY 1 BLK WE JUST READ
	BLE	30$		;NO MORE TO READ (ONLY 1 BLK EPT)	;MAS02-
	CMP	@#HIGH,R5	;ENOUGH ROOM TO FIT EPT IN MEMORY ?
	BHI	10$		;YES
	ERROR$	ERR3,E$F,E$PRT	;INSUFFICIENT MEMORY

10$:	ASR	R1		;NOW WORD COUNT
	.READW	#TEMP,#3,R2,R1,#1 ;READ IN REMAINDER OF EPT
	BCC	30$
20$:	ERROR$	ERR5,E$F,E$FIL	;READ ERROR IN <FILENAME>

30$:	CLR	@R5		;MARK END OF EPT
	ADD	#F.LNM,R3	;R3 -> FILENAME OF LIBRARY TO PRINT IN HDR
40$:	CMP	L$HC(R4),#L.BR	;LIBR FILE?
	BEQ	60$		;YES
50$:	ERROR$	ERR22,E$F,E$PRT	;BAD LIBRARY TO LIST

60$:	MOV	@SP,R1		;R1 -> ASCII AREA
	CALL	R50ASC		;CONVERT DDFILNMEXT TO 10. WORDS OF ASCII	;MAS10+
	CALL	R50ASC		;AND STORE SEQUENTIALLY IN MESSAGE BUFFER
	MOV	R1,R0		;COPY POINTER TO END OF MESSSAGE, AND POINT
	CMPB	(R1)+,(R1)+	;TO THE NEW END OF THE MESSAGE
	CLRB	@R1		;TO NEW END MSG. CLEAR END OF MESSAGE FLAG
	MOV	#BITPAT,R2	;MOVE A BIT PATTERN TO R2 FOR # OF MOVES
70$:	ASR	R2		;TEST FOR # MOVES FRO EXTENSION (3)
	BCC	80$		;C=0 DONE WITH THIS SET OF MOVES
	MOVB	-(R0),-(R1)	;OTHERWISE, START MOVING EXTENSION BY 2 BYTES
	BR	70$

80$:	MOVB	#'.,-(R1)	;INSET "." BETWEEN EXTENSION AND FILE NAME
90$:	ASR	R2		;TEST FOR # MOVES TO MAKE FOR FILENAME (6)
	BCC	100$		;C=0 -> DONE WITH MOVES
	MOVB	-(R0),-(R1)	;MOVE ONE CHAR OF FILENAME BY 1 BYTE
	BR	90$

100$:	MOVB	#':,-(R1)	;INSET ":" BETWEEN DEVICE AND FILENAME

; NOW COMPACT SPACES

	CMPB 	-(R1),-(R1)	;BACK UP TO 2ND CHAR OF DEVICE NAME
	MOV	R1,R0		;COPY IT (1ST CHAR IS ALSWAYS NON-ZERO)
110$:	TSTB	@R0		;AT END OF MESSAGE?
	BEQ	130$		;EQ -> YES
	CMPB	#SPACE,(R0)+	;IS IT A SPACE?
	BEQ	120$		;EQ -> YES, REMOVE FROM MESSAGE
	TSTB	(R1)+		;NON-SPACE
120$:	MOVB	@R0,@R1		;MOVE A CHAR BACK OVER A SPACE
	BR	110$

130$:	MOVB	#TAB,@R1	;SPACE OVER SO IT LOOKS NICE
	MOVB	(R1)+,@R1
	MOV	@SP,R0		;ARE WE SPACED OVER FAR ENOUGH?
 	ADD	#8.,R0		;IF THE FILE NAME IS SMALL, WE MAY NEED
	CMP	R1,R0		;ONE MORE TAB, AS LONG AS >9 CHARS ARE IN
	BHI	140$		;THE BUFFER, WE ARE OK
	MOVB	(R1)+,@R1	;OTHERWISE, ADD ANOTHER TAB
140$:	TSTB	(R1)+		;POSITION AT NEXT UNUSED SPACE		;MAS10-
	CLRB	@R1		;TERMINATE MESSAGE
	LSTOUT	@SP		;OUTPUT THE LIBRARY FILE NAME
	MOV	L$HDAT(R4),R0	;LIBR CREATION DATE & TIME
	MOV	L$HTIM(R4),TIME	;IN TIME FOR 'DATTIM' TO WORK ON IT
	MOV	L$HTIM+2(R4),TIME+2
	CALL	DATTIM
	LSTOUT	#LINE4		;MODULE HEADER
	MOVB	NUMCOL,R5	;COLUMN COUNTER
150$:	LSTOUT	#TITL4		;GLOBALS MSG
	DEC	R5		;ANY MORE COLUMNS
	BGT	150$		;YES
	MOV	#LF,R1		;PUT A NULL LINE AFTER SUBTITLES
	CALL	PUTBYT
	MOV	EPTST,R3	;START OF ENTRY POINT TABLE
	ADD	#L$HEPT,R3	;R3 -> 1ST ENTRY SYMBOL
	CLR	COBDEF		;USED FOR PREVIOUS MOD BLK # LISTED
				; TO DETERMINE WHEN A NEW MODULE IS FOUND
	BR	210$		;ENTER MODULE NAME & GLOBAL LOOP

;+
; DETERMINE WHEN A NEW MODULE STARTS BY A CHANGE IN THE BLOCK #
; & THE BYTE DISPLACEMENT SINCE MODULE NAMES MAY NOT BE INCLUDED.
;-

160$:	MOV	E$PBLK(R3),R4	;BLK # OF NEXT ENTRY
	ASL	R4		;GET RID OF BIT 15
	CMP	COBDEF,R4	;NEW BLK # .GT. PREVIOUS ?
	BLO	170$		;YES
	CMP	E$PBYT(R3),BYTDIS ;BYTE OFFSET NEW ?
	BEQ	180$		;STILL PROCESSING THE SAME MODULE

; START OF A NEW MODULE ENTRIES

170$:	MOV	R4,COBDEF	;UPDATE BLK #
	MOV	E$PBYT(R3),BYTDIS ;UPDATE BYTE DISP
	MOVB	#CR,(R1)+	;START A NEW LINE
	MOVB	#LF,(R1)+
	MOVB	NUMCOL,R5	;COLUMN CTR
	TST	E$PBLK(R3)	;MODULE NAME ?
	BPL	190$		;NO, 1ST NEW SYMBOL IS A GLOBAL
	INC	R5		;ONE MORE COL WHEN LINE STARTS WITH MOD NAME
	BR	200$

180$:	DECB	R5		;NEXT LINE ?
	BGT	190$		;NO
	MOVB	#CR,(R1)+
	MOVB	#LF,(R1)+
	MOVB	#'+,(R1)+	;CONTINUATION OF A MOD WHEN NAMES NOT PRINTED
	MOVB	NUMCOL,R5
190$:	MOVB	#TAB,@R1	;2 TABS IN FRONT OF EACH SYSBOL
	MOVB	(R1)+,(R1)+
200$:	CALL	R50ASC		;UNPACK THE SYMBOL NAME
	CMP	(R3)+,(R3)+	;R3 -> NEXT EPT ENTRY
	CLRB	@R1		;TERMINATE MSG
	LSTOUT	@SP
210$:	MOV	@SP,R1		;R1 -> START OF ASCII AREA
	TST	@R3		;END OF EPT ?
	BNE	160$		;NO
	MOVB	#CR,(R1)+	;CLEAN UP THE OUTPUT AT THE END
	MOVB	#LF,(R1)+
	CLRB	@R1		;TERMINATE MESSAGE
	LSTOUT	(SP)+
	CLR	R1		;ZERO THE REMAINDER OF THE BUFR
	MOV	#511.,R5	; TO FORCE THE LAST BLOCK OUT
220$:	CALL	PUTBYT
	SOB	R5,220$
	.SETTOP	FILPT1		;JUST ABOVE HANDLERSS FOR LESS SWAPPING
	.CLOSE	#0		;CLOSE THE LIBRARY FILE IF ANY
	BCC	230$		;C=0 NO ERROR ON CLOSE			;MAS07+
	CMPB	#PROTCT,@#ERRBYT ;PROTECTION ERROR?
	BNE	230$		;NE -> NO
	MOV	#ODBLK,R0	;POINT AT FILE NAME
	ERROR$	ERR33,E$W,E$FIL,R0 ;PROTECTION ERROR
230$:	.CLOSE	#1		;CLOSE THE LISTING FILE
	BCC	240$		;C=0 -> NO ERROR ON COLSSE
	CMPB	#PROTCT,@#ERRBYT ;PROTECTION VIOLATION?
	BNE	240$		;NE -> NO
	MOV	#ODBLK+10.,R0	;POINT AT FILE NAME
	ERROR$ ERR33,E$W,E$FIL,R0 ;PROTECTION VIOLATION ON CLOSE
240$:	JMP	REENTR		;ALL DONE SO RESTART			;MAS07-
.SBTTL	DATTIM	CONVERT DATE & TIME TO ASCII STRING

;+
; INPUT:
;	R0 = DATE WORD
;	THE TIME IS LOCATED AT "TIME"
; CLOBBERS R0 - R5
;-

DATTIM:	MOV	#LINE1,R1	;R1 -> OUTPUT AREA
	MOV	R0,R5		;COPY IT
	MOV	R0,R2		;AND AGAIN
	BEQ	40$		;WHOOPS! NO DATE!
	ASL	R5		;ISOLATE DAY IN R5
	ASL	R5
	ASL	R5
	SWAB	R5
	BIC	#^C<37>,R5	;R5 = DAY
	ASR	R2		;ISOLATE MONTH IN R2
	SWAB	R2
	MOV	R2,R3
	BIC	#^C<17*2>,R2	;R2 = <MONTH*2>				;012
	BIC	#^C<140>,R3	;ISOLATE AGE*32 IN R3			;012
	BIC	#^C<37>,R0	;AND YEAR IN R0				;012
	ADD	R3,R0		;NOW AGE*32.+YEAR IN R0			;012
	SUB	#2,R2		;GET R2=<MONTH*2> -2
	MOV	R0,-(SP)	;STACK YEAR FOR DATE PRINTING
	ADD	#BASEYR,@SP
	MOV	R2,-(SP)	;LIKEWISE FOR MONTH
	MOV	R5,-(SP)	;AND DAY

;+
; AT THIS POINT, R0=YEAR - 1972, R5=DAY, R2=<MONTH*2>-2
; WE NOW COMPUTE THE DAY-OF-THE-WEEK.
;-

	MOV	R0,-(SP)	;SAVE YEAR
	DEC	R0		;MAKE LEAP YEAR CORRECTION
	ASR	R0
	ASR	R0
	ADD	@SP,R0
	INC	R0
	ADD	R0,R5		;ACCUMULATE DAY
	BIT	#3,(SP)+	;LEAP YEAR?
	BNE	10$		;NOPE - SKIP CORRECTION
	CMP	#2*1,R2		;AFTER FEBRUARY?
	ADC	R5		;CORRECT IF SO
10$:	ADD	MONLEN(R2),R5	;ADD IN DAYS FROM PREVIOUS MONTHS
20$:	SUB	#7,R5		;CHEAPO MODULO 7
	BPL	20$
	ASL	R5		;*4 FOR TABLE INDEX
	ASL	R5
	ADD	#MONTHS,R5	;POINTS INTO TABLE
	MOVB	(R5)+,(R1)+	;COPY NAME OF DAY
	MOVB	(R5)+,(R1)+
	MOVB	(R5)+,(R1)+
	MOVB	(R5)+,(R1)+
	MOV	(SP)+,R0	;CONVERT DAY
	CALL	CVT2
	MOV	(SP)+,R0	;GET <MONTH*2>-2
	ASL	R0		;  <MONTH*4>-4
	ADD	#MONTHS,R0
	MOVB	(R0)+,(R1)+	;MOVE MONTH INTO OUTPUT AREA
	MOVB	(R0)+,(R1)+
	MOVB	(R0)+,(R1)+
	MOVB	(R0)+,(R1)+
	MOVB	(R0)+,(R1)+
	MOV	(SP)+,R3	;GET YEAR				;012
	MOV	#19.,R0		;ASSUME 19XX				;012
	CMP	R3,#100.	;UNLESS YEAR .GE. 100			;012
	BLO	24$		;ONLY IF YEAR WAS .GE. 100		;012
	INC	R0		;THEN IT IS 20XX			;012
	SUB	#100.,R3	;AND HAVE TO SUBTRACT 100 FROM YEAR	;012
24$:	CALL 	CVT2		;CONVERT FIRST TWO DIGS TO ASCII	;012
	MOV	R3,R0		;AND THEN SECOND TWO DIGS		;012
	CALL 	CVT2		;TO ASCII				;012
	MOVB	#SPACE,(R1)+	;LEAVE A BLANK AFTER DATE
	MOV	TIME,R4		;(R4,R5) = TIME OF DAY
	MOV	TIME+2,R5	;  IN TICKS PAST MIDNIGHT
	MOV	@#RMON,R0	;POINT AT RMON
	TST	CONFIG(R0)	;KW11L CLOCK PRESENT?
	BPL	40$		;NOPE - NO TIME TO OUTPUT
	MOV	#50.,R3		;ASSUME 50 CYCLE CLOCK
	BIT	CONFIG(R0),#CLK50 ;50 OR 60 CYCLE?
	BNE	30$		;50 CYCLE IS RIGHT
	MOV	#60.,R3		;ELSE 60 CYCLES PER SECOND
30$:	CALL	DIV		;DISCARD TICKS
	CALL	DIV60		;R0 = SECONDS
	MOV	R0,-(SP)
	CALL	DIV60		;R0 = MINUTES
	MOV	R0,-(SP)
	CALL	DIV60		;R0 = HOURS
	CALL	CVT2		;CONVERT HOURS TO ASCII
	MOVB	#':,(R1)+	;PLUS SEPARATOR
	MOV	(SP)+,R0	;GET MINUTES
	CALL	CVT2		;AND CONVERT TO ASCII
	MOVB	#':,(R1)+	;AND SEPARATOR
	MOV	(SP)+,R0	;GET SECONDS
	CALL	CVT2		;AND CONVERT THEM
40$:	MOVB	#CR,(R1)+	;END THE LINE WITH CR & LF
	MOVB	#LF,(R1)+
	CLRB	@R1		;TERMINATE MESSAGE
	LSTOUT	#LINE1		;OUTPUT DATE & TIME
	RETURN
.SBTTL	PUTMSG	OUTPUT AN ASCIZ MESSAGE

;+
; INPUT:
;	R2 = ADR OF ASCIZ MESSAGE
;
; OUTPUT:
;	R2 -> BEYOND END OF MESSAGE
;	R1 = 0 (MESSAGE TERMINATOR)
;	CLOBBERS R0
;-

.ENABL	LSB

10$:	CALL	PUTBYT		;OUTPUT THIS BYTE
PUTMSG:	MOVB	(R2)+,R1	;GET A BYTE
	BNE	10$		;RETURN IF 0
	RETURN

.DSABL	LSB

.SBTTL	CVT2	DECIMAL OUTPUT CONVERSION

;+
; INPUT:
;	R0 = DECIMAL NUMBER
;	R1 -> ASCII OUTPUT AREA
;
; OUTPUT:
;	R0 & R2 ARE DESTROYED
;	R1 -> NEXT FREE CHARACTER LOCATION
;-

.ENABL	LSB

CVT2:	MOV	#DIVTBL,R2	;SET UP FOR TWO DIGITS
10$:	MOV	#'0-1,-(SP)	;FORM DIGIT IN @SP
20$:	INC	@SP
	SUB	@R2,R0		;SUBTRACT DIVISOR
	BHIS	20$
	ADD	(R2)+,R0	;RE-ADD THE DIVISOR
	MOVB	(SP)+,(R1)+	;CONVERTED CHARACTER
	TST	@R2		;DONE?
	BNE	10$		;NO, DO NEXT DIGIT
	RETURN

.DSABL	LSB

DIVTBL:	.WORD	10.
	.WORD	1
	.WORD	0

.SBTTL	DIV	DIVIDES NUMBER IN (R4,R5) BY R3, RETURNING REMAINDER IN R0

DIV60:	MOV	#60.,R3		;DIVIDE BY 60
DIV:	CLR	R0		;INIT REMAINDER
	MOV	#32.,-(SP)	;SHIFT COUNT (16. FOR S.P.)
10$:	ASL	R5		;SHIFT AND SUBTRACT
	ROL	R4		;(NOT NEEDED FOR S.P.)
	ROL	R0
	CMP	R0,R3		;SUB OUT DIVISOR ?
	BLO	20$		;NO
	SUB	R3,R0
	INC	R5		;ADD IN LOW BIT
20$:	DEC	@SP		;REPEAT COUNT
	BNE	10$
	TST	(SP)+		;POP SHIFT COUNT
	RETURN

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

OV4DUM::RTS	R5

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

.END