;------------------------------------------------------------------------
;
;		Copyright 2005 Intergraded Logic Systems
;                  Source Code is Copyright Stephen J. Carden
;
;
;			Please do not share this source!
;------------------------------------------------------------------------
;
;               Source Code is Copyright 2006 Stephen J. Carden
;------------------------------------------------------------------------
;                              Megadisk.S
;
;	7/24/2006	Fixed end of line error
;
;
;
;                    File dissamble tool
;                    ~~~~~~~~~~~~~~~~~~~~~~~~~~
;------------------------------------------------------------------------
; 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)
;------------------------------------------------------------------------
;
;  run address $2100

;   ...  EQ  ...
;
;System equates
;------------------
;
dosvec:  equ    $0a
dosini:  equ    $0c
appmhi:  equ    $0e
lmarg:    equ   $52
rowcrs:  equ    $54
colcrs:  equ    $55
savmsc:  equ    $58
fr0:      equ   $d4
cix:      equ   $f2
inbuff:  equ    $f3
vvblkd:  equ    $0224
sdmctl:  equ    $022f
sdlstl:  equ    $0230
escflg:  equ    $02a2
invflg:  equ    $02b6
shflok:  equ    $02be
color0:  equ    $02c4
memtop:  equ    $02e5
memlo:    equ   $02e7
crsinh:  equ    $02f0
ch:    equ    $02fc
ddevic:  equ    $0300
dunit:    equ   $0301
dcomnd:  equ    $0302
dstats:  equ    $0303
dbuflo:  equ    $0304
dbufhi:  equ    $0305
daux1:    equ   $030a
daux2:    equ   $030b
iccom:    equ   $0342
icbal:    equ   $0344
icbah:    equ   $0345
icbll:    equ   $0348
icblh:    equ   $0349
icax1:    equ   $034a
consol:  equ    $d01f
audf1:    equ   $d200
audc1:    equ   $d201
afp:      equ   $d800
fasc:   equ   $d8e6
ifp:      equ   $d9aa
fpi:      equ   $d9d2
dskinv:  equ    $e453
ciov:   equ    $e456
setvbv:  equ    $e45c
xitvbv:  equ    $e462
;------------------
;
;Zero-page equates
;------------------
;
;         .org  $b0
buffer:   equ $b0	;ds.b 2
bufptr:   equ $b2	;ds.b 2
buftop:   equ $b4	;ds.b 2
bufsize:  equ $b6	;ds.b 2
syslabel: equ $b8	;ds.b 2
label.adr: equ $ba	;	;.org *+2
label.ptr: equ $bc	;	;.org *+2
this.lbl:  equ $be	;		;ds.b 2
this.lptr: equ $c0	;	;.org *+2
sptr:     equ 	$c2	;ds.b 2
pointr:   equ $c4		;ds.b 2
pc:       equ $c6	;ds.b 2
s.org:    equ $c8	;ds.b 2
number:   equ $ca	;ds.b 2
spaces:   equ $cc	;ds.b 1
ytemp:    equ $cd	;ds.b 1
tempy:    equ $ce	;ds.b 1
;
;  Misc Equates
;  ------------
;
esc:      equ   $1b
space:    equ   $20
cr:    equ     $9b
cls.:   equ    $7d
backsp:  equ    $7e
tab:      equ   $7f
em:    equ     $ff
;
chan1:    equ   $10
chan2:    equ   $20
chan3:    equ   $30
chan4:    equ   $40
;
open.:    equ   3
bget.:    equ   7
putrec.:  equ   9
bput.:    equ   $0b
close.:  equ    $0c
;
xread:    equ   4
xdir:   equ    7
xwrite:  equ    8
;
dbsize:  equ    icbll+$20
maxsec:  equ    720
dummy:    equ   $ffff
;------------------
;
;
;Macro Definitions
;------------------
;
;INW Word addr.
;
;
;         .macro inw
;         inc %1
;         bne .Az
;         inc %1+1
;.Az:
;        .ENDM

inw:          .macro  field
		inc     %1
		bne     ~a
		inc     %1+1
~a:
	 .endm
;----------------------------

;
;        .PAGE "Main Loop"
;         .include main

;
         .org  $2100
;
beginsave:	jmp	init

;		dc.b	$22	; version
;		dc.b	8	; month
;		dc.b	24	; day
;		dc.b	12	; year
;		dc.w	31	; dos build number Crc will end up here
;		dc.w	2012
;		dc.w	beginsave
;		dc.w	win_end
;		dc.b	0
;		dc.b	0
;		dc.w	0
;
;		dc.b	1
;		dc.b	2
;		dc.b	1
;		dc.w	31	; current dos build
;		dc.b	1
;

;
myscreen:	dc.b $70,$70,$90
         dc.b $42
dladr:    dc.w line1
         dc.b 0,1
oldscr:   dc.w $ffff
;
;
line1:     dc.b   <internal>, <+128>," Megadisk by Stephen J. Carden (C) 2012 "
;
;------------------------------
;
;Main Entry Point.
;Check to see if SpartaDOS
;is being used and point
;vector to RESET if so.
;Else skip to ENTER
;
init:     lda $0700   ;Sparta DOS?
         cmp #'S'
         bne enter
	 cmp #'R'	; real.dos
	 bne enter
         ldy #$3d    ;Yes, point SD
         lda # low enter ;RUN vector to
         sta (dosvec),y ;RESET.
         lda # high enter
         iny
         sta (dosvec),y
;
;Save left margin, screen
;colors, DOSVEC, and address
;of any resident VBI.
;
enter:    lda lmarg   ;Save left marg
         sta oldmar  ;and screen
         ldy #4      ;colors.
.savcolor: lda color0,y
         sta oldcolr,y
         dey
         bpl .savcolor
         lda dosini
         sta dvec
         sta reset+1
         lda dosini+1
         sta dvec+1
         sta reset+2
         lda vvblkd  ;Save Old VBI
         sta oldvbi  ;address.
         lda vvblkd+1
         sta oldvbi+1
         bne e.ovrset
;
;Skip over RESET first time
;thru.  This is where RESET
;button is trapped to.
;
reset:    jsr dummy
;
;Trap RESET, set VBI routine
;to point to our VBI, Close
;then re-open the scr editor.
;
e.ovrset:  lda # low reset
         sta dosini
         lda # high reset
         sta dosini+1
start:    jsr resetvbi
         lda #0      ;Open Screen
         sta sdmctl  ;editor.
         jsr opene
;
;Set up custom display list.
;
         lda kolor
         sta 710
         lda lum
         sta 709
         clc
         lda sdlstl
         sta sptr
         adc #3
         sta oldscr
         lda sdlstl+1
         sta sptr+1
         adc #0
         sta oldscr+1
         ldy #30
         lda # low myscreen
         sta (sptr),y
         sta sdlstl
         iny
         lda # high myscreen
         sta (sptr),y
         sta sdlstl+1
;Close all channels except
;channel 0, then initialize
;variables.
;
         ldx #$ff
         txs
         jsr closeall
;
;Zero out label bitmap.
;
         ldy # low label.map
         sty sptr
         ldy # high label.map
         sty sptr+1
         ldx #1
         ldy #0
         tya
         sta binflag
.zero_label.map: sta (sptr),y
         dey
         bne .zero_label.map
         inc sptr+1
         dex
         bpl .zero_label.map
;
;Init variables.
;
         ldx #90
.aloop:   sta try,x
         dex
         bpl .aloop
;
;Clear address line to spaces.
;
         lda #space
         ldx #5
.clr_adr: sta address,x
         dex
         bpl .clr_adr
;
;Initialize line number
;to 4995.
;
         ldx #5
.lin0:    lda frstno,x
         sta lnum,x
         dex
         bpl .lin0
         stx dskon
;
;Set TO.LINO to jump to
;GET_LINO which increments
;line numbers by 5, then
;set left margin and screen
;colors
;
         lda # low get_lino
         sta to.lino
         lda # high get_lino
         sta to.lino+1
         jsr light
         lda #1
         sta lmarg
         sta this.lbl+1
;
;Figure and set top of free
;memory 1 page lower than
;MEMTOP.
;
         sec
         lda memtop
         sta memlo
         sta appmhi
         sta freehi
         lda memtop+1
         sbc #1
         sta memlo+1
         sta appmhi+1
         sta freehi+1
;
;Point LABELTOP to beginning
;of LABEL.BUFFER.
;
         lda # low label.buffer
         sta labeltop
         lda # high label.buffer
         sta labeltop+1
         lda # low bufadr
         sta buffer
         sta buftop
         sta bufptr
         lda # high bufadr
         sta buffer+1
         sta buftop+1
         sta bufptr+1
;
;Unmark previously used
;operating system labels.
;
.ptr_setup: lda # low page0
         sta syslabel
         lda # high page0
         sta syslabel+1
         ldy #0
.offloop: jsr and7f
         sta (syslabel),y
         inc syslabel
         bne .lonly
         inc syslabel+1
.lonly:   lda syslabel
         cmp # low page.table
         bne .offloop
         lda syslabel+1
         cmp # high page.table
         bne .offloop
;
;Show menu and get users wish.
;
menu:
;
         jsr resetvbi
         jsr newscreen
;          position  9,1
         lda #6
         sta colcrs
         lda #1
         sta rowcrs

         jsr printsi
	 dc.b "Written By Stephen J. Carden",-1

         lda #11
         sta lmarg
         sta colcrs
         lda #3
         sta rowcrs
         jsr printsi
         dc.b <+128>,"C"
	 dc.b "hange Defaults",CR,CR
         dc.b <+128>,"#"
	 dc.b " Disk Directory",CR,CR
         dc.b <+128>,"F"
	 dc.b "ile Disassembly",CR,CR
         dc.b <+128>,"M"
	 dc.b "emory Disassembly",CR,CR
         dc.b <+128>,"S"
	 dc.b "ector Disassembly",CR,CR
         dc.b <+128>,"A"
	 dc.b "ction! Code Block",CR,CR
         dc.b <+128>,"B"
	 dc.b "YTE file",CR,CR
         dc.b <+128>,"D"
	 dc.b "ATA file",CR,CR
         dc.b <+128>,"Escape"
	 dc.b " to DOS"
	 dc.b CR,CR,CR,EM
         lda #1
         sta lmarg
         sta crsinh
;          col  13
         lda #13
         sta colcrs

         jsr printsi
         dc.b "Your Choice? ",EM
choice.:  jsr getcap
;
;Save users choice and
;then decode it.
;
         sta mode
         jsr cheknum ;Check for #
         bcs .keychk ;which means
         jmp directory ;show DIR.
;
.keychk:  ldy #9      ;Good keypress?
.kyloop:  cmp keytable,y
         beq .goodkey
         dey         ;No.
         bpl .kyloop
         bmi choice.
;
.goodkey: tya         ;Yes, Multiply
         asl        ;Y by two to
         tay         ;point to right
         lda menutabl,y ;adr in table
         sta menujmp+1 ;and point
         lda menutabl+1,y ;menujmp to
         sta menujmp+2 ;that address.
         lda line.start ;Point LINE.PTR
         sta line.ptr ;to proper
         lda line.start+1 ;output line.
         sta line.ptr+1
         lda mode
menujmp:  jmp dummy   ;Go do it.
;
;-----------------------
;Table of Menu Keys.
;
keytable: dc.b "C"
	  dc.b "F"
	 dc.b "M"
	 dc.b "S"
         dc.b "A"
	 dc.b "B"
	 dc.b "D"
	 dc.b $1B
         dc.b "K"
	 dc.b "L"    ;Hidden (color).
;
;Address table for Menu Choices.
;
menutabl: dc.w opt
	  dc.w dis
         dc.w dis
	 dc.w dis
         dc.w datafile
	 dc.w datafile
         dc.w datafile
	 dc.w exit
         dc.w .klr
	 dc.w .lm
;-----------------------
;
;
.lm:      clc         ;Change Character
         lda 709     ;Luminance.
         adc #2
         and #15
         sta 709
         sta lum
         bpl choice.
;
.klr:     lda 710     ;Change
         adc #16     ;Background
         sta 710     ;color
         sta kolor
         jmp choice.
;
opt:      jsr options ;Set Options.
         jmp menu
;
;
;Must point LINE.PTR to either
;PRINTLINE, if line numbers are
;not to be included, or LNUM
;if they are.  Do it here in
;case the option was changed
;by using the OPTIONS menu.
;
dis:      ldx # high vbi
         ldy # low vbi
         lda #7
         jsr setvbv
         lda mode
         cmp #'F'
         bne .m.
         lda # low file_dis ;Point
         sta modejump+1 ;Modejump to
         lda # high file_dis ;file
         sta modejump+2 ;disassembly.
         jsr get_infn ;Get Input fn.
         jmp get_outfn
;
.m.:      cmp #'M'
         bne .s.
;
;Set up for memory disassembly.
;Point MODEJUMP to memory
;disassembly routine.
;
         lda # low memory_dis
         sta modejump+1
         lda # high memory_dis
         sta modejump+2
;
;Find out what memory to
;disassemble.
;
         jsr get_start
;
;Initialize BUFPTR and
;BUFTOP to zero.
;
;
;Check first char of input.
;
.end_in:  jsr printsi
         dc.b cr,tab,"Enter End addre"
         dc.b "ss:   ",EM
;
;Convert end address.
;
         jsr getnum
         cmp #esc
         bne .digend
         jmp clrstack
;
.digend:  jsr digitize
         bcs .end_err
         lda number
         sta buftop
         lda number+1
         sta buftop+1
         lda #1
         sta more.
         jmp get_outfn
;
;
.end_err: jsr in_err
         jmp .end_in
;
;
.s.:      jsr getsectors
;
;
;Get output filename from user.
;
get_outfn: jsr outfn_in
         bcc .todsk
         lda #0      ;Flag indicating
         sta dskon   ;no disk output.
         jmp a.ready
;
;Indicate disk file not open,
;initialize disk file count to
;1, set DRIVES to 1 less than
;number of drives being used.
;
.todsk:   ldy #1
         lda outfn+1
         cmp infn+1
         bne .knodrv
         dey
.knodrv:  sty drives
         lda mode
         cmp #'M'
         beq got_info
         lda drives
         sta both.flag
;
.drvprmpt: jsr newscreen
         jsr indisk_prmpt
         lda drives
         beq a.ready
;
got_info: jsr outdisk_prmpt
;
a.ready:   lda mode
         cmp #'F'
         bne .getset
         jsr open_in ;Check for
         lda #0      ;DOS load file
         sta dskopnflg ;by looking
         jsr load_adr ;for $FFFF
         beq .setset ;file header.
         jsr not_binary
         jmp .opnreal
;
.setset:  jsr load_adr ;Get file
         lda seg.org ;ORG adress
         sta first   ;and save it.
         lda seg.org+1
         sta first+1
.opnreal: jsr open_in
;
;
.getset:  jsr loopinit
         lda scr     ;Set screen and
         sta sdmctl  ;printer to
         lda prt     ;default on/off.
         sta close.p.
         jsr build_symbol_tbl
         jsr setbuffer
         jsr loopinit
         lda mode
         sta loadflag
         cmp #'F'
         bne .notf
         lda first   ;Copy file
         sta pc      ;ORG adress
         lda first+1 ;into program
         sta pc+1    ;counter.
         jmp .dodis
;
.notf:    jsr sho_org
         jsr compute_address
.dodis:   jsr disassemble
         jsr write_equates
;
;Indicate to user that we are
;done and see what (s)he wants
;to do.
;
disdone:  jmp nowhat.
;
;Reopen scr editor, restore
;all the stuff saved when the
;program was entered, reset
;the stack pointer, then
;exit to address in DOSVEC.
;
exit:
;
         jsr opene
         lda oldmar
         sta lmarg
         ldy #4
.fixit:   lda oldcolr,y
         sta color0,y
         dey
         bpl .fixit
         iny
         sty crsinh  ;Turn on cursor.
         lda dvec    ;Restore DOSINI.
         sta dosini
         lda dvec+1
         sta dosini+1
         lda #7      ;Restore old VBI
         ldx oldvbi+1 ;routine
         ldy oldvbi
         jsr setvbv
         jsr closeall ;Close chans 1-7.
         ldx #$ff    ;Clear stack.
         txs
         jmp (dosvec)
;----------------------------
loopinit: lda #1
         sta more.
         sta crsinh
         jsr newscreen
         stx cioy
         inx
         stx mymr
         stx colcrs
         inx
         stx rowcrs
         jsr clr_printline
         lda mode
         cmp #'F'
         beq .notmem
         lda s.org   ;Set up for
         sta bufptr  ;memory
         sta pc      ;disassembly
         lda s.org+1
         sta bufptr+1
         sta pc+1
         lda mode
         cmp #'S'
         beq .notmem
         rts
;
.notmem:  jsr chk_in
         lda mode
         cmp #'S'
         bne .notsect
         jmp sector_block
;
.notsect: jmp dofile
;----------------------------
;
setbuffer: lda mode
         cmp #'M'
         bne .dskdis
         lda s.org
         sta bufptr
         lda s.org+1
         sta bufptr+1
         rts
;
.dskdis:  clc
         lda labeltop
         adc #2
         sta buffer
         sta buftop
         sta bufptr
         lda labeltop+1
         adc #0
         sta buffer+1
         sta buftop+1
         sta bufptr+1
         rts
;----------------------------
;
resetvbi: lda #7
         ldx # high xitvbv
         ldy # low xitvbv
         jmp setvbv
;----------------------------


;        .PAGE "Label Routines"
;         .include labl

;  ...  LABL  ...
;
;---------------------------
;
;     Labeling Routines.
;
;---------------------------
;
;This routine does a fake
;disassembly and saves the
;addresses that will require
;labels.
;
build_symbol_tbl:
;
         jsr get_a_byte ;Get a byte.
         bcs tabl_built ;End of dis.
         sta opcode  ;Save it.
         tax
         lda op.table,x ;See what
         cmp #$ff    ;it is.
         beq build_symbol_tbl ;Don't
         and #$60    ;need a label.
         beq build_symbol_tbl
         jsr get_a_byte ;Get label
         bcs tabl_built ;address.
         sta label.adr
         ldx opcode  ;See whether
         lda op.table,x ;it is a
         cmp #$26    ;branch
         bne .24.    ;instruction.
         jsr set_branch ;It is.
         jmp .make_lbl
;
.24.:     cmp #$24    ;Need a label?
         beq build_symbol_tbl ;No.
         and #$40    ;A zero-page adr?
         bne .not_page0 ;No.
         jsr lbladrh ;Yes.
         beq .make_lbl
;
.not_page0: jsr get_a_byte ;Get
         bcs tabl_built ;2nd byte of
         sta label.adr+1 ;address.
;
.make_lbl: jsr save_label
         bcc build_symbol_tbl
;
tabl_built: lda more.
         bne build_symbol_tbl
         rts
;----------------------------
;
;Figure out the target address
;of a branch instruction.
;
set_branch:
;
         jsr lbladrh
         lda label.adr
         bpl .zpl    ;Forward branch.
         lda #$ff    ;Backward branch.
         sta label.adr+1
.zpl:     clc
         lda label.adr
         adc pc
         sta label.adr
         lda label.adr+1
         adc pc+1
         sta label.adr+1
         rts
;----------------------------
;
;Save label address in the
;label address buffer.
;
save_label:
;
         jsr find_label ;Used already?
         bcs .keep_it ;No.
.sxit:    rts         ;Yes.
;
;
.keep_it: sec         ;Room for another
         lda lbuf.size ;label?
         sbc # low bufadr-label.buffer-2
         lda lbuf.size+1
         sbc # high bufadr-label.buffer-2
         bcs .sxit   ;NO.
;
         jsr setl.index ;Yes.
         lda labels
         ora labels+1
         bne .hilp
         jmp .addit
;
.hilp:    ldy #1      ;Find where to
         lda (label.ptr),y ;put it.
         cmp label.adr+1
         beq .findlo
         bcs .there
         bcc .lookmor
;
.findlo:  dey
         lda (label.ptr),y
         cmp label.adr
         bcs .there
.lookmor: clc
         lda label.ptr
         adc #2
         sta label.ptr
         lda label.ptr+1
         adc #0
         sta label.ptr+1
         lda labeltop+1
         cmp label.ptr+1
         bne .hilp
         lda labeltop
         cmp label.ptr
         bne .hilp
;
.there:   lda label.ptr+1
         cmp labeltop+1
         bne .svit
         lda label.ptr
         cmp labeltop
         bne .svit
         jmp .addit
;
.svit:    lda label.ptr
         sta number
         lda label.ptr+1
         sta number+1
         clc
         lda labeltop
         sta label.ptr
         adc #2
         sta pointr
         lda labeltop+1
         sta label.ptr+1
         adc #0
         sta pointr+1
         ldy #0
         lda labels
         ora labels+1
         beq .addit
;
.bmplbl:  lda pointr  ;Make room
         bne .pointrlo ;for this
         dec pointr+1 ;label adr.
.pointrlo: dec pointr
         lda label.ptr
         bne .lplo
         dec label.ptr+1
