;------------------------------------------------------------------------
;
;		Copyright 2010 Intergraded Logic Systems
;                  Source Code is Copyright Stephen J. Carden
;
;
;			Please do not share this source!
;------------------------------------------------------------------------
;       (General hard disk formatter for real.dos SpartaDOS v1.0 
;
;------------------------------------------------------------------------
;                         Real.dos 
;		This program is to replace hdfmtdir.COM with
;		      		fmtdir.com
;
;			Code History.
;
;Init design,   	10/28/2005	sjc
;	updated      	10/30/2005	sjc
;	updated		12/30/2008	sjc
;		Holding down the "select key will force 65535 sectors
;		changed name from hdfmtdir to fmtdir
;
;Last updated		08/29/2012	sjc
;		changed to call from $e459 to 'LSIO'
;
;
;
;       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;------------------------------------------------------------------------
; Notes: o This source code MAY NOT be placed for download on any BBS's!
;        o "mea" is a macro that loads the address of the first field
;          into the pointer specified by the second field.
;------------------------------------------------------------------------
; Assembler:  MADMAC (tm) ST Cross Assembler (Atari Corp)
;             XASM   st and IBM VERSIONS
;------------------------------------------------------------------------

com_file_name:		.macro
;			dc.b   13,"filename.ext",$9b
			dc.b   12,"Fmtdir.com  ",$9b
			.endm

;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; File revision history. Version Number in hex
;
file_ver:		equ   $18
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; the Month in dec for the first time this revision 
;was compiled
;
c_month:		equ   10
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; the day in dec for the first time this revision 
;was compiled
c_day:			equ   12
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; the year in dec for the first time this revision 
;was compiled
c_year:			equ   2012
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Type of compiler used in program
;
; 0 = unknown Compiler
; 1 = xasm
; 2 = mac_65
; 3 = basic
; 4 = compiled basic xl
; 5 = C65
; 6 = Action
;
; We can add more as time goes on!
;
;
;
xasm:			equ	1
mac_65:			equ	2 
basic:			equ	3
basicxl:		equ	4
c65:			equ	5
action:			equ	6

file_compiler:		equ	xasm
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; is this relocatable code ?
; anyother value other than 1 or 2 would be unknown
r..yes:			equ	1
r..no:			equ	2
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Gotta define if it can be relocated
l_relocatable:		equ	r..no
;
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Gotta define our Header control Byte
;$ff =bypass intro
;$15 = Bypass Dos check
r..crl:			equ	$7d
r..crlf:		equ	$9b
r..space:		equ	$20
r..bypassDOS:		equ	$15
r..bypass:		equ	$ff

l_frstscreenbyte:	equ	r..space
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; The language the output file is in. 
;
;
; 0	=	Undifined
; 1	=	English
; 2	=	German
;
r..language:		equ	1
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
;

			.include	equates
			.include	globals
			.include	macros
;
         		.org  $4000				;   Where the program Starts in memory.
;

win_start:
header_info:
			.include	header			; this reads info out of the header and displays to screen
								; let'S see if anything is on the parm line
			ldy	#LBUF    			; loading the offset into comtab
mux_1a:			lda	(comtab),y
			cmp	#' '				; looking for the space in the parm line
			beq	mux_1b 				; got the space let'S see if there is anything we can use
			cmp	#$9b				; nope!!  no parm
			beq	.a				; let'S see if they are playing with the consol
			iny
			jmp	mux_1a
.a:			jmp	start_it			; go to format code

mux_1b:
			ldx	#$00
			iny					; let'S get one more byte of contab+63,y

.a:			lda	(comtab),y			; well got a byte
			jsr	upcase 				; let'S make sure it is upper case
			cmp	#$9b
			beq	.noparm
			cmp	#'D'
			beq	.got_d				; going to the help menu
			inx
			stx	.holdx
			iny
			jmp	.a

.holdx:			dc.b	0

.noparm:		jmp	START_IT			; format with a menu

.got_d:			iny
			lda	(comtab),y			; well got a byte
			cmp	#'1'
			bcc	.noparm
			cmp	#'9'+1
			bcs	.noparm
			sta	.myhold
			sbc	#47				; turn it into a hex #
			STA	DUNIT
			iny
			lda	(comtab),y
			jsr	upcase
			cmp	#'Q'
			bne	.noparm
			sta	bypass_menu
			lda	.myhold
			jmp	start_it


.myhold:		dc.b	0			
;
;-----------------------------
;CHANGES THE CHARTER TO UPCASE
;-----------------------------
upcase:
			cmp	#$61
			bcc	.a
			cmp	#$7a
			bcs	.a
			sbc	#$1f
.a:			rts



	 		jmp START_IT  				;Goto the reset of the program


;			.org	$4560
Split:
BOOTI:
;###############################################################################
;
;	$3000
;       ==================== 
;       Stage 1 boot program 
;       ==================== 

initz1:
;
BOOTS:
		dc.b	$00
		dc.b	$03
		dc.b	$00
		dc.b	$30
		cpx	#$07
w_f01:		JMP	LOADER
;
;sector map main directory
;+9:
		dc.w	0
; Total number of sectors on disk
;+11:
		dc.w	0
; Number of free sectors on disk
;+13:
		dc.w	0
; Number of bit map sectors
;+15:
		dc.b	0
; 
		dc.w	4
;+18:
		dc.w	0
;+20:
		dc.w	0
;
;+22
Disk_Volume_name:
		dc.b	"        "
;+30:
		dc.b	0
;+31:
DENLOA:
		dc.b	0
		dc.b	$20
		dc.b	6
		dc.b	1
		dc.b	-1
		dc.b	-1
		dc.b	0
		dc.b	0

;+39:
		dc.b	0
;+40:
FIRMAP:
		dc.w	0
		dc.b	0

;+43:
		dc.b	0
;+44:
		dc.b	0
;+45:
		dc.w	0
;+47:
		dc.b	0
;+48:
NODMSG:		dc.b	"Error: No DOS",$9b
; 
; 
;       get next sector map.. initz new map # 
;       ------------------------------------- 
; 

LOANM:
w_f02:		LDA	FIRMAP
		STA	SECTOR
w_f03:		LDA	FIRMAP+1
		STA	SECTOR+1
		LDA	#low secmap
		LDX	#high secmap
w_f04:		JSR	READS
		LDA	secmap
w_f05:		STA	FIRMAP
		LDA	secmap+1
w_f06:		STA	FIRMAP+1
		LDY	#4
		STY	SECPTR
; 
;       get next sector number.. 
;       ------------------------ 
; 

GNXSEC:		LDY	SECPTR
w_f07:		CPY	DENLOA
		BEQ	LOANM
		LDA	secmap,Y
		STA	SECTOR
		LDA	secmap+1,Y
		STA	SECTOR+1
		INY
		INY
		STY	SECPTR
LRTS:		RTS
;
DOINITZ:       JMP ($2e2)
;
l407c:
		dc.b	0
		dc.b	0
		dc.b	0
		dc.b	0

LOADER:		LDX	#0
w_f08:		LDA	DENLOA  			; set ahead sector map ptr.. 
		STA	SECPTR  			;  to max val.. force map load 
		STA	CHPTR   			;  to max val.. force data load 
		STA	DBYTLO  			; set sector size accordingly 
		BNE	ISX
		INX
ISX:		STX	DBYTHI  			; set sector length high
w_f09:		JSR	GETBYTE 			; get FF FF header 
		STA	temp
w_f10:		JSR	GETBYTE
		AND	temp
		CMP	#$FF
		BNE	TYPER   			; Not binary file error
BEGIN:
w_lb_1:		LDA	# low LRTS 			; null initz 
		STA	INITAD
w_hb_1:		LDA	# high LRTS
		STA	INITAD+1
w_f11:		JSR	GETBYTE
		STA	buf     			; get start address 
w_f12:		jSR	GETBYTE
		STA	buf+1
		ORA	buf
		BEQ	STAD    			; a header of zero indicates end..
w_f13:		JSR	GETBYTE
		SEC
		SBC	buf     			; calc number of bytes
		PHA
		PHP
w_f14:		JSR	GETBYTE
		PLP
		SBC	buf+1
		STA	LENG+1  			; set total size-1 
		PLA
		STA	LENG

w_f15:		JSR	LOABUF 			;  and load buffer.. 
w_f16:		JSR	DOINITZ  			; repeat for next segment 
w_f17:		JMP	BEGIN 			; do start.. 
;
STAD:		JMP	($2e0)
;
; 
; 
;       error.. no DOS on diskette 
;       -------------------------- 
; 
TYPER:
w_lb_2:		LDA	#low NODMSG
w_hb_2:		LDX	#high NODMSG
		STA	ICBAL
		STX	ICBAH
		STX	ICBLL
		LDA	#9
		STA	ICCOM
		LDX	#0
		JSR	CIO

FOREV:
w_f18:      	JMP	FOREV  			; endless loop 
;
; 
; 
;       read sector at address 
;       ---------------------- 
; 
READS:
		LDY	#$40    			; read data sector at XA
		STY	DSTATS
		STA	DBUFLO
		STX	DBUFHI  			; note command is $52 ('R')
		LDA	SECTOR
		ORA	SECTOR+1
		BEQ	TYPER   			; if sector zero.. then error
		JSR	XSIO     			; use $E459 sio address.. ;update 8/29/2012 changed this from $e459 to 'xsio'
		BMI	TYPER   			; if error.. say no DOS 
		RTS
; 
; 
;       get byte/burst routine 
;       ---------------------- 
;
;
GETBYTE:
		LDA	#0
		STA	LENG+1
		STA	LENG

GETBYT:		LDX	CHPTR   			; get ptr to next char to load 
w_f19:		CPX	DENLOA  			; check if at end.. 
		BEQ	LOANS   			;  if so, load next sector
		LDA	datbuf,X
		INC	CHPTR
		RTS
;
; 
; 
;       Load next sector in buffer/ or burst if possible 
;       ------------------------------------------------ 
; 
LOANS:
w_f20:		jSR	GNXSEC  			; get next sector # 
		LDA	LENG+1  			; check if to do burst
		BNE	OKBUR
w_f21:		LDA	DENLOA
		BEQ	NOBUR
		LDA	LENG
		BMI	OKBUR   			; if >127, then burst it 

NOBUR:		LDA	#low datbuf
		LDX	#high datbuf
w_f22:		JSR	READS   			; read sector into data buffer.. 
		SEC
		ROL	CHPTR   			; put 1 into char ptr 
		LDA	datbuf  			; get first char..
		RTS
;
; 
;       Do burst read sector 
;       -------------------- 
; 
OKBUR:		LDA	buf     			; get address of where to load 
		LDX	buf+1
w_f23:		JSR	READS   			; read into correct place 
		LDA	buf     			; add length of sector.. 
		CLC
		ADC	DBYTLO
		STA	buf
		LDA	buf+1
		ADC	DBYTHI
		STA	buf+1
		SEC         			; subtract from length
		LDA	LENG
		SBC	DBYTLO
		STA	LENG
		LDA	LENG+1
		SBC	DBYTHI
		STA	LENG+1
w_f24:		JMP	LOANS   			; go load next sector
;
; 
; 
;       Load entire buffer from file 
;       ---------------------------- 
; 

LOABUFX:	LDA	LENG    			; decrement length
		BNE	NOB
		DEC	LENG+1
NOB:		DEC	LENG


LOABUF:
w_f25:		JSR	GETBYT  			; get byte.. 
		LDY	#0
		STA	(buf),Y
		INC	buf
		BNE	SK11
		iNC	buf+1
SK11:		LDA	LENG
		ORA	LENG+1
		BNE	LOABUFX
		RTS
		brk

zend1:		ds.b	0


; 
; 
;
; 
		.org	$8000
;========================================= 
;       Beginning and initialization 
;========================================= 
;
;
START_IT:
		jsr	rlocate

BEGINI:		LDA	COMTAB  			; calc address of SIO 
		SEC 
		SBC	#low lsio
		STA	XSIO+1
		LDA	COMTAB+1
		SBC	#high lsio
		STA	XSIO+2
		JMP	FORMAT
XSIO:		jMP	(0)
;
RETURN:		LDX	stackp
		TXS 
		RTS 
;
;
;================================== 
;       Main parameter input 
;================================== 
bypass_menu:	dc.b	0

format:		TSX 
		STX	stackp


;		JSR	printsi
;		dc.b	$7D,$9B,$9b,$9b
;		dc.b	"  RealDos Directory Format Utility",$9B
;		dc.b	"    Written By Stephen J. Carden",$9B
;		dc.b	"  (C)2010 Integrated Logic Systems! ",$9b
;		dc.b	$9b,$9b,$9b,-1


		lda	bypass_menu
		cmp	#$00
		beq	.fmt
		jmp	f.c
.fmt:
		JSR	printsi
		dc.b	$9b,$9b
		dc.b	"Please enter the number of the",$9b
		dc.b	"Drive (Dn:) you wish to format: ",-1

f_menu:
		jsr	inch
		CMP	#'1'				
		BCC	f_menu
		CMP	#'9'+1				
		BCS	f_menu
		JSR	ECHO
		JSR	printsi
		dc.b	$9B,-1
;		AND	#7
		sbc	#47				; turn it into a hex #
		STA	DUNIT
		JSR	printsi
		dc.b	$9B,$9B
		dc.b	"Volume Name ? ",-1

		ldy	#8
		LDA	#low Disk_Volume_name
		LDX	#high Disk_Volume_name
		JSR	GETLINE
		JSR	printsi
		dc.b	$9B,$9B
		dc.b	"Initialize... Are You Sure? ",-1

.a:		jsr	inch
		CMP	#'Y'			
		BEQ	.c
		CMP	#'y'			
		BEQ	.c
		CMP	#'N'			
		BEQ	.b
		CMP	#'n'			
		BNE	.a
.b:
		JSR	printsi
		dc.b	"n",$9b,-1
		JMP	RETURN
;
.c:
f.c:
		jsr	printsi
		dc.b	"Y",$9b,-1




		LDA	#low NAMES
		STA	DBUFLO
		LDA	#high NAMES
		STA	DBUFHI
		LDA	#$31
		STA	DDEVIC
		LDA	#'N'			
		STA	DCOMND
		LDA	#$40
		STA	DSTATS
		LDA	#low 12			
		STA	DBYTLO
		LDA	#high 12			
		STA	DBYTHI
		JSR	xsio
		BPL	.d
		JSR	printsi
		dc.b	"??Drive not Configurable??",$9b,-1
		JMP	RETURN
;

.d:
		jsr	calc_sector_count

		lda	consol
		cmp	#consol_any
		beq	.tam
		lda	consol
		cmp	#consol_select
		beq	.damn
		lda	#08
		bne	.usp
.tam:		Lda	Disk_Volume_name+1
		cmp	#$00
		bne	.e
		lda	Disk_Volume_name
		cmp	#$00
		bne	.e
.damn:
		lda	#$ff			; loading an ff in the sector block
		sta	Disk_Volume_name+1
		sta	Disk_Volume_name

.usp:
		jsr	printsi
		dc.b	$9b,$9b," Setting Disk to ",-1
	
		lda	end_sector
		ldx	end_sector+1
		jsr	pr_card


		jsr	printsi
		dc.b	" Sectors",$9b,$9b,-1
;
.e
		LDA	#1					;NAMES this is a change
		STA	DENS
		CMP	#1
		BEQ	.f
		JSR	printsi
		dc.b	"??Shows Multiple Tracks??",$9b,-1
		JMP	RETURN
;
.f:
		lda	real_sector_count
;	 LDA Disk_Volume_name+1
		STA	MAXSEC

		lda	real_sector_count+1
;		LDA	Disk_Volume_name
		STA	MAXSEC+1
 
		LDA	NAMES+7
		STA	DENSITY
		LDA	#$FF
		STA	SECTORS
		JSR	RECALC
		JSR	WRITE
		JSR	printsi
		dc.b	$9b,$9b
		dc.b	"Drive Initialized...",$9b,-1
		JMP	RETURN
;
;
;End of the directory formatting
;
;
get_sector_count:
		lda	#$31
		sta	$300
		lda	dunit
		sta	$301
		lda	#'N'			;$4e
		sta	$0302
		lda	#$40
		sta	$0303
		lda	# low huh_data
		sta	$0304
		lda	# high huh_data
		sta	$0305
		lda	#$0c
		sta	$0308
		lda	#$00
		sta	$0309
		sta	$030a
		sta	$030b
		jsr	xsio			; Changed from $e459 to 'Lsio'  8/29/2012
		lda	$0303
		cmp	#$01
		beq	.huh_1
		rts
.huh_1:
		lda 	consol
		cmp	#consol_select
		beq	tam
		rts
tam:
		jsr	printsi
		dc.b	$7d,$9b,$9b,$9b
		dc.b	"       Drive configuration table        ",$9B,$9B,$FF
		lda	huh_data
		jsr	sub_error
		jsr	printsi
		dc.b	"number of tracks",$9B,$FF
		lda	huh_data+1
		jsr	sub_error
		jsr	printsi
		dc.b	"Step rate! normaly 1",$9B,$FF
		lda	huh_data+2
		jsr	sub_error
		jsr	printsi
		dc.b	"Sector/Track high byte",$9B,$FF
		lda	huh_data+3
		jsr	sub_error
		jsr	printsi
		dc.b	"Sector/Track LOW byte",$9B,$FF
		lda	huh_data+4
		jsr	sub_error
		jsr	printsi
		dc.b	"Max head number",$9B,$FF
		lda	huh_data+5
		jsr	sub_error
		jsr	printsi
		dc.b	"Density -0=s, 4 double, 8 High",$9B,$FF
		lda	huh_data+6
		jsr	sub_error
		jsr	printsi
		dc.b	"Byte/sector h byte 1=256 0=128",$9B,$FF
		lda	huh_data+7
		jsr	sub_error
		jsr	printsi
		dc.b	"Byte/sector l byte 0=256 1=128",$9B,$FF
		lda	huh_data+8
		jsr	sub_error
		jsr	printsi
		dc.b	"Drive present flag -returns $ff",$9B,$FF
		lda	huh_data+9
		jsr	sub_error
		jsr	printsi
		dc.b	"not used",$9B,$FF
		lda	huh_data+10
		jsr	sub_error
		jsr	printsi
		dc.b	"not used",$9B,$FF
		lda	huh_data+11
		jsr	sub_error
		jsr	printsi
		dc.b	"not used",$9B
		dc.b	$9b,"Press any key to continue",$FF
		jsr	get_key
		lda	#$7d
		jsr	echo
		rts
sub_error:
		sta	.dan_k
		jsr	printsi
		dc.b	" $",$FF
		lda	.dan_k
		jsr	drive_error
		jsr	printsi
		dc.b	"  ",$FF
		rts
;
.dan_k:		dc.b	0
huh_data:	dc.b	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
huh_data_d:	dc.b	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

check_for_emulator:
		lda	huh_data
		cmp	#$28
		beq	.mite_be
		rts
.mite_be
		lda	huh_data+2
		cmp	#$00
		beq	.flop
		rts
.flop:
		lda	huh_data+3
		cmp	#18+1
		bcc	.go_on
		rts
.go_on:
		lda	huh_data+8
		cmp	#$01
		bne	.end
		lda	huh_data+9
		cmp	#$c0
		bne	.end
		lda	huh_data+10
		cmp	#$00
		bne	.end
		lda	huh_data+11
;		cmp	#$40			;????????
;		bne	.end
;
; This is for a 720 drive
; ok we have an emulator drive
;		lda	huh_data+2
;		cmp	#high 18
;		bne	.end
;		lda	huh_data+3
;		cmp	#low 18
;		bne	.a
	
		lda	#30
		sta	walter+1
		lda	#$04
		sta	huh_data+5
.a:
		rts
.end:
		rts



calc_sector_count:
		jsr	get_sector_count
		jsr	check_for_emulator
;		jsr	tam
		lda	#$ff
		sta	sector_density

		lda	huh_data+5
		cmp	#$04
		beq	.aa

		cmp	#$08
		bne	.a
		lda	#$02
		sta	percom_density
		jmp	.b

.aa:		lda	#$01
		sta	percom_density
		jmp	.b

.a:		lda	#$01
		sta	percom_density
		lda	huh_data+5
		cmp	#$00
		bne	.b
		lda	#$80
		sta	sector_density

.b:
		lda	huh_data+2
		cmp	#$00
		bne	.c
		lda	huh_data+3
		cmp	#$00
		bne	.c
		lda	#$ff
		sta	huh_data+2
		sta	huh_data+3

.c:		lda	huh_data+2
		sta	sector_per_trac+1		
		lda	huh_data+3
		sta	sector_per_trac

		lda	huh_data
		cmp	#$03
		bcs	.d
		lda	# low 1
		sta	huh_data

.d:		lda	huh_data
		sta	number_tracks
		lda	#$00
		sta	number_tracks+1


		jsr	zfr0
		lda	number_tracks
		sta	fr0
		lda	number_tracks+1
		sta	fr0+1
		jsr	ifp
		lda	#$00
		sta	cix
		jsr	fmove


		lda	sector_per_trac
		sta	fr0
		lda	sector_per_trac+1
		sta	fr0+1
		lda	#$00
		sta	cix
		jsr	ifp
		jsr	fmult
		jsr	fmove


		lda	percom_density
		sta	fr0
		lda	percom_density+1
		sta	fr0+1
		lda	#$00
		sta	cix
		jsr	ifp
		jsr	fmult

		jsr	fpi
		lda	fr0
		ldx	fr0+1
		sta	real_sector_count
		stx	real_sector_count+1
		sta	end_sector
		stx	end_sector+1
		rts

number_tracks:		dc.w	0
sector_per_trac:	dc.w	0
percom_density:		dc.w	0
real_sector_count:	dc.w	0
end_sector:		dc.w	0
sector_density:		dc.b	-1			; $ff = dd   $80 = sd


;
drive_error:
		pha
		lsr
		lsr
		lsr
		lsr
		jsr	.a
		pla
		and	#$0f
.a:		cmp	#$0a
		bcs	.b
		ora	#$30
		bne	.c
.b:		adc	#$36
.c:		jsr	ECHO
		rts
;

pr_byte:
		ldx	#$00
pr_card:
		sta	fr0
		stx	fr0+1
		lda	#$00
		sta	cix
		jsr	ifp
		jsr	fasc
		ldy	#$00
.aprbloop:
		lda	(inbuff),y
		php
		and	#$7f
		iny
		jsr	echo
		plp
		bpl	.aprbloop
		rts

; 
;       Input character with escape processing 
;       -------------------------------------- 
; 
INCH:		JSR	GET_KEY
		CMP	#27
		BEQ	EXI
		RTS 
EXI:		JMP	RETURN
; 
; 
; 
;================================= 
;       print/input routines 
;================================= 
; 
;       Print character 
;       --------------- 
; in: 
;       A       = character to print 
; out: 
;       all registers preserved 
; 
ECHO:		JSR	SAVER
		JSR	ZOUT
		JMP	RESALL
; 
ZOUT:		STA	ZTEMP+1
		LDA	$0347
		PHA 
		LDA	$0346
		PHA 
ZTEMP:		LDA	#0
		LDX	#0		;1      ; force NO output to PRINT Dn: 
		RTS 
; 
; 
;       Print text 
;       ---------- 
; out: 
;       all registers preserved 
; notes: 
;       This print routine will print all characters 
;       following the JSR PRINT until a delimiter of 
;       -1 ($FF) is reached. PRINT will return to the 
;       point one byte beyond the delimiter. 
; 
printsi:	JSR	SAVER
		TSX 
		LDA	$0105,X
		STA	ZOCH+1
		LDA	$0106,X
		STA	ZOCH+2
; 
		LDY	#1
ZOCH:		LDA	$FFFF,Y
		CMP	#$FF
		BEQ	ZECHO
		JSR	ECHO
		INY 
		BNE	ZOCH
ZECHO:		TYA 
		CLC 
		ADC	$0105,X
		STA	$0105,X
		LDA	$0106,X
		ADC	#0
		STA	$0106,X
		JMP	RESALL
; 
; 
;       SAVE & RESTORE registers 
;       ------------------------ 
; 
SAVER:		PHP 
		PHA 
		PHA 
		PHA 
		PHP 
		PHA 
		TXA 
		PHA 
		TSX 
		LDA	$0109,X
		STA	$0105,X
		LDA	$0107,X
		STA	$0109,X
		LDA	$0101,X
		STA	$0107,X
		LDA	$0108,X
		STA	$0104,X
		LDA	$0106,X
		STA	$0108,X
		TYA 
		STA	$0106,X
		PLA 
		TAX 
		PLA 
		PLP 
		RTS 
; 
RESALL:		PLA 
		TAY 
		PLA 
		TAX 
		PLA 
		PLP 
		RTS 
; 
; 
; 
;       Get character 
;       ------------- 
; out: 
;       A       = character (all others preserved) 
; 
GET_KEY:	JSR	ZGETCH
ZCH:		LDA	#0
		RTS 
; 
ZGETCH:		JSR	SAVER
		JSR	ZPHG
		STA	ZCH+1
		JMP	RESALL
; 
ZPHG:		LDA	$E425
		PHA 
		LDA	$E424
		PHA 
		RTS 
; 
; 
;;--------------------------------------------------------------------
; 
; 
;       Get line 
;       -------- 
; in: 
;       XA      = buffer address 
;       Y       = maximum number of characters 
; out: 
;       @XA     = data, return ends input, a backspace works 
;       all registers preserved 
; notes: 
;       This routine will first clear the input window 
; 
GETLINE:	JSR	SAVER
		STY	ZCNT
		STA	ZSTOR+1
		STX	ZSTOR+2
; 
		LDY	#0
		LDA	#$20
ZCLX:		JSR	ZSTOR
		INY 
		CPY	ZCNT
		BNE	ZCLX
; 
		LDY	#0
ZINLP:		JSR	GET_KEY
		CMP	#$7E
		BEQ	ZBS
		CMP	#$9B
		BEQ	ZENDZ
		CPY	ZCNT
		BEQ	ZINLP
		JSR	ECHO
		JSR	ZSTOR
		INY 
		BNE	ZINLP
; 
ZBS:		CPY	#0
		BEQ	ZINLP
		JSR	ECHO
		DEY 
		LDA	#$20
		JSR	ZSTOR
		BNE	ZINLP
ZENDZ:		JMP	RESALL
; 
ZSTOR:		STA	$FFFF,Y
		RTS


ZCNT:		dc.b	0
; 
; 
; 
;========================================= 
;       write/calculate diskette data 
;========================================= 
;       Write all data to disk 
;       ---------------------- 
WRITE:		LDX	#1      			; Write out all sectors 
		STX	SECTOR
		DEX 
		STX	SECTOR+1 			; begin at sector 1 
; 
		LDX	#high BOOTI
		LDY	#low BOOTI
		LDA	#3
		JSR	WRBLOCK 			; write boot program 
; 
		LDY	BOOTI+BMD+SDQBM 		; # bitmap sectors 
		STY	TEMPQX
; 
		LDA	DATASEC 			; Zero beginning of bit map 
		LSR
		LSR
		LSR
		TAX 
		STX	TEMPQX+1
		LDA	DATASEC
		AND	#7
		TAY 
		LDA	MASK,Y
		EOR	#$FF
; 
CLFIR:		STA	BITMAP,X
		LDA	#0
		DEX 
		BPL	CLFIR
; 
		LDX	TEMPQX+1
		INX 
		dc.b	$2C
; 
NXB:		LDX	#0      			; clear bit map 
		LDA	#$FF
SEA:		STA	BITMAP,X
		INX 
		BNE	SEA
; 
		LDY	TEMPQX  			; if not last, then use as is 
		DEY 
		BNE	WRBITX
; 
		LDX	NIBOFF  			; offset into nibble of last sector # 
		LDA	MASK,X
		LDX	BYTOFF
CLREST:		STA	BITMAP,X 			; clear out end 
		LDA	#0
		INX 
		BNE	CLREST
; 
WRBITX:		LDA	#1      			; write one bitmap sector 
		LDX	#high BITMAP
		LDY	#low BITMAP
		JSR	WRBLOCK
		DEC	TEMPQX
		BNE	NXB
; 
		LDA	#0
		TAX 
CLMAPS:		STA	SCMAP,X 			; Clear sector map and data sector 
		STA	DATSEC,X
		INX 
		BNE	CLMAPS
; 
		LDX	BOOTI+MDD 			; Sector map # of main directory 
		INX 
		STX	SCMAP+4 			; Put data sector # into sector map 
		LDA	#1
		LDX	#high SCMAP 			; Write sector map 
		LDY	#low SCMAP
		JSR	WRBLOCK
; 
		LDX	#11-1   			; Put directory name into data sector 
MVNAM:		LDA	NAMTAB,X
		STA	DATSEC+DEFNAM,X
		DEX 
		BPL	MVNAM
		LDA	#DESSUB+DESUSE
		STA	DATSEC+DESTA
		LDA	#DDEX
		STA	DATSEC+DENBYT
		LDA	#1
		LDX	#high DATSEC
		LDY	#low DATSEC
		JMP	WRBLOCK 			; Write directory sector 
; 
; 
;       Write a block of sectors 
;       ------------------------ 
; 
WRBLOCK:	STX	DBUFHI  			; address 
		STA	NUMSECS 			; number sectors to save 
		STY	DBUFLO
; 
		LDA	DENSITY 			; get density 
		LDX	SECTOR+1
		BNE	ISTHD
		LDX	SECTOR
		CPX	#4
		BCS	ISTHD
		LDA	#$80
ISTHD:		STA	DBYTLO
		LDX	#0
		TAY 
		BNE	ISSNG
		LDX	#1
ISSNG:		STX	DBYTHI
; 
REPOUT:		LDA	#'P'		   		; Assume blocks all same density 
		STA	DCOMND
		LDA	#$80
		STA	DSTATS
		JSR	XSIO
		BPL	OKWRTX
		JSR	printsi
		dc.b	"Error writing sector",$9b,-1
		JMP	RETURN
; 
OKWRTX:		INC	SECTOR
		BNE	SK1
		INC	SECTOR+1
; 
SK1:		CLC 
		LDA	DBUFLO
		ADC	DBYTLO
		STA	DBUFLO
		LDA	DBUFHI
		ADC	DBYTHI
		STA	DBUFHI
; 
		DEC	NUMSECS
		BNE	REPOUT
		RTS 
; 
; 
MASK:		dc.b	$00,$80,$C0,$E0
		dc.b	$F0,$F8,$FC,$FE,$FF
; 
NAMTAB:		dc.b	"MAIN       "
; 
; 
;       Calculate all sector positions for given density 
;       ------------------------------------------------ 
; 
RECALC:		LDA	MAXSEC  			; Get last sector # 
		STA	TEMPQX
		LDA	MAXSEC+1
		STA	TEMPQX+1
; 
		LDA	#0
		LDX	#3      			; divide by 8 for # of bms 
REPROL:
		LSR       tempqx+1 
		ROR	TEMPQX
		ROR
		DEX 
		BNE	REPROL
		LSR
		LSR
		LSR
		LSR
		LSR
		STA	NIBOFF  			; Offset into byte 
; 
		LDA	TEMPQX
		LDX	TEMPQX+1 			; Get # of bit maps and offset into last 
; 
		BIT	DENSITY
		BPL	G2
		ASL
		PHA 
		TXA 
		ROL
		TAX 
		PLA 
		LSR
; 
G2:		STA	BYTOFF
		INX 
		STX	BOOTI+BMD+SDQBM 		; # bit map sectors 
		TXA 
		CLC 
		ADC	#4      			; Add to bit map sector to get first 
		STA	BOOTI+MDD 			;  sector map sector 
		ADC	#2      			; Get first data sector # 
		STA	DATASEC
		STA	BOOTI+BMD+SDDIR 		; Free sector scan start (direct) 

;
;
;>>>>>>>>>>>>>>>>>Test code
walter:
;		ADC	#30     			; leave lots of room for dirs 
		ADC	#70     			; leave lots of room for dirs 

		STA	BOOTI+BMD+SDALLOC 		; Free sec scan (data sec) 
		BIT	CURP    			; check if to make this zero 
		BPL	ISSOMD
		LDA	#0      			; zero indicates no DOS 
ISSOMD:		AND	#$F8    			; IMPORTANT... DOS starts at a block 
;							;  when doing alloc search 
		STA	BOOTI+EXTR+DDMAP 		; Start DOS sector # 
; 
		SEC 
		LDA	MAXSEC  			; # sectors total & free 
		STA	BOOTI+BMD+SDTOT
		SBC	DATASEC
		STA	BOOTI+BMD+SDFRE
		LDA	MAXSEC+1
		STA	BOOTI+BMD+SDTOT+1
		SBC	#0
		STA	BOOTI+BMD+SDFRE+1
		LDA	DENSITY 			; set density & tracks 
		STA	BOOTI+DPD+SPDEN
		LDA	TRACKS
		STA	BOOTI+DPD+SPTRK
; 
		LDA	$D20A   			; get random number 
		STA	BOOTI+EXTR+DRAND
		RTS 
; 
;

DENSITY:  		ds.b	1		; bytes per sector 
SECTORS:  		ds.b 	1		; number of sectors per track 
MAXSEC:   		ds.b 	2		; total number of sectors 
DENS:     		ds.b 	1		; drive type/density flag 
; 
INCH8:    		ds.b 	1		; eight inch drive flag, -1=true 
TRACKS:   		ds.b 	1		; number of tracks on disk (B7=DS) 
TRKINX:   		ds.b 	1		; index into trkst 
DENINX:   		ds.b 	1		; density index 
; 
COUNT:    		ds.b 	1		; general counter.. 
STACKP:   		ds.b 	1		; return stack ptr 
CURP:     		ds.b 	1		; current DOS image ptr 
DOSP:     		ds.b 	1		; current # of .DOS files 
DOSPT:    		ds.b 	10		; space for 10 ptrs into names 
DIRP:     		ds.b 	1		; current ptr into names 
NAMES:    		ds.b	2		; ds.b	130
total.num.sec:		ds.b	2

			ds.b	126

ENTRY:    		ds.b	25      	; area for reading entries 
DOSI:     		ds.b	3+8+5   	; room for Dn:fname.DOS 
US:       		ds.b	1
HIGHSP:   		ds.b	1
; 
DATASEC:  		ds.b	1       	; Beginning of data sectors 
TEMPQX:   		ds.b	2
BYTOFF:   		ds.b	1
NIBOFF:   		ds.b	1
NUMSECS:  		ds.b	1       	; Number sectors to write 
TABLEN:   		ds.b	2       	; length of DOS file... 
; 
FMTBUF:   		ds.b	256     	; buffer for format data 
BITMAP:   		ds.b	256     	; bitmap buffer 
SCMAP:    		ds.b	256     	; sector map buffer 
DATSEC:   		ds.b	256     	; first directory sector 
TABLE:    		ds.b	256     	; area to load DOS file 
; 
;
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Ok the relocation marker is to tell the DOS we are now using
;more data at memlow..  
;
;
initz:			dc.b	0	; start address


zend:			dc.b	0	;end address

;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
;                        *** END OF HANDLER ***
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
;	The rest of this relocator Crap Took me a week to figure out!!
;
;       Relocater: main entry
;       ---------------------
; in:
;       segtab  = table of segment descriptors
;               +00 = relocater table address
;               +02 = originate address of block
;               +04 = destination originate of block
;               +06 = address of block
;               +08 = number of bytes in block
;               +10 = destination address of block
;		+12 = Length of segment descriptor
;		+14 = this is the word location addjust memory

;
;
;
;
;       reltab  = relocater table
;               list of address of words to adjust      2 bytes each entry
;               list of address low bytes to adjust     2 bytes each entry
;               list of address high bytes to adjust    3 bytes each entry
;                       followed by their low bytes
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
rlocate:

		lda	segtab+segaddress		; setting some stuff up for the relocator
        	sta	segtab+dorgadr			; Passing Stuff to the relocator
	       	sta	segtab+blkdes			; Passing Stuff to the relocator
	      	lda	segtab+segaddress+1		; setting some stuff up for the relocator
		sta	segtab+dorgadr+1		; Passing Stuff to the relocator
		sta	segtab+blkdes+1			; Passing Stuff to the relocator
;		jsr	rlocate				; ok do relocation of code!!!!!!!



		lda	#0				; set ptr to segment 0
	        sta	segment

segloop:	ldx	segment
	        lda	segtab+rettad,x 		; get address of relocater table
	        sta	relget+1
	        lda	segtab+rettad+1,x
		sta	relget+2
		ora	relget+1        		; if zero, then end of segtab
		bne	havseg
		rts

havseg:		sec            				; calculate offset to add to segment
		lda     segtab+dorgadr,x
		sbc     segtab+orgadr,x
		sta     zoffset
		lda	segtab+dorgadr+1,x
		sbc	segtab+orgadr+1,x
		sta	zoffset+1

zwordlp:	jsr	getzwp
		beq	zlbytlp				; if zero, go adjust low bytes

		lda	(zwptr),y			; add offset to address
		clc
		adc	zoffset
		sta	(zwptr),y
		iny
		lda	(zwptr),y
		adc	zoffset+1
		sta	(zwptr),y
		jmp	zwordlp

zlbytlp:	jsr	getzwp				; get address
		beq	zhbytlp				; if zero, then adjust high bytes

		lda	(zwptr),y
		clc
		adc	zoffset
		sta	(zwptr),y
		jmp	zlbytlp

zhbytlp:	jsr	getzwp				; get address
		beq	zmovlp				; jump if end of table

		jsr	relget				; get low byte
		clc
		adc	zoffset
		lda	(zwptr),y
		adc	zoffset+1
		sta	(zwptr),y
		jmp	zhbytlp
		rts

zmovlp:

		lda	segment+segmove			; gonna check the memover
		cmp	#seg_off			; $ff we quit subroutein
		bne	.zmovlp				; most of been something other than ff do mem move
		rts					; ok time to exit subroutien 	
.zmovlp:	ldx	segment				; get block start and to address
		lda	segtab+blkadr,x
		sta	zmovfr+1
		lda	segtab+blkadr+1,x
		sta	zmovfr+2

		lda	segtab+blkdes,x
		sta	zmovto+1
		lda	segtab+blkdes+1,x
		sta	zmovto+2

                       					; get # pages to move
		ldy	segtab+blkbyt+1,x

		ldx	#0
zmovfr:		lda	$ffff,x
zmovto:		sta	$ffff,x
		inx
		bne	zmovfr
		inc	zmovfr+2
		inc	zmovto+2
		dey
		bpl	zmovfr				; move even # pages, so may move up to 256;;
							;  bytes more than neede;d
		lda	segment
		clc
		adc	#seglen				; go to next segment
		sta	segment
		jmp	segloop


relget:		lda	$ffff
		inc	relget+1
		bne	nc1
		inc	relget+2
nc1:		rts

getzwp:		jsr	relget				; top of word adjust loop
		sta	zwptr				; save address of word
		jsr	relget
		ldy	#0
		sta	zwptr+1
		ora	zwptr				; check if at end
		rts

segment:	dc.b	0				; current segment
zoffset:	dc.w	0				; offset to add to addresses
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
;		       Relocation data table
;       	       ---------------------
;		We resolve Word locations First!
;
;	Things like	Lda $5000
;			Sta $5000
;			lda $5000,y
;			jsr $5000
;			jmp $5000
;
;	Well you get the Idea..
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
; $3000  tabel
;
rtable1:
		dc.w	w_f01+1
		dc.w	w_f02+1
		dc.w	w_f03+1
		dc.w	w_f04+1
		dc.w	w_f05+1
		dc.w	w_f06+1
		dc.w	w_f07+1
		dc.w	w_f08+1
		dc.w	w_f09+1
		dc.w	w_f10+1

		dc.w	w_f11+1
		dc.w	w_f12+1
		dc.w	w_f13+1
		dc.w	w_f14+1
		dc.w	w_f15+1
		dc.w	w_f16+1
		dc.w	w_f17+1
		dc.w	w_f18+1
		dc.w	w_f19+1
		dc.w	w_f20+1

		dc.w	w_f21+1
		dc.w	w_f22+1
		dc.w	w_f23+1
		dc.w	w_f24+1
		dc.w	w_f25+1


		dc.w	0			; ok done with this part
;
;
;Ok these are low Byte Locations..  only one byte changed!!
;   OK Resolving Low Byte's First
;
		dc.w	w_lb_1+1
		dc.w	w_lb_2+1
		dc.w	0			; ok done with this part
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;Now to resolve High Bytes...... Only one byte to change!
; Here is what is needed...  location of high byte in .word format
; Second thing needed is the low byte of the address you are wishing
;to adjust!
;
		dc.w	w_hb_1+1
		dc.b	LRTS
		dc.w	w_hb_2+1
		dc.b	NODMSG

		dc.w	0			; ok we are done
		dc.b	0			; ok we are done



;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;End of relocation Table!!!
;master table:
;
segtab:
		dc.w	rtable1          ; address of relocater table
		dc.w	initz1           ; assembly start address
		dc.w	0               ; relocate to address (filled in)
		dc.w	initz1           ; absolute start address of block
		dc.w	zend1-initz1      ; size of block
		dc.w	0               ; destination of block (filled in)
		dc.w	0       	; END of segments
		dc.w	$3000		;segaddress memory to adgust by.
		dc.b	seg_off		; -1 meand do not mem move


win_end:	ds.b	0
;
;


;
