Google
 

Trailing-Edge - PDP-10 Archives - ap-c796e-sb - lnklog.mac
There are 48 other files named lnklog.mac in the archive. Click here to see a list.
TITLE	LNKLOG - LOG/ERROR MODULE FOR LINK
SUBTTL	D.M.NIXON/DMN/JLd/JNG	27-Feb-78

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

ENTRY	LNKLOG
SEARCH	LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC
EXTERN	.TYOCH,LNKSCN,LNKERR



CUSTVR==0		;CUSTOMER VERSION
DECVER==4		;DEC VERSION
DECMVR==0		;DEC MINOR VERSION
DECEVR==765		;DEC EDIT VERSION




SEGMENT

;USES T1-T4 ONLY (PLUS PUSHDOWN STACK)

;CALLING SEQUENCE GENERATED BY .ERR. MACRO
;SEE LNKPAR FOR DETAILS

SUBTTL	REVISION HISTORY

;START OF VERSION 1A
;64	MAKE LNK999 BE USEFUL
;71	MAKE CONTINUE MESSAGE STANDARD FORM
;103	SAVE BOTH HALVES OF FL ON EDITED LOOKUP ERROR

;START OF VERSION 2
;135	ADD OVERLAY CAPABILITY
;146	(12860) MAKE S%E ENTER ERRORS FATAL (S%F)

;START OF VERSION 2B
;277	Don't clobber stack contents on editable error
;420	Always output a "[" when expected to.
;434	Don't clear OFFSET and OSCANF when doing an edit.

;START OF VERSION 2C
;464	Make .TEBLK internal for LNKLOG.
;473	Delete all .TMP files before exiting on a fatal error.
;557	Clean up the listing for release.

;START OF VERSION 3A
;560	Release on both TOPS-10 and TOPS-20 as LINK version 3A(560)

;START OF VERSION 4
;564	Make LINK assemble with MACRO 52.
;605	Use OUTSTR's to TTY whenever possible.
;625	Support .EB (Print blank line in log)
;634	Never delete input file on a fatal error.
;637	Always print the continuation error message in batch jobs.
;650	Use VM on TOPS-10 if available.
;657	Setup IO.EMG before deleting temp files on an error.
;731	SEARCH MACTEN,UUOSYM
;765	Release on both TOPS-10 and TOPS-20 as LINK version 4(765)
SUBTTL	ENTER HERE FROM LINK-10 
;UUO TYPE IS IN AC T1

IFN FTSINGLE,<
%%UUO::	PORTAL	LNKLOG		;ENTRY FROM UUO
>
LNKLOG:	MOVEM	P1,SAVEAC+P1	;SAVE P1
	MOVE	P1,[T2,,SAVEAC+T2]
	BLT	P1,SAVEAC+T4	;AND REST OF ACCS
	MOVE	P1,@UUOTRAP	;GET FIRST ERROR ARG
	JUMPGE	P1,@TYPTAB(T1)	;GO TO REQUIRED FUNCTION
	MOVE	P1,@P1		;GET A VALID ARG
	JUMPL	P1,.-1		;EVENTUALLY
	JRST	@TYPTAB(T1)

DEFINE XXX (TYPE) <
	EXP	ER.'TYPE
>

TYPTAB:	ERRTYPE

SALL
;ENTRY POINT FOR ASCII STRING
;CALLED BY
;	ERRUOO	MS
;	ARGS

ER.MS:	PUSHJ	P,CHKLVL	;OUTPUT %,? OR TIME STAMP ETC
	  JRST	NOERR		;NOTHING TO OUTPUT
	MOVE	T1,VERLVL	;GET VERBOSITY LEVEL
	SOJE	T1,ERRLV1	;END NOW IF /VER:SHORT
	HRRZ	T1,P1		;ADDRESS OF MESSAGE STRING
	OUTVIA	.TSTRG##	;OUTPUT MESSAGE
ERRNXT:	TXNN	P1,.EC		;MORE TO DO?
	JRST	ERRFIN		;NO, END LINE
	LDB	T1,BTHPTR	;GET SEVERITY AND VERBOSITY
	AOS	UUOTRAP		;ADVANCE RETURN POINTER
	MOVE	P1,@UUOTRAP	;GET ADDRESS OF OUTPUT INFO
	DPB	T1,BTHPTR	;STORE SEVERITY AGAIN
	TRNN	P1,-1		;IF ZERO , ITS ON THE STACK
	PUSHJ	P,UNSTCK	;GET IT
	HRRZ	T1,P1		;GET VALUE
	TXNN	P1,.EP		;ONLY A POINTER?
	JRST	.+4		;NO, ALL SET
	CAIG	T1,P1		;IS IT ONE OF THE SAVED ONES?
	SKIPA	T1,SAVEAC(T1)	;YES, GET FROM SAVED SET
	MOVE	T1,(T1)		;NO, GET REAL VALUE
	LDB	T2,LVLPTR	;GET TYPE
	JRST	@ER.TAB(T2)	;DO CORRECT FUNCTION

