;------------------------------------------------------------------------
;
;		Copyright 2006 Intergraded Logic Systems
;                  Source Code is Copyright Stephen J. Carden
;
;
;			Please do not share this source!
;------------------------------------------------------------------------
;			hyp_r (utility for real.dos v1.0) 
;                         Real.dos hpy_r.com
;
;	Code History.     Init design,   1994 			Lenard R. Spencer
;			  last updated   11/04/2006		sjc
;				converted to xasm		sjc
;			  combined both mio code and black box 
;			  code and installed a routeen to check
;			  for each device.			sjc
;
;
;
;                   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;------------------------------------------------------------------------
;Optimized R: handler
;for Multi-I/O and Black Box
;
;Multi-I/O
;Black Box tm CSS
;
;This is a replacement handler for the ROM handlers in the Multi-I/O and
;Black Box, in and effort to provide a more efficient handler for the newer
;high-speed modems.  The problem is not so much the handlers themselves, but
;rather the Atari XL/XE operating system, and its overhead of code in
;what is called the "generic handler just to access the ROM handlers.
;There is also an excess of overhead code in the interrupt handler just to
;get to the ROM interrupt service routines.  This memory-resident
;handler has its own IRQ routine that is patched into the IRQ vector at
;$0216, so it can check the hardware directly.
;
;This source code assembles into two versions, one for the Multi-I/O, the
;other for the Black Box, depending on how the variable MIO is set.  If
;MIO=0, a Black Box version will be assembled.  If MIO=non-zero, a MIO
;version will result.
;
;This handler is optimized for using the RS-232 port strictly for modem
;operations, so do not attempt to use it for a serial printer or the system
;will lock up.
;
;------------------------------------------------------------------------
; Notes: o This source code MAY NOT be placed for download on any BBS's!
;        o "mea" is a macro that loads the address of the first field
;          into the pointer specified by the second field.
;------------------------------------------------------------------------
; Assembler:  MADMAC (tm) ST Cross Assembler (Atari Corp)
;             XASM   st and IBM VERSIONS
;------------------------------------------------------------------------
;
com_file_name:		.macro
;			dc.b	13,"filename.ext",$9b
			dc.b	12,"HYP_r.com   ",$9b
			.endm

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

file_compiler:		equ	xasm
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; is this relocatable code ?
; anyother value other than 1 or 2 would be unknown
r..yes:			equ	1
r..no:			equ	2
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Gotta define if it can be relocated
l_relocatable:		equ	r..no
;
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Gotta define if it can be relocated
r..crl:			equ	$7d
r..crlf:		equ	$9b
r..space:		equ	$20

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


			.include	equates
			.include	globals
			.include	macros
;





				.org	$4000			;To be relocated



win_start:
header_info:
				.include	header			; this reads info out of the header and displays to screen

				jsr	os_off
				mea	tsr,s_ptr
				lda	#Hyp_r
				jsr	seclvl 			; call routing checking 
				bmi 	.aa
	 			jsr	printsi
				dc.b	$9b
				dc.b	" "
				dc.b	<+128>,"==>"
				dc.b	<+128>,"Hyper R is already present"
				dc.b	<+128>,"<=="
				dc.b	$9b
				dc.b	" "
				dc.b	<+128>,"==>"
				dc.b	<+128>,"And Registered with the OS"
				dc.b	<+128>,"<=="
				dc.b	$9b,-1
				jsr	os_on
				rts				; we are gonna Exit


.aa:
				jsr	os_on

				jsr	test_pbi
				lda	pbi_device
				cmp	#$01				; MIO ID
				beq	go_mio
				cmp	#$02				; Black Box ID
				beq	go_blackbox
				jmp	no_comp_pbi				

go_mio:				jmp	relocate
go_blackbox:			jmp	relocate.bb

no_comp_pbi:
				jsr	printsi
				dc.b	$9b,$9b
				dc.b	" You must have a Black Box or MIO",$9b
				dc.b	" to use the Hyper R: Handler",$9b,$9b
				dc.b	-1
				rts


pbi_device:			dc.b	$00				; 0 = no pbi 1= mio 2= Black Box






start:

;Needed by relocator
hatab:				dc.w	open-1
w01:				dc.w	close-1
w02:				dc.w	get-1
w03:				dc.w	put-1
w04:				dc.w	status-1
w05:				dc.w	special-1
				dc.b	0

staterr:			dc.b	0			;status/error fl.
nextin:				dc.b	0			;next byte in
lastin:				dc.b	0			;last byte in
nextout:			dc.b	0			;next byte out
lastout:			dc.b	0			;last byte out
concur:				dc.b	0			;concurrent flag
mode:				dc.b	0			;I/O mode
trans:				dc.b	0			;translation
;
;	 "INTERRUPT ROUTINE"
;
irq:				pha				;save accum.,X
				txa
				ldx	$d1c1			;ACIA IRQ?
				bmi	irq2			;yes - skip
				tax
				pla
sysirq:				jmp 	$c030			;otherwise out
irq2:				pha
				tya
				pha
				txa				;get status
				and	#8			;receive?
				beq	trysend			;no - try send
w06:				ldy	lastin
				lda	$d1c0 			;get byte
w07:				sta	mio.inbuff,y 		;store it
				iny
w08:				sty	lastin
w09:				cpy	nextin  		;rolled over?
				bne	irqexit 		;no - exit
w10:				inc	nextin  		;else set flag
w11:				lda	staterr 		; for buffer
				ora	#$10			;  overflow
w12:				sta	staterr
trysend:			txa
				and	#$10			;Tx reg empty?
				beq	irqexit 		;
				lda	$d1c2 			;Tx enabled?
				and	#$0c
				cmp	#4
				bne	irqexit 		;no - exit
send02:				lda	$d1ff 			;CTS monitoring
				and	#$04 			;=  ;CTS = 1?		; this maybe an error
				beq	send02			;no - loop back
w13:				ldy	nextout
w14:				cpy	lastout			;buffer empty?
				bne	sendit			;no - send byte
w15:				jsr	dstxirq			;disable Tx IRQ
irqexit:			pla				;restore regs
				tay

w16:				jsr	enirq 			;(needed if using BobTerm)
				pla
				tax
				pla
				rti				;bail out!
