A2osX/BIN/ASM.S.SRC.txt

PR#3
PREFIX /A2OSX.SRC
NEW
INC 1
AUTO 6
					.LIST OFF
*---------------------------------------
SRC.PrintLine		ldy #ASM.MACRO.ON
					lda (pData),y
					bpl .1
					
					ldy #ASM.LI.CON
					lda (pData),y
					bpl .9
					bmi .8
					
.1					ldy #ASM.LI.ON
					lda (pData),y
					bpl .9
					
.8					>PUSHWI UsrBuf256
					>PUSHW SRC.LINENUM
					ldy #ASM.PC+1
					>PUSHB (pData),y
					dey
					>PUSHB (pData),y
					>PUSHW L.MSG.SRCLINE
					>LIBCALL hLIBSTR,LIBSTR.PRINTF
.9					rts
*---------------------------------------
SRC.PrintLineErr	ldx #0
.1					lda UsrBuf256,x
					beq .2
					phx
					>SYSCALL SYS.COutA
					plx
					inx
					bcc .1
					rts	
					
.2					lda #13
					>SYSCALL SYS.COutA
					bcs .9
					
					ldx #0
.3					lda UsrBuf256,x
					beq .5
					inx
					cpx SRC.BufPtr
					beq .4
					phx
					lda #'-'
					>SYSCALL SYS.COutA
					plx
					bcs .9
					bra .3
					
.4					lda #'^'
					phx
					>SYSCALL SYS.COutA
					plx
					bcs .9

.5					lda #13
					>SYSCALL SYS.COutA
.9					rts
*---------------------------------------
SRC.ParseLine		ldx UsrBuf256
					beq .1
					
					cpx #'*'			Comment?
					beq .1
					cpx #';'			Comment?
					beq .1
					
					ldy #ASM.DO.ON
					lda (pData),y
					bne .1
					
					stz SRC.GLabel.New
					
					cpx #' '			no label...go scan dir/opcode
					beq .4
					
					cpx #'.'			local symbol?
					bne	.2
					jsr SRC.ParseLine.SymL
					bra .3
					
.1					clc					
					rts
					
					
.2					jsr SRC.ParseLine.SymG
.3					bcs SRC.ParseLine.Err
 
.4					jsr SRC.GetCharNB	Scan for an Opcode...
					beq SRC.ParseLine.Ok
					
					cmp #'.'
					bne .5
					
					jsr SRC.ParseLine.Dir
					bcs SRC.ParseLine.Err
					bra SRC.ParseLine.Ok

.5					cmp #'>'
					bne .6
					
					jsr SRC.ParseLine.Exec.Macro
					bcs SRC.ParseLine.Err
					bra SRC.ParseLine.Ok
					
.6					dec SRC.BufPtr		Back one char...
					jsr SRC.ParseLine.OpCode
					bcs SRC.ParseLine.Err

					
SRC.ParseLine.Ok	lda SRC.GLabel.New
					bpl .8
					
					ldy #ASM.PASS		
					lda (pData),y		pass#2?
					bne .8				yes, nothing to do
* --- Pass #1					
					>LDYA L.SRC.GLabel.Flags
					jsr SYM.SearchGlobal
					bcs .1				if CS, not found, add

					lda SRC.FLabel.Flags
					bit #$40			found symbol pending ?
					bne .2				yes, update
					
					bit #$1					found is .SE ?
					beq SRC.ParseLine.Redef		no, redefine error

.2					ldx #0					update current symbol with
.3					lda SRC.GLabel.Flags	flags & value
					jsr SYM.AddByteGBlock
					inx
					cpx #5
					bne .3
					bra .8								
					
.1					>LDYA L.SRC.GLabel.Flags
					jsr SYM.AddGToGBlockYA
					bcs SRC.ParseLine.Err
								
.8					clc
					rts

SRC.ParseLine.Inv	lda #ERR.INVALID.LABEL
SRC.ParseLine.Err	sec
					rts
					
SRC.ParseLine.Redef lda #ERR.SYMBOL.REDEFINE
					sec
					rts
*---------------------------------------
SRC.ParseLine.SymP	jsr SRC.GetChar
					beq SRC.ParseLine.SymE
					jsr SRC.GetDecimal
					bcs SRC.ParseLine.SymE
					jmp SYM.AddPrivate
