print	nomdir
		pagesize 70

debug_on	equ	$00	;$01 = debug code installed

		entry	draw_express

;==================================================================================================
;ExpressLoad:	This program is designed to load and relocate GS applications very fast.
;		It is intended to compliment the System Loader; not replace it.
;
;Create:	Sept. 30, 1988
;Modified:	Apr. 23, 1990
;Author:	Rob Turner
;
;Copyright Apple Computer Inc. 1988,1989,1990 All Rights Reserved
;
;Before you get started grab the ERS which has pictures of the data structures.
;
;
;Version 1.0
;		First version to go on a system disk.
;
;Version 1.0 a01 01/10/89 by Rob Turner
;
;		Fixed a bug in the initial load routine.  The routine was not storing
;		the special_memory flag.  I also added the ability to load the stack
;		and direct page segments regardless of the attr_no_spec flag.
;	
;Version 1.0 a02 01/11/89 by Rob Turner
;
;		Speeded up reloading of restart segmments by leaving the file open
;		while processing each segment.  I also reversered the order of loading
;		restart and init segments.
;
;Version 1.0 a03 01/12/89 by Rob Turner
;
;		Changed all the main routines to return to the caller with an error
;		if an error occurs after I have determined that the file is an ExpressLoad file.
;
;Version 1.0 a04 01/16/89 by Rob Turner
;
;		Major changes have occurred.  ExpressLoad now leaves a load file open if the
;		file contains any Dynamic Segments.  The file will be closed when the shutdown
;		down call is made.  The ProcessSegment routine was optimized, and in doing so I 
;		changed the data bank register to point to the relocation dicationary and NOT
;		my program bank. This means that I must be very careful accessing data in my bank.
;		I seperated the code that has the data bank register set to the relocation
;		dictionary.  The code is now in "ProcRelocDataBankChanged"
;
;Version 1.0 a05 01/17/89 by Rob Turner
;
;		ExpressLoad now gets called directly instead of using the notification queue.
;		Cheryl (GQuit) will call me with three different types of events.
;		(0) = Startup. (4) = Switch P8 to GS/OS (2) = Switch GS/OS to P8
;
;Version 1.0 a06 01/17/89 by Rob Turner
;
;		Fixed a bug in Restart.  If the app could not be restarted I was using ExpressHandle
;		when it was not valid.  This caused the open routine to fail since I thing that
;		there is a valid reference number.
;
;Version 1.0 a07 01/18/89 by Rob Turner
;
;		Fixed a bug in restart.  I was deleting a user_id then using it to allocate memory.
;
;Version 1.0 a08 01/22/89 by Rob Turner
;
;		Changed the initial load routine.  I now load the static segments in the order
;		they appear in the file instead of loading the stack segment first.  I also
;		maintain my own file mark so I do not have to make extra GS/OS calls.
;
;Version 1.0 a09 01/25/89 by Rob Turner
;
;		Changed the load static routine so it will not use the stack as the first
;		code segment.
;
;Version 1.0 a0A 02/20/89 by Rob Turner
;
;		I now unlock the ExpressHandle Segment on Exit. 
;
;Version 1.0 a0B 02/21/89 by Rob Turner
;
;		Fixed a bug in Unload2 routine.  If the address passed in is in a jump table
;		segment the Unload routine has to do a level of indirection to get the
;		real address to unload.  The old routine was just unloading the jump table segment
;		without doing the indirection.
;
;Version 1.0 a0C 02/21/89 by Rob Turner
;
;		Fixed a bug in Unload2 routine.  The return parameters were not correct if the
;		segment was not loaded.
;
;Version 1.0 a0D 02/23/89 by Rob Turner
;
;		Fixed a bug in Load_seg_by_num.  The routine was not converting the 
;		original segment number to the new segment number.
;
;Version 1.0 a0E 02/23/89 by Rob Turner
;
;		Changed the inital load routines so they only leave the load file open
;		if the file has a type of Application and contain dynamic segments.
;
;Version 1.0 a0F 02/27/89 by Rob Turner
;
;		Added ExpressLoad to boot screen.
;
;Version 1.0 a10 03/01/89 by Rob Turner
;
;		I now unlock the 2K User_ID_Table.  I was leaving the handle locked.
;
;Version 1.0 b01 03/06/89 by Rob Turner
;
;		Fixed a bug in Unload_Seg1.  The routine was not converting the 
;		original segment number to the new segment number.
;
;Version 1.0 b02 03/06/89 by Rob Turner
;
;		Changed the startup routine to allocate my direct page with my ID
;		instead of a GS/OS ID.
;
;Version 1.0 b03 03/08/89 by Rob Turner
;
;		Fixed the locked handle bug.  I was saving a handles attributes even
;		though the handle was not valid.  I then allocated the handle and
;		slammed the old attributes into it.
;
;Version 1.0 b04 03/21/89 by Rob Turner
;
;		Init segments are now ran in the order that they appear in the file.
;
;Version 1.0 b05 03/27/89 by Rob Turner
;
;		Added conditional to ExpressLoad boot screen.  If the user holds down
;		the Apple and Option key during boot then the ExpressLoad logo will be
;		drawn. I will also draw the logo if the Aux type for ExpressLoad is set
;		to $5254 i.e. 'RT'.
;
;Version 1.0 b06 03/31/89 by Rob Turner
;
;		Fixed a bug in LoadSegByName and UnloadSeg.  The routines were not returning
;		the correct segment numbers when a user made the call.
;
;Version 1.0 b07 04/4/89 by Rob Turner
;
;		Fixed a bug in UnloadSeg1.  I was not purging all dynamic segments if the
;		segment number was zero.
;
;Version 1.0 b08 04/6/89 by Rob Turner
;
;		Fixed several bugs in allocating special memory segments.  These include bank 
;		aligned and fixed address within a bank.
;
;Version 1.0 b09 04/24/89 by Rob Turner
;
;		Fixed two bugs.  The first bug occured when the user made a load_seg_by_name call.
;		The call would return the address of the last loaded segment.  Therefore, it was
;		possible to get the wrong address returned.  The second bug involved returned
;		segment numbers.  ExpressLoad was not converting output segment number when
;		returning them to the caller.  If the caller did a load_seg_by_name, then used the
;		returned segment number to issue a load_seg_by_num call it would fail.
;
;Version 1.0 b0A 04/24/89 by Rob Turner
;
;		Fixed a bug in all routines that have a user id as input.  ExpressLoad
;		could fail if the user_id was zero (indicating that ExpressLoad should
;		use the current ID).  If the file was not loaded by ExpressLoad the call
;		would fail.
;
;Version 1.0 b0B 04/26/89 by Rob Turner
;
;		Removed segment type check when loading the ExpressLoad segment.
;		I now look for the name only.  The name can be either, "ExpressLoad"
;		or "~ExpressLoad".
;
;Version 1.0 b0C 05/09/89 by Rob Turner
;
;		Changed "Check_express_seg" to check for a read failure.
;
;Version 1.0 b0D 05/12/89 by Rob Turner
;
;		ExpressLoad now supports renaming of loaded files.  The loader call
;		number is $1311.
;
;Version 1.0 b0E 05/18/89 by Rob Turner
;
;		ExpressLoad now supports renaming of ExpressLoad pathnames. ExpressLoad was
;		only renaming pathnames that contained the Application.
;
;Version 1.0 b0F 05/19/89 by Rob Turner
;
;		ExpressLoad now supports a relocation dictionary of zero length.  LinkIIGS
;		is creating a file mark for a zero length relocation dictionary, so I had
;		to modify the loader to handle it.
;
;Version 1.0 b10 05/23/89 by Rob Turner
;
;		ExpressLoad now returns "seg_not_found" if the caller passes in the
;		wrong pathname.
;
;Version 1.0 b11 05/24/89 by Rob Turner
;
;		ExpressLoad was using a buffer that was too small by two bytes.
;
;Version 1.0 b12 06/01/89 by Rob Turner
;
;		Added calls to lock and unlock handles around OS calls. I also
;		zero local handles when Dispose_handle is called.
;
;Version 1.02    06/11/89 by Rob Turner
;
;		Fixed a bug in Restart.  Restart could fail if the Application
;		was launched off another volume (with a shorter name) and later,
;		could not be restarted due to segments being purged.  The problem
;		was, merge_path was not setting up partial_offset, this caused
;		the pathname to be screwed up in the ExpressSegment on the rebuild.
;
;Version 1.03    06/14/89 by Rob Turner
;
;		Fixed a non-derefed pointer bug.  One of the handles was left out
;		of the Lock_Handles routine, causing bad things to happen under
;		scrambler.
;
;Version 1.04    06/16/89 by Rob Turner
;
;		Fixed a bug when calling INIT segments.  I was calling lock_handles
;		when the direct register was already set to $0000 for the init segment.
;		This caused many problems. I also, now restore the bank register when
;		returning from the init segment.
;
;Version 1.05	04/23/90 by Greg Branche
;
;		Unloading a dynamic segment by address is not working reliably.  When the address
;		of a procedure within a dynamic segment is passed which hasn't been used yet,
;		ExpressLoad looks at it's jump table segment and assumes that, since the referenced
;		entry hasn't been patched yet, it can't have been loaded yet.   This is being
;		corrected by having ExpressLoad always attempt to mark the dynamic segment as
;		purgeable, whether it's in memory or not.  Since it ignores a "Segment Not Found"
;		error returned by Make_Purgeable, this shouldn't cause any problems.  Procedure
;		affected = L_unload2.  Change marked by {gab - 04/23/90}
;
;Version 1.06	05/07/91 by Greg Branche
;		InitialLoad was trashing the first byte of the input pathname if it
;		  encountered a Bad Path Syntax error from GS/OS.  Fixed.
;		Restart would fail to restore the system preferences if it failed.  Fixed.
;		When loading Initalization segments, Expressload now tries to stay out of
;		  special memory.  Only if we can't get non-special memory for the segment
;		  will special memory be used, unless the segment attributes prevent it.
;		During Restart, special memory is not used unless there isn't enough
;		  non-special memory available.
;		During InitialLoad, Expressload now checks the EOF of the load file and
;		  returns a NotLoadFile error if the EOF is 0.
;		When loading a dynamic segment, Expressload no longer ORA's a #$1100 into
;		  any error code returned from other parts of the system prior to going
;		  to system death.
;
;  06/05/91	Extra PHA instruction was left in the error_routine subroutine, which was
;		  messing up the message displayed by the SysFailMgr.
;		alloc_ExpLoad is returning the application userID as an error code when
;		  an error occurs.  This has been fixed.
;		close_load_file no longer restores the system preferences, since
;		  open_load_file already does that after the file is opened up.
;		l_user_shutdown now locks the user_id_tbl memory block containing the
;		  user ID entry for the load file being shutdown prior to deleting the
;		  entry from the table.  The block is then unlocked again prior to exit.
;
;  06/17/91	Added logic to set and restore the proper GS/OS system preferences while
;		  loading a dynamic segment.
;
;  06/21/91	Fixed load_segment so that non-special memory is ALWAYS requested first.
;		  Only if we can't get non-special memory for the segment, AND the segment
;		  attributes allow it will we try again, allowing special memory to be
;		  used.
;		Fixed alloc_lconst_seg so that my handles are not locked and unlocked
;		  everytime a memory manager call is made in the loop that tries to
;		  allocate a bank-aligned block of memory.
;		Fixed alloc_lconst_seg so that when the bank number to allocate reaches
;		  $80, the subroutine exits with a Memory Full error (used to loop
;		  until the bank value reached $FF.)
;
;  07/09/91	Added file type $C7 (CDev) to list of allowable load files.
;		Fixed InitialLoad2 so that it disposes of any memory used by a partially
;		  loaded file when an error occurs.
;		Fixed handling of no-special memory allocation so that fixed-bank segments
;		  are allowed to use special memory.
;		Changed allocation of bank-aligned segments so that it should be quicker
;		  and memory won't get purged quite so often.  Now, alloc_LConst_seg
;		  tries to allocate an entire bank of memory, then disposes of it again,
;		  then uses the allocated bank number to allocate memory for the
;		  loaded segment.
;
;==================================================================================================
;Revisions

		Eject
ExpressLoad	proc	Export
		import	Switch_handler
		import	do_save_AXY
		
		jmp	Switch_handler
		export	Save_AXY
save_AXY	jmp	do_save_AXY

		string	pascal
		dc.b	'ExpressLoad Ver 1.06 Designed and Written by Rob Turner'
		string	asis
		endp

		print	push
		print	off
		INCLUDE 'M16.Util'
		INCLUDE 'M16.MEMORY'
		INCLUDE	'ExpressLoad.Macros'
		print	pop
		eject
		include	'ExpressLoad.Data'

		eject
;====================================================================================================
;seg_num_lookup:	This routine will take a segment number and convert the number
;			to the correct segment number via the segment conversion table
;
;Input:         A = original segment number
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;		HET_ptr		;must point to seg_num_count
;
;Output:        A = new segment number
;               X = preserved
;               Y = preserved
;               P = nvmxdizc
;                   ..000..1=error
;               b = k
;
;
;
;====================================================================================================
	
		longa	on
		longi	on		
seg_num_lookup	proc
		with	data
		tax
		beq	@bad_seg_num		;sorry bud
		dec	a			;make zero based
		cmp	[HET_ptr]		;is it in the range?
		beq	@num_OK
		bcs	@bad_seg_num		;sorry the segment number is no good
@num_OK
		clc
		lda	[HET_ptr]		;get the number of segments please
		inc	a			;add one for 0 based stuff
		asl	a
		asl	a
		asl	a			;times 8 to pass Header Entry table
		adc	#$0002			;pass the count please

;		clc

		adc	HET_ptr			;add current position
		sta	temp_ptr
		lda	#$0000
		adc	HET_ptr+2
		sta	temp_ptr+2		;Temp pointer now points to the segment conv tbl
		
		dex				;subtract one for zero based please
		txa				;Times two for word table
		asl	a
		tay				;index to the real segment number
		lda	[temp_ptr],y
		clc
		rts				;return with the new segment number in "A"

@bad_seg_num
		lda	#seg_not_found
		sec
		rts				;return the "Error"
		endp

		eject
;====================================================================================================
;my_seg_to_user_seg:	This routine will take my segment number and convert the number
;			to the correct segment number via the segment conversion table.
;			This means if you use the segment number returned to you as input
;			to another loader call then everything will workout OK.
;
;Input:         A = internal segment number
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;		HET_ptr		;must point to seg_num_count
;
;Output:        A = new segment number for user
;               X = preserved
;               Y = preserved
;               P = nvmxdizc
;                   ..000..1=error
;               b = k
;
;
;
;====================================================================================================
	
		longa	on
		longi	on		
my_seg_to_user_seg	proc
		with	data
		pha				;segment we need to find

		clc
		lda	[HET_ptr]		;get the number of segments please
		inc	a			;add one for 0 based stuff
		asl	a
		asl	a
		asl	a			;times 8 to pass Header Entry table
		adc	#$0002			;pass the count please

;		clc

		adc	HET_ptr			;add current position
		sta	temp_ptr
		lda	#$0000
		adc	HET_ptr+2
		sta	temp_ptr+2		;Temp pointer now points to the segment conv tbl

		ldy	#$0000
@look_loop		
		lda	[temp_ptr],y
		cmp	1,s			;is this the correct segment number
		beq	@have_segment
		iny
		iny
		bne	@look_loop

		pla
		lda	#seg_not_found
		sec
		rts				;return the "Error"
		
@have_segment	pla				;stack fix
		tya				;convert index to segment number
		lsr	a
		inc	a			;add one to convert from 0 to 1 based
		clc
		rts
		endp
		
		eject
;====================================================================================================
;reset_local_mark:	This routine will reset our local mark to $FFFFFF.
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;Output:        A = preserved
;               X = preserved
;               Y = preserved
;               P = preserved
;               b = k
;
;
;
;====================================================================================================
	
		longa	on
		longi	on		
reset_local_mark	proc
		with	data
		lda	#$FFFF
		sta	local_mark
		sta	local_mark+2
		rts
		endp
		
		eject
;====================================================================================================
;lock_handles	This routine will save and lock handles used by ExpressLoad
;unlock_handles	This routine will restore the previous state of the now locked handle
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;Output:        A = preserved
;               X = preserved
;               Y = preserved
;               P = preserved
;               b = k
;
;
;
;====================================================================================================
	
		longa	on
		longi	on		
lock_handles	proc
		with	data
		php				;save all registers!
		pha
		phx
		phy
				
		ldy	#$0004			;lets lock this puppy
		lda	ExpressHandle
		ora	ExpressHandle+2
		beq	@skip_express

		lda	[ExpressHandle],y
		sta	ExpressHndl_flag
		ora	#$8000			;lock the handle
		sta	[ExpressHandle],y
		
@skip_express
		lda	user_id_handle		;lock ID table down
		ora	user_id_handle+2
		beq	@skip_ids
		
		lda	[user_id_handle],y
		sta	User_ID_flag
		ora	#$8000			;lock the handle
		sta	[user_id_handle],y
@skip_ids
		lda	temp_handle
		ora	temp_handle+2
		beq	@skip_temp
		
		lda	[temp_handle],y
		sta	tempHndl_flag
		ora	#$8000			;lock the handle
		sta	[temp_handle],y
@skip_temp
		lda	reloc_handle
		ora	reloc_handle+2
		beq	@skip_reloc
		
		lda	[reloc_handle],y
		sta	relocHndl_flag
		ora	#$8000			;lock the handle
		sta	[reloc_handle],y
@skip_reloc
		lda	seg_handle
		ora	seg_handle+2
		beq	@skip_seg
		
		lda	[seg_handle],y
		sta	segHndl_flag
		ora	#$8000			;lock the handle
		sta	[seg_handle],y
@skip_seg
		lda	curr_id_handle
		ora	curr_id_handle+2
		beq	@skip_id
		
		lda	[curr_id_handle],y
		sta	idHndl_flag
		ora	#$8000			;lock the handle
		sta	[curr_id_handle],y
@skip_id
		bra	end_handles
		
		export	unlock_handles
unlock_handles	
		php				;save all registers!
		pha
		phx
		phy

		
		ldy	#$0004			;lets lock this puppy
		lda	ExpressHandle
		ora	ExpressHandle+2
		beq	@skip_express

		lda	ExpressHndl_flag	;restore old state
		sta	[ExpressHandle],y
@skip_express
		lda	temp_handle
		ora	temp_handle+2
		beq	@skip_temp
		
		lda	tempHndl_flag		;restore original state
		sta	[temp_handle],y
@skip_temp
		lda	user_id_handle		;lock ID table down
		ora	user_id_handle+2
		beq	@skip_ids
		
		lda	User_ID_flag
		sta	[user_id_handle],y
@skip_ids
		lda	reloc_handle
		ora	reloc_handle+2
		beq	@skip_reloc
		
		lda	relocHndl_flag		;restore orig state
		sta	[reloc_handle],y
@skip_reloc
		lda	seg_handle
		ora	seg_handle+2
		beq	@skip_seg
		
		lda	segHndl_flag		;do the restore
		sta	[seg_handle],y
@skip_seg
		lda	curr_id_handle
		ora	curr_id_handle+2
		beq	@skip_id
		
		lda	idHndl_flag		;do the restore
		sta	[curr_id_handle],y
@skip_id
end_handles
		ply
		plx
		pla
		plp				;restore original registers
		rts
		
		
ExpressHndl_flag	dc.w	00
tempHndl_flag		dc.w	00
relocHndl_flag		dc.w	00
segHndl_flag		dc.w	00
idHndl_flag		dc.w	00
user_id_flag		dc.w	00

		endp
		
		eject
;====================================================================================================
;clear_handles:	This routine will zero any local handles that contain a copy of the
;		handle that we are disposing
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;		stack:
;
;			Y register		$1,s
;			X register		$3,s
;			Accum			$5,s
;			processor_status	$7,s
;			return address		$8,s
;			low word of handle	$A,s
;			high word of handle	$C,s
;
;Output:        A = restored
;               X = restored
;               Y = restored
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;
;====================================================================================================
clear_handles	proc
		php
		pha
		phx
		phy

		lda	$0A,s			;get the low word of the handle
		tax
		lda	$0C,s			;get the high word of the handle
		
		cmp	ExpressHandle+2
		bne	@skip_express		;Does Express = Dispose Handle?
		cpx	ExpressHandle
		bne	@skip_express

		stz	ExpressHandle		;zero matching handle
		stz	ExpressHandle+2

@skip_express
		cmp	temp_handle
		bne	@skip_temp
		cpx	temp_handle+2
		bne	@skip_temp
		
		stz	temp_handle
		stz	temp_handle+2
		
@skip_temp
		cmp	reloc_handle
		bne	@skip_reloc
		cpx	reloc_handle+2
		bne	@skip_reloc
		
		stz	reloc_handle
		stz	reloc_handle+2
		
@skip_reloc
		cmp	seg_handle
		bne	@skip_seg
		cpx	seg_handle+2
		bne	@skip_seg
		
		stz	seg_handle
		stz	seg_handle+2
		
@skip_seg
		cmp	curr_id_handle
		bne	@skip_id
		cpx	curr_id_handle+2
		bne	@skip_id
		
		stz	curr_id_handle
		stz	curr_id_handle+2
@skip_id
		ply
		plx
		pla
		plp
		rts	
		endp
		
		eject
;====================================================================================================
;Error_routine:	This routine will call the death manager with an error code.  The routine will not
;		return to the caller.  The routine is called with a JSR so I can display the
;		address if I want to.
;
;Input:         A = error_code
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;
;====================================================================================================
	
		longa	on
		longi	on		
error_routine	proc
		with	data
		pha				;push the error code
		pea	err_string>>16
		pea	err_string
		ldx	#$1503			;call the death manager
		jsl	$e10000
		brk	$ff

		string	pascal
err_string	dc.b	'ExpressLoad error: '
		string	asis
		endp

		
		eject
;====================================================================================================
;make_HET_ptr:	This routine builds a pointer to the Header Entry Table
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;		ExpressHandle			;must be setup
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;		HET_ptr will point to the segment count field in the Header Entry Table (HET) 
;		temp_ptr will point to the link field (HET_ptr-4)
;
;====================================================================================================
	
		longa	on
		longi	on		
make_HET_ptr	proc
		with	data
;
;Setup temp_ptr to point to the reserved field (of Disk Image) of the HET
;
		ldy	#$0002
		clc
		lda	[ExpressHandle]
		adc	#extra_header		;load ExpressSegment past Extra Header
		tax
		sta	temp_ptr		;temp now points the link field
		lda	[ExpressHandle],y
		adc	#$0000
		tay
		sta	temp_ptr+2