ERRFIN:	MOVE	T1,VERLVL	;GET WHAT USER WANTS
	CAIGE	T1,V%L		;DOES HE WANT LONG?
	JRST	ERRFN0		;NO
	LDB	T1,VERPTR	;GET VERBOSITY LEVEL POSSIBLE
	CAIL	T1,V%L		;POSSIBLE TO HAVE MORE
	JRST	LNKERR##	;GO TO LONG ERROR MODULE
ER.FIN::			;RETURN HERE, IN OTHER SEGMENT
ERRFN0:	LDB	T2,SEVPTR	;GET SEVERITY
	MOVEI	T1,"]"		;INFO ENDS WITH "]"
	CAIL	T2,S%W		;WAS IT
	JRST	ERRFN2		;NO, DID NOT TYPE MESSAGE
	SKIPN	LOGTTY		;TTY BUT NOT LOG OUTPUT
	SKIPG	LOGSUB		;OR TTY AND LOG
	  SKIPA			;YES, IT IS ONE
	JRST	ERRFN2		;NEITHER CASE
	SKIPL	LOGSUB		;DO WE POINT TO TTY OR LOG DEV?
	JRST	ERRFN1		;POINTS TO TTY
	PUSH	P,[ERRFN1]	;CPOPJ RETURN, USUALLY CPOPJ1
	PUSH	P,T1		;SAVE CHARACTER
	PJRST	TTYSET		;OUTPUT ON TTY ONLY BUT RESET LOG DEV
ERRFN1:	PUSHJ	P,.TCHAR##	;YES
ERRFN2:	OUTVIA	.TCRLF##	;END WITH CR-LF
	TXNE	P1,.EB		;BLANK LINE NEEDED?
	SKIPN	LOGSUB		;YES, BUT HAVE A LOG FILE?
	  CAIA			;NO TO EITHER
	PUSHJ	P,.TCRLF##	;YES, BLANK LINE IN LOG ONLY
;HERE WHEN THE MESSAGE HAS BEEN TYPED. SHOULD WE CONTINUE?

ERRET:	LDB	T1,SEVPTR	;GET ERROR SEVERITY
	CAML	T1,SEVLVL	;OK TO CONTINUE?
	JRST	ERXIT		;NO
	HRRZS	LOGSUB		;CLEAR FLAG
	CAIL	T1,S%E		;DO WE NEED TO EDIT THIS ERROR FIRST
	JRST	EDITER		;YES, FATAL  IF WE DON'T
	MOVE	P1,SAVEAC+P1	;RESTORE P1
	SKIPG	T1,LOGTTY	;NEED TO RESTORE LOG SUB?
	JRST	RPOPJ1		;NO
	PUSHJ	P,.TYOCH	;YES,
	SETZM	LOGTTY		;[605] BACK TO 0
RPOPJ1:	AOS	UUOTRAP
RPOPJ:	JRST	.RPOPJ##	;RETUTN TO CPOPJ

;HERE WHEN LOG FILE GETS ERROR
;FINISH ORIGINAL MESSAGE THEN OUTPUT LOG ERROR MESSAGE

REPEAT 0,<			;NOT YET WORKING
ERRLOG:	POP	P,T1		;GET RETURN OFF STACK
	PUSH	P,UUOTRAP	;SAVE REAL RETURN ADDRESS
	PUSH	P,T1		;STACK RETURN
	MOVEI	T1,LOGERR-1	;FAKE RETURN
	HRRM	T1,UUOTRAP	;SO WE CAN TYPE 2ND MESSAGE
	POPJ	P,		;IF NOTHING MORE IMPORTANT OCCURS

LOGERR:	PUSH	P,[RC]		;CHAN#
	.ERR.	(ST,0,V%M,L%W,S%W,OEL,<Output error on LOG file, file closed, job continuing.>)
	POP	P,T1		;GET ORIGINAL RETURN
	JRSTF	@T1		;RETURN
>;END OF REPEAT 0
;HERE TO "EDIT" THE ERRONEOUS FILE SPEC
;STORE CURRENT STRING IN F.EDIT
;AND GO TO SCAN

EDITER:	MOVEI	T2,1		;GET A WORD TO HOLD FL
	PUSHJ	P,DY.GET##
	MOVEM	FL,(T1)		;SO WE CAN RESTORE LATER
	HRL	T1,F.INZR	;GET THIS FILE SPEC
	MOVSM	T1,F.EDIT	;STORE IT
	SETZM	F.INZR		;CLEAR ALL TRACES
	SETZM	F.NXZR		;SO SCAN THINKS ITS A NEW LINE
	OUTSTR	EDTMES		;WARN USER WHAT TO EXPECT
	SKIPG	T1,LOGTTY	;NEED TO RESTORE LOG SUB?
	JRST	LNKSCN		;NO
	PUSHJ	P,.TYOCH	;YES,
	SETZM	LOGTTY		;[605] BACK TO 0
	JRST	LNKSCN		;SCAN NEW LINE