.lplo:    dec label.ptr
         ldy #0
         lda (label.ptr),y
         sta (pointr),y
         lda label.ptr
         cmp number
         bne .bmplbl
         lda label.ptr+1
         cmp number+1
         bne .bmplbl
;
.addit:   ldy #0      ;Store this
         lda label.adr ;label adr.
         sta (label.ptr),y
         iny
         lda label.adr+1
         sta (label.ptr),y
         clc
         lda labeltop ;Add 2 to
         adc #2      ;top of label
         sta labeltop ;buffer pointer.
         lda labeltop+1
         adc #0
         sta labeltop+1
         clc
         lda lbuf.size ;Add 2 to
         adc #2      ;label buffer
         sta lbuf.size ;size.
         lda lbuf.size+1
         adc #0
         sta lbuf.size+1
          inw  labels ;Inc Label counter.
         jmp ir_awake
;----------------------------
;
;Check to see if we have
;saved this label address.
;
find_label:
;
         jsr setl.index
         lda #0      ;0 indicates
         sta good.label ;not found.
.find_lblp: ldy #1    ;Check adr hi
         jsr c.ladr
         bne .snot_here ;Not equal.
         dey
         jsr c.ladr  ;Check adr lo
         bne .snot_here ;Not equal
         inc good.label
         sec         ;Found it!
         lda label.ptr ;Get label
         sbc # low label.buffer ;#*2.
         sta this.lbl
         lda label.ptr+1
         sbc # high label.buffer
         sta this.lbl+1
         lsr this.lbl+1 ;Divide by 2.
         ror this.lbl
         clc         ;Indicate found.
         rts
;
.snot_here: clc       ;Point to next
         lda label.ptr ;label
         adc #2
         sta label.ptr
         lda label.ptr+1
         adc #0
         sta label.ptr+1
         sec
         lda label.ptr ;See if we
         sbc labeltop ;are at the
         lda label.ptr+1 ;top of
         sbc labeltop+1 ;the label
         bcc .find_lblp ;buffer yet.
         rts
;----------------------------
;
;Move Label name to printline.
;
label11:  ldx #11     ;Start in col 11.
get_label:
;
         txa         ;Save column.
         pha
         jsr chekfor_syslbl ;ATARI label?
         bcs .aint_sys ;No.
         jsr find_syslabel ;Yes, find it.
         pla         ;Restore column.
         tax
         jmp get_syslabel
;
.aint_sys: jsr find_label
         pla         ;Restore column.
         tax
;----------------------------
;
;See if we have a good label
;number.  If so move label
;name to printline.  Else
;move actual address to
;printline in hex.
;
labelize:
;
         lda good.label
         bne .good_lbl
         lda #'$'     ;Add address to
         sta printline,x ;printline
         inx         ;in Hex because
         ldy #1      ;there is no
.nolblp:  lda label.adr,y ;label
         jsr byte_to_hex ;for it.
         dey
         bpl .nolblp
         rts
;----------------------------
;
;We have a good label number
;so move label name to print-
;line.  First check to see if
;it is going in the label field
;and if so unmark it so it will
;not be included in equate file.
;
.good_lbl:
;
         cpx #0      ;If in column 0
         bne .noflip ;then unmark
         jsr get_lbit ;it so as not
         and bit.table,x ;to write
         beq .un_it  ;an equate for
         ldx #7      ;this label.
         rts
;
.un_it:   jsr unmark_label
         ldx #0
.noflip:  jsr point
         beq .czp    ;If ZP adr.
         cmp #$a0
         bcs .nomrk
         lda marker  ;Move label marker
         sta printline,x ;first.
         lda marker+1
         cmp #cr
         beq .csk
         inx
         sta printline,x
.csk:     inx         ;Move hi byte
         lda (label.ptr),y ;of adr
.nomrk:   jsr byte_to_hex ;to printline.
         bne .cnzp
.czp:     sty zp.flag ;Show that ZP labels exist.
         dey
         lda (label.ptr),y
         iny
         cmp #$a0
         bcs .cnzp
         lda zmarker
         sta printline,x ;page label
         inx         ;so move Zmarker
         lda zmarker+1 ;to printline.
         cmp #cr
         beq .cnzp
         sta printline,x
         inx
.cnzp:    dey         ;Move lo byte
         lda (label.ptr),y ;of adr to
         jmp byte_to_hex ;printline.
;----------------------------
;
;Check to see if this requires
;an ATARI label.
;
chekfor_syslbl:
;
         ldx #0
.tblsrch: cpx tsize   ;Past top of
         bcs mysys.  ;ATARI labels? Yes.
         ldy #0      ;No. Check next page.
.tblmv:   lda page.table,x ;Copy
         sta page.loc,y ;data for this
         inx         ;page to page.loc.
         iny
         cpy #5
         bne .tblmv
         lda page    		;Address in this
         cmp label.adr+1 	;page.
         bne .tblsrch 		;No.
         lda page.top 		;Yes. Is it
         cmp label.adr 		;included here?
         bcc mysys.  		;No.
         lda rw.flag 		;Two labels?
         bmi .found_adr ;No.
         lda opcode  ;Yes, see whether
         and #$e7    ;to use Read label
         cmp #$86    ;or Write label.
         beq .write
         cmp #$84
         beq .write
         and #$e3
         cmp #$81
         beq .write
         lda #1      ;Use Read label.
         dc.b $2c   ;Dummy BIT.
.write:   lda #0      ;Use Write label.
.ovr0:    cmp rw.flag ;Right?
         bne .tblsrch ;Nope, Look again.
.found_adr: lda #0    ;Indicate not
         sta myflag  ;from misc table.
         clc
         rts
;
;
mysys.:   ldy #0      ;Is this adr in the
         lda label.adr+1 ;misc table?
         beq .p0     ;Check page 0.
         cmp #3
         beq .p3     ;Check page 3.
         cmp #$d0    ;Between pages
         bcc .nope   ;D0-DF?
         cmp #$df
         bcs .nope
;
.fploop:  lda fp.adrlst+1,y ;Is it
         cmp label.adr+1 ;a Floating
         bne .fpnxt  ;point adr?
         lda fp.adrlst,y
         cmp label.adr
         bne .fpnxt
         tya         ;Yes, divide Y by
         lsr        ;two.
         tay
         jmp .gotim
;
.fpnxt:   iny         ;Point to next
         iny         ;FP label.
         cpy #66     ;Past end of table?
         bne .fploop ;No.
         beq .nope   ;Yes.
;
.p0:      lda # low p0.adrlst ;Set up to
         sta .findit+1 ;search page
         lda # high p0.adrlst ;0 misc.
         sta .findit+2
         lda #13
         sta ytemp
         lda #0
         beq .savea
;
.p3:      lda xe      ;XL/XE labels?
         beq .nope   ;No, skip it.
         lda # low p3.adrlst ;Yes, set up
         sta .findit+1 ;to search page
         lda # high p3.adrlst ;3 misc.
         sta .findit+2
         lda #12
         sta ytemp
         lda #3
;
.savea:   pha
.findit:  lda dummy,y ;Search for
         cmp label.adr ;match of lo byte.
         beq .hirit  ;Gotcha!
         iny
         cpy ytemp   ;Top of table?
         bne .findit ;No, look more.
.noway:   pla         ;No match found.
.nope:    sec
         rts
;
.hirit:   pla         ;Double check hi byte
         cmp label.adr+1 ;of adr.
         beq .gotim  ;it's a Match.
         iny         ;Does'nt match.
         cpy ytemp
         bne .savea
         beq .nope
;
.gotim:   sty ytemp   ;It's a good
         iny         ;label.
         sty myflag  ;Indicate it is
         clc         ;a misc label.
         rts
;----------------------------
;
;Find address of ATARI
;label name.
;
find_syslabel:
;
         lda myflag  ;Misc label?
         bne find_mysys ;Yes.
         jsr reset_ptrs ;Point to label.
         ldy #0
         jsr andspace ;Need a '+'?
         bne .found_lbl ;No.
         jsr backloop ;Yes, point to real label.
;
.found_lbl: rts
;
;
find_mysys: ;         Find Misc ATARI
         lda label.adr+1 ;label.
         cmp #$d0
         bcc .0adr
         lda # low fp.labels
         sta syslabel
         lda # high fp.labels
         sta syslabel+1
         bne .gotmyhi
;
.0adr:    tay         ;0 page?
         bne .lo_adr ;No.
         lda # low p0.labels ;Yes, point
         sta syslabel ;to 0 page
         lda # high p0.labels ;labels.
         sta syslabel+1
         bne .gotmyhi
;
.lo_adr:  lda # low p3.labels ;Point
         sta syslabel ;to page 3
         lda # high p3.labels ;labels.
         sta syslabel+1
;
.gotmyhi: ldy ytemp
         beq .mysysx
.setploop: jsr bumpsl.6
         dey
         bne .setploop
;
.mysysx:  ldy #0
         sty offset
         jsr and7f
         cmp #'+'
         bne .mysysfound
         sta offset
         jsr backup
;
.mysysfound: rts
;----------------------------
;
;Move system label name
;to printline.
;
get_syslabel:
         txa         ;Save printline index.
         pha
         lda # low label.buffer
         sta this.lptr
         lda # high label.buffer
         sta this.lptr+1
         jsr zthis.lbl
         ldy #1
.mhilp:   lda label.adr,y
         cmp (this.lptr),y
         beq .mlo
         jsr inths.lbl
         clc
         lda this.lptr
         adc #2
         sta this.lptr
         lda this.lptr+1
         adc #0
         sta this.lptr+1
         bne .mhilp
;
.mlo:     dey
         bpl .mhilp
;
.mrkit:   jsr unmark_label
         pla
         tax
.skflp:   lda myflag
         beq .nmsys
         jmp get_mysys
.nmsys:   lda #0
         sta offset
         jsr reset_ptrs
         ldy #1
         cpx #0
         bne .oprnd
         jsr ora80
.oprnd:   dey
         jsr andspace
         bne .whatsx
         jsr backloop
.whatsx:  cpx #0
         bne .movem
         lda offset
         bne .moved
.movem:   ldy #0
         jsr ora80
         and #$7f
         sta printline,x
;
.movemlp: inx
         iny
         jsr andspace
         beq .chkoffset
         sta printline,x
         cpy #5
         bcc .movemlp
         inx
.chkoffset: lda offset
         beq .moved
         cpx #7
         bcc .moved
         lda #'+'
         sta printline,x
         inx
         txa
         pha
         lda offset
         jsr decimal
         pla
         tax
         ldy #0
.cdeclp:  lda (inbuff),y
         bmi .lstdc
         sta printline,x
         inx
         iny
         cpy #2
         bne .cdeclp
.lstdc:   and #$7f
         sta printline,x
         inx
.moved:   clc
         rts
;
;
get_mysys:
;
         ldy #0
         jsr ora80
         iny
         cpx #6
         bcs .moprnd
         jsr ora80
;
.moprnd:  dey
.movmyslp: jsr andspace
         beq .chkmoff
         sta printline,x
         inx
         iny
         cpy #6
         bne .movmyslp
.chkmoff: cpx #7
         bcc .gotmsys
         lda offset
         cmp #'+'
         bne .gotmsys
         sta printline,x
         lda #'1'
         inx
         sta printline,x
         inx
.gotmsys: clc
         rts
;----------------------------
;
unmark_label: ;       Unmark label
;
         jsr get_lbit ;so we do not
         ora bit.table,x ;write an
         sta (this.lptr),y ;equate
         clc         ;for this label.
         rts
;----------------------------
;
;Labels are marked in a bitmap
;similar to the bitmap sector
;of a DOS disk.  This routine
;finds the bit in the bitmap
;Corresponding to the current
;label.
;
get_lbit:
;
         lda this.lbl
         and #7
         tax
         lda this.lbl
         sta this.lptr
         lda this.lbl+1
         sta this.lptr+1
         ldy #3
.divide:  lsr this.lptr+1
         ror this.lptr
         dey
         bne .divide
         clc
         lda # low label.map
         adc this.lptr
         sta this.lptr
         lda # high label.map
         adc this.lptr+1
         sta this.lptr+1
         lda (this.lptr),y
         rts
;----------------------------



;        .PAGE "Disassembly Routines"
;         .include diss
;  ...  DISS  ...
get_a_byte: jsr chkbuf
modejump: jmp dummy
;
;----------------------------
;
;
disassemble:
;
         jsr prep
;
;Compute current address
;and store it in LABEL.ADR.
;
         jsr compute_address
         jsr setprogc
;
;See if a label goes here.
;
         jsr chekfor_syslbl
         bcs .chklbl
         jsr find_syslabel
         ldx #0
         jsr get_syslabel
         bcc .ovrlbl
;
.chklbl:  jsr find_label
         bcs .ovrlbl
;
;One does so put it here.
;
         ldx #0
         jsr labelize
;
;Go disassemble what we got.
;
.ovrlbl:  jsr get_a_byte
         bcc .get_opratr
         jmp .go_to_byte
;
.get_opratr: tax
         lda op.table,x
         cmp #$ff
         bne .notyet
         jmp .get_oprand
;
.notyet:  ldy byts.this.op
         beq .dis.2
         stx xtemp
         jsr byte
         lda pc
         bne .A1
         dec pc+1
.A1:      dec pc
         jsr compute_address
         jsr inw.pcountr
;
.dis.1:   jsr prep
         ldx xtemp
;
.dis.2:   stx opcode
         inc bytes.done
         lda op.table,x
         and #$60
         lsr
         lsr
         lsr
         lsr
         lsr
         sta bytes.to.do ;will be 0,1,2, or 3.
         and #2
         sta op.temp
         lda bytes.to.do
;
.dis.3:   beq .dis.4
         jsr get_a_byte
         bcs .sav_done
         ldx bytes.done
         sta opcode,x
         inc bytes.done
         dec bytes.to.do
         jmp .dis.3
;
.dis.4:   lda op.temp
         beq .monicize
         lda operand+1
         bne .monicize
         lda #3
         sta byts.this.op
         jmp .do_a_byte
;
.monicize: jsr get_mnemonic
         jsr write_line
         ldx opcode
         lda mnem.pointr,x
         cmp #$53
         beq .brkit
         cmp #$80
         beq .brkit
         cmp #$7d
         bne .disj
;
.brkit:   jsr onespace
.disj:    jmp disassemble
;
.get_oprand: txa
         ldx byts.this.op
         sta opcode,x
         inc byts.this.op
         jsr setprogc
         jsr find_label
         bcs .dis.8
;
.do_a_byte: jsr byte
         jmp disassemble
;
.dis.8:   lda byts.this.op
         cmp bytes
         bcs .do_a_byte
         jmp .ovrlbl
;
.sav_done: ldx bytes.done
         stx byts.this.op
;
.go_to_byte: lda byts.this.op
         beq .mortodo.
         jsr byte
;
.mortodo.: lda more.
         beq .dis_exit
         lda lastorg
         cmp pc
         bne .do_org
         lda lastorg+1
         cmp pc+1
         beq .dis_exit
.do_org:  jsr sho_org
;
.dis_exit: lda more.
         beq .dis_done
         jmp disassemble
;
.dis_done: rts
;----------------------------
;
byte:
;
         lda # low byte_m
         sta from+1
         lda # high byte_m
         sta from+2
         ldx #7
         jsr move
         ldy #0
;
.storbyte: lda #'$'
         sta printline,x
         inx
         lda opcode,y
         jsr byte_to_hex
         lda #','
         sta printline,x
         inx
         iny
         dec byts.this.op
         bne .storbyte
         dex
         lda #cr
         sta printline,x
         jsr write_line
         lda printline+14
         cmp #'6'
         bne .jprp
         lda printline+15
         cmp #'C'
         bne .jprp
         jsr onespace
.jprp:    jmp prep
;----------------------------
;
;Move mnemonic to printline
;
get_mnemonic:
;
         ldx opcode
         lda mnem.pointr,x
         tax
         ldy #2
.mov_instr: lda mnemonic.tbl,x
         sta printline+7,y
         dex
         dey
         bpl .mov_instr
         ldx opcode  ;Add addressing
         lda op.table,x ;mode.
         and #$1f
         tax
         lda mode.tabl,x
         sta .arg_jmp+1
         inx
         lda mode.tabl,x
         sta .arg_jmp+2
.arg_jmp: jmp dummy
;----------------------------
;
;Routines to add the correct
;addressing mode to the
;output line.
;
reg:      ldx #10
         jmp Acr
;
acc:      lda #'A'
         ldx #11
         jmp Achr
;
imm:      lda #'#'
         sta printline+11
         ldx #12
         lda operand
         cmp #10
         bcs .immh
         ora #'0'
         jmp Achr
.immh:    lda #'$'
         sta printline,x
         inx
         lda operand
         jsr byte_to_hex
         jmp Acr
;
branch:   lda operand
         sta label.adr
         jsr set_branch
         jsr label11
         jmp Acr
;
adress:   jsr Aplbl
         jmp Acr
;
x_indx:   jsr Aplbl
         lda #'X'
         jmp Aopcr
;
y_indx:   jsr Aplbl
         lda #'Y'
         jmp Aopcr
;
zpage:    lda #0
         sta label.adr+1
         lda operand
         sta label.adr
         jsr label11
         jmp Acr
;
x_indx1:  lda #0
         sta label.adr+1
         lda operand
         sta label.adr
         jsr label11
         lda #'X'
         jmp Aopcr
;
yindx1:   lda #0
         sta label.adr+1
         lda operand
         sta label.adr
         jsr label11
         lda #'Y'
         jmp Aopcr
;
ind_x:    lda #'('
         sta printline+11
         jsr optolbl
         jsr Ainsrtlabl
         lda #')'
         jmp Achr
;
ind_x1:   lda #'('
         sta printline+11
         lda operand
         sta label.adr
         lda #0
         sta label.adr+1
         jsr Ainsrtlabl
         lda #'X'
         jsr Aopcr
         lda #')'
         jmp Achr
;
ind_y:    lda #'('
         sta printline+11
         lda operand
         sta label.adr
         lda #0
         sta label.adr+1
         jsr Ainsrtlabl
         lda #')'
         sta printline,x
         inx
         lda #'Y'
;----------------------------
;
Aopcr:    pha
         lda #','
         sta printline,x
         inx
         pla
Achr:     sta printline,x
         inx
Acr:      lda #cr
         sta printline,x
         rts
;----------------------------
;
Ainsrtlabl: ldx #12
         jsr get_label
         rts
;
;
Aplbl:    jsr optolbl
         jmp label11
;----------------------------
;
prep:
;
         lda #0
         ldx #7
.clrlp1:  sta opcode,x
         dex
         bpl .clrlp1
         sta byts.this.op
         sta bytes.done
         sta op.temp
;
clr_printline:
;
         lda #space
         ldx #39
.clrloop: sta printline,x
         dex
         bpl .clrloop
         rts
;----------------------------
;
reset_ptrs:
;
         lda #0
         sta syslabel
         sta syslabel+1
         ldy #6
.adlupe:  clc
         lda syslabel
         adc label.adr
         sta syslabel
         lda syslabel+1
         adc #0
         sta syslabel+1
         dey
         bne .adlupe
         clc
         lda syslabel
         adc page.loc
         sta syslabel
         lda syslabel+1
         adc page.loc+1
         sta syslabel+1
         rts
;----------------------------
;
chkbuf:
;
         sec
         lda buftop
         sbc bufptr
         lda buftop+1
         sbc bufptr+1
         rts
;
;----------------------------
;
memory_dis: bcs fetch_byte
         jmp no_more
;
fetch_byte:
;
         ldy #0      ;Get next byte
         lda (bufptr),y ;to be
         tax         ;disassembled
          inw  bufptr ;from buffer.
         jsr inw.pcountr
         txa
         clc
         rts
;----------------------------


;        .PAGE "Sector Disassembly Routines"
;         .include sect

;   ...  SECT  ...
;
;     Routines used for
;     Disassembling Sectors.
;
;Point MODEJUMP to sector
;disassembly routine.
;
getsectors:
;
         lda # low sector_dis
         sta modejump+1
         lda # high sector_dis
         sta modejump+2
         lda #'D'
         sta infn
         lda dn+1
         sta infn+1
         lda #0
         sta sector
         sta sector+1
         sta currnt.sectr
         sta currnt.sectr+1
;
;Find out which sectors
;to disassemble.
;
         jsr zero_sector.map
         jsr newscreen
         lda #6
         sta lmarg
         sta colcrs
;
a.get_first: jsr printsi
;
         dc.b "  Disassemble W"
         dc.b "hich Sectors"
         dc.b "?",CR,CR,SPACE,EM
;
;
a.sector_in: lda #32
         jsr getline
         cmp #esc
         beq a.orsec
         lda inline
         cmp #cr
         bne a.do_first
a.orsec:   lda sector
         ora sector+1
         bne a.stjmp
         jmp menu
;
a.stjmp:   jmp get_start
;
a.do_first: jsr digitize
         bcc a.first_ok
         jmp a.sectr_err
