Home
JAQForum Ver 24.01
Log In or Join  
Active Topics
Local Time 09:11 01 Aug 2025 Privacy Policy
Jump to

Notice. New forum software under development. It's going to miss a few functions and look a bit ugly for a while, but I'm working on it full time now as the old forum was too unstable. Couple days, all good. If you notice any issues, please contact me.

Forum Index : Microcontroller and PC projects : CMM2: 6502 emulator in Basic

Author Message
matherp
Guru

Joined: 11/12/2012
Location: United Kingdom
Posts: 10310
Posted: 11:27am 01 Nov 2020
Copy link to clipboard 
Print this post

Just for fun the attached is a full 6502 emulator completely running in Basic. This is a port of work from OneLoneCoder. If you haven't found him or his youtube channel it is worth a look.
The program embeds a very simple bit of 6502 machine code. Use any key to step through the code. Modify the main program to read in more complicated code and/or run without single stepping. Remove the display update to test speed
This requires CMM2 firmware Version 5.05.05RC12 or above and is entirely dependent on the new CALL command
Testing the emulator in a loop I get 10000 6502 instructions processed in 2.167 seconds which would have required 25026 clock cycles giving an effective 6502 clock speed of
11.548KHz and 4614 instructions per second.

' Based on work Copyright 2018, 2019 OneLoneCoder.com
' MMBasic conversion Peter Mather 2020
OPTION EXPLICIT
OPTION DEFAULT NONE
MODE 1
CLS
DIM INTEGER  a      = &H00  ' Accumulator Register
DIM INTEGER  x      = &H00  ' X Register
DIM INTEGER  y      = &H00  ' Y Register
DIM INTEGER  stkp   = &H00  ' Stack Pointer (points to location on bus)
DIM INTEGER  pc     = &H0000 ' Program Counter
DIM INTEGER  status = &H00  ' Status Register
DIM INTEGER bus(8192)
DIM INTEGER buscycles(255)
DIM STRING operate(255) length 4
DIM STRING addrmode(255) length 4
DIM INTEGER  fetched     = 0 ' Represents the working input value to the ALU
DIM INTEGER  temp        = 0 ' A convenience variable used everywhere
DIM INTEGER  addr_abs    = 0 ' All used memory addresses end up in here
DIM INTEGER  addr_rel    = 0 ' Represents absolute address following a branch
DIM INTEGER  opcode      = 0 ' Is the instruction byte
DIM INTEGER  cycles      = 0 ' Counts how many cycles the instruction has remaining
DIM INTEGER  clock_count = 0 ' A global accumulation of the number of clocks
DIM INTEGER  additional_cycle1    = 0 ' used to return added cycles in opcode addressing
DIM INTEGER  additional_cycle2    = 0 ' used to return added cycles in opcode processing
CONST C = (1 << 0) ' Carry Bit
CONST Z = (1 << 1) ' Zero
CONST I = (1 << 2) ' Disable Interrupts
CONST D = (1 << 3) ' Decimal Mode (unused in this implementation)
CONST B = (1 << 4) ' Break
CONST U = (1 << 5) ' Unused
CONST V = (1 << 6) ' Overflow
CONST N = (1 << 7) ' Negative
const true =1
const false =0
DIM INTEGER ii%, jj%
DIM INTEGER lo
DIM INTEGER hi
' Op codes

DATA "BRK", "ORA", "XXX", "XXX", "XXX", "ORA", "ASL", "XXX", "PHP", "ORA", "ASL", "XXX", "XXX", "ORA", "ASL", "XXX"
DATA "BPL", "ORA", "XXX", "XXX", "XXX", "ORA", "ASL", "XXX", "CLC", "ORA", "XXX", "XXX", "XXX", "ORA", "ASL", "XXX"
DATA "JSR", "AN6", "XXX", "XXX", "BIT", "AN6", "ROL", "XXX", "PLP", "AN6", "ROL", "XXX", "BIT", "AN6", "ROL", "XXX"
DATA "BMI", "AN6", "XXX", "XXX", "XXX", "AN6", "ROL", "XXX", "SEC", "AN6", "XXX", "XXX", "XXX", "AN6", "ROL", "XXX"
DATA "RTI", "EOR", "XXX", "XXX", "XXX", "EOR", "LSR", "XXX", "PHA", "EOR", "LSR", "XXX", "JMP", "EOR", "LSR", "XXX"
DATA "BVC", "EOR", "XXX", "XXX", "XXX", "EOR", "LSR", "XXX", "CLI", "EOR", "XXX", "XXX", "XXX", "EOR", "LSR", "XXX"
DATA "RTS", "ADC", "XXX", "XXX", "XXX", "ADC", "ROR", "XXX", "PLA", "ADC", "ROR", "XXX", "JMP", "ADC", "ROR", "XXX"
DATA "BVS", "ADC", "XXX", "XXX", "XXX", "ADC", "ROR", "XXX", "SEI", "ADC", "XXX", "XXX", "XXX", "ADC", "ROR", "XXX"
DATA "XXX", "STA", "XXX", "XXX", "STY", "STA", "STX", "XXX", "DEY", "XXX", "TXA", "XXX", "STY", "STA", "STX", "XXX"
DATA "BCC", "STA", "XXX", "XXX", "STY", "STA", "STX", "XXX", "TYA", "STA", "TXS", "XXX", "XXX", "STA", "XXX", "XXX"
DATA "LDY", "LDA", "LDX", "XXX", "LDY", "LDA", "LDX", "XXX", "TAY", "LDA", "TAX", "XXX", "LDY", "LDA", "LDX", "XXX"
DATA "BCS", "LDA", "XXX", "XXX", "LDY", "LDA", "LDX", "XXX", "CLV", "LDA", "TSX", "XXX", "LDY", "LDA", "LDX", "XXX"
DATA "CPY", "CMP", "XXX", "XXX", "CPY", "CMP", "DEC", "XXX", "INY", "CMP", "DEX", "XXX", "CPY", "CMP", "DEC", "XXX"
DATA "BNE", "CMP", "XXX", "XXX", "XXX", "CMP", "DEC", "XXX", "CLD", "CMP", "NOP", "XXX", "XXX", "CMP", "DEC", "XXX"
DATA "CPX", "SBC", "XXX", "XXX", "CPX", "SBC", "INC", "XXX", "INX", "SBC", "NOP", "XXX", "CPX", "SBC", "INC", "XXX"
DATA "BEQ", "SBC", "XXX", "XXX", "XXX", "SBC", "INC", "XXX", "SED", "SBC", "NOP", "XXX", "XXX", "SBC", "INC", "XXX"