*---------------------------------------
SRC.ParseLine.SymL	jsr SRC.GetChar
					beq SRC.ParseLine.SymE
					jsr SRC.GetDecimal
					bcs SRC.ParseLine.SymE
					lda SRC.ACC+1
					ora SRC.ACC+2
					ora SRC.ACC+3
					bne SRC.ParseLine.SymE	Max .255
					lda SRC.ACC
					beq SRC.ParseLine.SymE	.0 is not allowed
					sta SRC.LLabel.ID
					
					ldy #ASM.PC
					lda (pData),y
					ldy #ASM.PC.GLABEL
					sec		
					sbc (pData),y
					sta SRC.LLabel.Offset
					
					ldy #ASM.PC+1
					lda (pData),y
					ldy #ASM.PC.GLABEL+1
					sbc (pData),y
					bne SRC.ParseLine.SymR
					
					ldy #ASM.PC+2
					lda (pData),y
					ldy #ASM.PC.GLABEL+2
					sbc (pData),y
					bne SRC.ParseLine.SymR
					
					ldy #ASM.PC+3
					lda (pData),y
					ldy #ASM.PC.GLABEL+3
					sbc (pData),y
					bne SRC.ParseLine.SymR
					bcc SRC.ParseLine.SymR
					jmp SYM.AddLToGBlock
*---------------------------------------
SRC.ParseLine.SymE	lda #ERR.INVALID.LABEL
					sec
					rts
					
SRC.ParseLine.SymR	lda #ERR.RANGE
					sec
					rts
*---------------------------------------
SRC.ParseLine.SymG	>LDYA L.SRC.GLabel.Len
					jsr SRC.GetLabel
					bcs SRC.ParseLine.SymE
					
					ldx #3				Makes Current Label = PC for now
					ldy #ASM.PC+3
					
.1					lda (pData),y
					sta SRC.GLabel.Value,x
					dey
					dex
					bpl .1
					
					ldx #3				Makes Current Label = Ref for next local
					ldy #ASM.PC.GLABEL+3
					
.2					lda SRC.GLabel.Value,x
					sta (pData),y
					dey
					dex
					bpl .2
					
					lda #$80			Mark GLabel Flag...
					sta SRC.GLabel.Flags
					sta SRC.GLabel.New
					
					clc
					rts
*---------------------------------------
SRC.ParseLine.Dir	>LDYA L.T.DIRECTIVES
					jsr SRC.GetKeyword
					bcs .9
					
					jmp (J.DIRECTIVES,x)
					
.9					lda #ERR.INVALID.DIRECTIVE
					sec
					rts
*---------------------------------------
SRC.ParseLine.Exec.Macro
					clc
					rts
*---------------------------------------
SRC.ParseLine.Add.Macro
					clc
					rts
*---------------------------------------
SRC.ParseLine.OpCode
					jsr SRC.GetArg
					bcc .11
					rts

.11					ldy #ASM.T.hMem
					lda (pData),y
					>SYSCALL SYS.GetMemPtrA
					>STYA ZPPtr1

					ldy #ASM.T.O		setup Ptr to Opcodes
					lda (ZPPtr1),y
					clc
					adc ZPPtr1
					sta ZPPtr2
					iny
					lda (ZPPtr1),y
					adc ZPPtr1+1
					sta ZPPtr2+1
					
					ldy #ASM.T.R		setup Ptr to Registers
					lda (ZPPtr1),y
					clc
					adc ZPPtr1
					sta ZPPtr3
					iny
					lda (ZPPtr1),y
					adc ZPPtr1+1
					sta ZPPtr3+1
					
					
.10					lda (ZPPtr2)
					ldy #1
					ora (ZPPtr2),y
					beq .9
					
					ldx #$FF
					
.1					inx
					lda SRC.Buffer,x
					iny
					cmp (ZPPtr2),y
					bne .7
					
					cpx SRC.Buffer
					bne .1
					
					jsr SRC.ParseLine.AM
					
					
					
					
					

					
					
					
					
					
					
					
					bcs .99
					bcc .20
					ldx SRC.AM.StrBuf
					beq .20
					ldx #0
.21					inx
					lda SRC.AM.StrBuf,x
					phx
					>SYSCALL SYS.COutA
					plx
					cpx SRC.AM.StrBuf
					bne .21
					lda #13
					>SYSCALL SYS.COutA
					
					
.20					ldy #ASM.PC
					lda (pData),y
					inc
					sta (pData),y
					bne .2
					iny
					lda (pData),y
					inc
					sta (pData),y
					
.2					clc
					rts
					
