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