;
a.first_ok: jsr Achek_sec
         bcc a.fok
         jmp a.sectr_err
;
a.fok:     lda number
         sta sector
         lda number+1
         sta sector+1
         jsr Asetbit
;
a.get_last: ldx xsave
         lda inline,x
         cmp #cr
         beq a.moresecs.
;
         pha
         ldy #$ff
;
a.lshloop: iny
         inx
         lda inline,x
         sta inline,y
         cmp #cr
         bne a.lshloop
         jsr digitize
         bcc a.numok
         pla
         jmp a.sectr_err
;
a.numok:   jsr Achek_sec
         bcc a.num1
         pla
         jmp a.sectr_err
;
a.num1:    pla
         cmp #','
         bne a.dash.
         jmp a.fok
;
a.dash.:   cmp #'-'
         beq a.dodash
         jmp a.sectr_err
;
;
a.dodash:  jsr Achekdiff
         bcs a.mark_loop
         jmp a.sectr_err
;
a.mark_loop:  inw  sector
         jsr Achekdiff
         bcs a.diffok
         jmp a.get_last
;
a.diffok:  jsr Achek_sec
         bcc a.sec_ok
         jmp a.sectr_err
;
a.sec_ok:  jsr Asetbit
         bcc a.mark_loop
;
a.moresecs.: lda #0
         sta crsinh
         jsr printsi
         dc.b cr,cr," Any More "
         dc.b "Sectors? ",EM
;
         jsr getcap
         cmp #'Y'
         beq a.moreprmpt
         jmp get_start
a.moreprmpt: jsr printsi
;
         dc.b cr,cr,"Which Ones"
         dc.b "? ",CR,CR,EM
;
         jmp a.sector_in
;
;
Achekdiff: sec
         lda number
         sbc sector
         lda number+1
         sbc sector+1
         rts
;
;
Achek_sec: sec
         lda number
         sbc # low 721
         lda number+1
         sbc # high 721
         rts
;
Asetbit:  ldx sector
         ldy sector+1
         jsr get_sbit
         lda sector.map,x
         ora bit.table,y
         sta sector.map,x
         clc
         rts
;
a.sectr_err: jsr in_err
         jmp a.sector_in
;----------------------------
;
sector_dis:
;
         bcs a.nxt_sectr_byt
         jsr sectr_setup ;*
         bcc a.nxt_sectr_byt
         jmp no_more
;
a.nxt_sectr_byt: jmp fetch_byte
;
sectr_setup: jsr zmore ;*
         jsr setndx
;
a.sectr_chkbuf: jsr setbsize
         sec
         lda bufsize
         sbc #$80
         lda bufsize+1
         sbc #0
         bcc a.havsectors
;
prep__nxtsectr:  inw  currnt.sectr
         sec
         lda # low maxsec ;SECTOR 720?
         sbc currnt.sectr
         lda # high maxsec
         sbc currnt.sectr+1
         bcc a.havsectors
         ldx currnt.sectr
         ldy currnt.sectr+1
         jsr get_sbit
         lda sector.map,x
         and bit.table,y
         beq prep__nxtsectr
         jsr chk_in
;
a.read_nxtsectr: lda currnt.sectr
         sta daux1
         lda currnt.sectr+1
         sta daux2
         lda infn+1
         sta ddevic
         and #$0f
         sta dunit
         lda #$52    ;READ SECTOR
         sta dcomnd
         clc
         lda buftop
         adc #1
         sta dbuflo
         lda buftop+1
         adc #0
         sta dbufhi
         jsr dskinv
         ldy dstats
         bpl a.goodread
         jmp io_err
;
a.goodread: clc
         lda buftop
         adc #$80
         sta buftop
         lda buftop+1
         adc #0
         sta buftop+1
         jmp a.sectr_chkbuf
;
a.havsectors: jmp docarry
;----------------------------
;
sector_block: lda #0
         sta currnt.sectr
         sta currnt.sectr+1
         lda s.org
         sta pc
         lda s.org+1
         sta pc+1
set_blkptrs: jsr setndx
         jmp say_more
;----------------------------
;
zero_sector.map:
;
         lda #0
         ldx #90
a.zero_sector.map: sta sector.map,x
         dex
         bpl a.zero_sector.map
         rts
;----------------------------
;
get_sbit:
;
         lda #0
         sta xhi
         stx xlo
         tya
         ldx #3
a.by8:     lsr
         ror xlo
         ror xhi
         dex
         bne a.by8
         ldx #5
a.by32:    lsr xhi
         dex
         bne a.by32
         ldx xlo
         ldy xhi
         rts
;----------------------------

;        .PAGE "File Disassembly Routines"
;         .include file

;    ...   FILE   ...
;
;  File Disassembly Routines.
;
;----------------------------
;
file_dis:
;
         bcs file_disloop
         lda more.
         bne b.chk88
b.nevrmind: sec
         bcs b.nmj
;
b.chk88:   lda cioy
         cmp #$88
         beq b.nevrmind
         jsr setndx
         jsr setbsize
         jsr loadfile ;Yes, load buffer.
         bcc file_disloop
b.nmj:     jmp no_more ;EOF reached.
;
file_disloop: jsr orleft ;left.to.do>0?
         bne b.fdcont ;Yes.
         jsr zmore   ;more=0.
;
;Copy file segment address
;bytes to seg.adr.
;
         ldy #3
b.pcloop:  lda (bufptr),y
         sta seg.adr,y
         dey
         bpl b.pcloop
;
         clc         ;Bump bufptr past
         lda bufptr  ;address bytes.
         adc #4
         sta bufptr
         lda bufptr+1
         adc #0
         sta bufptr+1
;
;Check seg.adr to see if PC
;needs to be reset.
;
         lda seg.adr
         cmp pc
         bne b.reset_pc
         lda seg.adr+1
         cmp pc+1
         bne b.chkload
;
;pc=seg.adr:more=1
;Will just show new .ORG on
;next output line
;
b.reset_pc: lda seg.adr
         sta pc
         lda seg.adr+1
         sta pc+1
b.ld1:     sec
         jmp imore   ;more=1
;
;Get next byte to be dis-
;assembled - will be in X reg -
;then decrement left.to.do.
;
b.chkload: lda loadflag
         bne b.fdcont
         inc loadflag
         bne b.ld1
;
b.fdcont:  jsr fetch_byte
         lda left.to.do
         bne b.A2
         dec left.to.do+1
b.A2:      dec left.to.do
         jsr say_more ;more=1.
         txa
         rts
;
;------------------------
;File loading routines. =
;------------------------
;
loadfile: jsr chk_in  ;Check for right disk.
;
loadseg:  jsr check88
;
b.clib:    lda left.in.buf ;Check for
         ora left.in.buf+1 ;empty buffer.
         beq b.bufis_mt
         jsr chek_buf ;It's not.
         jsr fload
         jmp next
;
b.bufis_mt: lda binflag
         beq nextseg
         jmp nbload
;
nextseg:  jsr check88
         sec         ;Room in buffer
         lda bufsize ;for segment
         sbc #5      ;addresses?
         lda bufsize+1
         sbc #0
         bcs b.jladr  ;Yes.
         jmp docarry ;No.
;
b.jladr:   jsr load_adr
         beq b.jladr
         jsr load_end
;
;seg.size=seg.end-seg.org+1
;left.in.buf=seg.size.
;
         sec
         lda seg.end
         sbc seg.org
         sta seg.size
         lda seg.end+1
         sbc seg.org+1
         sta seg.size+1
         clc
         lda seg.size
         adc #1
         sta seg.size
         sta left.in.buf
         lda seg.size+1
         adc #0
         sta seg.size+1
         sta left.in.buf+1
;
;Copy start and end addresses
;into file buffer.
;
         ldy #4
b.sav_fhed: dey
         lda seg.org,y
         iny
         sta (buftop),y
         dey
         bne b.sav_fhed
         jsr bump4
         jsr chek_buf
         jsr fload
;
next:     jsr bumptop
         jmp nextseg ;Get next segment.
;
pla_eof:  pla
         pla
b.file_eof: jsr zmore  ;more=0
buf_full: jmp docarry
;
b.f_err:   sty cioy
         cpy #$88
         beq b.file_eof
         jmp io_err
;----------------------------
;
check88:  lda cioy
         cmp #$88
         beq pla_eof
         rts
;----------------------------
;
nbload:   jsr bump4
         jsr chek_buf
         jsr bload
         clc
         lda s.org
         sta bufadr
         adc icbll,x
         sta bufadr+2
         lda s.org+1
         sta bufadr+1
         adc icblh,x
         sta bufadr+3
         jsr bumptop
         cpy #$88
         beq b.file_eof
         bne buf_full
;----------------------------
;
;Bump buftop 4 bytes.
;
bump4:    clc
         lda buftop
         adc #4
         sta buftop
         lda buftop+1
         adc #0
         sta buftop+1
         rts
;----------------------------
;
;bufsize=freehi-buftop to
;Check for room in buffer.
         sbc icbll,x
;
chek_buf: sec
         lda freehi
         sbc buftop
         sta bufsize
         lda freehi+1
         sbc buftop+1
         sta bufsize+1
         bcc b.bjmp
         bne b.rume
         lda bufsize
         beq b.bjmp
b.rume:    rts
;
b.bjmp:    pla
         pla
         jmp docarry
;----------------------------
;
;buftop==+icbll,x.
;left.in.buf==-icbll,x.
;
bumptop:  clc
         lda buftop
         adc icbll,x
         sta buftop
         lda buftop+1
         adc icblh,x
         sta buftop+1
         sec
         lda left.in.buf
         sbc icbll,x
         sta left.in.buf
         lda left.in.buf+1
         sbc icblh,x
         sta left.in.buf+1
         rts
;----------------------------
;
;Open input file.
;
dofile:   jsr open_in
;
;left.in.buf=0
;seg.adr=left.to.do=0
;
b.zl.in.buf: lda #0
         sta left.in.buf
         sta left.in.buf+1
;
         ldx #3
b.zseg.adr: sta seg.adr,x
         dex
         bpl b.zseg.adr
         jmp set_blkptrs
;----------------------------



;        .PAGE "Write Equate file"
;         .include equs

;    ...   EQUS   ...
;
;-------------------------
; Routines to write Equate
; and .ASM files.
;
;-------------------------
;
write_equates:
;
         lda asmflg
         bne c.do_equates
         jsr endline
;
c.do_equates: jsr dash
         jsr blokclose
         lda totfiles
         lda # low inc_lino
         sta to.lino
         lda # high inc_lino
         sta to.lino+1
         lda totfiles
         sta mainfiles
         lda #0
         sta totfiles
         ldx #4
c.lolp:    lda secndno,x
         sta lnum,x
         dex
         bpl c.lolp
;
         jsr set_extender
         lda #'E'
         sta outfn,y
         lda #'Q'
         sta outfn+1,y
         jsr opn_disk
         lda #0
         sta files.size
         sta files.size+1
         lda # low sequ_m
         ldy # high sequ_m
         ldx #0
         jsr misc_line
         jsr dash
         ldx #0
c.nextpage: jsr setpage
         lda page
         cmp #$e4
         bne c.showthis
         jsr sho_fp
c.showthis: lda #0
         sta label.adr
c.pageloop: jsr reset_ptrs
         jsr getfirst
         bpl c.nx_label
         jsr getsecond
         bmi c.nx_label
         jsr to_pline
         lda page
         beq c.lopg
         jsr byte_to_hex
c.lopg:    lda label.adr
         jsr do_pline
c.nx_label: inc label.adr
         beq c._sysdone.
         lda label.adr
         cmp page.top
         bcc c.pageloop
         beq c.pageloop
;
c._sysdone.: lda page
         bne c.chkp3
         jsr sho_p0
         beq c._pagedone
c.chkp3:   cmp #3
         bne c._pagedone
         jsr sho_p3
;
c._pagedone: ldx pagex
         cpx tsize
         bcs c.chkforzeq
         jmp c.nextpage
;
c.chkforzeq: lda #1
         sta good.label
         lda zp.flag
         bne c.do_zqs
         jmp c.xeqs
;
c.do_zqs:  jsr dash
         lda # low zeq_m
         ldy # high zeq_m
         ldx #0
         jsr misc_line
         jsr dash
         jsr get_labelcount
         ldx #0
         stx this.lbl
         stx this.lbl+1
         stx label.adr
         stx label.adr+1
         beq c.ovritl
c.nxtzq:   jsr inths.lbl
c.ovritl:  inc label.adr
         sec
         lda label.count
         sbc this.lbl
         lda label.count+1
         sbc this.lbl+1
         bcc c.xeqs
         jsr point
         bne c.xeqs
         jsr andl
         bne c.nxtzq
         ldx #0
         jsr labelize
         lda #space
         sta printline,x
         jsr equlize
         ldy #0
         lda (label.ptr),y
         jsr do_pline
         jmp c.nxtzq
;
c.xeqs:    jsr dash
         lda # low xref_m
         ldy # high xref_m
         ldx #0
         jsr misc_line
         jsr dash
         jsr get_labelcount
         jsr zthis.lbl
         beq c.noxin
c.nxt_lbl: jsr inths.lbl
         jsr delcount
c.noxin:   lda label.count+1
         bmi c.ext_eqsdone
         jsr andl
         bne c.nxt_lbl
         ldx #0
         jsr labelize
         lda #space
         sta printline,x
         jsr equlize
         jsr point
         beq c.nxt_lbl
         jsr byte_to_hex
         dey
         lda (label.ptr),y
         jsr do_pline
         jmp c.nxt_lbl
;
c.ext_eqsdone: jsr dash
         lda asmflg
         bne c.closeqs
         jsr twospcs
         jsr set_extender
         jsr get_link
c.cfncr:   jsr write_line
;
c.closeqs: jsr blokclose
         lda dskon
         bne c.chkifle
         jmp disdone
c.chkifle: lda asmflg
         bne ifile
         jmp disdone
;
ifile:    ldy outdot
         lda #'A'
         sta outfn,y
         lda #'S'
         sta outfn+1,y
         lda #'M'
         sta outfn+2,y
         ldx #4
         lda #'0'
c.lulp:    sta lnum,x
         dex
         bpl c.lulp
         lda #'9'
         sta lnum+4
         jsr chk_out
         dec totfiles
         jsr set_extender
         lda #'E'
         sta outfn,y
         lda #'Q'
         sta outfn+1,y
c.eifloop: jsr get_link
         jsr write_line
         jsr nxt_outfn
         lda #0
         sta try
         dec totfiles
         bne c.eifloop
         lda mainfiles
         beq c.ifdun
         sta totfiles
         jsr set_extender
         lda #0
         sta mainfiles
         beq c.eifloop
;
c.ifdun:   jsr endline
         jsr dash
         jmp blokclose
;----------------------------
;
sho_p0:
         lda # low p0.labels
         sta syslabel
         lda # high p0.labels
         sta syslabel+1
         lda # low p0.adrlst
         sta c.show+1
         lda # high p0.adrlst
         sta c.show+2
         lda #12
         sta c.yy+1
c.sho0:    ldy #0
         sty ytemp
c.sho0_loop: jsr getfirst
         bpl c.nxt0
         jsr getsecond
         bmi c.nxt0
         jsr to_pline
         lda page
         beq c.show
         jsr byte_to_hex
c.show:    lda p0.adrlst,y
         jsr do_pline
c.nxt0:    ldy ytemp
         iny
c.yy:      cpy #12
         bcs c.p0shode
         sty ytemp
         jsr bumpsl.6
         jmp c.sho0_loop
;
c.p0shode: rts
;
sho_p3:
;
         lda # low p3.labels
         sta syslabel
         lda # high p3.labels
         sta syslabel+1
         lda # low p3.adrlst
         sta c.show+1
         lda # high p3.adrlst
         sta c.show+2
         lda #11
         sta c.yy+1
         bne c.sho0
;----------------------------
;
sho_fp:
;
         lda # low fp.labels
         sta syslabel
         lda # high fp.labels
         sta syslabel+1
         ldy #0
         sty ytemp
c.sfploop: jsr getfirst
         bpl c.nfp
         jsr getsecond
         bmi c.nfp
         jsr to_pline
         lda fp.adrlst+1,y
         jsr byte_to_hex
         lda fp.adrlst,y
         jsr do_pline
c.nfp:     ldy ytemp
         iny
         iny
         cpy #66
         beq c.fpshode
         sty ytemp
         clc
         lda syslabel
         adc #6
         sta syslabel
         lda syslabel+1
         adc #0
         sta syslabel+1
         bne c.sfploop
;
c.fpshode: rts
;----------------------------
;
setpage:  ldy #0
c.nploop:  lda page.table,x
         sta page.loc,y
         inx
         iny
         cpy #5
         bne c.nploop
         stx pagex
         rts
;----------------------------
endline:
;
         jsr onespace
         lda # low end_m
         ldy # high end_m
         ldx #7
         jsr misc_line
         rts
;----------------------------
;
andl:     jsr get_lbit
         and bit.table,x
         rts
;----------------------------


;        .PAGE "Data File Routines"
;         .include byte

;      ... BYTE ...
;
;Routines to create data files
;for Action!, Assembler, and
;BASIC.
;
;Entry - A reg = 'A, 'B, or 'D
;ANDing results in 0=ACTION,
;2=Assembler, & 4=BASIC.  Use
;result as an index.
;
abd_tbl:  dc.w action,assembler
         dc.w basic
;
datafile: and #6
         sta mode
         tax
         lda abd_tbl,x ;Set JMP
         sta langjmp+1 ;to called
         lda abd_tbl+1,x ;routine.
         sta langjmp+2
         lda asmflg  ;Save these.
         sta oldifile
         lda lino.flag
         sta oldlino
         ldy #0      ;Zero byte count.
         sty totaldc.bs
         sty totaldc.bs+1
         iny         ;Turn off ASM file
         sty asmflg  ;flag.
d.fbylp:   iny         ;Find end of
         lda byte_m,y ;BYTE mnem.
         cmp #cr
         bne d.fbylp
         tya
         adc #3
         sta indent+1
         lda # low label.buffer
         sta labeltop
         lda # high label.buffer
         sta labeltop+1
         jsr setbuffer
         jsr get_infn ;Get input fname.
         jsr :2crs
d.out.:    jsr outfn_in ;Output fname.
         ldy #0      ;Indicate file not
         sta dskopnflg ;open
         lda inline  ;CR means screen
         cmp #cr     ;or printer output
         beq d.ovrout ;only.
;
d.dout:    lda inline+1 ;Check to
         cmp #':'     ;see if user used
         beq d.coln   ;a Dn: in output
         lda inline+2 ;filename and
         cmp #':'     ;set it to default
         beq d.coln   ;output drive if
         lda d2      ;not.
         sta outfn+1
d.coln:    iny
d.ovrout:  sty dskon   ;Write to disk.
         ldy #0
         sty crsinh
         lda infn+1
         cmp outfn+1
         beq d.same
         iny
d.same:    sty drives
         sty both.flag
;
;All for skipping over 6
;file header bytes.
;
         jsr printsi
;
         dc.b cr,cr,tab,"Skip over"
         dc.b " first 6 bytes? ",EM
;
d.yn:      jsr getcap
         ldy #1
         cmp #'Y'
         beq d.itsy
         cmp #'N'
         bne d.yn
         dey
d.itsy:    sty all.
         jsr newscreen
         jsr indisk_prmpt
         lda drives
         beq d.open_dat
         jsr outdisk_prmpt
d.open_dat: jsr open_in
         jsr set_buffer
         jsr load_dat
         lda scr
         sta sdmctl
langjmp:  jmp dummy
;-----------------------------
;
action:
;
         lda #1      ;No line numbers!
         sta lino.flag
         lda # low printline
         sta line.ptr
         lda # high printline
         sta line.ptr+1
         lda # low code_m ;define an
         ldy # high code_m ;Action!
         jsr nameit  ;PROC.
         lda #'['
         sta printline+2
         lda #cr
         sta printline+3
         jsr write_line
         jmp doloop
;-----------------------------
;
assembler:
;
         lda # low mega_m ;Add a label.
         ldy # high mega_m
         jsr nameit
         jmp doloop
;
;-----------------------------
;
basic:
;
d.bloop:   jsr loopset
         ldx #0
         lda # low data_m
         sta from+1
         lda # high data_m
         sta from+2
         jsr move
         lda #space
         sta printline,x
d.bloop2:  stx xsave
         jsr readbyt
         jsr shodecml
         jsr repoint
         bcc d.bold
         jsr xload_dat
         ldx xsave
d.bold:    jsr oneless
         bcc d.bloop2
         bcs d.bloop
;-----------------------------
;
nameit:   ldx #0
         jsr misc_line
         jsr onespace
         jmp clr_printline
;
;
loopset:  lda bytes
         sta bytemax
         jsr clr_printline
         lda mode
         and #2
         beq d.lpsx
         jsr setbyte
d.lpsx:    jsr getx
         tax
         rts
;
;
readbyt:  ldy #0
         lda (bufptr),y
         ldy mode
         cpy #4
         beq d.rdbx
         jmp byte_to_hex
