;
;--------------
;PROGRAM TRACER
;--------------
;
;Get Key Routine
;
;This routine accepts a raw
;key press and converts it
;to ATASCII using the table
;supplied in the OS.
;
GETKEY	LDA CH 	;get key press
	CMP #$FF 	;$FF?
	BEQ GETKEY 	;yes. loop
	LDX #$FF 	;now clear key
	STX CH 	;press
	STA OLDC 	;save press
K0	TAY 
	CPY #$C0 	;192?
	BCC K1 	;no.
	LDY #$9A 	;error 136
K1	LDA $FEFE,Y 	;make ascii
	STA OLDAC 	;save it
	CMP #$80 	;128?
	BEQ GETKEY 	;yes. try again
	CMP #$81 	;129?
	BNE K2 	;no.
	LDA INVS 	;yes.
	EOR #$80 	;flip inverse
	STA INVS 	;status
	JMP GETKEY 	;go again
K2	CMP #$82 	;130?
	BNE K3
	LDA CAPS 	;yes. flip caps
	EOR #$40 	;status
	STA CAPS
	JMP GETKEY 	;go again
K3	CMP #$83 	;131?
	BNE K4 	;shift caps.
	LDA #$40 	;make caps
	STA CAPS
	BNE GETKEY
K4	CMP #$84 	;132?
	BNE K5
	LDA #$80 	;control-caps
	STA CAPS
	BNE GETKEY
K5	CMP #$85 	;skip this one
	BEQ GETKEY
	LDA OLDC 	;get press
	CMP #$40 	;64?
	BCS K6 	;yes. +>
	LDA OLDAC 	;get ascii
	CMP #$61 	;97?
	BCC K6
	CMP #$7B
	BCS K6
	LDA CAPS 	;lower case
	BEQ K6
	ORA OLDC 	;mask bits
	JMP K0 	;and do again
K6	LDX #$0F 	;scan for a
K7	LDA KEYS,X 	;special
	CMP OLDAC 	;key press
	BEQ K8
	DEX 
	BPL K7
K8	BEQ K9
	LDA OLDAC 	;get ascii
	EOR INVS 	;inverse bit
	STA OLDAC 	;save it
K9	RTS  	;and done
;
;Wait 15 jiffies
;
WAIT5	LDA #0 	;get 0
	STA RTCLOK 	;zero clok
W1	LDA RTCLOK
	CMP #15 	;at 15?
	BNE W1 	;no.
	RTS  	;so long!
;
;Perform manual RTS
;
DORTS	LDX USRS 	;get pointer
	INX 
	LDA MYPG1,X 	;RTS lo byte
	STA ADDR 	;in trace adr
	INX 
	LDA MYPG1,X 	;RTS hi byte
	STA ADDR+1 	;in trace adr
	STX USRS 	;update SP
	JMP NSET 	;add a 1 to adr
;
;Perform manual JSR
;
DOJSR	LDA ADDR 	;calc return
	SEC  	;address and
	SBC #1 	;store it in
	PHA  	;the users
	LDA ADDR+1 	;stack.
	SBC #0
	LDX USRS 	;stk pntr
	STA MYPG1,X 	;install MSB
	DEX  	;down 1
	PLA  	;get LSB
	STA MYPG1,X 	;put it in
	DEX 
	STX USRS 	;new stk pntr
DOJMP	LDY #1 	;copy new trace
	LDA (SAVD),Y 	;address into
	STA ADDR 	;pointers.
	INY  	;HI byte.
	LDA (SAVD),Y
	STA ADDR+1
	RTS  	;bye.
;
;Thread an ML program
;
TRACE	JSR GADR 	;get trace adr
	LDA FR0 	;save it.
	STA ADDR
	LDA FR0+1
	STA ADDR+1
	JSR CLRWIN
	LDY #7 	;slo or fast?
FSL	LDA SLOF,Y
	STA COMND,Y
	DEY 
	BPL FSL
	STY SLFS
;
;SLFS = $FF for Slow mode
;     = $00 for Fast mode
;     = $01 for Option step mode
;
FSW	JSR GETKEY 	;get choice
	CMP #'F 	;FAST?
	BNE SLO? 	;no.
	INC SLFS 	;fast mode
	BEQ TN
SLO?	CMP #'S 	;SLOW?
	BEQ TN 	;wrong!
	CMP #'O 	;O=option for
	BNE FSW 	;step thru
	LDA #1
	STA SLFS
TN	JSR CLRSCR 	;clear screen
	JSR CLRWIN 	;clear input
	JSR CLRCMD 	;and prompt
TLOOP	LDA ADDR 	;take addr and
	STA USRPC 	;put in Program
	STA SAVD 	;Counter, and
	LDA ADDR+1 	;instruction
	STA USRPC+1 	;save address.
	STA SAVD+1
	JSR DISAMEM 	;disa this adr
	JSR SCROLL 	;move screen
	LDY #2 	;install NOP's
	LDA #234 	;(a NOP)
