.TITLE BINASC .IDENT /V01/ .ENABLE LC ; ; Th= module converts a binary number to ASCII in any radix from 2 to 36 ; ; Author: V01 25-Jan-80 Phil Stephensen-Payne ; ; Calling Sequence: ; ; This subroutine is called via the standard FORTRAN calling sequence as:- ; ; CALL BINASC (NUMBER,NUMCHR,RADIX,ASCSTR [,STATUS]) ; or ; STATUS = BINASC (NUMBER,NUMCHR,RADIX,ASCSTR) ; ; WHERE: ; NUMBER = THE (DOUBLEWORD) NUMBER TO BE CONVERTED ; NUMCHR = THE NUMBER OF OUTPUT CHARACTERS IN THE RANGE 0-255 ; RADIX = THE RADIX FOR THE CONVERSION (2-36) ; ASCSTR = THE ADDRESS OF THE OUTPUT STRING ; STATUS, IF SPECIFIED, DETERMINES THE MODE OF CONVERSION ON INPUT ; IF BIT 0 SET THEN SIGNED CONVERSION, ELSE UNSIGNED ; IF BIT 1 SET THEN LEADING ZEROES, ELSE LEADING BLANKS ; IF BIT 2 SET THEN LEFT ADJUSTED, ELSE RIGHT ADJUSTED ; And is the error return on output ; ; Errors Returned: ; ; STATUS = 0 IF THE OPERATION WAS SUCCESSFUL ; = -1 IF THERE WAS A PARAMETER ERROR ; = +1 IF THE NUMBER WOULD NOT FIT IN THE OUTPUT FIELD ; ; External References: ; ; This module calls the subroutines PRMCHK & $DDIV ; ; ; DATA AREAS ; SIGN: .BYTE ;SIGNED/UNSIGNED CONVERSION ZSUP: .BYTE ;ZERO SUPPRESSION FLAG JUST: .BYTE ;LEFT/RIGHT JUSTIFICATION INCHAR: .BYTE ;NUMBER OF CHARACTERS IN FIELD OUCHAR: .BYTE ;NUMBER OF CHARACTERS OUTPUT RADIX: .BYTE ;RADIX FOR CONVERSION .EVEN INADDR: .WORD ;ADDRESS OF ASCII STRING ; BINASC:: ; ; INITIALISE CONVERSION PARAMETERS ; CLRB SIGN ;UNSIGNED CONVERSION CLRB ZSUP ;LEADING ZEROES SUPPRESSED CLRB JUST ;RIGHT-ADJUSTED CLRB OUCHAR ;NUMBER OF CHARACTERS TO BE MOVED ; ; CHECK VALID NUMBER OF PARAMETERS ; MOV #5,R0 ;4 OR 5 REQUIRED CALL PRMCHK ;CHECK IT BCC 5$ ; If CC OK - Carry on JMP BINEND ;EXIT ; 5$: TST R0 ; Input Status Supplied? BEQ 30$ ;IF EQ NO INPUT STATUS - OMIT CHECKS ; ; EXTRACT STATUS BITS ; MOVB @10.(R5),R1 ;GET STATUS BYTE BEQ 30$ ;IF EQ NONE - CARRY ON BIT #1,R1 ;SIGN BIT CLEAR? BEQ 10$ ;IF EQ YES - CARRY ON INCB SIGN ;ELSE SET SIGN FLAG ; 10$: BIT #2,R1 ;ZERO-SUPPRESSION BIT SET? BEQ 20$ ;IF EQ NO - CARRY ON INCB ZSUP ;ELSE SET SUPRESSION FLAG ; 20$: BIT #4,R1 ;JUSTIFICATION BIT SET? BEQ 30$ ;IF EQ NO - CARRY ON INCB JUST ;ELSE SET JUSTIFICATION FLAG ; 30$: ; ; OBTAIN OTHER PARAMETERS FROM INPUT LIST ; MOVB @4(R5),R3 ;GET OUTPUT COUNT MOVB @6(R5),RADIX ;GET RADIX MOV 2(R5),R1 ;GET ADDRESS OF NUMBER BIT #1,R1 ; Is it Word-aligned? BEQ 35$ ; If eq yes - carry on MOV #-1,R0 ; No - flag a parameter error JMP BINEND ; and exit ; 35$: MOV 8.(R5),R5 ;GET ADDRESS OF OUTPUT MOV R5,INADDR ;AND SAVE IT MOVB R3,INCHAR ;SAVE CHARACTER COUNT FOR LATER BEQ 50$ ;IF EQ NO CHARACTERS - ERROR ADD R3,R5 ;SET ADDRESS TO END OF STRING MOV (R1)+,R2 ;GET LOW VALUE OF NUMBER MOV (R1),R1 ;GET HIGH VALUE BNE 40$ ;IF NE OK - KEEP GOING TST R2 ;NUMBER ZERO? BNE 40$ ;IF NE NO - CARRY ON INC OUCHAR ;ZERO - INSERT ONE ZERO.. DEC R3 ;DECREMENT SPACE LEFT MOVB #'0,-(R5) ;..CHARACTER IN THE OUTPUT BR BINMOV ;AND SET THE REST AS REQUIRED ; 40$: CMPB RADIX,#2 ;RADIX TOO LOW? BLO 50$ ;IF LO YES - FLAG ERROR CMPB RADIX,#36. ;RADIX TOO HIGH? BLOS 55$ ;IF LOS NO - CARRY ON ; 50$: MOV #-1,R0 ;SET ERROR BR BINAS1 ;OUTPUT ASTERISKS ; 55$: ; ; NOW SEE IF WE NEED A SIGN ON THE FRONT ; MOVB #' ,@INADDR ;INITIALISE FIRST CHARACTER TO BLANK TSTB SIGN ;SIGNED CONVERSION? BEQ BINLOP ;IF EQ NO - CARRY ON TST R1 ;NUMBER NEGATIVE BGE BINLOP ;IF GE NO - CARRY ON MOVB #'-,@INADDR ;INSERT MINUS SIGN NEG R1 ;NEGATE THE NUMBER DEC R1 NEG R2 DEC R3 ;COUNT THE BYTE ; ; NOW WE DIVIDE THE NUMBER BY THE RADIX REPEATEDLY UNTIL WE REACH ZERO, ; EACH TIME CONVERTING THE REMAINDER TO ASCII AND ADDING IT (BACKWARDS) ; TO THE OUTPUT LINE. ; BINLOP: MOVB RADIX,R0 ;GET RADIX AS DIVISOR CALL $DDIV ;DO DIVIDE CMPB R0,#9. ;ALPHABETIC NUMBER? BLE 10$ ;IF LE NO - CARRY ON ADD #7,R0 ;YES - ADJUST FOR ASCII GAP ; 10$: ADD #'0,R0 ;CONVERT TO ASCII MOVB R0,-(R5) ;OUTPUT THE NUMBER INCB OUCHAR ;COUNT IT TST R1 ;NUMBER ZERO? BNE 20$ ;IF NE NO - KEEP GOING? TST R2 ;SURE IT'S ZERO? BNE 20$ ;IF NE NO - KEEP GOING DEC R3 ;COUNT THIS CHARACTER BR BINMOV ;DO THE MOVING ; 20$: SOB R3,BINLOP ;NO - CONVERT NEXT OUTPUT CHAR IF ROOM ; ; NO ROOM FOR OUTPUT - FILL WITH ASTERISKS INSTEAD ; BINAST: MOV #1,R0 ;SET ERROR ; BINAS1: MOVB INCHAR,R3 ;OVERWRITE ALLL CHARACTERS MOV INADDR,R5 ;FROM START OF BUFFER MOVB #'*,R2 ;WITH ASTERISKS BR BINFIL ;OUTPUT IT ; ; NOW WE SEE IF WE NEED TO JUSTIFY THE FIELD LEFT OR RIGHT, ; AND/OR MOVE THE SIGN ; BINMOV: MOVB #' ,R2 ;INITIALISE FILL CHARACTER TSTB JUST ;LEFT - ADJUST? BNE 30$ ;IF NE YES - GO DO IT TSTB ZSUP ;NO - LEADING ZEROES? BEQ 10$ ;IF EQ NO - GO DO IT MOVB #'0,R2 ;SET FILL CHARACTER SUB R3,R5 ;CALCULATE START ADDRESS CLR R0 ;SET SUCCESFUL RETURN BR BINFIL ;DO THE FILLING ; 10$: CMPB @INADDR,#'- ;NO - LEADING SIGN? BNE 20$ ;IF NE NO - CARRY ON MOVB #'-,-(R5) ;YES - INSERT AT FRONT OF NUMBER ; 20$: MOV INADDR,R5 ;SET FILL ADDRESS TO START CLR R0 ;SET SUCCESFUL RETURN BR BINFIL ;GO DO THE FILLING ; 30$: MOV R5,R2 ;GET CURRENT ADDRESS SUB R3,R2 ;RESET TO FIRST NON- MOVB OUCHAR,R1 ;CHARACTERS TO MOVE MOV INADDR,R0 ;ADDRESS OF START ; 40$: MOVB (R5)+,(R2)+ ;SHIFT A BYTE SOB R1,40$ ;AND SO ON MOV R2,R5 ;RESET ADDRESS MOVB #' ,R2 ;RESET FILL CHARACTER CLR R0 ;SET SUCCESFUL RETURN ; ; NOW FILL AS NECESSARY WITH BLANKS, ASTERISKS OR ZEROES ; BINFIL: TST R3 ;ANYTHING TO FILL BEQ BINEND ;NO - TERMINATE MOVB R2,(R5)+ ;FILL A BYTE SOB R3,BINFIL ;AND SO ON ; BINEND: RETURN ;RETURN .END