Trailing-Edge
-
PDP-10 Archives
-
BB-D480F-SB_FORTRAN10_V10
-
mthcnv.mac
There are 7 other files named mthcnv.mac in the archive. Click here to see a list.
SEARCH MTHPRM
TV MTHCNV Conversion routines and tables, 2(4010)
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
;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 WHICH IS NOT SUPPLIED BY DIGITAL.
COMMENT \
***** Begin Revision History *****
4003 JLC 8-Sep-83
Moved POWTAB from FORLIB.
4004 JLC 26-Sep-83
Moved most of the rest of FORCNV here. Reworked integer
output code to use string instructions.
4005 JLC 5-Oct-83
Added code to do truncation for FLOUT if %FTAST not set.
Fixed INTO to suppress leading blanks if %FTSLB set.
4006 JLC 27-Oct-83
Fix new FLOUT to handle outsize scale factors and decimal widths.
4007 JLC 29-Feb-84
Change references to F to S3, a new MTHPRM definition.
4010 JLC 16-Mar-84
Changed the fatal error calls to $ACALL.
\
PRGEND
TITLE FLIRT FLOATING POINT INPUT
SUBTTL DAVE NIXON AND TOM EGGERS
SUBTTL D.M.NIXON /DMN/DRT/HPW/MD/CLRH/DCE/CYM 28-Oct-81
SEARCH MTHPRM
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
;ALL RIGHTS RESERVED.
SEGMENT DATA
%FLESG: BLOCK 1 ;EXPONENT SIGN FLAG
%FLFSG: BLOCK 1 ;FRACTION SIGN FLAG
%FLRFR: BLOCK 2 ;RAW FRACTION
%FLRBX: BLOCK 1 ;RAW BINARY EXPONENT
%FLINF: BLOCK 1 ;DECIMAL POINT OR EXPONENT FOUND
SEGMENT CODE
ENTRY %FLIRT,%GRIN,%ERIN,%DIRT,%REALI,%FLSPR,%FLDPR,%FLGPR
INTERN %FLRFR,%FLRBX,%FLFSG,%FLINF
EXTERN %IBYTE,%FWVAL,%DWVAL
EXTERN IO.ADR,IO.TYP,%SAVE4,%SCLFC,ILLEG.
EXTERN %HITEN,%LOTEN,%EXP10,%PTMAX,%HIMAX,%SIZTB
EXTERN %EEMUL,%EEDIV,%EENRM
EXTERN %SKIP
EXTERN %BZFLG
EXTERN %FIXED,%ERTYP
;IF THE FLAG ILLEG. HAS BEEN SET (BY A CALL TO ILL), THE
;INPUT VALUE WILL BE SET TO 0 IF ANY ILLEGAL CHARACTERS
;ARE SCANNED FOR THAT VALUE.
;THE SYNTAX ANALYSIS FOR THE SINGLE AND DOUBLE PRECISION INPUT
;IS STATE TABLE DRIVEN. EACH NEW INPUT CHARACTER IS CONVERTED TO
;A CHARACTER TYPE AND COMBINED WITH THE OLD "STATE". THIS RESULT
;IS THEN LOOKED UP IN THE TABLE "NXTSTA" TO GET THE NEW STATE AND
;AN INDEX INTO THE "XCTTAB" TABLE TO DISPATCH FOR THE INPUT
;CHARACTER. THE STATE TABLE LOGIC AND THE DISPATCH ROUTINES BUILD
;THREE RESULTS: A DOUBLE PRECISION INTEGER(IN B,C) FOR THE FRACTIONAL
;PART OF THE RESULT, AN INTEGER(IN XP) FOR THE EXPONENT AFTER
;"D" OR "E", AND A COUNTER(IN "X") TO KEEP TRACK OF THE DECIMAL POINT.
;WHEN A TERMINATING CHARACTER IS FOUND, THE DOUBLE PRECISION INTEGER
;IS NORMALIZED TO THE LEFT TO GIVE A DOUBLE PRECISION FRACTION.
;THE DECIMAL POINT POSITION(FROM "X")OR THE IMPLIED DECIMAL POINT
;POSITION FROM THE FORMAT STATEMENT, THE "D" OR "E" EXPONENT, AND ANY
;SCALING FROM THE FORMAT STATEMENT ARE COMBINED INTO A DECIMAL
;EXPONENT. THIS DECIMAL EXPONENT IS USED AS AN INDEX INTO A POWER
;OF TEN TABLE (KEPT IN DOUBLE PRECISION INTEGER PLUS EXPONENT FORM
;SO INTERMEDIATE RESULTS WILL HAVE 8 MORE BITS OF PRECISION THAN
;FINAL RESULTS) TO MULTIPLY THE DOUBLE PRECISION FRACTION. THIS
;RESULT IS THEN ROUNDED TO GIVE A SINGLE PRECISION,
;PDP6/KI10 DOUBLE PRECISION RESULT.
;OVERFLOWS RETURN THE LARGEST POSSIBLE
;NUMBER (WITH CORRECT SIGN), WHILE UNDERFLOWS RETURN 0.
;ACCUMULATOR DEFINITIONS
A==T0
B=A+1 ;RESULT RETURNED IN A OR A AND B
C=B+1 ;B,C, AND D ARE USED AS A MULTIPLE PRECISION
D1=C+1 ; REGISTER FOR DOUBLE PRECISION OPERATIONS
E=D1+1 ;EXTRA AC
XP=T5 ;EXPONENT AFTER D OR E
BXP=P1 ;BINARY EXPONENT
ST==P1 ;STATES
;P2 ;Used for really temp purposes only
W==P3 ;FIELD WIDTH
X==P4 ;COUNTS DIGITS AFTER POINT
;RIGHT HALF FLAGS IN AC "F"
DOTFL==1 ;DOT SEEN
EXPFL==2 ;EXPONENT SEEN IN DATA (MAY BE 0)
LOCFLG==DOTFL+EXPFL
;INPUT CHARACTER TYPES
NULTYP==1 ;NULL
DOTTYP==2 ;DECIMAL POINT
DIGTYP==3 ;DIGITS 0-9
SPCTYP==4 ;SPACE OR TAB
EXPTYP==5 ;D OR E
PLSTYP==6 ;PLUS SIGN (+)
MINTYP==7 ;MINUS SIGN (-)
;ANYTHING ELSE IS TYPE 0
%DIRT:
%ERIN:
%GRIN:
%FLIRT: ;INPUT
MOVE T1,IO.TYP ;GET DATA TYPE
JUMPE T1,%REALI ;IF ZERO, JUST READ INTO RAW COMPONENTS
CAIN T1,TP%DPX ;G-FLOATING?
JRST GPIN ;YES
MOVE T1,%SIZTB(T1) ;NO. GET ENTRY SIZE
CAIN T1,2 ;DOUBLE PRECISION?
JRST DPIN ;YES
SPIN: PUSHJ P,%REALI ;GET RAW COMPONENTS
PJRST %FLSPR ;AND CONVERT TO SINGLE PRECISION
DPIN: PUSHJ P,%REALI ;GET RAW COMPONENTS
PJRST %FLDPR ;AND CONVERT TO DOUBLE PRECISION
GPIN: PUSHJ P,%REALI ;GET RAW COMPONENTS
PJRST %FLGPR ;AND CONVERT TO G-FLOATING
%REALI: PUSHJ P,%SAVE4 ;SAVE P1-P4
SETZM %FLRFR ;CLEAR ALL RAW DATA AND EXPS
SETZM %FLRFR+1
SETZM %FLRBX
TXZ S3,LOCFLG ;CLEAR LOCAL FLAGS IN F
SETZM %FLFSG ;CLEAR FRACTION SIGN
SETZM %FLESG ;AND EXPONENT SIGN
SETZM %FLINF ;CLEAR INFORMATION WORD
MOVE W,%FWVAL ;GET THE FIELD WIDTH
SETZB C,D1 ;INIT D.P. FRACTION
SETZB ST,XP ;INIT STATE AND DECIMAL EXPONENT
SETZ X, ;INIT "DIGITS AFTER POINT" COUNTER
JUMPG W,GETCH1 ;FIELD SPECIFIED
SETO W, ;SET FREE FORMAT FLAG
PUSHJ P,%SKIP ;FREE FORMAT - SKIP SPACES
JRST ENDF1 ;COMMA OR EOL = NULL FIELD
JRST GETCH2 ;PROCESS FIELD
GETNXT:
GETCHR: JUMPE W,ENDF1 ;END OF FIELD
LSH ST,-^D30 ;MOVE STATE TO BITS 30-32
GETCH1: PUSHJ P,%IBYTE ;GET NEXT CHARACTER
GETCH2: JUMPE T1,GOTNUL ;GO SET NULL FLAG FOR NULL
CAIL T1,"0" ;CHECK FOR NUMBER
CAILE T1,"9"
JRST CHRTYP ;NO, TRY OTHER
SUBI T1,"0" ;CONVERT TO NUMBER
GOT1: IORI ST,DIGTYP ;SET TYPE
GOTST: MOVE ST,NXTSTA(ST) ;GET NEXT STATE
ROT ST,-3 ;PUT DISPATCH ADDRESS IN BITS 32-35
; AND NEW STATE IN BITS 0-2
MOVEI P2,(ST) ;GET JUST DISPATCH INDEX
XCT XCTTAB(P2) ;DISPATCH OR EXECUTE
SOJA W,GETNXT ;RETURN FOR NEXT CHAR.
GOTNUL: IORI ST,NULTYP ;FLAG GOT NULL
JRST GOTST ;BACK FOR DISPATCH
XCTTAB: JRST ILLCH ; (00) ILLEGAL CHAR
JRST NULLIN ; (01) NULL [JLC]
IORI S3,DOTFL ; (02) PERIOD
JRST DIG ; (03) DIGIT BEFORE POINT
JRST BLNKIN ; (04) BLANK OR TAB
SOJA W,GETNXT ; (05) RETURN FOR NEXT CHAR.
SETOM %FLFSG ; (06) NEGATIVE FRACTION
SETOM %FLESG ; (07) NEGATIVE EXP
SOJA X,DIGAFT ; (10) DIGIT AFTER POINT
JRST DIGEXP ; (11) EXPONENT
JRST DELCK ; (12) DELIMITER TO BACK UP OVER
CHRTYP: CAIN T1,"+" ;CONVERT INPUT CHARS TO CHARACTER TYPE
IORI ST,PLSTYP
CAIN T1,"-"
IORI ST,MINTYP
CAIE T1," " ;SPACE
CAIN T1," " ;TAB
IORI ST,SPCTYP
CAIE T1,"." ;DECIMAL POINT?
JRST NOTDOT ;NO
IORI ST,DOTTYP
HRROS %FLINF ;SIGNAL DECIMAL POINT FOUND
NOTDOT: CAIE T1,"D"
CAIN T1,"E"
JRST GOTEXP
CAIE T1,"d" ;LOWER CASE D?
CAIN T1,"e" ;LOWER CASE E?
JRST GOTEXP ;YES
JRST GOTST ;NO
GOTEXP: IORI ST,EXPTYP ;SET STATUS FOR EXPONENT
HRROS %FLINF ;SET INFO FOR EXPONENT FOUND
JRST GOTST ;GO DISPATCH ON OLD STATE AND CHAR TYPE
DIGAFT: AOS %FLINF ;INCR # DIGITS AFTER DOT
DIG: JUMPN C,DPDIG ;NEED D.P. YET?
CAMLE D1,MAGIC ;NO, WILL MUL AND ADD CAUSE OVERFLOW?
JRST DPDIG ;MAYBE, SO DO IT IN DOUBLE PRECISION
IMULI D1,12 ;NO, MULTIPLY BY 10 SINGLE PRECISION
ADD D1,T1 ;ADD DIGIT INTO NUMBER
SOJA W,GETNXT ;GO GET NEXT CHARACTER
DPDIG: CAMLE C,MAGIC ;WILL MULTIPLY AND ADD CAUSE OVERFLOW?
AOJA X,DIGRET ;YES
IMULI C,12 ;MULTIPLY HIGH D.P. FRACTION BY 10
MULI D1,12 ;MULTIPLY LOW D.P. FRACTION BY 10
ADD C,D1 ;ADD HI PART OF LO PRODUCT INTO RESULT
MOVE D1,E ;GET LO PART OF LO PRODUCT
TLO D1,(1B0) ;STOP OVERFLOW IF CARRY INTO HI WORD
ADD D1,T1 ;ADD DIGIT INTO FRACTION
TLZN D1,(1B0) ;SKIP IF NO CARRY INTO HI WORD
ADDI C,1 ;PROPOGATE CARRY INTO HI WORD
DIGRET: SOJA W,GETNXT ;DECREMENT FIELD WIDTH AND GET NEXT CHAR
MAGIC: <377777777777-9>/^D10 ;LARGEST NUM PRIOR TO MULTIPLY AND ADD
DIGEXP: HRROS %FLINF ;SET INFO FOR EXPONENT FOUND
IORI S3,EXPFL ;SET FLAG TO SAY WE'VE SEEN EXPONENT
IMULI XP,12 ;MULTIPLY BY TEN
ADD XP,T1 ;ADD IN NEXT DIGIT
SOJA W,GETNXT ;DECREMENT FIELD WIDTH AND GET NEXT CHAR
;LAST DIGIT IS THE NEXT STATE NUMBER
;1ST 2 DIGITS ARE THE "ACTION" TO TAKE
;STATE 0 = NOTHING SIGNIFICANT READ YET
;STATE 1 = DIGIT OR SIGN SEEN
;STATE 2 = DECIMAL POINT SEEN
;STATE 3 = D OR E SEEN
;STATE 4 = SIGN SEEN AFTER DIGITS OR D OR E
; ? ,CR , . ,0-9, ,D E, + , - ,
NXTSTA: EXP
000,050,022,031,050,000,051,061,
000,011,022,031,041,053,054,074,
000,012,120,102,042,053,054,074,
000,013,120,114,043,000,054,074,
000,014,120,114,044,000,120,120
;ERROR PROCESSING. IF A REAL ILLEGAL CHARACTER (E.G. ALPHA CHAR) IS
;FOUND DIRECTLY AFTER A NUMBER, IT IS ILLEGAL. IF THE "ILLEGAL FLAG" (ILLEG.)
;IS SET, WE JUST IGNORE THE REST OF THE INPUT AND SET THE RESULT
;TO 0.
ILLCH:
DELCK: CAME W,[-1] ;FIRST ILLEGAL CHAR IN FREE FORMAT
JUMPL W,ENDF ;NO - DELIMITER OF FREE FORMAT
SKIPE ILLEG. ;ILLEGAL CHAR. FLAG SET?
JRST ERROR1 ;YES. THROW AWAY REST AND SET RESULT=0
$ACALL ILC ;"ILLEGAL CHARACTER IN DATA"
POPJ P, ;RETURN TO FOROTS
;[JLC]
;NULL IS A LEGAL CHARACTER, TREATED AS IF IT WERE A BLANK WITH
;BLANK='NULL' SPECIFIED.
NULLIN: JUMPL W,ENDF ;DONE IF FREE FORMAT
SOJA W,GETNXT ;OTHERWISE JUST SKIP IT
;THE STATE IS NOT DISTURBED BY BLANKS, THUS IF BZ IS ON (BLANK=ZERO)
;WE CAN MIMIC THE CODE AT GETNXT (MOVING THE STATE TO BITS 30-32) AND
;JUMP TO THE PLACE WHERE A DIGIT WOULD HAVE GONE.
BLNKIN: SETZ T1, ;SET TO NULL CHAR
JUMPL W,ENDF ;FREE FORMAT
SKIPN %BZFLG ;BLANK=ZERO?
SOJA W,GETNXT ;NO. SKIP THE SPACE
LSH ST,-^D30 ;YES. PUT STATE IN BITS 30-32
JRST GOT1 ;AND USE IT
ERROR1: SOJLE W,ZERO ;HAVEN'T DECR WIDTH YET
PUSHJ P,%IBYTE ;THROW AWAY CHAR
JRST ERROR1 ;KEEP GOING UNTIL DONE
ENDF:
ENDF1: DMOVE A,C ;MOVE 2-WORD RESULT TO BOTTOM AC'S
TXNE S3,DOTFL ;HAS DECIMAL POINT BEEN INPUT?
JRST ENDF2 ;YES
MOVE D1,%DWVAL ;NO, GET DIGITS AFTER POINT FROM FORMAT
SUB X,D1 ; AND MODIFY DECIMAL EXPONENT
ENDF2: HRRE D1,%SCLFC ;GET SCALE FACTOR
TXNN S3,EXPFL ;EXPONENT IN DATA?
SUB X,D1 ;NO, ADD INTO EXPONENT
SKIPE %FLESG ;WAS D OR E EXPONENT NEGATIVE?
MOVNS XP ;YES, SO NEGATE IT
ADD X,XP ;ADD EXPONENT FROM D OR E
NORM: MOVEI BXP,106 ;INIT BINARY EXPON FOR D.P. INTEGER
JUMPN A,NORM1 ;XFER IF AT LEAST ONE 1 IN HIGH HALF
EXCH A,B ;HIGH HALF ZERO, MOVE LOW HALF TO HIGH,
;AND CLEAR LOW HALF
SUBI BXP,^D35 ;AND ADJUST EXPONENT FOR 35 SHIFTS
NORM1: JUMPE A,ZERO ;LEAVE IF BOTH WORDS ZERO
MOVE D1,A ;COPY 1ST WORD
JFFO D1,NORM2 ;FIND 1ST BIT
NORM2: ASHC A,-1(E) ;NORMALIZE D.P. INTEGER WITH BIN POINT
;BETWEEN BITS 0 AND 1 IN HIGH WORD
SUBI BXP,-1(E) ;AND ADJUST EXPON TO ALLOW FOR SHIFTING
JUMPE X,ENDF6 ;IF DECIMAL EXP=0, NO MUL BY 10 NEEDED
ENDF3: CAILE X,%HIMAX ;WITHIN ABSOLUTE G-FLOAT BOUNDS?
JRST EXPTB ;NO. TOO BIG
CAMGE X,[-%HIMAX]
JRST EXPTS ;NO. TOO SMALL
PUSHJ P,EETST ;GO TEST FOR BIG SCALING
MUL B,%HITEN(X) ;LO FRAC TIMES HI POWER OF TEN(RESULT IN B,C)
MOVE E,B ;GET HI PART OF PREVIOUS PRODUCT OUT OF WAY
MOVE B,A ;COPY HI PART OF FRACTION
MOVE C,%LOTEN(X) ;GET LOW POWER OF TEN
ADDI C,1 ;BIAS IT - IT IS TRUNCATED
MUL B,C ;HI FRAC TIMES LO POWER OF TEN
TLO E,(1B0)
ADD E,B ;SUM OF HI PARTS OF CROSS PRODUCTS TO AC T
MUL A,%HITEN(X) ;HI FRACTION TIMES HI POWER OF TEN
TLON E,(1B0) ;DID CARRY OCCUR? ALLOW FOR NEXT CARRY
ADDI A,1 ;CARRY FROM ADDING CROSS PRODUCTS
ADD B,E ;ADD CROSS PRODUCTS TO LO PART
; OF (HI FRAC TIMES HI POW TEN)
TLZN B,(1B0)
AOJA A,ENDF5 ;AND PROPOGATE A CARRY, IF ANY
ENDF5: TLNE A,(1B1) ;NORMALIZED? 1.0 > RESULT >= 0.25
JRST ENDF5A ;YES, RESULT >= 0.5
ASHC A,1 ;NO, SHIFT LEFT ONE PLACE
SUBI BXP,1 ;AND ADJUST EXPONENT
ENDF5A: MOVE X,%EXP10(X) ;GET BINARY EXPONENT
ADD BXP,X ;ADJUST BINARY EXPONENT
ENDF6: DMOVEM A,%FLRFR ;SAVE THE RAW LEFT-JUSTIFIED FRACTION
MOVEM BXP,%FLRBX ;AND THE RAW BINARY EXPONENT
NOCVT: POPJ P,
ZERO: DMOVEM A,%FLRFR ;SAVE 0 IN RAW FRACTION
SETZM %FLRBX ;AND RAW FRACTION
POPJ P,
EXPTB: HRLOI A,377777 ;RETURN HUGE RAW NUMBERS
HRLOI B,377777
SKIPE %FLFSG ;NEGATE IF NECESSARY
DMOVN A,A
DMOVEM A,%FLRFR ;SAVE OVERFLOW AMOUNT
MOVEI A,2000 ;RETURN LARGEST G-FLOAT EXPONENT
SKIPE %FLESG ;NEGATE IF NECESSARY
MOVN A,A
MOVEM A,%FLRBX ;SAVE RAW EXPONENT
POPJ P,
EXPTS: $ECALL FUN ;GIVE FLOATING UNDERFLOW MESSAGE
SETZM %FLRFR ;RETURN ZERO
SETZM %FLRBX
SETZM %FLFSG ;WITH NO SIGNS
POPJ P,
%FLSPR: MOVE A,%FLRFR ;GET HIGH WORD OF RAW FRACTION
JUMPE A,SPZERO ;IF ZERO, DON'T PUT IN AN EXPONENT
MOVE XP,%FLRBX ;GET RAW BINARY EXPONENT
TLO A,(1B0) ;START ROUNDING (ALLOW FOR OVERFLOW)
ADDI A,200 ;NO, ROUND IN HIGH WORD
TRZ A,377 ;GET RID OF USELESS (UNUSED) BITS
TLZE A,(1B0) ;CARRY PROPOGATE TO BIT 0?
JRST SPRET ;NO
ASHC A,-1 ;YES, RENORMALIZE TO RIGHT
ADDI XP,1 ;AND ADJUST BINARY EXPONENT
TLO A,(1B1) ;AND TURN ON HI FRACTION BIT
SPRET: CAIL XP,200 ;OUT OF RANGE
JRST SEXPTB ;YES. TOO BIG
CAMGE XP,[-200]
JRST SEXPTS ;YES. TOO SMALL
ADDI XP,200 ;ADD IN EXCESS 200
ASHC A,-8 ;NO, LEAVE ROOM FOR EXPONENT
DPB XP,[POINT 9,A,8] ;INSERT EXPONENT INTO HI WORD
CSRET: SKIPGE %FLFSG ;RESULT NEGATIVE?
MOVN A,A ;YES. SO NEGATE RESULT
SPZERO: MOVEM A,@IO.ADR ;STORE IN USER AREA
POPJ P, ;RETURN TO USER
SEXPTB: MOVE A,IO.TYP ;GET DATA TYPE
MOVEM A,%ERTYP ;SAVE FOR USER SUBR
HRLOI A,377777 ;SET NUMBER TO LARGEST POSSIBLE
MOVEM A,%FIXED ;SAVE FOR USER CALL
$ECALL FOV ;GIVE FLOATING OVERFLOW MSG
MOVE A,%FIXED ;GET FIXED-UP RESULT
JRST CSRET
SEXPTS: MOVE A,IO.TYP ;GET DATA TYPE
MOVEM A,%ERTYP ;SAVE FOR USER SUBR
SETZM %FIXED ;SETUP FIXED-UP RESULT
$ECALL FUN ;GIVE FLOATING UNDERFLOW MSG
MOVE A,%FIXED ;GET FIXED-UP RESULT
JRST CSRET
DEXPTB: HRLOI A,377777 ;SET NUMBER TO LARGEST POSSIBLE
HRLOI B,377777
DMOVEM A,%FIXED ;SETUP FIXED-UP RESULT
$ECALL FOV ;GIVE FLOATING OVERFLOW MSG
DMOVE A,%FIXED ;GET FIXED-UP RESULT
JRST CDRET
DEXPTS: SETZM %FIXED ;SETUP FIXED-UP RESULT
SETZM %FIXED+1
$ECALL FUN ;GIVE FLOATING UNDERFLOW MSG
DMOVE A,%FIXED ;GET FIXED-UP RESULT
JRST CDRET
;IF RUNNING ON A KL, WE CAN USE THE SPARSE POWER
;OF TEN TABLE TO SCALE THE NUMBER. IT IS ABSOLUTELY NECESSARY
;FOR EXTENDED EXPONENT NUMBERS
EETST: MOVM P2,X ;GET MAGNITUDE OF DECIMAL EXPONENT
CAIG P2,%PTMAX ;WITHIN NORMAL RANGE?
POPJ P, ;YES. JUST DO IT NORMALLY
ASHC A,-1 ;PREVENT DIVIDE CHECK
ADDI BXP,1 ;AND MODIFY BINARY EXPONENT
ASH P2,1 ;CALCULATE FACTOR OF TEN TO USE
IDIVI P2,^D21 ;IN SPARSE TABLE
SUBI P2,2 ;STARTS WITH 10**21
IMULI P2,3 ;AND EACH ENTRY IS 3 LOCS
JUMPL X,EENEG ;GO DO DIVIDE IF EXP NEGATIVE
PUSHJ P,%EEMUL ;OR MULTIPLY IF POSITIVE
SUBI X,(XP) ;REDUCE THE DECIMAL EXP
ADDI BXP,(P3) ;AND ADD THE BINARY EXP FOUND
POPJ P,
EENEG: PUSHJ P,%EEDIV ;DO D.P. DIVIDE
ADDI X,(XP) ;REDUCE MAGNITUDE OF X
SUBI BXP,(P3) ;MODIFY BINARY EXPONENT
POPJ P,
;HERE FOR DOUBLE PRECISION ROUNDING
%FLDPR: DMOVE A,%FLRFR ;GET RAW FRACTION
JUMPE A,DPZERO ;IF ZERO, RETURN ZERO
MOVE XP,%FLRBX ;GET RAW BINARY EXPONENT
TLO A,(1B0) ;START ROUNDING (ALLOW FOR OVERFLOW)
TLO B,(1B0) ;START ROUNDING (ALLOW FOR CARRYS)
ADDI B,200 ;LOW WORD ROUNDING FOR PDP-6 OR KI10
TLZN B,(1B0) ;DID CARRY PROPOGATE TO SIGN?
ADDI A,1 ;YES, ADD CARRY INTO HIGH WORD
TLZE A,(1B0) ;CARRY PROPOGATE TO BIT 0?
JRST DPRET ;NO
ASHC A,-1 ;YES, RENORMALIZE TO RIGHT
ADDI XP,1 ;AND ADJUST BINARY EXPONENT
TLO A,(1B1) ;AND TURN ON HI FRACTION BIT
DPRET: CAIL XP,200 ;OUT OF RANGE
JRST DEXPTB
CAMGE XP,[-200]
JRST DEXPTS ;YES. RETURN ZERO OR INFINITY
ADDI XP,200 ;ADD IN EXCESS 200
ASHC A,-8 ;NO, LEAVE ROOM FOR EXPONENT
DPB XP,[POINT 9,A,8] ;INSERT EXPONENT INTO HI WORD
CDRET: SKIPGE %FLFSG ;RESULT NEGATIVE?
DMOVN A,A ;YES. SO NEGATE RESULT
DPZERO: DMOVEM A,@IO.ADR ;STORE IN USER AREA
POPJ P, ;RETURN TO USER
%FLGPR: DMOVE A,%FLRFR ;GET RAW FRACTION
JUMPE A,GDZERO ;IF ZERO, RETURN ZERO
MOVE XP,%FLRBX ;GET RAW BINARY EXPONENT
TLO A,(1B0) ;START ROUNDING (ALLOW FOR OVERFLOW)
TLO B,(1B0) ;START ROUNDING (ALLOW FOR CARRYS)
ADDI B,2000 ;YES. DO SPECIAL ROUNDING
TLZN B,(1B0) ;DID CARRY PROPOGATE TO SIGN?
ADDI A,1 ;YES, ADD CARRY INTO HIGH WORD
TLZE A,(1B0) ;CARRY PROPOGATE TO BIT 0?
JRST GPRET ;NO
ASHC A,-1 ;YES, RENORMALIZE TO RIGHT
ADDI XP,1 ;AND ADJUST BINARY EXPONENT
TLO A,(1B1) ;AND TURN ON HI FRACTION BIT
GPRET: CAIL XP,2000 ;OUT OF RANGE?
JRST DEXPTB ;YES. TOO BIG
CAMGE XP,[-2000]
JRST DEXPTS ;YES. TOO SMALL
ADDI XP,2000 ;ADD IN EXCESS 2000
ASHC A,-^D11 ;SHIFT TO MAKE ROOM FOR EXP
DPB XP,[POINT 12,A,11];DEPOSIT THE EXPONENT
SKIPGE %FLFSG ;RESULT NEGATIVE?
DMOVN A,A ;YES. SO NEGATE RESULT
GDZERO: DMOVEM A,@IO.ADR ;STORE IN USER AREA
POPJ P, ;RETURN TO USER
PRGEND
TITLE FLOUT FLOATING POINT OUTPUT
SUBTTL D. NIXON AND T. W. EGGERS
SUBTTL JLC - REWORKED FOR USE OF STRING INSTRUCTIONS
SEARCH MTHPRM
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
;ALL RIGHTS RESERVED.
SEGMENT CODE
XP==T5 ;DECIMAL EXPONENT
NOSIGN==1 ;NO SPACE FOR + SIGN
NOEFLG==2 ;DO NOT PRINT "D" OR "E" IN EXPONENT
NOPNT==4 ;DO NOT PRINT THE DECIMAL POINT (FOR FTAST=0)
LOCFLG==NOSIGN+NOEFLG+NOPNT
DPMAX==^D20 ;MAXIMUM NUMBER OF DIGITS TO PRINT
;IF WE PRINT ANY MORE, WE WILL BE LYING TO THE
;USER, AS THIS IS THE MAXIMUM PRECISION OF
;OUR SCALING FACTORS OF 10.
;WE CANNOT KNOW WHETHER THE NUMBER WE
;HAVE IN THE MACHINE IS AN EXACT REPRESENTATION
;OF WHATEVER WAS INPUT - WE MUST ASSUME THAT
;WHAT IS IN THE MACHINE IS EXACTLY WHAT IS DESIRED.
;THEREFORE THERE IS NO REASON NOT TO GIVE AS MANY
;DIGITS AS ARE ACCURATE. THE ONLY LIMITATION ON
;THIS CURRENTLY IS THE SCALING ALGORITHM.
LZALWAYS==1 ;SWITCH FOR ALWAYS PRINTING LEADING ZEROES
LZSOME==0 ;SWITCH FOR SOMETIMES - ALWAYS EXCEPT WHEN
;MANTISSA .LE. 1.0 AND DIGIT OUTPUT WITH
;LEADING ZERO WOULD COMPLETELY FILL THE
;FIELD, A SPACE IS SUBSTITUTED FOR THE
;LEADING ZERO.
ENTRY %FLOUT,%DOUBT,%GROUT,%EOUT
EXTERN %EEMUL,%EEDIV
EXTERN %OBYTE,%EXP10,%HITEN,%LOTEN,%SPFLG
EXTERN %FWVAL,%DWVAL,%XPVAL
EXTERN IO.ADR,IO.TYP,%SCLFC,%SAVE4,%FTAST,%FTSLB
EXTERN %SIZTB,%HIINT,%LOINT
EXTERN %NMEXP,%PMEXP,%OMPAD,%OMSPC,%CBDO
EXTERN %FTSUC
SEGMENT CODE
%EOUT: MOVEI T1,"E" ;OUTPUT AN "E" WITH EXPONENT
MOVEM T1,EXPCHR ;SAVE IT
JRST COMDE ;JOIN COMMON CODE IN %DOUBT
%DOUBT: MOVEI T1,"D" ;OUTPUT A "D" WITH EXPONENT
MOVEM T1,EXPCHR
COMDE: PUSHJ P,%SAVE4 ;SAVE P1-P4
PUSHJ P,FLOCNV ;CONVERT TO FRACTION AND DECIMAL EXPONENT
PUSHJ P,FLOUT6 ;GET FIELD WIDTHS
;E-FORMAT REQUIRES THAT THE NUMBER OF SIGNIFICANT DIGITS IS
;CALCULATED AS FOLLOWS: IF THE SCALE FACTOR IS POSITIVE, ENCODE
;D+1 DIGITS (WHERE D IS THE DECIMAL WIDTH), UNLESS THE SCALE
;FACTOR IS GREATER THAN D+1, IN WHICH CASE ENCODE %SCLFC DIGITS.
;IF THE SCALE FACTOR IS NEGATIVE OR ZERO, ENCODE D+%SCLFC DIGITS, I.E.,
;REDUCE THE NUMBER OF DIGITS ENCODED.
GECNV1: DMOVE T0,%FLRDF ;GET 2-WORD FRACTION AGAIN
MOVE P3,P2 ;GET # DECIMAL PLACES
SKIPLE T2,%SCLFC ;POSITIVE SCALE FACTOR?
MOVEI T2,1 ;YES. SET TO 1 FOR ADD
ADD P3,T2 ;ADD SCLFCT OR 1
CAMGE P3,%SCLFC ;IS SCLFCT .GT. D+1?
MOVE P3,%SCLFC ;YES. ENCODE %SCLFC DIGITS
PUSHJ P,DIGOK ;ENCODE DIGITS
JRST FLOU16 ;NO ROUNDING OVERFLOW OCCURRED
;OVERFLOW ROUNDING OCCURRED. IF NO DIGITS HAVE BEEN ENCODED, DON'T
;TOUCH ANYTHING. IF DIGITS HAVE BEEN ENCODED, THE NUMBER IS
;ONE FACTOR OF 10 TOO BIG, SO RELOAD THE NUMBER WITH THE
;NEXT TABLE ENTRY DOWN.
JUMPG P3,GESCL ;DON'T BOTHER ANYTHING IF NO DIGITS
MOVEI P3,1 ;1 DIGIT HAS BEEN ENCODED
JRST FLOU16 ;GO SAVE IT
GESCL: MOVE T0,%HIINT-1(P3) ;GET SCALED-DOWN FACTOR OF 10
MOVE T1,%LOINT-1(P3)
AOS %FLRDX ;INCREMENT EXPONENT, HOWEVER
FLOU16: DMOVEM T0,%FLINT ;SAVE 2-WORD INTEGER
MOVE P4,%SCLFC ;GET SCALE FACTOR
JUMPLE P4,FLOU17 ;IF FACTOR .LE. 0, GO CHECK EXP
SUBI P1,1 ;EXTRA DIGIT PRINTED
SUBI P2,-1(P4) ;REDUCE DIGITS AFTER POINT
JUMPGE P2,FLOU17 ;TO COMPENSATE FOR THOSE IN FRONT
ADD P1,P2 ;HOWEVER IF NOT ENOUGH LEFT
;TAKE FROM IN FRONT
FLOU17: PUSHJ P,CHEKDE ;CHECK EXPONENT AND FIT, SKIP RETURN IF OK
JRST %FTSUC ;PRINT ASTERISKS IF IT DOESN'T FIT
JRST EFORM ;OUTPUT NUMBER
;G-FORMAT OUTPUT. IF THE VALUE IS .GE. 0.1 AND .LT. 10**D, IT IS
;PRINTED IN F-FORMAT. OTHERWISE IT IS PRINTED IN E-FORMAT. IN THE
;CASE THAT IT IS PRINTED IN F-FORMAT, THE SCALE FACTOR HAS NO EFFECT.
%GROUT: PUSHJ P,%SAVE4 ;SAVE P1-P4
MOVEI T1,"E" ;USE "E" IF WE GO TO E-FORMAT
MOVEM T1,EXPCHR
PUSHJ P,FLOCNV ;CONVERT TO FRACTION AND DECIMAL EXPONENT
PUSHJ P,FLOUT6 ;GET FIELD WIDTHS
;HERE IS THE FIRST G-FORMAT NUMBER FILTER. THE NUMBER IS CHECKED
;IF IT IS "PROPER MAGNITUDE" FOR G-FORMAT. IF THE MAGNITUDE OF THE
;NUMBER IS SMALLER THAN 10**D OR GREATER THAN OR EQUAL TO 0.1,
;THE NUMBER SHOULD BE PRINTED IN F-FORMAT. SINCE THE NUMBER HAS NOT
;BEEN ROUNDED YET, WE CHECK THE NUMBER JUST USING THE DECIMAL EXPONENT,
;AND ALLOW NUMBERS WITH XP GREATER THAN -1 (WHICH COULD INCLUDE
;NUMBERS LESS THAN 0.1). A SECOND CHECK IS DONE AFTER
;THE NUMBER HAS BEEN ENCODED, TO SEE IF ROUNDING FORCED THE NUMBER
;INTO OR OUT OF THE F-FORMAT RANGE.
JUMPE T0,GECNV1 ;IF ZERO, MAKE IT E-FORMAT
MOVE T2,%FLRDX ;GET DECIMAL EXPONENT
CAML T2,[-1] ;IF EXPONENT .LT. 1
CAMLE T2,P2 ;OR .GT. # DECIMAL PLACES
JRST GECNV1 ;MAKE IT E-FORMAT
;HERE WE FIGURE OUT HOW MANY SIGNIFICANT DIGITS TO GET FROM THE
;NUMBER. FOR G-FORMAT, THIS IS JUST "D" (AS IN W.D).
;THE NUMBER IS ENCODED INTO P3 DIGITS, AND THE
;ACTUAL NUMBER IS IN T0/T1.
MOVE P3,P2 ;GET # DECIMAL PLACES
PUSHJ P,DIGOK ;ENCODE DIGITS
JRST GNORND ;DID NOT OVERFLOW ROUND
;OVERFLOW ROUNDING HAS OCCURRED. CHECK THE EXPONENT AGAIN TO SEE
;IF THE NUMBER IS STILL IN RANGE FOR F-FORMAT PRINTING.
CAMG P2,%FLRDX ;IS NON-UPDATED EXPONENT OK?
JRST GECNV1 ;NO. GO PRINT IT AS E-FORMAT
AOS %FLRDX ;UPDATE EXPONENT
ADDI P3,1 ;UPDATE # DIGITS ENCODED
GNORND: DMOVEM T0,%FLINT ;SAVE 2-WORD INTEGER
SKIPGE T2,%FLRDX ;SEE IF EXPONENT STILL NEGATIVE
JRST GECNV1 ;IF SO, PRINT AS E-FORMAT
MOVEI P4,(T2) ;MAKE DECIMAL EXPONENT THE # LEADING DIGITS
SUBI P2,(T2) ;REDUCE DIGITS AFTER POINT
MOVE T2,%XPVAL ;GET EXPONENT WIDTH
CAIN T2,0 ;OR USE DEFAULT
MOVEI T2,2
ADDI T2,2 ;ADD 2 FOR E+
MOVEM T2,EXPWID ;SAVE FOR LATER
SUBI P1,(T2) ;REDUCE WIDTH WHERE EXPONENT WOULD GO
PUSHJ P,TRYFIT ;CHECK FOR FIT, SKIP RETURN IF IT DOESN'T
JRST %FTSUC ;DOESN'T. GO PRINT ASTERISKS
PUSHJ P,FFORM ;OUTPUT NUMBER IN F-FORMAT
MOVE T3,EXPWID ;OUTPUT BLANKS WHERE EXPONENT WOULD GO
PJRST %OMSPC
;F-FORMAT - PRINT THE NUMBER IN STANDARD FIXED-POINT NOTATION nnnn.nnnn
;WITHOUT EXPONENT. IF THERE IS A SCALE FACTOR, ACTUALLY CHANGE THE
;OUTPUT TO BE THAT FACTOR OF 10 LARGER OR SMALLER THAN THE DATA.
%FLOUT: PUSHJ P,%SAVE4 ;SAVE P1-P4
PUSHJ P,FLOCNV ;CONVERT TO FRACTION AND DECIMAL EXPONENT
PUSHJ P,FLOUT6 ;GET FIELD WIDTHS
MOVE P3,P2 ;GET # DECIMAL PLACES
ADD P3,%FLRDX ;ADD MAGNITUDE OF NUMBER
ADD P3,%SCLFC ;ADD SCLFCT TO # DIGITS DESIRED
PUSHJ P,DIGOK ;ENCODE DIGITS
JRST FNORND ;NO OVERFLOW ROUNDING OCCURRED
;OVERFLOW ROUNDING HAS OCCURRED. INCREMENT THE EXPONENT AND THE
;NUMBER OF DIGITS ENCODED.
AOS %FLRDX ;INCREMENT EXPONENT
ADDI P3,1 ;INCREMENT # DIGITS ENCODED
;WE ARE NOW READY TO OUTPUT THE NUMBER. CALCULATE THE NUMBER
;OF LEADING DIGITS IN P4.
FNORND: DMOVEM T0,%FLINT ;SAVE 2-WORD INTEGER
MOVE P4,%SCLFC ;GET SCALE FACTOR
JUMPG P3,POSDIG ;CLEAR SCALE FACTOR IF NO DIGITS ENCODED
SETZ P4, ;YES. SET SCALE FACTOR TO 0
POSDIG: ADD P4,%FLRDX ;COUNT THE LEADING DIGITS
JUMPLE P4,NEGSCL ;IGNORE NEG SCALING
SUBI P1,(P4) ;REDUCE WIDTH BY # LEADING DIGITS
NEGSCL: PUSHJ P,TRYFIT ;CHECK FIT, SKIP RETURN IF IT DOES
JRST %FTSUC ;OUTPUT ASTERISKS IF IT DOESN'T FIT
JRST FFORM ;OUTPUT NUMBER
;CONVERT THE BINARY FLOATING-POINT MANTISSA IN T0/T1 TO A NUMBER
;IN THE RANGE .1 .LE. X .LT. 1.0, WITH A NORMALIZED MANTISSA
;IN T0/T1 AND A DECIMAL EXPONENT IN XP.
FLOCNV: TXZ S3,LOCFLG ;CLEAR LOCAL FLAGS IN F
MOVE T1,IO.TYP ;GET VARIABLE TYPE
JRST FLOBT(T1) ;DO FLOATING OUTPUT BY TYPE
FLOBT: JRST FLOSPR ;(0) UNDEFINED (INTEGER)
JRST FLOSPR ;(1) LOGICAL
JRST FLOSPR ;(2) INTEGER
JRST FLOSPR ;(3)
JRST FLOSPR ;(4) SINGLE REAL
JRST FLOSPR ;(5)
JRST FLOSPR ;(6) SINGLE OCTAL (INTEGER)
JRST FLOSPR ;(7) LABEL
JRST FLODPR ;(10) DOUBLE REAL
JRST FLODPR ;(11) DOUBLE INTEGER
JRST FLODPR ;(12) DOUBLE OCTAL
JRST FLOGPR ;(13) EXTENDED DOUBLE REAL
JRST FLOSPR ;(14) COMPLEX
POPJ P, ;(15) COBOL BYTE STRING
POPJ P, ;(16)
POPJ P, ;(17) ASCIZ
FLOSPR: SETZ T1, ;CLEAR 2ND WORD
MOVE T0,@IO.ADR ;GET SINGLE WORD
JUMPG T0,.+2 ;IF POSITIVE, LEAVE ALONE
MOVN T0,T0 ;IF NEGATIVE, MAKE POSITIVE
LDB P1,[POINT 9,T0,8] ;GET EXPONENT
HRREI P1,-200(P1) ;EXPONENT IS EXCESS 200
TLZ T0,777000 ;CLEAR THE EXPONENT
JRST FLOCOM ;JOIN COMMON CODE
FLODPR: DMOVE T0,@IO.ADR ;GET D.P. DATA
TLZ T1,400000 ;CLEAR TRASH BIT IN 2ND WORD
JUMPG T0,.+2 ;IF POSITIVE, LEAVE ALONE
DMOVN T0,T0 ;IF NEGATIVE, MAKE POSITIVE
LDB P1,[POINT 9,T0,8] ;GET EXPONENT
HRREI P1,-200(P1) ;EXPONENT IS EXCESS 200
TLZ T0,777000 ;CLEAR THE EXPONENT
JRST FLOCOM ;JOIN COMMON CODE
FLOGPR: DMOVE T0,@IO.ADR ;GET D.P. DATA
TLZ T1,400000 ;CLEAR TRASH BIT IN 2ND WORD
JUMPG T0,.+2 ;IF POSITIVE, LEAVE ALONE
DMOVN T0,T0 ;IF NEGATIVE, MAKE POSITIVE
LDB P1,[POINT 12,T0,11] ;GET EXPONENT
HRREI P1,-2000(P1) ;EXPONENT IS EXCESS 2000
TLZ T0,777700 ;CLEAR THE EXPONENT
ASHC T0,3 ;MAKE MANTISSA LOOK LIKE REAL
;THE INTENTION IN THE CODE FOLLOWING IS TO LEFT-JUSTIFY THE MANTISSA
;AFTER EXTRACTING THE BINARY EXPONENT, AND THEN TO "SCALE" THE NUMBER
;BY ONE OR MORE POWERS OF TEN SO THAT IT ENDS UP WITH VALUE LESS
;THAN 1.0 BUT GREATER THAN OR EQUAL TO 0.1, KEEPING TRACK OF THE
;POWERS OF TEN USED IN THE SCALING PROCESS. THESE POWERS OF TEN
;ARE ACCUMULATED INTO A DECIMAL EXPONENT, KEPT IN XP.
;
;EXTENDED EXPONENT NUMBERS WHICH REQUIRE A HUGE POWER OF TEN TO SCALE
;THEM DOWN (OR UP) ARE FILTERED THROUGH A SPECIAL ROUTINE WHICH USES
;A SPARSE POWER OF TEN TABLE TO BRING THE NUMBER INTO THE "NORMAL"
;RANGE.
FLOCOM: SETZ XP, ;CLEAR EXPONENT
CAMG P1,%PMEXP ;WITHIN NORMAL RANGE?
CAMGE P1,%NMEXP
PUSHJ P,EEDEC ;NO. REDUCE EE NUMBER TO NORMAL RANGE
MOVE T3,T0 ;GET THE HI FRACTION
JFFO T3,FLOU2A ;GET HI BIT
EXCH T0,T1 ;NONE. SWAP LO AND HI
SUBI P1,^D35 ;AND DECR BINARY EXPONENT
MOVE T3,T0 ;GET NEW HI WORD
JFFO T3,FLOU2A ;GET HI BIT
SETZM %FLRDX ;NUMBER IS ZERO. CLEAR EXPONENT
DMOVEM T0,%FLRDF ;AND FRACTION
POPJ P,
FLOU2A: ASHC T0,-1(T4) ;NORMALIZE NUMBER
SUBI P1,-^D9(T4) ;AND MODIFY BINARY EXPONENT
;8 MORE ADDED TO EXPONENT BECAUSE
;IT WAS NORMALIZED ON BIT 9
FLOU2B: MOVE P2,P1 ;GET BINARY EXPONENT
IMULI P2,232 ;DEC EXP=LOG10(2)*BIN EXP=.232(OCTAL)*BIN EXP
ADDI P2,400 ;ROUND TO NEAREST INTEGER
ASH P2,-^D9 ;GET RID OF 3 OCTAL FRACTION DIGITS
;THE ABOVE WORKS FOR NEGATIVE EXPONENTS BECAUSE
;THE ASH TRUNCATION EFFECTIVELY
;ROUNDS UP IN THE NEGATIVE DIRECTION
;FOR NEGATIVE VALUES
;P2 HOLDS A FIRST TRIAL DECIMAL EXPONENT. IT MAY BE
;ONE (BUT NO MORE) TOO SMALL TO DIVIDE THE BINARY NUM
;BY TO GET THE RANGE 1.0 .GT. NUM .GE. 0.1
FLOUT3: CAMGE P1,%EXP10(P2) ;IS NUMBER'S EXP .GE. POWER OF TEN'S?
JRST FLOT4A ;NO. OK
CAME P1,%EXP10(P2) ;ARE THEY EQUAL?
AOJA P2,FLOT4A ;NUMBER'S IS GREATER. USE BIGGER POWER OF TEN
CAMGE T0,%HITEN(P2) ;YES. IS HIGH WORD .GE. POWER OF TEN'S?
JRST FLOT4A ;NO. OK
CAMN T0,%HITEN(P2) ;YES. ARE THEY EQUAL?
CAML T1,%LOTEN(P2) ;YES. IS LOW WORD .LT. POWER OF TEN'S?
ADDI P2,1 ;NO. USE BIGGER POWER OF TEN
FLOT4A: PUSHJ P,DPMUL ;SCALE BY POWER OF 10
DMOVEM T0,%FLRDF ;SAVE 2-WORD DECIMAL FRACTION
MOVEM XP,%FLRDX ;AND DECIMAL EXPONENT
POPJ P,
FLOUT6: MOVE P1,%FWVAL ;GET FIELD WIDTH
MOVE P2,%DWVAL ;GET DECIMAL WIDTH
JUMPN P1,FLOU6E ;IF ZERO, DEFAULT BOTH
MOVE P2,IO.TYP ;GET DATA TYPE
MOVE P2,%SIZTB(P2) ;GET DATA SIZE
HLRZ P1,FLFWID(P2) ;GET DEFAULT FIELD WIDTH
HRRZ P2,FLFWID(P2) ;GET DEFAULT DECIMAL WIDTH
FLOU6E: SUBI P1,2(P2) ;REDUCE WIDTH FOR SIGN, POINT, AND DEC
POPJ P,
;HERE THE NUMBER IS "ENCODED", I.E., TURNED INTO A 2-WORD INTEGER
;ACCORDING TO THE NUMBER OF DIGITS TO "ENCODE" IN P3. THE DECIMAL
;FRACTION IS MULTIPLIED BY THE APPROPRIATE POWER OF TEN. THE 3RD
;WORD THEN CONTAINS THE ROUNDING BIT. IF IT IS ON, 1 IS ADDED TO THE
;2-WORD PRODUCT, AND IT IS COMPARED WITH THE FACTOR OF 10 USED FOR
;THE ORIGINAL MULTIPLIER. IF THEY ARE EQUAL, OVERFLOW ROUNDING HAS
;OCCURRED (E.G. THE FRACTION .99995, WHEN MULTIPLIED BY 10**4 AND
;ROUNDED WOULD YIELD 10**4), AND A SKIP RETURN IS TAKEN.
DIGOK: JUMPE T0,NODIG ;IF NUMBER IS ZERO, ENCODE NO DIGITS
JUMPL P3,DIGZER ;IF # DIGITS TO ENCODE .LT. 0, LEAVE
CAILE P3,DPMAX ;TOO MANY DECIMAL PLACES
MOVEI P3,DPMAX ;YES, REDUCE TO MAX POSSIBLE
MOVE T2,%HIINT(P3) ;GET HIGH FACTOR OF 10
MOVE T3,%LOINT(P3) ;GET LOW FACTOR OF 10
DMUL T0,T2 ;GET PRODUCT
TLNN T2,(1B1) ;ROUNDING BIT ON?
POPJ P, ;NO.
DADD T0,[EXP 0,1] ;YES. ADD 1 TO 2-WORD RESULT
CAMN T0,%HIINT(P3) ;DID WE OVERFLOW ROUND
CAME T1,%LOINT(P3)
POPJ P, ;NO
AOS (P) ;YES. SKIP RETURN
NODIG: POPJ P,
DIGZER: DMOVE T0,[EXP 0,0] ;GET 2 ZEROES
POPJ P, ;NO OVERFLOW ROUNDING
;CHECK TO SEE IF THE EXPONENT WILL FIT, THEN JOIN
;THE CODE WHICH CHECKS TO SEE WHETHER THE NUMBER WILL FIT
CHEKDE: MOVE T2,%XPVAL ;GET EXPONENT WIDTH
JUMPN T2,GOTEXW ;MIGHT BE DEFAULT
MOVEI T2,2 ;WHICH IS 2
GOTEXW: MOVEM T2,EXPWID ;SAVE FOR PRINTING OF EXPONENT
MOVE T1,%FLRDX ;GET EXPONENT
SUB T1,P4 ;REDUCE BY SCALE FACTOR
MOVM T1,T1 ;GET MAGNITUDE
CAMGE T1,EXPTAB(T2) ;[3273] WILL EXPONENT FIT?
JRST EXPOK ;[3273] YES
MOVE T3,%XPVAL ;[3273] NO. IF EXPONENT WIDTH GIVEN, DIE
JUMPN T3,NOFIT ;[3273] TOO BAD. THE STANDARD REQUIRES STARS
TXO S3,NOEFLG ;MAYBE JUST BARELY WITH NO "D" OR "E"
CAML T1,EXPTAB+1(T2) ;WILL IT FIT AT ALL?
JRST NOFIT ;NO
EXPOK: SUBI P1,(T2) ;REDUCE SPACE FOR EXPONENT
SUBI P1,2 ;ALLOW FOR E+ OR + AND 1ST DIGIT OF EXP
TRYFIT: JUMPG P1,FIT ;WILL IT FIT?
JUMPL P1,TRYF0 ;NO. SERIOUS IF .LT. 0
JUMPG P4,FIT ;C=0, OK IF DIGITS BEFORE POINT
IFN LZALWAYS,<
SKIPL @IO.ADR ;IS SIGN POSITIVE?
SKIPE %SPFLG ;YES. CAN WE SHED PLUS SIGN?
JRST CHKDEC ;NO. CHECK IF DIGITS AFTER POINT
AOJA P1,POSIGN ;YES. ELIMINATE IT FOR LEADING ZERO>
CHKDEC: JUMPG P2,FIT ;NO. BUT WE'RE OK IF DIGITS AFTER POINT
TRYF0: SKIPL @IO.ADR ;IS SIGN POSITIVE?
SKIPE %SPFLG ;YES. CAN WE SHED PLUS SIGN?
JRST NOFIT ;NO. NO GOOD
JUMPG P2,TRYF1 ;YES. ANY DIGITS AFTER POINT?
JUMPG P4,TRYF1 ;NO. ANY DIGITS BEFORE POINT?
JUMPL P1,NOFIT ;NO. MUST BE ROOM FOR LEADING 0
TRYF1: CAML P1,[-1] ;YES. WOULD THERE BE ROOM WITHOUT SIGN?
AOJA P1,POSIGN ;YES. PRINT WITHOUT SIGN
NOFIT: SKIPE %FWVAL ;IF FREE FORMAT
JRST FIT ;IT ALWAYS FITS
SKIPE %FTAST ;ASTERISKS FOR OVERFLOW?
POPJ P, ;YES. NON-SKIP RETURN
SKIPGE @IO.ADR ;NEGATIVE?
JRST NOFIT1 ;YES. CAN'T REMOVE SIGN
ADDI P1,1 ;NO. REMOVE SIGN
TXO S3,NOSIGN ;AND PRINT NO SIGN LOC
NOFIT1: ADD P2,P1 ;REDUCE # DIGITS AFTER DEC POINT
JUMPGE P2,FITDIV ;IF WE HAVE NEGATIVE
TXO S3,NOPNT ;OUTPUT NO DECIMAL POINT
AOJGE P2,FITDIV ;IF WE STILL HAVE NEGATIVE
ADD P4,P2 ;REDUCE THE DIGITS BEFORE DEC PNT
ADD P1,P2 ;ACCUMULATE NEG # DIGITS TRUNCATED
FITDIV: MOVM P1,P1 ;GET POSITIVE
SETZB T0,T1 ;CLEAR HIGH ORDER WORDS
DMOVE T2,%FLINT ;GET 2-WORD INTEGER
MOVE T4,%HIINT(P1) ;DIVIDE BY 10**P1
MOVE T5,%LOINT(P1)
DDIV T0,T4
DMOVEM T0,%FLINT ;SAVE AGAIN FOR OUTPUT
SETZ P1, ;CLEAR ROOM LEFT
AOS (P) ;SKIP RETURN
POPJ P,
FIT: JUMPLE P1,NOSPC ;NO EXTRA SPACE
MOVEI T3,(P1) ;GET # SPACES LEFT
CAIG P4,0 ;IF INTEGER PART, DON'T NEED LEADING 0
SOJA T3,GOSPC ;NO INTEGER PART, LEAVE ROOM FOR 0
SUBI P1,(T3) ;UPDATE ROOM LEFT
GOSPC: PUSHJ P,%OMSPC ;OUTPUT SPACES
NOSPC: AOS (P) ;SKIP RETURN
POPJ P,
POSIGN: TXO S3,NOSIGN ;SIGNAL NO ROOM FOR SIGN
AOS (P) ;SKIP RETURN
POPJ P, ;DONE WITH FIT
;E FORMAT
EFORM: JUMPLE P4,EFORM1 ;JUMP IF NO LEADING DIGITS
PUSHJ P,SIGN ;OUTPUT SIGN
CAIG P3,(P4) ;ANY TRAILING DIGITS ENCODED?
JRST ENODIV ;IF NO ENCODED TRAILING DIGITS, NO DIV
SUBI P3,(P4) ;GET # TRAILING DIGITS ENCODED
DMOVE T2,%FLINT ;GET THE 2-WORD INTEGER
SETZB T0,T1 ;CLEAR THE HIGH WORDS
MOVE T4,%HIINT(P3) ;DIVIDE BY 10**P2
MOVE T5,%LOINT(P3)
DDIV T0,T4
MOVEM T2,%FLINT ;SAVE REMAINDER FOR AFTER POINT
JRST EFDO ;GO OUTPUT LEADING DIGITS
ENODIV: DMOVE T0,%FLINT ;GET THE NUMBER
MOVEI T3,(P3) ;OUTPUT ENCODED DIGITS
PUSHJ P,%CBDO
SUBI P4,(P3) ;GET # ZEROES TO FOLLOW DIGITS
SETZ P3, ;CLEAR ENCODED DIGITS LEFT
JUMPE P4,EFPNT ;IF NONE, GO OUTPUT DEC PNT
MOVEI T3,(P4) ;OUTPUT ZEROES FOR REST OF LEADING DIGITS
MOVEI T1,"0"
PUSHJ P,%OMPAD
JRST EFPNT
EFDO: MOVEI T3,(P4) ;OUTPUT P4 LEADING DIGITS
PUSHJ P,%CBDO
EFPNT: PUSHJ P,PERIOD ;OUTPUT DOT
JUMPLE P3,EFCTZ ;NO MORE IF NO DECODED DIGITS
DMOVE T0,%FLINT ;GET REMAINDER OF NUMBER
MOVEI T3,(P2) ;GET # DIGITS TO PRINT
PUSHJ P,%CBDO ;OUTPUT P2 TRAILING DIGITS
EFCTZ: SUBI P2,(P3) ;GET # TRAILING ZEROS TO PAD
JUMPLE P2,EFORM4 ;OUTPUT EXPONENT IF NONE
MOVEI T1,"0" ;OUTPUT TRAILING ZEROES
MOVEI T3,(P2)
PUSHJ P,%OMPAD
JRST EFORM4 ;GO OUTPUT EXPONENT
;FOR NEGATIVE SCALE FACTORS, THERE ARE NO LEADING SIGNIFICANT
;DIGITS. ABS(%SCLFC) ZEROES ARE OUTPUT, FOLLOWED BY D-ABS(%SCLFC)
;SIGNIFICANT DIGITS. IF D=ABS(%SCLFC), SO THAT THERE WOULD BE NO
;SIGNIFICANT DIGITS OUTPUT AND THE LAST ZERO WOULD JUST PRECEDE
;WHERE THE 1ST SIGNIFICANT DIGIT WOULD HAVE BEEN, WE MODIFY
;THE ALGORITHM TO OUTPUT ABS(%SCLFC)-1 ZEROES AND 1 SIGNIFICANT
;DIGIT. IN THIS CASE, THE NUMBER OF DIGITS ENCODED IS 0, BUT
;THERE MIGHT HAVE BEEN ROUNDING (I.E., THE NUMBER IS .GE. 0.5),
;SO WE REALLY WANT TO PRINT A NUMBER FROM %FLINT+1 1 AS THE LAST
;DIGIT. DIGOK HAS BEEN CODED TO CHECK FOR ROUNDING EVEN IF P3=0, AND TO
;LEAVE THE ROUNDED RESULT IN T1, STORED IN %FLINT+1 (FOR P3 .LE. 0
;THE E-FORMAT CODE DOES NOT GET A REDUCED TABLE ENTRY).
EFORM1: PUSHJ P,SIGN ;OUTPUT SIGN
PUSHJ P,ZERO ;OUTPUT ZERO IF NECESSARY
EFORM2: PUSHJ P,PERIOD ;AND DECIMAL POINT
JUMPLE P2,EFORM4 ;GO TO EXPONENT IF NO DIGITS
JUMPE P4,EFORM3 ;ACCOUNT FOR ZERO SCALING
MOVM P4,P4 ;GET MAGNITUDE
CAIGE P4,(P2) ;SCLFCT .GE. # DECS?
JRST EFRM2A ;NO. THINGS ARE OK
CAIE P4,(P2) ;EQUAL?
MOVEI P4,1(P2) ;GREATER. SET P4=D
SUBI P4,1 ;EQUAL. SET P4=D-1
EFRM2A: JUMPE P4,EFORM3 ;IF SCLFCT (P4) NOW ZERO, NO LEADING ZEROES
SUBI P2,(P4) ;REDUCE # TRAILING DIGITS
MOVEI T1,"0" ;OUTPUT P4 LEADING ZEROES
MOVEI T3,(P4)
PUSHJ P,%OMPAD
EFORM3: JUMPLE P3,EFRM3A ;LEAVE IF NO ENCODED DIGITS AFTER POINT
DMOVE T0,%FLINT ;GET NUMBER AGAIN
MOVEI T3,(P3) ;GET # DIGITS TO OUTPUT
PUSHJ P,%CBDO ;OUTPUT THE NUMBER
EFRM3A: SUBI P2,(P3) ;CALCULATE # OF TRAILING ZEROES
JUMPLE P2,EFORM4 ;IF NONE, GO OUTPUT EXPONENT
MOVEI T1,"0" ;OUTPUT P2 TRAILING ZEROES
MOVEI T3,(P2)
PUSHJ P,%OMPAD
EFORM4: MOVE T1,EXPCHR ;GET THE EXPONENT CHAR
TXNN S3,NOEFLG ;DON'T PRINT IF NO ROOM
PUSHJ P,%OBYTE ;OUTPUT "E" OR "D"
EFORM5: MOVN T1,%SCLFC ;SUBTRACT SCALE FACTOR FROM EXPONENT
ADDM T1,%FLRDX
SKIPN %FLINT ;SEE IF NUMBER IS ZERO
SKIPE %FLINT+1
JRST ENONZ ;NUMBER IS NOT ZERO
SETZM %FLRDX ;NUMBER IS ZERO. SET EXPONENT TO 0
ENONZ: PUSHJ P,ESIGN ;PRINT SIGN
MOVE T3,EXPWID ;AND SET DIGIT COUNT
TXNE S3,NOEFLG ;DID WE PRINT "D" OR "E"?
ADDI T3,1 ;NO. MORE ROOM FOR EXPONENT
SETZ T0, ;HIGH ORDER WORD IS ZERO
MOVM T1,%FLRDX ;GET DECIMAL EXPONENT MAGNITUDE
PJRST %CBDO ;OUTPUT EXPONENT
;F FORMAT
FFORM: JUMPLE P4,FFORM3 ;NO LEADING DIGITS
PUSHJ P,SIGN ;OUTPUT SIGN
CAIG P3,(P4) ;ENCODED DIGITS .GT. LEADING DIGITS?
JRST FNODIV ;NO. NO TRAILING DIGITS, NO DIV
SUBI P3,(P4) ;GET # TRAILING ENCODED DIGITS
DMOVE T2,%FLINT ;GET NUMBER IN LOW WORDS
SETZB T0,T1 ;CLEAR HIGH WORDS
MOVE T4,%HIINT(P3) ;DIVIDE BY 10**P3
MOVE T5,%LOINT(P3)
DDIV T0,T4
DMOVEM T2,%FLINT ;SAVE REMAINDER FOR AFTER POINT
JRST FFDO ;GO OUTPUT LEADING DIGITS
FNODIV: DMOVE T0,%FLINT ;GET THE NUMBER
MOVEI T3,(P3) ;OUTPUT ENCODED DIGITS
PUSHJ P,%CBDO
SUBI P4,(P3) ;GET # ZEROES
SETZ P3, ;AND CLEAR ENCODED DIGITS LEFT
JUMPE P4,FFPNT ;IF NO ZEROES, GO OUTPUT DEC PNT
MOVEI T3,(P4) ;OUTPUT ZEROES
MOVEI T1,"0"
PUSHJ P,%OMPAD
JRST FFPNT
FFDO: MOVEI T3,(P4) ;OUTPUT P4 LEADING DIGITS
PUSHJ P,%CBDO
FFPNT: PUSHJ P,PERIOD ;PRINT DECIMAL POINT
FFORM1: JUMPLE P3,FFRM1A ;IF NO ENCODED DIGITS, GO CHECK OTHERS
MOVEI T3,(P3) ;GET # ENCODED DIGITS TO OUTPUT
DMOVE T0,%FLINT ;GET TRAILING NUMBER
PUSHJ P,%CBDO ;OUTPUT THEM
FFRM1A: SUBI P2,(P3) ;GET # TRAILING ZEROES
SKIPG T3,P2 ;ANY?
POPJ P, ;NO. DONE
MOVEI T1,"0" ;OUTPUT P2 TRAILING ZEROES
PJRST %OMPAD
FFORM3: PUSHJ P,SIGN ;OUTPUT SIGN
PUSHJ P,ZERO ;OUTPUT LEADING "0" IF NECESSARY
PUSHJ P,PERIOD ;OUTPUT DEC. POINT
ADD P2,P4 ;REDUCE DEC BY # ZEROES TO PRINT
JUMPGE P2,FFRM3C ;FINISH IF OK
SUB P2,P4 ;RESTORE ORIGINAL # DEC PLACES
SKIPG T3,P2 ;ANY TRAILING DIGITS AT ALL?
POPJ P, ;NO. DONE
MOVEI T1,"0" ;YES. OUTPUT THEM
PJRST %OMPAD ;AND LEAVE
FFRM3C: MOVM T3,P4 ;OUTPUT ABS(P4) ZEROES
MOVEI T1,"0"
PUSHJ P,%OMPAD
JRST FFORM1
;WE USE A SPARSE POWER OF TEN TABLE TO SCALE THE MANTISSA
;AND LOWER THE MAGNITUDE OF THE BINARY EXPONENT. THE TABLE IS ARRANGED
;SO THAT EACH POWER OF TEN WILL SCALE 2**35 MORE THAN THE NEXT,
;SO WE JUST DIVIDE THE BINARY EXPONENT BY 35 TO GET THE TABLE ENTRY
;TO USE.
;WE LEAVE THE MANTISSA ALIGNED WITH BIT 9 TO AVOID DIVIDE CHECKS. WE
;DON'T LOSE ANY PRECISION THEREBY BECAUSE FOR BOTH MULTIPLICATION
;AND DIVISION WE GET A 4-WORD RESULT. AFTER THE SCALING OPERATION,
;WE HAVE TO ALIGN THE MANTISSA ON BIT 1. THIS TIME,
;HOWEVER, IT MIGHT START ANYWHERE, SO WE CALL %EENRM.
EEDEC: MOVM P2,P1 ;GET MAGNITUDE OF EXP
SUBI P2,^D70 ;MODIFY FOR SPARSE 10'S TABLE
IDIVI P2,^D35 ;DERIVE INDEX FOR EXPONENT
IMULI P2,3 ;GET PROPER INDEX
JUMPL P1,EENEG ;GO DO MUL IF NEGATIVE
PUSHJ P,%EEDIV ;AND DIVIDE IF POSITIVE
SUBI P1,(P3) ;REDUCE THE BINARY EXPONENT
POPJ P,
EENEG: PUSHJ P,%EEMUL ;DO D.P. MULT
MOVNI XP,(XP) ;RECORD NEGATIVE DECIMAL EXPONENT
ADDI P1,(P3) ;REDUCE MAGNITUDE OF BINARY EXP
POPJ P,
;SCALE THE BINARY FRACTION BY A POWER OF TEN. SINCE THE OBJECT OF
;THIS EXERCISE IS TO PRODUCE A NUMBER [0.1 .LT. NUMBER .LT. 1.0],
;P2 WILL HAVE BEEN CHOSEN SUCH THAT THE BINARY EXPONENT
;CORRESPONDING TO THE POWER OF TEN, %EXP10(P2), IS GREATER THAN
;OR EQUAL TO THE BINARY EXPONENT OF THE ORIGINAL NUMBER, P1. THEREFORE
;WHEN %EXP10(-P2) IS ADDED TO P1, THE "LEFTOVER" BINARY EXPONENT
;SHOULD BE ZERO OR LESS. HOWEVER, BECAUSE OF THE ASSYMETRY OF
;THE POWER OF TEN TABLE (THE BINARY EXPONENT ASSOCIATED WITH 0.1
;IS -3, WHEREAS THE BINARY EXPONENT ASSOCIATED WITH 10 IS 4),
;THE "LEFTOVER" CAN BE 1. AT THE END OF THE SCALING, WE SHIFT THE RESULT
;USING THIS "LEFTOVER" EXPONENT, SO THAT IT HAS AN EFFECTIVE BINARY
;EXPONENT OF ZERO, AN ABSOLUTE FRACTION, WHICH CAN THEN BE USED
;DIRECTLY TO ENCODE DIGITS.
DPMUL: JUMPN P2,EXPNZ ;IF DEC EXP IS NONZERO, CONTINUE
SETZ T2, ;CLEAR THE 3RD AND 4TH WORDS
SETZ T3,
JUMPN P1,DPSCAL ;IF LEFTOVER, GO SCALE FRACTION
POPJ P, ;NONE LEFT
EXPNZ: ADD XP,P2 ;PUT DEC SCALE FACTOR INTO XP
MOVN P2,P2 ;TAKE RECIPROCAL OF POWER OF TEN
ADD P1,%EXP10(P2) ;ADD CORRESPONDING BIN EXP
MOVE T2,%HITEN(P2) ;GET DOUBLE SCALING FACTOR
MOVE T3,%LOTEN(P2)
ADDI T3,1 ;BIAS IT - IT IS TRUNCATED
DMUL T0,T2 ;GET DP PRODUCT
JUMPE P1,NOSCAL ;NO MORE SCALING IF NO LEFTOVER
DPSCAL: MOVN T4,P1 ;GET THE NEGATIVE OF SHIFT
JUMPL P1,RSHIFT ;NEGATIVE IS THE USUAL CASE
ASHC T0,(P1) ;SCALE 1ST AND 2ND WORDS
ASH T1,(T4) ;GET 2ND WORD BACK AGAIN
ASHC T1,(P1) ;SCALE 2ND AND 3RD WORDS
ASH T2,(T4) ;GET 3RD WORD BACK AGAIN
ASHC T2,(P1) ;SCALE 3RD AND 4TH WORDS
JRST NOSCAL ;GO CHECK 3RD AND 4TH WORDS
RSHIFT: ASHC T2,(P1) ;SCALE 3RD AND 4TH WORDS
ASH T2,(T4) ;GET 3RD WORD BACK AGAIN
ASHC T1,(P1) ;SCALE 2ND AND 3RD WORD
ASH T1,(T4) ;GET 2ND WORD BACK AGAIN
ASHC T0,(P1) ;SCALE 1ST AND 2ND WORD
NOSCAL: CAIN T2,0 ;IF ANY DATA IN 3RD OR 4TH WORD
CAIE T3,0
DADD T0,[EXP 0,1] ;ADD 1 TO 2-WORD PRODUCT
POPJ P, ;RETURN
; OUTPUT ROUTINES
PERIOD: TXNE S3,NOPNT ;SUPPRESS DEC PNT?
POPJ P, ;YES. JUST LEAVE
MOVEI T1,"." ;DECIMAL POINT
PJRST %OBYTE ;PRINT AND RETURN
SPACE: SKIPE %FTSLB ;SUPPRESS LEADING BLANKS?
POPJ P, ;YES. LEAVE
MOVEI T1," " ;SPACE
PJRST %OBYTE
ZERO:
IFN LZALWAYS!LZSOME,<
JUMPLE P1,NOLZ ;AND IF WE CAN,>
IFE LZALWAYS!LZSOME,<
JUMPG P2,NOLZ ;OR IF NO TRAILING DIGITS>
MOVEI T1,"0"
JRST %OBYTE
NOLZ: POPJ P,
SIGN: TXZE S3,NOSIGN ;NO ROOM FOR SIGN?
POPJ P, ;JUST RETURN
MOVEI T1," "
SKIPE %SPFLG ;FORCE PLUS SIGN?
MOVEI T1,"+" ;YES
SKIPGE @IO.ADR ;IF NUMBER NEGATIVE
MOVEI T1,"-" ;USE MINUS
CAIN T1," " ;IS IT A SPACE?
SKIPN %FTSLB ;YES. SUPPRESS LEADING BLANK?
PJRST %OBYTE ;NO. PRINT
POPJ P,
ESIGN: MOVEI T1,"+"
SKIPGE %FLRDX ;IF EXPONENT NEGATIVE
MOVEI T1,"-" ;OUTPUT MINUS SIGN
PJRST %OBYTE ;OUTPUT THE SIGN
FLFWID: 0
^D15,,7 ;15.7 DEFAULT
^D25,,^D17 ;25.17 DEFAULT
EXPTAB: 1 ;10**0
^D10 ;10**1
^D100 ;10**2
^D1000 ;10**3
SEGMENT DATA
%FLRDX: BLOCK 1 ;RAW DECIMAL EXPONENT
%FLRDF: BLOCK 2 ;RAW DECIMAL FRACTION
%FLINT: BLOCK 2 ;FRACTION EXPRESSED AS AN INTEGER
EXPCHR: BLOCK 1 ;EXPONENT CHARACTER
EXPWID: BLOCK 1 ;EXPONENT WIDTH
SEGMENT CODE
PRGEND
TITLE GSCALE GFLOATING SCALING ROUTINES
SEARCH MTHPRM
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1983, 1985
;ALL RIGHTS RESERVED.
ENTRY %EEDIV,%EEMUL,%EENRM
EXTERN %BEXP,%DEXP
SEGMENT CODE
%EEDIV: SETZB T2,T3 ;CLEAR LOWER AC'S
SETZB T4,T5 ;AND EVEN LOWER AC'S
DDIV T0,%BEXP(P2) ;GET 2-WORD RESULT
DDIV T2,%BEXP(P2) ;GET 4-WORD RESULT
JRST EECOM ;JOIN COMMON CODE
%EEMUL: DMOVE T2,%BEXP(P2) ;GET POWER OF TEN
ADDI T3,1 ;BIAS IT - IT IS TRUNCATED
DMUL T0,T2 ;GET 4-WORD RESULT
EECOM: PUSHJ P,%EENRM ;NORMALIZE IT
TLO T0,(1B0) ;PREPARE FOR OVERFLOW
TLNE T2,(1B1) ;ROUNDING BIT ON?
DADD T0,[EXP 0,1] ;YES. ROUND UP
TLZ T1,(1B0) ;TURN OFF LOW SIGN
TLZE T0,(1B0) ;DID WE OVERFLOW?
JRST EEOK ;NO
TLO T0,(1B1) ;YES. TURN JUST HIGH BIT ON
ADDI P1,1 ;AND INCR THE BINARY EXP
EEOK: HLRZ P3,%DEXP(P2) ;GET THE BINARY EXPONENT
HRRZ T5,%DEXP(P2) ;GET DECIMAL EXPONENT
POPJ P,
%EENRM: MOVE T4,T0 ;GET THE HIGH WORD
JFFO T4,EENZ ;LOOK FOR 1ST 1
DMOVE T0,T1 ;SHOVE THE NUMBER OVER
SUBI P1,^D35 ;AND MODIFY THE EXPONENT
MOVE T4,T0 ;TRY NEXT WORD
JFFO T4,EENZ
JRST EENEND ;STILL NONE
EENZ: SOJE T5,EENEND ;LEAVE STARTING AT BIT 1, DONE IF NO SHIFT
SUB P1,T5 ;MODIFY THE BINARY EXPONENT
MOVN T4,T5 ;AND GET NEG SHIFT ALSO
JUMPL T5,RGTSFT ;DIFFERENT FOR RIGHT SHIFT
ASHC T0,(T5) ;MOVE 1ST AND 2ND WORDS
ASH T1,(T4) ;MOVE BACK 2ND WORD
ASHC T1,(T5) ;MOVE 2ND AND 3RD WORD
EENEND: POPJ P,
RGTSFT: ASHC T1,(T5) ;MOVE 2ND AND 3RD
ASH T1,(T4) ;MOVE 2ND BACK
ASHC T0,(T5) ;MOVE 1ST AND 2ND
POPJ P,
PRGEND
TITLE INTEG DECIMAL INTEGER INPUT/OUTPUT
SUBTTL D. TODD/DRT/HPW/MD 28-Oct-81
SEARCH MTHPRM
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
;ALL RIGHTS RESERVED.
;FROM LIB40 %4(367)
SEGMENT CODE
ENTRY %INTI,%INTO,%GINTI,%GINTO
EXTERN %IBYTE,%OBYTE,%FWVAL,%DWVAL
EXTERN IO.ADR,IO.TYP,%SAVE1,%FTAST,%FTSLB
EXTERN %SKIP,%SPFLG
EXTERN %BZFLG
EXTERN %FTSUC,%ERTYP,IO.TYP,%FIXED
EXTERN %OMSPC,%CBDO,%LOINT,%HIINT,%SIZTB
DGSEEN==400000,,0 ;MUST BE 400000, CHECKED WITH JUMPL
SGNFLG==200000,,0 ;MINUS SIGN SEEN
OVRFLG==100000,,0 ;INTEGER OVERFLOW
%GINTI:
%INTI: PUSHJ P,%SAVE1 ;SAVE P1
MOVE P1,IO.ADR ;GET ADDR OF VARIABLE
MOVE T3,%FWVAL ;GET THE FIELD WIDTH
SETZB T5,T2 ;CLEAR STORAGE
SETZ T4,
JUMPG T3,INTI1 ;FIELD WIDTH SPECIFIED
SETO T3, ;SET VARIABLE FIELD FLAG
PUSHJ P,%SKIP ;SKIP SPACES
JRST INTI6 ;COMMA OR EOL (NULL FIELD)
JRST INTI1B ;PROCESS FIELD
INTI1: JUMPE T3,INTI6 ;FIELD EXHAUSTED
PUSHJ P,%IBYTE ;NO, GET NEXT INPUT CHARACTER
INTI1B: CAIG T1,"9" ;CHECK FOR A
CAIGE T1,"0" ;DECIMAL DIGIT (0-9)
JRST INTI3 ;NOT A DECIMAL DIGIT
TXO T2,DGSEEN ;SET DIGIT SEEN FLAG
INTI1A: ANDI T1,17 ;MAKE A BINARY NUMBER
MOVE T4,T5 ;PREPARE FOR 2-WORD MUL
MULI T4,12 ;MULT NUMBER BY A POWER OF 10
TLO T5,400000 ;TURN ON SIGN BIT TO STOP OVERFLOW
ADD T5,T1 ;ACCUMULATE THE SUM
TLZE T5,400000 ;DID WE OVERFLOW?
JUMPE T4,INTI2 ;NO. ANYTHING IN HIGH WORD?
TXO T2,OVRFLG ;YES. WE OVERFLOWED!
ADDI T4,1 ;YES. ADD ONE TO OVERFLOW
INTI2: SOJA T3,INTI1 ;GET NEXT DIGIT
;NULLS ARE LEGAL
INTI3: JUMPN T1,INOTNL ;IF NOT NULL, CONTINUE
JUMPL T3,INTFRE ;IF FREE FORMAT, GO CHECK IF ANYTHING ELSE SEEN
SOJA T3,INTI1 ;OTHERWISE, TREAT AS BLANK WITH BLANK='NULL'
INOTNL: CAIN T1,11 ;<TAB>
MOVEI T1," " ;CLEAR THE <TAB> CHARACTER
CAIE T1," " ;CHECK FOR A BLANK
JRST INTI3A ;NOT A BLANK OR <TAB>
JUMPL T3,INTFRE ;YES, CHECK BZ IF NOT FREE FORM
SKIPN %BZFLG ;BLANK=ZERO?
SOJA T3,INTI1 ;NO. SKIP THE CHAR
JRST INTI1A ;YES. TREAT AS A ZERO
INTFRE: JUMPGE T2,INTI1 ;NO DIGITS CONTINUE SCAN IF FREE FORM
JRST INTI4 ;DONE IF DIGITS SEEN
INTI3A: JUMPL T2,INTI4 ;DIGIT SEEN YET
CAIN T1,"-" ;NO, IS THIS A MINUS SIGN
TXOA T2,SGNFLG ;YES, SET THE FLAG
CAIN T1,"+" ;CHECK FOR A PLUS
TXOA T2,DGSEEN ;TREAT SIGNS LIKE DIGITS
JRST INTI4 ;NO. OTHER CHAR
SOJA T3,INTI1 ;GET NEXT DIGIT
INTI4: CAME T3,[-1] ;IF FIRST CHAR THEN ILLEGAL
JUMPL T3,INTI6 ;NO, CHECK FOR VARIABLE FIELD
$ACALL ILC ;"ILLEGAL CHARACTER IN DATA"
POPJ P, ;RETURN TO FOROTS
INTI6: TXNN T2,OVRFLG ;DID WE OVERFLOW?
JRST INTI6A ;NO
HRLOI T1,377777 ;YES. LOAD BIGGEST VALUE
MOVEM T1,%FIXED ;SAVE FOR POSSIBLE USER SUBSTITUTION
MOVE T1,IO.TYP ;GET DATA TYPE
MOVEM T1,%ERTYP ;SAVE FOR USER SUBR
$ECALL IOV
MOVE T5,%FIXED ;GET FIXED-UP RESULT
INTI6A: TXNE T2,SGNFLG ;CHECK FOR SIGN
MOVN T5,T5 ;NEGATE THE RESULT
MOVEM T5,(P1) ;PUT RESULT IN USER'S VARIABLE
POPJ P, ;RETURN TO FOROTS
%GINTO: MOVEI T1,1 ;AT LEAST ONE DIGIT FOR G-FORMAT
SKIPN %FWVAL ;IF FREE FORMAT
MOVEM T1,%DWVAL
%INTO: SKIPG T3,%FWVAL ;GET FIELD WIDTH
MOVEI T3,17 ;FREE. TURN INTO FIXED!
MOVE T1,IO.TYP ;GET DATA TYPE
MOVE T1,%SIZTB(T1) ;GET DATA SIZE
JRST ICNV(T1) ;GO CONVERT IT
ICNV: JRST INTSNG ;DATA SIZE = 0
JRST INTSNG ;DATA SIZE = 1
JRST INTDBL ;DATA SIZE = 2
INTDBL: DMOVE T0,@IO.ADR ;GET DATA
TLZ T1,400000 ;NO SIGN BIT IN 2ND WORD!
JUMPE T0,INTPOS ;HIGH WORD ZERO. TREAT AS SINGLE
JUMPG T0,DIPOS ;NOTHING MUCH TO DO IF POSITIVE
CAMN T0,[400000,,0] ;POSSIBLY LARGEST POSSIBLE NEGATIVE NUMBER?
JUMPE T1,DIPOS ;IT IS IF LOW ORDER WORD IS ZERO
DMOVN T0,T0 ;GET MAGNITUDE
DIPOS: DMOVEM T0,INTNUM ;SAVE IT
EXCH T0,T1 ;SWAP FOR JFFO
JFFO T1,.+1 ;GET 1ST BIT
EXCH T0,T1 ;GET DATA BACK WHERE IT BELONGS
MOVE T2,ILOG10(T2) ;GET LARGEST NUMBER OF DIGITS TO REPRESENT IT
CAMGE T0,%HIINT-1(T2) ;IS NUMBER .GE. 10**(T2-1)?
JRST DIRE ;NO. REDUCE NUMBER OF DIGITS
CAME T0,%HIINT-1(T2) ;HIGH ORDER WORD EQUAL TO 10**(T2-1)?
JRST INTOCM ;NO. IT WAS GREATER. IT IS OK
CAMG T1,%LOINT-1(T2) ;YES. IS LOW WORD .GT. 10**(T2-1)?
DIRE: SUBI T2,1 ;NO. REDUCE NUMBER DIGITS NEEDED
JRST INTOCM ;JOIN COMMON CODE
INTSNG: SETZ T0, ;SINGLE INTEGER HAS NO HIGH-ORDER WORD
SKIPL T1,@IO.ADR ;GET THE NUMBER
JRST INTPOS ;POSITIVE. NOTHING MUCH TO DO
CAME T1,[400000,,0] ;LARGEST NEGATIVE NUMBER?
JRST NLNN ;NO
DMOVE T0,[EXP 1,0] ;YES. GET EQUIVALENT POSITIVE INTEGER
DMOVEM T0,INTNUM ;SAVE IT
MOVE T2,SLOG10 ;SIMULATE JFFO
JRST INTSGN ;SKIP COMPARISON - WE KNOW IT WILL FIT
NLNN: MOVM T1,T1 ;GET MAGNITUDE
INTPOS: DMOVEM T0,INTNUM ;SAVE IT
JFFO T1,INTNZ ;GET BIT # OF 1ST BIT
JRST INTZER ;NO BITS. NUMBER IS ZERO
INTNZ: MOVE T2,SLOG10(T2) ;GET # DIGITS MAXIMUM TO REPRESENT IT
CAMGE T1,%LOINT-1(T2) ;IS NUMBER .GE. 10**(T2-1)?
SUBI T2,1 ;NO. NEED 1 LESS DIGIT TO REPRESENT IT
INTOCM: SKIPG @IO.ADR ;IS NUMBER POSITIVE?
JRST INTSGN ;NO. IT MUST HAVE A SIGN
SKIPN %SPFLG ;IS PLUS SIGN DESIRED?
JRST NOISGN ;NO
INTSGN: CAIG T3,(T2) ;ROOM FOR NUMBER AND SIGN?
JRST INTFTS ;NO. FIELD WIDTH TOO SMALL
MOVE T4,%DWVAL ;GET MINIMUM # DIGITS
CAIL T4,(T3) ;ROOM FOR SIGN?
JRST INTFTS ;NO. FIELD WIDTH TOO SMALL
CAIGE T2,(T4) ;IS ROOM NEEDED .GE. MINIMUM # DIGITS?
MOVEI T2,(T4) ;NO. GET MINIMUM # DIGITS
MOVEM T2,INTDIG ;SAVE IT
SUBI T3,1(T2) ;GET # SPACES
JUMPE T3,SGNNS ;NO SPACE IF ZERO
SKIPN %FTSLB ;SUPPRESS LEADING BLANKS?
PUSHJ P,%OMSPC ;NO. OUTPUT THEM
SGNNS: MOVEI T1,"-" ;ASSUME MINUS
SKIPL @IO.ADR ;NEGATIVE NUMBER?
MOVEI T1,"+" ;NO. USE PLUS SIGN
PUSHJ P,%OBYTE ;OUTPUT THE SIGN
JRST INTOUT ;GO OUTPUT THE NUMBER
INTZER:
NOISGN: CAIGE T3,(T2) ;ROOM FOR NUMBER?
JRST INTFTS ;NO. FIELD WIDTH TOO SMALL
MOVE T4,%DWVAL ;GET MINIMUM # DIGITS
CAILE T4,(T3) ;ROOM FOR THEM?
JRST INTFTS ;NO. FIELD WIDTH TOO SMALL
CAIGE T2,(T4) ;IS ROOM NEEDED .GE. MINIMUM # DIGITS?
MOVEI T2,(T4) ;NO. GET MINIMUM # DIGITS
MOVEM T2,INTDIG ;SAVE IT
SUBI T3,(T2) ;GET # LEADING SPACES
JUMPE T3,INTOUT ;NO SPACES IF ZERO
SKIPN %FTSLB ;SUPPRESS LEADING BLANKS?
PUSHJ P,%OMSPC ;NO. OUTPUT THEM
INTOUT: DMOVE T0,INTNUM ;GET THE MAGNITUDE AGAIN
SKIPE T3,INTDIG ;AND THE WIDTH DESIRED
JRST %CBDO ;OUTPUT THE NUMBER
POPJ P,
INTFTS: JRST %FTSUC ;NO HANDLING OF NOAST YET!!!
ILOG10: ^D22
^D22
^D22
^D21
^D21
^D21
^D20
^D20
^D20
^D19
^D19
^D19
^D19
^D18
^D18
^D18
^D17
^D17
^D17
^D16
^D16
^D16
^D16
^D15
^D15
^D15
^D14
^D14
^D14
^D13
^D13
^D13
^D13
^D12
^D12
^D12
SLOG10: ^D11 ;2**36-1=68719476735
^D11 ;2**35-1=34359738367
^D11 ;2**34-1=17179869183
^D10 ;2**33-1= 8589934591
^D10 ;2**32-1= 4294967295
^D10 ;2**31-1= 2147483647
^D10 ;2**30-1= 1073741823
9 ;2**29-1= 536870911
9 ;2**28-1= 268435455
9 ;2**27-1= 134217727
8 ;2**26-1= 67108863
8 ;2**25-1= 33554431
8 ;2**24-1= 16777215
7 ;2**23-1= 8388607
7 ;2**22-1= 4194303
7 ;2**21-1= 2097151
7 ;2**20-1= 1048575
6 ;2**19-1= 524287
6 ;2**18-1= 262143
6 ;2**17-1= 131071
5 ;2**16-1= 65535
5 ;2**15-1= 32767
5 ;2**14-1= 16383
4 ;2**13-1= 8191
4 ;2**12-1= 4095
4 ;2**11-1= 2047
4 ;2**10-1= 1023
3 ;2** 9-1= 511
3 ;2** 8-1= 255
3 ;2** 7-1= 127
2 ;2** 6-1= 63
2 ;2** 5-1= 31
2 ;2** 4-1= 15
1 ;2** 3-1= 7
1 ;2** 2-1= 3
1 ;2** 1-1= 1
SEGMENT DATA
INTNUM: BLOCK 2 ;THE MAGNITUDE OF THE DATA
INTDIG: BLOCK 1 ;THE NUMBER OF DIGITS TO ENCODE
SEGMENT CODE
PRGEND
TITLE OCTAL OCTAL INPUT/OUTPUT
SUBTTL D. TODD/DRT/HPW/MD/SWG/DCE 28-OCT-81
SEARCH MTHPRM
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
;ALL RIGHTS RESERVED.
SEGMENT CODE
ENTRY %OCTI,%OCTO,%GOCTI,%GOCTO
EXTERN %IBYTE,%OBYTE,%FWVAL,%DWVAL,%SAVE2
EXTERN %SKIP,%SIZTB
EXTERN IO.ADR,IO.TYP,%FTAST,%FTSLB
EXTERN %BZFLG
EXTERN %FTSUC
DGSEEN==400000,,0 ;MUST BE 400000, TEST WITH JUMPL
SGNFLG==200000,,0 ;MINUS SIGN SEEN
%GOCTI:
%OCTI: PUSHJ P,%SAVE2 ;SAVE P1 & P2
PUSHJ P,OCTSET ;DO SETUP
SETZB T4,T5 ;CLEAR THE OUTPUT WORD
SETZM ODGCNT ;[3342] AND DIGIT-READ COUNT
JUMPG T3,OCTI1 ;FIELD SPECIFIED
SETO T3, ;NO, SET VARIABLE FLAG
PUSHJ P,%SKIP ;SKIP SPACES
JRST OCTI5 ;NULL FIELD DELIMITED BY COMMA OR EOL
JRST OCTI1B ;PROCESS FIELD
OCTI1: JUMPE T3,OCTI5 ;CHECK FOR END OF FIELD
PUSHJ P,%IBYTE ;GET AN INPUT CHARACTER
OCTI1B: CAIG T1,"7" ;CHECK FOR AN OCTAL
CAIGE T1,"0" ;DIGIT (0-7)
JRST OCTI2 ;NO, NOT AN OCTAL DIGIT
TXO T2,DGSEEN ;SET DIGIT SEEN FLAG
OCTI1A: ANDI T1,7 ;MAKE AN OCTAL DIGIT
LSHC T4,3 ;POSITION OUTPUT WORD
TRO T5,(T1) ;OR IN DIGIT
AOS ODGCNT ;[3342] COUNT THIS DIGIT
SOJA T3,OCTI1 ;RETURN FOR NEXT CHARACTER
;NULLS ARE LEGAL
OCTI2: JUMPN T1,ONOTNL ;IF NOT NULL, CONTINUE
JUMPL T3,OCTFRE ;IF FREE FORMAT, CHECK IF ANYTHING ELSE SEEN
SOJA T3,OCTI1 ;OTHERWISE TREAT AS BLANK WITH BLANK='NULL'
ONOTNL: CAIN T1,11 ;<TAB> CHARACTER
MOVEI T1," " ;CLEAR THE <TAB>
CAIE T1," " ;CHECK FOR A BLANK
JRST OCTI2A ;NOT A BLANK OR <TAB>
JUMPL T3,OCTFRE ;FREE FORMAT?
SKIPN %BZFLG ;BLANK=ZERO?
SOJA T3,OCTI1 ;NO. SKIP CHARACTER
JRST OCTI1A ;YES. TREAT AS A ZERO
OCTFRE: JUMPGE T2,OCTI1 ;DIGIT NOT SEEN IN FREE FORM
OCTI2A: JUMPL T2,OCTI3 ;HAS A DIGIT BEEN SEEN
CAIN T1,"-" ;CHECK FOR A MINUS SIGN
TXOA T2,SGNFLG ;SET MINUS FLAG
CAIN T1,"+" ;CHECK FOR A PLUS SIGH
TXOA T2,DGSEEN ;TREAT SIGNS LIKE DIGITS
JRST OCTI3 ;NOT A SIGN
SOJA T3,OCTI1 ;YES, COUNT AND GET NEXT CHAR
OCTI3: CAME T3,[-1] ;FIRST CHAR ILLEGAL
JUMPL T3,OCTI5 ;NO ERROR ON VARIABLE FIELD INPUT
$ACALL ILC ;"ILLEGAL CHARACTER IN DATA"
OCTI5: TXNN T2,SGNFLG ;[3342] CHECK THE SIGN OF THE OUTPUT
JRST OCTI6 ;POSITIVE
DMOVN T4,T4 ;NEGATIVE (NEGATE THE RESULT)
JUMPE T5,OCTI6 ;[3342] IF 2ND WORD ZERO, DON'T TURN ON BIT
TLO T5,400000 ;DMOVN ZEROES SIGN BIT OF RIGHT
;[3342] WORD - VAL IS NEG SO TURN IT ON
OCTI6: MOVE T1,ODGCNT ;[3342] GET DIGITS-READ COUNT
CAIN P2,2 ;[3342] DOUBLE WORD TARGET?
JRST OCTI6A ;[3342] YES.
CAILE T1,^D12 ;[3342] SINGLE. HAVE WE READ MORE THAN 1 WORD?
MOVE T5,T4 ;[3342] YES, RETURN HIGH-ORDER WORD
MOVEM T5,(P1) ;[3342] OR LOW-ORDER IF <12 DIGITS READ
POPJ P, ;[3342] RETURN SINGLE RESULT.
OCTI6A: CAIG T1,^D12 ;[3342] TARGET IS DOUBLE. LESS THAN 12 DIGITS?
EXCH T4,T5 ;[3342] YES. RETURN HI=RESULT, LOW=0
DMOVEM T4,(P1) ;[3342] OTHERWISE RETURN HI/HI, LOW/LOW
POPJ P, ;[3342] RETURN TO FOROTS
SEGMENT DATA ;[3342]
;[3342]
ODGCNT: BLOCK 1 ;[3342] COUNT OF DIGITS READ
;[3342]
SEGMENT CODE ;[3342]
;[3342]
%GOCTO:
%OCTO: PUSHJ P,%SAVE2 ;SAVE P1 & P2
PUSHJ P,OCTSET ;DO SETUP
MOVSI T5,(POINT 3,(P1)) ;GET AN OCTAL BYTE POINTER
JUMPN T3,OCTO1 ;CHECK FOR VARIABLE FIELD OUTPUT
MOVEI T3,^D15 ;YES SET FILED WIDTH TO O15
CAIN P2,2 ;IF DOUBLE REAL
MOVEI T3,^D25 ;THEN ITS O25
OCTO1: MOVE T4,%DWVAL ;GET MINIMUM # DIGITS
JUMPN T4,GOTMIN ;DONE IF NON-ZERO
MOVEI T4,(T3) ;USE WIDTH IF 0
GOTMIN: SUBI T3,(T2) ;FIND THE EXCESS FIELD WIDTH
JUMPLE T3,OCTO2 ;W<= MAX FIELD WIDTH
MOVEI T1," " ;SET UP A BLANK FILLER
SKIPE %FTSLB ;DON'T OUTPUT IF SUPPRESS SWITCH ON
JRST OCTNB
PUSHJ P,%OBYTE ;OUTPUT THE FILLER
SOJG T3,.-1 ;CONTINUE UNTIL W=0 (EXCESS)
OCTNB: SETZ T3, ;DONE WITH LEADING BLANKS
OCTO2: JUMPE T3,OCTO2B ;GO ON IF FITS
ADD T2,T3 ;MODIFY # CHARS FOR OUTPUT
OCTO2A: ILDB T1,T5 ;GET CHAR
SKIPE %FTAST ;ASTERISKS ON OVERFLOW?
JUMPN T1,%FTSUC ;YES. OVERFLOW IF DIGIT NON-ZERO
AOJL T3,OCTO2A
OCTO2B: ILDB T1,T5 ;GET A CHAR
JUMPN T1,OCTO3A ;GO PRINT ALL IF NON-ZERO
MOVEI T1,"0" ;MAYBE PRINT A ZERO
CAILE T2,(T4) ;PRINT A SPACE IF ALLOWED TO
MOVEI T1," " ;IF W.M WAS SPECIFIED
PUSHJ P,%OBYTE ;OUTPUT ZERO OR SPACE
SOJG T2,OCTO2B
POPJ P, ;LEAVE IF DIGITS EXHAUSTED
OCTO3: ILDB T1,T5 ;GET THE NEXT OCTAL DIGIT
OCTO3A: ADDI T1,"0" ;CONVERT TO ASCII
PUSHJ P,%OBYTE ;OUTPUT A DIGIT
SOJG T2,OCTO3 ;BACK FOR MORE
OCTORT: POPJ P, ;RETURN TO FOROTS
OCTSET: MOVE P1,IO.ADR ;GET ADDR OF VARIABLE
MOVEI T2,^D12 ;12 DIGITS ONLY
MOVE P2,IO.TYP ;GET VARIABLE TYPE
MOVE P2,%SIZTB(P2) ;GET ENTRY SIZE
IMULI T2,(P2) ;GET CORRESPONDING # DIGITS
MOVE T3,%FWVAL ;GET THE FIELD WIDTH
POPJ P,
PRGEND
TITLE HEXIO HEX INPUT/OUTPUT
SUBTTL CHRIS SMITH/CKS 28-Oct-81
SEARCH MTHPRM
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
;ALL RIGHTS RESERVED.
;FROM OCTAL I/O
SEGMENT CODE
ENTRY %HEXI,%HEXO
EXTERN %IBYTE,%OBYTE,%FWVAL,%DWVAL,%SAVE2
EXTERN %SKIP,%SIZTB
EXTERN IO.ADR,IO.TYP,%FTAST
EXTERN %BZFLG
EXTERN %FTSUC
DGSEEN==400000,,0 ;MUST BE 400000, TEST WITH JUMPL
SGNFLG==200000,,0 ;MINUS SIGN SEEN
%HEXI: PUSHJ P,%SAVE2 ;SAVE P1 & P2
PUSHJ P,HEXSET ;DO SETUP
SETZB T4,T5 ;CLEAR THE OUTPUT WORD
JUMPG T3,HEXI1 ;FIELD SPECIFIED
SETO T3, ;NO, SET VARIABLE FLAG
PUSHJ P,%SKIP ;SKIP SPACES
JRST HEXI5 ;NULL FIELD DELIMITED BY COMMA OR EOL
JRST HEXI1B ;PROCESS FIELD
HEXI1: JUMPE T3,HEXI5 ;CHECK FOR END OF FIELD
PUSHJ P,%IBYTE ;GET AN INPUT CHARACTER
HEXI1B: CAILE T1,140 ;LOWER CASE?
SUBI T1,40 ;YES, CONVERT TO UPPER
CAIG T1,"F" ;CHECK FOR HEX DIGIT
CAIGE T1,"A"
CAIG T1,"9"
CAIGE T1,"0"
JRST HEXI2 ;NON-DIGIT
TXO T2,DGSEEN ;DIGIT, SET DIGIT SEEN FLAG
SUBI T1,"0" ;MAKE INTO DIGIT
CAIL T1,"A"-"0"
SUBI T1,"A"-"0"-^D10
HEXI1A: LSHC T4,4 ;POSITION OUTPUT WORD
TRO T5,(T1) ;OR IN DIGIT
SOJA T3,HEXI1 ;RETURN FOR NEXT CHARACTER
;NULLS ARE LEGAL
HEXI2: JUMPN T1,HNOTNL ;IF NOT NULL, CONTINUE
JUMPL T3,HEXFRE ;IF FREE FORMAT, CHECK IS ANYTHING ELSE SEEN
SOJA T3,HEXI1 ;OTHERWISE, TREAT AS BLANK WITH BLANK='NULL'
HNOTNL: CAIN T1,11 ;<TAB> CHARACTER
MOVEI T1," " ;CLEAR THE <TAB>
CAIE T1," " ;CHECK FOR A BLANK
JRST HEXI2A ;NOT A BLANK OR <TAB>
JUMPL T3,HEXFRE ;FREE FORMAT?
SKIPN %BZFLG ;BLANK=ZERO?
SOJA T3,HEXI1 ;NO. SKIP CHARACTER
SETZ T1, ;YES. TREAT AS A ZERO
JRST HEXI1A ;GO INSERT IN OUTPUT NUMBER
HEXFRE: JUMPGE T2,HEXI1 ;DIGIT NOT SEEN IN FREE FORM
HEXI2A: JUMPL T2,HEXI3 ;HAS A DIGIT BEEN SEEN
CAIN T1,"-" ;CHECK FOR A MINUS SIGN
TXOA T2,SGNFLG ;SET MINUS FLAG
CAIN T1,"+" ;CHECK FOR A PLUS SIGH
TXOA T2,DGSEEN ;TREAT SIGNS LIKE DIGITS
JRST HEXI3 ;NOT A SIGN
SOJA T3,HEXI1 ;YES, COUNT AND GET NEXT CHAR
HEXI3: CAME T3,[-1] ;FIRST CHAR ILLEGAL
JUMPL T3,HEXI5 ;NO ERROR ON VARIABLE FIELD INPUT
$ACALL ILC ;"ILLEGAL CHARACTER IN DATA"
HEXI5: JUMPN T4,HEXI5A ;LEAVE ALONE IF NON-ZERO 1ST WORD
EXCH T4,T5 ;ELSE SWAP THEM
HEXI5A: TXNN T2,SGNFLG ;CHECK THE SIGN OF THE OUTPUT
JRST HEXI6 ;POSITIVE
DMOVN T4,T4 ;NEGATIVE (NEGATE THE RESULT)
TLO T5,400000 ;DMOVN ZEROES SIGN BIT OF RIGHT
;WORD - VAL IS NEG SO TURN IT ON ALWAYS
HEXI6: MOVEM T4,(P1) ;ASSUME SINGLE PREC
CAIN P2,2 ;[735] IF DOUBLE PRECISION
MOVEM T5,1(P1) ;[735] THEN RETURN BOTH HALVES
POPJ P, ;RETURN TO FOROTS
%HEXO: PUSHJ P,%SAVE2 ;SAVE P1 & P2
PUSHJ P,HEXSET ;DO SETUP
MOVSI T5,(POINT 4,(P1)) ;GET A HEX BYTE POINTER
JUMPN T3,HEXO1 ;CHECK FOR VARIABLE FIELD OUTPUT
MOVEI T3,^D15 ;YES SET FIELD WIDTH TO O15
CAIN P2,2 ;IF DOUBLE REAL
MOVEI T3,^D25 ;THEN ITS O25
HEXO1: MOVE T4,%DWVAL ;GET MINIMUM # DIGITS
JUMPN T4,GOTMIN ;DONE IF NON-ZERO
MOVEI T4,(T3) ;USE WIDTH IF 0
GOTMIN: SUBI T3,(T2) ;FIND THE EXCESS FIELD WIDTH
JUMPLE T3,HEXO2 ;W<= MAX FIELD WIDTH
MOVEI T1," " ;SET UP A BLANK FILLER
PUSHJ P,%OBYTE ;OUTPUT THE FILLER
SOJG T3,.-1 ;CONTINUE UNTIL W=0 (EXCESS)
HEXO2: JUMPE T3,HEXO2B ;GO ON IF FITS
ADD T2,T3 ;MODIFY # CHARS FOR OUTPUT
HEXO2A: ILDB T1,T5 ;GET CHAR
SKIPE %FTAST ;ASTERISKS ON OVERFLOW?
JUMPN T1,%FTSUC ;YES. OVERFLOW IF DIGIT NON-ZERO
AOJL T3,HEXO2A
HEXO2B: ILDB T1,T5 ;GET A CHAR
JUMPN T1,HEXO3A ;GO PRINT ALL IF NON-ZERO
MOVEI T1,"0" ;MAYBE PRINT A ZERO
CAILE T2,(T4) ;PRINT A SPACE IF ALLOWED TO
MOVEI T1," " ;IF W.M WAS SPECIFIED
PUSHJ P,%OBYTE ;OUTPUT ZERO OR SPACE
SOJG T2,HEXO2B
POPJ P, ;LEAVE IF DIGITS EXHAUSTED
HEXO3: ILDB T1,T5 ;GET THE NEXT HEXAL DIGIT
HEXO3A: ADDI T1,"0" ;CONVERT TO ASCII
CAILE T1,"9" ;PAST 9?
ADDI T1,"A"-"0"-^D10 ;YES, CONVERT TO RANGE A-F
PUSHJ P,%OBYTE ;OUTPUT A DIGIT
SOJG T2,HEXO3 ;BACK FOR MORE
HEXORT: POPJ P, ;RETURN TO FOROTS
HEXSET: MOVE P1,IO.ADR ;GET ADDR OF VARIABLE
MOVEI T2,9 ;9 DIGITS ONLY
MOVE P2,IO.TYP ;GET VARIABLE TYPE
MOVE P2,%SIZTB(P2) ;GET ENTRY SIZE
IMULI T2,(P2) ;GET CORRESPONDING # DIGITS
MOVE T3,%FWVAL ;GET THE FIELD WIDTH
POPJ P,
PRGEND
TITLE POWTAB D.P. INTEGER POWER OF TEN TABLES
SEARCH MTHPRM
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
;ALL RIGHTS RESERVED.
SEGMENT CODE
ENTRY %HITEN, %LOTEN, %EXP10, %PTMAX,%NMEXP,%PMEXP
ENTRY %DEXP,%HIMAX,%BEXP,%HIINT,%LOINT,%LFMSK,%SIZTB
;POWER OF TEN TABLE IN DOUBLE PRECISION
;INTEGER FORMAT. EACH ENTRY CONSISTS OF TWO WORDS,
;EACH WITH 35 BITS OF FRACTION (SIGNS ARE EXCLUDED).
;THE BINARY POINT IS BETWEEN BITS 0 AND 1 OF THE
;HI ORDER WORD. THE EXPONENT FOR THE 70 BIT
;FRACTION IS STORED IN THE SHORT TABLE CALLED "EXPTEN".
;FOLLOWING THE STANDARD TABLE IS ATHE EXTENDED EXPONENT
;TABLE, WHICH IS A SPARSE POWER OF TEN TABLE RANGING FROM
;10**21 TO 10**326, FOR USE IN ENCODING AND DECODING G-FLOATING
;NUMBERS.
;THE NUMBERS IN BOTH TABLES ARE TRUNCATED, THAT IS, NO
;ROUNDING HAS BEEN DONE FROM THE (VIRTUAL) THIRD WORD OF
;PRECISION. THUS, ON AVERAGE, THE TABLES ARE BIASED 1/2 BIT
;DOWNWARDS.
DEFINE .TAB. (A)<
NUMBER -321,322477622614,164206201643
NUMBER -315,203507673567,310523721106
NUMBER -312,244431652525,272650705327
NUMBER -307,315540225253,051423066615
NUMBER -303,200434135252,371753742170
NUMBER -300,240543164525,270346732626
NUMBER -275,310674021653,046440521374
NUMBER -272,373053026225,360150645673
NUMBER -266,234732715735,266101407525
NUMBER -263,304121501325,043521711452
NUMBER -260,365146021612,154446273765
NUMBER -254,231177613066,203667765371
NUMBER -251,277437555704,044645762667
NUMBER -246,357347511265,056017357445
NUMBER -242,225520615661,074611525567
NUMBER -237,273044761235,213754053125
NUMBER -234,351656155504,356747065752
NUMBER -230,222114704413,025260341562
NUMBER -225,266540065515,332534432117
NUMBER -222,344270103041,121263540543
NUMBER -216,216563051724,322660234335
NUMBER -213,262317664312,007434303425
NUMBER -210,337003641374,211343364332
NUMBER -204,213302304735,325716130610
NUMBER -201,256162766125,113301556752
NUMBER -176,331617563552,236162112545
NUMBER -172,210071650242,242707256537
NUMBER -167,252110222313,113471132267
NUMBER -164,324532266776,036407360745
NUMBER -160,204730362276,323044526457
NUMBER -155,246116456756,207655654173
NUMBER -152,317542172552,051631227231
NUMBER -146,201635314542,132077636440
NUMBER -143,242204577672,360517606150
NUMBER -140,312645737651,254643547602
NUMBER -135,375417327624,030014501542
NUMBER -131,236351506674,217007711035
NUMBER -126,306044030453,262611673245
NUMBER -123,367455036566,237354252116
NUMBER -117,232574123152,043523552261
NUMBER -114,301333150004,254450504735
NUMBER -111,361622002005,327562626124
NUMBER -105,227073201203,246647575664
NUMBER -102,274712041444,220421535242
NUMBER -077,354074451755,264526064512
NUMBER -073,223445672164,220725640716
NUMBER -070,270357250621,265113211102
NUMBER -065,346453122766,042336053323
NUMBER -061,220072763671,325412633103
NUMBER -056,264111560650,112715401724
NUMBER -053,341134115022,135500702312
NUMBER -047,214571460113,172410431376
NUMBER -044,257727774136,131112537675
NUMBER -041,333715773165,357335267655
NUMBER -035,211340575011,265512262714
NUMBER -032,253630734214,043034737477
NUMBER -027,326577123257,053644127417
NUMBER -023,206157364055,173306466551
NUMBER -020,247613261070,332170204303
NUMBER -015,321556135307,020626245364
NUMBER -011,203044672274,152375747331
NUMBER -006,243656050753,205075341217
NUMBER -003,314631463146,146314631463
A: NUMBER 001,200000000000,000000000000
NUMBER 004,240000000000,000000000000
NUMBER 007,310000000000,000000000000
NUMBER 012,372000000000,000000000000
NUMBER 016,234200000000,000000000000
NUMBER 021,303240000000,000000000000
NUMBER 024,364110000000,000000000000
NUMBER 030,230455000000,000000000000
NUMBER 033,276570200000,000000000000
NUMBER 036,356326240000,000000000000
NUMBER 042,225005744000,000000000000
NUMBER 045,272207335000,000000000000
NUMBER 050,350651224200,000000000000
NUMBER 054,221411634520,000000000000
NUMBER 057,265714203644,000000000000
NUMBER 062,343277244615,000000000000
NUMBER 066,216067446770,040000000000
NUMBER 071,261505360566,050000000000
NUMBER 074,336026654723,262000000000
NUMBER 100,212616214044,117200000000
NUMBER 103,255361657055,143040000000
NUMBER 106,330656232670,273650000000
NUMBER 112,207414740623,165311000000
NUMBER 115,251320130770,122573200000
NUMBER 120,323604157166,147332040000
NUMBER 124,204262505412,000510224000
NUMBER 127,245337226714,200632271000
NUMBER 132,316627074477,241000747200
NUMBER 136,201176345707,304500460420
NUMBER 141,241436037271,265620574524
NUMBER 144,311745447150,043164733651
NUMBER 147,374336761002,054022122623
NUMBER 153,235613266501,133413263574
NUMBER 156,305156144221,262316140533
NUMBER 161,366411575266,037001570661
NUMBER 165,232046056261,323301053417
NUMBER 170,300457471736,110161266322
NUMBER 173,360573410325,332215544007
NUMBER 177,226355145205,250330436404
NUMBER 202,274050376447,022416546105
NUMBER 205,353062476160,327122277527
NUMBER 211,222737506706,206363367626
NUMBER 214,267527430470,050060265574
NUMBER 217,345455336606,062074343133
NUMBER 223,217374313163,337245615771
NUMBER 226,263273376020,327117161367
NUMBER 231,340152275425,014743015665
NUMBER 235,214102366355,050055710521
NUMBER 240,257123064050,162071272645
NUMBER 243,332747701062,216507551417
NUMBER 247,210660730537,231114641751
NUMBER 252,253035116667,177340012343
NUMBER 255,325644342445,137230015034
NUMBER 261,205506615467,133437010121
NUMBER 264,247030361005,062346612146
NUMBER 267,320636455206,177040354577
NUMBER 273,202403074224,017324223757
NUMBER 276,243103713271,023211270753
NUMBER 301,313724676147,130053547146
NUMBER 304,376712055601,056066501000
NUMBER 310,237236234460,274642110500
NUMBER 313,307105703574,354012532620
NUMBER 316,370727264534,047015261364
>
DEFINE NUMBER (A,B,C) <B>
TENTAB: .TAB. %HITEN
DEFINE NUMBER (A,B,C) <C>
.TAB. %LOTEN
%PTMAX==%HITEN-TENTAB-1 ;MAX ENTRY INDEX
DEFINE NUMBER (A,B,C) <A>
%NMEXP==.
.TAB. %EXP10
%PMEXP==.-1
DEFINE HITABL <
%%EXP==0
HIEXP 21, 0106, 330656232670, 273650000000
HIEXP 31, 0147, 374336761002, 054022122623
HIEXP 42, 0214, 267527430470, 050060265574
HIEXP 52, 0255, 325644342445, 137230015034
HIEXP 63, 0322, 233446460731, 230310256730
HIEXP 73, 0363, 265072116565, 045110433532
HIEXP 84, 0430, 203616042160, 325266273336
HIEXP 94, 0471, 231321375525, 337205744037
HIEXP 105, 0535, 337172572336, 007545174113
HIEXP 115, 0577, 201742476560, 254305755623
HIEXP 126, 0643, 275056630405, 050037577755
HIEXP 136, 0704, 334103204270, 352046213535
HIEXP 147, 0751, 240125245530, 066753037574
HIEXP 158, 1015, 351045347212, 074316542736
HIEXP 168, 1057, 207525153773, 310102120644
HIEXP 179, 1123, 305327273020, 343641442602
HIEXP 189, 1164, 345647674501, 121102720143
HIEXP 200, 1231, 247161432765, 330455055455
HIEXP 210, 1272, 302527746114, 232735577632
HIEXP 221, 1337, 215510706516, 363467704427
HIEXP 231, 1400, 244711331533, 105545654076
HIEXP 242, 1444, 357747123347, 374251221667
HIEXP 252, 1506, 213527073575, 262011603206
HIEXP 263, 1552, 313176275662, 023427342311
HIEXP 273, 1613, 354470426352, 214122564267
HIEXP 284, 1660, 254120203313, 021677205125
HIEXP 295, 1724, 372412614644, 074374052054
HIEXP 305, 1766, 221645055640, 266335117623
HIEXP 316, 2032, 324146136354, 344313410127
HIEXP 326, 2073, 367020634251, 325055547056
>
%HIMAX==^D326
DEFINE HIEXP (DEXP,BEXP,HIWRD,LOWRD) <
XWD BEXP,^D<DEXP>
EXP HIWRD
EXP LOWRD
%%EXP==%%EXP+1
>
%DEXP: HITABL
%BEXP==%DEXP+1
;TABLE OF INTEGER POWERS OF TEN
DEFINE TABLE
< NUMBER 000000000000,000000000001 ; 0
NUMBER 000000000000,000000000012 ; 1
NUMBER 000000000000,000000000144 ; 2
NUMBER 000000000000,000000001750 ; 3
NUMBER 000000000000,000000023420 ; 4
NUMBER 000000000000,000000303240 ; 5
NUMBER 000000000000,000003641100 ; 6
NUMBER 000000000000,000046113200 ; 7
NUMBER 000000000000,000575360400 ; 8
NUMBER 000000000000,007346545000 ; 9
NUMBER 000000000000,112402762000 ;10
NUMBER 000000000002,351035564000 ;11
NUMBER 000000000035,032451210000 ;12
NUMBER 000000000443,011634520000 ;13
NUMBER 000000005536,142036440000 ;14
NUMBER 000000070657,324461500000 ;15
NUMBER 000001070336,115760200000 ;16
NUMBER 000013064257,013542400000 ;17
NUMBER 000157013326,164731000000 ;18
NUMBER 002126162140,221172000000 ;19
NUMBER 025536165705,254304000000 ;20
NUMBER 330656232670,273650000000 ;21
>
DEFINE NUMBER (A,B)
< EXP A>
%HIINT: TABLE
DEFINE NUMBER (A,B)
< EXP B>
%LOINT: TABLE
;%SIZTB GIVES THE NUMBER OF WORDS ASSOCIATED WITH EACH TYPE OF
;VARIABLE.
%SIZTB: 1 ;(0) UNDEFINED (INTEGER)
1 ;(1) LOGICAL
1 ;(2) INTEGER
1 ;(3)
1 ;(4) SINGLE REAL
1 ;(5)
1 ;(6) SINGLE OCTAL (INTEGER)
1 ;(7) LABEL
2 ;(10) DOUBLE REAL
2 ;(11) DOUBLE INTEGER
2 ;(12) DOUBLE OCTAL
2 ;(13) EXTENDED DOUBLE REAL
2 ;(14) COMPLEX
1 ;(15) COBOL BYTE STRING
1 ;(16) CHARACTER
1 ;(17) ASCIZ
%LFMSK: 400000,,0
200000,,0
100000,,0
40000,,0
20000,,0
10000,,0
4000,,0
2000,,0
1000,,0
400,,0
200,,0
100,,0
40,,0
20,,0
10,,0
4,,0
2,,0
1,,0
400000
200000
100000
40000
20000
10000
4000
2000
1000
400
200
100
40
20
10
4
2
1
PRGEND
TITLE MTHAC AC SAVE ROUTINES
SEARCH MTHPRM
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1979, 1985
;ALL RIGHTS RESERVED.
ENTRY %SAVE1,%SAVE2,%SAVE3,%SAVE4
ENTRY %POPJ,%POPJ1,%POPJ2
ENTRY %PUSHT,%POPT,%JPOPT
SEGMENT CODE
;ROUTINES TO SAVE P1-P4
%SAVE1: EXCH P1,0(P) ;Save P1, get return addr
PUSHJ P,JRET1 ;STUFF RESTORE ROUTINE ADDR
JRST RET1 ;WHICH IS HERE
JRST RET11 ;SKIP RETURN
JRST RET12 ;DOUBLE SKIP RETURN
JRET1: PUSH P,P1 ;STUFF CURRENT RETURN ADDR
MOVE P1,-2(P) ;GET P1 BACK
POPJ P,
%SAVE2: EXCH P1,0(P) ;Save p1, get return addr
PUSH P,P2 ;Save p2
PUSHJ P,JRET2 ;STUFF RESTORE RETURN ADDR
JRST RET2 ;WHICH IS HERE
JRST RET21 ;SKIP RETURN
JRST RET22 ;DOUBLE SKIP RETURN
JRET2: PUSH P,P1 ;STUFF CURRENT RETURN ADDR
MOVE P1,-3(P) ;GET P1 BACK
POPJ P,
%SAVE3: EXCH P1,0(P) ;Save P1, get return addr
PUSH P,P2 ;Save P2
PUSH P,P3 ;Save P3
PUSHJ P,JRET3 ;STUFF RESTORE RETURN ADDR
JRST RET3 ;WHICH IS HERE
JRST RET31 ;SKIP RETURN
JRST RET32 ;DOUBLE SKIP RETURN
JRET3: PUSH P,P1 ;STUFF CURRENT RETURN ADDR
MOVE P1,-4(P) ;GET P1 BACK
POPJ P,
%SAVE4: EXCH P1,0(P) ;Save P1, get return addr
PUSH P,P2
PUSH P,P3
PUSH P,P4
PUSHJ P,JRET4 ;STUFF RESTORE RETURN ADDR
JRST RET4 ;WHICH IS HERE
JRST RET41 ;SKIP RETURN
JRST RET42 ;DOUBLE SKIP RETURN
JRET4: PUSH P,P1 ;STUFF CURRENT RETURN ADDR
MOVE P1,-5(P) ;GET P1 BACK
POPJ P,
RET4: POP P,P4
RET3: POP P,P3
RET2: POP P,P2
RET1: POP P,P1
POPJ P, ;Return to caller's caller.
;SKIP RETURNS
RET41: POP P,P4
RET31: POP P,P3
RET21: POP P,P2
RET11: POP P,P1
AOS (P) ;SKIP RETURN
POPJ P,
;DOUBLE SKIP RETURNS
RET42: POP P,P4
RET32: POP P,P3
RET22: POP P,P2
RET12: POP P,P1
%POPJ2: AOS (P) ;DOUBLE SKIP RETURN
%POPJ1: AOS (P) ;SINGLE SKIP
%POPJ: POPJ P, ;NONSKIP
;ROUTINES TO PUSH AND POP ALL T ACS
;Called by PUSHJ P,%PUSHT
%PUSHT: PUSH P,T1 ;SAVE T1-T5
PUSH P,T2
PUSH P,T3
PUSH P,T4
PUSH P,T5
EXCH T0,-5(P) ;SAVE T0, GET RETURN ADDRESS
PUSH P,T0 ;SAVE RETURN ADDRESS
MOVE T0,-6(P) ;RESTORE T0
POPJ P, ;RETURN
;Called by PUSHJ P,%POPT
%POPT: POP P,T0 ;GET RETURN ADDRESS
POP P,T5 ;RESTORE T5-T1
POP P,T4
POP P,T3
POP P,T2
POP P,T1
EXCH T0,(P) ;RESTORE T0
POPJ P, ;RETURN
;Called by PJRST %JPOPT
%JPOPT: POP P,T5 ;RESTORE T5-T0
POP P,T4
POP P,T3
POP P,T2
POP P,T1
POP P,T0
POPJ P, ;RETURN
END