.7					lda ZPPtr1
					clc
					adc (ZPPtr2)
					tax
					lda ZPPtr1+1
					ldy #1
					adc (ZPPtr2),y
					stx ZPPtr2
					sta ZPPtr2+1
					bra .10
					
.9					lda #ERR.INVALID.OPCODE
					sec
.99					rts
*---------------------------------------
SRC.ParseLine.AM	stz SRC.AM.ID
					stz SRC.AM.StrBuf
					
.1					jsr SRC.GetCharUC	any arg immediately after ' '?
					beq .8				no, AM.ID=0 (implied)

					cmp #' '			another space ?
					beq .8				ignore end of line (comment)
					
					jsr SRC.IsAMReserved
					bcs .2
					
					inc SRC.AM.StrBuf
					ldx SRC.AM.StrBuf
					sta SRC.AM.StrBuf,x
					bra .1
										
.8					clc
					rts
					
.2					jsr SRC.IsMODReserved
					bcs .21
					lda #'#'
					inc SRC.AM.StrBuf
					ldx SRC.AM.StrBuf
					sta SRC.AM.StrBuf,x
					bra .1
					
.21					jsr SRC.IsLetter	Any register?
					bcs .70				no, try something else
					
					ldx SRC.BufPtr
					stx SRC.BufPtrSave
					
					stz SRC.AM.tmpBuf
					sta SRC.AM.tmpBuf+1
					inc SRC.AM.tmpBuf
					
.3					jsr SRC.GetCharUC
					beq .41
					jsr SRC.IsLetterOrDigit
					bcs .4
					inc SRC.AM.tmpBuf
					ldx SRC.AM.tmpBuf
					sta SRC.AM.tmpBuf,x
					bra .3
					
.4					dec SRC.BufPtr		back one char

.41					ldy #0
					
.5					lda (ZPPtr3),y
					beq .71				last register ?
					
					phy
					ldx #$ff
					
.6					lda (ZPPtr3),y
					iny
					inx
					cmp SRC.AM.tmpBuf,x
					bne .7
					
					cpx SRC.AM.tmpBuf
					bne .6
					
					ply
					
					ldy #0				register match, add to AM string
					ldx SRC.AM.StrBuf
					
.61					iny
					lda SRC.AM.tmpBuf,y
					inx
					sta SRC.AM.StrBuf,x					
					cpy SRC.AM.tmpBuf
					bne .61
					
					stx SRC.AM.StrBuf
					jmp .1
					
.7					ply
					tya
					sec
					adc (ZPPtr3),y
					tay
					bra .5

.71					lda SRC.BufPtrSave	Does not match a register,restore Ptr
					sta SRC.BufPtr

.70					dec SRC.BufPtr		back one char
									
					jsr EXP.Eval

					bcs .99
					
					ldx #3
.73					lda SRC.ACC,x					
					bne .72
					dex
					bne .73
					
.72					inx
					txa
					ora #$30
					inc SRC.AM.StrBuf
					ldx SRC.AM.StrBuf
					sta SRC.AM.StrBuf,x
					
					jmp .1
					clc
					rts

					
					
.9					lda #ERR.INVALID.AM.SYN
					sec
.99					rts
*---------------------------------------
SRC.GetDecimal		stz SRC.ACC+1
					stz SRC.ACC+2
					stz SRC.ACC+3
					
					jsr SRC.GetChar
					beq .99
					jsr SRC.IsDigit10
					bcs .99
					and #$0F
					sta SRC.ACC
					
.1					jsr SRC.GetChar
					beq .8
					cmp #' '
					beq .88
					jsr SRC.IsEXPReserved
					bcc .88
					jsr SRC.IsAMReserved
					bcc .88
					jsr SRC.IsDigit10
					bcs .99
					and #$0F
					
					pha
					jsr SRC.ACC10
					pla
					bcs .9

					adc SRC.ACC
					sta SRC.ACC
					bcc .1
					
					inc SRC.ACC+1
					bne .1
					inc SRC.ACC+2
					bne .1
					inc SRC.ACC+3
					bne .1
					
.9					lda #ERR.VAL.TOO.BIG
					sec
					rts

.88					dec SRC.BufPtr		Back One Char
.8					clc
					rts
					
.99					lda #ERR.SYNTAX.ERROR
					sec
					rts
*---------------------------------------
SRC.GetHex			stz SRC.ACC+1
					stz SRC.ACC+2
					stz SRC.ACC+3
					
					jsr SRC.GetChar
					beq .99
					jsr SRC.IsDigit16
					bcs .99

					sta SRC.ACC
					
