;------------------------------------------------------------------------
;		Copyright 2010 Integrated Logic Systems
;                  Source Code is Copyright Stephen J. Carden
;
;
;			Please do not share this source!
;------------------------------------------------------------------------
;                              Peek.com
;
;	This is a program to peak a byte and display it to the screen
;		init	2/24/2010	sjc new design
;		added hex delimeter 		2/25/2010	sjc		
;		added new code for registered user 2/26/2010	sjc
;
;
;Also added code for Control+1 pause of screen to the high speed screen
;handling.		8/24/2012	sjc
; 
;
;
;Added code so this file cannot run on the AtariWin800 Emulator
;		8/24/2012	sjc
;
;
;       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;------------------------------------------------------------------------
; 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,"Shutdown.com",$9b
			.endm

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

file_compiler:		equ	xasm
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; is this relocatable code ?
; anyother value other than 1 or 2 would be unknown
r..yes:			equ	1
r..no:			equ	2
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Gotta define if it can be relocated
l_relocatable:		equ	r..yes
;
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; 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

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	#shutdown
			jsr	seclvl 			; call routing checking 
			bmi 	.aa
	 		jsr	printsi
			dc.b	$9b
			dc.b	" "
			dc.b	<+128>,"==>"
			dc.b	<+128>,"Shutdown 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	set_handler


         		lda 	memlo			; setting some stuff up for the relocator
         		sta 	segtab+dorgadr		; Passing Stuff to the relocator
         		sta 	segtab+blkdes		; Passing Stuff to the relocator
			sta	segtab+14
         		lda 	memlo+1			; setting some stuff up for the relocator
         		sta 	segtab+dorgadr+1	; Passing Stuff to the relocator
         		sta 	segtab+blkdes+1		; Passing Stuff to the relocator
			sta	segtab+15

			lda	#seg_on
			sta	segtab+16		; yes do a relocation

			jsr	rlocate

			lda 	$0222
w25:			sta 	brap+1
			lda 	$0222+1
w26:			sta 	brap+2
;
top1:
			ldy 	#63
mux_1a:			lda 	($0a),y
			cmp 	#$20
			beq 	mux_2a
			cmp 	#$9b
			beq 	mux_3a
			iny
			jmp 	mux_1a
mux_3a:
			jmp 	mux_3b
mux_2a:
			ldx 	#$00
			iny
mux_2b:			lda 	($0a),y
w27:			sta 	filename,x
			cmp 	#$9b
			beq 	mux_2c
			inx
			iny
			jmp 	mux_2b
mux_2c:
			lda 	#$9b
w28:			sta 	filename,x		; I need to find the end of the file with out extra bytes
			lda 	$0c
w29:			sta 	trap+1
			lda 	$0c+1
w30:			sta 	trap+2
w31:			jsr 	int_top
			rts

;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Ok the relocation marker is to tell the DOS we are now using
;more data at memlow..  
;
;
initz:

;
vbi_run:
			pha
			lda	$d010
			cmp	#0
			beq	fast_down
			pla
brap:
			jmp	$ffff
;
fast_down:
			lda	$d010
			cmp	#$00
w01:			beq	fast_down
			lda	#$01
w02:			sta	recurse
			ldx	#$10
w03:			jsr	close
			ldx	#$20
w04:			jsr	close
			ldx	#$30
w05:			jsr	close
			ldx	#$40
w06:			jsr	close
			ldx	#$50
w07:			jsr	close
			ldx	#$60
w08:			jsr	close
			ldx	#$70
w09:			jsr	close
			jmp	$e474
;
;
;
close:
			lda	#$0c
			sta 	$0342,x
			jsr 	$e456
			rts
;
;
;
;
int_top:
lb01:			lda 	# low vbi_run			;vbi_start
			sta 	$0222
hb01:			lda 	# high vbi_run			;vbi_start+1
			sta 	$0222+1

lb02:			lda 	# low zend			;end_of_file
			sta 	$02e7
hb02:			lda 	# high zend			;end_of_file+1
			sta 	$02e7+1

lb03:			lda 	# low trap			;v_trap
			sta 	$0c
hb03:			lda 	# high trap			;v_trap+1
			sta 	$0c+1
			rts
;
;
;-------------------------------
; STRING PROCESSOR
;-------------------------------
;
bat_load:
lb04:			lda 	# low filename			;in.fn_ptr
w10:			sta 	bl+1
hb04:			lda 	# high filename			;in.fn_ptr+1
w11:			sta 	bl+2
			ldy 	#63
w12:			jmp 	bl
;
bprsl:
			iny
w13:			inc 	bl+1
			bne 	bl
w14:			inc 	bl+2
bl:			lda 	$ffff
			sta 	($0a),y
			cmp 	#0
			beq 	bestri
w15:			jmp 	bprsl
bestri:
			rts