sendit:				iny
w17:				lda	outbuff,y
				sta	$d1c0
w18:				sty	nextout
w19:				jmp	irqexit
dstxirq:			lda	#8
				dc.b	$2c			;imp. BIT inst.
entxirq:			lda	#4
				eor	$d1c2
				and	#$0c
				eor	$d1c2
				sta	$d1c2
				rts
;
;	  "GET BYTE ROUTINE"
;
get:				bit	brkkey  		;BREAK key pressed?
				bpl	get10			;yes - bail out!
w20:				ldx	nextin  		;get pointer
w21:				cpx	lastin  		;buffer empty?
				beq	get				 ;yes - loop back
w22:				ldy	mio.inbuff,x 		;get byte
				inx				;bump pointer
w23:				stx	nextin  		;save it
w24:				lda	trans
				and	#$20			;ATASCII?
				bne	get10			;yes - skip
				cpy	#$0c+1			;ASCII CR?
				bne	get10			;no - skip
				ldy	#$9b			;make ATASCII EOL
get10:				tya
				pha
w25:				jsr	setbreak
				pla
				cpy	#0
				rts
;
;	  "PUT BYTE, SET BREAK"
;
put:				tay
w26:				lda	trans
				and	#$20			;ATASCII?
				bne	put03			;yes - skip
				cpy	#$9b			;ATASCII EOL?
				bne	put03			;no - skip
				ldy	#$0c+1			;else make CR
w27:				jsr	put10			;send it
w28:				bit	trans			;need LF?
				bvc	setbreak 		;no - skip
				ldy	#$0a			;else send LF
put03:				jsr	put10			;send character
setbreak:			ldy	#1			;assume OK
				bit	brkkey			;BREAK pressed?
				bmi	enirq			;no - skip
				ldy	#$80			;else ERROR 128
				sty	brkkey			;reset BREAK flag
ENIRQ:
				sei
				ldx	#0			;enable MIO RAM
				lda	#$20			;(needed with MIO
				stx	$d1e0			; or BobTerm will
				sta	$d1e2			;  crash)
				lda	$d6fc+1			;get shadows so
				ldx	$d6fc			; we don't crash
				ora	#$80			;  system
				stx	$d1e0			;enable
				sta	$d1e2			; parallel IRQ'S
				cli
				cpy	#0			;set exit flags
				sec				;yes we handled it
				rts
put10:				ldx	lastout			;get pointer
				inx
put11:				bit	brkkey			;BREAK pressed?
				bpl	putexit			;yes - bail out
w29:				cpx	nextout			;buffer full?
				beq	put11			;yes - loop back
				sei
				tya
w30:				sta	outbuff,x		;put in buffer
w31:				stx	lastout			;save pointer
w32:				jsr	entxirq			;enable Tx IRQ
				cli
putexit:  rts
;
;	  "OPEN, CLOSE R: CHANNEL"
;
open:				lda	icax1z			;get aux 1 byte
w33:				sta	mode			;save
				sei
				ldx	#5
				lda	#0			;zero out working
op01:				sta	staterr,x		; variables
				dex
				bpl	op01
open03:				lda	mode
				sta	icax1z
w34:				jmp	setbreak
;
; CLOSE R: HANDLER CHANNEL
;
close:				lda	#0			;end concurrent
w35:				sta	concur			;mode
xio32:				jsr	forceout		;send last bytes
w36:				jmp	open03
forceout:			lda	lastout			;get pointer
f01:				bit	brkkey			;BREAK pressed?
				bpl	f02			;yes - exit
w37:				cmp	nextout			;buffer empty?
				bne	f01			;no - loop back
f02:				rts				;exit
;
; "GET STATUS OF R: CHANNEL"
;
status:				lda	$d1ff			;read H/S lines
				and	#7			;get index into
				tax				; table
w38:				lda	hsflags,x
				sta	dvstat+1
w39:				bit	concur			;concurrent mode?
				bpl	stat02			;no - skip
				sec
w40:				lda	lastin			;calc bytes in
w41:				sbc	nextin			;input buffer
				sta	dvstat+1
				sec
w42:				lda	lastout			;calc bytes in
w43:				sbc	nextout			;output buffer
				sta	dvstat+3
stat02:				lda	staterr			;status flags
				sta	dvstat			
				lda	#0			;clear flags
w44:				sta	staterr
				sta	dvstat+2
w45:				jmp	setbreak


hSFLAGS:
				  dc.b $01,$0d,$c1,$cd
				  dc.b $31,$3d,$f1,$fd
;
;	  "XIO 40, 38, 36 CALLS"
;
special:			ldx	iccomz			;get command
				lda	icax1z			;get aux 1
				cpx	#$28			;set concurrent?
				bne	xio38			;no - try next
w46:				lda	concur			;set flag for
				ora	#$80			;concurrent mode
w47:				sta	concur			;operation
w48:				jmp	open03
xio38:				cpx	#$26			;trans, parity?
				bne	xio36			;no - try next
w49:				sta	trans			;save directly
				lsr
				lsr
				and	#3			;get parity bits
				tay
				lda	$d1c2
				and	#$1f
w50:				ora	parity,y
				sta	$d1c2
w51:				jmp	open03

parity:				dc.b	0,$20,$60,$a0


xio36:				cpx	#$24			;baud, word size?
				bne	xio34			;no - try next
				tay				;temp save
				and	#$d0			;set word size,
				asl				;stop bits
				php
				asl
				plp
				ror
				pha				;temp save
				tya
				and	#$0f			;get baud rate
				beq	xio36c			;index
				ldx	#8
				cmp	#5			;110 baud?
				beq	xio36a			;yes - skip down
				sec				;otherwise -
				cmp	#8			;standard rates?
				bcc	err132			;no - error out
				and	#7			;get index
xio36c:				tax
xio36a:				pla				;retrieve byte
w52:				ora	baud,x			;index baud table
				sta	$d1c3
xio36b:				jmp	open03
baud:				dc.b	$16,$17,$18,$19
				dc.b	$1a,$1c,$1e,$1f,$13
;	  "ERROR 132
; 	XIO 34, 32"
err132:				jsr	setbreak
				tya
				bmi	er132a
				ldy	#$84			;illegal XIO call
