Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/rmsmes.mac
There are 6 other files named rmsmes.mac in the archive. Click here to see a list.
;
;	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1986.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED  AND
;	COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND 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.  NO TITLE TO AND OWNERSHIP OF  THE
;	SOFTWARE IS HEREBY TRANSFERRED.
;
;	THE INFORMATION IN THIS SOFTWARE IS  SUBJECT  TO  CHANGE  WITHOUT
;	NOTICE  AND  SHOULD  NOT  BE CONSTRUED AS A COMMITMENT BY DIGITAL
;	EQUIPMENT CORPORATION.
;
;	DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF
;	ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
;
TITLE	RMSMES - FORMATTED MSG OUTPUTTER
SUBTTL	S. COHEN
SEARCH	RMSINT,RMSMAC
$PROLOG

$PURE

; CONSTANT MEMORY FOR MSG PROCESSOR
;
$ARRAY	(BPOS,0,4,<^D29,^D22,^D15,^D8,^D1>)	;THE BP.POS POSSIB FOR ASCIZ STRINGS
$DATA	(BLANKPT,1,<POINT ASC,BLANKS>)
$DATA	(BLANKS,0,ASCIZ/                                        /)
$DATA	(COMMA,1,<ASCIZ/,/>)
$DATA	(CRLF,1,<BYTE (ASC)15,12>)
$DATA	(DF1,2,<EXP 1.0,0>)
$DATA	(DF10,2,<EXP 10.0,0>)
$DATA	(DSK,1,ASCIZ/DSK:/)
$DATA	(MINUS,1,ASCIZ/-/)
$DATA	(QMARK,1,ASCIZ/?/)
$DATA	(TAB,1,ASCIZ/	/)

$FMT	(RM$ASZ,<-CA%ASZ>)
EXPFMT:	$FMT(,<E,-CA%NUM,-CA%NOCR>)
RFAFMT:	$FMT(,<-CA%NUM,/,-CA%NUM,-CA%NOCR>)

; STATIC VARIABLE MEMORY
;
DEFINE $XDATA(NAM$,SIZ$)<EXTERN NAM$>		;PICK UP DATA FROM GLOBAL LOC
$XDATA	(OV.CAS)				;-1 IF TX.APP, 0 OTHWISE
$XDATA	(OV.DSIG)				;DESIG TO USE ON NEXT CALL for tx.app
$XDATA	(OV.ACT)				;SPECIAL PROC TO CALL ON BUFF OVFLOW
$XDATA	(OV.LEFT)				;# OF CHARS IN MEMBUF, 0R 0
$XDATA	(TXT$CC)				;# OF CHARS WRITTEN TO MEM SINCE CALLER LAST 0-ED IT
SUBTTL	TX$ ENTRY POINTS

$SCOPE	(MSG-OUTPUT)
$LREG	(CAP,6)					;AOBJ PTR TO CURR ARG
$LREG	(ELEMPT,7)				;PTR TO CURR ITEM IN FMT STAT
$LREG	(DESIG,10)				;OUTPUT DESIGNATOR
$LOCALS
 $WORD	(CBUF,^D16)				;FOR BUILDING NUMBERS, DATES, & ERSTR'S
 $WORD	(FLOTMP,2)				;SPACE FOR DP FLO NUM
 $WORD	(STRLEN)				;# OF CHARS IN STRING TO OUTPUT
 $WORD	(TEMP1)					;A WORD FOR ARBIT SHORT-TERM USE
 $WORD	(XTINST,3)				;SPACE FOR EXTEND INST INFO
 $WORD	(STRIBP,2)				;STRING PTR
$ENDLOC

$DATA	(CHBUFP,1,<POINT AS%BYT,CBUF(CF)>)	;FOR CONVING INTEGERS TO STRINGS
						;(INIT USING LOCAL MUST FOL DCL)

$BLISS	(TX$TOUT)
;
; TX$TOUT - OUTPUTS A FORMATTED MSG TO THE PRIMARY OUTPUT DEVICE
; ARGUMENTS:
;	MSGFORMAT = BEGINNING OF THE FMT STATEMENT TO USE
;	MSGPARAM = 0 OR MORE VARIABLES TO BE MERGED WITH THE FMT
	IFN TOP$10,<SETZM DESIG>	;CLEAR IRRELEV CRUFT
	IFN TOP$20,<MOVEI DESIG,.PRIOU>	;TOUT MEANS USE PRIMARY OUTPUT DEVICE
	SETZM	OV.CASE			;INDIC NOT APPENDING
TXIMPD:					;COMM PT FOR ENTS WITH IMPLIC DESIG
	HRRE	CAP,@0(CF)		;PICK UP RIGHT HALF OF INST AT RET LOC
	ADDI	CAP,1(CF)		;PT CAP AT 1ST MSGPARAM ON STK
	JRST	TX.MERGE

$ENTRY	(TX$APP)
;
; TX$APP - APPENDS TO OV.DSIG
; ARGUMENTS:
;	AS FOR TX$TOUT, BUT OV.DSIG IS IMPLICIT STARTING PT
; NOTES:
;	TO USE THIS ROUTINE,
;	YOU MUST INIT OV.DSIG TO BE BP TO BEGIN OF BUFFER
;	YOU MUST INIT OV.LEFT TO MAX CHARS IN BUF
;	INIT TXT$CC TO 0
;	INIT OV.ACT TO PT AT BUFFER FLUSHING ROUTINE.
;	@OV.ACT MUST RESET OV.DSIG TO BEGIN OF BUF & ZERO TXT$CC
;	EACH TIME IT IS CALLED

	MOVE	DESIG,OV.DSIG			;INDIC APPEND CASE
	SETOM	OV.CASE				;INDIC APPENDING
	JRST	TXIMPD				;IMPLICIT DESIG
