; Reconstructed RCA Tiny BASIC, as explained.
;
; Sept 6 2016 Herb Johnson
; the following was TMSI Tiny BASIC as produced in 1982
; open-released by Lee Hart, around 2010.
; The TMSI source was slightly modified to assemble under A18.
;
; RCA manual CPD18S02 Evaluation Kit manual MPM-203 has
; a hex dump of RCA Tiny BASIC which is substantially the
; same binary as TMSI Tiny BASIC.
; 
; September 2016 - TMSI Tiny BASIC source was edited
; by Herb Johnson to assemble to the hex-dump code described above.
; There were not that many changes.
; 
	INCL "1802reg.asm"	;R0-RF defined HRJ

; AVOCET XASM18 MACRO-ASSEMBLER SYNONYMS
;
;	CALL ADDRESS	IS A SYNONYM FOR	SEP R4 (D4)
;						DW ADDR
;	EXIT		IS A SYNONYM FOR	SEP R5 (D5)
;	POP		IS A SYNONYM FOR	LDXA (72)
;	PUSH		IS A SYNONYM FOR	STXD (73)
;
; I had to change these pseudo-ops to actual code HRJ	

;------------------------------------------------------;
;						       ;
; TTTTT  I  N	N  Y   Y   BBBB    AAA	 SSSS  I  CCCC ;
;   T	   I  NN	N  Y   Y   B   B  A   A  S     I  C    ;
;   T	   I  N N   N   Y Y    BBBB   AAAAA  SSSS  I  C    ;
;   T	   I  N  N  N    Y     B   B  A   A     S  I  C    ;
;   T	   I  N	N    Y     BBBB   A   A  SSSS  I  CCCC ;
;						       ;
;------------------------------------------------------;
;
; TINY BASIC FOR THE COSMAC 1802 MICROCOMPUTER	 2/18/82
; WRITTEN BY TOM PITTMAN
; MODIFIED BY LEE A. HART
; COPYRIGHT 1982 BY TECHNICAL MICRO SYSTEMS, INC.
; ASSEMBLE WITH AVOCET XASM18 CROSS-ASSEMBLER
;
; REGISTER ASSIGNMENTS:
;
;	     0	; PC (VIA RESET) AT ENTRY
;	     1	;  ???
;	     2	; STACK POINTER
;	     3	; NORMAL PROGRAM COUNTER
;	     4	; MONITOR: RAM PAGE0 POINTER
;		  BASIC: SCRT "CALL" PC
;	     5	; MONITOR: MAIN PC
;		  BASIC: SCRT "RETURN" PC
;	     6	; BASIC: SCRT RETURN ADDR.
;	     7	; BASIC: PC FOR "FECH"
XX:	EQU  8	; MONITOR: ?M VS. !M SWITCH
;		  BASIC: WORK REGISTER
PC:	EQU  9	; IL PROGRAM COUNTER
AC:	EQU 10	; MONITOR: MEMORY POINTER
;		  BASIC: 16-BIT ACCUMULATOR
BP:	EQU 11	; BASIC POINTER
DELAY:	EQU 12	; PC FOR DELAY SUBROUTINE
HEXX:	EQU 13	; MONITOR: HEX ADDR. ACCUMULATOR
PZ:	EQU 13	; BASIC: PAGE 0 POINTER
BAUD:	EQU 14	; RE.0=BAUD RATE CONSTANT
;		  RE.1=USED FOR READ, TYPE
X:	EQU 15	; BASIC: SCRATCH REGISTER
ASCII:	EQU 15	; MONITOR: RF.1=ASCII I/O CHAR.
;			   RF.0=USED FOR READ, TYPE

;	
; EQUATES
;
LDI0:	EQU  97H	; GHI R7 - CLEAR ACCUM. MACRO	  
TYPA:	EQU  0D3H	; SEP R3 - TYPE CHAR. MACRO
FECH:	EQU  0D7H	; SEP R7 - PAGE 0 MACRO
;
; SCRATCHPAD MEMORY ALLOCATION - OFFSET ADDED TO PAGE ADDRESS
;
PAGE:	EQU  0800H	; WORKSPACE BEGINNING
KEYV:	EQU  PAGE+06H	; KEY-INPUT ROUTINE VECTOR
TYPEV:	EQU  PAGE+09H	; TYPE-OUTPUT ROUTINE VECTOR
BREAKV: EQU  PAGE+0CH	; BREAK-DETECTION ROUTINE VECTOR
;	EQU	 +0FH	; UNUSED	  
BS:	EQU	 +13H	; BACKSPACE CHARACTER
CAN:	EQU	 +14H	; CANCEL CHARACTER
PAD:	EQU	 +15H	; NUMBER OF PAD CHARACTERS
			; MSB=0 FOR NULL, =1 FOR DELETE 		       
;		 +16H	; TAPE MODE ENABLE (80H=ENABLE)
SPARE:	EQU	 +17H	; STACK RESERVE
XEQ:	EQU	 +18H	; EXECUTION MODE FLAG
LEND:	EQU	 +19H	; INPUT LINE BUFFER END
AEPTR:	EQU	 +1AH	; ARITHMETIC EXPRESSION STACK POINTER 
;			; AND INPUT LINE BUFFER
TTYCC:	EQU	 +1BH	; PRINT COLUMN, MSB=TAPE MODE FLAG
NXA:	EQU	 +1CH	; SAVED PC FOR "NXT"
AIL:	EQU	 +1EH	; START ADDRESS OF "IL"
BASIC:	EQU	 +20H	; START ADDRESS OF BASIC PROGRAM
STACK:	EQU	 +22H	; HIGHEST ADDRESS OF USER RAM
MEND:	EQU	 +24H	; END OF BASIC PROGRAM + STACK RESERVE
TOPS:	EQU	 +26H	; TOP OF GOSUB STACK
LINO:	EQU	 +28H	; CURRENT BASIC PROGRAM LINE NUMBER
WORK:	EQU	 +2AH	; MISC. TEMPORARY STORAGE (4 BYTES)
SP:	EQU	 +2EH	; SAVED POINTER
LINE:	EQU  PAGE+30H	; INPUT LINE BUFFER (BOTTOM; 80 BYTES)
AESTK:	EQU	 +80H	; ARITHMETIC EXECUTION STACK (TOP)
;		 +82H	; BASIC VARIABLE A
;		 +84H	; BASIC VARIABLE B
;		 ...	;	...
;		 +B4H	; BASIC VARIABLE Z
;	     PAGE+B6H	; INTERPRETER TEMPORARIES (18 BYTES)
SAVEREG: EQU PAGE+0B8H	; MONITOR: SAVED REGISTERS START
SAVEND: EQU	+0DFH	;	SAVED REGISTERS END
USER:	EQU PAGE+100H	; START OF USER'S BASIC PROGRAM        
;
; EXECUTION BEGINS AT 0000H, FOLLOWING A POWER-ON RESET.  

	ORG 0
	IDL
	BR 0B0H

	LBR  WARM	; WARM START
KEYBD: LBR  TTYRED	; JUMP TO KEY-INPUT ROUTINE
TYPED: LBR  TYPE	; JUMP TO KEY-OUTPUT ROUTINE
TBRK:	LBR  TSTBR	; JUMP TO BREAK-DETECTION ROUTINE
;
; EXIT TO MACHINE-LANGUAGE MONITOR	LBR  MONITOR
; CPU I/O BIT ACCESS (EF1-4, Q)	LBR  IOBIT
; I/O PORT ACCESS (IN1-7, OUT1-7)	LBR  IO
;
	DB   5FH	; "BACKSPACE" CHARACTER
	DB   18H	; "CANCEL" CHARACTER
			; (ANY BUT 0AH, ODH, FFH, 00H)
	DB   82H	; PAD CODE:	   
;	      ^-------------LSD=# OF PAD CHARS AFTER CR
;	     ^--------------MSD=8: PAD CHAR. IS NULL (00)
;			       =0: PAD CHAR. IS DELETE (FFH)
	DB   80H	; TAPE MODE
	DB   20H	; SPARE STACK

	DB   30h
	DB   22H
	DB   30H
	DB   20H
;
; MEMORY POKE SUBROUTINE
;
POKE:	STR  XX 	; STORE BYTE
	SEP R5 ;EXIT		;   RETURN
;
	DW   TBIL		; ADDRESS OF IL
CONST: DW  08C8H		; ENTRY TO MONITOR PGM?
	DB   0		; WRAP POINT
	DB   HIGH PAGE	; PAGE ADDR. HI BYTE
;
; MEMORY PEEK SUBROUTINE
;
	LDA  XX
	SKP

PEEK:	DB   LDI0	; SINGLE BYTE LOAD
	PHI  AC 	;   HI BYTE INTO ACCUM
	LDA  XX 	;   LO BYTE INTO D
	SEP R5 ;EXIT		;   RETURN
;
; I/O PORT ACCESS (IN1-7, OUT1-7)	

	LBR  IO

;---------------------------------------;
;	COMMONLY-USED SUBROUTINES	; 
;---------------------------------------;
;
; STANDARD CALL - USES R4 AS ITS PROGRAM COUNTER
;
	SEP  R3 	; < EXIT:
CALL:	PHI  X		; > ENTRY: SAVE D
	SEX  R2 	;   PUSH R6 ONTO STACK
	GLO  R6
	STXD
	GHI  R6
	STXD
	GLO  R3 	;   SAVE OLD R3 IN R6
	PLO  R6
	GHI  R3
	PHI  R6
	LDA  R6 	;   LOAD SUBROUTINE
	PHI  R3 	;     ADDRESS INTO R3
	LDA  R6
	PLO  R3
	GHI  X		;   RESTORE D
	BR   CALL-1	;   ...AND GO TO EXIT
