File PRINT.MA (MACREL macro assembler source file)

Directory of image this file is from
This file as a plain text file

	TITLE	PRINT - ROUTINE TO PRINT PPL USER DATA   /TAS/EAT/   24-MAR-72
	SUBTTL	ENTRY TO PRINT THE VALUE OF ANY LEXEME

	HISEG
	SEARCH	PPL

PRINT0:	MOVE	AC1,@ARGP	;ENTER HERE FROM SYSTEM FN 'PRINT'

	REPEAT 0,<THIS ROUTINE TAKES A LEXEME IN AC1 AND PRINTS IT.
		B HAS DZADR OF CAR IN IT AND TOPF OF CAR POINTS
		TO LEXEME TO BE PRINTED ON CAR STACK.>

PRINT:	SAVE <AC1,AC2,AC3,AC4,AC5>
IFN ARDS,<
	ARDMODE	34		;SET CHARACTER OUTPUT ON ARDS
	>
PRINT1:	MOVE	L,AC1		;PUT LEXEME IN L AND EXTRACT
	LGET	R2,LTYPF	;LEXEME TYPE IN R2
	JRST	@PRTAB(R2)	;DISPATCH ON LEXEME TYPE
PRTAB:	EXP	POPR		;OP-PRINT OPERATOR LEXEME AS OPERATOR
	EXP	PRLCL		;PROCID-GO REPLACE LEXEME WITH PROCID CONTENTS
	EXP	PRLCL		;FORML-GO REPLACE LEXEME WITH ACTUAL PARAMETER
	EXP	PRLCL		;LCL-GO REPLACE LOCAL WITH ITS VALUE IN CAR
	EXP	PID		;ID-GET VALUE OF ID IN IDT AND SWITCH ON I.TYPE
	EXP	PCONST		;CONST-GO SWITCH ON DATA TYPE AND PRINT CONSTANT
	EXP	PRELOC		;RELOC-PRINT RELOC AS INTEGER
	EXP	PDEMND		;DEMAND-PRINT QUESTION MARK
	EXP	PSELX		;SELX-COERCE TO CONSTANT AND GO TO PCONST
	EXP	PID		;$ID-PRINT LIKE ID
	EXP	PDREF		;DUMREF-FETCH REFERENCED VALUE


EXITPR:	RESTORE	AC5		;RESTORE AC'S AND EXIT
	HRRZ	B,(CAR)		;RESTORE DZADR OF CAR
	JRST	X4321