;
d.rdbx:    rts
;
;
repoint:   inw  totaldc.bs
          inw  bufptr
         lda bytecount
         bne d.aloA
         dec bytecount+1
d.aloA:    dec bytecount
         lda bytecount
         ora bytecount+1
         bne d.clrx
         sec
         rts
;
;
oneless:  dec bytemax
         bne comma
         jsr linefull
         sec
         rts
;
comma:    lda mode
         beq d.clrx
         lda #','
         sta printline,x
         inx
d.clrx:    clc
         rts
;
;
chekline: lda printline,y
         cmp #space
         bne linefull
         rts
;
linefull: lda #cr
         sta printline,x
         jmp write_line
;
;
closedat: jsr move
         jsr write_line
         jmp blokclose
;
;
doloop:   jsr loopset
;
d.loop2:   lda #'$'
         sta printline,x
         inx
         jsr readbyt
         jsr repoint
         bcc d.nold
         jsr xload_dat
         ldx xsave
d.nold:    jsr oneless
         bcc d.loop2
         bcs doloop
;-----------------------------
;
xload_dat: stx xsave
load_dat: lda cioy
         cmp #$88
         bne d.skip6
         pla
         pla
         jmp datdun
;
d.skip6:   lda all.
         beq fillbuffer
         lda #6
         sta bufsize
         lda #0
         sta all.
         sta bufsize+1
         jsr bload
;
fillbuffer: jsr set_buffer
         jsr bload
         clc
         lda icbll,x
         sta bytecount
         adc buftop
         sta buftop
         lda icblh,x
         sta bytecount+1
         adc buftop+1
         sta buftop+1
         jsr chk_out
         clc
         rts
;
;
set_buffer: lda buffer
         sta bufptr
         sta buftop
         lda buffer+1
         sta buftop+1
         sta bufptr+1
         sec
         lda freehi
         sbc buffer
         sta bufsize
         lda freehi+1
         sbc buffer+1
         sta bufsize+1
         clc
         rts
;-----------------------------
;
datdun:   jsr getx
         tay
d.kpy:     jsr chekline
         jsr clr_printline
         lda mode
         bne d.asmdun
;
         lda #']'
         sta printline+2
         lda #cr
         sta printline+3
         jsr write_line
         jmp a_end
;
;
d.asmdun:
;
         and #2
         beq d.basdun
a_end:    jsr clr_printline
         lda #';'
         sta printline
         jsr showcount
         jmp bytexit
;
;
d.basdun:
;
         lda # low rem_m
         ldy # high rem_m
         ldx #0
         jsr misc_line
         ldx #0
         jsr move
         lda #space
         sta printline,x
         inx
         inx
         jsr showcount
;
bytexit:  lda oldlino
         sta lino.flag
         lda oldifile
         sta asmflg
         lda line.start
         sta line.ptr
         lda line.start+1
         sta line.ptr+1
         jmp bydone
;-----------------------------
;
showcount: ldx #5
         stx xsave
         lda totaldc.bs
         sta fr0
         lda totaldc.bs+1
         sta fr0+1
         jsr Adecimal
         jsr recover
         lda # low size_m
         sta from+1
         lda # high size_m
         sta from+2
         jsr closedat
         rts
;
;
shodecml: jsr decimal
recover:  ldy #$ff
         ldx xsave
d.mvfp:    iny
         lda (inbuff),y
         sta printline,x
         bmi d.fplast
         inx
         bne d.mvfp
d.fplast:  and #$7f
         sta printline,x
         inx
         rts
;
;
setbyte:  lda # low byte_m
         sta from+1
         lda # high byte_m
         sta from+2
         ldx #4
         jsr move
         lda #space
         sta printline,x
         rts
;-----------------------------
getx:     lda mode
         lsr
         tay
         lda indent,y
         rts
;
;
indent:   dc.b 4,7,5
;-----------------------------


;----------------------------
;BYTE_TO_HEX converts the byte
;in the A register to hex and
;stores it in PRINTLINE. The
;X reg is used for the index
;index into PRINTLINE.
;----------------------------
;
byte_to_hex:
;
         pha         ;Save the A reg.
         lsr        ;Get the hi
         lsr        ;nibble.
         lsr
         lsr
         jsr hex_nibble ;Convert it.
         sta printline,x ;Save it
         inx
         pla         ;Restore A reg.
         and #$0f    ;Get lo nibble.
         jsr hex_nibble ;Convert it.
         sta printline,x ;Save it.
         inx
         rts
;
hex_nibble: sty tempy
         tay
         lda hextbl,y
         ldy tempy
got_nibble: rts
;
;----------------------------
;SHOW_HEX converts the byte
;in the A register to hex and
;prints it to the screen
;preceded by a '$.
;----------------------------
;
show_hex:
         pha
         lda #'$'
         jsr putchar
         pla
;
just_sho: pha
         lsr
         lsr
         lsr
         lsr
         jsr hex_nibble
         jsr putchar
         pla
         and #$0f
         jsr hex_nibble
         jsr putchar
         rts
;
;----------------------------
;DIGITIZE converts a number
;stored in inline to binary.
;The number can be either
;decimal or hex.  The result
;will be stored in NUMBER.
;----------------------------
;
digitize:
;
         lda #'D'
         sta hex.flag
         lda # low inline
         sta sptr
         lda # high inline
         sta sptr+1
         ldy #0
         ldx #0
         stx number
         stx number+1
         stx xsave
;
d.find_dig: lda (sptr),y
         cmp #space
         beq d.inc_ptr
         cmp #'0'
         bne d.hex.
;
d.inc_ptr: jsr inw.sptr
         bne d.find_dig
;
d.hex.:    cmp #'$'
         bne d.next_dig
         lda #'H'
         sta hex.flag
         jsr inw.sptr
         bne d.find_dig
;
d.next_dig: lda (sptr),y
         cmp #cr
         beq d.x_0.
         cmp #','
         bcc d.uh_oh
         beq d.x_0.
         cmp #'-'
         beq d.x_0.
         cmp #'0'
         bcc d.uh_oh
         cmp #':'
         bcc d.got_dig
         cmp #'A'
         bcc d.uh_oh
         lda #'H'
         sta hex.flag
         lda (sptr),y
         cmp #'G'
         bcc d.got_dig
         cmp #'H'
         bne d.uh_oh
         jmp d.x_0.
;
d.got_dig: inx
         jsr inw.sptr
         bne d.next_dig
;
d.uh_oh:   sec
         rts
;
d.x_0.:    txa
         stx xsave
         bne d.dec_or_hex.
         clc
         rts
;
d.dec_or_hex.: lda hex.flag
         cmp #'H'
         bne d.dcmltest
;
d.its_hex: cpx #5
         bcc d.do_hex
         sec
         rts
;
d.do_hex:  jsr dew_sptr
         lda (sptr),y
         jsr sbc_ascii
         sta number
         dex
         beq d.good_hexit
         jsr dew_sptr
         lda (sptr),y
         jsr sbc_ascii
         asl
         asl
         asl
         asl
         ora number
         sta number
         dex
         beq d.good_hexit
         jsr dew_sptr
         lda (sptr),y
         jsr sbc_ascii
         sta number+1
         dex
         beq d.good_hexit
         jsr dew_sptr
         lda (sptr),y
         jsr sbc_ascii
         asl
         asl
         asl
         asl
         ora number+1
         sta number+1
;
d.good_hexit: clc
         rts
;
dew_sptr: lda sptr
         bne d.A3
         dec sptr+1
d.A3:      dec sptr
         rts
;
sbc_ascii: sec
         sbc #'0'
         cmp #10
         bcc d.ascii_dun
         sbc #7
d.ascii_dun: rts
;
d.dcmltest: cpx #6
         bcc ascii_to_bin
         sec
         rts
;
ascii_to_bin: lda # low inline
         sta inbuff
         lda # high inline
         sta inbuff+1
         lda #0
         sta cix
         jsr afp
         bcc d.success
         rts
;
d.success: jsr fpi
         lda fr0
         sta number
         lda fr0+1
         sta number+1
         bcs d.noclc
         clc
d.noclc:   rts
;
;----------------------------
;DECIMAL converts the number
;in the A reg to Decimal.
;----------------------------
;
decimal:
;
         sta fr0
         lda #0
         sta fr0+1
Adecimal: jsr ifp
         jmp fasc
;----------------------------
;
opene:
;
;          close  0
         ldx #0
         jsr close.r


         lda #12
         sta icax1
         lda # low e
         sta icbal
         lda # high e
         sta icbah
         jmp opnly
;
;----------------------------
;Routines to print characters
;to the screen....
;
;CLS clears screen.
;PUTH prints a '$'.
;PUTCR prints a carriage return.
;PUTSPACE prints a space
;PUTCHAR prints char in A reg.
;----------------------------
;
cls:      lda #cls.
         bne putchar
:3crs:    jsr putcr
:2crs:    jsr putcr
putcr:    lda #cr
         bne putchar
putspace: lda #space
;
putchar:  pha         ;Save A and Y
         tax         ;Registers.
         tya
         pha
         txa
         ldx #0
         stx escflg
         stx icbll
         stx icblh
         ldy #bput.
         sty iccom
         jsr ciov
         pla         ;Restore Regs.
         tay
         pla
         rts
;
;----------------------------
;
;Prints string from memory
;then jumps over it.  Mark
;end of String with a $FF.
;----------------------------
;
printsi:    pla         ;Get String adr
         sta sptr    ;from stack.
         clc
         adc #1
         sta icbal
         pla
         sta sptr+1
         adc #0
         sta icbah
         ldy #0      ;Set length
         sty icbll   ;to zero.
         sty icblh
d.srch:    lda (sptr),y ;Search for
         cmp #em     ;end of string.
         beq d.eom
         jsr inw.sptr
         inc icbll
         bne d.srch
         inc icblh
         bne d.srch
;
d.eom:     lda sptr+1  ;Put new return
         pha         ;adr on stack.
         lda sptr
         pha
         ldx #0
         jmp bput
;
;----------------------------
;       Beep routine
;----------------------------
;
noise:    lda #18
         sta audf1
         lda #$af
         sta audc1
         ldy #25
         jsr Await
d.decay:   sta audc1
         ldy #8
         jsr Await
         sbc #1
         cmp #$9f
         bne d.decay
         rts
;
Await:    dex
         bne Await
         dey
         bne Await
         rts
;
;----------------------------
;GETKEY gets a keypress from
;keyboard using channel 4.
;Does not echo to screen.
;Entry point at GK skips
;noise prompt.
;----------------------------
;
getcap:   lda #$40
         sta shflok
         lda #0
         sta invflg
;
getkey:   jsr noise
gk:       lda #$ff
gk1:      sta ch
;          close  4
         ldx #$40
         jsr close.r

         lda # low k
         sta icbal,x
         lda # high k
         sta icbah,x
         lda #xread
         sta icax1,x
         jsr opnly
         lda #em
         ldy #0
;
d.ch:      sty 77
         cmp ch
         beq d.ch
         tya
         sta icbll,x
         sta icblh,x
         jsr bget
         cmp #cr
         beq d.kok
         cmp #esc
         beq d.kok
         cmp #backsp
         beq d.kok
         cmp #$7b
         bcs getkey
         cmp #space
         bcc getkey
;
d.kok:     rts
;----------------------------
;
getreturn: jsr getkey
         cmp #cr
         bne getreturn
         rts
;
;----------------------------
;
checkkey: jsr getcap
         cmp #esc
         bne d.isitcr
         jsr printsi
         dc.b $1c,$9c,$9c,em
         sec
         rts
;
d.isitcr:  cmp #cr
         bne checkkey
         clc
         rts
;----------------------------
;
;GETLINE gets a line of input
;from keyboard and echos to
;screen. Enter with maximum
;number of characters to be
;allowed in the A register.
;Input is terminated by a
;carriage return.
;----------------------------
;
;
getnum:   lda #5
getline:  sta maxlen
         lda #0      ;Turn on
         sta crsinh  ;the cursor.
         jsr printsi
         dc.b "  ",EM
         ldy maxlen
;
d.clr_buf: lda #cr     ;Clear input
         jsr Aaddchar ;buffer
         dey
         bpl d.clr_buf
         jsr noise   ;Beep
         ldy #0
;
d.nxt_letr: sty ytemp  ;Save index.
         jsr gk      ;Get a character.
         ldy ytemp   ;Restore index.
         cmp #esc
         bne d.bsp.
         inc crsinh
         rts
;
d.bsp.:    cmp #backsp
         beq d.bak_spce
         cmp #cr
         beq d.gotline
         cpy maxlen
         beq d.nxt_letr
         jsr putchar
         jsr Aaddchar
         iny
         bne d.nxt_letr
;
d.bak_spce: cpy #0     ;Handle a
         beq d.nxt_letr ;backspace.
         jsr putchar
         dey
         lda #cr
         jsr Aaddchar
         bmi d.nxt_letr
;
d.gotline: dey
         sta crsinh
         jmp putspace
;
Aaddchar: sta inline,y ;Add input.
         rts
;----------------------------
;
sho_address: lda address
         cmp #space
         bne shopc
         rts
;
shopc:    lda #5
         sta icbll,x
         lda #0
         sta icblh,x
         lda # low address
         sta icbal,x
         lda # high address
         sta icbah,x
         jmp bput
;
;----------------------------
;
to_lino:  jmp (to.lino)
;
;----------------------------
;PRINT_LINE prints a line of
;up to 40 characters to
;whichever channel the X reg
;is pointing to.  Address of
;string must be in LINE.PTR.
;Location 77 is poked with a
;zero here to keep the screen
;from going to attract mode.
;----------------------------
;
print_line:
;
         lda line.ptr
         sta icbal,x
         lda line.ptr+1
         sta icbah,x
         lda #putrec.
         sta iccom,x
         lda #60
         sta icbll,x
         lda #0
         sta icblh,x
         sta 77
         jmp ciov
;
;
;----------------------------
;WRITE_LINE writes a line of
;output to whichever devices
;are active.  Devices looked
;at are Disk, Screen, and
;Printer. The line is written
;using PRINT_LINE above.
;----------------------------
;
;
write_line: lda ch
         cmp #239    ;SHFT^Q
         bne d.write.1
         lda #$22
         sta sdmctl
         jmp start
;
;
d.write.1: lda lino.flag ;See whether to
         beq d.which. ;write a line #.
         jsr to_lino
;
d.which.:  lda dskon
         beq d.screen
         jsr chk_out
;
d.screen:  lda sdmctl  ;Screen on?
         beq d.disk   ;No.
         ldx #0
         jsr sho_address ;Print PC.
         jsr print_line ;Print line.
d.disk:    lda dskon
         beq d.printr
         ldy #0
         ldx linesize
         lda line.ptr
         sta sptr
         lda line.ptr+1
         sta sptr+1
d.lenloop: lda (sptr),y
         sta drvbuf,x
         cmp #cr
         beq d.gotlen
         inx
         iny
         bne d.lenloop
;
d.gotlen:  iny
         tya
         clc
         adc linesize
         sta linesize
         lda linesize+1
         adc #0
         sta linesize+1
         lda linesize
         bpl d.printr
         jsr putblock
;
d.printr:  ldx #chan3
         lda close.p. ;Option toggled?
         beq d.close_prntr ;Yes.
         lda is.p.opn. ;Printer open?
         bne d.prntr_is_opn ;Yes
         lda # low p
         sta icbal,x
         lda # high p
         sta icbah,x
         jsr ciopen
         bpl d.popnok
         lda #$fd    ;UHOH! Ring the
         jsr putchar ;lousy Bell!
         ldx #0      ;Then close the
         stx close.p. ;cottonpicker!
         jmp d.closep
;
d.popnok:  lda #$ff    ;Tell us it's
         sta is.p.opn. ;open
         jmp d.pdone
;
d.prntr_is_opn: jsr shopc
         jsr print_line
         jmp d.pdone
;
d.close_prntr: lda is.p.opn.
         beq d.pdone
         jsr print_line
;
d.closep:
;   close  3
         ldx #$30
         jsr close.r

         lda #0
         sta is.p.opn.
d.pdone:   rts
;----------------------------
;
putblock: lda linesize
         ora linesize+1
         beq d.blockput
;
d.putblk:  jsr chk_out
d.retry:   ldx #chan2
         lda # low drvbuf
         sta icbal,x
         lda # high drvbuf
         sta icbah,x
         lda linesize
         sta icbll,x
         lda linesize+1
         sta icblh,x
         jsr bput
         bmi d.bady
         lda #0
         sta linesize
         sta linesize+1
         clc
         lda files.size ;Add lines
         adc dbsize  ;length to
         sta files.size ;Filesize.
         lda files.size+1
         adc dbsize+1
         sta files.size+1
;
         lda files.size ;is room
         sbc max.fsize ;left in
         lda files.size+1 ;this file.
         sbc max.fsize+1
         bcc d.blockput ;There is.
         jsr opn_nxt_file ;isn't.
;
d.blockput: rts
;
d.bady:    cpy #$a2
         bne d.killit
         jsr newdisk
         bpl d.retry
;
d.killit:  jmp io_err
;----------------------------
;
opn_nxt_file:
;
         jsr nxt_outfn
         lda asmflg
         bne d.closeit
;
d.dotry:   lda #0
         sta files.size+1
         jsr write_line
         jsr twospcs
         jsr get_link
         jsr write_line
;
d.closeit: jsr putblock
d.noput:   jsr closedisk
d.opn_it:  jsr chk_out
         bmi d.opnerr
         rts
;
d.opnerr:  cpy #$a2
         beq d.fixa2
         jmp io_err
;
d.fixa2:   jsr newdisk
         jmp d.dotry
;----------------------------
;
opn_disk: lda dskon
         beq d.opnoop
         ldx #chan2
         lda # low outfn
         sta icbal,x
         lda # high outfn
         sta icbah,x
         jsr ciopen
         bmi d.opnoop
         inc dskopnflg
         inc totfiles
         lda #0
         sta try
         sta files.size
         sta files.size+1
d.opnoop:  rts
;
;----------------------------
;
;Load non-binary file.
;
bload:    ldx #chan1
; CLC
         lda buftop
; ADC #1
         sta icbal,x
         lda buftop+1
; ADC #0
         sta icbah,x
         lda bufsize
         sta icbll,x
         lda bufsize+1
         sta icblh,x
         lda #bget.
         sta iccom,x
         jsr ciov
         sty cioy
         bpl d.goodbl
         cpy #$88
         beq d.goodbl
         jmp io_err
;
d.goodbl:  rts
;----------------------------
;
;Load .ORG address from
;input file into seg.org.
;
load_adr: ldx #chan1
         lda # low seg.org
         sta icbal,x
         lda # high seg.org
         sta icbah,x
         lda #bget.
         sta iccom,x
         lda #2
         sta icbll,x
         lda #0
         sta icblh,x
d.get2:    jsr ciov
         bpl d.2ok
         jmp b.f_err
;
d.2ok:     lda seg.org ;$FFFF adr
         and seg.org+1 ;header?
         cmp #$ff
         rts
;
load_end: lda # low seg.end ;Get end
         sta icbal,x ;address of segment.
         lda # high seg.end
         sta icbah,x
         jsr ciov
         bpl d.goodadr
         jmp b.f_err
;
d.goodadr: rts
;----------------------------
;
;Load as much of file segment
;as will fit in buffer.
;
fload:    ldx #chan1
         lda left.in.buf
         sta icbll,x
         lda left.in.buf+1
         sta icblh,x
         sec
         lda bufsize
         sbc left.in.buf
         lda bufsize+1
         sbc left.in.buf+1
         bcs d.got_flen
         lda bufsize
         sta icbll,x
         lda bufsize+1
         sta icblh,x
d.got_flen: lda #bget.
         sta iccom,x
         clc
         lda buftop
         adc #1
         sta icbal,x
         lda buftop+1
         adc #0
         sta icbah,x
         jsr ciov
         sty cioy    ;Save CIO status.
         rts
;----------------------------
;
;
open_in:
;   close  1
         ldx #$10
         jsr close.r

         lda # low infn
         sta icbal,x
         lda # high infn
         sta icbah,x
         lda #xread
         sta icax1,x
         lda #open.
         sta iccom,x
         jsr ciov
         bpl d.inok
         jmp io_err
;
d.inok:    sty cioy
         ldx #1
         stx dskopnflg
         dex
         stx which.bytek
         rts
;----------------------------

;        .PAGE "Misc Subroutines"
;         .include misc
;  ...  MISC  ...
;
;----------------------------
;VBI routine checks to see if
;START or OPTION is pressed.
;START flips screen on/off.
;OPTION flips printer on/off.
;----------------------------
vbi:      lda consol
         and #5
         eor #5
         bne d.button_pressed
         lda vbi.timer ;Built in
         beq xitvbi  ;debounce.
         dec vbi.timer
         jmp xitvbi