EDTMES:	ASCIZ	\[	Please retype the incorrect parts of the file specification]
\

ERXIT:	MOVEI	T1,FINMES	;TELL USER WE CLOSED FILE
	SKIPE	LOGSUB		;BUT ONLY ON LOG FILE
	PUSHJ	P,.TSTRG##
	RELEASE	RC,		;CLOSE LOG FILE
	RELEASE	DC,		;[634] CLOSE REL FILE (DON'T DELETE)
	PUSH	P,P1		;SAVE A PERM AC
	MOVSI	P1,-20		;SETUP TO SCAN ALL CHANNELS
ERXIT1:	HRRZ	T1,P1		;GET THIS CHANNEL NUMBER
	DEVCHR	T1,		;FIND OUT ABOUT THE ASSOCIATED DEV
	JUMPE	T1,ERXIT2	;FORGET IT IF NONE
	MOVE	T1,IO.PTR(P1)	;SOMETHING THERE, GET IO BLOCK
	HRRZM	T1,IO.EMG	;[657] USE SAME BLOCK IN DVDEL.
	HLRZ	T1,I.EXT(T1)	;GET THE FILE EXTENSION
	CAIE	T1,'TMP'	;ONLY DELETE .TMP FILES
	JRST	ERXIT2		;NOT USER'S INPUT REL FILE ETC.
	HRRZ	T1,P1		;GOT ONE! GET I/O CHANNEL
	PUSHJ	P,DVDEL.##	;DELETE IT
	  JFCL			;IGNORE FAILURE
ERXIT2:	AOBJN	P1,ERXIT1	;LOOP OVER ALL CHANNELS
	POP	P,P1		;RESTORE PERM AC
	MOVEI	T1,V%L		;GET MAX VERBOSITY
	LDB	T2,VERPTR	;AND POSSIBLE MESSAGE VERBOSITY
	CAMLE	T1,VERLVL	;IF ALREADY SEEN IT ALL
	CAIGE	T2,V%L		;OR NOTHING MORE
	EXIT
	MOVEM	T1,VERLVL	;FAKE /VER:LONG
	SETZM	LOGSUB		;FORGET LOG DEVICE
	SETZM	LOGTTY
	MOVE	T1,HIORGN	;[650] SEE WHO CALLED
	HRRZ	T1,.JBHNM(T1)	;[650]
	CAIN	T1,'999'	;[650] SOME FLAVOR OF XXX999?
	EXIT			;GIVE UP, GETSEG WILL FAIL ETC.
	MOVE	T1,TTYSUB	;MAKE SURE WE POINT TO TTY
	PUSHJ	P,.TYOCH##
	CLRBFI			;[637] CLEAR JUNK
	SKIPE	BATCH		;[637] CAN USER TYPE CONTINUE?
	JRST	LNKERR##	;[637] NO, GIVE HIM THE MESSAGE FOR FREE
	OUTSTR	[ASCIZ	\[	Type CONTINUE for more information]\]
	EXIT	1,		;MONRET
	JRST	LNKERR##	;SO CONTINUE WILL GET REST OF TEXT

FINMES:	.ASCIZ	<	[END OF LOG FILE]
>

NOERR:	TXNN	P1,.EC		;MORE TO DO?
	JRST	ERRET		;NO, END LINE
	LDB	T1,SEVPTR	;GET SEVERITY
	AOS	UUOTRAP		;ADVANCE RETURN POINTER
	MOVE	P1,@UUOTRAP	;GET ADDRESS OF OUTPUT INFO
	DPB	T1,SEVPTR	;STORE SEVERITY AGAIN
	TRNN	P1,-1		;IF ZERO , ITS ON THE STACK
	PUSHJ	P,UNSTCK	;GET IT
	JRST	NOERR		;SEE IF END

;HERE IF /VER:SHORT
;WE MUST REMOVE ALL ITEMS FROM STACK
;SET SEVERITY LEVEL
;AND CLOSE OPEN ] ETC

ERRLV1:	TXNN	P1,.EC		;MORE TO DO?
	JRST	ERRFN0		;NO, END LINE
	LDB	T1,SEVPTR	;GET SEVERITY
	AOS	UUOTRAP		;ADVANCE RETURN POINTER
	MOVE	P1,@UUOTRAP	;GET ADDRESS OF OUTPUT INFO
	DPB	T1,SEVPTR	;STORE SEVERITY AGAIN
	TRNN	P1,-1		;IF ZERO , ITS ON THE STACK
	PUSHJ	P,UNSTCK	;GET IT
	JRST	ERRLV1		;SEE IF END