;
; STANDARD RETURN - USES R5 AS ITS PROGRAM COUNTER
;
	SEP  R3 	; < EXIT:
RETRN:	PHI  X		; > ENTRY: SAVE D
	SEX  R2 	;   COPY R6 INTO R3
	GHI  R6
	PHI  R3
	GLO  R6
	PLO  R3
	INC  R2 	;   POP R6 FROM STACK
	LDA  R2
	PHI  R6
	LDN  R2
	PLO  R6
	GHI  X		;   RESTORE D
	BR   RETRN-1	;   ...AND GO TO EXIT
;
; BASE PAGE RAM FETCH - USES R7 AS ITS PROGRAM COUNTER 
;
	SEP  R3 	; < EXIT:
FETCH:	LDA  R3 	; > ENTRY: SET PZ POINTER
	PLO  PZ 	;     TO BASE PAGE
	LDI  HIGH PAGE	;     PLUS OFFSET (FROM CALLER)
	PHI  PZ
	LDA  PZ 	;   GET BYTE @ POINTER
	SEX  PZ 	;   INCREMENT PZ POINTER
	BR   FETCH-1	;   ...AND GO TO EXIT

;---------------------------------------;
;	OPCODE TABLE			;
;---------------------------------------;
TABLE:	DW  BACK
	DW  HOP
	DW  MATCH
	DW  TSTV
	DW  TSTN
	DW  TEND
	DW  RTN
	DW  HOOK
	DW  WARM
	DW  XINIT
	DW  CLEAR
	DW  INSRT
	DW  RETN
	DW  RETN
	DW  GETLN
	DW  RETN
	DW  RETN
	DW  STRNG
	DW  CRLF
	DW  TAB
	DW  PRS
	DW  PRN
	DW  LIST
	DW  RETN
	DW  NXT
	DW  CMPR
	DW  IDIV
	DW  IMUL
	DW  ISUB
	DW  IADD
	DW  INEG
	DW  XFER
	DW  RSTR
	DW  SAV
	DW  STORE
	DW  IND
	DW  RSBP
	DW  SVBP
	DW  RETN
	DW  RETN
	DW  BPOP
	DW  APOP
	DW  DUPS
	DW  LITN
	DW  LIT1
	DW  RETN
TBEND:	EQU $		; OPCODES BACKWARDS FROM HERE

; TB-MON.ASM					    PAGE  6


;-----------------------------------------------;
;	COLD & WARM START INITIALIZATION	;
;-----------------------------------------------;
;
; COLD START; ENTRY FOR "NEW?" = YES
;
COLD:	LDI  LOW $+3	; CHANGE PROGRAM COUNTER
	PLO  R3 	;   FROM R0 TO R3
	LDI  HIGH $
	PHI  R3
	SEP  R3
; DETERMINE SIZE OF USER RAM
	PHI  AC 	; GET LOW END ADDR.
	LDI  LOW CONST	;   OF USER PROGRAM
	PLO  AC 	;   RAM (AT "CONST")
	LDA  AC
	PHI  R2 	; ..AND PUT IN R2
	LDA  AC
	PLO  R2
	LDA  AC 	; SET PZ TO WRAP POINT
	PHI  PZ 	;   (END OF SEARCH)
	LDI  0
	PLO  PZ
	LDN  PZ 	; ..AND SAVE BYTE
	PHI  X		;   NOW AT ADDR. PZ
SCAN:	SEX  R2 	; REPEAT TO SEARCH RAM..
	INC  R2 	; - GET NEXT BYTE
	LDX
	PLO  X		; - SAVE A COPY
	XRI  0FFH	; - COMPLEMENT IT
	STR  R2 	; - STORE IT
	XOR		; - SEE IF IT WORKED
	SEX  PZ
	LSNZ		; - IF MATCHES, IS RAM
	GHI  X		;     SET CARRY IF AT
	XOR		;     WRAP POINT..
	ADI  0FFH	; - ELSE IS NOT RAM
	GLO  X		;     RESTORE ORIGINAL BYTE
	STR  R2
	BNF  SCAN	; - ..UNTIL END OR WRAP POINT
	DEC  R2
	LDN  AC 	; RAM SIZED: SET
	PHI  PZ 	;   POINTER PZ TO
	LDI  STACK+1	;   WORK AREA
	PLO  PZ
	GLO  R2 	; STORE RAM END ADDRESS
	STXD
	GHI  R2
	STXD		; GET & STORE RAM BEGINNIG
	DEC  AC 	; REPEAT TO COPY PARAMETERS..
	DEC  AC 	; - POINT TO NEXT

; TB-MON.ASM					    PAGE  7


	LDN  AC 	; - GET PARAMETER
	STXD		; - STORE IN WORK AREA
	GLO  PZ
	XRI  BS-1	; - TEST FOR LAST PARAMETER
	BNZ  $-6	; - ..UNTIL LAST COPIED
	SHR		; SET DF=0 FOR "CLEAR"
	LSKP
;
; WARM START: ENTRY FOR "NEW?" = NO
;
WARM:	SMI  0		; SET DF=1 FOR "DON'T CLEAR"
	LDI  $+3
	PLO  R3 	; BE SURE PROGRAM COUNTER IS R3
	LDI  HIGH $
	PHI  R3
	SEP  R3
	PHI  R4 	; INITIALIZE R4, R5, R7
	PHI  R5
	PHI  R7
	LDI  CALL
	PLO  R4
	LDI  RETRN
	PLO  R5
	LDI  FETCH
	PLO  R7
	BDF  PEND	; IF COLD START,
CLEAR:	DB   FECH,BASIC ; - MARK PROGRAM EMPTY
	PHI  BP
	LDA  PZ
	PLO  BP
	DB   LDI0	;   WITH LINE# = 0
	STR  BP
	INC  BP
	STR  BP
	DB   FECH,SPARE-1; - SET MEND = START + SPARE
	GLO  BP 	;   GET START
	ADD		;   ADD LOW BYTE OF SPARE
	PHI  X		;   SAVE TEMPORARILY
	DB   FECH,MEND	;   GET MEND
	GHI  X
	STXD		;   STORE LOW BYTE OF MEND
	GHI  BP
	ADCI 0		;   ADD CARRY
	STXD		;   STORE HIGH BYTE OF MEND
PEND:	DB   FECH,STACK ; SET STACK TO END OF MEMORY
	PHI  R2
	LDA  PZ
	PLO  R2
	DB   FECH,TOPS
	GLO  R2 	; SET TOPS TO EMPTY
	STXD		; (I.E. STACK END)

; TB-MON.ASM					    PAGE  8


	GHI  R2
	STXD
	SEP R4 ;CALL 
	DW FORCE	; SET TAPE MODE "OFF"
IIL:	DB   FECH,AIL	; SET IL PC
	PHI  PC
	LDA  PZ
	PLO  PC 	; CONTINUE INTO "NEXT"
;
; EXECUTE NEXT INTERMEDIATE LANGUAGE (IL) INSTRUCTION
;
NEXT:	SEX  R2 	; GET OPCODE
	LDA  PC
	SMI  30H	; IF JUMP OR BRANCH,
	BDF  TBR	;   GO HANDLE IT
	SDI  0D7H	; IF STACK BYTE EXCHANGE,
	BDF  XCHG	;   GO HANDLE IT
	SHL		; ELSE MULTIPLY BY 2
	ADI  TBEND	;   TO POINT INTO TABLE
	PLO  R6
	LDI  LOW NEXT	; & SET RETURN TO HERE
	DEC  R2 	; (DUMMY STACK ENTRY)
	DEC  R2
	STXD
	GHI  R3
	STXD
DOIT:	GHI  R7 	; TABLE PAGE
	PHI  R6
	LDA  R6 	; FETCH SERVICE ADDRESS
	STR  R2
	LDA  R6
	PLO  R6
	LDX
	PHI  R6
	SEP  R5 	; GO DO IT
;
TBR:	SMI  10H	; IF JUMP OR CALL,
	BNF  TJMP	;   GO DO IT
	PLO  R6 	; ELSE BRANCH; SAVE OPCODE
	ANI  1FH	;   COMPUTE DESTINATION
	BZ   TBERR	;   IF BRANCH ADDR = 0, GOTO ERROR
	STR  R2 	; PUSH ADDRESS ONTO STACK 
	GLO  PC 	; ADD RELATIVE OFFSET
	ADD		;   LOW BYTE
	STXD
	GHI  PC 	;   HIGH BYTE W. CARRY
	ADCI 0
	SKP
TBERR:	STXD		; STORE 0 FOR ERROR
	STXD
	GLO  R6 	; NOW COMPUTE SERVICE ADDRESS
	SHR		;   WHICH IS HIGH 3 BITS

; TB-MON.ASM					    PAGE  9


	SHR
	SHR
	SHR
	ANI  0FEH
	ADI  LOW TABLE	;   INDEX INTO TABLE
	PLO  R6
	BR   DOIT
;
TJMP:	ADI  8		; NOTE IF JUMP IN CARRY
	ANI  7		; GET ADDRESS
	PHI  R6
	LDA  PC
	PLO  R6
	BDF  JMP	; JUMP
	GLO  PC 	; PUSH PC
	STXD ;PUSH
	GHI  PC
	STXD ;PUSH
	SEP R4 ;CALL 
	DW STEST	; CHECK STACK DEPTH