;
d.button_pressed: sta button
         lda vbi.timer
         bne xitvbi
         lda #5      ;Set timer.
         sta vbi.timer
         lda button  ;See which button
         cmp #4
         bne d.start_buttn
         lda close.p. ;It's OPTION so
         eor #$ff    ;flip printer flag.
         sta close.p.
d.start_buttn: lda button
         cmp #1
         bne xitvbi
         lda sdmctl  ;It's START so
         eor #$22    ;flip screen.
         sta sdmctl
xitvbi:   jmp xitvbv
;
;----------------------------
;IR_AWAKE lets the user know
;that something is happening
;while the symbol table is
;is being built.
;----------------------------
;
ir_awake:
;
         lda ch
         cmp #239
         bne d.scr.
         jmp start
d.scr.:    lda sdmctl
         beq d.waked
d.swtch:   inc mymr    ;This instruction
         lda mymr    ;is flipped from
         bne d.mymrhi ;INC to DEC
         ldx #$ee    ;and back as
         stx d.swtch  ;the printed line
         bne d.mrok   ;gets to one
d.mymrhi:  cmp #17     ;side or the
         bne d.mrok   ;other of the
         ldx #$ce    ;screen.
         stx d.swtch
d.mrok:    sta colcrs
         jsr printsi   ;Print the line.
ir:       dc.b "Building Symbol Table.",CR,EM
d.waked:   rts
;
;----------------------------
;NORMALIZE will put 'Dn:' in
;front of a filename if it
;isn't already there. It uses
;whatever is in DN so change
;the default drive by changing
;DN+1 to desired drive #.
;Enter with the users filename
;in INLINE, the hi byte of the
;address where the legal file-
;name is to be stored in the
;Y reg and the lo byte in the
;A reg.
;----------------------------
;
normalize:
;
         sta d.tl+1   ;Set address
         sta d.tl1+1  ;of filename.
         sta d.tl2+1
         sty d.tl+2
         sty d.tl1+2
         sty d.tl2+2
         ldy #0      ;Check to see
         lda inline+2 ;if user
         cmp #':'     ;entered 'Dn:'.
         beq d.fcont
         lda inline+1
         cmp #':'
         bne d.fchkd
         lda inline
         cmp #'D'
         bne d.fcont
d.fchkd:   ldx #2      ;He didn't.
d.fdnloop: lda dn,x
d.tl:      sta dummy,x
         dex
         bpl d.fdnloop
         ldy #3
;
d.fcont:   ldx #0
d.floop:   lda inline,x ;Copy the
d.tl1:     sta dummy,y ;Users filename.
         cmp #cr
         beq d.fndone
         inx
         iny
         bne d.floop
;
d.fndone:  clc
d.tl2:     lda dummy
         cmp #'E'
         beq d.fnsec
         cmp #'S'
         bne d.fnxit
d.fnsec:   sec
d.fnxit:   rts
;----------------------------
;
misc_line:
;
         jsr move_line
         jmp write_line
;
dash:
;
         lda # low dash_m
         ldy # high dash_m
         ldx #0
         jsr misc_line
;
onespace: lda #0
spacer:   sta spaces
         lda # low spacer_m
         ldy # high spacer_m
         ldx #0
         jsr misc_line
         dec spaces
         bpl spacer
         rts
;
twospcs:  lda #1
         bne spacer
;----------------------------
;
move_line:
;
         sta from+1
         sty from+2
         stx xsave
;
         jsr clr_printline
         ldx xsave
move:     ldy #0
from:     lda dummy,y
         sta printline,x
         cmp #cr
         beq d.exit_moov
         inx
         iny
         bne from
;
d.exit_moov: rts
;----------------------------
;
get_link:
;
         lda # low link_m
         ldy # high link_m
         ldx #7
         jsr move_line
         lda #space
         sta printline,x
         dex
         lda printline,x
         sta incend
         ldy #0
         inx
         txa
         pha
         lda # low outfn
         sta from+1
         lda # high outfn
         sta from+2
         jsr move
         lda incend
         cmp #'"'
         bne d.lnkdone
         sta printline,x
         lda #cr
         sta printline+1,x
d.lnkdone: pla
         tay
         lda da
         sta printline+1,y
         rts
;
;----------------------------
;
compute_address:
;
         ldx #0
         ldy #1
d.adr_loop: lda pc,y
         lsr
         lsr
         lsr
         lsr
         jsr hex_nibble
         sta address,x
         inx
         lda pc,y
         and #$0f
         jsr hex_nibble
         sta address,x
         inx
         dey
         bpl d.adr_loop
         lda #space
         sta address,x
         rts
;----------------------------
;
sho_org:
;
         lda dskopnflg
         bne d.orgit
         jsr chk_out
         bpl d.orgit
         jmp io_err
;
d.orgit:   ldy #6
d.mvplin:  lda printline,y
         sta inline,y
         dey
         bpl d.mvplin
         jsr onespace
         lda inline
         cmp #space
         beq d.ovrmv
         ldy #6
d.rvplin:  lda inline,y
         sta printline,y
         dey
         bpl d.rvplin
         lda #cr
         sta printline+7
         jsr write_line
         jsr onespace
d.ovrmv:   jsr onespace
         jsr clr_printline
         ldy #0
         ldx #7
d.orgmloop: lda org_m,y
         cmp #cr
         beq d.orgliz
         sta printline,x
         inx
         iny
         bne d.orgmloop
;
d.orgliz:  inx
         inx
         lda #'$'
         sta printline,x
         inx
         ldy #1
d.orgloop: lda pc,y
         sta lastorg,y
         jsr byte_to_hex
         dey
         bpl d.orgloop
;
d.orged:   lda #cr
         sta printline,x
         jsr write_line
         jmp twospcs
;----------------------------
;
get_lino:
;
         ldx #4
         lda lnum,x
         cmp #'0'
         bne d.d0
         lda #'5'
         sta lnum,x
         rts
;
d.d0:      lda #'0'
         sta lnum,x
         dex
         bne d.linoloop
;
inc_lino: ldx #4
;
d.linoloop: ldy lnum,x
         iny
         cpy #':'
         bcc d.lino_ok
         lda #'0'
         sta lnum,x
         dex
         bpl d.linoloop
d.lino_ok: tya
         sta lnum,x
         rts
;----------------------------
;
nxt_outfn:
;
         lda try
         beq d.newext
         rts
;
d.newext:  inc try
         ldx outdot
         inx
         inx
d.incloop: ldy outfn,x
         iny
         cpy #':'
         bcc d.storinc
         lda #'0'
         sta outfn,x
         dex
         cpx outdot
         bne d.incloop
d.storinc: tya
         sta outfn,x
         rts
;----------------------------


;        .PAGE "Mini Subroutines"
;         .include mini
;  ...  MINI  ...
;
no_more:  sec
zmore:    lda #0
         sta more.
         rts
;----------------------------
;
say_more: clc
imore:    lda #1
         sta more.
         rts
;----------------------------
;
optolbl:  lda operand
         sta label.adr
         lda operand+1
         sta label.adr+1
         rts
;----------------------------
;
setprogc: lda pc
         sta label.adr
         lda pc+1
         sta label.adr+1
         rts
;----------------------------
;
orleft:   lda left.to.do
         ora left.to.do+1
         rts
;----------------------------
;
setndx:   sec
         lda buffer
         sta bufptr
         sbc #1
         sta buftop
         lda buffer+1
         sta bufptr+1
         sbc #0
         sta buftop+1
         rts
;----------------------------
;
setbsize: sec
         lda freehi
         sbc buftop
         sta bufsize
         lda freehi+1
         sbc buftop+1
         sta bufsize+1
         rts
;----------------------------
;
docarry:  sec
         lda buftop+1
         sbc buffer+1
         beq d.lo.
         bcs d.clc
d.lo.:     lda buftop
         sbc buffer
         beq d.sec
         bcs d.clc
;
d.sec:     sec
         rts
;
d.clc:     clc
         rts
;----------------------------
;
to_pline: jsr clr_printline
         ldy #0
d.toplp:   jsr and7f
         sta printline,y
         iny
         cpy #6
         bne d.toplp
         jsr equlize
         ldy ytemp
         rts
;----------------------------
;
do_pline: jsr byte_to_hex
pline_out: lda #cr
         sta printline,x
         jmp write_line
; JMP CLR_PRINTLINE
;----------------------------
;
setl.index: lda # low label.buffer
         sta label.ptr
         lda # high label.buffer
         sta label.ptr+1
         rts
;----------------------------
;
c.ladr:   lda (label.ptr),y
         cmp label.adr,y
         rts
;----------------------------
;
andspace: lda (syslabel),y
         and #$7f
         cmp #space
         rts
;----------------------------
;
and7f:    lda (syslabel),y
         and #$7f
         rts
;----------------------------
;
bumpsl.6: clc
         lda syslabel
         adc #6
         sta syslabel
         lda syslabel+1
         adc #0
         sta syslabel+1
         rts
;----------------------------
;
backloop: ldy #1
         jsr and7f
         pha
         sta offset
d.bkloop:  jsr backup
         dec offset
         bne d.bkloop
         pla
         sta offset
         rts
;----------------------------
;
backup:   sec
         lda syslabel
         sbc #6
         sta syslabel
         lda syslabel+1
         sbc #0
         sta syslabel+1
         rts
;----------------------------
;
zthis.lbl: lda #0
         sta this.lbl
         sta this.lbl+1
         rts
;----------------------------
;
ora80:    lda (syslabel),y
         ora #$80
         sta (syslabel),y
         rts
;----------------------------
;
get_labelcount:
;
         lda labels
         sta label.count
         lda labels+1
         sta label.count+1
         rts
;----------------------------
;
delcount: sec
         lda label.count
         bne d.1
         dec label.count+1
d.1:       dec label.count
         rts
;----------------------------
;
lbladrh:  lda #0
         sta label.adr+1
         rts
;----------------------------
;
inths.lbl: inc this.lbl
         bne d.insk
         inc this.lbl+1
d.insk:    rts
;----------------------------
;
point:    clc
         lda # low label.buffer
         adc this.lbl
         sta label.ptr
         lda # high label.buffer
         adc this.lbl+1
         sta label.ptr+1
         lda label.ptr
         adc this.lbl
         sta label.ptr
         lda label.ptr+1
         adc this.lbl+1
         sta label.ptr+1
         ldy #1
         lda (label.ptr),y
         rts
;
;----------------------------
;
getfirst: ldy #0
         lda (syslabel),y
         rts
;
getsecond: ldy #1
         lda (syslabel),y
         rts
;
;----------------------------
;
cheknum:
;
         cmp #'1'
         bcc d.badnum
         cmp #':'
         bcs d.badnum
         dc.b $24
d.badnum:  sec
         rts
;----------------------------
;
addtosptr: clc
         adc sptr
         sta sptr
         lda sptr+1
         adc #0
         sta sptr+1
         rts
;----------------------------
;
inw.sptr: inc sptr
         bne d.A
         inc sptr+1
d.A:      rts
;----------------------------
;
inw.pcountr: inc pc
         bne d.A
         inc pc+1
         rts
;----------------------------
;
set_extender:
;
         ldy outdot
         lda #'0'
         sta outfn,y
         sta outfn+1,y
         sta outfn+2,y
         rts
;----------------------------
;
equlize:
;
         ldx #7
         ldy #0
lizloop:  lda eq_m,y
         cmp #cr
         beq d.lizdun
         sta printline,x
         inx
         iny
         bne lizloop
;
d.lizdun:  lda #'$'
         sta printline,x
         inx
         rts
;----------------------------
;
light:    lda #$22
         sta sdmctl
         sta sdm
         rts
;----------------------------
;
scr_on:
;
         lda sdmctl
         sta sdm
         lda #$22
         sta sdmctl
         rts
;
;----------------------------
;
restore_scr:
;
         lda sdm
         sta sdmctl
         rts
;
;----------------------------
;
newscreen:
;
         jsr cls
         lda #6
         sta rowcrs
         rts
;----------------------------
;
chk_in:   lda infn+1
         cmp outfn+1
         bne d.right
         lda which.bytek
         beq d.right
         jmp indisk_prmpt
d.right:   rts
;
chk_out:  lda infn+1
         cmp outfn+1
         bne d.dopn.
         lda which.bytek
         bne d.dopn.
         jsr outdisk_prmpt
d.dopn.:   lda $0360
         cmp #em
         bne d.right
         jmp opn_disk
;----------------------------
;
sixbytes: sta iccom,x
         lda #6
         sta icbll,x
         lda #0
         sta icblh,x
         jmp ciov
;----------------------------
;
blokclose: jsr putblock
         jmp closedisk
;----------------------------
;
closedisk:
;  close  2
         ldx #$20
         jsr close.r

         lda #0
         sta dskopnflg
         rts
;----------------------------
;
bput:     lda #bput.
         sta iccom,x
         jmp ciov
;----------------------------
;
ciopen:   lda #xwrite
         sta icax1,x
opnly:    lda #open.
         sta iccom,x
         jmp ciov
;----------------------------
;
bget:     lda #bget.
         sta iccom,x
         jmp ciov
;----------------------------
;
close.r:
;
         lda #close.
         sta iccom,x
         jmp ciov
;
;----------------------------
;CLOSEALL closes channels
;one through seven.
;----------------------------
;
closeall:
;
         ldx #$70
d.closelp: jsr close.r
         txa
         sbc #$10
         tax
         bne d.closelp
         rts
;----------------------------
;
clrstack: ldx #$ff
         txs
         jmp start
;----------------------------

;        .PAGE "Prompt Subroutines"
;         .include talk
;       ... TALK ...
;
outfn_in:
;
         jsr printsi
         dc.b cr,cr,tab,space
         dc.b " Enter "
         dc.b <+128>,"OUTPUT"
         dc.b " Filename",CR,TAB
         dc.b "  WITH NO EXTENDER!",EM
d.get_it:  jsr printsi
         dc.b cr,cr,tab,em
;
         lda #$20
         jsr getline
         cmp #esc
         bne d.good_out
         jmp clrstack
;
d.good_out: lda inline
         cmp #cr
         bne d.fixout
         sec
         rts
;
d.fixout:  lda # low outfn ;Make sure
         ldy # high outfn ;we have a
         jsr normalize ;legal fname.
         bcs outfn_in
         lda inline+2
         cmp #':'
         beq d.ofnk
         lda d2
         sta outfn+1
;
;Make sure user didn't enter
;an extender stripping it if
;he did then set extender to
;'.000'.
;
d.ofnk:    sty ytemp
         dey
d.dotloop: lda outfn,y
         cmp #'.'
         beq d.gotdot
         dey
         bne d.dotloop
         lda #'.'
         ldy ytemp
;
d.gotdot:  sta outfn,y
         iny
         sty outdot
         jsr set_extender
         lda #cr
         sta outfn+3,y
         lda #em
         sta outfn+4,y
         clc
         rts
;----------------------------
;
get_start: lda #1
         sta lmarg
         jsr newscreen
start_adr: jsr printsi
         dc.b cr,tab,"Enter Start Add"
         dc.b "ress: ",EM
;
         jsr getnum
         cmp #esc
         bne d.scont
         jmp clrstack
;
d.scont:   jsr digitize
         bcs d.s_err
         lda number
         sta s.org
         lda number+1
         sta s.org+1
         rts
;
d.s_err:   jsr input_err
         jmp start_adr
;----------------------------
;
get_infn: jsr newscreen
;          position  7,6
         lda #7
         sta colcrs
         lda #6
         sta rowcrs


         jsr printsi
         dc.b "Enter name of "
         dc.b <+128>,"INPUT"
         dc.b " file.",CR,CR,TAB,EM
;
         lda #$20    ;Allow 32 chars
         jsr getline ;in filename.
         cmp #esc
         bne d.fixinfn
         jmp clrstack
;
d.fixinfn: lda # low infn ;Go make it
         ldy # high infn ;legal if it
         jsr normalize ;isn't already.
         bcs get_infn
         rts         ;Move on.
;----------------------------
;INDISK_PRMPT prompts user to
;to insert input disk.
;----------------------------
;
indisk_prmpt:
;
         lda infn
         cmp #'D'
         beq d.prompt_em
         rts
;
d.prompt_em: jsr :3crs
         lda infn+1
         sta id1
         inc crsinh
         jsr printsi
         dc.b tab,"Put Input D"
         dc.b "isk in Drive "
id1:      dc.b "1,",CR,EM
         lda both.flag
         bne d.ipxit
         jsr printsi
         dc.b tab,"Then Pre"
         dc.b "ss RETURN...",EM
;
         jsr scr_on
         jsr checkkey
         bcc d.goahead
         jmp start
;
d.goahead: jsr :3crs
         lda #0
         sta which.bytek
d.ipxit:   jmp restore_scr
;
;----------------------------
;OUTDISK_PRMPT prompts the user
;to insert the output disk.
;----------------------------
;
outdisk_prmpt:
;
         lda outfn
         cmp #'D'
         beq d.prompt_er
         rts
;
d.prompt_er: lda outfn+1
         sta od1
         lda both.flag
         bne d.noclr
         jsr :2crs
d.noclr:   jsr printsi
         dc.b cr,tab,"Put Output "
         dc.b "Disk in Drive "
od1:      dc.b "1,",CR,CR
         dc.b tab,"Then Press "
         dc.b "RETURN...",EM
;
         stx both.flag
         jsr scr_on
         jsr checkkey
         bcc d.gotcha
         jmp start
;
d.gotcha:  jsr :3crs
         inc which.bytek
         jmp restore_scr
;----------------------------
;
not_binary:
;
         jsr newscreen
;          position  3,10
         lda #3
         sta colcrs
         lda #10
         sta rowcrs

         jsr printsi
         dc.b <+128>," This is not"
         dc.b <+128>," a binary lo"
         dc.b <+128>,"ad file. "
         dc.b cr,cr,em
;
         inc binflag
         jmp start_adr
;----------------------------
;
newdisk:
;
         jsr scr_on
d.inform:  jsr shoerr
         jsr closedisk
         lda #7
         sta lmarg
         sta colcrs
         lda outfn+1
         ora #$80
         sta d.nd
         jsr printsi
         dc.b cr,cr
         dc.b <+128>," Output Disk"
         dc.b <+128>," is Full. Pu"
         dc.b <+128>,"t ",ESC
         dc.b <+128>," New Disk in"
         dc.b <+128>," Drive "
d.nd:      dc.b <+128>,"1 Then ",ESC
         dc.b <+128>," Press RETUR"
         dc.b <+128>,"N or Drive  "
         dc.b <+128>,"  ",ESC
         dc.b <+128>," Number to S"
         dc.b <+128>,"witch Drives"
         dc.b <+128>,". "
	 dc.b	ESC,EM
;
d.gndrv:   jsr getkey
         cmp #esc
         bne d.ndcr.
         jmp start
;
d.ndcr.:   cmp #cr
         beq d.opnew
         cmp #'1'
         bcc d.gndrv
         cmp #':'
         bcs d.gndrv
         sta outfn+1
d.opnew:   jsr nxt_outfn
         jsr opn_disk
         bpl d.newok
         jmp d.inform
;
d.newok:   lda #1
         sta lmarg
         jsr :2crs
         jmp restore_scr
;----------------------------
;
bydone:   jsr setwhat
;          col  10
         lda #10
         sta colcrs

         jsr printsi
         dc.b <+128>," Data File C"
         dc.b <+128>,"omplete. "
         dc.b cr,cr,em
         jmp disdun1
;
nowhat.:  jsr setwhat
         jsr printsi
         dc.b <+128>," *** Disassembly"
         dc.b <+128>,"  Done *** "
         dc.b cr,cr,em
disdun1:  jsr printsi
         dc.b <+128>,"  Press RETURN t"
         dc.b <+128>,"o Continue,  "
         dc.b cr
         dc.b <+128>,"  or ESCAPE to E"
         dc.b <+128>,"xit to DOS   "
         dc.b cr,cr,em
         jsr light
         lda #1
         sta lmarg
;
d.adunlp:  jsr getcap
         cmp #cr
         bne d.escape.
         jmp start
;
d.escape.: cmp #esc
         bne d.adunlp
         jmp exit
;---------------------------
;
setwhat:  jsr :3crs
         ldy #7
         sty colcrs
         dey
         sty lmarg
         rts
;---------------------------
lblprmpt:
;  position  8,21
         lda #8
         sta colcrs
         lda #21
         sta rowcrs

         jsr printsi
         dc.b <+128>,"Put Disk With "
lname:    dc.b <+128>,"LABEL.XLE in"
	dc.b	EM
;          position  8,22
         lda #8
         sta colcrs
         lda #22
         sta rowcrs

         jsr printsi
         dc.b <+128>,"Drive "
lx:       dc.b <+128>,"1 Then Press"
         dc.b <+128>," RETURN "
	 dc.b	EM
;
         rts
;---------------------------

;        .PAGE "Error Routines"
;         .include errs
;    ...  ERRS  ...
;
;IO_ERR prints an error message
;including the I/O error number
;in both hex and decimal.
;At the prompt, ESCAPE exits
;to DOS and RETURN re-runs the
;program.
;----------------------------
;
shoerr:   tya
         pha
         pha
         jsr :2crs
         lda #space
         sta d.e-1
         sta d.e-2
         pla
         jsr decimal
         ldy #$ff
