Trailing-Edge
-
PDP-10 Archives
-
RMS-10_T10_704_FT2_880425
-
10,7/rms10/rmssrc/rmsmes.mac
There are 6 other files named rmsmes.mac in the archive. Click here to see a list.
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
DC 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
DC 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
DC T3,T5 ;WRITE IT
AOJL T4,R50CLP ;LOOP BACK
DC 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:
LC 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
DC 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:
LC TAP,T1 ;GET A 6BIT CHAR
ADDI TAP,40 ;MAKE IT ASCII
DC TAP,T2 ;PUT IT AWAY
SOJG T3,SIX.LP ;COP ANOTHER
DC 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
DC 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
DC 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
DC T1,T4 ;COMMA1
DC 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
DC T1,T4 ;YES, PUT OUT 1 0
DC 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
DC 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:
LC TAP,T2 ;GET FROM SOURCE
JUMPE TAP,PCOPYX ;EXIT IF HIT ASCIZ BYTE
DC 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:
MOVEI 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