.1					jsr SRC.GetChar
					beq .8
					cmp #' '
					beq .88
					jsr SRC.IsEXPReserved
					bcc .88
					jsr SRC.IsAMReserved
					bcc .88
					jsr SRC.IsDigit16
					bcs .99
					
					ldx #4
.2					asl SRC.ACC
					rol SRC.ACC+1
					rol SRC.ACC+2
					rol SRC.ACC+3
					bcs .9
					dex
					bne .2
					ora SRC.ACC
					sta SRC.ACC
					bra .1
					
.88					dec SRC.BufPtr		Back One Char
.8					clc
					rts
					
.9					lda #ERR.VAL.TOO.BIG
					sec
					rts
					
.99					lda #ERR.SYNTAX.ERROR
					sec
					rts
*---------------------------------------
SRC.GetOctal		stz SRC.ACC+1
					stz SRC.ACC+2
					stz SRC.ACC+3
					
					jsr SRC.GetChar
					beq .99
					jsr SRC.IsDigit8
					bcs .99
					and #$0F
					sta SRC.ACC
					
.1					jsr SRC.GetChar
					beq .8
					cmp #' '
					beq .88
					jsr SRC.IsEXPReserved
					bcc .88
					jsr SRC.IsAMReserved
					bcc .88
					jsr SRC.IsDigit8
					bcs .99
					
					asl
					asl
					asl
					asl
					asl
					
					ldx #3
.2					asl
					rol SRC.ACC
					rol SRC.ACC+1
					rol SRC.ACC+2
					rol SRC.ACC+3
					bcs .9
					dex
					bne .2
					bra .1
					
.88					dec SRC.BufPtr		Back One Char
.8					clc
					rts
					
.9					lda #ERR.VAL.TOO.BIG
					sec
					rts
					
.99					lda #ERR.SYNTAX.ERROR
					sec
					rts
*---------------------------------------
SRC.GetBinary		stz SRC.ACC+1
					stz SRC.ACC+2
					stz SRC.ACC+3
					
					jsr SRC.GetChar
					beq .99
					cmp #'1'
					beq .10
					cmp #'0'
					bne .99
.10					and #$01
					sta SRC.ACC
					
.1					jsr SRC.GetChar
					beq .8
					cmp #' '
					beq .88
					jsr SRC.IsEXPReserved
					bcc .88
					jsr SRC.IsAMReserved
					bcc .88
					cmp #'1'
					beq .11
					cmp #'0'
					bne .8
					
.11					lsr
					
					rol SRC.ACC
					rol SRC.ACC+1
					rol SRC.ACC+2
					rol SRC.ACC+3
					bcs .9
					bra .1
					
.88					dec SRC.BufPtr		Back One Char
.8					clc
					rts
					
.9					lda #ERR.VAL.TOO.BIG
					sec
					rts
					
.99					lda #ERR.SYNTAX.ERROR
					sec
					rts
*---------------------------------------
SRC.GetLabel		>STYA ZPPtr1

					jsr SRC.GetCharUC
					beq .9
					
					jsr SRC.IsLetter
					bcs .9
					
					ldy #1
					sta (ZPPtr1),y

.1					jsr SRC.GetCharUC
					beq .8

					jsr SRC.IsLetterOrDigit
					bcc .2
					cmp #'.'
					beq .2
					
					cmp #'_'
					beq .2
					
					cmp #' '
					beq .88
					jsr SRC.IsEXPReserved
					bcc .88
					jsr SRC.IsAMReserved
					bcc .88
					
.9					lda #ERR.SYNTAX.ERROR
					sec
					rts	
					
.2					iny
					sta (ZPPtr1),y
					cpy #SRC.GLABEL.MAXLEN
					bcc .1				if equ Carry is set

.88					dec SRC.BufPtr		Back One Char				
.8					tya
					sta (ZPPtr1)
					clc
					rts
*---------------------------------------
SRC.GetKeyword		>STYA ZPPtr1

					jsr SRC.GetArg
					bcs .9
					
					stz SRC.Keyword.ID
					
					ldy #0
					
.3					lda (ZPPtr1),y
					beq .9
					cmp SRC.Buffer
					bne .6
					phy
					
					ldx #0
.4					iny
					inx
					lda (ZPPtr1),y
					cmp SRC.Buffer,x
					bne .5
					cpx SRC.Buffer
					bne .4

					ply
					
					ldx SRC.Keyword.ID
					clc
					rts
					
.5					ply	
			