$ENTRY	(TX$CON)
;
; TX$CON - CONTINUE CALL OF CURR CONTEXT
	JRST	TXEXPD				;EXPLIC DESIG

$ENTRY	(TX$MERG)		;MERGE VARIABLES WITH MSG. ONLY
;
; ARGUMENTS -
;	MSGBUFFER: BUFFER BP OR JFN TO OUTPUT TO (-1,,ADDR==440700,,ADDR)
;	MSGFORMAT: FORMAT STMT
;	MSGPARAMS: PARAMS TO BE MERGED WITH FMT STMT

	SETZM	OV.CAS				;INDIC NOT APP
TXEXPD:						;COMM PT EXPLIC DESIG
	HRRE	CAP,@0(CF)		
	ADDI	CAP,2(CF)			;PT CAP AT 1ST MSGPARAM ON STACK
	MOVE	DESIG,-2(CAP)			;POINT TO BUFFER
	HLRE	T1,DESIG			;ISOL LEFTHALF
	AOSN	T1				;WAS IT -1
	HRLI	DESIG,440700			;YES
	JRST	TX.MERGE
TX.MERGE:
	MOVE	ELEMPT,-1(CAP)			;SET ELEMPT TO PT AT FMT STAT (@MSGPOINT(AP))
MSG.LOOP:
	SKIPN	0(ELEMPT)			;EXPLIC END OF FMT CODE?
	JRST	CA.EXIT				;YES
	HLRE	T1,0(ELEMPT)			;LEFT SIDE TELLS NATURE OF CTL WD?
	JUMPN	T1,L$IFX			;IS IT XWD 0,PTR-TO-ASCIZ?
	  $CALL PUTSTR,<@0(ELEMPT),[0]>		;YES, INDICATE THAT IT IS ASCIZ
	  AOJA ELEMPT,MSG.LOOP			;GET NEXT FORMAT CTL WORD
	$ENDIF
	AOJE	T1,L$IFX			;IS IT SIMPLY ASCIZ STRING?
	  $CALL	PUTSTR,<0(ELEMPT),[0]>		;YES, PUT IT OUT
	  JRST	CA.EXIT				;MUST BE ONLY THING LEFT IN FMT
	$ENDIF
	MOVM	T1,0(ELEMPT)			;SET INDEX TO ABS VAL
	CAIG	T1,CA%IVNUM			;IS IT A PADDED NUMBER?
	$SKIP					;YES
	  MOVSI	T4,(1B0)				;TELL CVTBDO PADDING APPLIC
	  CAIG	T1,CA%ZVNUM			;0 PADDED?
	  $SKIP1				;YES
	    HRRI T4,-CA%ZVNUM(T1)		;NORMALIZE THE FIELD'S SIZE
	    MOVEI TF,"0"			;PAD WITH ZEROES
	    JRST L$IFX(1)
	  $NOSK1				;NO
	    HRRI T4,-CA%IVNUM(T1)		;NORMALIZE THE FIELD'S SIZE
	    MOVEI TF," "			;PAD WITH BLANKS
	  $ENDIF(1)
	  MOVEM	TF,XTINST+1(CF)			;PUT AWAY PAD CHAR
	  JRST	ANY.N				;MERGE WITH NUMERIC PROCESSING
	$ENDIF
	CAIG	T1,CA%IVCOL			;IS IT "COLUMN" SPECIAL CASE
	$SKIP					;YES
	  IFN TOP$10,<ERRI (OAL)>		;NOT SUPPORTED ON 10 YET
	  ADDI	ELEMPT,1			;HOP OVER FMT CODE IMMED
	  MOVEI	T5,-CA%IVCOL(T1)			;ISOL COL NUMBER
	  CAILE	T5,^D132			;EXCEED MAX LINE?
	  ERRI	(OAL)				;COL ARG OUT OF RANGE
	  SUB	T5,TXT$CC			;GET RELAT COL
	  JUMPLE T5,MSG.LOOP			;JUMP IF COL ALREADY PASSED
	  CAILE	T5,^D40				;ENOUGH BLANKS IN BLANK VECTOR
	  ERRI	(OAL)				;NO
	  $CALL	PUTSTR,<BLANKPT,T5>		;PUT THE REQUIRED NUM OF BLANKS OUT
	  JRST	MSG.LOOP			;GET NEXT FMT CODE
	$ENDIF
	CASES	(T1,MX%CA)			;DISPATCH TO DO RIGHT FORMAT CTL
SUBTTL	THE STANDARD CASES

$CASE	(0)					;END OF MSG
CA.EXIT:
;	SKIPE	NOCR(CF)			;NOCR DT SPEC?
;	JRST	L$CASE(CA%NOCR)			;YES
	$CALL	PUTSTR,<CRLF,[0]>		;FINISH MSG TEXT
$CASE	(CA%NOCR)				;END OF MSG SUPPRESSING CRLF
	SKIPGE	OV.CAS				;APPENDING
	MOVEM	DESIG,OV.DSIG			;YES, SAVE UPD BP
	RETT					;WITH # OF CHARS IF MEM COPY
$CASE	(CA%ASZ)				;ASCIZ STRING
	$CALL	PUTSTR,<@0(CAP),[0]>		;DO THE OUTPUT
	ADDI	CAP,1
	AOJA	ELEMPT,MSG.LOOP
$CASE	(CA%CMA)				;PUT OUT A COMMA
	$CALL	PUTSTR,<COMMA,[0]>		;DO IT
	AOJA	ELEMPT,MSG.LOOP			;GET NEXT FMT CODE
$CASE	(CA%CRLF)				;PUT OUT A CRLF
	$CALL	PUTSTR,<CRLF,[0]>		;DO IT
	AOJA	ELEMPT,MSG.LOOP			;GET NEXT FMT CODE
