diff --git a/PLASMA-BLD1.PO b/PLASMA-BLD1.PO deleted file mode 100644 index ed98e66..0000000 Binary files a/PLASMA-BLD1.PO and /dev/null differ diff --git a/PLASMA-BLD2.PO b/PLASMA-BLD2.PO new file mode 100644 index 0000000..500cddb Binary files /dev/null and b/PLASMA-BLD2.PO differ diff --git a/PLASMA-DEM1.PO b/PLASMA-DEM2.PO similarity index 74% rename from PLASMA-DEM1.PO rename to PLASMA-DEM2.PO index 62ca12c..2c4c1b3 100644 Binary files a/PLASMA-DEM1.PO and b/PLASMA-DEM2.PO differ diff --git a/PLASMA-SOS1.PO b/PLASMA-SOS2.PO similarity index 85% rename from PLASMA-SOS1.PO rename to PLASMA-SOS2.PO index a574b69..2f08230 100644 Binary files a/PLASMA-SOS1.PO and b/PLASMA-SOS2.PO differ diff --git a/PLASMA-SYS1.PO b/PLASMA-SYS1.PO deleted file mode 100644 index b198a9c..0000000 Binary files a/PLASMA-SYS1.PO and /dev/null differ diff --git a/PLASMA-SYS2.PO b/PLASMA-SYS2.PO new file mode 100755 index 0000000..6300c41 Binary files /dev/null and b/PLASMA-SYS2.PO differ diff --git a/SANDBOX.PO b/SANDBOX.PO deleted file mode 100755 index 30f66ef..0000000 Binary files a/SANDBOX.PO and /dev/null differ diff --git a/src/inc/cmdsys.plh b/src/inc/cmdsys.plh index a5bb328..b225302 100644 --- a/src/inc/cmdsys.plh +++ b/src/inc/cmdsys.plh @@ -2,7 +2,7 @@ import cmdsys // // Useful values for everyone // - const _SYSVER_ = $0100 // Version built against + const _SYSVER_ = $0200 // Version built against const FALSE = 0 const TRUE = not FALSE const NULL = 0 @@ -33,6 +33,7 @@ import cmdsys const reshgr2 = $0020 const resxhgr1 = $0040 const resxhgr2 = $0080 + const nojitc = $0100 // // Module don't free memory // @@ -46,8 +47,15 @@ import cmdsys word syspath word cmdline word modexec - byte refcons - byte devcons + word sysopen + word sysclose + word sysread + word syswrite + byte syserr + byte jitcount + byte jitsize + byte refcons // Apple /// specific + byte devcons // Apple /// specific end // // CMD exported functions diff --git a/src/libsrc/apple/cleanjit.pla b/src/libsrc/apple/cleanjit.pla new file mode 100644 index 0000000..d8a6cb3 --- /dev/null +++ b/src/libsrc/apple/cleanjit.pla @@ -0,0 +1,1831 @@ +// +// PLASMA JIT bytecode compiler +// +include "inc/cmdsys.plh" +// +// Module don't free memory +// +const modkeep = $2000 +const modinitkeep = $4000 +// +// Indirect interpreter DEFinition entrypoint +// +struc t_defentry + byte interpjsr + word interpaddr + word bytecodeaddr + byte callcount + byte bytecodesize +end +// +// JIT compiler constants +// +const jitcount = $10 +const jitcomp = $03E2 +const jitcodeptr = $03E4 +const codemax = $BEE0 +// +// AUX bytecode interpreter entrypoint +// +const interpentry = $03DC +// +// TOS caching values +// +const TOS_DIRTY = 1 +const TOS_CLEAN = 2 +// +// Y unknown value +// +const UNKNOWN = -1 +// +// Resolve virtual X with real X +// +def resolveX(codeptr, VX)#2 + while VX > 0 + ^codeptr = $E8; codeptr++ // INX + VX-- + loop + while VX < 0 + ^codeptr = $CA; codeptr++ // DEX + VX++ + loop + return codeptr, 0 +end +// +// JIT compiler entry +// +def compiler(defptr)#0 + word codeptr, isdata, addrxlate, bytecode, i, case, dest, VX, VY + byte opcode, j, A_IS_TOSL + + //puts("JIT compiler invoked for :$"); puth(defptr=>bytecodeaddr); putln + if isult(heapavail, 512 + defptr->bytecodesize) // 256 * sizeof(word) address xlate + // + // Not enough heap available + // + defptr=>interpaddr = interpentry + return + fin + addrxlate = heapmark + memset(addrxlate, 0, 512) // Clear xlate buffer + // + // Copy bytecode def from AUX to heap for compiling + // + bytecode = addrxlate + 512 // def bytecode + *$003C = defptr=>bytecodeaddr + *$003E = *$003C + defptr->bytecodesize + *$0042 = bytecode + call($C311, 0, 0, 0, $04) // CALL XMOVE with carry clear (AUX->MAIN) and ints disabled + //^$C053 // MIX TEXT + //puts("Addr Xlate: $"); puth(addrxlate); putln + //puts("Bytecode: $"); puth(bytecode); putln + // + // Find all branch targets and optimization fences. Tag the opcode with the LSB set + // + // All PLASMA ops are even (LSB clear), so this will flag when to fence optimizations + // During compiling. + // + isdata = addrxlate // Use this buffer + i = 0 + while i < defptr->bytecodesize + if not ^(isdata+i) + when (^(bytecode+i) & $FE) + // + // Double byte operands + // + is $26 // LA + is $2C // CW + is $54 // CALL + is $58 // ENTER + is $68 // LAB + is $6A // LAW + is $78 // SAB + is $7A // SAW + is $7C // DAB + is $7E // DAW + is $B4 // ADDAB + is $B6 // ADDAW + is $BC // IDXAB + is $BE // IDXAW + i = i + 2 + break + // + // Multi-byte operands + // + is $2E // CS + i = i + ^(bytecode+i+1) + // + // Single byte operands + // + is $2A // CB + is $28 // LLA + is $38 // ADDI + is $3A // SUBI + is $3C // ANDI + is $3E // ORI + is $5A // LEAVE + is $5E // CFFB + is $64 // LLB + is $66 // LLW + is $6C // DLB + is $6E // DLW + is $74 // SLB + is $76 // SLW + is $B0 // ADDLB + is $B2 // ADDLW + is $B8 // IDXLB + is $BA // IDXLW + i++ + break + // + // Branches + // + is $50 // BRNCH + is $22 // BREQ + is $24 // BENE + is $4C // BRFLS + is $4E // BRTRU + is $A0 // BRGT + is $A2 // BRLT + is $A4 // INCBRLE + is $A6 // ADDBRLE + is $A8 // DECBRGE + is $AA // SUBBRGE + is $AC // BRAND + is $AE // BROR + i++ + // + // Flag branch destination + // + dest = i + *(bytecode+i) + ^(bytecode+dest) = ^(bytecode+dest) | 1 + i++ + break + // + // SELect/caseblock + // + is $52 // SEL + i++ + case = i + *(bytecode+i) + i++ + ^(isdata+case) = TRUE // Flag as data + j = ^(bytecode+case) + case++ + repeat + *(isdata+case) = TRUE // Flag as data + case = case + 2 + dest = case + *(bytecode+case) + ^(bytecode+dest) = ^(bytecode+dest) | 1 // Flag as branch dest + *(isdata+case) = TRUE // Flag as data + case = case + 2 + j-- + until not j + break + wend + fin + i++ + loop + memset(isdata, 0, 256) // Clear part of xlate buffer used for isdata + // + // Compile the bytecodes + // + codeptr = *jitcodeptr + A_IS_TOSL = FALSE + VY = UNKNOWN // Virtual Y register + VX = 0 // Virtual X register + i = 0 + if ^bytecode == $58 + //putc('$'); puth(codeptr);//puts(":[0] ENTER "); puti(^(bytecode+1)); putc(',');puti(^(bytecode+2)); putln + // + // Call into VM + // + codeptr->0 = $20 // JSR INTERP + codeptr=>1 = $3D0 + codeptr->3 = $58 // ENTER CODE + codeptr=>4 = *(bytecode+1) // ENTER FRAME SIZE & ARG COUNT + codeptr->6 = $C0 // NATV CODE + codeptr = codeptr + 7 + i = 3 + fin + while isule(codeptr, codemax) + //putc('$'); puth(codeptr); putc(':') + //putc('['); puti(i); //puts("] ") + opcode = ^(bytecode+i) + if opcode & 1 + // + // Optimization fence. Sync A and X registers + // + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VY = UNKNOWN + A_IS_TOSL = FALSE + opcode = opcode & $FE + fin + // + // Update bytecode->native code address translation. + // + // Here's how it works: + // + // The code buffer is above address $8000 so MSBit set. + // When we compile a bytecode, update the destination address in + // the address xlate buffer with actual address (MSBit set). But, if a branch + // opcode jumps to a bytecode address that hasn't been compiled yet, add the + // address offset in the code buffer to the list of addresses needing resolution. + // The offset will be less than $8000, so MSBit clear. This is how we know if + // an address has been resolved or is a list of addresses needing resolution. + // Before updating the address xlate buffer with the known address as we + // compile, look for existing resolution list and traverse it if there. + // + if addrxlate=>[i] + // + // Address list awaiting resolution + // + dest = addrxlate=>[i] + *jitcodeptr + repeat + case = *dest + *dest = codeptr + dest = case + *jitcodeptr + until not case + fin + // + // Update address translate buffer with bytecode->native address + // + addrxlate=>[i] = codeptr + // + // Compile this bad boy... + // + if opcode < $20 // CONSTANT NYBBLE + //puts("CN $"); putb(opcode/2) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + *codeptr = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 2 + if opcode == 0 + ^codeptr = $98; codeptr++ // TYA -> LDA #$00 + else + *codeptr = $A9+(opcode/2<<8) // LDA #(CN/2) + codeptr = codeptr + 2 + fin + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + else + when opcode + is $20 // MINUS ONE + //puts("MINUS_ONE") + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + codeptr=>0 = $FFA9 // LDA #$FF + codeptr=>2 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 4 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $22 // BREQ + i++ + dest = i + *(bytecode+i) + i++ + //puts("BREQ "); puti(dest) + codeptr, VX = resolveX(codeptr, VX + 2) // INX; INX + if not A_IS_TOSL + *codeptr = $D0B5-$0200//+(VX<<8) // LDA ESTKL-2,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0D5-$0100//+(VX<<8) // CMP ESTKL-1,X + codeptr=>2 = $09D0 // BNE +9 + codeptr=>4 = $C0B5-$0200//+(VX<<8) // LDA ESTKH-2,X + codeptr=>6 = $C0D5-$0100//+(VX<<8) // CMP ESTKH-1,X + codeptr=>8 = $03D0 // BNE +3 + codeptr->10 = $4C // JMP abs + codeptr=>11 = addrxlate=>[dest] + if not (codeptr->12 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 11 - *jitcodeptr + fin + codeptr = codeptr + 13 + A_IS_TOSL = FALSE + break + is $24 // BRNE + i++ + dest = i + *(bytecode+i) + i++ + //puts("BRNE "); puti(dest) + codeptr, VX = resolveX(codeptr, VX + 2) // INX; INX + if not A_IS_TOSL + *codeptr = $D0B5-$0200//+(VX<<8) // LDA ESTKL-2,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0D5-$0100//+(VX<<8) // CMP ESTKL-1,X + codeptr=>2 = $06D0 // BNE +6 + codeptr=>4 = $C0B5-$0200//+(VX<<8) // LDA ESTKH-2,X + codeptr=>6 = $C0D5-$0100//+(VX<<8) // CMP ESTKH-1,X + codeptr=>8 = $03F0 // BEQ +3 + codeptr->10 = $4C // JMP abs + codeptr=>11 = addrxlate=>[dest] + if not (codeptr->12 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 11 - *jitcodeptr + fin + codeptr = codeptr + 13 + A_IS_TOSL = FALSE + break + is $26 // LA + is $2C // CW + dest = *(bytecode+i+1) + i = i + 2 + //puts("LA/CW $"); puth(dest) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + codeptr=>0 = $A9+(dest&$FF00) // LDA #2 = $C095+(VX<<8) // STA ESTKH,X + codeptr=>4 = $A9+(dest<<8) // LDA #>VAL + codeptr = codeptr + 6 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $28 // LLA + i++ + j = ^(bytecode+i) + //puts("LLA "); puti(^(bytecode+i)) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + if VY == j + ^codeptr = $98; codeptr++ // TYA -> LDA #imm + else + *codeptr = $A9+(j<<8) // LDA #imm + codeptr = codeptr + 2 + fin + codeptr->0 = $18 // CLC + codeptr=>1 = $E065 // ADC IFPL + codeptr=>3 = $D095+(VX<<8) // STA ESTKL,X + if VY == 0 + codeptr->5 = $98 // TYA -> LDA #00 + codeptr = codeptr + 6 + else + codeptr=>5 = $00A9 // LDA #$00 + codeptr = codeptr + 7 + fin + codeptr=>0 = $E165 // ADC IFPH + codeptr=>2 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 4 + A_IS_TOSL = FALSE + break + is $2A // CB + i++ + //puts("CB $"); putb(^(bytecode+i)) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + codeptr=>0 = $C094+(VX<<8) // STY ESTKH,X + codeptr=>2 = $A9+(^(bytecode+i)<<8) // LDA #imm + codeptr = codeptr + 4 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $2E // CS + i++ + j = ^(bytecode+i) + dest = codeptr + 10 + j + //puts("CS "); //puts(bytecode+i); //puts("-->"); puti(dest) + if isule(dest, codemax) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + codeptr=>0 = $A9+((codeptr+9)&$FF00) // LDA #>STRING + codeptr=>2 = $C095+(VX<<8) // STA ESTKH,X + codeptr=>4 = $A9+((codeptr+9)<<8) // LDA #6 = $4C // JMP abs + dest = codeptr + 10 + j + codeptr=>7 = dest + strcpy(codeptr + 9, bytecode + i) + i = i + j + fin + codeptr = dest + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $32 // DROP2 + //puts("DROP2") + VX++ // INX + is $30 // DROP + //puts("DROP") + VX++ // INX + A_IS_TOSL = FALSE + break + is $34 // DUP + //puts("DUP") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + elsif A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C0B4+(VX<<8) // LDY ESTKH,X + VX-- // DEX + codeptr=>2 = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 4 + VY = UNKNOWN + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + //is $36 + //puts("DIVMOD") + // + // Should never happen + // + //break + is $38 // ADDI + i++ + //puts("ADDI $"); putb(^(bytecode+i)) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $18 // CLC + codeptr=>1 = $69+(^(bytecode+i)<<8) // ADC #imm + codeptr=>3 = $0290 // BCC +2 + codeptr=>5 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr = codeptr + 7 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $3A // SUBI + i++ + //puts("SUBI $"); putb(^(bytecode+i)) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $38 // SEC + codeptr=>1 = $E9+(^(bytecode+i)<<8) // SBC #imm + codeptr=>3 = $02B0 // BCS +2 + codeptr=>5 = $C0D6+(VX<<8) // DEC ESTKH,X + codeptr = codeptr + 7 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $3C // ANDI + i++ + //puts("ANDI $"); putb(^(bytecode+i)) + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $29+(^(bytecode+i)<<8) // AND #imm + codeptr=>2 = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 4 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $3E // ORI + i++ + //puts("ORI $"); putb(^(bytecode+i)) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + *codeptr = $09+(^(bytecode+i)<<8) // ORA #imm + codeptr = codeptr + 2 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $40 // ISEQ + //puts("ISEQ") + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0D5+$0100+(VX<<8) // CMP ESTKL+1,X + codeptr=>2 = $07D0 // BNE +7 + codeptr=>4 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>6 = $C0D5+$0100+(VX<<8) // CMP ESTKH+1 + codeptr=>8 = $01D0 // BNE +1 + codeptr=>10 = $9888 // DEY; TYA + codeptr=>12 = $C094+$0100+(VX<<8) // STY ESTKH+1,X + codeptr = codeptr + 14 + VX++ // INX + VY = UNKNOWN + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $42 // ISNE + //puts("ISNE") + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0D5+$0100+(VX<<8) // CMP ESTKL+1,X + codeptr=>2 = $06D0 // BNE +6 + codeptr=>4 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>6 = $C0D5+$0100+(VX<<8) // CMP ESTKH+1 + codeptr=>8 = $01F0 // BEQ +1 + codeptr=>10 = $9888 // DEY; TYA + codeptr=>12 = $C094+$0100+(VX<<8) // STY ESTKH+1,X + codeptr = codeptr + 14 + VX++ // INX + VY = UNKNOWN + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $44 // ISGT + //puts("ISGT") + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0D5+$0100+(VX<<8) // CMP ESTKL+1,X + codeptr=>2 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>4 = $C0F5+$0100+(VX<<8) // SBC ESTKH+1 + codeptr=>6 = $0250 // BVC +2 + codeptr=>8 = $8049 // EOR #$80 + codeptr=>10 = $0110 // BPL +1 + codeptr=>12 = $9888 // DEY TYA + codeptr=>14 = $C094+$0100+(VX<<8) // STY ESTKH+1,X + codeptr = codeptr + 16 + VX++ // INX + VY = UNKNOWN + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $46 + //puts("ISLT") + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0B5+$0100+(VX<<8) // LDA ESTKL+1,X + codeptr=>2 = $D0D5+(VX<<8) // CMP ESTKL,X + codeptr=>4 = $C0B5+$0100+(VX<<8) // LDA ESTKH+1,X + codeptr=>6 = $C0F5+(VX<<8) // SBC ESTKH + codeptr=>8 = $0250 // BVC +2 + codeptr=>10 = $8049 // EOR #$80 + codeptr=>12 = $0110 // BPL +1 + codeptr=>14 = $9888 // DEY; TYA + codeptr=>16 = $C094+$0100+(VX<<8) // STY ESTKH+1,X + codeptr = codeptr + 18 + VX++ // INX + VY = UNKNOWN + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $48 + //puts("ISGE") + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0B5+$0100+(VX<<8) // LDA ESTKL+1,X + codeptr=>2 = $D0D5+(VX<<8) // CMP ESTKL,X + codeptr=>4 = $C0B5+$0100+(VX<<8) // LDA ESTKH+1,X + codeptr=>6 = $C0F5+(VX<<8) // SBC ESTKH + codeptr=>8 = $0250 // BVC +2 + codeptr=>10 = $8049 // EOR #$80 + codeptr=>12 = $0130 // BMI +1 + codeptr=>14 = $9888 // DEY; TYA + codeptr=>16 = $C094+$0100+(VX<<8) // STY ESTKH+1,X + codeptr = codeptr + 18 + VX++ // INX + VY = UNKNOWN + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $4A // ISLE + //puts("ISLE") + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0D5+$0100+(VX<<8) // CMP ESTKL+1,X + codeptr=>2 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>4 = $C0F5+$0100+(VX<<8) // SBC ESTKH+1 + codeptr=>6 = $0250 // BVC +2 + codeptr=>8 = $8049 // EOR #$80 + codeptr=>10 = $0130 // BMI +1 + codeptr=>12 = $9888 // DEY; TYA + codeptr=>14 = $C094+$0100+(VX<<8) // STY ESTKH+1,X + codeptr = codeptr + 16 + VX++ // INX + VY = UNKNOWN + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $4C // BRFLS + i++ + dest = i + *(bytecode+i) + i++ + //puts("BRFLS "); puti(dest) + codeptr, VX = resolveX(codeptr, VX + 1) // INX + if not A_IS_TOSL + *codeptr = $D0B5-$0100//+(VX<<8) // LDA ESTKL-1,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C015-$0100//+(VX<<8) // ORA ESTKH-1,X + codeptr=>2 = $03D0 // BNE +3 + codeptr->4 = $4C // JMP abs + codeptr=>5 = addrxlate=>[dest] + if not (codeptr->6 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 5 - *jitcodeptr + fin + codeptr = codeptr + 7 + A_IS_TOSL = FALSE + break + is $4E // BRTRU + i++ + dest = i + *(bytecode+i) + i++ + //puts("BRTRU "); puti(dest) + codeptr, VX = resolveX(codeptr, VX + 1) // INX + if not A_IS_TOSL + *codeptr = $D0B5-$0100//+(VX<<8) // LDA ESTKL-1,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C015-$0100//+(VX<<8) // ORA ESTKH-1,X + codeptr=>2 = $03F0 // BEQ +3 + codeptr->4 = $4C // JMP abs + codeptr=>5 = addrxlate=>[dest] + if not (codeptr->6 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 5 - *jitcodeptr + fin + codeptr = codeptr + 7 + A_IS_TOSL = FALSE + break + is $50 // BRNCH + i++ + dest = i + *(bytecode+i) + i++ + //puts("BRNCH "); puti(dest) + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $4C // JMP abs + codeptr=>1 = addrxlate=>[dest] + if not (codeptr->2 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 1 - *jitcodeptr + fin + codeptr = codeptr + 3 + A_IS_TOSL = FALSE + break + is $52 // SEL + i++ + case = i + *(bytecode+i) + i++ + //puts("SEL "); puti(case); putln + j = ^(bytecode+case) + dest = codeptr + 9 + case * 11) + if isule(dest, codemax) + ^(bytecode+case) = $FE // Flag as NOP + case++ + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C0B4+(VX<<8) // LDY ESTKH,X + codeptr, VX = resolveX(codeptr + 2, VX + 1) // INX + repeat + dest = *(bytecode+case) + //puts(" $"); puth(dest) + codeptr=>0 = $C9+(dest<<8) // CMP #imm + codeptr=>2 = $07D0 // BNE +7 + codeptr=>4 = $C0+(dest&$FF00) // CPY #imm + codeptr=>6 = $03D0 // BNE +3 + *(bytecode+case) = $FEFE + case = case + 2 + dest = case + *(bytecode+case) + //puts("-->"); puti(dest); putln + codeptr->8 = $4C // JMP abs + codeptr=>9 = addrxlate=>[dest] + if not (codeptr->10 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 9 - *jitcodeptr + fin + codeptr = codeptr + 11 + *(bytecode+case) = $FEFE + case = case + 2 + j-- + until not j + codeptr->0 = $4C // JMP abs + codeptr=>1 = addrxlate=>[case] + if not (codeptr->2 & $80) // Unresolved address list + addrxlate=>[case] = codeptr + 1 - *jitcodeptr + fin + codeptr = codeptr + 3 + else + codeptr = dest + fin + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $54 // CALL + //puts("CALL $"); puth(*(bytecode+i)) + // + // Call address + // + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $20 // JSR abs + codeptr=>1 = *(bytecode+i+1) + codeptr = codeptr + 3 + VY = UNKNOWN + A_IS_TOSL = FALSE + i = i + 2 + break + is $56 // ICAL + //puts("ICAL") + // + // Pull address off stack + // + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $E785 // STA $E7:TMPL + codeptr=>2 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>4 = $E885 // STA $E8:TMPH + codeptr, VX = resolveX(codeptr + 6, VX + 1) // INX + // + // Call through TMP + // + codeptr->0 = $20 // JSR abs + codeptr=>1 = $00E6 // $E6:JMPTMP + codeptr = codeptr + 3 + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $5A // LEAVE + i++ + //puts("LEAVE "); puti(^(bytecode+i)) + // + // Call into VM + // + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $20 // JSR abs + codeptr=>1 = $03D0 // INTERP + codeptr=>3 = $5A + (^(bytecode+i)<<8) // LEAVE CODE AND OPERAND + codeptr = codeptr + 5 + A_IS_TOSL = FALSE + break + is $5C // RET + //puts("RET") + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + ^codeptr = $60; codeptr++ // RTS + A_IS_TOSL = FALSE + break + is $5E // CFFB + i++ + //puts("CFFB $FF"); putb(^(bytecode+i)) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + codeptr=>0 = $FFA9 // LDA #$FF + codeptr=>2 = $C095+(VX<<8) // STA ESTKH,X + codeptr=>4 = $A9+(^(bytecode+i)<<8) // LDA #imm + codeptr = codeptr + 6 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $60 // LB + //puts("LB") + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C095-$0100+(VX<<8) // STA ESTKH-1,X + codeptr=>2 = $C0A1-$0100+(VX<<8) // LDA (ESTKH-1,X) + codeptr=>4 = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 6 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $62 // LW + //puts("LW") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C095-$0100+(VX<<8) // STA ESTKH-1,X + codeptr=>2 = $C0A1-$0100+(VX<<8) // LDA (ESTKH-1,X) + codeptr=>4 = $D095+(VX<<8) // STA ESTKL,X + codeptr=>6 = $C0F6-$0100+(VX<<8) // INC ESTKH-1,X + codeptr=>8 = $02D0 // BNE +2 + codeptr=>10 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr=>12 = $C0A1-$0100+(VX<<8) // LDA (ESTKH-1,X) + codeptr=>14 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 16 + A_IS_TOSL = FALSE + break + is $64 // LLB + i++ + j = ^(bytecode+i) + //puts("LLB "); puti(j) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + VY = j + fin + *codeptr = $E0B1 // LDA (IFP),Y + codeptr = codeptr + 2 + if VY + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + *codeptr = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 2 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $66 // LLW + i++ + j = ^(bytecode+i) + //puts("LLW "); puti(j) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + if VY <> j + *codeptr = $A0+((j+1)<<8) // LDY #imm + codeptr = codeptr + 2 + VY = j + else + ^codeptr = $C8; codeptr++ // INY + fin + codeptr=>0 = $E0B1 // LDA (IFP),Y + codeptr=>2 = $C095+(VX<<8) // STA ESTKH,X + codeptr->4 = $88 // DEY + codeptr=>5 = $E0B1 // LDA (IFP),Y + codeptr = codeptr + 7 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $68 // LAB + i++ + //puts("LAB $"); puth(*(bytecode+i)) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + codeptr=>0 = $C094+(VX<<8) // STY ESTKH,X + codeptr->2 = $AD // LDA abs + codeptr=>3 = *(bytecode+i) + codeptr = codeptr + 5 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + i++ + break + is $6A // LAW + dest = *(bytecode+i+1) + i = i + 2 + //puts("LAW $"); puth(dest) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + codeptr->0 = $AD // LDA abs + codeptr=>1 = dest+1 + codeptr=>3 = $C095+(VX<<8) // STA ESTKH,X + codeptr->5 = $AD // LDA abs + codeptr=>6 = dest + codeptr = codeptr + 8 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $6C // DLB + i++ + j = ^(bytecode+i) + //puts("DLB "); puti(j) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + A_IS_TOSL = TOS_CLEAN + fin + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + VY = j + fin + *codeptr = $E091 // STA (IFP),Y + codeptr = codeptr + 2 + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + *codeptr = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 2 + break + is $6E // DLW + i++ + j = ^(bytecode+i) + //puts("DLW "); puti(j) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> j + *codeptr = $A0+((j+1)<<8) // LDY #imm + codeptr = codeptr + 2 + VY = j + else + ^codeptr = $C8; codeptr++ // INY + fin + codeptr=>0 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>2 = $E091 // STA (IFP),Y + codeptr->4 = $88 // DEY + codeptr=>5 = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr=>7 = $E091 // STA (IFP),Y + codeptr = codeptr + 9 + A_IS_TOSL = TOS_CLEAN + break + is $70 // SB + //puts("SB") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C095-$0100+(VX<<8) // STA ESTKH-1,X + codeptr=>2 = $D0B5+$0100+(VX<<8) // LDA ESTKL+1,X + codeptr=>4 = $C081-$0100+(VX<<8) // STA (ESTKH-1,X) + codeptr = codeptr + 6 + VX = VX + 2 // INX; INX + A_IS_TOSL = FALSE + break + is $72 // SW + //puts("SW") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C095-$0100+(VX<<8) // STA ESTKH-1,X + codeptr=>2 = $D0B5+$0100+(VX<<8) // LDA ESTKL+1,X + codeptr=>4 = $C081-$0100+(VX<<8) // STA (ESTKH-1,X) + codeptr=>6 = $C0B5+$0100+(VX<<8) // LDA ESTKH+1,X + codeptr=>8 = $C0F6-$0100+(VX<<8) // INC ESTKH-1,X + codeptr=>10 = $02D0 // BNE +2 + codeptr=>12 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr=>14 = $C081-$0100+(VX<<8) // STA (ESTKH-1,X) + codeptr = codeptr + 16 + VX = VX + 2 // INX; INX + A_IS_TOSL = FALSE + break + is $74 // SLB + i++ + j = ^(bytecode+i) + //puts("SLB "); puti(j) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + VY = j + fin + *codeptr = $E091 // STA (IFP),Y + codeptr = codeptr + 2 + VX++ // INX + A_IS_TOSL = FALSE + break + is $76 // SLW + i++ + j = ^(bytecode+i) + //puts("SLW "); puti(j) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + fin + codeptr=>0 = $E091 // STA (IFP),Y + codeptr->2 = $C8 // INY + codeptr=>3 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>5 = $E091 // STA (IFP),Y + codeptr = codeptr + 7 + VX++ // INX + VY = j + 1 + A_IS_TOSL = FALSE + break + is $78 // SAB + dest = *(bytecode+i+1) + i = i + 2 + //puts("SAB $"); puth(*(bytecode+i)) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $8D // STA abs + codeptr=>1 = dest + codeptr = codeptr + 3 + VX++ // INX + A_IS_TOSL = FALSE + break + is $7A // SAW + dest = *(bytecode+i+1) + i = i + 2 + //puts("SAW $"); puth(dest) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $8D // STA abs + codeptr=>1 = dest + codeptr=>3 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr->5 = $8D // STA abs+1 + codeptr=>6 = dest+1 + codeptr = codeptr + 8 + VX++ // INX + A_IS_TOSL = FALSE + break + is $7C // DAB + dest = *(bytecode+i+1) + i = i + 2 + //puts("DAB $"); puth(*(bytecode+i)) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + A_IS_TOSL = TOS_CLEAN + fin + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + codeptr->0 = $8D // STA abs + codeptr=>1 = dest + codeptr=>3 = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 5 + break + is $7E // DAW + dest = *(bytecode+i+1) + i = i + 2 + //puts("DAW $"); puth(*(bytecode+i)) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + A_IS_TOSL = TOS_CLEAN + fin + codeptr->0 = $8D // STA abs + codeptr=>1 = dest + codeptr=>3 = $C0B4+(VX<<8) // LDY ESTKH,X + codeptr->5 = $8C // STY abs+1 + codeptr=>6 = dest+1 + codeptr = codeptr + 8 + VY = UNKNOWN + break + is $80 // NOT + //puts("NOT") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C015+(VX<<8) // ORA ESTKH,X + codeptr=>2 = $02F0 // BEQ +2 + codeptr=>4 = $FFA9 // LDA #$FF + codeptr=>6 = $FF49 // EOR #$FF + codeptr=>8 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 10 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $82 // ADD + //puts("ADD") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $18 // CLC + codeptr=>1 = $D075+$0100+(VX<<8) // ADC ESTKL+1,X + codeptr=>3 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>5 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>7 = $C075+$0100+(VX<<8) // ADC ESTKH+1,X + codeptr=>9 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr = codeptr + 11 + VX++ // INX + A_IS_TOSL = FALSE + break + is $84 // SUB + //puts("SUB") + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0B5+$0100+(VX<<8) // LDA ESTKL+1,X + codeptr->2 = $38 // SEC + codeptr=>3 = $D0F5+(VX<<8) // SBC ESTKL,X + codeptr=>5 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>7 = $C0B5+$0100+(VX<<8) // LDA ESTKH+1,X + codeptr=>9 = $C0F5+(VX<<8) // SBC ESTKH,X + codeptr=>11 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr = codeptr + 13 + VX++ // INX + A_IS_TOSL = FALSE + break + is $86 // MUL + is $88 // DIV + is $8A // MOD + is $9A // SHL + is $9C // SHR + //puts("MUL,DIV,MOD,SHL,SHR") + // when opcode + // is $86 + // //puts("MUL") + // is $88 + // //puts("DIV") + // is $8A + // //puts("MOD") + // is $9A + // //puts("SHL") + // is $9C + // //puts("SHR") + // wend + // + // Call into VM + // + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $20 // JSR INTERP + codeptr=>1 = $3D0 // INTERP + codeptr=>3 = $C000+opcode // OPCODE; NATV CODE + codeptr = codeptr + 5 + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $8C // INCR + //puts("INCR") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $18 // CLC + codeptr=>1 = $0169 // ADC #$01 + codeptr=>3 = $0290 // BCC +2 + codeptr=>5 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr = codeptr + 7 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $8E // DECR + //puts("DECR") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $38 // SEC + codeptr=>1 = $01E9 // SBC #$01 + codeptr=>3 = $02B0 // BCS +2 + codeptr=>5 = $C0D6+(VX<<8) // DEC ESTKH,X + codeptr = codeptr + 7 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $90 // NEG + //puts("NEG") + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + codeptr=>0 = $3898 // TYA -> LDA #$00; SEC + codeptr=>2 = $D0F5+(VX<<8) // SBC ESTKL,X + codeptr=>4 = $D095+(VX<<8) // STA ESTKL,X + codeptr->6 = $98 // TYA -> LDA #00 + codeptr=>7 = $C0F5+(VX<<8) // SBC ESTKH,X + codeptr=>9 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 11 + A_IS_TOSL = FALSE + break + is $92 // COMP + //puts("COMP") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $FF49 // EOR #$FF + codeptr=>2 = $D095+(VX<<8) // STA ESTKL,X + codeptr=>4 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>6 = $FF49 // EOR #$FF + codeptr=>8 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 10 + A_IS_TOSL = FALSE + break + is $94 // AND + //puts("AND") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D035+$0100+(VX<<8) // AND ESTKL+1,X + codeptr=>2 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>4 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>6 = $C035+$0100+(VX<<8) // AND ESTKH+1,X + codeptr=>8 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr = codeptr + 10 + VX++ // INX + A_IS_TOSL = FALSE + break + is $96 // OR + //puts("OR") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D015+$0100+(VX<<8) // ORA ESTKL+1,X + codeptr=>2 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>4 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>6 = $C015+$0100+(VX<<8) // ORA ESTKH+1,X + codeptr=>8 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr = codeptr + 10 + VX++ // INX + A_IS_TOSL = FALSE + break + is $98 // XOR + //puts("XOR") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D055+$0100+(VX<<8) // EOR ESTKL+1,X + codeptr=>2 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>4 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>6 = $C055+$0100+(VX<<8) // EOR ESTKH+1,X + codeptr=>8 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr = codeptr + 10 + VX++ // INX + A_IS_TOSL = FALSE + break + is $9E // IDXW + //puts("IDXW") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $0A // ASL + codeptr=>1 = $C036+(VX<<8) // ROL ESTKH,X + codeptr->3 = $18 // CLC + codeptr=>4 = $D075+$0100+(VX<<8) // ADC ESTKL+1,X + codeptr=>6 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>8 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>10 = $C075+$0100+(VX<<8) // ADC ESTKH+1,X + codeptr=>12 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr = codeptr + 14 + VX++ // INX + A_IS_TOSL = FALSE + break + is $A0 // BRGT - FOR/NEXT SPECIFIC TEST & BRANCH + i++ + dest = i + *(bytecode+i) + //puts("BRGT "); puti(dest) + i++ + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0B5+$0100//+(VX<<8) // LDA ESTKL+1,X + codeptr=>2 = $D0D5//+(VX<<8) // CMP ESTKL,X + codeptr=>4 = $C0B5+$0100//+(VX<<8) // LDA ESTKH+1,X + codeptr=>6 = $C0F5//+(VX<<8) // SBC ESTKH + codeptr=>8 = $0250 // BVC +2 + codeptr=>10 = $8049 // EOR #$80 + codeptr=>12 = $0510 // BPL +5 + codeptr=>14 = $E8E8 // INX; INX + codeptr->16 = $4C // JMP abs + codeptr=>17 = addrxlate=>[dest] + if not (codeptr->18 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 17 - *jitcodeptr + fin + codeptr = codeptr + 19 + A_IS_TOSL = FALSE + break + is $A2 // BRLT - FOR/NEXT SPECIFIC TEST & BRANCH + i++ + dest = i + *(bytecode+i) + //puts("BRLT "); puti(dest) + i++ + codeptr, VX = resolveX(codeptr, VX) + if not A_IS_TOSL + *codeptr = $D0B5//+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + elsif A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0D5+$0100//+(VX<<8) // CMP ESTKL+1,X + codeptr=>2 = $C0B5//+(VX<<8) // LDA ESTKH,X + codeptr=>4 = $C0F5+$0100//+(VX<<8) // SBC ESTKH+1 + codeptr=>6 = $0250 // BVC +2 + codeptr=>8 = $8049 // EOR #$80 + codeptr=>10 = $0510 // BPL +5 + codeptr=>12 = $E8E8 // INX; INX + codeptr->14 = $4C // JMP abs + codeptr=>15 = addrxlate=>[dest] + if not (codeptr->16 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 15 - *jitcodeptr + fin + codeptr = codeptr + 17 + A_IS_TOSL = FALSE + break + is $A4 // INCBRLE - FOR/NEXT SPECIFIC INC & TEST & BRANCH + i++ + dest = i + *(bytecode+i) + //puts("INCBRLE "); puti(dest) + i++ + // + // INCR + // + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $18 // CLC + codeptr=>1 = $0169 // ADC #$01 + codeptr=>3 = $D095+(VX<<8) // STA ESTKL,X + codeptr=>5 = $0290 // BCC +2 + codeptr=>7 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr, VX = resolveX(codeptr + 9, VX) + // + // BRLE + // + codeptr=>0 = $D0B5+$0100//+(VX<<8) // LDA ESTKL+1,X + codeptr=>2 = $D0D5//+(VX<<8) // CMP ESTKL,X + codeptr=>4 = $C0B5+$0100//+(VX<<8) // LDA ESTKH+1,X + codeptr=>6 = $C0F5//+(VX<<8) // SBC ESTKH + codeptr=>8 = $0250 // BVC +2 + codeptr=>10 = $8049 // EOR #$80 + codeptr=>12 = $0330 // BMI +3 + codeptr->14 = $4C // JMP abs + codeptr=>15 = addrxlate=>[dest] + if not (codeptr->16 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 15 - *jitcodeptr + fin + codeptr=>17 = $E8E8 //VX=VX+2 // INX; INX + codeptr = codeptr + 19 + A_IS_TOSL = FALSE + break + is $A6 // ADDBRLE - FOR/NEXT SPECIFIC ADD & TEST & BRANCH + i++ + dest = i + *(bytecode+i) + //puts("ADDBRLE "); puti(dest) + i++ + // + // ADD + // + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $18 // CLC + codeptr=>1 = $D075+$0100+(VX<<8) // ADC ESTKL+1,X + codeptr=>3 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>5 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>7 = $C075+$0100+(VX<<8) // ADC ESTKH+1,X + codeptr=>9 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr, VX = resolveX(codeptr + 11, VX + 1) // INX + // + // BRLE + // + codeptr=>0 = $D0B5+$0100//+(VX<<8) // LDA ESTKL+1,X + codeptr=>2 = $D0D5+(VX<<8) // CMP ESTKL,X + codeptr=>4 = $C0B5+$0100//+(VX<<8) // LDA ESTKH+1,X + codeptr=>6 = $C0F5+(VX<<8) // SBC ESTKH + codeptr=>8 = $0250 // BVC +2 + codeptr=>10 = $8049 // EOR #$80 + codeptr=>12 = $0330 // BMI +3 + codeptr->14 = $4C // JMP abs + codeptr=>15 = addrxlate=>[dest] + if not (codeptr->16 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 15 - *jitcodeptr + fin + codeptr=>17 = $E8E8 //VX=VX+2 // INX; INX + codeptr = codeptr + 19 + A_IS_TOSL = FALSE + break + is $A8 // DECBRGR - FOR/NEXT SPECIFIC DEC & TEST & BRANCH + i++ + dest = i + *(bytecode+i) + //puts("DECBRGE "); puti(dest) + i++ + // + // DECR + // + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $38 // SEC + codeptr=>1 = $01E9 // SBC #$01 + codeptr=>3 = $D095+(VX<<8) // STA ESTKL,X + codeptr=>5 = $02B0 // BCS +2 + codeptr=>7 = $C0D6+(VX<<8) // DEC ESTKH,X + codeptr, VX = resolveX(codeptr + 9, VX) + // + // BRGE + // + codeptr=>0 = $D0D5+$0100//+(VX<<8) // CMP ESTKL+1,X + codeptr=>2 = $C0B5//+(VX<<8) // LDA ESTKH,X + codeptr=>4 = $C0F5+$0100//+(VX<<8) // SBC ESTKH+1,X + codeptr=>6 = $0250 // BVC +2 + codeptr=>8 = $8049 // EOR #$80 + codeptr=>10 = $0330 // BMI +3 + codeptr->12 = $4C // JMP abs + codeptr=>13 = addrxlate=>[dest] + if not (codeptr->14 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 13 - *jitcodeptr + fin + codeptr=>15 = $E8E8 //VX=VX+2 // INX; INX + codeptr = codeptr + 17 + A_IS_TOSL = FALSE + break + is $AA // SUBBRGE - FOR/NEXT SPECIFIC SUB & TEST & BRANCH + i++ + dest = i + *(bytecode+i) + //puts("SUBBRGE "); puti(dest) + i++ + // + // SUB + // + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0B5+$0100+(VX<<8) // LDA ESTKL+1,X + codeptr->2 = $38 // SEC + codeptr=>3 = $D0F5+(VX<<8) // SBC ESTKL,X + codeptr=>5 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>7 = $C0B5+$0100+(VX<<8) // LDA ESTKH+1,X + codeptr=>9 = $C0F5+(VX<<8) // SBC ESTKH,X + codeptr=>11 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr, VX = resolveX(codeptr + 13, VX + 1) // INX + // + // BRGE + // + codeptr=>0 = $D0B5//+(VX<<8) // LDA ESTKL,X + codeptr=>2 = $D0D5+$0100//+(VX<<8) // CMP ESTKL+1,X + codeptr=>4 = $C0B5//+(VX<<8) // LDA ESTKH,X + codeptr=>6 = $C0F5+$0100//+(VX<<8) // SBC ESTKH+1,X + codeptr=>8 = $0250 // BVC +2 + codeptr=>10 = $8049 // EOR #$80 + codeptr=>12 = $0330 // BMI +3 + codeptr->14 = $4C // JMP abs + codeptr=>15 = addrxlate=>[dest] + if not (codeptr->16 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 15 - *jitcodeptr + fin + codeptr=>17 = $E8E8 //VX=VX+2 // INX; INX + codeptr = codeptr + 19 + A_IS_TOSL = FALSE + break + is $AC // BRAND - LOGICAL AND SPECIFIC BRANCH + i++ + dest = i + *(bytecode+i) + i++ + //puts("BRAND "); puti(dest) + codeptr, VX = resolveX(codeptr, VX) + if not A_IS_TOSL + *codeptr = $D0B5//+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + elsif A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C015//+(VX<<8) // ORA ESTKH,X + codeptr=>2 = $03D0 // BNE +3 + codeptr->4 = $4C // JMP abs + codeptr=>5 = addrxlate=>[dest] + if not (codeptr->6 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 5 - *jitcodeptr + fin + codeptr = codeptr + 7 + VX++ // INX + A_IS_TOSL = FALSE + break + is $AE // BROR - LOGICAL OR SPECIFIC BRANCH + i++ + dest = i + *(bytecode+i) + i++ + //puts("BROR "); puti(dest) + codeptr, VX = resolveX(codeptr, VX) + if not A_IS_TOSL + *codeptr = $D0B5//+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + elsif A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C015//+(VX<<8) // ORA ESTKH,X + codeptr=>2 = $03F0 // BEQ +3 + codeptr->4 = $4C // JMP abs + codeptr=>5 = addrxlate=>[dest] + if not (codeptr->6 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 5 - *jitcodeptr + fin + codeptr = codeptr + 7 + VX++ // INX + A_IS_TOSL = FALSE + break + is $B0 // ADDLB + i++ + j = ^(bytecode+i) + //puts("ADDLB "); puti(j) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + VY = j + fin + codeptr->0 = $18 // CLC + codeptr=>1 = $E071 // ADC (IFP),Y + codeptr=>3 = $0290 // BCC +2 + codeptr=>5 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr = codeptr + 7 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $B2 // ADDLW + i++ + j = ^(bytecode+i) + //puts("ADDLW "); puti(j) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + fin + codeptr->0 = $18 // CLC + codeptr=>1 = $E071 // ADC (IFP),Y + codeptr=>3 = $D095+(VX<<8) // STA ESTKL,X + codeptr=>5 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr->7 = $C8 // INY + codeptr=>8 = $E071 // ADC (IFP),Y + codeptr=>10 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 12 + VY = j + 1 + A_IS_TOSL = FALSE + break + is $B4 // ADDAB + dest = *(bytecode+i+1) + i = i + 2 + //puts("ADDAB $"); puth(*(bytecode+i)) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $6D18 // CLC; ADC abs + codeptr=>2 = dest + codeptr=>4 = $0290 // BCC +2 + codeptr=>6 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr = codeptr + 8 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $B6 // ADDAW + dest = *(bytecode+i+1) + i = i + 2 + //puts("ADDAW $"); puth(dest) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $6D18 // CLC; ADC abs + codeptr=>2 = dest + codeptr=>4 = $D095+(VX<<8) // STA ESTKL,X + codeptr=>6 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr->8 = $6D // ADC abs + codeptr=>9 = dest+1 + codeptr=>11 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 13 + A_IS_TOSL = FALSE + break + is $B8 // IDXLB + i++ + j = ^(bytecode+i) + //puts("IDXLB "); puti(j) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + fin + *codeptr = $E0B1 // LDA (IFP),Y + codeptr = codeptr + 2 + if j + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + codeptr->0 = $0A // ASL + codeptr=>1 = $0290 // BCC +2 + codeptr=>3 = $18C8 // INY; CLC + codeptr=>5 = $D075+(VX<<8) // ADC ESTKL,X + codeptr=>7 = $D095+(VX<<8) // STA ESTKL,X + codeptr->9 = $98 // TYA + codeptr=>10 = $C075+(VX<<8) // ADC ESTKH,X + codeptr=>12 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 14 + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $BA // IDXLW + i++ + j = ^(bytecode+i) + //puts("IDXLW "); puti(j) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + fin + codeptr=>0 = $E0B1 // LDA (IFP),Y + codeptr->2 = $0A // ASL + codeptr=>3 = $E785 // STA $E7:TMPL + codeptr->5 = $C8 // INY + codeptr=>6 = $E0B1 // LDA (IFP),Y + codeptr=>8 = $A82A // ROL; TAY + codeptr=>10 = $E7A5 // LDA $E7:TMPL + codeptr->12 = $18 // CLC + codeptr=>13 = $D075+(VX<<8) // ADC ESTKL,X + codeptr=>15 = $D095+(VX<<8) // STA ESTKL,X + codeptr->17 = $98 // TYA + codeptr=>18 = $C075+(VX<<8) // ADC ESTKLH,X + codeptr=>20 = $C095+(VX<<8) // STA ESTKLH,X + codeptr = codeptr + 22 + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $BC // IDXAB + dest = *(bytecode+i+1) + i = i + 2 + //puts("IDXAB $"); puth(*(bytecode+i)) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + codeptr->0 = $AD // LDA abs + codeptr=>1 = dest + codeptr->3 = $0A // ASL + codeptr=>4 = $0290 // BCC +2 + codeptr=>6 = $18C8 // INY; CLC + codeptr=>8 = $D075+(VX<<8) // ADC ESTKL,X + codeptr=>10 = $D095+(VX<<8) // STA ESTKL,X + codeptr->12 = $98 // TYA + codeptr=>13 = $C075+(VX<<8) // ADC ESTKH,X + codeptr=>15 = $C095+(VX<<8) // STA ESTKLH,X + codeptr = codeptr + 17 + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $BE // IDXAW + dest = *(bytecode+i+1) + i = i + 2 + //puts("IDXAW $"); puth(dest) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $AD // LDA abs + codeptr=>1 = dest + codeptr->3 = $0A // ASL + codeptr=>4 = $E785 // STA $E7:TMPL + codeptr->6 = $AD // LDA abs + codeptr=>7 = dest+1 + codeptr=>9 = $A82A // ROL; TAY + codeptr=>11 = $E7A5 // LDA $E7:TMPL + codeptr->13 = $18 // CLC + codeptr=>14 = $D075+(VX<<8) // ADC ESTKL,X + codeptr=>16 = $D095+(VX<<8) // STA ESTKL,X + codeptr->18 = $98 // TYA + codeptr=>19 = $C075+(VX<<8) // ADC ESTKH,X + codeptr=>21 = $C095+(VX<<8) // STA ESTKLH,X + codeptr = codeptr + 23 + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $FE // NOPed out earlier by SELect + break + otherwise + //puts("???: $"); puth(^(bytecode+i)); putln + wend + fin + //putln + i++ + if i >= defptr->bytecodesize + // + // Done compiling. Update DEF entry with JMP to compiled code + // + defptr->interpjsr = $4C // JMP + defptr=>interpaddr = *jitcodeptr + *jitcodeptr = codeptr + // + // Free working bufffers + // + //heaprelease(addrxlate) + //puts("Done compiling: $"); puth(defptr=>interpaddr); putln + //getc + return + fin + //if opcode == $B6; getc; fin + loop + // + // If we got here. we ran out of code buffer space. Overwrite interpreter + // entrypoint with standard bytecode interpreter + // + defptr=>interpaddr = interpentry + // + // Free working bufffers + // + //heaprelease(addrxlate) + //puts("Ran out of code buffer\n") + //getc +end +// +// Install JIT compiler +// +if *jitcomp + puts("JIT compiler already installed!\n") + return 0 +fin +puts("Installing JIT compiler\n") +*jitcomp = @compiler +return modkeep +done diff --git a/src/libsrc/apple/conio.pla b/src/libsrc/apple/conio.pla index f851d58..5469998 100644 --- a/src/libsrc/apple/conio.pla +++ b/src/libsrc/apple/conio.pla @@ -1,4 +1,5 @@ include "inc/cmdsys.plh" +sysflags nojitc // Keep tone() from compiling and sounding different // // Handy constants. // diff --git a/src/libsrc/apple/fileio.pla b/src/libsrc/apple/fileio.pla index db299a2..3036f5c 100644 --- a/src/libsrc/apple/fileio.pla +++ b/src/libsrc/apple/fileio.pla @@ -1,4 +1,5 @@ include "inc/cmdsys.plh" +sysflags nojitc // It's file I/O. No need to hurry up and wait. // // CFFA1 addresses. // diff --git a/src/libsrc/apple/jit.pla b/src/libsrc/apple/jit.pla new file mode 100644 index 0000000..e22301b --- /dev/null +++ b/src/libsrc/apple/jit.pla @@ -0,0 +1,51 @@ +// +// PLASMA JIT bytecode compiler +// +include "inc/cmdsys.plh" +// +// Module don't free memory +// +const modkeep = $2000 +const modinitkeep = $4000 +// +// Indirect interpreter DEFinition entrypoint +// +struc t_defentry + byte interpjsr + word interpaddr + word bytecodeaddr + byte callcount + byte bytecodesize +end +// +// JIT compiler constants +// +const jitcomp = $03E2 +const jitcodeptr = $03E4 +const codemax = $BEE0 +// +// Bytecode interpreter entrypoints +// +const indirectentry = $03DC +const directentry = $03D0 +// +// Copy bytecode DEF to main memory +// +def defcpy(dst, defptr)#0 + *$003C = defptr=>bytecodeaddr + *$003E = *$003C + defptr->bytecodesize + *$0042 = dst + call($C311, 0, 0, 0, $04) // CALL XMOVE with carry clear (AUX->MAIN) and ints disabled +end +include "libsrc/jitcore.pla" +// +// Install JIT compiler +// +if *jitcomp + return 0 +fin +*jitcomp = @compiler +cmdsys.jitcount = 44 +cmdsys.jitsize = 96 +return modkeep +done diff --git a/src/libsrc/apple/jit16.pla b/src/libsrc/apple/jit16.pla new file mode 100644 index 0000000..e22301b --- /dev/null +++ b/src/libsrc/apple/jit16.pla @@ -0,0 +1,51 @@ +// +// PLASMA JIT bytecode compiler +// +include "inc/cmdsys.plh" +// +// Module don't free memory +// +const modkeep = $2000 +const modinitkeep = $4000 +// +// Indirect interpreter DEFinition entrypoint +// +struc t_defentry + byte interpjsr + word interpaddr + word bytecodeaddr + byte callcount + byte bytecodesize +end +// +// JIT compiler constants +// +const jitcomp = $03E2 +const jitcodeptr = $03E4 +const codemax = $BEE0 +// +// Bytecode interpreter entrypoints +// +const indirectentry = $03DC +const directentry = $03D0 +// +// Copy bytecode DEF to main memory +// +def defcpy(dst, defptr)#0 + *$003C = defptr=>bytecodeaddr + *$003E = *$003C + defptr->bytecodesize + *$0042 = dst + call($C311, 0, 0, 0, $04) // CALL XMOVE with carry clear (AUX->MAIN) and ints disabled +end +include "libsrc/jitcore.pla" +// +// Install JIT compiler +// +if *jitcomp + return 0 +fin +*jitcomp = @compiler +cmdsys.jitcount = 44 +cmdsys.jitsize = 96 +return modkeep +done diff --git a/src/libsrc/apple/jitune.pla b/src/libsrc/apple/jitune.pla new file mode 100644 index 0000000..4a4356b --- /dev/null +++ b/src/libsrc/apple/jitune.pla @@ -0,0 +1,45 @@ +// +// PLASMA JIT bytecode compiler tuner +// +include "inc/cmdsys.plh" +include "inc/args.plh" + +var arg, val + +def atoi(strptr) + var num, len + + num = 0 + len = ^strptr + strptr++ + while len and ^strptr >= '0' and ^strptr <= '9' + num = num * 10 + ^strptr - '0' + strptr++ + len-- + loop + return num +end + +arg = argNext(argFirst) +if ^arg + if arg->1 >= '0' and arg->1 <= '9' + val = atoi(arg) + if val > 255 + val = 255 + fin + cmdsys.jitcount = val + arg = argNext(arg) + if ^arg + val = atoi(arg) + if val > 255 + val = 255 + fin + cmdsys.jitsize = val + fin + else + puts("Usage: JITUNE WARMUP [CALLCOUNT [MAXSIZE]]\n") + fin +fin +puts("JIT Call Count: "); puti(cmdsys.jitcount); putln +puts("JIT Max Size: "); puti(cmdsys.jitsize); putln +done diff --git a/src/libsrc/args.pla b/src/libsrc/args.pla index 7945de0..bc3ec66 100644 --- a/src/libsrc/args.pla +++ b/src/libsrc/args.pla @@ -1,4 +1,5 @@ include "inc/cmdsys.plh" +sysflags nojitc // No need to speed this up def argDelim(str) byte n diff --git a/src/libsrc/jit16core.pla b/src/libsrc/jit16core.pla new file mode 100644 index 0000000..ccfc336 --- /dev/null +++ b/src/libsrc/jit16core.pla @@ -0,0 +1,1563 @@ +// +// TOS caching values +// +const TOS_DIRTY = 1 +const TOS_CLEAN = 2 +// +// Y unknown value +// +const UNKNOWN = -1 +// +// Resolve virtual X with real X +// +def resolveX(codeptr, VX)#2 + while VX > 0 + ^codeptr = $E8; codeptr++ // INX + VX-- + loop + while VX < 0 + ^codeptr = $CA; codeptr++ // DEX + VX++ + loop + return codeptr, 0 +end +// +// JIT compiler entry +// +def compiler(defptr)#0 + word codeptr, isdata[], addrxlate, bytecode, i, case, dest, VX, VY + byte opcode, j, A_IS_TOSL + + //puts("JIT compiler invoked for :$"); puth(defptr=>bytecodeaddr); putln + addrxlate = heapmark // heapalloc(512 + defptr->bytecodesize) + //if not addrxlate + if isult(heapavail, 512 + defptr->bytecodesize) // 256 * sizeof(word) address xlate + // + // Not enough heap available + // + //puts("Not enough free heap\n") + defptr=>interpaddr = indirectentry + return + fin + // + // Copy bytecode def from AUX to heap for compiling + // + bytecode = addrxlate + 512 // def bytecode + defcpy(bytecode, defptr) + //puts("Addr Xlate: $"); puth(addrxlate); putln + // + // Find all branch targets and optimization fences. Tag the opcode with the LSB set + // + // All PLASMA ops are even (LSB clear), so this will flag when to fence optimizations + // During compiling. + // + //isdata = addrxlate // Use this buffer + memset(isdata, 0, 256) // Clear isdata buffer + i = 0 + while i < defptr->bytecodesize + if not ^(isdata+i) + //puth(bytecode+i); putc(':'); putb(^(bytecode+i) & $FE); putln; getc + when ^(bytecode+i) & $FE + // + // Double byte operands + // + is $26 // LA + is $2C // CW + is $54 // CALL + is $58 // ENTER + is $68 // LAB + is $6A // LAW + is $78 // SAB + is $7A // SAW + is $7C // DAB + is $7E // DAW + is $B4 // ADDAB + is $B6 // ADDAW + is $BC // IDXAB + is $BE // IDXAW + i = i + 2 + break + // + // Multi-byte operands + // + is $2E // CS + i = i + ^(bytecode+i+1) + // + // Single byte operands + // + is $2A // CB + is $28 // LLA + is $38 // ADDI + is $3A // SUBI + is $3C // ANDI + is $3E // ORI + is $5A // LEAVE + is $5E // CFFB + is $64 // LLB + is $66 // LLW + is $6C // DLB + is $6E // DLW + is $74 // SLB + is $76 // SLW + is $B0 // ADDLB + is $B2 // ADDLW + is $B8 // IDXLB + is $BA // IDXLW + i++ + break + // + // Branches + // + is $50 // BRNCH + is $22 // BREQ + is $24 // BRNE + is $4C // BRFLS + is $4E // BRTRU + is $A0 // BRGT + is $A2 // BRLT + is $A4 // INCBRLE + is $A6 // ADDBRLE + is $A8 // DECBRGE + is $AA // SUBBRGE + is $AC // BRAND + is $AE // BROR + i++ + dest = i + *(bytecode+i) + i++ + ^(bytecode+dest) = ^(bytecode+dest) | 1 // Flag as branch dest + break + // + // SELect/caseblock + // + is $52 // SEL + i++ + case = i + *(bytecode+i) + i++ + ^(isdata+case) = TRUE // Flag as data + j = ^(bytecode+case) + case++ + repeat + *(isdata+case) = TRUE // Flag as data + case = case + 2 + dest = case + *(bytecode+case) + ^(bytecode+dest) = ^(bytecode+dest) | 1 // Flag as branch dest + *(isdata+case) = TRUE // Flag as data + case = case + 2 + j-- + until not j + break + wend + fin + i++ + loop + // + // Compile the bytecodes + // + memset(addrxlate, 0, 512) // Clear xlate buffer + //puts("Bytecode: $"); puth(bytecode); putln; getc + codeptr = *jitcodeptr + A_IS_TOSL = FALSE + VY = UNKNOWN // Virtual Y register + VX = 0 // Virtual X register + i = 0 + if ^bytecode == $58 + //putc('$'); puth(codeptr);//puts(":[0] ENTER "); puti(^(bytecode+1)); putc(',');puti(^(bytecode+2)); putln + // + // Call into VM + // + codeptr->0 = $20 // JSR INTERP + codeptr=>1 = directentry + codeptr->3 = $58 // ENTER CODE + codeptr=>4 = *(bytecode+1) // ENTER FRAME SIZE & ARG COUNT + codeptr->6 = $C0 // NATV CODE + codeptr = codeptr + 7 + i = 3 + fin + while isule(codeptr, codemax) + //putc('$'); puth(codeptr); putc(':') + //putc('['); puti(i); //puts("] ") + opcode = ^(bytecode+i) + if opcode & 1 + // + // Optimization fence. Sync A and X registers + // + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VY = UNKNOWN + A_IS_TOSL = FALSE + opcode = opcode & $FE + fin + // + // Update bytecode->native code address translation. + // + // Here's how it works: + // + // The code buffer is above address $8000 so MSBit set. + // When we compile a bytecode, update the destination address in + // the address xlate buffer with actual address (MSBit set). But, if a branch + // opcode jumps to a bytecode address that hasn't been compiled yet, add the + // address offset in the code buffer to the list of addresses needing resolution. + // The offset will be less than $8000, so MSBit clear. This is how we know if + // an address has been resolved or is a list of addresses needing resolution. + // Before updating the address xlate buffer with the known address as we + // compile, look for existing resolution list and traverse it if there. + // + if addrxlate=>[i] + // + // Address list awaiting resolution + // + dest = addrxlate=>[i] + *jitcodeptr + repeat + case = *dest + *dest = codeptr + dest = case + *jitcodeptr + until not case + fin + // + // Update address translate buffer with bytecode->native address + // + addrxlate=>[i] = codeptr + // + // Compile this bad boy... + // + if opcode < $20 // CONSTANT NYBBLE + //puts("CN $"); putb(opcode/2) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + *codeptr = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 2 + if opcode == 0 + ^codeptr = $98; codeptr++ // TYA -> LDA #$00 + else + *codeptr = $A9+(opcode/2<<8) // LDA #(CN/2) + codeptr = codeptr + 2 + fin + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + else + when opcode + is $20 // MINUS ONE + //puts("MINUS_ONE") + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + codeptr=>0 = $FFA9 // LDA #$FF + codeptr=>2 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 4 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $22 // BREQ + is $24 // BRNE + i++ + dest = i + *(bytecode+i) + i++ + codeptr, VX = resolveX(codeptr, VX + 2) // INX; INX + if not A_IS_TOSL + *codeptr = $D0B5-$0200//+(VX<<8) // LDA ESTKL-2,X + codeptr = codeptr + 2 + fin + if opcode == $22 + //puts("BREQ "); puti(dest) + codeptr=>2 = $09D0 // BNE +9 + codeptr=>8 = $03D0 // BNE +3 + else + //puts("BRNE "); puti(dest) + codeptr=>2 = $06D0 // BNE +6 + codeptr=>8 = $03F0 // BEQ +3 + fin + codeptr=>0 = $D0D5-$0100//+(VX<<8) // CMP ESTKL-1,X + codeptr=>4 = $C0B5-$0200//+(VX<<8) // LDA ESTKH-2,X + codeptr=>6 = $C0D5-$0100//+(VX<<8) // CMP ESTKH-1,X + codeptr->10 = $4C // JMP abs + codeptr=>11 = addrxlate=>[dest] + if not (codeptr->12 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 11 - *jitcodeptr + fin + codeptr = codeptr + 13 + A_IS_TOSL = FALSE + break + is $26 // LA + is $2C // CW + dest = *(bytecode+i+1) + i = i + 2 + //puts("LA/CW $"); puth(dest) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + codeptr=>0 = $A9+(dest&$FF00) // LDA #2 = $C095+(VX<<8) // STA ESTKH,X + codeptr=>4 = $A9+(dest<<8) // LDA #>VAL + codeptr = codeptr + 6 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $28 // LLA + i++ + j = ^(bytecode+i) + //puts("LLA "); puti(^(bytecode+i)) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + if VY == j + ^codeptr = $98; codeptr++ // TYA -> LDA #imm + + else + *codeptr = $A9+(j<<8) // LDA #imm + codeptr = codeptr + 2 + fin + codeptr->0 = $18 // CLC + codeptr=>1 = $E065 // ADC IFPL + codeptr=>3 = $D095+(VX<<8) // STA ESTKL,X + if VY == 0 + codeptr->5 = $98 // TYA -> LDA #00 + codeptr = codeptr + 6 + else + codeptr=>5 = $00A9 // LDA #$00 + codeptr = codeptr + 7 + fin + codeptr=>0 = $E165 // ADC IFPH + codeptr=>2 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 4 + A_IS_TOSL = FALSE + break + is $2A // CB + is $5E // CFFB + i++ + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + if opcode == $2A + //puts("CB $"); putb(^(bytecode+i)) + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + codeptr=>0 = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 2 + else + //puts("CFFB $FF"); putb(^(bytecode+i)) + codeptr=>0 = $FFA9 // LDA #$FF + codeptr=>2 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 4 + fin + *codeptr = $A9+(^(bytecode+i)<<8) // LDA #imm + codeptr = codeptr + 2 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $2E // CS + i++ + j = ^(bytecode+i) + dest = codeptr + 10 + j + //puts("CS "); //puts(bytecode+i); //puts("-->"); puti(dest) + if isule(dest, codemax) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + codeptr=>0 = $A9+((codeptr+9)&$FF00) // LDA #>STRING + codeptr=>2 = $C095+(VX<<8) // STA ESTKH,X + codeptr=>4 = $A9+((codeptr+9)<<8) // LDA #6 = $4C // JMP abs + dest = codeptr + 10 + j + codeptr=>7 = dest + strcpy(codeptr + 9, bytecode + i) + i = i + j + fin + codeptr = dest + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $32 // DROP2 + //puts("DROP2") + VX++ // INX + is $30 // DROP + //puts("DROP") + VX++ // INX + A_IS_TOSL = FALSE + break + is $34 // DUP + //puts("DUP") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + elsif A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C0B4+(VX<<8) // LDY ESTKH,X + VX-- // DEX + codeptr=>2 = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 4 + VY = UNKNOWN + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + //is $36 + //puts("DIVMOD") + // + // Should never happen + // + //break + is $38 // ADDI + i++ + j = ^(bytecode+i) + //puts("ADDI $"); putb(^(bytecode+i)) + is $8C // INCR + if opcode == $8C + //puts("INCR") + j = 1 + fin + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $18 // CLC + codeptr=>1 = $69+(j<<8) // ADC #imm + codeptr=>3 = $0290 // BCC +2 + codeptr=>5 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr = codeptr + 7 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $3A // SUBI + i++ + j = ^(bytecode+i) + //puts("SUBI $"); putb(^(bytecode+i)) + is $8E // DECR + if opcode == $8E + //puts("DECR") + j = 1 + fin + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $38 // SEC + codeptr=>1 = $E9+(j<<8) // SBC #imm + codeptr=>3 = $02B0 // BCS +2 + codeptr=>5 = $C0D6+(VX<<8) // DEC ESTKH,X + codeptr = codeptr + 7 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $3C // ANDI + i++ + //puts("ANDI $"); putb(^(bytecode+i)) + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $29+(^(bytecode+i)<<8) // AND #imm + codeptr=>2 = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 4 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $3E // ORI + i++ + //puts("ORI $"); putb(^(bytecode+i)) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + *codeptr = $09+(^(bytecode+i)<<8) // ORA #imm + codeptr = codeptr + 2 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $40 // ISEQ + is $42 // ISNE + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + if opcode == $40 + //puts("ISEQ") + codeptr=>2 = $07D0 // BNE +7 + codeptr=>8 = $01D0 // BNE +1 + else + //puts("ISNE") + codeptr=>2 = $06D0 // BNE +6 + codeptr=>8 = $01F0 // BEQ +1 + fin + codeptr=>0 = $D0D5+$0100+(VX<<8) // CMP ESTKL+1,X + codeptr=>4 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>6 = $C0D5+$0100+(VX<<8) // CMP ESTKH+1 + codeptr=>10 = $9888 // DEY; TYA + codeptr=>12 = $C094+$0100+(VX<<8) // STY ESTKH+1,X + codeptr = codeptr + 14 + VX++ // INX + VY = UNKNOWN + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $44 // ISGT + is $4A // ISLE + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0D5+$0100+(VX<<8) // CMP ESTKL+1,X + codeptr=>2 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>4 = $C0F5+$0100+(VX<<8) // SBC ESTKH+1 + codeptr=>6 = $0250 // BVC +2 + codeptr=>8 = $8049 // EOR #$80 + if opcode == $44 + //puts("ISGT") + codeptr=>10 = $0110 // BPL +1 + else + //puts("ISLE") + codeptr=>10 = $0130 // BMI +1 + fin + codeptr=>12 = $9888 // DEY TYA + codeptr=>14 = $C094+$0100+(VX<<8) // STY ESTKH+1,X + codeptr = codeptr + 16 + VX++ // INX + VY = UNKNOWN + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $46 // ISLT + is $48 // ISGE + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0B5+$0100+(VX<<8) // LDA ESTKL+1,X + codeptr=>2 = $D0D5+(VX<<8) // CMP ESTKL,X + codeptr=>4 = $C0B5+$0100+(VX<<8) // LDA ESTKH+1,X + codeptr=>6 = $C0F5+(VX<<8) // SBC ESTKH + codeptr=>8 = $0250 // BVC +2 + codeptr=>10 = $8049 // EOR #$80 + if opcode == $46 + //puts("ISLT") + codeptr=>12 = $0110 // BPL +1 + else + //puts("ISGE") + codeptr=>12 = $0130 // BMI +1 + fin + codeptr=>14 = $9888 // DEY; TYA + codeptr=>16 = $C094+$0100+(VX<<8) // STY ESTKH+1,X + codeptr = codeptr + 18 + VX++ // INX + VY = UNKNOWN + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $4C // BRFLS + is $4E // BRTRU + i++ + dest = i + *(bytecode+i) + i++ + codeptr, VX = resolveX(codeptr, VX + 1) // INX + if not A_IS_TOSL + *codeptr = $D0B5-$0100//+(VX<<8) // LDA ESTKL-1,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C015-$0100//+(VX<<8) // ORA ESTKH-1,X + if opcode == $4C + //puts("BRFLS "); puti(dest) + codeptr=>2 = $03D0 // BNE +3 + else + //puts("BRTRU "); puti(dest) + codeptr=>2 = $03F0 // BEQ +3 + fin + codeptr->4 = $4C // JMP abs + codeptr=>5 = addrxlate=>[dest] + if not (codeptr->6 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 5 - *jitcodeptr + fin + codeptr = codeptr + 7 + A_IS_TOSL = FALSE + break + is $50 // BRNCH + i++ + dest = i + *(bytecode+i) + i++ + //puts("BRNCH "); puti(dest) + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $4C // JMP abs + codeptr=>1 = addrxlate=>[dest] + if not (codeptr->2 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 1 - *jitcodeptr + fin + codeptr = codeptr + 3 + A_IS_TOSL = FALSE + break + is $52 // SEL + i++ + case = i + *(bytecode+i) + i++ + //puts("SEL "); puti(case); putln + j = ^(bytecode+case) + dest = codeptr + 9 + case * 11) + if isule(dest, codemax) + ^(bytecode+case) = $FE // Flag as NOP + case++ + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C0B4+(VX<<8) // LDY ESTKH,X + codeptr, VX = resolveX(codeptr + 2, VX + 1) // INX + repeat + dest = *(bytecode+case) + //puts(" $"); puth(dest) + codeptr=>0 = $C9+(dest<<8) // CMP #imm + codeptr=>2 = $07D0 // BNE +7 + codeptr=>4 = $C0+(dest&$FF00) // CPY #imm + codeptr=>6 = $03D0 // BNE +3 + *(bytecode+case) = $FEFE + case = case + 2 + dest = case + *(bytecode+case) + //puts("-->"); puti(dest); putln + codeptr->8 = $4C // JMP abs + codeptr=>9 = addrxlate=>[dest] + if not (codeptr->10 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 9 - *jitcodeptr + fin + codeptr = codeptr + 11 + *(bytecode+case) = $FEFE + case = case + 2 + j-- + until not j + codeptr->0 = $4C // JMP abs + codeptr=>1 = addrxlate=>[case] + if not (codeptr->2 & $80) // Unresolved address list + addrxlate=>[case] = codeptr + 1 - *jitcodeptr + fin + codeptr = codeptr + 3 + else + codeptr = dest + fin + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $54 // CALL + //puts("CALL $"); puth(*(bytecode+i)) + // + // Call address + // + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $20 // JSR abs + codeptr=>1 = *(bytecode+i+1) + codeptr = codeptr + 3 + VY = UNKNOWN + A_IS_TOSL = FALSE + i = i + 2 + break + is $56 // ICAL + //puts("ICAL") + // + // Pull address off stack + // + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $E785 // STA $E7:TMPL + codeptr=>2 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>4 = $E885 // STA $E8:TMPH + codeptr, VX = resolveX(codeptr + 6, VX + 1) // INX + // + // Call through TMP + // + codeptr->0 = $20 // JSR abs + codeptr=>1 = $00E6 // $E6:JMPTMP + codeptr = codeptr + 3 + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $5A // LEAVE + i++ + //puts("LEAVE "); puti(^(bytecode+i)) + // + // Call into VM + // + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $20 // JSR abs + codeptr=>1 = directentry // INTERP + codeptr=>3 = $5A + (^(bytecode+i)<<8) // LEAVE CODE AND OPERAND + codeptr = codeptr + 5 + A_IS_TOSL = FALSE + break + is $5C // RET + //puts("RET") + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + ^codeptr = $60; codeptr++ // RTS + A_IS_TOSL = FALSE + break + is $60 // LB + //puts("LB") + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C095-$0100+(VX<<8) // STA ESTKH-1,X + codeptr=>2 = $C0A1-$0100+(VX<<8) // LDA (ESTKH-1,X) + codeptr=>4 = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 6 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $62 // LW + //puts("LW") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C095-$0100+(VX<<8) // STA ESTKH-1,X + codeptr=>2 = $C0A1-$0100+(VX<<8) // LDA (ESTKH-1,X) + codeptr=>4 = $D095+(VX<<8) // STA ESTKL,X + codeptr=>6 = $C0F6-$0100+(VX<<8) // INC ESTKH-1,X + codeptr=>8 = $02D0 // BNE +2 + codeptr=>10 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr=>12 = $C0A1-$0100+(VX<<8) // LDA (ESTKH-1,X) + codeptr=>14 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 16 + A_IS_TOSL = FALSE + break + is $64 // LLB + i++ + j = ^(bytecode+i) + //puts("LLB "); puti(j) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + fin + *codeptr = $E0B1 // LDA (IFP),Y + codeptr = codeptr + 2 + if j <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + *codeptr = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 2 + VY = 0 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $66 // LLW + i++ + j = ^(bytecode+i) + //puts("LLW "); puti(j) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + if VY <> j + *codeptr = $A0+((j+1)<<8) // LDY #imm + codeptr = codeptr + 2 + VY = j + else + ^codeptr = $C8; codeptr++ // INY + fin + codeptr=>0 = $E0B1 // LDA (IFP),Y + codeptr=>2 = $C095+(VX<<8) // STA ESTKH,X + codeptr->4 = $88 // DEY + codeptr=>5 = $E0B1 // LDA (IFP),Y + codeptr = codeptr + 7 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $68 // LAB + is $6A // LAW + dest = *(bytecode+i+1) + i = i + 2 + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + if opcode == $68 + //puts("LAB $"); puth(dest) + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + *codeptr = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 2 + else + //puts("LAW $"); puth(dest) + codeptr->0 = $AD // LDA abs+1 + codeptr=>1 = dest+1 + codeptr=>3 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 5 + fin + codeptr->0 = $AD // LDA abs + codeptr=>1 = dest + codeptr = codeptr + 3 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $6C // DLB + i++ + j = ^(bytecode+i) + //puts("DLB "); puti(j) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + A_IS_TOSL = TOS_CLEAN + fin + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + VY = j + fin + *codeptr = $E091 // STA (IFP),Y + codeptr = codeptr + 2 + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + *codeptr = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 2 + break + is $6E // DLW + i++ + j = ^(bytecode+i) + //puts("DLW "); puti(j) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> j + *codeptr = $A0+((j+1)<<8) // LDY #imm + codeptr = codeptr + 2 + VY = j + else + ^codeptr = $C8; codeptr++ // INY + fin + codeptr=>0 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>2 = $E091 // STA (IFP),Y + codeptr->4 = $88 // DEY + codeptr=>5 = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr=>7 = $E091 // STA (IFP),Y + codeptr = codeptr + 9 + A_IS_TOSL = TOS_CLEAN + break + is $70 // SB + is $72 // SW + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C095-$0100+(VX<<8) // STA ESTKH-1,X + codeptr=>2 = $D0B5+$0100+(VX<<8) // LDA ESTKL+1,X + codeptr=>4 = $C081-$0100+(VX<<8) // STA (ESTKH-1,X) + if opcode == $70 + //puts("SB") + codeptr = codeptr + 6 + else + //puts("SW") + codeptr=>6 = $C0B5+$0100+(VX<<8) // LDA ESTKH+1,X + codeptr=>8 = $C0F6-$0100+(VX<<8) // INC ESTKH-1,X + codeptr=>10 = $02D0 // BNE +2 + codeptr=>12 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr=>14 = $C081-$0100+(VX<<8) // STA (ESTKH-1,X) + codeptr = codeptr + 16 + fin + VX = VX + 2 // INX; INX + A_IS_TOSL = FALSE + break + is $74 // SLB + is $76 // SLW + i++ + j = ^(bytecode+i) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + VY = j + fin + codeptr=>0 = $E091 // STA (IFP),Y + if opcode == $74 + //puts("SLB "); puti(j) + codeptr = codeptr + 2 + else + //puts("SLW "); puti(j) + codeptr->2 = $C8 // INY + codeptr=>3 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>5 = $E091 // STA (IFP),Y + codeptr = codeptr + 7 + VY++ + fin + VX++ // INX + A_IS_TOSL = FALSE + break + is $78 // SAB + is $7A // SAW + dest = *(bytecode+i+1) + i = i + 2 + //puts("SAW $"); puth(dest) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $8D // STA abs + codeptr=>1 = dest + if opcode == $78 + //puts("SAB $"); puth(*(bytecode+i)) + codeptr = codeptr + 3 + else + codeptr=>3 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr->5 = $8D // STA abs+1 + codeptr=>6 = dest+1 + codeptr = codeptr + 8 + fin + VX++ // INX + A_IS_TOSL = FALSE + break + is $7C // DAB + is $7E // DAW + dest = *(bytecode+i+1) + i = i + 2 + //puts("DAW $"); puth(*(bytecode+i)) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + A_IS_TOSL = TOS_CLEAN + fin + codeptr->0 = $8D // STA abs + codeptr=>1 = dest + if opcode == $7C + //puts("DAB $"); puth(*(bytecode+i)) + codeptr = codeptr + 3 + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + *codeptr = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 2 + else + codeptr=>3 = $C0B4+(VX<<8) // LDY ESTKH,X + codeptr->5 = $8C // STY abs+1 + codeptr=>6 = dest+1 + codeptr = codeptr + 8 + VY = UNKNOWN + fin + break + is $80 // NOT + //puts("NOT") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C015+(VX<<8) // ORA ESTKH,X + codeptr=>2 = $02F0 // BEQ +2 + codeptr=>4 = $FFA9 // LDA #$FF + codeptr=>6 = $FF49 // EOR #$FF + codeptr=>8 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 10 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $82 // ADD + //puts("ADD") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $18 // CLC + codeptr=>1 = $D075+$0100+(VX<<8) // ADC ESTKL+1,X + codeptr=>3 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>5 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>7 = $C075+$0100+(VX<<8) // ADC ESTKH+1,X + codeptr=>9 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr = codeptr + 11 + VX++ // INX + A_IS_TOSL = FALSE + break + is $84 // SUB + //puts("SUB") + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0B5+$0100+(VX<<8) // LDA ESTKL+1,X + codeptr->2 = $38 // SEC + codeptr=>3 = $D0F5+(VX<<8) // SBC ESTKL,X + codeptr=>5 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>7 = $C0B5+$0100+(VX<<8) // LDA ESTKH+1,X + codeptr=>9 = $C0F5+(VX<<8) // SBC ESTKH,X + codeptr=>11 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr = codeptr + 13 + VX++ // INX + A_IS_TOSL = FALSE + break + is $86 // MUL + is $88 // DIV + is $8A // MOD + is $9A // SHL + is $9C // SHR + //puts("MUL,DIV,MOD,SHL,SHR") + // when opcode + // is $86 + // //puts("MUL") + // is $88 + // //puts("DIV") + // is $8A + // //puts("MOD") + // is $9A + // //puts("SHL") + // is $9C + // //puts("SHR") + // wend + // + // Call into VM + // + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $20 // JSR INTERP + codeptr=>1 = directentry // INTERP + codeptr=>3 = $C000+opcode // OPCODE; NATV CODE + codeptr = codeptr + 5 + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $90 // NEG + //puts("NEG") + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + codeptr=>0 = $3898 // TYA -> LDA #$00; SEC + codeptr=>2 = $D0F5+(VX<<8) // SBC ESTKL,X + codeptr=>4 = $D095+(VX<<8) // STA ESTKL,X + codeptr->6 = $98 // TYA -> LDA #00 + codeptr=>7 = $C0F5+(VX<<8) // SBC ESTKH,X + codeptr=>9 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 11 + A_IS_TOSL = FALSE + break + is $92 // COMP + //puts("COMP") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $FF49 // EOR #$FF + codeptr=>2 = $D095+(VX<<8) // STA ESTKL,X + codeptr=>4 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>6 = $FF49 // EOR #$FF + codeptr=>8 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 10 + A_IS_TOSL = FALSE + break + is $94 // AND + is $96 // OR + is $98 // XOR + when opcode + is $94 + //puts("AND") + j = $35 + break + is $96 + //puts("OR") + j = $15 + break + is $98 + //puts("XOR") + j = $55 + wend + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = j // OP + codeptr->1 = $D0+$01+VX // ESTKL+1,X + codeptr=>2 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>4 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr->6 = j // OP + codeptr->7 = $C0+$01+VX // ESTKH+1,X + codeptr=>8 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr = codeptr + 10 + VX++ // INX + A_IS_TOSL = FALSE + break + is $9E // IDXW + //puts("IDXW") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $0A // ASL + codeptr=>1 = $C036+(VX<<8) // ROL ESTKH,X + codeptr->3 = $18 // CLC + codeptr=>4 = $D075+$0100+(VX<<8) // ADC ESTKL+1,X + codeptr=>6 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>8 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>10 = $C075+$0100+(VX<<8) // ADC ESTKH+1,X + codeptr=>12 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr = codeptr + 14 + VX++ // INX + A_IS_TOSL = FALSE + break + is $A0 // BRGT - FOR/NEXT SPECIFIC TEST & BRANCH + i++ + dest = i + *(bytecode+i) + i++ + //puts("BRGT "); puti(dest) + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0B5+$0100//+(VX<<8) // LDA ESTKL+1,X + codeptr=>2 = $D0D5//+(VX<<8) // CMP ESTKL,X + codeptr=>4 = $C0B5+$0100//+(VX<<8) // LDA ESTKH+1,X + codeptr=>6 = $C0F5//+(VX<<8) // SBC ESTKH + codeptr=>8 = $0250 // BVC +2 + codeptr=>10 = $8049 // EOR #$80 + codeptr=>12 = $0510 // BPL +5 + codeptr=>14 = $E8E8 // INX; INX + codeptr->16 = $4C // JMP abs + codeptr=>17 = addrxlate=>[dest] + if not (codeptr->18 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 17 - *jitcodeptr + fin + codeptr = codeptr + 19 + A_IS_TOSL = FALSE + break + is $A2 // BRLT - FOR/NEXT SPECIFIC TEST & BRANCH + i++ + dest = i + *(bytecode+i) + i++ + //puts("BRLT "); puti(dest) + codeptr, VX = resolveX(codeptr, VX) + if not A_IS_TOSL + *codeptr = $D0B5//+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + elsif A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0D5+$0100//+(VX<<8) // CMP ESTKL+1,X + codeptr=>2 = $C0B5//+(VX<<8) // LDA ESTKH,X + codeptr=>4 = $C0F5+$0100//+(VX<<8) // SBC ESTKH+1 + codeptr=>6 = $0250 // BVC +2 + codeptr=>8 = $8049 // EOR #$80 + codeptr=>10 = $0510 // BPL +5 + codeptr=>12 = $E8E8 // INX; INX + codeptr->14 = $4C // JMP abs + codeptr=>15 = addrxlate=>[dest] + if not (codeptr->16 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 15 - *jitcodeptr + fin + codeptr = codeptr + 17 + A_IS_TOSL = FALSE + break + is $A4 // INCBRLE - FOR/NEXT SPECIFIC INC & TEST & BRANCH + is $A6 // ADDBRLE - FOR/NEXT SPECIFIC ADD & TEST & BRANCH + i++ + dest = i + *(bytecode+i) + i++ + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + if opcode == $A4 + // + // INCR + // + //puts("INCBRLE "); puti(dest) + codeptr->0 = $18 // CLC + codeptr=>1 = $0169 // ADC #$01 + codeptr=>3 = $D095+(VX<<8) // STA ESTKL,X + codeptr=>5 = $0290 // BCC +2 + codeptr=>7 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr, VX = resolveX(codeptr + 9, VX) + else + // + // ADD + // + //puts("ADDBRLE "); puti(dest) + codeptr->0 = $18 // CLC + codeptr=>1 = $D075+$0100+(VX<<8) // ADC ESTKL+1,X + codeptr=>3 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>5 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>7 = $C075+$0100+(VX<<8) // ADC ESTKH+1,X + codeptr=>9 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr, VX = resolveX(codeptr + 11, VX + 1) // INX + fin + // + // BRLE + // + codeptr=>0 = $D0B5+$0100//+(VX<<8) // LDA ESTKL+1,X + codeptr=>2 = $D0D5//+(VX<<8) // CMP ESTKL,X + codeptr=>4 = $C0B5+$0100//+(VX<<8) // LDA ESTKH+1,X + codeptr=>6 = $C0F5//+(VX<<8) // SBC ESTKH + codeptr=>8 = $0250 // BVC +2 + codeptr=>10 = $8049 // EOR #$80 + codeptr=>12 = $0330 // BMI +3 + codeptr->14 = $4C // JMP abs + codeptr=>15 = addrxlate=>[dest] + if not (codeptr->16 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 15 - *jitcodeptr + fin + codeptr = codeptr + 17 + VX = VX + 2 // INX; INX + A_IS_TOSL = FALSE + break + is $A8 // DECBRGR - FOR/NEXT SPECIFIC DEC & TEST & BRANCH + is $AA // SUBBRGE - FOR/NEXT SPECIFIC SUB & TEST & BRANCH + i++ + dest = i + *(bytecode+i) + i++ + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if opcode == $A8 + // + // DECR + // + //puts("DECBRGE "); puti(dest) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $38 // SEC + codeptr=>1 = $01E9 // SBC #$01 + codeptr=>3 = $D095+(VX<<8) // STA ESTKL,X + codeptr=>5 = $02B0 // BCS +2 + codeptr=>7 = $C0D6+(VX<<8) // DEC ESTKH,X + codeptr, VX = resolveX(codeptr + 9, VX) + else + // + // SUB + // + //puts("SUBBRGE "); puti(dest) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0B5+$0100+(VX<<8) // LDA ESTKL+1,X + codeptr->2 = $38 // SEC + codeptr=>3 = $D0F5+(VX<<8) // SBC ESTKL,X + codeptr=>5 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>7 = $C0B5+$0100+(VX<<8) // LDA ESTKH+1,X + codeptr=>9 = $C0F5+(VX<<8) // SBC ESTKH,X + codeptr=>11 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr, VX = resolveX(codeptr + 13, VX + 1) // INX + *codeptr = $D0B5//+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + // + // BRGE + // + codeptr=>0 = $D0D5+$0100//+(VX<<8) // CMP ESTKL+1,X + codeptr=>2 = $C0B5//+(VX<<8) // LDA ESTKH,X + codeptr=>4 = $C0F5+$0100//+(VX<<8) // SBC ESTKH+1,X + codeptr=>6 = $0250 // BVC +2 + codeptr=>8 = $8049 // EOR #$80 + codeptr=>10 = $0330 // BMI +3 + codeptr->12 = $4C // JMP abs + codeptr=>13 = addrxlate=>[dest] + if not (codeptr->14 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 13 - *jitcodeptr + fin + codeptr = codeptr + 15 + VX = VX + 2 // INX; INX + A_IS_TOSL = FALSE + break + is $AC // BRAND - LOGICAL AND SPECIFIC BRANCH + is $AE // BROR - LOGICAL OR SPECIFIC BRANCH + i++ + dest = i + *(bytecode+i) + i++ + codeptr, VX = resolveX(codeptr, VX) + if not A_IS_TOSL + *codeptr = $D0B5//+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + elsif A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C015//+(VX<<8) // ORA ESTKH,X + if opcode == $AC + //puts("BRAND "); puti(dest) + codeptr=>2 = $03D0 // BNE +3 + else + //puts("BROR "); puti(dest) + codeptr=>2 = $03F0 // BEQ +3 + fin + codeptr->4 = $4C // JMP abs + codeptr=>5 = addrxlate=>[dest] + if not (codeptr->6 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 5 - *jitcodeptr + fin + codeptr = codeptr + 7 + VX++ // INX + A_IS_TOSL = FALSE + break + is $B0 // ADDLB + is $B2 // ADDLW + i++ + j = ^(bytecode+i) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + VY = j + fin + codeptr->0 = $18 // CLC + codeptr=>1 = $E071 // ADC (IFP),Y + if opcode == $B0 + //puts("ADDLB "); puti(j) + codeptr=>3 = $0290 // BCC +2 + codeptr=>5 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr = codeptr + 7 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + else + //puts("ADDLW "); puti(j) + codeptr=>3 = $D095+(VX<<8) // STA ESTKL,X + codeptr=>5 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr->7 = $C8 // INY + codeptr=>8 = $E071 // ADC (IFP),Y + codeptr=>10 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 12 + VY++ + A_IS_TOSL = FALSE + fin + break + is $B4 // ADDAB + is $B6 // ADDAW + dest = *(bytecode+i+1) + i = i + 2 + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $6D18 // CLC; ADC abs + codeptr=>2 = dest + if opcode == $B4 + //puts("ADDAB $"); puth(dest) + codeptr=>4 = $0290 // BCC +2 + codeptr=>6 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr = codeptr + 8 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + else + //puts("ADDAW $"); puth(dest) + codeptr=>4 = $D095+(VX<<8) // STA ESTKL,X + codeptr=>6 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr->8 = $6D // ADC abs + codeptr=>9 = dest+1 + codeptr=>11 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 13 + A_IS_TOSL = FALSE + fin + break + is $B8 // IDXLB + i++ + j = ^(bytecode+i) + //puts("IDXLB "); puti(j) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + fin + *codeptr = $E0B1 // LDA (IFP),Y + codeptr = codeptr + 2 + if j <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + codeptr->0 = $0A // ASL + codeptr=>1 = $0290 // BCC +2 + codeptr=>3 = $18C8 // INY; CLC + codeptr=>5 = $D075+(VX<<8) // ADC ESTKL,X + codeptr=>7 = $D095+(VX<<8) // STA ESTKL,X + codeptr->9 = $98 // TYA + codeptr=>10 = $C075+(VX<<8) // ADC ESTKH,X + codeptr=>12 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 14 + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $BA // IDXLW + i++ + j = ^(bytecode+i) + //puts("IDXLW "); puti(j) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + fin + codeptr=>0 = $E0B1 // LDA (IFP),Y + codeptr->2 = $0A // ASL + codeptr=>3 = $E785 // STA $E7:TMPL + codeptr->5 = $C8 // INY + codeptr=>6 = $E0B1 // LDA (IFP),Y + codeptr=>8 = $A82A // ROL; TAY + codeptr=>10 = $E7A5 // LDA $E7:TMPL + codeptr->12 = $18 // CLC + codeptr=>13 = $D075+(VX<<8) // ADC ESTKL,X + codeptr=>15 = $D095+(VX<<8) // STA ESTKL,X + codeptr->17 = $98 // TYA + codeptr=>18 = $C075+(VX<<8) // ADC ESTKH,X + codeptr=>20 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 22 + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $BC // IDXAB + dest = *(bytecode+i+1) + i = i + 2 + //puts("IDXAB $"); puth(*(bytecode+i)) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + codeptr->0 = $AD // LDA abs + codeptr=>1 = dest + codeptr->3 = $0A // ASL + codeptr=>4 = $0290 // BCC +2 + codeptr=>6 = $18C8 // INY; CLC + codeptr=>8 = $D075+(VX<<8) // ADC ESTKL,X + codeptr=>10 = $D095+(VX<<8) // STA ESTKL,X + codeptr->12 = $98 // TYA + codeptr=>13 = $C075+(VX<<8) // ADC ESTKH,X + codeptr=>15 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 17 + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $BE // IDXAW + dest = *(bytecode+i+1) + i = i + 2 + //puts("IDXAW $"); puth(dest) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $AD // LDA abs + codeptr=>1 = dest + codeptr->3 = $0A // ASL + codeptr=>4 = $E785 // STA $E7:TMPL + codeptr->6 = $AD // LDA abs+1 + codeptr=>7 = dest+1 + codeptr=>9 = $A82A // ROL; TAY + codeptr=>11 = $E7A5 // LDA $E7:TMPL + codeptr->13 = $18 // CLC + codeptr=>14 = $D075+(VX<<8) // ADC ESTKL,X + codeptr=>16 = $D095+(VX<<8) // STA ESTKL,X + codeptr->18 = $98 // TYA + codeptr=>19 = $C075+(VX<<8) // ADC ESTKH,X + codeptr=>21 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 23 + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $FE // NOPed out earlier by SELect + break + otherwise + //puts("???: $"); puth(^(bytecode+i)); putln + wend + fin + //putln + i++ + if i >= defptr->bytecodesize + // + // Done compiling. Update DEF entry with JMP to compiled code + // + defptr->interpjsr = $4C // JMP + defptr=>interpaddr = *jitcodeptr + *jitcodeptr = codeptr + // + // Free working bufffers + // + //heaprelease(addrxlate) + //puts("Done compiling: $"); puth(defptr=>interpaddr); putln + //getc + return + fin + loop + // + // If we got here. we ran out of code buffer space. Overwrite interpreter + // entrypoint with standard bytecode interpreter + // + defptr=>interpaddr = indirectentry + // + // Free working bufffers + // + //heaprelease(addrxlate) + //puts("Ran out of code buffer\n") + //getc +end diff --git a/src/libsrc/jitcore.pla b/src/libsrc/jitcore.pla new file mode 100644 index 0000000..ccfc336 --- /dev/null +++ b/src/libsrc/jitcore.pla @@ -0,0 +1,1563 @@ +// +// TOS caching values +// +const TOS_DIRTY = 1 +const TOS_CLEAN = 2 +// +// Y unknown value +// +const UNKNOWN = -1 +// +// Resolve virtual X with real X +// +def resolveX(codeptr, VX)#2 + while VX > 0 + ^codeptr = $E8; codeptr++ // INX + VX-- + loop + while VX < 0 + ^codeptr = $CA; codeptr++ // DEX + VX++ + loop + return codeptr, 0 +end +// +// JIT compiler entry +// +def compiler(defptr)#0 + word codeptr, isdata[], addrxlate, bytecode, i, case, dest, VX, VY + byte opcode, j, A_IS_TOSL + + //puts("JIT compiler invoked for :$"); puth(defptr=>bytecodeaddr); putln + addrxlate = heapmark // heapalloc(512 + defptr->bytecodesize) + //if not addrxlate + if isult(heapavail, 512 + defptr->bytecodesize) // 256 * sizeof(word) address xlate + // + // Not enough heap available + // + //puts("Not enough free heap\n") + defptr=>interpaddr = indirectentry + return + fin + // + // Copy bytecode def from AUX to heap for compiling + // + bytecode = addrxlate + 512 // def bytecode + defcpy(bytecode, defptr) + //puts("Addr Xlate: $"); puth(addrxlate); putln + // + // Find all branch targets and optimization fences. Tag the opcode with the LSB set + // + // All PLASMA ops are even (LSB clear), so this will flag when to fence optimizations + // During compiling. + // + //isdata = addrxlate // Use this buffer + memset(isdata, 0, 256) // Clear isdata buffer + i = 0 + while i < defptr->bytecodesize + if not ^(isdata+i) + //puth(bytecode+i); putc(':'); putb(^(bytecode+i) & $FE); putln; getc + when ^(bytecode+i) & $FE + // + // Double byte operands + // + is $26 // LA + is $2C // CW + is $54 // CALL + is $58 // ENTER + is $68 // LAB + is $6A // LAW + is $78 // SAB + is $7A // SAW + is $7C // DAB + is $7E // DAW + is $B4 // ADDAB + is $B6 // ADDAW + is $BC // IDXAB + is $BE // IDXAW + i = i + 2 + break + // + // Multi-byte operands + // + is $2E // CS + i = i + ^(bytecode+i+1) + // + // Single byte operands + // + is $2A // CB + is $28 // LLA + is $38 // ADDI + is $3A // SUBI + is $3C // ANDI + is $3E // ORI + is $5A // LEAVE + is $5E // CFFB + is $64 // LLB + is $66 // LLW + is $6C // DLB + is $6E // DLW + is $74 // SLB + is $76 // SLW + is $B0 // ADDLB + is $B2 // ADDLW + is $B8 // IDXLB + is $BA // IDXLW + i++ + break + // + // Branches + // + is $50 // BRNCH + is $22 // BREQ + is $24 // BRNE + is $4C // BRFLS + is $4E // BRTRU + is $A0 // BRGT + is $A2 // BRLT + is $A4 // INCBRLE + is $A6 // ADDBRLE + is $A8 // DECBRGE + is $AA // SUBBRGE + is $AC // BRAND + is $AE // BROR + i++ + dest = i + *(bytecode+i) + i++ + ^(bytecode+dest) = ^(bytecode+dest) | 1 // Flag as branch dest + break + // + // SELect/caseblock + // + is $52 // SEL + i++ + case = i + *(bytecode+i) + i++ + ^(isdata+case) = TRUE // Flag as data + j = ^(bytecode+case) + case++ + repeat + *(isdata+case) = TRUE // Flag as data + case = case + 2 + dest = case + *(bytecode+case) + ^(bytecode+dest) = ^(bytecode+dest) | 1 // Flag as branch dest + *(isdata+case) = TRUE // Flag as data + case = case + 2 + j-- + until not j + break + wend + fin + i++ + loop + // + // Compile the bytecodes + // + memset(addrxlate, 0, 512) // Clear xlate buffer + //puts("Bytecode: $"); puth(bytecode); putln; getc + codeptr = *jitcodeptr + A_IS_TOSL = FALSE + VY = UNKNOWN // Virtual Y register + VX = 0 // Virtual X register + i = 0 + if ^bytecode == $58 + //putc('$'); puth(codeptr);//puts(":[0] ENTER "); puti(^(bytecode+1)); putc(',');puti(^(bytecode+2)); putln + // + // Call into VM + // + codeptr->0 = $20 // JSR INTERP + codeptr=>1 = directentry + codeptr->3 = $58 // ENTER CODE + codeptr=>4 = *(bytecode+1) // ENTER FRAME SIZE & ARG COUNT + codeptr->6 = $C0 // NATV CODE + codeptr = codeptr + 7 + i = 3 + fin + while isule(codeptr, codemax) + //putc('$'); puth(codeptr); putc(':') + //putc('['); puti(i); //puts("] ") + opcode = ^(bytecode+i) + if opcode & 1 + // + // Optimization fence. Sync A and X registers + // + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VY = UNKNOWN + A_IS_TOSL = FALSE + opcode = opcode & $FE + fin + // + // Update bytecode->native code address translation. + // + // Here's how it works: + // + // The code buffer is above address $8000 so MSBit set. + // When we compile a bytecode, update the destination address in + // the address xlate buffer with actual address (MSBit set). But, if a branch + // opcode jumps to a bytecode address that hasn't been compiled yet, add the + // address offset in the code buffer to the list of addresses needing resolution. + // The offset will be less than $8000, so MSBit clear. This is how we know if + // an address has been resolved or is a list of addresses needing resolution. + // Before updating the address xlate buffer with the known address as we + // compile, look for existing resolution list and traverse it if there. + // + if addrxlate=>[i] + // + // Address list awaiting resolution + // + dest = addrxlate=>[i] + *jitcodeptr + repeat + case = *dest + *dest = codeptr + dest = case + *jitcodeptr + until not case + fin + // + // Update address translate buffer with bytecode->native address + // + addrxlate=>[i] = codeptr + // + // Compile this bad boy... + // + if opcode < $20 // CONSTANT NYBBLE + //puts("CN $"); putb(opcode/2) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + *codeptr = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 2 + if opcode == 0 + ^codeptr = $98; codeptr++ // TYA -> LDA #$00 + else + *codeptr = $A9+(opcode/2<<8) // LDA #(CN/2) + codeptr = codeptr + 2 + fin + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + else + when opcode + is $20 // MINUS ONE + //puts("MINUS_ONE") + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + codeptr=>0 = $FFA9 // LDA #$FF + codeptr=>2 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 4 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $22 // BREQ + is $24 // BRNE + i++ + dest = i + *(bytecode+i) + i++ + codeptr, VX = resolveX(codeptr, VX + 2) // INX; INX + if not A_IS_TOSL + *codeptr = $D0B5-$0200//+(VX<<8) // LDA ESTKL-2,X + codeptr = codeptr + 2 + fin + if opcode == $22 + //puts("BREQ "); puti(dest) + codeptr=>2 = $09D0 // BNE +9 + codeptr=>8 = $03D0 // BNE +3 + else + //puts("BRNE "); puti(dest) + codeptr=>2 = $06D0 // BNE +6 + codeptr=>8 = $03F0 // BEQ +3 + fin + codeptr=>0 = $D0D5-$0100//+(VX<<8) // CMP ESTKL-1,X + codeptr=>4 = $C0B5-$0200//+(VX<<8) // LDA ESTKH-2,X + codeptr=>6 = $C0D5-$0100//+(VX<<8) // CMP ESTKH-1,X + codeptr->10 = $4C // JMP abs + codeptr=>11 = addrxlate=>[dest] + if not (codeptr->12 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 11 - *jitcodeptr + fin + codeptr = codeptr + 13 + A_IS_TOSL = FALSE + break + is $26 // LA + is $2C // CW + dest = *(bytecode+i+1) + i = i + 2 + //puts("LA/CW $"); puth(dest) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + codeptr=>0 = $A9+(dest&$FF00) // LDA #2 = $C095+(VX<<8) // STA ESTKH,X + codeptr=>4 = $A9+(dest<<8) // LDA #>VAL + codeptr = codeptr + 6 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $28 // LLA + i++ + j = ^(bytecode+i) + //puts("LLA "); puti(^(bytecode+i)) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + if VY == j + ^codeptr = $98; codeptr++ // TYA -> LDA #imm + + else + *codeptr = $A9+(j<<8) // LDA #imm + codeptr = codeptr + 2 + fin + codeptr->0 = $18 // CLC + codeptr=>1 = $E065 // ADC IFPL + codeptr=>3 = $D095+(VX<<8) // STA ESTKL,X + if VY == 0 + codeptr->5 = $98 // TYA -> LDA #00 + codeptr = codeptr + 6 + else + codeptr=>5 = $00A9 // LDA #$00 + codeptr = codeptr + 7 + fin + codeptr=>0 = $E165 // ADC IFPH + codeptr=>2 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 4 + A_IS_TOSL = FALSE + break + is $2A // CB + is $5E // CFFB + i++ + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + if opcode == $2A + //puts("CB $"); putb(^(bytecode+i)) + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + codeptr=>0 = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 2 + else + //puts("CFFB $FF"); putb(^(bytecode+i)) + codeptr=>0 = $FFA9 // LDA #$FF + codeptr=>2 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 4 + fin + *codeptr = $A9+(^(bytecode+i)<<8) // LDA #imm + codeptr = codeptr + 2 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $2E // CS + i++ + j = ^(bytecode+i) + dest = codeptr + 10 + j + //puts("CS "); //puts(bytecode+i); //puts("-->"); puti(dest) + if isule(dest, codemax) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + codeptr=>0 = $A9+((codeptr+9)&$FF00) // LDA #>STRING + codeptr=>2 = $C095+(VX<<8) // STA ESTKH,X + codeptr=>4 = $A9+((codeptr+9)<<8) // LDA #6 = $4C // JMP abs + dest = codeptr + 10 + j + codeptr=>7 = dest + strcpy(codeptr + 9, bytecode + i) + i = i + j + fin + codeptr = dest + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $32 // DROP2 + //puts("DROP2") + VX++ // INX + is $30 // DROP + //puts("DROP") + VX++ // INX + A_IS_TOSL = FALSE + break + is $34 // DUP + //puts("DUP") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + elsif A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C0B4+(VX<<8) // LDY ESTKH,X + VX-- // DEX + codeptr=>2 = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 4 + VY = UNKNOWN + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + //is $36 + //puts("DIVMOD") + // + // Should never happen + // + //break + is $38 // ADDI + i++ + j = ^(bytecode+i) + //puts("ADDI $"); putb(^(bytecode+i)) + is $8C // INCR + if opcode == $8C + //puts("INCR") + j = 1 + fin + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $18 // CLC + codeptr=>1 = $69+(j<<8) // ADC #imm + codeptr=>3 = $0290 // BCC +2 + codeptr=>5 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr = codeptr + 7 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $3A // SUBI + i++ + j = ^(bytecode+i) + //puts("SUBI $"); putb(^(bytecode+i)) + is $8E // DECR + if opcode == $8E + //puts("DECR") + j = 1 + fin + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $38 // SEC + codeptr=>1 = $E9+(j<<8) // SBC #imm + codeptr=>3 = $02B0 // BCS +2 + codeptr=>5 = $C0D6+(VX<<8) // DEC ESTKH,X + codeptr = codeptr + 7 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $3C // ANDI + i++ + //puts("ANDI $"); putb(^(bytecode+i)) + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $29+(^(bytecode+i)<<8) // AND #imm + codeptr=>2 = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 4 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $3E // ORI + i++ + //puts("ORI $"); putb(^(bytecode+i)) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + *codeptr = $09+(^(bytecode+i)<<8) // ORA #imm + codeptr = codeptr + 2 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $40 // ISEQ + is $42 // ISNE + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + if opcode == $40 + //puts("ISEQ") + codeptr=>2 = $07D0 // BNE +7 + codeptr=>8 = $01D0 // BNE +1 + else + //puts("ISNE") + codeptr=>2 = $06D0 // BNE +6 + codeptr=>8 = $01F0 // BEQ +1 + fin + codeptr=>0 = $D0D5+$0100+(VX<<8) // CMP ESTKL+1,X + codeptr=>4 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>6 = $C0D5+$0100+(VX<<8) // CMP ESTKH+1 + codeptr=>10 = $9888 // DEY; TYA + codeptr=>12 = $C094+$0100+(VX<<8) // STY ESTKH+1,X + codeptr = codeptr + 14 + VX++ // INX + VY = UNKNOWN + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $44 // ISGT + is $4A // ISLE + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0D5+$0100+(VX<<8) // CMP ESTKL+1,X + codeptr=>2 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>4 = $C0F5+$0100+(VX<<8) // SBC ESTKH+1 + codeptr=>6 = $0250 // BVC +2 + codeptr=>8 = $8049 // EOR #$80 + if opcode == $44 + //puts("ISGT") + codeptr=>10 = $0110 // BPL +1 + else + //puts("ISLE") + codeptr=>10 = $0130 // BMI +1 + fin + codeptr=>12 = $9888 // DEY TYA + codeptr=>14 = $C094+$0100+(VX<<8) // STY ESTKH+1,X + codeptr = codeptr + 16 + VX++ // INX + VY = UNKNOWN + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $46 // ISLT + is $48 // ISGE + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0B5+$0100+(VX<<8) // LDA ESTKL+1,X + codeptr=>2 = $D0D5+(VX<<8) // CMP ESTKL,X + codeptr=>4 = $C0B5+$0100+(VX<<8) // LDA ESTKH+1,X + codeptr=>6 = $C0F5+(VX<<8) // SBC ESTKH + codeptr=>8 = $0250 // BVC +2 + codeptr=>10 = $8049 // EOR #$80 + if opcode == $46 + //puts("ISLT") + codeptr=>12 = $0110 // BPL +1 + else + //puts("ISGE") + codeptr=>12 = $0130 // BMI +1 + fin + codeptr=>14 = $9888 // DEY; TYA + codeptr=>16 = $C094+$0100+(VX<<8) // STY ESTKH+1,X + codeptr = codeptr + 18 + VX++ // INX + VY = UNKNOWN + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $4C // BRFLS + is $4E // BRTRU + i++ + dest = i + *(bytecode+i) + i++ + codeptr, VX = resolveX(codeptr, VX + 1) // INX + if not A_IS_TOSL + *codeptr = $D0B5-$0100//+(VX<<8) // LDA ESTKL-1,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C015-$0100//+(VX<<8) // ORA ESTKH-1,X + if opcode == $4C + //puts("BRFLS "); puti(dest) + codeptr=>2 = $03D0 // BNE +3 + else + //puts("BRTRU "); puti(dest) + codeptr=>2 = $03F0 // BEQ +3 + fin + codeptr->4 = $4C // JMP abs + codeptr=>5 = addrxlate=>[dest] + if not (codeptr->6 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 5 - *jitcodeptr + fin + codeptr = codeptr + 7 + A_IS_TOSL = FALSE + break + is $50 // BRNCH + i++ + dest = i + *(bytecode+i) + i++ + //puts("BRNCH "); puti(dest) + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $4C // JMP abs + codeptr=>1 = addrxlate=>[dest] + if not (codeptr->2 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 1 - *jitcodeptr + fin + codeptr = codeptr + 3 + A_IS_TOSL = FALSE + break + is $52 // SEL + i++ + case = i + *(bytecode+i) + i++ + //puts("SEL "); puti(case); putln + j = ^(bytecode+case) + dest = codeptr + 9 + case * 11) + if isule(dest, codemax) + ^(bytecode+case) = $FE // Flag as NOP + case++ + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C0B4+(VX<<8) // LDY ESTKH,X + codeptr, VX = resolveX(codeptr + 2, VX + 1) // INX + repeat + dest = *(bytecode+case) + //puts(" $"); puth(dest) + codeptr=>0 = $C9+(dest<<8) // CMP #imm + codeptr=>2 = $07D0 // BNE +7 + codeptr=>4 = $C0+(dest&$FF00) // CPY #imm + codeptr=>6 = $03D0 // BNE +3 + *(bytecode+case) = $FEFE + case = case + 2 + dest = case + *(bytecode+case) + //puts("-->"); puti(dest); putln + codeptr->8 = $4C // JMP abs + codeptr=>9 = addrxlate=>[dest] + if not (codeptr->10 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 9 - *jitcodeptr + fin + codeptr = codeptr + 11 + *(bytecode+case) = $FEFE + case = case + 2 + j-- + until not j + codeptr->0 = $4C // JMP abs + codeptr=>1 = addrxlate=>[case] + if not (codeptr->2 & $80) // Unresolved address list + addrxlate=>[case] = codeptr + 1 - *jitcodeptr + fin + codeptr = codeptr + 3 + else + codeptr = dest + fin + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $54 // CALL + //puts("CALL $"); puth(*(bytecode+i)) + // + // Call address + // + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $20 // JSR abs + codeptr=>1 = *(bytecode+i+1) + codeptr = codeptr + 3 + VY = UNKNOWN + A_IS_TOSL = FALSE + i = i + 2 + break + is $56 // ICAL + //puts("ICAL") + // + // Pull address off stack + // + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $E785 // STA $E7:TMPL + codeptr=>2 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>4 = $E885 // STA $E8:TMPH + codeptr, VX = resolveX(codeptr + 6, VX + 1) // INX + // + // Call through TMP + // + codeptr->0 = $20 // JSR abs + codeptr=>1 = $00E6 // $E6:JMPTMP + codeptr = codeptr + 3 + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $5A // LEAVE + i++ + //puts("LEAVE "); puti(^(bytecode+i)) + // + // Call into VM + // + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $20 // JSR abs + codeptr=>1 = directentry // INTERP + codeptr=>3 = $5A + (^(bytecode+i)<<8) // LEAVE CODE AND OPERAND + codeptr = codeptr + 5 + A_IS_TOSL = FALSE + break + is $5C // RET + //puts("RET") + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + ^codeptr = $60; codeptr++ // RTS + A_IS_TOSL = FALSE + break + is $60 // LB + //puts("LB") + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C095-$0100+(VX<<8) // STA ESTKH-1,X + codeptr=>2 = $C0A1-$0100+(VX<<8) // LDA (ESTKH-1,X) + codeptr=>4 = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 6 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $62 // LW + //puts("LW") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C095-$0100+(VX<<8) // STA ESTKH-1,X + codeptr=>2 = $C0A1-$0100+(VX<<8) // LDA (ESTKH-1,X) + codeptr=>4 = $D095+(VX<<8) // STA ESTKL,X + codeptr=>6 = $C0F6-$0100+(VX<<8) // INC ESTKH-1,X + codeptr=>8 = $02D0 // BNE +2 + codeptr=>10 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr=>12 = $C0A1-$0100+(VX<<8) // LDA (ESTKH-1,X) + codeptr=>14 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 16 + A_IS_TOSL = FALSE + break + is $64 // LLB + i++ + j = ^(bytecode+i) + //puts("LLB "); puti(j) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + fin + *codeptr = $E0B1 // LDA (IFP),Y + codeptr = codeptr + 2 + if j <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + *codeptr = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 2 + VY = 0 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $66 // LLW + i++ + j = ^(bytecode+i) + //puts("LLW "); puti(j) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + if VY <> j + *codeptr = $A0+((j+1)<<8) // LDY #imm + codeptr = codeptr + 2 + VY = j + else + ^codeptr = $C8; codeptr++ // INY + fin + codeptr=>0 = $E0B1 // LDA (IFP),Y + codeptr=>2 = $C095+(VX<<8) // STA ESTKH,X + codeptr->4 = $88 // DEY + codeptr=>5 = $E0B1 // LDA (IFP),Y + codeptr = codeptr + 7 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $68 // LAB + is $6A // LAW + dest = *(bytecode+i+1) + i = i + 2 + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + VX-- // DEX + if opcode == $68 + //puts("LAB $"); puth(dest) + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + *codeptr = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 2 + else + //puts("LAW $"); puth(dest) + codeptr->0 = $AD // LDA abs+1 + codeptr=>1 = dest+1 + codeptr=>3 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 5 + fin + codeptr->0 = $AD // LDA abs + codeptr=>1 = dest + codeptr = codeptr + 3 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $6C // DLB + i++ + j = ^(bytecode+i) + //puts("DLB "); puti(j) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + A_IS_TOSL = TOS_CLEAN + fin + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + VY = j + fin + *codeptr = $E091 // STA (IFP),Y + codeptr = codeptr + 2 + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + *codeptr = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 2 + break + is $6E // DLW + i++ + j = ^(bytecode+i) + //puts("DLW "); puti(j) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> j + *codeptr = $A0+((j+1)<<8) // LDY #imm + codeptr = codeptr + 2 + VY = j + else + ^codeptr = $C8; codeptr++ // INY + fin + codeptr=>0 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>2 = $E091 // STA (IFP),Y + codeptr->4 = $88 // DEY + codeptr=>5 = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr=>7 = $E091 // STA (IFP),Y + codeptr = codeptr + 9 + A_IS_TOSL = TOS_CLEAN + break + is $70 // SB + is $72 // SW + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C095-$0100+(VX<<8) // STA ESTKH-1,X + codeptr=>2 = $D0B5+$0100+(VX<<8) // LDA ESTKL+1,X + codeptr=>4 = $C081-$0100+(VX<<8) // STA (ESTKH-1,X) + if opcode == $70 + //puts("SB") + codeptr = codeptr + 6 + else + //puts("SW") + codeptr=>6 = $C0B5+$0100+(VX<<8) // LDA ESTKH+1,X + codeptr=>8 = $C0F6-$0100+(VX<<8) // INC ESTKH-1,X + codeptr=>10 = $02D0 // BNE +2 + codeptr=>12 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr=>14 = $C081-$0100+(VX<<8) // STA (ESTKH-1,X) + codeptr = codeptr + 16 + fin + VX = VX + 2 // INX; INX + A_IS_TOSL = FALSE + break + is $74 // SLB + is $76 // SLW + i++ + j = ^(bytecode+i) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + VY = j + fin + codeptr=>0 = $E091 // STA (IFP),Y + if opcode == $74 + //puts("SLB "); puti(j) + codeptr = codeptr + 2 + else + //puts("SLW "); puti(j) + codeptr->2 = $C8 // INY + codeptr=>3 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>5 = $E091 // STA (IFP),Y + codeptr = codeptr + 7 + VY++ + fin + VX++ // INX + A_IS_TOSL = FALSE + break + is $78 // SAB + is $7A // SAW + dest = *(bytecode+i+1) + i = i + 2 + //puts("SAW $"); puth(dest) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $8D // STA abs + codeptr=>1 = dest + if opcode == $78 + //puts("SAB $"); puth(*(bytecode+i)) + codeptr = codeptr + 3 + else + codeptr=>3 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr->5 = $8D // STA abs+1 + codeptr=>6 = dest+1 + codeptr = codeptr + 8 + fin + VX++ // INX + A_IS_TOSL = FALSE + break + is $7C // DAB + is $7E // DAW + dest = *(bytecode+i+1) + i = i + 2 + //puts("DAW $"); puth(*(bytecode+i)) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + A_IS_TOSL = TOS_CLEAN + fin + codeptr->0 = $8D // STA abs + codeptr=>1 = dest + if opcode == $7C + //puts("DAB $"); puth(*(bytecode+i)) + codeptr = codeptr + 3 + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + *codeptr = $C094+(VX<<8) // STY ESTKH,X + codeptr = codeptr + 2 + else + codeptr=>3 = $C0B4+(VX<<8) // LDY ESTKH,X + codeptr->5 = $8C // STY abs+1 + codeptr=>6 = dest+1 + codeptr = codeptr + 8 + VY = UNKNOWN + fin + break + is $80 // NOT + //puts("NOT") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C015+(VX<<8) // ORA ESTKH,X + codeptr=>2 = $02F0 // BEQ +2 + codeptr=>4 = $FFA9 // LDA #$FF + codeptr=>6 = $FF49 // EOR #$FF + codeptr=>8 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 10 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + break + is $82 // ADD + //puts("ADD") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $18 // CLC + codeptr=>1 = $D075+$0100+(VX<<8) // ADC ESTKL+1,X + codeptr=>3 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>5 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>7 = $C075+$0100+(VX<<8) // ADC ESTKH+1,X + codeptr=>9 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr = codeptr + 11 + VX++ // INX + A_IS_TOSL = FALSE + break + is $84 // SUB + //puts("SUB") + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0B5+$0100+(VX<<8) // LDA ESTKL+1,X + codeptr->2 = $38 // SEC + codeptr=>3 = $D0F5+(VX<<8) // SBC ESTKL,X + codeptr=>5 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>7 = $C0B5+$0100+(VX<<8) // LDA ESTKH+1,X + codeptr=>9 = $C0F5+(VX<<8) // SBC ESTKH,X + codeptr=>11 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr = codeptr + 13 + VX++ // INX + A_IS_TOSL = FALSE + break + is $86 // MUL + is $88 // DIV + is $8A // MOD + is $9A // SHL + is $9C // SHR + //puts("MUL,DIV,MOD,SHL,SHR") + // when opcode + // is $86 + // //puts("MUL") + // is $88 + // //puts("DIV") + // is $8A + // //puts("MOD") + // is $9A + // //puts("SHL") + // is $9C + // //puts("SHR") + // wend + // + // Call into VM + // + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $20 // JSR INTERP + codeptr=>1 = directentry // INTERP + codeptr=>3 = $C000+opcode // OPCODE; NATV CODE + codeptr = codeptr + 5 + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $90 // NEG + //puts("NEG") + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + VY = 0 + fin + codeptr=>0 = $3898 // TYA -> LDA #$00; SEC + codeptr=>2 = $D0F5+(VX<<8) // SBC ESTKL,X + codeptr=>4 = $D095+(VX<<8) // STA ESTKL,X + codeptr->6 = $98 // TYA -> LDA #00 + codeptr=>7 = $C0F5+(VX<<8) // SBC ESTKH,X + codeptr=>9 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 11 + A_IS_TOSL = FALSE + break + is $92 // COMP + //puts("COMP") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $FF49 // EOR #$FF + codeptr=>2 = $D095+(VX<<8) // STA ESTKL,X + codeptr=>4 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>6 = $FF49 // EOR #$FF + codeptr=>8 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 10 + A_IS_TOSL = FALSE + break + is $94 // AND + is $96 // OR + is $98 // XOR + when opcode + is $94 + //puts("AND") + j = $35 + break + is $96 + //puts("OR") + j = $15 + break + is $98 + //puts("XOR") + j = $55 + wend + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = j // OP + codeptr->1 = $D0+$01+VX // ESTKL+1,X + codeptr=>2 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>4 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr->6 = j // OP + codeptr->7 = $C0+$01+VX // ESTKH+1,X + codeptr=>8 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr = codeptr + 10 + VX++ // INX + A_IS_TOSL = FALSE + break + is $9E // IDXW + //puts("IDXW") + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $0A // ASL + codeptr=>1 = $C036+(VX<<8) // ROL ESTKH,X + codeptr->3 = $18 // CLC + codeptr=>4 = $D075+$0100+(VX<<8) // ADC ESTKL+1,X + codeptr=>6 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>8 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>10 = $C075+$0100+(VX<<8) // ADC ESTKH+1,X + codeptr=>12 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr = codeptr + 14 + VX++ // INX + A_IS_TOSL = FALSE + break + is $A0 // BRGT - FOR/NEXT SPECIFIC TEST & BRANCH + i++ + dest = i + *(bytecode+i) + i++ + //puts("BRGT "); puti(dest) + codeptr, VX = resolveX(codeptr, VX) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0B5+$0100//+(VX<<8) // LDA ESTKL+1,X + codeptr=>2 = $D0D5//+(VX<<8) // CMP ESTKL,X + codeptr=>4 = $C0B5+$0100//+(VX<<8) // LDA ESTKH+1,X + codeptr=>6 = $C0F5//+(VX<<8) // SBC ESTKH + codeptr=>8 = $0250 // BVC +2 + codeptr=>10 = $8049 // EOR #$80 + codeptr=>12 = $0510 // BPL +5 + codeptr=>14 = $E8E8 // INX; INX + codeptr->16 = $4C // JMP abs + codeptr=>17 = addrxlate=>[dest] + if not (codeptr->18 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 17 - *jitcodeptr + fin + codeptr = codeptr + 19 + A_IS_TOSL = FALSE + break + is $A2 // BRLT - FOR/NEXT SPECIFIC TEST & BRANCH + i++ + dest = i + *(bytecode+i) + i++ + //puts("BRLT "); puti(dest) + codeptr, VX = resolveX(codeptr, VX) + if not A_IS_TOSL + *codeptr = $D0B5//+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + elsif A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0D5+$0100//+(VX<<8) // CMP ESTKL+1,X + codeptr=>2 = $C0B5//+(VX<<8) // LDA ESTKH,X + codeptr=>4 = $C0F5+$0100//+(VX<<8) // SBC ESTKH+1 + codeptr=>6 = $0250 // BVC +2 + codeptr=>8 = $8049 // EOR #$80 + codeptr=>10 = $0510 // BPL +5 + codeptr=>12 = $E8E8 // INX; INX + codeptr->14 = $4C // JMP abs + codeptr=>15 = addrxlate=>[dest] + if not (codeptr->16 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 15 - *jitcodeptr + fin + codeptr = codeptr + 17 + A_IS_TOSL = FALSE + break + is $A4 // INCBRLE - FOR/NEXT SPECIFIC INC & TEST & BRANCH + is $A6 // ADDBRLE - FOR/NEXT SPECIFIC ADD & TEST & BRANCH + i++ + dest = i + *(bytecode+i) + i++ + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + if opcode == $A4 + // + // INCR + // + //puts("INCBRLE "); puti(dest) + codeptr->0 = $18 // CLC + codeptr=>1 = $0169 // ADC #$01 + codeptr=>3 = $D095+(VX<<8) // STA ESTKL,X + codeptr=>5 = $0290 // BCC +2 + codeptr=>7 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr, VX = resolveX(codeptr + 9, VX) + else + // + // ADD + // + //puts("ADDBRLE "); puti(dest) + codeptr->0 = $18 // CLC + codeptr=>1 = $D075+$0100+(VX<<8) // ADC ESTKL+1,X + codeptr=>3 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>5 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr=>7 = $C075+$0100+(VX<<8) // ADC ESTKH+1,X + codeptr=>9 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr, VX = resolveX(codeptr + 11, VX + 1) // INX + fin + // + // BRLE + // + codeptr=>0 = $D0B5+$0100//+(VX<<8) // LDA ESTKL+1,X + codeptr=>2 = $D0D5//+(VX<<8) // CMP ESTKL,X + codeptr=>4 = $C0B5+$0100//+(VX<<8) // LDA ESTKH+1,X + codeptr=>6 = $C0F5//+(VX<<8) // SBC ESTKH + codeptr=>8 = $0250 // BVC +2 + codeptr=>10 = $8049 // EOR #$80 + codeptr=>12 = $0330 // BMI +3 + codeptr->14 = $4C // JMP abs + codeptr=>15 = addrxlate=>[dest] + if not (codeptr->16 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 15 - *jitcodeptr + fin + codeptr = codeptr + 17 + VX = VX + 2 // INX; INX + A_IS_TOSL = FALSE + break + is $A8 // DECBRGR - FOR/NEXT SPECIFIC DEC & TEST & BRANCH + is $AA // SUBBRGE - FOR/NEXT SPECIFIC SUB & TEST & BRANCH + i++ + dest = i + *(bytecode+i) + i++ + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if opcode == $A8 + // + // DECR + // + //puts("DECBRGE "); puti(dest) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $38 // SEC + codeptr=>1 = $01E9 // SBC #$01 + codeptr=>3 = $D095+(VX<<8) // STA ESTKL,X + codeptr=>5 = $02B0 // BCS +2 + codeptr=>7 = $C0D6+(VX<<8) // DEC ESTKH,X + codeptr, VX = resolveX(codeptr + 9, VX) + else + // + // SUB + // + //puts("SUBBRGE "); puti(dest) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $D0B5+$0100+(VX<<8) // LDA ESTKL+1,X + codeptr->2 = $38 // SEC + codeptr=>3 = $D0F5+(VX<<8) // SBC ESTKL,X + codeptr=>5 = $D095+$0100+(VX<<8) // STA ESTKL+1,X + codeptr=>7 = $C0B5+$0100+(VX<<8) // LDA ESTKH+1,X + codeptr=>9 = $C0F5+(VX<<8) // SBC ESTKH,X + codeptr=>11 = $C095+$0100+(VX<<8) // STA ESTKH+1,X + codeptr, VX = resolveX(codeptr + 13, VX + 1) // INX + *codeptr = $D0B5//+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + // + // BRGE + // + codeptr=>0 = $D0D5+$0100//+(VX<<8) // CMP ESTKL+1,X + codeptr=>2 = $C0B5//+(VX<<8) // LDA ESTKH,X + codeptr=>4 = $C0F5+$0100//+(VX<<8) // SBC ESTKH+1,X + codeptr=>6 = $0250 // BVC +2 + codeptr=>8 = $8049 // EOR #$80 + codeptr=>10 = $0330 // BMI +3 + codeptr->12 = $4C // JMP abs + codeptr=>13 = addrxlate=>[dest] + if not (codeptr->14 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 13 - *jitcodeptr + fin + codeptr = codeptr + 15 + VX = VX + 2 // INX; INX + A_IS_TOSL = FALSE + break + is $AC // BRAND - LOGICAL AND SPECIFIC BRANCH + is $AE // BROR - LOGICAL OR SPECIFIC BRANCH + i++ + dest = i + *(bytecode+i) + i++ + codeptr, VX = resolveX(codeptr, VX) + if not A_IS_TOSL + *codeptr = $D0B5//+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + elsif A_IS_TOSL & TOS_DIRTY + *codeptr = $D095//+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $C015//+(VX<<8) // ORA ESTKH,X + if opcode == $AC + //puts("BRAND "); puti(dest) + codeptr=>2 = $03D0 // BNE +3 + else + //puts("BROR "); puti(dest) + codeptr=>2 = $03F0 // BEQ +3 + fin + codeptr->4 = $4C // JMP abs + codeptr=>5 = addrxlate=>[dest] + if not (codeptr->6 & $80) // Unresolved address list + addrxlate=>[dest] = codeptr + 5 - *jitcodeptr + fin + codeptr = codeptr + 7 + VX++ // INX + A_IS_TOSL = FALSE + break + is $B0 // ADDLB + is $B2 // ADDLW + i++ + j = ^(bytecode+i) + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + VY = j + fin + codeptr->0 = $18 // CLC + codeptr=>1 = $E071 // ADC (IFP),Y + if opcode == $B0 + //puts("ADDLB "); puti(j) + codeptr=>3 = $0290 // BCC +2 + codeptr=>5 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr = codeptr + 7 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + else + //puts("ADDLW "); puti(j) + codeptr=>3 = $D095+(VX<<8) // STA ESTKL,X + codeptr=>5 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr->7 = $C8 // INY + codeptr=>8 = $E071 // ADC (IFP),Y + codeptr=>10 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 12 + VY++ + A_IS_TOSL = FALSE + fin + break + is $B4 // ADDAB + is $B6 // ADDAW + dest = *(bytecode+i+1) + i = i + 2 + if not A_IS_TOSL + *codeptr = $D0B5+(VX<<8) // LDA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr=>0 = $6D18 // CLC; ADC abs + codeptr=>2 = dest + if opcode == $B4 + //puts("ADDAB $"); puth(dest) + codeptr=>4 = $0290 // BCC +2 + codeptr=>6 = $C0F6+(VX<<8) // INC ESTKH,X + codeptr = codeptr + 8 + A_IS_TOSL = TOS_DIRTY // STA ESTKL,X + else + //puts("ADDAW $"); puth(dest) + codeptr=>4 = $D095+(VX<<8) // STA ESTKL,X + codeptr=>6 = $C0B5+(VX<<8) // LDA ESTKH,X + codeptr->8 = $6D // ADC abs + codeptr=>9 = dest+1 + codeptr=>11 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 13 + A_IS_TOSL = FALSE + fin + break + is $B8 // IDXLB + i++ + j = ^(bytecode+i) + //puts("IDXLB "); puti(j) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + fin + *codeptr = $E0B1 // LDA (IFP),Y + codeptr = codeptr + 2 + if j <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + codeptr->0 = $0A // ASL + codeptr=>1 = $0290 // BCC +2 + codeptr=>3 = $18C8 // INY; CLC + codeptr=>5 = $D075+(VX<<8) // ADC ESTKL,X + codeptr=>7 = $D095+(VX<<8) // STA ESTKL,X + codeptr->9 = $98 // TYA + codeptr=>10 = $C075+(VX<<8) // ADC ESTKH,X + codeptr=>12 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 14 + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $BA // IDXLW + i++ + j = ^(bytecode+i) + //puts("IDXLW "); puti(j) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> j + *codeptr = $A0+(j<<8) // LDY #imm + codeptr = codeptr + 2 + fin + codeptr=>0 = $E0B1 // LDA (IFP),Y + codeptr->2 = $0A // ASL + codeptr=>3 = $E785 // STA $E7:TMPL + codeptr->5 = $C8 // INY + codeptr=>6 = $E0B1 // LDA (IFP),Y + codeptr=>8 = $A82A // ROL; TAY + codeptr=>10 = $E7A5 // LDA $E7:TMPL + codeptr->12 = $18 // CLC + codeptr=>13 = $D075+(VX<<8) // ADC ESTKL,X + codeptr=>15 = $D095+(VX<<8) // STA ESTKL,X + codeptr->17 = $98 // TYA + codeptr=>18 = $C075+(VX<<8) // ADC ESTKH,X + codeptr=>20 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 22 + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $BC // IDXAB + dest = *(bytecode+i+1) + i = i + 2 + //puts("IDXAB $"); puth(*(bytecode+i)) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + if VY <> 0 + *codeptr = $00A0 // LDY #$00 + codeptr = codeptr + 2 + fin + codeptr->0 = $AD // LDA abs + codeptr=>1 = dest + codeptr->3 = $0A // ASL + codeptr=>4 = $0290 // BCC +2 + codeptr=>6 = $18C8 // INY; CLC + codeptr=>8 = $D075+(VX<<8) // ADC ESTKL,X + codeptr=>10 = $D095+(VX<<8) // STA ESTKL,X + codeptr->12 = $98 // TYA + codeptr=>13 = $C075+(VX<<8) // ADC ESTKH,X + codeptr=>15 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 17 + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $BE // IDXAW + dest = *(bytecode+i+1) + i = i + 2 + //puts("IDXAW $"); puth(dest) + if A_IS_TOSL & TOS_DIRTY + *codeptr = $D095+(VX<<8) // STA ESTKL,X + codeptr = codeptr + 2 + fin + codeptr->0 = $AD // LDA abs + codeptr=>1 = dest + codeptr->3 = $0A // ASL + codeptr=>4 = $E785 // STA $E7:TMPL + codeptr->6 = $AD // LDA abs+1 + codeptr=>7 = dest+1 + codeptr=>9 = $A82A // ROL; TAY + codeptr=>11 = $E7A5 // LDA $E7:TMPL + codeptr->13 = $18 // CLC + codeptr=>14 = $D075+(VX<<8) // ADC ESTKL,X + codeptr=>16 = $D095+(VX<<8) // STA ESTKL,X + codeptr->18 = $98 // TYA + codeptr=>19 = $C075+(VX<<8) // ADC ESTKH,X + codeptr=>21 = $C095+(VX<<8) // STA ESTKH,X + codeptr = codeptr + 23 + VY = UNKNOWN + A_IS_TOSL = FALSE + break + is $FE // NOPed out earlier by SELect + break + otherwise + //puts("???: $"); puth(^(bytecode+i)); putln + wend + fin + //putln + i++ + if i >= defptr->bytecodesize + // + // Done compiling. Update DEF entry with JMP to compiled code + // + defptr->interpjsr = $4C // JMP + defptr=>interpaddr = *jitcodeptr + *jitcodeptr = codeptr + // + // Free working bufffers + // + //heaprelease(addrxlate) + //puts("Done compiling: $"); puth(defptr=>interpaddr); putln + //getc + return + fin + loop + // + // If we got here. we ran out of code buffer space. Overwrite interpreter + // entrypoint with standard bytecode interpreter + // + defptr=>interpaddr = indirectentry + // + // Free working bufffers + // + //heaprelease(addrxlate) + //puts("Ran out of code buffer\n") + //getc +end diff --git a/src/libsrc/sane.pla b/src/libsrc/sane.pla index ea79ca3..dae40f7 100644 --- a/src/libsrc/sane.pla +++ b/src/libsrc/sane.pla @@ -734,19 +734,21 @@ def loadcode(codefile) ref = fileio:open(strcat(strcpy(@filepath, cmdsys:syspath), codefile)) //puts("ref = "); prbyte(ref); puts(" perr = "); prbyte(perr); putln if ref - pcode = heapmark + pcode = heapalloc(512) fileio:read(ref, pcode, 512) //puts("Read header bytes: "); puti(seglen) //if seglen == 0; puts(" perr = "); prbyte(perr); fin //getc; putln //dumpheader(pcode) //putname(pcode + segname + 8); putc('='); prword(pcode); putln + heaprelease(pcode + (pcode + t_diskinfo)=>codeaddr) // REserve heap to end of buffer seglen = fileio:read(ref, pcode, (pcode + t_diskinfo)=>codeaddr) //puts("Read segment bytes: "); puti(seglen); putln fileio:close(ref) if !fp6502 and (MACHID & $F0 == $B0) // 128K Apple //e or //c seglen = fixup(AUXADDR, pcode + seglen - 2) - pcode auxmove(AUXADDR, pcode, seglen) + heaprelease(pcode) pcode = AUXADDR else heaprelease(fixup(pcode, pcode + seglen - 2)) // Set heap to beginning of relocation list diff --git a/src/makefile b/src/makefile index ed475b1..e308491 100755 --- a/src/makefile +++ b/src/makefile @@ -4,12 +4,18 @@ PLVM = plvm PLVMZP_APL = vmsrc/apple/plvmzp.inc PLVM01 = rel/apple/A1PLASMA\#060280 PLVM02 = rel/apple/PLASMA.SYSTEM\#FF2000 +PLVMJIT = rel/apple/PLASMAJIT.SYSTEM\#FF2000 PLVM802 = rel/apple/PLASMA16.SYSTEM\#FF2000 PLVM03 = rel/apple/SOS.INTERP\#050000 +SOSCMD = rel/apple/SOS.CMD\#FE1000 CMD = rel/apple/CMD\#061000 +CMDJIT = rel/apple/CMDJIT\#061000 PLVMZP_C64 = vmsrc/c64/plvmzp.inc PLVMC64 = rel/c64/PLASMA ED = rel/ED\#FE1000 +JIT = rel/apple/JIT\#FE1000 +JIT16 = rel/apple/JIT16\#FE1000 +JITUNE = rel/apple/JITUNE\#FE1000 SOS = rel/apple/SOS\#FE1000 ROD = rel/ROD\#FE1000 SIEVE = rel/SIEVE\#FE1000 @@ -75,7 +81,7 @@ TXTTYPE = .TXT #SYSTYPE = \#FF2000 #TXTTYPE = \#040000 -apple: $(PLVMZP_APL) $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM802) $(PLVM03) $(CMD) $(PLASMAPLASM) $(CODEOPT) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(FIBERTEST) $(LONGJMP) $(ED) $(MON) $(SOS) $(ROD) $(SIEVE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(ROGUE) $(ROGUEMAP) $(ROGUECOMBAT) $(GRAFIX) $(GFXDEMO) $(DGR) $(DGRTEST) $(FILEIO_APL) $(CONIO_APL) $(JOYBUZZ) $(PORTIO) $(SPIPORT) $(SDFAT) $(FATCAT) $(FATGET) $(FATPUT) $(FATWDSK) $(FATRDSK) $(SANE) $(FPSTR) $(FPU) $(SANITY) $(RPNCALC) $(SNDSEQ) $(PLAYSEQ) +apple: $(PLVMZP_APL) $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVMJIT) $(PLVM802) $(PLVM03) $(CMD) $(CMDJIT) $(JIT) $(JIT16) $(JITUNE) $(SOSCMD) $(PLASMAPLASM) $(CODEOPT) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(FIBERTEST) $(LONGJMP) $(ED) $(MON) $(SOS) $(ROD) $(SIEVE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(ROGUE) $(ROGUEMAP) $(ROGUECOMBAT) $(GRAFIX) $(GFXDEMO) $(DGR) $(DGRTEST) $(FILEIO_APL) $(CONIO_APL) $(JOYBUZZ) $(PORTIO) $(SPIPORT) $(SDFAT) $(FATCAT) $(FATGET) $(FATPUT) $(FATWDSK) $(FATRDSK) $(SANE) $(FPSTR) $(FPU) $(SANITY) $(RPNCALC) $(SNDSEQ) $(PLAYSEQ) -rm vmsrc/plvmzp.inc c64: $(PLVMZP_C64) $(PLASM) $(PLVM) $(PLVMC64) @@ -84,10 +90,8 @@ c64: $(PLVMZP_C64) $(PLASM) $(PLVM) $(PLVMC64) all: apple c64 clean: - -rm *FE1000 *FF2000 $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM03) - -rm rel/* - -rm rel/apple/* - -rm rel/c64/* + -rm *FE1000 *FF2000 $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVMJIT) $(PLVM03) + -rm -rf rel -rm samplesrc/*.o samplesrc/*~ samplesrc/*.a -rm toolsrc/*.o toolsrc/*~ toolsrc/*.a -rm toolsrc/apple/*.o toolsrc/apple/*~ toolsrc/apple/*.a @@ -150,16 +154,27 @@ $(CMD): vmsrc/apple/cmd.pla vmsrc/apple/cmdstub.s $(PLVM02) $(PLASM) ./$(PLASM) -AOW < vmsrc/apple/cmd.pla > vmsrc/apple/cmd.a acme --setpc 8192 -o $(CMD) vmsrc/apple/cmdstub.s +$(CMDJIT): vmsrc/apple/cmdjit.pla vmsrc/apple/cmdjitstub.s $(PLVMJIT) $(PLASM) + ./$(PLASM) -AOW < vmsrc/apple/cmdjit.pla > vmsrc/apple/cmdjit.a + acme --setpc 8192 -o $(CMDJIT) vmsrc/apple/cmdjitstub.s + +$(SOSCMD): vmsrc/apple/soscmd.pla libsrc/jitcore.pla $(PLVM03) $(PLASM) + ./$(PLASM) -AMOW < vmsrc/apple/soscmd.pla > vmsrc/apple/soscmd.a + acme --setpc 4094 -o $(SOSCMD) vmsrc/apple/soscmd.a + $(PLVM02): vmsrc/apple/plvm02.s acme -o $(PLVM02) -l vmsrc/apple/plvm02.sym vmsrc/apple/plvm02.s +$(PLVMJIT): vmsrc/apple/plvmjit02.s + acme -o $(PLVMJIT) -l vmsrc/apple/plvmjit02.sym vmsrc/apple/plvmjit02.s + $(PLVM802): vmsrc/apple/plvm802.s acme -o $(PLVM802) -l vmsrc/apple/plvm802.sym vmsrc/apple/plvm802.s -vmsrc/apple/soscmd.a: vmsrc/apple/soscmd.pla $(PLASM) - ./$(PLASM) -AOW < vmsrc/apple/soscmd.pla > vmsrc/apple/soscmd.a +vmsrc/apple/sossys.a: vmsrc/apple/sossys.pla $(PLASM) + ./$(PLASM) -AOW < vmsrc/apple/sossys.pla > vmsrc/apple/sossys.a -$(PLVM03): vmsrc/apple/plvm03.s vmsrc/apple/soscmd.a +$(PLVM03): vmsrc/apple/plvm03.s vmsrc/apple/sossys.a acme -o $(PLVM03) -l vmsrc/apple/plvm03.sym vmsrc/apple/plvm03.s # @@ -348,7 +363,20 @@ $(MON): samplesrc/mon.pla $(PLVM02) $(PLASM) ./$(PLASM) -AMOW < samplesrc/mon.pla > samplesrc/mon.a acme --setpc 4094 -o $(MON) samplesrc/mon.a -$(SOS): libsrc/apple/sos.pla $(PLVM02) $(PLASM) +$(SOS): libsrc/apple/sos.pla $(PLVM03) $(PLASM) ./$(PLASM) -AMO < libsrc/apple/sos.pla > libsrc/apple/sos.a acme --setpc 4094 -o $(SOS) libsrc/apple/sos.a +$(JIT): libsrc/apple/jit.pla libsrc/jitcore.pla $(PLVMJIT) $(PLASM) + ./$(PLASM) -AMO < libsrc/apple/jit.pla > libsrc/apple/jit.a + acme --setpc 4094 -o $(JIT) libsrc/apple/jit.a + +$(JIT16): libsrc/apple/jit16.pla libsrc/jit16core.pla $(PLVMJIT) $(PLASM) + ./$(PLASM) -AMO < libsrc/apple/jit16.pla > libsrc/apple/jit16.a + acme --setpc 4094 -o $(JIT16) libsrc/apple/jit16.a + +$(JITUNE): libsrc/apple/jitune.pla $(PLVMJIT) $(PLASM) + ./$(PLASM) -AMO < libsrc/apple/jitune.pla > libsrc/apple/jitune.a + acme --setpc 4094 -o $(JITUNE) libsrc/apple/jitune.a + + diff --git a/src/mkrel b/src/mkrel index 687e882..fc9a31c 100755 --- a/src/mkrel +++ b/src/mkrel @@ -1,7 +1,10 @@ cp rel/apple/CMD#061000 prodos/CMD.BIN +cp rel/apple/CMDJIT#061000 prodos/CMDJIT.BIN cp rel/apple/PLASMA.SYSTEM#FF2000 prodos/PLASMA.SYSTEM.SYS +cp rel/apple/PLASMAJIT.SYSTEM#FF2000 prodos/PLIJIT.SYSTEM.SYS cp rel/apple/PLASMA16.SYSTEM#FF2000 prodos/PLASMA16.SYSTEM.SYS cp rel/apple/SOS.INTERP#050000 prodos/SOS.INTERP.\$05 +cp rel/apple/SOS.CMD#FE1000 prodos/SOS.CMD.REL cp ../doc/Editor.md prodos/EDITOR.README.TXT rm -rf prodos/sys @@ -29,6 +32,9 @@ cp rel/apple/UTHERNET#FE1000 prodos/sys/UTHERNET.REL cp rel/apple/UTHERNET2#FE1000 prodos/sys/UTHERNET2.REL cp rel/apple/SOS#FE1000 prodos/sys/SOS.REL cp rel/apple/GRAFIX#FE1000 prodos/sys/GRAFIX.REL +cp rel/apple/JIT#FE1000 prodos/sys/JIT.REL +cp rel/apple/JIT16#FE1000 prodos/sys/JIT16.REL +cp rel/apple/JITUNE#FE1000 prodos/sys/JITUNE.REL cp ../sysfiles/FP6502.CODE#060000 prodos/sys/FP6502.CODE.BIN cp ../sysfiles/ELEMS.CODE#060000 prodos/sys/ELEMS.CODE.BIN diff --git a/src/opstat b/src/opstat new file mode 100755 index 0000000..38ae4bf --- /dev/null +++ b/src/opstat @@ -0,0 +1,82 @@ +echo -n "CN "; grep -c '; CN' $1 +echo -n "MINUS1 "; grep -c '; MINUS' $1 +echo -n "BREQ "; grep -c '; BREQ' $1 +echo -n "BRNE "; grep -c '; BRNE' $1 +echo -n "LA "; grep -c '; LA' $1 +echo -n "LLA "; grep -c '; LLA' $1 +echo -n "CB "; grep -c '; CB' $1 +echo -n "CW "; grep -c '; CW' $1 +echo -n "CS "; grep -c '; CS' $1 +echo -n "DROP "; grep -c '; DROP ' $1 +echo -n "DROP2 "; grep -c '; DROP2' $1 +echo -n "DUP "; grep -c '; DUP' $1 +echo -n "DIVMOD "; grep -c '; DIVMOD' $1 +echo -n "ADDI "; grep -c '; ADDI' $1 +echo -n "SUBI "; grep -c '; SUBI' $1 +echo -n "ANDI "; grep -c '; ANDI' $1 +echo -n "ORI "; grep -c '; ORI' $1 +echo -n "ISEQ "; grep -c '; ISEQ' $1 +echo -n "ISNE "; grep -c '; ISNE' $1 +echo -n "ISGT "; grep -c '; ISGT' $1 +echo -n "ISLT "; grep -c '; ISLT' $1 +echo -n "ISGE "; grep -c '; ISGE' $1 +echo -n "ISLE "; grep -c '; ISLE' $1 +echo -n "BRFLS "; grep -c '; BRFLS' $1 +echo -n "BRTRU "; grep -c '; BRTRU' $1 +echo -n "BRNCH "; grep -c '; BRNCH' $1 +echo -n "SEL "; grep -c '; SEL' $1 +echo -n "CALL "; grep -c '; CALL' $1 +echo -n "ICAL "; grep -c '; ICAL' $1 +echo -n "ENTER "; grep -c '; ENTER' $1 +echo -n "LEAVE "; grep -c '; LEAVE' $1 +echo -n "RET "; grep -c '; RET' $1 +echo -n "CFFB "; grep -c '; CFFB' $1 +echo -n "LB "; grep -c '; LB' $1 +echo -n "LW "; grep -c '; LW' $1 +echo -n "LLB "; grep -c '; LLB' $1 +echo -n "LLW "; grep -c '; LLW' $1 +echo -n "LAB "; grep -c '; LAB' $1 +echo -n "LAW "; grep -c '; LAW' $1 +echo -n "DLB "; grep -c '; DLB' $1 +echo -n "DLW "; grep -c '; DLW' $1 +echo -n "SB "; grep -c '; SB' $1 +echo -n "SW "; grep -c '; SW' $1 +echo -n "SLB "; grep -c '; SLB' $1 +echo -n "SLW "; grep -c '; SLW' $1 +echo -n "SAB "; grep -c '; SAB' $1 +echo -n "SAW "; grep -c '; SAW' $1 +echo -n "DAB "; grep -c '; DAB' $1 +echo -n "DAW "; grep -c '; DAW' $1 +echo -n "NOT "; grep -c '; NOT' $1 +echo -n "ADD "; grep -c '; ADD ' $1 +echo -n "SUB "; grep -c '; SUB ' $1 +echo -n "MUL "; grep -c '; MUL' $1 +echo -n "DIV "; grep -c '; DIV' $1 +echo -n "MOD "; grep -c '; MOD' $1 +echo -n "INCR "; grep -c '; INCR' $1 +echo -n "DECR "; grep -c '; DECR' $1 +echo -n "NEG "; grep -c '; NEG' $1 +echo -n "COMP "; grep -c '; COMP' $1 +echo -n "AND "; grep -c '; AND ' $1 +echo -n "OR "; grep -c '; OR' $1 +echo -n "XOR "; grep -c '; XOR' $1 +echo -n "SHL "; grep -c '; SHL' $1 +echo -n "SHR "; grep -c '; SHR' $1 +echo -n "IDXW "; grep -c '; IDXW' $1 +echo -n "BRGT "; grep -c '; BRGT' $1 +echo -n "BRLT "; grep -c '; BRLT' $1 +echo -n "INCBRLE "; grep -c '; INCBRLE' $1 +echo -n "ADDBRLE "; grep -c '; ADDBRLE' $1 +echo -n "DECBRGE "; grep -c '; DECBRGE' $1 +echo -n "SUBBRGE "; grep -c '; SUBBRGE' $1 +echo -n "BRAND "; grep -c '; BRAND' $1 +echo -n "BROR "; grep -c '; BROR' $1 +echo -n "ADDLB "; grep -c '; ADDLB' $1 +echo -n "ADDLW "; grep -c '; ADDLW' $1 +echo -n "ADDAB "; grep -c '; ADDAB' $1 +echo -n "ADDAW "; grep -c '; ADDAW' $1 +echo -n "IDXLB "; grep -c '; IDXLB' $1 +echo -n "IDXLW "; grep -c '; IDXLW' $1 +echo -n "IDXAB "; grep -c '; IDXAB' $1 +echo -n "IDXAW "; grep -c '; IDXAW' $1 + diff --git a/src/samplesrc/playseq.pla b/src/samplesrc/playseq.pla index 087dad9..2671eb8 100644 --- a/src/samplesrc/playseq.pla +++ b/src/samplesrc/playseq.pla @@ -6,8 +6,8 @@ include "inc/sndseq.plh" // // These are utility sequences/routines needed to test the music sequencer code. // -word arg -word ref +word arg, seq, len +byte ref // // Sample background process to show it's working // @@ -19,9 +19,11 @@ arg = argNext(argFirst) if ^arg ref = fileio:open(arg) if ref - fileio:read(ref, heapmark(), heapavail()) + seq = heapalloc(heapavail - 256) + len = fileio:read(ref, seq, heapmark - seq) fileio:close(ref) - musicPlay(heapmark(), TRUE) + heaprelease(seq + len) + musicPlay(seq, TRUE) musicGetKey(8, @backgroundProc) // Yield every 8/16 second musicStop else diff --git a/src/samplesrc/rod.pla b/src/samplesrc/rod.pla index 3b4bdf4..d754adb 100644 --- a/src/samplesrc/rod.pla +++ b/src/samplesrc/rod.pla @@ -4,7 +4,7 @@ include "inc/conio.plh" // Rod's Colors // def rod - var i, j, k, w, fmi, fmk, color + byte i, j, k, w, fmi, fmk, color while TRUE for w = 3 to 50 diff --git a/src/samplesrc/rogue.combat.pla b/src/samplesrc/rogue.combat.pla index 8e88b1a..4faea46 100644 --- a/src/samplesrc/rogue.combat.pla +++ b/src/samplesrc/rogue.combat.pla @@ -162,48 +162,47 @@ export def fight(player, enemy) if toupper(conio:getkey()) == 'R' conio:echo(ECHO_OFF) return 1 + fin + // + // Turn player in random direction + // + player->angle = conio:rnd() & 7 + // + // Calculate attack (with a little random variation) + // + p_atck = player->skill + player->energy / 10 - enemy->power / 25 + (conio:rnd() & 7) + e_atck = enemy->power - player->skill / 5 - player->energy / 20 + (conio:rnd() & 7) + if enemy->life > p_atck + enemy->life = enemy->life - p_atck else + win + enemy->life = 0 + p_atck = player->skill + enemy->power / 3 + if p_atck > 100 // Limit skill + p_atck = 100 + fin + player->skill = p_atck // - // Turn player in random direction + // Unlink dead enemy from entities list // - player->angle = conio:rnd() & 7 - // - // Calculate attack (with a little random variation) - // - p_atck = player->skill + player->energy / 10 - enemy->power / 25 + (conio:rnd() & 7) - e_atck = enemy->power - player->skill / 5 - player->energy / 20 + (conio:rnd() & 7) - if enemy->life > p_atck - enemy->life = enemy->life - p_atck - else - win - enemy->life = 0 - p_atck = player->skill + enemy->power / 3 - if p_atck > 100 // Limit skill - p_atck = 100 - fin - player->skill = p_atck - // - // Unlink dead enemy from entities list - // - if enemy == entities - entities = enemy=>next_other - fin - if enemy=>next_other - enemy=>next_other=>prev_other = enemy=>prev_other + if enemy == entities + entities = enemy=>next_other + fin + if enemy=>next_other + enemy=>next_other=>prev_other = enemy=>prev_other + fin + if enemy=>prev_other + enemy=>prev_other=>next_other = enemy=>next_other + fin fin - if enemy=>prev_other - enemy=>prev_other=>next_other = enemy=>next_other + if player->health > e_atck + player->health = player->health - e_atck + else + player->energy = 0 + player->health = 0 fin - fin - if player->health > e_atck - player->health = player->health - e_atck - else - player->energy = 0 - player->health = 0 - fin - if player->energy >= 4 - player->energy = player->energy - 4 - fin + if player->energy >= 4 + player->energy = player->energy - 4 fin until player->health == 0 or enemy->life == 0 conio:echo(ECHO_OFF) diff --git a/src/samplesrc/rogue.map.pla b/src/samplesrc/rogue.map.pla index b068fe1..0ddf1a9 100644 --- a/src/samplesrc/rogue.map.pla +++ b/src/samplesrc/rogue.map.pla @@ -260,8 +260,8 @@ end // export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist) - byte o, l, dist, tile, adjtile, occluded, darkness - word ymap, xmap, imap + byte l, dist, tile, adjtile, occluded, darkness + word ymap, xmap, imap, o byte yscr, xscr if viewdist > beamdepth @@ -279,7 +279,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist) // darkness = 1 imap = (yorg << rowshift) + xorg - if ^(map + imap) & LIT_TILE or lightdist + if lightdist or ^(map + imap) & LIT_TILE // // Update current spot in viewmap // @@ -358,7 +358,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist) // // Run through visible octant beam points // - for l = l to dbeam[viewdist] + for l = dbeam[lightdist]+1 to dbeam[viewdist] // // Check parent visiblity // @@ -429,7 +429,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist) vispix[l] = 0 fin next - for l = l to dbeam[viewdist] + for l = dbeam[lightdist]+1 to dbeam[viewdist] if vispix[vbeam[l]] imap = ((yorg - xbeam[l]) << rowshift) + xorg + ybeam[l] tile = ^(map + imap) @@ -479,7 +479,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist) vispix[l] = 0 fin next - for l = l to dbeam[viewdist] + for l = dbeam[lightdist]+1 to dbeam[viewdist] if vispix[vbeam[l]] imap = ((yorg + xbeam[l]) << rowshift) + xorg + ybeam[l] tile = ^(map + imap) @@ -529,7 +529,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist) vispix[l] = 0 fin next - for l = l to dbeam[viewdist] + for l = dbeam[lightdist]+1 to dbeam[viewdist] if vispix[vbeam[l]] imap = ((yorg + ybeam[l]) << rowshift) + xorg + xbeam[l] tile = ^(map + imap) @@ -579,7 +579,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist) vispix[l] = 0 fin next - for l = l to dbeam[viewdist] + for l = dbeam[lightdist]+1 to dbeam[viewdist] if vispix[vbeam[l]] imap = ((yorg + ybeam[l]) << rowshift) + xorg - xbeam[l] tile = ^(map + imap) @@ -629,7 +629,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist) vispix[l] = 0 fin next - for l = l to dbeam[viewdist] + for l = dbeam[lightdist]+1 to dbeam[viewdist] if vispix[vbeam[l]] imap = ((yorg + xbeam[l]) << rowshift) + xorg - ybeam[l] tile = ^(map + imap) @@ -679,7 +679,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist) vispix[l] = 0 fin next - for l = l to dbeam[viewdist] + for l = dbeam[lightdist]+1 to dbeam[viewdist] if vispix[vbeam[l]] imap = ((yorg - xbeam[l]) << rowshift) + xorg - ybeam[l] tile = ^(map + imap) @@ -729,7 +729,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist) vispix[l] = 0 fin next - for l = l to dbeam[viewdist] + for l = dbeam[lightdist]+1 to dbeam[viewdist] imap = ((yorg - ybeam[l]) << rowshift) + xorg - xbeam[l] if vispix[vbeam[l]] tile = ^(map + imap) diff --git a/src/samplesrc/sieve.pla b/src/samplesrc/sieve.pla index eed1c77..77beecc 100644 --- a/src/samplesrc/sieve.pla +++ b/src/samplesrc/sieve.pla @@ -11,26 +11,30 @@ def beep#0 putc(7) end -beep -//for iter = 1 to 10 - flag = heapalloc(sizepl) - memset(flag, TRUE, sizepl) - count = 0 - for i = 0 to size - if flag->[i] - prime = i + i + 3 - k = i + prime - while k <= size - flag->[k] = FALSE - k = k + prime - loop - count = count + 1 - puti(prime) - putln - fin - next -//next -beep +def sieve#0 + beep + //for iter = 1 to 10 + flag = heapalloc(sizepl) + memset(flag, TRUE, sizepl) + count = 0 + for i = 0 to size + if flag->[i] + prime = i + i + 3 + k = i + prime + while k <= size + flag->[k] = FALSE + k = k + prime + loop + count = count + 1 + puti(prime) + putln + fin + next + //next + beep +end + +sieve puti(count) puts(" primes.\n") done diff --git a/src/toolsrc/codegen.c b/src/toolsrc/codegen.c index 1ceb4f6..9f5efba 100755 --- a/src/toolsrc/codegen.c +++ b/src/toolsrc/codegen.c @@ -382,12 +382,13 @@ void emit_header(void) } void emit_rld(void) { - int i; + int i, j; printf(";\n; RE-LOCATEABLE DICTIONARY\n;\n"); /* * First emit the bytecode definition entrypoint information. */ + /* for (i = 0; i < globals; i++) if (!(idglobal_type[i] & EXTERN_TYPE) && (idglobal_type[i] & DEF_TYPE)) { @@ -395,6 +396,14 @@ void emit_rld(void) printf("\t%s\t_C%03d\t\t\n", DW, idglobal_tag[i]); printf("\t%s\t$00\n", DB); } + */ + j = outflags & INIT ? defs - 1 : defs; + for (i = 0; i < j; i++) + { + printf("\t%s\t$02\t\t\t; CODE TABLE FIXUP\n", DB); + printf("\t%s\t_C%03d\t\t\n", DW, i); + printf("\t%s\t$00\n", DB); + } /* * Now emit the fixup table. */ @@ -600,8 +609,10 @@ void emit_codetag(int tag) void emit_const(int cval) { emit_pending_seq(); - if (cval == 0x0000) - printf("\t%s\t$00\t\t\t; ZERO\n", DB); + if ((cval & 0xFFFF) == 0xFFFF) + printf("\t%s\t$20\t\t\t; MINUS ONE\n", DB); + else if ((cval & 0xFFF0) == 0x0000) + printf("\t%s\t$%02X\t\t\t; CN\t%d\n", DB, cval*2, cval); else if ((cval & 0xFF00) == 0x0000) printf("\t%s\t$2A,$%02X\t\t\t; CB\t%d\n", DB, cval, cval); else if ((cval & 0xFF00) == 0xFF00) @@ -614,6 +625,26 @@ void emit_conststr(long conststr) printf("\t%s\t$2E\t\t\t; CS\n", DB); emit_data(0, STRING_TYPE, conststr, 0); } +void emit_addi(int cval) +{ + emit_pending_seq(); + printf("\t%s\t$38,$%02X\t\t\t; ADDI\t%d\n", DB, cval, cval); +} +void emit_subi(int cval) +{ + emit_pending_seq(); + printf("\t%s\t$3A,$%02X\t\t\t; SUBI\t%d\n", DB, cval, cval); +} +void emit_andi(int cval) +{ + emit_pending_seq(); + printf("\t%s\t$3C,$%02X\t\t\t; ANDI\t%d\n", DB, cval, cval); +} +void emit_ori(int cval) +{ + emit_pending_seq(); + printf("\t%s\t$3E,$%02X\t\t\t; ORI\t%d\n", DB, cval, cval); +} void emit_lb(void) { printf("\t%s\t$60\t\t\t; LB\n", DB); @@ -630,6 +661,22 @@ void emit_llw(int index) { printf("\t%s\t$66,$%02X\t\t\t; LLW\t[%d]\n", DB, index, index); } +void emit_addlb(int index) +{ + printf("\t%s\t$B0,$%02X\t\t\t; ADDLB\t[%d]\n", DB, index, index); +} +void emit_addlw(int index) +{ + printf("\t%s\t$B2,$%02X\t\t\t; ADDLW\t[%d]\n", DB, index, index); +} +void emit_idxlb(int index) +{ + printf("\t%s\t$B8,$%02X\t\t\t; IDXLB\t[%d]\n", DB, index, index); +} +void emit_idxlw(int index) +{ + printf("\t%s\t$BA,$%02X\t\t\t; IDXLW\t[%d]\n", DB, index, index); +} void emit_lab(int tag, int offset, int type) { if (type) @@ -658,6 +705,62 @@ void emit_law(int tag, int offset, int type) printf("\t%s\t$6A,$%02X,$%02X\t\t; LAW\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset); } } +void emit_addab(int tag, int offset, int type) +{ + if (type) + { + int fixup = fixup_new(tag, type, FIXUP_WORD); + char *taglbl = tag_string(tag, type); + printf("\t%s\t$B4\t\t\t; ADDAB\t%s+%d\n", DB, taglbl, offset); + printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset); + } + else + { + printf("\t%s\t$B4,$%02X,$%02X\t\t; ADDAB\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset); + } +} +void emit_addaw(int tag, int offset, int type) +{ + if (type) + { + int fixup = fixup_new(tag, type, FIXUP_WORD); + char *taglbl = tag_string(tag, type); + printf("\t%s\t$B6\t\t\t; ADDAW\t%s+%d\n", DB, taglbl, offset); + printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset); + } + else + { + printf("\t%s\t$B6,$%02X,$%02X\t\t; ADDAW\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset); + } +} +void emit_idxab(int tag, int offset, int type) +{ + if (type) + { + int fixup = fixup_new(tag, type, FIXUP_WORD); + char *taglbl = tag_string(tag, type); + printf("\t%s\t$BC\t\t\t; IDXAB\t%s+%d\n", DB, taglbl, offset); + printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset); + } + else + { + printf("\t%s\t$BC,$%02X,$%02X\t\t; IDXAB\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset); + } +} +void emit_idxaw(int tag, int offset, int type) +{ + if (type) + { + int fixup = fixup_new(tag, type, FIXUP_WORD); + char *taglbl = tag_string(tag, type); + printf("\t%s\t$BE\t\t\t; IDXAW\t%s+%d\n", DB, taglbl, offset); + printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset); + } + else + { + printf("\t%s\t$BE,$%02X,$%02X\t\t; IDXAW\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset); + } +} void emit_sb(void) { printf("\t%s\t$70\t\t\t; SB\n", DB); @@ -747,11 +850,41 @@ void emit_globaladdr(int tag, int offset, int type) } void emit_indexbyte(void) { - printf("\t%s\t$02\t\t\t; IDXB\n", DB); + printf("\t%s\t$82\t\t\t; IDXB\n", DB); } void emit_indexword(void) { - printf("\t%s\t$1E\t\t\t; IDXW\n", DB); + printf("\t%s\t$9E\t\t\t; IDXW\n", DB); +} +void emit_select(int tag) +{ + emit_pending_seq(); + printf("\t%s\t$52\t\t\t; SEL\n", DB); + printf("\t%s\t_B%03d-*\n", DW, tag); +} +void emit_caseblock(int casecnt, int *caseof, int *casetag) +{ + int i; + + if (casecnt < 1 || casecnt > 256) + parse_error("Switch count under/overflow\n"); + emit_pending_seq(); + printf("\t%s\t$%02lX\t\t\t; CASEBLOCK\n", DB, casecnt & 0xFF); + for (i = 0; i < casecnt; i++) + { + printf("\t%s\t$%04lX\n", DW, caseof[i] & 0xFFFF); + printf("\t%s\t_B%03d-*\n", DW, casetag[i]); + } +} +void emit_breq(int tag) +{ + printf("\t%s\t$22\t\t\t; BREQ\t_B%03d\n", DB, tag); + printf("\t%s\t_B%03d-*\n", DW, tag); +} +void emit_brne(int tag) +{ + printf("\t%s\t$24\t\t\t; BRNE\t_B%03d\n", DB, tag); + printf("\t%s\t_B%03d-*\n", DW, tag); } void emit_brfls(int tag) { @@ -769,28 +902,52 @@ void emit_brnch(int tag) printf("\t%s\t$50\t\t\t; BRNCH\t_B%03d\n", DB, tag); printf("\t%s\t_B%03d-*\n", DW, tag); } -void emit_breq(int tag) +void emit_brand(int tag) { emit_pending_seq(); - printf("\t%s\t$3C\t\t\t; BREQ\t_B%03d\n", DB, tag); + printf("\t%s\t$AC\t\t\t; BRAND\t_B%03d\n", DB, tag); printf("\t%s\t_B%03d-*\n", DW, tag); } -void emit_brne(int tag) +void emit_bror(int tag) { emit_pending_seq(); - printf("\t%s\t$3E\t\t\t; BRNE\t_B%03d\n", DB, tag); + printf("\t%s\t$AE\t\t\t; BROR\t_B%03d\n", DB, tag); printf("\t%s\t_B%03d-*\n", DW, tag); } void emit_brgt(int tag) { emit_pending_seq(); - printf("\t%s\t$38\t\t\t; BRGT\t_B%03d\n", DB, tag); + printf("\t%s\t$A0\t\t\t; BRGT\t_B%03d\n", DB, tag); printf("\t%s\t_B%03d-*\n", DW, tag); } void emit_brlt(int tag) { emit_pending_seq(); - printf("\t%s\t$3A\t\t\t; BRLT\t_B%03d\n", DB, tag); + printf("\t%s\t$A2\t\t\t; BRLT\t_B%03d\n", DB, tag); + printf("\t%s\t_B%03d-*\n", DW, tag); +} +void emit_incbrle(int tag) +{ + emit_pending_seq(); + printf("\t%s\t$A4\t\t\t; INCBRLE\t_B%03d\n", DB, tag); + printf("\t%s\t_B%03d-*\n", DW, tag); +} +void emit_addbrle(int tag) +{ + emit_pending_seq(); + printf("\t%s\t$A6\t\t\t; ADDBRLE\t_B%03d\n", DB, tag); + printf("\t%s\t_B%03d-*\n", DW, tag); +} +void emit_decbrge(int tag) +{ + emit_pending_seq(); + printf("\t%s\t$A8\t\t\t; DECBRGE\t_B%03d\n", DB, tag); + printf("\t%s\t_B%03d-*\n", DW, tag); +} +void emit_subbrge(int tag) +{ + emit_pending_seq(); + printf("\t%s\t$AA\t\t\t; SUBBRGE\t_B%03d\n", DB, tag); printf("\t%s\t_B%03d-*\n", DW, tag); } void emit_call(int tag, int type) @@ -839,11 +996,17 @@ void emit_start(void) void emit_drop(void) { emit_pending_seq(); - printf("\t%s\t$30\t\t\t; DROP\n", DB); + printf("\t%s\t$30\t\t\t; DROP \n", DB); +} +void emit_drop2(void) +{ + emit_pending_seq(); + printf("\t%s\t$32\t\t\t; DROP2\n", DB); } void emit_dup(void) { - printf("\t%s\t$32\t\t\t; DUP\n", DB); + emit_pending_seq(); + printf("\t%s\t$34\t\t\t; DUP\n", DB); } int emit_unaryop(t_token op) { @@ -851,19 +1014,19 @@ int emit_unaryop(t_token op) switch (op) { case NEG_TOKEN: - printf("\t%s\t$10\t\t\t; NEG\n", DB); + printf("\t%s\t$90\t\t\t; NEG\n", DB); break; case COMP_TOKEN: - printf("\t%s\t$12\t\t\t; COMP\n", DB); + printf("\t%s\t$92\t\t\t; COMP\n", DB); break; case LOGIC_NOT_TOKEN: - printf("\t%s\t$20\t\t\t; NOT\n", DB); + printf("\t%s\t$80\t\t\t; NOT\n", DB); break; case INC_TOKEN: - printf("\t%s\t$0C\t\t\t; INCR\n", DB); + printf("\t%s\t$8C\t\t\t; INCR\n", DB); break; case DEC_TOKEN: - printf("\t%s\t$0E\t\t\t; DECR\n", DB); + printf("\t%s\t$8E\t\t\t; DECR\n", DB); break; case BPTR_TOKEN: emit_lb(); @@ -883,34 +1046,34 @@ int emit_op(t_token op) switch (op) { case MUL_TOKEN: - printf("\t%s\t$06\t\t\t; MUL\n", DB); + printf("\t%s\t$86\t\t\t; MUL\n", DB); break; case DIV_TOKEN: - printf("\t%s\t$08\t\t\t; DIV\n", DB); + printf("\t%s\t$88\t\t\t; DIV\n", DB); break; case MOD_TOKEN: - printf("\t%s\t$0A\t\t\t; MOD\n", DB); + printf("\t%s\t$8A\t\t\t; MOD\n", DB); break; case ADD_TOKEN: - printf("\t%s\t$02\t\t\t; ADD\n", DB); + printf("\t%s\t$82\t\t\t; ADD \n", DB); break; case SUB_TOKEN: - printf("\t%s\t$04\t\t\t; SUB\n", DB); + printf("\t%s\t$84\t\t\t; SUB \n", DB); break; case SHL_TOKEN: - printf("\t%s\t$1A\t\t\t; SHL\n", DB); + printf("\t%s\t$9A\t\t\t; SHL\n", DB); break; case SHR_TOKEN: - printf("\t%s\t$1C\t\t\t; SHR\n", DB); + printf("\t%s\t$9C\t\t\t; SHR\n", DB); break; case AND_TOKEN: - printf("\t%s\t$14\t\t\t; AND\n", DB); + printf("\t%s\t$94\t\t\t; AND \n", DB); break; case OR_TOKEN: - printf("\t%s\t$16\t\t\t; IOR\n", DB); + printf("\t%s\t$96\t\t\t; OR \n", DB); break; case EOR_TOKEN: - printf("\t%s\t$18\t\t\t; XOR\n", DB); + printf("\t%s\t$98\t\t\t; XOR\n", DB); break; case EQ_TOKEN: printf("\t%s\t$40\t\t\t; ISEQ\n", DB); @@ -930,12 +1093,6 @@ int emit_op(t_token op) case LE_TOKEN: printf("\t%s\t$4A\t\t\t; ISLE\n", DB); break; - case LOGIC_OR_TOKEN: - printf("\t%s\t$22\t\t\t; LOR\n", DB); - break; - case LOGIC_AND_TOKEN: - printf("\t%s\t$24\t\t\t; LAND\n", DB); - break; case COMMA_TOKEN: break; default: @@ -1063,13 +1220,6 @@ int crunch_seq(t_opseq **seq, int pass) freeops = 1; break; } - if (opnext->code == BINARY_CODE(SHL_TOKEN)) - { - op->code = DUP_CODE; - opnext->code = BINARY_CODE(ADD_TOKEN); - crunched = 1; - break; - } } switch (opnext->code) { @@ -1127,6 +1277,22 @@ int crunch_seq(t_opseq **seq, int pass) freeops = 1; } break; + case BRGT_CODE: + if (opprev && (opprev->code == CONST_CODE) && (op->val <= opprev->val)) + freeops = 1; + break; + case BRLT_CODE: + if (opprev && (opprev->code == CONST_CODE) && (op->val >= opprev->val)) + freeops = 1; + break; + case BROR_CODE: + if (!op->val) + freeops = -2; // Remove zero constant + break; + case BRAND_CODE: + if (op->val) + freeops = -2; // Remove non-zero constant + break; case NE_CODE: if (!op->val) freeops = -2; // Remove ZERO:ISNE @@ -1206,20 +1372,64 @@ int crunch_seq(t_opseq **seq, int pass) case BINARY_CODE(LE_TOKEN): op->val = op->val <= opnext->val ? 1 : 0; freeops = 2; - break; - case BINARY_CODE(LOGIC_OR_TOKEN): - op->val = op->val || opnext->val ? 1 : 0; - freeops = 2; - break; - case BINARY_CODE(LOGIC_AND_TOKEN): - op->val = op->val && opnext->val ? 1 : 0; - freeops = 2; - break; + break; } // End of collapse constant operation if ((pass > 0) && (freeops == 0) && (op->val != 0)) crunched = try_dupify(op); break; // CONST_CODE + case BINARY_CODE(ADD_TOKEN): + if (op->val == 0) + { + freeops = -2; + } + else if (op->val > 0 && op->val <= 255) + { + op->code = ADDI_CODE; + freeops = 1; + } + else if (op->val >= -255 && op->val < 0) + { + op->code = SUBI_CODE; + op->val = -op->val; + freeops = 1; + } + break; + case BINARY_CODE(SUB_TOKEN): + if (op->val == 0) + { + freeops = -2; + } + else if (op->val > 0 && op->val <= 255) + { + op->code = SUBI_CODE; + freeops = 1; + } + else if (op->val >= -255 && op->val < 0) + { + op->code = ADDI_CODE; + op->val = -op->val; + freeops = 1; + } + break; + case BINARY_CODE(AND_TOKEN): + if (op->val >= 0 && op->val <= 255) + { + op->code = ANDI_CODE; + freeops = 1; + } + break; + case BINARY_CODE(OR_TOKEN): + if (op->val == 0) + { + freeops = -2; + } + else if (op->val > 0 && op->val <= 255) + { + op->code = ORI_CODE; + freeops = 1; + } + break; case BINARY_CODE(MUL_TOKEN): for (shiftcnt = 0; shiftcnt < 16; shiftcnt++) { @@ -1325,7 +1535,17 @@ int crunch_seq(t_opseq **seq, int pass) crunched = try_dupify(op); break; // GADDR_CODE case LLB_CODE: - if (pass > 0) + if ((opnext->code == ADD_CODE) || (opnext->code == INDEXB_CODE)) + { + op->code = ADDLB_CODE; + freeops = 1; + } + else if (opnext->code == INDEXW_CODE) + { + op->code = IDXLB_CODE; + freeops = 1; + } + else if (pass > 0) crunched = try_dupify(op); break; // LLB_CODE case LLW_CODE: @@ -1343,11 +1563,31 @@ int crunch_seq(t_opseq **seq, int pass) } } } - if ((pass > 0) && (freeops == 0)) + else if ((opnext->code == ADD_CODE) || (opnext->code == INDEXB_CODE)) + { + op->code = ADDLW_CODE; + freeops = 1; + } + else if (opnext->code == INDEXW_CODE) + { + op->code = IDXLW_CODE; + freeops = 1; + } + else if (pass > 0) crunched = try_dupify(op); break; // LLW_CODE case LAB_CODE: - if ((pass > 0) && (op->type || !is_hardware_address(op->offsz))) + if ((opnext->code == ADD_CODE) || (opnext->code == INDEXB_CODE)) + { + op->code = ADDAB_CODE; + freeops = 1; + } + else if (opnext->code == INDEXW_CODE) + { + op->code = IDXAB_CODE; + freeops = 1; + } + else if ((pass > 0) && (op->type || !is_hardware_address(op->offsz))) crunched = try_dupify(op); break; // LAB_CODE case LAW_CODE: @@ -1365,8 +1605,17 @@ int crunch_seq(t_opseq **seq, int pass) } } } - if ((pass > 0) && (freeops == 0) && - (op->type || !is_hardware_address(op->offsz))) + else if ((opnext->code == ADD_CODE) || (opnext->code == INDEXB_CODE)) + { + op->code = ADDAW_CODE; + freeops = 1; + } + else if (opnext->code == INDEXW_CODE) + { + op->code = IDXAW_CODE; + freeops = 1; + } + else if ((pass > 0) && (op->type || !is_hardware_address(op->offsz))) crunched = try_dupify(op); break; // LAW_CODE case LOGIC_NOT_CODE: @@ -1384,6 +1633,36 @@ int crunch_seq(t_opseq **seq, int pass) break; } break; // LOGIC_NOT_CODE + case EQ_CODE: + switch (opnext->code) + { + case BRFALSE_CODE: + op->code = BRNE_CODE; + op->tag = opnext->tag; + freeops = 1; + break; + case BRTRUE_CODE: + op->code = BREQ_CODE; + op->tag = opnext->tag; + freeops = 1; + break; + } + break; // EQ_CODE + case NE_CODE: + switch (opnext->code) + { + case BRFALSE_CODE: + op->code = BREQ_CODE; + op->tag = opnext->tag; + freeops = 1; + break; + case BRTRUE_CODE: + op->code = BRNE_CODE; + op->tag = opnext->tag; + freeops = 1; + break; + } + break; // NE_CODE case SLB_CODE: if ((opnext->code == LLB_CODE) && (op->offsz == opnext->offsz)) { @@ -1577,8 +1856,6 @@ int emit_pending_seq() case LT_CODE: case GT_CODE: case LE_CODE: - case LOGIC_OR_CODE: - case LOGIC_AND_CODE: emit_op(op->code); break; case CONST_CODE: @@ -1587,6 +1864,18 @@ int emit_pending_seq() case STR_CODE: emit_conststr(op->val); break; + case ADDI_CODE: + emit_addi(op->val); + break; + case SUBI_CODE: + emit_subi(op->val); + break; + case ANDI_CODE: + emit_andi(op->val); + break; + case ORI_CODE: + emit_ori(op->val); + break; case LB_CODE: emit_lb(); break; @@ -1599,12 +1888,36 @@ int emit_pending_seq() case LLW_CODE: emit_llw(op->offsz); break; + case ADDLB_CODE: + emit_addlb(op->offsz); + break; + case ADDLW_CODE: + emit_addlw(op->offsz); + break; + case IDXLB_CODE: + emit_idxlb(op->offsz); + break; + case IDXLW_CODE: + emit_idxlw(op->offsz); + break; case LAB_CODE: emit_lab(op->tag, op->offsz, op->type); break; case LAW_CODE: emit_law(op->tag, op->offsz, op->type); break; + case ADDAB_CODE: + emit_addab(op->tag, op->offsz, op->type); + break; + case ADDAW_CODE: + emit_addaw(op->tag, op->offsz, op->type); + break; + case IDXAB_CODE: + emit_idxab(op->tag, op->offsz, op->type); + break; + case IDXAW_CODE: + emit_idxaw(op->tag, op->offsz, op->type); + break; case SB_CODE: emit_sb(); break; @@ -1662,12 +1975,30 @@ int emit_pending_seq() case BRNCH_CODE: emit_brnch(op->tag); break; + case BRAND_CODE: + emit_brand(op->tag); + break; + case BROR_CODE: + emit_bror(op->tag); + break; + case BREQ_CODE: + emit_breq(op->tag); + break; + case BRNE_CODE: + emit_brne(op->tag); + break; case BRFALSE_CODE: emit_brfls(op->tag); break; case BRTRUE_CODE: emit_brtru(op->tag); break; + case BRGT_CODE: + emit_brgt(op->tag); + break; + case BRLT_CODE: + emit_brlt(op->tag); + break; case CODETAG_CODE: printf("_B%03d%c\n", op->tag, LBL); break; diff --git a/src/toolsrc/codegen.h b/src/toolsrc/codegen.h index 243b751..ffde6de 100755 --- a/src/toolsrc/codegen.h +++ b/src/toolsrc/codegen.h @@ -31,8 +31,6 @@ typedef struct _opseq { #define LT_CODE (0x0200|LT_TOKEN) #define GT_CODE (0x0200|GT_TOKEN) #define LE_CODE (0x0200|LE_TOKEN) -#define LOGIC_OR_CODE (0x0200|LOGIC_OR_TOKEN) -#define LOGIC_AND_CODE (0x0200|LOGIC_AND_TOKEN) #define CONST_CODE 0x0300 #define STR_CODE 0x0301 #define LB_CODE 0x0302 @@ -59,11 +57,29 @@ typedef struct _opseq { #define INDEXW_CODE 0x0317 #define DROP_CODE 0x0318 #define DUP_CODE 0x0319 -#define BRNCH_CODE 0x031C -#define BRFALSE_CODE 0x031D -#define BRTRUE_CODE 0x031E -#define CODETAG_CODE 0x031F -#define NOP_CODE 0x0320 +#define ADDI_CODE 0x031A +#define SUBI_CODE 0x031B +#define ANDI_CODE 0x031C +#define ORI_CODE 0x31D +#define BRNCH_CODE 0x0320 +#define BRFALSE_CODE 0x0321 +#define BRTRUE_CODE 0x0322 +#define BREQ_CODE 0x0323 +#define BRNE_CODE 0x0324 +#define BRAND_CODE 0x0325 +#define BROR_CODE 0x0326 +#define BRLT_CODE 0x0327 +#define BRGT_CODE 0x0328 +#define CODETAG_CODE 0x0329 +#define NOP_CODE 0x032A +#define ADDLB_CODE 0x0330 +#define ADDLW_CODE 0x0331 +#define ADDAB_CODE 0x0332 +#define ADDAW_CODE 0x0333 +#define IDXLB_CODE 0x0334 +#define IDXLW_CODE 0x0335 +#define IDXAB_CODE 0x0336 +#define IDXAW_CODE 0x0337 #define gen_uop(seq,op) gen_seq(seq,UNARY_CODE(op),0,0,0,0) #define gen_op(seq,op) gen_seq(seq,BINARY_CODE(op),0,0,0,0) @@ -79,6 +95,10 @@ typedef struct _opseq { #define gen_sw(seq) gen_seq(seq,SW_CODE,0,0,0,0) #define gen_icall(seq) gen_seq(seq,ICAL_CODE,0,0,0,0) #define gen_drop(seq) gen_seq(seq,DROP_CODE,0,0,0,0) +#define gen_brand(seq,tag) gen_seq(seq,BRAND_CODE,0,tag,0,0) +#define gen_bror(seq,tag) gen_seq(seq,BROR_CODE,0,tag,0,0) +#define gen_brgt(seq,tag) gen_seq(seq,BRGT_CODE,0,tag,0,0) +#define gen_brlt(seq,tag) gen_seq(seq,BRLT_CODE,0,tag,0,0) #define gen_brfls(seq,tag) gen_seq(seq,BRFALSE_CODE,0,tag,0,0) #define gen_brtru(seq,tag) gen_seq(seq,BRTRUE_CODE,0,tag,0,0) #define gen_brnch(seq,tag) gen_seq(seq,BRNCH_CODE,0,tag,0,0) @@ -102,6 +122,10 @@ int emit_data(int vartype, int consttype, long constval, int constsize); void emit_codetag(int tag); void emit_const(int cval); void emit_conststr(long conststr); +void emit_addi(int cval); +void emit_subi(int cval); +void emit_andi(int cval); +void emit_ori(int cval); void emit_lb(void); void emit_lw(void); void emit_llb(int index); @@ -126,14 +150,23 @@ void emit_indexbyte(void); void emit_indexword(void); int emit_unaryop(t_token op); int emit_op(t_token op); +void emit_select(int tag); +void emit_caseblock(int casecnt, int *caseof, int *casetag); +void emit_brand(int tag); +void emit_bror(int tag); void emit_brtru(int tag); void emit_brfls(int tag); -void emit_brgt(int tag); -void emit_brlt(int tag); void emit_brne(int tag); void emit_brnch(int tag); +void emit_brgt(int tag); +void emit_brlt(int tag); +void emit_addbrle(int tag); +void emit_incbrle(int tag); +void emit_subbrge(int tag); +void emit_decbrge(int tag); void emit_empty(void); void emit_drop(void); +void emit_drop2(void); void emit_dup(void); void emit_leave(void); void emit_ret(void); diff --git a/src/toolsrc/codegen.pla b/src/toolsrc/codegen.pla index c51ab70..6f4cd5f 100644 --- a/src/toolsrc/codegen.pla +++ b/src/toolsrc/codegen.pla @@ -132,8 +132,10 @@ def emit_codeseg#0 end def emit_const(cval)#0 emit_pending_seq - if cval == $0000 // ZERO - emit_byte($00) + if cval == $FFFF // MINUS ONE + emit_byte($20) + elsif cval & $FFF0 == $0000 // Constant NYBBLE + emit_byte(cval*2) elsif cval & $FF00 == $0000 // Constant BYTE emit_byte($2A) emit_byte(cval) @@ -171,26 +173,67 @@ def emit_daw(tag, offset)#0 emit_byte($7E) emit_addr(tag, offset) end -def emit_brgt(tag)#0 +def emit_select(tag)#0 emit_pending_seq - emit_byte($38) + emit_byte($52) emit_reladdr(tag) end -def emit_brlt(tag)#0 +def emit_caseblock(cnt, oflist, taglist)#0 + byte i + + if not cnt or cnt > 256; exit_err(ERR_OVER|ERR_STATE); fin emit_pending_seq - emit_byte($3A) - emit_reladdr(tag) -end -def emit_brne(tag)#0 - emit_pending_seq - emit_byte($3E) - emit_reladdr(tag) + emit_byte(cnt) + for i = 0 to cnt-1 + emit_word(oflist=>[i]) + emit_reladdr(taglist=>[i]) + next end def emit_branch(tag)#0 emit_pending_seq emit_byte($50) emit_reladdr(tag) end +def emit_brgt(tag)#0 + emit_pending_seq + emit_byte($A0) + emit_reladdr(tag) +end +def emit_brlt(tag)#0 + emit_pending_seq + emit_byte($A2) + emit_reladdr(tag) +end +def emit_incbrle(tag)#0 + emit_pending_seq + emit_byte($A4) + emit_reladdr(tag) +end +def emit_addbrle(tag)#0 + emit_pending_seq + emit_byte($A6) + emit_reladdr(tag) +end +def emit_decbrge(tag)#0 + emit_pending_seq + emit_byte($A8) + emit_reladdr(tag) +end +def emit_subbrge(tag)#0 + emit_pending_seq + emit_byte($AA) + emit_reladdr(tag) +end +def emit_brand(tag)#0 + emit_pending_seq + emit_byte($AC) + emit_reladdr(tag) +end +def emit_bror(tag)#0 + emit_pending_seq + emit_byte($AE) + emit_reladdr(tag) +end def emit_leave#0 emit_pending_seq if framesize @@ -266,8 +309,11 @@ def emit_pending_seq#0 // is CONST_GROUP if op->opcode == CONST_CODE - if op=>opval == $0000 // ZERO - ^codeptr = $00 + if op=>opval == $FFFF // MINUS 1 + ^codeptr = $20 + codeptr++ + elsif op=>opval & $FFF0 == $0000 // Constant NYBBLE + ^codeptr = op->opval*2 codeptr++ elsif op=>opval & $FF00 == $0000 // Constant BYTE *codeptr = $2A | (op->opval << 8) @@ -280,6 +326,9 @@ def emit_pending_seq#0 codeptr=>1 = op=>opval codeptr = codeptr + 3 fin + else + *codeptr = op->opcode | (op->opval << 8) // IMMEDIATE BYTE OP + codeptr = codeptr + 2 fin break // @@ -382,9 +431,10 @@ def idmatch(nameptr, len, idptr, idcnt) while idcnt if len == idptr->idname - for i = 1 to len - if nameptr->[i - 1] <> idptr->idname.[i]; break; fin - next + i = 1; while i <= len and nameptr->[i - 1] == idptr->idname.[i]; i++; loop + //for i = 1 to len + // if nameptr->[i - 1] <> idptr->idname.[i]; break; fin + //next if i > len; return idptr; fin fin idptr = idptr + idptr->idname + t_id @@ -479,11 +529,13 @@ def init_idglobal#0 word op word i + dfd_num = DFDNUM tag_num = TAGNUM fixup_num = FIXUPNUM globalbufsz = IDGLOBALSZ localbufsz = IDLOCALSZ - if isult(heapavail, $8000) + if isult(heapavail, $4000) + dfd_num = DFDNUM/2 tag_num = TAGNUM/2 fixup_num = FIXUPNUM/2 globalbufsz = IDGLOBALSZ @@ -502,6 +554,7 @@ def init_idglobal#0 // // Allocate remaining buffers // + dfd_tag = heapalloc(dfd_num*2) tag_addr = heapalloc(tag_num*2) tag_type = heapalloc(tag_num) fixup_tag = heapalloc(fixup_num*2) @@ -534,13 +587,15 @@ def save_idlocal#0 savelocals = locals savesize = framesize savelast = lastlocal - memcpy(heapmark, idlocal_tbl, lastlocal - idlocal_tbl) + savetbl = heapalloc(lastlocal - idlocal_tbl) + memcpy(savetbl, idlocal_tbl, lastlocal - idlocal_tbl) end def restore_idlocal#0 locals = savelocals framesize = savesize lastlocal = savelast - memcpy(idlocal_tbl, heapmark, lastlocal - idlocal_tbl) + memcpy(idlocal_tbl, savetbl, lastlocal - idlocal_tbl) + heaprelease(savetbl) end // // Module dependency list @@ -554,6 +609,14 @@ def new_moddep(nameptr, len)#0 if moddep_cnt > MODDEPNUM; parse_warn("Module dependency overflow"); fin end // +// DFD list +// +def new_dfd(tag)#0 + if dfd_cnt >= dfd_num; exit_err(ERR_OVER|ERR_CODE|ERR_TABLE); fin + dfd_tag=>[dfd_cnt] = tag + dfd_cnt++ +end +// // Generate/add to a sequence of code // def gen_op(seq, code) @@ -690,15 +753,15 @@ def gen_uop(seq, tkn) fin when tkn is NEG_TKN - code = $10; break + code = $90; break is COMP_TKN - code = $12; break + code = $92; break is LOGIC_NOT_TKN - code = $20; break + code = $80; break is INC_TKN - code = $0C; break + code = $8C; break is DEC_TKN - code = $0E; break + code = $8E; break is BPTR_TKN code = $60; break is WPTR_TKN @@ -725,25 +788,25 @@ def gen_bop(seq, tkn) fin when tkn is MUL_TKN - code = $06; break + code = $86; break is DIV_TKN - code = $08; break + code = $88; break is MOD_TKN - code = $0A; break + code = $8A; break is ADD_TKN - code = $02; break + code = $82; break is SUB_TKN - code = $04; break + code = $84; break is SHL_TKN - code = $1A; break + code = $9A; break is SHR_TKN - code = $1C; break + code = $9C; break is AND_TKN - code = $14; break + code = $94; break is OR_TKN - code = $16; break + code = $96; break is EOR_TKN - code = $18; break + code = $98; break is EQ_TKN code = $40; break is NE_TKN @@ -756,10 +819,6 @@ def gen_bop(seq, tkn) code = $44; break is LE_TKN code = $4A; break - is LOGIC_OR_TKN - code = $22; break - is LOGIC_AND_TKN - code = $24; break otherwise exit_err(ERR_INVAL|ERR_SYNTAX) wend @@ -824,30 +883,34 @@ end // Write DeFinition Directory // def writeDFD(refnum, modfix)#0 - word dfd, idptr, idcnt + word dfd, idptr, cnt byte defdir[128] - dfd, idptr, idcnt = @defdir, idglobal_tbl, globals - while idcnt - if idptr=>idtype & (FUNC_TYPE|EXTERN_TYPE) == FUNC_TYPE + dfd = @defdir + for cnt = 0 to dfd_cnt-1 + //dfd, idptr, cnt = @defdir, idglobal_tbl, globals + //while cnt + //if idptr=>idtype & (FUNC_TYPE|EXTERN_TYPE) == FUNC_TYPE dfd->0 = $02 - dfd=>1 = tag_addr=>[idptr=>idval] + modfix + dfd=>1 = tag_addr=>[dfd_tag=>[cnt]] + modfix dfd->3 = 0 dfd = dfd + 4 - fin - idptr = idptr + idptr->idname + t_id - idcnt-- - loop + //fin + //idptr = idptr + idptr->idname + t_id + //cnt-- + //loop + next fileio:write(refnum, @defdir, dfd - @defdir) end // // Build External Symbol Directory on heap // def buildESD(modfix)#2 - word modofst, esd, idptr, idcnt, len + word modofst, esdtbl, esd, idptr, idcnt, len byte symnum - symnum, esd, idptr, idcnt = 0, heapmark, idglobal_tbl, globals + symnum, esdtbl, idptr, idcnt = 0, heapalloc(heapavail - 256), idglobal_tbl, globals + esd = esdtbl while idcnt if idptr=>idtype & EXPORT_TYPE esd = esd + stodci(@idptr->idname, esd) @@ -866,26 +929,27 @@ def buildESD(modfix)#2 idcnt-- loop ^esd = 0 - len = esd - heapmark + 1 - esd = heapalloc(len) - return esd, len + len = esd - esdtbl + 1 + heaprelease(esdtbl + len) + return esdtbl, len end // // Write ReLocation Directory // def writeRLD(refnum, modofst)#0 - word rld, rldlen, fixups, updtptr, idptr, idcnt, tag + word rldtbl, rld, rldlen, fixups, updtptr, idptr, idcnt, tag byte type - rld = heapmark + rldtbl = heapalloc(heapavail - 256) + rld = rldtbl rldlen = 0 for fixups = fixup_cnt-1 downto 0 tag = fixup_tag=>[fixups] type = tag_type->[tag] if not (type & RELATIVE_FIXUP) if rldlen == 64 // Write out blocks of entries - fileio:write(refnum, heapmark, rld - heapmark) - rld = heapmark + fileio:write(refnum, rldtbl, rld - rldtbl) + rld = rldtbl rldlen = 0 fin if type & EXTERN_FIXUP @@ -907,7 +971,8 @@ def writeRLD(refnum, modofst)#0 fin next ^rld = 0 - fileio:write(refnum, heapmark, rld - heapmark + 1) + fileio:write(refnum, rldtbl, rld - rldtbl + 1) + heaprelease(rldtbl) end // // Write Extended REL file diff --git a/src/toolsrc/codeopt.pla b/src/toolsrc/codeopt.pla index d695d5b..385cd7f 100644 --- a/src/toolsrc/codeopt.pla +++ b/src/toolsrc/codeopt.pla @@ -79,13 +79,6 @@ def crunch_seq(seq, pass) freeops = 1 break fin - if nextop->opcode == SHL_CODE - op->opcode = DUP_CODE - op->opgroup = STACK_GROUP - nextop->opcode = ADD_CODE - crunched = 1 - break - fin fin when nextop->opcode is NEG_CODE @@ -120,6 +113,26 @@ def crunch_seq(seq, pass) freeops = 1 fin break + is BRGT_CODE + if opprev and (opprev->opcode == CONST_CODE) and (op=>opval <= opprev=>opval) + freeops = 1 + fin + break + is BRLT_CODE + if opprev and (opprev->opcode == CONST_CODE) and (op=>opval >= opprev=>opval) + freeops = 1 + fin + break + is BROR_CODE + if not op=>opval + freeops = -2 // Remove zero constant + fin + break + is BRAND_CODE + if op=>opval + freeops = -2 // Remove non-zero constant + fin + break is NE_CODE if not op=>opval freeops = -2 // Remove ZERO:ISNE @@ -129,7 +142,7 @@ def crunch_seq(seq, pass) if not op=>opval op->opcode = LOGIC_NOT_CODE // Replace ZERO:ISEQ op->opgroup = STACK_GROUP - freeops = 1 + freeops = 1 fin break is CONST_CODE // Collapse constant operation @@ -200,20 +213,50 @@ def crunch_seq(seq, pass) op=>opval = op=>opval <= nextop=>opval freeops = 2 break - is LOGIC_OR_CODE - op=>opval = op=>opval or nextop=>opval - freeops = 2 - break - is LOGIC_AND_CODE - op=>opval = op=>opval and nextop=>opval - freeops = 2 - break wend // End of collapse constant operation fin if pass and not freeops and op=>opval crunched = try_dupify(op) fin break // CONST_CODE + is ADD_CODE + if op=>opval == 0 + freeops = -2 + elsif op=>opval > 0 and op=>opval <= 255 + op->opcode = ADDI_CODE + freeops = 1 + elsif op=>opval >= -255 and op=>opval < 0 + op->opcode = SUBI_CODE + op=>opval = -op=>opval + freeops = 1 + fin + break + is SUB_CODE + if op=>opval == 0 + freeops = -2 + elsif op=>opval > 0 and op=>opval <= 255 + op->opcode = SUBI_CODE + freeops = 1 + elsif op=>opval >= -255 and op=>opval < 0 + op->opcode = ADDI_CODE + op=>opval = -op=>opval + freeops = 1 + fin + break + is AND_CODE + if op=>opval >= 0 and op=>opval <= 255 + op->opcode = ANDI_CODE + freeops = 1 + fin + break + is OR_CODE + if op=>opval == 0 + freeops = -2 + elsif op=>opval > 0 and op=>opval <= 255 + op->opcode = ORI_CODE + freeops = 1 + fin + break is MUL_CODE for shiftcnt = 0 to 15 if op=>opval == 1 << shiftcnt @@ -240,7 +283,7 @@ def crunch_seq(seq, pass) if nextop=>opnext nextopnext = nextop=>opnext when nextopnext->opcode - is INDEXB_CODE // ADD_CODE + is ADD_CODE // INDEXB_CODE op=>opoffset = op=>opoffset + nextop=>opval freeops = 2 break @@ -278,7 +321,7 @@ def crunch_seq(seq, pass) if nextop=>opnext nextopnext = nextop=>opnext when nextopnext->opcode - is INDEXB_CODE // ADD_CODE + is ADD_CODE // INDEXB_CODE op=>opoffset = op=>opoffset + nextop=>opval freeops = 2 break @@ -315,45 +358,85 @@ def crunch_seq(seq, pass) fin break // GADDR_CODE is LLB_CODE - if pass + when nextop->opcode + is ADD_CODE // INDEXB_CODE + op->opcode = ADDLB_CODE + freeops = 1 + break + is INDEXW_CODE + op->opcode = IDXLB_CODE + freeops = 1 + break + wend + if pass and not freeops crunched = try_dupify(op) fin break // LLB_CODE is LLW_CODE - // LLW [n]:CB 8:SHR -> LLB [n+1] - if nextop->opcode == CONST_CODE and nextop=>opval == 8 - if nextop=>opnext - nextopnext = nextop=>opnext - if nextopnext->opcode == SHR_CODE - op->opcode = LLB_CODE - op=>opoffset++ - freeops = 2 - break + when nextop->opcode + is ADD_CODE // INDEXB_CODE + op->opcode = ADDLW_CODE + freeops = 1 + break + is INDEXW_CODE + op->opcode = IDXLW_CODE + freeops = 1 + break + is CONST_CODE + // LLW [n]:CB 8:SHR -> LLB [n+1] + if nextop=>opval == 8 and nextop=>opnext + nextopnext = nextop=>opnext + if nextopnext->opcode == SHR_CODE + op->opcode = LLB_CODE + op=>opoffset++ + freeops = 2 + break + fin fin - fin - fin + break + wend if pass and not freeops crunched = try_dupify(op) fin break // LLW_CODE is LAB_CODE - if pass and not is_hardware_address(op=>opoffset) + when nextop->opcode + is ADD_CODE // INDEXB_CODE + op->opcode = ADDAB_CODE + freeops = 1 + break + is INDEXW_CODE + op->opcode = IDXAB_CODE + freeops = 1 + break + wend + if pass and not freeops and not is_hardware_address(op=>opoffset) crunched = try_dupify(op) fin break // LAB_CODE is LAW_CODE - // LAW x:CB 8:SHR -> LAB x+1 - if nextop->opcode == CONST_CODE and nextop=>opval == 8 - if nextop=>opnext - nextopnext = nextop=>opnext - if nextopnext->opcode == SHR_CODE - op->opcode = LAB_CODE - op=>opoffset++ - freeops = 2 - break + when nextop->opcode + is ADD_CODE // INDEXB_CODE + op->opcode = ADDAW_CODE + freeops = 1 + break + is INDEXW_CODE + op->opcode = IDXAW_CODE + freeops = 1 + break + is CONST_CODE + // LLW [n]:CB 8:SHR -> LLB [n+1] + if nextop=>opval == 8 and nextop=>opnext + nextopnext = nextop=>opnext + if nextopnext->opcode == SHR_CODE + op->opcode = LAB_CODE + op=>opoffset++ + freeops = 2 + break + fin fin - fin - fin + break + wend if pass and not freeops and not is_hardware_address(op=>opoffset) crunched = try_dupify(op) fin @@ -374,6 +457,38 @@ def crunch_seq(seq, pass) break wend break // LOGIC_NOT_CODE + is EQ_CODE + when nextop->opcode + is BRFALSE_CODE + op->opcode = BRNE_CODE + op->opgroup = RELATIVE_GROUP + op=>optag = nextop=>optag + freeops = 1 + break + is BRTRUE_CODE + op->opcode = BREQ_CODE + op->opgroup = RELATIVE_GROUP + op=>optag = nextop=>optag + freeops = 1 + break + wend + break // EQ_CODE + is NE_CODE + when nextop->opcode + is BRFALSE_CODE + op->opcode = BREQ_CODE + op->opgroup = RELATIVE_GROUP + op=>optag = nextop=>optag + freeops = 1 + break + is BRTRUE_CODE + op->opcode = BRNE_CODE + op->opgroup = RELATIVE_GROUP + op=>optag = nextop=>optag + freeops = 1 + break + wend + break // NE_CODE is SLB_CODE if nextop->opcode == LLB_CODE and op=>opoffset == nextop=>opoffset op->opcode = DLB_CODE diff --git a/src/toolsrc/codeseq.plh b/src/toolsrc/codeseq.plh index 899d642..3dc89e9 100644 --- a/src/toolsrc/codeseq.plh +++ b/src/toolsrc/codeseq.plh @@ -3,33 +3,36 @@ // const CONST_GROUP = $00 const CONST_CODE = $2C +const ADDI_CODE = $38 +const SUBI_CODE = $3A +const ANDI_CODE = $3C +const ORI_CODE = $3E const CONSTR_GROUP = $01 const CONSTR_CODE = $2E // // Stack code group // const STACK_GROUP = $02 -const INDEXB_CODE = $02 -const ADD_CODE = $02 -const SUB_CODE = $04 -const MUL_CODE = $06 -const DIV_CODE = $08 -const MOD_CODE = $0A -const INC_CODE = $0C -const DEC_CODE = $0E -const NEG_CODE = $10 -const COMP_CODE = $12 -const AND_CODE = $14 -const OR_CODE = $16 -const EOR_CODE = $18 -const SHL_CODE = $1A -const SHR_CODE = $1C -const INDEXW_CODE = $1E -const LOGIC_NOT_CODE = $20 -const LOGIC_OR_CODE = $22 -const LOGIC_AND_CODE = $24 +const INDEXB_CODE = $82 +const ADD_CODE = $82 +const SUB_CODE = $84 +const MUL_CODE = $86 +const DIV_CODE = $88 +const MOD_CODE = $8A +const INC_CODE = $8C +const DEC_CODE = $8E +const NEG_CODE = $90 +const COMP_CODE = $92 +const AND_CODE = $94 +const OR_CODE = $96 +const EOR_CODE = $98 +const SHL_CODE = $9A +const SHR_CODE = $9C +const INDEXW_CODE = $9E +const LOGIC_NOT_CODE = $80 const DROP_CODE = $30 -const DUP_CODE = $32 +const DROP2_CODE = $32 +const DUP_CODE = $34 const EQ_CODE = $40 const NE_CODE = $42 const GT_CODE = $44 @@ -55,6 +58,10 @@ const DLB_CODE = $6C const DLW_CODE = $6E const SLB_CODE = $74 const SLW_CODE = $76 +const ADDLB_CODE = $B0 +const ADDLW_CODE = $B2 +const IDXLB_CODE = $B8 +const IDXLW_CODE = $BA // // Global address code group // @@ -67,13 +74,23 @@ const SAB_CODE = $78 const SAW_CODE = $7A const DAB_CODE = $7C const DAW_CODE = $7E +const ADDAB_CODE = $B4 +const ADDAW_CODE = $B6 +const IDXAB_CODE = $BC +const IDXAW_CODE = $BE // // Relative address code group // const RELATIVE_GROUP = $05 +const BREQ_CODE = $22 +const BRNE_CODE = $24 const BRFALSE_CODE = $4C const BRTRUE_CODE = $4E const BRNCH_CODE = $50 +const BRAND_CODE = $AC +const BROR_CODE = $AE +const BRGT_CODE = $A0 +const BRLT_CODE = $A2 // // Code tag address group // diff --git a/src/toolsrc/ed.pla b/src/toolsrc/ed.pla index 65f8f21..79c0214 100755 --- a/src/toolsrc/ed.pla +++ b/src/toolsrc/ed.pla @@ -7,6 +7,7 @@ include "inc/cmdsys.plh" include "inc/args.plh" include "inc/fileio.plh" +sysflags nojitc // Keep JITC from compiling and pausing while editing // // Hardware constants // @@ -169,8 +170,8 @@ def sizemask(size) return 0 end def strpoolalloc(size) - byte szmask, i - word mapmask, addr + byte szmask + word mapmask, addr, i szmask = sizemask(size) for i = strplmapsize - 1 downto 0 @@ -357,14 +358,13 @@ def writetxt(filename)#0 // // Remove blank lines at end of text. // - while numlines > 1 and strlinbuf=>[numlines - 1] == @nullstr; numlines = numlines - 1; loop + while numlines > 1 and strlinbuf=>[numlines - 1] == @nullstr; numlines--; loop // // Write all the text line to the file. // for i = 0 to numlines - 1 cpyln(strlinbuf=>[i], @txtbuf) - txtbuf = txtbuf + 1 - txtbuf[txtbuf] = $0D + txtbuf++; txtbuf[txtbuf] = $0D // Add CR to end of line fileio:write(refnum, @txtbuf + 1, txtbuf) if !(i & $0F); putc('.'); fin next @@ -503,7 +503,7 @@ end def pgup#0 byte i - for i = pgjmp downto 0 + for i = 0 to pgjmp cursup next end @@ -523,7 +523,7 @@ end def pgdown#0 byte i - for i = pgjmp downto 0 + for i = 0 to pgjmp cursdown next end @@ -543,7 +543,7 @@ end def pgleft#0 byte i - for i = 7 downto 0 + for i = 0 to 7 cursleft next end @@ -563,7 +563,7 @@ end def pgright#0 byte i - for i = 7 downto 0 + for i = 0 to 7 cursright next end @@ -623,8 +623,6 @@ def keyin3 key = keyctrlf; break is $80 | '\\' key = keydelete; break // Delete - is keyenter - key = keyctrlf; break // // Map OA+keypad // @@ -692,33 +690,45 @@ def keyin2 fin until key >= 128 ^keystrobe - if key == keyctrln - key = $DB // '[' - elsif key == $9E // SHIFT+CTRL+N - key = $FE // '~' - elsif key == keyctrlp - key = $DC // '\' - elsif key == $80 // SHIFT+CTRL+P -> CTRL+@ - key = $FC // '|' - elsif key == keyctrlg - key = $DF // '_' - elsif key == keyarrowleft - if ^pushbttn3 < 128 - key = keydelete - fin - elsif key >= $C0 and flags < shiftlock - if ^pushbttn3 < 128 - if key == $C0 - key = $D0 // P - elsif key == $DD - key = $CD // M - elsif key == $DE - key = $CE // N + when key + is keyctrln + key = $DB // '[' + break + is $9E // SHIFT+CTRL+N + key = $FE // '~' + break + is keyctrlp + key = $DC // '\' + break + is $80 // SHIFT+CTRL+P -> CTRL+@ + key = $FC // '|' + break + is keyctrlg + key = $DF // '_' + break + is keyarrowleft + if ^pushbttn3 < 128 + key = keydelete fin - else - key = key | $E0 - fin - fin + break + otherwise + if key >= $C0 and flags < shiftlock + if ^pushbttn3 < 128 + when key + is $C0 + key = $D0 // P + break + is $DD + key = $CD // M + break + is $DE + key = $CE // N + wend + else + key = key | $E0 + fin + fin + wend return key end def setkeyin#0 @@ -836,13 +846,7 @@ def splitline#0 fin end def editkey(key) - if key >= keyspace - return TRUE - elsif key == keydelete - return TRUE - elsif key == keyctrld - return TRUE - elsif key == keyctrlr + if key >= keyspace or key == keydelete or key == keyctrld or key == keyctrlr return TRUE fin return FALSE @@ -1022,7 +1026,6 @@ def editmode#0 fin redraw fin - break wend until exit end @@ -1123,7 +1126,7 @@ def cmdmode#0 word cmdptr clrscrn - puts("PLASMA Editor, Version 1.1\n") + puts("PLASMA Editor, Version 2.0 Dev\n") while not exit puts(@filename) cmdptr = gets($BA) diff --git a/src/toolsrc/lex.pla b/src/toolsrc/lex.pla index 6d8f062..934c351 100644 --- a/src/toolsrc/lex.pla +++ b/src/toolsrc/lex.pla @@ -325,7 +325,7 @@ def nextln scanptr++ scan else - if token <> EOL_TKN and token <> EOF_TKN; puti(token&$7F); puts("Extraneous characters\n"); exit_err(0); fin + if token <> EOL_TKN and token <> EOF_TKN; putc(token&$7F); puts("Extraneous characters\n"); exit_err(0); fin scanptr = inbuff ^instr = fileio:read(refnum, inbuff, 127) if ^instr diff --git a/src/toolsrc/parse.c b/src/toolsrc/parse.c index e10561f..1301921 100755 --- a/src/toolsrc/parse.c +++ b/src/toolsrc/parse.c @@ -1,11 +1,14 @@ #include #include +#include #include "plasm.h" #define LVALUE 0 #define RVALUE 1 #define MAX_LAMBDA 64 -int infunc = 0, break_tag = 0, cont_tag = 0, stack_loop = 0; +int parse_mods(void); + +int infunc = 0, break_tag = 0, cont_tag = 0, stack_loop = 0, infor = 0; long infuncvals = 0; t_token prevstmnt; static int lambda_num = 0; @@ -23,9 +26,7 @@ t_token binary_ops_table[] = { EOR_TOKEN, OR_TOKEN, GT_TOKEN, GE_TOKEN, LT_TOKEN, LE_TOKEN, - EQ_TOKEN, NE_TOKEN, - LOGIC_AND_TOKEN, - LOGIC_OR_TOKEN + EQ_TOKEN, NE_TOKEN /* Lowest precedence */ }; t_token binary_ops_precedence[] = { @@ -37,9 +38,7 @@ t_token binary_ops_precedence[] = { 5, 6, 7, 7, 7, 7, - 8, 8, - 9, - 10 + 8, 8 /* Lowest precedence */ }; @@ -729,14 +728,48 @@ t_opseq *parse_expr(t_opseq *codeseq, int *stackdepth) if (stackdepth) (*stackdepth)--; } - /* - * Look for ternary operator - */ - if (scantoken == TERNARY_TOKEN) + if (scantoken == LOGIC_AND_TOKEN) + { + int tag_and; + int stackdepth1; + + /* + * Short-circuit AND + */ + if (*stackdepth != 1) + parse_error("AND must evaluate to single value"); + tag_and = tag_new(BRANCH_TYPE); + codeseq = gen_brand(codeseq, tag_and); + codeseq = parse_expr(codeseq, &stackdepth1); + if (stackdepth1 != *stackdepth) + parse_error("Inconsistent AND value counts"); + codeseq = gen_codetag(codeseq, tag_and); + } + else if (scantoken == LOGIC_OR_TOKEN) + { + int tag_or; + int stackdepth1; + + /* + * Short-circuit OR + */ + if (*stackdepth != 1) + parse_error("OR must evaluate to single value"); + tag_or = tag_new(BRANCH_TYPE); + codeseq = gen_bror(codeseq, tag_or); + codeseq = parse_expr(codeseq, &stackdepth1); + if (stackdepth1 != *stackdepth) + parse_error("Inconsistent AND value counts"); + codeseq = gen_codetag(codeseq, tag_or); + } + else if (scantoken == TERNARY_TOKEN) { int tag_else, tag_endtri; int stackdepth1; + /* + * Look for ternary operator + */ if (*stackdepth != 1) parse_error("Ternary op must evaluate to single value"); tag_else = tag_new(BRANCH_TYPE); @@ -798,9 +831,11 @@ t_opseq *parse_set(t_opseq *codeseq) int parse_stmnt(void) { int tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend, tag_repeat, tag_for, tag_choice, tag_of; - int type, addr, step, cfnvals; + int type, addr, step, cfnvals, prev_for, constsize, casecnt, i; + int *caseval, *casetag; + long constval; char *idptr; - t_opseq *seq; + t_opseq *seq, *fromseq, *toseq; /* * Optimization for last function LEAVE and OF clause. @@ -856,12 +891,15 @@ int parse_stmnt(void) parse_error("Missing IF/FIN"); break; case WHILE_TOKEN: + prev_for = infor; + infor = 0; tag_while = tag_new(BRANCH_TYPE); tag_wend = tag_new(BRANCH_TYPE); tag_prevcnt = cont_tag; - cont_tag = tag_while; + cont_tag = tag_new(BRANCH_TYPE); tag_prevbrk = break_tag; break_tag = tag_wend; + emit_brnch(cont_tag); emit_codetag(tag_while); if (!(seq = parse_expr(NULL, &cfnvals))) parse_error("Bad expression"); @@ -870,17 +908,20 @@ int parse_stmnt(void) parse_warn("Expression value overflow"); while (cfnvals-- > 1) seq = gen_drop(seq); } - seq = gen_brfls(seq, tag_wend); - emit_seq(seq); + seq = gen_brtru(seq, tag_while); while (parse_stmnt()) next_line(); if (scantoken != LOOP_TOKEN) parse_error("Missing WHILE/END"); - emit_brnch(tag_while); + emit_codetag(cont_tag); + emit_seq(seq); emit_codetag(tag_wend); break_tag = tag_prevbrk; cont_tag = tag_prevcnt; + infor = prev_for; break; case REPEAT_TOKEN: + prev_for = infor; + infor = 0; tag_prevbrk = break_tag; break_tag = tag_new(BRANCH_TYPE); tag_repeat = tag_new(BRANCH_TYPE); @@ -904,48 +945,43 @@ int parse_stmnt(void) emit_seq(seq); emit_codetag(break_tag); break_tag = tag_prevbrk; + infor = prev_for; break; case FOR_TOKEN: - stack_loop++; + stack_loop += 2; + prev_for = infor; + infor = 1; tag_prevbrk = break_tag; break_tag = tag_new(BRANCH_TYPE); tag_for = tag_new(BRANCH_TYPE); tag_prevcnt = cont_tag; - cont_tag = tag_for; + cont_tag = tag_new(BRANCH_TYPE); if (scan() != ID_TOKEN) parse_error("Missing FOR variable"); type = id_type(tokenstr, tokenlen); addr = id_tag(tokenstr, tokenlen); if (scan() != SET_TOKEN) parse_error("Missing FOR ="); - if (!(seq = parse_expr(NULL, &cfnvals))) + if (!(fromseq = parse_expr(NULL, &cfnvals))) parse_error("Bad FOR expression"); if (cfnvals > 1) { parse_warn("Expression value overflow"); while (cfnvals-- > 1) seq = gen_drop(seq); } - emit_seq(seq); - emit_codetag(tag_for); - if (type & LOCAL_TYPE) - type & BYTE_TYPE ? emit_dlb(addr) : emit_dlw(addr); - else - type & BYTE_TYPE ? emit_dab(addr, 0, type) : emit_daw(addr, 0, type); if (scantoken == TO_TOKEN) step = 1; else if (scantoken == DOWNTO_TOKEN) step = -1; else parse_error("Missing FOR TO"); - if (!(seq = parse_expr(NULL, &cfnvals))) + if (!(toseq = parse_expr(NULL, &cfnvals))) parse_error("Bad FOR TO expression"); if (cfnvals > 1) { parse_warn("Expression value overflow"); while (cfnvals-- > 1) seq = gen_drop(seq); } - emit_seq(seq); - step > 0 ? emit_brgt(break_tag) : emit_brlt(break_tag); if (scantoken == STEP_TOKEN) { if (!(seq = parse_expr(NULL, &cfnvals))) @@ -955,27 +991,57 @@ int parse_stmnt(void) parse_warn("Expression value overflow"); while (cfnvals-- > 1) seq = gen_drop(seq); } - emit_seq(seq); - emit_op(step > 0 ? ADD_TOKEN : SUB_TOKEN); } else - emit_unaryop(step > 0 ? INC_TOKEN : DEC_TOKEN); + { + seq = NULL; + } + toseq = cat_seq(toseq, fromseq); + emit_seq(step > 0 ? gen_brgt(toseq, break_tag) : gen_brlt(toseq, break_tag)); + emit_codetag(tag_for); + if (type & LOCAL_TYPE) + type & BYTE_TYPE ? emit_dlb(addr) : emit_dlw(addr); + else + type & BYTE_TYPE ? emit_dab(addr, 0, type) : emit_daw(addr, 0, type); while (parse_stmnt()) next_line(); if (scantoken != NEXT_TOKEN) parse_error("Missing FOR/NEXT"); - emit_brnch(tag_for); + emit_codetag(cont_tag); cont_tag = tag_prevcnt; + if (step > 0) + { + if (seq) + { + emit_seq(seq); + emit_addbrle(tag_for); + } + else + emit_incbrle(tag_for); + } + else + { + if (seq) + { + emit_seq(seq); + emit_subbrge(tag_for); + } + else + emit_decbrge(tag_for); + } emit_codetag(break_tag); - emit_drop(); - break_tag = tag_prevbrk; - stack_loop--; + break_tag = tag_prevbrk; + infor = prev_for; + stack_loop -= 2; break; case CASE_TOKEN: - stack_loop++; + prev_for = infor; + infor = 0; tag_prevbrk = break_tag; break_tag = tag_new(BRANCH_TYPE); tag_choice = tag_new(BRANCH_TYPE); - tag_of = tag_new(BRANCH_TYPE); + caseval = malloc(sizeof(int)*256); + casetag = malloc(sizeof(int)*256); + casecnt = 0; if (!(seq = parse_expr(NULL, &cfnvals))) parse_error("Bad CASE expression"); if (cfnvals > 1) @@ -984,33 +1050,48 @@ int parse_stmnt(void) while (cfnvals-- > 1) seq = gen_drop(seq); } emit_seq(seq); + emit_select(tag_choice); next_line(); while (scantoken != ENDCASE_TOKEN) { if (scantoken == OF_TOKEN) { - if (!(seq = parse_expr(NULL, &cfnvals))) - parse_error("Bad CASE OF expression"); - if (cfnvals > 1) + tag_of = tag_new(BRANCH_TYPE); + constval = 0; + parse_constexpr(&constval, &constsize); + i = casecnt; + while ((i > 0) && (caseval[i-1] > constval)) { - parse_warn("Expression value overflow"); - while (cfnvals-- > 1) seq = gen_drop(seq); + // + // Move larger case consts up + // + caseval[i] = caseval[i-1]; + casetag[i] = casetag[i-1]; + i--; } - emit_seq(seq); - emit_brne(tag_choice); + if ((i < casecnt) && (caseval[i] == constval)) + parse_error("Duplicate CASE"); + caseval[i] = constval; + casetag[i] = tag_of; + casecnt++; emit_codetag(tag_of); while (parse_stmnt()) next_line(); - tag_of = tag_new(BRANCH_TYPE); - if (prevstmnt != BREAK_TOKEN) // Fall through to next OF if no break - emit_brnch(tag_of); - emit_codetag(tag_choice); - tag_choice = tag_new(BRANCH_TYPE); } else if (scantoken == DEFAULT_TOKEN) { - emit_codetag(tag_of); - tag_of = 0; + if (prevstmnt != BREAK_TOKEN) // Branch around caseblock if falling through + { + tag_of = tag_new(BRANCH_TYPE); + emit_brnch(tag_of); + } + else + tag_of = 0; + emit_codetag(tag_choice); + emit_caseblock(casecnt, caseval, casetag); + tag_choice = 0; scan(); + if (tag_of) + emit_codetag(tag_of); while (parse_stmnt()) next_line(); if (scantoken != ENDCASE_TOKEN) parse_error("Bad CASE DEFAULT clause"); @@ -1020,16 +1101,25 @@ int parse_stmnt(void) else parse_error("Bad CASE clause"); } - if (tag_of) - emit_codetag(tag_of); + if (tag_choice) + { + emit_brnch(break_tag); + emit_codetag(tag_choice); + emit_caseblock(casecnt, caseval, casetag); + } + free(caseval); + free(casetag); emit_codetag(break_tag); - emit_drop(); break_tag = tag_prevbrk; - stack_loop--; + infor = prev_for; break; case BREAK_TOKEN: if (break_tag) + { + if (infor) + emit_drop2(); emit_brnch(break_tag); + } else parse_error("BREAK without loop"); break; @@ -1043,7 +1133,14 @@ int parse_stmnt(void) if (infunc) { int i; - for (i = 0; i < stack_loop; i++) + + i = stack_loop; + while (i >= 2) + { + emit_drop2(); + i -= 2; + } + if (i) emit_drop(); cfnvals = 0; emit_seq(parse_list(NULL, &cfnvals)); @@ -1243,7 +1340,7 @@ int parse_struc(void) int parse_vars(int type) { long value; - int idlen, size, cfnparms; + int idlen, size, cfnparms, emit = 0; long cfnvals; char *idstr; @@ -1306,6 +1403,7 @@ int parse_vars(int type) if (type & WORD_TYPE) cfnvals *= 2; do parse_var(type, cfnvals); while (scantoken == COMMA_TOKEN); + emit = type == GLOBAL_TYPE; break; case PREDEF_TOKEN: /* @@ -1346,6 +1444,12 @@ int parse_vars(int type) else parse_error("Bad function pre-declaration"); } while (scantoken == COMMA_TOKEN); + break; + case IMPORT_TOKEN: + if (emit || type != GLOBAL_TYPE) + parse_error("IMPORT after emitting data"); + parse_mods(); + break; case EOL_TOKEN: break; default: @@ -1436,11 +1540,16 @@ int parse_defs(void) char c, *idstr; int idlen, func_tag, cfnparms, cfnvals, type = GLOBAL_TYPE, pretype; static char bytecode = 0; - if (scantoken == EXPORT_TOKEN) + + switch (scantoken) { - if (scan() != DEF_TOKEN && scantoken != ASM_TOKEN) - parse_error("Bad export definition"); - type = EXPORT_TYPE; + case CONST_TOKEN: + case STRUC_TOKEN: + return parse_vars(GLOBAL_TYPE); + case EXPORT_TOKEN: + if (scan() != DEF_TOKEN && scantoken != ASM_TOKEN) + parse_error("Bad export definition"); + type = EXPORT_TYPE; } if (scantoken == DEF_TOKEN) { @@ -1520,8 +1629,9 @@ int parse_defs(void) emit_const(0); emit_leave(); } - while (lambda_cnt--) - emit_lambdafunc(lambda_tag[lambda_cnt], lambda_id[lambda_cnt], lambda_cparams[lambda_cnt], lambda_seq[lambda_cnt]); + for (cfnvals = 0; cfnvals < lambda_cnt; cfnvals++) + emit_lambdafunc(lambda_tag[cfnvals], lambda_id[cfnvals], lambda_cparams[cfnvals], lambda_seq[cfnvals]); + lambda_cnt = 0; return (1); } else if (scantoken == ASM_TOKEN) @@ -1601,21 +1711,21 @@ int parse_module(void) while (parse_mods()) next_line(); while (parse_vars(GLOBAL_TYPE)) next_line(); while (parse_defs()) next_line(); + emit_bytecode_seg(); + emit_start(); + idlocal_reset(); + emit_idfunc(0, 0, NULL, 1); + prevstmnt = 0; if (scantoken != DONE_TOKEN && scantoken != EOF_TOKEN) { - emit_bytecode_seg(); - emit_start(); - idlocal_reset(); - emit_idfunc(0, 0, NULL, 1); - prevstmnt = 0; while (parse_stmnt()) next_line(); if (scantoken != DONE_TOKEN) parse_error("Missing DONE"); - if (prevstmnt != RETURN_TOKEN) - { - emit_const(0); - emit_ret(); - } + } + if (prevstmnt != RETURN_TOKEN) + { + emit_const(0); + emit_ret(); } } emit_trailer(); diff --git a/src/toolsrc/parse.pla b/src/toolsrc/parse.pla index c444eb4..79d0cee 100644 --- a/src/toolsrc/parse.pla +++ b/src/toolsrc/parse.pla @@ -494,7 +494,7 @@ end def parse_expr(codeseq)#2 byte stackdepth, matchdepth, stkdepth1, prevmatch, matchop, i word optos - word tag_else, tag_endtri + word tag_else, tag_endop stackdepth = 0 matchop = 0 @@ -524,21 +524,32 @@ def parse_expr(codeseq)#2 codeseq = gen_bop(codeseq, pop_op) stackdepth-- loop - // - // Look for ternary operator - // - if token == TERNARY_TKN + if token == LOGIC_AND_TKN + if stackdepth <> 1; exit_err(ERR_OVER|ERR_SYNTAX); fin + tag_endop = new_tag(RELATIVE_FIXUP) + codeseq = gen_oprel(codeseq, BRAND_CODE, tag_endop) + codeseq, stkdepth1 = parse_expr(codeseq) + if stkdepth1 <> stackdepth; exit_err(ERR_INVAL|ERR_CODE); fin + codeseq = gen_ctag(codeseq, tag_endop) + elsif token == LOGIC_OR_TKN + if stackdepth <> 1; exit_err(ERR_OVER|ERR_SYNTAX); fin + tag_endop = new_tag(RELATIVE_FIXUP) + codeseq = gen_oprel(codeseq, BROR_CODE, tag_endop) + codeseq, stkdepth1 = parse_expr(codeseq) + if stkdepth1 <> stackdepth; exit_err(ERR_INVAL|ERR_CODE); fin + codeseq = gen_ctag(codeseq, tag_endop) + elsif token == TERNARY_TKN if stackdepth <> 1; exit_err(ERR_OVER|ERR_SYNTAX); fin tag_else = new_tag(RELATIVE_FIXUP) - tag_endtri = new_tag(RELATIVE_FIXUP) + tag_endop = new_tag(RELATIVE_FIXUP) codeseq = gen_oprel(codeseq, BRFALSE_CODE, tag_else) codeseq, stkdepth1 = parse_expr(codeseq) if token <> TRIELSE_TKN; exit_err(ERR_MISS|ERR_SYNTAX); fin - codeseq = gen_oprel(codeseq, BRNCH_CODE, tag_endtri) + codeseq = gen_oprel(codeseq, BRNCH_CODE, tag_endop) codeseq = gen_ctag(codeseq, tag_else) codeseq, stackdepth = parse_expr(codeseq) if stkdepth1 <> stackdepth; exit_err(ERR_INVAL|ERR_CODE); fin - codeseq = gen_ctag(codeseq, tag_endtri) + codeseq = gen_ctag(codeseq, tag_endop) fin return codeseq, stackdepth end @@ -587,9 +598,10 @@ def parse_set(codeseq) return codeseq end def parse_stmnt - byte type, elem_type, elem_size, i, cfnvals - word seq, tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend + byte type, elem_type, elem_size, cfnvals, prev_for + word seq, fromseq, toseq, tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend word tag_repeat, tag_for, tag_choice, tag_of, idptr, addr, stepdir + word caseconst, casecnt, caseval, casetag, i if token <> END_TKN and token <> DONE_TKN and token <> OF_TKN and token <> DEFAULT_TKN prevstmnt = token @@ -640,12 +652,15 @@ def parse_stmnt if token <> FIN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin break is WHILE_TKN + prev_for = infor + infor = FALSE tag_while = new_tag(RELATIVE_FIXUP) tag_wend = new_tag(RELATIVE_FIXUP) tag_prevcnt = cont_tag - cont_tag = tag_while + cont_tag = new_tag(RELATIVE_FIXUP) tag_prevbrk = break_tag break_tag = tag_wend + emit_branch(cont_tag) emit_tag(tag_while) seq, cfnvals = parse_expr(NULL) if !seq; exit_err(ERR_INVAL|ERR_STATE); fin @@ -653,18 +668,21 @@ def parse_stmnt parse_warn("Expression value overflow") while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop fin - seq = gen_oprel(seq, BRFALSE_CODE, tag_wend) - emit_seq(seq) + seq = gen_oprel(seq, BRTRUE_CODE, tag_while) while parse_stmnt nextln loop if token <> LOOP_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin - emit_branch(tag_while) + emit_tag(cont_tag) + emit_seq(seq) emit_tag(tag_wend) break_tag = tag_prevbrk cont_tag = tag_prevcnt + infor = prev_for break is REPEAT_TKN + prev_for = infor + infor = FALSE tag_repeat = new_tag(RELATIVE_FIXUP) tag_prevbrk = break_tag break_tag = new_tag(RELATIVE_FIXUP) @@ -688,12 +706,15 @@ def parse_stmnt emit_seq(seq) emit_tag(break_tag) break_tag = tag_prevbrk + infor = prev_for break is FOR_TKN - stack_loop++ + prev_for = infor + infor = TRUE + stack_loop = stack_loop + 2 tag_for = new_tag(RELATIVE_FIXUP) tag_prevcnt = cont_tag - cont_tag = tag_for + cont_tag = new_tag(RELATIVE_FIXUP) tag_prevbrk = break_tag break_tag = new_tag(RELATIVE_FIXUP) if scan <> ID_TKN; exit_err(ERR_MISS|ERR_ID); fin @@ -705,19 +726,12 @@ def parse_stmnt exit_err(ERR_INVAL|ERR_ID) fin if scan <> SET_TKN; exit_err(ERR_INVAL|ERR_STATE); fin - seq, cfnvals = parse_expr(NULL) - if !seq; exit_err(ERR_INVAL|ERR_STATE); fin + fromseq, cfnvals = parse_expr(NULL) + if !fromseq; exit_err(ERR_INVAL|ERR_STATE); fin if cfnvals > 1 parse_warn("Expression value overflow") while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop fin - emit_seq(seq) - emit_tag(tag_for) - if type & LOCAL_TYPE - if type & BYTE_TYPE; emit_dlb(addr); else; emit_dlw(addr); fin - else - if type & BYTE_TYPE; emit_dab(addr, 0); else; emit_daw(addr, 0); fin - fin if token == TO_TKN stepdir = 1 elsif token == DOWNTO_TKN @@ -725,14 +739,12 @@ def parse_stmnt else exit_err(ERR_INVAL|ERR_STATE) fin - seq, cfnvals = parse_expr(NULL) - if !seq; exit_err(ERR_INVAL|ERR_STATE); fin + toseq, cfnvals = parse_expr(NULL) + if !toseq; exit_err(ERR_INVAL|ERR_STATE); fin if cfnvals > 1 parse_warn("Expression value overflow") while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop fin - emit_seq(seq) - if stepdir > 0; emit_brgt(break_tag); else; emit_brlt(break_tag); fin if token == STEP_TKN seq, cfnvals = parse_expr(NULL) if !seq; exit_err(ERR_INVAL|ERR_STATE); fin @@ -740,28 +752,51 @@ def parse_stmnt parse_warn("Expression value overflow") while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop fin - emit_seq(seq) - emit_code(stepdir > 0 ?? ADD_CODE :: SUB_CODE) else - emit_code(stepdir > 0 ?? INC_CODE :: DEC_CODE) + seq = NULL + fin + emit_seq(gen_oprel(cat_seq(toseq, fromseq), stepdir > 0 ?? BRGT_CODE :: BRLT_CODE, break_tag)) + emit_tag(tag_for) + if type & LOCAL_TYPE + if type & BYTE_TYPE; emit_dlb(addr); else; emit_dlw(addr); fin + else + if type & BYTE_TYPE; emit_dab(addr, 0); else; emit_daw(addr, 0); fin fin while parse_stmnt nextln loop if token <> NEXT_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin - emit_branch(tag_for) + emit_tag(cont_tag) cont_tag = tag_prevcnt + if stepdir > 0 + if seq + emit_seq(seq) + emit_addbrle(tag_for) + else + emit_incbrle(tag_for) + fin + else + if seq + emit_seq(seq) + emit_subbrge(tag_for) + else + emit_decbrge(tag_for) + fin + fin emit_tag(break_tag) - emit_code(DROP_CODE) - break_tag = tag_prevbrk - stack_loop-- + break_tag = tag_prevbrk + stack_loop = stack_loop - 2 + infor = prev_for break is CASE_TKN - stack_loop++ + prev_for = infor + infor = FALSE tag_prevbrk = break_tag break_tag = new_tag(RELATIVE_FIXUP) tag_choice = new_tag(RELATIVE_FIXUP) - tag_of = new_tag(RELATIVE_FIXUP) + caseval = heapalloc(CASENUM) + casetag = heapalloc(CASENUM) + casecnt = 0 seq, cfnvals = parse_expr(NULL) if !seq; exit_err(ERR_INVAL|ERR_STATE); fin if cfnvals > 1 @@ -769,32 +804,44 @@ def parse_stmnt while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop fin emit_seq(seq) + emit_select(tag_choice) nextln while token <> ENDCASE_TKN when token is OF_TKN - seq, cfnvals = parse_expr(NULL) - if !seq; exit_err(ERR_INVAL|ERR_STATE); fin - if cfnvals > 1 - parse_warn("Expression value overflow") - while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop - fin - emit_seq(seq) - emit_brne(tag_choice) + if casecnt == CASENUM; exit_err(ERR_OVER|ERR_TABLE); fin + caseconst, drop, drop = parse_constexpr + tag_of = new_tag(RELATIVE_FIXUP) + i = casecnt + while i > 0 and caseval=>[i-1] > caseconst + // + // Move larger case consts up + // + caseval=>[i] = caseval=>[i-1] + casetag=>[i] = casetag=>[i-1] + i-- + loop + if i < casecnt and caseval=>[i] == caseconst; exit_err(ERR_DUP|ERR_STATE); fin + caseval=>[i] = caseconst + casetag=>[i] = tag_of + casecnt++ emit_tag(tag_of) while parse_stmnt nextln loop - tag_of = new_tag(RELATIVE_FIXUP) - if prevstmnt <> BREAK_TKN // Fall through to next OF if no break + break + is DEFAULT_TKN + tag_of = 0 + if prevstmnt <> BREAK_TKN // Branch around caseblock if falling through + tag_of = new_tag(RELATIVE_FIXUP) emit_branch(tag_of) fin emit_tag(tag_choice) - tag_choice = new_tag(RELATIVE_FIXUP) - break - is DEFAULT_TKN - emit_tag(tag_of) - tag_of = 0 + emit_caseblock(casecnt, caseval, casetag) + tag_choice = 0 + if tag_of + emit_tag(tag_of) + fin scan while parse_stmnt nextln @@ -808,16 +855,19 @@ def parse_stmnt exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE) wend loop - if (tag_of) - emit_tag(tag_of) + if tag_choice + emit_branch(break_tag) + emit_tag(tag_choice) + emit_caseblock(casecnt, caseval, casetag) fin + heaprelease(caseval) emit_tag(break_tag) - emit_code(DROP_CODE) break_tag = tag_prevbrk - stack_loop-- + infor = prev_for break is BREAK_TKN if break_tag + if infor; emit_code(DROP2_CODE); fin emit_branch(break_tag) else exit_err(ERR_INVAL|ERR_STATE) @@ -832,9 +882,14 @@ def parse_stmnt break is RETURN_TKN if infunc - for i = 1 to stack_loop + i = stack_loop + while i >= 2 + emit_code(DROP2_CODE) + i = i - 2 + loop + if i emit_code(DROP_CODE) - next + fin seq, cfnvals = parse_list emit_seq(seq) if cfnvals > infuncvals @@ -1076,6 +1131,10 @@ def parse_vars(type) fin until token <> COMMA_TKN break + is IMPORT_TKN + if codeptr <> codebuff or type <> GLOBAL_TYPE; exit_err(ERR_INVAL|ERR_INIT); fin + parse_mods + break is EOL_TKN break otherwise @@ -1161,64 +1220,68 @@ def parse_defs word type, idstr, func_tag, idptr type = FUNC_TYPE - if token == EXPORT_TKN - if scan <> DEF_TKN; exit_err(ERR_INVAL|ERR_STATE); fin - type = type | EXPORT_TYPE - fin - if token == DEF_TKN - if scan <> ID_TKN; exit_err(ERR_INVAL|ERR_ID); fin - lambda_cnt = 0 - cfnparms = 0 - infuncvals = 1 - infunc = TRUE - idstr = tknptr - idlen = tknlen - init_idlocal - if scan == OPEN_PAREN_TKN - repeat - if scan == ID_TKN - cfnparms++ - new_idlocal(tknptr, tknlen, WORD_TYPE, 2) - scan - fin - until token <> COMMA_TKN - if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin + when token + is CONST_TKN + is STRUC_TKN + return parse_vars(GLOBAL_TYPE) + is EXPORT_TKN + if scan <> DEF_TKN; exit_err(ERR_INVAL|ERR_STATE); fin + type = type | EXPORT_TYPE + is DEF_TKN + if scan <> ID_TKN; exit_err(ERR_INVAL|ERR_ID); fin + lambda_cnt = 0 + cfnparms = 0 + infuncvals = 1 + infunc = TRUE + idstr = tknptr + idlen = tknlen + init_idlocal + if scan == OPEN_PAREN_TKN + repeat + if scan == ID_TKN + cfnparms++ + new_idlocal(tknptr, tknlen, WORD_TYPE, 2) + scan + fin + until token <> COMMA_TKN + if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin + scan + fin + if token == POUND_TKN + if not parse_const(@infuncvals); exit_err(ERR_INVAL|ERR_CONST); fin + scan + fin + idptr = lookup_idglobal(idstr, idlen) + if idptr + if not idptr=>idtype & PREDEF_TYPE; exit_err(ERR_DUP|ERR_ID); fin + if idptr->funcparms <> cfnparms or idptr->funcvals <> infuncvals; exit_err(ERR_DUP|ERR_CODE|ERR_ID); fin + func_tag = idptr=>idval + idptr=>idtype = idptr=>idtype | type + else + func_tag = new_tag(WORD_FIXUP) + new_idfunc(idstr, idlen, type, func_tag, cfnparms, infuncvals) + fin + emit_tag(func_tag) + new_dfd(func_tag) + while parse_vars(LOCAL_TYPE); nextln; loop + emit_enter(cfnparms) + prevstmnt = 0 + while parse_stmnt; nextln; loop + infunc = FALSE + if token <> END_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin scan - fin - if token == POUND_TKN - if not parse_const(@infuncvals); exit_err(ERR_INVAL|ERR_CONST); fin - scan - fin - idptr = lookup_idglobal(idstr, idlen) - if idptr - if not idptr=>idtype & PREDEF_TYPE; exit_err(ERR_DUP|ERR_ID); fin - if idptr->funcparms <> cfnparms or idptr->funcvals <> infuncvals; exit_err(ERR_DUP|ERR_CODE|ERR_ID); fin - func_tag = idptr=>idval - idptr=>idtype = idptr=>idtype | type - else - func_tag = new_tag(WORD_FIXUP) - new_idfunc(idstr, idlen, type, func_tag, cfnparms, infuncvals) - fin - emit_tag(func_tag) - while parse_vars(LOCAL_TYPE); nextln; loop - emit_enter(cfnparms) - prevstmnt = 0 - while parse_stmnt; nextln; loop - infunc = FALSE - if token <> END_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin - scan - if prevstmnt <> RETURN_TKN - if infuncvals; parse_warn("No return values"); fin - for cfnvals = infuncvals - 1 downto 0 - emit_const(0) + if prevstmnt <> RETURN_TKN + if infuncvals; parse_warn("No return values"); fin + for cfnvals = infuncvals - 1 downto 0 + emit_const(0) + next + emit_leave + fin + for cfnvals = 0 to lambda_cnt-1 + emit_lambdafunc(lambda_tag[cfnvals], lambda_cparms[cfnvals], lambda_seq[cfnvals]) + new_dfd(lambda_tag[cfnvals]) next - emit_leave - fin - while lambda_cnt - lambda_cnt-- - emit_lambdafunc(lambda_tag[lambda_cnt], lambda_cparms[lambda_cnt], lambda_seq[lambda_cnt]) - loop - fin + wend return token == EOL_TKN ?? TRUE :: FALSE end def parse_module#0 diff --git a/src/toolsrc/plasm.pla b/src/toolsrc/plasm.pla old mode 100644 new mode 100755 index c483a53..e129806 --- a/src/toolsrc/plasm.pla +++ b/src/toolsrc/plasm.pla @@ -194,8 +194,6 @@ byte = EOR_TKN byte = OR_TKN byte = GT_TKN, GE_TKN, LT_TKN, LE_TKN byte = EQ_TKN, NE_TKN -byte = LOGIC_AND_TKN -byte = LOGIC_OR_TKN // Lowest precedence byte[] bops_prec // Highest precedence byte = 1, 1, 1 @@ -206,8 +204,6 @@ byte = 5 byte = 6 byte = 7, 7, 7, 7 byte = 8, 8 -byte = 9 -byte = 10 // Lowest precedence byte[16] opstack byte[16] precstack @@ -236,24 +232,28 @@ end // Generated code buffers // const OPSEQNUM = 256 +const DFDNUM = 128 const TAGNUM = 1024 const FIXUPNUM = 2048 const MODDEPNUM = 8 const IDGLOBALSZ = 4096 const IDLOCALSZ = 512 +const CASENUM = 64 word fixup_cnt, tag_cnt = -1 +word dfd_tag, dfd_cnt word fixup_tag, fixup_addr word tag_addr, tag_type word idglobal_tbl, idlocal_tbl word pending_seq -word globals, lastglobal, lastglobalsize, lastlocal, savelast -word tag_num, fixup_num, globalbufsz, localbufsz, codebufsz +word globals, lastglobal, lastglobalsize, lastlocal, savelast, savetbl +word dfd_num, tag_num, fixup_num, globalbufsz, localbufsz, codebufsz word datasize, framesize, savesize byte locals, savelocals word codebuff, codeptr, entrypoint word modsysflags byte[16] moddep_tbl[MODDEPNUM] byte moddep_cnt, def_cnt = 1 +predef parse_mods predef emit_pending_seq#0 // // Module relocation base address @@ -298,7 +298,7 @@ const RVALUE = 1 const LAMBDANUM = 16 word strconstbuff word strconstptr -byte infunc, inlambda +byte infunc, inlambda, infor byte stack_loop byte prevstmnt word infuncvals @@ -511,7 +511,7 @@ include "toolsrc/parse.pla" // // Look at command line arguments and compile module // -puts("PLASMA Compiler, Version 1.1\n") +puts("PLASMA Compiler, Version 2.0 Dev\n") arg = argNext(argFirst) if ^arg and ^(arg + 1) == '-' opt = arg + 2 diff --git a/src/vmsrc/apple/cmd.pla b/src/vmsrc/apple/cmd.pla index 339b12c..300a185 100755 --- a/src/vmsrc/apple/cmd.pla +++ b/src/vmsrc/apple/cmd.pla @@ -34,14 +34,17 @@ predef crout()#0, cout(c)#0, prstr(s)#0, prbyte(b)#0, prword(w)#0, print(i)#0, c predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr)#1, releaseheap(newheap)#1, availheap()#1 predef memset(addr,value,size)#0, memcpy(dst,src,size)#0, strcpy(dst,src)#1, strcat(dst,src)#1 predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1, sext(a)#1, divmod(a,b)#2 -predef execmod(modfile)#1 +predef execmod(modfile)#1, open(path)#1, close(refnum)#1, read(refnum, buff, len)#1, write(refnum, buff, len)#1 // // Exported CMDSYS table // -word version = $0110 // 01.10 +word version = $0200 // 02.00 Dev word syspath word syscmdln -word = @execmod +word = @execmod, @open, @close, @read, @write +byte perr +byte jitcount = $10 +byte jitsize = $FF // // Working input buffer overlayed with strings table // @@ -117,7 +120,6 @@ word sysmodsym = @exports // System variable. // word systemflags = 0 -byte perr word heap word xheap = $0800 word lastsym = symtbl @@ -323,36 +325,6 @@ REVCPYLP LDA (SRC),Y BNE REVCPYLP CPYMEX RTS end -// -// COPY FROM MAIN MEM TO AUX MEM. -// -// MEMXCPY(DST, SRC, SIZE) -// -asm memxcpy(dst,src,size)#0 - LDA ESTKL+1,X - STA $3C - CLC - ADC ESTKL,X - STA $3E - LDA ESTKH+1,X - STA $3D - ADC ESTKH,X - STA $3F - LDA ESTKL+2,X - STA $42 - LDA ESTKH+2,X - STA $43 - STX ESP - BIT ROMEN - SEC - JSR $C311 - BIT LCRDEN+LCBNK2 - LDX ESP - INX - INX - INX - RTS -end asm crout()#0 LDA #$8D BNE ++ @@ -898,6 +870,17 @@ def read(refnum, buff, len)#1 perr = syscall($CA, @params) return params:6 end +def write(refnum, buf, len)#1 + byte params[8] + + params.0 = 4 + params.1 = refnum + params:2 = buf + params:4 = len + params:6 = 0 + perr = syscall($CB, @params) + return params:6 +end // // Heap routines. // @@ -906,9 +889,10 @@ def availheap()#1 return @fp - heap end def allocheap(size)#1 - word addr - addr = heap - heap = heap + size + word oldheap, addr + oldheap = heap + addr = heap + heap = heap + size if systemflags & reshgr1 if uword_islt(addr, $4000) and uword_isgt(heap, $2000) addr = $4000 @@ -922,6 +906,7 @@ def allocheap(size)#1 fin fin if uword_isge(heap, @addr) + heap = oldheap return 0 fin return addr @@ -1039,7 +1024,7 @@ def loadmod(mod)#1 word addr, defaddr, modaddr, modfix, modofst, modend word deftbl, deflast word moddep, rld, esd, sym - byte refnum, defbank, str[16], filename[64] + byte refnum, defbank, filename[64], str[] byte header[128] // // Read the RELocatable module header (first 128 bytes) @@ -1053,6 +1038,13 @@ def loadmod(mod)#1 refnum = open(strcpy(@filename,strcat(strcpy(@header, @sysmods), @filename))) fin if refnum + header.0 = $0A + header:1 = @filename + if not syscall($C4, @header) and header.4 <> $FE // Make sure it's a REL module + close(refnum) + perr = $4A // Incompatible type + return -perr + fin rdlen = read(refnum, @header, 128) modsize = header:0 moddep = @header.1 @@ -1212,8 +1204,13 @@ def loadmod(mod)#1 // // Move bytecode to AUX bank. // - memxcpy(defaddr, bytecode, modsize - (bytecode - modaddr)) + *$003C = bytecode + *$003E = modaddr + modsize + *$0042 = defaddr + call($C311, 0, 0, 0, $05) // CALL XMOVE with carry set (MAIN->AUX) and ints disabled fin + else + perr = $46 fin if perr return -perr @@ -1433,7 +1430,7 @@ heap = *freemem // // Print PLASMA version // -prstr("PLASMA "); prbyte(version.1); cout('.'); prbyte(version.0); crout +prstr("PLASMA 2.0 Dev\n")//; prbyte(version.1); cout('.'); prbyte(version.0); crout // // Init symbol table. // diff --git a/src/vmsrc/apple/cmdjit.pla b/src/vmsrc/apple/cmdjit.pla new file mode 100755 index 0000000..442bf2d --- /dev/null +++ b/src/vmsrc/apple/cmdjit.pla @@ -0,0 +1,1497 @@ +const MACHID = $BF98 +const iobuffer = $0800 +const databuff = $2000 +const RELADDR = $1000 +const symtbl = $0C00 +const freemem = $0006 +const getlnbuf = $01FF +// +// System flags: memory allocator screen holes. +// +const restxt1 = $0001 +const restxt2 = $0002 +const resxtxt1 = $0004 +const resxtxt2 = $0008 +const reshgr1 = $0010 +const reshgr2 = $0020 +const resxhgr1 = $0040 +const resxhgr2 = $0080 +const nojitc = $0100 +// +// Module don't free memory +// +const modkeep = $2000 +const modinitkeep = $4000 +// +// Prefix commands +// +const GET_PFX = $C7 +const SET_PFX = $C6 +// +// Indirect interpreter DEFinition entrypoint +// +struc t_defentry + byte interpjsr + word interpaddr + word bytecodeaddr + byte callcount + byte bytecodesize +end +// +// JIT compiler constants +// +const jitcomp = $03E2 +const jitcodeptr = $03E4 +const jitmod = $02E0 +// +// Pedefined functions. +// +predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1 +predef crout()#0, cout(c)#0, prstr(s)#0, prbyte(b)#0, prword(w)#0, print(i)#0, cin()#1, rdstr(p)#1, toupper(c)#1 +predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr)#1, releaseheap(newheap)#1, availheap()#1 +predef memset(addr,value,size)#0, memcpy(dst,src,size)#0, strcpy(dst,src)#1, strcat(dst,src)#1 +predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1, sext(a)#1, divmod(a,b)#2 +predef execmod(modfile)#1, open(path)#1, close(refnum)#1, read(refnum, buf, len)#1 +// +// Exported CMDSYS table +// +word version = $0200 // 02.00 Dev +word syspath +word syscmdln +word = @execmod, @open, @close, @read, 0 // Mark write() as NULL +byte perr +byte jitcount = 0 +byte jitsize = 0 +// +// Working input buffer overlayed with strings table +// +byte cmdln = "" +// +// Name for auto-run file (must follow cmdln) +// +byte autorun = "AUTORUN" +// +// Standard Library exported functions. +// +byte sysmodstr = "CMDSYS" +byte putsstr = "PUTS" +byte putistr = "PUTI" +byte putcstr = "PUTC" +byte putlnstr = "PUTLN" +byte putbstr = "PUTB" +byte putwstr = "PUTH" +byte getcstr = "GETC" +byte getsstr = "GETS" +byte toupstr = "TOUPPER" +byte strcpystr = "STRCPY" +byte strcatstr = "STRCAT" +byte hpmarkstr = "HEAPMARK" +byte hpalignstr = "HEAPALLOCALIGN" +byte hpallocstr = "HEAPALLOC" +byte hprelstr = "HEAPRELEASE" +byte hpavlstr = "HEAPAVAIL" +byte sysmods[] // overlay with exported strings +word memsetstr = "MEMSET" +byte memcpystr = "MEMCPY" +byte uisgtstr = "ISUGT" +byte uisgestr = "ISUGE" +byte uisltstr = "ISULT" +byte uislestr = "ISULE" +byte sextstr = "SEXT" +byte divmodstr = "DIVMOD" +byte machidstr = "MACHID" +byte sysstr = "SYSCALL" +byte callstr = "CALL" +byte prefix[] // overlay with exported symbols table +word exports = @sysmodstr, @version +word = @sysstr, @syscall +word = @callstr, @call +word = @putcstr, @cout +word = @putlnstr, @crout +word = @putsstr, @prstr +word = @putbstr, @prbyte +word = @putwstr, @prword +word = @putistr, @print +word = @getcstr, @cin +word = @getsstr, @rdstr +word = @toupstr, @toupper +word = @hpmarkstr, @markheap +word = @hpallocstr,@allocheap +word = @hpalignstr,@allocalignheap +word = @hprelstr, @releaseheap +word = @hpavlstr, @availheap +word = @memsetstr, @memset +word = @memcpystr, @memcpy +word = @uisgtstr, @uword_isgt +word = @uisgestr, @uword_isge +word = @uisltstr, @uword_islt +word = @uislestr, @uword_isle +word = @strcpystr, @strcpy +word = @strcatstr, @strcat +word = @sextstr, @sext +word = @divmodstr, @divmod +word = @machidstr, MACHID +word = 0 +word sysmodsym = @exports +// +// System variable. +// +word systemflags = 0 +word heap +word xheap = $A000 // Set load address for JIT compiler +word xheaptop = $C000 +word lastsym = symtbl +// +// Utility functions +// +//asm equates included from cmdstub.s +// +//asm saveX#0 +// STX XREG+1 +//end +//asm restoreX#0 +//XREG LDX #$00 +// RTS +//end +// CALL PRODOS +// SYSCALL(CMD, PARAMS) +// +asm syscall(cmd,params)#1 + LDA ESTKL,X + LDY ESTKH,X + STA PARAMS + STY PARAMS+1 + INX + LDA ESTKL,X + STA CMD + JSR $BF00 +CMD: !BYTE 00 +PARAMS: !WORD 0000 +; LDY #$00 + STA ESTKL,X +; STY ESTKH,X + RTS +end +// +// CALL 6502 ROUTINE +// CALL(ADDR, AREG, XREG, YREG, STATUS) +// +asm call(addr,areg,xreg,yreg,status)#1 +REGVALS = SRC + PHP + LDA ESTKL+4,X + STA TMPL + LDA ESTKH+4,X + STA TMPH + LDA ESTKL,X + PHA + LDY ESTKL+1,X + LDA ESTKL+3,X + PHA + LDA ESTKL+2,X + INX + INX + INX + INX + STX ESP + TAX + PLA + BIT ROMEN + PLP + JSR JMPTMP + PHP + BIT LCRDEN+LCBNK2 + STA REGVALS+0 + STX REGVALS+1 + STY REGVALS+2 + PLA + STA REGVALS+3 + LDX ESP + LDA #REGVALS + STA ESTKL,X + STY ESTKH,X + PLP + RTS +end +// +// CALL LOADED SYSTEM PROGRAM +// +asm exec()#0 + BIT ROMEN + JMP $2000 +end +// +// EXIT +// +asm reboot()#0 + BIT ROMEN + DEC $03F4 ; INVALIDATE POWER-UP BYTE + JMP ($FFFC) ; RESET +end +// +// SET MEMORY TO VALUE +// MEMSET(ADDR, VALUE, SIZE) +// With optimizations from Peter Ferrie +// +asm memset(addr,value,size)#0 + LDA ESTKL+2,X + STA DSTL + LDA ESTKH+2,X + STA DSTH + LDY ESTKL,X + BEQ + + INC ESTKH,X + LDY #$00 ++ LDA ESTKH,X + BEQ SETMEX +SETMLPL CLC + LDA ESTKL+1,X +SETMLPH STA (DST),Y + DEC ESTKL,X + BEQ ++ +- INY + BEQ + +-- BCS SETMLPL + SEC + LDA ESTKH+1,X + BCS SETMLPH ++ INC DSTH + BNE -- +++ DEC ESTKH,X + BNE - +SETMEX INX + INX + INX + RTS +end +// +// COPY MEMORY +// MEMCPY(DSTADDR, SRCADDR, SIZE) +// +asm memcpy(dst,src,size)#0 + INX + INX + INX + LDA ESTKL-3,X + ORA ESTKH-3,X + BEQ CPYMEX + LDA ESTKL-2,X + CMP ESTKL-1,X + LDA ESTKH-2,X + SBC ESTKH-1,X + BCC REVCPY +; +; FORWARD COPY +; + LDA ESTKL-1,X + STA DSTL + LDA ESTKH-1,X + STA DSTH + LDA ESTKL-2,X + STA SRCL + LDA ESTKH-2,X + STA SRCH + LDY ESTKL-3,X + BEQ FORCPYLP + INC ESTKH-3,X + LDY #$00 +FORCPYLP LDA (SRC),Y + STA (DST),Y + INY + BNE + + INC DSTH + INC SRCH ++ DEC ESTKL-3,X + BNE FORCPYLP + DEC ESTKH-3,X + BNE FORCPYLP + RTS +; +; REVERSE COPY +; +REVCPY ;CLC + LDA ESTKL-3,X + ADC ESTKL-1,X + STA DSTL + LDA ESTKH-3,X + ADC ESTKH-1,X + STA DSTH + CLC + LDA ESTKL-3,X + ADC ESTKL-2,X + STA SRCL + LDA ESTKH-3,X + ADC ESTKH-2,X + STA SRCH + DEC DSTH + DEC SRCH + LDY #$FF + LDA ESTKL-3,X + BEQ REVCPYLP + INC ESTKH-3,X +REVCPYLP LDA (SRC),Y + STA (DST),Y + DEY + CPY #$FF + BNE + + DEC DSTH + DEC SRCH ++ DEC ESTKL-3,X + BNE REVCPYLP + DEC ESTKH-3,X + BNE REVCPYLP +CPYMEX RTS +end +asm crout()#0 + LDA #$8D + BNE ++ +end +// +// CHAR OUT +// COUT(CHAR) +// +asm cout(c)#0 + LDA ESTKL,X + BIT $BF98 + BMI + + JSR TOUPR ++ ORA #$80 + INX +++ BIT ROMEN + JSR $FDED + BIT LCRDEN+LCBNK2 + RTS +end +// +// CHAR IN +// RDKEY() +// +asm cin()#1 + BIT ROMEN + JSR $FD0C + BIT LCRDEN+LCBNK2 + DEX + LDY #$00 + AND #$7F + STA ESTKL,X + STY ESTKH,X + RTS +end +// +// PRINT STRING +// PRSTR(STR) +// +asm prstr(s)#0 + LDY #$00 + LDA ESTKL,X + STA SRCL + LDA ESTKH,X + STA SRCH + LDA (SRC),Y + BEQ ++ + STA TMP + BIT ROMEN +- INY + LDA (SRC),Y + BIT $BF98 + BMI + + JSR TOUPR ++ ORA #$80 + JSR $FDED + CPY TMP + BNE - + BIT LCRDEN+LCBNK2 +++ INX + RTS +end +// +// PRINT WORD +// +asm prword(w)#0 + LDA ESTKH,X + JSR + + DEX + ; FALL THROUGH TO PRBYTE +end +// +// PRINT BYTE +// +asm prbyte(b)#0 + LDA ESTKL,X ++ STX ESP + BIT ROMEN + JSR $FDDA + LDX ESP + BIT LCRDEN+LCBNK2 + INX + RTS +end +// +// READ STRING +// STR = RDSTR(PROMPTCHAR) +// +asm rdstr(p)#1 + LDA ESTKL,X + STA $33 + STX ESP + BIT ROMEN + JSR $FD6A + STX $01FF +- LDA $01FF,X + AND #$7F + STA $01FF,X + DEX + BPL - + TXA + LDX ESP + STA ESTKL,X + LDA #$01 + STA ESTKH,X + BIT LCRDEN+LCBNK2 + RTS +end +asm uword_isge(a,b)#1 + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + LDA #$FF + ADC #$00 + EOR #$FF + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS +end +asm uword_isle(a,b)#1 + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + LDA #$FF + ADC #$00 + EOR #$FF + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS +end +asm uword_isgt(a,b)#1 + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + LDA #$FF + ADC #$00 + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS +end +asm uword_islt(a,b)#1 + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + LDA #$FF + ADC #$00 + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS +end +asm divmod(a,b)#2 + JSR INTERP ; CALL INTERP + !BYTE $36, $5C ; DIVMOD, RET +end +asm sext(a)#1 + LDY #$00 + LDA ESTKL,X + BPL + + DEY ++ STY ESTKH,X + RTS +end +// +// Utility routines. +// +// A DCI string is one that has the high bit set for every character except the last. +// More efficient than C or Pascal strings. +// +//def dcitos(dci, str) +// byte len, c +// len = 0 +// repeat +// c = (dci).[len] +// len = len + 1 +// (str).[len] = c & $7F +// until !(c & $80) +// ^str = len +// return len +//end +asm dcitos(dci, str)#1 + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + LDY #$00 +- LDA (SRC),Y + CMP #$80 + AND #$7F + INY + STA (DST),Y + BCS - + TYA + LDY #$00 + STA (DST),Y + INX + STA ESTKL,X + STY ESTKH,X + RTS +end +//def stodci(str, dci) +// byte len, c +// len = ^str +// if len == 0 +// return +// fin +// c = toupper((str).[len]) & $7F +// len = len - 1 +// (dci).[len] = c +// while len +// c = toupper((str).[len]) | $80 +// len = len - 1 +// (dci).[len] = c +// loop +// return ^str +//end +asm stodci(str,dci)#1 + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + INX + LDY #$00 + LDA (SRC),Y + BEQ ++ + TAY + LDA (SRC),Y + JSR TOUPR + BNE + +- LDA (SRC),Y + JSR TOUPR + ORA #$80 ++ DEY + STA (DST),Y + BNE - + LDA (SRC),Y +++ STA ESTKL,X + STY ESTKH,X + RTS +end +asm toupper(c)#1 + LDA ESTKL,X +TOUPR AND #$7F + CMP #'a' + BCC + + CMP #'z'+1 + BCS + + SBC #$1F ++ STA ESTKL,X + RTS +end +// +// Lookup routines. +// +//def lookuptbl(dci, tbl) +// word match +// while ^tbl +// match = dci +// while ^tbl == ^match +// if !(^tbl & $80) +// return (tbl):1 +// fin +// tbl = tbl + 1 +// match = match + 1 +// loop +// while (^tbl & $80) +// tbl = tbl + 1 +// loop +// tbl = tbl + 3 +// loop +// return 0 +asm lookuptbl(dci, tbl)#1 + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + INX + LDA ESTKL,X + STA SRCL + LDA ESTKH,X + STA SRCH +-- LDY #$00 +- LDA (DST),Y + BEQ + + CMP (SRC),Y + BNE ++ + INY + ASL + BCS - + LDA (DST),Y + STA ESTKL,X ; MATCH + INY + LDA (DST),Y + STA ESTKH,X + RTS ++ STA ESTKL,X ; NO MATCH + STA ESTKH,X + RTS +++ +- LDA (DST),Y ; NEXT ENTRY + BPL + + INY + BNE - ++ TYA + CLC + ADC #$03 + ADC DSTL + STA DSTL + BCC -- + INC DSTH + BNE -- +end +// def lookupidx(esd, index) +// word sym +// while ^esd +// sym = esd +// esd = sym + dcitos(sym, @str) +// if esd->0 & $10 and esd->1 == index +// return sym +// fin +// esd = esd + 3 +// loop +//end +asm lookupidx(esd, index)#1 + LDA ESTKL,X + STA TMPL + INX +--- LDA ESTKH,X + STA SRCH + LDA ESTKL,X +-- STA SRCL + LDY #$00 +- LDA (SRC),Y + BPL + + INY + BNE - ++ BEQ ++ ; END OF ESD + INY + LDA (SRC),Y + INY + AND #$10 ; EXTERN FLAG? + BEQ + + LDA (SRC),Y + CMP TMPL + BEQ +++ ; MATCH ++ INY + TYA + SEC + ADC SRCL + STA ESTKL,X ; SYM PTRL + BCC -- + INC ESTKH,X ; SYM PTRH + BNE --- +++ STA ESTKL,X ; END OF ESD + STA ESTKH,X ++++ RTS +end +//def lookupdef(addr, deftbl)#1 +// while deftbl->interpjsr == $20 +// if deftbl=>bytecodeaddr == addr +// return deftbl +// fin +// deftbl = deftbl + t_defentry +// loop +// return 0 +//end +asm lookupdef(addr, deftbl)#1 + LDA ESTKH,X + STA SRCH + LDA ESTKL,X + STA SRCL + INX +- LDY #$00 + LDA (SRC),Y + CMP #$20 ; JSR OPCODE? + BNE ++ + LDY #$03 + LDA (SRC),Y + CMP ESTKL,X + BNE + + INY + LDA (SRC),Y + CMP ESTKH,X + BNE + + LDA SRCL ; MATCH + STA ESTKL,X + LDA SRCH + STA ESTKH,X + RTS ++ LDA #$07 ; NEXT ENTRY + CLC + ADC SRCL + STA SRCL + BCC - + INC SRCH + BNE - +++ STY ESTKL,X + STY ESTKH,X + RTS +end +// +// Reloc internal data +// +//def reloc(modfix, modofst, bytecode, rld)#3 +// word addr, fixup +// while ^rld +// if ^rld & $10 // EXTERN reference. +// return rld, addr, fixup +// fin +// addr = rld=>1 + modfix +// fixup = *addr + modofst +// if uword_isge(fixup, bytecode) // Bytecode address. +// return rld, addr, fixup +// fin +// *addr = fixup +// rld = rld + 4 +// loop +// return rld, addr, fixup +//end +asm reloc(modfix, modofst, bytecode, rld)#3 + LDA ESTKL,X + STA SRCL + LDA ESTKH,X + STA SRCH + LDY #$00 +- LDA (SRC),Y + BEQ RLDEX ; END OF RLD + PHA + INY + LDA (SRC),Y + INY + CLC + ADC ESTKL+3,X ; ADDR=ENTRY=>1+MODFIX + STA DSTL + LDA (SRC),Y + ADC ESTKH+3,X + STA DSTH + PLA + AND #$10 ; EXTERN REF - EXIT + BNE RLDEX + TAY ; FIXUP=*ADDR+MODOFST + LDA (DST),Y + INY + CLC + ADC ESTKL+2,X + STA TMPL + LDA (DST),Y + ADC ESTKH+2,X + CMP ESTKH+1,X ; FIXUP >= BYTECODE? + BCC + + STA TMPH + BNE RLDEX ; YEP, EXIT + LDA TMPL + CMP ESTKL+1,X + BCS RLDEX ; YEP, EXIT + LDA TMPH ++ STA (DST),Y ; *ADDR=FIXUP + DEY + LDA TMPL + STA (DST),Y + LDA SRCL ; NEXT ENTRY +; CLC + ADC #$04 + STA SRCL + BCC - + INC SRCH + BNE - +RLDEX INX + LDA TMPL + STA ESTKL,X + LDA TMPH + STA ESTKH,X + LDA DSTL + STA ESTKL+1,X + LDA DSTH + STA ESTKH+1,X + LDA SRCL + STA ESTKL+2,X + LDA SRCH + STA ESTKH+2,X + RTS +end +// +// Cheap and dirty print integer +// +def print(i)#0 + if i < 0; cout('-'); i = -i; fin + if i >= 10; print(i / 10); fin + cout(i % 10 + '0') +end +// +// ProDOS routines +// +def pfxop(path, op)#1 + byte params[3] + + params.0 = 1 + params:1 = path + perr = syscall(op, @params) + return path +end +def open(path)#1 + byte params[6] + + params.0 = 3 + params:1 = path + params:3 = iobuffer + params.5 = 0 + perr = syscall($C8, @params) + return params.5 +end +def close(refnum)#1 + byte params[2] + + params.0 = 1 + params.1 = refnum + perr = syscall($CC, @params) + return perr +end +def read(refnum, buf, len)#1 + byte params[8] + + params.0 = 4 + params.1 = refnum + params:2 = buf + params:4 = len + params:6 = 0 + perr = syscall($CA, @params) + return params:6 +end +// +// Heap routines. +// +def availheap()#1 + byte fp + return @fp - heap +end +def allocheap(size)#1 + word oldheap, addr + oldheap = heap + addr = heap + heap = heap + size + if systemflags & reshgr1 + if uword_islt(addr, $4000) and uword_isgt(heap, $2000) + addr = $4000 + heap = addr + size + fin + fin + if systemflags & reshgr2 + if uword_islt(addr, $6000) and uword_isgt(heap, $4000) + addr = $6000 + heap = addr + size + fin + fin + if uword_isge(heap, @addr) + heap = oldheap + return 0 + fin + return addr +end +def allocalignheap(size, pow2, freeaddr) + word align, addr + if freeaddr + *freeaddr = heap + fin + align = (1 << pow2) - 1 + addr = (heap | align) + 1 + heap = addr + size + if uword_isge(heap, @addr) + return 0 + fin + return addr +end +def markheap()#1 + return heap +end +def releaseheap(newheap)#1 + heap = newheap + return @newheap - heap +end +def allocxheap(size)#1 + word xaddr + xaddr = xheap + xheap = xheap + size + if systemflags & restxt1 + if uword_isle(xaddr, $0800) and uword_isgt(xheap, $0400) + xaddr = $0800 + xheap = xaddr + size + fin + fin + if systemflags & restxt2 + if uword_isle(xaddr, $0C00) and uword_isgt(xheap, $0800) + xaddr = $0C00 + xheap = xaddr + size + fin + fin + if systemflags & resxhgr1 + if uword_isle(xaddr, $4000) and uword_isgt(xheap, $2000) + xaddr = $4000 + xheap = xaddr + size + fin + fin + if systemflags & resxhgr2 + if uword_isle(xaddr, $6000) and uword_isgt(xheap, $4000) + xaddr = $6000 + xheap = xaddr + size + fin + fin + if uword_isge(xheap, xheaptop) + return 0 + fin + return xaddr +end +// +// Symbol table routines. +// +def addsym(sym, addr)#0 + while ^sym & $80 + ^lastsym = ^sym + lastsym++ + sym++ + loop + lastsym->0 = ^sym + lastsym=>1 = addr + lastsym = lastsym + 3 + ^lastsym = 0 +end +// +// String routines. +// +def strcpy(dst, src)#1 + memcpy(dst+1, src+1, ^src) + ^dst = ^src + return dst +end +def strcat(dst, src)#1 + memcpy(dst + ^dst + 1, src + 1, ^src) + ^dst = ^dst + ^src + return dst +end +// +// Module routines. +// +def lookupextern(esd, index)#1 + word sym, addr + byte str[16] + sym = lookupidx(esd, index) + if sym + addr = lookuptbl(sym, symtbl) + if !addr + perr = $81 + dcitos(sym, @str) + cout('?'); prstr(@str); crout + fin + return addr + fin + return 0 +end +// +// Indirect interpreter DEFinition entrypoint +// +def adddef(isfirst, addr, deflast)#1 + word preventry, defentry, defsize + + defentry = *deflast + *deflast = defentry + t_defentry + if not isfirst + preventry = defentry - t_defentry + defsize = addr - preventry=>bytecodeaddr + if defsize <= jitsize // and *jitcomp + preventry=>interpaddr = $03D6 // JSR $03D6 (JIT INTERP) + preventry->callcount = jitcount // Set JIT countdown + preventry->bytecodesize = defsize // Set size + fin + fin + defentry->interpjsr = $20 + defentry=>interpaddr = $03DC // JSR $03DC (BYTECODE INTERP) + defentry=>bytecodeaddr = addr + //defentry=>5 = 0 // Clear count and size + defentry->t_defentry = 0 // NULL out next entry + return defentry +end +def loadmod(mod)#1 + word rdlen, modsize, bytecode, codefix, defofst, defcnt, init, fixup + word addr, defaddr, modaddr, modfix, modofst, modend + word deftbl, deflast + word moddep, rld, esd, sym + byte refnum[], deffirst, skipjit, filename[64], str[] + byte header[128] + // + // Read the RELocatable module header (first 128 bytes) + // + dcitos(mod, @filename) + refnum = open(@filename) + if !refnum + // + // Try system path + // + refnum = open(strcpy(@filename,strcat(strcpy(@header, @sysmods), @filename))) + fin + if refnum + header.0 = $0A + header:1 = @filename + if not syscall($C4, @header) and header.4 <> $FE // Make sure it's a REL module + close(refnum) + perr = $4A // Incompatible type + return -perr + fin + rdlen = read(refnum, @header, 128) + modsize = header:0 + moddep = @header.1 + defofst = modsize + RELADDR + init = 0 + if rdlen > 4 and header:2 == $6502 // magic number + // + // This is an EXTended RELocatable (data+bytecode) module. + // + systemflags = header.4 | systemflags + skipjit = header.5 & (nojitc >> 8) + defofst = header:6 + defcnt = header:8 + init = header:10 + moddep = @header.12 + // + // Load module dependencies. + // + while ^moddep + if !lookuptbl(moddep, symtbl) + close(refnum) + refnum = 0 + if loadmod(moddep) < 0 + return -perr + fin + fin + moddep = moddep + dcitos(moddep, @str) + loop + // + // Init def table. + // + deftbl = allocheap(defcnt * t_defentry + 1) + deflast = deftbl + if !refnum + // + // Reset read pointer. + // + refnum = open(@filename) + rdlen = read(refnum, @header, 128) + fin + fin + // + // Alloc heap space for relocated module (data + bytecode). + // + moddep = moddep + 1 + modfix = moddep - @header.2 // Adjust to skip header + modsize = modsize - modfix + rdlen = rdlen - modfix - 2 + modaddr = allocheap(modsize) + memcpy(modaddr, moddep, rdlen) + // + // Read in remainder of module into memory for fixups. + // + addr = modaddr + repeat + addr = addr + rdlen + rdlen = read(refnum, addr, 4096) + until rdlen <= 0 + close(refnum) + // + // Add module to symbol table. + // + addsym(mod, modaddr) + // + // Apply all fixups and symbol import/export. + // + modfix = modaddr - modfix + modofst = modfix - RELADDR + modend = modaddr + modsize + bytecode = defofst + modofst + rld = modend // Re-Locatable Directory + esd = rld // Extern+Entry Symbol Directory + while ^esd // Scan to end of ESD + esd = esd + 4 + loop + esd = esd + 1 + defaddr = allocxheap(rld - bytecode) + modend = bytecode + codefix = defaddr - bytecode + defofst = defaddr - defofst + // + // Run through the DeFinition Dictionary. + // + deffirst = 1 + while ^rld == $02 + // + // This is a bytcode def entry - add it to the def directory. + // + adddef(deffirst, rld=>1 + defofst, @deflast) + deffirst = skipjit // Calculate JIT potential or not + rld = rld + 4 + loop + // + // Run through the Re-Location Dictionary. + // + while ^rld + rld, addr, fixup = reloc(modfix, modofst, bytecode, rld) + if ^rld + *addr = ^rld & $10 ?? *addr + lookupextern(esd, rld->3) :: lookupdef(fixup + codefix, deftbl) + rld = rld + 4 + fin + loop + // + // Run through the External/Entry Symbol Directory. + // + while ^esd + sym = esd + esd = esd + dcitos(esd, @str) + if ^esd & $08 + // + // EXPORT symbol - add it to the global symbol table. + // + addr = esd=>1 + modofst + if uword_isge(addr, bytecode) + // + // Use the def directory address for bytecode. + // + addr = lookupdef(addr + codefix, deftbl) + fin + addsym(sym, addr) + fin + esd = esd + 3 + loop + // + // Move bytecode to AUX bank. + // + *$003C = bytecode + *$003E = modaddr + modsize + *$0042 = defaddr + call($C311, 0, 0, 0, $05) // CALL XMOVE with carry set (MAIN->AUX) and ints disabled + else + perr = $46 + fin + if perr + return -perr + fin + // + // Free up rld+esd (and bytecode on 128K) in main memory. + // + releaseheap(modend) + // + // Call init routine if it exists. + // + fixup = 0 // This is repurposed for the return code + if init + init = init + defofst + fixup = adddef(deffirst, init, @deflast)() + if fixup < modinitkeep + // + // Free init routine unless initkeep + // + xheap = init + if fixup < 0 + perr = -fixup + fin + else + fixup = fixup & ~modinitkeep + fin + fin + return fixup +end +// +// Command mode +// +def volumes()#0 + byte params[4] + word strbuf + byte i + + params.0 = 2 + params.1 = 0 + params:2 = databuff + perr = syscall($C5, @params) + strbuf = databuff + for i = 0 to 15 + ^strbuf = ^strbuf & $0F + if ^strbuf + cout('/'); prstr(strbuf); crout() + fin + strbuf = strbuf + 16 + next +end +def catalog(path)#0 + byte refnum + byte firstblk + byte entrylen, entriesblk + byte i, type, len + word entry, filecnt + + if !^path + path = @prefix + fin + refnum = open(path) + if perr + return + fin + firstblk = 1 + repeat + if read(refnum, databuff, 512) == 512 + entry = databuff + 4 + if firstblk + entrylen = databuff.$23 + entriesblk = databuff.$24 + filecnt = databuff:$25 + entry = entry + entrylen + fin + for i = firstblk to entriesblk + type = ^entry + if type + len = type & $0F + ^entry = len + prstr(entry) + type = ' ' + when entry->$10 + is $0F // Is it a directory? + type = '/' + break + is $FF // SYSTEM file + type = '-' + break + is $FE // REL file + type = '+' + wend + cout(type) + for len = 18 - len downto 0 + cout(' ') + next + filecnt-- + fin + entry = entry + entrylen + next + firstblk = 0 + else + filecnt = 0 + fin + until !filecnt + close(refnum) + crout() +end +def stripchars(strptr)#1 + while ^strptr and ^(strptr + 1) > ' ' + memcpy(strptr + 1, strptr + 2, ^strptr) + ^strptr-- + loop + return ^strptr +end +def stripspaces(strptr)#0 + while ^strptr and ^(strptr + ^strptr) <= ' ' + ^strptr-- + loop + while ^strptr and ^(strptr + 1) <= ' ' + memcpy(strptr + 1, strptr + 2, ^strptr) + ^strptr-- + loop +end +def striptrail(strptr)#1 + byte i + + for i = 1 to ^strptr + if ^(strptr + i) <= ' ' + ^strptr = i - 1 + break + fin + next + return strptr +end +def parsecmd(strptr)#1 + byte cmd + + cmd = 0 + stripspaces(strptr) + if ^strptr + cmd = ^(strptr + 1) + memcpy(strptr + 1, strptr + 2, ^strptr) + ^strptr-- + fin + stripspaces(strptr) + return cmd +end +def resetmemfiles()#0 + // + // Close all files + // + ^$BFD8 = 0 + close(0) + // + // Set memory bitmap + // + memset($BF58, 0, 24) + ^$BF58 = $CF + ^$BF6F = $01 +end +def execsys(sysfile)#0 + byte refnum + word len + + if ^sysfile + strcpy($280, sysfile) + striptrail(sysfile) + refnum = open(sysfile) + if refnum + len = read(refnum, databuff, $FFFF) + resetmemfiles() + if len + strcpy(sysfile, $280) + if stripchars(sysfile) and ^$2000 == $4C and *$2003 == $EEEE + stripspaces(sysfile) + if ^$2005 >= ^sysfile + 1 + strcpy($2006, sysfile) + fin + fin + striptrail($280) + exec() + fin + fin + fin +end +def execmod(modfile)#1 + byte moddci[17] + word saveheap, savexheap, savesym, saveflags, savejit + + perr = 1 + if stodci(modfile, @moddci) + saveheap = heap + savexheap = xheap + savesym = lastsym + saveflags = systemflags + savejit = *jitcodeptr + if loadmod(@moddci) < modkeep + lastsym = savesym + xheap = savexheap + heap = saveheap + *jitcodeptr = savejit + fin + ^lastsym = 0 + systemflags = saveflags + fin + return -perr +end +// +// Get heap start. +// +heap = *freemem +// +// Print PLASMA version +// +prstr("PLASMA JITC 2.0 Dev\n")//; prbyte(version.1); cout('.'); prbyte(version.0); crout +// +// Init symbol table. +// +while *sysmodsym + stodci(sysmodsym=>0, heap) + addsym(heap, sysmodsym=>2) + sysmodsym = sysmodsym + 4 +loop +// +// Set system path +// +strcat(strcpy(@sysmods, $280), "SYS/")) // This is the path to CMD +syspath = @sysmods // Update external interface table +syscmdln = @cmdln +loadmod(jitmod) +xheap = $0800 // Reset heap to point at low memory +xheaptop = $A000 // Top where JIT loaded +// +// Try to load autorun. +// +autorun = open(@autorun) +if autorun > 0 + cmdln = read(autorun, @autorun, 128) + close(0) +else + // + // Print some startup info. + // + prstr("MEM FREE:$"); prword(availheap); crout +fin +perr = 0 +while 1 + if ^getlnbuf + when toupper(parsecmd(getlnbuf)) + is 'Q' + reboot() + break + is 'C' + catalog(getlnbuf) + break + is 'P' + pfxop(getlnbuf, SET_PFX) + break + is '/' + repeat + prefix-- + until prefix[prefix] == '/' + if prefix > 1 + pfxop(@prefix, SET_PFX) + fin + break + is 'V' + volumes() + break + is '-' + execsys(getlnbuf) + break + is '+' + //saveX + execmod(striptrail(getlnbuf)) + // + // Clean up + // + //restoreX + resetmemfiles + break + otherwise + cout('?') + wend + if perr + prstr("ERR:$") + prbyte(perr) + perr = 0 + else + prstr("OK") + fin + crout() + fin + prstr(pfxop(@prefix, GET_PFX)) + strcpy(@cmdln, rdstr($BA)) +loop +done diff --git a/src/vmsrc/apple/cmdjitstub.s b/src/vmsrc/apple/cmdjitstub.s new file mode 100644 index 0000000..8e926dd --- /dev/null +++ b/src/vmsrc/apple/cmdjitstub.s @@ -0,0 +1,55 @@ +INTERP = $03D0 +LCRDEN = $C080 +LCWTEN = $C081 +ROMEN = $C082 +LCRWEN = $C083 +LCBNK2 = $00 +LCBNK1 = $08 +JITCOMP = $03E2 +JITCODE = $03E4 +!SOURCE "vmsrc/plvmzp.inc" +;* +;* MOVE CMD DOWN TO $1000-$2000 +;* + LDA #<_CMDBEGIN + STA SRCL + LDA #>_CMDBEGIN + STA SRCH + LDY #$00 + STY DSTL + LDX #$10 + STX DSTH +- LDA (SRC),Y + STA (DST),Y + INY + BNE - + INC SRCH + INC DSTH + DEX ; STOP WHEN DST=$2000 REACHED + BNE - + LDA #<_CMDEND + STA SRCL + LDA #>_CMDEND + STA SRCH +; +; INIT VM ENVIRONMENT STACK POINTERS +; + STY JITCOMP + STY JITCOMP+1 + STY PPL + STY IFPL ; INIT FRAME POINTER + STY JITCODE + LDA #$AF + STA PPH + STA IFPH + STA JITCODE+1 + LDX #$FE ; INIT STACK POINTER (YES, $FE. SEE GETS) + TXS + LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX + + JMP $1000 +_CMDBEGIN = * +!PSEUDOPC $1000 { +!SOURCE "vmsrc/apple/cmdjit.a" +_CMDEND = * +} diff --git a/src/vmsrc/apple/plvm01.s b/src/vmsrc/apple/plvm01.s index e6870b3..e9e14d3 100644 --- a/src/vmsrc/apple/plvm01.s +++ b/src/vmsrc/apple/plvm01.s @@ -109,14 +109,18 @@ COMP LDA #$FF ;* OPCODE TABLE ;* !ALIGN 255,0 -OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E - !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E - !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E - !WORD DROP,DUP,NEXTOP,DIVMOD,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E - !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E - !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E - !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E - !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E +OPTBL !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06 08 0A 0C 0E + !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E + !WORD MINUS1,BREQ,BRNE,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E + !WORD DROP,DROP2,DUP,DIVMOD,ADDI,SUBI,ANDI,ORI ; 30 32 34 36 38 3A 3C 3E + !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E + !WORD BRNCH,SEL,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E + !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E + !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E + !WORD LNOT,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 80 82 84 86 88 8A 8C 8E + !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E + !WORD BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE + !WORD ADDLB,ADDLW,ADDAB,ADDAW,IDXLB,IDXLW,IDXAB,IDXAW ; B0 B2 B4 B6 B8 BA BC BE ;* ;* DIV TOS-1 BY TOS ;* @@ -324,31 +328,6 @@ SHR STY IPY + LDY IPY JMP DROP ;* -;* LOGICAL AND -;* -LAND LDA ESTKL+1,X - ORA ESTKH+1,X - BEQ ++ - LDA ESTKL,X - ORA ESTKH,X - BEQ + - LDA #$FF -+ STA ESTKL+1,X - STA ESTKH+1,X -++ JMP DROP -;* -;* LOGICAL OR -;* -LOR LDA ESTKL,X - ORA ESTKH,X - ORA ESTKL+1,X - ORA ESTKH+1,X - BEQ + - LDA #$FF - STA ESTKL+1,X - STA ESTKH+1,X -+ JMP DROP -;* ;* DUPLICATE TOS ;* DUP DEX @@ -358,23 +337,69 @@ DUP DEX STA ESTKH,X JMP NEXTOP ;* +;* ADD IMMEDIATE TO TOS +;* +ADDI INY ;+INC_IP + LDA (IP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ JMP NEXTOP +;* +;* SUB IMMEDIATE FROM TOS +;* +SUBI INY ;+INC_IP + LDA ESTKL,X + SEC + SBC (IP),Y + STA ESTKL,X + BCS + + DEC ESTKH,X ++ JMP NEXTOP +;* +;* AND IMMEDIATE TO TOS +;* +ANDI INY ;+INC_IP + LDA (IP),Y + AND ESTKL,X + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +;* +;* IOR IMMEDIATE TO TOS +;* +ORI INY ;+INC_IP + LDA (IP),Y + ORA ESTKL,X + STA ESTKL,X + JMP NEXTOP +;* ;* LOGICAL NOT ;* LNOT LDA ESTKL,X ORA ESTKH,X - BNE + - LDA #$FF + BEQ + + LDA #$00 STA ESTKL,X STA ESTKH,X JMP NEXTOP ;* -;* CONSTANT +;* CONSTANT -1, NYBBLE, BYTE, $FF BYTE, WORD (BELOW) ;* -ZERO DEX -+ LDA #$00 +MINUS1 DEX ++ LDA #$FF STA ESTKL,X STA ESTKH,X JMP NEXTOP +CN DEX + LSR ; A = CONST * 2 + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP CFFB LDA #$FF !BYTE $2C ; BIT $00A9 - effectively skips LDA #$00, no harm in reading this address CB LDA #$00 @@ -476,7 +501,7 @@ LLA INY ;+INC_IP ;* ;* LOAD VALUE FROM LOCAL FRAME OFFSET ;* -LLB INY ;+INC_IP +_LLB INY ;+INC_IP LDA (IP),Y STY IPY TAY @@ -486,8 +511,8 @@ LLB INY ;+INC_IP LDA #$00 STA ESTKH,X LDY IPY - JMP NEXTOP -LLW INY ;+INC_IP + RTS +_LLW INY ;+INC_IP LDA (IP),Y STY IPY TAY @@ -498,11 +523,29 @@ LLW INY ;+INC_IP LDA (IFP),Y STA ESTKH,X LDY IPY + RTS +LLB JSR _LLB JMP NEXTOP +LLW JSR _LLW + JMP NEXTOP +;* +;* ADD VALUE FROM LOCAL FRAME OFFSET +;* +ADDLB JSR _LLB + JMP ADD +ADDLW JSR _LLW + JMP ADD +;* +;* INDEX VALUE FROM LOCAL FRAME OFFSET +;* +IDXLB JSR _LLB + JMP IDXW +IDXLW JSR _LLW + JMP IDXW ;* ;* LOAD VALUE FROM ABSOLUTE ADDRESS ;* -LAB INY ;+INC_IP +_LAB INY ;+INC_IP LDA (IP),Y STA ESTKH-2,X INY ;+INC_IP @@ -513,8 +556,8 @@ LAB INY ;+INC_IP STA ESTKL,X LDA #$00 STA ESTKH,X - JMP NEXTOP -LAW INY ;+INC_IP + RTS +_LAW INY ;+INC_IP LDA (IP),Y STA TMPL INY ;+INC_IP @@ -529,7 +572,25 @@ LAW INY ;+INC_IP LDA (TMP),Y STA ESTKH,X LDY IPY + RTS +LAB JSR _LAB JMP NEXTOP +LAW JSR _LAW + JMP NEXTOP +;* +;* ADD VALUE FROM ABSOLUTE ADDRESS +;* +ADDAB JSR _LAB + JMP ADD +ADDAW JSR _LAW + JMP ADD +;* +;* INDEX VALUE FROM ABSOLUTE ADDRESS +;* +IDXAB JSR _LAB + JMP IDXW +IDXAW JSR _LAW + JMP IDXW ;* ;* STORE VALUE TO ADDRESS ;* @@ -551,7 +612,10 @@ SW LDA ESTKL,X JMP DROP + INC ESTKH,X STA (ESTKH-1,X) - INX +;* +;* DROP2 +;* +DROP2 INX JMP DROP ;* ;* STORE VALUE TO LOCAL FRAME OFFSET @@ -594,6 +658,8 @@ DLB INY ;+INC_IP TAY LDA ESTKL,X STA (IFP),Y + LDA #$00 + STA ESTKH,X LDY IPY JMP NEXTOP DLW INY ;+INC_IP @@ -654,6 +720,8 @@ DAB INY ;+INC_IP STA ESTKH-1,X LDA ESTKL,X STA (ESTKH-2,X) + LDA #$00 + STA ESTKH,X JMP NEXTOP DAW INY ;+INC_IP LDA (IP),Y @@ -683,7 +751,6 @@ ISTRU LDA #$FF STA ESTKL+1,X STA ESTKH+1,X JMP DROP -; ISNE LDA ESTKL,X CMP ESTKL+1,X BNE ISTRU @@ -694,7 +761,6 @@ ISFLS LDA #$00 STA ESTKL+1,X STA ESTKH+1,X JMP DROP -; ISGE LDA ESTKL+1,X CMP ESTKL,X LDA ESTKH+1,X @@ -702,9 +768,16 @@ ISGE LDA ESTKL+1,X BVS + BPL ISTRU BMI ISFLS -+ BPL ISFLS ++ + - BPL ISFLS BMI ISTRU -; +ISLE LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVS - + BPL ISTRU + BMI ISFLS ISGT LDA ESTKL,X CMP ESTKL+1,X LDA ESTKH,X @@ -712,31 +785,114 @@ ISGT LDA ESTKL,X BVS + BMI ISTRU BPL ISFLS -+ BMI ISFLS ++ +- BMI ISFLS BPL ISTRU -; -ISLE LDA ESTKL,X - CMP ESTKL+1,X - LDA ESTKH,X - SBC ESTKH+1,X - BVS + - BPL ISTRU - BMI ISFLS -+ BPL ISFLS - BMI ISTRU -; ISLT LDA ESTKL+1,X CMP ESTKL,X LDA ESTKH+1,X SBC ESTKH,X - BVS + + BVS - BMI ISTRU BPL ISFLS -+ BMI ISFLS - BPL ISTRU ;* ;* BRANCHES ;* +SEL INX + TYA ; FLATTEN IP + SEC + ADC IPL + STA TMPL + LDA #$00 + TAY + ADC IPH + STA TMPH ; ADD BRANCH OFFSET + LDA (TMP),Y + ;CLC ; BETTER NOT CARRY OUT OF IP+Y + ADC TMPL + STA IPL + INY + LDA (TMP),Y + ADC TMPH + STA IPH + DEY + LDA (IP),Y + STA TMPL ; CASE COUNT + INC IPL + BNE CASELP + INC IPH +CASELP LDA ESTKL-1,X + CMP (IP),Y + BEQ + + LDA ESTKH-1,X + INY + SBC (IP),Y + BMI CASEEND +- INY + INY + DEC TMPL + BEQ FIXNEXT + INY + BNE CASELP + INC IPH + BNE CASELP ++ LDA ESTKH-1,X + INY + SBC (IP),Y + BEQ BRNCH + BPL - +CASEEND LDA #$00 + STA TMPH + DEC TMPL + LDA TMPL + ASL ; SKIP REMAINING CASES + ROL TMPH + ASL + ROL TMPH +; CLC + ADC IPL + STA IPL + LDA TMPH + ADC IPH + STA IPH + INY + INY +FIXNEXT TYA + LDY #$00 + SEC + ADC IPL + STA IPL + BCC + + INC IPH ++ JMP FETCHOP +BRAND LDA ESTKL,X + ORA ESTKH,X + BEQ BRNCH + INX ; DROP LEFT HALF OF AND + BNE NOBRNCH +BROR LDA ESTKL,X + ORA ESTKH,X + BNE BRNCH + INX ; DROP LEFT HALF OF OR + BNE NOBRNCH +BREQ INX + INX + LDA ESTKL-2,X + CMP ESTKL-1,X + BNE NOBRNCH + LDA ESTKH-2,X + CMP ESTKH-1,X + BEQ BRNCH + BNE NOBRNCH +BRNE INX + INX + LDA ESTKL-2,X + CMP ESTKL-1,X + BNE BRNCH + LDA ESTKH-2,X + CMP ESTKH-1,X + BNE BRNCH + BEQ NOBRNCH BRTRU INX LDA ESTKH-1,X ORA ESTKL-1,X @@ -745,14 +901,6 @@ NOBRNCH INY ;+INC_IP INY ;+INC_IP BMI FIXNEXT JMP NEXTOP -FIXNEXT TYA - LDY #$00 - CLC - ADC IPL - STA IPL - BCC + - INC IPH -+ JMP NEXTOP BRFLS INX LDA ESTKH-1,X ORA ESTKL-1,X @@ -775,58 +923,75 @@ BRNCH TYA ; FLATTEN IP STA IPH DEY JMP FETCHOP -BREQ INX - LDA ESTKL-1,X +;* +;* FOR LOOPS PUT TERMINAL VALUE AT ESTK+1 AND CURRENT COUNT ON ESTK +;* +BRGT LDA ESTKL+1,X CMP ESTKL,X - BNE NOBRNCH - LDA ESTKH-1,X - CMP ESTKH,X - BEQ BRNCH - BNE NOBRNCH -BRNE INX - LDA ESTKL-1,X - CMP ESTKL,X - BNE BRNCH - LDA ESTKH-1,X - CMP ESTKH,X - BEQ NOBRNCH - BNE BRNCH -BRGT INX - LDA ESTKL-1,X - CMP ESTKL,X - LDA ESTKH-1,X + LDA ESTKH+1,X SBC ESTKH,X BVS + BPL NOBRNCH - BMI BRNCH -+ BPL BRNCH - BMI NOBRNCH -BRLT INX - LDA ESTKL,X - CMP ESTKL-1,X +- INX ; DROP FOR VALUES + INX + BNE BRNCH ; BMI BRNCH +BRLT LDA ESTKL,X + CMP ESTKL+1,X LDA ESTKH,X - SBC ESTKH-1,X + SBC ESTKH+1,X BVS + BPL NOBRNCH - BMI BRNCH -+ BPL BRNCH - BMI NOBRNCH -IBRNCH TYA ; FLATTEN IP + INX ; DROP FOR VALUES + INX + BNE BRNCH ; BMI BRNCH ++ BMI NOBRNCH + BPL - +DECBRGE DEC ESTKL,X + LDA ESTKL,X + CMP #$FF + BNE + + DEC ESTKH,X +_BRGE LDA ESTKL,X ++ CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVS + + BPL BRNCH +- INX ; DROP FOR VALUES + INX + BNE NOBRNCH ; BMI NOBRNCH +INCBRLE INC ESTKL,X + BNE _BRLE + INC ESTKH,X +_BRLE LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + BVS + + BPL BRNCH + INX ; DROP FOR VALUES + INX + BNE NOBRNCH ; BMI NOBRNCH ++ BMI BRNCH + BPL - +SUBBRGE LDA ESTKL+1,X + SEC + SBC ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + SBC ESTKH,X + STA ESTKH+1,X + INX + BNE _BRGE +ADDBRLE LDA ESTKL,X CLC - ADC IPL - STA TMPL - LDA #$00 - TAY - ADC IPH - STA TMPH ; ADD BRANCH OFFSET - LDA TMPL - ;CLC ; BETTER NOT CARRY OUT OF IP+Y - ADC ESTKL,X - STA IPL - LDA TMPH - ADC ESTKH,X - STA IPH - JMP DROP + ADC ESTKL+1,X + STA ESTKL+1,X + LDA ESTKH,X + ADC ESTKH+1,X + STA ESTKH+1,X + INX + BNE _BRLE ;* ;* INDIRECT CALL TO ADDRESS (NATIVE CODE) ;* @@ -846,7 +1011,7 @@ CALL INY ;+INC_IP LDA (IP),Y STA TMPH _CALL TYA - CLC + SEC ADC IPL PHA LDA IPH @@ -857,7 +1022,7 @@ _CALL TYA STA IPH PLA STA IPL - LDY #$01 + LDY #$00 JMP FETCHOP ;* ;* JUMP INDIRECT TRHOUGH TMP diff --git a/src/vmsrc/apple/plvm02.s b/src/vmsrc/apple/plvm02.s index 9e58eac..abb60cb 100755 --- a/src/vmsrc/apple/plvm02.s +++ b/src/vmsrc/apple/plvm02.s @@ -193,28 +193,22 @@ VMCORE = * ;* * ;**************** !ALIGN 255,0 -OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E - !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E - !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E - !WORD DROP,DUP,NEXTOP,DIVMOD,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E - !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E - !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E - !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E - !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E +OPTBL !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06 08 0A 0C 0E + !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E + !WORD MINUS1,BREQ,BRNE,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E + !WORD DROP,DROP2,DUP,DIVMOD,ADDI,SUBI,ANDI,ORI ; 30 32 34 36 38 3A 3C 3E + !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E + !WORD BRNCH,SEL,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E + !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E + !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E + !WORD LNOT,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 80 82 84 86 88 8A 8C 8E + !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E + !WORD BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE + !WORD ADDLB,ADDLW,ADDAB,ADDAW,IDXLB,IDXLW,IDXAB,IDXAW ; B0 B2 B4 B6 B8 BA BC BE ;* -;* ENTER INTO BYTECODE INTERPRETER ;* -DINTRP PLA - CLC - ADC #$01 - STA IPL - PLA - ADC #$00 - STA IPH - LDY #$00 - LDA #>OPTBL - STA OPPAGE - JMP FETCHOP +;* INDIRECTLY ENTER INTO BYTECODE INTERPRETER +;* IINTRP PLA STA TMPL PLA @@ -344,7 +338,7 @@ CMDENTRY = * ; PRINT FAIL MESSAGE, WAIT FOR KEYPRESS, AND REBOOT ; FAIL INC $3F4 ; INVALIDATE POWER-UP BYTE - LDY #33 + LDY #11 - LDA FAILMSG,Y ORA #$80 JSR $FDED @@ -364,7 +358,7 @@ READPARMS !BYTE 4 CLOSEPARMS !BYTE 1 !BYTE 0 DISABLE80 !BYTE 21, 13, '1', 26, 13 -FAILMSG !TEXT "...TESER OT YEK YNA .DMC GNISSIM" +FAILMSG !TEXT ".DMC GNISSIM" PAGE0 = * ;****************************** ;* * @@ -390,24 +384,43 @@ PAGE3 = * BIT LCRDEN+LCBNK2 ; $03DC - INDIRECT INTERPX ENTRY JMP IINTRPX } -DEFCMD !FILL 28 +DEFCMD = * ;!FILL 28 ENDBYE = * } -LCDEFCMD = *-28 ; DEFCMD IN LC MEMORY +LCDEFCMD = * ;*-28 ; DEFCMD IN LC MEMORY ;***************** ;* * ;* OPXCODE TABLE * ;* * ;***************** !ALIGN 255,0 -OPXTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E - !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E - !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CSX ; 20 22 24 26 28 2A 2C 2E - !WORD DROP,DUP,NEXTOP,DIVMOD,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E - !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E - !WORD BRNCH,IBRNCH,CALLX,ICALX,ENTER,LEAVEX,RETX,CFFB; 50 52 54 56 58 5A 5C 5E - !WORD LBX,LWX,LLBX,LLWX,LABX,LAWX,DLB,DLW ; 60 62 64 66 68 6A 6C 6E - !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E +OPXTBL !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06 08 0A 0C 0E + !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E + !WORD MINUS1,BREQ,BRNE,LA,LLA,CB,CW,CSX ; 20 22 24 26 28 2A 2C 2E + !WORD DROP,DROP2,DUP,DIVMOD,ADDI,SUBI,ANDI,ORI ; 30 32 34 36 38 3A 3C 3E + !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E + !WORD BRNCH,SEL,CALLX,ICALX,ENTER,LEAVEX,RETX,CFFB ; 50 52 54 56 58 5A 5C 5E + !WORD LBX,LWX,LLBX,LLWX,LABX,LAWX,DLB,DLW ; 60 62 64 66 68 6A 6C 6E + !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E + !WORD LNOT,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 80 82 84 86 88 8A 8C 8E + !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E + !WORD BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE + !WORD ADDLBX,ADDLWX,ADDABX,ADDAWX,IDXLBX,IDXLWX,IDXABX,IDXAWX ; B0 B2 B4 B6 B8 BA BC BE +;* +;* +;* DIRECTLY ENTER INTO BYTECODE INTERPRETER +;* +DINTRP PLA + CLC + ADC #$01 + STA IPL + PLA + ADC #$00 + STA IPH + LDY #$00 + LDA #>OPTBL + STA OPPAGE + JMP FETCHOP ;* ;* ADD TOS TO TOS-1 ;* @@ -678,31 +691,6 @@ SHR STY IPY + LDY IPY JMP DROP ;* -;* LOGICAL AND -;* -LAND LDA ESTKL+1,X - ORA ESTKH+1,X - BEQ ++ - LDA ESTKL,X - ORA ESTKH,X - BEQ + - LDA #$FF -+ STA ESTKL+1,X - STA ESTKH+1,X -++ JMP DROP -;* -;* LOGICAL OR -;* -LOR LDA ESTKL,X - ORA ESTKH,X - ORA ESTKL+1,X - ORA ESTKH+1,X - BEQ + - LDA #$FF - STA ESTKL+1,X - STA ESTKH+1,X -+ JMP DROP -;* ;* DUPLICATE TOS ;* DUP DEX @@ -712,32 +700,78 @@ DUP DEX STA ESTKH,X JMP NEXTOP ;* +;* ADD IMMEDIATE TO TOS +;* +ADDI INY ;+INC_IP + LDA (IP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ JMP NEXTOP +;* +;* SUB IMMEDIATE FROM TOS +;* +SUBI INY ;+INC_IP + LDA ESTKL,X + SEC + SBC (IP),Y + STA ESTKL,X + BCS + + DEC ESTKH,X ++ JMP NEXTOP +;* +;* AND IMMEDIATE TO TOS +;* +ANDI INY ;+INC_IP + LDA (IP),Y + AND ESTKL,X + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +;* +;* IOR IMMEDIATE TO TOS +;* +ORI INY ;+INC_IP + LDA (IP),Y + ORA ESTKL,X + STA ESTKL,X + JMP NEXTOP +;* ;* LOGICAL NOT ;* LNOT LDA ESTKL,X ORA ESTKH,X - BNE + - LDA #$FF + BEQ + + LDA #$00 STA ESTKL,X STA ESTKH,X JMP NEXTOP ;* -;* CONSTANT +;* CONSTANT -1, NYBBLE, BYTE, $FF BYTE, WORD (BELOW) ;* -ZERO DEX -+ LDA #$00 +MINUS1 DEX ++ LDA #$FF STA ESTKL,X STA ESTKH,X JMP NEXTOP -CFFB DEX - LDA #$FF +CN DEX + LSR ; A = CONST * 2 + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +CB DEX + LDA #$00 STA ESTKH,X INY ;+INC_IP LDA (IP),Y STA ESTKL,X JMP NEXTOP -CB DEX - LDA #$00 +CFFB DEX + LDA #$FF STA ESTKH,X INY ;+INC_IP LDA (IP),Y @@ -788,7 +822,6 @@ CS DEX LDA (IP),Y TAY JMP NEXTOP -; CSX DEX ;INY ;+INC_IP TYA ; NORMALIZE IP @@ -882,7 +915,6 @@ LW LDA ESTKL,X LDA (ESTKH-1,X) STA ESTKH,X JMP NEXTOP -; LBX LDA ESTKL,X STA ESTKH-1,X STA ALTRDOFF @@ -955,7 +987,6 @@ LLW INY ;+INC_IP STA ESTKH,X LDY IPY JMP NEXTOP -; LLBX INY ;+INC_IP LDA (IP),Y STY IPY @@ -984,6 +1015,146 @@ LLWX INY ;+INC_IP LDY IPY JMP NEXTOP ;* +;* ADD VALUE FROM LOCAL FRAME OFFSET +;* +ADDLB INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA (IFP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ LDY IPY + JMP NEXTOP +ADDLBX INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + STA ALTRDOFF + LDA (IFP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ STA ALTRDON + LDY IPY + JMP NEXTOP +ADDLW INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA (IFP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + INY + LDA (IFP),Y + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +ADDLWX INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + STA ALTRDOFF + LDA (IFP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + INY + LDA (IFP),Y + ADC ESTKH,X + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +;* +;* INDEX VALUE FROM LOCAL FRAME OFFSET +;* +IDXLB INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA (IFP),Y + LDY #$00 + ASL + BCC + + INY + CLC ++ ADC ESTKL,X + STA ESTKL,X + TYA + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +IDXLBX INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + STA ALTRDOFF + LDA (IFP),Y + LDY #$00 + ASL + BCC + + INY + CLC ++ ADC ESTKL,X + STA ESTKL,X + TYA + ADC ESTKH,X + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +IDXLW INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA (IFP),Y + ASL + STA TMPL + INY + LDA (IFP),Y + ROL + STA TMPH + LDA TMPL + CLC + ADC ESTKL,X + STA ESTKL,X + LDA TMPH + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +IDXLWX INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + STA ALTRDOFF + LDA (IFP),Y + ASL + STA TMPL + INY + LDA (IFP),Y + ROL + STA TMPH + LDA TMPL + CLC + ADC ESTKL,X + STA ESTKL,X + LDA TMPH + ADC ESTKH,X + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +;* ;* LOAD VALUE FROM ABSOLUTE ADDRESS ;* LAB INY ;+INC_IP @@ -1014,7 +1185,6 @@ LAW INY ;+INC_IP STA ESTKH,X LDY IPY JMP NEXTOP -; LABX INY ;+INC_IP LDA (IP),Y STA ESTKH-2,X @@ -1048,6 +1218,170 @@ LAWX INY ;+INC_IP LDY IPY JMP NEXTOP ;* +;* ADD VALUE FROM ABSOLUTE ADDRESS +;* +ADDAB INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + LDA (ESTKH-2,X) + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ JMP NEXTOP +ADDABX INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + STA ALTRDOFF + LDA (ESTKH-2,X) + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ STA ALTRDON + JMP NEXTOP +ADDAW INY ;+INC_IP + LDA (IP),Y + STA SRCL + INY ;+INC_IP + LDA (IP),Y + STA SRCH + STY IPY + LDY #$00 + LDA (SRC),Y + CLC + ADC ESTKL,X + STA ESTKL,X + INY + LDA (SRC),Y + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +ADDAWX INY ;+INC_IP + LDA (IP),Y + STA SRCL + INY ;+INC_IP + LDA (IP),Y + STA SRCH + STY IPY + STA ALTRDOFF + LDY #$00 + LDA (SRC),Y + CLC + ADC ESTKL,X + STA ESTKL,X + INY + LDA (SRC),Y + ADC ESTKH,X + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +;* +;* INDEX VALUE FROM ABSOLUTE ADDRESS +;* +IDXAB INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + LDA (ESTKH-2,X) + STY IPY + LDY #$00 + ASL + BCC + + INY + CLC ++ ADC ESTKL,X + STA ESTKL,X + TYA + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +IDXABX INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + STA ALTRDOFF + LDA (ESTKH-2,X) + STY IPY + LDY #$00 + ASL + BCC + + INY + CLC ++ ADC ESTKL,X + STA ESTKL,X + TYA + ADC ESTKH,X + STA ESTKH,X + LDY IPY + STA ALTRDON + JMP NEXTOP +IDXAW INY ;+INC_IP + LDA (IP),Y + STA SRCL + INY ;+INC_IP + LDA (IP),Y + STA SRCH + STY IPY + LDY #$00 + LDA (SRC),Y + ASL + STA TMPL + INY + LDA (SRC),Y + ROL + STA TMPH + LDA TMPL + CLC + ADC ESTKL,X + STA ESTKL,X + LDA TMPH + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +IDXAWX INY ;+INC_IP + LDA (IP),Y + STA SRCL + INY ;+INC_IP + LDA (IP),Y + STA SRCH + STY IPY + STA ALTRDOFF + LDY #$00 + LDA (SRC),Y + ASL + STA TMPL + INY + LDA (SRC),Y + ROL + STA TMPH + LDA TMPL + CLC + ADC ESTKL,X + STA ESTKL,X + LDA TMPH + ADC ESTKH,X + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +;* ;* STORE VALUE TO ADDRESS ;* SB LDA ESTKL,X @@ -1068,7 +1402,10 @@ SW LDA ESTKL,X JMP DROP + INC ESTKH,X STA (ESTKH-1,X) - INX +;* +;* DROP TOS, TOS-1 +;* +DROP2 INX JMP DROP ;* ;* STORE VALUE TO LOCAL FRAME OFFSET @@ -1111,6 +1448,8 @@ DLB INY ;+INC_IP TAY LDA ESTKL,X STA (IFP),Y + LDA #$00 + STA ESTKH,X LDY IPY JMP NEXTOP DLW INY ;+INC_IP @@ -1172,6 +1511,8 @@ DAB INY ;+INC_IP STA ESTKH-1,X LDA ESTKL,X STA (ESTKH-2,X) + LDA #$00 + STA ESTKH,X JMP NEXTOP DAW INY ;+INC_IP LDA (IP),Y @@ -1201,7 +1542,6 @@ ISTRU LDA #$FF STA ESTKL+1,X STA ESTKH+1,X JMP DROP -; ISNE LDA ESTKL,X CMP ESTKL+1,X BNE ISTRU @@ -1212,7 +1552,6 @@ ISFLS LDA #$00 STA ESTKL+1,X STA ESTKH+1,X JMP DROP -; ISGE LDA ESTKL+1,X CMP ESTKL,X LDA ESTKH+1,X @@ -1220,9 +1559,16 @@ ISGE LDA ESTKL+1,X BVS + BPL ISTRU BMI ISFLS -+ BPL ISFLS ++ +- BPL ISFLS BMI ISTRU -; +ISLE LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVS - + BPL ISTRU + BMI ISFLS ISGT LDA ESTKL,X CMP ESTKL+1,X LDA ESTKH,X @@ -1230,31 +1576,114 @@ ISGT LDA ESTKL,X BVS + BMI ISTRU BPL ISFLS -+ BMI ISFLS ++ +- BMI ISFLS BPL ISTRU -; -ISLE LDA ESTKL,X - CMP ESTKL+1,X - LDA ESTKH,X - SBC ESTKH+1,X - BVS + - BPL ISTRU - BMI ISFLS -+ BPL ISFLS - BMI ISTRU -; ISLT LDA ESTKL+1,X CMP ESTKL,X LDA ESTKH+1,X SBC ESTKH,X - BVS + + BVS - BMI ISTRU BPL ISFLS -+ BMI ISFLS - BPL ISTRU ;* ;* BRANCHES ;* +SEL INX + TYA ; FLATTEN IP + SEC + ADC IPL + STA TMPL + LDA #$00 + TAY + ADC IPH + STA TMPH ; ADD BRANCH OFFSET + LDA (TMP),Y + ;CLC ; BETTER NOT CARRY OUT OF IP+Y + ADC TMPL + STA IPL + INY + LDA (TMP),Y + ADC TMPH + STA IPH + DEY + LDA (IP),Y + STA TMPL ; CASE COUNT + INC IPL + BNE CASELP + INC IPH +CASELP LDA ESTKL-1,X + CMP (IP),Y + BEQ + + LDA ESTKH-1,X + INY + SBC (IP),Y + BMI CASEEND +- INY + INY + DEC TMPL + BEQ FIXNEXT + INY + BNE CASELP + INC IPH + BNE CASELP ++ LDA ESTKH-1,X + INY + SBC (IP),Y + BEQ BRNCH + BPL - +CASEEND LDA #$00 + STA TMPH + DEC TMPL + LDA TMPL + ASL ; SKIP REMAINING CASES + ROL TMPH + ASL + ROL TMPH +; CLC + ADC IPL + STA IPL + LDA TMPH + ADC IPH + STA IPH + INY + INY +FIXNEXT TYA + LDY #$00 + SEC + ADC IPL + STA IPL + BCC + + INC IPH ++ JMP FETCHOP +BRAND LDA ESTKL,X + ORA ESTKH,X + BEQ BRNCH + INX ; DROP LEFT HALF OF AND + BNE NOBRNCH +BROR LDA ESTKL,X + ORA ESTKH,X + BNE BRNCH + INX ; DROP LEFT HALF OF OR + BNE NOBRNCH +BREQ INX + INX + LDA ESTKL-2,X + CMP ESTKL-1,X + BNE NOBRNCH + LDA ESTKH-2,X + CMP ESTKH-1,X + BEQ BRNCH + BNE NOBRNCH +BRNE INX + INX + LDA ESTKL-2,X + CMP ESTKL-1,X + BNE BRNCH + LDA ESTKH-2,X + CMP ESTKH-1,X + BNE BRNCH + BEQ NOBRNCH BRTRU INX LDA ESTKH-1,X ORA ESTKL-1,X @@ -1263,14 +1692,6 @@ NOBRNCH INY ;+INC_IP INY BMI FIXNEXT JMP NEXTOP -FIXNEXT TYA - LDY #$00 - CLC - ADC IPL - STA IPL - BCC + - INC IPH -+ JMP NEXTOP BRFLS INX LDA ESTKH-1,X ORA ESTKL-1,X @@ -1293,58 +1714,75 @@ BRNCH TYA ; FLATTEN IP STA IPH DEY JMP FETCHOP -BREQ INX - LDA ESTKL-1,X +;* +;* FOR LOOPS PUT TERMINAL VALUE AT ESTK+1 AND CURRENT COUNT ON ESTK +;* +BRGT LDA ESTKL+1,X CMP ESTKL,X - BNE NOBRNCH - LDA ESTKH-1,X - CMP ESTKH,X - BEQ BRNCH - BNE NOBRNCH -BRNE INX - LDA ESTKL-1,X - CMP ESTKL,X - BNE BRNCH - LDA ESTKH-1,X - CMP ESTKH,X - BEQ NOBRNCH - BNE BRNCH -BRGT INX - LDA ESTKL-1,X - CMP ESTKL,X - LDA ESTKH-1,X + LDA ESTKH+1,X SBC ESTKH,X BVS + BPL NOBRNCH - BMI BRNCH -+ BPL BRNCH - BMI NOBRNCH -BRLT INX - LDA ESTKL,X - CMP ESTKL-1,X +- INX ; DROP FOR VALUES + INX + BNE BRNCH ; BMI BRNCH +BRLT LDA ESTKL,X + CMP ESTKL+1,X LDA ESTKH,X - SBC ESTKH-1,X + SBC ESTKH+1,X BVS + BPL NOBRNCH - BMI BRNCH -+ BPL BRNCH - BMI NOBRNCH -IBRNCH TYA ; FLATTEN IP + INX ; DROP FOR VALUES + INX + BNE BRNCH ; BMI BRNCH ++ BMI NOBRNCH + BPL - +DECBRGE DEC ESTKL,X + LDA ESTKL,X + CMP #$FF + BNE + + DEC ESTKH,X +_BRGE LDA ESTKL,X ++ CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVS + + BPL BRNCH +- INX ; DROP FOR VALUES + INX + BNE NOBRNCH ; BMI NOBRNCH +INCBRLE INC ESTKL,X + BNE _BRLE + INC ESTKH,X +_BRLE LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + BVS + + BPL BRNCH + INX ; DROP FOR VALUES + INX + BNE NOBRNCH ; BMI NOBRNCH ++ BMI BRNCH + BPL - +SUBBRGE LDA ESTKL+1,X + SEC + SBC ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + SBC ESTKH,X + STA ESTKH+1,X + INX + BNE _BRGE +ADDBRLE LDA ESTKL,X CLC - ADC IPL - STA TMPL - LDA #$00 - TAY - ADC IPH - STA TMPH ; ADD BRANCH OFFSET - LDA TMPL - ;CLC ; BETTER NOT CARRY OUT OF IP+Y - ADC ESTKL,X - STA IPL - LDA TMPH - ADC ESTKH,X - STA IPH - JMP DROP + ADC ESTKL+1,X + STA ESTKL+1,X + LDA ESTKH,X + ADC ESTKH+1,X + STA ESTKH+1,X + INX + BNE _BRLE ;* ;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE) ;* @@ -1355,7 +1793,7 @@ CALL INY ;+INC_IP LDA (IP),Y STA TMPH TYA - CLC + SEC ADC IPL PHA LDA IPH @@ -1368,9 +1806,8 @@ CALL INY ;+INC_IP STA IPL LDA #>OPTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE STA OPPAGE - LDY #$01 + LDY #$00 JMP FETCHOP -; CALLX INY ;+INC_IP LDA (IP),Y STA TMPL @@ -1378,7 +1815,7 @@ CALLX INY ;+INC_IP LDA (IP),Y STA TMPH TYA - CLC + SEC ADC IPL PHA LDA IPH @@ -1400,7 +1837,7 @@ CALLX INY ;+INC_IP STA IPL LDA #>OPXTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE STA OPPAGE - LDY #$01 + LDY #$00 JMP FETCHOP ;* ;* INDIRECT CALL TO ADDRESS (NATIVE CODE) @@ -1411,7 +1848,7 @@ ICAL LDA ESTKL,X STA TMPH INX TYA - CLC + SEC ADC IPL PHA LDA IPH @@ -1424,16 +1861,15 @@ ICAL LDA ESTKL,X STA IPL LDA #>OPTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE STA OPPAGE - LDY #$01 + LDY #$00 JMP FETCHOP -; ICALX LDA ESTKL,X STA TMPL LDA ESTKH,X STA TMPH INX TYA - CLC + SEC ADC IPL PHA LDA IPH @@ -1454,7 +1890,7 @@ ICALX LDA ESTKL,X STA IPL LDA #>OPXTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE STA OPPAGE - LDY #$01 + LDY #$0 JMP FETCHOP ;* ;* JUMP INDIRECT TRHOUGH TMP @@ -1582,15 +2018,16 @@ CDINTRP PLY JMP FETCHOP CDINTRPEND ; - LDA #ZERO - LDY #(CZEROEND-CZERO) + LDA #CN + LDY #(CCNEND-CCN) JSR OPCPY -CZERO DEX - STZ ESTKL,X +CCN DEX + LSR + STA ESTKL,X STZ ESTKH,X JMP NEXTOP -CZEROEND +CCNEND ; LDA #CB @@ -1829,6 +2266,37 @@ CDAW INY ;+INC_IP LDY IPY JMP NEXTOP CDAWEND +; + LDA #DAB + LDY #(CDABEND-CDAB) + JSR OPCPY +CDAB INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + LDA ESTKL,X + STA (ESTKH-2,X) + STZ ESTKH,X + JMP NEXTOP +CDABEND +; + LDA #DLB + LDY #(CDLBEND-CDLB) + JSR OPCPY +CDLB INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + STZ ESTKH,X + LDY IPY + JMP NEXTOP +CDLBEND ; LDA #ISFLS diff --git a/src/vmsrc/apple/plvm03.s b/src/vmsrc/apple/plvm03.s index 824de0a..920c57b 100755 --- a/src/vmsrc/apple/plvm03.s +++ b/src/vmsrc/apple/plvm03.s @@ -49,10 +49,6 @@ SEGSTART = $2000 !WORD SEGSTART !WORD SEGEND-SEGSTART -; +SOS $40, SEGREQ ; ALLOCATE SEG 1 AND MAP IT -; BNE FAIL ; PRHEX -; LDA #$00 -; STA MEMBANK LDY #$0F ; INSTALL PAGE 0 FETCHOP ROUTINE LDA #$00 - LDX PAGE0,Y @@ -65,16 +61,9 @@ SEGSTART = $2000 STA TMPX ; CLEAR ALL EXTENDED POINTERS STA SRCX STA DSTX - STA PPX ; INIT FRAME & POOL POINTERS + STA PPX STA IFPX - LDA #$00 - STA PPL - STA IFPL - LDA #$A0 - STA PPH - STA IFPH - !IF 1 { - LDA #VMCORE STA SRCH @@ -91,7 +80,16 @@ SEGSTART = $2000 LDA DSTH CMP #$B8 BNE - -} + LDA #$00 ; INIT JIT, FRAME & POOL POINTERS + STA JITCOMP + STA JITCOMP+1 + STA JITCODE + STA PPL + STA IFPL + LDA #$90 ; RESERVE 4K FOR JITCODE + STA JITCODE+1 + STA PPH + STA IFPH LDX #$FF ; INIT STACK POINTER TXS LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX @@ -134,18 +132,30 @@ PAGE0 = * } VMCORE = * !PSEUDOPC $A000 { +TEMPBUF !FILL $F0 +CMDPARS !WORD 0 ; $A0F0 +JITCOMP !WORD 0 ; $A0F2 +JITCODE !WORD 0 ; $A0F4 +SENTRY !WORD INTERP ; $A0F6 +XENTRY !WORD XINTERP ; $A0F8 +JENTRY !WORD JITINTRP ; $A0FA ;* ;* OPCODE TABLE ;* !ALIGN 255,0 -OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E - !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E - !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E - !WORD DROP,DUP,NEXTOP,DIVMOD,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E - !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E - !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E - !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E - !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E +OPTBL !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06 08 0A 0C 0E + !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E + !WORD MINUS1,BREQ,BRNE,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E + !WORD DROP,DROP2,DUP,DIVMOD,ADDI,SUBI,ANDI,ORI ; 30 32 34 36 38 3A 3C 3E + !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E + !WORD BRNCH,SEL,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E + !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E + !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E + !WORD LNOT,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 80 82 84 86 88 8A 8C 8E + !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E + !WORD BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE + !WORD ADDLB,ADDLW,ADDAB,ADDAW,IDXLB,IDXLW,IDXAB,IDXAW ; B0 B2 B4 B6 B8 BA BC BE + !WORD NATV ; C0 ;* ;* SYSTEM INTERPRETER ENTRYPOINT ;* @@ -166,7 +176,7 @@ XINTERP PLA STA TMPL PLA STA TMPH - LDY #$03 +- LDY #$03 LDA (TMP),Y STA IPX DEY @@ -178,6 +188,49 @@ XINTERP PLA DEY JMP FETCHOP ;* +;* JIT PROFILING ENTRY INTO INTERPRETER +;* +JITINTRP PLA + STA TMPL + PLA + STA TMPH + LDY #$04 + LDA (TMP),Y ; DEC JIT COUNT + SEC + SBC #$01 + STA (TMP),Y + BNE - ; INTERP BYTECODE + LDA JITCOMP ; CALL JIT COMPILER + STA SRCL + LDA JITCOMP+1 + STA SRCH + INY ; LDY #$05 + LDA (SRC),Y + STA IPX + DEY + LDA (SRC),Y + STA IPH + DEY + LDA (SRC),Y + STA IPL + DEX ; ADD PARAMETER TO DEF ENTRY + LDA TMPL + SEC + SBC #$02 ; POINT TO DEF ENTRY + PHA ; AND SAVE IT FOR LATER + STA ESTKL,X + LDA TMPH + SBC #$00 + PHA + STA ESTKH,X + LDY #$00 + JSR FETCHOP ; CALL JIT COMPILER + PLA + STA TMPH + PLA + STA TMPL + JMP (TMP) ; RE-CALL ORIGINAL DEF ENTRY +;* ;* INTERNAL DIVIDE ALGORITHM ;* _NEG LDA #$00 @@ -439,31 +492,6 @@ SHR STY IPY + LDY IPY JMP DROP ;* -;* LOGICAL AND -;* -LAND LDA ESTKL+1,X - ORA ESTKH+1,X - BEQ ++ - LDA ESTKL,X - ORA ESTKH,X - BEQ + - LDA #$FF -+ STA ESTKL+1,X - STA ESTKH+1,X -++ JMP DROP -;* -;* LOGICAL OR -;* -LOR LDA ESTKL,X - ORA ESTKH,X - ORA ESTKL+1,X - ORA ESTKH+1,X - BEQ + - LDA #$FF - STA ESTKL+1,X - STA ESTKH+1,X -+ JMP DROP -;* ;* DUPLICATE TOS ;* DUP DEX @@ -473,25 +501,76 @@ DUP DEX STA ESTKH,X JMP NEXTOP ;* +;* ADD IMMEDIATE TO TOS +;* +ADDI INY ;+INC_IP + LDA (IP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ JMP NEXTOP +;* +;* SUB IMMEDIATE FROM TOS +;* +SUBI INY ;+INC_IP + LDA ESTKL,X + SEC + SBC (IP),Y + STA ESTKL,X + BCS + + DEC ESTKH,X ++ JMP NEXTOP +;* +;* AND IMMEDIATE TO TOS +;* +ANDI INY ;+INC_IP + LDA (IP),Y + AND ESTKL,X + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +;* +;* IOR IMMEDIATE TO TOS +;* +ORI INY ;+INC_IP + LDA (IP),Y + ORA ESTKL,X + STA ESTKL,X + JMP NEXTOP +;* ;* LOGICAL NOT ;* LNOT LDA ESTKL,X ORA ESTKH,X - BNE + - LDA #$FF + BEQ + + LDA #$00 STA ESTKL,X STA ESTKH,X JMP NEXTOP ;* -;* CONSTANT +;* CONSTANT -1, NYBBLE, BYTE, $FF BYTE, WORD (BELOW) ;* -ZERO DEX -+ LDA #$00 +MINUS1 DEX ++ LDA #$FF STA ESTKL,X STA ESTKH,X JMP NEXTOP +CN DEX + LSR ; A = CONST * 2 + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP CFFB LDA #$FF - !BYTE $2C ; BIT $00A9 - effectively skips LDA #$00, no harm in reading this address + DEX + STA ESTKH,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKL,X + JMP NEXTOP CB LDA #$00 DEX STA ESTKH,X @@ -608,12 +687,9 @@ LW LDA ESTKL,X LDA (ESTKH-1,X) STA ESTKL,X INC ESTKH-1,X - BEQ + - LDA (ESTKH-1,X) - STA ESTKH,X - JMP NEXTOP -+ INC ESTKH,X - LDA (ESTKH-1,X) + BNE + + INC ESTKH,X ++ LDA (ESTKH-1,X) STA ESTKH,X JMP NEXTOP ;* @@ -664,6 +740,75 @@ LLW INY ;+INC_IP LDY IPY JMP NEXTOP ;* +;* ADD VALUE FROM LOCAL FRAME OFFSET +;* +ADDLB INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA (IFP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ LDY IPY + JMP NEXTOP +ADDLW INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA (IFP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + INY + LDA (IFP),Y + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +;* +;* INDEX VALUE FROM LOCAL FRAME OFFSET +;* +IDXLB INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA (IFP),Y + LDY #$00 + ASL + BCC + + INY + CLC ++ ADC ESTKL,X + STA ESTKL,X + TYA + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +IDXLW INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA (IFP),Y + ASL + STA TMPL + INY + LDA (IFP),Y + ROL + STA TMPH + LDA TMPL + CLC + ADC ESTKL,X + STA ESTKL,X + LDA TMPH + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +;* ;* LOAD VALUE FROM ABSOLUTE ADDRESS ;* LAB INY ;+INC_IP @@ -695,6 +840,87 @@ LAW INY ;+INC_IP LDY IPY JMP NEXTOP ;* +;* ADD VALUE FROM ABSOLUTE ADDRESS +;* +ADDAB INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + LDA (ESTKH-2,X) + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ JMP NEXTOP +ADDAW INY ;+INC_IP + LDA (IP),Y + STA SRCL + INY ;+INC_IP + LDA (IP),Y + STA SRCH + STY IPY + LDY #$00 + LDA (SRC),Y + CLC + ADC ESTKL,X + STA ESTKL,X + INY + LDA (SRC),Y + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +;* +;* INDEX VALUE FROM ABSOLUTE ADDRESS +;* +IDXAB INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + LDA (ESTKH-2,X) + STY IPY + LDY #$00 + ASL + BCC + + INY + CLC ++ ADC ESTKL,X + STA ESTKL,X + TYA + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +IDXAW INY ;+INC_IP + LDA (IP),Y + STA SRCL + INY ;+INC_IP + LDA (IP),Y + STA SRCH + STY IPY + LDY #$00 + LDA (SRC),Y + ASL + STA TMPL + INY + LDA (SRC),Y + ROL + STA TMPH + LDA TMPL + CLC + ADC ESTKL,X + STA ESTKL,X + LDA TMPH + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +;* ;* STORE VALUE TO ADDRESS ;* SB LDA ESTKL,X @@ -709,13 +935,13 @@ SW LDA ESTKL,X STA (ESTKH-1,X) LDA ESTKH+1,X INC ESTKH-1,X - BEQ + - STA (ESTKH-1,X) - INX - JMP DROP -+ INC ESTKH,X - STA (ESTKH-1,X) - INX + BNE + + INC ESTKH,X ++ STA (ESTKH-1,X) +;* +;* DROP TOS, TOS-1 +;* +DROP2 INX JMP DROP ;* ;* STORE VALUE TO LOCAL FRAME OFFSET @@ -758,6 +984,8 @@ DLB INY ;+INC_IP TAY LDA ESTKL,X STA (IFP),Y + LDA #$00 + STA ESTKH,X LDY IPY JMP NEXTOP DLW INY ;+INC_IP @@ -818,6 +1046,8 @@ DAB INY ;+INC_IP STA ESTKH-1,X LDA ESTKL,X STA (ESTKH-2,X) + LDA #$00 + STA ESTKH,X JMP NEXTOP DAW INY ;+INC_IP LDA (IP),Y @@ -847,7 +1077,6 @@ ISTRU LDA #$FF STA ESTKL+1,X STA ESTKH+1,X JMP DROP -; ISNE LDA ESTKL,X CMP ESTKL+1,X BNE ISTRU @@ -858,7 +1087,6 @@ ISFLS LDA #$00 STA ESTKL+1,X STA ESTKH+1,X JMP DROP -; ISGE LDA ESTKL+1,X CMP ESTKL,X LDA ESTKH+1,X @@ -866,9 +1094,16 @@ ISGE LDA ESTKL+1,X BVS + BPL ISTRU BMI ISFLS -+ BPL ISFLS ++ +- BPL ISFLS BMI ISTRU -; +ISLE LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVS - + BPL ISTRU + BMI ISFLS ISGT LDA ESTKL,X CMP ESTKL+1,X LDA ESTKH,X @@ -876,42 +1111,117 @@ ISGT LDA ESTKL,X BVS + BMI ISTRU BPL ISFLS -+ BMI ISFLS ++ +- BMI ISFLS BPL ISTRU -; -ISLE LDA ESTKL,X - CMP ESTKL+1,X - LDA ESTKH,X - SBC ESTKH+1,X - BVS + - BPL ISTRU - BMI ISFLS -+ BPL ISFLS - BMI ISTRU -; ISLT LDA ESTKL+1,X CMP ESTKL,X LDA ESTKH+1,X SBC ESTKH,X - BVS + + BVS - BMI ISTRU BPL ISFLS -+ BMI ISFLS - BPL ISTRU ;* -;* NORMALIZE IP+Y BEFORE CALLING NEXTOP +;* BRANCHES ;* +SEL INX + TYA ; FLATTEN IP + SEC + ADC IPL + STA TMPL + LDA #$00 + TAY + ADC IPH + STA TMPH ; ADD CASEBLOCK OFFSET + LDA IPX ; COPY XBYTE FROM IP + STA TMPX + LDA (TMP),Y + ;CLC ; BETTER NOT CARRY OUT OF IP+Y + ADC TMPL + STA IPL + INY + LDA (TMP),Y + ADC TMPH + STA IPH + DEY + STY TMPX ; CLEAR TMPX + LDA (IP),Y + STA TMPL ; CASE COUNT + INC IPL + BNE CASELP + INC IPH +CASELP LDA ESTKL-1,X + CMP (IP),Y + BEQ + + LDA ESTKH-1,X + INY + SBC (IP),Y + BMI CASEEND +- INY + INY + DEC TMPL + BEQ FIXNEXT + INY + BNE CASELP + INC IPH + BNE CASELP ++ LDA ESTKH-1,X + INY + SBC (IP),Y + BEQ BRNCH + BPL - +CASEEND LDA #$00 + STA TMPH + DEC TMPL + LDA TMPL + ASL ; SKIP REMAINING CASES + ROL TMPH + ASL + ROL TMPH +; CLC + ADC IPL + STA IPL + LDA TMPH + ADC IPH + STA IPH + INY + INY FIXNEXT TYA LDY #$00 - CLC + SEC ADC IPL STA IPL BCC + INC IPH -+ JMP NEXTOP -;* -;* BRANCHES -;* ++ JMP FETCHOP +BRAND LDA ESTKL,X + ORA ESTKH,X + BEQ BRNCH + INX ; DROP LEFT HALF OF AND + BNE NOBRNCH +BROR LDA ESTKL,X + ORA ESTKH,X + BNE BRNCH + INX ; DROP LEFT HALF OF OR + BNE NOBRNCH +BREQ INX + INX + LDA ESTKL-2,X + CMP ESTKL-1,X + BNE NOBRNCH + LDA ESTKH-2,X + CMP ESTKH-1,X + BEQ BRNCH + BNE NOBRNCH +BRNE INX + INX + LDA ESTKL-2,X + CMP ESTKL-1,X + BNE BRNCH + LDA ESTKH-2,X + CMP ESTKH-1,X + BNE BRNCH + BEQ NOBRNCH BRTRU INX LDA ESTKH-1,X ORA ESTKL-1,X @@ -945,67 +1255,97 @@ BRNCH TYA ; FLATTEN IP DEY STY TMPX ; CLEAR TMPX JMP FETCHOP -BREQ INX - LDA ESTKL-1,X +;* +;* FOR LOOPS PUT TERMINAL VALUE AT ESTK+1 AND CURRENT COUNT ON ESTK +;* +BRGT LDA ESTKL+1,X CMP ESTKL,X - BNE NOBRNCH - LDA ESTKH-1,X - CMP ESTKH,X - BEQ BRNCH - BNE NOBRNCH -BRNE INX - LDA ESTKL-1,X - CMP ESTKL,X - BNE BRNCH - LDA ESTKH-1,X - CMP ESTKH,X - BEQ NOBRNCH - BNE BRNCH -BRGT INX - LDA ESTKL-1,X - CMP ESTKL,X - LDA ESTKH-1,X + LDA ESTKH+1,X SBC ESTKH,X BVS + BPL NOBRNCH - BMI BRNCH -+ BPL BRNCH - BMI NOBRNCH -BRLT INX - LDA ESTKL,X - CMP ESTKL-1,X +- INX ; DROP FOR VALUES + INX + BNE BRNCH ; BMI BRNCH +BRLT LDA ESTKL,X + CMP ESTKL+1,X LDA ESTKH,X - SBC ESTKH-1,X + SBC ESTKH+1,X BVS + BPL NOBRNCH - BMI BRNCH -+ BPL BRNCH - BMI NOBRNCH -IBRNCH TYA ; FLATTEN IP + BMI - ++ BMI NOBRNCH + BPL - +INCBRLE INC ESTKL,X + BNE _BRLE + INC ESTKH,X +_BRLE LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + BVS + + BPL BRNCH +- INX ; DROP FOR VALUES + INX + BNE NOBRNCH ; BMI NOBRNCH +DECBRGE DEC ESTKL,X + LDA ESTKL,X + CMP #$FF + BNE + + DEC ESTKH,X +_BRGE LDA ESTKL,X ++ CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVS + + BPL BRNCH + BMI - ++ BMI BRNCH + BPL - +SUBBRGE LDA ESTKL+1,X + SEC + SBC ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + SBC ESTKH,X + STA ESTKH+1,X + INX + BNE _BRGE +ADDBRLE LDA ESTKL,X CLC - ADC IPL - STA TMPL - LDA #$00 - TAY - ADC IPH - STA TMPH ; ADD BRANCH OFFSET - LDA TMPL - ;CLC ; BETTER NOT CARRY OUT OF IP+Y - ADC ESTKL,X - STA IPL - LDA TMPH - ADC ESTKH,X - STA IPH - JMP DROP + ADC ESTKL+1,X + STA ESTKL+1,X + LDA ESTKH,X + ADC ESTKH+1,X + STA ESTKH+1,X + INX + BNE _BRLE ;* ;* INDIRECT CALL TO ADDRESS (NATIVE CODE) ;* ICAL LDA ESTKL,X - STA CALLADR+1 + STA ICALADR+1 LDA ESTKH,X - STA CALLADR+2 + STA ICALADR+2 INX - BNE _CALL + TYA + SEC + ADC IPL + PHA + LDA IPH + ADC #$00 + PHA + LDA IPX + PHA +ICALADR JSR $FFFF + PLA + STA IPX + PLA + STA IPH + PLA + STA IPL + LDY #$00 + JMP FETCHOP ;* ;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE) ;* @@ -1016,7 +1356,7 @@ CALL INY ;+INC_IP LDA (IP),Y STA CALLADR+2 _CALL TYA - CLC + SEC ADC IPL PHA LDA IPH @@ -1031,7 +1371,7 @@ CALLADR JSR $FFFF STA IPH PLA STA IPL - LDY #$01 + LDY #$00 JMP FETCHOP ;* ;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT @@ -1082,7 +1422,19 @@ LEAVE INY ;+INC_IP PLA STA IFPH RET RTS +;* +;* RETURN TO NATIVE CODE +;* +NATV TYA ; FLATTEN IP + SEC + ADC IPL + STA TMPL + LDA #$00 + ADC IPH + STA TMPH + JMP JMPTMP SOSCMD = * - !SOURCE "vmsrc/apple/soscmd.a" + !SOURCE "vmsrc/apple/sossys.a" + } SEGEND = * diff --git a/src/vmsrc/apple/plvm802.s b/src/vmsrc/apple/plvm802.s index 18fca79..26906da 100644 --- a/src/vmsrc/apple/plvm802.s +++ b/src/vmsrc/apple/plvm802.s @@ -64,7 +64,10 @@ OPPAGE = OPIDX+1 ; BUFFER ADDRESSES ; STRBUF = $0280 +JITMOD = $02E0 INTERP = $03D0 +JITCOMP = $03E2 +JITCODE = $03E4 ;* ;* HARDWARE STACK OFFSETS ;* @@ -88,18 +91,35 @@ NOS = $03 ; TOS-1 ;****************************** * = $2000 ;* -;* CHECK CPU TYPE +;* MUST HAVE 128K FOR JIT ;* - CLC - XCE ; SWITCH TO NATIVE MODE - BCS ++ ; NOPE, NOT 65802/65816 ++ LDA MACHID + AND #$30 + CMP #$30 + BEQ ++ LDY #$00 -- LDA BADCPU,Y +- LDA NEEDAUX,Y BEQ + ORA #$80 JSR $FDED INY BNE - + LDY #ANYKEY-BADCPU + BNE +++ +NEEDAUX !TEXT "128K MEMORY REQUIRED.", 13, 0 +;* +;* CHECK CPU TYPE +;* +++ CLC + XCE ; SWITCH TO NATIVE MODE + BCS ++ + LDY #$00 ; NOPE, NOT 65802/65816 +- LDA BADCPU,Y + BEQ + + ORA #$80 + JSR $FDED + INY ++++ BNE - + LDA $C000 BPL - LDA $C010 @@ -112,7 +132,7 @@ BYEPARMS !BYTE 4 !BYTE 0 !WORD 0 BADCPU !TEXT "65C802/65C816 CPU REQUIRED.", 13 - !TEXT "PRESS ANY KEY...", 0 +ANYKEY !TEXT "PRESS ANY KEY...", 0 ++ XCE ; SWITCH BACK TO EMULATED MODE ;* @@ -193,7 +213,7 @@ RAMDONE ;CLI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE JSR PRODOS ; GET PREFIX !BYTE $C7 !WORD GETPFXPARMS - LDY STRBUF ; APPEND "CMD" + LDY STRBUF ; APPEND "CMDJIT" LDA #"/" CMP STRBUF,Y BEQ + @@ -208,6 +228,15 @@ RAMDONE ;CLI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE LDA #"D" INY STA STRBUF,Y + LDA #"J" + INY + STA STRBUF,Y + LDA #"I" + INY + STA STRBUF,Y + LDA #"T" + INY + STA STRBUF,Y STY STRBUF BIT LCRWEN+LCBNK2 ; COPY TO LC FOR BYE BIT LCRWEN+LCBNK2 @@ -231,14 +260,19 @@ VMCORE = * ;* * ;**************** !ALIGN 255,0 -OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E - !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E - !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E - !WORD DROP,DUP,NEXTOP,DIVMOD,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E - !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E - !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E - !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E - !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E +OPTBL !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06 08 0A 0C 0E + !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E + !WORD MINUS1,BREQ,BRNE,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E + !WORD DROP,DROP2,DUP,DIVMOD,ADDI,SUBI,ANDI,ORI ; 30 32 34 36 38 3A 3C 3E + !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E + !WORD BRNCH,SEL,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E + !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E + !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E + !WORD LNOT,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 80 82 84 86 88 8A 8C 8E + !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E + !WORD BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE + !WORD ADDLB,ADDLW,ADDAB,ADDAW,IDXLB,IDXLW,IDXAB,IDXAW ; B0 B2 B4 B6 B8 BA BC BE + !WORD NATV ; C0 ;* ;* ENTER INTO BYTECODE INTERPRETER - IMMEDIATELY SWITCH TO NATIVE ;* @@ -258,36 +292,13 @@ DINTRP PHP STX HWSP LDX #>OPTBL !IF DEBUG { - BRA SETDBG + JMP SETDBG } ELSE { STX OPPAGE LDY #$00 JMP FETCHOP } !AS -IINTRP PHP - PLA - STA PSR - SEI - CLC ; SWITCH TO NATIVE MODE - XCE - +ACCMEM16 ; 16 BIT A/M - LDY #$01 - LDA (TOS,S),Y - DEY - STA IP - PLA - STX ESP - TSX - STX HWSP - LDX #>OPTBL -!IF DEBUG { - BRA SETDBG -} ELSE { - STX OPPAGE - JMP FETCHOP -} - !AS IINTRPX PHP PLA STA PSR @@ -332,6 +343,19 @@ BYE LDY DEFCMD ; STY $01FF CMDENTRY = * ; +; SET DCI STRING FOR JIT MODULE +; + LDA #'J'|$80 + STA JITMOD+0 + LDA #'I'|$80 + STA JITMOD+1 + LDA #'T'|$80 + STA JITMOD+2 + LDA #'1'|$80 + STA JITMOD+3 + LDA #'6' + STA JITMOD+4 +; ; DEACTIVATE 80 COL CARDS ; BIT ROMEN @@ -348,9 +372,6 @@ CMDENTRY = * !IF DEBUG { LDA #20 ; SET TEXT WINDOW ABOVE DEBUG OUTPUT STA $23 -; LDA $BF98 ; FORCE 64K -; AND #$CF -; STA $BF98 } ; ; INSTALL PAGE 0 FETCHOP ROUTINE @@ -397,11 +418,11 @@ CMDENTRY = * ; ; INIT VM ENVIRONMENT STACK POINTERS ; -; LDA #$00 +; LDA #$00 STA $01FF ; CLEAR CMDLINE BUFF STA PPL ; INIT FRAME POINTER STA IFPL - LDA #$BF + LDA #$AF ; FRAME POINTER AT $AF00, BELOW JIT BUFFER STA PPH STA IFPH LDX #$FE ; INIT STACK POINTER (YES, $FE. SEE GETS) @@ -412,14 +433,14 @@ CMDENTRY = * ; LDA STRBUF SEC - SBC #$03 + SBC #$06 STA STRBUF JMP $2000 ; JUMP TO LOADED SYSTEM COMMAND ; ; PRINT FAIL MESSAGE, WAIT FOR KEYPRESS, AND REBOOT ; FAIL INC $3F4 ; INVALIDATE POWER-UP BYTE - LDY #33 + LDY #31 - LDA FAILMSG,Y ORA #$80 JSR $FDED @@ -459,8 +480,8 @@ PAGE3 = * !PSEUDOPC $03D0 { BIT LCRDEN+LCBNK2 ; $03D0 - DIRECT INTERP ENTRY JMP DINTRP - BIT LCRDEN+LCBNK2 ; $03D6 - INDIRECT INTERP ENTRY - JMP IINTRP + BIT LCRDEN+LCBNK2 ; $03D6 - JIT INDIRECT INTERPX ENTRY + JMP JITINTRPX BIT LCRDEN+LCBNK2 ; $03DC - INDIRECT INTERPX ENTRY JMP IINTRPX } @@ -482,14 +503,97 @@ LCDEFCMD = *-28 ; DEFCMD IN LC MEMORY ;* * ;***************** !ALIGN 255,0 -OPXTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E - !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E - !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CSX ; 20 22 24 26 28 2A 2C 2E - !WORD DROP,DUP,NEXTOP,DIVMOD,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E - !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E - !WORD BRNCH,IBRNCH,CALLX,ICALX,ENTER,LEAVEX,RETX,CFFB ; 50 52 54 56 58 5A 5C 5E - !WORD LBX,LWX,LLBX,LLWX,LABX,LAWX,DLB,DLW ; 60 62 64 66 68 6A 6C 6E - !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E +OPXTBL !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06 08 0A 0C 0E + !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E + !WORD MINUS1,BREQ,BRNE,LA,LLA,CB,CW,CSX ; 20 22 24 26 28 2A 2C 2E + !WORD DROP,DROP2,DUP,DIVMOD,ADDI,SUBI,ANDI,ORI ; 30 32 34 36 38 3A 3C 3E + !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E + !WORD BRNCH,SEL,CALLX,ICALX,ENTER,LEAVEX,RETX,CFFB ; 50 52 54 56 58 5A 5C 5E + !WORD LBX,LWX,LLBX,LLWX,LABX,LAWX,DLB,DLW ; 60 62 64 66 68 6A 6C 6E + !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E + !WORD LNOT,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 80 82 84 86 88 8A 8C 8E + !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E + !WORD BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE + !WORD ADDLBX,ADDLWX,ADDABX,ADDAWX,IDXLBX,IDXLWX,IDXABX,IDXAWX ; B0 B2 B4 B6 B8 BA BC BE + !WORD NATV ; C0 +;* +;* JIT PROFILING ENTRY INTO INTERPRETER +;* +JITINTRPX PHP + PLA + STA PSR + SEI + PLA + SEC + SBC #$02 ; POINT TO DEF ENTRY + STA TMPL + PLA + SBC #$00 + STA TMPH + LDY #$05 + LDA (TMP),Y ; DEC JIT COUNT + DEC + STA (TMP),Y + BEQ RUNJIT + CLC ; SWITCH TO NATIVE MODE + XCE + +ACCMEM16 ; 16 BIT A/M + LDY #$3 ; INTERP BYTECODE AS USUAL + LDA (TMP),Y + STA IP + STX ESP + TSX + STX HWSP + STX ALTRDON + LDX #>OPXTBL +!IF DEBUG { +SETDBG LDY LCRWEN+LCBNK2 + LDY LCRWEN+LCBNK2 + STX DBG_OP+2 + LDY LCRDEN+LCBNK2 + LDX #>DBGTBL +} + STX OPPAGE + LDY #$00 + JMP FETCHOP +; + !AS +RUNJIT DEX ; ADD PARAMETER TO DEF ENTRY + LDA TMPL + PHA ; AND SAVE IT FOR LATER + STA ESTKL,X + LDA TMPH + PHA + STA ESTKH,X + CLC ; SWITCH TO NATIVE MODE + XCE + +ACCMEM16 ; 16 BIT A/M + LDA JITCOMP + STA SRC + LDY #$03 + LDA (SRC),Y + STA IP + STX ESP + TSX + STX HWSP + STX ALTRDON + LDX #>OPXTBL +!IF DEBUG { +SETDBG LDY LCRWEN+LCBNK2 + LDY LCRWEN+LCBNK2 + STX DBG_OP+2 + LDY LCRDEN+LCBNK2 + LDX #>DBGTBL +} + STX OPPAGE + LDY #$00 + JSR FETCHOP ; CALL JIT COMPILER + !AS + PLA + STA TMPH + PLA + STA TMPL + JMP (TMP) ; RE-CALL ORIGINAL DEF ENTRY ;********************************************************************* ;* ;* CODE BELOW HERE DEFAULTS TO NATIVE 16 BIT A/M, 8 BIT X,Y @@ -707,45 +811,64 @@ SHR PLA STA TOS,S + JMP NEXTOP ;* -;* LOGICAL AND -;* -LAND PLA - BEQ LAND1 - LDA TOS,S - BEQ LAND2 - LDA #$FFFF -LAND1 STA TOS,S -LAND2 JMP NEXTOP -;* -;* LOGICAL OR -;* -LOR PLA - ORA TOS,S - BEQ LOR1 - LDA #$FFFF - STA TOS,S -LOR1 JMP NEXTOP -;* ;* DUPLICATE TOS ;* DUP LDA TOS,S PHA JMP NEXTOP ;* +;* ADD IMMEDIATE TO TOS +;* +ADDI INY ;+INC_IP + LDA (IP),Y + AND #$00FF + CLC + ADC TOS,S + STA TOS,S + JMP NEXTOP +;* +;* SUB IMMEDIATE FROM TOS +;* +SUBI INY ;+INC_IP + LDA (IP),Y + AND #$00FF + EOR #$FFFF + SEC + ADC TOS,S + STA TOS,S + JMP NEXTOP +;* +;* AND IMMEDIATE TO TOS +;* +ANDI INY ;+INC_IP + LDA (IP),Y + AND #$00FF + AND TOS,S + STA TOS,S + JMP NEXTOP +;* +;* IOR IMMEDIATE TO TOS +;* +ORI INY ;+INC_IP + LDA (IP),Y + AND #$00FF + ORA TOS,S + STA TOS,S + JMP NEXTOP +;* ;* LOGICAL NOT ;* LNOT PLA - BNE ZERO - PEA $FFFF + BEQ MINUS1 + PEA $0000 JMP NEXTOP ;* -;* CONSTANT +;* CONSTANT -1, NYBBLE, BYTE, $FF BYTE, WORD (BELOW) ;* -ZERO PEA $0000 +MINUS1 PEA $FFFF JMP NEXTOP -CFFB INY ;+INC_IP - LDA (IP),Y - ORA #$FF00 +CN TXA + LSR ; A = CONST * 2 PHA JMP NEXTOP CB INY ;+INC_IP @@ -753,6 +876,11 @@ CB INY ;+INC_IP AND #$00FF PHA JMP NEXTOP +CFFB INY ;+INC_IP + LDA (IP),Y + ORA #$FF00 + PHA + JMP NEXTOP ;* ;* LOAD ADDRESS & LOAD CONSTANT WORD (SAME THING, WITH OR WITHOUT FIXUP) ;* @@ -780,7 +908,6 @@ CS ;INY ;+INC_IP LDA (IP) TAY JMP NEXTOP -; CSX ;INY ;+INC_IP TYA ; NORMALIZE IP SEC @@ -853,7 +980,6 @@ LW TYX STA TOS,S TXY JMP NEXTOP -; LBX TYX LDY #$00 TYA ; QUICKY CLEAR OUT MSB @@ -909,7 +1035,6 @@ LLW INY ;+INC_IP PHA TXY JMP NEXTOP -; LLBX INY ;+INC_IP TYX LDA (IP),Y @@ -932,6 +1057,108 @@ LLWX INY ;+INC_IP TXY JMP NEXTOP ;* +;* ADD VALUE FROM LOCAL FRAME OFFSET +;* +ADDLB INY ;+INC_IP + TYX + LDA (IP),Y + TAY + LDA (IFP),Y + AND #$00FF + TXY + CLC + ADC TOS,S + STA TOS,S + JMP NEXTOP +ADDLBX INY ;+INC_IP + TYX + LDA (IP),Y + TAY + STX ALTRDOFF + LDA (IFP),Y + STX ALTRDON + AND #$00FF + TXY + CLC + ADC TOS,S + STA TOS,S + JMP NEXTOP +ADDLW INY ;+INC_IP + TYX + LDA (IP),Y + TAY + LDA (IFP),Y + TXY + CLC + ADC TOS,S + STA TOS,S + JMP NEXTOP +ADDLWX INY ;+INC_IP + TYX + LDA (IP),Y + TAY + STX ALTRDOFF + LDA (IFP),Y + STX ALTRDON + TXY + CLC + ADC TOS,S + STA TOS,S + JMP NEXTOP +;* +;* INDEX VALUE FROM LOCAL FRAME OFFSET +;* +IDXLB INY ;+INC_IP + TYX + LDA (IP),Y + TAY + LDA (IFP),Y + AND #$00FF + TXY + ASL + CLC + ADC TOS,S + STA TOS,S + JMP NEXTOP +IDXLBX INY ;+INC_IP + TYX + LDA (IP),Y + TAY + STX ALTRDOFF + LDA (IFP),Y + STX ALTRDON + AND #$00FF + TXY + ASL + CLC + ADC TOS,S + STA TOS,S + JMP NEXTOP +IDXLW INY ;+INC_IP + TYX + LDA (IP),Y + TAY + LDA (IFP),Y + TXY + ASL + CLC + ADC TOS,S + STA TOS,S + JMP NEXTOP +IDXLWX INY ;+INC_IP + TYX + LDA (IP),Y + TAY + STX ALTRDOFF + LDA (IFP),Y + STX ALTRDON + TXY + ASL + CLC + ADC TOS,S + STA TOS,S + JMP NEXTOP +;* ;* LOAD VALUE FROM ABSOLUTE ADDRESS ;* LAB INY ;+INC_IP @@ -951,7 +1178,6 @@ LAW INY ;+INC_IP PHA INY ;+INC_IP JMP NEXTOP -; LABX INY ;+INC_IP LDA (IP),Y STA TMP @@ -973,7 +1199,108 @@ LAWX INY ;+INC_IP PHA INY ;+INC_IP JMP NEXTOP -; +;* +;* ADD VALUE FROM ABSOLUTE ADDRESS +;* +ADDAB INY ;+INC_IP + LDA (IP),Y + STA TMP + TYA ; QUICKY CLEAR OUT MSB + +ACCMEM8 ; 8 BIT A/M + LDA (TMP) + +ACCMEM16 ; 16 BIT A/M + INY ;+INC_IP + CLC + ADC TOS,S + STA TOS,S + JMP NEXTOP +ADDABX INY ;+INC_IP + LDA (IP),Y + STA TMP + TYA ; QUICKY CLEAR OUT MSB + STX ALTRDOFF + +ACCMEM8 ; 8 BIT A/M + LDA (TMP) + +ACCMEM16 ; 16 BIT A/M + STX ALTRDON + INY ;+INC_IP + CLC + ADC TOS,S + STA TOS,S + JMP NEXTOP +ADDAW INY ;+INC_IP + LDA (IP),Y + STA TMP + LDA (TMP) + INY ;+INC_IP + CLC + ADC TOS,S + STA TOS,S + JMP NEXTOP +ADDAWX INY ;+INC_IP + LDA (IP),Y + STA TMP + STX ALTRDOFF + LDA (TMP) + STX ALTRDON + INY ;+INC_IP + CLC + ADC TOS,S + STA TOS,S + JMP NEXTOP +;* +;* INDEX VALUE FROM ABSOLUTE ADDRESS +;* +IDXAB INY ;+INC_IP + LDA (IP),Y + STA TMP + TYA ; QUICKY CLEAR OUT MSB + +ACCMEM8 ; 8 BIT A/M + LDA (TMP) + +ACCMEM16 ; 16 BIT A/M + INY ;+INC_IP + ASL + CLC + ADC TOS,S + STA TOS,S + JMP NEXTOP +IDXABX INY ;+INC_IP + LDA (IP),Y + STA TMP + TYA ; QUICKY CLEAR OUT MSB + STX ALTRDOFF + +ACCMEM8 ; 8 BIT A/M + LDA (TMP) + +ACCMEM16 ; 16 BIT A/M + STX ALTRDON + INY ;+INC_IP + ASL + CLC + ADC TOS,S + STA TOS,S + JMP NEXTOP +IDXAW INY ;+INC_IP + LDA (IP),Y + STA TMP + LDA (TMP) + INY ;+INC_IP + ASL + CLC + ADC TOS,S + STA TOS,S + JMP NEXTOP +IDXAWX INY ;+INC_IP + LDA (IP),Y + STA TMP + STX ALTRDOFF + LDA (TMP) + STX ALTRDON + INY ;+INC_IP + ASL + CLC + ADC TOS,S + STA TOS,S + JMP NEXTOP ;* ;* STORE VALUE TO ADDRESS ;* @@ -991,7 +1318,10 @@ SW TYX LDA NOS,S STA (TOS,S),Y TXY - PLA +;* +;* DROP TOS, TOS-1 +;* +DROP2 PLA JMP DROP ;* ;* STORE VALUE TO LOCAL FRAME OFFSET @@ -1028,6 +1358,8 @@ DLB INY ;+INC_IP LDA TOS,S STA (IFP),Y +ACCMEM16 ; 16 BIT A/M + AND #$00FF + STA TOS,S TXY JMP NEXTOP DLW INY ;+INC_IP @@ -1070,6 +1402,8 @@ DAB INY ;+INC_IP LDA TOS,S STA (TMP) +ACCMEM16 ; 16 BIT A/M + AND #$00FF + STA TOS,S INY ;+INC_IP JMP NEXTOP DAW INY ;+INC_IP @@ -1088,14 +1422,12 @@ ISEQ PLA ISTRU LDA #$FFFF STA TOS,S JMP NEXTOP -; ISNE PLA CMP TOS,S BNE ISTRU ISFLS LDA #$0000 STA TOS,S JMP NEXTOP -; ISGE PLA SEC SBC TOS,S @@ -1106,7 +1438,6 @@ ISGE PLA + BMI ISFLS BEQ ISFLS BPL ISTRU -; ISGT PLA SEC SBC TOS,S @@ -1115,7 +1446,6 @@ ISGT PLA BPL ISFLS + BMI ISFLS BPL ISTRU -; ISLE PLA SEC SBC TOS,S @@ -1124,7 +1454,6 @@ ISLE PLA BMI ISFLS + BPL ISFLS BMI ISTRU -; ISLT PLA SEC SBC TOS,S @@ -1138,65 +1467,144 @@ ISLT PLA ;* ;* BRANCHES ;* +SEL TYA ; FLATTEN IP + SEC + ADC IP + INY ;+INC_IP + ;CLC ; ADD BRANCH OFFSET (BETTER NOT CARRY OUT OF IP+Y) + ADC (IP),Y + STA IP + LDY #$00 + LDA (IP),Y + TAX ; CASE COUNT + PLA + INC IP +CASELP CMP (IP),Y + BEQ + + BMI CASEEND ; CASE VALS IN ASCENDING ORDER, EXIT WHEN LESS + INY + INY + INY + DEX + BEQ FIXNEXT + INY + BNE CASELP + +ACCMEM8 ; 8 BIT A/M + INC IPH + +ACCMEM16 ; 16 BIT A/M + BRA CASELP ++ INY + BRA BRNCH +CASEEND TXA ; SKIP REMAINING CASES + ASL + ASL + DEC +; CLC + ADC IP + STA IP +FIXNEXT TYA + LDY #$00 + SEC + ADC IP + STA IP + JMP FETCHOP +BRAND LDA TOS,S + BEQ BRNCH + PLA ; DROP LEFT HALF OF AND + BRA NOBRNCH +BROR LDA TOS,S + BNE BRNCH + PLA ; DROP LEFT HALF OF OR + BRA NOBRNCH +BREQ PLA + CMP TOS,S + BNE + + PLA + BRA BRNCH +BRNE PLA + CMP TOS,S + BEQ + + PLA + BRA BRNCH ++ PLA + BRA NOBRNCH BRTRU PLA BNE BRNCH NOBRNCH INY ;+INC_IP INY BMI FIXNEXT JMP NEXTOP -FIXNEXT TYA - SEC - ADC IP - STA IP - LDY #$00 - JMP FETCHOP BRFLS PLA BNE NOBRNCH BRNCH TYA ; FLATTEN IP - CLC + SEC ADC IP INY ;+INC_IP ;CLC ; ADD BRANCH OFFSET (BETTER NOT CARRY OUT OF IP+Y) ADC (IP),Y STA IP - LDY #$01 + LDY #$00 JMP FETCHOP -BREQ PLA - CMP TOS,S - BEQ BRNCH - BNE NOBRNCH -BRNE PLA - CMP TOS,S - BNE BRNCH - BEQ NOBRNCH -BRGT PLA +;* +;* FOR LOOPS PUT TERMINAL VALUE AT ESTK+1 AND CURRENT COUNT ON ESTK +;* +BRGT LDA NOS,S SEC SBC TOS,S BVS + BPL NOBRNCH - BMI BRNCH -+ BMI NOBRNCH - BPL BRNCH -BRLT PLA - SEC - SBC TOS,S - BVS + - BMI NOBRNCH - BEQ NOBRNCH - BPL BRNCH -+ BMI BRNCH - BEQ BRNCH - BPL NOBRNCH -IBRNCH TYA ; FLATTEN IP - CLC - ADC IP - STA IP + PLA ; DROP FOR VALUES PLA - ;CLC ; ADD BRANCH OFFSET (BETTER NOT CARRY OUT OF IP+Y) - ADC IP - STA IP - LDY #$01 - JMP FETCHOP + BRA BRNCH ; BMI BRNCH +BRLT LDA TOS,S + SEC + SBC NOS,S + BVS + + BPL NOBRNCH + PLA ; DROP FOR VALUES + PLA + BRA BRNCH ; BMI BRNCH ++ BMI NOBRNCH + PLA ; DROP FOR VALUES + PLA + BRA BRNCH ; BMI BRNCH +DECBRGE LDA TOS,S + DEC + STA TOS,S +_BRGE LDA TOS,S + SEC + SBC NOS,S + BVS + + BPL BRNCH + PLA ; DROP FOR VALUES + PLA + BRA NOBRNCH ; BMI NOBRNCH +INCBRLE LDA TOS,S + INC + STA TOS,S +_BRLE LDA NOS,S + SEC + SBC TOS,S + BVS + + BPL BRNCH + PLA ; DROP FOR VALUES + PLA + BNE NOBRNCH ; BMI NOBRNCH ++ BMI BRNCH + PLA ; DROP FOR VALUES + PLA + BRA NOBRNCH ; BMI NOBRNCH +SUBBRGE LDA NOS,S + SEC + SBC TOS,S + STA NOS,S + PLA + BRA _BRGE +ADDBRLE PLA + CLC + ADC TOS,S + STA TOS,S + BRA _BRLE ;* ;* INDIRECT CALL TO ADDRESS (NATIVE CODE) ;* @@ -1210,7 +1618,7 @@ CALL INY ;+INC_IP INY EMUSTK STA TMP TYA ; FLATTEN IP - CLC + SEC ADC IP STA IP SEC ; SWITCH TO EMULATED MODE @@ -1306,7 +1714,7 @@ EMUSTK STA TMP LDX #>DBGTBL } STX OPPAGE - LDY #$01 + LDY #$00 JMP FETCHOP ;* ;* INDIRECT CALL TO ADDRESS (NATIVE CODE) @@ -1321,7 +1729,7 @@ CALLX INY ;+INC_IP INY EMUSTKX STA TMP TYA ; FLATTEN IP - CLC + SEC ADC IP STA IP SEC ; SWITCH TO EMULATION MODE @@ -1419,7 +1827,7 @@ EMUSTKX STA TMP LDX #>DBGTBL } STX OPPAGE - LDY #$01 + LDY #$00 JMP FETCHOP ;* ;* JUMP INDIRECT THROUGH TMP @@ -1511,7 +1919,7 @@ LEAVEX INY ;+INC_IP BEQ + LDX #$80+'L' STX $7D0+30 -- LDX $C000 +- LDX $C000 BPL - LDX $C010 + @@ -1533,7 +1941,6 @@ LEAVEX INY ;+INC_IP PLP RTS !AL -; RETX STX ALTRDOFF RET SEC ; SWITCH TO EMULATION MODE XCE @@ -1571,7 +1978,7 @@ RET SEC ; SWITCH TO EMULATION MODE BEQ + LDX #$80+'X' STX $7D0+30 -- LDX $C000 +- LDX $C000 BPL - LDX $C010 + @@ -1581,6 +1988,59 @@ RET SEC ; SWITCH TO EMULATION MODE PHA PLP RTS +;* +;* RETURN TO NATIVE CODE +;* +NATV TYA ; FLATTEN IP + SEC + ADC IP + STA IP + SEC ; SWITCH TO EMULATION MODE + XCE + !AS + ;+ACCMEM8 ; 8 BIT A/M + TSC ; MOVE HW EVAL STACK TO ZP EVAL STACK + EOR #$FF + SEC + ADC HWSP ; STACK DEPTH = (HWSP - SP)/2 + LSR +!IF DEBUG { + PHA + CLC + ADC #$80+'0' + STA $7D0+31 + PLA +} + EOR #$FF + SEC + ADC ESP ; ESP - STACK DEPTH + TAX + CPX ESP + BEQ ++ + TAY +- PLA + STA ESTKL,X + PLA + STA ESTKH,X + INX + CPX ESP + BNE - +!IF DEBUG { + TSX + CPX HWSP + BEQ + + LDX #$80+'V' + STX $7D0+30 +- LDX $C000 + BPL - + LDX $C010 ++ +} + TYX +++ LDA PSR + PHA + PLP + JMP (IP) !IF DEBUG { ;***************** ;* * @@ -1596,6 +2056,11 @@ DBGTBL !WORD STEP,STEP,STEP,STEP,STEP,STEP,STEP,STEP ; 00 02 04 06 08 !WORD STEP,STEP,STEP,STEP,STEP,STEP,STEP,STEP ; 50 52 54 56 58 5A 5C 5E !WORD STEP,STEP,STEP,STEP,STEP,STEP,STEP,STEP ; 60 62 64 66 68 6A 6C 6E !WORD STEP,STEP,STEP,STEP,STEP,STEP,STEP,STEP ; 70 72 74 76 78 7A 7C 7E + !WORD STEP,STEP,STEP,STEP,STEP,STEP,STEP,STEP ; 80 82 84 86 88 8A 8C 8E + !WORD STEP,STEP,STEP,STEP,STEP,STEP,STEP,STEP ; 90 92 94 96 98 9A 9C 9E + !WORD STEP,STEP,STEP,STEP,STEP,STEP,STEP,STEP ; A0 A2 A4 A6 A8 AA AC AE + !WORD STEP,STEP,STEP,STEP,STEP,STEP,STEP,STEP ; B0 B2 B4 B6 B8 BA BC BE + !WORD STEP ; C0 ;* ;* DEBUG PRINT ROUTINES ;* @@ -1755,8 +2220,8 @@ STEP STX TMPL CMP #$10 BCC DBGKEY LDX TMPL - CPX #$00 ; FORCE PAUSE AT 'ZERO' - BEQ DBGKEY +; CPX #$00 ; FORCE PAUSE AT 'ZERO' +; BEQ DBGKEY - LDX $C000 CPX #$9B BNE + diff --git a/src/vmsrc/apple/plvmjit02.s b/src/vmsrc/apple/plvmjit02.s new file mode 100755 index 0000000..f0d57f8 --- /dev/null +++ b/src/vmsrc/apple/plvmjit02.s @@ -0,0 +1,2411 @@ +;********************************************************** +;* +;* APPLE ][ 64K/128K PLASMA INTERPRETER +;* +;* SYSTEM ROUTINES AND LOCATIONS +;* +;********************************************************** + !CPU 65C02 +;* +;* MONITOR SPECIAL LOCATIONS +;* +CSWL = $36 +CSWH = $37 +PROMPT = $33 +;* +;* PRODOS +;* +PRODOS = $BF00 +DEVCNT = $BF31 ; GLOBAL PAGE DEVICE COUNT +DEVLST = $BF32 ; GLOBAL PAGE DEVICE LIST +MACHID = $BF98 ; GLOBAL PAGE MACHINE ID BYTE +RAMSLOT = $BF26 ; SLOT 3, DRIVE 2 IS /RAM'S DRIVER VECTOR +NODEV = $BF10 +;* +;* HARDWARE ADDRESSES +;* +KEYBD = $C000 +CLRKBD = $C010 +SPKR = $C030 +LCRDEN = $C080 +LCWTEN = $C081 +ROMEN = $C082 +LCRWEN = $C083 +LCBNK2 = $00 +LCBNK1 = $08 +ALTZPOFF= $C008 +ALTZPON = $C009 +ALTRDOFF= $C002 +ALTRDON = $C003 +ALTWROFF= $C004 +ALTWRON = $C005 + !SOURCE "vmsrc/plvmzp.inc" +PSR = TMP+2 +DVSIGN = PSR+1 +DROP = $EF +NEXTOP = $F0 +FETCHOP = NEXTOP+1 +IP = FETCHOP+1 +IPL = IP +IPH = IPL+1 +OPIDX = FETCHOP+6 +OPPAGE = OPIDX+1 +STRBUF = $0280 +JITMOD = $02E0 +INTERP = $03D0 +JITCOMP = $03E2 +JITCODE = $03E4 +;****************************** +;* * +;* INTERPRETER INITIALIZATION * +;* * +;****************************** +* = $2000 + LDX #$FE + TXS + LDX #$00 + STX $01FF +;* +;* MUST HAVE 128K FOR JIT +;* ++ LDA MACHID + AND #$30 + CMP #$30 + BEQ ++ + LDY #$00 +- LDA NEEDAUX,Y + BEQ + + ORA #$80 + JSR $FDED + INY + BNE - ++ LDA $C000 + BPL - + LDA $C010 + JSR PRODOS + !BYTE $65 + !WORD BYEPARMS +BYEPARMS !BYTE 4 + !BYTE 4 + !WORD 0 + !BYTE 0 + !WORD 0 +NEEDAUX !TEXT "128K MEMORY REQUIRED.", 13 + !TEXT "PRESS ANY KEY...", 0 +;* +;* DISCONNECT /RAM +;* +++ ;SEI ; DISABLE /RAM + LDA RAMSLOT + CMP NODEV + BNE RAMCONT + LDA RAMSLOT+1 + CMP NODEV+1 + BEQ RAMDONE +RAMCONT LDY DEVCNT +RAMLOOP LDA DEVLST,Y + AND #$F3 + CMP #$B3 + BEQ GETLOOP + DEY + BPL RAMLOOP + BMI RAMDONE +GETLOOP LDA DEVLST+1,Y + STA DEVLST,Y + BEQ RAMEXIT + INY + BNE GETLOOP +RAMEXIT LDA NODEV + STA RAMSLOT + LDA NODEV+1 + STA RAMSLOT+1 + DEC DEVCNT +RAMDONE ;CLI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE +;* +;* MOVE VM INTO LANGUAGE CARD +;* + BIT LCRWEN+LCBNK2 + BIT LCRWEN+LCBNK2 + LDA #VMCORE + STA SRCH + LDY #$00 + STY DSTL + LDA #$D0 + STA DSTH +- LDA (SRC),Y ; COPY VM+CMD INTO LANGUAGE CARD + STA (DST),Y + INY + BNE - + INC SRCH + INC DSTH + LDA DSTH + CMP #$E0 + BNE - +;* +;* MOVE FIRST PAGE OF 'BYE' INTO PLACE +;* + STY SRCL + LDA #$D1 + STA SRCH +- LDA (SRC),Y + STA $1000,Y + INY + BNE - +;* +;* INSERT 65C02 OPS IF APPLICABLE +;* + LDA #$00 + INC + BEQ + + JSR C02OPS +;* +;* SAVE DEFAULT COMMAND INTERPRETER PATH IN LC +;* ++ JSR PRODOS ; GET PREFIX + !BYTE $C7 + !WORD GETPFXPARMS + LDY STRBUF ; APPEND "CMDJIT" + LDA #"/" + CMP STRBUF,Y + BEQ + + INY + STA STRBUF,Y ++ LDA #"C" + INY + STA STRBUF,Y + LDA #"M" + INY + STA STRBUF,Y + LDA #"D" + INY + STA STRBUF,Y + LDA #"J" + INY + STA STRBUF,Y + LDA #"I" + INY + STA STRBUF,Y + LDA #"T" + INY + STA STRBUF,Y + STY STRBUF + BIT LCRWEN+LCBNK2 ; COPY TO LC FOR BYE + BIT LCRWEN+LCBNK2 +- LDA STRBUF,Y + STA LCDEFCMD,Y + DEY + BPL - + JMP CMDENTRY +GETPFXPARMS !BYTE 1 + !WORD STRBUF ; PATH STRING GOES HERE +;************************************************ +;* * +;* LANGUAGE CARD RESIDENT PLASMA VM STARTS HERE * +;* * +;************************************************ +VMCORE = * + !PSEUDOPC $D000 { +;**************** +;* * +;* OPCODE TABLE * +;* * +;**************** + !ALIGN 255,0 +OPTBL !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06 08 0A 0C 0E + !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E + !WORD MINUS1,BREQ,BRNE,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E + !WORD DROP,DROP2,DUP,DIVMOD,ADDI,SUBI,ANDI,ORI ; 30 32 34 36 38 3A 3C 3E + !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E + !WORD BRNCH,SEL,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E + !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E + !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E + !WORD LNOT,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 80 82 84 86 88 8A 8C 8E + !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E + !WORD BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE + !WORD ADDLB,ADDLW,ADDAB,ADDAW,IDXLB,IDXLW,IDXAB,IDXAW ; B0 B2 B4 B6 B8 BA BC BE + !WORD NATV ; C0 +;* +;* DIRECTLY ENTER INTO BYTECODE INTERPRETER +;* +DINTRP PLA + CLC + ADC #$01 + STA IPL + PLA + ADC #$00 + STA IPH + LDY #$00 + LDA #>OPTBL + STA OPPAGE + JMP FETCHOP +;* +;* INDIRECTLY ENTER INTO BYTECODE INTERPRETER +;* +IINTRPX PHP + PLA + STA PSR + SEI + PLA + STA TMPL + PLA + STA TMPH + LDY #$02 + LDA (TMP),Y + STA IPH + DEY + LDA (TMP),Y + STA IPL + DEY + LDA #>OPXTBL + STA OPPAGE + STA ALTRDON + JMP FETCHOP +;************************************************************ +;* * +;* 'BYE' PROCESSING - COPIED TO $1000 ON PRODOS BYE COMMAND * +;* * +;************************************************************ + !ALIGN 255,0 + !PSEUDOPC $1000 { +BYE LDY DEFCMD +- LDA DEFCMD,Y ; SET DEFAULT COMMAND WHEN CALLED FROM 'BYE' + STA STRBUF,Y + DEY + BPL - +; INY ; CLEAR CMDLINE BUFF +; STY $01FF +CMDENTRY = * +; +; SET DCI STRING FOR JIT MODULE +; + LDA #'J'|$80 + STA JITMOD+0 + LDA #'I'|$80 + STA JITMOD+1 + LDA #'T' + STA JITMOD+2 +; +; DEACTIVATE 80 COL CARDS +; + BIT ROMEN + LDY #4 +- LDA DISABLE80,Y + ORA #$80 + JSR $FDED + DEY + BPL - + BIT $C054 ; SET TEXT MODE + BIT $C051 + BIT $C05F + JSR $FC58 ; HOME +; +; INSTALL PAGE 0 FETCHOP ROUTINE +; + LDY #$0F +- LDA PAGE0,Y + STA DROP,Y + DEY + BPL - +; +; SET JMPTMP OPCODE +; + LDA #$4C + STA JMPTMP +; +; INSTALL PAGE 3 VECTORS +; + LDY #$16 +- LDA PAGE3,Y + STA INTERP,Y + DEY + BPL - +; +; READ CMD INTO MEMORY +; + JSR PRODOS ; CLOSE EVERYTHING + !BYTE $CC + !WORD CLOSEPARMS + BNE FAIL + JSR PRODOS ; OPEN CMD + !BYTE $C8 + !WORD OPENPARMS + BNE FAIL + LDA REFNUM + STA READPARMS+1 + JSR PRODOS + !BYTE $CA + !WORD READPARMS + BNE FAIL + JSR PRODOS + !BYTE $CC + !WORD CLOSEPARMS + BNE FAIL +; +; INIT VM ENVIRONMENT STACK POINTERS +; +; LDA #$00 + STA $01FF ; CLEAR CMDLINE BUFF + STA PPL ; INIT FRAME POINTER + STA IFPL + LDA #$AF ; FRAME POINTER AT $AF00, BELOW JIT BUFFER + STA PPH + STA IFPH + LDX #$FE ; INIT STACK POINTER (YES, $FE. SEE GETS) + TXS + LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX +; +; CHANGE CMD STRING TO SYSPATH STRING +; + LDA STRBUF + SEC + SBC #$06 + STA STRBUF + JMP $2000 ; JUMP TO LOADED SYSTEM COMMAND +; +; PRINT FAIL MESSAGE, WAIT FOR KEYPRESS, AND REBOOT +; +FAIL INC $3F4 ; INVALIDATE POWER-UP BYTE + LDY #11 +- LDA FAILMSG,Y + ORA #$80 + JSR $FDED + DEY + BPL - + JSR $FD0C ; WAIT FOR KEYPRESS + JMP ($FFFC) ; RESET +OPENPARMS !BYTE 3 + !WORD STRBUF + !WORD $0800 +REFNUM !BYTE 0 +READPARMS !BYTE 4 + !BYTE 0 + !WORD $2000 + !WORD $9F00 + !WORD 0 +CLOSEPARMS !BYTE 1 + !BYTE 0 +DISABLE80 !BYTE 21, 13, '1', 26, 13 +FAILMSG !TEXT ".DMC GNISSIM" +PAGE0 = * +;****************************** +;* * +;* INTERP BYTECODE INNER LOOP * +;* * +;****************************** + !PSEUDOPC DROP { + INX ; DROP @ $EF + INY ; NEXTOP @ $F0 + LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4 + STA OPIDX + JMP (OPTBL) ; OPIDX AND OPPAGE MAP OVER OPTBL +} +PAGE3 = * +;* +;* PAGE 3 VECTORS INTO INTERPRETER +;* + !PSEUDOPC $03D0 { + BIT LCRDEN+LCBNK2 ; $03D0 - BYTECODE DIRECT INTERP ENTRY + JMP DINTRP + BIT LCRDEN+LCBNK2 ; $03D6 - JIT INDIRECT INTERPX ENTRY + JMP JITINTRPX + BIT LCRDEN+LCBNK2 ; $03DC - BYTECODE INDIRECT INTERPX ENTRY + JMP IINTRPX +} +DEFCMD = * ;!FILL 28 +ENDBYE = * +} +LCDEFCMD = * ;*-28 ; DEFCMD IN LC MEMORY +;***************** +;* * +;* OPXCODE TABLE * +;* * +;***************** + !ALIGN 255,0 +OPXTBL !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06 08 0A 0C 0E + !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E + !WORD MINUS1,BREQ,BRNE,LA,LLA,CB,CW,CSX ; 20 22 24 26 28 2A 2C 2E + !WORD DROP,DROP2,DUP,DIVMOD,ADDI,SUBI,ANDI,ORI ; 30 32 34 36 38 3A 3C 3E + !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E + !WORD BRNCH,SEL,CALLX,ICALX,ENTER,LEAVEX,RETX,CFFB ; 50 52 54 56 58 5A 5C 5E + !WORD LBX,LWX,LLBX,LLWX,LABX,LAWX,DLB,DLW ; 60 62 64 66 68 6A 6C 6E + !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E + !WORD LNOT,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 80 82 84 86 88 8A 8C 8E + !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E + !WORD BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE + !WORD ADDLBX,ADDLWX,ADDABX,ADDAWX,IDXLBX,IDXLWX,IDXABX,IDXAWX ; B0 B2 B4 B6 B8 BA BC BE + !WORD NATV ; C0 +;* +;* JIT PROFILING ENTRY INTO INTERPRETER +;* +JITINTRPX PHP + PLA + STA PSR + SEI + PLA + SEC + SBC #$02 ; POINT TO DEF ENTRY + STA TMPL + PLA + SBC #$00 + STA TMPH + LDY #$05 + LDA (TMP),Y ; DEC JIT COUNT + SEC + SBC #$01 + STA (TMP),Y + BEQ RUNJIT + DEY ; INTERP BYTECODE AS USUAL + LDA (TMP),Y + STA IPH + DEY + LDA (TMP),Y + STA IPL + LDY #$00 + LDA #>OPXTBL + STA OPPAGE + STA ALTRDON + JMP FETCHOP +RUNJIT LDA JITCOMP + STA SRCL + LDA JITCOMP+1 + STA SRCH + DEY ; LDY #$04 + LDA (SRC),Y + STA IPH + DEY + LDA (SRC),Y + STA IPL + DEX ; ADD PARAMETER TO DEF ENTRY + LDA TMPL + PHA ; AND SAVE IT FOR LATER + STA ESTKL,X + LDA TMPH + PHA + STA ESTKH,X + LDY #$00 + LDA #>OPXTBL + STA OPPAGE + STA ALTRDON + JSR FETCHOP ; CALL JIT COMPILER + PLA + STA TMPH + PLA + STA TMPL + JMP (TMP) ; RE-CALL ORIGINAL DEF ENTRY +;* +;* ADD TOS TO TOS-1 +;* +ADD LDA ESTKL,X + CLC + ADC ESTKL+1,X + STA ESTKL+1,X + LDA ESTKH,X + ADC ESTKH+1,X + STA ESTKH+1,X + JMP DROP +;* +;* SUB TOS FROM TOS-1 +;* +SUB LDA ESTKL+1,X + SEC + SBC ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + SBC ESTKH,X + STA ESTKH+1,X + JMP DROP +;* +;* SHIFT TOS LEFT BY 1, ADD TO TOS-1 +;* +IDXW LDA ESTKL,X + ASL + ROL ESTKH,X + CLC + ADC ESTKL+1,X + STA ESTKL+1,X + LDA ESTKH,X + ADC ESTKH+1,X + STA ESTKH+1,X + JMP DROP +;* +;* MUL TOS-1 BY TOS +;* +MUL STY IPY + LDY #$10 + LDA ESTKL+1,X + EOR #$FF + STA TMPL + LDA ESTKH+1,X + EOR #$FF + STA TMPH + LDA #$00 + STA ESTKL+1,X ; PRODL +; STA ESTKH+1,X ; PRODH +_MULLP LSR TMPH ; MULTPLRH + ROR TMPL ; MULTPLRL + BCS + + STA ESTKH+1,X ; PRODH + LDA ESTKL,X ; MULTPLNDL + ADC ESTKL+1,X ; PRODL + STA ESTKL+1,X + LDA ESTKH,X ; MULTPLNDH + ADC ESTKH+1,X ; PRODH ++ ASL ESTKL,X ; MULTPLNDL + ROL ESTKH,X ; MULTPLNDH + DEY + BNE _MULLP + STA ESTKH+1,X ; PRODH + LDY IPY + JMP DROP +;* +;* INTERNAL DIVIDE ALGORITHM +;* +_NEG LDA #$00 + SEC + SBC ESTKL,X + STA ESTKL,X + LDA #$00 + SBC ESTKH,X + STA ESTKH,X + RTS +_DIV STY IPY + LDY #$11 ; #BITS+1 + LDA #$00 + STA TMPL ; REMNDRL + STA TMPH ; REMNDRH + STA DVSIGN + LDA ESTKH+1,X + BPL + + INX + JSR _NEG + DEX + LDA #$81 + STA DVSIGN ++ ORA ESTKL+1,X ; DVDNDL + BEQ _DIVEX + LDA ESTKH,X + BPL _DIV1 + JSR _NEG + INC DVSIGN +_DIV1 ASL ESTKL+1,X ; DVDNDL + ROL ESTKH+1,X ; DVDNDH + DEY + BCC _DIV1 +_DIVLP ROL TMPL ; REMNDRL + ROL TMPH ; REMNDRH + LDA TMPL ; REMNDRL + CMP ESTKL,X ; DVSRL + LDA TMPH ; REMNDRH + SBC ESTKH,X ; DVSRH + BCC + + STA TMPH ; REMNDRH + LDA TMPL ; REMNDRL + SBC ESTKL,X ; DVSRL + STA TMPL ; REMNDRL + SEC ++ ROL ESTKL+1,X ; DVDNDL + ROL ESTKH+1,X ; DVDNDH + DEY + BNE _DIVLP +_DIVEX INX + LDY IPY + RTS +;* +;* NEGATE TOS +;* +NEG LDA #$00 + SEC + SBC ESTKL,X + STA ESTKL,X + LDA #$00 + SBC ESTKH,X + STA ESTKH,X + JMP NEXTOP +;* +;* DIV TOS-1 BY TOS +;* +DIV JSR _DIV + LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1 + BCS NEG + JMP NEXTOP +;* +;* MOD TOS-1 BY TOS +;* +MOD JSR _DIV + LDA TMPL ; REMNDRL + STA ESTKL,X + LDA TMPH ; REMNDRH + STA ESTKH,X + LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND + BMI NEG + JMP NEXTOP +;* +;* DIVMOD TOS-1 BY TOS +;* +DIVMOD JSR _DIV + LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1 + BCC + + JSR _NEG ++ DEX + LDA TMPL ; REMNDRL + STA ESTKL,X + LDA TMPH ; REMNDRH + STA ESTKH,X + ASL DVSIGN ; REMAINDER IS SIGN OF DIVIDEND + BMI NEG + JMP NEXTOP +;* +;* INCREMENT TOS +;* +INCR INC ESTKL,X + BEQ + + JMP NEXTOP ++ INC ESTKH,X + JMP NEXTOP +;* +;* DECREMENT TOS +;* +DECR LDA ESTKL,X + BEQ + + DEC ESTKL,X + JMP NEXTOP ++ DEC ESTKL,X + DEC ESTKH,X + JMP NEXTOP +;* +;* BITWISE COMPLIMENT TOS +;* +COMP LDA #$FF + EOR ESTKL,X + STA ESTKL,X + LDA #$FF + EOR ESTKH,X + STA ESTKH,X + JMP NEXTOP +;* +;* BITWISE AND TOS TO TOS-1 +;* +BAND LDA ESTKL+1,X + AND ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + AND ESTKH,X + STA ESTKH+1,X + JMP DROP +;* +;* INCLUSIVE OR TOS TO TOS-1 +;* +IOR LDA ESTKL+1,X + ORA ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + ORA ESTKH,X + STA ESTKH+1,X + JMP DROP +;* +;* EXLUSIVE OR TOS TO TOS-1 +;* +XOR LDA ESTKL+1,X + EOR ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + EOR ESTKH,X + STA ESTKH+1,X + JMP DROP +;* +;* SHIFT TOS-1 LEFT BY TOS +;* +SHL STY IPY + LDA ESTKL,X + CMP #$08 + BCC + + LDY ESTKL+1,X + STY ESTKH+1,X + LDY #$00 + STY ESTKL+1,X + SBC #$08 ++ TAY + BEQ + + LDA ESTKL+1,X +- ASL + ROL ESTKH+1,X + DEY + BNE - + STA ESTKL+1,X ++ LDY IPY + JMP DROP +;* +;* SHIFT TOS-1 RIGHT BY TOS +;* +SHR STY IPY + LDA ESTKL,X + CMP #$08 + BCC ++ + LDY ESTKH+1,X + STY ESTKL+1,X + CPY #$80 + LDY #$00 + BCC + + DEY ++ STY ESTKH+1,X + SEC + SBC #$08 +++ TAY + BEQ + + LDA ESTKH+1,X +- CMP #$80 + ROR + ROR ESTKL+1,X + DEY + BNE - + STA ESTKH+1,X ++ LDY IPY + JMP DROP +;* +;* DUPLICATE TOS +;* +DUP DEX + LDA ESTKL+1,X + STA ESTKL,X + LDA ESTKH+1,X + STA ESTKH,X + JMP NEXTOP +;* +;* ADD IMMEDIATE TO TOS +;* +ADDI INY ;+INC_IP + LDA (IP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ JMP NEXTOP +;* +;* SUB IMMEDIATE FROM TOS +;* +SUBI INY ;+INC_IP + LDA ESTKL,X + SEC + SBC (IP),Y + STA ESTKL,X + BCS + + DEC ESTKH,X ++ JMP NEXTOP +;* +;* AND IMMEDIATE TO TOS +;* +ANDI INY ;+INC_IP + LDA (IP),Y + AND ESTKL,X + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +;* +;* IOR IMMEDIATE TO TOS +;* +ORI INY ;+INC_IP + LDA (IP),Y + ORA ESTKL,X + STA ESTKL,X + JMP NEXTOP +;* +;* LOGICAL NOT +;* +LNOT LDA ESTKL,X + ORA ESTKH,X + BEQ + + LDA #$00 + STA ESTKL,X + STA ESTKH,X + JMP NEXTOP +;* +;* CONSTANT -1, NYBBLE, BYTE, $FF BYTE, WORD (BELOW) +;* +MINUS1 DEX ++ LDA #$FF + STA ESTKL,X + STA ESTKH,X + JMP NEXTOP +CN DEX + LSR ; A = CONST * 2 + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +CB DEX + LDA #$00 + STA ESTKH,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKL,X + JMP NEXTOP +CFFB DEX + LDA #$FF + STA ESTKH,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKL,X + JMP NEXTOP +;* +;* LOAD ADDRESS & LOAD CONSTANT WORD (SAME THING, WITH OR WITHOUT FIXUP) +;* +- TYA ; RENORMALIZE IP + CLC + ADC IPL + STA IPL + BCC + + INC IPH ++ LDY #$FF +LA INY ;+INC_IP + BMI - + DEX + LDA (IP),Y + STA ESTKL,X + INY + LDA (IP),Y + STA ESTKH,X + JMP NEXTOP +CW DEX + INY ;+INC_IP + LDA (IP),Y + STA ESTKL,X + INY + LDA (IP),Y + STA ESTKH,X + JMP NEXTOP +;* +;* CONSTANT STRING +;* +CS DEX + ;INY ;+INC_IP + TYA ; NORMALIZE IP AND SAVE STRING ADDR ON ESTK + SEC + ADC IPL + STA IPL + STA ESTKL,X + LDA #$00 + TAY + ADC IPH + STA IPH + STA ESTKH,X + LDA (IP),Y + TAY + JMP NEXTOP +CSX DEX + ;INY ;+INC_IP + TYA ; NORMALIZE IP + SEC + ADC IPL + STA IPL + LDA #$00 + TAY + ADC IPH + STA IPH + LDA PPL ; SCAN POOL FOR STRING ALREADY THERE + STA TMPL + LDA PPH + STA TMPH +_CMPPSX ;LDA TMPH ; CHECK FOR END OF POOL + CMP IFPH + BCC _CMPSX ; CHECK FOR MATCHING STRING + BNE _CPYSX ; BEYOND END OF POOL, COPY STRING OVER + LDA TMPL + CMP IFPL + BCS _CPYSX ; AT OR BEYOND END OF POOL, COPY STRING OVER +_CMPSX STA ALTRDOFF + LDA (TMP),Y ; COMPARE STRINGS FROM AUX MEM TO STRINGS IN MAIN MEM + STA ALTRDON + CMP (IP),Y ; COMPARE STRING LENGTHS + BNE _CNXTSX1 + TAY +_CMPCSX STA ALTRDOFF + LDA (TMP),Y ; COMPARE STRING CHARS FROM END + STA ALTRDON + CMP (IP),Y + BNE _CNXTSX + DEY + BNE _CMPCSX + LDA TMPL ; MATCH - SAVE EXISTING ADDR ON ESTK AND MOVE ON + STA ESTKL,X + LDA TMPH + STA ESTKH,X + BNE _CEXSX +_CNXTSX LDY #$00 + STA ALTRDOFF + LDA (TMP),Y + STA ALTRDON +_CNXTSX1 SEC + ADC TMPL + STA TMPL + LDA #$00 + ADC TMPH + STA TMPH + BNE _CMPPSX +_CPYSX LDA (IP),Y ; COPY STRING FROM AUX TO MAIN MEM POOL + TAY ; MAKE ROOM IN POOL AND SAVE ADDR ON ESTK + EOR #$FF + CLC + ADC PPL + STA PPL + STA ESTKL,X + LDA #$FF + ADC PPH + STA PPH + STA ESTKH,X ; COPY STRING FROM AUX MEM BYTECODE TO MAIN MEM POOL +_CPYSX1 LDA (IP),Y ; ALTRD IS ON, NO NEED TO CHANGE IT HERE + STA (PP),Y ; ALTWR IS OFF, NO NEED TO CHANGE IT HERE + DEY + CPY #$FF + BNE _CPYSX1 + INY +_CEXSX LDA (IP),Y ; SKIP TO NEXT OP ADDR AFTER STRING + TAY + JMP NEXTOP +;* +;* LOAD VALUE FROM ADDRESS TAG +;* +LB LDA ESTKL,X + STA ESTKH-1,X + LDA (ESTKH-1,X) + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +LW LDA ESTKL,X + STA ESTKH-1,X + LDA (ESTKH-1,X) + STA ESTKL,X + INC ESTKH-1,X + BEQ + + LDA (ESTKH-1,X) + STA ESTKH,X + JMP NEXTOP ++ INC ESTKH,X + LDA (ESTKH-1,X) + STA ESTKH,X + JMP NEXTOP +LBX LDA ESTKL,X + STA ESTKH-1,X + STA ALTRDOFF + LDA (ESTKH-1,X) + STA ESTKL,X + LDA #$00 + STA ESTKH,X + STA ALTRDON + JMP NEXTOP +LWX LDA ESTKL,X + STA ESTKH-1,X + STA ALTRDOFF + LDA (ESTKH-1,X) + STA ESTKL,X + INC ESTKH-1,X + BEQ + + LDA (ESTKH-1,X) + STA ESTKH,X + STA ALTRDON + JMP NEXTOP ++ INC ESTKH,X + LDA (ESTKH-1,X) + STA ESTKH,X + STA ALTRDON + JMP NEXTOP +;* +;* LOAD ADDRESS OF LOCAL FRAME OFFSET +;* +- TYA ; RENORMALIZE IP + CLC + ADC IPL + STA IPL + BCC + + INC IPH ++ LDY #$FF +LLA INY ;+INC_IP + BMI - + LDA (IP),Y + DEX + CLC + ADC IFPL + STA ESTKL,X + LDA #$00 + ADC IFPH + STA ESTKH,X + JMP NEXTOP +;* +;* LOAD VALUE FROM LOCAL FRAME OFFSET +;* +LLB INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + LDA (IFP),Y + STA ESTKL,X + LDA #$00 + STA ESTKH,X + LDY IPY + JMP NEXTOP +LLW INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + LDA (IFP),Y + STA ESTKL,X + INY + LDA (IFP),Y + STA ESTKH,X + LDY IPY + JMP NEXTOP +LLBX INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + STA ALTRDOFF + LDA (IFP),Y + STA ESTKL,X + LDA #$00 + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +LLWX INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + STA ALTRDOFF + LDA (IFP),Y + STA ESTKL,X + INY + LDA (IFP),Y + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +;* +;* ADD VALUE FROM LOCAL FRAME OFFSET +;* +ADDLB INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA (IFP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ LDY IPY + JMP NEXTOP +ADDLBX INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + STA ALTRDOFF + LDA (IFP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ STA ALTRDON + LDY IPY + JMP NEXTOP +ADDLW INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA (IFP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + INY + LDA (IFP),Y + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +ADDLWX INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + STA ALTRDOFF + LDA (IFP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + INY + LDA (IFP),Y + ADC ESTKH,X + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +;* +;* INDEX VALUE FROM LOCAL FRAME OFFSET +;* +IDXLB INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA (IFP),Y + LDY #$00 + ASL + BCC + + INY + CLC ++ ADC ESTKL,X + STA ESTKL,X + TYA + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +IDXLBX INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + STA ALTRDOFF + LDA (IFP),Y + LDY #$00 + ASL + BCC + + INY + CLC ++ ADC ESTKL,X + STA ESTKL,X + TYA + ADC ESTKH,X + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +IDXLW INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA (IFP),Y + ASL + STA TMPL + INY + LDA (IFP),Y + ROL + STA TMPH + LDA TMPL + CLC + ADC ESTKL,X + STA ESTKL,X + LDA TMPH + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +IDXLWX INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + STA ALTRDOFF + LDA (IFP),Y + ASL + STA TMPL + INY + LDA (IFP),Y + ROL + STA TMPH + LDA TMPL + CLC + ADC ESTKL,X + STA ESTKL,X + LDA TMPH + ADC ESTKH,X + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +;* +;* LOAD VALUE FROM ABSOLUTE ADDRESS +;* +LAB INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + LDA (ESTKH-2,X) + DEX + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +LAW INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA (TMP),Y + DEX + STA ESTKL,X + INY + LDA (TMP),Y + STA ESTKH,X + LDY IPY + JMP NEXTOP +LABX INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + STA ALTRDOFF + LDA (ESTKH-2,X) + DEX + STA ESTKL,X + LDA #$00 + STA ESTKH,X + STA ALTRDON + JMP NEXTOP +LAWX INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + STY IPY + STA ALTRDOFF + LDY #$00 + LDA (TMP),Y + DEX + STA ESTKL,X + INY + LDA (TMP),Y + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +;* +;* ADD VALUE FROM ABSOLUTE ADDRESS +;* +ADDAB INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + LDA (ESTKH-2,X) + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ JMP NEXTOP +ADDABX INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + STA ALTRDOFF + LDA (ESTKH-2,X) + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ STA ALTRDON + JMP NEXTOP +ADDAW INY ;+INC_IP + LDA (IP),Y + STA SRCL + INY ;+INC_IP + LDA (IP),Y + STA SRCH + STY IPY + LDY #$00 + LDA (SRC),Y + CLC + ADC ESTKL,X + STA ESTKL,X + INY + LDA (SRC),Y + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +ADDAWX INY ;+INC_IP + LDA (IP),Y + STA SRCL + INY ;+INC_IP + LDA (IP),Y + STA SRCH + STY IPY + STA ALTRDOFF + LDY #$00 + LDA (SRC),Y + CLC + ADC ESTKL,X + STA ESTKL,X + INY + LDA (SRC),Y + ADC ESTKH,X + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +;* +;* INDEX VALUE FROM ABSOLUTE ADDRESS +;* +IDXAB INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + LDA (ESTKH-2,X) + STY IPY + LDY #$00 + ASL + BCC + + INY + CLC ++ ADC ESTKL,X + STA ESTKL,X + TYA + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +IDXABX INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + STA ALTRDOFF + LDA (ESTKH-2,X) + STY IPY + LDY #$00 + ASL + BCC + + INY + CLC ++ ADC ESTKL,X + STA ESTKL,X + TYA + ADC ESTKH,X + STA ESTKH,X + LDY IPY + STA ALTRDON + JMP NEXTOP +IDXAW INY ;+INC_IP + LDA (IP),Y + STA SRCL + INY ;+INC_IP + LDA (IP),Y + STA SRCH + STY IPY + LDY #$00 + LDA (SRC),Y + ASL + STA TMPL + INY + LDA (SRC),Y + ROL + STA TMPH + LDA TMPL + CLC + ADC ESTKL,X + STA ESTKL,X + LDA TMPH + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +IDXAWX INY ;+INC_IP + LDA (IP),Y + STA SRCL + INY ;+INC_IP + LDA (IP),Y + STA SRCH + STY IPY + STA ALTRDOFF + LDY #$00 + LDA (SRC),Y + ASL + STA TMPL + INY + LDA (SRC),Y + ROL + STA TMPH + LDA TMPL + CLC + ADC ESTKL,X + STA ESTKL,X + LDA TMPH + ADC ESTKH,X + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +;* +;* STORE VALUE TO ADDRESS +;* +SB LDA ESTKL,X + STA ESTKH-1,X + LDA ESTKL+1,X + STA (ESTKH-1,X) + INX + JMP DROP +SW LDA ESTKL,X + STA ESTKH-1,X + LDA ESTKL+1,X + STA (ESTKH-1,X) + LDA ESTKH+1,X + INC ESTKH-1,X + BEQ + + STA (ESTKH-1,X) + INX + JMP DROP ++ INC ESTKH,X + STA (ESTKH-1,X) +;* +;* DROP TOS, TOS-1 +;* +DROP2 INX + JMP DROP +;* +;* STORE VALUE TO LOCAL FRAME OFFSET +;* +SLB INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + LDY IPY + BMI FIXDROP + JMP DROP +SLW INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + INY + LDA ESTKH,X + STA (IFP),Y + LDY IPY + BMI FIXDROP + JMP DROP +FIXDROP TYA + LDY #$00 + CLC + ADC IPL + STA IPL + BCC + + INC IPH ++ JMP DROP +;* +;* STORE VALUE TO LOCAL FRAME OFFSET WITHOUT POPPING STACK +;* +DLB INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + LDA #$00 + STA ESTKH,X + LDY IPY + JMP NEXTOP +DLW INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + INY + LDA ESTKH,X + STA (IFP),Y + LDY IPY + JMP NEXTOP +;* +;* STORE VALUE TO ABSOLUTE ADDRESS +;* +- TYA ; RENORMALIZE IP + CLC + ADC IPL + STA IPL + BCC + + INC IPH ++ LDY #$FF +SAB INY ;+INC_IP + BMI - + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + LDA ESTKL,X + STA (ESTKH-2,X) + JMP DROP +SAW INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + INY + LDA ESTKH,X + STA (TMP),Y + LDY IPY + BMI + + JMP DROP ++ JMP FIXDROP +;* +;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK +;* +DAB INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + LDA ESTKL,X + STA (ESTKH-2,X) + LDA #$00 + STA ESTKH,X + JMP NEXTOP +DAW INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + INY + LDA ESTKH,X + STA (TMP),Y + LDY IPY + JMP NEXTOP +;* +;* COMPARES +;* +ISEQ LDA ESTKL,X + CMP ESTKL+1,X + BNE ISFLS + LDA ESTKH,X + CMP ESTKH+1,X + BNE ISFLS +ISTRU LDA #$FF + STA ESTKL+1,X + STA ESTKH+1,X + JMP DROP +ISNE LDA ESTKL,X + CMP ESTKL+1,X + BNE ISTRU + LDA ESTKH,X + CMP ESTKH+1,X + BNE ISTRU +ISFLS LDA #$00 + STA ESTKL+1,X + STA ESTKH+1,X + JMP DROP +ISGE LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + BVS + + BPL ISTRU + BMI ISFLS ++ +- BPL ISFLS + BMI ISTRU +ISLE LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVS - + BPL ISTRU + BMI ISFLS +ISGT LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVS + + BMI ISTRU + BPL ISFLS ++ +- BMI ISFLS + BPL ISTRU +ISLT LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + BVS - + BMI ISTRU + BPL ISFLS +;* +;* BRANCHES +;* +SEL INX + TYA ; FLATTEN IP + SEC + ADC IPL + STA TMPL + LDA #$00 + TAY + ADC IPH + STA TMPH ; ADD BRANCH OFFSET + LDA (TMP),Y + ;CLC ; BETTER NOT CARRY OUT OF IP+Y + ADC TMPL + STA IPL + INY + LDA (TMP),Y + ADC TMPH + STA IPH + DEY + LDA (IP),Y + STA TMPL ; CASE COUNT + INC IPL + BNE CASELP + INC IPH +CASELP LDA ESTKL-1,X + CMP (IP),Y + BEQ + + LDA ESTKH-1,X + INY + SBC (IP),Y + BMI CASEEND +- INY + INY + DEC TMPL + BEQ FIXNEXT + INY + BNE CASELP + INC IPH + BNE CASELP ++ LDA ESTKH-1,X + INY + SBC (IP),Y + BEQ BRNCH + BPL - +CASEEND LDA #$00 + STA TMPH + DEC TMPL + LDA TMPL + ASL ; SKIP REMAINING CASES + ROL TMPH + ASL + ROL TMPH +; CLC + ADC IPL + STA IPL + LDA TMPH + ADC IPH + STA IPH + INY + INY +FIXNEXT TYA + LDY #$00 + SEC + ADC IPL + STA IPL + BCC + + INC IPH ++ JMP FETCHOP +BRAND LDA ESTKL,X + ORA ESTKH,X + BEQ BRNCH + INX ; DROP LEFT HALF OF AND + BNE NOBRNCH +BROR LDA ESTKL,X + ORA ESTKH,X + BNE BRNCH + INX ; DROP LEFT HALF OF OR + BNE NOBRNCH +BREQ INX + INX + LDA ESTKL-2,X + CMP ESTKL-1,X + BNE NOBRNCH + LDA ESTKH-2,X + CMP ESTKH-1,X + BEQ BRNCH + BNE NOBRNCH +BRNE INX + INX + LDA ESTKL-2,X + CMP ESTKL-1,X + BNE BRNCH + LDA ESTKH-2,X + CMP ESTKH-1,X + BNE BRNCH + BEQ NOBRNCH +BRTRU INX + LDA ESTKH-1,X + ORA ESTKL-1,X + BNE BRNCH +NOBRNCH INY ;+INC_IP + INY + BMI FIXNEXT + JMP NEXTOP +BRFLS INX + LDA ESTKH-1,X + ORA ESTKL-1,X + BNE NOBRNCH +BRNCH TYA ; FLATTEN IP + SEC + ADC IPL + STA TMPL + LDA #$00 + TAY + ADC IPH + STA TMPH ; ADD BRANCH OFFSET + LDA (TMP),Y + ;CLC ; BETTER NOT CARRY OUT OF IP+Y + ADC TMPL + STA IPL + INY + LDA (TMP),Y + ADC TMPH + STA IPH + DEY + JMP FETCHOP +;* +;* FOR LOOPS PUT TERMINAL VALUE AT ESTK+1 AND CURRENT COUNT ON ESTK +;* +BRGT LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + BVS + + BPL NOBRNCH +- INX ; DROP FOR VALUES + INX + BNE BRNCH ; BMI BRNCH +BRLT LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVS + + BPL NOBRNCH + INX ; DROP FOR VALUES + INX + BNE BRNCH ; BMI BRNCH ++ BMI NOBRNCH + BPL - +DECBRGE DEC ESTKL,X + LDA ESTKL,X + CMP #$FF + BNE + + DEC ESTKH,X +_BRGE LDA ESTKL,X ++ CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVS + + BPL BRNCH +- INX ; DROP FOR VALUES + INX + BNE NOBRNCH ; BMI NOBRNCH +INCBRLE INC ESTKL,X + BNE _BRLE + INC ESTKH,X +_BRLE LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + BVS + + BPL BRNCH + INX ; DROP FOR VALUES + INX + BNE NOBRNCH ; BMI NOBRNCH ++ BMI BRNCH + BPL - +SUBBRGE LDA ESTKL+1,X + SEC + SBC ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + SBC ESTKH,X + STA ESTKH+1,X + INX + BNE _BRGE +ADDBRLE LDA ESTKL,X + CLC + ADC ESTKL+1,X + STA ESTKL+1,X + LDA ESTKH,X + ADC ESTKH+1,X + STA ESTKH+1,X + INX + BNE _BRLE +;* +;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE) +;* +CALL INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + TYA + CLC + ADC IPL + PHA + LDA IPH + ADC #$00 + PHA + JSR JMPTMP + PLA + STA IPH + PLA + STA IPL + LDA #>OPTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE + STA OPPAGE + LDY #$01 + JMP FETCHOP +CALLX INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + TYA + CLC + ADC IPL + PHA + LDA IPH + ADC #$00 + PHA + STA ALTRDOFF + LDA PSR + PHA + PLP + JSR JMPTMP + PHP + PLA + STA PSR + SEI + STA ALTRDON + PLA + STA IPH + PLA + STA IPL + LDA #>OPXTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE + STA OPPAGE + LDY #$01 + JMP FETCHOP +;* +;* INDIRECT CALL TO ADDRESS (NATIVE CODE) +;* +ICAL LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + INX + TYA + CLC + ADC IPL + PHA + LDA IPH + ADC #$00 + PHA + JSR JMPTMP + PLA + STA IPH + PLA + STA IPL + LDA #>OPTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE + STA OPPAGE + LDY #$01 + JMP FETCHOP +ICALX LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + INX + TYA + CLC + ADC IPL + PHA + LDA IPH + ADC #$00 + PHA + STA ALTRDOFF + LDA PSR + PHA + PLP + JSR JMPTMP + PHP + PLA + STA PSR + STA ALTRDON + PLA + STA IPH + PLA + STA IPL + LDA #>OPXTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE + STA OPPAGE + LDY #$01 + JMP FETCHOP +;* +;* JUMP INDIRECT TRHOUGH TMP +;* +;JMPTMP JMP (TMP) +;* +;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT +;* +ENTER LDA IFPH + PHA ; SAVE ON STACK FOR LEAVE + LDA IFPL + PHA + INY + LDA (IP),Y + EOR #$FF ; ALLOCATE FRAME + SEC + ADC PPL + STA PPL + STA IFPL + LDA #$FF + ADC PPH + STA PPH + STA IFPH + INY + LDA (IP),Y + BEQ + + ASL + TAY +- LDA ESTKH,X + DEY + STA (IFP),Y + LDA ESTKL,X + INX + DEY + STA (IFP),Y + BNE - ++ LDY #$03 + JMP FETCHOP +;* +;* LEAVE FUNCTION +;* +LEAVEX INY ;+INC_IP + LDA (IP),Y + CLC + ADC IFPL + STA PPL + LDA #$00 + ADC IFPH + STA PPH + PLA ; RESTORE PREVIOUS FRAME + STA IFPL + PLA + STA IFPH +RETX STA ALTRDOFF + LDA PSR + PHA + PLP + RTS +LEAVE INY ;+INC_IP + LDA (IP),Y + CLC + ADC IFPL + STA PPL + LDA #$00 + ADC IFPH + STA PPH + PLA ; RESTORE PREVIOUS FRAME + STA IFPL + PLA + STA IFPH +RET RTS +;* +;* RETURN TO NATIVE CODE +;* +NATV TYA ; FLATTEN IP + SEC + ADC IPL + STA TMPL + LDA #$00 + ADC IPH + STA TMPH + JMP JMPTMP +VMEND = * +} +;*************************************** +;* * +;* 65C02 OPS TO OVERWRITE STANDARD OPS * +;* * +;*************************************** +C02OPS LDA #DINTRP + LDY #(CDINTRPEND-CDINTRP) + JSR OPCPY +CDINTRP PLY + PLA + INY + BNE + + INC ++ STY IPL + STA IPH + LDY #$00 + LDA #>OPTBL + STA OPPAGE + JMP FETCHOP +CDINTRPEND +; + LDA #CN + LDY #(CCNEND-CCN) + JSR OPCPY +CCN DEX + LSR + STA ESTKL,X + STZ ESTKH,X + JMP NEXTOP +CCNEND +; + LDA #CB + LDY #(CCBEND-CCB) + JSR OPCPY +CCB DEX + STZ ESTKH,X + INY + LDA (IP),Y + STA ESTKL,X + JMP NEXTOP +CCBEND +; + LDA #CS + LDY #(CCSEND-CCS) + JSR OPCPY +CCS DEX + ;INY ;+INC_IP + TYA ; NORMALIZE IP AND SAVE STRING ADDR ON ESTK + SEC + ADC IPL + STA IPL + STA ESTKL,X + LDA #$00 + ADC IPH + STA IPH + STA ESTKH,X + LDA (IP) + TAY + JMP NEXTOP +CCSEND +; + LDA #SHL + LDY #(CSHLEND-CSHL) + JSR OPCPY +CSHL STY IPY + LDA ESTKL,X + CMP #$08 + BCC + + LDY ESTKL+1,X + STY ESTKH+1,X + STZ ESTKL+1,X + SBC #$08 ++ TAY + BEQ + + LDA ESTKL+1,X +- ASL + ROL ESTKH+1,X + DEY + BNE - + STA ESTKL+1,X ++ LDY IPY + JMP DROP +CSHLEND +; + LDA #LB + LDY #(CLBEND-CLB) + JSR OPCPY +CLB LDA ESTKL,X + STA ESTKH-1,X + LDA (ESTKH-1,X) + STA ESTKL,X + STZ ESTKH,X + JMP NEXTOP +CLBEND +; + LDA #LBX + LDY #(CLBXEND-CLBX) + JSR OPCPY +CLBX LDA ESTKL,X + STA ESTKH-1,X + STA ALTRDOFF + LDA (ESTKH-1,X) + STA ESTKL,X + STZ ESTKH,X + STA ALTRDON + JMP NEXTOP +CLBXEND +; + LDA #LLB + LDY #(CLLBEND-CLLB) + JSR OPCPY +CLLB INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + LDA (IFP),Y + STA ESTKL,X + STZ ESTKH,X + LDY IPY + JMP NEXTOP +CLLBEND +; + LDA #LLBX + LDY #(CLLBXEND-CLLBX) + JSR OPCPY +CLLBX INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + STA ALTRDOFF + LDA (IFP),Y + STA ESTKL,X + STZ ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +CLLBXEND +; + LDA #LAB + LDY #(CLABEND-CLAB) + JSR OPCPY +CLAB INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + LDA (ESTKH-2,X) + DEX + STA ESTKL,X + STZ ESTKH,X + JMP NEXTOP +CLABEND +; + LDA #LAW + LDY #(CLAWEND-CLAW) + JSR OPCPY +CLAW INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDA (TMP) + DEX + STA ESTKL,X + LDY #$01 + LDA (TMP),Y + STA ESTKH,X + LDY IPY + JMP NEXTOP +CLAWEND +; + LDA #LABX + LDY #(CLABXEND-CLABX) + JSR OPCPY +CLABX INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + STA ALTRDOFF + LDA (ESTKH-2,X) + DEX + STA ESTKL,X + STZ ESTKH,X + STA ALTRDON + JMP NEXTOP +CLABXEND +; + LDA #LAWX + LDY #(CLAWXEND-CLAWX) + JSR OPCPY +CLAWX INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + STY IPY + STA ALTRDOFF + LDA (TMP) + DEX + STA ESTKL,X + LDY #$01 + LDA (TMP),Y + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +CLAWXEND +; + LDA #SAW + LDY #(CSAWEND-CSAW) + JSR OPCPY +CSAW INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDA ESTKL,X + STA (TMP) + LDY #$01 + LDA ESTKH,X + STA (TMP),Y + LDY IPY + BMI + + JMP DROP ++ JMP FIXDROP +CSAWEND +; + LDA #DAW + LDY #(CDAWEND-CDAW) + JSR OPCPY +CDAW INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDA ESTKL,X + STA (TMP) + LDY #$01 + LDA ESTKH,X + STA (TMP),Y + LDY IPY + JMP NEXTOP +CDAWEND +; + LDA #DAB + LDY #(CDABEND-CDAB) + JSR OPCPY +CDAB INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + LDA ESTKL,X + STA (ESTKH-2,X) + STZ ESTKH,X + JMP NEXTOP +CDABEND +; + LDA #DLB + LDY #(CDLBEND-CDLB) + JSR OPCPY +CDLB INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + STZ ESTKH,X + LDY IPY + JMP NEXTOP +CDLBEND +; + LDA #ISFLS + LDY #(CISFLSEND-CISFLS) + JSR OPCPY +CISFLS STZ ESTKL+1,X + STZ ESTKH+1,X + JMP DROP +CISFLSEND +; + LDA #BRNCH + LDY #(CBRNCHEND-CBRNCH) + JSR OPCPY +CBRNCH TYA ; FLATTEN IP + SEC + ADC IPL + STA TMPL + LDA #$00 + ADC IPH + STA TMPH ; ADD BRANCH OFFSET + LDA (TMP) + ;CLC ; BETTER NOT CARRY OUT OF IP+Y + ADC TMPL + STA IPL + LDY #$01 + LDA (TMP),Y + ADC TMPH + STA IPH + DEY + JMP FETCHOP +CBRNCHEND +; + RTS +;* +;* COPY OP TO VM +;* +OPCPY STA DST + STX DST+1 + PLA + STA SRC + PLA + STA SRC+1 + TYA + CLC + ADC SRC + TAX + LDA #$00 + ADC SRC+1 + PHA + PHX + INC SRC + BNE + + INC SRC+1 ++ DEY +- LDA (SRC),Y + STA (DST),Y + DEY + BPL - + RTS diff --git a/src/vmsrc/apple/soscmd.pla b/src/vmsrc/apple/soscmd.pla index d60bbc0..f370a2b 100755 --- a/src/vmsrc/apple/soscmd.pla +++ b/src/vmsrc/apple/soscmd.pla @@ -1,787 +1,72 @@ -const membank = $FFEF -const RELADDR = $1000 +include "inc/cmdsys.plh" // -// System flags: memory allocator screen holes. +// JIT compiler values // -const restxt1 = $0001 -const restxt2 = $0002 -const resxtxt1 = $0004 -const resxtxt2 = $0008 -const reshgr1 = $0010 -const reshgr2 = $0020 -const resxhgr1 = $0040 -const resxhgr2 = $0080 // -// Module don't free memory +// Indirect interpreter DEFinition entrypoint // -const modkeep = $2000 -const modinitkeep = $4000 -// -// Pedefined functions. -// -predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1 -predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, prbyte(b)#0, prword(w)#0 -predef cin()#1, rdstr(p)#1, toupper(c)#1, strcpy(dst,src)#1, strcat(dst,src)#1 -predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr), releaseheap(newheap)#1, availheap()#1 -predef memset(addr,value,size)#0, memcpy(dst,src,size)#0 -predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1, sext(a)#1, divmod(a,b)#2 -predef execmod(modfile)#1 -// -// Exported CMDSYS table -// -word version = $0110 // 01.10 -word syspath -word cmdlnptr -word = @execmod -byte refcons = 0 -byte devcons = 0 -// -// String pool. -// -byte console[] = ".CONSOLE" -byte textmode[] = 16, 0, 15 -byte hexchar[] = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F' -// -// Exported Machine ID. -// -byte machid = $F2 // Apple ///, 80 columns -// -// Working input buffer overlayed with strings table -// -word cmdptr -byte cmdln = "" -// -// Standard Library exported functions. -// -byte sysmodstr[] = "CMDSYS" -byte machidstr[] = "MACHID" -byte sysstr[] = "SYSCALL" -byte callstr[] = "CALL" -byte putcstr[] = "PUTC" -byte putlnstr[] = "PUTLN" -byte putsstr[] = "PUTS" -byte putistr[] = "PUTI" -byte putbstr[] = "PUTB" -byte putwstr[] = "PUTH" -byte getcstr[] = "GETC" -byte getsstr[] = "GETS" -byte toupstr[] = "TOUPPER" -byte strcpystr[] = "STRCPY" -byte strcatstr[] = "STRCAT" -byte hpmarkstr[] = "HEAPMARK" -byte hpalignstr[] = "HEAPALLOCALIGN" -byte hpallocstr[] = "HEAPALLOC" -byte hprelstr[] = "HEAPRELEASE" -byte hpavlstr[] = "HEAPAVAIL" -byte sysmods[] = "" // overlay with exported strings -byte memsetstr[] = "MEMSET" -byte memcpystr[] = "MEMCPY" -byte uisgtstr[] = "ISUGT" -byte uisgestr[] = "ISUGE" -byte uisltstr[] = "ISULT" -byte uislestr[] = "ISULE" -byte sextstr[] = "SEXT" -byte divmodstr[] = "DIVMOD" -byte autorun[] = "AUTORUN" -byte prefix[] = "" // Overlay with exported symbols table -word exports[] = @sysmodstr, @version -word = @sysstr, @syscall -word = @callstr, @call -word = @putcstr, @cout -word = @putlnstr, @crout -word = @putsstr, @prstr -word = @putistr, @print -word = @putbstr, @prbyte -word = @putwstr, @prword -word = @getcstr, @cin -word = @getsstr, @rdstr -word = @toupstr, @toupper -word = @hpmarkstr, @markheap -word = @hpallocstr,@allocheap -word = @hpalignstr,@allocalignheap -word = @hprelstr, @releaseheap -word = @hpavlstr, @availheap -word = @memsetstr, @memset -word = @memcpystr, @memcpy -word = @strcpystr, @strcpy -word = @strcatstr, @strcat -word = @uisgtstr, @uword_isgt -word = @uisgestr, @uword_isge -word = @uisltstr, @uword_islt -word = @uislestr, @uword_isle -word = @sextstr, @sext -word = @divmodstr, @divmod -word = @machidstr, @machid -word = 0 -word sysmodsym = @exports -// -// System variables. -// -word systemflags = 0 -word heap = $2000 -byte modid = 0 -byte modseg[15] -word symtbl, lastsym -byte perr, terr, lerr -// -// Utility functions -// -asm saveX#0 - STX XREG+1 -end -asm restoreX#0 -XREG LDX #$00 - RTS +struc t_defentry + byte interpjsr + word interpaddr + word bytecodeaddr + byte bytecodexbyte + byte callcount + byte bytecodesize end // -// CALL SOS -// SYSCALL(CMD, PARAMS) +// Private addresses // -asm syscall(cmd,params)#1 - LDA ESTKL,X - LDY ESTKH,X - STA PARAMS - STY PARAMS+1 - INX - LDA ESTKL,X - STA CMD - BRK -CMD !BYTE 00 -PARAMS !WORD 0000 - LDY #$00 - STA ESTKL,X - STY ESTKH,X - RTS -end +const codemax = $A000 +const cmdparser = $A0F0 +const jitcomp = $A0F2 +const jitcodeptr = $A0F4 +const sinterp = $A0F6 +const xinterp = $A0F8 +const jitinterp = $A0FA +word directentry, indirectentry // -// CALL 6502 ROUTINE -// CALL(AREG, XREG, YREG, STATUS, ADDR) +// COPY FROM EXT MEM TO MAIN MEM. // -asm call(addr,areg,xreg,yreg,sstatus)#1 -REGVALS = SRC - PHP +asm defcpy(dst, defentry)#0 + !SOURCE "vmsrc/plvmzp.inc" +XPAGE = $1600 +SRCX = XPAGE+SRCH +DSTX = XPAGE+DSTH + + LDA ESTKL+1,X + STA DSTL + LDA ESTKH+1,X + STA DSTH LDA ESTKL,X STA TMPL LDA ESTKH,X STA TMPH - INX - LDA ESTKL,X - PHA - INX - LDY ESTKL,X - INX - LDA ESTKL+1,X - PHA - LDA ESTKL,X - INX - STX ESP - TAX - PLA - PLP - JSR JMPTMP - PHP - STA REGVALS+0 - STX REGVALS+1 - STY REGVALS+2 - PLA - STA REGVALS+3 - LDX ESP - LDA #REGVALS - STA ESTKL,X - STY ESTKH,X - PLP - RTS -end -// -// SET MEMORY TO VALUE -// MEMSET(ADDR, VALUE, SIZE) -// With optimizations from Peter Ferrie -// -asm memset(addr,value,size)#0 - LDA ESTKL+2,X - STA DSTL - LDA ESTKH+2,X - STA DSTH - LDY ESTKL,X - BEQ + - INC ESTKH,X - LDY #$00 -+ LDA ESTKH,X - BEQ SETMEX -SETMLPL CLC - LDA ESTKL+1,X -SETMLPH STA (DST),Y - DEC ESTKL,X - BEQ ++ -- INY - BEQ + --- BCS SETMLPL - SEC - LDA ESTKH+1,X - BCS SETMLPH -+ INC DSTH - BNE -- -++ DEC ESTKH,X - BNE - -SETMEX INX - INX - INX - RTS -end -// -// COPY MEMORY -// MEMCPY(DSTADDR, SRCADDR, SIZE) -// -asm memcpy(dst,src,size)#0 - INX - INX - INX - LDA ESTKL-3,X - ORA ESTKH-3,X - BEQ CPYMEX - LDA ESTKL-2,X - CMP ESTKL-1,X - LDA ESTKH-2,X - SBC ESTKH-1,X - BCC REVCPY -; -; FORWARD COPY -; - LDA ESTKL-1,X - STA DSTL - LDA ESTKH-1,X - STA DSTH - LDA ESTKL-2,X - STA SRCL - LDA ESTKH-2,X - STA SRCH - LDY ESTKL-3,X - BEQ FORCPYLP - INC ESTKH-3,X - LDY #$00 -FORCPYLP LDA (SRC),Y - STA (DST),Y - INY - BNE + - INC DSTH - INC SRCH -+ DEC ESTKL-3,X - BNE FORCPYLP - DEC ESTKH-3,X - BNE FORCPYLP - RTS -; -; REVERSE COPY -; -REVCPY ;CLC - LDA ESTKL-3,X - ADC ESTKL-1,X - STA DSTL - LDA ESTKH-3,X - ADC ESTKH-1,X - STA DSTH - CLC - LDA ESTKL-3,X - ADC ESTKL-2,X - STA SRCL - LDA ESTKH-3,X - ADC ESTKH-2,X - STA SRCH - DEC DSTH - DEC SRCH - LDY #$FF - LDA ESTKL-3,X - BEQ REVCPYLP - INC ESTKH-3,X -REVCPYLP LDA (SRC),Y - STA (DST),Y + LDY #$05 + LDA (TMP),Y + STA SRCX DEY - CPY #$FF - BNE + - DEC DSTH - DEC SRCH -+ DEC ESTKL-3,X - BNE REVCPYLP - DEC ESTKH-3,X - BNE REVCPYLP -CPYMEX RTS -end -// -// COPY FROM MAIN MEM TO EXT MEM. -// -// MEMXCPY(DSTSEG, SRC, SIZE) -// -asm memxcpy(dst,src,size)#0 - LDA ESTKL,X - ORA ESTKH,X - BEQ CPYXMEX - LDY #$00 - STY DSTL - LDA ESTKH+2,X - CLC - ADC #$60 - STA DSTH - LDA ESTKL+2,X - CLC - ADC #$7F - STA DSTX - LDA ESTKL+1,X - STA SRCL - LDA ESTKH+1,X + LDA (TMP),Y STA SRCH - INC ESTKH,X -CPYXLP LDA (SRC),Y - STA (DST),Y - INY - BNE + - INC DSTH - INC SRCH -+ DEC ESTKL,X - BNE CPYXLP - DEC ESTKH,X - BNE CPYXLP - LDA #$00 - STA DSTX -CPYXMEX INX - INX - INX - RTS -end -// -// POKE BYTE VAL INTO EXT MEM. -// -// XPOKEB(SEG, DST, BYTEVAL) -// -asm xpokeb(seg, dst, byteval)#0 - LDA ESTKL+1,X - STA DSTL - LDA ESTKH+1,X - CLC - ADC #$60 - STA DSTH - LDA ESTKL+2,X - CLC - ADC #$7F - STA DSTX - LDY #$00 - LDA ESTKL,X - STA (DST),Y - STY DSTX - INX - INX - INX - RTS -end -// -// Unsigned word comparisons. -// -asm uword_isge(a,b)#1 - LDA ESTKL+1,X - CMP ESTKL,X - LDA ESTKH+1,X - SBC ESTKH,X - LDA #$FF - ADC #$00 - EOR #$FF - STA ESTKL+1,X - STA ESTKH+1,X - INX - RTS -end -asm uword_isle(a,b)#1 - LDA ESTKL,X - CMP ESTKL+1,X - LDA ESTKH,X - SBC ESTKH+1,X - LDA #$FF - ADC #$00 - EOR #$FF - STA ESTKL+1,X - STA ESTKH+1,X - INX - RTS -end -asm uword_isgt(a,b)#1 - LDA ESTKL,X - CMP ESTKL+1,X - LDA ESTKH,X - SBC ESTKH+1,X - LDA #$FF - ADC #$00 - STA ESTKL+1,X - STA ESTKH+1,X - INX - RTS -end -asm uword_islt(a,b)#1 - LDA ESTKL+1,X - CMP ESTKL,X - LDA ESTKH+1,X - SBC ESTKH,X - LDA #$FF - ADC #$00 - STA ESTKL+1,X - STA ESTKH+1,X - INX - RTS -end -asm divmod(a,b)#2 - JSR INTERP ; CALL INTERP - !BYTE $36, $5C ; DIVMOD, RET -end -asm sext(a)#1 - LDY #$00 - LDA ESTKL,X - BPL + DEY -+ STY ESTKH,X - RTS -end -// -// Addresses of internal routines. -// -asm interp()#1 - DEX - LDA #XINTERP - STA ESTKH,X - RTS -end -// -// A DCI string is one that has the high bit set for every character except the last. -// More efficient than C or Pascal strings. -// -//def dcitos(dci, str) -// byte len, c -// len = 0 -// repeat -// c = (dci).[len] -// len = len + 1 -// (str).[len] = c & $7F -// until !(c & $80) -// ^str = len -// return len -//end -asm dcitos(dci, str)#1 - LDA ESTKL,X - STA DSTL - LDA ESTKH,X - STA DSTH - LDA ESTKL+1,X + LDA (TMP),Y STA SRCL - LDA ESTKH+1,X - STA SRCH - LDY #$00 -- LDA (SRC),Y - CMP #$80 - AND #$7F - INY - STA (DST),Y - BCS - - TYA - LDY #$00 - STA (DST),Y - INX - STA ESTKL,X - STY ESTKH,X - RTS -end -//def stodci(str, dci) -// byte len, c -// len = ^str -// if len == 0 -// return -// fin -// c = toupper((str).[len]) & $7F -// len = len - 1 -// (dci).[len] = c -// while len -// c = toupper((str).[len]) | $80 -// len = len - 1 -// (dci).[len] = c -// loop -// return ^str -//end -asm stodci(str, dci)#1 - LDA ESTKL,X - STA DSTL - LDA ESTKH,X - STA DSTH - LDA ESTKL+1,X - STA SRCL - LDA ESTKH+1,X - STA SRCH - INX - LDY #$00 - LDA (SRC),Y - BEQ ++ + LDY #$07 + LDA (TMP),Y TAY - LDA (SRC),Y - JSR TOUPR - BNE + -- LDA (SRC),Y - JSR TOUPR - ORA #$80 -+ DEY - STA (DST),Y - BNE - - LDA (SRC),Y -++ STA ESTKL,X - STY ESTKH,X - RTS -end -asm toupper(c)#1 - LDA ESTKL,X -TOUPR AND #$7F - CMP #'a' - BCC + - CMP #'z'+1 - BCS + - SBC #$1F -+ STA ESTKL,X - RTS -end -// -// Lookup routines. -// -//def lookuptbl(dci, tbl) -// word match -// while ^tbl -// match = dci -// while ^tbl == ^match -// if !(^tbl & $80) -// return (tbl):1 -// fin -// tbl = tbl + 1 -// match = match + 1 -// loop -// while (^tbl & $80) -// tbl = tbl + 1 -// loop -// tbl = tbl + 3 -// loop -// return 0 -asm lookuptbl(dci, tbl)#1 - LDY #$00 - STY DSTL - LDA ESTKH,X - CLC - ADC #$60 - STA DSTH - LDA ESTKL,X - CLC - ADC #$7F - STA DSTX - LDA ESTKL+1,X - STA SRCL - LDA ESTKH+1,X - STA SRCH -- LDA (DST),Y - BEQ + - CMP (SRC),Y - BNE ++ - INY - ASL - BCS - - LDA (DST),Y - PHA - INY - LDA (DST),Y - TAY - PLA -+ INX - STA ESTKL,X - STY ESTKH,X - LDA #$00 - STA DSTX - RTS -++ LDY #$00 --- LDA (DST),Y - INC DSTL - BEQ + ---- ASL - BCS -- - LDA #$02 - ADC DSTL - STA DSTL - BCC - - INC DSTH - BCS - -+ INC DSTH - BNE --- -end -// def lookupidx(esd, index) -// word sym -// while ^esd -// sym = esd -// esd = sym + dcitos(sym, @str) -// if esd->0 & $10 and esd->1 == index -// return sym -// fin -// esd = esd + 3 -// loop -//end -asm lookupidx(esd, index)#1 - LDA ESTKL,X - STA TMPL - INX ---- LDA ESTKH,X - STA SRCH - LDA ESTKL,X --- STA SRCL - LDY #$00 -- LDA (SRC),Y - BPL + - INY - BNE - -+ BEQ ++ ; END OF ESD - INY - LDA (SRC),Y - INY - AND #$10 ; EXTERN FLAG? - BEQ + - LDA (SRC),Y - CMP TMPL - BEQ +++ ; MATCH -+ INY - TYA - SEC - ADC SRCL - STA ESTKL,X ; SYM PTRL - BCC -- - INC ESTKH,X ; SYM PTRH - BNE --- -++ STA ESTKL,X ; END OF ESD - STA ESTKH,X -+++ RTS -end -//def lookupdef(addr, deftbl)#1 -// while deftbl->0 == $20 -// if deftbl=>3 == addr -// return deftbl -// fin -// deftbl = deftbl + 6 -// loop -// return 0 -//end -asm lookupdef(addr, deftbl)#1 - LDA ESTKH,X - STA SRCH - LDA ESTKL,X - STA SRCL - INX -- LDY #$00 - LDA (SRC),Y - CMP #$20 ; JSR OPCODE? - BNE ++ - LDY #$03 - LDA (SRC),Y - CMP ESTKL,X - BNE + - INY - LDA (SRC),Y - CMP ESTKH,X - BNE + - LDA SRCL ; MATCH - STA ESTKL,X - LDA SRCH - STA ESTKH,X - RTS -+ LDA #$06 - CLC - ADC SRCL - STA SRCL - BCC - - INC SRCH - BNE - -++ STY ESTKL,X - STY ESTKH,X - RTS -end -// -// Reloc internal data -// -//def reloc(modfix, modofst, bytecode, rld)#3 -// word addr, fixup -// while ^rld -// if ^rld & $10 // EXTERN reference. -// return rld, addr, fixup -// fin -// addr = rld=>1 + modfix -// fixup = *addr + modofst -// if uword_isge(fixup, bytecode) // Bytecode address. -// return rld, addr, fixup -// fin -// *addr = fixup -// rld = rld + 4 -// loop -// return rld, addr, fixup -//end -asm reloc(modfix, modofst, bytecode, rld)#3 - LDA ESTKL,X - STA SRCL - LDA ESTKH,X - STA SRCH - LDY #$00 -- LDA (SRC),Y - BEQ RLDEX ; END OF RLD - PHA - INY - LDA (SRC),Y - INY - CLC - ADC ESTKL+3,X ; ADDR=ENTRY=>1+MODFIX - STA DSTL - LDA (SRC),Y - ADC ESTKH+3,X - STA DSTH - PLA - AND #$10 ; EXTERN REF - EXIT - BNE RLDEX - TAY ; FIXUP=*ADDR+MODOFST - LDA (DST),Y - INY - CLC - ADC ESTKL+2,X - STA TMPL - LDA (DST),Y - ADC ESTKH+2,X - CMP ESTKH+1,X ; FIXUP >= BYTECODE? - BCC + - STA TMPH - BNE RLDEX ; YEP, EXIT - LDA TMPL - CMP ESTKL+1,X - BCS RLDEX ; YEP, EXIT - LDA TMPH -+ STA (DST),Y ; *ADDR=FIXUP DEY - LDA TMPL + BEQ + +- LDA (SRC),Y STA (DST),Y - LDA SRCL ; NEXT ENTRY -; CLC - ADC #$04 - STA SRCL - BCC - - INC SRCH + DEY BNE - -RLDEX INX - LDA TMPL - STA ESTKL,X - LDA TMPH - STA ESTKH,X - LDA DSTL - STA ESTKL+1,X - LDA DSTH - STA ESTKH+1,X - LDA SRCL - STA ESTKL+2,X - LDA SRCH - STA ESTKH+2,X ++ LDA (SRC),Y + STA (DST),Y + STY SRCX + INX + INX RTS end +include "libsrc/jitcore.pla" // // SOS routines // FILE I/O @@ -793,7 +78,7 @@ def getpfx(path)#1 params.0 = 2 params:1 = path params.3 = 128 - perr = syscall($C7, @params) + syscall($C7, @params) return path end def setpfx(path)#1 @@ -804,89 +89,15 @@ def setpfx(path)#1 params:1 = path params:3 = @fileinfo params.5 = 2 - perr = syscall($C4, @params) // Get file info - if not perr and (fileinfo.1 == $00 or fileinfo.1 == $0F) // Make sure it's a directory + if not syscall($C4, @params) and (fileinfo.1 == $00 or fileinfo.1 == $0F) // Make sure it's a directory params.0 = 1 params:1 = path - perr = syscall($C6, @params) + syscall($C6, @params) else - perr = $44 + getpfx(path) // Get current path fin return path end -def volume(devname, volname)#1 - byte params[9] - - params.0 = 4 - params:1 = devname - params:3 = volname - params:5 = 0 - params:7 = 0 - perr = syscall($C5, @params) - return perr -end -def open(path)#1 - byte params[7] - - params.0 = 4 - params:1 = path - params.3 = 0 - params:4 = 0 - params.6 = 0 - perr = syscall($C8, @params) - return params.3 -end -def close(refnum)#1 - byte params[2] - - params.0 = 1 - params.1 = refnum - perr = syscall($CC, @params) - return perr -end -def read(refnum, buff, len)#1 - byte params[8] - - params.0 = 4 - params.1 = refnum - params:2 = buff - params:4 = len - params:6 = 0 - perr = syscall($CA, @params) - return params:6 -end -def write(refnum, buff, len)#1 - byte params[6] - - params.0 = 3 - params.1 = refnum - params:2 = buff - params:4 = len - perr = syscall($CB, @params) - return perr -end -// -// DEVICE I/O -// -def dev_control(devnum, code, list)#1 - byte params[5] - - params.0 = 3 - params.1 = devnum - params.2 = code - params:3 = list - perr = syscall($83, @params) - return perr -end -def dev_getnum(name)#1 - byte params[4] - - params.0 = 2 - params:1 = name - params.3 = 0 - perr = syscall($84, @params) - return params.3 -end def dev_info(devnum, name, list, listlen)#1 byte params[7] @@ -895,388 +106,17 @@ def dev_info(devnum, name, list, listlen)#1 params:2 = name params:4 = list params.6 = listlen - perr = syscall($85, @params) - return perr + return syscall($85, @params) end -// -// MEMORY CALLS -// -def seg_find(search, pages, id)#3 - byte params[10] +def volume(devname, volname)#1 + byte params[9] - params.0 = 6 - params.1 = search - params.2 = id - params:3 = pages + params.0 = 4 + params:1 = devname + params:3 = volname params:5 = 0 params:7 = 0 - params.9 = 0 - perr = syscall($41, @params) - return params.9, params:5, params:7 -end -def seg_release(segnum)#1 - byte params[2] - - params.0 = 1 - params.1 = segnum - perr = syscall($45, @params) - return perr -end -// -// CONSOLE I/O -// -def init_cons()#0 - byte nlmode[2] - if !refcons - refcons = open(@console) - fin - write(refcons, @textmode, 3) - devcons = dev_getnum(@console) - nlmode:0 = $0D80 - //nlmode.0 = $80 - //nlmode.1 = $0D - dev_control(devcons, $02, @nlmode) -end -def cout(ch)#0 - if ch == $0D - ch = $0A0D - write(refcons, @ch, 2) - else - write(refcons, @ch, 1) - fin -end -def crout()#0 - cout($0D) -end -def cin()#1 - byte ch - read(refcons, @ch, 1) - return ch & $7F -end -def prstr(str)#0 - write(refcons, str + 1, ^str) - if str->[^str] == $0D - cout($0A) - fin -end -def print(i)#0 - if i < 0; cout('-'); i = -i; fin - if i >= 10; print(i / 10); fin - cout(i % 10 + '0') -end -def rdstr(prompt)#1 - cout(prompt) - ^heap = read(refcons, heap + 1, 128) - if heap->[^heap] == $0D - ^heap-- - fin - crout - return heap -end -def prbyte(v)#0 - cout(hexchar[(v >> 4) & $0F]) - cout(hexchar[v & $0F]) -end -def prword(v)#0 - prbyte(v >> 8) - prbyte(v) -end -// -// Heap routines. -// -def availheap()#1 - byte fp - return @fp - heap -end -def allocheap(size)#1 - word addr - addr = heap - heap = heap + size - if uword_isge(heap, @addr) - return 0 - fin - return addr -end -def allocalignheap(size, pow2, freeaddr)#1 - word align, addr - if freeaddr - *freeaddr = heap - fin - align = (1 << pow2) - 1 - addr = (heap | align) + 1 - heap = addr + size - if uword_isge(heap, @addr) - return 0 - fin - return addr -end -def markheap()#1 - return heap -end -def releaseheap(newheap)#1 - heap = newheap - return @newheap - heap -end -// -// Symbol table routines. -// -def addsym(sym, addr)#0 - while ^sym & $80 - xpokeb(symtbl.0, lastsym, ^sym) - lastsym = lastsym + 1 - sym = sym + 1 - loop - xpokeb(symtbl.0, lastsym, ^sym) - xpokeb(symtbl.0, lastsym + 1, addr.0) - xpokeb(symtbl.0, lastsym + 2, addr.1) - xpokeb(symtbl.0, lastsym + 3, 0) - lastsym = lastsym + 3 -end -// -// String routines. -// -def strcpy(dst, src)#1 - memcpy(dst+1, src+1, ^src) - ^dst = ^src - return dst -end -def strcat(dst, src)#1 - memcpy(dst + ^dst + 1, src + 1, ^src) - ^dst = ^dst + ^src - return dst -end -// -// Module routines. -// -def lookupextern(esd, index)#1 - word sym, addr - byte str[16] - sym = lookupidx(esd, index) - if sym - addr = lookuptbl(sym, symtbl) - if !addr - perr = $81 - dcitos(sym, @str) - cout('?'); prstr(@str); crout - fin - return addr - fin - return 0 -end -def adddef(ext, addr, deflast)#1 - word defentry - defentry = *deflast - *deflast = defentry + 6 - defentry->0 = $20 - defentry=>1 = interp - defentry=>3 = addr - defentry=>5 = ext // ext is byte, so this nulls out next entry - return defentry -end -def loadmod(mod)#1 - word refnum, rdlen, modsize, bytecode, codefix, defofst, defcnt, init, fixup - word addr, defaddr, modaddr, modfix, modofst, modend - word deftbl, deflast, codeseg - word moddep, rld, esd, sym - byte defext, str[16], filename[33] - byte header[128] - lerr = 0 - // - // Read the RELocatable module header (first 128 bytes) - // - dcitos(mod, @filename) - refnum = open(@filename) - if !refnum - // - // Try system path - // - refnum = open(strcpy(@filename,strcat(strcpy(@header, @sysmods), @filename))) - fin - if refnum - rdlen = read(refnum, @header, 128) - modsize = header:0 - moddep = @header.1 - defofst = modsize + RELADDR - defext = 0 - init = 0 - if rdlen > 4 and header:2 == $6502 // magic number - // - // This is an EXTended RELocatable (data+bytecode) module. - // - systemflags = header:4 | systemflags - defofst = header:6 - defcnt = header:8 - init = header:10 - moddep = @header.12 - // - // Load module dependencies. - // - while ^moddep - if !lookuptbl(moddep, symtbl) - if refnum - close(refnum) - refnum = 0 - fin - if loadmod(moddep) < 0 - return -perr - fin - fin - moddep = moddep + dcitos(moddep, @str) - loop - // - // Init def table. - // - deftbl = allocheap(defcnt * 6 + 1) - deflast = deftbl - ^deflast = 0 - if !refnum - // - // Reset read pointer. - // - refnum = open(@filename) - rdlen = read(refnum, @header, 128) - fin - fin - // - // Alloc heap space for relocated module (data + bytecode). - // - moddep++ - modfix = moddep - @header.2 // Adjust to skip header - modsize = modsize - modfix - rdlen = rdlen - modfix - 2 - modaddr = allocheap(modsize) - memcpy(modaddr, moddep, rdlen) - // - // Read in remainder of module into memory for fixups. - // - addr = modaddr - repeat - addr = addr + rdlen - rdlen = read(refnum, addr, 4096) - until rdlen <= 0 - close(refnum) - // - // Add module to symbol table. - // - addsym(mod, modaddr) - // - // Apply all fixups and symbol import/export. - // - modfix = modaddr - modfix - modofst = modfix - RELADDR - modend = modaddr + modsize - bytecode = defofst + modofst - rld = modend // Re-Locatable Directory - esd = rld // Extern+Entry Symbol Directory - while ^esd // Scan to end of ESD - esd = esd + 4 - loop - esd++ - if defcnt - // - // Locate bytecode defs in allocated segment. - // - modseg[modid], codeseg, drop = seg_find($00, (rld - bytecode + 255) >> 8, modid + $12) - if perr - return -perr - fin - modid++ - defext = codeseg.0 + $7F // (codeseg.0 | $80) - 1 - defaddr = (codeseg & $FF00) + $6000 - codefix = defaddr - bytecode - defofst = defaddr - defofst - fin - // - // Run through the DeFinition Dictionary. - // - while ^rld == $02 - // - // This is a bytcode def entry - add it to the def directory. - // - adddef(defext, rld=>1 + defofst, @deflast) - rld = rld + 4 - loop - // - // Run through the Re-Location Dictionary. - // - while ^rld - rld, addr, fixup = reloc(modfix, modofst, bytecode, rld) - if ^rld - *addr = ^rld & $10 ?? *addr + lookupextern(esd, rld->3) :: lookupdef(fixup + codefix, deftbl) - rld = rld + 4 - fin - //addr = rld=>1 + modfix - //if uword_isge(addr, modaddr) // Skip fixups to header - // if type & $80 // WORD sized fixup. - // fixup = *addr - // else // BYTE sized fixup. - // fixup = ^addr - // fin - // if ^rld & $10 // EXTERN reference. - // fixup = fixup + lookupextern(esd, rld->3) - // else // INTERN fixup. - // fixup = fixup + modofst - // if uword_isge(fixup, bytecode) - // // - // // Bytecode address - replace with call def directory. - // // - // fixup = lookupdef(fixup + codefix, deftbl) - // fin - // fin - // if type & $80 // WORD sized fixup. - // *addr = fixup - // else // BYTE sized fixup. - // ^addr = fixup - // fin - //fin - //rld = rld + 4 - loop - // - // Run through the External/Entry Symbol Directory. - // - while ^esd - sym = esd - esd = esd + dcitos(esd, @str) - if ^esd & $08 - // - // EXPORT symbol - add it to the global symbol table. - // - addr = esd=>1 + modofst - if uword_isge(addr, bytecode) - // - // Use the def directory address for bytecode. - // - addr = lookupdef(addr + codefix, deftbl) - fin - addsym(sym, addr) - fin - esd = esd + 3 - loop - if defext - // - // Copy bytecode to code segment. - // - memxcpy(codeseg, bytecode, modsize - (bytecode - modaddr)) - fin - fin - if lerr - return -lerr - fin - // - // Free up end-of-module main memory. - // - releaseheap(bytecode) - // - // Call init routine if it exists. - // - fixup = 0 - if init - fixup = adddef(defext, init + defofst, @deflast)() - if fixup < 0 - perr = -fixup - fin - fin - return fixup + return syscall($C5, @params) end // // Command mode @@ -1289,39 +129,39 @@ def volumes()#0 for i = $01 to $18 if dev_info(i, @devname, @info, 11) == 0 - prstr(@devname) + puts(@devname) if volume(@devname, @volname) == 0 - prstr(" => /") - prstr(@volname) - cout('/') + puts(" => /") + puts(@volname) + putc('/') fin - crout + putln fin next - perr = 0 end def catalog(path)#0 byte refnum byte firstblk byte entrylen, entriesblk byte i, type, len - word entry, filecnt + word entry, filecnt, catptr if !^path - path = @prefix + getpfx(path) fin - refnum = open(path) - if perr + refnum = cmdsys:sysopen(path) + if not refnum return fin + catptr = heapmark firstblk = 1 repeat - if read(refnum, heap, 512) == 512 - entry = heap + 4 + if cmdsys:sysread(refnum, catptr, 512) == 512 + entry = catptr + 4 if firstblk - entrylen = heap->$23 - entriesblk = heap->$24 - filecnt = heap=>$25 + entrylen = catptr->$23 + entriesblk = catptr->$24 + filecnt = catptr=>$25 entry = entry + entrylen fin for i = firstblk to entriesblk @@ -1329,7 +169,7 @@ def catalog(path)#0 if type len = type & $0F ^entry = len - prstr(entry) + puts(entry) type = ' ' when entry->$10 is $0F // Is it a directory? @@ -1341,9 +181,9 @@ def catalog(path)#0 is $FE // REL file type = '+' wend - cout(type) + putc(type) for len = 18 - len downto 0 - cout(' ') + putc(' ') next filecnt-- fin @@ -1354,8 +194,8 @@ def catalog(path)#0 filecnt = 0 fin until filecnt == 0 - close(refnum) - crout() + cmdsys:sysclose(refnum) + putln() end def stripchars(strptr)#1 while ^strptr and ^(strptr + 1) > ' ' @@ -1397,127 +237,83 @@ def parsecmd(strptr)#1 stripspaces(strptr) return cmd end -def execmod(modfile)#1 - byte moddci[17] - word saveheap, savesym, saveflags - - perr = 1 - if stodci(modfile, @moddci) - saveheap = heap - savesym = lastsym - saveflags = systemflags - if loadmod(@moddci) < modkeep - lastsym = savesym - heap = saveheap - while modid - modid-- - seg_release(modseg[modid]) - loop - else - modid = 0 +// +// Command line handler +// +def shell#1 + byte textmode[3] + byte prefix[64] + byte err[] + word cmdptr + // + // Copy AUTORUN commmand line + // + cmdptr = strcpy(heapmark, cmdsys:cmdline) + // + // Handle commands. + // + repeat + if ^cmdptr + when toupper(parsecmd(cmdptr)) + is 'C' + catalog(cmdptr) + break + is 'P' + if ^cmdptr and ^(cmdptr + 1) <> '/' + strcat(@prefix, cmdptr) + else + strcpy(@prefix, cmdptr) + fin + setpfx(@prefix) + break + is '/' + repeat + prefix-- + until prefix[prefix] == '/' + if prefix > 1 + setpfx(@prefix) + fin + break + is 'S' + setpfx(cmdptr) + strcat(getpfx(cmdsys:syspath), "SYS/")) + break + is 'V' + volumes + break + is '+' + //cmdsys:modexec(striptrail(cmdptr)) + return striptrail(cmdptr) + //cmdsys:syswrite(cmdsys.refcons, @textmode, 3) + break + otherwise + puts("?\n") + wend + if cmdsys.syserr + err = cmdsys.syserr + puts("ERR:$") + putb(err) + else + puts("OK") + fin + putln fin - xpokeb(symtbl.0, lastsym, 0) - systemflags = saveflags - fin - return -perr + puts(getpfx(@prefix)) + cmdptr = gets($BA) + strcpy(cmdsys:cmdline, cmdptr) + until 0 + return 0 end // -// Init console. +// Save pointer to command line handler // -init_cons +*cmdparser = @shell // -// Print PLASMA version +// Install JIT compiler // -prstr("PLASMA "); prbyte(version.1); cout('.'); prbyte(version.0); crout -// -// Init 2K symbol table. -// -drop, symtbl, drop = seg_find($00, $08, $11) -lastsym = symtbl & $FF00 -xpokeb(symtbl.0, lastsym, 0) -while *sysmodsym - stodci(sysmodsym=>0, heap) - addsym(heap, sysmodsym=>2) - sysmodsym = sysmodsym + 4 -loop -// -// Clear system path -// -sysmods = 0 -syspath = @sysmods -// -// Try to load autorun. -// -cmdlnptr = @cmdln -cmdptr = heap -^cmdptr = 0 -autorun = open(@autorun) -if autorun > 0 - ^cmdptr = read(autorun, cmdptr + 1, 64) - close(autorun) -else - // - // Print some startup info. - // - prstr("MEM:$") - prword(availheap) - crout -fin -perr = 0 -// -// Handle commands. -// -while 1 - if ^cmdptr - when toupper(parsecmd(cmdptr)) - is 'C' - catalog(cmdptr) - break - is 'P' - if ^cmdptr and ^(cmdptr + 1) <> '/' - strcat(@prefix, cmdptr) - else - strcpy(@prefix, cmdptr) - fin - setpfx(@prefix) - break - is '/' - repeat - prefix-- - until prefix[prefix] == '/' - if prefix > 1 - setpfx(@prefix) - fin - break - is 'S' - setpfx(cmdptr) - strcat(getpfx(@sysmods), "SYS/")) - break - is 'V' - volumes - break - is '+' - saveX - execmod(striptrail(cmdptr)) - restoreX - //close(0) - init_cons - break - otherwise - prstr("?\n") - wend - if perr - terr = perr - prstr("ERR:$") - prbyte(terr) - perr = 0 - else - prstr("OK") - fin - crout() - fin - prstr(getpfx(@prefix)) - cmdptr = rdstr($BA) - strcpy(@cmdln, cmdptr) -loop +directentry = *sinterp +indirectentry = *xinterp +*jitcomp = @compiler +cmdsys.jitcount = 44 +cmdsys.jitsize = 96 done diff --git a/src/vmsrc/apple/sossys.pla b/src/vmsrc/apple/sossys.pla new file mode 100755 index 0000000..98e60cb --- /dev/null +++ b/src/vmsrc/apple/sossys.pla @@ -0,0 +1,1335 @@ +const membank = $FFEF +const RELADDR = $1000 +// +// System flags: memory allocator screen holes. +// +const restxt1 = $0001 +const restxt2 = $0002 +const resxtxt1 = $0004 +const resxtxt2 = $0008 +const reshgr1 = $0010 +const reshgr2 = $0020 +const resxhgr1 = $0040 +const resxhgr2 = $0080 +const nojitc = $0100 +// +// Module don't free memory +// +const modkeep = $2000 +const modinitkeep = $4000 +// +// Private addresses +// +const instr = $A020 +const cmdparser = $A0F0 +const xinterp = $A0F8 +const jitinterp = $A0FA +// +// Indirect interpreter DEFinition entrypoint +// +struc t_defentry + byte interpjsr + word interpaddr + word bytecodeaddr + byte bytecodexbyte + byte callcount + byte bytecodesize +end +// +// JIT compiler values +// +const jitcomp = $A0F2 +const jitcodeptr = $A0F4 +const codemax = $A000 +// +// Pedefined functions. +// +predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1 +predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, prbyte(b)#0, prword(w)#0 +predef cin()#1, rdstr(p)#1, toupper(c)#1, strcpy(dst,src)#1, strcat(dst,src)#1 +predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr), releaseheap(newheap)#1, availheap()#1 +predef memset(addr,value,size)#0, memcpy(dst,src,size)#0 +predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1, sext(a)#1, divmod(a,b)#2 +predef execmod(modfile)#1, open(path)#1, close(refnum)#1, read(refnum, buff, len)#1, write(refnum, buff, len)#1 +// +// Exported CMDSYS table +// +word version = $0200 // 02.00 +word syspath +word cmdlnptr +word = @execmod, @open, @close, @read, @write +byte perr +byte jitcount = 0 +byte jitsize = 0 +byte refcons = 0 +byte devcons = 0 +// +// String pool. +// +byte hexchar[] = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F' +// +// Exported Machine ID. +// +byte machid = $F2 // Apple ///, 80 columns +// +// Console and textmode control characters +// +byte console[] = ".CONSOLE" +byte textmode[] = 16, 0, 15 + +// +// Working input buffer overlayed with strings table +// +byte cmdln = "" +// +// SOS.CMD as DCI string +// +byte soscmd = 'S'|$80,'O'|$80,'S'|$80,'.'|$80,'C'|$80,'M'|$80,'D' +// +// Standard Library exported functions. +// +byte sysmodstr[] = "CMDSYS" +byte machidstr[] = "MACHID" +byte sysstr[] = "SYSCALL" +byte callstr[] = "CALL" +byte putcstr[] = "PUTC" +byte putlnstr[] = "PUTLN" +byte putsstr[] = "PUTS" +byte putistr[] = "PUTI" +byte putbstr[] = "PUTB" +byte putwstr[] = "PUTH" +byte getcstr[] = "GETC" +byte getsstr[] = "GETS" +byte toupstr[] = "TOUPPER" +byte strcpystr[] = "STRCPY" +byte strcatstr[] = "STRCAT" +byte hpmarkstr[] = "HEAPMARK" +byte hpalignstr[] = "HEAPALLOCALIGN" +byte hpallocstr[] = "HEAPALLOC" +byte hprelstr[] = "HEAPRELEASE" +byte hpavlstr[] = "HEAPAVAIL" +byte memsetstr[] = "MEMSET" +byte memcpystr[] = "MEMCPY" +byte uisgtstr[] = "ISUGT" +byte uisgestr[] = "ISUGE" +byte uisltstr[] = "ISULT" +byte uislestr[] = "ISULE" +byte sextstr[] = "SEXT" +byte divmodstr[] = "DIVMOD" +byte sysmods[] = "" // overlay sys path with exports +word exports[] = @sysmodstr, @version +word = @sysstr, @syscall +word = @callstr, @call +word = @putcstr, @cout +word = @putlnstr, @crout +word = @putsstr, @prstr +word = @putistr, @print +word = @putbstr, @prbyte +word = @putwstr, @prword +word = @getcstr, @cin +word = @getsstr, @rdstr +word = @toupstr, @toupper +word = @hpmarkstr, @markheap +word = @hpallocstr,@allocheap +word = @hpalignstr,@allocalignheap +word = @hprelstr, @releaseheap +word = @hpavlstr, @availheap +word = @memsetstr, @memset +word = @memcpystr, @memcpy +word = @strcpystr, @strcpy +word = @strcatstr, @strcat +word = @uisgtstr, @uword_isgt +word = @uisgestr, @uword_isge +word = @uisltstr, @uword_islt +word = @uislestr, @uword_isle +word = @sextstr, @sext +word = @divmodstr, @divmod +word = @machidstr, @machid +word = 0 +word sysmodsym = @exports +// +// System variables. +// +word systemflags = 0 +word heap = $2000 +byte autorun[] +byte modseg[15] +byte modid = 0 +word symtbl, lastsym +// +// CALL SOS +// SYSCALL(CMD, PARAMS) +// +asm syscall(cmd,params)#1 + LDA ESTKL,X + LDY ESTKH,X + STA PARAMS + STY PARAMS+1 + INX + LDA ESTKL,X + STA CMD + BRK +CMD !BYTE 00 +PARAMS !WORD 0000 + LDY #$00 + STA ESTKL,X + STY ESTKH,X + RTS +end +// +// CALL 6502 ROUTINE +// CALL(AREG, XREG, YREG, STATUS, ADDR) +// +asm call(addr,areg,xreg,yreg,sstatus)#1 +REGVALS = SRC + PHP + LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + INX + LDA ESTKL,X + PHA + INX + LDY ESTKL,X + INX + LDA ESTKL+1,X + PHA + LDA ESTKL,X + INX + STX ESP + TAX + PLA + PLP + JSR JMPTMP + PHP + STA REGVALS+0 + STX REGVALS+1 + STY REGVALS+2 + PLA + STA REGVALS+3 + LDX ESP + LDA #REGVALS + STA ESTKL,X + STY ESTKH,X + PLP + RTS +end +// +// SET MEMORY TO VALUE +// MEMSET(ADDR, VALUE, SIZE) +// With optimizations from Peter Ferrie +// +asm memset(addr,value,size)#0 + LDA ESTKL+2,X + STA DSTL + LDA ESTKH+2,X + STA DSTH + LDY ESTKL,X + BEQ + + INC ESTKH,X + LDY #$00 ++ LDA ESTKH,X + BEQ SETMEX +SETMLPL CLC + LDA ESTKL+1,X +SETMLPH STA (DST),Y + DEC ESTKL,X + BEQ ++ +- INY + BEQ + +-- BCS SETMLPL + SEC + LDA ESTKH+1,X + BCS SETMLPH ++ INC DSTH + BNE -- +++ DEC ESTKH,X + BNE - +SETMEX INX + INX + INX + RTS +end +// +// COPY MEMORY +// MEMCPY(DSTADDR, SRCADDR, SIZE) +// +asm memcpy(dst,src,size)#0 + INX + INX + INX + LDA ESTKL-3,X + ORA ESTKH-3,X + BEQ CPYMEX + LDA ESTKL-2,X + CMP ESTKL-1,X + LDA ESTKH-2,X + SBC ESTKH-1,X + BCC REVCPY +; +; FORWARD COPY +; + LDA ESTKL-1,X + STA DSTL + LDA ESTKH-1,X + STA DSTH + LDA ESTKL-2,X + STA SRCL + LDA ESTKH-2,X + STA SRCH + LDY ESTKL-3,X + BEQ FORCPYLP + INC ESTKH-3,X + LDY #$00 +FORCPYLP LDA (SRC),Y + STA (DST),Y + INY + BNE + + INC DSTH + INC SRCH ++ DEC ESTKL-3,X + BNE FORCPYLP + DEC ESTKH-3,X + BNE FORCPYLP + RTS +; +; REVERSE COPY +; +REVCPY ;CLC + LDA ESTKL-3,X + ADC ESTKL-1,X + STA DSTL + LDA ESTKH-3,X + ADC ESTKH-1,X + STA DSTH + CLC + LDA ESTKL-3,X + ADC ESTKL-2,X + STA SRCL + LDA ESTKH-3,X + ADC ESTKH-2,X + STA SRCH + DEC DSTH + DEC SRCH + LDY #$FF + LDA ESTKL-3,X + BEQ REVCPYLP + INC ESTKH-3,X +REVCPYLP LDA (SRC),Y + STA (DST),Y + DEY + CPY #$FF + BNE + + DEC DSTH + DEC SRCH ++ DEC ESTKL-3,X + BNE REVCPYLP + DEC ESTKH-3,X + BNE REVCPYLP +CPYMEX RTS +end +// +// COPY FROM MAIN MEM TO EXT MEM. +// +// MEMXCPY(DSTSEG, SRC, SIZE) +// +asm memxcpy(dst,src,size)#0 + LDA ESTKL,X + ORA ESTKH,X + BEQ CPYXMEX + LDY #$00 + STY DSTL + LDA ESTKH+2,X + CLC + ADC #$60 + STA DSTH + LDA ESTKL+2,X + CLC + ADC #$7F + STA DSTX + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + INC ESTKH,X +CPYXLP LDA (SRC),Y + STA (DST),Y + INY + BNE + + INC DSTH + INC SRCH ++ DEC ESTKL,X + BNE CPYXLP + DEC ESTKH,X + BNE CPYXLP + LDA #$00 + STA DSTX +CPYXMEX INX + INX + INX + RTS +end +// +// POKE BYTE VAL INTO EXT MEM. +// +// XPOKEB(SEG, DST, BYTEVAL) +// +asm xpokeb(seg, dst, byteval)#0 + LDA ESTKL+1,X + STA DSTL + LDA ESTKH+1,X + CLC + ADC #$60 + STA DSTH + LDA ESTKL+2,X + CLC + ADC #$7F + STA DSTX + LDY #$00 + LDA ESTKL,X + STA (DST),Y + STY DSTX + INX + INX + INX + RTS +end +// +// Unsigned word comparisons. +// +asm uword_isge(a,b)#1 + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + LDA #$FF + ADC #$00 + EOR #$FF + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS +end +asm uword_isle(a,b)#1 + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + LDA #$FF + ADC #$00 + EOR #$FF + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS +end +asm uword_isgt(a,b)#1 + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + LDA #$FF + ADC #$00 + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS +end +asm uword_islt(a,b)#1 + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + LDA #$FF + ADC #$00 + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS +end +asm divmod(a,b)#2 + JSR INTERP ; CALL INTERP + !BYTE $36, $5C ; DIVMOD, RET +end +asm sext(a)#1 + LDY #$00 + LDA ESTKL,X + BPL + + DEY ++ STY ESTKH,X + RTS +end +// +// A DCI string is one that has the high bit set for every character except the last. +// More efficient than C or Pascal strings. +// +//def dcitos(dci, str) +// byte len, c +// len = 0 +// repeat +// c = (dci).[len] +// len = len + 1 +// (str).[len] = c & $7F +// until !(c & $80) +// ^str = len +// return len +//end +asm dcitos(dci, str)#1 + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + LDY #$00 +- LDA (SRC),Y + CMP #$80 + AND #$7F + INY + STA (DST),Y + BCS - + TYA + LDY #$00 + STA (DST),Y + INX + STA ESTKL,X + STY ESTKH,X + RTS +end +//def stodci(str, dci) +// byte len, c +// len = ^str +// if len == 0 +// return +// fin +// c = toupper((str).[len]) & $7F +// len = len - 1 +// (dci).[len] = c +// while len +// c = toupper((str).[len]) | $80 +// len = len - 1 +// (dci).[len] = c +// loop +// return ^str +//end +asm stodci(str, dci)#1 + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + INX + LDY #$00 + LDA (SRC),Y + BEQ ++ + TAY + LDA (SRC),Y + JSR TOUPR + BNE + +- LDA (SRC),Y + JSR TOUPR + ORA #$80 ++ DEY + STA (DST),Y + BNE - + LDA (SRC),Y +++ STA ESTKL,X + STY ESTKH,X + RTS +end +asm toupper(c)#1 + LDA ESTKL,X +TOUPR AND #$7F + CMP #'a' + BCC + + CMP #'z'+1 + BCS + + SBC #$1F ++ STA ESTKL,X + RTS +end +// +// Lookup routines. +// +//def lookuptbl(dci, tbl) +// word match +// while ^tbl +// match = dci +// while ^tbl == ^match +// if !(^tbl & $80) +// return (tbl):1 +// fin +// tbl = tbl + 1 +// match = match + 1 +// loop +// while (^tbl & $80) +// tbl = tbl + 1 +// loop +// tbl = tbl + 3 +// loop +// return 0 +asm lookuptbl(dci, tbl)#1 + LDY #$00 + STY DSTL + LDA ESTKH,X + CLC + ADC #$60 + STA DSTH + LDA ESTKL,X + CLC + ADC #$7F + STA DSTX + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH +- LDA (DST),Y + BEQ + + CMP (SRC),Y + BNE ++ + INY + ASL + BCS - + LDA (DST),Y + PHA + INY + LDA (DST),Y + TAY + PLA ++ INX + STA ESTKL,X + STY ESTKH,X + LDA #$00 + STA DSTX + RTS +++ LDY #$00 +-- LDA (DST),Y + INC DSTL + BEQ + +--- ASL + BCS -- + LDA #$02 + ADC DSTL + STA DSTL + BCC - + INC DSTH + BCS - ++ INC DSTH + BNE --- +end +// def lookupidx(esd, index) +// word sym +// while ^esd +// sym = esd +// esd = sym + dcitos(sym, @str) +// if esd->0 & $10 and esd->1 == index +// return sym +// fin +// esd = esd + 3 +// loop +//end +asm lookupidx(esd, index)#1 + LDA ESTKL,X + STA TMPL + INX +--- LDA ESTKH,X + STA SRCH + LDA ESTKL,X +-- STA SRCL + LDY #$00 +- LDA (SRC),Y + BPL + + INY + BNE - ++ BEQ ++ ; END OF ESD + INY + LDA (SRC),Y + INY + AND #$10 ; EXTERN FLAG? + BEQ + + LDA (SRC),Y + CMP TMPL + BEQ +++ ; MATCH ++ INY + TYA + SEC + ADC SRCL + STA ESTKL,X ; SYM PTRL + BCC -- + INC ESTKH,X ; SYM PTRH + BNE --- +++ STA ESTKL,X ; END OF ESD + STA ESTKH,X ++++ RTS +end +//def lookupdef(addr, deftbl)#1 +// while deftbl->0 == $20 +// if deftbl=>3 == addr +// return deftbl +// fin +// deftbl = deftbl + t_defentry +// loop +// return 0 +//end +asm lookupdef(addr, deftbl)#1 + LDA ESTKH,X + STA SRCH + LDA ESTKL,X + STA SRCL + INX +- LDY #$00 + LDA (SRC),Y + CMP #$20 ; JSR OPCODE? + BNE ++ + LDY #$03 + LDA (SRC),Y + CMP ESTKL,X + BNE + + INY + LDA (SRC),Y + CMP ESTKH,X + BNE + + LDA SRCL ; MATCH + STA ESTKL,X + LDA SRCH + STA ESTKH,X + RTS ++ LDA #$08 ; T_DEFENTRY + CLC + ADC SRCL + STA SRCL + BCC - + INC SRCH + BNE - +++ STY ESTKL,X + STY ESTKH,X + RTS +end +// +// Reloc internal data +// +//def reloc(modfix, modofst, bytecode, rld)#3 +// word addr, fixup +// while ^rld +// if ^rld & $10 // EXTERN reference. +// return rld, addr, fixup +// fin +// addr = rld=>1 + modfix +// fixup = *addr + modofst +// if uword_isge(fixup, bytecode) // Bytecode address. +// return rld, addr, fixup +// fin +// *addr = fixup +// rld = rld + 4 +// loop +// return rld, addr, fixup +//end +asm reloc(modfix, modofst, bytecode, rld)#3 + LDA ESTKL,X + STA SRCL + LDA ESTKH,X + STA SRCH + LDY #$00 +- LDA (SRC),Y + BEQ RLDEX ; END OF RLD + PHA + INY + LDA (SRC),Y + INY + CLC + ADC ESTKL+3,X ; ADDR=ENTRY=>1+MODFIX + STA DSTL + LDA (SRC),Y + ADC ESTKH+3,X + STA DSTH + PLA + AND #$10 ; EXTERN REF - EXIT + BNE RLDEX + TAY ; FIXUP=*ADDR+MODOFST + LDA (DST),Y + INY + CLC + ADC ESTKL+2,X + STA TMPL + LDA (DST),Y + ADC ESTKH+2,X + CMP ESTKH+1,X ; FIXUP >= BYTECODE? + BCC + + STA TMPH + BNE RLDEX ; YEP, EXIT + LDA TMPL + CMP ESTKL+1,X + BCS RLDEX ; YEP, EXIT + LDA TMPH ++ STA (DST),Y ; *ADDR=FIXUP + DEY + LDA TMPL + STA (DST),Y + LDA SRCL ; NEXT ENTRY +; CLC + ADC #$04 + STA SRCL + BCC - + INC SRCH + BNE - +RLDEX INX + LDA TMPL + STA ESTKL,X + LDA TMPH + STA ESTKH,X + LDA DSTL + STA ESTKL+1,X + LDA DSTH + STA ESTKH+1,X + LDA SRCL + STA ESTKL+2,X + LDA SRCH + STA ESTKH+2,X + RTS +end +// +// SOS routines +// FILE I/O +// +def open(path)#1 + byte params[7] + + params.0 = 4 + params:1 = path + params.3 = 0 + params:4 = 0 + params.6 = 0 + perr = syscall($C8, @params) + return params.3 +end +def close(refnum)#1 + byte params[2] + + params.0 = 1 + params.1 = refnum + perr = syscall($CC, @params) + return perr +end +def read(refnum, buff, len)#1 + byte params[8] + + params.0 = 4 + params.1 = refnum + params:2 = buff + params:4 = len + params:6 = 0 + perr = syscall($CA, @params) + return params:6 +end +def write(refnum, buff, len)#1 + byte params[6] + + params.0 = 3 + params.1 = refnum + params:2 = buff + params:4 = len + perr = syscall($CB, @params) + return perr +end +// +// CONSOLE I/O +// +def dev_control(devnum, code, list)#1 + byte params[5] + + params.0 = 3 + params.1 = devnum + params.2 = code + params:3 = list + return syscall($83, @params) +end +def dev_getnum(name)#1 + byte params[4] + + params.0 = 2 + params:1 = name + params.3 = 0 + syscall($84, @params) + return params.3 +end +def init_cons()#0 + byte nlmode[2] + + refcons = open(@console) + devcons = dev_getnum(@console) + nlmode:0 = $0D80 + //nlmode.0 = $80 + //nlmode.1 = $0D + dev_control(devcons, $02, @nlmode) + write(refcons, @textmode, 3) +end +// +// MEMORY CALLS +// +def seg_find(search, pages, id)#3 + byte params[10] + + params.0 = 6 + params.1 = search + params.2 = id + params:3 = pages + params:5 = 0 + params:7 = 0 + params.9 = 0 + perr = syscall($41, @params) + return params.9, params:5, params:7 +end +def seg_release(segnum)#1 + byte params[2] + + params.0 = 1 + params.1 = segnum + perr = syscall($45, @params) + return perr +end +// +// CONSOLE I/O +// +def cout(ch)#0 + byte nc + + nc = 1 + if ch == $0D + ch = $0A0D + nc = 2 + fin + write(refcons, @ch, nc) +end +def crout()#0 + cout($0D) +end +def cin()#1 + byte ch + read(refcons, @ch, 1) + return ch & $7F +end +def prstr(str)#0 + write(refcons, str + 1, ^str) + if str->[^str] == $0D + cout($0A) + fin +end +def print(i)#0 + if i < 0; cout('-'); i = -i; fin + if i >= 10; print(i / 10); fin + cout(i % 10 + '0') +end +def rdstr(prompt)#1 + cout(prompt) + ^instr = read(refcons, instr+1, 128) + if instr->[^instr] == $0D + ^instr-- + fin + crout + return instr +end +def prbyte(v)#0 + cout(hexchar[(v >> 4) & $0F]) + cout(hexchar[v & $0F]) +end +def prword(v)#0 + prbyte(v >> 8) + prbyte(v) +end +// +// Heap routines. +// +def availheap()#1 + byte fp + return @fp - heap +end +def allocheap(size)#1 + word addr + addr = heap + heap = heap + size + if uword_isge(heap, @addr) + heap = addr + return 0 + fin + return addr +end +def allocalignheap(size, pow2, freeaddr)#1 + word align, addr + if freeaddr + *freeaddr = heap + fin + align = (1 << pow2) - 1 + addr = (heap | align) + 1 + heap = addr + size + if uword_isge(heap, @addr) + return 0 + fin + return addr +end +def markheap()#1 + return heap +end +def releaseheap(newheap)#1 + heap = newheap + return @newheap - heap +end +// +// Symbol table routines. +// +def addsym(sym, addr)#0 + while ^sym & $80 + xpokeb(symtbl.0, lastsym, ^sym) + lastsym = lastsym + 1 + sym = sym + 1 + loop + xpokeb(symtbl.0, lastsym, ^sym) + xpokeb(symtbl.0, lastsym + 1, addr.0) + xpokeb(symtbl.0, lastsym + 2, addr.1) + xpokeb(symtbl.0, lastsym + 3, 0) + lastsym = lastsym + 3 +end +// +// String routines. +// +def strcpy(dst, src)#1 + memcpy(dst+1, src+1, ^src) + ^dst = ^src + return dst +end +def strcat(dst, src)#1 + memcpy(dst + ^dst + 1, src + 1, ^src) + ^dst = ^dst + ^src + return dst +end +// +// Module routines. +// +def lookupextern(esd, index)#1 + word sym, addr + byte str[16] + sym = lookupidx(esd, index) + if sym + addr = lookuptbl(sym, symtbl) + if !addr + perr = $81 + dcitos(sym, @str) + cout('?'); prstr(@str); crout + fin + return addr + fin + return 0 +end +def adddef(isfirst, ext, addr, deflast)#1 + word preventry, defentry, defsize + defentry = *deflast + *deflast = defentry + t_defentry + if not isfirst + preventry = defentry - t_defentry + defsize = addr - preventry=>bytecodeaddr + if defsize <= jitsize + preventry=>interpaddr = *jitinterp // JSR JITINTRP + preventry->callcount = jitcount // Set JIT countdown + preventry->bytecodesize = defsize // Set size + fin + fin + defentry->interpjsr = $20 // JSR + defentry=>interpaddr = *xinterp // XINTERP + defentry=>bytecodeaddr = addr + defentry->bytecodexbyte = ext + defentry->t_defentry = 0 + return defentry +end +def loadmod(mod)#1 + word refnum[], deffirst, rdlen, modsize, bytecode, codefix, defofst, defcnt, init, fixup + word addr, defaddr, modaddr, modfix, modofst, modend + word deftbl, deflast, codeseg + word moddep, rld, esd, sym + byte lerr, defext, skipjit, fileinfo[], str[16], filename[33] + byte header[128] + lerr = 0 + // + // Read the RELocatable module header (first 128 bytes) + // + dcitos(mod, @filename) + refnum = open(@filename) + if !refnum + // + // Try system path + // + refnum = open(strcpy(@filename,strcat(strcpy(@header, @sysmods), @filename))) + fin + if refnum + header.0 = 3 + header:1 = @filename + header:3 = @fileinfo + header.5 = 2 + if not syscall($C4, @header) and fileinfo.1 <> $FE // Make sure it's a REL module + close(refnum) + perr = $4A // Incompatible type + return -perr + fin + rdlen = read(refnum, @header, 128) + modsize = header:0 + moddep = @header.1 + defofst = modsize + RELADDR + defext = 0 + init = 0 + if rdlen > 4 and header:2 == $6502 // magic number + // + // This is an EXTended RELocatable (data+bytecode) module. + // + systemflags = header.4 | systemflags + skipjit = header.5 & (nojitc >> 8) + defofst = header:6 + defcnt = header:8 + init = header:10 + moddep = @header.12 + // + // Load module dependencies. + // + while ^moddep + if !lookuptbl(moddep, symtbl) + if refnum + close(refnum) + refnum = 0 + fin + if loadmod(moddep) < 0 + return -perr + fin + fin + moddep = moddep + dcitos(moddep, @str) + loop + // + // Init def table. + // + deftbl = allocheap(defcnt * t_defentry + 1) + deflast = deftbl + ^deflast = 0 + if !refnum + // + // Reset read pointer. + // + refnum = open(@filename) + rdlen = read(refnum, @header, 128) + fin + fin + // + // Alloc heap space for relocated module (data + bytecode). + // + moddep++ + modfix = moddep - @header.2 // Adjust to skip header + modsize = modsize - modfix + rdlen = rdlen - modfix - 2 + modaddr = allocheap(modsize) + memcpy(modaddr, moddep, rdlen) + // + // Read in remainder of module into memory for fixups. + // + addr = modaddr + repeat + addr = addr + rdlen + rdlen = read(refnum, addr, 4096) + until rdlen <= 0 + close(refnum) + // + // Add module to symbol table. + // + addsym(mod, modaddr) + // + // Apply all fixups and symbol import/export. + // + modfix = modaddr - modfix + modofst = modfix - RELADDR + modend = modaddr + modsize + bytecode = defofst + modofst + rld = modend // Re-Locatable Directory + esd = rld // Extern+Entry Symbol Directory + while ^esd // Scan to end of ESD + esd = esd + 4 + loop + esd++ + if defcnt + // + // Locate bytecode defs in allocated segment. + // + modseg[modid], codeseg, drop = seg_find($00, (rld - bytecode + 255) >> 8, modid + $12) + if perr + return -perr + fin + modid++ + defext = codeseg.0 + $7F // (codeseg.0 | $80) - 1 + defaddr = (codeseg & $FF00) + $6000 + codefix = defaddr - bytecode + defofst = defaddr - defofst + fin + // + // Run through the DeFinition Dictionary. + // + deffirst = 1 + while ^rld == $02 + // + // This is a bytcode def entry - add it to the def directory. + // + adddef(deffirst, defext, rld=>1 + defofst, @deflast) + deffirst = skipjit // Calculate JIT potential or not + rld = rld + 4 + loop + // + // Run through the Re-Location Dictionary. + // + while ^rld + rld, addr, fixup = reloc(modfix, modofst, bytecode, rld) + if ^rld + *addr = ^rld & $10 ?? *addr + lookupextern(esd, rld->3) :: lookupdef(fixup + codefix, deftbl) + rld = rld + 4 + fin + //addr = rld=>1 + modfix + //if uword_isge(addr, modaddr) // Skip fixups to header + // if type & $80 // WORD sized fixup. + // fixup = *addr + // else // BYTE sized fixup. + // fixup = ^addr + // fin + // if ^rld & $10 // EXTERN reference. + // fixup = fixup + lookupextern(esd, rld->3) + // else // INTERN fixup. + // fixup = fixup + modofst + // if uword_isge(fixup, bytecode) + // // + // // Bytecode address - replace with call def directory. + // // + // fixup = lookupdef(fixup + codefix, deftbl) + // fin + // fin + // if type & $80 // WORD sized fixup. + // *addr = fixup + // else // BYTE sized fixup. + // ^addr = fixup + // fin + //fin + //rld = rld + 4 + loop + // + // Run through the External/Entry Symbol Directory. + // + while ^esd + sym = esd + esd = esd + dcitos(esd, @str) + if ^esd & $08 + // + // EXPORT symbol - add it to the global symbol table. + // + addr = esd=>1 + modofst + if uword_isge(addr, bytecode) + // + // Use the def directory address for bytecode. + // + addr = lookupdef(addr + codefix, deftbl) + fin + addsym(sym, addr) + fin + esd = esd + 3 + loop + if defext + // + // Copy bytecode to code segment. + // + memxcpy(codeseg, bytecode, modsize - (bytecode - modaddr)) + fin + else + lerr = $46 + fin + if lerr + return -lerr + fin + // + // Free up end-of-module main memory. + // + releaseheap(bytecode) + // + // Call init routine if it exists. + // + fixup = 0 + if init + fixup = adddef(deffirst, defext, init + defofst, @deflast)() + if fixup < 0 + perr = -fixup + fin + fin + return fixup +end +def execmod(modfile)#1 + byte moddci[17] + word saveheap, savesym, saveflags, savejit + + perr = 1 + if stodci(modfile, @moddci) + saveheap = heap + savesym = lastsym + saveflags = systemflags + savejit = *jitcodeptr + if loadmod(@moddci) < modkeep + lastsym = savesym + heap = saveheap + *jitcodeptr = savejit + while modid + modid-- + seg_release(modseg[modid]) + loop + xpokeb(symtbl.0, lastsym, 0) + systemflags = saveflags + else + modid = 0 + fin + fin + return -perr +end +// +// Init 2K symbol table. +// +drop, symtbl, drop = seg_find($00, $08, $11) +lastsym = symtbl & $FF00 +xpokeb(symtbl.0, lastsym, 0) +while *sysmodsym + stodci(sysmodsym=>0, heap) + addsym(heap, sysmodsym=>2) + sysmodsym = sysmodsym + 4 +loop +// +// Clear system path and command line +// +sysmods = 0 +syspath = @sysmods +cmdlnptr = @cmdln +// +// Print PLASMA version +// +init_cons +prstr("PLASMA JITC 2.0 Dev\n")//; putb(version.1); putc('.'); putb(version.0); putln +prstr("MEM:$"); prword(availheap); crout +// +// Exec command line parser +// +loadmod(@soscmd) +modid = 0 +autorun = open("AUTORUN") +if autorun > 0 + cmdln = read(autorun, @cmdln.1, 64) + close(autorun) +fin +// +// Call cmd line parser +// +repeat + execmod((*cmdparser)()) + write(refcons, @textmode, 3) + cmdln = 0 +until 0 +done diff --git a/src/vmsrc/c64/plvmc64.s b/src/vmsrc/c64/plvmc64.s index 02b5d03..0c8d6e1 100644 --- a/src/vmsrc/c64/plvmc64.s +++ b/src/vmsrc/c64/plvmc64.s @@ -109,14 +109,18 @@ COMP LDA #$FF ;* OPCODE TABLE ;* !ALIGN 255,0 -OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E - !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E - !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E - !WORD DROP,DUP,NEXTOP,DIVMOD,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E - !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E - !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E - !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E - !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E +OPTBL !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06 08 0A 0C 0E + !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E + !WORD MINUS1,BREQ,BRNE,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E + !WORD DROP,DROP2,DUP,DIVMOD,ADDI,SUBI,ANDI,ORI ; 30 32 34 36 38 3A 3C 3E + !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E + !WORD BRNCH,SEL,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E + !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E + !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E + !WORD LNOT,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 80 82 84 86 88 8A 8C 8E + !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E + !WORD BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE + !WORD ADDLB,ADDLW,ADDAB,ADDAW,IDXLB,IDXLW,IDXAB,IDXAW ; B0 B2 B4 B6 B8 BA BC BE ;* ;* DIV TOS-1 BY TOS ;* @@ -324,31 +328,6 @@ SHR STY IPY + LDY IPY JMP DROP ;* -;* LOGICAL AND -;* -LAND LDA ESTKL+1,X - ORA ESTKH+1,X - BEQ ++ - LDA ESTKL,X - ORA ESTKH,X - BEQ + - LDA #$FF -+ STA ESTKL+1,X - STA ESTKH+1,X -++ JMP DROP -;* -;* LOGICAL OR -;* -LOR LDA ESTKL,X - ORA ESTKH,X - ORA ESTKL+1,X - ORA ESTKH+1,X - BEQ + - LDA #$FF - STA ESTKL+1,X - STA ESTKH+1,X -+ JMP DROP -;* ;* DUPLICATE TOS ;* DUP DEX @@ -358,23 +337,69 @@ DUP DEX STA ESTKH,X JMP NEXTOP ;* +;* ADD IMMEDIATE TO TOS +;* +ADDI INY ;+INC_IP + LDA (IP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ JMP NEXTOP +;* +;* SUB IMMEDIATE FROM TOS +;* +SUBI INY ;+INC_IP + LDA ESTKL,X + SEC + SBC (IP),Y + STA ESTKL,X + BCS + + DEC ESTKH,X ++ JMP NEXTOP +;* +;* AND IMMEDIATE TO TOS +;* +ANDI INY ;+INC_IP + LDA (IP),Y + AND ESTKL,X + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +;* +;* IOR IMMEDIATE TO TOS +;* +ORI INY ;+INC_IP + LDA (IP),Y + ORA ESTKL,X + STA ESTKL,X + JMP NEXTOP +;* ;* LOGICAL NOT ;* LNOT LDA ESTKL,X ORA ESTKH,X - BNE + - LDA #$FF + BEQ + + LDA #$00 STA ESTKL,X STA ESTKH,X JMP NEXTOP ;* -;* CONSTANT +;* CONSTANT -1, NYBBLE, BYTE, $FF BYTE, WORD (BELOW) ;* -ZERO DEX -+ LDA #$00 +MINUS1 DEX ++ LDA #$FF STA ESTKL,X STA ESTKH,X JMP NEXTOP +CN DEX + LSR ; A = CONST * 2 + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP CFFB LDA #$FF !BYTE $2C ; BIT $00A9 - effectively skips LDA #$00, no harm in reading this address CB LDA #$00 @@ -500,6 +525,48 @@ LLW INY ;+INC_IP LDY IPY JMP NEXTOP ;* +;* ADD VALUE FROM LOCAL FRAME OFFSET +;* +ADDLB LDA #$60 ; RTS + STA NEXTOP + JSR LLB + LDA #$C8 ; INY + STA NEXTOP + JMP ADD +ADDLBX LDA #$60 ; RTS + STA NEXTOP + JSR LLBX + LDA #$C8 ; INY + STA NEXTOP + JMP ADD +ADDLW LDA #$60 ; RTS + STA NEXTOP + JSR LLW + LDA #$C8 ; INY + STA NEXTOP + JMP ADD +ADDLWX LDA #$60 ; RTS + STA NEXTOP + JSR LLWX + LDA #$C8 ; INY + STA NEXTOP + JMP ADD +;* +;* INDEX VALUE FROM LOCAL FRAME OFFSET +;* +IDXLB LDA #$60 ; RTS + STA NEXTOP + JSR LLB + LDA #$C8 ; INY + STA NEXTOP + JMP IDXW +IDXLW LDA #$60 ; RTS + STA NEXTOP + JSR LLW + LDA #$C8 ; INY + STA NEXTOP + JMP IDXW +;* ;* LOAD VALUE FROM ABSOLUTE ADDRESS ;* LAB INY ;+INC_IP @@ -531,6 +598,36 @@ LAW INY ;+INC_IP LDY IPY JMP NEXTOP ;* +;* ADD VALUE FROM ABSOLUTE ADDRESS +;* +ADDAB LDA #$60 ; RTS + STA NEXTOP + JSR LAB + LDA #$C8 ; INY + STA NEXTOP + JMP ADD +ADDAW LDA #$60 ; RTS + STA NEXTOP + JSR LAW + LDA #$C8 ; INY + STA NEXTOP + JMP ADD +;* +;* INDEX VALUE FROM ABSOLUTE ADDRESS +;* +IDXAB LDA #$60 ; RTS + STA NEXTOP + JSR LAB + LDA #$C8 ; INY + STA NEXTOP + JMP IDXW +IDXAW LDA #$60 ; RTS + STA NEXTOP + JSR LAW + LDA #$C8 ; INY + STA NEXTOP + JMP IDXW +;* ;* STORE VALUE TO ADDRESS ;* SB LDA ESTKL,X @@ -551,7 +648,10 @@ SW LDA ESTKL,X JMP DROP + INC ESTKH,X STA (ESTKH-1,X) - INX +;* +;* DROP2 +;* +DROP2 INX JMP DROP ;* ;* STORE VALUE TO LOCAL FRAME OFFSET @@ -683,7 +783,6 @@ ISTRU LDA #$FF STA ESTKL+1,X STA ESTKH+1,X JMP DROP -; ISNE LDA ESTKL,X CMP ESTKL+1,X BNE ISTRU @@ -694,7 +793,6 @@ ISFLS LDA #$00 STA ESTKL+1,X STA ESTKH+1,X JMP DROP -; ISGE LDA ESTKL+1,X CMP ESTKL,X LDA ESTKH+1,X @@ -702,9 +800,16 @@ ISGE LDA ESTKL+1,X BVS + BPL ISTRU BMI ISFLS -+ BPL ISFLS ++ +- BPL ISFLS BMI ISTRU -; +ISLE LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVS - + BPL ISTRU + BMI ISFLS ISGT LDA ESTKL,X CMP ESTKL+1,X LDA ESTKH,X @@ -712,31 +817,96 @@ ISGT LDA ESTKL,X BVS + BMI ISTRU BPL ISFLS -+ BMI ISFLS ++ +- BMI ISFLS BPL ISTRU -; -ISLE LDA ESTKL,X - CMP ESTKL+1,X - LDA ESTKH,X - SBC ESTKH+1,X - BVS + - BPL ISTRU - BMI ISFLS -+ BPL ISFLS - BMI ISTRU -; ISLT LDA ESTKL+1,X CMP ESTKL,X LDA ESTKH+1,X SBC ESTKH,X - BVS + + BVS - BMI ISTRU BPL ISFLS -+ BMI ISFLS - BPL ISTRU ;* ;* BRANCHES ;* +SEL INX + TYA ; FLATTEN IP + SEC + ADC IPL + STA TMPL + LDA #$00 + TAY + ADC IPH + STA TMPH ; ADD BRANCH OFFSET + LDA (TMP),Y + ;CLC ; BETTER NOT CARRY OUT OF IP+Y + ADC TMPL + STA IPL + INY + LDA (TMP),Y + ADC TMPH + STA IPH + DEY + LDA (IP),Y + STA TMPL ; CASE COUNT + LDA ESTKL-1,X + INC IPL + BNE CASELP + INC IPH +CASELP CMP (IP),Y + BNE + + LDA ESTKH-1,X + INY + CMP (IP),Y + BEQ BRNCH + LDA ESTKL-1,X + DEY ++ INY + INY + INY + DEC TMPL + BEQ FIXNEXT + INY + BNE CASELP + INC IPH + BNE CASELP +FIXNEXT TYA + LDY #$00 + SEC + ADC IPL + STA IPL + BCC + + INC IPH ++ JMP FETCHOP +BRAND LDA ESTKL,X + ORA ESTKH,X + BEQ BRNCH + INX ; DROP LEFT HALF OF AND + BNE NOBRNCH +BROR LDA ESTKL,X + ORA ESTKH,X + BNE BRNCH + INX ; DROP LEFT HALF OF OR + BNE NOBRNCH +BREQ INX + INX + LDA ESTKL-2,X + CMP ESTKL-1,X + BNE NOBRNCH + LDA ESTKH-2,X + CMP ESTKH-1,X + BEQ BRNCH + BNE NOBRNCH +BRNE INX + INX + LDA ESTKL-2,X + CMP ESTKL-1,X + BNE BRNCH + LDA ESTKH-2,X + CMP ESTKH-1,X + BNE BRNCH + BEQ NOBRNCH BRTRU INX LDA ESTKH-1,X ORA ESTKL-1,X @@ -745,14 +915,6 @@ NOBRNCH INY ;+INC_IP INY ;+INC_IP BMI FIXNEXT JMP NEXTOP -FIXNEXT TYA - LDY #$00 - CLC - ADC IPL - STA IPL - BCC + - INC IPH -+ JMP NEXTOP BRFLS INX LDA ESTKH-1,X ORA ESTKL-1,X @@ -775,58 +937,75 @@ BRNCH TYA ; FLATTEN IP STA IPH DEY JMP FETCHOP -BREQ INX - LDA ESTKL-1,X +;* +;* FOR LOOPS PUT TERMINAL VALUE AT ESTK+1 AND CURRENT COUNT ON ESTK +;* +BRGT LDA ESTKL+1,X CMP ESTKL,X - BNE NOBRNCH - LDA ESTKH-1,X - CMP ESTKH,X - BEQ BRNCH - BNE NOBRNCH -BRNE INX - LDA ESTKL-1,X - CMP ESTKL,X - BNE BRNCH - LDA ESTKH-1,X - CMP ESTKH,X - BEQ NOBRNCH - BNE BRNCH -BRGT INX - LDA ESTKL-1,X - CMP ESTKL,X - LDA ESTKH-1,X + LDA ESTKH+1,X SBC ESTKH,X BVS + BPL NOBRNCH - BMI BRNCH -+ BPL BRNCH - BMI NOBRNCH -BRLT INX - LDA ESTKL,X - CMP ESTKL-1,X +- INX ; DROP FOR VALUES + INX + BNE BRNCH ; BMI BRNCH +BRLT LDA ESTKL,X + CMP ESTKL+1,X LDA ESTKH,X - SBC ESTKH-1,X + SBC ESTKH+1,X BVS + BPL NOBRNCH - BMI BRNCH -+ BPL BRNCH - BMI NOBRNCH -IBRNCH TYA ; FLATTEN IP + INX ; DROP FOR VALUES + INX + BNE BRNCH ; BMI BRNCH ++ BMI NOBRNCH + BPL - +DECBRGE DEC ESTKL,X + LDA ESTKL,X + CMP #$FF + BNE + + DEC ESTKH,X +_BRGE LDA ESTKL,X ++ CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVS + + BPL BRNCH +- INX ; DROP FOR VALUES + INX + BNE NOBRNCH ; BMI NOBRNCH +INCBRLE INC ESTKL,X + BNE _BRLE + INC ESTKH,X +_BRLE LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + BVS + + BPL BRNCH + INX ; DROP FOR VALUES + INX + BNE NOBRNCH ; BMI NOBRNCH ++ BMI BRNCH + BPL - +SUBBRGE LDA ESTKL+1,X + SEC + SBC ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + SBC ESTKH,X + STA ESTKH+1,X + INX + BNE _BRGE +ADDBRLE LDA ESTKL,X CLC - ADC IPL - STA TMPL - LDA #$00 - TAY - ADC IPH - STA TMPH ; ADD BRANCH OFFSET - LDA TMPL - ;CLC ; BETTER NOT CARRY OUT OF IP+Y - ADC ESTKL,X - STA IPL - LDA TMPH - ADC ESTKH,X - STA IPH - JMP DROP + ADC ESTKL+1,X + STA ESTKL+1,X + LDA ESTKH,X + ADC ESTKH+1,X + STA ESTKH+1,X + INX + BNE _BRLE ;* ;* INDIRECT CALL TO ADDRESS (NATIVE CODE) ;* diff --git a/src/vmsrc/plvm.c b/src/vmsrc/plvm.c index 5379d9b..64a3764 100755 --- a/src/vmsrc/plvm.c +++ b/src/vmsrc/plvm.c @@ -36,7 +36,7 @@ uword sp = 0x01FE, fp = 0xFFFF, heap = 0x0200, deftbl = DEF_CALL, lastdef = DEF_ #define UPOP ((uword)(*(esp++))) #define TOS (esp[0]) word eval_stack[EVAL_STACKSZ]; -word *esp = eval_stack + EVAL_STACKSZ; +word *esp = &eval_stack[EVAL_STACKSZ]; #define SYMTBLSZ 1024 #define SYMSZ 16 @@ -524,21 +524,30 @@ void call(uword pc) /* * OPCODE TABLE * -OPTBL: DW ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E - DW NEG,COMP,AND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E - DW NOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E - DW DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E - DW ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E - DW BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E - DW LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E - DW SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E +OPTBL DW CN,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06 08 0A 0C 0E + DW CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E + DW MINUS1,NEXTOP,NEXTOP,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E + DW DROP,DROP2,DUP,DIVMOD,ADDI,SUBI,ANDI,ORI ; 30 32 34 36 38 3A 3C 3E + DW ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E + DW BRNCH,SEL,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E + DW LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E + DW SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E + DW LNOT,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 80 82 84 86 88 8A 8C 8E + DW NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E + DW BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE */ void interp(code *ip) { - int val, ea, frmsz, parmcnt; + int val, ea, frmsz, parmcnt, nybble; + code *previp = ip; while (1) { + if ((esp - eval_stack) < 0 || (esp - eval_stack) > EVAL_STACKSZ) + { + printf("Eval stack over/underflow! - $%04X: $%02X [%d]\n", previp - mem_data, *previp, EVAL_STACKSZ - (esp - eval_stack)); + show_state = 1; + } if (show_state) { char cmdline[16]; @@ -549,83 +558,45 @@ void interp(code *ip) printf("]\n"); gets(cmdline); } + nybble = 15; + previp = ip; switch (*ip++) { - /* - * 0x00-0x0F - */ - case 0x00: // ZERO : TOS = 0 - PUSH(0); - break; - case 0x02: // ADD : TOS = TOS + TOS-1 - val = POP; - ea = POP; - PUSH(ea + val); - break; - case 0x04: // SUB : TOS = TOS-1 - TOS - val = POP; - ea = POP; - PUSH(ea - val); - break; - case 0x06: // MUL : TOS = TOS * TOS-1 - val = POP; - ea = POP; - PUSH(ea * val); - break; - case 0x08: // DIV : TOS = TOS-1 / TOS - val = POP; - ea = POP; - PUSH(ea / val); - break; - case 0x0A: // MOD : TOS = TOS-1 % TOS - val = POP; - ea = POP; - PUSH(ea % val); - break; - case 0x0C: // INCR : TOS = TOS + 1 - TOS++;; - break; - case 0x0E: // DECR : TOS = TOS - 1 - TOS--; - break; - /* - * 0x10-0x1F - */ - case 0x10: // NEG : TOS = -TOS - TOS = -TOS; - break; - case 0x12: // COMP : TOS = ~TOS - TOS = ~TOS; - break; - case 0x14: // AND : TOS = TOS & TOS-1 - val = POP; - ea = POP; - PUSH(ea & val); - break; - case 0x16: // IOR : TOS = TOS ! TOS-1 - val = POP; - ea = POP; - PUSH(ea | val); - break; - case 0x18: // XOR : TOS = TOS ^ TOS-1 - val = POP; - ea = POP; - PUSH(ea ^ val); - break; - case 0x1A: // SHL : TOS = TOS-1 << TOS - val = POP; - ea = POP; - PUSH(ea << val); - break; - case 0x1C: // SHR : TOS = TOS-1 >> TOS - val = POP; - ea = POP; - PUSH(ea >> val); - break; - case 0x1E: // IDXW : TOS = TOS * 2 + TOS-1 - val = POP; - ea = POP; - PUSH(ea + val * 2); + /* + * 0x00-0x1F + */ + case 0x00: + nybble--; + case 0x02: + nybble--; + case 0x04: + nybble--; + case 0x06: + nybble--; + case 0x08: + nybble--; + case 0x0A: + nybble--; + case 0x0C: + nybble--; + case 0x0E: + nybble--; + case 0x10: + nybble--; + case 0x12: + nybble--; + case 0x14: + nybble--; + case 0x16: + nybble--; + case 0x18: + nybble--; + case 0x1A: + nybble--; + case 0x1C: + nybble--; + case 0x1E: + PUSH(nybble); break; /* * 0x20-0x2F @@ -669,41 +640,31 @@ void interp(code *ip) case 0x30: // DROP : TOS = POP; break; - case 0x32: // DUP : TOS = TOS + case 0x32: // DROP2 : TOS == + POP; + POP; + break; + case 0x34: // DUP : TOS = TOS val = TOS; PUSH(val); break; - case 0x34: // NOP + case 0x36: // DIVMOD break; - case 0x36: // NOP + case 0x38: // ADDI + PUSH(POP + BYTE_PTR(ip)); + ip++; break; - case 0x38: // BRGT : TOS-1 > TOS ? IP += (IP) - val = POP; - if (TOS > val) - ip += WORD_PTR(ip); - else - ip += 2; + case 0x3A: // SUBI + PUSH(POP - BYTE_PTR(ip)); + ip++; break; - case 0x3A: // BRLT : TOS-1 < TOS ? IP += (IP) - val = POP; - if (TOS < val) - ip += WORD_PTR(ip); - else - ip += 2; + case 0x3C: // ANDI + PUSH(POP & BYTE_PTR(ip)); + ip++; break; - case 0x3C: // BREQ : TOS == TOS-1 ? IP += (IP) - val = POP; - if (TOS == val) - ip += WORD_PTR(ip); - else - ip += 2; - break; - case 0x3E: // BRNE : TOS != TOS-1 ? IP += (IP) - val = POP; - if (TOS != val) - ip += WORD_PTR(ip); - else - ip += 2; + case 0x3E: // ORI + PUSH(POP | BYTE_PTR(ip)); + ip++; break; /* * 0x40-0x4F @@ -756,8 +717,22 @@ void interp(code *ip) case 0x50: // BRNCH : IP += (IP) ip += WORD_PTR(ip); break; - case 0x52: // IBRNCH : IP += TOS - ip += POP; + case 0x52: // SELECT + val = POP; + ip += WORD_PTR(ip); + parmcnt = BYTE_PTR(ip); + ip++; + while (parmcnt--) + { + if (WORD_PTR(ip) == val) + { + ip += 2; + ip += WORD_PTR(ip); + parmcnt = 0; + } + else + ip += 4; + } break; case 0x54: // CALL : TOFP = IP, IP = (IP) ; call call(UWORD_PTR(ip)); @@ -880,6 +855,191 @@ void interp(code *ip) mem_data[ea + 1] = TOS >> 8; ip += 2; break; + /* + * 0x080-0x08F + */ + case 0x80: // ZERO : TOS = 0 + PUSH(0); + break; + case 0x82: // ADD : TOS = TOS + TOS-1 + val = POP; + ea = POP; + PUSH(ea + val); + break; + case 0x84: // SUB : TOS = TOS-1 - TOS + val = POP; + ea = POP; + PUSH(ea - val); + break; + case 0x86: // MUL : TOS = TOS * TOS-1 + val = POP; + ea = POP; + PUSH(ea * val); + break; + case 0x88: // DIV : TOS = TOS-1 / TOS + val = POP; + ea = POP; + PUSH(ea / val); + break; + case 0x8A: // MOD : TOS = TOS-1 % TOS + val = POP; + ea = POP; + PUSH(ea % val); + break; + case 0x8C: // INCR : TOS = TOS + 1 + TOS++;; + break; + case 0x8E: // DECR : TOS = TOS - 1 + TOS--; + break; + /* + * 0x90-0x9F + */ + case 0x90: // NEG : TOS = -TOS + TOS = -TOS; + break; + case 0x92: // COMP : TOS = ~TOS + TOS = ~TOS; + break; + case 0x94: // AND : TOS = TOS & TOS-1 + val = POP; + ea = POP; + PUSH(ea & val); + break; + case 0x96: // IOR : TOS = TOS ! TOS-1 + val = POP; + ea = POP; + PUSH(ea | val); + break; + case 0x98: // XOR : TOS = TOS ^ TOS-1 + val = POP; + ea = POP; + PUSH(ea ^ val); + break; + case 0x9A: // SHL : TOS = TOS-1 << TOS + val = POP; + ea = POP; + PUSH(ea << val); + break; + case 0x9C: // SHR : TOS = TOS-1 >> TOS + val = POP; + ea = POP; + PUSH(ea >> val); + break; + case 0x9E: // IDXW : TOS = TOS * 2 + TOS-1 + val = POP; + ea = POP; + PUSH(ea + val * 2); + break; + /* + * 0xA0-0xAF + */ + case 0xA0: // BRGT : TOS-1 > TOS ? IP += (IP) + val = POP; + if (TOS < val) + { + POP; + ip += WORD_PTR(ip); + } + else + { + PUSH(val); + ip += 2; + } + break; + case 0xA2: // BRLT : TOS-1 < TOS ? IP += (IP) + val = POP; + if (TOS > val) + { + POP; + ip += WORD_PTR(ip); + } + else + { + PUSH(val); + ip += 2; + } + break; + case 0xA4: // INCBRLE : TOS = TOS + 1 + val = POP; + val++; + if (TOS >= val) + { + PUSH(val); + ip += WORD_PTR(ip); + } + else + { + POP; + ip += 2; + } + break; + case 0xA6: // ADDBRLE : TOS = TOS + TOS-1 + val = POP; + ea = POP; + val = ea + val; + if (TOS >= val) + { + PUSH(val); + ip += WORD_PTR(ip); + } + else + { + POP; + ip += 2; + } + break; + case 0xA8: // DECBRGE : TOS = TOS - 1 + val = POP; + val--; + if (TOS <= val) + { + PUSH(val); + ip += WORD_PTR(ip); + } + else + { + POP; + ip += 2; + } + break; + case 0xAA: // SUBBRGE : TOS = TOS-1 - TOS + val = POP; + ea = POP; + val = ea - val; + if (TOS <= val) + { + PUSH(val); + ip += WORD_PTR(ip); + } + else + { + POP; + ip += 2; + } + break; + case 0xAC: // BRAND : SHORT CIRCUIT AND + if (TOS) // EVALUATE RIGHT HAND OF AND + { + POP; + ip += 2; + } + else // MUST BE FALSE, SKIP RIGHT HAND + { + ip += WORD_PTR(ip); + } + break; + case 0xAE: // BROR : SHORT CIRCUIT OR + if (!TOS) // EVALUATE RIGHT HAND OF OR + { + POP; + ip += 2; + } + else // MUST BE TRUE, SKIP RIGHT HAND + { + ip += WORD_PTR(ip); + } + break; /* * Odd codes and everything else are errors. */