format

	.PAG 'FORMAT'
;
;*THIS MODULE FORMATS THE DATA
; ACCORDING TO THE FLAGS SET BY
; THE INTERP MODULE
;
FMTNUM	LDA OPT ;GET OPTIONS BYTE
	ROR A ;PRINT LEADING SIGN?
	BCC FN20 ;IF CC, NO
;
;*FOUND LEADING SIGN FIELD
;
	LDA #'+
	LDX SGN
	BPL FN10
	LDA #'-
FN10	JSR INSERT
;
;*NOW CHECK FOR OVERFLOW IN FIELD
;
FN20	BIT SGN ;EXPONENT NEG?
	BVS FN70 ;IF VS, YES. CAN'T OVERFLOW
	LDA LW ;IS EXP>LW?
	CMP EXP
	BCS FN70 ;IF CS, NO. NUMBER FITS INTO FIELD
;
;*PROCESS THE OVERFLOW BY FILLING
; THE FIELD WITH *'S
;
;*PRINT THE DOLLAR SIGN IF PRESENT
;
FN23	LDA OPT
	AND #PRTDOL
	BNE LOOP
	LDA OPT
	AND #$10
	BEQ FN25
	LDA #'\
	JSR INSERT
	JMP FN25
;
;*FOUND A DOLLAR SIGN FIELD
;
LOOP	LDA #'$
	JSR INSERT
;
;*FILL THE LHS IF PRESENT
;
FN25	DEC LW ;ANY POSN LEFT TO FILL ON LHS?
	BMI FN30 ;IF MI, NO.
	LDA #'* ;YES
	JSR INSERT
	BCC FN25
;
;*PUT IN THE DECIMAL IF PRESENT
;
FN30	BIT OPT ;DECIMAL PT?
	BVC FN40 ;IF VC, NO
;
;*FOUND A DECIMAL POINT FIELD
;
	LDA #'. ;INSERT THE DECIMAL PT
	JSR INSERT
;
;*NOW FILL THE RHS IF PRESENT
;
FN35	DEC RW ;ANY POSNS LEFT TO FILL ON RHS?
	BMI FN40 ;IF MI, NO.
	LDA #'* ;FILL POSN W/*
	JSR INSERT
	BCC FN35
;
FN40	BIT OPT ;TRAILING SIGN FIELD?
	BPL FN60 ;IF PL, NO. DONE PROCESSING OVERFLOW
;
;*FOUND A TRAILING SIGN FIELD.
;
	LDA #BLANK ;ASSUME POSITIVE #
	BIT SGN ;# POSITIVE?
	BPL FN45 ;IF PL, YES
	LDA #'- ;NEG #
FN45	JSR INSERT
;
;*END OF OVERFLOW PROCESSING.
;
FN60	JMP FN280
;
;*NO OVERFLOW. IS THERE A DOLLAR FIELD?
;
FN70	LDA OPT
	AND #PRTDOL
	BNE FN100
	LDA OPT
	AND #PRTYEN
	BEQ FN73
	LDA OPT
	AND #PRTFYN
	BNE FN73
	LDA #'\
	JSR INSERT
	JMP FN73
;
;*FOUND A DOLLAR SIGN FIELD.
; IS IT REALLY FLOATING DOLLARS?
;
FN100	LDA OPT
	AND #PRTFDL
	BNE FN73
;
;*FOUND A FIXED DOLLAR SIGN FIELD.
; PRINT IT.
	LDA #'$
	JSR INSERT
;
;*ALGOL EQUIVALENT FOR THE FOLLOWING CODE:
; WRKBYT:=IF EXPSGN<0 THEN LW ELSE LW-EXP;
; IF EXP=0 AND RW=0 THEN WRKBYT:=WRKBYT-1;
; (LAST STMNT ALLOWS ROOM FOR A 0 IF ZERO WAS SENT BY THE PET)
FN73	LDA LW ;WRKBYT:=IF EXPSGN<0 THEN LW ELSE LW-EXP;
;
	BIT SGN
	BVS FN75
	SEC
	SBC EXP
FN75	STA WRKBYT
	LDA EXP ;IF EXP=0 AND RW=0 THEN WRKBYT:=WRKBYT-1;
	BNE FN78
	LDA RW
	BNE FN78
	DEC WRKBYT
;
;*ALGOL EQUIVALENT BELOW:
; WHILE (WRKBYT:=WRKBYT-1)>0
;   DO CALL INSERT( IF PRTLZ&OPT=0 THEN ' ' ELSE '0' );
;
FN78	DEC WRKBYT ;WHILE (WRKBYT:=WRKBYT-1)>0;
	BMI FN85
	LDY #BLANK ;IF PRTLZ&OPT=0 THEN ' ' ELSE '0';
	LDA OPT
	AND #PRTLZ
	BEQ FN80
	LDY #'0
FN80	TYA
	JSR INSERT
	BCC FN78 ;BR ALWAYS
;
;*ALGOL:
; IF PRTFDL&OPT<>0 THEN CALL INSERT('$');
;
FN85	LDA OPT
	AND #PRTFDL
	BNE FN103
	LDA OPT
	AND #PRTFYN
	BEQ FN90
	LDA #'\
	JSR INSERT
	JMP FN90
FN103	LDA #'$
	JSR INSERT
;
;*ALGOL:
; IF EXP=0 AND LW=0 THEN CALL INSERT('0');
;
FN90	LDA EXP
	BNE FN95
	LDA RW
	BNE FN95
	LDA #'0
	JSR INSERT