;
;Now set HET_ptr to point past the reserved field of the disk image
;
		clc
		txa
		adc	#$0004			;pass the reserved field
		sta	HET_ptr			;header entry table pointer
		tya
		adc	#$0000
		sta	HET_ptr+2

		rts
		endp
		
		eject
;====================================================================================================
;setup_seg_ptrs:	This routine builds pointers to the segment header entry and the segment
;
;Input:         A = segment number
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;		HET_entry_ptr
;		seg_header_ptr
;
;====================================================================================================
	
		longa	on
		longi	on		
setup_seg_ptrs	proc
		with	data

		dec	a			;convert the segment number please
		sec
		sbc	ExpressSeg_pos		;0 or 1
		
		asl	a
		asl	a
		asl	a			;times 8 for HET entry size
		
		inc	a			;add two to pass the segment count field
		inc	a

		clc
		adc	HET_ptr			;make a pointer to the Entry
		sta	HET_Entry_ptr		;pointer to the entry itself
		lda	#$0000
		adc	HET_ptr+2
		sta	HET_Entry_ptr+2		
;
;Build a pointer to the segment header itself
;
		clc
		lda	HET_entry_ptr		;add in relative address to segment
		adc	[HET_Entry_ptr]
		sta	seg_header_ptr
		lda	HET_Entry_ptr+2
		adc	#$0000
		sta	seg_header_ptr+2
		rts
		endp
		
		eject
;====================================================================================================
;setup_base_ptr:	This routine setups the pointer to the base address of the segment
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;		Het_Entry_pointer		;must be setup
;		seg_header_ptr
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;		base_ptr
;		segment_entry
;====================================================================================================
	
		longa	on
		longi	on		
setup_base_ptr	proc
		with	data
		import	add_segment_offset
		
		ldy	#handle_offset		;setup the Base_ptr
		lda	[HET_entry_ptr],y
		tax
		iny
		iny
		lda	[HET_entry_ptr],y
		tay
		bne	@good_handle
		txa
		bne	@good_Handle
		sec
		rts
@good_Handle
		stx	temp_handle
		sty	temp_handle+2		;handle to the segment in memory
		ldy	#$0002			;deref the handle to get the base address
		lda	[temp_handle]
		tax
		lda	[temp_handle],y
		tay
		bne	@good_address
		tax
		bne	@good_address
		sec
		rts
@good_address
		stx	base_ptr
		sty	base_ptr+2		;address of the segment in memory
		jsr	add_segment_offset
		clc
		rts
		endp
		
		eject
;====================================================================================================
;Alloc_ID:	This routine will allocate a new user ID for a load file.  This routine is called
;		by the "initial_Load" routine
;
;Input:         A = user_id		;ID from the caller
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;Output:        A = user_id		;ID for the application
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
Alloc_id	proc
		with	data

		tax
		and	#$00FF
		bne	@exit_alloc	;use the given ID
		txa
		and	#$FF00		;see if the Type_ID is 0
		bne	@get_new	;Use the Input Type and Aux type please
		txa
		ora	#app_type_id	;set the Type to Application
		tax
@get_new
		pea	$0000		;space for result
		phx			;ID stuff
		ldx	#$2003		;GetNewID
		jsl	$e10000
		plx
		bcs	@oops		;return the error
@exit_alloc
		txa			;set A = User_ID
		sta	user_id		;this is now the Global_ID
		clc
@oops
		rts
		endp
		
		eject
;====================================================================================================
;compare_paths:	This routine will compare Expanded_Name and Full_Blown to see if they are equal
;		It can also compare partial paths if "Partial_Match" is negative.
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..0 = Complete path found
;			   1 = Complete path not found
;		     0 = partial path found.
;		     1 = partial path not found.
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
compare_paths	proc
		with	data

		lda	Expanded_name.size	;compare the string sizes first
		tay
		cmp	Full_Blown.size
		beq	@do_full_check
		bcc	@chk_colon_full_blown	;expand_name_contains the smaller string.
		lda	full_blown.size
		tay

		iny				;full blown contains the smaller string
		lda	expanded_name.name-1,y
		bra	@do_chk

@chk_colon_full_blown
		iny
		lda	full_blown.name-1,y
@do_chk
		and	#$00FF
		cmp	#seperator		;is it a seperator?
		bne	@not_same
		dey
		
@do_partial_compare
		lda	partial_match		;are we looking for a partial match?
		bpl	@not_same		;don't bother.
		
		sty	SubStr_size		;size of the substring
		longa	off
		sep	#$20
@partial_loop
		lda	Expanded_name.name-1,y	;compare the ascii data
		cmp	full_blown.name-1,y
		bne	@not_same
		dey
		bne	@partial_loop
		rep	#$60			;we have a match (clear overflow bit as well)
		sec				;no complete path found.
		rts
		
@do_full_check
		longa	off
		sep	#$20
@loop
		lda	Expanded_name.name-1,y	;compare the ascii data
		cmp	full_blown.name-1,y
		bne	@not_same
		dey
		bne	@loop
		rep	#$20
		clc
		rts				;the pathnames are the same
@not_same
		longa	on
		rep	#$20
		sep	#$41			;no partial or complete match found
		rts
		endp

		eject
;====================================================================================================
;Expand_Path:	This routine will expand a partial path into a complete GS/OS pathname
;		Note:  The name buffer is an internal 256 byte buffer, in the future
;		use the memory manager to get memory for the name.
;
;Input:         A = undefined
;               X = low word ptr to pathname
;               Y = high word ptr to pathname
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;		Expanded_name is setup
;
;====================================================================================================
	
		longa	on
		longi	on		
Expand_Path	proc
		with	data
		
		stx	expand.src
		sty	expand.src+2

		lda	#expanded_name
		sta	expand.dest
		lda	#^expanded_name
		sta	expand.dest+2
		
		jsr	lock_handles
		jsl	$e100a8			;call GS/OS
		dc.w	$200E			;expand path call
		dc.l	Expand			;pointer to the parameter
		jsr	unlock_handles
		bcc	@full_blown		;great news.
		rts
@full_blown
		with	Expanded_name
		
		lda	#Expanded_name.size	;address of GString
		sta	Open_List.Path_ptr
		lda	#^Expanded_name.size	;address of GString
		sta	Open_List.Path_ptr+2	;setup the Open Parameter block

;====================================================================================================
;
;This routine will take the pathname stored in Expanded_Name and generate the following variables:
;
;		partial_size			;size of the partial string
;		partial_offset			;offset to the partial string
;		vol_size			;size of the volume
;		path_size			;= Source size
;
;Input:		Expanded_name			;must contain a GString.
;
;
;====================================================================================================
		export	setup_path_sizes
setup_path_sizes
		stz	partial_size		;there is no partial path
		lda	size
		sta	path_size		;the complete size of the string
		beq	@end_expand
		
		ldx	#$0001			;convert from 1 based to two based
		ldy	#$0000			;init the volume size counter
@vol_loop
		lda	name,x			;get the character please
		iny
		and	#$00FF			;clear garbage
		cmp	#seperator
		beq	@save_vol		;we now have the volume size
		inx				;move to the next character
		cpx	size			;have we looked at all the characters?
		bne	@vol_loop
		iny				;adjust count correctly
@save_vol
		dey				;make count correct
		sty	vol_size		;the size of the volume name

		cpx	size			;is there anything to look at?
		beq	@end_expand
		ldy	#$0000			;reset counter for partial length
		inx				;point pass the colon please
		cpx	size
		beq	@end_expand		;pathname ended with a colon
		stx	partial_offset		;beginning of the partial pathname
		sec
		lda	size			;calculate the size of the partial
		sbc	partial_offset
		sta	partial_size
@end_expand
		clc
		rts
		endp

		eject
;====================================================================================================
;GString_to_PString:	This routine will convert a GString into a PString.  It will also
;			Convert Colons to Slashes.
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;		Expanded_Name		;Contains GString
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;		full_blown		;setup with the new string.
;
;====================================================================================================
	
		longa	on
		longi	on		
GString_to_PString	proc
		with	data
		
		lda	Expanded_name.size	;get the size of the name
		sta	Full_Blown.size
		cmp	#$0100
		bcs	@bad_name		;I cannot convert the name
		tay				;number of characters to move
		longa	off
		sep	#$20
@loop
		lda	Expanded_Name.name-1,y	;get the character
		cmp	#'/'
		beq	@bad_name		;name contains Slashes
		cmp	#':'
		bne	@store_it
		lda	#'/'			;convert to a slash
@store_it
		sta	Full_Blown.size,y	;store the character
		dey
		bne	@loop
		rep	#$20
		clc
		rts
@bad_name
		sec
		rts
		endp
		
		eject
;====================================================================================================
;Expand_app_path:	This routine will expand the pathname that has been supplied by the 
;			caller.
;
;Input:         A = undefined
;               X = pointer to input string: low
;               Y = pointer to input string: high
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;		full_blown		;setup with the new string.
;
;====================================================================================================
	
		longa	on
		longi	on		
Expand_app_path	proc
		with	data

		txa				;back up one for GString conversion
		bne	@low_only
		dey
@low_only
		dex
		stx	temp_ptr
		stx	expand.src
		sty	temp_ptr+2
		sty	expand.src+2		;parameter for Expand Path
		
		lda	[temp_ptr]		;get garbage + length byte
		pha				;save it please
		xba				;put length byte in the low word
		and	#$00FF			;clear the garbage
		sta	[temp_ptr]		;PString now equals GString
		
		lda	#full_blown		;setup destination buffer
		sta	expand.dest
		lda	#^full_blown
		sta	expand.dest+2

		jsr	lock_handles
		jsl	$e100a8			;call GS/OS
		dc.w	$200E			;expand path call
		dc.l	Expand			;pointer to the parameter
		jsr	unlock_handles
		bcc	@big_name		;great news.
		
		tax				;save the error code
		pla
		sta	[temp_ptr]
		txa
		rts
@big_name
		pla
		sta	[temp_ptr]		;restore the callers PString
		rts
		endp
		
		eject
;====================================================================================================
;Merge_path:	This routine will merge the volume name and partial path into one complete pathname
;		The names are stored at the end of an ExpressLoad segment
;
;Input:         A = undefined
;               X = low word of ExpressHandle
;               Y = High Word of ExpressHandle
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;		ExpressHandle		;must be setup
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;		Expanded_name		;setup with the new string.
;
;====================================================================================================
	
		longa	on
		longi	on		
Merge_path	proc
		with	data
		
		stx	ExpressHandle
		sty	ExpressHandle+2
		
		ldy	#$0002		;build a pointer to ExpressSegment
		lda	[ExpressHandle]
		sta	temp_ptr
		lda	[ExpressHandle],y
		sta	temp_ptr+2
;
;Now we need to build a pointer to the volume name
;		
		ldy	#seg_vol_offset	;offset to the volume name
		clc
		lda	[Temp_ptr],y
		adc	temp_ptr
		sta	vol_ptr
		lda	#$0000
		adc	temp_ptr+2
		sta	vol_ptr+2	;super_ptr now points to the volume name
;
;Now we need to build a pointer to the partial pathname
;
		iny
		iny			;point to the partial pathname
		clc
		lda	[Temp_ptr],y
		adc	temp_ptr
		sta	path_ptr
		lda	#$0000
		adc	temp_ptr+2
		sta	path_ptr+2	;super_ptr now points to the volume name
;
;OK now lets merge the volume and the partial pathname
;
		with	expanded_name
		
		longa	off
		sep	#$20		;switch to eight bit mode
		clc
		lda	#$02		;there will be two seperators added
		adc	[vol_ptr]	;the length of the volume name
		clc
		adc	[path_ptr]	;the length of the partial name
		sta	size
		sta	path_size
		
		lda	[vol_ptr]	;save the length
		sta	vol_size
		lda	[path_ptr]
		sta	partial_size	;save the length of the partial pathname
		
		lda	#seperator	;start the name with a ":"
		sta	name
		ldx	#$0001		;where we start storing the ascii name
		txy
@move_vol
		lda	[vol_ptr],y
		sta	name,x
		inx
		iny
		cpy	vol_size	;are we done
		bcc	@move_vol
		beq	@move_vol
		
		lda	#seperator	;add in the second seperator
		sta	name,x
		inx

		ldy	#$0001
@move_partial
		lda	[path_ptr],y	;get the character
		sta	name,x
		inx
		iny
		cpy	partial_size
		bcc	@move_partial
		beq	@move_partial
		longa	on
		rep	#$20
		sec
		lda	size		;build partial offset
		sbc	partial_size
		sta	partial_offset
		clc
		rts
		endp

		eject
;====================================================================================================
;alloc_my_dp:	This routine will allocate my direct page from the system.
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
alloc_my_dp	proc
		with	data

		lda	#256
		sta	free_mem_size		;save the request count
		stz	free_mem_size+2
		
		lda	#gs_os_start
		sta	search_addr		;start looking at $9A00 (start of GS/OS)
		stz	search_addr+2	
@search_loop
		pha				;space for handle
		pha
		PushLong free_mem_size		;request bytes
		PushWord ExpLoad_ID
		PushWord #attr_locked+attr_fixed+attr_addr+attr_page
		PushLong search_addr		;address to start at
		_NewHandle
		plx
		ply				;get the handle
		bcs	@not_done
		stx	dp_handle		;save my handle please
		sty	dp_handle+2
		
		rts				;return the handle
@not_done
		lda	search_addr+1
		dec	a
		sta	search_addr+1		;move down one page
		cmp	#$0008			;have we searched down to $000800?
		bne	@search_loop
		sec
		rts				;we cannot get our direct page/stack
		
		endp

		eject
;====================================================================================================
;Switch_handler	This routine is called when we switch from GS/OS to ProDOS 8 and when we switch
;		from ProDOS8 to GS/OS. It is also called for startup
;
;Input:         A = Function: 0 = startup,  4 = Swicth P8 to GS/OS, 2 = Switch GS/OS to P8
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;		The Direct page is saved and released if we are switching from GS/OS to P8
;		The Direct page is allocated and restored if we are switching from P8 to GS/OS
;
;====================================================================================================
	
		longa	on
		longi	on		
Switch_handler	proc
		with	data
		import	main
		import	loader_patch
		
		tax			;Is this my startup call?
		bne	@not_startup
		jmp	main		;do our main thing.
@not_startup
		phk			;set our data bank register
		plb
		lda	data.my_dir_page	;setup our own direct page
		tcd
		
		cpx	#$0004		;Switch P8 to GS/OS
		beq	@restore_dp

		ldx	#dir_page_size	;save the direct page please
@save_loop	lda	00,x
		sta	dir_page_buffer,x
		dex
		dex
		bpl	@save_loop
		
		lda	dp_handle+2	;dispose the handle
		pha
		lda	dp_handle
		pha
		jsr	clear_handles		;clear local copy of handle
		ldx	#$1002			;dispose handle
		jsl	$e10000		;its gone
		stz	dp_handle
		stz	dp_handle+2
		rtl			;exit back to the system

@restore_dp
		jsr	alloc_my_dp	;allocate me a direct page please
		bcc	@got_it
		rts			;return the error
@got_it
		pei	temp_handle	;save the current handle please
		pei	temp_handle+2
		
		stx	temp_handle
		sty	temp_handle+2	;to determine our direct page

		lda	[temp_handle]	;get the page please
		sta	my_dir_page	;save my direct page please
	
		ply
		sty	temp_handle+2	;restore data used on current direct page
		ply
		sty	temp_handle	;it is now safe to setup the direct register
		
		tcd			;go ahead and setup the direct register
		
		ldx	#dir_page_size	;save the direct page please
@restore_loop	lda	dir_page_buffer,x
		sta	00,x
		dex
		dex
		bpl	@restore_loop
		clc
		rtl
		
		endp

		eject
;====================================================================================================
;alloc_ExpLoad:	This routine will allocate memory from the system for the loader.
;
;Input:         A = undefined
;               X = request bytes low
;               Y = requets bytes high
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;Output:        A = undefined
;               X = handle low
;               Y = handle high
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
alloc_ExpLoad	proc
		with	data

		lda	ExpLoad_ID		;my ID
		bra	do_alloc		;go allocate

		eject
;====================================================================================================
;alloc_mem:	This routine will allocate memory from the system.
;
;Input:         A = user ID to use
;               X = request bytes low
;               Y = requets bytes high
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;Output:        A = undefined
;               X = handle low
;               Y = handle high
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;
;====================================================================================================

		entry	alloc_mem	
alloc_mem
		lda	AppID			;use application ID for normal allocation
do_alloc
		pha	 			;space for handle
		pha
		phy				;high request bytes
		phx				;low request bytes
		pha				;userID
		pea	$8000			;locked
		lda	#0
		pha
		pha
		jsr	lock_handles		;lock my handles so they stay put!!
		_NewHandle			;allocate the memory
		jsr	unlock_handles		;put the handles back to original state
		plx
		ply
		rts
		endp

		eject
;====================================================================================================
;alloc_LConst_seg	This routine will allocate memory from the system.
;
;Input:         A = undefined
;               X = request bytes low
;               Y = requets bytes high
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;		seg_header_ptr		;must be setup
;
;Output:        A = undefined
;               X = handle low
;               Y = handle high
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
alloc_LConst_seg	proc
		with	data
		jsr	lock_handles

		lda	mem_attr		;see if this is bank aligned or align in bank
		and	#attr_bank_align+attr_align_in_bank
		bne	@align_to_bank

		pha				;space for handle
		pha
		phy				;high request bytes
		phx				;low request bytes
		PushWord AppID
		lda	mem_attr
		pha
		PushLong org_address		;address to start at
		_NewHandle
		jsr	unlock_handles		;put the handles back to original state

		plx
		ply
		rts

@align_to_bank
		stx	free_mem_size		;save the request count
		sty	free_mem_size+2

		lda	mem_attr		;clear the align to bank bit
		and	#Å(attr_bank_align+attr_align_in_bank)
		sta	mem_attr

		lda	#$0002			;start looking in bank two
		sta	search_addr+2		;address we are searching for
		lda	org_address		;add in org. align in bank if non zero
		sta	search_addr	

		pha				;space for handle
		pha
		ldx	#$0000			;convenient place for a zero
		pea	$0001			;allocate 64K
		phx
		lda	AppID			;use App's ID
		pha
		lda	mem_attr		;attributes
		and	#Å(attr_Bank+attr_Addr)
		ora	#attr_No_Spec+attr_No_Cross
		pha
		phx				;location pointer
		phx
		_NewHandle			;allocate the memory
		plx				;retrieve handle
		ply
		bcs	@no_memory		;oops!  couldn't get a whole bank!
		phb				;save current DBR
		phy				;set to handle's DBR
		plb
		inx				;bump to bank word of handle
		inx
		lda	|0,x			;get the bank # that was allocated
		plb
		plb				;restore DBR
		sta	search_addr+2		;save the bank value
		dex				;restore original value
		dex
		phy
		phx				;now deallocate the bank again
		_DisposeHandle
		
@no_memory
		lda	#attr_addr+attr_bank	;set the fixed address and bank bits
		tsb	mem_attr

@search_loop
		pha				;space for handle
		pha
		PushLong free_mem_size
		PushWord AppID
		lda	mem_attr
		pha
		PushLong search_addr		;address to start at
		_NewHandle
		plx
		ply				;get the handle
		bcc	@done			;if no error, return!
@not_done
		inc	search_addr+2
		lda	search_addr+2		;move up one bank
		cmp	#$0080			;have we searched all of memory?
		bcc	@search_loop
		lda	#$0201			;synthesize a Memory Manager error
						;(carry already set)
@done		jsr	unlock_handles
		rts				;return the handle
		
		endp

		eject
;====================================================================================================
;add_id_table:	This routine will allocate memory for one user_id_table and link the table
;		into the list of user_id_tables.  It will also zero the entire table
;
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
add_id_table	proc
		with	data
		ldx	#id_tbl_size	;allocate the table please
		ldy	#$0000
		jsr	alloc_ExpLoad	;go and allocate memory using ExpressLoad ID
		bcc	@got_it
		rts			;return the error to the caller
@got_it
		stx	temp_handle	;save the handle please
		stx	temp_long
		sty	temp_handle+2
		sty	temp_long+2

		ldy	#$0004		;offset to memory manager attributes
		lda	[temp_handle],y
		and	#$7FFF		;unlock the handle
		sta	[temp_handle],y
		
		ldy	#$0002		;make a pointer to new memory
		lda	[temp_handle]
		sta	user_id_ptr
		lda	[temp_handle],y
		sta	user_id_ptr+2
		
		lda	#$0000
		ldy	#id_tbl_size-2	;clear the buffer please
@clear_loop
		sta	[user_id_ptr],y
		dey
		dey
		bpl	@clear_loop
;
;Now that we have cleared the segment lets link it into the list
;
		lda	user_id_handle	;see if this is the first one!
		ora	user_id_handle+2
		bne	@walk_list
		
		lda	temp_handle	;setup the first handle and exit
		sta	user_id_handle
		lda	temp_handle+2
		sta	user_id_handle+2
		clc
		rts
@walk_list
		lda	user_id_handle	;start at front of the list
		sta	temp_handle
		lda	user_id_handle+2
		sta	temp_handle+2
@search_loop
		ldy	#$0002
		lda	[temp_handle]
		sta	user_id_ptr
		lda	[temp_handle],y
		sta	user_id_ptr+2
		
		lda	[user_id_ptr]	;get the forward link please (Link = Handle)
		tax
		lda	[user_id_ptr],y
		tay
		bne	@next_one
		txa
		bne	@next_one
		
		ldy	#$0002		;link in the new entry
		lda	temp_long	;handle to our new segment
		sta	[user_id_ptr]
		lda	temp_long+2
		sta	[user_id_ptr],y
		
		lda	[temp_long]	;deref handle
		sta	user_id_ptr
		lda	[temp_long],y
		sta	user_id_ptr+2
		
		clc
		rts
@next_one
		stx	temp_handle
		sty	temp_handle+2
		bra	@search_loop
		endp

		eject
;====================================================================================================
;add_user_id:	This routine will find a empty spot in the user_id table and allocate it
;
;Input:         A = user_id		;ID from the caller
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;Output:        A = undefined
;               X = low word address of entry
;               Y = high word address of entry
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
Add_user_id	proc
		with	data
		
		sta	temp_word		;ID to add
		
		ldy	#$0002			;start at the beginning of the User_Id table
		lda	[user_id_handle]
		sta	user_id_ptr
		lda	[user_id_handle],y
		sta	user_id_ptr+2	
@loop
		jsr	get_free_id		;find a free spot in the table
		bcc	@got_it
		jsr	add_id_table		;add another table please
		bcc	@loop			;try again
		rts				;return the error
@got_it
		ldx	temp_ptr
		ldy	temp_ptr+2		;address of the entry
		clc
		rts

