;***************************************************
;***************************************************
;**                                               **
;**                               PL-PA00-J001A   **
;**     ROCKWELL R6500 MICROCOMPUTER SYSTEM       **
;**                                               **
;**               AIM 65 MONITOR                  **
;**                                               **
;**              PROGRAM LISTING                  **
;**                                               **
;**   REVISION A                   AUG 27, 1978   **
;**                                               **
;***************************************************
;***************************************************


;ROCKWELL INTERNATIONAL
;MICROELECTRONIC DEVICES
;3310 MIRALOMA AVENUE
;P. O. BOX 3669
;ANAHEIM CA U.S.A. 92803

;	**************************************
;	*  USER 6522 ADDRESSES (A000-A00F)   *
;	**************************************
       *=$A000
UDRB   *=*+1		;DATA REG B
UDRAH  *=*+1		;DATA REG A
UDDRB  *=*+1		;DATA DIR REG B
UDDRA  *=*+1		;DATA DIR REG A
UT1L   *=*+1		;TIMER 1 COUNTER LOW
UT1CH  *=*+1		;TIMER 1 COUNTER HIGH
UT1LL  *=*+1		;TIMER 1 LATCH LOW
UT1LH  *=*+1		;TIMER 1 LATCH HIGH
UT2L   *=*+1		;TIMER 2 LATCH & COUNTER LOW
UT2CH  *=*+1		;TIMER 2 COUNTER HIGH
USR    *=*+1		;SHIFT REGISTER
UACR   *=*+1		;AUX CONTROL REGISTER
UPCR   *=*+1		;PERIPHERAL CONTROL REGISTER
UIFR   *=*+1		;INTERRUPT FLAG REGISTER
UIER   *=*+1		;INTERRUTP ENABLE REGISTER
UDRA   *=*+1		;DATA REGISTER A

ASSEM  =$D000		;ASSEMBLER ENTRY
BASIEN =$B000		;BASIC ENTRRY (COLD)
BASIRE =$B003		;BASIC REENTRY (WARM)

;	 MONITOR RAM
;TEXT EDITOR EQUATES (PAG 0)
;OVERLAPS IABUF2+50 (TAPE OUTPUT BUFFER $AD-$FF)
       *=$00DF
NOWLN  *=*+2		;CURENT LINE
BOTLN  *=*+2		;LAST ACTIVE , SO FAR
TEXT   *=*+2		;LIMITS OF BUFFER (START)
END    *=*+2		;LIMITS OF BUFFER (END)
SAVE   *=*+2		;USED BY REPLACE
OLDLEN *=*+1		;ORIG LENGTH
LENGTH *=*+1		;NEW LENGTH
STRING *=*+20		;FIND STRING

       *=$0100
;BREAKPOINTS AND USER I/O HANDLERS
BKS    *=*+8		;.BRK LOCATIONS
UIN    *=*+2		;USER INPUT HANDLER (VECTOR)
UOUT   *=*+2		;USER OUTPUT HANDLER (VECTOR)

;UNUSED KEYS TO GO TO USER ROUTINE
KEYF1  *=*+3		;USER PUTS A JMP INSTRUCTION TO...
KEYF2  *=*+3		;GO TO HIS TOURINE ON EITHER KEY..
KEYF3  *=*+3		;ENTRY

;EQUATES FRO DISASSEMBLER (PAG 1)
       *=$0116		;SAME AS TAPE BUFFER I/O (TARBUFF)
FORMA  *=*+1
LMNEM  *=*+1
RMNEM  *=*+14

;EQUATES FOR MNEMONIC ENTRY
MOVAD  *=*+8
TYPE   *=*+2
TMASK1 =MOVAD
TMASK2 =MOVAD+1
CH     *=*+3
ADFLD  *=*+20
HISTM  =$A42E		;SHARE WITH NAME & HIST
BYTESM =HISTM+1
TEMPX  =HISTM+3 
TEMPA  =HISTM+5
OPCODE =HISTM+6
CODFLG =HISTM+9

;      **********************************
;      *  6532 ADDRESSES (A400-A7FF)    *
;      **********************************
       *=$A400
MONRAM *=*+0
;JUMP VECTORS
IRQV4  *=*+2		;IRQ AFTER MONITOR (NO BRK)
NMIV2  *=*+2		;NMI
IRQV2  *=*+2		;IRQ

;I/O DEVICES
DILINK *=*+2		;DISPL LINKAGE (TO ECHO TO DISP)
TSPEED *=*+1		;TAPE SPEED (C7,5B,5A)
GAP    *=*+1		;TIMING GAP BETWEEN BLOCK
;END OF USER ALTERABLE LOCATIONS
NPUL   *=*+1		;# OF HALF PULSES...
TIMG   *=*+3		;FOR TAPE
REGF   *=*+1		;REGS FLG FOR SINGLE STEP MODE
DISFLG *=*+1		;DISASSEM FLG FOR SINGLE STEP MODE
BKFLG  *=*+1		;ENABLE OR DIS BREAKPOINTS
PRIFLG *=*+1		;ENABLE OR DIS PRINTER
INFLG  *=*+1		;INPUT DEVICE
OUTFLG *=*+1		;OUTPUT DEVICE
HISTP  *=*+1		;HISTORY PTR (SINGLE STEP) (Y)
CURPO2 *=*+1		;DISPLAY POINTER
CURPOS *=*+1		;PRINTER POINTER
CNTH30 *=*+1		;BAUD RATE & ...
CNTL30 *=*+1		;DELAY FOR TTY
COUNT  *=*+1		;# OF LINES (0-99)
S1     *=*+2		;START ADDRESS
ADDR   *=*+2		;END ADDRESS
CKSUM  *=*+2		;CHECKSUM
S2     =BKS+6		;VERTICAL COUNT (ONLY ON DUMP)

;MONITOR REGISTERS
SAVPS  *=*+1		;STATUS
SAVA   *=*+1		;ACCUM
SAVX   *=*+1		;X REG
SAVY   *=*+1		;Y REG
SAVS   *=*+1		;STACK POINTER
SAVPC  *=*+2		;PROGR COUNTER

;WORK AREAS FOR PAGE ZERO SIMULATION
;SIMULATE LDA (NNNN),Y ,WHERE NNNN IS ABSOLUTE
STIY   *=*+3		;STA NM,Y
CPIY   *=*+3		;CMP NM,Y   OR  LDA NM,Y
       *=*+1		;RTS
LDIY   =CPIY

;VARIABLES FOR TAPE
NAME   *=*+6		;FILE NAME
TAPIN  *=*+1		;IN FLG (TAPE 1 OR 2)
TAPOUT *=*+1		;OUT FLG (TAPE 1 OR 2)
TAPTR  *=*+1		;TAPE BUFF POINTER
TAPTR2 *=*+1		;TAPE OUTPUT BUFF PTR
HIST   =NAME		;FOUR LAST ADDR + NEXT (SINGL STEP)
BLK    =$0115		;BLOCK COUNT
TABUFF =$0116		;TAPE BUFFER (I/O)
BLKO   =$0168		;OUTPUT BLOCK COUNT
TABUF2 =$00AD		;OUTPUT BUFF WHEN ASSEMB (PAG0)
DIBUFF *=*+40		;DISPLAY BUFFER

;VARIABLES USED IN PRINTING
IBUFM  *=*+20		;PRINTER BUFFER
IDIR   *=*+1		;DIRECTION == 0=>+ , FF=>-
ICOL   *=*+1		;COLUMN  LEFTMOST=0,RIGHTMOST=4
IOFFST *=*+1		;OFFSET  0=LEFT DGT,1=RIGHT DGT
IDOT   *=*+1		;# OF LAST DOT ENCOUNTERED 
IOUTL  *=*+1		;LOWER 8 OUTPUTS(9 COLS ON RIGHT)
IOUTU  *=*+1		;UPPER 2 DIGITS
IBITL  *=*+1		;1BIT MSK FOR CURRENT OUTPUT
IBITU  *=*+1
IMASK  *=*+1		;MSK FOR CURRENT ROW
JUMP   *=*+2		;INDIR AND ADDR OF TABL FOR CURR ROW

;VARIABLES FOR KEYBOARD
ROLLFL *=*+1		;SAVE LAST STROBE FOR ROLLOVER
KMASK  =CPIY		;TO MASK OFF CTRL OR SHIFT
STBKEY =CPIY+1		;STROBE KEY (1-8 COLUMNS)

;			I/O ASSIGNMENT
       *=$A480
DRA2   *=*+1			;DATA REG A
DDRA2  *=*+1			;DATA DIR REG A
DRB2   *=*+1			;DATA REG B
DDRB2  *=*+1			;DATA DIR REG B

;  WRITE EDGE DETECT CONTROL (NOT USED BECAUSE OF KB)
       *=$A484
DNPA7  *=*+1		;DISABLE PA7 INT .NEG EDGE DET
DPPA7  *=*+1		;DIS PA7 INT ,POS EDGE DETE
ENPA7  *=*+1		;ENA PA7 INT ,NEG EDGE DET
EPPA7  *=*+1		;ENA PA7 INT ,POS EDG DET

;		READ AND CLEAR INTERRUPT
       *=$A485
RINT   *=*+1		;BIT 7=TIMER FLG , NBIT 6=PA7 FLG

;			TIMER INPTERRUPT
       *=$A494
;WRITE COUNT TO INTERVAL TIMER
;INTERRUPT DISABLE FOR THESE ADDRS
DIV1   *=*+1		;DIV BY 1 (DISABLE);ADD 8 to ENA
DIVB   *=*+1		;DIV BY 8 (DIS) ; ADD 8 TO ENA
DIV64  *=*+1		;DIV BY 64 (DIS) ; ADD 8 TO ENA
DI1024 *=*+1		;DIV BY 1024 (DIS) ; ADD 8 TO ENA

;	**********************************************
;	*	6522 ADDRESSES (MONIT) (A800-ABFF)     *
;	**********************************************
       *=$A800
DRB    *=*+1		;DATA REG B
DRAH   *=*+1		;DATA REG A
DDRB   *=*+1		;DATA DIR REG B
DDRA   *=*+1		;DATA DIR REG B
T1L    *=*+1		;TIMER 1 COUNTER LOW
T1CH   *=*+1		;TIMAER 1 COUNTER HIGH
T1LL   *=*+1		;TIMER 1 LATCH LOW
T1LH   *=*+1		;TIMER 1 LATCH HIGH
T2L    *=*+1		;TIMER 2 LATCH & COUNTER LOW
T2H    *=*+1		;TIEMR 2 COUNTER HIGH
SR     *=*+1		;SHIFT REGISTER
ACR    *=*+1		;AUX CONTROL REGISTER
PCR    *=*+1		;PERIPHERAL CONTROL REGISTER
IFR    *=*+1		;INTERRUPT FLAG REGISTER
IER    *=*+1		;INTERRUPT ENABLE REGISTER
DRA    *=*+1		;DATA REGISTER A

;DEFINE I/O CONTROL FOR PGR (CA1,CA2,CB1,CB2)
DATIN  =$0E		;DATA IN CA2=1
DATOUT =$0C		;DATA OUT DA2=0
PRST   =$00		;PRINT START (CB1) ,NEG DETEC
SP12   =$01		;STROBE P1,P2 (CA1) ,POS DETEC
MON    =$C0		;MOTOR ON (CB2 = 0)
MOFF   =$E0
;MSKS TO OBTAIN EACH INTERRUPT
MPRST  =$10		;INT FLG FOR DB1
MSP12  =$02		;INT FLG FRO CA1
MT2    =$20		;INT FLAG FOR T2

;DEFINE I/O CONTROL FOR ACR (TIMERS,SR)
PRTIME =1700		; PRINTING TIME =1.7 MSEC
DEBTIM =5000		; DEBOUNCE TIME (5 MSEC)
T2I    =$00		;T2 AS ONE SHOT (PRI,KB,TTY,TAPE)
T1I    =$00		;T1 AS ONE SHOT ,PB7 DIS (TAPES)
T1FR   =$C0		;T1 IN FREE RUNNING (TAPE)

;	******************************
;	*    DISPLAY   (AC00-AFFF)   *
;	******************************
; REGISTERS FOR DISPLAY (6520)
       *=$AC00
RA     *=*+1		;REGISTER A
CRA    *=*+1		;CONTROL REG A
RB     *=*+1		;REGISTER B
CRB    *=*+1		;CONTROL REG B

;CHR 00-03 ENA BY $AC04-AC07
;CHR 04-07 ENA BY $AC08-AC0B
;CHR 08-11 ENA BY $AC10-AC13
;CHR 12-15 ENA BY $AC20-AC23
;CHR 16-20 ENA BY $AC40-AC43

NULLC  =$FF
CR     =$0D
LF     =$0A
ESCAPE =$1B
RUB    =$08
EQS    =$BD
; .FILE A1

; E=ENTER EDITOR
; T=RE-ENTER EDITOR TO RE-EDIT SOURCE
; R=SHOW REGISTERS
; M=DISPLAY MEMORY
;  =SHOW NEXT 4 ADDRESSES
; G=GO AT CURENT P.C. (COUNT)
; /=ALTER CURRENT MEMORY
; L=LOAD OBJECT
; D=DUMP OBJECT
; N=ASSEMBLE
; *=ALTER P.C.
; A=ALTER ACCUMULATOR
; X=ALTER X REGISTER
; Y=ALTER Y REGISTER
; P=ALTER PROCESSOR STATUS
; G=ALTER STACK POINTER
; B=SET BREAK ADDR
; ?=SHOW BREAK ADDRESSES
; $=CLEAR BREAK ADDRESSES
; H=SHOW TRACE HISTORY STACK
; V=TOGGLE REGISTER PRINT WITH DIS
; Z=TOGGLE DISASSEMBLER TRACE
; \=TURN ON/OFF PRINTER
;  =ADV PAPER
; I=MNEMNOIC ENTER
; K=DISASSEMBLE MEMORY
; 1=TOGGLE TAPE 1 CONTROL (ON OR OFF)
; 2=TOGGLE TAPE 2 CONTROL
; 3=VERIFY CKSUM FOR TAPES
; 4=ENABLE BREAKS
; 5=BASIC ENTRY (COLD)
; 6=BASIC REENTRY (WARM)
;
;FOLLOWING KEYS ARE UNUSED BUT 'HOOKS"
;ARE PROVIDED IN LOCATIONS 010C-0114
;
; KEYF1,KEYF2,KEYF3

       *=$E000
;ALL MSGS HAVE MSB=1 OF LAST CHAR TO END IT
M1     .BYT 'FROM',EQS
M3     .BYT 'TO',EQS
M4     .BYT ' **** PS AA XX YY S',$D3
M5     .BYT 'MORE',$BF
M6     .BYT 'ON',$A0	;'ON '
M7     .BYT 'OF',$C6	;'OFF'
M8     .BYT 'BR',$CB	;'BRK'
M9     .BYT 'IN',EQS
M10    .BYT 'OUT',EQS
M11    .BYT ' MEM FAIL',$A0
M12    .BYT ' PRINTER DOW',$CE
TMSG0  .BYT ' SRCH'
TMSG1  .BYT ' F',EQS
TMSG2  .BYT 'T',EQS
TMSG3  .BYT $A0,$C5,$D2,$D2	;PRINT ' ERROR' ,MSB=1
       .BYT $CF,$D2,$A0,$A0,$A0,$A0,$A0,$A0,';'
TMSG5  .BYT 'A',EQS
TMSG6  .BYT 'BLK=',$A0
TMSG7  .BYT $A0,$CC,$CF,$C1,$C4,';'
EMSG1  .BYT 'EDITO',$D2		;EDITOR MESSAGES
EMSG2  .BYT 'EN',$C4

;VECTORS COME HERE FIRST AFTER JUMP THRU FFFA-FFFF
NMIV1  JMP (NMIV2)	;NMIV2 IS A VECTOR TO NMIV3
IRQV1  JMP (IRQV2)	;IRQV2 IS A VECTOR TO IRQV3

;SINGLE STEP ENTRY POINT (NMI)
NMIV3  STA SAVA		;SAVE ACCUM
       PLA
       STA SAVPS	;SAVE PROCESSOR STATUS
       CLD
       STX SAVX		;SAVE X
       STY SAVY
       PLA
       STA SAVPC	;PROGRAM COUNTER
       PLA
       STA SAVPC+1	
       TSX		;GET STACK POINTER & SAVE IT
       STX SAVS
;TRACE THE ADDRESS
       LDY HISTP	;GET POINTER TO HISTORY STACK
       LDA SAVPC+1	;SAVE HALT ADDR IN HISTORY STACK
       STA HIST,Y
       LDA SAVPC
       STA HIST+1,Y
       JSR NHIS		;UPDATE POINTER
       LDA BKFLG	;SOFT BRAKS ON?
       BEQ NMI5		;NO, DON'T CHCK BRKPOINT LIST
       JSR CKB		;CHECK BREAKPOINT LIST
       BCC NMI5
NMI4   JMP IRQ2		;HIT A BREAK-TRAP TO MONITOR
NMI5   JSR DONE		;COUNT =0?
       BEQ NMI4		;YES, TRAP TO MONITOR
       JSR RCHEK	;CHK IF HE WANTS TO ITNERR
       JMP GOBK		;NOT DONE-RESUME EXECUTION

;POWER UP AND REST ENTRY POINT (RST TRANSFERS HERE)
RSET   CLD		;CLEAR DEC MODE
       SEI		;DISBALE INTERRUPT
       LDX #$FF		;INIT STACK POINTER
       TXS
       STX SAVS		;ALSO INIT SAVED STACK PTR
;INITIALIZE 6522
       LDX #14
RS1    LDA INTAB1,X	;PB1-PB0,PA7-PA0 FOR PRNTR
       STA DRB,X	;PB2=TTO,PB6=TTI
       DEX		;PB4-PB5=TAPE CONTROL,PB7=DATA
       BPL RS1		;PB3=SWITCH KB/TTY
;INITIALIZE 6532
       LDX #3		;PORTS USED FOR KB
RS2    LDA INTAB2,X	;PA0-PA7 AS OUTPUT
       STA DRA2,X	;PB0-PB7 AS INPUT
       DEX
       BPL RS2
;INITIALIZE MONITOR RAM (6532)
       LDA INTAB3	;CHECK IF NMIV2 HAS BEEN CHANGED
       CMP NMIV2	;IF IT HAS THEN ASSUME A COLD
       BNE RS3A		;START AND INITIALZE EVERYTHING
       LDA INTAB3+1
       CMP NMIV2+1
       BNE RS3A
       LDX #16		;THEY ARE EQUAL ,IT'S A WARM RESET
       BNE RS3
RS3A   LDX #0		;INIT EVERYTHING (POWER UP)
RS3    LDA INTAB3,X
       STA NMIV2,X
       INX
       CPX #21
       BCC RS3
;INITIALIZE DISPLAY (6520)
       LDA #0		;SET CONTR REG FOR DATA DIR REG
       LDX #1
       JSR SETREG
       LDA #$FF		;SET DATA DIR REG FOR OUTPUT
       DEX
       JSR SETREG
       LDA #$04		;SET CONTR REG FOR PORTS
       INX
       JSR SETREG
       BNE RS3B
SETREG STA RA,X
       STA RB,X
       RTS
RS3B   CLI		;CLEAR INTRERRUPT

;KB/TTY SWITCH TEST AND BIT RATE MEASUREMENT
       LDA #$08		;PB3=SWITCH KB/TTY
RS4    BIT DRB		;A^M ,PB6-> V (OVERFLOW FLG)
       BNE RS7		;BRANCH ON KB
       BVS RS4		;START BIT=PB6=0?
       LDA #$FF		;YES ,INITIALIZE TIMER T2
       STA T2H
RS5    BIT DRB		;END OF START BIT ?
       BVC RS5		;NO ,WAIT UNTIL PB6 BACK TO 1
       LDA T2H		;STORE TIMING
       EOR #$FF		;COMPLEMENT
       STA CNTH30
       LDA T2L 
       EOR #$FF
       JSR PATCH1	;ADJUST IT
RS6    JSR CRLOW	;CLEAR DISPLAY 
       JMP PAT21
RS7    LDX #19		;CLEAR HARDARE CURSORS
RS8    TXA
       PHA
       LDA #0
       JSR OUTDD1
       PLA
       TAX
       DEX
       BPL RS8
       BMI RS6

;BRK INSTR (00) OR IRQ ENTRY POINT
IRQV3  STA SAVA
       PLA
       PHA		;GET STATUS
       AND #$10		;SEE IF 'BRK' , ISOLATE B FLAG
       BNE IRQ1		;TRAP WAS CAUSED BY 'BRK' INSTRUC
       LDA SAVA		;TRAP CAUSED BY IRQ SO TRANSFER
       JMP (IRQV4)	;CONTROL TO USER THRU VECTOR
