Apple-2-SW/qasm
1
0 Fork 0
mirror of https://github.com/marketideas/qasm.git synced 2026-10-25 13:02:45 +00:00
Code Issues Projects Releases Wiki Activity
Files
dev
qasm/IIGS.601.SRC/GS.OS/Loader/ExpressLoad/ExpressLoad.src
T
Shawn Quick dfcaae62dd Add qlink, the disk tools, and a bootable ProDOS 8 image. 
Move the assembler to src/qasm. qlink links OMF 1.0 and 2.0 from a script. makeBin flattens a load file, qomf dumps OMF, and qpro builds ProDOS volumes. APW and MPW assemble through the ORCA front end. Relocatable modules emit OMF objects. Listings stay off unless -l is set.

make boot assembles the GS/OS 6.0.1 ProDOS 8 kernel and BASIC.SYSTEM into an 800K volume. BASIC.SYSTEM accepts ls and pfx, and its splash reports PRODOS BASIC 2.0, copyright 1983-2026. IIGS.601.SRC is the source and the BASIC.SYSTEM oracle that image is built from.
2026-10-16 14:41:55 -07:00

1 line
189 KiB
Plaintext
Raw Permalink Blame History

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
Reference in new issue View Git Blame Copy Permalink