d.cpydec:  iny
         lda (inbuff),y
         bmi d.deccpd
         ora #$80
         sta inline,y
         bmi d.cpydec
d.deccpd:  sta inline,y
         iny
         tya
         tax
         lda #')'
         sta d.decerr,x
         dex
d.eloop:   lda inline,x
         sta d.decerr,x
         dex
         bpl d.eloop
         inx
         pla
         jsr byte_to_hex
         dex
d.hloop:   lda printline,x
         sta d.hexerr,x
         dex
         bpl d.hloop
         ldx #d.e-d.errline
d.elloop:  lda d.errline,x
         ora #$80
         sta d.errline,x
         dex
         bpl d.elloop
         lda #11
         sta colcrs
         jsr printsi
;
d.errline: dc.b " ERROR $"
d.hexerr:  dc.b "   ("
d.decerr:  dc.b "     "
d.e:       dc.b em
;
         rts
;----------------------------
;
io_err:   jsr shoerr
         lda #1
         sta lmarg
         jsr printsi
         dc.b cr,cr,tab,space
         dc.b "Press RETURN"
         dc.b " to Restart,"
         dc.b cr,cr,tab,space
         dc.b "or ESCAPE to"
         dc.b " Exit to DOS.",EM
;
         jsr scr_on
d.kylp:    jsr checkkey
         bcc d.rt
         jmp exit
;
d.rt:      jmp start
;
;----------------------------
;INPUT_ERR tells the user
;that he screwed up and to
;try again.
;----------------------------
;
in_err:   jsr printsi
         dc.b $1c,$9c,$9c,cr,em
         jmp d.setcol
;
input_err: jsr :2crs
d.setcol:  lda #5
         sta colcrs
         jsr printsi
         dc.b <+128>,"INPUT ERROR."
         dc.b <+128>,".. PLEASE TR"
         dc.b <+128>,"Y AGAIN."
         dc.b cr,cr,em
         rts
;----------------------------



;      ...   OPTN   ...
;
;Options menu to allow user to
;customize the program. The
;users choice will be deter-
;mined by the row the cursor
;is on when a key is pressed.
;
options:
;
         jsr opmenu
;
;Wait for either consol button
;or keypress.
;
d.whatkey:
;  col  24
         lda #24
         sta colcrs

         lda #$ff
         sta ch
         ldy #0
d.waitkey: sty 77
         lda consol
         cmp #5      ;SELECT?
         beq nextrow
         cmp #3      ;OPTION?
         beq lastrow
         cmp #6
         beq d.jtm
         lda ch
         cmp #$ff
         beq d.waitkey
         jsr gk1
         cmp #esc
         bne d.what.
d.jtm:     jmp to_menu
;
;----------------------------
;
nextrow:  ldy #1      ;Move
         sty ytemp   ;cursor down one
         jsr normvert ;row
         lda rowcrs
         cmp #20
         bne d.nxtok
         lda #2
         sta rowcrs
d.nxtok:   inc rowcrs
d.ivj:     jsr invert
         jmp d.wbit
;
lastrow:  sty ytemp   ;Move
         jsr normvert ;cursor up one
         lda rowcrs  ;row.
         cmp #3
         bne d.lstok
         lda #21
         sta rowcrs
d.lstok:   dec rowcrs
         jsr invert
;
;Wait a bit.
;
d.wbit:    lda #0
         sta 20
         lda #7
d.wbtlp:   cmp 20
         bne d.wbtlp
d.whj:     jmp d.whatkey
;----------------------------
;
d.what.:   cmp #cr
         beq nextrow
         pha         ;Figure out
         lda rowcrs  ;what routine
         asl        ;is being called
         tay         ;by which line cursor
         lda optn_tbl,y ;is on and load
         sta opjmp+1 ;called routines
         lda optn_tbl+1,y ;address into
         sta opjmp+2 ;OPJMP's operand
         pla         ;field.
opjmp:    jmp dummy
;----------------------------
;
indrv:    jsr cheknum ;Change
         bcs d.whj    ;Input drv #.
         sta dn+1
         jmp shodn
;
outdrv:   jsr cheknum ;Change
         bcs d.whj    ;Output drv #.
         sta d2
         jmp shodn
;
asmdrv:   jsr cheknum ;Change
         bcs d.whj    ;Asm drv #.
         sta da
         jmp shodn
;
flipscr:  cmp #space  ;Flip Screen
         bne d.whatjmp
         lda #24
         sta colcrs
         lda scr
         eor #$22    ;on/off.
         sta scr
         jsr on_off
         jmp nextrow
;
flipprt:  cmp #space  ;Flip Printer
         bne d.whatjmp
         lda #24
         sta colcrs
         lda prt
         eor #$ff    ;on/off.
         sta prt
         jsr on_off
         jmp nextrow
;
fliplino: cmp #space  ;Line
         bne d.whatjmp ;numbers
         lda lino.flag ;on/off
         eor #1
         sta lino.flag
         beq d.lineoff
         lda # low lnum
         sta line.start
         lda # high lnum
         sta line.start+1
         bne d.slno
;
d.lineoff: lda # low printline
         sta line.start
         lda # high printline
         sta line.start+1
d.slno:    lda lino.flag ;Show lino
         jsr yes_no  ;status.
         jmp nextrow
;
asmfile:  cmp #space  ;Flip
         bne d.whatjmp ;ASM file
         lda asmflg  ;flag on/off.
         eor #1
         sta asmflg
         jsr yes_no
         jmp nextrow
;
d.whatjmp: jmp d.whatkey
;
;
linebyts: jsr cheknum ;Set bytes
         bcs d.whatjmp ;per line.
         and #$0f
         sta bytes
         jsr shobytes
         jmp decnext
;
newfsize: jsr getdata ;Change
         jsr digitize ;output file
         bcs d.oldfs  ;size.
         lda number
         sta max.fsize
         lda number+1
         sta max.fsize+1
d.oldfs:   jsr shofsize
         jmp decnext
;
;
zflip:    jsr getdata ;Change
         bne d.mvzz   ;Zero-page
d.shz:     jsr shozmark ;label marker.
         jmp decnext
;
d.mvzz:    ldy #2
d.n9lp:    lda inline,y
         sta zmarker,y
         dey
         bpl d.n9lp
         bmi d.shz
;
;
mflip:    jsr getdata ;Change
         bne d.mvmm   ;Non zero-page
d.shm:     jsr shomark ;label marker.
         jmp decnext
;
d.mvmm:    ldy #2
d.n10lp:   lda inline,y
         sta marker,y
         dey
         bpl d.n10lp
         bmi d.shm
;
neworg:   jsr getdata ;Change
         beq d.oldorg ;assembler ORG
         jsr addspace ;directive.
         ldy #0
d.mvorg:   lda inline,y
         sta org_m,y
         cmp #cr
         beq d.orgmvd
         cpy #11
         bcs d.orgmvd
         iny
         bne d.mvorg
d.orgmvd:  lda #cr
         sta org_m,y
d.oldorg:  jsr shoorgm
         jmp decnext
;
neweq:    jsr getdata ;Change
         beq d.oldeqm ;EQUAL directive.
         jsr addspace
         ldy #0
d.mveq:    lda inline,y
         sta eq_m,y
         cmp #cr
         beq d.mveqdn
         cpy #11
         beq d.mveqdn
         iny
         bne d.mveq
d.mveqdn:  lda #cr
         sta eq_m,y
d.oldeqm:  jsr shoeq
         jmp decnext
;
newbyte:  jsr getdata ;Change
         beq d.oldbyt ;BYTE directive.
         jsr addspace
         ldy #0
d.mvbyt:   lda inline,y
         sta byte_m,y
         cmp #cr
         beq d.bytmvd
         cpy #11
         bcs d.bytmvd
         iny
         bne d.mvbyt
d.bytmvd:  lda #cr
         sta byte_m,y
d.oldbyt:  jsr shobytm
         jmp decnext
;
;
newlink:  jsr getdata ;Change
         beq d.oldlnk ;LINK directive.
         ldy #0
d.mvlnk:   lda inline,y
         sta link_m,y
         cmp #cr
         beq d.lnkmvd
         cpy #11
         bcs d.lnkmvd
         iny
         bne d.mvlnk
d.lnkmvd:  lda #cr
         sta link_m,y
d.oldlnk:  jsr sholink
         jmp decnext
;
newend:   jsr getdata ;Change
         beq d.oldend ;END directive
         jsr addspace
         ldy #0
d.mvend:   lda inline,y
         sta end_m,y
         cmp #cr
         beq d.endmvd
         cpy #11
         bcs d.endmvd
         iny
         bne d.mvend
d.endmvd:  lda #cr
         sta end_m,y
d.oldend:  jsr shoend
         jmp decnext
;
to_menu:  lda #1
         sta lmarg
         rts
;
d.jwhtky:  jmp d.whatkey
;----------------------------
;
decnext:  dec rowcrs
         jmp nextrow
;----------------------------
;
;Routine to invert line cursor
;is on.
;
invert:   jsr sety
d.ivlup1:  cpy #15
         beq d.iv
         jsr vert
         bne d.ivlup1
;
d.iv:      dey
         dey
d.ivlup2:  jsr vert
         bpl d.ivlup2
         rts
;----------------------------
;
;Routine to un-inverse line
;cursor is on before moving
;cursor to another line.
;
normvert: jsr sety
d.nvlup1:  cpy #15
         beq d.nv
         jsr trev
         bne d.nvlup1
;
d.nv:      dey
         dey
d.nvlup2:  jsr trev
         bpl d.nvlup2
         rts
;----------------------------
;
vert:     lda (sptr),y ;Invert a
         ora #$80    ;character and
         sta (sptr),y ;decrement
         dey         ;Y register.
         rts
;
trev:     lda (sptr),y ;Un_invert
         and #$7f    ;a character.
         sta (sptr),y
         dey
         rts
;----------------------------
;
;Routine to load Y reg with
;number of characters to
;invert or normalize in the
;data field of a given line
;using COLSIZE table.
;
sety:     ldy rowcrs
         lda colsize,y
         jsr setrow
         ldy rowcrs
         lda colsize,y
         clc
         adc #15
         tay
         rts
;
;----------------------------
;
;Point Zero page pointer to
;line cursor is on for
;inverting/normalizing line.
;
setrow:
;
         lda savmsc
         sta sptr
         lda savmsc+1
         sta sptr+1
         ldy rowcrs
d.pluslp:  lda #40
         jsr addtosptr
         dey
         bne d.pluslp
         lda #8
         jsr addtosptr
         rts
;----------------------------
;
;Add one space to a directive
;so we don't butt against it
;later.
;
addspace: lda inline-1,y
         cmp #space
         beq d.spaced
         lda #space
         sta inline,y
         lda #cr
         sta inline+1,y
d.spaced:  rts
;----------------------------



;        .PAGE "Option I/O Routines"
;         .include opio

;      ...   OPIO   ...
;
opmenu:   lda #1
         sta crsinh
         jsr newscreen
;          position  0,0
         lda #0
         sta colcrs
         lda #0
         sta rowcrs

         jsr printsi
;
;                               1111111111222222222233333333334
;                     01234567890123456789012345678901234567890
         dc.b <+128>,"SELECT = down  OPTION = up  START = Exit"
         dc.b cr,cr,em
;          col  8
         lda #8
         sta colcrs

         sta lmarg
         jsr printsi
         dc.b "Input Drive    ",CR
         dc.b "Output Drive   ",CR
         dc.b "Assembly Drive ",CR
         dc.b "Screen",CR
         dc.b "Printer",CR
         dc.b "Line Numbers?  ",CR
         dc.b "'ASM' File?    ",CR
         dc.b "Label Type     ",CR
         dc.b "Bytes per Line ",CR
         dc.b "File Size      ",CR
         dc.b "Zero Page ID   ",CR
         dc.b "Non-ZP ID      ",CR
         dc.b "ORG Directive  ",CR
         dc.b "EQU Directive  ",CR
         dc.b "BYTE Directive ",CR
         dc.b "LINK Directive ",CR
         dc.b "END Directive  ",CR
         dc.b "Save MEGADIS",EM
;
         lda #3      ;Show all the
         sta rowcrs  ;defaults.
;          col  24
         lda #24
         sta colcrs

         sta lmarg
         lda dn+1    ;Input drv #.
         sta dnum
         lda d2      ;Output drv #.
         sta dnum+2
         lda da      ;Asm drv #.
         sta dnum+4
         jsr printsi
dnum:     dc.b "1",CR,"1",CR
         dc.b "1",CR,EM
         lda scr     ;Screen.
         jsr on_off
         jsr putcr
         lda prt
         jsr on_off  ;Printer.
         jsr putcr
         lda lino.flag ;Line numbers?
         jsr yes_no
         jsr putcr
         lda asmflg  ;ASM file?
         jsr yes_no
         jsr putcr
         lda xe      ;Show ATARI label
         beq d.800    ;type.
         jsr printsi
         dc.b "XL/XE",CR,EM
         jmp d.srg
d.800:     jsr printsi
         dc.b "800 ",CR,EM
d.srg:     jsr shobytes
         jsr shofsize
         jsr shozmark
         jsr shomark
         jsr shoorgm
         jsr shoeq
         jsr shobytm
         jsr sholink
         jsr shoend
;
         clc         ;Show cursor on
         lda savmsc  ;top line.
         adc #88
         sta sptr
         lda savmsc+1
         adc #0
         sta sptr+1
         lda #3
         sta rowcrs
         jmp invert
;----------------------------
;
;Routines to show various
;data and flags.
;
on_off:   beq d.off
         jsr printsi
         dc.b "On ",EM
         rts
d.off:     jsr printsi
         dc.b "Off",EM
         rts
;
;If 0 then print 'No ' else
;print 'Yes'
;
yes_no:   beq no
;
         jsr printsi
         dc.b "Yes",EM
         rts
;
no:       jsr printsi
         dc.b "No ",EM
         rts
;----------------------------
shobytes: lda bytes
         ora #'0'     ;Show bytes
         jsr putchar ;per line.
         jmp putcr
;
shofsize:
;  col  24
         lda #24
         sta colcrs

         lda max.fsize+1 ;Show output
         jsr show_hex ;file size
         lda max.fsize
         jsr just_sho
         jmp putcr
;
shozmark:
;  col  24
         lda #24
         sta colcrs

         lda zmarker ;Show ZP
         jsr putchar ;marker.
         lda zmarker+1
d.mrcr:    cmp #cr
         bne d.mok
         lda #space
d.mok:     jsr putchar
         jmp putcr
;
shomark:
;   col  24
         lda #24
         sta colcrs

         lda marker  ;Show non-ZP
         jsr putchar ;marker
         lda marker+1
         bne d.mrcr
;
shoorgm:  lda # low org_m
         ldy # high org_m ;Show ORG
         bne showit  ;directive.
;
shoeq:    lda # low eq_m
         ldy # high eq_m ;Show EQUATE
         bne showit  ;directive.
;
shobytm:  lda # low byte_m
         ldy # high byte_m ;Show BYTE
         bne showit  ;directive.
;
sholink:  lda # low link_m
         ldy # high link_m ;Show LINK
         bne showit  ;directive.
;
shoend:   lda # low end_m
         ldy # high end_m ;Show END
         bne showit  ;directive.
;----------------------------
;
;Routine prints line of up to
;10 chars to screen starting
;in column 24.  Enter with lo
;adr in A reg and hi adr in Y.
;
showit:   ldx #24
         stx colcrs
         sta icbal
         sty icbah
         lda #10
         sta icbll
         ldx #0
         stx icblh
         lda #putrec.
         sta iccom
         jmp ciov
;----------------------------
;
;Show drive # in inverse.
;
shodn:    ldx #24
         stx colcrs
         ora #$80
         jsr putchar
         jmp nextrow
;----------------------------
;
;Load OS label file from disk.
;
load_labels: pha
         lda dn+1    ;Use and show right
         sta l800+1  ;input drive
         sta lxle+1  ;number
         ora #$80
         sta lx
         pla
         cmp #'8'     ;Load 800 labels?
         beq d.do800  ;yes.
         jmp d.lxl.   ;No.
;
d.do800:   lda # low l800
         sta sptr
         lda # high l800
         sta sptr+1
         ldx #0
         stx xsave
         beq d.opnlbl
;
d.lxl.:    cmp #'X'     ;Load XE labels?
         beq d.doxl   ;Yes.
         jmp d.whatkey ;No... oops...
;
d.doxl:    lda # low lxle
         sta sptr
         lda # high lxle
         sta sptr+1
         ldx #1
         stx xsave
;
d.opnlbl:  ldy #0
d.oplblp:  lda (sptr),y
         sta infn,y
         cpy #3
         bcc d.nxtopl
         ora #$80
         sta lname-3,y
d.nxtopl:  iny
         cpy #12
         bne d.oplblp
         lda (sptr),y
         sta infn,y
         jsr lblprmpt
         jsr checkkey
         bcc d.keyok
         jmp options
;
d.keyok:   jsr open_in
d.xeok:    lda xsave
         sta xe
         jsr printsi   ;Erase
         dc.b $1c,$9c,$9c,em ;disk prompt.
         ldx #chan1  ;Read 6 header
         lda buffer  ;bytes
         sta icbal,x ;which we don't
         lda buffer+1 ;want.
         sta icbah,x
         lda #bget.
         jsr sixbytes
         bpl d.loadmore
         jmp io_err
d.loadmore: lda # low page0 ;Read in
         sta icbal,x ;the label file.
         lda # high page0
         sta icbah,x
         lda #$ff
         sta icbll,x
         sta icblh,x
         jsr ciov
         cpy #$88    ;EOF?
         beq d.goodload ;Yup.
         jmp io_err  ;ONONO!
d.goodload: jmp options
;----------------------------
;
;Routine to get a line of
;input from user.  Character
;in A reg on entry is used as
;first char of said input.
;Input is saved in INLINE.
;On exit first char of INLINE
;is compared with a CR.
;
getdata:  pha
         lda #1
         sta crsinh
         ldy rowcrs
         lda colsize,y
         tay
         sty maxlen
;
d.clr_buf1: lda #cr    ;Clear input
         sta inline,y ;buffer
         lda #space+$80
         jsr putchar
         dey
         bne d.clr_buf1
;          col  24
         lda #24
         sta colcrs

         pla
         jsr d.sho1char
         ldy #1
;
d.nxletr:  sty ytemp   ;Save index.
         jsr gk      ;Get a character.
         ldy ytemp   ;Restore index.
         cmp #backsp
         beq d.bkspc
         cmp #cr
         beq d.got_line
         cmp #esc
         beq d.got_line
         cpy maxlen
         bcs d.nxletr
         jsr d.sho1char
         iny
         bne d.nxletr
;
d.bkspc:   cpy #0      ;Handle a
         beq d.nxletr ;backspace.
         tya
         pha
         lda #backsp
         jsr putchar
         lda #space+$80
         jsr putchar
         lda #$1e
         jsr putchar
         pla
         tay
         dey
         lda #cr
         sta inline,y
         jmp d.nxletr
;
d.got_line: sta inline,y
         cmp #esc
         beq d.gdx
         lda inline
         cmp #cr
d.gdx:     rts
;
d.sho1char: sta inline,y
         ora #$80
         jmp putchar
;----------------------------
;
;Routine to save customized
;version of this program.
;
saveprog: jsr cheknum
         bcs d.nosv
         sta filename+1 ;disk.
         ora #$80
         sta thsprmpt
;          position  8,21
         lda #8
         sta colcrs
         lda #21
         sta rowcrs

         jsr printsi
         dc.b <+128>," Ready Disk "
         dc.b <+128>,"in Drive "
thsprmpt: dc.b <+128>,"1 ",ESC
	 dc.b	em
;          col  8
         lda #8
         sta colcrs

         jsr printsi
         dc.b <+128>,"   Then Pres"
         dc.b <+128>,"s RETURN   "
	 dc.b	em
         jsr checkkey
         bcc d.chk3ok
d.nosv:    jmp options ;If ESC pressed.
;
d.chk3ok:
;   close  1
         ldx #$10
         jsr close.r
;
         lda #open.  ;Open MEGADIS.COM
         sta iccom,x ;for output.
         lda #xwrite
         sta icax1,x
         lda # low filename
         sta icbal,x
         lda # high filename
         sta icbah,x
         jsr ciov
         bpl d.fileok
         jmp io_err
;
d.fileok:  lda # low header ;Write
         sta icbal,x ;header bytes
         lda # high header ;to output
         sta icbah,x ;file
         lda #bput.
         jsr sixbytes
         bpl d.hedok
         jmp io_err
;
d.hedok:   lda # low beginsave
         sta icbal,x ;Write the
         lda # high beginsave ;file
         sta icbah,x
         lda icsize
         sta icbll,x
         lda icsize+1
         sta icblh,x
         jsr ciov
         bpl d.mainok
         jmp io_err