$CASE	(CA%DIR)				;PUT OUT A DIRECTORY STRING
	IFN TOP$20,<
	  HRROI	1,CBUF(CF)			;BUILD IN TEMP AREA
	  MOVE	2,0(CAP)			;DIRECTORY NUMBER
	  JUMPE	2,[$CALL PUTSTR,<DSK,[0]>
		 JRST NODIR]
	  DIRST%					;CONVERT TO STRING
	    ERC	(OAL)				;OUTPUT ARG LIST ERROR
	>						;END IFN TOP$20
	$CALL	PUTSTR,<CBUF(CF),[0]>		;PUT OUT THE DIR STRING
NODIR:	ADDI	CAP,1
	AOJA	ELEMPT,MSG.LOOP			;GO BACK FOR MORE
IFN TOP$20,<
$CASE	(CA%DT)					;DATE & TIME
	TDZA	T5,T5				;0 IS DEFAULT
$CASE	(CA%DTT)				;TIME ONLY
	LOADX	T5,OT%NDA			;SUPPRESS-DATE FLAG
	JRST	DT.GO
$CASE	(CA%DTD)				;DATE ONLY
	LOADX	T5,OT%NTM			;SUPPRESS TIME
	DT.GO:
	$CALL	PUTDT,<T5,0(CAP)>		;PASS CODE & UNIV DT
	ADDI	CAP,1				;HOP OVER THE ARG
	AOJA	ELEMPT,MSG.LOOP			;GET NEXT THING FROM FMT STAT
>						;IFN TOP$20 FOR DATE FUNCTIONS
$CASE	(CA%FIL)				;PUT OUT A FILE NAME
	IFN TOP$20,<
	  HRROI	1,CBUF(CF)			;BUILD IN TEMP AREA
	  HRRZ	2,0(CAP)			;JFN OF FILE NAME
	  SETZ	3,				;USE DEFAULT STRING
	  JFNS%					;PRINT THE NAME
	  ERC	(OAL)				;ARG LIST ERR
	>					;END IFN TOP$20
	$CALL	PUTSTR,<CBUF(CF),[0]>		;PUT OUT THE FILE STRING
	ADDI	CAP,1				;GET PAST ARG
	AOJA	ELEMPT,MSG.LOOP			;GO BACK FOR MORE
$CASE	(CA%FLO)				;SING PREC FLOAT NUM
	$CALL	PUTFLO,<0(CAP)>			;SING PREC NUM
	AOJA	ELEMPT,MSG.LOOP
$CASE	(CA%JSE)				;JSYS ERR CHK
;???	SKIPL	TCS.EC				;JSYS ERROR INVOLVED?
;???	JRST	L$CASE(0)			;NO, TERM USER MSG
	$CALL	PUTSTR,<CRLF,[0]>		;START FRESH LINE
	$CALL	PUTLER				;YES, PUT IT OUT
	JRST	L$CASE(0)			;JSYS MSG ALWAYS ENDS MSG
$CASE	(CA%JSM)				;JUST A JSYS MSG
	$CALL	PUTERS,<0(CAP)>		;PRINT MSG ASSOC WITH PASSED CODE
	ADDI	CAP,1				;HOP OVER PROCESSED ARG
	AOJA	ELEMPT,MSG.LOOP			;GET NEXT FMT CODE
$CASE	(CA%MIN)				;PUT OUT A MINUS SIGN
	$CALL	PUTSTR,<MINUS,[0]>		;DO IT
	AOJA	ELEMPT,MSG.LOOP			;GET NEXT FMT CODE
$CASE	(CA%PNUM)				;PADDED INTEGER
$CASE	(CA%NUM)				;UNPADDED INTEGER
	MOVEI	T4,22				;INDIC MAX LEN, BUT NO RIGHT JUSTIF
	ANY.N:
	MOVE	T5,CHBUFP			;THE DESTINATION
	SKIPL	T2,0(CAP)			;GET THE SINGLE-PREC INTEGER
	$SKIP					;ITS NEGATIVE
	  MOVMS	T2				;FIX IT
	  MOVEI	TAP,"-"				;PUT SIGN OUT
	  IDPB	TAP,T5				;DONE
	$ENDIF
	MOVE	T1,[CVTBDO "0"]			;DESIRED CONVERT INST
	MOVEM	T1,XTINST(CF)			;PERMANIZE IT
	ADDI	CAP,1
	SETZB	T1,T3				;NO HIGH-ORDER DATA
	EXTEND	T1,XTINST(CF)			;EXTEND OPTION=BIN TO DEC
	$SKIP					;DATA FITS
	  IDPB T1,T5				;MAKE IT ASCIZ
	  $CALL PUTSTR,<CBUF(CF),[0]>		;OUTPUT IT NOW
	  JRST L$IFX
	$NOSKIP					;DOESNT FIT
	  $CALL PUTSTR,<[ASCIZ/*OVFL*/],[0]>	;FIELD SIZE NOT LARGE ENOUGH
	$ENDIF
	AOJA	ELEMPT,MSG.LOOP
$CASE	(CA%OCT)				;OCTAL NUMBER: XXXXXX,,XXXXXX
	$CALL	PUTOCT,<0(CAP)>			;OUTPUT IT
	AOJA	ELEMPT,MSG.LOOP			;GET ANOTHER MSG SEGMENT
$CASE	(CA%R50)
	MOVE	T1,0(CAP)			;PUT VAL IN AC
	TLZ	T1,740000			;INSURE FLAG BITS OFF
	MOVEI	T4,6				;LEN OF R50 FLD