;
;------------------------------------------------
; spartados run vector
;
;After a srting has been copied into dos's buffer
;This will execute it just like you typed it in!
;
;------------------------------------------------
;
line_process:
			lda 	#$00
			ldy 	#10
			sta 	($0a),y
			lda 	$d301
			pha
			and 	#$fe
			sta 	$d301
			jsr 	$ffd2
			pla
			sta 	$d301
			rts
;
;------------------------------
;
;------------------------------
trap:
w16:			jsr 	trap
w17:			lda 	recurse
			cmp 	#$01
			beq 	tp_1
			lda 	$d01f
			cmp 	#3
			bne 	tp_1
w18:			jmp 	fast_down
tp_1:
w19:			jsr 	int_top
w20:			lda 	recurse
			cmp 	#$01
			beq 	trap1
			lda 	#$00
w21:			sta 	recurse
			rts
trap1:
			lda 	#$00
w22:			sta 	recurse
w23:			jsr 	bat_load
w24:			jmp 	line_process
;
;
;
;
recurse:		dc.b 	0
filename:		ds.b	40


zend:			ds.b 	0			
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
;                        *** END OF HANDLER ***
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
;	The rest of this relocator Crap Took me a week to figure out!!
;
;       Relocater: main entry
;       ---------------------
; in:
;       segtab  = table of segment descriptors
;               +00 = relocater table address
;               +02 = originate address of block
;               +04 = destination originate of block
;               +06 = address of block
;               +08 = number of bytes in block
;               +10 = destination address of block
;		+12 = Length of segment descriptor
;		+14 = this is the word location addjust memory
;		+16 = -1 means do not mem move
;
;
;
;
;       reltab  = relocater table
;               list of address of words to adjust      2 bytes each entry
;               list of address low bytes to adjust     2 bytes each entry
;               list of address high bytes to adjust    3 bytes each entry
;                       followed by their low bytes
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
rlocate:

			lda	segtab+segaddress	; setting some stuff up for the relocator
			sta	segtab+dorgadr		; Passing Stuff to the relocator
			sta	segtab+blkdes		; Passing Stuff to the relocator
			lda	segtab+segaddress+1	; setting some stuff up for the relocator
			sta	segtab+dorgadr+1	; Passing Stuff to the relocator
			sta	segtab+blkdes+1		; Passing Stuff to the relocator


			lda	#0			; set ptr to segment 0
			sta	segment

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

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

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

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

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

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

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

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

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

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

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

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


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

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

segment:		dc.b	0			; current segment
zoffset:		dc.w	0			; offset to add to addresses
;


;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
;		       Relocation data table
;       	       ---------------------
;		We resolve Word locations First!
;
;	Things like	Lda $5000
;			Sta $5000
;			lda $5000,y
;			jsr $5000
;			jmp $5000
;
;	Well you get the Idea..
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
;
rtable:
			dc.w	w01+1
			dc.w	w02+1
			dc.w	w03+1
			dc.w	w04+1
			dc.w	w05+1
			dc.w	w06+1
			dc.w	w07+1
			dc.w	w08+1
			dc.w	w09+1

			dc.w	w10
			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	0			; ok done with the words

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
;Ok these are low Byte Locations..  only one byte changed!!
;   OK Resolving Low Byte's First
;
			dc.w	lb01+1
			dc.w	lb02+1
			dc.w	lb03+1
			dc.w	lb04+1
			dc.w	0			; ok done with this part


			dc.w	hb01+1
			dc.b	vbi_run

        		dc.w	Hb02+1
			dc.b	zend

			dc.w	hb03+1
			dc.b	trap

			dc.w	hb04+1
			dc.b	filename

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


;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

;End of relocation Table!!!
;master table:
;
segtab:
			dc.w	rtable			; address of relocater table
			dc.w	initz			; assembly start address
			dc.w	0			; relocate to address (filled in)
			dc.w	initz			; absolute start address of block
			dc.w	zend-initz		; size of block
			dc.w	0			; destination of block (filled in)
			dc.w	0			; END of segments
			dc.w	$3000			; segaddress memory to adgust by. Poke 
							; in memlow or the location in 
							; memory you want it
			dc.b	seg_off			; -1 meand do not mem move





;---------------------------	
;   jsr  printsi		
;this prints an inline string	
;     terminated by $ff  	
;---------------------------	
;        jsr   prints
;       .BYTE "print this",$9B,$FF
echosi:
printsi:		pla
			sta 	pstr+1
			pla
			sta 	pstr+2
prsl:			inc 	pstr+1
			bne 	pstr
			inc 	pstr+2
pstr:			lda 	$ffff
			cmp 	#$ff
			beq 	estri
			jsr 	fast_output
			jmp 	prsl
estri:			lda 	pstr+2
			pha
			lda 	pstr+1
			pha
			rts