'Cycles
DATA 7,6,2,8,3,3,5,5,3,2,2,2,4,4,6,6
DATA 2,5,2,8,4,4,6,6,2,4,2,7,4,4,7,7
DATA 6,6,2,8,3,3,5,5,4,2,2,2,4,4,6,6
DATA 2,5,2,8,4,4,6,6,2,4,2,7,4,4,7,7
DATA 6,6,2,8,3,3,5,5,3,2,2,2,3,4,6,6
DATA 2,5,2,8,4,4,6,6,2,4,2,7,4,4,7,7
DATA 6,6,2,8,3,3,5,5,4,2,2,2,5,4,6,6
DATA 2,5,2,8,4,4,6,6,2,4,2,7,4,4,7,7
DATA 2,6,2,6,3,3,3,3,2,2,2,2,4,4,4,4
DATA 2,6,2,6,4,4,4,4,2,5,2,5,5,5,5,5
DATA 2,6,2,6,3,3,3,3,2,2,2,2,4,4,4,4
DATA 2,5,2,5,4,4,4,4,2,4,2,4,4,4,4,4
DATA 2,6,2,8,3,3,5,5,2,2,2,2,4,4,6,6
DATA 2,5,2,8,4,4,6,6,2,4,2,7,4,4,7,7
DATA 2,6,2,8,3,3,5,5,2,2,2,2,4,4,6,6
DATA 2,5,2,8,4,4,6,6,2,4,2,7,4,4,7,7

'ADDRESSING
DATA "IMM","IZX","IMP","IMP","IMP","ZP0","ZP0","IMP","IMP","IMM","IMP","IMP","IMP","ABS","ABS","IMP"
DATA "REL","IZY","IMP","IMP","IMP","ZPX","ZPX","IMP","IMP","ABY","IMP","IMP","IMP","ABX","ABX","IMP"
DATA "ABS","IZX","IMP","IMP","ZP0","ZP0","ZP0","IMP","IMP","IMM","IMP","IMP","ABS","ABS","ABS","IMP"
DATA "REL","IZY","IMP","IMP","IMP","ZPX","ZPX","IMP","IMP","ABY","IMP","IMP","IMP","ABX","ABX","IMP"
DATA "IMP","IZX","IMP","IMP","IMP","ZP0","ZP0","IMP","IMP","IMM","IMP","IMP","ABS","ABS","ABS","IMP"
DATA "REL","IZY","IMP","IMP","IMP","ZPX","ZPX","IMP","IMP","ABY","IMP","IMP","IMP","ABX","ABX","IMP"
DATA "IMP","IZX","IMP","IMP","IMP","ZP0","ZP0","IMP","IMP","IMM","IMP","IMP","IND","ABS","ABS","IMP"
DATA "REL","IZY","IMP","IMP","IMP","ZPX","ZPX","IMP","IMP","ABY","IMP","IMP","IMP","ABX","ABX","IMP"
DATA "IMP","IZX","IMP","IMP","ZP0","ZP0","ZP0","IMP","IMP","IMP","IMP","IMP","ABS","ABS","ABS","IMP"
DATA "REL","IZY","IMP","IMP","ZPX","ZPX","ZPY","IMP","IMP","ABY","IMP","IMP","IMP","ABX","IMP","IMP"
DATA "IMM","IZX","IMM","IMP","ZP0","ZP0","ZP0","IMP","IMP","IMM","IMP","IMP","ABS","ABS","ABS","IMP"
DATA "REL","IZY","IMP","IMP","ZPX","ZPX","ZPY","IMP","IMP","ABY","IMP","IMP","ABX","ABX","ABY","IMP"
DATA "IMM","IZX","IMP","IMP","ZP0","ZP0","ZP0","IMP","IMP","IMM","IMP","IMP","ABS","ABS","ABS","IMP"
DATA "REL","IZY","IMP","IMP","IMP","ZPX","ZPX","IMP","IMP","ABY","IMP","IMP","IMP","ABX","ABX","IMP"
DATA "IMM","IZX","IMP","IMP","ZP0","ZP0","ZP0","IMP","IMP","IMM","IMP","IMP","ABS","ABS","ABS","IMP"
DATA "REL","IZY","IMP","IMP","IMP","ZPX","ZPX","IMP","IMP","ABY","IMP","IMP","IMP","ABX","ABX","IMP"

data &HA2, &H0A, &H8E, &H00, &H00, &HA2, &H03, &H8E, &H01, &H00, &HAC, &H00, &H00, &HA9, &H00, &H18
data &H6D, &H01, &H00, &H88, &HD0, &HFA, &H8D, &H02, &H00, &HEA, &H4C, &H19, &H80

longstring resize bus(),&H10000
for ii%=0 to 255: read operate(ii%):next ii%
for ii%=0 to 255: read buscycles(ii%):next ii%
for ii%=0 to 255: read addrmode(ii%):next ii%
for ii%=0 to 28 : read jj% : longstring setbyte bus(),ii%+&H8000, jj% : next ii%
longstring setbyte bus(),&HFFFC,0
longstring setbyte bus(),&HFFFD,&H80
reset
do
display
clock
do:loop while inkey$=""
loop

sub display
text 0,0,"  A    X    Y    stkp    PC    stat        clock   &H0000  &H0001  &H0002  OPCODE  ADDMODE
text 0*mm.info(fontwidth),20,"                                                                                  "
text 2*mm.info(fontwidth),20,hex$(a)
text 7*mm.info(fontwidth),20,hex$(x)
text 12*mm.info(fontwidth),20,hex$(y)
text 17*mm.info(fontwidth),20,hex$(stkp)
text 25*mm.info(fontwidth),20,hex$(pc)
text 31*mm.info(fontwidth),20,bin$(status,8)
text 44*mm.info(fontwidth),20,str$(clock_count)
text 52*mm.info(fontwidth),20,hex$(lgetbyte(bus(),0),2)
text 60*mm.info(fontwidth),20,hex$(lgetbyte(bus(),1),2)
text 68*mm.info(fontwidth),20,hex$(lgetbyte(bus(),2),2)
text 76*mm.info(fontwidth),20,operate(opcode)
text 84*mm.info(fontwidth),20,addrmode(opcode)
end sub


'''''''''''''''''''''''''''''''''''''''/
' BUS CONNECTIVITY

' Reads an 8-bit byte from the bus, located at the specified 16-bit addresssub readbus( a)
' In normal operation "read only" is set to false. This may seem odd. Some
' devices on the bus may change state when they are read from, and this
' is intentional under normal circumstances. However the disassembler will
' want to read the data at an address without changing the state of the
' devices on the bus
function readbus(a as integer) as integer
readbus=lgetbyte(bus(),a)
end function

' Writes a byte to the bus at the specified address
sub writebus( a as integer,  d as integer)
longstring setbyte bus(),a,d
end sub





'''''''''''''''''''''''''''''''''''''''/
' EXTERNAL INPUTS