er132a:				rts
xio34:				cpx	#$22			;set H/S lines?
				bne	xio32a			;no - skip
				tax
				bpl	xio34a
				and	#$40			;set DTR
				asl
				asl
				php
				lda	$d1c2
				lsr
				plp
				rol
				sta	$d1c2
xio34a:				txa
				and	#$30
				cmp	#$30			;set RTS true?
				beq	xio34d			;yes - skip
				cmp	#$20			;set RTS false?
				beq	xio34c			;yes - skip
				txa
				and	#3
				cmp	#3			;set xmit MARK?
				beq	xio34b			;yes - skip
				cmp	#2			;set xmit SPACE?
				bne	w53			;no - exit
xio34d:				lda	#8
				dc.b	$2c			;implied 'BIT'
xio34b:				lda	#$0c			;instructions -
				dc.b	$2c			;will not alter
xio34c:				lda	#0			;accumulator data
				eor	$d1c2
				and	#$0c
				eor	$d1c2
				sta	$d1c2
w53:				jmp	open03
xio32a:				cpx	#$20			;XIO 32?
				bne	err132			;no - error out
w54:				jmp	xio32
mio.inbuff:			ds.b	256
outbuff:			ds.b	256
;								
;  "RESET INITIALIZATION"
init:				jsr	$ffff			;DOSINI vector
init02:				lda	# low relocate		;move MEMLO up to
				sta	memlo			;protect handler
h03:				lda	# high relocate
				sta	memlo+1
				ldx	#0
init03:				lda	$031a,x			;find handler
				beq	sethand			;end of HATABS
				cmp	#'R'			;$52	"R:"
				beq	set02			;R: handler found
				inx
				inx
				inx
				bne	init03
sethand:			lda	#'R'			;$52
				sta	$031a,x
set02:				lda	# low hatab
				sta	$031b,x
h01:				lda	# high hatab
				sta	$031c,x
				lda	$0216			;patch into
w55:				sta	sysirq+1		;IRQ vector
				lda	$0216+1
w56:				sta	sysirq+2
				sei
l02:				lda	# low irq
				sta	$0216
h02:				lda	# high irq
				sta	$0216+1
				cli
				lda	$d1c2			;set DTR low
				and	#$fe
				sta	$d1c2
inout:				rts
;
;	GENERIC RELOCATOR -this is my early relocator
;
relocate:
				jsr	set_handler		; register hyp_r with the os


				ldx	#0			;Just to make sure
rel01:				lda	$031a,x			;we have room in
				beq	rel01a			;the handler table
				inx
				inx
				inx
				cpx	#32+1
				bcc	rel01

				jmp	no_instal_error		; nope out of here with an error

rel01a:
				lda	pbi_device		; is there an MIO?
				cmp	#$01			; 1 = yes
				beq	.a			; ok do the relocate
				jmp	no_instal_error		; nope out of here with an error
.a:
				lda	# low start		;calculate
				sec				;offset for
				sbc	memlo			; relocation
				sta	offset
				lda	# high start
				sbc	memlo+1
				sta	offset+1
				ldx	#0			;initialize for
				ldy	#0			; relocation loop
rel02:				lda	tablo,x
				sta	$e0
rel03:				lda	tabhi,x
				sta	$e2
				inx
rel04:				lda	tablo,x
				sta	$e0+1
rel05:				lda	tabhi,x
				sta	$e2+1
				ora	$e2			;end of table?
				beq	moveit			;yes - drop down
				lda	($e0),y			;else - recalc
				sec				;address
				sbc	offset
				sta	($e0),y
				lda	($e2),y
				sbc	offset+1
				sta	($e2),y
				inx				;next address
				bne	rel02			;no wrap - go back
				inc	rel02+2			;else bump
				inc	rel03+2			;addresses up
				inc	rel04+2			;to next page
				inc	rel05+2
				jmp	rel02



; "MOVE CODE TO MEMLO"

moveit:				lda	# low start		;move handler
				sta	$e0			;to MEMLO
				lda	# high start
				sta	$e0+1
				lda	memlo
				sta	$e2
				lda	memlo+1
				sta	$e2+1
				lda	# low relocate-start
				sta	$e4
				lda	# high relocate-start
				sta	$e4+1
move02:				lda	($e0),y
				sta	($e2),y
				inc	$e0
				bne	move03
				inc	$e0+1
move03:				inc	$e2
				bne	move04
				inc	$e2+1
move04:				lda	$e4
				bne	move05
				dec	$e4+1
move05:				dec	$e4
				bne	move02
				lda	$e4+1
				bne	move02
relinit:			lda	$0c			;DOSINI vector
m06:				sta	init+1			;patch point
				lda	$0c+1
m07:				sta	init+2
m08:				lda	# low init
				sta	$0c
m09:				lda	# high init
				sta	$0c+1
m10:				jsr	init02

prtmsg:
				jsr	printsi

				dc.b	"HyperSpeed RS232 accelerator",$9B
				dc.b	"Version ",-1
				lda	f.c_ver     ;cmd_ver
				jsr	ver_num
				lda	pbi_device		; is there an BB?
				cmp	#$02			; 2 = yes
				beq	.got_bb				
								; we must have an mio or someone
				jsr	printsi			; been sector editing <grin>
				dc.b	" for Multi I/O",-1
				jmp	.gotendmsg

.got_bb:			jsr	printsi
				dc.b	" for Black Box",-1

.gotendmsg:			jsr	printsi
				dc.b	$9b
				dc.b	<+128>,"Installed"
				dc.b	$9b,-1
				rts


no_instal_error:		jsr	printsi
				dc.b	$9b,$9b
				dc.b	<+128>,"Handler table full!"
				dc.b	$9B
				dc.b	<+128>,"HyperSpeed not installed!"
				dc.b	$9b,-1
				rts
errend:

offset:				dc.w 0


