Trailing-Edge
-
PDP-10 Archives
-
bb-d868b-bm_tops20_v3a_2020_dist
-
3a-sources/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
SUBTT L 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