CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug017.ark / PROCCALC.ASM < prev next >

Wrap

Assembly Source File | 1984-04-29 | 24.3 KB | 1,619 lines

; THIS IS A FOUR FUNCTION FLOATING POINT MATH PACKAGE ; ; EACH FUNCTION MAY BE EXPRESSED AS <BC> = <DE> # <HL> WHERE ; ; <BC> = ADDRESS OF RESULT ; <DE> = ADDRESS OF FIRST ARGUMENT ; <HL> = ADDRESS OF SECOND ARGUMENT ; ; AND # IS ONE OF THE FUNCTIONS +, -, *, / ; ; ON ENTRY TO EACH FUNCTION, BC,DE, & HL SHOULD BE SET AS INDICATED ; ABOVE. ALL ADDRESSES ON ENTRY POINT TO THE EXPONENT PART OF THE ; FLOATING POINT NUMBER. EACH FLOATING POINT NUMBER CONSISTS OF 12 PACKED ; DECIMAL DIGITS, A SIGN, AND A BIASED BINARY EXPONENT ; ; THE EXPONENT RANGE IS -127 TO +127 ; ; THE NUMBER ZERO IS REPRESENTED BY ALL DIGITS ZERO AND THE EXPONENT ZERO ; ; THE NUMBERS ARE STORED IN MEMORY STARTING AT THE LOW ORDER ADDRESS AS ; 6 BYTES OF DECIMAL DIGITS FOLLOWED BY THE SIGN FOLLOWED BY THE EXPONENT ; ; THE NUMBERS ARE ASSUMED TO BE NORMALIZED. THAT IS, EACH NUMBER ; CAN BE REPRESENTED AS F**E WHERE .1 <= F <1.0 AND E IS THE EXPONENT ; ; PROCT EQU 0 INTEL EQU 1 CI EQU 3803H CO EQU 3809H CSTS EQU 3812H ; ; DIGIT EQU 15 ASCR EQU 0DH MAXI EQU 72 ;MAXIMUM INPUT LINE LENGTH STAT EQU 0 DATA EQU 1 DAV EQU 40H TBE EQU 80H ; ORG 100H ; CALC: LXI H,0 ;ENTRY POINT FOR THE CALCULATOR DAD SP SHLD USRST ;SAVE USER'S STACK POINTER CALC2: LXI SP,STACK INIT: LXI H,INFES MVI M,18H ;INITIALIZE FORMAT (FD12) INX H MVI M,60 ;INITIALIZE TERMINAL WIDTH TO 60 ; LXI H,INMES ;PRINT HEADER JMP OMESS INMES: DB 'PROCESSOR TECHNOLOGY CORP.' DW 0A0DH DW 77577Q DB 'FLOATING POINT CALCULATOR' DB 0 CALL CRLF ; ; THIS ROUTINE CLEARS ALL RAM STORAGE SPACE AND ; PRINTS "CLEAR" MESSAGE ; FRESH: LXI H,OPST MVI C,MAXCL CALL CLEAR LXI H,CLMES CALL OMESS JMP READ ; ; ALL ERRORS COME HERE FOR MESSAGE PRINTOUT ; ERCHK: CALL MSG JMP READ MSG: LXI H,OMESS PUSH H ;OMESS ADDR JP OVER LXI H,UNMES RET OVER: RAR JNC DIVZM LXI H,OVMES RET DIVZM: LXI H,DZMES RET ERROR: LXI H,ERMES CALL OMESS JMP READ ; ; THIS ROUTINE WILL OUTPUT AN ASCII MESSAGE..H&L ; POINT TO THE BEGINNING AND THE ROUTINE TERMINATES ; WHEN IT FINDS A BINARY ZERO. THE PROGRAM COUNTER IS ; SET ONE BYTE PAST THE ZERO. ; OMESS: CALL CRLF MOV B,M CALL OUTB INX H ORA A JNZ OMESS+3 PCHL ; ; ERROR MESSAGES USED BY OMESS ; ERMES: DB 'THAT DOES NOT COMPUTE' DB 0 RET DZMES: DB 'D/ZERO' DB 0 RET UNMES: DB 'UNDERFLOW' DB 0 RET OVMES: DB 'OVERFLOW' DB 0 RET CLMES: DB 'CLEAR' DB 0 RET ; ; THIS ROUTINE READS DATA INTO AN INPUT BUFFER (IBUF) ; THE INPUT IS TERMINATED BY A CARRIAGE RETURN ; READ: LXI SP,STACK LXI H,IBUF-1 SHLD ADDS INX H CALL CRLF MVI E,MAXI ; READ2: CALL INB CPI 18H ;CHECK FOR CONTROL X JNZ DEL MVI B,'\' CALL OUTB JMP READ ; DEL: CPI 7FH ;CHECK FOR RUBOUT JNZ CHR MVI A,MAXI CMP E JZ READ DCX H DEL2: MVI B,'_' CALL OUTB INR E JMP READ2 ; CHR: XRA A ORA E JZ DEL2 MOV M,B ;STORE CHARACTER INX H DCR E MVI A,ASCR CMP B ;CHECK FOR CARRIAGE RETURN JZ SCAN CALL OUTB ;ECHO CHAR JMP READ2 ;GET MORE ; ; THIS ROUTINE GETS CHARACTERS FROM THE INPUT BUFFER ; AND SCANS PAST BLANKS ; IBSCN: LHLD ADDS INX H MOV A,M CPI ' ' JZ IBSCN+3 SHLD ADDS ; ; THIS ROUTINE CHECKS FOR ASCII NUMBERS (0-9) ; NMCHK: CPI '9'+1 RNC CPI '0' CMC RET ; ; THIS ROUTINE SCANS THE INPUT LINE, BRANCHES TO ; NECESSARY SUBROUTINES, AND CONVERTS ASCII NUMBERS ; TO BINARY AND BCD PACKS THEM INTO REGISTER 'BC' ; OF THE SOFTWARE PUSH-DOWN STACK FOR LATER USE ; SCAN: CALL CRLF LXI H,TEMP ;CLEAR TEMPORARY STORAGE AREAS MVI C,7 CALL CLEAR STA ERRI ;CLEAR ERROR FLAG BYTE ; SCANC: LXI D,0 LXI H,BC SCAN0: SHLD BCADD SCANP: LXI H,SCANP PUSH H XRA A STA XSIGN LDA TEMP ORA A ;ANY TEMPORARY CHARS? JZ SCANG CALL NMCHK ;CHECK IF NUMBER JMP SCANG+3 ; SCANG: CALL IBSCN JC SCANX CPI '.' ;RADIX? JZ SCAN5 CPI 'E' ;EXPONENT? JZ EXCON LXI H,OPST STA TEMP MOV C,A MVI A,10H ;ANY NUMBERS IN BC YET? ANA M JNZ ENTR2 ;YES-PUSH SOFTWARE STACK STA TEMP MVI B,80H MOV A,C CPI 'S' ;SUBTOTAL? JNZ PCHK MOV A,B ; PUT: ORA M MOV M,A RET PCHK: CPI 'P' ;PRINT? JNZ SCNQ MOV A,B RLC JMP PUT SCNQ: CPI 'Q' ;SQUARE ROOT? JNZ SCN MVI A,1 STA SQR RET SCN: CPI '##' ;FLAG FOR LEADING UNARY SIGN JZ SCAN3-4 CALL CHKOP JNZ SCAN3 MOV B,A LDA OPSTR ORA A JZ SCAN2 ;IT'S AN OPERATOR MOV A,C CPI 2 JNC SCAN2 SQN: STA SIGN ;IT'S A SIGN RET ; SCAN2: LDA SQR ORA A JNZ SQN MOV A,B STA OPSTR RET ; SCAN3: CALL FINDR ;CHECK IF REGISTER (A,B,C,D) JM DLMT ;NO GO-CHECK FOR DELIMITERS PUSH H CALL IBSCN CPI '=' ;FIND REG AND SET DESTINATION JZ SCAN4 DCX H ;MOVE DATA IN REG (N) TO BC SHLD ADDS LXI D,HL-1 POP H MVI C,DIGIT+2 CALL UP JMP ENT1 ;SKIP FILE AND MOVE REG TO STACK ; SCAN4: MVI A,3 DCR A CMP C JNZ SCAN4+2 LXI H,OPST INR A RLC ;A=8,B=6,C=4,D=2 ORA M MOV M,A POP H SHLD DEST RET ; SCAN5: XRA A ;FOUND RADIX ORA D ;ANY DIGITS YET? JNZ SCAN6 ADI 0C0H ;SET ECNT - & STOP COUNTING DIGITS ORA E MOV E,A RET SCAN6: MVI A,80H ;SET ECNT TO COUNT DIGITS ORA E MOV E,A RET ; SCANX: ANI 0FH ;FOUND NUMBER-REMOVE ASCII BIAS MOV B,A LXI H,OPST ;SET FIRST CHARACTER FLAG MVI A,30H ORA M MOV M,A XRA A ORA B ;IS CHARACTER ZERO JNZ PACK ORA D ;LEADING ZERO? JNZ PACK ORA E MOV E,A RZ INR E ;ECNT+1 RET ; ; THIS SUBROUTINE BCD PACKS DIGITS INTO REG BC ; PACK: MOV A,E RAL JC $+4 INR E MOV A,E STA ECNT INR D MOV A,D ANI 7FH ;REMOVE TOP/BOTTOM FLAG CPI DIGIT*2 ;LIMIT INPUT DIGITS RNC XRA A ORA D JM BOTM ; TOP: ORI 80H ;SET MSB FOR TOP FLAG MOV D,A MOV A,B LHLD BCADD ;GET BC ADDRESS RLC RLC RLC RLC MOV M,A ;SAVE CHR IN BC RET ; BOTM: ANI 7FH ;STRIP MSB (BOTTOM FLAG) MOV D,A MOV A,B LHLD BCADD ORA M ;OR IN TOP NUMBER MOV M,A ;PUT NUMBER BACK IN BC INX H POP B JMP SCAN0 ; ; THIS ROUTINE CHECKS FOR STATEMENT DELIMITERS ; ( : \ , \ ; \ <CR> ) ; DLMT: LXI H,TEMP MOV M,A INX H ;TO OPST MOV A,M MOV B,A PUSH PSW ANI 0EH ;ANY REGISTER NAMES TO PRINT? JZ DL2 MOV L,A MOV A,B ANI 100Q JZ DL1 MVI A,12Q MVI B,'A'-1 ALPH: INR B ;FIND REGISTER NAME DCR A DCR A CMP L JNZ ALPH DOUT: CALL OUTB ;PRINT NAME MVI B,'=' CALL OUTB ; DL1: LHLD DEST XCHG LXI H,DE-1 ;MOVE SOFTWARE STACK REG HL TO MEMORY REG MVI C,DIGIT+2 ;(A,B,C,D) CALL UP ; DL2: POP B ;PRINT RESULTS IF ANY MVI A,40H ANA B JZ DL3 XRA B STA OPST CALL OUTPUT CALL SPACE ; DL3: LXI H,OPSTR MOV A,M ORA A JNZ ENTR5 ;CONTINUE IF MORE DATA ; DCX H ;CHECK FOR DELIMITERS DCX H MOV A,M ;GET DATA FROM TEMPORARY MVI M,DIGIT-DIGIT CPI ASCR ;CARRIAGE RETURN? JZ READ ;NEXT LINE IN CPI ':' ;COLON? JNZ DL4 POP H JMP SCAN DL4: CPI ',' ;COMMA? JNZ DL5 MVI C,5 ;PRINT FIVE SPACES DL40: CALL SPACE DCR C JNZ DL40 POP H JMP SCAN+3 DL5: MVI C,1 ;PRINT ONE SPACE CPI ';' ;SEMICOLON? JZ DL40 ; ; THIS ROUTINE CHECKS FOR COMMAND CHARACTERS ; AND JUMPS TO THE APPROPRIATE ROUTINES ; IF CHR IS NOT FOUND HERE, IT IS ILLEGAL ; CMD: CPI 'X' JZ EXIT CPI 'R' JZ FRESH CPI 'F' JZ FIXS CPI 'K' JZ POPST CPI 'Q' JZ ROOT CPI 'W' JZ WIDE JMP ERROR DS 40 ;LEAVE ROOM FOR MORE COMMANDS!!! ; ; THIS ROUTINE SETS THE TERMINAL WIDTH ; WIDE: CALL IBSCN RNC CALL ASCDC MOV A,E CPI 4 ;MINIMUM WIDTH JC ERROR STA WIDTH RET ; ; THIS ROUTINE IS USED TO ADJUST A NUMBER IN BC ; FOR INPUT TO THE SOFTWARE STACK. IT THEN CALLS ; ROUTINES TO PUSH THE NUMBER ON THE STACK, AND CHECKS ; IF IMMEDIATE PRINTING OF A NUMBER IS WANTED ; ENTR2: LXI D,0 CALL FIXE ;NORMALIZE FLOATING POINT NUMBER ENT1: LXI H,SCANC XTHL ;CHANGE RETURN ADDRESS ON STACK LDA SIGN ;SET UNARY SIGN OF NUMBER ORA A JZ ENT2 XRA A STA SIGN LDA BC+DIGIT CMA STA BC+DIGIT ENT2: CALL ENTR ;PUSH SOFTWARE STACK ENTR3: LXI H,OPST ;CHECK FOR IMMEDIATE 'PRINT' (P) MVI A,1 ANA M JZ ENTR4 PUSH H CALL OUTPUT CALL SPACE POP H ENTR4: LDA SQR ORA A JNZ ROOT QRET: XRA A STA SQR MVI A,356Q ;CLEAR PRINT AND 'OPERATION-OCCURRED' FLAGS ANA M MOV M,A INX H MOV A,M ORA A RZ ;TO SCANC CPI '##' ;CHECK IF LEADING UNARY JNZ ENTR5 MVI M,DIGIT-DIGIT RET ;TO SCANC ENTR5: CALL CHKOP ;CHECK FOR LEGAL OPERATOR JNZ ERROR ; ; THIS ROUTINE SETS UP ALL REGISTERS AND CALLS ; THE FLOATING POINT ROUTINES ; FPC: MVI A,-1 ;FIND TYPE OF OPERATION LXI H,FPCAL-2 FPC2: INX H INX H INR A CMP C JNZ FPC2 MOV E,M ;MOVE FLOATING POINT ROUTINE ADDR INTO D&E INX H MOV D,M FPC3: LXI B,FPR PUSH B ;SET UP RETURN FOR FLOATING POINT ROUTINES PUSH D ;SET UP FLOATING POINT ADDRESS LXI B,BC+DIGIT+1 ;SET REGISTERS LXI H,HL+DIGIT+1 LXI D,DE+DIGIT+1 RET ;GO TO FLOATING POINT! ; ; FLOATING POINT ROUTINE ADDRESSES ; FPCAL: DW FADD DW FSUB DW FMULT DW FDIV ; ; THE FLOATING POINT ROUTINES RETURN HERE ; FPR: LDA ERRI ;CHECK FOR OVER-UNDER-D/ZERO ERRORS ORA A JNZ ERCHK ;PRINT MESSAGE IF ERROR ; CALL POP ;FIX SOFTWARE STACK LXI H,BC LXI D,HL LXI B,DIGIT+2 CALL DOWN ; XRA A ;CHECK HERE IF SUBTOTAL PRINTOUT IS WANTED STA OPSTR LXI H,OPST MVI A,100Q ORA M MOV M,A RAL RNC ;NO-RETURN TO SCANC ANI 7FH STC RAR MOV M,A CALL OUTPUT CALL SPACE RET ;SCANC ; ; THIS IS THE EXIT ROUTINE. IT IS SET NOW TO RETURN ; TO THE BEGINNING OF THIS FLOATING POINT CALCULATOR ; PACKAGE. IT MAY BE SET TO JUMP OR RETURN TO OTHER ; ROUTINES OR PROGRAMS. IT WILL RESET THE STACK ; WITH THE VALUE IT HAD WHEN THE FLOATING POINT ; CALCULATOR WAS ENTERED. ; EXIT: LHLD USRST ;GET USER STACK ADDRESS SPHL ;RESET USER'S STACK JMP CALC ;ENTER A RETURN OR JUMP HERE IF NEEDED ; ; THIS ROUTINE IS USED TO CALCULATE THE SQUARE ROOT ; THE FORMULA IS B=(A/B+2)/2 WHERE A IS THE NUMBER TO BE ; ROOTED, AND B IS THE ESTIMATED SQUARE ROOT. ; ROOT: INX H ;SAVE OPERATION IF ANY MOV A,M STA ECNT LXI D,BC+DIGIT+1 LXI H,HL+DIGIT XRA A ORA M JNZ ERROR ;ERROR IF NEGATIVE ARG INX H ORA M JZ QRET ;Q=0 - MOVE ON SUI 128 ;SUBTRACT EXPONENT BIAS JNC ROOT2 CMA INR A ;MAKE NEGATIVE EXPONENT POSITIVE ; ROOT2: STC RAR STAX D ;PUT ESTIMATE EXPONENT IN BC MVI A,80H ANA M ;CHECK IF NEGATIVE EXPONENT JNZ RTPOS LDAX D ;SWITCH IF NEGATIVE CMA INR A STAX D ;NEGATIVE EXPONENT ESTIMATE TO BC ; RTPOS: DCX H DCX D MVI C,DIGIT+1 CALL UP ;MOVE ESTIMATE TO BC LXI H,DE ;MOVE DATA IN SOFTWARE STACK TO TEMPORARY LXI D,REGE LXI B,DIGIT+2 CALL DOWN CALL ENTR ;PUSH SOFTWARE STACK MVI A,(DIGIT/3)*4 ;ITERATION COUNT ; ROOT3: PUSH PSW CALL SETST LXI D,FDIV ;DIVIDE A/B CALL FPC3 LXI D,FADD CALL FPC3 ;ADD (A/B)+B MVI A,20H STA BC MVI A,81H STA BC+DIGIT+1 ;MOVE IN A '2' FOR DIVIDE CALL ENTR LXI D,FDIV ;DIVIDE (A/B+B)/2 CALL FPC3 POP PSW DCR A JNZ ROOT3 ;DO IT 8 TIMES LXI H,REGE LXI D,DE ;MOVE DATA FROM THE TEMPORARY TO DE IN STACK LXI B,DIGIT+2 CALL DOWN LDA ECNT ;GET PREVIOUS OPERATORS IF ANY LXI H,OPSTR MOV M,A XRA A STA ECNT DCX H JMP QRET ;DONE-BACK TO NORMAL ; SETST: LXI H,DE+DIGIT+1 ;SET UP SOFTWARE STACK FOR SQR ROOT LXI D,S4+DIGIT+1 MVI C,(DIGIT+2)*2 JMP UP ; ; THIS ROUTINE IS USED TO SET REGISTER ADDRESSES ; FOR MEMORY REGISTERS A,B,C,D ; FINDR: LXI H,REGB-1 PUSH D LXI D,DIGIT+2 LXI B,4103H FIND2: CMP B JZ FEND DCR C JM FEND DAD D ;GO TO NEXT REG INR B JMP FIND2 FEND: POP D RET ; ; THESE ROUTINES ARE USED TO MANIPULATE THE ; SOFTWARE STACK ; ; POP STACK ; POPST: LXI H,HL LXI D,BC MVI C,DIGIT*5+2 CALL DOWN LXI B,DIGIT+2 LXI H,BC LXI D,S4 CALL DOWN JMP ENTR3 ; ; RESET STACK AFTER OPERATION ; POP: LXI H,S3 LXI D,DE LXI B,DIGIT*2+4 CALL DOWN RET ; ; MOVE DATA FROM ADDRESS POINTED TO BY HL ; TO ADDRESS POINTED TO BY DE ; DOWN: MOV A,M STAX D MOV M,B ;PULL A ZERO INX H INX D DCR C JNZ DOWN RET ; ; ENTER (PUSH) DATA ONTO STACK ; ENTR: LXI H,S3+DIGIT+1 LXI D,S4+DIGIT+1 MVI C,DIGIT*5+3 CALL UP LXI H,BC MVI C,DIGIT+2 CALL CLEAR ;CLEAR BC RET ; ; MOVE DATA ; UP: MOV A,M STAX D DCX D DCX H DCR C JNZ UP RET ; ; THIS ROUTINE IS USED TO SET THE OUTPUT FORMAT ; FIXS: CALL FIXS2 ;GET FORMAT SYMBOL JNZ ERROR ;NO FORMAT? CALL IBSCN JC FIXS3 CPI '$' ;PRINT TRAILING ZEROS? JNZ FIXS3 MVI A,200Q ORA C MOV C,A CALL IBSCN FIXS3: PUSH B ;SAVE OLD DECIMAL PLACE COUNT JC FIXS4 LDA INFES RRC ANI 0FH JMP FIXS5 FIXS4: CALL ASCDC ;CONVERT DECIMAL PLACE COUNT MOV A,E FIXS5: CPI DIGIT*2+1 JC FIXS6 MVI A,DIGIT*2 FIXS6: RLC POP B ORA C STA INFES ;STORE NEW FORMAT XRA A STA TEMP ;CLEAR TEMPORARY STORAGE REGISTERS RET ;TO SCANC ; FIXS2: CALL IBSCN ;GET FORMAT SYMBOL MVI C,0 CPI 'D' ;DECIMAL PLACES RZ INR C CPI 'E' ;EXPONENTIAL RZ MVI C,40H CPI 'F' ;FLOAT-MANDATORY DECIMAL PLACE RET ; ; THIS ROUTINE CHECKS OR OPERATORS (+,-,*,/) ; CHKOP: MVI C,0 CPI '+' RZ INR C CPI '-' RZ INR C CPI '*' RZ INR C CPI '/' RET ; ; THIS ROUTINE IS USED TO CLEAR STORAGE AREAS ; THE STARTING ADDRESS IS IN H&L AND THE COUNT ; IS IN REG C ; CLEAR: XRA A MOV M,A INX H DCR C JNZ CLEAR+1 RET ; ; THIS ROUTINE CONVERTS THE ASCII EXPONENT O ; THE NUMBER IN THE INPUT BUFFER TO BINARY, AND ; NORMALIZES EXPONENT ACCORDING TO THE INPUT ; FORMAT OF THE NUMBER ; EXCON: CALL IBSCN ;GET CHAR JC EXC3 CPI '+' ;CHECK FOR UNARY OPERATOR JZ EXC2+3 ;*************************????????? CPI '-' JNZ ERROR ;NO SIGN OR NUMBER? MVI A,1 EXC2: STA XSIGN ;SAVE SIGN CALL IBSCN JNC ERROR ;NO NUMBER? EXC3: CALL ASCDC ;CONVERT ASCII TO BINARY CALL FIXE ;NORMALIZE EXPONENT JMP ENT1 ;GO ENTER NUMBER NOW ; ; THIS ROUTINE CONVERTS ASCII TO BINARY ; THREE CONSECUTIVE NUMBERS < 128 MAY BE CONVERTED ; ASCDC: XCHG LXI H,0 ASC1: LDAX D CALL NMCHK ;CHECK NUMERIC JNC ASC2 SUI '0' ;REMOVE ASCII BIAS MOV B,H MOV C,L DAD H DAD H DAD B DAD H MOV C,A MVI B,0 DAD B INX D JMP ASC1 ASC2: XCHG DCX H SHLD ADDS ;SAVE IBUF ADDRESS MOV A,D ORA A JNZ ERROR ;TOO BIG >255 MOV A,E RAL JC ERROR ;TOO BIG >127 RAR RET ; ; THIS ROUTINE NORMALIZES THE INPUT NUMBER ; FIXE: XCHG LDA BC ORA A ;IS IT ZERO? JZ ZZ2 CALL CHKPN ADI 80H ;ADD EXPONENT BIAS ZZ2: STA BC+DIGIT+1 RET ; CHKPN: LDA ECNT ;GET DIGIT COUNT MOV E,A ANI 3FH ;STRIP BITS 7&8 MOV B,A LDA XSIGN ORA A JZ LPOS ;EXPONENT IS POSITIVE INR H ;SET SIGN IN H MVI A,40H ;L IS NEGATIVE ANA E ;CHECK IF E IS NEGATIVE JZ EPOS MOV A,L ;BOTH E&L NEGATIVE MOV L,B CALL EPOS+1 CMA INR A RET ;BACK TO FIXE ; EPOS: MOV A,L ;E&L NEGATIVE CMA INR A ADD B RET ;TO FIXE ; LPOS: MVI A,40H ;EXPONENT POSITIVE ANA E ;IS E NEGATIVE? JZ BPOS MOV A,B MOV B,L JMP EPOS+1 ; BPOS: MOV A,B ;E&L POSITIVE ADD L JM ERSET RET ; ERSET: XRA A ;EXPONENT ERROR ORA H ;GET EXPONENT SIGN JZ ERSE2 ;UNDERFLOW CMA ERSE2: INR A ;OVERFLOW STA ERRI ;STORE ERROR NUMBER JMP ERCHK ;GO OUTPUT ERROR MESSAGE ; ; ; THIS ROUTINE TAKES THE BCD NUMBER IN HL AND ; CONVERTS IT FOR OUTPUT ACCORDING TO THE OUTPUT ; FORMAT ; OUTPUT: LXI H,ABUF LDA INFES ;GET OUTPUT FORMAT STA FES ;STORE IT IN WORKING BUFFER LXI B,HL MVI E,DIGIT MVI M,0 ;CLEAR ROUND-OFF OVERFLOW BUFFER INX H ; NEXT: LDAX B ;GET DIGIT AND UNPACK MOV D,A RAR RAR RAR RAR ANI 0FH ;REMOVE BOTTOM DIGIT MOV M,A ;STORE TOP DIGIT IN OUTPUT BUFFER(ABUF) INX H MOV A,D ;NOW GET BOTTOM DIGIT ANI 0FH MOV M,A ;STORE IT INX H INX B DCR E JNZ NEXT XRA A MOV M,A INX H MOV M,A ; FIX: INX B LDAX B ORA A ;EXPONENT ZERO? JZ ZRO SBI 128 ;REMOVE NORMALIZING BIAS JNZ FIX2 INR M FIX2: JP CHK13 CMA ;IT'S A NEGATIVE EXPONENT INR M ZRO: INR A CHK13: INX H ;CHECK IF EXPONENT > 12 MOV M,A MOV E,A CPI DIGIT*2 INX H JC CHKX0 CHK40: MVI A,1 ;FORCE EXPONENTIAL PRINTOUT ORA M MOV M,A ; CHKX0: MOV A,M ;CHECK IF EXPONENTIAL PRINTOUT RAR JNC CHKX3 ANI 1FH CPI DIGIT*2 JC CHKX2 MVI A,DIGIT*2-1 CHKX2: MOV D,A INR A JMP ROUND ; CHKX3: ANI 1FH ;ADD EXPONENT AND DECIMAL PLACES MOV D,A ADD E CPI DIGIT*2+1 MOV B,A JC CHKXN MOV A,M CPI 100Q JNZ CHK40 ; CHKXN: LDA XSIGN ;CHECK EXPONENT SIGN ORA A JNZ XNEG ;IT'S NEGATIVE MOV A,B JMP ROUND ; XNEG: MOV A,D ;SUBTRACT EXPONENT AND DECIMAL PLACE COUNT SUB E JNC XN2 XN1: LDA INFES ORA A JP ZERO ANI 0EH JZ ZERO RRC MOV E,A DCR E MVI C,1 LXI H,ABUF-1 JMP NRND XN2: JZ XN1 JMP ROUND ; CLEAN: MVI B,1FH ;CLEAR FLAGS ANA B CPI DIGIT*2+1 RC MVI A,DIGIT*2+1 RET ; ; THIS ROUTINE IS USED TO ROUND DATA TO THE ; SPECIFIED PRECISION ; ROUND: CALL CLEAN MOV C,A MVI B,0 LXI H,ABUF+1 DAD B ;GET ROUND ADDRESS SHLD ADD MOV A,M CPI 5 ;ROUND IF >= 5 JC TRL2-1 ; LESS1: DCX H INR M ;ROUND UP MOV A,M ORA A JZ TRL2 CPI 10 ;CHECK IF ROUNDED NUMBER >9 JNZ TRAIL MVI M,0 JMP LESS1 ; ; THIS ROUTINE IS USED TO ELIMINATE TRAILING ZEROS ; TRAIL: LHLD ADD DCX H TRL2: LDA FES ;CHECK IF TRAILING ZEROS ARE WANTED RAL JC PRINT ;YES-GO PRINT DATA ; TRL3: MOV A,M ORA A ;IS IT A ZERO? JNZ PRINT ;NO - GO PRINT DCX H DCR C ;YES-FIX OUTPUT DIGIT COUNT JM ZERO JMP TRL3 ; ; HERE START THE PRINT FORMAT ROUTINES ; PRINT: LXI H,ABUF MOV A,M ;CHECK IF ROUNDED UP TO 1 ORA A JZ NRND ;JUMP IF NOT MVI B,1 LDA XSIGN ;IS EXPONENT NEGATIVE ORA A JZ POSR MVI B,-1 ; POSR: LDA EXPO ;GET EXPONENT ORA A JNZ PO2 ;IS IT ZERO? (E+0) STA XSIGN MVI B,1 PO2: ADD B ;FIX EXPONENT COUNT STA EXPO INR E INR C DCX H ; NRND: INX H MOV A,C CPI DIGIT*2+1 ;CHECK FOR MAXIMUM DIGITS OUT JNZ $+4 DCR C LDA HL+DIGIT RAR JNC PRIN2 CALL NEG JMP PRIN2+3 ; PRIN2: CALL SPACE LDA FES ;GET OUTPUT FORMAT RAR JC XPRIN LDA XSIGN ;GET EXPONENT SIGN ORA A JZ POSIT ; PRIN3: MOV A,C ;CHECK IF FRACTIONAL NUMBER ORA A RZ RM ; PRIN4: CALL RADIX ;PRINT DECIMAL POINT XRA A ORA E JZ PRIN5 ;JUMP IF NO ZEROS TO PRINT CALL ZERO ;FORCE PRINT A ZERO DCR E JNZ PRIN4+3 ; PRIN5: CALL NOUT ;PRINT ASCII DIGIT JNZ PRIN5 RET ; POSIT: CALL NOUT DCR E ;BUMP EXPONENT COUNT JNZ POSIT JMP PRIN3 ;NOW PRINT DECIMAL POINT ; ; GET HERE FOR EXPONENTIAL OUTPUT FORMAT ; XPRIN: CALL NOUT JZ NDEC ;INTEGER? CALL RADIX ;NO...PRINT DECIMAL POINT ; XPRI2: CALL NOUT JNZ XPRI2 ; NDEC: CALL SPACE MVI B,'E' CALL OUTB LDA XSIGN ORA A JZ XPRI3 CALL NEG ;PRINT EXPONENT SIGN (-) LDA EXPO INR A JMP XOUT2 XPRI3: MVI B,'+' ;EXPONENT (+) CALL OUTB ; ; THIS ROUTINE IS USED TO CONVERT THE EXPONENT ; FROM BINARY TO ASCII AND PRINT THE RESULT ; XOUT: LDA EXPO DCR A XOUT2: MVI C,100 MVI D,0 CALL CONV CPI '0' ;SKIP LEADING ZEROS JZ $+7 INR D CALL OUTB MOV A,E MVI C,10 CALL CONV CPI '0' JNZ $+7 DCR D JNZ $+6 CALL OUTB MOV A,E ADI '0' ;ADD ASCII BIAS MOV B,A CALL OUTB RET ; CONV: MVI B,'0'-1 INR B SUB C JNC CONV+2 ADD C MOV E,A MOV A,B RET ; ; THIS ROUTINE ADDS ASCII BIAS TO A BCD DIGIT ; AND CALLS THE OUTPUT ROUTINE ; NOUT: MOV A,M ADI '0' MOV B,A CALL OUTB INX H DCR C RET ; ; COMMON SYMBOL LOADING ROUTINES ; NEG: MVI B,'-' JMP OUTB ZERO: MVI B,'0' JMP OUTB SPACE: MVI B,' ' JMP OUTB RADIX: MVI B,'.' JMP OUTB ; ; OUTPUT DRIVER ; OUTB: PUSH B IF PROCT IN STAT ;STATUS PORT ANI TBE+DAV ;CHECK FOR "ESCAPE" JP OUTB+1 ANI DAV JZ OUTB2 IN DATA ANI 7FH CPI 1BH ; ESCAPE JZ READ ;STOP OUTPUT OUTB2: MOV A,B CALL 9060H ENDIF IF INTEL CALL CSTS ORA A JZ OUTB2 CALL CI ANI 7FH CPI 1BH JZ READ OUTB2: MOV C,B CALL CO ENDIF ; CPI 0DH ;CHECK IF CARRIAGE RETURN FOR TERM WIDTH JZ OUTR LDA WIDTH MOV C,A LDA WIDEC INR A ;UPDATE CHAR COUNT CMP C JNZ OUTR+1 CALL CRLF ;NEW LINE OUTR: XRA A STA WIDEC POP B MOV A,B RET ; ; OUTPUT A CARRIAGE RETURN, LINE FEED ; FOLLOWED BY TWO DELETES ; CRLF: MVI B,0DH CALL OUTB MVI B,0AH CALL OUTB MVI B,7FH CALL OUTB JMP OUTB ; ; INPUT DATA ROUTINE ; INB: IF PROCT IN STAT ANI DAV JZ INB IN DATA ENDIF IF INTEL CALL CI ENDIF ANI 7FH MOV B,A RET ; ; GLOBAL PARAMETERS ; INFES: DS 1 WIDTH: DS 1 USRST: DS 2 ADDS: DS 2 ADD: DS 2 BCADD: DS 2 ; WIDEC: DS 1 TEMP: DS 1 OPST: DS 1 OPSTR: DS 1 ECNT: DS 1 SIGN: DS 1 DEST: DS 2 IBUF: DS 73 ABUF: DS DIGIT*2+2 XSIGN: DS 1 EXPO: DS 1 FES: DS 1 SQR: DS 1 REGA: DS DIGIT+2 REGB: DS DIGIT+2 REGC: DS DIGIT+2 REGD: DS DIGIT+2 REGE: DS DIGIT+2 BC: DS DIGIT+2 HL: DS DIGIT+2 DE: DS DIGIT+2 S3: DS DIGIT+2 S4: DS DIGIT+2 MAXCL EQU $-OPST ; DS (DIGIT+2)*10 DS 50 STACK: DW 0 ; FADD: PUSH B CALL L0F77 MVI C,000H L0DB8: DCX D XCHG LDA L0FFE XRA M MOV B,A XCHG LDAX D DCX D XRA C STA L0FFE MOV A,B ANI 001H JNZ L0E05 CALL L0DE3 JNC L0DDE MVI B,004H CALL L0FBE LXI H,EXP INR M JZ L0FE4 L0DDE: POP B CALL L0FB0 RET L0DE3: LXI H,BUF+DIGIT-1 MVI B,DIGIT ORA A L0DE9: LDAX D ADC M DAA MOV M,A DCX H DCX D DCR B JNZ L0DE9 RNC INR M RET FSUB: PUSH B CALL L0F77 LDA L0FFE XRI 001H STA L0FFE JMP L0DB8 L0E05: CALL L0E51 LXI H,L0FFE JNC L0E15 MOV A,M XRI 001H MOV M,A JMP L0E25 L0E15: DCX H MVI B,DIGIT L0E18: MVI A,09AH SBB M ADI 000H DAA MOV M,A DCX H DCR B CMC JNZ L0E18 L0E25: LXI H,BUF XRA A MVI C,DIGIT L0E2B: CMP M JNZ L0E3A INX H DCR C JNZ L0E2B STA EXP JMP L0DDE L0E3A: LDA BUF ANI 0F0H JNZ L0DDE LXI H,EXP DCR M JZ L0FEC MVI B,004H CALL L0FD1 JMP L0E3A L0E51: LXI H,BUF+DIGIT-1 MVI B,DIGIT STC L0E57: MVI A,099H ACI 000H XCHG SUB M XCHG ADD M DAA MOV M,A DCX H DCX D DCR B JNZ L0E57 RET FMULT: PUSH B MOV A,M ORA A JZ L0E82 LDAX D ORA A JZ L0E82 ADD M JC L0E7D JP L0FEC JMP L0E80 L0E7D: JM L0FE4 L0E80: SUI 080H L0E82: STA EXP DCX D DCX H LDAX D XRA M STA L0FFE DCX H DCX D MOV C,L MOV B,H MVI A,DIGIT+1 LXI H,L0FF7 L0E95: MVI M,0 INX H DCR A JNZ L0E95 LXI H,DIGIT+DIGIT L0E9F: LDAX B L0EA0: PUSH H ANI 0FH PUSH B MOV C,A JZ L0EB5 L0EA8: CALL L0DE3 XCHG LXI D,DIGIT DAD D XCHG DCR C JNZ L0EA8 L0EB5: MVI B,4 CALL L0FBE POP B POP H DCR L JZ L0ECF DCR H JP L0E9F INR H INR H LDAX B RAR RAR RAR RAR DCX B JMP L0EA0 L0ECF: LDA BUF ANI 0F0H JNZ L0DDE MVI B,004H LXI H,EXP DCR M JZ L0FEC CALL L0FD1 JMP L0DDE FDIV: PUSH B MOV A,M ORA A JZ L0FF1 LDAX D ORA A JZ L0FE9 SUB M JC L0EFB JM L0FE4 JMP L0EFE L0EFB: JP L0FEC L0EFE: ADI 081H STA EXP XCHG CALL L0F9B POP B XCHG LDA L0FFE DCX H XRA M STA L0FFE XCHG DCX D LXI H,-DIGIT-1 DAD B MOV B,H MOV C,L L0F19: MVI L,DIGIT+DIGIT L0F1B: PUSH B PUSH H MVI C,0 L0F1F: CALL L0E51 MOV A,M CMC SBI 0 MOV M,A RAR LXI H,DIGIT DAD D XCHG INR C RAL JNC L0F1F CALL L0DE3 LXI H,DIGIT DAD D XCHG PUSH B MVI B,4 CALL L0FD1 POP B DCR C POP H MOV H,C POP B MOV A,L JNZ L0F58 CPI DIGIT+DIGIT JNZ L0F58 LXI H,EXP DCR M CZ L0FEC JMP L0F19 L0F58: RAR MOV A,H JNC L0F68 LDAX B RLC RLC RLC RLC ADD H STAX B INX B JMP L0F69 L0F68: STAX B L0F69: DCR L JNZ L0F1B LDA L0FFE STAX B LDA EXP INX B STAX B RET L0F77: LDAX D SUB M MVI C,000H JNC L0F82 INR C XCHG CMA INR A L0F82: MOV B,A LDAX D STA EXP MOV A,B CPI DIGIT+DIGIT JC L0F8F MVI A,DIGIT+DIGIT L0F8F: RLC RLC MOV B,A PUSH B CALL L0F9B CALL L0FBE POP B RET L0F9B: PUSH D LXI D,L0FFE MVI C,DIGIT+1 DCX H L0FA2: MOV A,M STAX D DCX H DCX D DCR C JNZ L0FA2 XRA A STAX D DCX D STAX D POP D RET L0FB0: LXI H,EXP MVI E,DIGIT+2 L0FB5: MOV A,M STAX B DCX B DCX H DCR E JNZ L0FB5 RET L0FBE: LXI H,BUF-1 DCR B RM ORA A MVI C,DIGIT+1 L0FC6: MOV A,M RAR MOV M,A INX H DCR C JNZ L0FC6 JMP L0FBE L0FD1: LXI H,BUF+DIGIT-1 DCR B RM ORA A MVI C,DIGIT+1 L0FD9: MOV A,M RAL MOV M,A DCX H DCR C JNZ L0FD9 JMP L0FD1 L0FE4: MVI A,001H L0FE6: STA ERRI L0FE9: INX SP INX SP RET L0FEC: MVI A,-1 JMP L0FE6 L0FF1: MVI A,2 JMP L0FE6 ERRI: DB 0 L0FF7: DB 0 BUF: DS DIGIT L0FFE: DB 0 EXP: DB 84H END