/FILE SYSPRINT NAME($Y65:Y6502A.LIS) NEW(REPLACE) LRECL(133) SPACE(100) /FILE SYSPUNCH NAME($Y65:Y6502A.OBJ) NEW(REPLACE) /LOAD ASM /OPT DECK,LIST /JOB NOGO * * R0 X'0000FFFF' for ANDing * R1 Standard linkage / Function code * R2 A * R3 X * R4 Y * R5 P * R6 PC * R7 SP * R8 Current opcode * R9 Current address mode * 4 * R10 Address of current operand * R11 Temporary * R12 Base * R13 Save area * R14 Return address * R15 Entry point / Current operand * Y6502 CSECT ENTRY RDMEM,WRMEM USING *,R15 B START DC AL1(6) DC CL7'Y6502' START STM R14,R12,12(R13) Save all registers * ST R13,SAVEAREA+4 LA R13,SAVEAREA Get address of our save area BALR R12,0 Use R12 for our base DROP R15 USING *,R12 * L R11,=V(TRAPS) Get address of TRAP common block MVC OPTRAP(4),0(R11) Get page for OPSYS calls MVC IOTRAP(4),4(R11) Get page for INOUT calls * L R11,0(R1) Get address of 1st argument L PC,0(R11) Get value of 1st argument (PC) N PC,=X'0000FFFF' Make sure its between 0 and FFFF * L R11,4(R1) Get address of 2nd argument L P,0(R11) Get value of 2nd argument (DEBUG) N P,=X'80000000' Take top bit only * L R11,8(R1) Get address of 3rd argument L R0,0(R11) Get value of 3rd argument (EXTEND) N R0,=X'80000000' Take top bit only O R0,=X'0000FFFF' Load R0 with mask value * XR OPCODE,OPCODE Clear opcode register XR A,A Clear accumulator XR X,X Clear X XR Y,Y Clear Y XR SP,SP Clear stack pointer * * Main loop * LOOP ST PC,CURRENT Note address of current opcode IC OPCODE,MEMORY(PC) Get the opcode LA PC,1(PC) Increment PC NR PC,R0 Make sure PC stays valid * LR R15,OPCODE N R15,=X'0000000F' Get bottom four bits SLL R15,2 Multiply by 4 (4 byte addresses) L R15,COLUMNS(R15) Get address of column routine * LR MODE,OPCODE Get address mode * 4 N MODE,=X'0000001C' * LR R1,OPCODE Calculate Function SRL R1,3 Shift right 5, then multiply by 4 N R1,=X'0000001C' Ensure range (0-7)*4 * BR R15 Execute appropriate routine * SETNZ EQU * Return to here to set N and Z N P,=X'F000007F' O P,=X'00000002' LTR R11,R11 Test for zero BZ INSTDONE N P,=X'F00000FD' Non-zero - clear Z flag N R11,=X'00000080' If non zero, could be negative OR P,R11 * * Check for attention interrupt (PA1 followed by return) * INSTDONE EQU * Return to here from instruction CLC $PSTCOD(5),=C'ASYNC' BNE NOATTN * STM A,SP,REGISTRS LR X,OPERAND Put OPERAND (R15) somewhere safe LR Y,R0 Put R0 somewhere safe LA R1,=A(REGISTRS) L R15,=V(USRATN) BALR R14,R15 Go to Fortran routine LR OPERAND,X Retreive OPERAND (R15) LR R0,Y Retreive R0 LM A,SP,REGISTRS Reload in case regs changed * NOATTN EQU * * * Call Fortran routine to print debug listing if required * LTR P,P BNL LOOP * SRL MODE,2 Bring MODE back to normal ST MODE,DBGMODE STM A,SP,REGISTRS *??? NC DBGARGS+16,=X'000000FF' Mask out flag bits ST ADDRBUS,DBGADDR ST OPERAND,DBGDATA LR R11,R0 Keep R0 safe LA R1,DBGARGS L R15,=V(DBGLST) BALR R14,R15 LR R0,R11 Retreive R0 * B LOOP * * The code that implements the actual opcodes starts here * COLUMN0 EQU * LR R11,OPCODE N R11,=X'00000010' BNZ COL0REL * * Miscellaneous instructions in column 0 * LA MODE,13*4 Set mode to implied L R1,COL0MOPS(R1) Get address of appropriate routine BR R1 * COL0BRK EQU * LA MODE,2*4 Set mode to immediate (not really) BAL R14,GETOPND O P,=X'00000010' LR R11,PC SRL R11,8 STC R11,MEMORY+256(SP) LA SP,255(SP) SP = SP - 1 N SP,=X'000000FF' STC PC,MEMORY+256(SP) LA SP,255(SP) SP = SP - 1 N SP,=X'000000FF' STC P,MEMORY+256(SP) LA SP,255(SP) SP = SP - 1 N SP,=X'000000FF' O P,=X'00000004' LA R1,MEMORY A R1,=X'0000FFFE' IC PC,0(R1) ICM PC,B'0010',1(R1) B CHECKPC * COL0JSR EQU * LA MODE,3*4 Set mode to absolute BAL R14,GETOPND Get operand LR R11,PC S R11,=F'1' LR R14,R11 SRL R11,8 STC R11,MEMORY+256(SP) LA SP,255(SP) SP = SP - 1 N SP,=X'000000FF' STC R14,MEMORY+256(SP) LA SP,255(SP) SP = SP - 1 N SP,=X'000000FF' LR PC,ADDRBUS B CHECKPC * COL0RTI EQU * LA SP,1(SP) N SP,=X'000000FF' IC P,MEMORY+256(SP) O P,=X'00000020' LA SP,1(SP) N SP,=X'000000FF' IC R11,MEMORY+256(SP) LA SP,1(SP) N SP,=X'000000FF' IC R1,MEMORY+256(SP) SLL R1,8 AR R11,R1 NR R11,R0 LR PC,R11 B CHECKPC * COL0RTS EQU * LA SP,1(SP) N SP,=X'000000FF' IC R11,MEMORY+256(SP) LA SP,1(SP) N SP,=X'000000FF' IC R1,MEMORY+256(SP) SLL R1,8 AR R11,R1 LA R11,1(R11) NR R11,R0 LR PC,R11 B CHECKPC * COL0LDY EQU * LA MODE,2*4 Set mode to immediate COL4LDY BAL R14,GETOPND LR Y,OPERAND LR R11,Y B SETNZ * COL0CPY EQU * LA MODE,2*4 Set mode to immediate COL4CPY BAL R14,GETOPND LR R11,Y SR R11,OPERAND LR R1,R11 SRL R1,8 N R1,=X'00000001' X R1,=X'00000001' N P,=X'F00000FE' OR P,R1 B SETNZ * COL0CPX EQU * LA MODE,2*4 Set mode to immediate COL4CPX BAL R14,GETOPND LR R11,X SR R11,OPERAND LR R1,R11 SRL R1,8 N R1,=X'00000001' X R1,=X'00000001' N P,=X'F00000FE' OR P,R1 B SETNZ * * Relative branch instructions * COL0REL LA MODE,9*4 Set addressing mode to relative BAL R14,GETOPND Get operand LR R11,P Get P into tenporary register L R1,COL0ROPS(R1) Function code is in R1 BR R1 Execute particular opcode * COL0BPL N R11,=X'00000080' X R11,=X'00000080' B RELCONT * COL0BMI N R11,=X'00000080' B RELCONT * COL0BVC N R11,=X'00000040' X R11,=X'00000040' B RELCONT * COL0BVS N R11,=X'00000040' B RELCONT * COL0BCC CLM OPCODE,B'0001',=X'80' BE BRANCH N R11,=X'00000001' X R11,=X'00000001' B RELCONT * COL0BCS N R11,=X'00000001' B RELCONT * COL0BNE N R11,=X'00000002' X R11,=X'00000002' B RELCONT * COL0BEQ N R11,=X'00000002' * RELCONT BZ INSTDONE BRANCH LR PC,ADDRBUS B CHECKPC * * ORA, AND, EOR, ADC, STA, LDA, CMP, SBC, BIT # * COLUMN2 EQU * CLM OPCODE,B'0001',=X'A2' BE LDXIMM LTR R0,R0 Check for extended mode BNL INVOPCD LA MODE,11*4 Change mode to (ind) zp LR R11,OPCODE N R11,=X'00000010' BZ INVOPCD * COLUMN1 EQU * BAL R14,GETOPND Get instruction operand L R1,COL1OPS(R1) Function code is in R1 BR R1 Execute particular opcode * COL1ORA EQU * OR A,OPERAND LR R11,A B SETNZ * COL1AND EQU * NR A,OPERAND LR R11,A B SETNZ * COL1EOR EQU * XR A,OPERAND LR R11,A B SETNZ * COL1ADC EQU * LR R1,A Perform overflow check N R1,=X'0000007F' LR R14,OPERAND N R14,=X'0000007F' AR R1,R14 Add factors without signs LR R11,P N R11,=X'00000001' Extract C AR R1,R11 Add in carry to V calculation SRL R1,7 Move to RHS N P,=X'F00000BE' Clear V and C AR A,R11 AR A,OPERAND LR R11,A N R11,=X'00000100' Extract new C SRL R11,8 Move it to correct position OR P,R11 Insert C into P XR R1,R11 Compare new C to correct C SLL R1,6 Shift to V position OR P,R1 Insert V into P N A,=X'000000FF' LR R11,A B SETNZ * COL1STA EQU * CLM OPCODE,B'0001',=X'89' Check for BIT # BE COL9BIT STC A,MEMORY(ADDRBUS) B INSTDONE * COL1LDA EQU * LR A,OPERAND LR R11,A B SETNZ * COL1CMP EQU * LR R11,A SR R11,OPERAND LR R1,R11 SRL R1,8 N R1,=X'00000001' X R1,=X'00000001' N P,=X'F00000FE' OR P,R1 B SETNZ * COL1SBC EQU * LR R1,A Perform overflow check N R1,=X'0000007F' LR R14,OPERAND X R14,=X'000000FF' N R14,=X'0000007F' AR R1,R14 Add factors without signs LR R11,P N R11,=X'00000001' Extract C N P,=X'F00000BE' Clear V and C AR R1,R11 Add in carry to V calculation SRL R1,7 Move to RHS AR A,R11 LR R11,OPERAND X R11,=X'000000FF' AR A,R11 LR R11,A N R11,=X'00000100' Extract new C SRL R11,8 Move C to correct position OR P,R11 Insert C into P XR R1,R11 Compare new C to correct C SLL R1,6 Shift to V position OR P,R1 Insert V into P N A,=X'000000FF' LR R11,A B SETNZ * COLUMN8 EQU * LA MODE,13*4 Set mode to implied LR R1,OPCODE N R1,=X'000000F0' Get top four bits SRL R1,2 Divide by 16, multiply by 4 L R1,COL8OPS(R1) BR R1 * COL8PHP EQU * STC P,MEMORY+256(SP) LA SP,255(SP) SP = SP - 1 N SP,=X'000000FF' B INSTDONE * COL8CLC EQU * N P,=X'F00000FE' B INSTDONE * COL8PLP EQU * LA SP,1(SP) N SP,=X'000000FF' IC P,MEMORY+256(SP) O P,=X'00000020' B INSTDONE * COL8SEC EQU * O P,=X'00000001' B INSTDONE * COL8PHA EQU * STC A,MEMORY+256(SP) LA SP,255(SP) SP = SP - 1 N SP,=X'000000FF' B INSTDONE * COL8CLI EQU * N P,=X'F00000FB' B INSTDONE * COL8PLA EQU * LA SP,1(SP) N SP,=X'000000FF' IC A,MEMORY+256(SP) LR R11,A B SETNZ * COL8SEI EQU * O P,=X'00000004' B INSTDONE * COL8DEY EQU * S Y,=F'1' N Y,=X'000000FF' LR R11,Y B SETNZ * COL8TYA EQU * LR A,Y LR R11,A B SETNZ * COL8TAY EQU * LR Y,A LR R11,Y B SETNZ * COL8CLV EQU * N P,=X'F00000BF' B INSTDONE * COL8INY EQU * LA Y,1(Y) N Y,=X'000000FF' LR R11,Y B SETNZ * COL8CLD EQU * N P,=X'F00000F7' B INSTDONE * COL8INX EQU * LA X,1(X) N X,=X'000000FF' LR R11,X B SETNZ * COL8SED EQU * O P,=X'00000008' B INSTDONE * COLUMN4 EQU * LR R11,OPCODE N R11,=X'00000090' CLM R11,B'0001',=X'80' BE COLUMN4C LR R11,OPCODE N R11,=X'000000D0' CLM R11,B'0001',=X'90' BE COLUMN4C CLM OPCODE,B'0001',=X'24' BE COL4BIT * * Check for extended codes * LTR R0,R0 Check for extended mode BNL INVOPCD B INVOPCD * COLUMNC EQU * LR R11,OPCODE N R11,=X'00000090' CLM R11,B'0001',=X'80' BE COLUMN4C CLM OPCODE,B'0001',=X'4C' BE COL4JMP CLM OPCODE,B'0001',=X'6C' BE COL4JMPI CLM OPCODE,B'0001',=X'2C' BE COL4BIT CLM OPCODE,B'0001',=X'BC' BE COLUMN4C * * Check for extended codes * LTR R0,R0 Check for extended mode BNL INVOPCD B INVOPCD * COLUMN4C EQU * L R1,COL4OPS-16(R1) BR R1 * COL9BIT EQU * LA MODE,2*4 Set mode to immediate * COL4BITX EQU * Not called as yet LTR R0,R0 Check for extended mode BNL INVOPCD * COL4BIT EQU * BAL R14,GETOPND N P,=X'F000003D' Clear N,V and Z LR R11,OPERAND N R11,=X'000000C0' OR P,R11 Set N and V accordingly LR R11,OPERAND NR R11,A BNZ INSTDONE O P,=X'00000002' Set Z B INSTDONE * COL4JMPX EQU * LA MODE,3*4 INDABSX - 5 * COL4JMPI EQU * LA MODE,5*4(MODE) ABS -> INDABS * COL4JMP EQU * BAL R14,GETOPND LR PC,ADDRBUS B CHECKPC * COL4STY EQU * BAL R14,GETOPND STC Y,MEMORY(ADDRBUS) B INSTDONE * COLUMN6 EQU * LR R11,OPCODE N R11,=X'000000D0' CLM R11,B'0001',=X'90' BNE COLUMN6E LA MODE,5*4(MODE) ZPX -> ZPY B COLUMN6E * COLUMNE EQU * LR R11,OPCODE N R11,=X'000000D0' CLM R11,B'0001',=X'90' BNE COLUMN6E CLM OPCODE,B'0001',=X'9E' * BEQ STZ S MODE,=F'4' ABX -> ABY B COLUMN6E * LDXIMM LA MODE,2*4 Set address mode to immediate * COLUMN6E BAL R14,GETOPND L R1,COL6OPS(R1) Get address of appropriate code BR R1 * COL6ASL EQU * SLL OPERAND,1 LR R11,OPERAND N OPERAND,=X'000000FF' N R11,=X'00000100' SRL R11,8 N P,=X'F00000FE' OR P,R11 LR R11,OPERAND STC OPERAND,MEMORY(ADDRBUS) B SETNZ * COL6ROL EQU * SLL OPERAND,1 LR R11,P N R11,=X'00000001' XR P,R11 OR OPERAND,R11 LR R11,OPERAND N OPERAND,=X'000000FF' N R11,=X'00000100' SRL R11,8 OR P,R11 LR R11,OPERAND STC OPERAND,MEMORY(ADDRBUS) B SETNZ * COL6LSR EQU * LR R11,OPERAND N R11,=X'00000001' N P,=X'F00000FE' OR P,R11 SRL OPERAND,1 LR R11,OPERAND STC OPERAND,MEMORY(ADDRBUS) B SETNZ * COL6ROR EQU * LR R11,P N R11,=X'00000001' XR P,R11 SLL R11,8 OR OPERAND,R11 LR R11,OPERAND N R11,=X'00000001' OR P,R11 SRL OPERAND,1 LR R11,OPERAND STC OPERAND,MEMORY(ADDRBUS) B SETNZ * COL6STX EQU * STC X,MEMORY(ADDRBUS) B INSTDONE * COL6LDX EQU * LR X,OPERAND LR R11,X B SETNZ * COL6DEC EQU * S OPERAND,=F'1' N OPERAND,=X'000000FF' LR R11,OPERAND STC OPERAND,MEMORY(ADDRBUS) B SETNZ * COL6INC EQU * LA OPERAND,1(OPERAND) N OPERAND,=X'000000FF' LR R11,OPERAND STC OPERAND,MEMORY(ADDRBUS) B SETNZ * COLUMNA EQU * LA MODE,13*4 Set mode to implied LR R11,OPCODE N R11,=X'00000010' Check which part of column A BZ COLUMNA0 * CLM OPCODE,B'0001',=X'9A' BE COLUMNA0 CLM OPCODE,B'0001',=X'BA' BE COLUMNA0 * LTR R0,R0 Check for extended mode BNL INVOPCD * COLUMNA0 LR R1,OPCODE N R1,=X'000000F0' Get top four bits SRL R1,2 Divide by 16, multiply by 4 L R1,COLAOPS(R1) BR R1 * COLAASL EQU * SLL A,1 LR R11,A N A,=X'000000FF' N R11,=X'00000100' SRL R11,8 N P,=X'F00000FE' OR P,R11 LR R11,A B SETNZ * COLAINA EQU * LA A,1(A) N A,=X'000000FF' LR R11,A B SETNZ * COLAROL EQU * SLL A,1 LR R11,P N R11,=X'00000001' XR P,R11 OR A,R11 LR R11,A N A,=X'000000FF' N R11,=X'00000100' SRL R11,8 OR P,R11 LR R11,A B SETNZ * COLADEA EQU * S A,=F'1' N A,=X'000000FF' LR R11,A B SETNZ * COLALSR EQU * LR R11,A N R11,=X'00000001' N P,=X'F00000FE' OR P,R11 SRL A,1 LR R11,A B SETNZ * COLAPHY EQU * STC Y,MEMORY+256(SP) LA SP,255(SP) SP = SP - 1 N SP,=X'000000FF' B INSTDONE * COLAROR EQU * LR R11,P N R11,=X'00000001' XR P,R11 SLL R11,8 OR A,R11 LR R11,A N R11,=X'00000001' OR P,R11 SRL A,1 LR R11,A B SETNZ * COLAPLY EQU * LA SP,1(SP) N SP,=X'000000FF' IC Y,MEMORY+256(SP) LR R11,Y B SETNZ * COLATXA EQU * LR A,X LR R11,A B SETNZ * COLATXS EQU * LR SP,X B INSTDONE * COLATAX EQU * LR X,A LR R11,A B SETNZ * COLATSX EQU * LR X,SP LR R11,X B SETNZ * COLADEX EQU * S X,=F'1' N X,=X'000000FF' LR R11,X B SETNZ * COLAPHX EQU * STC X,MEMORY+256(SP) LA SP,255(SP) SP = SP - 1 N SP,=X'000000FF' B INSTDONE * COLAPLX EQU * LA SP,1(SP) N SP,=X'000000FF' IC X,MEMORY+256(SP) LR R11,X B SETNZ * COLUMN7 EQU * * COLUMNF EQU * * * Invalid Opcode encountered. Call Fortran routine to * print error message etc. Pass it the address of the opcode. * Note : Control will return to the main loop. * INVOPCD EQU * LA R1,=A(CURRENT) LA R14,INSTDONE L R15,=V(INVOPC) BR R15 * * Come here to check if a new assignment to the program counter * is valid. Used to extract operating system calls * CHECKPC EQU * CLM PC,B'0010',OPTRAP+3 BNE INSTDONE CLC OPTRAP(3),=X'000000' BNE INSTDONE L R1,=V(REGS) Get address of REGS common block STM A,SP,0(R1) Store registers there LR X,OPERAND Put OPERAND (R15) somewhere safe LR Y,R0 Put R0 somewhere safe L R15,=V(OPSYS) Call operating system routine BALR R14,R15 LR OPERAND,X Retreive OPERAND (R15) LR R0,Y Retreive R0 L R1,=V(REGS) Get address of REGS common block LM A,SP,0(R1) Reload in case regs changed * * There should be a return address on the stack ... RTS to it. * LA SP,1(SP) N SP,=X'000000FF' XR R11,R11 IC R11,MEMORY+256(SP) LA SP,1(SP) N SP,=X'000000FF' IC R1,MEMORY+256(SP) SLL R1,8 OR R11,R1 LA R11,1(R11) NR R11,R0 LR PC,R11 B INSTDONE * * Get operand for current instruction. * Returns operand in OPERAND (R15) and address in ADDRBUS (R10) * GETOPND SR ADDRBUS,ADDRBUS Clear top of address IC ADDRBUS,MEMORY(PC) Get operand low byte LA PC,1(PC) Increment PC NR PC,R0 * L R15,MODES(MODE) Get address of address mode code BR R15 Execute code for address mode * * (ind,x) * INDINDX EQU * SR OPERAND,OPERAND Clear top of operand AR ADDRBUS,X N ADDRBUS,=X'000000FF' LA R11,1(ADDRBUS) N R11,=X'000000FF' LA R11,MEMORY(R11) IC ADDRBUS,MEMORY(ADDRBUS) ICM ADDRBUS,B'0010',0(R11) IC OPERAND,MEMORY(ADDRBUS) BR R14 * * (ind,y) * INDINDY EQU * SR OPERAND,OPERAND Clear top of operand LA R11,1(ADDRBUS) N R11,=X'000000FF' IC ADDRBUS,MEMORY(ADDRBUS) LA R11,MEMORY(R11) ICM ADDRBUS,B'0010',0(R11) AR ADDRBUS,Y NR ADDRBUS,R0 IC OPERAND,MEMORY(ADDRBUS) BR R14 * * zp * ZEROPG EQU * SR OPERAND,OPERAND Clear top of operand IC OPERAND,MEMORY(ADDRBUS) BR R14 * * zp,x * ZEROPGX EQU * SR OPERAND,OPERAND Clear top of operand AR ADDRBUS,X N ADDRBUS,=X'000000FF' IC OPERAND,MEMORY(ADDRBUS) BR R14 * * # imm * IMMED EQU * LR OPERAND,ADDRBUS LR ADDRBUS,PC S ADDRBUS,=X'00000001' NR ADDRBUS,R0 BR R14 * * abs,y * ABSY EQU * SR OPERAND,OPERAND Clear top of operand LA R11,MEMORY(PC) ICM ADDRBUS,B'0010',0(R11) Get high byte LA PC,1(PC) NR PC,R0 AR ADDRBUS,Y NR ADDRBUS,R0 IC OPERAND,MEMORY(ADDRBUS) BR R14 * * abs * ABS EQU * SR OPERAND,OPERAND Clear top of operand LA R11,MEMORY(PC) ICM ADDRBUS,B'0010',0(R11) Get high byte LA PC,1(PC) NR PC,R0 IC OPERAND,MEMORY(ADDRBUS) BR R14 * * abs,x * ABSX EQU * SR OPERAND,OPERAND Clear top of operand LA R11,MEMORY(PC) ICM ADDRBUS,B'0010',0(R11) Get high byte LA PC,1(PC) NR PC,R0 AR ADDRBUS,X NR ADDRBUS,R0 IC OPERAND,MEMORY(ADDRBUS) BR R14 * * (abs) * INDABS EQU * LA R11,MEMORY(PC) ICM ADDRBUS,B'0010',0(R11) Get high byte LA PC,1(PC) NR PC,R0 LA R11,1(ADDRBUS) NR R11,R0 LA R11,MEMORY(R11) IC ADDRBUS,MEMORY(ADDRBUS) ICM ADDRBUS,B'0010',0(R11) BR R14 * * rel * RELATIVE EQU * CLM ADDRBUS,B'0001',=X'80' BL RELFWD SH ADDRBUS,=H'256' RELFWD LR OPERAND,ADDRBUS AR ADDRBUS,PC NR ADDRBUS,R0 BR R14 * * zp,y * ZEROPGY EQU * XR OPERAND,OPERAND Clear top of operand AR ADDRBUS,Y N ADDRBUS,=X'000000FF' IC OPERAND,MEMORY(ADDRBUS) BR R14 * * (ind) * INDZP EQU * XR OPERAND,OPERAND Clear top of operand LA R11,1(ADDRBUS) N R11,=X'000000FF' LA R11,MEMORY(R11) IC ADDRBUS,MEMORY(ADDRBUS) ICM ADDRBUS,B'0010',0(R11) IC OPERAND,MEMORY(ADDRBUS) BR R14 * * (abs,x) * INDABSX EQU * LA R11,MEMORY(PC) ICM ADDRBUS,B'0010',0(R11) Get high byte LA PC,1(PC) NR PC,R0 AR ADDRBUS,X NR ADDRBUS,R0 LA R11,1(ADDRBUS) NR R11,R0 LA R11,MEMORY(R11) IC ADDRBUS,MEMORY(ADDRBUS) ICM ADDRBUS,B'0010',0(R11) BR R14 * DROP R12 * * Routines to read and write memory - for FORTRAN part. * USING *,R15 RDMEM ST R2,28(R13) Save the one register modified * L R2,0(R1) Get address of 1st argument L R2,0(R2) Get value of 1st argument N R2,=X'0000FFFF' Make sure its between 0 and FFFF SR R0,R0 Clear R0 IC R0,MEMORY(R2) Load the byte into lsb of R0 * L R2,28(R13) Restore register BR R14 * DROP R15 USING *,R15 WRMEM STM 2,3,28(R13) Save registers modified * L R2,0(R1) Get address of 1st argument L R2,0(R2) Get value of 1st argument N R2,=X'0000FFFF' Make sure its between 0 and FFFF L R3,4(R1) Get address of 2nd argument L R3,0(R3) Get value of 2nd argument STC R3,MEMORY(R2) Store the byte * LM 2,3,28(R13) Restore registers BR R14 * * Arguments for calls to INVOPC, DBGLST and USRATN routines * DS 0F DBGARGS DC A(CURRENT) DC A(DBGMODE) DC A(DBGADDR) DC A(DBGDATA) DC A(REGISTRS) DBGMODE DS F Current address mode DBGADDR DS F Current address bus value DBGDATA DS F Current data bus value REGISTRS DS 6F Current register values CURRENT DS F Start address of current instruction * * Traps for operating system calls and I/O manipulations * OPTRAP DS F IOTRAP DS F * * Register save area for standard linkage * SAVEAREA DS 18F * * Addresses of routines to interpret opcodes * COLUMNS DC A(COLUMN0) DC A(COLUMN1) DC A(COLUMN2) DC A(INVOPCD) DC A(COLUMN4) DC A(COLUMN1) DC A(COLUMN6) DC A(COLUMN7) DC A(COLUMN8) DC A(COLUMN1) DC A(COLUMNA) DC A(INVOPCD) DC A(COLUMNC) DC A(COLUMN1) DC A(COLUMNE) DC A(COLUMNF) * COL0ROPS DC A(COL0BPL) DC A(COL0BMI) DC A(COL0BVC) DC A(COL0BVS) DC A(COL0BCC) DC A(COL0BCS) DC A(COL0BNE) DC A(COL0BEQ) * COL0MOPS DC A(COL0BRK) DC A(COL0JSR) DC A(COL0RTI) DC A(COL0RTS) DC A(COL0REL) DC A(COL0LDY) DC A(COL0CPY) DC A(COL0CPX) * COL1OPS DC A(COL1ORA) DC A(COL1AND) DC A(COL1EOR) DC A(COL1ADC) DC A(COL1STA) DC A(COL1LDA) DC A(COL1CMP) DC A(COL1SBC) * COL4OPS DC A(COL4STY) DC A(COL4LDY) DC A(COL4CPY) DC A(COL4CPX) * COL6OPS DC A(COL6ASL) DC A(COL6ROL) DC A(COL6LSR) DC A(COL6ROR) DC A(COL6STX) DC A(COL6LDX) DC A(COL6DEC) DC A(COL6INC) * COL8OPS DC A(COL8PHP) DC A(COL8CLC) DC A(COL8PLP) DC A(COL8SEC) DC A(COL8PHA) DC A(COL8CLI) DC A(COL8PLA) DC A(COL8SEI) DC A(COL8DEY) DC A(COL8TYA) DC A(COL8TAY) DC A(COL8CLV) DC A(COL8INY) DC A(COL8CLD) DC A(COL8INX) DC A(COL8SED) * COLAOPS DC A(COLAASL) DC A(COLAINA) DC A(COLAROL) DC A(COLADEA) DC A(COLALSR) DC A(COLAPHY) DC A(COLAROR) DC A(COLAPLY) DC A(COLATXA) DC A(COLATXS) DC A(COLATAX) DC A(COLATSX) DC A(COLADEX) DC A(COLAPHX) DC A(INSTDONE) DC A(COLAPLX) * * Addresses of address mode processing routines * MODES DC A(INDINDX) DC A(ZEROPG) DC A(IMMED) DC A(ABS) DC A(INDINDY) DC A(ZEROPGX) DC A(ABSY) DC A(ABSX) DC A(INDABS) DC A(RELATIVE) DC A(ZEROPGY) DC A(INDZP) DC A(INDABSX) * * Put the literal pool here as it won't be addressable if * it comes after the memory. * LTORG , * * 64K of memory * MEMORY DC 65536X'00' * * Equates and things * REGS A EQU 2 X EQU 3 Y EQU 4 P EQU 5 PC EQU 6 SP EQU 7 OPCODE EQU 8 MODE EQU 9 ADDRBUS EQU 10 OPERAND EQU 15 $PSTCOD EQU X'0C64' So we can check for attn interrupts END