R50PLP:
	IDIVI	T1,50				;CALC CURR LOW ORD DIGIT
	SETZM	T3				;START WITH NULL MATCH
	CAIL	T2,1				;IN DIGIT RANGE?
	MOVEI	T3,"0"-1(T2)			;YES
	CAIL	T2,13				;IN ALPH RANGE?
	MOVEI	T3,"A"-13(T2)			;YES
	CAIN	T2,45				;MATCH .?
	MOVEI	T3,"."				;YES
	CAIN	T2,46				;MATCH $?
	MOVEI	T3,"$"				;YES
	CAIN	T2,47				;MATCH %?
	MOVEI	T3,"%"				;YES
	JUMPE	T3,R50PLE			;EXIT ON NUL
	PUSH	P,T3				;SAVE TILL END
	SOJG	T4,R50PLP			;LOOP BACK IF MORE LEFT
R50PLE:
	HRREI	T4,-6(T4)			;;GET NEG OF CH PROC BY R50PLP
	MOVE	T5,CHBUFP			;BYTE PTR TO TEMP AREA
R50CLP:
	POP	P,T3				;GET CHAR BACK
	IDPB	T3,T5				;WRITE IT
	AOJL	T4,R50CLP			;LOOP BACK
	IDPB	T4,T5				;MAKE ASCIZ
	JRST	SIXPUT				;PUT IT OUT
$CASE	(CA%RFA)				;DISPLAY RFA: P#/ID#
	HRRZ	T1,0(CAP)			;GET P# FROM RFA
	HLRZ	T2,0(CAP)			;GET ID#
	$CALLB	TX$CON,<DESIG,[RFAFMT],T1,T2>
	SKIPGE	OV.CAS				;APPENDING?
	MOVE	DESIG,OV.DSIG			;YES, GET NEW LAST VAL
						;PUT IT OUT RECURS
	ADDI	CAP,1
	AOJA	ELEMPT,MSG.LOOP			;GET NEXT FLD
$CASE	(CA%STP)				;STRING PTR
	DMOVE	T1,@0(CAP)			;PUT LENGTH IN T5
	HRRZS	T2				;MAKE SURE ITS CLEAN
	JUMPE	T2,CANOOP			;NOOP IF NUL STRING
	DMOVEM	T1,STRIBP(CF)			;PERMANIZE IT
	LOAD	T3,BP.SIZ+T1			;CHK TYPE OF STRING
	CAIN	T3,AS%BYT			;ASCII?
	JRST	STP.AS				;YES
	CAIE	T3,9				;EBCDIC?
	CAIN	T3,6				;SIXBIT?
	JRST	STP.TR				;YES
STP.O:
	ILDB	T5,STRIBP(CF)			;GET A BYT
	$CALL	PUTOCT,<T5>			;OUTPUT IT
	$CALL	PUTSTR,<TAB,[0]>		;FOLLOW IT WITH TAB
	SOSLE	STRIBP+1(CF)			;CHK FOR MORE
	JRST	STP.O				;OUTPUT ANOTHER BYTE
	JRST	STPEXIT
STP.TR:
	ADDI	CAP,1				;PT AT TRANS TAB
	MOVE	T3,0(CAP)			;COPY IT
	HRLI	T3,(MOVST)			;THE DESIRED OPR
	MOVEM	T3,XTINST(CF)			;PUT IT AWAY (NOTE: FILL WDS IGNORED -- NEV PAD)
	EXCH	T1,T2				;PUT BKWARDS FOR EXTEND
	DMOVEM	T1,STRIBP(CF)			;DONE
STP.LP:
	DMOVE	T1,STRIBP(CF)			;GET LEN & BP
	MOVE	T5,CHBUFP			;PT AT DEST BUFF
	MOVEI	T4,100				;DEFAULT AMT TO COPY
	CAIG	T1,100				;GTR THAN MAX?
	MOVEM	T1,T4				;COPY AMT LEFT
	EXTEND	T1,XTINST(CF)			;DO PROPER COPY
	  JFCL					;TRUNCATED OK
	DMOVEM	T1,STRIBP(CF)			;SAVE RESIDUE LEN & LOC
	IDPB	T4,T5				;APPEND A NUL TO DEST
	$CALL	PUTSTR,<CBUF(CF),[0]>		;PUT OUT WHAT COPIED
	SKIPG	STRIBP(CF)			;ANYTHING LEFT?
	JRST	STPEXIT				;NO
	JRST	STP.LP				;YES, COPY & OUTPUT IT
STP.AS:
	$CALL	PUTSTR,<STRIBP(CF),STRIBP+1(CF)>	;PUT IT OUT
STPEXIT:
	ADDI	CAP,1				;HOP OVER THE ARG
	AOJA	ELEMPT,MSG.LOOP
$CASE	(CA%SIX)				;6-BIT WORD
	MOVE	T1,[POINT 6,0(CAP)]		;MAKE PTR TO WORD
	PUSHJ	P,SIXASZ			;CONV 6BIT TO ASCIZ
SIXPUT:
	$CALL	PUTSTR,<CBUF(CF),[0]>		;PUT IT OUT
	ADDI	CAP,1				;HOP OVER THE ARG
	AOJA	ELEMPT,MSG.LOOP			;GO BACK FOR MORE
