diff --git a/backup b/backup old mode 100755 new mode 100644 index 2fc77f1..b3e14cf --- a/backup +++ b/backup @@ -1 +1,27 @@ -if "{#}" != "1" echo Form: backup [day] exit 65535 end set dest /library/mike/{1}/linker set list backup count directpage linker.notes linkit make smac set list {list} exp.asm exp.mac set list {list} file.asm file.mac set list {list} linker.asm linker.mac linker.rez set list {list} out.asm out.mac set list {list} pass1.asm pass1.mac set list {list} pass2.asm pass2.mac set list {list} seg.asm seg.mac set list {list} symbol.asm symbol.mac set list {list} exp.asm exp.mac set list {list} util.asm util.mac unset exit create {dest} >.null >&.null for i in {list} newer {dest}/{i} {i} if {Status} != 0 copy -c {i} {dest}/{i} end end \ No newline at end of file +if "{#}" != "1" + echo Form: backup [day] + exit 65535 +end + +set dest /library/mike/{1}/linker + +set list backup count directpage linker.notes linkit make smac +set list {list} exp.asm exp.mac +set list {list} file.asm file.mac +set list {list} linker.asm linker.mac linker.rez +set list {list} out.asm out.mac +set list {list} pass1.asm pass1.mac +set list {list} pass2.asm pass2.mac +set list {list} seg.asm seg.mac +set list {list} symbol.asm symbol.mac +set list {list} exp.asm exp.mac +set list {list} util.asm util.mac + +unset exit +create {dest} >.null >&.null +for i in {list} + newer {dest}/{i} {i} + if {Status} != 0 + copy -c {i} {dest}/{i} + end +end diff --git a/count b/count old mode 100755 new mode 100644 index d0ab591..6ed61a6 --- a/count +++ b/count @@ -1 +1,11 @@ -set list directPage linker.asm set list {list} util.asm set list {list} file.asm set list {list} pass1.asm set list {list} pass2.asm set list {list} seg.asm set list {list} symbol.asm set list {list} exp.asm set list {list} out.asm wc {list} \ No newline at end of file +set list directPage linker.asm +set list {list} util.asm +set list {list} file.asm +set list {list} pass1.asm +set list {list} pass2.asm +set list {list} seg.asm +set list {list} symbol.asm +set list {list} exp.asm +set list {list} out.asm + +wc {list} diff --git a/directpage b/directpage old mode 100755 new mode 100644 index 3b6cebc..bd6f1d4 --- a/directpage +++ b/directpage @@ -1 +1,62 @@ -; ; Global constants ; OBJ gequ $B1 object file LIB gequ $B2 library file EXE gequ $B5 executable file ; ; direct page map ; r0 gequ $0 general purpose registers r1 gequ $1 r2 gequ $2 r3 gequ $3 r4 gequ $4 r5 gequ $5 r6 gequ $6 r7 gequ $7 r8 gequ $8 r9 gequ $9 r10 gequ $A r11 gequ $B r12 gequ $C r13 gequ $D r14 gequ $E r15 gequ $F r16 gequ $10 r17 gequ $11 r18 gequ $12 r19 gequ $13 slist gequ $14 list of input names kname gequ $18 output file name (nil for none) sdisp gequ $1C disp to next char in slist fname gequ $1E ptr to current input file name basename gequ $22 ptr to root file name seg gequ $26 pointer to the first byte in the segment sp gequ $2A pointer to the next byte to process len gequ $2E # bytes left in the current file pc gequ $32 program counter dictionary gequ $36 current library dictionary buffer libSymbols gequ $3A ptr to first library symbol libNames gequ $3E ptr to first library name didLibSegment gequ $42 library segment processed flag libDisp gequ $44 disp in the file being processed libLength gequ $48 length of the library symbol table op gequ $4C output buffer pointer opst gequ $50 op at start of last lConst dp gequ $54 dictionary pointer dictSize gequ $58 remaining size of dictionary dy gequ $5A ptr to next byte in the dynamic segment expStart gequ $5E start of express segment expOffset gequ $62 offset table in express segment expMap gequ $66 segment map in express segment expHeader gequ $6A header table in express segment fMark gequ $6E file mark for express segment ! $52 next available spot \ No newline at end of file +; +; Global constants +; +OBJ gequ $B1 object file +LIB gequ $B2 library file +EXE gequ $B5 executable file +; +; direct page map +; +r0 gequ $0 general purpose registers +r1 gequ $1 +r2 gequ $2 +r3 gequ $3 +r4 gequ $4 +r5 gequ $5 +r6 gequ $6 +r7 gequ $7 +r8 gequ $8 +r9 gequ $9 +r10 gequ $A +r11 gequ $B +r12 gequ $C +r13 gequ $D +r14 gequ $E +r15 gequ $F +r16 gequ $10 +r17 gequ $11 +r18 gequ $12 +r19 gequ $13 + +slist gequ $14 list of input names +kname gequ $18 output file name (nil for none) +sdisp gequ $1C disp to next char in slist +fname gequ $1E ptr to current input file name +basename gequ $22 ptr to root file name + +seg gequ $26 pointer to the first byte in the segment +sp gequ $2A pointer to the next byte to process +len gequ $2E # bytes left in the current file +pc gequ $32 program counter + +dictionary gequ $36 current library dictionary buffer +libSymbols gequ $3A ptr to first library symbol +libNames gequ $3E ptr to first library name +didLibSegment gequ $42 library segment processed flag +libDisp gequ $44 disp in the file being processed +libLength gequ $48 length of the library symbol table + +op gequ $4C output buffer pointer +opst gequ $50 op at start of last lConst +dp gequ $54 dictionary pointer +dictSize gequ $58 remaining size of dictionary + +dy gequ $5A ptr to next byte in the dynamic segment + +expStart gequ $5E start of express segment +expOffset gequ $62 offset table in express segment +expMap gequ $66 segment map in express segment +expHeader gequ $6A header table in express segment +fMark gequ $6E file mark for express segment + +! $52 next available spot diff --git a/exp.asm b/exp.asm old mode 100755 new mode 100644 index 6d25640..a545482 --- a/exp.asm +++ b/exp.asm @@ -1 +1,1661 @@ - keep obj/exp mcopy exp.mac **************************************************************** * * Expression evaluation * * This module handles evaluation of expressions during pass * 2. * **************************************************************** copy directPage **************************************************************** * * ExpCommon - global data for the expression module * **************************************************************** * ; ; Constants ; maxTerm gequ 16 max # of STACKED terms in an expression maxDepth gequ 8 max # of NESTED unresolved labels ExpCommon data ; ; External value returned by CopyExpression ; copiedExpression ds 2 was the expression resolved to a constant? shiftCount ds 4 shift count (# bits to shift) shiftFlag ds 2 is the expression shifted? shiftValue ds 4 expression value before shift symbolCount ds 2 count attribute symbolLength ds 2 length attribute symbolRelocatable ds 2 symbol relocatable flag symbolType ds 2 type attribute symbolValue ds 4 symbol value symbolData ds 2 symbol data area number symbolFlag ds 2 symbol flags symbolFile ds 2 symbol file expSegment ds 2 segment number for the expression ; ; Current expression information ; expValue ds 4 expression value expLength ds 2 expression length end **************************************************************** * * CopyExpression - resolve or copy an expression * * Inputs: * ep - pointer to the first opcode in the expression * * Outputs: * X-A constant value or ptr to a safe copy of the expression * copiedExpression - * 1 -> the value returned is a copy of the expression * 0 -> the value returned is a constant * **************************************************************** * CopyExpression start using ExpCommon val equ 1 value of the expression oep equ 5 original copy of ep length equ 9 length of the expression, in bytes done equ 13 done processing flag sp equ 15 expression stack pointer stack equ 17 expression stack sub (4:ep),16+maxTerm*4 stz copiedExpression assume we can resolve to a constant move4 ep,oep save a copy of the start of the expression stz done not done, yet stz sp nothing on the operand stack lb1 lda [ep] loop over the expression, processing it and #$00FF asl A tax jsr (addr,X) lda done beq lb1 lda #9 if sp <> 4 then ldx sp cpx #4 jne TermError flag an expression syntax error move4 stack,val set the value lda copiedExpression if the expression is not constant then beq lb4 sub2 ep,oep,length get some memory from the symbol table ph2 length jsr GetSymbolMemory sta val stx val+2 sta ep stx ep+2 lda length X = # of words to copy lsr A tax bcc lb2 if there are an odd # of bytes then short M lda [oep] sta [ep] long M inc4 oep inc4 ep tax beq lb4 lb2 ldy #0 lb3 lda [oep],Y sta [ep],Y iny iny dex bne lb3 lb4 ret 4:val return the expression value ; ; Add: ; Add anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands clc do the operation lda stack-4,X adc stack,X sta stack-4,X lda stack-2,X adc stack+2,X sta stack-2,X rts ; ; And: ; And anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-4,X do the operation ora stack-2,X beq and1 lda stack,X ora stack+2,X beq and1 lda #1 result is true bra and2 and1 lda #0 result is false and2 sta stack-4,X lda #0 sta stack-2,X rts ; ; BAnd: ; BAnd anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-4,X do the operation and stack,X sta stack-4,X lda stack-2,X and stack+2,X sta stack-2,X rts ; ; BEor: ; BEor anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-4,X do the operation eor stack,X sta stack-4,X lda stack-2,X eor stack+2,X sta stack-2,X rts ; ; BNot: ; BNot anop inc4 ep update ep jsr Check1 make sure there is at least 1 operand lda stack-4,X do the operation eor #$FFFF sta stack-4,X lda stack-2,X eor #$FFFF sta stack-2,X rts ; ; BOr: ; BOr anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-4,X do the operation ora stack,X sta stack-4,X lda stack-2,X ora stack+2,X sta stack-2,X rts ; ; Check1 - Makes sure there is at least 1 operand. Returns sp in X. ; Check1 anop ldx sp beq check2a rts ; ; Check2 - Makes sure there are at least 2 operands. Removes 1, returns ; new sp in X. ; Check2 anop lda sp cmp #8 bge check21 check2a lda #9 jmp TermError check21 sec sbc #4 sta sp tax rts ; ; CheckStack - check for stack overflows ; CheckStack anop lda #9 ldx sp cpx #maxTerm*4 jeq TermError rts ; ; Div: ; Div anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-2,X do the operation pha lda stack-4,X pha lda stack+2,X pha lda stack,X pha jsl ~Div4 ldx sp pla sta stack-4,X pla sta stack-2,X pla pla rts ; ; Eor: ; Eor anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-4,X do the operation ora stack-2,X bne eor1 lda stack,X ora stack+2,X bne eor2 bra eor3 eor1 lda stack,X ora stack+2,X bne eor3 eor2 lda #1 result is true bra eor4 eor3 lda #0 result is false eor4 sta stack-4,X lda #0 sta stack-2,X rts ; ; EndExp - end of the expression ; EndExp anop inc4 ep inc done rts ; ; EQ: ; EQ anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-4,X do the operation cmp stack,X bne eq1 lda stack-2,X cmp stack+2,X bne eq1 lda #1 result is true bra eq2 eq1 lda #0 result is false eq2 ldx sp sta stack-4,X lda #0 sta stack-2,X rts ; ; Invalid - illegal byte in the expression ; Invalid anop lda #8 jmp TermError ; ; LE: ; LE anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-2,X do the operation pha lda stack-4,X pha lda stack+2,X pha lda stack,X pha jsl SCmp4 ble le1 lda #0 result is false bra le2 le1 lda #1 result is true le2 ldx sp sta stack-4,X lda #0 sta stack-2,X rts ; ; LT: ; LT anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-2,X do the operation pha lda stack-4,X pha lda stack+2,X pha lda stack,X pha jsl SCmp4 blt lt1 lda #0 result is false bra lt2 lt1 lda #1 result is true lt2 ldx sp sta stack-4,X lda #0 sta stack-2,X rts ; ; GE: ; GE anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-2,X do the operation pha lda stack-4,X pha lda stack+2,X pha lda stack,X pha jsl SCmp4 bge ge1 lda #0 result is false bra ge2 ge1 lda #1 result is true ge2 ldx sp sta stack-4,X lda #0 sta stack-2,X rts ; ; GT: ; GT anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-2,X do the operation pha lda stack-4,X pha lda stack+2,X pha lda stack,X pha jsl SCmp4 bgt gt1 lda #0 result is false bra gt2 gt1 lda #1 result is true gt2 ldx sp sta stack-4,X lda #0 sta stack-2,X rts ; ; Mod: ; Mod anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-2,X do the operation pha lda stack-4,X pha lda stack+2,X pha lda stack,X pha jsl ~Div4 pla pla ldx sp pla sta stack-4,X pla sta stack-2,X rts ; ; Mul: ; Mul anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-2,X do the operation pha lda stack-4,X pha lda stack+2,X pha lda stack,X pha jsl ~Mul4 ldx sp pla sta stack-4,X pla sta stack-2,X rts ; ; NE: ; NE anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-4,X do the operation cmp stack,X bne ne1 lda stack-2,X cmp stack+2,X bne ne1 lda #0 result is false bra ne2 ne1 lda #1 result is true ne2 ldx sp sta stack-4,X lda #0 sta stack-2,X rts ; ; Not: ; Not anop inc4 ep update ep jsr Check1 make sure there are at least 2 operands lda stack-4,X do the operation ora stack-2,X bne not1 lda #1 result is true bra not2 not1 lda #0 result is false not2 sta stack-4,X lda #0 sta stack-2,X rts ; ; Or: ; Or anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-4,X do the operation ora stack-2,X bne or1 lda stack,X ora stack+2,X bne or1 lda #0 result is false bra or2 or1 lda #1 result is true or2 sta stack-4,X lda #0 sta stack-2,X rts ; ; PCounter - program counter ; PCounter anop lda #1 copiedExpression = true sta copiedExpression inc4 ep skip the op code jsr CheckStack make sure there is room on the stack add2 sp,#4 reserve space on the operand stack rts ; ; Reference - a reference to a label ; Reference anop lda #1 copiedExpression = true sta copiedExpression jsr CheckStack make sure there is room on the stack add2 sp,#4 reserve space on the operand stack inc4 ep skip the op code lda [ep] skip the name in the segment and #$00FF sec adc ep sta ep bcc rf1 inc ep+2 rf1 rts ; ; SegDisp - disp from the start of the segment ; SegDisp anop lda #1 copiedExpression = true sta copiedExpression jsr CheckStack make sure there is room on the stack add4 ep,#5 skip the op code and operand add2 sp,#4 reserve space on the operand stack rts ; ; Shift: ; Shift anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack+2,X if shift is to the right then bpl shift2 lda stack,X shift to the right tay shift1 lsr stack-2,X ror stack-4,X iny bne shift1 rts return shift2 lda stack,X shift to the left tay beq shift4 shift3 asl stack-4,X rol stack-2,X dey bne shift3 shift4 rts ; ; Sub: ; Sub anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands sec do the operation lda stack-4,X sbc stack,X sta stack-4,X lda stack-2,X sbc stack+2,X sta stack-2,X rts ; ; UMinus: ; UMinus anop inc4 ep update ep jsr Check1 make sure there is at least 1 operand sec do the operation lda #0 sbc stack-4,X sta stack-4,X lda #0 sbc stack-2,X sta stack-2,X rts ; ; Value - constant value ; Value anop jsr CheckStack make sure there is room on the stack ldy #1 place the value on the stack ldx sp lda [ep],Y sta stack,X ldy #3 lda [ep],Y sta stack+2,X add4 ep,#5 skip the op code and operand add2 sp,#4 reserve space on the operand stack rts ; ; Table of expression handling subroutines ; addr dc a'EndExp' $00 End dc a'Add' $01 + dc a'Sub' $02 - dc a'Mul' $03 * dc a'Div' $04 div dc a'Mod' $05 mod dc a'UMinus' $06 unary - dc a'Shift' $07 << or >> dc a'And' $08 and dc a'Or' $09 or dc a'Eor' $0A eor dc a'Not' $0B not dc a'LE' $0C <= dc a'GE' $0D >= dc a'NE' $0E <> dc a'LT' $0F < dc a'GT' $10 > dc a'EQ' $11 = dc a'BAnd' $12 & dc a'BOr' $13 | dc a'BEor' $14 bitwise eor dc a'BNot' $15 bitwise not dc 10a'Invalid' $16..$1F unused dc 16a'Invalid' $20..$2F unused dc 16a'Invalid' $30..$3F unused dc 16a'Invalid' $40..$4F unused dc 16a'Invalid' $50..$5F unused dc 16a'Invalid' $60..$6F unused dc 16a'Invalid' $70..$7F unused dc a'PCounter' $80 program counter dc a'Value' $81 absolute value dc a'Reference' $82 weak label reference dc a'Reference' $83 strong label reference dc a'Reference' $84 length attribute dc a'Reference' $85 type attribute dc a'Reference' $86 count attribute dc a'SegDisp' $87 disp from start of segment dc 8a'Invalid' $88-8F unused dc 16a'Invalid' $90..$9F unused dc 16a'Invalid' $A0..$AF unused dc 16a'Invalid' $B0..$BF unused dc 16a'Invalid' $C0..$CF unused dc 16a'Invalid' $D0..$DF unused dc 16a'Invalid' $E0..$EF unused dc 16a'Invalid' $F0..$FF unused end **************************************************************** * * Evaluate - evaluate an expression * * Inputs: * ep - pointer to the expression * * Outputs: * shiftFlag - 1 if the value is shifted, else 0 * shiftValue - expression result before shifting * shiftCount - shift counter * returns the value of the expression * **************************************************************** * Evaluate start using Common using ExpCommon done equ 1 done processing flag sp equ 3 expression stack pointer stack equ 7 expression stack sub (4:ep),6+maxTerm*5 tsc check for a stack overflow sec sbc #$0100 cmp dpReg bge lb0 lda #9 jmp TermError lb0 stz shiftFlag no shift has occurred stz shiftCount stz shiftCount+2 stz done not done, yet stz sp nothing on the operand stack stz expSegment no segment-dependent variables, yet lb1 lda [ep] loop over the expression, processing it and #$00FF asl A tax jsr (addr,X) lda done beq lb1 lda #9 if sp <> 4 then ldx sp cpx #5 jne TermError flag an expression syntax error lda stack+4 set the relocatable flag and #$00FF sta symbolRelocatable ret 4:stack return the expression value ; ; Add: ; Add anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands clc do the operation lda stack-5,X adc stack,X sta stack-5,X lda stack-3,X adc stack+2,X sta stack-3,X lda stack-1,X if both operands are relative then and stack+4,X and #$00FF beq ad1 ph4 #0 Error(NULL,16) ph2 #16 jsr Error rts ad1 lda stack-1,X if either operand is relative and a ora stack+4,X shift has occurred then and #$00FF beq ad3 lda shiftFlag beq ad2 ph4 #0 Error(NULL,16) ph2 #16 jsr Error rts ad2 lda #1 one operand is relative, so the result sta stack-1,X is also relative ad3 rts ; ; And: ; And anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-5,X do the operation ora stack-3,X beq and1 lda stack,X ora stack+2,X beq and1 lda #1 result is true bra and2 and1 lda #0 result is false and2 sta stack-5,X lda #0 sta stack-3,X jsr NoRelocate2 make sure the operands are not relocatable rts ; ; AttrCount - get the count attribute of a label ; AttrCount anop inc4 ep skip the op code ph4 ep find the symbol value ph2 #0 jsr GetSymbolValue jsr CheckStack make sure there is room on the stack lda symbolCount save the value sta stack,X lda #0 sta stack+2,X short M set the relocation flag lda #0 sta stack+4,X long M add2 sp,#5 reserve space on the operand stack lda [ep] skip the name in the segment and #$00FF sec adc ep sta ep bcc ac1 inc ep+2 ac1 rts ; ; AttrLength - get the length attribute of a label ; AttrLength anop inc4 ep skip the op code ph4 ep find the symbol value ph2 #1 jsr GetSymbolValue jsr CheckStack make sure there is room on the stack lda symbolLength save the value sta stack,X lda #0 sta stack+2,X short M set the relocation flag lda #0 sta stack+4,X long M add2 sp,#5 reserve space on the operand stack lda [ep] skip the name in the segment and #$00FF sec adc ep sta ep bcc al1 inc ep+2 al1 rts ; ; AttrType - get the type attribute of a label ; AttrType anop inc4 ep skip the op code ph4 ep find the symbol value ph2 #1 jsr GetSymbolValue jsr CheckStack make sure there is room on the stack lda symbolType save the value sta stack,X lda #0 sta stack+2,X short M set the relocation flag lda #0 sta stack+4,X long M add2 sp,#5 reserve space on the operand stack lda [ep] skip the name in the segment and #$00FF sec adc ep sta ep bcc at1 inc ep+2 at1 rts ; ; BAnd: ; BAnd anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-5,X do the operation and stack,X sta stack-5,X lda stack-3,X and stack+2,X sta stack-3,X jsr NoRelocate2 make sure the operands are not relocatable rts ; ; BEor: ; BEor anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-5,X do the operation eor stack,X sta stack-5,X lda stack-3,X eor stack+2,X sta stack-3,X jsr NoRelocate2 make sure the operands are not relocatable rts ; ; BNot: ; BNot anop inc4 ep update ep jsr Check1 make sure there is at least 1 operand lda stack-5,X do the operation eor #$FFFF sta stack-5,X lda stack-3,X eor #$FFFF sta stack-3,X jsr NoRelocate1 make sure the operand is not relocatable rts ; ; BOr: ; BOr anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-5,X do the operation ora stack,X sta stack-5,X lda stack-3,X ora stack+2,X sta stack-3,X jsr NoRelocate2 make sure the operands are not relocatable rts ; ; Check1 - Makes sure there is at least 1 operand. Returns sp in X. ; Check1 anop ldx sp beq check2a rts ; ; Check2 - Makes sure there are at least 2 operands. Removes 1, returns ; new sp in X. ; Check2 anop lda sp cmp #10 bge check21 check2a lda #9 jmp TermError check21 sec sbc #5 sta sp tax rts ; ; CheckStack - check for stack overflows ; CheckStack anop lda #9 ldx sp cpx #maxTerm*5 jeq TermError rts ; ; Div: ; Div anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-3,X do the operation pha lda stack-5,X pha lda stack+2,X pha lda stack,X pha jsl ~Div4 ldx sp pla sta stack-5,X pla sta stack-3,X pla pla jsr NoRelocate2 make sure the operands are not relocatable rts ; ; Eor: ; Eor anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-5,X do the operation ora stack-3,X bne eor1 lda stack,X ora stack+2,X bne eor2 bra eor3 eor1 lda stack,X ora stack+2,X bne eor3 eor2 lda #1 result is true bra eor4 eor3 lda #0 result is false eor4 sta stack-5,X lda #0 sta stack-3,X jsr NoRelocate2 make sure the operands are not relocatable rts ; ; EndExp - end of the expression ; EndExp anop inc4 ep inc done rts ; ; EQ: ; EQ anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-5,X do the operation cmp stack,X bne eq1 lda stack-3,X cmp stack+2,X bne eq1 lda #1 result is true bra eq2 eq1 lda #0 result is false eq2 ldx sp sta stack-5,X lda #0 sta stack-3,X jsr NoRelocate2 make sure the operands are not relocatable rts ; ; Invalid - illegal byte in the expression ; Invalid anop lda #8 jmp TermError ; ; LE: ; LE anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-3,X do the operation pha lda stack-5,X pha lda stack+2,X pha lda stack,X pha jsl SCmp4 ble le1 lda #0 result is false bra le2 le1 lda #1 result is true le2 ldx sp sta stack-5,X lda #0 sta stack-3,X jsr NoRelocate2 make sure the operands are not relocatable rts ; ; LT: ; LT anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-3,X do the operation pha lda stack-5,X pha lda stack+2,X pha lda stack,X pha jsl SCmp4 blt lt1 lda #0 result is false bra lt2 lt1 lda #1 result is true lt2 ldx sp sta stack-5,X lda #0 sta stack-3,X jsr NoRelocate2 make sure the operands are not relocatable rts ; ; GE: ; GE anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-3,X do the operation pha lda stack-5,X pha lda stack+2,X pha lda stack,X pha jsl SCmp4 bge ge1 lda #0 result is false bra ge2 ge1 lda #1 result is true ge2 ldx sp sta stack-5,X lda #0 sta stack-3,X jsr NoRelocate2 make sure the operands are not relocatable rts ; ; GT: ; GT anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-3,X do the operation pha lda stack-5,X pha lda stack+2,X pha lda stack,X pha jsl SCmp4 bgt gt1 lda #0 result is false bra gt2 gt1 lda #1 result is true gt2 ldx sp sta stack-5,X lda #0 sta stack-3,X jsr NoRelocate2 make sure the operands are not relocatable rts ; ; Mod: ; Mod anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-3,X do the operation pha lda stack-5,X pha lda stack+2,X pha lda stack,X pha jsl ~Div4 pla pla ldx sp pla sta stack-5,X pla sta stack-3,X jsr NoRelocate2 make sure the operands are not relocatable rts ; ; Mul: ; Mul anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-3,X do the operation pha lda stack-5,X pha lda stack+2,X pha lda stack,X pha jsl ~Mul4 ldx sp pla sta stack-5,X pla sta stack-3,X jsr NoRelocate2 make sure the operands are not relocatable rts ; ; NE: ; NE anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-5,X do the operation cmp stack,X bne ne1 lda stack-3,X cmp stack+2,X bne ne1 lda #0 result is false bra ne2 ne1 lda #1 result is true ne2 ldx sp sta stack-5,X lda #0 sta stack-3,X jsr NoRelocate2 make sure the operands are not relocatable rts ; ; NoRelocate1 - make sure the top operand is not relocatable ; NoRelocate1 anop lda stack-1,X bra nr0 ; ; NoRelocate2 - make sure the top two operands are not relocatable ; NoRelocate2 anop lda stack-1,X ora stack+4,X nr0 and #$00FF beq nr1 ph4 #0 ph2 #16 jsr Error nr1 rts ; ; Not: ; Not anop inc4 ep update ep jsr Check1 make sure there are at least 2 operands lda stack-5,X do the operation ora stack-3,X bne not1 lda #1 result is true bra not2 not1 lda #0 result is false not2 sta stack-5,X lda #0 sta stack-3,X jsr NoRelocate1 make sure the operand is not relocatable rts ; ; Or: ; Or anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda stack-5,X do the operation ora stack-3,X bne or1 lda stack,X ora stack+2,X bne or1 lda #0 result is false bra or2 or1 lda #1 result is true or2 sta stack-5,X lda #0 sta stack-3,X jsr NoRelocate2 make sure the operands are not relocatable rts ; ; PCounter - program counter ; PCounter anop inc4 ep skip the op code ldx dpReg get the program counter lda >pc+2,X pha lda >pc,X pha jsr CheckStack make sure there is room on the stack pla save the program counter sta stack,X pla sta stack+2,X short M value is relocatable lda #1 sta stack+4,X long M add2 sp,#5 reserve space on the operand stack rts ; ; Reference - a reference to a label ; Reference anop inc4 ep skip the op code ph4 ep find the symbol value ph2 #1 jsr GetSymbolValue jsr CheckStack make sure there is room on the stack lda symbolValue save the value sta stack,X lda symbolValue+2 sta stack+2,X short M set the relocation flag lda symbolRelocatable sta stack+4,X long M add2 sp,#5 reserve space on the operand stack lda [ep] skip the name in the segment and #$00FF sec adc ep sta ep bcc rf1 inc ep+2 rf1 rts ; ; SegDisp - disp from the start of the segment ; SegDisp anop jsr CheckStack make sure there is room on the stack clc save the value + startpc lda startpc ldy #1 adc [ep],Y sta stack,X lda startpc+2 iny iny adc [ep],Y sta stack+2,X short M value is relocatable lda #1 sta stack+4,X long M add4 ep,#5 skip the op code and operand add2 sp,#5 reserve space on the operand stack rts ; ; Shift: ; Shift anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands lda shiftFlag a shift can only be done 1 time beq shift0 phx ph4 #0 ph2 #2 jsr Error plx stz shiftFlag shift0 inc shiftFlag lda stack,X save the shift count sta shiftCount lda stack+2,X sta shiftCount+2 bmi sh2 restrict it to a reasonable range bne sh1 lda shiftCount cmp #32 blt sh4 sh1 lla shiftCount,32 bra sh4 sh2 inc A bne sh3 lda shiftCount cmp #-32 bge sh4 sh3 lla shiftCount,-32 sh4 lda stack-5,X save the shifted value sta shiftValue lda stack-3,X sta shiftValue+2 lda stack+2,X if shift is to the right then bpl shift2 lda stack,X shift to the right tay shift1 lsr stack-3,X ror stack-5,X iny bne shift1 rts return shift2 lda stack,X shift to the left tay beq shift4 shift3 asl stack-5,X rol stack-3,X dey bne shift3 shift4 rts ; ; Sub: ; Sub anop inc4 ep update ep jsr Check2 make sure there are at least 2 operands sec do the operation lda stack-5,X sbc stack,X sta stack-5,X lda stack-3,X sbc stack+2,X sta stack-3,X lda stack-1,X if both operands are relative then and stack+4,X and #$00FF beq su1 lda #0 result is a constant sta stack-1,X rts su1 lda stack-1,X if either operand is relative and a ora stack+4,X shift has occurred then and #$00FF beq su3 lda shiftFlag beq su2 ph4 #0 Error(NULL,16) ph2 #16 jsr Error rts su2 lda #1 one operand is relative, so the result sta stack-1,X is also relative su3 rts ; ; UMinus: ; UMinus anop inc4 ep update ep jsr Check1 make sure there is at least 1 operand sec do the operation lda #0 sbc stack-5,X sta stack-5,X lda #0 sbc stack-3,X sta stack-3,X jsr NoRelocate1 make sure the operand is not relocatable rts ; ; Value - constant value ; Value anop jsr CheckStack make sure there is room on the stack ldy #1 place the value on the stack ldx sp lda [ep],Y sta stack,X ldy #3 lda [ep],Y sta stack+2,X short M value is not relocatable lda #0 sta stack+4,X long M add4 ep,#5 skip the op code and operand add2 sp,#5 reserve space on the operand stack rts ; ; Weak - weak reference to a label ; Weak anop inc4 ep skip the op code ph4 ep find the symbol value ph2 #0 jsr GetSymbolValue jsr CheckStack make sure there is room on the stack lda symbolValue save the value sta stack,X lda symbolValue+2 sta stack+2,X short M set the relocation flag lda symbolRelocatable sta stack+4,X long M add2 sp,#5 reserve space on the operand stack lda [ep] skip the name in the segment and #$00FF sec adc ep sta ep bcc wk1 inc ep+2 wk1 rts ; ; Table of expression handling subroutines ; addr dc a'EndExp' $00 End dc a'Add' $01 + dc a'Sub' $02 - dc a'Mul' $03 * dc a'Div' $04 div dc a'Mod' $05 mod dc a'UMinus' $06 unary - dc a'Shift' $07 << or >> dc a'And' $08 and dc a'Or' $09 or dc a'Eor' $0A eor dc a'Not' $0B not dc a'LE' $0C <= dc a'GE' $0D >= dc a'NE' $0E <> dc a'LT' $0F < dc a'GT' $10 > dc a'EQ' $11 = dc a'BAnd' $12 & dc a'BOr' $13 | dc a'BEor' $14 bitwise eor dc a'BNot' $15 bitwise not dc 10a'Invalid' $16..$1F unused dc 16a'Invalid' $20..$2F unused dc 16a'Invalid' $30..$3F unused dc 16a'Invalid' $40..$4F unused dc 16a'Invalid' $50..$5F unused dc 16a'Invalid' $60..$6F unused dc 16a'Invalid' $70..$7F unused dc a'PCounter' $80 program counter dc a'Value' $81 absolute value dc a'Weak' $82 weak label reference dc a'Reference' $83 strong label reference dc a'AttrLength' $84 length attribute dc a'AttrType' $85 type attribute dc a'AttrCount' $86 count attribute dc a'SegDisp' $87 disp from start of segment dc 8a'Invalid' $88-8F unused dc 16a'Invalid' $90..$9F unused dc 16a'Invalid' $A0..$AF unused dc 16a'Invalid' $B0..$BF unused dc 16a'Invalid' $C0..$CF unused dc 16a'Invalid' $D0..$DF unused dc 16a'Invalid' $E0..$EF unused dc 16a'Invalid' $F0..$FF unused ret end **************************************************************** * * SCmp4 - Four byte signed integer compare * * Inputs: * 7,S - first argument * 3,S - second argument * * Outputs: * C - set if 7,S >= 3,S, else clear * Z - set if 7,S = 3,S, else clear * **************************************************************** * SCmp4 private lda 9,S branch if both numbers have the same eor 5,S sign bpl cp1 lda 5,S do a comparison of oppositely signed cmp 9,S numbers rts cp1 lda 9,S do a comparison of numbers with the cmp 5,S same sign bne cp2 lda 7,S cmp 3,S cp2 rts end \ No newline at end of file + keep obj/exp + mcopy exp.mac +**************************************************************** +* +* Expression evaluation +* +* This module handles evaluation of expressions during pass +* 2. +* +**************************************************************** + copy directPage +**************************************************************** +* +* ExpCommon - global data for the expression module +* +**************************************************************** +* +; +; Constants +; +maxTerm gequ 16 max # of STACKED terms in an expression +maxDepth gequ 8 max # of NESTED unresolved labels + +ExpCommon data +; +; External value returned by CopyExpression +; +copiedExpression ds 2 was the expression resolved to a constant? +shiftCount ds 4 shift count (# bits to shift) +shiftFlag ds 2 is the expression shifted? +shiftValue ds 4 expression value before shift +symbolCount ds 2 count attribute +symbolLength ds 2 length attribute +symbolRelocatable ds 2 symbol relocatable flag +symbolType ds 2 type attribute +symbolValue ds 4 symbol value +symbolData ds 2 symbol data area number +symbolFlag ds 2 symbol flags +symbolFile ds 2 symbol file +expSegment ds 2 segment number for the expression +; +; Current expression information +; +expValue ds 4 expression value +expLength ds 2 expression length + end + +**************************************************************** +* +* CopyExpression - resolve or copy an expression +* +* Inputs: +* ep - pointer to the first opcode in the expression +* +* Outputs: +* X-A constant value or ptr to a safe copy of the expression +* copiedExpression - +* 1 -> the value returned is a copy of the expression +* 0 -> the value returned is a constant +* +**************************************************************** +* +CopyExpression start + using ExpCommon +val equ 1 value of the expression +oep equ 5 original copy of ep +length equ 9 length of the expression, in bytes +done equ 13 done processing flag +sp equ 15 expression stack pointer +stack equ 17 expression stack + + sub (4:ep),16+maxTerm*4 + + stz copiedExpression assume we can resolve to a constant + move4 ep,oep save a copy of the start of the expression + stz done not done, yet + stz sp nothing on the operand stack + +lb1 lda [ep] loop over the expression, processing it + and #$00FF + asl A + tax + jsr (addr,X) + lda done + beq lb1 + + lda #9 if sp <> 4 then + ldx sp + cpx #4 + jne TermError flag an expression syntax error + move4 stack,val set the value + lda copiedExpression if the expression is not constant then + beq lb4 + sub2 ep,oep,length get some memory from the symbol table + ph2 length + jsr GetSymbolMemory + sta val + stx val+2 + sta ep + stx ep+2 + lda length X = # of words to copy + lsr A + tax + bcc lb2 if there are an odd # of bytes then + short M + lda [oep] + sta [ep] + long M + inc4 oep + inc4 ep + tax + beq lb4 +lb2 ldy #0 +lb3 lda [oep],Y + sta [ep],Y + iny + iny + dex + bne lb3 + +lb4 ret 4:val return the expression value +; +; Add: +; +Add anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + clc do the operation + lda stack-4,X + adc stack,X + sta stack-4,X + lda stack-2,X + adc stack+2,X + sta stack-2,X + rts +; +; And: +; +And anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-4,X do the operation + ora stack-2,X + beq and1 + lda stack,X + ora stack+2,X + beq and1 + + lda #1 result is true + bra and2 + +and1 lda #0 result is false +and2 sta stack-4,X + lda #0 + sta stack-2,X + rts +; +; BAnd: +; +BAnd anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-4,X do the operation + and stack,X + sta stack-4,X + lda stack-2,X + and stack+2,X + sta stack-2,X + rts +; +; BEor: +; +BEor anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-4,X do the operation + eor stack,X + sta stack-4,X + lda stack-2,X + eor stack+2,X + sta stack-2,X + rts +; +; BNot: +; +BNot anop + + inc4 ep update ep + jsr Check1 make sure there is at least 1 operand + lda stack-4,X do the operation + eor #$FFFF + sta stack-4,X + lda stack-2,X + eor #$FFFF + sta stack-2,X + rts +; +; BOr: +; +BOr anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-4,X do the operation + ora stack,X + sta stack-4,X + lda stack-2,X + ora stack+2,X + sta stack-2,X + rts +; +; Check1 - Makes sure there is at least 1 operand. Returns sp in X. +; +Check1 anop + + ldx sp + beq check2a + rts +; +; Check2 - Makes sure there are at least 2 operands. Removes 1, returns +; new sp in X. +; +Check2 anop + + lda sp + cmp #8 + bge check21 +check2a lda #9 + jmp TermError + +check21 sec + sbc #4 + sta sp + tax + rts +; +; CheckStack - check for stack overflows +; +CheckStack anop + + lda #9 + ldx sp + cpx #maxTerm*4 + jeq TermError + rts +; +; Div: +; +Div anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-2,X do the operation + pha + lda stack-4,X + pha + lda stack+2,X + pha + lda stack,X + pha + jsl ~Div4 + ldx sp + pla + sta stack-4,X + pla + sta stack-2,X + pla + pla + rts +; +; Eor: +; +Eor anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-4,X do the operation + ora stack-2,X + bne eor1 + lda stack,X + ora stack+2,X + bne eor2 + bra eor3 + +eor1 lda stack,X + ora stack+2,X + bne eor3 + +eor2 lda #1 result is true + bra eor4 + +eor3 lda #0 result is false +eor4 sta stack-4,X + lda #0 + sta stack-2,X + rts +; +; EndExp - end of the expression +; +EndExp anop + + inc4 ep + inc done + rts +; +; EQ: +; +EQ anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-4,X do the operation + cmp stack,X + bne eq1 + lda stack-2,X + cmp stack+2,X + bne eq1 + + lda #1 result is true + bra eq2 + +eq1 lda #0 result is false +eq2 ldx sp + sta stack-4,X + lda #0 + sta stack-2,X + rts +; +; Invalid - illegal byte in the expression +; +Invalid anop + + lda #8 + jmp TermError +; +; LE: +; +LE anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-2,X do the operation + pha + lda stack-4,X + pha + lda stack+2,X + pha + lda stack,X + pha + jsl SCmp4 + ble le1 + + lda #0 result is false + bra le2 + +le1 lda #1 result is true +le2 ldx sp + sta stack-4,X + lda #0 + sta stack-2,X + rts +; +; LT: +; +LT anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-2,X do the operation + pha + lda stack-4,X + pha + lda stack+2,X + pha + lda stack,X + pha + jsl SCmp4 + blt lt1 + + lda #0 result is false + bra lt2 + +lt1 lda #1 result is true +lt2 ldx sp + sta stack-4,X + lda #0 + sta stack-2,X + rts +; +; GE: +; +GE anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-2,X do the operation + pha + lda stack-4,X + pha + lda stack+2,X + pha + lda stack,X + pha + jsl SCmp4 + bge ge1 + + lda #0 result is false + bra ge2 + +ge1 lda #1 result is true +ge2 ldx sp + sta stack-4,X + lda #0 + sta stack-2,X + rts +; +; GT: +; +GT anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-2,X do the operation + pha + lda stack-4,X + pha + lda stack+2,X + pha + lda stack,X + pha + jsl SCmp4 + bgt gt1 + + lda #0 result is false + bra gt2 + +gt1 lda #1 result is true +gt2 ldx sp + sta stack-4,X + lda #0 + sta stack-2,X + rts +; +; Mod: +; +Mod anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-2,X do the operation + pha + lda stack-4,X + pha + lda stack+2,X + pha + lda stack,X + pha + jsl ~Div4 + pla + pla + ldx sp + pla + sta stack-4,X + pla + sta stack-2,X + rts +; +; Mul: +; +Mul anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-2,X do the operation + pha + lda stack-4,X + pha + lda stack+2,X + pha + lda stack,X + pha + jsl ~Mul4 + ldx sp + pla + sta stack-4,X + pla + sta stack-2,X + rts +; +; NE: +; +NE anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-4,X do the operation + cmp stack,X + bne ne1 + lda stack-2,X + cmp stack+2,X + bne ne1 + + lda #0 result is false + bra ne2 + +ne1 lda #1 result is true +ne2 ldx sp + sta stack-4,X + lda #0 + sta stack-2,X + rts +; +; Not: +; +Not anop + + inc4 ep update ep + jsr Check1 make sure there are at least 2 operands + lda stack-4,X do the operation + ora stack-2,X + bne not1 + + lda #1 result is true + bra not2 + +not1 lda #0 result is false +not2 sta stack-4,X + lda #0 + sta stack-2,X + rts +; +; Or: +; +Or anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-4,X do the operation + ora stack-2,X + bne or1 + lda stack,X + ora stack+2,X + bne or1 + + lda #0 result is false + bra or2 + +or1 lda #1 result is true +or2 sta stack-4,X + lda #0 + sta stack-2,X + rts +; +; PCounter - program counter +; +PCounter anop + + lda #1 copiedExpression = true + sta copiedExpression + inc4 ep skip the op code + jsr CheckStack make sure there is room on the stack + add2 sp,#4 reserve space on the operand stack + rts +; +; Reference - a reference to a label +; +Reference anop + + lda #1 copiedExpression = true + sta copiedExpression + jsr CheckStack make sure there is room on the stack + add2 sp,#4 reserve space on the operand stack + inc4 ep skip the op code + lda [ep] skip the name in the segment + and #$00FF + sec + adc ep + sta ep + bcc rf1 + inc ep+2 +rf1 rts +; +; SegDisp - disp from the start of the segment +; +SegDisp anop + + lda #1 copiedExpression = true + sta copiedExpression + jsr CheckStack make sure there is room on the stack + add4 ep,#5 skip the op code and operand + add2 sp,#4 reserve space on the operand stack + rts +; +; Shift: +; +Shift anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + + lda stack+2,X if shift is to the right then + bpl shift2 + lda stack,X shift to the right + tay +shift1 lsr stack-2,X + ror stack-4,X + iny + bne shift1 + rts return + +shift2 lda stack,X shift to the left + tay + beq shift4 +shift3 asl stack-4,X + rol stack-2,X + dey + bne shift3 +shift4 rts +; +; Sub: +; +Sub anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + sec do the operation + lda stack-4,X + sbc stack,X + sta stack-4,X + lda stack-2,X + sbc stack+2,X + sta stack-2,X + rts +; +; UMinus: +; +UMinus anop + + inc4 ep update ep + jsr Check1 make sure there is at least 1 operand + sec do the operation + lda #0 + sbc stack-4,X + sta stack-4,X + lda #0 + sbc stack-2,X + sta stack-2,X + rts +; +; Value - constant value +; +Value anop + + jsr CheckStack make sure there is room on the stack + ldy #1 place the value on the stack + ldx sp + lda [ep],Y + sta stack,X + ldy #3 + lda [ep],Y + sta stack+2,X + add4 ep,#5 skip the op code and operand + add2 sp,#4 reserve space on the operand stack + rts +; +; Table of expression handling subroutines +; +addr dc a'EndExp' $00 End + dc a'Add' $01 + + dc a'Sub' $02 - + dc a'Mul' $03 * + dc a'Div' $04 div + dc a'Mod' $05 mod + dc a'UMinus' $06 unary - + dc a'Shift' $07 << or >> + dc a'And' $08 and + dc a'Or' $09 or + dc a'Eor' $0A eor + dc a'Not' $0B not + dc a'LE' $0C <= + dc a'GE' $0D >= + dc a'NE' $0E <> + dc a'LT' $0F < + dc a'GT' $10 > + dc a'EQ' $11 = + dc a'BAnd' $12 & + dc a'BOr' $13 | + dc a'BEor' $14 bitwise eor + dc a'BNot' $15 bitwise not + dc 10a'Invalid' $16..$1F unused + dc 16a'Invalid' $20..$2F unused + dc 16a'Invalid' $30..$3F unused + dc 16a'Invalid' $40..$4F unused + dc 16a'Invalid' $50..$5F unused + dc 16a'Invalid' $60..$6F unused + dc 16a'Invalid' $70..$7F unused + dc a'PCounter' $80 program counter + dc a'Value' $81 absolute value + dc a'Reference' $82 weak label reference + dc a'Reference' $83 strong label reference + dc a'Reference' $84 length attribute + dc a'Reference' $85 type attribute + dc a'Reference' $86 count attribute + dc a'SegDisp' $87 disp from start of segment + dc 8a'Invalid' $88-8F unused + dc 16a'Invalid' $90..$9F unused + dc 16a'Invalid' $A0..$AF unused + dc 16a'Invalid' $B0..$BF unused + dc 16a'Invalid' $C0..$CF unused + dc 16a'Invalid' $D0..$DF unused + dc 16a'Invalid' $E0..$EF unused + dc 16a'Invalid' $F0..$FF unused + end + +**************************************************************** +* +* Evaluate - evaluate an expression +* +* Inputs: +* ep - pointer to the expression +* +* Outputs: +* shiftFlag - 1 if the value is shifted, else 0 +* shiftValue - expression result before shifting +* shiftCount - shift counter +* returns the value of the expression +* +**************************************************************** +* +Evaluate start + using Common + using ExpCommon +done equ 1 done processing flag +sp equ 3 expression stack pointer +stack equ 7 expression stack + + sub (4:ep),6+maxTerm*5 + + tsc check for a stack overflow + sec + sbc #$0100 + cmp dpReg + bge lb0 + lda #9 + jmp TermError + +lb0 stz shiftFlag no shift has occurred + stz shiftCount + stz shiftCount+2 + stz done not done, yet + stz sp nothing on the operand stack + stz expSegment no segment-dependent variables, yet + +lb1 lda [ep] loop over the expression, processing it + and #$00FF + asl A + tax + jsr (addr,X) + lda done + beq lb1 + + lda #9 if sp <> 4 then + ldx sp + cpx #5 + jne TermError flag an expression syntax error + lda stack+4 set the relocatable flag + and #$00FF + sta symbolRelocatable + + ret 4:stack return the expression value +; +; Add: +; +Add anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + clc do the operation + lda stack-5,X + adc stack,X + sta stack-5,X + lda stack-3,X + adc stack+2,X + sta stack-3,X + + lda stack-1,X if both operands are relative then + and stack+4,X + and #$00FF + beq ad1 + ph4 #0 Error(NULL,16) + ph2 #16 + jsr Error + rts + +ad1 lda stack-1,X if either operand is relative and a + ora stack+4,X shift has occurred then + and #$00FF + beq ad3 + lda shiftFlag + beq ad2 + ph4 #0 Error(NULL,16) + ph2 #16 + jsr Error + rts + +ad2 lda #1 one operand is relative, so the result + sta stack-1,X is also relative +ad3 rts +; +; And: +; +And anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-5,X do the operation + ora stack-3,X + beq and1 + lda stack,X + ora stack+2,X + beq and1 + + lda #1 result is true + bra and2 + +and1 lda #0 result is false +and2 sta stack-5,X + lda #0 + sta stack-3,X + jsr NoRelocate2 make sure the operands are not relocatable + rts +; +; AttrCount - get the count attribute of a label +; +AttrCount anop + + inc4 ep skip the op code + ph4 ep find the symbol value + ph2 #0 + jsr GetSymbolValue + jsr CheckStack make sure there is room on the stack + lda symbolCount save the value + sta stack,X + lda #0 + sta stack+2,X + short M set the relocation flag + lda #0 + sta stack+4,X + long M + add2 sp,#5 reserve space on the operand stack + lda [ep] skip the name in the segment + and #$00FF + sec + adc ep + sta ep + bcc ac1 + inc ep+2 +ac1 rts +; +; AttrLength - get the length attribute of a label +; +AttrLength anop + + inc4 ep skip the op code + ph4 ep find the symbol value + ph2 #1 + jsr GetSymbolValue + jsr CheckStack make sure there is room on the stack + lda symbolLength save the value + sta stack,X + lda #0 + sta stack+2,X + short M set the relocation flag + lda #0 + sta stack+4,X + long M + add2 sp,#5 reserve space on the operand stack + lda [ep] skip the name in the segment + and #$00FF + sec + adc ep + sta ep + bcc al1 + inc ep+2 +al1 rts +; +; AttrType - get the type attribute of a label +; +AttrType anop + + inc4 ep skip the op code + ph4 ep find the symbol value + ph2 #1 + jsr GetSymbolValue + jsr CheckStack make sure there is room on the stack + lda symbolType save the value + sta stack,X + lda #0 + sta stack+2,X + short M set the relocation flag + lda #0 + sta stack+4,X + long M + add2 sp,#5 reserve space on the operand stack + lda [ep] skip the name in the segment + and #$00FF + sec + adc ep + sta ep + bcc at1 + inc ep+2 +at1 rts +; +; BAnd: +; +BAnd anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-5,X do the operation + and stack,X + sta stack-5,X + lda stack-3,X + and stack+2,X + sta stack-3,X + jsr NoRelocate2 make sure the operands are not relocatable + rts +; +; BEor: +; +BEor anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-5,X do the operation + eor stack,X + sta stack-5,X + lda stack-3,X + eor stack+2,X + sta stack-3,X + jsr NoRelocate2 make sure the operands are not relocatable + rts +; +; BNot: +; +BNot anop + + inc4 ep update ep + jsr Check1 make sure there is at least 1 operand + lda stack-5,X do the operation + eor #$FFFF + sta stack-5,X + lda stack-3,X + eor #$FFFF + sta stack-3,X + jsr NoRelocate1 make sure the operand is not relocatable + rts +; +; BOr: +; +BOr anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-5,X do the operation + ora stack,X + sta stack-5,X + lda stack-3,X + ora stack+2,X + sta stack-3,X + jsr NoRelocate2 make sure the operands are not relocatable + rts +; +; Check1 - Makes sure there is at least 1 operand. Returns sp in X. +; +Check1 anop + + ldx sp + beq check2a + rts +; +; Check2 - Makes sure there are at least 2 operands. Removes 1, returns +; new sp in X. +; +Check2 anop + + lda sp + cmp #10 + bge check21 +check2a lda #9 + jmp TermError + +check21 sec + sbc #5 + sta sp + tax + rts +; +; CheckStack - check for stack overflows +; +CheckStack anop + + lda #9 + ldx sp + cpx #maxTerm*5 + jeq TermError + rts +; +; Div: +; +Div anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-3,X do the operation + pha + lda stack-5,X + pha + lda stack+2,X + pha + lda stack,X + pha + jsl ~Div4 + ldx sp + pla + sta stack-5,X + pla + sta stack-3,X + pla + pla + jsr NoRelocate2 make sure the operands are not relocatable + rts +; +; Eor: +; +Eor anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-5,X do the operation + ora stack-3,X + bne eor1 + lda stack,X + ora stack+2,X + bne eor2 + bra eor3 + +eor1 lda stack,X + ora stack+2,X + bne eor3 + +eor2 lda #1 result is true + bra eor4 + +eor3 lda #0 result is false +eor4 sta stack-5,X + lda #0 + sta stack-3,X + jsr NoRelocate2 make sure the operands are not relocatable + rts +; +; EndExp - end of the expression +; +EndExp anop + + inc4 ep + inc done + rts +; +; EQ: +; +EQ anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-5,X do the operation + cmp stack,X + bne eq1 + lda stack-3,X + cmp stack+2,X + bne eq1 + + lda #1 result is true + bra eq2 + +eq1 lda #0 result is false +eq2 ldx sp + sta stack-5,X + lda #0 + sta stack-3,X + jsr NoRelocate2 make sure the operands are not relocatable + rts +; +; Invalid - illegal byte in the expression +; +Invalid anop + lda #8 + jmp TermError +; +; LE: +; +LE anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-3,X do the operation + pha + lda stack-5,X + pha + lda stack+2,X + pha + lda stack,X + pha + jsl SCmp4 + ble le1 + + lda #0 result is false + bra le2 + +le1 lda #1 result is true +le2 ldx sp + sta stack-5,X + lda #0 + sta stack-3,X + jsr NoRelocate2 make sure the operands are not relocatable + rts +; +; LT: +; +LT anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-3,X do the operation + pha + lda stack-5,X + pha + lda stack+2,X + pha + lda stack,X + pha + jsl SCmp4 + blt lt1 + + lda #0 result is false + bra lt2 + +lt1 lda #1 result is true +lt2 ldx sp + sta stack-5,X + lda #0 + sta stack-3,X + jsr NoRelocate2 make sure the operands are not relocatable + rts +; +; GE: +; +GE anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-3,X do the operation + pha + lda stack-5,X + pha + lda stack+2,X + pha + lda stack,X + pha + jsl SCmp4 + bge ge1 + + lda #0 result is false + bra ge2 + +ge1 lda #1 result is true +ge2 ldx sp + sta stack-5,X + lda #0 + sta stack-3,X + jsr NoRelocate2 make sure the operands are not relocatable + rts +; +; GT: +; +GT anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-3,X do the operation + pha + lda stack-5,X + pha + lda stack+2,X + pha + lda stack,X + pha + jsl SCmp4 + bgt gt1 + + lda #0 result is false + bra gt2 + +gt1 lda #1 result is true +gt2 ldx sp + sta stack-5,X + lda #0 + sta stack-3,X + jsr NoRelocate2 make sure the operands are not relocatable + rts +; +; Mod: +; +Mod anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-3,X do the operation + pha + lda stack-5,X + pha + lda stack+2,X + pha + lda stack,X + pha + jsl ~Div4 + pla + pla + ldx sp + pla + sta stack-5,X + pla + sta stack-3,X + jsr NoRelocate2 make sure the operands are not relocatable + rts +; +; Mul: +; +Mul anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-3,X do the operation + pha + lda stack-5,X + pha + lda stack+2,X + pha + lda stack,X + pha + jsl ~Mul4 + ldx sp + pla + sta stack-5,X + pla + sta stack-3,X + jsr NoRelocate2 make sure the operands are not relocatable + rts +; +; NE: +; +NE anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-5,X do the operation + cmp stack,X + bne ne1 + lda stack-3,X + cmp stack+2,X + bne ne1 + + lda #0 result is false + bra ne2 + +ne1 lda #1 result is true +ne2 ldx sp + sta stack-5,X + lda #0 + sta stack-3,X + jsr NoRelocate2 make sure the operands are not relocatable + rts +; +; NoRelocate1 - make sure the top operand is not relocatable +; +NoRelocate1 anop + + lda stack-1,X + bra nr0 +; +; NoRelocate2 - make sure the top two operands are not relocatable +; +NoRelocate2 anop + + lda stack-1,X + ora stack+4,X +nr0 and #$00FF + beq nr1 + ph4 #0 + ph2 #16 + jsr Error +nr1 rts +; +; Not: +; +Not anop + + inc4 ep update ep + jsr Check1 make sure there are at least 2 operands + lda stack-5,X do the operation + ora stack-3,X + bne not1 + + lda #1 result is true + bra not2 + +not1 lda #0 result is false +not2 sta stack-5,X + lda #0 + sta stack-3,X + jsr NoRelocate1 make sure the operand is not relocatable + rts +; +; Or: +; +Or anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + lda stack-5,X do the operation + ora stack-3,X + bne or1 + lda stack,X + ora stack+2,X + bne or1 + + lda #0 result is false + bra or2 + +or1 lda #1 result is true +or2 sta stack-5,X + lda #0 + sta stack-3,X + jsr NoRelocate2 make sure the operands are not relocatable + rts +; +; PCounter - program counter +; +PCounter anop + + inc4 ep skip the op code + ldx dpReg get the program counter + lda >pc+2,X + pha + lda >pc,X + pha + jsr CheckStack make sure there is room on the stack + pla save the program counter + sta stack,X + pla + sta stack+2,X + short M value is relocatable + lda #1 + sta stack+4,X + long M + add2 sp,#5 reserve space on the operand stack + rts +; +; Reference - a reference to a label +; +Reference anop + + inc4 ep skip the op code + ph4 ep find the symbol value + ph2 #1 + jsr GetSymbolValue + jsr CheckStack make sure there is room on the stack + lda symbolValue save the value + sta stack,X + lda symbolValue+2 + sta stack+2,X + short M set the relocation flag + lda symbolRelocatable + sta stack+4,X + long M + add2 sp,#5 reserve space on the operand stack + lda [ep] skip the name in the segment + and #$00FF + sec + adc ep + sta ep + bcc rf1 + inc ep+2 +rf1 rts +; +; SegDisp - disp from the start of the segment +; +SegDisp anop + + jsr CheckStack make sure there is room on the stack + clc save the value + startpc + lda startpc + ldy #1 + adc [ep],Y + sta stack,X + lda startpc+2 + iny + iny + adc [ep],Y + sta stack+2,X + short M value is relocatable + lda #1 + sta stack+4,X + long M + add4 ep,#5 skip the op code and operand + add2 sp,#5 reserve space on the operand stack + rts +; +; Shift: +; +Shift anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + + lda shiftFlag a shift can only be done 1 time + beq shift0 + phx + ph4 #0 + ph2 #2 + jsr Error + plx + stz shiftFlag +shift0 inc shiftFlag + + lda stack,X save the shift count + sta shiftCount + lda stack+2,X + sta shiftCount+2 + bmi sh2 restrict it to a reasonable range + bne sh1 + lda shiftCount + cmp #32 + blt sh4 +sh1 lla shiftCount,32 + bra sh4 +sh2 inc A + bne sh3 + lda shiftCount + cmp #-32 + bge sh4 +sh3 lla shiftCount,-32 + +sh4 lda stack-5,X save the shifted value + sta shiftValue + lda stack-3,X + sta shiftValue+2 + + lda stack+2,X if shift is to the right then + bpl shift2 + lda stack,X shift to the right + tay +shift1 lsr stack-3,X + ror stack-5,X + iny + bne shift1 + rts return + +shift2 lda stack,X shift to the left + tay + beq shift4 +shift3 asl stack-5,X + rol stack-3,X + dey + bne shift3 +shift4 rts +; +; Sub: +; +Sub anop + + inc4 ep update ep + jsr Check2 make sure there are at least 2 operands + sec do the operation + lda stack-5,X + sbc stack,X + sta stack-5,X + lda stack-3,X + sbc stack+2,X + sta stack-3,X + + lda stack-1,X if both operands are relative then + and stack+4,X + and #$00FF + beq su1 + lda #0 result is a constant + sta stack-1,X + rts + +su1 lda stack-1,X if either operand is relative and a + ora stack+4,X shift has occurred then + and #$00FF + beq su3 + lda shiftFlag + beq su2 + ph4 #0 Error(NULL,16) + ph2 #16 + jsr Error + rts + +su2 lda #1 one operand is relative, so the result + sta stack-1,X is also relative +su3 rts +; +; UMinus: +; +UMinus anop + + inc4 ep update ep + jsr Check1 make sure there is at least 1 operand + sec do the operation + lda #0 + sbc stack-5,X + sta stack-5,X + lda #0 + sbc stack-3,X + sta stack-3,X + jsr NoRelocate1 make sure the operand is not relocatable + rts +; +; Value - constant value +; +Value anop + + jsr CheckStack make sure there is room on the stack + ldy #1 place the value on the stack + ldx sp + lda [ep],Y + sta stack,X + ldy #3 + lda [ep],Y + sta stack+2,X + short M value is not relocatable + lda #0 + sta stack+4,X + long M + add4 ep,#5 skip the op code and operand + add2 sp,#5 reserve space on the operand stack + rts +; +; Weak - weak reference to a label +; +Weak anop + + inc4 ep skip the op code + ph4 ep find the symbol value + ph2 #0 + jsr GetSymbolValue + jsr CheckStack make sure there is room on the stack + lda symbolValue save the value + sta stack,X + lda symbolValue+2 + sta stack+2,X + short M set the relocation flag + lda symbolRelocatable + sta stack+4,X + long M + add2 sp,#5 reserve space on the operand stack + lda [ep] skip the name in the segment + and #$00FF + sec + adc ep + sta ep + bcc wk1 + inc ep+2 +wk1 rts +; +; Table of expression handling subroutines +; +addr dc a'EndExp' $00 End + dc a'Add' $01 + + dc a'Sub' $02 - + dc a'Mul' $03 * + dc a'Div' $04 div + dc a'Mod' $05 mod + dc a'UMinus' $06 unary - + dc a'Shift' $07 << or >> + dc a'And' $08 and + dc a'Or' $09 or + dc a'Eor' $0A eor + dc a'Not' $0B not + dc a'LE' $0C <= + dc a'GE' $0D >= + dc a'NE' $0E <> + dc a'LT' $0F < + dc a'GT' $10 > + dc a'EQ' $11 = + dc a'BAnd' $12 & + dc a'BOr' $13 | + dc a'BEor' $14 bitwise eor + dc a'BNot' $15 bitwise not + dc 10a'Invalid' $16..$1F unused + dc 16a'Invalid' $20..$2F unused + dc 16a'Invalid' $30..$3F unused + dc 16a'Invalid' $40..$4F unused + dc 16a'Invalid' $50..$5F unused + dc 16a'Invalid' $60..$6F unused + dc 16a'Invalid' $70..$7F unused + dc a'PCounter' $80 program counter + dc a'Value' $81 absolute value + dc a'Weak' $82 weak label reference + dc a'Reference' $83 strong label reference + dc a'AttrLength' $84 length attribute + dc a'AttrType' $85 type attribute + dc a'AttrCount' $86 count attribute + dc a'SegDisp' $87 disp from start of segment + dc 8a'Invalid' $88-8F unused + dc 16a'Invalid' $90..$9F unused + dc 16a'Invalid' $A0..$AF unused + dc 16a'Invalid' $B0..$BF unused + dc 16a'Invalid' $C0..$CF unused + dc 16a'Invalid' $D0..$DF unused + dc 16a'Invalid' $E0..$EF unused + dc 16a'Invalid' $F0..$FF unused + ret + end + +**************************************************************** +* +* SCmp4 - Four byte signed integer compare +* +* Inputs: +* 7,S - first argument +* 3,S - second argument +* +* Outputs: +* C - set if 7,S >= 3,S, else clear +* Z - set if 7,S = 3,S, else clear +* +**************************************************************** +* +SCmp4 private + + lda 9,S branch if both numbers have the same + eor 5,S sign + bpl cp1 + lda 5,S do a comparison of oppositely signed + cmp 9,S numbers + rts + +cp1 lda 9,S do a comparison of numbers with the + cmp 5,S same sign + bne cp2 + lda 7,S + cmp 3,S +cp2 rts + end diff --git a/exp.mac b/exp.mac old mode 100755 new mode 100644 index 6e730ed..88f29ee --- a/exp.mac +++ b/exp.mac @@ -1 +1,507 @@ - MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND macro &lab sub &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta c:&parms .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+3+&work &totallen seta &totallen+&len &i seta &i-1 aif &i,^b .e tsc aif &work=0,.f sec sbc #&work tcs .f phd tcd mend macro &lab ret &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g ldy #&r ldx #^&r ago .h .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+1 sta &worklen+&totallen+1 .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rts mend macro &l add2 &n1,&n2,&n3 aif c:&n3,.a lclc &n3 &n3 setc &n1 .a &l ~setm clc ~lda &n1 ~op adc,&n2 ~sta &n3 ~restm mend macro &l sub2 &n1,&n2,&n3 aif c:&n3,.a lclc &n3 &n3 setc &n1 .a &l ~setm sec ~lda &n1 ~op sbc,&n2 ~sta &n3 ~restm mend macro &l add4 &m1,&m2,&m3 lclb &yistwo lclc &c &l ~setm aif c:&m3,.a &c amid "&m2",1,1 aif "&c"<>"#",.a &c amid "&m1",1,1 aif "&c"="{",.a aif "&c"="[",.a &c amid "&m2",2,l:&m2-1 aif &c>=65536,.a clc ~lda &m1 ~op adc,&m2 ~sta &m1 bcc ~&SYSCNT ~op.h inc,&m1 ~&SYSCNT anop ago .c .a aif c:&m3,.b lclc &m3 &m3 setc &m1 .b clc ~lda &m1 ~op adc,&m2 ~sta &m3 ~lda.h &m1 ~op.h adc,&m2 ~sta.h &m3 .c ~restm mend macro &l bgt &bp &l beq *+4 bge &bp mend macro &l ble &bp &l blt &bp beq &bp mend macro &l inc4 &a &l ~setm inc &a bne ~&SYSCNT inc 2+&a ~&SYSCNT ~restm mend macro &l jeq &bp &l bne *+5 brl &bp mend macro &l jne &bp &l beq *+5 brl &bp mend macro &l lla &ad1,&ad2 &l anop lcla &lb lclb &la aif s:longa,.a rep #%00100000 longa on &la setb 1 .a lda #&ad2 &lb seta c:&ad1 .b sta &ad1(&lb) &lb seta &lb-1 aif &lb,^b lda #^&ad2 &lb seta c:&ad1 .c sta 2+&ad1(&lb) &lb seta &lb-1 aif &lb,^c aif &la=0,.d sep #%00100000 longa off .d mend macro &l long &a,&b lclb &i lclb &m &a amid &a,1,1 &m setb ("&a"="M").or.("&a"="m") &i setb ("&a"="I").or.("&a"="i") aif c:&b=0,.a &b amid &b,1,1 &m setb ("&b"="M").or.("&b"="m").or.&m &i setb ("&b"="I").or.("&b"="i").or.&i .a &l rep #&m*32+&i*16 aif .not.&m,.b longa on .b aif .not.&i,.c longi on .c mend macro &l ph2 &n1 &l anop aif "&n1"="*",.f lclc &c &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 lda (&n1) pha ago .e .b aif "&c"="<",.c lda &n1 pha ago .e .c &n1 amid &n1,2,l:&n1-1 pei &n1 ago .e .d &n1 amid &n1,2,l:&n1-1 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l ph4 &n1 &l anop aif "&n1"="*",.f lclc &c &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 ldy #2 lda (&n1),y pha lda (&n1) pha ago .e .b aif "&c"<>"[",.c ldy #2 lda &n1,y pha lda &n1 pha ago .e .c aif "&c"<>"<",.c1 &n1 amid &n1,2,l:&n1-1 pei &n1+2 pei &n1 ago .e .c1 lda &n1+2 pha lda &n1 pha ago .e .d &n1 amid &n1,2,l:&n1-1 pea +(&n1)|-16 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l short &a,&b lclb &i lclb &m &a amid &a,1,1 &m setb ("&a"="M").or.("&a"="m") &i setb ("&a"="I").or.("&a"="i") aif c:&b=0,.a &b amid &b,1,1 &m setb ("&b"="M").or.("&b"="m").or.&m &i setb ("&b"="I").or.("&b"="i").or.&i .a &l sep #&m*32+&i*16 aif .not.&m,.b longa off .b aif .not.&i,.c longi off .c mend macro &l ~lda &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l lda &op mend macro &l ~lda.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" lda &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" lda &op mexit .e lda 2+&op mend macro &l ~op &opc,&op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l &opc &op mend macro &l ~op.h &opc,&op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" &opc &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" &opc &op mexit .e &opc 2+&op mend macro &l ~restm &l anop aif (&~la+&~li)=2,.i sep #32*(.not.&~la)+16*(.not.&~li) aif &~la,.h longa off .h aif &~li,.i longi off .i mend macro &l ~setm &l anop aif c:&~la,.b gblb &~la gblb &~li .b &~la setb s:longa &~li setb s:longi aif s:longa.and.s:longi,.a rep #32*(.not.&~la)+16*(.not.&~li) longa on longi on .a mend macro &l ~sta &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l sta &op mend macro &l ~sta.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" sta &op mexit .d sta 2+&op mend \ No newline at end of file + MACRO +&LAB MOVE4 &F,&T +&LAB ~SETM + LDA 2+&F + STA 2+&T + LDA &F + STA &T + ~RESTM + MEND + macro +&lab sub &parms,&work +&lab anop + aif c:&work,.a + lclc &work +&work setc 0 +.a + gbla &totallen + gbla &worklen +&worklen seta &work +&totallen seta 0 + aif c:&parms=0,.e + lclc &len + lclc &p + lcla &i +&i seta c:&parms +.b +&p setc &parms(&i) +&len amid &p,2,1 + aif "&len"=":",.c +&len amid &p,1,2 +&p amid &p,4,l:&p-3 + ago .d +.c +&len amid &p,1,1 +&p amid &p,3,l:&p-2 +.d +&p equ &totallen+3+&work +&totallen seta &totallen+&len +&i seta &i-1 + aif &i,^b +.e + tsc + aif &work=0,.f + sec + sbc #&work + tcs +.f + phd + tcd + mend + macro +&lab ret &r +&lab anop + lclc &len + aif c:&r,.a + lclc &r +&r setc 0 +&len setc 0 + ago .h +.a +&len amid &r,2,1 + aif "&len"=":",.b +&len amid &r,1,2 +&r amid &r,4,l:&r-3 + ago .c +.b +&len amid &r,1,1 +&r amid &r,3,l:&r-2 +.c + aif &len<>2,.d + ldy &r + ago .h +.d + aif &len<>4,.e + ldx &r+2 + ldy &r + ago .h +.e + aif &len<>10,.g + ldy #&r + ldx #^&r + ago .h +.g + mnote 'Not a valid return length',16 + mexit +.h + aif &totallen=0,.i + lda &worklen+1 + sta &worklen+&totallen+1 +.i + pld + tsc + clc + adc #&worklen+&totallen + tcs + aif &len=0,.j + tya +.j + rts + mend + macro +&l add2 &n1,&n2,&n3 + aif c:&n3,.a + lclc &n3 +&n3 setc &n1 +.a +&l ~setm + clc + ~lda &n1 + ~op adc,&n2 + ~sta &n3 + ~restm + mend + macro +&l sub2 &n1,&n2,&n3 + aif c:&n3,.a + lclc &n3 +&n3 setc &n1 +.a +&l ~setm + sec + ~lda &n1 + ~op sbc,&n2 + ~sta &n3 + ~restm + mend + macro +&l add4 &m1,&m2,&m3 + lclb &yistwo + lclc &c +&l ~setm + aif c:&m3,.a +&c amid "&m2",1,1 + aif "&c"<>"#",.a +&c amid "&m1",1,1 + aif "&c"="{",.a + aif "&c"="[",.a +&c amid "&m2",2,l:&m2-1 + aif &c>=65536,.a + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m1 + bcc ~&SYSCNT + ~op.h inc,&m1 +~&SYSCNT anop + ago .c +.a + aif c:&m3,.b + lclc &m3 +&m3 setc &m1 +.b + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m3 + ~lda.h &m1 + ~op.h adc,&m2 + ~sta.h &m3 +.c + ~restm + mend + macro +&l bgt &bp +&l beq *+4 + bge &bp + mend + macro +&l ble &bp +&l blt &bp + beq &bp + mend + macro +&l inc4 &a +&l ~setm + inc &a + bne ~&SYSCNT + inc 2+&a +~&SYSCNT ~restm + mend + macro +&l jeq &bp +&l bne *+5 + brl &bp + mend + macro +&l jne &bp +&l beq *+5 + brl &bp + mend + macro +&l lla &ad1,&ad2 +&l anop + lcla &lb + lclb &la + aif s:longa,.a + rep #%00100000 + longa on +&la setb 1 +.a + lda #&ad2 +&lb seta c:&ad1 +.b + sta &ad1(&lb) +&lb seta &lb-1 + aif &lb,^b + lda #^&ad2 +&lb seta c:&ad1 +.c + sta 2+&ad1(&lb) +&lb seta &lb-1 + aif &lb,^c + aif &la=0,.d + sep #%00100000 + longa off +.d + mend + macro +&l long &a,&b + lclb &i + lclb &m +&a amid &a,1,1 +&m setb ("&a"="M").or.("&a"="m") +&i setb ("&a"="I").or.("&a"="i") + aif c:&b=0,.a +&b amid &b,1,1 +&m setb ("&b"="M").or.("&b"="m").or.&m +&i setb ("&b"="I").or.("&b"="i").or.&i +.a +&l rep #&m*32+&i*16 + aif .not.&m,.b + longa on +.b + aif .not.&i,.c + longi on +.c + mend + macro +&l ph2 &n1 +&l anop + aif "&n1"="*",.f + lclc &c +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + lda (&n1) + pha + ago .e +.b + aif "&c"="<",.c + lda &n1 + pha + ago .e +.c +&n1 amid &n1,2,l:&n1-1 + pei &n1 + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l ph4 &n1 +&l anop + aif "&n1"="*",.f + lclc &c +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + ldy #2 + lda (&n1),y + pha + lda (&n1) + pha + ago .e +.b + aif "&c"<>"[",.c + ldy #2 + lda &n1,y + pha + lda &n1 + pha + ago .e +.c + aif "&c"<>"<",.c1 +&n1 amid &n1,2,l:&n1-1 + pei &n1+2 + pei &n1 + ago .e +.c1 + lda &n1+2 + pha + lda &n1 + pha + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea +(&n1)|-16 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l short &a,&b + lclb &i + lclb &m +&a amid &a,1,1 +&m setb ("&a"="M").or.("&a"="m") +&i setb ("&a"="I").or.("&a"="i") + aif c:&b=0,.a +&b amid &b,1,1 +&m setb ("&b"="M").or.("&b"="m").or.&m +&i setb ("&b"="I").or.("&b"="i").or.&i +.a +&l sep #&m*32+&i*16 + aif .not.&m,.b + longa off +.b + aif .not.&i,.c + longi off +.c + mend + macro +&l ~lda &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l lda &op + mend + macro +&l ~lda.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + lda &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + lda &op + mexit +.e + lda 2+&op + mend + macro +&l ~op &opc,&op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l &opc &op + mend + macro +&l ~op.h &opc,&op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + &opc &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + &opc &op + mexit +.e + &opc 2+&op + mend + macro +&l ~restm +&l anop + aif (&~la+&~li)=2,.i + sep #32*(.not.&~la)+16*(.not.&~li) + aif &~la,.h + longa off +.h + aif &~li,.i + longi off +.i + mend + macro +&l ~setm +&l anop + aif c:&~la,.b + gblb &~la + gblb &~li +.b +&~la setb s:longa +&~li setb s:longi + aif s:longa.and.s:longi,.a + rep #32*(.not.&~la)+16*(.not.&~li) + longa on + longi on +.a + mend + macro +&l ~sta &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l sta &op + mend + macro +&l ~sta.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + sta &op + mexit +.d + sta 2+&op + mend diff --git a/file.asm b/file.asm old mode 100755 new mode 100644 index 4c95fe9..b96557a --- a/file.asm +++ b/file.asm @@ -1 +1,1017 @@ - keep obj/file mcopy file.mac **************************************************************** * * File2 * * This module contains the subroutines that depend on the file * system and shell. * * This version uses shell 2.0 calls. * **************************************************************** copy directPage **************************************************************** * * FileCommon - common data for the file module * **************************************************************** * FileCommon privdata ; ; Constants ; fileBuffSize equ 8*1024 max size of a file name buffer ; ; Shell call records ; ffDCB dc i'14' fast file DCB ffAction ds 2 ffIndex ds 2 ffFlags ds 2 ffFileHandle ds 4 ffPathName ds 4 ffAccess ds 2 ffFileType ds 2 ffAuxType ds 4 ffStorageType ds 2 ffCreate ds 8 ffMod ds 8 ffOption ds 4 ffFileLength ds 4 ffBlocksUsed ds 4 ffCheckSum ds 2 stlf_dcb dc i'11' set linfo DCB stlf_src ds 4 source file stlf_out ds 4 output file stlf_prm dc a4'PRM' parameter list stlf_lan dc a4'LAN' language specific string stlf_mer ds 1 maximum error allowed stlf_mef ds 1 maximum error found stlf_lop ds 1 operations flag stlf_kep ds 1 keep flag stlf_ltm ds 4 set of letters with - stlf_ltp ds 4 set of letters with + stlf_org ds 4 origin prm dc i'4,0' lan dc i'4,0' ; ; global variables ; libRefnum ds 2 refnum for the open library file name ds 256 file name end **************************************************************** * * AppendOSNames - append two GS/OS path names * * Inputs: * p1,p2 - pointers to input format GS/OS names * flags - * 0 - return an input string * 1 - return an output string * * Outputs: * X-A - nil for out of memory, otherwise a pointer to the string * * Notes: * This subroutine reserves a memory buffer based on * the actual length of the expanded path name. The * caller is responsible for disposing of the memory. * **************************************************************** * AppendOSNames private out equ 1 return pointer chars equ 5 pointer to input format portion of out sub (4:p1,4:p2,2:flags),8 clc find the length of the buffer lda [p1] adc [p2] inc A inc A ldx flags beq lb1 inc A inc A sta chars lb1 pea 0 allocate the memory pha jsr MLalloc sta out stx out+2 ora out beq lb7 lda flags if flags then beq lb2 lda chars set the length of the buffer sta [out] add4 out,#2,chars chars = out+2 bra lb3 else lb2 move4 out,chars chars = out lb3 anop endif clc set the length lda [p1] adc [p2] sta [chars] lda [p1] move in the first string beq lb4a tax ldy #2 short M lb4 lda [p1],Y sta [chars],Y iny dex bne lb4 long M lb4a clc update chars lda [p1] adc chars sta chars bcc lb5 inc chars+2 lb5 lda [p2] move in the second string beq lb7 tax ldy #2 short M lb6 lda [p2],Y sta [chars],Y iny dex bne lb6 long M lb7 ret 4:out end **************************************************************** * * CloseLibrary - close a library file * * Inputs: * dictionary - ptr to dictionary buffer * libRefnum - reference number for the library file * **************************************************************** * CloseLibrary start using FileCommon ph4 dictionary dispose of the dictionary buffer jsr Free lda libRefnum close the library file sta clRefnum OSClose clRec rts clRec dc i'1' clRefnum ds 2 end **************************************************************** * * ConvertString - convert an output string to an input string * * Inputs: * str - output string pointer * * Outputs: * Returns a pointer to the input string buffer * * Notes: * Allocates an appropriate size buffer. * **************************************************************** * ConvertString private ptr equ 1 sub (4:str),4 add4 str,#2 lda [str] inc A inc A pea 0 pha jsr MLalloc sta ptr stx ptr+2 lda [str] tay iny short M lb1 lda [str],Y sta [ptr],Y dey bpl lb1 long M ret 4:ptr end **************************************************************** * * GetLibFile - get a library file name from the library directory * * Inputs: * libIndex - index in the directory of the last library * * Outputs: * r0 - pointer to a GS/OS path name * C - set if a file was found, else clear * * Notes: * The file name pointer points to a dynamically * allocated buffer. The caller is responsible for * disposing of the buffer. The buffer is allocated * and returned even if the call fails. * **************************************************************** * GetLibFile start using FileCommon using Common stz found no name found, yet ph4 #fileBuffSize+4 get a file name buffer jsr MLalloc sta gdName sta r0 stx gdName+2 stx r2 lda #fileBuffSize+4 set its size sta [r0] OSOpen opRec open the library prefix bcs lb3 lda opRefnum set the reference number sta gdRefnum sta clRefnum lb1 inc libIndex try the next file in the library prefix lda libIndex sta gdIndex OSGet_Dir_Entry gdRec bcs lb2 lda gdFiletype cmp #LIB bne lb1 ph4 #libname append the file name to the library name add4 r0,#2 ph4 r0 ph2 #0 jsr AppendOSNames sta r0 stx r2 ph4 gdName free the name buffer jsr Free inc found found a file lb2 OSClose clRec close the library direcory lb3 lda found return found lsr A rts ; ; Local data ; found ds 2 was a path name found? libname dos '13/' library directory name opRec dc i'2' open record opRefnum ds 2 dc a4'libname' clRec dc i'1' close record clRefnum ds 2 gdRec dc i'7' GetDirEntry record gdRefnum ds 2 ds 2 file flags dc i'0' base (absolute displacement number) gdIndex ds 2 index into the directory gdName ds 4 file name ds 2 entry number gdFiletype ds 2 file type end **************************************************************** * * GetLibList - process libraries in {Libraries} shell variable * * Inputs: * slist - list of command line libraries * * Outputs: * slist - updated * libFromShell - true if {Libraries} existed, else false * **************************************************************** * GetLibList start using FileCommon using Common ; ; Read the library shell variable ; stz libFromShell libFromShell = false ph4 #fileBuffSize+4 allocate default space for the jsr MLAlloc variable sta rdValue sta r0 stx rdValue+2 stx r2 lda #fileBuffSize set the buffer size sta [r0] OSRead_Variable rdRef read the shell variable bcs lb1 ldy #2 quit if the value is null lda [r0],Y beq lb1 ; ; Append the variable list to the command line file list ; ph4 slist append a space ph4 #blank ph2 #0 jsr AppendOSNames phx pha ph4 slist jsr Free pl4 slist ph4 slist append the variable's contents add4 rdValue,#2,r0 ph4 r0 ph2 #0 jsr AppendOSNames phx pha ph4 slist jsr Free pl4 slist inc libFromShell libFromShell = true lb1 ph4 rdValue dispose of our buffer jsr Free rts ; ; Local data ; blank dos ' ' space lib dos Libraries name of the library shell variable rdRef dc i'3' Read_Variable record rdName dc a4'lib' rdValue ds 4 ds 2 end **************************************************************** * * GetLInfo - get the command link information * * Outputs: * slist - ptr to list of input file names * kname - keep file name (nil for none) * merr - maximum error level allowed * merrf - maxiumum error level found so far * lops - language operations * kflag - keep flag * mflags - minus flags * pflags - plus flags * org - origin * * C - set if an error occurred * **************************************************************** * GetLInfo start using FileCommon using Common ; ; Get info ; ph4 #fileBuffSize+4 allocate default space for the names jsr MLAlloc sta stlf_src sta r0 stx stlf_src+2 stx r2 ph4 #fileBuffSize+4 jsr MLAlloc sta stlf_out sta r4 stx stlf_out+2 stx r6 lda #fileBuffSize set the buffer sizes sta [r0] sta [r4] lla stlf_prm,prm get file info lla stlf_lan,lan OSGet_LInfo stlf_dcb ; ; Convert the file names ; ph4 stlf_src jsr ConvertString sta slist stx slist+2 ph4 stlf_src jsr Free ph4 stlf_out jsr ConvertString sta kname stx kname+2 ph4 stlf_out jsr Free ; ; Set the scalars ; lda stlf_mer and #$00FF sta merr lda stlf_mef and #$00FF sta merrf lda stlf_lop and #$00FF sta lops lda stlf_kep and #$00FF sta kflag move4 stlf_ltm,mflags move4 stlf_ltp,pflags move4 stlf_org,org clc rts end **************************************************************** * * OpenLibrary - open a library file * * Inputs: * fname - name of the library to open * * Outputs: * libRefnum - reference number for the library file * **************************************************************** * OpenLibrary start using FileCommon move4 fname,opPathname OSOpen opRec bcc lb1 lda #1 jmp TermError lb1 lda opRefnum sta libRefnum rts opRec dc i'2' opRefnum ds 2 opPathname ds 4 end **************************************************************** * * Purge - purge a file * * Inputs: * fname - name of the file to purge * **************************************************************** * Purge start using FileCommon move4 fname,ffPathName lda #7 sta ffAction lda #$C000 sta ffFlags OSFastFile ffDCB rts end **************************************************************** * * PurgePlusM - purge memory only files * **************************************************************** * PurgePlusM start using Common using FileCommon lda memory skip this check if +m was not used jeq ff4 ph4 #fileBuffSize+4 get a file name buffer jsr MLalloc sta ffPathName sta r0 stx ffPathName+2 stx r2 lda #fileBuffSize+4 sta [r0] add4 ffPathName,#2 stz index for each file index do ff1 lda #1 do an indexed load of the file sta ffAction lda index sta ffIndex sub4 ffPathName,#2 OSFastFile ffDCB bcs ff3 quit if there is no file add4 ffPathName,#2 lda ffFlags quit if the file is not a memory file bne ff2 lda #5 remove the file sta ffAction OSFastFile ffDCB bra ff1 try again with the same index ff2 lda #7 purge the file sta ffAction OSFastFile ffDCB inc index next file index bra ff1 ff3 ph4 r0 dispose of the file buffer jsr Free ff4 rts ; ; Local data ; index ds 2 indexed load index end **************************************************************** * * Read - open a file for input * * Inputs: * fname - name of the file to open * * Outputs: * r0 - pointer to the first byte in the file * r4 - length of the file * r8 - file type * **************************************************************** * Read start using Common using FileCommon lda memory if +m then beq ff1 move4 fname,ffPathName try loading the file from memory lda #2 sta ffAction lda #$C000 sta ffFlags OSFastFile ffDCB bra ff2 else ff1 move4 fname,ffPathName try loading the file from disk stz ffAction lda #$C000 sta ffFlags OSFastFile ffDCB ff2 bcc lb1 lda #6 file not found: flag the error jmp TermError lb1 lda ffFileLength make sure the file is not empty ora ffFileLength+2 bne lb2 lda #13 jmp TermError lb2 move4 ffFileHandle,r4 return the file parameters ldy #2 lda [r4] sta r0 lda [r4],Y sta r2 move4 ffFileLength,r4 lda ffFileType sta r8 rts end **************************************************************** * * ReadLibraryHeader - read the dictionary for a library * * Inputs: * libRefnum - reference number for the library file * * Outputs: * libSymbols - pointer to the first entry in the lib symbol table * libLength - length of the symbol table * libNames - pointer to the first library name * libDisp - set to 0 * didLibSegment - set to false * **************************************************************** * ReadLibraryHeader start using FileCommon lda libRefnum read the library header sta rdRefnum sta dcRefnum sta mkRefnum OSRead rdRec bcc lb0 err1 lda #1 jmp TermError lb0 lda version if version = 2 then and #$00FF cmp #2 bne lb1 lda type2 if the segment type is not libDict then and #$00FF flag the error bra lb2 lb1 lda type1 if the segment is not libDict then and #$001F lb2 cmp #8 beq lb3 lda #10 TermError(10) jmp TermError lb3 ph4 length get space for the dictionary jsr MLalloc sta dictionary sta dcBuffer stx dictionary+2 stx dcBuffer+2 OSSet_Mark mkRec set the file mark to the file start move4 length,dcLength read the dictionary OSRead dcRec bcs err1 move4 dictionary,r0 {find the library symbol table} lda version if version = 0 then and #$00FF bne lb4 add4 r0,#$24 add in the segment header length bra lb7 else if version in [1,2] then lb4 cmp #3 bge lb6 ldy #$2A add in the disp to the data clc lda [r0],Y adc r0 sta r0 bcc lb5 inc r2 lb5 bra lb7 else lb6 lda #3 flag an unsuported segment error jmp TermError lb7 jsr SkipLConst skip the first lconst record add4 r0,#5,libSymbols set the library symbol table pointer ldy #1 set the length of the symbol table lda [r0],Y sta libLength iny iny lda [r0],Y sta libLength+2 jsr SkipLConst skip the symbol table add4 r0,#5,libNames set the library names pointer jsr SkipLConst verify the last record is LConst stz libDisp no symbols processed stz libDisp+2 stz didLibSegment no segments processed rts ; ; SkipLConst - skip an lconst record ; SkipLConst anop lda [r0] verify that the first thing is an and #$00FF lconst record cmp #$F2 beq sc1 lda #11 {illegal data error} jmp TermError sc1 ldy #1 skip it clc lda [r0],Y adc r0 tax iny iny lda [r0],Y adc r2 sta r2 stx r0 add4 r0,#5 rts ; ; Local data ; header anop header for the first library segment length ds 4 length of the segment, in bytes ds 4 reserved space ds 4 length type1 ds 1 segment type, versions 0 and 1 ds 1 label length ds 1 number length version ds 1 segment version ds 4 bank size type2 ds 2 segment type, version 2 headerend anop rdRec dc i'4' read record for reading the first rdRefnum ds 2 segment header dc a4'header' dc i4'headerend-header' ds 4 dc i'1' cache the blocks! dcRec dc i'4' read record for reading the dictionary dcRefnum ds 2 dcBuffer ds 4 dcLength ds 4 ds 4 dc i'1' cache the blocks! mkRec dc i'3' for SetMark; used to set the file mkRefnum ds 2 mark back to the start of the file dc i'0' dc i4'0' end **************************************************************** * * ReadLibrarySegment - read a segment from the library * * Inputs: * libseg - pointer to any old library segment * libRefnum - reference number for the library * r0 - disp in the file * * Outputs: * libseg - pointer to the new library segment * seg - pointer to the first byte in the segment * **************************************************************** * ReadLibrarySegment start using Common using FileCommon lda libRefnum set file reference numbers sta rdRefnum sta dcRefnum sta mkRefnum move4 r0,mkDisp set the mark in the file OSSet_Mark mkRec bcs err1 OSRead rdRec read the library length bcc lb1 err1 lda #6 jmp TermError lb1 ph4 libSeg free any old segment jsr Free ph4 length get space for the dictionary jsr MLalloc sta libSeg sta dcBuffer sta seg stx libSeg+2 stx dcBuffer+2 stx seg+2 OSSet_Mark mkRec set the file mark to the segment start move4 length,dcLength read the segment OSRead dcRec bcs err1 rts ; ; Local data ; header anop header for the first library segment length ds 4 length of the segment, in bytes headerend anop rdRec dc i'4' read record for reading the first rdRefnum ds 2 segment header dc a4'header' dc i4'headerend-header' ds 4 dc i'1' cache the blocks! dcRec dc i'4' read record for reading the segment dcRefnum ds 2 dcBuffer ds 4 dcLength ds 4 ds 4 dc i'1' cache the blocks! mkRec dc i'3' for SetMark; used to set the file mkRefnum ds 2 mark back to the start of the file dc i'0' mkDisp dc i4'0' end **************************************************************** * * ReadVariable - read a shell variable * * Inputs: * name - GS/OS version of the variable name * * Outputs: * returns a pointer to the shell variable value * * Notes: * A value is always returned. If there is no shell * variable, a value with a length of 0 is returned. * * The buffer is allocated dynamically. The caller must * dispose of the buffer. * **************************************************************** * ReadVariable start value equ 1 pointer to the value sub (4:name),4 move4 name,rdName set the name OSRead_Variable rdRef read the shell variable ph4 rdValue return the value jsr ConvertString sta value stx value+2 ret 4:value rdRef dc i'3' Read_Variable record rdName ds 4 rdValue dc a4'buff2' ds 2 buff2 dc i'256' variable value ds 256 end **************************************************************** * * ScanFastFile - see if the file is in the FastFile list * * Inputs: * fname - file name * * Outputs: * A - 1 if the file is in the list and is memory, else 0 * **************************************************************** * ScanFastFile start using Common using FileCommon val equ 1 return value ptr equ 3 work pointer fullName equ 7 expanded version of fname index equ 11 indexed load index sub (4:fname),12 stz val assume there is no match ph4 #fileBuffSize+4 get a file name buffer jsr MLalloc sta ffPathName sta ptr stx ffPathName+2 stx ptr+2 lda #fileBuffSize+4 sta [ptr] add4 ptr,#2 add4 ffPathName,#2 ph4 #fileBuffSize+4 get another buffer for the expanded jsr MLalloc input name sta fullName sta exOut stx fullName+2 stx exOut+2 lda #fileBuffSize+4 sta [fullName] move4 fname,exIn OSExpandDevices exRec jcs ff5 add4 fullName,#2 make sure it is lowercase lda [fullName] jeq ff5 tax ldy #2 short M lb1 lda [fullName],Y ora #$20 sta [fullName],Y iny dex bne lb1 long M stz index for each file index do ff1 lda #1 do an indexed load of the file sta ffAction lda index sta ffIndex sub4 ffPathName,#2 OSFastFile ffDCB bcs ff5 quit if there is no file add4 ffPathName,#2 lda ffFlags skip if the file is not a memory file bne ff4 lda [fullName] skip if the names are different cmp [ptr] bne ff4 tax ldy #2 short M ff2 lda [ptr],Y ora #$20 cmp [fullName],Y bne ff4 iny dex bne ff2 long M lda #1 names match: val = true sta val lda #7 purge the file sta ffAction OSFastFile ffDCB bra ff5 quit ff4 long M lda #7 purge the file sta ffAction OSFastFile ffDCB inc index next file index brl ff1 ff5 ph4 ptr free the name buffers jsr Free ph4 fullName jsr Free ret 2:val exRec dc i'2' ExpandDevices record exIn ds 4 exOut ds 4 end **************************************************************** * * SetLInfo - set language info before return to shell * **************************************************************** * SetLInfo start using FileCommon using Common ; ; Set the scalars ; short M lda merr sta stlf_mer lda merrf sta stlf_mef lda lops and #$FC sta stlf_lop lda kflag sta stlf_kep long M move4 mflags,stlf_ltm move4 pflags,stlf_ltp move4 org,stlf_org ; ; Return info to the shell ; move4 kname,stlf_src move4 kname,stlf_out lla stlf_prm,prm lla stlf_lan,lan OSSet_LInfo stlf_dcb rts end \ No newline at end of file + keep obj/file + mcopy file.mac +**************************************************************** +* +* File2 +* +* This module contains the subroutines that depend on the file +* system and shell. +* +* This version uses shell 2.0 calls. +* +**************************************************************** + copy directPage +**************************************************************** +* +* FileCommon - common data for the file module +* +**************************************************************** +* +FileCommon privdata +; +; Constants +; +fileBuffSize equ 8*1024 max size of a file name buffer +; +; Shell call records +; +ffDCB dc i'14' fast file DCB +ffAction ds 2 +ffIndex ds 2 +ffFlags ds 2 +ffFileHandle ds 4 +ffPathName ds 4 +ffAccess ds 2 +ffFileType ds 2 +ffAuxType ds 4 +ffStorageType ds 2 +ffCreate ds 8 +ffMod ds 8 +ffOption ds 4 +ffFileLength ds 4 +ffBlocksUsed ds 4 +ffCheckSum ds 2 + +stlf_dcb dc i'11' set linfo DCB +stlf_src ds 4 source file +stlf_out ds 4 output file +stlf_prm dc a4'PRM' parameter list +stlf_lan dc a4'LAN' language specific string +stlf_mer ds 1 maximum error allowed +stlf_mef ds 1 maximum error found +stlf_lop ds 1 operations flag +stlf_kep ds 1 keep flag +stlf_ltm ds 4 set of letters with - +stlf_ltp ds 4 set of letters with + +stlf_org ds 4 origin +prm dc i'4,0' +lan dc i'4,0' +; +; global variables +; +libRefnum ds 2 refnum for the open library file +name ds 256 file name + end + +**************************************************************** +* +* AppendOSNames - append two GS/OS path names +* +* Inputs: +* p1,p2 - pointers to input format GS/OS names +* flags - +* 0 - return an input string +* 1 - return an output string +* +* Outputs: +* X-A - nil for out of memory, otherwise a pointer to the string +* +* Notes: +* This subroutine reserves a memory buffer based on +* the actual length of the expanded path name. The +* caller is responsible for disposing of the memory. +* +**************************************************************** +* +AppendOSNames private +out equ 1 return pointer +chars equ 5 pointer to input format portion of out + + sub (4:p1,4:p2,2:flags),8 + + clc find the length of the buffer + lda [p1] + adc [p2] + inc A + inc A + ldx flags + beq lb1 + inc A + inc A + sta chars +lb1 pea 0 allocate the memory + pha + jsr MLalloc + sta out + stx out+2 + ora out + beq lb7 + lda flags if flags then + beq lb2 + lda chars set the length of the buffer + sta [out] + add4 out,#2,chars chars = out+2 + bra lb3 else +lb2 move4 out,chars chars = out +lb3 anop endif + clc set the length + lda [p1] + adc [p2] + sta [chars] + lda [p1] move in the first string + beq lb4a + tax + ldy #2 + short M +lb4 lda [p1],Y + sta [chars],Y + iny + dex + bne lb4 + long M +lb4a clc update chars + lda [p1] + adc chars + sta chars + bcc lb5 + inc chars+2 +lb5 lda [p2] move in the second string + beq lb7 + tax + ldy #2 + short M +lb6 lda [p2],Y + sta [chars],Y + iny + dex + bne lb6 + long M + +lb7 ret 4:out + end + +**************************************************************** +* +* CloseLibrary - close a library file +* +* Inputs: +* dictionary - ptr to dictionary buffer +* libRefnum - reference number for the library file +* +**************************************************************** +* +CloseLibrary start + using FileCommon + + ph4 dictionary dispose of the dictionary buffer + jsr Free + lda libRefnum close the library file + sta clRefnum + OSClose clRec + rts + +clRec dc i'1' +clRefnum ds 2 + end + +**************************************************************** +* +* ConvertString - convert an output string to an input string +* +* Inputs: +* str - output string pointer +* +* Outputs: +* Returns a pointer to the input string buffer +* +* Notes: +* Allocates an appropriate size buffer. +* +**************************************************************** +* +ConvertString private +ptr equ 1 + + sub (4:str),4 + + add4 str,#2 + lda [str] + inc A + inc A + pea 0 + pha + jsr MLalloc + sta ptr + stx ptr+2 + lda [str] + tay + iny + short M +lb1 lda [str],Y + sta [ptr],Y + dey + bpl lb1 + long M + + ret 4:ptr + end + +**************************************************************** +* +* GetLibFile - get a library file name from the library directory +* +* Inputs: +* libIndex - index in the directory of the last library +* +* Outputs: +* r0 - pointer to a GS/OS path name +* C - set if a file was found, else clear +* +* Notes: +* The file name pointer points to a dynamically +* allocated buffer. The caller is responsible for +* disposing of the buffer. The buffer is allocated +* and returned even if the call fails. +* +**************************************************************** +* +GetLibFile start + using FileCommon + using Common + + stz found no name found, yet + ph4 #fileBuffSize+4 get a file name buffer + jsr MLalloc + sta gdName + sta r0 + stx gdName+2 + stx r2 + lda #fileBuffSize+4 set its size + sta [r0] + OSOpen opRec open the library prefix + bcs lb3 + lda opRefnum set the reference number + sta gdRefnum + sta clRefnum + +lb1 inc libIndex try the next file in the library prefix + lda libIndex + sta gdIndex + OSGet_Dir_Entry gdRec + bcs lb2 + lda gdFiletype + cmp #LIB + bne lb1 + ph4 #libname append the file name to the library name + add4 r0,#2 + ph4 r0 + ph2 #0 + jsr AppendOSNames + sta r0 + stx r2 + ph4 gdName free the name buffer + jsr Free + inc found found a file + +lb2 OSClose clRec close the library direcory +lb3 lda found return found + lsr A + rts +; +; Local data +; +found ds 2 was a path name found? +libname dos '13/' library directory name + +opRec dc i'2' open record +opRefnum ds 2 + dc a4'libname' + +clRec dc i'1' close record +clRefnum ds 2 + +gdRec dc i'7' GetDirEntry record +gdRefnum ds 2 + ds 2 file flags + dc i'0' base (absolute displacement number) +gdIndex ds 2 index into the directory +gdName ds 4 file name + ds 2 entry number +gdFiletype ds 2 file type + end + +**************************************************************** +* +* GetLibList - process libraries in {Libraries} shell variable +* +* Inputs: +* slist - list of command line libraries +* +* Outputs: +* slist - updated +* libFromShell - true if {Libraries} existed, else false +* +**************************************************************** +* +GetLibList start + using FileCommon + using Common +; +; Read the library shell variable +; + stz libFromShell libFromShell = false + ph4 #fileBuffSize+4 allocate default space for the + jsr MLAlloc variable + sta rdValue + sta r0 + stx rdValue+2 + stx r2 + lda #fileBuffSize set the buffer size + sta [r0] + OSRead_Variable rdRef read the shell variable + bcs lb1 + ldy #2 quit if the value is null + lda [r0],Y + beq lb1 +; +; Append the variable list to the command line file list +; + ph4 slist append a space + ph4 #blank + ph2 #0 + jsr AppendOSNames + phx + pha + ph4 slist + jsr Free + pl4 slist + ph4 slist append the variable's contents + add4 rdValue,#2,r0 + ph4 r0 + ph2 #0 + jsr AppendOSNames + phx + pha + ph4 slist + jsr Free + pl4 slist + inc libFromShell libFromShell = true +lb1 ph4 rdValue dispose of our buffer + jsr Free + rts +; +; Local data +; +blank dos ' ' space +lib dos Libraries name of the library shell variable + +rdRef dc i'3' Read_Variable record +rdName dc a4'lib' +rdValue ds 4 + ds 2 + end + +**************************************************************** +* +* GetLInfo - get the command link information +* +* Outputs: +* slist - ptr to list of input file names +* kname - keep file name (nil for none) +* merr - maximum error level allowed +* merrf - maxiumum error level found so far +* lops - language operations +* kflag - keep flag +* mflags - minus flags +* pflags - plus flags +* org - origin +* +* C - set if an error occurred +* +**************************************************************** +* +GetLInfo start + using FileCommon + using Common +; +; Get info +; + ph4 #fileBuffSize+4 allocate default space for the names + jsr MLAlloc + sta stlf_src + sta r0 + stx stlf_src+2 + stx r2 + ph4 #fileBuffSize+4 + jsr MLAlloc + sta stlf_out + sta r4 + stx stlf_out+2 + stx r6 + lda #fileBuffSize set the buffer sizes + sta [r0] + sta [r4] + lla stlf_prm,prm get file info + lla stlf_lan,lan + OSGet_LInfo stlf_dcb +; +; Convert the file names +; + ph4 stlf_src + jsr ConvertString + sta slist + stx slist+2 + ph4 stlf_src + jsr Free + + ph4 stlf_out + jsr ConvertString + sta kname + stx kname+2 + ph4 stlf_out + jsr Free +; +; Set the scalars +; + lda stlf_mer + and #$00FF + sta merr + lda stlf_mef + and #$00FF + sta merrf + lda stlf_lop + and #$00FF + sta lops + lda stlf_kep + and #$00FF + sta kflag + move4 stlf_ltm,mflags + move4 stlf_ltp,pflags + move4 stlf_org,org + clc + rts + end + +**************************************************************** +* +* OpenLibrary - open a library file +* +* Inputs: +* fname - name of the library to open +* +* Outputs: +* libRefnum - reference number for the library file +* +**************************************************************** +* +OpenLibrary start + using FileCommon + + move4 fname,opPathname + OSOpen opRec + bcc lb1 + lda #1 + jmp TermError +lb1 lda opRefnum + sta libRefnum + rts + +opRec dc i'2' +opRefnum ds 2 +opPathname ds 4 + end + +**************************************************************** +* +* Purge - purge a file +* +* Inputs: +* fname - name of the file to purge +* +**************************************************************** +* +Purge start + using FileCommon + + move4 fname,ffPathName + lda #7 + sta ffAction + lda #$C000 + sta ffFlags + OSFastFile ffDCB + rts + end + +**************************************************************** +* +* PurgePlusM - purge memory only files +* +**************************************************************** +* +PurgePlusM start + using Common + using FileCommon + + lda memory skip this check if +m was not used + jeq ff4 + + ph4 #fileBuffSize+4 get a file name buffer + jsr MLalloc + sta ffPathName + sta r0 + stx ffPathName+2 + stx r2 + lda #fileBuffSize+4 + sta [r0] + add4 ffPathName,#2 + + stz index for each file index do +ff1 lda #1 do an indexed load of the file + sta ffAction + lda index + sta ffIndex + sub4 ffPathName,#2 + OSFastFile ffDCB + bcs ff3 quit if there is no file + add4 ffPathName,#2 + lda ffFlags quit if the file is not a memory file + bne ff2 + lda #5 remove the file + sta ffAction + OSFastFile ffDCB + bra ff1 try again with the same index +ff2 lda #7 purge the file + sta ffAction + OSFastFile ffDCB + inc index next file index + bra ff1 + +ff3 ph4 r0 dispose of the file buffer + jsr Free +ff4 rts +; +; Local data +; +index ds 2 indexed load index + end + +**************************************************************** +* +* Read - open a file for input +* +* Inputs: +* fname - name of the file to open +* +* Outputs: +* r0 - pointer to the first byte in the file +* r4 - length of the file +* r8 - file type +* +**************************************************************** +* +Read start + using Common + using FileCommon + + lda memory if +m then + beq ff1 + move4 fname,ffPathName try loading the file from memory + lda #2 + sta ffAction + lda #$C000 + sta ffFlags + OSFastFile ffDCB + bra ff2 else +ff1 move4 fname,ffPathName try loading the file from disk + stz ffAction + lda #$C000 + sta ffFlags + OSFastFile ffDCB +ff2 bcc lb1 + lda #6 file not found: flag the error + jmp TermError + +lb1 lda ffFileLength make sure the file is not empty + ora ffFileLength+2 + bne lb2 + lda #13 + jmp TermError + +lb2 move4 ffFileHandle,r4 return the file parameters + ldy #2 + lda [r4] + sta r0 + lda [r4],Y + sta r2 + move4 ffFileLength,r4 + lda ffFileType + sta r8 + rts + end + +**************************************************************** +* +* ReadLibraryHeader - read the dictionary for a library +* +* Inputs: +* libRefnum - reference number for the library file +* +* Outputs: +* libSymbols - pointer to the first entry in the lib symbol table +* libLength - length of the symbol table +* libNames - pointer to the first library name +* libDisp - set to 0 +* didLibSegment - set to false +* +**************************************************************** +* +ReadLibraryHeader start + using FileCommon + + lda libRefnum read the library header + sta rdRefnum + sta dcRefnum + sta mkRefnum + OSRead rdRec + bcc lb0 +err1 lda #1 + jmp TermError + +lb0 lda version if version = 2 then + and #$00FF + cmp #2 + bne lb1 + lda type2 if the segment type is not libDict then + and #$00FF flag the error + bra lb2 +lb1 lda type1 if the segment is not libDict then + and #$001F +lb2 cmp #8 + beq lb3 + lda #10 TermError(10) + jmp TermError + +lb3 ph4 length get space for the dictionary + jsr MLalloc + sta dictionary + sta dcBuffer + stx dictionary+2 + stx dcBuffer+2 + OSSet_Mark mkRec set the file mark to the file start + move4 length,dcLength read the dictionary + OSRead dcRec + bcs err1 + + move4 dictionary,r0 {find the library symbol table} + lda version if version = 0 then + and #$00FF + bne lb4 + add4 r0,#$24 add in the segment header length + bra lb7 else if version in [1,2] then +lb4 cmp #3 + bge lb6 + ldy #$2A add in the disp to the data + clc + lda [r0],Y + adc r0 + sta r0 + bcc lb5 + inc r2 +lb5 bra lb7 else +lb6 lda #3 flag an unsuported segment error + jmp TermError + +lb7 jsr SkipLConst skip the first lconst record + add4 r0,#5,libSymbols set the library symbol table pointer + ldy #1 set the length of the symbol table + lda [r0],Y + sta libLength + iny + iny + lda [r0],Y + sta libLength+2 + jsr SkipLConst skip the symbol table + add4 r0,#5,libNames set the library names pointer + jsr SkipLConst verify the last record is LConst + stz libDisp no symbols processed + stz libDisp+2 + stz didLibSegment no segments processed + rts +; +; SkipLConst - skip an lconst record +; +SkipLConst anop + + lda [r0] verify that the first thing is an + and #$00FF lconst record + cmp #$F2 + beq sc1 + lda #11 {illegal data error} + jmp TermError +sc1 ldy #1 skip it + clc + lda [r0],Y + adc r0 + tax + iny + iny + lda [r0],Y + adc r2 + sta r2 + stx r0 + add4 r0,#5 + rts +; +; Local data +; +header anop header for the first library segment +length ds 4 length of the segment, in bytes + ds 4 reserved space + ds 4 length +type1 ds 1 segment type, versions 0 and 1 + ds 1 label length + ds 1 number length +version ds 1 segment version + ds 4 bank size +type2 ds 2 segment type, version 2 +headerend anop + +rdRec dc i'4' read record for reading the first +rdRefnum ds 2 segment header + dc a4'header' + dc i4'headerend-header' + ds 4 + dc i'1' cache the blocks! + +dcRec dc i'4' read record for reading the dictionary +dcRefnum ds 2 +dcBuffer ds 4 +dcLength ds 4 + ds 4 + dc i'1' cache the blocks! + +mkRec dc i'3' for SetMark; used to set the file +mkRefnum ds 2 mark back to the start of the file + dc i'0' + dc i4'0' + end + +**************************************************************** +* +* ReadLibrarySegment - read a segment from the library +* +* Inputs: +* libseg - pointer to any old library segment +* libRefnum - reference number for the library +* r0 - disp in the file +* +* Outputs: +* libseg - pointer to the new library segment +* seg - pointer to the first byte in the segment +* +**************************************************************** +* +ReadLibrarySegment start + using Common + using FileCommon + + lda libRefnum set file reference numbers + sta rdRefnum + sta dcRefnum + sta mkRefnum + move4 r0,mkDisp set the mark in the file + OSSet_Mark mkRec + bcs err1 + OSRead rdRec read the library length + bcc lb1 +err1 lda #6 + jmp TermError + +lb1 ph4 libSeg free any old segment + jsr Free + ph4 length get space for the dictionary + jsr MLalloc + sta libSeg + sta dcBuffer + sta seg + stx libSeg+2 + stx dcBuffer+2 + stx seg+2 + OSSet_Mark mkRec set the file mark to the segment start + move4 length,dcLength read the segment + OSRead dcRec + bcs err1 + rts +; +; Local data +; +header anop header for the first library segment +length ds 4 length of the segment, in bytes +headerend anop + +rdRec dc i'4' read record for reading the first +rdRefnum ds 2 segment header + dc a4'header' + dc i4'headerend-header' + ds 4 + dc i'1' cache the blocks! + +dcRec dc i'4' read record for reading the segment +dcRefnum ds 2 +dcBuffer ds 4 +dcLength ds 4 + ds 4 + dc i'1' cache the blocks! + +mkRec dc i'3' for SetMark; used to set the file +mkRefnum ds 2 mark back to the start of the file + dc i'0' +mkDisp dc i4'0' + end + +**************************************************************** +* +* ReadVariable - read a shell variable +* +* Inputs: +* name - GS/OS version of the variable name +* +* Outputs: +* returns a pointer to the shell variable value +* +* Notes: +* A value is always returned. If there is no shell +* variable, a value with a length of 0 is returned. +* +* The buffer is allocated dynamically. The caller must +* dispose of the buffer. +* +**************************************************************** +* +ReadVariable start +value equ 1 pointer to the value + + sub (4:name),4 + + move4 name,rdName set the name + OSRead_Variable rdRef read the shell variable + ph4 rdValue return the value + jsr ConvertString + sta value + stx value+2 + + ret 4:value + +rdRef dc i'3' Read_Variable record +rdName ds 4 +rdValue dc a4'buff2' + ds 2 + +buff2 dc i'256' variable value + ds 256 + end + +**************************************************************** +* +* ScanFastFile - see if the file is in the FastFile list +* +* Inputs: +* fname - file name +* +* Outputs: +* A - 1 if the file is in the list and is memory, else 0 +* +**************************************************************** +* +ScanFastFile start + using Common + using FileCommon +val equ 1 return value +ptr equ 3 work pointer +fullName equ 7 expanded version of fname +index equ 11 indexed load index + + sub (4:fname),12 + + stz val assume there is no match + ph4 #fileBuffSize+4 get a file name buffer + jsr MLalloc + sta ffPathName + sta ptr + stx ffPathName+2 + stx ptr+2 + lda #fileBuffSize+4 + sta [ptr] + add4 ptr,#2 + add4 ffPathName,#2 + ph4 #fileBuffSize+4 get another buffer for the expanded + jsr MLalloc input name + sta fullName + sta exOut + stx fullName+2 + stx exOut+2 + lda #fileBuffSize+4 + sta [fullName] + move4 fname,exIn + OSExpandDevices exRec + jcs ff5 + add4 fullName,#2 make sure it is lowercase + lda [fullName] + jeq ff5 + tax + ldy #2 + short M +lb1 lda [fullName],Y + ora #$20 + sta [fullName],Y + iny + dex + bne lb1 + long M + + stz index for each file index do +ff1 lda #1 do an indexed load of the file + sta ffAction + lda index + sta ffIndex + sub4 ffPathName,#2 + OSFastFile ffDCB + bcs ff5 quit if there is no file + add4 ffPathName,#2 + lda ffFlags skip if the file is not a memory file + bne ff4 + lda [fullName] skip if the names are different + cmp [ptr] + bne ff4 + tax + ldy #2 + short M +ff2 lda [ptr],Y + ora #$20 + cmp [fullName],Y + bne ff4 + iny + dex + bne ff2 + long M + lda #1 names match: val = true + sta val + lda #7 purge the file + sta ffAction + OSFastFile ffDCB + bra ff5 quit + +ff4 long M + lda #7 purge the file + sta ffAction + OSFastFile ffDCB + inc index next file index + brl ff1 +ff5 ph4 ptr free the name buffers + jsr Free + ph4 fullName + jsr Free + + ret 2:val + +exRec dc i'2' ExpandDevices record +exIn ds 4 +exOut ds 4 + end + +**************************************************************** +* +* SetLInfo - set language info before return to shell +* +**************************************************************** +* +SetLInfo start + using FileCommon + using Common +; +; Set the scalars +; + short M + lda merr + sta stlf_mer + lda merrf + sta stlf_mef + lda lops + and #$FC + sta stlf_lop + lda kflag + sta stlf_kep + long M + move4 mflags,stlf_ltm + move4 pflags,stlf_ltp + move4 org,stlf_org +; +; Return info to the shell +; + move4 kname,stlf_src + move4 kname,stlf_out + lla stlf_prm,prm + lla stlf_lan,lan + OSSet_LInfo stlf_dcb + rts + end diff --git a/file.mac b/file.mac old mode 100755 new mode 100644 index d4ed2ed..165c290 --- a/file.mac +++ b/file.mac @@ -1 +1,613 @@ - MACRO &LAB DOS &ADR &LAB DC I"L:~&SYSNAME&SYSCNT" ~&SYSNAME&SYSCNT DC C"&ADR" MEND MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND macro &lab sub &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta c:&parms .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+3+&work &totallen seta &totallen+&len &i seta &i-1 aif &i,^b .e tsc aif &work=0,.f sec sbc #&work tcs .f phd tcd mend macro &lab ret &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g ldy #&r ldx #^&r ago .h .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+1 sta &worklen+&totallen+1 .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rts mend macro &l add4 &m1,&m2,&m3 lclb &yistwo lclc &c &l ~setm aif c:&m3,.a &c amid "&m2",1,1 aif "&c"<>"#",.a &c amid "&m1",1,1 aif "&c"="{",.a aif "&c"="[",.a &c amid "&m2",2,l:&m2-1 aif &c>=65536,.a clc ~lda &m1 ~op adc,&m2 ~sta &m1 bcc ~&SYSCNT ~op.h inc,&m1 ~&SYSCNT anop ago .c .a aif c:&m3,.b lclc &m3 &m3 setc &m1 .b clc ~lda &m1 ~op adc,&m2 ~sta &m3 ~lda.h &m1 ~op.h adc,&m2 ~sta.h &m3 .c ~restm mend macro &l sub4 &m1,&m2,&m3 lclb &yistwo lclc &c &l ~setm aif c:&m3,.a &c amid "&m2",1,1 aif "&c"<>"#",.a &c amid "&m1",1,1 aif "&c"="{",.a aif "&c"="[",.a &c amid "&m2",2,l:&m2-1 aif &c>=65536,.a sec ~lda &m1 ~op sbc,&m2 ~sta &m1 bcs ~&SYSCNT ~op.h dec,&m1 ~&SYSCNT anop ago .c .a aif c:&m3,.b lclc &m3 &m3 setc &m1 .b sec ~lda &m1 ~op sbc,&m2 ~sta &m3 ~lda.h &m1 ~op.h sbc,&m2 ~sta.h &m3 .c ~restm mend macro &l jcs &bp &l bcc *+5 brl &bp mend macro &l jeq &bp &l bne *+5 brl &bp mend macro &l lla &ad1,&ad2 &l anop lcla &lb lclb &la aif s:longa,.a rep #%00100000 longa on &la setb 1 .a lda #&ad2 &lb seta c:&ad1 .b sta &ad1(&lb) &lb seta &lb-1 aif &lb,^b lda #^&ad2 &lb seta c:&ad1 .c sta 2+&ad1(&lb) &lb seta &lb-1 aif &lb,^c aif &la=0,.d sep #%00100000 longa off .d mend macro &l long &a,&b lclb &i lclb &m &a amid &a,1,1 &m setb ("&a"="M").or.("&a"="m") &i setb ("&a"="I").or.("&a"="i") aif c:&b=0,.a &b amid &b,1,1 &m setb ("&b"="M").or.("&b"="m").or.&m &i setb ("&b"="I").or.("&b"="i").or.&i .a &l rep #&m*32+&i*16 aif .not.&m,.b longa on .b aif .not.&i,.c longi on .c mend macro &l ph2 &n1 &l anop aif "&n1"="*",.f lclc &c &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 lda (&n1) pha ago .e .b aif "&c"="<",.c lda &n1 pha ago .e .c &n1 amid &n1,2,l:&n1-1 pei &n1 ago .e .d &n1 amid &n1,2,l:&n1-1 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l ph4 &n1 &l anop aif "&n1"="*",.f lclc &c &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 ldy #2 lda (&n1),y pha lda (&n1) pha ago .e .b aif "&c"<>"[",.c ldy #2 lda &n1,y pha lda &n1 pha ago .e .c aif "&c"<>"<",.c1 &n1 amid &n1,2,l:&n1-1 pei &n1+2 pei &n1 ago .e .c1 lda &n1+2 pha lda &n1 pha ago .e .d &n1 amid &n1,2,l:&n1-1 pea +(&n1)|-16 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l pl4 &n1 lclc &c &l anop aif s:longa=1,.a rep #%00100000 .a &c amid &n1,1,1 aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.f &n1 amid &n1,2,l:&n1-2 pla sta (&n1) ldy #2 pla sta (&n1),y ago .d .b aif "&c"<>"[",.c pla sta &n1 ldy #2 pla sta &n1,y ago .d .c pla sta &n1 pla sta &n1+2 .d aif s:longa=1,.e sep #%00100000 .e mexit .f mnote "Missing closing '}'",16 mend macro &l short &a,&b lclb &i lclb &m &a amid &a,1,1 &m setb ("&a"="M").or.("&a"="m") &i setb ("&a"="I").or.("&a"="i") aif c:&b=0,.a &b amid &b,1,1 &m setb ("&b"="M").or.("&b"="m").or.&m &i setb ("&b"="I").or.("&b"="i").or.&i .a &l sep #&m*32+&i*16 aif .not.&m,.b longa off .b aif .not.&i,.c longi off .c mend macro &l ~lda &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l lda &op mend macro &l ~lda.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" lda &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" lda &op mexit .e lda 2+&op mend macro &l ~op &opc,&op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l &opc &op mend macro &l ~op.h &opc,&op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" &opc &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" &opc &op mexit .e &opc 2+&op mend macro &l ~restm &l anop aif (&~la+&~li)=2,.i sep #32*(.not.&~la)+16*(.not.&~li) aif &~la,.h longa off .h aif &~li,.i longi off .i mend macro &l ~setm &l anop aif c:&~la,.b gblb &~la gblb &~li .b &~la setb s:longa &~li setb s:longi aif s:longa.and.s:longi,.a rep #32*(.not.&~la)+16*(.not.&~li) longa on longi on .a mend macro &l ~sta &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l sta &op mend macro &l ~sta.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" sta &op mexit .d sta 2+&op mend macro &l osclose &p &l jsl $E100A8 dc i2'$2014' dc i4'&p' mend macro &l osget_dir_entry &p &l jsl $E100A8 dc i2'$201C' dc i4'&p' mend macro &l osopen &p &l jsl $E100A8 dc i2'$2010' dc i4'&p' mend macro &l osread &p &l jsl $E100A8 dc i2'$2012' dc i4'&p' mend macro &l osset_mark &p &l jsl $E100A8 dc i2'$2016' dc i4'&p' mend MACRO &LAB OSFASTFILE &DCB &LAB ~SETM JSL $E100A8 DC I2'$014E' DC I4'&DCB' ~RESTM MEND MACRO &LAB OSGET_LINFO &DCB &LAB ~SETM JSL $E100A8 DC I2'$0141' DC I4'&DCB' ~RESTM MEND MACRO &LAB OSREAD_VARIABLE &DCB &LAB ~SETM JSL $E100A8 DC I2'$014B' DC I4'&DCB' ~RESTM MEND MACRO &LAB OSSET_LINFO &DCB &LAB ~SETM JSL $E100A8 DC I2'$0142' DC I4'&DCB' ~RESTM MEND MACRO &LAB OSEXPANDDEVICES &DCB &LAB ~SETM JSL $E100A8 DC I2'$0154' DC I4'&DCB' ~RESTM MEND \ No newline at end of file + MACRO +&LAB DOS &ADR +&LAB DC I"L:~&SYSNAME&SYSCNT" +~&SYSNAME&SYSCNT DC C"&ADR" + MEND + MACRO +&LAB MOVE4 &F,&T +&LAB ~SETM + LDA 2+&F + STA 2+&T + LDA &F + STA &T + ~RESTM + MEND + macro +&lab sub &parms,&work +&lab anop + aif c:&work,.a + lclc &work +&work setc 0 +.a + gbla &totallen + gbla &worklen +&worklen seta &work +&totallen seta 0 + aif c:&parms=0,.e + lclc &len + lclc &p + lcla &i +&i seta c:&parms +.b +&p setc &parms(&i) +&len amid &p,2,1 + aif "&len"=":",.c +&len amid &p,1,2 +&p amid &p,4,l:&p-3 + ago .d +.c +&len amid &p,1,1 +&p amid &p,3,l:&p-2 +.d +&p equ &totallen+3+&work +&totallen seta &totallen+&len +&i seta &i-1 + aif &i,^b +.e + tsc + aif &work=0,.f + sec + sbc #&work + tcs +.f + phd + tcd + mend + macro +&lab ret &r +&lab anop + lclc &len + aif c:&r,.a + lclc &r +&r setc 0 +&len setc 0 + ago .h +.a +&len amid &r,2,1 + aif "&len"=":",.b +&len amid &r,1,2 +&r amid &r,4,l:&r-3 + ago .c +.b +&len amid &r,1,1 +&r amid &r,3,l:&r-2 +.c + aif &len<>2,.d + ldy &r + ago .h +.d + aif &len<>4,.e + ldx &r+2 + ldy &r + ago .h +.e + aif &len<>10,.g + ldy #&r + ldx #^&r + ago .h +.g + mnote 'Not a valid return length',16 + mexit +.h + aif &totallen=0,.i + lda &worklen+1 + sta &worklen+&totallen+1 +.i + pld + tsc + clc + adc #&worklen+&totallen + tcs + aif &len=0,.j + tya +.j + rts + mend + macro +&l add4 &m1,&m2,&m3 + lclb &yistwo + lclc &c +&l ~setm + aif c:&m3,.a +&c amid "&m2",1,1 + aif "&c"<>"#",.a +&c amid "&m1",1,1 + aif "&c"="{",.a + aif "&c"="[",.a +&c amid "&m2",2,l:&m2-1 + aif &c>=65536,.a + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m1 + bcc ~&SYSCNT + ~op.h inc,&m1 +~&SYSCNT anop + ago .c +.a + aif c:&m3,.b + lclc &m3 +&m3 setc &m1 +.b + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m3 + ~lda.h &m1 + ~op.h adc,&m2 + ~sta.h &m3 +.c + ~restm + mend + macro +&l sub4 &m1,&m2,&m3 + lclb &yistwo + lclc &c +&l ~setm + aif c:&m3,.a +&c amid "&m2",1,1 + aif "&c"<>"#",.a +&c amid "&m1",1,1 + aif "&c"="{",.a + aif "&c"="[",.a +&c amid "&m2",2,l:&m2-1 + aif &c>=65536,.a + sec + ~lda &m1 + ~op sbc,&m2 + ~sta &m1 + bcs ~&SYSCNT + ~op.h dec,&m1 +~&SYSCNT anop + ago .c +.a + aif c:&m3,.b + lclc &m3 +&m3 setc &m1 +.b + sec + ~lda &m1 + ~op sbc,&m2 + ~sta &m3 + ~lda.h &m1 + ~op.h sbc,&m2 + ~sta.h &m3 +.c + ~restm + mend + macro +&l jcs &bp +&l bcc *+5 + brl &bp + mend + macro +&l jeq &bp +&l bne *+5 + brl &bp + mend + macro +&l lla &ad1,&ad2 +&l anop + lcla &lb + lclb &la + aif s:longa,.a + rep #%00100000 + longa on +&la setb 1 +.a + lda #&ad2 +&lb seta c:&ad1 +.b + sta &ad1(&lb) +&lb seta &lb-1 + aif &lb,^b + lda #^&ad2 +&lb seta c:&ad1 +.c + sta 2+&ad1(&lb) +&lb seta &lb-1 + aif &lb,^c + aif &la=0,.d + sep #%00100000 + longa off +.d + mend + macro +&l long &a,&b + lclb &i + lclb &m +&a amid &a,1,1 +&m setb ("&a"="M").or.("&a"="m") +&i setb ("&a"="I").or.("&a"="i") + aif c:&b=0,.a +&b amid &b,1,1 +&m setb ("&b"="M").or.("&b"="m").or.&m +&i setb ("&b"="I").or.("&b"="i").or.&i +.a +&l rep #&m*32+&i*16 + aif .not.&m,.b + longa on +.b + aif .not.&i,.c + longi on +.c + mend + macro +&l ph2 &n1 +&l anop + aif "&n1"="*",.f + lclc &c +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + lda (&n1) + pha + ago .e +.b + aif "&c"="<",.c + lda &n1 + pha + ago .e +.c +&n1 amid &n1,2,l:&n1-1 + pei &n1 + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l ph4 &n1 +&l anop + aif "&n1"="*",.f + lclc &c +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + ldy #2 + lda (&n1),y + pha + lda (&n1) + pha + ago .e +.b + aif "&c"<>"[",.c + ldy #2 + lda &n1,y + pha + lda &n1 + pha + ago .e +.c + aif "&c"<>"<",.c1 +&n1 amid &n1,2,l:&n1-1 + pei &n1+2 + pei &n1 + ago .e +.c1 + lda &n1+2 + pha + lda &n1 + pha + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea +(&n1)|-16 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l pl4 &n1 + lclc &c +&l anop + aif s:longa=1,.a + rep #%00100000 +.a +&c amid &n1,1,1 + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.f +&n1 amid &n1,2,l:&n1-2 + pla + sta (&n1) + ldy #2 + pla + sta (&n1),y + ago .d +.b + aif "&c"<>"[",.c + pla + sta &n1 + ldy #2 + pla + sta &n1,y + ago .d +.c + pla + sta &n1 + pla + sta &n1+2 +.d + aif s:longa=1,.e + sep #%00100000 +.e + mexit +.f + mnote "Missing closing '}'",16 + mend + macro +&l short &a,&b + lclb &i + lclb &m +&a amid &a,1,1 +&m setb ("&a"="M").or.("&a"="m") +&i setb ("&a"="I").or.("&a"="i") + aif c:&b=0,.a +&b amid &b,1,1 +&m setb ("&b"="M").or.("&b"="m").or.&m +&i setb ("&b"="I").or.("&b"="i").or.&i +.a +&l sep #&m*32+&i*16 + aif .not.&m,.b + longa off +.b + aif .not.&i,.c + longi off +.c + mend + macro +&l ~lda &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l lda &op + mend + macro +&l ~lda.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + lda &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + lda &op + mexit +.e + lda 2+&op + mend + macro +&l ~op &opc,&op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l &opc &op + mend + macro +&l ~op.h &opc,&op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + &opc &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + &opc &op + mexit +.e + &opc 2+&op + mend + macro +&l ~restm +&l anop + aif (&~la+&~li)=2,.i + sep #32*(.not.&~la)+16*(.not.&~li) + aif &~la,.h + longa off +.h + aif &~li,.i + longi off +.i + mend + macro +&l ~setm +&l anop + aif c:&~la,.b + gblb &~la + gblb &~li +.b +&~la setb s:longa +&~li setb s:longi + aif s:longa.and.s:longi,.a + rep #32*(.not.&~la)+16*(.not.&~li) + longa on + longi on +.a + mend + macro +&l ~sta &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l sta &op + mend + macro +&l ~sta.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + sta &op + mexit +.d + sta 2+&op + mend + macro +&l osclose &p +&l jsl $E100A8 + dc i2'$2014' + dc i4'&p' + mend + macro +&l osget_dir_entry &p +&l jsl $E100A8 + dc i2'$201C' + dc i4'&p' + mend + macro +&l osopen &p +&l jsl $E100A8 + dc i2'$2010' + dc i4'&p' + mend + macro +&l osread &p +&l jsl $E100A8 + dc i2'$2012' + dc i4'&p' + mend + macro +&l osset_mark &p +&l jsl $E100A8 + dc i2'$2016' + dc i4'&p' + mend + MACRO +&LAB OSFASTFILE &DCB +&LAB ~SETM + JSL $E100A8 + DC I2'$014E' + DC I4'&DCB' + ~RESTM + MEND + MACRO +&LAB OSGET_LINFO &DCB +&LAB ~SETM + JSL $E100A8 + DC I2'$0141' + DC I4'&DCB' + ~RESTM + MEND + MACRO +&LAB OSREAD_VARIABLE &DCB +&LAB ~SETM + JSL $E100A8 + DC I2'$014B' + DC I4'&DCB' + ~RESTM + MEND + MACRO +&LAB OSSET_LINFO &DCB +&LAB ~SETM + JSL $E100A8 + DC I2'$0142' + DC I4'&DCB' + ~RESTM + MEND + MACRO +&LAB OSEXPANDDEVICES &DCB +&LAB ~SETM + JSL $E100A8 + DC I2'$0154' + DC I4'&DCB' + ~RESTM + MEND diff --git a/linker.asm b/linker.asm old mode 100755 new mode 100644 index b09b6b7..ece70b6 --- a/linker.asm +++ b/linker.asm @@ -1 +1,713 @@ - mcopy linker.mac keep obj/linker **************************************************************** * * Linker 2.0 * * Link editor for ORCA/M. * **************************************************************** * * Linker 2.0.3 prepared Mar 96 by Mike Westerfield * **************************************************************** * * Linker 2.0.2 prepared Jul 94 by Mike Westerfield * **************************************************************** * Linker start using Common phk use our data bank plb tsx save the stack register stx sreg ora #$0100 set our user ID sta userID jsl SysIOStartup start the I/O system jsr Initialize set up the linker bcs exit jsr DoPass1 do pass 1 bcs exit jsr DoPass2 do pass 2 bcs exit lda kflag if kflag then beq lb1 jsr KeepFile write the keep file lb1 jsr Terminate do final processing exit entry jsr PurgePlusM purge memory only files jsr SetLInfo pass parameters back to the shell jsl SysIOShutdown shut down the I/O system lda #0 return to the caller rtl end **************************************************************** * * Common - global data * **************************************************************** * copy DirectPage Common data ; ; Memory locations ; keyboard equ $C000 keyboard value strobe equ $C010 keyboard strobe kflags equ $C025 keyboard flags ; ; Constants ; flagB equ %01000000000000000000000000000000 command line flag masks flagC equ %00100000000000000000000000000000 flagL equ %00000000000100000000000000000000 flagM equ %00000000000010000000000000000000 flagP equ %00000000000000010000000000000000 flagS equ %00000000000000000010000000000000 flagW equ %00000000000000000000001000000000 flagX equ %00000000000000000000000100000000 flagAll equ flagB+flagC+flagL+flagM+flagP+flagS+flagW+flagX RETURN equ $0D key codes TAB equ $09 ; ; Symbol flags (bit masks for symFlag) ; pass1Resolved equ 1 label defined on pass 1 pass2Resolved equ 2 label defined on pass 2 pass1Requested equ 4 label has been requested on pass1 pass2Requested equ 8 label has been requested on pass2 ! (see also, subroutine Reference2) isConstant equ 16 is the value a constant? isDataArea equ 32 is the symbol a data area? isSegmentFlag equ 64 is the symbol a segment name? ; ; global scalars ; bankOrg ds 2 bank org the program? compact ds 2 compact the object files? dataAreas ds 256 data area array dpReg ds 2 default DP register eoln ds 2 script end of line flag express ds 2 expressload the file? length ds 4 length of the output file libFromShell ds 2 did the shell have a variable? libIndex ds 2 next library index libSeg ds 4 pointer to the current library segment lineNumber ds 2 script line number list ds 2 list segment info? memory ds 2 is this a +m link? numerror ds 2 number of linker errors found pass ds 2 pass number (1 or 2) pause ds 2 pause on error? progress ds 2 write progress info? sreg ds 2 stack register in main symbols ds 2 list the symbol table? userID ds 2 user ID; for memory manager calls ; ; Current code segment information ; segLength ds 4 length of the code in the segment segDisp ds 4 disp to the next segment in the file segSpace ds 4 reserved space at the end of the segment segType ds 2 segment type segName ds 4 pointer to the name of the segment segEntry ds 4 disp to entry point in segment segAlign ds 4 segment alignment factor segVersion ds 2 segment version number segOrg ds 4 origin for this segment segBanksize ds 4 banksize for this segment startpc ds 4 pc at the start of the segment fileNumber ds 2 source file number dataNumber ds 2 data area number (0 for code segments) lastDataNumber ds 2 last data area number used lastFileNumber ds 2 last file number used ; ; Scalars passed to and from the shell ; merr ds 2 maximum error level allowed merrf ds 2 maxiumum error level found so far lops ds 2 language operations kflag ds 2 keep flag mflags ds 4 minus flags pflags ds 4 plus flags org ds 4 origin end **************************************************************** * * GetCh - get the current character from the script * * Inputs: * r0 - ptr to the start of a file * r4 - length of the file * * Outputs: * A - character read * * Notes: * 1. All whitespace characters are converted to spaces. * 2. A null is returned if there are no more characters * in the file. * **************************************************************** * GetCh private using Common lb1 lda r4 quit if at eof ora r6 beq lb3 lda [r0] A = r0^ and #$00FF cmp #RETURN if A in [RETURN,TAB] then beq lb2 cmp #TAB else if A = TAB then bne lb3 lb2 lda #' ' return a space lb3 rts end **************************************************************** * * Initialize - get ready to do a link * * Outputs: * C - set if an error occurred * **************************************************************** * Initialize private using Common ; ; Get the command line inputs ; tdc set our DP register sta dpReg jsr GetLInfo get the command line inputs jcs rts jsr GetLibList read and handle {Libraries} ; ; Initialize the global scalars ; jsr InitSymbol initialize the symbol table jsr InitOut initialize the output module stz length no bytes in the program stz length+2 stz fname no file name buffer allocated stz fname+2 stz basename no base name buffer allocated stz basename+2 stz numerror no errors so far stz libSeg no library segment buffer allocated stz libSeg+2 ; ; Read the script file ; lda lops if this is a scripted link then lsr A bcc sf0 stz sdisp initialize the command line disp jsr GetName get the script file name jsr CopybaseName jsr GetName make sure there is only one file bcc rs1 lda #13 jsr TermError sec brl rts rs1 jsr Read read the script file jsr Script process the script file jsr Purge purge the file ; ; Set the various flags ; sf0 stz list list = false lda #^flagL if +L then and pflags+2 beq sf1 inc list list = true sf1 stz symbols symbols = false lda #flagS if +S then and pflags beq sf2 inc symbols symbols = true sf2 lda #1 express = true sta express lda #flagX if -X then and mflags beq sf3 stz express express = false sf3 stz pause pause = false lda #flagW if +W then and pflags beq sf4 inc pause pause = true sf4 stz memory memory = false lda #^flagM if +M then and pflags+2 beq sf5 inc memory memory = true sf5 lda #1 compact = true sta compact lda #^flagC if -C then and mflags+2 beq sf6 stz compact compact = false sf6 stz bankOrg bankOrg = false lda #^flagB if +B then and pflags+2 beq sf7 inc bankOrg bankOrg = true sf7 lda #1 progress = true sta progress lda #^flagP if -P then and mflags+2 beq sf8 stz progress progress = false sf8 anop ; ; Write the header ; lda progress beq wh1 puts #'Link Editor 2.0.3',cr=t putcr wh1 anop ; ; Return to main ; clc rts rts end **************************************************************** * * NextCh - get the next character from the script * * Inputs: * r0 - ptr to the start of a file * r4 - length of the file * eoln - was the last character an eoln? * * Outputs: * A - character read * eoln - was the last character an eoln? * r8 - set to the start of any new line * * Notes: * 1. All whitespace characters are converted to spaces. * 2. A null is returned if there are no more characters * in the file. * 3. Comments are skipped * **************************************************************** * NextCh private using Common ; ; Check for EOF ; lda r4 quit if at eof ora r6 jeq lb5 ; ; Handle comments ; lda eoln if eoln then beq lb3 stz eoln eoln = false lb1 lda [r0] if r0[1] in ['*','!',';'] then and #$FF00 xba cmp #'*' beq lb2 cmp #'!' beq lb2 cmp #';' bne lb3 lb2 inc4 r0 skip this line dec4 r4 lda r4 ora r6 beq lb5 lda [r0] and #$00FF cmp #RETURN bne lb2 bra lb1 check for adjacent comments ; ; Return the next character ; lb3 inc4 r0 next char dec4 r4 lda r4 quit if at eof ora r6 beq lb5 lda [r0] A = r0^ and #$00FF cmp #RETURN if A = RETURN then bne lb4 add4 r0,#1,r8 set the line start lda #1 eoln = true sta eoln inc lineNumber ++lineNumber lda #' ' return a space bra lb5 lb4 cmp #TAB else if A = TAB then bne lb5 lda #' ' return a space lb5 rts end **************************************************************** * * Script - read and process a script file * * Inputs: * r0 - ptr to the start of a file * r4 - length of the file * mflags,pflags - current file flags * kname - keep file name * kflag - keep file flag * * Outputs: * mflags,pflags - file flags * kname - keep file name * kflag - keep file flag * slist - pointer to the file name list * **************************************************************** * Script private using Common ; ; Set up the script ; lda #1 eoln = true {starting a new line} sta eoln sta lineNumber current line # = 1 move4 r0,r8 set the first line pointer dec4 r0 get the first char (skipping comments) jsr NextCh ; ; Process flags ; fl0 jsr SkipBlanks skip leading blanks fl1 jsr GetCh if GetCh in ['+','-'] then cmp #'+' beq fl2 cmp #'-' bne pn1 fl2 sta flagCh save the flag sign jsr NextCh get the flag character and #$5F uppercase the character sec form the flag bit sbc #'@' bmi fl4 tax stz r12 stz r14 sec fl3 ror r14 ror r12 dex bne fl3 lda r12 make sure the flag is legal and #flagAll bne fl5 lda r14 and #^flagAll bne fl5 fl4 lda #1 flag an illegal flag error jmp ScriptError fl5 jsr NextCh skip the flag character lda r12 if this flag was set from the CL then bit pFlags bne fl0 skip the flag bit mFlags bne fl0 lda r14 bit pFlags+2 bne fl0 bit mFlags+2 bne fl0 lda flagCh if flagCh = '+' then cmp #'+' bne fl6 lda r12 pFlags |= r12 ora pFlags sta pFlags lda r14 ora pFlags+2 sta pFlags+2 bra fl0 else fl6 lda r12 mFlags |= r12 ora mFlags sta mFlags lda r14 ora mFlags+2 sta mFlags+2 brl fl0 get the next flag ; ; Process file names ; pn1 ph4 slist free the old list jsr Free add4 r4,#4,r12 reserve plenty of space for the file list ph4 r12 jsr MLalloc sta slist stx slist+2 stz r16 no characters written add4 slist,#2,r12 set next char pointer pn2 jsr SkipBlanks skip any blanks jsr GetCh if at eof then tax beq pn6 done lda r6 if r4 > 5 then bne pn2a lda r4 cmp #6 blt pn4 pn2a ldy #4 if r0^ = "keep=" then pn3 lda [r0],Y and #$00FF jsr ToUpper short M cmp keep,Y long M bne pn4 dey bpl pn3 done bra pn6 pn4 jsr GetCh while not GetCh in [' ', chr(0)] do tax beq pn5 cmp #' ' beq pn5 short M save the character sta [r12] long M inc4 r12 inc r16 update the line length jsr NextCh skip to the next character bra pn4 endwhile pn5 short M add a trailing space lda #' ' sta [r12] long M inc4 r12 inc r16 bra pn2 next name pn6 lda r16 set the list length beq pn7 dec A pn7 sta [slist] ; ; Process a keep name ; lda kname skip this step if we have a kname ora kname+2 beq kn0 lda [kname] jne kn5 kn0 jsr NextCh skip the keep name jsr NextCh jsr NextCh jsr NextCh jsr NextCh kn1 ph4 kname free the old list jsr Free lda #1 kflag = true sta kflag add4 r4,#4,r12 reserve plenty of space for the file list ph4 r12 jsr MLalloc sta kname stx kname+2 stz r16 no characters written add4 kname,#2,r12 set next char pointer jsr GetCh if at eof then tax beq kn3 done kn2 jsr GetCh while not GetCh in [' ', chr(0)] do tax beq kn3 cmp #' ' beq kn3 short M save the character sta [r12] long M inc4 r12 inc r16 update the line length jsr NextCh skip to the next character bra kn2 endwhile kn3 lda r16 set the list length bne kn4 lda #2 missing keep name jmp ScriptError kn4 sta [kname] jsr SkipBlanks skip trailing blanks and comments jsr GetCh make sure there are no more chars tax beq kn5 lda #3 unknow parameters jmp ScriptError kn5 rts ; ; Local data ; flagCh ds 2 flag character keep dc c'KEEP=' keep preamble end **************************************************************** * * ScriptError - flag an error in a script file * * Inputs: * r0 - ptr to the char where the error occurred * r4 - # chars left in the script * r8 - ptr to the start of the line * A - error number * **************************************************************** * ScriptError private using Common sta err save the error number sub4 r0,r8,disp get the disp to the error add4 r4,disp move back to the start of the line move4 r8,r0 put2 lineNumber,#5,errout=t print the line number putc #' ',errout=t print one space lb1 jsr GetCh print the line tax beq lb2 sta ch putc ch,errout=t jsr NextCh lda eoln beq lb1 lb2 putcr errout=t add4 disp,#6 print the error pointer lb3 putc #' ',errout=t dec4 disp lda disp ora disp+2 bne lb3 puts #'^ ',errout=t dec err print the error message bne lb4 puts #'Illegal flag',errout=t,cr=t bra lb6 lb4 dec err bne lb5 puts #'Missing keep name',errout=t,cr=t bra lb6 lb5 dec err bne lb6 puts #'Unrecognized parameter',errout=t,cr=t lb6 lda #14 stop the link jmp TermError ; ; Local data ; ch ds 2 character from script err ds 2 error number disp ds 4 # chars to the error end **************************************************************** * * SkipBlanks - skip whitespace in a script file * **************************************************************** * SkipBlanks private jsr GetCh bra lb2 lb1 jsr NextCh lb2 tax beq lb3 cmp #' ' beq lb1 lb3 rts end **************************************************************** * * Terminate - do terminal processing * **************************************************************** * Terminate private using OutCommon using Common ; ; Write the link statistics ; jsr PrintSymbols print the symbol table lda list if list then beq sg1 jsr PrintSegmentInfo write the segment table sg1 lda numError if there are errors then jeq er3 putcr errout=t write the error summary lda numError dec A bne er1 puts #'1 error',errout=t bra er2 er1 put2 numError,errout=t puts #' errors',errout=t er2 puts #' found during link',cr=t,errout=t put2 merrf,errout=t puts #' was the highest error level',cr=t,errout=t er3 lda progress if progress or list then bne er4 lda list jeq er5 er4 putcr write the number, size of segments puts #'There ' lda lastLoadNumber dec A bne lb1 puts #'is 1 segment' bra lb2 lb1 puts #'are ' put2 lastLoadNumber puts #' segments' lb2 puts #', for a length of $' ph4 length ph2 #8 ph2 #0 jsr PrintHex puts #' bytes.',cr=t er5 anop endif rts end \ No newline at end of file + mcopy linker.mac + keep obj/linker +**************************************************************** +* +* Linker 2.0 +* +* Link editor for ORCA/M. +* +**************************************************************** +* +* Linker 2.0.3 prepared Mar 96 by Mike Westerfield +* +**************************************************************** +* +* Linker 2.0.2 prepared Jul 94 by Mike Westerfield +* +**************************************************************** +* +Linker start + using Common + + phk use our data bank + plb + tsx save the stack register + stx sreg + ora #$0100 set our user ID + sta userID + jsl SysIOStartup start the I/O system + jsr Initialize set up the linker + bcs exit + jsr DoPass1 do pass 1 + bcs exit + jsr DoPass2 do pass 2 + bcs exit + lda kflag if kflag then + beq lb1 + jsr KeepFile write the keep file +lb1 jsr Terminate do final processing + +exit entry + jsr PurgePlusM purge memory only files + jsr SetLInfo pass parameters back to the shell + jsl SysIOShutdown shut down the I/O system + lda #0 return to the caller + rtl + end + +**************************************************************** +* +* Common - global data +* +**************************************************************** +* + copy DirectPage +Common data +; +; Memory locations +; +keyboard equ $C000 keyboard value +strobe equ $C010 keyboard strobe +kflags equ $C025 keyboard flags +; +; Constants +; +flagB equ %01000000000000000000000000000000 command line flag masks +flagC equ %00100000000000000000000000000000 +flagL equ %00000000000100000000000000000000 +flagM equ %00000000000010000000000000000000 +flagP equ %00000000000000010000000000000000 +flagS equ %00000000000000000010000000000000 +flagW equ %00000000000000000000001000000000 +flagX equ %00000000000000000000000100000000 +flagAll equ flagB+flagC+flagL+flagM+flagP+flagS+flagW+flagX + +RETURN equ $0D key codes +TAB equ $09 +; +; Symbol flags (bit masks for symFlag) +; +pass1Resolved equ 1 label defined on pass 1 +pass2Resolved equ 2 label defined on pass 2 +pass1Requested equ 4 label has been requested on pass1 +pass2Requested equ 8 label has been requested on pass2 +! (see also, subroutine Reference2) +isConstant equ 16 is the value a constant? +isDataArea equ 32 is the symbol a data area? +isSegmentFlag equ 64 is the symbol a segment name? +; +; global scalars +; +bankOrg ds 2 bank org the program? +compact ds 2 compact the object files? +dataAreas ds 256 data area array +dpReg ds 2 default DP register +eoln ds 2 script end of line flag +express ds 2 expressload the file? +length ds 4 length of the output file +libFromShell ds 2 did the shell have a variable? +libIndex ds 2 next library index +libSeg ds 4 pointer to the current library segment +lineNumber ds 2 script line number +list ds 2 list segment info? +memory ds 2 is this a +m link? +numerror ds 2 number of linker errors found +pass ds 2 pass number (1 or 2) +pause ds 2 pause on error? +progress ds 2 write progress info? +sreg ds 2 stack register in main +symbols ds 2 list the symbol table? +userID ds 2 user ID; for memory manager calls +; +; Current code segment information +; +segLength ds 4 length of the code in the segment +segDisp ds 4 disp to the next segment in the file +segSpace ds 4 reserved space at the end of the segment +segType ds 2 segment type +segName ds 4 pointer to the name of the segment +segEntry ds 4 disp to entry point in segment +segAlign ds 4 segment alignment factor +segVersion ds 2 segment version number +segOrg ds 4 origin for this segment +segBanksize ds 4 banksize for this segment + +startpc ds 4 pc at the start of the segment + +fileNumber ds 2 source file number +dataNumber ds 2 data area number (0 for code segments) + +lastDataNumber ds 2 last data area number used +lastFileNumber ds 2 last file number used +; +; Scalars passed to and from the shell +; +merr ds 2 maximum error level allowed +merrf ds 2 maxiumum error level found so far +lops ds 2 language operations +kflag ds 2 keep flag +mflags ds 4 minus flags +pflags ds 4 plus flags +org ds 4 origin + end + +**************************************************************** +* +* GetCh - get the current character from the script +* +* Inputs: +* r0 - ptr to the start of a file +* r4 - length of the file +* +* Outputs: +* A - character read +* +* Notes: +* 1. All whitespace characters are converted to spaces. +* 2. A null is returned if there are no more characters +* in the file. +* +**************************************************************** +* +GetCh private + using Common + +lb1 lda r4 quit if at eof + ora r6 + beq lb3 + lda [r0] A = r0^ + and #$00FF + cmp #RETURN if A in [RETURN,TAB] then + beq lb2 + cmp #TAB else if A = TAB then + bne lb3 +lb2 lda #' ' return a space +lb3 rts + end + +**************************************************************** +* +* Initialize - get ready to do a link +* +* Outputs: +* C - set if an error occurred +* +**************************************************************** +* +Initialize private + using Common +; +; Get the command line inputs +; + tdc set our DP register + sta dpReg + jsr GetLInfo get the command line inputs + jcs rts + jsr GetLibList read and handle {Libraries} +; +; Initialize the global scalars +; + jsr InitSymbol initialize the symbol table + jsr InitOut initialize the output module + stz length no bytes in the program + stz length+2 + stz fname no file name buffer allocated + stz fname+2 + stz basename no base name buffer allocated + stz basename+2 + stz numerror no errors so far + stz libSeg no library segment buffer allocated + stz libSeg+2 +; +; Read the script file +; + lda lops if this is a scripted link then + lsr A + bcc sf0 + stz sdisp initialize the command line disp + jsr GetName get the script file name + jsr CopybaseName + jsr GetName make sure there is only one file + bcc rs1 + lda #13 + jsr TermError + sec + brl rts +rs1 jsr Read read the script file + jsr Script process the script file + jsr Purge purge the file +; +; Set the various flags +; +sf0 stz list list = false + lda #^flagL if +L then + and pflags+2 + beq sf1 + inc list list = true + +sf1 stz symbols symbols = false + lda #flagS if +S then + and pflags + beq sf2 + inc symbols symbols = true + +sf2 lda #1 express = true + sta express + lda #flagX if -X then + and mflags + beq sf3 + stz express express = false + +sf3 stz pause pause = false + lda #flagW if +W then + and pflags + beq sf4 + inc pause pause = true + +sf4 stz memory memory = false + lda #^flagM if +M then + and pflags+2 + beq sf5 + inc memory memory = true + +sf5 lda #1 compact = true + sta compact + lda #^flagC if -C then + and mflags+2 + beq sf6 + stz compact compact = false + +sf6 stz bankOrg bankOrg = false + lda #^flagB if +B then + and pflags+2 + beq sf7 + inc bankOrg bankOrg = true + +sf7 lda #1 progress = true + sta progress + lda #^flagP if -P then + and mflags+2 + beq sf8 + stz progress progress = false + +sf8 anop +; +; Write the header +; + lda progress + beq wh1 + puts #'Link Editor 2.0.3',cr=t + putcr +wh1 anop +; +; Return to main +; + clc +rts rts + end + +**************************************************************** +* +* NextCh - get the next character from the script +* +* Inputs: +* r0 - ptr to the start of a file +* r4 - length of the file +* eoln - was the last character an eoln? +* +* Outputs: +* A - character read +* eoln - was the last character an eoln? +* r8 - set to the start of any new line +* +* Notes: +* 1. All whitespace characters are converted to spaces. +* 2. A null is returned if there are no more characters +* in the file. +* 3. Comments are skipped +* +**************************************************************** +* +NextCh private + using Common +; +; Check for EOF +; + lda r4 quit if at eof + ora r6 + jeq lb5 +; +; Handle comments +; + lda eoln if eoln then + beq lb3 + stz eoln eoln = false +lb1 lda [r0] if r0[1] in ['*','!',';'] then + and #$FF00 + xba + cmp #'*' + beq lb2 + cmp #'!' + beq lb2 + cmp #';' + bne lb3 +lb2 inc4 r0 skip this line + dec4 r4 + lda r4 + ora r6 + beq lb5 + lda [r0] + and #$00FF + cmp #RETURN + bne lb2 + bra lb1 check for adjacent comments +; +; Return the next character +; +lb3 inc4 r0 next char + dec4 r4 + lda r4 quit if at eof + ora r6 + beq lb5 + lda [r0] A = r0^ + and #$00FF + cmp #RETURN if A = RETURN then + bne lb4 + add4 r0,#1,r8 set the line start + lda #1 eoln = true + sta eoln + inc lineNumber ++lineNumber + lda #' ' return a space + bra lb5 +lb4 cmp #TAB else if A = TAB then + bne lb5 + lda #' ' return a space +lb5 rts + end + +**************************************************************** +* +* Script - read and process a script file +* +* Inputs: +* r0 - ptr to the start of a file +* r4 - length of the file +* mflags,pflags - current file flags +* kname - keep file name +* kflag - keep file flag +* +* Outputs: +* mflags,pflags - file flags +* kname - keep file name +* kflag - keep file flag +* slist - pointer to the file name list +* +**************************************************************** +* +Script private + using Common +; +; Set up the script +; + lda #1 eoln = true {starting a new line} + sta eoln + sta lineNumber current line # = 1 + move4 r0,r8 set the first line pointer + dec4 r0 get the first char (skipping comments) + jsr NextCh +; +; Process flags +; +fl0 jsr SkipBlanks skip leading blanks +fl1 jsr GetCh if GetCh in ['+','-'] then + cmp #'+' + beq fl2 + cmp #'-' + bne pn1 +fl2 sta flagCh save the flag sign + jsr NextCh get the flag character + and #$5F uppercase the character + sec form the flag bit + sbc #'@' + bmi fl4 + tax + stz r12 + stz r14 + sec +fl3 ror r14 + ror r12 + dex + bne fl3 + lda r12 make sure the flag is legal + and #flagAll + bne fl5 + lda r14 + and #^flagAll + bne fl5 +fl4 lda #1 flag an illegal flag error + jmp ScriptError +fl5 jsr NextCh skip the flag character + lda r12 if this flag was set from the CL then + bit pFlags + bne fl0 skip the flag + bit mFlags + bne fl0 + lda r14 + bit pFlags+2 + bne fl0 + bit mFlags+2 + bne fl0 + lda flagCh if flagCh = '+' then + cmp #'+' + bne fl6 + lda r12 pFlags |= r12 + ora pFlags + sta pFlags + lda r14 + ora pFlags+2 + sta pFlags+2 + bra fl0 else +fl6 lda r12 mFlags |= r12 + ora mFlags + sta mFlags + lda r14 + ora mFlags+2 + sta mFlags+2 + brl fl0 get the next flag +; +; Process file names +; +pn1 ph4 slist free the old list + jsr Free + add4 r4,#4,r12 reserve plenty of space for the file list + ph4 r12 + jsr MLalloc + sta slist + stx slist+2 + stz r16 no characters written + add4 slist,#2,r12 set next char pointer +pn2 jsr SkipBlanks skip any blanks + jsr GetCh if at eof then + tax + beq pn6 done + lda r6 if r4 > 5 then + bne pn2a + lda r4 + cmp #6 + blt pn4 +pn2a ldy #4 if r0^ = "keep=" then +pn3 lda [r0],Y + and #$00FF + jsr ToUpper + short M + cmp keep,Y + long M + bne pn4 + dey + bpl pn3 done + bra pn6 +pn4 jsr GetCh while not GetCh in [' ', chr(0)] do + tax + beq pn5 + cmp #' ' + beq pn5 + short M save the character + sta [r12] + long M + inc4 r12 + inc r16 update the line length + jsr NextCh skip to the next character + bra pn4 endwhile +pn5 short M add a trailing space + lda #' ' + sta [r12] + long M + inc4 r12 + inc r16 + bra pn2 next name +pn6 lda r16 set the list length + beq pn7 + dec A +pn7 sta [slist] +; +; Process a keep name +; + lda kname skip this step if we have a kname + ora kname+2 + beq kn0 + lda [kname] + jne kn5 +kn0 jsr NextCh skip the keep name + jsr NextCh + jsr NextCh + jsr NextCh + jsr NextCh +kn1 ph4 kname free the old list + jsr Free + lda #1 kflag = true + sta kflag + add4 r4,#4,r12 reserve plenty of space for the file list + ph4 r12 + jsr MLalloc + sta kname + stx kname+2 + stz r16 no characters written + add4 kname,#2,r12 set next char pointer + jsr GetCh if at eof then + tax + beq kn3 done +kn2 jsr GetCh while not GetCh in [' ', chr(0)] do + tax + beq kn3 + cmp #' ' + beq kn3 + short M save the character + sta [r12] + long M + inc4 r12 + inc r16 update the line length + jsr NextCh skip to the next character + bra kn2 endwhile +kn3 lda r16 set the list length + bne kn4 + lda #2 missing keep name + jmp ScriptError +kn4 sta [kname] + + jsr SkipBlanks skip trailing blanks and comments + jsr GetCh make sure there are no more chars + tax + beq kn5 + lda #3 unknow parameters + jmp ScriptError +kn5 rts +; +; Local data +; +flagCh ds 2 flag character +keep dc c'KEEP=' keep preamble + end + +**************************************************************** +* +* ScriptError - flag an error in a script file +* +* Inputs: +* r0 - ptr to the char where the error occurred +* r4 - # chars left in the script +* r8 - ptr to the start of the line +* A - error number +* +**************************************************************** +* +ScriptError private + using Common + + sta err save the error number + sub4 r0,r8,disp get the disp to the error + add4 r4,disp move back to the start of the line + move4 r8,r0 + put2 lineNumber,#5,errout=t print the line number + putc #' ',errout=t print one space +lb1 jsr GetCh print the line + tax + beq lb2 + sta ch + putc ch,errout=t + jsr NextCh + lda eoln + beq lb1 +lb2 putcr errout=t + add4 disp,#6 print the error pointer +lb3 putc #' ',errout=t + dec4 disp + lda disp + ora disp+2 + bne lb3 + puts #'^ ',errout=t + + dec err print the error message + bne lb4 + puts #'Illegal flag',errout=t,cr=t + bra lb6 +lb4 dec err + bne lb5 + puts #'Missing keep name',errout=t,cr=t + bra lb6 +lb5 dec err + bne lb6 + puts #'Unrecognized parameter',errout=t,cr=t + +lb6 lda #14 stop the link + jmp TermError +; +; Local data +; +ch ds 2 character from script +err ds 2 error number +disp ds 4 # chars to the error + end + +**************************************************************** +* +* SkipBlanks - skip whitespace in a script file +* +**************************************************************** +* +SkipBlanks private + + jsr GetCh + bra lb2 +lb1 jsr NextCh +lb2 tax + beq lb3 + cmp #' ' + beq lb1 +lb3 rts + end + +**************************************************************** +* +* Terminate - do terminal processing +* +**************************************************************** +* +Terminate private + using OutCommon + using Common +; +; Write the link statistics +; + jsr PrintSymbols print the symbol table + + lda list if list then + beq sg1 + jsr PrintSegmentInfo write the segment table + +sg1 lda numError if there are errors then + jeq er3 + putcr errout=t write the error summary + lda numError + dec A + bne er1 + puts #'1 error',errout=t + bra er2 +er1 put2 numError,errout=t + puts #' errors',errout=t +er2 puts #' found during link',cr=t,errout=t + put2 merrf,errout=t + puts #' was the highest error level',cr=t,errout=t + +er3 lda progress if progress or list then + bne er4 + lda list + jeq er5 +er4 putcr write the number, size of segments + puts #'There ' + lda lastLoadNumber + dec A + bne lb1 + puts #'is 1 segment' + bra lb2 +lb1 puts #'are ' + put2 lastLoadNumber + puts #' segments' +lb2 puts #', for a length of $' + ph4 length + ph2 #8 + ph2 #0 + jsr PrintHex + puts #' bytes.',cr=t +er5 anop endif + rts + end diff --git a/linker.mac b/linker.mac old mode 100755 new mode 100644 index a7092ca..b5ff71e --- a/linker.mac +++ b/linker.mac @@ -1 +1,511 @@ - MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND macro &l put2 &n1,&f1,&cr,&errout aif c:&f1,.a lclc &f1 &f1 setc #0 .a &l ~setm ph2 &n1 ph2 &f1 ph2 #c:&cr ph2 #c:&errout jsl ~put2 ~restm mend macro &l puts &n1,&f1,&cr,&errout &l ~setm lclc &c &c amid "&n1",1,1 aif "&c"<>"#",.c aif l:&n1>127,.a bra ~&SYSCNT ago .b .a brl ~&SYSCNT .b &n1 amid "&n1",2,l:&n1-1 ~l&SYSCNT dc i1"l:~s&SYSCNT" ~s&SYSCNT dc c&n1 ~&SYSCNT anop &n1 setc ~l&SYSCNT-1 .c ~pusha &n1 aif c:&f1,.c1 pea 0 ago .c2 .c1 ph2 &f1 .c2 ph2 #c:&cr ph2 #c:&errout jsl ~puts ~restm mend macro &l putc &n1,&f1,&cr,&errout lclc &f1 &f1 setc #0 .a &l ~setm ph2 &n1 aif c:&f1,.a pea 0 ago .b .a ph2 &f1 .b ph2 #c:&cr ph2 #c:&errout jsl ~putc ~restm mend macro &l putcr &errout &l ~setm pea $0D aif c:&errout,.a jsl SysCharOut ~restm mexit .a jsl SysCharErrout ~restm mend macro &l add4 &m1,&m2,&m3 lclb &yistwo lclc &c &l ~setm aif c:&m3,.a &c amid "&m2",1,1 aif "&c"<>"#",.a &c amid "&m1",1,1 aif "&c"="{",.a aif "&c"="[",.a &c amid "&m2",2,l:&m2-1 aif &c>=65536,.a clc ~lda &m1 ~op adc,&m2 ~sta &m1 bcc ~&SYSCNT ~op.h inc,&m1 ~&SYSCNT anop ago .c .a aif c:&m3,.b lclc &m3 &m3 setc &m1 .b clc ~lda &m1 ~op adc,&m2 ~sta &m3 ~lda.h &m1 ~op.h adc,&m2 ~sta.h &m3 .c ~restm mend macro &l sub4 &m1,&m2,&m3 lclb &yistwo lclc &c &l ~setm aif c:&m3,.a &c amid "&m2",1,1 aif "&c"<>"#",.a &c amid "&m1",1,1 aif "&c"="{",.a aif "&c"="[",.a &c amid "&m2",2,l:&m2-1 aif &c>=65536,.a sec ~lda &m1 ~op sbc,&m2 ~sta &m1 bcs ~&SYSCNT ~op.h dec,&m1 ~&SYSCNT anop ago .c .a aif c:&m3,.b lclc &m3 &m3 setc &m1 .b sec ~lda &m1 ~op sbc,&m2 ~sta &m3 ~lda.h &m1 ~op.h sbc,&m2 ~sta.h &m3 .c ~restm mend macro &l dec4 &a &l ~setm lda &a bne ~&SYSCNT dec 2+&a ~&SYSCNT dec &a ~restm mend macro &l inc4 &a &l ~setm inc &a bne ~&SYSCNT inc 2+&a ~&SYSCNT ~restm mend macro &l jcs &bp &l bcc *+5 brl &bp mend macro &l jeq &bp &l bne *+5 brl &bp mend macro &l jne &bp &l beq *+5 brl &bp mend macro &l long &a,&b lclb &i lclb &m &a amid &a,1,1 &m setb ("&a"="M").or.("&a"="m") &i setb ("&a"="I").or.("&a"="i") aif c:&b=0,.a &b amid &b,1,1 &m setb ("&b"="M").or.("&b"="m").or.&m &i setb ("&b"="I").or.("&b"="i").or.&i .a &l rep #&m*32+&i*16 aif .not.&m,.b longa on .b aif .not.&i,.c longi on .c mend macro &l ph2 &n1 &l anop aif "&n1"="*",.f lclc &c &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 lda (&n1) pha ago .e .b aif "&c"="<",.c lda &n1 pha ago .e .c &n1 amid &n1,2,l:&n1-1 pei &n1 ago .e .d &n1 amid &n1,2,l:&n1-1 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l ph4 &n1 &l anop aif "&n1"="*",.f lclc &c &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 ldy #2 lda (&n1),y pha lda (&n1) pha ago .e .b aif "&c"<>"[",.c ldy #2 lda &n1,y pha lda &n1 pha ago .e .c aif "&c"<>"<",.c1 &n1 amid &n1,2,l:&n1-1 pei &n1+2 pei &n1 ago .e .c1 lda &n1+2 pha lda &n1 pha ago .e .d &n1 amid &n1,2,l:&n1-1 pea +(&n1)|-16 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l short &a,&b lclb &i lclb &m &a amid &a,1,1 &m setb ("&a"="M").or.("&a"="m") &i setb ("&a"="I").or.("&a"="i") aif c:&b=0,.a &b amid &b,1,1 &m setb ("&b"="M").or.("&b"="m").or.&m &i setb ("&b"="I").or.("&b"="i").or.&i .a &l sep #&m*32+&i*16 aif .not.&m,.b longa off .b aif .not.&i,.c longi off .c mend macro &l ~lda &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l lda &op mend macro &l ~lda.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" lda &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" lda &op mexit .e lda 2+&op mend macro &l ~op &opc,&op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l &opc &op mend macro &l ~op.h &opc,&op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" &opc &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" &opc &op mexit .e &opc 2+&op mend macro &l ~pusha &n1 lclc &c &l anop &c amid &n1,1,1 aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 sep #$20 longa off lda #0 pha rep #$20 longa on phk lda &n1 pha mexit .b aif "&c"<>"[",.c &n1 amid &n1,2,l:&n1-2 lda &n1+2 pha lda &n1 pha mexit .c pea +(&n1)|-16 pea &n1 mexit .g mnote "Missing closing '}'",16 mend macro &l ~restm &l anop aif (&~la+&~li)=2,.i sep #32*(.not.&~la)+16*(.not.&~li) aif &~la,.h longa off .h aif &~li,.i longi off .i mend macro &l ~setm &l anop aif c:&~la,.b gblb &~la gblb &~li .b &~la setb s:longa &~li setb s:longi aif s:longa.and.s:longi,.a rep #32*(.not.&~la)+16*(.not.&~li) longa on longi on .a mend macro &l ~sta &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l sta &op mend macro &l ~sta.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" sta &op mexit .d sta 2+&op mend \ No newline at end of file + MACRO +&LAB MOVE4 &F,&T +&LAB ~SETM + LDA 2+&F + STA 2+&T + LDA &F + STA &T + ~RESTM + MEND + macro +&l put2 &n1,&f1,&cr,&errout + aif c:&f1,.a + lclc &f1 +&f1 setc #0 +.a +&l ~setm + ph2 &n1 + ph2 &f1 + ph2 #c:&cr + ph2 #c:&errout + jsl ~put2 + ~restm + mend + macro +&l puts &n1,&f1,&cr,&errout +&l ~setm + lclc &c +&c amid "&n1",1,1 + aif "&c"<>"#",.c + aif l:&n1>127,.a + bra ~&SYSCNT + ago .b +.a + brl ~&SYSCNT +.b +&n1 amid "&n1",2,l:&n1-1 +~l&SYSCNT dc i1"l:~s&SYSCNT" +~s&SYSCNT dc c&n1 +~&SYSCNT anop +&n1 setc ~l&SYSCNT-1 +.c + ~pusha &n1 + aif c:&f1,.c1 + pea 0 + ago .c2 +.c1 + ph2 &f1 +.c2 + ph2 #c:&cr + ph2 #c:&errout + jsl ~puts + ~restm + mend + macro +&l putc &n1,&f1,&cr,&errout + lclc &f1 +&f1 setc #0 +.a +&l ~setm + ph2 &n1 + aif c:&f1,.a + pea 0 + ago .b +.a + ph2 &f1 +.b + ph2 #c:&cr + ph2 #c:&errout + jsl ~putc + ~restm + mend + macro +&l putcr &errout +&l ~setm + pea $0D + aif c:&errout,.a + jsl SysCharOut + ~restm + mexit +.a + jsl SysCharErrout + ~restm + mend + macro +&l add4 &m1,&m2,&m3 + lclb &yistwo + lclc &c +&l ~setm + aif c:&m3,.a +&c amid "&m2",1,1 + aif "&c"<>"#",.a +&c amid "&m1",1,1 + aif "&c"="{",.a + aif "&c"="[",.a +&c amid "&m2",2,l:&m2-1 + aif &c>=65536,.a + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m1 + bcc ~&SYSCNT + ~op.h inc,&m1 +~&SYSCNT anop + ago .c +.a + aif c:&m3,.b + lclc &m3 +&m3 setc &m1 +.b + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m3 + ~lda.h &m1 + ~op.h adc,&m2 + ~sta.h &m3 +.c + ~restm + mend + macro +&l sub4 &m1,&m2,&m3 + lclb &yistwo + lclc &c +&l ~setm + aif c:&m3,.a +&c amid "&m2",1,1 + aif "&c"<>"#",.a +&c amid "&m1",1,1 + aif "&c"="{",.a + aif "&c"="[",.a +&c amid "&m2",2,l:&m2-1 + aif &c>=65536,.a + sec + ~lda &m1 + ~op sbc,&m2 + ~sta &m1 + bcs ~&SYSCNT + ~op.h dec,&m1 +~&SYSCNT anop + ago .c +.a + aif c:&m3,.b + lclc &m3 +&m3 setc &m1 +.b + sec + ~lda &m1 + ~op sbc,&m2 + ~sta &m3 + ~lda.h &m1 + ~op.h sbc,&m2 + ~sta.h &m3 +.c + ~restm + mend + macro +&l dec4 &a +&l ~setm + lda &a + bne ~&SYSCNT + dec 2+&a +~&SYSCNT dec &a + ~restm + mend + macro +&l inc4 &a +&l ~setm + inc &a + bne ~&SYSCNT + inc 2+&a +~&SYSCNT ~restm + mend + macro +&l jcs &bp +&l bcc *+5 + brl &bp + mend + macro +&l jeq &bp +&l bne *+5 + brl &bp + mend + macro +&l jne &bp +&l beq *+5 + brl &bp + mend + macro +&l long &a,&b + lclb &i + lclb &m +&a amid &a,1,1 +&m setb ("&a"="M").or.("&a"="m") +&i setb ("&a"="I").or.("&a"="i") + aif c:&b=0,.a +&b amid &b,1,1 +&m setb ("&b"="M").or.("&b"="m").or.&m +&i setb ("&b"="I").or.("&b"="i").or.&i +.a +&l rep #&m*32+&i*16 + aif .not.&m,.b + longa on +.b + aif .not.&i,.c + longi on +.c + mend + macro +&l ph2 &n1 +&l anop + aif "&n1"="*",.f + lclc &c +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + lda (&n1) + pha + ago .e +.b + aif "&c"="<",.c + lda &n1 + pha + ago .e +.c +&n1 amid &n1,2,l:&n1-1 + pei &n1 + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l ph4 &n1 +&l anop + aif "&n1"="*",.f + lclc &c +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + ldy #2 + lda (&n1),y + pha + lda (&n1) + pha + ago .e +.b + aif "&c"<>"[",.c + ldy #2 + lda &n1,y + pha + lda &n1 + pha + ago .e +.c + aif "&c"<>"<",.c1 +&n1 amid &n1,2,l:&n1-1 + pei &n1+2 + pei &n1 + ago .e +.c1 + lda &n1+2 + pha + lda &n1 + pha + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea +(&n1)|-16 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l short &a,&b + lclb &i + lclb &m +&a amid &a,1,1 +&m setb ("&a"="M").or.("&a"="m") +&i setb ("&a"="I").or.("&a"="i") + aif c:&b=0,.a +&b amid &b,1,1 +&m setb ("&b"="M").or.("&b"="m").or.&m +&i setb ("&b"="I").or.("&b"="i").or.&i +.a +&l sep #&m*32+&i*16 + aif .not.&m,.b + longa off +.b + aif .not.&i,.c + longi off +.c + mend + macro +&l ~lda &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l lda &op + mend + macro +&l ~lda.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + lda &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + lda &op + mexit +.e + lda 2+&op + mend + macro +&l ~op &opc,&op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l &opc &op + mend + macro +&l ~op.h &opc,&op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + &opc &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + &opc &op + mexit +.e + &opc 2+&op + mend + macro +&l ~pusha &n1 + lclc &c +&l anop +&c amid &n1,1,1 + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + sep #$20 + longa off + lda #0 + pha + rep #$20 + longa on + phk + lda &n1 + pha + mexit +.b + aif "&c"<>"[",.c +&n1 amid &n1,2,l:&n1-2 + lda &n1+2 + pha + lda &n1 + pha + mexit +.c + pea +(&n1)|-16 + pea &n1 + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l ~restm +&l anop + aif (&~la+&~li)=2,.i + sep #32*(.not.&~la)+16*(.not.&~li) + aif &~la,.h + longa off +.h + aif &~li,.i + longi off +.i + mend + macro +&l ~setm +&l anop + aif c:&~la,.b + gblb &~la + gblb &~li +.b +&~la setb s:longa +&~li setb s:longi + aif s:longa.and.s:longi,.a + rep #32*(.not.&~la)+16*(.not.&~li) + longa on + longi on +.a + mend + macro +&l ~sta &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l sta &op + mend + macro +&l ~sta.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + sta &op + mexit +.d + sta 2+&op + mend diff --git a/linker.notes b/linker.notes old mode 100755 new mode 100644 index ff7c38c..84c6e2f --- a/linker.notes +++ b/linker.notes @@ -1 +1,28 @@ -ORCA/Linker 2.0.3 Copyright 1996, Byte Works Inc. -- Change List -------------------------------------------------------------- 2.0.3 1. Fixed bug that caused programs with more than one dynamic segment to link improperly. (Ian Brumby) 2. Fixed bug that caused approximately one in 65536 load segments to be trashed with a random word placed every 14 bytes through the segment. 2.0.2 1. Fixed bug that caused the linker to step on memory that did not belong to it when the +m flag was used. The most common symptom of this bug was crashing during the second or subsequent compile when using PRIZM. (Kurtis Carter) 2.0.1 1. Fixed bug that caused the current location counter (* in assembly language parlance) to be evaluated incorrectly in some expressions. -- Documentation Update ----------------------------------------------------- No changes. \ No newline at end of file +ORCA/Linker 2.0.3 +Copyright 1996, Byte Works Inc. + +-- Change List -------------------------------------------------------------- + +2.0.3 1. Fixed bug that caused programs with more than one dynamic + segment to link improperly. + + (Ian Brumby) + + 2. Fixed bug that caused approximately one in 65536 load segments + to be trashed with a random word placed every 14 bytes through + the segment. + +2.0.2 1. Fixed bug that caused the linker to step on memory that did + not belong to it when the +m flag was used. The most common + symptom of this bug was crashing during the second or + subsequent compile when using PRIZM. + + (Kurtis Carter) + +2.0.1 1. Fixed bug that caused the current location counter (* in + assembly language parlance) to be evaluated incorrectly in + some expressions. + +-- Documentation Update ----------------------------------------------------- + +No changes. diff --git a/linker.rez b/linker.rez old mode 100755 new mode 100644 index 32261f7..8e907d8 --- a/linker.rez +++ b/linker.rez @@ -1 +1,14 @@ -#include "types.rez" resource rVersion(1) { { 2, /* Major revision */ 0, /* Minor revision */ 3, /* Bug version */ release, /* Release stage */ 0, /* Non-final release # */ }, verUS, /* Region code */ "ORCA/Linker", /* Short version number */ "Copyright 1996, Byte Works, Inc." /* Long version number */ }; \ No newline at end of file +#include "types.rez" + +resource rVersion(1) { + { + 2, /* Major revision */ + 0, /* Minor revision */ + 3, /* Bug version */ + release, /* Release stage */ + 0, /* Non-final release # */ + }, + verUS, /* Region code */ + "ORCA/Linker", /* Short version number */ + "Copyright 1996, Byte Works, Inc." /* Long version number */ + }; diff --git a/linkit b/linkit old mode 100755 new mode 100644 index 365d5da..78442a9 --- a/linkit +++ b/linkit @@ -1 +1,6 @@ -echo set auxtype $DB01 set auxtype $DB01 set list obj/linker obj/util obj/file obj/pass1 obj/pass2 obj/seg obj/symbol obj/exp obj/out echo link {Parameters} {list} 13/SysLib keep=obj/linker link {Parameters} {list} 13/SysLib keep=obj/linker \ No newline at end of file +echo set auxtype $DB01 +set auxtype $DB01 + +set list obj/linker obj/util obj/file obj/pass1 obj/pass2 obj/seg obj/symbol obj/exp obj/out +echo link {Parameters} {list} 13/SysLib keep=obj/linker +link {Parameters} {list} 13/SysLib keep=obj/linker diff --git a/make b/make old mode 100755 new mode 100644 index 27bcfaa..56ac4bd --- a/make +++ b/make @@ -1 +1,83 @@ -* * Linker * unset exit Newer obj/linker linker.rez if {status} != 0 set exit on echo compile -e linker.rez keep=obj/linker compile -e linker.rez keep=obj/linker unset exit end if {#} == 0 then Newer obj/linker.a linker.asm linker.macros directPage if {Status} != 0 set linker linker end Newer obj/util.a util.asm util.macros directPage if {Status} != 0 set util util end Newer obj/file.a file.asm file.macros directPage if {Status} != 0 set file file end Newer obj/pass1.a pass1.asm pass1.macros directPage if {Status} != 0 set pass1 pass1 end Newer obj/pass2.a pass2.asm pass2.macros directPage if {Status} != 0 set pass2 pass2 end Newer obj/seg.a seg.asm seg.macros directPage if {Status} != 0 set seg seg end Newer obj/symbol.a symbol.asm symbol.macros directPage if {Status} != 0 set symbol symbol end Newer obj/exp.a exp.asm exp.macros directPage if {Status} != 0 set exp exp end Newer obj/out.a out.asm out.2 out.macros directPage if {Status} != 0 set out out end set exit on for i in {linker} {util} {file} {pass1} {pass2} {seg} {symbol} {exp} {out} echo assemble +t +e {i}.asm assemble +t +e {i}.asm end else set exit on for i echo assemble +t +e {i}.asm assemble +t +e {i}.asm end end linkit set echo on copy -c obj/linker 5 \ No newline at end of file +* +* Linker +* + +unset exit + +Newer obj/linker linker.rez +if {status} != 0 + set exit on + echo compile -e linker.rez keep=obj/linker + compile -e linker.rez keep=obj/linker + unset exit +end + +if {#} == 0 then + + Newer obj/linker.a linker.asm linker.macros directPage + if {Status} != 0 + set linker linker + end + + Newer obj/util.a util.asm util.macros directPage + if {Status} != 0 + set util util + end + + Newer obj/file.a file.asm file.macros directPage + if {Status} != 0 + set file file + end + + Newer obj/pass1.a pass1.asm pass1.macros directPage + if {Status} != 0 + set pass1 pass1 + end + + Newer obj/pass2.a pass2.asm pass2.macros directPage + if {Status} != 0 + set pass2 pass2 + end + + Newer obj/seg.a seg.asm seg.macros directPage + if {Status} != 0 + set seg seg + end + + Newer obj/symbol.a symbol.asm symbol.macros directPage + if {Status} != 0 + set symbol symbol + end + + Newer obj/exp.a exp.asm exp.macros directPage + if {Status} != 0 + set exp exp + end + + Newer obj/out.a out.asm out.2 out.macros directPage + if {Status} != 0 + set out out + end + + set exit on + + for i in {linker} {util} {file} {pass1} {pass2} {seg} {symbol} {exp} {out} + echo assemble +t +e {i}.asm + assemble +t +e {i}.asm + end + +else + + set exit on + + for i + echo assemble +t +e {i}.asm + assemble +t +e {i}.asm + end + +end + +linkit + +set echo on +copy -c obj/linker 5 diff --git a/out.asm b/out.asm old mode 100755 new mode 100644 index f15e2ce..c7ee0f4 --- a/out.asm +++ b/out.asm @@ -1 +1,3147 @@ - keep obj/out mcopy out.mac **************************************************************** * * Ouput Module * * This module handles writing the output file and locating the * proper load segment for code segments. * **************************************************************** copy directPage **************************************************************** * * OutCommon - global data for the segment module * **************************************************************** * OutCommon data ; ; Constants ; nameSize equ 10 size of a load segment name dictGrowSize equ 4096 grow size for the dictionary buffer dynGrowSize equ 1024 grow size for synamic segment buffer ; ; global variables ; expressSegment ds 2 express segment number keepRefnum ds 2 keep file reference number lastLoadNumber ds 4 last load number allocated loadList ds 4 head of load segment list loadNamePtr ds 4 pointer to the name of the load segment ; ; Dynamic segment information ; dynHandle ds 4 handle of the dynamic segment buffer dynSize ds 2 bytes left in the buffer dynBuffSize ds 4 total memory in the segment buffer dynStart ds 4 ptr to the start of the buffer dynSegment ds 2 dynamic segment number ; ; Current load segment information ; loadNext ds 4 pointer to the next load segment loadLast ds 4 pointer to the last load segment loadPtr ds 4 pointer to the storage location for this record loadNumber ds 2 number of this load segment loadType ds 2 load segment type loadORG ds 4 load segment origin loadAlign ds 4 load segment aligment loadBankSize ds 4 load segment bank size loadName ds nameSize name of the load segment loadSeg ds 4 handle of the segment buffer loadSegStart ds 4 start of the segment buffer loadPC ds 4 size of the load segment loadOp ds 4 op disp for the segment buffer loadOpSt ds 4 op at start of current lConst loadDict ds 4 handle of the dictionary buffer loadDictStart ds 4 start of the dictionary buffer loadDictSize ds 2 bytes left in the dictionary buffer loadDp ds 4 dp disp for the dictionary buffer loadPass2 ds 2 are we ready for pass 2? loadEnd anop end of the record loadSize equ loadEnd-loadNext size of a load module record (even!) end **************************************************************** * * AddEnd - add an end record to the dictionary * * Inputs: * loadNext... - load segment record * **************************************************************** * AddEnd private using OutCommon lda loadDictSize make sure there is room in the dictionary bne lb1 jsr ExpandDictBuffer lb1 short M save the end marker lda #0 sta [dp] long M inc4 dp update dp dec loadDictSize update loadDictSize rts end **************************************************************** * * AddSegment - add a segment to the expressload table * * Inputs: * r8 - pointer to the segment to add * r4,r8 - expressload list pointers * expOffset - segment offset pointer * expMap - segment map pointer * expHeader - segment header map * expressSegment - express segment number * **************************************************************** * AddSegment private using OutCommon jsr MoveSegment move the segment ot the new list sub4 expHeader,expOffset,r12 set the segment offset lda r12 sta [expOffset] ldy #6 zero the reserved words lda #0 lb1 sta [expOffset],Y dey dey bne lb1 add4 expOffset,#8 update the offset pointer ldy #loadNumber-loadNext get the old segment number lda [r4],Y dec A set it's mapped segment asl A tay lda expressSegment sta [expMap],Y ldy #loadNumber-loadNext set the new segment number sta [r4],Y inc expressSegment update segment number add4 fMark,#69+5 allow for the segment header & lconst move4 fMark,mark1 set the lconst mark ldy #loadPC-loadNext find the segment size lda [r4],Y sta len1 iny iny lda [r4],Y sta len1+2 add4 fMark,len1 allow for the segment body move4 fMark,mark2 set the reloc mark ldy #loadDp-loadNext find the reloc size lda [r4],Y sta len2 iny iny lda [r4],Y sta len2+2 ora len2 if len2 = 0 then bne lb1a stz mark2 mark2 = 0 stz mark2+2 lb1a add4 fMark,len2 allow for the dictionary inc4 fMark allow for the end mark ldy #loadBankSize-loadNext set the bank size lda [r4],Y sta bankSize iny iny lda [r4],Y sta bankSize+2 ldy #loadType-loadNext set the segment type lda [r4],Y sta kind ldy #loadOrg-loadNext set the origin lda [r4],Y sta org iny iny lda [r4],Y sta org+2 ldy #loadAlign-loadNext set the alignment factor lda [r4],Y sta align iny iny lda [r4],Y sta align+2 ldy #loadNumber-loadNext set the segment number lda [r4],Y sta segNum ldx #nameSize-2 set the segment name ldy #loadName-loadNext+nameSize-2 lb2 lda [r4],Y sta name,X dey dey dex dex bpl lb2 ldy #segEnd-mark1-1 move the header to the express segment short M lb3 lda mark1,Y sta [expHeader],Y dey bpl lb3 long M add4 expHeader,#69 update the segment header pointer rts mark1 ds 4 lConst file mark len1 ds 4 lConst length mark2 ds 4 reloc file mark len2 ds 4 reloc length dc i1'0' undefined dc i1'0' label length dc i1'4' number length dc i1'2' version bankSize ds 4 bank size kind ds 2 segment type dc i'0' undefined org ds 4 origin align ds 4 alignment dc i1'0' numsex dc i1'0' undefined segNum ds 2 segment number dc i4'0' segment entry dc i'lname-len1' disp to name dc i'segend-mark1' disp to body lname dc 10c' ' load name dc i1'10' segment name length name ds 10 segment name segend anop end **************************************************************** * * CheckHeader - check the header parameters * * Inputs: * segOrg - origin for this segment * segAlign - alignment for this segment * segType - type for this segment * segBanksize - banksize for this segment * loadType - load segment type * loadORG - load segment origin * loadAlign - load segment aligment * loadBankSize - load segment bank size * * Outputs: * loadType - load segment type * loadORG - load segment origin * loadAlign - load segment aligment * loadBankSize - load segment bank size * **************************************************************** * CheckHeader private using OutCommon using Common ; ; Set the load segment type ; lda loadPC if at the start of the segment then ora loadPC+2 bne st1 lda segType use segType and #$FEFF sta loadType bra st4 else st1 lda segType or in the or flags and #$1D00 ora loadType sta loadType lda segType mask out missing and flags and #$E200 ora #$3DFF and loadType sta loadType lda loadType get the type without flags and #$007F sta r0 lda segType and #$007F cmp r0 if they do not match then beq st4 cmp #1 if seg is data then bne st2 lda r0 if not load in [code,init,dp] then beq st4 cmp #$10 beq st4 cmp #$12 beq st4 err15 ph4 #0 flag segment conflict ph2 #15 jsr Error bra st4 st2 cmp #0 else if seg in [code,init,dp] then beq st3 cmp #$10 beq st3 cmp #$12 bne err15 st3 lda r0 if load = data then cmp #1 bne err15 lda loadType use seg type and #$FF00 sta loadType lda segType and #$007F ora loadType sta loadType ! else flag the error st4 anop endif lda bankOrg if bankOrg then beq st5 lda loadType bank org the program ora #$0100 sta loadType st5 anop endif ; ; Set the load segment origin (pass 1) ; lda pass branch if pass 2 cmp #2 beq or0 lda segOrg skip if org is 0 ora segOrg+2 jeq or4 lda loadPC if at the start of the segment then ora loadPC+2 ora loadOrg ora loadOrg+2 bne po1 move4 segOrg,loadOrg loadOrg = segOrg bra po3 else po1 sub4 segOrg,loadOrg,r0 update the pc lda r2 bmi po3 cmpl r0,pc blt po3 move4 r0,pc po3 anop endif bra or4 ; ; Set the load segment origin (pass 2) ; or0 lda segOrg skip if org is 0 ora segOrg+2 beq or4 lda loadPC if at the start of the segment then ora loadPC+2 ora loadOrg ora loadOrg+2 bne or1 move4 segOrg,loadOrg loadOrg = segOrg bra or3 else or1 sub4 segOrg,loadOrg,r0 update the pc sub4 r0,pc lda r2 bpl or2 if disp is negative then ph4 #0 Error(NULL,3) ph2 #3 jsr Error bra or3 else or2 lda r0 define DS bytes to fill space ora r2 beq or3 jsr DefineDS or3 anop endif jsr CheckAlignOrg check for conflicts between align,org or4 anop ; ; Set the load segment alignment (pass 1) ; lda pass branch if pass 2 cmp #2 beq sa0 lda segAlign skip if alignment is 0 ora segAlign+2 jeq sa4 lda loadPC if at the start of the segment then ora loadPC+2 ora loadAlign ora loadAlign+2 bne la1 move4 segAlign,loadAlign loadAlign = segAlign bra la2 else la1 move4 segAlign,r0 PrepareAlign(segAlign) jsr PrepareAlign la2 anop endif bra sa4 ; ; Set the load segment alignment (pass 2) ; sa0 lda segAlign skip if alignment is 0 ora segAlign+2 beq sa4 ph4 segAlign make sure the align is a power of 2 jsr CheckAlign lda loadPC if at the start of the segment then ora loadPC+2 ora loadAlign ora loadAlign+2 bne sa1 move4 segAlign,loadAlign loadAlign = segAlign bra sa3 else sa1 cmpl loadAlign,segAlign if loadAlign < segAlign then bge sa2 ph4 #0 Error(NULL,22) ph2 #22 jsr Error bra sa3 else sa2 move4 segAlign,r0 DefineAlign(segAlign) jsr DefineAlign ! anop endif sa3 anop endif jsr CheckAlignOrg check for conflicts between align,org sa4 anop ; ; Set the load segment bank size ; lda pass branch if pass 2 cmp #2 beq rt1 lda loadBankSize if loadBanksize = 0 ora loadBanksize+2 beq bs1 cmpl segBanksize,loadBanksize or ((segBanksize < loadBanksize) bge bs2 and (segBanksize <> 0)) then lda segBanksize ora segBanksize+2 beq bs2 bs1 move4 segBankSize,loadBankSize loadBankSize = segBankSize bs2 anop rt1 rts ; ; CheckAlignOrg - make sure the align and org do not conflict ; CheckAlignOrg anop lda loadAlign if loadAlign <> 0 then ora loadAlign+2 beq ca2 sub4 loadAlign,#1,r0 if loadOrg & (loadAlign-1) then lda r0 and loadOrg bne ca1 lda r2 and loadOrg+2 beq ca2 ca1 ph4 #0 Error(NULL,21) ph2 #21 jsr Error ca2 rts end **************************************************************** * * CompactCInterseg - compact a cInterseg record * * Inputs: * r0 - ptr to the cInterseg record * r4 - ptr to the end of the dictionary * dp - ptr to the next free byte in the dictionary * **************************************************************** * CompactCInterseg private using Common using OutCommon ; ; See if the record can be compacted ; lda [r0] length must be 2 or 3 xba and #$00FF cmp #2 beq ck1 cmp #3 jne nc1 ck1 sta length cmp #3 if length = 3 then bne ck2 ldy #2 shift count must be 0 lda [r0],Y and #$00FF jne nc1 stz shift lda #2 set the record type sta recordType ldy #5 set the segment number lda [r0],Y and #$00FF sta segment bra ck3 else {if length = 2 then} ck2 ldy #5 segment number must be <= 12 lda [r0],Y and #$00FF sta segment cmp #13 jge nc1 ldx express if express then beq ck2a cmp #12 don't use 12, either jeq nc1 ck2a clc set the record type for shift 0 lda segment adc #13 sta recordType ldy #2 shift must be 0 or -16 lda [r0],Y and #$00FF sta shift beq ck3 cmp #$00F0 jne nc1 add2 recordType,#12 set the record type for shift -16 ck3 anop ; ; Create a Super record ; lda #13 create the record header cmp loadDictSize make sure there is room in the blt sp1 dictionary jsr ExpandDictBuffer sp1 add4 dp,#1,recordLengthPtr save a pointer to the length field sub4 recordLengthPtr,loadDictStart short M set the op code lda #$F7 sta [dp] ldy #5 set the super record type lda recordType sta [dp],Y long M add4 dp,#6 skip the super record header sub2 loadDictSize,#6 ldy #4 set the segment offset page lda [r0],Y and #$00FF sta page beq pg3 if page <> 0 then sta r12 while (r12 := page) > $7F do pg1 lda r12 cmp #$80 blt pg2 short M write a skip page for $7F pages lda #$FF sta [dp] long M inc4 dp dec loadDictSize sub2 r12,#$7F r12 -= $7F bra pg1 endwhile pg2 lda r12 if r12 <> 0 then beq pg3 short M write a skip page for r12 pages ora #$80 sta [dp] long M inc4 dp dec loadDictSize pg3 anop move4 dp,r12 initialize the page counter short M lda #$FF sta [r12] long M inc4 dp skip the page counter dec loadDictSize move4 r0,r8 for each dictionary record do sp2 cmpl r8,r4 jeq sp14 lda [r8] if it is a Reloc then and #$00FF cmp #$E2 bne sp3 add4 r8,#11 skip the record bra sp2 loop sp3 cmp #$75 if it is a skipped cReloc or beq sp4 cReloc then cmp #$F5 bne sp5 sp4 add4 r8,#7 skip the record bra sp2 loop sp5 cmp #$76 if it is a skipped cInterseg then bne sp6 add4 r8,#8 skip the record bra sp2 loop sp6 cmp #$E3 if it is an Interseg then bne sp7 add4 r8,#15 skip the record bra sp2 loop sp7 ldy #2 if the cInterseg is a different type short M then lda [r8],Y cmp shift bne sp7a dey lda [r8],Y cmp length bne sp7a cmp #3 beq sp8 ldy #5 lda [r8],Y cmp segment beq sp8 sp7a long M skip the record add4 r8,#8 brl sp2 loop sp8 long M make sure there is room in the lda #5 dictionary cmp loadDictSize blt sp9 sub4 r12,loadDictStart jsr ExpandDictBuffer add4 r12,loadDictStart sp9 short M if r8^.page <> page then sec ldy #4 lda [r8],Y sbc page beq sp13 dec A if r8^.page - page > 1 then beq sp12 sp10 cmp #$80 record a page skip blt sp11 tax lda #$FF sta [dp] long M inc4 dp dec loadDictSize short M txa sec sbc #$7F bra sp10 sp11 cmp #0 beq sp12 ora #$80 sta [dp] long M inc4 dp dec loadDictSize short M sp12 ldy #4 record the new page lda [r8],Y sta page lda #$FF set up a record count sta [dp] long M move4 dp,r12 inc4 dp dec loadDictSize short M sp13 lda [r12] increment the record count inc A sta [r12] ldy #3 set the offset lda [r8],Y sta [dp] long M inc4 dp dec loadDictSize short M mark the record lda [r8] and #$7F sta [r8] long M add4 r8,#8 skip the record brl sp2 loop sp14 anop set the super record length add4 recordLengthPtr,loadDictStart,r12 sub4 dp,r12,recordLengthPtr sub4 recordLengthPtr,#4 ldy #2 lda recordLengthPtr sta [r12] lda recordLengthPtr+2 sta [r12],Y rts ; ; Cannot compact - put the unchanged record in the dictionary ; nc1 lda #8 make sure there is room in the cmp loadDictSize dictionary blt nc2 jsr ExpandDictBuffer nc2 ldy #6 move the record nc3 lda [r0],Y sta [dp],Y dey dey bpl nc3 add4 dp,#8 skip the record sub2 loadDictSize,#8 add4 r0,#8 rts ; ; Local data ; recordLengthPtr ds 4 pointer to the super record length field page ds 2 current cReloc page number length ds 2 length of the cReloc fields shift ds 2 shift count segment ds 2 segment number recordType ds 2 type of the Super record end **************************************************************** * * CompactCReloc - compact a cReloc record * * Inputs: * r0 - ptr to the cReloc record * r4 - ptr to the end of the dictionary * dp - ptr to the next free byte in the dictionary * **************************************************************** * CompactCReloc private using OutCommon ; ; See if the record can be compacted ; lda [r0] length must be 2 or 3 xba and #$00FF cmp #2 beq ck1 cmp #3 jne nc1 ck1 sta length ldy #2 shift count must be 0 lda [r0],Y and #$00FF jne nc1 ; ; Create a Super record ; lda #13 create the record header cmp loadDictSize make sure there is room in the blt sp1 dictionary jsr ExpandDictBuffer sp1 add4 dp,#1,recordLengthPtr save a pointer to the length field sub4 recordLengthPtr,loadDictStart short M set the op code lda #$F7 sta [dp] ldy #5 set the super record type lda length and #$01 sta [dp],Y long M add4 dp,#6 skip the super record header sub2 loadDictSize,#6 ldy #4 set the segment offset page lda [r0],Y and #$00FF sta page beq pg3 if page <> 0 then sta r12 while (r12 := page) > $7F do pg1 lda r12 cmp #$80 blt pg2 short M write a skip page for $7F pages lda #$FF sta [dp] long M inc4 dp dec loadDictSize sub2 r12,#$7F r12 -= $7F bra pg1 endwhile pg2 lda r12 if r12 <> 0 then beq pg3 short M write a skip page for r12 pages ora #$80 sta [dp] long M inc4 dp dec loadDictSize pg3 anop move4 dp,r12 initialize the page counter short M lda #$FF sta [r12] long M inc4 dp skip the page counter dec loadDictSize move4 r0,r8 for each dictionary record do sp2 cmpl r8,r4 jeq sp14 lda [r8] if it is a Reloc then and #$00FF cmp #$E2 bne sp3 add4 r8,#11 skip the record bra sp2 loop sp3 cmp #$75 if it is a skipped cReloc then bne sp4 add4 r8,#7 skip the record bra sp2 loop sp4 cmp #$F6 if it is a cInterseg or skipped beq sp5 cInterseg then cmp #$76 bne sp6 sp5 add4 r8,#8 skip the record bra sp2 loop sp6 cmp #$E3 if it is an Interseg then bne sp7 add4 r8,#15 skip the record bra sp2 loop sp7 ldy #1 if the cReloc is a different type then lda [r8],Y cmp length (checks length and shift=0) beq sp8 add4 r8,#7 skip the record bra sp2 loop sp8 lda #5 make sure there is room in the cmp loadDictSize dictionary blt sp9 sub4 r12,loadDictStart jsr ExpandDictBuffer add4 r12,loadDictStart sp9 short M if r8^.page <> page then sec ldy #4 lda [r8],Y sbc page beq sp13 dec A if r8^.page - page > 1 then beq sp12 sp10 cmp #$80 record a page skip blt sp11 tax lda #$FF sta [dp] long M inc4 dp dec loadDictSize short M txa sec sbc #$7F bra sp10 sp11 cmp #0 beq sp12 ora #$80 sta [dp] long M inc4 dp dec loadDictSize short M sp12 ldy #4 record the new page lda [r8],Y sta page lda #$FF set up a record count sta [dp] long M move4 dp,r12 inc4 dp dec loadDictSize short M sp13 lda [r12] increment the record count inc A sta [r12] ldy #3 set the offset lda [r8],Y sta [dp] long M inc4 dp dec loadDictSize short M mark the record lda [r8] and #$7F sta [r8] long M add4 r8,#7 skip the record brl sp2 loop sp14 anop set the super record length add4 recordLengthPtr,loadDictStart,r12 sub4 dp,r12,recordLengthPtr sub4 recordLengthPtr,#4 ldy #2 lda recordLengthPtr sta [r12] lda recordLengthPtr+2 sta [r12],Y rts ; ; Cannot compact - put the unchanged record in the dictionary ; nc1 lda #8 make sure there is room in the cmp loadDictSize dictionary blt nc2 jsr ExpandDictBuffer nc2 ldy #6 move the record nc3 lda [r0],Y sta [dp],Y dey dey bpl nc3 add4 dp,#7 skip the record sub2 loadDictSize,#7 add4 r0,#7 rts ; ; Local data ; recordLengthPtr ds 4 pointer to the super record length field page ds 2 current cReloc page number length ds 2 length of the cReloc fields end **************************************************************** * * CompactSegment - compact a single segment * * Inputs: * LoadNext... - segment record * **************************************************************** * CompactSegment private using OutCommon using Common lda loadDict if there is no dictionary then ora loadDict+2 bne lb1 rts return lb1 move4 loadDict,dictHandle save the dictionary handle move4 loadDictStart,r0 get a pointer to the dictionary move4 dp,r4 get a pointer to the dictionary end stz loadDictStart zero the current load dictionary stz loadDictStart+2 stz loadDict stz loadDict+2 stz loadDp stz loadDp+2 stz dp stz dp+2 stz loadDictSize stz loadDictSize+2 lb2 cmpl r0,r4 for each dictionary entry do jeq lb12 lda [r0] if r0^ = cReloc then and #$00FF cmp #$00F5 bne lb3 jsr CompactCReloc compact the record bra lb2 loop lb3 cmp #$75 if r0^ = skipped cReloc then bne lb4 add4 r0,#7 skip the record bra lb2 loop lb4 cmp #$E2 if r0^ = Reloc then bne lb7 lda #12 make sure there is room in the cmp loadDictSize dictionary blt lb5 jsr ExpandDictBuffer lb5 ldy #10 move the record lb6 lda [r0],Y sta [dp],Y dey dey bpl lb6 add4 dp,#11 skip the record sub2 loadDictSize,#11 add4 r0,#11 bra lb2 loop lb7 cmp #$F6 if r0^ = cInterseg then bne lb8 jsr CompactCInterseg compact the record bra lb2 loop lb8 cmp #$76 if r0^ = skipped cInterseg then bne lb9 add4 r0,#8 skip the record brl lb2 loop ! (condition must be true) if r0^ = Interseg then lb9 lda #16 make sure there is room in the cmp loadDictSize dictionary blt lb10 jsr ExpandDictBuffer lb10 ldy #14 move the record lb11 lda [r0],Y sta [dp],Y dey dey bpl lb11 add4 dp,#15 skip the record sub2 loadDictSize,#15 add4 r0,#15 brl lb2 loop lb12 ph4 dictHandle free the old dictionary buffer _DisposeHandle rts dictHandle ds 4 old dictionary handle end **************************************************************** * * CreateDynamicSegment - create the dynamic segment (if any) * * Inputs: * dynSegment - dynmaic segment number; 0 if none * dynStart - start of the dynamic segment * dy - next byte in the buffer * **************************************************************** * CreateDynamicSegment private using OutCommon lda dynSegment quit if there is no segment bne lb0 rts lb0 lda dynSize write the trailing 4 bytes cmp #4 bge lb1 jsr ExpandDynamicBuffer lb1 ldy #2 lda #0 sta [dy] sta [dy],Y add4 dy,#4 sub4 dy,dynStart,r0 set the size of the lConst sub4 r0,#5 move4 dynStart,r4 lda #$F2 sta [r4] ldy #1 lda r0 sta [r4],Y iny iny lda r2 sta [r4],Y move #0,loadNext,#loadSize clear all entries lda dynSegment set the segment number sta loadNumber lda #2 set the segment type sta loadType lla loadBankSize,$10000 set the load segment bank size move jumpName,loadName,#nameSize set the segment name move4 dynHandle,loadSeg set the segment buffer handle move4 dynStart,loadSegStart set the load segment start sub4 dy,dynStart,loadPc set the segment size sub4 loadPc,#5 move4 loadPc,pc move4 dy,op set the segment pointer sub4 dy,dynStart,loadOp set the segment displacement inc loadPass2 ready for pass 2 stz dp no dictionary pointer stz dp+2 jsr SaveSegment rts jumpName dc c'~JumpTable' end **************************************************************** * * CreateFile - make sure an output file exists * * Inputs: * kname - keep file name * **************************************************************** * CreateFile private using OutCommon move4 kname,giPathname see if a file exists OSGet_File_Info giRec bcs lb1 lda giFiletype yes -> make sure it is an OBJ file cmp #$B3 blt err7 cmp #$BF+1 bge err7 rts lb1 move4 kname,crPathname no file exists, so create one OSCreate crRec bcs err12 rts err12 lda #12 file write error jmp TermError err7 lda #7 Could not overwrite existing file jmp TermError ; ; Local data ; giRec dc i'3' GetFileInfo record giPathname ds 4 ds 2 giFiletype ds 2 crRec dc i'4' crPathname ds 4 dc i'$C3' dc i'EXE' dc i4'$0100' end **************************************************************** * * DecimalVariable - convert an OS string to a decimal value * * Inputs: * r0 - pointer to the shell variable value * * Outputs: * C - set if all characters are digits, else clear * X-A - value (if C set); least sig. 32 bits only * **************************************************************** * DecimalVariable private lda [r0] get a loop counter sta r12 stz r8 set the initial value stz r10 add4 r0,#2,r4 get a character pointer lb1 lda [r4] if the character is not a digit then and #$00FF return false cmp #'0' blt lb3 cmp #'9'+1 bge lb3 mul4 r8,#10 r8 = r8*10 + value(r4^) lda [r4] and #$000F clc adc r8 sta r8 bcc lb2 inc r10 lb2 inc4 r4 loop dec r12 bne lb1 lda r8 return value ldx r10 sec rts lb3 clc return false rts end **************************************************************** * * DoCompact - compact the dictionaries * **************************************************************** * DoCompact private using OutCommon using Common jsr SaveSegment save the current segment lda #1 set the segment number sta segment lb1 move4 loadList,r0 find the proper segment lb2 ldy #loadNumber-loadNext lda [r0],Y cmp segment bne lb3 jsr GetSegment get the segment jsr CompactSegment compact the segment jsr SaveSegment save the segment inc segment next segment bra lb1 start the search over lb3 ldy #2 next segment pointer lda [r0],Y tax lda [r0] sta r0 stx r2 ora r2 bne lb2 move4 loadList,r0 done - get a segment back jsr GetSegment rts return segment ds 2 segment number end **************************************************************** * * DynamicCheck - if any segment is dynamic, set up a jump table * * Inputs: * loadList - list of current load segments * loadNext... - active load segment * lastLoadNumber - last load number allocated * * Outputs: (if there is a dynamic segment) * dynHandle - handle of the synamic segment * dynStart - start of the dynamic segment * dynSize - size of the dynamic segment * dy - pointer to the next spot in the dynamic segment * dynSegment - dynamic segment number * **************************************************************** * DynamicCheck start using OutCommon ; ; See if any segment is dynamic ; lda loadType check the current segment bmi pr1 move4 loadList,r0 check the segments in the segment list cs1 lda r0 ora r2 beq cs2 ldy #loadType-loadNext lda [r0],Y bmi pr1 ldy #2 lda [r0],Y tax lda [r0] sta r0 stx r2 bra cs1 cs2 rts ; ; Prepare for dynamic segment output ; pr1 stz dy zero the pointer stz dy+2 stz dynSize zero the size stz dynBuffSize no memory in the buffer stz dynBuffSize+2 stz dynHandle no handle, yet stz dynHandle+2 stz dynStart initialize the field stz dynStart+2 jsr ExpandDynamicBuffer get an initial buffer add4 dy,#5 create space for the lConst opcode ldy #6 insert the 8 leading zeros lda #0 pr2 sta [dy],Y dey dey bpl pr2 sub2 dynSize,#13 add4 dy,#8 lda lastLoadNumber get a segment number inc A sta lastLoadNumber sta dynSegment rts end **************************************************************** * * ExpandDictBuffer - expand the dictionary buffer * * Inputs: * loadDict - handle of the dictionary buffer, nil for none * loadDictSize - size of the dictionary buffer * * Outputs: * loadDict - handle of the dictionary buffer * loadDictStart - start of the dictionary buffer * loadDictSize - size of the dictionary buffer * dp - start of the dictionary buffer * * Notes: * Other than dp, direct page is not disturbed. * **************************************************************** * ExpandDictBuffer start using Common using OutCommon lda loadDict if there is no buffer then ora loadDict+2 bne lb1 la loadDictSize,dictGrowSize set the dictionary size pha get a new buffer pha ph4 #dictGrowSize ph2 userID ph2 #$8000 ph4 #0 _NewHandle jcs oom pl4 loadDict stz loadDP loadDP = 0 stz loadDP+2 brl lb2 else lb1 sub4 dp,loadDictStart,loadDP get the displacement ph4 loadDict unlock the handle _HUnlock pha get the current handle size pha ph4 loadDict _GetHandleSize clc set the new size lda 1,S adc #dictGrowSize sta 1,S lda 3,S adc #^dictGrowSize sta 3,S ph4 loadDict expand the buffer _SetHandleSize bcs oom ph4 loadDict lock the handle _HLock add2 loadDictSize,#dictGrowSize update the free space lb2 anop endif move4 loadDict,dp dereference the handle ldy #2 lda [dp] sta loadDictStart lda [dp],Y sta loadDictStart+2 add4 loadDictStart,loadDP,dp set dp rts oom lda #5 jmp TermError end **************************************************************** * * ExpandDynamicBuffer - expand the dynamic segment buffer * * Inputs: * dynHandle - handle of the buffer, nil for none * dynBuffSize - size of the buffer * synSize - bytes left in the current buffer * dy - pointer to the current buffer * dynStart - start of the buffer * * Outputs: * dynHandle - handle of the buffer, nil for none * dynBuffSize - size of the buffer * synSize - bytes left in the current buffer * dy - pointer to the current buffer * dynStart - start of the buffer * **************************************************************** * ExpandDynamicBuffer private using Common using OutCommon lda dynHandle if there is no buffer then ora dynHandle+2 bne lb1 pha get a new buffer pha ph4 #dynGrowSize ph2 userID ph2 #$8000 ph4 #0 _NewHandle jcs oom pl4 dynHandle lla dynBuffSize,dynGrowSize set the size bra lb2 else lb1 ph4 loadDict unlock the handle _HUnlock add4 dynBuffSize,#dynGrowSize get the new size ph4 dynBuffSize set the new size ph4 dynHandle expand the buffer _SetHandleSize bcs oom ph4 dynHandle lock the handle _HLock lb2 anop endif add2 dynSize,#dynGrowSize update the free space sub4 dy,dynStart convert dy to a displacement move4 dynHandle,r0 dereference the handle ldy #2 lda [r0] sta dynStart lda [r0],Y sta dynStart+2 add4 dy,dynStart set dy rts oom lda #5 jmp TermError end **************************************************************** * * ExpressLoad - Handle express loading * * Inputs: * express - is the program express loaded? * **************************************************************** * ExpressLoad private using OutCommon using Common ; ; Sort the segments by number ; lda #1 set the initial segment number sta expressSegment stz r0 nothing in the output list stz r2 sn1 move4 loadList,r8 for each segment number sn2 lda r8 for each segment ora r10 beq sn4 ldy #loadNumber-loadNext if this is the right segment then lda [r8],Y cmp expressSegment bne sn3 jsr MoveSegment move the segment to the new list bra sn4 sn3 ldy #2 next segment lda [r8],Y tax lda [r8] sta r8 stx r10 bra sn2 sn4 inc expressSegment next segment number lda loadList ora loadList+2 bne sn1 move4 r0,loadList replace the list ; ; Build the expressload segment ; pha get memory for the lConst record pha mul4 lastLoadNumber,#79,r0 add4 r0,#7 ph4 r0 ph2 userID ph2 #$8000 ph4 #0 _NewHandle bcc ex1 lda #5 jmp TermError ex1 pl4 r0 recover the handle ldy #2 recover the start pointer lda [r0] sta expStart lda [r0],Y sta expStart+2 add4 expStart,#6,expOffset set the initial offset pointer mul4 lastLoadNumber,#8,r0 set the initial map pointer add4 r0,expOffset,expMap mul4 lastLoadNumber,#2,r0 set the initial header pointer add4 r0,expMap,expHeader lda #2 start with segment 2 sta expressSegment mul4 lastLoadNumber,#79,fMark set the initial file mark add4 fMark,#67+5+4+2+1 ; ; Add all static segments to the expressload segment ; stz r0 nothing in the output list stz r2 st1 move4 loadList,r8 for each segment do st2 lda r8 ora r10 beq dy1 ldy #loadType-loadNext if it is a static segment then lda [r8],Y bmi st3 jsr AddSegment add the segment to the express list bra st1 loop st3 ldy #2 next segment lda [r8],Y tax lda [r8] sta r8 stx r10 bra st2 ; ; Add all remaining segments to the expressload segment ; dy1 lda loadList for each segment do ora loadList+2 beq dn1 move4 loadList,r8 add the segment to the express list jsr AddSegment bra dy1 ; ; Adjust the dynamic segment number ; dn1 anop lda dynSegment get the old segment number beq fe1 skip if there isn't one dec A set its mapped segment asl A tay lda [expMap],Y sta dynSegment set the new segment number ; ; Finish off the express record ; fe1 move4 r0,loadList replace the load list pointer lda #0 put and end mark after the record short M sta [expHeader] long M ldy #2 zero the reserved space for the link sta [expStart] sta [expStart],Y ldy #4 set the number of segments lda lastLoadNumber dec A sta [expStart],Y ; ; Write the expressload segment ; ! set the size of the segment sub4 expHeader,expStart,length add4 length,#headerEnd-header+1,byteCnt move4 length,length2 set the length of the lCost record lda keepRefnum write the header sta wrRefnum sta wsRefnum OSWrite wrRec bcs lb1 move4 expStart,wsBuff write the body add4 length,#1,wsLen OSWrite wsRec bcs lb1 rts lb1 lda #12 jmp TermError ; ; Local data ; wsRec dc i'4' write the body wsRefnum ds 2 wsBuff ds 4 wsLen ds 4 ds 4 wrRec dc i'4' write the segment header wrRefnum ds 2 da 'header' dc i4'headerEnd-header' ds 4 header anop segment header model byteCnt ds 4 length of the segment, in bytes dc i4'0' reserved space at the end of the segment length ds 4 length of the segment dc i1'0' undefined dc i1'0' label length dc i1'4' number length dc i1'2' OMF version dc i4'$10000' bank size dc i'$8001' segment kind dc i'0' undefined dc i4'0' origin dc i4'0' alignment factor dc i1'0' numSex; set to LSB first dc i1'0' undefined dc i'1' segment number dc i4'0' entry point dc i'ldName-header' disp to the segment name dc i'data-header' disp to the segment image ldName dc 10c' ' load segment name; unused in load segs dc i1'12' length of the segment name dc c'~ExpressLoad' segment name data dc i1'$F2' lConst header length2 ds 4 headerEnd anop end **************************************************************** * * FindLoadSegment - find the proper load segment for a file * * Inputs: * loadNamePtr - pointer to the load segment name * segOrg - origin for this segment * segAlign - alignment for this segment * segType - type for this segment * segBanksize - banksize for this segment * * Outputs: * loadNumber - load segment number * * Additional outputs if pass = 2: * op - pointer to the next output segment byte * dp - pointer to the next dictionary segment byte * dictSize - remaining bytes in the dictionary segment * dictStart - pointer to the first byte in the dictionary * **************************************************************** * FindLoadSegment start using Common using OutCommon lda loadNumber if there is an existing segment then bmi lb3 move4 loadNamePtr,r0 if we need this segment then ldy #nameSize-2 lb1 lda [r0],Y cmp loadName,Y bne lb2 dey dey bpl lb1 move4 pc,loadPC save the program counter jsr Pass2Prep make sure we are "pass 2 ready" jsr CheckHeader check header parameters rts return lb2 jsr SaveSegment save the current segment info lb3 move4 loadList,r0 find the correct segment move4 loadNamePtr,r8 lb4 lda r0 ora r2 beq lb6 add4 r0,#loadName-loadNext,r4 ldy #nameSize-2 lb5 lda [r4],Y cmp [r8],Y bne lb5a dey dey bpl lb5 jsr GetSegment recover the segment jsr CheckHeader check header parameters rts lb5a ldy #2 next segment lda [r0],Y tax lda [r0] sta r0 stx r2 bra lb4 lb6 jsr NewSegment create a new segment jsr CheckHeader rts end **************************************************************** * * FinishLconst - finish the current lconst record * * Inputs: * op - current ptr in buffer * opst - op at the start of this record * * Outputs: * opst - set to op * **************************************************************** * FinishLConst start sub4 op,opSt,r0 sub4 r0,#5 lda #$F2 sta [opSt] ldy #1 lda r0 sta [opSt],Y lda r2 iny iny sta [opSt],Y move4 op,opSt rts end **************************************************************** * * GetSegment - get a segment from storage * * Inputs: * r0 - pointer to the segment to get * pass - current pass number * * Outputs: * loadNext... - filled in * pc - set to last value * op,opst,dp,dpSize - set as appropriate * **************************************************************** * GetSegment private using Common using OutCommon ldy #loadSize-2 recover the segment lb0 lda [r0],Y sta loadNext,Y dey dey bpl lb0 lda loadSeg if there is a segment buffer then ora loadSeg+2 beq lb1 ph4 loadSeg lock the buffer _HLock move4 loadSeg,r0 dereference the segment ldy #2 lda [r0] sta loadSegStart lda [r0],Y sta loadSegStart+2 add4 loadOp,loadSegStart,op set the segment pointer add4 loadOpSt,loadSegStart,opst set the lConst pointer bra lb3 else if pass = 2 then lb1 lda pass cmp #2 bne lb3 move4 loadPC,pc save the program counter jsr Pass2Prep prepare for pass2 lb3 anop endif move4 loadPC,pc reset the program counter lda loadDict if there is a dictionary then ora loadDict+2 beq lb4 ph4 loadDict lock the buffer _HLock move4 loadDict,r0 dereference the segment ldy #2 lda [r0] sta loadDictStart lda [r0],Y sta loadDictStart+2 add4 loadDp,loadDictStart,dp set the segment pointer lb4 lda loadLast break the back link ora loadLast+2 beq lb5 move4 loadLast,r0 ldy #2 lda loadNext sta [r0] lda loadNext+2 sta [r0],Y bra lb6 lb5 move4 loadNext,loadList lb6 lda loadNext break the forward link ora loadNext+2 beq lb7 move4 loadNext,r0 ldy #loadLast-loadNext lda loadLast sta [r0],Y iny iny lda loadLast+2 sta [r0],Y lb7 rts end **************************************************************** * * HexVariable - convert an OS string to a value * * Inputs: * r0 - pointer to the shell variable value * * Outputs: * C - set if all characters are hex digits, else clear * X-A - value (if C set); least sig. 32 bits only * **************************************************************** * HexVariable private lda [r0] get a loop counter sta r12 stz r8 set the initial value stz r10 add4 r0,#2,r4 get a character pointer lda [r4] the first char must be '$' and #$00FF cmp #'$' bne lb3 inc4 r4 dec r12 beq lb2a lb1 lda [r4] if the character is not a digit then and #$00FF return false cmp #'0' blt lb3 cmp #'9'+1 blt lb1a and #$005F cmp #'F'+1 bge lb3 cmp #'A' blt lb3 lb1a pha r8 = r8*16 + value(r4^) mul4 r8,#16 pla and #$007F cmp #'9'+1 blt lb1b sbc #7 lb1b and #$000F clc adc r8 sta r8 bcc lb2 inc r10 lb2 inc4 r4 loop dec r12 bne lb1 lb2a lda r8 return value ldx r10 sec rts lb3 clc return false rts end **************************************************************** * * InitOut - initialize the output buffer variables * **************************************************************** * InitOut start using Common using OutCommon lda #-1 no load segment is active sta loadNumber stz lastLoadNumber no load segments created stz loadList no load segments in the list stz loadList+2 stz dynSegment no dynamic segment rts end **************************************************************** * * IsDynamic - is the segment dynamic? * * Inputs: * A - segment to check * * Outputs: * C - set if the segment is dynamic, else clear * **************************************************************** * IsDynamic start using OutCommon cmp loadNumber if A = current segment then bne lb2 lda loadType return dynamic(loadType) lb0 bpl lb1 sec rts lb1 clc rts lb2 sta r4 save the segment number move4 loadList,r0 for each segment in the list do lb3 lda r0 ora r2 beq lb1 ldy #loadNumber-loadNext if this is the correct segment then lda [r0],Y cmp r4 bne lb4 ldy #loadType-loadNext return dynamic(r0^.loadType) lda [r0],Y bra lb0 lb4 ldy #2 next segment lda [r0],Y tax lda [r0] sta r0 stx r2 bra lb3 end **************************************************************** * * JumpTable - create/reuse a jump table entry * * Inputs: * expValue - disp into the dynamic segment * expSegment - dynamic segment number * shiftFlag - shift flag for the expression * * Outputs: * expValue - disp into the segment buffer * expSegment - dynamic segment number * **************************************************************** * JumpTable start using OutCommon using ExpCommon userID equ 0 disp to the user ID field file equ 2 disp to the file number seg equ 4 disp to the segment number offset equ 6 disp to the offset (expr value) jsl equ 10 disp to the jsl to the loader length equ 14 length of a record header equ 8+5 bytes in the buffer header add4 dynStart,#header,r0 check for an existing entry lb1 cmpl r0,dy bge lb3 ldy #seg lda [r0],Y cmp expSegment bne lb2 ldy #offset lda [r0],Y cmp expValue bne lb2 iny iny lda [r0],Y cmp expValue+2 beq lb5 lb2 add4 r0,#length bra lb1 lb3 lda dynSize no existing entry; create a new one cmp #length bge lb4 jsr ExpandDynamicBuffer lb4 move4 dy,r0 add4 dy,#length lda #0 sta [r0] ldy #file lda #1 sta [r0],Y ldy #seg lda expSegment sta [r0],Y ldy #offset lda expValue sta [r0],Y iny iny lda expValue+2 sta [r0],Y ldy #jsl lda #$0022 sta [r0],Y iny iny lda #0 sta [r0],Y lb5 sub4 r0,dynStart,expValue set the new expValue add4 expValue,#jsl-5 lda dynSegment set the new segment value sta expSegment lda shiftFlag check for an illegal shift beq lb6 ph4 #0 ph2 #20 jsr Error lb6 rts end **************************************************************** * * KeepFile - write the segments to the file * * Inputs: * loadList - head of the load list * kname - pointer to the output name * **************************************************************** * KeepFile start using Common using OutCommon lda #1 set the segment number sta segment jsr CreateFile create/check the file move4 kname,opPathname open the file OSOpen opRec bcc lb0 err12 lda #12 jmp TermError lb0 lda opRefnum save the keep refnum sta keepRefnum sta clRefnum sta mkRefnum OSSet_EOF mkRec erase the old file contents bcs err12 lda compact if compact then beq lb0a jsr DoCompact compact the dictionaries lb0a jsr SaveSegment save the current segment jsr CreateDynamicSegment create the dynamic segment lda express if express then beq lb1 jsr ExpressLoad write the expressload segment (if any) inc segment first segment to process is 2 lb1 move4 loadList,r0 find the proper segment lb2 ldy #loadNumber-loadNext lda [r0],Y cmp segment beq lb3 ldy #2 lda [r0],Y tax lda [r0] sta r0 stx r2 ora r2 bne lb2 OSClose clRec none left -- close the file move4 loadList,r0 get a segment back jsr GetSegment jsr SetFileType rts lb3 jsr GetSegment get and lock the segment jsr AddEnd add an end record to the dictionary jsr FinishLConst finish the current lconst record lda express if express then beq lb4 jsr Remap remap the segment numbers bra lb5 else lb4 jsr OptimizeDS optimize the DS, LConst records lb5 jsr WriteHeader write the header jsr WriteBody write the segment image jsr WriteDictionary write the dictionary jsr SaveSegment save the segment inc segment next segment bra lb1 ; ; Local data ; clRec dc i'1' close record clRefnum ds 2 opRec dc i'2' open record opRefnum ds 2 opPathname ds 4 mkRec dc i'3' set mark record mkRefnum ds 2 dc i'0' dc i4'0' segment ds 2 segment number end **************************************************************** * * MoveSegment - move a segment record * * Inputs: * r0 - pointer to the head of the new list * r4 - pointer to the last record in the new list (if r0 <> nil) * r8 - pointer to the record to move * loadList - pointer to the first record in the old list * * Outputs: * input pointers are modified * **************************************************************** * MoveSegment private using OutCommon ; ; Break the back link ; ldy #loadLast-loadNext if r8^.last = nil then lda [r8],Y iny iny ora [r8],Y bne lb1 ldy #2 loadList := r8^.next lda [r8] sta loadList lda [r8],Y sta loadList+2 bra lb2 else lb1 ldy #loadLast-loadNext r12 := r8^.last lda [r8],Y sta r12 iny iny lda [r8],Y sta r14 ldy #2 r12^.next := r8^.next lda [r8] sta [r12] lda [r8],Y sta [r12],Y lb2 anop endif ; ; Break the forward link ; ldy #2 if r8^.next <> nil then lda [r8] ora [r8],Y beq lb3 lda [r8] r12 := r8^.next sta r12 lda [r8],Y sta r14 ldy #loadLast-loadNext r12^.last := r8^.last lda [r8],Y sta [r12],Y iny iny lda [r8],Y sta [r12],Y lb3 anop endif ; ; Add the record to the new list ; ldy #2 r8^.next := nil lda #0 sta [r8] sta [r8],Y lda r0 if r0 = nil then ora r2 bne lb4 ldy #loadLast-loadNext r8^.last := nil lda #0 sta [r8],Y iny iny sta [r8],Y move4 r8,r0 r0 := r8 bra lb5 else lb4 ldy #2 r4^.next := r8 lda r8 sta [r4] lda r10 sta [r4],Y ldy #loadLast-loadNext r8^.last := r4 lda r4 sta [r8],Y iny iny lda r6 sta [r8],Y lb5 anop endif move4 r8,r4 r4 := r8 rts end **************************************************************** * * NamedVariable - see if the variable is a file type * * Inputs: * r0 - pointer to the shell variable value * * Outputs: * C - set if we have a match, else clear * X-A - variable value (if C is set) * **************************************************************** * NamedVariable private lda [r0] if length <> 3 then cmp #3 bne lb3 return false lda #nameEnd-name-3 index into the name array sta r4 lda #$BA initial file number sta r6 lb1 ldx r4 check for match ldy #2 short M lb1a lda [r0],Y cmp name,X beq lb1b and #$5F cmp name,X bne lb2 lb1b inx iny cpy #5 bne lb1a long M lda r6 return the file type ldx #0 sec rts lb2 long M no match - loop dec r6 sec lda r4 sbc #3 sta r4 bpl lb1 lb3 clc return false rts ; ; Local data ; name dc c'S16' file type mnemonics dc c'RTL' dc c'EXE' dc c'PIF' dc c'TIF' dc c'NDA' dc c'CDA' dc c'TOL' nameEnd anop end **************************************************************** * * NewSegment - create a new segment record * * Inputs: * loadNamePtr - pointer to the load name * lastLoadNumber - load number for the last segment created * * Outputs: * loadNumber - number of this load segment * loadName - name of the load segment * pc - 0 * * - all other load record variables are set to 0 * **************************************************************** * NewSegment private using Common using OutCommon move #0,loadNext,#loadSize move4 loadNamePtr,r0 ldy #nameSize-2 lb1 lda [r0],Y sta loadName,Y dey dey bpl lb1 inc lastLoadNumber lda lastLoadNumber sta loadNumber stz pc stz pc+2 rts end **************************************************************** * * OptimizeDS - optimize DS and LConst records * * This subroutine removes LConst records that have a length * of zero, and combines adjacent DS records. * * Inputs: * op - ptr to the end of the load segment body * opst - copy of op * loadSegStart - start of the load segment body * * Outputs: * op - ptr to the end of the load segment body * opst - copy of op * **************************************************************** * OptimizeDS private using Common using OutCommon LConst equ $F2 long contanst op-code DS equ $F0 DS op-code lda loadSegStart r0 = to address ldx loadSegStart+2 r4 = from address sta r0 stx r2 sta r4 stx r6 stz r8 r8 = false {r0, r4 are the same} lb2 cmpl r4,op while r4 <> op do jge lb12 lda [r4] if r4^ = LConst then and #$00FF cmp #LConst bne lb3 ldy #1 if length = 0 then lda [r4],Y ldy #3 ora [r4],Y bne lb4 add4 r4,#5 skip the record lda #1 r8 := true sta r8 bra lb2 lb3 add4 r4,#5,r10 else {if r4^ = DS then} lb3a cmpl r10,op if (r10 = r4+5) < op then bge lb4 lda [r10] if r10^ = LConst then and #$00FF cmp #LConst bne lb3b ldy #1 if r10^.length = 0 then lda [r10],Y ldy #3 ora [r10],Y bne lb4 add4 r10,#5 skip the lconst lda #1 r8 := true sta r8 bra lb3a try again lb3b ldy #1 else if r10^ = DS then clc r10^.length += r4^.length lda [r10],Y adc [r4],Y sta [r10],Y ldy #3 lda [r10],Y adc [r4],Y sta [r10],Y move4 r10,r4 r4 := r10 lda #1 r8 := true sta r8 bra lb3 try again lb4 lda r8 {move the record to the new spot} beq lb10 if the record needs to be moved then lda [r4] if r4^ = LConst then and #$00FF cmp #Lconst bne lb9 ldy #1 lda [r4],Y sta r10 ldy #3 lda [r4],Y sta r12 add4 r10,#5 ldx r12 beq lb6 ldy #0 lb5 lda [r4],Y sta [r0],Y iny iny bne lb5 inc r2 inc r6 dex bne lb5 lb6 lda r10 beq lb10 ldy #0 lsr A tax bcc lb7 short M lda [r4] sta [r0] long M iny lb7 txa beq lb10 lb8 lda [r4],Y sta [r0],Y iny iny dex bne lb8 bra lb10 else {if r4^ = DS then} lb9 lda [r4] sta [r0] ldy #2 lda [r4],Y sta [r0],Y iny lda [r4],Y sta [r0],Y lb10 lda [r0] {next record} and #$00FF cmp #LConst bne lb11 clc ldy #1 lda [r0],Y adc r4 tax ldy #3 lda [r0],Y adc r6 sta r6 stx r4 clc ldy #1 lda [r0],Y adc r0 tax ldy #3 lda [r0],Y adc r2 sta r2 stx r0 lb11 add4 r0,#5 add4 r4,#5 brl lb2 endwhile lb12 lda r0 op = opst = r0 ldx r2 sta op stx op+2 sta opst stx opst+2 rts end **************************************************************** * * Pass2Prep - prepare a buffer for the first call to pass2 * * Inputs: * loadPass2 - has the buffer been prepared for pass 2? * **************************************************************** * Pass2Prep private using Common using OutCommon lda pass if this is not pass 2 cmp #2 bne lb1 lda loadPass2 or the buffer has already been prepared beq lb2 lb1 rts return lb2 add4 length,loadPC update the length of the program lda loadBanksize check for a bank overflow ora loadBanksize+2 beq lb2a cmpl loadPC,loadBanksize blt lb2a ph4 #0 ph2 #18 jsr Error lb2a pha get memory for the output buffer pha clc lda loadPC adc #5 tax lda loadPC+2 adc #0 pha phx ph2 userID ph2 #$8000 ph4 #0 _NewHandle bcc lb3 lda #5 jmp TermError lb3 pl4 loadSeg move4 loadSeg,r0 dereference the segment ldy #2 lda [r0] sta loadSegStart sta op sta opst lda [r0],Y sta loadSegStart+2 sta op+2 sta opst+2 add4 op,#5 skip the space for the lConst header stz loadPC loadPC = 0 stz loadPC+2 stz loadOrg loadOrg = 0 stz loadOrg+2 stz loadAlign loadAlign = 0 stz loadAlign+2 stz pc pc = 0 stz pc+2 inc loadPass2 loadPass2 = true rts end **************************************************************** * * PrintSegmentInfo - print the segment statistics * * Inputs: * loadList - head of the load list * **************************************************************** * PrintSegmentInfo start using Common using OutCommon puts #'Segment Information:',cr=t write segment header putcr puts #' Number Name Type Length Org',cr=t putcr jsr SaveSegment save the current segment lda #1 set the segment number sta segment lda kflag beq lb1 lda express beq lb1 inc segment lb1 move4 loadList,r0 find the proper segment lb2 ldy #loadNumber-loadNext lda [r0],Y cmp segment beq lb3 ldy #2 lda [r0],Y tax lda [r0] sta r0 stx r2 ora r2 bne lb2 move4 loadList,r0 done - get a segment back jsr GetSegment rts lb3 put2 segment,#6 print the segment number putc #' ',#6 inc segment ldy #loadName-loadNext print the segment name short I,M ldx #0 lb3a lda [r0],Y beq lb3b sta name+1,X iny inx cpx #10 bne lb3a lb3b stx name sec lda #13 sbc name sta fw long I,M puts name-1 putc #'$',fw print the type pea 0 ldy #loadType-loadNext lda [r0],Y pha ph2 #2 ph2 #0 jsr PrintHex puts #' $' print the length ldy #loadPC-loadNext+2 lda [r0],Y pha dey dey lda [r0],Y pha ph2 #8 ph2 #0 jsr PrintHex puts #' ' ldy #loadORG-loadNext+2 print the org lda [r0],Y sta r6 dey dey lda [r0],Y sta r4 ora r6 beq lb4 putc #'$' ph4 r4 ph2 #8 ph2 #0 jsr PrintHex putcr brl lb1 lb4 puts #'Relocatable',cr=t brl lb1 segment ds 2 segment number name dc i1'10',10c' ' segment name fw dc i'0' field width for spaces after name end **************************************************************** * * Remap - remap the segment numbers in interseg references * * Inputs: * loadDictStart - start of the dictionary * * Notes: * This remapping is needed when express loading a segment * changes the segment numbers. * **************************************************************** * Remap private using OutCommon move4 loadDictStart,r0 lb1 lda [r0] get an op code and #$00FF jeq lb5 quit if it is the end cmp #$E2 skip reloc bne lb2 add4 r0,#11 bra lb1 lb2 cmp #$E3 remap interseg bne lb3 ldy #9 lda [r0],Y dec A asl A tay lda [expMap],Y ldy #9 sta [r0],Y add4 r0,#15 bra lb1 lb3 cmp #$F5 skip cReloc bne lb4 add4 r0,#7 bra lb1 lb4 cmp #$F7 remap Super jne lb4a ldy #5 if r0^.type = 2 {interseg1} then lda [r0],Y and #$00FF cmp #2 jne sp7 add4 r0,#6,r4 r4 = disp to 1st subrecord sec r8 = page offset lda loadSegStart sbc #$0100-7 sta r8 lda loadSegStart+2 sbc #0 sta r10 ldy #1 r12 = # bytes to process lda [r0],Y dec A sta r12 sp1 lda [r4] repeat and #$00FF if r4^ & $80 <> 0 then bit #$0080 beq sp4 and #$007F add in the page displacement bne sp2 lda #$0080 sp2 xba clc adc r8 sta r8 bcc sp3 inc r10 sp3 inc4 r4 ++r4 dec r12 --r12 bra sp6 next entry sp4 sta r14 else r14 = #bytes + 1 inc4 r4 skip the count byte dec r12 lda r8 new page clc adc #$100 sta r8 bcc sp5 inc r10 sp5 short I,M repeat lda [r4] remap one segment tay tax lda [r8],Y dec A asl A tay lda [expMap],Y txy sta [r8],Y long I,M inc4 r4 ++r4 dec r12 --r12 dec r14 --r14 bpl sp5 until r14 < 0 sp6 lda r12 until r12 = 0 bne sp1 bra sp9 sp7 cmp #14 else if r0^.type in [14..25] then blt sp9 cmp #26 bge sp8 short I,M remap the segment number sec sbc #14 asl A tay lda [expMap],Y clc adc #13 ldy #5 sta [r0],Y long I,M bra sp9 else if r0^.type in [26..37] then sp8 short I,M remap the segment number sec sbc #26 asl A tay lda [expMap],Y clc adc #25 ldy #5 sta [r0],Y long I,M sp9 anop endif ldy #1 skip the record clc lda [r0],Y adc r0 tax iny iny lda [r0],Y adc r2 sta r2 stx r0 add4 r0,#5 brl lb1 lb4a short I,M remap cInterseg ldy #5 lda [r0],Y dec A asl A tay lda [expMap],Y ldy #5 sta [r0],Y long I,M add4 r0,#8 brl lb1 lb5 rts end **************************************************************** * * RemapJumpTable - remap the segment numbers in the jump table * * Inputs: * loadSegStart - start of the jump table buffer * * Notes: * This remapping is needed when express loading a segment * changes the segment numbers. * **************************************************************** * RemapJumpTable private using OutCommon add4 loadSegStart,#8+5,r0 lb1 ldy #2 quit if file = 0 lda [r0],Y beq lb2 ldy #4 remap a segment lda [r0],Y dec A asl A tay lda [expMap],Y ldy #4 sta [r0],Y add4 r0,#14 bra lb1 lb2 rts end **************************************************************** * * SaveSegment - save the current load segment record * **************************************************************** * SaveSegment private using OutCommon move4 loadList,loadNext insert the record in the linked list stz loadLast stz loadLast+2 move4 pc,loadPC save the current pc lda loadSeg if there is a segment buffer then ora loadSeg+2 beq lb1 sub4 op,loadSegStart,loadOp save the op displacement sub4 opst,loadSegStart,loadOpSt save the opst displacement ph4 loadSeg unlock the segment buffer _HUnlock lb1 lda loadDict if there is a dictionary buffer then ora loadDict+2 beq lb2 sub4 dp,loadDictStart,loadDP save the dp displacement ph4 loadDict unlock the dictionary buffer _HUnlock lb2 lda loadPtr if there is no spot reserved then ora loadPtr+2 bne lb3 ph2 #loadSize get some space jsr GetSymbolMemory sta loadPtr stx loadPtr+2 lb3 move4 loadPtr,r0 save the record ldy #loadSize-2 lb4 lda loadNext,Y sta [r0],Y dey dey bpl lb4 lda loadList if loadList <> nil then ora loadList+2 beq lb5 move4 loadList,r0 loadList^.loadLast = loadPtr ldy #loadLast-loadNext lda loadPtr sta [r0],Y iny iny lda loadPtr+2 sta [r0],Y lb5 move4 loadPtr,loadList point the head to this segment rts end **************************************************************** * * SetFileType - set the file type and aux type * * Inputs: * kname - keep name pointer * **************************************************************** * SetFileType private ; ; Get the current file info ; move4 kname,giPathName OSGet_File_Info giRec ; ; Set the file type ; ph4 #FileType read the file type variable jsr ReadVariable sta r0 stx r2 lda [r0] if the variable exists then beq lb2 jsr NamedVariable handle a named variable bcs lb1 jsr DecimalVariable handle a decimal variable bcs lb1 jsr HexVariable handle a hex variable bcs lb1 err13 ph4 #0 flag a bad file name error ph2 #13 jsr Error bra lb2 lb1 txy check for a file type out of range bne err13 cmp #$B3 blt err13 cmp #$BF+1 bge err13 sta giFileType set the file type bra lb3 else lb2 lda #EXE use the default file type sta giFileType lb3 anop endif ph4 r0 Free(r0) jsr Free ; ; Set the aux type ; ph4 #AuxType read the file type variable jsr ReadVariable sta r0 stx r2 lda [r0] if the variable exists then beq ax2 jsr DecimalVariable handle a decimal variable bcs ax1 jsr HexVariable handle a hex variable bcs ax1 ph4 #0 flag a bad file name error ph2 #19 jsr Error bra ax2 ax1 stx giAuxType+2 save the aux type sta giAuxType bra ax3 else ax2 lla giAuxType,$100 use the default aux type ax3 anop endif ph4 r0 Free(r0) jsr Free ; ; Update the file info ; OSSet_File_Info giRec bcs fi1 rts fi1 lda #12 jmp TermError ; ; Local data ; giRec dc i'4' get/set file info record giPathname ds 4 ds 2 giFileType ds 2 giAuxType ds 4 FileType dos KeepType filetype shell variable name AuxType dos AuxType auxtype shell variable name end **************************************************************** * * WriteBody - write the body of a load segment * * Inputs: * loadNext... - load segment record * keepRefnum - keep file reference number * **************************************************************** * WriteBody private using Common using OutCommon lda express if express then beq lb0 lda loadNumber if loadNumber = dynSegment then cmp dynSegment bne lb0 jsr RemapJumpTable remap the dynamic jump table lb0 move4 loadSegStart,wrBuff set the buffer address sub4 op,loadSegStart,wrLength set the length lda keepRefnum set the refnum sta wrRefnum OSWrite wrRec write the segment bcs lb1 rts lb1 lda #12 jmp TermError ; ; Local data ; wrRec dc i'4' write the segment wrRefnum ds 2 wrBuff ds 4 wrLength ds 4 ds 4 end **************************************************************** * * WriteDictionary - write the dictionary for a load segment * * Inputs: * loadNext... - load segment record * keepRefnum - keep file reference number * **************************************************************** * WriteDictionary private using Common using OutCommon sub4 dp,loadDictStart,wrLength set the length move4 loadDictStart,wrBuff set the buffer address lda keepRefnum set the refnum sta wrRefnum OSWrite wrRec write the segment bcs lb1 rts lb1 lda #12 jmp TermError ; ; Local data ; wrRec dc i'4' write the segment wrRefnum ds 2 wrBuff ds 4 wrLength ds 4 ds 4 end **************************************************************** * * WriteHeader - write the segment header for a load segment * * Inputs: * loadNext... - load segment record * keepRefnum - keep file reference number * * Notes: * This subroutine also writes the lConst opcode and * length field for the code image that will be written * by WriteBody. * **************************************************************** * WriteHeader private using OutCommon ! set the size of the segment sub4 opst,loadSegStart,byteCnt add4 byteCnt,#headerEnd-header sub4 dp,loadDictStart,r0 add4 byteCnt,r0 move4 loadPC,length set the length of the segment move4 loadBankSize,bankSize set the bankSize of the segment lda loadType set the kind of the segment sta kind move4 loadORG,org set the org of the segment move4 loadAlign,align set the alignment factor of the segment lda loadNumber set the segment number sta segNum move loadName,segName,#nameSize set the segment name lda keepRefnum write the header sta wrRefnum OSWrite wrRec bcs lb1 rts lb1 lda #12 jmp TermError ; ; Local data ; wrRec dc i'4' write the segment wrRefnum ds 2 da 'header' dc i4'headerEnd-header' ds 4 header anop segment header model byteCnt ds 4 length of the segment, in bytes dc i4'0' reserved space at the end of the segment length ds 4 length of the segment dc i1'0' undefined dc i1'0' label length dc i1'4' number length dc i1'2' OMF version bankSize ds 4 bank size kind ds 2 segment kind dc i'0' undefined org ds 4 origin align ds 4 alignment factor dc i1'0' numSex; set to LSB first dc i1'0' undefined segnum ds 2 segment number ds 4 entry point dc i'ldName-header' disp to the segment name dc i'headerEnd-header' disp to the segment image dc i4'0' temp ORG ldName dc 10c' ' load segment name; unused in load segs dc i1'10' length of the segment name segName ds 10 segment name headerEnd anop end \ No newline at end of file + keep obj/out + mcopy out.mac +**************************************************************** +* +* Ouput Module +* +* This module handles writing the output file and locating the +* proper load segment for code segments. +* +**************************************************************** + copy directPage +**************************************************************** +* +* OutCommon - global data for the segment module +* +**************************************************************** +* +OutCommon data +; +; Constants +; +nameSize equ 10 size of a load segment name +dictGrowSize equ 4096 grow size for the dictionary buffer +dynGrowSize equ 1024 grow size for synamic segment buffer +; +; global variables +; +expressSegment ds 2 express segment number +keepRefnum ds 2 keep file reference number +lastLoadNumber ds 4 last load number allocated +loadList ds 4 head of load segment list +loadNamePtr ds 4 pointer to the name of the load segment +; +; Dynamic segment information +; +dynHandle ds 4 handle of the dynamic segment buffer +dynSize ds 2 bytes left in the buffer +dynBuffSize ds 4 total memory in the segment buffer +dynStart ds 4 ptr to the start of the buffer +dynSegment ds 2 dynamic segment number +; +; Current load segment information +; +loadNext ds 4 pointer to the next load segment +loadLast ds 4 pointer to the last load segment +loadPtr ds 4 pointer to the storage location for this record +loadNumber ds 2 number of this load segment +loadType ds 2 load segment type +loadORG ds 4 load segment origin +loadAlign ds 4 load segment aligment +loadBankSize ds 4 load segment bank size +loadName ds nameSize name of the load segment +loadSeg ds 4 handle of the segment buffer +loadSegStart ds 4 start of the segment buffer +loadPC ds 4 size of the load segment +loadOp ds 4 op disp for the segment buffer +loadOpSt ds 4 op at start of current lConst +loadDict ds 4 handle of the dictionary buffer +loadDictStart ds 4 start of the dictionary buffer +loadDictSize ds 2 bytes left in the dictionary buffer +loadDp ds 4 dp disp for the dictionary buffer +loadPass2 ds 2 are we ready for pass 2? + +loadEnd anop end of the record + +loadSize equ loadEnd-loadNext size of a load module record (even!) + end + +**************************************************************** +* +* AddEnd - add an end record to the dictionary +* +* Inputs: +* loadNext... - load segment record +* +**************************************************************** +* +AddEnd private + using OutCommon + + lda loadDictSize make sure there is room in the dictionary + bne lb1 + jsr ExpandDictBuffer +lb1 short M save the end marker + lda #0 + sta [dp] + long M + inc4 dp update dp + dec loadDictSize update loadDictSize + rts + end + +**************************************************************** +* +* AddSegment - add a segment to the expressload table +* +* Inputs: +* r8 - pointer to the segment to add +* r4,r8 - expressload list pointers +* expOffset - segment offset pointer +* expMap - segment map pointer +* expHeader - segment header map +* expressSegment - express segment number +* +**************************************************************** +* +AddSegment private + using OutCommon + + jsr MoveSegment move the segment ot the new list + + sub4 expHeader,expOffset,r12 set the segment offset + lda r12 + sta [expOffset] + ldy #6 zero the reserved words + lda #0 +lb1 sta [expOffset],Y + dey + dey + bne lb1 + add4 expOffset,#8 update the offset pointer + + ldy #loadNumber-loadNext get the old segment number + lda [r4],Y + dec A set it's mapped segment + asl A + tay + lda expressSegment + sta [expMap],Y + ldy #loadNumber-loadNext set the new segment number + sta [r4],Y + inc expressSegment update segment number + + add4 fMark,#69+5 allow for the segment header & lconst + move4 fMark,mark1 set the lconst mark + ldy #loadPC-loadNext find the segment size + lda [r4],Y + sta len1 + iny + iny + lda [r4],Y + sta len1+2 + add4 fMark,len1 allow for the segment body + move4 fMark,mark2 set the reloc mark + ldy #loadDp-loadNext find the reloc size + lda [r4],Y + sta len2 + iny + iny + lda [r4],Y + sta len2+2 + ora len2 if len2 = 0 then + bne lb1a + stz mark2 mark2 = 0 + stz mark2+2 +lb1a add4 fMark,len2 allow for the dictionary + inc4 fMark allow for the end mark + ldy #loadBankSize-loadNext set the bank size + lda [r4],Y + sta bankSize + iny + iny + lda [r4],Y + sta bankSize+2 + ldy #loadType-loadNext set the segment type + lda [r4],Y + sta kind + ldy #loadOrg-loadNext set the origin + lda [r4],Y + sta org + iny + iny + lda [r4],Y + sta org+2 + ldy #loadAlign-loadNext set the alignment factor + lda [r4],Y + sta align + iny + iny + lda [r4],Y + sta align+2 + ldy #loadNumber-loadNext set the segment number + lda [r4],Y + sta segNum + ldx #nameSize-2 set the segment name + ldy #loadName-loadNext+nameSize-2 +lb2 lda [r4],Y + sta name,X + dey + dey + dex + dex + bpl lb2 + + ldy #segEnd-mark1-1 move the header to the express segment + short M +lb3 lda mark1,Y + sta [expHeader],Y + dey + bpl lb3 + long M + add4 expHeader,#69 update the segment header pointer + rts + +mark1 ds 4 lConst file mark +len1 ds 4 lConst length +mark2 ds 4 reloc file mark +len2 ds 4 reloc length + dc i1'0' undefined + dc i1'0' label length + dc i1'4' number length + dc i1'2' version +bankSize ds 4 bank size +kind ds 2 segment type + dc i'0' undefined +org ds 4 origin +align ds 4 alignment + dc i1'0' numsex + dc i1'0' undefined +segNum ds 2 segment number + dc i4'0' segment entry + dc i'lname-len1' disp to name + dc i'segend-mark1' disp to body +lname dc 10c' ' load name + dc i1'10' segment name length +name ds 10 segment name +segend anop + end + +**************************************************************** +* +* CheckHeader - check the header parameters +* +* Inputs: +* segOrg - origin for this segment +* segAlign - alignment for this segment +* segType - type for this segment +* segBanksize - banksize for this segment +* loadType - load segment type +* loadORG - load segment origin +* loadAlign - load segment aligment +* loadBankSize - load segment bank size +* +* Outputs: +* loadType - load segment type +* loadORG - load segment origin +* loadAlign - load segment aligment +* loadBankSize - load segment bank size +* +**************************************************************** +* +CheckHeader private + using OutCommon + using Common +; +; Set the load segment type +; + lda loadPC if at the start of the segment then + ora loadPC+2 + bne st1 + lda segType use segType + and #$FEFF + sta loadType + bra st4 else +st1 lda segType or in the or flags + and #$1D00 + ora loadType + sta loadType + lda segType mask out missing and flags + and #$E200 + ora #$3DFF + and loadType + sta loadType + lda loadType get the type without flags + and #$007F + sta r0 + lda segType + and #$007F + cmp r0 if they do not match then + beq st4 + cmp #1 if seg is data then + bne st2 + lda r0 if not load in [code,init,dp] then + beq st4 + cmp #$10 + beq st4 + cmp #$12 + beq st4 +err15 ph4 #0 flag segment conflict + ph2 #15 + jsr Error + bra st4 +st2 cmp #0 else if seg in [code,init,dp] then + beq st3 + cmp #$10 + beq st3 + cmp #$12 + bne err15 +st3 lda r0 if load = data then + cmp #1 + bne err15 + lda loadType use seg type + and #$FF00 + sta loadType + lda segType + and #$007F + ora loadType + sta loadType +! else flag the error +st4 anop endif + + lda bankOrg if bankOrg then + beq st5 + lda loadType bank org the program + ora #$0100 + sta loadType +st5 anop endif +; +; Set the load segment origin (pass 1) +; + lda pass branch if pass 2 + cmp #2 + beq or0 + lda segOrg skip if org is 0 + ora segOrg+2 + jeq or4 + + lda loadPC if at the start of the segment then + ora loadPC+2 + ora loadOrg + ora loadOrg+2 + bne po1 + move4 segOrg,loadOrg loadOrg = segOrg + bra po3 else +po1 sub4 segOrg,loadOrg,r0 update the pc + lda r2 + bmi po3 + cmpl r0,pc + blt po3 + move4 r0,pc +po3 anop endif + bra or4 +; +; Set the load segment origin (pass 2) +; +or0 lda segOrg skip if org is 0 + ora segOrg+2 + beq or4 + + lda loadPC if at the start of the segment then + ora loadPC+2 + ora loadOrg + ora loadOrg+2 + bne or1 + move4 segOrg,loadOrg loadOrg = segOrg + bra or3 else +or1 sub4 segOrg,loadOrg,r0 update the pc + sub4 r0,pc + lda r2 + bpl or2 if disp is negative then + ph4 #0 Error(NULL,3) + ph2 #3 + jsr Error + bra or3 else +or2 lda r0 define DS bytes to fill space + ora r2 + beq or3 + jsr DefineDS +or3 anop endif + jsr CheckAlignOrg check for conflicts between align,org +or4 anop +; +; Set the load segment alignment (pass 1) +; + lda pass branch if pass 2 + cmp #2 + beq sa0 + lda segAlign skip if alignment is 0 + ora segAlign+2 + jeq sa4 + + lda loadPC if at the start of the segment then + ora loadPC+2 + ora loadAlign + ora loadAlign+2 + bne la1 + move4 segAlign,loadAlign loadAlign = segAlign + bra la2 else +la1 move4 segAlign,r0 PrepareAlign(segAlign) + jsr PrepareAlign +la2 anop endif + bra sa4 +; +; Set the load segment alignment (pass 2) +; +sa0 lda segAlign skip if alignment is 0 + ora segAlign+2 + beq sa4 + + ph4 segAlign make sure the align is a power of 2 + jsr CheckAlign + lda loadPC if at the start of the segment then + ora loadPC+2 + ora loadAlign + ora loadAlign+2 + bne sa1 + move4 segAlign,loadAlign loadAlign = segAlign + bra sa3 else +sa1 cmpl loadAlign,segAlign if loadAlign < segAlign then + bge sa2 + ph4 #0 Error(NULL,22) + ph2 #22 + jsr Error + bra sa3 else +sa2 move4 segAlign,r0 DefineAlign(segAlign) + jsr DefineAlign +! anop endif +sa3 anop endif + jsr CheckAlignOrg check for conflicts between align,org +sa4 anop +; +; Set the load segment bank size +; + lda pass branch if pass 2 + cmp #2 + beq rt1 + lda loadBankSize if loadBanksize = 0 + ora loadBanksize+2 + beq bs1 + cmpl segBanksize,loadBanksize or ((segBanksize < loadBanksize) + bge bs2 and (segBanksize <> 0)) then + lda segBanksize + ora segBanksize+2 + beq bs2 +bs1 move4 segBankSize,loadBankSize loadBankSize = segBankSize +bs2 anop + +rt1 rts +; +; CheckAlignOrg - make sure the align and org do not conflict +; +CheckAlignOrg anop + + lda loadAlign if loadAlign <> 0 then + ora loadAlign+2 + beq ca2 + sub4 loadAlign,#1,r0 if loadOrg & (loadAlign-1) then + lda r0 + and loadOrg + bne ca1 + lda r2 + and loadOrg+2 + beq ca2 +ca1 ph4 #0 Error(NULL,21) + ph2 #21 + jsr Error +ca2 rts + end + +**************************************************************** +* +* CompactCInterseg - compact a cInterseg record +* +* Inputs: +* r0 - ptr to the cInterseg record +* r4 - ptr to the end of the dictionary +* dp - ptr to the next free byte in the dictionary +* +**************************************************************** +* +CompactCInterseg private + using Common + using OutCommon +; +; See if the record can be compacted +; + lda [r0] length must be 2 or 3 + xba + and #$00FF + cmp #2 + beq ck1 + cmp #3 + jne nc1 +ck1 sta length + cmp #3 if length = 3 then + bne ck2 + ldy #2 shift count must be 0 + lda [r0],Y + and #$00FF + jne nc1 + stz shift + lda #2 set the record type + sta recordType + ldy #5 set the segment number + lda [r0],Y + and #$00FF + sta segment + bra ck3 else {if length = 2 then} +ck2 ldy #5 segment number must be <= 12 + lda [r0],Y + and #$00FF + sta segment + cmp #13 + jge nc1 + ldx express if express then + beq ck2a + cmp #12 don't use 12, either + jeq nc1 +ck2a clc set the record type for shift 0 + lda segment + adc #13 + sta recordType + ldy #2 shift must be 0 or -16 + lda [r0],Y + and #$00FF + sta shift + beq ck3 + cmp #$00F0 + jne nc1 + add2 recordType,#12 set the record type for shift -16 +ck3 anop +; +; Create a Super record +; + lda #13 create the record header + cmp loadDictSize make sure there is room in the + blt sp1 dictionary + jsr ExpandDictBuffer +sp1 add4 dp,#1,recordLengthPtr save a pointer to the length field + sub4 recordLengthPtr,loadDictStart + short M set the op code + lda #$F7 + sta [dp] + ldy #5 set the super record type + lda recordType + sta [dp],Y + long M + add4 dp,#6 skip the super record header + sub2 loadDictSize,#6 + + ldy #4 set the segment offset page + lda [r0],Y + and #$00FF + sta page + beq pg3 if page <> 0 then + sta r12 while (r12 := page) > $7F do +pg1 lda r12 + cmp #$80 + blt pg2 + short M write a skip page for $7F pages + lda #$FF + sta [dp] + long M + inc4 dp + dec loadDictSize + sub2 r12,#$7F r12 -= $7F + bra pg1 endwhile +pg2 lda r12 if r12 <> 0 then + beq pg3 + short M write a skip page for r12 pages + ora #$80 + sta [dp] + long M + inc4 dp + dec loadDictSize +pg3 anop + move4 dp,r12 initialize the page counter + short M + lda #$FF + sta [r12] + long M + inc4 dp skip the page counter + dec loadDictSize + + move4 r0,r8 for each dictionary record do +sp2 cmpl r8,r4 + jeq sp14 + lda [r8] if it is a Reloc then + and #$00FF + cmp #$E2 + bne sp3 + add4 r8,#11 skip the record + bra sp2 loop +sp3 cmp #$75 if it is a skipped cReloc or + beq sp4 cReloc then + cmp #$F5 + bne sp5 +sp4 add4 r8,#7 skip the record + bra sp2 loop +sp5 cmp #$76 if it is a skipped cInterseg then + bne sp6 + add4 r8,#8 skip the record + bra sp2 loop +sp6 cmp #$E3 if it is an Interseg then + bne sp7 + add4 r8,#15 skip the record + bra sp2 loop +sp7 ldy #2 if the cInterseg is a different type + short M then + lda [r8],Y + cmp shift + bne sp7a + dey + lda [r8],Y + cmp length + bne sp7a + cmp #3 + beq sp8 + ldy #5 + lda [r8],Y + cmp segment + beq sp8 +sp7a long M skip the record + add4 r8,#8 + brl sp2 loop + +sp8 long M make sure there is room in the + lda #5 dictionary + cmp loadDictSize + blt sp9 + sub4 r12,loadDictStart + jsr ExpandDictBuffer + add4 r12,loadDictStart +sp9 short M if r8^.page <> page then + sec + ldy #4 + lda [r8],Y + sbc page + beq sp13 + dec A if r8^.page - page > 1 then + beq sp12 +sp10 cmp #$80 record a page skip + blt sp11 + tax + lda #$FF + sta [dp] + long M + inc4 dp + dec loadDictSize + short M + txa + sec + sbc #$7F + bra sp10 +sp11 cmp #0 + beq sp12 + ora #$80 + sta [dp] + long M + inc4 dp + dec loadDictSize + short M +sp12 ldy #4 record the new page + lda [r8],Y + sta page + lda #$FF set up a record count + sta [dp] + long M + move4 dp,r12 + inc4 dp + dec loadDictSize + short M +sp13 lda [r12] increment the record count + inc A + sta [r12] + ldy #3 set the offset + lda [r8],Y + sta [dp] + long M + inc4 dp + dec loadDictSize + short M mark the record + lda [r8] + and #$7F + sta [r8] + long M + add4 r8,#8 skip the record + brl sp2 loop + +sp14 anop set the super record length + add4 recordLengthPtr,loadDictStart,r12 + sub4 dp,r12,recordLengthPtr + sub4 recordLengthPtr,#4 + ldy #2 + lda recordLengthPtr + sta [r12] + lda recordLengthPtr+2 + sta [r12],Y + rts +; +; Cannot compact - put the unchanged record in the dictionary +; +nc1 lda #8 make sure there is room in the + cmp loadDictSize dictionary + blt nc2 + jsr ExpandDictBuffer +nc2 ldy #6 move the record +nc3 lda [r0],Y + sta [dp],Y + dey + dey + bpl nc3 + add4 dp,#8 skip the record + sub2 loadDictSize,#8 + add4 r0,#8 + rts +; +; Local data +; +recordLengthPtr ds 4 pointer to the super record length field +page ds 2 current cReloc page number +length ds 2 length of the cReloc fields +shift ds 2 shift count +segment ds 2 segment number +recordType ds 2 type of the Super record + end + +**************************************************************** +* +* CompactCReloc - compact a cReloc record +* +* Inputs: +* r0 - ptr to the cReloc record +* r4 - ptr to the end of the dictionary +* dp - ptr to the next free byte in the dictionary +* +**************************************************************** +* +CompactCReloc private + using OutCommon +; +; See if the record can be compacted +; + lda [r0] length must be 2 or 3 + xba + and #$00FF + cmp #2 + beq ck1 + cmp #3 + jne nc1 +ck1 sta length + ldy #2 shift count must be 0 + lda [r0],Y + and #$00FF + jne nc1 +; +; Create a Super record +; + lda #13 create the record header + cmp loadDictSize make sure there is room in the + blt sp1 dictionary + jsr ExpandDictBuffer +sp1 add4 dp,#1,recordLengthPtr save a pointer to the length field + sub4 recordLengthPtr,loadDictStart + short M set the op code + lda #$F7 + sta [dp] + ldy #5 set the super record type + lda length + and #$01 + sta [dp],Y + long M + add4 dp,#6 skip the super record header + sub2 loadDictSize,#6 + + ldy #4 set the segment offset page + lda [r0],Y + and #$00FF + sta page + beq pg3 if page <> 0 then + sta r12 while (r12 := page) > $7F do +pg1 lda r12 + cmp #$80 + blt pg2 + short M write a skip page for $7F pages + lda #$FF + sta [dp] + long M + inc4 dp + dec loadDictSize + sub2 r12,#$7F r12 -= $7F + bra pg1 endwhile +pg2 lda r12 if r12 <> 0 then + beq pg3 + short M write a skip page for r12 pages + ora #$80 + sta [dp] + long M + inc4 dp + dec loadDictSize +pg3 anop + move4 dp,r12 initialize the page counter + short M + lda #$FF + sta [r12] + long M + inc4 dp skip the page counter + dec loadDictSize + + move4 r0,r8 for each dictionary record do +sp2 cmpl r8,r4 + jeq sp14 + lda [r8] if it is a Reloc then + and #$00FF + cmp #$E2 + bne sp3 + add4 r8,#11 skip the record + bra sp2 loop +sp3 cmp #$75 if it is a skipped cReloc then + bne sp4 + add4 r8,#7 skip the record + bra sp2 loop +sp4 cmp #$F6 if it is a cInterseg or skipped + beq sp5 cInterseg then + cmp #$76 + bne sp6 +sp5 add4 r8,#8 skip the record + bra sp2 loop +sp6 cmp #$E3 if it is an Interseg then + bne sp7 + add4 r8,#15 skip the record + bra sp2 loop +sp7 ldy #1 if the cReloc is a different type then + lda [r8],Y + cmp length (checks length and shift=0) + beq sp8 + add4 r8,#7 skip the record + bra sp2 loop + +sp8 lda #5 make sure there is room in the + cmp loadDictSize dictionary + blt sp9 + sub4 r12,loadDictStart + jsr ExpandDictBuffer + add4 r12,loadDictStart +sp9 short M if r8^.page <> page then + sec + ldy #4 + lda [r8],Y + sbc page + beq sp13 + dec A if r8^.page - page > 1 then + beq sp12 +sp10 cmp #$80 record a page skip + blt sp11 + tax + lda #$FF + sta [dp] + long M + inc4 dp + dec loadDictSize + short M + txa + sec + sbc #$7F + bra sp10 +sp11 cmp #0 + beq sp12 + ora #$80 + sta [dp] + long M + inc4 dp + dec loadDictSize + short M +sp12 ldy #4 record the new page + lda [r8],Y + sta page + lda #$FF set up a record count + sta [dp] + long M + move4 dp,r12 + inc4 dp + dec loadDictSize + short M +sp13 lda [r12] increment the record count + inc A + sta [r12] + ldy #3 set the offset + lda [r8],Y + sta [dp] + long M + inc4 dp + dec loadDictSize + short M mark the record + lda [r8] + and #$7F + sta [r8] + long M + add4 r8,#7 skip the record + brl sp2 loop + +sp14 anop set the super record length + add4 recordLengthPtr,loadDictStart,r12 + sub4 dp,r12,recordLengthPtr + sub4 recordLengthPtr,#4 + ldy #2 + lda recordLengthPtr + sta [r12] + lda recordLengthPtr+2 + sta [r12],Y + rts +; +; Cannot compact - put the unchanged record in the dictionary +; +nc1 lda #8 make sure there is room in the + cmp loadDictSize dictionary + blt nc2 + jsr ExpandDictBuffer +nc2 ldy #6 move the record +nc3 lda [r0],Y + sta [dp],Y + dey + dey + bpl nc3 + add4 dp,#7 skip the record + sub2 loadDictSize,#7 + add4 r0,#7 + rts +; +; Local data +; +recordLengthPtr ds 4 pointer to the super record length field +page ds 2 current cReloc page number +length ds 2 length of the cReloc fields + end + +**************************************************************** +* +* CompactSegment - compact a single segment +* +* Inputs: +* LoadNext... - segment record +* +**************************************************************** +* +CompactSegment private + using OutCommon + using Common + + lda loadDict if there is no dictionary then + ora loadDict+2 + bne lb1 + rts return + +lb1 move4 loadDict,dictHandle save the dictionary handle + move4 loadDictStart,r0 get a pointer to the dictionary + move4 dp,r4 get a pointer to the dictionary end + stz loadDictStart zero the current load dictionary + stz loadDictStart+2 + stz loadDict + stz loadDict+2 + stz loadDp + stz loadDp+2 + stz dp + stz dp+2 + stz loadDictSize + stz loadDictSize+2 +lb2 cmpl r0,r4 for each dictionary entry do + jeq lb12 + lda [r0] if r0^ = cReloc then + and #$00FF + cmp #$00F5 + bne lb3 + jsr CompactCReloc compact the record + bra lb2 loop +lb3 cmp #$75 if r0^ = skipped cReloc then + bne lb4 + add4 r0,#7 skip the record + bra lb2 loop +lb4 cmp #$E2 if r0^ = Reloc then + bne lb7 + lda #12 make sure there is room in the + cmp loadDictSize dictionary + blt lb5 + jsr ExpandDictBuffer +lb5 ldy #10 move the record +lb6 lda [r0],Y + sta [dp],Y + dey + dey + bpl lb6 + add4 dp,#11 skip the record + sub2 loadDictSize,#11 + add4 r0,#11 + bra lb2 loop +lb7 cmp #$F6 if r0^ = cInterseg then + bne lb8 + jsr CompactCInterseg compact the record + bra lb2 loop +lb8 cmp #$76 if r0^ = skipped cInterseg then + bne lb9 + add4 r0,#8 skip the record + brl lb2 loop +! (condition must be true) if r0^ = Interseg then +lb9 lda #16 make sure there is room in the + cmp loadDictSize dictionary + blt lb10 + jsr ExpandDictBuffer +lb10 ldy #14 move the record +lb11 lda [r0],Y + sta [dp],Y + dey + dey + bpl lb11 + add4 dp,#15 skip the record + sub2 loadDictSize,#15 + add4 r0,#15 + brl lb2 loop + +lb12 ph4 dictHandle free the old dictionary buffer + _DisposeHandle + rts + +dictHandle ds 4 old dictionary handle + end + +**************************************************************** +* +* CreateDynamicSegment - create the dynamic segment (if any) +* +* Inputs: +* dynSegment - dynmaic segment number; 0 if none +* dynStart - start of the dynamic segment +* dy - next byte in the buffer +* +**************************************************************** +* +CreateDynamicSegment private + using OutCommon + + lda dynSegment quit if there is no segment + bne lb0 + rts +lb0 lda dynSize write the trailing 4 bytes + cmp #4 + bge lb1 + jsr ExpandDynamicBuffer +lb1 ldy #2 + lda #0 + sta [dy] + sta [dy],Y + add4 dy,#4 + sub4 dy,dynStart,r0 set the size of the lConst + sub4 r0,#5 + move4 dynStart,r4 + lda #$F2 + sta [r4] + ldy #1 + lda r0 + sta [r4],Y + iny + iny + lda r2 + sta [r4],Y + + move #0,loadNext,#loadSize clear all entries + lda dynSegment set the segment number + sta loadNumber + lda #2 set the segment type + sta loadType + lla loadBankSize,$10000 set the load segment bank size + move jumpName,loadName,#nameSize set the segment name + move4 dynHandle,loadSeg set the segment buffer handle + move4 dynStart,loadSegStart set the load segment start + sub4 dy,dynStart,loadPc set the segment size + sub4 loadPc,#5 + move4 loadPc,pc + move4 dy,op set the segment pointer + sub4 dy,dynStart,loadOp set the segment displacement + inc loadPass2 ready for pass 2 + stz dp no dictionary pointer + stz dp+2 + jsr SaveSegment + rts + +jumpName dc c'~JumpTable' + end + +**************************************************************** +* +* CreateFile - make sure an output file exists +* +* Inputs: +* kname - keep file name +* +**************************************************************** +* +CreateFile private + using OutCommon + + move4 kname,giPathname see if a file exists + OSGet_File_Info giRec + bcs lb1 + lda giFiletype yes -> make sure it is an OBJ file + cmp #$B3 + blt err7 + cmp #$BF+1 + bge err7 + rts + +lb1 move4 kname,crPathname no file exists, so create one + OSCreate crRec + bcs err12 + rts + +err12 lda #12 file write error + jmp TermError + +err7 lda #7 Could not overwrite existing file + jmp TermError +; +; Local data +; +giRec dc i'3' GetFileInfo record +giPathname ds 4 + ds 2 +giFiletype ds 2 + +crRec dc i'4' +crPathname ds 4 + dc i'$C3' + dc i'EXE' + dc i4'$0100' + end + +**************************************************************** +* +* DecimalVariable - convert an OS string to a decimal value +* +* Inputs: +* r0 - pointer to the shell variable value +* +* Outputs: +* C - set if all characters are digits, else clear +* X-A - value (if C set); least sig. 32 bits only +* +**************************************************************** +* +DecimalVariable private + + lda [r0] get a loop counter + sta r12 + stz r8 set the initial value + stz r10 + add4 r0,#2,r4 get a character pointer + +lb1 lda [r4] if the character is not a digit then + and #$00FF return false + cmp #'0' + blt lb3 + cmp #'9'+1 + bge lb3 + mul4 r8,#10 r8 = r8*10 + value(r4^) + lda [r4] + and #$000F + clc + adc r8 + sta r8 + bcc lb2 + inc r10 +lb2 inc4 r4 loop + dec r12 + bne lb1 + + lda r8 return value + ldx r10 + sec + rts + +lb3 clc return false + rts + end + +**************************************************************** +* +* DoCompact - compact the dictionaries +* +**************************************************************** +* +DoCompact private + using OutCommon + using Common + + jsr SaveSegment save the current segment + lda #1 set the segment number + sta segment +lb1 move4 loadList,r0 find the proper segment +lb2 ldy #loadNumber-loadNext + lda [r0],Y + cmp segment + bne lb3 + jsr GetSegment get the segment + jsr CompactSegment compact the segment + jsr SaveSegment save the segment + inc segment next segment + bra lb1 start the search over + +lb3 ldy #2 next segment pointer + lda [r0],Y + tax + lda [r0] + sta r0 + stx r2 + ora r2 + bne lb2 + + move4 loadList,r0 done - get a segment back + jsr GetSegment + rts return + +segment ds 2 segment number + end + +**************************************************************** +* +* DynamicCheck - if any segment is dynamic, set up a jump table +* +* Inputs: +* loadList - list of current load segments +* loadNext... - active load segment +* lastLoadNumber - last load number allocated +* +* Outputs: (if there is a dynamic segment) +* dynHandle - handle of the synamic segment +* dynStart - start of the dynamic segment +* dynSize - size of the dynamic segment +* dy - pointer to the next spot in the dynamic segment +* dynSegment - dynamic segment number +* +**************************************************************** +* +DynamicCheck start + using OutCommon +; +; See if any segment is dynamic +; + lda loadType check the current segment + bmi pr1 + move4 loadList,r0 check the segments in the segment list +cs1 lda r0 + ora r2 + beq cs2 + ldy #loadType-loadNext + lda [r0],Y + bmi pr1 + ldy #2 + lda [r0],Y + tax + lda [r0] + sta r0 + stx r2 + bra cs1 + +cs2 rts +; +; Prepare for dynamic segment output +; +pr1 stz dy zero the pointer + stz dy+2 + stz dynSize zero the size + stz dynBuffSize no memory in the buffer + stz dynBuffSize+2 + stz dynHandle no handle, yet + stz dynHandle+2 + stz dynStart initialize the field + stz dynStart+2 + jsr ExpandDynamicBuffer get an initial buffer + add4 dy,#5 create space for the lConst opcode + ldy #6 insert the 8 leading zeros + lda #0 +pr2 sta [dy],Y + dey + dey + bpl pr2 + sub2 dynSize,#13 + add4 dy,#8 + lda lastLoadNumber get a segment number + inc A + sta lastLoadNumber + sta dynSegment + rts + end + +**************************************************************** +* +* ExpandDictBuffer - expand the dictionary buffer +* +* Inputs: +* loadDict - handle of the dictionary buffer, nil for none +* loadDictSize - size of the dictionary buffer +* +* Outputs: +* loadDict - handle of the dictionary buffer +* loadDictStart - start of the dictionary buffer +* loadDictSize - size of the dictionary buffer +* dp - start of the dictionary buffer +* +* Notes: +* Other than dp, direct page is not disturbed. +* +**************************************************************** +* +ExpandDictBuffer start + using Common + using OutCommon + + lda loadDict if there is no buffer then + ora loadDict+2 + bne lb1 + la loadDictSize,dictGrowSize set the dictionary size + pha get a new buffer + pha + ph4 #dictGrowSize + ph2 userID + ph2 #$8000 + ph4 #0 + _NewHandle + jcs oom + pl4 loadDict + stz loadDP loadDP = 0 + stz loadDP+2 + brl lb2 else +lb1 sub4 dp,loadDictStart,loadDP get the displacement + ph4 loadDict unlock the handle + _HUnlock + pha get the current handle size + pha + ph4 loadDict + _GetHandleSize + clc set the new size + lda 1,S + adc #dictGrowSize + sta 1,S + lda 3,S + adc #^dictGrowSize + sta 3,S + ph4 loadDict expand the buffer + _SetHandleSize + bcs oom + ph4 loadDict lock the handle + _HLock + add2 loadDictSize,#dictGrowSize update the free space +lb2 anop endif + + move4 loadDict,dp dereference the handle + ldy #2 + lda [dp] + sta loadDictStart + lda [dp],Y + sta loadDictStart+2 + add4 loadDictStart,loadDP,dp set dp + rts + +oom lda #5 + jmp TermError + end + +**************************************************************** +* +* ExpandDynamicBuffer - expand the dynamic segment buffer +* +* Inputs: +* dynHandle - handle of the buffer, nil for none +* dynBuffSize - size of the buffer +* synSize - bytes left in the current buffer +* dy - pointer to the current buffer +* dynStart - start of the buffer +* +* Outputs: +* dynHandle - handle of the buffer, nil for none +* dynBuffSize - size of the buffer +* synSize - bytes left in the current buffer +* dy - pointer to the current buffer +* dynStart - start of the buffer +* +**************************************************************** +* +ExpandDynamicBuffer private + using Common + using OutCommon + + lda dynHandle if there is no buffer then + ora dynHandle+2 + bne lb1 + pha get a new buffer + pha + ph4 #dynGrowSize + ph2 userID + ph2 #$8000 + ph4 #0 + _NewHandle + jcs oom + pl4 dynHandle + lla dynBuffSize,dynGrowSize set the size + bra lb2 else +lb1 ph4 loadDict unlock the handle + _HUnlock + add4 dynBuffSize,#dynGrowSize get the new size + ph4 dynBuffSize set the new size + ph4 dynHandle expand the buffer + _SetHandleSize + bcs oom + ph4 dynHandle lock the handle + _HLock +lb2 anop endif + + add2 dynSize,#dynGrowSize update the free space + sub4 dy,dynStart convert dy to a displacement + move4 dynHandle,r0 dereference the handle + ldy #2 + lda [r0] + sta dynStart + lda [r0],Y + sta dynStart+2 + add4 dy,dynStart set dy + rts + +oom lda #5 + jmp TermError + end + +**************************************************************** +* +* ExpressLoad - Handle express loading +* +* Inputs: +* express - is the program express loaded? +* +**************************************************************** +* +ExpressLoad private + using OutCommon + using Common +; +; Sort the segments by number +; + lda #1 set the initial segment number + sta expressSegment + stz r0 nothing in the output list + stz r2 +sn1 move4 loadList,r8 for each segment number +sn2 lda r8 for each segment + ora r10 + beq sn4 + ldy #loadNumber-loadNext if this is the right segment then + lda [r8],Y + cmp expressSegment + bne sn3 + jsr MoveSegment move the segment to the new list + bra sn4 +sn3 ldy #2 next segment + lda [r8],Y + tax + lda [r8] + sta r8 + stx r10 + bra sn2 +sn4 inc expressSegment next segment number + lda loadList + ora loadList+2 + bne sn1 + move4 r0,loadList replace the list +; +; Build the expressload segment +; + pha get memory for the lConst record + pha + mul4 lastLoadNumber,#79,r0 + add4 r0,#7 + ph4 r0 + ph2 userID + ph2 #$8000 + ph4 #0 + _NewHandle + bcc ex1 + lda #5 + jmp TermError +ex1 pl4 r0 recover the handle + ldy #2 recover the start pointer + lda [r0] + sta expStart + lda [r0],Y + sta expStart+2 + add4 expStart,#6,expOffset set the initial offset pointer + mul4 lastLoadNumber,#8,r0 set the initial map pointer + add4 r0,expOffset,expMap + mul4 lastLoadNumber,#2,r0 set the initial header pointer + add4 r0,expMap,expHeader + lda #2 start with segment 2 + sta expressSegment + mul4 lastLoadNumber,#79,fMark set the initial file mark + add4 fMark,#67+5+4+2+1 +; +; Add all static segments to the expressload segment +; + stz r0 nothing in the output list + stz r2 +st1 move4 loadList,r8 for each segment do +st2 lda r8 + ora r10 + beq dy1 + ldy #loadType-loadNext if it is a static segment then + lda [r8],Y + bmi st3 + jsr AddSegment add the segment to the express list + bra st1 loop +st3 ldy #2 next segment + lda [r8],Y + tax + lda [r8] + sta r8 + stx r10 + bra st2 +; +; Add all remaining segments to the expressload segment +; +dy1 lda loadList for each segment do + ora loadList+2 + beq dn1 + move4 loadList,r8 add the segment to the express list + jsr AddSegment + bra dy1 +; +; Adjust the dynamic segment number +; +dn1 anop + lda dynSegment get the old segment number + beq fe1 skip if there isn't one + dec A set its mapped segment + asl A + tay + lda [expMap],Y + sta dynSegment set the new segment number +; +; Finish off the express record +; +fe1 move4 r0,loadList replace the load list pointer + lda #0 put and end mark after the record + short M + sta [expHeader] + long M + ldy #2 zero the reserved space for the link + sta [expStart] + sta [expStart],Y + ldy #4 set the number of segments + lda lastLoadNumber + dec A + sta [expStart],Y +; +; Write the expressload segment +; +! set the size of the segment + sub4 expHeader,expStart,length + add4 length,#headerEnd-header+1,byteCnt + move4 length,length2 set the length of the lCost record + + lda keepRefnum write the header + sta wrRefnum + sta wsRefnum + OSWrite wrRec + bcs lb1 + move4 expStart,wsBuff write the body + add4 length,#1,wsLen + OSWrite wsRec + bcs lb1 + rts + +lb1 lda #12 + jmp TermError +; +; Local data +; +wsRec dc i'4' write the body +wsRefnum ds 2 +wsBuff ds 4 +wsLen ds 4 + ds 4 + +wrRec dc i'4' write the segment header +wrRefnum ds 2 + da 'header' + dc i4'headerEnd-header' + ds 4 + +header anop segment header model +byteCnt ds 4 length of the segment, in bytes + dc i4'0' reserved space at the end of the segment +length ds 4 length of the segment + dc i1'0' undefined + dc i1'0' label length + dc i1'4' number length + dc i1'2' OMF version + dc i4'$10000' bank size + dc i'$8001' segment kind + dc i'0' undefined + dc i4'0' origin + dc i4'0' alignment factor + dc i1'0' numSex; set to LSB first + dc i1'0' undefined + dc i'1' segment number + dc i4'0' entry point + dc i'ldName-header' disp to the segment name + dc i'data-header' disp to the segment image +ldName dc 10c' ' load segment name; unused in load segs + dc i1'12' length of the segment name + dc c'~ExpressLoad' segment name +data dc i1'$F2' lConst header +length2 ds 4 +headerEnd anop + end + +**************************************************************** +* +* FindLoadSegment - find the proper load segment for a file +* +* Inputs: +* loadNamePtr - pointer to the load segment name +* segOrg - origin for this segment +* segAlign - alignment for this segment +* segType - type for this segment +* segBanksize - banksize for this segment +* +* Outputs: +* loadNumber - load segment number +* +* Additional outputs if pass = 2: +* op - pointer to the next output segment byte +* dp - pointer to the next dictionary segment byte +* dictSize - remaining bytes in the dictionary segment +* dictStart - pointer to the first byte in the dictionary +* +**************************************************************** +* +FindLoadSegment start + using Common + using OutCommon + + lda loadNumber if there is an existing segment then + bmi lb3 + move4 loadNamePtr,r0 if we need this segment then + ldy #nameSize-2 +lb1 lda [r0],Y + cmp loadName,Y + bne lb2 + dey + dey + bpl lb1 + move4 pc,loadPC save the program counter + jsr Pass2Prep make sure we are "pass 2 ready" + jsr CheckHeader check header parameters + rts return +lb2 jsr SaveSegment save the current segment info + +lb3 move4 loadList,r0 find the correct segment + move4 loadNamePtr,r8 +lb4 lda r0 + ora r2 + beq lb6 + add4 r0,#loadName-loadNext,r4 + ldy #nameSize-2 +lb5 lda [r4],Y + cmp [r8],Y + bne lb5a + dey + dey + bpl lb5 + jsr GetSegment recover the segment + jsr CheckHeader check header parameters + rts + +lb5a ldy #2 next segment + lda [r0],Y + tax + lda [r0] + sta r0 + stx r2 + bra lb4 + +lb6 jsr NewSegment create a new segment + jsr CheckHeader + rts + end + +**************************************************************** +* +* FinishLconst - finish the current lconst record +* +* Inputs: +* op - current ptr in buffer +* opst - op at the start of this record +* +* Outputs: +* opst - set to op +* +**************************************************************** +* +FinishLConst start + + sub4 op,opSt,r0 + sub4 r0,#5 + lda #$F2 + sta [opSt] + ldy #1 + lda r0 + sta [opSt],Y + lda r2 + iny + iny + sta [opSt],Y + move4 op,opSt + rts + end + +**************************************************************** +* +* GetSegment - get a segment from storage +* +* Inputs: +* r0 - pointer to the segment to get +* pass - current pass number +* +* Outputs: +* loadNext... - filled in +* pc - set to last value +* op,opst,dp,dpSize - set as appropriate +* +**************************************************************** +* +GetSegment private + using Common + using OutCommon + + ldy #loadSize-2 recover the segment +lb0 lda [r0],Y + sta loadNext,Y + dey + dey + bpl lb0 + lda loadSeg if there is a segment buffer then + ora loadSeg+2 + beq lb1 + ph4 loadSeg lock the buffer + _HLock + move4 loadSeg,r0 dereference the segment + ldy #2 + lda [r0] + sta loadSegStart + lda [r0],Y + sta loadSegStart+2 + add4 loadOp,loadSegStart,op set the segment pointer + add4 loadOpSt,loadSegStart,opst set the lConst pointer + bra lb3 else if pass = 2 then +lb1 lda pass + cmp #2 + bne lb3 + move4 loadPC,pc save the program counter + jsr Pass2Prep prepare for pass2 +lb3 anop endif + move4 loadPC,pc reset the program counter + lda loadDict if there is a dictionary then + ora loadDict+2 + beq lb4 + ph4 loadDict lock the buffer + _HLock + move4 loadDict,r0 dereference the segment + ldy #2 + lda [r0] + sta loadDictStart + lda [r0],Y + sta loadDictStart+2 + add4 loadDp,loadDictStart,dp set the segment pointer + +lb4 lda loadLast break the back link + ora loadLast+2 + beq lb5 + move4 loadLast,r0 + ldy #2 + lda loadNext + sta [r0] + lda loadNext+2 + sta [r0],Y + bra lb6 +lb5 move4 loadNext,loadList +lb6 lda loadNext break the forward link + ora loadNext+2 + beq lb7 + move4 loadNext,r0 + ldy #loadLast-loadNext + lda loadLast + sta [r0],Y + iny + iny + lda loadLast+2 + sta [r0],Y +lb7 rts + end + +**************************************************************** +* +* HexVariable - convert an OS string to a value +* +* Inputs: +* r0 - pointer to the shell variable value +* +* Outputs: +* C - set if all characters are hex digits, else clear +* X-A - value (if C set); least sig. 32 bits only +* +**************************************************************** +* +HexVariable private + + lda [r0] get a loop counter + sta r12 + stz r8 set the initial value + stz r10 + add4 r0,#2,r4 get a character pointer + + lda [r4] the first char must be '$' + and #$00FF + cmp #'$' + bne lb3 + inc4 r4 + dec r12 + beq lb2a +lb1 lda [r4] if the character is not a digit then + and #$00FF return false + cmp #'0' + blt lb3 + cmp #'9'+1 + blt lb1a + and #$005F + cmp #'F'+1 + bge lb3 + cmp #'A' + blt lb3 +lb1a pha r8 = r8*16 + value(r4^) + mul4 r8,#16 + pla + and #$007F + cmp #'9'+1 + blt lb1b + sbc #7 +lb1b and #$000F + clc + adc r8 + sta r8 + bcc lb2 + inc r10 +lb2 inc4 r4 loop + dec r12 + bne lb1 + +lb2a lda r8 return value + ldx r10 + sec + rts + +lb3 clc return false + rts + end + +**************************************************************** +* +* InitOut - initialize the output buffer variables +* +**************************************************************** +* +InitOut start + using Common + using OutCommon + + lda #-1 no load segment is active + sta loadNumber + stz lastLoadNumber no load segments created + stz loadList no load segments in the list + stz loadList+2 + stz dynSegment no dynamic segment + rts + end + +**************************************************************** +* +* IsDynamic - is the segment dynamic? +* +* Inputs: +* A - segment to check +* +* Outputs: +* C - set if the segment is dynamic, else clear +* +**************************************************************** +* +IsDynamic start + using OutCommon + + cmp loadNumber if A = current segment then + bne lb2 + lda loadType return dynamic(loadType) +lb0 bpl lb1 + sec + rts +lb1 clc + rts + +lb2 sta r4 save the segment number + move4 loadList,r0 for each segment in the list do +lb3 lda r0 + ora r2 + beq lb1 + ldy #loadNumber-loadNext if this is the correct segment then + lda [r0],Y + cmp r4 + bne lb4 + ldy #loadType-loadNext return dynamic(r0^.loadType) + lda [r0],Y + bra lb0 +lb4 ldy #2 next segment + lda [r0],Y + tax + lda [r0] + sta r0 + stx r2 + bra lb3 + end + +**************************************************************** +* +* JumpTable - create/reuse a jump table entry +* +* Inputs: +* expValue - disp into the dynamic segment +* expSegment - dynamic segment number +* shiftFlag - shift flag for the expression +* +* Outputs: +* expValue - disp into the segment buffer +* expSegment - dynamic segment number +* +**************************************************************** +* +JumpTable start + using OutCommon + using ExpCommon +userID equ 0 disp to the user ID field +file equ 2 disp to the file number +seg equ 4 disp to the segment number +offset equ 6 disp to the offset (expr value) +jsl equ 10 disp to the jsl to the loader + +length equ 14 length of a record + +header equ 8+5 bytes in the buffer header + + add4 dynStart,#header,r0 check for an existing entry +lb1 cmpl r0,dy + bge lb3 + ldy #seg + lda [r0],Y + cmp expSegment + bne lb2 + ldy #offset + lda [r0],Y + cmp expValue + bne lb2 + iny + iny + lda [r0],Y + cmp expValue+2 + beq lb5 +lb2 add4 r0,#length + bra lb1 + +lb3 lda dynSize no existing entry; create a new one + cmp #length + bge lb4 + jsr ExpandDynamicBuffer +lb4 move4 dy,r0 + add4 dy,#length + lda #0 + sta [r0] + ldy #file + lda #1 + sta [r0],Y + ldy #seg + lda expSegment + sta [r0],Y + ldy #offset + lda expValue + sta [r0],Y + iny + iny + lda expValue+2 + sta [r0],Y + ldy #jsl + lda #$0022 + sta [r0],Y + iny + iny + lda #0 + sta [r0],Y + +lb5 sub4 r0,dynStart,expValue set the new expValue + add4 expValue,#jsl-5 + lda dynSegment set the new segment value + sta expSegment + lda shiftFlag check for an illegal shift + beq lb6 + ph4 #0 + ph2 #20 + jsr Error +lb6 rts + end + +**************************************************************** +* +* KeepFile - write the segments to the file +* +* Inputs: +* loadList - head of the load list +* kname - pointer to the output name +* +**************************************************************** +* +KeepFile start + using Common + using OutCommon + + lda #1 set the segment number + sta segment + jsr CreateFile create/check the file + move4 kname,opPathname open the file + OSOpen opRec + bcc lb0 +err12 lda #12 + jmp TermError + +lb0 lda opRefnum save the keep refnum + sta keepRefnum + sta clRefnum + sta mkRefnum + OSSet_EOF mkRec erase the old file contents + bcs err12 + lda compact if compact then + beq lb0a + jsr DoCompact compact the dictionaries +lb0a jsr SaveSegment save the current segment + jsr CreateDynamicSegment create the dynamic segment + lda express if express then + beq lb1 + jsr ExpressLoad write the expressload segment (if any) + inc segment first segment to process is 2 + +lb1 move4 loadList,r0 find the proper segment +lb2 ldy #loadNumber-loadNext + lda [r0],Y + cmp segment + beq lb3 + ldy #2 + lda [r0],Y + tax + lda [r0] + sta r0 + stx r2 + ora r2 + bne lb2 + OSClose clRec none left -- close the file + move4 loadList,r0 get a segment back + jsr GetSegment + jsr SetFileType + rts + +lb3 jsr GetSegment get and lock the segment + jsr AddEnd add an end record to the dictionary + jsr FinishLConst finish the current lconst record + lda express if express then + beq lb4 + jsr Remap remap the segment numbers + bra lb5 else +lb4 jsr OptimizeDS optimize the DS, LConst records +lb5 jsr WriteHeader write the header + jsr WriteBody write the segment image + jsr WriteDictionary write the dictionary + jsr SaveSegment save the segment + inc segment next segment + bra lb1 +; +; Local data +; +clRec dc i'1' close record +clRefnum ds 2 + +opRec dc i'2' open record +opRefnum ds 2 +opPathname ds 4 + +mkRec dc i'3' set mark record +mkRefnum ds 2 + dc i'0' + dc i4'0' + +segment ds 2 segment number + end + +**************************************************************** +* +* MoveSegment - move a segment record +* +* Inputs: +* r0 - pointer to the head of the new list +* r4 - pointer to the last record in the new list (if r0 <> nil) +* r8 - pointer to the record to move +* loadList - pointer to the first record in the old list +* +* Outputs: +* input pointers are modified +* +**************************************************************** +* +MoveSegment private + using OutCommon +; +; Break the back link +; + ldy #loadLast-loadNext if r8^.last = nil then + lda [r8],Y + iny + iny + ora [r8],Y + bne lb1 + ldy #2 loadList := r8^.next + lda [r8] + sta loadList + lda [r8],Y + sta loadList+2 + bra lb2 else +lb1 ldy #loadLast-loadNext r12 := r8^.last + lda [r8],Y + sta r12 + iny + iny + lda [r8],Y + sta r14 + ldy #2 r12^.next := r8^.next + lda [r8] + sta [r12] + lda [r8],Y + sta [r12],Y +lb2 anop endif +; +; Break the forward link +; + ldy #2 if r8^.next <> nil then + lda [r8] + ora [r8],Y + beq lb3 + lda [r8] r12 := r8^.next + sta r12 + lda [r8],Y + sta r14 + ldy #loadLast-loadNext r12^.last := r8^.last + lda [r8],Y + sta [r12],Y + iny + iny + lda [r8],Y + sta [r12],Y +lb3 anop endif +; +; Add the record to the new list +; + ldy #2 r8^.next := nil + lda #0 + sta [r8] + sta [r8],Y + lda r0 if r0 = nil then + ora r2 + bne lb4 + ldy #loadLast-loadNext r8^.last := nil + lda #0 + sta [r8],Y + iny + iny + sta [r8],Y + move4 r8,r0 r0 := r8 + bra lb5 else +lb4 ldy #2 r4^.next := r8 + lda r8 + sta [r4] + lda r10 + sta [r4],Y + ldy #loadLast-loadNext r8^.last := r4 + lda r4 + sta [r8],Y + iny + iny + lda r6 + sta [r8],Y +lb5 anop endif + move4 r8,r4 r4 := r8 + rts + end + +**************************************************************** +* +* NamedVariable - see if the variable is a file type +* +* Inputs: +* r0 - pointer to the shell variable value +* +* Outputs: +* C - set if we have a match, else clear +* X-A - variable value (if C is set) +* +**************************************************************** +* +NamedVariable private + + lda [r0] if length <> 3 then + cmp #3 + bne lb3 return false + lda #nameEnd-name-3 index into the name array + sta r4 + lda #$BA initial file number + sta r6 +lb1 ldx r4 check for match + ldy #2 + short M +lb1a lda [r0],Y + cmp name,X + beq lb1b + and #$5F + cmp name,X + bne lb2 +lb1b inx + iny + cpy #5 + bne lb1a + long M + lda r6 return the file type + ldx #0 + sec + rts + +lb2 long M no match - loop + dec r6 + sec + lda r4 + sbc #3 + sta r4 + bpl lb1 + +lb3 clc return false + rts +; +; Local data +; +name dc c'S16' file type mnemonics + dc c'RTL' + dc c'EXE' + dc c'PIF' + dc c'TIF' + dc c'NDA' + dc c'CDA' + dc c'TOL' +nameEnd anop + end + +**************************************************************** +* +* NewSegment - create a new segment record +* +* Inputs: +* loadNamePtr - pointer to the load name +* lastLoadNumber - load number for the last segment created +* +* Outputs: +* loadNumber - number of this load segment +* loadName - name of the load segment +* pc - 0 +* * - all other load record variables are set to 0 +* +**************************************************************** +* +NewSegment private + using Common + using OutCommon + + move #0,loadNext,#loadSize + move4 loadNamePtr,r0 + ldy #nameSize-2 +lb1 lda [r0],Y + sta loadName,Y + dey + dey + bpl lb1 + inc lastLoadNumber + lda lastLoadNumber + sta loadNumber + stz pc + stz pc+2 + rts + end + +**************************************************************** +* +* OptimizeDS - optimize DS and LConst records +* +* This subroutine removes LConst records that have a length +* of zero, and combines adjacent DS records. +* +* Inputs: +* op - ptr to the end of the load segment body +* opst - copy of op +* loadSegStart - start of the load segment body +* +* Outputs: +* op - ptr to the end of the load segment body +* opst - copy of op +* +**************************************************************** +* +OptimizeDS private + using Common + using OutCommon +LConst equ $F2 long contanst op-code +DS equ $F0 DS op-code + + lda loadSegStart r0 = to address + ldx loadSegStart+2 r4 = from address + sta r0 + stx r2 + sta r4 + stx r6 + stz r8 r8 = false {r0, r4 are the same} +lb2 cmpl r4,op while r4 <> op do + jge lb12 + lda [r4] if r4^ = LConst then + and #$00FF + cmp #LConst + bne lb3 + ldy #1 if length = 0 then + lda [r4],Y + ldy #3 + ora [r4],Y + bne lb4 + add4 r4,#5 skip the record + lda #1 r8 := true + sta r8 + bra lb2 +lb3 add4 r4,#5,r10 else {if r4^ = DS then} +lb3a cmpl r10,op if (r10 = r4+5) < op then + bge lb4 + lda [r10] if r10^ = LConst then + and #$00FF + cmp #LConst + bne lb3b + ldy #1 if r10^.length = 0 then + lda [r10],Y + ldy #3 + ora [r10],Y + bne lb4 + add4 r10,#5 skip the lconst + lda #1 r8 := true + sta r8 + bra lb3a try again +lb3b ldy #1 else if r10^ = DS then + clc r10^.length += r4^.length + lda [r10],Y + adc [r4],Y + sta [r10],Y + ldy #3 + lda [r10],Y + adc [r4],Y + sta [r10],Y + move4 r10,r4 r4 := r10 + lda #1 r8 := true + sta r8 + bra lb3 try again +lb4 lda r8 {move the record to the new spot} + beq lb10 if the record needs to be moved then + lda [r4] if r4^ = LConst then + and #$00FF + cmp #Lconst + bne lb9 + ldy #1 + lda [r4],Y + sta r10 + ldy #3 + lda [r4],Y + sta r12 + add4 r10,#5 + ldx r12 + beq lb6 + ldy #0 +lb5 lda [r4],Y + sta [r0],Y + iny + iny + bne lb5 + inc r2 + inc r6 + dex + bne lb5 +lb6 lda r10 + beq lb10 + ldy #0 + lsr A + tax + bcc lb7 + short M + lda [r4] + sta [r0] + long M + iny +lb7 txa + beq lb10 +lb8 lda [r4],Y + sta [r0],Y + iny + iny + dex + bne lb8 + bra lb10 else {if r4^ = DS then} +lb9 lda [r4] + sta [r0] + ldy #2 + lda [r4],Y + sta [r0],Y + iny + lda [r4],Y + sta [r0],Y +lb10 lda [r0] {next record} + and #$00FF + cmp #LConst + bne lb11 + clc + ldy #1 + lda [r0],Y + adc r4 + tax + ldy #3 + lda [r0],Y + adc r6 + sta r6 + stx r4 + clc + ldy #1 + lda [r0],Y + adc r0 + tax + ldy #3 + lda [r0],Y + adc r2 + sta r2 + stx r0 +lb11 add4 r0,#5 + add4 r4,#5 + brl lb2 endwhile + +lb12 lda r0 op = opst = r0 + ldx r2 + sta op + stx op+2 + sta opst + stx opst+2 + rts + end + +**************************************************************** +* +* Pass2Prep - prepare a buffer for the first call to pass2 +* +* Inputs: +* loadPass2 - has the buffer been prepared for pass 2? +* +**************************************************************** +* +Pass2Prep private + using Common + using OutCommon + + lda pass if this is not pass 2 + cmp #2 + bne lb1 + lda loadPass2 or the buffer has already been prepared + beq lb2 +lb1 rts return + +lb2 add4 length,loadPC update the length of the program + lda loadBanksize check for a bank overflow + ora loadBanksize+2 + beq lb2a + cmpl loadPC,loadBanksize + blt lb2a + ph4 #0 + ph2 #18 + jsr Error +lb2a pha get memory for the output buffer + pha + clc + lda loadPC + adc #5 + tax + lda loadPC+2 + adc #0 + pha + phx + ph2 userID + ph2 #$8000 + ph4 #0 + _NewHandle + bcc lb3 + lda #5 + jmp TermError +lb3 pl4 loadSeg + move4 loadSeg,r0 dereference the segment + ldy #2 + lda [r0] + sta loadSegStart + sta op + sta opst + lda [r0],Y + sta loadSegStart+2 + sta op+2 + sta opst+2 + add4 op,#5 skip the space for the lConst header + stz loadPC loadPC = 0 + stz loadPC+2 + stz loadOrg loadOrg = 0 + stz loadOrg+2 + stz loadAlign loadAlign = 0 + stz loadAlign+2 + stz pc pc = 0 + stz pc+2 + inc loadPass2 loadPass2 = true + rts + end + +**************************************************************** +* +* PrintSegmentInfo - print the segment statistics +* +* Inputs: +* loadList - head of the load list +* +**************************************************************** +* +PrintSegmentInfo start + using Common + using OutCommon + + puts #'Segment Information:',cr=t write segment header + putcr + puts #' Number Name Type Length Org',cr=t + putcr + jsr SaveSegment save the current segment + lda #1 set the segment number + sta segment + lda kflag + beq lb1 + lda express + beq lb1 + inc segment + +lb1 move4 loadList,r0 find the proper segment +lb2 ldy #loadNumber-loadNext + lda [r0],Y + cmp segment + beq lb3 + ldy #2 + lda [r0],Y + tax + lda [r0] + sta r0 + stx r2 + ora r2 + bne lb2 + + move4 loadList,r0 done - get a segment back + jsr GetSegment + rts + +lb3 put2 segment,#6 print the segment number + putc #' ',#6 + inc segment + ldy #loadName-loadNext print the segment name + short I,M + ldx #0 +lb3a lda [r0],Y + beq lb3b + sta name+1,X + iny + inx + cpx #10 + bne lb3a +lb3b stx name + sec + lda #13 + sbc name + sta fw + long I,M + puts name-1 + putc #'$',fw print the type + pea 0 + ldy #loadType-loadNext + lda [r0],Y + pha + ph2 #2 + ph2 #0 + jsr PrintHex + puts #' $' print the length + ldy #loadPC-loadNext+2 + lda [r0],Y + pha + dey + dey + lda [r0],Y + pha + ph2 #8 + ph2 #0 + jsr PrintHex + puts #' ' + ldy #loadORG-loadNext+2 print the org + lda [r0],Y + sta r6 + dey + dey + lda [r0],Y + sta r4 + ora r6 + beq lb4 + putc #'$' + ph4 r4 + ph2 #8 + ph2 #0 + jsr PrintHex + putcr + brl lb1 +lb4 puts #'Relocatable',cr=t + brl lb1 + +segment ds 2 segment number +name dc i1'10',10c' ' segment name +fw dc i'0' field width for spaces after name + end + +**************************************************************** +* +* Remap - remap the segment numbers in interseg references +* +* Inputs: +* loadDictStart - start of the dictionary +* +* Notes: +* This remapping is needed when express loading a segment +* changes the segment numbers. +* +**************************************************************** +* +Remap private + using OutCommon + + move4 loadDictStart,r0 + +lb1 lda [r0] get an op code + and #$00FF + jeq lb5 quit if it is the end + + cmp #$E2 skip reloc + bne lb2 + add4 r0,#11 + bra lb1 + +lb2 cmp #$E3 remap interseg + bne lb3 + ldy #9 + lda [r0],Y + dec A + asl A + tay + lda [expMap],Y + ldy #9 + sta [r0],Y + add4 r0,#15 + bra lb1 + +lb3 cmp #$F5 skip cReloc + bne lb4 + add4 r0,#7 + bra lb1 + +lb4 cmp #$F7 remap Super + jne lb4a + ldy #5 if r0^.type = 2 {interseg1} then + lda [r0],Y + and #$00FF + cmp #2 + jne sp7 + add4 r0,#6,r4 r4 = disp to 1st subrecord + sec r8 = page offset + lda loadSegStart + sbc #$0100-7 + sta r8 + lda loadSegStart+2 + sbc #0 + sta r10 + ldy #1 r12 = # bytes to process + lda [r0],Y + dec A + sta r12 +sp1 lda [r4] repeat + and #$00FF if r4^ & $80 <> 0 then + bit #$0080 + beq sp4 + and #$007F add in the page displacement + bne sp2 + lda #$0080 +sp2 xba + clc + adc r8 + sta r8 + bcc sp3 + inc r10 +sp3 inc4 r4 ++r4 + dec r12 --r12 + bra sp6 next entry +sp4 sta r14 else r14 = #bytes + 1 + inc4 r4 skip the count byte + dec r12 + lda r8 new page + clc + adc #$100 + sta r8 + bcc sp5 + inc r10 +sp5 short I,M repeat + lda [r4] remap one segment + tay + tax + lda [r8],Y + dec A + asl A + tay + lda [expMap],Y + txy + sta [r8],Y + long I,M + inc4 r4 ++r4 + dec r12 --r12 + dec r14 --r14 + bpl sp5 until r14 < 0 +sp6 lda r12 until r12 = 0 + bne sp1 + bra sp9 +sp7 cmp #14 else if r0^.type in [14..25] then + blt sp9 + cmp #26 + bge sp8 + short I,M remap the segment number + sec + sbc #14 + asl A + tay + lda [expMap],Y + clc + adc #13 + ldy #5 + sta [r0],Y + long I,M + bra sp9 else if r0^.type in [26..37] then +sp8 short I,M remap the segment number + sec + sbc #26 + asl A + tay + lda [expMap],Y + clc + adc #25 + ldy #5 + sta [r0],Y + long I,M +sp9 anop endif + ldy #1 skip the record + clc + lda [r0],Y + adc r0 + tax + iny + iny + lda [r0],Y + adc r2 + sta r2 + stx r0 + add4 r0,#5 + brl lb1 + +lb4a short I,M remap cInterseg + ldy #5 + lda [r0],Y + dec A + asl A + tay + lda [expMap],Y + ldy #5 + sta [r0],Y + long I,M + add4 r0,#8 + brl lb1 + +lb5 rts + end + +**************************************************************** +* +* RemapJumpTable - remap the segment numbers in the jump table +* +* Inputs: +* loadSegStart - start of the jump table buffer +* +* Notes: +* This remapping is needed when express loading a segment +* changes the segment numbers. +* +**************************************************************** +* +RemapJumpTable private + using OutCommon + + add4 loadSegStart,#8+5,r0 + +lb1 ldy #2 quit if file = 0 + lda [r0],Y + beq lb2 + + ldy #4 remap a segment + lda [r0],Y + dec A + asl A + tay + lda [expMap],Y + ldy #4 + sta [r0],Y + add4 r0,#14 + bra lb1 + +lb2 rts + end + +**************************************************************** +* +* SaveSegment - save the current load segment record +* +**************************************************************** +* +SaveSegment private + using OutCommon + + move4 loadList,loadNext insert the record in the linked list + stz loadLast + stz loadLast+2 + move4 pc,loadPC save the current pc + lda loadSeg if there is a segment buffer then + ora loadSeg+2 + beq lb1 + sub4 op,loadSegStart,loadOp save the op displacement + sub4 opst,loadSegStart,loadOpSt save the opst displacement + ph4 loadSeg unlock the segment buffer + _HUnlock +lb1 lda loadDict if there is a dictionary buffer then + ora loadDict+2 + beq lb2 + sub4 dp,loadDictStart,loadDP save the dp displacement + ph4 loadDict unlock the dictionary buffer + _HUnlock +lb2 lda loadPtr if there is no spot reserved then + ora loadPtr+2 + bne lb3 + ph2 #loadSize get some space + jsr GetSymbolMemory + sta loadPtr + stx loadPtr+2 +lb3 move4 loadPtr,r0 save the record + ldy #loadSize-2 +lb4 lda loadNext,Y + sta [r0],Y + dey + dey + bpl lb4 + lda loadList if loadList <> nil then + ora loadList+2 + beq lb5 + move4 loadList,r0 loadList^.loadLast = loadPtr + ldy #loadLast-loadNext + lda loadPtr + sta [r0],Y + iny + iny + lda loadPtr+2 + sta [r0],Y +lb5 move4 loadPtr,loadList point the head to this segment + rts + end + +**************************************************************** +* +* SetFileType - set the file type and aux type +* +* Inputs: +* kname - keep name pointer +* +**************************************************************** +* +SetFileType private +; +; Get the current file info +; + move4 kname,giPathName + OSGet_File_Info giRec +; +; Set the file type +; + ph4 #FileType read the file type variable + jsr ReadVariable + sta r0 + stx r2 + lda [r0] if the variable exists then + beq lb2 + jsr NamedVariable handle a named variable + bcs lb1 + jsr DecimalVariable handle a decimal variable + bcs lb1 + jsr HexVariable handle a hex variable + bcs lb1 +err13 ph4 #0 flag a bad file name error + ph2 #13 + jsr Error + bra lb2 +lb1 txy check for a file type out of range + bne err13 + cmp #$B3 + blt err13 + cmp #$BF+1 + bge err13 + sta giFileType set the file type + bra lb3 else +lb2 lda #EXE use the default file type + sta giFileType +lb3 anop endif + ph4 r0 Free(r0) + jsr Free +; +; Set the aux type +; + ph4 #AuxType read the file type variable + jsr ReadVariable + sta r0 + stx r2 + lda [r0] if the variable exists then + beq ax2 + jsr DecimalVariable handle a decimal variable + bcs ax1 + jsr HexVariable handle a hex variable + bcs ax1 + ph4 #0 flag a bad file name error + ph2 #19 + jsr Error + bra ax2 +ax1 stx giAuxType+2 save the aux type + sta giAuxType + bra ax3 else +ax2 lla giAuxType,$100 use the default aux type +ax3 anop endif + ph4 r0 Free(r0) + jsr Free +; +; Update the file info +; + OSSet_File_Info giRec + bcs fi1 + rts + +fi1 lda #12 + jmp TermError +; +; Local data +; +giRec dc i'4' get/set file info record +giPathname ds 4 + ds 2 +giFileType ds 2 +giAuxType ds 4 + +FileType dos KeepType filetype shell variable name +AuxType dos AuxType auxtype shell variable name + end + +**************************************************************** +* +* WriteBody - write the body of a load segment +* +* Inputs: +* loadNext... - load segment record +* keepRefnum - keep file reference number +* +**************************************************************** +* +WriteBody private + using Common + using OutCommon + + lda express if express then + beq lb0 + lda loadNumber if loadNumber = dynSegment then + cmp dynSegment + bne lb0 + jsr RemapJumpTable remap the dynamic jump table +lb0 move4 loadSegStart,wrBuff set the buffer address + sub4 op,loadSegStart,wrLength set the length + lda keepRefnum set the refnum + sta wrRefnum + OSWrite wrRec write the segment + bcs lb1 + rts + +lb1 lda #12 + jmp TermError +; +; Local data +; +wrRec dc i'4' write the segment +wrRefnum ds 2 +wrBuff ds 4 +wrLength ds 4 + ds 4 + end + +**************************************************************** +* +* WriteDictionary - write the dictionary for a load segment +* +* Inputs: +* loadNext... - load segment record +* keepRefnum - keep file reference number +* +**************************************************************** +* +WriteDictionary private + using Common + using OutCommon + + sub4 dp,loadDictStart,wrLength set the length + move4 loadDictStart,wrBuff set the buffer address + lda keepRefnum set the refnum + sta wrRefnum + OSWrite wrRec write the segment + bcs lb1 + rts + +lb1 lda #12 + jmp TermError +; +; Local data +; +wrRec dc i'4' write the segment +wrRefnum ds 2 +wrBuff ds 4 +wrLength ds 4 + ds 4 + end + +**************************************************************** +* +* WriteHeader - write the segment header for a load segment +* +* Inputs: +* loadNext... - load segment record +* keepRefnum - keep file reference number +* +* Notes: +* This subroutine also writes the lConst opcode and +* length field for the code image that will be written +* by WriteBody. +* +**************************************************************** +* +WriteHeader private + using OutCommon + +! set the size of the segment + sub4 opst,loadSegStart,byteCnt + add4 byteCnt,#headerEnd-header + sub4 dp,loadDictStart,r0 + add4 byteCnt,r0 + move4 loadPC,length set the length of the segment + move4 loadBankSize,bankSize set the bankSize of the segment + lda loadType set the kind of the segment + sta kind + move4 loadORG,org set the org of the segment + move4 loadAlign,align set the alignment factor of the segment + lda loadNumber set the segment number + sta segNum + move loadName,segName,#nameSize set the segment name + + lda keepRefnum write the header + sta wrRefnum + OSWrite wrRec + bcs lb1 + rts + +lb1 lda #12 + jmp TermError +; +; Local data +; +wrRec dc i'4' write the segment +wrRefnum ds 2 + da 'header' + dc i4'headerEnd-header' + ds 4 + +header anop segment header model +byteCnt ds 4 length of the segment, in bytes + dc i4'0' reserved space at the end of the segment +length ds 4 length of the segment + dc i1'0' undefined + dc i1'0' label length + dc i1'4' number length + dc i1'2' OMF version +bankSize ds 4 bank size +kind ds 2 segment kind + dc i'0' undefined +org ds 4 origin +align ds 4 alignment factor + dc i1'0' numSex; set to LSB first + dc i1'0' undefined +segnum ds 2 segment number + ds 4 entry point + dc i'ldName-header' disp to the segment name + dc i'headerEnd-header' disp to the segment image + dc i4'0' temp ORG +ldName dc 10c' ' load segment name; unused in load segs + dc i1'10' length of the segment name +segName ds 10 segment name +headerEnd anop + end + diff --git a/out.mac b/out.mac old mode 100755 new mode 100644 index ac8af81..7efdc97 --- a/out.mac +++ b/out.mac @@ -1 +1,793 @@ - macro &lab da &op &lab dc a3"&op" dc i1'0' mend macro &lab cmpl &n1,&n2 &lab lda 2+&n1 cmp 2+&n2 bne ~&syscnt lda &n1 cmp &n2 ~&syscnt anop mend MACRO &LAB DOS &ADR &LAB DC I"L:~&SYSNAME&SYSCNT" ~&SYSNAME&SYSCNT DC C"&ADR" MEND MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND MACRO &LAB MOVE &AD1,&AD2,&LEN &LAB ANOP LCLB &LA LCLB &LI LCLC &C AIF C:&LEN,.A1 LCLC &LEN &LEN SETC #2 .A1 &LA SETB S:LONGA &LI SETB S:LONGI AIF S:LONGA.AND.S:LONGI,.A REP #32*(.NOT.&LA)+16*(.NOT.&LI) LONGA ON LONGI ON .A &C AMID &LEN,1,1 AIF "&C"<>"#",.D &C AMID &LEN,2,L:&LEN-1 AIF &C<>2,.D &C AMID &AD1,1,1 AIF "&C"<>"{",.B &AD1 AMID &AD1,2,L:&AD1-2 &AD1 SETC (&AD1) .B LDA &AD1 &C AMID &AD2,1,1 AIF "&C"<>"{",.C &AD2 AMID &AD2,2,L:&AD2-2 &AD2 SETC (&AD2) .C STA &AD2 AGO .G .D &C AMID &AD1,1,1 AIF "&C"="#",.F &C AMID &LEN,1,1 AIF "&C"<>"{",.E &LEN AMID &LEN,2,L:&LEN-2 &LEN SETC (&LEN) .E &C AMID &LEN,1,1 AIF "&C"="#",.E1 LDA &LEN DEC A AGO .E2 .E1 LDA &LEN-1 .E2 LDX #&AD1 LDY #&AD2 MVN &AD1,&AD2 AGO .G .F LDA &AD1 STA &AD2 LDA &LEN-2 LDX #&AD2 LDY #&AD2+1 MVN &AD2,&AD2 .G AIF (&LA+&LI)=2,.I SEP #32*(.NOT.&LA)+16*(.NOT.&LI) AIF &LA,.H LONGA OFF .H AIF &LI,.I LONGI OFF .I MEND macro &l put2 &n1,&f1,&cr,&errout aif c:&f1,.a lclc &f1 &f1 setc #0 .a &l ~setm ph2 &n1 ph2 &f1 ph2 #c:&cr ph2 #c:&errout jsl ~put2 ~restm mend macro &l puts &n1,&f1,&cr,&errout &l ~setm lclc &c &c amid "&n1",1,1 aif "&c"<>"#",.c aif l:&n1>127,.a bra ~&SYSCNT ago .b .a brl ~&SYSCNT .b &n1 amid "&n1",2,l:&n1-1 ~l&SYSCNT dc i1"l:~s&SYSCNT" ~s&SYSCNT dc c&n1 ~&SYSCNT anop &n1 setc ~l&SYSCNT-1 .c ~pusha &n1 aif c:&f1,.c1 pea 0 ago .c2 .c1 ph2 &f1 .c2 ph2 #c:&cr ph2 #c:&errout jsl ~puts ~restm mend macro &l putc &n1,&f1,&cr,&errout &l ~setm ph2 &n1 aif c:&f1,.a pea 0 ago .b .a ph2 &f1 .b ph2 #c:&cr ph2 #c:&errout jsl ~putc ~restm mend macro &l putcr &errout &l ~setm pea $0D aif c:&errout,.a jsl SysCharOut ~restm mexit .a jsl SysCharErrout ~restm mend macro &l add2 &n1,&n2,&n3 aif c:&n3,.a lclc &n3 &n3 setc &n1 .a &l ~setm clc ~lda &n1 ~op adc,&n2 ~sta &n3 ~restm mend macro &l sub2 &n1,&n2,&n3 aif c:&n3,.a lclc &n3 &n3 setc &n1 .a &l ~setm sec ~lda &n1 ~op sbc,&n2 ~sta &n3 ~restm mend macro &l add4 &m1,&m2,&m3 lclb &yistwo lclc &c &l ~setm aif c:&m3,.a &c amid "&m2",1,1 aif "&c"<>"#",.a &c amid "&m1",1,1 aif "&c"="{",.a aif "&c"="[",.a &c amid "&m2",2,l:&m2-1 aif &c>=65536,.a clc ~lda &m1 ~op adc,&m2 ~sta &m1 bcc ~&SYSCNT ~op.h inc,&m1 ~&SYSCNT anop ago .c .a aif c:&m3,.b lclc &m3 &m3 setc &m1 .b clc ~lda &m1 ~op adc,&m2 ~sta &m3 ~lda.h &m1 ~op.h adc,&m2 ~sta.h &m3 .c ~restm mend macro &l mul4 &n1,&n2,&n3 &l ~setm ph4 &n1 ph4 &n2 jsl ~mul4 aif c:&n3,.a pl4 &n1 ago .b .a pl4 &n3 .b ~restm mend macro &l sub4 &m1,&m2,&m3 lclb &yistwo lclc &c &l ~setm aif c:&m3,.a &c amid "&m2",1,1 aif "&c"<>"#",.a &c amid "&m1",1,1 aif "&c"="{",.a aif "&c"="[",.a &c amid "&m2",2,l:&m2-1 aif &c>=65536,.a sec ~lda &m1 ~op sbc,&m2 ~sta &m1 bcs ~&SYSCNT ~op.h dec,&m1 ~&SYSCNT anop ago .c .a aif c:&m3,.b lclc &m3 &m3 setc &m1 .b sec ~lda &m1 ~op sbc,&m2 ~sta &m3 ~lda.h &m1 ~op.h sbc,&m2 ~sta.h &m3 .c ~restm mend macro &l inc4 &a &l ~setm inc &a bne ~&SYSCNT inc 2+&a ~&SYSCNT ~restm mend macro &l jcs &bp &l bcc *+5 brl &bp mend macro &l jeq &bp &l bne *+5 brl &bp mend macro &l jge &bp &l blt *+5 brl &bp mend macro &l jne &bp &l beq *+5 brl &bp mend macro &l la &ad1,&ad2 &l anop lcla &lb lclb &la aif s:longa,.a rep #%00100000 longa on &la setb 1 .a lda #&ad2 &lb seta c:&ad1 .b sta &ad1(&lb) &lb seta &lb-1 aif &lb,^b aif &la=0,.d sep #%00100000 longa off .d mend macro &l lla &ad1,&ad2 &l anop lcla &lb lclb &la aif s:longa,.a rep #%00100000 longa on &la setb 1 .a lda #&ad2 &lb seta c:&ad1 .b sta &ad1(&lb) &lb seta &lb-1 aif &lb,^b lda #^&ad2 &lb seta c:&ad1 .c sta 2+&ad1(&lb) &lb seta &lb-1 aif &lb,^c aif &la=0,.d sep #%00100000 longa off .d mend macro &l long &a,&b lclb &i lclb &m &a amid &a,1,1 &m setb ("&a"="M").or.("&a"="m") &i setb ("&a"="I").or.("&a"="i") aif c:&b=0,.a &b amid &b,1,1 &m setb ("&b"="M").or.("&b"="m").or.&m &i setb ("&b"="I").or.("&b"="i").or.&i .a &l rep #&m*32+&i*16 aif .not.&m,.b longa on .b aif .not.&i,.c longi on .c mend macro &l ph2 &n1 &l anop aif "&n1"="*",.f lclc &c &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 lda (&n1) pha ago .e .b aif "&c"="<",.c lda &n1 pha ago .e .c &n1 amid &n1,2,l:&n1-1 pei &n1 ago .e .d &n1 amid &n1,2,l:&n1-1 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l ph4 &n1 &l anop aif "&n1"="*",.f lclc &c &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 ldy #2 lda (&n1),y pha lda (&n1) pha ago .e .b aif "&c"<>"[",.c ldy #2 lda &n1,y pha lda &n1 pha ago .e .c aif "&c"<>"<",.c1 &n1 amid &n1,2,l:&n1-1 pei &n1+2 pei &n1 ago .e .c1 lda &n1+2 pha lda &n1 pha ago .e .d &n1 amid &n1,2,l:&n1-1 pea +(&n1)|-16 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l pl4 &n1 lclc &c &l anop aif s:longa=1,.a rep #%00100000 .a &c amid &n1,1,1 aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.f &n1 amid &n1,2,l:&n1-2 pla sta (&n1) ldy #2 pla sta (&n1),y ago .d .b aif "&c"<>"[",.c pla sta &n1 ldy #2 pla sta &n1,y ago .d .c pla sta &n1 pla sta &n1+2 .d aif s:longa=1,.e sep #%00100000 .e mexit .f mnote "Missing closing '}'",16 mend macro &l short &a,&b lclb &i lclb &m &a amid &a,1,1 &m setb ("&a"="M").or.("&a"="m") &i setb ("&a"="I").or.("&a"="i") aif c:&b=0,.a &b amid &b,1,1 &m setb ("&b"="M").or.("&b"="m").or.&m &i setb ("&b"="I").or.("&b"="i").or.&i .a &l sep #&m*32+&i*16 aif .not.&m,.b longa off .b aif .not.&i,.c longi off .c mend macro &l ~lda &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l lda &op mend macro &l ~lda.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" lda &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" lda &op mexit .e lda 2+&op mend macro &l ~op &opc,&op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l &opc &op mend macro &l ~op.h &opc,&op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" &opc &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" &opc &op mexit .e &opc 2+&op mend macro &l ~pusha &n1 lclc &c &l anop &c amid &n1,1,1 aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 sep #$20 longa off lda #0 pha rep #$20 longa on phk lda &n1 pha mexit .b aif "&c"<>"[",.c &n1 amid &n1,2,l:&n1-2 lda &n1+2 pha lda &n1 pha mexit .c pea +(&n1)|-16 pea &n1 mexit .g mnote "Missing closing '}'",16 mend macro &l ~restm &l anop aif (&~la+&~li)=2,.i sep #32*(.not.&~la)+16*(.not.&~li) aif &~la,.h longa off .h aif &~li,.i longi off .i mend macro &l ~setm &l anop aif c:&~la,.b gblb &~la gblb &~li .b &~la setb s:longa &~li setb s:longi aif s:longa.and.s:longi,.a rep #32*(.not.&~la)+16*(.not.&~li) longa on longi on .a mend macro &l ~sta &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l sta &op mend macro &l ~sta.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" sta &op mexit .d sta 2+&op mend macro &l osclose &p &l jsl $E100A8 dc i2'$2014' dc i4'&p' mend macro &l oscreate &p &l jsl $E100A8 dc i2'$2001' dc i4'&p' mend macro &l osget_file_info &p &l jsl $E100A8 dc i2'$2006' dc i4'&p' mend macro &l osopen &p &l jsl $E100A8 dc i2'$2010' dc i4'&p' mend macro &l osset_eof &p &l jsl $E100A8 dc i2'$2018' dc i4'&p' mend macro &l osset_file_info &p &l jsl $E100A8 dc i2'$2005' dc i4'&p' mend macro &l oswrite &p &l jsl $E100A8 dc i2'$2013' dc i4'&p' mend MACRO &lab _DisposeHandle &lab ldx #$1002 jsl $E10000 MEND MACRO &lab _GetHandleSize &lab ldx #$1802 jsl $E10000 MEND MACRO &lab _HLock &lab ldx #$2002 jsl $E10000 MEND MACRO &lab _HUnlock &lab ldx #$2202 jsl $E10000 MEND MACRO &lab _NewHandle &lab ldx #$0902 jsl $E10000 MEND MACRO &lab _SetHandleSize &lab ldx #$1902 jsl $E10000 MEND \ No newline at end of file + macro +&lab da &op +&lab dc a3"&op" + dc i1'0' + mend + macro +&lab cmpl &n1,&n2 +&lab lda 2+&n1 + cmp 2+&n2 + bne ~&syscnt + lda &n1 + cmp &n2 +~&syscnt anop + mend + MACRO +&LAB DOS &ADR +&LAB DC I"L:~&SYSNAME&SYSCNT" +~&SYSNAME&SYSCNT DC C"&ADR" + MEND + MACRO +&LAB MOVE4 &F,&T +&LAB ~SETM + LDA 2+&F + STA 2+&T + LDA &F + STA &T + ~RESTM + MEND + MACRO +&LAB MOVE &AD1,&AD2,&LEN +&LAB ANOP + LCLB &LA + LCLB &LI + LCLC &C + AIF C:&LEN,.A1 + LCLC &LEN +&LEN SETC #2 +.A1 +&LA SETB S:LONGA +&LI SETB S:LONGI + AIF S:LONGA.AND.S:LONGI,.A + REP #32*(.NOT.&LA)+16*(.NOT.&LI) + LONGA ON + LONGI ON +.A +&C AMID &LEN,1,1 + AIF "&C"<>"#",.D +&C AMID &LEN,2,L:&LEN-1 + AIF &C<>2,.D +&C AMID &AD1,1,1 + AIF "&C"<>"{",.B +&AD1 AMID &AD1,2,L:&AD1-2 +&AD1 SETC (&AD1) +.B + LDA &AD1 +&C AMID &AD2,1,1 + AIF "&C"<>"{",.C +&AD2 AMID &AD2,2,L:&AD2-2 +&AD2 SETC (&AD2) +.C + STA &AD2 + AGO .G +.D +&C AMID &AD1,1,1 + AIF "&C"="#",.F +&C AMID &LEN,1,1 + AIF "&C"<>"{",.E +&LEN AMID &LEN,2,L:&LEN-2 +&LEN SETC (&LEN) +.E +&C AMID &LEN,1,1 + AIF "&C"="#",.E1 + LDA &LEN + DEC A + AGO .E2 +.E1 + LDA &LEN-1 +.E2 + LDX #&AD1 + LDY #&AD2 + MVN &AD1,&AD2 + AGO .G +.F + LDA &AD1 + STA &AD2 + LDA &LEN-2 + LDX #&AD2 + LDY #&AD2+1 + MVN &AD2,&AD2 +.G + AIF (&LA+&LI)=2,.I + SEP #32*(.NOT.&LA)+16*(.NOT.&LI) + AIF &LA,.H + LONGA OFF +.H + AIF &LI,.I + LONGI OFF +.I + MEND + macro +&l put2 &n1,&f1,&cr,&errout + aif c:&f1,.a + lclc &f1 +&f1 setc #0 +.a +&l ~setm + ph2 &n1 + ph2 &f1 + ph2 #c:&cr + ph2 #c:&errout + jsl ~put2 + ~restm + mend + macro +&l puts &n1,&f1,&cr,&errout +&l ~setm + lclc &c +&c amid "&n1",1,1 + aif "&c"<>"#",.c + aif l:&n1>127,.a + bra ~&SYSCNT + ago .b +.a + brl ~&SYSCNT +.b +&n1 amid "&n1",2,l:&n1-1 +~l&SYSCNT dc i1"l:~s&SYSCNT" +~s&SYSCNT dc c&n1 +~&SYSCNT anop +&n1 setc ~l&SYSCNT-1 +.c + ~pusha &n1 + aif c:&f1,.c1 + pea 0 + ago .c2 +.c1 + ph2 &f1 +.c2 + ph2 #c:&cr + ph2 #c:&errout + jsl ~puts + ~restm + mend + macro +&l putc &n1,&f1,&cr,&errout +&l ~setm + ph2 &n1 + aif c:&f1,.a + pea 0 + ago .b +.a + ph2 &f1 +.b + ph2 #c:&cr + ph2 #c:&errout + jsl ~putc + ~restm + mend + macro +&l putcr &errout +&l ~setm + pea $0D + aif c:&errout,.a + jsl SysCharOut + ~restm + mexit +.a + jsl SysCharErrout + ~restm + mend + macro +&l add2 &n1,&n2,&n3 + aif c:&n3,.a + lclc &n3 +&n3 setc &n1 +.a +&l ~setm + clc + ~lda &n1 + ~op adc,&n2 + ~sta &n3 + ~restm + mend + macro +&l sub2 &n1,&n2,&n3 + aif c:&n3,.a + lclc &n3 +&n3 setc &n1 +.a +&l ~setm + sec + ~lda &n1 + ~op sbc,&n2 + ~sta &n3 + ~restm + mend + macro +&l add4 &m1,&m2,&m3 + lclb &yistwo + lclc &c +&l ~setm + aif c:&m3,.a +&c amid "&m2",1,1 + aif "&c"<>"#",.a +&c amid "&m1",1,1 + aif "&c"="{",.a + aif "&c"="[",.a +&c amid "&m2",2,l:&m2-1 + aif &c>=65536,.a + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m1 + bcc ~&SYSCNT + ~op.h inc,&m1 +~&SYSCNT anop + ago .c +.a + aif c:&m3,.b + lclc &m3 +&m3 setc &m1 +.b + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m3 + ~lda.h &m1 + ~op.h adc,&m2 + ~sta.h &m3 +.c + ~restm + mend + macro +&l mul4 &n1,&n2,&n3 +&l ~setm + ph4 &n1 + ph4 &n2 + jsl ~mul4 + aif c:&n3,.a + pl4 &n1 + ago .b +.a + pl4 &n3 +.b + ~restm + mend + macro +&l sub4 &m1,&m2,&m3 + lclb &yistwo + lclc &c +&l ~setm + aif c:&m3,.a +&c amid "&m2",1,1 + aif "&c"<>"#",.a +&c amid "&m1",1,1 + aif "&c"="{",.a + aif "&c"="[",.a +&c amid "&m2",2,l:&m2-1 + aif &c>=65536,.a + sec + ~lda &m1 + ~op sbc,&m2 + ~sta &m1 + bcs ~&SYSCNT + ~op.h dec,&m1 +~&SYSCNT anop + ago .c +.a + aif c:&m3,.b + lclc &m3 +&m3 setc &m1 +.b + sec + ~lda &m1 + ~op sbc,&m2 + ~sta &m3 + ~lda.h &m1 + ~op.h sbc,&m2 + ~sta.h &m3 +.c + ~restm + mend + macro +&l inc4 &a +&l ~setm + inc &a + bne ~&SYSCNT + inc 2+&a +~&SYSCNT ~restm + mend + macro +&l jcs &bp +&l bcc *+5 + brl &bp + mend + macro +&l jeq &bp +&l bne *+5 + brl &bp + mend + macro +&l jge &bp +&l blt *+5 + brl &bp + mend + macro +&l jne &bp +&l beq *+5 + brl &bp + mend + macro +&l la &ad1,&ad2 +&l anop + lcla &lb + lclb &la + aif s:longa,.a + rep #%00100000 + longa on +&la setb 1 +.a + lda #&ad2 +&lb seta c:&ad1 +.b + sta &ad1(&lb) +&lb seta &lb-1 + aif &lb,^b + aif &la=0,.d + sep #%00100000 + longa off +.d + mend + macro +&l lla &ad1,&ad2 +&l anop + lcla &lb + lclb &la + aif s:longa,.a + rep #%00100000 + longa on +&la setb 1 +.a + lda #&ad2 +&lb seta c:&ad1 +.b + sta &ad1(&lb) +&lb seta &lb-1 + aif &lb,^b + lda #^&ad2 +&lb seta c:&ad1 +.c + sta 2+&ad1(&lb) +&lb seta &lb-1 + aif &lb,^c + aif &la=0,.d + sep #%00100000 + longa off +.d + mend + macro +&l long &a,&b + lclb &i + lclb &m +&a amid &a,1,1 +&m setb ("&a"="M").or.("&a"="m") +&i setb ("&a"="I").or.("&a"="i") + aif c:&b=0,.a +&b amid &b,1,1 +&m setb ("&b"="M").or.("&b"="m").or.&m +&i setb ("&b"="I").or.("&b"="i").or.&i +.a +&l rep #&m*32+&i*16 + aif .not.&m,.b + longa on +.b + aif .not.&i,.c + longi on +.c + mend + macro +&l ph2 &n1 +&l anop + aif "&n1"="*",.f + lclc &c +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + lda (&n1) + pha + ago .e +.b + aif "&c"="<",.c + lda &n1 + pha + ago .e +.c +&n1 amid &n1,2,l:&n1-1 + pei &n1 + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l ph4 &n1 +&l anop + aif "&n1"="*",.f + lclc &c +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + ldy #2 + lda (&n1),y + pha + lda (&n1) + pha + ago .e +.b + aif "&c"<>"[",.c + ldy #2 + lda &n1,y + pha + lda &n1 + pha + ago .e +.c + aif "&c"<>"<",.c1 +&n1 amid &n1,2,l:&n1-1 + pei &n1+2 + pei &n1 + ago .e +.c1 + lda &n1+2 + pha + lda &n1 + pha + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea +(&n1)|-16 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l pl4 &n1 + lclc &c +&l anop + aif s:longa=1,.a + rep #%00100000 +.a +&c amid &n1,1,1 + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.f +&n1 amid &n1,2,l:&n1-2 + pla + sta (&n1) + ldy #2 + pla + sta (&n1),y + ago .d +.b + aif "&c"<>"[",.c + pla + sta &n1 + ldy #2 + pla + sta &n1,y + ago .d +.c + pla + sta &n1 + pla + sta &n1+2 +.d + aif s:longa=1,.e + sep #%00100000 +.e + mexit +.f + mnote "Missing closing '}'",16 + mend + macro +&l short &a,&b + lclb &i + lclb &m +&a amid &a,1,1 +&m setb ("&a"="M").or.("&a"="m") +&i setb ("&a"="I").or.("&a"="i") + aif c:&b=0,.a +&b amid &b,1,1 +&m setb ("&b"="M").or.("&b"="m").or.&m +&i setb ("&b"="I").or.("&b"="i").or.&i +.a +&l sep #&m*32+&i*16 + aif .not.&m,.b + longa off +.b + aif .not.&i,.c + longi off +.c + mend + macro +&l ~lda &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l lda &op + mend + macro +&l ~lda.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + lda &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + lda &op + mexit +.e + lda 2+&op + mend + macro +&l ~op &opc,&op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l &opc &op + mend + macro +&l ~op.h &opc,&op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + &opc &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + &opc &op + mexit +.e + &opc 2+&op + mend + macro +&l ~pusha &n1 + lclc &c +&l anop +&c amid &n1,1,1 + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + sep #$20 + longa off + lda #0 + pha + rep #$20 + longa on + phk + lda &n1 + pha + mexit +.b + aif "&c"<>"[",.c +&n1 amid &n1,2,l:&n1-2 + lda &n1+2 + pha + lda &n1 + pha + mexit +.c + pea +(&n1)|-16 + pea &n1 + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l ~restm +&l anop + aif (&~la+&~li)=2,.i + sep #32*(.not.&~la)+16*(.not.&~li) + aif &~la,.h + longa off +.h + aif &~li,.i + longi off +.i + mend + macro +&l ~setm +&l anop + aif c:&~la,.b + gblb &~la + gblb &~li +.b +&~la setb s:longa +&~li setb s:longi + aif s:longa.and.s:longi,.a + rep #32*(.not.&~la)+16*(.not.&~li) + longa on + longi on +.a + mend + macro +&l ~sta &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l sta &op + mend + macro +&l ~sta.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + sta &op + mexit +.d + sta 2+&op + mend + macro +&l osclose &p +&l jsl $E100A8 + dc i2'$2014' + dc i4'&p' + mend + macro +&l oscreate &p +&l jsl $E100A8 + dc i2'$2001' + dc i4'&p' + mend + macro +&l osget_file_info &p +&l jsl $E100A8 + dc i2'$2006' + dc i4'&p' + mend + macro +&l osopen &p +&l jsl $E100A8 + dc i2'$2010' + dc i4'&p' + mend + macro +&l osset_eof &p +&l jsl $E100A8 + dc i2'$2018' + dc i4'&p' + mend + macro +&l osset_file_info &p +&l jsl $E100A8 + dc i2'$2005' + dc i4'&p' + mend + macro +&l oswrite &p +&l jsl $E100A8 + dc i2'$2013' + dc i4'&p' + mend + MACRO +&lab _DisposeHandle +&lab ldx #$1002 + jsl $E10000 + MEND + MACRO +&lab _GetHandleSize +&lab ldx #$1802 + jsl $E10000 + MEND + MACRO +&lab _HLock +&lab ldx #$2002 + jsl $E10000 + MEND + MACRO +&lab _HUnlock +&lab ldx #$2202 + jsl $E10000 + MEND + MACRO +&lab _NewHandle +&lab ldx #$0902 + jsl $E10000 + MEND + MACRO +&lab _SetHandleSize +&lab ldx #$1902 + jsl $E10000 + MEND diff --git a/pass1.asm b/pass1.asm old mode 100755 new mode 100644 index c513f14..b18a290 --- a/pass1.asm +++ b/pass1.asm @@ -1 +1,873 @@ - keep obj/pass1 mcopy pass1.mac **************************************************************** * * Pass 1 * * This module contains the subroutines used to do pass 1 * processing of the input files. * **************************************************************** copy directPage **************************************************************** * * Align - align the code to a byte boundary * * Inputs: * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * Align private ldy #1 get the alignment factor lda [sp],Y sta r0 iny iny lda [sp],Y sta r2 add4 sp,#5 jsr PrepareAlign do pass 1 prep for the align rts end **************************************************************** * * Const - constant bytes * * Inputs: * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * Const private lda [sp] and #$00FF tax clc adc pc sta pc bcc lb1 inc pc+2 lb1 txa sec adc sp sta sp bcc lb2 inc sp+2 lb2 rts end **************************************************************** * * DefineSegment - put the segment in the symbol table * * Inputs: * segName - pointer to the segment name * segType - segment type * pc - current pc * segEntry - disp to segment entry point * **************************************************************** * DefineSegment private using Common ph4 segName push the symbol name ptr ph2 #0 length attribute is 0 ph2 #'N' push the type attribute lda segType push the private flag and #$4000 beq lb1 lda #1 lb1 pha ph2 #1 the symbol is global ph2 #0 the symbol is not an expression clc push the location lda pc adc segEntry tax lda pc+2 adc segEntry+2 pha phx lda segType push the data area flag and #$007F cmp #1 beq lb2 ph2 #0 bra lb3 lb2 ph2 #1 lb3 ph2 #1 push the segment flag jsr Define define the symbol rts end **************************************************************** * * DoOrg - set the program counter * * Inputs: * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * DoOrg private using OutCommon ldy #1 get the value and skip the record lda [sp],Y sta r0 ldy #3 lda [sp],Y sta r2+2 add4 sp,#5 sub4 r0,loadOrg get the disp from the segment start cmpl pc,r0 bge lb1 if the disp is greater than the pc then move4 r0,pc update the pc lb1 anop rts end **************************************************************** * * DoPass1 - Do pass 1 processing * * Outputs: * C - set if an error occurred * **************************************************************** * DoPass1 start using Common ; ; Write the pass header ; lda #1 pass = 1 sta pass lda list if list then beq wp1 puts #'Segment:',cr=t print the general header putcr bra wp2 else if progress then wp1 lda progress beq wp2 puts #'Pass 1: ' print the dot header wp2 anop ; ; Initialize pass dependent variables ; jsr InitPass ; ; Process segments until there are no more ; ps1 jsr NextSegment get the next segment bcc rt1 branch if there are no more jsr DefineSegment put the segment in the symbol table jsr ListSeg list the segname start info jsr DoSegment process this segment add4 pc,segSpace add in the reserved space (if any) bra ps1 next segment ; ; Return to main ; rt1 lda list if list or progress then bne rt2 lda progress beq rt3 rt2 putcr write a cr rt3 anop endif clc rts end **************************************************************** * * DoSegment - process the opcodes in this segment * * Inputs: * sp - pointer to the first opcode to process * **************************************************************** * DoSegment private lb1 lda [sp] and #$00FF asl A tax jsr (addr,X) bra lb1 addr dc a'End' $00 End dc 15a'Const' $01..$0F Const dc 16a'Const' $10..$1F Const dc 16a'Const' $20..$2F Const dc 16a'Const' $30..$3F Const dc 16a'Const' $40..$4F Const dc 16a'Const' $50..$5F Const dc 16a'Const' $60..$6F Const dc 16a'Const' $70..$7F Const dc 16a'Const' $80..$8F Const dc 16a'Const' $90..$9F Const dc 16a'Const' $A0..$AF Const dc 16a'Const' $B0..$BF Const dc 16a'Const' $C0..$CF Const dc 16a'Const' $D0..$DF Const dc a'Align' $E0 Align dc a'DoOrg' $E1 Org dc a'Invalid' $E2 Reloc dc a'Invalid' $E3 Interseg dc a'Strong' $E4 Using dc a'Strong' $E5 Strong dc a'Global' $E6 Global dc a'Gequ' $E7 Gequ dc a'Invalid' $E8 Mem dc a'Invalid' $E9 unused dc a'Invalid' $EA unused dc a'Expr' $EB Expr dc a'Expr' $EC ZExpr dc a'Expr' $ED BExpr dc a'RelExpr' $EE RelExpr dc a'Local' $EF Local dc a'Equ' $F0 Equ dc a'DS' $F1 DS dc a'Lconst' $F2 LConst dc a'Expr' $F3 LExpr dc a'Invalid' $F4 Entry dc a'Invalid' $F5 cReloc dc a'Invalid' $F6 cInterseg dc a'Invalid' $F7 Super dc a'Invalid' $F8 unused dc a'Invalid' $F9 unused dc a'Invalid' $FA unused dc a'Invalid' $FB unused dc a'Invalid' $FC unused dc a'Invalid' $FD unused dc a'Invalid' $FE unused dc a'Invalid' $FF unused end **************************************************************** * * DS - insert zeros at the PC * * Inputs: * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * DS private inc4 sp ldy #2 clc lda [sp] adc pc sta pc lda [sp],Y adc pc+2 sta pc+2 add4 sp,#4 rts end **************************************************************** * * End - end of the segment * **************************************************************** * End private pla rts end **************************************************************** * * EndExp - end of the expression * * Inputs: * sp - pointer to the opcode * * Outputs: * sp - pointer to the next opcode * **************************************************************** * EndExp private inc4 sp pla rts end **************************************************************** * * Equ - define a local equate * * Inputs: * sp - pointer to the opcode * * Outputs: * sp - pointer to the next opcode * **************************************************************** * Equ private using Common inc4 sp skip the op code ph4 sp push the symbol name ptr lda [sp] skip the symbol name and #$00FF sec adc sp sta sp bcc lb1 inc sp+2 lb1 lda segVersion if the segment is version 0 or 1 then cmp #2 beq lb2 lda [sp] push the length byte and #$00FF pha inc4 sp ++sp bra lb3 else lb2 lda [sp] push the length word pha add4 sp,#2 sp += 2 lb3 anop endif lda [sp] push the type attribute and #$00FF pha lda [sp] push the private flag and #$FF00 xba pha add4 sp,#2 sp += 2 {skip the attributes} ph2 #0 the symbol is local ph2 #1 the symbol is an expression ph4 sp push the address of the expression ph2 #0 push the data area flag ph2 #0 push the segment flag jsr Define define the symbol jsr SkipExpression skip the expression rts end **************************************************************** * * Expr - evaluate an expression * * Inputs: * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * Expr private lda [sp] update the PC xba and #$00FF clc adc pc sta pc bcc lb1 inc pc+2 lb1 add4 sp,#2 skip the op code and expression length brl SkipExpression skip the expression end **************************************************************** * * Gequ - define a global equate * * Inputs: * sp - pointer to the opcode * * Outputs: * sp - pointer to the next opcode * **************************************************************** * Gequ private using Common inc4 sp skip the op code ph4 sp push the symbol name ptr lda [sp] skip the symbol name and #$00FF sec adc sp sta sp bcc lb1 inc sp+2 lb1 lda segVersion if the segment is version 0 ro 1 then cmp #2 beq lb2 lda [sp] push the length byte and #$00FF pha inc4 sp ++sp bra lb3 else lb2 lda [sp] push the length word pha add4 sp,#2 sp += 2 lb3 anop endif lda [sp] push the type attribute and #$00FF pha lda [sp] push the private flag and #$FF00 xba pha add4 sp,#2 sp += 2 {skip the attributes} ph2 #1 the symbol is global ph2 #1 the symbol is an expression ph4 sp push the address of the expression ph2 #0 push the data area flag ph2 #0 push the segment flag jsr Define define the symbol jsr SkipExpression skip the expression rts end **************************************************************** * * Global - define a global label at the PC * * Inputs: * sp - pointer to the opcode * * Outputs: * sp - pointer to the next opcode * **************************************************************** * Global private using Common inc4 sp skip the op code ph4 sp push the symbol name ptr lda [sp] skip the symbol name and #$00FF sec adc sp sta sp bcc lb1 inc sp+2 lb1 lda segVersion if the segment is version 0 ro 1 then cmp #2 beq lb2 lda [sp] push the length byte and #$00FF pha inc4 sp ++sp bra lb3 else lb2 lda [sp] push the length word pha add4 sp,#2 sp += 2 lb3 anop endif lda [sp] push the type attribute and #$00FF pha lda [sp] push the private flag and #$FF00 xba pha add4 sp,#2 sp += 2 {skip the attributes} ph2 #1 the symbol is global ph2 #0 the symbol is not an expression ph4 pc push the current pc ph2 #0 push the data area flag ph2 #0 push the segment flag jsr Define define the symbol rts end **************************************************************** * * Invalid - invalid op code * * Notes: * An invalid opcode stops the link process with a * terminal error. * **************************************************************** * Invalid private lda #8 jmp TermError end **************************************************************** * * LConst - long constant bytes * * Inputs: * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * LConst private inc4 sp ldy #2 lda [sp] sta r0 lda [sp],Y sta r0+2 add4 sp,r0 add4 sp,#4 add4 pc,r0 rts end **************************************************************** * * ListSeg - list the segment start info * * Inputs: * list - list info flag * **************************************************************** * ListSeg private using Common lda list bne lb1 lda progress beq lb1 putc #'.' lb1 jsr CheckForPause rts end **************************************************************** * * Local - define a local label at the PC * * Inputs: * sp - pointer to the opcode * * Outputs: * sp - pointer to the next opcode * **************************************************************** * Local private using Common inc4 sp skip the op code ph4 sp push the symbol name ptr lda [sp] skip the symbol name and #$00FF sec adc sp sta sp bcc lb1 inc sp+2 lb1 lda segVersion if the segment is version 0 ro 1 then cmp #2 beq lb2 lda [sp] push the length byte and #$00FF pha inc4 sp ++sp bra lb3 else lb2 lda [sp] push the length word pha add4 sp,#2 sp += 2 lb3 anop endif lda [sp] push the type attribute and #$00FF pha lda [sp] push the private flag and #$FF00 xba pha add4 sp,#2 sp += 2 {skip the attributes} ph2 #0 the symbol is local ph2 #0 the symbol is not an expression ph4 pc push the current pc ph2 #0 push the data area flag ph2 #0 push the segment flag jsr Define define the symbol rts end **************************************************************** * * Operation - handle an operation in an expression * * Inputs: * sp - pointer to the operation * * Outputs: * sp - pointer to the next expression term * **************************************************************** * Operation private inc4 sp rts end **************************************************************** * * PrepareAlign - do pass 1 prep for an align on pass 2 * * Inputs: * r0 - alignmanr factor * pc - program counter * * Outputs: * pc - program counter * **************************************************************** * PrepareAlign start dec4 r0 align the PC lb1 lda r0 quit if we are aligned and pc bne lb2 lda r2 and pc+2 beq lb5 lb2 lda r0 form the remaining bit mask and pc sta r4 lda r2 and pc+2 sta r6 lda #1 find the least significant bit sta r8 stz r10 lb3 lda r8 and r4 bne lb4 lda r10 and r6 bne lb4 asl r8 rol r10 bra lb3 lb4 add4 pc,r8 add this to the pc bra lb1 check the next bit lb5 rts end **************************************************************** * * RelExpr - evaluate a relative expression * * Inputs: * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * RelExpr private lda [sp] update the PC xba and #$00FF clc adc pc sta pc bcc lb1 inc pc+2 lb1 add4 sp,#6 skip the op code, length and offset brl SkipExpression skip the expression end **************************************************************** * * SkipExpression - skip an expression, noting label uses * * Inputs: * sp - pointer to the first opcode in the expression * * Outputs: * sp - pointer to the first opcode past the expression * **************************************************************** * SkipExpression private lb1 lda [sp] and #$00FF asl A tax jsr (addr,X) bra lb1 addr dc a'EndExp' $00 End dc 15a'Operation' $01..$0F some form of operation dc 6a'Operation' $10..$15 some form of operation dc 10a'Invalid' $16..$1F unused dc 16a'Invalid' $20..$2F unused dc 16a'Invalid' $30..$3F unused dc 16a'Invalid' $40..$4F unused dc 16a'Invalid' $50..$5F unused dc 16a'Invalid' $60..$6F unused dc 16a'Invalid' $70..$7F unused dc a'Operation' $80 program counter dc a'Value' $81 absolute value dc a'WeakReference' $82 weak label reference dc a'StrongReference' $83 strong label reference dc a'StrongReference' $84 length attribute dc a'StrongReference' $85 type attribute dc a'WeakReference' $86 count attribute dc a'Value' $87 disp from start of segment dc 8a'Invalid' $88-8F unused dc 16a'Invalid' $90..$9F unused dc 16a'Invalid' $A0..$AF unused dc 16a'Invalid' $B0..$BF unused dc 16a'Invalid' $C0..$CF unused dc 16a'Invalid' $D0..$DF unused dc 16a'Invalid' $E0..$EF unused dc 16a'Invalid' $F0..$FF unused end **************************************************************** * * Strong - Note that we are using a data area * * Inputs: * sp - pointer to the opcode * * Outputs: * sp - pointer to the next opcode * **************************************************************** * Strong private inc4 sp skip the op code jsr Reference make a reference to the name lda [sp] skip the name in the obj segment and #$00FF sec adc sp sta sp bcc lb1 inc sp+2 lb1 rts end **************************************************************** * * StrongReference - handle a strong label reference in an expression * * Inputs: * sp - pointer to the label name * * Outputs: * sp - pointer to the next expression term * **************************************************************** * StrongReference private inc4 sp skip the op code jsr Reference make a reference to the name lda [sp] skip the name in the segment and #$00FF sec adc sp sta sp bcc lb1 inc sp+2 lb1 rts end **************************************************************** * * Value - handle a value in an expression * * Inputs: * sp - pointer to the value * * Outputs: * sp - pointer to the next expression term * **************************************************************** * Value private add4 sp,#5 rts end **************************************************************** * * WeakReference - handle a weak label reference in an expression * * Inputs: * sp - pointer to the label name * * Outputs: * sp - pointer to the next expression term * **************************************************************** * WeakReference private lda [sp] and #$FF00 xba inc A sec adc sp sta sp bcc lb1 inc sp+2 lb1 rts end \ No newline at end of file + keep obj/pass1 + mcopy pass1.mac +**************************************************************** +* +* Pass 1 +* +* This module contains the subroutines used to do pass 1 +* processing of the input files. +* +**************************************************************** + copy directPage +**************************************************************** +* +* Align - align the code to a byte boundary +* +* Inputs: +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +Align private + + ldy #1 get the alignment factor + lda [sp],Y + sta r0 + iny + iny + lda [sp],Y + sta r2 + add4 sp,#5 + jsr PrepareAlign do pass 1 prep for the align + rts + end + +**************************************************************** +* +* Const - constant bytes +* +* Inputs: +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +Const private + + lda [sp] + and #$00FF + tax + clc + adc pc + sta pc + bcc lb1 + inc pc+2 +lb1 txa + sec + adc sp + sta sp + bcc lb2 + inc sp+2 +lb2 rts + end + +**************************************************************** +* +* DefineSegment - put the segment in the symbol table +* +* Inputs: +* segName - pointer to the segment name +* segType - segment type +* pc - current pc +* segEntry - disp to segment entry point +* +**************************************************************** +* +DefineSegment private + using Common + + ph4 segName push the symbol name ptr + ph2 #0 length attribute is 0 + ph2 #'N' push the type attribute + lda segType push the private flag + and #$4000 + beq lb1 + lda #1 +lb1 pha + ph2 #1 the symbol is global + ph2 #0 the symbol is not an expression + clc push the location + lda pc + adc segEntry + tax + lda pc+2 + adc segEntry+2 + pha + phx + lda segType push the data area flag + and #$007F + cmp #1 + beq lb2 + ph2 #0 + bra lb3 +lb2 ph2 #1 +lb3 ph2 #1 push the segment flag + jsr Define define the symbol + rts + end + +**************************************************************** +* +* DoOrg - set the program counter +* +* Inputs: +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +DoOrg private + using OutCommon + + ldy #1 get the value and skip the record + lda [sp],Y + sta r0 + ldy #3 + lda [sp],Y + sta r2+2 + add4 sp,#5 + + sub4 r0,loadOrg get the disp from the segment start + cmpl pc,r0 + bge lb1 if the disp is greater than the pc then + move4 r0,pc update the pc +lb1 anop + rts + end + +**************************************************************** +* +* DoPass1 - Do pass 1 processing +* +* Outputs: +* C - set if an error occurred +* +**************************************************************** +* +DoPass1 start + using Common +; +; Write the pass header +; + lda #1 pass = 1 + sta pass + lda list if list then + beq wp1 + puts #'Segment:',cr=t print the general header + putcr + bra wp2 else if progress then +wp1 lda progress + beq wp2 + puts #'Pass 1: ' print the dot header +wp2 anop +; +; Initialize pass dependent variables +; + jsr InitPass +; +; Process segments until there are no more +; +ps1 jsr NextSegment get the next segment + bcc rt1 branch if there are no more + jsr DefineSegment put the segment in the symbol table + jsr ListSeg list the segname start info + jsr DoSegment process this segment + add4 pc,segSpace add in the reserved space (if any) + bra ps1 next segment +; +; Return to main +; +rt1 lda list if list or progress then + bne rt2 + lda progress + beq rt3 +rt2 putcr write a cr +rt3 anop endif + clc + rts + end + +**************************************************************** +* +* DoSegment - process the opcodes in this segment +* +* Inputs: +* sp - pointer to the first opcode to process +* +**************************************************************** +* +DoSegment private + +lb1 lda [sp] + and #$00FF + asl A + tax + jsr (addr,X) + bra lb1 + +addr dc a'End' $00 End + dc 15a'Const' $01..$0F Const + dc 16a'Const' $10..$1F Const + dc 16a'Const' $20..$2F Const + dc 16a'Const' $30..$3F Const + dc 16a'Const' $40..$4F Const + dc 16a'Const' $50..$5F Const + dc 16a'Const' $60..$6F Const + dc 16a'Const' $70..$7F Const + dc 16a'Const' $80..$8F Const + dc 16a'Const' $90..$9F Const + dc 16a'Const' $A0..$AF Const + dc 16a'Const' $B0..$BF Const + dc 16a'Const' $C0..$CF Const + dc 16a'Const' $D0..$DF Const + dc a'Align' $E0 Align + dc a'DoOrg' $E1 Org + dc a'Invalid' $E2 Reloc + dc a'Invalid' $E3 Interseg + dc a'Strong' $E4 Using + dc a'Strong' $E5 Strong + dc a'Global' $E6 Global + dc a'Gequ' $E7 Gequ + dc a'Invalid' $E8 Mem + dc a'Invalid' $E9 unused + dc a'Invalid' $EA unused + dc a'Expr' $EB Expr + dc a'Expr' $EC ZExpr + dc a'Expr' $ED BExpr + dc a'RelExpr' $EE RelExpr + dc a'Local' $EF Local + dc a'Equ' $F0 Equ + dc a'DS' $F1 DS + dc a'Lconst' $F2 LConst + dc a'Expr' $F3 LExpr + dc a'Invalid' $F4 Entry + dc a'Invalid' $F5 cReloc + dc a'Invalid' $F6 cInterseg + dc a'Invalid' $F7 Super + dc a'Invalid' $F8 unused + dc a'Invalid' $F9 unused + dc a'Invalid' $FA unused + dc a'Invalid' $FB unused + dc a'Invalid' $FC unused + dc a'Invalid' $FD unused + dc a'Invalid' $FE unused + dc a'Invalid' $FF unused + end + +**************************************************************** +* +* DS - insert zeros at the PC +* +* Inputs: +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +DS private + + inc4 sp + ldy #2 + clc + lda [sp] + adc pc + sta pc + lda [sp],Y + adc pc+2 + sta pc+2 + add4 sp,#4 + rts + end + +**************************************************************** +* +* End - end of the segment +* +**************************************************************** +* +End private + + pla + rts + end + +**************************************************************** +* +* EndExp - end of the expression +* +* Inputs: +* sp - pointer to the opcode +* +* Outputs: +* sp - pointer to the next opcode +* +**************************************************************** +* +EndExp private + + inc4 sp + pla + rts + end + +**************************************************************** +* +* Equ - define a local equate +* +* Inputs: +* sp - pointer to the opcode +* +* Outputs: +* sp - pointer to the next opcode +* +**************************************************************** +* +Equ private + using Common + + inc4 sp skip the op code + ph4 sp push the symbol name ptr + lda [sp] skip the symbol name + and #$00FF + sec + adc sp + sta sp + bcc lb1 + inc sp+2 +lb1 lda segVersion if the segment is version 0 or 1 then + cmp #2 + beq lb2 + lda [sp] push the length byte + and #$00FF + pha + inc4 sp ++sp + bra lb3 else +lb2 lda [sp] push the length word + pha + add4 sp,#2 sp += 2 +lb3 anop endif + lda [sp] push the type attribute + and #$00FF + pha + lda [sp] push the private flag + and #$FF00 + xba + pha + add4 sp,#2 sp += 2 {skip the attributes} + ph2 #0 the symbol is local + ph2 #1 the symbol is an expression + ph4 sp push the address of the expression + ph2 #0 push the data area flag + ph2 #0 push the segment flag + jsr Define define the symbol + jsr SkipExpression skip the expression + rts + end + +**************************************************************** +* +* Expr - evaluate an expression +* +* Inputs: +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +Expr private + + lda [sp] update the PC + xba + and #$00FF + clc + adc pc + sta pc + bcc lb1 + inc pc+2 +lb1 add4 sp,#2 skip the op code and expression length + brl SkipExpression skip the expression + end + +**************************************************************** +* +* Gequ - define a global equate +* +* Inputs: +* sp - pointer to the opcode +* +* Outputs: +* sp - pointer to the next opcode +* +**************************************************************** +* +Gequ private + using Common + + inc4 sp skip the op code + ph4 sp push the symbol name ptr + lda [sp] skip the symbol name + and #$00FF + sec + adc sp + sta sp + bcc lb1 + inc sp+2 +lb1 lda segVersion if the segment is version 0 ro 1 then + cmp #2 + beq lb2 + lda [sp] push the length byte + and #$00FF + pha + inc4 sp ++sp + bra lb3 else +lb2 lda [sp] push the length word + pha + add4 sp,#2 sp += 2 +lb3 anop endif + lda [sp] push the type attribute + and #$00FF + pha + lda [sp] push the private flag + and #$FF00 + xba + pha + add4 sp,#2 sp += 2 {skip the attributes} + ph2 #1 the symbol is global + ph2 #1 the symbol is an expression + ph4 sp push the address of the expression + ph2 #0 push the data area flag + ph2 #0 push the segment flag + jsr Define define the symbol + jsr SkipExpression skip the expression + rts + end + +**************************************************************** +* +* Global - define a global label at the PC +* +* Inputs: +* sp - pointer to the opcode +* +* Outputs: +* sp - pointer to the next opcode +* +**************************************************************** +* +Global private + using Common + + inc4 sp skip the op code + ph4 sp push the symbol name ptr + lda [sp] skip the symbol name + and #$00FF + sec + adc sp + sta sp + bcc lb1 + inc sp+2 +lb1 lda segVersion if the segment is version 0 ro 1 then + cmp #2 + beq lb2 + lda [sp] push the length byte + and #$00FF + pha + inc4 sp ++sp + bra lb3 else +lb2 lda [sp] push the length word + pha + add4 sp,#2 sp += 2 +lb3 anop endif + lda [sp] push the type attribute + and #$00FF + pha + lda [sp] push the private flag + and #$FF00 + xba + pha + add4 sp,#2 sp += 2 {skip the attributes} + ph2 #1 the symbol is global + ph2 #0 the symbol is not an expression + ph4 pc push the current pc + ph2 #0 push the data area flag + ph2 #0 push the segment flag + jsr Define define the symbol + rts + end + +**************************************************************** +* +* Invalid - invalid op code +* +* Notes: +* An invalid opcode stops the link process with a +* terminal error. +* +**************************************************************** +* +Invalid private + + lda #8 + jmp TermError + end + +**************************************************************** +* +* LConst - long constant bytes +* +* Inputs: +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +LConst private + + inc4 sp + ldy #2 + lda [sp] + sta r0 + lda [sp],Y + sta r0+2 + add4 sp,r0 + add4 sp,#4 + add4 pc,r0 + rts + end + +**************************************************************** +* +* ListSeg - list the segment start info +* +* Inputs: +* list - list info flag +* +**************************************************************** +* +ListSeg private + using Common + + lda list + bne lb1 + lda progress + beq lb1 + putc #'.' +lb1 jsr CheckForPause + rts + end + +**************************************************************** +* +* Local - define a local label at the PC +* +* Inputs: +* sp - pointer to the opcode +* +* Outputs: +* sp - pointer to the next opcode +* +**************************************************************** +* +Local private + using Common + + inc4 sp skip the op code + ph4 sp push the symbol name ptr + lda [sp] skip the symbol name + and #$00FF + sec + adc sp + sta sp + bcc lb1 + inc sp+2 +lb1 lda segVersion if the segment is version 0 ro 1 then + cmp #2 + beq lb2 + lda [sp] push the length byte + and #$00FF + pha + inc4 sp ++sp + bra lb3 else +lb2 lda [sp] push the length word + pha + add4 sp,#2 sp += 2 +lb3 anop endif + lda [sp] push the type attribute + and #$00FF + pha + lda [sp] push the private flag + and #$FF00 + xba + pha + add4 sp,#2 sp += 2 {skip the attributes} + ph2 #0 the symbol is local + ph2 #0 the symbol is not an expression + ph4 pc push the current pc + ph2 #0 push the data area flag + ph2 #0 push the segment flag + jsr Define define the symbol + rts + end + +**************************************************************** +* +* Operation - handle an operation in an expression +* +* Inputs: +* sp - pointer to the operation +* +* Outputs: +* sp - pointer to the next expression term +* +**************************************************************** +* +Operation private + + inc4 sp + rts + end + +**************************************************************** +* +* PrepareAlign - do pass 1 prep for an align on pass 2 +* +* Inputs: +* r0 - alignmanr factor +* pc - program counter +* +* Outputs: +* pc - program counter +* +**************************************************************** +* +PrepareAlign start + + dec4 r0 align the PC + +lb1 lda r0 quit if we are aligned + and pc + bne lb2 + lda r2 + and pc+2 + beq lb5 +lb2 lda r0 form the remaining bit mask + and pc + sta r4 + lda r2 + and pc+2 + sta r6 + lda #1 find the least significant bit + sta r8 + stz r10 +lb3 lda r8 + and r4 + bne lb4 + lda r10 + and r6 + bne lb4 + asl r8 + rol r10 + bra lb3 +lb4 add4 pc,r8 add this to the pc + bra lb1 check the next bit + +lb5 rts + end + +**************************************************************** +* +* RelExpr - evaluate a relative expression +* +* Inputs: +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +RelExpr private + + lda [sp] update the PC + xba + and #$00FF + clc + adc pc + sta pc + bcc lb1 + inc pc+2 +lb1 add4 sp,#6 skip the op code, length and offset + brl SkipExpression skip the expression + end + +**************************************************************** +* +* SkipExpression - skip an expression, noting label uses +* +* Inputs: +* sp - pointer to the first opcode in the expression +* +* Outputs: +* sp - pointer to the first opcode past the expression +* +**************************************************************** +* +SkipExpression private + +lb1 lda [sp] + and #$00FF + asl A + tax + jsr (addr,X) + bra lb1 + +addr dc a'EndExp' $00 End + dc 15a'Operation' $01..$0F some form of operation + dc 6a'Operation' $10..$15 some form of operation + dc 10a'Invalid' $16..$1F unused + dc 16a'Invalid' $20..$2F unused + dc 16a'Invalid' $30..$3F unused + dc 16a'Invalid' $40..$4F unused + dc 16a'Invalid' $50..$5F unused + dc 16a'Invalid' $60..$6F unused + dc 16a'Invalid' $70..$7F unused + dc a'Operation' $80 program counter + dc a'Value' $81 absolute value + dc a'WeakReference' $82 weak label reference + dc a'StrongReference' $83 strong label reference + dc a'StrongReference' $84 length attribute + dc a'StrongReference' $85 type attribute + dc a'WeakReference' $86 count attribute + dc a'Value' $87 disp from start of segment + dc 8a'Invalid' $88-8F unused + dc 16a'Invalid' $90..$9F unused + dc 16a'Invalid' $A0..$AF unused + dc 16a'Invalid' $B0..$BF unused + dc 16a'Invalid' $C0..$CF unused + dc 16a'Invalid' $D0..$DF unused + dc 16a'Invalid' $E0..$EF unused + dc 16a'Invalid' $F0..$FF unused + end + +**************************************************************** +* +* Strong - Note that we are using a data area +* +* Inputs: +* sp - pointer to the opcode +* +* Outputs: +* sp - pointer to the next opcode +* +**************************************************************** +* +Strong private + + inc4 sp skip the op code + jsr Reference make a reference to the name + lda [sp] skip the name in the obj segment + and #$00FF + sec + adc sp + sta sp + bcc lb1 + inc sp+2 +lb1 rts + end + +**************************************************************** +* +* StrongReference - handle a strong label reference in an expression +* +* Inputs: +* sp - pointer to the label name +* +* Outputs: +* sp - pointer to the next expression term +* +**************************************************************** +* +StrongReference private + + inc4 sp skip the op code + jsr Reference make a reference to the name + lda [sp] skip the name in the segment + and #$00FF + sec + adc sp + sta sp + bcc lb1 + inc sp+2 +lb1 rts + end + +**************************************************************** +* +* Value - handle a value in an expression +* +* Inputs: +* sp - pointer to the value +* +* Outputs: +* sp - pointer to the next expression term +* +**************************************************************** +* +Value private + + add4 sp,#5 + rts + end + +**************************************************************** +* +* WeakReference - handle a weak label reference in an expression +* +* Inputs: +* sp - pointer to the label name +* +* Outputs: +* sp - pointer to the next expression term +* +**************************************************************** +* +WeakReference private + + lda [sp] + and #$FF00 + xba + inc A + sec + adc sp + sta sp + bcc lb1 + inc sp+2 +lb1 rts + end diff --git a/pass1.mac b/pass1.mac old mode 100755 new mode 100644 index cb417f4..a757419 --- a/pass1.mac +++ b/pass1.mac @@ -1 +1,451 @@ - macro &lab cmpl &n1,&n2 &lab lda 2+&n1 cmp 2+&n2 bne ~&syscnt lda &n1 cmp &n2 ~&syscnt anop mend MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND macro &l puts &n1,&f1,&cr,&errout &l ~setm lclc &c &c amid "&n1",1,1 aif "&c"<>"#",.c aif l:&n1>127,.a bra ~&SYSCNT ago .b .a brl ~&SYSCNT .b &n1 amid "&n1",2,l:&n1-1 ~l&SYSCNT dc i1"l:~s&SYSCNT" ~s&SYSCNT dc c&n1 ~&SYSCNT anop &n1 setc ~l&SYSCNT-1 .c ~pusha &n1 aif c:&f1,.c1 pea 0 ago .c2 .c1 ph2 &f1 .c2 ph2 #c:&cr ph2 #c:&errout jsl ~puts ~restm mend macro &l putc &n1,&f1,&cr,&errout lclc &f1 &f1 setc #0 .a &l ~setm ph2 &n1 aif c:&f1,.a pea 0 ago .b .a ph2 &f1 .b ph2 #c:&cr ph2 #c:&errout jsl ~putc ~restm mend macro &l putcr &errout &l ~setm pea $0D aif c:&errout,.a jsl SysCharOut ~restm mexit .a jsl SysCharErrout ~restm mend macro &l add4 &m1,&m2,&m3 lclb &yistwo lclc &c &l ~setm aif c:&m3,.a &c amid "&m2",1,1 aif "&c"<>"#",.a &c amid "&m1",1,1 aif "&c"="{",.a aif "&c"="[",.a &c amid "&m2",2,l:&m2-1 aif &c>=65536,.a clc ~lda &m1 ~op adc,&m2 ~sta &m1 bcc ~&SYSCNT ~op.h inc,&m1 ~&SYSCNT anop ago .c .a aif c:&m3,.b lclc &m3 &m3 setc &m1 .b clc ~lda &m1 ~op adc,&m2 ~sta &m3 ~lda.h &m1 ~op.h adc,&m2 ~sta.h &m3 .c ~restm mend macro &l sub4 &m1,&m2,&m3 lclb &yistwo lclc &c &l ~setm aif c:&m3,.a &c amid "&m2",1,1 aif "&c"<>"#",.a &c amid "&m1",1,1 aif "&c"="{",.a aif "&c"="[",.a &c amid "&m2",2,l:&m2-1 aif &c>=65536,.a sec ~lda &m1 ~op sbc,&m2 ~sta &m1 bcs ~&SYSCNT ~op.h dec,&m1 ~&SYSCNT anop ago .c .a aif c:&m3,.b lclc &m3 &m3 setc &m1 .b sec ~lda &m1 ~op sbc,&m2 ~sta &m3 ~lda.h &m1 ~op.h sbc,&m2 ~sta.h &m3 .c ~restm mend macro &l dec4 &a &l ~setm lda &a bne ~&SYSCNT dec 2+&a ~&SYSCNT dec &a ~restm mend macro &l inc4 &a &l ~setm inc &a bne ~&SYSCNT inc 2+&a ~&SYSCNT ~restm mend macro &l ph2 &n1 &l anop aif "&n1"="*",.f lclc &c &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 lda (&n1) pha ago .e .b aif "&c"="<",.c lda &n1 pha ago .e .c &n1 amid &n1,2,l:&n1-1 pei &n1 ago .e .d &n1 amid &n1,2,l:&n1-1 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l ph4 &n1 &l anop aif "&n1"="*",.f lclc &c &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 ldy #2 lda (&n1),y pha lda (&n1) pha ago .e .b aif "&c"<>"[",.c ldy #2 lda &n1,y pha lda &n1 pha ago .e .c aif "&c"<>"<",.c1 &n1 amid &n1,2,l:&n1-1 pei &n1+2 pei &n1 ago .e .c1 lda &n1+2 pha lda &n1 pha ago .e .d &n1 amid &n1,2,l:&n1-1 pea +(&n1)|-16 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l ~lda &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l lda &op mend macro &l ~lda.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" lda &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" lda &op mexit .e lda 2+&op mend macro &l ~op &opc,&op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l &opc &op mend macro &l ~op.h &opc,&op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" &opc &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" &opc &op mexit .e &opc 2+&op mend macro &l ~pusha &n1 lclc &c &l anop &c amid &n1,1,1 aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 sep #$20 longa off lda #0 pha rep #$20 longa on phk lda &n1 pha mexit .b aif "&c"<>"[",.c &n1 amid &n1,2,l:&n1-2 lda &n1+2 pha lda &n1 pha mexit .c pea +(&n1)|-16 pea &n1 mexit .g mnote "Missing closing '}'",16 mend macro &l ~restm &l anop aif (&~la+&~li)=2,.i sep #32*(.not.&~la)+16*(.not.&~li) aif &~la,.h longa off .h aif &~li,.i longi off .i mend macro &l ~setm &l anop aif c:&~la,.b gblb &~la gblb &~li .b &~la setb s:longa &~li setb s:longi aif s:longa.and.s:longi,.a rep #32*(.not.&~la)+16*(.not.&~li) longa on longi on .a mend macro &l ~sta &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l sta &op mend macro &l ~sta.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" sta &op mexit .d sta 2+&op mend \ No newline at end of file + macro +&lab cmpl &n1,&n2 +&lab lda 2+&n1 + cmp 2+&n2 + bne ~&syscnt + lda &n1 + cmp &n2 +~&syscnt anop + mend + MACRO +&LAB MOVE4 &F,&T +&LAB ~SETM + LDA 2+&F + STA 2+&T + LDA &F + STA &T + ~RESTM + MEND + macro +&l puts &n1,&f1,&cr,&errout +&l ~setm + lclc &c +&c amid "&n1",1,1 + aif "&c"<>"#",.c + aif l:&n1>127,.a + bra ~&SYSCNT + ago .b +.a + brl ~&SYSCNT +.b +&n1 amid "&n1",2,l:&n1-1 +~l&SYSCNT dc i1"l:~s&SYSCNT" +~s&SYSCNT dc c&n1 +~&SYSCNT anop +&n1 setc ~l&SYSCNT-1 +.c + ~pusha &n1 + aif c:&f1,.c1 + pea 0 + ago .c2 +.c1 + ph2 &f1 +.c2 + ph2 #c:&cr + ph2 #c:&errout + jsl ~puts + ~restm + mend + macro +&l putc &n1,&f1,&cr,&errout + lclc &f1 +&f1 setc #0 +.a +&l ~setm + ph2 &n1 + aif c:&f1,.a + pea 0 + ago .b +.a + ph2 &f1 +.b + ph2 #c:&cr + ph2 #c:&errout + jsl ~putc + ~restm + mend + macro +&l putcr &errout +&l ~setm + pea $0D + aif c:&errout,.a + jsl SysCharOut + ~restm + mexit +.a + jsl SysCharErrout + ~restm + mend + macro +&l add4 &m1,&m2,&m3 + lclb &yistwo + lclc &c +&l ~setm + aif c:&m3,.a +&c amid "&m2",1,1 + aif "&c"<>"#",.a +&c amid "&m1",1,1 + aif "&c"="{",.a + aif "&c"="[",.a +&c amid "&m2",2,l:&m2-1 + aif &c>=65536,.a + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m1 + bcc ~&SYSCNT + ~op.h inc,&m1 +~&SYSCNT anop + ago .c +.a + aif c:&m3,.b + lclc &m3 +&m3 setc &m1 +.b + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m3 + ~lda.h &m1 + ~op.h adc,&m2 + ~sta.h &m3 +.c + ~restm + mend + macro +&l sub4 &m1,&m2,&m3 + lclb &yistwo + lclc &c +&l ~setm + aif c:&m3,.a +&c amid "&m2",1,1 + aif "&c"<>"#",.a +&c amid "&m1",1,1 + aif "&c"="{",.a + aif "&c"="[",.a +&c amid "&m2",2,l:&m2-1 + aif &c>=65536,.a + sec + ~lda &m1 + ~op sbc,&m2 + ~sta &m1 + bcs ~&SYSCNT + ~op.h dec,&m1 +~&SYSCNT anop + ago .c +.a + aif c:&m3,.b + lclc &m3 +&m3 setc &m1 +.b + sec + ~lda &m1 + ~op sbc,&m2 + ~sta &m3 + ~lda.h &m1 + ~op.h sbc,&m2 + ~sta.h &m3 +.c + ~restm + mend + macro +&l dec4 &a +&l ~setm + lda &a + bne ~&SYSCNT + dec 2+&a +~&SYSCNT dec &a + ~restm + mend + macro +&l inc4 &a +&l ~setm + inc &a + bne ~&SYSCNT + inc 2+&a +~&SYSCNT ~restm + mend + macro +&l ph2 &n1 +&l anop + aif "&n1"="*",.f + lclc &c +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + lda (&n1) + pha + ago .e +.b + aif "&c"="<",.c + lda &n1 + pha + ago .e +.c +&n1 amid &n1,2,l:&n1-1 + pei &n1 + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l ph4 &n1 +&l anop + aif "&n1"="*",.f + lclc &c +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + ldy #2 + lda (&n1),y + pha + lda (&n1) + pha + ago .e +.b + aif "&c"<>"[",.c + ldy #2 + lda &n1,y + pha + lda &n1 + pha + ago .e +.c + aif "&c"<>"<",.c1 +&n1 amid &n1,2,l:&n1-1 + pei &n1+2 + pei &n1 + ago .e +.c1 + lda &n1+2 + pha + lda &n1 + pha + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea +(&n1)|-16 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l ~lda &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l lda &op + mend + macro +&l ~lda.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + lda &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + lda &op + mexit +.e + lda 2+&op + mend + macro +&l ~op &opc,&op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l &opc &op + mend + macro +&l ~op.h &opc,&op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + &opc &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + &opc &op + mexit +.e + &opc 2+&op + mend + macro +&l ~pusha &n1 + lclc &c +&l anop +&c amid &n1,1,1 + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + sep #$20 + longa off + lda #0 + pha + rep #$20 + longa on + phk + lda &n1 + pha + mexit +.b + aif "&c"<>"[",.c +&n1 amid &n1,2,l:&n1-2 + lda &n1+2 + pha + lda &n1 + pha + mexit +.c + pea +(&n1)|-16 + pea &n1 + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l ~restm +&l anop + aif (&~la+&~li)=2,.i + sep #32*(.not.&~la)+16*(.not.&~li) + aif &~la,.h + longa off +.h + aif &~li,.i + longi off +.i + mend + macro +&l ~setm +&l anop + aif c:&~la,.b + gblb &~la + gblb &~li +.b +&~la setb s:longa +&~li setb s:longi + aif s:longa.and.s:longi,.a + rep #32*(.not.&~la)+16*(.not.&~li) + longa on + longi on +.a + mend + macro +&l ~sta &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l sta &op + mend + macro +&l ~sta.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + sta &op + mexit +.d + sta 2+&op + mend diff --git a/pass2.asm b/pass2.asm old mode 100755 new mode 100644 index 51e7353..9581a9c --- a/pass2.asm +++ b/pass2.asm @@ -1 +1,1661 @@ - keep obj/pass2 mcopy pass2.mac **************************************************************** * * Pass 2 * * This module contains the subroutines used to do pass 2 * processing of the input files and creation of the output * files. * **************************************************************** copy directPage **************************************************************** * * Align - align the code to a byte boundary * * Inputs: * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * Align private ldy #1 get the alignment factor lda [sp],Y sta r0 iny iny lda [sp],Y sta r2 add4 sp,#5 skip the alignment opcode and operand jsr DefineAlign do the align rts end **************************************************************** * * BExpr - evaluate a local bank expression * * Inputs: * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * BExpr private using ExpCommon using OutCommon using Common stz saveSegment saveSegment := false lda [sp] update the PC xba and #$00FF sta expLength lb1 add4 sp,#2 skip the op code and expression length ph4 sp evaluate the expression jsr Evaluate sta expValue stx expValue+2 add4 loadOrg,pc,val1 make sure bank bytes match lda symbolRelocatable beq lb2 add4 loadOrg,expValue,val2 bra lb2a lb2 move4 expValue,val2 lb2a stz mask stz mask+2 short M ldx expLength beq lb4 cpx #4 bge lb4 ldx #3 lda #$FF lb3 sta mask,X dex cpx expLength bge lb3 lb4 long M lda mask and val1 sta val1 lda mask+2 and val1+2 sta val1+2 lda mask and val2 cmp val1 bne lb5 lda mask+2 and val2+2 cmp val1+2 beq lb6 lb5 ph4 #0 ph2 #10 jsr Error bra lb10 lb6 lda expSegment if the expression uses values in another beq lb10 segment then cmp loadNumber beq lb10 lda expLength if the expression is too short for cmp #3 a legal interseg reference then bge lb7 ph4 #0 flag the error ph2 #10 jsr Error bra lb10 skip to "normal" processing lb7 lda symbolRelocatable if the expression is relocatable then beq lb9 jsr DictInterseg create a dictionary entry sta saveSegment save the save segment flag lda shiftFlag if the value is shifted then beq lb8 move4 shiftValue,expValue use the unshifted value lb8 anop lb9 lda expSegment if the segment is dynamic then jsr IsDynamic bcc lb11 ph4 #0 flag the error ph2 #17 jsr Error bra lb11 else lb10 lda symbolRelocatable if the expression is relocatable then beq lb11 jsr DictReloc create a dictionary entry lb11 anop endif jsr PutValue write an expression value lda saveSegment if saveSegment then beq lb12 sec save the segment number lda op sbc saveSegment sta r0 lda op+2 sbc #0 sta r2 short M clc lda expSegment sta [r0] long M lb12 brl SkipExpression skip the expression ; ; Local data ; val1 ds 4 first address val2 ds 4 second address mask ds 4 bank mask saveSegment ds 2 save segment number flag end **************************************************************** * * Const - constant bytes * * Inputs: * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * Const private lda [sp] update the program counter and #$00FF tay clc adc pc sta pc bcc lb1 inc pc+2 lb1 inc4 sp skip the op code tyx save the length tya move the bytes lsr A bcc lb2 short M dey lda [sp],Y sta [op],Y long M lb2 dey dey bmi lb3a lb3 lda [sp],Y sta [op],Y dey dey bpl lb3 lb3a anop txa update the output pointer clc adc op sta op bcc lb4 inc op+2 lb4 txa update sp clc adc sp sta sp bcc lb5 inc sp+2 lb5 rts end **************************************************************** * * DefineAlign - align to a power of 2 boundary * * Inputs: * r0 - alignment factor * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * DefineAlign start using Common stz total total = 0 stz total+2 move4 pc,tpc save the pc ph4 r0 check the alignment factor jsr CheckAlign dec4 r0 align the PC lb1 lda r0 quit if we are aligned and pc bne lb2 lda r2 and pc+2 beq lb5 lb2 lda r0 form the remaining bit mask and pc sta r4 lda r2 and pc+2 sta r6 lda #1 find the least significant bit sta r8 stz r10 lb3 lda r8 and r4 bne lb4 lda r10 and r6 bne lb4 asl r8 rol r10 bra lb3 lb4 add4 total,r8 update the total add4 pc,r8 bra lb1 check the next bit lb5 move4 tpc,pc reset pc lda total if total <> 0 then ora total+2 beq lb6 move4 total,r0 define an appropriate DS record jsr DefineDS lb6 rts total ds 4 total DS space tpc ds 4 temp pc end **************************************************************** * * DefineDS - reserve space in a segment * * Inputs: * r0 - # of bytes to reserve * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * DefineDS start using Common add4 pc,r0 update the program count lda express if express or (r0 < 10) then bne lb0 lda r2 bne lb7 lda r0 cmp #10 bge lb7 lb0 ldx r2 fill 64K areas beq lb2 ldy #0 tya lb1 sta [op],Y dey dey bne lb1 inc op+2 dex bne lb1 lb2 short M fill in remaining bytes lda #0 ldy r0 beq lb5 dey beq lb4 lb3 sta [op],Y dey bne lb3 lb4 sta [op] lb5 long M clc update op lda op adc r0 sta op bcc lb6 inc op+2 lb6 bra lb8 else {if not express then} lb7 ph4 r0 finish off the current lConst jsr FinishLConst pl4 r0 lda #$F1 place a DS record in the segment sta [op] ldy #1 lda r0 sta [op],Y iny iny lda r2 sta [op],Y add4 op,#5,opst start a new lConst add4 op,#10 update op lb8 anop endif rts end **************************************************************** * * DefineSegment - put the segment in the symbol table * * Inputs: * segName - pointer to the segment name * pc - current pc * segEntry - disp to segment entry point * **************************************************************** * DefineSegment private using Common ph4 segName push the symbol name ptr ph2 #1 the symbol is global clc push the location lda pc adc segEntry tax lda pc+2 adc segEntry+2 pha phx jsr Define2 define the symbol rts end **************************************************************** * * DictReloc - Create a relocatable dictionary entry (current bank) * * Inputs: * bankOrg - is the program bank relative? * expLength - expression length * expValue - expression value * shiftFlag - is the value shifted? * shiftValue - value before a shift * shiftCount - shift counter * **************************************************************** * DictReloc private using Common using ExpCommon using OutCommon lda bankOrg if the program is bank relative then beq lb0 lda shiftFlag if the value is not shifted then bne lb0 lda expLength if the expression is 1 or 2 bytes then cmp #3 bge lb0 rts return lb0 lda #11 make sure there is room in the dictionary cmp loadDictSize blt lb1 jsr ExpandDictBuffer lb1 lda shiftFlag if the expression is shifted then beq lb1a move4 shiftValue,val use the unshifted value bra lb1b else lb1a move4 expValue,val use the returned value lb1b anop endif lda val+2 short = val and pc < 64K ora pc+2 sta short short M if short then bne lb2 lda #$F5 write the cReloc opcode sta [dp] lda expLength write the expression length cmp #4 bne lb1c dec A lb1c ldy #1 sta [dp],Y bra lb3 else lb2 lda #$E2 write the Reloc opcode sta [dp] lda expLength write the expression length ldy #1 sta [dp],Y lb3 iny write the shift count lda shiftCount sta [dp],Y long M lda short if short then bne lb4 lda pc save the pc iny sta [dp],Y iny save the value iny lda val sta [dp],Y add4 dp,#7 update dp sub2 loadDictSize,#7 update loadDictSize rts return lb4 iny save the pc lda pc sta [dp],Y iny iny lda pc+2 sta [dp],Y iny save the value iny lda val sta [dp],Y iny iny lda val+2 sta [dp],Y sub2 loadDictSize,#11 update loadDictSize add4 dp,#11 update dp rts ; ; Local data ; short ds 2 is this a cReloc? val ds 4 expression value end **************************************************************** * * DictInterseg - Create an interseg dictionary entry (another bank) * * Inputs: * expLength - expression length * expValue - expression value * expSegment - expression segment number * shiftFlag - is the value shifted? * shiftValue - value before a shift * shiftCount - shift counter * * Outputs: * A - 1 if the segment should be saved in the expression, * else 0. (The segment is saved with the expression * for 3-byte cInterseg expressions with 0 shift when * files are being compacted.) * **************************************************************** * DictInterseg private using Common using ExpCommon using OutCommon stz saveSegment don't save the segment number lda #15 make sure there is room in the dictionary cmp loadDictSize blt lb1 jsr ExpandDictBuffer lb1 lda shiftFlag if the expression is shifted then beq lb1a move4 shiftValue,val use the unshifted value bra lb1b else lb1a move4 expValue,val use the returned value lb1b anop endif lda expSegment short = (val < 64K) and (pc < 64K) and #$FF00 and (expSegment < 256) ora val+2 ora pc+2 sta short short M if short then bne lb2 lda #$F6 write the cInterseg opcode sta [dp] lda expLength write the expression length cmp #4 bne lb1c ldx compact if compact then beq ss1 ldx shiftFlag if not shiftFlag then bne ss1 ldx #2 set saveSegment stx saveSegment ss1 dec A convert length to 3 lb1c ldy #1 sta [dp],Y bra lb3 else lb2 lda #$E3 write the interseg opcode sta [dp] lda expLength write the expression length ldy #1 sta [dp],Y lb3 ldy #2 write the shift count lda shiftCount sta [dp],Y long M lda short if short then bne lb4 lda pc save the pc iny sta [dp],Y iny save the expression segment iny lda expSegment sta [dp],Y iny save the value lda val sta [dp],Y sub2 loadDictSize,#8 update loadDictSize add4 dp,#8 update dp ldx compact if compact then beq lb4a ldx expLength if expLength = 3 then cpx #3 bne lb4a ldx shiftFlag if not shiftFlag then bne lb4a lda #1 we do need to save the segment sta saveSegment lb4a lda saveSegment return the save segment code rts lb4 iny save the pc lda pc sta [dp],Y iny iny lda pc+2 sta [dp],Y iny set the file number to 1 iny lda #1 sta [dp],Y iny save the segment number iny lda expSegment sta [dp],Y iny save the value iny lda val sta [dp],Y iny iny lda val+2 sta [dp],Y sub2 loadDictSize,#15 update loadDictSize add4 dp,#15 update dp lda #0 don't save the segment number rts ; ; Local data ; saveSegment ds 2 save segment code: ! 0: don't save the segment # ! 1: save segment # in 3 byte field ! 2: save segment # in 4 byte field short ds 2 is this a cReloc? val ds 4 expression value end **************************************************************** * * DoOrg - set the program counter * * Inputs: * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * DoOrg private ldy #1 get the value lda [sp],Y sta r4 ldy #3 lda [sp],Y sta r6 add4 sp,#5 skip the op code & operand sub4 pc,r4,r0 calculate the space to insert lda r2 if space < 0 then bpl lb1 ph4 #0 Error(NULL,3) ph2 #3 jsr Error rts return lb1 jsr DefineDS handle the ORG rts end **************************************************************** * * DoPass2 - Do pass 1 processing * * Outputs: * C - set if an error occurred * **************************************************************** * DoPass2 start using Common ; ; Write the pass header ; lda #2 pass = 2 sta pass lda list if (not list) and progress then bne wp1 lda progress beq wp1 puts #'Pass 2: ' print the dot header wp1 anop ; ; Initialize pass dependent variables ; jsr InitPass jsr DynamicCheck ; ; Process segments until there are no more ; ps1 jsr NextSegment get the next segment bcc rt1 branch if there are no more move #0,dataAreas,#256 clear the data area flags jsr DefineSegment put the segment in the symbol table jsr ListSeg list the segname start info jsr DoSegment process the segment lda segSpace add in the reserved space (if any) ora segSpace+2 beq ps1 move4 segSpace,r0 jsr DefineDS bra ps1 next segment ; ; Return to main ; rt1 lda list if list or progress then bne rt2 lda progress beq rt3 rt2 putcr write a cr rt3 anop endif clc rts end **************************************************************** * * DoSegment - process the opcodes in this segment * * Inputs: * sp - pointer to the first opcode to process * **************************************************************** * DoSegment private lb1 lda [sp] and #$00FF asl A tax jsr (addr,X) bra lb1 addr dc a'End' $00 End dc 15a'Const' $01..$0F Const dc 16a'Const' $10..$1F Const dc 16a'Const' $20..$2F Const dc 16a'Const' $30..$3F Const dc 16a'Const' $40..$4F Const dc 16a'Const' $50..$5F Const dc 16a'Const' $60..$6F Const dc 16a'Const' $70..$7F Const dc 16a'Const' $80..$8F Const dc 16a'Const' $90..$9F Const dc 16a'Const' $A0..$AF Const dc 16a'Const' $B0..$BF Const dc 16a'Const' $C0..$CF Const dc 16a'Const' $D0..$DF Const dc a'Align' $E0 Align dc a'DoOrg' $E1 Org dc a'Invalid' $E2 Reloc dc a'Invalid' $E3 Interseg dc a'Using' $E4 Using dc a'Strong' $E5 Strong dc a'Global' $E6 Global dc a'Gequ' $E7 Gequ dc a'Invalid' $E8 Mem dc a'Invalid' $E9 unused dc a'Invalid' $EA unused dc a'Expr' $EB Expr dc a'ZExpr' $EC ZExpr dc a'BExpr' $ED BExpr dc a'RelExpr' $EE RelExpr dc a'Local' $EF Local dc a'Equ' $F0 Equ dc a'DS' $F1 DS dc a'Lconst' $F2 LConst dc a'LExpr' $F3 LExpr dc a'Invalid' $F4 Entry dc a'Invalid' $F5 cReloc dc a'Invalid' $F6 cInterseg dc a'Invalid' $F7 Super dc a'Invalid' $F8 unused dc a'Invalid' $F9 unused dc a'Invalid' $FA unused dc a'Invalid' $FB unused dc a'Invalid' $FC unused dc a'Invalid' $FD unused dc a'Invalid' $FE unused dc a'Invalid' $FF unused end **************************************************************** * * DS - insert zeros at the PC * * Inputs: * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * DS private using Common inc4 sp skip the opcode ldy #2 get the DS length lda [sp] sta r0 lda [sp],Y sta r2 jsr DefineDS handle the DS add4 sp,#4 skip the length rts end **************************************************************** * * End - end of the segment * **************************************************************** * End private pla rts end **************************************************************** * * EndExp - end of the expression * * Inputs: * sp - pointer to the opcode * * Outputs: * sp - pointer to the next opcode * **************************************************************** * EndExp private inc4 sp pla rts end **************************************************************** * * Equ - define a local equate * * Inputs: * sp - pointer to the opcode * * Outputs: * sp - pointer to the next opcode * **************************************************************** * Equ private using Common inc4 sp skip the op code ph4 sp push the symbol name ptr lda [sp] skip the symbol name and #$00FF sec adc sp sta sp bcc lb1 inc sp+2 lb1 lda segVersion if the segment is version 0 ro 1 then cmp #2 beq lb2 add4 sp,#3 skip the attributes (1 byte length) bra lb3 else lb2 add4 sp,#4 skip the attributes (2 byte length) lb3 anop endif ph2 #0 the symbol is local ph4 #0 don't check for addressing errors jsr Define2 define the symbol jsr SkipExpression skip the expression rts end **************************************************************** * * Expr - evaluate an expression * * Inputs: * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * Expr private using ExpCommon using Common using OutCommon stz saveSegment saveSegment := false lda [sp] update the PC xba and #$00FF sta expLength lb1 add4 sp,#2 skip the op code and expression length ph4 sp evaluate the expression jsr Evaluate sta expValue stx expValue+2 lda expSegment if the expression uses values in another beq lb2 segment then cmp loadNumber beq lb2 lda symbolRelocatable if the expression is relocatable then beq lb1a jsr DictInterseg create a dictionary entry sta saveSegment save the save segment flag lda shiftFlag if the value is shifted then beq sh1 use the unshifted value move4 shiftValue,expValue sh1 anop lb1a lda expSegment if the segment is dynamic then jsr IsDynamic bcc lb3 ph4 #0 flag the error ph2 #17 jsr Error bra lb3 else lb2 lda symbolRelocatable if the expression is relocatable then beq lb3 jsr DictReloc create a dictionary entry lb3 anop endif jsr PutValue write an expression value lda saveSegment if saveSegment then beq lb4 sec save the segment number lda op sbc saveSegment sta r0 lda op+2 sbc #0 sta r2 short M clc lda expSegment sta [r0] long M lb4 brl SkipExpression skip the expression saveSegment ds 2 save segment number flag end **************************************************************** * * Gequ - define a global equate * * Inputs: * sp - pointer to the opcode * * Outputs: * sp - pointer to the next opcode * **************************************************************** * Gequ private using Common inc4 sp skip the op code ph4 sp push the symbol name ptr lda [sp] skip the symbol name and #$00FF sec adc sp sta sp bcc lb1 inc sp+2 lb1 lda segVersion if the segment is version 0 or 1 then cmp #2 beq lb2 add4 sp,#3 skip the attributes (1 byte length) bra lb3 else lb2 add4 sp,#4 skip the attributes (2 byte length) lb3 anop endif ph2 #1 the symbol is global ph4 #0 don't ceck for addressing errors jsr Define2 define the symbol jsr SkipExpression skip the expression rts end **************************************************************** * * Global - define a global label at the PC * * Inputs: * sp - pointer to the opcode * * Outputs: * sp - pointer to the next opcode * **************************************************************** * Global private using Common inc4 sp skip the op code ph4 sp push the symbol name ptr lda [sp] skip the symbol name and #$00FF sec adc sp sta sp bcc lb1 inc sp+2 lb1 lda segVersion if the segment is version 0 ro 1 then cmp #2 beq lb2 add4 sp,#3 skip the attributes (1 byte length) bra lb3 else lb2 add4 sp,#4 skip the attributes (2 byte length) lb3 anop endif ph2 #1 the symbol is global ph4 pc push the pass 2 value jsr Define2 define the symbol rts end **************************************************************** * * Invalid - invalid op code * * Notes: * An invalid opcode stops the link process with a * terminal error. * **************************************************************** * Invalid private lda #8 jmp TermError end **************************************************************** * * LConst - long constant bytes * * Inputs: * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * LConst private ldy #1 get the length lda [sp],Y sta r0 iny iny lda [sp],Y sta r2 add4 sp,#5 skip the op code, length ldx r2 move 64K chunks beq lb3 ldy #0 lb2 lda [sp],Y sta [op],Y dey dey bne lb2 inc op+2 inc sp+2 inc pc+2 dec r2 bne lb2 lb3 ldy r0 move the remaining bytes beq lb6 short M dey beq lb5 lb4 lda [sp],Y sta [op],Y dey bne lb4 lb5 lda [sp] sta [op] long M add4 op,r0 update op for the <64K part add4 sp,r0 skip the rest of the record add4 pc,r0 update the PC lb6 rts end **************************************************************** * * LExpr - evaluate an expression, allowing references to dynamic segs * * Inputs: * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * LExpr private using ExpCommon using Common using OutCommon stz saveSegment saveSegment := false lda [sp] update the PC xba and #$00FF sta expLength lb1 add4 sp,#2 skip the op code and expression length ph4 sp evaluate the expression jsr Evaluate sta expValue stx expValue+2 lda expSegment if the expression uses values in another beq lb2 segment then cmp loadNumber beq lb2 lda expSegment if the segment is dynamic then jsr IsDynamic bcc lb1a jsr JumpTable create a jump table entry lb1a lda symbolRelocatable if the expression is relocatable then beq lb3 jsr DictInterseg create a dictionary entry sta saveSegment save the save segment flag lda shiftFlag if the value is shifted then beq lb3 use the unshifted value move4 shiftValue,expValue bra lb3 else lb2 lda symbolRelocatable if the expression is relocatable then beq lb3 jsr DictReloc create a dictionary entry lb3 anop endif jsr PutValue write an expression value lda saveSegment if saveSegment then beq lb4 sec save the segment number lda op sbc saveSegment sta r0 lda op+2 sbc #0 sta r2 short M clc lda expSegment sta [r0] long M lb4 brl SkipExpression skip the expression saveSegment ds 2 save segment number flag end **************************************************************** * * ListSeg - list the segment start info * * Inputs: * segName - ptr to name of the segment * segType - segment type * pc - segment disp * segLength - segment length * list - list info flag * **************************************************************** * ListSeg private using Common using OutCommon lda list if list then jeq lb3 ph4 pc print the program counter ph2 #8 ph2 #0 jsr PrintHex putc #' ' ph4 segLength print the segment length ph2 #8 ph2 #0 jsr PrintHex putc #' ' print the load segment number lda loadNumber ldx kflag beq lb0 ldx express beq lb0 inc A lb0 pea 0 pha ph2 #2 ph2 #0 jsr PrintHex lda segType print the segment type lsr A bcc lb1 puts #' Data: ' bra lb2 lb1 puts #' Code: ' lb2 sub4 segName,#1,r0 print the segment name puts [r0],cr=t jsr CheckForPause check for early exit rts lb3 lda progress else if progres then beq lb4 putc #'.' print a dot lb4 jsr CheckForPause check for early exit rts end **************************************************************** * * Local - define a local label at the PC * * Inputs: * sp - pointer to the opcode * * Outputs: * sp - pointer to the next opcode * **************************************************************** * Local private using Common inc4 sp skip the op code ph4 sp push the symbol name ptr lda [sp] skip the symbol name and #$00FF sec adc sp sta sp bcc lb1 inc sp+2 lb1 lda segVersion if the segment is version 0 ro 1 then cmp #2 beq lb2 add4 sp,#3 skip the attributes (1 byte length) bra lb3 else lb2 add4 sp,#4 skip the attributes (2 byte length) lb3 anop endif ph2 #0 the symbol is local ph4 pc push the pass 2 value jsr Define2 define the symbol rts end **************************************************************** * * Operation - handle an operation in an expression * * Inputs: * sp - pointer to the operation * * Outputs: * sp - pointer to the next expression term * **************************************************************** * Operation private inc4 sp rts end **************************************************************** * * PutValue - write a value to the file * * Inputs: * expValue - expression value * expLength - expression length * **************************************************************** * PutValue private using ExpCommon lda expLength write the value cmp #2 bge lb4 short M write a 1 byte value lda expValue sta [op] long M bra lb7 lb4 bne lb5 lda expValue write a 2 byte value sta [op] bra lb7 lb5 cmp #4 beq lb6 lda expValue write a 3 byte value sta [op] ldy #1 lda expValue+1 sta [op],Y bra lb7 lb6 lda expValue write a 4 byte value sta [op] ldy #2 lda expValue+2 sta [op],Y lb7 clc update op lda op adc expLength sta op bcc lb8 inc op+2 lb8 clc update pc lda pc adc expLength sta pc bcc lb9 inc pc+2 lb9 rts end **************************************************************** * * RelExpr - evaluate a relative expression * * Inputs: * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * RelExpr private using ExpCommon using Common using OutCommon lda [sp] update the PC xba and #$00FF sta expLength lb1 ldy #2 add pc, org and value clc lda [sp],Y adc pc sta t1 iny iny lda [sp],Y adc pc+2 sta t1+2 add4 t1,loadOrg add4 sp,#6 skip the op code, length & value ph4 sp evaluate the expression jsr Evaluate sta expValue stx expValue+2 sub4 expValue,t1 compute rel displacement add4 expValue,loadOrg,t1 t1 = expValue+loadOrg short I,M check t1 for branch out of range lda expLength cmp #4 bge lb6 tay tax lda t1,X bmi lb3 lb2 lda t1,X bne lb5 inx cpx #4 blt lb2 lda t1-1,Y bpl lb6 bra lb5 lb3 lda #$FF lb4 cmp t1,X bne lb5 inx cpx #4 blt lb4 lda t1-1,Y bmi lb6 lb5 long I,M ph4 #0 ph2 #11 jsr Error lb6 long I,M lda expSegment if the expression uses values in another beq lb7 segment then flag the error cmp loadNumber beq lb7 ph4 #0 ph2 #10 jsr Error lb7 jsr PutValue write an expression value brl SkipExpression skip the expression t1 ds 4 temp value end **************************************************************** * * SkipExpression - skip an expression, noting label uses * * Inputs: * sp - pointer to the first opcode in the expression * * Outputs: * sp - pointer to the first opcode past the expression * **************************************************************** * SkipExpression private lb1 lda [sp] and #$00FF asl A tax jsr (addr,X) bra lb1 addr dc a'EndExp' $00 End dc 15a'Operation' $01..$0F some form of operation dc 6a'Operation' $10..$15 some form of operation dc 10a'Invalid' $16..$1F unused dc 16a'Invalid' $20..$2F unused dc 16a'Invalid' $30..$3F unused dc 16a'Invalid' $40..$4F unused dc 16a'Invalid' $50..$5F unused dc 16a'Invalid' $60..$6F unused dc 16a'Invalid' $70..$7F unused dc a'Operation' $80 program counter dc a'Value' $81 absolute value dc a'WeakReference' $82 weak label reference dc a'StrongReference' $83 strong label reference dc a'StrongReference' $84 length attribute dc a'StrongReference' $85 type attribute dc a'WeakReference' $86 count attribute dc a'Value' $87 disp from start of segment dc 8a'Invalid' $88-8F unused dc 16a'Invalid' $90..$9F unused dc 16a'Invalid' $A0..$AF unused dc 16a'Invalid' $B0..$BF unused dc 16a'Invalid' $C0..$CF unused dc 16a'Invalid' $D0..$DF unused dc 16a'Invalid' $E0..$EF unused dc 16a'Invalid' $F0..$FF unused end **************************************************************** * * Strong - Strong label reference * * Inputs: * sp - pointer to the opcode * * Outputs: * sp - pointer to the next opcode * **************************************************************** * Strong private using ExpCommon inc4 sp skip the op code jsr Reference2 make a reference to the name stz expSegment find the symbol value (forces error) ph4 sp ph2 #1 jsr GetSymbolValue lda [sp] skip the name in the obj segment and #$00FF sec adc sp sta sp bcc lb1 inc sp+2 lb1 rts end **************************************************************** * * StrongReference - handle a strong label reference in an expression * * Inputs: * sp - pointer to the label name * * Outputs: * sp - pointer to the next expression term * **************************************************************** * StrongReference private inc4 sp skip the op code jsr Reference2 make a reference to the name lda [sp] skip the name in the segment and #$00FF sec adc sp sta sp bcc lb1 inc sp+2 lb1 rts end **************************************************************** * * Using - Note that we are using a data area * * Inputs: * sp - pointer to the opcode * * Outputs: * sp - pointer to the next opcode * **************************************************************** * Using private using ExpCommon using Common inc4 sp skip the op code jsr Reference2 make a reference to the name stz expSegment find the symbol ph4 sp ph2 #1 jsr GetSymbolValue lda symbolFlag if not a data area then and #isDataArea bne lb1 ph4 sp Error(sp,8) ph2 #8 jsr Error bra lb2 else lb1 ldx symbolData set the data area flag short M lda #1 sta dataAreas,X long M lb2 anop endif lda [sp] skip the name in the obj segment and #$00FF sec adc sp sta sp bcc lb3 inc sp+2 lb3 rts end **************************************************************** * * Value - handle a value in an expression * * Inputs: * sp - pointer to the value * * Outputs: * sp - pointer to the next expression term * **************************************************************** * Value private add4 sp,#5 rts end **************************************************************** * * WeakReference - handle a weak label reference in an expression * * Inputs: * sp - pointer to the label name * * Outputs: * sp - pointer to the next expression term * **************************************************************** * WeakReference private lda [sp] and #$FF00 xba inc A sec adc sp sta sp bcc lb1 inc sp+2 lb1 rts end **************************************************************** * * ZExpr - evaluate a zero page expression * * Inputs: * sp - pointer to the opcode * pc - current program counter * * Outputs: * sp - pointer to the next opcode * pc - new program counter * **************************************************************** * ZExpr private using ExpCommon using Common using OutCommon lda [sp] update the PC xba and #$00FF sta expLength lb1 add4 sp,#2 skip the op code and expression length ph4 sp evaluate the expression jsr Evaluate sta expValue stx expValue+2 ldx expLength make sure truncated bytes are 0 cpx #4 bge lb2 lb1a lda expValue,X and #$00FF beq lb1b ph4 #0 ph2 #9 jsr Error bra lb2 lb1b inx cpx #4 blt lb1a lb2 lda symbolRelocatable if the expression is relocatable then beq lb3 ph4 #0 flag an error ph2 #9 jsr Error lb3 jsr PutValue write an expression value brl SkipExpression skip the expression end \ No newline at end of file + keep obj/pass2 + mcopy pass2.mac +**************************************************************** +* +* Pass 2 +* +* This module contains the subroutines used to do pass 2 +* processing of the input files and creation of the output +* files. +* +**************************************************************** + copy directPage + +**************************************************************** +* +* Align - align the code to a byte boundary +* +* Inputs: +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +Align private + + ldy #1 get the alignment factor + lda [sp],Y + sta r0 + iny + iny + lda [sp],Y + sta r2 + add4 sp,#5 skip the alignment opcode and operand + jsr DefineAlign do the align + rts + end + +**************************************************************** +* +* BExpr - evaluate a local bank expression +* +* Inputs: +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +BExpr private + using ExpCommon + using OutCommon + using Common + + stz saveSegment saveSegment := false + lda [sp] update the PC + xba + and #$00FF + sta expLength +lb1 add4 sp,#2 skip the op code and expression length + ph4 sp evaluate the expression + jsr Evaluate + sta expValue + stx expValue+2 + add4 loadOrg,pc,val1 make sure bank bytes match + lda symbolRelocatable + beq lb2 + add4 loadOrg,expValue,val2 + bra lb2a +lb2 move4 expValue,val2 +lb2a stz mask + stz mask+2 + short M + ldx expLength + beq lb4 + cpx #4 + bge lb4 + ldx #3 + lda #$FF +lb3 sta mask,X + dex + cpx expLength + bge lb3 +lb4 long M + lda mask + and val1 + sta val1 + lda mask+2 + and val1+2 + sta val1+2 + lda mask + and val2 + cmp val1 + bne lb5 + lda mask+2 + and val2+2 + cmp val1+2 + beq lb6 +lb5 ph4 #0 + ph2 #10 + jsr Error + bra lb10 +lb6 lda expSegment if the expression uses values in another + beq lb10 segment then + cmp loadNumber + beq lb10 + lda expLength if the expression is too short for + cmp #3 a legal interseg reference then + bge lb7 + ph4 #0 flag the error + ph2 #10 + jsr Error + bra lb10 skip to "normal" processing +lb7 lda symbolRelocatable if the expression is relocatable then + beq lb9 + jsr DictInterseg create a dictionary entry + sta saveSegment save the save segment flag + lda shiftFlag if the value is shifted then + beq lb8 + move4 shiftValue,expValue use the unshifted value +lb8 anop +lb9 lda expSegment if the segment is dynamic then + jsr IsDynamic + bcc lb11 + ph4 #0 flag the error + ph2 #17 + jsr Error + bra lb11 else +lb10 lda symbolRelocatable if the expression is relocatable then + beq lb11 + jsr DictReloc create a dictionary entry +lb11 anop endif + + jsr PutValue write an expression value + lda saveSegment if saveSegment then + beq lb12 + sec save the segment number + lda op + sbc saveSegment + sta r0 + lda op+2 + sbc #0 + sta r2 + short M + clc + lda expSegment + sta [r0] + long M +lb12 brl SkipExpression skip the expression +; +; Local data +; +val1 ds 4 first address +val2 ds 4 second address +mask ds 4 bank mask +saveSegment ds 2 save segment number flag + end + +**************************************************************** +* +* Const - constant bytes +* +* Inputs: +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +Const private + + lda [sp] update the program counter + and #$00FF + tay + clc + adc pc + sta pc + bcc lb1 + inc pc+2 +lb1 inc4 sp skip the op code + tyx save the length + + tya move the bytes + lsr A + bcc lb2 + short M + dey + lda [sp],Y + sta [op],Y + long M +lb2 dey + dey + bmi lb3a +lb3 lda [sp],Y + sta [op],Y + dey + dey + bpl lb3 +lb3a anop + txa update the output pointer + clc + adc op + sta op + bcc lb4 + inc op+2 +lb4 txa update sp + clc + adc sp + sta sp + bcc lb5 + inc sp+2 +lb5 rts + end + +**************************************************************** +* +* DefineAlign - align to a power of 2 boundary +* +* Inputs: +* r0 - alignment factor +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +DefineAlign start + using Common + + stz total total = 0 + stz total+2 + move4 pc,tpc save the pc + ph4 r0 check the alignment factor + jsr CheckAlign + dec4 r0 align the PC + +lb1 lda r0 quit if we are aligned + and pc + bne lb2 + lda r2 + and pc+2 + beq lb5 +lb2 lda r0 form the remaining bit mask + and pc + sta r4 + lda r2 + and pc+2 + sta r6 + lda #1 find the least significant bit + sta r8 + stz r10 +lb3 lda r8 + and r4 + bne lb4 + lda r10 + and r6 + bne lb4 + asl r8 + rol r10 + bra lb3 +lb4 add4 total,r8 update the total + add4 pc,r8 + bra lb1 check the next bit + +lb5 move4 tpc,pc reset pc + lda total if total <> 0 then + ora total+2 + beq lb6 + move4 total,r0 define an appropriate DS record + jsr DefineDS +lb6 rts + +total ds 4 total DS space +tpc ds 4 temp pc + end + +**************************************************************** +* +* DefineDS - reserve space in a segment +* +* Inputs: +* r0 - # of bytes to reserve +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +DefineDS start + using Common + + add4 pc,r0 update the program count + lda express if express or (r0 < 10) then + bne lb0 + lda r2 + bne lb7 + lda r0 + cmp #10 + bge lb7 +lb0 ldx r2 fill 64K areas + beq lb2 + ldy #0 + tya +lb1 sta [op],Y + dey + dey + bne lb1 + inc op+2 + dex + bne lb1 +lb2 short M fill in remaining bytes + lda #0 + ldy r0 + beq lb5 + dey + beq lb4 +lb3 sta [op],Y + dey + bne lb3 +lb4 sta [op] +lb5 long M + clc update op + lda op + adc r0 + sta op + bcc lb6 + inc op+2 +lb6 bra lb8 else {if not express then} +lb7 ph4 r0 finish off the current lConst + jsr FinishLConst + pl4 r0 + lda #$F1 place a DS record in the segment + sta [op] + ldy #1 + lda r0 + sta [op],Y + iny + iny + lda r2 + sta [op],Y + add4 op,#5,opst start a new lConst + add4 op,#10 update op +lb8 anop endif + rts + end + +**************************************************************** +* +* DefineSegment - put the segment in the symbol table +* +* Inputs: +* segName - pointer to the segment name +* pc - current pc +* segEntry - disp to segment entry point +* +**************************************************************** +* +DefineSegment private + using Common + + ph4 segName push the symbol name ptr + ph2 #1 the symbol is global + clc push the location + lda pc + adc segEntry + tax + lda pc+2 + adc segEntry+2 + pha + phx + jsr Define2 define the symbol + rts + end + +**************************************************************** +* +* DictReloc - Create a relocatable dictionary entry (current bank) +* +* Inputs: +* bankOrg - is the program bank relative? +* expLength - expression length +* expValue - expression value +* shiftFlag - is the value shifted? +* shiftValue - value before a shift +* shiftCount - shift counter +* +**************************************************************** +* +DictReloc private + using Common + using ExpCommon + using OutCommon + + lda bankOrg if the program is bank relative then + beq lb0 + lda shiftFlag if the value is not shifted then + bne lb0 + lda expLength if the expression is 1 or 2 bytes then + cmp #3 + bge lb0 + rts return + +lb0 lda #11 make sure there is room in the dictionary + cmp loadDictSize + blt lb1 + jsr ExpandDictBuffer + +lb1 lda shiftFlag if the expression is shifted then + beq lb1a + move4 shiftValue,val use the unshifted value + bra lb1b else +lb1a move4 expValue,val use the returned value +lb1b anop endif + lda val+2 short = val and pc < 64K + ora pc+2 + sta short + short M if short then + bne lb2 + lda #$F5 write the cReloc opcode + sta [dp] + lda expLength write the expression length + cmp #4 + bne lb1c + dec A +lb1c ldy #1 + sta [dp],Y + bra lb3 else +lb2 lda #$E2 write the Reloc opcode + sta [dp] + lda expLength write the expression length + ldy #1 + sta [dp],Y +lb3 iny write the shift count + lda shiftCount + sta [dp],Y + long M + lda short if short then + bne lb4 + lda pc save the pc + iny + sta [dp],Y + iny save the value + iny + lda val + sta [dp],Y + add4 dp,#7 update dp + sub2 loadDictSize,#7 update loadDictSize + rts return + +lb4 iny save the pc + lda pc + sta [dp],Y + iny + iny + lda pc+2 + sta [dp],Y + iny save the value + iny + lda val + sta [dp],Y + iny + iny + lda val+2 + sta [dp],Y + sub2 loadDictSize,#11 update loadDictSize + add4 dp,#11 update dp + rts +; +; Local data +; +short ds 2 is this a cReloc? +val ds 4 expression value + end + +**************************************************************** +* +* DictInterseg - Create an interseg dictionary entry (another bank) +* +* Inputs: +* expLength - expression length +* expValue - expression value +* expSegment - expression segment number +* shiftFlag - is the value shifted? +* shiftValue - value before a shift +* shiftCount - shift counter +* +* Outputs: +* A - 1 if the segment should be saved in the expression, +* else 0. (The segment is saved with the expression +* for 3-byte cInterseg expressions with 0 shift when +* files are being compacted.) +* +**************************************************************** +* +DictInterseg private + using Common + using ExpCommon + using OutCommon + + stz saveSegment don't save the segment number + lda #15 make sure there is room in the dictionary + cmp loadDictSize + blt lb1 + jsr ExpandDictBuffer + +lb1 lda shiftFlag if the expression is shifted then + beq lb1a + move4 shiftValue,val use the unshifted value + bra lb1b else +lb1a move4 expValue,val use the returned value +lb1b anop endif + lda expSegment short = (val < 64K) and (pc < 64K) + and #$FF00 and (expSegment < 256) + ora val+2 + ora pc+2 + sta short + short M if short then + bne lb2 + lda #$F6 write the cInterseg opcode + sta [dp] + lda expLength write the expression length + cmp #4 + bne lb1c + ldx compact if compact then + beq ss1 + ldx shiftFlag if not shiftFlag then + bne ss1 + ldx #2 set saveSegment + stx saveSegment +ss1 dec A convert length to 3 +lb1c ldy #1 + sta [dp],Y + bra lb3 else +lb2 lda #$E3 write the interseg opcode + sta [dp] + lda expLength write the expression length + ldy #1 + sta [dp],Y +lb3 ldy #2 write the shift count + lda shiftCount + sta [dp],Y + long M + lda short if short then + bne lb4 + lda pc save the pc + iny + sta [dp],Y + iny save the expression segment + iny + lda expSegment + sta [dp],Y + iny save the value + lda val + sta [dp],Y + sub2 loadDictSize,#8 update loadDictSize + add4 dp,#8 update dp + ldx compact if compact then + beq lb4a + ldx expLength if expLength = 3 then + cpx #3 + bne lb4a + ldx shiftFlag if not shiftFlag then + bne lb4a + lda #1 we do need to save the segment + sta saveSegment +lb4a lda saveSegment return the save segment code + rts + +lb4 iny save the pc + lda pc + sta [dp],Y + iny + iny + lda pc+2 + sta [dp],Y + iny set the file number to 1 + iny + lda #1 + sta [dp],Y + iny save the segment number + iny + lda expSegment + sta [dp],Y + iny save the value + iny + lda val + sta [dp],Y + iny + iny + lda val+2 + sta [dp],Y + sub2 loadDictSize,#15 update loadDictSize + add4 dp,#15 update dp + lda #0 don't save the segment number + rts +; +; Local data +; +saveSegment ds 2 save segment code: +! 0: don't save the segment # +! 1: save segment # in 3 byte field +! 2: save segment # in 4 byte field +short ds 2 is this a cReloc? +val ds 4 expression value + end + +**************************************************************** +* +* DoOrg - set the program counter +* +* Inputs: +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +DoOrg private + + ldy #1 get the value + lda [sp],Y + sta r4 + ldy #3 + lda [sp],Y + sta r6 + add4 sp,#5 skip the op code & operand + sub4 pc,r4,r0 calculate the space to insert + lda r2 if space < 0 then + bpl lb1 + ph4 #0 Error(NULL,3) + ph2 #3 + jsr Error + rts return + +lb1 jsr DefineDS handle the ORG + rts + end + +**************************************************************** +* +* DoPass2 - Do pass 1 processing +* +* Outputs: +* C - set if an error occurred +* +**************************************************************** +* +DoPass2 start + using Common +; +; Write the pass header +; + lda #2 pass = 2 + sta pass + lda list if (not list) and progress then + bne wp1 + lda progress + beq wp1 + puts #'Pass 2: ' print the dot header +wp1 anop +; +; Initialize pass dependent variables +; + jsr InitPass + jsr DynamicCheck +; +; Process segments until there are no more +; +ps1 jsr NextSegment get the next segment + bcc rt1 branch if there are no more + move #0,dataAreas,#256 clear the data area flags + jsr DefineSegment put the segment in the symbol table + jsr ListSeg list the segname start info + jsr DoSegment process the segment + lda segSpace add in the reserved space (if any) + ora segSpace+2 + beq ps1 + move4 segSpace,r0 + jsr DefineDS + bra ps1 next segment +; +; Return to main +; +rt1 lda list if list or progress then + bne rt2 + lda progress + beq rt3 +rt2 putcr write a cr +rt3 anop endif + clc + rts + end + +**************************************************************** +* +* DoSegment - process the opcodes in this segment +* +* Inputs: +* sp - pointer to the first opcode to process +* +**************************************************************** +* +DoSegment private + +lb1 lda [sp] + and #$00FF + asl A + tax + jsr (addr,X) + bra lb1 + +addr dc a'End' $00 End + dc 15a'Const' $01..$0F Const + dc 16a'Const' $10..$1F Const + dc 16a'Const' $20..$2F Const + dc 16a'Const' $30..$3F Const + dc 16a'Const' $40..$4F Const + dc 16a'Const' $50..$5F Const + dc 16a'Const' $60..$6F Const + dc 16a'Const' $70..$7F Const + dc 16a'Const' $80..$8F Const + dc 16a'Const' $90..$9F Const + dc 16a'Const' $A0..$AF Const + dc 16a'Const' $B0..$BF Const + dc 16a'Const' $C0..$CF Const + dc 16a'Const' $D0..$DF Const + dc a'Align' $E0 Align + dc a'DoOrg' $E1 Org + dc a'Invalid' $E2 Reloc + dc a'Invalid' $E3 Interseg + dc a'Using' $E4 Using + dc a'Strong' $E5 Strong + dc a'Global' $E6 Global + dc a'Gequ' $E7 Gequ + dc a'Invalid' $E8 Mem + dc a'Invalid' $E9 unused + dc a'Invalid' $EA unused + dc a'Expr' $EB Expr + dc a'ZExpr' $EC ZExpr + dc a'BExpr' $ED BExpr + dc a'RelExpr' $EE RelExpr + dc a'Local' $EF Local + dc a'Equ' $F0 Equ + dc a'DS' $F1 DS + dc a'Lconst' $F2 LConst + dc a'LExpr' $F3 LExpr + dc a'Invalid' $F4 Entry + dc a'Invalid' $F5 cReloc + dc a'Invalid' $F6 cInterseg + dc a'Invalid' $F7 Super + dc a'Invalid' $F8 unused + dc a'Invalid' $F9 unused + dc a'Invalid' $FA unused + dc a'Invalid' $FB unused + dc a'Invalid' $FC unused + dc a'Invalid' $FD unused + dc a'Invalid' $FE unused + dc a'Invalid' $FF unused + end + +**************************************************************** +* +* DS - insert zeros at the PC +* +* Inputs: +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +DS private + using Common + + inc4 sp skip the opcode + ldy #2 get the DS length + lda [sp] + sta r0 + lda [sp],Y + sta r2 + jsr DefineDS handle the DS + add4 sp,#4 skip the length + rts + end + +**************************************************************** +* +* End - end of the segment +* +**************************************************************** +* +End private + + pla + rts + end + +**************************************************************** +* +* EndExp - end of the expression +* +* Inputs: +* sp - pointer to the opcode +* +* Outputs: +* sp - pointer to the next opcode +* +**************************************************************** +* +EndExp private + + inc4 sp + pla + rts + end + +**************************************************************** +* +* Equ - define a local equate +* +* Inputs: +* sp - pointer to the opcode +* +* Outputs: +* sp - pointer to the next opcode +* +**************************************************************** +* +Equ private + using Common + + inc4 sp skip the op code + ph4 sp push the symbol name ptr + lda [sp] skip the symbol name + and #$00FF + sec + adc sp + sta sp + bcc lb1 + inc sp+2 +lb1 lda segVersion if the segment is version 0 ro 1 then + cmp #2 + beq lb2 + add4 sp,#3 skip the attributes (1 byte length) + bra lb3 else +lb2 add4 sp,#4 skip the attributes (2 byte length) +lb3 anop endif + ph2 #0 the symbol is local + ph4 #0 don't check for addressing errors + jsr Define2 define the symbol + jsr SkipExpression skip the expression + rts + end + +**************************************************************** +* +* Expr - evaluate an expression +* +* Inputs: +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +Expr private + using ExpCommon + using Common + using OutCommon + + stz saveSegment saveSegment := false + lda [sp] update the PC + xba + and #$00FF + sta expLength +lb1 add4 sp,#2 skip the op code and expression length + ph4 sp evaluate the expression + jsr Evaluate + sta expValue + stx expValue+2 + lda expSegment if the expression uses values in another + beq lb2 segment then + cmp loadNumber + beq lb2 + lda symbolRelocatable if the expression is relocatable then + beq lb1a + jsr DictInterseg create a dictionary entry + sta saveSegment save the save segment flag + lda shiftFlag if the value is shifted then + beq sh1 use the unshifted value + move4 shiftValue,expValue +sh1 anop +lb1a lda expSegment if the segment is dynamic then + jsr IsDynamic + bcc lb3 + ph4 #0 flag the error + ph2 #17 + jsr Error + bra lb3 else +lb2 lda symbolRelocatable if the expression is relocatable then + beq lb3 + jsr DictReloc create a dictionary entry +lb3 anop endif + jsr PutValue write an expression value + lda saveSegment if saveSegment then + beq lb4 + sec save the segment number + lda op + sbc saveSegment + sta r0 + lda op+2 + sbc #0 + sta r2 + short M + clc + lda expSegment + sta [r0] + long M +lb4 brl SkipExpression skip the expression + +saveSegment ds 2 save segment number flag + end + +**************************************************************** +* +* Gequ - define a global equate +* +* Inputs: +* sp - pointer to the opcode +* +* Outputs: +* sp - pointer to the next opcode +* +**************************************************************** +* +Gequ private + using Common + + inc4 sp skip the op code + ph4 sp push the symbol name ptr + lda [sp] skip the symbol name + and #$00FF + sec + adc sp + sta sp + bcc lb1 + inc sp+2 +lb1 lda segVersion if the segment is version 0 or 1 then + cmp #2 + beq lb2 + add4 sp,#3 skip the attributes (1 byte length) + bra lb3 else +lb2 add4 sp,#4 skip the attributes (2 byte length) +lb3 anop endif + ph2 #1 the symbol is global + ph4 #0 don't ceck for addressing errors + jsr Define2 define the symbol + jsr SkipExpression skip the expression + rts + end + +**************************************************************** +* +* Global - define a global label at the PC +* +* Inputs: +* sp - pointer to the opcode +* +* Outputs: +* sp - pointer to the next opcode +* +**************************************************************** +* +Global private + using Common + + inc4 sp skip the op code + ph4 sp push the symbol name ptr + lda [sp] skip the symbol name + and #$00FF + sec + adc sp + sta sp + bcc lb1 + inc sp+2 +lb1 lda segVersion if the segment is version 0 ro 1 then + cmp #2 + beq lb2 + add4 sp,#3 skip the attributes (1 byte length) + bra lb3 else +lb2 add4 sp,#4 skip the attributes (2 byte length) +lb3 anop endif + ph2 #1 the symbol is global + ph4 pc push the pass 2 value + jsr Define2 define the symbol + rts + end + +**************************************************************** +* +* Invalid - invalid op code +* +* Notes: +* An invalid opcode stops the link process with a +* terminal error. +* +**************************************************************** +* +Invalid private + + lda #8 + jmp TermError + end + +**************************************************************** +* +* LConst - long constant bytes +* +* Inputs: +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +LConst private + + ldy #1 get the length + lda [sp],Y + sta r0 + iny + iny + lda [sp],Y + sta r2 + add4 sp,#5 skip the op code, length + + ldx r2 move 64K chunks + beq lb3 + ldy #0 +lb2 lda [sp],Y + sta [op],Y + dey + dey + bne lb2 + inc op+2 + inc sp+2 + inc pc+2 + dec r2 + bne lb2 +lb3 ldy r0 move the remaining bytes + beq lb6 + short M + dey + beq lb5 +lb4 lda [sp],Y + sta [op],Y + dey + bne lb4 +lb5 lda [sp] + sta [op] + long M + + add4 op,r0 update op for the <64K part + add4 sp,r0 skip the rest of the record + add4 pc,r0 update the PC +lb6 rts + end + +**************************************************************** +* +* LExpr - evaluate an expression, allowing references to dynamic segs +* +* Inputs: +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +LExpr private + using ExpCommon + using Common + using OutCommon + + stz saveSegment saveSegment := false + lda [sp] update the PC + xba + and #$00FF + sta expLength +lb1 add4 sp,#2 skip the op code and expression length + ph4 sp evaluate the expression + jsr Evaluate + sta expValue + stx expValue+2 + lda expSegment if the expression uses values in another + beq lb2 segment then + cmp loadNumber + beq lb2 + lda expSegment if the segment is dynamic then + jsr IsDynamic + bcc lb1a + jsr JumpTable create a jump table entry +lb1a lda symbolRelocatable if the expression is relocatable then + beq lb3 + jsr DictInterseg create a dictionary entry + sta saveSegment save the save segment flag + lda shiftFlag if the value is shifted then + beq lb3 use the unshifted value + move4 shiftValue,expValue + bra lb3 else +lb2 lda symbolRelocatable if the expression is relocatable then + beq lb3 + jsr DictReloc create a dictionary entry +lb3 anop endif + jsr PutValue write an expression value + lda saveSegment if saveSegment then + beq lb4 + sec save the segment number + lda op + sbc saveSegment + sta r0 + lda op+2 + sbc #0 + sta r2 + short M + clc + lda expSegment + sta [r0] + long M +lb4 brl SkipExpression skip the expression + +saveSegment ds 2 save segment number flag + end + +**************************************************************** +* +* ListSeg - list the segment start info +* +* Inputs: +* segName - ptr to name of the segment +* segType - segment type +* pc - segment disp +* segLength - segment length +* list - list info flag +* +**************************************************************** +* +ListSeg private + using Common + using OutCommon + + lda list if list then + jeq lb3 + ph4 pc print the program counter + ph2 #8 + ph2 #0 + jsr PrintHex + putc #' ' + ph4 segLength print the segment length + ph2 #8 + ph2 #0 + jsr PrintHex + putc #' ' print the load segment number + lda loadNumber + ldx kflag + beq lb0 + ldx express + beq lb0 + inc A +lb0 pea 0 + pha + ph2 #2 + ph2 #0 + jsr PrintHex + lda segType print the segment type + lsr A + bcc lb1 + puts #' Data: ' + bra lb2 +lb1 puts #' Code: ' +lb2 sub4 segName,#1,r0 print the segment name + puts [r0],cr=t + jsr CheckForPause check for early exit + rts + +lb3 lda progress else if progres then + beq lb4 + putc #'.' print a dot +lb4 jsr CheckForPause check for early exit + rts + end + +**************************************************************** +* +* Local - define a local label at the PC +* +* Inputs: +* sp - pointer to the opcode +* +* Outputs: +* sp - pointer to the next opcode +* +**************************************************************** +* +Local private + using Common + + inc4 sp skip the op code + ph4 sp push the symbol name ptr + lda [sp] skip the symbol name + and #$00FF + sec + adc sp + sta sp + bcc lb1 + inc sp+2 +lb1 lda segVersion if the segment is version 0 ro 1 then + cmp #2 + beq lb2 + add4 sp,#3 skip the attributes (1 byte length) + bra lb3 else +lb2 add4 sp,#4 skip the attributes (2 byte length) +lb3 anop endif + ph2 #0 the symbol is local + ph4 pc push the pass 2 value + jsr Define2 define the symbol + rts + end + +**************************************************************** +* +* Operation - handle an operation in an expression +* +* Inputs: +* sp - pointer to the operation +* +* Outputs: +* sp - pointer to the next expression term +* +**************************************************************** +* +Operation private + + inc4 sp + rts + end + +**************************************************************** +* +* PutValue - write a value to the file +* +* Inputs: +* expValue - expression value +* expLength - expression length +* +**************************************************************** +* +PutValue private + using ExpCommon + + lda expLength write the value + cmp #2 + bge lb4 + short M write a 1 byte value + lda expValue + sta [op] + long M + bra lb7 +lb4 bne lb5 + lda expValue write a 2 byte value + sta [op] + bra lb7 +lb5 cmp #4 + beq lb6 + lda expValue write a 3 byte value + sta [op] + ldy #1 + lda expValue+1 + sta [op],Y + bra lb7 +lb6 lda expValue write a 4 byte value + sta [op] + ldy #2 + lda expValue+2 + sta [op],Y +lb7 clc update op + lda op + adc expLength + sta op + bcc lb8 + inc op+2 +lb8 clc update pc + lda pc + adc expLength + sta pc + bcc lb9 + inc pc+2 +lb9 rts + end + +**************************************************************** +* +* RelExpr - evaluate a relative expression +* +* Inputs: +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +RelExpr private + using ExpCommon + using Common + using OutCommon + + lda [sp] update the PC + xba + and #$00FF + sta expLength +lb1 ldy #2 add pc, org and value + clc + lda [sp],Y + adc pc + sta t1 + iny + iny + lda [sp],Y + adc pc+2 + sta t1+2 + add4 t1,loadOrg + add4 sp,#6 skip the op code, length & value + ph4 sp evaluate the expression + jsr Evaluate + sta expValue + stx expValue+2 + sub4 expValue,t1 compute rel displacement + + add4 expValue,loadOrg,t1 t1 = expValue+loadOrg + short I,M check t1 for branch out of range + lda expLength + cmp #4 + bge lb6 + tay + tax + lda t1,X + bmi lb3 +lb2 lda t1,X + bne lb5 + inx + cpx #4 + blt lb2 + lda t1-1,Y + bpl lb6 + bra lb5 +lb3 lda #$FF +lb4 cmp t1,X + bne lb5 + inx + cpx #4 + blt lb4 + lda t1-1,Y + bmi lb6 +lb5 long I,M + ph4 #0 + ph2 #11 + jsr Error +lb6 long I,M + + lda expSegment if the expression uses values in another + beq lb7 segment then flag the error + cmp loadNumber + beq lb7 + ph4 #0 + ph2 #10 + jsr Error +lb7 jsr PutValue write an expression value + brl SkipExpression skip the expression + +t1 ds 4 temp value + end + +**************************************************************** +* +* SkipExpression - skip an expression, noting label uses +* +* Inputs: +* sp - pointer to the first opcode in the expression +* +* Outputs: +* sp - pointer to the first opcode past the expression +* +**************************************************************** +* +SkipExpression private + +lb1 lda [sp] + and #$00FF + asl A + tax + jsr (addr,X) + bra lb1 + +addr dc a'EndExp' $00 End + dc 15a'Operation' $01..$0F some form of operation + dc 6a'Operation' $10..$15 some form of operation + dc 10a'Invalid' $16..$1F unused + dc 16a'Invalid' $20..$2F unused + dc 16a'Invalid' $30..$3F unused + dc 16a'Invalid' $40..$4F unused + dc 16a'Invalid' $50..$5F unused + dc 16a'Invalid' $60..$6F unused + dc 16a'Invalid' $70..$7F unused + dc a'Operation' $80 program counter + dc a'Value' $81 absolute value + dc a'WeakReference' $82 weak label reference + dc a'StrongReference' $83 strong label reference + dc a'StrongReference' $84 length attribute + dc a'StrongReference' $85 type attribute + dc a'WeakReference' $86 count attribute + dc a'Value' $87 disp from start of segment + dc 8a'Invalid' $88-8F unused + dc 16a'Invalid' $90..$9F unused + dc 16a'Invalid' $A0..$AF unused + dc 16a'Invalid' $B0..$BF unused + dc 16a'Invalid' $C0..$CF unused + dc 16a'Invalid' $D0..$DF unused + dc 16a'Invalid' $E0..$EF unused + dc 16a'Invalid' $F0..$FF unused + end + +**************************************************************** +* +* Strong - Strong label reference +* +* Inputs: +* sp - pointer to the opcode +* +* Outputs: +* sp - pointer to the next opcode +* +**************************************************************** +* +Strong private + using ExpCommon + + inc4 sp skip the op code + jsr Reference2 make a reference to the name + stz expSegment find the symbol value (forces error) + ph4 sp + ph2 #1 + jsr GetSymbolValue + lda [sp] skip the name in the obj segment + and #$00FF + sec + adc sp + sta sp + bcc lb1 + inc sp+2 +lb1 rts + end + +**************************************************************** +* +* StrongReference - handle a strong label reference in an expression +* +* Inputs: +* sp - pointer to the label name +* +* Outputs: +* sp - pointer to the next expression term +* +**************************************************************** +* +StrongReference private + + inc4 sp skip the op code + jsr Reference2 make a reference to the name + lda [sp] skip the name in the segment + and #$00FF + sec + adc sp + sta sp + bcc lb1 + inc sp+2 +lb1 rts + end + +**************************************************************** +* +* Using - Note that we are using a data area +* +* Inputs: +* sp - pointer to the opcode +* +* Outputs: +* sp - pointer to the next opcode +* +**************************************************************** +* +Using private + using ExpCommon + using Common + + inc4 sp skip the op code + jsr Reference2 make a reference to the name + stz expSegment find the symbol + ph4 sp + ph2 #1 + jsr GetSymbolValue + lda symbolFlag if not a data area then + and #isDataArea + bne lb1 + ph4 sp Error(sp,8) + ph2 #8 + jsr Error + bra lb2 else +lb1 ldx symbolData set the data area flag + short M + lda #1 + sta dataAreas,X + long M +lb2 anop endif + + lda [sp] skip the name in the obj segment + and #$00FF + sec + adc sp + sta sp + bcc lb3 + inc sp+2 +lb3 rts + end + +**************************************************************** +* +* Value - handle a value in an expression +* +* Inputs: +* sp - pointer to the value +* +* Outputs: +* sp - pointer to the next expression term +* +**************************************************************** +* +Value private + + add4 sp,#5 + rts + end + +**************************************************************** +* +* WeakReference - handle a weak label reference in an expression +* +* Inputs: +* sp - pointer to the label name +* +* Outputs: +* sp - pointer to the next expression term +* +**************************************************************** +* +WeakReference private + + lda [sp] + and #$FF00 + xba + inc A + sec + adc sp + sta sp + bcc lb1 + inc sp+2 +lb1 rts + end + +**************************************************************** +* +* ZExpr - evaluate a zero page expression +* +* Inputs: +* sp - pointer to the opcode +* pc - current program counter +* +* Outputs: +* sp - pointer to the next opcode +* pc - new program counter +* +**************************************************************** +* +ZExpr private + using ExpCommon + using Common + using OutCommon + + lda [sp] update the PC + xba + and #$00FF + sta expLength +lb1 add4 sp,#2 skip the op code and expression length + ph4 sp evaluate the expression + jsr Evaluate + sta expValue + stx expValue+2 + ldx expLength make sure truncated bytes are 0 + cpx #4 + bge lb2 +lb1a lda expValue,X + and #$00FF + beq lb1b + ph4 #0 + ph2 #9 + jsr Error + bra lb2 +lb1b inx + cpx #4 + blt lb1a + +lb2 lda symbolRelocatable if the expression is relocatable then + beq lb3 + ph4 #0 flag an error + ph2 #9 + jsr Error +lb3 jsr PutValue write an expression value + brl SkipExpression skip the expression + end diff --git a/pass2.mac b/pass2.mac old mode 100755 new mode 100644 index 6cb3eb0..78307f1 --- a/pass2.mac +++ b/pass2.mac @@ -1 +1,610 @@ - MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND MACRO &LAB MOVE &AD1,&AD2,&LEN &LAB ANOP LCLB &LA LCLB &LI LCLC &C AIF C:&LEN,.A1 LCLC &LEN &LEN SETC #2 .A1 &LA SETB S:LONGA &LI SETB S:LONGI AIF S:LONGA.AND.S:LONGI,.A REP #32*(.NOT.&LA)+16*(.NOT.&LI) LONGA ON LONGI ON .A &C AMID &LEN,1,1 AIF "&C"<>"#",.D &C AMID &LEN,2,L:&LEN-1 AIF &C<>2,.D &C AMID &AD1,1,1 AIF "&C"<>"{",.B &AD1 AMID &AD1,2,L:&AD1-2 &AD1 SETC (&AD1) .B LDA &AD1 &C AMID &AD2,1,1 AIF "&C"<>"{",.C &AD2 AMID &AD2,2,L:&AD2-2 &AD2 SETC (&AD2) .C STA &AD2 AGO .G .D &C AMID &AD1,1,1 AIF "&C"="#",.F &C AMID &LEN,1,1 AIF "&C"<>"{",.E &LEN AMID &LEN,2,L:&LEN-2 &LEN SETC (&LEN) .E &C AMID &LEN,1,1 AIF "&C"="#",.E1 LDA &LEN DEC A AGO .E2 .E1 LDA &LEN-1 .E2 LDX #&AD1 LDY #&AD2 MVN &AD1,&AD2 AGO .G .F LDA &AD1 STA &AD2 LDA &LEN-2 LDX #&AD2 LDY #&AD2+1 MVN &AD2,&AD2 .G AIF (&LA+&LI)=2,.I SEP #32*(.NOT.&LA)+16*(.NOT.&LI) AIF &LA,.H LONGA OFF .H AIF &LI,.I LONGI OFF .I MEND macro &l puts &n1,&f1,&cr,&errout &l ~setm lclc &c &c amid "&n1",1,1 aif "&c"<>"#",.c aif l:&n1>127,.a bra ~&SYSCNT ago .b .a brl ~&SYSCNT .b &n1 amid "&n1",2,l:&n1-1 ~l&SYSCNT dc i1"l:~s&SYSCNT" ~s&SYSCNT dc c&n1 ~&SYSCNT anop &n1 setc ~l&SYSCNT-1 .c ~pusha &n1 aif c:&f1,.c1 pea 0 ago .c2 .c1 ph2 &f1 .c2 ph2 #c:&cr ph2 #c:&errout jsl ~puts ~restm mend macro &l putc &n1,&f1,&cr,&errout lclc &f1 &f1 setc #0 .a &l ~setm ph2 &n1 aif c:&f1,.a pea 0 ago .b .a ph2 &f1 .b ph2 #c:&cr ph2 #c:&errout jsl ~putc ~restm mend macro &l putcr &errout &l ~setm pea $0D aif c:&errout,.a jsl SysCharOut ~restm mexit .a jsl SysCharErrout ~restm mend macro &l sub2 &n1,&n2,&n3 aif c:&n3,.a lclc &n3 &n3 setc &n1 .a &l ~setm sec ~lda &n1 ~op sbc,&n2 ~sta &n3 ~restm mend macro &l add4 &m1,&m2,&m3 lclb &yistwo lclc &c &l ~setm aif c:&m3,.a &c amid "&m2",1,1 aif "&c"<>"#",.a &c amid "&m1",1,1 aif "&c"="{",.a aif "&c"="[",.a &c amid "&m2",2,l:&m2-1 aif &c>=65536,.a clc ~lda &m1 ~op adc,&m2 ~sta &m1 bcc ~&SYSCNT ~op.h inc,&m1 ~&SYSCNT anop ago .c .a aif c:&m3,.b lclc &m3 &m3 setc &m1 .b clc ~lda &m1 ~op adc,&m2 ~sta &m3 ~lda.h &m1 ~op.h adc,&m2 ~sta.h &m3 .c ~restm mend macro &l sub4 &m1,&m2,&m3 lclb &yistwo lclc &c &l ~setm aif c:&m3,.a &c amid "&m2",1,1 aif "&c"<>"#",.a &c amid "&m1",1,1 aif "&c"="{",.a aif "&c"="[",.a &c amid "&m2",2,l:&m2-1 aif &c>=65536,.a sec ~lda &m1 ~op sbc,&m2 ~sta &m1 bcs ~&SYSCNT ~op.h dec,&m1 ~&SYSCNT anop ago .c .a aif c:&m3,.b lclc &m3 &m3 setc &m1 .b sec ~lda &m1 ~op sbc,&m2 ~sta &m3 ~lda.h &m1 ~op.h sbc,&m2 ~sta.h &m3 .c ~restm mend macro &l dec4 &a &l ~setm lda &a bne ~&SYSCNT dec 2+&a ~&SYSCNT dec &a ~restm mend macro &l inc4 &a &l ~setm inc &a bne ~&SYSCNT inc 2+&a ~&SYSCNT ~restm mend macro &l jeq &bp &l bne *+5 brl &bp mend macro &l long &a,&b lclb &i lclb &m &a amid &a,1,1 &m setb ("&a"="M").or.("&a"="m") &i setb ("&a"="I").or.("&a"="i") aif c:&b=0,.a &b amid &b,1,1 &m setb ("&b"="M").or.("&b"="m").or.&m &i setb ("&b"="I").or.("&b"="i").or.&i .a &l rep #&m*32+&i*16 aif .not.&m,.b longa on .b aif .not.&i,.c longi on .c mend macro &l ph2 &n1 &l anop aif "&n1"="*",.f lclc &c &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 lda (&n1) pha ago .e .b aif "&c"="<",.c lda &n1 pha ago .e .c &n1 amid &n1,2,l:&n1-1 pei &n1 ago .e .d &n1 amid &n1,2,l:&n1-1 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l ph4 &n1 &l anop aif "&n1"="*",.f lclc &c &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 ldy #2 lda (&n1),y pha lda (&n1) pha ago .e .b aif "&c"<>"[",.c ldy #2 lda &n1,y pha lda &n1 pha ago .e .c aif "&c"<>"<",.c1 &n1 amid &n1,2,l:&n1-1 pei &n1+2 pei &n1 ago .e .c1 lda &n1+2 pha lda &n1 pha ago .e .d &n1 amid &n1,2,l:&n1-1 pea +(&n1)|-16 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l pl4 &n1 lclc &c &l anop aif s:longa=1,.a rep #%00100000 .a &c amid &n1,1,1 aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.f &n1 amid &n1,2,l:&n1-2 pla sta (&n1) ldy #2 pla sta (&n1),y ago .d .b aif "&c"<>"[",.c pla sta &n1 ldy #2 pla sta &n1,y ago .d .c pla sta &n1 pla sta &n1+2 .d aif s:longa=1,.e sep #%00100000 .e mexit .f mnote "Missing closing '}'",16 mend macro &l short &a,&b lclb &i lclb &m &a amid &a,1,1 &m setb ("&a"="M").or.("&a"="m") &i setb ("&a"="I").or.("&a"="i") aif c:&b=0,.a &b amid &b,1,1 &m setb ("&b"="M").or.("&b"="m").or.&m &i setb ("&b"="I").or.("&b"="i").or.&i .a &l sep #&m*32+&i*16 aif .not.&m,.b longa off .b aif .not.&i,.c longi off .c mend macro &l ~lda &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l lda &op mend macro &l ~lda.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" lda &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" lda &op mexit .e lda 2+&op mend macro &l ~op &opc,&op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l &opc &op mend macro &l ~op.h &opc,&op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" &opc &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" &opc &op mexit .e &opc 2+&op mend macro &l ~pusha &n1 lclc &c &l anop &c amid &n1,1,1 aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 sep #$20 longa off lda #0 pha rep #$20 longa on phk lda &n1 pha mexit .b aif "&c"<>"[",.c &n1 amid &n1,2,l:&n1-2 lda &n1+2 pha lda &n1 pha mexit .c pea +(&n1)|-16 pea &n1 mexit .g mnote "Missing closing '}'",16 mend macro &l ~restm &l anop aif (&~la+&~li)=2,.i sep #32*(.not.&~la)+16*(.not.&~li) aif &~la,.h longa off .h aif &~li,.i longi off .i mend macro &l ~setm &l anop aif c:&~la,.b gblb &~la gblb &~li .b &~la setb s:longa &~li setb s:longi aif s:longa.and.s:longi,.a rep #32*(.not.&~la)+16*(.not.&~li) longa on longi on .a mend macro &l ~sta &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l sta &op mend macro &l ~sta.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" sta &op mexit .d sta 2+&op mend \ No newline at end of file + MACRO +&LAB MOVE4 &F,&T +&LAB ~SETM + LDA 2+&F + STA 2+&T + LDA &F + STA &T + ~RESTM + MEND + MACRO +&LAB MOVE &AD1,&AD2,&LEN +&LAB ANOP + LCLB &LA + LCLB &LI + LCLC &C + AIF C:&LEN,.A1 + LCLC &LEN +&LEN SETC #2 +.A1 +&LA SETB S:LONGA +&LI SETB S:LONGI + AIF S:LONGA.AND.S:LONGI,.A + REP #32*(.NOT.&LA)+16*(.NOT.&LI) + LONGA ON + LONGI ON +.A +&C AMID &LEN,1,1 + AIF "&C"<>"#",.D +&C AMID &LEN,2,L:&LEN-1 + AIF &C<>2,.D +&C AMID &AD1,1,1 + AIF "&C"<>"{",.B +&AD1 AMID &AD1,2,L:&AD1-2 +&AD1 SETC (&AD1) +.B + LDA &AD1 +&C AMID &AD2,1,1 + AIF "&C"<>"{",.C +&AD2 AMID &AD2,2,L:&AD2-2 +&AD2 SETC (&AD2) +.C + STA &AD2 + AGO .G +.D +&C AMID &AD1,1,1 + AIF "&C"="#",.F +&C AMID &LEN,1,1 + AIF "&C"<>"{",.E +&LEN AMID &LEN,2,L:&LEN-2 +&LEN SETC (&LEN) +.E +&C AMID &LEN,1,1 + AIF "&C"="#",.E1 + LDA &LEN + DEC A + AGO .E2 +.E1 + LDA &LEN-1 +.E2 + LDX #&AD1 + LDY #&AD2 + MVN &AD1,&AD2 + AGO .G +.F + LDA &AD1 + STA &AD2 + LDA &LEN-2 + LDX #&AD2 + LDY #&AD2+1 + MVN &AD2,&AD2 +.G + AIF (&LA+&LI)=2,.I + SEP #32*(.NOT.&LA)+16*(.NOT.&LI) + AIF &LA,.H + LONGA OFF +.H + AIF &LI,.I + LONGI OFF +.I + MEND + macro +&l puts &n1,&f1,&cr,&errout +&l ~setm + lclc &c +&c amid "&n1",1,1 + aif "&c"<>"#",.c + aif l:&n1>127,.a + bra ~&SYSCNT + ago .b +.a + brl ~&SYSCNT +.b +&n1 amid "&n1",2,l:&n1-1 +~l&SYSCNT dc i1"l:~s&SYSCNT" +~s&SYSCNT dc c&n1 +~&SYSCNT anop +&n1 setc ~l&SYSCNT-1 +.c + ~pusha &n1 + aif c:&f1,.c1 + pea 0 + ago .c2 +.c1 + ph2 &f1 +.c2 + ph2 #c:&cr + ph2 #c:&errout + jsl ~puts + ~restm + mend + macro +&l putc &n1,&f1,&cr,&errout + lclc &f1 +&f1 setc #0 +.a +&l ~setm + ph2 &n1 + aif c:&f1,.a + pea 0 + ago .b +.a + ph2 &f1 +.b + ph2 #c:&cr + ph2 #c:&errout + jsl ~putc + ~restm + mend + macro +&l putcr &errout +&l ~setm + pea $0D + aif c:&errout,.a + jsl SysCharOut + ~restm + mexit +.a + jsl SysCharErrout + ~restm + mend + macro +&l sub2 &n1,&n2,&n3 + aif c:&n3,.a + lclc &n3 +&n3 setc &n1 +.a +&l ~setm + sec + ~lda &n1 + ~op sbc,&n2 + ~sta &n3 + ~restm + mend + macro +&l add4 &m1,&m2,&m3 + lclb &yistwo + lclc &c +&l ~setm + aif c:&m3,.a +&c amid "&m2",1,1 + aif "&c"<>"#",.a +&c amid "&m1",1,1 + aif "&c"="{",.a + aif "&c"="[",.a +&c amid "&m2",2,l:&m2-1 + aif &c>=65536,.a + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m1 + bcc ~&SYSCNT + ~op.h inc,&m1 +~&SYSCNT anop + ago .c +.a + aif c:&m3,.b + lclc &m3 +&m3 setc &m1 +.b + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m3 + ~lda.h &m1 + ~op.h adc,&m2 + ~sta.h &m3 +.c + ~restm + mend + macro +&l sub4 &m1,&m2,&m3 + lclb &yistwo + lclc &c +&l ~setm + aif c:&m3,.a +&c amid "&m2",1,1 + aif "&c"<>"#",.a +&c amid "&m1",1,1 + aif "&c"="{",.a + aif "&c"="[",.a +&c amid "&m2",2,l:&m2-1 + aif &c>=65536,.a + sec + ~lda &m1 + ~op sbc,&m2 + ~sta &m1 + bcs ~&SYSCNT + ~op.h dec,&m1 +~&SYSCNT anop + ago .c +.a + aif c:&m3,.b + lclc &m3 +&m3 setc &m1 +.b + sec + ~lda &m1 + ~op sbc,&m2 + ~sta &m3 + ~lda.h &m1 + ~op.h sbc,&m2 + ~sta.h &m3 +.c + ~restm + mend + macro +&l dec4 &a +&l ~setm + lda &a + bne ~&SYSCNT + dec 2+&a +~&SYSCNT dec &a + ~restm + mend + macro +&l inc4 &a +&l ~setm + inc &a + bne ~&SYSCNT + inc 2+&a +~&SYSCNT ~restm + mend + macro +&l jeq &bp +&l bne *+5 + brl &bp + mend + macro +&l long &a,&b + lclb &i + lclb &m +&a amid &a,1,1 +&m setb ("&a"="M").or.("&a"="m") +&i setb ("&a"="I").or.("&a"="i") + aif c:&b=0,.a +&b amid &b,1,1 +&m setb ("&b"="M").or.("&b"="m").or.&m +&i setb ("&b"="I").or.("&b"="i").or.&i +.a +&l rep #&m*32+&i*16 + aif .not.&m,.b + longa on +.b + aif .not.&i,.c + longi on +.c + mend + macro +&l ph2 &n1 +&l anop + aif "&n1"="*",.f + lclc &c +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + lda (&n1) + pha + ago .e +.b + aif "&c"="<",.c + lda &n1 + pha + ago .e +.c +&n1 amid &n1,2,l:&n1-1 + pei &n1 + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l ph4 &n1 +&l anop + aif "&n1"="*",.f + lclc &c +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + ldy #2 + lda (&n1),y + pha + lda (&n1) + pha + ago .e +.b + aif "&c"<>"[",.c + ldy #2 + lda &n1,y + pha + lda &n1 + pha + ago .e +.c + aif "&c"<>"<",.c1 +&n1 amid &n1,2,l:&n1-1 + pei &n1+2 + pei &n1 + ago .e +.c1 + lda &n1+2 + pha + lda &n1 + pha + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea +(&n1)|-16 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l pl4 &n1 + lclc &c +&l anop + aif s:longa=1,.a + rep #%00100000 +.a +&c amid &n1,1,1 + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.f +&n1 amid &n1,2,l:&n1-2 + pla + sta (&n1) + ldy #2 + pla + sta (&n1),y + ago .d +.b + aif "&c"<>"[",.c + pla + sta &n1 + ldy #2 + pla + sta &n1,y + ago .d +.c + pla + sta &n1 + pla + sta &n1+2 +.d + aif s:longa=1,.e + sep #%00100000 +.e + mexit +.f + mnote "Missing closing '}'",16 + mend + macro +&l short &a,&b + lclb &i + lclb &m +&a amid &a,1,1 +&m setb ("&a"="M").or.("&a"="m") +&i setb ("&a"="I").or.("&a"="i") + aif c:&b=0,.a +&b amid &b,1,1 +&m setb ("&b"="M").or.("&b"="m").or.&m +&i setb ("&b"="I").or.("&b"="i").or.&i +.a +&l sep #&m*32+&i*16 + aif .not.&m,.b + longa off +.b + aif .not.&i,.c + longi off +.c + mend + macro +&l ~lda &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l lda &op + mend + macro +&l ~lda.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + lda &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + lda &op + mexit +.e + lda 2+&op + mend + macro +&l ~op &opc,&op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l &opc &op + mend + macro +&l ~op.h &opc,&op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + &opc &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + &opc &op + mexit +.e + &opc 2+&op + mend + macro +&l ~pusha &n1 + lclc &c +&l anop +&c amid &n1,1,1 + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + sep #$20 + longa off + lda #0 + pha + rep #$20 + longa on + phk + lda &n1 + pha + mexit +.b + aif "&c"<>"[",.c +&n1 amid &n1,2,l:&n1-2 + lda &n1+2 + pha + lda &n1 + pha + mexit +.c + pea +(&n1)|-16 + pea &n1 + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l ~restm +&l anop + aif (&~la+&~li)=2,.i + sep #32*(.not.&~la)+16*(.not.&~li) + aif &~la,.h + longa off +.h + aif &~li,.i + longi off +.i + mend + macro +&l ~setm +&l anop + aif c:&~la,.b + gblb &~la + gblb &~li +.b +&~la setb s:longa +&~li setb s:longi + aif s:longa.and.s:longi,.a + rep #32*(.not.&~la)+16*(.not.&~li) + longa on + longi on +.a + mend + macro +&l ~sta &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l sta &op + mend + macro +&l ~sta.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + sta &op + mexit +.d + sta 2+&op + mend diff --git a/seg.asm b/seg.asm old mode 100755 new mode 100644 index 584723b..0a43cd0 --- a/seg.asm +++ b/seg.asm @@ -1 +1,1105 @@ - keep obj/seg mcopy seg.mac **************************************************************** * * Segment Processing * * This module contains the subroutines used to find the next * segment that needs to be linked. * **************************************************************** copy directPage **************************************************************** * * SegCommon - global data for the segment module * **************************************************************** * SegCommon privdata ; ; Scalars ; inFile ds 2 are we processing a file? isLibrary ds 2 is the file we are processing a library file? largeLibFile ds 2 largest library file number libDisp ds 4 disp in library symbol table suffix ds 2 suffix letter end **************************************************************** * * CopyBasename - make a copy of the base name * * inputs: * basename - base keep name * * outputs: * fname - copy of basename * **************************************************************** * CopyBasename start using SegCommon ph4 fname free old buffer jsr Free lda [basename] get new buffer pea 0 inc A inc A pha jsr MLalloc sta fname stx fname+2 sta r4 copy basename to fname stx r6 move4 basename,r0 jsr MoveName rts end **************************************************************** * * Exists - see if a file exists * * Inputs: * fname - pointer to the file name * * Returns: * 1 if the file exists, else 0 * **************************************************************** * Exists private val equ 1 does the file exist? sub (4:fname),2 stz val assume the file does not exist move4 fname,giPathname if it does exist then OSGet_File_Info giRec bcs lb1 inc val ++val lb1 ret 2:val return val giRec dc i'2' giPathname ds 4 ds 2 end **************************************************************** * * ExistsM - see if a file exists in the memory list * * Inputs: * fname - pointer to the file name * memory - is this a +m link? * * Returns: * 1 if the file exists, else 0 * **************************************************************** * ExistsM private using Common val equ 1 does the file exist? sub (4:fname),2 ph4 fname (needed for both if and else branch) lda memory if this is a +m link then beq lb1 jsr ScanFastFile scan the FastFile list bra lb2 else lb1 jsr Exists check the disk lb2 sta val ret 2:val return val end **************************************************************** * * FileType - get the type of a file * * Inputs: * fname - pointer to the file name * * Returns: * file type (0 for none) * **************************************************************** * FileType private sub (4:fname),0 stz giFiletype assume the file does not exist move4 fname,giPathname if it does exist then OSGet_File_Info giRec ret 2:giFiletype return giFiletype giRec dc i'3' giPathname ds 4 ds 2 giFiletype ds 2 end **************************************************************** * * FindSuffix - find the highest keep suffix * * Inputs: * basename - base file name * * Outputs: * suffix - highest existing obj file suffix letter * **************************************************************** * FindSuffix private using SegCommon lda #'A' set the initial suffix sta lsuffix lb1 lda lsuffix try it out sta suffix jsr KeepName ph4 fname jsr ExistsM tax beq lb2 inc lsuffix it works, so try the next one bra lb1 lb2 lda lsuffix use the last one - it worked (or did dec A not exist, as in 'A'-1) sta suffix rts lsuffix ds 2 local suffix end **************************************************************** * * GetName - get the next file name * * Inputs: * sdisp - disp in the name list * slist - list of file names * * Outputs: * basename - new file name * C - set if a name was found, else clear * **************************************************************** * GetName start ph4 baseName Free(baseName) jsr Free stz baseName basename = NULL stz baseName+2 lda [slist] maxDisp = length(slist)+2 inc A inc A sta maxDisp ldy sdisp Y = sdisp+2 iny iny lb1 cpy maxDisp while (Y < maxDisp) blt lb1a clc rts lb1a lda [slist],Y and (slist[Y] = ' ') do and #$00FF cmp #' ' bne lb2 ++Y iny bra lb1 lb2 sty nDisp save the starting disp lb3 cpy maxDisp while (Y < maxDisp) bge lb4 lda [slist],Y and (slist[Y] <> ' ') do and #$00FF cmp #' ' beq lb4 iny ++Y bra lb3 lb4 sec A = Y-sDisp {length of the new string} tya sbc nDisp dey sdisp = Y-2 dey sty sdisp pha baseName = mlalloc(A+2) inc A inc A pea 0 pha jsr MLalloc sta baseName stx baseName+2 lda 1,S set the file name length sta [baseName] add4 slist,nDisp,r0 set r0 to the start of the name-2 sub4 r0,#2 plx move in the new characters ldy #2 short M lb5 lda [r0],Y sta [baseName],Y iny dex bne lb5 long M sec return found rts ; ; Local data area ; nDisp ds 4 disp in sname maxDisp ds 2 max allowed disp end **************************************************************** * * InitPass - initialize pass dependent variables * **************************************************************** * InitPass start using Common using SegCommon stz libIndex no libraries scanned stz sdisp no chars processed in the source list stz inFile not processing a file stz fileNumber no files processed, so far stz lastFileNumber stz dataNumber no data areas processed stz lastDataNumber rts end **************************************************************** * * KeepName - Update the Keep Name * * inputs: * basename - base keep name * suffix - suffix letter to use * * outputs: * fname - current keep file name * suffix - decremented * C - set if there is another dot name, else clear * **************************************************************** * KeepName private using SegCommon lda suffix if suffix = 'A'-1 then cmp #'A'-1 bne kn0 clc return false rts kn0 ph4 fname free old buffer jsr Free lda [basename] get new buffer clc adc #4 pea 0 pha jsr MLalloc sta fname stx fname+2 sta r4 copy basename to fname stx r6 move4 basename,r0 jsr MoveName lda [fname] append .suffix to the names inc A inc A sta [fname] tay short M kn1 lda #'.' sta [fname],Y iny lda suffix sta [fname],Y dec suffix --suffix long M sec rts end **************************************************************** * * MoveName - move a file name * * Inputs: * r0 - pointer to the name to move * r4 - pointer to the new file buffer * * Notes: * This subroutine assumes that the buffer is large * enough. * **************************************************************** * MoveName private lda [r0] inc A tay short M lb1 lda [r0],Y sta [r4],Y dey bpl lb1 long M rts end **************************************************************** * * NextFile - find the next file * * Inputs: * sdisp - disp in the file list * slist - file list * fname - pointer to the base file name * suffix - suffix letter for the next obj file * * Outputs: * C - set if a file was found, else clear * inFile - set to 1 * isLibrary - 1 for a library, 0 for an obj segment * fname - pointer to the base file name * suffix - suffix letter for the next obj file * **************************************************************** * NextFile start using Common using SegCommon ; ; If there are more files left in an obj sequence, process the next one. For ; example, if we just processed foo.root, we need to look for foo.a. ; lda inFile if inFile then beq lb1 inc lastFileNumber update the file number lda isLibrary if not isLibrary then bne lb0 jsr Purge mark the old file as purgeable stz inFile inFile = false jsr KeepName form the next file name bcc lb1 if exists(fname) then jsr Open open(fname) stz isLibrary isLibrary = false lda #1 inFile = true sta inFile sec return more files rts ; ; If the last file was a library file, close it ; lb0 clc update the file number lda lastFileNumber dec A adc largeLibFile sta lastFileNumber jsr CloseLibrary close the library file ; ; If the next file in the file list is a library, process it. ; lb1 jsr GetName if there are files left then jcc li1 ph4 basename get the next file jsr Exists tay beq lb2 ph4 basename if filetype = LIB then jsr FileType cmp #LIB bne lb2 lda #1 isLibrary = true sta isLibrary ! lda #1 inFile = true sta inFile stz largeLibFile no files processed lda lastFileNumber update the source file number sta fileNumber jsr CopyBasename make a copy of the file name jsr OpenLibrary open the library file jsr ReadLibraryHeader sec return more files rts ; ; Get the next file name from the list of file names specified on the ; command line. ; lb2 lda lastFileNumber update the source file number sta fileNumber jsr FindSuffix find the highest dot suffix jsr RootName form root file ph4 fname if exists(fname) then jsr ExistsM tay beq lb3 jsr Open open(fname) lda #1 inFile = true sta inFile stz isLibrary isLibrary = false sec return more files rts lb3 jsr KeepName form .a name bcc lb4 if exists(fname) then jsr Open open(fname) lda #1 inFile = true sta inFile stz isLibrary isLibrary = false sec return more files rts lb4 lda #1 TermError(1) jmp TermError ; ; Process a library file from the library directory. ; li1 jsr Unresolved see if we have unresolved references bcc nf1 lda libFromShell see if we are using a {Libraries} bne nf1 variable jsr GetLibFile find the next library file bcs li2 ph4 r0 none left -> free the buffer & quit jsr Free bra nf1 li2 ph4 baseName Free(baseName) jsr Free move4 r0,baseName basename = r0 jsr CopyBaseName make a copy of baseName lda #1 isLibrary = true sta isLibrary ! lda #1 inFile = true sta inFile stz largeLibFile no files processed lda lastFileNumber update the source file number sta fileNumber jsr OpenLibrary open the library file jsr ReadLibraryHeader sec rts ; ; There are no more files to process ; nf1 clc return no more files rts end **************************************************************** * * NextLibrarySeg - get the next library segment * * Inputs: * libSymbols - pointer to the symbol table * libLength - length of the symbol table * libNames - pointer to the names table * libDisp - disp of the next symbol to process * didLibSegment - did we process one, yet? * * Outputs: * C - set if a segment was found, else clear * **************************************************************** * NextLibrarySeg start using SegCommon using Common dicName equ 0 disp to the name displacement dicFile equ 4 disp to the file number dicPriv equ 6 disp to the private flag dicSeg equ 8 disp to the segment disp dicLength equ 12 length of one entry lb1 cmpl libLength,libDisp if we are at the end of the file then bne lb2 lda didLibSegment if we did not processed a segment then bne lb1a clc return false rts lb1a stz libDisp start the scan over stz libDisp+2 stz didLibSegment lb2 add4 libSymbols,libDisp,r0 get a pointer to the entry add4 libDisp,#dicLength skip to the next entry clc push the disp to the name ldy #2 lda libNames adc [r0] tax lda libNames+2 adc [r0],Y pha phx ldy #dicPriv push the private flag lda [r0],Y pha ldy #dicFile set the file number lda [r0],Y clc adc lastFileNumber sta fileNumber lda [r0],Y if file number > largest one so far then cmp largeLibFile blt lb3 sta largeLibFile update the largest library file lb3 jsr NeedSegment if we don't need this segment then tax beq lb1 go get the next one lda #1 note that we did one sta didLibSegment ldy #dicSeg read the segment lda [r0],Y tax iny iny lda [r0],Y sta r2 stx r0 jsr ReadLibrarySegment jsr ProcessHeader process the header sec return true rts end **************************************************************** * * NextObjSeg - get the next object segment * * Inputs: * seg - pointer to the first byte in the last segment * len - # bytes left in the file * segDisp - length of the last segment * * Outputs: * seg - pointer to the first byte in the new segment * len - # bytes left in the file * segLength - # of bytes of code in the segment * segDisp - length of the new segment, in bytes * sp - pointer to the first byte to process * segSpace - reserved space at the end of the segment * segType - segment type * segName - pointer to the segment name * segEntry - disp from start of segment for entry point * segAlign - segment alignment factor * startpc - pc at the start of the segment * **************************************************************** * NextObjSeg private using ExpCommon using Common vc0 sub4 len,segDisp update the # of bytes left add4 seg,segDisp move to the start of the next segment lda len if we are at the end of the file then ora len+2 bne vc1 clc return with no segment rts vc1 jsr ProcessHeader process the segment header cmpl len,segDisp make sure there are enough bytes in the bge vc2 file lda #4 jmp TermError vc2 stz expSegment make sure the segment has not already ph4 segName been included ph2 #0 jsr GetSymbolValue lda symbolData beq vc2a lda symbolFlag and #isSegmentFlag beq vc5 vc2a lda pass cmp #2 beq vc3 lda #pass1Resolved bra vc4 vc3 lda #pass2Resolved vc4 and symbolFlag bne vc6 vc5 sec rts ! handle a duplicate segment vc6 lda symbolFile if the segments are in the same file then cmp fileNumber beq vc0 skip this segment lda segType if this segment is private then and #$4000 bne vc5 process the segment lda pass if this is pass 1 then cmp #1 jeq vc0 don't flag the error ph4 segName ph2 #4 flag a duplicate segment error jsr Error brl vc0 end **************************************************************** * * NextSegment - find the next segment * * Outputs: * C - set if a segment was found, else clear * **************************************************************** * NextSegment start using SegCommon lda inFile if we are not processing a file then bne lb2 lb1 jsr NextFile get one bcc lb4 lb2 lda isLibrary if we are in a library then beq lb3 jsr NextLibrarySeg get the next library segment bcc lb1 if none, go to the next file bra lb4 else lb3 jsr NextObjSeg get the next obj segment bcc lb1 if none, go to the next file lb4 anop endif rts end **************************************************************** * * Open - open an object file and prepare it for input * * Inputs: * fname - file name * * Outputs: * seg - pointer to the first byte in the file * len - length of the file * segDisp - 0 * **************************************************************** * Open private using Common jsr Read open the file for input lda r8 make sure the file is an obj file cmp #OBJ beq lb1 lda #2 jmp TermError lb1 move4 r0,seg set the initial byte pointer move4 r4,len set the lengt of the file stz segDisp set the "previous" segment disp to 0 stz segDisp+2 rts end **************************************************************** * * ProcessHeader - process the header for the next code segment * * Inputs: * seg - pointer to the first byte in the segment * * Outputs: * segLength - # of bytes of code in the segment * segDisp - length of the new segment, in bytes * sp - pointer to the first byte to process * segSpace - reserved space at the end of the segment * segType - segment type * segName - pointer to the segment name * segEntry - disp from start of segment for entry point * segAlign - segment alignment factor * segBanksize - segment bank size * startpc - pc at the start of the segment * **************************************************************** * ProcessHeader private using Common using OutCommon resspc equ $04 disp to reserved space length equ $08 disp to code length lablen equ $0D disp to label length numlen equ $0E disp to number length version equ $0F disp to the segment version banksize equ $10 disp to bank size s0type equ $0C disp to segment type s0org equ $14 disp to org s0align equ $18 disp to alignment factor s0numsex equ $1C disp to the number type s1type equ $0C disp to segment type s1org equ $18 disp to org s1numsex equ $20 disp to the number type s1entry equ $24 disp to segment entry s1dispname equ $28 disp to the name displacement s1dispdata equ $2A disp to the data displacement s1align equ $1C disp to alignment factor s2type equ $14 disp to segment type s2org equ $18 disp to org s2numsex equ $20 disp to the number type s2entry equ $24 disp to segment entry s2dispname equ $28 disp to the name displacement s2dispdata equ $2A disp to the data displacement s2temporg equ $2C disp to temporg s2align equ $1C disp to alignment factor ; ; Do processing common to all segments ; ldy #resspc get the reserved space lda [seg],Y sta segSpace iny iny lda [seg],Y sta segSpace+2 ldy #length get the length of the code lda [seg],Y sta segLength iny iny lda [seg],Y sta segLength+2 ldy #banksize get the bank size lda [seg],Y sta segBanksize iny iny lda [seg],Y sta segBanksize+2 ldy #lablen make sure names are pstrings lda [seg],Y and #$00FF bne vc2 ldy #numlen make sure numbers are 4 bytes long lda [seg],Y and #$00FF cmp #4 beq vt0 vc2 lda #4 flag an illegal header value error jmp TermError ; ; Handle a version 2 header ; vt0 ldy #version get the segment version number lda [seg],Y and #$00FF sta segVersion cmp #2 branch if not version 2 jne vo1 ldy #2 get the length of the segment lda [seg] sta segDisp lda [seg],Y sta segDisp+2 ldy #s2type get the segment type lda [seg],Y sta segType ldy #s2org get the org lda [seg],Y sta segOrg iny iny lda [seg],Y sta segOrg+2 ldy #s2align get the alignment factor lda [seg],Y sta segAlign iny iny lda [seg],Y sta segAlign+2 ldy #s2entry get the entry disp lda [seg],Y sta segEntry iny iny lda [seg],Y sta segEntry+2 ldy #s2dispdata get the disp to the first op code byte lda [seg],Y clc adc seg sta sp lda seg+2 adc #0 sta sp+2 ldy #s2dispname get a pointer to the segment name lda [seg],Y and find the proper load segment clc adc seg sta segName lda seg+2 adc #0 sta segName+2 move4 segName,loadNamePtr add4 segName,#10 jsr FindLoadSegment ldy #s2numsex verify that numsex = 0 lda [seg],Y and #$00FF beq vt1 lda #4 jmp TermError vt1 lda pass if this is pass 2 then cmp #2 jne vf1 ldy #s2dispname skip check if disp to names < $30 lda [seg],Y cmp #$30 jlt vf1 ldy #s2temporg flag temporg errors lda [seg],Y iny iny ora [seg],Y jeq vf1 ph4 #0 ph2 #12 jsr Error brl vf1 ; ; Handle a version 1 header ; vo1 cmp #1 branch if not version 1 jne vz1 ldy #2 get the length of the segment lda [seg] sta segDisp+1 lda [seg],Y short M stz segDisp sta segDisp+3 long M asl segDisp rol segDisp+2 ldy #s1type get the segment type lda [seg],Y and #$00FF pha and #$001F sta segType pla xba and #$E000 ora segType sta segType ldy #s1org get the org lda [seg],Y sta segOrg iny iny lda [seg],Y sta segOrg+2 ldy #s1align get the alignment factor lda [seg],Y sta segAlign iny iny lda [seg],Y sta segAlign+2 ldy #s1entry get the entry disp lda [seg],Y sta segEntry iny iny lda [seg],Y sta segEntry+2 ldy #s1dispdata get the disp to the first op code byte lda [seg],Y clc adc seg sta sp lda seg+2 adc #0 sta sp+2 ldy #s1dispname get a pointer to the segment name lda [seg],Y and find the proper load segment clc adc seg sta segName lda seg+2 adc #0 sta segName+2 move4 segName,loadNamePtr add4 segName,#10 jsr FindLoadSegment ldy #s1numsex verify that numsex = 0 lda [seg],Y and #$00FF jeq vf1 lda #4 jmp TermError brl vf1 ; ; Handle a version 0 header ; vz1 cmp #0 branch if not version 0 jne ve1 ldy #2 get the length of the segment lda [seg] sta segDisp+1 lda [seg],Y short M stz segDisp sta segDisp+3 long M asl segDisp rol segDisp+2 ldy #s0type get the segment type lda [seg],Y and #$00FF pha and #$001F sta segType pla xba and #$E000 ora segType sta segType ldy #s0org get the org lda [seg],Y sta segOrg iny iny lda [seg],Y sta segOrg+2 ldy #s0align get the alignment factor lda [seg],Y sta segAlign iny iny lda [seg],Y sta segAlign+2 stz segEntry get the entry disp stz segEntry+2 add4 seg,#$24,segName get a pointer to the segment name move4 segName,r0 get the disp to the first op code byte lda [r0] and #$00FF sec adc segName sta sp lda segName+2 adc #0 sta sp+2 ldy #s0numsex verify that numsex = 0 lda [seg],Y and #$00FF beq vz2 lda #4 jmp TermError vz2 lla loadNamePtr,blankSeg find the proper load segment jsr FindLoadSegment bra vf1 ; ; Segment version error ; ve1 lda #3 jmp TermError ; ; Do common end processing ; vf1 stz dataNumber data area number is 0 for code files lda segType if this is a data area then and #$00FF cmp #1 bne vf2 inc lastDataNumber assign a data area number lda lastDataNumber sta dataNumber vf2 move4 pc,startpc record the pc sec rts ; ; Local data ; blankSeg dc 10c' ' default load segment name end **************************************************************** * * RootName - Append .ROOT to file name * * inputs: * basename - base file name * * outputs: * ckname - current keep file name * tkname - .ROOT appended to contents of kname * kltr - suffix letter for the main obj file * **************************************************************** * RootName private using SegCommon ph4 fname free old buffer jsr Free lda [basename] get new buffer clc adc #2+l:root pea 0 pha jsr MLalloc sta fname stx fname+2 sta r4 copy basename to fname stx r6 move4 basename,r0 jsr MoveName lda [fname] append root to the name tay clc adc #l:root sta [fname] iny iny ldx #0 short M kn1 lda root,X sta [fname],Y iny inx cpx #l:root bne kn1 long M rts root dc c'.ROOT' end \ No newline at end of file + keep obj/seg + mcopy seg.mac +**************************************************************** +* +* Segment Processing +* +* This module contains the subroutines used to find the next +* segment that needs to be linked. +* +**************************************************************** + copy directPage +**************************************************************** +* +* SegCommon - global data for the segment module +* +**************************************************************** +* +SegCommon privdata +; +; Scalars +; +inFile ds 2 are we processing a file? +isLibrary ds 2 is the file we are processing a library file? +largeLibFile ds 2 largest library file number +libDisp ds 4 disp in library symbol table +suffix ds 2 suffix letter + end + +**************************************************************** +* +* CopyBasename - make a copy of the base name +* +* inputs: +* basename - base keep name +* +* outputs: +* fname - copy of basename +* +**************************************************************** +* +CopyBasename start + using SegCommon + + ph4 fname free old buffer + jsr Free + lda [basename] get new buffer + pea 0 + inc A + inc A + pha + jsr MLalloc + sta fname + stx fname+2 + sta r4 copy basename to fname + stx r6 + move4 basename,r0 + jsr MoveName + rts + end + +**************************************************************** +* +* Exists - see if a file exists +* +* Inputs: +* fname - pointer to the file name +* +* Returns: +* 1 if the file exists, else 0 +* +**************************************************************** +* +Exists private +val equ 1 does the file exist? + + sub (4:fname),2 + + stz val assume the file does not exist + move4 fname,giPathname if it does exist then + OSGet_File_Info giRec + bcs lb1 + inc val ++val + +lb1 ret 2:val return val + +giRec dc i'2' +giPathname ds 4 + ds 2 + end + +**************************************************************** +* +* ExistsM - see if a file exists in the memory list +* +* Inputs: +* fname - pointer to the file name +* memory - is this a +m link? +* +* Returns: +* 1 if the file exists, else 0 +* +**************************************************************** +* +ExistsM private + using Common +val equ 1 does the file exist? + + sub (4:fname),2 + + ph4 fname (needed for both if and else branch) + lda memory if this is a +m link then + beq lb1 + jsr ScanFastFile scan the FastFile list + bra lb2 else +lb1 jsr Exists check the disk +lb2 sta val + + ret 2:val return val + end + +**************************************************************** +* +* FileType - get the type of a file +* +* Inputs: +* fname - pointer to the file name +* +* Returns: +* file type (0 for none) +* +**************************************************************** +* +FileType private + + sub (4:fname),0 + + stz giFiletype assume the file does not exist + move4 fname,giPathname if it does exist then + OSGet_File_Info giRec + + ret 2:giFiletype return giFiletype + +giRec dc i'3' +giPathname ds 4 + ds 2 +giFiletype ds 2 + end + +**************************************************************** +* +* FindSuffix - find the highest keep suffix +* +* Inputs: +* basename - base file name +* +* Outputs: +* suffix - highest existing obj file suffix letter +* +**************************************************************** +* +FindSuffix private + using SegCommon + + lda #'A' set the initial suffix + sta lsuffix +lb1 lda lsuffix try it out + sta suffix + jsr KeepName + ph4 fname + jsr ExistsM + tax + beq lb2 + inc lsuffix it works, so try the next one + bra lb1 + +lb2 lda lsuffix use the last one - it worked (or did + dec A not exist, as in 'A'-1) + sta suffix + rts + +lsuffix ds 2 local suffix + end + +**************************************************************** +* +* GetName - get the next file name +* +* Inputs: +* sdisp - disp in the name list +* slist - list of file names +* +* Outputs: +* basename - new file name +* C - set if a name was found, else clear +* +**************************************************************** +* +GetName start + + ph4 baseName Free(baseName) + jsr Free + stz baseName basename = NULL + stz baseName+2 + + lda [slist] maxDisp = length(slist)+2 + inc A + inc A + sta maxDisp + ldy sdisp Y = sdisp+2 + iny + iny +lb1 cpy maxDisp while (Y < maxDisp) + blt lb1a + clc + rts +lb1a lda [slist],Y and (slist[Y] = ' ') do + and #$00FF + cmp #' ' + bne lb2 ++Y + iny + bra lb1 + +lb2 sty nDisp save the starting disp +lb3 cpy maxDisp while (Y < maxDisp) + bge lb4 + lda [slist],Y and (slist[Y] <> ' ') do + and #$00FF + cmp #' ' + beq lb4 + iny ++Y + bra lb3 +lb4 sec A = Y-sDisp {length of the new string} + tya + sbc nDisp + dey sdisp = Y-2 + dey + sty sdisp + pha baseName = mlalloc(A+2) + inc A + inc A + pea 0 + pha + jsr MLalloc + sta baseName + stx baseName+2 + + lda 1,S set the file name length + sta [baseName] + add4 slist,nDisp,r0 set r0 to the start of the name-2 + sub4 r0,#2 + plx move in the new characters + ldy #2 + short M +lb5 lda [r0],Y + sta [baseName],Y + iny + dex + bne lb5 + long M + sec return found + rts +; +; Local data area +; +nDisp ds 4 disp in sname +maxDisp ds 2 max allowed disp + end + +**************************************************************** +* +* InitPass - initialize pass dependent variables +* +**************************************************************** +* +InitPass start + using Common + using SegCommon + + stz libIndex no libraries scanned + stz sdisp no chars processed in the source list + stz inFile not processing a file + stz fileNumber no files processed, so far + stz lastFileNumber + stz dataNumber no data areas processed + stz lastDataNumber + rts + end + +**************************************************************** +* +* KeepName - Update the Keep Name +* +* inputs: +* basename - base keep name +* suffix - suffix letter to use +* +* outputs: +* fname - current keep file name +* suffix - decremented +* C - set if there is another dot name, else clear +* +**************************************************************** +* +KeepName private + using SegCommon + + lda suffix if suffix = 'A'-1 then + cmp #'A'-1 + bne kn0 + clc return false + rts + +kn0 ph4 fname free old buffer + jsr Free + lda [basename] get new buffer + clc + adc #4 + pea 0 + pha + jsr MLalloc + sta fname + stx fname+2 + sta r4 copy basename to fname + stx r6 + move4 basename,r0 + jsr MoveName + + lda [fname] append .suffix to the names + inc A + inc A + sta [fname] + tay + short M +kn1 lda #'.' + sta [fname],Y + iny + lda suffix + sta [fname],Y + dec suffix --suffix + long M + sec + rts + end + +**************************************************************** +* +* MoveName - move a file name +* +* Inputs: +* r0 - pointer to the name to move +* r4 - pointer to the new file buffer +* +* Notes: +* This subroutine assumes that the buffer is large +* enough. +* +**************************************************************** +* +MoveName private + + lda [r0] + inc A + tay + short M +lb1 lda [r0],Y + sta [r4],Y + dey + bpl lb1 + long M + rts + end + +**************************************************************** +* +* NextFile - find the next file +* +* Inputs: +* sdisp - disp in the file list +* slist - file list +* fname - pointer to the base file name +* suffix - suffix letter for the next obj file +* +* Outputs: +* C - set if a file was found, else clear +* inFile - set to 1 +* isLibrary - 1 for a library, 0 for an obj segment +* fname - pointer to the base file name +* suffix - suffix letter for the next obj file +* +**************************************************************** +* +NextFile start + using Common + using SegCommon +; +; If there are more files left in an obj sequence, process the next one. For +; example, if we just processed foo.root, we need to look for foo.a. +; + lda inFile if inFile then + beq lb1 + inc lastFileNumber update the file number + lda isLibrary if not isLibrary then + bne lb0 + jsr Purge mark the old file as purgeable + stz inFile inFile = false + jsr KeepName form the next file name + bcc lb1 if exists(fname) then + jsr Open open(fname) + stz isLibrary isLibrary = false + lda #1 inFile = true + sta inFile + sec return more files + rts +; +; If the last file was a library file, close it +; +lb0 clc update the file number + lda lastFileNumber + dec A + adc largeLibFile + sta lastFileNumber + jsr CloseLibrary close the library file +; +; If the next file in the file list is a library, process it. +; +lb1 jsr GetName if there are files left then + jcc li1 + ph4 basename get the next file + jsr Exists + tay + beq lb2 + ph4 basename if filetype = LIB then + jsr FileType + cmp #LIB + bne lb2 + lda #1 isLibrary = true + sta isLibrary +! lda #1 inFile = true + sta inFile + stz largeLibFile no files processed + lda lastFileNumber update the source file number + sta fileNumber + jsr CopyBasename make a copy of the file name + jsr OpenLibrary open the library file + jsr ReadLibraryHeader + sec return more files + rts +; +; Get the next file name from the list of file names specified on the +; command line. +; +lb2 lda lastFileNumber update the source file number + sta fileNumber + jsr FindSuffix find the highest dot suffix + jsr RootName form root file + ph4 fname if exists(fname) then + jsr ExistsM + tay + beq lb3 + jsr Open open(fname) + lda #1 inFile = true + sta inFile + stz isLibrary isLibrary = false + sec return more files + rts +lb3 jsr KeepName form .a name + bcc lb4 if exists(fname) then + jsr Open open(fname) + lda #1 inFile = true + sta inFile + stz isLibrary isLibrary = false + sec return more files + rts +lb4 lda #1 TermError(1) + jmp TermError +; +; Process a library file from the library directory. +; +li1 jsr Unresolved see if we have unresolved references + bcc nf1 + lda libFromShell see if we are using a {Libraries} + bne nf1 variable + jsr GetLibFile find the next library file + bcs li2 + ph4 r0 none left -> free the buffer & quit + jsr Free + bra nf1 + +li2 ph4 baseName Free(baseName) + jsr Free + move4 r0,baseName basename = r0 + jsr CopyBaseName make a copy of baseName + lda #1 isLibrary = true + sta isLibrary +! lda #1 inFile = true + sta inFile + stz largeLibFile no files processed + lda lastFileNumber update the source file number + sta fileNumber + jsr OpenLibrary open the library file + jsr ReadLibraryHeader + sec + rts +; +; There are no more files to process +; +nf1 clc return no more files + rts + end + +**************************************************************** +* +* NextLibrarySeg - get the next library segment +* +* Inputs: +* libSymbols - pointer to the symbol table +* libLength - length of the symbol table +* libNames - pointer to the names table +* libDisp - disp of the next symbol to process +* didLibSegment - did we process one, yet? +* +* Outputs: +* C - set if a segment was found, else clear +* +**************************************************************** +* +NextLibrarySeg start + using SegCommon + using Common +dicName equ 0 disp to the name displacement +dicFile equ 4 disp to the file number +dicPriv equ 6 disp to the private flag +dicSeg equ 8 disp to the segment disp +dicLength equ 12 length of one entry + +lb1 cmpl libLength,libDisp if we are at the end of the file then + bne lb2 + lda didLibSegment if we did not processed a segment then + bne lb1a + clc return false + rts +lb1a stz libDisp start the scan over + stz libDisp+2 + stz didLibSegment +lb2 add4 libSymbols,libDisp,r0 get a pointer to the entry + add4 libDisp,#dicLength skip to the next entry + clc push the disp to the name + ldy #2 + lda libNames + adc [r0] + tax + lda libNames+2 + adc [r0],Y + pha + phx + ldy #dicPriv push the private flag + lda [r0],Y + pha + + ldy #dicFile set the file number + lda [r0],Y + clc + adc lastFileNumber + sta fileNumber + lda [r0],Y if file number > largest one so far then + cmp largeLibFile + blt lb3 + sta largeLibFile update the largest library file + +lb3 jsr NeedSegment if we don't need this segment then + tax + beq lb1 go get the next one + + lda #1 note that we did one + sta didLibSegment + ldy #dicSeg read the segment + lda [r0],Y + tax + iny + iny + lda [r0],Y + sta r2 + stx r0 + jsr ReadLibrarySegment + jsr ProcessHeader process the header + sec return true + rts + end + +**************************************************************** +* +* NextObjSeg - get the next object segment +* +* Inputs: +* seg - pointer to the first byte in the last segment +* len - # bytes left in the file +* segDisp - length of the last segment +* +* Outputs: +* seg - pointer to the first byte in the new segment +* len - # bytes left in the file +* segLength - # of bytes of code in the segment +* segDisp - length of the new segment, in bytes +* sp - pointer to the first byte to process +* segSpace - reserved space at the end of the segment +* segType - segment type +* segName - pointer to the segment name +* segEntry - disp from start of segment for entry point +* segAlign - segment alignment factor +* startpc - pc at the start of the segment +* +**************************************************************** +* +NextObjSeg private + using ExpCommon + using Common + +vc0 sub4 len,segDisp update the # of bytes left + add4 seg,segDisp move to the start of the next segment + lda len if we are at the end of the file then + ora len+2 + bne vc1 + clc return with no segment + rts + +vc1 jsr ProcessHeader process the segment header + cmpl len,segDisp make sure there are enough bytes in the + bge vc2 file + lda #4 + jmp TermError +vc2 stz expSegment make sure the segment has not already + ph4 segName been included + ph2 #0 + jsr GetSymbolValue + lda symbolData + beq vc2a + lda symbolFlag + and #isSegmentFlag + beq vc5 +vc2a lda pass + cmp #2 + beq vc3 + lda #pass1Resolved + bra vc4 +vc3 lda #pass2Resolved +vc4 and symbolFlag + bne vc6 +vc5 sec + rts + +! handle a duplicate segment +vc6 lda symbolFile if the segments are in the same file then + cmp fileNumber + beq vc0 skip this segment + lda segType if this segment is private then + and #$4000 + bne vc5 process the segment + lda pass if this is pass 1 then + cmp #1 + jeq vc0 don't flag the error + ph4 segName + ph2 #4 flag a duplicate segment error + jsr Error + brl vc0 + end + +**************************************************************** +* +* NextSegment - find the next segment +* +* Outputs: +* C - set if a segment was found, else clear +* +**************************************************************** +* +NextSegment start + using SegCommon + + lda inFile if we are not processing a file then + bne lb2 +lb1 jsr NextFile get one + bcc lb4 +lb2 lda isLibrary if we are in a library then + beq lb3 + jsr NextLibrarySeg get the next library segment + bcc lb1 if none, go to the next file + bra lb4 else +lb3 jsr NextObjSeg get the next obj segment + bcc lb1 if none, go to the next file +lb4 anop endif + rts + end + +**************************************************************** +* +* Open - open an object file and prepare it for input +* +* Inputs: +* fname - file name +* +* Outputs: +* seg - pointer to the first byte in the file +* len - length of the file +* segDisp - 0 +* +**************************************************************** +* +Open private + using Common + + jsr Read open the file for input + lda r8 make sure the file is an obj file + cmp #OBJ + beq lb1 + lda #2 + jmp TermError +lb1 move4 r0,seg set the initial byte pointer + move4 r4,len set the lengt of the file + stz segDisp set the "previous" segment disp to 0 + stz segDisp+2 + rts + end + +**************************************************************** +* +* ProcessHeader - process the header for the next code segment +* +* Inputs: +* seg - pointer to the first byte in the segment +* +* Outputs: +* segLength - # of bytes of code in the segment +* segDisp - length of the new segment, in bytes +* sp - pointer to the first byte to process +* segSpace - reserved space at the end of the segment +* segType - segment type +* segName - pointer to the segment name +* segEntry - disp from start of segment for entry point +* segAlign - segment alignment factor +* segBanksize - segment bank size +* startpc - pc at the start of the segment +* +**************************************************************** +* +ProcessHeader private + using Common + using OutCommon +resspc equ $04 disp to reserved space +length equ $08 disp to code length +lablen equ $0D disp to label length +numlen equ $0E disp to number length +version equ $0F disp to the segment version +banksize equ $10 disp to bank size + +s0type equ $0C disp to segment type +s0org equ $14 disp to org +s0align equ $18 disp to alignment factor +s0numsex equ $1C disp to the number type + +s1type equ $0C disp to segment type +s1org equ $18 disp to org +s1numsex equ $20 disp to the number type +s1entry equ $24 disp to segment entry +s1dispname equ $28 disp to the name displacement +s1dispdata equ $2A disp to the data displacement +s1align equ $1C disp to alignment factor + +s2type equ $14 disp to segment type +s2org equ $18 disp to org +s2numsex equ $20 disp to the number type +s2entry equ $24 disp to segment entry +s2dispname equ $28 disp to the name displacement +s2dispdata equ $2A disp to the data displacement +s2temporg equ $2C disp to temporg +s2align equ $1C disp to alignment factor +; +; Do processing common to all segments +; + ldy #resspc get the reserved space + lda [seg],Y + sta segSpace + iny + iny + lda [seg],Y + sta segSpace+2 + ldy #length get the length of the code + lda [seg],Y + sta segLength + iny + iny + lda [seg],Y + sta segLength+2 + ldy #banksize get the bank size + lda [seg],Y + sta segBanksize + iny + iny + lda [seg],Y + sta segBanksize+2 + ldy #lablen make sure names are pstrings + lda [seg],Y + and #$00FF + bne vc2 + ldy #numlen make sure numbers are 4 bytes long + lda [seg],Y + and #$00FF + cmp #4 + beq vt0 +vc2 lda #4 flag an illegal header value error + jmp TermError +; +; Handle a version 2 header +; +vt0 ldy #version get the segment version number + lda [seg],Y + and #$00FF + sta segVersion + cmp #2 branch if not version 2 + jne vo1 + + ldy #2 get the length of the segment + lda [seg] + sta segDisp + lda [seg],Y + sta segDisp+2 + ldy #s2type get the segment type + lda [seg],Y + sta segType + ldy #s2org get the org + lda [seg],Y + sta segOrg + iny + iny + lda [seg],Y + sta segOrg+2 + ldy #s2align get the alignment factor + lda [seg],Y + sta segAlign + iny + iny + lda [seg],Y + sta segAlign+2 + ldy #s2entry get the entry disp + lda [seg],Y + sta segEntry + iny + iny + lda [seg],Y + sta segEntry+2 + ldy #s2dispdata get the disp to the first op code byte + lda [seg],Y + clc + adc seg + sta sp + lda seg+2 + adc #0 + sta sp+2 + ldy #s2dispname get a pointer to the segment name + lda [seg],Y and find the proper load segment + clc + adc seg + sta segName + lda seg+2 + adc #0 + sta segName+2 + move4 segName,loadNamePtr + add4 segName,#10 + jsr FindLoadSegment + ldy #s2numsex verify that numsex = 0 + lda [seg],Y + and #$00FF + beq vt1 + lda #4 + jmp TermError +vt1 lda pass if this is pass 2 then + cmp #2 + jne vf1 + ldy #s2dispname skip check if disp to names < $30 + lda [seg],Y + cmp #$30 + jlt vf1 + ldy #s2temporg flag temporg errors + lda [seg],Y + iny + iny + ora [seg],Y + jeq vf1 + ph4 #0 + ph2 #12 + jsr Error + brl vf1 +; +; Handle a version 1 header +; +vo1 cmp #1 branch if not version 1 + jne vz1 + + ldy #2 get the length of the segment + lda [seg] + sta segDisp+1 + lda [seg],Y + short M + stz segDisp + sta segDisp+3 + long M + asl segDisp + rol segDisp+2 + ldy #s1type get the segment type + lda [seg],Y + and #$00FF + pha + and #$001F + sta segType + pla + xba + and #$E000 + ora segType + sta segType + ldy #s1org get the org + lda [seg],Y + sta segOrg + iny + iny + lda [seg],Y + sta segOrg+2 + ldy #s1align get the alignment factor + lda [seg],Y + sta segAlign + iny + iny + lda [seg],Y + sta segAlign+2 + ldy #s1entry get the entry disp + lda [seg],Y + sta segEntry + iny + iny + lda [seg],Y + sta segEntry+2 + ldy #s1dispdata get the disp to the first op code byte + lda [seg],Y + clc + adc seg + sta sp + lda seg+2 + adc #0 + sta sp+2 + ldy #s1dispname get a pointer to the segment name + lda [seg],Y and find the proper load segment + clc + adc seg + sta segName + lda seg+2 + adc #0 + sta segName+2 + move4 segName,loadNamePtr + add4 segName,#10 + jsr FindLoadSegment + ldy #s1numsex verify that numsex = 0 + lda [seg],Y + and #$00FF + jeq vf1 + lda #4 + jmp TermError + brl vf1 +; +; Handle a version 0 header +; +vz1 cmp #0 branch if not version 0 + jne ve1 + + ldy #2 get the length of the segment + lda [seg] + sta segDisp+1 + lda [seg],Y + short M + stz segDisp + sta segDisp+3 + long M + asl segDisp + rol segDisp+2 + ldy #s0type get the segment type + lda [seg],Y + and #$00FF + pha + and #$001F + sta segType + pla + xba + and #$E000 + ora segType + sta segType + ldy #s0org get the org + lda [seg],Y + sta segOrg + iny + iny + lda [seg],Y + sta segOrg+2 + ldy #s0align get the alignment factor + lda [seg],Y + sta segAlign + iny + iny + lda [seg],Y + sta segAlign+2 + stz segEntry get the entry disp + stz segEntry+2 + add4 seg,#$24,segName get a pointer to the segment name + move4 segName,r0 get the disp to the first op code byte + lda [r0] + and #$00FF + sec + adc segName + sta sp + lda segName+2 + adc #0 + sta sp+2 + ldy #s0numsex verify that numsex = 0 + lda [seg],Y + and #$00FF + beq vz2 + lda #4 + jmp TermError + +vz2 lla loadNamePtr,blankSeg find the proper load segment + jsr FindLoadSegment + bra vf1 +; +; Segment version error +; +ve1 lda #3 + jmp TermError +; +; Do common end processing +; +vf1 stz dataNumber data area number is 0 for code files + lda segType if this is a data area then + and #$00FF + cmp #1 + bne vf2 + inc lastDataNumber assign a data area number + lda lastDataNumber + sta dataNumber +vf2 move4 pc,startpc record the pc + sec + rts +; +; Local data +; +blankSeg dc 10c' ' default load segment name + end + +**************************************************************** +* +* RootName - Append .ROOT to file name +* +* inputs: +* basename - base file name +* +* outputs: +* ckname - current keep file name +* tkname - .ROOT appended to contents of kname +* kltr - suffix letter for the main obj file +* +**************************************************************** +* +RootName private + using SegCommon + + ph4 fname free old buffer + jsr Free + lda [basename] get new buffer + clc + adc #2+l:root + pea 0 + pha + jsr MLalloc + sta fname + stx fname+2 + sta r4 copy basename to fname + stx r6 + move4 basename,r0 + jsr MoveName + + lda [fname] append root to the name + tay + clc + adc #l:root + sta [fname] + iny + iny + ldx #0 + short M +kn1 lda root,X + sta [fname],Y + iny + inx + cpx #l:root + bne kn1 + long M + rts + +root dc c'.ROOT' + end diff --git a/seg.mac b/seg.mac old mode 100755 new mode 100644 index 40534b2..59fa011 --- a/seg.mac +++ b/seg.mac @@ -1 +1,524 @@ - macro &lab cmpl &n1,&n2 &lab lda 2+&n1 cmp 2+&n2 bne ~&syscnt lda &n1 cmp &n2 ~&syscnt anop mend MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND macro &lab sub &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta c:&parms .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+3+&work &totallen seta &totallen+&len &i seta &i-1 aif &i,^b .e tsc aif &work=0,.f sec sbc #&work tcs .f phd tcd mend macro &lab ret &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g ldy #&r ldx #^&r ago .h .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+1 sta &worklen+&totallen+1 .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rts mend macro &l add4 &m1,&m2,&m3 lclb &yistwo lclc &c &l ~setm aif c:&m3,.a &c amid "&m2",1,1 aif "&c"<>"#",.a &c amid "&m1",1,1 aif "&c"="{",.a aif "&c"="[",.a &c amid "&m2",2,l:&m2-1 aif &c>=65536,.a clc ~lda &m1 ~op adc,&m2 ~sta &m1 bcc ~&SYSCNT ~op.h inc,&m1 ~&SYSCNT anop ago .c .a aif c:&m3,.b lclc &m3 &m3 setc &m1 .b clc ~lda &m1 ~op adc,&m2 ~sta &m3 ~lda.h &m1 ~op.h adc,&m2 ~sta.h &m3 .c ~restm mend macro &l sub4 &m1,&m2,&m3 lclb &yistwo lclc &c &l ~setm aif c:&m3,.a &c amid "&m2",1,1 aif "&c"<>"#",.a &c amid "&m1",1,1 aif "&c"="{",.a aif "&c"="[",.a &c amid "&m2",2,l:&m2-1 aif &c>=65536,.a sec ~lda &m1 ~op sbc,&m2 ~sta &m1 bcs ~&SYSCNT ~op.h dec,&m1 ~&SYSCNT anop ago .c .a aif c:&m3,.b lclc &m3 &m3 setc &m1 .b sec ~lda &m1 ~op sbc,&m2 ~sta &m3 ~lda.h &m1 ~op.h sbc,&m2 ~sta.h &m3 .c ~restm mend macro &l jcc &bp &l bcs *+5 brl &bp mend macro &l jeq &bp &l bne *+5 brl &bp mend macro &l jlt &bp &l bge *+5 brl &bp mend macro &l jne &bp &l beq *+5 brl &bp mend macro &l lla &ad1,&ad2 &l anop lcla &lb lclb &la aif s:longa,.a rep #%00100000 longa on &la setb 1 .a lda #&ad2 &lb seta c:&ad1 .b sta &ad1(&lb) &lb seta &lb-1 aif &lb,^b lda #^&ad2 &lb seta c:&ad1 .c sta 2+&ad1(&lb) &lb seta &lb-1 aif &lb,^c aif &la=0,.d sep #%00100000 longa off .d mend macro &l long &a,&b lclb &i lclb &m &a amid &a,1,1 &m setb ("&a"="M").or.("&a"="m") &i setb ("&a"="I").or.("&a"="i") aif c:&b=0,.a &b amid &b,1,1 &m setb ("&b"="M").or.("&b"="m").or.&m &i setb ("&b"="I").or.("&b"="i").or.&i .a &l rep #&m*32+&i*16 aif .not.&m,.b longa on .b aif .not.&i,.c longi on .c mend macro &l ph2 &n1 &l anop aif "&n1"="*",.f lclc &c &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 lda (&n1) pha ago .e .b aif "&c"="<",.c lda &n1 pha ago .e .c &n1 amid &n1,2,l:&n1-1 pei &n1 ago .e .d &n1 amid &n1,2,l:&n1-1 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l ph4 &n1 &l anop aif "&n1"="*",.f lclc &c &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 ldy #2 lda (&n1),y pha lda (&n1) pha ago .e .b aif "&c"<>"[",.c ldy #2 lda &n1,y pha lda &n1 pha ago .e .c aif "&c"<>"<",.c1 &n1 amid &n1,2,l:&n1-1 pei &n1+2 pei &n1 ago .e .c1 lda &n1+2 pha lda &n1 pha ago .e .d &n1 amid &n1,2,l:&n1-1 pea +(&n1)|-16 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l short &a,&b lclb &i lclb &m &a amid &a,1,1 &m setb ("&a"="M").or.("&a"="m") &i setb ("&a"="I").or.("&a"="i") aif c:&b=0,.a &b amid &b,1,1 &m setb ("&b"="M").or.("&b"="m").or.&m &i setb ("&b"="I").or.("&b"="i").or.&i .a &l sep #&m*32+&i*16 aif .not.&m,.b longa off .b aif .not.&i,.c longi off .c mend macro &l ~lda &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l lda &op mend macro &l ~lda.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" lda &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" lda &op mexit .e lda 2+&op mend macro &l ~op &opc,&op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l &opc &op mend macro &l ~op.h &opc,&op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" &opc &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" &opc &op mexit .e &opc 2+&op mend macro &l ~restm &l anop aif (&~la+&~li)=2,.i sep #32*(.not.&~la)+16*(.not.&~li) aif &~la,.h longa off .h aif &~li,.i longi off .i mend macro &l ~setm &l anop aif c:&~la,.b gblb &~la gblb &~li .b &~la setb s:longa &~li setb s:longi aif s:longa.and.s:longi,.a rep #32*(.not.&~la)+16*(.not.&~li) longa on longi on .a mend macro &l ~sta &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l sta &op mend macro &l ~sta.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" sta &op mexit .d sta 2+&op mend macro &l osget_file_info &p &l jsl $E100A8 dc i2'$2006' dc i4'&p' mend \ No newline at end of file + macro +&lab cmpl &n1,&n2 +&lab lda 2+&n1 + cmp 2+&n2 + bne ~&syscnt + lda &n1 + cmp &n2 +~&syscnt anop + mend + MACRO +&LAB MOVE4 &F,&T +&LAB ~SETM + LDA 2+&F + STA 2+&T + LDA &F + STA &T + ~RESTM + MEND + macro +&lab sub &parms,&work +&lab anop + aif c:&work,.a + lclc &work +&work setc 0 +.a + gbla &totallen + gbla &worklen +&worklen seta &work +&totallen seta 0 + aif c:&parms=0,.e + lclc &len + lclc &p + lcla &i +&i seta c:&parms +.b +&p setc &parms(&i) +&len amid &p,2,1 + aif "&len"=":",.c +&len amid &p,1,2 +&p amid &p,4,l:&p-3 + ago .d +.c +&len amid &p,1,1 +&p amid &p,3,l:&p-2 +.d +&p equ &totallen+3+&work +&totallen seta &totallen+&len +&i seta &i-1 + aif &i,^b +.e + tsc + aif &work=0,.f + sec + sbc #&work + tcs +.f + phd + tcd + mend + macro +&lab ret &r +&lab anop + lclc &len + aif c:&r,.a + lclc &r +&r setc 0 +&len setc 0 + ago .h +.a +&len amid &r,2,1 + aif "&len"=":",.b +&len amid &r,1,2 +&r amid &r,4,l:&r-3 + ago .c +.b +&len amid &r,1,1 +&r amid &r,3,l:&r-2 +.c + aif &len<>2,.d + ldy &r + ago .h +.d + aif &len<>4,.e + ldx &r+2 + ldy &r + ago .h +.e + aif &len<>10,.g + ldy #&r + ldx #^&r + ago .h +.g + mnote 'Not a valid return length',16 + mexit +.h + aif &totallen=0,.i + lda &worklen+1 + sta &worklen+&totallen+1 +.i + pld + tsc + clc + adc #&worklen+&totallen + tcs + aif &len=0,.j + tya +.j + rts + mend + macro +&l add4 &m1,&m2,&m3 + lclb &yistwo + lclc &c +&l ~setm + aif c:&m3,.a +&c amid "&m2",1,1 + aif "&c"<>"#",.a +&c amid "&m1",1,1 + aif "&c"="{",.a + aif "&c"="[",.a +&c amid "&m2",2,l:&m2-1 + aif &c>=65536,.a + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m1 + bcc ~&SYSCNT + ~op.h inc,&m1 +~&SYSCNT anop + ago .c +.a + aif c:&m3,.b + lclc &m3 +&m3 setc &m1 +.b + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m3 + ~lda.h &m1 + ~op.h adc,&m2 + ~sta.h &m3 +.c + ~restm + mend + macro +&l sub4 &m1,&m2,&m3 + lclb &yistwo + lclc &c +&l ~setm + aif c:&m3,.a +&c amid "&m2",1,1 + aif "&c"<>"#",.a +&c amid "&m1",1,1 + aif "&c"="{",.a + aif "&c"="[",.a +&c amid "&m2",2,l:&m2-1 + aif &c>=65536,.a + sec + ~lda &m1 + ~op sbc,&m2 + ~sta &m1 + bcs ~&SYSCNT + ~op.h dec,&m1 +~&SYSCNT anop + ago .c +.a + aif c:&m3,.b + lclc &m3 +&m3 setc &m1 +.b + sec + ~lda &m1 + ~op sbc,&m2 + ~sta &m3 + ~lda.h &m1 + ~op.h sbc,&m2 + ~sta.h &m3 +.c + ~restm + mend + macro +&l jcc &bp +&l bcs *+5 + brl &bp + mend + macro +&l jeq &bp +&l bne *+5 + brl &bp + mend + macro +&l jlt &bp +&l bge *+5 + brl &bp + mend + macro +&l jne &bp +&l beq *+5 + brl &bp + mend + macro +&l lla &ad1,&ad2 +&l anop + lcla &lb + lclb &la + aif s:longa,.a + rep #%00100000 + longa on +&la setb 1 +.a + lda #&ad2 +&lb seta c:&ad1 +.b + sta &ad1(&lb) +&lb seta &lb-1 + aif &lb,^b + lda #^&ad2 +&lb seta c:&ad1 +.c + sta 2+&ad1(&lb) +&lb seta &lb-1 + aif &lb,^c + aif &la=0,.d + sep #%00100000 + longa off +.d + mend + macro +&l long &a,&b + lclb &i + lclb &m +&a amid &a,1,1 +&m setb ("&a"="M").or.("&a"="m") +&i setb ("&a"="I").or.("&a"="i") + aif c:&b=0,.a +&b amid &b,1,1 +&m setb ("&b"="M").or.("&b"="m").or.&m +&i setb ("&b"="I").or.("&b"="i").or.&i +.a +&l rep #&m*32+&i*16 + aif .not.&m,.b + longa on +.b + aif .not.&i,.c + longi on +.c + mend + macro +&l ph2 &n1 +&l anop + aif "&n1"="*",.f + lclc &c +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + lda (&n1) + pha + ago .e +.b + aif "&c"="<",.c + lda &n1 + pha + ago .e +.c +&n1 amid &n1,2,l:&n1-1 + pei &n1 + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l ph4 &n1 +&l anop + aif "&n1"="*",.f + lclc &c +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + ldy #2 + lda (&n1),y + pha + lda (&n1) + pha + ago .e +.b + aif "&c"<>"[",.c + ldy #2 + lda &n1,y + pha + lda &n1 + pha + ago .e +.c + aif "&c"<>"<",.c1 +&n1 amid &n1,2,l:&n1-1 + pei &n1+2 + pei &n1 + ago .e +.c1 + lda &n1+2 + pha + lda &n1 + pha + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea +(&n1)|-16 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l short &a,&b + lclb &i + lclb &m +&a amid &a,1,1 +&m setb ("&a"="M").or.("&a"="m") +&i setb ("&a"="I").or.("&a"="i") + aif c:&b=0,.a +&b amid &b,1,1 +&m setb ("&b"="M").or.("&b"="m").or.&m +&i setb ("&b"="I").or.("&b"="i").or.&i +.a +&l sep #&m*32+&i*16 + aif .not.&m,.b + longa off +.b + aif .not.&i,.c + longi off +.c + mend + macro +&l ~lda &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l lda &op + mend + macro +&l ~lda.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + lda &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + lda &op + mexit +.e + lda 2+&op + mend + macro +&l ~op &opc,&op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l &opc &op + mend + macro +&l ~op.h &opc,&op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + &opc &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + &opc &op + mexit +.e + &opc 2+&op + mend + macro +&l ~restm +&l anop + aif (&~la+&~li)=2,.i + sep #32*(.not.&~la)+16*(.not.&~li) + aif &~la,.h + longa off +.h + aif &~li,.i + longi off +.i + mend + macro +&l ~setm +&l anop + aif c:&~la,.b + gblb &~la + gblb &~li +.b +&~la setb s:longa +&~li setb s:longi + aif s:longa.and.s:longi,.a + rep #32*(.not.&~la)+16*(.not.&~li) + longa on + longi on +.a + mend + macro +&l ~sta &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l sta &op + mend + macro +&l ~sta.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + sta &op + mexit +.d + sta 2+&op + mend + macro +&l osget_file_info &p +&l jsl $E100A8 + dc i2'$2006' + dc i4'&p' + mend diff --git a/smac b/smac old mode 100755 new mode 100644 index 73fea56..61f9c8d --- a/smac +++ b/smac @@ -1 +1,202 @@ - macro &lab da &op &lab dc a3"&op" dc i1'0' mend macro &lab cmpl &n1,&n2 &lab lda 2+&n1 cmp 2+&n2 bne ~&syscnt lda &n1 cmp &n2 ~&syscnt anop mend MACRO &LAB DOS &ADR &LAB DC I"L:~&SYSNAME&SYSCNT" ~&SYSNAME&SYSCNT DC C"&ADR" MEND MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND macro &lab sub &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta c:&parms .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+3+&work &totallen seta &totallen+&len &i seta &i-1 aif &i,^b .e tsc aif &work=0,.f sec sbc #&work tcs .f phd tcd mend macro &lab ret &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g ldy #&r ldx #^&r ago .h .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+1 sta &worklen+&totallen+1 .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rts mend MACRO &LAB MOVE &AD1,&AD2,&LEN &LAB ANOP LCLB &LA LCLB &LI LCLC &C AIF C:&LEN,.A1 LCLC &LEN &LEN SETC #2 .A1 &LA SETB S:LONGA &LI SETB S:LONGI AIF S:LONGA.AND.S:LONGI,.A REP #32*(.NOT.&LA)+16*(.NOT.&LI) LONGA ON LONGI ON .A &C AMID &LEN,1,1 AIF "&C"<>"#",.D &C AMID &LEN,2,L:&LEN-1 AIF &C<>2,.D &C AMID &AD1,1,1 AIF "&C"<>"{",.B &AD1 AMID &AD1,2,L:&AD1-2 &AD1 SETC (&AD1) .B LDA &AD1 &C AMID &AD2,1,1 AIF "&C"<>"{",.C &AD2 AMID &AD2,2,L:&AD2-2 &AD2 SETC (&AD2) .C STA &AD2 AGO .G .D &C AMID &AD1,1,1 AIF "&C"="#",.F &C AMID &LEN,1,1 AIF "&C"<>"{",.E &LEN AMID &LEN,2,L:&LEN-2 &LEN SETC (&LEN) .E &C AMID &LEN,1,1 AIF "&C"="#",.E1 LDA &LEN DEC A AGO .E2 .E1 LDA &LEN-1 .E2 LDX #&AD1 LDY #&AD2 MVN &AD1,&AD2 AGO .G .F LDA &AD1 STA &AD2 LDA &LEN-2 LDX #&AD2 LDY #&AD2+1 MVN &AD2,&AD2 .G AIF (&LA+&LI)=2,.I SEP #32*(.NOT.&LA)+16*(.NOT.&LI) AIF &LA,.H LONGA OFF .H AIF &LI,.I LONGI OFF .I MEND \ No newline at end of file + macro +&lab da &op +&lab dc a3"&op" + dc i1'0' + mend + + + macro +&lab cmpl &n1,&n2 +&lab lda 2+&n1 + cmp 2+&n2 + bne ~&syscnt + lda &n1 + cmp &n2 +~&syscnt anop + mend + + + MACRO +&LAB DOS &ADR +&LAB DC I"L:~&SYSNAME&SYSCNT" +~&SYSNAME&SYSCNT DC C"&ADR" + MEND + + + MACRO +&LAB MOVE4 &F,&T +&LAB ~SETM + LDA 2+&F + STA 2+&T + LDA &F + STA &T + ~RESTM + MEND + + + macro +&lab sub &parms,&work +&lab anop + aif c:&work,.a + lclc &work +&work setc 0 +.a + gbla &totallen + gbla &worklen +&worklen seta &work +&totallen seta 0 + aif c:&parms=0,.e + lclc &len + lclc &p + lcla &i +&i seta c:&parms +.b +&p setc &parms(&i) +&len amid &p,2,1 + aif "&len"=":",.c +&len amid &p,1,2 +&p amid &p,4,l:&p-3 + ago .d +.c +&len amid &p,1,1 +&p amid &p,3,l:&p-2 +.d +&p equ &totallen+3+&work +&totallen seta &totallen+&len +&i seta &i-1 + aif &i,^b +.e + tsc + aif &work=0,.f + sec + sbc #&work + tcs +.f + phd + tcd + mend + + + macro +&lab ret &r +&lab anop + lclc &len + aif c:&r,.a + lclc &r +&r setc 0 +&len setc 0 + ago .h +.a +&len amid &r,2,1 + aif "&len"=":",.b +&len amid &r,1,2 +&r amid &r,4,l:&r-3 + ago .c +.b +&len amid &r,1,1 +&r amid &r,3,l:&r-2 +.c + aif &len<>2,.d + ldy &r + ago .h +.d + aif &len<>4,.e + ldx &r+2 + ldy &r + ago .h +.e + aif &len<>10,.g + ldy #&r + ldx #^&r + ago .h +.g + mnote 'Not a valid return length',16 + mexit +.h + aif &totallen=0,.i + lda &worklen+1 + sta &worklen+&totallen+1 +.i + pld + tsc + clc + adc #&worklen+&totallen + tcs + aif &len=0,.j + tya +.j + rts + mend + + + MACRO +&LAB MOVE &AD1,&AD2,&LEN +&LAB ANOP + LCLB &LA + LCLB &LI + LCLC &C + AIF C:&LEN,.A1 + LCLC &LEN +&LEN SETC #2 +.A1 +&LA SETB S:LONGA +&LI SETB S:LONGI + AIF S:LONGA.AND.S:LONGI,.A + REP #32*(.NOT.&LA)+16*(.NOT.&LI) + LONGA ON + LONGI ON +.A +&C AMID &LEN,1,1 + AIF "&C"<>"#",.D +&C AMID &LEN,2,L:&LEN-1 + AIF &C<>2,.D +&C AMID &AD1,1,1 + AIF "&C"<>"{",.B +&AD1 AMID &AD1,2,L:&AD1-2 +&AD1 SETC (&AD1) +.B + LDA &AD1 +&C AMID &AD2,1,1 + AIF "&C"<>"{",.C +&AD2 AMID &AD2,2,L:&AD2-2 +&AD2 SETC (&AD2) +.C + STA &AD2 + AGO .G +.D +&C AMID &AD1,1,1 + AIF "&C"="#",.F +&C AMID &LEN,1,1 + AIF "&C"<>"{",.E +&LEN AMID &LEN,2,L:&LEN-2 +&LEN SETC (&LEN) +.E +&C AMID &LEN,1,1 + AIF "&C"="#",.E1 + LDA &LEN + DEC A + AGO .E2 +.E1 + LDA &LEN-1 +.E2 + LDX #&AD1 + LDY #&AD2 + MVN &AD1,&AD2 + AGO .G +.F + LDA &AD1 + STA &AD2 + LDA &LEN-2 + LDX #&AD2 + LDY #&AD2+1 + MVN &AD2,&AD2 +.G + AIF (&LA+&LI)=2,.I + SEP #32*(.NOT.&LA)+16*(.NOT.&LI) + AIF &LA,.H + LONGA OFF +.H + AIF &LI,.I + LONGI OFF +.I + MEND diff --git a/symbol.asm b/symbol.asm old mode 100755 new mode 100644 index ccd7586..765281a --- a/symbol.asm +++ b/symbol.asm @@ -1 +1,1605 @@ - keep obj/symbol mcopy symbol.mac **************************************************************** * * Symbol Tables * * This module contains the subroutines used to create, search * and manipulate the symbol table. * **************************************************************** copy directPage **************************************************************** * * SymbolCommon - global data for the symbol table module * **************************************************************** * SymbolCommon privdata ; ; Symbol table entry ; symNext equ 0 pointer to the next symbol symAlpha equ 4 alphabetized list pointer symVal equ 8 value of the label (or ptr to expression) symSeg equ 12 segment number symFile equ 14 file number symData equ 16 data area number symExp equ 18 is the value an expression? symFlag equ 20 pass 1/2 resolved flags symPriv equ 22 is the symbol private? symLength equ 24 length attribute symType equ 26 type attribute symName equ 28 symbol name (p-string) symSize equ 28 size of a symbol, sans symbol name ; ; Constants ; hashSize equ 877 number of hash buckets blockSize equ 4096 symbol table blocking factor ; ; Symbol table variables ; alpha ds 4 head of alphabetized list hashDisp ds 2 disp in hash table; saved for efficiency poolPtr ds 4 ptr to next byte in symbol table pool poolSize ds 2 # of bytes left in the current pool table ds hashSize*4 symbol table end **************************************************************** * * AllocatePool - allocate a new symbol table pool * * Outputs: * poolPtr - pointer to the first byte of the pool * poolSize - size of the block, in bytes * **************************************************************** * AllocatePool private using SymbolCommon ph4 #blockSize jsr MLalloc sta poolPtr stx poolPtr+2 lda #blockSize sta poolSize rts end **************************************************************** * * AlphaInsert - insert the symbol in the alphabetized list * * Inputs: * sym - pointer to the new symbol * alpha - head of the alphabetized list * **************************************************************** * AlphaInsert private using SymbolCommon p1 equ 1 work pointers p2 equ 5 p3 equ 9 sub (4:sym),12 lda alpha if alpha = nil then ora alpha+2 bne lb1 move4 sym,alpha alpha = sym ldy #symAlpha sym^.alpha = nil lda #0 sta [sym],Y iny iny sta [sym],Y brl lb8 return lb1 move4 alpha,p1 p1 = alpha stz p2 p2 = nil stz p2+2 add4 sym,#symName while sym^.symName >= p1^.symName do lda [sym] and #$00FF sta len1 lb2 add4 p1,#symName,p3 lda len1 sta lens lda [p3] and #$00FF sta len2 cmp lens bge lb3 sta lens lb3 short M ldy #1 lb4 lda [sym],Y cmp [p3],Y bne lb5 iny dec lens bne lb4 lda len1 cmp len2 lb5 long M blt lb6 move4 p1,p2 p2 = p1 ldy #symAlpha p1 = p2^.symAlpha lda [p2],Y sta p1 iny iny lda [p2],Y sta p1+2 ora p1 quit if at the end of the list bne lb2 endwhile lb6 sub4 sym,#symName fix sym ldy #symAlpha sym^.symAlpha = p1 lda p1 sta [sym],Y iny iny lda p1+2 sta [sym],Y lda p2 if p2 = nil then ora p2+2 bne lb7 move4 sym,alpha alpha = sym bra lb8 return lb7 ldy #symAlpha p2^.symAlpha = sym lda sym sta [p2],Y iny iny lda sym+2 sta [p2],Y lb8 ret ; ; Local data ; lens ds 2 shortest string length len1 ds 2 length(sym^.symName) len2 ds 2 length(p1^.symName) end **************************************************************** * * CreateSymbol - create a new symbol table entry * * Inputs: * name - name of the new entry * hashDisp - disp in hash table for the entry * * Outputs: * returns a pointer to the new symbol table entry * **************************************************************** * CreateSymbol private using Common using OutCommon using SymbolCommon entryLength equ 1 length of the symbol table entry sym equ 3 ptr to symbol table entry p1 equ 7 work pointer sub (4:name),10 lda [name] no match - create a symbol table entry and #$00FF sec adc #symSize sta entryLength cmp poolSize ble cs2 jsr AllocatePool no room - get a new pool cs2 sub2 poolSize,entryLength subtract the space we need clc update the pool pointer and get a copy lda poolPtr sta sym adc entryLength sta poolPtr lda poolPtr+2 sta sym+2 adc #0 sta poolPtr+2 ldx hashDisp place the record in the hash list ldy #2 lda table,X sta [sym] lda table+2,X sta [sym],Y lda sym sta table,X lda sym+2 sta table+2,X ldy #symSeg record our load segment number lda loadNumber sta [sym],Y ldy #symFile record our file number lda fileNumber sta [sym],Y ldy #symFlag the value is not resolved lda #0 sta [sym],Y ldy #symPriv the symbol is not private sta [sym],Y add4 sym,#symName,p1 record the symbol name lda [name] and #$00FF tay short M cs3 lda [name],Y sta [p1],Y dey bpl cs3 long M lda symbols if the symbol table will be printed then beq cs4 ph4 sym insert in alphabetical list jsr AlphaInsert cs4 ret 4:sym end **************************************************************** * * Define - define a symbol * * Inputs: * name - ptr to the symbol name * length - length attribute * type - type attribute * private - is the symbol private? * global - is the symbol global? (or local) * expression - is the value an expression? (or a constant) * value - symbol value, or pointer to the expression * isData - is the symbol a data area name? * isSegment - is the symbol a segment name? * **************************************************************** * Define start using Common using SymbolCommon using ExpCommon using OutCommon sym equ 1 pointer to symbol table entry sub (4:name,2:length,2:type,2:private,2:global,2:expression,4:value,2:isData,2:isSegment),4 lda global if the symbol is local then bne fs1 lda dataNumber if dataNumber = 0 then jeq lb2 return {don't define the symbol!} ! {get a symbol to define} fs1 ph4 name if ((sym = FindSymbol(name)) != NULL) { jsr FindSymbol sta sym stx sym+2 ora sym beq fs5 ldy #symFile if (sym->symFile == fileNumber) lda [sym],Y cmp fileNumber beq fs6 goto fs6; fs2 ldy #symFile while (sym->symFile != fileNumber) { lda [sym],Y cmp fileNumber beq fs4 fs3 ldy #2 sym = sym->symNext; lda [sym] tax lda [sym],Y sta sym+2 stx sym ora sym if (sym == NULL) beq fs5 goto fs5; bra fs2 } fs4 clc if (!Match(& sym->symName,name)) { lda sym adc #symName tax lda sym+2 adc #^symName pha phx ph4 name jsr Match tax beq fs6 bra fs3 sym = sym->symNext; ! if (sym == NULL) ! goto fs5; ! goto fs2; ! } ! } bra fs6 else fs5 ph4 name sym = CreateSymbol(name); jsr CreateSymbol sta sym stx sym+2 fs6 anop lda expression if the value is an expression then beq ex1 ph4 value copy the expression jsr CopyExpression ldy #symVal sta [sym],Y ldy #symVal+2 txa sta [sym],Y ldy #symExp set the expression flag lda copiedExpression sta [sym],Y bne ex2 if a constant was returned then ldy #symFlag set the constant flag lda #isConstant ora [sym],Y sta [sym],Y bra ex2 else ex1 ldy #symVal save the symbol value lda value sta [sym],Y ldy #symVal+2 lda value+2 sta [sym],Y ldy #symExp clear expression flag lda #0 sta [sym],Y ex2 anop endif ldy #symLength set the length attribute lda length sta [sym],Y ldy #symType set the type attribute lda type sta [sym],Y ldy #symPriv set the private flag lda private sta [sym],Y ldy #symData set the data area number lda dataNumber ldx global beq ex3 ldx isData bne ex3 lda #0 ex3 sta [sym],Y ldy #symFile set the file number lda fileNumber sta [sym],Y ldy #symSeg set the load segment number lda loadNumber sta [sym],Y ldy #symFlag set the "resolved on pass 1" flag lda [sym],Y ora #pass1Resolved+pass1Requested sta [sym],Y lda isData if isData then beq lb2 ! ldy #symFlag set the data area flag lda [sym],Y ora #isDataArea sta [sym],Y lb2 lda isSegment if isSegment then beq lb3 ! ldy #symFlag set the segment flag lda [sym],Y ora #isSegmentFlag sta [sym],Y lb3 ret end **************************************************************** * * Define2 - note that the symbol is resolved on pass 2 * * Inputs: * name - ptr to the symbol name * global - is the symbol global? * value - value, or 0 if the value does not need to be checked * **************************************************************** * Define2 start using Common using SymbolCommon sym equ 1 pointer to symbol table entry p1 equ 5 copy of sym; used for duplicate check sub (4:name,2:global,4:value),8 lda global if the symbol is local then bne lb1 lda dataNumber if dataNumber = 0 then jeq lb10 return {don't define the symbol!} ! /* find the correct symbol */ lb1 ph4 name sym = FindSymbol(name); jsr FindSymbol p1 = sym; sta sym sta p1 stx sym+2 stx p1+2 ldy #symFile if (sym->symFile != fileNumber) { lda [sym],Y cmp fileNumber beq lb5 lb2 ldy #symFile while (sym->symFile != fileNumber) lda [sym],Y cmp fileNumber beq lb4 lb3 ldy #2 sym = sym->symNext; lda [sym],Y tax lda [sym] sta sym stx sym+2 bra lb2 lb4 clc if (!Match(& sym->symName,name) { lda sym adc #symName tax lda sym+2 adc #^symName pha phx ph4 name jsr Match tax bne lb3 ! sym = sym->symNext; ! goto lb2; ! } ! } ! /* check for duplicates in this file */ lb5 ldy #symFlag if (sym->symFlag & pass2Resolved) lda [sym],Y and #pass2Resolved bne lb7 ! Error(DUPLICATE_SYMBOL); ! /* check for duplicate globals in */ ! /* two different files */ ldy #symPriv else if ((global) && (!sym^.symPriv)){ lda [sym],Y bne lb9 lb6 lda p1 while (p1 != NULL) { ora p1+2 beq lb9 cmpl p1,sym if (p1 != sym) beq lb8 clc if (Match(p1->symName,name)) lda p1 adc #symName tax lda p1+2 adc #^symName pha phx ph4 name jsr Match tax bne lb8 ldy #symPriv if (!p1->symPriv) { lda [p1],Y bne lb8 ldy #symFlag if (p1->symFlag & pass2Resolved) lda [p1],Y and #pass2Resolved beq lb8 lb7 ph4 name Error(DUPLICATE_SYMBOL); ph2 #1 jsr Error bra lb9 goto lb9; ! } lb8 ldy #2 p1 = p1->symNext; lda [p1],Y tax lda [p1] sta p1 stx p1+2 bra lb6 } ! } lb9 anop ldy #symFlag set the "resolved on pass 2" flag lda [sym],Y ora #pass2Resolved+pass2Requested sta [sym],Y ldy #symExp if the symbol is an expression then lda [sym],Y beq lb9a ldy #symVal+2 make sure all needed symbols are lda [sym],Y available ; and #$FF00 debug ; beq db1 debug ; brk $33 debug ;b1 lda [sym],Y debug pha dey dey lda [sym],Y pha jsr Evaluate lb9a lda value if value <> 0 then ora value+2 beq lb10 ldy #symVal if value <> sym^.symVal then lda [sym],Y cmp value bne lb9b iny iny lda [sym],Y cmp value+2 beq lb10 lb9b ph4 name addressing error ph2 #7 jsr Error lb10 ret end **************************************************************** * * FindFirstSymbol - find the alphabetically smallest symbol * * Inputs: * r12 - head of the symbol table * * Outputs: * r0 - pointer to the first symbol * r12 - pointer to the remaining symbols * C - set if a symbol was found, else clear * * Notes: * Only symbols resolved on pass 2 are returned. * **************************************************************** * FindFirstSymbol private using Common using SymbolCommon lb0 lda r12 if r12 = nil then ora r14 bne lb1 return false clc rts lb1 move4 r12,r0 r0 = r12 ldy #symAlpha r12 = r0^.symAlpha lda [r0],Y sta r12 iny iny lda [r0],Y sta r14 ldy #symFlag if the symbol was not resolved then lda [r0],Y and #pass2Resolved beq lb0 skip this one sec return true rts end **************************************************************** * * FindSymbol - find a symbol * * Inputs: * name - pointer to the symbol name * * Outputs: * A-X - address of the symbol table entry; nil for none * hashDisp - hash table displacement * * Notes: * There may be several symbols with the same name. In * that case, this subroutine returns the first one in * the hash bucked. You can scan forward from sym^.next * to find the others. * **************************************************************** * FindSymbol private using SymbolCommon sym equ 1 symbol table pointer sub (4:name),4 ph4 name get the address of the proper hash bucket jsr Hash sta hashDisp tax lda table,X sta sym lda table+2,X sta sym+2 ora sym branch if it is empty beq lb2 lb1 clc if the names match then lda sym adc #symName tax lda sym+2 adc #0 pha phx ph4 name jsr Match tax beq lb2 return ldy #2 next symbol lda [sym],Y tax lda [sym] sta sym stx sym+2 ora sym+2 bne lb1 lb2 ret 4:sym end **************************************************************** * * GetSymbolMemory - get memory from the symbol table pool * * Inputs: * size - number of bytes to reserve * * Outputs: * returns a pointer to the memory * **************************************************************** * GetSymbolMemory start using SymbolCommon ptr equ 1 pointer to the memory sub (2:size),4 lda size if there isn't enough room then cmp poolSize ble lb2 cmp #blockSize if the request is bigger than blt lb1 blockSize then pea 0 get the memory from MLalloc pha jsr MLAlloc sta ptr stx ptr+2 bra lb3 return lb1 jsr AllocatePool no room - get a new pool lb2 sub2 poolSize,size subtract the space we need clc update the pool pointer and get a copy lda poolPtr sta ptr adc size sta poolPtr lda poolPtr+2 sta ptr+2 adc #0 sta poolPtr+2 lb3 ret 4:ptr end **************************************************************** * * GetSymbolValue - get the value of a symbol; for Evaluate only! * * Inputs: * name - name of the symbol * strong - strong reference? (or weak) * fileNumber - current file number * expSegment - segment for the current expression * * Outputs: * symbolValue - symbol value * symbolRelocatable - is the symbol relocatable? * symbolLength - length attribute * symbolCount - count attribute * symbolType - type attribute * symbolFlag - symbol flags * symbolData - data area number * **************************************************************** * GetSymbolValue start using Common using OutCommon using SymbolCommon using ExpCommon sym equ 1 pointer to the symbol p1 equ 5 work pointer sub (4:name,2:strong),8 ; ; Find the symbol in the hash table ; ph4 name find the symbol jsr FindSymbol sta sym sta p1 stx sym+2 stx p1+2 ora p1+2 beq nosym ; ; Find the private version of the symbol. Use it if it is resolved. ; ldy #symFile if p1^.symFile <> fileNumber then lda [p1],Y cmp fileNumber beq lb4 lb1 ldy #symFile while p1^.symFile <> fileNumber do lda [p1],Y cmp fileNumber beq lb3 lb2 ldy #2 p1 := p1^.next; lda [p1],Y tax lda [p1] sta p1 stx p1+2 ora p1+2 beq gb1 bra lb1 lb3 clc if not Match(p1^.symName,name) then lda #symName adc p1 tax lda #^symName adc p1+2 pha phx ph4 name jsr Match tax bne lb2 p1 := p1^.next; ! goto 1; ! endif lb4 anop endif ldy #symFlag if the private symbol is resolved then lda [p1],Y and #pass1Resolved beq gb1 move4 p1,sym use it bra sv1 ; ; Find the global version of the symbol. ; gb1 ldy #symFlag while not (sym^.symFlag & pass1Resolved) do lda [sym],Y and #pass1Resolved bne gb3 gb2 ldy #2 sym := sym^.next; lda [sym],Y tax lda [sym] sta sym stx sym+2 ora sym+2 if sym = nil then bne gb1 nosym stz symbolValue symbolValue = 0 stz symbolValue+2 stz symbolRelocatable symbolRelocatable = false stz symbolLength symbolLength = 0 stz symbolCount symbolCount = 0 stz symbolType symbolType = 0 stz symbolFlag symbolFlag = 0 stz symbolData symbolData = 0 stz symbolFile symbolFile = 0 lda strong if the reference is strong then jeq rt1 ph4 name flag the error ph2 #6 jsr Error brl rt1 return gb3 ldy #symPriv if sym^.symPriv then lda [sym],Y bne gb2 sym := sym^.next; ! goto 1; ! endif clc if not Match(sym^.symName,name) then lda #symName adc sym tax lda #^symName adc sym+2 pha phx ph4 name jsr Match tax bne gb2 sym := sym^.next; ! goto 1; ! endif ! endif ; ; Set the symbol values ; sv1 ldy #symExp if the value is an expression then lda [sym],Y jeq sv2 ph2 copiedExpression save volitile variables ph4 shiftCount ph2 shiftFlag ph4 shiftValue ph2 symbolCount ph2 symbolLength ph2 symbolRelocatable ph2 symbolType ph4 symbolValue ldy #symVal+2 evaluate the expression lda [sym],Y pha dey dey lda [sym],Y pha jsr Evaluate sta symbolValue save the value stx symbolValue+2 lda shiftFlag if the value is shifted then beq sv1a ph4 name flag the error ph2 #2 jsr Error sv1a lda symbolRelocatable if the symbol is relocatable then beq sv1c jsr CheckSegment check for errors ldy #symSeg set the expression file lda [sym],Y sta expSegment sv1c pl4 symbolValue restore volitile variables pl2 symbolType pl2 symbolRelocatable pl2 symbolLength pl2 symbolCount pl4 shiftValue pl2 shiftFlag pl4 shiftCount pl2 copiedExpression bra sv3 else sv2 ldy #symVal set the value lda [sym],Y sta symbolValue iny iny lda [sym],Y sta symbolValue+2 stz symbolRelocatable set the relocation flag ldy #symFlag lda [sym],Y and #isConstant bne sv3 inc symbolRelocatable if relocatable then jsr CheckSegment check for cross-file errors ldy #symSeg set the expression file lda [sym],Y sta expSegment sv3 anop endif lda #1 count attribute is 1 sta symbolCount ldy #symLength set the length attribute lda [sym],Y sta symbolLength ldy #symType set the type attribute lda [sym],Y sta symbolType ldy #symFlag set the flags lda [sym],Y sta symbolFlag ldy #symFile set the file lda [sym],Y sta symbolFile ldy #symData set the data area number lda [sym],Y sta symbolData beq rt1 if symbolData <> 0 then lda symbolFlag if not symbolFlag & isDataArea then and #isDataArea bne rt1 ldx symbolData if not dataAreas[symbolData] then lda dataAreas,X and #$00FF bne rt1 lda strong if the reference is strong then beq rt1 ph4 name flag unresolved reference ph2 #6 jsr Error rt1 ret ; ; CheckSegment - check for cross-file expressions ; CheckSegment anop lda expSegment if the expression is file-sensitive beq cf1 then ldy #symSeg verify that the files match cmp [sym],Y beq cf1 clc nope -> flag the error lda sym adc #symName tax lda sym+2 adc #^symName pha phx ph2 #24 jsr Error cf1 rts end **************************************************************** * * Hash - find the hash tabe displacement for a symbol * * Inputs: * ptr - pointer to the symbol name * * Outputs: * returns the displacement into table * **************************************************************** * Hash private using SymbolCommon disp equ 1 hash displacement temp equ 3 temp value; for forming char pairs sub (4:ptr),4 ! {get ready for the sum loop} lda [ptr] get the # of characters and #$00FF lsr A X = numChars div 2 tax bcc lb1 if odd(numChars) then lda [ptr] disp = ch[1] & $3F xba and #$003F sta disp ldy #2 Y = 2 bra lb2 else lb1 stz disp disp = 0 ldy #1 y = 1 lb2 anop endif ! {add pairs of characters to the sum} txa quit now if there was 1 character beq lb4 lb3 lda [ptr],Y fetch a character pair and #$003F compact it to 12 bits sta temp lda [ptr],Y and #$3F00 lsr A lsr A ora temp adc disp add the result to disp sta disp iny next pair iny dex bne lb3 ! {create a hash table displacement} lb4 lda disp mod result with # of buckets lb5 cmp #hashSize blt lb6 sec sbc #hashSize bra lb5 lb6 asl A convert to a displacement asl A sta disp ret 2:disp end **************************************************************** * * InitSymbol - initialize the symbol table module * * Outputs: * poolSize - set to 0 * table - all pointers set to nil * **************************************************************** * InitSymbol start using SymbolCommon stz alpha alpha = nil stz alpha+2 stz poolSize no bytes in the symbol pool move #0,table,#hashSize*4 zero the hash table rts end **************************************************************** * * Match - see if two names match * * Inputs: * p1,p2 - pointers to the two names * * Outputs: * A - 0 if the names match, 1 if they do not * * Notes: * This subroutine assumes that the names are not null * strings. * **************************************************************** * Match private res equ 1 do the names match? sub (4:p1,4:p2),2 lda #1 assume they do not match sta res lda [p1] check the length & first char cmp [p2] bne mt2 and #$00FF check the characters tay short M mt1 lda [p1],Y cmp [p2],Y bne mt2 dey bne mt1 long M stz res the strings match mt2 long M ret 2:res end **************************************************************** * * NeedSegment - do we need this symbol from the library? * * Inputs: * name - pointer to the symbol name * priv - private flag * fileNumber - symbol's file number * pass - pass number * * Outputs: * A - 1 if we need it, 0 if we don't * **************************************************************** * NeedSegment start using Common using SymbolCommon need equ 1 do we need it? sp equ 3 symbol pointer maybe equ 7 we may need this symbol sub (4:name,2:priv),8 stz need assume we don't need it stz maybe so far, we have no need ph4 name if the symbol is not found then jsr FindSymbol sta sp stx sp+2 ora sp+2 jeq lb10 we don't need it lda priv if the library symbol is private then beq lb4 ldy #symFile if (sp->symFile != fileNumber) { lda [sp],Y cmp fileNumber beq lb3 lb1 ldy #symFile while (sp->symFile != fileNumber) { lda [sp],Y cmp fileNumber beq lb2a lb2 ldy #2 sp = sp->symNext; lda [sp],Y tax lda [sp] sta sp stx sp+2 ora sp+2 if (sp == NULL) jeq lb10 return false; bra lb1 } lb2a clc if (!Match(sp->symName,sp)) { lda sp adc #symName tax lda sp+2 adc #^symName pha phx ph4 name jsr Match tax bne lb2 ! sp = sp->symNext; ! goto lb1; lb3 anop } jsr CheckSymbol check the symbol bcc lb10 inc need bra lb10 lb4 anop else {if library symbol is global then} lda sp while (sp != NULL) ora sp+2 beq lb7 ldy #symPriv if (!sp->symPriv) lda [sp],Y bne lb6 clc if (Match(sp->symName,name)) lda sp adc #symName tax lda sp+2 adc #^symName pha phx ph4 name jsr Match tax bne lb6 lda pass if the symbol is resolved then cmp #1 bne lb5 lda #pass1Resolved bra lb5a lb5 lda #pass2Resolved lb5a ldy #symFlag and [sp],Y bne lb10 we don't need this segment lda pass if the symbol is requested then cmp #1 bne lb5b lda #pass1Requested bra lb5c lb5b lda #pass2Requested lb5c ldy #symFlag and [sp],Y beq lb6 inc maybe we may need this segment lb6 ldy #2 sp = sp->symNext; lda [sp],Y tax lda [sp] sta sp stx sp+2 bra lb4 lb7 lda maybe if maybe then beq lb10 inc need we need this symbol lb10 ret 2:need ; ; Check the symbol ; CheckSymbol anop lda pass if (pass == 1) { cmp #1 bne cs1 ldy #symFlag if (sp->symFlag & pass1Requested) lda [sp],Y bit #pass1Requested beq cs2 bit #pass1Resolved if (!(sp->symFlag & pass1Resolved) bne cs2 sec return true; rts ! } ! else {pass == 2} cs1 ldy #symFlag if (sp->symFlag & pass2Requested) lda [sp],Y bit #pass2Requested beq cs2 bit #pass2Resolved if (!(sp->symFlag & pass2Resolved) bne cs2 sec return true; rts ! } cs2 clc return false rts end **************************************************************** * * PrintSymbol - print one symbol * * Inputs: * r0 - pointer to the symbol table entry * **************************************************************** * PrintSymbol private using Common using SymbolCommon ldy #symVal+2 push the symbol value lda [r0],Y pha dey dey lda [r0],Y pha ldy #symExp if the symbol is an expression then lda [r0],Y beq lb0 jsr Evaluate evaluate the expression phx pha lb0 ph2 #8 print the symbol value ph2 #0 jsr PrintHex ldy #symPriv print the global/private flag lda [r0],Y beq lb1 puts #' P ' bra lb2 lb1 puts #' G ' lb2 ldy #symSeg print the load segment number lda [r0],Y ldx kflag beq lb3 ldx express beq lb3 inc A lb3 pea 0 pha ph2 #2 ph2 #0 jsr PrintHex putc #' ' ldy #symData print the data area number lda [r0],Y pea 0 pha ph2 #2 ph2 #0 jsr PrintHex putc #' ' add4 r0,#symName-1,r4 print the symbol name puts [r4] rts end **************************************************************** * * PrintSymbols - print the symbol table * * Inputs: * symbols - print symbols flag * **************************************************************** * PrintSymbols start using SymbolCommon using Common ; ; Write the header ; lda symbols quit if the symbol flag is off bne lb1 rts lb1 lda list write the header bne lb2 putcr putcr lb2 puts #'Global symbol table:',cr=t putcr ; ; Initialize the symbol list pointer ; move4 alpha,r12 ; ; Print the symbols ; stz col2 not doing column 2 ps1 jsr FindFirstSymbol find the next symbol to print bcc ps5 jsr PrintSymbol print it lda col2 if this one is in column 1 then bne ps4 inc col2 col2 = true ldy #symName get the length of the name lda [r0],Y and #$00FF sta r4 sec print the proper number of spaces lda #27 sbc r4 sta r4 beq ps2 bpl ps3 ps2 lda #1 sta r4 ps3 putc #' ' dec r4 bne ps3 bra ps1 else ps4 stz col2 col2 = false putcr write a CR jsr CheckForPause check for early exit bra ps1 next symbol ps5 lda col2 if in column 1 then bne ps6 putcr write the CR ps6 putcr lda list beq ps7 putcr putcr ps7 rts ; ; Local data ; col2 ds 2 end **************************************************************** * * Reference - make a reference to a symbol * * Inputs: * sp - pointer to the symbol name to reference * **************************************************************** * Reference start using Common using SymbolCommon ! {get a symbol to define} fs1 ph4 sp if ((r0 = FindSymbol(sp)) != NULL) { jsr FindSymbol sta r0 stx r0+2 ora r0 beq fs5 ldy #symFile if (r0->symFile == fileNumber) lda [r0],Y cmp fileNumber beq fs6 goto fs6; fs2 ldy #symFile while (r0->symFile != fileNumber) { lda [r0],Y cmp fileNumber beq fs4 fs3 ldy #2 r0 = r0->symNext; lda [r0] tax lda [r0],Y sta r2 stx r0 ora r0 if (r0 == NULL) beq fs5 goto fs5; bra fs2 } fs4 clc if (!Match(r0->symName,sp)) { lda r0 adc #symName tax lda r2 adc #^symName pha phx ph4 sp jsr Match tax bne fs3 rts r0 = r0->symNext; ! if (r0 == NULL) ! goto fs5; ! goto fs2; ! } ! } ! else fs5 ph4 sp CreateSymbol(sp); jsr CreateSymbol sta r0 stx r2 fs6 ldy #symFlag set the pass 1 requested flag lda [r0],Y ora #pass1Requested sta [r0],Y rts end **************************************************************** * * Reference2 - note that pass2 has requested a symbol * * Inputs: * sp - pointer to the symbol name to reference * **************************************************************** * Reference2 start using Common using SymbolCommon ph4 sp r0 = FindSymbol(sp); jsr FindSymbol sta r0 stx r2 ldy #symFile if (r0->symFile != fileNumber) { lda [r0],Y cmp fileNumber beq lb3 lb1 ldy #symFile while (r0->symFile != fileNumber) { lda [r0],Y cmp fileNumber beq lb2a lb2 ldy #2 r0 = r0->symNext; lda [r0],Y tax lda [r0] sta r0 stx r2 bra lb1 lb2a clc if (!Match(r0->symName,sp)) { lda r0 adc #symName tax lda r2 adc #^symName pha phx ph4 sp jsr Match tax bne lb2 ! r0 = r0->symNext; ! goto lb1; lb3 anop } ldy #symFlag set the pass 2 requested flag lda [r0],Y ora #pass2Requested sta [r0],Y rts end **************************************************************** * * Unresolved - are there unresolved references? * * Inputs: * pass - pass number * * Outputs: * C - set if there are unresolved references, else clear * **************************************************************** * Unresolved start using SymbolCommon using Common lda pass if pass1 then cmp #1 bne lb1 lda #pass1Resolved resolved = pass1Resolved ldx #pass1Requested requested = pass1Requested bra lb2 else lb1 lda #pass2Resolved resolved = pass2Resolved ldx #pass2Requested requested = pass2Requested lb2 sta resolved endif stx requested la index,hashSize*4-4 for each hash bucket do lb3 ldx index for each symbol in the bucket do lda table,X sta r0 sta r4 lda table+2,X sta r2 sta r6 ora r2 beq lb7 lb4 ldy #symFlag if r0^.symFlag & requested then lda [r0],Y bit requested beq lb6 bit resolved if not (r0^.symFlag & resolved) then bne lb6 ldy #symPriv if r0^.symPriv then lda [r0] beq lb5 jsr GlobalExists if GlobalExists then bcs lb6 skip request lb5 sec return true rts lb6 ldy #2 r0 = r0^.symNext lda [r0],Y tax lda [r0] sta r0 stx r2 ora r2 next symbol in bucket bne lb4 lb7 sec next bucket lda index sbc #4 sta index bpl lb3 clc no symbols needed rts ; ; GlobalExists - see if a global symbol by the name of r0^.symName exists ; GlobalExists anop move4 r4,r8 r8 = first sym in bucket add4 r0,#symName,r12 r12 = @r0^.symName ge1 ldy #symPriv for each symbol do lda [r8],Y if the symbol is global then bne ge2 clc if Match(r8^.symName,r12) then lda r8 adc #symName tax lda r10 adc #^symName pha phx ph4 r12 jsr Match tax bne ge2 sec return true rts ge2 ldy #2 next symbol lda [r8],Y tax lda [r8] sta r8 stx r10 ora r10 bne ge1 clc return false rts ; ; Local data ; index ds 2 index into the hash table resolved ds 2 resolved mask for this pass requested ds 2 requested mask for this pass end \ No newline at end of file + keep obj/symbol + mcopy symbol.mac +**************************************************************** +* +* Symbol Tables +* +* This module contains the subroutines used to create, search +* and manipulate the symbol table. +* +**************************************************************** + copy directPage +**************************************************************** +* +* SymbolCommon - global data for the symbol table module +* +**************************************************************** +* +SymbolCommon privdata +; +; Symbol table entry +; +symNext equ 0 pointer to the next symbol +symAlpha equ 4 alphabetized list pointer +symVal equ 8 value of the label (or ptr to expression) +symSeg equ 12 segment number +symFile equ 14 file number +symData equ 16 data area number +symExp equ 18 is the value an expression? +symFlag equ 20 pass 1/2 resolved flags +symPriv equ 22 is the symbol private? +symLength equ 24 length attribute +symType equ 26 type attribute +symName equ 28 symbol name (p-string) + +symSize equ 28 size of a symbol, sans symbol name +; +; Constants +; +hashSize equ 877 number of hash buckets +blockSize equ 4096 symbol table blocking factor +; +; Symbol table variables +; +alpha ds 4 head of alphabetized list +hashDisp ds 2 disp in hash table; saved for efficiency + +poolPtr ds 4 ptr to next byte in symbol table pool +poolSize ds 2 # of bytes left in the current pool + +table ds hashSize*4 symbol table + end + +**************************************************************** +* +* AllocatePool - allocate a new symbol table pool +* +* Outputs: +* poolPtr - pointer to the first byte of the pool +* poolSize - size of the block, in bytes +* +**************************************************************** +* +AllocatePool private + using SymbolCommon + + ph4 #blockSize + jsr MLalloc + sta poolPtr + stx poolPtr+2 + lda #blockSize + sta poolSize + rts + end + +**************************************************************** +* +* AlphaInsert - insert the symbol in the alphabetized list +* +* Inputs: +* sym - pointer to the new symbol +* alpha - head of the alphabetized list +* +**************************************************************** +* +AlphaInsert private + using SymbolCommon +p1 equ 1 work pointers +p2 equ 5 +p3 equ 9 + + sub (4:sym),12 + + lda alpha if alpha = nil then + ora alpha+2 + bne lb1 + move4 sym,alpha alpha = sym + ldy #symAlpha sym^.alpha = nil + lda #0 + sta [sym],Y + iny + iny + sta [sym],Y + brl lb8 return + +lb1 move4 alpha,p1 p1 = alpha + stz p2 p2 = nil + stz p2+2 + add4 sym,#symName while sym^.symName >= p1^.symName do + lda [sym] + and #$00FF + sta len1 +lb2 add4 p1,#symName,p3 + lda len1 + sta lens + lda [p3] + and #$00FF + sta len2 + cmp lens + bge lb3 + sta lens +lb3 short M + ldy #1 +lb4 lda [sym],Y + cmp [p3],Y + bne lb5 + iny + dec lens + bne lb4 + lda len1 + cmp len2 +lb5 long M + blt lb6 + move4 p1,p2 p2 = p1 + ldy #symAlpha p1 = p2^.symAlpha + lda [p2],Y + sta p1 + iny + iny + lda [p2],Y + sta p1+2 + ora p1 quit if at the end of the list + bne lb2 endwhile +lb6 sub4 sym,#symName fix sym + + ldy #symAlpha sym^.symAlpha = p1 + lda p1 + sta [sym],Y + iny + iny + lda p1+2 + sta [sym],Y + lda p2 if p2 = nil then + ora p2+2 + bne lb7 + move4 sym,alpha alpha = sym + bra lb8 return + +lb7 ldy #symAlpha p2^.symAlpha = sym + lda sym + sta [p2],Y + iny + iny + lda sym+2 + sta [p2],Y + +lb8 ret +; +; Local data +; +lens ds 2 shortest string length +len1 ds 2 length(sym^.symName) +len2 ds 2 length(p1^.symName) + end + +**************************************************************** +* +* CreateSymbol - create a new symbol table entry +* +* Inputs: +* name - name of the new entry +* hashDisp - disp in hash table for the entry +* +* Outputs: +* returns a pointer to the new symbol table entry +* +**************************************************************** +* +CreateSymbol private + using Common + using OutCommon + using SymbolCommon +entryLength equ 1 length of the symbol table entry +sym equ 3 ptr to symbol table entry +p1 equ 7 work pointer + + sub (4:name),10 + + lda [name] no match - create a symbol table entry + and #$00FF + sec + adc #symSize + sta entryLength + cmp poolSize + ble cs2 + jsr AllocatePool no room - get a new pool +cs2 sub2 poolSize,entryLength subtract the space we need + clc update the pool pointer and get a copy + lda poolPtr + sta sym + adc entryLength + sta poolPtr + lda poolPtr+2 + sta sym+2 + adc #0 + sta poolPtr+2 + + ldx hashDisp place the record in the hash list + ldy #2 + lda table,X + sta [sym] + lda table+2,X + sta [sym],Y + lda sym + sta table,X + lda sym+2 + sta table+2,X + ldy #symSeg record our load segment number + lda loadNumber + sta [sym],Y + ldy #symFile record our file number + lda fileNumber + sta [sym],Y + ldy #symFlag the value is not resolved + lda #0 + sta [sym],Y + ldy #symPriv the symbol is not private + sta [sym],Y + add4 sym,#symName,p1 record the symbol name + lda [name] + and #$00FF + tay + short M +cs3 lda [name],Y + sta [p1],Y + dey + bpl cs3 + long M + lda symbols if the symbol table will be printed then + beq cs4 + ph4 sym insert in alphabetical list + jsr AlphaInsert +cs4 ret 4:sym + end + +**************************************************************** +* +* Define - define a symbol +* +* Inputs: +* name - ptr to the symbol name +* length - length attribute +* type - type attribute +* private - is the symbol private? +* global - is the symbol global? (or local) +* expression - is the value an expression? (or a constant) +* value - symbol value, or pointer to the expression +* isData - is the symbol a data area name? +* isSegment - is the symbol a segment name? +* +**************************************************************** +* +Define start + using Common + using SymbolCommon + using ExpCommon + using OutCommon +sym equ 1 pointer to symbol table entry + + sub (4:name,2:length,2:type,2:private,2:global,2:expression,4:value,2:isData,2:isSegment),4 + + lda global if the symbol is local then + bne fs1 + lda dataNumber if dataNumber = 0 then + jeq lb2 return {don't define the symbol!} + +! {get a symbol to define} +fs1 ph4 name if ((sym = FindSymbol(name)) != NULL) { + jsr FindSymbol + sta sym + stx sym+2 + ora sym + beq fs5 + ldy #symFile if (sym->symFile == fileNumber) + lda [sym],Y + cmp fileNumber + beq fs6 goto fs6; +fs2 ldy #symFile while (sym->symFile != fileNumber) { + lda [sym],Y + cmp fileNumber + beq fs4 +fs3 ldy #2 sym = sym->symNext; + lda [sym] + tax + lda [sym],Y + sta sym+2 + stx sym + ora sym if (sym == NULL) + beq fs5 goto fs5; + bra fs2 } +fs4 clc if (!Match(& sym->symName,name)) { + lda sym + adc #symName + tax + lda sym+2 + adc #^symName + pha + phx + ph4 name + jsr Match + tax + beq fs6 + bra fs3 sym = sym->symNext; +! if (sym == NULL) +! goto fs5; +! goto fs2; +! } +! } + bra fs6 else +fs5 ph4 name sym = CreateSymbol(name); + jsr CreateSymbol + sta sym + stx sym+2 +fs6 anop + + lda expression if the value is an expression then + beq ex1 + ph4 value copy the expression + jsr CopyExpression + ldy #symVal + sta [sym],Y + ldy #symVal+2 + txa + sta [sym],Y + + ldy #symExp set the expression flag + lda copiedExpression + sta [sym],Y + bne ex2 if a constant was returned then + ldy #symFlag set the constant flag + lda #isConstant + ora [sym],Y + sta [sym],Y + bra ex2 else +ex1 ldy #symVal save the symbol value + lda value + sta [sym],Y + ldy #symVal+2 + lda value+2 + sta [sym],Y + ldy #symExp clear expression flag + lda #0 + sta [sym],Y +ex2 anop endif + + ldy #symLength set the length attribute + lda length + sta [sym],Y + ldy #symType set the type attribute + lda type + sta [sym],Y + ldy #symPriv set the private flag + lda private + sta [sym],Y + ldy #symData set the data area number + lda dataNumber + ldx global + beq ex3 + ldx isData + bne ex3 + lda #0 +ex3 sta [sym],Y + ldy #symFile set the file number + lda fileNumber + sta [sym],Y + ldy #symSeg set the load segment number + lda loadNumber + sta [sym],Y + ldy #symFlag set the "resolved on pass 1" flag + lda [sym],Y + ora #pass1Resolved+pass1Requested + sta [sym],Y + lda isData if isData then + beq lb2 +! ldy #symFlag set the data area flag + lda [sym],Y + ora #isDataArea + sta [sym],Y +lb2 lda isSegment if isSegment then + beq lb3 +! ldy #symFlag set the segment flag + lda [sym],Y + ora #isSegmentFlag + sta [sym],Y + +lb3 ret + end + +**************************************************************** +* +* Define2 - note that the symbol is resolved on pass 2 +* +* Inputs: +* name - ptr to the symbol name +* global - is the symbol global? +* value - value, or 0 if the value does not need to be checked +* +**************************************************************** +* +Define2 start + using Common + using SymbolCommon +sym equ 1 pointer to symbol table entry +p1 equ 5 copy of sym; used for duplicate check + + sub (4:name,2:global,4:value),8 + + lda global if the symbol is local then + bne lb1 + lda dataNumber if dataNumber = 0 then + jeq lb10 return {don't define the symbol!} + +! /* find the correct symbol */ +lb1 ph4 name sym = FindSymbol(name); + jsr FindSymbol p1 = sym; + sta sym + sta p1 + stx sym+2 + stx p1+2 + ldy #symFile if (sym->symFile != fileNumber) { + lda [sym],Y + cmp fileNumber + beq lb5 +lb2 ldy #symFile while (sym->symFile != fileNumber) + lda [sym],Y + cmp fileNumber + beq lb4 +lb3 ldy #2 sym = sym->symNext; + lda [sym],Y + tax + lda [sym] + sta sym + stx sym+2 + bra lb2 +lb4 clc if (!Match(& sym->symName,name) { + lda sym + adc #symName + tax + lda sym+2 + adc #^symName + pha + phx + ph4 name + jsr Match + tax + bne lb3 +! sym = sym->symNext; +! goto lb2; +! } +! } +! /* check for duplicates in this file */ +lb5 ldy #symFlag if (sym->symFlag & pass2Resolved) + lda [sym],Y + and #pass2Resolved + bne lb7 +! Error(DUPLICATE_SYMBOL); +! /* check for duplicate globals in */ +! /* two different files */ + ldy #symPriv else if ((global) && (!sym^.symPriv)){ + lda [sym],Y + bne lb9 +lb6 lda p1 while (p1 != NULL) { + ora p1+2 + beq lb9 + cmpl p1,sym if (p1 != sym) + beq lb8 + clc if (Match(p1->symName,name)) + lda p1 + adc #symName + tax + lda p1+2 + adc #^symName + pha + phx + ph4 name + jsr Match + tax + bne lb8 + ldy #symPriv if (!p1->symPriv) { + lda [p1],Y + bne lb8 + ldy #symFlag if (p1->symFlag & pass2Resolved) + lda [p1],Y + and #pass2Resolved + beq lb8 +lb7 ph4 name Error(DUPLICATE_SYMBOL); + ph2 #1 + jsr Error + bra lb9 goto lb9; +! } +lb8 ldy #2 p1 = p1->symNext; + lda [p1],Y + tax + lda [p1] + sta p1 + stx p1+2 + bra lb6 } +! } +lb9 anop + + ldy #symFlag set the "resolved on pass 2" flag + lda [sym],Y + ora #pass2Resolved+pass2Requested + sta [sym],Y + ldy #symExp if the symbol is an expression then + lda [sym],Y + beq lb9a + ldy #symVal+2 make sure all needed symbols are + lda [sym],Y available + +; and #$FF00 debug +; beq db1 debug +; brk $33 debug +;b1 lda [sym],Y debug + + pha + dey + dey + lda [sym],Y + pha + jsr Evaluate +lb9a lda value if value <> 0 then + ora value+2 + beq lb10 + ldy #symVal if value <> sym^.symVal then + lda [sym],Y + cmp value + bne lb9b + iny + iny + lda [sym],Y + cmp value+2 + beq lb10 +lb9b ph4 name addressing error + ph2 #7 + jsr Error + +lb10 ret + end + +**************************************************************** +* +* FindFirstSymbol - find the alphabetically smallest symbol +* +* Inputs: +* r12 - head of the symbol table +* +* Outputs: +* r0 - pointer to the first symbol +* r12 - pointer to the remaining symbols +* C - set if a symbol was found, else clear +* +* Notes: +* Only symbols resolved on pass 2 are returned. +* +**************************************************************** +* +FindFirstSymbol private + using Common + using SymbolCommon + +lb0 lda r12 if r12 = nil then + ora r14 + bne lb1 return false + clc + rts + +lb1 move4 r12,r0 r0 = r12 + ldy #symAlpha r12 = r0^.symAlpha + lda [r0],Y + sta r12 + iny + iny + lda [r0],Y + sta r14 + ldy #symFlag if the symbol was not resolved then + lda [r0],Y + and #pass2Resolved + beq lb0 skip this one + sec return true + rts + end + +**************************************************************** +* +* FindSymbol - find a symbol +* +* Inputs: +* name - pointer to the symbol name +* +* Outputs: +* A-X - address of the symbol table entry; nil for none +* hashDisp - hash table displacement +* +* Notes: +* There may be several symbols with the same name. In +* that case, this subroutine returns the first one in +* the hash bucked. You can scan forward from sym^.next +* to find the others. +* +**************************************************************** +* +FindSymbol private + using SymbolCommon +sym equ 1 symbol table pointer + + sub (4:name),4 + + ph4 name get the address of the proper hash bucket + jsr Hash + sta hashDisp + tax + lda table,X + sta sym + lda table+2,X + sta sym+2 + ora sym branch if it is empty + beq lb2 + +lb1 clc if the names match then + lda sym + adc #symName + tax + lda sym+2 + adc #0 + pha + phx + ph4 name + jsr Match + tax + beq lb2 return + ldy #2 next symbol + lda [sym],Y + tax + lda [sym] + sta sym + stx sym+2 + ora sym+2 + bne lb1 + +lb2 ret 4:sym + end + +**************************************************************** +* +* GetSymbolMemory - get memory from the symbol table pool +* +* Inputs: +* size - number of bytes to reserve +* +* Outputs: +* returns a pointer to the memory +* +**************************************************************** +* +GetSymbolMemory start + using SymbolCommon +ptr equ 1 pointer to the memory + + sub (2:size),4 + + lda size if there isn't enough room then + cmp poolSize + ble lb2 + cmp #blockSize if the request is bigger than + blt lb1 blockSize then + pea 0 get the memory from MLalloc + pha + jsr MLAlloc + sta ptr + stx ptr+2 + bra lb3 return +lb1 jsr AllocatePool no room - get a new pool + +lb2 sub2 poolSize,size subtract the space we need + clc update the pool pointer and get a copy + lda poolPtr + sta ptr + adc size + sta poolPtr + lda poolPtr+2 + sta ptr+2 + adc #0 + sta poolPtr+2 + +lb3 ret 4:ptr + end + +**************************************************************** +* +* GetSymbolValue - get the value of a symbol; for Evaluate only! +* +* Inputs: +* name - name of the symbol +* strong - strong reference? (or weak) +* fileNumber - current file number +* expSegment - segment for the current expression +* +* Outputs: +* symbolValue - symbol value +* symbolRelocatable - is the symbol relocatable? +* symbolLength - length attribute +* symbolCount - count attribute +* symbolType - type attribute +* symbolFlag - symbol flags +* symbolData - data area number +* +**************************************************************** +* +GetSymbolValue start + using Common + using OutCommon + using SymbolCommon + using ExpCommon + +sym equ 1 pointer to the symbol +p1 equ 5 work pointer + + sub (4:name,2:strong),8 +; +; Find the symbol in the hash table +; + ph4 name find the symbol + jsr FindSymbol + sta sym + sta p1 + stx sym+2 + stx p1+2 + ora p1+2 + beq nosym +; +; Find the private version of the symbol. Use it if it is resolved. +; + ldy #symFile if p1^.symFile <> fileNumber then + lda [p1],Y + cmp fileNumber + beq lb4 +lb1 ldy #symFile while p1^.symFile <> fileNumber do + lda [p1],Y + cmp fileNumber + beq lb3 +lb2 ldy #2 p1 := p1^.next; + lda [p1],Y + tax + lda [p1] + sta p1 + stx p1+2 + ora p1+2 + beq gb1 + bra lb1 +lb3 clc if not Match(p1^.symName,name) then + lda #symName + adc p1 + tax + lda #^symName + adc p1+2 + pha + phx + ph4 name + jsr Match + tax + bne lb2 p1 := p1^.next; +! goto 1; +! endif +lb4 anop endif + + ldy #symFlag if the private symbol is resolved then + lda [p1],Y + and #pass1Resolved + beq gb1 + move4 p1,sym use it + bra sv1 +; +; Find the global version of the symbol. +; +gb1 ldy #symFlag while not (sym^.symFlag & pass1Resolved) do + lda [sym],Y + and #pass1Resolved + bne gb3 +gb2 ldy #2 sym := sym^.next; + lda [sym],Y + tax + lda [sym] + sta sym + stx sym+2 + ora sym+2 if sym = nil then + bne gb1 +nosym stz symbolValue symbolValue = 0 + stz symbolValue+2 + stz symbolRelocatable symbolRelocatable = false + stz symbolLength symbolLength = 0 + stz symbolCount symbolCount = 0 + stz symbolType symbolType = 0 + stz symbolFlag symbolFlag = 0 + stz symbolData symbolData = 0 + stz symbolFile symbolFile = 0 + lda strong if the reference is strong then + jeq rt1 + ph4 name flag the error + ph2 #6 + jsr Error + brl rt1 return +gb3 ldy #symPriv if sym^.symPriv then + lda [sym],Y + bne gb2 sym := sym^.next; +! goto 1; +! endif + clc if not Match(sym^.symName,name) then + lda #symName + adc sym + tax + lda #^symName + adc sym+2 + pha + phx + ph4 name + jsr Match + tax + bne gb2 sym := sym^.next; +! goto 1; +! endif +! endif +; +; Set the symbol values +; +sv1 ldy #symExp if the value is an expression then + lda [sym],Y + jeq sv2 + ph2 copiedExpression save volitile variables + ph4 shiftCount + ph2 shiftFlag + ph4 shiftValue + ph2 symbolCount + ph2 symbolLength + ph2 symbolRelocatable + ph2 symbolType + ph4 symbolValue + ldy #symVal+2 evaluate the expression + lda [sym],Y + pha + dey + dey + lda [sym],Y + pha + jsr Evaluate + sta symbolValue save the value + stx symbolValue+2 + lda shiftFlag if the value is shifted then + beq sv1a + ph4 name flag the error + ph2 #2 + jsr Error +sv1a lda symbolRelocatable if the symbol is relocatable then + beq sv1c + jsr CheckSegment check for errors + ldy #symSeg set the expression file + lda [sym],Y + sta expSegment +sv1c pl4 symbolValue restore volitile variables + pl2 symbolType + pl2 symbolRelocatable + pl2 symbolLength + pl2 symbolCount + pl4 shiftValue + pl2 shiftFlag + pl4 shiftCount + pl2 copiedExpression + bra sv3 else +sv2 ldy #symVal set the value + lda [sym],Y + sta symbolValue + iny + iny + lda [sym],Y + sta symbolValue+2 + stz symbolRelocatable set the relocation flag + ldy #symFlag + lda [sym],Y + and #isConstant + bne sv3 + inc symbolRelocatable if relocatable then + jsr CheckSegment check for cross-file errors + ldy #symSeg set the expression file + lda [sym],Y + sta expSegment +sv3 anop endif + + lda #1 count attribute is 1 + sta symbolCount + ldy #symLength set the length attribute + lda [sym],Y + sta symbolLength + ldy #symType set the type attribute + lda [sym],Y + sta symbolType + ldy #symFlag set the flags + lda [sym],Y + sta symbolFlag + ldy #symFile set the file + lda [sym],Y + sta symbolFile + ldy #symData set the data area number + lda [sym],Y + sta symbolData + beq rt1 if symbolData <> 0 then + lda symbolFlag if not symbolFlag & isDataArea then + and #isDataArea + bne rt1 + ldx symbolData if not dataAreas[symbolData] then + lda dataAreas,X + and #$00FF + bne rt1 + lda strong if the reference is strong then + beq rt1 + ph4 name flag unresolved reference + ph2 #6 + jsr Error +rt1 ret +; +; CheckSegment - check for cross-file expressions +; +CheckSegment anop + lda expSegment if the expression is file-sensitive + beq cf1 then + ldy #symSeg verify that the files match + cmp [sym],Y + beq cf1 + clc nope -> flag the error + lda sym + adc #symName + tax + lda sym+2 + adc #^symName + pha + phx + ph2 #24 + jsr Error +cf1 rts + end + +**************************************************************** +* +* Hash - find the hash tabe displacement for a symbol +* +* Inputs: +* ptr - pointer to the symbol name +* +* Outputs: +* returns the displacement into table +* +**************************************************************** +* +Hash private + using SymbolCommon +disp equ 1 hash displacement +temp equ 3 temp value; for forming char pairs + + sub (4:ptr),4 + +! {get ready for the sum loop} + lda [ptr] get the # of characters + and #$00FF + lsr A X = numChars div 2 + tax + bcc lb1 if odd(numChars) then + lda [ptr] disp = ch[1] & $3F + xba + and #$003F + sta disp + ldy #2 Y = 2 + bra lb2 else +lb1 stz disp disp = 0 + ldy #1 y = 1 +lb2 anop endif + +! {add pairs of characters to the sum} + txa quit now if there was 1 character + beq lb4 + +lb3 lda [ptr],Y fetch a character pair + and #$003F compact it to 12 bits + sta temp + lda [ptr],Y + and #$3F00 + lsr A + lsr A + ora temp + adc disp add the result to disp + sta disp + iny next pair + iny + dex + bne lb3 + +! {create a hash table displacement} +lb4 lda disp mod result with # of buckets +lb5 cmp #hashSize + blt lb6 + sec + sbc #hashSize + bra lb5 +lb6 asl A convert to a displacement + asl A + sta disp + + ret 2:disp + end + +**************************************************************** +* +* InitSymbol - initialize the symbol table module +* +* Outputs: +* poolSize - set to 0 +* table - all pointers set to nil +* +**************************************************************** +* +InitSymbol start + using SymbolCommon + + stz alpha alpha = nil + stz alpha+2 + stz poolSize no bytes in the symbol pool + move #0,table,#hashSize*4 zero the hash table + rts + end + +**************************************************************** +* +* Match - see if two names match +* +* Inputs: +* p1,p2 - pointers to the two names +* +* Outputs: +* A - 0 if the names match, 1 if they do not +* +* Notes: +* This subroutine assumes that the names are not null +* strings. +* +**************************************************************** +* +Match private +res equ 1 do the names match? + + sub (4:p1,4:p2),2 + + lda #1 assume they do not match + sta res + lda [p1] check the length & first char + cmp [p2] + bne mt2 + and #$00FF check the characters + tay + short M +mt1 lda [p1],Y + cmp [p2],Y + bne mt2 + dey + bne mt1 + long M + stz res the strings match + +mt2 long M + ret 2:res + end + +**************************************************************** +* +* NeedSegment - do we need this symbol from the library? +* +* Inputs: +* name - pointer to the symbol name +* priv - private flag +* fileNumber - symbol's file number +* pass - pass number +* +* Outputs: +* A - 1 if we need it, 0 if we don't +* +**************************************************************** +* +NeedSegment start + using Common + using SymbolCommon +need equ 1 do we need it? +sp equ 3 symbol pointer +maybe equ 7 we may need this symbol + + sub (4:name,2:priv),8 + + stz need assume we don't need it + stz maybe so far, we have no need + ph4 name if the symbol is not found then + jsr FindSymbol + sta sp + stx sp+2 + ora sp+2 + jeq lb10 we don't need it + + lda priv if the library symbol is private then + beq lb4 + ldy #symFile if (sp->symFile != fileNumber) { + lda [sp],Y + cmp fileNumber + beq lb3 +lb1 ldy #symFile while (sp->symFile != fileNumber) { + lda [sp],Y + cmp fileNumber + beq lb2a +lb2 ldy #2 sp = sp->symNext; + lda [sp],Y + tax + lda [sp] + sta sp + stx sp+2 + ora sp+2 if (sp == NULL) + jeq lb10 return false; + bra lb1 } +lb2a clc if (!Match(sp->symName,sp)) { + lda sp + adc #symName + tax + lda sp+2 + adc #^symName + pha + phx + ph4 name + jsr Match + tax + bne lb2 +! sp = sp->symNext; +! goto lb1; +lb3 anop } + jsr CheckSymbol check the symbol + bcc lb10 + inc need + bra lb10 +lb4 anop else {if library symbol is global then} + lda sp while (sp != NULL) + ora sp+2 + beq lb7 + ldy #symPriv if (!sp->symPriv) + lda [sp],Y + bne lb6 + clc if (Match(sp->symName,name)) + lda sp + adc #symName + tax + lda sp+2 + adc #^symName + pha + phx + ph4 name + jsr Match + tax + bne lb6 + lda pass if the symbol is resolved then + cmp #1 + bne lb5 + lda #pass1Resolved + bra lb5a +lb5 lda #pass2Resolved +lb5a ldy #symFlag + and [sp],Y + bne lb10 we don't need this segment + lda pass if the symbol is requested then + cmp #1 + bne lb5b + lda #pass1Requested + bra lb5c +lb5b lda #pass2Requested +lb5c ldy #symFlag + and [sp],Y + beq lb6 + inc maybe we may need this segment +lb6 ldy #2 sp = sp->symNext; + lda [sp],Y + tax + lda [sp] + sta sp + stx sp+2 + bra lb4 +lb7 lda maybe if maybe then + beq lb10 + inc need we need this symbol + +lb10 ret 2:need +; +; Check the symbol +; +CheckSymbol anop + lda pass if (pass == 1) { + cmp #1 + bne cs1 + ldy #symFlag if (sp->symFlag & pass1Requested) + lda [sp],Y + bit #pass1Requested + beq cs2 + bit #pass1Resolved if (!(sp->symFlag & pass1Resolved) + bne cs2 + sec return true; + rts +! } +! else {pass == 2} +cs1 ldy #symFlag if (sp->symFlag & pass2Requested) + lda [sp],Y + bit #pass2Requested + beq cs2 + bit #pass2Resolved if (!(sp->symFlag & pass2Resolved) + bne cs2 + sec return true; + rts +! } +cs2 clc return false + rts + end + +**************************************************************** +* +* PrintSymbol - print one symbol +* +* Inputs: +* r0 - pointer to the symbol table entry +* +**************************************************************** +* +PrintSymbol private + using Common + using SymbolCommon + + ldy #symVal+2 push the symbol value + lda [r0],Y + pha + dey + dey + lda [r0],Y + pha + ldy #symExp if the symbol is an expression then + lda [r0],Y + beq lb0 + jsr Evaluate evaluate the expression + phx + pha +lb0 ph2 #8 print the symbol value + ph2 #0 + jsr PrintHex + ldy #symPriv print the global/private flag + lda [r0],Y + beq lb1 + puts #' P ' + bra lb2 +lb1 puts #' G ' +lb2 ldy #symSeg print the load segment number + lda [r0],Y + ldx kflag + beq lb3 + ldx express + beq lb3 + inc A +lb3 pea 0 + pha + ph2 #2 + ph2 #0 + jsr PrintHex + putc #' ' + ldy #symData print the data area number + lda [r0],Y + pea 0 + pha + ph2 #2 + ph2 #0 + jsr PrintHex + putc #' ' + add4 r0,#symName-1,r4 print the symbol name + puts [r4] + rts + end + +**************************************************************** +* +* PrintSymbols - print the symbol table +* +* Inputs: +* symbols - print symbols flag +* +**************************************************************** +* +PrintSymbols start + using SymbolCommon + using Common +; +; Write the header +; + lda symbols quit if the symbol flag is off + bne lb1 + rts + +lb1 lda list write the header + bne lb2 + putcr + putcr +lb2 puts #'Global symbol table:',cr=t + putcr +; +; Initialize the symbol list pointer +; + move4 alpha,r12 +; +; Print the symbols +; + stz col2 not doing column 2 +ps1 jsr FindFirstSymbol find the next symbol to print + bcc ps5 + jsr PrintSymbol print it + lda col2 if this one is in column 1 then + bne ps4 + inc col2 col2 = true + ldy #symName get the length of the name + lda [r0],Y + and #$00FF + sta r4 + sec print the proper number of spaces + lda #27 + sbc r4 + sta r4 + beq ps2 + bpl ps3 +ps2 lda #1 + sta r4 +ps3 putc #' ' + dec r4 + bne ps3 + bra ps1 else +ps4 stz col2 col2 = false + putcr write a CR + jsr CheckForPause check for early exit + bra ps1 next symbol + +ps5 lda col2 if in column 1 then + bne ps6 + putcr write the CR + +ps6 putcr + lda list + beq ps7 + putcr + putcr +ps7 rts +; +; Local data +; +col2 ds 2 + end + +**************************************************************** +* +* Reference - make a reference to a symbol +* +* Inputs: +* sp - pointer to the symbol name to reference +* +**************************************************************** +* +Reference start + using Common + using SymbolCommon + +! {get a symbol to define} +fs1 ph4 sp if ((r0 = FindSymbol(sp)) != NULL) { + jsr FindSymbol + sta r0 + stx r0+2 + ora r0 + beq fs5 + ldy #symFile if (r0->symFile == fileNumber) + lda [r0],Y + cmp fileNumber + beq fs6 goto fs6; +fs2 ldy #symFile while (r0->symFile != fileNumber) { + lda [r0],Y + cmp fileNumber + beq fs4 +fs3 ldy #2 r0 = r0->symNext; + lda [r0] + tax + lda [r0],Y + sta r2 + stx r0 + ora r0 if (r0 == NULL) + beq fs5 goto fs5; + bra fs2 } +fs4 clc if (!Match(r0->symName,sp)) { + lda r0 + adc #symName + tax + lda r2 + adc #^symName + pha + phx + ph4 sp + jsr Match + tax + bne fs3 + rts r0 = r0->symNext; +! if (r0 == NULL) +! goto fs5; +! goto fs2; +! } +! } +! else +fs5 ph4 sp CreateSymbol(sp); + jsr CreateSymbol + sta r0 + stx r2 +fs6 ldy #symFlag set the pass 1 requested flag + lda [r0],Y + ora #pass1Requested + sta [r0],Y + rts + end + +**************************************************************** +* +* Reference2 - note that pass2 has requested a symbol +* +* Inputs: +* sp - pointer to the symbol name to reference +* +**************************************************************** +* +Reference2 start + using Common + using SymbolCommon + + ph4 sp r0 = FindSymbol(sp); + jsr FindSymbol + sta r0 + stx r2 + ldy #symFile if (r0->symFile != fileNumber) { + lda [r0],Y + cmp fileNumber + beq lb3 +lb1 ldy #symFile while (r0->symFile != fileNumber) { + lda [r0],Y + cmp fileNumber + beq lb2a +lb2 ldy #2 r0 = r0->symNext; + lda [r0],Y + tax + lda [r0] + sta r0 + stx r2 + bra lb1 +lb2a clc if (!Match(r0->symName,sp)) { + lda r0 + adc #symName + tax + lda r2 + adc #^symName + pha + phx + ph4 sp + jsr Match + tax + bne lb2 +! r0 = r0->symNext; +! goto lb1; +lb3 anop } + + ldy #symFlag set the pass 2 requested flag + lda [r0],Y + ora #pass2Requested + sta [r0],Y + rts + end + +**************************************************************** +* +* Unresolved - are there unresolved references? +* +* Inputs: +* pass - pass number +* +* Outputs: +* C - set if there are unresolved references, else clear +* +**************************************************************** +* +Unresolved start + using SymbolCommon + using Common + + lda pass if pass1 then + cmp #1 + bne lb1 + lda #pass1Resolved resolved = pass1Resolved + ldx #pass1Requested requested = pass1Requested + bra lb2 else +lb1 lda #pass2Resolved resolved = pass2Resolved + ldx #pass2Requested requested = pass2Requested +lb2 sta resolved endif + stx requested + + la index,hashSize*4-4 for each hash bucket do +lb3 ldx index for each symbol in the bucket do + lda table,X + sta r0 + sta r4 + lda table+2,X + sta r2 + sta r6 + ora r2 + beq lb7 +lb4 ldy #symFlag if r0^.symFlag & requested then + lda [r0],Y + bit requested + beq lb6 + bit resolved if not (r0^.symFlag & resolved) then + bne lb6 + ldy #symPriv if r0^.symPriv then + lda [r0] + beq lb5 + jsr GlobalExists if GlobalExists then + bcs lb6 skip request +lb5 sec return true + rts + +lb6 ldy #2 r0 = r0^.symNext + lda [r0],Y + tax + lda [r0] + sta r0 + stx r2 + ora r2 next symbol in bucket + bne lb4 +lb7 sec next bucket + lda index + sbc #4 + sta index + bpl lb3 + clc no symbols needed + rts +; +; GlobalExists - see if a global symbol by the name of r0^.symName exists +; +GlobalExists anop + + move4 r4,r8 r8 = first sym in bucket + add4 r0,#symName,r12 r12 = @r0^.symName +ge1 ldy #symPriv for each symbol do + lda [r8],Y if the symbol is global then + bne ge2 + clc if Match(r8^.symName,r12) then + lda r8 + adc #symName + tax + lda r10 + adc #^symName + pha + phx + ph4 r12 + jsr Match + tax + bne ge2 + sec return true + rts +ge2 ldy #2 next symbol + lda [r8],Y + tax + lda [r8] + sta r8 + stx r10 + ora r10 + bne ge1 + clc return false + rts +; +; Local data +; +index ds 2 index into the hash table +resolved ds 2 resolved mask for this pass +requested ds 2 requested mask for this pass + end diff --git a/symbol.mac b/symbol.mac old mode 100755 new mode 100644 index 773d315..f591199 --- a/symbol.mac +++ b/symbol.mac @@ -1 +1,745 @@ - macro &lab cmpl &n1,&n2 &lab lda 2+&n1 cmp 2+&n2 bne ~&syscnt lda &n1 cmp &n2 ~&syscnt anop mend MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND macro &lab sub &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta c:&parms .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+3+&work &totallen seta &totallen+&len &i seta &i-1 aif &i,^b .e tsc aif &work=0,.f sec sbc #&work tcs .f phd tcd mend macro &lab ret &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g ldy #&r ldx #^&r ago .h .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+1 sta &worklen+&totallen+1 .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rts mend MACRO &LAB MOVE &AD1,&AD2,&LEN &LAB ANOP LCLB &LA LCLB &LI LCLC &C AIF C:&LEN,.A1 LCLC &LEN &LEN SETC #2 .A1 &LA SETB S:LONGA &LI SETB S:LONGI AIF S:LONGA.AND.S:LONGI,.A REP #32*(.NOT.&LA)+16*(.NOT.&LI) LONGA ON LONGI ON .A &C AMID &LEN,1,1 AIF "&C"<>"#",.D &C AMID &LEN,2,L:&LEN-1 AIF &C<>2,.D &C AMID &AD1,1,1 AIF "&C"<>"{",.B &AD1 AMID &AD1,2,L:&AD1-2 &AD1 SETC (&AD1) .B LDA &AD1 &C AMID &AD2,1,1 AIF "&C"<>"{",.C &AD2 AMID &AD2,2,L:&AD2-2 &AD2 SETC (&AD2) .C STA &AD2 AGO .G .D &C AMID &AD1,1,1 AIF "&C"="#",.F &C AMID &LEN,1,1 AIF "&C"<>"{",.E &LEN AMID &LEN,2,L:&LEN-2 &LEN SETC (&LEN) .E &C AMID &LEN,1,1 AIF "&C"="#",.E1 LDA &LEN DEC A AGO .E2 .E1 LDA &LEN-1 .E2 LDX #&AD1 LDY #&AD2 MVN &AD1,&AD2 AGO .G .F LDA &AD1 STA &AD2 LDA &LEN-2 LDX #&AD2 LDY #&AD2+1 MVN &AD2,&AD2 .G AIF (&LA+&LI)=2,.I SEP #32*(.NOT.&LA)+16*(.NOT.&LI) AIF &LA,.H LONGA OFF .H AIF &LI,.I LONGI OFF .I MEND macro &l puts &n1,&f1,&cr,&errout &l ~setm lclc &c &c amid "&n1",1,1 aif "&c"<>"#",.c aif l:&n1>127,.a bra ~&SYSCNT ago .b .a brl ~&SYSCNT .b &n1 amid "&n1",2,l:&n1-1 ~l&SYSCNT dc i1"l:~s&SYSCNT" ~s&SYSCNT dc c&n1 ~&SYSCNT anop &n1 setc ~l&SYSCNT-1 .c ~pusha &n1 aif c:&f1,.c1 pea 0 ago .c2 .c1 ph2 &f1 .c2 ph2 #c:&cr ph2 #c:&errout jsl ~puts ~restm mend macro &l putc &n1,&f1,&cr,&errout lclc &f1 &f1 setc #0 .a &l ~setm ph2 &n1 aif c:&f1,.a pea 0 ago .b .a ph2 &f1 .b ph2 #c:&cr ph2 #c:&errout jsl ~putc ~restm mend macro &l putcr &errout &l ~setm pea $0D aif c:&errout,.a jsl SysCharOut ~restm mexit .a jsl SysCharErrout ~restm mend macro &l sub2 &n1,&n2,&n3 aif c:&n3,.a lclc &n3 &n3 setc &n1 .a &l ~setm sec ~lda &n1 ~op sbc,&n2 ~sta &n3 ~restm mend macro &l add4 &m1,&m2,&m3 lclb &yistwo lclc &c &l ~setm aif c:&m3,.a &c amid "&m2",1,1 aif "&c"<>"#",.a &c amid "&m1",1,1 aif "&c"="{",.a aif "&c"="[",.a &c amid "&m2",2,l:&m2-1 aif &c>=65536,.a clc ~lda &m1 ~op adc,&m2 ~sta &m1 bcc ~&SYSCNT ~op.h inc,&m1 ~&SYSCNT anop ago .c .a aif c:&m3,.b lclc &m3 &m3 setc &m1 .b clc ~lda &m1 ~op adc,&m2 ~sta &m3 ~lda.h &m1 ~op.h adc,&m2 ~sta.h &m3 .c ~restm mend macro &l sub4 &m1,&m2,&m3 lclb &yistwo lclc &c &l ~setm aif c:&m3,.a &c amid "&m2",1,1 aif "&c"<>"#",.a &c amid "&m1",1,1 aif "&c"="{",.a aif "&c"="[",.a &c amid "&m2",2,l:&m2-1 aif &c>=65536,.a sec ~lda &m1 ~op sbc,&m2 ~sta &m1 bcs ~&SYSCNT ~op.h dec,&m1 ~&SYSCNT anop ago .c .a aif c:&m3,.b lclc &m3 &m3 setc &m1 .b sec ~lda &m1 ~op sbc,&m2 ~sta &m3 ~lda.h &m1 ~op.h sbc,&m2 ~sta.h &m3 .c ~restm mend macro &l ble &bp &l blt &bp beq &bp mend macro &l jeq &bp &l bne *+5 brl &bp mend macro &l la &ad1,&ad2 &l anop lcla &lb lclb &la aif s:longa,.a rep #%00100000 longa on &la setb 1 .a lda #&ad2 &lb seta c:&ad1 .b sta &ad1(&lb) &lb seta &lb-1 aif &lb,^b aif &la=0,.d sep #%00100000 longa off .d mend macro &l long &a,&b lclb &i lclb &m &a amid &a,1,1 &m setb ("&a"="M").or.("&a"="m") &i setb ("&a"="I").or.("&a"="i") aif c:&b=0,.a &b amid &b,1,1 &m setb ("&b"="M").or.("&b"="m").or.&m &i setb ("&b"="I").or.("&b"="i").or.&i .a &l rep #&m*32+&i*16 aif .not.&m,.b longa on .b aif .not.&i,.c longi on .c mend macro &l ph2 &n1 &l anop aif "&n1"="*",.f lclc &c &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 lda (&n1) pha ago .e .b aif "&c"="<",.c lda &n1 pha ago .e .c &n1 amid &n1,2,l:&n1-1 pei &n1 ago .e .d &n1 amid &n1,2,l:&n1-1 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l ph4 &n1 &l anop aif "&n1"="*",.f lclc &c &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 ldy #2 lda (&n1),y pha lda (&n1) pha ago .e .b aif "&c"<>"[",.c ldy #2 lda &n1,y pha lda &n1 pha ago .e .c aif "&c"<>"<",.c1 &n1 amid &n1,2,l:&n1-1 pei &n1+2 pei &n1 ago .e .c1 lda &n1+2 pha lda &n1 pha ago .e .d &n1 amid &n1,2,l:&n1-1 pea +(&n1)|-16 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l pl2 &n1 lclc &c &l anop aif s:longa=1,.a rep #%00100000 .a &c amid &n1,1,1 aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.f &n1 amid &n1,2,l:&n1-2 pla sta (&n1) ago .d .b pla sta &n1 .d aif s:longa=1,.e sep #%00100000 .e mexit .f mnote "Missing closing '}'",16 mend macro &l pl4 &n1 lclc &c &l anop aif s:longa=1,.a rep #%00100000 .a &c amid &n1,1,1 aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.f &n1 amid &n1,2,l:&n1-2 pla sta (&n1) ldy #2 pla sta (&n1),y ago .d .b aif "&c"<>"[",.c pla sta &n1 ldy #2 pla sta &n1,y ago .d .c pla sta &n1 pla sta &n1+2 .d aif s:longa=1,.e sep #%00100000 .e mexit .f mnote "Missing closing '}'",16 mend macro &l short &a,&b lclb &i lclb &m &a amid &a,1,1 &m setb ("&a"="M").or.("&a"="m") &i setb ("&a"="I").or.("&a"="i") aif c:&b=0,.a &b amid &b,1,1 &m setb ("&b"="M").or.("&b"="m").or.&m &i setb ("&b"="I").or.("&b"="i").or.&i .a &l sep #&m*32+&i*16 aif .not.&m,.b longa off .b aif .not.&i,.c longi off .c mend macro &l ~lda &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l lda &op mend macro &l ~lda.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" lda &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" lda &op mexit .e lda 2+&op mend macro &l ~op &opc,&op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l &opc &op mend macro &l ~op.h &opc,&op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" &opc &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" &opc &op mexit .e &opc 2+&op mend macro &l ~pusha &n1 lclc &c &l anop &c amid &n1,1,1 aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 sep #$20 longa off lda #0 pha rep #$20 longa on phk lda &n1 pha mexit .b aif "&c"<>"[",.c &n1 amid &n1,2,l:&n1-2 lda &n1+2 pha lda &n1 pha mexit .c pea +(&n1)|-16 pea &n1 mexit .g mnote "Missing closing '}'",16 mend macro &l ~restm &l anop aif (&~la+&~li)=2,.i sep #32*(.not.&~la)+16*(.not.&~li) aif &~la,.h longa off .h aif &~li,.i longi off .i mend macro &l ~setm &l anop aif c:&~la,.b gblb &~la gblb &~li .b &~la setb s:longa &~li setb s:longi aif s:longa.and.s:longi,.a rep #32*(.not.&~la)+16*(.not.&~li) longa on longi on .a mend macro &l ~sta &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l sta &op mend macro &l ~sta.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" sta &op mexit .d sta 2+&op mend \ No newline at end of file + macro +&lab cmpl &n1,&n2 +&lab lda 2+&n1 + cmp 2+&n2 + bne ~&syscnt + lda &n1 + cmp &n2 +~&syscnt anop + mend + MACRO +&LAB MOVE4 &F,&T +&LAB ~SETM + LDA 2+&F + STA 2+&T + LDA &F + STA &T + ~RESTM + MEND + macro +&lab sub &parms,&work +&lab anop + aif c:&work,.a + lclc &work +&work setc 0 +.a + gbla &totallen + gbla &worklen +&worklen seta &work +&totallen seta 0 + aif c:&parms=0,.e + lclc &len + lclc &p + lcla &i +&i seta c:&parms +.b +&p setc &parms(&i) +&len amid &p,2,1 + aif "&len"=":",.c +&len amid &p,1,2 +&p amid &p,4,l:&p-3 + ago .d +.c +&len amid &p,1,1 +&p amid &p,3,l:&p-2 +.d +&p equ &totallen+3+&work +&totallen seta &totallen+&len +&i seta &i-1 + aif &i,^b +.e + tsc + aif &work=0,.f + sec + sbc #&work + tcs +.f + phd + tcd + mend + macro +&lab ret &r +&lab anop + lclc &len + aif c:&r,.a + lclc &r +&r setc 0 +&len setc 0 + ago .h +.a +&len amid &r,2,1 + aif "&len"=":",.b +&len amid &r,1,2 +&r amid &r,4,l:&r-3 + ago .c +.b +&len amid &r,1,1 +&r amid &r,3,l:&r-2 +.c + aif &len<>2,.d + ldy &r + ago .h +.d + aif &len<>4,.e + ldx &r+2 + ldy &r + ago .h +.e + aif &len<>10,.g + ldy #&r + ldx #^&r + ago .h +.g + mnote 'Not a valid return length',16 + mexit +.h + aif &totallen=0,.i + lda &worklen+1 + sta &worklen+&totallen+1 +.i + pld + tsc + clc + adc #&worklen+&totallen + tcs + aif &len=0,.j + tya +.j + rts + mend + MACRO +&LAB MOVE &AD1,&AD2,&LEN +&LAB ANOP + LCLB &LA + LCLB &LI + LCLC &C + AIF C:&LEN,.A1 + LCLC &LEN +&LEN SETC #2 +.A1 +&LA SETB S:LONGA +&LI SETB S:LONGI + AIF S:LONGA.AND.S:LONGI,.A + REP #32*(.NOT.&LA)+16*(.NOT.&LI) + LONGA ON + LONGI ON +.A +&C AMID &LEN,1,1 + AIF "&C"<>"#",.D +&C AMID &LEN,2,L:&LEN-1 + AIF &C<>2,.D +&C AMID &AD1,1,1 + AIF "&C"<>"{",.B +&AD1 AMID &AD1,2,L:&AD1-2 +&AD1 SETC (&AD1) +.B + LDA &AD1 +&C AMID &AD2,1,1 + AIF "&C"<>"{",.C +&AD2 AMID &AD2,2,L:&AD2-2 +&AD2 SETC (&AD2) +.C + STA &AD2 + AGO .G +.D +&C AMID &AD1,1,1 + AIF "&C"="#",.F +&C AMID &LEN,1,1 + AIF "&C"<>"{",.E +&LEN AMID &LEN,2,L:&LEN-2 +&LEN SETC (&LEN) +.E +&C AMID &LEN,1,1 + AIF "&C"="#",.E1 + LDA &LEN + DEC A + AGO .E2 +.E1 + LDA &LEN-1 +.E2 + LDX #&AD1 + LDY #&AD2 + MVN &AD1,&AD2 + AGO .G +.F + LDA &AD1 + STA &AD2 + LDA &LEN-2 + LDX #&AD2 + LDY #&AD2+1 + MVN &AD2,&AD2 +.G + AIF (&LA+&LI)=2,.I + SEP #32*(.NOT.&LA)+16*(.NOT.&LI) + AIF &LA,.H + LONGA OFF +.H + AIF &LI,.I + LONGI OFF +.I + MEND + macro +&l puts &n1,&f1,&cr,&errout +&l ~setm + lclc &c +&c amid "&n1",1,1 + aif "&c"<>"#",.c + aif l:&n1>127,.a + bra ~&SYSCNT + ago .b +.a + brl ~&SYSCNT +.b +&n1 amid "&n1",2,l:&n1-1 +~l&SYSCNT dc i1"l:~s&SYSCNT" +~s&SYSCNT dc c&n1 +~&SYSCNT anop +&n1 setc ~l&SYSCNT-1 +.c + ~pusha &n1 + aif c:&f1,.c1 + pea 0 + ago .c2 +.c1 + ph2 &f1 +.c2 + ph2 #c:&cr + ph2 #c:&errout + jsl ~puts + ~restm + mend + macro +&l putc &n1,&f1,&cr,&errout + lclc &f1 +&f1 setc #0 +.a +&l ~setm + ph2 &n1 + aif c:&f1,.a + pea 0 + ago .b +.a + ph2 &f1 +.b + ph2 #c:&cr + ph2 #c:&errout + jsl ~putc + ~restm + mend + macro +&l putcr &errout +&l ~setm + pea $0D + aif c:&errout,.a + jsl SysCharOut + ~restm + mexit +.a + jsl SysCharErrout + ~restm + mend + macro +&l sub2 &n1,&n2,&n3 + aif c:&n3,.a + lclc &n3 +&n3 setc &n1 +.a +&l ~setm + sec + ~lda &n1 + ~op sbc,&n2 + ~sta &n3 + ~restm + mend + macro +&l add4 &m1,&m2,&m3 + lclb &yistwo + lclc &c +&l ~setm + aif c:&m3,.a +&c amid "&m2",1,1 + aif "&c"<>"#",.a +&c amid "&m1",1,1 + aif "&c"="{",.a + aif "&c"="[",.a +&c amid "&m2",2,l:&m2-1 + aif &c>=65536,.a + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m1 + bcc ~&SYSCNT + ~op.h inc,&m1 +~&SYSCNT anop + ago .c +.a + aif c:&m3,.b + lclc &m3 +&m3 setc &m1 +.b + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m3 + ~lda.h &m1 + ~op.h adc,&m2 + ~sta.h &m3 +.c + ~restm + mend + macro +&l sub4 &m1,&m2,&m3 + lclb &yistwo + lclc &c +&l ~setm + aif c:&m3,.a +&c amid "&m2",1,1 + aif "&c"<>"#",.a +&c amid "&m1",1,1 + aif "&c"="{",.a + aif "&c"="[",.a +&c amid "&m2",2,l:&m2-1 + aif &c>=65536,.a + sec + ~lda &m1 + ~op sbc,&m2 + ~sta &m1 + bcs ~&SYSCNT + ~op.h dec,&m1 +~&SYSCNT anop + ago .c +.a + aif c:&m3,.b + lclc &m3 +&m3 setc &m1 +.b + sec + ~lda &m1 + ~op sbc,&m2 + ~sta &m3 + ~lda.h &m1 + ~op.h sbc,&m2 + ~sta.h &m3 +.c + ~restm + mend + macro +&l ble &bp +&l blt &bp + beq &bp + mend + macro +&l jeq &bp +&l bne *+5 + brl &bp + mend + macro +&l la &ad1,&ad2 +&l anop + lcla &lb + lclb &la + aif s:longa,.a + rep #%00100000 + longa on +&la setb 1 +.a + lda #&ad2 +&lb seta c:&ad1 +.b + sta &ad1(&lb) +&lb seta &lb-1 + aif &lb,^b + aif &la=0,.d + sep #%00100000 + longa off +.d + mend + macro +&l long &a,&b + lclb &i + lclb &m +&a amid &a,1,1 +&m setb ("&a"="M").or.("&a"="m") +&i setb ("&a"="I").or.("&a"="i") + aif c:&b=0,.a +&b amid &b,1,1 +&m setb ("&b"="M").or.("&b"="m").or.&m +&i setb ("&b"="I").or.("&b"="i").or.&i +.a +&l rep #&m*32+&i*16 + aif .not.&m,.b + longa on +.b + aif .not.&i,.c + longi on +.c + mend + macro +&l ph2 &n1 +&l anop + aif "&n1"="*",.f + lclc &c +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + lda (&n1) + pha + ago .e +.b + aif "&c"="<",.c + lda &n1 + pha + ago .e +.c +&n1 amid &n1,2,l:&n1-1 + pei &n1 + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l ph4 &n1 +&l anop + aif "&n1"="*",.f + lclc &c +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + ldy #2 + lda (&n1),y + pha + lda (&n1) + pha + ago .e +.b + aif "&c"<>"[",.c + ldy #2 + lda &n1,y + pha + lda &n1 + pha + ago .e +.c + aif "&c"<>"<",.c1 +&n1 amid &n1,2,l:&n1-1 + pei &n1+2 + pei &n1 + ago .e +.c1 + lda &n1+2 + pha + lda &n1 + pha + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea +(&n1)|-16 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l pl2 &n1 + lclc &c +&l anop + aif s:longa=1,.a + rep #%00100000 +.a +&c amid &n1,1,1 + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.f +&n1 amid &n1,2,l:&n1-2 + pla + sta (&n1) + ago .d +.b + pla + sta &n1 +.d + aif s:longa=1,.e + sep #%00100000 +.e + mexit +.f + mnote "Missing closing '}'",16 + mend + macro +&l pl4 &n1 + lclc &c +&l anop + aif s:longa=1,.a + rep #%00100000 +.a +&c amid &n1,1,1 + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.f +&n1 amid &n1,2,l:&n1-2 + pla + sta (&n1) + ldy #2 + pla + sta (&n1),y + ago .d +.b + aif "&c"<>"[",.c + pla + sta &n1 + ldy #2 + pla + sta &n1,y + ago .d +.c + pla + sta &n1 + pla + sta &n1+2 +.d + aif s:longa=1,.e + sep #%00100000 +.e + mexit +.f + mnote "Missing closing '}'",16 + mend + macro +&l short &a,&b + lclb &i + lclb &m +&a amid &a,1,1 +&m setb ("&a"="M").or.("&a"="m") +&i setb ("&a"="I").or.("&a"="i") + aif c:&b=0,.a +&b amid &b,1,1 +&m setb ("&b"="M").or.("&b"="m").or.&m +&i setb ("&b"="I").or.("&b"="i").or.&i +.a +&l sep #&m*32+&i*16 + aif .not.&m,.b + longa off +.b + aif .not.&i,.c + longi off +.c + mend + macro +&l ~lda &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l lda &op + mend + macro +&l ~lda.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + lda &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + lda &op + mexit +.e + lda 2+&op + mend + macro +&l ~op &opc,&op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l &opc &op + mend + macro +&l ~op.h &opc,&op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + &opc &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + &opc &op + mexit +.e + &opc 2+&op + mend + macro +&l ~pusha &n1 + lclc &c +&l anop +&c amid &n1,1,1 + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + sep #$20 + longa off + lda #0 + pha + rep #$20 + longa on + phk + lda &n1 + pha + mexit +.b + aif "&c"<>"[",.c +&n1 amid &n1,2,l:&n1-2 + lda &n1+2 + pha + lda &n1 + pha + mexit +.c + pea +(&n1)|-16 + pea &n1 + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l ~restm +&l anop + aif (&~la+&~li)=2,.i + sep #32*(.not.&~la)+16*(.not.&~li) + aif &~la,.h + longa off +.h + aif &~li,.i + longi off +.i + mend + macro +&l ~setm +&l anop + aif c:&~la,.b + gblb &~la + gblb &~li +.b +&~la setb s:longa +&~li setb s:longi + aif s:longa.and.s:longi,.a + rep #32*(.not.&~la)+16*(.not.&~li) + longa on + longi on +.a + mend + macro +&l ~sta &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l sta &op + mend + macro +&l ~sta.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + sta &op + mexit +.d + sta 2+&op + mend diff --git a/util.asm b/util.asm old mode 100755 new mode 100644 index 63a0526..46772b7 --- a/util.asm +++ b/util.asm @@ -1 +1,511 @@ - keep obj/util mcopy util.mac **************************************************************** * * Util * * This module contains general purpose utility subroutines * used throughout the editor. It also contains utility * subroutines used by both linker passes. * **************************************************************** copy directPage **************************************************************** * * CheckAlign - make sure the alignment is a power of 2 * * Inputs: * align - alignment factor * **************************************************************** * CheckAlign start count equ 1 bit count sub (4:align),2 stz count count the bits ldx #16 lb1 lsr align+2 ror align bcc lb2 inc count lb2 dex bne lb1 lda count if count <> 1 then cmp #1 beq lb3 ph4 #0 flag the error ph2 #23 jsr Error lb3 ret end **************************************************************** * * Error - Writes segment error messages * * Inputs: * name - pointer to the symbol name; nil for none * num - error number * **************************************************************** * Error start using Common temp equ 1 temp work number lpc equ 5 local copy of the program counter sub (4:name,2:num),8 ldx dpReg get the program counter lda >pc,X sta lpc lda >pc+2,X sta lpc+2 inc numError up the error count lda list bne lb1 putcr errout=t lb1 puts #'Error at ',errout=t print error info sub4 lpc,startpc,temp ph4 temp ph2 #8 ph2 #1 jsr PrintHex puts #' past ',errout=t sub4 segName,#1,temp puts [temp],errout=t puts #' PC = ',errout=t ph4 lpc ph2 #8 ph2 #1 jsr PrintHex puts #' : ',errout=t ldx num set the error level lda erLev-1,X and #$00FF cmp merrf blt ls3 sta merrf ls3 lda num write the error message dec A asl A tax lda erAdr,X sta temp lda #^er1 sta temp+2 puts [temp],errout=t lda name print segment name if any ora name+2 beq ls6 ldx num cpx #8 bne ls4 puts #' Data area: ',errout=t bra ls5 ls4 puts #' Label: ',errout=t ls5 sub4 name,#1,temp puts [temp],errout=t ls6 putcr errout=t lda pause see if we need to pause on error beq ls7 jsr Wait ls7 ret ; ; Local data ; erLev dc I1'8,16,16,2' dc I1'16,8,16,2' dc I1'8,8,8,4' dc I1'4,16,2,8' dc I1'8,4,4,8' dc I1'8,8,8,8' erAdr dc a'er1-1' dc a'er2-1' dc a'er3-1' dc a'er4-1' ds 2 dc a'er6-1' dc a'er7-1' dc a'er8-1' dc a'er9-1' dc a'er10-1' dc a'er11-1' dc a'er12-1' dc a'er13-1' ds 2 dc a'er15-1' dc a'er16-1' dc a'er17-1' dc a'er18-1' dc a'er19-1' dc a'er20-1' dc a'er21-1' dc a'er22-1' dc a'er23-1' dc a'er24-1' er1 dw 'Duplicate label' er2 dw 'Illegal shift operator' er3 dw 'ORG location has been passed' er4 dw 'Duplicate segment' er6 dw 'Unresolved reference' er7 dw 'Addressing error' er8 dw 'Data area not found' er9 dw 'Address is not in zero page' er10 dw 'Address is not in current bank' er11 dw 'Relative address out of range' er12 dw 'Temporg not supported' er13 dw 'Illegal {KeepType} shell variable' er15 dw 'Segment types conflict' er16 dw 'Invalid operation on relocatable expression' er17 dw 'Only JSL can reference dynamic segment' er18 dw 'Code exceeds code bank size' er19 dw 'Illegal {AuxType} shell variable' er20 dw 'Shift operator is not allowed on JSL to dynamic segment' er21 dw 'Alignment and ORG conflict' er22 dw 'Alignment factor must not exceed segment align factor' er23 dw 'Alignment factor must be a power of two' er24 dw 'Expression operand is not in same segment' end **************************************************************** * * Free - free memory allocated by Malloc * * Inputs: * ptr - address of the parameter block * * Notes: * No action is taken if a nil pointer is passed. * * This subroutine must be called in long mode. * **************************************************************** * Free start sub (4:ptr),0 lda ptr ora ptr+2 beq rts pha pha ph4 ptr _FindHandle _DisposeHandle rts ret end **************************************************************** * * MLalloc - allocate memory * * Inputs: * len - # of bytes to allocate * * Outputs: * X-A - pointer to allocated memory * * Notes: * Flags a terminal error and quits if there is not * emough memory. * * This subroutine must be called in long mode. * **************************************************************** * MLalloc start using Common ptr equ 1 pointer to memory hand equ 5 handle of memory sub (4:len),8 pha reserve the memory pha ph4 len ph2 userID ph2 #$C010 ph4 #0 _NewHandle pl4 hand pull the handle bcc lb1 branch if there was an error lda #5 jmp TermError lb1 ldy #2 dereference the handle lda [hand],Y sta ptr+2 lda [hand] sta ptr ret 4:ptr return end **************************************************************** * * CheckForPause - pause if a key was pressed; check for abort * **************************************************************** * CheckForPause start using Common short I,M lda >keyboard see if we need to pause bpl no branch if not sta >strobe yes - clear strobe and #$7F cmp #'.' quit if is an open apple . bne lb1 lda >kflags bmi yes lb1 lda >keyboard wait for keypress bpl lb1 sta >strobe and #$7F cmp #'.' quit if is an open apple . bne no lda >kflags bmi yes no long I,M rts yes long I,M quit lda #15 jmp TermError end **************************************************************** * * PrintHex - print a hex number * * Inputs: * val - hex value * digits - number of digits to print * errout - error out flag * **************************************************************** * PrintHex start temp equ 1 temp work value sub (4:val,2:digits,2:errout),4 lda digits if digits <> 1 then cmp #1 beq lb1 move4 val,temp PrintHex(val>>4, digits-1) lsr temp+2 ror temp lsr temp+2 ror temp lsr temp+2 ror temp lsr temp+2 ror temp ph4 temp lda digits dec A pha ph2 errout jsr PrintHex lb1 lda val print a hex digit and #$000F ora #'0' cmp #'9'+1 blt lb2 adc #6 lb2 sta temp lda errout bne lb3 putc temp bra lb4 lb3 putc temp,errout=t lb4 anop ret end **************************************************************** * * PrintOSString - print an os string * * Inputs: * ptr - pointer to the string * errout - error output flag * **************************************************************** * PrintOSString start loop equ 1 loop counter char equ 3 character to write sub (4:ptr,2:errout),4 lda ptr ora ptr+2 beq lb4 lda [ptr] beq lb4 sta loop add4 ptr,#2 lb1 lda [ptr] sta char lda errout bne lb2 putc char bra lb3 lb2 putc char,errout=t lb3 inc4 ptr dec loop bne lb1 lb4 ret end **************************************************************** * * TermError - handle a terminal error * * Inputs: * A - error number * fname - file name (used for file errors) * * 1: Could not open file * 2: Must be an object file: * 3: Linker version misatch * 4: Illegal header value in * 5: Out of memory * 6: File read error: * 7: Could not overwrite existing file: * 8: Undefined opcode in * 9: Expression too complex in * 10: Could not find library header in * 11: Invalid dictionary in * 12: File write error * 13: Only one script file is allowed * 14: Script error: link aborted * 15: Stopped by open-apple . * **************************************************************** * TermError start using Common pha print the message leader puts #'Terminal error: ',errout=t lda dpReg restore the default DP register tcd lda 1,S print the message asl A tax lda #^msg pha lda msg-2,X pha ph2 #1 jsr PrintOSString plx if needed, print the file name lda needFname-1,X and #$00FF beq lb1 ph4 fname ph2 #1 jsr PrintOSString lb1 putcr errout=t stz lops set lops to 0 lda #127 set max error found to 127 sta merrf lda Sreg restore the original stack reg tcs jmp exit exit ; ; Local data ; msg dc a'e1,e2,e3,e4,e5,e6,e7,e8,e9,e10,e11,e12,e13,e14,e15' e1 dos 'Could not open file ' e2 dos 'Must be an object file: ' e3 dos 'Linker version misatch' e4 dos 'Illegal header value in ' e5 dos 'Out of memory' e6 dos 'File read error: ' e7 dos 'Could not overwrite existing file' e8 dos 'Undefined opcode in ' e9 dos 'Expression too complex in ' e10 dos 'Could not find library header in ' e11 dos 'Invalid dictionary in ' e12 dos 'File write error' e13 dos 'Only one script file is allowed' e14 dos 'Script error: link aborted' e15 dos 'Stopped by open-apple .' needFname dc i1'1,1,0,1,0,1,0,1,1,1,1,0,0,0,0' end **************************************************************** * * ToUpper - Convert to Upper-case * * Inputs: * A - character to shift * * Outputs: * A - upper-case character * * Notes: * This subroutine can be called in long or short mode. * **************************************************************** * ToUpper start php long M and #$00FF cmp #'a' blt rts cmp #'z'+1 bge rts adc #'A'-'a' rts plp rts end **************************************************************** * * Wait - Wait for a keypress * * Notes: * Quits if the user presses open-apple . * **************************************************************** * Wait start using Common short I,M wa1 lda >keyboard wait for keypress bpl wa1 sta >strobe and #$7F cmp #'.' quit if is an open apple . bne wa2 lda >kflags bmi abort wa2 long I,M rts abort long I,M lda #15 jmp TermError end \ No newline at end of file + keep obj/util + mcopy util.mac +**************************************************************** +* +* Util +* +* This module contains general purpose utility subroutines +* used throughout the editor. It also contains utility +* subroutines used by both linker passes. +* +**************************************************************** + copy directPage +**************************************************************** +* +* CheckAlign - make sure the alignment is a power of 2 +* +* Inputs: +* align - alignment factor +* +**************************************************************** +* +CheckAlign start +count equ 1 bit count + + sub (4:align),2 + + stz count count the bits + ldx #16 +lb1 lsr align+2 + ror align + bcc lb2 + inc count +lb2 dex + bne lb1 + lda count if count <> 1 then + cmp #1 + beq lb3 + ph4 #0 flag the error + ph2 #23 + jsr Error + +lb3 ret + end + +**************************************************************** +* +* Error - Writes segment error messages +* +* Inputs: +* name - pointer to the symbol name; nil for none +* num - error number +* +**************************************************************** +* +Error start + using Common +temp equ 1 temp work number +lpc equ 5 local copy of the program counter + + sub (4:name,2:num),8 + + ldx dpReg get the program counter + lda >pc,X + sta lpc + lda >pc+2,X + sta lpc+2 + inc numError up the error count + lda list + bne lb1 + putcr errout=t +lb1 puts #'Error at ',errout=t print error info + sub4 lpc,startpc,temp + ph4 temp + ph2 #8 + ph2 #1 + jsr PrintHex + puts #' past ',errout=t + sub4 segName,#1,temp + puts [temp],errout=t + puts #' PC = ',errout=t + ph4 lpc + ph2 #8 + ph2 #1 + jsr PrintHex + puts #' : ',errout=t + + ldx num set the error level + lda erLev-1,X + and #$00FF + cmp merrf + blt ls3 + sta merrf +ls3 lda num write the error message + dec A + asl A + tax + lda erAdr,X + sta temp + lda #^er1 + sta temp+2 + puts [temp],errout=t + lda name print segment name if any + ora name+2 + beq ls6 + ldx num + cpx #8 + bne ls4 + puts #' Data area: ',errout=t + bra ls5 +ls4 puts #' Label: ',errout=t +ls5 sub4 name,#1,temp + puts [temp],errout=t +ls6 putcr errout=t + lda pause see if we need to pause on error + beq ls7 + jsr Wait +ls7 ret +; +; Local data +; +erLev dc I1'8,16,16,2' + dc I1'16,8,16,2' + dc I1'8,8,8,4' + dc I1'4,16,2,8' + dc I1'8,4,4,8' + dc I1'8,8,8,8' + +erAdr dc a'er1-1' + dc a'er2-1' + dc a'er3-1' + dc a'er4-1' + ds 2 + dc a'er6-1' + dc a'er7-1' + dc a'er8-1' + dc a'er9-1' + dc a'er10-1' + dc a'er11-1' + dc a'er12-1' + dc a'er13-1' + ds 2 + dc a'er15-1' + dc a'er16-1' + dc a'er17-1' + dc a'er18-1' + dc a'er19-1' + dc a'er20-1' + dc a'er21-1' + dc a'er22-1' + dc a'er23-1' + dc a'er24-1' + +er1 dw 'Duplicate label' +er2 dw 'Illegal shift operator' +er3 dw 'ORG location has been passed' +er4 dw 'Duplicate segment' +er6 dw 'Unresolved reference' +er7 dw 'Addressing error' +er8 dw 'Data area not found' +er9 dw 'Address is not in zero page' +er10 dw 'Address is not in current bank' +er11 dw 'Relative address out of range' +er12 dw 'Temporg not supported' +er13 dw 'Illegal {KeepType} shell variable' +er15 dw 'Segment types conflict' +er16 dw 'Invalid operation on relocatable expression' +er17 dw 'Only JSL can reference dynamic segment' +er18 dw 'Code exceeds code bank size' +er19 dw 'Illegal {AuxType} shell variable' +er20 dw 'Shift operator is not allowed on JSL to dynamic segment' +er21 dw 'Alignment and ORG conflict' +er22 dw 'Alignment factor must not exceed segment align factor' +er23 dw 'Alignment factor must be a power of two' +er24 dw 'Expression operand is not in same segment' + end + +**************************************************************** +* +* Free - free memory allocated by Malloc +* +* Inputs: +* ptr - address of the parameter block +* +* Notes: +* No action is taken if a nil pointer is passed. +* +* This subroutine must be called in long mode. +* +**************************************************************** +* +Free start + + sub (4:ptr),0 + + lda ptr + ora ptr+2 + beq rts + pha + pha + ph4 ptr + _FindHandle + _DisposeHandle +rts ret + end + +**************************************************************** +* +* MLalloc - allocate memory +* +* Inputs: +* len - # of bytes to allocate +* +* Outputs: +* X-A - pointer to allocated memory +* +* Notes: +* Flags a terminal error and quits if there is not +* emough memory. +* +* This subroutine must be called in long mode. +* +**************************************************************** +* +MLalloc start + using Common +ptr equ 1 pointer to memory +hand equ 5 handle of memory + + sub (4:len),8 + + pha reserve the memory + pha + ph4 len + ph2 userID + ph2 #$C010 + ph4 #0 + _NewHandle + pl4 hand pull the handle + bcc lb1 branch if there was an error + lda #5 + jmp TermError +lb1 ldy #2 dereference the handle + lda [hand],Y + sta ptr+2 + lda [hand] + sta ptr + + ret 4:ptr return + end + +**************************************************************** +* +* CheckForPause - pause if a key was pressed; check for abort +* +**************************************************************** +* +CheckForPause start + using Common + + short I,M + lda >keyboard see if we need to pause + bpl no branch if not + sta >strobe yes - clear strobe + and #$7F + cmp #'.' quit if is an open apple . + bne lb1 + lda >kflags + bmi yes + +lb1 lda >keyboard wait for keypress + bpl lb1 + sta >strobe + and #$7F + cmp #'.' quit if is an open apple . + bne no + lda >kflags + bmi yes +no long I,M + rts + +yes long I,M quit + lda #15 + jmp TermError + end + +**************************************************************** +* +* PrintHex - print a hex number +* +* Inputs: +* val - hex value +* digits - number of digits to print +* errout - error out flag +* +**************************************************************** +* +PrintHex start +temp equ 1 temp work value + + sub (4:val,2:digits,2:errout),4 + + lda digits if digits <> 1 then + cmp #1 + beq lb1 + move4 val,temp PrintHex(val>>4, digits-1) + lsr temp+2 + ror temp + lsr temp+2 + ror temp + lsr temp+2 + ror temp + lsr temp+2 + ror temp + ph4 temp + lda digits + dec A + pha + ph2 errout + jsr PrintHex +lb1 lda val print a hex digit + and #$000F + ora #'0' + cmp #'9'+1 + blt lb2 + adc #6 +lb2 sta temp + lda errout + bne lb3 + putc temp + bra lb4 +lb3 putc temp,errout=t +lb4 anop + + ret + end + +**************************************************************** +* +* PrintOSString - print an os string +* +* Inputs: +* ptr - pointer to the string +* errout - error output flag +* +**************************************************************** +* +PrintOSString start +loop equ 1 loop counter +char equ 3 character to write + + sub (4:ptr,2:errout),4 + + lda ptr + ora ptr+2 + beq lb4 + lda [ptr] + beq lb4 + sta loop + add4 ptr,#2 + +lb1 lda [ptr] + sta char + lda errout + bne lb2 + putc char + bra lb3 +lb2 putc char,errout=t +lb3 inc4 ptr + dec loop + bne lb1 + +lb4 ret + end + +**************************************************************** +* +* TermError - handle a terminal error +* +* Inputs: +* A - error number +* fname - file name (used for file errors) +* +* 1: Could not open file +* 2: Must be an object file: +* 3: Linker version misatch +* 4: Illegal header value in +* 5: Out of memory +* 6: File read error: +* 7: Could not overwrite existing file: +* 8: Undefined opcode in +* 9: Expression too complex in +* 10: Could not find library header in +* 11: Invalid dictionary in +* 12: File write error +* 13: Only one script file is allowed +* 14: Script error: link aborted +* 15: Stopped by open-apple . +* +**************************************************************** +* +TermError start + using Common + + pha print the message leader + puts #'Terminal error: ',errout=t + lda dpReg restore the default DP register + tcd + lda 1,S print the message + asl A + tax + lda #^msg + pha + lda msg-2,X + pha + ph2 #1 + jsr PrintOSString + plx if needed, print the file name + lda needFname-1,X + and #$00FF + beq lb1 + ph4 fname + ph2 #1 + jsr PrintOSString +lb1 putcr errout=t + stz lops set lops to 0 + lda #127 set max error found to 127 + sta merrf + lda Sreg restore the original stack reg + tcs + jmp exit exit +; +; Local data +; +msg dc a'e1,e2,e3,e4,e5,e6,e7,e8,e9,e10,e11,e12,e13,e14,e15' + +e1 dos 'Could not open file ' +e2 dos 'Must be an object file: ' +e3 dos 'Linker version misatch' +e4 dos 'Illegal header value in ' +e5 dos 'Out of memory' +e6 dos 'File read error: ' +e7 dos 'Could not overwrite existing file' +e8 dos 'Undefined opcode in ' +e9 dos 'Expression too complex in ' +e10 dos 'Could not find library header in ' +e11 dos 'Invalid dictionary in ' +e12 dos 'File write error' +e13 dos 'Only one script file is allowed' +e14 dos 'Script error: link aborted' +e15 dos 'Stopped by open-apple .' + +needFname dc i1'1,1,0,1,0,1,0,1,1,1,1,0,0,0,0' + end + +**************************************************************** +* +* ToUpper - Convert to Upper-case +* +* Inputs: +* A - character to shift +* +* Outputs: +* A - upper-case character +* +* Notes: +* This subroutine can be called in long or short mode. +* +**************************************************************** +* +ToUpper start + + php + long M + and #$00FF + cmp #'a' + blt rts + cmp #'z'+1 + bge rts + adc #'A'-'a' +rts plp + rts + end + +**************************************************************** +* +* Wait - Wait for a keypress +* +* Notes: +* Quits if the user presses open-apple . +* +**************************************************************** +* +Wait start + using Common + + short I,M +wa1 lda >keyboard wait for keypress + bpl wa1 + sta >strobe + and #$7F + cmp #'.' quit if is an open apple . + bne wa2 + lda >kflags + bmi abort +wa2 long I,M + rts + +abort long I,M + lda #15 + jmp TermError + end diff --git a/util.mac b/util.mac old mode 100755 new mode 100644 index 3b6a88d..5489387 --- a/util.mac +++ b/util.mac @@ -1 +1,628 @@ - MACRO &LAB DOS &ADR &LAB DC I"L:~&SYSNAME&SYSCNT" ~&SYSNAME&SYSCNT DC C"&ADR" MEND MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND macro &lab sub &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta c:&parms .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+3+&work &totallen seta &totallen+&len &i seta &i-1 aif &i,^b .e tsc aif &work=0,.f sec sbc #&work tcs .f phd tcd mend macro &lab ret &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g ldy #&r ldx #^&r ago .h .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+1 sta &worklen+&totallen+1 .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rts mend macro &l puts &n1,&f1,&cr,&errout &l ~setm lclc &c &c amid "&n1",1,1 aif "&c"<>"#",.c aif l:&n1>127,.a bra ~&SYSCNT ago .b .a brl ~&SYSCNT .b &n1 amid "&n1",2,l:&n1-1 ~l&SYSCNT dc i1"l:~s&SYSCNT" ~s&SYSCNT dc c&n1 ~&SYSCNT anop &n1 setc ~l&SYSCNT-1 .c ~pusha &n1 aif c:&f1,.c1 pea 0 ago .c2 .c1 ph2 &f1 .c2 ph2 #c:&cr ph2 #c:&errout jsl ~puts ~restm mend macro &l putc &n1,&f1,&cr,&errout lclc &f1 &f1 setc #0 .a &l ~setm ph2 &n1 aif c:&f1,.a pea 0 ago .b .a ph2 &f1 .b ph2 #c:&cr ph2 #c:&errout jsl ~putc ~restm mend macro &l putcr &errout &l ~setm pea $0D aif c:&errout,.a jsl SysCharOut ~restm mexit .a jsl SysCharErrout ~restm mend macro &l add4 &m1,&m2,&m3 lclb &yistwo lclc &c &l ~setm aif c:&m3,.a &c amid "&m2",1,1 aif "&c"<>"#",.a &c amid "&m1",1,1 aif "&c"="{",.a aif "&c"="[",.a &c amid "&m2",2,l:&m2-1 aif &c>=65536,.a clc ~lda &m1 ~op adc,&m2 ~sta &m1 bcc ~&SYSCNT ~op.h inc,&m1 ~&SYSCNT anop ago .c .a aif c:&m3,.b lclc &m3 &m3 setc &m1 .b clc ~lda &m1 ~op adc,&m2 ~sta &m3 ~lda.h &m1 ~op.h adc,&m2 ~sta.h &m3 .c ~restm mend macro &l sub4 &m1,&m2,&m3 lclb &yistwo lclc &c &l ~setm aif c:&m3,.a &c amid "&m2",1,1 aif "&c"<>"#",.a &c amid "&m1",1,1 aif "&c"="{",.a aif "&c"="[",.a &c amid "&m2",2,l:&m2-1 aif &c>=65536,.a sec ~lda &m1 ~op sbc,&m2 ~sta &m1 bcs ~&SYSCNT ~op.h dec,&m1 ~&SYSCNT anop ago .c .a aif c:&m3,.b lclc &m3 &m3 setc &m1 .b sec ~lda &m1 ~op sbc,&m2 ~sta &m3 ~lda.h &m1 ~op.h sbc,&m2 ~sta.h &m3 .c ~restm mend macro &l dw &adr &l dc i1"l:~&SYSNAME&SYSCNT" ~&SYSNAME&SYSCNT dc c"&adr" mend macro &l inc4 &a &l ~setm inc &a bne ~&SYSCNT inc 2+&a ~&SYSCNT ~restm mend macro &l long &a,&b lclb &i lclb &m &a amid &a,1,1 &m setb ("&a"="M").or.("&a"="m") &i setb ("&a"="I").or.("&a"="i") aif c:&b=0,.a &b amid &b,1,1 &m setb ("&b"="M").or.("&b"="m").or.&m &i setb ("&b"="I").or.("&b"="i").or.&i .a &l rep #&m*32+&i*16 aif .not.&m,.b longa on .b aif .not.&i,.c longi on .c mend macro &l ph2 &n1 &l anop aif "&n1"="*",.f lclc &c &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 lda (&n1) pha ago .e .b aif "&c"="<",.c lda &n1 pha ago .e .c &n1 amid &n1,2,l:&n1-1 pei &n1 ago .e .d &n1 amid &n1,2,l:&n1-1 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l ph4 &n1 &l anop aif "&n1"="*",.f lclc &c &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 ldy #2 lda (&n1),y pha lda (&n1) pha ago .e .b aif "&c"<>"[",.c ldy #2 lda &n1,y pha lda &n1 pha ago .e .c aif "&c"<>"<",.c1 &n1 amid &n1,2,l:&n1-1 pei &n1+2 pei &n1 ago .e .c1 lda &n1+2 pha lda &n1 pha ago .e .d &n1 amid &n1,2,l:&n1-1 pea +(&n1)|-16 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend macro &l pl4 &n1 lclc &c &l anop aif s:longa=1,.a rep #%00100000 .a &c amid &n1,1,1 aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.f &n1 amid &n1,2,l:&n1-2 pla sta (&n1) ldy #2 pla sta (&n1),y ago .d .b aif "&c"<>"[",.c pla sta &n1 ldy #2 pla sta &n1,y ago .d .c pla sta &n1 pla sta &n1+2 .d aif s:longa=1,.e sep #%00100000 .e mexit .f mnote "Missing closing '}'",16 mend macro &l short &a,&b lclb &i lclb &m &a amid &a,1,1 &m setb ("&a"="M").or.("&a"="m") &i setb ("&a"="I").or.("&a"="i") aif c:&b=0,.a &b amid &b,1,1 &m setb ("&b"="M").or.("&b"="m").or.&m &i setb ("&b"="I").or.("&b"="i").or.&i .a &l sep #&m*32+&i*16 aif .not.&m,.b longa off .b aif .not.&i,.c longi off .c mend macro &l ~lda &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l lda &op mend macro &l ~lda.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" lda &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" lda &op mexit .e lda 2+&op mend macro &l ~op &opc,&op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l &opc &op mend macro &l ~op.h &opc,&op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" &opc &op mexit .d aif "&c"<>"#",.e &op amid "&op",2,l:&op-1 &op setc "#^&op" &opc &op mexit .e &opc 2+&op mend macro &l ~pusha &n1 lclc &c &l anop &c amid &n1,1,1 aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 sep #$20 longa off lda #0 pha rep #$20 longa on phk lda &n1 pha mexit .b aif "&c"<>"[",.c &n1 amid &n1,2,l:&n1-2 lda &n1+2 pha lda &n1 pha mexit .c pea +(&n1)|-16 pea &n1 mexit .g mnote "Missing closing '}'",16 mend macro &l ~restm &l anop aif (&~la+&~li)=2,.i sep #32*(.not.&~la)+16*(.not.&~li) aif &~la,.h longa off .h aif &~li,.i longi off .i mend macro &l ~setm &l anop aif c:&~la,.b gblb &~la gblb &~li .b &~la setb s:longa &~li setb s:longi aif s:longa.and.s:longi,.a rep #32*(.not.&~la)+16*(.not.&~li) longa on longi on .a mend macro &l ~sta &op lclc &c &c amid "&op",1,1 aif "&c"<>"{",.b &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b &l sta &op mend macro &l ~sta.h &op &l anop lclc &c &c amid "&op",1,1 aif "&c"="[",.b aif "&c"<>"{",.d &c amid "&op",l:&op,1 aif "&c"="}",.a mnote "Missing closing '}'",2 &op setc &op} .a &op amid "&op",2,l:&op-2 &op setc (&op) .b aif &yistwo,.c &yistwo setb 1 ldy #2 .c &op setc "&op,y" sta &op mexit .d sta 2+&op mend MACRO &lab _DisposeHandle &lab ldx #$1002 jsl $E10000 MEND MACRO &lab _FindHandle &lab ldx #$1A02 jsl $E10000 MEND MACRO &lab _NewHandle &lab ldx #$0902 jsl $E10000 MEND \ No newline at end of file + MACRO +&LAB DOS &ADR +&LAB DC I"L:~&SYSNAME&SYSCNT" +~&SYSNAME&SYSCNT DC C"&ADR" + MEND + MACRO +&LAB MOVE4 &F,&T +&LAB ~SETM + LDA 2+&F + STA 2+&T + LDA &F + STA &T + ~RESTM + MEND + macro +&lab sub &parms,&work +&lab anop + aif c:&work,.a + lclc &work +&work setc 0 +.a + gbla &totallen + gbla &worklen +&worklen seta &work +&totallen seta 0 + aif c:&parms=0,.e + lclc &len + lclc &p + lcla &i +&i seta c:&parms +.b +&p setc &parms(&i) +&len amid &p,2,1 + aif "&len"=":",.c +&len amid &p,1,2 +&p amid &p,4,l:&p-3 + ago .d +.c +&len amid &p,1,1 +&p amid &p,3,l:&p-2 +.d +&p equ &totallen+3+&work +&totallen seta &totallen+&len +&i seta &i-1 + aif &i,^b +.e + tsc + aif &work=0,.f + sec + sbc #&work + tcs +.f + phd + tcd + mend + macro +&lab ret &r +&lab anop + lclc &len + aif c:&r,.a + lclc &r +&r setc 0 +&len setc 0 + ago .h +.a +&len amid &r,2,1 + aif "&len"=":",.b +&len amid &r,1,2 +&r amid &r,4,l:&r-3 + ago .c +.b +&len amid &r,1,1 +&r amid &r,3,l:&r-2 +.c + aif &len<>2,.d + ldy &r + ago .h +.d + aif &len<>4,.e + ldx &r+2 + ldy &r + ago .h +.e + aif &len<>10,.g + ldy #&r + ldx #^&r + ago .h +.g + mnote 'Not a valid return length',16 + mexit +.h + aif &totallen=0,.i + lda &worklen+1 + sta &worklen+&totallen+1 +.i + pld + tsc + clc + adc #&worklen+&totallen + tcs + aif &len=0,.j + tya +.j + rts + mend + macro +&l puts &n1,&f1,&cr,&errout +&l ~setm + lclc &c +&c amid "&n1",1,1 + aif "&c"<>"#",.c + aif l:&n1>127,.a + bra ~&SYSCNT + ago .b +.a + brl ~&SYSCNT +.b +&n1 amid "&n1",2,l:&n1-1 +~l&SYSCNT dc i1"l:~s&SYSCNT" +~s&SYSCNT dc c&n1 +~&SYSCNT anop +&n1 setc ~l&SYSCNT-1 +.c + ~pusha &n1 + aif c:&f1,.c1 + pea 0 + ago .c2 +.c1 + ph2 &f1 +.c2 + ph2 #c:&cr + ph2 #c:&errout + jsl ~puts + ~restm + mend + macro +&l putc &n1,&f1,&cr,&errout + lclc &f1 +&f1 setc #0 +.a +&l ~setm + ph2 &n1 + aif c:&f1,.a + pea 0 + ago .b +.a + ph2 &f1 +.b + ph2 #c:&cr + ph2 #c:&errout + jsl ~putc + ~restm + mend + macro +&l putcr &errout +&l ~setm + pea $0D + aif c:&errout,.a + jsl SysCharOut + ~restm + mexit +.a + jsl SysCharErrout + ~restm + mend + macro +&l add4 &m1,&m2,&m3 + lclb &yistwo + lclc &c +&l ~setm + aif c:&m3,.a +&c amid "&m2",1,1 + aif "&c"<>"#",.a +&c amid "&m1",1,1 + aif "&c"="{",.a + aif "&c"="[",.a +&c amid "&m2",2,l:&m2-1 + aif &c>=65536,.a + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m1 + bcc ~&SYSCNT + ~op.h inc,&m1 +~&SYSCNT anop + ago .c +.a + aif c:&m3,.b + lclc &m3 +&m3 setc &m1 +.b + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m3 + ~lda.h &m1 + ~op.h adc,&m2 + ~sta.h &m3 +.c + ~restm + mend + macro +&l sub4 &m1,&m2,&m3 + lclb &yistwo + lclc &c +&l ~setm + aif c:&m3,.a +&c amid "&m2",1,1 + aif "&c"<>"#",.a +&c amid "&m1",1,1 + aif "&c"="{",.a + aif "&c"="[",.a +&c amid "&m2",2,l:&m2-1 + aif &c>=65536,.a + sec + ~lda &m1 + ~op sbc,&m2 + ~sta &m1 + bcs ~&SYSCNT + ~op.h dec,&m1 +~&SYSCNT anop + ago .c +.a + aif c:&m3,.b + lclc &m3 +&m3 setc &m1 +.b + sec + ~lda &m1 + ~op sbc,&m2 + ~sta &m3 + ~lda.h &m1 + ~op.h sbc,&m2 + ~sta.h &m3 +.c + ~restm + mend + macro +&l dw &adr +&l dc i1"l:~&SYSNAME&SYSCNT" +~&SYSNAME&SYSCNT dc c"&adr" + mend + macro +&l inc4 &a +&l ~setm + inc &a + bne ~&SYSCNT + inc 2+&a +~&SYSCNT ~restm + mend + macro +&l long &a,&b + lclb &i + lclb &m +&a amid &a,1,1 +&m setb ("&a"="M").or.("&a"="m") +&i setb ("&a"="I").or.("&a"="i") + aif c:&b=0,.a +&b amid &b,1,1 +&m setb ("&b"="M").or.("&b"="m").or.&m +&i setb ("&b"="I").or.("&b"="i").or.&i +.a +&l rep #&m*32+&i*16 + aif .not.&m,.b + longa on +.b + aif .not.&i,.c + longi on +.c + mend + macro +&l ph2 &n1 +&l anop + aif "&n1"="*",.f + lclc &c +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + lda (&n1) + pha + ago .e +.b + aif "&c"="<",.c + lda &n1 + pha + ago .e +.c +&n1 amid &n1,2,l:&n1-1 + pei &n1 + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l ph4 &n1 +&l anop + aif "&n1"="*",.f + lclc &c +&c amid &n1,1,1 + aif "&c"="#",.d + aif s:longa=1,.a + rep #%00100000 +.a + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + ldy #2 + lda (&n1),y + pha + lda (&n1) + pha + ago .e +.b + aif "&c"<>"[",.c + ldy #2 + lda &n1,y + pha + lda &n1 + pha + ago .e +.c + aif "&c"<>"<",.c1 +&n1 amid &n1,2,l:&n1-1 + pei &n1+2 + pei &n1 + ago .e +.c1 + lda &n1+2 + pha + lda &n1 + pha + ago .e +.d +&n1 amid &n1,2,l:&n1-1 + pea +(&n1)|-16 + pea &n1 + ago .f +.e + aif s:longa=1,.f + sep #%00100000 +.f + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l pl4 &n1 + lclc &c +&l anop + aif s:longa=1,.a + rep #%00100000 +.a +&c amid &n1,1,1 + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.f +&n1 amid &n1,2,l:&n1-2 + pla + sta (&n1) + ldy #2 + pla + sta (&n1),y + ago .d +.b + aif "&c"<>"[",.c + pla + sta &n1 + ldy #2 + pla + sta &n1,y + ago .d +.c + pla + sta &n1 + pla + sta &n1+2 +.d + aif s:longa=1,.e + sep #%00100000 +.e + mexit +.f + mnote "Missing closing '}'",16 + mend + macro +&l short &a,&b + lclb &i + lclb &m +&a amid &a,1,1 +&m setb ("&a"="M").or.("&a"="m") +&i setb ("&a"="I").or.("&a"="i") + aif c:&b=0,.a +&b amid &b,1,1 +&m setb ("&b"="M").or.("&b"="m").or.&m +&i setb ("&b"="I").or.("&b"="i").or.&i +.a +&l sep #&m*32+&i*16 + aif .not.&m,.b + longa off +.b + aif .not.&i,.c + longi off +.c + mend + macro +&l ~lda &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l lda &op + mend + macro +&l ~lda.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + lda &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + lda &op + mexit +.e + lda 2+&op + mend + macro +&l ~op &opc,&op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l &opc &op + mend + macro +&l ~op.h &opc,&op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + &opc &op + mexit +.d + aif "&c"<>"#",.e +&op amid "&op",2,l:&op-1 +&op setc "#^&op" + &opc &op + mexit +.e + &opc 2+&op + mend + macro +&l ~pusha &n1 + lclc &c +&l anop +&c amid &n1,1,1 + aif "&c"<>"{",.b +&c amid &n1,l:&n1,1 + aif "&c"<>"}",.g +&n1 amid &n1,2,l:&n1-2 + sep #$20 + longa off + lda #0 + pha + rep #$20 + longa on + phk + lda &n1 + pha + mexit +.b + aif "&c"<>"[",.c +&n1 amid &n1,2,l:&n1-2 + lda &n1+2 + pha + lda &n1 + pha + mexit +.c + pea +(&n1)|-16 + pea &n1 + mexit +.g + mnote "Missing closing '}'",16 + mend + macro +&l ~restm +&l anop + aif (&~la+&~li)=2,.i + sep #32*(.not.&~la)+16*(.not.&~li) + aif &~la,.h + longa off +.h + aif &~li,.i + longi off +.i + mend + macro +&l ~setm +&l anop + aif c:&~la,.b + gblb &~la + gblb &~li +.b +&~la setb s:longa +&~li setb s:longi + aif s:longa.and.s:longi,.a + rep #32*(.not.&~la)+16*(.not.&~li) + longa on + longi on +.a + mend + macro +&l ~sta &op + lclc &c +&c amid "&op",1,1 + aif "&c"<>"{",.b +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b +&l sta &op + mend + macro +&l ~sta.h &op +&l anop + lclc &c +&c amid "&op",1,1 + aif "&c"="[",.b + aif "&c"<>"{",.d +&c amid "&op",l:&op,1 + aif "&c"="}",.a + mnote "Missing closing '}'",2 +&op setc &op} +.a +&op amid "&op",2,l:&op-2 +&op setc (&op) +.b + aif &yistwo,.c +&yistwo setb 1 + ldy #2 +.c +&op setc "&op,y" + sta &op + mexit +.d + sta 2+&op + mend + MACRO +&lab _DisposeHandle +&lab ldx #$1002 + jsl $E10000 + MEND + MACRO +&lab _FindHandle +&lab ldx #$1A02 + jsl $E10000 + MEND + MACRO +&lab _NewHandle +&lab ldx #$0902 + jsl $E10000 + MEND