;
JMP:	DB   FECH,AIL	; ADD JUMP ADDRESS TO IL BASE
	GLO  R6
	ADD
	PLO  PC
	GHI  R6
	DEC  PZ
	ADC
	PHI  PC
	BR   NEXT
;
XCHG:	SDI  7		; SAVE OFFSET
	STR  R2
	DB   FECH,AEPTR
	PLO  PZ
	SEX  R2
	ADD
	PLO  R6 	; R6 IS OTHER POINTER
	GHI  PZ
	PHI  R6
	LDN  PZ 	; NOW SWAP THEM:
	STR  R2 	;  SAVE OLD TOP
	LDN  R6 	; GET INNER BYTE
	STR  PZ 	;  PUT ON TOP
	LDN  R2 	; GET OLD TOP
	STR  R6 	;  PUT IN
	BR   NEXT
;
BACK:	GLO  R6 	; REMOVE OFFSET
	SMI  20H	;   FOR BACKWARDS HOP
	PLO  R6
	GHI  R6

; TB-MON.ASM					    PAGE 10


	SMBI 0
	SKP
;
HOP:	GHI  R6 	; FORWARD HOP
BZERR:	LBZ  ERR	; IF ZERO, GOTO ERROR
	PHI  PC 	; ELSE PUT INTO PC
	GLO  R6
	PLO  PC
	BR   NEXT
;
	INC  BP 	; ADVANCE TO NEXT NON-BLANK CHAR.
NONBL:	LDN  BP 	; GET CHARACTER
	SMI  20H	; IF BLANK,
	BZ   NONBL-1	;   INCREMENT POINTER AND TRY AGAIN
	SMI  10H	; IF NUMERIC (0-9),
	LSNF
	SDI  9		;   SET DF=1
NONBX:	LDN  BP 	;   GET CHARACTER
	SEP R5 ;EXIT		;   AND RETURN
;
STORE:	SEP R4 ;CALL 
	DW APOP		; GET VARIABLE
	LDA  PZ 	; GET POINTER
	PLO  PZ
	GHI  AC 	; STORE THE NUMBER
	STR  PZ
	INC  PZ
	GLO  AC
	STR  PZ
	BR   BPOP	; GO POP POINTER
;
	SEP R4 ;CALL 
	DW APOP		; POP 4 BYTES
APOP:	SEP R4 ;CALL 
	DW BPOP		; POP 2 BYTES
	PHI  AC 	;   FIRST BYTE TO AC.1
BPOP:	DB   FECH,AEPTR ; POP 1 BYTE
	DEC  PZ
	ADI  1		; INCREMENT
	STR  PZ
	PLO  PZ
	DEC  PZ
	LDA  PZ 	; LEAVE IT IN D
	PLO  AC 	;   AND AC.0
RETN:	SEP R5 ;EXIT
;
TEND:	SEP R4 ;CALL 
	DW NONBL	; GET NEXT CHARACTER
	XRI  0DH	; IF CARRIAGE RETURN,
	BZ   NEXT	;   THEN FALL THRU IN IL
	BR   HOP	;   ELSE TAKE BRANCH
;
TSTV:	SEP R4 ;CALL 
	DW NONBL	; GET NEXT CHARACTER
	SMI  41H	; IF LESS THAN 'A',
	BNF  HOP	;   THEN HOP

; TB-MON.ASM					    PAGE 11


	SMI  1AH	; IF GREATER THAN 'Z'
	BDF  HOP	;   THEN HOP
	INC  BP 	; ELSE IS LETTER A-Z
	GHI  X		;   GET SAVED COPY
	SHL		;   CONVERT TO VARIABLE'S ADDRESS
	SEP R4 ;CALL 
	DW BPUSH	;   AND PUSH ONTO STACK
	BR   NEXT
;
TSTN:	SEP R4 ;CALL 
	DW NONBL	; GET NEXT CHARACTER
	BNF  HOP	; IF NOT A DIGIT, HOP
	DB   LDI0	; ELSE COMPUTE NUMBER
	PHI  AC 	;   INITIALLY 0
	PLO  AC
	SEP R4 ;CALL 
	DW APUSH	;   PUSH ONTO STACK
NUMB:	LDA  BP 	; GET CHARACTER
	ANI  0FH	; CONVERT FROM ASCII TO NUMBER
	PLO  AC
	DB   LDI0
	PHI  AC
	LDI  10 	; ADD 10 TIMES THE..
	PLO  X
	SEX  PZ
NM10:	INC  PZ
	GLO  AC 	; ..PREVIOUS VALUE..
	ADD
	PLO  AC
	GHI  AC
	DEC  PZ 	; ..WHICH IS ON STACK.
	ADC
	PHI  AC
	DEC  X		; COUNT THE ITERATIONS
	GLO  X
	BNZ  NM10
	GHI  AC 	; SAVE NEW VALUE
	STR  PZ
	INC  PZ
	GLO  AC
	STXD
	SEP R4 ;CALL 
	DW NONBL	; IF ANY MORE DIGITS,
	LBDF NUMB	;   THEN DO IT AGAIN
NHOP:	LBR  NEXT	; UNTIL DONE
;
MATCH:	GHI  BP 	; SAVE PB IN CASE NO MATCH
	PHI  AC
	GLO  BP
	PLO  AC
MAL:	SEP R4 ;CALL 
	DW NONBL	; GET A BYTE (IN CAPS)
;
	INC  BP 	; COMPARE THEM
	STR  R2
	LDA  PC

; TB-MON.ASM					    PAGE 12


	XOR
	BZ   MAL	; STILL EQUAL
	XRI  80H	; END?
	BZ   NHOP	; YES
	GHI  AC 	; NO GOOD
	PHI  BP 	; PUT POINTER BACK
	GLO  AC
	PLO  BP
JHOP:	LBR  HOP	; THEN TAKE BRANCH
;
STEST:	DB   FECH,MEND	; POINT TO PROGRAM END
	GLO  R2 	; COMPARE TO STACK TOP
	SD
	DEC  PZ
	GHI  R2
	SDB
	BDF  ERR	; AHA; OVERFLOW
	SEP R5 ;EXIT		; ELSE EXIT
;
LIT1:	LDA  PC 	; ONE BYTE
	BR   BPUSH
LITN:	LDA  PC 	; TWO BYTES
	PHI  AC 	; FIRST IS HIGH BYTE,
	LDA  PC 	;   THEN LOW BYTE
	BR   APUSH+1	; PUSH RESULT ONTO STACK
;
HOOK:	SEP R4 ;CALL 
	DW HOOP		; GO DO IT, LEAVE EXIT HERE
	BR   APUSH+1	; PUSH RESULT ONTO STACK
;
DUPS:	SEP R4 ;CALL 
	DW APOP		; POP 2 BYTES INTO AC
	SEP R4 ;CALL 
	DW APUSH	; THEN PUSH TWICE
APUSH:	GLO  AC 	; PUSH 2 BYTES
	SEP R4 ;CALL 
	DW BPUSH
	GHI  AC
BPUSH:	STR  R2 	; PUSH ONE BYTE (IN D)
	DB   FECH,LEND	; CHECK FOR OVERFLOW
	SM		; COMPARE AEPTR TO LEND
	BDF  ERR	; OOPS!
	LDI  1
	SD
	STR  PZ 	
	PLO  PZ
	LDN  R2 	; GET SAVED BYTE
	STR  PZ 	; STORE INTO STACK
SEP5:	SEP R5 ;EXIT		; & RETURN
;
IND:	SEP R4 ;CALL 
	DW BPOP		; GET POINTER
	PLO  PZ
	LDA  PZ 	; GET VARIABLE
	PHI  AC
	LDA  PZ

; TB-MON.ASM					    PAGE 13


	BR   APUSH+1	; GO PUSH IT
;
QUOTE:	XRI  2FH	; TEST FOR QUOTE
	BZ   SEP5	; IF QUOTE, GO EXIT
	XRI  22H	;   ELSE RESTORE CHARACTER
	SEP R4 ;CALL 
	DW TYPER
PRS:	LDA  BP 	; GET NEXT BYTE
	XRI  0DH	; IF NOT CARRIAGE RETURN,
	BNZ  QUOTE	;   THEN CONTINUE
	DEC  PC 	;   ELSE CONTINUE INTO ERROR
;
ERR:	DB   FECH,XEQ	; ERROR:
	PHI  XX 	; SAVE XEQ FLAG
	SEP R4 ;CALL 
	DW FORCE	; TURN TAPE MODE OFF
	LDI  "!"	; PRINT "!" ON NEW LINE
	SEP R4 ;CALL 
	DW TYPER
	DB   FECH,AIL
	GLO  PC 	; CONVERT IL PC TO ERROR#
	SM		;   BY SUBTRACTING
	PLO  AC 	;   IL START FROM PC
	GHI  PC
	DEC  PZ 	; X MUST POINT TO
	SMB		;   PAGE0 REGISTER PZ=RD
	PHI  AC
	SEP R4 ;CALL 
	DW PRNA		; PRINT ERROR#
	GHI  XX 	; GET XEQ FLAG
	BZ   BELL	; IF XEQ SET,
	LDI  LOW ATMSG	; - THEN TYPE "AT"
	PLO  PC
	GHI  R3
	PHI  PC
	SEP R4 ;CALL 
	DW STRNG
	DB   FECH,LINO	; - GET LINE NUMBER
	PHI  AC 	; - AND PRINT IT, TOO
	LDA  PZ
	PLO  AC
	SEP R4 ;CALL 
	DW PRNA