;IS 'BRK' INSTR ,SHOW PC & DATA
;PC IS OFF BY ONE , SO ADJUST IT
IRQ1   PLA
       STA SAVPS	;SAVE PROCESSOR STATUS
       STX SAVX
       STY SAVY
       CLD
       PLA		;PROG CNTR
       SEC		;SUBTRACT ONE FROM RETURN ADDR
       SBC #1
       STA SAVPC
       PLA
       SBC #0
       STA SAVPC+1
       TSX		;GET STACK PTR & SAVE IT
       STX SAVS
;SHOW PC AND DATA
IRQ2   JSR REGQ		;SHOW NEXT INSTRUCTION & CONTINUE
;THIS ROUTINE WILL GET A CHR WITH '( )' FROM
;KB/TTY & THEN WILL GO TO THE RESPECTIVE COMMAND
START  JMP PAT19	;CLEAR DEC MODE & (CR)
STA1   LDA #$BC		;'(' CHR WITH MRB=1 FRO DISP
       JSR OUTPUT
       JSR RED1		;GET CHR & ECHO FROM KB/TTY
       PHA
       LDA #'>
       JSR OUTPUT
       PLA		;SCAN LIST OF CMNDS FOR ENTERED CHR
       LDX #MCNT	;COUNT OF COMMANDS
MCM2   CMP COMB,X	;CHECK NEXT COMMAND IN LIST
       BEQ MCM3		;MATHC , SO PROCESS THIS COMMAND
       DEX
       BPL MCM2
;IS BAD COMMAND
       JSR QM
COMIN  CLD
       JSR LL
       LDX SAVS
       TXS
       JMP START
;HAVE VALID COMMAND
MCM3   TXA		;CONVERT TO WORD (MULT BY 2)
       ASL A		;2 BYTES (ADDR)
       TAX
       LDA MONCOM,X	;GET ADDRESS OF COMMAND PROCESSOR
       STA JUMP
       LDA MONCOM+1,X
       STA JUMP+1
       JSR JMPR		;CMD PROOCESSORS CAN EXIT WITH 'RTS'
       JMP START
JMPR   JMP (JUMP)	;GO TO COMMAND


;VALID COMMANDS
MCNT   =    32			;COUNT
COMB   .BYT 'ETRMG/LDN*AXYPS '
       .BYT 'B?#HVZIK123456[]',$5E

MONCOM .WOR EDIT,REENTR,REG,MEM,GO
       .WOR CHNGG,LOAD,DUMP,ASSEM,CGPC,CGA
       .WOR CGX,CGY,CGPS,CGS,NXT5,BRKA
       .WOR SHOW,CLRBK,SHIS,REGT,TRACE
       .WOR MNEENT,KDISA,TOGTA1,TOGTA2,VECKSM
       .WORD BRKK,BASIEN,BASIRE
;USER DEFINED FUNCTIONS
       .WOR KEYF1,KEYF2,KEYF3

;***** R COMMAND-DISPLAY REGISTERS *****
REG    JSR CRLOW	;CLEAR DISPLAY IF KB
       LDY #M4-M1	;MESSAG & (CR)
       JSR KEP
       JSR CRCK
REG1   JSR BLANK
       LDY #SAVPC-ADDR	;OUTPUT PGR CNTR (SAVPC)
       JSR WRITAD
       LDA #<SAVPS	;NOW THE OTEHR 5 REGS
       STA ADDR
       LDA #>SAVPS
       STA ADDR+1
       LDX #5		;COUNT
       BNE MEM1		;SHARE CODE

;***** M COMMAND-DISPLAY MEMORY *****
MEM    JSR ADDIN	;GET START ADDRESS IN ADDR
       BCS MEM3
MEIN   LDX #4
MEM1   LDY #0
MEM2   JSR BLANK
       LDA #<ADDR
       JSR LDAY		;LOAD CONTENTS OF CURR LOCATION
       JSR NUMA		;AND DISPLAY IT AS 2 HEX DIGITS
       INY
       DEX		;DECR COUNTER
       BNE MEM2
MEM3   RTS

;***** G COMMAND-RESTART PROCESSOR *****
GO     JSR PSL1		;'/'
       JSR GCNT		;GET COUNT
       JSR CRLF
       JMP GOBK1	;RESUME EXECUTION
GOBK   LDA REGF		;DISPLAY REGISTERS ?
       BEQ GOBK0	;NO,BRANCH
       JSR REG1		;SHOW THE SIZ REG
       JSR CRCK		;(CR)
GOBK0  JSR RCHEK	;SEE IF HE WANTS TO INTERRUPT
       LDA DISFLG	;DISASSEMBLE CURRENT INSTR?
       BEQ GOBK1	;NO,BRANCH
       JSR DISASM       ;DISASM THIS INSTRUCTION
       JSR CRLOW
GOBK1  LDX SAVS		;RESTORE SAVED REGS FOR RTI
       TXS
       LDY SAVY
       LDX SAVX
       LDA SAVPC+1
       PHA		;PUT PC ON STACK
       LDA SAVPC
       PHA
       LDA SAVPS	;STATUS ALSO
       PHA
       LDA SAVA
       RTI		;AND AWAY WE GO
;***** / COMMAND-ALTER MEMEORY *****
CHNGG  JSR BLANK
       JSR WRITAZ	;WRITE ADDR
CHNG1  JSR BLANK
       JSR RD2		;GET VALUE
       BCC CH2		;ISN'T SKIP OR DONE
       CMP #' 
       BNE CH3		;NOT BLANK SO MUST BE DONE
;SKIP THIS LOCATION
       JSR BLANK
       JMP CH4
;IS ALTER
CH2    JSR SADDR	;STORE ENTERED VALUE INTO MEMORY
       BEQ CH4		;NO ERROR IN STORE
       JMP MEMERR	;MEMORY WRITE ERROR
CH4    INY
       CPY #4
       BNE CHNG1	;GO AGAIN
;HAVE DONE LINE OR HAVE (CR)
CH3    JSR NXTADD	;UPDATE THE ADDRESS
       LDA #CR		;CLEAR DISPL
       JMP PATC10	;ONLY ONE (CR) & BACK TO MONITOR

NXTADD TYA		;ADD Y TO ADDR+1,ADDR
       CLC
       ADC ADDR
       STA ADDR
       BCC NXTA1
       INC ADDR+1
NXTA1  RTS

;WRITE CURRENT VALUE OF ADDR
;PART OF / & SPACE COMM
WRITAZ LDY #0
WRITAD LDA ADDR+1,Y
       LDX ADDR,Y
       JMP WRAX


;***** L COMMAND-GENERAL LOAD *****
;LOAD OBJECT FROM TTY,USER,TAPE OR TAPE IN KIM-1 FORMAT
LOAD   JSR WHEREI	;WHERE INPUT
;GET ':' , # OF BYTES AND SA
LOAD1  JSR INALL	;GET FIRST CHAR
       CMP #';		;LOOK FOR BEGINNING
       BNE LOAD1	;IGNORE ALL CHARS BEFORE ';'
       JSR CLRCK	;CLEAR CHECKSUM
       JSR CHEKAR	;READ UPPER HALF OF ADDRESS
       TAX		;SAVE IN X THE # BYTES
       JSR CHEKAR	;READ UPPER HALF OF ADRESS
       STA ADDR+1
       JSR CHEKAR	;READ LOWER HALF OF ADDRESS
       STA ADDR
       TXA
       BEQ LOAD4	;LAST RECORD (RECORD LENGTH=0)
;GET DATA
LOAD2  JSR RBYTE	;READ NEXT BYTE OF DATA
       JSR STBYTE 	;STORE AT LOC (ADDR+1,ADDR)
       DEX		;DECR RECORD LENGTH
       BNE LOAD2
;COMPARE CKSUM
       JSR RBYTE	;READ UPPER HALF OF CHCKSUM
       CMP CKSUM+1	;COMPARE TO COMPUTED VALUE
       BNE CKERR
       JSR RBYTE	;READ LOWER HALF OF CHECKSUM
       CMP CKSUM
       BNE CKERR
       BEQ LOAD1	;UNTIL LAST RECORD
LOAD4  LDX #5		;READ 4 MORE ZEROS
LOAD5  JSR RBYTE
       DEX
       BNE LOAD5
       JSR INALL	;READ LAST (CR)
       JMP DU13		;SET DEFAULT DEV & GO BACK

;LOAD ROUTINE FROM TAPE BY BLOCKS
;CHECK FOR RIGHT FILE & LAOD FIRST BLOCK
LOADTA LDA #$00		;CLEAR BLOCK COUNT
       STA BLK
       JSR TIBY1	;LOAD BUFFER WITH BLOCK
       DEX		;SET X=0
       STX CURPO2	;CLEAR DISPLAY PTR
       LDA TABUFF,X	;BLK COUNT SHOULD BE ZERO
       BNE LOADTA	;NO, READ ANOTEHR BLOCK
       INX
;AFTER FIRST BLOCK OUTPUT FILE NAME
       INC PRIFLG	;SO DO NOT GO TO PRINT
       LDY #TMSG0-M1	;PRINT 'f='
       JSR KEP
LOAD1A LDA TABUFF,X	;OUTPUT FILE NAME
       JSR OUTPUT	;ONLY TO DISPLAY
       INX
       CPX #6
       BNE LOAD1A
       JSR BLANK
       LDY #TMSG6-M1	;PRINT 'BLK=  '
       JSR KEP
       DEC PRIFLG	;RESTORE PRINTR FLG
       JSR ADDBK1	;JUST OUTPUT BLOCK COUNT
       LDX #1		;RESTORE X
;CHECK IF FILE IS CORRECT
LOADT2 LDA TABUFF,X	;NOW CHEK FILE NAME
       CMP NAME-1,X
       BNE LOADTA	;IF NO FILENAME GET
       INX		;ANOTHER BLOCK
       CPX #6		;FILENAME=5 CHRS
       BNE LOADT2
       STX TAPTR	;SAVE TAPE BUFF PTR
       INC PRIFLG	;OUTPUT MS ONLY TO DISPLAY
       LDA #0		;CLEAR DISPLAY POINTER
       STA CURPO2
       LDY #TMSG7-M1	;PRINTF 'LOAD ' WITHOUT CLR DISPL
       JSR CKER1
       DEC PRIFLG
       RTS

;LINE CKSUM ERROR
CKERR  JSR CKERo	;SUBR SO MNEM ENTRY CAN USE IT
       JSR WRITAZ	;WRITE ADDR
       JMP COMIN
CKERO  JSR LL		;SET DEFAULT DEVICES
       JSR CRCK		;(CR)
CKERO0 LDY #TMSG3-M1	;PRINT 'ERROR'
CKER1  LDA M1,Y		;DONT CLR DISPLAY TO THE RIGHT
       CMP #';
       BEQ CKER2
       JSR OUTPUT	;ONLY TO TERMINAL
       INY
       BNE CKER1
CKER2  RTS

;LOAD ROUTINE FROM TAPE WITH KIM-1 FORMAT
LOADKI JSR CLRCK	;CLEAR CKSUM
LOADK1 JSR TAISET	;SET TAPE FOR INPUT
LOADK2 JSR GETTAP	;READ CHARACTER FROM TAPE
       CMP #'*		;BEGINNING OF FILE?
       BEQ LOADK3	;YES,BRANCH
       CMP #$16		;IF NOT * SHOULD BE SYN
       BNE LOADK1
       BEQ LOADK2
LOADK3 JSR RBYTE	;READ ID FROM TAPE
       STA SAVA		;SAVE ID
;NOW GET ADDR TO DISPLAY
;& COMPARE ID AFTERWARDS
       JSR CHEKAR	;GET START ADDR LOW
       STA ADDR
       JSR CHEKAR	;GET START ADDR HIGH
       STA ADDR+1
       JSR GETID	;ID FROM HIM
       CMP SAVA		;DO IDS MATCH?
       BNE LOADKI	;NO ,GET ANOTHER FILE
LOADK5 LDX #$02		;GET 2 CHARS
LOADK6 JSR GETTAP	;1 CHAR FROM TAPE
       CMP #'/		;LAST CHAR?
       BEQ LOADK7	;YES,BRNCH
       JSR PACK		;CONVERT TO HEX
       BCS CKERR	;NOT HEX CHAR SO ERROR
       DEX
       BNE LOADK6
       JSR STBYTE	;STORE & CHCK MEM FAIL
       JMP LOADK5	;NEXT
LOADK7 JSR RBYTE	;END OF DATA CMP CKSUM
       CMP CKSUM	;LOW
       BNE CKERR
       JSR RBYTE
       CMP CKSUM+1	;HIGH
       BNE CKERR
       PLA		;CORRECT RTN INSTEAD OF WHEREI
       PLA
       JMP DU13		;TELL HIM & GO BACK TO COMMAN

;GET 2 ASCII CHRS INTO 1 BYTE
;FRO TAPE (T) GET ONLY ONE HEX CHR
RBYTE  LDA INFLG	;INPUT DEVICE
       CMP #'T
       BNE RBYT1
       JMP INALL 	;ONLY ONE BYTE FOR T (INPUT DEV)
RBYT1  JSR INALL
       JSR PACK
       JSR INALL
       JMP PACK

;STORE AND CHECK MEMORY FAIL
STBYTE JSR CHEKA	;ADD TO CHSUM
       LDY #0
       JSR SADDR	;STORE AND CHCK
       BEQ *+5
       JMP MEMERR	;MEMORY WRITE ERROR
       LDY #1		;INC ADDR+1,ADDR BY 1
       JMP NXTADD

;GET ID FROM LAST 2 CHR OF FILNAM
GETID  LDX #4		;SEE WHAT HE GAVE US
GID1   LDA NAME,X	;GET LAST 2 CJHARD
       DEX
       CMP #$20		;(SPACE) ?
       BEQ GID1
       LDA NAME,X	;CONVERT TO BINARY
       JSR PACK
       LDA NAME+1,X
       JMP PACK		;ID IS IN STY

;***** D COMMAND-GENERAL DUMP *****
;TO TTY,PRINTR,USER,X ,TAPE,TAKIM-1
DUMP   LDA BKFLG	;SAVE IT TO USE IT
       PHA
       LDA #00
       STA BKFLG
DU1    JSR CRCK		;(CR)
DU0    JSR FROM		;GET START ADDR
       BCS DU0		;IN CASE OF ERROR DO IT AGAIN
       JSR BLANK
       JSR ADDRS1	;TRANSFER ADDR TO S1
DU1B   JSR TO		;GET END ADDR
       BCS DU1B
       JSR CRLOW
       LDA BKFLG	;EXECUTE WHEREO ONLY ONCE
       BNE DV1A
       JSR WHEREO	;WHICH DEV (OUTFLG)
       LDA #0
       STA S2		;CLEAR RECORD COUNT
       STA S2+1
       INC BKFLG	;SET FLG
;CHCK OUTPUT DEV
DV1A   LDA OUTFLG
       CMP #'K		;TAPE FOR KIM?
       BNE *+6
       PLA		;PULL FLG
       JMP DUMPKI	;YES, GO OUTPUT WHOLE FILE
       LDY #1		;OUTPUT ONE MORE BYTE
       JSR NXTADD
DU2    JSR CRLF
       JSR RCHEK	;SEE IF HE WANTS TO INTERRUPT
;CALCULATE # OF BYTES YET TO BE DUMPED
       JSR CLRCK	;CLEAR CKSUM
       LDA ADDR		;END ADDRESS-CURRENT ADDRESS
       SEC
       SBC S1
       PHA		;# OF BYTES LOW
       LDA ADDR+1
       SBC S1+1
       BNE DU6		;# OF BYTES HIGH
;SEE IF 24 OR MORE BYTES TO GO
       PLA		;# BYTES HIGH WAS ZERO
       BEQ DU10		;ARE DONE
       CMP #24		;# BYTES > 24 ?
       BCC DU8		;NO ,ONLY OUTPUT REMAINING BYTES
       BCS DU7		;YES ,24 BYETS IN NEXT RECORD
DU6    PLA
DU7    LDA #24
;OUTPUT ";" ,# OF BYTES AND SA
DU8    PHA
       JSR SEMI		;SEMICOLON
       PLA
       STA COUNT	;SAVE # OF BYTES
       JSR OUTCK	;OUTPUT # OF BYTES
       LDA S1+1		;OUTPUT ADDRESS
       JSR OUTCK
       LDA S1
       JSR OUTCK
;OUTPUT DATA
DU9    JSR OUTCKS	;GET CHAR SPEC BY S1 (NO PAG 0)
       LDA #0		;CLEAR DISP PTR
       STA CURPO2
       JSR ADDS1	;INCR S1+1,S1
       DEC COUNT	;DECREMENT BYTE COUNT
       BNE DU9		;NOT DONE WITH THIS RECORD
;OUTPUT CKSUM
       LDA CKSUM+1
       JSR OUTCK1	;WITHOUT CHEKA
       LDA CKSUM
       JSR OUTCK1
       JSR INCS2	;INC VERTICAL COUNT
       JMP DU2		;NEXT RECORD
;ALL DONE
DU10   LDY #M5-M1	;PRINT 'MORE ?#
       JSR KEPR		;OUTPUT MESSAGE AND GET AN ANSWER
       CMP #'Y
       BNE *+5
       JMP DU1		;DUMP MORE DATA
       PLA		;RESTORE FLG
       STA BKFLG
;OUTPUT LAST RECORD
       JSR INCS2
       JSR SEMI		;OUTPUT ';'
       LDX #2
       LDA #0		;OUTPUT # OF BYTES (0=LAST RECORD)
       JSR OUTCK1
DU10A  LDA S2+1		;OUTPUT RECORD COUNT
       JSR OUTCK1	;CHECKCUM IS THE SAME
       LDA S2
       JSR OUTCK1
       DEX
       BNE DU10A
       JSR CRLF
;CLOSE TAPE BLOCK IF ACTIVE
DU11   LDA OUTFLG
       CMP #'T
       BNE DU13		;NO ,BRANCH
DU12   LDA TAPTR2	;TAP OUTPUT BUFF PTR
       CMP #1		;BECAUSE FIRST ONE IS BLOCK COUNT
       BEQ DU13		;NO DATA TO WRITE
       LDA #0		;FILL REST BUFF ZEROS
       JSR TOBYTE	;OUTPUT TO BUFF
       JMP DU12		;FINISH THIS BLOCK
DU13   JSR CRLOW
       CLC		;ENABL INTERR
       LDA #T1I		;T1 FROM FREE RUNNING ONE SHOT
       STA ACR
DU14   LDA #$34		;SET BOTH TAPES ON
       STA DRB
       JMP LL

;GET CHARACTER SPECIFIED BY START ADDR (S1)
OUTCKS LDA #<S1
       LDY #0
       JSR LDAY

;ADD TO CHECKSUM AND PRINT
OUTCK  JSR CHEKA	;CHCKSUM
OUTCK1 PHA
       LDA OUTFLG	;IF TAPE DO NOT CNVRT
       CMP #'T		;TO TWO ASCII CHRS
       BNE OUTCK2
       PLA
       JMP TOBYTE	;OUTPUT TO TAP BUFF
OUTCK2 PLA
       JMP NUMA		;TWO ASCII REPRE

CHEKAR JSR RBYTE	;TWO ASCI CHR---> 1 BYTE
CHEKA  PHA		;ADD TO CHECKSUM
       CLC
       ADC CKSUM
       STA CKSUM
       BCC *+5
       INC CKSUM+1
       PLA
       RTS

;ADD ONE TO START ADDR (S1)
ADDS1  INC S1
       BNE ADD1
       INC S1+1
ADD1   RTS

INCS2  INC S2		;INCR VERTICAL COUNT
       BNE *+5
       INC S2+1
       RTS

;OPEN A FILE FOR OUTPUT TO TAPE BY BLOCKS
;OUTPUT FILENAME GIVEN BY JSR WHEREO TO TAPE BUFF
DUMPTA LDX #0		;INITIALIZE TAPTR
       TXA		;TO OUTPUT
       STX BLKO		;BLOCK COUNTER
       STX TAPTR2	;TAP OUTPUT BUFF PTR
       JSR TOBYTE	;TWO START OF FILE CHRS
DUMPT1 LDA NAME,X	;OUTPUT FILENAME
       JSR TOBYTE
       INX
       CPX #5		;5 FILENAME CHRS ?
       BNE DUMPT1
       RTS

;DUMP ROUTINE TO TAPE WITH KIM-1 FORMAT
DUMPKI JSR TAOSET	;SET TAPE FOR OUTPUT
       LDA #'*		;TO EITHER 1 OR 2
       JSR OUTTAP	;DIRECTLY TO TAPE
;ID FROM LAST 2 CHRS OF FILENAME
       JSR GETID
       JSR OUTCK1
       JSR CLRCK
;STARTING ADDR
       LDA S1
       JSR OUTCK	;WITH CHCKSUM
       LDA S1+1
       JSR OUTCK
;OUTPUT DATA
DUK2   JSR OUTCKS	;OUTPUT CHR SPECIFIED BY S1+1,S1
       JSR ADDS1	;INCREM S1+1,S1
       LDA S1		;CHCK FOR LAST BYTE
       CMP ADDR		;LSB OF END ADDR
       LDA S1+1
       SBC ADDR+1
       BCC DUK2		;NEXT CHR