; "RELOCATOR TABLE 1"
;
;Each TABLO entry MUST have a matching
;TABHI entry.  TABLO is for the low
;bytes to be offset, TABHI is for the
;high bytes.  TABHI MUST END WITH ZERO
;OR THE RELOCATOR WILL NOT KNOW WHEN
;TO STOP!
;
tablo:				dc.w	m06+1
				dc.w	m07+1
				dc.w	m08+1
				dc.w	m10+1
				dc.w	hatab
				dc.w	w01
				dc.w	w02
				dc.w	w03
				dc.w	w04
				dc.w	w05
				dc.w	w06+1
				dc.w	w07+1
				dc.w	w08+1
				dc.w	w09+1
				dc.w	w10+1
				dc.w	w11+1
				dc.w	w12+1
				dc.w	w13+1
				dc.w	w14+1
				dc.w	w15+1
				dc.w	w16+1
				dc.w	w17+1
				dc.w	w18+1
				dc.w	w19+1
				dc.w	w20+1
				dc.w	w21+1
				dc.w	w22+1
				dc.w	w23+1
				dc.w	w24+1
				dc.w	w25+1
				dc.w	w26+1
				dc.w	w27+1
				dc.w	w28+1
				dc.w	w29+1
				dc.w	w30+1
				dc.w	w31+1
				dc.w	w32+1
				dc.w	w33+1
				dc.w	w34+1
				dc.w	w35+1
				dc.w	w36+1
				dc.w	w37+1
				dc.w	w38+1
				dc.w	w39+1
				dc.w	w40+1
				dc.w	w41+1
				dc.w	w42+1
				dc.w	w43+1
				dc.w	w44+1
				dc.w	w45+1
				dc.w	w46+1
				dc.w	w47+1
				dc.w	w48+1
				dc.w	w49+1
				dc.w	w50+1
				dc.w	w51+1
				dc.w	w52+1
				dc.w	w53+1
				dc.w	w54+1
				dc.w	w55+1
				dc.w	w56+1
				dc.w	set02+1
				dc.w	l02+1
				dc.w	put03+1
				dc.w	put10+1
				dc.w	op01+1
				dc.w	open03+1
				dc.w	xio32+1
				dc.w	init02+1
				dc.w	forceout+1
				dc.w	stat02+1
				dc.w	xio36b+1
				dc.w	err132+1



; "RELOCATOR TABLE 2"
tabhi:
				dc.w	m06+2
				dc.w	m07+2
				dc.w	m09+1
				dc.w	m10+2
				dc.w	hatab+1
				dc.w	w01+1
				dc.w	w02+1
				dc.w	w03+1
				dc.w	w04+1
				dc.w	w05+1
				dc.w	w06+2
				dc.w	w07+2
				dc.w	w08+2
				dc.w	w09+2
				dc.w	w10+2
				dc.w	w11+2
				dc.w	w12+2
				dc.w	w13+2
				dc.w	w14+2
				dc.w	w15+2
				dc.w	w16+2
				dc.w	w17+2
				dc.w	w18+2
				dc.w	w19+2
				dc.w	w20+2
				dc.w	w21+2
				dc.w	w22+2
				dc.w	w23+2
				dc.w	w24+2
				dc.w	w25+2
				dc.w	w26+2
				dc.w	w27+2
				dc.w	w28+2
				dc.w	w29+2
				dc.w	w30+2
				dc.w	w31+2
				dc.w	w32+2
				dc.w	w33+2
				dc.w	w34+2
				dc.w	w35+2
				dc.w	w36+2
				dc.w	w37+2
				dc.w	w38+2
				dc.w	w39+2
				dc.w	w40+2
				dc.w	w41+2
				dc.w	w42+2
				dc.w	w43+2
				dc.w	w44+2
				dc.w	w45+2
				dc.w	w46+2
				dc.w	w47+2
				dc.w	w48+2
				dc.w	w49+2
				dc.w	w50+2
				dc.w	w51+2
				dc.w	w52+2
				dc.w	w53+2
				dc.w	w54+2
				dc.w	w55+2
				dc.w	w56+2
				dc.w	h01+1
				dc.w	h02+1
				dc.w	put03+2
				dc.w	put10+2
				dc.w	op01+2
				dc.w	open03+2
				dc.w	xio32+2
				dc.w	h03+1
				dc.w	forceout+2
				dc.w	stat02+2
				dc.w	xio36b+2
				dc.w	err132+2
				dc.w	0				 ;STOP HERE!
;

;--------------------------------------------
;printsi Routeen macro             
;this is a slow print to the screen
;usage jsr	printsi
;    .byte $9b," string to be printed",$ff
;--------------------------------------------
;
printsi:			pla
				sta	$b0
				pla
				sta	$b1
				ldy	#$01
.a:				lda	($b0),y
				cmp	#$ff
				beq	.b
				jsr	sprint
				jsr	.c
				jmp	.a
.b:				jsr	.c
				lda	$b1
				pha
				lda	$b0
				pha
				rts
.c:				inc	$b0
				bne	.d
				inc	$b1
.d:				rts
;
;
;------------
; PRINT BYTE 
;------------
echo:
sprint:				sta	$b8
				lda	#$04
				sta	$034a
				stx	$b6
				sty	$b7
				ldx	#$06
				lda	$e400+1,x
				sta	$b3
				lda	$e400,x
				sta	$b2
				lda	$b8
				jsr	.a
				ldx	$b6
				ldy	$b7
				lda	#$0c
				sta	$034a
				lda	$b8
				rts
;
.a:				inc	$b2
				jmp	($b2)
				rts

test_pbi:
				jsr	BLACK_BOX
				lda	pbi_device
				cmp	#$02		; bb ID
				beq	.done
				jsr	mio_test
.done:				rts


;
ver_num:
				pha	
				lsr
				lsr
				lsr
				lsr		
				jsr     .a
				lda     #'.'
				jsr     echo
				pla
				and     #$0f
.a:         			cmp     #$0a
				bcs     .b
				ora     #$30
				bne     .c
.b:         			adc      #$36
.c:        			jsr      echo
				rts

;






;;
;------------------------------------------------------------------
;  This Routeen Tests for a MIO in system
;
;
MIO_TEST:
				sta	mio_acc
				sty	mio_y
				stx	mio_x
				tsx
				stx	mio_stack
				sei

				lda	$14
tammy:				cmp	$14
				beq	tammy
				SEC         		; DISSABLE ALL INTRUPES
				LDa	Ld1e0
				STa	M_HOLD
				LDa	Ld1e2
				STa	M_HOLD+1
				LDa	#$00
				STa	Ld1e0
				LDa	#$20
				STa	Ld1e2
				LDa	#'C'
				cmp	pbi_ram+1
				bne	NO_MIO
				cmp	pbi_ram+10
				bne	NO_MIO
				lda	#$01
				sta	mio_there