BELL:	LDI  7		; RING THE BELL
	SEP R4 ;CALL 
	DW TYPEV
	SEP R4 ;CALL 
	DW CRLF		; PRINT <CR><LF>
FIN:	DB   FECH,TTYCC-1
	DB   LDI0	; TURN TAPE MODE OFF
	STR  PZ
EXIT:	DB   FECH,TOPS	; RESET STACK POINTER
	PHI  R2
	LDA  PZ
	PLO  R2
	LBR  IIL	; RESTART IL FROM BEGINNING
;
ATMSG:	DB   ' AT ',0A3H; ERROR MESSAGE TEMPLATE
;

; TB-MON.ASM					    PAGE 14


TSTR:	SEP R4 ;CALL 
	DW TYPER-2	; PRINT CHARACTER STRING
STRNG:	LDA  PC 	; GET NEXT CHARACTER OF STRING
	ADI  80H	; IF HI BIT=0,
	BNF  TSTR	;   THEN GO PRINT & CONTINUE
	BR   TYPER-2	;   PRINT LAST CHAR AND EXIT
;
FORCE:	DB   FECH,AEPTR-1
	LDI  AESTK	; CLEAR A.E.STACK
	STXD
	DB   LDI0	; SET "NOT EXECUTING"
	STXD		;   LEND=0 ZERO LINE LENGTH
	STXD		;   XEQ=0 NOT EXECUTING
	LSKP		; CONTINUE TO CRLF
;
CRLF:	DB   FECH,TTYCC ; GET COLUMN COUNT
	SHL		; IF IN TAPE MODE (MSB=1),
	BDF  SEP5	;   THEN JUST EXIT
	DB   FECH,PAD	; GET # OF PAD CHARS
	PLO  AC 	;   & SAVE IT
	LDI  0DH	; TYPE <CR>
PADS:	SEP R4 ;CALL 
	DW TYPEV
	DB   FECH,TTYCC-1; POINT PZ TO COLUMN COUNTER
	GLO  AC 	; GET # OF PADS TO GO
	SHL		;   MSB SELECTS NULL OR DELETE
	BZ   PLF	; UNTIL NO MORE PADS..
	DEC  AC 	;   DECREMENT # OF PADS TO GO
	DB   LDI0	;   PAD=NULL=0 IF MSB=0
	LSNF
	LDI  0FFH	;   PAD=DELETE=FFH IF MSB=1
	BR   PADS	;   ..REPEAT
;
PLF:	STXD		; SET COLUMN COUNTER TTYCC=0
	LDI  8AH	; TYPE <LF>
;
	SMI  80H	; FIX HI BIT
TYPER:	PHI  X		; SAVE CHAR
	DB   FECH,TTYCC ; CHECK OUTPUT MODE
	DEC  PZ
	ADI  81H	; INCREMENT COLUMN COUNTER TTYCC
	ADI  80H	;   WITHOUT DISTURBING MSB
	BNF  SEP5	; IF MSB=1, IN TAPE MODE, NOT PRINTING
	STR  PZ 	;   ELSE UPDATE COLUMN COUNTER
	GHI  X		;   GET CHAR
	LBR  TYPEV	;   AND GO TYPE IT
;
TAB:	DB   FECH,TTYCC ; GET COLUMN COUNT
	ANI  7		; LOW 3 BITS
	SDI  8		; SUBTRACT FROM 8 TO GET
	PLO  AC 	;   NUMBER OF SPACES TO NEXT TAB
TABS:	GLO  AC
	BZ   SKIP+1	; UNTIL 0..

; TB-MON.ASM					    PAGE 15


	LDI  ' '	;   PRINT A SPACE
	SEP R4 ;CALL 
	DW TYPER
	DEC  AC 	;   DECREMENT SPACES TO GO
	BR   TABS	;   ...REPEAT
;
PRNA:	SEP R4 ;CALL 
	DW APUSH	; NUMBER IN AC
PRN:	DB   FECH,AEPTR ; CHECK SIGN
	PLO  PZ
	SEP R4 ;CALL 
	DW DNEG		; IF NEGATIVE,
	BNF  PRP
	LDI  '-'	;   PRINT '-'
	SEP R4 ;CALL 
	DW TYPER
PRP:	DB   LDI0	; PUSH ZERO FLAG
	STXD		;   WHICH MARKS NUMBER END
	PHI  AC 	; PUSH 10 (=DIVISOR)
	LDI  10
	SEP R4 ;CALL 
	DW APUSH+1
	INC  PZ
PDVL:	SEP R4 ;CALL 
	DW PDIV		; DIVIDE BY 10
	GLO  AC 	; REMAINDER IS NEXT DIGIT
	SHR		; BUT DOUBLED; HALVE IT
	ORI  30H	; CONVERT TO ASCII
	STXD		; PUSH IT
	INC  PZ 	; IS QUOTIENT=0?
	LDA  PZ
	SEX  PZ
	OR
	DEC  PZ 	; RESTORE POINTER
	DEC  PZ
	BNZ  PDVL	; ..REPEAT
PRNL:	INC  R2 	; NOW, TO PRINT IT
	LDN  R2 	; GET CHAR
	LBZ  APOP-3	; UNTIL ZERO (END FLAG)..
	SEP R4 ;CALL 
	DW TYPER	;   PRINT IT
	BR   PRNL	;   ..REPEAT
;
RSBP:	DB   FECH,SP	; GET SP
	SKP
SVBP:	GHI  BP 	; GET BP
	XRI  HIGH LINE	; IN THE LINE?
	BNZ  SWAP	; NO, NOT IN SAME PAGE
	GLO  BP
	STR  R2
	LDX
	SMI  LOW AESTK
	BDF  SWAP	; NO, BEYOND ITS END
	DB   FECH,SP
	GLO  BP 	; YES, JUST COPY BP TO SP
	STXD
	GHI  BP
	STR  PZ

; TB-MON.ASM					    PAGE 16


TYX:	SEP R5 ;EXIT
;
SWAP:	DB   FECH,SP	; EXCHANGE BP AND SP
	PHI  XX 	; PUT SP IN TEMP
	LDN  PZ
	PLO  XX
	GLO  BP 	; STORE BP IN SP
	STXD
	GHI  BP
	STR  PZ
	GHI  XX 	; STORE TEMP IN BP
	PHI  BP
	GLO  XX
	PLO  BP
	SEP R5 ;EXIT
