mirror of
https://github.com/marketideas/qasm.git
synced 2026-10-24 22:02:28 +00:00
Shawn Quick
dfcaae62dd
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.
1 line
144 KiB
Plaintext
1 line
144 KiB
Plaintext
TITLE ', ExpressLoad.a - Switch_handler'
|
|
SEG 'Loader'
|
|
;====================================================================================================
|
|
;Switch_handler This routine is called when we switch from GS/OS to ProDOS 8 and when we switch
|
|
; from ProDOS8 to GS/OS.
|
|
;
|
|
;Input: 1 = Switch P8 to GS/OS, 0 = Switch GS/OS to P8
|
|
;
|
|
;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
|
|
LoadSegCheck
|
|
|
|
with DirectPage, Globals
|
|
|
|
Import clear_handles, alloc_my_dp
|
|
|
|
function equ 7
|
|
|
|
lda function,s ;get the input parameter
|
|
tax ;save in X for a minute
|
|
lda 5,s ;remove input parameter from stack
|
|
sta 7,s ;by moving two return addresses up
|
|
lda 3,s
|
|
sta 5,s
|
|
pla
|
|
sta 1,s
|
|
|
|
phb
|
|
phk ;set our data bank register
|
|
plb
|
|
phd ;save caller's direct page
|
|
|
|
txa ;check the input parameter
|
|
bne @restore_dp ;goin' back to GS/OS
|
|
|
|
lda Globals.my_dir_page ;setup our own direct page
|
|
tcd
|
|
|
|
ldx #dir_page_size-2 ;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
|
|
_DisposeHandle
|
|
stz dp_handle
|
|
stz dp_handle+2
|
|
bra no_errors
|
|
|
|
@restore_dp
|
|
jsr alloc_my_dp ;allocate me a direct page please
|
|
bcs error_exit ;return the error
|
|
|
|
ldx #dir_page_size-2 ;save the direct page please
|
|
@restore_loop lda dir_page_buffer,x
|
|
sta 00,x
|
|
dex
|
|
dex
|
|
bpl @restore_loop
|
|
no_errors
|
|
lda #0 ;no errors
|
|
clc
|
|
error_exit
|
|
pld ;restore direct page
|
|
plb ;and DBR
|
|
rtl
|
|
|
|
endp
|
|
|
|
if 0 then ;nobody likes my special graphics <pout>
|
|
TITLE ', ExpressLoad.a - draw_express'
|
|
****************************************************************************************************
|
|
*
|
|
* draw_express - draws splash screen text
|
|
*
|
|
****************************************************************************************************
|
|
|
|
draw_express proc
|
|
LoadSegCheck
|
|
|
|
with DirectPage, Globals
|
|
|
|
line equ $A0
|
|
progress_start PointAddress 95,310
|
|
my_string_width equ $001a
|
|
my_string_height equ $0007
|
|
|
|
sep #$20 ;8-bit accumulator
|
|
longa off
|
|
lda >$E0C025
|
|
bit #%00000100 ;Caps Lock key down?
|
|
rep #$20
|
|
longa on
|
|
beq jump_out ;no, just skip it
|
|
|
|
lda #my_string_height
|
|
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
|
|
ldx #$0000
|
|
|
|
longa off
|
|
longi on
|
|
sep #$20
|
|
loop1
|
|
ldy #$0000
|
|
loop
|
|
lda splash_image,x ;grab graphics line from our buffer
|
|
sta [temp_ptr],y
|
|
inx
|
|
iny
|
|
cpy #my_string_width ;move one line then update base pointer
|
|
bne loop
|
|
|
|
clc
|
|
lda temp_ptr
|
|
adc #line ;move to the next line
|
|
sta temp_ptr
|
|
bcc @1
|
|
inc temp_ptr+1
|
|
@1
|
|
dec temp_word ;see if we have done enough lines
|
|
bne loop1
|
|
|
|
longa on
|
|
longi on
|
|
rep #$20
|
|
jump_out
|
|
rts ;we are done
|
|
|
|
splash_image
|
|
HEX FFFFFFFFFFFF03FFFFFFFFFFFF
|
|
HEX FC0FFFFFFFFFFFF03FFFFFF003
|
|
HEX FFFF4444444F03FFFFFFFFFFFF
|
|
HEX FC0FFFFFFFFFFFF0303FFFC303
|
|
HEX FFFFFFFFFFFF03FFF003FC003F
|
|
HEX 000FC00FC003FFF0303FFF0303
|
|
HEX F44444444FFF03FFC0C0F0303C
|
|
HEX 0C0F0303C03FFFC0303FFF0303
|
|
HEX FFFFFFFFFFFC0FFF0303C0C0F0
|
|
HEX 303C000F03FFFFC000FFFC0C0F
|
|
HEX FFFFF4444FFC0FFF0303C0C0F0
|
|
HEX 303C0FFF03FFFFFFC0FFFC0C3F
|
|
HEX FFFFFFFFFFFC000FC00FF000FC
|
|
HEX 003F003F03FFFFFFC0F03C00FF
|
|
|
|
endp
|
|
endif
|
|
|
|
TITLE ', ExpressLoad.a - startup'
|
|
;====================================================================================================
|
|
;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
|
|
LoadSegCheck
|
|
|
|
with DirectPage
|
|
|
|
Import alloc_my_dp,add_id_table
|
|
|
|
sep #$20 ;go into 8-bit mode
|
|
longa off
|
|
lda >statereg ;get current language card setting
|
|
pha ;save on stack temporarily
|
|
lda >$E0C08B ;turn language card on
|
|
lda >$E0C08B
|
|
rep #$20
|
|
longa on
|
|
|
|
jsr alloc_my_dp ;allocate me a direct page please
|
|
bcs @error_exit
|
|
|
|
ldx #256
|
|
@clear_it
|
|
dex
|
|
dex
|
|
stz DirectPage,x ;zero out my direct page
|
|
bne @clear_it
|
|
|
|
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
|
|
@error_exit
|
|
tax ;save any possible error code
|
|
sep #$20 ;8-bit accumulator
|
|
longa off
|
|
pla ;retrieve saved language card state
|
|
sta >statereg ;restore it
|
|
rep #$20
|
|
longa on
|
|
txa ;retrieve possible error code
|
|
rts ;return the error code to caller
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - get_parameters'
|
|
;====================================================================================================
|
|
;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
|
|
LoadSegCheck
|
|
|
|
with DirectPage, Globals
|
|
Import zero_handles,reset_local_mark
|
|
|
|
;
|
|
;Save the data bank register
|
|
;
|
|
phb
|
|
phb ;save the bank register first
|
|
pla
|
|
;
|
|
;Set data bank register to our bank
|
|
;
|
|
phk
|
|
plb ;set data bank to our bank.
|
|
sta data_bank ;save caller's DBR
|
|
;
|
|
;Save the return address
|
|
;
|
|
pla ;save RTS
|
|
sta local_return
|
|
|
|
;
|
|
;save the app's 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_addr+4
|
|
|
|
phx ;save the # of input parameters
|
|
|
|
jsl incbusyflg ;don't let nobody bother us!
|
|
|
|
;
|
|
; enable the language card memory
|
|
;
|
|
sep #$20 ;8-bit soft-switch access
|
|
longa off
|
|
lda >statereg ;get the current setting
|
|
sta save_statereg
|
|
lda >$E0C08B ;turn language card on
|
|
lda >$E0C08B
|
|
rep #$20
|
|
longa on
|
|
|
|
ply ;retrieve the # of input parameters
|
|
beq @done ;we have done our job
|
|
;
|
|
;now we need to pull the needed parameters off of the stack.
|
|
;
|
|
ldx #$0000
|
|
@loop
|
|
pla ;get a byte off the stack
|
|
sta input_parms,x ;save the byte in a common parameter block
|
|
inx
|
|
inx
|
|
dey
|
|
dey
|
|
bne @loop
|
|
@done
|
|
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
|
|
|
|
TITLE ', ExpressLoad.a - return_to_caller'
|
|
;====================================================================================================
|
|
;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
|
|
LoadSegCheck
|
|
|
|
with DirectPage, Globals
|
|
Import close_load_file
|
|
|
|
sta local_error
|
|
|
|
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
|
|
sep #$20 ;8-bit soft-switch access
|
|
longa off
|
|
lda save_statereg ;get the original setting
|
|
sta >statereg ;reset
|
|
rep #$20
|
|
longa on
|
|
|
|
jsl decbusyflg ;we be done now
|
|
|
|
lda return_addr+4
|
|
pha
|
|
lda return_addr+2
|
|
pha
|
|
lda return_addr
|
|
pha
|
|
|
|
|
|
lda apps_dir_page
|
|
tcd ;restore the direct page
|
|
lda data_bank
|
|
pha
|
|
lda local_error
|
|
plb
|
|
plb
|
|
cmp #$0001
|
|
rtl
|
|
|
|
local_error dc.w 00
|
|
|
|
endp
|
|
|
|
|
|
TITLE ', ExpressLoad.a - lock_handles'
|
|
;====================================================================================================
|
|
;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 DirectPage,Globals
|
|
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
|
|
|
|
entry 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
|
|
|
|
TITLE ', ExpressLoad.a - clear_handles'
|
|
;
|
|
; Language card portion of loader starts here
|
|
;
|
|
|
|
SEG 'Loader_LC'
|
|
;====================================================================================================
|
|
;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
|
|
with DirectPage
|
|
|
|
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
|
|
|
|
TITLE ', ExpressLoad.a - alloc_ExpLoad'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
lda #uExpressSegment ;my ID
|
|
bra do_alloc ;go allocate
|
|
|
|
;====================================================================================================
|
|
;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, do_alloc
|
|
alloc_mem
|
|
lda |USERID ;use application ID for normal allocation
|
|
do_alloc
|
|
pha ;space for handle
|
|
pha
|
|
phy ;high request bytes
|
|
phx ;low request bytes
|
|
pha ;userID
|
|
pea attrLocked ;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
|
|
|
|
TITLE ', ExpressLoad.a - alloc_my_dp'
|
|
;====================================================================================================
|
|
;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 Globals
|
|
Import DeRef
|
|
|
|
lda #0
|
|
pha ;space for handle
|
|
pha
|
|
pha ;request bytes
|
|
pea 256
|
|
pea uDirectPage ;userID
|
|
pea #attr_locked+attr_bank+attr_page
|
|
pha ;MUST be in bank 0
|
|
pha
|
|
_NewHandle
|
|
plx
|
|
ply ;get the handle
|
|
stx dp_handle ;save my handle please
|
|
sty dp_handle+2
|
|
bcs @oops
|
|
txa ;put low word into accumulator
|
|
jsr DeRef ;get the pointer to the direct page
|
|
sta my_dir_page
|
|
tcd ;go ahead and setup the direct register
|
|
@oops
|
|
rts ;and return it
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - alloc_LConst_seg'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
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
|
|
lda |USERID
|
|
pha
|
|
lda mem_attr
|
|
pha
|
|
lda org_address+2
|
|
pha
|
|
lda org_address ;address to start at
|
|
pha
|
|
_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 |USERID ;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
|
|
lda free_mem_size+2
|
|
pha
|
|
lda free_mem_size
|
|
pha
|
|
lda |USERID
|
|
pha
|
|
lda mem_attr
|
|
pha
|
|
lda search_addr+2 ;address to start at
|
|
pha
|
|
lda search_addr
|
|
pha
|
|
_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
|
|
|
|
TITLE ', ExpressLoad.a - add_id_table'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
ldx #id_tbl_size ;allocate the table please
|
|
ldy #$0000
|
|
lda #uUserIDTable ;ID to use for the user id table
|
|
jsr do_alloc ;go and allocate memory
|
|
bcs @oops
|
|
|
|
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
|
|
@oops
|
|
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)
|
|
sta temp_handle
|
|
lda [user_id_ptr],y
|
|
sta temp_handle+2
|
|
ora temp_handle
|
|
bne @search_loop
|
|
|
|
ldy #User_ID_Table.Next+2 ;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
|
|
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - reset_local_mark'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
lda #$FFFF
|
|
sta local_mark
|
|
sta local_mark+2
|
|
rts
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - seg_num_lookup'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
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
|
|
|
|
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
|
|
|
|
TITLE ', ExpressLoad.a - my_seg_to_user_seg'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
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
|
|
pla ;retrieve comparison value
|
|
@look_loop
|
|
cmp [temp_ptr],y ;is this the correct segment number?
|
|
beq @have_segment
|
|
iny
|
|
iny
|
|
bne @look_loop
|
|
|
|
lda #seg_not_found
|
|
sec
|
|
rts ;return the "Error"
|
|
|
|
@have_segment tya ;convert index to segment number
|
|
lsr a
|
|
inc a ;add one to convert from 0 to 1 based
|
|
clc
|
|
rts
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - error_routine'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
pha ;push the error code
|
|
pea err_string>>16
|
|
pea err_string
|
|
_SysFailMgr
|
|
brk $ff
|
|
|
|
string pascal
|
|
err_string dc.b 'ExpressLoad error: '
|
|
string asis
|
|
endp
|
|
|
|
|
|
TITLE ', ExpressLoad.a - make_HET_ptr'
|
|
;====================================================================================================
|
|
;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 = low word of pointer to Expressload Segment memory
|
|
; Y = high word of pointer to Expressload Segment memory
|
|
; 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 DirectPage, Globals
|
|
;
|
|
;Setup temp_ptr to point to the reserved field (of Disk Image) of the HET,
|
|
; and HET_ptr to point to the segment count field of the segment.
|
|
;
|
|
ldy #$0002
|
|
clc
|
|
lda [ExpressHandle]
|
|
sta temp_ptr ;temp now points the link field
|
|
tax
|
|
clc
|
|
adc #ExpressloadSeg.SegCount
|
|
sta HET_ptr ;and HET_ptr points to count field
|
|
lda [ExpressHandle],y
|
|
tay
|
|
sta temp_ptr+2
|
|
adc #0
|
|
sta HET_ptr+2
|
|
rts
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - setup_seg_ptrs'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
dec a ;convert the segment number please
|
|
dec a ;allow for ExpressLoad segment
|
|
|
|
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
|
|
|
|
TITLE ', ExpressLoad.a - setup_base_ptr'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
import add_segment_offset
|
|
|
|
ldy #HET_Entry.SegHandle ;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
|
|
ora [temp_handle]
|
|
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
|
|
|
|
TITLE ', ExpressLoad.a - alloc_id'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
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 #Application ;set the Type to Application
|
|
tax
|
|
@get_new
|
|
pea $0000 ;space for result
|
|
phx ;ID stuff
|
|
_GetNewID
|
|
plx
|
|
bcs @oops ;return the error
|
|
@exit_alloc
|
|
txa ;set A = user_id
|
|
sta |USERID ;this is now the Global_ID
|
|
clc
|
|
@oops
|
|
rts
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - compare_paths'
|
|
;====================================================================================================
|
|
;compare_paths: This routine will compare the full pathnames pointed to by PathnamePtr and
|
|
; TempBuff 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
|
|
; PathnamePtr & TempBuff point to the two pathnames to compare
|
|
;
|
|
;Output: A = undefined
|
|
; X = undefined
|
|
; Y = undefined
|
|
; P = nvmxdizc
|
|
; .x000..0 = Match found (complete or partial, depending on V flag)
|
|
; 1 = Match not found
|
|
; 0 = partial match found.
|
|
; 1 = complete match found.
|
|
; b = k
|
|
;
|
|
;
|
|
;====================================================================================================
|
|
|
|
longa on
|
|
longi on
|
|
compare_paths proc
|
|
with DirectPage, Globals
|
|
|
|
lda [PathnamePtr] ;compare the string sizes first
|
|
tay
|
|
cmp [TempBuff]
|
|
beq @do_full_check
|
|
bcc @chk_colon_full_blown ;PathnamePtr contains the smaller string.
|
|
lda [TempBuff]
|
|
tay
|
|
|
|
iny ;TempBuff contains the smaller string
|
|
iny
|
|
lda [PathnamePtr],y
|
|
bra @do_chk
|
|
|
|
@chk_colon_full_blown
|
|
iny
|
|
iny
|
|
lda [TempBuff],y
|
|
@do_chk
|
|
and #$00FF
|
|
cmp #seperator ;is it a seperator?
|
|
bne @not_same
|
|
|
|
@do_partial_compare
|
|
lda partial_match ;are we looking for a partial match?
|
|
bpl @not_same ;don't bother.
|
|
|
|
dey
|
|
longa off
|
|
sep #$20
|
|
@partial_loop
|
|
lda [PathnamePtr],y ;compare the ascii data
|
|
eor [TempBuff],y ;case insensitive comparison
|
|
beq @equal_1
|
|
cmp #$20 ;difference only in case?
|
|
bne @not_same ;nope!
|
|
lda [PathnamePtr],y ;get character again
|
|
cmp #'A' ;make sure it's alphabetic
|
|
bcc @not_same
|
|
cmp #'Z'+1
|
|
bcc @equal_1
|
|
cmp #'a' ;lower case?
|
|
bcc @not_same
|
|
cmp #'z'+1
|
|
bcs @not_same
|
|
@equal_1
|
|
dey
|
|
bne @partial_loop
|
|
rep #$61 ;clear overflow & carry bits
|
|
rts
|
|
|
|
@do_full_check
|
|
iny ;bump for leading length word
|
|
longa off
|
|
sep #$20
|
|
@loop
|
|
lda [PathnamePtr],y ;compare the ascii data
|
|
eor [TempBuff],y ;case insensitive comparison
|
|
beq @equal_2
|
|
cmp #$20 ;difference only in case?
|
|
bne @not_same ;nope!
|
|
lda [PathnamePtr],y ;get character again
|
|
cmp #'A' ;make sure it's alphabetic
|
|
bcc @not_same
|
|
cmp #'Z'+1
|
|
bcc @equal_2
|
|
cmp #'a' ;lower case?
|
|
bcc @not_same
|
|
cmp #'z'+1
|
|
bcs @not_same
|
|
@equal_2
|
|
dey
|
|
bne @loop
|
|
rep #$21 ;clears carry too
|
|
sep #$40 ;set overflow bit (full match)
|
|
rts ;the pathnames are the same
|
|
@not_same
|
|
longa on
|
|
rep #$20
|
|
sep #$41 ;no partial or complete match found
|
|
rts
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - merge_path'
|
|
;====================================================================================================
|
|
;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.
|
|
;
|
|
;merge_path_2: Alternate entry point that can be used when ExpressHandle already contains the handle.
|
|
;
|
|
;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
|
|
;
|
|
; PathnamePtr pointer to pathname within ExpressLoad segment
|
|
;
|
|
;====================================================================================================
|
|
|
|
longa on
|
|
longi on
|
|
merge_path proc
|
|
entry merge_path_2
|
|
|
|
with DirectPage, Globals
|
|
|
|
stx ExpressHandle
|
|
sty ExpressHandle+2
|
|
|
|
merge_path_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 #ExpressloadSeg.PathnameOffset ;offset to the volume name
|
|
clc
|
|
lda [temp_ptr],y
|
|
adc temp_ptr
|
|
sta PathnamePtr
|
|
lda #$0000
|
|
adc temp_ptr+2
|
|
sta PathnamePtr+2 ;PathnamePtr now points to the volume name
|
|
|
|
clc
|
|
rts
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - add_user_id'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
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
|
|
|
|
TITLE ', ExpressLoad.a - delete_user_id'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
sta id_flag ;used to determine if I should delete the user id
|
|
|
|
ldy #ID_Table_Entry.ExpressHandle
|
|
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
|
|
_DisposeHandle
|
|
@no_handle
|
|
lda [user_id_ptr] ;get the user_id
|
|
beq @zero_and_exit
|
|
|
|
pha ;ID to nuke
|
|
_DisposeAll
|
|
|
|
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
|
|
_DeleteID
|
|
|
|
@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
|
|
|
|
TITLE ', ExpressLoad.a - purge_user_id'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
lda [user_id_ptr] ;get the user_id
|
|
beq @exit
|
|
pha
|
|
_PurgeAll
|
|
@exit
|
|
rts
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - remove_segment'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
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 #HET_Entry.SegFlags
|
|
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 #HET_Entry.SegHandle ;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
|
|
_DisposeHandle
|
|
rts
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - find_user_id'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
tax
|
|
bne @use_input
|
|
lda |USERID ;use the global ID
|
|
@use_input
|
|
sta search_kind
|
|
sta |USERID ;update the global User ID
|
|
|
|
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 #User_ID_Table.Next+2 ;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 #$0002
|
|
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
|
|
|
|
TITLE ', ExpressLoad.a - path_to_user_id'
|
|
;====================================================================================================
|
|
;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
|
|
;
|
|
; TempBuff ;pointer to 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 DirectPage, Globals
|
|
|
|
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
|
|
ora [user_id_ptr]
|
|
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
|
|
tax
|
|
iny
|
|
iny
|
|
lda [user_id_ptr],y
|
|
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
|
|
|
|
TITLE ', ExpressLoad.a - find_seg_handle'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
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 #User_ID_Table.Next+2 ;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 |USERID
|
|
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 #HET_Entry.SegHandle ;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
|
|
|
|
TITLE ', ExpressLoad.a - get_seg_base'
|
|
;====================================================================================================
|
|
;get_seg_base: Given a segment number this routine will setup segment_base
|
|
;
|
|
;Input: A = segment_number
|
|
; X = undefined
|
|
; Y = undefined
|
|
; P = nvmxdizc
|
|
; ..000...
|
|
; b = undefined
|
|
;
|
|
; HET_ptr ;must be setup!
|
|
;
|
|
;Output: A = undefined
|
|
; X = undefined
|
|
; Y = undefined
|
|
; P = nvmxdizc
|
|
; ..000...
|
|
; b = k
|
|
;
|
|
;
|
|
;====================================================================================================
|
|
|
|
longa on
|
|
longi on
|
|
get_seg_base proc
|
|
with DirectPage
|
|
|
|
dec a ;HET table numbers are 0 thru (-n- minus 1)
|
|
dec a ;allow for ExpressLoad segment
|
|
|
|
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
|
|
;
|
|
;Now we need to setup our Base address for this segment
|
|
;
|
|
ldy #HET_Entry.SegHandle ;index to the handle
|
|
lda [HET_entry_ptr],y
|
|
sta temp_handle
|
|
iny
|
|
iny
|
|
lda [HET_entry_ptr],y
|
|
sta temp_handle+2
|
|
;
|
|
;Deref the handle to find out the base address
|
|
;
|
|
ldy #$0002
|
|
lda [temp_handle]
|
|
sta segment_base ;starting address of the segment
|
|
lda [temp_handle],y
|
|
sta segment_base+2
|
|
ora segment_base ;see if the segment has been purged!
|
|
bne @segment_alive ;great.
|
|
lda #seg_not_found
|
|
sec
|
|
rts
|
|
@segment_alive
|
|
clc
|
|
rts
|
|
|
|
TITLE ', ExpressLoad.a - Process_Reloc'
|
|
;====================================================================================================
|
|
;Process_Reloc: This routine is called to process the relocation dictionary of a segment
|
|
; ** NOTE ** This code changes the data bank register to the bank that
|
|
; contains the Relocation Dictionary. This means all data access to data in
|
|
; our bank must use long addressing.
|
|
;
|
|
;Input: A = segment number to relocate
|
|
; X = undefined
|
|
; Y = undefined
|
|
; P = nvmxdizc
|
|
; ..000...
|
|
; b = k
|
|
;
|
|
; HET_ptr ;pointer to HET (Header Entry Table) must be setup!
|
|
;
|
|
;Output: A = undefined
|
|
; X = undefined
|
|
; Y = undefined
|
|
; P = nvmxdizc
|
|
; ..000...
|
|
; b = k
|
|
;
|
|
;
|
|
;
|
|
;-Note-
|
|
; All Segments that this segment links to must be loaded into memory
|
|
;
|
|
;HET Entry definition:
|
|
;
|
|
; -------------------
|
|
; Number of segments (word)
|
|
; -------------------
|
|
; �
|
|
; �
|
|
; �
|
|
; ------------------- [This is one Header Entry, it is repeated -n- times]
|
|
; Relative offset to
|
|
; segment header (word)
|
|
; -------------------
|
|
; Flags (word) Bit 15 = loaded
|
|
; -------------------
|
|
; Handle to segment (Long) Points to the segment in memory
|
|
; -------------------
|
|
; �
|
|
; �
|
|
; �
|
|
;
|
|
;====================================================================================================
|
|
|
|
longa on
|
|
longi on
|
|
Process_Reloc proc
|
|
with DirectPage, Globals
|
|
|
|
; sta reloc_seg ;segment numbers are 1 thru -n-
|
|
jsr setup_seg_ptrs ;build pointers to the segment entries
|
|
|
|
;
|
|
;Now we need to setup our Base address for this segment
|
|
;
|
|
ldy #HET_Entry.SegHandle ;index to the handle
|
|
lda [HET_entry_ptr],y
|
|
sta temp_handle
|
|
iny
|
|
iny
|
|
lda [HET_entry_ptr],y
|
|
sta temp_handle+2
|
|
;
|
|
;Deref the handle to find out the base address
|
|
;
|
|
ldy #$0002
|
|
lda [temp_handle]
|
|
sta base_ptr ;starting address of the segment
|
|
lda [temp_handle],y
|
|
sta base_ptr+2
|
|
ora base_ptr ;see if the segment has been purged!
|
|
bne @segment_alive ;great.
|
|
@no_seg
|
|
sec
|
|
lda #seg_not_found ;sorry we cannot process the segment
|
|
rts
|
|
;
|
|
;Now we need to deref the handle to the relocation dictionary
|
|
;The handle for the relocation dictionary is located in the segment header
|
|
;
|
|
@segment_alive
|
|
ldy #SegHeaderEntry.RelocDict_Length ;now lets get the size of the segment
|
|
lda [seg_header_ptr],y
|
|
bne @its_there
|
|
iny
|
|
iny
|
|
lda [seg_header_ptr],y
|
|
bne @its_there
|
|
clc
|
|
rts ;easy case
|
|
@its_there
|
|
ldy #SegHeaderEntry.RelocDict_Hndl ;offset to the relocation dictionary handle
|
|
lda [seg_header_ptr],y ;get the handle
|
|
sta temp_handle
|
|
iny
|
|
iny
|
|
lda [seg_header_ptr],y
|
|
sta temp_handle+2
|
|
;
|
|
;now lets deref the handle and build a pointer to the relocation dictionary
|
|
;
|
|
ldy #$0002
|
|
lda [temp_handle]
|
|
sta reloc_dict_ptr ;points the relocation dictionary in memory
|
|
lda [temp_handle],y
|
|
sta reloc_dict_ptr+2
|
|
ora reloc_dict_ptr ;is the dictionary available
|
|
beq @no_seg
|
|
stz patch_cnt
|
|
stz shift_cnt
|
|
|
|
lda reloc_dict_ptr+1 ;set the data bank register to relocation dictionary
|
|
pha
|
|
plb ;get the Bank Address of Relocation Dictionary
|
|
plb
|
|
opcode_loop
|
|
lda (reloc_dict_ptr) ;get the current opcode
|
|
and #$00FF ;clear any garbage
|
|
beq do_end_handler ;this is the end handler
|
|
cmp #$00E2 ;valid record?
|
|
bcc @invalid_record ;no...
|
|
cmp #$F8
|
|
bcc @good_record
|
|
@invalid_record
|
|
lda #$00E4 ;translate into another invalid number
|
|
@good_record
|
|
asl a ;times two for word table
|
|
tax
|
|
jsr (opcode_handlers-$1C4,x) ;Subtract of base of opcodes ($1C4 = $E2*2)
|
|
bcc opcode_loop ;do the next opcode please
|
|
phk
|
|
plb ;restore our bank
|
|
rts ;return the error code
|
|
|
|
;
|
|
;This routine dispatches to the correct opcode handler
|
|
;
|
|
do_end_handler
|
|
pea we_are_done-1 ;this is the last one!
|
|
pea end_handler-1
|
|
rts
|
|
we_are_done
|
|
phk
|
|
plb ;restore our bank please
|
|
|
|
ldy #SegHeaderEntry.RelocDict_Hndl+2 ;offset to the relocation dictionary handle
|
|
lda [seg_header_ptr],y ;get the handle
|
|
pha
|
|
lda #$0000
|
|
sta [seg_header_ptr],y
|
|
dey
|
|
dey
|
|
lda [seg_header_ptr],y
|
|
pha
|
|
lda #$0000
|
|
sta [seg_header_ptr],y
|
|
|
|
_DisposeHandle
|
|
|
|
stz temp_handle ;make sure we note that the handle is invalid
|
|
stz temp_handle+2
|
|
|
|
clc
|
|
rts ;we did it!!!!
|
|
|
|
bad_opcode
|
|
sec
|
|
lda #illegal_record
|
|
rts ;exit with error
|
|
|
|
|
|
opcode_handlers
|
|
dc.w Reloc_handler ;$E2
|
|
dc.w Interseg_handler ;$E3
|
|
dc.w bad_opcode ;$E4
|
|
dc.w bad_opcode ;$E5
|
|
dc.w bad_opcode ;$E6
|
|
dc.w bad_opcode ;$E7
|
|
dc.w bad_opcode ;$E8
|
|
dc.w bad_opcode ;$E9
|
|
dc.w bad_opcode ;$EA
|
|
dc.w bad_opcode ;$EB
|
|
dc.w bad_opcode ;$EC
|
|
dc.w bad_opcode ;$ED
|
|
dc.w bad_opcode ;$EE
|
|
dc.w bad_opcode ;$EF
|
|
dc.w bad_opcode ;$F0
|
|
dc.w bad_opcode ;$F1
|
|
dc.w bad_opcode ;$F2
|
|
dc.w bad_opcode ;$F3
|
|
dc.w bad_opcode ;$F4
|
|
dc.w cReloc_handler ;$F5
|
|
dc.w cInterseg_handler ;$F6
|
|
dc.w super_handler ;$F7
|
|
|
|
TITLE ', ExpressLoad.a - Reloc_handler'
|
|
;====================================================================================================
|
|
;
|
|
;This routine will process a standard relocation entry
|
|
;
|
|
;Structure pointed to by Reloc_dict_ptr
|
|
;
|
|
; opcode $E2 (1 Byte)
|
|
; patch_cnt (1 byte: number of bytes to patch)
|
|
; bit_shift (1 byte: (+) = ASL (-) = LSR
|
|
; patch_offset (4 bytes: offset from the start of the segment)
|
|
; patch_value (4 bytes: offset from the start of the segment)
|
|
;
|
|
;====================================================================================================
|
|
|
|
Reloc_handler
|
|
ldy #$0001
|
|
lda (reloc_dict_ptr),y ;get the patch cnt and bit shift
|
|
sep #$20
|
|
sta patch_cnt ;the number of bytes to patch 1,2 or 3
|
|
xba
|
|
sta shift_cnt
|
|
rep #$20 ;back to 16 bit mode
|
|
|
|
ldy #$0003 ;point to the patch offset
|
|
clc
|
|
lda (reloc_dict_ptr),y
|
|
adc base_ptr ;base address
|
|
sta patch_ptr ;address to patch
|
|
ldy #$0005
|
|
lda (reloc_dict_ptr),y
|
|
adc base_ptr+2
|
|
sta patch_ptr+2 ;high word of patch address
|
|
|
|
ldy #$0007 ;point to the patch value field
|
|
clc
|
|
lda (reloc_dict_ptr),y
|
|
adc base_ptr
|
|
sta patch_value
|
|
ldy #$0009
|
|
lda (reloc_dict_ptr),y
|
|
adc base_ptr+2
|
|
sta patch_value+2 ;what we will patch with
|
|
|
|
clc
|
|
lda reloc_dict_ptr ;bump the relocation dictionary pointer please
|
|
adc #$000b
|
|
sta reloc_dict_ptr
|
|
bcc @low_only
|
|
inc reloc_dict_ptr+2 ;don't forget the high byte please
|
|
lda reloc_dict_ptr+1
|
|
pha
|
|
plb
|
|
plb ;setup for the new bank please
|
|
@low_only
|
|
jmp shift_patch ;the the patch please
|
|
|
|
TITLE ', ExpressLoad.a - cReloc_handler'
|
|
;====================================================================================================
|
|
;
|
|
;This routine will process a compressed relocation entry
|
|
;
|
|
;Structure pointed to by Reloc_dict_ptr
|
|
;
|
|
; opcode $F5 (1 Byte)
|
|
; patch_cnt (1 byte: number of bytes to patch)
|
|
; bit_shift (1 byte: (+) = ASL (-) = LSR
|
|
; patch_offset (2 bytes: offset from the start of the segment)
|
|
; patch_value (2 bytes: offset from the start of the segment)
|
|
;
|
|
;====================================================================================================
|
|
|
|
cReloc_handler
|
|
ldy #$0001
|
|
lda (reloc_dict_ptr),y ;get the patch cnt and bit shift
|
|
sep #$20
|
|
sta patch_cnt ;the number of bytes to patch 1,2 or 3
|
|
xba
|
|
sta shift_cnt
|
|
rep #$20 ;back to 16 bit mode
|
|
|
|
ldy #$0003 ;point the patch offset
|
|
clc
|
|
lda (reloc_dict_ptr),y
|
|
adc base_ptr ;base address
|
|
sta patch_ptr ;address to patch
|
|
lda #$0000
|
|
adc base_ptr+2
|
|
sta patch_ptr+2 ;high word of patch address
|
|
|
|
ldy #$0005 ;point to the patch value field
|
|
clc
|
|
lda (reloc_dict_ptr),y
|
|
adc base_ptr
|
|
sta patch_value
|
|
lda #$0000
|
|
adc base_ptr+2
|
|
sta patch_value+2 ;what we will patch with
|
|
|
|
clc
|
|
lda reloc_dict_ptr ;bump the relocation dictionary pointer please
|
|
adc #$0007
|
|
sta reloc_dict_ptr
|
|
bcc @low_only
|
|
inc reloc_dict_ptr+2 ;don't forget the high byte please
|
|
pei reloc_dict_ptr+1
|
|
plb
|
|
plb ;setup for the new bank please
|
|
@low_only
|
|
jmp shift_patch ;the the patch please
|
|
|
|
TITLE ', ExpressLoad.a - Interseg_handler'
|
|
;====================================================================================================
|
|
;
|
|
;This routine will process a Interseg relocation entry
|
|
;
|
|
;Structure pointed to by Reloc_dict_ptr
|
|
;
|
|
; opcode $E3 (1 Byte)
|
|
; patch_cnt (1 byte: number of bytes to patch)
|
|
; bit_shift (1 byte: (+) = ASL (-) = LSR
|
|
; patch_offset (4 bytes: offset from the start of the segment)
|
|
; file number (2 bytes: file number of load file: not supported yet)
|
|
; segment number (2 bytes: segment that we are linking to)
|
|
; patch_value (4 bytes: offset from the start of the destination segment)
|
|
;
|
|
;====================================================================================================
|
|
Interseg_handler
|
|
ldy #$0001
|
|
lda (reloc_dict_ptr),y ;get the patch cnt and bit shift
|
|
sep #$20
|
|
sta patch_cnt ;the number of bytes to patch 1,2 or 3
|
|
xba
|
|
sta shift_cnt
|
|
rep #$20 ;back to 16 bit mode
|
|
|
|
ldy #$0003 ;point the patch offset
|
|
clc
|
|
lda (reloc_dict_ptr),y
|
|
adc base_ptr ;base address
|
|
sta patch_ptr ;address to patch
|
|
ldy #$0005
|
|
lda (reloc_dict_ptr),y
|
|
adc base_ptr+2
|
|
sta patch_ptr+2 ;high word of patch address
|
|
|
|
ldy #$0007 ;now lets point to the file number
|
|
lda (reloc_dict_ptr),y
|
|
dec a ;better be one
|
|
beq @great
|
|
sec
|
|
lda #illegal_record
|
|
rts ;return the error
|
|
@great
|
|
ldy #$0009 ;get the segment number
|
|
lda (reloc_dict_ptr),y
|
|
and #$00FF
|
|
jsr get_seg_base
|
|
bcc @got_it
|
|
rts
|
|
@got_it
|
|
ldy #$000B ;offset to relative address in destination seg
|
|
clc
|
|
lda (reloc_dict_ptr),y
|
|
adc segment_base
|
|
sta patch_value
|
|
ldy #$000D
|
|
lda (reloc_dict_ptr),y
|
|
adc segment_base+2
|
|
sta patch_value+2
|
|
|
|
clc
|
|
lda reloc_dict_ptr ;bump the relocation dictionary pointer please
|
|
adc #$000F
|
|
sta reloc_dict_ptr
|
|
bcc @low_only
|
|
inc reloc_dict_ptr+2 ;don't forget the high byte please
|
|
lda reloc_dict_ptr+1
|
|
pha
|
|
plb
|
|
plb ;setup for the new bank please
|
|
@low_only
|
|
jmp shift_patch ;patch the segment please
|
|
|
|
TITLE ', ExpressLoad.a - cInterseg_handler'
|
|
;====================================================================================================
|
|
;
|
|
;This routine will process a compressed Interseg relocation entry
|
|
;
|
|
;Structure pointed to by Reloc_dict_ptr
|
|
;
|
|
; opcode $F6 (1 Byte)
|
|
; patch_cnt (1 byte: number of bytes to patch)
|
|
; bit_shift (1 byte: (+) = ASL (-) = LSR
|
|
; patch_offset (2 bytes: offset from the start of the segment)
|
|
; segment number (1 bytes: segment that we are linking to)
|
|
; patch_value (2 bytes: offset from the start of the destination segment)
|
|
;
|
|
;====================================================================================================
|
|
cInterseg_handler
|
|
ldy #$0001
|
|
lda (reloc_dict_ptr),y ;get the patch cnt and bit shift
|
|
sep #$20
|
|
sta patch_cnt ;the number of bytes to patch 1,2 or 3
|
|
xba
|
|
sta shift_cnt
|
|
rep #$20 ;back to 16 bit mode
|
|
|
|
ldy #$0003 ;point the patch offset
|
|
clc
|
|
lda (reloc_dict_ptr),y
|
|
adc base_ptr ;base address
|
|
sta patch_ptr ;address to patch
|
|
lda #$0000
|
|
adc base_ptr+2
|
|
sta patch_ptr+2 ;high word of patch address
|
|
|
|
ldy #$0005 ;get the segment number
|
|
lda (reloc_dict_ptr),y
|
|
and #$00FF ;one byte segment number
|
|
jsr get_seg_base
|
|
bcc @got_it
|
|
rts
|
|
@got_it
|
|
ldy #$0006 ;offset to relative address in destination seg
|
|
clc
|
|
lda (reloc_dict_ptr),y
|
|
adc segment_base
|
|
sta patch_value
|
|
lda #$0000
|
|
adc segment_base+2
|
|
sta patch_value+2
|
|
|
|
clc
|
|
lda reloc_dict_ptr ;bump the relocation dictionary pointer please
|
|
adc #$0008
|
|
sta reloc_dict_ptr
|
|
bcc @low_only
|
|
inc reloc_dict_ptr+2 ;don't forget the high byte please
|
|
lda reloc_dict_ptr+1
|
|
pha
|
|
plb
|
|
plb ;setup for the new bank please
|
|
@low_only
|
|
jmp shift_patch ;patch the segment please
|
|
|
|
TITLE ', ExpressLoad.a - super_handler'
|
|
;====================================================================================================
|
|
;super_handler This one is a bitch.
|
|
;
|
|
;There are several types of super records. Below is the list that I support.
|
|
;
|
|
; 1) Reloc2
|
|
; 2) Reloc3
|
|
; 3) Interseg1-Interseg36
|
|
;
|
|
;
|
|
;Super record structure:
|
|
;
|
|
; opcode $F7 ;byte
|
|
; ------------------------
|
|
; size of record ;long
|
|
; ------------------------
|
|
; record type ;byte
|
|
; ------------------------
|
|
; patch info: example
|
|
;
|
|
; $01 ;patch two bytes in page one of load segment
|
|
; $34 ;offset to 1st byte in page one of load segment
|
|
; $7A ;offset to 2nd byte in page one of load segment
|
|
; $81 ;skip 1 page. (High bit means lower 7 bits contain skip cnt)
|
|
; $00 ;patch one byte in page three of load segment
|
|
; $82 ;offset in page three to patch
|
|
;
|
|
;====================================================================================================
|
|
super_handler
|
|
lda base_ptr ;address of the segment
|
|
sta temp_ptr
|
|
lda base_ptr+2
|
|
sta temp_ptr+2
|
|
|
|
clc
|
|
lda reloc_dict_ptr
|
|
adc #$0006 ;pass the record type
|
|
sta super_ptr
|
|
lda reloc_dict_ptr+2
|
|
adc #$0000
|
|
sta super_ptr+2
|
|
|
|
ldy #$0001 ;get the total count of entries please
|
|
lda (reloc_dict_ptr),y ;get the size of the Super Record
|
|
sta super_size
|
|
dec a ;remove one for the opcode byte
|
|
sta cnt_word
|
|
ldy #$0003
|
|
lda (reloc_dict_ptr),y ;fail if non-zero
|
|
beq @size_ok
|
|
sec
|
|
lda #illegal_record
|
|
rts ;return the error
|
|
@size_ok
|
|
ldy #$0005 ;pass the size field
|
|
lda (reloc_dict_ptr),y
|
|
and #$00FF ;clear the garbage
|
|
tax
|
|
beq @reloc2_type ;do a reloc 2 type
|
|
dec a
|
|
beq @reloc3_type
|
|
;
|
|
;If we get here we know that this is an Interseg Record of some kind
|
|
;
|
|
txa ;get back the kind again
|
|
cmp #26
|
|
bcc @chk_14
|
|
|
|
jsr Interseg_26
|
|
bra @end_super ;we are done
|
|
@chk_14
|
|
cmp #14
|
|
bcc @one_thru_12
|
|
|
|
jsr Interseg_14 ;do the conversion
|
|
bra @end_super
|
|
@one_thru_12
|
|
jsr Interseg_1
|
|
bra @end_super
|
|
@reloc2_type
|
|
jsr reloc2
|
|
bra @end_super
|
|
@reloc3_type
|
|
jsr reloc3
|
|
|
|
@end_super
|
|
bcs @abort
|
|
lda super_size ;size of the data area
|
|
adc #$0005 ;overhead in record
|
|
clc
|
|
adc reloc_dict_ptr ;bump the relocation dictionary pointer please
|
|
sta reloc_dict_ptr
|
|
bcc @low_only
|
|
inc reloc_dict_ptr+2 ;don't forget the high byte please
|
|
lda reloc_dict_ptr+1
|
|
pha
|
|
plb
|
|
plb ;setup for the new bank please
|
|
@low_only
|
|
clc
|
|
@abort
|
|
rts
|
|
|
|
TITLE ', ExpressLoad.a - Interseg_1'
|
|
;====================================================================================================
|
|
;Interseg1 This routine is used to patch Super interseg records 1 thru 12:
|
|
;
|
|
;structure:
|
|
;
|
|
; If the opcode field is 3 thru 13 then this value indicates
|
|
; the file number (plus 1) to load from. I do not support this.
|
|
;
|
|
; relocation information is in the operand field of load segment.
|
|
; Format:
|
|
; Offset ;word
|
|
; segment number ;byte number of segment to link to.
|
|
;
|
|
;
|
|
;====================================================================================================
|
|
Interseg_1
|
|
ldy #$0005 ;lets get the segment number
|
|
lda (reloc_dict_ptr),y
|
|
and #$00FF ;get the record type
|
|
cmp #$0003 ;is the number 2 thru 12?
|
|
bcc @good_seg
|
|
lda #illegal_record ;sorry illegal record type
|
|
@good_seg
|
|
ldy #$0000
|
|
|
|
lda cnt_word ;see if we are done yet
|
|
beq @done
|
|
@outter_loop
|
|
lda [super_ptr],y ;get the command (8 Bits)
|
|
bit #$0080 ;clear all but the pages bit
|
|
beq @do_inner_loop ;process the relocation info
|
|
and #$007F ;get the number of pages to skip
|
|
|
|
xba ;multiply the number times 256
|
|
clc
|
|
adc temp_ptr
|
|
sta temp_ptr
|
|
bcc @low_only
|
|
inc temp_ptr+2
|
|
@low_only
|
|
iny ;bump index to the next byte
|
|
dec cnt_word ;reduce the count by one
|
|
bne @outter_loop
|
|
@done
|
|
clc
|
|
rts ;we are done
|
|
|
|
|
|
@do_inner_loop
|
|
and #$007F ;number of entries we have to patch
|
|
tax
|
|
@inner_loop
|
|
dec cnt_word ;reduce the count by one
|
|
iny ;bump index to the next byte
|
|
|
|
lda [super_ptr],y ;A = offset
|
|
and #$00FF ;clear garbage
|
|
phy ;save the index please
|
|
|
|
tay
|
|
phy ;index to patch area
|
|
|
|
lda [temp_ptr],y ;get the relative offset in other segment
|
|
sta patch_value
|
|
iny
|
|
iny
|
|
lda [temp_ptr],y ;get the segment number to patch to
|
|
and #$00FF
|
|
jsr get_seg_base ;go and get the segment base address
|
|
ply ;get our index back please
|
|
bcc @have_segment
|
|
ply ;remove super index please
|
|
rts ;return the error
|
|
@have_segment
|
|
clc
|
|
lda segment_base
|
|
adc patch_value
|
|
sta [temp_ptr],y
|
|
iny
|
|
iny
|
|
lda segment_base+2
|
|
adc #$0000
|
|
sep #$20 ;8 bit store only
|
|
sta [temp_ptr],y ;save the new address please
|
|
rep #$20 ;16 bit mode
|
|
|
|
ply ;restore super index
|
|
dex
|
|
bpl @inner_loop ;process this page
|
|
|
|
iny ;bump to next byte
|
|
inc temp_ptr+1 ;add 256 to the page pointer
|
|
dec cnt_word ;reduce the count by one
|
|
bne @outter_loop
|
|
clc
|
|
rts
|
|
|
|
TITLE ', ExpressLoad.a - Interseg_14'
|
|
;====================================================================================================
|
|
;Interseg_14 This routine processes interseg 14 thru interseg 24 types.
|
|
; This type allows a 16 bit patch with no shifting.
|
|
;
|
|
;Structure:
|
|
;
|
|
; The segment number to process is in the opcode byte. To determine
|
|
; the real segment number just subtract 13 from the stored value.
|
|
;
|
|
;====================================================================================================
|
|
Interseg_14
|
|
ldy #$0005 ;lets get the segment number
|
|
sec
|
|
lda (reloc_dict_ptr),y
|
|
and #$00FF ;get the record type
|
|
sbc #13
|
|
jsr get_seg_base ;setup the base address for this segment
|
|
ldy #$0000 ;init super index
|
|
bcc @continue
|
|
rts ;return the error
|
|
|
|
@continue
|
|
lda cnt_word ;see if we are done yet
|
|
beq @done
|
|
@outter_loop
|
|
lda [super_ptr],y ;get the command (8 Bits)
|
|
bit #$0080 ;clear all but the pages bit
|
|
beq @do_inner_loop ;process the relocation info
|
|
and #$007F ;get the number of pages to skip
|
|
|
|
xba ;multiply the number times 256
|
|
clc
|
|
adc temp_ptr
|
|
sta temp_ptr
|
|
bcc @low_only
|
|
inc temp_ptr+2
|
|
@low_only
|
|
iny ;bump index to the next byte
|
|
dec cnt_word ;reduce the count by one
|
|
bne @outter_loop
|
|
@done
|
|
clc
|
|
rts
|
|
|
|
@do_inner_loop
|
|
and #$007F ;number of entries we have to patch
|
|
tax
|
|
@inner_loop
|
|
dec cnt_word ;reduce the count by one
|
|
iny ;point to the next byte
|
|
|
|
lda [super_ptr],y ;A = offset
|
|
and #$00FF ;clear garbage
|
|
phy ;save super index
|
|
tay ;build patch record index
|
|
|
|
clc ;do the 16 bit patch
|
|
lda [temp_ptr],y ;get the relative offset in other segment
|
|
adc segment_base
|
|
sta [temp_ptr],y
|
|
|
|
ply ;get back super index
|
|
dex
|
|
bpl @inner_loop ;process this page
|
|
|
|
iny ;point to the next byte
|
|
inc temp_ptr+1 ;point to the next page please
|
|
dec cnt_word ;reduce the count by one
|
|
bne @outter_loop
|
|
clc
|
|
rts
|
|
|
|
TITLE ', ExpressLoad.a - Interseg_26'
|
|
;====================================================================================================
|
|
;Interseg_26 This routine processes interseg 25 thru interseg 36 types.
|
|
; This type allows a 16 bit patch with 16 bit shifting.
|
|
;
|
|
;Structure:
|
|
;
|
|
; The segment number to process is in the opcode byte. To determine
|
|
; the real segment number just subtract 25 from the stored value.
|
|
;====================================================================================================
|
|
Interseg_26
|
|
ldy #$0005 ;lets get the segment number
|
|
sec
|
|
lda (reloc_dict_ptr),y
|
|
and #$00FF ;get the record type
|
|
sbc #25
|
|
jsr get_seg_base ;setup the base address for this segment
|
|
ldy #$0000 ;init the super index pointer
|
|
bcc @continue
|
|
rts ;return the error
|
|
@continue
|
|
lda cnt_word ;see if we are done yet
|
|
beq @done
|
|
@outter_loop
|
|
lda [super_ptr],y ;get the command (8 Bits)
|
|
bit #$0080 ;clear all but the pages bit
|
|
beq @do_inner_loop ;process the relocation info
|
|
and #$007F ;get the number of pages to skip
|
|
|
|
xba ;multiply the number times 256
|
|
clc
|
|
adc temp_ptr
|
|
sta temp_ptr
|
|
bcc @low_only
|
|
inc temp_ptr+2
|
|
@low_only
|
|
iny ;bump index to point to the next byte
|
|
dec cnt_word ;reduce the count by one
|
|
bne @outter_loop
|
|
@done
|
|
clc
|
|
rts
|
|
|
|
@do_inner_loop
|
|
and #$007F ;number of entries we have to patch
|
|
tax
|
|
@inner_loop
|
|
dec cnt_word ;reduce the count by one
|
|
iny ;point to the next byte
|
|
|
|
lda [super_ptr],y ;A = offset
|
|
and #$00FF ;clear garbage
|
|
phy ;save super index
|
|
tay ;build index to patch address
|
|
|
|
lda [temp_ptr],y ;get the relative offset in other segment
|
|
sta patch_value
|
|
|
|
clc ;do the 16 bit patch
|
|
lda segment_base
|
|
adc patch_value
|
|
lda segment_base+2 ;store the upper 16 bits only
|
|
adc #$0000
|
|
sta [temp_ptr],y
|
|
|
|
ply ;restore super index
|
|
dex
|
|
bpl @inner_loop ;process this page
|
|
|
|
iny ;point to the next byte
|
|
inc temp_ptr+1 ;bump to the next page
|
|
dec cnt_word ;reduce the count by one
|
|
bne @outter_loop
|
|
clc
|
|
rts
|
|
|
|
TITLE ', ExpressLoad.a - reloc2'
|
|
;====================================================================================================
|
|
reloc2
|
|
ldy #$0000 ;init the index
|
|
@outter_loop
|
|
lda cnt_word ;see if we are done yet
|
|
bne @not_yet
|
|
clc
|
|
rts ;we are done
|
|
@not_yet
|
|
lda [super_ptr],y ;get the command (8 Bits)
|
|
bit #$0080 ;clear all but the pages bit
|
|
beq @do_inner_loop ;process the relocation info
|
|
and #$007F ;get the number of pages to skip
|
|
|
|
xba ;multiply the number times 256
|
|
clc
|
|
adc temp_ptr
|
|
sta temp_ptr
|
|
bcc @low_only
|
|
inc temp_ptr+2
|
|
@low_only
|
|
dec cnt_word ;reduce the count by one
|
|
iny ;bump index to the next byte
|
|
bra @outter_loop
|
|
|
|
|
|
@do_inner_loop
|
|
and #$007F ;number of entries we have to patch
|
|
tax
|
|
@inner_loop
|
|
dec cnt_word ;reduce the count by one
|
|
iny ;point to the next index please
|
|
|
|
lda [super_ptr],y ;A = offset
|
|
and #$00FF ;clear garbage
|
|
phy ;save super index
|
|
tay ;build index to the patch area
|
|
|
|
clc
|
|
lda [temp_ptr],y ;get the relative offset to patch with
|
|
adc base_ptr ;base address of segment
|
|
sta [temp_ptr],y
|
|
|
|
ply ;restore super index
|
|
dex
|
|
bpl @inner_loop ;process this page
|
|
|
|
dec cnt_word ;reduce the count by one
|
|
iny ;point to the next byte
|
|
inc temp_ptr+1 ;point to the next page please
|
|
bra @outter_loop
|
|
|
|
TITLE ', ExpressLoad.a - reloc3'
|
|
;====================================================================================================
|
|
reloc3
|
|
ldy #$0000 ;init super index to zero
|
|
@outter_loop
|
|
lda cnt_word ;see if we are done yet
|
|
bne @not_yet
|
|
clc
|
|
rts ;we are done
|
|
@not_yet
|
|
lda [super_ptr],y ;get the command (8 Bits)
|
|
bit #$0080 ;clear all but the pages bit
|
|
beq @do_inner_loop ;process the relocation info
|
|
and #$007F ;get the number of pages to skip
|
|
|
|
xba ;multiply the number times 256
|
|
clc
|
|
adc temp_ptr
|
|
sta temp_ptr
|
|
bcc @low_only
|
|
inc temp_ptr+2
|
|
@low_only
|
|
dec cnt_word ;reduce the count by one
|
|
iny ;point to next byte
|
|
bra @outter_loop
|
|
|
|
|
|
@do_inner_loop
|
|
and #$007F ;number of entries we have to patch
|
|
tax
|
|
@inner_loop
|
|
dec cnt_word ;reduce the count by one
|
|
iny ;point to next byte in super record
|
|
|
|
lda [super_ptr],y ;A = offset
|
|
and #$00FF ;clear garbage
|
|
phy ;save the super index please
|
|
tay
|
|
|
|
clc
|
|
lda [temp_ptr],y ;get the relative offset to patch with
|
|
adc base_ptr ;base address of segment
|
|
sta [temp_ptr],y
|
|
iny
|
|
iny
|
|
|
|
sep #$20 ;8 bit accumulator
|
|
lda [temp_ptr],y
|
|
adc base_ptr+2
|
|
sta [temp_ptr],y ;save the third byte please
|
|
rep #$20 ;16 bit accumulator
|
|
|
|
ply ;restore super index
|
|
dex
|
|
bpl @inner_loop ;process this page
|
|
|
|
dec cnt_word ;reduce the count by one
|
|
iny ;bump super record index
|
|
inc temp_ptr+1 ;bump to the next page please
|
|
bra @outter_loop
|
|
|
|
;====================================================================================================
|
|
;End_handler: Just sets the flag indicating that we are done.
|
|
;====================================================================================================
|
|
|
|
end_handler
|
|
; lda #$FFFF
|
|
; sta >end_found ;indicate that we are done!!!
|
|
rts
|
|
|
|
TITLE ', ExpressLoad.a - shift_patch'
|
|
;====================================================================================================
|
|
;
|
|
;Below is the common patch code. This code will do the relocation of the operand field
|
|
;
|
|
;====================================================================================================
|
|
shift_patch
|
|
longa off
|
|
sep #$20
|
|
lda shift_cnt ;number of times to shift
|
|
beq @no_shift ;very common case
|
|
cmp #$F0 ;load the 3rd byte of address
|
|
beq @skip_16_bits
|
|
cmp #$F8 ;load the 2nd byte of address
|
|
beq @skip_8_bits
|
|
;
|
|
;we have now handled the common cases. So lets do the odd cases now
|
|
;
|
|
lda shift_cnt
|
|
bpl @shift_left ;not a commom case
|
|
sec
|
|
lda #$00
|
|
sbc shift_cnt ;convert twos compliment please
|
|
;
|
|
;do the slow shift right
|
|
;
|
|
longa on
|
|
rep #$20 ;back to 16 bit mode
|
|
and #$00FF ;clear garbage
|
|
tax ;count
|
|
@right_loop
|
|
lsr patch_value+2
|
|
ror patch_value ;shift by amount in x
|
|
dex
|
|
bne @right_loop
|
|
bra patch_it ;continue the patch
|
|
|
|
@shift_left
|
|
longa on
|
|
rep #$20
|
|
and #$00FF
|
|
tax
|
|
@left_loop
|
|
asl patch_value
|
|
rol patch_value+2
|
|
dex
|
|
bne @left_loop ;shift the correct amount
|
|
bra patch_it ;continue the patch
|
|
|
|
@skip_16_bits ;equals a shift 16
|
|
longa on
|
|
rep #$20
|
|
lda patch_value+2 ;get the high word please
|
|
sta patch_value
|
|
bra patch_it
|
|
|
|
@skip_8_bits ;equals a shift 8
|
|
longa on
|
|
rep #$20
|
|
lda patch_value+1
|
|
sta patch_value
|
|
bra patch_it
|
|
|
|
@no_shift ;equals no shift
|
|
longa on
|
|
rep #$20
|
|
patch_it
|
|
ldy #$0000
|
|
lda patch_cnt ;number of bytes to patch
|
|
asl a
|
|
tax
|
|
lda >quick_jump-2,x
|
|
pha
|
|
rts
|
|
quick_jump
|
|
dc.w one_byte-1
|
|
dc.w two_byte-1
|
|
dc.w three_byte-1
|
|
dc.w four_byte-1
|
|
|
|
one_byte
|
|
sep #$20
|
|
lda patch_value
|
|
sta [patch_ptr] ;store the value
|
|
rep #$20
|
|
clc
|
|
rts
|
|
two_byte
|
|
lda patch_value
|
|
sta [patch_ptr]
|
|
clc
|
|
rts
|
|
three_byte
|
|
lda patch_value
|
|
sta [patch_ptr]
|
|
ldy #$0001
|
|
lda patch_value+1
|
|
sta [patch_ptr],y
|
|
clc
|
|
rts
|
|
four_byte
|
|
ldy #$0002
|
|
lda patch_value
|
|
sta [patch_ptr]
|
|
lda patch_value+2
|
|
sta [patch_ptr],y
|
|
clc
|
|
rts
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - read_less_64k'
|
|
;====================================================================================================
|
|
;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
|
|
with DirectPage, Globals
|
|
|
|
stz |PRead.requestCount+2
|
|
sta |PRead.requestCount
|
|
export read_wBuf_ptr
|
|
read_wBuf_ptr
|
|
stx |PRead.dataBuffer
|
|
sty |PRead.dataBuffer+2
|
|
|
|
jsr lock_handles
|
|
jsl $e100a8
|
|
dc.w PD_READ ;class 0 read call
|
|
dc.l PRead
|
|
jsr unlock_handles
|
|
bcs @exit
|
|
|
|
lda |PRead.transferCount
|
|
adc local_mark ;bump the local mark please
|
|
sta local_mark
|
|
lda |PRead.transferCount+2
|
|
adc local_mark+2
|
|
sta local_mark+2
|
|
lda #$0000
|
|
clc
|
|
@exit
|
|
rts
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - set_mark'
|
|
;====================================================================================================
|
|
;set_mark: This routine will set the current file position
|
|
;
|
|
;
|
|
;Input: A = undefined
|
|
; 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
|
|
with DirectPage, Globals
|
|
|
|
stx |PSetMark.position
|
|
sty |PSetMark.position+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 SET_MARK ;class 0 set mark call
|
|
dc.l PSetMark
|
|
jsr unlock_handles
|
|
bcs @exit
|
|
|
|
lda |PSetMark.position
|
|
sta local_mark ;reset our mark please
|
|
lda |PSetMark.position+2
|
|
sta local_mark+2
|
|
@exit
|
|
rts
|
|
endp
|
|
|
|
|
|
TITLE ', ExpressLoad.a - check_express_seg'
|
|
;====================================================================================================
|
|
;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
|
|
;
|
|
; PathnamePtr pointer to file's pathname
|
|
;
|
|
;Output: A = undefined
|
|
; X = undefined
|
|
; Y = undefined
|
|
; P = nvmxdizc
|
|
; ..000...
|
|
; b = k
|
|
;
|
|
;
|
|
;====================================================================================================
|
|
|
|
longa on
|
|
longi on
|
|
check_express_seg proc
|
|
with DirectPage, Globals
|
|
|
|
ldx #Header
|
|
ldy #^Header
|
|
lda #SegmentHeader.SegHeaderSize ;read in segment header
|
|
jsr read_less_64k ;read in less then 64K
|
|
bcs @oops
|
|
@no_error
|
|
lda |PRead.transferCount ;is the segment > $47 bytes
|
|
cmp #SegmentHeader.SegHeaderSize
|
|
beq @good_size
|
|
sec
|
|
@oops
|
|
rts ;return with error flag
|
|
|
|
@good_size
|
|
lda Header.DispName ;offset to the name
|
|
clc
|
|
adc #10 ;pass my Name
|
|
clc
|
|
adc #Header
|
|
sta temp_ptr
|
|
lda #^Header
|
|
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
|
|
load_it
|
|
rep #$30
|
|
clc
|
|
rts
|
|
|
|
sorry_not_express
|
|
longa on
|
|
longi on
|
|
rep #$30
|
|
sec
|
|
rts
|
|
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - find_Segment'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
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 #SegHeaderEntry.Kind ;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
|
|
inc a ;account for ExpressLoad segment
|
|
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
|
|
|
|
TITLE ', ExpressLoad.a - chk_dynamic_seg'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
jsr make_HET_ptr ;setup pointer to the HETable
|
|
|
|
lda #dynamic ;Compare to Dynamic BIT
|
|
tax ;And Mask (Only Dynamic Bit is important)
|
|
ldy #unloaded_state ;only unloaded segments please
|
|
jsr find_Segment ;do the search
|
|
rts
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - save_ref_num'
|
|
;====================================================================================================
|
|
;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
|
|
;
|
|
; POpen.refNum ;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 DirectPage, Globals
|
|
|
|
lda |POpen.fileType ;retrieve returned 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]
|
|
sta temp_ptr ;temp now points the link field
|
|
lda [ExpressHandle],y
|
|
sta temp_ptr+2
|
|
|
|
lda |POpen.refNum ;save the file reference number since the file
|
|
sta [temp_ptr] ; contains Dynamic Segments.
|
|
rts
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - get_express_seg'
|
|
;====================================================================================================
|
|
;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
|
|
;
|
|
; PathnamePtr points to pathname
|
|
;
|
|
;Output: A = undefined
|
|
; X = undefined
|
|
; Y = undefined
|
|
; P = nvmxdizc
|
|
; ..000...
|
|
; b = k
|
|
;
|
|
;
|
|
;====================================================================================================
|
|
|
|
longa on
|
|
longi on
|
|
get_express_seg proc
|
|
with DirectPage, Globals
|
|
|
|
clc
|
|
lda Header.DispData
|
|
adc #$0005 ;Add in LConst overhead
|
|
tax
|
|
ldy #$0000
|
|
jsr set_mark
|
|
bcs @error_return
|
|
ldx Header.Length ;get the size of the disk image please
|
|
stx |PRead.requestCount
|
|
ldy Header.Length+2
|
|
sty |PRead.requestCount+2
|
|
;
|
|
;Now we need to add in the pathname overhead + mod date field overhead
|
|
;
|
|
lda [PathnamePtr] ;get the length of the pathname
|
|
clc
|
|
adc #10 ;add 2 (for length word) and 8 (for mod date)
|
|
clc
|
|
adc Header.Length ;add in ExpressLoad segment size
|
|
tax ;save request count low
|
|
lda #$0000
|
|
adc Header.Length+2
|
|
tay ;save request count high
|
|
|
|
jsr alloc_ExpLoad ;get enough memory to hold segment
|
|
bcs @error_return
|
|
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
|
|
|
|
;
|
|
;Lets go ahead and add the Express Segment into the User ID table
|
|
;
|
|
lda |USERID ;this is the ID to use
|
|
jsr add_user_id ;temp_ptr setup by Add_user_id
|
|
bcs @error_return
|
|
ldy #ID_Table_Entry.ExpressHandle ;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
|
|
bcs @error_return
|
|
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
|
|
@error_return
|
|
rts
|
|
|
|
TITLE ', ExpressLoad.a - store_pathname'
|
|
;====================================================================================================
|
|
;
|
|
;This routine will add in the pathname stored at [PathnamePtr] 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
|
|
;
|
|
; PathnamePtr pointer to pathname
|
|
; base_ptr pointer to ExpressLoad segment
|
|
;
|
|
;Output: A = undefined
|
|
; X = undefined
|
|
; Y = undefined
|
|
; P = nvmxdizc
|
|
; ..000...
|
|
; b = k
|
|
;
|
|
;Uses:
|
|
;
|
|
;====================================================================================================
|
|
|
|
store_pathname
|
|
clc
|
|
txa
|
|
adc |PRead.requestCount ;build a pointer to the Volume Name Buffer
|
|
sta super_ptr ;another temp pointer
|
|
tya
|
|
adc |PRead.requestCount+2
|
|
sta super_ptr+2 ;super_ptr now points past the ExpressLoad segment
|
|
|
|
ldy #6 ;copy 8 bytes
|
|
@store_date_loop
|
|
lda POpen.modDateTime,y
|
|
sta [super_ptr],y
|
|
dey
|
|
dey
|
|
bpl @store_date_loop
|
|
|
|
lda super_ptr ;update super_ptr to location for pathname
|
|
clc
|
|
adc #8
|
|
sta super_ptr
|
|
bcc @no_bump
|
|
inc super_ptr+2
|
|
@no_bump
|
|
lda [PathnamePtr] ;get the length
|
|
sta [super_ptr] ;and store in destination
|
|
inc a ;bump by 1 for leading length word
|
|
tay ;into indexor
|
|
sep #$20 ;8-bit mode
|
|
longa off
|
|
@store_name_loop
|
|
lda [PathnamePtr],y ;copy characters from source
|
|
sta [super_ptr],y ;to destination
|
|
dey ;continue until back at length word
|
|
bne @store_name_loop
|
|
rep #$20 ;back to 16-bit accumulator
|
|
longa on
|
|
|
|
ldy #ExpressloadSeg.PathnameOffset ;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
|
|
rts
|
|
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - close_dynamic_file'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
import close_load_file
|
|
|
|
pei temp_ptr ;save temp pointer please
|
|
pei temp_ptr+2
|
|
|
|
ldy #$0002
|
|
clc
|
|
lda [ExpressHandle]
|
|
sta temp_ptr ;temp now points the link field
|
|
lda [ExpressHandle],y
|
|
sta temp_ptr+2
|
|
|
|
lda [temp_ptr] ;see if there is reference number.
|
|
beq @exit ;no, just exit with Acc = 0
|
|
sta |POpen.refNum ;setup the reference number for closing
|
|
lda #$0000 ;zero the reference number in ExpressSegment
|
|
sta [temp_ptr]
|
|
|
|
inc a ;set the pCount
|
|
sta PSysPrefs.pCount
|
|
|
|
jsr lock_handles
|
|
jsl $e100a8 ;get the current system preferences
|
|
dc.w GetSysPrefs
|
|
dc.l PSysPrefs
|
|
;
|
|
;Save the current user's preference please
|
|
;
|
|
lda PSysPrefs.preferences
|
|
sta 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 PSysPrefs.preferences
|
|
|
|
jsl $e100a8
|
|
dc.w SetSysPrefs ;set the system preference
|
|
dc.l PSysPrefs
|
|
jsr unlock_handles
|
|
|
|
jsr close_load_file ;close the file please
|
|
|
|
lda users_prefs
|
|
sta PSysPrefs.preferences
|
|
jsr lock_handles
|
|
jsl $e100a8
|
|
dc.w SetSysPrefs ;restore the caller's system preference
|
|
dc.l PSysPrefs
|
|
jsr unlock_handles
|
|
@exit
|
|
plx
|
|
stx temp_ptr+2
|
|
plx
|
|
stx temp_ptr
|
|
cmp #$0001
|
|
rts ;exit with error if any
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - close_load_file'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
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]
|
|
sta temp_ptr ;temp now points the reference number field
|
|
lda [ExpressHandle],y
|
|
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
|
|
lda POpen.refNum ;is there a valid refNum?
|
|
beq @do_preference ;no, so don't do a global close
|
|
|
|
jsr lock_handles
|
|
jsl $e100a8
|
|
dc.w PD_CLOSE ;GS/OS close command
|
|
dc.l POpen.refNum
|
|
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
|
|
plp
|
|
pla ;restore the close error if any
|
|
rts
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - open_load_file'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
;
|
|
;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]
|
|
sta temp_ptr ;temp now points the reference number field
|
|
lda [ExpressHandle],y
|
|
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 |POpen.refNum ;save the reference number
|
|
lda #app_type ;setup the file type also
|
|
sta |POpen.fileType
|
|
brl @opened ;say that we already opened the file.
|
|
|
|
@get_pathname
|
|
|
|
|
|
@do_open
|
|
lda #10 ;pCount (return info up to OptionList)
|
|
sta |POpen.pCount
|
|
lda #$01 ;requestAccess
|
|
sta |POpen.requestAccess
|
|
sta PSysPrefs.pCount
|
|
inc a
|
|
sta PGetLevel.pCount
|
|
sta PSetLevel.pCount
|
|
stz PGetLevel.levelMode
|
|
stz PSetLevel.levelMode
|
|
stz POpen.resourceNumber ;resourceNumber (data fork always)
|
|
|
|
lda PathnamePtr ;address of GString
|
|
sta |POpen.pathname
|
|
lda PathnamePtr+2 ;address of GString
|
|
sta |POpen.pathname+2 ;setup the Open Parameter block
|
|
|
|
jsr lock_handles
|
|
|
|
jsl $e100a8 ;get the current system preferences
|
|
dc.w GetSysPrefs
|
|
dc.l PSysPrefs
|
|
;
|
|
;Save the current user's preference please
|
|
;
|
|
lda PSysPrefs.preferences
|
|
sta 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 PSysPrefs.preferences
|
|
|
|
jsl $e100a8
|
|
dc.w SetSysPrefs ;set the system preference
|
|
dc.l PSysPrefs
|
|
|
|
jsl $e100a8 ;do a get level call to get the current level
|
|
dc.w GetLevel
|
|
dc.l PGetLevel ;get the level
|
|
|
|
lda #my_level
|
|
sta PSetLevel.level
|
|
|
|
jsl $e100a8
|
|
dc.w SetLevel ;set the current level
|
|
dc.l PSetLevel
|
|
|
|
jsl $e100a8 ;call GS/OS
|
|
dc.w Open ;class 1 open call
|
|
dc.l POpen
|
|
pha
|
|
php
|
|
|
|
jsl $e100a8 ;set back to user's setting
|
|
dc.w SetLevel ;set the current level
|
|
dc.l PGetLevel ;(just reuse this parm block)
|
|
|
|
lda users_prefs
|
|
sta PSysPrefs.preferences
|
|
jsl $e100a8
|
|
dc.w SetSysPrefs ;restore the caller's system preference
|
|
dc.l PSysPrefs
|
|
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 |POpen.refNum ;setup the reference number
|
|
sta |PRead.fileRefNum
|
|
sta |PGetMark.markRefNum
|
|
sta |PSetMark.markRefNum
|
|
lda #$0001 ;indicate that the file is open
|
|
sta file_open
|
|
|
|
*** added 18-Aug-92 DAL -- allow file types $003x
|
|
lda |POpen.fileType
|
|
and #$FFF0
|
|
cmp #$0030
|
|
beq @chk_length
|
|
*** end 18-Aug-92
|
|
|
|
lda |POpen.fileType ;get returned filetype
|
|
cmp #Load_File
|
|
bcc @no_way
|
|
cmp #Last_Load_File+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 GET_EOF ; GetEOF
|
|
dc.l PGetMark
|
|
jsr unlock_handles
|
|
bcs @oops
|
|
lda |PGetMark.position ;is there anything in the file?
|
|
ora |PGetMark.position+2
|
|
bne @oops ;actually no error
|
|
@no_way
|
|
lda #not_load_file ;Incompatible file format
|
|
sec
|
|
@oops
|
|
rts ;return error
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - conv_attributes'
|
|
;====================================================================================================
|
|
;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
|
|
;
|
|
; 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 DirectPage, Globals
|
|
|
|
ldy #SegHeaderEntry.Kind ;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 ;save temporarily
|
|
;
|
|
;If the bank size = $10000 then we must set the no_cross bit in the attribute
|
|
;
|
|
ldx #$0008 ;default is can cross
|
|
ldy #SegHeaderEntry.BankSize ;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 #SegHeaderEntry.Align ;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 #SegHeaderEntry.Org ;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 #attr_align_in_bank
|
|
tsb mm_attr ;segment is aligned within the bank
|
|
|
|
;
|
|
;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
|
|
|
|
TITLE ', ExpressLoad.a - reset_jmp_tables'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
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 #HET_Entry.SegFlags ;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 #HET_Entry.SegHandle
|
|
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 #JE_FileNum ;see if we are done
|
|
lda [temp_ptr],y
|
|
beq @done
|
|
|
|
lda |USERID ;see if this is the user ID
|
|
cmp [temp_ptr]
|
|
bne @next_entry
|
|
|
|
ldy #JE_jsl ;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
|
|
|
|
TITLE ', ExpressLoad.a - make_purgable'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
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 #HET_Entry.SegFlags ;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 #HET_Entry.SegHandle ;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 #HET_Entry.SegFlags ;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
|
|
|
|
_SetPurge
|
|
rts ;return any error
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - purge_all_dyn'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
|
|
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 #SegHeaderEntry.Kind ;lets check the kind please
|
|
lda [seg_header_ptr],y
|
|
bpl @skip_it ;skip the segment if it is not dynamic
|
|
|
|
ldy #HET_Entry.SegFlags ;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
|
|
|
|
TITLE ', ExpressLoad.a - mark_all_purgable'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
|
|
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 |USERID ;push the User ID
|
|
pha
|
|
_HUnlockAll
|
|
|
|
;
|
|
; purge all other dynamic segments
|
|
;
|
|
lda |USERID ;push the User ID
|
|
pha
|
|
_PurgeAll
|
|
;
|
|
; make all static segments purgeable
|
|
;
|
|
pea $0003 ;Purge Level
|
|
lda |USERID ;push the User ID
|
|
pha
|
|
_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 #HET_Entry.SegFlags ;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 #HET_Entry.SegHandle ;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 #HET_Entry.SegFlags ;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
|
|
|
|
TITLE ', ExpressLoad.a - lock_statics'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
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 #HET_Entry.SegFlags ;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 #HET_Entry.SegHandle ;now lets see if the segment has been purged
|
|
lda [HET_entry_ptr],y
|
|
tax
|
|
iny
|
|
iny
|
|
lda [HET_entry_ptr],y
|
|
tay
|
|
ora [HET_entry_ptr] ;check for a null handle
|
|
bne @handle_OK
|
|
@bad_handle
|
|
sec
|
|
rts ;the handle is scewed up
|
|
@handle_OK
|
|
stx temp_handle
|
|
sty temp_handle+2
|
|
ldy #$0002
|
|
lda [temp_handle]
|
|
ora [temp_handle],y ;valid handle?
|
|
beq @bad_handle ;nope
|
|
|
|
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
|
|
_SetPurge
|
|
rts ;carry is set based on the call.
|
|
|
|
@not_static
|
|
clc
|
|
rts
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - lock_segment'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
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 #HET_Entry.SegFlags ;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 #HET_Entry.SegHandle ;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]
|
|
ora [temp_handle],y
|
|
bne @lock_it
|
|
|
|
ldy #HET_Entry.SegFlags ;mark segment as gone
|
|
lda #$0000
|
|
sta [HET_entry_ptr],y
|
|
ldy #HET_Entry.SegHandle
|
|
sta [HET_entry_ptr],y
|
|
iny
|
|
iny
|
|
sta [HET_entry_ptr],y ;zero the handle also
|
|
|
|
jsr clear_handles ;clear local copy of handle
|
|
_DisposeHandle
|
|
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 #HET_Entry.SegFlags ;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
|
|
|
|
TITLE ', ExpressLoad.a - load_segment'
|
|
;====================================================================================================
|
|
;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 - Pointer to SegHeaderEntry
|
|
;
|
|
;Output: A = undefined
|
|
; X = undefined
|
|
; Y = undefined
|
|
; P = nvmxdizc
|
|
; ..000...
|
|
; b = k
|
|
;
|
|
;
|
|
;====================================================================================================
|
|
|
|
longa on
|
|
longi on
|
|
load_segment proc
|
|
with DirectPage, Globals
|
|
|
|
stz reloc_handle
|
|
stz reloc_handle+2
|
|
ldy #SegHeaderEntry.RelocDict_Hndl ;set handle to zero
|
|
lda #$0000
|
|
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 #SegHeaderEntry.LConst_Mark+2
|
|
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 #SegHeaderEntry.LConst_Length ;now lets get the size of the segment
|
|
lda [seg_header_ptr],y
|
|
sta |PRead.requestCount
|
|
sta LConst_Size
|
|
iny
|
|
iny
|
|
lda [seg_header_ptr],y ;get the high count
|
|
sta |PRead.requestCount+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 #HET_Entry.SegHandle ;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 |PRead.requestCount
|
|
ldy |PRead.requestCount+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 |PRead.requestCount
|
|
ldy |PRead.requestCount+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 #HET_Entry.SegHandle ;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 #SegHeaderEntry.RelocDict_Mark
|
|
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 #SegHeaderEntry.RelocDict_Length ;now lets get the size of the segment
|
|
clc
|
|
lda [seg_header_ptr],y
|
|
adc #$0001
|
|
sta |PRead.requestCount
|
|
tax
|
|
iny
|
|
iny
|
|
lda [seg_header_ptr],y ;get the high count
|
|
adc #$0000
|
|
sta |PRead.requestCount+2
|
|
tay
|
|
|
|
lda |PRead.requestCount ;check for a zero length relocation dictionary
|
|
dec a
|
|
ora |PRead.requestCount+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 #SegHeaderEntry.RelocDict_Hndl ;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 #HET_Entry.SegFlags
|
|
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 #HET_Entry.SegFlags ;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 #HET_Entry.SegFlags ;set the static bit please
|
|
lda [HET_entry_ptr],y
|
|
ora #stat_type
|
|
sta [HET_entry_ptr],y
|
|
@its_dynamic
|
|
clc
|
|
rts
|
|
|
|
entry patch_jmp_tbl
|
|
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 #JE_FileNum ;see if we are done
|
|
lda [temp_ptr],y
|
|
beq @done
|
|
|
|
lda |USERID ;save the ID please
|
|
sta [temp_ptr]
|
|
|
|
ldy #JE_jsl ;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
|
|
bcc @loop
|
|
inc temp_ptr+2
|
|
bra @loop
|
|
@done
|
|
rts
|
|
|
|
Entry add_segment_offset
|
|
add_segment_offset
|
|
ldy #SegHeaderEntry.Entry ;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
|
|
|
|
TITLE ', ExpressLoad.a - find_Seg_name'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
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 #SegHeaderEntry.DispName ;get the displacement
|
|
lda [seg_header_ptr],y
|
|
adc #SegHeaderEntry.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)
|
|
ldy #SegHeaderEntry.LabLen ;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
|
|
|
|
@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
|
|
if 0 then ;segment name comparison should be case SENSITIVE
|
|
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
|
|
else
|
|
lda [temp_ptr],y ;get the character
|
|
cmp [path_ptr],y ;same as supplied?
|
|
bne @not_it ;nope!
|
|
endif
|
|
@check_next
|
|
dey
|
|
bne @compare_loop ;keep looking
|
|
rep #$30
|
|
clc
|
|
rts ;We have found the segment!
|
|
|
|
@not_it
|
|
rep #$30
|
|
sec
|
|
rts
|
|
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - save_dp_info'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
lda segment_entry ;address of the stack direct page
|
|
sta stack_addr
|
|
lda LConst_Size ;save the size please
|
|
sta stack_size
|
|
rts
|
|
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - load_statics'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
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 #SegHeaderEntry.Kind ;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
|
|
|
|
jsr lock_handles
|
|
lda segment_entry ;address of the segment just loaded
|
|
ldy segment_entry+2
|
|
jsr Do_Init_Segment
|
|
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
|
|
|
|
TITLE ', ExpressLoad.a - save_start'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
|
|
ldy #ID_Table_Entry.Stack_Addr ;save the address of the stack/direct page
|
|
lda stack_addr
|
|
sta [user_id_ptr],y
|
|
ldy #ID_Table_Entry.Stack_Size ;also save the size
|
|
lda stack_size
|
|
sta [user_id_ptr],y
|
|
ldy #ID_Table_Entry.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_Table_Entry.Stack_Addr ;get the address of the stack/direct page
|
|
lda [user_id_ptr],y
|
|
sta stack_addr
|
|
ldy #ID_Table_Entry.Stack_Size ;get save the size
|
|
lda [user_id_ptr],y
|
|
sta stack_size
|
|
ldy #ID_Table_Entry.Start_Addr
|
|
lda [user_id_ptr],y
|
|
sta starting_addr
|
|
iny
|
|
iny
|
|
lda [user_id_ptr],y
|
|
sta starting_addr+2
|
|
clc
|
|
rts
|
|
endp
|
|
|
|
TITLE ', ExpressLoad.a - reload_restart'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
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 #SegHeaderEntry.Kind
|
|
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
|
|
|
|
TITLE ', ExpressLoad.a - reload_inits'
|
|
;====================================================================================================
|
|
;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 DirectPage, Globals
|
|
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 #SegHeaderEntry.Kind
|
|
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 #HET_Entry.SegHandle ;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
|
|
|
|
TITLE ', ExpressLoad.a - zero_handles'
|
|
;====================================================================================================
|
|
;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 DirectPage
|
|
|
|
;
|
|
;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
|
|
|
|
TITLE ', ExpressLoad.a - rename_segments'
|
|
;====================================================================================================
|
|
;rename_segments: This routine will rename paths for ExpressLoad
|
|
;
|
|
;Input: A = undefined
|
|
; X = undefined
|
|
; Y = undefined
|
|
; P = nvmxdizc
|
|
; ..000...
|
|
; b = k
|
|
;
|
|
;Output: A = User ID
|
|
; X = undefined
|
|
; Y =undefined
|
|
; P = nvmxdizc
|
|
; ..000..1 = not found
|
|
; b = k
|
|
;
|
|
;
|
|
;====================================================================================================
|
|
|
|
longa on
|
|
longi on
|
|
rename_segments proc
|
|
with DirectPage, Globals
|
|
|
|
newAddr EQU input_parms
|
|
oldAddr EQU newAddr+4
|
|
|
|
ldx user_id_handle
|
|
ldy user_id_handle+2
|
|
@keep_going
|
|
stx temp_handle
|
|
sty temp_handle+2
|
|
|
|
ldy #$0002
|
|
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
|
|
|
|
jsr do_rename ;rename all files in this user_id chunk
|
|
|
|
ldy #$0004 ;unlock the handle
|
|
lda [temp_handle],y
|
|
and #$7FFF
|
|
sta [temp_handle],y
|
|
|
|
ldy #User_ID_Table.Next+2 ;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
|
|
|
|
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 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
|
|
Import MemMove
|
|
|
|
iny
|
|
iny ;get the ExpressHandle
|
|
lda [user_id_ptr],y
|
|
tax
|
|
iny
|
|
iny
|
|
lda [user_id_ptr],y
|
|
tay
|
|
jsr merge_path ;build a complete pathname
|
|
jsr compare_paths ;is this the one?
|
|
bcs @no_match ;yup
|
|
|
|
php ;save partial/full match status
|
|
lda ExpressHandle ;copy ExpressHandle into generic variable
|
|
sta Handle
|
|
lda ExpressHandle+2
|
|
sta Handle+2
|
|
|
|
lda [newAddr] ;get the length of the new name
|
|
sec
|
|
sbc [oldAddr] ;calculate difference (may be negative)
|
|
beq @no_size_change ;if same length, no adjustment necessary
|
|
jsr adjust_handle_size ;change the size of the Express Segment buffer
|
|
bcs @no_match ;just punt if we get an error
|
|
ldy #2 ;deref Handle
|
|
lda [Handle]
|
|
sta TempZero
|
|
lda [Handle],y
|
|
sta TempZero+2
|
|
|
|
ldy #ExpressloadSeg.PathnameOffset
|
|
clc
|
|
lda [TempZero],y
|
|
adc TempZero ;offset to position of pathname within segment
|
|
sta PathnamePtr
|
|
lda TempZero+2
|
|
adc #0
|
|
sta PathnamePtr+2
|
|
@no_size_change
|
|
plp ;retrieve complete/partial match status
|
|
jsr change_pathname ;go make the change
|
|
@no_match
|
|
rts ;else we're done with this one
|
|
|
|
entry change_pathname
|
|
change_pathname
|
|
php ;save overflow flag
|
|
bvs @full_match ;complete match, go move the new name in
|
|
@partial_match
|
|
lda [oldAddr] ;get length of matching portion of name
|
|
inc a ;adjust for leading length word
|
|
inc a
|
|
clc
|
|
adc PathnamePtr ;calculate address of remainder of name
|
|
tax
|
|
lda PathnamePtr+2
|
|
adc #0
|
|
pha ;put source pointer on stack
|
|
phx
|
|
|
|
lda [newAddr] ;get length of new name
|
|
inc a ;adjust for leading length word
|
|
inc a
|
|
clc
|
|
adc PathnamePtr ;calculate address of destination
|
|
tax
|
|
lda PathnamePtr+2
|
|
adc #0
|
|
pha ;put destination pointer on stack
|
|
phx
|
|
|
|
lda [PathnamePtr] ;get length of Express segment name
|
|
sec
|
|
sbc [oldAddr] ;calculate length of remainder of name
|
|
pha
|
|
jsr MemMove ;move the unchanging portion of name in
|
|
|
|
@full_match
|
|
lda [PathnamePtr] ;get length of original name
|
|
pha ;save on stack for a bit
|
|
|
|
pei newAddr+2 ;source pointer
|
|
pei newAddr
|
|
pei PathnamePtr+2 ;destination address
|
|
pei PathnamePtr
|
|
lda [newAddr]
|
|
inc a ;adjust for leading length word
|
|
inc a
|
|
pha
|
|
jsr MemMove ;move the new name in
|
|
|
|
pla ;retrieve original length
|
|
|
|
plp ;complete or partial match?
|
|
bvs @done ;complete, so we're done
|
|
sta [PathnamePtr] ;save here for a bit
|
|
lda [newAddr] ;calculate difference in size
|
|
sec
|
|
sbc [oldAddr]
|
|
clc ;calculate new length
|
|
adc [PathnamePtr]
|
|
sta [PathnamePtr] ;set new length
|
|
@done
|
|
rts ;we're done with this name
|
|
|
|
;====================================================================================================
|
|
;
|
|
;This routine will resize the ExpressLoad handle as needed
|
|
;
|
|
;====================================================================================================
|
|
entry adjust_handle_size
|
|
adjust_handle_size
|
|
|
|
pha ;save the amount of change
|
|
|
|
lda #$0000
|
|
pha
|
|
pha
|
|
pei Handle+2 ;push the high word of the handle
|
|
pei Handle
|
|
_GetHandleSize
|
|
|
|
ldx #0 ;init high word of difference
|
|
lda 5,s ;get difference value
|
|
bpl @enlarge ;if positive, must grow the segment
|
|
dex ;else sign extend the high word
|
|
@enlarge
|
|
clc
|
|
adc 1,s ;calculate the new size
|
|
tay ;save here for a second
|
|
txa ;do high word
|
|
adc 3,s
|
|
sta 5,s ;save the value back on the stack
|
|
pla ;remove old size
|
|
pla
|
|
phy ;and put low word of new size on stack
|
|
|
|
pei Handle+2
|
|
pei Handle
|
|
_HUnlock ;unlock the handle
|
|
|
|
; new size is already on stack
|
|
pei Handle+2
|
|
pei Handle
|
|
_SetHandleSize ;SetHandle size for ExpressLoad segment
|
|
rts
|
|
|
|
endp
|
|
|