;NOW SEND END CHR '/'
       LDA #$2F
       JSR OUTTAP	;DIRECTLY TO TAPE
;CHECKSUM
       LDA CKSUM
       JSR NUMA		;ASCII REPRES
       LDA CKSUM+1
       JSR NUMA
;TWO EOT CHRS
       LDA #$04
       JSR OUTTAP
       JSR OUTTAP
;TURN TAPES ON
       JMP DU13

;***** * COMMAND-ALTER PROGRAM COUNTER *****
CGPC   JSR ADDIN	;ADDR <=ADDRESS ENTERED FROM KB
CGPC0  JSR CGPC1	;TRANSFER ADDR TO SAVPC
       JMP CRLOW
CGPC1  LDA ADDR+1	;THIS WAY MNEMONICS CAN USE IT
       STA SAVPC+1
       LDA ADDR
       STA SAVPC
       RTS

;***** P COMMAND-ALTER PROCESSOR STATUS *****
CGPS   LDX #0
       BEQ CGALL

;***** A COMMAND-ALTER ACCUMULATOR *****
CGA    LDX #1
       BNE CGALL

;***** X COMMAND-ALTER X REGISTER *****
CGX    LDX #2
       BNE CGALL

;***** Y COMMAND-ALTER Y REGISTER *****
CGY    LDX #3
       BNE CGALL

;***** S COMMAND-ALTER STACK POINTER *****
CGS    LDX #4
CGALL  JSR EQUAL	;PRINT PROMPT
       JSR RD2		;GET VALUE FORM KEYBAORD
       BCS GOERR
       STA SAVPS,X
       RTS
GOERR  JSR QM
       BNE CGALL

;***** (SPACE) COMMAND-SHOW NEXT 5 MEMORY LOC *****
NXT5   JSR BLANK
       LDY #4		;UPDATE ADDR FROM
       JSR NXTADD	;(M)=XXXX
       JSR WRITAZ	;OUTPUT ADDRESS
       JMP MEIN		;DISPLAY CONTEXT OF NEXT 4 LOCS

;***** B COMMAND-SET BREAKPOINT ADDR *****
BRKA   LDY #M8-M1	;PRINT 'BRK'
       JSR KEP
BRK1   JSR PSL1		;PRINT '/'
       JSR REDOUT	;GET BREAK NUMBER
       SEC
       SBC #$30		;0 THRU 3
       BMI BKERR	;CHARACTER < '0' - ILLEGAL
       CMP #4		;FOUR BREAKPOINTS
       BMI BKOK		;0 < CHARACTER < 4 -OK
BKERR  JSR QM		;ERROR
       BNE BRK1		;ALLOW REENTRY OF BREAK NUMBER
BKOK   ASL A		;*2 TO FORM WORD OFFSET
       PHA		;SAVE IT
       JSR ADDIN	;GET ADDRESS FOR BREAKPOINT
       PLA
       BCS BK02		;BAD ADDRESS ENTERED
       JSR PATC18	;(CR) & CLR BUFFERS
       TAX		;# OF BRK
       LDA ADDR		;STORE ENTERED ADDR IN BRKPT LIST
       STA BKS,X
       LDA ADDR+1
       STA BKS+1,X
BK02   RTS		;ALL DONE

;***** ? COMMAND-SHOW CURRENT BREAKPOINTS *****
SHOW   LDY #0
       JSR CRLOW
SH1    JSR BLANK
       LDX BKS,Y	;ADDRESS OF NEXT BREAKPOINT
       LDA BKS+1,Y
       JSR WRAX		;SHOW BREAKPOITN ADDRESS
       INY
       INY
       CPY #8
       BNE SH1
       RTS

;***** H COMMAND-SHOW TRACE STACK HISTORY *****
;LAST FIVE INSTR ADDRS
SHIS   LDX #5		;NUMBER OF ENTRIES
       STX STIY+2
SHI1   LDY HISTP	;POINTER TO LATETS ENTRY
       JSR CRLOW
       JSR BLANK
       LDA HIST,Y	;OUTPUT ADDRESS OF ENTRY
       JSR NUMA
       LDA HIST+1,Y
       JSR NUMA
       JSR NHIS		;UPDATE POINTER
       DEC STIY+2
       BNE SHI1
       RTS

;UPDATE HISTORY POINTER (PART OF H)
NHIS   INY
       INY
       CPY #10
       BNE NH1
       LDY #0		;WRAPAROUND AT 10
NH1    STY HISTP
       RTS

;***** 3 COMMAND-VERIFY TAPES *****
;VERIFY CKSUM OF BLOCKS
VECKSM JSR WHEREI	;GET THE FILE
       JSR INALL	;CHK OBJ OR SOURCE
       CMP #CR		;FIRST CHR IS (CR) IF OBJ
       BNE VECK2	;ASSUME SOURCE CODE
VECK1  JSR INALL	;OBJECT FILE
       CMP #';
       BNE VECK1	;IGNORE ALL CHARS BEFORE ';'
       JSR INALL
       JMP PAT20
       NOP
VECK2  JSR INALL	;IT IS TEXT
       CMP #CR
       BNE VECK2
       JSR INALL	;NEED TWO (CR) TO FINISH
       CMP #CR
       BNE VECK2
       JMP DU13		;CLOSE FILE, IT IS OK

;***** 1 COMMAND-TOGGLE TAPE 1 CONTROL *****
TOGTA1 LDA DRB
       EOR #$10		;INVERT PB4
       STA DRB
       AND #$10
       BEQ BRK3		;IF 0 TAPE CNTRL IS ON
       BNE BRK4		;IF $10 TAPE CNTRL IS OFF

;***** 2 COMMAND-TOGGLE TAPE 2 CONTROL
TOGTA2 LDA DRB
       EOR #$20		;INVERT PB5
       STA DRB
       AND #$20
       BEQ BRK3
       BNE BRK4

;***** V COMMAND-TOGGLE REGISTER DISP FLG *****
;DISPLAY REGIST BEFORE EXEC
REGT   LDX #<REGF
       BNE TOGL

;***** Z COMMMAND-TOGGLE DIS TRACE FLG *****
;DISPL NEXT INSTR BEFORE EXEC
TRACE  LDX #<DISFLG
       BNE TOGL

;***** \ COMMAND-TOGGLE PRINTER FLAG *****
PRITR  LDX #<PRIFLG
       BNE TOGL

;***** 4 COMMAND-TOGGLE SOFT BRK ENABL FLG *****
BRKK   LDX #<BKFLG

TOGL   LDA MONRAM,X	;LOAD FLAG
       BEQ TOGL1	;FLAG IS OFF ,SO TURN ON
       LDA #0		;FLAG IS ON ,SO TURN OFF
       STA MONRAM,X
BRK3   LDY #M7-M1	;PRINT 'OFF'
BRK2   JMP KEP
TOGL1  SEC		;TURN FLAG ON BY SETTING NON-ZERO
       ROR MONRAM,X	;FLAG IS ON MSB
BRK4   LDY #M6-M1	;PRINT 'ON'
       BNE BRK2

;***** # COMMAND-CLEAR ALL BREAKS *****
CLRBK  LDA #0		;STORE ZEROS INTO BRKPT LIST
       LDX #7
RS20   STA BKS,X
       DEX
       BPL RS20
       BMI BRK3		;PRINT 'OFF'

;***** K COMMAND-DISASSEMBLE MEMORY *****
KDISA  LDA #'*		;GET START ADDRESS
       JSR OUTPUT
       JSR ADDIN
       BCS KDISA	;IF ERROR DO IT AGAIN
       JSR CGPC0	;GET IT INTO PROG CNTR
       JSR PSL1		;PRINT '/'
       JSR GCNT		;GET COUNT
       JSR CRCK
       JMP JD2
JD1    JSR RCHEK	;SEE IF HE WANTS TO INTERRUPT
       JSR DONE
       BEQ JD4
JD2    JSR DISASM	;GO TO DISASSEMBLER
       LDA SAVPC	;POINT TO NEXT INSTRUC LOCAT
       SEC		;ONE MORE TO PROG CNTR
       ADC LENGTH
       STA SAVPC
       BCC JD3
       INC SAVPC+1
JD3    JSR CRCK		;(CR)
       JMP JD1
JD4    RTS

;INITIALIZATION TABLE FOR 6522
INTAB1 .BYT $34,$00,$37,$FF,$25,$FF,$25,$FF
       .BYT $FF,$FF,$00,T1I+T2I
       .BYT MOFF+PRST+SP12,$FF,$7F
;INITIALIZATION TABLE FOR 6532
INTAB2 .BYT $FF,$FF,$00,$00
;INITIALIZATION TABLE FOR MONITOR RAM
INTAB3 .WORD NMIV3,IRQV3,OUTDIS
       .BYT $C7,$08,$02,$CA,$03,$80,$00,$00
       .BYT $00,$80,$0D,$0D,$00,$00,$00
;SEE IF WE HIT A SOFT BREAKPOINT (PART OF NMV3)
CKB    LDX #7		;COMPARE BRKPT LIST TO TRAP ADDR
CKB2   LDA BKS,X	;GET ADDRESS OF NEXT BREAKPOINT
       DEX
       CMP SAVPC+1	;COMPARE TO SAVED PROGRAM COUNTER
       BNE CKB1
       LDA BKS,X
       CMP SAVPC
       BNE CKB1		;NO MATCH SO TRY NEXT BREAKPOINT
       SEC		;MATCH-SET MATCH FLAG
       RTS
CKB1   DEX
       BPL CKB2		;MORE TO GO
       CLC		;NO MATCH -RESET MATCH FLAG
       RTS
;GET # OF LINES COUNT FOR GO-COMMAND,LIST-COMM
GCNT   JSR RD2
       BCC GCN1
       EOR #$0C		;(SPACE)---> $2C ,(CR)----> $01
GCN1   STA COUNT
       RTS

;CHECK IF COUNT HAS REACHED ZERO
;COUNT=$2C MEANS FOREVER
DONE   LDA COUNT	;IF COUNT=0 WE ARE DONE
       CMP #$2C		;THIS MEANS FOREVER
       BEQ DON1		;SET ACC DIFF FROM ZERO
       SED		;DECREMENT COUNT IN DECIMAL
       SEC
       SBC #1
       CLD
       STA COUNT
       RTS
DON1   LDA #$2C
       RTS

FROM   LDY #0		;PRINT 'FR='
       BEQ TO1

TO     LDY #M3-M1	;PRINT 'TO='
TO1    JSR KEP
       JMP ADDNE	;GET ADDRESS

;PRINT MSG POINTED TO BY Y REG
KEP    LDA M1,Y
       PHA
       AND #$7F		;STRIP OFF MSB
       JSR OUTPUT
       INY
       PLA
       BPL KEP		;MSB =1 ?
       RTS


;PRINT '*' ,BUT NOT TO TAPE RECORDER, NOR LOADING....
;PAPER TAPE OR TO DISPLAY
PROMPT LDA INFLG	;WHICH DEV (FOR EDITOR)
       CMP #'T		;NO PROMPT IF 'T' OR 'L'
       JMP PATC11
PROMP1 JSR TTYTST	;PROMPT ONLY TO TTY
       BNE PR2		;BRANCH ON KB
       LDA #'*
PR1    JMP OUTPUT	;ONLY TO TERMIN
PR2    LDA #CR		;CLR DISP
       JMP OUTDIS

QM     LDA #'?		;PRINT '?'
       BNE PR1

EQUAL  LDA #'=		;PRINT '='
       BNE PR1
;ON DELETE KEY OUTPUT SLASH IF TTY & ....
;BACK UP CURSOR IF KB (MAY NEED SCROLLING)
PSLS   JSR TTYTST	;TTY OR KB ?
       BEQ PSL1		;BRANCH ON TTY
       JSR PHXY	   	;SAVE X,Y
       DEC CURPO2	;DECR DISP PNTR
       LDX CURPO2
       CPX #20		;IF MORE THAN 20 JUST SCROLL THEM
       BCS PSL0
       LDA #' 		;< 20 ,SO CLR CUR
       JSR OUTDP1
       DEC CURPO2
       JMP PSLO0
       NOP
       NOP
PSL0   JSR PATC12	;CLR PRIFLG
       DEX		;ONE CHR LESS
       JSR OUTD2A	;SCROLL THEM
PSLO0  LDA CURPO2	;DISBUFF---> PRIBUFF
       CMP #21
       BCC PSLOB
       CMP #41
       BCC PSLOA
       LDY #40		;CHR 40-59
       SBC #40
       JMP PSLOC
PSLOA  LDY #20		;CHR 20-39
       SEC
       SBC #20
       JMP PSLOC
PSLOB  LDY #0		;CHR 00-19
PSLOC  STA CURPOS
       LDX #0
PSLOD  LDA DIBUFF,Y	;TRANSFER THEM
       STA IBUFM,X
       INX
       INY
       CPX CURPOS	;PRI PNTR
       BCC PSLOD
       JSR OUTPR	;CLR PRI BUFF TO THE RIGHT
       JSR PLXY		;RESTORE X,Y
       RTS
PSL1   LDA #'/		;PRINT '/'
       BNE PR1

BLANK2 JSR BLANK	;TWO SPACE
BLANK  LDA #' '
       BNE PR1


;CHECK TTY/KBD SWITCH (Z=1 FOR TTY)
TTYTST LDA #$08		;CHECK IF TTY OR KB
       BIT DRB		;TTY OR KB SWITCH =PB3
       RTS

;WHERE IS INPUT COMING FROM?
;SET UP FOR INPUT ACTIVE DEVICE
WHEREI LDY #M9-M1	;PRINT 'IN'
       JSR KEPR		;OUTPUT MESSAGE AND INPUT CHR
       STA INFLG
       CMP #'T
       BNE WHE1
       LDX #0		;FOR INPUT FILE FLG
       JSR FNAM		;OPEN FILE FOR TAPE (1 OR 2)
       JMP LOADTA	;GET FILE
WHE1   CMP #'K		;TAPE WITH KIM FORMAT
       BNE WHE2
       LDX #0		;FOR INPUT FILE FLG
       JSR FNAM		;OPEN FILE FOR TAP (1 OR 2)
       JMP LOADKI	;THE WHOLE FILE
WHE2   CMP #'U		;USER RTN?
       BNE WHE3
       CLC		;SET FLAG FOR INITIALIZATION
       JMP (UIN)	;USER INPUT SETUP
WHE3   RTS

;WHERE IS OUTPUT GOING TO?
;SET UP FOR OUTPUT ACTIVE DEVICE
WHEREO LDY #M10-M1	;PRINT 'OUT'
       JSR KEPR		;OUTPUT MSG & INPUT CHR
       STA OUTFLG	;DEVICE FLG
;TAPES
       CMP #'T
       BNE WHRO1
       LDX #1		;FOR OUTPUT FILE FLG
       JSR FNAM		;FILENAME & TAPE (1 OR 2)
       JMP DUMPTA	;INITIALZE FILE
WHRO1  CMP #'K		;TAPE WITH KIM FORMAT
       BNE WHRO2
       LDX #1		;FOR OUTPUT FILE FLG
       JMP FNAM
;PRINTER
WHRO2  CMP #'P		;PRINTER?
       BNE WHRO3
       LDA #CR		;OUTPUT LAST LIEN IF ON
       JMP OUTPRI	;& CLEAR PRINTER PTR
;USER SET UP
WHRO3  CMP #'U		;USER RTN?
       BNE WHRO4
       CLC		;CLR FLG FOR INITIALIZATION
       JMP (UOUT)	;USER OUTPUT SETUP
;ANY OTHER
WHRO4  JMP CRLOW

;GET FILE NAME & TAPE UNIT
FNAM   JSR PHXY		;SAVE IN/OUT FLG (X)
       JSR NAMO		;GET NAME
WHICHT LDY #TMSG2-M1	;PRINT 'T='
       JSR KEPR		;OUTPUT MSG & INPUT CHR
       CMP #CR
       BNE TAP1
       LDA #$31		;(CR) ==> TAPE 1
TAP1   SEC
       SBC #$31		;SUBTRACT 31
       BMI TAP2		;ONLY 1,2 OK
       CMP #2
       BMI TAP3		;OK
TAP2   JSR QM		;ERROR
       JMP WHICHT
TAP3   JSR PLXY		;IN/OUT FLG
       STA TAPIN,X	;IF X=0 -->TAPIN (TAPE 1 OR 2)
       JSR CUREAD	;GET ANYTHING
       JSR CRCK		;(CR)
       RTS		;IF X=1 -->TAPOUT (TAPE 1 OR 2)

;GET FILE NAME
NAMO   LDY #TMSG1-M1	;PRINT 'F='
       JSR KEP		;NO CRLF
       LDY #0
NAMO1  JSR RDRUB	;GET CHAR
       CMP #CR		;DONE?
       BEQ NAMO2
       CMP #' 
       BEQ NAMO2
       STA NAME,Y	;STORE
       INY
       CPY #5
       BNE NAMO1
;BLANK REST OF NAME
NAMO2  LDA #' 
NAMO3  CPY #5
       BEQ NAMO4
       STA NAME,Y
       INY
       BNE NAMO3
NAMO4  JMP BLANK

;SET INPUT FROM TERMINAL (KB OR TTY)
INLOW  LDA #CR
       STA INFLG
       RTS

;SET I/O TO TERMINAL (KB & D/P ,OR TTY)
LL     JSR INLOW

;SET OUTPUT TO TERMINAL (D/P OR TTY)
OUTLOW LDA #CR
       STA OUTFLG
OUTL1  RTS

;ON (ESCAPE) STOPS EXECUTION & BACK TO MONITOR
;ON (SPACE) STOPS EXECUTION & CONTINUE ON ANY OTHER KEY
RCHEK  JSR TTYTST	;TTY OR KB ?
       BEQ RCHTTY
       JSR ROONEK	;CKR MSK & GET A KEY
       DEY
       BMI RCH3		;RTN ON NO KEY
       LDX #0
       JSR GETK2	;GET THE KEY
       CMP #ESCAPE
       BEQ REA1		;TO COMMAN & SET I/O TO TERMINAL
       CMP #' 		;WAIT KEY
       BNE RCH3		;RTN, IGNORE OTHER KEYS
RCH2   JSR ROONEK	;WAIT TILL HE RELEASES IT &
       DEY		;QUIT WAITING ON NEXT KEY
       BMI RCH2
RCH3   RTS
RCHTTY BVS RCHT1	;TTI=PB6 ---> V (OVERFL FLG)
RCHT2  BIT DRB		;WAIT TILL HE RELEASE IT
       BVC RCHT2
       JSR DELAY
       JSR GETTTY	;GET A CHAR
       CMP #ESCAPE
       BEQ REA1		;TO COMMAN
       CMP #' 
       BNE RCHT2
RCHT1  RTS		;QUIT WAITING ON ANY KEY

;READ ONE CHAR FROM KB/TTY AND PRESERVE X,Y
READ   JSR PHXY		;PUSH X & Y
       JSR TTYTST	;TTY OR KB ?
       BNE READ1
       JSR GETTTY
       JMP READ2
READ1  JSR GETKEY
READ2  JSR PLXY		;PULL X & Y
       AND #$7F		;STRIP PARITY
       CMP #ESCAPE
       BNE RCHT1	;RTN
REA1   JSR PATC18	;(CR) AND CLR BUFFERS
       JMP COMIN	;BOTH I/O TO TERMINAL

;READ WITH RUBOUT OR DELETE POSSIBLE
RB2    JSR PSLS		;SLASH OR BACK SPACE
RDRUB  JSR CUREAD
       CMP #RUB		;RUBOUT
       BEQ RDR1
       CMP #$7F		;ALSO DELETE
       BNE RED2		;ECHO IF NOT (CR)
;RUBOUT TO DELETE CHAR
RDR1   DEY
       BPL RB2
       INY
       BEQ RDRUB

;OUTPUT MESSAGE THEN INPUT CHR
KEPR   JSR KEP

;READ AND ECHO A CHAR FROM KB OR TTY
REDOUT JSR CUREAD
RED2   CMP #CR
       BEQ RCHT1	;DO NOT ECHO (CR)

;OUTPUTS A CHAR TO EITHER TTY OR D/P
OUTPUT PHA		;SAVE IT
OUT1   LDA PRIFLG	;IF LSB=1 OUTPUT ONLT TO DISP
       AND #$01
       BEQ OUT1A
       PLA
       JMP OUTDP1	;ONLY TO DISPL
OUT1A  JSR TTYTST	;TTY OR KB ?
       BNE OUT2
       PLA
       JMP OUTTTY	;TO TTY
OUT2   PLA
       JMP OUTDP	;TO DISP & PRINTR