;
CMPR:	SEP R4 ;CALL 
	DW APOP	; GET FIRST NUMBER
	GHI  AC 	; PUSH ONTO STACK WITH BIAS
	XRI  80H	;   (FOR 2'S COMPLEMENT)
	STXD		;   (BACKWARDS)
	GLO  AC
	STXD
	SEP R4 ;CALL 
	DW BPOP		; GET AND SAVE
	PLO  X		;   COMPARE BITS
	SEP R4 ;CALL 
	DW APOP		; GET SECOND NUMBER
	INC  R2
	GLO  AC 	; COMARE THEM
	SM		;   LOW BYTE
	PLO  AC
	INC  R2
	GHI  AC 	;   HIGH BYTE
	XRI  80H	; BIAS: 0 TO 65535 INSTEAD
	SMB		;   OF -32768 TO +32767
	STR  R2
	BNF  CLT	; LESS IF NO CARRY OUT
	GLO  AC
	OR
	BZ   CEQ	; EQUAL IF BOTH BYTES 0
	GLO  X		; ELSE GREATER
	SHR		; MOVE PROPER BIT
	SKP
CEQ:	GLO  X		; (BIT 1)
	SHR
	SKP
CLT:	GLO  X		; (BIT 0)
	SHR		; TO CARRY
	LSNF
	NOP
SKIP:	INC  PC 	; SKIP ONE BYTE IF TRUE
	SEP R5 ;EXIT
;

; TB-MON.ASM					    PAGE 17


ISUB:	SEP R4 ;CALL 
	DW INEG		; SUBTRACT IS ADD NEGATIVE
IADD:	SEP R4 ;CALL 
	DW APOP		; PUT ADDEND IN AC
	SEX  PZ
	INC  PZ 	; ADD TO AUGEND
	GLO  AC
	ADD
	STXD
	GHI  AC 	; CARRY INTO HIGH BYTE
	ADC
	STR  PZ
	SEP R5 ;EXIT
;
IMUL:	SEP R4 ;CALL 
	DW APOP		; MULTIPLIER IN AC
	LDI  10H	; BIT COUNTER IN X
	PLO  X
	LDA  PZ 	; MULTIPLICAND IN XX
	PHI  XX
	LDN  PZ
	PLO  XX
MULL:	LDN  PZ 	; SHIFT PRODUCT LEFT
	SHL		;   (ON STACK)
	STR  PZ
	DEC  PZ
	LDN  PZ
	SHLC		; DISCARD HIGH 16 BITS
	STR  PZ
	SEP R4 ;CALL 
	DW SHAL		; GET A BIT
	BNF  MULC	; NOT THIS TIME
	SEX PZ		; IF MULTIPLIER BIT=1,
	INC  PZ
	GLO  XX 	; ADD MULTIPLICAND
	ADD
	STXD
	GHI  XX
	ADC
	STR  PZ
MULC:	DEC  X		; REPEAT 16 TIMES
	GLO  X
	INC  PZ
	BNZ  MULL
	SEP R5 ;EXIT
;
IDIV:	SEP R4 ;CALL 
	DW APOP		; GET DIVISOR
	GHI  AC
	STR  R2 	; CHECK FOR DIVIDE BY ZERO
	GLO  AC
	OR
	LBZ  ERR	; IF YES, FORGET IT
	LDN  PZ 	; COMPARE SIGN OF DIVISOR
	XOR
	STXD		; SAVE FOR LATER

; TB-MON.ASM					    PAGE 18


	SEP R4 ;CALL 
	DW DNEG		; MAKE DIVEDEND POSITIVE
	DEC  PZ 	; SAME FOR DIVISOR
	DEC  PZ
	SEP R4 ;CALL 
	DW DNEG
	INC  PZ
	DB   LDI0
	LSKP
PDIV:	DB   LDI0	; MARK "NO SIGN CHANGE"    
	STXD		;   FOR PRN ENTRY
	PLO  AC 	; CLEAR HIGH END
	PHI  AC 	;   OF DIVIDEND IN AC
	LDI  17 	; COUNTER TO X
	PLO  X
DIVL:	SEX  PZ 	; DO TRIAL SUBTRACT
	GLO  AC
	SM
	STR  R2 	; HOLD LOW BYTE FOR NOW
	DEC  PZ
	GHI  AC
	SMB
	BNF  $+5	; IF NEGATIVE, CANCEL  IT
	PHI  AC 	; IF POSITIVE, MAKE IT REAL
	LDN  R2
	PLO  AC
	INC  PZ 	; SHIFT EVERYTHING LEFT
	INC  PZ
	INC  PZ
	LDX
	SHLC
	STXD
	LDX
	SHLC
	STXD
	GLO  AC 	; HIGH 16
	SHLC
	SEP R4 ;CALL 
	DW SHCL
	DEC  X		; DO IT 16 TIMES MORE
	GLO  X
	LBNZ DIVL
	INC  R2 	; CHECK SIGN OF QUOTIENT
	LDN  R2
	SHL
	BNF  NEGX	; POSITIVE IS DONE
INEG:	DB   FECH,AEPTR ; POINT TO STACK
	PLO  PZ
	BR   NEG
DNEG:	SEX  PZ
	LDX		; FOR DIVIDE,
	SHL		;   TEST SIGN
	BNF  NEGX	; IF POSITIVE, LEAVE IT ALONE
NEG:	INC  PZ 	; IF NEGATIVE,

; TB-MON.ASM					    PAGE 19


	DB   LDI0	;   SUBTRACT IT FROM 0
	SM
	STXD
	DB   LDI0
	SMB
	STR  PZ
	SMI  0		;   AND SET CARRY=1
NEGX:	SEP R5 ;EXIT
;
SHAL:	GLO  AC 	; USED BY MULTIPLY
	SHL
SHCL:	PLO  AC 	;   AND DIVIDE
	GHI  AC
	SHLC
	PHI  AC
	SEP R5 ;EXIT
;
NXT:	DB   FECH,XEQ	; IF DIRECT EXECUTION,
	LBZ  FIN	;   QUIT WITH DF=0
	LDA  BP 	; ELSE SCAN TO NEXT <CR>
	XRI  0DH
	BNZ  $-3
	SEP R4 ;CALL 
	DW GLINO	; GET LINE NUMBER
	BZ   BERR	;   ZERO IS ERROR
CONT:	SEP R4 ;CALL 
	DW TBRK		; TEST FOR BREAK
	BDF  BREAK	; IF BREAK,
	DB   FECH,NXA	;   RECOVER RESTART POINT
	PHI  PC 	;   WHICH WAS SAVED BY INIT
	LDA  PZ
	PLO  PC
RUN:	DB   FECH,XEQ-1 ;   TURN OFF RUN MODE
	STR  PZ 	;   (NON-ZERO)
	SEP R5 ;EXIT
	;
BREAK:	DB   FECH,AIL	; SET BREAK ADDR=0
	PHI  PC 	;   I.E. PC=IL START
	LDA  PZ
	PLO  PC
BERR:	LBR  ERR
;
XINIT:	DB   FECH,BASIC ; POINT TO START OF BASIC PROGRAM
	PHI  BP
	LDA  PZ
	PLO  BP
	SEP R4 ;CALL 
	DW GLINO	; GET LINE NUMBER
	BZ   BERR	; IF 0, IS ERROR (NO PROGRAM)
	DB   FECH,NXA	; SAVE STATEMENT
	GLO  PC 	;   ANALYZER ADDRESS
	STXD
	GHI  PC
	STR  PZ

; TB-MON.ASM					    PAGE 20


	BR   RUN	; GO START UP
;
XFER:	SEP R4 ;CALL 
	DW FIND		; GET THE LINE
	BZ   CONT	; IF WE GOT IT, GO CONTINUE
GOAL:	DB   FECH,LINO	;   ELSE FAILED
	GLO  AC 	;   MARK DESTINATION
	STXD
	GHI  AC
	STR  PZ
	BR   BERR	;   GO HANDLE ERROR
;
RSTR:	SEP R4 ;CALL 
	DW TTOP		; CHECK FOR UNDERFLOW
	LDA  R2 	; GET THE NUMBER
	PHI  AC 	;   FROM STACK INTO AC
	LDN  R2
	PLO  AC
	DB   FECH,TOPS
	GLO  R2 	; RESET TOPS FROM R2
	STXD
	GHI  R2
	STXD
	SEP R4 ;CALL 
	DW FIND+3	; POINT TO THIS LINE
	BNZ  GOAL	; NOT THERE ANY MORE
	BR   BNEXT	; OK
;
RTN:	SEP R4 ;CALL 
	DW TTOP		; CHECK FOR UNDERFLOW
	LDA  R2 	; (2 ALREADY INCLUDED)
	PHI  PC 	; PIP ADDRESS TO PC
	LDN  R2
	PLO  PC
BNEXT:	LBR  NEXT
;
TTOP:	DB   FECH,STACK ; GET TOP OF STACK
	INC  R2
	INC  R2
	GLO  R2 	; MATCH TO STACK POINTER
	ADI  2		; (ADJUSTED FOR RETURN)
	XOR
	DEC  PZ
	BNZ  TTOK	; NOT EQUAL
	GHI  R2
	ADCI 0
	XOR
	BZ   BERR	; MATCH IS EMPTY STACK
;
TTOK:	INC  R2 	; (ONCE HERE SAVES TWICE)
	SEP R5 ;EXIT
;
TAPE:	DB   FECH,PAD+1 ; TURN OFF TYPEOUT
	SKP
NTAPE:	DB   LDI0	; TURN ON TYPEOUT

; TB-MON.ASM					    PAGE 21


	SHL		; (FLAG TO CARRY)
	DB   FECH,TTYCC-1
	DB   LDI0
	SHRC		; 00 OR 80H
	STR  PZ
	BR   KLOOP

GETLN:	LDI  LOW LINE	; POINT TO LINE
	PLO  BP
	SEP R4 ;CALL 
	DW APUSH	; MARK STACK LIMIT
	GHI  PZ
	PHI  BP
KLOOP:	SEP R4 ;CALL 
	DW KEYV		; GET AN ECHOED BYTE
	ANI  7FH	; SET HIGH BIT TO 0
	BZ   KLOOP	; IGNORE NULL
	STR  R2
	XRI  7FH
	BZ   KLOOP	; IGNORE DELETE
	XRI  75H	; IF <LF>,
	BZ   TAPE	;   THEN TURN TAPE MODE ON
	XRI  19H	; IF <XOFF> (DC3=13H),
	BZ   NTAPE	;   THEN TURN TAPE MODE OFF
	DB   FECH,CAN-1
	LDN  R2
	XOR		; IF CANCEL,
	BZ   CANCL	;   THEN GO TO CANCEL
	DEC  PZ
	LDN  R2
	XOR
	BNZ  STOK	; NO
	DEC  BP 	; YES
	GLO  BP
	SMI  LOW LINE	; ANYTHING LEFT?
	BDF  KLOOP	; YES
CANCL:	LDI  LOW LINE	; IF NO, CANCEL THIS LINE
	PLO  BP
	LDI  0DH	; BY FORCING A <CR>
	SKP
STOK:	LDN  R2 	; STORE CHARACTER IN LINE
	STR  BP
	DB   FECH,AEPTR-1
	GLO  BP 	; CHECK FOR OVERFLOW
	SM
	BNF  CHIN	; OK
	LDI  7		; IF NOT, RING BELL
	SEP R4 ;CALL 
	DW TYPER
	LDN  BP 	; NOW LOOK AT CHAR
	SKP
CHIN:	LDA  BP 	; INCREMENT POINTER
	XRI  0DH	; IF NOT <CR>,
	BNZ  KLOOP	;   THEN GET ANOTHER

; TB-MON.ASM					    PAGE 22


	SEP R4 ;CALL 
	DW CRLF		;   ELSE ECHO <LF>
	DB   FECH,LEND-1;   AND MARK END
	GLO  BP
	STR  PZ
	LDI  LOW LINE	;   RESET BP TO FRONT
	PLO  BP
	LBR  APOP	;   AND GO POP DUMMY
;
FIND:	SEP R4 ;CALL 
	DW APOP		; GET LINE NUMBER
	GLO  AC
	STR  R2 	; CHECK FOR ZERO
	GHI  AC
	OR
	LBZ  ERR	; IF 0, GO TO ERROR
FINDX:	DB   FECH,BASIC ; START AT FRONT
	PHI  BP
	LDA  PZ
	PLO  BP
FLINE:	SEP R4 ;CALL 
	DW GLINO	; GET LINE NUMBER
	LSNZ		; NOT THER IF 0
	GLO  PZ 	; SET NON-ZERO,
FEND:	SEP R5 ;EXIT	;   AND RETURN
	SEX  PZ
	GLO  AC 	; COMPARE THEM
	SD
	STR  R2 	; (SAVE LOW BYTE OF DIFFERENCE)
	GHI  AC
	DEC  PZ
	SDB
	SEX  R2
	OR		; (D=0 IF EQUAL)
	BDF  FEND	; LESS OR EQUAL IS END
	LDA  BP 	; NOT THERE YET
	XRI  0DH	; SCAN TO NEXT <CR>
	BNZ  $-3
	BR   FLINE
;
HOOP:	SEP R4 ;CALL 
	DW HOOP+3	; ADJUST STACK
	SEP R4 ;CALL 
	DW APOP		; SET UP PARAMETERS:
	LDA  PZ 	;   AC
	PHI  XX 	;   MIDDLE ARGUMENT TO XX
	LDA  PZ
	PLO  XX
	LDA  PZ 	; SUBROUTINE ADDRESS BECOMES
	PHI  R6 	;   "RETURN ADDRESS"
	LDA  PZ
	PLO  R6
	GLO  PZ 	; FIX STACK POINTER
	STR  R2
	DB   FECH,AEPTR-1
	LDN  R2 	; BY PUTTING CURRENT VALUE

; TB-MON.ASM					    PAGE 23


	STR  PZ 	;   VALUE BACK INTO IT
	PLO  PZ 	; LEAVE PZ AT STACK TOP
	GLO  AC 	; LEAVE AC.0 IN D
	SEP R5 ;EXIT	; GO DO IT
;
LIST:	DB   FECH,WORK+2
	GLO  BP 	; SAVE POINTERS
	STXD
	GHI  BP
	STR  PZ
	SEP R4 ;CALL 
	DW FIND		; GET LIST LIMITS
	DB   FECH,WORK	; SAVE UPPER
	GLO  BP
	STXD
	GHI  BP
	STXD
	SEP R4 ;CALL 
	DW FIND		; TWO ITEMS MARK BOUNDS
	DEC  BP 	; BACK UP OVER LINE#
	DEC  BP
LLINE:	DB   FECH,WORK	; END?
	GLO  BP
	SM
	DEC  PZ
	GHI  BP
	SMB
	BDF  LIX	; SO IF BP>BOUNDS,
	LDA  BP 	;   GET LINE#
	PHI  AC
	LDA  BP
	PLO  AC
	BNZ  $+5
	GHI  AC
	BZ   LIX	; QUIT IF ZERO (PROGRAM END)
	SEP R4 ;CALL 
	DW PRNA		; ELSE PRINT LINE#
	LDI  2DH	;   THEN A SPACE
LLOOP:	XRI  0DH	;   (RESTORE BITS FROM <CR> TEST)
	SEP R4 ;CALL 
	DW TYPER
	SEP R4 ;CALL 
	DW TBRK		;   TEST FOR BREAK
	BDF  LIX	;     IF YES, THEN QUIT
	LDA  BP 	;   NOW PRINT TEXT
	XRI  0DH	;     UNTIL <CR>
	BNZ  LLOOP
	SEP R4 ;CALL 
	DW CRLF		;   END LINE WITH <CR><LF>
	BR   LLINE	; ..REPEAT UNTIL DONE
;
LIX:	DB   FECH,WORK+2; RESTORE BP
	PHI  BP
	LDA  PZ
	PLO  BP
	SEP R5 ;EXIT
;

; TB-MON.ASM					    PAGE 24


SAV:	DB   FECH,TOPS	; ADJUST STACK TOP
	GLO  R2
	STXD
	GHI  R2
	STR  PZ
	DB   FECH,XEQ	; IF NOT EXECUTING,
	DEC  PZ
	LSZ		;   USE ZERO INSTEAD
	DB   FECH,LINO
	PLO  AC 	; HOLD HIGH BYTE
	LDA  PZ 	; GET LOW BYTE
	INC  R2
	INC  R2
	SEX  R2
	STXD		; PUSH ONTO STACK
	GLO  AC 	; NOW THE HIGH BYTE
	STXD
	LBR  NEXT
;
GLINO:	DB   FECH,LINO-1; SETUP POINTER
	LDA  BP 	; GET 1ST BYTE
	STR  PZ 	; STORE IN RAM
	INC  PZ
	LDA  BP 	; 2ND BYTE
	STXD
	OR		; D=0 IF LINE#=0
	INC  PZ
	SEP R5 ;EXIT
;
INSRT:	SEP R4 ;CALL 
	DW SWAP		; SAVE POINTER IN NEW LINE
	SEP R4 ;CALL 
	DW FIND		; FIND INSERT POINT
	ADI  0FFH	; IF DONE, SET DF
	DB   LDI0
	PLO  X		; X IS SIZE DIFFERENCE
	BDF  NEW
	GHI  BP 	; SAVE INSERT POINT
	PHI  PZ
	GLO  BP
	PLO  PZ
	DEC  X		; MEASURE OLD LINE LENGTH
	DEC  X		; -3 FOR LINE# AND <CR>
	DEC  X		; REPEAT..
	LDA  PZ 	;   -1 FOR EACH BYTE OF TEXT
	XRI  0DH	; ..UNTIL <CR>
	BNZ  $-4
NEW:	DEC  BP 	; BACK OVER LINE#
	DEC  BP
	SEP R4 ;CALL 
	DW SWAP		; TRADE LINE POINTERS
	DB   FECH,LINO
	LDN  BP
	XRI  0DH	; IF NEW LINE IS NULL,

; TB-MON.ASM					    PAGE 25


	STXD
	STR  PZ
	BZ   HMUCH	;   THEN GO MARK IT
	GHI  AC 	; ELSE SAVE LINE NUMBER
	STR  PZ
	INC  PZ
	GLO  AC
	STR  PZ
	GHI  BP 	; MEASURE ITS LENGTH
	PHI  AC
	GLO  BP
	PLO  AC
	INC  X		;   LINE#
	INC  X		;   ENDING <CR>
	INC  X
	LDA  AC
	XRI  0DH	;   AND ALL CHARS UNTIL FINAL <CR>
	BNZ  $-4
HMUCH:	DB   FECH,SP	; FIGURE AMOUNT OF MOVE
	PHI  AC
	LDA  PZ
	PLO  AC
	DB   FECH,MEND	; =DISTANCE FROM INSERT
	GLO  AC 	;   TO END OF PROGRAM
	SM
	PLO  AC 	; LEAVE IT IN AC, NEGATIVE
	DEC  PZ
	GHI  AC
	SMB
	PHI  AC
	INC  PZ
	GLO  X		; NOW COMPUTE NEW MEND,
	ADD		;   WHICH IS SUM OF OFFSET,
	PHI  X
	GLO  X
	ANI  80H	;   WITH SIGN EXTEND,
	LSZ
	LDI  0FFH
	DEC  PZ
	ADC		;   PLUS OLD MEND
	SEX  R2
	STXD		;   PUSH ONTO STACK
	PHI  XX
	GHI  X
	STXD		;     (BACKWARDS)
	STR  R2 	; CHECK FOR OVERFLOW
	GLO  R2
	SD
	GHI  XX
	STR  R2
	GHI  R2

; TB-MON.ASM					    PAGE 26


	SDB
	LBDF ERR-1	; IF YES, THEN QUIT
	GLO  X		; ELSE NO, PREPARE TO MOVE
	BZ   STUFF	; NO MOVE NEEDED
	STR  R2
	SHL
	BNF  MORE	; ADD SOME SPACE
	DB   FECH,SP	; DELETE SOME
	PHI  X		; X IS DESTINATION
	LDA  PZ
	PLO  X
	SEX  R2
	SM
	PLO  XX 	; XX IS SOURCE
	GHI  X
	ADCI 0
	PHI  XX
	LDA  XX 	; NOW MOVE IT
	STR  X
	INC  X
	INC  AC
	GHI  AC
	BNZ  $-5
	BR   STUFF
MORE:	GHI  X		; SET UP POINTERS
	PLO  X		; X IS DESTINATION
	GHI  XX
	PHI  X
	DB   FECH,MEND
	PHI  XX
	LDA  PZ
	PLO  XX 	; XX IS SOURCE
	DEC  AC
	SEX  X		; NOW MOVE IT
	LDN  XX
	DEC  XX
	STXD
	INC  AC
	GHI  AC
	BNZ  $-5
STUFF:	DB   FECH,MEND	; UPDATE MEND
	INC  R2
	LDA  R2
	STXD
	LDN  R2
	STR  PZ
	DB   FECH,SP	; POINT INTO PROGRAM
	PHI  AC
	LDA  PZ
	PLO  AC
	DB   FECH,LINO	; INSERT NEW LINE

; TB-MON.ASM					    PAGE 27


	PLO  X
	OR		; IF THERE IS ONE
	BZ   INSX	;   NO, EXIT
	GLO  X		; ELSE INSERT LINE NUMBER
	STR  AC
	INC  AC
	LDA  PZ
	STR  AC
	INC  AC
	LDA  BP 	; NOW REST OF LINE
	STR  AC
	XRI  0DH	;   TO <CR>
	BNZ  $-5
INSX:	LBR  EXIT
;
; I/O PORT DRIVER: CALL VIA USR(38,N,B)
;	N=1 TO 7: OUT1-7 & OUTPUT B
;	N=9 TO 15: IN1-7 RESPECTIVELY
;
IO:	STXD		; PUSH OUT BYTE
	STR  R2
	DB   LDI0	; CLEAR AC
	PHI  AC
	DEC  PZ
	LDA  R3 	; STORE RETURN IN RAM
	SEP  R5 	; (THIS IS NOT EXECUTED)
	STR  PZ
	DEC  PZ
	GLO  XX 	; MAKE IO INSTRUCTION
	ANI  0FH
	ORI  60H
	STR  PZ
	ANI  8
	LSZ
	NOP		; INPUT, SO
	INC  R2 	;   DO INCREMENT NOW
	SEP  PZ 	; GO EXECUTE, RESULT IN D
;
; TEST FOR BREAK (TO ABORT LONG LISTINGS)
;
TSTBR:	ADI  0		; SET DF=0
	B4   $+6	; IF BREAK (EF4=0, SO EF4 PIN HIGH),
	SMI  0		;   THEN SET DF=1
	BN4  $		;   WAIT FOR EF4 PIN TO RETURN LOW
	SEP R5 ;EXIT		; EXIT
;
; MONITOR, should be 066FH- RCA disassembled code HRJ

TTYRED: SEP R7	;monitor
	INC R1		 
	GLO RD
	STXD			 
	LBR 8440H	 

TYPE:	SEP R7	
	INC R2
	BZ  TT  
	SEP RC		
	INC R7
	DEC RD
	STR RD
TT:	LBR 81A4H
; 


;-----------------------------------------------;
;	TINY BASIC INTERMEDIATE LANGUAGE	;
;-----------------------------------------------;
;
; INTERMEDIATE LANGUAGE OPERATION CODES
;
SX:	EQU 00H  ; STACK EXCHANGE (00-07) BYTE N WITH BYTE 0
NO:	EQU 08H  ; NO OPERATION
LB:	EQU 09H  ; PUSH NEXT BYTE ONTO STACK
LN:	EQU 0AH  ; ADD NEXT NUMBER TO STACK (2 BYTES)
DS:	EQU 0BH  ; DUPLICATE NUMBER ON TOP OF STACK (2 BYTES)
SB:	EQU 10H  ; SAVE BASIC POINTER
RP:	EQU 11H  ; RESTORE BASIC POINTER (PITTMAN USED RB)
FV:	EQU 12H  ; FETCH VARIABLE
SV:	EQU 13H  ; STORE VARIABLE
GS:	EQU 14H  ; GOSUB SAVE
RS:	EQU 15H  ; RESTORE SAVED LINE
GO:	EQU 16H  ; GOTO
NG:	EQU 17H  ; NEGATE, TWO'S COMPLEMENT (PITTMAN USED NE)
AD:	EQU 18H  ; ADD
SU:	EQU 19H  ; SUBTRACT
MP:	EQU 1AH  ; MULTIPLY
DV:	EQU 1BH  ; DIVIDE
CP:	EQU 1CH  ; COMPARE
NX:	EQU 1DH  ; NEXT BASIC STATEMENT
LS:	EQU 1FH  ; LIST PROGRAM
PN:	EQU 20H  ; PRINT NUMBER
PQ:	EQU 21H  ; PRINT BASIC STRING
PT:	EQU 22H  ; PRINT TAB
NL:	EQU 23H  ; NEW LINE
PS:	EQU 24H  ; PRINT STRING, ENDING IN CHAR W. MSB=1
GL:	EQU 27H  ; GET INPUT LINE
IL:	EQU 2AH  ; INSERT BASIC LINE
MT:	EQU 2BH  ; MARK BASIC PROGRAM SPACE EMPTY
XQ:	EQU 2CH  ; EXECUTE
WS:	EQU 2DH  ; STOP
US:	EQU 2EH  ; MACHINE LANGUAGE SUBROUTINE CALL
RT:	EQU 2FH  ; IL SUBROUTINE RETURN
JS:	EQU 3000H; JUMP SUBROUTINE @ NEXTBYTE-STRT (3000-37FF)
JU:	EQU 3800H; JUMP TO LABEL AT NEXTBYTE-STRT (3800-3FFF)
BR:	EQU 5FH  ; BRANCH RELATIVE TO 5FH+LABEL-$ (40-7F)
BC:	EQU 7FH  ; BRANCH IF NO MATCH TO 7FH+LABEL-$ (80-9F)
BV:	EQU 9FH  ; BRANCH IF NOT A VARIABLE (A0-BF)
BN:	EQU 0BFH ; BRANCH IF NOT NUMBER TO BFH+LABEL-$ (C0-DF)
BE:	EQU 0DFH ; BRANCH IF NOT ENDLINE TO DFH+LABEL-$(E0-FF)

; TB-MON.ASM					    PAGE 30


;
; BEGIN TINY BASIC INTERMEDIATE LANGUAGE PROGRAM
;
TBIL:	EQU $
STRT:	DB  PS,":",91H	; PS ":<DC1>"	PRINT PROMPT
	DB  GL		; GL		GET LINE
	DB  SB		; SB		SAVE POINTER
	DB  BE+L0-$	; BE L0 	IF EMPTY,
	DB  BR+STRT-$	; BR STRT	  THEN START AGAIN
L0:	DB  BN+GOTO-$	; BN GOTO	IF LINE NUMBER,
	DB  IL		; IL		  THEN INSERT LINE
	DB  BR+STRT-$	; BR STRT	    AND START AGAIN
X1:	DB  XQ		; XQ		ELSE EXECUTE LINE
;
; EXECUTE STATEMENT
;
GOTO:	DB  BC+GOSB-$	; BC GOSB "GOTO"
	DB  "GOT",("O"+80H)
	DW  JS+EXPR-STRT; JS EXPR	GET LINE NUMBER
XEC:	DB  SB		; SB		SAVE POINTERS
	DB  RP		; RP		  FOR RUNN WITH
	DB  BE+G1-$	; BE G1 	  CONCATENATED INPUT
	DB  BR+G2-$	; BR G2
GOSB:	DB  BC+STMT-$	; BC STMT "GOSUB"
	DB  "GOSU"
	DB  ("B"+80H)
	DW  JS+EXPR-STRT; JS EXPR
	DB  SB		; SB
	DB  RP		; RP
G1:	DB  BE+1	; BE *
	DB  GS		; GS
G2:	DB  GO		; GO
STMT:	DB  BC+PRNT-$	; BC PRNT "LET"
	DB  "LE",("T"+80H)
	DB  BV+1	; BV *		MUST BE VARIABLE NAME
	DB  BC+1	; BC * "="
	DB   ("="+80H)
LET:	DW  JS+EXPR-STRT; JS EXPR	GO GET EXPRESSION
	DB  BE+1	; BE *		IF STATEMENT,
	DB  SV		; SV		  STORE RESULT
	DB  NX
PRNT:	DB  BC+SKIPIT-$ ; BC SKIPIT "PR"
	DB  "P",("R"+80H)
	DB  BC+P0-$	; BC P0 "INT"	IF PR OR PRINT,
	DB  "IN",("T"+80H)
P0:	DB  BE+P1-$	; BE P1
	DB  BR+P2-$	; BR P2
P1:	DB  BC+P3-$	; BC P3 ":"
	DB  (":"+80H)
P2:	DW  JU+P12-STRT ; JU P12
SKIPIT: DW  JU+IF-STRT	; JU IF

; TB-MON.ASM					    PAGE 31


P3:	DB  BC+P4-$	; BC P4 '"'
	DB  ('"'+80H)
	DB  PQ		; PQ		QUOTE MARKS STRING
	DB  BR+P5-$	; BR P5
P4:	DW  JS+EXPR-STRT; JS EXPR
	DB  PN		; PN
P5:	DB  BC+P6-$	; BC P6 ","
	DB  (","+80H)
	DB  PT		; PT
	DB  BR+P7-$	; BR P7
P6:	DB  BC+P9-$	; BC P9 ";"
	DB  (";"+80H)
P7:	DB  BE+P8-$	; BE P8
	DB  BR+P11-$	; BR P11
P8:	DB  BR+P1-$	; BR P1
P9:	DB  BC+P10-$	; BC P10 "^"
	DB  ("^"+80H)
	DB  PS,93H	; PS "<DC3>"	PRINT <DC3>=13H=^S
P10:	DB  BE+1	; BE *
P12:	DB  NL		; NL		THEN <CR><LF>
P11:	DB  NX		; NX
IF:	DB  BC+INP-$	; BC INP "IF"
	DB  "I",("F"+80H)
	DW  JS+EXPR-STRT; JS EXPR
	DW  JS+RELO-STRT; JS RELO
	DW  JS+EXPR-STRT; JS EXPR
	DB  BC+I1-$	; BC I1 "THEN"	(OPTIONAL)
	DB  "THE",("N"+80H)
I1:	DB  CP		; CP
	DB  NX		; NX
	DW  JU+GOTO-STRT; JU STMT
;
; PROCESS INPUT STATEMENT
;
INP:	DB  BC+RTRN-$	; BC RTRN "IN"
	DB  "I",("N"+80H)
	DB  BC+I2-$	; BC I2 "PUT"
	DB  "PU",("T"+80H)
I2:	DB  BV+1	; BV *
	DB  SB		; SB
	DB  BE+I4-$	; BE I4
I3:	DB  PS,"? "	; PS "? <DC1>"	TYPE "?" PROMPT,
	DB  (11H+80H)	;		THEN <DC1>=11H=XON=^Q
	DB  GL		; GL		THEN READ INPUT LINE
	DB  BE+I4-$	; BE I4 	PROCESS IT
	DB  BR+I3-$	; BR I3 	IF NOT ENOUGH, REPEAT
I4:	DB  BC+I5-$	; BC I5 ","	OPTIONAL COMMA?
	DB  (","+80H)
I5:	DW  JS+EXPR-STRT; JS EXPR	READ A NUMBER
	DB  SV		; SV		STORE IN VARIABLE
	DB  RP		; RB		SWAP

; TB-MON.ASM					    PAGE 32


	DB  BC+I6-$	; BC I6 ","	IF ANOTHER COMMA,
	DB  (","+80H)
	DB  BR+I2-$	; BR I2 	  THEN PROCESS IT
I6:	DB  BE+1	; BE *
	DB  NX		; NX		  ELSE QUIT
;
; PROCESS RETURN STATEMENT
;
RTRN:	DB  BC+END-$	; BC END "RET"
	DB  "RE",("T"+80H)
	DB  BC+RT1-$	; BC RT1 "URN"
	DB  "UR",("N"+80H)
RT1:	DB  BE+1	; BE *
	DB  RS		; RS
	DB  NX		; NX
END:	DB  BC+RUNN-$	; BC RUNN "END"
	DB  "EN",("D"+80H)
	DB  BE+1	; BE *
	DB  WS		; WS
RUNN:	DB  BC+CLER-$	; BC CLER "RUN"
	DB  "RU",("N"+80H)
	DB  SB		; SB
	DB  RP		; RB
	DW  JU+X1-STRT	; JU X1
CLER:	DB  BC+LISTIT-$ ; BC LISTIT "NEW"
	DB  "NE",("W"+80H)
	DB  MT		; MT
LISTIT: DB  BC+REM-$	; BC REM "LIST"
	DB  "LIS",("T"+80H)
	DB  BE+L2-$	; BE L2
LISX:	DB  LN,0,1	; LN 1
	DB  LN,7FH,0FFH ; LN 32767
	DB  BR+L1-$	; BR L1
L2:	DW  JS+EXPR-STRT; JS EXPR
	DW  JS+ARG-STRT ; JS ARG
	DB  BE+1	; BE *
L1:	DB  PS		; PS "^@^@^@^@^@^@^J^@"
	DW  0,0 	;		SIX <NUL>,<LF>,<NUL>
	DB  0,0,0AH,80H ;		  AS A PUNCH LEADER,
	DB  LS		; LS		THEN LIST,
	DB  PS,93H	; PS "^S"	THEN TURN PUNCH OFF
	DB  NL		; NL		   WITH <DC3>=XOFF=^S
	DB  NX		; NX
REM:	DB  BC+DFLT-$	; BC DFLT "REM"
	DB  "RE",("M"+80H)
	DB  NX		; NX
DFLT:	DB  BV+1	; BV *		IF NO KEYWORD,
	DB  BC+1	; BC * "="	  TRY FOR "=" (LET)
	DB  ("="+80H)
	DW  JU+LET-STRT ; JU LET
;

; TB-MON.ASM					    PAGE 33


; IL SUBROUTINES
;
ARG:	DB  BC+E5-$	; BC E5 ","
	DB  (","+80H)
	DB  BR+EXPR-$	; BR EXPR
E5:	DB  DS		; DS
E3:	DB  RT		; RT
EXPR:	DB  BC+E0-$	; BC E0 "-"	IF UNARY MINUS,
	DB  ("-"+80H)
	DW  JS+TERM-STRT; JS TERM	  GO PROCESS IT
	DB  NG		; NE
	DB  BR+E1-$	; BR E1
E0:	DB  BC+E4-$	; BC E4 "+"	IGNORE LEADING PLUS
	DB  ("+"+80H)
E4:	DW  JS+TERM-STRT; JS TERM
E1:	DB  BC+E2-$	; BC E2 "+"	TERMS SEPARATED BY +
	DB  ("+"+80H)
	DW  JS+TERM-STRT; JS TERM
	DB  AD		; AD
	DB  BR+E1-$	; BR E1
E2:	DB  BC+T2-$	; BC T2 "-"	TERM SEPARATED BY -
	DB  ("-"+80H)
	DW  JS+TERM-STRT; JS TERM
	DB  SU		; SU
	DB  BR+E1-$	; BR E1
;
TERM:	DW  JS+FACT-STRT; JS FACT
T0:	DB  BC+T1-$	; BC T1 "*"	FACTORS SEPARATED
	DB  ("*"+80H)	;		  BY TIMES
	DW  JS+FACT-STRT; JS FACT
	DB  MP		; MP
	DB  BR+T0-$	; BR T0
T1:	DB  BC+T2-$	; BC T2 "/"
	DB  ("/"+80H)
	DW  JS+FACT-STRT; JS FACT
	DB  DV		; DV
	DB  BR+T0-$	; BR T0
T2:	DB  RT		; RT
FACT:	DB  BC+F2-$	; BC F2 "RND("
	DB  "RND",("("+80H)
	DW  JS+F6-STRT	; JS F6
	DW  JU+RR7-STRT ; JU RR7
F2:	DB  BC+F3-$	; BC F3 "USR("	3 ARGUMENTS POSSIBLE
	DB  "USR",("("+80H)
	DW  JS+EXPR-STRT; JS EXPR	ONE REQUIRED
	DW  JS+ARG-STRT ; JS ARG	2ND OPTIONAL
	DW  JS+ARG-STRT ; JS ARG	3RD OPTIONAL
	DW  JS+FUNC-STRT; JU FUNC
	DB  US
	DB  RT
F3:	DB  BV+F4-$	; BV F4 	IF A VARIABLE,

; TB-MON.ASM					    PAGE 34


	DB  FV		; FV		  THEN GET IT
	DB  RT		; RT
F4:	DB  BN+F5-$	; BN F5 	IF A NUMBER,
	DB  RT		; RT		  THEN GET IT
F5:	DB  BC+1	; BC * "("	ELSE MUST BE
	DB  ("("+80H)	;		  AN EXPRESSION
	DB  BR+F7-$	; BR F7
F6:	DW  JS+EXPR-STRT; JS EXPR
	DB  DS		; DS
	DB  BC+1	; BC * ","	ANOTHER ARGUMENT
	DB  (","+80H)
F7:	DW  JS+EXPR-STRT; JS EXPR
FUNC:	DB  BC+1	; BC * ")"	END OF PARENTHESES?
	DB  (")"+80H)
	DB  RT		; RT
RELO:	DB  BC+RR0-$	; BC RR0 "="	CONVERT RELATIONAL
	DB  ("="+80H)	;		  OPERATORS TO CODE
	DB  LB,2	; LB 2		  BYTE ON STACK
	DB  RT		; RT
RR0:	DB  BC+RR1-$	; BC RR1 "<>"
	DB  "<",(">"+80H)
	DB  BR+RR2-$	; BR RR2
RR1:	DB  BC+RR3-$	; BC RR3 "<="
	DB  "<",("="+80H)
	DB  LB,3	; LB 3
	DB  RT		; RT
RR3:	DB  BC+RR4-$	; BC RR4 "<"
	DB  ("<"+80H)
	DB  LB,1	; LB 1
	DB  RT		; RT
RR4:	DB  BC+RR5-$	; BC RR5 ">="
	DB  ">",("="+80H)
	DB  LB,6	; LB 5
	DB  RT		; RT
RR5:	DB  BC+RR6-$	; BC RR6 "><"
	DB  ">",("<"+80H)
RR2:	DB  LB,5	; LB 5
	DB  RT		; RT
RR6:	DB  BC+1	; BC * ">"
	DB  (">"+80H)
	DB  LB,4	; LB 4
	DB  RT		; RT
RR7:	DB  SU		; SU
	DB  NG		; NE
	DB  LN,0,1	; LN 257*128	STACK POINTER
	DB  AD		; AD		  FOR STORE
	DB  LB,80H	; LB 128
	DB  LB,80H	; LB 128
	DB  FV		; FV		SET RANDOM NUMBER
	DB  LN,09H,29H	; LN 2345	R:=R*2345+6789
	DB  MP		; MP

; TB-MON.ASM					    PAGE 35


	DB  LN,1AH,85H	; LN 6789
	DB  AD		; AD
	DB  NO		; NO
	DB  SV		; SV
	DB  LB,80H	; LB 128	GET IT AGAIN
	DB  FV		; FV
	DB  SX+3	; SX 3
	DB  SX+1	; SX 1
	DB  SX+2	; SX 2
	DW  JS+F1-STRT	; JS F1 	SKIPPING
F0:	DW  JS+ABS-STRT ; JS ABS
	DB  DV		; DV
	DB  MP		; MP
	DB  SU		; SU
	DW  JS+ABS-STRT ; JS ABS
	DB  AD		; AD
	DB  RT		; RT
F1:	DB  DS		; DS
	DB  SX+1	; SX 1		PUSH TOP INTO STACK
	DB  SX+5	; SX 5
	DB  SX+1	; SX 1
	DB  SX+4	; SX 4
	DB  DS		; DS
	DB  SX+1	; SX 1
	DB  SX+7	; SX 7
	DB  SX+1	; SX 1
	DB  SX+6	; SX 6
	DB  RT		; RT
ABS:	DB  DS		; DS		PERFORM ABS FUNCTION
	DB  LB,6	; LB 6
	DB  LN,0,0	; LN 0
	DB  CP		; CP
	DB  NG		; NE
	DB  RT		; RT
;
; END TINY BASIC INTERMEDIATE LANGUAGE PROGRAM
; should be 7FFEH
	DB	00H
	END