get_free_id
		ldy	#id_entry_size		;start at the first available spot
		ldx	#id_entry_cnt		;number of entries in a table
@search_loop
		lda	[user_id_ptr],y		;is this avail.
		beq	@its_free
		clc
		tya
		adc	#id_entry_size
		tay
		dex
		bpl	@search_loop
		sec
		rts
@its_free
		clc				;build a pointer to the entry
		tya
		adc	user_id_ptr
		sta	temp_ptr
		sta	user_id_ptr
		lda	#$000
		adc	user_id_ptr+2
		sta	temp_ptr+2
		sta	user_id_ptr+2
		
		ldy	#14			;clear the entry please (16 bytes total 0 thru 15)
		lda	#$0000
@clr_it
		sta	[temp_ptr],y
		dey
		dey
		bpl	@clr_it
		
		lda	temp_word		;save the user Id please
		sta	[temp_ptr]
		clc
		rts
		endp

		eject
;====================================================================================================
;delete_user_id:	This routine will delete the user_id pointer to by user_id
;
;Input:         A = User_ID_Flag:	0 = delete ID, 1 = keep the user_id
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;		user_id			;must be setup
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
delete_user_id	proc
		with	data
		
		sta	id_flag			;used to determine if I should delete the user id
		
		ldy	#$0002
		lda	[user_id_ptr],y		;get the ExpressLoad handle
		tax
		iny
		iny
		lda	[User_id_ptr],y
		tay
		bne	@deallocate
		tax
		beq	@no_handle
@deallocate
		phy
		phx
		jsr	clear_handles		;clear local copy of handle
		ldx	#$1002			;dispose handle
		jsl	$e10000			;its gone
@no_handle		
		lda	[user_id_ptr]		;get the user_id
		beq	@zero_and_exit

		pha				;ID to nuke
		ldx	#$1102			;do a dispose all please
		jsl	$e10000
		
		ldx	id_flag			;should we nuke the ID?
		bne	@zero_and_exit		;no...
		
		lda	[user_id_ptr]		;get the user_id
		pha				;ID to nuke
		ldx	#$2103			;delete ID
		jsl	$e10000
		
@zero_and_exit
		ldy	#$0002
		lda	#$0000
		sta	[user_id_ptr]
		sta	[user_id_ptr],y
		iny
		iny
		sta	[user_id_ptr],y		;remove everything
		stz	ExpressHandle		;indicate that we no longer have the load file
		stz	ExpressHandle+2
		clc
		rts
		endp
		
		eject
;====================================================================================================
;purge_user_id:	This routine will mark an application as purgable
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;		user_id			;must be setup
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
purge_user_id	proc
		with	data
		
		lda	[user_id_ptr]		;get the user_id
		beq	@exit
		pha
		ldx	#$1302			;Purge all
		jsl	$e10000
@exit
		rts
		endp
		
		eject
;====================================================================================================
;remove_segment:	This routine will deallocate all memory associated with a user ID.
;
;Input:         A = And Mask for flags field
;               X = Compare Value
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;		ExpressHandle
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
remove_segment	proc
		with	data
		sta	temp_word
		stx	search_kind
		
		jsr	make_HET_ptr
		
		lda	[HET_ptr]		;get the number of entries in table
		inc	a			;start from the last segment
		inc	a
		tax
@search_loop
		txa				;pass in the segment number
		beq	@end_remove		;sorry there is no segment
		phx
		jsr	setup_seg_ptrs		;we are now in business
		ldy	#flags_offset
		lda	[HET_entry_ptr],y
		and	temp_word		;AND off user requested bits
		cmp	search_kind		;see if we have a match
		bne	@skip_it
		jsr	do_operation
@skip_it
		plx
		dex				;back off by one and try again
		cpx	#$0001
		bne	@search_loop
@end_remove
		clc
		rts
		
do_operation
		lda	#$0000			;zero the status word
		sta	[HET_entry_ptr],y	
		ldy	#handle_offset		;lets dispose of the handle please
		lda	[HET_entry_ptr],y
		tax
		lda	#$0000
		sta	[HET_entry_ptr],y
		iny
		iny
		lda	[HET_entry_ptr],y	;get the high word
		pha
		lda	#$000
		sta	[HET_entry_ptr],y
		phx				;push the low word
		jsr	clear_handles		;clear local copy of handle
		ldx	#$1002			;dispose handle
		jsl	$E10000
		rts
		endp
		
		eject
;====================================================================================================
;find_user_id:	This routine will find a user_id in the User_ID_Table
;
;Input:         A = user_id		;ID from the caller
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;Output:        A = undefined
;               X = low word address of entry
;               Y = high word address of entry
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
find_user_id	proc
		with	data

		tax		
		bne	@use_input
		lda	User_ID			;use the global ID
@use_input
		sta	search_kind
		sta	User_ID			;update the global User ID
		sta	AppID

		ldy	#$0002
		lda	[user_id_handle]
		sta	user_id_ptr
		lda	[user_id_handle],y
		sta	user_id_ptr+2
@loop
		jsr	find_id
		bcc	@found_it
		
		ldy	#$0002			;get the next link
		lda	[user_id_ptr]
		tax
		lda	[user_id_ptr],y
		tay
		bne	@keep_going
		txa
		bne	@keep_going
		sec
		rts				;sorry ID not found
@keep_going
		stx	temp_handle
		stx	curr_id_handle		;the current handle table
		sty	temp_handle+2
		sty	curr_id_handle+2
		ldy	#$00002
		lda	[temp_handle]
		sta	user_id_ptr
		lda	[temp_handle],y
		sta	user_id_ptr+2
		bra	@loop
@found_it
		ldx	temp_ptr		;return pointer to the entry
		ldy	temp_ptr+2
		clc
		rts
		
find_id
		ldy	#id_entry_size		;start at the first available spot
		ldx	#id_entry_cnt		;number of entries in a table
@search_loop
		lda	[user_id_ptr],y		;is this the one
		cmp	search_kind
		beq	@its_the_one
		clc
		tya
		adc	#id_entry_size
		tay
		dex
		bpl	@search_loop
		sec
		rts
@its_the_one
		clc				;build a pointer to the entry
		tya
		adc	user_id_ptr
		sta	temp_ptr
		sta	user_id_ptr
		lda	#$000
		adc	user_id_ptr+2
		sta	temp_ptr+2
		sta	user_id_ptr+2

		clc
		rts
		
		endp

		eject
;====================================================================================================
;path_to_user_id:	This routine will find a user_id in the User_ID_Table given a pathname
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;		Full_Blown		;Path that we need to find
;
;Output:        A = User ID
;               X = undefined
;               Y =undefined
;               P = nvmxdizc
;                   ..000..1 = not found
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
path_to_user_id	proc
		with	data

		ldy	#$0002
		lda	[user_id_handle]
		sta	user_id_ptr
		lda	[user_id_handle],y
		sta	user_id_ptr+2
@loop
		jsr	find_id
		bcc	@found_it		;we have found the complete path!
		
		ldy	#$0002			;get the next link
		lda	[user_id_ptr]
		tax
		lda	[user_id_ptr],y
		tay
		bne	@keep_going
		txa
		bne	@keep_going
		sec
		rts				;sorry ID not found
@keep_going
		stx	temp_handle
		sty	temp_handle+2
		ldy	#$00002
		lda	[temp_handle]
		sta	user_id_ptr
		lda	[temp_handle],y
		sta	user_id_ptr+2
		bra	@loop
@found_it
		rts				;A = User_ID
		
find_id
		ldy	#id_entry_size		;start at the first available spot
		ldx	#id_entry_cnt		;number of entries in a table
@search_loop
		lda	[user_id_ptr],y		;is this the one
		sta	search_kind		;save the User ID
		beq	@empty_slot
		phy
		phx
		jsr	check_name		;is this the one
		plx
		ply
		bcc	@its_the_one

@empty_slot	clc
		tya
		adc	#id_entry_size
		tay
		dex
		bpl	@search_loop
		sec
		sep	#$40			;no partial match!!!
@its_the_one
		rts
check_name
		iny
		iny				;get the handle
		lda	[user_id_ptr],y
		sta	ExpressHandle
		tax
		iny
		iny
		lda	[user_id_ptr],y
		sta	ExpressHandle+2		;Handle to the ExpressLoad segment
		tay
		jsr	Merge_path		;build a complete pathname
		jsr	compare_paths		;is this the one?
		lda	search_kind
		rts				;carry set or cleared from the compare routine
		endp

		eject
;====================================================================================================
;find_seg_handle:	This routine will find a segment by handle
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;		seg_handle		;must be setup
;
;Output:        A = User ID
;               X = undefined
;               Y =undefined
;               P = nvmxdizc
;                   ..000..1 = not found
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
find_seg_handle	proc
		with	data

		ldy	#$0002
		lda	[user_id_handle]
		sta	user_id_ptr
		lda	[user_id_handle],y
		sta	user_id_ptr+2
@loop
		jsr	find_id
		bcc	@found_it
		
		ldy	#$0002			;get the next link
		lda	[user_id_ptr]
		tax
		lda	[user_id_ptr],y
		tay
		bne	@keep_going
		txa
		bne	@keep_going
		sec
		rts				;sorry ID not found
@keep_going
		stx	temp_handle
		sty	temp_handle+2
		ldy	#$00002
		lda	[temp_handle]
		sta	user_id_ptr
		lda	[temp_handle],y
		sta	user_id_ptr+2
		bra	@loop
@found_it
		rts				;A = User_ID
		
find_id
		ldy	#id_entry_size		;start at the first available spot
		ldx	#id_entry_cnt		;number of entries in a table
@search_loop
		lda	[user_id_ptr],y		;is this the one
		sta	User_ID
		beq	@empty_slot
		phy
		phx
		jsr	check_handle		;is this the one
		plx
		ply
		bcc	@its_the_one
@empty_slot
		clc
		tya
		adc	#id_entry_size
		tay
		dex
		bpl	@search_loop
		sec
@its_the_one
		sta	search_seg		;save the segment number
		rts
check_handle
		iny
		iny				;get the handle
		lda	[user_id_ptr],y
		sta	ExpressHandle
		tax
		iny
		iny
		lda	[user_id_ptr],y
		sta	ExpressHandle+2		;Handle to the ExpressLoad segment
		jsr	walk_ExpressSeg		;look at all the handles in the ExpressLoad segment
		rts				;found the handle

walk_expressSeg
		jsr	make_HET_ptr		;make a pointer to the Header Entry Table
		
		lda	[HET_ptr]		;get the number of entries in table
		inc	a			;start from the last segment
		inc	a
		tax
@search_loop
		txa				;pass in the segment number
		beq	@end_handle		;sorry there is no segment by this name
		phx
		jsr	setup_seg_ptrs		;we are now in business
		ldy	#handle_offset		;see if this is a jump segment
		lda	[HET_Entry_ptr],y
		cmp	seg_handle
		bne	@not_handle
		iny
		iny
		lda	[HET_entry_ptr],y
		cmp	seg_handle+2
		bne	@not_handle
		pla				;this is the segment number
		clc
		rts
@not_handle
		plx
		dex				;back off by one and try again
		cpx	#$0001
		bne	@search_loop
@end_handle
		sec
		rts
		
		endp

		eject
;====================================================================================================
;Get_ExpLoad_ID:	This routine will request an ID from the ID manager.
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;		ExpLoad_ID		;contains our ID
;
;====================================================================================================
	
		longa	on
		longi	on		
get_ExpLoad_ID	proc
		with	data
		lda	#$7050		;This is ExpressLoad ID
		sta	ExpLoad_ID
		rts
		endp
		
		include	'ProcReloc.DataBankChanged'
		
		eject
;====================================================================================================
;read_less_64K:	This routine will read data from the input file.  It is limited to $FFFF bytes
;
;
;Input:         A = request count
;               X = buffer_ptr low
;               Y = buffer_ptr high
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
read_less_64k	proc
		stz	read_list.cnt+2
		sta	read_list.cnt
		export	read_wBuf_ptr
read_wBuf_ptr
		stx	read_list.ptr
		sty	read_list.ptr+2

		jsr	lock_handles
		jsl	$e100a8
		dc.w	$2012			;class 1 read call
		dc.l	read_list
		jsr	unlock_handles
		bcs	@exit

		lda	read_list.ret_cnt
		adc	local_mark		;bump the local mark please
		sta	local_mark
		lda	read_list.ret_cnt+2
		adc	local_mark+2
		sta	local_mark+2
		lda	#$0000
		clc
@exit
		rts
		endp
		
		eject
;====================================================================================================
;get_mark:	This routine will return the current file position
;
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = Mark Low
;               Y = Mark High
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
get_mark	proc
		jsr	lock_handles
		jsl	$e100a8
		dc.w	$2017
		dc.l	get_mark_list
		jsr	unlock_handles
		bcc	@got_mark
		rts
@got_mark
		ldx	get_mark_list.pos
		ldy	get_mark_list.pos+2
		rts
		endp
		
		eject
;====================================================================================================
;set_mark:	This routine will set the current file position
;
;
;Input:         A = base
;               X = displacement low
;               Y = displacement high
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = error if carry set
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
set_mark	proc
		lda	#absolute
		sta	set_mark_list.base
		stx	set_mark_list.disp
		sty	set_mark_list.disp+2
		cpx	local_mark		;lets see if we are already at the mark
		bne	@do_mark
		cpy	local_mark+2
		bne	@do_mark
		clc
		lda	#$0000			;we are already at the mark
		rts				;return with no error
@do_mark
		jsr	lock_handles
		jsl	$e100a8
		dc.w	$2016			;class 1 set mark call
		dc.l	set_mark_list
		jsr	unlock_handles
		bcs	@exit
		
		lda	set_mark_list.disp	
		sta	local_mark		;reset our mark please
		lda	set_mark_list.disp+2
		sta	local_mark+2
@exit
		rts
		endp


		eject
;====================================================================================================
;check_express_seg:	This routine will determine if this is an expressload file
;
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;		Expanded_name		;must be setup
;		vol_size
;		partial_size
;		partial_offset		;all must be setup
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
check_express_seg	proc
		with	data
;		jsr	get_mark		;save the current file position
		
		ldx	#header_buf
		ldy	#^header_buf
		lda	#$0047			;read in $47 byte
		jsr	read_less_64k		;read in less then 64K		
		bcc	@no_error
		rts
@no_error
		lda	read_list.ret_cnt	;is the segment > $47 bytes
		cmp	#$0047
		beq	@good_size
		sec
		rts				;return with error flag

@good_size
;
;I am removing the type check so the linker can produce a skip segment if it wishes
;
;		lda	header_buf.kind		;see if it is my kind
;		cmp	#Data_Kind+Dynamic
;		bne	sorry_not_express	;this cannot be it


		lda	header_buf.name_disp	;offset to the name
		clc
		adc	#10			;pass my Name
		clc
		adc	#header_buf
		sta	temp_ptr
		lda	#^header_buf
		sta	temp_ptr+2		;point to the name field
		
		longa	off
		longi	off
		sep	#$30
		lda	[temp_ptr]		;get the length of the name
		cmp	express_name		;is the length the same?
		bne	next_name		;cannot be the same
		tay
@loop
		lda	[temp_ptr],y
		cmp	#'a'			;is this lower case
		bcc	@not_lower
		cmp	#'z'+1
		bcs	@not_lower
		and	#$DF			;convert to Upper case
@Not_lower
		cmp	express_name,y
		bne	sorry_not_express
		dey
		bne	@loop			;keep checking
		bra	load_it
;
;Now look for "~ExpressLoad"
;
next_name
		cmp	tilda_name		;now check for "~ExpressLoad"
		bne	sorry_not_express
		tay
@loop
		lda	[temp_ptr],y
		cmp	#'a'			;is this lower case
		bcc	@not_lower
		cmp	#'z'+1
		bcs	@not_lower
		and	#$DF			;convert to Upper case
@Not_lower
		cmp	tilda_name,y
		bne	sorry_not_express
		dey
		bne	@loop			;keep checking
		bra	load_it


sorry_not_express
		longa	on
		longi	on
		rep	#$30
		sec
		rts
		
load_it
		rep	#$30
		clc
		rts
		endp

		eject
;====================================================================================================
;find_segment:	This routine will search for segments in the HET table
;
;
;Input:         A = Kind to search for
;               X = AND mask for kind field.	If equal after AND the kind was a match
;               Y = AND mask for flags field.  	If equal after AND then search succeeds
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;		HET_ptr		;must be setup!
;
;Output:        A = Segment number in file
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = not found
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
find_Segment	proc
		with	data
		
		sta	search_kind
		stx	kind_mask
		sty	flags_mask
		ldx	#$0000			;start search from the beginning
	
@loop
	
		txa
		asl	a
		asl	a
		asl	a			;times eight for HET
		inc	a
		inc	a			;pass the count word
		tay
		
		clc
		adc	HET_ptr
		sta	HET_Entry_ptr		;build a pointer to the HET entry
		lda	#$0000
		adc	HET_ptr+2
		sta	HET_entry_ptr+2
		
		clc
		lda	[HET_entry_ptr]		;get the relative offset to segment
		adc	HET_entry_ptr
		sta	seg_header_ptr		;point to the segment
		lda	#$0000
		adc	HET_entry_ptr+2
		sta	seg_header_ptr+2
		
		iny
		iny
		lda	[HET_ptr],y		;check the flags mask
		and	flags_mask
		bne	@check_next		;sorry
		
		ldy	#seg_kind_offset	;lets check the kind please
		lda	[seg_header_ptr],y
		and	kind_mask
		cmp	search_kind		;is this it
		bne	@check_next		;sorry false alarm
		
		txa
		inc	a			;convert 0 thru n to 1 thru n
		clc
		adc	ExpressSeg_Pos		;account for Express Segments position
		sta	loaded_seg_num
		clc
		rts				;return the segment
		
@check_next
		inx
		txa
		cmp	[HET_ptr]		;are we done
		beq	@loop			;we have one more to do
		bcc	@loop
		rts				;return with the carry set
		endp
		
		eject
;====================================================================================================
;chk_dynamic_seg:	See if there are any dynamic segments in the file.
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;		ExpressHandle		;handle to the express segment.
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = no seg.
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
chk_dynamic_seg	proc
		with	data
		jsr	make_HET_ptr		;setup pointer to the HETable
		
		lda	#Dynamic		;Compare to Dynamic BIT
		ldx	#Dynamic		;And Mask (Only Dynamic Bit is important)
		ldy	#unloaded_state		;only unloaded segments please
		jsr	find_segment		;do the search
		rts
		endp
		
		eject
;====================================================================================================
;Save_Ref_Num:	This routine will save the files reference number if the file contains any dynamic
;		segments.  We do this so the file can remain open while the program is running.
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;		open_list.ref_num	;reference number for the current file.
;		ExpressHandle		;handle to the express segment.
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
Save_Ref_Num	proc
		with	data

		lda	open_list.file_type
		cmp	#app_type		;only leave the file open if type = Application
		bne	@skip_dynamic_chk	;don't leave the file open

		jsr	chk_dynamic_seg	
		bcc	@save_the_num		;There is a dynamic segment.

@skip_dynamic_chk
		clc
		rts
@save_the_num
		ldy	#$0002
		clc
		lda	[ExpressHandle]
		adc	#extra_header		;load ExpressSegment past Extra Header
		sta	temp_ptr		;temp now points the link field
		lda	[ExpressHandle],y
		adc	#$0000
		sta	temp_ptr+2
		
		lda	open_list.ref_num	;save the file reference number since the file
		sta	[temp_ptr]		; contains Dynamic Segments.
		rts
		endp
		
		eject
;====================================================================================================
;get_express_seg:	This routine will locate and read in the ExpressLoad Header
;
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;		Expanded_name		;must be setup
;		vol_size
;		partial_size
;		partial_offset		;all must be setup
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
get_express_seg	proc
		with	data
		
		clc
		lda	header_buf.code_disp
		adc	#$0005			;Add in LConst over header
		clc
		adc	get_mark_list.pos
		tax
		lda	#$000
		adc	get_mark_list.pos+2
		tay
		lda	#absolute		;set the mark to the LConst please
		jsr	set_mark
		bcc	@its_there
		rts				;return the error
@its_there
		ldx	header_buf.image	;get the size of the disk image please
		stx	read_list.cnt
		ldy	header_buf.image+2
		sty	read_list.cnt+2
;
;Now we need to add in the pathname overhead + link field overhead
;
		lda	vol_size		;see if the volume name is larger then 40 characters
		cmp	#max_vol+1
		bcc	@vol_ok
		lda	#$0001			;error
		rts
@vol_ok
		clc
		lda	#max_vol		;add in volume buffer size
		adc	partial_size		;add in partial pathname size
		clc
		adc	#extra_header+2		;add in extra header size + two for vol and partial 
		clc				; length bytes.
		adc	header_buf.image	;add in ExpressLoad segment size
		tax				;save request count low
		lda	#$0000
		adc	header_buf.image+2
		tay				;save request count high
		
		jsr	alloc_ExpLoad		;get enough memory to hold segment
		bcc	@have_mem
		rts
@have_mem
		stx	ExpressHandle		;handle to Express Segment
		stx	temp_handle
		sty	ExpressHandle+2
		sty	temp_handle+2
		ldy	#$0002
		lda	[temp_handle]		;clear the link field etc.
		sta	base_ptr
		lda	[temp_handle],y
		sta	base_ptr+2
		
		ldy	#extra_header
		lda	#$0000			;clear the buffer
@clr_loop
		sta	[base_ptr],y
		dey
		bpl	@clr_loop

;
;Lets go ahead and add the Express Segment into the User ID table
;
		lda	user_id			;this is the ID to use
		jsr	add_user_id		;temp_ptr setup by Add_User_ID
		bcc	@id_added
		rts				;return the error
@id_added
		ldy	#$0002			;save the Handle to the ExpressSegment
		lda	ExpressHandle
		sta	[temp_ptr],y
		iny
		iny
		lda	ExpressHandle+2
		sta	[temp_ptr],y

		jsr	make_het_ptr		;temp_ptr will point to the link field (HET_ptr-4)		
		jsr	read_wBuf_ptr		;make the read call please
		bcc	@I_love_it
		rts
@I_love_it
		ldx	temp_ptr		;pass in pointer to ExpressSegment link field
		ldy	temp_ptr+2
		jsr	store_pathname		;store the pathname in the ExpressLoad segment
		jsr	save_ref_num		;save the files reference number.
		clc
		rts

		eject
;====================================================================================================
;
;This routine will add in the pathname stored in Expanded_name to the ExpressLoad segment.
;
;Input:         A = undefined
;               X = Points to the ExpressLoad segment link field
;               Y = Points to the ExpressLoad segment link field
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;		Expanded_name		;must be setup
;		base_ptr
;		vol_size
;		partial_size
;		partial_offset		;all must be setup
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;Uses:		
;
;====================================================================================================