' Forces the 6502 into a known state. This is hard-wired inside the CPU. The
' registers are set to &H00, the status register is cleared except for unused
' bit which remains at 1. An absolute address is read from location &HFFFC
' which contains a second address that the program counter is set to. This
' allows the programmer to jump to a known and programmable location in the
' memory to start executing from. Typically the programmer would set the value
' at location &HFFFC at compile time.
sub reset
' Get address to set program counter to
 addr_abs = &HFFFC
 lo = readbus(addr_abs + 0)
 hi = readbus(addr_abs + 1)

' Set it
pc = (hi << 8) OR lo
' Reset internal registers
a = 0
x = 0
y = 0
stkp = &HFD
status = &H00 OR U

' Clear internal helper variables
addr_rel = &H0000
addr_abs = &H0000
fetched = &H00

' Reset takes time
clock_count = 8
end sub


' Interrupt requests are a complex operation and only happen if the
' "disable interrupt" flag is 0. IRQs can happen at any time, but
' you dont want them to be destructive to the operation of the running
' program. Therefore the current instruction is allowed to finish
' (which I facilitate by doing the whole thing when cycles = 0) and
' then the current program counter is stored on the stack. Then the
' current status register is stored on the stack. When the routine
' that services the interrupt has finished, the status register
' and program counter can be restored to how they where before it
' occurred. This is impemented by the "RTI" instruction. Once the IRQ
' has happened, in a similar way to a reset, a programmable address
' is read form hard coded location &HFFFE, which is subsequently
' set to the program counter.
sub irq
' If interrupts are allowed
if (GetFlag(I) = 0) then
 ' Push the program counter to the stack. It's 16-bits dont
 ' forget so that takes two pushes
 writebus(&H0100 + stkp, (pc >> 8) AND &H00FF)
 stkp=stkp-1
 writebus(&H0100 + stkp, pc AND &H00FF)
 stkp=stkp-1

 ' Then Push the status register to the stack
 SetFlag(B, 0)
 SetFlag(U, 1)
 SetFlag(I, 1)
 writebus(&H0100 + stkp, status)
 stkp=stkp-1

 ' Read new program counter location from fixed address
 addr_abs = &HFFFE
  lo = readbus(addr_abs + 0)
  hi = readbus(addr_abs + 1)
 pc = (hi << 8) OR lo

 ' IRQs take time
 cycles = 7
endif
end sub


' A Non-Maskable Interrupt cannot be ignored. It behaves in exactly the
' same way as a regular IRQ, but reads the new program counter address
' form location &HFFFA.
sub nmi
writebus(&H0100 + stkp, (pc >> 8) AND &H00FF)
stkp=stkp-1
writebus(&H0100 + stkp, pc AND &H00FF)
stkp=stkp-1

SetFlag(B, 0)
SetFlag(U, 1)
SetFlag(I, 1)
writebus(&H0100 + stkp, status)
stkp=stkp-1

addr_abs = &HFFFA
 lo = readbus(addr_abs + 0)
 hi = readbus(addr_abs + 1)
pc = (hi << 8) OR lo

cycles = 8
end sub

' Perform one clock cycles worth of emulation
sub clock

' Each instruction requires a variable number of clock cycles to execute.
' In my emulation, I only care about the final result and so I perform
' the entire computation in one hit. In hardware, each clock cycle would
' perform "microcode" style transformations of the CPUs state.
'
' To remain compliant with connected devices, it's important that the
' emulation also takes "time" in order to execute instructions, so I
' implement that delay by simply counting down the cycles required by
' the instruction. When it reaches 0, the instruction is complete, and
' the next one is ready to be executed.
' if (cycles = 0) then

 ' Read next instruction byte. This 8-bit value is used to index
 ' the translation table to get the relevant information about
 ' how to implement the instruction
 opcode = readbus(pc)


 ' Always set the unused status flag bit to 1
 SetFlag(U, true)

 ' Increment program counter, we read the opcode byte
 pc=pc+1

 ' Get Starting number of cycles
 cycles = buscycles(opcode)

 ' Perform fetch of intermmediate data using the
 ' required addressing mode
 additional_cycle1=0
 call addrmode(opcode)

 ' Perform operation
 additional_cycle2=0
 call operate(opcode)

 ' The addressmode and opcode may have altered the number
 ' of cycles this instruction requires before its completed
 cycles = cycles + (additional_cycle1 AND additional_cycle2)

 ' Always set the unused status flag bit to 1
 SetFlag(U, true)

' endif

' Increment global clock count - This is actually unused unless logging is enabled
' but I've kept it in because its a handy watch variable for debugging
clock_count=clock_count+cycles

' Decrement the number of cycles remaining for this instruction
' cycles=cycles-1
end sub





'''''''''''''''''''''''''''''''''''''''/
' FLAG FUNCTIONS

' Returns the value of a specific bit of the status register
FUNCTION GetFlag(f as integer) as integer
if (status and f) > 0 then GetFlag=1 else GetFlag=0
end FUNCTION

' Sets or clears a specific bit of the status register
sub SetFlag(f as integer, v as integer)
if (v) then
 status = status OR f
else
 status = status and  (INV f)
endif
end sub





'''''''''''''''''''''''''''''''''''''''/
' ADDRESSING MODES

' The 6502 can address between &H0000 - &HFFFF. The high byte is often referred
' to as the "page", and the low byte is the offset into that page. This implies
' there are 256 pages, each containing 256 bytes.
'
' Several addressing modes have the potential to require an additional clock
' cycle if they cross a page boundary. This is combined with several instructions
' that enable this additional clock cycle. So each addressing function returns
' a flag saying it has potential, as does each instruction. If both instruction
' and address function return 1, then an additional clock cycle is required.


' Address Mode: Implied
' There is no additional data required for this instruction. The instruction
' does something very simple like like sets a status bit. However, we will
' target the accumulator, for instructions like PHA
sub IMP
fetched = a
end sub


' Address Mode: Immediate
' The instruction expects the next byte to be used as a value, so we'll prep
' the read address to point to the next byte
sub IMM
addr_abs = pc
pc=pc+1
end sub



' Address Mode: Zero Page
' To save program bytes, zero page addressing allows you to absolutely address
' a location in first &HFF bytes of address range. Clearly this only requires
' one byte instead of the usual two.
sub ZP0
addr_abs = readbus(pc)
pc=pc+1
addr_abs = addr_abs and &Hff
end sub



' Address Mode: Zero Page with X Offset
' Fundamentally the same as Zero Page addressing, but the contents of the X Register
' is added to the supplied single byte address. This is useful for iterating through
' ranges within the first page.
sub ZPX
addr_abs = (readbus(pc) + x)
pc=pc+1
addr_abs = addr_abs and &Hff
end sub


' Address Mode: Zero Page with Y Offset
' Same as above but uses Y Register for offset
sub ZPY
addr_abs = (readbus(pc) + y)
pc=pc+1
addr_abs = addr_abs and &Hff
end sub