$CASE	(CA%TCE)				;TCS ERR STATUS
IFN 0,<
	HRRZ	T2,TCS.EC			;GET ERR CODE
	HLLZS	TCS.EC				;..AND CLEAR IT
	HLRZ	T1,TX.0##(T2)			;GET MNEMONIC FROM VECTOR
	HRRM	T1,TCS.EH			;MERGE WITH COMPON
	HRRZ	T1,TX.0##(T2)			;GET PTR TO ERR TEXT'S FMT STAT
	MOVEM	T1,TEMP1(CF)			;PERMANIZE IT
	CAME	T1,TCS.FM			;IS LAST SAVED MSG THE CURR 1?
						;...WONT = IF INT ERR CAUSE TCS.FM=-1,,FMT
	$SKIP					;YES
	  $CALL	PUTSTR,<TCS.SV,[0]>		;PUT OUT THE ERR BUF
	  AOJA	ELEMPT,MSG.LOOP			;GO BACK FOR MORE
	$NOSKIP					;NO
	  $CALL	PUTSTR,<QMARK,[0]>		;PUT OUT Q MARK
	  $CALL	TX.CASE,<CA%SIX,TCS.EH>		;PUT cccmmm = COMPON/ERR MNEMONIC
	  $CALL	PUTSTR,<BLANKPT,[1]>		;SEP FROM TEXT OF MSG
	  HRRZ	T1,TCS.FM			;ISOL CURR FMT
	  HRRZ	T5,TEMP1(CF)			;TENTA ASSUME NO SAVED MSG
	  CAMN	T1,T5				;A SAVED INT-ERR MSG?
	  MOVEI	T5,TCS.SV			;YES, USE IT
	  $CALL PUTSTR,<0(T5),[0]>		;PUT OUT TEXT OF MSG
	$ENDIF
	$CALL	PUTSTR,<[ASCIZ/ at /],[0]>	;INDIC PC COMING
	$CALL	TX.CASE,<CA%OCT,TCS.PC>		;PUT OUT THE PC
	AOJA	ELEMPT,MSG.LOOP			;GO BACK FOR MORE
>
$CASE	(CA%VARY)
	HRROI	T5,@0(CAP)			;SET UP PSEUDO-BP TO THE VARYING STRING
	HRRZ	T1,-1(T5)			;GET ITS LENGTH
	MOVEM	T1,STRLEN(CF)			;...AND MAKE IT PASSABLE
	JUMPE	T1,CANOOP			;NOOP IF NUL STRING
	$CALL	PUTSTR,<T5,STRLEN(CF)>		;WRITE IT
CANOOP:
	ADDI	CAP,1				;GET PAST THIS ARG
	AOJA	ELEMPT,MSG.LOOP
$CASF						;LABELS FOR THE COMPONENT SPECIFIC CASES
	ERRI	(OAL)

SIXASZ:
; ARGUMENTS:
;	T1 = BP TO STRING
; RETURNS:
;	ASCIZ STRING IN CBUF(CF)
	MOVE	T2,CHBUFP			;THE DEST
	MOVEI	T3,6				;THE LENGTH
SIX.LP:
	ILDB	TAP,T1				;GET A 6BIT CHAR
	ADDI	TAP,40				;MAKE IT ASCII
	IDPB	TAP,T2				;PUT IT AWAY
	SOJG	T3,SIX.LP			;COP ANOTHER
	IDPB	T3,T2				;MAKE ASCIZ
	POPJ	P,
$ENDPROC
$SCOPE	(PUTFLO)
$LREG	(EXPON)
$LREG	(MAXDIG)

$UTIL	(PUTFLO,<NUMVAL>)
;
; PUTFLO - OUTPUTS SING PREC FLOATING NUM
; ARGUMENTS:
;	NUMVAL = VAL TO OUTPUT
; NOTES:
;	NUMBER IS OUTPUT AS 0.nnnnEnn, WITH SIGNS AS NECES
	MOVE	EXPON,@0(AP)			;GET NUM TO PRINT (MISUSE EXPON TO SAVE IT TEMP)
	JUMPN	EXPON,L$IFX			;SPEC CASE OF 0?
		$CALL PUTSTR,<[ASCIZ/0.0/],[0]>	;PUT OUT 0.0
		RETURN
	$ENDIF
	MOVEI	T5,[ASCIZ/0./]			;PRESUME POS
	SKIPG	EXPON				;IS IT POS?
	MOVEI	T5,[ASCIZ/-0./]			;NO, START WITH MINUS
	$CALL	PUTSTR,<0(T5),[0]>		;OUTPUT IT
PFCONV:
	MOVM	T1,EXPON			;FROM NOW ON NEED ONLY MAGN
	SETZM	T2				;INDIC 1 WD OF PREC
	MOVEI	MAXDIG,8			;DEC PREC OF 1 WD FLOAT NUM
	MOVEI	EXPON,1				;ALG WORKS ON NUMS 1 TO 10
	CAML	T1,DF1				;DET DIR TO NORMALIZE
	JRST	PFDECR				;LARGER THAN 1, SHRINK PROB
PFINCR:						;LESS THAN 1, INCREASE IT
	CAML	T1,DF1				;IN 1 TO 10 RANGE YET?
	JRST	PFNORM				;YES, NOW PUT THE NORMALIZED NUM
	DFMP	T1,DF10				;TRY NEXT POW OF 10
	SOJA	EXPON,PFINCR			;NO, EXPON IS SMALLER STILL
PFDECR:						;DECR NUM TO 1 TO 10 RANGE
	DMOVE	T3,DF1				;AVOID REPEATED DIVISIONS
PFDECLP:
	DMOVEM	T3,FLOTMP(CF)			;ADJ BELOW BY 1 POW LT BOUND
	DFMP	T3,DF10				;PREP TO CHK IF NUM GTR 10**N
	CAML	T1,T3				;IS IT?
	AOJA	EXPON,PFDECLP			;YES, STILL MORE NRMIZING TO DO
						;IF T1 INIT IN RANGE, FALLS THRU 1ST TIME
	DFDV	T1,FLOTMP(CF)			;ADJ NUM TO 1 TO 10
PFNORM:
	SETZB	T4,TAP				;MANTISSA TOT & LOW ORD VAL FOR DFSB