store_pathname
		clc
		txa
		adc	read_list.cnt		;build a pointer to the Volume Name Buffer
		sta	super_ptr		;another temp pointer
		tya	
		adc	read_list.cnt+2
		sta	super_ptr+2		;super_ptr now points past the ExpressLoad segment
;
;This entry point is used by rename call
;
		export	store_new_name
store_new_name
		ldx	#$0001
		ldy	#$0001
		lda	vol_size		;store the volume size (1 Byte)
		sta	[super_ptr]
@store_vol_loop
		lda	Expanded_name.name,x
		sta	[super_ptr],y
		iny
		inx
		cpx	vol_size		;see if we are done
		bcc	@store_vol_loop		;keep moving the name
		
		ldy	#seg_vol_offset		;index to offset field (relative offset is based
		sec				;from the beginning of the segment)
		lda	super_ptr
		sbc	base_ptr
		sta	[base_ptr],y
		iny
		iny
		clc
		adc	#max_vol		;offset to partial
		sta	[base_ptr],y		;save partial offset
		
		clc
		lda	super_ptr
		adc	#max_vol
		sta	super_ptr		;build a pointer to the partial buffer
		lda	super_ptr+2
		adc	#$0000
		sta	super_ptr+2
		
		ldx	partial_offset		;start of the partial name
		ldy	#$0001
		lda	partial_size		;store the volume size (1 Byte)
		sta	[super_ptr]
		longa	off
		sep	#$20			;8 bit mode
@store_part_loop
		lda	Expanded_name.name,x
		sta	[super_ptr],y
		inx
		iny
		cpy	partial_size		;see if we are done
		bcc	@store_part_loop	;keep moving the name
		beq	@store_part_loop
		longa	on
		rep	#$20			;16 bit mode
		rts
		
		endp

		eject
;====================================================================================================
;close_dynamic_file:	This routine will close the load file if the file is still open
;
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;		ExpressHandle
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error if any
;               b = k
;
;
;====================================================================================================

		longa	on
		longi	on
close_dynamic_file	proc		
		with	data
		import	close_load_file
		
		pei	temp_ptr		;save temp pointer please
		pei	temp_ptr+2
		
		ldy	#$0002
		clc
		lda	[ExpressHandle]
		adc	#extra_header		;load ExpressSegment past Extra Header
		sta	temp_ptr		;temp now points the link field
		lda	[ExpressHandle],y
		adc	#$0000
		sta	temp_ptr+2
		
		lda	[temp_ptr]		;see if there is reference number.
		bne	@do_close		;yes we must close the file
		bra	@exit			;accumulator already 0 here!

@do_close
		sta	open_list.ref_num	;setup the reference number for closing
		lda	#$0000			;zero the reference number in ExpressSegment
		sta	[temp_ptr]

		jsr	lock_handles
		jsl	$e100a8			;get the current system preferences
		dc.w	$200F
		dc.l	preference_list
;
;Save the current user's preference please
;
		lda	preference_list.sys_prefs
		sta	preference_list.users_prefs
;
;Now ask the operating system to put up a mount dialog when I ask for a disk
;
		lda	#$C000			;ask the OS to put up the mount dialog
		sta	preference_list.sys_prefs
		
		jsl	$e100a8
		dc.w	$200C			;set the system preference
		dc.l	preference_list
		jsr	unlock_handles
		
		jsr	close_load_file		;close the file please

		lda	preference_list.users_prefs
		sta	preference_list.sys_prefs
		jsr	lock_handles
		jsl	$e100a8
		dc.w	$200C			;restore the caller's system preference
		dc.l	preference_list
		jsr	unlock_handles
@exit
		plx
		stx	temp_ptr+2
		plx
		stx	temp_ptr
		cmp	#$0001
		rts				;exit with error if any
		endp
		
		eject
;====================================================================================================
;close_load_file:	This routine will close the load file and restore the caller's sys_prefs
;
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error if any
;               b = k
;
;
;====================================================================================================

		longa	on
		longi	on
close_load_file	proc
		with	data
		
		lda	ExpressHandle		;see if there is an ExpressSegment for this file.
		ora	ExpressHandle+2
		beq	@do_close		;There is no Segment associated with the file.
		
		ldy	#$0002
		clc
		lda	[ExpressHandle]
		adc	#extra_header		;load ExpressSegment past Extra Header
		sta	temp_ptr		;temp now points the reference number field
		lda	[ExpressHandle],y
		adc	#$0000
		sta	temp_ptr+2
		
		lda	[temp_ptr]		;see if there is reference number.
		beq	@do_close		;there is no reference number with the segment so
						;go ahead and close the file they want.
		lda	#$0000
		clc
		bra	@do_preference		;No error and I am not going to close the file
						;since the file contains Dynamic Segments I will
						;leave the file open.
		
@do_close
		
		jsr	lock_handles
		jsl	$e100a8
		dc.w	$14			;GS/OS close command
		dc.l	open_list.ref_num
		jsr	unlock_handles
;
;Save the error code and statue from the close call while I restore the user's system preferences
;
@do_preference
		pha
		php
		stz	file_open		;file is now closed
		jsr	reset_local_mark	;our local mark is invalid
 if 0 then
		lda	preference_list.users_prefs
		sta	preference_list.sys_prefs
		jsr	lock_handles
		jsl	$e100a8
		dc.w	$200C			;restore the caller's system preference
		dc.l	preference_list
		jsr	unlock_handles
 endif
		plp
		pla				;restore the close error if any
		rts
		endp
		
		eject
;====================================================================================================
;Open_load_file:	This routine will open the load file and verify the storage type
;
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;		pathname pointer must be setup
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================

		longa	on
		longi	on
open_load_file	proc
		with	data
		
;
;Now before I open the file let me see If I have a Reference number for it already.
;
		lda	ExpressHandle		;see if there is an ExpressSegment for this file.
		ora	ExpressHandle+2
		beq	@do_open		;There is no Segment associated with the file.
;
;There is an Active Segment so lets see if we have the reference number
;
		ldy	#$0002
		clc
		lda	[ExpressHandle]
		adc	#extra_header		;load ExpressSegment past Extra Header
		sta	temp_ptr		;temp now points the reference number field
		lda	[ExpressHandle],y
		adc	#$0000
		sta	temp_ptr+2
		
		lda	[temp_ptr]		;see if there is reference number.
		beq	@do_open		;There is no reference number so lets open the file
		sta	open_list.ref_num	;save the reference number
		lda	#app_type		;setup the file type also
		sta	open_list.file_type
		bra	@opened			;say that we already opened the file.
		
@do_open	
		jsr	lock_handles

		jsl	$e100a8			;get the current system preferences
		dc.w	$200F
		dc.l	preference_list
;
;Save the current user's preference please
;
		lda	preference_list.sys_prefs
		sta	preference_list.users_prefs
;
;Now ask the operating system to put up a mount dialog when I ask for a disk
;
		lda	#$C000			;ask the OS to put up the mount dialog
		sta	preference_list.sys_prefs
		
		jsl	$e100a8
		dc.w	$200C			;set the system preference
		dc.l	preference_list

		jsl	$e100a8			;do a get level call to get the current level
		dc.w	$201B
		dc.l	level_list		;get the level

		lda	level_list.curr_level
		sta	level_list.hold_level	;save the current level
		lda	#my_level
		sta	level_list.curr_level
		
		jsl	$e100a8			;do a get level call to get the current level
		dc.w	$201A			;set the current level
		dc.l	level_list		;get the level
		
		jsl	$e100a8			;call GS/OS
		dc.w	$2010			;class 1 open call
		dc.l	open_list
		pha
		php
		
		lda	level_list.hold_level	;restore the saved level
		sta	level_list.curr_level

		jsl	$e100a8			;do a get level call to get the current level
		dc.w	$201A			;set the current level
		dc.l	level_list		;get the level

		lda	preference_list.users_prefs
		sta	preference_list.sys_prefs
		jsl	$e100a8
		dc.w	$200C			;restore the caller's system preference
		dc.l	preference_list
		jsr	unlock_handles

		plp
		pla
		bcs	@oops			;return the error to the caller
@opened
		stz	local_mark
		stz	local_mark+2		;we are at the beginning of the file.
		lda	open_list.ref_num	;setup the reference number
		sta	read_list.ref_num
		sta	get_mark_list.ref_num
		sta	set_mark_list.ref_num
		sta	eof_list.ref_num
		lda	#$0001			;indicate that the file is open
		sta	file_open
		
		lda	open_list.file_type
		cmp	#app_type
		bcc	@no_way
		cmp	#$00BD+1		;max file type that we support
		bcc	@chk_length
		cmp	#$C7			;is it a CDev file?
		bne	@no_way			;nope, can't be a load file
@chk_length
		jsr	lock_handles		;lock the handles around the OS call
		jsl	$E100A8			;Call GS/OS
		dc.w	$2019			; GetEOF
		dc.l	eof_list
		jsr	unlock_handles
		bcs	@oops
		lda	eof_list.eof		;is there anything in the file?
		ora	eof_list.eof+2
		bne	@oops			;actually no error
@no_way
		lda	#not_load_file		;Incompatible file format
		sec
@oops
		rts				;return error
		endp
		
		eject
;====================================================================================================
;conv_attributes:	This routine will convert the attributes in the segment header to
;			memory manager attributes
;
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;		HET_Entry_ptr			;must be setup
;		Seg_header_ptr			;must be setup
;
;Output:        A = Memory Manager Attributes
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;====================================================================================================

mm_attr_tbl	record

;Attr_Locked	1 = segment is locked when allocated
;Attr_fixed	1 = segment can't move while it is in memory 
;attr_no_cross	1 = segment may not cross a bank boundary
;attr_no_spec	1 = segment may not use special memory
;attr_page	1 = segment will be page aligned
;attr_addr	1 = segment will remain at fixed address
;attr_bank	1 = segment must remain in fixed bank

		dc.w	attr_locked+attr_fixed+attr_no_cross
		dc.w	attr_locked+attr_fixed+attr_no_cross+attr_bank
		dc.w	attr_locked+attr_fixed+attr_no_cross+attr_no_spec
		dc.w	attr_locked+attr_fixed+attr_no_cross+attr_no_spec+attr_bank
		dc.w	attr_locked+attr_no_cross
		dc.w	attr_locked+attr_no_cross+attr_bank
		dc.w	attr_locked+attr_no_cross+attr_no_spec
		dc.w	attr_locked+attr_no_cross+attr_no_spec+attr_bank
		
		dc.w	attr_locked+attr_fixed
		dc.w	attr_locked+attr_fixed+attr_bank
		dc.w	attr_locked+attr_fixed+attr_no_spec
		dc.w	attr_locked+attr_fixed+attr_no_spec+attr_bank
		dc.w	attr_locked
		dc.w	attr_locked+attr_bank
		dc.w	attr_locked+attr_no_spec
		dc.w	attr_locked+attr_no_spec+attr_bank
		endr
		
		
		longa	on
		longi	on		
conv_attributes	proc
		with	data
		
		ldy	#seg_kind_offset	;get the segment kind
		lda	[seg_header_ptr],y
		sta	seg_kind		;save the word for later
		xba				;get the segment attributes
		lsr	a
		lsr	a
		lsr	a			;move abs. bank, special mem, and pos. independent
		and	#$0007			;clear other garbage
		sta	mm_attr
;
;If the bank size = $10000 then we must set the no_cross bit in the attribute
;
		ldx	#$0008			;default is can cross
		ldy	#bank_size_offset	;get the bank size please
		lda	[seg_header_ptr],y
		bne	@can_cross		;it must be able to cross
		iny
		iny
		lda	[seg_header_ptr],y	;get the high please
		beq	@can_cross		;we can cross bank boundaries
		ldx	#$0000		
;
;now we get the memory manager attributes
;
; We have now handled the following bits:
;
;	(1)	absolute Bank
;	(2)	special Memory
;	(3)	position independent
;	(4)	bank crossing
;
@can_cross
		txa
		ora	mm_attr
		asl	a
		tax
		lda	mm_attr_tbl,x		;get the correct atributes for memory manager
;
;We still need to handle the following things:
;
;	(1)	Purge Level	(3 for dynamics)
;	(2)	Alignment 	(page and Bank)
;	(3)	Org 		(fixed address)
		
		ldx	seg_kind
		bpl	@its_static		;this is a static segment
		ora	#purge_level_3		;set the purge level to three for dynamics
@its_static
		sta	mm_attr
		
		ldx	#attr_Page		;default is page aligned
		ldy	#align_offset		;offset to the alignment field
		lda	[seg_header_ptr],y
		beq	@align_high
		cmp	#257
		bcc	@set_aligned		;align to a page boundary
		ldx	#attr_bank_align	;force bank alignment
		bra	@set_aligned
@align_high
		iny
		iny
		ldx	#attr_bank_align	;force bank alignment
		lda	[seg_header_ptr],y
		beq	@do_org			;there is no alignment
@set_aligned
		txa
		tsb	mm_attr			;add in the alignment bit
@do_org
		ldy	#org_offset		;offset to segment org
		lda	[seg_header_ptr],y
		sta	org_address
		iny
		iny
		lda	[seg_header_ptr],y
		sta	org_address+2
		ora	org_address
		beq	@no_org

		lda	org_address		;if the low byte is non-zero then fixed attr = true
		bne	@do_fixed_addr
		lda	seg_kind		;see if this is a absolute bank segment
		and	#kind_abs_bank
		bne	@no_org			;This is absolute bank but not fixed address
		
@do_fixed_addr
		lda	#attr_addr		;block must remain at fixed addr
		tsb	mm_attr
@no_org
		lda	seg_kind		;see if this is an absolute Bank only
		tay
		and	#kind_bank_bit		;see if this segment is aligned in any bank
		beq	@not_aligned_in_bank
		
		lda	mm_attr
		ora	#attr_align_in_bank	;segment is aligned within the bank
		sta	mm_attr
		
;
;Now we need to handle the direct page / stack segment
;
@not_aligned_in_bank
		tya
		bit	#kind_abs_bank		;absolute bank segment?
		bne	@is_abs			;yes, allow special memory
		and	#kind_only		;clear attributes
		cmp	#dp_seg_type		;DP/Stack segment?
		bne	@no_stack		;no, conditionalize special memory bit
		
		lda	mm_attr
		ora	#attr_page+attr_bank	;fixed bank and page aligned
		sta	mm_attr
		rts				;skip special memory flag

@is_abs
		lda	mm_attr			;must return attributes in accumulator
		and	#Åattr_no_spec
		sta	mm_attr
		rts

@no_stack
		lda	mm_attr
		ldx	spec_mem_flag		;check the special memory flag
		beq	@skip_spec
		ora	#attr_no_spec		;sorry bud no special memory for you
		sta	mm_attr
		
@skip_spec
		rts
		endp
		
		eject
;====================================================================================================
;reset_jmp_tables:	This routine will mark all jump table segments as unloaded for a given
;			user id
;
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;		ExpressHandle		;must be setup
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
reset_jmp_tables	proc
		with	data
		
		lda	[HET_ptr]		;get the number of entries in table
		inc	a			;start from the last segment
		inc	a
		tax
@search_loop
		txa				;pass in the segment number
		beq	@end_reset		;sorry there is no segment by this name
		phx
		jsr	setup_seg_ptrs		;we are now in business
		ldy	#flags_offset		;see if this is a jump segment
		lda	[HET_Entry_ptr],y
		and	#jmp_type
		beq	@not_jump
		jsr	clr_table		;clear this segment
@not_jump
		plx
		dex				;back off by one and try again
		cpx	#$0001
		bne	@search_loop
@end_reset	
		clc
		rts
clr_table
		ldy	#handle_offset

		lda	[HET_Entry_ptr],y
		sta	temp_handle
		iny
		iny
		lda	[HET_Entry_ptr],y
		sta	temp_handle+2

		ldy	#$0002			;point to the first entry in table
		clc
		lda	[temp_handle]
		adc	#seg_jmp_start
		sta	temp_ptr
		lda	[temp_handle],y
		adc	#$0000
		sta	temp_ptr+2
@loop
		ldy	#$0002			;see if we are done
		lda	[temp_ptr],y
		beq	@done
		
		lda	user_id			;see if this is the user ID
		cmp	[temp_ptr]
		bne	@next_entry
		
		ldy	#$000A			;index to the JSL instruction
		lda	jump_load_instr		;store the Jump Load Instruction
		sta	[temp_ptr],y
		iny
		iny
		lda	jump_load_instr+2
		sta	[temp_ptr],y
@next_entry
		clc
		lda	temp_ptr
		adc	#jmp_entry_size		;size of one entry
		sta	temp_ptr
		lda	temp_ptr+2
		adc	#$0000
		sta	temp_ptr+2
		bra	@loop
@done
		rts
		endp
		
		eject
;====================================================================================================
;Make_Purgable:	This routine will make segment purgable and unlocked
;
;
;Input:         A = segment_number
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;		ExpressHandle		;must be setup
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
Make_Purgable	proc
		with	data

		sta	search_seg		;segment we need to nuke
		jsr	make_HET_ptr
		lda	search_seg
		jsr	setup_seg_ptrs		;point to the entry please

		ldy	#flags_offset		;see of it is loaded
		lda	[HET_entry_ptr],y
		bmi	@do_it
@no_seg		lda	#seg_not_found		;seg_not_found
		sec
		rts
@do_it
		ldy	#handle_offset		;lets get the handle
		lda	[HET_entry_ptr],y
		tax
		iny
		iny
		lda	[HET_entry_ptr],y
		tay
		bne	@have_handle
		txa
		beq	@no_Seg
@have_handle
		pea	$0003			;make it purgable
		phy
		phx				;push the handle
		
		stx	temp_handle
		sty	temp_handle+2		;handle to the segment
		ldy	#$0004			;lets unlock this puppy
		lda	[temp_handle],y
		and	#$7FFF
		sta	[temp_handle],y

		ldy	#flags_offset		;mark this segment as Purgable
		lda	[HET_entry_ptr],y
		ora	#$0001
		sta	[HET_Entry_ptr],y	;segment is now marked purgable

		jsr	reset_jmp_tables	;go and reset the jump tables for this ID		
		
		ldx	#$2402			;SetPurgeLevel
		jsl	$e10000
		rts				;return any error
		endp

		eject
;====================================================================================================
;purge_all_dyn:	This routine will mark all dynamic segments as purgable
;
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;		ExpressHandle		;must be setup
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
purge_all_dyn	proc
		with	data


		lda	[HET_ptr]		;get the number of entries in table
		inc	a			;start from the last segment
		inc	a
		tax
@search_loop
		txa				;pass in the segment number
		beq	@end_purge		;sorry there is no segment
		phx
		jsr	setup_seg_ptrs		;we are now in business

		ldy	#seg_kind_offset	;lets check the kind please
		lda	[seg_header_ptr],y
		bpl	@skip_it		;skip the segment if it is not dynamic
		
		ldy	#flags_offset		;mark this segment as Purgable
		lda	[HET_entry_ptr],y
		bpl	@skip_it		;the segment is already unloaded
		
		lda	1,s			;get the seg number
		jsr	make_purgable
@skip_it
		plx
		dex				;back off by one and try again
		cpx	#$0001
		bne	@search_loop
@end_purge
		clc
		rts
		endp
		
		eject
;====================================================================================================
;mark_all_purgable:	This routine will mark all segments as purgable
;
;
;Input:         A =undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;		ExpressHandle		;must be setup
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
mark_all_purgable	proc
		with	data


		lda	[HET_ptr]		;get the number of entries in table
		inc	a			;start from the last segment
		inc	a
		tax
@search_loop
		txa				;pass in the segment number
		beq	@end_purge		;sorry there is no segment
		phx
		jsr	setup_seg_ptrs		;we are now in business
		lda	1,s			;get the seg number
		jsr	mark_purged
@skip_it
		plx
		dex				;back off by one and try again
		cpx	#$0001
		bne	@search_loop
@end_purge
;
;		 unlock	all load segments
;
		lda	User_ID			;push the User ID
		pha
		ldx	#$2302
		jsl	$e10000			
;		_HUnlockAll

;
;		 purge all other dynamic segments
;
		lda	User_ID			;push the User ID
		pha
		ldx	#$1302
		jsl	$e10000
		
;		_PurgeAll
;
;		 make all static segments purgeable
;
		pea	$0003			;Purge Level
		lda	User_ID			;push the User ID
		pha
		ldx	#$2502
		jsl	$e10000

;		push	#3			;PurgeLevel
;		push	OUserID			;Owner
;		_SetPurgeAll

		clc
		rts


mark_purged
		sta	search_seg		;segment we need to nuke
		jsr	make_HET_ptr
		lda	search_seg
		jsr	setup_seg_ptrs		;point to the entry please

		ldy	#flags_offset		;see of it is loaded
		lda	[HET_entry_ptr],y
		bmi	@do_it
@no_seg		lda	#seg_not_found		;seg_not_found
		sec
		rts
@do_it
		ldy	#handle_offset		;lets get the handle
		lda	[HET_entry_ptr],y
		tax
		iny
		iny
		lda	[HET_entry_ptr],y
		tay
		bne	@have_handle
		txa
		beq	@no_Seg
@have_handle
		
		stx	temp_handle
		sty	temp_handle+2		;handle to the segment
		ldy	#$0004			;lets unlock this puppy
		lda	[temp_handle],y
		and	#$7FFF
		sta	[temp_handle],y

		ldy	#flags_offset		;mark this segment as Purgable
		lda	[HET_entry_ptr],y
		ora	#$0001
		sta	[HET_Entry_ptr],y	;segment is now marked purgable

		jsr	reset_jmp_tables	;go and reset the jump tables for this ID
		clc
		rts		
		endp
		
		eject
;====================================================================================================
;lock_statics:	This routine will check and see if all the static segments are loaded.  It will
;		also lock all the static segments that it finds.  If any of the static segments
;		have been purged the routine will error out with the carry set
;
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;		ExpressHandle		;must be setup
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error all static segments are not loaded
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
lock_statics	proc
		with	data
		stz	temp_word		;If zero on exit then there were no static segments
		
		jsr	make_HET_ptr		;convert ExpressHandle into pointers
		
		lda	[HET_ptr]		;get the number of entries in table
		inc	a			;start from the last segment
		inc	a
		tax
@search_loop
		txa				;pass in the segment number
		beq	@end_lock		;sorry there is no segment
		phx
		jsr	setup_seg_ptrs		;setup pointer to the Header Entry
		jsr	lock_it
		plx
		bcs	@error_out
		dex				;back off by one and try again
		cpx	#$0001
		bne	@search_loop