;GET A CHAR FORM CURRENT INPUT DEVICE (SET ON INFL)
INALL  LDA INFLG
       CMP #'T
       BNE *+5
       JMP TIBYTE	;CHAR FROM BUFFER
       CMP #'K		;WITH KIM FORMAT
       BNE *+5
       JMP GETTAP	;DIRECTLY FROM TAPE
       CMP #'M		;MEMORY FOR ASM?
       BNE *+5
       JMP MREAD
       CMP #'U		;USER ROUTINE?
       BNE *+6
       SEC		;SET FLG FOR NORMAL INPUT
       JMP (UIN)
       CMP #'L		;TO LOAD PPR TAPE
       BNE RDRUB
       JMP GETTTY	;FROM TTY

;.FILE A2
SEMI   LDA #';		;OUTPUT A ';'
;WRITE A CHR TO OUTPUT DEVICE (SET ON OUTFLG)
OUTALL PHA
       LDA OUTFLG
;TAPE BY BLOCKS
       CMP #'T		;TAPES ?
       BNE OUTA1
       PLA
       JMP TOBYTE	;OUTPUT ONE CHAR TO TAPE BUFFER
;TAPE KIM FORMAT
OUTA1  CMP #'K		;KIM-1 ?
       BNE OUTA2
       PLA
       JMP OUTTAP
;PRINTER
OUTA2  CMP #'P		;PRINTER ?
       BNE OUTA3
       SEC		;TURN PRINTR ON
       ROR PRIFLG
       PLA
       PHP
       JSR OUTPRI
       PLP
       ROL PRIFLG	;RESTORE FLG
       RTS
;USER DEFINED
OUTA3  CMP #'U		;USER ROUTINE?
       BNE OUTA4
       SEC		;SET FLG FOR NORMAL OUTPUT
       JMP (UOUT)	;YES
;NOWHERE OR TO TTY ,D/P
OUTA4  CMP #'X		;EAT IT?
       BNE OUT1		;OUTPUT TO TTY OR D/P
       PLA
       RTS

;THIS ROUTINE OUPTUTS A CRLF TO ANY OUTPUT DEV
;LF AND NULL IS SENT ONLY TO TTY
CRLF   LDA #CR
       JSR OUTALL
       JSR TTYTST	;TTY OR KB ?
       BNE CR2J
       LDA OUTFLG	;LF ONLY TO TTY
       CMP #'T
       BEQ CR2J
       CMP #'K
       BEQ CR2J
       CMP #'P
       BEQ CR2J
       LDA #LF
       JSR OUTALL
       LDA #NULLC
       JMP OUTALL

;CRLF TO TERMINAL (TTY OR D/P) ONLY
CRLOW  PHA		;SAVE A
       LDA OUTFLG
       PHA
       JSR OUTLOW
       JSR CRLF
       PLA
       STA OUTFLG
       PLA
CR2J   RTS

;OUTPUT (CR) TO TTY IF SWITHC ON TTY & INFLG NOT L
;DONT CLR DISPLAY BUT CLEARS PNTRS FOR NEXT LINE
;IF PRNTR HAS PRINTED ON 21RST CHR DONT OUTPUT (CR)
CRCK   LDA INFLG	;NO (CR) IF 'L'
       CMP #'L
       BNE CRCK1
       RTS
CRCK1  JSR TTYTST	;CHECK IF TTY OR KB
       BEQ CRLOW	;BRANCH IF TTY
;IF PRINTR PTR=0 ,DO NOT CLR PRI
       LDA CURPOS
       BEQ CRCK2	;IF PTR=0 ,NO (CR)
       LDA #CR
       JSR OUTPRI
CRCK2  LDA #$8D		;(CR) ONLY FOR TV
       JMP OUTDP1
       NOP
       NOP

;WRITE A THEN X IN ASCII TO THE OUTPUT DEV
WRAX   JSR NUMA
       TXA

;PRINT ONE BYTE=TWO ASCII CHARS TO OUTPUT DEVICE
NUMA   PHA
       LSR A
       LSR A
       LSR A
       LSR A
       JSR NOUT
       PLA
       AND #$F
NOUT   CLC
       ADC #$30
       CMP #$3A
       BCC LT10
       ADC #6		;CARRY IS SET
LT10   JMP OUTALL

;READ TWO CHR & PACK THEM INTO ONE BYTE
;PART OF ALTER MEMORY , / COMM
RD2    JSR REDOUT
       CMP #$D		;(CR)?
       BEQ RSPAC
       CMP #' 		;FOR MEMORY ALTER
       BEQ RSPAC
       CMP #'.		;TREAT '.' AS (SPACE)
       BNE RD1
       LDA #$20
       BNE RSPAC
RD1    JSR PACK
       BCS RSPAC
       JSR REDOUT
       JMP PACK
;WAS SPACE OR (CR)
RSPAC  SEC
       RTS

;CONVERT ACC IN ASCII TO ACC IN HEX (4 MSB=0)
HEX    PHA		;SAVE A
       LDA #0		;CLEAR STIY IF HEX
       STA STIY+2	;BECAUSE ONLY ONCE
       PLA
;PACK TWO ASCII INTO ONE HEX (CALL SUBR TWO TIMES)
;RESULT IS GIVEN ON ACC WITH FIRST CHR INTO 4 MSB
PACK   CMP #$30		;< 30 ?
       BCC RSPAC
       CMP #$47		; > 47 ?
       BCS RSPAC
       CMP #$3A		; < #10
       BCC PAK1
       CMP #$40		; > #10 ?
       BCC RSPAC
       ADC #8		;ADD 0 IS LETTER (C IS SET)
PAK1   ROL A		;SHIFT A 4 TIMES
       ROL A
       ROL A
       ROL A
       STX CPIY+3	;SAVE X
       LDX #4
PAK2   ROL A		;TRANSFER A TO STIY
       ROL STIY+2	; THRU CARRY
       DEX
       BNE PAK2
       LDX CPIY+3	;REST X
       LDA STIY+2
       CLC
       RTS

;GET FOUR BYTE ADDR ,TAKE LAST FOUR CHR TO....
;CALCULATE ADDR  ALLOW DELETE ALSO
ADDIN  JSR EQUAL
ADDNE  LDA CURPO2	;SAVE POSITION
       PHA
       LDY #0
ADDN1  JSR RDRUB
       CMP #CR
       BEQ ADDN2
       CMP #' 
       BEQ ADDN2
       INY
       CPY #11		;ALLOW 10
       BCC ADDN1
ADDN2  PLA
       STA CPIY+3	;SAVE
       CPY #0		;IF FIRST CHR PUT DEFAULT VALUES
       BNE ADDN3
       LDA #$02
       STA ADDR+1	;DEFAULT OF 0200
       STA CKSUM	;DEFAULT
       STY ADDR
       CLC
       RTS
ADDN3  LDX #0
       DEY		;Y-4
       DEY
       DEY
       DEY
       BPL ADDN5	;BRANCH IF > 4 CHR
       TYA
       EOR #$FF
       TAY		;# OF LEADING 0
ADDN4  LDA #$30
       STA ADDR,X
       INX
       DEY
       BPL ADDN4
       LDY CPIY+3	;NOW THE CHR
       JMP ADDN6
ADDN5  TYA		;PUT CHR
       CLC
       ADC CPIY+3
       TAY
ADDN6  LDA DIBUFF,Y	;FROM DISP BUFF
       STA ADDR,X
       INY
       INX
       CPX #4
       BNE ADDN6
       LDX #1
       LDY #0		;CNVRT CHR TO HEX
ADDN7  LDA ADDR,Y
       JSR HEX
       BCS ADDN8
       INY
       LDA ADDR,Y
       INY
       JSR PACK		;PACK TWO CHRS INTO 1 BYTE
       BCS ADDN8	;BRCNH IF ERROR
       STA ADDR,X
       DEX
       BPL ADDN7
       INX		;X=0
       STX CKSUM	;TO INDICATE WE GOT AN ADDR
       CLC		;NO INVALID CHARS
       RTS
ADDN8  JSR CKERO0	;OUTPUT ERROR MSG
       JSR CRCK		;(CR)
       SEC		;SET CARYY FOR INVALID CHR
       RTS

;MEMORY FAIL TO WRITE MSG & SPECIFIC ADDRESS
MEMERR JSR CRCK
       JSR NXTADD	;ADD Y TO ADDR+1,ADDR
       LDY #M11-M1	;PRINT 'MEM FAIL'
       JSR KEP		;FAIL MSG
       JSR WRITAZ	;PRINT ADDR+1 , ADDR
       JMP COMIN

;CLEAR DISPLAY & PRINTER POINTERS
CLR    LDA #0
       STA CURPO2	;DISP PNTR
       STA CURPOS	;PRINTR PNTR
       RTS

;CLEAR CKSUM
CLRCK  LDA #0
       STA CKSUM+1
       STA CKSUM
       RTS

;CODE FOR PAGE ZERO SIMULTAION
;SUBR LDAY-SIMULATES LDA (N),Y INSTR WITHOUT PAG 0
;BY PUTTING INDIRECT ADDR INTO RAM & THEN EXEC LDA NM,Y
PCLLD  LDA #<SAVPC	;FOR DISASSEMBLER
LDAY   STY CPIY+3	;SAVE Y
       TAY
       LDA MONRAM,Y	;MONRAM=MONITOR RAM
       STA LDIY+1
       LDA MONRAM+1,Y
       STA LDIY+2
       LDY CPIY+3	;REST Y
       LDA #$B9		;INST FOR LDA NM,Y
       STA LDIY
       LDA #$60		;RTS
       STA LDIY+3
       JMP LDIY		;START EXECUTING LDA (),Y

;SUBR STORE AT ADDR & CMP WITOUT PAG 0
;REPLACES STA (ADDR),Y & CMP (ADDR),Y
;LOOK THAT ADDR & ADDR+1 ARE NOT ON PAG 0
SADDR  PHA
       LDA ADDR
       STA STIY+1
       STA CPIY+1
       LDA ADDR+1
       STA STIY+2
       STA CPIY+2
       LDA #$99		;STA INSTR
       STA STIY
       LDA #$D9		;CMP INSTR
       STA CPIY
       LDA #$60		;RTS
       STA CPIY+3
       PLA
       JMP STIY		;START EXECUTING STA ( ),Y

;PUSH X & Y WITHOUT CHANGING REGS
PHXY	STA CPIY+3	;SAVE ACC
       TYA
       PHA		;PUSH Y
       TXA
       PHA		;PUSH X
       JSR SWSTAK	;SWAP X , Y WITH RTRN ADDR FROM SU
       LDA CPIY+3
       RTS

;PULL X & Y WITHOUT CHANGING ACC
;IT HAS TO BE CALLED BY JSR & NOT BY JMP INSTR
;SINCE IT SWAPS THE STACK
PLXY   STA CPIY+3
       JSR SWSTAK	;SWAP X , Y WITH RTRN ADDR FROM
       PLA
       TAX		;PULL X
       PLA
       TAY		;PULL Y
       LDA CPIY+3
       RTS

;SWAP STACK
SWSTAK TSX
       LDA #2
SWST1  PHA
       LDA $0106,X	;GET PCH OR PCL
       LDY $0104,X	;GET Y OR X REGS
       STA $0104,X
       TYA
       STA $0106,X
       DEX
       PLA
       SEC
       SBC #1
       BNE SWST1
       LDA $0108,X	;RESTORE Y & X FROM STACK
       TAY
       LDA $0107,X
       TAX
       RTS

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;GET A CHAR FROM TTY SUBR INTO ACC ,SAVEX X
GETTTY TXA		;SAVE X
       PHA
       LDX #$07		;SET UP FOR 8 BIT CONT
       STX CPIY		;CLEAR MSB
GET1   BIT DRB		;A^M , PB6->V
       BVS GET1		;WAIT FOR START BIT
       JSR DELAY	;DELAY ONE BIT
       JSR DEHALF	;DELAY 1/2 BIT TIME
GET3   LDA DRB		;GET 8 BITS
       AND #$40		;MASK OFF OTHE RBITS,ONLY PB6
       LSR CPIY		;SHIFT RIGHT CHARACTER
       ORA CPIY
       STA CPIY
       JSR DELAY	;DELAY 1 BIT TIME
       DEX
       BNE GET3		;GET NEXT BIT
       JSR DELAY	;DO NOT CARE FOR PARITY BIT
       JSR DEHALF	;UNTIL WE GET BACK TO ONE AGAIN
       PLA 		;RESTORE X
       TAX
       LDA CPIY
       AND #$7F		;CLEAR PARITY BIT
       RTS

;DELAY 1 BIT TIME AS GIEN BY BAUD RATE
DELAY  LDA CNTL30	;START TIMER T2
       STA T2L
       LDA CNTH30
DE1    STA T2H
DE2    LDA IFR		;GET INT FLG FOR T2
       AND #MT2
       BEQ DE2		;TIME OUT ?
       RTS

;DELAY HALF BIT TIME
;TOTLA TIME DIVIDED BY 2
DEHALF LDA CNTH30
       LSR A		;LSB TO CARRY
       LDA CNTL30
       ROR A		;SHIFT WITH CARRY
       STA T2L
       LDA CNTH30
       LSR A
       STA T2H
       JMP DE2

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
GETKDO LDA #0
       STA IDOT		;GO ANOTHER 90 DOTS
       JSR IPO0		;OUTPUT 90 DOTS TO PRI (ZEROS)

;GET CHAR FROM KB SUBROUTINE
;FROM KB Y=ROW ,STBKEY=COLUMNS (STROBE)
;X=CTRL OR SHIFT ,OTHERWISE X=0
GETKEY JSR ROONEK	;WAIT IF LAST KEY STILL DOWN
GETKY  JSR DEBKEY	;DEBOUNCE KEY (5 MSEC)
;CTRL OR SHIFT ?
       LDA #$8F		;CHCK CLMN 5,6,7
       STA DRA2
       LDA DRB2		;CHCK ROW 1
       LSR A
       BCS GETK1	;IF=1 ,NO CTRL OR SHIFT
       LDX #3		;CLMN 5,6,7 (CNTRL,SHIFTL,SHIFTR)
       LDA #$7F		;CTRL OR SHIFT ,SO WHICH ONE ?
GETKO  SEC
       ROR A
       PHA
       JSR ONEK2	;LETS GET CTRL OR SHIFT INTO X
       LDA DRB2
       LSR A		;ONLY 1 ROW
       BCC GETKOO	;GOT YOU
       PLA
       DEX
       BNE GETKO 		
       BEQ GETKY	;THERE IS A MISTAKE CHECK AGAIN
GETKOO PLA		;NOW GET STBKEY INTO X
       LDA STBKEY	;CLMN INTO X
       EOR #$FF		;COMPLEMENT BECAUSE STRBS ARE 0
       TAX		;CTRL OR SIFT TO X
       INC KMASK	;SET MASK=$01
;NOW GET ANY KEY
GETK1  JSR ONEKEY	;GET A KEY
       DEY		;CHK THE ROW (1-8)
       BNE GETK1B	;CHCK IF CTRL OR SHIFT
       LDA STBKEY       ;WERE ENTERED AT THE LAST MOMENT
       CMP #$F7		;IF CLMN 5,6,7,8 DO IT AGAIN
       BCS GETK2
       BCC GETKY	;SEND IT TO GET CTRL OR SHIFT
GETK1B BMI GETKY	;NO KEY ,CLEAR MSK
;WE HAVE A KEY ,DECODE IT
GETK2  JSR DEBK1	;DEBOUNCE KEY (5 MSEC)
       TYA		;MULT BY 8
       ASL A
       ASL A
       ASL A
       TAY		;NOW Y HAS ROW ADDR FROM ROW 1
       LDA STBKEY       ;ADD COLUMN TO Y
GETK3  LSR A
       BCC GETK4
       INY
       BNE GETK3
GETK4  LDA ROW1,Y	;GET THE CHR
       PHA
       TXA		;SEE IF CTRL OR SHIFT WAS USED
       BEQ GETK7	;BRCH IF NO CTRL OR SHIFT
       AND #$10		;CTRL ?
       BEQ GETK5	;NO ,GO GETK5
       PLA
       AND #$3F		;MSK OFF 2 MSB FRO CONTROL
       JMP GETK8	;EXIT
GETK5  PLA
       PHA		;SAVE IT
       AND #$40		;IF ALPHA CHARS DO NOT SHIFT
       BNE GETK7
       PLA
       PHA
       AND #$0F		;ONLY LSB
       BEQ GETK7	;DO NOT INTERCHANGE (SPACE) OR 0
       CMP #$0C		;ACC>=$0C ?
       BCS GETK6	;YES ACC>=$0C
       PLA		;NO, ACC<$0C
       AND #$EF		;STRIP OFF BIT 4
       BNE GETK8	;EXIT
GETK6  PLA		;ACC>=$0C
       ORA #$10		;BIT 4= 1
       BNE GETK8	;EXIT
GETK7  PLA
;CHECK FOR 'ADV PAP', "PRI LINE", OR "TOGL PRIFLG"
;IN THIS WAY WE DONT HAVE TO CHCK FOR THIS COMM
GETK8  CMP #$60		;ADV PAPER COMM
       BNE GETK11
       CPX #0		;IF SHIFT IS NOT ADV PAPER
       BEQ GETK10	;NO SHIFT ,SO ADV PAPER
       AND #$4F		;CONVERT TO "@"
GETK11 CMP #$1C		;SEE IF TOGGL PRIFLG (CONTROL PRI)
       BNE GETK13
       JSR PRITR	;GO TOGGLE FLG
       LDY #1		;GET THE PTRS BACK 3 SPACES
GETK12 LDA CURPO2,Y
       SEC
       SBC #3		;BECAUSE 'ON ,OFF' MSGS
       STA CURPO2,Y
       DEY
       BPL GETK12
       JMP GETKEY
GETK13 CMP #'\		;PRINT LINE COMMAND
       BNE GETK14
       JSR IPSO		;PRINT WHATEVER IS IN BUFFER
       JMP GETKEY
GETK14 RTS
GETK10 JMP GETKDO

;WAIT IF LAST KEY STILL DOWN (ROLLOVER)
ROONEK LDA DRB2		;SEE IF KEY STILL DOWN
       CMP #$FF
       BEQ R001		;NO KEY AT ALL, CLR ROLLFL
       ORA ROLLFL	;ACCEPT ONLY LAST KEY
       EOR #$FF		;STRBS ARE ZERO SO INER
       BNE ROONEK
       JSR DEBKEY	;CLR KMASK & DEBOUNCE RELEASE
R001   LDA #0		;CLR KMASK
       STA KMASK
;GO THRU KB ONCE AND RTN ,IF ANY
;KEY Y=ROW (1-8) & STRBKEY=CLMN
;IF NO KEY Y=0 ,STBKEY=$FF
ONEKEY LDA #$7F		;FISRT STROBE TO MSB
       BNE ONEK2	;START AT ONEK2
ONEK1  SEC		;ONLY ONE PULSE (ZERO)
       ROR A		;SHIFT TO RIGHT
ONEK2  STA DRA2		;OUTPUT CLMN STROBE
       STA STBKEY	;SAVE IT
       LDY #8		;CHECK 8 ROWS
       LDA DRB2		;ANY KEY ?
       ORA KMASK	;DISABLE ROW 1 IF CRTL OR SHIFT
       STA ROLLFL	;SAVE WHICH KEY IT WAS
ONEK3  ASL A
       BCC ONEK4	;JUMP IF KEY (ZERO)
       DEY
       BNE ONEK3
       LDA STBKEY
       CMP #$FF		;LAST CLMN ?
       BNE ONEK1	;NO ,DO NEXT CLMN
ONEK4  RTS

DEBKEY LDX #0		;CLEAR CNTRL OR SHIFT
DEBK1  LDA #0		;CLR KMASK
       STA KMASK
       LDA #<DEBTIM	;DEBOUNCE TIME FOR KEYBOARD
       STA T2L
       LDA #>DEBTIM
       JMP DE1		;WAIT FRO 5 MSEC

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;GET A CHAR FROM TAPE SUBROUTINE
;A BUFFER IS USED TO GET BLOCKS OF DATA
;FROM TAPE ,EXCEPT WHEN FORMAT EQUAL TO
;KIM-1 (THE WHOLE FILE IS LOADED AT ONE TIME)
TIBYTE JSR PHXY		;PUSH X
       LDX TAPTR	;POINTER FOR BUFFER
       CPX #80		;IS BUFFER EMPTY ?
       BNE TIB1
       JSR TIBY1	;LOAD ANOTHER BLOCK
TIB1   LDA TABUFF,X
       INX
       STX TAPTR
       JSR PLXY		;PULL X
       RTS
;LOAD A BLOCK FROM TAPE INTO BUFFER
TIBY1  JSR TAISET	;SET TAPE FOR INPUT
TIBY3  JSR GETTAP	;GET A CHAR FROM TAPE
       CMP #'#		;CHECK FIRST CHAR FOR
       BEQ TIBY4	;START OF BLOCK
       CMP #$16		;IF NOT # SHOULD BE SYN
       BNE TIBY1
       BEQ TIBY3