PFMAN1:
	FIX	TF,T1				;GET CURR HI ORD DIGIT
	CAIN	MAXDIG,1			;DOWN TO LOW DIGIT?
	FIXR	TF,T1				;YES, ROUND THIS TIME
	IMULI	TAP,^D10			;MAKE ROOM FOR NEW 1'S DIGIT
	ADD	TAP,TF				;MERGE IT
	FLTR	T3,TF				;GET JUST INTEG PART BACK
	DFSB	T1,T3				;MAP X.Y TO .Y
	DFMP	T1,DF10				;MAP .Y TO Y.Z TO REPEAT LOOP
	SOJG	MAXDIG,PFMAN1			;PROC NEXT LOWER DIG
PFM1X:
	MOVE	T1,[^D10000000]			;NUM AT LEAST 10 MILLION
	EXCH	T1,TAP				;PUT DIVISOR IN TAP
	CAME	T1,[^D100000000]			;SPEC CASE OF 100 MILLION?
	$SKIP					;YES
		$CALL	PUTSTR,<[ASCIZ/1/],[0]>	;PUT OUT THE 1 SIGNIF DIG
		AOJA	EXPON,PFOEXP		;MERGE WITH EXPONENT
	$ENDIF
	MOVE	T3,CHBUFP			;PT TO BUF TO BUILD ASC MANTISSA
	SETZM	STRLEN(CF)			;SET INIT LEN TO 0
PFMAN2:
	IDIV	T1,TAP				;ISOL HI-ORD DIGIT & REMAINDER
	ADDI	T1,60				;CONV IT TO ASCII
	IDPB	T1,T3				;PUT IT IN MANTISSA STRING
	AOS	STRLEN(CF)			;BUMP LEN
	MOVE	T1,T2				;MAKE REMAINDER THE DIVIDEND
	IMULI	T1,^D10				;MAKE DIVIDEND GTR 100 MIL AGAIN
	JUMPN	T1,PFMAN2			;PICK OFF NEXT DIGIT
PFOUT:
	$CALL	PUTSTR,<CHBUFP,STRLEN(CF)>	;OUTPUT MANTISSA
PFOEXP:
	$CALLB	TX$CON,<DESIG,[EXPFMT],EXPON>	;OUTPUT EXPON INFO
	SKIPGE	OV.CAS				;APPENDING?
	MOVE	DESIG,OV.DSIG			;GET LAST POS BACK
	RETURN
$ENDUTIL
$ENDSCOPE(PUTFLO)
$UTIL	(PUTOCT,<NUMVAL>)
;
; PUTOCT - OUTPUTS OCTAL NUMBER
; ARGUMENTS:
;	NUMVAL = VAL TO OUTPUT
	MOVE	T2,@0(AP)			;MATER VAL
	MOVEI	T3,^D12				;MAX # OF BYTES
	MOVE	T4,CHBUFP			;THE DEST
	ADDI	CAP,1				;HOP OVER ARG JUST PUT IN T2
CAOCLP:
	SETZM	T1				;START WITH CLEAN SLATE
	LSHC	T1,3				;MOVE A DIGIT TO T1
	CAMN	T4,CHBUFP			;IS IT A LEADING BYTE?
	JUMPE	T1,L$IFX			;;NO, IGNORE IF THE LEADING BYTE IS 0
	  ADDI T1,"0"				;MAKE IT A CHAR
	  IDPB T1,T4				;PUT IT AWAY
	$ENDIF
	CAME	T4,CHBUFP			;NON-0 IN LEFT HALF?
	CAIE	T3,7				;HALF DONE SOURCE?
	$SKIP					;YES TO BOTH
	  MOVEI	T1,","				;PUT OUT IN HALF-WORD FMT
	  IDPB	T1,T4				;COMMA1
	  IDPB	T1,T4				;COMMA2
	$ENDIF
	SOJG	T3,CAOCLP			;GONE THRU ALL 12 POTENT DIGITS?
	MOVEI	T1,"0"				;PRESUME 0 NUMBER
	CAMN	T4,CHBUFP			;IS 0 IF NOTHING COPIED
	IDPB	T1,T4				;YES, PUT OUT 1 0
	IDPB	T2,T4				;MAKE IT ASCIZ (BY NOW T2==0)
	$CALL	PUTSTR,<CBUF(CF),[0]>		;PUT IT OUT
	RETT
$ENDUTIL
$ENDSCOPE(MSG-OUTPUT)
SUBTTL	ROUTINES THAT DO OUTPUT

$UTIL	(PUTERS,<CODERR>)
;
; PUTERS - DO ERSTR FOR SPECIFIED ERROR
; ARGUMENTS:
;	CODERR = CODE OF ERR TO OUTPUT
	MOVE	2,@0(AP)			;GET THE CODE
	IFN TOP$10,<HALT>
	IFN TOP$20,<
	  HRLI	2,.FHSLF			;DO FOR CURR PROCESS
	  JRST	PUERMRG				;DO COMMON STUFF
	>
;
$ENTRY	(PUTLER)
;
; PUTLER - CONSTRUCTS ERROR STRING FOR THE MOST RECENT MONITOR ERROR
;
	$CALL	PUTSTR,<[ASCIZ/Reason is: /],[0]> ;GIVE IT HDR
	IFN TOP$20,<
	  HRLOI	2,.FHSLF			;LAST ERR FOR SELF
PUERMRG:
	  MOVE	1,CHBUFP				;SETUP THE DEST LOC
	  SETZM	3				;ALWAYS ENOUGH ROOM FOR MSG
	  ERSTR%
	    JFCL				;CANT HAPPEN
	    JFCL				;OH YEAH
	>
	$CALL	PUTSTR,<CBUF(CF),[0]>		;APPEND IT TO CURR OUTPUT STRING
;???	HRRZS	TCS.EC				;INDIC JSYS ERR NO LONGER "ACTIVE"
	RETT
