mirror of
https://github.com/marketideas/qasm.git
synced 2026-10-25 13:02:45 +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
44 KiB
Plaintext
1 line
44 KiB
Plaintext
|
|
TITLE ', FUNCTIONS.a - LoaderInit'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Initialization ($01)
|
|
*
|
|
* Inputs: none
|
|
*
|
|
* Outputs: none
|
|
*
|
|
****************************************************************
|
|
*
|
|
LoaderInit PROC Export
|
|
LoadSegCheck
|
|
|
|
with Globals
|
|
IMPORT draw_express,startup
|
|
|
|
phb ;set up DBR
|
|
phk
|
|
plb
|
|
|
|
lda boot_flag ;is this the initial system boot-up?
|
|
beq @restart ;no, must be a restart after using P8
|
|
|
|
phd
|
|
jsr startup ;init my self
|
|
bcs @error ;oops!
|
|
if 0 then
|
|
jsr draw_express
|
|
endif
|
|
pld ;restore the direct page
|
|
stz boot_flag ;fix the flag
|
|
|
|
@restart
|
|
plb ;restore DBR
|
|
bra NoError
|
|
|
|
@error
|
|
pld ;restore caller's DP
|
|
plb ;and DBR
|
|
rtl ;and return to caller
|
|
|
|
TITLE ', FUNCTIONS.a - Version, Status, Startup, Shutdown, Reset'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Loader Version ($04)
|
|
*
|
|
* Inputs: none
|
|
*
|
|
* Outputs: Loader Version (2 bytes)
|
|
*
|
|
****************************************************************
|
|
*
|
|
Export LoaderVersion
|
|
LoaderVersion lda #Loader_Version
|
|
bra store_ret_value
|
|
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Loader Status ($06)
|
|
*
|
|
* Inputs: none
|
|
*
|
|
* Outputs: Status (TRUE or FALSE 2 bytes)
|
|
*
|
|
****************************************************************
|
|
*
|
|
Export LoaderStatus
|
|
LoaderStatus
|
|
lda #1 ;status is ALWAYS started
|
|
store_ret_value
|
|
sta 7,s
|
|
bra NoError
|
|
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Loader Startup ($02)
|
|
* Loader Shutdown ($03)
|
|
* Loader Reset ($05)
|
|
* other non-implemented functions
|
|
*
|
|
* Inputs: none
|
|
*
|
|
* Outputs: none
|
|
*
|
|
****************************************************************
|
|
*
|
|
EXPORT LoaderReset
|
|
LoaderReset
|
|
EXPORT LoaderStartup
|
|
LoaderStartup
|
|
EXPORT LoaderShutdown
|
|
LoaderShutdown
|
|
|
|
NoError lda #0
|
|
clc
|
|
rtl
|
|
|
|
ENDP
|
|
|
|
TITLE ', FUNCTIONS.a - No Function'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Loader Unsupported Function
|
|
*
|
|
* Inputs: none
|
|
*
|
|
* Outputs: none
|
|
*
|
|
****************************************************************
|
|
*
|
|
Load_NI Proc Export
|
|
LoadSegCheck
|
|
|
|
lda #$0002 ;synthesize tool setup error
|
|
sec
|
|
rtl
|
|
|
|
EndP
|
|
|
|
TITLE ', FUNCTIONS.a - LoadNum'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Load Segment by Number ($0B)
|
|
*
|
|
* Inputs: UserID (2 bytes)
|
|
* Load File Number (2 bytes)
|
|
* Load Segment Number (2 bytes)
|
|
* Outputs: Address of segment (4 bytes)
|
|
* Errors: $0000 - Operation successful
|
|
* $1101 - Segment not found
|
|
* $1102 - OMF Version error
|
|
* $1104 - File not Load File
|
|
* $1107 - File Version error
|
|
* $1109 - SegNum out of sequence
|
|
* $00xx - GS/OS I/O error
|
|
* $02xx - Memory Manager error
|
|
*
|
|
****************************************************************
|
|
*
|
|
LoadNum PROC EXPORT
|
|
LoadSegCheck
|
|
|
|
with DirectPage, Globals
|
|
Import find_user_id,merge_path,make_HET_ptr,seg_num_lookup
|
|
Import setup_seg_ptrs,open_load_file,load_segment
|
|
Import Process_Reloc,lock_segment,setup_base_ptr
|
|
|
|
ldx #func_0B_param_cnt ;6 bytes of input
|
|
jsr get_parameters ;get the parameters
|
|
|
|
ISegNum EQU input_parms
|
|
IFileNum EQU ISegNum+2
|
|
IUserID EQU IFileNum+2
|
|
OAddress EQU 1 ;offset within stack
|
|
|
|
lda IFileNum ;see if this is file number one
|
|
dec a
|
|
bne old_loader ;sorry we will let the system loader handle it
|
|
|
|
lda IUserID ;lets see if we know about this user ID
|
|
jsr find_user_id ;If found temp_ptr setup
|
|
bcs old_loader ;not my job
|
|
;
|
|
;At this point all errors that we encounter must be returned to the caller since the file is mine.
|
|
;
|
|
ldy #ID_Table_Entry.ExpressHandle
|
|
lda [temp_ptr],y ;get the ExpressLoad handle
|
|
tax
|
|
iny
|
|
iny
|
|
lda [temp_ptr],y
|
|
tay
|
|
bne @have_handle
|
|
txa
|
|
bne @have_handle ;we have the handle
|
|
lda #ExpressSegLost
|
|
sec
|
|
bra @error_exit ;report error to the caller.
|
|
@have_handle
|
|
jsr merge_path ;we now have the expanded ExpressLoad pathname
|
|
|
|
;the segment we will have to load
|
|
jsr make_HET_ptr
|
|
lda ISegNum
|
|
jsr seg_num_lookup ;convert the segment number to correct number
|
|
bcs @error_exit ;the number is not valid
|
|
sta search_seg ;save the real segment to load.
|
|
jsr setup_seg_ptrs ;setup pointers for the load
|
|
|
|
ldy #HET_Entry.SegFlags ;see if the segment is already loaded
|
|
lda [HET_entry_ptr],y
|
|
bmi @already_in ;this segment is already loaded
|
|
@do_load
|
|
jsr open_load_file ;open the puppy
|
|
bcs @error_exit ;report error to the caller.
|
|
jsr load_segment ;load the segment into memory
|
|
bcs @error_exit ;report error to the caller.
|
|
lda search_seg ;relocate the segment
|
|
jsr Process_Reloc
|
|
bcs @error_exit ;report error to the caller.
|
|
bra @continue1
|
|
@already_in
|
|
lsr a ;see if the segment is purgable?
|
|
bcc @continue
|
|
lda search_seg ;go and lock the handle please
|
|
jsr lock_segment
|
|
bcs @do_load
|
|
@continue
|
|
jsr setup_base_ptr ;please setup the base pointer
|
|
@continue1
|
|
lda segment_entry+2 ;address of the segment
|
|
sta OAddress+2,s
|
|
lda segment_entry
|
|
sta OAddress,s
|
|
|
|
lda #$0000
|
|
clc
|
|
@outta_here
|
|
jmp return_to_caller ;we were successful!!
|
|
|
|
@error_exit
|
|
ldx IUserID
|
|
bne @outta_here ;if user_id = 0, try old method
|
|
|
|
old_loader
|
|
; space for output address is already on stack
|
|
; pha ;output Address
|
|
; pha
|
|
lda IUserID ;input UserID
|
|
bne cont ;if 0, use global USERID
|
|
lda |USERID
|
|
cont pha ;UserID
|
|
pei IFileNum ;File Number
|
|
pei ISegNum ;Segment Number
|
|
jsr Load_Segment ;Load Segment routine
|
|
; OAddress is already on stack, so we just have to return
|
|
jmp return_to_caller
|
|
ENDP
|
|
|
|
TITLE ', FUNCTIONS.a - ULoadNum'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* UnLoad Segment by Number ($0C)
|
|
*
|
|
* Inputs: UserID (2 bytes)
|
|
* Load File Number (2 bytes)
|
|
* Load Segment Number (2 bytes)
|
|
* Outputs: none
|
|
* Errors: $0000 - Operation successful
|
|
* $1101 - Segment not found
|
|
* $00xx - GS/OS I/O error
|
|
* $02xx - Memory Manager error
|
|
*
|
|
****************************************************************
|
|
*
|
|
ULoadNum PROC EXPORT
|
|
LoadSegCheck
|
|
|
|
with DirectPage, Globals
|
|
Import make_HET_ptr,seg_num_lookup,make_purgable, \
|
|
purge_all_dyn,find_user_id
|
|
|
|
ldx #func_0C_param_cnt ;get the number of parameters of the stack
|
|
jsr get_parameters
|
|
|
|
ISegNum EQU input_parms
|
|
IFileNum EQU ISegNum+2
|
|
IUserID EQU IFileNum+2
|
|
|
|
lda IFileNum ;see if this is file number one
|
|
bne @check_for_1 ;we handle 0 and 1
|
|
sta ISegNum
|
|
bra @skip_abort
|
|
@check_for_1
|
|
dec a
|
|
bne old_loader ;sorry we will let the system loader handle it
|
|
@skip_abort
|
|
lda IUserID ;see if this is for me
|
|
jsr find_user_id
|
|
bcs old_loader ;must be the real system loaders
|
|
;
|
|
;At this point all errors that we encounter must be returned to the caller since the file is mine.
|
|
;
|
|
ldy #ID_Table_Entry.ExpressHandle
|
|
lda [temp_ptr],y ;get the ExpressLoad handle
|
|
tax
|
|
iny
|
|
iny
|
|
lda [temp_ptr],y
|
|
tay
|
|
bne @have_handle
|
|
txa
|
|
bne @have_handle ;we have the handle
|
|
lda #ExpressSegLost
|
|
sec
|
|
bra @error_exit ;report error to the caller.
|
|
@have_handle
|
|
stx ExpressHandle
|
|
sty ExpressHandle+2
|
|
|
|
jsr make_HET_ptr
|
|
lda ISegNum
|
|
beq @do_all_dyn ;we need to purge all dynamics
|
|
jsr seg_num_lookup ;convert the segment number to correct number
|
|
bcs @error_exit ;the number is not valid
|
|
jsr make_purgable
|
|
jmp return_to_caller ;return to the caller
|
|
@do_all_dyn
|
|
jsr purge_all_dyn
|
|
@outta_here
|
|
jmp return_to_caller ;return the info please
|
|
@error_exit
|
|
ldx IUserID
|
|
bne @outta_here
|
|
old_loader
|
|
lda IUserID ;input UserID
|
|
bne cont1 ;if 0, use global USERID
|
|
lda |USERID
|
|
sta IUserID
|
|
cont1 pha ;UserID
|
|
pei IFileNum ;File Number
|
|
pei ISegNum ;Segment Number
|
|
;
|
|
; if any of the inputs are 0, unload dynamic segments only
|
|
;
|
|
lda #1
|
|
ldy IFileNum
|
|
beq cont2
|
|
ldy ISegNum
|
|
beq cont2
|
|
dec a
|
|
cont2 pha ;Dynamic Only Flag
|
|
pea $0003 ;Purge Level
|
|
jsr Purge_Segment
|
|
jmp return_to_caller ;return the info please
|
|
|
|
ENDP
|
|
|
|
TITLE ', FUNCTIONS.a - LoadName'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Load Segment by Name ($0D)
|
|
*
|
|
*Stack before call:
|
|
*
|
|
* previous contents
|
|
* result space word
|
|
* result space word
|
|
* result space word
|
|
* result space long
|
|
* User ID word
|
|
* Addr of load file name long
|
|
* Addr of load seg name long
|
|
* SP ---->
|
|
*
|
|
*Stack after call:
|
|
*
|
|
* previous contents
|
|
* load-segment number word
|
|
* load-file number word
|
|
* User ID word
|
|
* Addr of the segment long
|
|
* SP ---->
|
|
*
|
|
* Errors: $0000 - Operation successful
|
|
* $1101 - Segment not found
|
|
* $1102 - OMF Version error
|
|
* $1104 - File not Load File
|
|
* $1107 - File Version error
|
|
* $1108 - UserID error
|
|
* $1109 - SegNum out of sequence
|
|
* $00xx - GS/OS I/O error
|
|
* $02xx - Memory Manager error
|
|
*
|
|
* How it works:
|
|
* IF find_user_id(input_id) THEN {If found, ExpressHandle setup}
|
|
* BEGIN
|
|
* IF compare_path(input_path,ExpressLoad_path) THEN {See if looking for loaded segment}
|
|
* BEGIN
|
|
* IF find_seg(input_seg_name) THEN {See if segment is available}
|
|
* BEGIN
|
|
* IF seg_loaded(seg_num) THEN {See if the segment is loaded}
|
|
* BEGIN
|
|
* Return_parameters
|
|
* Exit () {return to the caller}
|
|
* END
|
|
* ELSE
|
|
* BEGIN
|
|
* Load_Seg(Seg_num) {load in the segment please}
|
|
* return_parameters
|
|
* Exit() {return to the caller}
|
|
* END
|
|
* END
|
|
* ELSE
|
|
* BEGIN {segment not found}
|
|
* Return_error(Seg_Not_Found)
|
|
* Exit ()
|
|
* END
|
|
* ELSE {not same file}
|
|
* BEGIN {Pain in the Butt}
|
|
* open_file(input_path) {open file, type check etc.}
|
|
* get_express_seg {get the ExpressLoad segment}
|
|
* IF find_seg(input_seg_name) THEN {See if segment is available}
|
|
* BEGIN
|
|
* IF seg_loaded(seg_num) THEN {See if the segment is loaded}
|
|
* BEGIN
|
|
* Return_parameters
|
|
* Exit () {return to the caller}
|
|
* END
|
|
* ELSE
|
|
* BEGIN
|
|
* Load_Seg(Seg_num) {load in the segment please}
|
|
* return_parameters
|
|
* Exit() {return to the caller}
|
|
* END
|
|
* END
|
|
* ELSE
|
|
* BEGIN {segment not found}
|
|
* Return_error(Seg_Not_Found)
|
|
* Exit ()
|
|
* END
|
|
* get_jmp_tbl_seg {load any jump tables please}
|
|
* Add_file_num {Link this file in please}
|
|
* Return_error(Seg_Not_Found)
|
|
* Exit ()
|
|
*
|
|
****************************************************************
|
|
*
|
|
LoadName PROC EXPORT
|
|
LoadSegCheck
|
|
|
|
with DirectPage, Globals
|
|
Import find_user_id,merge_path,compare_paths,find_seg_name, \
|
|
open_load_file,load_segment,Process_Reloc,lock_segment, \
|
|
setup_base_ptr,my_seg_to_user_seg
|
|
|
|
ldx #func_0D_param_cnt ;get the number of parameters of the stack
|
|
jsr get_parameters
|
|
|
|
ISegName EQU input_parms
|
|
IFileName EQU ISegName+4
|
|
IUserID EQU IFileName+4
|
|
OAddress EQU 1
|
|
OUserID EQU OAddress+4
|
|
OFileNum EQU OUserID+2
|
|
OSegNum EQU OFileNum+2
|
|
|
|
lda IUserID ;get the input user id
|
|
jsr find_user_id ;see if we have the ID
|
|
bcc @its_mine
|
|
brl old_loader ;later we need to handle this better
|
|
@its_mine
|
|
;
|
|
;At this point all errors that we encounter must be returned to the caller since the file is mine.
|
|
;
|
|
ldy #ID_Table_Entry.ExpressHandle
|
|
lda [temp_ptr],y ;get the ExpressLoad handle
|
|
tax
|
|
iny
|
|
iny
|
|
lda [temp_ptr],y
|
|
tay
|
|
bne @have_handle
|
|
txa
|
|
bne @have_handle ;we have the handle
|
|
lda #ExpressSegLost
|
|
sec
|
|
bra @outta_here ;report error to the caller.
|
|
@have_handle
|
|
jsr merge_path ;we now have the expanded ExpressLoad pathname
|
|
;
|
|
;At this point Expanded_name contains the Pathname from the ExpressLoad segment
|
|
;Now we need to build an Expanded Name from the Applications input pathname
|
|
;
|
|
ldy IFileName+2 ;lets build the name
|
|
lda IFileName
|
|
ldx #0 ;convert 0->1
|
|
jsr Convert_Pathname ;first, must convert from class 0 to class 1
|
|
lda TempBuff ;get pointer to converted name
|
|
ldy TempBuff+2
|
|
jsr Expand_Pathname ;now do an ExpandPath on it
|
|
bcs @outta_here ;GS/OS could not expand the pathname
|
|
|
|
jsr compare_paths ;see if the paths are equal
|
|
lda #seg_not_found ;pre-charge the error code if needed
|
|
bcs @outta_here ;report error to the caller.
|
|
lda ISegName+2 ;lets get a copy of the segment name
|
|
tay
|
|
lda ISegName
|
|
tax ;low word address of the segment name
|
|
jsr find_seg_name ;go and find the segment name in ExpressLoad
|
|
bcs @outta_here ;report error to the caller.
|
|
sta search_seg ;segment number of the segment
|
|
|
|
ldy #HET_Entry.SegFlags ;see if the segment is already loaded
|
|
lda [HET_entry_ptr],y
|
|
bmi @already_in ;this segment is already loaded
|
|
@do_load
|
|
jsr open_load_file ;open the puppy
|
|
bcs @outta_here ;report error to the caller.
|
|
jsr load_segment ;load the segment into memory
|
|
bcs @outta_here ;report error to the caller.
|
|
|
|
lda search_seg ;relocate the segment
|
|
jsr Process_Reloc
|
|
bcs @outta_here ;report error to the caller.
|
|
bra @continue1
|
|
@already_in
|
|
lsr a ;see if the segment is purgable?
|
|
bcc @continue
|
|
|
|
lda search_seg ;go and lock the handle please
|
|
jsr lock_segment
|
|
bcs @do_load ;segment was purged behind my back!
|
|
@continue
|
|
jsr setup_base_ptr ;please setup the base pointer
|
|
@continue1
|
|
lda search_seg ;push the load segment number
|
|
jsr my_seg_to_user_seg ;convert to user type number
|
|
sta OSegNum,s
|
|
lda #$0001 ;file number
|
|
sta OFileNum,s
|
|
lda |USERID
|
|
sta OUserID,s
|
|
lda segment_entry+2 ;address of the segment
|
|
sta OAddress+2,s
|
|
lda segment_entry
|
|
sta OAddress,s
|
|
|
|
lda #$0000
|
|
clc
|
|
@outta_here
|
|
jmp cont7 ;we were successful!!
|
|
|
|
old_loader
|
|
;
|
|
; initialize things
|
|
;
|
|
stz OFileNum ;output File Num
|
|
stz Keep_Open ;don't Keep File open
|
|
stz Memory_Load ;clear Memory Load flag
|
|
;
|
|
; if UserID is 0, use USERID
|
|
;
|
|
lda IUserID
|
|
bne cont1
|
|
lda |USERID
|
|
cont1 sta OUserID,s
|
|
;
|
|
; if UserID is an Application, don't close load file
|
|
;
|
|
and #$F000
|
|
cmp #Application
|
|
bne cont1a
|
|
inc Keep_Open
|
|
;
|
|
; convert type 0 pathname to type 1
|
|
;
|
|
cont1a lda IFileName
|
|
ldy IFileName+2
|
|
ldx #0
|
|
jsr Convert_Pathname
|
|
bcs error_skip
|
|
;
|
|
; expand input File Pathname
|
|
;
|
|
lda TempBuff
|
|
ldy TempBuff+2
|
|
jsr Expand_Pathname
|
|
bcs error_skip
|
|
;
|
|
; search Pathname Table for input File Pathname
|
|
;
|
|
lda OUserID,s ;UserID
|
|
pha
|
|
pea #0 ;File Number (none)
|
|
pei TempBuff+2 ;Address of full pathname
|
|
pei TempBuff
|
|
jsr Find_Pathname
|
|
bcs cont2
|
|
;
|
|
; Input File Name is in Pathname Table, copy FileNum to output
|
|
;
|
|
lda |PT_FileNum,x
|
|
sta OFileNum,s
|
|
phk ;restore DBR to PBR
|
|
plb
|
|
stz Counter ;set to 0 as flag
|
|
bra cont3
|
|
;
|
|
; input File Name is not in Pathname Table, move last File Number
|
|
; for the UserID in Pathname Table +1 to output. Note: Counter contains
|
|
; the max File Num as an output from Find_Pathname subroutine
|
|
;
|
|
cont2 lda Counter
|
|
inc a
|
|
sta OFileNum,s
|
|
;
|
|
; open file, if necessary
|
|
;
|
|
cont3 pei TempBuff+2 ;address of file name
|
|
pei TempBuff
|
|
lda #0
|
|
pha ;no time/date stamp
|
|
pha
|
|
pha
|
|
pha
|
|
jsr Open_File ;open file
|
|
bcc _1
|
|
error_skip
|
|
jmp Error_Exit
|
|
_1
|
|
;
|
|
; read next Segment Header
|
|
;
|
|
loop1 rep #$30
|
|
longa on
|
|
longi on
|
|
jsr Next_Header
|
|
bcs error_skip
|
|
;
|
|
; set TempZero to address of 1st char in SegName
|
|
;
|
|
cont4 lda Header.DispName ;DISPNAME contains offset of SEGNAME in Header_Var
|
|
clc
|
|
adc Header_Var
|
|
sta TempZero
|
|
lda #0
|
|
adc Header_Var+2
|
|
sta TempZero+2
|
|
lda Header.LabLen ;if LABLEN=0, both names are Pascal strings
|
|
and #$FF
|
|
beq cont4a
|
|
lda TempZero ;if not, decrement pointer so indices line up
|
|
bne @1
|
|
dec TempZero+2
|
|
@1
|
|
dec TempZero
|
|
;
|
|
; compare Segment Names
|
|
;
|
|
cont4a
|
|
sep #$30
|
|
longa off
|
|
longi off
|
|
lda [ISegName] ;char count
|
|
tay ;Y=index into each SegName
|
|
loop2 lda [ISegName],y
|
|
cmp [TempZero],y
|
|
bne loop1 ;char mismatch, try next Segment
|
|
dey
|
|
bne loop2
|
|
rep #$30
|
|
longa on
|
|
longi on
|
|
;
|
|
; copy Segment Number from Segment Header to output
|
|
;
|
|
lda Header.SegNum
|
|
sta OSegNum,s
|
|
;
|
|
; add File Name to Pathname Table, if not already there
|
|
;
|
|
lda Counter ;0 if already in table
|
|
beq cont6
|
|
lda OUserID,s ;UserID
|
|
pha
|
|
lda OFileNum+2,s ;File Number
|
|
pha
|
|
lda |POpen.modDateTime+6 ;mod_date/time
|
|
pha
|
|
lda |POpen.modDateTime+4
|
|
pha
|
|
lda |POpen.modDateTime+2
|
|
pha
|
|
lda |POpen.modDateTime
|
|
pha
|
|
lda #0
|
|
pha ;Direct Page/Stack info
|
|
pha
|
|
pha ;Starting Address
|
|
pha
|
|
pei TempBuff+2 ;Address of File Name
|
|
pei TempBuff
|
|
jsr Add_Pathname
|
|
bcs Error_Exit
|
|
;
|
|
; close file
|
|
;
|
|
cont6 jsr Close_File
|
|
;
|
|
; load segment found
|
|
;
|
|
; space for output address is already on stack
|
|
; pha ;output Address
|
|
; pha
|
|
lda OUserID,s ;UserID
|
|
pha
|
|
lda OFileNum+2,s ;File Number
|
|
pha
|
|
lda OSegNum+4,s ;Segment Number
|
|
pha
|
|
jsr Load_Segment ;Load Segment routine
|
|
|
|
Error_Exit
|
|
;
|
|
; if error occured, close file again
|
|
;
|
|
bcc cont7
|
|
pha ;save status
|
|
stz Keep_Open
|
|
jsr Close_File ;close file
|
|
pla ;restore status
|
|
|
|
cont7
|
|
pha ;save status
|
|
pea uTempBuff ;dispose of temporary memory
|
|
_DisposeAll
|
|
pla ;restore status
|
|
|
|
jmp return_to_caller
|
|
|
|
ENDP
|
|
|
|
TITLE ', FUNCTIONS.a - ULoadSeg'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* UnloadSeg ($0E)
|
|
*
|
|
* Inputs: Address in Segment (4 bytes)
|
|
* Outputs: UserID (2 bytes)
|
|
* Load File Number (2 bytes)
|
|
* Load Segment Number (2 bytes)
|
|
* Errors: $0000 - Operation successful
|
|
* $1101 - Segment not found
|
|
* $00xx - GS/OS I/O error
|
|
* $02xx - Memory Manager error
|
|
*
|
|
****************************************************************
|
|
*
|
|
ULoadSeg PROC EXPORT
|
|
LoadSegCheck
|
|
|
|
with DirectPage, Globals
|
|
Import find_seg_handle,make_purgable,my_seg_to_user_seg
|
|
|
|
ldx #func_0E_param_cnt ;get the number of parameters of the stack
|
|
jsr get_parameters
|
|
|
|
IAddress EQU input_parms
|
|
OUserID EQU 1
|
|
OFileNum EQU OUserID+2
|
|
OSegNum EQU OFileNum+2
|
|
|
|
stz search_seg
|
|
@retry
|
|
pea $0000
|
|
pea $0000 ;result space
|
|
|
|
lda IAddress+2
|
|
sta hold_long+2 ;save the address in case this is a jump table seg
|
|
pha ;address in a segment
|
|
lda IAddress
|
|
sta hold_long
|
|
pha
|
|
_FindHandle
|
|
plx
|
|
ply
|
|
bcs old_loader
|
|
stx seg_handle ;handle to the segment
|
|
sty seg_handle+2
|
|
jsr find_seg_handle
|
|
bcs old_loader ;it must be in the original loader
|
|
tax
|
|
|
|
ldy #HET_Entry.SegFlags ;see if this is a jump segment
|
|
lda [HET_entry_ptr],y
|
|
and #jmp_type
|
|
beq @not_jump
|
|
|
|
lda hold_long
|
|
sta temp_ptr
|
|
lda hold_long+2
|
|
sta temp_ptr+2 ;setup pointer to the segment entry please
|
|
|
|
lda [temp_ptr] ;get the current opcode
|
|
and #$00FF ;clear the garbage
|
|
cmp #$0022 ;is it a JSL instruction to ME???
|
|
bne @chk_JML
|
|
|
|
sec
|
|
lda temp_ptr ;make pointer to the load_seg_number field
|
|
sbc #$0006
|
|
sta temp_ptr
|
|
lda temp_ptr+2
|
|
sbc #$0000
|
|
sta temp_ptr+2 ;temp_ptr now points to the correct field
|
|
|
|
; User_ID 2
|
|
; Load_File Number 2
|
|
; Load Segment Number 2
|
|
; Load Segment Offset 4
|
|
; JSL to Jump-table load 4
|
|
|
|
lda [temp_ptr] ;get the segment number please
|
|
sta search_seg
|
|
bra @return_info
|
|
|
|
@chk_JML
|
|
cmp #$005C ;is it a JML instruction!!
|
|
bne old_loader ;let lou return the error
|
|
;
|
|
;Setup the new address to find
|
|
;
|
|
ldy #$0001 ;get the address that I need to unload please
|
|
lda [temp_ptr],y
|
|
sta IAddress
|
|
iny
|
|
iny
|
|
lda [temp_ptr],y ;get the high word please
|
|
and #$00FF ;clear garbage
|
|
sta IAddress+2
|
|
;save the new address please
|
|
bra @retry
|
|
@not_jump
|
|
txa ;setup the segment number
|
|
|
|
@return_info ;label moved so that we _always_ call Make_Purgeable
|
|
jsr make_purgable ;{gab - 04/23/90}
|
|
|
|
lda search_seg
|
|
jsr my_seg_to_user_seg
|
|
sta OSegNum,s
|
|
lda #$0001
|
|
sta OFileNum,s
|
|
lda |USERID
|
|
sta OUserID,s
|
|
lda #$0000
|
|
jmp return_to_caller ;return to the caller
|
|
|
|
old_loader
|
|
;
|
|
; call Memory Manager with input Address
|
|
;
|
|
pha ;output Handle
|
|
pha
|
|
pei IAddress+2 ;Address
|
|
pei IAddress
|
|
_FindHandle
|
|
pla
|
|
sta TempZero ;output Handle
|
|
pla
|
|
sta TempZero+2
|
|
ora TempZero ;if Handle=0, no find
|
|
bne cont1
|
|
lda #NoFind
|
|
jmp Error_Exit
|
|
;
|
|
; get UserID associated with Handle
|
|
;
|
|
cont1 ldy #6
|
|
lda [TempZero],y
|
|
sta OUserID,s
|
|
;
|
|
; search Memory Segment Table for entries having UserID
|
|
;
|
|
lda |SEGTBL
|
|
sta Handle
|
|
lda |SEGTBL+2
|
|
sta Handle+2
|
|
loop pha ;output Handle
|
|
pha
|
|
lda OUserID+4,s ;UserID
|
|
pha
|
|
lda #0
|
|
pha ;File Number
|
|
pha ;Segment Number
|
|
jsr Next_MemSeg
|
|
pla ;output Handle
|
|
pla ;(not used)
|
|
lda |MS_Handle,x
|
|
sta TempZero+4 ;save Handle of Memory block
|
|
lda |MS_Handle+2,x
|
|
sta TempZero+6
|
|
lda #NoFind
|
|
bcs Error_Exit ;last entry scanned, no find
|
|
;
|
|
; compare Handle of Memory block with Handle for input Address
|
|
;
|
|
lda TempZero
|
|
cmp TempZero+4
|
|
bne loop
|
|
lda TempZero+2
|
|
cmp TempZero+6
|
|
bne loop
|
|
;
|
|
; found Load Segment which contains the input address. Check whether
|
|
; segment is a Jump Table Segment
|
|
;
|
|
lda |MS_Kind,x
|
|
cmp #Jump_Segment
|
|
bne cont2
|
|
;
|
|
; segment is a Jump Table Segment. Address points to JSL or JMP in
|
|
; one of the entries. So extract the File Number and Segment Number
|
|
; from locations just above.
|
|
;
|
|
lda IAddress
|
|
sec
|
|
sbc #8
|
|
sta TempZero
|
|
lda IAddress+2
|
|
sbc #0
|
|
sta TempZero+2
|
|
lda [TempZero]
|
|
sta OFileNum ;File Number
|
|
ldy #2
|
|
lda [TempZero],y
|
|
sta OSegNum ;Segment Number
|
|
bra cont3
|
|
;
|
|
; segment is a regular Load Segment. Get File Number and Segment Number
|
|
; from Memory Segment Table entry.
|
|
;
|
|
cont2 lda |MS_FileNum,x
|
|
sta OFileNum,s
|
|
lda |MS_SegNum,x
|
|
sta OSegNum,s
|
|
;
|
|
; unload the specified segment
|
|
;
|
|
cont3 phk ;restore DBR
|
|
plb
|
|
lda OUserID,s ;UserID
|
|
pha
|
|
lda OFileNum+2,s ;File Number
|
|
pha
|
|
lda OSegNum+4,s ;Segment Number
|
|
pha
|
|
pea $0000 ;Dynamic Only Flag (false)
|
|
pea $0003 ;Purge Level
|
|
jsr Purge_Segment
|
|
|
|
Error_Exit phk ;restore DBR
|
|
plb
|
|
|
|
jmp return_to_caller
|
|
|
|
ENDP
|
|
|
|
TITLE ', FUNCTIONS.a - GetInfo'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Get Segment Information ($0F)
|
|
*
|
|
* Inputs: UserID (2 bytes)
|
|
* Load File Number (2 bytes)
|
|
* Load Segment Number (2 bytes)
|
|
* Address of User Buffer (4 bytes)
|
|
* Outputs: filled User Buffer
|
|
* Errors: $0000 - Operation successful
|
|
* $1101 - Entry not found
|
|
* $00xx - GS/OS I/O error
|
|
* $02xx - Memory Manager error
|
|
*
|
|
****************************************************************
|
|
*
|
|
GetInfo PROC EXPORT
|
|
LoadSegCheck
|
|
|
|
with DirectPage, Globals
|
|
Import find_user_id,make_HET_ptr,seg_num_lookup,setup_seg_ptrs
|
|
|
|
ldx #func_0F_param_cnt ;get the number of parameters of the stack
|
|
jsr get_parameters
|
|
|
|
IAddress EQU input_parms
|
|
ISegNum EQU IAddress+4
|
|
IFileNum EQU ISegNum+2
|
|
IUserID EQU IFileNum+2
|
|
|
|
lda IFileNum
|
|
dec a
|
|
bne old_loader ;if file number not 1 then call system loader
|
|
|
|
lda IUserID
|
|
jsr find_user_id ;see if we have the ID
|
|
bcs old_loader
|
|
|
|
ldy #ID_Table_Entry.ExpressHandle
|
|
lda [temp_ptr],y ;get the ExpressLoad handle
|
|
sta ExpressHandle
|
|
iny
|
|
iny
|
|
lda [temp_ptr],y
|
|
sta ExpressHandle+2
|
|
ora ExpressHandle
|
|
bne @have_handle
|
|
lda #ExpressSegLost
|
|
bra @error_exit
|
|
@have_handle
|
|
jsr make_HET_ptr ;set up the HET pointer
|
|
lda ISegNum ;segment # to get info for
|
|
jsr seg_num_lookup ;convert the segment number to correct number
|
|
bcs @error_exit ;the number is not valid
|
|
sta search_seg
|
|
jsr setup_seg_ptrs ;setup pointers for the transfer
|
|
|
|
lda IUserID ;copy UserID
|
|
sta [IAddress]
|
|
|
|
ldy #HET_Entry.SegHandle ;copy segment handle
|
|
lda [HET_entry_ptr],y
|
|
pha
|
|
iny
|
|
iny
|
|
lda [HET_entry_ptr],y
|
|
ldy #$0004
|
|
sta [IAddress],y
|
|
dey
|
|
dey
|
|
pla
|
|
sta [IAddress],y
|
|
|
|
ldy #$0006 ;copy load file #
|
|
lda IFileNum
|
|
sta [IAddress],y
|
|
|
|
iny ;copy segment #
|
|
iny
|
|
lda ISegNum
|
|
sta [IAddress],y
|
|
|
|
ldy #SegHeaderEntry.Kind ;copy segment kind
|
|
lda [seg_header_ptr],y
|
|
ldy #10
|
|
sta [IAddress],y
|
|
|
|
lda #0 ;no error
|
|
@error_exit
|
|
jmp return_to_caller ;report error to the caller.
|
|
old_loader
|
|
;
|
|
; search Memory Segment Table using inputs
|
|
;
|
|
pha ;output Handle
|
|
pha
|
|
pei IUserID ;UserID
|
|
pei IFileNum ;File Number
|
|
pei ISegNum ;Segment Number
|
|
jsr Find_MemSeg
|
|
plx ;output Handle
|
|
ply
|
|
phk ;restore DBR
|
|
plb
|
|
bcs Error_Exit
|
|
;
|
|
; dereference Handle
|
|
;
|
|
txa
|
|
jsr DeRef
|
|
;
|
|
; set Pointer to start of data
|
|
; (returned from DeRef in Acc and Y)
|
|
;
|
|
clc
|
|
adc #MS_UserID
|
|
sta Pointer
|
|
bcc @1
|
|
iny
|
|
@1
|
|
sty Pointer+2
|
|
;
|
|
; move data to user's buffer
|
|
;
|
|
phy ;Source
|
|
pha
|
|
pei IAddress+2 ;Destination
|
|
pei IAddress
|
|
pea $0000
|
|
pea MS_Kind-6 ;Count
|
|
jsr Block_Move
|
|
|
|
Error_Exit
|
|
jmp return_to_caller
|
|
|
|
ENDP
|
|
|
|
TITLE ', FUNCTIONS.a - myGetUserID'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* private Get UserID subroutine
|
|
*
|
|
* Inputs: Address of Pathname in a,y (class 1 string)
|
|
* Outputs: UserID (2 bytes)
|
|
* Errors: $0000 - Operation successful
|
|
* $1101 - Entry not found
|
|
* $00xx - GS/OS I/O error
|
|
* $02xx - Memory Manager error
|
|
*
|
|
****************************************************************
|
|
*
|
|
myGetUserID PROC
|
|
with DirectPage, Globals
|
|
Import lock_handles,unlock_handles,path_to_user_id
|
|
|
|
OUserID EQU 3
|
|
|
|
jsr Expand_Pathname ;make it a full pathname
|
|
jsr path_to_user_id ;given a path this routine finds a user ID
|
|
bcc Normal_Exit ;go store the user_id
|
|
|
|
old_loader
|
|
;
|
|
; search Pathname Table for full pathname
|
|
;
|
|
lda #0
|
|
pha ;UserID (none)
|
|
pha ;File Number (none)
|
|
pei TempBuff+2 ;Address of Pathname
|
|
pei TempBuff
|
|
jsr Find_Pathname
|
|
bcs Error_Exit
|
|
|
|
lda |PT_UserID,x
|
|
Normal_Exit
|
|
sta OUserID,s
|
|
|
|
lda #0 ;clear Accumulator (no error)
|
|
|
|
Error_Exit phk
|
|
plb ;restore DBR
|
|
|
|
pha ;save status
|
|
pea uTempBuff ;dispose of temporary memory
|
|
_DisposeAll
|
|
pla ;restore status
|
|
|
|
rts
|
|
|
|
EndP
|
|
|
|
TITLE ', FUNCTIONS.a - GetUserID'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Get UserID ($10)
|
|
*
|
|
* Inputs: Address of Pathname (4 bytes)
|
|
* Outputs: UserID (2 bytes)
|
|
* Errors: $0000 - Operation successful
|
|
* $1101 - Entry not found
|
|
* $00xx - GS/OS I/O error
|
|
* $02xx - Memory Manager error
|
|
*
|
|
****************************************************************
|
|
*
|
|
GetUserID PROC EXPORT
|
|
LoadSegCheck
|
|
|
|
with DirectPage
|
|
|
|
ldx #func_10_param_cnt ;get the number of parameters of the stack
|
|
jsr get_parameters
|
|
|
|
IAddress EQU input_parms
|
|
OUserID EQU 1
|
|
|
|
;
|
|
; convert type 0 pathname to type 1
|
|
;
|
|
lda IAddress
|
|
ldy IAddress+2
|
|
ldx #0
|
|
jsr Convert_Pathname
|
|
bcs Error_Exit
|
|
;
|
|
; then call the _real_ GetUserID routine
|
|
;
|
|
ldy TempBuff+2 ;converted pathname
|
|
lda TempBuff
|
|
jsr myGetUserID ;go find the User ID
|
|
|
|
Error_Exit
|
|
jmp return_to_caller
|
|
|
|
|
|
ENDP
|
|
|
|
TITLE ', FUNCTIONS.a - GetUserID 2'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Get UserID 2 ($21) - Type 1 Pathname used
|
|
*
|
|
* Inputs: Address of Pathname (4 bytes)
|
|
* Outputs: UserID (2 bytes)
|
|
* Errors: $0000 - Operation successful
|
|
* $1101 - Entry not found
|
|
* $00xx - GS/OS I/O error
|
|
* $02xx - Memory Manager error
|
|
*
|
|
****************************************************************
|
|
*
|
|
GetUserID2 PROC EXPORT
|
|
LoadSegCheck
|
|
|
|
with DirectPage
|
|
|
|
ldx #func_21_param_cnt ;get the number of parameters of the stack
|
|
jsr get_parameters
|
|
|
|
IAddress EQU input_parms
|
|
|
|
lda IAddress ;get the name pointer into registers
|
|
ldy IAddress+2
|
|
|
|
jsr myGetUserID ;call the _real_ workhorse
|
|
|
|
jmp return_to_caller
|
|
|
|
ENDP
|
|
|
|
TITLE ', FUNCTIONS.a - GetPathname'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Get Pathname ($11)
|
|
*
|
|
* Inputs: UserID (2 bytes)
|
|
* File Number (2 bytes)
|
|
* Outputs: Address of Pathname (4 bytes)
|
|
* Errors: $0000 - Operation successful
|
|
* $1101 - Entry not found
|
|
* $00xx - GS/OS I/O error
|
|
* $02xx - Memory Manager error
|
|
*
|
|
****************************************************************
|
|
*
|
|
GetPathname PROC EXPORT
|
|
LoadSegCheck
|
|
|
|
with DirectPage, Globals
|
|
Import find_user_id,merge_path, GString_to_PString
|
|
|
|
ldx #func_11_param_cnt ;get the number of parameters of the stack
|
|
jsr get_parameters
|
|
|
|
IFileNum EQU input_parms
|
|
IUserID EQU IFileNum+2
|
|
OAddress EQU 1
|
|
|
|
pea uTempBuff ;dispose of any old buffer
|
|
_DisposeAll
|
|
|
|
lda IFileNum
|
|
dec a
|
|
bne old_loader ;if file number not 1 then call system loader
|
|
|
|
lda IUserID
|
|
jsr find_user_id ;see if we have the ID
|
|
bcs old_loader
|
|
|
|
ldy #ID_Table_Entry.ExpressHandle
|
|
lda [temp_ptr],y ;get the ExpressLoad handle
|
|
tax
|
|
iny
|
|
iny
|
|
lda [temp_ptr],y
|
|
tay
|
|
bne @have_handle
|
|
txa
|
|
bne @have_handle ;we have the handle
|
|
lda #ExpressSegLost
|
|
sec
|
|
bra @error_exit ;report error to the caller.
|
|
@have_handle
|
|
jsr merge_path ;Build a GString
|
|
|
|
pei ExpressHandle+2
|
|
pei ExpressHandle
|
|
_HLock ;we better lock it down for a bit
|
|
|
|
lda PathnamePtr
|
|
ldy PathnamePtr+2
|
|
ldx #1
|
|
jsr Convert_Pathname ;convert to a class 0 string
|
|
pha ;save return status
|
|
|
|
pei ExpressHandle+2 ;now we can unlock the handle
|
|
pei ExpressHandle
|
|
_HUnlock
|
|
|
|
pla
|
|
bra store_pointer
|
|
|
|
@error_exit
|
|
ldx IUserID
|
|
bne outta_here
|
|
|
|
old_loader
|
|
;
|
|
; search Pathname Table for UserID
|
|
;
|
|
pei IUserID ;UserID
|
|
pei IFileNum ;File Number
|
|
lda #0
|
|
pha ;Address of Pathname
|
|
pha
|
|
jsr Find_Pathname
|
|
bcs Error_Exit
|
|
|
|
txa
|
|
clc
|
|
adc #PT_Path
|
|
tax ;save in X for a minute
|
|
phb
|
|
phb
|
|
pla
|
|
and #$FF
|
|
bcc @1
|
|
inc a
|
|
@1
|
|
tay ;put high word in Y
|
|
txa ;retrieve low word
|
|
;
|
|
; convert pathname to type 0
|
|
;
|
|
ldx #1
|
|
jsr Convert_Pathname
|
|
store_pointer
|
|
tax ;save status
|
|
lda TempBuff
|
|
sta OAddress,s
|
|
lda TempBuff+2
|
|
sta OAddress+2,s
|
|
txa
|
|
Error_Exit
|
|
phk
|
|
plb ;restore DBR
|
|
outta_here
|
|
jmp return_to_caller
|
|
|
|
ENDP
|
|
|
|
TITLE ', FUNCTIONS.a - GetPathname 2'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Get Pathname 2 ($22) - Type 1 Pathname used
|
|
*
|
|
* Inputs: UserID (2 bytes)
|
|
* File Number (2 bytes)
|
|
* Outputs: Address of Pathname (4 bytes)
|
|
* Errors: $0000 - Operation successful
|
|
* $1101 - Entry not found
|
|
* $00xx - GS/OS I/O error
|
|
* $02xx - Memory Manager error
|
|
*
|
|
****************************************************************
|
|
*
|
|
GetPathname2 PROC Export
|
|
LoadSegCheck
|
|
|
|
with DirectPage, Globals
|
|
Import merge_path,find_user_id,MemMove,do_alloc
|
|
|
|
ldx #func_22_param_cnt ;get the number of parameters of the stack
|
|
jsr get_parameters
|
|
|
|
IFileNum EQU input_parms
|
|
IUserID EQU IFileNum+2
|
|
OAddress EQU 1
|
|
|
|
pea uLGetPathname ;dispose of any old buffer
|
|
_DisposeAll
|
|
|
|
lda IFileNum
|
|
dec a
|
|
bne old_loader ;if file number not 1 then call system loader
|
|
|
|
lda IUserID
|
|
jsr find_user_id ;see if we have the ID
|
|
bcs old_loader
|
|
|
|
ldy #ID_Table_Entry.ExpressHandle
|
|
lda [temp_ptr],y ;get the ExpressLoad handle
|
|
tax
|
|
iny
|
|
iny
|
|
lda [temp_ptr],y
|
|
tay
|
|
bne @have_handle
|
|
txa
|
|
bne @have_handle ;we have the handle
|
|
lda #ExpressSegLost
|
|
sec
|
|
bra Error_Exit ;report error to the caller.
|
|
|
|
@have_handle
|
|
jsr merge_path
|
|
bra copy_pathname ;go copy the pathname into a temp buffer
|
|
|
|
old_loader
|
|
;
|
|
; search Pathname Table for UserID
|
|
;
|
|
pei IUserID ;UserID
|
|
pei IFileNum ;File Number
|
|
lda #0
|
|
pha ;Address of Pathname
|
|
pha
|
|
jsr Find_Pathname
|
|
bcs Error_Exit
|
|
|
|
txa
|
|
clc
|
|
adc #PT_Path
|
|
sta PathnamePtr
|
|
phb
|
|
phb
|
|
pla
|
|
and #$FF
|
|
bcc @1 ;was there a carry from the above calculation?
|
|
inc a ;yes, adjust bank #
|
|
@1
|
|
sta PathnamePtr+2
|
|
phk
|
|
plb
|
|
copy_pathname
|
|
lda [PathnamePtr] ;get the length of the pathname
|
|
inc a ;adjust for leading length word
|
|
inc a
|
|
tax ;pass in X register
|
|
ldy #0 ;always < 64K
|
|
lda #uLGetPathname ;use this ID to allocate memory
|
|
jsr do_alloc ;allocate some memory
|
|
bcs Error_Exit ;oops! couldn't get the memory
|
|
|
|
txa ;put low word of handle into Accumulator
|
|
jsr DeRef ;deref the handle (into Acc & Y)
|
|
|
|
tax ;save low word in X for a second
|
|
sta OAddress,s ;store return pointer
|
|
tya
|
|
sta OAddress+2,s
|
|
|
|
pei PathnamePtr+2 ;source for move
|
|
pei PathnamePtr
|
|
phy ;destination pointer
|
|
phx
|
|
lda [PathnamePtr] ;get length
|
|
inc a ;include length word
|
|
inc a
|
|
pha
|
|
jsr MemMove ;copy the string
|
|
|
|
lda #0 ;signify no error
|
|
Error_Exit
|
|
phk
|
|
plb ;restore DBR
|
|
|
|
outta_here
|
|
jmp return_to_caller
|
|
|
|
ENDP
|
|
|
|
TITLE ', FUNCTIONS.a - myUserShutdown'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* private User Shutdown function
|
|
*
|
|
* Inputs: UserID (2 bytes)
|
|
* Quit Flag (2 bytes)
|
|
*
|
|
* Outputs: UserID (2 bytes)
|
|
*
|
|
* Errors: $0000 - Operation successful
|
|
* $00xx - GS/OS I/O error
|
|
* $02xx - Memory Manager error
|
|
*
|
|
****************************************************************
|
|
*
|
|
myUserShutdown Proc
|
|
with DirectPage, Globals
|
|
|
|
IQuit EQU input_parms
|
|
IUserID EQU IQuit+2
|
|
OUserID EQU 3 ;allow for extra return address
|
|
|
|
lda IUserID
|
|
bne cont1
|
|
lda |USERID
|
|
cont1 sta OUserID,s
|
|
;
|
|
; close all the Files associated with this UserID
|
|
;
|
|
stz Memory_Load
|
|
stz Keep_Open
|
|
;
|
|
; get the first Pathname Table entry for this UserID
|
|
;
|
|
pha ;UserID
|
|
lda #0
|
|
pha ;File Number (any)
|
|
pha ;Pathname (none)
|
|
pha
|
|
jsr Find_Pathname
|
|
bcc cont2
|
|
jmp Error_Exit
|
|
;
|
|
; get next Pathname entry for this UserID
|
|
;
|
|
loop lda OUserID,s ;UserID
|
|
pha
|
|
lda #0
|
|
pha ;File Number (any)
|
|
pha ;Pathname (none)
|
|
pha
|
|
jsr Next_Pathname
|
|
bcs eloop
|
|
;
|
|
; get Pathname and save for Open_File
|
|
;
|
|
cont2 txa
|
|
clc
|
|
adc #PT_Path
|
|
sta TempZero
|
|
phb
|
|
phb
|
|
pla
|
|
and #$FF
|
|
bcc @1 ;propage carry for possible
|
|
inc a ;bank crossing
|
|
@1
|
|
sta TempZero+2
|
|
;
|
|
; bump handle of Pathname Table entry to next
|
|
;
|
|
lda |MS_Next,x
|
|
sta Handle
|
|
lda |MS_Next+2,x
|
|
sta Handle+2
|
|
;
|
|
; restore DBR
|
|
;
|
|
phk
|
|
plb
|
|
;
|
|
; open (only gets refnum) and close Load File
|
|
;
|
|
lda [TempZero] ;get the length of the pathname
|
|
beq loop ;if 0, just skip the OS calls
|
|
|
|
pei TempZero+2 ;Pathname
|
|
pei TempZero
|
|
lda #0 ;Time/Date stamp
|
|
pha
|
|
pha
|
|
pha
|
|
pha
|
|
jsr Open_File
|
|
jsr Close_File
|
|
bra loop
|
|
|
|
eloop phk
|
|
plb
|
|
;
|
|
; if Quit Flag=
|
|
;
|
|
; $0000 - cleanup internal tables and dispose all memory
|
|
; $8000 - reloadable - same as above except spare Pathname Table
|
|
; other - restartable
|
|
;
|
|
ldx IQuit
|
|
beq cont3
|
|
cpx #$8000
|
|
bne cont5
|
|
;
|
|
; cleanup internal tables for UserID
|
|
;
|
|
cont3 lda OUserID,s ;UserID
|
|
pha ;once for _DisposeAll
|
|
pha
|
|
jsr Cleanup
|
|
;
|
|
; dispose of all memory blocks for UserID
|
|
;
|
|
_DisposeAll
|
|
;
|
|
; if Quit Flag<>$8000, remove UserID from Pathname Table and delete it
|
|
;
|
|
ldx IQuit
|
|
cpx #$8000
|
|
beq cont4
|
|
|
|
lda OUserID,s
|
|
pha ;extra for Remove_UserID
|
|
pha
|
|
_DeleteID
|
|
|
|
pea PATHTBL>>16
|
|
pea |PATHTBL
|
|
jsr Remove_UserID
|
|
;
|
|
; remove UserID from Jump Table and Memory Segment Table
|
|
;
|
|
cont4 lda OUserID,s
|
|
pha ;extra for Remove_UserID
|
|
pha
|
|
pea JMPTBL>>16
|
|
pea |JMPTBL
|
|
jsr Remove_UserID
|
|
|
|
pea SEGTBL>>16
|
|
pea |SEGTBL
|
|
jsr Remove_UserID
|
|
|
|
bra OK_Exit
|
|
;
|
|
; User is Restartable, purge all dynamic segments for this UserID
|
|
; from all tables (this will also dispose of memory block handles)
|
|
;
|
|
cont5
|
|
pea 3 ;purge level for _SetPurgeAll
|
|
lda OUserID+2,s ;UserID
|
|
pha ;for _SetPurgeAll
|
|
pha ;for _PurgeAll
|
|
pha ;for _HUnlockAll
|
|
pha ;for Purge_Segment
|
|
lda #0
|
|
pha ;all Load Files
|
|
pha ;all Load Segments
|
|
pea 1 ;Dynamic Segments only
|
|
pha ;Purge Level (dispose)
|
|
jsr Purge_Segment
|
|
;
|
|
; unlock all load segments
|
|
;
|
|
_HUnlockAll
|
|
;
|
|
; purge all other dynamic segments
|
|
;
|
|
_PurgeAll
|
|
;
|
|
; make all static segments purgeable
|
|
;
|
|
_SetPurgeAll
|
|
|
|
OK_Exit lda #0
|
|
Error_Exit rts ;back to caller
|
|
|
|
EndP
|
|
|
|
TITLE ', FUNCTIONS.a - UserShutdown'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* User Shutdown ($12)
|
|
*
|
|
* Inputs: UserID (2 bytes)
|
|
* Quit Flag (2 bytes)
|
|
*
|
|
* Outputs: UserID (2 bytes)
|
|
*
|
|
* Errors: $0000 - Operation successful
|
|
* $00xx - GS/OS I/O error
|
|
* $02xx - Memory Manager error
|
|
*
|
|
****************************************************************
|
|
*
|
|
UserShutdown PROC EXPORT
|
|
LoadSegCheck
|
|
|
|
with DirectPage, Globals
|
|
Import find_user_id,close_dynamic_file,remove_segment
|
|
Import mark_all_purgable,delete_user_id
|
|
|
|
ldx #func_12_param_cnt ;get the number of parameters of the stack
|
|
jsr get_parameters
|
|
|
|
IQuit EQU input_parms
|
|
IUserID EQU IQuit+2
|
|
OUserID EQU 1
|
|
|
|
lda IUserID ;see if this is my User ID
|
|
jsr find_user_id ;Is this mine?
|
|
bcc @found_it ;yes...
|
|
brl old_loader ;no. It must belong to the system loader
|
|
@found_it
|
|
ldy #ID_Table_Entry.ExpressHandle
|
|
lda [temp_ptr],y ;get the ExpressLoad handle
|
|
tax
|
|
iny
|
|
iny
|
|
lda [temp_ptr],y
|
|
tay
|
|
bne @have_handle
|
|
txa
|
|
bne @have_handle ;we have the handle
|
|
lda #ExpressSegLost
|
|
sec
|
|
bra @error_exit ;report error to the caller.
|
|
@have_handle
|
|
stx ExpressHandle
|
|
sty ExpressHandle+2
|
|
jsr close_dynamic_file ;close file if any segments were dynamic
|
|
|
|
lda temp_ptr ;setup the User_ID pointer to point to the entry
|
|
sta user_id_ptr
|
|
lda temp_ptr+2
|
|
sta user_id_ptr+2
|
|
|
|
lda IQuit ;save the guit flag
|
|
;what type of kill is this?
|
|
beq @nuke_it ;remove the entire application
|
|
cmp #$8000 ;is this a "keep Only Table" quit
|
|
bne @make_dormant ;this a restart attemp
|
|
;
|
|
;If we get here we need to purge the app but keep our tables intack
|
|
;
|
|
lda #purge_all ;remove all segments
|
|
ldx #$0000 ;LOAD flags AND mask COMPARE value BEQ REMOVE_IT
|
|
jsr remove_segment ;deallocate the segments
|
|
bra @norm_exit
|
|
|
|
@make_dormant
|
|
lda #purge_dynamics ;remove dynamic segments
|
|
ldx #$0000 ;LOAD flags AND mask COMPARE value BEQ REMOVE_IT
|
|
jsr remove_segment ;deallocate the segments
|
|
jsr mark_all_purgable
|
|
bra @norm_exit
|
|
@nuke_it
|
|
pha ;space for handle
|
|
pha
|
|
pei user_id_ptr+2 ;lock down the user ID table
|
|
pei user_id_ptr
|
|
_FindHandle
|
|
lda 3,s ;duplicate the handle on the stack
|
|
pha
|
|
lda 3,s
|
|
pha
|
|
_HLock
|
|
|
|
lda #nuke_id ;delete the ID and the memory
|
|
jsr delete_user_id ;remove the user_id please
|
|
|
|
_HUnlock ;unlock the user ID table
|
|
|
|
@norm_exit
|
|
lda |USERID
|
|
sta OUserID,s
|
|
lda #$0000
|
|
@outta_here
|
|
jmp return_to_caller ;we were successful!!
|
|
@error_exit
|
|
ldx IUserID
|
|
bne @outta_here
|
|
|
|
old_loader
|
|
jsr myUserShutdown ;call private function
|
|
|
|
jmp return_to_caller
|
|
|
|
ENDP
|
|
|
|
TITLE ', FUNCTIONS.a - RenamePathname'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Rename Pathname ($13)
|
|
*
|
|
* Inputs: Address of old Pathname (4 bytes) - Type 1 pathname
|
|
* Address of new Pathname (4 bytes) - Type 1 pathname
|
|
* Outputs: none
|
|
* Errors: $0000 - Operation successful
|
|
* $02xx - Memory Manager error
|
|
*
|
|
****************************************************************
|
|
*
|
|
RenamePathname PROC EXPORT
|
|
LoadSegCheck
|
|
|
|
with DirectPage, Globals
|
|
Import rename_segments, compare_paths, adjust_handle_size, change_pathname
|
|
|
|
ldx #func_13_param_cnt ;get the number of parameters of the stack
|
|
jsr get_parameters
|
|
|
|
newAddr EQU input_parms
|
|
oldAddr EQU newAddr+4
|
|
|
|
;
|
|
; indicate to compare_paths that a partial match is OK
|
|
;
|
|
lda #$8000
|
|
sta partial_match ;indicate that a partial match is OK
|
|
|
|
;
|
|
; if either input pathname is NIL, just exit with no error
|
|
;
|
|
lda oldAddr
|
|
ora oldAddr+2
|
|
bne cont1
|
|
its_null
|
|
jmp OK_Exit
|
|
cont1 lda newAddr
|
|
ora newAddr+2
|
|
beq its_null
|
|
cont2 lda [oldAddr]
|
|
beq its_null
|
|
cont3 lda [newAddr]
|
|
beq its_null
|
|
|
|
;
|
|
; expand both input pathnames (to upper case them)
|
|
;
|
|
cont3a lda oldAddr
|
|
ldy oldAddr+2
|
|
jsr Expand_Pathname
|
|
bcc _1
|
|
error_skip
|
|
jmp Error_Exit
|
|
_1
|
|
lda TempBuff
|
|
sta oldAddr
|
|
lda TempBuff+2
|
|
sta oldAddr+2
|
|
|
|
lda newAddr
|
|
ldy newAddr+2
|
|
jsr Expand_Pathname
|
|
bcs error_skip
|
|
lda TempBuff
|
|
sta newAddr
|
|
lda TempBuff+2
|
|
sta newAddr+2
|
|
;
|
|
; if input and output pathnames are the same, exit
|
|
;
|
|
lda [oldAddr]
|
|
cmp [newAddr]
|
|
bne do_rename ;different lengths, just do the rename
|
|
|
|
cont3b tay
|
|
iny
|
|
sep #$20
|
|
longa off
|
|
loop0 lda [oldAddr],y
|
|
eor [newAddr],y ;case insensentive comparision
|
|
and #$DF ;ignore the case bit
|
|
bne cont3c
|
|
dey
|
|
bne loop0
|
|
rep #$20
|
|
longa on
|
|
to_OK_Exit
|
|
jmp OK_Exit ;they're the same!
|
|
cont3c
|
|
rep #$20
|
|
longa on
|
|
do_rename
|
|
lda oldAddr ;point TempBuff to old pathname
|
|
sta TempBuff
|
|
lda oldAddr+2
|
|
sta TempBuff+2
|
|
|
|
jsr rename_segments ;go and rename ExpressLoad stuff
|
|
|
|
old_loader
|
|
;
|
|
; oldAddr = points into old input pathname
|
|
; newAddr = points into new input pathname
|
|
; oldTable = points into original Pathname Table entry
|
|
; newTable = points into new Pathname Table entry
|
|
|
|
;
|
|
; search Pathname Table for a match to old Pathname (match only the number of chars
|
|
; corresponding to the length of the old Pathname)
|
|
;
|
|
lda |PATHTBL+2
|
|
sta Handle+2
|
|
lda |PATHTBL
|
|
sta Handle ;handle to 1st entry
|
|
ora Handle+2
|
|
beq OK_Exit ;yes, end of pathname table
|
|
loop1
|
|
lda Handle
|
|
ldy Handle+2
|
|
jsr DeRef ;dereference Handle
|
|
;
|
|
; bump returned pointer to start of pathname in Pathname Table entry
|
|
;
|
|
clc
|
|
adc #PT_Path
|
|
sta PathnamePtr ;set PathnamePtr to name within Pathname table entry
|
|
bcc @1
|
|
iny
|
|
@1
|
|
sty PathnamePtr+2
|
|
|
|
lda [PathnamePtr] ;check for a NULL pathname (memory-loaded file)
|
|
beq eloop1 ;if NULL, there's no way there's gonna be a match
|
|
|
|
jsr compare_paths ;compare the pathnames
|
|
bcs eloop1 ;no match
|
|
|
|
php ;save partial/full match status
|
|
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 table entry
|
|
bcs eloop1 ;just punt if we get an error
|
|
ldy #2 ;deref Handle
|
|
lda [Handle]
|
|
clc
|
|
adc #PT_Path ;offset to position of pathname within segment
|
|
sta PathnamePtr
|
|
lda [Handle],y
|
|
adc #0
|
|
sta PathnamePtr+2
|
|
@no_size_change
|
|
plp ;retrieve complete/partial match status
|
|
jsr change_pathname ;go make the change
|
|
;
|
|
; continue to next entry
|
|
;
|
|
eloop1 lda Handle
|
|
ldy Handle+2
|
|
jsr DeRef
|
|
sta Pointer
|
|
sty Pointer+2
|
|
ldy #PT_Next+2 ;bump Handle to Next Handle
|
|
lda [Pointer],y
|
|
sta Handle+2
|
|
lda [Pointer]
|
|
sta Handle
|
|
ora Handle+2
|
|
bne loop1 ;continue checking
|
|
|
|
OK_Exit lda #0
|
|
Error_Exit
|
|
pha ;save status
|
|
pea uTempBuff ;dispose of temporary memory
|
|
_DisposeAll
|
|
pla ;restore status
|
|
jmp return_to_caller
|
|
|
|
ENDP
|
|
|
|
TITLE ', FUNCTIONS.a - GetGlobalsAddr'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* GetGlobalsAddr ($1E)
|
|
*
|
|
* Inputs: none
|
|
*
|
|
* Outputs: Globals address (4 bytes)
|
|
*
|
|
* Errors: $0000 - Operation successful
|
|
*
|
|
****************************************************************
|
|
*
|
|
GetGlobalsAddr PROC EXPORT
|
|
LoadSegCheck
|
|
|
|
with DirectPage, Globals
|
|
|
|
oAddress equ 7
|
|
|
|
lda #Globals
|
|
sta oAddress,s
|
|
lda #^Globals
|
|
sta oAddress+2,s
|
|
lda #0
|
|
clc
|
|
rtl
|
|
EndP |