;
d.mainok:  lda # low savend
         sta icbal,x
         lda # high savend
         sta icbah,x
         lda #bput.
         jsr sixbytes
;
d.savok:
;    close  1   ;File saved.
         ldx #$10
         jsr close.r

         jmp options
;----------------------------



;        .PAGE "Directory Routine"
;         .include dirs

;        ...  DIRS  ...
;
;Show disk directory.
;
directory:
;
         sta dir+1   ;Save drive #.
         lda #0
         sta ytemp
         jsr newscreen
;          col  20
         lda #20
         sta colcrs

         lda #1
         sta rowcrs
;          close  1
         ldx #$10
         jsr close.r

         lda #open.  ;Open directory.
         sta iccom,x
         lda #xdir
         sta icax1,x
         lda # low dir
         sta icbal,x
         lda # high dir
         sta icbah,x
         jsr ciov
         bpl d.dirline
         jmp io_err
;
d.dirline: ldx #chan1  ;Input 1
         lda # low inline ;filename.
         sta icbal,x
         lda # high inline
         sta icbah,x
         lda #5
         sta iccom,x
         lda #40
         sta icbll,x
         lda #0
         sta icblh,x
         lda colcrs  ;Put cursor
         cmp #19     ;where we want
         bcs d.nxdrln ;to show this
         lda #20     ;filename.
         sta colcrs
         bne d.dirin
d.nxdrln:  jsr putcr
         ldx #chan1
d.dirin:   jsr ciov
         bpl d.dirlineok ;Got a line.
         cpy #$88    ;End of Directory?
         beq d.dirend ;Yup
         jmp io_err
;
d.dirlineok: jsr Ashodline
         jmp d.dirline
;
d.dirend:  jmp d.dirdun
;
;
Ashodline: lda rowcrs ;Check for
         cmp #21     ;room on screen.
         bcc d.shod
         jsr printsi   ;None here so
         dc.b cr,tab ;prompt for CR.
         dc.b <+128>," More Files Press RETURN "
	 dc.b	em
         jsr getreturn
         jsr newscreen
;          position  1,2
         lda #1
         sta colcrs
         lda #2
         sta rowcrs

;
d.shod:    lda # low inline ;Show the
         sta icbal   ;filename.
         lda # high inline
         sta icbah
;
         ldx #0
         ldy #0
d.drnn:    lda inline,y
         cmp #cr
         beq d.drmm
         iny
         bne d.drnn
;
d.drmm:    sty icbll
         stx icblh
         lda #bput.
         sta iccom
         jmp ciov
;
d.dirdun:  jsr putcr   ;End of
         jsr putcr   ;Directory routine.
;          col  4
         lda #4
         sta colcrs

         jsr printsi
         dc.b <+128>," End of Directory Press any key "
	 dc.b	em
         jsr getkey
         jsr cheknum
         bcs d.dirxit
         jmp directory
;
d.dirxit:  jmp menu
;----------------------------


;        .OPT NO LIST
;        .PAGE "Label Table"
;         .include lxe

; ...  XL/XE LABELS  ...
;
page0:
;
         dc.b "LNFLG "
         dc.b "NGFLAG"
         dc.b "CASINI"
         dc.b 32,1,"    "
         dc.b "RAMLO "
         dc.b 32,1,"    "
         dc.b "TRAMSZ"
         dc.b "CMCMD "
         dc.b "WARMST"
         dc.b "BOOT? "
         dc.b "DOSVEC"
         dc.b 32,1,"    "
         dc.b "DOSINI"
         dc.b 32,1,"    "
         dc.b "APPMHI"
         dc.b 32,1,"    "
         dc.b "POKMSK"
         dc.b "BRKKEY"
         dc.b "RTCLOK"
         dc.b 32,1,"    "
         dc.b 32,2,"    "
         dc.b "BUFADR"
         dc.b 32,1,"    "
         dc.b "ICCOMT"
         dc.b "DSKFMS"
         dc.b 32,1,"    "
         dc.b "DSKUTL"
         dc.b 32,1,"    "
         dc.b "ABUFPT"
         dc.b 32,1,"    "
         dc.b 32,2,"    "
         dc.b 32,3,"    "
         dc.b "ICHIDZ"
         dc.b "ICDNOZ"
         dc.b "ICCOMZ"
         dc.b "ICSTAZ"
         dc.b "ICBALZ"
         dc.b "ICBAHZ"
         dc.b "ICPTLZ"
         dc.b "ICPTHZ"
         dc.b "ICBLLZ"
         dc.b "ICBLHZ"
         dc.b "ICAX1Z"
         dc.b "ICAX2Z"
         dc.b "ICAX3Z"
         dc.b "ICAX4Z"
         dc.b "ICAX5Z"
         dc.b "CIOCHR"
         dc.b "STATUS"
         dc.b "CHKSUM"
         dc.b "BUFRLO"
         dc.b "BUFRHI"
         dc.b "BFENLO"
         dc.b "BFENHI"
         dc.b "LTEMP "
         dc.b 32,1,"    "
         dc.b "BUFRFL"
         dc.b "RECVDN"
         dc.b "XMTDON"
         dc.b "CHKSNT"
         dc.b "NOCKSM"
         dc.b "BPTR  "
         dc.b "FTYPE "
         dc.b "FEOF  "
         dc.b "FREQ  "
         dc.b "SOUNDR"
         dc.b "CRITIC"
         dc.b "ZBUFP "
         dc.b 32,1,"    "
         dc.b "ZDRVA "
         dc.b 32,1,"    "
         dc.b "ZSBA  "
         dc.b 32,1,"    "
         dc.b "ERRNO "
         dc.b "ZCHAIN"
         dc.b 32,1,"    "
         dc.b "DSTAT "
         dc.b "ATRACT"
         dc.b "DRKMSK"
         dc.b "COLRSH"
         dc.b "TEMP  "
         dc.b "HOLD1 "
         dc.b "LMARGN"
         dc.b "RMARGN"
         dc.b "ROWCRS"
         dc.b "COLCRS"
         dc.b 32,1,"    "
         dc.b "DINDEX"
         dc.b "SAVMSC"
         dc.b 32,1,"    "
         dc.b "OLDROW"
         dc.b "OLDCOL"
         dc.b 32,1,"    "
         dc.b "OLDCHR"
         dc.b "OLDADR"
         dc.b 32,1,"    "
         dc.b "FKDEF "
         dc.b 32,1,"    "
         dc.b "PALNTS"
         dc.b "LOGCOL"
         dc.b "ADRESS"
         dc.b 32,1,"    "
         dc.b "MLTTMP"
         dc.b 32,1,"    "
         dc.b "SAVADR"
         dc.b 32,1,"    "
         dc.b "RAMTOP"
         dc.b "BUFCNT"
         dc.b "BUFSTR"
         dc.b 32,1,"    "
         dc.b "BITMSK"
         dc.b "SHFAMT"
         dc.b "ROWAC "
         dc.b 32,1,"    "
         dc.b "COLAC "
         dc.b 32,1,"    "
         dc.b "ENDPT "
         dc.b 32,1,"    "
         dc.b "DELTAR"
         dc.b "DELTAC"
         dc.b 32,1,"    "
         dc.b "KEYDEF"
         dc.b 32,1,"    "
         dc.b "SWPFLG"
         dc.b "HOLDCH"
         dc.b "INSDAT"
         dc.b "COUNTR"
         dc.b 32,1,"    "
;
;------------------------------
;
page2:
;
         dc.b "VDSLST"
         dc.b 32,1,"    "
         dc.b "VPRCED"
         dc.b 32,1,"    "
         dc.b "VINTER"
         dc.b 32,1,"    "
         dc.b "VBREAK"
         dc.b 32,1,"    "
         dc.b "VKEYBD"
         dc.b 32,1,"    "
         dc.b "VSERIN"
         dc.b 32,1,"    "
         dc.b "VSEROR"
         dc.b 32,1,"    "
         dc.b "VSEROC"
         dc.b 32,1,"    "
         dc.b "VTIMR1"
         dc.b 32,1,"    "
         dc.b "VTIMR2"
         dc.b 32,1,"    "
         dc.b "VTIMR4"
         dc.b 32,1,"    "
         dc.b "VIMIRQ"
         dc.b 32,1,"    "
         dc.b "CDTMV1"
         dc.b 32,1,"    "
         dc.b "CDTMV2"
         dc.b 32,1,"    "
         dc.b "CDTMV3"
         dc.b 32,1,"    "
         dc.b "CDTMV4"
         dc.b 32,1,"    "
         dc.b "CDTMV5"
         dc.b 32,1,"    "
         dc.b "VVBLKI"
         dc.b 32,1,"    "
         dc.b "VVBLKD"
         dc.b 32,1,"    "
         dc.b "CDTMA1"
         dc.b 32,1,"    "
         dc.b "CDTMA2"
         dc.b 32,1,"    "
         dc.b "CDTMF3"
         dc.b "SRTIMR"
         dc.b "CDTMF4"
         dc.b "INTEMP"
         dc.b "CDTMF5"
         dc.b "SDMCTL"
         dc.b "SDLSTL"
         dc.b "SDLSTH"
         dc.b "SSKCTL"
         dc.b "LCOUNT"
         dc.b "LPENH "
         dc.b "LPENV "
         dc.b 32,1,"    "
         dc.b 32,2,"    "
         dc.b "VPIRQ "
         dc.b 32,1,"    "
         dc.b "CDEVIC"
         dc.b "CCOMND"
         dc.b "CAUX1 "
         dc.b "CAUX2 "
         dc.b "TEMP  "
         dc.b "ERRFLG"
         dc.b "DFLAGS"
         dc.b "DBSECT"
         dc.b "BOOTAD"
         dc.b 32,1,"    "
         dc.b "COLDST"
         dc.b "RECLEN"
         dc.b "DSKTIM"
         dc.b "PDVMSK"
         dc.b "SHPDVS"
         dc.b "PDMSK "
         dc.b "RELADR"
         dc.b 32,1,"    "
         dc.b "PPTMPA"
         dc.b "PPTMPX"
         dc.b 32,1,"    "
         dc.b 32,2,"    "
         dc.b 32,3,"    "
         dc.b 32,4,"    "
         dc.b 32,5,"    "
         dc.b 32,6,"    "
         dc.b 32,7,"    "
         dc.b 32,8,"    "
         dc.b 32,9,"    "
         dc.b 32,10,"    "
         dc.b 32,11,"    "
         dc.b 32,12,"    "
         dc.b 32,13,"    "
         dc.b 32,14,"    "
         dc.b 32,15,"    "
         dc.b 32,16,"    "
         dc.b 32,17,"    "
         dc.b 32,18,"    "
         dc.b 32,19,"    "
         dc.b 32,20,"    "
         dc.b 32,21,"    "
         dc.b 32,22,"    "
         dc.b 32,23,"    "
         dc.b 32,24,"    "
         dc.b 32,25,"    "
         dc.b 32,26,"    "
         dc.b 32,27,"    "
         dc.b 32,28,"    "
         dc.b 32,29,"    "
         dc.b "CHSALT"
         dc.b "VSFLAG"
         dc.b "KEYDIS"
         dc.b "FINE  "
         dc.b "GPRIOR"
         dc.b "PADDL0"
         dc.b "PADDL1"
         dc.b "PADDL2"
         dc.b "PADDL3"
         dc.b "PADDL4"
         dc.b "PADDL5"
         dc.b "PADDL6"
         dc.b "PADDL7"
         dc.b "STICK0"
         dc.b "STICK1"
         dc.b "STICK2"
         dc.b "STICK3"
         dc.b "PTRIG0"
         dc.b "PTRIG1"
         dc.b "PTRIG2"
         dc.b "PTRIG3"
         dc.b "PTRIG4"
         dc.b "PTRIG5"
         dc.b "PTRIG6"
         dc.b "PTRIG7"
         dc.b "STRIG0"
         dc.b "STRIG1"
         dc.b "STRIG2"
         dc.b "STRIG3"
         dc.b "HIBYTE"
         dc.b 32,1,"    "
         dc.b 32,2,"    "
         dc.b "IMASK "
         dc.b "JVECK "
         dc.b 32,1,"    "
         dc.b "NEWADR"
         dc.b 32,1,"    "
         dc.b "TXTROW"
         dc.b "TXTCOL"
         dc.b 32,1,"    "
         dc.b "TINDEX"
         dc.b "TXTMSC"
         dc.b 32,1,"    "
         dc.b "TXTOLD"
         dc.b 32,1,"    "
         dc.b 32,2,"    "
         dc.b 32,3,"    "
         dc.b 32,4,"    "
         dc.b 32,5,"    "
         dc.b "CRETRY"
         dc.b "HOLD3 "
         dc.b "SUBTMP"
         dc.b "HOLD2 "
         dc.b "DMASK "
         dc.b "TMPLBT"
         dc.b "ESCFLG"
         dc.b "TABMAP"
         dc.b 32,1,"    "
         dc.b 32,2,"    "
         dc.b 32,3,"    "
         dc.b 32,4,"    "
         dc.b 32,5,"    "
         dc.b 32,6,"    "
         dc.b 32,7,"    "
         dc.b 32,8,"    "
         dc.b 32,9,"    "
         dc.b 32,10,"    "
         dc.b 32,11,"    "
         dc.b 32,12,"    "
         dc.b 32,13,"    "
         dc.b 32,14,"    "
         dc.b "LOGMAP"
         dc.b 32,1,"    "
         dc.b 32,2,"    "
         dc.b 32,3,"    "
         dc.b "INVFLG"
         dc.b "FILFLG"
         dc.b "TMPROW"
         dc.b "TMPCOL"
         dc.b 32,1,"    "
         dc.b "SCRFLG"
         dc.b "HOLD4 "
         dc.b "DRETRY"
         dc.b "SHFLOK"
         dc.b "BOTSCR"
         dc.b "PCOLR0"
         dc.b "PCOLR1"
         dc.b "PCOLR2"
         dc.b "PCOLR3"
         dc.b "COLOR0"
         dc.b "COLOR1"
         dc.b "COLOR2"
         dc.b "COLOR3"
         dc.b "COLOR4"
         dc.b "RUNADR"
         dc.b 32,1,"    "
         dc.b "HIUSED"
         dc.b 32,1,"    "
         dc.b "ZHIUSE"
         dc.b 32,1,"    "
         dc.b "GBYTEA"
         dc.b 32,1,"    "
         dc.b "LOADAD"
         dc.b 32,1,"    "
         dc.b "ZLOADA"
         dc.b 32,1,"    "
         dc.b "DSCTLN"
         dc.b 32,1,"    "
         dc.b "ACMISR"
         dc.b 32,1,"    "
         dc.b "KRPDEL"
         dc.b "KEYREP"
         dc.b "NOCLIK"
         dc.b "HELPFG"
         dc.b "DMASAV"
         dc.b "PBPNT "
         dc.b "PBUFSZ"
         dc.b "RUNAD "
         dc.b 32,1,"    "
         dc.b "INITAD"
         dc.b 32,1,"    "
         dc.b "RAMSIZ"
         dc.b "MEMTOP"
         dc.b 32,1,"    "
         dc.b "MEMLO "
         dc.b 32,1,"    "
         dc.b "HNDLOD"
         dc.b "DVSTAT"
         dc.b 32,1,"    "
         dc.b 32,2,"    "
         dc.b 32,3,"    "
         dc.b "CBAUDL"
         dc.b "CBAUDH"
         dc.b "CRSINH"
         dc.b "KEYDEL"
         dc.b "CH1   "
         dc.b "CHACT "
         dc.b "CHBAS "
         dc.b "NEWROW"
         dc.b "NEWCOL"
         dc.b 32,1,"    "
         dc.b "ROWINC"
         dc.b "COLINC"
         dc.b "CHAR  "
         dc.b "ATACHR"
         dc.b "CH    "
         dc.b "FILDAT"
         dc.b "DSPFLG"
         dc.b "SSFLAG"
;
;------------------------------
;
page3:
;
         dc.b "DDEVIC"
         dc.b "DUNIT "
         dc.b "DCOMND"
         dc.b "DSTATS"
         dc.b "DBUFLO"
         dc.b "DBUFHI"
         dc.b "DTIMLO"
         dc.b "DUNUSE"
         dc.b "DBYTLO"
         dc.b "DBYTHI"
         dc.b "DAUX1 "
         dc.b "DAUX2 "
         dc.b "TIMER1"
         dc.b 32,1,"    "
         dc.b "JMPERS"
         dc.b "CASFLG"
         dc.b "TIMER2"
         dc.b 32,1,"    "
         dc.b "TEMP1 "
         dc.b "TEMP2 "
         dc.b "PTIMOT"
         dc.b "TEMP3 "
         dc.b "SAVIO "
         dc.b "TIMFLG"
         dc.b "STACKP"
         dc.b "TSTAT "
         dc.b "HATABS"
         dc.b 32,1,"    "
         dc.b 32,2,"    "
         dc.b 32,3,"    "
         dc.b 32,4,"    "
         dc.b 32,5,"    "
         dc.b 32,6,"    "
         dc.b 32,7,"    "
         dc.b 32,8,"    "
         dc.b 32,9,"    "
         dc.b 32,10,"    "
         dc.b 32,11,"    "
         dc.b 32,12,"    "
         dc.b 32,13,"    "
         dc.b 32,14,"    "
         dc.b 32,15,"    "
         dc.b 32,16,"    "
         dc.b 32,17,"    "
         dc.b 32,18,"    "
         dc.b 32,19,"    "
         dc.b 32,20,"    "
         dc.b 32,21,"    "
         dc.b 32,22,"    "
         dc.b 32,23,"    "
         dc.b 32,24,"    "
         dc.b 32,25,"    "
         dc.b 32,26,"    "
         dc.b 32,27,"    "
         dc.b 32,28,"    "
         dc.b 32,29,"    "
         dc.b 32,30,"    "
         dc.b 32,31,"    "
         dc.b 32,32,"    "
         dc.b 32,33,"    "
         dc.b 32,34,"    "
         dc.b "PUPBT1"
         dc.b "PUPBT2"
         dc.b "PUPBT3"
         dc.b "ICHID "
         dc.b "ICDNO "
         dc.b "ICCOM "
         dc.b "ICSTA "
         dc.b "ICBAL "
         dc.b "ICBAH "
         dc.b "ICPTL "
         dc.b "ICPTH "
         dc.b "ICBLL "
         dc.b "ICBLH "
         dc.b "ICAX1 "
         dc.b "ICAX2 "
         dc.b "ICAX3 "
         dc.b "ICAX4 "
         dc.b "ICAX5 "
         dc.b "ICAX6 "
;
;------------------------------
;
gtia_r:
;
         dc.b "M0PF  "
         dc.b "M1PF  "
         dc.b "M2PF  "
         dc.b "M3PF  "
         dc.b "P0PF  "
         dc.b "P1PF  "
         dc.b "P2PF  "
         dc.b "P3PF  "
         dc.b "M0PL  "
         dc.b "M1PL  "
         dc.b "M2PL  "
         dc.b "M3PL  "
         dc.b "P0PL  "
         dc.b "P1PL  "
         dc.b "P2PL  "
         dc.b "P3PL  "
         dc.b "TRIG0 "
         dc.b "TRIG1 "
         dc.b "TRIG2 "
         dc.b "TRIG3 "
         dc.b "PAL   "
;
;------------------------------
;
gtia_w:
;
         dc.b "HPOSP0"
         dc.b "HPOSP1"
         dc.b "HPOSP2"
         dc.b "HPOSP3"
         dc.b "HPOSM0"
         dc.b "HPOSM1"
         dc.b "HPOSM2"
         dc.b "HPOSM3"
         dc.b "SIZEP0"
         dc.b "SIZEP1"
         dc.b "SIZEP2"
         dc.b "SIZEP3"
         dc.b "SIZEM "
         dc.b "GRAFP0"
         dc.b "GRAFP1"
         dc.b "GRAFP2"
         dc.b "GRAFP3"
         dc.b "GRAFM "
         dc.b "COLPM0"
         dc.b "COLPM1"
         dc.b "COLPM2"
;
;------------------------------
;
pokey_r:
;
         dc.b "POT0  "
         dc.b "POT1  "
         dc.b "POT2  "
         dc.b "POT3  "
         dc.b "POT4  "
         dc.b "POT5  "
         dc.b "POT6  "
         dc.b "POT7  "
         dc.b "ALLPOT"
         dc.b "KBCODE"
         dc.b "RANDOM"
         dc.b "POTGO "
         dc.b 32,1,"    "
         dc.b "SERIN "
         dc.b "IRQST "
         dc.b "SKSTAT"
;
;------------------------------
;
pokey_w:
;
         dc.b "AUDF1 "
         dc.b "AUDC1 "
         dc.b "AUDF2 "
         dc.b "AUDC2 "
         dc.b "AUDF3 "
         dc.b "AUDC3 "
         dc.b "AUDF4 "
         dc.b "AUDC4 "
         dc.b "AUDCTL"
         dc.b "STIMER"
         dc.b "SKRES "
         dc.b 32,1,"    "
         dc.b 32,2,"    "
         dc.b "SEROUT"
         dc.b "IRQEN "
         dc.b "SKCTL "