;ROUTINE TO PRINT AN OPERATOR POPR: HLLI AC1,AC1 ;ZERO LEFT HALF OF LEXEME IN AC1 PUSHJ P,OPPR ;SO AC1= RELADR OF OP IN OPT JRST EXITPR ;AND GO PRINT OPERATOR. ;ROUTINE TO SUBSTITUTE LEXEME OF A LOCAL QUANTITY IN THE ;CURRENT ACTIVATION RECORD FOR THE LOCAL LEXEME ;IN AC1, AND TO REENTER PRINT. PRLCL: MOVE AC2,AC1 ;SAVE PARAMETER NUMBER ADDI AC1,ARBASE(B) ;AC1=ABSOLUTE ADR OF LEXEME IN CAR STACK SKIPE AC1,(AC1) ;SUBSTITUTE VALUE OF LOCAL FOR LOCAL LEXEME IN AC1 JRST PRINT1 ;AND REENTER PRINTING PROCESS CALL KILLIO ;ERROR - BEGIN ERROR RECOVERY TTOS [SIXBIT/LOCAL !/] ;LOCAL UNDEFINED, ERROR. GET FNF ;R_PZ ADR OF FN HRRZ B,(R) ;GET DZ ADR OF FN HLRZ R,3(B) ;GET LINE0 ENTRY HRRZ B,(R) ;GET DZ ADR OF LINE 0 ADDI AC2,4(B) ;AC2_ABS ADDR OF LOCAL PARAMETER IN ERROR HLRZ AC1,(AC2) ;GET INTERNAL NAME OF PARAMETER JRST ILL5A ;GO PRINT IT AND ERROR EXIT ;ROUTINE TO PRINT THE VALUE OF AN IDENTIFIER PID: HRRZ AC2,@IDTP ;GET DZADR OF IDT HRLI AC2,AC1 ;PREPARE TO INDEX BY ID INTERNAL NAME MOVE R,@AC2 ;GET SYMBOL TABLE ENTRY FOR ID HLRZ R2,R ;R2=IDENTIFIER CLASS TO DISPATCH ON JUMPE R2,ILL5 ;IF ID IS UNDEFINED ,GO ILL5 JRST @ITTAB-1(R2) ;GO TO APPROPRIATE ACTION DEPENDING ON I.TYPE ITTAB: EXP PVAR ;VAR-GO PRINT VALUE OF VARIABLE AS CONST EXP PFN ;FN-PRINT FUNCTION DEFINITION EXP PDDEF ;DDEF-GO PRINT OUT DDEF EXP PSEL ;SEL-PRINT SELECTOR AS IDENTIFIER EXP PCEV ;CEV-GET VALUE OF CEV AND PRINT AS CONST EXP PATOM ;ATOM-PRINT ATOMIC TYPE NAME AS IDENTIFIER EXP ILL4 ;SNF-ILLEGAL TO PRINT SFN EXP PRESW ;RESW - PRINT ITS NAME
ILL4: EXERR MSG(PLMFC) ;PARAMETER LIST MISSING IN FN CALL PVAR: HRRZ AC1,R ;AC1_PZADR OF CONSTANT JUMPE AC1,ILL5 ;IF PZADR IS ZERO,VALUE UNDEFINED JRST PCONST ;PRINT VALUE AS CONSTANT ILL5: CALL KILLIO ILL5A: CALL IDPR ;PRINT ID NAME TO START MESSAGE TTOS [SIXBIT/ HAS NO VALUE IN CURRENT ENVIRONMENT#/] JRST RESTRT ;GO NOTIFY USER AND EXECUTE RECOVERY PFN: HLRZ R2,(R) ;GET TYPE OF BLOCK POINTED TO BY STE CAIE R2,B.FN(SYSBIT) ;A FN BLOCK? JRST .+3 ;NO, A LSB (UNTRANSLATED FN) HRRZ B,(R) ;YES. GET DZADR OF FN BLOCK GET R,TEXTF ;R_PZADR OF LSB HRRZ AC1,R ;PUT IN AC1 CALL TYFN ;TYPE OUT ADDRESSED FN DEFINITION JRST EXITPR PDREF: CALL GETDMR ;FETCH LEXEME REFERRED TO BY DUMREF MOVE AC1,L JRST PRINT1 ;SWITCH ON LEXEME TYPE AGAIN
PDDEF: HRRZ AC2,R ;PRINT A DDEF..... GET ADDR OF DDEF JUMPE AC2,ILL5 ;SHOULD NEVER BE ZERO TTOA [BYTE(7) TAB,"$"] CALL IDPR ;PRINT DDEF NAME (IN AC1) TTOS [SIXBIT/ = !/] ;SEPARATORS HRRZ B,(AC2) ;GET ABS ADDR OF DDEF BLOCK HLRZ AC2,(AC2) ;GET DDEF BLOCK TYPE FIELD CAIN AC2,SB+B.ALT ;AN ALTERNATE DEFINITION? JRST PALT ;YES, GO PRINT IT TTOI "[" ;NO, ALL OTHERS PRINT LEFT BRACKET CAIN AC2,SB+B.STRUCT ;A STRUCTURE DEFINITION? JRST PSTRUC ;YES, GO PRINT IT GET AC1,LBF ;MUST BE A SEQ OR VSEQ CALL INTPR ;PRINT LOWER BOUND TTOI ":" ;COLON CAIN AC2,SB+B.VSEQ ;VARIADIC SEQUENCE? JRST PVSEQ ;YES, GO SUBSTITUTE SPACE FOR UPPER BOUND GET AC1,UBF ;NO, GET UPPER BOUND FIELD CALL INTPR ;PRINT IT PSEQ1: TTOS [SIXBIT/] !/] ;PRINT RIGHT BRACKET GET AC1,TYPF ;PRINT ELEMENT TYPE CALL IDPR XITDEF: HRRZ B,(CAR) ;RESTORE CLOBBERED AC JRST EXITPR PVSEQ: TTOI " " ;PRINT SPACE IN PLACE OF UPPER BOUND JRST PSEQ1 PSTRUC: HLRZ AC2,(B) ;PRINT A STRUCTURE DEF.... GET LENGTH SOJA AC2,.+2 PSTRC1: TTOI "," ;SEPARATE THE COMPONENTS ADDI B,1 ;MOVE TO NEXT ENTRY HLRZ AC1,(B) ;GET SELECTOR NAME CALL IDPR ;PRINT IT TTOI ":" HRRZ AC1,(B) ;PRINT ELEMENT TYPE NAME CALL IDPR SOJG AC2,PSTRC1 ;CONTINUE FOR EACH PAIR TTOI "]" ;CLOSE DEFINITION JRST XITDEF PALT: HLRZ AC2,(B) ;PRINT AL ALTERNATE DEFINITION SOJA AC2,.+2 ;COMPUTE LENGTH PALT1: TTOI "!" ;SEPARATE THE ALTERNATE NAMES ADDI B,1 ;MOVE TO NEXT ALT PAIR HLRZ AC1,(B) ;GET AND PRINT LEFT ALTERNATE IN PAIR CALL IDPR HRRZ AC1,(B) ;GET RIGHT ALT NAME JUMPE AC1,XITDEF ;DON'T PRINT IF BLANK TTOI "!" ;OTHERWISE, SEPARATE AND PRINT CALL IDPR SOJG AC2,PALT1 JRST XITDEF
PRELOC: HLLI AC1,0 ;ZERO AC1 LEFT HALF PUSHJ P,INTPR ;PRINT RELOC AS POSITIVE INTEGER JRST EXITPR ;EXIT THE PRINT ROUTINE ;ROUTINE TO PRINT DEMAND SYMBOL AS "?" PDEMND: TTOI "?" ;PRINT "?" AND EXIT JRST EXITPR ;PRINT "?" AND EXIT ;CODE TO COERCE SELX TO CONSTANT AND PRINT IT. PSELX: HRRZ B,(L) ;B_DZADR OF LVALUE PUSHJ P,SELECT ;VALUE (R,R2),T=ELEMENT TYPE MOVEI T,17 ;NORMAL RETRN,HAD PZADR IN R LSH T,-1 ;SHIFT ELEMENT CODE RIGHT ONE CAILE T,LSTATM/2 ;SKIP IF CODE ATOMIC MOVEI T,LSTATM/2+1 ;ELSE USE 5 FOR ALL OTHERS MOVE AC1,R ;PUT (R,R2) IN (AC1,AC2) MOVE AC2,R2 XCT PELTBL(T) ;DISPATCH TO CORRECT PRINT HRRZ B,(CAR) ;RECOMPUTE DZADR OF CAR JRST EXITPR ;ROUTINE AND EXIT ;CODE COMMON TO PRESW,PDOLID,PATOM,AND PSEL. PRESW:PATOM:PSEL: IDENT: PUSHJ P,IDPR ;RH CONTAINS RELADR OF ID IN IDT JRST EXITPR ;PRINT ID AND EXIT ;IDPR ;PRINT THE SIXBIT ID NAME RELATIVELY ADDRESSED BY AC1 IDPR:: SAVE <AC1> ;SAVE ARG HRRZ R,@IDTP ;GET BASE ADDR OF IDT ADDI AC1,1(R) ;COMPUTE ADDR OF FIRST WORD OF PRINTNAME HRLI AC1,(POINT 6,0,5) ;MAKE BYTE POINTER ADDRESS FIRST CHAR LDB R,[POINT 6,(AC1),5] ;GET NUMBER OF WORDS IN IDT ENTRY IMULI R,6 ;COMPUTE MAX POSSIBLE NUMBER OF CHARACTERS SUBI R,7 LOOP13: ILDB R2,AC1 ;GET AN ID CHARACTER JUMPE R2,NEXT4 ;EXIT IF BLANK TTOI 40(R2) ;NO, PRINT THE CHAR SOJG R,LOOP13 ;GO FOR NEXT IF COUNT POSITIVE NEXT4: RESTORE <AC1> RETURN
SUBTTL CODE TO PRINT THE VALUE OF A CONST PCONST: MOVE AC1,(AC1) ;AC1_PZWORD FOR CONST HLRZ R2,AC1 ;R2_PZWORD LEFT HALF TLNE AC1,100000 ;SKIP IF WAS USER TYPE ERROR MSG(PNTSY) ;ATTEMPT TO PRINT SYSTEM DATA BLOCK CAILE R2,U.STRING ;SKIP IF NOT USER DEFINED JRST PUTYPE ;ELSE GO PRINT USER DEFINED TYPE LSH R2,-1 ;SHIFT RIGHT ONE JRST @CONTAB(R2) ;DISPATCH ON USER TYPE CONTAB: EXP PINT ;INT-GO FETCH INTEGER AND PRINT EXP PREAL ;REAL-GO FETCH REAL AND PRINT EXP PDBL ;DBL-GO FETCH DBL AND PRINT EXP PBOOL ;BOOL-GO FETCH BOOL AND PRINT EXP PCHAR ;CHAR-GO FETCH CHAR AND PRINT EXP PNULL ;NULL-GO PRINT "NULL" EXP PSTRIN ;STRING-GO PRINT STRING PINT: MOVE AC1,1(AC1) ;GET INTEGER IN AC1 PUSHJ P,INTPR ;PRINT AS DECIMAL INTEGER JRST EXITPR ;AND EXIT PREAL: MOVE AC1,1(AC1) ;AC1_REAL PUSHJ P,REALPR ;PRINT THE REAL JRST EXITPR ;GO OUT PDBL: MOVE AC2,2(AC1) ;PUT DOUBLE IN AC1,AC2 MOVE AC1,1(AC1) PUSHJ P,DBLPR ;PRINT THE DOUBLE JRST EXITPR ;AND EXIT PBOOL: MOVE AC1,1(AC1) ;GET BOOL IN AC1 ANDI AC1,1 PUSHJ P,BOOLPR ;GO PRINT BOOL JRST EXITPR ;AND EXIT PCHAR: MOVE AC1,1(AC1) ;GET CHARACTER IN AC1 ANDI AC1,177 ;EXTRACT RIGHTMOST SEVEN BITS PUSHJ P,CHARPR ;PRINT CHARACTER JRST EXITPR ;AND EXIT PNULL: TTOS [SIXBIT/NULL!/] JRST EXITPR
CHARPR: TTOI (AC1) ;PRINT CHAR IN AC1 RETURN ;EXIT BOOLPR: TTOS BOOLTB(AC1) ;PRINT "TRUE" OR "FALSE" RETURN BOOLTB: SIXBIT /FALSE!/ SIXBIT /TRUE!/
SUBTTL PRINT USER-DEFINED TYPES ;CODE TO PRINT USER DEFINED TYPE: QUICK AND DIRTY VERSION. ;THIS ROUTINE ONLY PRINTS TREE STRUCTURES. IT WILL LOOP ON ;STRUCTURES CONTAINING CYCLES. REPEAT 0,<ENTER WITH AC1=PZWORD FOR DATUM, R2=USER TYPE RELADR IN IDT.> PUTYPE: SAVE <AC6,AC7> ;SAVE TWO MORE ACCUMULATORS HRRZ AC2,(AC1) ;AC2_PZADR OF DATUM EXCH AC1,AC2 ;AC1=PZADR DATUM,AC2=PZWORD MOVE AC5,R2 ;SAVE USER TYPE RELADR IN AC5 PUSHJ P,LENGT ;CALCULATE LENGTH MOVE AC4,R ;SAVE IT IN AC4 TTOI "[" ;PRINT "[" JUMPN R,PUTYP2 ;EXIT IF LENGTH=0 PUTYP1: TTOI "]" ;EXIT FOR ENTIRE ROUTINE RESTOR <AC7,AC6> ;RESTORE ACCUMULATORS JRST EXITPR ;GO TO EXIT IN PRINT ROUTINE. I== AC7 ;TEMPORARY ACCUMULATOR ASSIGNMENT PUTYP2: MOVEI I,1 ;I_COMPONENT NUMBER TO BE PRINTED HRRZ AC3,@IDTP ;AC3_DZADR OF IDT ADD AC3,AC5 ;AC3_ABS ADR FOR STE OF DDEF TYPE HRRZ AC3,(AC3) ;AC3_PZADR OF DDEF BLOCK SKIPN AC3 ;IF TYPE DEFINED,SKIP ERROR MSG(PNTUN) ;ATTEMPT TO PRINT DATUM OF UNDEFINED TYPE HLRZ R2,(AC3) ;R2_DDEF TYPE ANDCMI R2,(CPYBIT+GCBIT+SYSBIT) ;MASK OUT OTHER BITS XCT PUTYTB-B.STRUCT(R2) ;DISPATCH ON DDEF TYPE INDEX PUTYTB: JRST PUTSTR ;GO PRINT STRUCTURE ERROR MSG(DTALT) ;DATUM WAS ALT IN PUTYPE JRST PUTSEQ ;GO PRINT POLYADIC SEQUENCE JRST PUTVSQ ;GO PRINT VARIADIC SEQUENCE
;PRINT A STRUCTURE. ;AC3=PZADR OF DDEF BLOCK, AC4=LENGTH, I=COMPONENT NUMBER, ;AC1=PZADR OF DATUM. PUTSTR: CAMLE I,AC4 ;IF I >LENGTH ,GO OUT JRST PUTYP1 PUTST1: HRRZ AC2,(AC3) ;AC2_DZADR OF DDEF BLOCK ADD AC2,I ;AC2_ABS ADR OF ITH SEL:TYPE PAIR IN DDEF HLRZ AC2,(AC2) ;AC2_RELADR OF SELECTOR ID IN IDT EXCH AC2,AC1 ;SAVE PZADR OF DATUM IN AC2 PUSHJ P,IDPR ;PRINT SELECTOR ID IN AC1 EXCH AC1,AC2 ;RESTORE PZADR OF DATUM IN AC1 TTOI ":" ;PRINT COLON MOVE AC5,I ;AC5_COMPONENT NUMBER-1 SUBI AC5,1 ROT AC5,-1 ;ROTATE IT RIGHT ONE HRRZ AC2,(AC1) ;AC2_DZADR OF DATUM ADDI AC2,1(AC5) ;AC2 POINTS TO WORD WITH ITH COMPONENT JUMPGE AC5,.+2 ;PICK UP PROPER HALF SKIPA AC2,(AC2) ;WORD IN AC2 MOVS AC2,(AC2) ;LEFT HALF HRLI AC2,(LXM(STAK,CONST)) ;MAKE CONSTANT LEXEME EXCH AC1,AC2 ;PUT IN AC1 &SAVE PZADR OF MOVE AC5,I ;DATUM IN AC2 PUSHJ P,PRINT ;CALL PRINT RECURSIVELY MOVE AC1,AC2 ;RESTORE AC1 TO PZADR OF DATUM MOVE I,AC5 ;AND RESTORE I TO COMPONENT NUMBER CAML I,AC4 ;GO OUT IF PRINTED LAST COMPONENT JRST PUTYP1 TTOI "," ;ELSE PRINT COMMA, AOJA I,PUTST1 ;INCRMNT I,AND GO AROUND
;PRINT POLYADIC AND VARIADIC SEQUENCES. ;ENTER HERE WITH AC1=PZADR OF DATUM,AC2=PZWORD OF DATUM, ;AC3=PZADR OF DDEF BLOCK,AC4=LENGTH,AC5=USER TYPE RELADR, ;I=AC7=COMPONENT NUMBER. PUTSEQ: MOVEI AC6,0 ;PUT 0 IN AC6 AS CODE FOR POLYADIC JRST PCSEQ ;SEQUENCE AND GO TO COMMON CODE PUTVSQ: MOVEI AC6,1 ;PUT 1 IN AC6 AS CODE FOR VARIADIC JRST PCSEQ ;SEQUENCE,AND GO TO COMMON CODE PCSEQ: CAMLE I,AC4 ;IF I > LENGTH OF DATUM JRST PUTYP1 ;GO OUT TO PRINT "]",ELSE EXCH B,AC3 ;COMPUTE CODE FOR ELEMENT HRRZ B,(B) ;TYPE IN AC3, B_DZADR OF DDEF GET R,TYPF ;R_ELEMENT TYPE (RELADR IN IDT) LSH R,-1 ;SHIFT ELEMENT TYPE RIGHT 1 ADDI R,1 ;ADD 1 CAILE R,LSTATM/2+1 ;ATOMIC? MOVEI R,LSTATM/2+2 ;NO, SIGNAL PACKED BY ADDRES MOVE B,AC3 ;RESTORE B MOVE AC3,R ;PUT ELEMENT TYPE CODE IN AC3 HRL AC3,AC1 ;SAVE AC1 RH IN AC3 LH PCSEQ1: PUSHJ P,ITH ;GO GET ITH ELEMENT IN (AC1,AC2) XCT PELTBL-1(AC3) ;DISPATCH TO PRINT ELEMENT ADDI I,1 ;I_I+1 CAMLE I,AC4 ;IF I>LENGTH EXIT JRST PUTYP1 ;TO PRINT "]" TTOI "," ;ELSE PRINT COMMA JRST PCSEQ1 ;AND GO AROUND
PELTBL: PUSHJ P,INTPR ;PRINT INT IN AC1 PUSHJ P,REALPR ;PRINT REAL IN AC1 PUSHJ P,DBLPR ;PRINT DBL IN (AC1,AC2) PUSHJ P,BOOLPR ;PRINT BOOL IN AC1 PUSHJ P,CHARPR ;PRINT CHAR IN AC1 TTOS [SIXBIT/NULL!/] ;PRINT NULL PUSHJ P,PZAPR ;RECURSIVELY PRINT DATUM PZAPR: HRLI AC1,(LXM(STAK,CONST)) ;SETUP CONSTANT LEXEME PUSHJ P,PRINT ;CALL PRINT RECURSIVELY POPJ P, ;EXIT ;CODE TO GET ITH ELEMENT OF SEQ OR VSEQ. ;DATUM PZADR IN AC3 LH, I=AC7,AC6= 0 FOR SEQ,1 FOR VSEQ, ;AC3 RH =CODE FOR ELEMENT TYPE INT=1,REAL=2,DBL=3,BOOL=4,CHAR=5, ;ALL OTHERS = 6 ITH: MOVE AC1,I ;AC1_I MOVE AC2,LTABL-1(AC3);AC2_SIZE OF FIELD IN BITS PUSHJ P,DBFIND ;CALCULATE POSITION OF ITH FIELD CAILE AC2,^D36 ;(R=DISP,R2=BEG) JRST DBLGET ;IF SIZE>36 GO GET DBL ADD R2,AC2 ;R2_SIZE+BEG MOVEI AC1,^D36 ;P=36-SIZE-BEG SUB AC1,R2 ;AC1=P FOR BYTE POINTER LSH AC1,6 ;SHIFT LEFT 6 ADD AC1,AC2 ;ADD SIZE LSH AC1,^D24 ;SHIFT P AND S LEFT 24 HLRZ R2,AC3 ;R2=PZADR OF DATUM HRRZ R2,(R2) ;R2_DZADR OF DATUM ADD R2,AC6 ;ADD 0 FOR SEQ,1 FOR VSEQ ADDI R2,1 ;INCREMENT BY ONE ADD R2,R ;R2_R2+DISP HLL R2,AC1 ;MAKE BYTE POINTER IN R2 LDB AC1,R2 ;LOAD BYTE POPJ P, ;AND EXIT ;COME HERE TO HANDLE DOUBLES DBLGET: HLRZ R2,AC3 ;R2_PZADR OF DATUM HRRZ R2,(R2) ;R2_DZADR OF DATUM ADD R2,AC6 ;ADD O FOR SEQ, 1 FOR VSEQ ADDI R2,1 ADD R2,R ;ADD DISPLACEMENT MOVE AC1,(R2) ;(AC1,AC2)_DOUBLE MOVE AC2,1(R2) ;R2 HAS ABS ADR OF DBL IN IT POPJ P, ;EXIT
SUBTTL PRIMITIVE PRINT ROUTINES OPPR: MOVE R,OPTP ;GET RELADR OF OPR IN AC1 HRRZ R,(R) ;R _ DZADR OF IDT BASE ADD R,AC1 ;R _ ADR OF ENTRY IN OPT MOVS R,(R) ;GET OP SWAPPED SO FIRST CHAR IS IN RH TRNE R,-1 ;PRINT CHARACTER IF NONBLANK TTOI 40(R) HLRI R, ;CLEAR RH ROT R,6 ;GET NEXT CHAR. JUMPN R,.-4 ;LOOP BACK IF ANY CHARACTERS REMAIN RETURN
;PRINT A FULL-WORD SIGNED DECIMAL INTEGER ;THIS ROUTINE IS STRAIGHT OUT OF THE MANUAL INTPR: SAVE <AC1,AC2> JUMPGE AC1,.+3 ;JUMP AROUND IF NUMBER POSITIVE TTOI "-" ;NEGATIVE, PRINT MINUS SIGN MOVN AC1,AC1 ;NEGATE NUMBER CALL INTPR1 ;CALL DIGIT UNPACK AND PRINT ROUTINE RESTORE <AC2,AC1> RETURN INTPR1: LSHC AC1,-^D35 ;THIS JAZZ PREVENTS TROUBLE WITH -2^35 LSH AC2,-1 DIVI AC1,^D10 ;EXTRACT LEAST SIGNIFICANT DIGIT HRLM AC2,(P) ;SAVE DIGIT ON STACK JUMPE AC1,.+2 ;IF QUOTIENT ZERO, ALL DIGITS HAVE BEEN EXTRACTED CALL INTPR1 ;NONZERO, STACK ANOTHER DIGIT HLRZ AC1,(P) ;DONE, RECOVER A DIGIT TTOI 60(AC1) ;PRINT IT RETURN ;GO BACK FOR ANOTHER OR EXIT
SUBTTL FORMATTED NUMERIC OUTPUT CONVERSION ROUTINES ;THE FOLLOWING ROUTINES OUTPUT NUMBERS ACCORDING TO A FORMAT WORD ; CONSTRUCTED AS FOLLOWS: ; BIT 0 0 = FREE FORMAT ; 1 = SUPPLIED FORMAT ; BIT 1 0 = PRINT "." ONLY IF REQUIRED ; 1 = PRINT "." ALWAYS ; BIT 2 0 = PRINT WITHOUT EXPONENT ; 1 = PRINT WITH EXPONENT ; BIT 3 0 = USE "E" FOR EXPONENT IF REQUIRED ; 1 = USE "D" FOR EXPONENT IF REQUIRED ; BITS 4-10 NUMBER OF LEADING ZERO-SUPPRESSED POSITIONS ; BITS 11-17 NUMBER OF LEADING NON-ZERO-SUPPRESSED POSITIONS ; BITS 18-24 NUMBER OF TRAILING NON-ZERO-SUPPRESSED POSITIONS ; BITS 25-31 NUMBER OF TRAILING ZERO-SUPPRESSED POSITIONS ; NOTE: BITS 2 AND 4-31 ARE EXPECTED TO BE CLEAR IF BIT 0 IS CLEAR. ;IN FREE FORMAT, A NUMBER IS PRINTED USING THE MINIMUM NUMBER ; OF DIGITS POSSIBLE. IT IS PRINTED IN NORMAL DECIMAL FORM IF ITS ; ABSOLUTE VALUE IS BETWEEN 10^-3 AND 10^6, ELSE IN SCIENTIFIC NOTATION. ;ACCUMULATOR CONVENTIONS FOR THE NUMERIC OUTPUT PACKAGE. E== AC3 ;DECIMAL EXPONENT K== AC4 ;BINARY EXPONENT; COUNTER; SCRATCH SD== AC5 ;SIGNIFICANT DIGIT COUNTER FM== AC7 ;FORMAT WORD
;FORMAT WORD BIT AND FIELD DEFINITIONS FMFLF== 1B0 ;FREE/FORMATTED FLAG **** MUST BE SIGN **** FMFLP== 1B1 ;ALWAYS PRINT PERIOD FMFLX== 1B2 ;ALWAYS PRINT EXPONENT FMFLD== 1B3 ;"D"/"E" SWITCH ; REFERENCED FROM SYSFUN. ****** DO NOT CHANGE ORDER ****** FMLZ: POINT 7,FM,<LZPOS==^D10> ;LEFT ZERO-SUPPRESSED PLACES FMLD: POINT 7,FM,<LDPOS==^D17> ;LEFT NON-ZERO-SUPPRESSED PLACES FMRZ: POINT 7,FM,<RZPOS==^D31> ;RIGNT ZERO-SUPPRESSED PLACES FMRD: POINT 7,FM,<RDPOS==^D24> ;RIGHT NON-ZERO-SUPPRESSED PLACES ; ********************************* MSKLZ== 177B<LZPOS> ;MASK FOR LZ MSKLD== 177B<LDPOS> ;MASK FOR LD MSKRD== 177B<RDPOS> ;MASK FOR RD MSKRZ== 177B<RZPOS> ;MASK FOR RZ ;USED INTERNALLY FMFLM== 1B32 ;MINUS SIGN TO BE PRINTED ;ROUTINE TO PRINT A REAL IN FREE FORMAT. ; AC1 = THE NORMALIZED FLOATING POINT NUMBER TO BE PRINTED. ; ROUNDING IS TO 7 SIGNIFICANT DIGITS. A DECIMAL POINT IS ALWAYS PRINTED. ; CLOBBERS ONLY R,R2 REALPR: CALL CNVSET ;SAVE AC'S 1-7 AND PUT NUMBER IN R SETZ R2, ;CLEAR LOW ORDER TO MAKE VALID DBL MOVEI SD,^D7 ;7 SIGNIFICANT DIGITS MOVSI FM,(FMFLP) ;FORMAT WORD: FREE FORMAT, ALWAYS PRINT "." JRST SGNCNV ;ENTER MAIN CONVERSION ROUTINE ;ROUTINE TO PRINT A DBL IN FREE FORMAT. ; (AC1,AC2) = NORMALIZED DOUBLE-PRECISION FLOATING POINT NUMBER ; TO BE PRINTED. ; ROUNDS TO 15 SIGNIFICANT DIGITS. A DECIMAL POINT IS ALWAYS PRINTED. ; IF EXPONENT IS PRINTED, IT IS PRECEDED BY "D" RATHER THAN "E". ; R,R2 CLOBBERED DBLPR: CALL CNVSET ;SAVE AC'S 1-7 AND PUT NUMBER IN (R,R2) MOVEI SD,^D15 ;15 SIGNIFICANT DIGITS MOVSI FM,(FMFLP+FMFLD) ;FORMAT WORD: FREE, ALWAYS PRINT "." AND "D" JRST SGNCNV ;ENTER MAIN CONVERSION CODE
;ROUTINE TO SAVE AC'S 1-7 AND LOAD (R,R2) WITH THE NUMBER TO BE PRINTED CNVSET: MOVE R,AC1 ;GET THE ARGS MOVE R2,AC2 EXCH AC1,(P) ;SAVE AC1 AND GET PC SAVE <AC2,AC3,AC4,AC5,AC6,AC7> ;SAVE AC'S 2-7 JRST (AC1) ;RETURN ;ROUTINE TO FORMAT AN INT, REAL, OR DBL IN A GIVEN FORMAT. ; (AC1,AC2) = INT, REAL, OR DBL TO BE OUTPUT ; T (AC12) = TYPE OF NUMBER, WHERE ; 0 = INT ; 1 = REAL ; 2 = DBL ; FM (AC7) = FORMAT WORD FORMPR: CALL CNVSET ;SAVE AC1-7 AND PUT NUMBER IN (R,R2) JRST FMPTAB(T) ;BRANCH ON TYPE OF ARG FMPTAB: JRST FORMNT ;INTEGER, GO DO SPECIAL PREPARATION TDZA R2,R2 ;REAL, CLEAR LOW-ORDER WORD AND SKIP TLO FM,(FMFLD) ;DOUBLE, SET "ALWAYS PRINT D" FLAG MOVE SD,T ;FETCH TYPE (1=REAL, 2=DBL) ASH SD,3 ;COMPUTE NUMBER OF SIGNIFICANT DIGITS ; WHERE REAL HAS 8 AND DBL HAS 16 JRST SGNCNV ;ENTER MAIN CONVERSION CODE ;HERE TO PREPARE AN INTEGER. WE DO SO BY CONVERTING IT TO A DBL. FORMNT: CALL INTDB1 ;CONVERT TO DBL, RESULT IN (R,R2) MOVEI SD,^D11 ;11 SIGNIFICANT DIGITS FOR INTEGER
;BODY OF PRINT ROUTINE. ; NUMBER IS IN (AC1,AC2) IN STANDARD DOUBLE-PRECISION FORMAT. ; SD CONTAINS MAX NUMBER OF SIGNIFICANT DIGITS AVAILABLE FROM THE ; NUMBER. FM CONTAINS FORMAT WORD. ; REMEMBER SIGN OF NUMBER, THEN EXTRACT EXPONENT AND CONVERT ; MANTISSA TO DOUBLE-PRECISION FIXED-POINT FRACTION. SGNCNV: JUMPG R,SGNCN1 ;JUMP IF NUMBER IS POSITIVE JUMPE R,RNDZER ;DON'T SCALE OR ROUND IF ZERO DFN R,R2 ;WAS NEGATIVE, TAKE MAGNITUDE TRO FM,FMFLM ;REMEMBER NUMBER WAS NEGATIVE SGNCN1: LDB K,[POINT 8,R,8] ;FETCH BINARY CHARACTERISTIC ASH R2,8 ;SQUEEZE OUT LOW-ORDER EXPONENT ASHC R,8 ;SHIFT OUT HIGH EXPONENT AND NORMALIZE ;NOW COMPUTE AN APPROXIMATION FOR THE DECIMAL SCALE, USING ; MEALY'S MAGIC ALGORITHM. HRREI E,-200(K) ;COMPUTE BINARY EXPONENT SAVE <R,R2,E> ;SAVE SOME STUFF IN CASE OF RESCALE IMULI E,2321 ;CALCULATE DECIMAL EXPONENT BY ADDI E,7777 ; CEIL(K*LOG10(2)) ASH E,-^D12
;RECALCULATE BINARY SCALE FROM THE RESULTANT DECIMAL SCALE TO DETERMINE ; THE NUMBER OF PLACES TO SHIFT FOR SCALING. SCALE: MOVE R,-2(P) ;RESTORE OLD DATA FROM STACK (IF RESCALE) MOVE R2,-1(P) MOVE K,(P) MOVM AC1,E ;FETCH MAGNITUDE OF DECIMAL SCALE IMULI AC1,3245 ;COMPUTE E*LOG2(10)+1 ASH AC1,-9 JUMPG K,.+2 ;WAS OLD BINARY EXPONENT NEGATIVE? MOVNI AC1,2(AC1) ;YES, NEGATE AND FIX UP FOR +1 BELOW SUBI K,1(AC1) ;COMPUTE SCALE DISCREPANCY ;SCALE BY POWER OF TEN ASHC R,-3 ;PREVENT DIVIDE CHECK MOVM AC2,E ;FETCH MAGNITUDE OF DECIMAL EXPONENT MOVE AC1,TENH(AC2) ;FETCH HIGH ORDER POWER OF TEN MOVE AC2,TENL(AC2) ;FETCH LOW ORDER POWER OF TEN JUMPG E,SCALDN ;JUMP TO SCALE DOWN IF E>0 CALL DBLMUL ;SCALE UP BY POWER OF TEN JRST .+2 SCALDN: CALL DBLDIV ;SCALE DOWN BY POWER OF TEN ASHC R,3(K) ;SCALE RESULTANT FRACTION BY POWER OF TWO CAMN R,C0.10H ;SEE WHETHER DOUBLE-PRECISION RESULT IS <0.1 CAML R2,C0.10L CAMGE R,C0.10H SOJA E,SCALE ;YES, DECREMENT DECIMAL EXPONENT AND RESCALE SUB P,[3,,3] ;NO, IN RANGE. FIX UP STACK
;NOW COMPUTE THE NUMBER OF SIGNIFICANT DIGITS TO ROUND TO. ; SD CONTAINS THE MAX NUMBER OF DIGITS THAT CAN BE GOTTEN OUT OF ; THE NUMBER AT HAND. JUMPGE FM,ROUND ;IF FREE FORMAT, USE ALL AVAILABLE DIGITS LDB K,FMRZ ;FETCH NUMBER OF RIGHT 0-SUPPR DIGITS LDB AC1,FMRD ;FETCH NUMBER OF RIGHT NON-0-SUPPR DIGITS ADD K,AC1 ;COMPUTE TOTAL DIGITS TO RIGHT OF "." TLNN FM,(FMFLX) ;PRINTING EXPONENT? JRST NPNTXP ;NO LDB AC1,FMLD ;YES, FETCN # OF LEFT NON-0-SUPPR DIGITS ADD K,AC1 ;INCREASE ROUND FACTOR BY THAT AMOUNT TRNN FM,FMFLM ;MINUS SIGN TO BE PRINTED? JRST SDCMP ;NO TLNN FM,(MSKLZ) ;YES, ANY LZ PLACES TO PUT IT INTO? SUBI K,1 ;NO, WILL HAVE TO BE PUT IN FIRST LD PLACE JRST SDCMP ;NOT PRINTING EXPONENT. COMPUTE NUMBER OF DIGITS TO ROUND TO ON THE BASIS ; OF THE NUMBER'S DECIMAL EXPONENT NPNTXP: ADD K,E ;ADD NUMBER OF DIGITS THAT WILL PRINT ON LEFT ;COMPUTE NUMBER OF SIGNIFICANT DIGITS ACTUALLY TO BE USED SDCMP: CAMGE K,SD ;LESS DIGITS REQUESTED THAN AVAILABLE? MOVE SD,K ;YES, GET ONLY NUMBER REQUESTED JUMPL SD,RNDZER ;SKIP ROUNDING IF NO DIGITS TO GET AT ALL ;NOW ROUND THE NUMBER TO (SD) SIGNIFICANT DIGITS; RESULT IN (AC1,AC2). ROUND: MOVE AC1,RNDH(SD) ;FETCH ROUNDING CONSTANT .5*10.^-(SD) MOVE AC2,RNDL(SD) ADD AC2,R2 ;ADD LOW ORDER ROUNDING CONSTANT TLZE AC2,400000 ;OVERFLOW? ADDI AC1,1 ;YES, CARRY TO HIGH ORDER ADD AC1,R ;ADD HIGH ORDER ROUNDING CONSTANT JUMPGE AC1,DIGCNT ;JUMP IF IT DIDN'T OVERFLOW MOVE AC1,C0.10H ;OVERFLOWED TO 1.0; SET RESULT TO 0.1 MOVE AC2,C0.10L ADDI AC2,1 ;FUDGE FOR ROUNDING PURPOSES ADDI E,1 ;AND INCREMENT DECIMAL EXPONENT BY 1 MOVEI SD,1 ;NOW WE HAVE ONE SIGNIFICANT DIGIT
;LOOK AT ALL THE DIGITS AND REMOVE TRAILING ZEROES FROM THE SIGNIFICANT ; DIGIT COUNT. DIGCNT: JUMPLE SD,RNDZER ;SET RESULT TO ZERO IF NO SIGNIFICANT DIGITS SAVE <AC1,AC2,SD> ;SAVE RESULT OF ROUNDING DIGCN1: CALL NXTDIG ;FETCH A DIGIT JUMPE R,.+2 ;NONZERO? MOVE K,SD ;YES, REMEMBER POSITION OF NONZERO DIGIT JUMPG SD,DIGCN1 ;REPEAT IF MORE DIGITS LEFT RESTOR <SD,AC2,AC1> ;GET BACK OLD NUMBER AND COUNT SUB SD,K ;SUBTRACT # OF TRAILING ZEROES FROM COUNT JUMPG SD,.+3 ;ARE THERE ANY SIGNIFICANT DIGITS LEFT? RNDZER: SETZB SD,E ;NO, ZERO COUNT AND EXPONENT SETZB AC1,AC2 ;ZERO THE NUMBER ITSELF ;IF FREE FORMAT, COMPUTE THE FORMAT PARAMETERS REQUIRED FOR OUTPUT. JUMPL FM,FMPR0 ;JUMP AROUND THIS IF NOT FREE FORMAT MOVEI K,1 ;ASSUME ONE LEFT DIGIT TO PRINT JUMPE AC1,FREFM2 ;VERY TRUE IF THE MANTISSA IS ZERO CAIG E,6 ;EXPONENT IN RANGE -3 TO 6? CAMGE E,[-3] TLOA FM,(FMFLX) ;NO, USE EXPONENTIAL FORMAT; LEFT DIGITS _1 SKIPL K,E ;YES, PRINT E LEFT DIGITS IN NON-EXPONENTIAL FREFM2: DPB K,FMLD ;SET LEFT DIGITS FIELD TRNE FM,FMFLM ;MINUS SIGN TO BE PRINTED? TLO FM,(1B<LZPOS>) ;YES, LEAVE ROOM FOR IT SUBM SD,K ;NOW COMPUTE # OF DIGITS TO GO ON RIGHT JUMPL K,.+2 ;NONE IF RESULT NEGATIVE DPB K,FMRD ;ELSE SET RIGHT DIGITS FIELD
;IF PRINTING IN EXPONENTIAL FORMAT, ADJUST EXPONENT SO THAT MANTISSA ; EXACTLY FILLS THE LEFT NON-0-SUPPR PLACES. FMPR0: TLNN FM,(FMFLX) ;PRINTING IN E FORMAT? JRST FMPR1 ;NO LDB K,FMLD ;YES, FETCH LEFT DIGIT COUNT TLNE FM,(MSKLZ) ;ANY ZERO-SUPPRESSED PLACES AVAILABLE? JRST .+3 ;YES, SPACE IS AVAILABLE FOR POSSIBLE "-" TRNE FM,FMFLM ;NO, MINUS SIGN TO BE PRINTED? SOJL K,FMTSML ;YES, RESERVE SPACE FOR IT IN LD FIELD; ; ERROR IF NO SPACE AVAAILABLE SUB E,K ;DECREMENT EXPONENT BY LEFT DIGIT COUNT SAVE <E> ;SAVE ADJUSTED EXPONENT FOR LATER PRINTING MOVE E,K ;NEW EXPONENT = # OF LEFT DIGITS TO PRINT ;MAKE SURE THERE IS SUFFICIENT SPACE TO PRINT THE INTEGER PART. FMPR1: LDB K,FMLD ;FETCH LEFT NON-ZERO-SUPPR DIGIT COUNT LDB AC6,FMLZ ;FETCH LEFT ZERO-SUPPR DIGIT COUNT ADDI K,(AC6) ;K_TOTAL LEFT DIGIT POSITIONS TRNE FM,FMFLM ;MINUS SIGN TO BE PRINTED? CAIGE E,(K) ;YES, ERROR IF E >= # OF PLACES AVAILABLE CAILE E,(K) ;NO, ERROR IF E > # OF PLACES AVAILABLE FMTSML: SFNERR MSG(NNFIT) ;NUMBER WILL NOT FIT INTO CURRENT FORMAT ;PRINT LEADING BLANKS, MINUS SIGN, AND/OR ZEROES. JUMPE K,FMPR4 ;JUMP IF NO INTEGER PART TO PRINT FMPR2: CAIN E,(K) ;REACHED FIRST SIGNIFICANT DIGIT YET? JRST FMPR3 ;YES, PRINT IT TRNN FM,FMFLM ;NO, MINUS SIGN STILL TO BE PRINTED? JRST FMPR2A ;NO, GO HANDLE LEADING ZERO CAIE E,-1(K) ;YES, WILL NEXT DIGIT BE SIGNIFICANT? CAIG AC6,1 ;OR IS 0-SUPPR COUNT 0 OR 1? SOJA AC6,FMPR2B ;YES TO EITHER, PRINT MINUS SIGN NOW FMPR2A: JUMPLE AC6,.+3 ;NO, 0-SUPPR IN EFFECT? TTOI " " ;YES, PRINT LEADING BLANK SOJA AC6,FMPR2C ;DECREMENT 0-SUPPR COUNT TTOI "0" ;NO, PRINT LEADING ZERO SOJA AC6,FMPR2C ;DECREMENT 0-SUPPR COUNT FMPR2B: TTOI "-" ;HERE TO PRINT MINUS SIGN TRZ FM,FMFLM ;CLEAR MINUS SIGN FLAG FMPR2C: SOJG K,FMPR2 ;LOOP BACK IF ANY LEFT DIGIT POSITIONS REMAIN JRST FMPR4 ;HERE ONLY IF NO SIG DIGITS TO LEFT OF "." ;SIGNIFICANT DIGIT SEEN, PRINT INTEGER PART OF NUMBER. FMPR3: CALL NXTDIG ;COMPUTE THE NEXT DIGIT TTOI "0"(R) ;PRINT IT IN ASCII SOJG K,FMPR3 ;LOOP BACK IF ANY LEFT DIGIT POSITIONS REMAIN
;INTEGER PART FINISHED. PRINT PERIOD IF NECESSARY FMPR4: TRNN FM,MSKRD+MSKRZ ;FRACTIONAL DIGIT POSITIONS SPECIFIED? TLNE FM,(FMFLP) ;PERIOD FLAG SET? TTOI "." ;YES TO EITHER, PRINT DECIMAL POINT ;PRINT FRACTIONAL PART LDB K,FMRZ ;FETCH RIGHT ZERO SUPPRESSED DIGITS LDB AC6,FMRD ;FETCH RIGHT NON-0-SUPPR DIGITS ADD K,AC6 ;COMPUTE TOTAL RIGHT DIGITS JUMPE K,FMPR6 ;JUMP IF NO DIGIT POSITIONS REMAIN FMPR5: AOJLE E,FMPR5B ;PRINTING SIGNIFICANT DIGITS YET? JUMPLE SD,FMPR5A ;YES, ANY SIGNIFICANT DIGITS LEFT? CALL NXTDIG ;YES, FETCH NEXT DIGIT TTOI "0"(R) ;PRINT IT SOJA AC6,FMPR5C ;DECREMENT NON-0-SUPPR COUNT FMPR5A: SOJGE AC6,FMPR5B ;TRAILING ZEROES. 0-SUPPR IN EFFECT? TTOI " " ;YES, PRINT A SPACE JRST FMPR5C FMPR5B: TTOI "0" ;NO, PRINT A ZERO FMPR5C: SOJG K,FMPR5 ;JUMP BACK IF FRACTION NOT FINISHED ;PRINT EXPONENT IF REQUIRED AND EXIT THE PRINT ROUTINE. FMPR6: TLNN FM,(FMFLX) ;PRINTING EXPONENT? JRST FMPR9 ;NO, EXIT NOW RESTOR <E> ;YES, RESTORE (ADJUSTED) EXPONENT MOVEI K,"E" ;ASSUME "E" TO BE PRINTED? TLNE FM,(FMFLD) ;CORRECT? MOVEI K,"D" ;NO, SETUP "D" TO BE PRINTED TTOI (K) ;PRINT "E" OR "D" MOVEI K,"+" ;ASSUME EXPONENT IS POSITIVE JUMPGE E,.+3 ;CORRECT? MOVEI K,"-" ;NO, SETUP "-" TO BE PRINTED MOVMS E ;TAKE MAGNITUDE OF EXPONENT TTOI (K) ;OUTPUT "+" OR "-" IDIVI E,^D10 ;E_QUOTIENT, K_REMAINDER TTOI "0"(E) ;OUTPUT FIRST EXPONENT DIGIT TTOI "0"(K) ;OUTPUT SECOND EXPONENT DIGIT FMPR9: RESTOR <AC7,AC6,AC5> ;RESTORE SOME AC'S JRST X4321 ;RESTORE AC'S 4,3,2,1 AND RETURN
;ROUTINE TO OBTAIN THE NEXT DIGIT. ; (AC1,AC2) = THE CURRENT NORMALIZED FRACTION. ; SD = NUMBER OF SIGNIFICANT DIGITS REMAINING ; RETURNS THE NEXT DIGIT IN R; AC1,AC2,SD UPDATED. NXTDIG: SETZ R, ;SET DIGIT TO ZERO JUMPLE SD,CPOPJ ;RETURN IF NO DIGITS REMAIN MOVE R,AC1 ;FETCH HIGH WORD MOVE AC1,AC2 ;FETCH LOW WORD MULI AC1,^D10 ;MULTIPLY LOW WORD BY 10 MULI R,^D10 ;MULTIPLY HIGH WORD BY 10 ADD AC1,R2 ;CARRY FROM LOW TO HIGH WORD TLZE AC1,400000 ;OVERFLOW DURING CARRY? ADDI R,1 ;YES, CARRY 1 INTO NEW DIGIT SOJA SD,CPOPJ ;DECREMENT DIGIT COUNT AND RETURN ;ROUTINE TO PERFORM DOUBLE-PRECISION FIXED-POINT MULTIPLICATION ; (R,R2) = MULTIPLICAND AS A NORMALIZED BINARY FRACTION ; (AC1,AC2) = MULTIPLIER AS A NORMALIZED BINARY FRACTION ;RESULT RETURNED IN (R,R2), NOT NECESSARILY NORMALIZED. ;NO AC'S CLOBBERED EXCEPT R,R2 DBLMUL: SAVE <AC1,AC2,AC3,AC4> MOVE AC3,R2 ;COMPUTE CROSS PRODUCT A[LOW]*B[HIGH] MUL AC3,AC1 ;RESULT IN (AC3,AC4) MOVE AC1,R ;COMPUTE CROSS PRODUCT A[HIGH]*B[LOW] MUL AC1,AC2 ;RESULT IN (AC1,AC2) ADD AC2,AC4 ;ADD LOW PARTS OF CROSS PRODUCTS TLZE AC2,400000 ;IF OVERFLOW, ADD ONE TO HIGH PART OF ADDI AC1,1 ; CROSS PRODUCT MUL R,-3(P) ;COMPUTE HIGH ORDER PRODUCT A[HIGH]*B[HIGH] ADD R2,AC1 ;ADD HIGH PARTS OF CROSS PRODUCTS TLZE R2,400000 ; TO LOW PART OF HIGH-ORDER PRODUCT ADDI R,1 ;CARRY OVERFLOW ADD R2,AC3 TLZE R2,400000 ADDI R,1 JRST X4321 ;RESTORE AC'S, RESULT IN (R,R2)
;ROUTINE TO PERFORM DOUBLE-PRECISION FIXED-POINT DIVISION "X/Y". ; (R,R2) = DIVIDEND, A NORMALIZED FRACTION (X) ; (AC1,AC2) = DIVISOR, A NORMALIZED FRACTION (Y) ; X AND Y MUST BE POSITIVE AND X<Y. THE RESULT IS RETURNED (NOT ; NECESSARILY NORMALIZED) IN (R,R2). ;QUOTIENT IS COMPUTED BY : ; X/Y = Q+((R-Q*D)*2^-35)/B ; WHERE ; X = A+C*2^-35 ; Y = B+D*2^-35 ; Q,R ARE QUOTIENT AND REMAINDER OF X/B DBLDIV: SAVE <AC1,AC2> DIV R,AC1 ;R_Q, R2_R MOVE AC1,R ;AC1_Q MUL AC1,(P) ;(AC1,AC2)_Q*D SUBM R2,AC1 ;(AC1,AC2)_R-Q*D ASHC AC1,-1 ;PREVENT DIVIDE CHECK AT NEXT STEP DIV AC1,-1(P) ;AC1_((R-Q*D)/2)/B ASHC AC1,-^D34 ;AC2_(R-Q*D)/B, AC1_OVERFLOW, IF ANY MOVE R2,AC2 ;"ADD" LOW ORDER TO Q, WHICH WAS ; SINGLE PRECISION. TLZ R2,400000 ;FIX UP LOW SIGN (NOT REALLY NECESSARY) ADD R,AC1 ;ADD HIGH PART OF ((R-Q*D)*2^-35)/B JRST X21 ;RETURN, RESTORING AC'S
;POWER-OF-TEN TABLE FOR SCALING. ; ENTRIES ARE NORMALIZED, ROUNDED DOUBLE-PRECISION FRACTIONS. DEFINE PTENS < PTEN (200000000000,000000000000) ; 10.^00 PTEN (240000000000,000000000000) ; 10.^01 PTEN (310000000000,000000000000) ; 10.^02 PTEN (372000000000,000000000000) ; 10.^03 PTEN (234200000000,000000000000) ; 10.^04 PTEN (303240000000,000000000000) ; 10.^05 PTEN (364110000000,000000000000) ; 10.^06 PTEN (230455000000,000000000000) ; 10.^07 PTEN (276570200000,000000000000) ; 10.^08 PTEN (356326240000,000000000000) ; 10.^09 PTEN (225005744000,000000000000) ; 10.^10 PTEN (272207335000,000000000000) ; 10.^11 PTEN (350651224200,000000000000) ; 10.^12 PTEN (221411634520,000000000000) ; 10.^13 PTEN (265714203644,000000000000) ; 10.^14 PTEN (343277244615,000000000000) ; 10.^15 PTEN (216067446770,040000000000) ; 10.^16 PTEN (261505360566,050000000000) ; 10.^17 PTEN (336026654723,262000000000) ; 10.^18 PTEN (212616214044,117200000000) ; 10.^19 PTEN (255361657055,143040000000) ; 10.^20 PTEN (330656232670,273650000000) ; 10.^21 PTEN (207414740623,165311000000) ; 10.^22 PTEN (251320130770,122573200000) ; 10.^23 PTEN (323604157166,147332040000) ; 10.^24 PTEN (204262505412,000510224000) ; 10.^25 PTEN (245337226714,200632271000) ; 10.^26 PTEN (316627074477,241000747200) ; 10.^27 PTEN (201176345707,304500460420) ; 10.^28 PTEN (241436037271,265620574524) ; 10.^29
PTEN (311745447150,043164733651) ; 10.^30 PTEN (374336761002,054022122623) ; 10.^31 PTEN (235613266501,133413263574) ; 10.^32 PTEN (305156144221,262316140533) ; 10.^33 PTEN (366411575266,037001570662) ; 10.^34 PTEN (232046056261,323301053417) ; 10.^35 PTEN (300457471736,110161266323) ; 10.^36 PTEN (360573410325,332215544010) ; 10.^37 PTEN (226355145205,250330436405) ; 10.^38 PTEN (274050376447,022416546106) ; 10.^39 PTEN (353062476160,327122277527) ; 10.^40 PTEN (222737506706,206363367627) ; 10.^41 PTEN (267527430470,050060265574) ; 10.^42 PTEN (345455336606,062074343133) ; 10.^43 PTEN (217374313163,337245615771) ; 10.^44 PTEN (263273376020,327117161367) ; 10.^45 PTEN (340152275425,014743015665) ; 10.^46 PTEN (214102366355,050055710521) ; 10.^47 PTEN (257123064050,162071272646) ; 10.^48 PTEN (332747701062,216507551417) ; 10.^49 PTEN (210660730537,231114641751) ; 10.^50 PTEN (253035116667,177340012344) ; 10.^51 PTEN (325644342445,137230015035) ; 10.^52 PTEN (205506615467,133437010122) ; 10.^53 PTEN (247030361005,062346612146) ; 10.^54 PTEN (320636455206,177040354600) ; 10.^55 >
;ROUNDING CONSTANTS DEFINE RNDCS < RNDC (200000000000,000000100000) ; .5*10^-00 RNDC (014631463146,146314731463) ; .5*10^-01 RNDC (001217270243,327024465605) ; .5*10^-02 RNDC (000101422335,057065276764) ; .5*10^-03 RNDC (000006433342,353070514545) ; .5*10^-04 RNDC (000000517426,261070764361) ; .5*10^-05 RNDC (000000041433,336405636662) ; .5*10^-06 RNDC (000000003265,374515374537) ; .5*10^-07 RNDC (000000000253,314356206043) ; .5*10^-08 RNDC (000000000021,056027740467) ; .5*10^-09 RNDC (000000000001,267634066354) ; .5*10^-10 RNDC (000000000000,053766077030) ; .5*10^-11 RNDC (000000000000,004313731402) ; .5*10^-12 RNDC (000000000000,000341234115) ; .5*10^-13 RNDC (000000000000,000026511156) ; .5*10^-14 RNDC (000000000000,000002300730) ; .5*10^-15 RNDC (000000000000,000000263226) ; .5*10^-16 > ;UNNORMALIZED AND ROUNDED FRACTION 0.1 C0.10H: OCT 031463146314 C0.10L: OCT 314631463146
;ASSEMBLE THE TABLES DEFINED ABOVE DEFINE PTEN(H,L) < OCT H > TENH: PTENS ;HIGH-ORDER POWERS OF TEN DEFINE PTEN(H,L) < OCT L > TENL: PTENS ;LOW-ORDER POWERS OF TEN DEFINE RNDC(H,L) < OCT H > RNDH: RNDCS ;HIGH-ORDER ROUNDING CONSTANTS DEFINE RNDC(H,L) < OCT L > RNDL: RNDCS ;LOW-ORDER ROUNDING CONSTANTS
;ROUTINE TO PRINT A STRING PSTRIN: HRRE AC2,1(AC1) ;AC2_UPPER BOUND HRLI AC1,(POINT 7,) ;INIT ASCII BYTE POINTER ADDI AC1,2 ;POINT TO FIRST WORD OF DATA PRSTR1: JUMPLE AC2,EXITPR ;RETURN IF NO MORE CHARACTERS ILDB R,AC1 ;FETCH NEXT CHARACTER TTOI (R) ;PRINT IT SOJA AC2,PRSTR1 ;DECREMENT CHAR COUNT AND LOOP ;CODE TO PRINT A CONTINUOUS VALUE PCEV: HLLI R,0 ;ZERO R LEFT HALF JUMPE R,ILL5 ;GO TO ILL5 IF VALUE UNASSIGNED HRRZ AC1,(R) ;AC1=DZADR OF CONTINUOUS VALUE HRRZ AC1,1(AC1) ;AC1=PZADR OF CONTINUOUS VALUE JUMPE AC1,ILL5 ;GO TO ILL5 IF VALUE UNASSIGNED JRST PCONST ;ELSE GO PRINT VALUE AS CONSTANT LIT END



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search