;
; radix takes a decimal number and optionally converts it to another base.  At any stage during input,
; entering B,H or O causes the output to be in Binary, Hex or Octal.  If no letter is encountered,
; the input is echoed.  Only digits and the radix letter in the input are processed, any other character
; is ignored.  Although the action appears trivial, internally the input number is converted to binary
; then back to digits in the selected radix for output.  General multiply and divide routines are used,
; so could be adapted to other uses.  The program is not intended to be very useful, but 'proof of
; concept'.  Note that quite large numbers can be processed using the bignum.vbs engine, but be prepared
; for a wait especially if converting to binary.
;
*0
	finish
*4
	inctl
	inchar
	ouctl
	ouchar
*8
	lookup=-1,2,-1,-1,-1,-1,-1,16,-1,-1,-1,-1,-1,-1,8
;
; work space for main
;
	numrx
	numchr
	numwk
	numlen
	numcc=1
;
; work space for multiply
;
	mulA	; multiply A
	mulB	; by B
	mulres	; result
	mulwk	; work area
	mulshf	; count of shifts
	mulmsk	; mask
	mulmcy	; copy of mask
;
; work space for divide
;
	divA	; divide B into A
	divB
	divwk1
	divwk2
	divBln	; length of B
	divmsk	; mask
	divshf	; shift count
	divres	; result
*99
	stackptr=-99 ; value is -topofstack
*1000
:main	0,numcc,numfin ; if no input, finish
;
; clear top of stack
;
	1,stackptr ; pUsh zero onto the stack
	numUa1,numUa1 ; clear all the places
	numUa2,numUa2 ; where the stack pointer goes 
	stackptr,numUa1 ; then put in the stack pointer
	stackptr,numUa2
	:numUa1,:numUa2 ; clear top of stack
	numcc,numcc ; count of chars on input line
	ouchar,ouchar ; prompt '>'
	-62,ouchar
	0,ouctl
	numwk,numwk ; assume decimal output
	10,numwk
:num01	numrx,numrx ; store the output base
	numwk,numrx
:num02	numchr,numchr ; get a char
	0,inctl
	inchar,numchr ; note numchr is negative inchar
	-14,numchr,num03 ; if it was -13 (cr), now +1
	1,numchr,num08 ; and now 0, skip directly to output
	-1,numchr ; adjust back to -14
:num03	-1,numcc ; add to input chars count
	-44,numchr,num04 ; digits should be positive, letters negative
	10,numchr,num06 ; this makes digits 0 to -9
	numchr,numchr,num02 ; all others ignored
:num04	-54,numchr,num02 ; ignore letters more than lower case o
	15,numchr,num05 ; branch on lower case a thru o
	17,numchr,num02 ; ignore between uppercase O and lower case a
	15,numchr,num05 ; branch on upper case A thru O
	numchr,numchr,num02 ; ignore the rest
; both A->O and a->o are now 0-> -14.  Use this to index into a table
:num05	lookp,lookp ; zero the lookup pointer
	$lookup,lookp ; put in the table start
	numchr,lookp ; add in the character offset
	numwk,numwk 
	:lookp,numwk,num01 ; retrieve the lookup - only radix are negative
	numchr,numchr,num02 ; ignore the rest
;
; here if the input was a digit, now converted to 0 thru -9
; push 10 onto stack and multiply, then add the new digit
;
:num06	1,stackptr 
	numUb1,numUb1
	numUb2,numUb2 ; clear all the places
	numUb3,numUb3 ; where the stack pointer goes 
	stackptr,numUb1 ; then put in the stack pointer
	stackptr,numUb2
	stackptr,numUb3
	:numUb1,:numUb2 ; clear top of stack
	10,:numUb3 ; and push the multiplier
;
; set up return address and jump to multiply
;
	mulret,mulret
	$num07,mulret
	numwk,numwk,mul
; return here, result is top of stack
:num07	numchr,numwk ; -- add the new digit --
	numph6,numph6 ; to where the stack pointer points 
	stackptr,numph6 ; plug in the stack pointer
	numwk,:numph6 ; and add the latest digit
	35,numchr ; put it back the way it was for output
:num08	13,numchr
:num09	ouchar,ouchar ; and send it to output
	numchr,ouchar
	0,ouctl
