home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Dream 52
/
Amiga_Dream_52.iso
/
Amiga
/
Applications
/
Mathematiques
/
Debt.lha
/
Debt
/
Debt.s
< prev
next >
Wrap
Text File
|
1992-09-26
|
31KB
|
1,450 lines
XREF _AbsExecBase
XREF _LVOOpenLibrary
XREF _LVOCloseLibrary
XREF _LVOWait
XREF _LVOOpenWindow
XREF _LVOCloseWindow
XREF _LVOGetMsg
XREF _LVOReplyMsg
XREF _LVOMove
XREF _LVOText
XREF _LVOSetAPen
XREF _LVORectFill
XREF _LVOWaitPort
XREF _LVOForbid
XREF _LVOPermit
XREF _LVOScrollRaster
XREF _LVOWaitTOF
GADGETUP EQU $00000040
CLOSEWINDOW EQU $00000200
WINDOWCLOSE EQU $0008
SMART_REFRESH EQU $0000
ACTIVATE EQU $1000
WINDOWDRAG EQU $0002
WBENCHSCREEN EQU $0001
GADGHCOMP EQU $0000
RELVERIFY EQU $0001
BOOLGADGET EQU $0001
WINDOWDEPTH EQU $0004
ThisTask EQU $0114
pr_CLI EQU $00ac
pr_MsgPort EQU $005c
CODE CODE
public _Debt
_Debt:
move.l a7,parksp
move.l #0,WBenchMsg
movea.l _AbsExecBase,a6 ;test if WB or CLI
movea.l ThisTask(a6),a4
tst.l pr_CLI(a4)
bne.s fromCLI
lea pr_MsgPort(a4),a0 ;get WB Message
jsr _LVOWaitPort(a6)
lea pr_MsgPort(a4),a0 ;maybe refreshing a0 will prevent
jsr _LVOGetMsg(a6) ;the crashes I get on WB.
move.l d0,WBenchMsg
fromCLI:
movea.l #IntuitionName,a1
moveq #33,d0
movea.l _AbsExecBase,a6
jsr _LVOOpenLibrary(a6)
move.l d0,IntBase
beq Abort
movea.l #GName,a1
moveq #33,d0
jsr _LVOOpenLibrary(a6)
move.l d0,GBase
beq Abort2
movea.l #NewWdw,a0
movea.l IntBase,a6
jsr _LVOOpenWindow(a6)
move.l d0,Wdw
beq Abort3
movea.l Wdw,a0
move.l 50(a0),rp ;save rasterport address
move.l 86(a0),a0 ;save userport address
move.l a0,userport
move.b 15(a0),d1 ;byte mp_sigbit
moveq.l #1,d0 ;Make a mask and save it.
lsl.l d1,d0
move.l d0,sigmask
;**********************************
startover:
bsr ClearAll
bsr BuildAString
cmp #CLOSEWINDOW,d5
beq closeup
cmp #14,d5
beq startover
lea accum1+63,a4 ;set up for pack
bsr pack
bsr ClearInBuf
secondpass:
move dec,firstdec ;switch signs and negs around for
move.b negative,firstneg ;second pass.
move.b #0,point ;clear period inhibitor.
move #0,dec
move.b #0,negative
move.b #0,havept
addi #9,printy
bsr BuildAString
cmp #CLOSEWINDOW,d5
beq closeup
cmp #14,d5
beq startover
lea accum2+63,a4
bsr pack
cmp.b #43,fun
beq.s t1
cmp.b #45,fun
bne.s t2
t1:
bsr WhatTheHell
t2:
cmp.b #42,fun
bne.s t3
bsr multiply
t3:
cmp.b #47,fun
bne.s t4
bsr divide
t4:
move.b #0,havept
bsr unpack
addi #9,printy
cmp.b #47,fun
beq.s t5
move chars,d0 ;check for overflow
sub res_pts,d0
cmpi #$78,d0
bhi error
t5:
lea buildstr,a0
bsr print_bs
t6:
move.b fun2,fun
cmp.b #61,fun2
bne chain2
bsr waitforkey
cmp #CLOSEWINDOW,d5
beq closeup
cmp #45,d5 ; -
beq.s chain
cmp #43,d5 ; +
beq.s chain
cmp #47,d5 ; /
beq.s chain
cmp #42,d5 ; *
beq.s chain
bra startover
chain:
move.b d5,fun
chain2:
bsr ClearInBuf
movea.l GBase,a6
move.b eq,d6
ext d6
scroll:
movea.l rp,a1
move #0,d0
move #1,d1
move #5,d2
move #11,d3
move #485,d4
move #72,d5
jsr _LVOScrollRaster(a6)
jsr _LVOWaitTOF(a6)
jsr _LVOWaitTOF(a6)
dbra d6,scroll ;just to slow it down
move.b eq,d0 ;eq contains scroll y + 1
ext d0
sub d0,printy
addi #8,printy
move res_pts,dec
move.b res_sign,negative
move.b #0,res_sign
lea fun,a0
move #1,chars
bsr print_bs
lea accum2,a2
lea accum1,a1
bsr exchange ;put prev answer in accum1
lea accum2,a2
lea accum3,a3
move.l #0,d1
move #15,d2
clear1:
move.l d1,(a2)+
move.l d1,(a3)+
dbra d2,clear1
bra secondpass
;*********************************
closeup:
movea.l Wdw,a0
movea.l IntBase,a6
jsr _LVOCloseWindow(a6)
Abort3:
movea.l GBase,a1
movea.l _AbsExecBase,a6
jsr _LVOCloseLibrary(a6)
Abort2:
movea.l IntBase,a1
movea.l _AbsExecBase,a6
jsr _LVOCloseLibrary(a6)
Abort:
movea.l parksp,a7
tst.l WBenchMsg
beq.s CLIclose
movea.l _AbsExecBase,a6
jsr _LVOForbid(a6) reply to WB
lea WBenchMsg,a1
jsr _LVOReplyMsg(a6)
jsr _LVOPermit(a6)
CLIclose:
move.l #0,d0
rts
;*********************************************************************
; PRINT ERROR STRING
;*********************************************************************
error:
lea errstr,a0
movea.l rp,a1
moveq #5,d0
move printy,d1
movea.l GBase,a6
jsr _LVOMove(a6)
move #5,d0
jsr _LVOText(a6)
bsr waitforkey
bra startover
;************************************************************************
; SUBROUTINE CLEAR ALL
; uses a1,a2,a3,a4,a6, d0,d1
*************************************************************************
ClearAll:
lea buildstr,a1
lea accum1,a2
lea accum2,a3
lea accum3,a4
lea buildstr+64,a6
moveq.l #0,d0
moveq #15,d1
clearly:
move.l d0,(a1)+
move.l d0,(a2)+
move.l d0,(a3)+
move.l d0,(a4)+
move.l d0,(a6)+
dbra d1,clearly
lea printy,a1
move.l d0,(a1)+ ;need 17 more bytes cleared
move.l d0,(a1)+
move.l d0,(a1)+
move.l d0,(a1)+
move.l d0,(a1)+
move.l d0,(a1)+ ;24 now
clearscn:
movea.l rp,a1
movea.l GBase,a6
moveq.b #0,d0
jsr _LVOSetAPen(a6)
moveq #4,d0
moveq #10,d1
move #485,d2
moveq #72,d3
jsr _LVORectFill(a6)
moveq.b #1,d0
movea.l rp,a1 ;a1 trashed by RectFill
jsr _LVOSetAPen(a6) ;put rp back into a1
move #17,printy
rts
;************************************************************************
; SUBROUTINE JUST CLEAR INPUT BUFFER
;
*************************************************************************
ClearInBuf:
lea buildstr,a1
move.l #0,d0
moveq #15,d1
bufcl:
move.l d0,(a1)+
dbra d1,bufcl
rts
;************************************************************************
; SUBROUTINE WAIT FOR KEY
; uses a0,a1,a6, d0,d1,d5
;************************************************************************
waitforkey:
movea.l _AbsExecBase,a6
move.l sigmask,d0
jsr _LVOWait(a6)
WFK1:
movea.l userport,a0
jsr _LVOGetMsg(a6)
tst.l d0
beq.s return
move.l d0,a1
move.l 20(a1),class ;msg->Class is 20
move.l 28(a1),a0 ;msg->IAddress 28
move 38(a0),d5 ;IAddress->GadgetID is 38
jsr _LVOReplyMsg(a6)
move.l class,d0
cmp.l #CLOSEWINDOW,d0
bne.s WFK1
move d0,d5
bra WFK1
return:
rts
;************************************************************************
; SUBROUTINE BUILD A STRING
; uses a5, d4,d5
;************************************************************************
BuildAString:
moveq.l #0,d4
lea buildstr,a5
cmp #57,d5
bhi again
cmp #47,d5
bhi dont
again:
bsr waitforkey
cmp #CLOSEWINDOW,d5
bne.s dont
rts
dont:
cmp #13,d5 ; C
bne checkbs
bsr ClearInBuf
lea blanks,a0
bsr print_bs
move.b #0,point
move.b #0,negative
bra BuildAString
checkbs:
cmp #19,d5 ; <
bne.s not_bs ;does not count. only allows 1 point.
tst.b point
beq.s nopoint
move.b #0,point
nopoint:
subq #1,d4
move #32,d5
bra ok
not_bs:
cmp #14,d5 ; AC
bne.s not_AC
rts ;with a 14 in d5
not_AC:
cmp #61,d5 ; =
beq equals
cmp #46,d5 ; .
beq period
cmp #45,d5 ; -
beq.s minus
cmp #43,d5 ; +
beq.s plus
cmp #47,d5 ; /
beq.s funct
cmp #42,d5 ; *
beq.s funct
ok:
cmp #59,d4
bhi again
move.b d5,0(a5,d4) ;a5 buildstr
addq #1,d4
move d4,chars
movea.l a5,a0
bsr print_bs ;print length d4 from buildstr array.
cmp.b #32,d5 ;if d5==32 it is a backspace
bne again ;if d4==0 you are at left margin
cmp #0,d4 ;if bksp and ! at margin subtract 1
beq again
subq #1,d4
bra again
minus:
tst d4
bne funct
move.b #1,negative
bra ok
plus:
tst d4
bne funct
move.b #0,negative
bra ok
funct:
cmp #1,d4
bhi.s allisright ;Almost. Still lets -. to go through.
cmp.b #48,(a5) ;Supposed to stop crashing when no
bcs again ;number, only function, is entered.
allisright: ;Still crashes on -.* combination.
tst.b fun
bne.s alright
addi #9,printy
already:
move.b d5,fun
lea fun,a0
move #1,chars
bsr print_bs
rts
period:
tst.b point ;does not count. only allows 1 pt.
bne again
move.b #1,point
bra ok
equals:
cmp #1,d4
bhi.s alright
cmp.b #48,(a5)
bcs again
alright:
move.b d5,fun2
move.b #61,eq
lea eq,a0
addi #9,printy
move #1,chars
bsr print_bs
move printy,d5
subi #9,d5
move.b d5,eq ;number of lines to scroll
rts
;************************************************************************
; SUBROUTINE TO ALIGN DECIMAL POINTS
; uses d1,d2, a4
;************************************************************************
align:
move firstdec,d1 ;if firstdec>dec then shift2 left
;if dec>firstdec then shift1 left
move dec,d2
cmp d2,d1
bhi.s shift2 ;three-way branch 1, 2, or rts
bcs.s shift1
move d2,res_pts
rts
shift1:
move d2,res_pts ;no of dec points in answer
sub d1,d2
subq #1,d2
line1:
lea accum1+63,a4 ;call shift with accum addr+63 in a4
bsr shift_l
dbra d2,line1
rts
shift2:
move d1,res_pts
sub d2,d1
subq #1,d1
line2:
lea accum2+63,a4
bsr shift_l
dbra d1,line2
rts
;************************************************************************
; SUBROUTINE TO ADD TWO BCD NUMBERS OF LENGTH 120
; uses a0,a1, d1
;************************************************************************
addemup:
moveq #65,d1 ;31 one for final carry
lea accum1+65,a0
lea accum2+65,a1
move.b #4,ccr ;x=0 and z=1
keepadding:
abcd -(a0),-(a1)
dbra d1,keepadding
rts
;************************************************************************
; SUBROUTINE TO SUBTRACT TWO BCD NUMBERS OF LENGTH 120
; uses a0,a1, d1
;************************************************************************
subem:
moveq #65,d1 ;31 one for final carry
lea accum1+65,a0
lea accum2+65,a1
move.b #4,ccr ;x=0 and z=1
keepsubbing:
sbcd -(a0),-(a1)
dbra d1,keepsubbing
rts
;************************************************************************
; SUBROUTINE TO MULTIPLY TWO NUMBERS OF COMBINED LENGTH 120
; uses d0,d1,d2, a0,a1,a2,a4 for calling shift_l
;************************************************************************
multiply:
lea accum2,a2
lea accum3,a1
bsr exchange ;so answer will end up in accum2
retry:
lea accum1,a1
move #64,d2
M0:
tst.b (a1)+
dbne d2,M0
cmp.b #-1,d2
bne.s Mzero
rts
Mzero:
lsl #1,d2
subq #1,a1
cmp.b #9,(a1)
bhi.s even_one
subq #1,d2
even_one ;d2 has len accum1
move.b d2,div1
lea accum3,a1
move #64,d0
M1:
tst.b (a1)+
dbne d0,M1
cmp #-1,d0
bne.s M2
rts
M2: ;d0 has length of accum3.
lsl #1,d0
subq #1,a1
cmp.b #9,(a1)
bhi.s even_two
subq #1,d0
even_two
move.b d0,div2
add d0,d2
cmp #121,d2
bcs.s not_too_big
tst firstdec
beq error
sub #1,firstdec
lea accum1,a4
bsr shift_r
bra retry
not_too_big:
btst #0,d0
beq.s notset ;if set, we did a sub on an even number
addq #1,d0 ;4 lines backaways
notset
lsr #1,d0
subq #1,d0 ;to adjust for decrement and branch
M3:
move.b (a1),d2 ;d2 contains first or odd lh digit
swap d2
move.b (a1)+,d2 ;after swap, second or even lh digit
lsr #4,d2
andi #$000f,d2
subq #1,d2
bmi.s nogo
lea accum2+63,a4
bsr shift_l
goagain:
lea accum1+64,a0
lea accum2+64,a2
moveq #61,d1
move.b #4,ccr ;x=0 and z=1
keepitup:
abcd -(a0),-(a2)
dbra d1,keepitup
dbra d2,goagain
bra secondhalf
nogo:
lea accum2+63,a4
bsr shift_l
secondhalf:
swap d2
andi #$000f,d2
subq #1,d2
bmi.s nogo2
lea accum2+63,a4
bsr shift_l
gogo:
lea accum1+64,a0
lea accum2+64,a2
moveq #61,d1
move.b #4,ccr ;x=0 and z=1
keep_on:
abcd -(a0),-(a2)
dbra d1,keep_on
dbra d2,gogo
bra decrement
nogo2:
lea accum2+63,a4
bsr shift_l
decrement:
dbra d0,M3
move dec,d1
move firstdec,d2
add d1,d2
move d2,res_pts
move.b firstneg,d2
cmp.b negative,d2
beq.s exit
move.b #1,res_sign
exit:
rts
;************************************************************************
; SUBROUTINE TO DIVIDE TWO NUMBERS OF LENGTH 120
; uses a0,a1,a2,a3, d0,d1,d2 shift_l uses d4,d5,d6, a4,a5
;************************************************************************
divide:
lea accum2+63,a3 ;later move this to top of function
lea accum3,a1
lea accum2,a2
bsr exchange
lea accum1,a0
lea accum1+63,a4
move #$80,d0
align_1_l:
bsr shift_l
cmp.b #1,(a0)
dbhi d0,align_1_l
bmi error
move.b d0,div1
lea accum3+63,a4
lea accum3,a0
move #$80,d0
align_3_l:
bsr shift_l
cmp.b #1,(a0)
dbhi d0,align_3_l
bmi error
move.b d0,div2
moveq #120,d2
lea accum2,a4
Dzero: ; don't ever use labels D1, D2, etc.
moveq #-1,d0 ; It won't cry error but crash.
do_it_again:
addq #1,d0
lea accum1+64,a0
lea accum3+64,a2
moveq #63,d1
move.b #4,ccr ;x=0 and z=1
redo:
sbcd -(a2),-(a0)
dbra d1,redo
bcc do_it_again
and #$f,d0
or.b d0,(a3)
lea accum2+63,a4
bsr shift_l
lea accum1+64,a0 ;after carry sets add one back
lea accum3+64,a2
moveq #63,d1
move.b #4,ccr
Dthree:
abcd -(a2),-(a0)
dbra d1,Dthree
lea accum3,a4
bsr shift_r
dbra d2,Dzero
move #121,res_pts
;**************figure out points
move.b div1,d1 ;div1 and div2 contain number of places in
move.b div2,d2 ;operators.
ext d1 ;
ext d2 ;
cmp d1,d2 ;
bhi.s toohigh ;if div2>div1 then move point to right
sub d2,d1 ;by subtracting difference from res_pts
sub d1,res_pts ;
bra CkDec ;
toohigh: ;
sub d1,d2 ;if div1>div2 do the opposite. Add to res_pts
add d2,res_pts ;to move point to left
CkDec: ;
move firstdec,d1 ;if dec>firstdec then move point to right
move dec,d2 ;
cmp d1,d2 ;
bhi.s tohigh ;
sub d2,d1 ;if firstdec>dec move point to left
add d1,res_pts ;
bra CkSgn ;
tohigh: ;
sub d1,d2 ;
sub d2,res_pts ;
;*******************************
CkSgn:
move.b firstneg,d2
cmp.b negative,d2
beq.s EndOfDiv
move.b #1,res_sign
EndOfDiv:
rts
;************************************************************************
; SUBROUTINE TO FIND OUT WHAT THE HELL SIGN TO USE ON ADD AND SUBTRACT
; uses a0,a1 makes use of d0 from 'biggest'
;************************************************************************
; oper first second do result
;-----------------------------------------
; + + + add +
; - + - add +
; + - - add -
; - - + add -
; + + - sub biggest
; + - + sub biggest
; - + + sub if 1 big + if 2 big -
; - - - sub if 1 big - if 2 big +
WhatTheHell:
bsr align ;first, align points.
cmp.b #43,fun ;plus
bne.s on
op:
tst.b firstneg
beq.s op1p
op1n:
tst.b negative
beq op1n2p
op1n2n: ;always minus
move.b #1,res_sign
bsr addemup
rts
on:
tst.b firstneg
beq on1p
on1n:
tst.b negative
beq on1n2p
on1n2n: ;if 1 big then -
bsr biggest
cmp.b #1,d0
bne it_is_a_plus
move.b #1,res_sign
lea accum1,a1
lea accum2,a2
bsr exchange
it_is_a_plus:
bsr subem
rts
op1p:
tst.b negative
beq op1p2p
op1p2n: ;sign of the biggest
bsr biggest
cmp.b #2,d0
beq cecond_sgn
fust_sgn:
lea accum1,a1
lea accum2,a2
bsr exchange
move.b firstneg,res_sign
bsr subem
rts
cecond_sgn
move.b negative,res_sign
bsr subem
rts
on1p
tst.b negative
beq.s on1p2p
on1p2n: ;always plus
bsr addemup
rts
on1p2p: ;if 2 big then - dont exg
bsr biggest
cmp.b #2,d0
bne.s two_small
move.b #1,res_sign
bra.s two_big
two_small:
lea accum1,a1
lea accum2,a2
bsr exchange
two_big:
bsr subem
rts
on1n2p: ;always minus
move.b #1,res_sign
bsr addemup
rts
op1p2p: ;always plus
bsr addemup
rts
op1n2p: ;sign of the biggest
bsr biggest
cmp.b #2,d0
beq snd_sgn
fst_sgn:
lea accum1,a1
lea accum2,a2
bsr exchange
move.b firstneg,res_sign
bsr subem
rts
snd_sgn
move.b negative,res_sign
bsr subem
rts
;************************************************************************
; SUBROUTINE TO PACK STRING INTO BCD FORM
; uses a3,a4, d0,d1,d2 input accum accumX+63 in a4 outputs to accum.
; calls shift_l which uses a5,d4,d5,d6
;************************************************************************
pack:
lea buildstr,a3
moveq #$30,d1
moveq #0,d2
swap d2 ;Try to use swapping instruction.
moveq #61,d2 ;just for fun
eatzeros:
subq.b #1,d2
bne.s continue
swap d2
move d2,dec ;count of dec points from rh side.
rts
continue:
move.b (a3)+,d0
tst.b d0
beq eatzeros
cmp.b #',',d0
beq eatzeros
cmp.b #'+',d0
beq eatzeros
cmp.b #'-',d0
beq eatzeros
cmp.b #'.',d0
beq.s decimal
bsr shift_l
tst.b havept
beq.s no_pt
swap d2
addq #1,d2
swap d2
no_pt:
sub.b d1,d0
and.b #$f,d0
or.b d0,(a4)
bra eatzeros
decimal:
move.b #1,havept
bra eatzeros
;************************************************************************
; SUBROUTINE TO REMOVE TRAILING ZEROS FROM RESULT
; uses d0,d1,d2 a4,a0 input accum address in a4
;************************************************************************
trail:
lea accum2,a4 ;for sub shift_r
movea.l a4,a0
adda.l #63,a0
move #127,d1
T1:
tst res_pts ;if we don't have a point we can't
beq.s out ;remove zeros
move.b (a0),d0
andi.b #$f,d0
bne.s out
sub #1,res_pts ;decrease point count
bsr shift_r
dbra d1,T1
out:
rts
;************************************************************************
; SUBROUTINE TO UNPACK BCD BACK TO ASCII STRING WITH COMMAS AND DEC POINT
; uses d0,d1,d2,d3,d7 a1,a2 didn't do commas yet
;************************************************************************
unpack:
move #0,d7
bsr trail
lea accum2,a1
lea buildstr,a2
moveq #64,d0
U2:
tst.b (a1)+
dbne d0,U2 ;dbcc checks cc before dec-ing.
cmp #-1,d0
bne.s notazero
move #1,chars ;if d0 counts down to -1, put 1 in
move.b #$30,(a2) ;chars and '0' in buildstr
rts
notazero:
lsl #1,d0
subq #1,a1
cmp.b #9,(a1)
bhi.s U3
subq #1,d0
U3:
move d0,chars ;all that for no. of places in d0
move res_pts,d1 ;also a1 is pointing to high byte
;points in result from right
move.b res_sign,d2
beq.s U5
moveq #45,d2
move.b d2,(a2)+
U5:
cmp d1,d0 ;d1 has res_pts d0 has chars
bhi.s no_first_pt ;leave bhi it is correct
bsr insert_point
cmp d1,d0
beq.s no_first_pt
U6:
move.b #$30,(a2)+
add #1,chars ;need to increase chars printed
cmp #$78,chars
bcs.s dontmess
sub #1,chars
subq #1,d1
subq #1,d0
dontmess:
cmp chars,d1
bhi U6
no_first_pt
move chars,d3
sub d1,d3 ;difference bet res_pts & chars if
;chars is larger or equal
btst #0,d0 ;odd or even no of bytes?
bne odd
even:
move.b (a1),d2
lsr.b #4,d2
andi.b #$f,d2
add.b #$30,d2
move.b d2,(a2)+
subq #1,d0
beq.s U4
subq #1,d3
bne.s odd
bsr insert_point
odd:
move.b (a1)+,d2 ;pick up byte
andi.b #$f,d2
add.b #$30,d2
move.b d2,(a2)+
subq #1,d0
beq.s U4
subq #1,d3
bne even
bsr insert_point
bra even
U4:
add d7,chars
rts
insert_point:
move #1,d7
move.b #46,(a2)+
rts
;************************************************************************
; SUBROUTINE TO FIND THE BIGGEST
; uses a3,a5, d0, no inputs. output 1 if 1 larger. 2 if 2 -1 neither
;************************************************************************
biggest:
lea accum1,a3
lea accum2,a5
moveq #63,d0
repeat:
cmp.b (a3)+,(a5)+
bhi.s second
bcs.s first
dbne d0,repeat
rts
first:
moveq #1,d0
rts
second:
moveq #2,d0
rts
;************************************************************************
; SUBROUTINE SHIFT AN ACCUMULATOR LEFT FOUR BITS
; uses a4,a5, d4,d5,d6 input a4 with accum address+63 no outputs.
;************************************************************************
shift_l:
moveq #3,d5
SL1:
movea.l a4,a5 ;a4 already has accum(1 or 2) addr+63
subq.l #3,a5 ;Need accum+60 in a5
move.l (a5),d6
asl.l #1,d6
move.l d6,(a5)
moveq #14,d4
SL2:
move.l -(a5),d6
roxl.l #1,d6
move.l d6,(a5)
dbra d4,SL2
dbra d5,SL1
rts
;************************************************************************
; SUBROUTINE SHIFT AN ACCUMULATOR RIGHT FOUR BITS
; uses a4,a5, d4,d5,d6 input a4 with accum address+00 no outputs.
;************************************************************************
shift_r:
moveq #3,d5
SHR1:
movea.l a4,a5
move.l (a5),d6
lsr.l #1,d6
move.l d6,(a5)+
moveq #14,d4
SHR2:
move.l (a5),d6
roxr.l #1,d6
move.l d6,(a5)+
dbra d4,SHR2
dbra d5,SHR1
rts
;************************************************************************
; SUBROUTINE EXCHANGE TWO ACCUMULATORS
; uses a1,a2, d0,d1
;************************************************************************
exchange:
moveq.b #15,d0
E1:
move.l (a1),d1
move.l (a2),(a1)+
move.l d1,(a2)+
dbra d0,E1
rts
;************************************************************************
; SUBROUTINE TO PRINT THE BUILDSTRING ARRAY (or anything)
; uses a1,a0,a5,a6, d0,d1,d2,d3 input addr in a0 # of chars in chars
;************************************************************************
print_bs: ;prints the first 60 characters on
moveq #0,d2 ;one line and the next 60 on the
move chars,d3 ;next line.
add.b havept,d3
add.b res_sign,d3
cmp #61,d3
bcs.s smaller
move d3,d2
subi #60,d2
move #60,d3
smaller:
movea.l rp,a1
moveq #5,d0
move printy,d1
movea.l GBase,a6
jsr _LVOMove(a6)
move d3,d0
jsr _LVOText(a6)
tst d2
beq gohome
movea.l rp,a1
moveq #5,d0
addi #9,printy
move printy,d1
jsr _LVOMove(a6)
lea buildstr+60,a0
move d2,d0
cmp #60,d0
bcs.s sixty
move #60,d0
sixty:
jsr _LVOText(a6)
gohome:
rts
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DATA DATA
GName:
dc.b 'graphics.library',0
IntuitionName:
dc.b 'intuition.library',0
title:
dc.b 'THE NATIONAL DEBT A 120 place calculator by Martin Gitelson.',0
text1:
dc.b '1',0
text2:
dc.b '2',0
text3:
dc.b '3',0
text4:
dc.b '4',0
text5:
dc.b '5',0
text6:
dc.b '6',0
text7:
dc.b '7',0
text8:
dc.b '8',0
text9:
dc.b '9',0
text10:
dc.b '0',0
text11:
dc.b '.',0
text12:
dc.b ",",0
text13:
dc.b 'C',0
text14:
dc.b 'AC',0
text15:
dc.b '*',0
text16:
dc.b '/',0
text17:
dc.b '+',0
text18:
dc.b '-',0
text19:
dc.b '<',0
text20:
dc.b '=',0
IDCMPFlags EQU CLOSEWINDOW|GADGETUP
OtherFlags EQU WINDOWCLOSE|SMART_REFRESH|ACTIVATE|WINDOWDRAG|WINDOWDEPTH
blanks:
dc.b ' ',0
errstr:
dc.b 'ERROR',0
EVEN
NewWdw:
dc.w 0,50,640,74
dc.b 2,1
dc.l IDCMPFlags
dc.l OtherFlags
dc.l Gad1 ;Firstgadget
dc.l 0
dc.l title
dc.l 0
dc.l 0
dc.w 640,73,640,73
dc.w WBENCHSCREEN
Gad1:
dc.l Gad2 ;struct Gadget *NextGadget
dc.w 490 ;LeftEdge
dc.w 12 ;TopEdge
dc.w 26 ;Width
dc.w 16 ;Height
dc.w GADGHCOMP ;Flags
dc.w RELVERIFY ;Activation
dc.w BOOLGADGET ;GadgetType
dc.l Border1 ;APTR GadgetRender
dc.l 0 ;APTR SelectRender
dc.l Textstruct1 ;struct IntuiText *GadgetText
dc.l 0 ;LONG MutualExclude
dc.l 0 ;APTR SpecialInfo
dc.w 49 ;USHORT GadgetID
dc.l 0 ;APTR UserData
Gad2:
dc.l Gad3
dc.w 520,12,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct2,0,0
dc.w 50
dc.l 0
Gad3:
dc.l Gad4
dc.w 550,12,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct3,0,0
dc.w 51
dc.l 0
Gad4:
dc.l Gad5
dc.w 490,27,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct4,0,0
dc.w 52
dc.l 0
Gad5:
dc.l Gad6
dc.w 520,27,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct5,0,0
dc.w 53
dc.l 0
Gad6:
dc.l Gad7
dc.w 550,27,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct6,0,0
dc.w 54
dc.l 0
Gad7:
dc.l Gad8
dc.w 490,42,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct7,0,0
dc.w 55
dc.l 0
Gad8:
dc.l Gad9
dc.w 520,42,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct8,0,0
dc.w 56
dc.l 0
Gad9:
dc.l Gad10
dc.w 550,42,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct9,0,0
dc.w 57
dc.l 0
Gad10:
dc.l Gad11
dc.w 490,57,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct10,0,0
dc.w 48
dc.l 0
Gad11:
dc.l Gad12
dc.w 520,57,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct11,0,0
dc.w 46
dc.l 0
Gad12:
dc.l Gad13
dc.w 550,57,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct12,0,0
dc.w 44
dc.l 0
Gad13:
dc.l Gad14
dc.w 580,12,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct13,0,0
dc.w 13
dc.l 0
Gad14:
dc.l Gad15
dc.w 610,12,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct14,0,0
dc.w 14
dc.l 0
Gad15:
dc.l Gad16
dc.w 580,27,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct15,0,0
dc.w 42
dc.l 0
Gad16:
dc.l Gad17
dc.w 610,27,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct16,0,0
dc.w 47
dc.l 0
Gad17:
dc.l Gad18
dc.w 580,42,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct17,0,0
dc.w 43
dc.l 0
Gad18:
dc.l Gad19
dc.w 610,42,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct18,0,0
dc.w 45
dc.l 0
Gad19:
dc.l Gad20
dc.w 580,57,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct19,0,0
dc.w 19
dc.l 0
Gad20:
dc.l 0
dc.w 610,57,26,16,GADGHCOMP,RELVERIFY,BOOLGADGET
dc.l Border1,0,Textstruct20,0,0
dc.w 61
dc.l 0
Textstruct1: ;size=20
dc.b 2,1
dc.w 0,10,5
dc.l 0,text1,0
Textstruct2:
dc.b 2,1
dc.w 0,10,5
dc.l 0,text2,0
Textstruct3:
dc.b 2,1
dc.w 0,10,5
dc.l 0,text3,0
Textstruct4:
dc.b 2,1
dc.w 0,10,5
dc.l 0,text4,0
Textstruct5:
dc.b 2,1
dc.w 0,10,5
dc.l 0,text5,0
Textstruct6:
dc.b 2,1
dc.w 0,10,5
dc.l 0,text6,0
Textstruct7:
dc.b 2,1
dc.w 0,10,5
dc.l 0,text7,0
Textstruct8:
dc.b 2,1
dc.w 0,10,5
dc.l 0,text8,0
Textstruct9:
dc.b 2,1
dc.w 0,10,5
dc.l 0,text9,0
Textstruct10:
dc.b 2,1
dc.w 0,10,5
dc.l 0,text10,0
Textstruct11:
dc.b 2,1
dc.w 0,10,5
dc.l 0,text11,0
Textstruct12:
dc.b 2,1
dc.w 0,10,5
dc.l 0,text12,0
Textstruct13:
dc.b 3,1
dc.w 0,10,5
dc.l 0,text13,0
Textstruct14:
dc.b 3,1
dc.w 0,6,5
dc.l 0,text14,0
Textstruct15:
dc.b 1,1
dc.w 0,10,5
dc.l 0,text15,0
Textstruct16:
dc.b 1,1
dc.w 0,10,5
dc.l 0,text16,0
Textstruct17:
dc.b 1,1
dc.w 0,10,5
dc.l 0,text17,0
Textstruct18:
dc.b 1,1
dc.w 0,10,5
dc.l 0,text18,0
Textstruct19:
dc.b 2,1
dc.w 0,10,5
dc.l 0,text19,0
Textstruct20:
dc.b 1,1
dc.w 0,10,5
dc.l 0,text20,0
Border1:
dc.w 0 ; 0 LeftEdge
dc.w 0 ; 2 TopEdge
dc.b 1 ; 4 FrontPen
dc.b 2 ; 5 BackPen
dc.b 0 ; 6 DrawMode
dc.b 6 ; 7 Count
dc.l Vectors1 ; 8 XY
dc.l Border2 ; 12 NextBorder
Border2:
dc.w 0,0
dc.b 2,3,0,6
dc.l Vectors2,0
Vectors1:
dc.w 0,15,0,0,25,0,25,1,1,1,1,14
Vectors2:
dc.w 25,0,25,15,0,15,1,14,24,14,24,1
BSS BSS
EVEN
parksp
ds.l 1
IntBase:
ds.l 1
GBase:
ds.l 1
Wdw:
ds.l 1
userport:
ds.l 1
WBenchMsg:
ds.l 1
class
ds.l 1
rp:
ds.l 1
sigmask:
ds.l 1
buildstr:
ds.b 128
accum1:
ds.b 64
accum2:
ds.b 64
accum3:
ds.b 64
printy:
ds.w 1 ;20 bytes follow to be cleared
dec:
ds.w 1
firstdec:
ds.w 1
res_pts:
ds.w 1
chars:
ds.w 1
div1:
ds.b 1
div2:
ds.b 1
point:
ds.b 1
havept:
ds.b 1
negative:
ds.b 1
firstneg:
ds.b 1
res_sign:
ds.b 1
fun:
ds.b 1
eq: ;park equals sign here for printing
ds.b 1
fun2:
ds.b 1
pad:
ds.b 6 ;so clear won't affect something else
END