DNOP	STA NOPS,Y 	;in area
	DEY 
	BPL DNOP 	;done?
	JSR PAUSE 	;wait?
	JSR DOREGS 	;up date USRPC
	LDA MYBUF+18 	;get disa chr
	BPL GINS 	;inverse?
	JSR POS15 	;on status line
	LDA # <BRKPNT 	;BRK REACHED
	LDY # >BRKPNT
	JMP EPRINT 	;print it.
GINS	CMP #63 	;a '?' ?
	BNE NOBR 	;no.
	LDY #151 	;yes. a No-inst
	JMP IOERR 	;give error.
NOBR	LDA OP 	;get the Opcode
	CMP #96 	;is it RTS?
	BNE NORTS 	;no.
	JSR DORTS 	;do the RTS
	JMP TDNE 	;all done.
NORTS	CMP #$40 	;RTI?
	BNE IJMP 	;no.
	LDX USRS 	;get USRP
	INC USRS 	;off stack.
	LDA MYPG1,X 	;proc status.
	STA USRP 	;in REG
	INX 
	LDA MYPG1,X
	STA ADDR
	INX 
	LDA MYPG1,X
	STA ADDR+1
	STX USRS
	JMP TDNE 	;all done.
IJMP	CMP #76 	;JMP?
	BNE CPN2 	;nope.
	JSR DOJMP 	;do JMP
	JMP TDNE 	;done.
CPN2	CMP #32 	;JSR?
	BNE CPN6 	;nope.
	JSR DOJSR 	;make JSR
	JMP TDNE 	;finished.
CPN6	CMP #108 	;JMP ()?
	BNE CPN7 	;no.
	JSR DOJMP 	;yes. get adr
	LDY #0 	;look up JMP
	LDA (ADDR),Y 	;addr thru
	PHA  	;this adr.
	INY  	;up Y
	LDA (ADDR),Y 	;get HI byte
	STA ADDR+1 	;in addr
	PLA  	;restore LSB
	STA ADDR 	;in addr
	JMP TDNE 	;done.
CPN7	LDA BRAFLG 	;branch?
	BEQ CPN4 	;not this one.
	LDA OP 	;get Op.
	LDY #3 	;loop 4 times
FBRA	CMP BRAL,Y 	;bit not set?
	BEQ HAVBRA2 	;YES.
	CMP BRAH,Y 	;bit set?
	BEQ HAVBRA 	;YES.
	DEY  	;no.
	BPL FBRA 	;try next one.
;
;Branch if bit set
;
HAVBRA	LDA USRP 	;get processor
	AND BBIT,Y 	;mask bit.
	BEQ NOTE 	;off? yes.
NEWADR	LDA BRAN 	;set up the
	STA ADDR 	;new branch
	LDA BRAN+1 	;address for
	STA ADDR+1 	;next time.
NOTE	JMP TDNE 	;jam!
;
;Branch if bit not set
;
HAVBRA2	LDA USRP 	;processor
	AND BBIT,Y 	;mask it.
	BEQ NEWADR 	;off? yes.
	JMP TDNE 	;no.
CPN4	LDY #0 	;ready to copy
CIN	LDA (SAVD),Y 	;the instr
	STA NOPS,Y 	;into NOP area
	INY  	;for fall thru.
	CPY NBYTE 	;done?
	BNE CIN 	;not yet.
;
;Run the instruction
;
	LDA #0 	;kill ints
	STA NMIEN
	SEI  	;set interrupt
	LDX #0 	;copy user mem
CPZ1	LDA ZPAGE,X 	;into pages
	TAY  	;0 - 2.
	LDA MYZPG,X 	;PAGE 0
	STA ZPAGE,X
	TYA 
	STA MYZPG,X
;
	LDA STACK,X 	;PAGE 1
	TAY  	;(the stack)
	LDA MYPG1,X
	STA STACK,X
	TYA 
	STA MYPG1,X
;
	LDA PAGE2,X 	;PAGE 2
	TAY  	;(interrupts)
	LDA MYPG2,X 	;(and stuff)
	STA PAGE2,X
	TYA 
	STA MYPG2,X
;
	INX 
	BNE CPZ1
	TSX  	;get stack
	TXA  	;in A
	LDX USRS 	;user stack
	TXS  	;pointer.
	STA USRS 	;save my stack.
	LDY USRY 	;get Y,
	LDX USRX 	;get X,
	LDA USRP 	;put on the
	PHA  	;processor stat
	LDA USRA 	;get A
	PLP  	;pull status
NOPS	NOP  	;* here is    *
	NOP  	;* where the  *
	NOP  	;* instr goes *
	PHP  	;push status
	STA USRA 	;save A
	PLA  	;save status
	STA USRP
	STX USRX 	;save X
	STY USRY 	;save Y
	TSX  	;put back stack
	TXA  	;pointers
	LDX USRS
	TXS 
	STA USRS
	SEI  	;set for safety
	LDX #0 	;now copy back