; test for end of input
	-14,numchr,num02 ; if it was -13, now +1
	1,numchr,num10 ; if it was -13, now 0
	numchr,numchr,num02
:num10	numlen,numlen ; number of digits on stack after divide
;
; to divide, stack dividend, then divisor.  The quotient is returned top
; of stack, remainder underneath.  To convert binary to radix repeatedly 
; push radix onto stack and divide until the quotient is zero.  All
; the remainders are stacked in the right order for output.
;
:num11	-1,numlen
	1,stackptr 
	numUc1,numUc1
	numUc2,numUc2 ; clear all the places
	numUc3,numUc3 ; where the stack pointer goes 
	stackptr,numUc1 ; then put in the stack pointer
	stackptr,numUc2
	stackptr,numUc3
	:numUc1,:numUc2 ; clear top of stack
	numrx,:numUc3 ; and push the divisor
	divret,divret
	$num12,divret
	numwk,numwk,div
;
; test top of stack.  If zero, no need to divide more
;
:num12	numOa1,numOa1 ; pOp remaining number
	stackptr,numOa1
	:numOa1,numwk,num13 ; test top of stack for zero
	numwk,numwk,num11 ; not zero, divide again
:num13	-1,stackptr ; clear the result of zero off the stack
:num14	ouchar,ouchar
	numOb1,numOb1 ; pOp remaining number
	stackptr,numOb1
	-1,stackptr
	:numOb1,ouchar ; ready to print it
	9,ouchar,num15 ; if 0 thru 9, now -9 thru zero
	-7,ouchar ; drop thru if bigger than 9 - add 7 to make a hex char
:num15	-57,ouchar ; add back the 9, and another 48 to make it ASCII
	0,ouctl
	1,numlen,num16 ; subtract 1 from count of stacked digits
	numwk,numwk,num14 ; go back if more to print
:num16	ouchar,ouchar ; print end of line
	-13,ouchar
	0,ouctl
	numchr,numchr,main
:numfin	finish,finish,finish
;
; multiply
;
:mul	mulpp1,mulpp1 ; pop B
	stackptr,mulpp1
	mulB,mulB
	:mulpp1,mulB
	-1,stackptr
;
	mulpp2,mulpp2 ; pop A
	stackptr,mulpp2
	mulA,mulA
	:mulpp2,mulA ; lazy - leave stack pointer here to push mulres
;
	mulshf,mulshf ; zero count of shifts
	mulmsk,mulmsk
	-1,mulmsk ' mask = 1
	mulwk,mulwk

:mul01	mulmsk,mulwk
	mulmcy,mulmcy
	mulwk,mulmcy ; mask copy = mask
	mulB,mulmcy,mul02 ; keep increasing mask *2 until mask > B
; 
	mulres,mulres,mul03 ; conveniently need to clear result
:mul02	mulwk,mulmsk ; mask = mask * 2
	-1,mulshf ; shift++
	mulwk,mulwk,mul01 ; go again
;
; here - mask bigger than B
;
:mul03	mulwk,mulwk
:mul04	mulres,mulwk
	mulwk,mulres ; result = result * 2
	mulwk,mulwk
	mulB,mulwk
	mulwk,mulB ; B = B * 2
	mulwk,mulwk
	mulmsk,mulwk
	mulmcy,mulmcy
	mulwk,mulmcy ; mask copy = mask
	mulB,mulmcy,mul05 ; 
	mulwk,mulwk,mul06 ; B < mask, don't add
:mul05	mulmsk,mulB ; unset B significant bit
	mulwk,mulwk
	mulA,mulwk ; and add A to mulres
	mulwk,mulres
:mul06	1,mulshf,mul07 ; shift = shift - 1
	mulwk,mulwk,mul04 ; shifts > 0, go again
;
; push result onto stack
;
:mul07	mulph1,mulph1 ; clear all the places
	mulph2,mulph2 ; where the stack pointer goes 
	mulph3,mulph3
	stackptr,mulph1 ; then put in the stack pointer
	stackptr,mulph2
	stackptr,mulph3
	:mulph1,:mulph2 ; clear top of stack
	mulres,:mulph3 ; and push the result