@end_lock
		lda	temp_word		;see if we encountered any static segments
		beq	@error_out
		clc
		rts
@error_out
		sec				;sorry there are no static segments or not all
						;segments are still in memory
		rts
lock_it
		ldy	#flags_offset		;first lets see if this is a static segment
		lda	[het_entry_ptr],y
		and	#stat_type
		beq	@not_static		;its not static so we do not care about the segment
		
		sta	temp_word		;this is used as a flag to indicate that there are
						;static segments that can be locked
		ldy	#handle_offset		;now lets see if the segment has been purged
		lda	[het_entry_ptr],y
		tax
		iny
		iny
		lda	[het_entry_ptr],y
		tay
		bne	@handle_OK
		txa
		bne	@handle_OK
		sec
		rts				;the handle is scewed up
@handle_OK
		stx	temp_handle
		sty	temp_handle+2
		ldy	#$0002
		lda	[temp_handle]
		tax
		lda	[temp_handle],y		;get the address please
		tay
		bne	@handle_valid
		txa
		bne	@handle_valid		;the handle is still good
		sec
		rts
@handle_valid
		ldy	#$0004			;now lets lock the handle please
		lda	[temp_handle],y
		ora	#$8000			;set the lock bit
		sta	[temp_handle],y
		
		pea	#$0000			;set the purge level to zero
		pei	temp_handle+2
		pei	temp_handle
		ldx	#$2402			;SetPurge call to the memory manager
		jsl	$e10000			;call the tool locator
		rts				;carry is set based on the call.
		
@not_static
		clc
		rts
		endp
		
		eject
;====================================================================================================
;lock_segment:	This routine will make segment purgable and locked
;
;
;Input:         A = segment_number
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;		ExpressHandle		;must be setup
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
lock_segment	proc
		with	data

		sta	search_seg		;segment we need to lock
		jsr	make_HET_ptr
		lda	search_seg		;segment we need to lock
		jsr	setup_seg_ptrs		;point to the entry please

		ldy	#flags_offset		;see of it is loaded
		lda	[HET_entry_ptr],y
		lsr	a
		bcs	@do_it			;yep the segment is unlocked
		clc
		rts
@do_it
		ldy	#handle_offset		;lets get the handle
		lda	[HET_entry_ptr],y
		tax
		iny
		iny
		lda	[HET_entry_ptr],y
		tay
		bne	@have_handle
		txa
		beq	@no_Seg
@have_handle
		phy
		phx				;push the handle
		
		stx	temp_handle
		sty	temp_handle+2		;handle to the segment
		
		ldy	#$0002			;deref the handle to see if it is nill
		lda	[temp_handle]
		tax
		lda	[temp_handle],y
		tay
		bne	@lock_it
		txa
		bne	@lock_it
		
		ldy	#flags_offset		;mark segment as gone
		lda	#$0000
		sta	[HET_entry_ptr],y
		ldy	#handle_offset
		sta	[HET_entry_ptr],y
		iny
		iny
		sta	[HET_entry_ptr],y	;zero the handle also
		
		jsr	clear_handles		;clear local copy of handle
		ldx	#$1002			;dispose handle
		jsl	$e10000
		stz	temp_handle
		stz	temp_handle+2		;Temp Handle is not valid
@no_seg
		lda	#seg_not_found
		sec
		rts				;indicate segment is gone
		
@lock_it	ldy	#$0004			;lets lock this puppy
		lda	[temp_handle],y
		ora	#$8000
		sta	[temp_handle],y

		ldy	#flags_offset		;mark this segment as locked
		lda	[HET_entry_ptr],y
		and	#$FFFE			;clear the Unlocked Bit
		sta	[HET_Entry_ptr],y	;segment is now marked purgable
		plx
		ply
		clc				;indicate segment is safely locked down
		rts
		endp
		
		eject
;====================================================================================================
;load_segment:	This routine will load a segment into memory
;
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;		HET_Entry_ptr			;must be setup
;		Seg_header_ptr			;must be setup
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
load_segment	proc
		with	data
		
		
		stz	reloc_handle
		stz	reloc_handle+2
		ldy	#reloc_dict_offset	;set handle to zero
		lda	#$000
		sta	[seg_header_ptr],y
		iny
		iny
		sta	[seg_header_ptr],y
		
		jsr	conv_attributes		;convert the attributes to something useful
;
;On exit conv_attributes sets A to memory manager Attributes
;
		sta	mem_attr
		
		ldy	#$0002
		lda	[seg_header_ptr]
		tax
		lda	[seg_header_ptr],y
		tay
		lda	#absolute
		jsr	set_mark
		bcc	@mark1_set
@oops		rts				;return the error
@mark1_set
		ldy	#seg_size_offset	;now lets get the size of the segment
		lda	[seg_header_ptr],y
		sta	read_list.cnt
		sta	LConst_size
		iny
		iny
		lda	[seg_header_ptr],y	;get the high count
		sta	read_list.cnt+2
		sta	LConst_Size+2
;
;Now lets see if we already have memory.  We will have memory if we are reloading a restart segment
;
		ldy	#handle_offset		;see if we already have the memory segment
		lda	[het_entry_ptr],y
		tax
		iny
		iny
		lda	[het_entry_ptr],y
		tay
		bne	@skip_alloc		;we already have the memory
		txa
		bne	@skip_alloc		;this must be a restart call

		lda	seg_kind		;what kind of segment is it?
		bit	#kind_abs_bank		;absolute bank segment?
		bne	@just_allocate		;yes, use attributes as is
		and	#kind_only
		cmp	#dp_seg_type		;is it a DP segment?
		beq	@just_allocate		;yes, so we HAVE to allow special memory
		lda	mem_attr		;get the original attributes
		pha				;save 'em
		ora	#attr_no_spec		;set the 'no-special-memory' bit
		sta	mem_attr
@try_again
		ldx	read_list.cnt
		ldy	read_list.cnt+2		;load the number of bytes to allocate for the segment
		jsr	alloc_lconst_seg	;allocate the memory for the segment
		bcs	@had_error
		pla				;restore original attributes
		sta	mem_attr
		bra	@skip_alloc		;all is fine, continue

@had_error
		plx				;retrieve original attributes
		tay				;save error code
		lda	mem_attr		;get the attributes we just used
		and	#$0008			;did we allow special memory?
		beq	@oops2			;yes, and still had a problem!
		txa				;get the original attributes
		and	#$0008			;did they allow special memory?
		bne	@oops2			;no, don't override their wishes
		stx	mem_attr		;restore original attributes
		phx				;back on stack
		bra	@try_again		;go back and try to allocate again

@oops2
		tya				;restore error code
		bra	@oops			;and exit

@just_allocate
		ldx	read_list.cnt
		ldy	read_list.cnt+2		;load the number of bytes to allocate for the segment
		jsr	alloc_lconst_seg	;allocate the memory for the segment
		bcs	@oops
@skip_alloc
		stx	temp_handle
		stx	seg_handle
		sty	temp_handle+2
		sty	seg_handle+2
		
		ldy	#handle_offset		;update the handle address in HET entry
		txa
		sta	[HET_entry_ptr],y
		lda	temp_handle+2
		iny
		iny
		sta	[HET_entry_ptr],y
		
		ldy	#$0002			;deref the handle please
		lda	[temp_handle]
		sta	base_ptr		;address of the image
		tax
		lda	[temp_handle],y
		sta	base_ptr+2
		tay
		
		jsr	read_wBuf_ptr		;read in the segment please
		bcc	@add_seg_offset
		rts
@add_seg_offset
		jsr	add_segment_offset	;add seg offset to base_ptr return value in X&Y

		entry	load_reloc_dict
load_reloc_dict					;go ahead and load the relocation dictionary
;
;Now lets do the relocation dictionary
;
		ldy	#reloc_mark_offset
		lda	[seg_header_ptr],y
		tax
		iny
		iny
		lda	[seg_header_ptr],y
		tay
		bne	@data_avail
		txa
		beq	@its_loaded
@data_avail
		lda	#absolute
		jsr	set_mark
		bcc	@mark2_set
		rts				;return the error
@mark2_set
		ldy	#reloc_size_offset	;now lets get the size of the segment
		clc
		lda	[seg_header_ptr],y
		adc	#$0001
		sta	read_list.cnt
		tax
		iny
		iny
		lda	[seg_header_ptr],y	;get the high count
		adc	#$0000
		sta	read_list.cnt+2
		tay

		lda	read_list.cnt		;check for a zero length relocation dictionary
		dec	a
		ora	read_list.cnt+2
		beq	@its_loaded
		
		jsr	alloc_mem		;allocate the memory for the segment
		stx	temp_handle
		stx	reloc_handle
		sty	temp_handle+2
		sty	reloc_handle+2
		
		ldy	#reloc_dict_offset	;save handle to relocation dictionary
		lda	temp_handle
		sta	[seg_header_ptr],y
		iny
		iny
		lda	temp_handle+2
		sta	[seg_header_ptr],y
		
		ldy	#$0002			;deref the handle please
		lda	[temp_handle]
		tax
		lda	[temp_handle],y
		tay
		
		jsr	read_wBuf_ptr		;read in the segment please
		bcc	@its_loaded
		rts
@its_loaded
		ldy	#flags_offset
		lda	[het_entry_ptr],y
		ora	#$8000			;mark segment loaded
		sta	[het_entry_ptr],y
		
		lda	seg_kind
		and	#kind_only		;lets see if this is a jump table segment
		cmp	#jmp_tbl_seg
		bne	@not_jump
		jsr	patch_jmp_tbl		;we need to setup the jump table entries

		ldy	#flags_offset		;mark segment as a Jump Segment
		lda	[HET_Entry_ptr],y
		ora	#jmp_type
		sta	[HET_entry_ptr],y
@not_jump
		lda	seg_kind		;see if the segment is dynamic or static
		bmi	@its_dynamic
		ldy	#flags_offset		;set the static bit please
		lda	[HET_Entry_ptr],y
		ora	#stat_type
		sta	[HET_entry_ptr],y
@its_dynamic
		clc
		rts
patch_jmp_tbl
		clc
		lda	base_ptr		;please point to the first segment entry
		adc	#seg_jmp_start
		sta	temp_ptr
		lda	base_ptr+2
		adc	#$0000
		sta	temp_ptr+2		;point to the first entry
@loop
		ldy	#$0002			;see if we are done
		lda	[temp_ptr],y
		beq	@done
		
		lda	user_id			;save the ID please
		sta	[temp_ptr]
		
		ldy	#$000A			;index to the JSL instruction
		lda	jump_load_instr		;store the Jump Load Instruction
		sta	[temp_ptr],y
		iny
		iny
		lda	jump_load_instr+2
		sta	[temp_ptr],y
@next_entry
		clc
		lda	temp_ptr
		adc	#jmp_entry_size		;size of one entry
		sta	temp_ptr
		lda	temp_ptr+2
		adc	#$0000
		sta	temp_ptr+2
		bra	@loop
@done
		rts
		
		Export	add_segment_offset
add_segment_offset
		ldy	#seg_entry_offset	;See if this segment is the main segment
		lda	[seg_header_ptr],y
		tax
		iny
		iny
		lda	[seg_header_ptr],y	;get the high word
		tay
		bne	@Seg_offset_true	;we must override the first segment
		txa
		bne	@Seg_offset_true

		ldx	#$0000
		txy
@seg_offset_true
		clc
		txa				;get the low word of the offset
		adc	base_ptr
		sta	segment_entry
		tya				;get the high word of the segment offset
		adc	base_ptr+2
		sta	segment_entry+2
		rts
		endp

		eject
;====================================================================================================
;find_seg_name:	This routine will locate a segment by name
;
;
;Input:         A = undefined
;               X = low word pointer to name
;               Y = high word pointer to the name
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;		ExpressHandle		;must be setup
;
;Output:        A = segment number if found
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = segment not found
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
find_Seg_name	proc
		with	data
		
		stx	path_ptr
		sty	path_ptr+2		;segment name pointer
		
		jsr	Make_HET_ptr		;setup pointer to the Header Entry Table
		lda	[HET_ptr]		;get the number of entries in table
		inc	a			;start from the last segment
		inc	a
		tax
@search_loop
		txa				;pass in the segment number
		beq	@not_found		;sorry there is no segment by this name
		phx
		jsr	setup_seg_ptrs		;we are now in business
		jsr	compare_names		;see if this is the one
		bcc	@found_it		;we have located the correct segment
		plx
		dex				;back off by one and try again
		cpx	#$0001
		bne	@search_loop
@not_found
		sec
		rts				;segment is not in ExpressLoad header
		
@found_it	pla				;return the segment number
		clc
		rts				;return to the caller with the good news		
compare_names	
		clc
		ldy	#seg_name_disp		;get the displacement
		lda	[seg_header_ptr],y
		adc	#name_overhead
		clc
		adc	seg_header_ptr
		sta	temp_ptr
		lda	#$0000
		adc	seg_header_ptr+2
		sta	temp_ptr+2		;temp_ptr now points to the segment name (PString)
 if 0 then
;
;Special note:  For some reason, segment names may or may not have a length byte.
;		This means that I have to make a best guest as to the type of string.
;		If the first byte is less the $20 (Space) then I assume it is a length byte.
;
		lda	[temp_ptr]
		and	#$00ff
		cmp	#$0020
		bcc	@is_length		;there is a length byte
		
		lda	temp_ptr
		bne	@only_low
		dec	temp_ptr+2
@only_low	dec	a
		sta	temp_ptr		;point to one less then the name
		longa	off
		longi	off
		sep	#$30
		ldy	#$0001			;start counting characters
@count_loop
		lda	[temp_ptr],y
		cmp	#' '
		beq	@save_size
		iny
		bra	@count_loop
@save_size
		dey
		tya
		sta	[temp_ptr]		;opdate the length please
;
;now adjust the displacement so the string will always have a length
;
		ldy	#seg_name_disp		;get the displacement
		lda	[seg_header_ptr],y	;adjust the displacement for the next time
		dec	a
		sta	[seg_header_ptr],y
 else
		ldy	#lablen_offset		;offset to label length field in header
		lda	[seg_header_ptr],y	;get the value
		and	#$00ff			;it's only a byte wide
		beq	@is_length		;length is first byte of string (Pascal style)
		ldy	temp_ptr		;else decrement the string pointer
		bne	@only_low
		dec	temp_ptr+2
@only_low
		dec	temp_ptr
		sep	#$20			;8-bit store here
		sta	[temp_ptr]		;store the string length (from lablen)
		rep	#$20
 endif
@is_length
		longa	off
		longi	off
		sep	#$30
		lda	[path_ptr]		;get the length of the input name
		tay
		cmp	[temp_ptr]
		bne	@not_it			;the length is not the same
		
@compare_loop
		lda	[temp_ptr],y		;get the character
		cmp	#'a'
		bcc	@no_convert
		cmp	#'z'+1
		bcs	@no_convert
		and	#$DF			;convert to upper case
@no_convert
		cmp	[path_ptr],y		;see if the characters are the same
		beq	@check_next
		
		sta	temp_word		;save for compare
		lda	[path_ptr],y		;get char from callers area
		cmp	#'a'
		bcc	@not_it			;it cannot be the one
		cmp	#'z'+1
		bcs	@not_it
		and	#$DF			;convert to upper case
		cmp	temp_word
		bne	@not_it			;sorry wrong name
@check_next
		dey
		bne	@compare_loop		;keep looking
		rep	#$30
		clc
		rts				;We have found the segment!
		
@not_it
		rep	#$30
		sec
		rts
		
		endp
		
		eject
;====================================================================================================
;save_dp_info:	This routine will save the direct page address
;
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
save_dp_info	proc
		with	data
		
		lda	segment_entry		;address of the stack direct page
		sta	stack_addr
		lda	LConst_size		;save the size please
		sta	stack_size
		rts
		
		endp

		eject
;====================================================================================================
;load_statics:	This routine will load all static segments
;
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;		HET_ptr			;must be setup
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
load_statics	proc
		with	data
		
		tsx				;save the stack pointer
		stx	stack
		
		stz	starting_addr
		stz	starting_addr+2
		stz	stack_addr		;there is no stack
		stz	stack_size
		
static_loop
		lda	#any_kind		;lets find all static segments that are left
		ldx	#static_only		;don't look at other bits
		ldy	#unloaded_state		;skip loaded segments
		jsr	find_segment		;do the search
		bcc	@another_seg
		clc
@oops		rts				;return with no error

@another_seg
		jsr	load_segment		;load the segment into memory
		bcs	@oops
		ldy	#seg_kind_offset	;lets see if this is a Stack/Direct Page segment
		lda	[seg_header_ptr],y	;If it is then save the correct Info.
		and	#kind_only
		cmp	#dp_seg_type		;lets find the stack seg please
		bne	@not_stack

		jsr	save_dp_info		;save stack and Direct page info
		bra	not_first		;even if it is skip it please
		
@not_stack	cmp	#init_seg_type		;is this an initilization segment?
		beq	run_init_seg		;go ahead and run the segment

		lda	starting_addr
		ora	starting_addr+2
		bne	not_first		;this is not the first segment
;
;If this is the first segment then save it's starting address so we can return it to the caller
;
		lda	segment_entry
		sta	starting_addr		;save the starting address that we will jump to
		lda	segment_entry+2
		sta	starting_addr+2
not_first
		lda	loaded_seg_num		;save the seg number
		pha
		jsr	static_loop
		bcs	fix_stack_abort		;exit if an error occurred
		pla
		jsr	process_reloc
		bcs	fix_stack_abort		;mjor problems
		rts
		
run_init_seg
		lda	loaded_seg_num		;the init segment we just loaded!
		jsr	process_reloc
		bcs	fix_stack_abort		;exit with the error

		lda	segment_entry		;address of the segment just loaded
		sta	self_mod+1
		lda	segment_entry+1
		sta	self_mod+2		;make a self modifing address to run init segment

		jsr	lock_handles
		tdc				;save my direct page
		pha
		lda	#$0000
		tcd				;set direct register to real zero page
self_mod	jsl	>$000000
		rep	#$30			;restore 16 bit mode
		pla				;restore direct register
		tcd
		phk
		plb				;set my bank please
		jsr	unlock_handles
		bra	static_loop		;load any other init segs please

fix_stack_abort
		ldx	stack
		txs				;restore the stack pointer please
		rts				;return the error to the caller
		endp

		eject
;====================================================================================================
;save_start:	This routine will save the starting address and stack info in the user_id_table
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;		user_id_ptr
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
save_start	proc
		with	data

		ldy	#id_stack_addr		;save the address of the stack/direct page
		lda	stack_addr
		sta	[user_id_ptr],y
		ldy	#id_stack_size		;also save the size
		lda	stack_size
		sta	[user_id_ptr],y
		ldy	#id_start_addr
		lda	starting_addr		;save the starting address of the application
		sta	[user_id_ptr],y
		iny
		iny
		lda	starting_addr+2
		sta	[user_id_ptr],y
		clc
		rts
		entry	restore_start
restore_start

		ldy	#id_stack_addr		;get the address of the stack/direct page
		lda	[user_id_ptr],y
		sta	stack_addr
		ldy	#id_stack_size		;get save the size
		lda	[user_id_ptr],y
		sta	stack_size
		ldy	#id_start_addr
		lda	[user_id_ptr],y
		sta	starting_addr
		iny
		iny
		lda	[user_id_ptr],y
		sta	starting_addr+2
		clc
		rts
		endp
		
		eject
;====================================================================================================
;reload_restart:	This routine will scan the ExpressLoad segment looking for a restart segment
;		If any are found they will be loaded into the same address as they were before.
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;		ExpressHandle
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
reload_restart	proc
		with	data
		jsr	make_HET_ptr
		
		lda	[HET_ptr]		;get the number of entries in table
		inc	a			;start from the last segment
		inc	a
		tax
@search_loop
		txa				;pass in the segment number
		beq	@end_restarts		;sorry there is no segment
		phx
		sta	loaded_seg_num
		jsr	setup_seg_ptrs		;we are now in business
		jsr	do_restarts
@skip_it
		plx
		bcs	@restart_error
		dex				;back off by one and try again
		cpx	#$0001
		bne	@search_loop
@end_restarts
		clc
@restart_error
		rts
		
do_restarts
		ldy	#seg_kind_offset
		lda	[seg_header_ptr],y	;get the segment kind field to determine if this
		and	#reload_segment		;segment needs to be reloaded.
		beq	@not_reload
		jsr	load_restart		;major pain in the butt!
@not_reload
		clc
		rts

load_restart
		lda	file_open		;is the file already open?
		bne	@skip_open		;someone has already opened the file

		jsr	open_load_file		;open the file please
		bcs	@load_exit
@skip_open
		jsr	load_segment		;load the segment into memory
		bcs	@load_exit		;bad news
		lda	loaded_seg_num		;now relocate the segment
		jsr	process_reloc		;process the segment
@load_exit
		rts
		
		endp

		eject
;====================================================================================================
;reload_inits:	This routine will scan the ExpressLoad segment looking for init segments.  If it finds
;		an init segment it will pass control to that segment
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;		ExpressHandle
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
reload_inits	proc
		with	data
		jsr	make_HET_ptr
		
		lda	[HET_ptr]		;get the number of entries in table
		inc	a			;start from the last segment
		inc	a
		tax
@search_loop
		txa				;pass in the segment number
		beq	@end_inits		;sorry there is no segment
		phx
		sta	loaded_seg_num
		jsr	setup_seg_ptrs		;we are now in business
		jsr	do_inits
@skip_it
		plx
		bcs	@init_error
		dex				;back off by one and try again
		cpx	#$0001
		bne	@search_loop
@end_inits
		clc
@init_error
		rts
		
do_inits
		ldy	#seg_kind_offset
		lda	[seg_header_ptr],y	;get the segment kind field to determine if this
		and	#kind_only
		cmp	#init_seg_type
		beq	@do_init_type
		clc
		rts
@do_init_type
		ldy	#handle_offset		;get the handle to the segment
		lda	[het_entry_ptr],y
		tax
		iny
		iny
		lda	[het_entry_ptr],y
		tay
		bne	@have_handle
		tax
		bne	@have_handle
		sec
		rts				;return the handle
@have_handle
		stx	temp_handle
		sty	temp_handle+2
		ldy	#$0001
		lda	[temp_handle]
		sta	self_mod+1
		lda	[temp_handle],y
		sta	self_mod+2
		jsr	lock_handles

		tdc				;save my direct page
		pha
		lda	#$0000
		tcd				;set direct register to real zero page
self_mod	jsl	>$000000
		rep	#$30			;restore 16 bit mode
		pla				;restore direct register
		tcd
		phk
		plb
		jsr	unlock_handles
		clc
		rts
		endp

		eject
