.TITLE IFCNV .IDENT /1509.1/ ; ; ; ; WRITTEN BY RAY DI MARCO ; 15-SEP-81. ; ; ; VERSION 150981/01. ; ; ;------------------------------------------------------------------------- ; ; ; This module contains the FORTRAN callable routine IFCNV. The calling ; sequence is ; ; CALL IFCNV (ISIZE,BUF1,BUF2) ; ; where ISIZE is an integer ; BUF1 is a buffer of ISIZE bytes ; BUF2 is a buffer of ISIZE bytes ; ; ; The fuction 'IFCNVS' may also be called by the user to return the sign ; (+ -) of the resulting answer. ; ; ; ; ; The function will translate the monetary string BUF1 into BUF2; the format ; of the string in BUF2 will be ; ; [] [DDDDDD] <.> [CC] ; ; where is one or more leading spaces ; DDDDDD is on or more digits representing DOLLARS ; . is a decimal point ; CC is a two digit CENTs string ; ; The resulting string will be returned right justified in BUF1. R0 will be ; negative on return if an error was detected. All characters other than 0-9 ; and the decimal point are ignored! ; ; Note that all leading zeros except the one immediately before the decimal ; dot are converted to spaces. ; ; The routine will also set up the global "IFSIGN" word as follows ; ; if a "-" or "(" was included in the input string, then ; "IFSIGN" is loaded with the ascii code for "-" ; ; if no "-" or "(" is detected, then "IFSIGN" is loaded ; with the ascii code for "+". ; ; ; ; ; .SBTTL DECLARATIONS ; ; ; .MCALL .EXIT,.PRINT ; USED FOR ERROR REPORTING ; ; ; .GLOBL IFCNV,IFCNVS ; ENTRY .GLOBL IFSIGN ; SIGN WORD ; ; ; ; .PSECT CODE ; CODE SECTION ; ====== ==== ; ; ; ; ; .SBTTL ROUTINE - "IFCNV" ; ; ; ; ENSURE STRING OF LEAGL SIZE. IF NOT ABORT AFTER PRINTING AN ; ERROR MESSAGE. ; ; ; IFCNV: MOV #'+,IFSIGN ; ASSUME POSITIVE MOV @2(R5),R2 ; NUMBER OF CHARACTERS MOV 4(R5),R1 ; INPUT BUFFER MOV #BUF,R0 ; WORK BUFFER ; CMP R2,#4 ; MIN SIZE IS 4 BLO 700$ ; TOO SMALL -> ABORT CMP R2,#100. ; TOO LARGE? BLO 1000$ ; NO -> PROCEED 700$: .PRINT #ERR1 ; PRINT ERROR MESSAGE .EXIT ; EXIT ; ; ; COPY STRING INTO WORK BUFFER! AT SAME TIME CHECK FOR - OR ; ( WHICH MEAN MINUS! ; ; ; 1000$: MOVB (R1)+,(R0)+ ; COPY CMPB -1(R0),#'- ; NEAGTIVE? BEQ 1100$ ; YES -> SKIP CMPB -1(R0),#'( ; NEGATIVE? BNE 1200$ ; NO -> SKIP 1100$: MOV #'-,IFSIGN ; SET SIGN NEGATIVE 1200$: SOB R2,1000$ ; LOOP TILL ALL DONE CLRB (R0) ; NULL AT END OF STRING ; ; ; ; REMOVE ALL CHARACTERS OTHER THAN 0-9 AND DECIMAL POINT, CONPRESSING ; STRING TO THE RIGHT. ; ; MOV @2(R5),R2 ; COUNTER MOV R0,R1 ; R1 == FETCH POINTER DEC R1 ; R1 --> LAST CHARACTER 2000$: CMPB (R1),#'. ; DECIMAL POINT? BEQ 2400$ ; YES -> ACCEPT CMPB (R1),#'0 ; DIGIT? BLO 2500$ ; NO -> IGNORE CMPB (R1),#'9 ; DIGIT? BHI 2500$ ; NO -> IGNORE 2400$: MOVB (R1),-(R0) ; COPY 2500$: DEC R1 ; DOWN FETCH POINTER SOB R2,2000$ ; LOOP 2600$: CMP R0,#BUF ; ZEROED OUT LEADING BYTES? BLOS 2700$ ; YES -> SKIP MOVB #40,-(R0) ; LEADING SPACE BR 2600$ ; LOOP 2700$: ; EXIT FROM LOOP ; ; ; ; CONVERT LEADING ZEROS TO SPACES. ; MOV @2(R5),R2 ; COUNTER MOV #BUF,R0 ; R0 = START OF STRING 2720$: CMPB (R0),#40 ; SPACE? BEQ 2760$ ; YES -> SKIP CMPB (R0),#'0 ; "0" ? BNE 2770$ ; NO -> SKIP MOVB #40,(R0) ; CONVERT LEADING '0' -> SPACE 2760$: INC R0 ; BUMP POINTER SOB R2,2720$ ; LOOP 2770$: ; EXIT FROM LOOP ; ; ; ; ; STRING CAN HAVE ONLY 1 DECIMAL POINT. IF HAS MORE PRINT ; AN ERROR MESSAGE AND EXIT WITH ERROR FLAG SET! ; ; ; 3000$: MOV @2(R5),R2 ; NUMBER OF CHARACTERS CLR R1 ; NUMBER OF DOTS MOV #BUF,R0 ; POINTER 3100$: CMPB (R0)+,#'. ; DOT? BNE 3200$ ; SKIP IF NOT INC R1 ; UP COUNTER 3200$: SOB R2,3100$ ; LOOP CMP R1,#1 ; GOT 1 DOT? BLOS 3700$ ; 1 OR 0 DOTS -> SKIP .PRINT #ERR2 ; TELL GOT ERROR MOV #-1,R0 ; SET ERROR FLAG RETURN ; EXIT 3700$: BNE 5000$ ; NO DECIMAL POINT -> 5000$ ; ; ; ; ; ; ; STRING HAS A DECIMAL POINT. DECIMAL POINT CAN BE FOLLOWED WITH ; AT MOST 2 DIGITS. IF FOLLOWED BY MORE THAN TWO DIGITS PRINT ; ERROR MESSAGE AND ABORT. IF OK THEN ENSURE THAT HAVE TWO ; DIGITS AFTER POINT AND GOTO EXIT CODE. CAN ALSO ABORT IF STRING ; NOT LARGE TO HOLD EXTRA CENTS DIGITS. ; ; ; MOV @2(R5),R2 ; R2 = NUMBER OF CHARACTERS MOV #BUF,R1 ; R1 = FETCH POINTER MOV 6(R5),R0 ; R0 = STORE POINTER CMPB BUF-3(R2),#'. ; DOT IN RIGHT PLACE? BEQ 7000$ ; YES -> SKIP CMPB BUF-2(R2),#'. ; XXXX.X? BEQ 4100$ ; YES -> NEED SHIFT BY 1 CMPB BUF-1(R2),#'. ; XXXXX.? BEQ 4000$ ; YES -> NEED SHIFT BY 2 .PRINT #ERR3 ; TELL GOT AN ERROR MOV #-1,R0 ; SET ERROR FLAG RETURN ; EXIT ; ; 4000$: MOVB #'0,BUF+1(R2) ; PUT IN LAST ZERO CMPB BUF+1,#40 ; NEED 2 SPACES BNE 4200$ ; NO ROOM -> ERROR INC R1 ; BUMP FETCH POINTER 4100$: MOVB #'0,BUF(R2) ; PUT IN SECOND LAST ZERO INC R1 ; BUMP FETCH POINTER CMPB BUF,#40 ; NEED AT LEAST 1 SPACE BEQ 7000$ ; YES -> ALL OK 4200$: .PRINT #ERR4 ; TELL FAILED MOV #-1,R0 ; SET ERROR FLAG RETURN ; EXIT ; ; ; ; ; ; ; MUST PUT DECIMAL POINT AND TWO '0'S AT END OF STRING AS INPUT ; STRING DID NOT CONTAIN A DECIMAL POINT! ; ; 5000$: MOV @2(R5),R2 ; R2 = NUMBER OF CHARACTERS MOV #BUF+3,R1 ; R1 = FETCH POINTER MOV 6(R5),R0 ; R0 = STORE POINTER CMPB BUF+2,#40 ; ENOUGH ROOM? BNE 5100$ ; NO -> ERROR MOVB #'.,BUF(R2) ; PUT . MOVB #'0,BUF+1(R2) ; PUT 10S OF CENTS MOVB #'0,BUF+2(R2) ; PUT 1S OF CENTS BR 7000$ ; ALL OK 5100$: .PRINT #ERR4 ; TELL FAILED MOV #-1,R0 ; SET ERROR FLAG RETURN ; EXIT ; ; ; ; COPY R2 CHARACTERS FROM DTRING R1 INTO STRING R0 AND EXIT INDICATIONG ; THAT NO ERRORS OCCURED. ; ; 7000$: MOVB (R1)+,(R0)+ ; COPY SOB R2,7000$ ; LOOP CMPB -4(R0),#40 ; .XX ? BNE 7100$ ; NO -> SKIP MOVB #'0,-4(R0) ; --> 0.XX 7100$: CLR R0 ; CLEAR ERROR FLAG RETURN ; EXIT ; ; ; ; ; .SBTTL ROUTINE - 'IFCNVS' ... RETURN SIGN ; ; ; IFCNVS: MOV IFSIGN,R0 ; SIGN -> R0 RETURN ; ALL DONE ; ; ; ; ; ; .SBTTL BUFFER AND MESSAGES .NLIST BIN ; NO BINARY ; ; ; ; IFSIGN: .WORD 0 ; SIGN WORD BUF: .BLKB 100. ; WORK BUFFER ; .ENABL LC ; ENABLE LC ERR1: .ASCIZ /"IFCNV" - illegal string size?/ ERR2: .ASCIZ /"IFCNV" - too many decimal points in string?/ ERR3: .ASCIZ /"IFCNV" - too many cents in string?/ ERR4: .ASCIZ /"IFCNV" - output string too small?/ ; .END