;
:mul08	mulwk,mulwk,:mulret ; and return
;
; Divide
;
:div	divpp1,divpp1 ; pop B
	stackptr,divpp1
	divB,divB
	:divpp1,divB
	-1,stackptr
;
	divpp2,divpp2 ; pop A
	stackptr,divpp2
	divA,divA
	:divpp2,divA ; lazy - leave stack pointer here to push remainder
;
	divmsk,divmsk ; initialise variables
	-1,divmsk ; mask = 1
	divBln,divBln,div02 ; B length = 0
; determine size of B
:div01	-1,divBln ; B length++
	divwk1,divwk1 ; mask = mask * 2
	divmsk,divwk1
	divwk1,divmsk
:div02	divwk1,divwk1
	divmsk,divwk1
	divwk2,divwk2
	divwk1,divwk2 ; divwk2 = copy of mask
	divB,divwk2,div01 ; if mask <= B, shift left
;
	divshf,divshf,div04 ; B shifts = 0
; shift B to make most significant B bit = most significant A bit if len A > len B
:div03	divwk1,divwk1 ; B = B + B (ie shift B left)
	divB,divwk1
	divwk1,divB
	divwk1,divwk1 ; shift mask
	divmsk,divwk1
	divwk1,divmsk
	-1,divshf ; shift = shift + 1
:div04	divwk1,divwk1
	divmsk,divwk1
	divwk2,divwk2
	divwk1,divwk2 ; divwk2 = mask
	divA,divwk2,div03 ; if mask <= A goto div03
;
; the first part of divide : A - B (shifted or unshifted)
; and assume B <= A (fixed up in third part)
;
	divB,divA
;
; add 1 to A.  This is done because the test is always < or equal to zero
; but we are happy with zero and don't want it included.  Adding 1 at this
; point overcomes this, otherwise we would need to test explicitly for
; zero which would make for a lot more instructions
;
	-1,divA
	divres,divres
	-1,divres ; divres = 1
	0,divshf,div08 ; branch if no shifts required
;
; second part of divide: shift A, borrow if necessary
; (logic needs some explanation)
;
:div05	divwk1,divwk1 ; shift result left
	divres,divwk1
	divwk1,divres
	divwk1,divwk1 ; shift A left
	divA,divwk1
	divwk1,divA,div06 ; jump if adding B to A
	divB,divA ; A = A - B
	-1,divres ; result++
	divwk1,divwk1,div07
:div06	divwk1,divwk1 ; A = A + B
	divB,divwk1
	divwk1,divA
	1,divres ; result--
;
:div07	1,divshf,div08 ; skip if no more shift needed
	divwk1,divwk1,div05 ; otherwise go back for next shift
;
; last part of divide: result needs adjusting if B > A
; because we assumed B <= A and borrowed when it wasn't
;
:div08	0,divA,div09
	divwk1,divwk1,div10
:div09	1,divres ; result - 1
	divwk1,divwk1 ; A + B
	divB,divwk1
	divwk1,divA
;
; the remainder is in A, but A may have been shifted
; so a 'barrel roll' puts the remainder in its place
;
:div10	1,divmsk
:div11	divwk1,divwk1 ; shift A left
	divA,divwk1
	divwk1,divA,div12 ; if A <= 0 skip
	divmsk,divA ; A = A - mask
	divwk1,divwk1,div13
:div12	divwk1,divwk1
	divmsk,divwk1
	divwk1,divA ; A = A + mask
:div13	1,divBln,div14 ; repeat for length of B times
	divwk1,divwk1,div11
:div14	0,divA,div15 ; 
	divwk1,divwk1,div16
:div15	divwk1,divwk1
	divmsk,divwk1
	divwk1,divA
:div16	1,divA ; subtract the 1 we added way back now all the tests are done
;
; push remainder, result onto stack
;
	divp1a,divp1a
	divp1b,divp1b
	divp1c,divp1c
	stackptr,divp1a
	stackptr,divp1b
	stackptr,divp1c
	:divp1a,:divp1b
	divA,:divp1c
	1,stackptr
;
	divp2a,divp2a
	divp2b,divp2b
	divp2c,divp2c
	stackptr,divp2a
	stackptr,divp2b
	stackptr,divp2c
	:divp2a,:divp2b
	divres,:divp2c
; and return
	divwk1,divwk1,:divret