
 1000  *--------------------------------
 1010  *      6502 RELOCATION SUBROUTINE
 1020  *--------------------------------
 1030  *      MAY BE LOADED ANYWHERE, AS IT IS SELF-RELOCATABLE
 1040  *--------------------------------
 1050  *      ADAPTED FROM SIMILAR PROGRAM IN PROGRAMMERS AID #1
 1060  *      ORIGINAL PROGRAM BY WOZ, 11-10-77
 1070  *      ADAPTED BY BOB SANDER-CEDERLOF, 12-30-81
 1080  *      (ELIMINATED USAGE OF SWEET-16)
 1090  *--------------------------------
 1100  MON.YSAV   .EQ $34  COMMAND BUFFER POINTER
 1110  MON.LENGTH .EQ $2F  # BYTES IN INSTRUCTION - 1
 1120  MON.INSDS2 .EQ $F88E  DISASSEMBLE (FIND LENGTH OF OPCODE)
 1130  MON.NXTA4  .EQ $FCB4     UPDATE POINTERS, TEST FOR END
 1140  MON.RETURN .EQ $FF58
 1150  STACK      .EQ $0100     SYSTEM STACK
 1160  INBUF      .EQ $0200     COMMAND INPUT BUFFER
 1170  *--------------------------------
 1180  A1     .EQ $3C,3D
 1190  A2     .EQ $3E,3F
 1200  A4     .EQ $42,43
 1210  R1     .EQ $02,03
 1220  R2     .EQ $04,05
 1230  R4     .EQ $08,09
 1240  INST   .EQ $0A,0B,0C
 1250  *--------------------------------
 1260  START  LDA #$4C     JMP OPCODE
 1270         STA $3F8     BUILD CONTROL-Y VECTOR
 1280         JSR MON.RETURN    FIND OUT WHERE I AM FIRST
 1290  START1 TSX
 1300         DEX          POINT AT LOW BYTE
 1310         SEC          +1
 1320         LDA STACK,X  LOW BYTE OF START1-1
 1330         ADC #RELOC-START1
 1340         STA $3F9
 1350         LDA STACK+1,X   HIGH BYTE OF START1-1
 1360         ADC /RELOC-START1
 1370         STA $3FA
 1380         RTS
 1390  *--------------------------------
 1400  RELOC  LDY MON.YSAV COMMAND BUFFER POINTER
 1410         LDA INBUF,Y  GET CHAR AFTER CONTROL-Y
 1420         CMP #$AA     IS IT "*"?
 1430         BNE RELOC2   NO, RELOCATE A BLOCK
 1440         INC MON.YSAV YES, GET BLOCK DEFINITION
 1450         LDX #7       COPY A1, A2, AND A4
 1460  .1     LDA A1,X
 1470         STA R1,X
 1480         DEX
 1490         BPL .1
 1500         RTS
 1510  *--------------------------------
 1520  RELOC2 LDY #2       COPY NEXT 3 BYTES FOR MY USE
 1530  .1     LDA (A1),Y
 1540         STA INST,Y
 1550         DEY
 1560         BPL .1
 1570         JSR MON.INSDS2  GET LENGTH OF INSTRUCTION
 1580         LDX MON.LENGTH  0=1 BYTE, 1=2 BYTES, 2=3 BYTES
 1590         BEQ .3       1-BYTE OPCODE
 1600         DEX
 1610         BNE .2       3-BYTE OPCODE
 1620         LDA INST     2-BYTE OPCODE
 1630         AND #$0D     SEE IF ZERO-PAGE MODE
 1640         BEQ .3       NO (X0 OR X2 OPCODE)
 1650         AND #$08
 1660         BNE .3       NO (80-FF OPCODE)
 1670         STA INST+2   CLEAR HIGH BYTE OF ADDRESS FIELD
 1680  *--------------------------------
 1690  .2     LDA R2       COMPARE ADDR TO END OF SOURCE BLOCK
 1700         CMP INST+1
 1710         LDA R2+1
 1720         SBC INST+2
 1730         BCC .3       ADDR > SRCEND
 1740         SEC          COMPARE ADDR TO BEGINNING OF SRC
 1750         LDA INST+1
 1760         SBC R1
 1770         TAY
 1780         LDA INST+2
 1790         SBC R1+1
 1800         BCC .3       ADDR < SRCBEG
 1810         TAX
 1820         TYA          ADDR = ADDR-SRCBEG+DESTBEG
 1830         CLC
 1840         ADC R4
 1850         STA INST+1
 1860         TXA
 1870         ADC R4+1
 1880         STA INST+2
 1890  *--------------------------------
 1900  .3     LDX #0       COPY MODIFIED INSTRUCTION TO DESTINATION
 1910         LDY #0
 1920  .4     LDA INST,X   NEXT BYTE OF THIS INSTRUCTION
 1930         STA (A4),Y
 1940         INX
 1950         JSR MON.NXTA4    ADVANCE A1 AND A4, TEST FOR END
 1960         DEC MON.LENGTH  TEST FOR END OF THIS INSTRUCTION
 1970         BPL .4       MORE IN THIS INSTRUCTION
 1980         BCC RELOC2   END OF SOURCE BLOCK
 1990         RTS