TIBY4  LDX #0
TIBY5  JSR GETTAP	;NOW LOAD INTO BUFFER
       STA TABUFF,X
       INX
       CPX #82
       BNE TIBY5
       LDA DRB
       AND #$CF
       STA DRB		;TURN OFF TAPES
       CLI		;ENABL INTERR
       JSR ADDBK1	;DISPLAY BLK COUNT
       LDX #0		;TO CLEAR PTR IN TIBYTE
       LDA BLK		;CHECK THE BLOCK COUNT
       BEQ TIBY5A	;IF FIRST BLOCK ,DO NOT CMP
       CMP TABUFF,X
       BNE TIBY7	;BRANCH IF WE MISSED ONE BLOCK
TIBY5A INX
       STX TAPTR
       INC BLK		;INCR BLK CONT
       LDA TABUFF+81	;STORE THIS BLK CKSUM
       PHA
       LDA TABUFF+80
       PHA
       DEC INFLG	;SET INFLG DIFF FROM OUTFLG
       JSR BKCKSM	;COMPUT BLK CKSUM FOR THIS BLK
       PLA
       CMP TABUFF+80	;DO THEY AGREE ?
       BNE TIBY6
       PLA
       CMP TABUFF+81
       BNE TIBY7
       INC INFLG	;RESTORE INPUT DEVICE
       LDX #1		;TO GET FIRST CHR IN TIBYTE
       RTS
TIBY6  PLA		;RESTORE STACK PTR
TIBY7  PLA
       PLA
       PLA
       PLA
       JSR CKERO
       JMP COMIN

;ADD 1 TO BLK COUNT AND OUTPUT IT
ADDBLK INC BLK		;INCR BLK CNT
ADDBK1 INC PRIFLG	;SO DONT OUTPUT TO PRINTR
       LDA #18		;ONLY OUTPUT IN THIS POSITION
       STA CURPO2
       LDA DIBUFF+18	;SAVE DISBUFF (FOR EDIT)
       PHA
       LDA DIBUFF+19
       PHA
       LDX OUTFLG	;SAVE OUTFLG
       LDA #CR
       STA OUTFLG	;TO OUTPUT TO TERMINAL
       LDA BLK+1	;BLK CNT COMING FROM TAPE
       JSR NUMA		;OUTPUT IN ASCII
       STX OUTFLG	;RESTORE OUTFLG
       PLA
       STA DIBUFF+19
       PLA 
       STA DIBUFF+18
       DEC PRIFLG	;RESTORE PRIFLG
       RTS

;SET TAPE (1 OR 2) FRO INPUT
TAISET LDA #$37		;SET PB7 FRO INPUT
       STA DDRB
       LDA TAPIN	;INPUT FLAG (TAP 1=0 OR TAP 2=1)
       JSR TIOSET	;RESET PB4 OR PB5
       LDA #MOFF+DATIN	;SET CA2=1 (DATA IN)
       STA PCR
       LDA #$FF		;PREPARE T2
       STA T2L		;LACTH
;CHCK BIT BY BIT UNTIL $16
SYNC   JSR RDBIT	;GET A BIT IN MSB
       LSR CPIY		;MAKE ROOM FOR BIT
       ORA CPIY		;PUT BIT IN MSB
       STA CPIY
       CMP #$16		;SYN CHAR ?
       BNE SYNC
       LDX #$05		;TEST FRO 5 SYN CHARS
SYNC1  JSR GETTAP
       CMP #$16
       BNE SYNC		;IF NOT 2 CHAR RE-SYNC
       DEX
       BNE SYNC1
       RTS

;SET PB4 OR PB5 OFF
;USED BY IN/OUT SET UPS
TIOSET BNE TIOS1	;BRCH IF TAP1
       LDA #$14		;SET TAPE 2 OFF (PB5=0)
       BNE TIOS2
TIOS1  LDA #$24		;SET TAPE 1 OFF (PB4=0)
TIOS2  STA DRB
       SEI		;DISABLE INTERR WHILE TAP
       RTS

;GET 1 CHAR FORM TAPE AND RETURN
;WITH CHR IN ACC, USE CPIY TO ASM CHR ,USES Y
GETTAP LDY #$08		;READ 8 BITS
GETA1  JSR RDBIT	;GET NEXT DATA BIT
       LSR CPIY		;MAKE ROOM FOR MSB
       ORA CPIY		;OR IN SIGN BIT
       STA CPIY		;REPLACE CHAR
       DEY
       BNE GETA1
       RTS
;GET ONE BIT FROM TAPE AND
;RETURN IT IN SIGN OF A (MSB)
RDBIT  LDA TSPEED	;ARE WE IN C7 OR 5B,5A FREQUENCY
       BMI RDBIT4	;JUMP TO C7 FREQ FROMAT
       JSR CKFREQ	;START BIT IN HIGH FREC
RDBIT1 JSR CKFREQ	;HIGH TO LOW FREQ TRANS
       BCS RDBIT1
       LDA DIV64	;GET HIGH FREQ TIMING
       PHA
       LDA #$FF		;SET UP TIMER
       STA DIV64
RDBIT2 JSR CKFREQ	;LOW TO HIGH FREQ TRANS
       BCC RDBIT2	;WAIT TILL FREQ IS HIGH
       PLA
       SEC
       SBC DIV64	;(256-T1) - (256-T2) =T2-T1
       PHA		;LOW FREQ TIME-HIGHT FREQ TIME
       LDA #$FF
       STA DIV64	;SET UP TIMER
       PLA
       EOR #$FF
       AND #$80
       RTS
;EACH BIT STARTS WITH HALF PULSE OF 2400 & THEN
;3 HALF PULSES OF 1200 HZ FRO 0 ,3 PLUSES OF 2400 FOR 1
;THE READING IS MADE ONTHE FOURTH 1/2 PULSE ,WHERE
;THE SIGNAL HAS STABILIZED
RDBIT4 JSR CKFREQ	;SEE WHICH FREQ
       BCC RDBIT4
       JSR CKFREQ
       JSR CKFREQ
       JMP PATC24	;NOW READ THE BIT

CKFREQ BIT DRB		;ARE WE HIGH OR LOW ?
       BMI CKF4
CKF1   BIT DRB		;WAIT TILL HIH
       BPL CKF1
       ADC $00		;EQUALIZER
CKF2   LDA T2H		;SAVE CNTR
       PHA
       LDA T2L
       PHA
       LDA #$FF
       STA T2H		;START CNTR
       LDA TSPEED
       BMI CKF3		;SUPER SPEED ?
       PLA
       CMP TSPEED	;HIGH OR LOW FREC
       PLA		;C=1 IF HIGH ,C=0 IF LOW
       RTS
CKF3   PLA
       CMP TSPEED	;CENTER FREQ
CKF3A  PLA
       SBC #$FE
       RTS
CKF4   BIT DRB		;WAIT TILL LOW
       BMI CKF4
       BPL CKF2		;GO GET TIMING

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;OUTPUT ACC TO TTY SUBROUTINE
;X,Y ARE PRESERVED
OUTTTY PHA		;SAVE A
       JSR PHXY		;PUSH X
       STA STIY		;PUT CHAR HERE
       JSR DELAY	;STOP BIT FROM LAST CHAR
       LDA DRB
       AND #$FB		;START BIT PB2=0
       STA DRB		;TTO=PB2
       STA STIY+1	;SAVE THIS PATTERN
       JSR DELAY
       LDX #$08		;8 BITS
       ROL STIY		;GET FIRST LSB INTO BIT 2
       ROL STIY
       ROL STIY
OUTT1  ROR STIY
       LDA STIY
       AND #$04		;GET ONLY BIT 2 FOR PB2
       ORA STIY+1	;PUT BIT INTO PATTERN
       STA DRB		;NOW TO TTY
       PHP		;PRESERVE CARRY FOR ROTATE
       JSR DELAY
       PLP
       DEX
       BNE OUTT1
       LDA #$04		;STOP BIT
       ORA STIY+1
       STA DRB
       JSR DELAY	;STOP BIT
       JSR PLXY		;PULL X
       PLA
       CMP #LF
       BEQ OUTT2
       CMP #NULLC
       BEQ OUTT2
       JMP OUTDIS	;USE THAT BUFF
OUTT2  RTS

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;OUTPUT A CHR TO D/P SUBR (SINGLE ENTRY FOR BOTH SUBR)
;IF CHAR=<CR> CLEAR DISPLAY & PRINTER
OUTDP  JSR OUTPRI	;FIRST TO PRI THEN TO DISP
       NOP
       NOP
       NOP
OUTDP1 JMP (DILINK)	;HERE HE COULD ECHO SOMEWHERE ELSE

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;OUTPUT ACC TO DISPLAY SUBROUTINE
;IF SIGN BIT (MSB)=1 DISPL DO NOT CLR TO THE RIGHT
OUTDIS PHA		;SAVE A
       JSR PHXY		;PUSH X
       CMP #CR		;<CR>?
       BNE OUTD1
       LDX #0		;YES
       STX CURPO2	;CLEAR DISP POINTER
       BEQ OUTD5	;GO CLEAR DISP
OUTD1  JMP PATCH4
OUTD1A CPX #60		;LAST CHAR FOR DISP?
       BCC OUTD2
       JSR PLXY		;GO BACK
       PLA		;DO NOT STORE
       RTS
OUTD2  STA DIBUFF,X	;PUT CHAR IN BUFF
       INC CURPO2	;INC POINTER
       CPX #20		;DISPLAY FULL?
       BCC OUTD4
       JSR OUTD2A	;THIS WAY SCROLL IS A SUBR
       BMI OUTD7	;EXIT DISP
;YES, SCROLL CHARS TO THE LEFT
OUTD2A TXA		;X---> Y
       TAY
       LDX #19		;ADDR FOR DISP DO NOT
OUTD3  STX STIY		;DECREM IN BINARY
       LDA DIBUFF,Y	;FROM BUFFER TO DISP
       ORA #$80		;NO CURSOR
       JSR OUTDD1	;CONVERT X TO REAL ADDR
       DEY
       DEC STIY
       LDX STIY
       BPL OUTD3	;AGAIN UNTIL WHOLE DISP
       RTS
OUTD4  PHA
       ORA #$80		;NO CURSOR
       JSR OUTDD1	;X=<$19 ,CONVRT TO REAL ADDR
       PLA
       AND #$80		;IF MSB=0 CLEAR REST OF DISPLAY
       BNE OUTD7
       LDX CURPO2
;CLEAR DISP TO THE RIGHT
OUTD5  CPX #20
       BCS OUTD7
       STX STIY
       LDA #$A0		;<SPACE>
       JSR OUTDD1	;CONVRT TO REAL ADDR
       INC STIY
       LDX STIY
       BNE OUTD5	;GO NEXT
       JMP OUTD7
       NOP
       NOP
       NOP
       NOP
       NOP
       NOP
       NOP
       NOP
       NOP
OUTD7  JSR PLXY		;REST ,SO PRINTR INDEPEN
       PLA
       RTS

;CONVERT X INTO REAL ADDR FOR DISPLAY
;AND OUTPUT IT PB=DATA ; PA=W,CE ,A0 A1 (6520)
OUTDD1 PHA		;SAVE DATA
       TXA
       PHA		;SAVE X
       LSR A		;DIVIDE X BY 4
       LSR A		;TO GET CHIP SELECT
       TAX		;BACK TO X
       LDA #4		;FIRST CHIP SELECT
       CPX #0		;FIRST CHIP ?
       BEQ OUTDD3
OUTDD2 ASL A
       DEX
       BNE OUTDD2	;BACK TILL RIGH CS
OUTDD3 STA STIY+1	;SAVE CS TEMPORARILY
       PLA		;GET X AGAIN FOR CHAR
       AND #03		;IN THAT CHIP
       ORA STIY+1	;OR IN CS AND CHAR
;STORE ADDR AND DATA INTO DISPL
       EOR #$FF		;W=1 , CE=0 & A1,A0
       STA RA
       TAX	;SAVE A IN X
       PLA	;GET DATA
       PHA
       STA RB
       TXA
       EOR #$80		;SET W=0
       STA RA
       NOP
       ORA #$7C		;SET CE=1
       STA RA
       LDA #$FF		;SET W=1
       STA RA
       PLA		;RETURN DATA
       RTS

;       *=$EFF9
       .WOR 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
       .WOR 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
       .byt 0
       .BYT $EA
;       *=$F000
        .BYT 0,0,0,0,0,0
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;OUTPUT ACC TO PRINTER SUBROUTINE
;PRINTS ON 21RST CHAR OR WHEN (CR)
;IT WILL PUT IT ON BUFFER BUT WONT PRINT IF
;PRIFLG=0
OUTPRI PHA		;SAVE CHR TO BE OUTPUT
       JSR PHXY		;SAVE X
       CMP #$0D		;SEE IF CR
       BEQ OUTO1	;YES SO PRINT THE BUFF
       LDX CURPOS	;PTR TO NEXT PSO IN BUFF
       CPX #20		;SEE IF BUFF FULL
       BNE OUT04	;NOT FULL SO RETURN
;(CR) SO FILL REST OF BUFFER WITH BLANKS
OUTO1  PHA
       LDA #0		;CURPOS = 0
       LDX CURPOS	;SEE IF ANYTHING IN BUFFER
       STA CURPOS
       JSR OUTPR	;CLEAR PRIBUFF TO RIGHT
;BUFFER FILLED SO PRINT IT
       JSR IPST		;START THE PRINT
       LDX #0		;STORE CHR IN BUFF (FIRST LOC)
       PLA		;GET IT
       CMP #CR		;DONT STORE IF (CR)
       BEQ OUT05
OUT04  STA IBUFM,X	;STORE CHR IN BUFF
       INC CURPOS	;INCR BUFF PNTR
       INX
       AND #$80
       BNE OUT05	;DONT CLR IS MSB=1
       JSR OUTPR	;CLEAR PRIBUFF TO THE RIGHT
OUT05  JSR PLXY		;RESTORE REGS
       PLA
       RTS
OUTPR  LDA #$20		;FILL REST OF BUFF WIT BLANKS
OUTPR1 CPX #20		;SEE IF END OF BUFF
       BEQ OUTPR2
       STA IBUFM,X	;NO SO STORE BLANK
       INX		;INCR BUFF PNTR
       BPL OUTPR1
OUTPR2 RTS

;SUB TO OUTPUT BUFFER, 70 DOTS (10 DOTS AT
;A TIME BY 7 ROWS) FOR EACH LINE OF PRINTING
IPST   BIT PRIFLG	;PRINT FLG ON ?
       BPL IPO4
IPSO   JSR PINT		;INITIALIZE VALUES
       JSR IPSU		;SET UP FIRS OUTPUT PATTERN
IPO0   LDA #PRST+SP12+MON ;TURN MOTOR ON
       STA PCR
       JSR PAT23	;TIME OUT?
       BNE IPO2		;NO, START SIGNAL RECEIVED
       JSR PAT23	;YES, TRY AGAIN
       BNE IPO2
       JMP PRIERR	;TWO TIMEOUT - ERROR
       NOP
       NOP
       NOP
       NOP
IPO2   JSR PRNDOT	;STRB P1=1 PRINT DOTS (1.7MSEC)
       JSR PRNDOT	;STRB P2=1 PRINT DOTS (1.7MSEC)
;CHECK FOR 90, WHEN 70 PRNDOT WILL OUTPUT ZEROS
       LDA IDOT
       CMP #90
       BCC IPO2		;L.T. 90 THEN GOTO STROB P1
IPO3   LDA #PRST+SP12+MOFF ;TIRN MOTOR OFF
       STA PCR
IPO4	RTS

PRIERR JSR CLR		;CLEAR PRI PNTR
       JSR PATCH5	;PURN PRI OFF
       LDY #M12-M1
       JSR KEP
       JMP COMIN	;BACK WHERE SUBR WAS CALLED

;SUBR TO INCR DOT COUNTER,WHEN
;NEG TRANS OUTPUT CHR FOR 1.7 MSEC
;CLEAR & SET UP NEXT PATTERN
PRNDOT LDA #0		;CLR INTERRUPTS
       STA DRAH
PRDOT0 LDA IFR
       AND #MSP12	;ANY STROBES
       BEQ PRDOT0
       LDA PCR
       EOR #$01
       STA PCR
       INC IDOT
       LDA IOUTU	;2 LEFT ELEM
       ORA DRB		;DO NOT TURN TTY OUTPUT OFF
       STA DRB
       LDA IOUTL	;T RIGTH ELEM, CLR CA1 INTER FLG
       STA DRAH
       LDA #<PRTIME
       STA T2L
       LDA #>PRTIME	;START T2 FOR 1.7 MSEC
       STA T2H
       JSR IPSU		;SET NEXT PATTER WHILE WAITING
       JSR DE2		;WAIT TILL TIME OUT
       LDA #0		;THERNAL ELEM OFF
       STA DRAH
       LDA DRB		;BUT DONT CHANGE TAPE CONTROLS
       AND #$FC
       STA DRB
       RTS

; SUBROUTINE PINT -- INIT VARS FOR PRINTER
PINT   LDA #$FF
       STA IDIR		;DIRECTION <= -
       LDA #5
       STA ICOL		;COLUMN <= LEFTMOST +1
       LDA #1
       STA IOFFST	;OFFSET <= LEFT CHARACTER
       STA IMASK
       LDA #0
       STA IDOT		;DOC COUNTER <= 0
       RTS