NO_MIO
				lda	#$00    	; this reselects the mio to be enabled
				sta	$d1e0
				sta	$d1e2
				CLI

				ldx	mio_stack
				txs
				lda	mio_acc
				ldy	 mio_y
				ldx	mio_x
				lda	mio_there
				cmp	#$00
				beq	_exit


				jsr	printsi
				dc.b	"ICD MIO Present in System!",$9B,-1
				lda	#$01
				sta	pbi_device

_exit:				rts


M_HOLD:				dc.b	0,0

mio_acc:			dc.b	0	; accumlator
mio_y:				dc.b	0	; Y register
mio_x:				dc.b	0	; x register
mio_stack:			dc.b	0	; hold the stack
mio_there:			dc.b	0	; holding reg for mio test
;
;
;  Checking on the black box if it is present!
;
BLACK_BOX:
				SEI
				LDa	#2
				STa	BB_Sensel
				ldy	 #$10
.a
				ldx	#2
				LDa	bb_rom,Y
				cmp	.e,X
				beq	.b
				INY
				bne	.a
				jmp	.d
				RTS
;
.b
				INY
				DEX
				bmi	.c
				LDa	bb_rom,Y
				cmp	.e,X
				bne	.a
				beq	.b
.c
				jsr	printsi
				dc.b	$9b
				dc.b	"Black Box IS present in system!",$9B,-1
				lda	#$02
				sta	pbi_device
;
.d
				CLD
				LDa	#0
				STa	BB_Sensel
				CLI
				RTS
;
.e				dc.b	$D0,$08,$29,$00
;
;
;
;
;	this is stuff for a Hyper R for the black box
;
;
;
start.bb:

;Needed by relocator
hatab.bb:			dc.w	open.bb-1
w01.bb:				dc.w	close.bb-1
w02.bb:				dc.w	get.bb-1
w03.bb:				dc.w	put.bb-1
w04.bb:				dc.w	status.bb-1
w05.bb:				dc.w	special.bb-1
				dc.b	0

staterr.bb:			dc.b	0			;status/error fl.
nextin.bb:			dc.b	0			;next byte in
lastin.bb:			dc.b	0			;last byte in
nextout.bb:			dc.b	0			;next byte out
lastout.bb:			dc.b	0			;last byte out
concur.bb:			dc.b	0			;concurrent flag
mode.bb:			dc.b	0			;I/O mode
trans.bb:			dc.b	0			;translation
;
; "INTERRUPT ROUTINE"
;
irq.bb:				pha				;save accum.,X
				txa
				ldx	$d131			;ACIA IRQ?
				bmi	irq2.bb			;yes - skip
				tax
				pla
sysirq.bb:			jmp 	$c030			;otherwise out
irq2.bb:			pha
				tya
				pha
				txa				;get status
				and	#8			;receive?
				beq	trysend.bb		;no - try send
w06.bb:				ldy	lastin.bb
				lda	$d130 			;get byte
w07.bb:				sta	inbuff.bb,y 		;store it
				iny
w08.bb:				sty	lastin.bb
w09.bb:				cpy	nextin.bb  		;rolled over?
				bne	irqexit.bb 		;no - exit
w10.bb:				inc	nextin.bb  		;else set flag
w11.bb:				lda	staterr.bb 		; for buffer
				ora	#$10			;  overflow
w12.bb:				sta	staterr.bb
trysend.bb:			txa
				and	#$10			;Tx reg empty?
				beq	irqexit.bb 		;
				lda	$d132 			;Tx enabled?
				and	#$0c
				cmp	#4
				bne	irqexit.bb 		;no - exit
send02.bb:			lda	$d1c0 			;CTS monitoring
				and	#$40 			;=  ;CTS = 1?		; this maybe an error
				beq	send02.bb		;no - loop back
w13.bb:				ldy	nextout.bb
w14.bb:				cpy	lastout.bb		;buffer empty?
				bne	sendit.bb		;no - send byte
w15.bb:				jsr	dstxirq.bb		;disable Tx IRQ
irqexit.bb:			pla				;restore regs
				tay

				pla
				tax
				pla
				rti				;bail out!
sendit.bb:				iny
w17.bb:				lda	outbuff.bb,y
				sta	$d130
w18.bb:				sty	nextout.bb
w19.bb:				jmp	irqexit.bb
dstxirq.bb:			lda	#8
				dc.b	$2c			;imp. BIT inst.
entxirq.bb:			lda	#4
				eor	$d132
				and	#$0c
				eor	$d132
				sta	$d132
				rts
;
;	  "GET BYTE ROUTINE"
;
get.bb:				bit	brkkey  		;BREAK key pressed?
				bpl	get10.bb		;yes - bail out!
w20.bb:				ldx	nextin.bb  		;get pointer
w21.bb:				cpx	lastin.bb  		;buffer empty?
				beq	get.bb			 ;yes - loop back
w22.bb:				ldy	inbuff.bb,x 		;get byte
				inx				;bump pointer
w23.bb:				stx	nextin.bb  		;save it
w24.bb:				lda	trans.bb
				and	#$20			;ATASCII?
				bne	get10.bb		;yes - skip
				cpy	#$0d			;ASCII CR?
				bne	get10.bb		;no - skip
				ldy	#$9b			;make ATASCII EOL
get10.bb:			tya
				pha
w25.bb:				jsr	setbreak.bb
				pla
				cpy	#0
				rts
;
;	  "PUT BYTE, SET BREAK"
;
put.bb:				tay
w26.bb:				lda	trans.bb
				and	#$20			;ATASCII?
				bne	put03.bb		;yes - skip
				cpy	#$9b			;ATASCII EOL?
				bne	put03.bb		;no - skip
				ldy	#$0d			;else make CR
w27.bb:				jsr	put10.bb		;send it
w28.bb:				bit	trans.bb		;need LF?
				bvc	setbreak.bb 		;no - skip
				ldy	#$0a			;else send LF
put03.bb:			jsr	put10.bb		;send character
setbreak.bb:			ldy	#1			;assume OK
				bit	brkkey			;BREAK pressed?
				bmi	enirq.bb		;no - skip
				ldy	#$80			;else ERROR 128
				sty	brkkey			;reset BREAK flag