' Address Mode: Relative
' This address mode is exclusive to branch instructions. The address
' must reside within -128 to +127 of the branch instruction, i.e.
' you cant directly branch to any address in the addressable range.
sub REL
addr_rel = readbus(pc)
pc=pc+1
if (addr_rel AND &H80) then addr_rel = addr_rel OR &HFFFFFFFFFFFFFF00
end sub


' Address Mode: Absolute
' A full 16-bit address is loaded and used
sub ABS
 lo = readbus(pc)
pc=pc+1
 hi = readbus(pc)
pc=pc+1
addr_abs = (hi << 8) OR lo
end sub


' Address Mode: Absolute with X Offset
' Fundamentally the same as absolute addressing, but the contents of the X Register
' is added to the supplied two byte address. If the resulting address changes
' the page, an additional clock cycle is required
sub ABX
lo = readbus(pc)
pc=pc+1
 hi = readbus(pc)
pc=pc+1
addr_abs = (hi << 8) OR lo
addr_abs = addr_abs + x
if ((addr_abs AND &HFF00) <> (hi << 8)) then additional_cycle1=1
end sub


' Address Mode: Absolute with Y Offset
' Fundamentally the same as absolute addressing, but the contents of the Y Register
' is added to the supplied two byte address. If the resulting address changes
' the page, an additional clock cycle is required
sub ABY
lo = readbus(pc)
pc=pc+1
 hi = readbus(pc)
pc=pc+1

addr_abs = (hi << 8) OR lo
addr_abs = addr_abs +  y

if ((addr_abs AND &HFF00) <> (hi << 8)) then additional_cycle1=1
end sub

' Note: The next 3 address modes use indirection (aka PointersNOT)

' Address Mode: Indirect
' The supplied 16-bit address is read to get the actual 16-bit address. This is
' instruction is unusual in that it has a bug in the hardware! To emulate its
' function accurately, we also need to emulate this bug. If the low byte of the
' supplied address is &HFF, then to read the high byte of the actual address
' we need to cross a page boundary. This doesn't actually work on the chip as
' designed, instead it wraps back around in the same page, yielding an
' invalid actual address
sub IND
ptr_lo = readbus(pc)
pc=pc+1
ptr_hi = readbus(pc)
pc=pc+1
ptr = (ptr_hi << 8) OR ptr_lo
if (ptr_lo = &H00FF) then' Simulate page boundary hardware bug
 addr_abs = (readbus(ptr AND &HFF00) << 8) OR readbus(ptr + 0)
else ' Behave normally
 addr_abs = (readbus(ptr + 1) << 8) OR readbus(ptr + 0)
endif
end sub


' Address Mode: Indirect X
' The supplied 8-bit address is offset by X Register to index
' a location in page &H00. The actual 16-bit address is read
' from this location
sub IZX
t = readbus(pc)
pc=pc+1
lo = readbus((t + x) AND &H00FF)
hi = readbus((t + x + 1) AND &H00FF)
addr_abs = (hi << 8) OR lo
end sub


' Address Mode: Indirect Y
' The supplied 8-bit address indexes a location in page &H00. From
' here the actual 16-bit address is read, and the contents of
' Y Register is added to it to offset it. If the offset causes a
' change in page then an additional clock cycle is required.
sub IZY
t = readbus(pc)
pc=pc+1
lo = readbus(t AND &H00FF)
hi = readbus((t + 1) AND &H00FF)
addr_abs = (hi << 8) OR lo
addr_abs = addr_abs +  y
if ((addr_abs AND &HFF00) <> (hi << 8)) then additional_cycle1=0
end sub



' This function sources the data used by the instruction into
' a convenient numeric variable. Some instructions don't have to
' fetch data as the source is implied by the instruction. For example
' "INX" increments the X register. There is no additional data
' required. For all other addressing modes, the data resides at
' the location held within addr_abs, so it is read from there.
' Immediate address mode exploits this slightly, as that has
' set addr_abs = pc + 1, so it fetches the data from the
' next byte for example "LDA $FF" just loads the accumulator with
' 256, i.e. no far reaching memory fetch is required. "fetched"
' is a variable global to the CPU, and is set by calling this
' function. It also returns it for convenience.
sub fetch
if (not(addrmode(opcode) = "IMP")) then fetched = readbus(addr_abs)
end sub