;
;------------------------------
;
pia:
;
         dc.b "PORTA "
         dc.b "PORTB "
         dc.b "PACTL "
         dc.b "PBCTL "
;
;------------------------------
;
antic:
;
         dc.b "DMACTL"
         dc.b "CHACTL"
         dc.b "DLISTL"
         dc.b "DLISTH"
         dc.b "HSCROL"
         dc.b "VSCROL"
         dc.b 32,1,"    "
         dc.b "PMBASE"
         dc.b 32,1,"    "
         dc.b "CHBASE"
         dc.b "WSYNC "
         dc.b "VCOUNT"
         dc.b "PENH  "
         dc.b "PENV  "
         dc.b "NMIEN "
         dc.b "NMIST "
;
;------------------------------
;
os:
;
         dc.b "EDITRV"
         dc.b 32,1,"    "
         dc.b 32,2,"    "
         dc.b 32,3,"    "
         dc.b 32,4,"    "
         dc.b 32,5,"    "
         dc.b 32,6,"    "
         dc.b 32,7,"    "
         dc.b 32,8,"    "
         dc.b 32,9,"    "
         dc.b 32,10,"    "
         dc.b 32,11,"    "
         dc.b 32,12,"    "
         dc.b 32,13,"    "
         dc.b 32,14,"    "
         dc.b 32,15,"    "
         dc.b "SCRENV"
         dc.b 32,1,"    "
         dc.b 32,2,"    "
         dc.b 32,3,"    "
         dc.b 32,4,"    "
         dc.b 32,5,"    "
         dc.b 32,6,"    "
         dc.b 32,7,"    "
         dc.b 32,8,"    "
         dc.b 32,9,"    "
         dc.b 32,10,"    "
         dc.b 32,11,"    "
         dc.b 32,12,"    "
         dc.b 32,13,"    "
         dc.b 32,14,"    "
         dc.b 32,15,"    "
         dc.b "KEYBDV"
         dc.b 32,1,"    "
         dc.b 32,2,"    "
         dc.b 32,3,"    "
         dc.b 32,4,"    "
         dc.b 32,5,"    "
         dc.b 32,6,"    "
         dc.b 32,7,"    "
         dc.b 32,8,"    "
         dc.b 32,9,"    "
         dc.b 32,10,"    "
         dc.b 32,11,"    "
         dc.b 32,12,"    "
         dc.b 32,13,"    "
         dc.b 32,14,"    "
         dc.b 32,15,"    "
         dc.b "PRINTV"
         dc.b 32,1,"    "
         dc.b 32,2,"    "
         dc.b 32,3,"    "
         dc.b 32,4,"    "
         dc.b 32,5,"    "
         dc.b 32,6,"    "
         dc.b 32,7,"    "
         dc.b 32,8,"    "
         dc.b 32,9,"    "
         dc.b 32,10,"    "
         dc.b 32,11,"    "
         dc.b 32,12,"    "
         dc.b 32,13,"    "
         dc.b 32,14,"    "
         dc.b 32,15,"    "
         dc.b "CASETV"
         dc.b 32,1,"    "
         dc.b 32,2,"    "
         dc.b 32,3,"    "
         dc.b 32,4,"    "
         dc.b 32,5,"    "
         dc.b 32,6,"    "
         dc.b 32,7,"    "
         dc.b 32,8,"    "
         dc.b 32,9,"    "
         dc.b 32,10,"    "
         dc.b 32,11,"    "
         dc.b 32,12,"    "
         dc.b 32,13,"    "
         dc.b 32,14,"    "
         dc.b 32,15,"    "
         dc.b "DISKIV           "
         dc.b "DSKINV           "
         dc.b "CIOV             "
         dc.b "SIOV             "
         dc.b "SETVBV           "
         dc.b "SYSVBV           "
         dc.b "XITVBV           "
         dc.b "SIOINV           "
         dc.b "SENDEV           "
         dc.b "INTINV           "
         dc.b "CIOINV           "
         dc.b "SLFTST           "
         dc.b "WARMSV           "
         dc.b "COLDSV           "
         dc.b "RBLOKV           "
         dc.b "CSOPIV           "
         dc.b "VCTABL"
;
;------------------------------
;
p0.labels:
;
         dc.b "FR0   "
         dc.b "FRE   "
         dc.b "FR1   "
         dc.b "FR2   "
         dc.b "FRX   "
         dc.b "CIX   "
         dc.b "INBUFF"
         dc.b "+     "
         dc.b "FLPTR "
         dc.b "+     "
         dc.b "FPTR2 "
         dc.b "+     "
;------------------------------
;
p3.labels:
;
         dc.b "SUPERF"
         dc.b "CKEY  "
         dc.b "CASSBT"
         dc.b "CARTCK"
         dc.b "DERRF "
         dc.b "ACMVAR"
         dc.b "BASICF"
         dc.b "MINTLK"
         dc.b "GINTLK"
         dc.b "CHLINK"
         dc.b "+     "
;------------------------------
;
fp.labels:
;
         dc.b "COLPM3"
         dc.b "COLPF0"
         dc.b "COLPF1"
         dc.b "COLPF2"
         dc.b "COLPF3"
         dc.b "COLBK "
         dc.b "PRIOR "
         dc.b "VDELAY"
         dc.b "GRACTL"
         dc.b "HITCLR"
         dc.b "CONSOL"
         dc.b "AFP   "
         dc.b "FASC  "
         dc.b "IFP   "
         dc.b "FPI   "
         dc.b "ZFR0  "
         dc.b "ZFR1  "
         dc.b "FSUB  "
         dc.b "FADD  "
         dc.b "FMUL  "
         dc.b "FDIV  "
         dc.b "PLYEVL"
         dc.b "FLD0R "
         dc.b "FLD0P "
         dc.b "FLD1R "
         dc.b "FLD1P "
         dc.b "FST0R "
         dc.b "FST0P "
         dc.b "FMOVE "
         dc.b "EXP   "
         dc.b "EXP10 "
         dc.b "LOG   "
         dc.b "LOG10 "
;
;-----------------------------



;        .OPT LIST
;        .PAGE "Data Tables"
;         .include tabl
;     ...   TABL   ...
;
;Table of ATARI label info
;in the following format:
;
;  1) Address of labels.
;  2) Memory Page #.
;  3) Last adr of page used.
;  4) Read/Write flag  $80=ignore
;                        1=read
;                        0=write.
;------------------------------
;
page.table:
;
         dc.w page0
         dc.b 0,$7f,$80
         dc.w page2
         dc.b 2,$ff,$80
         dc.w page3
         dc.b 3,$4f,$80
         dc.w gtia_r
         dc.b $d0,$14,1
         dc.w gtia_w
         dc.b $d0,$14,0
         dc.w pokey_r
         dc.b $d2,$0f,1
         dc.w pokey_w
         dc.b $d2,$0f,0
         dc.w pia
         dc.b $d3,3,$80
         dc.w antic
         dc.b $d4,$0f,$80
         dc.w os
         dc.b $e4,$7f,$80
;
tsize:    dc.b tsize-page.table		;*-page.table


;------------------------------
;
;Table of addresses added to
;pages 0 and 3 and the FP adrs.
;
p0.adrlst:
;
         dc.b $d4,$da,$e0,$e6
         dc.b $ec,$f2,$f3,$f4
         dc.b $fc,$fd,$fe,$ff
;
;
p3.adrlst:
;
         dc.b $e8,$e9,$ea,$eb
         dc.b $ec,$ed,$f8,$f9
         dc.b $fa,$fb,$fc
;
fp.adrlst:
;
         dc.w $d015,$d016,$d017,$d018
         dc.w $d019,$d01a,$d01b,$d01c
         dc.w $d01d,$d01e,$d01f
         dc.w $d800,$d8e6,$d9aa,$d9d2
         dc.w $da44,$da46,$da60,$da66
         dc.w $dadb,$db28,$dd40,$dd89
         dc.w $dd8d,$dd98,$dd9c,$dda7
         dc.w $ddab,$ddb6,$ddc0,$ddcc
         dc.w $decd,$ded1
;------------------------------
;
;        Mnemonic Table
;        --------------
;
mnemonic.tbl:
;
         dc.b "ADCANDASLBCC"
         dc.b "BCSBEQBITBMI"
         dc.b "BNEBPLBRKBVC"
         dc.b "BVSCLCCLDCLI"
         dc.b "CLVCMPCPXCPY"
         dc.b "DECDEXDEYEOR"
         dc.b "INCINXINYJMP"
         dc.b "JSRLDALDXLDY"
         dc.b "LSRNOPORAPHA"
         dc.b "PHPPLAPLPROL"
         dc.b "RORRTIRTSSBC"
         dc.b "SECSEDSEISTA"
         dc.b "STXSTYTAXTAY"
         dc.b "TSXTXATXSTYA"
;
;------------------------------
;        .PAGE "Mnemonic pointer table"
;Table used to index into the
;mnemonic table to get the
;desired assembler mnemonic.
;
mnem.pointr:
;
         dc.b $00,$68,$00,$00
         dc.b $00,$68,$08,$00
         dc.b $6e,$68,$08,$00
         dc.b $00,$68,$08,$00
         dc.b $1d,$68,$00,$00
         dc.b $00,$68,$08,$00
         dc.b $29,$68,$00,$00
         dc.b $00,$68,$08,$00
         dc.b $56,$05,$00,$00
         dc.b $14,$05,$77,$00
         dc.b $74,$05,$77,$00
         dc.b $14,$05,$77,$00
         dc.b $17,$05,$00,$00
         dc.b $00,$05,$77,$00
         dc.b $86,$05,$00,$00
         dc.b $00,$05,$77,$00
         dc.b $7d,$47,$00,$00
         dc.b $00,$47,$62,$00
         dc.b $6b,$47,$62,$00
         dc.b $53,$47,$62,$00
         dc.b $23,$47,$00,$00
         dc.b $00,$47,$62,$00
         dc.b $2f,$47,$00,$00
         dc.b $00,$47,$62,$00
         dc.b $80,$02,$00,$00
         dc.b $00,$02,$7a,$00
         dc.b $71,$02,$7a,$00
         dc.b $53,$02,$7a,$00
         dc.b $26,$02,$00,$00
         dc.b $00,$02,$00,$00
         dc.b $8c,$02,$00,$00
         dc.b $00,$02,$00,$00
         dc.b $00,$8f,$00,$00
         dc.b $95,$8f,$92,$00
         dc.b $44,$00,$a1,$00
         dc.b $95,$8f,$92,$00
         dc.b $0b,$8f,$00,$00
         dc.b $95,$8f,$92,$00
         dc.b $a7,$8f,$a4,$00
         dc.b $00,$8f,$00,$00
         dc.b $5f,$59,$5c,$00
         dc.b $5f,$59,$5c,$00
         dc.b $9b,$59,$98,$00
         dc.b $5f,$59,$5c,$00
         dc.b $0e,$59,$00,$00
         dc.b $5f,$59,$5c,$00
         dc.b $32,$59,$9e,$00
         dc.b $5f,$59,$5c,$00
         dc.b $3b,$35,$00,$00
         dc.b $3b,$35,$3e,$00
         dc.b $50,$35,$41,$00
         dc.b $3b,$35,$3e,$00
         dc.b $1a,$35,$00,$00
         dc.b $00,$35,$3e,$00
         dc.b $2c,$35,$00,$00
         dc.b $00,$35,$3e,$00
         dc.b $38,$83,$00,$00
         dc.b $38,$83,$4a,$00
         dc.b $4d,$83,$65,$00
         dc.b $38,$83,$4a,$00
         dc.b $11,$83,$00,$00
         dc.b $00,$83,$4a,$00
         dc.b $89,$83,$00,$00
         dc.b $00,$83,$4a,$00
;------------------------------
;        .PAGE "Operator Table"
;Table used to figure out what
;mnemonic and addressing mode
;to use.
;
op.table: dc.b $ff,$36,$ff,$ff
         dc.b $ff,$2e,$ae,$ff
         dc.b $00,$24,$02,$ff
         dc.b $ff,$48,$c8,$ff
         dc.b $26,$38,$ff,$ff
         dc.b $ff,$30,$b0,$ff
         dc.b $00,$4c,$ff,$ff
         dc.b $ff,$4a,$ca,$ff
         dc.b $48,$36,$ff,$ff
         dc.b $2e,$2e,$ae,$ff
         dc.b $00,$24,$02,$ff
         dc.b $48,$48,$c8,$ff
         dc.b $26,$38,$ff,$ff
         dc.b $ff,$30,$b0,$ff
         dc.b $00,$4c,$ff,$ff
         dc.b $ff,$4a,$ca,$ff
         dc.b $00,$36,$ff,$ff
         dc.b $ff,$2e,$ae,$ff
         dc.b $00,$24,$02,$ff
         dc.b $48,$48,$c8,$ff
         dc.b $26,$38,$ff,$ff
         dc.b $ff,$30,$b0,$ff
         dc.b $00,$4c,$ff,$ff
         dc.b $ff,$4a,$ca,$ff
         dc.b $00,$36,$ff,$ff
         dc.b $ff,$2e,$ae,$ff
         dc.b $00,$24,$02,$ff
         dc.b $54,$48,$c8,$ff
         dc.b $26,$38,$ff,$ff
         dc.b $ff,$30,$ff,$ff
         dc.b $00,$4c,$ff,$ff
         dc.b $ff,$4a,$ff,$ff
         dc.b $ff,$b6,$ff,$ff
         dc.b $ae,$ae,$ae,$ff
         dc.b $00,$ff,$00,$ff
         dc.b $c8,$c8,$c8,$ff
         dc.b $26,$b8,$ff,$ff
         dc.b $b0,$b0,$b2,$ff
         dc.b $00,$cc,$00,$ff
         dc.b $ff,$ca,$ff,$ff
         dc.b $24,$36,$24,$ff
         dc.b $2e,$2e,$2e,$ff
         dc.b $00,$24,$00,$ff
         dc.b $48,$48,$48,$ff
         dc.b $26,$38,$ff,$ff
         dc.b $30,$30,$32,$ff
         dc.b $00,$4c,$00,$ff
         dc.b $4a,$4a,$4c,$ff
         dc.b $24,$36,$ff,$ff
         dc.b $2e,$2e,$ae,$ff
         dc.b $00,$24,$00,$ff
         dc.b $48,$48,$c8,$ff
         dc.b $26,$38,$ff,$ff
         dc.b $ff,$30,$b0,$ff
         dc.b $00,$4c,$ff,$ff
         dc.b $ff,$4a,$ca,$ff
         dc.b $24,$36,$ff,$ff
         dc.b $2e,$2e,$ae,$ff
         dc.b $00,$24,$00,$ff
         dc.b $48,$48,$c8,$ff
         dc.b $26,$38,$ff,$ff
         dc.b $ff,$30,$b0,$ff
         dc.b $00,$4c,$ff,$ff
         dc.b $ff,$4a,$ca,$ff
;------------------------------
;        .PAGE "Misc tables"
;Table of bit masks
;
bit.table: dc.b 1,2,4,8
         dc.b $10,$20,$40,$80
;
;------------------------------
;
;Table of jump addresses to
;add the correct addressing
;mode to a mnemonic.
;
mode.tabl: dc.w reg,acc
         dc.w imm,branch
         dc.w adress,x_indx
         dc.w y_indx,zpage
         dc.w x_indx1,yindx1
         dc.w ind_x,ind_x1
         dc.w ind_y
;
;------------------------------
;
optn_tbl:
;
         dc.w dummy,dummy
         dc.w dummy,indrv
         dc.w outdrv,asmdrv
         dc.w flipscr,flipprt
         dc.w fliplino,asmfile
         dc.w load_labels,linebyts
         dc.w newfsize,zflip
         dc.w mflip,neworg
         dc.w neweq,newbyte
         dc.w newlink,newend
         dc.w saveprog
;------------------------------




;        .PAGE "Data Stuff"
;   ...   DATA   ...
;
icsize:   dc.w savend-beginsave
;
header:   dc.w dummy
         dc.w beginsave
         dc.w savend-1
;-----------------------------
;
colsize:  dc.b 0,0,0,1
         dc.b 1,1,3,3
         dc.b 3,3,5,1
         dc.b 5,2,2,10
         dc.b 10,10,10,10
         dc.b 0,0
;
hextbl:   dc.b "01234567"
         dc.b "89ABCDEF"
;-----------------------------
;
mymr:     dc.b 1
kolor:    dc.b $80
lum:      dc.b $ff
scr:      dc.b 0
prt:      dc.b 0
line.start: dc.w lnum
xe:       dc.b 1
bytes:    dc.b 4
lino.flag: dc.b 1
asmflg:   dc.b 1
max.fsize: dc.w $8000
marker:   dc.b "L",CR,CR
zmarker:  dc.b "Z",CR,CR
filename: dc.b "D1:MEGADIS.COM",CR
frstno:   dc.b "04995 "
secndno:  dc.b "00999 "
;-----------------------------
;
k:        dc.b "K:",CR
p:        dc.b "P:",CR
e:        dc.b "E:",CR
dn:       dc.b "D8:"
d2:       dc.b "8"
da:       dc.b "8"
dir:      dc.b "D1:*.*",CR
l800:     dc.b "D1:LABEL.800",CR
lxle:     dc.b "D1:LABEL.XLE",CR
;-----------------------------
;
zeq_m:
         dc.b ";     Zero Page Equates",CR
;
sequ_m:
         dc.b ";        System Equates",CR
;
xref_m:
         dc.b "; External reference Equates",CR
;
dash_m:
         dc.b ";----------------------------",CR
;
spacer_m: dc.b ";",CR
;
size_m:   dc.b " Bytes.",CR
;-----------------------------
;
org_m:    dc.b ".org",CR,"        "
;
eq_m:     dc.b "= ",CR,"        "
;
byte_m:   dc.b ".BYTE ",CR,"    "
;
link_m:   dc.b ".INCLUDE #",CR
;
end_m:    dc.b ".END",CR,"      "
;
data_m:   dc.b "DATA ",CR
;
rem_m:    dc.b "REM ",CR
;
code_m:   dc.b "PROC MegaCode=*()",CR
;
mega_m:   dc.b "MEGABYTES",CR
;-----------------------------
;
savend:
         dc.w $02e0
         dc.w $02e1
         dc.w init
;-----------------------------
;
dvec:     ds.b 2
oldvbi:   ds.b 2
oldmar:   ds.b 1
oldcolr:  ds.b 5
try:      ds.b 1
loadflag: ds.b 1
pagex:    ds.b 1
sdm:      ds.b 1
all.:     ds.b 1
pcflag:   ds.b 1
maxlen:   ds.b 1
mainfiles: ds.b 1
totfiles: ds.b 1
dskopnflg: ds.b 1
cioy:     ds.b 1
zp.flag:  ds.b 1
address:  ds.b 5
both.flag: ds.b 1
myflag:
swapflag: ds.b 1
hex.flag: ds.b 1
binflag:  ds.b 1
outdot:   ds.b 1
first:    ds.b 2
labels:   ds.b 2
good.label: ds.b 1
which.bytek: ds.b 1
drives:   ds.b 1
pass:     ds.b 1
more.:    ds.b 1
xsave:    ds.b 1
op.temp:  ds.b 1
freehi:   ds.b 2
button:   ds.b 1
st.flag:  ds.b 1
vbi.timer: ds.b 1
seg.org:  ds.b 2
seg.end:
seg.size: ds.b 2
dskon:    ds.b 1
files.size: ds.b 2
seg.adr:  ds.b 2
left.to.do: ds.b 2
opcode:   ds.b 1
operand:  ds.b 7
bytemax:
bytes.done: ds.b 1
bytecount:
lbuf.size: ds.b 2
labeltop: ds.b 2
totaldc.bs:
label.count: ds.b 2
bytes.to.do: ds.b 1
xtemp:    ds.b 1
page.loc: ds.b 2
oldlino:
page:     ds.b 1
oldifile:
page.top: ds.b 1
rw.flag:  ds.b 1
is.p.opn.: ds.b 1
close.p.: ds.b 1
sector:   ds.b 2
left.in.buf: ds.b 2
line.ptr: ds.b 2
linesize: ds.b 2
mode:     ds.b 1
lastorg:  ds.b 2
offset:   ds.b 1
currnt.sectr: ds.b 2
xlo:      ds.b 1
xhi:      ds.b 1
byts.this.op: ds.b 8
incend:   ds.b 1
to.lino:  ds.b 2
;-----------------------------
;
lnum:     ds.b 6
printline: ds.b 40
inline:   ds.b 40
infn:     ds.b 32
outfn:    ds.b 32
sector.map: ds.b 144
label.map: ds.b 512
drvbuf:   ds.b 256
label.buffer: ds.b 5632
bufadr:   ds.b 0		;equ    *
;-----------------------------

win_end:	ds.b 0
.end
;