;====================================================================================================
;jump_load:	This routine is used to load segments via the Jump Table
;
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;		On the stack is the return address of the routine that called me
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error	;If this happens I would be suprized
;               b = k
;
;
; Jump Table Entry
;
;		User_ID			2
;		Load_File Number	2
;		Load Segment Number	2
;		Load Segment Offset	4
;		JSL to Jump-table load	4
;
;====================================================================================================
	
		longa	on
		longi	on		
jump_load	proc
		with	data
;
; -------------
; Bank Register
; -------------
; Return addr
; -------------
;
		phb			;save the callers bank
		phk
		plb			;set my bank please		
;
; ----------------
; Processor Status
; ----------------
; Bank Register
; ----------------
; Return Address
; ----------------
; Return Address
; of main routine
; ----------------
;
		php			;save the m and x bits
		
		rep	#$30		;16 bit mode
		sta	save_a
		stx	save_x
		sty	save_y		;save apps registers
;
; ----------------
; Return Address
; of main routine
; ----------------
;
		plx			;get the processor status + Bank registe

		pla			;get the low word of the return address
		sta	starting_addr

		sep	#$20		;8 bit mode
		pla
		sta	starting_addr+2
		stz	starting_addr+3
		rep	#$20		;16 bit
;
; ----------------
; Processor Status
; ----------------
; Bank Register
; ----------------
; Return Address
; of main routine
; ----------------
		phx			;push back the processor status and bank register
;
; ----------------
; Direct Register
; ----------------
; Processor Status
; ----------------
; Bank Register
; ----------------
; Return Address
; of main routine
; ----------------
		phd				;save the apps direct register please

;
;Now we need to setup our stuff
;
		lda	my_dir_page		;setup my direct register
		tcd

		jsr	reset_local_mark

		sec
		lda	starting_addr		;build a pointer to the start of the info
		sbc	#jmp_entry_size-1
		sta	jmp_tbl_ptr
		lda	starting_addr+2
		sbc	#$0000
		sta	jmp_tbl_ptr+2		;temp_ptr points to Jump Table Entry
		
		lda	[jmp_tbl_ptr]		;get the user ID
		sta	user_id			;update the global User ID
		jsr	find_user_id
		bcc	@found_it
		lda	#User_id_err		;no way bud!! my system is messed up
		jsr	error_routine		;Time to go see Freddy (No Return)
@found_it
		ldy	#$0002			;get handle to the ExpressLoad segment
		lda	[temp_ptr],y
		sta	ExpressHandle
		iny
		iny
		lda	[temp_ptr],y
		sta	ExpressHandle+2
		
		ldy	#$0002			;check the load file number
		lda	[jmp_tbl_ptr],y
		dec	a
		beq	@good_file
		lda	#incompatible_err	;This file is not ExpressLoad compatible
		jsr	error_routine		;sorry no can do.
@good_file
		iny
		iny
		lda	[jmp_tbl_ptr],y		;get the segment we need to find
		sta	search_seg

		iny
		iny
		lda	[jmp_tbl_ptr],y		;get the relative offset
		sta	jmp_patch_value
		iny
		iny
		lda	[jmp_tbl_ptr],y
		sta	jmp_patch_value+2

		ldx	ExpressHandle
		ldy	ExpressHandle+2
		jsr	merge_path
		
		clc
		ldy	#$0002
		lda	[ExpressHandle]
		adc	#extra_header		;load ExpressSegment past Extra Header
		tax
		clc
		adc	#$0004			;pass the link field
		sta	HET_ptr			;header entry table pointer
		lda	[ExpressHandle],y
		tay
		adc	#$0000
		sta	HET_ptr+2
		
		lda	search_seg
		dec	a
		sec
		sbc	ExpressSeg_pos		;0 or 1
		
		asl	a
		asl	a
		asl	a			;times 8 for HET entry size
		
		inc	a			;add two to pass the segment count field
		inc	a

		clc
		adc	HET_ptr			;make a pointer to the Entry
		sta	HET_Entry_ptr		;pointer to the entry itself
		lda	#$0000
		adc	HET_ptr+2
		sta	HET_Entry_ptr+2		
;
;Build a pointer to the segment header itself
;
		clc
		lda	HET_entry_ptr		;add in relative address to segment
		adc	[HET_Entry_ptr]
		sta	seg_header_ptr
		lda	HET_Entry_ptr+2
		adc	#$0000
		sta	seg_header_ptr+2
;
;Now lets see if the segment is already loaded into memory
;
		ldy	#flags_offset
		lda	[het_entry_ptr],y
		bpl	@new_segment		;we must load the segment from disk
		lsr	a			;see if the segment is marked as purgable
		bcc	@its_locked
		lda	search_seg		;pass in the segment number please
		jsr	lock_segment		;go and lock this segment
		bcs	@new_segment		;we have to reload the segment from disk
@its_locked
		ldy	#handle_offset		;get the base address
		lda	[het_entry_ptr],y
		sta	temp_handle
		iny
		iny
		lda	[het_entry_ptr],y
		sta	temp_handle+2

		ldy	#$0002			;get the real address
		lda	[temp_handle]
		sta	base_ptr
		lda	[temp_handle],y
		sta	base_ptr+2
		bra	@do_patch			
@new_segment
		jsr	open_load_file		;open the puppy
		bcc	@got_it
@oops
		jsr	error_routine		;sorry no can do. (No Return)
@got_it		
		jsr	lock_handles
		jsl	$e100a8			;get the current system preferences
		dc.w	$200F
		dc.l	preference_list
;
;Save the current user's preference please
;
		lda	preference_list.sys_prefs
		sta	preference_list.users_prefs
;
;Now ask the operating system to put up a mount dialog when I ask for a disk
;
		lda	#$C000			;ask the OS to put up the mount dialog
		sta	preference_list.sys_prefs
		
		jsl	$e100a8
		dc.w	$200C			;set the system preference
		dc.l	preference_list
		jsr	unlock_handles
		
		jsr	load_segment		;load the segment into memory
		bcs	@oops
		lda	search_seg		;relocate the segment
		jsr	process_reloc

		lda	preference_list.users_prefs
		sta	preference_list.sys_prefs
		jsr	lock_handles
		jsl	$e100a8
		dc.w	$200C			;restore the caller's system preference
		dc.l	preference_list
		jsr	unlock_handles

		jsr	close_load_file		;close the file
@do_patch
		clc				;add in the offset field
		lda	base_ptr
		adc	jmp_patch_value
		sta	base_ptr
		lda	base_ptr+2
		adc	jmp_patch_value+2
		sta	base_ptr+2
		
		ldy	#$000A			;offset to the JSL 
		longa	off
		sep	#$20
		lda	#$5C			;convert to a JML
		sta	[jmp_tbl_ptr],y
		longa	on
		rep	#$20
		iny
		lda	base_ptr
		sta	[jmp_tbl_ptr],y
		sta	call_routine+1
		lda	base_ptr+1
		iny
		sta	[jmp_tbl_ptr],y
		sta	call_routine+2
		
;
; ----------------
; Processor Status
; ----------------
; Bank Register 
; ----------------
; Return Address
; of main routine
; ----------------
		pla			;restore Direct Register
		tcd
		lda	save_a		;restore registers
		ldx	save_x
		ldy	save_y
;
; ----------------
; Return Address
; of main routine
; ----------------
		plp			;restore processor mode
		plb
call_routine	jml	$0000000	;call the desired routine
		endp
				
		eject
;====================================================================================================
;startup:	This routine will allocate memory used by the system loader and setup
;		any data structures that are used by ExpressLoad.
;
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = error	;If this happens I would be suprized
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
startup		proc
		with	data
		jsr	Get_ExpLoad_ID	;get ID for me to use
		jsr	alloc_my_dp	;allocate me a direct page please
		bcc	@got_it
		rts			;return the error
@got_it
		lda	temp_handle	;save the current handle please
		pha
		lda	temp_handle+2
		pha
		
		stx	temp_handle
		sty	temp_handle+2	;to determine our direct page

		lda	[temp_handle]	;get the page please
		sta	my_dir_page	;save my direct page please

		sta	temp_handle	;setup pointer to direct page
		stz	temp_handle+2

		lda	#$0000
		ldy	#$00FE
		
@clear_it	sta	[temp_handle],y
		dey
		dey
		bpl	@clear_it
	
		ply
		sty	temp_handle+2	;restore data used on current direct page
		ply
		sty	temp_handle	;it is now safe to setup the direct register
		
		lda	my_dir_page
		tcd			;go ahead and setup the direct register

		stz	user_id_handle	;indicate that there is no ID table yet
		stz	user_id_handle+2
;
;Now lets setup one user_id_table
;
		jsr	add_id_table	;add the first User ID Table please				
		rts			;return the error code to caller
		endp

		eject
;====================================================================================================
;zero_handles:	Zero handles to indicate that there is no segment
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = ?
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
zero_handles	proc
		with	data
	
;
;We now zero the handles that do not live across calls.  We do this so we can
;lock the handles when we make memory manager calls
;
		stz	ExpressHandle	;zero the handles please
		stz	ExpressHandle+2
		stz	temp_handle	;zero any temp handles hanging around
		stz	temp_handle+2
		stz	reloc_handle	;this handle does not live across calls
		stz	reloc_handle+2
		stz	seg_handle		
		stz	seg_handle+2	;this handles do not live across calls	
		stz	curr_id_handle
		stz	curr_id_handle+2
		rts
		endp
		
		eject
;====================================================================================================
;get_parameters:	This routine is called at the beginning of each Tool call.  It will
;			get the input parameters off the stack and setup our operating environment.
;
;
;Input:         A = undefined
;               X = number of paramters on stack
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = ?
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
get_parameters	proc
		with	data
		pla			;save RTS
		sta	>local_return
		
;
;Save the data bank register
;
		phb
		phb			;save the bank register first
		pla
		sta	>data_bank
;
;Set data bank register to our bank
;
		phk
		plb			;set data bank to our bank.
;
;save the apps direct page
;
		tdc			;save the direct page register
		sta	apps_dir_page
;
;setup our direct page
;
		lda	my_dir_page
		tcd			;we now have our own direct page
		
;
;save the return address
;
		pla			;now save the return address
		sta	return_addr
		pla			;get both return address off the stack
		sta	return_addr+2
		pla
		sta	return_addr2+1
		
		longa	off
		longi	off
		sep	#$30

		txy
		beq	@done		;we have done our job
;
;now we need to pull the needed parameters off of the stack.
;
		ldy	#$00
@loop
		pla			;get a byte off the stack
		sta	param_blk,y	;save the byte in a common parameter block
		iny
		dex
		bne	@loop
@done
		longa	on
		longi	on
		rep	#$30
		lda	local_return
		pha
		jsr	zero_handles
		jsr	reset_local_mark
		stz	partial_match		;indicate that we need a complete match!!!

		rts
local_return	dc.w	00
		endp
		
		eject
;====================================================================================================
;restore_params:	This routine is called if we are going to call the standard system loader.
;
;
;Input:         A = undefined
;               X = number of paramters on stack
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = ?
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
restore_params	proc
		with	data

		pla
		sta	local_return
		phx			;save x for one second: actually much less then that
		lda	file_open	;is the load file open?
		beq	@not_open	;the file is not open so don't worry about it.
		jsr	close_load_file	;go ahead and close the file since we are thru with it.
@not_open
		plx			;restore the parameter count please.
		longa	off
		longi	off
		sep	#$30

		txy
		beq	@done		;we have done our job
		dex
;
;now we need to push the original parameters on the stack.
;
@loop
		lda	param_blk,x	;get the original byte
		pha
		dex
		bpl	@loop
@done
		longa	on
		longi	on
		rep	#$30

		lda	return_addr2+1
		pha
		lda	return_addr+2
		pha
		lda	return_addr
		pha
		
		
		lda	apps_dir_page
		tcd			;restore the direct page
		lda	>data_bank
		pha
		plb
		plb
		
		IF	debug_on=0	GOTO	.nobug
		lda	#$FEFE
		sta	>Rom_debug+2
.nobug

		lda	>orig_y
		tay
		lda	>orig_x
		tax
		lda	>local_return
		pha
		lda	>orig_a		;restore the Accum
		
		clc
		rts
local_return	dc.w	00

		endp

		eject
;====================================================================================================
;return_with_error:	This routine is called if ExpresssLoad has handled the file and an error
;			has occured.
;
;
;Input:         A = Error Code
;               X = number of bytes to push on the stack
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = no error
;               b = K
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
return_with_error	proc
		with	data
		tay
		lda	#$0000
		sep	#$20			;eight bit mode for push
		cpx	#$0000
		beq	@nothing
@loop
		pha
		dex
		bne	@loop			;push the correct number of bytes.

@nothing
		rep	#$20
		tya				;restore the error
		sec
;
;		jmp	return_to_caller	;FALL THRU TO THE NORMAL EXIT
		endp

		eject
;====================================================================================================
;return_to_caller:	This routine is called if ExpresssLoad has handled the file
;
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..1 = no error
;               b = K
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
return_to_caller	proc
		with	data
		
		sta	local_error

		IF	debug_on=0	GOTO	.nobug
		sta	>Rom_debug+2
.nobug

		lda	file_open	;is the load file open?
		beq	@not_open	;the file is not open so don't worry about it.
		jsr	close_load_file	;go ahead and close the file since we are thru with it.
@not_open
		ldy	#$0004			;lets unlock this puppy
		lda	ExpressHandle
		ora	ExpressHandle+2
		beq	@skip_unlock		;there is no ExpressSegment

		lda	[ExpressHandle],y
		and	#$7FFF			;unlock the handle
		sta	[ExpressHandle],y

@skip_unlock
		lda	return_addr2+1
		pha
		lda	return_addr+2
		pha
		lda	return_addr
		pha
		
		
		lda	apps_dir_page
		tcd			;restore the direct page
		lda	>data_bank
		pha
		plb
		plb
		lda	>orig_y
		tay
		lda	>orig_x
		tax
		lda	>local_error
		cmp	#$0001
		rtl
		
local_error	dc.w	00

		endp
		
		eject
;====================================================================================================
;Main Entry point for the loader
;====================================================================================================
		longa	on
		longi	on
		
Main		proc
		with	data
		import	loader_patch
		
		phk
		plb
		phd
		lda	#$0000
		tcd				;setup the standard direct page

		jsr	startup			;init my self
		jsr	loader_patch
		IMPORT	draw_express

		jsr	draw_express
@skip_startup
		pld				;restore the direct page
		rtl
		
		
		string	asis
		
		
		endp
		
		eject
;====================================================================================================
;do_Save_AXY	Save the A X and Y register from the tool dispatcher	
;
;
;Input:         A = ??
;               X = Tool and Function Number
;               Y = ??
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;
;====================================================================================================
		longa	on
		longi	on
do_Save_AXY	proc
		with	data
		sta	>orig_a
		txa
		sta	>orig_x
		tya
		sta	>orig_y

		php
		longa	on
		longi	on
		rep	#$30		;16 bit mode
		pha
		phx
		phy
		
		lda	>show_splash	;have I already checked?
		bmi	@already_done
		lda	#$FFFF		
		sta	>show_splash

		jsl	$e100a8		;get info on ExpressLoad
		dc.w	$2006
		dc.l	ExpressInfoList
		bcs	@already_done	;An Error?
		
		lda	>ExpressAux	;get the AuxType
		cmp	#'RT'		;is it my initials?
		bne	@already_done

		phb			;save bank from call
		phk
		plb
		jsr	draw_express	;draw the ExpressLoad logo and screw marketing!
		plb
@already_done

		ply
		plx
		pla

		plp
		rts
		
		Export	show_splash
show_splash	dc.w	00		;Used to indicate that I shown splash screen

ExpressInfoList	dc.w	$0004		;PCount for the call
		dc.l	ExpressPath
		dc.w	00		;access
		dc.w	00		;filetype
ExpressAux	dc.l	000000000	;ExpressLoad Aux Type

ExpressPath	dc.w	20
		dc.b	'*:System:ExpressLoad'

		
		endp
		
		eject
;====================================================================================================
;rename_segments:	This routine will rename paths for ExpressLoad 
;
;Input:         A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;
;		Full_Blown		;Path that we need to find
;
;Output:        A = User ID
;               X = undefined
;               Y =undefined
;               P = nvmxdizc
;                   ..000..1 = not found
;               b = k
;
;
;====================================================================================================
	
		longa	on
		longi	on		
rename_segments	proc
		with	data
		
		lda	#$8000
		sta	partial_match		;indicate that a partial match is OK


		ldx	user_id_handle
		ldy	user_id_handle+2
		bra	@keep_going
@loop
		jsr	do_rename		;rename all files in thie user_id chunck

		ldy	#$0004			;unlock the handle
		lda	[temp_handle],y
		and	#$7FFF
		sta	[temp_handle],y
		
		ldy	#$0002			;get the next link
		lda	[user_id_ptr]
		tax
		lda	[user_id_ptr],y
		tay
		bne	@keep_going
		txa
		bne	@keep_going

		rts				;we are done
@keep_going
		stx	temp_handle
		sty	temp_handle+2
		
		ldy	#$00002
		lda	[temp_handle]
		sta	user_id_ptr		;point to the next user_id table
		lda	[temp_handle],y
		sta	user_id_ptr+2

		ldy	#$0004			;lock the handle
		lda	[temp_handle],y
		ora	#$8000
		sta	[temp_handle],y
		
		bra	@loop
@found_it
		rts				;A = User_ID
		
do_rename
		ldy	#id_entry_size		;start at the first available spot
		ldx	#id_entry_cnt		;number of entries in a table
@rename_loop
		lda	[user_id_ptr],y		;get a user_id
		beq	@empty_slot
		phy
		phx
		jsr	copy_orig_name		
		plx
		ply
		
		phy
		phx
		jsr	check_and_rename	;rename if needed
		plx
		ply
@empty_slot
		clc
		tya
		adc	#id_entry_size
		tay
		dex
		bpl	@rename_loop
		clc
		rts
;====================================================================================================
;Rename the segment if needed
;====================================================================================================
check_and_rename
		iny
		iny				;get the handle
		lda	[user_id_ptr],y
		sta	ExpressHandle
		tax
		iny
		iny
		lda	[user_id_ptr],y
		sta	ExpressHandle+2		;Handle to the ExpressLoad segment
		tay
		jsr	Merge_path		;build a complete pathname
		jsr	compare_paths		;is this the one?
		bcc	@go_on			;a complete match was found!!!
		bvc	@partial_found		;we have a partial match
		rts				;see if the pathname is found
		
@partial_found
		php				;save partial/ complete flag
		jsr	Expand_to_full_blown	;copy name from ExpressLoad segment into fullBlown.
		plp
@go_on
		php				;save partial/compelete flag
		lda	param_blk+func_13_new_ptr+2
		sta	path_ptr+2		;high word of the pathname
		lda	param_blk+func_13_new_ptr
		sta	path_ptr		;low word of the pathname

		lda	[path_ptr]		;get the length
		cmp	#$0100
		bcc	@go_around
		plp				;fix the stack
@long_to_loader
		rts
@go_around
		tay
		iny				;get all the characters
@new_loop
		lda	[path_ptr],y
		sta	Expanded_name.size,y	;Expanded now has a GString with the new name
		dey
		bpl	@new_loop

		plp
		bcc	@not_partial		;this is a complete pathname
		jsr	merge_names		;add partial to old ExpressLoad name
		bcc	@not_partial	
		rts
@not_partial
		jsr	setup_path_sizes	;setup vol_size, partial_size, partial_offset etc.
		jsr	make_HET_ptr
		jsr	setup_base_ptr
		jsr	adjust_handle_size
		bcc	@adjusted
		rts
@adjusted	jsr	save_new_name
		clc
		rts
		
;====================================================================================================
;
;save_new_name will store the name in the ExpressLoad segment
;
;
;====================================================================================================
save_new_name
		ldy	#$0002			;build a pointer to ExpressSegment
		lda	[ExpressHandle]
		sta	temp_ptr
		sta	base_ptr
		lda	[ExpressHandle],y
		sta	temp_ptr+2
		sta	base_ptr+2

;
;Now we need to build a pointer to the volume name
;		
		ldy	#seg_vol_offset	;offset to the volume name
		clc
		lda	[Temp_ptr],y
		adc	temp_ptr
		sta	super_ptr
		lda	#$0000
		adc	temp_ptr+2
		sta	super_ptr+2		;super_ptr now points to the volume name
		jsr	store_new_name		;go and do it
		rts

;====================================================================================================
;
;Get the original name from SCM
;
;====================================================================================================
copy_orig_name		
		lda	param_blk+func_13_orig_ptr+2
		sta	path_ptr+2		;high word of the pathname
		lda	param_blk+func_13_orig_ptr
		sta	path_ptr		;low word of the pathname
		
		lda	[path_ptr]		;get the length
		cmp	#$0100
		bcc	@onward
		rts
@onward
		tay
		iny				;get all the characters
@loop
		lda	[path_ptr],y
		sta	full_blown.size,y	;Full blown now has a GString with the source
		dey
		bpl	@loop
		rts
;====================================================================================================
;
;This routine will resize the ExpressLoad handle as needed
;
;====================================================================================================
adjust_handle_size		

		lda	#$0000
		pha
		pha
		pei	ExpressHandle+2		;push the high word of the handle
		pei	ExpressHandle
		ldx	#$1802			;GetHandle call
		jsl	$e10000

		pla
		sta	express_size
		pla
		sta	express_size+2
		
		lda	full_blown.size		;see if the original is larger then new pathname?
		and	#$00FF
		sta	full_blown.size
		cmp	Expanded_name.size
		beq	@no_problem		;the strings are the same size
		bcc	@grow_handle		;source < destination name so grow handle
;
;if here, the original name (Full) is greater then new name (expanded) 
;

		lda	full_blown.size		;larger number
		sbc	Expanded_name.size
;
;A = size we need to reduce ExpressHandle by
;
		pha

		sec
		lda	express_size
		sbc	1,s			;reduce the size
		sta	express_size
		lda	express_size+2
		sbc	#0000
		sta	express_size+2
		pla
		bra	@set_size		;go and set the size
@grow_handle
		sec
		lda	expanded_name.size	;larger name
		sbc	full_blown.size
		pha

		clc
		lda	express_size
		adc	1,s			;increase the size
		sta	express_size
		lda	express_size+2
		adc	#0000
		sta	express_size+2
		pla
		
@set_size
		pei	ExpressHandle+2
		pei	ExpressHandle
		ldx	#$2202			;unlock the handle
		jsl	$e10000
		
		lda	express_size+2		;get the size please
		pha
		lda	express_size
		pha
		pei	ExpressHandle+2
		pei	ExpressHandle
		ldx	#$1902			;SetHandle size for ExpressLoad segment
		jsl	$e10000
		rts