ENIRQ.bb:
				cpy	#0			;set exit flags
				sec				;yes we handled it
				rts
put10.bb:			ldx	lastout.bb		;get pointer
				inx
put11.bb:			bit	brkkey			;BREAK pressed?
				bpl	putexit.bb		;yes - bail out
w29.bb:				cpx	nextout.bb		;buffer full?
				beq	put11.bb		;yes - loop back
				sei
				tya
w30.bb:				sta	outbuff.bb,x		;put in buffer
w31.bb:				stx	lastout.bb		;save pointer
w32.bb:				jsr	entxirq.bb		;enable Tx IRQ
				cli
putexit.bb:			rts
;
;	  "OPEN, CLOSE R.bb: CHANNEL"
;
open.bb:			lda	icax1z			;get aux 1 byte
w33.bb:				sta	mode.bb			;save
				sei
				ldx	#5
				lda	#0			;zero out working
op01.bb:			sta	staterr.bb,x		; variables
				dex
				bpl	op01.bb
open03.bb:			lda	mode.bb
				sta	icax1z
w34.bb:				jmp	setbreak.bb
;
; CLOSE R: HANDLER CHANNEL
;
close.bb:			lda	#0			;end concurrent
w35.bb:				sta	concur.bb		;mode
xio32.bb:			jsr	forceout.bb		;send last bytes
w36.bb:				jmp	open03.bb
forceout.bb:			lda	lastout.bb		;get pointer
f01.bb:				bit	brkkey			;BREAK pressed?
				bpl	f02.bb			;yes - exit
w37.bb:				cmp	nextout.bb		;buffer empty?
				bne	f01.bb			;no - loop back
f02.bb:				rts				;exit
;
; "GET STATUS OF R: CHANNEL"
;
status.bb:			lda	$d1c0			;read H/S lines
				lsr
				lsr
				lsr
				lsr
				lsr
				and	#7			;get index into
				tax				; table
w38.bb:				lda	hsflags.bb,x
				sta	dvstat+1
w39.bb:				bit	concur.bb		;concurrent mode?
				bpl	stat02.bb		;no - skip
				sec
w40.bb:				lda	lastin.bb		;calc bytes in
w41.bb:				sbc	nextin.bb		;input buffer
				sta	dvstat+1
				sec
w42.bb:				lda	lastout.bb		;calc bytes in
w43.bb:				sbc	nextout.bb		;output buffer
				sta	dvstat+3
stat02.bb:			lda	staterr.bb		;status flags
				sta	dvstat			
				lda	#0			;clear flags
w44.bb:				sta	staterr.bb
				sta	dvstat+2
w45.bb:				jmp	setbreak.bb


HSFLAGS.bb:
				  dc.b $01,$31,$0d,$3d
				  dc.b $c1,$f1,$cd,$fd

;	  "XIO 40, 38, 36 CALLS"
;
special.bb:			ldx	iccomz			;get command
				lda	icax1z			;get aux 1
				cpx	#$28			;set concurrent?
				bne	xio38.bb		;no - try next
w46.bb:				lda	concur.bb		;set flag for
				ora	#$80			;concurrent mode
w47.bb:				sta	concur.bb		;operation
w48.bb:				jmp	open03.bb
xio38.bb:			cpx	#$26			;trans, parity?
				bne	xio36.bb		;no - try next
w49.bb:				sta	trans.bb		;save directly
				lsr
				lsr
				and	#3			;get parity bits
				tay
				lda	$d132
				and	#$1f
w50.bb:				ora	parity.bb,y
				sta	$d132
w51.bb:				jmp	open03.bb

parity.bb:			dc.b	0,$20,$60,$a0


xio36.bb:			cpx	#$24			;baud, word size?
				bne	xio34.bb		;no - try next
				tay				;temp save
				and	#$d0			;set word size,
				asl				;stop bits
				php
				asl
				plp
				ror
				pha				;temp save
				tya
				and	#$0f			;get baud rate
				beq	xio36c.bb		;index
				ldx	#8
				cmp	#5			;110 baud?
				beq	xio36a.bb		;yes - skip down
				sec				;otherwise -
				cmp	#8			;standard rates?
				bcc	err132.bb		;no - error out
				and	#7			;get index
xio36c.bb:			tax
xio36a.bb:			pla				;retrieve byte
w52.bb:				ora	baud.bb,x		;index baud table
				sta	$d133
xio36b.bb:			jmp	open03.bb
baud.bb:			dc.b	$16,$17,$18,$19
				dc.b	$1a,$1c,$1e,$1f,$13
;	  "ERROR 132
; 	XIO 34, 32"
err132.bb:			jsr	setbreak.bb
				tya
				bmi	er132a.bb
				ldy	#$84			;illegal XIO call
er132a.bb:			rts
xio34.bb:			cpx	#$22			;set H/S lines?
				bne	xio32a.bb		 ;no - skip
				tax
				bpl	xio34a.bb
				and	#$40			;set DTR
				asl
				asl
				php
				lda	$d132
				lsr
				plp
				rol
				sta	$d132
xio34a.bb:			txa
				and	#$30
				cmp	#$30			;set RTS true?
				beq	xio34d.bb		;yes - skip
				cmp	#$20			;set RTS false?
				beq	xio34c.bb		;yes - skip
				txa
				and	#3
				cmp	#3			;set xmit MARK?
				beq	xio34b.bb		;yes - skip
				cmp	#2			;set xmit SPACE?
				bne	w53.bb			;no - exit
xio34d.bb:			lda	#8
				dc.b	$2c			;implied 'BIT'
xio34b.bb:			lda	#$0c			;instructions -
				dc.b	$2c			;will not alter
xio34c.bb:			lda	#0			;accumulator data
				eor	$d132
				and	#$0c
				eor	$d132
				sta	$d132
w53.bb:				jmp	open03.bb
xio32a.bb:			cpx	#$20			;XIO 32?
				bne	err132.bb		;no - error out
w54.bb:				jmp	xio32.bb
inbuff.bb:			ds.b	256
outbuff.bb:			ds.b	256
;								
;  "RESET INITIALIZATION"
init.bb:			jsr	$ffff			;DOSINI vector
init02.bb:			lda	# low relocate.bb	;move MEMLO up to
				sta	memlo			;protect handler