;
;-------------------------	
;actual screen handler    	
;screen offset definitions 
;------------------------- 
scr_offset:		dc.w	0
			dc.w 	40
			dc.w 	80
			dc.w 	120
			dc.w 	160
			dc.w 	200
			dc.w 	240
			dc.w 	280
			dc.w 	320
			dc.w 	360
			dc.w 	400
			dc.w 	440
			dc.w 	480
			dc.w 	520
			dc.w 	560
			dc.w 	600
			dc.w 	640
			dc.w 	680
			dc.w 	720
			dc.w 	760
			dc.w 	800
			dc.w 	840
			dc.w 	880
			dc.w 	920
;
fast_output:
			sta	$5a
			lda	sc.redirect
			cmp	#print_p
			beq	.go_cio
.leo:
			lda 	$02ff   	; CONTROL 1 FLAG
			cmp 	#$00
			bne 	.leo

			lda	$5a
			cmp	#32
			bcc	.do_look
			cmp	#125
			bcc	.do_here
.do_look:		ldy	#0
.lookup:		lda	.char_table,y
			beq	.do_here
			cmp	$5a
			beq	.go_cio
			iny
			bne	.lookup


.go_cio:		lda	$5a
			jmp	putlocal


.do_here:		ldy	#0
			lda	$5d
			sta	($5e),y
			lda	$5a
			cmp	#$9b
			beq	.docr
.notcr:			jsr	.get_adr
			lda	$5a
			and	#$7f
			cmp	#32
			bcc	.add64
			cmp	#96
			bcc	.sub32
			jmp	.asis
.add64:			clc
			adc	#64
			jmp	.asis
.sub32:			sec
			sbc	#32
.asis:			bit	$5a
			bpl	.xxlate
			ora	#$80
.xxlate:		ldy	#0
			sta	($5e),y
			inc	$55
			inc	$63
			lda	$55
			cmp	#40
			bcs	.next_row
			iny
			lda	($5e),y
			sta	$5d
			ora	#$80
			ldx	752
			bne	.nocurs1
			sta	($5e),y
.nocurs1:		inc	$5e
			bne	.nooav
			inc	$5e+1
.nooav:			rts
.docr:			lda	#0
			sta	$63
.next_row:		lda	$52
			sta	$55
			inc	$54
			ldy	$54
			cpy	#24
			bcs	.scroll
			jsr	.get_adr
			ldy	#0
			lda	($5e),y
			sta	$5d
			ldx	752
			bne	.nocurs2
			ora	#$80
			sta	($5e),y
.nocurs2:		rts

.scroll:		dec	$54
			lda	$58
			sta	$68
			clc
			adc	#40
			sta	$5e
			lda	$58+1
			sta	$68+1
			adc	#0
			sta	$5e+1
			ldy	#0
			ldx	#3
.scloop:		lda	($5e),y
			sta	($68),y
			iny
			bne	.scloop
			inc	$5e+1
			inc	$68+1
			dex
			bne	.scloop
.scloop2:		lda	($5e),y
			sta	($68),y
			iny
			cpy	#152
			bcc	.scloop2
			lda	$58
			clc
			adc	#920&$ff
			sta	$5e
			lda	$58+1
			adc	#920/256
			sta	$5e+1
			ldy	#0
			tya
.clear:			sta	($5e),y
			iny
			cpy	#40
			bcc	.clear
			ldx	752
			bne	.nocurs3
			lda	#$80
			ldy	$55
			sta	($5e),y
.nocurs3:		lda	#0
			sta	$5d
			lda	$5e
			clc
			adc	$55
			sta	$5e
			lda	$5e+1
			adc	#0
			sta	$5e+1
			rts
.get_adr:		lda	$54
			asl
			tay
			lda	$58
			clc
			adc	scr_offset,y
			sta	$5e
			lda	$58+1
			adc	scr_offset+1,y
			sta	$5e+1
			lda	$5e
			clc
			adc	$55
			sta	$5e
			lda	$5e+1
			adc	#0
			sta	$5e+1
			rts
.char_table:
			dc.b	27,28,29,30,31,125,126,127
			dc.b	156,157,158,159,253,254,255,0


putlocal:		ldx	#11
			stx	$0342
			ldx	#0
			stx	$0348
			stx	$0349
			jmp	$e456
;



;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;   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	#shutdown
			jsr	setlvl
			jsr	os_on
			rts


;
mux_3b:
			jsr 	printsi
			dc.b 	$7d,$9b,$9b,$9b
			dc.b 	" File Function Aborted",$9B,$9B
			dc.b 	" Syntax error!",$9B
			dc.b 	" usage = dx:>path>shutdown parm",$9B
			dc.b 	" parm = dn:>path>filename.ext",$9B,$9B,$FF
			rts
;
;
win_end:		ds.b	0
;
;