@no_problem
		clc
		rts
;====================================================================================================
;Copy Expanded name into Full_blown name
; == save name from ExpressLoad segment
;
;====================================================================================================
Expand_to_full_blown
		lda	expanded_name.size
		sta	full_blown.size
		tay
		longa	off
		sep	#$20
		lda	#$00
		sta	full_blown.size+2,y	;make a C string
@loop
		lda	expanded_name.size+1,y
		sta	full_blown.size+1,y	;Full blown now has a GString with the source
		dey
		bne	@loop
		
		longa	on
		rep	#$20
		rts
;====================================================================================================
;This routine will merge the partial path onto the new name
; == Expanded_name will contain the new name for ExpressLoad segment
;====================================================================================================
merge_names
		lda	expanded_name.size	;get index to the end of the string
		tay
		ldx	SubStr_size		;index into full blown
		longa	off
		sep	#$20
@merge_loop
		lda	full_blown.name,x	;get the seperator
		sta	expanded_name.size+2,y	;store the character
		beq	@done
		inx
		iny
		inc	expanded_name.size	;bump the count.
		bne	@merge_loop
		longa	on
		rep	#$20
		sec
		rts
		
@done
		longa	on
		rep	#$20
		clc
		rts
		endp

	
		eject
;====================================================================================================
;============= Beginning of the Patch code for the loader ===========================================
;====================================================================================================
		longa	on
		longi	on
		string	asis
		
loader_patch	proc
		with	data
		
ptr1		equ	$00
ptr2		equ	$04
loader_ptr	equ	$08
		
		longa	on
		longi	on
patch_main		

		phk
		plb
		rep	#$30
		
		lda	#$0000
		pha
		pha
		
		pha
		lda	#$0011			;get the loader table
		pha
		ldx	#$0901
		jsl	$e10000
		pla
		sta	loader_ptr
		pla
		sta	loader_ptr+2

		
		lda	#Patch_table
		sta	ptr1
		lda	#^Patch_table
		sta	ptr1+2			;pointer to the patch table
		
		ldx	#$0000
@loop
		lda	patch_table,x
		beq	@done			;we are thru
		tay				;index to loader entry
		inx
		inx
		inx
		inx				;pass the offset field
		lda	patch_table,x
		sta	my_routine		;address that I need to patch with
		inx
		inx
		lda	patch_table,x
		sta	my_routine+2
		
		inx
		inx
		clc
		lda	patch_table,x		;address of return address
		adc	#$0001
		sta	ptr1
		inx
		inx
		lda	patch_table,x
		adc	#$0000
		sta	ptr1+2
		inx
		inx				;point to the next entry
			
		lda	[loader_ptr],y
		sta	loader_address
		iny
		iny
		lda	[loader_ptr],y
		sta	loader_address+2
		
		lda	my_routine+2		;Patch the Loader to point to me
		sta	[loader_ptr],y
		dey
		dey
		lda	my_routine
		sta	[loader_ptr],y
		
		clc
		lda	loader_address
		adc	#$0001
		sta	loader_address
		lda	loader_address+2
		adc	#0000
		sta	loader_address+2	;slowest way possible. But I'm hot and tired!
		
		ldy	#$0001			;Patch my exit routine to point to the loader
		lda	loader_address
		sta	[ptr1]
		lda	loader_address+1
		sta	[ptr1],y
		bra	@loop
@done		
		rts		


loader_address	dc.l	00
my_routine	dc.l	00

		eject
;====================================================================================================
;Initial_Load:	This routine will do an Initial Load of a load file.	
;
;
;Input:         A = undefined
;               X = Tool and Function Number
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;Stack before call:
;
;		previous contents
;		result space		word
;		result space		word
;		result space		long
;		result space		word
;		User ID			word
;		Addr of load file name	long
;		special memory flag	word
;	SP ---->
;
;Stack after call:
;
;		previous contents
;		direct page/stack size	word
;		direct page/stack addr	word
;		starting address	long
;		User ID			word
;	SP ---->
;
;
;====================================================================================================
		longa	on
		longi	on
L_init_load
		jsr	save_AXY

		IF	debug_on=0	GOTO	.nobug
		lda	#$0001			;initial load
		sta	>Rom_debug
.nobug
		ldx	#func_9_param_cnt	;get the number of parameters of the stack
		jsr	get_parameters

						;now we make a string to the pathname
		lda	param_blk+func_9_path_addr
		sta	temp_ptr
		lda	param_blk+func_9_path_addr+2
		sta	temp_ptr+2		;temp_ptr now points to a PString
;
;Now we need to do an Expand Path on the Input name. Expand Path expects a pointer to a 
;GString, So I will cheat and convert the callers string into a GString.
;
		lda	temp_ptr
		bne	@low_only
		dec	temp_ptr+2		;decrement the High Byte
@low_only	dec	a
		sta	temp_ptr
		lda	[temp_ptr]		;get garbage + length byte
		pha				;save it please
		xba				;put length byte in the low word
		and	#$00FF			;clear the garbage
		sta	[temp_ptr]		;PString now equals GString
		
		ldx	temp_ptr
		ldy	temp_ptr+2		;convert the puppy please
		jsr	expand_path
		pla				;restore the PString
		sta	[temp_ptr]
		bcs	@abort			;dump to Lou's loader on errors

		jsr	open_load_file		;open the file please
		bcs	@abort

		jsr	check_express_seg	;see if this is an expressload file
		bcs	@abort
;
;At this point all errors that we encounter must be returned to the caller since the file is mine.
;
						;setup the special memory flag
		lda	param_blk+func_9_spec_mem
		sta	spec_mem_flag		;user's preference
		
						;go and get the user ID
		lda	param_blk+func_9_user_id
						;get the User_ID from the caller
		jsr	Alloc_ID
		bcs	@error_exit		;we have an error we must report to caller
		sta	User_ID			;make the New ID Global
		sta	AppID
		jsr	get_express_seg		;load in the express load segment
		bcs	@error_exit		;we have an error we must report to caller

		ldx	ExpressHandle
		ldy	ExpressHandle+2
		jsr	merge_path
		
		jsr	load_statics		;load all the static segments
		bcs	@error_exit		;return the error to the caller

		jsr	save_start		;save the starting address please
		
		lda	stack_size		;return the correct parameters
		pha
		lda	stack_addr
		pha
		lda	starting_addr+2		;address of the Application
		and	#$00FF
		pha
		lda	starting_addr
		pha
		lda	User_ID
		pha
		lda	#$0000
		clc
		jmp	return_to_caller	;we were successful!!
@error_exit
		ldx	#func_9_err_cnt		;exit with the error
		jmp	return_with_error
		
@abort
		ldx	#func_9_param_cnt	;restore the stack for the loader
		jsr	restore_params

return9		jml	$000000
		
		eject
;====================================================================================================
;L_initial2:	This routine will do an Initial Load of a load file. Version 2 of the call	
;
;
;Input:         A = undefined
;               X = Tool and Function Number
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;Stack before call:
;
;		previous contents
;		result space		word
;		result space		word
;		result space		long
;		result space		word
;		User ID			word
;		Addr of load file name	long
;		special memory flag	word
;		pathname flag		word	1 = GString, 2 = mem load, 3=pathname table, 4= code resorce
;	SP ---->
;
;
;Stack after call:
;
;		previous contents
;		direct page/stack size	word
;		direct page/stack addr	word
;		starting address	long
;		User ID			word
;	SP ---->
;
;
;====================================================================================================
		longa	on
		longi	on
L_initial2
		jsr	save_AXY
		
		IF	debug_on=0	GOTO	.nobug
		lda	#$0002			;initial load
		sta	>Rom_debug
.nobug
		
		ldx	#func_20_param_cnt	;get the number of parameters of the stack
		jsr	get_parameters

						;now we make a string to the pathname
		lda	param_blk+func_20_path_addr
		sta	temp_ptr
		lda	param_blk+func_20_path_addr+2
		sta	temp_ptr+2		;temp_ptr now points to a PString

		lda	param_blk+func_20_path_flag
						;see if this is a class1 string
		beq	@old_style
		cmp	#$0002			;see if I can handle this one
		bcs	@to_abort		;sorry not my type
		bra	@do_expand		;this is a class1 string
;
;Now we need to do an Expand Path on the Input name. Expand Path expects a pointer to a 
;GString, So I will cheat and convert the callers string into a GString.
;
@old_style
		lda	temp_ptr
		bne	@low_only
		dec	temp_ptr+2		;decrement the High Byte
@low_only	dec	a
		sta	temp_ptr
		lda	[temp_ptr]		;get garbage + length byte
		pha				;save it please
		xba				;put length byte in the low word
		and	#$00FF			;clear the garbage
		sta	[temp_ptr]		;PString now equals GString
@do_expand
		ldx	temp_ptr
		ldy	temp_ptr+2		;convert the puppy please
		jsr	expand_path

		lda	param_blk+func_20_path_flag
						;see if this is a class1 string
		bne	@class1
		
		pla				;restore the PString
		sta	[temp_ptr]
@class1
		bcs	@to_abort
		
		jsr	open_load_file		;open the file please
		bcs	@to_abort

		jsr	check_express_seg	;see if this is an expressload file
		bcc	@its_expressed
@to_abort
		brl	@abort			;call the standard loader and let it try
;
;At this point all errors that we encounter must be returned to the caller since the file is mine.
;
@its_expressed
						;setup the special memory flag
		lda	param_blk+func_20_spec_mem
		sta	spec_mem_flag		;user's preference
		
						;go and get the user ID
		lda	param_blk+func_20_user_id
						;get the User_ID from the caller
		jsr	Alloc_ID
		bcs	@skip_to_error		;pass the error back to the caller
		sta	User_ID			;make the New ID Global
		sta	AppID
		jsr	get_express_seg		;load in the express load segment
@skip_to_error
		bcs	@error_exit		;pass the error back to the caller

		ldx	ExpressHandle
		ldy	ExpressHandle+2
		jsr	merge_path
		
		jsr	load_statics		;load all the static segments
		bcs	@dispose_exit		;pass the error back to the caller
		
		jsr	save_start		;save starting address and stack info
		lda	stack_size		;return the correct parameters
		pha
		lda	stack_addr
		pha
		lda	starting_addr+2		;address of the Application
		and	#$00FF
		pha
		lda	starting_addr
		pha
		lda	User_ID
		pha
		lda	#$0000
		clc
		jmp	return_to_caller	;we were successful!!

; this is used when an error occurs after loading at least one segment into memory.
; in this case, we must do a pseudo-userShutdown to clean up memory and dispose of
; the user ID.

@dispose_exit
		pha				;save the error code
		lda	User_ID
		jsr	find_user_id		;get pointer to user_id_table
		ldy	#$0002
		lda	[temp_ptr],y		;get the ExpressLoad handle
		sta	ExpressHandle
		iny
		iny
		lda	[temp_ptr],y
		sta	ExpressHandle+2		
		jsr	close_dynamic_file	;close file if any segments were dynamic
		
		lda	temp_ptr		;setup the User_ID pointer to point to the entry
		sta	user_id_ptr
		lda	temp_ptr+2
		sta	user_id_ptr+2
		
		pha				;space for handle
		pha
		pei	user_id_ptr+2		;lock down the user ID table
		pei	user_id_ptr
		ldx	#$1A02			;FindHandle
		jsl	$E10000
		lda	3,s			;suplicate the handle on the stack
		pha
		lda	3,s
		pha
		ldx	#$2002			;HLock
		jsl	$E10000
		
		lda	#nuke_id		;delete the ID and the memory
		jsr	delete_user_id		;remove the user_id please
		
		ldx	#$2202			;HUnlock (handle already on stack)
		jsl	$E10000			;unlock the user ID table
		pla				;restore error code

@error_exit
		ldx	#func_20_err_cnt	;exit with the error
		jmp	return_with_error
		
@abort
		ldx	#func_20_param_cnt	;restore the stack for the loader
		jsr	restore_params

return15	jml	$000000
		
		eject
;====================================================================================================
;L_restart:	This routine is called to restart an application.
;
;
;Input:         A = undefined
;               X = Tool and Function Number
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;Stack before call:
;
;		previous contents
;		result space		word
;		result space		word
;		result space		long
;		result space		word
;		User ID			word
;	SP ---->
;
;Stack after call:
;
;		previous contents
;		Dir. Page/Stack size	word
;		Dir. Page/Stack addr	word
;		starting address	long
;		User ID			word
;	SP ---->
;
;
;====================================================================================================
L_restart	
		jsr	save_AXY
		
		IF	debug_on=0	GOTO	.nobug
		lda	#$0003			;initial load
		sta	>Rom_debug
.nobug

		ldx	#func_0A_param_cnt	;get the number of parameters of the stack
		jsr	get_parameters
		
		lda	param_blk+func_0A_user_id
						;lets see if we know about this user ID
		jsr	find_user_id		;If found temp_ptr setup
		bcc	@continue
		brl	@abort			;not my job
@continue
;
;At this point all errors that we encounter must be returned to the caller since the file is mine.
;

		ldy	#$0002
		lda	[temp_ptr],y		;get the ExpressLoad handle
		tax
		iny
		iny
		lda	[temp_ptr],y
		tay
		bne	@have_handle
		txa
		bne	@have_handle		;we have the handle
		lda	#ExpressSegLost
		sec
		bra	@error_exit		;report error to the caller.
@have_handle
		stx	ExpressHandle
		sty	ExpressHandle+2		
		jsr	Merge_path		;we now have the expanded ExpressLoad pathname
		
		jsr	lock_statics		;lock the static segments please
		bcc	@no_reload		;this is an easy case.
;
;If we get here we need to remove the old info and reload the application from disk
;
		lda	#keep_id		;indicate that we must keep the ID
		jsr	delete_user_id		;we need to nuke the old copy.
		jsr	zero_handles		;reset everything
		jsr	open_load_file		;open the file please
		bcs	@error_exit		;report error to the caller.
		jsr	check_express_seg	;see if this is an expressload file
		bcs	@error_exit		;report error to the caller.
		jsr	get_express_seg		;load in the express load segment
		bcs	@error_exit		;report error to the caller.

		lda	#any_state	
		sta	load_state
		lda	#1
		sta	spec_mem_flag		;don't use special memory for restart
		jsr	load_statics		;try to load all static segments
		bcc	@loaded_ok		;loaded fine, thank you!
		stz	spec_mem_flag		;try again, using special memory
		jsr	load_statics		;load all the static segments
@loaded_ok
		php				;save carry
		pha				;save possible error code
		jsr	close_load_file		;close the file and restore sys_prefs
		pla				;restore error code
		plp				;restore carry
		bcs	@error_exit		;report error to the caller.
		bra	@clean_exit
@no_reload
		jsr	kick_start
		bcs	@error_exit		;report error to the caller.
@clean_exit
		jsr	save_start
		lda	stack_size		;return the correct parameters
		pha
		lda	stack_addr
		pha
		lda	starting_addr+2		;address of the Application
		and	#$00FF
		pha
		lda	starting_addr
		pha
		lda	User_ID
		pha
		lda	#$0000
		clc
		jmp	return_to_caller	;we were successful!!
@error_exit
		ldx	param_blk+func_0A_user_id
		beq	@abort			;If the user_id was zero let Lou try.

		ldx	#func_0A_err_cnt	;exit with the error
		jmp	return_with_error
@abort
		ldx	#func_0A_param_cnt	;restore the stack for the loader
		jsr	restore_params
returnA
		jml	$000000

kick_start		
		stz	file_open		;indicate that the file is closed
		stz	starting_addr		;reset all of our variables
		stz	starting_addr+2
		stz	stack_addr		;there is no stack
		stz	stack_size
		
		jsr	chk_dynamic_Seg		;does the file contain any dynamic segments
		bcs	@no_dynamics

		jsr	open_load_file		;open the file please
		bcs	@error_out		;report error to the caller.
		jsr	save_ref_num
@no_dynamics		
		jsr	make_HET_ptr		;make pointer to Header Entry Table
		jsr	reset_jmp_tables	;delete any references to dynamic segments
		jsr	reload_inits		;please restart any init segments
		bcs	@error_out
		jsr	reload_restart		;please reload any restart segments.
		bcs	@error_out
		jsr	restore_start
		clc
@error_out
		php
		pha
		lda	file_open		;is the file open?
		beq	@skip_close
		jsr	close_load_file
@skip_close
		pla
		plp
		rts
		
		eject
;====================================================================================================
;L_Seg_by_num:	This routine will load a segment by number.  Note: an application should never
;		make this call.  If they do they should be shot.
;
;
;Input:         A = undefined
;               X = Tool and Function Number
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;Stack before call:
;
;		previous contents
;		result space		long
;		User ID			word
;		load-file number	word
;		load-segment number	word
;	SP ---->
;
;Stack after call:
;
;		previous contents
;		starting address	long
;	SP ---->
;
;
;====================================================================================================
L_seg_by_num	
		jsr	save_AXY

		IF	debug_on=0	GOTO	.nobug
		lda	#$0004			;initial load
		sta	>Rom_debug
.nobug

		
		ldx	#func_0b_param_cnt	;get the number of parameters of the stack
		jsr	get_parameters

						;see if this is file number one
		lda	param_blk+func_0B_file_num
		dec	a
		bne	@abort			;sorry we will let the system loader handle it
		
		lda	param_blk+func_0B_user_id
						;lets see if we know about this user ID
		jsr	find_user_id		;If found temp_ptr setup
		bcs	@abort			;not my job
;
;At this point all errors that we encounter must be returned to the caller since the file is mine.
;

		ldy	#$0002
		lda	[temp_ptr],y		;get the ExpressLoad handle
		tax
		iny
		iny
		lda	[temp_ptr],y
		tay
		bne	@have_handle
		txa
		bne	@have_handle		;we have the handle
		lda	#ExpressSegLost
		sec
		bra	@error_exit		;report error to the caller.
@have_handle
		stx	ExpressHandle
		sty	ExpressHandle+2		
		jsr	Merge_path		;we now have the expanded ExpressLoad pathname
		
						;the segment we will have to load
		jsr	make_HET_ptr
		lda	param_blk+func_0B_seg_num
		jsr	seg_num_lookup		;convert the segment number to correct number
		bcs	@error_exit		;the number is not valid
		sta	search_seg		;save the real segment to load.		
		jsr	setup_seg_ptrs		;setup pointers for the load

		ldy	#flags_offset		;see if the segment is already loaded
		lda	[HET_entry_ptr],y
		bmi	@already_in		;this segment is already loaded
@do_load
		jsr	open_load_file		;open the puppy
		bcs	@error_exit		;report error to the caller.
		jsr	load_segment		;load the segment into memory
		bcs	@error_exit		;report error to the caller.
		lda	search_seg		;relocate the segment
		jsr	process_reloc
		bcs	@error_exit		;report error to the caller.
		bra	@continue1
@already_in
		lsr	a			;see if the segment is purgable?
		bcc	@continue
		lda	search_seg		;go and lock the handle please
		jsr	lock_segment
		bcs	@do_load
@continue
		jsr	setup_base_ptr		;please setup the base pointer
@continue1
		lda	segment_entry+2		;address of the segment
		pha
		lda	segment_entry
		pha

		lda	#$0000
		clc
		jmp	return_to_caller	;we were successful!!
@error_exit
		ldx	param_blk+func_0B_user_id
		beq	@abort			;let Lou try if user_id was zero
		ldx	#func_0b_err_cnt	;exit with the error
		jmp	return_with_error
		
@abort
		ldx	#func_0b_param_cnt	;restore the stack for the loader
		jsr	restore_params
returnB
		jml	$000000
		
		eject
;====================================================================================================
;L_unload1:	This is the unload segment by number routine.  It will mark a segment as purgable
;		and unlocked.
;
;
;Input:         A = undefined
;               X = Tool and Function Number
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;Stack before call:
;
;		previous contents
;		User ID			word
;		load-file number	word
;		load-segment number	word
;	SP ---->
;
;Stack after call:
;
;		previous contents
;	SP ---->
;
;
;====================================================================================================
L_unload1	
		jsr	save_AXY
		
		IF	debug_on=0	GOTO	.nobug
		lda	#$0005
		sta	>Rom_debug
.nobug

		ldx	#func_0c_param_cnt	;get the number of parameters of the stack
		jsr	get_parameters

						;see if this is file number one
		lda	param_blk+func_0c_file_num
		bne	@check_for_1		;we handle 0 and 1
		sta	param_blk+func_0C_seg_num
		bra	@skip_abort
@check_for_1
		dec	a
		bne	@abort			;sorry we will let the system loader handle it
@skip_abort
						;see if this is for me
		lda	param_blk+func_0c_user_id
		jsr	find_user_id
		bcs	@abort			;must be the real system loaders
;
;At this point all errors that we encounter must be returned to the caller since the file is mine.
;
		ldy	#$0002
		lda	[temp_ptr],y		;get the ExpressLoad handle
		tax
		iny
		iny
		lda	[temp_ptr],y
		tay
		bne	@have_handle
		txa
		bne	@have_handle		;we have the handle
		lda	#ExpressSegLost
		sec
		bra	@error_exit		;report error to the caller.
@have_handle
		stx	ExpressHandle
		sty	ExpressHandle+2		

		jsr	make_HET_ptr
		lda	param_blk+func_0C_seg_num
		beq	@do_all_dyn		;we need to purge all dynamics
		jsr	seg_num_lookup		;convert the segment number to correct number
		bcs	@error_exit		;the number is not valid
		jsr	make_purgable
		jmp	return_to_caller	;return to the caller
@do_all_dyn
		jsr	purge_all_dyn
		jmp	return_to_caller	;return the info please
@error_exit
		ldx	param_blk+func_0c_user_id
		beq	@abort			;let Lou try.
		ldx	#func_0c_err_cnt	;exit with the error
		jmp	return_with_error
@abort
		ldx	#func_0c_param_cnt	;restore the stack for the loader
		jsr	restore_params
returnC
		jml	$000000
;
;If we get here then we must purge all the dynamic segments
;

		eject