h03.bb:				lda	# high relocate.bb
				sta	memlo+1
				ldx	#0
init03.bb:			lda	$031a,x			;find handler
				beq	sethand.bb		;end of HATABS
				cmp	#'R'			;$52	"R:"
				beq	set02.bb		;R: handler found
				inx
				inx
				inx
				bne	init03.bb
sethand.bb:			lda	#'R'			;$52
				sta	$031a,x
set02.bb:			lda	# low hatab.bb
				sta	$031b,x
h01.bb:				lda	# high hatab.bb
				sta	$031c,x
				lda	$0216			;patch into
w55.bb:				sta	sysirq.bb+1		;IRQ vector
				lda	$0216+1
w56.bb:				sta	sysirq.bb+2
				sei
l02.bb:				lda	# low irq.bb
				sta	$0216
h02.bb:				lda	# high irq.bb
				sta	$0216+1
				cli
				lda	$d132			;set DTR low
				and	#$fe
				sta	$d132
inout.bb:			rts
;
;	GENERIC RELOCATOR - written for use with other programs as well.
;
relocate.bb:
				jsr	set_handler		; register hyp_r with the os

				ldx	#0			;Just to make sure
rel01.bb:			lda	$031a,x			;we have room in
				beq	rel01a.bb		;the handler table
				inx
				inx
				inx
				cpx	#32+1
				bcc	rel01.bb

				jmp	no_instal_error		; nope out of here with an error
rel01a.bb:
				lda	pbi_device		; is there an BB?
				cmp	#$02			; 2 = yes
				beq	.a			; ok do the relocate
				jmp	no_instal_error		; nope out of here with an error
.a:
				lda	# low start.bb		;calculate
				sec				;offset for
				sbc	memlo			; relocation
				sta	offset.bb
				lda	# high start.bb
				sbc	memlo+1
				sta	offset.bb+1
				ldx	#0			;initialize for
				ldy	#0			; relocation loop
rel02.bb:			lda	tablo.bb,x
				sta	$e0
rel03.bb:			lda	tabhi.bb,x
				sta	$e2
				inx
rel04.bb:			lda	tablo.bb,x
				sta	$e1
rel05.bb:			lda	tabhi.bb,x
				sta	$e3
				ora	$e2			;end of table?
				beq	moveit.bb		;yes - drop down
				lda	($e0),y			;else - recalc
				sec				;address
				sbc	offset.bb
				sta	($e0),y
				lda	($e2),y
				sbc	offset.bb+1
				sta	($e2),y
				inx				;next address
				bne	rel02.bb		;no wrap - go back
				inc	rel02.bb+2		;else bump
				inc	rel03.bb+2		;addresses up
				inc	rel04.bb+2		;to next page
				inc	rel05.bb+2
				jmp	rel02.bb



; "MOVE CODE TO MEMLO"

moveit.bb:			lda	# low start.bb		;move handler
				sta	$e0			;to MEMLO
				lda	# high start.bb
				sta	$e1
				lda	memlo
				sta	$e2
				lda	memlo+1
				sta	$e3
				lda	# low relocate.bb-start.bb
				sta	$e4
				lda	# high relocate.bb-start.bb
				sta	$e5
move02.bb:			lda	($e0),y
				sta	($e2),y
				inc	$e0
				bne	move03.bb
				inc	$e1
move03.bb:			inc	$e2
				bne	move04.bb
				inc	$e3
move04.bb:			lda	$e4
				bne	move05.bb
				dec	$e5
move05.bb:			dec	$e4
				bne	move02.bb
				lda	$e5
				bne	move02.bb
relinit.bb:			lda	$0c			;DOSINI vector
m06.bb:				sta	init.bb+1		;patch point
				lda	$0d
m07.bb:				sta	init.bb+2
m08.bb:				lda	# low init.bb
				sta	$0c
m09.bb:				lda	# high init.bb
				sta	$0d
m10.bb:				jsr	init02.bb



prtmsg.bb:			jsr	prtmsg

				rts



offset.bb:			dc.w 0





; "RELOCATOR TABLE 1"
;
;Each TABLO entry MUST have a matching
;TABHI entry.  TABLO is for the low
;bytes to be offset, TABHI is for the
;high bytes.  TABHI MUST END WITH ZERO
;OR THE RELOCATOR WILL NOT KNOW WHEN
;TO STOP!
;
tablo.bb:			dc.w	m06.bb+1
				dc.w	m07.bb+1
				dc.w	m08.bb+1
				dc.w	m10.bb+1
				dc.w	hatab.bb
				dc.w	w01.bb
				dc.w	w02.bb
				dc.w	w03.bb
				dc.w	w04.bb
				dc.w	w05.bb
				dc.w	w06.bb+1
				dc.w	w07.bb+1
				dc.w	w08.bb+1
				dc.w	w09.bb+1
				dc.w	w10.bb+1
				dc.w	w11.bb+1
				dc.w	w12.bb+1
				dc.w	w13.bb+1
				dc.w	w14.bb+1
				dc.w	w15.bb+1
				dc.w	w17.bb+1
				dc.w	w18.bb+1
				dc.w	w19.bb+1
				dc.w	w20.bb+1
				dc.w	w21.bb+1
				dc.w	w22.bb+1
				dc.w	w23.bb+1
				dc.w	w24.bb+1
				dc.w	w25.bb+1
				dc.w	w26.bb+1
				dc.w	w27.bb+1
				dc.w	w28.bb+1
				dc.w	w29.bb+1
				dc.w	w30.bb+1
				dc.w	w31.bb+1
				dc.w	w32.bb+1
				dc.w	w33.bb+1
				dc.w	w34.bb+1
				dc.w	w35.bb+1
				dc.w	w36.bb+1
				dc.w	w37.bb+1
				dc.w	w38.bb+1
				dc.w	w39.bb+1
				dc.w	w40.bb+1
				dc.w	w41.bb+1
				dc.w	w42.bb+1
				dc.w	w43.bb+1
				dc.w	w44.bb+1
				dc.w	w45.bb+1
				dc.w	w46.bb+1
				dc.w	w47.bb+1
				dc.w	w48.bb+1
				dc.w	w49.bb+1
				dc.w	w50.bb+1
				dc.w	w51.bb+1
				dc.w	w52.bb+1
				dc.w	w53.bb+1
				dc.w	w54.bb+1
				dc.w	w55.bb+1
				dc.w	w56.bb+1
				dc.w	set02.bb+1
				dc.w	l02.bb+1
				dc.w	put03.bb+1
				dc.w	put10.bb+1
				dc.w	op01.bb+1
				dc.w	open03.bb+1
				dc.w	xio32.bb+1
				dc.w	init02.bb+1
				dc.w	forceout.bb+1
				dc.w	stat02.bb+1
				dc.w	xio36b.bb+1
				dc.w	err132.bb+1