$ENDUTIL

$UTIL	(PUTDT,<DTFLAG,INTDT>)
;
; PUTDT - CONVERTS INTERNAL DATE/TIME TO EXT FMT
; ARGUMENTS:
;	DTFLAG = JSYS FLAG
;	INTDT = INTERNAL DATE/TIME
	MOVE	2,@INTDT(AP)			;THE INTERNAL D/T
	MOVE	3,@DTFLAG(AP)			;MATER THE FLAGS
	IFN TOP$20,<
	  MOVE	1,CHBUFP				;PLACE TO BUILD DATE
	  ODTIM%					;DO IT
	  ERC	(OWE)				;COULDNT PUT IT OUT
	  $CALL	PUTSTR,<CBUF(CF),[0]>		;ACTU PUT DATE OUT
	>
	POPJ	P,
$ENDUTIL
$UTIL	(PUTSTR,<ASTRING,LENSTR>)
;
; PUTSTR - OUTPUTS THE STRING TO THE SPECIFIED DESIGNATOR
; ARGUMENTS:
;	ASTRING = BYTE PTR TO WHAT IS BEING OUTPUT
;		= OR THE STRING ITSELF
;	LENSTR = MAX LENGTH OF THE STRING OR 0
;		= IF 0, STRING MUST BE ASCIZ

	MOVE	3,@LENSTR(AP)		;PICK UP STRING LENGTH
	MOVE	2,@ASTRING(AP)		;ASSUME BYTE PTR
	LOAD	1,BP.SIZ+2		;GET BYTE SIZE FLD
	CAIE	1,7			;IS IT ASCII BYTE?
	MOVEI	2,@ASTRING(AP)		;NO, TREAT AS STRING ITSELF
PUTMEM:					;CHK IF "OUTPUTTING" TO MEM
	TLNN	DESIG,777700		;YES, IF DESIG IS BYTE PTR
	$SKIP				;YES
	  PUSHJ P,PCOPYM		;DO WORK 2=SRC,3=LEN,1=DEST
	  RETT				;DONE
	$ENDIF
PUTOUT:
	IFN TOP$10,<
	  TLNN	2,777700		;IS SOURCE A BP?
	  SKIPE	3			;IS THERE A LEN?
	  $NOSKIP			;YES TO EITHER, SO FIX
	    PUSH P,DESIG		;KLUDGE, USE DESIG AS BP IN PCOPYM
	    MOVE DESIG,CHBUFP		;SET DEST
	    PUSHJ P,PCOPYM		;YES TO EITHER, SO FIX
	    SETZM 3			;INSURE ASCIZ
	    IDPB 3,DESIG			;PUT OUT TRAILING NUL BYTE
	    POP P,DESIG			;GET DESIG BACK 
	    MOVEI 2,CBUF(CF)		;SET UP PTR TO WHERE COPIED
	  $ENDIF
	  OUTSTR 0(2)			;OUTPUT THE STRING
	>
	IFN TOP$20,<
	MOVE	1,DESIG			;TELL SOUT THE OUTPUT STREAM
	  TLNN 2,777700			;BP?
	  HRLI 2,440700			;NO, MAKE 1
	  SETZM 4			;SCAN TO NUL-BYTE IF APPLIC
	  SOUT%				;DO IT
	  ERC	(OWE)			;TXT OUTPUT WRITE ERR
	>
	RETT
PCOPYM:
;
; PCOPYM - COPY ASCII STRING TO MEM
; ARGS: DESIG=DEST BP, 2=SRC BP, 3=LEN OR 0
; RETURNS:
;	UPDATED BP'S
	TLNN T2,777700		;BP?
	HRLI T2,440700		;NO, MAKE 1
PUTMLP:
	ILDB	TAP,T2			;GET FROM SOURCE
	JUMPE	TAP,PCOPYX		;EXIT IF HIT ASCIZ BYTE
	IDPB	TAP,DESIG		;STOR TO DEST
	SKIPL	OV.CAS			;APPENDING?
	$SKIP				;YES
	  AOS	T1,TXT$CC		;INCR CHARS COPPED
	  CAMGE	T1,OV.LEFT		;FILLED BUF?
	  JRST	L$IFX			;NO
	  PUSH	P,T2			;SAVE SRC BP
	  PUSH	P,T3			;SAVE CNT OF HOW MUCH LEFT
	  PUSHJ	P,@OV.ACT		;CALL THE FLUSH ROUTINE
	  POP	P,T3			;GET CNT BACK
	  POP	P,T2			;GET SRC BP BACK
	  MOVE	DESIG,OV.DSIG		;RESET CURR POS TO START OF BUF
	$ENDIF
	SOJN	T3,PUTMLP		;LP TIL CNT EXH OR INFIN IF ASZ
PCOPYX:
	POPJ	P,
$ENDUTIL

PRGEND
TITLE	RMSERR - CENTRAL MODULE FOR HANDLING EXCEPTIONAL ERRORS
SUBTTL	S. COHEN
SEARCH	RMSINT,RMSMAC
$PROLOG

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

ENTRY	TRAP.H
SUBTTL	THE MGR FOR "SYSTEM" ERRORS

$IMPURE
;$GDATA	(TCS.EC)				;TCS ERROR CODE, SETUP BY UNWINDER
;$GDATA	(TCS.EH)				;SIXBIT ERR MSG PREFIX (EG. CON)
;$GDATA	(TCS.FM)				;LH: -1=IERR, 0=OTHER
						;RH: ADDR OF FMT STAT FOR MSG CURR IN TCS.SV
;$GDATA	(TCS.PC)				;PC IMMED PAST THE TRAP
;$GDATA	(TCS.SV,^D27)				;ONE-LINE BUF FOR SAVED MSG