;====================================================================================================
;L_seg_by_name:	This routine will load a segment by Name.	
;
;
;Input:         A = undefined
;               X = Tool and Function Number
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;Stack before call:
;
;		previous contents
;		result space		word
;		result space		word
;		result space		word
;		result space		long
;		User ID			word
;		Addr of load file name	long
;		Addr of load seg name	long
;	SP ---->
;
;Stack after call:
;
;		previous contents
;		load-segment number	word
;		load-file number	word
;		User ID			word
;		Addr of the segment	long
;	SP ---->
;
; How it works:
;	IF find_user_id(input_id) THEN				{If found, ExpressHandle setup}
;	  BEGIN
;	    IF compare_path(input_path,ExpressLoad_path) THEN 	{See if looking for loaded segment}
;	      BEGIN
;		IF find_seg(input_seg_name) THEN		{See if segment is available}
;		  BEGIN
;		    IF seg_loaded(seg_num) THEN			{See if the segment is loaded}
;		      BEGIN
;			Return_parameters
;			Exit ()					{return to the caller}
;		      END
;		    ELSE
;		      BEGIN
;			Load_Seg(Seg_num)			{load in the segment please}
;			return_parameters
;			Exit()					{return to the caller}
;		      END
;  	          END
;		ELSE
;		  BEGIN						{segment not found}
;		    Return_error(Seg_Not_Found)
;		    Exit ()
;		  END
;	    ELSE						{not same file}
;	      BEGIN						{Pain in the Butt}
;		open_file(input_path)				{open file, type check etc.}
;		get_express_seg					{get the ExpressLoad segment}
;		IF find_seg(input_seg_name) THEN		{See if segment is available}
;		  BEGIN
;		    IF seg_loaded(seg_num) THEN			{See if the segment is loaded}
;		      BEGIN
;			Return_parameters
;			Exit ()					{return to the caller}
;		      END
;		    ELSE
;		      BEGIN
;			Load_Seg(Seg_num)			{load in the segment please}
;			return_parameters
;			Exit()					{return to the caller}
;		      END
;  	          END
;		ELSE
;		  BEGIN						{segment not found}
;		    Return_error(Seg_Not_Found)
;		    Exit ()
;		  END		
;		get_jmp_tbl_seg					{load any jump tables please}
;		Add_file_num					{Link this file in please}
;		Return_error(Seg_Not_Found)
;		Exit ()
;
;====================================================================================================
L_seg_by_name	
		jsr	save_AXY
		
		IF	debug_on=0	GOTO	.nobug
		lda	#$0006
		sta	>Rom_debug
.nobug
		ldx	#func_0D_param_cnt	;get the number of parameters of the stack
		jsr	get_parameters
		
						;get the input user id
		lda	param_blk+func_0D_user_id
		jsr	find_user_id		;see if we have the ID
		bcc	@its_mine
		brl	@abort			;later we need to handle this better
@its_mine
;
;At this point all errors that we encounter must be returned to the caller since the file is mine.
;
		ldy	#$0002
		lda	[temp_ptr],y		;get the ExpressLoad handle
		tax
		iny
		iny
		lda	[temp_ptr],y
		tay
		bne	@have_handle
		txa
		bne	@have_handle		;we have the handle
		lda	#ExpressSegLost
		sec
		bra	@error_exit		;report error to the caller.
@have_handle
		stx	ExpressHandle
		sty	ExpressHandle+2		
		jsr	Merge_path		;we now have the expanded ExpressLoad pathname
;
;At this point Expanded_name contains the Pathname from the ExpressLoad segment
;Now we need to build an Expanded Name from the Applications input pathname
;
						;lets build the name
		lda	param_blk+func_0D_file_name+2
		tay				;high word of the pathname
		lda	param_blk+func_0D_file_name
		tax				;low word of the pathname
		jsr	expand_app_path
		bcs	@error_exit		;GS/OS could not expand the pathname

		jsr	compare_paths		;see if the paths are equal
		lda	#seg_not_found		;pre-charge the error code if needed
		bcs	@error_exit		;report error to the caller.
						;lets get a copy of the segment name
		lda	param_blk+func_0D_seg_name+2
		tay
		lda	param_blk+func_0D_seg_name
		tax				;low word address of the segment name
		jsr	find_seg_name		;go and find the segment name in ExpressLoad
		bcs	@error_exit		;report error to the caller.
		sta	search_seg		;segment number of the segment
		
		ldy	#flags_offset		;see if the segment is already loaded
		lda	[HET_entry_ptr],y
		bmi	@already_in		;this segment is already loaded
@do_load
		jsr	open_load_file		;open the puppy
		bcs	@error_exit		;report error to the caller.
		jsr	load_segment		;load the segment into memory
		bcs	@error_exit		;report error to the caller.
		
		lda	search_seg		;relocate the segment
		jsr	process_reloc
		bcs	@error_exit		;report error to the caller.
		bra	@continue1
@already_in
		lsr	a			;see if the segment is purgable?
		bcc	@continue
		
		lda	search_seg		;go and lock the handle please
		jsr	lock_segment
		bcs	@do_load		;segment was purged behind my back!
@continue
		jsr	setup_base_ptr		;please setup the base pointer
@continue1
		lda	search_seg		;push the load segment number
		jsr	my_seg_to_user_seg	;convert to user type number
		pha
		pea	$0001			;file number
		lda	User_ID
		pha
		lda	segment_entry+2		;address of the segment
		pha
		lda	segment_entry
		pha

		lda	#$0000
		clc
		jmp	return_to_caller	;we were successful!!
@error_exit
		ldx	param_blk+func_0D_user_id
		beq	@abort			;Let Lou try
		ldx	#func_0D_err_cnt
		jmp	return_with_error	;Return to the caller with the error code
@abort
		ldx	#func_0D_param_cnt	;restore the stack for the loader
		jsr	restore_params
returnD
		jml	$000000
		
		eject
;====================================================================================================
;L_unload2:	This is the unload segment by address routine.  It will mark a segment as purgable
;		and unlocked.
;
;
;Input:         A = undefined
;               X = Tool and Function Number
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;Stack before call:
;
;		previous contents
;		result			word
;		result			word
;		result			word
;		Address in segment	long
;	SP ---->
;
;Stack after call:
;
;		previous contents
;		load-segment number	word
;		load-file number	word
;		user_id			word
;	SP ---->
;
;
;====================================================================================================
L_unload2	
		jsr	save_AXY
		
		IF	debug_on=0	GOTO	.nobug
		lda	#$0007
		sta	>Rom_debug
.nobug
		ldx	#func_0e_param_cnt	;get the number of parameters of the stack
		jsr	get_parameters
		stz	search_seg
@retry
		pea	$0000
		pea	$0000			;result space

		lda	param_blk+func_0e_seg_addr+2
		sta	hold_long+2		;save the address in case this is a jump table seg
		pha				;address in a segment
		lda	param_blk+func_0e_seg_addr
		sta	hold_long
		pha
		ldx	#$1A02			;find handle call
		jsl	$e10000
		plx
		ply
		bcs	@abort
		stx	seg_handle		;handle to the segment
		sty	seg_handle+2
		jsr	find_seg_handle
		bcs	@abort			;it must be in the original loader
		tax
		
		ldy	#flags_offset		;see if this is a jump segment
		lda	[HET_Entry_ptr],y
		and	#jmp_type
		beq	@not_jump

		lda	hold_long
		sta	temp_ptr
		lda	hold_long+2
		sta	temp_ptr+2		;setup pointer to the segment entry please

		lda	[temp_ptr]		;get the current opcode
		and	#$00FF			;clear the garbage
		cmp	#$0022			;is it a JSL instruction to ME???
		bne	@chk_JML

		sec
		lda	temp_ptr		;make pointer to the load_seg_number field
		sbc	#$0006
		sta	temp_ptr
		lda	temp_ptr+2
		sbc	#$0000
		sta	temp_ptr+2		;temp_ptr now points to the correct field
		
;		User_ID			2
;		Load_File Number	2
;		Load Segment Number	2
;		Load Segment Offset	4
;		JSL to Jump-table load	4

		lda	[temp_ptr]		;get the segment number please
		sta	search_seg
		bra	@return_info

@chk_JML
		cmp	#$005C			;is it a JML instruction!!
		bne	@abort			;let lou return the error
;
;Setup the new address to find
;
		ldy	#$0001			;get the address that I need to unload please
		lda	[temp_ptr],y
		sta	param_blk+func_0e_seg_addr
		iny
		iny
		lda	[temp_ptr],y		;get the high word please
		and	#$00FF			;clear garbage
		sta	param_blk+func_0e_seg_addr+2
						;save the new address please
		bra	@retry
@not_jump
		txa				;setup the segment number

@return_info					;label moved so that we _always_ call Make_Purgeable
		jsr	make_purgable		;{gab - 04/23/90}

;@return_info
		lda	search_seg
		jsr	my_seg_to_user_seg
		pha
		pea	$0001
		lda	user_id
		pha
		lda	#$0000
		jmp	return_to_caller	;return to the caller
@abort
		ldx	#func_0e_param_cnt	;restore the stack for the loader
		jsr	restore_params
returnE
		jml	$000000
			
		eject
;====================================================================================================
;L_Get_User_ID:	This routine will return the user Id given a Pathname	
;
;
;Input:         A = undefined
;               X = function number
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;Stack before call:
;
;		previous contents
;		result space		word
;		Pathname Pointer	Long	PString	
;	SP ---->
;
;Stack after call:
;
;		previous contents
;		User_ID			word
;	SP ---->
;
;====================================================================================================
L_get_userID	
		jsr	save_AXY
		
		IF	debug_on=0	GOTO	.nobug
		lda	#$0008
		sta	>Rom_debug
.nobug
		ldx	#func_10_param_cnt	;get the number of parameters of the stack
		jsr	get_parameters

						;lets build the name
		lda	param_blk+func_10_path_addr+2
		tay				;high word of the pathname
		lda	param_blk+func_10_path_addr
		tax				;low word of the pathname
		jsr	expand_app_path
		bcs	@abort			;GS/OS could not expand the pathname

		jsr	path_to_user_id		;given a path this routine finds a user ID		
		bcs	@abort
		pha				;push the user ID
		lda	#$0000
		clc
		jmp	return_to_caller	;we were successful!!
@abort
		ldx	#func_10_param_cnt	;restore the stack for the loader
		jsr	restore_params
return10
		jml	$000000

		eject
;====================================================================================================
;L_Get_User_ID2:	This routine will return the user Id given a class1 Pathname	
;
;
;Input:         A = undefined
;               X = function number
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;Stack before call:
;
;		previous contents
;		result space		word
;		Pathname Pointer	Long	GString	
;	SP ---->
;
;Stack after call:
;
;		previous contents
;		User_ID			word
;	SP ---->
;
;====================================================================================================
L_get_userID2	
		jsr	save_AXY
		
		IF	debug_on=0	GOTO	.nobug
		lda	#$0009
		sta	>Rom_debug
.nobug
		ldx	#func_21_param_cnt	;get the number of parameters of the stack
		jsr	get_parameters

					;lets build the name
		lda	param_blk+func_21_path_addr+2
		tay				;high word of the pathname
		lda	param_blk+func_21_path_addr
		tax				;low word of the pathname

		stx	expand.src
		sty	expand.src+2

		lda	#Full_blown
		sta	expand.dest
		lda	#^Full_blown		;put the destination name here
		sta	expand.dest+2

		jsr	lock_handles
		jsl	$e100a8			;call GS/OS
		dc.w	$200E			;expand path call
		dc.l	Expand			;pointer to the parameter
		jsr	unlock_handles
		bcs	@abort			;GS/OS could not expand the pathname

		jsr	path_to_user_id		;given a path this routine finds a user ID		
		bcs	@abort
		pha				;push the user_id
		lda	#$0000
		clc
		jmp	return_to_caller	;we were successful!!

@abort
		ldx	#func_21_param_cnt	;restore the stack for the loader
		jsr	restore_params
return17
		jml	$000000

		eject
;====================================================================================================
;L_get_pathname:	This call returns the pathname associated with a User ID.	
;
;Input:         A = undefined
;               X = function number
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;Stack before call:
;
;		previous contents
;		result space		long
;		User ID			word
;		file number		word	
;	SP ---->
;
;Stack after call:
;
;		previous contents
;		pathname pointer	long	PString
;	SP ---->
;
;
;
;====================================================================================================
L_get_pathname	
		jsr	save_AXY
		
		IF	debug_on=0	GOTO	.nobug
		lda	#$000A
		sta	>Rom_debug
.nobug
		ldx	#func_11_param_cnt	;get the number of parameters of the stack
		jsr	get_parameters

		lda	param_blk+func_11_file_num
		dec	a
		bne	@abort			;if file number not 1 then call system loader
		
		lda	param_blk+func_11_user_id
		jsr	find_user_id		;see if we have the ID
		bcs	@abort

		ldy	#$0002
		lda	[temp_ptr],y		;get the ExpressLoad handle
		tax
		iny
		iny
		lda	[temp_ptr],y
		tay
		bne	@have_handle
		txa
		bne	@have_handle		;we have the handle
		lda	#ExpressSegLost
		sec
		bra	@error_exit		;report error to the caller.
@have_handle
		stx	ExpressHandle
		sty	ExpressHandle+2
		jsr	Merge_path		;Build a GString
		jsr	GString_to_PString	;convert string to class 0 format
		bcs	@error_exit		;I could not convert the pathname
		
		lda	#^Full_Blown.size	
		pha
		lda	#Full_Blown.size
		pha
		lda	#$0000
		clc

		jmp	return_to_caller	;we were successful!!
@error_exit
		ldx	param_blk+func_11_user_id
		beq	@abort			;Give Lou a chance.
		ldx	#func_11_err_cnt
		jmp	return_with_error	;Return to the caller with the error code
		
@abort
		ldx	#func_11_param_cnt	;restore the stack for the loader
		jsr	restore_params
return11
		jml	$0000000
		
		eject
;====================================================================================================
;L_getpath2:	This routine will return a pathname for a user ID	
;
;
;Input:         A = undefined
;               X = Tool and Function Number
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;Stack before call:
;
;		previous contents
;		result space		long
;		User ID			word
;		file number		word	
;	SP ---->
;
;Stack after call:
;
;		previous contents
;		pathname pointer	long
;	SP ---->
;
;
;====================================================================================================
		longa	on
		longi	on
L_getpath2
		jsr	save_AXY
		
		IF	debug_on=0	GOTO	.nobug
		lda	#$000b
		sta	>Rom_debug
.nobug
		ldx	#func_22_param_cnt	;get the number of parameters of the stack
		jsr	get_parameters

		lda	param_blk+func_22_file_num
		dec	a
		bne	@abort			;if file number not 1 then call system loader
		
		lda	param_blk+func_22_user_id
		jsr	find_user_id		;see if we have the ID
		bcs	@abort

		ldy	#$0002
		lda	[temp_ptr],y		;get the ExpressLoad handle
		tax
		iny
		iny
		lda	[temp_ptr],y
		tay
		bne	@have_handle
		txa
		bne	@have_handle		;we have the handle
		lda	#ExpressSegLost
		sec
		bra	@error_exit		;report error to the caller.
@have_handle
		stx	ExpressHandle
		sty	ExpressHandle+2
		jsr	Merge_path
		
		lda	#^Expanded_name.size	
		pha
		lda	#expanded_name.size
		pha
		lda	#$0000
		clc
		jmp	return_to_caller	;we were successful!!
@error_exit
		ldx	param_blk+func_22_user_id
		beq	@abort
		ldx	#func_22_err_cnt
		jmp	return_with_error	;Return to the caller with the error code
		
@abort
		ldx	#func_22_param_cnt	;restore the stack for the loader
		jsr	restore_params

return16	jml	$000000
		
		eject
;====================================================================================================
;L_user_shutdown:	This routine will shutdown a load segment	
;
;
;Input:         A = undefined
;               X = Tool and Function Number
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;Stack before call:
;
;		previous contents
;		result space		long
;		User ID			word
;		quit flag		word	
;	SP ---->
;
;Stack after call:
;
;		previous contents
;		User ID			word
;	SP ---->
;
;
;====================================================================================================
L_user_shutdown	
		jsr	save_AXY
		
		IF	debug_on=0	GOTO	.nobug
		lda	#$000c
		sta	>Rom_debug
.nobug
		ldx	#func_12_param_cnt	;get the number of parameters of the stack
		jsr	get_parameters

						;see if this is my User ID
		lda	param_blk+func_12_User_ID
		jsr	find_user_id		;Is this mine?
		bcc	@found_it		;yes...
		brl	@abort			;no. It must belong to the system loader
@found_it
		ldy	#$0002
		lda	[temp_ptr],y		;get the ExpressLoad handle
		tax
		iny
		iny
		lda	[temp_ptr],y
		tay
		bne	@have_handle
		txa
		bne	@have_handle		;we have the handle
		lda	#ExpressSegLost
		sec
		bra	@error_exit		;report error to the caller.
@have_handle
		stx	ExpressHandle
		sty	ExpressHandle+2		
		jsr	close_dynamic_file	;close file if any segments were dynamic
		
		lda	temp_ptr		;setup the User_ID pointer to point to the entry
		sta	user_id_ptr
		lda	temp_ptr+2
		sta	user_id_ptr+2
		
						;save the guit floag
		lda	param_blk+func_12_quit_flag
						;what type of kill is this
		beq	@nuke_it		;remove the entire application
		cmp	#$8000			;is this a "keep Only Table" quit
		bne	@make_dormant		;this a restart attemp
;
;If we get here we need to purge the app but keep our tables intack
;
		lda	#purge_all		;remove all segments
		ldx	#$0000			;LOAD flags AND mask COMPARE value BEQ REMOVE_IT
		jsr	Remove_segment		;deallocate the segments
		bra	@norm_exit

@make_dormant
		lda	#purge_dynamics		;remove dynamic segments
		ldx	#$0000			;LOAD flags AND mask COMPARE value BEQ REMOVE_IT
		jsr	Remove_segment		;deallocate the segments
		jsr	mark_all_purgable
		bra	@norm_exit
@nuke_it
		pha				;space for handle
		pha
		pei	user_id_ptr+2		;lock down the user ID table
		pei	user_id_ptr
		ldx	#$1A02			;FindHandle
		jsl	$E10000
		lda	3,s			;duplicate the handle on the stack
		pha
		lda	3,s
		pha
		ldx	#$2002			;HLock
		jsl	$E10000
		
		lda	#nuke_id		;delete the ID and the memory
		jsr	delete_user_id		;remove the user_id please
		
		ldx	#$2202			;HUnlock (handle already on stack)
		jsl	$E10000			;unlock the user ID table
		
@norm_exit
		lda	user_id
		pha
		lda	#$0000
		clc
		jmp	return_to_caller	;we were successful!!
@error_exit
		ldx	param_blk+func_12_User_ID
		beq	@abort			;Must be Lou's
		ldx	#func_12_err_cnt
		jmp	return_with_error	;Return to the caller with the error code
@abort
		ldx	#func_12_param_cnt	;restore the stack for the loader
		jsr	restore_params
return12
		jml	$000000

		eject
;====================================================================================================
;L_Rename_Path:	This routine will rename a pathname if the pathname belongs to an ExpressLoad segment	
;
;
;Input:         A = undefined
;               X = function number
;               Y = undefined
;               P = nvmxdizc
;                   ..000...
;               b = k
;		
;
;Output:        A = undefined
;               X = undefined
;               Y = undefined
;               P = nvmxdizc
;                   ..000..
;               b = k
;
;Stack before call:
;
;		previous contents
;		Pathname Pointer old	Long	GString	
;		Pathname Pointer new	Long	GString	
;	SP ---->
;
;Stack after call:
;
;		previous contents
;	SP ---->
;
;====================================================================================================
L_Rename_Path	
		jsr	save_AXY
		
		IF	debug_on=0	GOTO	.nobug
		lda	#$000F
		sta	>Rom_debug
.nobug
		ldx	#func_13_param_cnt	;get the number of parameters of the stack
		jsr	get_parameters
						;lets build the name
		jsr	rename_segments		;go and rename what we can		
		
		ldx	#func_13_param_cnt	;restore the stack for the loader
		jsr	restore_params
return13
		jml	$000000


		
patch_table		
		dc.l	9*4			;skip to Initial Load
		dc.l	L_init_load-1
		dc.l	return9
		
		dc.l	$0A*4
		dc.l	L_restart-1
		dc.l	returnA
		
		dc.l	$0B*4
		dc.l	L_seg_by_num-1		;load segment by number
		dc.l	returnB
		
		dc.l	$0C*4
		dc.l	L_unload1-1
		dc.l	returnC
		
		dc.l	$0D*4
		dc.l	L_seg_by_name-1		;load the segment by name
		dc.l	returnD
		
		dc.l	$0E*4
		dc.l	L_unload2-1
		dc.l	returnE
		
		dc.l	$10*4
		dc.l	L_get_userID-1
		dc.l	return10
		
		dc.l	$11*4
		dc.l	L_get_pathname-1
		dc.l	return11
		
		dc.l	$12*4
		dc.l	L_user_shutdown-1
		dc.l	return12

		dc.l	$13*4
		dc.l	L_rename_path-1
		dc.l	return13
		
		dc.l	$20*4			;initial load 2 routine
		dc.l	L_initial2-1
		dc.l	return15
		
		dc.l	$22*4			;get pathname call
		dc.l	L_getpath2-1
		dc.l	return16
	
		dc.l	$21*4			;get pathname call
		dc.l	L_get_userID2-1
		dc.l	return17

		
		dc.l	0000
		endp

		eject
****************************************************************************************************
*
* draw_express - draws splash screen text
*
****************************************************************************************************

draw_express	proc

line		equ	$A0
progress_start	equ	$e15109+02+(line*17)

		php
		
		pei	temp_word
		pei	temp_ptr
		pei	temp_ptr+2

		lda	#$0008
		sta	temp_word
;
;setup pointer to graphics screen area I am going to write to.
;
		lda	#progress_start**$FFFF
		sta	temp_ptr
		lda	#^progress_start
		sta	temp_ptr+2
		ldy	#$0000
		tyx

		longa	off
		longi	on
		sep	#$20
		lda	>show_splash
		bmi	loop				;I am being called because user wants screen
		
		lda	>$00C025			;read the AppleKey while I boot
		and	#$C0				;leave Option/Apple Key
		cmp	#$C0
		bne	jump_out
loop					 
		lda	Expanded_name.my_string,x	;grab graphics line from our buffer
		sta	[temp_ptr],y
		inx
		iny
		cpy	#Expanded_name.line_length	;move one line then update base pointer
		bne	loop

		longa	on
		rep	#$20
		clc
		lda	temp_ptr
		adc	#line		;move to the next line
		sta	temp_ptr		
		lda	temp_ptr+2
		adc	#$0000
		sta	temp_ptr+2
		longa	off
		sep	#$20
		
		ldy	#$0000
		dec	temp_word	;see if we have done enough lines
		bne	loop

		longa	on
		longi	on
		rep	#$20
		lda	#$FFFF		;we do not need to draw this twice.
		sta	>show_splash
jump_out
		rep	#$20
		pla
		sta	temp_ptr+2
		pla
		sta	temp_ptr
		pla
		sta	temp_word

		plp
		rts			;we are done

		endp		
		end