;             ;pages 0 - 2
CZP	LDA ZPAGE,X 	;zero page
	TAY 
	LDA MYZPG,X
	STA ZPAGE,X
	TYA 
	STA MYZPG,X
;
	LDA STACK,X 	;the stack
	TAY 
	LDA MYPG1,X
	STA STACK,X
	TYA 
	STA MYPG1,X
;
	LDA PAGE2,X 	;page 2
	TAY 
	LDA MYPG2,X
	STA PAGE2,X
	TYA 
	STA MYPG2,X
;
	INX 
	BNE CZP
	CLI  	;clr interrupts
	LDA #64 	;turn on the
	STA NMIEN 	;interrupts
TDNE	JSR DOREGS 	;show registers
	LDA SLFS 	;mode.
	BMI TDN1 	;Slow.
	BEQ TDN2 	;Fast!
	LDX #8 	;consol clear
	STX CONSOL 	;clear it.
CNW	LDA CONSOL 	;get it
	CMP #3 	;OPTION?
	BNE CNW 	;no.
	STX CONSOL 	;yes. zero it.
	BNE TDN2
TDN1	JSR WAIT5 	;wait 1/4 sec
TDN2	JMP TLOOP 	;next instr
;
;Move screen up 32 bytes
;
MOVE32	LDA # <MYSCRN 	;screen
	STA IND2 	;address in
	LDA # >MYSCRN 	;Zpage addr
	STA IND2+1 	;so we can
	LDA IND2 	;the screen up
	CLC  	;40 bytes
	ADC #32
	STA INDR
	LDA IND2+1
	ADC #0
	STA INDR+1
	LDX #0 	;line 0
MOVE	LDY #31 	;32 bytes
MOVIT	LDA (INDR),Y
	STA (IND2),Y
	DEY 
	BPL MOVIT 	;loop.
	LDA INDR+1 	;copy to
	STA IND2+1
	LDA INDR
	STA IND2 	;add a 32
	CLC  	;to copy
	ADC #32 	;from.
	STA INDR
	LDA INDR+1
	ADC #0
	STA INDR+1
	INX  	;up line
	CPX #14 	;line 13?
	BNE MOVE 	;no.
	RTS  	;bye.
;
;Clear status line
;
ERASTAT	LDY #23 	;24 characters
	LDA #0 	;a zero
ERAS1	STA STATLN,Y 	;in line
	DEY  	;next
	BPL ERAS1 	;go to it.
	RTS  	;bye.
;
;Decimal/Hexadecimal Convert
;
PRDH	LDA HXDC 	;# type
	STA SAVY2 	;save it
	LDA #3 	;full number
	STA NBYTE 	;length
	JSR GADR 	;get number
	LDA #32 	;make EOL a spc
	STA MYBUF,Y
	STA MYBUF+2,Y
	LDA #'= 	;install =
	INY 
	STA MYBUF,Y
	INY 
	STY SAVX2 	;save Y
	LDA HXDC 	;# type
	EOR #1 	;flip it
	STA HXDC 	;and save again
	LDX #28 	;copy in #
	JSR COPYNUM
	STX CEND
	LDX #28 	;now move #
	LDY SAVX2 	;down in string
CPN9	LDA MYBUF,X
	STA MYBUF+1,Y
	CPX CEND 	;at end?
	BEQ AEND 	;yes!
	INX 
	INY 
	BNE CPN9 	;go again.
AEND	LDA #EOL 	;install EOL
	STA MYBUF+2,Y
	JSR POS15 	;on status line
	LDA SAVY2 	;restore # type
	STA HXDC
	JMP IOL3 	;print it.
;
;Erase memory
;
ERASE	JSR GADR 	;start addr
	LDA FR0 	;transfer to
	STA SL 	;2 Zpage locs
	LDA FR0+1
	STA SL+1
	JSR GADR 	;End addr
	LDY #0
	LDA FR0+1 	;is End<Start?
	CMP SL+1
	BCC NEWERR 	;yes!
	BNE NEWOK 	;no.
	LDA FR0 	;equal check
	CMP SL 	;LSB.
	BCC NEWERR 	;error!
	BEQ NEW2 	;equal 1 byte
NEWOK	TYA  	;get 0
	STA (SL),Y 	;in loc
	INC SL 	;up loc
	BNE NEW1 	;wrap around?
	INC SL+1 	;yes.
NEW1	LDA FR0+1 	;check to see
	CMP SL+1 	;if done yet.
	BNE NEWOK 	;not done.
	LDA FR0 	;check LSB
	CMP SL
	BNE NEWOK 	;not yet.
NEW2	TYA  	;and do last
	STA (SL),Y 	;location.
	RTS  	;bye.
NEWERR	LDY #153 	;ADR RANGE
	JMP IOERR 	;show it.