DEFINE TCS.EC<T4>
DEFINE TCS.PC<T3>
$PURE
DEFINE $FMT(X,Y)<X==:0>			;MAKE IT A NOOP
$FMT	(RM$FPE,<page of form file improperly formatted>)
$FMT	(RM$FRE,<read of form file failed>)
$FMT	(RM$FRO,<root of form file not found>)
$FMT	(RM$FWE,<write of form file failed>)
$FMT	(RM$MMI,<unable to initialize memory manager>)
$FMT	(RM$MMX,<free memory exhausted>)
$FMT	(RM$NME,<no message set up for error>)
$FMT	(RM$OOP,<unable to open text file>)
$FMT	(RM$OWE,<unable to output text message>)

$FMT	(RM$ISE,<internal software error>)
RM$ARG==:RM$ISE
RM$COP==:RM$ISE
RM$CVO==:RM$ISE
RM$MBO==:RM$ISE
RM$MDI==:RM$ISE
RM$MPX==:RM$ISE
RM$MSZ==:RM$ISE
RM$OAL==:RM$ISE
RM$OST==:RM$ISE
RM$TAL==:RM$ISE
SUBTTL	ERROR CODE AND ONE-TIME CODE

; TRAP.H - SETS UP ERROR DATA & "RETURNS" TO DESIRED LOCATION
; ARGUMENTS:
;	FH.OCF(CF) FOR THE REG UNWINDING
;	FH.EH(CF) TO DETERM THE APPROP RETURN LOCATION
; RETURNS:
;	TF = TCSERR ERROR CODE
;	T1 THRU T4 AS AT TIME OF TRAP
;	TCS.EC == -1,,VAL(TF) IF JSYS ERROR / AS-IS,,VAL(TF) OTHERWISE
; NOTES:
;	$EH(LABEL) (IMPLIES TAP GTR 0): ALWAYS JUMP TO SPEC LABEL
;	$EH	(IMPLIES TAP -1)
;		ERR DEF BY H$RET (IMPLIES T5=-1): RET TO LEVEL OF $EH
;		ERR DEF BY H$GO (IMPLIES T5=0): GOTO 1ST ENCOUNTERED $EH(LABEL)
	TDZA	T5,T5			;INDIC TRAP ERR CODE
	SETOM	T5			;INDIC USER ERR CODE
TRAP.H::
	JFCL				;AVAIL SO "HALTF" CAN BE INSERTED FOR DEBUGGING PURPOSES
	POP	P,TAP			;FIGURE OUT WHICH ERROR
	HRRZS	TAP			;MAKE SURE NO FLAGS IN LEFT HALF
	MOVEI	TF,-EH.1##(TAP)		;ERR CODES WILL RANGE FROM 0 IN BOTH DIR
	HRRZ	TAP,0(P)		;GET PTR TO INST AFTER ERR CALL
	MOVEM	TAP,TCS.PC		;PRESERVE PC OF TRAP
	HLRZ	TAP,-2(TAP)		;CHK FOR IMPLIC JSYS ERR
	CAIN	TAP,(JSYS)		;IS INST BEFORE ERRH A JSYS?
	HRROS	TCS.EC			;YES, INDIC THAT JSYS ERR ACTIVE
	HRRM	TF,TCS.EC		;MERGE IN TCS ERR, NOTE THAT LH TCS.EC GUARAN 0K
TRAPLP:					;LOOP TO UNWIND STACK AFTER THE TRAP
	LOAD	TAP,FH.EH(CF)		;GET THE DEFINED ERR HANDLER IF 1
	JUMPE	TAP,L$IFX		;JUMP SAYS NONE
	  $ZERO	FH.EH(CF),0		;PREVENT ERR HANDLER FROM INTERCEPTING ITSELF
					;(,0 SUPPRESSES TEMP REG UPD)
	  CAIE	TAP,-1			;IS IT RETF-SIMUL HANDLER? (CANT SIMUL RETF TO SELF)
	  JRST 0(TAP)			;NO, GO TO EXPLIC ERR HANDLER
	$ENDIF
	HRRZ	TAP,FH.OCF(CF)		;GET THE PREV CF
	LOAD	TAP,FH.EH(TAP)		;GET HIS TRAP CTL FIELD
	CAIN	TAP,-1			;DID PROC SPEC RETF-SIMUL HANDLER?
	JUMPL	T5,TRAPUN		;YES, IS IT AN H$RET TRAP?
TRAPLE:
	XMOVEI	TAP,TRAPLP		;NO, "RETURN" TO THIS LOOP
	MOVEM	TAP,FH.RET(CF)		;DONE
TRAPUN:					;UNWIND ANOTHER LEVEL
	LOAD	TAP,FH.ENT(CF)		;+1 OF LOC THAT TELLS REGS SAVED
	JUMPN	TAP,L$IFX		;FH.ENT CAN BE 0 ONLY IF RUNNING OFF STACK
	  HALT				;2ND ORDER INTERNAL ERROR
	$ENDIF
	HRRZ TAP,-1(TAP)		;GET THE EN.. LABEL FROM THE 1ST INST OF ROUTINE
	SUBI TAP,EN..7			;DETERM HOW FAR FROM TOP OF RESTORE SEQ IT IS
	JRST EX..7(TAP)			;START WITH THAT REG

ABORT.::				;DETERM NUMBER OF PROC REGS TO RESTORE
	SETZM	TF			;BUT JUST START WITH INDIC FAILURE RET
	JRST	TRAPUN			;JRST UNWIND TO CALLER
TRAP.U::				;RESUME UNWIND WITH EXISTING ERR CODE
	SETZM	T5			;RESUME IMPLIES TRAP ERR
	JRST	TRAPLE			;RESUME UNWINDING LOOP
END