; Version 1.0
; Cal.asm
;
; by Steve Martin
;
; Hope you understand this mess.
;
; Copyright: People can do what they want with this progrm except
; to sell it, also I am not responsible for anything.
;
nolist
incdir 'vd0:include/'
include 'exec/exec_lib.i'
;include 'exec/types.i'
;include 'exec/memory.i'
;include 'intuition/intuition.i'
include "libraries/dos_lib.i"
xref _LVOOpenLibrary
xref _LVOCloseLibrary
xref _LVOInput
xref _LVOOutput
xref _LVORead
xref _LVOWrite
; list
ExecBase equ 4
calexec MACRO
move.l ExecBase,a6
jsr _LVO\1(a6)
ENDM
caldos MACRO
move.l DosBase,a6
jsr _LVO\1(a6)
ENDM
; A0 holds the address of the command parameters
; D0 holds the length of the command parameters
; command string ends with $0A
start move.l a0,ipadd store address of command line
move.w d0,iplen store length of command line
getDOS lea.l DosName,a1 library to open
moveq #0,d0 library version (do not care)
calexec OpenLibrary open library
tst.l d0 test if succesful (0 = NG)
bne.s DosOK
moveq #20,d0 return code to tell user system problem
rts return to operating system
DosOK move.l d0,DosBase Save DOS base pointer
caldos Input find standard input
move.l D0,stdin save
caldos Output find standard output
move.l D0,stdout save
;*************************************************************************
iptype bsr getchar get first character form input
cmpi.b #"$",d1 is the number enter in HEX
bne.s ipt2
moveq #0,d1
bra Selip
ipt2 cmpi.b #"@",d1 is the number enter in OCT
bne.s ipt3
moveq #1,d1
bra Selip
ipt3 cmpi.b #"%",d1 is the number enter in binary
bne ipt4
moveq #2,d1
bra Selip
ipt4 cmpi.b #"-",d1 is the number negative
bne others
seq neg set neg flag
moveq #3,d1
bra Selip
others subi.b #$30,d1 is input < 0
bmi error1 yes, error
cmpi.b #9,d1 is the character a decimal number
bgt error1
sub.l #1,ipadd move pointer back a character
add.w #1,iplen incrememt length not read
moveq #3,d1 d1 = decimal input
Selip lsl #2,d1 cal index for jump table
lea Selipt,a0 get address of jump table
move.l 0(a0,d1.w),a0 get address of input routine
jsr (a0)
bcs error1
bsr opert if operator, action it
bmi result
bcc.s nip get net input type
bra operr if operator err
nip bra iptype check input type
Selipt dc.l HEXip,OCTip,BINip,DECip
;*************************************************************************
result clr d0
move.b func,d0 get function pointer
subq #1,d0
lsl #2,d0 cal index for jump table
lea selfunc,a0 get address of jump table
move.l 0(a0,d0.w),a0 get address of func routine
jsr (a0)
tst.b err
bne error1
bsr HtoA
bsr OtoA
bsr BtoA
bsr DtoA
lea BuffHS,a3
bsr nextlin
lea BuffOS,a3
bsr nextlin
lea BuffBS,a3
bsr nextlin
lea BuffDS,a3
bsr nextlin
lea blank,a3
bsr nextlin
bra quit
selfunc dc.l add,sub,mult,div
;*************************************************************************
quit move.l DosBase,a1 Close DOS library
calexec CloseLibrary
moveq #0,d0 Zero return code
rts return to Operating System
;*************************************************************************
opert move.b func,d2
bne.s opequal if func <> 0 then equal is expected
add? cmpi.b #"+",d1 is operator +,if so func = 1
bne.s sub?
move.b #1,func
bra nextval
sub? cmpi.b #"-",d1 is operator -,if so func = 2
bne.s mult?
move.b #2,func
bra nextval
mult? cmpi.b #"*",d1 is operator *,if so func = 3
bne.s div?
move.b #3,func
bra nextval
div? cmpi.b #"/",d1 is operator /,if so func = 4
bne.s operr1
move.b #4,func
nextval move.l #4,VarPtr Point to next variable
rts
operr1 ori #%1,ccr set carry if error only
andi #%1,ccr
rts
opequal cmpi.b #"=",d1 is operator =, if so get result
beq opeq
cmpi.b #$0a,d1 is operator a return, if so get result
beq opeq
bra operr1 if not, error
opeq moveq #-1,d1
rts
;*************************************************************************
operr lea oInfo,a3 get start address of operator error info
bsr nextlin output message
;*************************************************************************
error1 lea Info,a3 get start address of information
bsr nextlin output message
bra quit
;*************************************************************************
nextlin move.l a3,d2 move start address to buffer (d2) of write
moveq #0,d3 clear length input (d3) of write
mesloop move.b (a3)+,d1
beq.s wrend if null (0) all info has been output so end
addq #1,d3 add 1 to length
cmpi.b #$0a,d1 check to see if at end of line
bne.s mesloop if not get next character
wrinfo move.l stdout,d1 stdout file handle
caldos Write Output line to standard output (screen)
bra.s nextlin Output next line of info
wrend rts
;*************************************************************************
getchar move.l ipadd,a0 get address of command line
move.w iplen,d0 get length of command line
next_c moveq #0,d1 clear d1
move.b (a0)+,d1 move next character to d1 and
;increment address pointer
subq #1,d0 decrement length counter
cmpi.b #$20,d1 is it a space
beq.s next_c get next character
move.l a0,ipadd save current pionter to input address
move.w d0,iplen save length not read
rts
;*************************************************************************
oper cmpi.b #"+",d1 is the character an operator
beq.s op1
cmpi.b #"-",d1
beq.s op1
cmpi.b #"/",d1
beq.s op1
cmpi.b #"*",d1
beq.s op1
cmpi.b #"=",d1
beq.s op1
cmpi.b #$0a,d1
beq.s op1
bra.s opend
op1 ori #1,ccr set carry bit if an operator
opend rts
;******************************************************************
;* *
;* Input handling Routines *
;* *
;******************************************************************
;******************************************************************
;* *
;* HEX Input handling Routine *
;* *
;******************************************************************
HEXip bsr getchar
bsr oper is the character an operator
bcc.s Hno_op if carry clear, character not an operator
andi #0,ccr clear carry before returning
rts
Hno_op cmpi.b #"0",d1 if input character is less than an ascii 0
blt Herror then in put is in error
cmpi.b #$3a,d1 is in put character between ,including 0 - 9
blt.s HEXnum yes, do not subtract $37 from ascii value
letter cmpi.b #"a",d1 is input greater than a
blt.s letter2 is character a capital letter?
andi.b #%11011111,d1 no, so convert to a capital
letter2 cmpi.b #"A",d1 is input between and including A and F
blt Herror
cmpi.b #"F",d1
bgt Herror no, HEX number in error
subi.b #$7,d1 yes, convert to a value between and including
; 3A and 3F
HEXnum subi.b #$30,d1 convert input to a value between 0 and F
lea VarPtr,a0
move.l 0(a0),d0 move VarPtr to d0
move.l 4(a0,d0.w),d2 get current variable
moveq #0,d3 clear counter register
hshift asl.l #1,d2 shift left 4 bit places
bcs.s Herror if carry set number intered was to large
addq #1,d3 inc counter
cmpi #4,d3 shifted four places?
bne.s hshift no, repeat
or.l d1,d2 yes, add input character to variable
move.l d2,4(a0,d0.w) save current variable
bra.s HEXip get next character
Herror lea hInfo,a3 get start address of operator error info
bsr nextlin output message
ori #1,ccr set carry to indicate an error
rts
;******************************************************************
;* *
;* OCT Input handling Routine *
;* *
;******************************************************************
OCTip bsr getchar
bsr oper is the character an operator
bcc.s Ono_op if carry clear, character not an operator
andi #0,ccr clear carry before returning
rts
Ono_op subi.b #$30,d1 remove ascii offset
blt.s Oerror if input character is less than an ascii 0
;then in put is in error
cmpi.b #7,d1 is in put character between ,including 0 - 7
bgt.s Oerror no, error
OCTnum lea VarPtr,a0
move.l 0(a0),d0 move VarPtr to d0
move.l 4(a0,d0.w),d2 get current variable
moveq #0,d3 clear counter register
Oshift asl.l #1,d2 shift left three bit places
bcs.s Oerror if carry set number intered was to large
addq #1,d3 inc counter
cmpi #3,d3 shifted 3?
bne.s Oshift no, do it again
or.l d1,d2 add input to variable
move.l d2,4(a0,d0.w) save current variable
bra.s OCTip get next character
Oerror lea OInfo,a3 get start address of operator error info
bsr nextlin output message
ori #1,ccr set carry to indicate an error
rts
;******************************************************************
;* *
;* BIN Input handling Routine *
;* *
;******************************************************************
BINip bsr getchar
bsr oper is the character an operator
bcc.s Bno_op carry clear, character not an operator
andi #0,ccr clear carry before returning
rts
Bno_op subi.b #$30,d1 remove ascii offset
blt.s Berror if input character is less than an ascii 0
;then in put is in error
cmpi.b #1,d1 is in put character 0 or 1
bgt.s Berror no, error
BINnum lea VarPtr,a0
move.l 0(a0),d0 move VarPtr to d0
move.l 4(a0,d0.w),d2 get current variable
Bshift asl.l #1,d2 shift left one bit place
bcs.s Berror if carry set number intered was to large
or.l d1,d2 add input to variable
move.l d2,4(a0,d0.w) save current variable
bra.s BINip get next character
Berror lea BInfo,a3 get start address of operator error info
bsr nextlin output message
ori #1,ccr set carry to indicate an error
rts
;******************************************************************
;* *
;* DEC Input handling Routine *
;* *
;******************************************************************
DECip bsr getchar
bsr oper is the character an operator
bcc.s Dno_op carry clear, character not an operator
tst.b neg test neg flag is set
beq.s DECpos if operator is "-" and neg flag clear,return
bsr.s DECneg if neg flaf set, make number negative
DECpos andi #0,ccr clear carry defore returning
rts
DECneg lea VarPtr,a0 if negative
move.l 0(a0),d0 move VarPtr to d0
move.l 4(a0,d0.w),d2 get current variable
neg.l d2 make it negative
move.l d2,4(a0,d0.w) save current variable
clr.b neg clear negative flag
rts
Dno_op subi.b #$30,d1 remove ascii offset
blt.s Derror if input character is less than an ascii 0
;then in put is in error
cmpi.b #9,d1 is in put character between, including 0 or 9
bgt.s Derror no, error
DECnum lea VarPtr,a0
move.l 0(a0),d0 move VarPtr to d0
move.l 4(a0,d0.w),d2 get current variable
move.l d2,d3 mult by 10
asl.l #1,d3 *2
bvs.s Derror if ovrflow input dec number is to large
move.l d3,d4 save * 2 result
asl.l #2,d3 *4, total of *8
bvs.s Derror if ovrflow input dec number is to large
add.l d3,d4 add *2 result to *8 result
bmi.s Derror if becomes neg input dec number is to large
add.l d1,d4 add input to value
move.l d4,4(a0,d0.w) save current variable
bra.s DECip get next character
Derror lea DInfo,a3 get start address of operator error info
bsr nextlin output message
ori #1,ccr clear carry before returning
rts
;******************************************************************
;* *
;* Math Handling Routines *
;* *
;******************************************************************
;******************************************************************
;* *
;* ADD Routine *
;* *
;******************************************************************
add lea VarPtr,a0
lea Total,a1
moveq #0,d1
move.l 0(a0),d0 move VarPtr to d0
move.l 4(a0),d2 move Var1 to d2
move.l 4(a0,d0.w),d3 move Var2 to d3
add.l d3,d2 add variables
svs err if over flow, err = -1
bvc.s addok if add ok, save result and output
lea adderrI,a3 no, output error
bsr nextlin
bra addend
addok move.l d1,(a1) save result
move.l d2,4(a1)
addend rts
;******************************************************************
;* *
;* SUB Routine *
;* *
;******************************************************************
sub lea VarPtr,a0
lea Total,a1
moveq #0,d1
move.l 0(a0),d0 move VarPtr to d0
move.l 4(a0),d2 move Var1 to d2
move.l 4(a0,d0.w),d3 move Var2 to d3
sub.l d3,d2 var1 - var2
svs err if over flow, err = -1
bvc.s subok sub ok, save reult and output
lea suberrI,a3 no, output error message
bsr nextlin
bra subend
subok move.l d1,(a1) save result
move.l d2,4(a1)
subend rts
;******************************************************************
;* *
;* MULT Routine *
;* 32 * 32 = 64 *
;* *
;******************************************************************
mult lea VarPtr,a0
lea Total,a1 a1 points to result storage area
move.l 0(a0),d0 move VarPtr to d0
move.l 4(a0),d1 move Var1 to d1
move.l 4(a0,d0.w),d2 move Var2 to d2
move.l d1,d6 copy var1 to d6
move.l d2,d7 copy var2 to d7
mul32 move.l d1,d3 copy var1 to d3
move.l d1,d4 and into d4
swap d4 swaped form (upper 2 bytes swapped with lower)
move.l d2,d5 copy var2 to d5
swap d5 in swapped form
mulu d2,d1 partial product #1
mulu d4,d2 #2
mulu d5,d3 #3
mulu d5,d4 #4
swap d1 sum1 = pp #2 low +
add d2,d1 pp #1 high
clr.l d5
addx.l d5,d4 propagate carry into pp #4
add d3,d1 sum2 = sum1 + pp #3 low
addx.l d5,d4 propargate carry into pp #4
swap d1 put low product in correct order
clr d2 prepare for sum #3
swap d2
clr d3
swap d3
add.l d3,d2 sum3 = pp #2 low + pp #3 high
add.l d4,d2 sum4 = sum3 + pp #4
;
; The following instructions modify the product if required
;
tst.l d7 val2 negative?
bpl.s CHKd6 no, go check val1
sub.l d6,d2 yes, sub val1 from product
CHKd6 tst.l d6 val1 negative
bpl.s mulend no, finish
sub.l d7,d2 yes, sub val2 from product
mulend move.l d2,(a1) save result, high 32 bits
move.l d1,4(a1) low 32bits
rts
;******************************************************************
;* *
;* DIV Routines *
;* *
;******************************************************************
div lea VarPtr,a0
lea Total,a1 a1 points to result storage error
move.l 0(a0),d0 move VarPtr to d0
move.l 4(a0),d2 move Var1 to d2
move.l 4(a0,d0.w),d1 move Var2 to d1
div0 moveq #0,d6
moveq #0,d7
tst.l d1 is var2 negative or zero
seq err if zero, divid by zero
beq.s dbyz and output message
smi d6 set d6 if var2 is negative
bpl.s div1 positive, test next variable
neg.l d1 make var2 positive
div1 tst.l d2 is var1 negative
smi d7 set d7 if var1 is negative
bpl.s div2 positive, divid var1 by var2
neg.l d2 make var1 positive
div2 eor d6,d7 are signs different
sne.b neg if signs are different result must be neg
cmpi.l #$FFFF,d1 is var2 larger than 16 bits
sls d6 if lower or same set d6 to -1
addi.b #1,d6 calculate jump offset
lsl.l #2,d6 *4 to get address
lea divlen,a3 get address of jump table
move.l 0(a3,d6.w),a3 move address of divid routine to a3
jsr (a3)
divend move.l d2,(a1) quotient
move.l d1,4(a1) remainder
rts
divlen dc.l d32.16,d32.32
dbyz lea dbyzI,a3 output divid by zero message
bsr nextlin
rts
;
; Use this routine if var2 is stored in 16 bits or less
; Uses 68000 divid operand and accounts for over flow when the quotient
; needs 32 bits instead of the standard 16
;
; d2 = dividend
; d1 = divisor
d32.16 moveq #0,d4
divu d1,d2 Has overflow occurred?
bvc.s dformat No, go format result
move.l d2,d3 Yes, copy yo into d3
clr.w d2 clr low word of d2, y1-y0 to y1-0
swap d2 y1-0 to 0-y1
divu d1,d2 div puts r1-q1 into d2
move d2,d4 d3 contains q1
move d3,d2 d1 changes from r1-q1 to r1-y0
divu d1,d2 div puts r0-q0 into d1
;
; Form quotient (D2) and remainder (D1)
;
dformat move.l d2,d1 d1 contains r-q or r0-q0
swap d2 d2 contains q-r or q0-r0
move d4,d2 d2 contains q-0 or q0-q1
swap d2 d2 contains 0-q or q1-q0
clr d1 d1 contains r-0 or r0-0
swap d1 d1 contains 0-r or 0-r0
tst.b neg is result to be negative
beq.s d32.16e no, return
neg.l d2 yes, make neqative
neg.l d1
clr.b neg
d32.16e rts
;
; Use this routine if var2 is stored in 16 bits or less
; Uses a divid algorithm
;
; d2 = dividend
; d1 = divisor
;
d32.32 cmp.l d2,d1 divisor = dividend
bne.s divi1 no, divid out
moveq #1,d3 yes, result = 1
moveq #0,d2 zero remainder
bra.s divout return
divi1 cmp.l d2,d1 dividend > divisor?
bcs.s divi2 yes, result is > 0
moveq #0,d3 else result = 0 + r
bra.s divout return
divi2 moveq #0,d4 initialise iteration count
divi3 addq #1,d4 inc count
asl.l #1,d1 see if d1 goes > 0
bmi.s divi4 it did if now neg
cmp.l d1,d2 d1 > 0
bcc.s divi3 no, try again
divi4 lsr.l #1,d1 readjust divisor
moveq #0,d3 initialise quotient
divi5 sub.l d1,d2 divisor goes in
bmi.s divi6 no
addq #1,d3 else record it
bra.s divi7
divi6 add.l d1,d2 restore dividend
divi7 subq #1,d4 done all bits?
beq.s divout yes
asl.l #1,d3 quotient * 2
asr.l #1,d1 divisor / 2
bra.s divi5 next round
divout move.l d2,d1 move remainder to d1
move.l d3,d2 move quotient to result
tst.b neg should result be neg
beq.s d32.32e no exit
neg.l d2 change sign of result
neg.l d1
clr.b neg
d32.32e rts
;******************************************************************
;* *
;* Output Handling Routines *
;* *
;******************************************************************
;******************************************************************
;* HtoA *
;* Converts variable pointed to by VarPtr to *
;* a HEX ascii string for displaying. *
;******************************************************************
HtoA lea VarPtr,a0
move.l #12,d4 point to result
lea BuffT,a1 get address of tempory buffer
move.l #147,d3 point to end of buffer
GetH move.l 4(a0,d4),d0 get a varible
cmpi.b #12,d4 pointing to result
blt.s GetH0 no, no special trement
cmpi.b #4,func is operation div
beq.s Hdiv yes, output in divid format
GetH0 cmpi #8,d4 remove if leading zeros are to be removed
bne.s GetH1 "
tst.l d0 "
bne.s GetH1 "
subq #4,d4 "
bsr Iequal "
bra.s GetH "
GetH1 bsr HtoAt change variable to ascii in HEX base
tst.b err error in converstion
bne.s HtoAerr output error message
nextH subq #4,d4 point to next variable
bmi.s BTtoBH if negative all variables actioned
beq.s Hoper d4 = 0, then output relavent operator
Hequal cmpi #4,d4 has total been actioned
bhi.s GetH higher, get high 32 bits of result
bsr Iequal d4 = 4, insert "=" sign
bra.s GetH get next variable
Hoper bsr Ifunc branch to insert operator routine
bra GetH get next variable
BTtoBH lea BuffH,a0 a0 points to HEX output buffer
;jsr Rled0 remove leading zeros
jsr BTcopy do not remove leading zeros
rts
Hdiv move.l #9,d5 insert "remainder" into tempory buffer
lea rem,a2 a2 points to remainder
Hdiv1 move.b 0(a2,d5.w),d6 get a letter
move.b d6,0(a1,d3.w) put it into tempory buffer
subq #1,d3 point to next letter
dbf d5,Hdiv1 d5 = 0, then finished
Hdiv2 bsr HtoAt convet to ascii, HEX base
move.b #' ',0(a1,d3.w) add "+" to buffer
subq #1,d3
move.b #'+',0(a1,d3.w)
subq #1,d3
move.b #' ',0(a1,d3.w)
subq #1,d3
subq #4,d4 point to quotient
move.l 4(a0,d4.w),d0 get quotient
bsr HtoAt convert to ascii, HEX base
bra nextH get var2
HtoAerr lea HtoAI,a3 output error message
bsr nextlin
rts
HtoAt moveq #8,d1 do not remove leading zeros
;move to remove leading zeros
HtoAtp move.l d0,d2
andi.l #$0000000F,d2 get lsnibble
addi.l #$30,d2 ascii offset for num
cmpi.l #$39,d2 larger than $39
ble.s HtoAct no do not add $7, yes, add $7
addq.l #$7,d2 ascii offset for alpha
HtoAct move.b d2,0(a1,d3.w) move to tempory buffer
subq #1,d3 point to next buffer place
lsr.l #4,d0 move next byte into LSnibble
subq #1,d1 decrememt counter, remove to delete leading
;zero
smi.b err if negative, an error has occurred
bgt.s HtoAtp if greater convert next byte
rts
;******************************************************************
;* OtoA *
;* Converts variable pointed to by VarPtr to *
;* a OCT ascii string for displaying. *
;******************************************************************
OtoA lea VarPtr,a0
move.l #12,d4 point to result
lea BuffT,a1 get address of tempory buffer
move.l #147,d3 point to end of buffer
GetO move.l 4(a0,d4),d0 get a varible
cmpi.b #12,d4 pointing to result
blt.s GetO0 no, no special treatment
cmpi.b #4,func is operation div
beq.s Odiv yes, output in divid format
GetO0 cmpi #8,d4 remove if leading zeros are to be removed
bne.s GetO1 "
tst.l d0 "
bne.s GetO1 "
subq #4,d4 "
bsr Iequal "
bra.s GetO " "
GetO1 bsr OtoAt change variable to ascii in OCT base
tst.b err error in converstion
bne.s OtoAerr output error message
nextO subq #4,d4 point to next variable
bmi.s BTtoBO if negative all variables actioned
beq.s Ooper d4 = 0, then output relavent operator
Oequal cmpi #4,d4 has total been actioned
bhi.s GetO higher, get high 32 bits of result
bsr Iequal d4 = 4, insert "=" sign
bra.s GetO get next variable
Ooper bsr Ifunc branch to insert operator routine
bra GetO get next variable
BTtoBO lea BuffO,a0 a0 points to OCT output buffer
;jsr Rled0 remove leading zeros
jsr BTcopy do not remove leading zeros
rts
Odiv move.l #9,d5 insert "remainder" into tempory buffer
lea rem,a2 a2 points to remainder
Odiv1 move.b 0(a2,d5.w),d6 get a letter
move.b d6,0(a1,d3.w) put it into tempory buffer
subq #1,d3 point to next letter
dbf d5,Odiv1 d5 = 0, then finished
Odiv2 bsr OtoAt convet to ascii, BIN base
move.b #' ',0(a1,d3.w) if so add + to buffer
subq #1,d3
move.b #'+',0(a1,d3.w)
subq #1,d3
move.b #' ',0(a1,d3.w)
subq #1,d3
subq #4,d4 point to quotient
move.l 4(a0,d4.w),d0 get quotient
bsr OtoAt convert to ascii, OCT base
bra nextO get var2
OtoAerr lea HtoAI,a3 output error message
bsr nextlin
rts
OtoAt moveq #11,d1 do not remove leading zeros
;move to remove leading zeros
OtoAtp move.l d0,d2
andi.l #$00000007,d2 get lsf
addi.l #$30,d2 ascii offset for num
OtoAct move.b d2,0(a1,d3.w) move to tempory buffer
subq #1,d3 point to next buffer place
lsr.l #3,d0 move next byte into LSBits (3)
subq #1,d1 decrememt counter, remove to delete leading
;zeros
smi err if negative, an error has occurred
bgt.s OtoAtp if greater convert next 3 bits
rts
;******************************************************************
;* BtoA *
;* Converts variable pointed to by VarPtr to *
;* a BIN ascii string for displaying. *
;******************************************************************
BtoA lea VarPtr,a0
move.l #12,d4 point to result
lea BuffT,a1 get address of tempory buffer
move.l #147,d3 point to end of buffer
GetB move.l 4(a0,d4),d0 get a varible
cmpi.b #12,d4 pointing to result
blt.s GetB0 no, no special treatment
cmpi.b #4,func is operation div
beq.s Bdiv yes, output in divid format
GetB0 cmpi #8,d4 remove if leading zeros are to be removed
bne.s GetB1 "
tst.l d0 "
bne.s GetB1 "
subq #4,d4 "
bsr Iequal "
bra.s GetB " "
GetB1 bsr BtoAt change variable to ascii in BIN base
tst.b err error in converstion
bne.s BtoAerr output error message
nextB subq #4,d4 point to next variable
bmi.s BTtoBB if negative all variables actioned
beq.s Boper d4 = 0, then output relavent operator
Bequal cmpi #4,d4 has total been actioned
bhi.s GetB higher, get high 32 bits of result
bsr Iequal d4 = 4, insert "=" sign
bra.s GetB get next variable
Boper bsr Ifunc branch to insert operator routine
bra GetB get next variable
BTtoBB lea BuffB,a0 a0 points to BIN output buffer
;jsr Rled0 remove leding zeros
jsr BTcopy do not remove leading zeros
rts
Bdiv move.l #9,d5 insert "remainder" into tempory buffer
lea rem,a2 a2 points to remainder
Bdiv1 move.b 0(a2,d5.w),d6 get a letter
move.b d6,0(a1,d3.w) put it into tempory buffer
subq #1,d3 point to next letter
dbf d5,Bdiv1 d5 = 0, then finished
Bdiv2 bsr BtoAt convet to ascii, BIN base
move.b #' ',0(a1,d3.w) if so add + to buffer
subq #1,d3
move.b #'+',0(a1,d3.w)
subq #1,d3
move.b #' ',0(a1,d3.w)
subq #1,d3
subq #4,d4 point to quotient
move.l 4(a0,d4.w),d0 get quotient
bsr BtoAt convert to ascii, BIN base
bra nextB get var2
BtoAerr lea HtoAI,a3 output error message
bsr nextlin
bra quit
BtoAt move.l #32,d1 do not remove leading zeros
;move to remove leading zeros
BtoAtp move.l d0,d2
andi.l #$00000001,d2 get lsbit
addi.l #$30,d2 ascii offset for num
BtoAct move.b d2,0(a1,d3.w) move to tempory buffer
subq #1,d3 point to next buffer place
lsr.l #1,d0 move next byte into LSBit
subq #1,d1 decrememt counter, remove to delete leading
;zeros
smi err if negative, an error has occurred
bgt.s BtoAtp if greater convert next bit
rts
;******************************************************************
;* DtoA *
;* Converts variable pointed to by VarPtr to *
;* a DEC ascii string for displaying. *
;******************************************************************
DtoA lea VarPtr,a0
move.l #12,d4 point to result
lea BuffT,a1 get address of tempory buffer
move.l #147,d3 point to end of buffer
GetD move.l 4(a0,d4.w),d0 get a variable
cmpi.b #12,d4 pointing to result
blt.s GetD0 no, no special treatment
cmpi.b #3,func is operation mult or div
beq Dtmul if equal, output in mult format
bgt Dtdiv if greater, output in div format
GetD0 tst.l d0 find sign of variable
bge.s GetD1
smi neg neg, set neg flag
neg.l d0 make number possible
GetD1 bsr HtoBCD change variable to ascii in DEC base
nextD subq #4,d4 point to next variable
bmi BTtoBD if negative all variables actioned
beq.s Doper d4 = 4, then insert operator
Dequal cmpi #4,d4 has total been actioned
bhi.s Getr no, go to save to buffer routine
bsr DequalI yes, insert "=" in tempory buffer
bra.s GetD get next variable
Getr bsr DtoAct move result from DecTemp to Tempory Buffer
subq #4,d4 point to next variable
bsr Iequal insert "=" into tempory buffer
bra GetD get next variable
Doper bsr DtoAct move var2 from DecTemp to Tempory Buffer
bsr Ifunc then insert operator
bra GetD get var1
DequalI bsr DtoAct move result from DecTemp to Tempory Buffer
bsr Iequal then insert equal sign
rts
BTtoBD bsr DtoAct move DecTemp to Buffer
lea BuffD,a0 point to DEC output buffer
jsr Rled0 remove leading zero's and move to output buffer
rts
; Dtmul uses two longwords to calculate decimal equivalent
Dtmul tst.l 0(a0,d4.w) is variable negative
bge.s Dtmul1 no, convert
smi neg yes, set neg flag
neg.l d0 neg low word
negx.l 0(a0,d4.w) neg (account for borrow if used for low word)
Dtmul1 bsr HtoBCD change variable to ascii in DEC base
subq #4,d4 point to next variable
move.l 4(a0,d4.w),d0 get high 32 bits
bsr BCDT miss out set up routine in HtoBCD
bra nextD move to tempory buffer and get next var2
; Dtdiv uses the lowword for remainder, high word for quotient
Dtdiv move.l #9,d5 insert "remainder" into tempory buffer
lea rem,a2 a2 points to remainder
Dtdiv1 move.b 0(a2,d5.w),d6 get a letter
move.b d6,0(a1,d3.w) put it into tempory buffer
subq #1,d3 point to next letter
dbf d5,Dtdiv1 d5 = 0, then finished
tst.l d0 is remainder negative
bpl.s Dtdiv2 no, convert
smi neg yes, set neg flag
neg.l d0 and make poitive
Dtdiv2 bsr HtoBCD change variable to ascii in DEC base
bsr DtoAct move to tempory buffer
tst.b neg was number negative
bpl.s Dtdiv3 no, add "+" to buffer
move.b #' ',0(a1,d3.w) yes, so add - to buffer
subq #1,d3
move.b #'-',0(a1,d3.w)
subq #1,d3
move.b #' ',0(a1,d3.w)
subq #1,d3
clr.b neg clear neg flag
bra.s Dtdiv4 convert quotient
Dtdiv3 move.b #' ',0(a1,d3.w) add + to buffer
subq #1,d3
move.b #'+',0(a1,d3.w)
subq #1,d3
move.b #' ',0(a1,d3.w)
subq #1,d3
Dtdiv4 subq #4,d4 point to next variable
move.l 4(a0,d4.w),d0 get quotient
tst.l d0 is it negative
smi.b neg set neg flag if negative
bpl.s Dtdiv5 no, convert
neg.l d0 yes, make it positive
Dtdiv5 bsr HtoBCD change variable to ascii in BIN base
bra nextD move to tempory buffer and get var2
; HtoBCD converts a HEX number to BCD
HtoBCD moveq #0,d5 clear d5
move.l #DecSize,d2 get size of DecTemp
lea DecTemp,a2 get address of DecTemp
HtoBCD2 move.b d5,0(a2,d2.w) clear a2 + d2
dbmi.w d2,HtoBCD2 all done, no do it again
lea DecCon1,a2 get address of DecCon1
BCDT moveq #8,d1 d1 holds the number of nibbles to do
BCDT0 move.l d0,d2 move variable to d2
andi.l #$0000000F,d2 get lsnibble
BCDT1 beq.s BCDT3 if zero get next significant nibble
lea DecCon0,a4 get address of DecCon0
andi #$EF,ccr clear extended flag in ccr
move.l a2,a3
adda.l d5,a3 calculate 16^x pointer
BCDT2 abcd -(a3),-(a4) add BCD from number pointed to by a3 to DecTemp
cmpa.l #DecTemp,a4 all bytes added
bne.s BCDT2 no, do next byte, elseget next significant nib
subq #1,d2 sub 1 from hex number
bra BCDT1 do again
BCDT3 lsr.l #4,d0 move next significant nibble into lsnibble
addi.l #12,d5 point to next 16^x (x = D5)
subq #1,d1 dec nibble count
bne.s BCDT0 if not zero do it again
BCDend rts
; DtoAct converts a BCD number to ASCII and moves it to a tempory buffer
DtoAct lea DecCon0,a4 point to end of DecTemp
DtoAct1 moveq #2,d5 d5 = nibble count
move.b -(a4),d0 move byte from DecTemp into d0
DtoAct2 move.b d0,d2
andi #$F,d2 get lsnibble
add.b #$30,d2 convert it to an ascii number
move.b d2,0(a1,d3.w) move to tempory buffer
subq #1,d3 point to next buffer position
lsr #4,d0 move nibble into lsnibble position
subq #1,d5 dec nibble count
bne.s DtoAct2 all nibbles done, no do next nibble
DtoAct3 cmpa.l #DecTemp-1,a4 else, all of DecTemp done?
bne.s DtoAct1 no, done next byte
tst.b neg was number negative
beq.s DtoActe no return
move.b #'-',0(a1,d3.w) else put negative in front of number
subq #1,d3 point to next buffer position
clr.b neg clear neg flag
DtoActe rts
DtoAerr lea HtoAI,a3 print error message
bsr nextlin
rts
***********************************************************
Iequal move.b #' ',0(a1,d3.w) add " = " to buffer
subq #1,d3
move.b #'=',0(a1,d3.w)
subq #1,d3
move.b #' ',0(a1,d3.w)
subq #1,d3
rts
Ifunc move.b #' ',0(a1,d3.w) add function to buffer
subq #1,d3
moveq #0,d5
move.b func,d5
subq #1,d5
lsl #2,d5 cal index for jump table
lea funcH,a3 get address of jump table
move.l 0(a3,d5.w),a3 get address of func routine
jsr (a3) insert correct function
move.b #' ',0(a1,d3.w)
subq #1,d3
rts
funcH dc.l Iadd,Isub,Imult,Idiv
Iadd move.b #'+',0(a1,d3.w) add + to buffer
subq #1,d3
rts
Isub move.b #'-',0(a1,d3.w) add - to buffer
subq #1,d3
rts
Imult move.b #'*',0(a1,d3.w) add * to buffer
subq #1,d3
rts
Idiv move.b #'/',0(a1,d3.w) add / to buffer
subq #1,d3
rts
;******************************************************************
;* Rmzero Kill leading zeros *
;* Inputs: a0 pointer to destination buffer *
;* a1 pointer to source *
;******************************************************************
Rled0 moveq #0,d0
moveq #0,d2
moveq #0,d1
addq #1,d3 compensate for last subq of d3
Rled01 move.b 0(a1,d3.w),d0 get character from buffer
addq #1,d3
cmpi.b #$30,d0 is it a zero
bne.s Rled02 check for other characters of interest
tst d1 has a character been output
beq.s Rled01 no, geet next character
bne.s BtoB2 yes, output "0"
Rled02 cmpi.b #$20,d0 is the character a space
beq.s BtoB yes, check if input betwwen spaces
cmpi #'-',d0 is it "-"?
beq.s BtoB3 move it to out put buffer
cmpi.b #LF,d0 end of tempory buffer
bne.s BtoB2 no, put character into buffer
tst d1 character between last space and Line Feed
bne Tnzero yes, put into buffer
move.b #'0',0(a0,d2.w) no, insert a "0" before Line Feed
addq #1,d2
moveq #LF,d0
Tnzero move.b d0,0(a0,d2.w) move to output buffer
addq #1,d2 inc output buffer pointer
move.b #0,0(a0,d2.w) put a NULL at end of output string
rts
BtoB tst d1 has a character been output
beq.s Val0 no, insert a "0"
moveq #3,d1 yes, d1 is used to count three characters
;move " ? " to output buffer. (? = +,-,*,/,=)
BtoB1 move.b d0,0(a0,d2.w) move character to output buffer
addq #1,d2 inc buffer pointer
subq #1,d1 dec character counter
beq.s BtoB1e all done, reset character output flag
move.b 0(a1,d3.w),d0 get character from temp buffer
addq #1,d3 inc buffer pointer
bra BtoB1 do again
BtoB1e moveq #0,d1 clear output flag
bra.s Rled01 get next character
BtoB2 move.b d0,0(a0,d2.w) move character to output buffer
addq #1,d2 inc buffer pointer
addq #1,d1 inc buffer pointer
bra Rled01 get next character
BtoB3 move.b d0,0(a0,d2.w) move character to output buffer
addq #1,d2 inc buffer pointer
bra Rled01 get next character
Val0 move.b #'0',0(a0,d2.w) move "0" to output buffer
addq #1,d2 inc buffer pointer
moveq #3,d1 move " ? " to output buffer. (? = +,-,*,/,=)
bra.s BtoB1
;******************************************************************
;* Copy from tempory buffer to output buffer *
;* Inputs: a0 pointer to destination buffer *
;* a1 pointer to source *
;******************************************************************
BTcopy moveq #0,d0
moveq #0,d2
moveq #0,d1
addq #1,d3 compensate for last subq of d3
BTcopy1 move.b 0(a1,d3.w),d0 get character from buffer
addq #1,d3 inc buffer pointer
cmpi.b #LF,d0 end of tempory buffer
beq.s BTcopy2 yes, end routine
move.b d0,0(a0,d2.w) move character to output buffer
addq #1,d2 inc buffer pointer
bra BTcopy1 get next character
BTcopy2 move.b d0,0(a0,d2.w) move character to output buffer
addq #1,d2 inc buffer pointer
move.b #0,0(a0,d2.w) put a NULL at end of output string
rts
;******************************************************************
;* *
;* Variables and Constants *
;* *
;******************************************************************
VarPtr ds.l 1
Var1 ds.l 1
Var2 ds.l 1
Total ds.l 2
func dc.b 0 ; 0,1,2,3,4 none,add,sub,Mult,Div
neg dc.b 0
err dc.b 0
BuffT ds.b 148
BuffTE dc.b $0a
BuffHS dc.b "HEX "
BuffH ds.b 52
BuffHe dc.b 0
BuffOS dc.b "OCT "
BuffO ds.b 64
BuffOE dc.b 0
BuffBS dc.b "BIN "
BuffB ds.b 148
BuffBE dc.b 0
BuffDS dc.b "DEC "
BuffD ds.b 55
BuffDE dc.b 0
rem dc.b " remainder"
even
DecTemp ds.w 6
DecCon0 dc.w $0000,$0000,$0000,$0000,$0000,$0001
DecCon1 dc.w $0000,$0000,$0000,$0000,$0000,$0016
DecCon2 dc.w $0000,$0000,$0000,$0000,$0000,$0256
DecCon3 dc.w $0000,$0000,$0000,$0000,$0000,$4096
DecCon4 dc.w $0000,$0000,$0000,$0000,$0006,$5536
DecCon5 dc.w $0000,$0000,$0000,$0000,$0104,$8576
DecCon6 dc.w $0000,$0000,$0000,$0000,$1677,$7216
DecCon7 dc.w $0000,$0000,$0000,$0002,$6843,$5456
DecCon8 dc.w $0000,$0000,$0000,$0042,$9496,$7296
DecCon9 dc.w $0000,$0000,$0000,$0687,$1947,$6736
DecConA dc.w $0000,$0000,$0001,$0995,$1162,$7776
DecConB dc.w $0000,$0000,$0017,$5921,$8604,$4416
DecConC dc.w $0000,$0000,$0281,$4749,$7671,$0656
DecConD dc.w $0000,$0000,$4503,$5996,$2737,$0496
DecConE dc.w $0000,$0007,$2057,$5940,$3792,$7936
DecConF dc.w $0000,$0115,$2921,$5046,$0694,$6976
DecEND dc.w $0000,$0000,$0000,$0000,$0000,$0000
DecSize equ (DecCon0-DecTemp)-1
even
ipadd dc.l 0
iplen dc.w 0
stdout dc.l 0
stdin dc.l 0
DosBase dc.l 0
DosName dc.b "dos.library",0
LF equ $0a
blank dc.b LF,0
HtoAI dc.b "You stuffed it up again",LF,0
oInfo dc.b "Error in operator",LF,0
hInfo dc.b "Error in hexadecimal number",LF,0
OInfo dc.b "Error in octal number",LF,0
BInfo dc.b "Error in binary number",LF,0
DInfo dc.b "Error in Decimal number",LF,0
adderrI dc.b "Overflow occured in addition, numbers are to large.",LF,0
suberrI dc.b "Overflow occured in subtraction, numbers are to large.",LF,0
dbyzI dc.b "Divid by zero",LF,0
Info dc.b "CAL number operator number <=> [return]",LF
dc.b " base: $ = HEX, @ = Octal, % = binary, none = decimal",LF
dc.b " number: HEX max 7FFFFFFF t0 80000000,",LF
dc.b " Decimal max +/-2147483647",LF
dc.b " operator: +,-,*,/",LF,LF,0
end