'''''''''''''''''''''''''''''''''''''''/
' INSTRUCTION IMPLEMENTATIONS

' Note: Ive started with the two most complicated instructions to emulate, which
' ironically is addition and subtraction! Ive tried to include a detailed
' explanation as to why they are so complex, yet so fundamental. Im also NOT
' going to do this through the explanation of 1 and 2's complement.

' Instruction: Add with Carry In
' Function:    A = A + M + C
' Flags Out:   C, V, N, Z
'
' Explanation:
' The purpose of this function is to add a value to the accumulator and a carry bit. If
' the result is > 255 there is an overflow setting the carry bit. This allows you to
' chain together ADC instructions to add numbers larger than 8-bits. This in itself is
' simple, however the 6502 supports the concepts of Negativity/Positivity and Signed Overflow.
'
' 10000100 = 128 + 4 = 132 in normal circumstances, we know this as unsigned and it allows
' us to represent numbers between 0 and 255 (given 8 bits). The 6502 can also interpret
' this word as something else if we assume those 8 bits represent the range -128 to +127,
' i.e. it has become signed.
'
' Since 132 > 127, it effectively wraps around, through -128, to -124. This wraparound is
' called overflow, and this is a useful to know as it indicates that the calculation has
' gone outside the permissible range, and therefore no longer makes numeric sense.
'
' Note the implementation of ADD is the same in binary, this is just about how the numbers
' are represented, so the word 10000100 can be both -124 and 132 depending upon the
' context the programming is using it in. We can prove this!
'
'  10000100 =  132  or  -124
' +00010001 = + 17      + 17
'  ====    ==       ==     See, both are valid additions, but our interpretation of
'  10010101 =  149  or  -107     the context changes the value, not the hardware!
'
' In principle under the -128 to 127 range:
' 10000000 = -128, 11111111 = -1, 00000000 = 0, 00000000 = +1, 01111111 = +127
' therefore negative numbers have the most significant set, positive numbers do not
'
' To assist us, the 6502 can set the overflow flag, if the result of the addition has
' wrapped around. V <- NOT(AXORM) AND AXOR(A+M+C) :D lol, let's work out why!
'
' Let's suppose we have A = 30, M = 10 and C = 0
'          A = 30 = 00011110
'          M = 10 = 00001010+
'     RESULT = 40 = 00101000
'
' Here we have not gone out of range. The resulting significant bit has not changed.
' So let's make a truth table to understand when overflow has occurred. Here I take
' the MSB of each component, where R is RESULT.
'
' A  M  R OR V OR AXORR OR AXORM ORNOT(AXORM) OR
' 0  0  0 OR 0 OR  0  OR  0  OR   1   OR
' 0  0  1 OR 1 OR  1  OR  0  OR   1   OR
' 0  1  0 OR 0 OR  0  OR  1  OR   0   OR
' 0  1  1 OR 0 OR  1  OR  1  OR   0   OR  so V = NOT(AXORM) AND (AXORR)
' 1  0  0 OR 0 OR  1  OR  1  OR   0   OR
' 1  0  1 OR 0 OR  0  OR  1  OR   0   OR
' 1  1  0 OR 1 OR  1  OR  0  OR   1   OR
' 1  1  1 OR 0 OR  0  OR  0  OR   1   OR
'
' We can see how the above equation calculates V, based on A, M and R. V was chosen
' based on the following hypothesis:
'       Positive Number + Positive Number = Negative Result -> Overflow
'       Negative Number + Negative Number = Positive Result -> Overflow
'       Positive Number + Negative Number = Either Result -> Cannot Overflow
'       Positive Number + Positive Number = Positive Result -> OK! No Overflow
'       Negative Number + Negative Number = Negative Result -> OK! NO Overflow
sub ADC

' Grab the data that we are adding to the accumulator
fetch

' Add is performed in 16-bit domain for emulation to capture any
' carry bit, which will exist in bit 8 of the 16-bit word
temp = a + fetched + GetFlag(C)

' The carry flag out exists in the high byte bit 0
SetFlag(C, temp > 255)

' The Zero flag is set if the result is 0
if (temp and &H00FF) then SetFlag(Z, true) else SetFlag(Z, false)

' The signed Overflow flag is set based on all that up thereNOT :D
SetFlag(V, (INV(a XOR fetched) AND (a XOR temp)) AND &H0080)

' The negative flag is set to the most significant bit of the result
SetFlag(N, temp AND &H80)

' Load the result into the accumulator (it's 8-bit don't forget!)
a = temp AND &H00FF

' This instruction has the potential to require an additional clock cycle
additional_cycle2 = 1
end sub


' Instruction: Subtraction with Borrow In
' Function:    A = A - M - (1 - C)
' Flags Out:   C, V, N, Z
'
' Explanation:
' Given the explanation for ADC above, we can reorganise our data
' to use the same computation for addition, for subtraction by multiplying
' the data by -1, i.e. make it negative
'
' A = A - M - (1 - C)  ->  A = A + -1 * (M - (1 - C))  ->  A = A + (-M + 1 + C)
'
' To make a signed positive number negative, we can invert the bits and add 1
' (OK, I lied, a little bit of 1 and 2s complement :P)
'
'  5 = 00000101
' -5 = 11111010 + 00000001 = 11111011 (or 251 in our 0 to 255 range)
'
' The range is actually unimportant, because if I take the value 15, and add 251
' to it, given we wrap around at 256, the result is 10, so it has effectively
' subtracted 5, which was the original intention. (15 + 251) % 256 = 10
'
' Note that the equation above used (1-C), but this got converted to + 1 + C.
' This means we already have the +1, so all we need to do is invert the bits
' of M, the data(NOT) therefore we can simply add, exactly the same way we did
' before.
sub SBC
fetch
' Operating in 16-bit domain to capture carry out
' We can invert the bottom 8 bits with bitwise xor
 value = (fetched) XOR &H00FF
' Notice this is exactly the same as addition from here!
temp = a + value + GetFlag(C)
SetFlag(C, temp AND &HFF00)
if (temp and &H00FF) then SetFlag(Z, true) else SetFlag(Z, false)
SetFlag(V, (temp XOR a) AND (temp XOR value) AND &H0080)
SetFlag(N, temp AND &H0080)
a = temp AND &H00FF
additional_cycle2 = 1
end sub

' OK! Complicated operations are done! the following are much simpler
' and conventional. The typical order of events is:
' 1) Fetch the data you are working with
' 2) Perform calculation
' 3) Store the result in desired place
' 4) Set Flags of the status register
' 5) Return if instruction has potential to require additional
'    clock cycle


' Instruction: Bitwise Logic AND
' Function:    A = A AND M
' Flags Out:   N, Z
sub AN6
fetch
a = a AND fetched
if (a=&H00) then SetFlag(Z, true) else SetFlag(Z, false)
SetFlag(N, a AND &H80)
additional_cycle2 = 1
end sub


' Instruction: Arithmetic Shift Left
' Function:    A = C <- (A << 1) <- 0
' Flags Out:   N, Z, C
sub ASL
fetch
temp = fetched << 1
SetFlag(C, (temp AND &HFF00) > 0)
if (temp and &H00FF) then SetFlag(Z, true) else SetFlag(Z, false)
SetFlag(N, temp AND &H80)
if (addrmode(opcode) = "IMP") then
 a = temp AND &H00FF
else
 writebus(addr_abs, temp AND &H00FF)
endif
end sub


' Instruction: Branch if Carry Clear
' Function:    if(C = 0) pc = address
sub BCC
if (GetFlag(C) = 0) then
 cycles=cycles+1
 addr_abs = pc + addr_rel
 if((addr_abs AND &HFF00) <> (pc AND &HFF00)) then cycles=cycles+1
 pc = addr_abs
endif
end sub


' Instruction: Branch if Carry Set
' Function:    if(C = 1) pc = address
sub BCS
if (GetFlag(C) = 1) then
 cycles=cycles+1
 addr_abs = pc + addr_rel
 if((addr_abs AND &HFF00) <> (pc AND &HFF00)) then cycles=cycles+1
 pc = addr_abs
endif
end sub


' Instruction: Branch if Equal
' Function:    if(Z = 1) pc = address
sub BEQ
if (GetFlag(Z) = 1) then
 cycles=cycles+1
 addr_abs = pc + addr_rel
 if((addr_abs AND &HFF00) <> (pc AND &HFF00)) then cycles=cycles+1
 pc = addr_abs
endif
end sub
sub BIT
fetch
temp = a AND fetched
if (temp and &H00FF) then SetFlag(Z, true) else SetFlag(Z, false)
SetFlag(N, fetched AND (1 << 7))
SetFlag(V, fetched AND (1 << 6))
end sub


' Instruction: Branch if Negative
' Function:    if(N = 1) pc = address
sub BMI
if (GetFlag(N) = 1) then
 cycles=cycles+1
 addr_abs = pc + addr_rel
 if((addr_abs AND &HFF00) <> (pc AND &HFF00)) then cycles=cycles+1
 pc = addr_abs
endif
end sub


' Instruction: Branch if Not Equal
' Function:    if(Z = 0) pc = address
sub BNE
if (GetFlag(Z) = 0) then
 cycles=cycles+1
 addr_abs = pc + addr_rel
 if((addr_abs AND &HFF00) <> (pc AND &HFF00)) then cycles=cycles+1
 pc = addr_abs
endif
end sub


' Instruction: Branch if Positive
' Function:    if(N = 0) pc = address
sub BPL

if (GetFlag(N) = 0) then
 cycles=cycles+1
 addr_abs = pc + addr_rel
 if((addr_abs AND &HFF00) <> (pc AND &HFF00)) then cycles=cycles+1
 pc = addr_abs
endif
end sub

' Instruction: Break
' Function:    Program Sourced Interrupt
sub BRK
pc=pc+1
SetFlag(I, 1)
writebus(&H0100 + stkp, (pc >> 8) AND &H00FF)
stkp=stkp-1
writebus(&H0100 + stkp, pc AND &H00FF)
stkp=stkp-1
SetFlag(B, 1)
writebus(&H0100 + stkp, status)
stkp=stkp-1
SetFlag(B, 0)
pc = readbus(&HFFFE) OR (readbus(&HFFFF) << 8)
end sub


' Instruction: Branch if Overflow Clear
' Function:    if(V = 0) pc = address
sub BVC
if (GetFlag(V) = 0) then
 cycles=cycles+1
 addr_abs = pc + addr_rel
 if((addr_abs AND &HFF00) <> (pc AND &HFF00)) then cycles=cycles+1
 pc = addr_abs
endif
end sub


' Instruction: Branch if Overflow Set
' Function:    if(V = 1) pc = address
sub BVS
if (GetFlag(V) = 1) then
 cycles=cycles+1
 addr_abs = pc + addr_rel
 if((addr_abs AND &HFF00) <> (pc AND &HFF00)) then cycles=cycles+1
 pc = addr_abs
endif
end sub


' Instruction: Clear Carry Flag
' Function:    C = 0
sub CLC
SetFlag(C, false)
end sub


' Instruction: Clear Decimal Flag
' Function:    D = 0
sub CLD
SetFlag(D, false)
end sub


' Instruction: Disable Interrupts / Clear Interrupt Flag
' Function:    I = 0
sub CLI
SetFlag(I, false)
end sub


' Instruction: Clear Overflow Flag
' Function:    V = 0
sub CLV
SetFlag(V, false)
end sub

' Instruction: Compare Accumulator
' Function:    C <- A >= M      Z <- (A - M) = 0
' Flags Out:   N, C, Z
sub CMP
additional_cycle2 = 0
fetch
temp = a - fetched
SetFlag(C, a >= fetched)
if (temp and &H00FF = &H0000) then SetFlag(Z, true) else SetFlag(Z, false)
SetFlag(N, temp AND &H0080)
additional_cycle2 = 1
end sub


' Instruction: Compare X Register
' Function:    C <- X >= M      Z <- (X - M) = 0
' Flags Out:   N, C, Z
sub CPX
fetch
temp = x - fetched
SetFlag(C, x >= fetched)
if (temp and &H00FF = &H0000) then SetFlag(Z, true) else SetFlag(Z, false)
SetFlag(N, temp AND &H0080)
end sub


' Instruction: Compare Y Register
' Function:    C <- Y >= M      Z <- (Y - M) = 0
' Flags Out:   N, C, Z
sub CPY
fetch
temp = y - fetched
SetFlag(C, y >= fetched)
if (temp and &H00FF = &H0000) then SetFlag(Z, true) else SetFlag(Z, false)
SetFlag(N, temp AND &H0080)
end sub


' Instruction: Decrement Value at Memory Location
' Function:    M = M - 1
' Flags Out:   N, Z
sub DEC
fetch
temp = fetched - 1
writebus(addr_abs, temp AND &H00FF)
if (temp and &H00FF = &H0000) then SetFlag(Z, true) else SetFlag(Z, false)
SetFlag(N, temp AND &H0080)
end sub


' Instruction: Decrement X Register
' Function:    X = X - 1
' Flags Out:   N, Z
sub DEX
x=x-1
if x=&H00 then SetFlag(Z,true) else SetFlag(Z, false)
SetFlag(N, x AND &H80)
end sub


' Instruction: Decrement Y Register
' Function:    Y = Y - 1
' Flags Out:   N, Z
sub DEY
y=y-1
if y=&H00 then SetFlag(Z,true) else SetFlag(Z, false)
SetFlag(N, y AND &H80)
end sub


' Instruction: Bitwise Logic XOR
' Function:    A = A xor M
' Flags Out:   N, Z
sub EOR
fetch
a = a XOR fetched
if a=&H00 then SetFlag(Z,true) else SetFlag(Z, false)
SetFlag(N, a AND &H80)
additional_cycle2 = 1
end sub


' Instruction: Increment Value at Memory Location
' Function:    M = M + 1
' Flags Out:   N, Z
sub INC
fetch
temp = fetched + 1
writebus(addr_abs, temp AND &H00FF)
if (temp and &H00FF = &H0000) then SetFlag(Z, true) else SetFlag(Z, false)
SetFlag(N, temp AND &H0080)
end sub


' Instruction: Increment X Register
' Function:    X = X + 1
' Flags Out:   N, Z
sub INX
x=x+1
if (x = &H00) then SetFlag(Z, true) else SetFlag(Z, false)
SetFlag(N, x AND &H80)
end sub


' Instruction: Increment Y Register
' Function:    Y = Y + 1
' Flags Out:   N, Z
sub INY
y=y+1
if (y = &H00) then SetFlag(Z, true) else SetFlag(Z, false)
SetFlag(N, y AND &H80)
end sub


' Instruction: Jump To Location
' Function:    pc = address
sub JMP
pc = addr_abs
end sub


' Instruction: Jump To Sub-Routine
' Function:    Push current pc to stack, pc = address
sub JSR
pc=pc-1
writebus(&H0100 + stkp, (pc >> 8) AND &H00FF)
stkp=stkp-1
writebus(&H0100 + stkp, pc AND &H00FF)
stkp=stkp-1
pc = addr_abs
end sub


' Instruction: Load The Accumulator
' Function:    A = M
' Flags Out:   N, Z
sub LDA
fetch
a = fetched
if (a = &H00) then SetFlag(Z, true) else SetFlag(Z, false)
SetFlag(N, a AND &H80)
additional_cycle2 = 1
end sub


' Instruction: Load The X Register
' Function:    X = M
' Flags Out:   N, Z
sub LDX
fetch
x = fetched
if x=&H00 then SetFlag(Z,true) else SetFlag(Z, false)
SetFlag(N, x AND &H80)
additional_cycle2 = 1
end sub


' Instruction: Load The Y Register
' Function:    Y = M
' Flags Out:   N, Z
sub LDY
fetch
y = fetched
if y=&H00 then SetFlag(Z,true) else SetFlag(Z, false)
SetFlag(N, y AND &H80)
additional_cycle2 = 1
end sub
sub LSR
fetch
SetFlag(C, fetched AND &H0001)
temp = fetched >> 1
if (temp and &H00FF) then SetFlag(Z, true) else SetFlag(Z, false)
SetFlag(N, temp AND &H0080)
if (addrmode(opcode) = "IMP") then
 a = temp AND &H00FF
else
 writebus(addr_abs, temp AND &H00FF)
endif
end sub

sub NOP
' Sadly not all NOPs are equal, Ive added a few here
' based on https:'wiki.nesdev.com/w/index.php/CPU_unofficial_opcodes
' and will add more based on game compatibility, and ultimately
' I'd like to cover all illegal opcodes too
select case opcode
case &H1C
case &H3C
case &H5C
case &H7C
case &HDC
case &HFC
 additional_cycle2 = 1
case else
 additional_cycle2 = 0
end select
end sub


' Instruction: Bitwise Logic OR
' Function:    A = A OR M
' Flags Out:   N, Z
sub ORA
fetch
a = a OR fetched
if a=&H00 then SetFlag(Z,true) else SetFlag(Z, false)
SetFlag(N, a AND &H80)
return 1
end sub


' Instruction: Push Accumulator to Stack
' Function:    A -> stack
sub PHA
writebus(&H0100 + stkp, a)
stkp=stkp-1
end sub


' Instruction: Push Status Register to Stack
' Function:    status -> stack
' Note:        Break flag is set to 1 before push
sub PHP
writebus(&H0100 + stkp, status OR B OR U)
SetFlag(B, 0)
SetFlag(U, 0)
stkp=stkp-1
end sub


' Instruction: Pop Accumulator off Stack
' Function:    A <- stack
' Flags Out:   N, Z
sub PLA
stkp = stkp + 1
a = readbus(&H0100 + stkp)
if a=&H00 then SetFlag(Z,true) else SetFlag(Z, false)
SetFlag(N, a AND &H80)
end sub


' Instruction: Pop Status Register off Stack
' Function:    Status <- stack
sub PLP
stkp = stkp + 1
status = readbus(&H0100 + stkp)
SetFlag(U, 1)
end sub

sub ROL
fetch
temp = (fetched << 1) OR GetFlag(C)
SetFlag(C, temp AND &HFF00)
if (temp and &H00FF) then SetFlag(Z, true) else SetFlag(Z, false)
SetFlag(N, temp AND &H0080)
if (addrmode(opcode) = "IMP") then
 a = temp AND &H00FF
else
 writebus(addr_abs, temp AND &H00FF)
endif
end sub

sub ROR
fetch
temp = (GetFlag(C) << 7) OR (fetched >> 1)
SetFlag(C, fetched AND &H01)
if (temp and &H00FF) then SetFlag(Z, true) else SetFlag(Z, false)
SetFlag(N, temp AND &H0080)
if (addrmode(opcode) = "IMP") then
 a = temp AND &H00FF
else
 writebus(addr_abs, temp AND &H00FF)
endif
end sub

sub RTI
stkp = stkp + 1
status = readbus(&H0100 + stkp)
status = status and (inv B)
status = status and (inv U)
stkp = stkp + 1
pc = readbus(&H0100 + stkp)
stkp = stkp + 1
pc = pc OR  readbus(&H0100 + stkp) << 8
end sub

sub RTS
stkp = stkp + 1
pc = readbus(&H0100 + stkp)
stkp = stkp + 1
pc = pc OR  readbus(&H0100 + stkp) << 8
pc=pc+1
end sub




' Instruction: Set Carry Flag
' Function:    C = 1
sub SEC
SetFlag(C, true)
end sub


' Instruction: Set Decimal Flag
' Function:    D = 1
sub SED
SetFlag(D, true)
end sub


' Instruction: Set Interrupt Flag / Enable Interrupts
' Function:    I = 1
sub SEI

SetFlag(I, true)
end sub


' Instruction: Store Accumulator at Address
' Function:    M = A
sub STA
writebus(addr_abs, a)
end sub


' Instruction: Store X Register at Address
' Function:    M = X
sub STX
writebus(addr_abs, x)
end sub


' Instruction: Store Y Register at Address
' Function:    M = Y
sub STY
writebus(addr_abs, y)
end sub


' Instruction: Transfer Accumulator to X Register
' Function:    X = A
' Flags Out:   N, Z
sub TAX
x = a
if x=&H00 then SetFlag(Z,true) else SetFlag(Z, false)
SetFlag(N, x AND &H80)
end sub


' Instruction: Transfer Accumulator to Y Register
' Function:    Y = A
' Flags Out:   N, Z
sub TAY
y = a
if y=&H00 then SetFlag(Z,true) else SetFlag(Z, false)
SetFlag(N, y AND &H80)
end sub


' Instruction: Transfer Stack Pointer to X Register
' Function:    X = stack pointer
' Flags Out:   N, Z
sub TSX
x = stkp
if x=&H00 then SetFlag(Z,true) else SetFlag(Z, false)
SetFlag(N, x AND &H80)
end sub


' Instruction: Transfer X Register to Accumulator
' Function:    A = X
' Flags Out:   N, Z
sub TXA
a = x
if a=&H00 then SetFlag(Z,true) else SetFlag(Z, false)
SetFlag(N, a AND &H80)
end sub


' Instruction: Transfer X Register to Stack Pointer
' Function:    stack pointer = X
sub TXS
stkp = x
end sub


' Instruction: Transfer Y Register to Accumulator
' Function:    A = Y
' Flags Out:   N, Z
sub TYA
a = y
if a=&H00 then SetFlag(Z,true) else SetFlag(Z, false)
SetFlag(N, a AND &H80)
end sub


' This function captures illegal opcodes
sub XXX

end sub

Edited 2020-11-01 22:23 by matherp
 
lizby
Guru

Joined: 17/05/2016
Location: United States
Posts: 3378
Posted: 12:19pm 01 Nov 2020
Copy link to clipboard 
Print this post

  matherp said  is entirely dependent on the new CALL command


Ah! A use case. I wondered what might have brought about the addition of CALL. Neat.

Early on someone mentioned a Z80 emulator for the CMM2. And then, CP/M.
PicoMite, Armmite F4, SensorKits, MMBasic Hardware, Games, etc. on fruitoftheshed
 
matherp
Guru

Joined: 11/12/2012
Location: United Kingdom
Posts: 10310
Posted: 12:26pm 01 Nov 2020
Copy link to clipboard 
Print this post

I hope the code provides a generic template for any sort of interpreter. Certainly it is massively more efficient then huge SELECT CASE or IF THEN ELSEIF ENDIF clauses
Edited 2020-11-01 22:26 by matherp
 
jirsoft

Guru

Joined: 18/09/2020
Location: Czech Republic
Posts: 533
Posted: 12:59pm 01 Nov 2020
Copy link to clipboard 
Print this post

Hi Peter,
perfect work! As I currently write C64 implementation on CMM2, it's for sure nice tool to optimise (I'm somewhere between 1/100 of C64 speed to 1/7 with CSUB help...).

Just for info, your code needs to be a little modified, until now I found with quick test DEX and DEY doesn't work because not rounding to 8 bits (I think the original maybe used 8 bit variables for registers).


' Instruction: Decrement X Register
' Function:    X = X - 1
' Flags Out:   N, Z
sub DEX
x=x-1
if x=&H00 then SetFlag(Z,true) else SetFlag(Z, false)
SetFlag(N, x AND &H80)
end sub


on second line needs to be:

x=(x-1) AND &hFF

Jiri
Napoleon Commander and SimplEd for CMM2 (GitHub),  CMM2.fun
 
William Leue
Guru

Joined: 03/07/2020
Location: United States
Posts: 405
Posted: 02:01pm 01 Nov 2020
Copy link to clipboard 
Print this post

Very nifty!
-Bill
 
matherp
Guru

Joined: 11/12/2012
Location: United Kingdom
Posts: 10310
Posted: 02:04pm 01 Nov 2020
Copy link to clipboard 
Print this post

  Quote  DEX and DEY doesn't work because not rounding to 8 bits


Thanks - same for INX and INY. Can't see any others at first glance
 
jirsoft

Guru

Joined: 18/09/2020
Location: Czech Republic
Posts: 533
Posted: 03:53pm 01 Nov 2020
Copy link to clipboard 
Print this post

The problem (I think) will be the same in calculation of SP (stkp), PC and maybe somewhere else. But anyway, your CALL modification wll improve performance of my "clean BASIC" emulator...

Also the LONGSTRING extensions are very welcome.

Thank you!
Jiri
Napoleon Commander and SimplEd for CMM2 (GitHub),  CMM2.fun
 
matherp
Guru

Joined: 11/12/2012
Location: United Kingdom
Posts: 10310
Posted: 06:31pm 01 Nov 2020
Copy link to clipboard 
Print this post

I don't believe there is an issue with the stack pointer or program counter as in the real silicon the processor would crash anyway if they wrap. In the code they are only ever incremented or decremented by 1.

Attached corrected version for the dec and inc instructions


M6502.zip
 
vegipete

Guru

Joined: 29/01/2013
Location: Canada
Posts: 1132
Posted: 06:53pm 01 Nov 2020
Copy link to clipboard 
Print this post

That's a bit better than double the speed of my 65C02 emulator, which uses a giant SELECT CASE to handle each op-code.

Time to try a re-write using CALL...

===
Are you sure about a processor crash with stack and pc under/overflow?
Edited 2020-11-02 05:23 by vegipete
Visit Vegipete's *Mite Library for cool programs.
 
matherp
Guru

Joined: 11/12/2012
Location: United Kingdom
Posts: 10310
Posted: 06:57pm 01 Nov 2020
Copy link to clipboard 
Print this post

You could speed it up quite a bit more by putting the bus read/write routines inline rather than a function call and having a bunch of pre-calculated masks for status bit setting/clearing and doing this in the instruction routines
Edited 2020-11-02 05:07 by matherp
 
jirsoft

Guru

Joined: 18/09/2020
Location: Czech Republic
Posts: 533
Posted: 08:12pm 01 Nov 2020
Copy link to clipboard 
Print this post

Hi Peter,
I just tried to change SELECT CASE into CALL of subroutines and I found a problem, when CALL is used in included file: I then get "Argument list" error. When I move the subroutine, what is calling back to the main file, everything is OK.
Jiri
Napoleon Commander and SimplEd for CMM2 (GitHub),  CMM2.fun
 
matherp
Guru

Joined: 11/12/2012
Location: United Kingdom
Posts: 10310
Posted: 09:11pm 01 Nov 2020
Copy link to clipboard 
Print this post

  Quote  when CALL is used in included file: I then get "Argument list" error. When I move the subroutine, what is calling back to the main file, everything is OK.


The function table is only constructed after the include files are merged and arguments are only evaluated when a function is called. You will need to provide a simple example if you want to prove this one isn't some sort of "operator" error.
Edited 2020-11-02 07:13 by matherp
 
jirsoft

Guru

Joined: 18/09/2020
Location: Czech Republic
Posts: 533
Posted: 09:47pm 01 Nov 2020
Copy link to clipboard 
Print this post


TEST.BAS


DIM STRING calledSub(2) LENGTH 2 = ("a", "b", "c")
DIM INTEGER i

#INCLUDE "TEST.INC"

FOR i=0 TO 2
 CALL calledSub(i)
NEXT i

testCall



TEST.INC

SUB testCall
 LOCAL INTEGER j
 FOR j=0 TO 2
   CALL calledSub(j)
 NEXT j
END SUB

SUB a
 ?"a was called"
END SUB

SUB b
 ?"b was called"
END SUB

SUB c
 ?"c was called"
END SUB


First CALLs from TEST.BAS are OK, then testCall in TEST.INC:
Error in TEST.INC line 4: Argument list
Jiri
Napoleon Commander and SimplEd for CMM2 (GitHub),  CMM2.fun
 
jirsoft

Guru

Joined: 18/09/2020
Location: Czech Republic
Posts: 533
Posted: 09:53pm 01 Nov 2020
Copy link to clipboard 
Print this post

And one more think:
since some new RC version of firmware (I'm not sure when and on the MacOS firmware updating is not so easy), it's not possible to call SUB/FUNCTION from command line after break/error... Variables are accessible, but calling of SUB or FUNCTION generate Unknown command error.
Jiri
Napoleon Commander and SimplEd for CMM2 (GitHub),  CMM2.fun
 
qwerty823
Newbie

Joined: 30/07/2020
Location: United States
Posts: 30
Posted: 09:56pm 01 Nov 2020
Copy link to clipboard 
Print this post

I have a simple example that causes a similar problem:

include.inc
Sub CallInclude
 Call "CalledFromInclude"
End Sub


main.bas
#include "include.inc"

Sub CalledFromInclude
 Print "Called from include file"
End Sub

cls
CallInclude


As is, this causes the error. If I change the sub in main.bas to something like:

Sub CalledFromInclude(dummy as integer)


then it works. I'm guessing something inside call is expecting an argument list either passed in, or expected.

If I manually inline the include file:


' #include "include.inc"

Sub CallInclude
 Call "CalledFromInclude"
End Sub

Sub CalledFromInclude
 Print "Called from include file"
End Sub

cls
CallInclude


then this works without the error.
 
matherp
Guru

Joined: 11/12/2012
Location: United Kingdom
Posts: 10310
Posted: 10:27am 02 Nov 2020
Copy link to clipboard 
Print this post

Thanks for the test code - bug found and fixed    Will post a new version later today
 
Print this page


To reply to this topic, you need to log in.

The Back Shed's forum code is written, and hosted, in Australia.
© JAQ Software 2025