FN95
FN140	BIT SGN ;EXPONENT NEG?
	BVS FN170 ;IF VE, YES
	LDX #0
	STX WRKBYT
FN150	LDX WRKBYT
	CPX EXP
	BEQ FN170
	LDA FACC,X
	CPX #9
	BCC FN160
	LDA #'0
FN160	JSR INSERT
	INC WRKBYT
	BNE FN150
FN170	BIT OPT ;PRINT DECIMAL PT?
	BVC FN260 ;IF VC, NO
	LDA #'.
	JSR INSERT
	LDA RW
	BEQ FN260
	BIT SGN ;EXPONENT NEG?
	BVS FN220 ;IF VS, YES
	LDX EXP
	CPX #9
	BCC FN200
FN190	DEC RW
	BMI FN260
	JSR INSZER
	BCC FN190
FN200	LDA RW
	CLC
	ADC EXP
	STA RW
FN210	LDX EXP
	CPX RW
	BCS FN260
	LDA FACC,X
	CPX #9
	BCC *+4
	LDA #'0
	JSR INSERT
	INC EXP
	BNE FN210
FN220	LDX EXP
	CPX RW
	BCC *+4
	LDX RW
	STX WRKBYT
	LDA RW
	SEC
	SBC WRKBYT
	STA RW
FN230	DEC WRKBYT
	BMI FN240
	JSR INSZER
	BCC FN230
FN240	LDX #1
	STX WRKBYT
FN250	LDX WRKBYT
	CPX RW
	BEQ FN255
	BCS FN260
FN255	LDA FACC-1,X
	JSR INSERT
	INC WRKBYT
	BNE FN250
FN260	BIT OPT ;PRINT TRAILING SIGN?
	BPL FN280 ;IF PL, NO
;
;*FOUND TRAILING SIGN FIELD
;
	LDA #BLANK
	LDX SGN
	BPL FN270
	LDA #'-
FN270	JSR INSERT
FN280	JMP FMT10
	.SKI 5
;
;*SKPNUM-SKIP NUMERIC FIELD.
; THIS ROUTINE REPLACES EACH
; OUTPUT POSITION SET UP BY
; THE INTERP MODULE WITH
; BLANKS.
;
;*FILL LHS W/BLANKS IF PRESENT.
;
SKPNUM	LDA LW ;REPLACE LHS W/BLANKS
	BEQ SKPNU4 ;IF ZERO, NO POSNS TO REPLACE ON LHS
SKPNU2	LDA #BLANK
	JSR INSERT
	DEC LW ;DONE?
	BNE SKPNU2 ;IF NE, NO
;
;*NOW FILL RHS.
;
SKPNU4	LDA RW
	BEQ SKPNU6
SKPNU5	LDA #BLANK
	JSR INSERT
	DEC RW ;DONE?
	BNE SKPNU5
;
;*NOW FILL OTHER FIELDS
;
SKPNU6	LDX #8 ;SET UP BIT CTR
	STX LW ;USE LW AS TEMP CTR
	LDA #PRTLS+PRTDOL+PRTDP+PRTTS
	AND OPT ;THESE FIELDS GENERATE ONE CHAR EACH
	STA OPT
SKPNU7	LSR OPT ;THIS OPT BIT SET?
	BCC SKPNU8 ;IF NOT , DON'T INSERT BLANK
	LDA #BLANK
	JSR INSERT
SKPNU8	DEC LW
	BNE SKPNU7
	JSR IEEE ;NOW DUMP SKIP CHAR
	BVS ALP20 ;AND HOPE THE SA DIDN'T CHANGE ON US
	JMP FMT10 ;THRU PROCESSING SKIP
	.SKI 5
;
;*PROCESS ALPHA FIELD.
;
;
;*ELIMINATE LEADING BLANKS
;
ALPHA	JSR TERML
	BCS ALP80 ;LEAVE IF CS(TERMINAL)
	CMP #SKIP
	BEQ ALP50 ;GO BLANK FILL
	CMP #$20 ;LEADING BLANK
	BNE ALP30 ;IF NE, NO. GO USE CHAR
	JSR IEEE ;IGNORE BLANK
	BVC ALPHA ;IF NO SA CHANGE, LOOP
	JMP FINI20 ;ERROR
;
;*LEFT JUSTIFY DATA
;
ALP10	JSR IEEE
ALP20	BVS ALP85 ;IF VS, MISSING TERMINATOR ERROR
	JSR TERML ;ABORT FORMATTER?
	BCS ALP80 ;IF CS, YES
	CMP #SKIP ;SKIP OUT OF ALPHA?
	BEQ ALP50 ;IF EQ, YES
ALP30	LDX LW ;FIELD FULL?
	BEQ ALP10 ;IF EQ, YES
	JSR INSERT ;NO, SO INSERT CHAR
	LDA DATA ;PRINTABLE CHAR?
	AND #$7F
	CMP #$20
	BCC ALP10 ;IF CC, NO. DON'T CNT
	DEC LW ;YES, ONE LESS CHAR POSN LEFT
	BCS ALP10 ;BR ALWAYS
;
;*PAD RIGHT WITH BLANKS
;
ALP50	LDX LW ;FIELD ALREADY FULL?
	BEQ ALP70 ;IF EQ, YES
ALP55	LDA #BLANK ;NO, SO BLANK FILL
	JSR INSERT
	DEC LW ;DONE?
	BNE ALP55
ALP70	JSR IEEE
	BVS ALP85 ;IF VS, ERROR
	JMP FMT10
ALP80	JMP FINI20 ;ABORT FORMATTER
ALP85	JMP FINI90 ;MISSING TERMINATOR ERROR
	.END