;HERE FOR LOOKUP/ENTER/RENAME ERROR

;CALLED BY
;	PUSH	P,[CHAN#]
;	ERRUUO	LRE
;	ARGS

ER.LRE:	MOVE	T4,0(P)		;GET CHAN#
	TLNE	P1,(77B<B%SEV>)	;DO WE HAVE SEVERITY?
	JRST	ERLRE2		;YES
	MOVE	T2,IO.PTR(T4)	;GET I/O BLOCK
	HRRE	T2,I.EXT(T2)	;GET ERROR CODE
	CAILE	T2,LRELEN	;IN RANGE?
	MOVEI	T2,LRELEN	;NO, USE DEFAULT VALUE
	HLRZ	T3,LRETAB(T2)	;PICKUP LVL FOR THIS MESSAGE
	TLNE	T4,(%ENT)	;ENTER HAS SPECIAL MESSAGES
	SKIPLE	T2		;CHANGE IF 0 OR -1
	CAIA			;NOT SPECIAL
	HLRZ	T3,ENTAB(T2)	;GET RIGHT MESSAGE
	DPB	T3,[POINT 12,P1,B%LVL]	;STORE SEV AND LEVEL
	LDB	T3,SEVPTR	;GET SEVERITY
	TXNE	T4,%ENT		;IF ENTER UUO
	CAIE	T3,S%E		;AND MARKED AS EDITABLE
	JRST	ERLRE2		;NO
	TLO	P1,(<S%F>B<B%SEV>)	;MARK AS FATAL
ERLRE2:	PUSHJ	P,CHKCHN	;IF EDITABLE, SEE IF FATAL
	PUSHJ	P,CHKLVL	;OUTPUT TIME ETC
	  JRST	ERRET1		;NOTHING TO DO
	HRRZ	T1,P1		;ADDRESS OF MESSAGE
	OUTVIA	.TSTRG##	;OUTPUT ON TTY AND/OR LOG
	POP	P,T4		;RESTORE CHAN PLUS FLAGS
IFE FTSINGLE,<
	JUMPE	T4,ERGSEG	;GETSEG ERROR IF CHAN# 0
>
;NOW TYPE APPROPRIATE MESSAGE FOR ERROR CODE

	HRR	P1,IO.PTR(T4)	;GET POINTER TO I/O BLOCK
	HRRE	T2,I.EXT(P1)	;GET ERROR CODE
	CAILE	T2,LRELEN	;DO WE KNOW ABOUT IT?
	PUSHJ	P,ERLDEF	;NO SETUP DEFAULT
	SKIPGE	T1,T2		;BUT IF NEGATIVE
	ANDI	T1,<BYTE (7) 0,0,0,177,177 (1) 1>
	IORM	T1,ERRCOD	;STORE TABLE INDEX
	HRRZ	T1,LRETAB(T2)	;GET MESSAGE
	TLNE	T4,(%ENT)	;SPECIAL IF ENTER
	SKIPLE	T2		;AND 0 OR -1
	CAIA
	HRRZ	T1,ENTAB(T2)	;GET RIGHT MESSAGE
	OUTVIA	.TSTRG##	;OUTPUT IT
ERLRE3:	HRRZ	T1,P1		;POINT TO SCAN BLOCK
ERFSPC:	OUTVIA	.TEBLK		;OUTPUT LOOKUP BLOCK
	JRST	ERRFIN		;RETURN

ERRET1:	POP	P,T1		;REMOVE CHAN#
	JRST	ERRET		;AND RETURN


IFE FTSINGLE,<
ERGSEG:	HRRZ	T2,SEGBLK+2	;GET ERROR CODE
	CAILE	T2,LRELEN	;RANGE CHECK
	PUSHJ	P,ERLDEF	;NO SETUP DEFAULT
	HRRZ	T1,LRETAB(T2)	;GET MESSAGE
	OUTVIA	.TSTRG##
	HRRZI	T1,SEGBLK	;POINT TO GETSEG BLOCK
	OUTVIA	.TSBLK		;OUTPUT SEGMENT BLOCK
	JRST	ERRFIN
>;END IFE FTSINGLE

ERLDEF:	PUSH	P,T2		;SAVE ERROR CODE
	MOVEI	T1,"("
	OUTVIA	.TCHAR##
	POP	P,T1
	OUTVIA	.TOCTW
	MOVEI	T2,LRELEN	;USE DEFAULT
	POPJ	P,
;INIT/OPEN ERROR
;CALLED BY
;	PUSH	P,[CHAN#]
;	ERRUUO	I
;	ARGS

ER.I:	PUSHJ	P,CHKLVL	;OUTPUT % OR ?
	  JRST	ERRET1		;NOTHING TO DO
	HRRZ	T1,P1		;GET MESSAGE
	OUTVIA	.TSTRG##
	POP	P,T4		;GET CHAN#
	PUSHJ	P,CHKCHN	;SETUP CHAN# IF EDITABLE
	HRRZ	T4,IO.PTR(T4)	;GET IO POINTER
	MOVE	T1,I.DEV(T4)
	SETZM	I.DEV(T4)	;DELETE IT INCASE TRYING TO RECOVER
	OUTVIA	.TSIXN##	;DEVICE
	OUTVIA	.TCOLN##
	JRST	ERRFIN		;RETURN OR EXIT


;STATUS CHECK ERRORS
;CALLED BY
;	PUSH	P,[CHAN#]
;	ERRUUO	ST
;	ARGS

ER.ST:	PUSHJ	P,CHKLVL	;OUTPUT % OR ?
	  PJRST	ERRET1		;NOTHING TO DO
	HRRZ	T1,P1		;GET MESSAGE
	OUTVIA	.TSTRG##
	MOVEI	T1,[ASCIZ \ STATUS \]
	OUTVIA	.TSTRG##
	HRLZ	T1,(P)		;GET CHAN#
	LSH	T1,5		;PUT IN AC FIELD
	IOR	T1,[GETSTS T1]	;FORM INST
	XCT	T1		;DO IT
	HRRZ	T1,T1
	OUTVIA	.TOEP##		;(XXXXXX)
	MOVEI	T1,[ASCIZ \ FOR \]
	OUTVIA	.TSTRG##
	POP	P,T4		;GET CHAN#
	PUSHJ	P,CHKCHN	;SETUP CHAN# IF EDITABLE
	HRRZ	T1,IO.PTR(T4)	;GET IO POINTER
	JRST	ERFSPC		;REST OF FILE SPEC


;INPUT CHAN CHECK
;CALLED BY
;	MOVE	T4,CHAN#
;	PUSHJ	P,CHKCHN

CHKCHN:	HRRZ	T4,T4		;CHAN # ONLY
	LDB	T1,SEVPTR	;GET SEVERITY
	CAIN	T1,S%E		;EDITABLE?
	CAIN	T4,DC		;BUT ONLY IF INPUT
	POPJ	P,		;YES
	MOVEI	T1,S%F		;NOT EDITABLE YET
	DPB	T1,SEVPTR	;SO MAKE FATAL
	POPJ	P,
SUBTTL	CONTINUATION DISPATCH

DEFINE	XXX (TYPE)<
	EXP	ER'TYPE
>
	XALL
ER.TAB:	ETCTYPE		;GENERATE DISPATCHES
ERLEN==.-ER.TAB		;LENGTH OF TABLE
	SALL

;ASCII LINE
ERSTR:	OUTVIA	.TSTRG##
	JRST	ERRNXT		;SEE IF MORE

ERSBX:	OUTVIA	.TSIXN##
	JRST	ERRNXT

EROCT:	OUTVIA	.TOCTW##
	JRST	ERRNXT

ERDEC:	OUTVIA	.TDECW##
	JRST	ERRNXT

;FILE SPECS
ERFSP:	HRR	P1,IO.PTR(P1)	;GET ADDRESS
	HRRZ	T1,P1		;PTR IN T1
	OUTVIA	.TEBLK
	JRST	ERRNXT

;ASCII CHARACTER
ERASC:	OUTVIA	.TCHAR##
	JRST	ERRNXT


;CORE ARG EITHER K OR P (DECIMAL)
ERCOR:	ADDI	T1,1		;ROUND UP TO 1000 OR 2000
IFE TOPS20,<
	MOVE	T2,.PGSIZ	;GET PAGE SIZE
	CAIE	T2,777		;P OR K
	JRST	[MOVEI	T2,"K"		;K
		LSH	T1,-^D10	;CONVERT TO K
		JRST	ERCOR1]
>;END IFE TOPS20
	MOVEI	T2,"P"		;PAGES
	LSH	T1,-9		;GET INTO PAGES
ERCOR1:	PUSH	P,T2		;SAVE CHAR
	OUTVIA	.TDECW##	;DECIMAL NUMBER
	POP	P,T1		;AND LETTER
	OUTVIA	.TCHAR##
	JRST	ERRNXT

;GOTO WORD
ERJMP:	SUBI	P1,1		;BACKUP SO AOS WILL GET RIGHT LOC
	HRRM	P1,UUOTRAP	;STORE GOTO ADDRESS
	JRST	ERRNXT

;RELATIVE POINTER TO TRIPLET(S) IN LS AREA


IFN .NWBLK,<
ERLSP:	SUB	T1,LW.LS	;CONVERT TO OFFSET FROM LS.LB
	JUMPL	T1,[HALT]	;ALREADY PAGED OUT
	ADD	T1,LS.LB	;CONVERT TO PHYSICAL ADDRESS
	HRR	P1,T1		;USE RH(P1) AS PHYSICAL POINTER
	MOVE	T1,1(P1)	;GET 1ST 6 CHARS
	OUTVIA	.TSIXN##	;TYPE THEM
	SKIPL	T1,(P1)		;WAS THIS A PRIMARY TRIPLET?
	HALT			;NO, ERROR
	TXNN	T1,PT.EXT	;EXTENDED TRIPLET?
	  JRST	ERRNXT		;NO, FINISHED
ERLSP1:	ADDI	P1,3		;POINT TO NEXT TRIPLET
	SKIPL	T1,(P1)		;SECONDARY?
	TXNE	T1,<-1B17>&<^-S.TTL>	;AND STILL IN NAME TRIPLETS?
	JRST	ERRNXT		;NO, QUIT
	MOVE	T1,1(P1)	;GET 1ST SIX CHARS
	OUTVIA	.TSIXN##	;TYPE THEM
	SKIPN	T1,2(P1)	;ANY MORE?
	JRST	ERRNXT		;NO, QUIT
	OUTVIA	.TSIXN##	;YES, TYPE THEM TOO
	JRST	ERLSP1		;LOOP FOR ALL SECONDARY TRIPLETS

> ;END IFN .NWBLK

SUBTTL	USEFUL SUBROUTINES

;ROUTINE CHKLVL - CHECKS THE MESSAGE TO SEE IF IT SHOULD
;GO TO LOG FILE, TTY, OR BOTH.
;ALSO OUTPUTS TIME STAMP AND EITHER % OR ? IF REQUIRED
;ENTER WITH LOGSUB AND LOGTTY SET UP AS
;LOGSUB NON-ZERO IF LOG DEVICE EXISTS AND IS NOT TTY
;LOGTTY = -1 IF LOG DEVICE IS TTY
;CHKLVL CHANGES THESE TO BE
;LOGSUB <-1,,NON-ZERO> IF BOTH  LOG AND TTY OUTPUT REQUIRED
;LOGTTY <0,,NON-ZERO> IF TTY BUT NOT LOG AND TTY NOT = LOG
CHKLVL:	LDB	T1,LVLPTR	;GET LIST LEVEL
	CAMGE	T1,LOGLVL	;ABOVE CUTOFF?
	JRST	CHKLV2		;NO, TRY TTY ONLY
	SKIPE	LOGTTY		;YES, THEN IS LOG = TTY?
	JRST	[AOS	(P)		;SKIP RET
		JRST	CHKLV4]		;OUTPUT % OR ? AND CODE
	SKIPN	LOGSUB		;DO WE REALLY HAVE A LOG DEVICE?
	JRST	CHKLV2		;NO, JUST TRY TTY

CHKLV1:	AOS	(P)		;SET FOR SKIP RETURN
	PUSHJ	P,TSTAMP	;PUT TIME STAMP ON LOG FILE
	LDB	T1,LVLPTR	;GET LEVEL AGAIN
	CAMGE	T1,ERRLVL	;ABOVE ERROR CUTOFF?
	JRST	CHKLV5		;NO, NOT TO TTY
	MOVE	T1,TTYSUB	;POINT TO TTY LINE BUFFER
	PUSHJ	P,.TYOCH	;SWAP WITH LOG
	PUSH	P,T1		;SAVE IT
	PUSHJ	P,SEVTST	;USE TTY TO OUTPUT % OR ?
	POP	P,T1		;GET OUTPUT ROUTINE BACK
	PUSHJ	P,.TYOCH	;AS IT WAS
	HRROS	LOGSUB		;SIGNAL TO BOTH DEVICES
	JRST	CHKLV5		;NOW FOR REST OF MESSAGE
;HERE WHEN NO LOG DEVICE. CHECK FOR TTY OUTPUT.

CHKLV2:	LDB	T1,LVLPTR	;GET ERROR LEVEL
	CAMGE	T1,ERRLVL	;TO GO TO TTY?
CPOPJ:	POPJ	P,		;NOTHING TO DO AT ALL
	AOS	(P)		;SKIP RETURN
	SKIPE	LOGTTY		;LOG = TTY?
	JRST	CHKLV4		;YES, JUST PRINT CODE AND RETURN
CHKLV3:	HRRZ	T1,LOWSUB	;[605] SET FOR TTY OUTPUT ONLY
	PUSHJ	P,.TYOCH	;GET OLD RETURN
	HRRZM	T1,LOGTTY	;STORE OLD RETURN
CHKLV4:	PUSHJ	P,SEVTST	;OUTPUT % OR ?
CHKLV5:	MOVE	T1,(P1)		;GET CODE
	TRZ	T1,<BYTE (7) 0,0,0,177,177>
	MOVEM	T1,ERRCOD	;INCASE MORE MESSAGE REQUIRED
	MOVE	T1,VERLVL	;IF /VER:SHORT
	SOJE	T1,CHKLV6	;DON'T OUTPUT SPACE AFTER 3 CHARS
	HRRZ	T1,P1		;GET ERROR CODE ADDRESS
	OUTVIA	.TSTRG##
	AOJA	P1,CPOPJ	;RETURN WITH P1 POINTING TO REST OF MESS


CHKLV6:	MOVEI	T1,ERRCOD	;JUST 3 CHARS
	OUTVIA	.TSTRG##
	AOJA	P1,CPOPJ
;ROUTINE SEVTST CHECKS ERROR FOR FATAL OR NOT
;AND OUTPUTS EITHER % OR ? ON TTY ONLY
SEVTST:	LDB	T2,SEVPTR	;GET SEVERITY
	MOVEI	T1,"["		;ASSUME INFO
	CAIL	T2,S%W		;IS IT A WARNING?
	MOVEI	T1,"%"		;YES, OR WORSE
	CAML	T2,SEVLVL	;IS IT FATAL?
	MOVEI	T1,"?"		;YES, 
	CAIN	T1,"["		;IF MORE THAN INFO
	JRST	SEVTS1		;NO
	CLEARO			;CLEAR ^O
SEVTS1:	PUSHJ	P,.TCHAR##	;TYPE CHARACTER
	MOVEI	T1,[ASCIZ \LNK\]
	PJRST	.TSTRG##
TTYCHK::SKIPL	LOGSUB		;ANY NEED TO DO IT?
	POPJ	P,		;NO
	PUSH	P,T1		;SAVE ENTRY TO .TOUTS
	XCT	@-1(P)		;PUT IN LOG FILE
TTYSET:	MOVE	T1,TTYSUB	;GET TTY LINE BUFFER SUB
	PUSHJ	P,.TYOCH	;INITIALIZE FOR IT
	EXCH	T1,(P)		;SWAP OUT SUB FOR ENTRY PTR
	XCT	@-1(P)		;GO TO .TOUTS
	POP	P,T1		;RESTORE OUTSUB
	AOS	(P)		;SKIP OVER XCT'ED INST
	PJRST	.TYOCH		;RESET AND RETURN

TSTAMP:	PUSHJ	P,.TTIMN##	;STANDARD TIME OUTPUT
	PUSHJ	P,.TSPAC##	;SPACE
	LDB	T1,LVLPTR	;GET PRINT LEVEL
	MOVEI	T2," "		;FILLER CHAR IF 1 DIGIT
	PUSHJ	P,.TDEC2##	;OUTPUT IT
	PUSHJ	P,.TSPAC##
	LDB	T1,SEVPTR	;ERR LEVEL
	MOVEI	T2," "
	PUSHJ	P,.TDEC2##	;
	PJRST	.TSPAC##	;FINISH WITH A SPACE


;UNSTCK REMOVES TOP DATA ITEM FROM STACK
;AND PUT RH IN P1 AND T1

UNSTCK:	POP	P,T3		;GET RETURN ADDRESS
	POP	P,T2		;MAIN RETURN
	POP	P,T1		;WHAT WE WANT
	PUSH	P,T2		;RESTACK
	HRR	P1,T1		;GET A COPY
	JRSTF	@T3		;RETURN


VERPTR:	POINT	3,P1,B%VER	;VERBOSITY LEVEL
SEVPTR:	POINT	6,P1,B%SEV	;SEVERITY LEVEL
BTHPTR:	POINT	9,P1,B%SEV	;SEVERITY AND VERBOSITY
LVLPTR:	POINT	6,P1,B%LVL	;OUTPUT MESSAGE LEVEL

;.TEBLK --TYPE LOOKUP/ENTER/RENAME BLOCK (NOT SAME AS .TFBLK##)
;CALL:	MOVEI	T1,ADDR OF BLOCK
;	PUSHJ	P,.TEBLK
;USES T1-4

.TEBLK::MOVE	T4,T1		;SAVE ARGUMENT
	MOVE	T1,I.DEV(T4)	;DEVICE
	PUSHJ	P,.TSIXN##
	PUSHJ	P,.TCOLN##
	MOVE	T1,I.NAM(T4)	;NAME
	PUSHJ	P,.TSIXN##
	HLLZ	T1,I.EXT(T4)	;EXTENSION
	MOVE	T2,I.SCN(T4)	;GET MOD WORD
	TXNE	T2,FX.NUL	;TEST FOR NULL EXTENSION (NO DOT)
	JUMPE	T1,TEBLK2	;NO EXT
	TRO	T1,'.'
	ROT	T1,-6		;PUT IN LEADING PLACE
	PUSHJ	P,.TSIXN##
TEBLK2:	MOVEI	T1,I.PPN(T4)	;POINTER TO PPN OR SFD
IFN LN.DRB,<			;ENABLED FOR SFD'S?
	MOVE	T2,(T1)		;GET UFD
	TLNE	T2,-1		;0,,+ IS A PNTR
	PJRST	.TDIRB##	;NO, JUST [PPN]
	MOVE	T1,(T1)		;GET 0,,SFDARG
	ADD	T1,[1,,2]	;POINT TO SFDDIR
>
	PJRST	.TDIRB##	;OUTPUT DIRECTORY

;.TSBLK --TYPE GETSEG BLOCK (NOT SAME AS .TFBLK##)
;CALL:	MOVEI	T1,ADDR OF BLOCK
;	PUSHJ	P,.TSBLK
;USES T1-4

.TSBLK:	MOVE	T4,T1		;SAVE ARGUMENT
	MOVE	T1,0(T4)	;DEVICE
	PUSHJ	P,.TSIXN##
	PUSHJ	P,.TCOLN##
	MOVE	T1,1(T4)	;NAME
	PUSHJ	P,.TSIXN##
	HLLZ	T1,2(T4)	;EXTENSION
	TRO	T1,'.'
	ROT	T1,-6		;PUT IN LEADING PLACE
	PUSHJ	P,.TSIXN##
	MOVEI	T1,4(T4)	;PPN
	PJRST	.TDIRB##	;OUTPUT DIRECTORY

;STANDARD ERROR MESSAGES - USED EVERYWHERE

.ERFEE::ASCIZ	\FEE \
	.ASCIZ	<ENTER error >;;[564]
.ERFLE::ASCIZ	\FLE \
	.ASCIZ	<LOOKUP error >
.ERFRE::ASCIZ	\FRE \
	.ASCIZ	<RENAME error >
.ERGSE::ASCIZ	\GSE \
	.ASCIZ	<GETSEG error >
.ERNED::ASCIZ	\NED \
	.ASCIZ	<Non-existent device >
.ERIFD::ASCIZ	\IFD \
	.ASCIZ	<INIT failure for device >

	.ERR.	(,0,V%L,L%F,S%F,,<(2) directory full >)
ENTAB:	.ERR.	(,0,V%L,L%F,S%F,,<(0) Illegal file name >)
LRETAB:	.ERR.	(,0,V%L,L%F,S%E,,<(0) file was not found >)
	.ERR.	(,0,V%L,L%F,S%E,,<(1) no directory for project-programmer number >)
	.ERR.	(,0,V%L,L%F,S%E,,<(2) protection failure >)
	.ERR.	(,0,V%L,L%F,S%E,,<(3) file was being modified >)
	.ERR.	(,0,V%L,L%F,S%E,,<(4) rename file name already exists >)
	.ERR.	(,0,V%L,L%F,S%F,,<(5) illegal sequence of UUOs >)
	.ERR.	(,0,V%L,L%F,S%F,,<(6) bad UFD or bad RIB >)
	.ERR.	(,0,V%L,L%F,S%F,,<(7) not a SAV file >)
	.ERR.	(,0,V%L,L%F,S%F,,<(10) not enough core >)
	.ERR.	(,0,V%L,L%F,S%F,,<(11) device not available >)
	.ERR.	(,0,V%L,L%F,S%F,,<(12) no such device >)
	.ERR.	(,0,V%L,L%F,S%F,,<(13) not two reloc reg. capability >)
	.ERR.	(,0,V%L,L%F,S%E,,<(14) no room or quota exceeded >)
	.ERR.	(,0,V%L,L%F,S%E,,<(15) write lock error >)
	.ERR.	(,0,V%L,L%F,S%F,,<(16) not enough monitor table space >)
	.ERR.	(,0,V%L,L%I,S%I,,<(17) partial allocation only >)
	.ERR.	(,0,V%L,L%F,S%F,,<(20) block not free on allocation >)
	.ERR.	(,0,V%L,L%F,S%F,,<(21) can't supersede (enter) an existing directory >)
	.ERR.	(,0,V%L,L%F,S%F,,<(22) can't delete (rename) a non-empty directory >)
	.ERR.	(,0,V%L,L%F,S%E,,<(23) SFD not found >)
	.ERR.	(,0,V%L,L%F,S%E,,<(24) search list empty >)
	.ERR.	(,0,V%L,L%F,S%E,,<(25) SFD nested too deeply >)
	.ERR.	(,0,V%L,L%F,S%E,,<(26) no-create on for specified SFD path >)
	.ERR.	(,0,V%L,L%F,S%E,,<(27) segment not on swap space >)
	.ERR.	(,0,V%L,L%F,S%E,,<(30) can't update file >)
	.ERR.	(,0,V%L,L%F,S%E,,<(31) low segment overlaps high segment >)

LRELEN==.-LRETAB
LREDEF:	.ERR.	(,0,V%L,L%F,S%F,,<) Unknown cause >)

.ERCNW::ASCIZ	\CNW \
	.ASCIZ	<Code not yet written at >

LOGLIT:
END