.6					tya
					sec					Add keyword Len+1
					adc (ZPPtr1),y
					tay
					inc SRC.Keyword.ID
					inc SRC.Keyword.ID
					bra .3
					
.9					sec
					rts
*---------------------------------------
SRC.GetArg			jsr SRC.GetCharUC
					beq .9

					sta SRC.Buffer+1
					ldy #1
					
.1					jsr SRC.GetCharUC
					beq .2
					cmp #' '
					beq .2
					iny
					sta SRC.Buffer,y
					bra .1
					
.2					sty SRC.Buffer
					clc
					rts
					
.9					sec
					rts
*---------------------------------------
SRC.IsAMReserved	ldx SRC.AM.RESERVED
.1					cmp SRC.AM.RESERVED,x
					beq .8
					dex
					bne .1
					sec
					rts
.8					clc
					rts					
*---------------------------------------
SRC.IsMODReserved	ldx SRC.MOD.RESERVED
.1					cmp SRC.MOD.RESERVED,x
					beq .8
					dex
					bne .1
					sec
					rts
.8					clc
					rts					
*---------------------------------------
SRC.IsEXPReserved	ldx SRC.EXP.RESERVED
.1					cmp SRC.EXP.RESERVED,x
					beq .8
					dex
					bne .1
					sec
					rts
.8					clc
					rts					
*---------------------------------------
SRC.IsLetterOrDigit jsr SRC.IsDigit10
					bcc SRC.IsLetterRTS
*---------------------------------------
SRC.IsLetter		cmp #'A'
					bcc .9
					cmp #'Z'+1
					bcc SRC.IsLetterRTS

					cmp #'a'
					bcc .9
					cmp #'z'+1
					rts					CC if lowercase
					
.9					sec					
SRC.IsLetterRTS		rts					
*---------------------------------------
SRC.IsDigit16		jsr SRC.IsDigit10
					bcc .8
					cmp #'A'
					bcc .9
					cmp #'F'+1
					bcc .1
					rts					cc if ok, cs if not
					
.1					sbc #'A'-11			cc so A->10 (11-CC)
					clc
.8					and #$0F					
					rts
					
.9					sec
					rts
*---------------------------------------
SRC.IsDigit10		cmp #'0'
					bcc .9
					cmp #'9'+1
					rts					cc if ok, cs if not
					
.9					sec
					rts
*---------------------------------------
SRC.IsDigit8		cmp #'0'
					bcc .9
					cmp #'7'+1
					rts					cc if ok, cs if not
					
.9					sec
					rts
*---------------------------------------
SRC.GetCharNB		jsr SRC.GetCharUC
					beq .9
					cmp #' '
					beq SRC.GetCharNB
.9					rts
*---------------------------------------
SRC.GetCharUC		jsr SRC.GetChar
					beq .9
					cmp #'a'
					bcc .9
					cmp #'z'+1
					bcs .9
					eor #$20			to Uppercase
.9					rts
*---------------------------------------
SRC.GetChar			ldx SRC.BufPtr
					lda UsrBuf256,x
					beq .9
					inc SRC.BufPtr		if 255, will make Z
.9					rts
*---------------------------------------
SRC.ACC10			lda SRC.ACC			ACC*2-> ACC & ACCTMP
					asl
					sta SRC.ACC
					sta SRC.ACCTMP
					lda SRC.ACC+1
					rol
					sta SRC.ACC+1
					sta SRC.ACCTMP+1
					lda SRC.ACC+2
					rol
					sta SRC.ACC+2
					sta SRC.ACCTMP+2
					lda SRC.ACC+3
					rol
					sta SRC.ACC+3
					sta SRC.ACCTMP+3
					bcs .9
					
					ldx #2
.1					asl SRC.ACC			ACC=ACC*4
					rol SRC.ACC+1
					rol SRC.ACC+2
					rol SRC.ACC+3
					bcs .9
					dex
					bne .1
					
					lda SRC.ACC			CC from ROL SRC.ACC+3
					adc SRC.ACCTMP
					sta SRC.ACC
					lda SRC.ACC+1
					adc SRC.ACCTMP+1
					sta SRC.ACC+1
					lda SRC.ACC+2
					adc SRC.ACCTMP+2
					sta SRC.ACC+2
					lda SRC.ACC+3
					adc SRC.ACCTMP+3
					sta SRC.ACC+3		CS if overflow
					
.9					rts					

*---------------------------------------
MAN
SAVE BIN/ASM.S.SRC
LOAD BIN/ASM.S
ASM