;THE VARIABLES FOR THE PRINTER ARE AS FOLLOWS
;
;IDIR   DIRECT HEAD IS CURRENTLY MOVING (0=+, $ff=-)
;ICOL   CLMN TO BE PRINTED NEXT (LEFTMOST=0,RIGHTMOST=4
;IOFFST OFFSET N PRINT BUFF (0=LEFT CHR, 1=RIGHT CHR)

;; PAGE 0051
;.....

;SUBROUTINE IPSU -- SET UP OUTPUT PATTERN FOR PRINTER
;   THIS ROUTINE IS CALLED IN ORDER TO
;SET UP THE NEXT GROUP OF SOLENOIDS TO
;BE OUTPUT TO THE PRINTER
;   ON NETRY THE CONTENTS OF ALL RESGISTERS
;ARE ARIBTRARY
;   ON EXIT THE CONTENTS OF A,X,Y ARE UNDEFINED
IPSU   LDX #0		;X POINTS TO VAR BLOCK FOR PRNTR
       JSR INCP		;ADVANCE PTRS TO NEXT DOT POSITION
;X NOW CONTAINS INDEX INTO PRINT BUFFER
IPS1   LDA IBUFM,X	;LOAD NEXT CHAR FROM BUFFER
       AND #$3F
       TAY
       LDA #<JUMP	;A<= DOT PATTERN FOR CHAR & COL
       JSR LDAY
       BIT IMASK	;SEE IF DOT IS SET
       BEQ IPS2		;NO SO GO ON TO NEXT CHAR
       LDA IBITL	;DOT ON SO SET THE CURR SOLENOID
       BEQ IPS3		;LSB OF SOL MASK IS 0 , DO MSB
       ORA IOUTL	;SET THE SOLENOID IN THE PATTERN
       STA IOUTL
       BNE IPS2		;BRANCH ALWAYS
IPS3   LDA IBITU	;SOLENOID IS ONE OF THE 2 MSD
       ORA IOUTU	;SET THE BIT IN THE PATTERN
       STA IOUTU
IPS2   ASL IBITL	;SHIFT MASK TO NXT CHR POSITION
       ROL IBITU
       DEX		;DECR PTR INTO BUFFER
       DEX
       BPL IPS1		;NOT END YET
;SOLENOID PATTERN IS SET UP IN IOUTU,IOUTL
       LDA IOUTU	;LEFTMOST 2
       AND #$3		;DISABLE FRO SEGEMENTS
       STA IOUTU
       RTS

;SUBROUTINE INCP
;THIS SUBROUTINE IS USED TO UPDATE THE PRINTER VARIABLES
;TO POINT TO TEH NEXT DOT POSITION TO BE PRINTED
;X REG IS USED TO POINT TO THE VARIABLE BLOCK OF
;BEING UPDATED
;ON EXIT X CONTAINS THE POINTER TO THE LAST CHARACTER IN
;THE PRINT BUFFER
;CONTENTS OF A,Y ON EXIT ARE ARIBTRARY
INCP   LDA IDIR,X	;EXAMINE DIRECTION (+ OR -)
       BPL OP03		;DIRECTION = +
;*DIRECTION = -
       LDA ICOL,X	;SEE WHAT THE COLUMN IS
       BEQ OP04		;COLUMN = 0 SO END OF DIGIT
;**COLUMN # 0 SO JUST DECREMENT COLUMN
       DEC ICOL,X
       BPL NEWCOL	;BRANCH ALWAYS
;**COLUMN = 0 SO SEE IF EVEN OR ODD DIGIT
OP04   LDA IOFFST,X
       BEQ OP07		;OFFSET = 0 SO DIREFTION CHANGE
;***OFFSET = 1 SO MOVE TO RIGHT DIGIT
       DEC IOFFST,X	;OFFSET <= 0 (LEFT CHARACTER)
       LDA #4		;COLUMN <= 4
       STA ICOL,X
       BPL NEWCOL	;BRANCH ALWAYS
;***OFFSET = 0 SO CHANGE DIRECTION TO +
OP07   INC IDIR,X	;DIRECTION <= $00 (+)
       BPL NEWROW	;BRANCH ALWAYS
;*DIRECTION = +
OP03   LDA ICOL,X	;SEE IF LAST COLUMN IS DIGIT
       CMP #4
       BEQ OP05		;COLUMN = 4 GO TO NEXT DIGIT
       INC ICOL,X	;JUST INCR COLUMN-NOT END OF DIGIT
       BPL NEWCOL	;BRANCH ALWAYS
;**AT COLUMN 4 -- SEE IF LEFT OR RIGHT DIGIT
OP05   LDA IOFFST,X
       BNE OP06		;OFFSET #0 SO RIGHT DIGIT
       STA ICOL,X	;COLUMN <= 0
       INC IOFFST,X	;OFFSET <= 1 (RIGHT CHARACTER)
       BPL NEWCOL	;BRANCH ALWAYS
;***OFFSET = 1 SO DIRECTION CHANGE
OP06   DEC IDIR,X	;DIRECTION <= $FF (-)

;START OF NEW PRINT ROW
NEWROW ASL IMASK,X	;UPDATE ROW MASK FOR DOT PATTERN
;SATRT OF NEW PRINT COLUMN
NEWCOL LDA #0		;CLEAR OUTPUT PATTERN
       STA IOUTL,X	;PATTERN FOR 8 RIGHT CHRS
       STA IOUTU,X	;PATTERN FOR 2 LEFT SOLEN
       STA IBITU,X	;OUTPUT MSK FRO LEFTMOST SOLEN
       LDA #1
       STA IBITL,X	;OUTPUT MSK FRO RIGHMOST SOELN
;GET ADDRESS OF DOT PATTERN TABLE FOR NEXT COLUMN
       LDA ICOL,X	;GET COLUMN NUMBER (0-4)
       ASL A		;*2 ,INDEX INTO TBL OF TBL ADDRS
       TAY
       LDA MTBL,Y	;LSB OF ADDR OF TABLE
       STA JUMP,X	;PTR TO TBL WITH DOT PATTERNS
       LDA MTBL+1,Y	;MSB OF TABLE ADDRESS
       STA JUMP+1,X
       LDA #18		;COMPUTER INDEX INTO PRNTR BUFFER
       ORA IOFFST,X	;+1 IF RIGHT CHR
       TAX
       RTS

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;OUTPUT ACC TO TAPE BUFFER SUBROUTINE
; & WHEN FULL OUTPUT BUFF TO TAPE
; IF INFLG=OUTFLG= T USE TWO BUFFERS
;OTHERWISE USE SAME BUFFER FROR INPUT
;AND OUTPUT (MONIT BUFFER)
TOBYTE JSR PHXY		;SAVE X
       LDX TAPTR2	;TAPE BUFFER POINTER FOR OUTPUT
       JSR BKCK2	;STORE IN BUFFER
       INX
       STX TAPTR2	;FOR NEXT
       CPX #80		;BUFFER FULL?
       BNE TABY3	;NO , GO BACK
;OUTPUT A BLOCK FROM BUFFER TO TAPE
       JSR BKCKSM	;COMPUTE BLOCK CHECKSUM
       JSR TAOSET	;SET TAPE FOR OUTPUT
       LDA #'#		;CHAR FOR BEGINNING
       JSR OUTTAP	;OF BLOCK
;OUTPUT CHRS FROM ACTIVE BUFFER
TABY2  JSR CKBUFF	;LOAD CHR FORM ACTIVE BUFFER
       JSR OUTTAP	; FROM BUFFER
       INX
       CPX #83		;2 BLOCK CKSUM CHAR + 1 EXTRA CHR
       BNE TABY2	;OTHERWISE ERROR
       LDA DRB
       AND #$CF		;TURN TAPES OFF PB5,PB4
       STA DRB
       CLI		;ENABLE INTERRUPT
       LDA #0
       STA TAPTR2	;CLR TAPE BUFF PTR
       LDA #T1I		;RESET FREE RUNNING TO 1 SHOT
       STA ACR
       JSR PAT22	;ADD 1 TO BLK COUNT & OUTPUT
       LDA BLKO		;PUT BLK CNT IN FIRST LOC (TABUFF)
       JSR TOBYTE
TABY3  JSR PLXY
       RTS

;CHCK ACTIVE BUFFER AND LAOD A CHAR
;CARRY=0 IF ONLY 1 BUFFER ,C=1 IF 2 BUFFERS
CKBUFF LDA INFLG
       CMP OUTFLG
       BNE CBUFF1
       CMP #'T		;SEE IF INFLG=OUTFLG = T
       BNE CBUFF1
       SEC		;USE PAGE 1 FOR OUTPUT BUFFER
       LDA TABUF2,X
       RTS
CBUFF1 CLC		;USE SAME BUFFER FRO I/O
       LDA TABUFF,X
       RTS

;COMPUTER BLOCK CHECKSUM & PUT IT
;AT THE END OF ACTIVE BUFFER
BKCKSM LDA #0		;CLEAR BLK CKSUM LOCAT
       STA TABUFF+80
       STA TABUFF+81
       LDX #79
BKCK1  JSR CKBUFF	;GET CHR FROM EITHER BUFFER
       CLC
       ADC TABUFF+80	;ADD CKSUM
       STA TABUFF+80
       BCC *+5
       INC TABUFF+81
       DEX
       BPL BKCK1	;DO THE WHOLE BUFFER
       LDX #80
       LDA TABUFF+80	;PUT CKSUM INTO RIGTH BUFFER
       JSR BKCK2
       INX
       LDA TABUFF+81
BKCK2  PHA		;OUTPUT A CHAR TO RIGTH BUFFER
       JSR CKBUFF	;GET WHICH BUFFER
       PLA
       BCS BKCK3	;BRANCH TO SECOND BUFFER
       STA TABUFF,X
       RTS
BKCK3  STA TABUF2,X	;TO PAG 1
       RTS

;SET TAPE (1 OR 2) FRO OUTPUT
TAOSET JSR SETSPD	;SET UP SPEED (# OF HALF PULSES)
       LDA TAPOUT	;OUTPUT FLG (TAPE 1 OR 2)
       JSR TIOSET	;SET PB4 OR PB5 TO SERO
       LDA #DATOUT+MOFF ;SET CA2=0 (DATA OUT)
       STA PCR
       LDA #T1FR	;SET TIMER IN FREE RUNNING
       STA ACR
       LDA #00
       STA T1CH		;START TIMER 1
       LDX GAP		;OUTPUT 4 * GAP SYN BYTES
TAOS1  LDA #$16		;SYN CHAR
       JSR OUTTAP	;TO TAPE
       JSR OUTTAP
       JSR OUTTAP
       JSR OUTTAP
       DEX
       BNE TAOS1
       RTS

;OUTPUT ACC TO TAPE
OUTTAP STX CPIY+3	;SAVE X
       LDY #$07		;FOR THE 8 BITS
       STY STIY
       LDX TSPEED
       BMI OUTTA1	;IF ONE IS SUPER HIPER
       PHA
TRY    LDY #2		;SEND 3 UNITS
       STY STIY+1	;STARTING AT 3700 HZ
ZON    LDX NPUL,Y	;#OF HALF CYCLES
       PHA
ZON1   LDA TIMG,Y	;SET UP LACTH FRO NEXT
       STA T1LL		;PULSE (80- OR CA) (FREC)
       LDA #0
       STA T1LH
ZON2   BIT IFR		;WAIT FRO PREVIOUS
       BVC ZON2		;CYCLE (T1 INT FLG)
       LDA T1L		;CLR INTERR FLG
       DEX
       BNE ZON1		;SEND ALL CYCLES
       PLA
       DEC STIY+1
       BEQ SETZ		;BRCH IF LAST ONE
       BMI ROUT		;BRCH IF NO MORE
       LSR A		;TAKE NEXT BIT
       BCC ZON		;....IF IT'S A ONE...
SETZ   LDY #0		;SWITCH TO 2400 HZ
       BEQ ZON		;UNCONDITIONAL BRCH
ROUT   DEC STIY		;ONE LESS BIT
       BPL TRY		;ANY MORE? GO BACK
ROUT1  PLA		;RECOVER CHR
       LDX CPIY+3	;RESTORE X
       RTS

;OUTPUT HALF PULSE FRO 0 (1200 HZ) &
;TWO HALF PULSES FOR 1 (2400HZ) (00 TSPEED)
OUTTA1 PHA
       STA STIY+1	;STORE ACC
OUTTA2 LDX #2		;# OF HALF PULSES
       LDA #$D0		;1/2 PULSE OF 2400
       STA T1LL
       LDA #00
       STA T1LH
       JSR PATC25	;WAIT TILL COMPLETED
       LSR STIY+1	;GET BITS FROM CHR
       BCS OUTTA3
       LDA #$A0		;BIT=0 ,OUTPUT 1220 HZ
       STA T1LL
       LDA #$01
       STA T1LH
OUTTA3 JSR PATC25
       DEX
       BPL OUTTA3	;OUTPUT 3 HALF PULSES
       DEY
       BPL OUTTA2

;; PAGE 0056 Dwight K. Elvey

       JMP ROUT1	;RESTORES REGS
       NOP
       NOP
;SET SPEED FROM NORMAL TO 3 TIMES NORMAL
SETSPD LDA TSPEED	;SPEED FLG
       ROR A		;NORMAL OR 3* NORM
       LDA #12
       BCC SETSP1
       LDA #4
SETSP1 STA NPUL
       LDA #18
       BCC SETSP2
       LDA #6
SETSP2 STA TIMG+1
       RTS

;.FILE A3/2

;; PAGE 0057  DWIGHT ELVEY

; ADDRESS TABLE FOR EACH PRINT COLUMN.
; EACH TBL CONTAINS DOT PATTERNS FOR 1 OF 5 COLUMNS.
;   DATA ARE STORED WITH EACH BYTE DEFINING ONE COLUMN..
; OF A CHARACTER, WITH THE TOP DOT CORRESPONDING TO THE..
; LSB IN THE BYTE
MTBL   .WOR COL0,COL1,COL2,COL3,COL4
;DOT PATTERNS FOR COLUMN ZERO (LEFTMOST COLUMN)
COL0   .BYT $3E,$7E,$7F,$3E,$7F,$7F,$7F,$3E
       .BYT $7F,$00,$20,$7F,$7F,$7F,$7F,$3E
       .BYT $7F,$3E,$7F,$46,$01,$3F,$07,$7F
       .BYT $63,$07,$61,$7F,$03,$00,$02,$40
       .BYT $00,$00,$00,$14,$24,$63,$60,$00
       .BYT $00,$00,$14,$08,$40,$08,$40,$60

;; PAGE 0058 DWIGHT ELVEY

       .BYT $3E,$44,$62,$41,$18,$27,$3C,$01
       .BYT $36,$46,$00,$40,$08,$14,$41,$02

;DOT PATTERNS FOR COLUMN 1
COL1   .BYT $41,$09,$49,$41,$41,$49,$09,$41
       .BYT $08,$41,$40,$08,$40,$02,$06,$41
       .BYT $09,$41,$09,$49,$01,$40,$18,$20
       .BYT $14,$08,$51,$41,$04,$00,$01,$40

;; PAGE 0059 DWIGHT ELVEY

       .BYT $00,$00,$07,$7F,$2A,$13,$4E,$04
       .BYT $1C,$41,$08,$08,$30,$08,$00,$10
       .BYT $51,$42,$51,$41,$14,$45,$4A,$71
       .BYT $49,$49,$00,$34,$14,$14,$41,$01

;DOT PATTERNS FOR COLUMN 2
COL2   .BYT $5D,$09,$49,$41,$41,$49,$09,$41
       .BYT $08,$7F,$41,$14,$40,$0C,$08,$41
       .BYT $09,$51,$19,$49,$7F,$40,$60,$18   P -- W

;; PAGE 0060 DWIGHT ELVEY

       .BYT $08,$78,$49,$41,$08,$41,$01,$40
       .BYT $00,$4F,$00,$14,$7F,$08,$59,$02
       .BYT $22,$22,$3E,$3E,$00,$08,$00,$08
       .BYT $49,$7F,$51,$49,$12,$45,$49,$09
       .BYT $49,$49,$44,$00,$22,$14,$22,$51

;DOT PATTERNS FOR COLUMN 3
COL3   .BYT $55,$09,$49,$41,$22,$49,$09,$49
       .BYT $08,$41,$3F,$22,$40,$02,$30,$41

;; PAGE 0061 DWIGHT ELVEY

       .BYT $09,$21,$29,$49,$01,$40,$18,$20
       .BYT $14,$08,$45,$00,$10,$41,$01,$40
       .BYT $00,$00,$07,$7F,$2A,$64,$26,$01
       .BYT $41,$1C,$08,$08,$00,$08,$00,$04
       .BYT $45,$40,$49,$55,$7F,$45,$49,$05
       .BYT $49,$29,$00,$00,$41,$14,$14,$09

;DOT PATTERNS FOR COLUMN 4

;; PAGE 0062 DWIGHT ELVEY

COL4   .BYT $1E,$7E,$36,$22,$1C,$41,$01,$7A
       .BYT $7F,$00,$01,$41,$40,$7F,$7F,$3E
       .BYT $06,$5E,$46,$31,$01,$3F,$07,$7F
       .BYT $63,$07,$43,$00,$60,$7F,$02,$40
       .BYT $00,$00,$00,$14,$12,$63,$50,$00
       .BYT $00,$00,$14,$08,$00,$08,$00,$03
       .BYT $3E,$40,$46,$22,$10,$39,$31,$03

;; PAGE 0063 DWIGHT ELVEY

       .BYT $36,$1E,$00,$00,$41,$14,$08,$06

;ASCII CHARACTERS FOR KB
ROW1   .BYT $20,$08,$00,$0D,$00,$00,$00,$00
ROW2   .BYT $00,$60,'\',$00,$00,$00,$7F,$00
ROW3   .BYT '.LP-:0;/'
ROW4   .BYT 'MJIO98K,'
ROW5   .BYT 'BGYU76HN'
ROW6   .BYT 'CDRT54FV'
ROW7   .BYT 'ZAWE32SX'
ROW8   .BYT $00,$00,$1B, 'Q1',$5E,']['

;; PAGE 0064 

;DISASSEMBLE INSTRUCTION AND SHOW REGS IS REGF SET
REGQ   LDA REGF		;GET FLAG
       BEQ DISASM
       JSR REG1		;SHOW THE SIX REGS
       JSR CRCK		;(CR)

DISASM JSR PRBL2
       JSR PRPC		;OUTPUT PROG COUNTER
       LDY #0
       JSR PCLLD
       TAY
       LSR A
       BCC IEVEN
       LSR A
       BCS ERR
       CMP #$22
       BEQ ERR
       AND #7
       ORA #$80
IEVEN  LSR A
       TAX
       LDA MODE,X
       BCS RTMODE
       LSR A
       LSR A
       LSR A
       LSR A
RTMODE AND #$F
       BNE GETFMT
ERR    LDY #$80
       LDA #0
GETFMT TAX
       LDA MODE2,X
       STA FORMA
       AND #3
       STA LENGTH
       TYA		;OPCODE
       AND #$8F
       TAX
       TYA		;OPCODE IN A AGAIN
       LDY #3
       CPX #$8A
       BEQ MNNDX3
MNNDX1 LSR A
       BCC MNNDX3
       LSR A
MNNDX2 LSR A
       ORA #$20
       DEY
       BNE MNNDX2
       INY
MNNDX3 DEY
       BNE MNNDX1
       PHA		;SAVE MNEMONIC TABLE INDEX
       JSR PCLLD

;; PAGE 65

       JSR NUMA
       JSR PRBL2	;PRINT LAST BALNK
       PLA
       TAY
       LDA MNEML,Y
       STA LMNEM
       LDA MNEMR,Y
       STA RMNEM
       LDX #3		;MUST BE
PRMN1  LDA #0
       LDY #5
PRMN2  ASL RMNEM
       ROL LMNEM
       ROL A
       DEY
       BNE PRMN2
       ADC #$BF		;ADD '?' OFFSET
       JSR OUTALL
       DEX
       BNE PRMN1
       JSR PRBL2
       LDX #6
       LDA #0
       STA STIY+2	;FLAG
PRADR1 CPX #3
       BNE PRADR3	;IF X=3 PRINT ADDR VALUE
       LDY LENGTH
       BEQ PRADR3	;1 BYTE INSTR
PRADR2 LDA FORMA
       CMP #$E8		;RELATIVE ADDRESSING
       JSR PCLLD
       BCS RELADR
;SEE IF SYMBOL
       PHA
       LDA STIY+2
       BNE MR11A
       INC STIY+2	;SHOW WE WERE HERE

MR11A  PLA
       JSR NUMA
       DEY
       BNE PRADR2
PRADR3 ASL FORMA
       BCC PRADR4
       LDA CHAR1-1,X
       JSR OUTALL
       LDA CHAR2-1,X
       BEQ PRADR4
       JSR OUTALL
PRADR4 DEX
       BNE PRADR1
       RTS
RELADR JSR PCADJ3
       TAX
       INX
     
;; PAGE 66

       BNE PRNTYX
       INY
PRNTYX TYA
       JMP WRAX		;PRINT A &X
PRPC   LDA SAVPC+1	;PRINT PC
       LDX SAVPC
       JSR WRAX
PRBL2  LDA #$20
       JMP OUTALL
       LDA LENGTH
       SEC
PCADJ3 LDY SAVPC+1	;PRG CNTR HIGH
       TAX
       BPL PCADJ4
       DEY
PCADJ4 ADC SAVPC	;PROG CNTR LOW
       BCC RTS1
       INY
RTS1   RTS

MODE   .BYT $40,2,$45,3,$D0,8,$40,9
       .BYT $30,$22,$45,$33,$D0,8,$40,9
       .BYT $40,2,$45,$33,$D0,8,$40,9
       .BYT $40,2,$45,$B3,$D0,8,$40,9
       .BYT 0,$22,$44,$33,$D0,$8C,$44,0

;; PAGE 67

       .BYT $11,$22,$44,$33,$D0,$8C,$44,$9A
       .BYT $10,$22,$44,$33
       .BYT $D0,8,$40,9
       .BYT $10,$22,$44,$33,$D0,8,$40,9
       .BYT $62,$13,$78,$A9
MODE2  .BYT 0,$21,1,2,0,$80,$59,$4D 
       .BYT $11,$12,6,$4A,5,$1D
CHAR1  .BYT ',',$29,',#(','.'
CHAR2  .BYT 'Y',0,'X',0,0,'A'

;; PAGE 68

MNEML  .BYT $1C,$8A,$1C,$23,$5D,$8B,$1B
       .BYT $A1
       .BYT $9D,$8A,$1D,$23,$9D,$8B,$1D,$A1
       .BYT 0,$29,$19,$AE,$69,$A8,$19,$23
       .BYT $24,$53,$1B,$23,$24,$53,$19,$A1
       .BYT 0,$1A,$5B,$5B,$A5,$69,$24,$24
       .BYT $AE,$AE,$A8,$AD,$29,0,$7C,0
       .BYT $15,$9C,$6D,$9C,$A5,$69,$29,$53

;; PAGE 69

       .BYT $84,$13,$34,$11,$A5,$69,$23,$A0
MNEMR  .BYT $D8,$62,$5A,$48,$26,$62,$94
       .BYT $88
       .BYT $54,$44,$C8,$54,$68,$44,$E8,$94
       .BYT 0,$B4,8,$84,$74,$B4,$28,$6E
       .BYT $74,$F4,$CC,$4A,$72,$F2,$A4,$8A
       .BYT 0,$AA,$A2,$A2,$74,$74,$74,$72

;; PAGE 70

       .BYT $44,$68,$B2,$32,$B2,0,$22,0
       .BYT $1A,$1A,$26,$26,$72,$72,$88,$C8
       .BYT $C4,$CA,$26,$48,$44,$44,$A2,$C8

;; PAGE 71

 
;*******************************
;***    AIM TEXT EDITOR      ***
;***      05/01/78           ***
;*******************************

; R=READ FROM ANY INPUT DEVICE
; I=INSERT A LINE FORM INPUT DEV
; K=DELETE A LINE
; U=GO UP ONE LINE
; D=O DOWN ONE LINE
; L=LIST LINES TO OUTPUT DEV
; T=GO TO TO OF TEXT
; B=GO TO BOTTOM OF TEXT
; F=FIND STRING
; C=CHANGE STRING TO NEW STRING
; Q=QUIT EDITOR
; (SPACE)=DISPLAY CURRENT LINE

;***** E COMMAND-EDITOR ENTRY (FROM MONITOR) *****
EDIT   JSR CRLOW
       LDY #EMSG1-M1
       JSR KEP		;START UP MSG
       JSR CRLOW
EDIO   JSR FROM
       BCS EDIO
       LDA CKSUM	;IS CLR IF ADDR WAS INPUTTED
       BEQ *+5
       JSR WRITAZ	;OUTPUT DEFAULT ADDR (0200)
       LDX #1
EDI1   LDA ADDR,X
       STA TEXT,X
       STA BOTLN,X
       STA S1,X		;FOR MEMORY TEST
       DEX
       BPL EDI1
       JSR BLANK2
EDI2   JSR TO		;END
       BCS EDI2
       JSR TOPNO	;TRANSF TEXT TO ADDR FRO RAM CHECK
       LDA CKSUM	;IS CLR IF ADDR WAS INPUTTED
       BEQ EDI4		;BRNCH IF NOT DEFAULT VALUE
       JSR SAVNOW
EDI3   JSR EDI		;CARRY IS SET IF NO RAM THERE
       BCC EDI3
       LDA #0		;SET UPPER LIMIT TO BEGINNING....
       STA ADDR		;OF PAGE
       JSR WRITAZ	;OUTPUT DEFAULT VALUE ,UPPER LIMIT
EDI4   LDA ADDR
       STA END
       LDA ADDR+1
       STA END+1
       JSR SAVNOW
;NOW SEE IF MEMORY IS THERE

;; PAGE 72

EDI5   JSR EDI
       BCC EDI5
       LDA END+1	;CMP WITH END
       CMP ADDR+1
       BEQ EDI7
       BCS EDI8
EDI6   JSR TOPNO	;RESTORE NOWLN
       LDA #0
       STA (NOWLN),Y	;END OF TEXT MARKER
       JSR CRLOW
       LDA #'R		;FORCE READ COMMAND
       JMP ENTRY
EDI7   LDA END		;IF ZERO MEM IS OK
       BEQ EDI6
EDI8   LDA #0
       STA ADDR
       JMP MEMERR	;NO MEMORY FOR THOSE LIMITS

EDI    LDY #0		;CHCK IF MEMORY WRITES
       JSR PATCH6	;GET BYTE ADDR BY ADDR,ADDR+1
       PHA		;SAVE IT
       LDA #$AA		;SET THIS PATTERN
       JSR SADDR	;CHCK IT
       BNE EDI2B
       PLA
       JSR SADDR	;RESTORE CHR
       INC ADDR+1	;NEXT PAG
       CLC		;IT WROTE
       RTS
EDI2B  SEC		;DIDNT WRITE
       PLA
       RTS

;***** T COMMAND-REENTRY EDITOR *****
;RE-ENTRY POINT,TEXT ALREADY THERE
REENTR JSR CRCK		;(CR) IF PRI ON
TP     JSR TOPNO	;GO TO TOP
       JMP INO3A	;DISPLAY LINE

;***** U COMMAND-UP LINE *****
;GO UP ONE LINE BUT....
;DOWN IN ADDRESSING MEMEORY
DNNO   JSR ATTOP	;THIS RTN DOESNT PRINT
       BCC DOW1		;NOT TOP
       JSR PLNE		;ARE AT TOP
       JMP ERRO
DOW1   LDY #0
       JSR SUB		;DECREMENT NOWLN PAST (CR)
DOW2   JSR SUB
       JSR ATTOP
       BCS UP4
       LDA (NOWLN),Y
       CMP #CR
       BNE DOW2
       JMP AD1

;; PAGE 73

;***** D COMMAND-DOWN LINE *****
;GO DOWN ONE LINE BUT....
;UP IN ADRESSING MEMEORY
UP     JSR UPNO
       JSR PLNE		;DISPLAY LINE & CHCK BOTTOM
       JSR ATBOT
       BCC UP4
       LDY #EMSG2-M1	;PRINT 'END'
       JMP KEP
UPNO   LDY #0
       JSR ATBOT
       BCC UP1
       JMP ENDERR
UP1    LDA (NOWLN),Y
       BEQ UP4
       INY
       CMP #CR
       BNE UP1
       TYA
       JSR ADDA		;ADD LENGTH TO CURRENT LINE
UP4    RTS

;***** B COMMAND-GO TO BOTTOM *****
BT     JSR SETBOT
;START U-COMMAND HERE
DOWN   JSR DNNO		;U COMMAND

;***** (SPACE) COOMAND-DISPLAY CURRENT LINE *****
PLNE   LDY #0		;PRINT CURRENT LINE
PO2    LDA (NOWLN),Y
       BEQ PO1		;PAST END ?
       CMP #CR		;DONE?
       BEQ	PO1
       JSR OUTALL	;PUT IT SOMEWHERE
       STA DIBUFF,Y
       INY
       JMP PO2
PO1    STY LENGTH
       STY OLDLEN
PO3    LDY OUTFLG	;ONE MORE (CR) FOR TAPE
       CPY #CR
       BEQ PO0
       JMP CRLF		;TO OUTPUT DEV
PO0    JMP CRCK		;(CR), & DONT CLR DISPL

;***** K COMMAND-KILL LINE *****
;DELETE CURRENT LINE
DLNE   JSR KIFLG	;CLR K OR I COMM FLG
       NOP
       NOP
       NOP
       JSR PLNE
       JSR ATBOT
       BCS PLNE		;AT END OF TEXT
       LDY #0

;; PAGE 74

       STY LENGTH
       JSR REPLAC	;KILL LINE
       JMP PLNE

;***** I COMMAND-INSERT LINE *****
IN     JSR INL
       JSR UP		;DISPLAY NEXT LINE DOWN
       JMP ERRO		;IF AT BOTTOM PRINT 'END'
INL    JSR KIFLG	;CLR K OR I COMM FLG
       LDY #0		;GET LINE INTO DIBUFF
       STY OLDLEN
       JSR PROMPT
       JSR CLR
INO2   JSR INALL
       JSR PATC12	;CLR, SO WE CAN OUTPUT TO PRI
       CMP #$7F		;RUB
       JMP PATC17	;NO ZEEROS IN CASE OF PAPER TAPE
INO2A  CMP #LF
       BEQ INO2
       CMP #CR
       BEQ INO3
       CPY #60		;DO NOT INCR Y IF 60
       BCS INO3B
       STA DIBUFF,Y
       INY
       CPY #60
       BNE INO2		;CONTIN , DISP WONT ALLOW > 60 CHR
INO3B  LDY #60		;SET Y TO MAX OF 60
       LDA #$01
       ORA PRIFLG	;DO NOT OUTPUT TO PRI ANY MORE
       STA PRIFLG	;OTHERWISE CLOBBERS BUFFER
       STY CURPO2
       BNE INO2		;GO BACK
INO3   STY LENGTH
       CPY #0		;FIRST CHAR?
       BNE INO5
       LDA COUNT	;K OR I COMM FLG ?
       BNE INO5		;BRANCH IF C COMMAND
       JSR CRCK		;(CR) IF PRI PNTR DIFF FROM 0
       JSR PATC13	;TURN ON TAPES & SET DEFAULT DEV
INO3A  JSR PLNE		;DISPLAY NEXT LINE DOWN
       JSR UPNO		;PRINT 'END' IF BOTTOM
       JSR DNNO
       JMP ERRO
INO5   JSR REPLAC	;INSERT HE LINE
       JMP CRCK		;(CR) IF PRI PTR NOT 0

;***** R COMMAND-READ LINE *****
;READ TEXT FROM ANY INPUT DEVICE UNTIL
;TWO CONSECUTIVE (CR) ARE ENCOUNTERED
INPU   JSR WHEREI
       LDY INFLG  	;IF TAPE DO NOT ERRASE BUFFER
       CPY #'T
       BEQ INPU1
       JSR CRLOW   

;; PAGE 75

INPU1  JSR INL
       JSR UPNO		;NEXT LINE
       JMP INPU1

;***** L COMMAND-LIST LINES *****
;PRINT FROM HERE N LINES TO ACTIVE OUTPUT DEV
LST    JSR PSL1		;PRINT '/'
       JSR GCNT		;GET LINES COUNT
       JSR CRLOW
       JSR WHEREO	;WHERE TO
       JMP LSTO2	;ONE MORE LINE
LSTO1  JSR RCHEK
       JSR DONE
       BEQ LST3
LSTO2  JSR PLNE
       JSR UPNO		;NEXT LINE
       JSR ATBOT
       BCC LSTO1	;NO
LST3   JSR PO3		;ONE MORE CRLF FOR TAPE
       JSR PATC14	;CLOSE TAPE IF NEEDED
       JMP ENDERR

;***** F COMMAN-FIND STRING *****
;FIND STRING AND PRINT LINE TO TERMINAL
FCHAR  JSR FCH
FCHA1  LDA CURPO2	;SAVE BUFFER PNTR
       PHA
       JSR CLR		;CLEAR DISP PNTR
       JSR PLNE
       PLA
       STA CURPO2
       RTS
;FIND A CHARACTER STRING
FCH    LDY #0
       JSR PROMPT
FC1    JSR RDRUB	;GET THE CHARACTER
       CMP #$D		;REUSE OLD ARGUMENT??
       BNE FC3
       CPY #0		;FIRST CHAR?
       BNE FC3
FC2    JSR UPNO		;NEXT LINE DOWN
       JMP FC5
FC3    CMP #CR		;DONE
       BEQ FC4
       STA STRING,Y
       INY
       CPY #20		;MAX LENGTH
       BNE FC1
       JMP ERROR
FC4    JSR CRCK		;CLEAR DISPLAY
       STY STIY+2	;COUNT OF CHRACTERS
FC5    LDY #0
       STY CURPO2	;STRAT AT BEGINNING OF LINENTR IS
FC6    LDY CURPO2	;CLOBBER
       LDX #0

;; PAGE 0076

FC7    LDA (NOWLN),Y	;GET THE CHARACTER
       BNE FC8		;NOT AT END
       JMP ENDERR
FC8    CMP #CR		;END OF LINE
       BEQ FC2
       CMP STRING,X
       BEQ FC9
       INC CURPO2
       JMP FC6
FC9    INY
       INX
       CPX STIY+2	;DONE?
       BNE FC7
       RTS

;***** Q COMMAND-EXIT EDITOR *****
;EXIT THE TEXT EDITOR NEATLY
STOP   JSR CRLOW
       JMP COMIN

;***** C COMMAND-CHANGE STRING *****
;CHANGE STRING TO ANOTHER STRING IN A LINE
CHNG   JSR CFLG		;SET C COMMAND FLG
       JSR FCHAR	;FIND CORRECT LINE
CHN1   JSR READ		;IS (CR) IF OK
       CMP #CR
       BEQ CHN2
       JSR FC2		;TRY NEXT ONE
       JSR FCHA1	; SHOW LINE
       JMP CHN1
CHN2   LDA STIY+2	;GET CHAR COUNT
       STA OLDLEN	;GET READY FRO REPLAC
       LDA CURPO2	;PNTR TO BEGINNING OF STRING
       PHA		;SAVE IT
       JSR ADDA		;ADD TO NOWLN (LINE PNTR)
       JSR CLR		;CLEAR DISP
       LDY #M3-M1	;PRINT 'TO'
       JSR KEP
       LDY #0
       JSR INO2		;GET NEW STRING & REPLAC
       PLA
       TAX
       BEQ CHN4
CHN3   JSR SUB		;RESTORE NOWLN WHERE IT WAS
       DEX
       BNE CHN3
CHN4   JMP PLNE		;DISPLAY THE CHANGED LINE


;THE FOLLOWING ARE SUBROUTINES USED BY COMMANDS
CFLG   LDA #1		;SET FLG FOR C COMMAND
       BNE KI2
KIFLG  LDA #0		;CLR K OR I COMMAND FLG

;; PAGE 0077

KI2    STA COUNT
       RTS


TOPNO  LDA TEXT		;SET CURRENT LINE TO TOP
       LDX TEXT+1
TPO1   STA NOWLN
       STX NOWLN+1
       RTS

SETBOT LDA BOTLN	;SET CURRENT LINE TO BOTTOM
       LDX BOTLN+1
       STA SAVE
       STX SAVE+1
       JMP TPO1

RESNOW LDA ADDR		;RESTORE CURRENT LINE ADDRESS
       STA NOWLN
       LDA ADDR+1
       STA NOWLN+1
       RTS

;SEE CURRENT LINE AT TOP (C SET IF SO)
ATTOP	LDA NOWLN
       CMP TEXT
       BNE ATO1
       LDA NOWLN+1
       CMP TEXT+1
       BNE ATO1
       SEC
       RTS

;SEE IF CURRENT LINE AT BOTTOM (C SET IF SO)
ATBOT  LDA NOWLN
       LDX NOWLN+1
       CMP BOTLN
       BNE ATO1
       CPX BOTLN+1
       BNE ATO1
ATO2   SEC
       RTS
ATO1   CLC
       RTS

;SEE IF WE RAN PAST END OF BUFFER LIMIT
ATEND  LDA BOTLN
       LDX BOTLN+1
       CPX END+1	; HIGH BYTE > OR = ?
       BCC ATO1
       BNE ATO2
       CMP END		;LOW BYTE > OR = ?
       BCC ATO1
       BCS ATO2

;SAVE CURRENT LINE (NOWLN) IN S1
NOWS1  LDA NOWLN

;; PAGE 0078

       LDX NOWLN+1
       JMP ADDS1A

;MOVE ADDR INTO S1
ADDRS1 LDA ADDR
       LDX ADDR+1
ADDS1A STA S1
       STX S1+1
       RTS

;SUBTRACT ONE FROM CURRENT LINE (NOWLN)
SUB    DEC NOWLN
       LDA NOWLN
       CMP #$FF
       BNE SUB1
       DEC NOWLN+1
SUB1   RTS

;ADD ACC TO CURRENT LINE (NOWLN)
AD1    LDA #1
ADDA   CLC
       ADC NOWLN
       STA NOWLN
       BCC ADDA1
       INC NOWLN+1
ADDA1  RTS

SAVNOW LDA NOWLN	;SAVE CURRENT LINE INTO ADDR
       STA ADDR
       LDA NOWLN+1
       STA ADDR+1
REP2   RTS

;; PAGE 0079

;MOVE CURRENT TEXT AROUND TO HAVE
;SPACE TO PUT IN THE NEW BUFFER
REPLAC LDY LENGTH
       CPY OLDLEN	;COMPARE OLD AND NEW LENGTHS
       BNE R2W		;BRANCH IF DIFF
       BEQ R87		;LENGTHS ARE EQUAL.  JUST REPLACE
R8     LDA #CR
       STA (NOWLN),Y
       JSR GOGO

;LENGTH = OLDLEN
R87    DEY
       CPY #$FF
       BEQ REP2
R88    LDA DIBUFF,Y
       STA (NOWLN),Y
       JSR GOGO
       DEY
       BPL R88
       RTS
R2W    BCS R100		;LENGTH > OLDLEN

;LENGTH < OLDLEN
       JSR SAVNOW	;PUT NOWLN INTO ADDR
       JSR ADDRS1	;PUT IT IN S1 ALSO
       LDA OLDLEN
       SEC
       SBC LENGTH    	;GET DIFFERENCE IN LENGTHS
       LDY LENGTH
       BNE RQP
       LDX COUNT	;C-COMM ?
       BNE RQP		;YES, JUMP
       ADC #0		;INCLUDE (CR)
RQP    PHA
       CLC
       ADC S1
       STA S1
       BCC R6
       INC S1+1
R6     LDA #<S1
       JSR LDAY
       STA (NOWLN),Y	;.... AND MOVE IT UP (DOWN IN ADDR)
       JSR GOGO
       TAX
       LDA S1
       CMP BOTLN 	;DOBE ??
       BNE R5
       LDA S1+1
       CMP BOTLN+1
       BEQ R7
R5     JSR AD1
       INC S1
       BNE R55
       INC S1+1
R55    JMP R6

;; PAGE 0080

R7     JSR RESNOW	;RESTORE NOWLN
       PLA		;RESTORE DIFFERENCE
       STA CPIY		;SAVE IT
       LDA BOTLN
       SEC
       SBC CPIY		;AND SUBTRACT IT FROM BOTTOM
       STA BOTLN
       BCS R9
       DEC BOTLN+1
R9     LDA COUNT	;C COMM OR K ,I COMM ?
       BNE R10
       LDY LENGTH
       BNE R11
R10    LDY LENGTH
       BNE R87
       RTS
R11    JMP R8

;LENGTH > OLDLEN
R100   LDA LENGTH	;NEW LINE IS LONGER
       SEC
       SBC OLDLEN
       LDY OLDLEN
       BNE R101		;ALREADY HAVE ROOM FOR CR
       ADC #0		;ADD ONE TO DIFFERENCE
R101   PHA
       JSR SAVNOW	;NOWLN ITNO S1
       JSR SETBOT
       LDY #0
R102   LDA (NOWLN),Y
       CMP #0
       BEQ R108
       JSR AD1
       JMP R102
R108   PLA
       PHA
       CLC
       ADC BOTLN	;ADD DIFFERENCE TO END
       STA BOTLN	;STORE NEW END
       BCC R103
       INC BOTLN+1
R103   JSR ATEND
       BCC R107
       LDA SAVE		;RESTORE OLD BOTTOM
       STA BOTLN
       LDA SAVE+1
       STA BOTLN+1
       JMP ENDERR	;RAN PAST BUFFER END
R107   JSR NOWS1	;SAVE CURRENT END
       PLA
       CLC
       ADC NOWLN
       STA NOWLN
       BCC R104
       INC NOWLN+1

;; PAGE 0081

R104   LDA #<S1
       JSR LDAY
       STA (NOWLN),Y
       JSR GOGO
       LDA S1
       CMP ADDR
       BNE R105
       LDA S1+1
       CMP ADDR+1	;BACK WHERE WE STARTED ??
       BEQ R106		;BRANCH IF DONE
R105   JSR SUB
       DEC S1
       LDA S1
       CMP #$FF
       BNE R1051
       DEC S1+1
R1051  JMP R104
R106   JSR RESNOW
       JMP R9

;SEE IF IT WROTE INTO MEMORY
GOGO   CMP (NOWLN),Y
       BEQ GOGO1
;MOVE ADDRESS
       LDA NOWLN
       STA ADDR
       LDA NOWLN+1
       STA ADDR+1
       JMP MEMERR
GOGO1  RTS		;OK
 
;; PAGE 0082

ENDERR JSR CLR		;CLEAR PNTR
       LDY #EMSG2-M1	;PRINT 'END'
       JSR KEP
       JSR DNNO		;BACK UP TO LAST LINE
       JSR TTYTST	;IF TTY (CR)
       BNE ENDE2
       JSR CRLOW
ENDE2  JMP ERRO
ERROR  JSR LL
       JSR QM
ERRO   JSR CLR
       LDX #$FF
COM = ERRO
       TXS
       JSR LL		;I/O TO TERMINAL (KB,D/P OR TTY)
       CLD
       JSR COMM
       JMP COM


; GET EDDITOR COMMANDS & DECODE
COMM   LDX #0
       JSR PATCH8	;READ A CHAR WITH '=( )'
ENTRY  LDX #COMCN1
CD02   CMP COMTBL,X	;COMPARE WITH ALL ALLOWABLE COMMANDS
       BEQ CFND1	;MATCH ,SO PROCESS COMMAND
       DEX
       BPL CD02
       JSR QM		;NOT IN LIST ,SO NOT LEGAL COMMAND
       JSR CRCK
       JMP ERRO
CFND1  JSR PATC15	;(CR) & START DECODING COMMAND
       LDA HTBL+1,X
       STA S1+1
       JMP (S1)

COMCN1 = 11
;COMMAND TABLE
COMTBL .BYT 'K RIUDLTBFQC'
HTBL   .WOR DLNE,PLNE,INPU,IN,DOWN,UP
       .WOR LST,TP,BT,FCHAR,STOP,CHNG
;READ FROM MEMORY FOR ASSEMBLER
MREAD  TYA
       PHA

;; PAGE 0083

       LDY #0
       LDA (NOWLN),Y
       STA CPIY
       JSR AD1
       PLA
       TAY
       LDA CPIY
       RTS

;; PAGE 0084

;THIS PROGRAM CONVERTS MNEMONIC INSTRUCTIONS INTO MACHINE
;CODE AND STORES IT ON THE DESIGNATED MEMORY AREA

;ROM TABLE LOCATIONS
TYPTR1 .BYT 00,02,00,08,$F2,$FF,$80,01
       .BYT $C0,$E2,$C0,$C0,$FF,00,00
TYPTR2 .BYT 08,00,$10,$80,$40,$C0,00,$C0
       .BYT $00,$40,00,00,$E4,$20,$80
CORR   .BYT 00,$FC,00,08,08,$F8,$FC,$F4
       .BYT $0C,$10,04,$F4,00,$20,$10
SIZEM  .BYT 00,00,$0F,01,01,01,$11,$11

;; PAGE 0085
       .BYT 02,02,$11,$11,02,$12,00
STCODE .BYT $00,$08,$10,$18,$20,$28,$30,$38
       .BYT $40,$48,$50,$58,$60,$68,$70,$78
       .BYT $80,$88,$90,$98,$AC,$A8,$B0,$B8
       .BYT $CC,$C8,$D0,$D8,$EC,$E8,$F0,$F8
       .BYT $0C,$2C,$4C,$4C,$8C,$AC,$CC,$EC
       .BYT $8A,$9A,$AA,$BA,$CA,$DA,$EA,$FA

;; PAGE 0086

       .BYT $0E,$2E,$4E,$6E,$8E,$AE,$CE,$EE
       .BYT $0D,$2D,$4D,$6D,$8D,$AD,$CD,$ED
TYPTB  .BYT 13,13,12,13,14,13,12,13
       .BYT 13,13,12,13,13,13,12,13
       .BYT 15,13,12,13,9,13,12,13
       .BYT 8,13,12,13,8,13,12,13
       .BYT 15,6,11,11,4,10,8,8

;; PAGE 0087

       .BYT 13,13,13,13,13,15,13,15
       .BYT 7,7,7,7,5,9,3,3
       .BYT 1,1,1,1,2,1,1,1

;PROGRAM STARTS HERE
MNEENT LDA SAVPC	;TRANSF PC TO ADDDR
       STA ADDR
       LDA SAVPC+1
       STA ADDR+1       
STARTM JSR CRCK		;(CR) IF PRI PTR DIFF FROM 0
       LDA #0
       STA CODFLG
       JSR BLANK
       JSR WRITAZ	;WRITE ADDRESS
       JSR BLANK2
       JSR BLANK2
       JMP MNEM		;JUMP TO INPUT MNEMONIC OPCODE
MODEM  LDA #00		;SET UP TO FORM MODE MATCH
       STA TMASK1
       STA TMASK2
       JSR BLANK
       LDY TYPE
       SEC
PNTLUP ROR TMASK1	;SHIFT POINTER TO INSTRUCTION TYPE
       ROR TMASK2
       DEY
       BNE PNTLUP

;TEST FRO ONE BYTE INSTRUCTION
       LDY TYPE

;; PAGE 0088

       CPY #$0D
       BNE RDADDR
       LDX #00
       JMP OPCOMP

;INPUT ADDRESS FIELD
RDADDR LDY #06		;CLEAR ADDRESS FIELD (NON HEX)
       LDA #'Q'
CLRLUP STA ADFLD-1,Y
       DEY
       BNE CLRLUP	;(LEAVES Y = 0 FOR NEXT PHASE)
       JSR RDRUB	;WITHOUT RUBOUT
       CMP #$20		;IGNORE SPACE CHARCATERS
       BEQ RDADDR
STORCH STA ADFLD,Y	;STROE ADDRESS CHARACTER
       INY
       CPY #07
       BCS TRY56
       JSR RDRUB	;READ REMAINDER OF ADDRESS CHARS
       CMP #$20		;THRU WHEN (SPACE) OR (CR)
       BNE STOR1
       INC CODFLG	;SET CODE FLG
       BNE EVAL
STOR1  CMP #$0D		;CHECK FOR (CR)
       BNE STORCH

;SEPARATE ADDRESSING MODE FROM ADDRESSING FIELD
EVAL   STY TEMPX		;TEMPX NOW HAS NUMBER OF CHAR
       LDA ADFLD	;CHECK FRIST CHAR FOR # OR (
       CMP #'#'
       BEQ HATCJ
       CMP #'('
       BEQ PAREN
       LDA TEMPX	;CHECK FOR ACCUMULATOR MODE
       CMP #01
       BNE TRYZP
ACCUM  LDX #01
       JMP OPCOMP
TRYZP  CMP #$02		;CHECK FOR ZERO PAGE MODE
       BNE TRY34
       LDA TYPE		;CHCK FOR BARANCH WITH RELATIVE ADDR
       CMP #$0C
       BNE ZPAGE
       LDX #02
       JMP OPCOMP
ZPAGE  LDX #05
       JMP OPCOMP
HATCJ  JMP HATCH
TRY34  LDA #04		;CHECK FOR ABSOLUTE OR ZP,X ORZP,
       CMP TEMPX
       BCC ABSIND
       LDX #02
       JSR XORYZ	;CC = X, CS = Y NE = ABSOLUTE
       BNE ABSOL
       BCC ZPX

;; PAGE 0089

ZPY    LDX #03		;CARRY SET SO ZP,Y MODE
       JMP OPCOMP
ZPX    LDX #04		;CARRY CLEAR SO ZP,X MODE
       JMP OPCOMP
TRY56  BCS ERRORM
ABSIND JSR XORY		;CC=ABS,X   CS=ABS,Y   NE=ERROR
       BNE ERRORM
       BCC ABSX
ABSY   LDA #09
       CMP TYPE
       BNE ABSY1
       LDX #$0E
       BNE OPCOMP
ABSY1  LDX #$08
       BNE OPCOMP
ABSX   LDX #$09		;CARRY CLEAR SO ABS,X MODE
       BNE OPCOMP
PAREN  LDA ADFLD+3	;SEE IF (HH,X),(HH)Y OR (HHHH)
       CMP #','		;(HHX) (HH),Y ARE OK TOO
       BEQ INDX		;COMMA IN 4TH POSITION = (HH,X)
       CMP #'X'		;X IN 4TH POSITION = (HHX)
       BNE TRYINY
INDX   LDX #$0B
       BNE OPCOMP
TRYINY CMP #')'		;')' IN 4TH POS = (HH)Y OR (HH),Y
       BNE TRYJMP
       JSR XORY		;CHCK TO SEE IF Y INDEX REG DESIRED
       BNE ERRORM
       BCC ERRORM
       LDX #$0A
       BNE OPCOMP
TRYJMP LDA ADFLD+5	;CHECK FOR FINAL PAREN
       CMP #')'
       BNE ERRORM
       LDA TYPE		;CONFIRM CORRECT ADDRESS TYPE
       CMP #$0B
       BNE ERRORM
       LDX #$0D		;OK, FORM IS JMP (HHHH)
       BNE OPCOMP
ABSOL  LDA TYPE		;CHECK FOR BRANCH TO ABSOLUTE LOC
       CMP #$0C
       BNE ABSOL1
       LDX #$02
       JMP OPCOMP
ABSOL1 LDX #$0C
       BNE OPCOMP
;SELECT IMMEDIATE ADDRESSING TYPE
HATCH  LDA TYPE
       CMP #01
       BEQ IMMED1
       LDX #07
       BNE OPCOMP
IMMED1 LDX #06
       BNE OPCOMP
ERRORM JSR CKERO0	;OUTPUT ERROR MESSAGE

; page 90-96   Dwight Elvey
        JMP STARTM

;COMPUTE FINAL OP CODE FOR DEFINED ADDRESSING MODE
OPCOMP  LDA TYPTR1,X   ;MATCH TYPE MASK VALID MODE
        BEQ OPCMP1     ;PATTERNS & SKIP 1ST WORD TEST IF
        AND TMASK1     ;ALREADY ZERO
        BNE VALID
OPCMP1  LDA TYPTR2,X   ;TEST 2ND PART
        AND TMASK2
        BEQ ERRORM     ;INST DOES NOT HAVE SPECIFIED MODE
VALID   CLC            ;FORM FINAL OP CODE
        LDA CORR,X
        ADC OPCODE
        STA OPCODE
;PROCESS ADDRESSES TO FINAL FORMAT
        LDA SIZEM,X    ;OBTAIN ADDRESS FORMAT FROM TABLE
        CMP #00
        BEQ ONEBYT
        CMP #$0F       ;NEED BRANCH COMPUTATION?
        BEQ BRNCHC
        STA TEMPA      ;SAVE START POINT & CHAR COUNT
        AND #$0F       ;SEPARATE CHARACTER COUNT
        TAY            ;LOAD ADDR BYTES INTO Y (0,1,OR 2)
        STA BYTESM     ;SAVE IN BYTES
        INC BYTESM     ;TO INSTR LENGHT (1,2,OR 3 BYTES)
        LDA TEMPA      ;SEPARATE STARTING POINT
        AND #$F0
        LSR A
        LSR A
        LSR A
        LSR A
        TAX            ;AND PUT IT IN X
        JSR CONVRT     ;CONVERT ASCII ADDRESS TO HEX
        BCS ERRORM     ;SKIP OUT IF ERROR IN INPUT
        BCC STASH
BRNCHC  JMP BRCOMP

;########### SUBROUTE ##########
;CONVERT FORMATTED ADDRESS INTO PROPER HEX ADDRESS
CONVRT  LDA ADFLD,X   ;PICK UP 1ST ADDRES CHARACTER
        JSR HEX       ;CONVERT TO MOST SIG HEX
        BCS ERRFLG
        INX           ;GET NEXT ASCII CHARACTER
        LDA ADFLD,X
        INX           ;POINT TO NEXT CHARACTER, IF ANY
        JSR PACK
        BCS ERRFLG
        STA OPCODE,Y  ;SAVE IN MOST SIG. BYT LOCATION
        DEY           ;SET UP FOR NEXT ADDR BYTE, IF ANY
        BNE CONVRT    ;IF NECESSARY, FORM NEXT ADDR BYTE
        CLC
ERRFLG  RTS           ;NON HEX CLEARED CARRY
;############
;PAGE 91
STASH   LDY BYTESM    ;SET UP TO STORE COMMAND
        DEY
STSHLP  LDA OPCODE,Y
        JSR SADDR     ;STORE ONE BYTE OFF COMMAND
        CPY #00
        BEQ FORMDS
        DEY
        CLV
        BVC STSHLP    ;REPEAT TILL THRU

ONEBYT  LDA #01       ;SET BYTES = 1
        STA BYTESM
        BNE STASH

;FORMAT FOR SYSTEM 65 DISPLAY (REFORMAT FOR AIM)
FORMDS  JSR CLR
        JSR CGPC1     ;ADDR TO SAVPC FOR DISASSEMBLY
        JSR TTYTST    ;IF TTY DO NOT GO TO DISASS
        BNE FORMD1
        JSR BLANK2
        JSR BLANK2
        BNE FORMD2    ;OUTPUT OPCODE
FORMD1  JSR DISASM
        JSR CRCK      ;<CR> IF PRI PTR DIFF FROM 0
        LDA CODFLG	;SEE IF HE WANTS CODE ALSO
        BEQ FORM1
        JSR BLANK
        JSR PRPC      ;PROG CNTR
;OUTPUT OPCODE
FORMD2  LDX BYTESM
        LDY #00
DISPLY  LDA #<ADDR    ;DO LDA (ADDR),Y ,WITHOUT PAG 0
        JSR LDAY
        JSR NUMA
        JSR BLANK
        INY
        DEX
        BNE DISPLY

;POINT TO NEXT INSTRUCTION LOCATION
FORM1   LDY BYTESM     ;ADD BYTESM TO ADDR
        JSR NXTADD
        JMP PATC16     ;UPDATE PC

;RELATIVE BRANCH ADDRESS COMPUTATION
BRCOMP  LDA TEMPX
        CMP #02       ;IF REL BRANCH INPUT, USE IT
        BNE COMPBR
        LDX #00
        LDY #01
        JSR CONVRT
        BCS ERRJMP
        LDA #02
        STA BYTESM     ;SET PROPER BYTES
        JMP STASH
;PAGE 92 DWIGHT ELVEY
COMPBR  LDX #00
        LDY #02
        JSR CONVRT
        BCS ERRJMP
        LDA ADDR+1     ;ADD BRANCH OFFSET
        STA MOVAD+1
        LDA ADDR
        CLC
        ADC #02
        STA MOVAD
        BCC CMPBR1
        INC MOVAD+1
CMPBR1  SEC            ;COMPUTE BRANCH RELATIVE ADDRESS
        LDA OPCODE+1
        SBC MOVAD
        STA OPCODE+1
        LDA OPCODE+2
        SBC MOVAD+1
        STA OPCODE+2
        CMP #00
        BEQ FORWRD
        CMP #$FF
        BEQ BACKWD
ERRJMP  JMP ERRORM
BACKWD  LDA OPCODE+1   ;CHECK IN RANGE
        BMI OK
        BPL ERRJMP
FORWRD  LDA OPCODE+1
        BPL OK
        BMI ERRJMP
OK      LDA #02        ;SET UP FOR STASH
        STA BYTESM
        JMP STASH

;######## SUBROUTINE ##########
;SUBROUTINE FOR DETERMINING X OR Y OR NEITHER
XORY    LDX #04
XORYZ   LDA ADFLD,X
        CMP #','
        BNE XORY1
        INX
        LDA ADFLD,X
XORY1   CMP #'X'
        BEQ ISX
        CMP #'Y'
XORYRT
        RTS ;NOT ZERO IS OT X OR Y
ISX     CLC            ;CARRY SET IS Y
        BCC XORYRT     ;CARRY CLEAR IS X
;######### RND OF SUB ########

;INPUT FOR MNEMONIC CODE
MNEM    LDY #00
        STY OPCODE
        STY OPCODE+1
; PAGE 93
        STY OPCODE+2   ;CLEARS OPCODE FOR NEW INPUT
        STY MOVAD      ;CLEARS UNUSED BIT IN FINAL FORMAT
RDLUP   JSR RDRUB
        CMP #'*'       ;COMMAND TO LOAD POINTER
        BEQ STLOAD     ;GO TO SET CURRENT ADDRESS POINTER
        CMP #$20       ;IGNORE SPACE BAR INPUT
        BEQ RDLUP
        AND #$1F       ;MASK OFF UPPER 3 BITS
        STA CH,Y
        TYA
        TAX            ;Y----> X
        INC CH,X       ;FORMAT TO MATCH DISASSEMBLER TBL
        INY
        CPY #03        ;REPEAT FOR EACH OF 3 CHARACTERS
        BNE RDLUP

;COMPRESS 3 FORMATTED CHARACTERS TO MOVAD & MOVAD+1
        LDY #03        ;SET UP OUTER LOOP
OUTLUP  LDA CH-1,Y     ;COMPRESS 3 CHARACTERS
        LDX #05        ;SET UP INNER LOOP
INLUP   LSR A          ;SHIFT 5 BITS ACCTO MOVAD,MOVAD+1
        ROR MOVAD
        ROR MOVAD+1
        DEX
        BNE INLUP
        DEY
        BNE OUTLUP

;SEARCH FOR MATCHIN COMPRESSED CODE
        LDX #$40
SRCHLP  LDA MOVAD
SRCHM   CMP MNEML-1,X  ;MATCH LEFT HALF
        BEQ MATCH
        DEX
        BNE SRCHM
        BEQ MATCH1
MATCH   LDA MOVAD+1
        CMP MNEMR-1,X
        BEQ GOTIT
        DEX
        BNE SRCHLP
MATCH1  JMP ERRORM

;GET INSTRUCTION TYPE FROM TYPE TABLE
GOTIT   LDA TYPTB-1,X
        STA TYPE

;GET OPCODE FROM OP CODE UE
        LDA STCODE-1,X
        STA OPCODE
        JMP MODEM

;THIS SECTION SETS THE CURRENT ADDRESS POINTER
STLO    LDA #'*
; PAGE 94
        JSR OUTPUT
STLOAD  JSR ADDIN      ;GET ADDR
        BCS STLO       ;IN CASE OF ERROR
        JMP PATC16     ;ADDR TO PC THEN TO STARTM


;PATCHES TO CORRECT PROBLEMS WITHOUT
;CHANGING ENTRY POINTS TO THE ROUTINES
        .BYT 'A'
PATCH1  SEC            ;ADJUST BAUD
        SBC #44
        STA CNTL30
        RTS

CUREAD  TXA            ;SAVE X  , OUTPUT CUR
        PHA
        LDX CURPO2
        CPX #20        ;ONLY IF < 20
        BCS PAT2A
        LDA #$DE
        JSR OUTDD1
PAT2A   PLA
        TAX
        JMP READ       ;CONTINUE

RED1    JSR READ       ;READ & ECHO WITHOUT CURSOR
        JMP RED2

PATCH4  LDX CURPO2     ;DONT DO ANYTHING IF '8D'
        CMP #$8D       ;S0 <CR> FOR TV & NOT FOR DISP
        BNE PAT4A
        LDA #$A0       ;CLR CURSOR
        JSR OUTDD1
        JSR CLR        ;CLR PNTRS
        JMP OUTD7      ;EXIT
PAT4A   JMP OUTD1A     ;CONTINUE

PATCH5  STA PRIFLG     ;TURN PRI OFF
        JMP IPO3

PATCH6  LDA #<ADDR     ;SIMULATE LDA (ADDR),Y
        JMP LDAY

PATCH8  JSR READ       ;READ & ECHO WITH CARROTS
        PHA
        JSR EQUAL
        LDA #'<
	JSR OUTPUT
        PLA
        PHA
        CMP #CR
        BEQ PATC8C
        JSR OUTPUT
PATC8C  LDA #'>
;PAGE 95
        JSR OUTPUT
        PLA
        RTS

PATCH9  CMP #$F7       ;CHCK LOWER TRANSITION OF TIMER
        BCS PAT9A
        CMP TSPEED
        JMP CKF3A
PAT9A   CMP TSPEED
        PLA
        CMP #$FF
PAT9B   RTS

PATC10  JSR CRLF       ;CLR DISP (ONLY 1<CR>)
        JMP STA1

PATC11  BEQ PAT9B      ;GO OUTPUT PROMPT
        CMP #'L        ;NO PROMPT FOR 'T' OR 'L'
        BEQ PAT9B
        JMP PROMP1

PATC12  PHA            ;CLEAR PRIFLG SO WE CAN OUTPUT
        LDA PRIFLG     ;TO PRINTER IF FLG WAS ON (MSB)
        AND #$F0
        STA PRIFLG
        PLA
        RTS

PATC13  LDA INFLG      ;TURN TAPES ON ONLY IF TAPES
        CMP #'T
        BNE PAT9B
        JMP DU14       ;TURN ON TAPES & SET DEF DEV

PATC14  LDA OUTFLG     ;TURN ON TAPES ONLY IF TAPES
        CMP #'T
        BNE PAT9B
        JMP DU11

PATC15  JSR CRLF       ;DECODE COMMAND
        TXA            ;SAVE INDEX
        ASL A
        TAX
        LDA HTBL,X     ;PART OF ENTRY
        STA S1
        RTS

PATC16  JSR CGPC1      ;ADDR TO PC
        JMP STARTM     ;BACK TO MNEMONIC START

PATC17  BEQ PAT17B     ;RUB ,SO READ ANOTHER
        CMP #0
        BEQ PAT17A
        JMP INO2A      ;NEITHER ,CONTINUE
PAT17A  JSR INALL      ;SKIP ON ZEROS
        CMP #$7F       ;UNTIL RUB
;PAGE 96
        BNE PAT17A
PAT17B  JMP INO2       ;GO BACK

PATC18  JSR PATC12     ;RESET PRIFLG
        PHA
        JSR TTYTST     ;IF TTY JUST RTN
        BNE PAT18A
        PLA
        RTS
PAT18A  JSR LL         ;SET TO LOW SPEED
        JSR IPST       ;PRINT WHAT IS IN BUFFER
        JSR CLR        ;CLR PRINTER BUFFER BY OUTPUTTING
        JSR BLANK      ;AN SPACE
        JSR CLR
        PLA            ;RTN ACC
        RTS

PAT19   CLD
        JSR CRCK
        JMP STA1

PAT20   BEQ VECK4      ;END (DATA BYTES=0)
        CLC
        ADC #4
        TAX
VECK5   JSR INALL      ;SKIP OVER DATA
        DEX
        BNE VECK5
        JMP VECK1      ;PROCESS NEXT RCD
VECK4   JMP DU13

PAT21   LDY #0
PAT12A  LDA POMSG,Y   ;RESET MSG
        BEQ PAT12B
        JSR OUTPUT
        INY
        BNE PAT12A
PAT12B  JSR CRLF
        JSR CRLF
        JMP START

POMSG   .BYT '  ROCKWELL AIM 65'
        .BYT 0

PAT22   INC BLKO
        JMP ADDBK1

PAT23   LDA #$FF       ;START TIMER
        STA DI1024
PAT23A  LDA RINT       ;TIME OUT?
        BMI PAT23B     ;YES
        LDA IFR        ;START SIGNAL?
        AND #MPRST
        BEQ PAT23A     ;NO
        RTS            ;YES

;; PAGE 97 Hans B Pufal

PAT23B LDA #0		;TIME OUT RETURN
       RTS

PATC24 JSR CKFREQ	;READ BIT FROM FOURTH HALF PULSE
       ROR A
       AND #$80
       RTS

PATC25 BIT IFR		;WAIT TILL TIMES OUT
       BVC PATC25
       LDA T1L		;CLR INTERRUPT FLG
       RTS

;        *=$FFF9
       .WOR 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
;INTERRUPT VECTORS
       .BYT $FA
       .WOR NMIV1,RSET,IRQV1	;SET UP VECTORS



       .END A0/1