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
25 KiB
Plaintext
1 line
25 KiB
Plaintext
TITLE ', SEGMENTS.a - Load_Segment'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Load a Segment
|
|
*
|
|
* Inputs: User ID (TOS+7)
|
|
* Load File Number (TOS+5)
|
|
* Load Segment Number (TOS+3)
|
|
*
|
|
* Outputs: Segment Address (TOS+9)
|
|
* A - status
|
|
* C - set if error occurred
|
|
*
|
|
* Zero Page used: TempZero, Handle
|
|
*
|
|
****************************************************************
|
|
*
|
|
Load_Segment PROC
|
|
with DirectPage, Globals
|
|
|
|
OAddress equ 9
|
|
IUserID equ 7
|
|
IFileNum equ 5
|
|
ISegNum equ 3
|
|
;
|
|
; look in Memory Segment Table for segment
|
|
;
|
|
lda #0
|
|
pha ;output Handle
|
|
pha
|
|
lda IUserID+4,s ;UserID
|
|
pha
|
|
lda IFileNum+6,s ;Load File Number
|
|
pha
|
|
lda ISegNum+8,s ;Load Segment Number
|
|
pha
|
|
jsr Find_MemSeg
|
|
pla
|
|
sta Handle ;output Handle
|
|
pla
|
|
sta Handle+2
|
|
lda |MS_Handle,x ;save handle to Load Segment
|
|
sta TempZero
|
|
lda |MS_Handle+2,x
|
|
sta TempZero+2
|
|
phk ;restore DBR
|
|
plb
|
|
|
|
bcs cont1 ;check if segment actually found
|
|
;
|
|
; found segment in Memory Segment Table, lock it
|
|
;
|
|
pei TempZero+2 ;Handle
|
|
pei TempZero
|
|
_HLock
|
|
;
|
|
; now check to see if it is really in memory
|
|
;
|
|
lda TempZero
|
|
ora TempZero+2
|
|
beq cont0
|
|
lda TempZero ;handle to load segment
|
|
ldy TempZero+2
|
|
jsr DeRef ;dereference handle
|
|
bcc found ;A,Y now contains address
|
|
;
|
|
; segment is not in memory, dispose of the handle in the
|
|
; Memory Segment Table entry
|
|
;
|
|
pei TempZero+2
|
|
pei TempZero
|
|
_DisposeHandle
|
|
bcs error
|
|
;
|
|
; remove entry in Memory Segment Table
|
|
;
|
|
cont0 pea SEGTBL>>16 ;address of Memory Segment Table
|
|
pea |SEGTBL
|
|
pei Handle+2 ;handle of entry
|
|
pei Handle
|
|
jsr Remove_Link
|
|
;
|
|
; look for load segment in Load File
|
|
;
|
|
cont1 ldx #0 ;output Address
|
|
phx
|
|
phx
|
|
lda IUserID+4,s ;UserID
|
|
pha
|
|
lda IFileNum+6,s ;Load File Number
|
|
pha
|
|
lda ISegNum+8,s ;Load Segment Number
|
|
pha
|
|
phx ;Load Segment Address (0 for allocate)
|
|
phx
|
|
jsr Find_Segment
|
|
plx
|
|
ply
|
|
bcs error
|
|
txa
|
|
;
|
|
; store address as output and we are done
|
|
;
|
|
found sta OAddress,s
|
|
tya
|
|
sta OAddress+2,s
|
|
lda #0
|
|
error Stack_Cleanup 6
|
|
rts
|
|
|
|
ENDP
|
|
|
|
TITLE ', SEGMENTS.a - Find_Segment'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Find and Load Segment
|
|
*
|
|
* Inputs: User ID (TOS+11)
|
|
* Load File Number (TOS+9)
|
|
* Load Segment Number (TOS+7)
|
|
* Load Segment Address (TOS+3)
|
|
* Outputs: Segment Address (TOS+13)
|
|
* A - status
|
|
* C - set if error occurred
|
|
*
|
|
* Zero Page used: TempZero, CFileNum, CSegNum, CAddress, Counter
|
|
*
|
|
* If Load Segment Number=0, the Jump Table Segment is loaded.
|
|
*
|
|
****************************************************************
|
|
*
|
|
Find_Segment PROC
|
|
with DirectPage, Globals
|
|
Import save_dp,restore_dp
|
|
|
|
OAddress equ 13
|
|
IUserID equ 11
|
|
IFileNum equ 9
|
|
ISegNum equ 7
|
|
IAddress equ 3
|
|
;
|
|
; look for entry in Pathname Table for file
|
|
;
|
|
lda IUserID,s ;UserID
|
|
pha
|
|
lda IFileNum+2,s ;File Number
|
|
pha
|
|
lda #0 ;no pathname
|
|
pha
|
|
pha
|
|
jsr Find_Pathname
|
|
bcs error_skip
|
|
;
|
|
; if UserID is an Application, don't close load file
|
|
;
|
|
stz Keep_Open
|
|
lda IUserID,s
|
|
and #$F000
|
|
cmp #Application
|
|
bne cont1
|
|
inc Keep_Open
|
|
;
|
|
; extract Time/Date stamp from entry
|
|
;
|
|
cont1 lda |PT_Date,x
|
|
sta TempZero
|
|
lda |PT_Date+2,x
|
|
sta TempZero+2
|
|
lda |PT_Date+4,x
|
|
sta TempZero+4
|
|
lda |PT_Date+6,x
|
|
sta TempZero+6
|
|
;
|
|
; extract pathname of file
|
|
;
|
|
cont phx ;save X
|
|
jsr Get_Pathname
|
|
plx ;restore x
|
|
bcs error_skip
|
|
;
|
|
; has Jump Table Segment been processed yet?
|
|
;
|
|
cont2 lda |PT_Jump,x
|
|
bne cont3
|
|
|
|
inc a ;Acc now = 1
|
|
sta |PT_Jump,x ;set flag
|
|
phk ;restore DBR
|
|
plb ;to our bank
|
|
;
|
|
; no, load all static segments by calling InitialLoad 2
|
|
;
|
|
jsr save_dp ;save current direct page
|
|
|
|
lda IUserID+4,s ;UserID (+4 because of handle on stack)
|
|
|
|
;make space for output parameters
|
|
pha ;output Direct Page/Stack info
|
|
pha
|
|
pha ;output Starting Address
|
|
pha
|
|
pha ;output UserID
|
|
|
|
;now place the input parameters into direct page
|
|
sta input_parms+8 ;UserID
|
|
stz input_parms+2 ;special memory flag
|
|
lda Handle ;Handle of Pathname Table
|
|
ldy Handle+2
|
|
jsr DeRef
|
|
sta input_parms+4 ;address of Pathname Table entry
|
|
sty input_parms+6
|
|
lda #3 ;input type
|
|
sta input_parms
|
|
jsr type3_InitLoad ;private call to InitialLoad
|
|
|
|
plx ;UserID
|
|
plx ;Starting Address
|
|
ply
|
|
plx ;Direct Page/Stack Address
|
|
plx ;Direct Page/Stack Size
|
|
jsr restore_dp ;restore our direct page values
|
|
bcc good_load
|
|
error_skip
|
|
jmp error
|
|
|
|
good_load
|
|
;
|
|
; check whether segment has been loaded (i.e. segment is static)
|
|
;
|
|
lda #0 ;output Handle
|
|
pha
|
|
pha
|
|
lda IUserID+4,s ;UserID
|
|
pha
|
|
lda IFileNum+6,s ;Load File Number
|
|
pha
|
|
lda ISegNum+8,s ;Load Segment Number
|
|
pha
|
|
jsr Find_MemSeg
|
|
pla ;output Handle
|
|
pla
|
|
lda |MS_Handle,x ;handle to segment's memory
|
|
ldy |MS_Handle+2,x
|
|
;
|
|
; restore DBR
|
|
;
|
|
phk
|
|
plb
|
|
;
|
|
; if segment is there, return with address
|
|
;
|
|
bcs cont3
|
|
jsr DeRef ;convert handle to address
|
|
sta OAddress,s
|
|
tya
|
|
sta OAddress+2,s
|
|
lda #0 ;no error
|
|
jmp return ;and exit
|
|
;
|
|
; open file
|
|
;
|
|
cont3 phk
|
|
plb
|
|
stz Memory_Load ;clear Memory Load Flag
|
|
pei TempBuff+2 ;address of Pathname
|
|
pei TempBuff
|
|
pei TempZero+6 ;time/date stamp
|
|
pei TempZero+4
|
|
pei TempZero+2
|
|
pei TempZero
|
|
jsr Open_File
|
|
bcs error_skip
|
|
;
|
|
; skip 'SegNum'-1 number of Segment Headers and read the next one
|
|
;
|
|
cont4 lda ISegNum,s
|
|
beq cont5 ;if SegNum=0, load Segment 1
|
|
dec a
|
|
beq cont5 ;if SegNum=1, skip skipping
|
|
sta Counter ;set counter to Segment Number-1
|
|
loop jsr Skip_Header
|
|
lda #NoFind
|
|
bcs error
|
|
dec Counter
|
|
bne loop
|
|
cont5 jsr Next_Header
|
|
bcs error
|
|
;
|
|
; load segment - pass 1
|
|
;
|
|
lda IUserID,s ;set global USERID to input UserID
|
|
sta |USERID
|
|
lda IFileNum,s ;set current File Number to FileNum
|
|
sta CFileNum
|
|
lda ISegNum,s ;set current Segment Number to SegNum
|
|
sta CSegNum
|
|
lda IAddress,s
|
|
sta CAddress ;set current Segment Address to Address
|
|
lda IAddress+2,s
|
|
sta CAddress+2
|
|
lda |SEGTBL
|
|
sta FirstMemSeg ;set first Memory Segment entry
|
|
lda |SEGTBL+2
|
|
sta FirstMemSeg+2
|
|
stz Pass ;set current pass to 1st pass
|
|
stz Pass2_Needed ;zero Pass2 Needed flag
|
|
ldx #1 ;Special Memory Flag
|
|
try_again_2
|
|
phx ;save special memory flag
|
|
jsr Do_Segment
|
|
plx ;retrieve special memory flag
|
|
bcc @no_error ;no errors, continue
|
|
dex ;should we allow special memory?
|
|
beq try_again_2 ;yup, try again
|
|
bra error ;nope, we've already tried
|
|
@no_error
|
|
;
|
|
; save address of segment as output
|
|
;
|
|
lda Header.Org
|
|
sta OAddress,s
|
|
lda Header.Org+2
|
|
sta OAddress+2,s
|
|
;
|
|
; is a second pass needed ?
|
|
;
|
|
lda Pass2_Needed
|
|
beq return ;no, exit
|
|
inc Pass ;set current pass to 2nd pass
|
|
;
|
|
; yes, position file at Relocation Dictionary
|
|
;
|
|
lda #0 ;output Offset
|
|
pha
|
|
pha
|
|
pea ML_FirstEntry>>16 ;Offset of 1st entry
|
|
pea |ML_FirstEntry
|
|
jsr Next_Dictionary
|
|
plx ;output Offset
|
|
ply
|
|
bcs error
|
|
;
|
|
; process Segment's Relocation Dictionary
|
|
;
|
|
ldx #0 ;Special Memory Flag
|
|
jsr Do_Segment
|
|
bcc return
|
|
|
|
error stz Keep_Open ;set Keep_Open flag to FALSE
|
|
phk ;restore DBR
|
|
plb
|
|
return
|
|
error1 pha ;save status
|
|
;
|
|
; dispose of temporary pathname buffer
|
|
;
|
|
pea uTempBuff ;UserID
|
|
_DisposeAll
|
|
;
|
|
; dispose of Mark List
|
|
;
|
|
pea uMarkList ;UserID
|
|
_DisposeAll
|
|
|
|
jsr Close_File
|
|
|
|
pla ;restore status
|
|
Stack_Cleanup 10
|
|
rts
|
|
|
|
ENDP
|
|
|
|
TITLE ', SEGMENTS.a - Do_Segment'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Process current Segment
|
|
*
|
|
* Inputs: X - Special Memory Flag
|
|
* Header - Segment Header
|
|
* CFileNum - current File Number
|
|
* CSegNum - current Segment Number
|
|
* CAddress - current Segment Address
|
|
*
|
|
* Outputs: A - status
|
|
* C - set if error occurred
|
|
*
|
|
* Zero Page used: TempZero, Handle, FirstMemSeg
|
|
*
|
|
* If CAddress is 0, the fields in the Segment Header will
|
|
* determine where a new Memory Segment will be allocated and
|
|
* the Segment will be loaded there. If CAddress is not
|
|
* 0, the Segment will be loaded at that address.
|
|
*
|
|
****************************************************************
|
|
*
|
|
Do_Segment PROC
|
|
with DirectPage, Globals
|
|
|
|
;
|
|
; which pass are we doing ?
|
|
;
|
|
lda Pass
|
|
beq cont1
|
|
;
|
|
; pass 2, look in Memory Segment Table for segment
|
|
;
|
|
lda FirstMemSeg
|
|
sta Handle
|
|
lda FirstMemSeg+2
|
|
sta Handle+2
|
|
|
|
lda #0 ;output Handle
|
|
pha
|
|
pha
|
|
lda |USERID ;UserID
|
|
pha
|
|
pei CFileNum ;Load File Number
|
|
pei CSegNum ;Load Segment Number
|
|
jsr Next_MemSeg
|
|
ply ;output Handle
|
|
ply
|
|
bcs to_Reloc_Error
|
|
lda |MS_Handle,x
|
|
ldy |MS_Handle+2,x
|
|
phk ;restore DBR
|
|
plb
|
|
;
|
|
; set CAddress to Address of current Segment
|
|
;
|
|
jsr DeRef
|
|
sta CAddress
|
|
sty CAddress+2
|
|
;
|
|
; go to record processing loop
|
|
;
|
|
jmp Reloc_Loop
|
|
;
|
|
; pass 1, check whether Version is 1 or 2
|
|
;
|
|
cont1 lda Header.Version
|
|
and #$FF
|
|
cmp #1
|
|
beq cont2
|
|
cmp #2
|
|
beq cont2
|
|
;
|
|
; no, the OMF Version is not supported
|
|
;
|
|
lda #BadOMF
|
|
to_Reloc_Error
|
|
jmp Reloc_Error
|
|
;
|
|
; check whether SegNum in Header = current Segment Number
|
|
;
|
|
cont2 lda Header.SegNum
|
|
cmp CSegNum
|
|
beq cont3
|
|
;
|
|
; no, this file is corrupt (SegNum out of sequence)
|
|
;
|
|
lda #BadNum
|
|
jmp Reloc_Error
|
|
;
|
|
; check whether Segment is foreign
|
|
;
|
|
cont3 ldy #Foreign
|
|
lda Header.NumSex ;check NumSex
|
|
and #$FF
|
|
beq cont4 ;should be 0
|
|
;
|
|
; yes, Segment is foreign
|
|
;
|
|
its_foreign
|
|
tya
|
|
jmp Reloc_Error
|
|
|
|
cont4 lda Header.NumLen ;check NumLen
|
|
and #$FF
|
|
cmp #4 ;should be 4
|
|
bne its_foreign
|
|
;
|
|
; check whether BankSize is legal
|
|
;
|
|
cont5 lda Header.BankSize+2 ;check BankSize
|
|
beq cont6 ;must be <=$10000
|
|
cmp #1
|
|
bne its_foreign
|
|
lda Header.BankSize
|
|
bne its_foreign
|
|
;
|
|
; check whether Align is legal
|
|
;
|
|
cont6 lda Header.Align+2 ;check Align
|
|
beq cont7 ;must be <=$10000
|
|
cmp #1
|
|
bne its_foreign
|
|
lda Header.Align
|
|
bne its_foreign
|
|
;
|
|
; check whether there is any data in the segment
|
|
;
|
|
cont7 lda Header.ByteCnt ;if BYTECNT=0, no data
|
|
ora Header.ByteCnt+2
|
|
bne cont7a
|
|
to_Reloc_Return
|
|
jmp Reloc_Return ;no data
|
|
|
|
cont7a lda Header.Length ;if LENGTH=0, no data
|
|
ora Header.Length+2
|
|
beq to_Reloc_Return ;no data
|
|
;
|
|
; if CAddress<>0, segment will be loaded into existing memory buffer
|
|
;
|
|
cont8 lda CAddress
|
|
ora CAddress+2
|
|
beq cont9
|
|
;
|
|
; find Memory Handle that corresponds to CAddress
|
|
;
|
|
phx ;save X (Special Memory Flag)
|
|
lda #0 ;output Handle
|
|
pha
|
|
pha
|
|
lda CAddress+2 ;Address (bank)
|
|
sta Header.Org+2
|
|
pha
|
|
lda CAddress
|
|
sta Header.Org
|
|
pha
|
|
_FindHandle
|
|
pla ;output Handle
|
|
ply
|
|
sta Handle
|
|
sty Handle+2
|
|
;
|
|
; zero memory segment
|
|
;
|
|
jsr DeRef ;dereference Handle
|
|
jsr Zero_Segment
|
|
|
|
plx ;restore X
|
|
bra Reloc_Loop
|
|
;
|
|
; get memory segment for load segment
|
|
;
|
|
cont9 txa ;Special Memory Flag
|
|
jsr Allocate_Segment
|
|
bcs Reloc_Error
|
|
|
|
lda Header.Org
|
|
sta CAddress ;save Load Address
|
|
lda Header.Org+2
|
|
sta CAddress+2
|
|
;
|
|
; create new entry in Memory Segment Table
|
|
;
|
|
pei Handle+2 ;Memory Handle
|
|
pei Handle
|
|
lda |USERID
|
|
pha
|
|
pei CFileNum ;Load File Number
|
|
pei CSegNum ;Load Segment Number
|
|
lda Header.Kind ;Load Segment Kind
|
|
pha
|
|
jsr Add_MemSeg
|
|
bcs Reloc_Error
|
|
;
|
|
; if this is first segment loaded, save Memory Segment Table handle
|
|
;
|
|
lda FirstMemSeg
|
|
ora FirstMemSeg+2
|
|
bne Reloc_Loop
|
|
lda TempZero
|
|
sta FirstMemSeg
|
|
lda TempZero+2
|
|
sta FirstMemSeg+2
|
|
;
|
|
; process each Segment record until the END record is reached
|
|
;
|
|
ENTRY Reloc_Loop
|
|
Reloc_Loop
|
|
jsr Read_Op ;read operation code
|
|
bcs Reloc_Error
|
|
|
|
lda |Record ;get record operation code
|
|
and #$FF
|
|
beq Reloc_Return ;END record found, we are done
|
|
;
|
|
; search Record Table for OP code
|
|
;
|
|
ldx #6*4 ;7 double entries in table
|
|
loop2 cmp Record_Table,x
|
|
bne cont10
|
|
;
|
|
; found OP code in Table, put OP code routine address on stack and
|
|
; jump to it
|
|
;
|
|
jmp (Record_Table+2,x)
|
|
|
|
cont10 dex
|
|
dex
|
|
dex
|
|
dex
|
|
bpl loop2
|
|
;
|
|
; OP code not in table, error
|
|
;
|
|
lda #Illegal ;illegal record operation code
|
|
|
|
ENTRY Reloc_Return,Reloc_Error
|
|
Reloc_Return
|
|
Reloc_Error
|
|
phk ;restore DBR just in case
|
|
plb
|
|
cmp #1
|
|
rts
|
|
|
|
Record_Table
|
|
DC.W DS,Do_DS
|
|
DC.W LCONST,Do_LCONST
|
|
DC.W INTERSEG,Do_INTERSEG
|
|
DC.W RELOC,Do_RELOC
|
|
DC.W cINTERSEG,Do_cINTERSEG
|
|
DC.W cRELOC,Do_cRELOC
|
|
DC.W SUPER,Do_SUPER
|
|
|
|
ENDP
|
|
|
|
TITLE ', SEGMENTS.a - Do_Init_Segment'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Process Initialization Segment
|
|
*
|
|
* Inputs: A,Y - Address of Segment
|
|
*
|
|
* Direct Page used - TempZero
|
|
****************************************************************
|
|
*
|
|
Do_Init_Segment PROC
|
|
|
|
dec a ;Address -1
|
|
phb ;yes, save Data Bank register
|
|
phd ;save Direct register
|
|
phk ;setup stack for implicit JSL
|
|
pea cont-1
|
|
|
|
sep #$10 ;8-bit index registers
|
|
phy ;put high byte of address on stack
|
|
rep #$10
|
|
pha ;put segment address on stack
|
|
lda #0 ;set Direct register to 0
|
|
tcd
|
|
rtl ;do implicit JSL
|
|
|
|
cont pld ;restore Direct register
|
|
plb ;restore Data Bank register
|
|
rep #$30 ;restore 16 bit mode
|
|
rts
|
|
|
|
ENDP
|
|
|
|
TITLE ', SEGMENTS.a - Do_Path_Segment'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Process Pathname Segment
|
|
*
|
|
* Inputs: Handle of segment in memory (TOS+7)
|
|
* Address of segment in memory (TOS+3)
|
|
*
|
|
* Zero Page used: Pointer,TempBuff
|
|
*
|
|
****************************************************************
|
|
*
|
|
|
|
Do_Path_Segment PROC
|
|
with DirectPage, Globals
|
|
;
|
|
; inputs on stack
|
|
;
|
|
SHandle equ 7
|
|
SAddress equ 3
|
|
;
|
|
; fields in Pathname Segment entry
|
|
;
|
|
File_Num equ 0
|
|
File_Date equ 2
|
|
File_Path equ 10
|
|
|
|
lda SAddress,s
|
|
sta Pointer
|
|
lda SAddress+2,s
|
|
sta Pointer+2
|
|
loop ldy #File_Num ;get next File Number
|
|
lda [Pointer],y
|
|
beq return ;if 0, we are done
|
|
lda |USERID ;UserID
|
|
pha
|
|
ldy #File_Num
|
|
lda [Pointer],y ;File Number
|
|
pha
|
|
ldy #File_Date+6 ;File Date
|
|
lda [Pointer],y
|
|
pha
|
|
ldy #File_Date+4
|
|
lda [Pointer],y
|
|
pha
|
|
ldy #File_Date+2 ;File Date
|
|
lda [Pointer],y
|
|
pha
|
|
ldy #File_Date
|
|
lda [Pointer],y
|
|
pha
|
|
ldx #0 ;Direct Page/Stack info
|
|
phx
|
|
phx
|
|
phx ;Starting Address
|
|
phx
|
|
ldy Pointer+2 ;calculate address of pathname
|
|
lda Pointer
|
|
clc
|
|
adc #File_Path
|
|
bcc @1
|
|
iny
|
|
@1 ;A,Y - pathname
|
|
; ldx #0 (already) ;X - convert 0 pathname to 1
|
|
jsr Convert_Pathname ;convert Pathname
|
|
lda TempBuff ;converted Pathname
|
|
ldy TempBuff+2
|
|
jsr Expand_Pathname ;expand Pathname
|
|
pei TempBuff+2 ;expanded Pathname
|
|
pei TempBuff
|
|
jsr Add_Pathname ;add entry to Pathname Table
|
|
bcs return
|
|
;
|
|
; bump SAddress and Pointer to next entry
|
|
;
|
|
lda SAddress,s
|
|
sta Pointer
|
|
lda SAddress+2,s
|
|
sta Pointer+2
|
|
ldy #File_Path
|
|
lda [Pointer],y
|
|
and #$FF
|
|
clc
|
|
adc #11
|
|
adc Pointer
|
|
sta Pointer
|
|
sta SAddress,s
|
|
lda Pointer+2
|
|
adc #0
|
|
sta Pointer+2
|
|
sta SAddress+2,s
|
|
bra loop
|
|
;
|
|
; return
|
|
;
|
|
return Stack_Cleanup 8 ;remove input parameters
|
|
rts
|
|
ENDP
|
|
|
|
TITLE ', SEGMENTS.a - Do_Jump_Segment'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Process Jump Table Segment
|
|
*
|
|
* Inputs: Handle of segment in memory (TOS+7)
|
|
* Address of segment in memory (TOS+3)
|
|
*
|
|
* Zero Page used: TempZero
|
|
*
|
|
****************************************************************
|
|
*
|
|
|
|
Do_Jump_Segment PROC
|
|
with DirectPage, Globals
|
|
;
|
|
; inputs on stack
|
|
;
|
|
SHandle equ 7
|
|
SAddress equ 3
|
|
|
|
;
|
|
; copy address to ExpressLoad variables, and then call the ExpressLoad function
|
|
;
|
|
lda SAddress,s
|
|
sta base_ptr
|
|
lda SAddress+2,s
|
|
sta base_ptr+2
|
|
jsr patch_jmp_tbl
|
|
;
|
|
; allocate memory buffer for new Jump Table List entry
|
|
;
|
|
cont2 lda #0 ;output Handle
|
|
pha
|
|
pha
|
|
pea JT_Handle+4>>16 ;BlockSize
|
|
pea |JT_Handle+4
|
|
pea uJMPTBL ;Owner
|
|
pea attrLocked+attrNoSpec ;Attributes
|
|
pha ;Location
|
|
pha
|
|
_NewHandle ;get memory buffer
|
|
plx
|
|
ply
|
|
stx TempZero ;save returned handle
|
|
sty TempZero+2
|
|
bcs error
|
|
|
|
txa
|
|
jsr DeRef ;dereference handle
|
|
sta TempZero+4 ;save pointer
|
|
sty TempZero+6
|
|
;
|
|
; zero linked list pointers
|
|
;
|
|
lda #0
|
|
ldy #6
|
|
@loop
|
|
sta [TempZero+4],y
|
|
dey
|
|
dey
|
|
bpl @loop
|
|
;
|
|
; make pointer usable
|
|
;
|
|
lda TempZero+4
|
|
ldy TempZero+6
|
|
phb ;save DBR
|
|
jsr UsePtr
|
|
;
|
|
; store data in Jump Table List entry
|
|
;
|
|
lda >USERID ;UserID
|
|
sta |JT_UserID,x
|
|
lda SHandle+1,s ;Handle to Jump Table Segment
|
|
sta |JT_Handle,x
|
|
lda SHandle+3,s
|
|
sta |JT_Handle+2,x
|
|
plb ;restore DBR
|
|
;
|
|
; link new entry to previous
|
|
;
|
|
pea JMPTBL>>16
|
|
pea |JMPTBL
|
|
pei TempZero+2
|
|
pei TempZero
|
|
jsr Add_Link
|
|
;
|
|
; unlock Jump Table List entry
|
|
;
|
|
pei TempZero+2
|
|
pei TempZero
|
|
_HUnlock
|
|
error Stack_Cleanup 8 ;remove input parameters
|
|
rts
|
|
|
|
ENDP
|
|
|
|
TITLE ', SEGMENTS.a - Allocate_Segment'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Allocate a Memory Segment for a Segment
|
|
*
|
|
* Inputs: A - Special Memory Flag
|
|
* Header - Segment Header
|
|
*
|
|
* Outputs: Handle - Handle to Memory Segment
|
|
* Header+ORG - Address of Memory Segment
|
|
* A - status code
|
|
* C - set if error
|
|
*
|
|
* Zero Page used: TempZero, Counter, Handle
|
|
*
|
|
****************************************************************
|
|
*
|
|
|
|
Allocate_Segment PROC
|
|
with DirectPage, Globals
|
|
|
|
sta spec_mem_flag ;save for use by conv_attributes
|
|
lda #<(Header-4) ;set up seg_header_ptr
|
|
sta seg_header_ptr
|
|
lda #^(Header-4) ;to make ExpressLoad subroutine happy
|
|
sta seg_header_ptr+2
|
|
jsr conv_attributes ;calculate memory attributes required
|
|
pha ;save on stack
|
|
sta Counter ;save (TempZero is used later)
|
|
|
|
lda Header.Kind ;get the segment kind
|
|
bit #AbsBank_Segment ;Absolute Bank Segment?
|
|
bne @skip_special ;yes, don't set the NoSpecialMemory attribute
|
|
and #$001f ;mask out the attributes
|
|
cmp #Direct_Segment ;direct page?
|
|
beq @skip_special ;yes, don't set the NoSpecialMemory attribute
|
|
lda #attrNoSpec ;set the NoSpecialMemory bit
|
|
tsb Counter
|
|
@skip_special
|
|
jsr allocate_mem ;go allocate the memory
|
|
bcc cont ;if no error, we are done
|
|
;
|
|
; couldn't allocate memory but maybe the Loader is wasting memory sooo
|
|
; call Cleanup routine to attempt to free more memory.
|
|
;
|
|
pha ;save Memory Manager error
|
|
pea 0 ;all UserID's
|
|
jsr Cleanup ;cleanup internal tables
|
|
pla ;restore Memory Manager error
|
|
bcs error
|
|
|
|
jsr allocate_mem ;go allocate the memory
|
|
bcc cont ;got it!
|
|
tax ;save error code
|
|
lda 1,s ;retrieve original attributes
|
|
bit #attrNoSpec ;was the noSpecialMemory attribute set already?
|
|
beq @try_again ;no, so try again, allowing special memory
|
|
txa ;restore error code to accumulator
|
|
sec
|
|
bra error ;and we're outta here
|
|
@try_again
|
|
sta Counter ;use the original attributes this time
|
|
jsr allocate_mem ;try this one last time
|
|
bcs error ;OK already, I give up!
|
|
;
|
|
; dereference the memory segment Handle
|
|
;
|
|
cont
|
|
txa ;get handle into Acc and Y
|
|
jsr DeRef ;dereference Handle
|
|
sta Header.Org ;save in Segment Header
|
|
sty Header.Org+2
|
|
;
|
|
; zero out segment to speed up DS record processing
|
|
;
|
|
jsr Zero_Segment
|
|
;
|
|
; normal return
|
|
;
|
|
error
|
|
plx ;clean up stack (remove original attributes)
|
|
rts
|
|
|
|
allocate_mem
|
|
lda Counter ;copy attributes
|
|
sta mem_attr
|
|
lda Header.Org
|
|
sta org_address
|
|
lda Header.Org+2
|
|
sta org_address+2
|
|
ldx Header.Length
|
|
ldy Header.Length+2
|
|
jsr alloc_LConst_seg
|
|
stx Handle ;Handle
|
|
sty Handle+2
|
|
rts
|
|
|
|
ENDP
|
|
|
|
TITLE ', SEGMENTS.a - Purge_Segment'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Purge Segment
|
|
*
|
|
* Inputs: User ID (TOS+11)
|
|
* Load File Number (TOS+9)
|
|
* Load Segment Number (TOS+7)
|
|
* Dynamic Only Flag (TOS+5)
|
|
* Purge Level (TOS+3)
|
|
*
|
|
* Outputs: A - status code
|
|
* C - set if entry not found or error ocurred
|
|
*
|
|
* Zero Page used: TempZero, Handle
|
|
*
|
|
* The Memory Segment Table is searched for the specified
|
|
* Load Segment or all segments (if UserID=0). The Memory Block
|
|
* for the segment is either made purgeable (if Purge Level>0) or
|
|
* disposed (if Purge Level=0) and all the Jump Table entries for
|
|
* the segment are marked as unloaded.
|
|
*
|
|
* If the UserID is 0, only segments which are no longer in memory
|
|
* (their Memory Segment Handle is NIL) are processed.
|
|
*
|
|
* If a Memory Segment Handle is disposed, the Handle in the Memory
|
|
* Segment Table entry is set to 0.
|
|
*
|
|
* If the Dynamic Only Flag is set, only Dynamic Load Segments
|
|
* are processed.
|
|
*
|
|
* If any of the 1st three inputs are 0, all entries in the
|
|
* Memory Segment Table are searched and only the entries
|
|
* with attributes equal to the non-zero inputs are processed.
|
|
*
|
|
****************************************************************
|
|
*
|
|
|
|
Purge_Segment PROC
|
|
with DirectPage, Globals
|
|
|
|
IUserID equ 11
|
|
FileNum equ 9
|
|
SegNum equ 7
|
|
Dynamic equ 5
|
|
PLevel equ 3
|
|
;
|
|
; if any of the inputs are 0, set Pass2_Needed
|
|
;
|
|
ldx #1
|
|
lda IUserID,s
|
|
beq cont1
|
|
lda FileNum,s
|
|
beq cont1
|
|
lda SegNum,s
|
|
beq cont1
|
|
dex
|
|
;
|
|
; search Memory Segment Table for entry corresponding to inputs
|
|
;
|
|
cont1 stx Pass2_Needed
|
|
lda |SEGTBL
|
|
sta Handle
|
|
lda |SEGTBL+2
|
|
sta Handle+2
|
|
loop lda #0 ;output Handle
|
|
pha
|
|
pha
|
|
lda IUserID+4,s ;UserID
|
|
pha
|
|
lda FileNum+6,s ;File Number
|
|
pha
|
|
lda SegNum+8,s ;Segment Number
|
|
pha
|
|
jsr Next_MemSeg
|
|
pla
|
|
sta TempZero ;output Handle
|
|
pla
|
|
sta TempZero+2
|
|
lda |MS_Handle,x
|
|
sta TempZero+4 ;save Handle of Memory block
|
|
lda |MS_Handle+2,x
|
|
sta TempZero+6
|
|
lda #NoFind
|
|
bcs error
|
|
;
|
|
; if Dynamic Only Flag is set, skip if not a Dynamic Load Segment
|
|
;
|
|
lda Dynamic,s
|
|
beq cont2
|
|
lda |MS_Kind,x
|
|
bit #Dyn_Segment
|
|
beq eloop
|
|
;
|
|
; check Purge Level
|
|
;
|
|
cont2 lda PLevel,s
|
|
bne cont3
|
|
;
|
|
; Purge Level=0, dispose of Memory Block if
|
|
;
|
|
; a) UserID<>0
|
|
; or
|
|
; b) UserID=0 and Handle=NIL
|
|
;
|
|
lda IUserID,s
|
|
bne cont2a
|
|
lda TempZero+4 ;Memory Segment Handle
|
|
ldy TempZero+6
|
|
jsr DeRef ;deference
|
|
bcc eloop ;if not NIL, skip this entry
|
|
cont2a phx ;save X
|
|
pei TempZero+6
|
|
pei TempZero+4
|
|
_DisposeHandle ;error is OK
|
|
plx ;restore X
|
|
;
|
|
; set Handle in entry to 0
|
|
;
|
|
stz |MS_Handle,x
|
|
stz |MS_Handle+2,x
|
|
bra cont4
|
|
;
|
|
; Purge Level>0, unlock Memory Block and set its Purge Level
|
|
;
|
|
cont3 phx ;save X
|
|
pei TempZero+6
|
|
pei TempZero+4
|
|
_HUnlock ;error is OK
|
|
|
|
lda PLevel+2,s
|
|
pha
|
|
pei TempZero+6
|
|
pei TempZero+4
|
|
_SetPurge ;error is OK
|
|
plx ;restore X
|
|
;
|
|
; unload all entries in Jump Table for this segment
|
|
;
|
|
cont4 lda |MS_UserID,x ;UserID
|
|
pha
|
|
lda |MS_FileNum,x ;Load File Number
|
|
pha
|
|
lda |MS_SegNum,x ;Load Segment Number
|
|
pha
|
|
phk ;restore DBR
|
|
plb
|
|
jsr Unload_JTL
|
|
;
|
|
; if any inputs = 0, keep looking for segments to unload
|
|
;
|
|
eloop lda Pass2_Needed
|
|
beq return
|
|
jmp loop
|
|
;
|
|
; normal return
|
|
;
|
|
return
|
|
error phk ;restore DBR
|
|
plb
|
|
;
|
|
; if any inputs = 0, error is not really an error
|
|
;
|
|
ldx Pass2_Needed
|
|
beq cont5
|
|
lda #0
|
|
cont5 Stack_Cleanup 10 ;remove input parameters
|
|
rts
|
|
|
|
ENDP
|
|
|
|
TITLE ', SEGMENTS.a - Zero_Segment'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Zero Segment
|
|
*
|
|
* Inputs: A,Y - Address of Segment in Memory
|
|
* Header - Segment Header
|
|
*
|
|
* Outputs: none
|
|
*
|
|
* Zero Page used: TempZero
|
|
*
|
|
****************************************************************
|
|
*
|
|
|
|
Zero_Segment PROC
|
|
with DirectPage, Globals
|
|
|
|
sta TempZero ;address of Segment in memory
|
|
sty TempZero+2
|
|
phy ;Source
|
|
pha
|
|
lda #0
|
|
sta [TempZero] ;zero 1st 2 bytes
|
|
lda TempZero ;offset past first two bytes
|
|
clc
|
|
adc #2
|
|
bcc @1
|
|
iny
|
|
@1
|
|
phy ;Destination
|
|
pha
|
|
ldy Header.Length+2
|
|
lda Header.Length
|
|
sec
|
|
sbc #2
|
|
bcs @2
|
|
dey
|
|
@2
|
|
phy ;Count
|
|
pha
|
|
|
|
jsr Block_Move
|
|
rts
|
|
|
|
ENDP
|
|
|
|
TITLE ', SEGMENTS.a - Check_KIND'
|
|
*
|
|
****************************************************************
|
|
*
|
|
* Check KIND field
|
|
*
|
|
* Inputs: Header - Segment Header
|
|
*
|
|
* Outputs: Header - Segment Header
|
|
*
|
|
* Zero Page used: TempZero
|
|
*
|
|
* This routine checks whether the old KIND field is used in
|
|
* Segment Header and converts it to the new KIND field.
|
|
*
|
|
****************************************************************
|
|
*
|
|
|
|
Check_KIND PROC
|
|
with DirectPage, Globals
|
|
;
|
|
; if Version>1, no conversion needed
|
|
;
|
|
lda Header.Version
|
|
cmp #2
|
|
bcs return
|
|
;
|
|
; move Type to KIND field
|
|
;
|
|
lda Header.oldKind
|
|
pha
|
|
and #$1F
|
|
sta Header.Kind
|
|
;
|
|
; move Attribute bits to KIND field
|
|
;
|
|
lda 1,s
|
|
and #$E0
|
|
sep #$30
|
|
sta Header.Kind+1
|
|
rep #$30
|
|
;
|
|
; if Absolute Bank Segment, set attribute bit and clear Type
|
|
;
|
|
pla
|
|
and #$1F
|
|
cmp #$11
|
|
bne return
|
|
lda Header.Kind
|
|
and #$FFE0
|
|
ora #AbsBank_Segment
|
|
sta Header.Kind
|
|
|
|
return rts
|
|
|
|
ENDP
|
|
|