; "RELOCATOR TABLE 2"
tabhi.bb:
				dc.w	m06.bb+2
				dc.w	m07.bb+2
				dc.w	m09.bb+1
				dc.w	m10.bb+2
				dc.w	hatab.bb+1
				dc.w	w01.bb+1
				dc.w	w02.bb+1
				dc.w	w03.bb+1
				dc.w	w04.bb+1
				dc.w	w05.bb+1
				dc.w	w06.bb+2
				dc.w	w07.bb+2
				dc.w	w08.bb+2
				dc.w	w09.bb+2
				dc.w	w10.bb+2
				dc.w	w11.bb+2
				dc.w	w12.bb+2
				dc.w	w13.bb+2
				dc.w	w14.bb+2
				dc.w	w15.bb+2
				dc.w	w17.bb+2
				dc.w	w18.bb+2
				dc.w	w19.bb+2
				dc.w	w20.bb+2
				dc.w	w21.bb+2
				dc.w	w22.bb+2
				dc.w	w23.bb+2
				dc.w	w24.bb+2
				dc.w	w25.bb+2
				dc.w	w26.bb+2
				dc.w	w27.bb+2
				dc.w	w28.bb+2
				dc.w	w29.bb+2
				dc.w	w30.bb+2
				dc.w	w31.bb+2
				dc.w	w32.bb+2
				dc.w	w33.bb+2
				dc.w	w34.bb+2
				dc.w	w35.bb+2
				dc.w	w36.bb+2
				dc.w	w37.bb+2
				dc.w	w38.bb+2
				dc.w	w39.bb+2
				dc.w	w40.bb+2
				dc.w	w41.bb+2
				dc.w	w42.bb+2
				dc.w	w43.bb+2
				dc.w	w44.bb+2
				dc.w	w45.bb+2
				dc.w	w46.bb+2
				dc.w	w47.bb+2
				dc.w	w48.bb+2
				dc.w	w49.bb+2
				dc.w	w50.bb+2
				dc.w	w51.bb+2
				dc.w	w52.bb+2
				dc.w	w53.bb+2
				dc.w	w54.bb+2
				dc.w	w55.bb+2
				dc.w	w56.bb+2
				dc.w	h01.bb+1
				dc.w	h02.bb+1
				dc.w	put03.bb+2
				dc.w	put10.bb+2
				dc.w	op01.bb+2
				dc.w	open03.bb+2
				dc.w	xio32.bb+2
				dc.w	h03.bb+1
				dc.w	forceout.bb+2
				dc.w	stat02.bb+2
				dc.w	xio36b.bb+2
				dc.w	err132.bb+2
				dc.w	0				 ;STOP HERE!
;



;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;   OS on and off ROUTEEN	      
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;

os_off:
				SEI	
				LDA	PORTB
				AND	#$FE
				STA	PORTB
				CLI	
				RTS	
;
os_on:
				SEI	
				LDA	PORTB
				ORA	#1
				STA	PORTB
				CLI	
				RTS	
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;checks user security level pointed to by S_PTR to see if the
;bit specified in the A register is ON.  Returns MInus if the
;user doesn't have the specified security level.
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

seclvl:	    			sty	.tempy
				stx	.tempx
				cmp	#0			;sec lvl of zero?
				beq	.passed			;yes..they have it
				tay				;-1 for shifting
				lda	#128
				sta	.temp			;initialize mask
				lda	#0
				sta	.temp+1
				sta	.temp+2
				sta	.temp+3
				dey
				beq	.mask			;if it was one, no need to shift
.shloop:	 	  	lsr	.temp			;shift bits down to form mask
				ror	.temp+1
				ror	.temp+2
				ror	.temp+3
				dey
				bne	.shloop
				ldy	#0
.mask:				lda	.temp,y			;now, AND off all the bits
				and	(s_ptr),y
				sta	.temp,y
				iny
				cpy	#4
				bne	.mask
.check:				lda	.temp			;next, OR all the bytes...if any one
				ora	.temp+1			; is > 0, then they passed (whew!)
				ora	.temp+2	
				ora	.temp+3
				cmp	#0
				beq	.failed
.passed:		   	lda	#0
				beq	.return
.failed:		   	lda	#$80
.return:		   	php
				ldy	.tempy
				ldx	.tempx
				plp
				rts

.tempy:	    			dc.b    0
.tempx:	    			dc.b    0
.temp:				dc.b    0,0,0,0


;     sets the bit specified (in the A register) of the security
;     level pointed to by S_PTR to a TRUE value.
;     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

setlvl:				sty	.tempy
				stx	.tempx
				cmp	#0			;sec lvl of zero?
				beq	.return			;yes..just exit (shouldn't happen!)
				tay				 ;-1 for shifting
				lda	#128
				sta	.temp			;initialize mask
				lda	#0
				sta	.temp+1
				sta	.temp+2
				sta	.temp+3
				dey
				beq	.mask			;if it was one, no need to shift
.shloop:		   	lsr	.temp			;shift bits down to form mask
				ror	.temp+1
				ror	.temp+2
				ror	.temp+3
				dey
				bne	.shloop
				ldy	#0
.mask:				lda	.temp,y			;now, OR the bit on
				ora	(s_ptr),y
				sta	(s_ptr),y
				iny
				cpy	#4
				bne	.mask
.return:		   	rts

.tempy:				dc.b    0
.tempx:				dc.b    0
.temp:				dc.b    0,0,0,0

;     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
set_handler:
				jsr	os_off
				mea	tsr,s_ptr
				lda	#hyp_r
				jsr	setlvl
				jsr	os_on
				rts



win_end:			ds.b	0
;
;
